56 SUBROUTINE afluxt(IPARG ,ELBUF_TAB ,PM ,IXS ,IXQ ,
58 3 ALPHA ,ALE_CONNECT ,ITASK ,
59 4 ITRIMAT ,FLUX_SAV ,NERCVOIS ,NESDVOIS,
60 5 LERCVOIS,LESDVOIS ,LENCOM ,QMV ,ITAB ,
61 6 ITABM1 ,NV46 ,SEGVAR)
73 USE multimat_param_mod ,
ONLY : m51_n0phas, m51_nvphas
77#include "implicit_f.inc"
84#include "vect01_c.inc"
91 my_real pm(npropm,nummat), x(3,numnod),
92 . flux(nv46,*), flu2(*),
95 INTEGER (NPARG,NGROUP), IXS(NIXS,NUMELS), IXQ(7,NUMELQ)
96 INTEGER ITASK,,LENCOM,ADD,NERCVOIS(*),NESDVOIS(*),LERCVOIS(*),LESDVOIS(*), ITAB(NUMNOD),ITABM1(*)
98 TYPE(ELBUF_STRUCT_),
TARGET,
DIMENSION(NGROUP) :: ELBUF_TAB
99 TYPE(t_segvar),
INTENT(IN) :: SEGVAR
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, , IBV
108 TYPE(BUF_MAT_) ,
POINTER :: MBUF
114 ALLOCATE(
n4_vois(numels+nsvois,8))
115 ALLOCATE(flux_vois(numels+nsvois,nv46))
117 ALLOCATE(
n4_vois(numelq+nqvois,4))
118 ALLOCATE(flux_vois(numelq+nqvois,nv46))
129 DO ng=itask+1,ngroup,nthread
131 IF (iparg(76, ng) == 1) cycle
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
145 add = m51_n0phas + (itrimat-1)*m51_nvphas
148 volp => uvar(k+1:k+llt)
151 alpha(ii) = volp(i)/volg(i)
155 DO ii=nft+lft,nft+llt
156 flux(k,ii)=flux_sav(k,ii)
161 DO ii=nft+lft,nft+llt
171 nbf = 1+itask*
nb/nthread
172 nbl = (itask+1)*
nb/nthread
180 DO WHILE (icell <= ncell)
182 IF (icell>ncell .AND. ncell /= 0)icell=9
184 j =
brick_list(nin,ib)%POLY(icell)%WhereIsMain(1)
188 ELSEIF(j <= nv46)
THEN
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)
202 mbuf => elbuf_tab(ng)%BUFLY(1)%MAT(1,1,1)
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)
212 k0 = ((m51_n0phas + (itrimat-1)*m51_nvphas )+ipos-1)
214 vfrac = mbuf%VAR(k1+idloc)
215 vfrac =
max(zero,
min(one,vfrac))
216 brick_list(nin,ib)%POLY(icell)%VFRACm(itrimat)= vfrac
236 nfirst = 1+itask*(numels+numelq)/nthread
237 nlast = (itask+1)*(numels+numelq)/nthread
239 nfirst = 1+itask*(numelq)/nthread
240 nlast = (itask+1)*(numelq)/nthread
244 flux_vois(nfirst:nlast,i) = -ep20
254 DO ng=itask+1,ngroup,nthread
256 IF (iparg(76, ng) == 1) cycle
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 )
267 IF(jale+jeul == 0) cycle
268 IF(iparg(8,ng) == 1) cycle
269 IF(iparg(1,ng) /= 51) cycle
275 volg => elbuf_tab(ng)%GBUF%VOL
279 . itab, nv46 , itrimat,segvar)
282 . itab, nv46 , itrimat, segvar)
287 . itab, nv46 , itrimat,segvar)
290 .
n4_vois,itab ,itrimat,segvar)
297 . nv46, elbuf_tab,itask,
alpha)
307 CALL spmd_e6vois(flux_vois,nercvois,nesdvois,lercvois,lesdvois,lencom)
310 CALL spmd_e4vois(flux_vois,nercvois,nesdvois,lercvois,lesdvois,lencom)
319 DO ng=itask+1,ngroup,nthread
321 IF (iparg(76, ng) == 1) cycle
323 2 mtn ,llt ,nft ,iad ,ity ,
324 3 npt ,jale ,ismstr ,jeul ,jtur ,
325 4 jthe ,jlag ,jmult ,jhbe ,jivf ,
327 6 irep ,iint ,igtyp ,israt
328 7 icsen ,isorth ,isorthg ,ifailure,jsms )
332 IF(jale+jeul == 0) cycle
333 IF(iparg(8,ng) == 1) cycle
334 IF(iparg(1,ng) /= 51) cycle
339 add = (m51_n0phas + (itrimat-1)*m51_nvphas+12)*llt
340 pddvol => uvar(add+1:add+llt)
348 . flux_vois,
n4_vois,itabm1 ,nv46)
351 . itrimat,pddvol,qmv(1,nf1),1,
356 . flux_vois,
n4_vois, itabm1,nv46)
358 CALL ale51_upwind2(pm,x,ixq,flux(1,nf1),flu2(nf1),ale_connect,
359 . itrimat,pddvol,qmv(1,nf1),1)
365 . iparg, elbuf_tab, itask )
374 DEALLOCATE(flux_vois)