62 3 PM ,XLAS ,MS ,FSAV ,
65 6 IPARG ,IXS ,IXQ ,NODPOR ,
66 7 ISKEW ,ICODT ,ELBUF_TAB ,
67 8 NPF ,LINALE ,NPRW ,LAS ,
68 9 IPARI ,NODFT ,NODLT ,ITASK ,
69 A IAD_ELEM ,FR_ELEM ,NBRCVOIS ,NBSDVOIS ,LNRCVOIS ,
70 B LNSDVOIS ,WEIGHT ,ADSKY ,FSKY ,IADS ,
71 C FR_WALL ,NPORGEO ,PROCNE ,
72 D FR_NBCC ,IADQ ,XDP ,IGRNOD ,
73 E DR ,INTBUF_TAB ,MULTI_FVM ,
74 F ALE_CONNECTIVITY,DDP ,NE_NERCVOIS,NE_NESDVOIS,
75 G NE_LERCVOIS ,NE_LESDVOIS ,XCELL ,XFACE ,WFEXT)
108 USE alew8_mod ,
ONLY : alew8
109 use element_mod ,
only : nixs,nixq
113#include "implicit_f.inc"
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"
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(*),
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,/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,*)
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
157 INTEGER I, N, ISK, LCOD, NINDX1, NINDX2,INDX1(1024), INDX2(1024), SIZEN
158 DOUBLE PRECISION VDT2
163 IF(imon > 0 .AND. itask == 0)
THEN
169 IF(
ale%SUB%IFSUB == 0)
THEN
173 IF(
ale%SUB%IALESUB /= 0)dt2=int(dt2s/dt2save)*dt2save
175 IF(iparit == 0)sizen = numnod
178 SELECT CASE (
ale%GRID%NWALE)
187 2 ale_connectivity%NN_CONNECT ,ale_connectivity%NALE ,nodft ,nodlt ,
188 3 nbrcvois,nbsdvois,lnrcvois ,lnsdvois )
197 2 ale_connectivity%NN_CONNECT ,ale_connectivity%NALE ,nodft ,nodlt ,
198 3 nbrcvois ,nbsdvois,lnrcvois,lnsdvois )
208 2 ale_connectivity%NALE ,iparg ,ixs ,wb ,
209 3 iad_elem,fr_elem,fr_nbcc ,sizen,adsky,
210 4 procne ,fsky ,fsky ,iads )
218 CALL wlag(v,w,ale_connectivity%NALE)
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),
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),
252 2 ale_connectivity%NN_CONNECT ,ale_connectivity%NALE ,nodft , nodlt ,
253 3 nbrcvois ,nbsdvois ,lnrcvois, lnsdvois,
254 4 skew ,iskew ,icodt)
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)
276 1 x ,v ,w ,ms ,ale_connectivity%NALE,
277 2 nodft ,nodlt ,weight ,numnod ,dt1 ,
278 3 sx ,sv ,sw ,nspmd )
286 CALL alew8(sv, sw, v ,w, nodft, nodlt, numnod, ale_connectivity%NALE)
295 IF (itask == 0)
CALL wlag(v,w,ale_connectivity%NALE)
300 IF(imon > 0 .AND. itask == 0)
CALL stoptime(timers,5)
304 1
CALL wpor(geo,nodpor ,x ,v ,vr ,
305 2 w ,ale_connectivity%NALE,nporgeo )
309 IF(imon > 0 .AND. itask == 0)
CALL startime(timers,4)
313 DO n = i,
min(numnod,i+1023)
314 IF(ale_connectivity%NALE(n) /= 0)
THEN
321 lcod=icodt(n+numnod+numnod)
329 CALL bcs2v(nindx1,indx1,iskew,icodt(numnod+1),w,skew)
332 CALL bcs3v(nindx2,indx2,iskew,icodt(2*numnod+1),w,v,skew)
335 IF(imon > 0 .AND. itask == 0)
CALL stoptime(timers,4)
340 IF(imon > 0 .AND. itask == 0)
CALL startime(timers,2)
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)
352 IF(imon > 0 .AND. itask == 0)
CALL startime(timers
354 IF(x(2,i)+dt2*w(2,i) >= zero)cycle
358 IF(imon > 0 .AND. itask == 0)
CALL stoptime(timers,5)
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)
372 IF(imon > 0 .AND. itask == 0)
CALL startime(timers,5)
374 IF(x(2,i)+dt2*w(2,i) >= zero)cycle
378 IF(imon > 0 .AND. itask == 0)
CALL stoptime(timers,5)
384 IF(imon > 0 .AND. itask == 0)
CALL startime(timers,4)
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)
398 CALL laser1(las ,xlas ,ms ,x ,v ,
399 . w ,wa ,iparg ,ixq ,pm ,
400 . tf ,npf ,elbuf_tab,wfext)
408 IF(impose_dr /= 0 .AND. iroddl /= 0)
THEN
409#include "vectorize.inc"
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)
420 IF(imon > 0 .AND. itask == 0)
CALL startime(timers,5)
424 IF (.NOT. multi_fvm%IS_USED)
THEN
426#include "vectorize.inc"
429 ddp(1,n) = ddp(1,n)+vdt2
431 xdp(1,n) = xdp(1,n)+vdt2
435 ddp(2,n) = ddp(2,n)+vdt2
437 xdp(2,n) = xdp(2,n)+vdt2
441 ddp(3,n) = ddp(3,n)+vdt2
443 xdp(3,n) = xdp(3,n)+vdt2
447#include "vectorize.inc"
466 IF(imon > 0 .AND. itask == 0)
THEN
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)