OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i2mom27_cin.F File Reference
#include "implicit_f.inc"
#include "scr14_c.inc"
#include "scr16_c.inc"
#include "impl1_c.inc"
#include "vectorize.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine i2mom27_cin (nsn, nmn, ar, irect, crst, msr, nsv, irtl, in, ms, a, x, weight, stifr, stifn, idel2, smass, siner, nmas, adi, indxc, miner, h3d_data, msegtyp2, csts_bis)

Function/Subroutine Documentation

◆ i2mom27_cin()

subroutine i2mom27_cin ( integer nsn,
integer nmn,
ar,
integer, dimension(4,*) irect,
crst,
integer, dimension(*) msr,
integer, dimension(*) nsv,
integer, dimension(*) irtl,
in,
ms,
a,
x,
integer, dimension(*) weight,
stifr,
stifn,
integer idel2,
smass,
siner,
nmas,
adi,
integer, dimension(nsn) indxc,
miner,
type (h3d_database) h3d_data,
integer, dimension(*) msegtyp2,
csts_bis )

Definition at line 31 of file i2mom27_cin.F.

36C-----------------------------------------------
37C M o d u l e s
38C-----------------------------------------------
39 USE h3d_mod
40 USE outmax_mod
41C-----------------------------------------------
42C I m p l i c i t T y p e s
43C-----------------------------------------------
44#include "implicit_f.inc"
45C-----------------------------------------------
46C D u m m y A r g u m e n t s
47C-----------------------------------------------
48 INTEGER NSN, NMN, IDEL2,
49 . IRECT(4,*), MSR(*), NSV(*), IRTL(*), WEIGHT(*),INDXC(NSN),MSEGTYP2(*)
50C REAL
51 my_real
52 . a(3,*), ar(3,*),crst(2,*), ms(*),
53 . x(3,*),in(*),stifr(*),stifn(*), smass(*), siner(*),
54 . nmas(*),adi(*),miner(*),csts_bis(2,*)
55 TYPE (H3D_DATABASE) :: H3D_DATA
56C-----------------------------------------------
57C C o m m o n B l o c k s
58C-----------------------------------------------
59#include "scr14_c.inc"
60#include "scr16_c.inc"
61#include "impl1_c.inc"
62C-----------------------------------------------
63C L o c a l V a r i a b l e s
64C-----------------------------------------------
65 INTEGER I, J, K, I3, J3, I2, J2, I1, J1, II, L, JJ, W,NIR
66C REAL
67 my_real
68 . h(4), xmsj, ss, st, xmsi, fxi, fyi, fzi, mxi, myi, mzi,ins,
69 . x0,x1,x2,x3,x4,y0,y1,y2,y3,y4,z0,z1,z2,z3,z4,aa,
70 . xc0,yc0,zc0,sp,sm,tp,tm,xc,yc,zc,
71 . stf,ai,h2(4)
72C=======================================================================
73C MINER(II) initialise a MS(J) dans resol_init
74 IF(anim_n(12)+outp_n(3)+h3d_data%N_SCAL_DINER >0) THEN
75 DO ii=1,nmn
76 j=msr(ii)
77 adi(j) = adi(j)*nmas(ii)
78 ENDDO
79 ENDIF
80 IF(impl_s>0) THEN
81 DO ii=1,nsn
82 k = indxc(ii)
83 IF (k == 0) cycle
84 i = nsv(k)
85 IF(i>0)THEN
86 l=irtl(ii)
87C
88 IF (irect(3,l) == irect(4,l)) THEN
89C-- Shape functions of triangles
90 nir = 3
91 h(1) = crst(1,ii)
92 h(2) = crst(2,ii)
93 h(3) = one-crst(1,ii)-crst(2,ii)
94 h(4) = zero
95 h2(1) = csts_bis(1,ii)
96 h2(2) = csts_bis(2,ii)
97 h2(3) = one-csts_bis(1,ii)-csts_bis(2,ii)
98 h2(4) = zero
99 ELSE
100C-- Shape functions of quadrangles
101 nir = 4
102 ss=crst(1,ii)
103 st=crst(2,ii)
104 sp=one + ss
105 sm=one - ss
106 tp=fourth*(one + st)
107 tm=fourth*(one - st)
108 h(1)=tm*sm
109 h(2)=tm*sp
110 h(3)=tp*sp
111 h(4)=tp*sm
112
113C Additional form functions for distribution of mass / inertia - to avoid negative masses for projection outside of the element
114 ss=csts_bis(1,ii)
115 st=csts_bis(2,ii)
116 sp=one + ss
117 sm=one - ss
118 tp=fourth*(one + st)
119 tm=fourth*(one - st)
120 h2(1)=tm*sm
121 h2(2)=tm*sp
122 h2(3)=tp*sp
123 h2(4)=tp*sm
124 ENDIF
125C
126 xc=zero
127 yc=zero
128 zc=zero
129 DO jj=1,nir
130 j=irect(jj,l)
131 xc=xc+x(1,j)*h(jj)
132 yc=yc+x(2,j)*h(jj)
133 zc=zc+x(3,j)*h(jj)
134 ENDDO
135C
136 x0 = x(1,i)
137 y0 = x(2,i)
138 z0 = x(3,i)
139C
140 xc0=x0-xc
141 yc0=y0-yc
142 zc0=z0-zc
143C
144 aa = xc0*xc0 + yc0*yc0 + zc0*zc0
145 ins = in(i) + aa * ms(i)
146 stf = stifr(i) + aa * stifn(i)
147C
148 fxi=a(1,i)
149 fyi=a(2,i)
150 fzi=a(3,i)
151C
152 mxi = ar(1,i) + yc0 * fzi - zc0 * fyi
153 myi = ar(2,i) + zc0 * fxi - xc0 * fzi
154 mzi = ar(3,i) + xc0 * fyi - yc0 * fxi
155C
156 w = weight(i)
157 ai=aa * ms(i) * w
158 IF (anim_n(12)+outp_n(3)+h3d_data%N_SCAL_DINER >0) THEN
159 DO jj=1,nir
160 j=irect(jj,l)
161 adi(j)=adi(j)+ai*h(jj)
162 END DO
163 END IF
164C
165 IF (h3d_data%N_VECT_CONT2M > 0) THEN
166 mcont2(1,i) = -ar(1,i)*w
167 mcont2(2,i) = -ar(2,i)*w
168 mcont2(3,i) = -ar(3,i)*w
169 DO jj=1,nir
170 j=irect(jj,l)
171 mcont2(1,j) = mcont2(1,j) + mxi*h(jj)*w
172 mcont2(2,j) = mcont2(2,j) + myi*h(jj)*w
173 mcont2(3,j) = mcont2(3,j) + mzi*h(jj)*w
174 ENDDO
175 ENDIF
176C
177 DO jj=1,nir
178 j=irect(jj,l)
179 IF (msegtyp2(l)==1) THEN
180 ar(1,j)=ar(1,j)+mxi*h(jj)*w
181 ar(2,j)=ar(2,j)+myi*h(jj)*w
182 ar(3,j)=ar(3,j)+mzi*h(jj)*w
183 in(j)=in(j)+ins*h2(jj)*w
184 stifr(j)=stifr(j)+abs(stf*h(jj)*w)
185 END IF
186 ENDDO
187 stifr(i)=em20
188 IF(idel2/=0.AND.in(i)/=0.)siner(ii)=in(i)
189 in(i)=zero
190 stifn(i)=em20
191 IF(idel2/=0.AND.ms(i)/=0.)smass(ii)=ms(i)
192 ms(i)=zero
193 a(1,i)=zero
194 a(2,i)=zero
195 a(3,i)=zero
196 ENDIF
197C
198 ENDDO
199c
200 ELSE
201c
202 DO ii=1,nsn
203 k = indxc(ii)
204 IF (k == 0) cycle
205 i = nsv(k)
206 IF(i>0)THEN
207 l=irtl(ii)
208C
209 ss=crst(1,ii)
210 st=crst(2,ii)
211 sp=one + ss
212 sm=one - ss
213 tp=fourth*(one + st)
214 tm=fourth*(one - st)
215C
216 IF (irect(3,l) == irect(4,l)) THEN
217C-- Shape functions of triangles
218 nir = 3
219 h(1) = crst(1,ii)
220 h(2) = crst(2,ii)
221 h(3) = one-crst(1,ii)-crst(2,ii)
222 h(4) = zero
223 h2(1) = csts_bis(1,ii)
224 h2(2) = csts_bis(2,ii)
225 h2(3) = one-csts_bis(1,ii)-csts_bis(2,ii)
226 h2(4) = zero
227 ELSE
228C-- Shape functions of quadrangles
229 nir = 4
230 ss=crst(1,ii)
231 st=crst(2,ii)
232 sp=one + ss
233 sm=one - ss
234 tp=fourth*(one + st)
235 tm=fourth*(one - st)
236 h(1)=tm*sm
237 h(2)=tm*sp
238 h(3)=tp*sp
239 h(4)=tp*sm
240
241C Additional form functions for distribution of mass / inertia - to avoid negative masses for projection outside of the element
242 ss=csts_bis(1,ii)
243 st=csts_bis(2,ii)
244 sp=one + ss
245 sm=one - ss
246 tp=fourth*(one + st)
247 tm=fourth*(one - st)
248 h2(1)=tm*sm
249 h2(2)=tm*sp
250 h2(3)=tp*sp
251 h2(4)=tp*sm
252 ENDIF
253C
254 x0 = x(1,i)
255 y0 = x(2,i)
256 z0 = x(3,i)
257C
258 x1 = x(1,irect(1,l))
259 y1 = x(2,irect(1,l))
260 z1 = x(3,irect(1,l))
261 x2 = x(1,irect(2,l))
262 y2 = x(2,irect(2,l))
263 z2 = x(3,irect(2,l))
264 x3 = x(1,irect(3,l))
265 y3 = x(2,irect(3,l))
266 z3 = x(3,irect(3,l))
267 x4 = x(1,irect(4,l))
268 y4 = x(2,irect(4,l))
269 z4 = x(3,irect(4,l))
270C
271 xc = x1 * h(1) + x2 * h(2) + x3 * h(3) + x4 * h(4)
272 yc = y1 * h(1) + y2 * h(2) + y3 * h(3) + y4 * h(4)
273 zc = z1 * h(1) + z2 * h(2) + z3 * h(3) + z4 * h(4)
274C
275 xc0=x0-xc
276 yc0=y0-yc
277 zc0=z0-zc
278C
279 aa = xc0*xc0 + yc0*yc0 + zc0*zc0
280 ins = in(i) + aa * ms(i)
281 stf = stifr(i) + aa * stifn(i)
282C
283 fxi=a(1,i)
284 fyi=a(2,i)
285 fzi=a(3,i)
286C
287 mxi = ar(1,i) + yc0 * fzi - zc0 * fyi
288 myi = ar(2,i) + zc0 * fxi - xc0 * fzi
289 mzi = ar(3,i) + xc0 * fyi - yc0 * fxi
290C
291 w = weight(i)
292 ai=aa * ms(i) * w
293 IF (anim_n(12)+outp_n(3)+h3d_data%N_SCAL_DINER >0) THEN
294 DO jj=1,4
295 j=irect(jj,l)
296 adi(j)=adi(j)+ai*h(jj)
297 END DO
298 END IF
299C
300 IF (h3d_data%N_VECT_CONT2M > 0) THEN
301 mcont2(1,i) = -ar(1,i)*w
302 mcont2(2,i) = -ar(2,i)*w
303 mcont2(3,i) = -ar(3,i)*w
304 DO jj=1,nir
305 j=irect(jj,l)
306 mcont2(1,j) = mcont2(1,j) + mxi*h(jj)*w
307 mcont2(2,j) = mcont2(2,j) + myi*h(jj)*w
308 mcont2(3,j) = mcont2(3,j) + mzi*h(jj)*w
309 ENDDO
310 ENDIF
311C
312 DO jj=1,4
313 j=irect(jj,l)
314 IF (msegtyp2(l)==1) THEN
315 ar(1,j)=ar(1,j)+mxi*h(jj)*w
316 ar(2,j)=ar(2,j)+myi*h(jj)*w
317 ar(3,j)=ar(3,j)+mzi*h(jj)*w
318 in(j)=in(j)+ins*h2(jj)*w
319 stifr(j)=stifr(j)+abs(stf*h(jj)*w)
320 END IF
321 ENDDO
322 stifr(i)=em20
323 IF(idel2/=0.AND.in(i)/=0.)siner(ii)=in(i)
324 in(i)=zero
325 stifn(i)=em20
326 IF(idel2/=0.AND.ms(i)/=0.)smass(ii)=ms(i)
327 ms(i)=zero
328 a(1,i)=zero
329 a(2,i)=zero
330 a(3,i)=zero
331 ENDIF
332C
333 ENDDO
334 ENDIF
335C
336C
337 IF(anim_n(12)+outp_n(3)+h3d_data%N_SCAL_DINER >0) THEN
338#include "vectorize.inc"
339 DO ii=1,nmn
340 j=msr(ii)
341 adi(j) = adi(j)/max(em20,nmas(ii))
342 ENDDO
343 ENDIF
344C
345 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
max
#define max(a, b)
Definition macros.h:21
h3d_mod
Definition h3d_mod.F:308
outmax_mod
Definition outmax_mod.F:52