OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i2_imp2.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23!||====================================================================
24!|| int2_imp2 ../engine/source/interfaces/interf/i2_imp2.F
25!||--- called by ------------------------------------------------------
26!|| i2_impd ../engine/source/interfaces/interf/i2_impd.F
27!||--- calls -----------------------------------------------------
28!|| i2recu0 ../engine/source/interfaces/interf/i2_imp2.F
29!|| i2recu1 ../engine/source/interfaces/interf/i2_imp2.F
30!|| i2recu2 ../engine/source/interfaces/interf/i2_imp2.F
31!||--- uses -----------------------------------------------------
32!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
33!||====================================================================
34 SUBROUTINE int2_imp2(IPARI,INTBUF_TAB,X ,
35 . MS ,IN ,WEIGHT ,NDOF ,D ,DR )
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
90 END
91!||====================================================================
92!|| i2recu0 ../engine/source/interfaces/interf/i2_imp2.F
93!||--- called by ------------------------------------------------------
94!|| int2_imp2 ../engine/source/interfaces/interf/i2_imp2.F
95!||--- calls -----------------------------------------------------
96!|| velrot ../engine/source/constraints/general/rbe2/rbe2v.F
97!|| zero1 ../engine/source/system/zero.F
98!||====================================================================
99 SUBROUTINE i2recu0(NSN,NMN,IRECT,CRST,MSR ,
100 1 NSV,IRTL,MS ,X ,WEIGHT,
101 2 NDOF, D ,DR )
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
214 END
215!||====================================================================
216!|| i2recu1 ../engine/source/interfaces/interf/i2_imp2.F
217!||--- called by ------------------------------------------------------
218!|| int2_imp2 ../engine/source/interfaces/interf/i2_imp2.F
219!||--- calls -----------------------------------------------------
220!|| i2matc ../engine/source/interfaces/interf/i2_imp1.F
221!||====================================================================
222 SUBROUTINE i2recu1(NSN,NMN,IRECT,DPARA,MSR ,
223 1 NSV,IRTL,MS ,X ,WEIGHT,
224 2 NDOF, D ,DR )
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
277 END
278!||====================================================================
279!|| i2recu2 ../engine/source/interfaces/interf/i2_imp2.F
280!||--- called by ------------------------------------------------------
281!|| int2_imp2 ../engine/source/interfaces/interf/i2_imp2.F
282!||--- calls -----------------------------------------------------
283!|| i2matc ../engine/source/interfaces/interf/i2_imp1.F
284!|| velrot ../engine/source/constraints/general/rbe2/rbe2v.F
285!|| zero1 ../engine/source/system/zero.F
286!||====================================================================
287 SUBROUTINE i2recu2(NSN,NMN,IRECT,DPARA,MSR ,
288 1 NSV,IRTL,MS ,X ,WEIGHT,
289 2 NDOF, D ,DR )
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
375 END
376!||====================================================================
377!|| i2_frrd1 ../engine/source/interfaces/interf/i2_imp2.F
378!||--- called by ------------------------------------------------------
379!|| fr_u2dd ../engine/source/mpi/implicit/imp_fri.F
380!|| imp3_u2x ../engine/source/airbag/monv_imp0.F
381!||====================================================================
382 SUBROUTINE i2_frrd1(X ,IRECT,DPARA ,NSV ,IRTL ,
383 1 D ,II )
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
469 END
470!||====================================================================
471!|| i2_frrd0 ../engine/source/interfaces/interf/i2_imp2.F
472!||--- called by ------------------------------------------------------
473!|| fr_u2dd ../engine/source/mpi/implicit/imp_fri.F
474!|| imp3_u2x ../engine/source/airbag/monv_imp0.F
475!||====================================================================
476 SUBROUTINE i2_frrd0(X ,IRECT,CRST ,NSV ,IRTL ,
477 1 D ,DR ,II ,NDOF )
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
558 END
#define my_real
Definition cppsort.cpp:32
subroutine zero1(r, n)
subroutine i2matc(nsn, irect, dpara, nsv, irtl, x, niri, rj, rjt)
Definition i2_imp1.F:1199
subroutine i2recu0(nsn, nmn, irect, crst, msr, nsv, irtl, ms, x, weight, ndof, d, dr)
Definition i2_imp2.F:102
subroutine int2_imp2(ipari, intbuf_tab, x, ms, in, weight, ndof, d, dr)
Definition i2_imp2.F:36
subroutine i2_frrd0(x, irect, crst, nsv, irtl, d, dr, ii, ndof)
Definition i2_imp2.F:478
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
subroutine i2_frrd1(x, irect, dpara, nsv, irtl, d, ii)
Definition i2_imp2.F:384
#define min(a, b)
Definition macros.h:20
#define max(a, b)
Definition macros.h:21
initmumps id
subroutine velrot(vrm, lsm, vs)
Definition rbe2v.F:1119
character *2 function nl()
Definition message.F:2354