OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
sms_cjoint.F File Reference
#include "implicit_f.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "param_c.inc"
#include "task_c.inc"
#include "com08_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine sms_cjoint_0 (a, ar, v, vr, x, fsav, ljoint, ms, in, iadcj, fr_cj, cjwork, tag_lnk_sms, diag_sms, itask)
subroutine sms_cjoint_1 (a, ms, ljoint, iadcj, fr_cj, cjwork, idown, tag_lnk_sms, itask)
subroutine sms_cjoint_2 (a, ar, v, vr, x, ljoint, ms, in, iadcj, fr_cj, cjwork, tag_lnk_sms, itask)
subroutine sms_telesc_0 (a, ar, v, vr, x, fs, nod, ms, in, cjwork, diag_sms)
subroutine sms_telesc_1 (a, dms, nod, cjwork, idown)
subroutine sms_telesc_2 (a, ar, v, vr, x, nod, ms, in, cjwork)

Function/Subroutine Documentation

◆ sms_cjoint_0()

subroutine sms_cjoint_0 ( a,
ar,
v,
vr,
x,
fsav,
integer, dimension(*) ljoint,
ms,
in,
integer, dimension(nspmd+1,*) iadcj,
integer, dimension(*) fr_cj,
cjwork,
integer, dimension(*) tag_lnk_sms,
diag_sms,
integer itask )

Definition at line 32 of file sms_cjoint.F.

35C-----------------------------------------------
36C I m p l i c i t T y p e s
37C-----------------------------------------------
38#include "implicit_f.inc"
39C-----------------------------------------------
40C D u m m y A r g u m e n t s
41C-----------------------------------------------
42 INTEGER LJOINT(*), FR_CJ(*), IADCJ(NSPMD+1,*),
43 . TAG_LNK_SMS(*), ITASK
44 my_real
45 . a(3,numnod), ar(3,numnod), v(3,numnod), vr(3,numnod), x(3,numnod), fsav(nthvki,*),
46 . ms(*), in(*), cjwork(18,*), diag_sms(*)
47C-----------------------------------------------
48C C o m m o n B l o c k s
49C-----------------------------------------------
50#include "com01_c.inc"
51#include "com04_c.inc"
52#include "param_c.inc"
53#include "task_c.inc"
54C-----------------------------------------------
55C L o c a l V a r i a b l e s
56C-----------------------------------------------
57 INTEGER K, N, NN, KIND(NJOINT), ICSIZE
58C-----------------------------------------------
59C
60 IF(ispmd==0) THEN
61
62 k=1
63 DO n=1,njoint
64 kind(n) = k
65 k=k+ljoint(k)+1
66 END DO
67
68!$OMP DO
69 DO n=1,njoint
70 IF(tag_lnk_sms(n)==0) cycle
71 k = kind(n)
72 nn=ninter+nrwall+nrbody+nsect+n
73 CALL sms_telesc_0(a,ar,v,vr,x,fsav(1,nn),ljoint(k),ms,in,
74 . cjwork(1,n),diag_sms)
75 END DO
76!$OMP END DO
77
78 ENDIF
79
80 IF(nspmd>1)THEN
81C
82 CALL my_barrier
83C
84 IF(itask==0)THEN
85 icsize=0
86 DO n=1,njoint
87 IF(tag_lnk_sms(n)/=0)
88 . icsize=icsize+iadcj(nspmd+1,n)-iadcj(1,n)
89 END DO
90 CALL spmd_sd_cj_0(ar ,v ,vr ,ljoint,fr_cj,
91 2 iadcj,icsize,tag_lnk_sms)
92 END IF
93 END IF
94
95 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
sms_telesc_0
subroutine sms_telesc_0(a, ar, v, vr, x, fs, nod, ms, in, cjwork, diag_sms)
Definition sms_cjoint.F:245
spmd_sd_cj_0
subroutine spmd_sd_cj_0(ar, v, vr, ljoint, fr_cj, iadcj, icsize, tag_lnk_sms)
Definition spmd_sd_cj_0.F:34
my_barrier
subroutine my_barrier
Definition machine.F:31

◆ sms_cjoint_1()

subroutine sms_cjoint_1 ( a,
ms,
integer, dimension(*) ljoint,
integer, dimension(nspmd+1,*) iadcj,
integer, dimension(*) fr_cj,
cjwork,
integer idown,
integer, dimension(*) tag_lnk_sms,
integer itask )

Definition at line 106 of file sms_cjoint.F.

108C-----------------------------------------------
109C I m p l i c i t T y p e s
110C-----------------------------------------------
111#include "implicit_f.inc"
112C-----------------------------------------------
113C D u m m y A r g u m e n t s
114C-----------------------------------------------
115 INTEGER LJOINT(*), FR_CJ(*), IADCJ(NSPMD+1,*), IDOWN,
116 . TAG_LNK_SMS(*), ITASK
117C REAL
118 my_real
119 . a(3,*), ms(*), cjwork(18,*)
120C-----------------------------------------------
121C C o m m o n B l o c k s
122C-----------------------------------------------
123#include "com01_c.inc"
124#include "com04_c.inc"
125#include "task_c.inc"
126C-----------------------------------------------
127C L o c a l V a r i a b l e s
128C-----------------------------------------------
129 INTEGER K, N, KIND(NJOINT), ICSIZE
130C-----------------------------------------------
131C
132 IF(ispmd==0) THEN
133
134 k=1
135 DO n=1,njoint
136 kind(n) = k
137 k=k+ljoint(k)+1
138 END DO
139
140!$OMP DO
141 DO n=1,njoint
142 IF(tag_lnk_sms(n)==0) cycle
143 k = kind(n)
144 CALL sms_telesc_1(a,ms,ljoint(k),cjwork(1,n),idown)
145 END DO
146!$OMP END DO
147
148 ENDIF
149
150 IF(nspmd>1)THEN
151C
152 CALL my_barrier
153C
154 IF(itask==0)THEN
155 icsize=0
156 DO n=1,njoint
157 IF(tag_lnk_sms(n)/=0)
158 . icsize=icsize+iadcj(nspmd+1,n)-iadcj(1,n)
159 END DO
160 CALL spmd_sd_cj_1(a,ljoint,fr_cj,iadcj,icsize,tag_lnk_sms)
161 END IF
162 END IF
163
164 RETURN
sms_telesc_1
subroutine sms_telesc_1(a, dms, nod, cjwork, idown)
Definition sms_cjoint.F:488
spmd_sd_cj_1
subroutine spmd_sd_cj_1(a, ljoint, fr_cj, iadcj, icsize, tag_lnk_sms)
Definition spmd_sd_cj_1.F:35

◆ sms_cjoint_2()

subroutine sms_cjoint_2 ( a,
ar,
v,
vr,
x,
integer, dimension(*) ljoint,
ms,
in,
integer, dimension(nspmd+1,*) iadcj,
integer, dimension(*) fr_cj,
cjwork,
integer, dimension(*) tag_lnk_sms,
integer itask )

Definition at line 175 of file sms_cjoint.F.

178C-----------------------------------------------
179C I m p l i c i t T y p e s
180C-----------------------------------------------
181#include "implicit_f.inc"
182C-----------------------------------------------
183C D u m m y A r g u m e n t s
184C-----------------------------------------------
185 INTEGER LJOINT(*), FR_CJ(*), IADCJ(NSPMD+1,*),
186 . TAG_LNK_SMS(*), ITASK
187C REAL
188 my_real
189 . a(3,*), ar(3,*), v(3,*), vr(3,*), x(3,*),
190 . ms(*), in(*), cjwork(18,*)
191C-----------------------------------------------
192C C o m m o n B l o c k s
193C-----------------------------------------------
194#include "com01_c.inc"
195#include "com04_c.inc"
196#include "task_c.inc"
197C-----------------------------------------------
198C L o c a l V a r i a b l e s
199C-----------------------------------------------
200 INTEGER K, N, KIND(NJOINT), ICSIZE
201C-----------------------------------------------
202C
203 IF(ispmd==0) THEN
204
205 k=1
206 DO n=1,njoint
207 kind(n) = k
208 k=k+ljoint(k)+1
209 END DO
210
211!$OMP DO
212 DO n=1,njoint
213 IF(tag_lnk_sms(n)==0) cycle
214 k = kind(n)
215 CALL sms_telesc_2(a,ar,v,vr,x,ljoint(k),ms,in,
216 . cjwork(1,n))
217 END DO
218!$OMP END DO
219
220 ENDIF
221
222 IF(nspmd>1)THEN
223C
224 CALL my_barrier
225C
226 IF(itask==0)THEN
227 icsize=0
228 DO n=1,njoint
229 IF(tag_lnk_sms(n)/=0)
230 . icsize=icsize+iadcj(nspmd+1,n)-iadcj(1,n)
231 END DO
232 CALL spmd_sd_cj_1(a,ljoint,fr_cj,iadcj,icsize,tag_lnk_sms)
233 END IF
234 END IF
235
236 RETURN
sms_telesc_2
subroutine sms_telesc_2(a, ar, v, vr, x, nod, ms, in, cjwork)
Definition sms_cjoint.F:589

◆ sms_telesc_0()

subroutine sms_telesc_0 ( a,
ar,
v,
vr,
x,
fs,
integer, dimension(0:*) nod,
ms,
in,
cjwork,
diag_sms )

Definition at line 243 of file sms_cjoint.F.

245C-----------------------------------------------
246C I m p l i c i t T y p e s
247C-----------------------------------------------
248#include "implicit_f.inc"
249C-----------------------------------------------
250C D u m m y A r g u m e n t s
251C-----------------------------------------------
252 INTEGER NOD(0:*), IFLAG
253C REAL
254 my_real
255 . a(3,*), ar(3,*), v(3,*), vr(3,*), x(3,*), fs(*), ms(*),
256 . in(*), cjwork(*), diag_sms(*)
257CMasParINCLUDE 'telesc.intmap.inc'
258C-----------------------------------------------
259C C o m m o n B l o c k s
260C-----------------------------------------------
261#include "com08_c.inc"
262C-----------------------------------------------
263C L o c a l V a r i a b l e s
264C-----------------------------------------------
265 INTEGER NSN, NA, NB, I, N
266C REAL
267 my_real
268 . masse, iner, n1, n2, n3, s, ax, ay, az, axx, ayy, azz, vx,
269 . vy, vz, vxx, vyy, vzz, xcdg, ycdg, zcdg, xx, yy, zz, rr, a0,
270 . dmasse, vg(3), usdt, v0, dt05
271C-----------------------------------------------
272 nsn =nod(0)
273C----------------------------
274C DIRECTION LIBRE
275C----------------------------
276 na=nod(1)
277 nb=nod(2)
278 n1=x(1,nb)-x(1,na)
279 n2=x(2,nb)-x(2,na)
280 n3=x(3,nb)-x(3,na)
281 s=sqrt(n1**2+n2**2+n3**2)
282 n1=n1/s
283 n2=n2/s
284 n3=n3/s
285C
286 masse=zero
287 iner=zero
288C
289 ax= zero
290 ay= zero
291 az= zero
292C
293 axx= zero
294 ayy= zero
295 azz= zero
296C
297 xcdg=zero
298 ycdg=zero
299 zcdg=zero
300C----------------------------
301C CALCUL DU CDG + MASSE
302C----------------------------
303 DO 100 i=1,nsn
304 n = nod(i)
305 masse= masse+ms(n)
306 xcdg=xcdg+x(1,n)*ms(n)
307 ycdg=ycdg+x(2,n)*ms(n)
308 zcdg=zcdg+x(3,n)*ms(n)
309 100 CONTINUE
310C
311 IF (masse>zero) THEN
312 xcdg=xcdg/masse
313 ycdg=ycdg/masse
314 zcdg=zcdg/masse
315 ENDIF
316C----------------------------
317C CALCUL MOMENTS,INERTIE(PTS ALIGNES SUR N)
318C----------------------------
319 DO i=1,nsn
320 n = nod(i)
321C
322 xx=x(1,n)-xcdg
323 yy=x(2,n)-ycdg
324 zz=x(3,n)-zcdg
325C
326 rr=n1*xx+n2*yy+n3*zz
327 xx=n1*rr
328 yy=n2*rr
329 zz=n3*rr
330C
331 iner=iner+rr**2*diag_sms(n)+in(n)
332C INER=INER+RR**2*MS(N)+IN(N)
333C
334C Forces
335 ax= ax+a(1,n)
336 ay= ay+a(2,n)
337 az= az+a(3,n)
338C
339C Moments
340 axx= axx+ar(1,n)+yy*a(3,n)-zz*a(2,n)
341 ayy= ayy+ar(2,n)+zz*a(1,n)-xx*a(3,n)
342 azz= azz+ar(3,n)+xx*a(2,n)-yy*a(1,n)
343C
344 END DO
345C
346 a0=n1*ax+n2*ay+n3*az
347 ax=ax-n1*a0
348 ay=ay-n2*a0
349 az=az-n3*a0
350 a0=n1*axx+n2*ayy+n3*azz
351 axx=axx-n1*a0
352 ayy=ayy-n2*a0
353 azz=azz-n3*a0
354C
355 fs(1)=fs(1)+ax*dt12
356 fs(2)=fs(2)+ay*dt12
357 fs(3)=fs(3)+az*dt12
358 fs(4)=fs(4)+axx*dt12
359 fs(5)=fs(5)+ayy*dt12
360 fs(6)=fs(6)+azz*dt12
361C
362 IF (iner>zero) THEN
363 axx=axx/iner
364 ayy=ayy/iner
365 azz=azz/iner
366 ENDIF
367C----------------------------
368 cjwork(1)=n1
369 cjwork(2)=n2
370 cjwork(3)=n3
371C
372 cjwork(4)=axx
373 cjwork(5)=ayy
374 cjwork(6)=azz
375C
376 cjwork(7)=xcdg
377 cjwork(8)=ycdg
378 cjwork(9)=zcdg
379C
380 cjwork(10)=masse
381 cjwork(11)=iner
382C----------------------------
383C mvt de corps rigide autour de CDG (masse MASSE, inertie INER):
384C Extract V(t-1/2) and VR(t-1/2)
385C----------------------------
386 vx= zero
387 vy= zero
388 vz= zero
389C
390 vxx= zero
391 vyy= zero
392 vzz= zero
393C
394 DO i=1,nsn
395 n = nod(i)
396C
397 vx= vx+v(1,n)*ms(n)
398 vy= vy+v(2,n)*ms(n)
399 vz= vz+v(3,n)*ms(n)
400C
401 END DO
402C
403 a0=n1*vx+n2*vy+n3*vz
404 vx=vx-n1*a0
405 vy=vy-n2*a0
406 vz=vz-n3*a0
407C
408 IF (masse>zero) THEN
409 vx=vx/masse
410 vy=vy/masse
411 vz=vz/masse
412 ENDIF
413C
414 dt05=half*dt1
415 DO i=1,nsn
416 n = nod(i)
417C
418 xx=x(1,n)-xcdg-(v(1,n)-vx)*dt05
419 yy=x(2,n)-ycdg-(v(2,n)-vy)*dt05
420 zz=x(3,n)-zcdg-(v(3,n)-vz)*dt05
421C
422 rr=n1*xx+n2*yy+n3*zz
423 xx=n1*rr
424 yy=n2*rr
425 zz=n3*rr
426C
427 vxx= vxx+vr(1,n)*in(n)+yy*v(3,n)*ms(n)-zz*v(2,n)*ms(n)
428 vyy= vyy+vr(2,n)*in(n)+zz*v(1,n)*ms(n)-xx*v(3,n)*ms(n)
429 vzz= vzz+vr(3,n)*in(n)+xx*v(2,n)*ms(n)-yy*v(1,n)*ms(n)
430C
431 END DO
432C
433 a0=n1*vxx+n2*vyy+n3*vzz
434 vxx=vxx-n1*a0
435 vyy=vyy-n2*a0
436 vzz=vzz-n3*a0
437C
438 IF (iner>zero) THEN
439 vxx=vxx/iner
440 vyy=vyy/iner
441 vzz=vzz/iner
442 ENDIF
443C
444C store sum(diag_i)
445 dmasse=zero
446 DO i=1,nsn
447 n = nod(i)
448 dmasse= dmasse+diag_sms(n)
449 END DO
450C
451 cjwork(12)=vx
452 cjwork(13)=vy
453 cjwork(14)=vz
454C
455 cjwork(15)=vxx
456 cjwork(16)=vyy
457 cjwork(17)=vzz
458C
459 cjwork(18)=dmasse
460C----------------------------
461C CALCUL ACCELERATIONS DE ROTATION
462C----------------------------
463 vg(1)=vxx+axx*dt12
464 vg(2)=vyy+ayy*dt12
465 vg(3)=vzz+azz*dt12
466C
467 usdt = one/dt12
468C
469 DO i=1,nsn
470 n = nod(i)
471C
472 a0=n1*ar(1,n)+n2*ar(2,n)+n3*ar(3,n)
473 v0=n1*vr(1,n)+n2*vr(2,n)+n3*vr(3,n)
474 ar(1,n)= in(n)*(vg(1)-(vr(1,n)-n1*v0)) * usdt + n1*a0
475 ar(2,n)= in(n)*(vg(2)-(vr(2,n)-n2*v0)) * usdt + n2*a0
476 ar(3,n)= in(n)*(vg(3)-(vr(3,n)-n3*v0)) * usdt + n3*a0
477C
478 END DO
479C
480 RETURN

◆ sms_telesc_1()

subroutine sms_telesc_1 ( a,
dms,
integer, dimension(0:*) nod,
cjwork,
integer idown )

Definition at line 487 of file sms_cjoint.F.

488C-----------------------------------------------
489C I m p l i c i t T y p e s
490C-----------------------------------------------
491#include "implicit_f.inc"
492C-----------------------------------------------
493C D u m m y A r g u m e n t s
494C-----------------------------------------------
495 INTEGER NOD(0:*), IDOWN
496 my_real a(3,*), dms(*), cjwork(*)
497C-----------------------------------------------
498C L o c a l V a r i a b l e s
499C-----------------------------------------------
500 INTEGER NSN, NA, NB, I, N
501 my_real ax, ay, az, a0, n1, n2, n3, dmasse
502C-----------------------------------------------
503 nsn =nod(0)
504C----------------------------
505 n1=cjwork(1)
506 n2=cjwork(2)
507 n3=cjwork(3)
508 dmasse=cjwork(18)
509C----------------------------
510 SELECT CASE(idown)
511
512 CASE(0)
513C----------------------------
514C Remontee
515C----------------------------
516C
517 ax= zero
518 ay= zero
519 az= zero
520C
521C MONTE FORCES(PTS ALIGNES SUR N)
522 DO i=1,nsn
523 n = nod(i)
524C
525 ax= ax+a(1,n)
526 ay= ay+a(2,n)
527 az= az+a(3,n)
528C
529 END DO
530C
531 a0=n1*ax+n2*ay+n3*az
532 ax=ax-n1*a0
533 ay=ay-n2*a0
534 az=az-n3*a0
535C
536C transmet force au 1er nd
537 n = nod(1)
538 a0=n1*a(1,n)+n2*a(2,n)+n3*a(3,n)
539 a(1,n)=ax+n1*a0
540 a(2,n)=ay+n2*a0
541 a(3,n)=az+n3*a0
542 DO i=2,nsn
543 n = nod(i)
544 a0=n1*a(1,n)+n2*a(2,n)+n3*a(3,n)
545 a(1,n)=n1*a0
546 a(2,n)=n2*a0
547 a(3,n)=n3*a0
548 END DO
549C----------------------------
550C Redescente
551C----------------------------
552C
553 CASE(1)
554C
555
556 n = nod(1)
557C
558 a0=n1*a(1,n)+n2*a(2,n)+n3*a(3,n)
559 ax= dms(n)*(a(1,n)-n1*a0)
560 ay= dms(n)*(a(2,n)-n2*a0)
561 az= dms(n)*(a(3,n)-n3*a0)
562C
563 IF (dmasse>zero) THEN
564 ax=ax/dmasse
565 ay=ay/dmasse
566 az=az/dmasse
567 ENDIF
568C
569 DO i=1,nsn
570 n = nod(i)
571C
572 a0=n1*a(1,n)+n2*a(2,n)+n3*a(3,n)
573 a(1,n)=ax+n1*a0
574 a(2,n)=ay+n2*a0
575 a(3,n)=az+n3*a0
576 END DO
577
578 END SELECT
579
580 RETURN

◆ sms_telesc_2()

subroutine sms_telesc_2 ( a,
ar,
v,
vr,
x,
integer, dimension(0:*) nod,
ms,
in,
cjwork )

Definition at line 587 of file sms_cjoint.F.

589C-----------------------------------------------
590C I m p l i c i t T y p e s
591C-----------------------------------------------
592#include "implicit_f.inc"
593C-----------------------------------------------
594C D u m m y A r g u m e n t s
595C-----------------------------------------------
596 INTEGER NOD(0:*)
597 my_real a(3,*), ar(3,*), v(3,*), vr(3,*), x(3,*), ms(*),in(*), cjwork(*)
598C-----------------------------------------------
599C C o m m o n B l o c k s
600C-----------------------------------------------
601#include "com08_c.inc"
602C-----------------------------------------------
603C L o c a l V a r i a b l e s
604C-----------------------------------------------
605 INTEGER NSN, NA, NB, I, N
606 my_real
607 . n1, n2, n3, ax, ay, az, axx, ayy, azz,
608 . xcdg, ycdg, zcdg, xx, yy, zz, rr, a0,
609 . vx, vy, vz, vxx, vyy, vzz, v0,
610 . vg(3), v1x2, v2x1, v2x3, v3x2, v3x1, v1x3, usdt, vx1, vx2, vx3
611C-----------------------------------------------
612 nsn =nod(0)
613C----------------------------
614 n1=cjwork(1)
615 n2=cjwork(2)
616 n3=cjwork(3)
617C
618 axx= cjwork(4)
619 ayy= cjwork(5)
620 azz= cjwork(6)
621C
622 xcdg=cjwork(7)
623 ycdg=cjwork(8)
624 zcdg=cjwork(9)
625C
626 vx=cjwork(12)
627 vy=cjwork(13)
628 vz=cjwork(14)
629C
630 vxx=cjwork(15)
631 vyy=cjwork(16)
632 vzz=cjwork(17)
633C
634 vg(1)=vxx+axx*dt12
635 vg(2)=vyy+ayy*dt12
636 vg(3)=vzz+azz*dt12
637C----------------------------
638 n = nod(1)
639 ax=a(1,n)
640 ay=a(2,n)
641 az=a(3,n)
642C
643 a0=n1*a(1,n)+n2*a(2,n)+n3*a(3,n)
644 ax=ax-n1*a0
645 ay=ay-n2*a0
646 az=az-n3*a0
647C----------------------------
648C CALCUL ACCELERATIONS
649C----------------------------
650 usdt = one/dt12
651C
652 DO i=1,nsn
653 n = nod(i)
654C
655 xx=x(1,n)-xcdg
656 yy=x(2,n)-ycdg
657 zz=x(3,n)-zcdg
658C
659 rr=n1*xx+n2*yy+n3*zz
660 xx=n1*rr
661 yy=n2*rr
662 zz=n3*rr
663C
664 v1x2=vg(1)*yy
665 v2x1=vg(2)*xx
666 v2x3=vg(2)*zz
667 v3x2=vg(3)*yy
668 v3x1=vg(3)*xx
669 v1x3=vg(1)*zz
670C
671 vx1=v2x3-v3x2
672 vx2=v3x1-v1x3
673 vx3=v1x2-v2x1
674C
675 a0=n1*a(1,n)+n2*a(2,n)+n3*a(3,n)
676 v0=n1*v(1,n)+n2*v(2,n)+n3*v(3,n)
677 a(1,n)=ax
678 . +(vx+vx1+half*dt2*(vg(2)*vx3-vg(3)*vx2)-(v(1,n)-n1*v0))*usdt
679 . +n1*a0
680 a(2,n)=ay
681 . +(vy+vx2+half*dt2*(vg(3)*vx1-vg(1)*vx3)-(v(2,n)-n2*v0))*usdt
682 . +n2*a0
683 a(3,n)=az
684 . +(vz+vx3+half*dt2*(vg(1)*vx2-vg(2)*vx1)-(v(3,n)-n3*v0))*usdt
685 . +n3*a0
686C
687 END DO
688C
689 RETURN