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

Go to the source code of this file.

Functions/Subroutines

subroutine ale51_antidiff3_int22 (flux, itrimat, ixs, nv46, elbuf_tab, itask, vfrac)

Function/Subroutine Documentation

◆ ale51_antidiff3_int22()

subroutine ale51_antidiff3_int22 ( flux,
integer itrimat,
integer, dimension(nixs,*) ixs,
integer nv46,
type(elbuf_struct_), dimension(ngroup), target elbuf_tab,
integer itask,
vfrac )

Definition at line 34 of file ale51_antidiff3_int22.F.

37C-----------------------------------------------
38C M o d u l e s
39C-----------------------------------------------
40 USE elbufdef_mod
41 USE i22bufbric_mod
42 USE i22tri_mod
43 USE ale_mod
44 use element_mod , only : nixs
45C-----------------------------------------------
46C D e c r i p t i o n
47C-----------------------------------------------
48C 'alefvm' is related to a collocated scheme (built from FVM and based on Godunov scheme)
49C which was temporarily introduced for experimental option /INTER/TYPE22 (FSI coupling with cut cell method)
50C This cut cell method is not completed, abandoned, and is not an official option.
51C There is no other use for this scheme which is automatically enabled when /INTER/TYPE22 is defined (INT22>0 => IALEFVM=1).
52C
53c Same as ALE51_ANTIDIFF3 but for cut cells
54C (inter22)
55C-----------------------------------------------
56C I m p l i c i t T y p e s
57C-----------------------------------------------
58#include "implicit_f.inc"
59C-----------------------------------------------
60C C o m m o n B l o c k s
61C-----------------------------------------------
62#include "spmd_c.inc"
63#include "com01_c.inc"
64#include "com04_c.inc"
65#include "com08_c.inc"
66#include "param_c.inc"
67#include "task_c.inc"
68C-----------------------------------------------
69C D u m m y A r g u m e n t s
70C-----------------------------------------------
71 INTEGER IXS(NIXS,*),NV46,ITRIMAT,ITASK
72 my_real
73 . flux(nv46,*),vfrac(*)
74 TYPE(ELBUF_STRUCT_), TARGET, DIMENSION(NGROUP) :: ELBUF_TAB
75C-----------------------------------------------
76C L o c a l V a r i a b l e s
77C-----------------------------------------------
78 INTEGER K,KK,J1,J2,J
79 my_real
80 . vol0,av0,uav0,alphi,ualphi,aaa,ff(nv46,5),udt,phi0 !FF(NV46,5=NADJ_MAX)
81 INTEGER :: IE, MLW, IADJv, NADJv, IB, NBF, NBL, ICELL,ICELLM, MCELL, IE_M, IBM,NG,IDLOC,NADJ,IADJ
82 INTEGER :: NIN,NCELL,IBV,IFV,ICELLv, IEV
83 my_real :: volg, alph, alphv(6,5), tmpflux(nv46,5) !5=NAdj_max
84 my_real :: debug_tmp
85 LOGICAL :: debug_outp
86C-----------------------------------------------
87C P r e - C o n d i t i o n s
88C-----------------------------------------------
89 IF(trimat==0)RETURN
90C-----------------------------------------------
91C S o u r c e L i n e s
92C-----------------------------------------------
93
94 IF(dt1>zero)THEN
95 udt = one/dt1
96 ELSE
97 udt = zero
98 ENDIF
99
100 nin = 1
101 nbf = 1+itask*nb/nthread
102 nbl = (itask+1)*nb/nthread
103 nbl = min(nbl,nb)
104
105
106 !INTERFACE 22 ONLY - OUTPUT---------------!
107 debug_outp = .false.
108 if(ibug22_antidiff/=0)then
109 debug_outp = .false.
110 if(ibug22_antidiff>0)then
111 do ib=nbf,nbl
112 ie = brick_list(nin,ib)%id
113 if(ixs(11,ie)==ibug22_antidiff)then
114 mlw = brick_list(nin,ib)%MLW
115 if(mlw==51)then
116 debug_outp=.true.
117 endif
118 endif
119 enddo
120 elseif(ibug22_antidiff==-1)then
121 debug_outp = .true.
122 kk = 1
123 do ib=nbf,nbl
124 mlw = brick_list(nin,ib)%MLW
125 if(mlw/=51)then
126 kk = 0
127 endif
128 enddo
129 if (kk==0)debug_outp=.false.
130 endif
131 if(((itrimat/=ibug22_itrimat).and.(ibug22_itrimat/=-1)))debug_outp=.false.
132 endif
133 if(debug_outp)then
134 print *, " |----ale51_antidiff3_int22.F-----|"
135 print *, " | THREAD INFORMATION |"
136 print *, " |--------------------------------|"
137 print *, " NCYCLE =", ncycle
138 print *, " ITRIMAT =", itrimat
139 endif
140 !INTERFACE 22 ONLY - OUTPUT---------------!
141
142
143 DO ib=nbf,nbl
144 ie = brick_list(nin,ib)%ID
145 mlw = brick_list(nin,ib)%MLW
146 ncell = brick_list(nin,ib)%NBCUT
147 mcell = brick_list(nin,ib)%MainID
148 icell = 0
149 DO WHILE (icell<=ncell) ! loop on polyhedron {1:NCELL} U {9}
150 icell = icell +1
151 IF (icell>ncell .AND. ncell/=0)icell=9
152 !get_main_data
153 j = brick_list(nin,ib)%POLY(icell)%WhereIsMain(1)
154 icellm = brick_list(nin,ib)%POLY(icell)%WhereIsMain(2)
155 IF(j==0)THEN
156 ie_m = ie
157 ibm = ib
158 icellm = mcell
159 ELSEIF(j<=nv46)THEN
160 ie_m = brick_list(nin,ib)%Adjacent_Brick(j,1)
161 ibm = brick_list(nin,ib)%Adjacent_Brick(j,4)
162 ELSE
163 j1 = j/10
164 j2 = mod(j,10)
165 ibv = brick_list(nin,ib )%Adjacent_Brick(j1,4)
166 ie_m = brick_list(nin,ibv)%Adjacent_Brick(j2,1)
167 ibm = brick_list(nin,ibv)%Adjacent_Brick(j2,4)
168 ENDIF
169 ng = brick_list(nin,ibm)%NG
170 idloc = brick_list(nin,ibm)%IDLOC
171 mlw = brick_list(nin,ibm)%MLW
172 IF(mlw/=51)cycle
173 alph = brick_list(nin,ibm)%POLY(icellm)%VFRACm(itrimat)
174 volg = elbuf_tab(ng)%GBUF%VOL(idloc)
175 vol0 = volg*udt
176 av0 = alph * vol0
177 uav0 = vol0 - av0
178 alphi = zero
179 ualphi = zero
180 phi0 = zero
181 !-----------------------------------------------
182 ! neighboring face of the neighbor
183 ! and total outgoing flux
184 !-----------------------------------------------
185 DO k=1,nv46
186 nadj = brick_list(nin,ib)%POLY(icell)%FACE(k)%NAdjCell
187 DO iadj=1,nadj
188 tmpflux(k,iadj) = brick_list(nin,ib)%POLY(icell)%FACE(k)%Adjacent_UpwFLUX(iadj)
189 IF(tmpflux(k,iadj)>zero)THEN
190 iev = brick_list(nin,ib)%Adjacent_Brick(k,1)
191 ibv = brick_list(nin,ib)%Adjacent_Brick(k,4)
192 ifv = brick_list(nin,ib)%Adjacent_Brick(k,5)
193 icellv = brick_list(nin,ib)%POLY(icell)%FACE(k)%Adjacent_Cell(iadj)
194 IF(icellv==0) THEN !adj elem does not exist
195 alphv(k,iadj) = alph
196 ELSE !adjacent elem does exist
197 IF(ibv==0)THEN
198 IF(iev==0)print *, "inter22 : potential material leakage, Check domain boundaries..."
199 alphv(k,iadj) = vfrac(iev)
200 ELSE
201 alphv(k,iadj) = brick_list(nin,ibv)%POLY(icellv)%VFRACm(itrimat)
202 ENDIF
203 ENDIF
204 ff(k,iadj)= alphv(k,iadj) * tmpflux(k,iadj)
205 !outgoing flow
206 alphi = alphi + ff(k,iadj)
207 !initial outgoing flow
208 phi0 = phi0 + tmpflux(k,iadj)
209 ENDIF
210 enddo!next IADJ
211 enddo!next K
212 !Empty outgoing esteem
213 ualphi = phi0 - alphi
214 !-----------------------------------------------
215 ! outgoing flux by face
216 !-----------------------------------------------
217 IF(alphi>av0.AND.av0>zero)THEN
218 !-----------------------------------------------
219 ! Outgoing flow> Non -empty volume
220 !-----------------------------------------------
221 aaa = av0 / alphi
222 DO k=1,nv46
223 nadj = brick_list(nin,ib)%POLY(icell)%FACE(k)%NAdjCell
224 DO iadj=1,nadj
225 IF(tmpflux(k,iadj)>zero)THEN
226 ff(k,iadj) = ff(k,iadj) * aaa
227 ENDIF
228 enddo!necti IADJ
229 enddo!next K
230 ELSEIF(ualphi>uav0.AND.uav0>zero)THEN
231 !-----------------------------------------------
232 ! Outgoing empty> Available empty
233 !-----------------------------------------------
234 aaa = uav0/ualphi
235 DO k=1,nv46
236 nadj = brick_list(nin,ib)%POLY(icell)%FACE(k)%NAdjCell
237 DO iadj=1,nadj
238 IF(tmpflux(k,iadj)>zero)THEN
239 ff(k,iadj) = tmpflux(k,iadj) + (ff(k,iadj)-tmpflux(k,iadj))*aaa
240 ENDIF
241 enddo!next IADJ
242 enddo!next K
243 ENDIF
244 !-----------------------------------------------
245 ! output
246 !-----------------------------------------------
247 DO k=1,nv46
248 nadj = brick_list(nin,ib)%POLY(icell)%FACE(k)%NAdjCell
249 DO iadj=1,nadj
250 iev = brick_list(nin,ib)%Adjacent_Brick(k,1)
251 ibv = brick_list(nin,ib)%Adjacent_Brick(k,4)
252 ifv = brick_list(nin,ib)%Adjacent_Brick(k,5)
253 icellv = brick_list(nin,ib)%POLY(icell)%FACE(k)%Adjacent_Cell(iadj)
254 IF(tmpflux(k,iadj)>zero)THEN
255 ff(k,iadj) = half * ( ff(k,iadj)*(one-ale%UPWIND%UPWSM)+alph*tmpflux(k,iadj)*(one+ale%UPWIND%UPWSM) )
256
257
258
259 !INTERFACE 22 ONLY------------------------!
260 if(debug_outp)then
261 ie = brick_list(nin,ib)%Id
262 if(ibug22_antidiff==ixs(11,ie) .OR. ibug22_antidiff==-1)then
263
264 print *, " brique =", ixs(11,ie)
265 print *, " icell =", icell
266 print *, " FACE =", k
267 print *, " ALPH =", alph
268 print *, " ALPHv =", alphv(k,iadj)
269 write (*,fmt='(A,6E26.14)')" WAS Flux(J) =", brick_list(nin,ib)%POLY(icell)%FACE(k)%Adjacent_upwFLUX(iadj)
270 write (*,fmt='(A,6E26.14)')" IS Flux(J) =", ff(k,iadj)
271 print *, " ------------------------"
272 endif
273 endif
274 !-----------------------------------------!
275
276 !flux is here updated
277 brick_list(nin,ib)%POLY(icell)%FACE(k)%Adjacent_UpwFLUX(iadj) = ff(k,iadj)
278
279 !adjacent flux is also updated to be consistent and conservative
280 IF(icellv>0)THEN
281 !search for neighboring flux
282 !Optim later: if already calculated in Sinit, store to save Accesses Memoires
283 IF(ibv>0)THEN
284 !--IN CUT CELL BUFFER
285 nadjv = brick_list(nin,ibv)%POLY(icellv)%FACE(ifv)%NAdjCell
286 DO iadjv=1,nadjv
287 IF(brick_list(nin,ibv)%POLY(icellv)%FACE(ifv)%Adjacent_Cell(iadjv)==icell)EXIT
288 !(IB,ICELL,IADjv) <---bijected to---> (IBv,ICELLv,IADJ)
289 ENDDO
290 debug_tmp = brick_list(nin,ibv)%POLY(icellv)%FACE(ifv)%Adjacent_UpwFLUX(iadjv)
291 brick_list(nin,ibv)%POLY(icellv)%FACE(ifv)%Adjacent_UpwFLUX(iadjv) = -ff(k,iadj)
292 ELSE
293 !--NOT IN CUT CELL BUFFER
294 debug_tmp = flux(ifv,iev)
295 flux(ifv,iev) = -ff(k,iadj)
296 ENDIF
297
298 !INTERFACE 22 ONLY------------------------!
299 if(debug_outp)then
300 if(ibug22_antidiff==ixs(11,ie) .OR. ibug22_antidiff==-1)then
301 print *, " => Setting adjacent flux consequently :"
302 print *, " brique.V =", ixs(11,iev)
303 print *, " icell.V =", icellv
304 print *, " FACE.V =", ifv
305 write (*,fmt='(A,6E26.14)')
306 . " WAS Flux(J) =", debug_tmp
307 write (*,fmt='(A,6E26.14)')
308 . " IS Flux(J) =", -ff(k,iadj)
309 print *, " ---"
310 endif
311 endif
312 !-----------------------------------------!
313 ELSE
314 !TRAITEMENT SPMD HERE : see ale51_antidiff3.F
315 ENDIF
316 ENDIF
317 enddo!next IADJ
318 enddo!next K
319 !-----------------------------------------------
320 enddo!next ICELL
321 enddo!next IB
322
323C-------------
324 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
min
#define min(a, b)
Definition macros.h:20
ale_mod
Definition ale_mod.F:150
ale_mod::ale
type(ale_) ale
Definition ale_mod.F:253
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
i22tri_mod::ibug22_itrimat
integer ibug22_itrimat
Definition cut-cell-search_mod.F:393
i22tri_mod::ibug22_antidiff
integer ibug22_antidiff
Definition cut-cell-search_mod.F:398