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

Go to the source code of this file.

Functions/Subroutines

subroutine i2for28_cin (nsn, nmn, a, irect, dpara, msr, nsv, irtl, ms, weight, ar, in, x, stifn, stifr, fsav, dmast, adm, mmass, idel2, smass, siner, crst, fncont, indxc, miner, h3d_data, fncontp, ftcontp)

Function/Subroutine Documentation

◆ i2for28_cin()

subroutine i2for28_cin ( integer nsn,
integer nmn,
a,
integer, dimension(4,*) irect,
dpara,
integer, dimension(*) msr,
integer, dimension(*) nsv,
integer, dimension(*) irtl,
ms,
integer, dimension(*) weight,
ar,
in,
x,
stifn,
stifr,
fsav,
dmast,
adm,
mmass,
integer idel2,
smass,
siner,
crst,
fncont,
integer, dimension(*) indxc,
miner,
type (h3d_database) h3d_data,
fncontp,
ftcontp )

Definition at line 32 of file i2for28_cin.F.

38C-----------------------------------------------
39C M o d u l e s
40C-----------------------------------------------
41 USE h3d_mod
42C-----------------------------------------------
43C I m p l i c i t T y p e s
44C-----------------------------------------------
45#include "implicit_f.inc"
46C-----------------------------------------------
47C D u m m y A r g u m e n t s
48C-----------------------------------------------
49 INTEGER NSN, NMN,
50 . IRECT(4,*), MSR(*), NSV(*), IRTL(*), WEIGHT(*), IDEL2, INDXC(*)
51C REAL
52 my_real
53 . x(3,*),a(3,*),ar(3,*), mmass(*), crst(2,*),
54 . dpara(7,*), ms(*), in(*),stifn(*),stifr(*),dmast,adm(*),
55 . smass(*), siner(*),fsav(*), fncont(3,*), miner(*),fncontp(3,*),
56 . ftcontp(3,*)
57 TYPE (H3D_DATABASE) :: H3D_DATA
58C-----------------------------------------------
59C C o m m o n B l o c k s
60C-----------------------------------------------
61#include "com01_c.inc"
62#include "scr14_c.inc"
63#include "scr16_c.inc"
64#include "impl1_c.inc"
65C-----------------------------------------------
66C L o c a l V a r i a b l e s
67C-----------------------------------------------
68 INTEGER NIR, I, J, K, J1,J2,J3,J4, II, L, JJ
69C REAL
70 my_real
71 . h(4),xm(4),ym(4),zm(4),
72 . xmsj, ss, st, xmsi, fs(3),sp,sm,tp,tm,facm,
73 . mx,my,mz,det,fx0,fy0,fz0,ins,
74 . x0,x1,x2,x3,x4,xs,y0,y1,y2,y3,y4,ys,z0,z1,z2,z3,z4,zs,
75 . x12,x22,x32,x42,y12,y22,y32,y42,z12,z22,z32,z42,
76 . xx,yy,zz,xxx,yyy,zzz,xy,yz,zx,xy2,yz2,zx2,s,t,
77 . a1,a2,a3,b1,b2,b3,c1,c2,c3,mr,mrx,mry,mrz,inx,iny,inz,stf,fact,
78 . fx(4),fy(4),fz(4)
79C=======================================================================
80C
81C------------------------------
82C DUPLICATED FROM I2FOMO3 - SPOTFLAG1 FORMULATION
83C------------------------------
84C
85 nir=4
86C
87C--- Traitement specifique pour DMAS
88C
89C--- MMASS(II) initialise a MS(J) a t=0 dans starter
90 IF(anim_n(2)+outp_n(2)+h3d_data%N_SCAL_DMAS >0) THEN
91 DO ii=1,nmn
92 j=msr(ii)
93 adm(j) = adm(j)*mmass(ii)
94 ENDDO
95 ENDIF
96C
97C------------------------------
98C FORCES ET MOMENTS DES NOEUDS SECONDS
99C TRANSMIS AUX NOEUDS MAINS SOUS
100C FORME DE FORCES
101C
102C MASSES ET INERTIES DES NOEUDS SECONDS
103C TRANSMISES AUX NOEUDS MAINS SOUS
104C FORME DE MASSES
105C------------------------------
106C
107 IF(impl_s>0) THEN
108 DO ii=1,nsn
109 k = indxc(ii)
110 IF (k == 0) cycle
111 i = nsv(k)
112 IF(i>0)THEN
113 l=irtl(ii)
114C
115 s = crst(1,ii)
116 t = crst(2,ii)
117 sp=one + s
118 sm=one - s
119 tp=fourth*(one + t)
120 tm=fourth*(one - t)
121C
122 h(1)=one/nir
123 h(2)=one/nir
124 h(3)=one/nir
125 h(4)=one/nir
126C
127 nir=4
128 DO jj=1,nir
129 j=irect(jj,l)
130 xm(jj)=x(1,j)
131 ym(jj)=x(2,j)
132 zm(jj)=x(3,j)
133 ENDDO
134 IF(irect(3,l)==irect(4,l)) THEN
135 nir=3
136 xm(4)=zero
137 ym(4)=zero
138 zm(4)=zero
139 ENDIF
140 facm = one / nir
141C----------------------------------------------------
142C VITESSE DE ROTATION MOYENNE DU SEGMENT MAIN
143C----------------------------------------------------
144 x0=facm*(xm(1)+xm(2)+xm(3)+xm(4))
145 y0=facm*(ym(1)+ym(2)+ym(3)+ym(4))
146 z0=facm*(zm(1)+zm(2)+zm(3)+zm(4))
147 DO j=1,nir
148 xm(j)=xm(j)-x0
149 ym(j)=ym(j)-y0
150 zm(j)=zm(j)-z0
151 ENDDO
152 xs=x(1,i)-x0
153 ys=x(2,i)-y0
154 zs=x(3,i)-z0
155 xx=0
156 yy=0
157 zz=0
158 xy=0
159 yz=0
160 zx=0
161 DO j=1,nir
162 xx=xx+ xm(j)*xm(j)
163 yy=yy+ ym(j)*ym(j)
164 zz=zz+ zm(j)*zm(j)
165 xy=xy+ xm(j)*ym(j)
166 yz=yz+ ym(j)*zm(j)
167 zx=zx+ zm(j)*xm(j)
168 ENDDO
169 zzz=xx+yy
170 xxx=yy+zz
171 yyy=zz+xx
172 xy2=xy*xy
173 yz2=yz*yz
174 zx2=zx*zx
175 det= xxx*yyy*zzz - xxx*yz2 - yyy*zx2 - zzz*xy2 - two*xy*yz*zx
176 det=one/det
177 b1=zzz*yyy-yz2
178 b2=xxx*zzz-zx2
179 b3=yyy*xxx-xy2
180 c3=zzz*xy+yz*zx
181 c1=xxx*yz+zx*xy
182 c2=yyy*zx+xy*yz
183C
184 dpara(1,ii)=det
185 dpara(2,ii)=b1
186 dpara(3,ii)=b2
187 dpara(4,ii)=b3
188 dpara(5,ii)=c1
189 dpara(6,ii)=c2
190 dpara(7,ii)=c3
191C
192 xmsi=ms(i)*weight(i)
193 fs(1)=a(1,i)*weight(i)
194 fs(2)=a(2,i)*weight(i)
195 fs(3)=a(3,i)*weight(i)
196C
197 IF (iroddl==1) THEN
198 ins=in(i)*weight(i)
199 mx=ar(1,i)*weight(i) + ys*fs(3) - zs*fs(2)
200 my=ar(2,i)*weight(i) + zs*fs(1) - xs*fs(3)
201 mz=ar(3,i)*weight(i) + xs*fs(2) - ys*fs(1)
202 ELSE
203 ins=zero
204 mx=ys*fs(3) - zs*fs(2)
205 my=zs*fs(1) - xs*fs(3)
206 mz=xs*fs(2) - ys*fs(1)
207 ENDIF
208C
209 a1=det*(mx*b1+my*c3+mz*c2)
210 a2=det*(my*b2+mz*c1+mx*c3)
211 a3=det*(mz*b3+mx*c2+my*c1)
212C
213 fx0=fs(1)*facm
214 fy0=fs(2)*facm
215 fz0=fs(3)*facm
216C------------------------------------------------------
217C FORCES TRANSMISES AUX NOEUDS MAINS
218C------------------------------------------------------
219 fx(1:4) = zero
220 fy(1:4) = zero
221 fz(1:4) = zero
222 DO jj=1,nir
223 j=irect(jj,l)
224 fx(jj)=fx0 + a2*zm(jj) - a3*ym(jj)
225 fy(jj)=fy0 + a3*xm(jj) - a1*zm(jj)
226 fz(jj)=fz0 + a1*ym(jj) - a2*xm(jj)
227 a(1,j)=a(1,j) + fx(jj)
228 a(2,j)=a(2,j) + fy(jj)
229 a(3,j)=a(3,j) + fz(jj)
230 ENDDO
231C------------------------------------------------------
232C INERTIES => MASSES
233C------------------------------------------------------
234C
235 inx=ins + xmsi*(xs*xs+ys*ys+zs*zs)
236 mrx = (b1+c3+c2)
237 mry = (b2+c1+c3)
238 mrz = (b3+c2+c1)
239 mr=det*inx*max(mrx,mry,mrz)
240C
241C------------------------------------------------------
242C MASSES TRANSMISES AUX NOEUDS MAINS
243C------------------------------------------------------
244 xmsi=max(facm*xmsi,mr)
245 dmast = dmast + nir*xmsi - ms(i)
246 IF (anim_n(2)+outp_n(2)+h3d_data%N_SCAL_DMAS >0) THEN
247 DO jj=1,nir
248 j=irect(jj,l)
249 adm(j) = adm(j) + xmsi - facm*ms(i)
250 ENDDO
251 ENDIF
252C
253 IF (iroddl == 1) THEN
254 stf = (facm*stifn(i)
255 . + det*max(mrx,mry,mrz)*(stifr(i)+stifn(i)*(xs*xs+ys*ys+zs*zs)))*weight(i)
256 ELSE
257 stf = (facm*stifn(i)
258 . + det*max(mrx,mry,mrz)*(stifn(i)*(xs*xs+ys*ys+zs*zs)))*weight(i)
259 ENDIF
260C
261 DO jj=1,nir
262 j=irect(jj,l)
263 ms(j)=ms(j)+xmsi
264 stifn(j)=stifn(j) + stf
265 ENDDO
266C
267 IF(idel2/=0.AND.ms(i)/=0.)smass(ii)=ms(i)
268 ms(i)=zero
269 stifn(i)=em20
270C
271 IF (iroddl==1) THEN
272 IF(idel2/=0.AND.in(i)/=0.)siner(ii)=in(i)
273 in(i)=zero
274 stifr(i)=em20
275 ENDIF
276C
277 ENDIF
278C----
279 IF(i>0)THEN
280C--- output of tied contact forces
281 CALL i2forces(x ,fs ,fx ,fy ,fz ,
282 . irect(1,l),nir ,fsav ,fncont ,fncontp,
283 . ftcontp ,weight ,h3d_data,i ,h)
284 ENDIF
285C----
286 ENDDO
287
288 ELSE
289C
290 DO ii=1,nsn
291 k = indxc(ii)
292 IF (k == 0) cycle
293 i = nsv(k)
294C
295 IF(i>0)THEN
296 l=irtl(ii)
297C
298 s = crst(1,ii)
299 t = crst(2,ii)
300 sp=one + s
301 sm=one - s
302 tp=fourth*(one + t)
303 tm=fourth*(one - t)
304C
305 h(1)=one/nir
306 h(2)=one/nir
307 h(3)=one/nir
308 h(4)=one/nir
309C
310 j1=irect(1,l)
311 j2=irect(2,l)
312 j3=irect(3,l)
313 j4=irect(4,l)
314 x1=x(1,j1)
315 y1=x(2,j1)
316 z1=x(3,j1)
317 x2=x(1,j2)
318 y2=x(2,j2)
319 z2=x(3,j2)
320 x3=x(1,j3)
321 y3=x(2,j3)
322 z3=x(3,j3)
323 x4=x(1,j4)
324 y4=x(2,j4)
325 z4=x(3,j4)
326 x0=fourth*(x1+x2+x3+x4)
327 y0=fourth*(y1+y2+y3+y4)
328 z0=fourth*(z1+z2+z3+z4)
329 x1=x1-x0
330 y1=y1-y0
331 z1=z1-z0
332 x2=x2-x0
333 y2=y2-y0
334 z2=z2-z0
335 x3=x3-x0
336 y3=y3-y0
337 z3=z3-z0
338 x4=x4-x0
339 y4=y4-y0
340 z4=z4-z0
341 xs=x(1,i)-x0
342 ys=x(2,i)-y0
343 zs=x(3,i)-z0
344C
345 x12=x1*x1
346 x22=x2*x2
347 x32=x3*x3
348 x42=x4*x4
349 y12=y1*y1
350 y22=y2*y2
351 y32=y3*y3
352 y42=y4*y4
353 z12=z1*z1
354 z22=z2*z2
355 z32=z3*z3
356 z42=z4*z4
357 xx=x12 + x22 + x32 + x42
358 yy=y12 + y22 + y32 + y42
359 zz=z12 + z22 + z32 + z42
360 xy=x1*y1 + x2*y2 + x3*y3 + x4*y4
361 yz=y1*z1 + y2*z2 + y3*z3 + y4*z4
362 zx=z1*x1 + z2*x2 + z3*x3 + z4*x4
363 zzz=xx+yy
364 xxx=yy+zz
365 yyy=zz+xx
366 xy2=xy*xy
367 yz2=yz*yz
368 zx2=zx*zx
369 det= xxx*yyy*zzz - xxx*yz2 - yyy*zx2 - zzz*xy2 - two*xy*yz*zx
370 det=one/det
371 b1=zzz*yyy-yz2
372 b2=xxx*zzz-zx2
373 b3=yyy*xxx-xy2
374 c3=zzz*xy+yz*zx
375 c1=xxx*yz+zx*xy
376 c2=yyy*zx+xy*yz
377C
378 dpara(1,ii)=det
379 dpara(2,ii)=b1
380 dpara(3,ii)=b2
381 dpara(4,ii)=b3
382 dpara(5,ii)=c1
383 dpara(6,ii)=c2
384 dpara(7,ii)=c3
385C
386 xmsi=ms(i)*weight(i)
387 fs(1)=a(1,i)*weight(i)
388 fs(2)=a(2,i)*weight(i)
389 fs(3)=a(3,i)*weight(i)
390 IF (iroddl==1) THEN
391 ins=in(i)*weight(i)
392 mx=ar(1,i)*weight(i) + ys*fs(3) - zs*fs(2)
393 my=ar(2,i)*weight(i) + zs*fs(1) - xs*fs(3)
394 mz=ar(3,i)*weight(i) + xs*fs(2) - ys*fs(1)
395 ELSE
396 ins=zero
397 mx=ys*fs(3) - zs*fs(2)
398 my=zs*fs(1) - xs*fs(3)
399 mz=xs*fs(2) - ys*fs(1)
400 ENDIF
401C
402 a1=det*(mx*b1+my*c3+mz*c2)
403 a2=det*(my*b2+mz*c1+mx*c3)
404 a3=det*(mz*b3+mx*c2+my*c1)
405C
406 fx0=fs(1)*fourth
407 fy0=fs(2)*fourth
408 fz0=fs(3)*fourth
409C------------------------------------------------------
410C FORCES TRANSMISES AUX NOEUDS MAINS
411C------------------------------------------------------
412 fx(1) = fx0 + a2*z1 - a3*y1
413 fy(1) = fy0 + a3*x1 - a1*z1
414 fz(1) = fz0 + a1*y1 - a2*x1
415 fx(2) = fx0 + a2*z2 - a3*y2
416 fy(2) = fy0 + a3*x2 - a1*z2
417 fz(2) = fz0 + a1*y2 - a2*x2
418 fx(3) = fx0 + a2*z3 - a3*y3
419 fy(3) = fy0 + a3*x3 - a1*z3
420 fz(3) = fz0 + a1*y3 - a2*x3
421 fx(4) = fx0 + a2*z4 - a3*y4
422 fy(4) = fy0 + a3*x4 - a1*z4
423 fz(4) = fz0 + a1*y4 - a2*x4
424c
425 a(1,j1)=a(1,j1) + fx(1)
426 a(2,j1)=a(2,j1) + fy(1)
427 a(3,j1)=a(3,j1) + fz(1)
428 a(1,j2)=a(1,j2) + fx(2)
429 a(2,j2)=a(2,j2) + fy(2)
430 a(3,j2)=a(3,j2) + fz(2)
431 a(1,j3)=a(1,j3) + fx(3)
432 a(2,j3)=a(2,j3) + fy(3)
433 a(3,j3)=a(3,j3) + fz(3)
434 a(1,j4)=a(1,j4) + fx(4)
435 a(2,j4)=a(2,j4) + fy(4)
436 a(3,j4)=a(3,j4) + fz(4)
437C------------------------------------------------------
438C INERTIES => MASSES
439C------------------------------------------------------
440C
441 inx=ins + xmsi*(xs*xs+ys*ys+zs*zs)
442 mrx = (b1+c3+c2)
443 mry = (b2+c1+c3)
444 mrz = (b3+c2+c1)
445 mr=det*inx*max(mrx,mry,mrz)
446C
447C------------------------------------------------------
448C MASSES TRANSMISES AUX NOEUDS MAINS
449C------------------------------------------------------
450C
451 fact = one
452 IF (iroddl==1) THEN
453 IF (miner(j1)>zero.AND.miner(j2)>zero.AND.miner(j3)>zero.AND.miner(j4)>zero) THEN
454C-- Inertie transmise sous forme d'inertie
455 fact = zero
456 ENDIF
457 ENDIF
458C
459 xmsi=fourth*xmsi+mr*fact
460C
461 dmast = dmast + four*xmsi - ms(i)
462 IF (anim_n(2)+outp_n(2)+h3d_data%N_SCAL_DMAS >0) THEN
463 adm(j1) = adm(j1) + xmsi - fourth*ms(i)
464 adm(j2) = adm(j2) + xmsi - fourth*ms(i)
465 adm(j3) = adm(j3) + xmsi - fourth*ms(i)
466 adm(j4) = adm(j4) + xmsi - fourth*ms(i)
467 ENDIF
468C
469 ms(j1)=ms(j1)+xmsi
470 ms(j2)=ms(j2)+xmsi
471 ms(j3)=ms(j3)+xmsi
472 ms(j4)=ms(j4)+xmsi
473C
474 IF (iroddl == 1) THEN
475 stf = (fourth*stifn(i)
476 . + det*max(mrx,mry,mrz)*(stifr(i)+stifn(i)*(xs*xs+ys*ys+zs*zs)))*weight(i)
477 ELSE
478 stf = (fourth*stifn(i)
479 . + det*max(mrx,mry,mrz)*(stifn(i)*(xs*xs+ys*ys+zs*zs)))*weight(i)
480 ENDIF
481C
482 stifn(j1)=stifn(j1) + stf
483 stifn(j2)=stifn(j2) + stf
484 stifn(j3)=stifn(j3) + stf
485 stifn(j4)=stifn(j4) + stf
486C
487 IF (iroddl==1) THEN
488 in(j1)=in(j1)+inx*fourth*(one-fact)
489 in(j2)=in(j2)+inx*fourth*(one-fact)
490 in(j3)=in(j3)+inx*fourth*(one-fact)
491 in(j4)=in(j4)+inx*fourth*(one-fact)
492 ENDIF
493C
494 IF(idel2/=0.AND.ms(i)/=0.)smass(ii)=ms(i)
495 ms(i)=zero
496 stifn(i)=em20
497C
498 IF (iroddl==1) THEN
499 IF(idel2/=0.AND.in(i)/=0.)siner(ii)=in(i)
500 in(i)=zero
501 stifr(i)=em20
502 ENDIF
503C
504 ENDIF
505C----
506 IF(i>0)THEN
507C--- output of tied contact forces
508 CALL i2forces(x ,fs ,fx ,fy ,fz ,
509 . irect(1,l),nir ,fsav ,fncont ,fncontp,
510 . ftcontp ,weight ,h3d_data,i ,h)
511 ENDIF
512C----
513 ENDDO
514C
515 ENDIF
516C
517C Traitement specifique pour ADM
518C
519 IF(anim_n(2)+outp_n(2)+h3d_data%N_SCAL_DMAS >0)THEN
520#include "vectorize.inc"
521 DO ii=1,nmn
522 j=msr(ii)
523 adm(j) = adm(j)/max(mmass(ii),em20)
524 ENDDO
525 ENDIF
526C
527C
528 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
i2forces
subroutine i2forces(x, fs, fx, fy, fz, irect, nir, fsav, fncont, fncontp, ftcontp, weight, h3d_data, nsl, h)
Definition i2forces.F:52
max
#define max(a, b)
Definition macros.h:21
h3d_mod
Definition h3d_mod.F:308