OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
afluxt.F File Reference
#include "implicit_f.inc"
#include "spmd_c.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "vect01_c.inc"
#include "param_c.inc"
#include "task_c.inc"
#include "inter22.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine afluxt (iparg, elbuf_tab, pm, ixs, ixq, x, flux, flu2, alpha, ale_connect, itask, itrimat, flux_sav, nercvois, nesdvois, lercvois, lesdvois, lencom, qmv, itab, itabm1, nv46, segvar)

Function/Subroutine Documentation

◆ afluxt()

subroutine afluxt ( integer, dimension(nparg,ngroup) iparg,
type(elbuf_struct_), dimension(ngroup), target elbuf_tab,
pm,
integer, dimension(nixs,numels) ixs,
integer, dimension(7,numelq) ixq,
x,
flux,
flu2,
alpha,
type(t_ale_connectivity), intent(in) ale_connect,
integer itask,
integer itrimat,
flux_sav,
integer, dimension(*) nercvois,
integer, dimension(*) nesdvois,
integer, dimension(*) lercvois,
integer, dimension(*) lesdvois,
integer lencom,
qmv,
integer, dimension(numnod) itab,
integer, dimension(*) itabm1,
integer nv46,
type(t_segvar), intent(in) segvar )

Definition at line 56 of file afluxt.F.

62C-----------------------------------------------
63C M o d u l e s
64C-----------------------------------------------
65 USE initbuf_mod
66 USE trimat_mod
67 USE elbufdef_mod
68 USE i22tri_mod
69 USE i22bufbric_mod
70 USE segvar_mod
71 USE ale_connectivity_mod
72 USE alemuscl_mod , only:alemuscl_param
73 USE multimat_param_mod , ONLY : m51_n0phas, m51_nvphas
74C-----------------------------------------------
75C I m p l i c i t T y p e s
76C-----------------------------------------------
77#include "implicit_f.inc"
78C-----------------------------------------------
79C C o m m o n B l o c k s
80C-----------------------------------------------
81#include "spmd_c.inc"
82#include "com01_c.inc"
83#include "com04_c.inc"
84#include "vect01_c.inc"
85#include "param_c.inc"
86#include "task_c.inc"
87#include "inter22.inc"
88C-----------------------------------------------
89C D u m m y A r g u m e n t s
90C-----------------------------------------------
91 my_real pm(npropm,nummat), x(3,numnod),
92 . flux(nv46,*), flu2(*),
93 . alpha(*), flux_sav(nv46,*), qmv(2*nv46,*)
94
95 INTEGER IPARG(NPARG,NGROUP), IXS(NIXS,NUMELS), IXQ(7,NUMELQ)
96 INTEGER ITASK,ITRIMAT,LENCOM,ADD,NERCVOIS(*),NESDVOIS(*),LERCVOIS(*),LESDVOIS(*), ITAB(NUMNOD),ITABM1(*)
97
98 TYPE(ELBUF_STRUCT_), TARGET, DIMENSION(NGROUP) :: ELBUF_TAB
99 TYPE(t_segvar), INTENT(IN) :: SEGVAR
100 TYPE(t_ale_connectivity), INTENT(IN) :: ALE_CONNECT
101C-----------------------------------------------
102C L o c a l V a r i a b l e s
103C-----------------------------------------------
104 my_real, DIMENSION(:), POINTER :: uvar,volg,volp,pddvol
105 INTEGER NG, I, K, II, NF1, NFIRST, NLAST, NV46, LLT_
106 INTEGER :: IB, IE, NIN, NBF, NBL, K0, K1, IBM, J, IE_M, IDLOC, IPOS, ICELL, NCELL, MCELL, tNB, J1, J2, IBV
107 my_real :: vfrac
108 TYPE(BUF_MAT_) ,POINTER :: MBUF
109C-----------------------------------------------
110C S o u r c e L i n e s
111C-----------------------------------------------
112 IF(itask == 0)THEN
113 IF (n2d == 0) THEN
114 ALLOCATE(n4_vois(numels+nsvois,8))
115 ALLOCATE(flux_vois(numels+nsvois,nv46))
116 ELSE
117 ALLOCATE(n4_vois(numelq+nqvois,4))
118 ALLOCATE(flux_vois(numelq+nqvois,nv46))
119 ENDIF
120 END IF
121
122C--------------------
123 CALL my_barrier
124C--------------------
125
126C-----------------------------------------------
127C VOLUME FLUXES BACKUP
128C-----------------------------------------------
129 DO ng=itask+1,ngroup,nthread
130C ALE ON / OFF
131 IF (iparg(76, ng) == 1) cycle ! --> OFF
132 CALL initbuf(iparg ,ng ,
133 2 mtn ,llt ,nft ,iad ,ity ,
134 3 npt ,jale ,ismstr ,jeul ,jtur ,
135 4 jthe ,jlag ,jmult ,jhbe ,jivf ,
136 5 nvaux ,jpor ,jcvt ,jclose ,jplasol ,
137 6 irep ,iint ,igtyp ,israt ,isrot ,
138 7 icsen ,isorth ,isorthg ,ifailure,jsms )
139 IF(jale+jeul == 0) cycle
140 IF(iparg(8,ng) == 1) cycle
141 IF(iparg(1,ng) /= 51) cycle
142 volg => elbuf_tab(ng)%GBUF%VOL
143 uvar => elbuf_tab(ng)%BUFLY(1)%MAT(1,1,1)%VAR
144 lft=1
145 add = m51_n0phas + (itrimat-1)*m51_nvphas ! ADD => SIG(1)
146 add = add + 11 ! ADD + 11 => VOLUME_Phase
147 k = llt*(add-1) ! VAR(I,ADD) = VAR(K+I)
148 volp => uvar(k+1:k+llt)
149 DO i=lft,llt
150 ii = i+nft
151 alpha(ii) = volp(i)/volg(i)
152 alpha(ii) = max(zero,min(one,alpha(ii)))
153 ENDDO
154 DO k=1,nv46
155 DO ii=nft+lft,nft+llt
156 flux(k,ii)=flux_sav(k,ii)
157 ENDDO
158 ENDDO
159 IF(itrimat == 1)THEN
160 DO k=1,nv46
161 DO ii=nft+lft,nft+llt
162 qmv(k,ii) = zero
163 ENDDO
164 ENDDO
165 ENDIF
166 ENDDO
167
168 !IDEM FOR CUT CELLS (INTER22) (OBSOLETE)
169 IF(int22 /= 0)THEN
170 nin = 1
171 nbf = 1+itask*nb/nthread
172 nbl = (itask+1)*nb/nthread
173 nbl = min(nbl,nb)
174 tnb = nbl-nbf+1
175 DO ib=nbf,nbl
176 ncell = brick_list(nin,ib)%NBCUT
177 mcell = brick_list(nin,ib)%MainID
178 icell = 0
179 ie = brick_list(nin,ib)%ID
180 DO WHILE (icell <= ncell) ! loop on polyhedron {1:NCELL} U {9}
181 icell = icell +1
182 IF (icell>ncell .AND. ncell /= 0)icell=9
183 !get_main_data
184 j = brick_list(nin,ib)%POLY(icell)%WhereIsMain(1)
185 IF(j==0)THEN
186 ie_m = ie
187 ibm = ib
188 ELSEIF(j <= nv46)THEN
189 ie_m = brick_list(nin,ib)%Adjacent_Brick(j,1)
190 ibm = brick_list(nin,ib)%Adjacent_Brick(j,4)
191 ELSE
192 j1 = j/10
193 j2 = mod(j,10)
194 ibv = brick_list(nin,ib )%Adjacent_Brick(j1,4)
195 ibm = brick_list(nin,ibv)%Adjacent_Brick(j2,4)
196 ie_m = brick_list(nin,ibv)%Adjacent_Brick(j2,1)
197 ENDIF
198 ng = brick_list(nin,ibm)%NG
199 idloc = brick_list(nin,ibm)%IDLOC
200 mtn = iparg(1,ng)
201 IF(mtn == 51)THEN
202 mbuf => elbuf_tab(ng)%BUFLY(1)%MAT(1,1,1)
203 llt_ = iparg(2,ng)
204 !===restore direct fluxes====!
205 brick_list(nin,ib)%POLY(icell)%FACE(1:6)%Adjacent_UpwFLUX(1)=brick_list(nin,ib)%POLY(icell)%FACE(1:6)%Adjacent_FLUX(1)
206 brick_list(nin,ib)%POLY(icell)%FACE(1:6)%Adjacent_UpwFLUX(2)=brick_list(nin,ib)%POLY(icell)%FACE(1:6)%Adjacent_FLUX(2)
207 brick_list(nin,ib)%POLY(icell)%FACE(1:6)%Adjacent_UpwFLUX(3)=brick_list(nin,ib)%POLY(icell)%FACE(1:6)%Adjacent_FLUX(3)
208 brick_list(nin,ib)%POLY(icell)%FACE(1:6)%Adjacent_UpwFLUX(4)=brick_list(nin,ib)%POLY(icell)%FACE(1:6)%Adjacent_FLUX(4)
209 brick_list(nin,ib)%POLY(icell)%FACE(1:6)%Adjacent_UpwFLUX(5)=brick_list(nin,ib)%POLY(icell)%FACE(1:6)%Adjacent_FLUX(5)
210 !===get Vfrac================!
211 ipos = 1
212 k0 = ((m51_n0phas + (itrimat-1)*m51_nvphas )+ipos-1) ! example : IPOS=1 => VFRAC {UVAR(I,ADD)=UVAR(K+I)}
213 k1 = k0 * llt_
214 vfrac = mbuf%VAR(k1+idloc)
215 vfrac = max(zero,min(one,vfrac))
216 brick_list(nin,ib)%POLY(icell)%VFRACm(itrimat)= vfrac
217 ENDIF
218 enddo!next ICELL
219 enddo!next IB
220 endif!IF(INT22 /= 0)
221C--------------------
222 CALL my_barrier
223C--------------------
224
225 IF(nspmd > 1)THEN
226!$OMP SINGLE
227 CALL spmd_e1vois(alpha,nercvois,nesdvois,lercvois,lesdvois,lencom )
228!$OMP END SINGLE
229 ENDIF
230C
231C-----------------------------------------------
232C zeroing N4_VOIS & test if remote set it
233C-----------------------------------------------
234 IF(nspmd > 1)THEN
235 IF (n2d == 0) THEN
236 nfirst = 1+itask*(numels+numelq)/nthread
237 nlast = (itask+1)*(numels+numelq)/nthread
238 ELSE
239 nfirst = 1+itask*(numelq)/nthread
240 nlast = (itask+1)*(numelq)/nthread
241 ENDIF
242 n4_vois(nfirst:nlast,1) = 0
243 DO i=1,nv46
244 flux_vois(nfirst:nlast,i) = -ep20
245 ENDDO
246C----------------------
247 CALL my_barrier
248C----------------------
249 ENDIF
250C-----------------------------------------------
251C LAW51
252C submatrial volumefluxes update
253C-----------------------------------------------
254 DO ng=itask+1,ngroup,nthread
255C ALE ON / OFF
256 IF (iparg(76, ng) == 1) cycle ! --> OFF
257 CALL initbuf(iparg ,ng ,
258 2 mtn ,llt ,nft ,iad ,ity ,
259 3 npt ,jale ,ismstr ,jeul ,jtur ,
260 4 jthe ,jlag ,jmult ,jhbe ,jivf ,
261 5 nvaux ,jpor ,jcvt ,jclose ,jplasol ,
262 6 irep ,iint ,igtyp ,israt ,isrot ,
263 7 icsen ,isorth ,isorthg ,ifailure,jsms )
264 !------------------------------!
265 ! UNPLUG CONDITIONS !
266 !------------------------------!
267 IF(jale+jeul == 0) cycle
268 IF(iparg(8,ng) == 1) cycle
269 IF(iparg(1,ng) /= 51) cycle
270! IF(IPARG(64,NG) == 1) CYCLE
271 !------------------------------------!
272 ! VOLUME FLUXES UPDATE (SUBMATERIAL) !
273 !------------------------------------!
274 lft=1
275 volg => elbuf_tab(ng)%GBUF%VOL
276 IF(n2d == 0)THEN
277 IF (alemuscl_param%IALEMUSCL > 0) THEN
278 CALL alemuscl_upwind(flux, ale_connect, x, ixs, flux_vois, n4_vois,
279 . itab, nv46 , itrimat,segvar)
280 ELSE
281 CALL ale51_antidiff3(flux, ale_connect, alpha , volg, ixs, flux_vois, n4_vois,
282 . itab, nv46 , itrimat, segvar)
283 ENDIF
284 ELSE
285 IF (alemuscl_param%IALEMUSCL > 0) THEN
286 CALL alemuscl_upwind2(flux, ale_connect, x , ixq, flux_vois, n4_vois,
287 . itab, nv46 , itrimat,segvar)
288 ELSE
289 CALL ale51_antidiff2(flux ,ale_connect,alpha ,volg ,ixq,flux_vois,
290 . n4_vois,itab ,itrimat,segvar)
291 ENDIF
292 ENDIF
293 ENDDO !next NG
294
295 IF(int22 /= 0)THEN
296 CALL ale51_antidiff3_int22(flux , itrimat,ixs ,
297 . nv46, elbuf_tab,itask,alpha)
298 ENDIF
299
300C--------------------
301 CALL my_barrier
302C--------------------
303
304 IF(nspmd > 1)THEN
305!$OMP SINGLE
306 IF (n2d == 0) THEN
307 CALL spmd_e6vois(flux_vois,nercvois,nesdvois,lercvois,lesdvois,lencom)
308 CALL spmd_i8vois(n4_vois ,nercvois,nesdvois,lercvois,lesdvois,lencom)
309 ELSE
310 CALL spmd_e4vois(flux_vois,nercvois,nesdvois,lercvois,lesdvois,lencom)
311 CALL spmd_i4vois(n4_vois ,nercvois,nesdvois,lercvois,lesdvois,lencom)
312 ENDIF
313!$OMP END SINGLE
314 ENDIF
315
316C-----------------------------------------------
317C UPDATING VOLUME FLUXES & UPWIND
318C-----------------------------------------------
319 DO ng=itask+1,ngroup,nthread
320C ALE ON / OFF
321 IF (iparg(76, ng) == 1) cycle ! --> OFF
322 CALL initbuf(iparg ,ng ,
323 2 mtn ,llt ,nft ,iad ,ity ,
324 3 npt ,jale ,ismstr ,jeul ,jtur ,
325 4 jthe ,jlag ,jmult ,jhbe ,jivf ,
326 5 nvaux ,jpor ,jcvt ,jclose ,jplasol ,
327 6 irep ,iint ,igtyp ,israt ,isrot ,
328 7 icsen ,isorth ,isorthg ,ifailure,jsms )
329 !------------------------------!
330 ! UNPLUG CONDITIONS !
331 !------------------------------!
332 IF(jale+jeul == 0) cycle
333 IF(iparg(8,ng) == 1) cycle
334 IF(iparg(1,ng) /= 51) cycle
335! IF(IPARG(64,NG) == 1) CYCLE
336 lft = 1
337 nf1 = nft+1
338 uvar => elbuf_tab(ng)%BUFLY(1)%MAT(1,1,1)%VAR
339 add = (m51_n0phas + (itrimat-1)*m51_nvphas+12)*llt
340 pddvol => uvar(add+1:add+llt)
341 !DDVOL*DT IS SUM OF INCOMING AND OUTGOING VOLUMES
342 !------------------------------!
343 ! UPWIND, QMV, DDVOL !
344 !------------------------------!
345 IF(n2d == 0)THEN
346 IF(nspmd > 1)THEN
347 CALL ale51_spmd3(ixs,flux(1,nf1),ale_connect,
348 . flux_vois,n4_vois,itabm1 ,nv46)
349 ENDIF
350 CALL ale51_upwind3(pm,ixs,flux(1,nf1),flu2(nf1),ale_connect,
351 . itrimat,pddvol,qmv(1,nf1),1,
352 . nv46)
353 ELSE
354 IF(nspmd > 1)THEN
355 CALL ale51_spmd2(ixq,flux(1,nf1),ale_connect,
356 . flux_vois,n4_vois, itabm1,nv46)
357 ENDIF
358 CALL ale51_upwind2(pm,x,ixq,flux(1,nf1),flu2(nf1),ale_connect,
359 . itrimat,pddvol,qmv(1,nf1),1)
360 ENDIF
361 ENDDO
362
363 IF(int22 /= 0)THEN
364 CALL ale51_upwind3_int22(pm , ixs , itrimat, 1,
365 . iparg, elbuf_tab, itask )
366 ENDIF
367
368C--------------------
369 CALL my_barrier
370C--------------------
371
372 IF(itask == 0)THEN
373 DEALLOCATE(n4_vois)
374 DEALLOCATE(flux_vois)
375 END IF
376C-----------------------------------------------
377 RETURN
ale51_antidiff2
subroutine ale51_antidiff2(flux, ale_connect, alph, vol, ixq, flux_vois, n4_vois, itab, itrimat, segvar)
Definition ale51_antidiff2.F:35
ale51_antidiff3
subroutine ale51_antidiff3(flux, ale_connect, alph, vol, ixs, flux_vois, n4_vois, itab, nv46, itrimat, segvar)
Definition ale51_antidiff3.F:37
ale51_antidiff3_int22
subroutine ale51_antidiff3_int22(flux, itrimat, ixs, nv46, elbuf_tab, itask, vfrac)
Definition ale51_antidiff3_int22.F:36
ale51_spmd2
subroutine ale51_spmd2(ixq, flux, ale_connect, flux_vois, n4_vois, itabm1, nv46)
Definition ale51_spmd2.F:34
ale51_spmd3
subroutine ale51_spmd3(ixs, flux, ale_connect, flux_vois, n4_vois, itabm1, nv46)
Definition ale51_spmd3.F:34
ale51_upwind2
subroutine ale51_upwind2(pm, x, ixq, flux, flu1, ale_connect, itrimat, ddvol, qmv, iflg)
Definition ale51_upwind2.F:34
ale51_upwind3
subroutine ale51_upwind3(pm, ixs, flux, flu1, ale_connect, itrimat, ddvol, qmv, iflg, nv46)
Definition ale51_upwind3.F:36
ale51_upwind3_int22
subroutine ale51_upwind3_int22(pm, ixs, itrimat, iflg, iparg, elbuf_tab, itask)
Definition ale51_upwind3_int22.F:40
alemuscl_upwind2
subroutine alemuscl_upwind2(flux, ale_connect, x, ixq, flux_vois, n4_vois, itab, nv46, itrimat, segvar)
Definition alemuscl_upwind2.F:36
alemuscl_upwind
subroutine alemuscl_upwind(flux, ale_connect, x, ixs, flux_vois, n4_vois, itab, nv46, itrimat, segvar)
Definition alemuscl_upwind.F:36
my_real
#define my_real
Definition cppsort.cpp:32
alpha
#define alpha
Definition eval.h:35
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
ale_connectivity_mod
Definition ale_connectivity_mod.F:223
alemuscl_mod
Definition alemuscl_mod.F:54
alemuscl_mod::alemuscl_param
type(alemuscl_param_) alemuscl_param
Definition alemuscl_mod.F:75
i22bufbric_mod
Definition cut-cell-search_mod.F:95
i22bufbric_mod::brick_list
type(brick_entity), dimension(:,:), allocatable, target brick_list
Definition cut-cell-search_mod.F:105
i22tri_mod
Definition cut-cell-search_mod.F:212
i22tri_mod::nb
integer nb
Definition cut-cell-search_mod.F:487
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
segvar_mod
Definition segvar_mod.F:61
trimat_mod
Definition trimat.F:31
trimat_mod::n4_vois
integer, dimension(:,:), allocatable n4_vois
Definition trimat.F:34
spmd_e4vois
subroutine spmd_e4vois(phi, nercvois, nesdvois, lercvois, lesdvois, lencom)
Definition spmd_cfd.F:586
spmd_i8vois
subroutine spmd_i8vois(phi, nercvois, nesdvois, lercvois, lesdvois, lencom)
Definition spmd_cfd.F:799
spmd_i4vois
subroutine spmd_i4vois(phi, nercvois, nesdvois, lercvois, lesdvois, lencom)
Definition spmd_cfd.F:919
spmd_e6vois
subroutine spmd_e6vois(phi, nercvois, nesdvois, lercvois, lesdvois, lencom)
Definition spmd_cfd.F:474
spmd_e1vois
subroutine spmd_e1vois(phi, nercvois, nesdvois, lercvois, lesdvois, lencom)
Definition spmd_cfd.F:375
my_barrier
subroutine my_barrier
Definition machine.F:31