OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
alemain.F File Reference
#include "implicit_f.inc"
#include "comlock.inc"
#include "mvsiz_p.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "com06_c.inc"
#include "com08_c.inc"
#include "param_c.inc"
#include "vect01_c.inc"
#include "scr06_c.inc"
#include "scr17_c.inc"
#include "parit_c.inc"
#include "task_c.inc"
#include "spmd_c.inc"
#include "inter18.inc"
#include "inter22.inc"
#include "scr07_c.inc"
#include "stati_c.inc"
#include "macro.inc"
#include "tabsiz_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine alemain (timers, pm, geo, x, a, v, ms, wa, elbuf_tab, bufmat, partsav, tf, val2, veul, fv, stifn, fsky, eani, phi, fill, dfill, alph, skew, w, d, dsave, asave, dt2t, dt2save, xcell, iparg, npc, ixs, ixq, ixtg, iads, ifill, icodt, iskew, ims, iadq, neltst, ityptst, iparts, ipartq, itask, nodft, nodlt, nbrcvois, temp, fsavsurf, nbsdvois, lnrcvois, lnsdvois, nercvois, nesdvois, lercvois, lesdvois, isizxv, iad_elem, fr_elem, fskym, msnf, ipari, segvar, itab, iskwn, diffusion, iresp, volmon, fsav, igrsurf, neltsa, ityptsa, weight, npsegcom, lsegcom, ipm, igeo, itabm1, lenqmv, nv46, aglob, gresav, grth, igrth, lgauge, gauge, mssa, dmels, igaup, ngaup, table, ms0, xdp, igrnod, sfem_nodvar, fskyi, isky, s_sfem_nodvar, intbuf_tab, ixt, igrv, agrav, sensors, lgrav, condnsky, condn, ms_2d, multi_fvm, igrtruss, igrbric, nloc_dmg, id_global_vois, face_vois, ebcs_tab, ale_connectivity, mat_elem, h3d_data, dt, output, need_comm_inter18, idtmins, idtmin, maxfunc, imon_mat, userl_avail, impl_s, idyna, python, matparam, glob_therm)

Function/Subroutine Documentation

◆ alemain()

subroutine alemain ( type(timer_) timers,
pm,
geo,
x,
a,
v,
ms,
wa,
type(elbuf_struct_), dimension(ngroup), target elbuf_tab,
bufmat,
partsav,
tf,
val2,
veul,
fv,
stifn,
fsky,
eani,
phi,
fill,
dfill,
alph,
skew,
w,
d,
dsave,
asave,
dt2t,
dt2save,
dimension(3,sxcell), intent(inout) xcell,
integer, dimension(nparg,ngroup) iparg,
integer, dimension(*) npc,
integer, dimension(nixs,numels) ixs,
integer, dimension(nixq,numelq) ixq,
integer, dimension(nixtg,numeltg) ixtg,
integer, dimension(8,*) iads,
integer, dimension(numnod,*) ifill,
integer, dimension(*) icodt,
integer, dimension(*) iskew,
integer, dimension(*) ims,
integer, dimension(4,*) iadq,
integer neltst,
integer ityptst,
integer, dimension(*) iparts,
integer, dimension(*) ipartq,
integer itask,
integer nodft,
integer nodlt,
integer, dimension(*) nbrcvois,
temp,
dimension(th_surf_num_channel,nsurf), intent(inout) fsavsurf,
integer, dimension(*) nbsdvois,
integer, dimension(*) lnrcvois,
integer, dimension(*) lnsdvois,
integer, dimension(*) nercvois,
integer, dimension(*) nesdvois,
integer, dimension(*) lercvois,
integer, dimension(*) lesdvois,
integer isizxv,
integer, dimension(*) iad_elem,
integer, dimension(*) fr_elem,
fskym,
msnf,
integer, dimension(sipari) ipari,
type(t_segvar) segvar,
integer, dimension(numnod) itab,
integer, dimension(*) iskwn,
type(t_diffusion), intent(inout) diffusion,
integer, intent(in) iresp,
volmon,
fsav,
type (surf_), dimension(nsurf) igrsurf,
integer neltsa,
integer ityptsa,
integer, dimension(*) weight,
integer, dimension(*) npsegcom,
integer, dimension(*) lsegcom,
integer, dimension(npropmi,*) ipm,
integer, dimension(npropgi,numgeo) igeo,
integer, dimension(*) itabm1,
integer lenqmv,
integer nv46,
aglob,
gresav,
integer, dimension(*) grth,
integer, dimension(*) igrth,
integer, dimension(3,nbgauge) lgauge,
gauge,
mssa,
dmels,
integer, dimension(*) igaup,
integer, dimension(*) ngaup,
type(ttable), dimension(*) table,
ms0,
double precision, dimension(3,*) xdp,
type (group_), dimension(ngrnod) igrnod,
sfem_nodvar,
fskyi,
integer, dimension(*) isky,
integer, intent(in) s_sfem_nodvar,
type(intbuf_struct_), dimension(*) intbuf_tab,
integer, dimension(nixt,*) ixt,
integer, dimension(*) igrv,
agrav,
type (sensors_), intent(inout) sensors,
integer, dimension(*) lgrav,
condnsky,
condn,
ms_2d,
type(multi_fvm_struct) multi_fvm,
type (group_), dimension(ngrtrus) igrtruss,
type (group_), dimension(ngrbric) igrbric,
type (nlocal_str_) nloc_dmg,
integer, dimension(*), intent(in) id_global_vois,
integer, dimension(*), intent(in) face_vois,
type(t_ebcs_tab), intent(inout) ebcs_tab,
type(t_ale_connectivity), intent(inout) ale_connectivity,
type (mat_elem_), intent(inout) mat_elem,
type (h3d_database) h3d_data,
type (dt_), intent(inout) dt,
type(output_), intent(inout) output,
logical, intent(inout) need_comm_inter18,
integer, intent(in) idtmins,
integer, dimension(102) idtmin,
integer, intent(in) maxfunc,
integer, intent(in) imon_mat,
integer, intent(in) userl_avail,
integer, intent(in) impl_s,
integer, intent(in) idyna,
type(python_) python,
type(matparam_struct_), dimension(nummat), intent(in) matparam,
type (glob_therm_), intent(inout) glob_therm )
Parameters
[in]matparammaterial buffer
[in,out]need_comm_inter18true if the mpi comm "exchange of remote XCELL data" is mandatory
[in,out]outputoutput structure

Definition at line 92 of file alemain.F.

117C-----------------------------------------------
118C M o d u l e s
119C-----------------------------------------------
120 USE timer_mod
121 USE python_funct_mod
122 USE initbuf_mod
123 USE table_mod
124 USE mat_elem_mod
125 USE intbufdef_mod
126 USE alefvm_mod
127 USE multi_fvm_mod
128 USE groupdef_mod
129 USE nlocal_reg_mod
130 USE sensor_mod
131 USE ebcs_mod
132 USE bcs_mod , only : bcs
133 USE ale_connectivity_mod
134 USE diffusion_mod
135 USE segvar_mod
136 USE h3d_mod
137 USE ale_mod
138 USE dt_mod
139 USE output_mod
140 USE th_surf_mod , only : th_surf_num_channel
141 USE elbufdef_mod
142 USE multimat_param_mod , ONLY : m51_iflg6_size
143 USE matparam_def_mod, ONLY : matparam_struct_
144 use bcs_wall_trigger_mod
145 use glob_therm_mod
146 use element_mod , only : nixs,nixq,nixtg,nixt
147C-----------------------------------------------
148C I m p l i c i t T y p e s
149C-----------------------------------------------
150#include "implicit_f.inc"
151#include "comlock.inc"
152C-----------------------------------------------
153C G l o b a l P a r a m e t e r s
154C-----------------------------------------------
155#include "mvsiz_p.inc"
156C-----------------------------------------------
157C C o m m o n B l o c k s
158C-----------------------------------------------
159#include "com01_c.inc"
160#include "com04_c.inc"
161#include "com06_c.inc"
162#include "com08_c.inc"
163#include "param_c.inc"
164#include "vect01_c.inc"
165#include "scr06_c.inc"
166#include "scr17_c.inc"
167#include "parit_c.inc"
168#include "task_c.inc"
169#include "spmd_c.inc"
170#include "inter18.inc"
171#include "inter22.inc"
172#include "scr07_c.inc"
173#include "stati_c.inc"
174#include "macro.inc"
175#include "tabsiz_c.inc"
176C-----------------------------------------------
177C D u m m y A r g u m e n t s
178C-----------------------------------------------
179 TYPE(TIMER_) :: TIMERS
180 INTEGER,INTENT(IN) :: S_SFEM_NODVAR
181 TYPE(MATPARAM_STRUCT_),DIMENSION(NUMMAT),INTENT(IN) :: MATPARAM !< material buffer
182 INTEGER, INTENT(IN):: IRESP
183 integer,dimension(102) :: IDTMIN
184 INTEGER ,INTENT(IN) :: MAXFUNC
185 INTEGER, INTENT(IN) :: IMON_MAT
186 INTEGER, INTENT(IN) :: USERL_AVAIL
187 INTEGER, INTENT(IN) :: IMPL_S
188 INTEGER, INTENT(IN) :: IDYNA
189 my_real,INTENT(INOUT) :: fsavsurf(th_surf_num_channel,nsurf)
190 INTEGER IXS(NIXS,NUMELS),IXQ(NIXQ,NUMELQ),IXTG(NIXTG,NUMELTG), ISKY(*),
191 . IFILL(NUMNOD,*), NPC(*), IPARG(NPARG,NGROUP),
192 . IADS(8,*),IADQ(4,*),ICODT(*),ISKEW(*), IMS(*),
193 . IGEO(NPROPGI,NUMGEO),
194 . IPARTS(*) ,IPARTQ(*),IPM(NPROPMI,*),NODFT,
195 . NELTST ,ITYPTST, ITASK,
196 . NBRCVOIS(*),NBSDVOIS(*), LNRCVOIS(*), LNSDVOIS(*),
197 . NERCVOIS(*),NESDVOIS(*),LERCVOIS(*),LESDVOIS(*),
198 . NELTSA, ITYPTSA,NPSEGCOM(*),LSEGCOM(*),
199 . IAD_ELEM(*),FR_ELEM(*), IPARI(SIPARI),ITAB(NUMNOD),ISKWN(*),
200 . WEIGHT(*), ITABM1(*),
201 . ISIZXV, LENQMV,NV46,GRTH(*),IGRTH(*),LGAUGE(3,NBGAUGE),
202 . IGAUP(*),NGAUP(*),NODLT, IXT(NIXT,*),
203 . IGRV(*),LGRAV(*)
204 INTEGER, INTENT(IN) :: IDTMINS
205 ! for parith/on : ID_GLOBAL_VOIS --> user id ; FACE_VOIS --> face of the remote element
206 INTEGER, DIMENSION(*), INTENT(in) :: ID_GLOBAL_VOIS,FACE_VOIS
207 LOGICAL, INTENT(inout) :: NEED_COMM_INTER18 !< true if the mpi comm "exchange of remote XCELL data" is mandatory
208 DOUBLE PRECISION XDP(3,*)
209
210 my_real x(3,numnod),v(3,numnod),ms(*),pm(npropm,nummat),skew(lskew,*),
211 . geo(npropg,ngroup),bufmat(*) ,w(3,numnod),veul(*),fill(numnod,*),
212 . dfill(numnod,*),alph(*),tf(*),
213 . fv(*),a(3,numnod),val2(*),phi(*),
214 . partsav(*) ,stifn(*) ,d(3,numnod),dsave(3,*),asave(3,*),wa(*),
215 . fsky(*),eani(*), fskym(*),
216 . dt2t, dt2save,
217 . aglob(3,*),gauge(llgauge,*),ms0(*),
218 . msnf(*),volmon(*),fsav(nthvki,*),gresav(*),
219 . mssa(*), dmels(*),sfem_nodvar(s_sfem_nodvar),fskyi(lskyi,nfskyi),
220 . agrav(*),condn(*),condnsky(*),ms_2d(*),temp(*)
221
222 TYPE(t_segvar) :: SEGVAR
223 TYPE(TTABLE) TABLE(*)
224 TYPE(ELBUF_STRUCT_), TARGET, DIMENSION(NGROUP) :: ELBUF_TAB
225
226 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
227 TYPE(MULTI_FVM_STRUCT) :: MULTI_FVM
228 TYPE (NLOCAL_STR_) :: NLOC_DMG
229!
230 TYPE (GROUP_) , DIMENSION(NGRNOD) :: IGRNOD
231 TYPE (GROUP_) , DIMENSION(NGRBRIC) :: IGRBRIC
232 TYPE (GROUP_) , DIMENSION(NGRTRUS) :: IGRTRUSS
233 TYPE (SURF_) , DIMENSION(NSURF) :: IGRSURF
234 TYPE(t_ebcs_tab), INTENT(INOUT) :: EBCS_TAB
235 TYPE(t_ale_connectivity), INTENT(INOUT) :: ALE_CONNECTIVITY
236 TYPE(T_DIFFUSION),INTENT(INOUT) :: DIFFUSION
237 TYPE (MAT_ELEM_) ,INTENT(INOUT) :: MAT_ELEM
238 TYPE (H3D_DATABASE) :: H3D_DATA
239 TYPE (SENSORS_) ,INTENT(INOUT) :: SENSORS
240 my_real, INTENT(INOUT) :: xcell(3,sxcell)
241 TYPE (DT_) ,INTENT(INOUT) :: DT
242 TYPE(OUTPUT_), INTENT(INOUT) :: OUTPUT !< output structure
243 TYPE(PYTHON_) :: PYTHON
244 type (glob_therm_) ,intent(inout) :: glob_therm
245C-----------------------------------------------
246C L o c a l V a r i a b l e s
247C-----------------------------------------------
248 my_real, DIMENSION(MVSIZ,6) :: svis
249 INTEGER N, M, NG, NVC, NF1,OFFSET,ISOLNOD,NSG,NEL,I,LENCOM,ISTRA,IBID,IOUTPRT
250 INTEGER IPLA
251 INTEGER IADBH, IAD22, NIN, NBRIC_L
252 INTEGER SBUFVOIS,SZ_BUFVOIS
253
254 my_real fx(mvsiz,10),fy(mvsiz,10),fz(mvsiz,10),voln(mvsiz)
255 my_real, TARGET :: bid
256 my_real, DIMENSION(:,:),ALLOCATABLE,TARGET :: qmv
257 my_real, POINTER :: pqmv
258 ! SPMD array for adjacent data ALE/CFD
259 my_real, DIMENSION(:,:),ALLOCATABLE ::bufvois
260
261 LOGICAL :: PRED
262
263 SAVE bufvois
264
265 DATA offset/0/
266C-----------------------------------------------
267C S o u r c e L i n e s
268C-----------------------------------------------
269
270 ibid = 0
271 bid = zero
272 sbufvois = 6
273
274C IOUTPRT (assembly report)
275 ioutprt = 0
276 IF(mod(ncycle,iabs(ncpri)) == 0 .OR. tt >= output%TH%THIS .OR. mdess /= 0
277 . .OR. (ale%SUB%IALESUB /= 0 .AND. t1s+dt2s >= output%TH%THIS)
278 . .OR. tt >= output%TH%THIS1(1) .OR. tt >= output%TH%THIS1(2)
279 . .OR. tt >= output%TH%THIS1(3) .OR. tt >= output%TH%THIS1(4) .OR. tt >= output%TH%THIS1(5)
280 . .OR. tt >= output%TH%THIS1(6) .OR. tt >= output%TH%THIS1(7) .OR. tt >= output%TH%THIS1(8)
281 . .OR. tt >= output%TH%THIS1(9) .OR. nth /= 0 .OR. nanim /= 0
282 . .OR. tt >= tabfis(1) .OR. tt >= tabfis(2)
283 . .OR. tt >= tabfis(3) .OR. tt >= tabfis(4) .OR. tt >= tabfis(5)
284 . .OR. tt >= tabfis(6) .OR. tt >= tabfis(7) .OR. tt >= tabfis(8)
285 . .OR. tt >= tabfis(9) .OR. tt >= tabfis(10)
286 . .OR. (ale%SUB%IALESUB /= 0 .AND. t1s+dt2s >= output%TH%THIS1(1))
287 . .OR. (ale%SUB%IALESUB /= 0 .AND. t1s+dt2s >= output%TH%THIS1(2))
288 . .OR. (ale%SUB%IALESUB /= 0 .AND. t1s+dt2s >= output%TH%THIS1(3))
289 . .OR. (ale%SUB%IALESUB /= 0 .AND. t1s+dt2s >= output%TH%THIS1(4))
290 . .OR. (ale%SUB%IALESUB /= 0 .AND. t1s+dt2s >= output%TH%THIS1(5))
291 . .OR. (ale%SUB%IALESUB /= 0 .AND. t1s+dt2s >= output%TH%THIS1(6))
292 . .OR. (ale%SUB%IALESUB /= 0 .AND. t1s+dt2s >= output%TH%THIS1(7))
293 . .OR. (ale%SUB%IALESUB /= 0 .AND. t1s+dt2s >= output%TH%THIS1(8))
294 . .OR. (ale%SUB%IALESUB /= 0 .AND. t1s+dt2s >= output%TH%THIS1(9)) .OR. istat==3) ioutprt=1
295
296 ALLOCATE(qmv(2*nv46,lenqmv)) !MM-ALE 51 only !OPTIM : SHOULD BE ALLOCATED IN ARRALOC
297 IF(m51_iflg6 == 1)sbufvois = m51_iflg6_size
298
299 IF(itask==0)ALLOCATE(bufvois(sbufvois ,nsvois+nqvois)) !SPMD array of adjacent ALE/CFD elems !OPTIM : SHOULD BE ALLOCATED IN ARRALOC, same for FLUX_VOIS & N4_VOIS
300 IF(itask==0)sz_bufvois=sbufvois*(nsvois+nqvois)
301
302 IF(n2d /= 0 .AND. nmult /= 0)THEN
303 !WA(1:IADBH-1) = FLUX
304 !WA(IADBH:IADBH+MAX(1,NMULT)*NUMELQ-1) = BHOLE
305 iadbh=max(1,nmult)*4*numelq+1
306 ELSE
307 iadbh=1
308 ENDIF
309 !IFSUBM=1 : masse changed
310 ale%SUB%IFSUBM=1
311
312 IF(iale+ieuler /= 0)THEN
313 DO n=nodft,nodlt
314 IF(ale_connectivity%NALE(n) /= 0) ms0(n) = ms(n)
315 ENDDO
316 IF(alefvm_param%IEnabled > 0)THEN
317 DO n=nodft,nodlt
318 IF(ale_connectivity%NALE(n) /= 0) v(1:3,n) = zero !reset velocities
319 ENDDO
320 ENDIF
321 ENDIF
322
323 !---------------------------------------------
324 ! INTERFACE 18 - variable gap
325 !---------------------------------------------
326 IF(inter18_is_variable_gap_defined)THEN
327 need_comm_inter18 = .true.
328 DO ng=itask+1,ngroup,nthread
329 IF (tt > zero .AND. iparg(76, ng) == 1) cycle ! --> OFF
330 IF(iparg(8,ng) == 1) cycle
331 isolnod=iparg(28,ng)
332 CALL initbuf(
333 1 iparg ,ng ,
334 2 mtn ,nel ,nft ,iad ,ity ,
335 3 npt ,jale ,ismstr ,jeul ,jtur ,
336 4 jthe ,jlag ,jmult ,jhbe ,jivf ,
337 5 nvaux ,jpor ,jcvt ,jclose ,ipla ,
338 6 irep ,iint ,igtyp ,israt ,isrot ,
339 7 icsen ,isorth ,isorthg ,ifailure ,jsms )
340 IF (ity == 1 .AND. isolnod /= 4) THEN
341 DO i=1,nel
342 xcell(1,i+nft)=exp(log(elbuf_tab(ng)%GBUF%VOL(i))/three)
343 xcell(2,i+nft)=zero
344 xcell(3,i+nft)=zero
345 ENDDO
346 ENDIF
347 ENDDO
348 CALL my_barrier
349 IF(nspmd > 1)THEN
350!$OMP SINGLE
351 lencom = nercvois(nspmd + 1) + nesdvois(nspmd + 1)
352 CALL startime(timers, timer_spmdcfd)
353 CALL spmd_envois(3, xcell, nercvois, nesdvois, lercvois, lesdvois, lencom)
354 CALL stoptime(timers, timer_spmdcfd)
355!$OMP END SINGLE
356 ENDIF
357 ENDIF
358
359 !--------------------------------------------------------
360 ! F L U I D E
361 ! ALE SUB-CYCLING PREPARATION
362 ! ALE%SUB%IALESUB=1 LEGACY IMPLEMENTATION, NOT PARALLEL, DELETED IN V11
363 ! ALE%SUB%IALESUB=2 PARALLEL IMPLMEMENTATION IN 2002
364 !--------------------------------------------------------
365 IF(ale%SUB%IALESUB /= 0) CALL my_barrier
366 !-----
367 IF(ale%SUB%IALESUB == 2)THEN
368 IF(itask == 0)THEN
369 IF(tt == zero .OR. tt+dt1 > t1s+dt2s)THEN
370 ale%SUB%IFSUB = 0
371 ale%SUB%IFSUBM = 1
372 ale%SUB%DT1SAVE= dt1
373 dt1 = tt-t1s
374 t1s = tt
375 ELSE
376 ale%SUB%IFSUB=1
377 ale%SUB%IFSUBM=0
378 ENDIF
379 ENDIF
380 CALL my_barrier
381 IF(ale%SUB%IFSUB == 0)THEN
382 neltsa = neltst
383 ityptsa = ityptst
384 dt2save = dt2t
385 dt2t = ep30
386 ENDIF
387 CALL alesub1(ale_connectivity%NALE,v,w,dsave,icodt,iskew,skew,d,itask,nodft,nodlt,fsky,fsky)
388 ENDIF
389 IF(ale%SUB%IALESUB == 0 .AND. itask == 0)THEN
390 ale%SUB%IFSUB = 0
391 t1s = tt
392 ENDIF
393 !-----
394
395 IF (glob_therm%ITHERM == 1 .AND. iale+ieuler == 0) ale%SUB%IFSUBM=0
396C----------------------------------
397C ALE - EULER - THERMAL
398C WA = flux for sforc3 and qforc3
399C----------------------------------
400
401 CALL my_barrier
402C
403 IF (iparit == 0 .AND. nspmd > 1 .AND. ale%SUB%IFSUBM == 1 .AND. n2d == 0 .AND. ale%GLOBAL%INCOMP == 0) THEN
404 DO n = nodft, nodlt
405 ms(n) = ms(n)*weight(n)
406 msnf(n) = msnf(n)*weight(n)
407 ENDDO
408 CALL my_barrier
409 ENDIF
410C---------------------------------------------------------
411C ALE - EULER + 2D : update masses
412C---------------------------------------------------------
413 IF (n2d > 0 .AND. ale%SUB%IFSUBM == 1) THEN
414 DO n = nodft, nodlt
415 ms_2d(n) = zero
416 ENDDO
417 CALL my_barrier
418 ENDIF
419C
420 IF(ale%SUB%IFSUB == 0)THEN
421 IF(itask==0) CALL startime(timers,macro_timer_ifsub0)
422 IF(iale+ieuler+glob_therm%ITHERM /= 0)THEN
423 IF(ale%GLOBAL%INCOMP == 0) THEN
424 IF(nsegflu > 0 .AND. n2d == 0) THEN
425 CALL seggetv(iparg,elbuf_tab,ale_connectivity,itask,segvar)
426 ! Comm SPMD SEGVAR Pi -> P0
427 IF(nspmd > 1) THEN
428!$OMP SINGLE
429 CALL startime(timers, timer_spmdcfd)
430 CALL spmd_segcom(segvar,npsegcom,lsegcom,npsegcom(nspmd+1),0)
431 CALL stoptime(timers, timer_spmdcfd)
432!$OMP END SINGLE
433 ENDIF
434 ENDIF
435 !------------------------------------------------!
436 ! INTERFACE CONVECTIONS !
437 !------------------------------------------------!
438 IF(ninter /= 0)THEN
439 !element from Interface type 12 calculated on proc_0 + sending X proc_i -> proc_0
440 !Sending X for interface type 12 ?
441 IF (itask == 0 .AND. ispmd == 0)
442 . CALL intti0(ipari ,x ,v ,wa ,itab ,iparg ,ixs ,segvar ,skew ,iskwn ,intbuf_tab)
443 CALL my_barrier
444 ENDIF
445 !------------------------------------------------!
446 ! ELEMENTARY BCS (/EBCS) !
447 !------------------------------------------------!
448 IF(nebcs > 0)THEN
449 IF(itask == 0)THEN
450 i=1+ninter+nrwall+nrbody+nsect+njoint+nrbag
451 CALL ebcs_main(igrsurf,segvar,volmon,
452 . a,v,w,x,fsav(1,i),fv,
453 . ms,stifn,iparg,
454 . elbuf_tab,ebcs_tab,multi_fvm,ixq,ixs,ixtg,
455 . fsky,fsavsurf,tt,dt1,
456 . sensors%NSENSOR,sensors%SENSOR_TAB,python,
457 . npc, tf ,snpc, stf, output, matparam, pm,
458 . bufmat)
459 ENDIF
460 CALL my_barrier
461 ENDIF
462 !------------------------------------------------!
463 IF(nsegflu > 0) THEN
464C Comm SPMD SEGVAR P0 -> Pi
465 IF(nspmd > 1) THEN
466!$OMP SINGLE
467 CALL startime(timers, timer_spmdcfd)
468 CALL spmd_segcom(segvar,npsegcom,lsegcom,npsegcom(nspmd+1),1)
469 CALL stoptime(timers, timer_spmdcfd)
470C Comm SPMD P0 -> Pi time T=0 depending on EBCS type
471 IF(tt == zero)THEN
472 CALL spmd_init_ebcs(v,isizxv,iad_elem,fr_elem, ebcs_tab)
473 ENDIF
474!$OMP END SINGLE
475 ENDIF
476 ENDIF
477c
478 !==========inter22=================================================================
479 !------------------------------------------------!
480 ! SUPERCELLS MANAGEMENT + VELOCITY INTERPOLATION !
481 !------------------------------------------------!
482 IF(int22>0)THEN
483 nin = 1 !temporary (max 1 interface) !!!interface number
484 iad22 = ipari(npari*(nin-1)+39)
485 nbric_l = igrbric(ipari(npari*(nin-1)+45))%NENTITY
486
487 CALL my_barrier
488
489 CALL sinit22_fvm(
490 1 ixs , elbuf_tab, iparg, itab , itask ,
491 2 ibid , nbric_l , x , ale_connectivity , v ,
492 3 nv46 , veul , igrnod, ipari, igrtruss ,
493 4 ixt , bufmat , ipm
494 5 )
495 ENDIF
496 !==================================================================================
497
498 IF (multi_fvm%IS_USED) THEN
499
500 IF(itask==0) CALL startime(timers,macro_timer_multifvm)
501C -------------------------
502C Multifluid law variable globalization
503C LBUF -> GBUF
504C -------------------------
505 IF (tt == zero) THEN
506 CALL multi_globalize(elbuf_tab, iparg, itask, multi_fvm,
507 . partsav, iparts, gresav, igrth, grth)
508 IF (multi_fvm%NS_DIFF) THEN
509 DO ng = itask + 1, ngroup, nthread
510 IF (iparg(1, ng) == 151) THEN
511 nel = iparg(2, ng)
512 nft = iparg(3, ng)
513 ity = iparg(5, ng)
514 CALL multi_computevolume(nel, ng, iparg, multi_fvm%SYM,
515 . elbuf_tab, ixs, ixq, ixtg, multi_fvm%VOL(1 + nft : nel + nft),x)
516 ENDIF
517 ENDDO
518 ENDIF
519 CALL my_barrier
520C -------------------------
521C Multifluid pressure equilibration
522C -------------------------
523 CALL multi_pressure_equilibrium(dt1, elbuf_tab, iparg, itask, ixs, ixq, ixtg,
524 . pm, ipm, multi_fvm, tt, bufmat,npc,tf,nummat,matparam)
525C ------------------------
526C Build FVM Connectivities
527C ------------------------
528 CALL build_connectivity(itask, multi_fvm, ale_connectivity, iparg)
529 CALL my_barrier
530C -------------------------
531C Wall boundary condition
532C -------------------------
533!$OMP SINGLE
534 IF(bcs%NUM_WALL > 0)THEN
535 CALL bcs_wall_trigger(tt,ale_connectivity,sensors%NSENSOR,sensors%SENSOR_TAB)
536 ENDIF
537!$OMP END SINGLE
538C ---------------------
539C Face data computation
540C ---------------------
541 CALL multi_face_elem_data(itask, iparg, ixs, ixq, ixtg, x, w, multi_fvm)
542 CALL my_barrier
543 IF (nspmd > 1 .AND. ((multi_fvm%MUSCL > 0) .OR. multi_fvm%NS_DIFF)) THEN
544!$OMP SINGLE
545 lencom = nercvois(nspmd + 1) + nesdvois(nspmd + 1)
546 CALL startime(timers, timer_spmdcfd)
547 CALL spmd_envois(3, multi_fvm%ELEM_DATA%CENTROID,nercvois, nesdvois, lercvois, lesdvois, lencom)
548 IF (ALLOCATED(multi_fvm%VOL)) THEN
549 CALL spmd_envois(1, multi_fvm%VOL, nercvois, nesdvois, lercvois, lesdvois, lencom)
550 ENDIF
551 CALL stoptime(timers, timer_spmdcfd)
552!$OMP END SINGLE
553 CALL my_barrier
554 ENDIF
555C -------------------------
556C Multifluid law time step computation
557C -------------------------
558 CALL multi_compute_dt(dt2t, elbuf_tab, iparg, itask, ixs, ixq, ixtg,
559 . pm, ipm, multi_fvm, w, x,
560 . neltst, ityptst)
561C -------------------------
562C Internal forces and nodal mass computation
563C -------------------------
564 IF(n2d == 0)THEN
565 DO i=nodft,nodlt
566 ms(i)=ms(i)-msnf(i)
567 msnf(i)=zero
568 ENDDO
569 ENDIF
570 CALL my_barrier
571 IF (iale > 0) THEN
572 CALL multi_fvm2fem(dt1, elbuf_tab, itask,
573 . ixs, ixq, iparg, x, a, v, w, ms, msnf, veul,
574 . stifn, fsky, iads, fskym,
575 . condn, condnsky, multi_fvm,glob_therm%NODADT_THERM)
576 ENDIF
577 CALL my_barrier
578!$OMP SINGLE
579 multi_fvm%IS_RESTART = .false.
580!$OMP END SINGLE
581 ELSE
582 IF (multi_fvm%IS_RESTART) THEN
583C -------------------------
584C Multifluid law variable globalization
585C LBUF -> GBUF
586C -------------------------
587 CALL multi_buf2var(itask, iparg, multi_fvm, elbuf_tab)
588 CALL my_barrier
589C -------------------------
590C Multifluid pressure equilibration
591C -------------------------
592 CALL multi_pressure_equilibrium(dt1, elbuf_tab, iparg, itask, ixs, ixq, ixtg,
593 . pm, ipm, multi_fvm, tt, bufmat,npc,tf,nummat,matparam)
594C ------------------------
595C Build FVM Connectivities
596C ------------------------
597 CALL build_connectivity(itask, multi_fvm, ale_connectivity, iparg)
598 CALL my_barrier
599
600 CALL multi_face_elem_data(itask, iparg, ixs, ixq, ixtg, x, w, multi_fvm)
601 CALL my_barrier
602 IF (nspmd > 1 .AND. multi_fvm%MUSCL > 0) THEN
603!$OMP SINGLE
604 lencom = nercvois(nspmd + 1) + nesdvois(nspmd + 1)
605 CALL startime(timers,timer_spmdcfd)
606 CALL spmd_envois(3, multi_fvm%ELEM_DATA%CENTROID,
607 . nercvois, nesdvois, lercvois, lesdvois, lencom)
608 CALL stoptime(timers,timer_spmdcfd)
609!$OMP END SINGLE
610 CALL my_barrier
611 ENDIF
612!$OMP SINGLE
613 multi_fvm%IS_RESTART = .false.
614!$OMP END SINGLE
615 ENDIF
616C -------------------------
617C Gravity terms
618C -------------------------
619 CALL alefvm_grav_init(python,
620 1 agrav, igrv , lgrav, sensors%NSENSOR,sensors%SENSOR_TAB,
621 2 itask, npc , tf , skew )
622
623C -------------------------
624C Wall boundary condition
625C -------------------------
626!$OMP SINGLE
627 IF(bcs%NUM_WALL > 0)THEN
628 CALL bcs_wall_trigger(tt,ale_connectivity,sensors%NSENSOR,sensors%SENSOR_TAB)
629 ENDIF
630!$OMP END SINGLE
631
632 CALL my_barrier
633
634 IF (multi_fvm%MUSCL == 1) THEN
635C --------------------------------------------------
636C Multifluid law time evolution --> Prediction phase
637C Half time step evolution
638C --------------------------------------------------
639 pred = .true.
640
641 CALL multi_timeevolution(timers,half * dt1, elbuf_tab, iparg, itask, ixs, ixq, ixtg,
642 . pm, ipm, multi_fvm, ale_connectivity, v, a, w, x, d, ale_connectivity%NALE,
643 . partsav, iparts, gresav, igrth, grth,
644 . nercvois, nesdvois, lercvois, lesdvois,
645 . itab, itabm1, tt - dt1,
646 . stifn, fsky, iads, fskym,
647 . condn, condnsky, bufmat, fv, pred,id_global_vois,face_vois,ebcs_tab,npc,tf,fsavsurf,matparam,
648 . output%TH%WFEXT, output)
649
650 CALL my_barrier
651C -------------------------
652C Multifluid pressure computation
653C -------------------------
654 CALL multi_pressure_equilibrium(dt1, elbuf_tab, iparg, itask, ixs, ixq, ixtg,
655 . pm, ipm, multi_fvm, tt - dt1, bufmat,npc,tf,nummat,matparam)
656 CALL my_barrier
657C --------------------------------------------------
658C Multifluid law time evolution --> Correction phase
659C Full time step evolution, with predicted fluxes
660C --------------------------------------------------
661 pred = .false.
662
663 CALL multi_timeevolution(timers,dt1, elbuf_tab, iparg, itask, ixs, ixq, ixtg,
664 . pm, ipm, multi_fvm, ale_connectivity, v, a, w, x, d, ale_connectivity%NALE,
665 . partsav, iparts, gresav, igrth, grth,
666 . nercvois, nesdvois, lercvois, lesdvois,
667 . itab, itabm1, tt - dt1,
668 . stifn, fsky, iads, fskym,
669 . condn, condnsky, bufmat, fv, pred,id_global_vois,face_vois,ebcs_tab,npc,tf,fsavsurf,matparam,
670 . output%TH%WFEXT, output)
671
672 CALL my_barrier
673C -------------------------
674C Multifluid pressure equilibration
675C -------------------------
676 CALL multi_pressure_equilibrium(dt1, elbuf_tab, iparg, itask, ixs, ixq, ixtg,
677 . pm, ipm, multi_fvm, tt, bufmat,npc,tf,nummat,matparam)
678 CALL my_barrier
679 ELSE
680C -------------------------
681C Multifluid law time evolution
682C -------------------------
683 CALL multi_timeevolution(timers,dt1, elbuf_tab, iparg, itask, ixs, ixq, ixtg,
684 . pm, ipm, multi_fvm, ale_connectivity, v, a, w, x, d, ale_connectivity%NALE,
685 . partsav, iparts, gresav, igrth, grth,
686 . nercvois, nesdvois, lercvois, lesdvois,
687 . itab, itabm1, tt - dt1,
688 . stifn, fsky, iads, fskym,
689 . condn, condnsky, bufmat, fv, .false.,id_global_vois,face_vois,ebcs_tab,npc,tf,fsavsurf,matparam,
690 . output%TH%WFEXT, output)
691 CALL my_barrier
692
693 IF (multi_fvm%NS_DIFF) THEN
694!$OMP SINGLE
695 CALL ns_fvm_diffusion(ale_connectivity, multi_fvm, dt1, ebcs_tab, diffusion,
696 . ipm, pm, iparg, elbuf_tab, nercvois, nesdvois, lercvois, lesdvois,
697 . ixs, fv)
698!$OMP END SINGLE
699 ENDIF
700C -------------------------
701C Multifluid pressure equilibration
702C -------------------------
703 CALL multi_pressure_equilibrium(dt1, elbuf_tab, iparg, itask, ixs, ixq, ixtg,
704 . pm, ipm, multi_fvm, tt, bufmat,npc,tf,nummat,matparam)
705 CALL my_barrier
706 ENDIF
707
708C -------------------------
709C Save old values into ELBUF_TAB struct
710C -------------------------
711 CALL multi_var2buf(itask, iparg, multi_fvm, elbuf_tab)
712 CALL my_barrier
713C -------------------------
714C Internal forces and nodal mass computation
715C -------------------------
716 IF(n2d == 0)THEN
717 DO i=nodft,nodlt
718 ms(i)=ms(i)-msnf(i)
719 msnf(i)=zero
720 ENDDO
721 ENDIF
722 CALL my_barrier
723 IF (iale > 0) THEN
724 CALL multi_fvm2fem(dt1, elbuf_tab, itask,
725 . ixs, ixq, iparg, x, a, v, w, ms, msnf, veul,
726 . stifn, fsky, iads, fskym,
727 . condn, condnsky, multi_fvm,glob_therm%NODADT_THERM)
728 CALL my_barrier
729 ENDIF
730C -------------------------
731C Multifluid law time step computation
732C -------------------------
733 CALL multi_compute_dt(dt2t, elbuf_tab, iparg, itask, ixs, ixq, ixtg, pm, ipm, multi_fvm, w, x, neltst, ityptst)
734 CALL my_barrier
735 ENDIF
736 IF(itask==0) CALL stoptime(timers,macro_timer_multifvm)
737
738 ELSE
739
740!------------------------------------------------!
741! CONVECTION, CONDUCTION, REZONING !
742!------------------------------------------------!
743 CALL alethe(
744 1 iparg, elbuf_tab, wa, val2,
745 2 phi, ale_connectivity,ixs, ixq,
746 3 v, w, x, pm,
747 4 ms, veul, fill, dfill,
748 5 alph, fv, bufmat, tf,
749 6 npc, itask, nbrcvois, nbsdvois,
750 7 lnrcvois, lnsdvois, nercvois, nesdvois,
751 8 lercvois, lesdvois, segvar,
752 9 msnf, nodft, nodlt, wa(iadbh),
753 a ipm, qmv, itab, itabm1,
754 b lenqmv, nv46,
755 c iad_elem, glob_therm,
756 d fr_elem, matparam)
757 ENDIF
758 ELSE
759 ale%SUB%IFSUBM=0
760 ENDIF
761C
762 CALL my_barrier
763C
764 !---------------------------------------------
765 ! MULTIMATERIAL - LAW20(BIMAT)
766 !---------------------------------------------
767 IF(nmult > 0)THEN
768 DO n=nodft,nodlt
769 ims(n)=0
770 DO m=1,nmult
771 ifill(n,m)=-2
772 dfill(n,m)=zero
773 ENDDO
774 ENDDO
775 ENDIF
776
777 !---------------------------------------------
778 ! ALEFVM : FINITE VOLUME FOR MOMENTUM
779 !---------------------------------------------
780 IF(alefvm_param%IEnabled > 0) THEN
781 !GRAVITY INIT
782 ! VERTEX(4,1:NUMNOD) = ZERO !-> not needed, nodes remain the same ones and VERTEX is initialized on allocation
783 CALL alefvm_grav_init(python,
784 1 agrav, igrv , lgrav, sensors%NSENSOR,sensors%SENSOR_TAB,
785 2 itask , npc , tf , skew )
786 ENDIF
787
788
789 CALL my_barrier !MM-ALE 20 + ALEFVM
790
791 !---------------------------------------------
792 ! TETRA4 : SMOOTH FINITE ELEMENT FORMULATIONS
793 !---------------------------------------------
794!$OMP SINGLE
795 IF(isfem >= 1) THEN
796 CALL s4alesfem(iparg,ixs,x,elbuf_tab,sfem_nodvar,s_sfem_nodvar,pm,iad_elem,fr_elem)
797 ENDIF
798!$OMP END SINGLE
799
800 !---------------------------------------------
801 ! /ALE/GRID/FLOW-TRACKING - INIT BUFFER
802 !---------------------------------------------
803 IF(ale%GRID%NWALE == 7) THEN
804!$OMP SINGLE
805 ale%GRID%flow_tracking_data%EP(1:9)=zero
806 ale%GRID%flow_tracking_data%SUM_M = zero
807 ale%GRID%flow_tracking_data%SUM_VOL = zero
808 ale%GRID%flow_tracking_data%NUM_ELEM_ALE = 0
809!$OMP END SINGLE
810 ENDIF
811
812 !---------------------------------------------
813 ! ALL ELEMENTS EXPECT LAW/=11
814 !---------------------------------------------
815 DO ng=itask+1,ngroup,nthread
816C ALE ON / OFF
817 sensors%NGR_SENSOR(itask+1) = ng
818 IF (tt > zero .AND. iparg(76, ng) == 1) cycle ! --> OFF
819 IF(iparg(8,ng) /= 1) THEN
820C
821 CALL initbuf(iparg ,ng ,
822 2 mtn ,nel ,nft ,iad ,ity ,
823 3 npt ,jale ,ismstr ,jeul ,jtur ,
824 4 jthe ,jlag ,jmult ,jhbe ,jivf ,
825 5 nvaux ,jpor ,jcvt ,jclose ,ipla ,
826 6 irep ,iint ,igtyp ,israt ,isrot ,
827 7 icsen ,isorth ,isorthg ,ifailure,jsms )
828C
829 IF (mtn == 151) cycle
830 IF(jlag /= 1 .AND. ity <= 2) THEN
831 IF(iparg(64,ng)==1) ilaw11=1 !place later in starter>priv>spmd>ddsplit>c_vois() for law51
832 IF (mtn /= 0 .AND. iparg(64,ng)==0) THEN !IPARG(64) : law11 & law51-outlet
833 nsg =iparg(10,ng)
834 nvc =iparg(19,ng)
835 isolnod=iparg(28,ng)
836 istra =iparg(44,ng)
837 jsph =0
838 jplasol=ipla
839 isph2sol = 0
840 ipartsph = iparg(69,ng)
841 lft=1
842 llt=nel
843 nf1=nft+1
844C
845 IF (ity == 1 .AND. isolnod == 4) THEN
846 CALL s4forc3(timers, output,
847 1 elbuf_tab, ng, pm, geo,
848 2 ixs, x, a, v,
849 3 ms, w, wa, val2,
850 4 veul, fv, ale_connectivity,iparg,
851 5 tf, npc, bufmat, partsav,
852 6 nloc_dmg, dt2t, neltst, ityptst,
853 7 stifn, fsky, iads, offset,
854 8 eani, iparts(nf1), fx(1,1), fy(1,1),
855 9 fz(1,1), fx(1,2), fy(1,2), fz(1,2),
856 a fx(1,3), fy(1,3), fz(1,3), fx(1,4),
857 b fy(1,4), fz(1,4), nel, fskym,
858 c msnf, ipm, igeo, bufvois,
859 d istra, itask, bid, bid,
860 e bid, ibid, gresav, grth,
861 f igrth, mssa, dmels, table,
862 g xdp, sfem_nodvar, voln, bid,
863 h bid, d, sensors, ioutprt,
864 i mat_elem, ibid, dt, idel7nok,
865 j nsvois, sz_bufvois, snpc, stf,
866 k sbufmat, svis, idtmins, iresp,
867 * idel7ng, maxfunc, userl_avail, glob_therm,
868 v impl_s, idyna, s_sfem_nodvar)
869C
870 ELSEIF (ity == 1 .AND. isolnod /= 4) THEN
871 NULLIFY(pqmv);
872 IF(trimat>0)THEN
873 pqmv => qmv(1,1+nft)
874 ELSE
875 pqmv => bid
876 ENDIF
877 CALL sforc3(timers,output,
878 1 elbuf_tab, ng, pm, geo,
879 2 ixs, x, nv46, a,
880 3 v, ms, w, wa,
881 4 val2, veul, fv, ale_connectivity,
882 5 iparg, tf, npc, bufmat,
883 6 partsav, itab, dt2t, neltst,
884 7 ityptst, stifn, fsky, iads,
885 8 offset, eani, iparts(1+nft), fx(1,1),
886 9 fy(1,1), fz(1,1), fx(1,2), fy(1,2),
887 a fz(1,2), fx(1,3), fy(1,3), fz(1,3),
888 b fx(1,4), fy(1,4), fz(1,4), fx(1,5),
889 c fy(1,5), fz(1,5), fx(1,6), fy(1,6),
890 d fz(1,6), fx(1,7), fy(1,7), fz(1,7),
891 e fx(1,8), fy(1,8), fz(1,8), nel,
892 f fskym, msnf, isky, fskyi,
893 g nvc, ipm, igeo, bid,
894 h bid, bid, bid, bid,
895 i bufvois, itask, pqmv, istra,
896 j temp, bid, bid, ibid,
897 k gresav, grth, igrth, mssa,
898 l dmels, table, bid, bid,
899 m bid, bid, bid, bid,
900 n bid, bid, bid, iparg(1,ng),
901 o xdp, bid, ibid, ibid,
902 p voln, condn, condnsky, agrav,
903 q igrv, lgrav, sensors, skew,
904 r ale_connectivity%NALE, d, ioutprt, nloc_dmg,
905 s mat_elem, ibid, dt, idel7nok,nsvois,
906 t sz_bufvois, snpc, stf, sbufmat,svis,idtmins,iresp,
907 u idel7ng, maxfunc, userl_avail, glob_therm,
908 v impl_s, idyna, output%TH%WFEXT)
909C
910 ELSEIF (ity == 2 .AND. jmult == 0) THEN
911 NULLIFY(pqmv);
912 IF(trimat>0)THEN
913 pqmv => qmv(1,1+nft)
914 ELSE
915 pqmv => bid
916 ENDIF
917 CALL qforc2(timers, output,
918 . elbuf_tab ,ng ,
919 1 pm ,geo ,ixq ,x ,a ,
920 2 v ,ms ,w ,wa ,val2 ,
921 3 veul ,ale_connectivity ,iparg ,nloc_dmg ,
922 4 tf ,npc ,bufmat ,partsav ,
923 5 dt2t ,neltst ,ityptst ,stifn ,offset ,
924 6 eani ,ipartq(1+nft) ,nel ,iadq ,fsky ,
925 9 ipm ,bufvois ,pqmv ,
926 a gresav ,grth ,igrth ,table ,igeo ,
927 b voln ,itask ,ms_2d ,fskym ,ioutprt ,
928 c mat_elem ,h3d_data%STRAIN ,sz_bufvois ,snpc ,stf ,sbufmat ,
929 d svis ,nsvois ,iresp ,tt ,dt1 ,
930 . idel7nok ,idtmin ,maxfunc ,
931 . imon_mat ,userl_avail ,impl_s ,idyna ,
932 . dt ,glob_therm ,sensors)
933c
934 ELSEIF (ity == 2 .AND. jmult /= 0) THEN
935 CALL bforc2(timers,
936 . elbuf_tab , ng ,
937 1 pm , geo ,ixq , x ,
938 2 a , v ,ms , w , wa ,
939 3 val2 , veul ,ale_connectivity, iparg ,
940 4 iparg(1,ng) , fill ,dfill , ims , nloc_dmg ,
941 5 tf , npc ,bufmat , partsav ,
942 6 dt2t , neltst ,ityptst , stifn , offset ,
943 7 eani , ipartq(1+nft) ,nel , iadq , fsky ,
944 8 ipm , bufvois ,
945 9 gresav , grth ,igrth , table , igeo ,
946 o voln , itask ,ms_2d , fskym , mat_elem ,
947 b ibid , output ,sz_bufvois , snpc , stf ,sbufmat, svis,
948 c nsvois , iresp ,idel7nok ,
949 d idtmin , maxfunc ,imon_mat ,
950 e userl_avail , impl_s , idyna ,dt ,
951 f glob_therm , sensors)
952 ENDIF
953 ENDIF
954 ENDIF
955 ENDIF
956 ENDDO
957C
958 !---------------------------------------------
959 ! ELEMENTS : LAW==11
960 !---------------------------------------------
961 CALL my_barrier !wait for adjacent elems
962 IF (ilaw11 /= 0) THEN !Law11 or Law51 in/Out
963 IF(nspmd > 1) THEN
964 ! SPMD COMMUNICATION VOISINS LOI11
965 !
966 ! WA[1..IADC-1] : FLUX
967 ! WA[IADC..IADD-1] : BUFVOIS (buffer elements voisins en SPMD)
968 ! WA[IADD..LENWA] : BUFCOM (wa pour comm spmd)
969!$OMP SINGLE
970 CALL startime(timers,timer_spmdcfd)
971 lencom=nbrcvois(nspmd+1)+nbsdvois(nspmd+1)
972 IF(m51_iflg6 == 0) THEN
973 !======LAW11-NRF/SPMD=====================================!
974 ! comm adjacent domains
975 CALL spmd_xvois(
976 1 v ,nbrcvois,nbsdvois,lnrcvois,lnsdvois,
977 2 lencom )
978 ! to be optimized depending on combination of options
979 IF(ale%GLOBAL%INCOMP == 1 .OR. iturb + glob_therm%ITHERM == 0)
980 . CALL spmd_xvois(x,nbrcvois,nbsdvois,lnrcvois,lnsdvois,lencom )
981 ! Comm adjacent elems
982 CALL spmd_l11vois(
983 1 bufvois ,iparg ,elbuf_tab,pm ,ixs ,
984 2 ixq ,nercvois,nesdvois,lercvois,lesdvois,
985 3 lencom )
986 ELSE
987 !======LAW51-NRF/SPMD=====================================!
988 CALL spmd_l51vois(
989 1 bufvois ,iparg ,elbuf_tab,pm ,ixs ,
990 2 ixq ,nercvois,nesdvois,lercvois,lesdvois,
991 3 lencom ,ipm ,bufmat)
992 ENDIF
993 CALL stoptime(timers,timer_spmdcfd)
994!$OMP END SINGLE
995 ENDIF
996
997 DO ng=itask+1,ngroup,nthread
998C ALE ON / OFF
999 sensors%NGR_SENSOR(itask+1) = ng
1000 IF (tt > zero .AND. iparg(76, ng) == 1) cycle ! --> OFF
1001 CALL initbuf(iparg ,ng ,
1002 2 mtn ,nel ,nft ,iad ,ity ,
1003 3 npt ,jale ,ismstr ,jeul ,jtur ,
1004 4 jthe ,jlag ,jmult ,jhbe ,jivf ,
1005 5 nvaux ,jpor ,jcvt ,jclose ,ipla ,
1006 6 irep ,iint ,igtyp ,israt ,isrot ,
1007 7 icsen ,isorth ,isorthg ,ifailure,jsms )
1008 IF (mtn == 151) cycle
1009 IF (iparg(8,ng) /= 1) THEN
1010 IF (jlag /= 1 .AND. ity <= 2) THEN
1011 IF (mtn == 11 .OR. iparg(64,ng) == 1) THEN
1012 nsg =iparg(10,ng)
1013 nvc =iparg(19,ng)
1014 isolnod=iparg(28,ng)
1015 istra = iparg(44,ng)
1016 jsph =0
1017 isph2sol = 0
1018 ipartsph = iparg(69,ng)
1019
1020 lft=1
1021 llt=nel
1022 nf1=nft+1
1023
1024 IF(ity == 1 .AND. isolnod == 4)THEN
1025 CALL s4forc3(timers, output,
1026 1 elbuf_tab, ng, pm, geo,
1027 2 ixs, x, a, v,
1028 3 ms, w, wa, val2,
1029 4 veul, fv, ale_connectivity,iparg,
1030 5 tf, npc, bufmat, partsav,
1031 6 nloc_dmg, dt2t, neltst, ityptst,
1032 7 stifn, fsky, iads, offset,
1033 8 eani, iparts(nf1), fx(1,1), fy(1,1),
1034 9 fz(1,1), fx(1,2), fy(1,2), fz(1,2),
1035 a fx(1,3), fy(1,3), fz(1,3), fx(1,4),
1036 b fy(1,4), fz(1,4), nel, fskym,
1037 c msnf, ipm, igeo, bufvois,
1038 d istra, itask, bid, bid,
1039 e bid, ibid, gresav, grth,
1040 f igrth, mssa, dmels, table,
1041 g xdp, sfem_nodvar, voln, bid,
1042 h bid, d, sensors, ioutprt,
1043 i mat_elem, ibid, dt, idel7nok,
1044 j nsvois, sz_bufvois, snpc, stf,
1045 k sbufmat, svis, idtmins, iresp,
1046 * idel7ng, maxfunc, userl_avail, glob_therm,
1047 v impl_s, idyna, s_sfem_nodvar)
1048
1049 ELSEIF(ity == 1 .AND. isolnod /= 4)THEN
1050 NULLIFY(pqmv);
1051 IF(trimat>0)THEN
1052 pqmv => qmv(1,1+nft)
1053 ELSE
1054 pqmv => bid
1055 ENDIF
1056 CALL sforc3(timers, output,
1057 1 elbuf_tab, ng, pm, geo,
1058 2 ixs, x, nv46, a,
1059 3 v, ms, w, wa,
1060 4 val2, veul, fv, ale_connectivity,
1061 5 iparg, tf, npc, bufmat,
1062 6 partsav, itab, dt2t, neltst,
1063 7 ityptst, stifn, fsky, iads,
1064 8 offset, eani, iparts(1+nft), fx(1,1),
1065 9 fy(1,1), fz(1,1), fx(1,2), fy(1,2),
1066 a fz(1,2), fx(1,3), fy(1,3), fz(1,3),
1067 b fx(1,4), fy(1,4), fz(1,4), fx(1,5),
1068 c fy(1,5), fz(1,5), fx(1,6), fy(1,6),
1069 d fz(1,6), fx(1,7), fy(1,7), fz(1,7),
1070 e fx(1,8), fy(1,8), fz(1,8), nel,
1071 f fskym, msnf, isky, fskyi,
1072 g nvc, ipm, igeo, bid,
1073 h bid, bid, bid, bid,
1074 i bufvois, itask, pqmv, istra,
1075 j temp, bid, bid, ibid,
1076 k gresav, grth, igrth, mssa,
1077 l dmels, table, bid, bid,
1078 m bid, bid, bid, bid,
1079 n bid, bid, bid, iparg(1,ng),
1080 o xdp, bid, ibid, ibid,
1081 p voln, condn, condnsky, agrav,
1082 q igrv, lgrav, sensors, skew,
1083 r ale_connectivity%NALE,d, ioutprt, nloc_dmg,
1084 s mat_elem, ibid, dt, idel7nok,nsvois,
1085 t sz_bufvois, snpc, stf,sbufmat,svis,idtmins,iresp,
1086 u idel7ng, maxfunc, userl_avail ,glob_therm,
1087 v impl_s, idyna, output%TH%WFEXT)
1088
1089 ELSEIF (ity == 2 .AND. jmult == 0) THEN
1090 NULLIFY(pqmv);
1091 IF(trimat>0)THEN
1092 pqmv => qmv(1,1+nft)
1093 ELSE
1094 pqmv => bid
1095 ENDIF
1096 CALL qforc2(timers, output,
1097 . elbuf_tab ,ng ,
1098 1 pm ,geo ,ixq ,x ,a ,
1099 2 v ,ms ,w ,wa ,val2 ,
1100 3 veul ,ale_connectivity ,iparg ,nloc_dmg ,
1101 4 tf ,npc ,bufmat ,partsav ,
1102 5 dt2t ,neltst ,ityptst ,stifn ,offset ,
1103 6 eani ,ipartq(1+nft) ,nel ,iadq ,fsky ,
1104 9 ipm ,bufvois ,pqmv ,
1105 a gresav ,grth ,igrth ,table ,igeo ,
1106 b voln ,itask ,ms_2d ,fskym ,ioutprt ,
1107 c mat_elem ,h3d_data%STRAIN ,sz_bufvois ,snpc ,stf ,sbufmat,
1108 d svis ,nsvois ,iresp ,tt ,dt1 ,
1109 . idel7nok ,idtmin ,maxfunc ,
1110 . imon_mat ,userl_avail ,impl_s ,idyna ,
1111 . dt ,glob_therm ,sensors)
1112c
1113 ELSEIF(ity == 2 .AND. jmult /= 0)THEN
1114 CALL bforc2(timers, elbuf_tab ,ng ,
1115 1 pm ,geo ,ixq ,x ,
1116 2 a ,v ,ms ,w ,wa ,
1117 3 val2 ,veul ,ale_connectivity ,iparg ,
1118 4 iparg(1,ng),fill ,dfill ,ims ,nloc_dmg ,
1119 5 tf ,npc ,bufmat ,partsav ,
1120 5 dt2t ,neltst ,ityptst ,stifn ,offset ,
1121 6 eani ,ipartq(1+nft),nel ,iadq ,fsky ,
1122 7 ipm ,bufvois ,
1123 8 gresav ,grth ,igrth ,table ,igeo ,
1124 9 voln ,itask ,ms_2d ,fskym ,mat_elem,
1125 a ibid ,output ,sz_bufvois ,snpc ,stf ,sbufmat ,svis,
1126 b nsvois ,iresp ,idel7nok ,
1127 c idtmin ,maxfunc ,imon_mat ,
1128 e userl_avail,impl_s ,idyna ,dt ,
1129 f glob_therm ,sensors)
1130
1131 ENDIF
1132 ENDIF
1133 ENDIF
1134 ENDIF
1135 enddo!next NG
1136
1137 endif!IF (ILAW11 /= 0) THEN
1138
1139 ENDIF !IF(IALE+IEULER+ITHERM /= 0)THEN
1140 IF(itask==0) CALL stoptime(timers,macro_timer_ifsub0)
1141 endif!IF(IFSUB == 0)THEN
1142
1143c !Fluid mass do not contribute in FEM : add external force for FSI
1144c IF(IALE+IEULER /= 0)THEN
1145c DO N=NODFT,NODLT
1146c MSNF(N) = ZERO
1147c ENDDO
1148c ENDIF
1149
1150 !-----------------------------!
1151 ! PRESSURE GAUGE !
1152 !-----------------------------!
1153 IF (nbgauge > 0) THEN
1154 IF (nspmd > 1) THEN
1155 lencom =nercvois(nspmd+1)+nesdvois(nspmd+1)
1156 END IF
1157 CALL agauge(
1158 1 iparg ,elbuf_tab ,phi ,ixs ,ixq ,
1159 2 x ,ale_connectivity,itask ,nercvois,nesdvois,
1160 3 lercvois,lesdvois ,lencom ,lgauge ,
1161 4 gauge ,v ,igaup ,ngaup ,ixtg)
1162 ENDIF ! IF (NBGAUGE > 0)
1163
1164 !--------------------------------------------------------
1165 ! ALE SUB-CYCLING SUITE
1166 !--------------------------------------------------------
1167 IF(ale%SUB%IALESUB == 2)THEN
1168 !ifsub=0 fluid calculation
1169 !ifsub=2 fluid calculation + assembly
1170 !ifsub=1 no fluid calculation
1171 IF(itask == 0) THEN
1172 IF(ale%SUB%IFSUB == 0) THEN
1173 ale%SUB%IFSUB=2
1174 ENDIF
1175 ENDIF
1176 CALL my_barrier
1177 IF(ale%SUB%IFSUB == 1)THEN
1178 ! getting A from ASAVE
1179 ! AGLOB is pointing on A (no SMP shift))
1180 DO n=nodft,nodlt
1181 aglob(1,n)=asave(1,n)
1182 aglob(2,n)=asave(2,n)
1183 aglob(3,n)=asave(3,n)
1184 ENDDO
1185 ENDIF
1186 ENDIF
1187
1188
1189
1190
1191 CALL my_barrier
1192 DEALLOCATE(qmv)
1193 IF(itask==0)DEALLOCATE(bufvois)
1194
1195
1196 RETURN
agauge
subroutine agauge(iparg, elbuf_str, phi, ixs, ixq, x, ale_connect, itask, nercvois, nesdvois, lercvois, lesdvois, lencom, lgauge, gauge, v, igaup, ngaup, ixtg)
Definition agauge.F:48
alefvm_grav_init
subroutine alefvm_grav_init(python, agrv, igrv, lgrav, nsensor, sensor_tab, itask, npc, tf, skew)
Definition alefvm_grav_init.F:37
alesub1
subroutine alesub1(nale, v, w, dsave, icodt, iskew, skew, d, itask, nodft, nodlt, fsky, fskyv)
Definition alesub1.F:36
alethe
subroutine alethe(iparg, elbuf_tab, flux, val2, phi, ale_connect, ixs, ixq, v, w, x, pm, ms, veul, fill, dfill, alph, fv, bufmat, tf, npf, itask, nbrcvois, nbsdvois, lnrcvois, lnsdvois, nercvois, nesdvois, lercvois, lesdvois, segvar, msnf, nodft, nodlt, bhole, ipm, qmv, itab, itabm1, lenqmv, nv46, iad_elem, glob_therm, fr_elem, matparam)
Definition alethe.F:69
bforc2
subroutine bforc2(timers, elbuf_tab, ng, pm, geo, ic, x, a, v, ms, w, flux, flu1, veul, ale_connect, iparg, jparg, fill, dfill, ims, nloc_dmg, tf, npf, bufmat, partsav, dt2t, neltst, ityptst, stifn, offset, eani, ipartq, nel, iadq, fsky, ipm, bufvois, gresav, grth, igrth, table, igeo, voln, itask, ms_2d, fskym, mat_elem, h3d_strain, output, sz_bufvois, snpc, stf, sbufmat, svis, nsvois, iresp, idel7nok, idtmin, maxfunc, imon_mat, userl_avail, impl_s, idyna, dt, glob_therm, sensors)
Definition bforc2.F:87
build_connectivity
subroutine build_connectivity(itask, multi_fvm, ale_connectivity, iparg)
Definition connectivity.F:34
my_real
#define my_real
Definition cppsort.cpp:32
ebcs_main
subroutine ebcs_main(igrsurf, segvar, volmon, a, v, w, x, fsav, fv, ms, stifn, iparg, elbuf_tab, ebcs_tab, multi_fvm, ixq, ixs, ixtg, fsky, fsavsurf, time, dt1, nsensor, sensor_tab, python, npc, tf, snpc, stf, output, matparam, pm, bufmat)
Definition ebcs_main.F:68
intti0
subroutine intti0(ipari, x, v, wa, itab, iparg, ixs, segvar, skew, iskwn, intbuf_tab)
Definition intti0.F:35
max
#define max(a, b)
Definition macros.h:21
multi_buf2var
subroutine multi_buf2var(itask, iparg, multi_fvm, elbuf_tab)
Definition multi_buf2var.F:32
multi_compute_dt
subroutine multi_compute_dt(dt2t, elbuf_tab, iparg, itask, ixs, ixq, ixtg, pm, ipm, multi_fvm, wgrid, xgrid, neltst, ityptst)
Definition multi_compute_dt.F:36
multi_computevolume
subroutine multi_computevolume(nel, ng, iparg, sym, elbuf_tab, ixs, ixq, ixtg, volnew, xgrid)
Definition multi_computevolume.F:37
multi_face_elem_data
subroutine multi_face_elem_data(itask, iparg, ixs, ixq, ixtg, xgrid, wgrid, multi_fvm)
Definition multi_face_data_elem.F:42
multi_fvm2fem
subroutine multi_fvm2fem(timestep, elbuf_tab, itask, ixs, ixq, iparg, xgrid, accele, vel, wgrid, ms, msnf, veul, stifn, fsky, iads, fskym, condn, condnsky, multi_fvm, nodadt_therm)
Definition multi_fvm2fem.F:49
multi_globalize
subroutine multi_globalize(elbuf_tab, iparg, itask, multi_fvm, partsav, iparts, gresav, igrth, grth)
Definition multi_globalize.F:36
multi_pressure_equilibrium
subroutine multi_pressure_equilibrium(timestep, elbuf_tab, iparg, itask, ixs, ixq, ixtg, pm, ipm, multi_fvm, current_time, bufmat, npf, tf, nummat, matparam)
Definition multi_pressure_equilibrium.F:39
multi_timeevolution
subroutine multi_timeevolution(timers, timestep, elbuf_tab, iparg, itask, ixs, ixq, ixtg, pm, ipm, multi_fvm, ale_connectivity, vel, accele, wgrid, xgrid, dnod, nale, partsav, iparts, gresav, igrth, grth, nercvois, nesdvois, lercvois, lesdvois, itab, itabm1, current_time, stifn, fsky, iads, fskym, condn, condnsky, bufmat, func_value, pred, id_global_vois, face_vois, ebcs_tab, npf, tf, fsavsurf, matparam, wfext, output)
Definition multi_timeevolution.F:68
multi_var2buf
subroutine multi_var2buf(itask, iparg, multi_fvm, elbuf_tab)
Definition multi_var2buf.F:32
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
alefvm_mod
Definition alefvm_mod.F:88
alefvm_mod::alefvm_param
type(alefvm_param_), target alefvm_param
Definition alefvm_mod.F:121
diffusion_mod
Definition diffusion_mod.F:36
dt_mod
Definition dt_mod.F:80
groupdef_mod
Definition groupdef_mod.F:668
h3d_mod
Definition h3d_mod.F:311
initbuf_mod
Definition initbuf.F:160
initbuf_mod::initbuf
subroutine initbuf(iparg, ng, mtn, llt, nft, iad, ity, npt, jale, ismstr, jeul, jtur, jthe, jlag, jmult, jhbe, jivf, mid, jpor, jcvt, jclose, jpla, irep, iint, igtyp, israt, isrot, icsen, isorth, isorthg, ifailure, jsms)
Definition initbuf.F:261
nlocal_reg_mod
Definition nlocal_reg_mod.F:119
segvar_mod
Definition segvar_mod.F:63
table_mod
Definition table_mod.F:113
th_surf_mod
OPTION /TH/SURF outputs of Pressure and Area needed Tabs.
Definition th_surf_mod.F:61
th_surf_mod::th_surf_num_channel
integer, parameter th_surf_num_channel
number of /TH/SURF channels : AREA, VELOCITY, MASSFLOW, P A, MASS
Definition th_surf_mod.F:100
ns_fvm_diffusion
subroutine ns_fvm_diffusion(ale_connect, multi_fvm, time_step, ebcs_tab, diffusion, ipm, pm, iparg, elbuf_tab, nercvois, nesdvois, lercvois, lesdvois, ixs, func_value)
Definition ns_fvm_diffusion.F:40
qforc2
subroutine qforc2(timers, output, elbuf_tab, ng, pm, geo, ic, x, a, v, ms, w, flux, flu1, veul, ale_connect, iparg, nloc_dmg, tf, npf, bufmat, partsav, dt2t, neltst, ityptst, stifn, offset, eani, ipartq, nel, iadq, fsky, ipm, bufvois, qmv, gresav, grth, igrth, table, igeo, voln, itask, ms_2d, fskym, ioutprt, mat_elem, h3d_strain, sz_bufvois, snpc, stf, sbufmat, svis, nsvois, iresp, tt, dt1, idel7nok, idtmin, maxfunc, imon_mat, userl_avail, impl_s, idyna, dt, glob_therm, sensors)
Definition qforc2.F:84
s4alesfem
subroutine s4alesfem(iparg, ixs, x, elbuf_tab, sfem_nodvar, s_sfem_nodvar, pm, iad_elem, fr_elem)
Definition s4alesfem.F:39
s4forc3
subroutine s4forc3(timers, output, elbuf_tab, ng, pm, geo, ixs, x, a, v, ms, w, flux, flu1, veul, fv, ale_connect, iparg, tf, npf, bufmat, partsav, nloc_dmg, dt2t, neltst, ityptst, stifn, fsky, iads, offset, eani, iparts, f11, f21, f31, f12, f22, f32, f13, f23, f33, f14, f24, f34, nel, fskym, msnf, ipm, igeo, bufvois, istrain, itask, temp, fthe, fthesky, iexpan, gresav, grth, igrth, mssa, dmels, table, xdp, sfem_nodvar, voln, condn, condnsky, d, sensors, ioutprt, mat_elem, h3d_strain, dt, idel7nok, nsvois, sz_bufvois, snpc, stf, sbufmat, svis, idtmins, iresp, idel7ng, maxfunc, userl_avail, glob_therm, impl_s, idyna, s_sfem_nodvar)
Definition s4forc3.F:110
seggetv
subroutine seggetv(iparg, elbuf_tab, ale_connectivity, itask, segvar)
Definition seggetv.F:41
sforc3
subroutine sforc3(timers, output, elbuf_tab, ng, pm, geo, ixs, x, nv46, a, v, ms, w, flux, flu1, veul, fv, ale_connect, iparg, tf, npf, bufmat, partsav, itab, dt2t, neltst, ityptst, stifn, fsky, iads, offset, eani, iparts, f11, f21, f31, f12, f22, f32, f13, f23, f33, f14, f24, f34, f15, f25, f35, f16, f26, f36, f17, f27, f37, f18, f28, f38, nel, fskym, msnf, isky, fskyi, nvc, ipm, igeo, ar, vr, in, fr_wave, dr, bufvois, itask, qmv, istrain, temp, fthe, fthesky, iexpan, gresav, grth, igrth, mssa, dmels, table, phi1, phi2, vf, af, df, wf, ffsky, afglob, msf, iparg1, xdp, por, icontact, ifoam, voln, condn, condnsky, agrav, igrv, lgrav, sensors, skew, nale, d, ioutprt, nloc_dmg, mat_elem, h3d_strain, dt, idel7nok, nsvois, sz_bufvois, snpc, stf, sbufmat, svis, idtmins, iresp, idel7ng, maxfunc, userl_avail, glob_therm, impl_s, idyna, wfext)
Definition sforc3.F:157
sinit22_fvm
subroutine sinit22_fvm(ixs, elbuf_tab, iparg, itab, itask, bufbric, nbric_l, x, ale_connectivity, v, nv46, veul, igrnod, ipari, igrtruss, ixt, bufmat, ipm)
Definition sinit22_fvm.F:53
spmd_envois
subroutine spmd_envois(dim, phi, nercvois, nesdvois, lercvois, lesdvois, lencom)
Definition spmd_cfd.F:695
spmd_init_ebcs
subroutine spmd_init_ebcs(v, isizxv, iad_elem, fr_elem, ebcs_tab)
Definition spmd_cfd.F:1899
spmd_xvois
subroutine spmd_xvois(x, nbrcvois, nbsdvois, lnrcvois, lnsdvois, lencom)
Definition spmd_cfd.F:40
spmd_segcom
subroutine spmd_segcom(segvar, npsegcom, lsegcom, size, flag)
Definition spmd_cfd.F:1666
spmd_l51vois
subroutine spmd_l51vois(lbvois, iparg, elbuf_tab, pm, ixs, ixq, nercvois, nesdvois, lercvois, lesdvois, lencom, ipm, bufmat)
Definition spmd_cfd.F:2018
spmd_l11vois
subroutine spmd_l11vois(lbvois, iparg, elbuf_tab, pm, ixs, ixq, nercvois, nesdvois, lercvois, lesdvois, lencom)
Definition spmd_cfd.F:1032
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