59 . PM, IPM, MULTI_FVM, ALE_CONNECTIVITY, VEL, ACCELE, WGRID, XGRID, DNOD, NALE,
60 . PARTSAV, IPARTS, GRESAV, IGRTH, GRTH,
61 . NERCVOIS, NESDVOIS, LERCVOIS, LESDVOIS,
62 . ITAB, ITABM1, CURRENT_TIME,
63 . STIFN, FSKY, IADS, FSKYM,
64 . CONDN, CONDNSKY, BUFMAT, FUNC_VALUE, PRED,ID_GLOBAL_VOIS,FACE_VOIS,EBCS_TAB,NPF,TF,FSAVSURF,MATPARAM,
78 USE matparam_def_mod,
ONLY : matparam_struct_
83#include "implicit_f.inc"
93#include "tabsiz_c.inc"
97 TYPE(timer_),
INTENT(INOUT) :: TIMERS
98 TYPE(MATPARAM_STRUCT_),
DIMENSION(NUMMAT),
INTENT(IN) :: MATPARAM
99 my_real,
INTENT(INOUT) :: FSAVSURF(TH_SURF_NUM_CHANNEL,NSURF)
100 my_real,
INTENT(IN) :: TIMESTEP
101 TYPE(),
TARGET,
DIMENSION(NGROUP) :: ELBUF_TAB
102 INTEGER,
INTENT(IN) :: IPARG(NPARG, *), IADS(8, *)
103 INTEGER,
INTENT(IN) :: ITASK
104 INTEGER,
INTENT(IN),
TARGET :: IXS(NIXS, *), IXQ(NIXQ, *), IXTG(NIXTG, *)
105 INTEGER,
INTENT(IN) :: IPM(NPROPMI, *)
106 my_real,
INTENT(IN) :: pm(npropm, *)
107 TYPE(multi_fvm_struct),
INTENT(INOUT) :: MULTI_FVM
109 INTEGER,
INTENT(IN) :: ID_GLOBAL_VOIS(*),FACE_VOIS(*)
110 my_real,
INTENT(INOUT) :: vel(3, *),
accele(3, *)
111 my_real,
INTENT(IN) :: wgrid(3, *)
112 my_real,
INTENT(INOUT) :: xgrid(3, *), dnod(3, *)
113 INTEGER,
INTENT(IN) :: NALE(*)
114 my_real,
INTENT(INOUT) :: partsav(npsav, *), gresav(*)
115 INTEGER,
INTENT(IN) :: IPARTS(*), IGRTH(*), GRTH(*)
116 INTEGER,
INTENT(IN) :: NERCVOIS(*), NESDVOIS(*), LERCVOIS(*), LESDVOIS(*)
117 INTEGER,
INTENT(IN) :: ITAB(*), ITABM1(*)
118 my_real,
INTENT(IN) :: current_time
119 my_real,
INTENT(INOUT) :: fskym(*), stifn(*), fsky(*),
120 . condn(*), condnsky(*), bufmat(*)
121 LOGICAL,
INTENT(IN) :: PRED
122 my_real,
INTENT(IN) :: func_value(*)
123 TYPE(t_ebcs_tab),
INTENT(IN) :: EBCS_TAB
125 INTEGER,
INTENT(IN) :: NPF(SNPC)
126 my_real,
INTENT(IN) :: tf(stf)
127 DOUBLE PRECISION,
INTENT(INOUT) :: WFEXT
131 INTEGER :: NG, NEL, II, I
132 INTEGER :: LOCAL_MATID
133 INTEGER :: NBMAT, IMAT, NIX
136 INTEGER,
DIMENSION(:, :),
POINTER :: IX
137 INTEGER :: MATLAW, NFT, ITY, ELEMTYP
139 my_real :: volnew(mvsiz)
140 TYPE(g_bufel_),
POINTER :: GBUF
144 IF (iale /= 0 .AND. .NOT. pred)
THEN
145 DO node_id = 1 + itask, numnod, nthread
146 vdt = half * timestep * wgrid(1, node_id)
147 dnod(1, node_id) = dnod(1, node_id) + vdt
148 xgrid(1, node_id) = xgrid(1, node_id) + vdt
150 vdt = half * timestep * wgrid(2,node_id)
151 dnod(2, node_id) = dnod(2, node_id) + vdt
152 xgrid(2, node_id) = xgrid(2, node_id) + vdt
154 vdt = half * timestep * wgrid(3,node_id)
155 dnod(3, node_id) = dnod(3, node_id) + vdt
156 xgrid(3, node_id) = xgrid(3, node_id) + vdt
174 lencom = nercvois(nspmd + 1) + nesdvois(nspmd + 1)
177 . nercvois, nesdvois, lercvois, lesdvois, lencom)
179 . nercvois, nesdvois, lercvois, lesdvois, lencom)
181 . nercvois, nesdvois, lercvois, lesdvois, lencom)
184 . nercvois, nesdvois, lercvois, lesdvois, lencom)
186 . nercvois, nesdvois, lercvois, lesdvois, lencom)
188 . nercvois, nesdvois, lercvois, lesdvois, lencom)
191 . nercvois, nesdvois, lercvois, lesdvois, lencom)
194 . nercvois, nesdvois, lercvois, lesdvois, lencom)
196 IF (multi_fvm%NBMAT > 1)
THEN
197 CALL spmd_envois(multi_fvm%NBMAT, multi_fvm%PHASE_ALPHA,
198 . nercvois, nesdvois, lercvois, lesdvois, lencom)
199 CALL spmd_envois(multi_fvm%NBMAT, multi_fvm%PHASE_RHO,
200 . nercvois, nesdvois, lercvois, lesdvois, lencom)
201 CALL spmd_envois(multi_fvm%NBMAT, multi_fvm%PHASE_EINT,
202 . nercvois, nesdvois, lercvois, lesdvois, lencom)
203 CALL spmd_envois(multi_fvm%NBMAT, multi_fvm%PHASE_PRES,
204 . nercvois, nesdvois, lercvois, lesdvois, lencom)
207 IF (multi_fvm%MUSCL > 0)
THEN
210 . nercvois, nesdvois, lercvois, lesdvois, lencom)
212 !
for parith/on, need to communicate face_data%CENTROID
215 . nercvois, nesdvois, lercvois, lesdvois, lencom
226 IF (multi_fvm%MUSCL > 0)
THEN
228 . pm, ipm, multi_fvm, ale_connectivity, wgrid, xgrid, itab, multi_fvm%NBMAT,
229 . current_time, bufmat)
234 IF (nspmd > 1 .AND. multi_fvm%MUSCL > 0)
THEN
237 lencom = nercvois(nspmd + 1) + nesdvois(nspmd + 1)
238 IF (multi_fvm%MUSCL == 1)
THEN
241 . nercvois, nesdvois, lercvois, lesdvois, lencom)
243 . nercvois, nesdvois, lercvois, lesdvois, lencom)
245 . nercvois, nesdvois, lercvois, lesdvois, lencom)
248 IF (multi_fvm%NBMAT == 1)
THEN
249 IF (multi_fvm%MUSCL == 1)
THEN
251 . nercvois, nesdvois, lercvois, lesdvois, lencom)
253 . nercvois, nesdvois, lercvois, lesdvois, lencom)
256 CALL spmd_envois(3 * multi_fvm%NBMAT, multi_fvm%PHASE_GRAD_ALPHA,
257 . nercvois, nesdvois, lercvois, lesdvois, lencom)
258 IF (multi_fvm%MUSCL == 1)
THEN
259 CALL spmd_envois(3 * multi_fvm%NBMAT, multi_fvm%PHASE_GRAD_RHO,
260 . nercvois, nesdvois, lercvois, lesdvois, lencom)
261 CALL spmd_envois(3 * multi_fvm%NBMAT, multi_fvm%PHASE_GRAD_PRES,
262 . nercvois, nesdvois, lercvois, lesdvois, lencom)
270 DO ng = itask + 1, ngroup, nthread
271 matlaw = iparg(1, ng)
272 IF (matlaw == 151)
THEN
276 gbuf => elbuf_tab(ng)%GBUF
277 IF (multi_fvm%MUSCL > 0)
THEN
279 . pm, ipm, multi_fvm, ale_connectivity, wgrid, xgrid, itab,
280 . multi_fvm%NBMAT, current_time, bufmat,
281 . id_global_vois,face_vois
284 . pm, ipm, multi_fvm, ale_connectivity, wgrid, xgrid, itab,
285 . multi_fvm%NBMAT, current_time, bufmat,
286 . id_global_vois,npf,tf)
294 IF (ebcs_tab%nebcs_fvm > 0)
THEN
296 CALL multi_ebcs(itask, multi_fvm, ixs, ixq, ixtg, xgrid, wgrid, ipm, pm, func_value,
297 . ebcs_tab,npf,tf,fsavsurf,nsurf,timestep
304 IF (iale /= 0 .AND. .NOT. pred)
THEN
305 DO node_id = 1 + itask, numnod, nthread
306 vdt = half * timestep * wgrid(1, node_id)
307 dnod(1, node_id) = dnod(1, node_id
308 xgrid(1, node_id) = xgrid(1, node_id) + vdt
310 vdt = half * timestep * wgrid(2,node_id)
311 dnod(2, node_id) = dnod(2, node_id) + vdt
312 xgrid(2, node_id) = xgrid(2, node_id) + vdt
314 vdt = half * timestep * wgrid(3,node_id)
315 dnod(3, node_id) = dnod(3, node_id) + vdt
316 xgrid(3, node_id) = xgrid(3, node_id) + vdt
323 nbmat = multi_fvm%NBMAT
325 DO ng = itask + 1, ngroup
326 matlaw = iparg(1, ng)
327 IF (matlaw == 151)
THEN
332 . iparg, itask, ixs, ixq, ixtg, multi_fvm,
alefvm_buffer%VERTEX, wfext)
338 . iparg, itask, ixs, ixq, ixtg, multi_fvm,
344 DO ng = itask + 1, ngroup, nthread
345 matlaw = iparg(1, ng)
346 IF (matlaw == 151)
THEN
350 gbuf => elbuf_tab(ng)%GBUF
354 volnew(1:mvsiz) = zero
356 . elbuf_tab, ixs, ixq, ixtg, volnew, xgrid)
361 . partsav, iparts, gresav, igrth, grth, volnew(1:nel), pred, timestep)
363 IF (multi_fvm%SYM == 0)
THEN
364 ix => ixs(1:nixs, 1 + nft:nel + nft)
367 ELSEIF (ity == 2)
THEN
369 ix => ixq(1:nixq, 1 + nft:nel + nft)
372 ELSEIF (ity == 7)
THEN
374 ix => ixtg(1:nixtg, 1 + nft:nel + nft)
381 IF (multi_fvm%RHO(i) <= zero)
THEN
382 IF (elemtyp == 0)
THEN
383 CALL ancmsg(msgid = 167, anmode = aninfo, i1 = ix(nix, ii),
384 . r1 = multi_fvm%RHO(i))
386 CALL ancmsg(msgid = 12, anmode = aninfo, i1 = ix(nix, ii),
387 . r1 = multi_fvm%RHO(i))
398 local_matid = ipm(20 + imat, ix(1, 1))
400 . elbuf_tab, iparg, itask, multi_fvm, volnew)
408 gbuf%VOL(ii) = volnew(ii)
410 IF (multi_fvm%NS_DIFF
THEN
413 multi_fvm%VOL(i) = volnew(ii)