61 . PM, IPM, MULTI_FVM, ALE_CONNECTIVITY, VEL, ACCELE, WGRID, XGRID, DNOD, NALE,
62 . PARTSAV, IPARTS, GRESAV, IGRTH, GRTH,
63 . NERCVOIS, NESDVOIS, LERCVOIS, LESDVOIS,
64 . ITAB, ITABM1, CURRENT_TIME,
65 . STIFN, FSKY, IADS, FSKYM,
66 . CONDN, CONDNSKY, BUFMAT, FUNC_VALUE, PRED,ID_GLOBAL_VOIS,FACE_VOIS,EBCS_TAB,NPF,TF,FSAVSURF,MATPARAM,
80 USE matparam_def_mod,
ONLY : matparam_struct_
82 USE output_mod ,
ONLY : output_
83 use element_mod ,
only : nixs,nixq,nixtg
87#include
"implicit_f.inc"
97#include "tabsiz_c.inc"
101 TYPE(timer_),
INTENT(INOUT) :: TIMERS
102 TYPE(MATPARAM_STRUCT_),
DIMENSION(NUMMAT),
INTENT(IN) :: MATPARAM
103 my_real,
INTENT(INOUT) :: FSAVSURF(TH_SURF_NUM_CHANNEL,NSURF)
104 my_real,
INTENT(IN) :: TIMESTEP
105 TYPE(ELBUF_STRUCT_),
TARGET,
DIMENSION(NGROUP) :: ELBUF_TAB
106 INTEGER,
INTENT(IN) :: (NPARG, *), IADS(8, *)
107 INTEGER,
INTENT(IN) :: ITASK
108 INTEGER,
INTENT(IN),
TARGET :: IXS(NIXS, *), IXQ(NIXQ, *), IXTG(NIXTG, *)
109 INTEGER,
INTENT(IN) :: IPM(NPROPMI, *)
110 my_real,
INTENT(IN) :: pm(npropm, *)
111 TYPE(multi_fvm_struct),
INTENT(INOUT) :: MULTI_FVM
113 INTEGER,
INTENT(IN) :: ID_GLOBAL_VOIS(*),FACE_VOIS(*)
114 my_real,
INTENT(INOUT) :: vel(3, *),
accele(3, *)
115 my_real,
INTENT(IN) :: wgrid(3, *)
116 my_real,
INTENT(INOUT) :: xgrid(3, *), dnod(3, *)
117 INTEGER,
INTENT(IN) :: NALE(*)
118 my_real,
INTENT(INOUT) :: partsav(npsav, *), gresav(*)
119 INTEGER,
INTENT(IN) :: IPARTS(*), IGRTH(*), GRTH(*)
120 INTEGER,
INTENT(IN) :: NERCVOIS(*), NESDVOIS(*), LERCVOIS(*), LESDVOIS(*)
121 INTEGER,
INTENT(IN) :: ITAB(*), ITABM1(*)
122 my_real,
INTENT(IN) :: current_time
123 my_real,
INTENT(INOUT) :: fskym(*), stifn(*), fsky(*),
124 . condn(*), condnsky(*), bufmat(*)
125 LOGICAL,
INTENT(IN) :: PRED
126 my_real,
INTENT(IN) :: func_value(*)
127 TYPE(t_ebcs_tab),
INTENT(IN) :: EBCS_TAB
129 INTEGER,
INTENT(IN) :: NPF(SNPC)
130 my_real,
INTENT(IN) :: tf(stf)
131 DOUBLE PRECISION,
INTENT(INOUT) :: WFEXT
132 TYPE(output_),
INTENT(INOUT) :: OUTPUT
136 INTEGER :: NG, NEL, II, I
137 INTEGER :: LOCAL_MATID
138 INTEGER :: NBMAT, IMAT, NIX
141 INTEGER,
DIMENSION(:, :),
POINTER :: IX
142 INTEGER :: MATLAW, NFT, ITY, ELEMTYP
144 my_real :: volnew(mvsiz)
145 TYPE(g_bufel_),
POINTER :: GBUF
149 IF (iale /= 0 .AND. .NOT. pred)
THEN
150 DO node_id = 1 + itask, numnod, nthread
151 vdt = half * timestep * wgrid(1, node_id)
152 dnod(1, node_id) = dnod(1, node_id) + vdt
153 xgrid(1, node_id) = xgrid(1, node_id) + vdt
155 vdt = half * timestep * wgrid(2,node_id)
156 dnod(2, node_id) = dnod(2, node_id) + vdt
157 xgrid(2, node_id) = xgrid(2, node_id) + vdt
159 vdt = half * timestep * wgrid(3,node_id)
160 dnod(3, node_id) = dnod(3, node_id) + vdt
161 xgrid(3, node_id) = xgrid(3, node_id) + vdt
179 lencom = nercvois(nspmd + 1) + nesdvois(nspmd + 1)
182 . nercvois, nesdvois, lercvois, lesdvois, lencom)
184 . nercvois, nesdvois, lercvois, lesdvois, lencom)
186 . nercvois, nesdvois, lercvois, lesdvois, lencom)
189 . nercvois, nesdvois, lercvois, lesdvois, lencom)
191 . nercvois, nesdvois, lercvois, lesdvois, lencom)
193 . nercvois, nesdvois, lercvois, lesdvois, lencom)
196 . nercvois, nesdvois, lercvois, lesdvois, lencom)
199 . nercvois, nesdvois, lercvois, lesdvois, lencom)
201 IF (multi_fvm%NBMAT > 1)
THEN
202 CALL spmd_envois(multi_fvm%NBMAT, multi_fvm%PHASE_ALPHA,
203 . nercvois, nesdvois, lercvois, lesdvois, lencom)
205 . nercvois, nesdvois, lercvois, lesdvois, lencom)
206 CALL spmd_envois(multi_fvm%NBMAT, multi_fvm%PHASE_EINT,
207 . nercvois, nesdvois, lercvois, lesdvois, lencom)
208 CALL spmd_envois(multi_fvm%NBMAT, multi_fvm%PHASE_PRES,
209 . nercvois, nesdvois, lercvois, lesdvois, lencom)
212 IF (multi_fvm%MUSCL > 0)
THEN
215 . nercvois, nesdvois, lercvois, lesdvois, lencom)
220 . nercvois, nesdvois, lercvois, lesdvois, lencom)
231 IF (multi_fvm%MUSCL > 0)
THEN
233 . pm, ipm, multi_fvm, ale_connectivity, wgrid, xgrid, itab, multi_fvm%NBMAT,
234 . current_time, bufmat)
239 IF (nspmd > 1 .AND. multi_fvm%MUSCL > 0)
THEN
242 lencom = nercvois(nspmd + 1) + nesdvois(nspmd + 1)
243 IF (multi_fvm%MUSCL == 1)
THEN
246 . nercvois, nesdvois, lercvois, lesdvois, lencom)
248 . nercvois, nesdvois, lercvois, lesdvois, lencom)
250 . nercvois, nesdvois, lercvois, lesdvois, lencom)
253 IF (multi_fvm%NBMAT == 1)
THEN
254 IF (multi_fvm%MUSCL == 1)
THEN
256 . nercvois, nesdvois, lercvois, lesdvois, lencom)
258 . nercvois, nesdvois, lercvois, lesdvois, lencom)
261 CALL spmd_envois(3 * multi_fvm%NBMAT, multi_fvm%PHASE_GRAD_ALPHA,
262 . nercvois, nesdvois, lercvois, lesdvois, lencom)
263 IF (multi_fvm%MUSCL == 1)
THEN
264 CALL spmd_envois(3 * multi_fvm%NBMAT, multi_fvm%PHASE_GRAD_RHO,
265 . nercvois, nesdvois, lercvois, lesdvois, lencom)
266 CALL spmd_envois(3 * multi_fvm%NBMAT, multi_fvm%PHASE_GRAD_PRES,
267 . nercvois, nesdvois, lercvois, lesdvois, lencom)
275 DO ng = itask + 1, ngroup, nthread
276 matlaw = iparg(1, ng)
277 IF (matlaw == 151)
THEN
281 gbuf => elbuf_tab(ng)%GBUF
282 IF (multi_fvm%MUSCL > 0)
THEN
284 . pm, ipm, multi_fvm, ale_connectivity, wgrid, xgrid, itab,
285 . multi_fvm%NBMAT, current_time, bufmat,
286 . id_global_vois,face_vois,npf,tf,ispmd, matparam)
289 . pm, ipm, multi_fvm, ale_connectivity, wgrid, xgrid, itab,
290 . multi_fvm%NBMAT, current_time, bufmat,
291 . id_global_vois,npf,tf)
299 IF (ebcs_tab%nebcs_fvm > 0)
THEN
301 CALL multi_ebcs(itask, multi_fvm, ixs, ixq, ixtg, xgrid, wgrid, ipm, pm, func_value,
302 . ebcs_tab,npf,tf,fsavsurf,nsurf
303 . numels, numelq, numeltg, numnod, ncycle, nummat, matparam, output, pred)
309 IF (iale /= 0 .AND. .NOT. pred)
THEN
310 DO node_id = 1 + itask, numnod, nthread
311 vdt = half * timestep * wgrid(1, node_id)
312 dnod(1, node_id) = dnod(1, node_id) + vdt
313 xgrid(1, node_id) = xgrid(1, node_id) + vdt
315 vdt = half * timestep * wgrid
316 dnod(2, node_id) = dnod(2, node_id) + vdt
317 xgrid(2, node_id) = xgrid
319 vdt = half * timestep * wgrid(3,node_id)
320 dnod(3, node_id) = dnod(3, node_id) + vdt
321 xgrid(3, node_id) = xgrid(3, node_id) + vdt
328 nbmat = multi_fvm%NBMAT
330 DO ng = itask + 1, ngroup, nthread
331 matlaw = iparg(1, ng)
332 IF (matlaw == 151)
THEN
343 . iparg, itask, ixs, ixq, ixtg, multi_fvm,
349 DO ng = itask + 1, ngroup, nthread
351 IF (matlaw == 151)
THEN
355 gbuf => elbuf_tab(ng)%GBUF
359 volnew(1:mvsiz) = zero
361 . elbuf_tab, ixs, ixq, ixtg, volnew, xgrid)
366 . partsav, iparts, gresav, igrth, grth, volnew(1:nel), pred, timestep)
368 IF (multi_fvm%SYM == 0)
THEN
369 ix => ixs(1:nixs, 1 + nft:nel + nft)
372 ELSEIF (ity == 2)
THEN
374 ix => ixq(1:nixq, 1 + nft:nel + nft)
377 ELSEIF (ity == 7)
THEN
379 ix => ixtg(1:nixtg, 1 + nft:nel + nft)
386 IF (multi_fvm%RHO
THEN
387 IF (elemtyp == 0)
THEN
388 CALL ancmsg(msgid = 167, anmode = aninfo, i1 = ix(nix, ii),
389 . r1 = multi_fvm%RHO(i))
391 CALL ancmsg(msgid = 12, anmode = aninfo, i1 = ix(nix, ii),
392 . r1 = multi_fvm%RHO(i))
403 local_matid = ipm(20 + imat, ix(1, 1))
405 . elbuf_tab, iparg, itask, multi_fvm, volnew)
413 gbuf%VOL(ii) = volnew(ii)
415 IF (multi_fvm%NS_DIFF)
THEN
418 multi_fvm%VOL(i) = volnew(ii)