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 91 of file alemain.F.

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