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 57 of file afluxt.F.

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