OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
alewdx.F File Reference
#include "implicit_f.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "com06_c.inc"
#include "com08_c.inc"
#include "param_c.inc"
#include "scr03_c.inc"
#include "scr05_c.inc"
#include "timeri_c.inc"
#include "parit_c.inc"
#include "tabsiz_c.inc"
#include "vectorize.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine alewdx (timers, geo, x, d, v, vr, w, wa, wb, skew, pm, xlas, ms, fsav, a, tf, rwbuf, dt2save, python, iparg, ixs, ixq, nodpor, iskew, icodt, elbuf_tab, npf, linale, nprw, las, ipari, nodft, nodlt, itask, iad_elem, fr_elem, nbrcvois, nbsdvois, lnrcvois, lnsdvois, weight, adsky, fsky, iads, fr_wall, nporgeo, procne, fr_nbcc, iadq, xdp, igrnod, dr, intbuf_tab, multi_fvm, ale_connectivity, ddp, ne_nercvois, ne_nesdvois, ne_lercvois, ne_lesdvois, xcell, xface, wfext)

Function/Subroutine Documentation

◆ alewdx()

subroutine alewdx ( type(timer_), intent(inout) timers,
geo,
x,
d,
v,
vr,
w,
wa,
wb,
skew,
pm,
xlas,
ms,
fsav,
a,
tf,
rwbuf,
dt2save,
type(python_), intent(inout) python,
integer, dimension(nparg,ngroup) iparg,
integer, dimension(nixs,numels) ixs,
integer, dimension(nixq,numelq) ixq,
integer, dimension(*) nodpor,
integer, dimension(*) iskew,
integer, dimension(*) icodt,
type(elbuf_struct_), dimension(ngroup) elbuf_tab,
integer, dimension(*) npf,
integer, dimension(*) linale,
integer, dimension(*) nprw,
integer, dimension(*) las,
integer, dimension(npari,ninter) ipari,
integer nodft,
integer nodlt,
integer itask,
integer, dimension(*) iad_elem,
integer, dimension(*) fr_elem,
integer, dimension(*) nbrcvois,
integer, dimension(*) nbsdvois,
integer, dimension(*) lnrcvois,
integer, dimension(*) lnsdvois,
integer, dimension(*) weight,
integer, dimension(*) adsky,
fsky,
integer, dimension(*) iads,
integer, dimension(*) fr_wall,
integer, dimension(*) nporgeo,
integer, dimension(*) procne,
integer, dimension(*) fr_nbcc,
integer, dimension(*) iadq,
double precision, dimension(3,*) xdp,
type (group_), dimension(ngrnod) igrnod,
dr,
type(intbuf_struct_), dimension(*) intbuf_tab,
type(multi_fvm_struct) multi_fvm,
type(t_ale_connectivity), intent(in) ale_connectivity,
double precision, dimension(3,*) ddp,
integer, dimension(*), intent(in) ne_nercvois,
integer, dimension(*), intent(in) ne_nesdvois,
integer, dimension(*), intent(in) ne_lercvois,
integer, dimension(*), intent(in) ne_lesdvois,
xcell,
xface,
double precision, intent(inout) wfext )

Definition at line 59 of file alewdx.F.

76C-----------------------------------------------
77C D e s c r i p t i o n
78C-----------------------------------------------
79! --- NWALE : INTEGER SET IN [0,7] depending on /ALE/GRID/Keyword option
80!
81! NWALE FORMULATION (/ALE/GRID/...)
82! 0 'DONEA'
83! 1 'DISP'
84! 2 'SPRING'
85! 3 'ZERO'
86! 4 'STANDARD'
87! 5 'LAPLACIAN'
88! 6 'VOLUME'
89! 7 'FLOW-TRACKING'
90!
91! This subroutine is switching to grid formulation depending on NWALE value.
92C
93C X,D,V are allocated to SX,SD,DV=3*(NUMNOD_L+NUMVVOIS_L)
94C in grid subroutine it may needed to access nodes which
95C are connected to a remote elem. They are sored in X(1:3,NUMNOD+1:)
96C Consequently X is defined here X(3,SX/3) instead of X(3,NUMNOD) as usually
97C-----------------------------------------------
98C M o d u l e s
99C-----------------------------------------------
100 USE timer_mod
101 USE python_funct_mod
102 USE elbufdef_mod
103 USE intbufdef_mod
104 USE groupdef_mod
105 USE ale_connectivity_mod
106 USE multi_fvm_mod
107 USE ale_mod
108 USE alew8_mod , ONLY : alew8
109 use element_mod , only : nixs,nixq
110C-----------------------------------------------
111C I m p l i c i t T y p e s
112C-----------------------------------------------
113#include "implicit_f.inc"
114C-----------------------------------------------
115C C o m m o n B l o c k s
116C-----------------------------------------------
117#include "com01_c.inc"
118#include "com04_c.inc"
119#include "com06_c.inc"
120#include "com08_c.inc"
121#include "param_c.inc"
122#include "scr03_c.inc"
123#include "scr05_c.inc"
124#include "timeri_c.inc"
125#include "parit_c.inc"
126#include "tabsiz_c.inc"
127C-----------------------------------------------
128C D u m m y A r g u m e n t s
129C-----------------------------------------------
130 TYPE(TIMER_), INTENT(inout) :: TIMERS
131 TYPE(PYTHON_), INTENT(inout) :: PYTHON
132 TYPE(MULTI_FVM_STRUCT) :: MULTI_FVM
133 INTEGER ISKEW(*), IXS(NIXS,NUMELS),IXQ(NIXQ,NUMELQ),
134 . NPF(*),LAS(*), IPARG(NPARG,NGROUP), IPARI(NPARI,NINTER),
135 . NPRW(*), ICODT(*), LINALE(*),
136 . NODPOR(*), NBRCVOIS(*),NBSDVOIS(*), PROCNE(*),FR_NBCC(*),
137 . LNRCVOIS(*),LNSDVOIS(*), NODFT ,NODLT, ITASK,
138 . WEIGHT(*), FR_ELEM(*), IAD_ELEM(*), ADSKY(*), NPORGEO(*),
139 . IADS(*) ,FR_WALL(*),
140 . IADQ(*), NIADX
141 DOUBLE PRECISION :: XDP(3,*),DDP(3,*)
142 my_real x(3,sx/3) ,d(3,sd/3), v(3,sv/3) ,vr(3,svr/3) ,a(3,sa/3) , fsky(*),
143 . ms(*) ,pm(npropm,nummat),skew(lskew,*),geo(npropg,numgeo),
144 . w(3,sw/3), wb(*), tf(*), fsav(nthvki,*) ,xlas(*),
145 . wa(3,*),dr(3,sdr/3),xcell(3,sxcell), xface(3,6,*)
146 my_real :: rwbuf(nrwlp,*)
147 my_real dt2save
148 TYPE(ELBUF_STRUCT_), DIMENSION(NGROUP) :: ELBUF_TAB
149 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
150 TYPE (GROUP_) , DIMENSION(NGRNOD) :: IGRNOD
151 TYPE(t_ale_connectivity), INTENT(IN) :: ALE_CONNECTIVITY
152 INTEGER, INTENT(IN) :: NE_NERCVOIS(*), NE_NESDVOIS(*), NE_LERCVOIS(*), NE_LESDVOIS(*)
153 DOUBLE PRECISION, INTENT(INOUT) :: WFEXT
154C-----------------------------------------------
155C L o c a l V a r i a b l e s
156C-----------------------------------------------
157 INTEGER I, N, ISK, LCOD, NINDX1, NINDX2,INDX1(1024), INDX2(1024), SIZEN
158 DOUBLE PRECISION VDT2
159 my_real vdt
160C-----------------------------------------------
161C S o u r c e L i n e s
162C-----------------------------------------------
163 IF(imon > 0 .AND. itask == 0) THEN
164 CALL startime(timers,5)
165 ENDIF
166C----------------------------------------
167C MESH VELOCITIES DEPENDING ON USER FORMULATION
168C----------------------------------------
169 IF(ale%SUB%IFSUB == 0) THEN
170
171 IF(itask == 0)THEN
172 dt2save=dt2
173 IF(ale%SUB%IALESUB /= 0)dt2=int(dt2s/dt2save)*dt2save !DT2=DT2S
174 sizen=0
175 IF(iparit == 0)sizen = numnod
176 ENDIF
177
178 SELECT CASE (ale%GRID%NWALE)
179
180 !-------------------------!
181 !---/ALE/GRID/DONEA (0)
182 !-------------------------!
183 CASE(0)
184 CALL my_barrier
185 CALL alew(
186 1 x ,d ,v ,w ,wa ,
187 2 ale_connectivity%NN_CONNECT ,ale_connectivity%NALE ,nodft ,nodlt ,
188 3 nbrcvois,nbsdvois,lnrcvois ,lnsdvois )
189 CALL my_barrier
190
191 !-------------------------!
192 !---/ALE/GRID/DISP (1)
193 !-------------------------!
194 CASE(1)
195 CALL alew1(
196 1 d ,v ,w ,
197 2 ale_connectivity%NN_CONNECT ,ale_connectivity%NALE ,nodft ,nodlt ,
198 3 nbrcvois ,nbsdvois,lnrcvois,lnsdvois )
199 CALL my_barrier
200
201 !-------------------------!
202 !---/ALE/GRID/SPRING (2)
203 !-------------------------!
204 CASE(2)
205 IF (itask == 0) THEN
206 CALL alew2(
207 1 x ,d ,v ,w ,wa ,
208 2 ale_connectivity%NALE ,iparg ,ixs ,wb ,
209 3 iad_elem,fr_elem,fr_nbcc ,sizen,adsky,
210 4 procne ,fsky ,fsky ,iads )
211 ENDIF
212
213 !-------------------------!
214 !---/ALE/GRID/ZERO (3)
215 !-------------------------!
216 CASE(3)
217 IF (itask == 0) THEN
218 CALL wlag(v,w,ale_connectivity%NALE)
219 ENDIF
220
221 !-------------------------!
222 !---/ALE/GRID/STANDARD (4)
223 !-------------------------!
224 CASE(4)
225 IF (itask == 0) THEN
226 IF (n2d == 0) THEN
227 niadx=8
228 CALL alew4(
229 1 x ,d ,v ,w ,wa ,
230 2 ale_connectivity%NALE ,iparg ,ixs ,wb ,
231 3 iad_elem,fr_elem,fr_nbcc ,sizen,adsky ,
232 4 procne ,fsky ,fsky ,iads ,wb(1+3*numnod),
233 5 nixs ,niadx )
234 ELSE
235 niadx=4
236 CALL alew4(
237 1 x ,d ,v ,w ,wa ,
238 2 ale_connectivity%NALE ,iparg ,ixq ,wb ,
239 3 iad_elem ,fr_elem ,fr_nbcc ,sizen ,adsky ,
240 4 procne ,fsky ,fsky ,iadq ,wb(1+3*numnod),
241 5 nixq ,niadx )
242 ENDIF
243 ENDIF
244
245 !-------------------------!
246 !---/ALE/GRID/LAPLACIAN (5)
247 !-------------------------!
248 CASE(5)
249 CALL my_barrier
250 CALL alew5(
251 1 x ,v ,w , wa ,
252 2 ale_connectivity%NN_CONNECT ,ale_connectivity%NALE ,nodft , nodlt ,
253 3 nbrcvois ,nbsdvois ,lnrcvois, lnsdvois,
254 4 skew ,iskew ,icodt)
255 CALL my_barrier
256
257 !-------------------------!
258 !---/ALE/GRID/VOLUME (6)
259 !-------------------------!
260 CASE(6)
261 CALL my_barrier
262 CALL alew6(
263 1 x , v ,w , wa ,
264 . xcell , xface ,
265 2 ale_connectivity%NE_CONNECT, ale_connectivity%NALE ,nodft , nodlt ,itask ,
266 3 ne_nercvois , ne_nesdvois ,ne_lercvois, ne_lesdvois,
267 4 elbuf_tab , iparg ,ixs , ixq)
268 CALL my_barrier
269
270 !-------------------------------!
271 !---/ALE/GRID/FLOW-TRACKING (7)
272 !-------------------------------!
273 CASE(7)
274 CALL my_barrier
275 CALL alew7(
276 1 x ,v ,w ,ms ,ale_connectivity%NALE,
277 2 nodft ,nodlt ,weight ,numnod ,dt1 ,
278 3 sx ,sv ,sw ,nspmd )
279 CALL my_barrier
280
281 !-------------------------------!
282 !---/ALE/GRID/LAGRANGE (8)
283 !-------------------------------!
284 CASE(8)
285 CALL my_barrier
286 CALL alew8(sv, sw, v ,w, nodft, nodlt, numnod, ale_connectivity%NALE)
287 CALL my_barrier
288
289 END SELECT !CASE (ALE%GRID%NWALE)
290
291 IF (itask == 0) THEN
292 dt2=dt2save
293 ENDIF
294 ELSE
295 IF (itask == 0) CALL wlag(v,w,ale_connectivity%NALE)
296 ENDIF
297C
298 CALL my_barrier
299C
300 IF(imon > 0 .AND. itask == 0) CALL stoptime(timers,5)
301 IF (itask == 0) THEN
302C----------------------------------------
303 IF(numpor > 0)
304 1 CALL wpor(geo,nodpor ,x ,v ,vr ,
305 2 w ,ale_connectivity%NALE,nporgeo )
306C----------------------------------------
307C BOUNDARY CONDITIONS AT NODES
308C----------------------------------------
309 IF(imon > 0 .AND. itask == 0) CALL startime(timers,4)
310 DO i=1,numnod,1024
311 nindx1 = 0
312 nindx2 = 0
313 DO n = i,min(numnod,i+1023)
314 IF(ale_connectivity%NALE(n) /= 0)THEN
315 isk=iskew(n)
316 lcod=icodt(n+numnod)
317 IF(lcod /= 0) THEN
318 nindx1 = nindx1 + 1
319 indx1(nindx1) = n
320 ENDIF
321 lcod=icodt(n+numnod+numnod)
322 IF(lcod /= 0) THEN
323 nindx2 = nindx2 + 1
324 indx2(nindx2) = n
325 ENDIF
326 ENDIF
327 ENDDO
328 IF(nindx1 /= 0)THEN
329 CALL bcs2v(nindx1,indx1,iskew,icodt(numnod+1),w,skew)
330 ENDIF
331 IF(nindx2 /= 0)THEN
332 CALL bcs3v(nindx2,indx2,iskew,icodt(2*numnod+1),w,v,skew)
333 ENDIF
334 ENDDO
335 IF(imon > 0 .AND. itask == 0) CALL stoptime(timers,4)
336C--------------------------------
337C ALE/LAGRANGE INTERFACES
338C--------------------------------
339 IF(ninter /= 0) THEN
340 IF(imon > 0 .AND. itask == 0) CALL startime(timers,2)
341 CALL intal3(
342 1 ipari,x ,v ,
343 2 a ,w ,iskew ,skew ,icodt(1+numnod),
344 3 ixs ,ixq ,elbuf_tab ,iparg ,
345 4 pm ,ale_connectivity%NALE ,intbuf_tab)
346 IF(imon > 0 .AND. itask == 0) CALL stoptime(timers,2)
347 ENDIF
348C-----------------------------------
349C 2D GRID VELOCITIES
350C-----------------------------------
351 IF(n2d == 1)THEN
352 IF(imon > 0 .AND. itask == 0) CALL startime(timers,5)
353 DO i=1,numnod
354 IF(x(2,i)+dt2*w(2,i) >= zero)cycle
355 w(2,i)=zero
356 v(2,i)=zero
357 ENDDO
358 IF(imon > 0 .AND. itask == 0) CALL stoptime(timers,5)
359 ENDIF
360C--------------------------------------
361C /ALE/LINK/VEL
362C--------------------------------------
363 IF(nalelk /= 0) THEN
364 IF(imon > 0 .AND. itask == 0) CALL startime(timers,4)
365 CALL alelin(nalelk,linale,w,weight,igrnod)
366 IF(imon > 0 .AND. itask == 0) CALL stoptime(timers,4)
367 ENDIF
368C-----------------------------------
369C 2D GRID VELOCITY
370C-----------------------------------
371 IF(n2d == 1)THEN
372 IF(imon > 0 .AND. itask == 0) CALL startime(timers,5)
373 DO i=1,numnod
374 IF(x(2,i)+dt2*w(2,i) >= zero)cycle
375 w(2,i)=zero
376 v(2,i)=zero
377 enddo!next I
378 IF(imon > 0 .AND. itask == 0) CALL stoptime(timers,5)
379 ENDIF
380C-----------------------
381C RIGID WALL ALE or ALE-TH
382C-----------------------
383 IF(nrwall > 0) THEN
384 IF(imon > 0 .AND. itask == 0) CALL startime(timers,4)
385 CALL rgwal1(
386 1 x ,a ,v ,w ,
387 2 rwbuf ,nprw(1+nnprw*nrwall),nprw ,python ,
388 3 ms ,fsav(1,ninter+1),
389 4 ixs ,ixq ,elbuf_tab ,iparg ,
390 5 pm ,tf ,npf ,weight ,
391 6 iad_elem ,fr_elem ,fr_wall )
392 IF(imon > 0.AND. itask == 0) CALL stoptime(timers,4)
393 ENDIF
394C-----------------------
395C LASER
396C-----------------------
397 IF (nlaser > 0) THEN
398 CALL laser1(las ,xlas ,ms ,x ,v ,
399 . w ,wa ,iparg ,ixq ,pm ,
400 . tf ,npf ,elbuf_tab,wfext)
401 ENDIF
402C-----------------------
403 ENDIF ! ITASK == 0
404
405C-----------------------------------
406C LAGRANGIAN ROTATIONS
407C-----------------------------------
408 IF(impose_dr /= 0 .AND. iroddl /= 0) THEN
409#include "vectorize.inc"
410 DO n=nodft,nodlt
411 dr(1,n)=dr(1,n)+dt2*vr(1,n)
412 dr(2,n)=dr(2,n)+dt2*vr(2,n)
413 dr(3,n)=dr(3,n)+dt2*vr(3,n)
414 ENDDO
415 ENDIF
416
417C-----------------------------------
418C GRID DISPLACEMENT
419C-----------------------------------
420 IF(imon > 0 .AND. itask == 0) CALL startime(timers,5)
421C
422 CALL my_barrier
423C
424 IF (.NOT. multi_fvm%IS_USED) THEN
425 IF (iresp == 1) THEN
426#include "vectorize.inc"
427 DO n=nodft,nodlt
428 vdt2 = dt2*w(1,n)
429 ddp(1,n) = ddp(1,n)+vdt2
430 d(1,n) = d(1,n)+vdt2
431 xdp(1,n) = xdp(1,n)+vdt2
432 x(1,n) = xdp(1,n)
433
434 vdt2 = dt2*w(2,n)
435 ddp(2,n) = ddp(2,n)+vdt2
436 d(2,n) = d(2,n)+vdt2
437 xdp(2,n) = xdp(2,n)+vdt2
438 x(2,n) = xdp(2,n)
439
440 vdt2 = dt2*w(3,n)
441 ddp(3,n) = ddp(3,n)+vdt2
442 d(3,n) = d(3,n)+vdt2
443 xdp(3,n) = xdp(3,n)+vdt2
444 x(3,n) = xdp(3,n)
445 ENDDO
446 ELSE
447#include "vectorize.inc"
448 DO n=nodft,nodlt
449 vdt = dt2*w(1,n)
450 d(1,n) = d(1,n)+vdt
451 x(1,n) = x(1,n)+vdt
452
453 vdt = dt2*w(2,n)
454 d(2,n) = d(2,n)+vdt
455 x(2,n) = x(2,n)+vdt
456
457 vdt = dt2*w(3,n)
458 d(3,n) = d(3,n)+vdt
459 x(3,n) = x(3,n)+vdt
460 ENDDO
461 ENDIF
462 ENDIF
463C-----------------------------------------------
464 CALL my_barrier
465C-----------------------------------------------
466 IF(imon > 0 .AND. itask == 0) THEN
467 CALL stoptime(timers,5)
468 ENDIF
469C-----------------------------------------------
470 RETURN
alelin
subroutine alelin(nalelk, linale, w, weight, igrnod)
Definition alelin.F:34
alew1
subroutine alew1(d, v, w, ale_nn_connect, nale, nodft, nodlt, nbrcvois, nbsdvois, lnrcvois, lnsdvois)
Definition alew1.F:37
alew2
subroutine alew2(x, d, v, w, wa, nale, iparg, nc, wb, iad_elem, fr_elem, fr_nbcc, sizen, addcne, procne, fsky, fskyv, iads)
Definition alew2.F:38
alew4
subroutine alew4(x, d, v, w, wa, nale, iparg, nc, wb, iad_elem, fr_elem, fr_nbcc, sizen, addcne, procne, fsky, fskyv, iadx, wma, nix, niadx)
Definition alew4.F:39
alew5
subroutine alew5(x, v, w, wa, ale_nn_connect, nale, nodft, nodlt, nbrcvois, nbsdvois, lnrcvois, lnsdvois, skew, iskew, icodt)
Definition alew5.F:40
alew6
subroutine alew6(x, v, w, wa, xcell, xface, ale_ne_connect, nale, nodft, nodlt, itask, nercvois, nesdvois, lercvois, lesdvois, elbuf_tab, iparg, ixs, ixq)
Definition alew6.F:45
alew7
subroutine alew7(x, v, w, ms, nale, nodft, nodlt, weight, numnod, dt1, sx, sv, sw, nspmd)
Definition alew7.F:46
alew
subroutine alew(x, d, v, w, wa, ale_nn_connect, nale, nodft, nodlt, nbrcvois, nbsdvois, lnrcvois, lnsdvois)
Definition alew.F:38
bcs2v
subroutine bcs2v(nindx, indx, iskew, icodt, a, b)
Definition bcs2.F:146
bcs3v
subroutine bcs3v(nindx, indx, iskew, icodt, w, v, b)
Definition bcs3v.F:31
my_real
#define my_real
Definition cppsort.cpp:32
intal3
subroutine intal3(ipari, x, v, a, vg, iskew, skew, icode, ixs, ixq, elbuf_tab, iparg, pm, nale, intbuf_tab)
Definition intal3.F:40
laser1
subroutine laser1(las, xlas, ms, x, v, w, wa, iparg, ixq, pm, tf, npf, elbuf_tab, wfext)
Definition laser1.F:36
min
#define min(a, b)
Definition macros.h:20
ale_connectivity_mod
Definition ale_connectivity_mod.F:225
ale_mod
Definition ale_mod.F:150
ale_mod::ale
type(ale_) ale
Definition ale_mod.F:253
groupdef_mod
Definition groupdef_mod.F:668
rgwal1
subroutine rgwal1(x, a, v, w, rwbuf, lprw, nprw, python, ms, fsav, ixs, ixq, elbuf_tab, iparg, pm, tf, npf, weight, iad_elem, fr_elem, fr_wall)
Definition rgwal1.F:41
my_barrier
subroutine my_barrier
Definition machine.F:31
startime
subroutine startime(event, itask)
Definition timer.F:93
stoptime
subroutine stoptime(event, itask)
Definition timer.F:135
wlag
subroutine wlag(v, w, nale)
Definition wlag.F:29
wpor
subroutine wpor(geo, nodpor, x, v, vr, w, nale, nporgeo)
Definition wpor.F:31