OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i2_imp2.F File Reference
#include "implicit_f.inc"
#include "impl1_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine int2_imp2 (ipari, intbuf_tab, x, ms, in, weight, ndof, d, dr)
subroutine i2recu0 (nsn, nmn, irect, crst, msr, nsv, irtl, ms, x, weight, ndof, d, dr)
subroutine i2recu1 (nsn, nmn, irect, dpara, msr, nsv, irtl, ms, x, weight, ndof, d, dr)
subroutine i2recu2 (nsn, nmn, irect, dpara, msr, nsv, irtl, ms, x, weight, ndof, d, dr)
subroutine i2_frrd1 (x, irect, dpara, nsv, irtl, d, ii)
subroutine i2_frrd0 (x, irect, crst, nsv, irtl, d, dr, ii, ndof)

Function/Subroutine Documentation

◆ i2_frrd0()

subroutine i2_frrd0 ( x,
integer, dimension(4,*) irect,
crst,
integer, dimension(*) nsv,
integer, dimension(*) irtl,
d,
dr,
integer ii,
integer, dimension(*) ndof )

Definition at line 476 of file i2_imp2.F.

478C-----------------------------------------------
479C I m p l i c i t T y p e s
480C-----------------------------------------------
481#include "implicit_f.inc"
482C-----------------------------------------------
483C D u m m y A r g u m e n t s
484C-----------------------------------------------
485 INTEGER
486 . IRECT(4,*), NSV(*), IRTL(*), II,NDOF(*)
487C REAL
488 my_real
489 . x(3,*),d(3,*),dr(3,*), crst(2,*)
490C-----------------------------------------------
491C L o c a l V a r i a b l e s
492C-----------------------------------------------
493 INTEGER NIR, I, J, J1, J2, J3, J4, K, JD, L, JJ,
494 . I1,ID,NL,NJ,ND
495C REAL
496 my_real
497 . h(4), ss, tt, sp,sm,tp,tm,dr1(3),xs,ys,zs,xs0,ys0,zs0
498C-----------------------------------------------
499 nir=4
500 i=nsv(ii)
501 l=irtl(ii)
502C
503 ss=crst(1,ii)
504 tt=crst(2,ii)
505 sp=one + ss
506 sm=one - ss
507 tp=fourth*(one + tt)
508 tm=fourth*(one - tt)
509 h(1)=tm*sm
510 h(2)=tm*sp
511 h(3)=tp*sp
512 h(4)=tp*sm
513 nd = 0
514 DO j=1,nir
515 nj=irect(j,l)
516 nd = max(nd,ndof(nj))
517 ENDDO
518C-------NDOF(M)> 3 comme rigid body---
519 IF (nd==6) THEN
520 xs0=zero
521 ys0=zero
522 zs0=zero
523 DO j=1,nir
524 nj=irect(j,l)
525 xs0=xs0+x(1,nj)*h(j)
526 ys0=ys0+x(2,nj)*h(j)
527 zs0=zs0+x(3,nj)*h(j)
528 ENDDO
529 xs=x(1,i)-xs0
530 ys=x(2,i)-ys0
531 zs=x(3,i)-zs0
532 ENDIF
533C-------Update K(main node),B---
534 DO k =1,3
535 d(k,i)=zero
536 ENDDO
537 DO j=1,nir
538 nj=irect(j,l)
539 DO k =1,3
540 d(k,i)=d(k,i)+h(j)*d(k,nj)
541 ENDDO
542 ENDDO
543 IF (nd==6) THEN
544 DO k =1,3
545 dr1(k)=zero
546 ENDDO
547 DO j=1,nir
548 DO k =1,3
549 dr1(k)=dr1(k)+h(j)*dr(k,nj)
550 ENDDO
551 ENDDO
552 d(1,i)=d(1,i)+zs*dr1(2)-ys*dr1(3)
553 d(2,i)=d(2,i)-zs*dr1(1)+xs*dr1(3)
554 d(3,i)=d(3,i)+ys*dr1(1)-xs*dr1(2)
555 ENDIF
556C
557 RETURN
#define my_real
Definition cppsort.cpp:32
#define max(a, b)
Definition macros.h:21

◆ i2_frrd1()

subroutine i2_frrd1 ( x,
integer, dimension(4,*) irect,
dpara,
integer, dimension(*) nsv,
integer, dimension(*) irtl,
d,
integer ii )

Definition at line 382 of file i2_imp2.F.

384C-----------------------------------------------
385C I m p l i c i t T y p e s
386C-----------------------------------------------
387#include "implicit_f.inc"
388C-----------------------------------------------
389C D u m m y A r g u m e n t s
390C-----------------------------------------------
391 INTEGER
392 . IRECT(4,*), NSV(*), IRTL(*),II
393C REAL
394 my_real
395 . d(3,*),x(3,*),dpara(7,*)
396C-----------------------------------------------
397C L o c a l V a r i a b l e s
398C-----------------------------------------------
399 INTEGER I, J, J1,J2,J3,J4, L, JJ
400C REAL
401 my_real
402 . vmx, vmy, vmz,mgx,mgy,mgz,vrx,vry,vrz,
403 . x0,x1,x2,x3,x4,xs,y0,y1,y2,y3,y4,ys,z0,z1,
404 . z2,z3,z4,zs,a1,a2,a3,b1,b2,b3,c1,c2,c3,det
405C-----------------------------------------------
406 i=nsv(ii)
407 l=irtl(ii)
408 j1=irect(1,l)
409 j2=irect(2,l)
410 j3=irect(3,l)
411 j4=irect(4,l)
412 x1=x(1,j1)
413 y1=x(2,j1)
414 z1=x(3,j1)
415 x2=x(1,j2)
416 y2=x(2,j2)
417 z2=x(3,j2)
418 x3=x(1,j3)
419 y3=x(2,j3)
420 z3=x(3,j3)
421 x4=x(1,j4)
422 y4=x(2,j4)
423 z4=x(3,j4)
424 x0=fourth*(x1+x2+x3+x4)
425 y0=fourth*(y1+y2+y3+y4)
426 z0=fourth*(z1+z2+z3+z4)
427 x1=x1-x0
428 y1=y1-y0
429 z1=z1-z0
430 x2=x2-x0
431 y2=y2-y0
432 z2=z2-z0
433 x3=x3-x0
434 y3=y3-y0
435 z3=z3-z0
436 x4=x4-x0
437 y4=y4-y0
438 z4=z4-z0
439 xs=x(1,i)-x0
440 ys=x(2,i)-y0
441 zs=x(3,i)-z0
442C
443 det=dpara(1,ii)
444 b1=dpara(2,ii)
445 b2=dpara(3,ii)
446 b3=dpara(4,ii)
447 c1=dpara(5,ii)
448 c2=dpara(6,ii)
449 c3=dpara(7,ii)
450C
451 vmx=fourth*(d(1,j1)+d(1,j2)+d(1,j3)+d(1,j4))
452 vmy=fourth*(d(2,j1)+d(2,j2)+d(2,j3)+d(2,j4))
453 vmz=fourth*(d(3,j1)+d(3,j2)+d(3,j3)+d(3,j4))
454C
455 mgx = y1*d(3,j1) + y2*d(3,j2) + y3*d(3,j3) + y4*d(3,j4)
456 . - z1*d(2,j1) - z2*d(2,j2) - z3*d(2,j3) - z4*d(2,j4)
457 mgy = z1*d(1,j1) + z2*d(1,j2) + z3*d(1,j3) + z4*d(1,j4)
458 . - x1*d(3,j1) - x2*d(3,j2) - x3*d(3,j3) - x4*d(3,j4)
459 mgz = x1*d(2,j1) + x2*d(2,j2) + x3*d(2,j3) + x4*d(2,j4)
460 . - y1*d(1,j1) - y2*d(1,j2) - y3*d(1,j3) - y4*d(1,j4)
461 vrx=det*(mgx*b1+mgy*c3+mgz*c2)
462 vry=det*(mgy*b2+mgz*c1+mgx*c3)
463 vrz=det*(mgz*b3+mgx*c2+mgy*c1)
464 d(1,i)=vmx + vry*zs - vrz*ys
465 d(2,i)=vmy + vrz*xs - vrx*zs
466 d(3,i)=vmz + vrx*ys - vry*xs
467C
468 RETURN

◆ i2recu0()

subroutine i2recu0 ( integer nsn,
integer nmn,
integer, dimension(4,*) irect,
crst,
integer, dimension(*) msr,
integer, dimension(*) nsv,
integer, dimension(*) irtl,
ms,
x,
integer, dimension(*) weight,
integer, dimension(*) ndof,
d,
dr )

Definition at line 99 of file i2_imp2.F.

102C-----------------------------------------------
103C I m p l i c i t T y p e s
104C-----------------------------------------------
105#include "implicit_f.inc"
106#include "impl1_c.inc"
107C-----------------------------------------------
108C D u m m y A r g u m e n t s
109C-----------------------------------------------
110 INTEGER NSN, NMN,NDOF(*),
111 . IRECT(4,*), MSR(*), NSV(*), IRTL(*),WEIGHT(*)
112C REAL
113 my_real
114 . crst(2,*), d(3,*),ms(*),dr(3,*),x(3,*)
115C-----------------------------------------------
116C L o c a l V a r i a b l e s
117C-----------------------------------------------
118 INTEGER NIR, I, J, J1, J2, J3, J4, K, JD, II, L, JJ,
119 . I1,ID,NL,NJ,ND
120C REAL
121 my_real
122 . h(4), ss, tt, sp,sm,tp,tm,dr1(3),xs,ys,zs,xs0,ys0,zs0,nun,
123 . ds(3), lsm(3)
124C------------------------------------
125C VITESSES DES NOEUDS SECONDS
126C------------------------------------
127C-------pour simplement etre coherent avec INTTI2, on ne distinque pas 3n,4n
128 nun=-one
129 DO ii=1,nsn
130 i=nsv(ii)
131 l=irtl(ii)
132C
133 ss=crst(1,ii)
134 tt=crst(2,ii)
135 ss = min(one,ss)
136 tt = min(one,tt)
137 ss = max(nun,ss)
138 tt = max(nun,tt)
139 sp=one + ss
140 sm=one - ss
141 IF (irect(3,l)==irect(4,l)) THEN
142 nir=3
143 tp=third*(one + tt)
144 tm=third*(one - tt)
145 h(1)=tm*sm
146 h(2)=tm*sp
147 h(3)=one-h(1)-h(2)
148 ELSE
149 nir=4
150 tp=fourth*(one + tt)
151 tm=fourth*(one - tt)
152 h(1)=tm*sm
153 h(2)=tm*sp
154 h(3)=tp*sp
155 h(4)=tp*sm
156 ENDIF
157 nd = 0
158 DO j=1,nir
159 nj=irect(j,l)
160 nd = max(nd,ndof(nj))
161 ENDDO
162C-------NDOF(M)> 3 comme rigid body---
163 IF (nd==6) THEN
164 xs0=zero
165 ys0=zero
166 zs0=zero
167 DO j=1,nir
168 nj=irect(j,l)
169 xs0=xs0+x(1,nj)*h(j)
170 ys0=ys0+x(2,nj)*h(j)
171 zs0=zs0+x(3,nj)*h(j)
172 ENDDO
173 xs=x(1,i)-xs0
174 ys=x(2,i)-ys0
175 zs=x(3,i)-zs0
176 ENDIF
177 DO k =1,3
178 d(k,i)=zero
179 ENDDO
180 DO j=1,nir
181 nj=irect(j,l)
182 DO k =1,3
183 d(k,i)=d(k,i)+h(j)*d(k,nj)
184 ENDDO
185 ENDDO
186 IF (nd==6) THEN
187 DO k =1,3
188 dr(k,i)=zero
189 ENDDO
190 DO j=1,nir
191 nj=irect(j,l)
192 DO k =1,3
193 dr(k,i)=dr(k,i)+h(j)*dr(k,nj)
194 ENDDO
195 ENDDO
196 IF( imp_lr > 0)THEN
197 CALL zero1(ds,3)
198 lsm(1) = xs
199 lsm(2) = ys
200 lsm(3) = zs
201 CALL velrot(dr(1,i),lsm,ds)
202 DO k = 1 , 3
203 d(k,i) = d(k,i) + ds(k)
204 END DO
205 ELSE
206 d(1,i)=d(1,i)+zs*dr(2,i)-ys*dr(3,i)
207 d(2,i)=d(2,i)-zs*dr(1,i)+xs*dr(3,i)
208 d(3,i)=d(3,i)+ys*dr(1,i)-xs*dr(2,i)
209 END IF
210 ENDIF
211 ENDDO
212C
213 RETURN
subroutine zero1(r, n)
#define min(a, b)
Definition macros.h:20
subroutine velrot(vrm, lsm, vs)
Definition rbe2v.F:1119

◆ i2recu1()

subroutine i2recu1 ( integer nsn,
integer nmn,
integer, dimension(4,*) irect,
dpara,
integer, dimension(*) msr,
integer, dimension(*) nsv,
integer, dimension(*) irtl,
ms,
x,
integer, dimension(*) weight,
integer, dimension(*) ndof,
d,
dr )

Definition at line 222 of file i2_imp2.F.

225C-----------------------------------------------
226C I m p l i c i t T y p e s
227C-----------------------------------------------
228#include "implicit_f.inc"
229C-----------------------------------------------
230C D u m m y A r g u m e n t s
231C-----------------------------------------------
232 INTEGER NSN, NMN,NDOF(*),
233 . IRECT(4,*), MSR(*), NSV(*), IRTL(*),WEIGHT(*)
234C REAL
235 my_real
236 . dpara(7,*), d(3,*),ms(*),dr(3,*),x(3,*)
237C-----------------------------------------------
238C L o c a l V a r i a b l e s
239C-----------------------------------------------
240 INTEGER I, J, K, II, L, NIR(NSN),NJ
241C REAL
242 my_real
243 . rj(3,3,4,nsn),rjt(3,3,4,nsn)
244C------------------------------------
245C VITESSES DES NOEUDS SECONDS
246C------------------------------------
247 CALL i2matc(nsn,irect,dpara,nsv,irtl,x ,
248 1 nir,rj ,rjt )
249 DO ii=1,nsn
250 i=nsv(ii)
251 l=irtl(ii)
252 DO k =1,3
253 d(k,i)=zero
254 ENDDO
255 IF (ndof(i)>3) THEN
256 DO k =1,3
257 dr(k,i)=zero
258 ENDDO
259 ENDIF
260 DO j=1,nir(ii)
261 nj=irect(j,l)
262C-------recupere salve dis : in function of main's translation--
263 DO k=1,3
264 d(k,i)=d(k,i)+rjt(k,1,j,ii)*d(1,nj)+
265 . rjt(k,2,j,ii)*d(2,nj)+rjt(k,3,j,ii)*d(3,nj)
266 ENDDO
267 IF (ndof(i)>3) THEN
268 DO k=1,3
269 dr(k,i)=dr(k,i)+rj(k,1,j,ii)*d(1,nj)+
270 . rj(k,2,j,ii)*d(2,nj)+rj(k,3,j,ii)*d(3,nj)
271 ENDDO
272 ENDIF
273 ENDDO
274 ENDDO
275C
276 RETURN
subroutine i2matc(nsn, irect, dpara, nsv, irtl, x, niri, rj, rjt)
Definition i2_imp1.F:1199

◆ i2recu2()

subroutine i2recu2 ( integer nsn,
integer nmn,
integer, dimension(4,*) irect,
dpara,
integer, dimension(*) msr,
integer, dimension(*) nsv,
integer, dimension(*) irtl,
ms,
x,
integer, dimension(*) weight,
integer, dimension(*) ndof,
d,
dr )

Definition at line 287 of file i2_imp2.F.

290C-----------------------------------------------
291C I m p l i c i t T y p e s
292C-----------------------------------------------
293#include "implicit_f.inc"
294C-----------------------------------------------
295C D u m m y A r g u m e n t s
296C-----------------------------------------------
297 INTEGER NSN, NMN,NDOF(*),
298 . IRECT(4,*), MSR(*), NSV(*), IRTL(*),WEIGHT(*)
299C REAL
300 my_real
301 . dpara(7,*), d(3,*),ms(*),dr(3,*),x(3,*)
302C-----------------------------------------------
303C L o c a l V a r i a b l e s
304C-----------------------------------------------
305 INTEGER I, J, K, II, L, NIR(NSN),NJ,NIRI
306C REAL
307 my_real
308 . rj(3,3,4,nsn),rjt(3,3,4,nsn),facm,x0,y0,z0,
309 . lsm(3),dr2(3),ds(3),xm(4),ym(4),zm(4),dt(3)
310C------------------------------------
311C VITESSES DES NOEUDS SECONDS
312C------------------------------------
313 CALL i2matc(nsn,irect,dpara,nsv,irtl,x ,
314 1 nir,rj ,rjt )
315 DO ii=1,nsn
316 i=nsv(ii)
317 l=irtl(ii)
318 niri=4
319 DO j=1,niri
320 nj=irect(j,l)
321 xm(j)=x(1,nj)
322 ym(j)=x(2,nj)
323 zm(j)=x(3,nj)
324 ENDDO
325 IF(irect(3,l)==irect(4,l)) THEN
326 niri=3
327 xm(4)=zero
328 ym(4)=zero
329 zm(4)=zero
330 ENDIF
331 facm = one / niri
332C----------------------------------------------------
333C VITESSE DE ROTATION MOYENNE DU SEGMENT MAIN
334C----------------------------------------------------
335 x0=facm*(xm(1)+xm(2)+xm(3)+xm(4))
336 y0=facm*(ym(1)+ym(2)+ym(3)+ym(4))
337 z0=facm*(zm(1)+zm(2)+zm(3)+zm(4))
338 lsm(1)=x(1,i)-x0
339 lsm(2)=x(2,i)-y0
340 lsm(3)=x(3,i)-z0
341 DO k =1,3
342 d(k,i)=zero
343 ENDDO
344 IF (ndof(i)>3) THEN
345 DO k =1,3
346 dr(k,i)=zero
347 ENDDO
348 ENDIF
349 call zero1(dr2,3)
350 call zero1(dt,3)
351 DO j=1,nir(ii)
352 nj=irect(j,l)
353C-------recupere salve dis : in function of main's translation--
354 DO k=1,3
355 dr2(k)=dr2(k)+rj(k,1,j,ii)*d(1,nj)+
356 . rj(k,2,j,ii)*d(2,nj)+rj(k,3,j,ii)*d(3,nj)
357 dt(k) = dt(k) + facm*d(k,nj)
358 END DO
359
360 IF (ndof(i)>3) THEN
361 DO k=1,3
362 dr(k,i)=dr(k,i)+rj(k,1,j,ii)*d(1,nj)+
363 . rj(k,2,j,ii)*d(2,nj)+rj(k,3,j,ii)*d(3,nj)
364 ENDDO
365 ENDIF
366 ENDDO
367 CALL velrot(dr2,lsm,ds)
368 DO k=1,3
369 d(k,i)=d(k,i)+ ds(k)+ dt(k)
370 ENDDO
371
372 ENDDO
373C
374 RETURN

◆ int2_imp2()

subroutine int2_imp2 ( integer, dimension(*) ipari,
type(intbuf_struct_) intbuf_tab,
x,
ms,
in,
integer, dimension(*) weight,
integer, dimension(*) ndof,
d,
dr )

Definition at line 34 of file i2_imp2.F.

36C-----------------------------------------------
37C M o d u l e s
38C-----------------------------------------------
39 USE intbufdef_mod
40C-----------------------------------------------
41C I m p l i c i t T y p e s
42C-----------------------------------------------
43#include "implicit_f.inc"
44#include "impl1_c.inc"
45C-----------------------------------------------
46C D u m m y A r g u m e n t s
47C-----------------------------------------------
48 INTEGER IPARI(*),NDOF(*), WEIGHT(*)
49C REAL
51 . x(*),ms(*),in(*),d(3,*),dr(3,*)
52
53 TYPE(INTBUF_STRUCT_) INTBUF_TAB
54C-----------------------------------------------
55C L o c a l V a r i a b l e s
56C-----------------------------------------------
57 integer
58 . nsn,nmn,nrts,nrtm,ilev
59C-----------------------------------------------
60 nrts =ipari(3)
61 nrtm =ipari(4)
62 nsn =ipari(5)
63 nmn =ipari(6)
64 ilev =ipari(20)
65C
66C version spmd avec plus d'un proc nsn = nsn_loc & nmn = nmn_loc
67 IF(ilev==1)THEN
68 if( imp_lr > 0)THEN
69 CALL i2recu2(nsn ,nmn ,intbuf_tab%IRECTM,
70 1 intbuf_tab%DPARA,intbuf_tab%MSR,intbuf_tab%NSV,
71 . intbuf_tab%IRTLM,
72 2 ms ,x ,weight ,ndof ,
73 3 d ,dr )
74 ELSE
75 CALL i2recu1(nsn ,nmn ,intbuf_tab%IRECTM,
76 1 intbuf_tab%DPARA,intbuf_tab%MSR,intbuf_tab%NSV,
77 . intbuf_tab%IRTLM,
78 2 ms ,x ,weight ,ndof ,
79 3 d ,dr )
80 END IF
81 ELSE
82 CALL i2recu0(nsn ,nmn ,intbuf_tab%IRECTM,
83 1 intbuf_tab%CSTS,intbuf_tab%MSR,intbuf_tab%NSV,
84 . intbuf_tab%IRTLM,
85 2 ms ,x ,weight ,ndof ,
86 3 d ,dr )
87 ENDIF
88C
89 RETURN
subroutine i2recu0(nsn, nmn, irect, crst, msr, nsv, irtl, ms, x, weight, ndof, d, dr)
Definition i2_imp2.F:102
subroutine i2recu2(nsn, nmn, irect, dpara, msr, nsv, irtl, ms, x, weight, ndof, d, dr)
Definition i2_imp2.F:290
subroutine i2recu1(nsn, nmn, irect, dpara, msr, nsv, irtl, ms, x, weight, ndof, d, dr)
Definition i2_imp2.F:225