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,IPEN
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 DO n=1,nrwall
90 n2=n +nrwall
91 n3=n2+nrwall
92 n4=n3+nrwall
93 n5=n4+nrwall
94 n6=n5+nrwall
95C
96 ityp= nprw(n4)
97 ilagm= 0
98 ipen= nprw(n+8*nrwall)
99 IF (nprw(n6) == 1) ilagm=1
100 IF (ipen == 0.OR.impl_s>0) THEN
101 IF(ityp == 1.AND.ilagm == 0)THEN
102 CALL rgwall(
103 + x ,a ,v ,rwbuf(1,n),lprw(k),
104 + nprw(n) ,nprw(n2) ,nprw(n3) ,ms ,weight ,
105 + nprw(n5),rwsav(isl),frwl6(1,1,n),imp ,ibid ,
106 + ibid ,ibid ,ibid ,nodnx_sms ,weight_md, wfext, wfext_md)
107 ELSEIF(ityp == 2)THEN
108 CALL rgwalc(
109 + x ,a ,v ,rwbuf(1,n) ,lprw(k),
110 + nprw(n) ,nprw(n2) ,nprw(n3),ms ,weight ,
111 + nprw(n5),frwl6(1,1,n),imp ,ibid ,ibid ,
112 + ibid ,ibid ,nodnx_sms , weight_md,wfext, wfext_md)
113C
114 ELSEIF(ityp == 3)THEN
115 CALL rgwals(
116 + x ,a ,v ,rwbuf(1,n),lprw(k),
117 + nprw(n) ,nprw(n2) ,nprw(n3),ms ,weight ,
118 + nprw(n5),frwl6(1,1,n),imp ,ibid ,ibid ,
119 + ibid ,ibid ,nodnx_sms ,weight_md,wfext, wfext_md)
120 ELSEIF(ityp == 4)THEN
121 CALL rgwalp(
122 + x ,a ,v ,rwbuf(1,n),lprw(k),
123 + nprw(n) ,nprw(n2) ,nprw(n3),ms ,weight ,
124 + nprw(n5),frwl6(1,1,n),imp ,ibid ,ibid ,
125 + ibid ,ibid ,nodnx_sms ,weight_md,wfext,wfext_md)
126 ENDIF
127 END IF !(IPEN == 0.OR.IMPL_S>0) THEN
128 k=k+nprw(n)
129 ifq = nint(rwbuf(15,n))
130 IF (sminver < 9.OR.ifq > 0) THEN
131 isl=isl+nprw(n)*3
132 ENDIF
133 IF(nprw(n4) == -1)THEN
134 k=k+nint(rwbuf(8,n))
135 ENDIF
136 END DO
137
138C Explicit barrier required before communication
139
140 CALL my_barrier
141
142!$OMP SINGLE
143
144C
145C Traitements Speciaux : Communications SPMD si moving present
146C + Sauvegarde Force et Impultion main
147C
148 IF(imconv == 1) THEN
149 DO n=1,nrwall
150 n2=n +nrwall
151 n3=n2+nrwall
152 n4=n3+nrwall
153 n5=n4+nrwall
154 n6=n5+nrwall
155 IF(nprw(n3) /= 0) THEN
156 IF(nspmd > 1) THEN
157C if processor concerned by the rgwall
158 IF(fr_wall(ispmd+1,n) /= 0) THEN
159 CALL spmd_exch_fr6(fr_wall(1,n),frwl6(1,1,n),7*6)
160 ENDIF
161 pmain = fr_wall(nspmd+2,n)
162 ELSE
163 pmain = 1
164 ENDIF
165 ELSE
166 pmain = 1
167 END IF
168C
169 iparsens=0
170 isect=0
171 IF(stabsen/=0) THEN
172 isect=tabsensor(n+nsect+nintsub+ninter+1)-tabsensor(n+nsect+nintsub+ninter)
173 ENDIF
174 IF(isect/=0) THEN
175 iparsens=1
176 CALL rgwalt(
177 1 nprw(n3),rwbuf(1,n),frwl6(1,1,n),pmain,fsav(1,n),
178 2 fopt(1,n),fbsav6(1,1,isect) , iparsens)
179 ELSE
180 CALL rgwalt(
181 1 nprw(n3),rwbuf(1,n),frwl6(1,1,n),pmain,fsav(1,n),
182 2 fopt(1,n),rbid , iparsens)
183 ENDIF
184 END DO
185 END IF
186
187!$OMP END SINGLE
188
189 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
rgwalt
subroutine rgwalt(msr, rwl, frwl6, pmain, fsav, fopt, fbsav6, iparsens)
Definition rgwal0.F:439
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:52
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 208 of file rgwal0.F.

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

Definition at line 379 of file rgwal0.F.

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

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