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 58 of file alewdx.F.

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