OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
rgwal0.F File Reference
#include "implicit_f.inc"
#include "comlock.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "param_c.inc"
#include "task_c.inc"
#include "impl1_c.inc"
#include "scr03_c.inc"
#include "com08_c.inc"
#include "sms_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine rgwal0 (x, a, v, rwbuf, lprw, nprw, ms, fsav, fr_wall, fopt, rwsav, weight, frwl6, nodnx_sms, weight_md, dimfb, fbsav6, stabsen, tabsensor, wfext, wfext_md)
subroutine rgwal0_imp (x, d, v, rwbuf, lprw, nprw, ms, fsav, fr_wall, fopt, rwsav, weight, fsavd, nt_rw, iddl, ikc, icomv, ndof, frwl6, weight_md, dimfb, fbsav6, stabsen, tabsensor, wfext, wfext_md)
subroutine rgwalf (a, rwbuf, nprw, ms)
subroutine rgwalt (msr, rwl, frwl6, pmain, fsav, fopt, fbsav6, iparsens)

Function/Subroutine Documentation

◆ rgwal0()

subroutine rgwal0 ( x,
a,
v,
rwbuf,
integer, dimension(*) lprw,
integer, dimension(*) nprw,
ms,
fsav,
integer, dimension(nspmd+2,*) fr_wall,
fopt,
rwsav,
integer, dimension(*) weight,
double precision, dimension(7,6,nrwall) frwl6,
integer, dimension(*) nodnx_sms,
integer, dimension(*) weight_md,
integer dimfb,
double precision, dimension(12,6,dimfb) fbsav6,
integer stabsen,
integer, dimension(*) tabsensor,
double precision, intent(inout) wfext,
double precision, intent(inout) wfext_md )

Definition at line 36 of file rgwal0.F.

40C-----------------------------------------------
41C I m p l i c i t T y p e s
42C-----------------------------------------------
43#include "implicit_f.inc"
44#include "comlock.inc"
45C-----------------------------------------------
46C C o m m o n B l o c k s
47C-----------------------------------------------
48#include "com01_c.inc"
49#include "com04_c.inc"
50#include "param_c.inc"
51#include "task_c.inc"
52#include "impl1_c.inc"
53C-----------------------------------------------
54C D u m m y A r g u m e n t s
55C-----------------------------------------------
56 INTEGER LPRW(*), NPRW(*), FR_WALL(NSPMD+2,*), WEIGHT(*),
57 . IBID, NODNX_SMS(*),WEIGHT_MD(*),
58 . DIMFB,STABSEN,TABSENSOR(*)
59 my_real x(3,numnod), a(3,numnod), v(3,numnod),rwbuf(nrwlp,*),rwsav(*),ms(*),
60 . fsav(nthvki,*), fopt(6,*)
61 DOUBLE PRECISION FRWL6(7,6,NRWALL)
62 DOUBLE PRECISION FBSAV6(12,6,DIMFB),RBID(12,6)
63 DOUBLE PRECISION,INTENT(INOUT) :: WFEXT, WFEXT_MD
64C-----------------------------------------------
65C L o c a l V a r i a b l e s
66C-----------------------------------------------
67 INTEGER K,N,N2,N3,N4,N5,N6, ITYP, ISL, IFQ, ILAGM, IMP, PMAIN,IPARSENS,ISECT
68C-----------------------------------------------
69 rbid = zero
70C Init global result to 0
71
72!$OMP DO
73 DO n = 1, nrwall
74 DO k = 1, 6
75 frwl6(1,k,n) = zero
76 frwl6(2,k,n) = zero
77 frwl6(3,k,n) = zero
78 frwl6(4,k,n) = zero
79 frwl6(5,k,n) = zero
80 frwl6(6,k,n) = zero
81 frwl6(7,k,n) = zero
82 END DO
83 END DO
84!$OMP END DO
85
86 isl = 1
87 k=1
88 imp=0
89
90 DO n=1,nrwall
91 n2=n +nrwall
92 n3=n2+nrwall
93 n4=n3+nrwall
94 n5=n4+nrwall
95 n6=n5+nrwall
96C
97 ityp= nprw(n4)
98 ilagm= 0
99 IF (nprw(n6) == 1) ilagm=1
100 IF(ityp == 1.AND.ilagm == 0)THEN
101 CALL rgwall(
102 + x ,a ,v ,rwbuf(1,n),lprw(k),
103 + nprw(n) ,nprw(n2) ,nprw(n3) ,ms ,weight ,
104 + nprw(n5),rwsav(isl),frwl6(1,1,n),imp ,ibid ,
105 + ibid ,ibid ,ibid ,nodnx_sms ,weight_md, wfext, wfext_md)
106 ELSEIF(ityp == 2)THEN
107 CALL rgwalc(
108 + x ,a ,v ,rwbuf(1,n) ,lprw(k),
109 + nprw(n) ,nprw(n2) ,nprw(n3),ms ,weight ,
110 + nprw(n5),frwl6(1,1,n),imp ,ibid ,ibid ,
111 + ibid ,ibid ,nodnx_sms , weight_md,wfext, wfext_md)
112C
113 ELSEIF(ityp == 3)THEN
114 CALL rgwals(
115 + x ,a ,v ,rwbuf(1,n),lprw(k),
116 + nprw(n) ,nprw(n2) ,nprw(n3),ms ,weight ,
117 + nprw(n5),frwl6(1,1,n),imp ,ibid ,ibid ,
118 + ibid ,ibid ,nodnx_sms ,weight_md,wfext, wfext_md)
119 ELSEIF(ityp == 4)THEN
120 CALL rgwalp(
121 + x ,a ,v ,rwbuf(1,n),lprw(k),
122 + nprw(n) ,nprw(n2) ,nprw(n3),ms ,weight ,
123 + nprw(n5),frwl6(1,1,n),imp ,ibid ,ibid ,
124 + ibid ,ibid ,nodnx_sms ,weight_md,wfext,wfext_md)
125 ENDIF
126 k=k+nprw(n)
127 ifq = nint(rwbuf(15,n))
128 IF (sminver < 9.OR.ifq > 0) THEN
129 isl=isl+nprw(n)*3
130 ENDIF
131 IF(nprw(n4) == -1)THEN
132 k=k+nint(rwbuf(8,n))
133 ENDIF
134 END DO
135
136C Explicit barrier required before communication
137
138 CALL my_barrier
139
140!$OMP SINGLE
141
142C
143C Traitements Speciaux : Communications SPMD si moving present
144C + Sauvegarde Force et Impultion main
145C
146 IF(imconv == 1) THEN
147 DO n=1,nrwall
148 n2=n +nrwall
149 n3=n2+nrwall
150 n4=n3+nrwall
151 n5=n4+nrwall
152 n6=n5+nrwall
153 IF(nprw(n3) /= 0) THEN
154 IF(nspmd > 1) THEN
155C si proc concerne par le rgwall
156 IF(fr_wall(ispmd+1,n) /= 0) THEN
157 CALL spmd_exch_fr6(fr_wall(1,n),frwl6(1,1,n),7*6)
158 ENDIF
159 pmain = fr_wall(nspmd+2,n)
160 ELSE
161 pmain = 1
162 ENDIF
163 ELSE
164 pmain = 1
165 END IF
166C
167 iparsens=0
168 isect=0
169 IF(stabsen/=0) THEN
170 isect=tabsensor(n+nsect+nintsub+ninter+1)-tabsensor(n+nsect+nintsub+ninter)
171 ENDIF
172 IF(isect/=0) THEN
173 iparsens=1
174 CALL rgwalt(
175 1 nprw(n3),rwbuf(1,n),frwl6(1,1,n),pmain,fsav(1,n),
176 2 fopt(1,n),fbsav6(1,1,isect) , iparsens)
177 ELSE
178 CALL rgwalt(
179 1 nprw(n3),rwbuf(1,n),frwl6(1,1,n),pmain,fsav(1,n),
180 2 fopt(1,n),rbid , iparsens)
181 ENDIF
182 END DO
183 END IF
184
185!$OMP END SINGLE
186
187 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
rgwalt
subroutine rgwalt(msr, rwl, frwl6, pmain, fsav, fopt, fbsav6, iparsens)
Definition rgwal0.F:440
rgwalc
subroutine rgwalc(x, a, v, rwl, nsw, nsn, itied, msr, ms, weight, icont, frwl6, imp_s, nt_rw, iddl, ikc, ndof, nodnx_sms, weight_md, wfext, wfext_md)
Definition rgwalc.F:37
rgwall
subroutine rgwall(x, a, v, rwl, nsw, nsn, itied, msr, ms, weight, icont, rwsav, frwl6, imp_s, nt_rw, iddl, ikc, ndof, nodnx_sms, weight_md, wfext, wfext_md)
Definition rgwall.F:37
rgwalp
subroutine rgwalp(x, a, v, rwl, nsw, nsn, itied, msr, ms, weight, icont, frwl6, imp_s, nt_rw, iddl, ikc, ndof, nodnx_sms, weight_md, wfext, wfext_md)
Definition rgwalp.F:36
rgwals
subroutine rgwals(x, a, v, rwl, nsw, nsn, itied, msr, ms, weight, icont, frwl6, imp_s, nt_rw, iddl, ikc, ndof, nodnx_sms, weight_md, wfext, wfext_md)
Definition rgwals.F:36
spmd_exch_fr6
subroutine spmd_exch_fr6(fr, fs6, len)
Definition spmd_exch_fr6.F:51
my_barrier
subroutine my_barrier
Definition machine.F:31

◆ rgwal0_imp()

subroutine rgwal0_imp ( x,
d,
v,
rwbuf,
integer, dimension(*) lprw,
integer, dimension(*) nprw,
ms,
fsav,
integer, dimension(nspmd+2,*) fr_wall,
fopt,
rwsav,
integer, dimension(*) weight,
fsavd,
integer nt_rw,
integer, dimension(*) iddl,
integer, dimension(*) ikc,
integer icomv,
integer, dimension(*) ndof,
double precision, dimension(7,6,nrwall) frwl6,
integer, dimension(*) weight_md,
integer dimfb,
double precision, dimension(12,6,dimfb) fbsav6,
integer stabsen,
integer, dimension(*) tabsensor,
double precision, intent(inout) wfext,
double precision, intent(inout) wfext_md )

Definition at line 206 of file rgwal0.F.

211C-----------------------------------------------
212C I m p l i c i t T y p e s
213C-----------------------------------------------
214#include "implicit_f.inc"
215#include "comlock.inc"
216C-----------------------------------------------
217C C o m m o n B l o c k s
218C-----------------------------------------------
219#include "com01_c.inc"
220#include "com04_c.inc"
221#include "param_c.inc"
222#include "task_c.inc"
223#include "scr03_c.inc"
224#include "com08_c.inc"
225#include "impl1_c.inc"
226C-----------------------------------------------
227C D u m m y A r g u m e n t s
228C-----------------------------------------------
229 INTEGER LPRW(*), NPRW(*), FR_WALL(NSPMD+2,*), WEIGHT(*),
230 . NT_RW,IDDL(*),IKC(*),NDOF(*),ICOMV,WEIGHT_MD(*),
231 . DIMFB,STABSEN,TABSENSOR(*)
232 my_real x(3,numnod), d(3,numnod), v(3,numnod),rwbuf(nrwlp,*),rwsav(*),ms(*),
233 . fsav(nthvki,*), fopt(6,*),fsavd(nthvki,*)
234 DOUBLE PRECISION FRWL6(7,6,NRWALL)
235 DOUBLE PRECISION FBSAV6(12,6,DIMFB),RBID(12,6)
236 DOUBLE PRECISION,INTENT(INOUt) :: WFEXT, WFEXT_MD
237C-----------------------------------------------
238C L o c a l V a r i a b l e s
239C-----------------------------------------------
240 INTEGER K, N, N2, N3, N4, N5, N6, ITYP, ISL, IFQ, ILAGM,
241 . NDS,IMP, PMAIN, IBID,IPARSENS,ISECT
242 my_real a(3,numnod),bid,dti
243C-----------------------------------------------
244 rbid = zero
245C Init global result to 0
246
247C for the moment RGWAL0 is called in monoprocessor, so no need of // do loop
248c!$OMP DO
249 DO n = 1, nrwall
250 DO k = 1, 6
251 frwl6(1,k,n) = zero
252 frwl6(2,k,n) = zero
253 frwl6(3,k,n) = zero
254 frwl6(4,k,n) = zero
255 frwl6(5,k,n) = zero
256 frwl6(6,k,n) = zero
257 frwl6(7,k,n) = zero
258 END DO
259 END DO
260c!$OMP END DO
261
262 nds=0
263 imp=1
264 IF (idyna > 0) THEN
265 CALL getdyna_a(1 ,numnod ,a )
266 ELSE
267 CALL zeror(a,numnod)
268 END IF
269 IF (icomv == 1) THEN
270 dti = one/dt2
271 DO n=1,numnod
272 v(1,n)=d(1,n)*dti
273 v(2,n)=d(2,n)*dti
274 v(3,n)=d(3,n)*dti
275 ENDDO
276 ENDIF
277 isl = 1
278 k=1
279 DO n=1,nrwall
280 n2=n +nrwall
281 n3=n2+nrwall
282 n4=n3+nrwall
283 n5=n4+nrwall
284 n6=n5+nrwall
285
286 ityp= nprw(n4)
287 ilagm= 0
288 IF (codvers >= 44) THEN
289 IF (nprw(n6) == 1) ilagm=1
290 ENDIF
291 IF(ityp == 1.AND.ilagm == 0)THEN
292 CALL rgwall(
293 + x ,a ,v ,rwbuf(1,n),lprw(k),
294 + nprw(n) ,nprw(n2) ,nprw(n3) ,ms ,weight ,
295 + nprw(n5),rwsav(isl),frwl6(1,1,n),imp ,nt_rw ,
296 + iddl ,ikc ,ndof ,ibid ,weight_md, wfext, wfext_md)
297 ELSEIF(ityp == 2)THEN
298 CALL rgwalc(
299 + x ,a ,v ,rwbuf(1,n),lprw(k),
300 + nprw(n) ,nprw(n2) ,nprw(n3),ms ,weight ,
301 + nprw(n5),frwl6(1,1,n),imp ,nt_rw ,iddl ,
302 + ikc ,ndof ,ibid ,weight_md ,wfext ,wfext_md)
303 ELSEIF(ityp == 3)THEN
304 CALL rgwals(
305 + x ,a ,v ,rwbuf(1,n),lprw(k),
306 + nprw(n) ,nprw(n2) ,nprw(n3),ms ,weight ,
307 + nprw(n5),frwl6(1,1,n),imp ,nt_rw ,iddl ,
308 + ikc ,ndof ,ibid ,weight_md ,wfext, wfext_md)
309 ELSEIF(ityp == 4)THEN
310 CALL rgwalp(
311 + x ,a ,v ,rwbuf(1,n),lprw(k),
312 + nprw(n) ,nprw(n2) ,nprw(n3),ms ,weight ,
313 + nprw(n5),frwl6(1,1,n),imp ,nt_rw ,iddl ,
314 + ikc ,ndof ,ibid ,weight_md ,wfext, wfext_md)
315 ENDIF
316
317 k=k+nprw(n)
318 ifq = nint(rwbuf(15,n))
319 IF (sminver < 9.OR.ifq > 0) isl=isl+nprw(n)*3
320 IF(nprw(n4) == -1)k=k+nint(rwbuf(8,n))
321 END DO
322
323C
324C Traitements Speciaux : Communications SPMD si moving present
325C + Sauvegarde Force et Impultion main
326C
327 IF(imconv == 1) THEN
328 DO n=1,nrwall
329 n2=n +nrwall
330 n3=n2+nrwall
331 n4=n3+nrwall
332 n5=n4+nrwall
333 n6=n5+nrwall
334 IF(nprw(n3) /= 0) THEN
335 IF(nspmd > 1) THEN
336C si proc concerne par le rgwall
337 IF(fr_wall(ispmd+1,n) /= 0) THEN
338 CALL spmd_exch_fr6(fr_wall(1,n),frwl6(1,1,n),7*6)
339 ENDIF
340 pmain = fr_wall(nspmd+2,n)
341 ELSE
342 pmain = 1
343 ENDIF
344 ELSE
345 pmain = 1
346 END IF
347C
348 iparsens=0
349 isect=0
350 IF(stabsen/=0) isect=tabsensor(n+nsect+nintsub+ninter+1)-
351 . tabsensor(n+nsect+nintsub+ninter)
352 IF(isect/=0) THEN
353 iparsens=1
354 CALL rgwalt(
355 1 nprw(n3),rwbuf(1,n),frwl6(1,1,n),pmain,fsav(1,n),
356 2 fopt(1,n),fbsav6(1,1,isect) , iparsens)
357 ELSE
358 CALL rgwalt(
359 1 nprw(n3),rwbuf(1,n),frwl6(1,1,n),pmain,fsav(1,n),
360 2 fopt(1,n),rbid , iparsens)
361 ENDIF
362 END DO
363 END IF
364
365 IF (nt_rw > 0) THEN
366 CALL fv_rwl(iddl ,ikc ,ndof ,d ,v ,a )
367 ENDIF
368
369 RETURN
getdyna_a
subroutine getdyna_a(nodft, nodlt, a)
Definition imp_dyna.F:1909
fv_rwl
subroutine fv_rwl(iddl, ikc, ndof, ud, v, a)
Definition srw_imp.F:33
zeror
subroutine zeror(a, n)
Definition zero.F:39

◆ rgwalf()

subroutine rgwalf ( a,
rwbuf,
integer, dimension(*) nprw,
ms )

Definition at line 377 of file rgwal0.F.

378C-----------------------------------------------
379C I m p l i c i t T y p e s
380C-----------------------------------------------
381#include "implicit_f.inc"
382#include "comlock.inc"
383C-----------------------------------------------
384C C o m m o n B l o c k s
385C-----------------------------------------------
386#include "com04_c.inc"
387#include "param_c.inc"
388C-----------------------------------------------
389C D u m m y A r g u m e n t s
390C-----------------------------------------------
391 INTEGER NPRW(*)
392 my_real a(3,numnod),rwbuf(nrwlp,*),ms(*)
393C-----------------------------------------------
394C L o c a l V a r i a b l e s
395C-----------------------------------------------
396 INTEGER N,N2,N3,N4,N5,N6, MSR, ITYP, ILAGM
397 my_real dm
398C-----------------------------------------------
399C
400C RWL(17) = Fx
401C RWL(18) = Fy
402C RWL(19) = Fz
403C RWL(20) = Somme (Xslv)
404C
405 DO n=1,nrwall
406 n2=n +nrwall
407 n3=n2+nrwall
408 n4=n3+nrwall
409 n5=n4+nrwall
410 n6=n5+nrwall
411 ityp= nprw(n4)
412 ilagm= 0
413 IF (nprw(n6) == 1) ilagm=1
414 IF(ityp >= 1.AND.ityp <= 4.AND.ilagm == 0)THEN
415 msr = nprw(n3)
416 IF(msr /= 0)THEN
417 dm = ms(msr)+ rwbuf(20,n)
418 IF(dm /= zero) THEN
419 dm = ms(msr) / dm
420 a(1,msr) = (a(1,msr) + rwbuf(17,n))*dm
421 a(2,msr) = (a(2,msr) + rwbuf(18,n))*dm
422 a(3,msr) = (a(3,msr) + rwbuf(19,n))*dm
423 ENDIF
424 ENDIF
425 ENDIF
426 END DO
427
428C
429 RETURN

◆ rgwalt()

subroutine rgwalt ( integer msr,
rwl,
double precision, dimension(7,6) frwl6,
integer pmain,
fsav,
fopt,
double precision, dimension(12,6) fbsav6,
integer iparsens )

Definition at line 438 of file rgwal0.F.

440C-----------------------------------------------
441C I m p l i c i t T y p e s
442C-----------------------------------------------
443#include "implicit_f.inc"
444#include "comlock.inc"
445C-----------------------------------------------
446C C o m m o n B l o c k s
447C-----------------------------------------------
448#include "com08_c.inc"
449#include "sms_c.inc"
450#include "task_c.inc"
451C-----------------------------------------------
452C D u m m y A r g u m e n t s
453C-----------------------------------------------
454 INTEGER MSR, PMAIN, IPARSENS, I
455 my_real rwl(*), fsav(*),fopt(6),divdt12
456 DOUBLE PRECISION FRWL6(7,6)
457 DOUBLE PRECISION FBSAV6(12,6)
458C-----------------------------------------------
459C L o c a l V a r i a b l e s
460C-----------------------------------------------
461 my_real fxn, fyn, fzn, fxt, fyt, fzt, xmt
462C-----------------------------------------------
463 fxn = frwl6(1,1)+frwl6(1,2)+frwl6(1,3)+
464 . frwl6(1,4)+frwl6(1,5)+frwl6(1,6)
465 fyn = frwl6(2,1)+frwl6(2,2)+frwl6(2,3)+
466 . frwl6(2,4)+frwl6(2,5)+frwl6(2,6)
467 fzn = frwl6(3,1)+frwl6(3,2)+frwl6(3,3)+
468 . frwl6(3,4)+frwl6(3,5)+frwl6(3,6)
469 xmt = frwl6(4,1)+frwl6(4,2)+frwl6(4,3)+
470 . frwl6(4,4)+frwl6(4,5)+frwl6(4,6)
471 fxt = frwl6(5,1)+frwl6(5,2)+frwl6(5,3)+
472 . frwl6(5,4)+frwl6(5,5)+frwl6(5,6)
473 fyt = frwl6(6,1)+frwl6(6,2)+frwl6(6,3)+
474 . frwl6(6,4)+frwl6(6,5)+frwl6(6,6)
475 fzt = frwl6(7,1)+frwl6(7,2)+frwl6(7,3)+
476 . frwl6(7,4)+frwl6(7,5)+frwl6(7,6)
477C
478 IF(dt12 /= zero)THEN
479 divdt12 = one / dt12
480 ELSE
481 divdt12 = zero
482 ENDIF
483
484 IF (iparsens /= 0)THEN
485 DO i=1,6
486 fbsav6(1,i) = frwl6(1,i)*divdt12
487 fbsav6(2,i) = frwl6(2,i)*divdt12
488 fbsav6(3,i) = frwl6(3,i)*divdt12
489 fbsav6(4,i) = frwl6(5,i)*divdt12
490 fbsav6(5,i) = frwl6(6,i)*divdt12
491 fbsav6(6,i) = frwl6(7,i)*divdt12
492 ENDDO
493 ENDIF
494C
495 IF(idtmins==0.AND.idtmins_int==0)THEN
496C changement formulation F et XMT stockoques dans RWL et appliques debut cycle suivant
497 rwl(17)=(fxn+fxt)*divdt12
498 rwl(18)=(fyn+fyt)*divdt12
499 rwl(19)=(fzn+fzt)*divdt12
500 rwl(20)=xmt
501C test pour ne cummuler qu'une fois en multiprocessors dans le cas moving
502 IF(ispmd+1 == pmain.OR. msr == 0) THEN
503 fsav(1)=fsav(1)+fxn
504 fsav(2)=fsav(2)+fyn
505 fsav(3)=fsav(3)+fzn
506 fsav(4)=fsav(4)+fxt
507 fsav(5)=fsav(5)+fyt
508 fsav(6)=fsav(6)+fzt
509 fopt(1)=fopt(1)+rwl(17)
510 fopt(2)=fopt(2)+rwl(18)
511 fopt(3)=fopt(3)+rwl(19)
512 END IF
513 ELSE
514 rwl(17)=rwl(17)+(fxn+fxt)*divdt12
515 rwl(18)=rwl(18)+(fyn+fyt)*divdt12
516 rwl(19)=rwl(19)+(fzn+fzt)*divdt12
517 rwl(20)=rwl(20)+xmt
518C test pour ne cummuler qu'une fois en multiprocessors dans le cas moving
519 IF(ispmd+1 == pmain.OR. msr == 0) THEN
520 fsav(1)=fsav(1)+fxn
521 fsav(2)=fsav(2)+fyn
522 fsav(3)=fsav(3)+fzn
523 fsav(4)=fsav(4)+fxt
524 fsav(5)=fsav(5)+fyt
525 fsav(6)=fsav(6)+fzt
526 fopt(1)=fopt(1)+(fxn+fxt)*divdt12
527 fopt(2)=fopt(2)+(fyn+fyt)*divdt12
528 fopt(3)=fopt(3)+(fzn+fzt)*divdt12
529 END IF
530 END IF
531C
532 RETURN