OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
ale51_antidiff3_int22.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23!||====================================================================
24!|| ale51_antidiff3_int22 ../engine/source/ale/alefvm/cut_cells/ale51_antidiff3_int22.F
25!||--- called by ------------------------------------------------------
26!|| afluxt ../engine/source/ale/ale51/afluxt.F
27!||--- uses -----------------------------------------------------
28!|| ale_mod ../common_source/modules/ale/ale_mod.F
29!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
30!|| i22bufbric_mod ../common_source/modules/interfaces/cut-cell-search_mod.F
31!|| i22tri_mod ../common_source/modules/interfaces/cut-cell-search_mod.F
32!||====================================================================
33 SUBROUTINE ale51_antidiff3_int22(FLUX , ITRIMAT, IXS ,
34 . NV46 , ELBUF_TAB,
35 . ITASK , VFRAC)
36C-----------------------------------------------
37C M o d u l e s
38C-----------------------------------------------
39 USE elbufdef_mod
40 USE i22bufbric_mod
41 USE i22tri_mod
42 USE ale_mod
43C-----------------------------------------------
44C D e c r i p t i o n
45C-----------------------------------------------
46C 'alefvm' is related to a collocated scheme (built from FVM and based on Godunov scheme)
47C which was temporarily introduced for experimental option /INTER/TYPE22 (FSI coupling with cut cell method)
48C This cut cell method is not completed, abandoned, and is not an official option.
49C There is no other use for this scheme which is automatically enabled when /INTER/TYPE22 is defined (INT22>0 => IALEFVM=1).
50C
51c Same as ALE51_ANTIDIFF3 but for cut cells
52C (inter22)
53C-----------------------------------------------
54C I m p l i c i t T y p e s
55C-----------------------------------------------
56#include "implicit_f.inc"
57C-----------------------------------------------
58C C o m m o n B l o c k s
59C-----------------------------------------------
60#include "spmd_c.inc"
61#include "com01_c.inc"
62#include "com04_c.inc"
63#include "com08_c.inc"
64#include "param_c.inc"
65#include "task_c.inc"
66C-----------------------------------------------
67C D u m m y A r g u m e n t s
68C-----------------------------------------------
69 INTEGER IXS(NIXS,*),NV46,ITRIMAT,ITASK
70 my_real
71 . flux(nv46,*),vfrac(*)
72 TYPE(elbuf_struct_), TARGET, DIMENSION(NGROUP) :: ELBUF_TAB
73C-----------------------------------------------
74C L o c a l V a r i a b l e s
75C-----------------------------------------------
76 INTEGER K,KK,J1,J2,J
77 my_real
78 . vol0,av0,uav0,alphi,ualphi,aaa,ff(nv46,5),udt,phi0 !FF(NV46,5=NADJ_MAX)
79 INTEGER :: IE, MLW, IADJv, NADJv, IB, NBF, NBL, ICELL,ICELLM, MCELL, IE_M, IBM,NG,IDLOC,NADJ,IADJ
80 INTEGER :: NIN,NCELL,IBV,IFV,ICELLv, IEV
81 my_real :: volg, alph, alphv(6,5), tmpflux(nv46,5) !5=NAdj_max
82 my_real :: debug_tmp
83 LOGICAL :: debug_outp
84C-----------------------------------------------
85C P r e - C o n d i t i o n s
86C-----------------------------------------------
87 IF(trimat==0)RETURN
88C-----------------------------------------------
89C S o u r c e L i n e s
90C-----------------------------------------------
91
92 IF(dt1>zero)THEN
93 udt = one/dt1
94 ELSE
95 udt = zero
96 ENDIF
97
98 nin = 1
99 nbf = 1+itask*nb/nthread
100 nbl = (itask+1)*nb/nthread
101 nbl = min(nbl,nb)
102
103
104 !INTERFACE 22 ONLY - OUTPUT---------------!
105 debug_outp = .false.
106 if(ibug22_antidiff/=0)then
107 debug_outp = .false.
108 if(ibug22_antidiff>0)then
109 do ib=nbf,nbl
110 ie = brick_list(nin,ib)%id
111 if(ixs(11,ie)==ibug22_antidiff)then
112 mlw = brick_list(nin,ib)%MLW
113 if(mlw==51)then
114 debug_outp=.true.
115 endif
116 endif
117 enddo
118 elseif(ibug22_antidiff==-1)then
119 debug_outp = .true.
120 kk = 1
121 do ib=nbf,nbl
122 mlw = brick_list(nin,ib)%MLW
123 if(mlw/=51)then
124 kk = 0
125 endif
126 enddo
127 if (kk==0)debug_outp=.false.
128 endif
129 if(((itrimat/=ibug22_itrimat).and.(ibug22_itrimat/=-1)))debug_outp=.false.
130 endif
131 if(debug_outp)then
132 print *, " |----ale51_antidiff3_int22.F-----|"
133 print *, " | THREAD INFORMATION |"
134 print *, " |--------------------------------|"
135 print *, " NCYCLE =", ncycle
136 print *, " ITRIMAT =", itrimat
137 endif
138 !INTERFACE 22 ONLY - OUTPUT---------------!
139
140
141 DO ib=nbf,nbl
142 ie = brick_list(nin,ib)%ID
143 mlw = brick_list(nin,ib)%MLW
144 ncell = brick_list(nin,ib)%NBCUT
145 mcell = brick_list(nin,ib)%MainID
146 icell = 0
147 DO WHILE (icell<=ncell) ! loop on polyhedron {1:NCELL} U {9}
148 icell = icell +1
149 IF (icell>ncell .AND. ncell/=0)icell=9
150 !get_main_data
151 j = brick_list(nin,ib)%POLY(icell)%WhereIsMain(1)
152 icellm = brick_list(nin,ib)%POLY(icell)%WhereIsMain(2)
153 IF(j==0)THEN
154 ie_m = ie
155 ibm = ib
156 icellm = mcell
157 ELSEIF(j<=nv46)THEN
158 ie_m = brick_list(nin,ib)%Adjacent_Brick(j,1)
159 ibm = brick_list(nin,ib)%Adjacent_Brick(j,4)
160 ELSE
161 j1 = j/10
162 j2 = mod(j,10)
163 ibv = brick_list(nin,ib )%Adjacent_Brick(j1,4)
164 ie_m = brick_list(nin,ibv)%Adjacent_Brick(j2,1)
165 ibm = brick_list(nin,ibv)%Adjacent_Brick(j2,4)
166 ENDIF
167 ng = brick_list(nin,ibm)%NG
168 idloc = brick_list(nin,ibm)%IDLOC
169 mlw = brick_list(nin,ibm)%MLW
170 IF(mlw/=51)cycle
171 alph = brick_list(nin,ibm)%POLY(icellm)%VFRACm(itrimat)
172 volg = elbuf_tab(ng)%GBUF%VOL(idloc)
173 vol0 = volg*udt
174 av0 = alph * vol0
175 uav0 = vol0 - av0
176 alphi = zero
177 ualphi = zero
178 phi0 = zero
179 !-----------------------------------------------
180 ! face voisine du voisin
181 ! et flux total sortant
182 !-----------------------------------------------
183 DO k=1,nv46
184 nadj = brick_list(nin,ib)%POLY(icell)%FACE(k)%NAdjCell
185 DO iadj=1,nadj
186 tmpflux(k,iadj) = brick_list(nin,ib)%POLY(icell)%FACE(k)%Adjacent_UpwFLUX(iadj)
187 IF(tmpflux(k,iadj)>zero)THEN
188 iev = brick_list(nin,ib)%Adjacent_Brick(k,1)
189 ibv = brick_list(nin,ib)%Adjacent_Brick(k,4)
190 ifv = brick_list(nin,ib)%Adjacent_Brick(k,5)
191 icellv = brick_list(nin,ib)%POLY(icell)%FACE(k)%Adjacent_Cell(iadj)
192 IF(icellv==0) THEN !adj elem does not exist
193 alphv(k,iadj) = alph
194 ELSE !adjacent elem does exist
195 IF(ibv==0)THEN
196 IF(iev==0)print *, "inter22 : potential material leakage, Check domain boundaries..."
197 alphv(k,iadj) = vfrac(iev)
198 ELSE
199 alphv(k,iadj) = brick_list(nin,ibv)%POLY(icellv)%VFRACm(itrimat)
200 ENDIF
201 ENDIF
202 ff(k,iadj)= alphv(k,iadj) * tmpflux(k,iadj)
203 !flux sortant estime
204 alphi = alphi + ff(k,iadj)
205 !flux sortant initial
206 phi0 = phi0 + tmpflux(k,iadj)
207 ENDIF
208 enddo!next IADJ
209 enddo!next K
210 !vide sortant estime
211 ualphi = phi0 - alphi
212 !-----------------------------------------------
213 ! flux sortant par face
214 !-----------------------------------------------
215 IF(alphi>av0.AND.av0>zero)THEN
216 !-----------------------------------------------
217 ! flux sortant > volume non vide
218 !-----------------------------------------------
219 aaa = av0 / alphi
220 DO k=1,nv46
221 nadj = brick_list(nin,ib)%POLY(icell)%FACE(k)%NAdjCell
222 DO iadj=1,nadj
223 IF(tmpflux(k,iadj)>zero)THEN
224 ff(k,iadj) = ff(k,iadj) * aaa
225 ENDIF
226 enddo!necti IADJ
227 enddo!next K
228 ELSEIF(ualphi>uav0.AND.uav0>zero)THEN
229 !-----------------------------------------------
230 ! vide sortant > vide disponible
231 !-----------------------------------------------
232 aaa = uav0/ualphi
233 DO k=1,nv46
234 nadj = brick_list(nin,ib)%POLY(icell)%FACE(k)%NAdjCell
235 DO iadj=1,nadj
236 IF(tmpflux(k,iadj)>zero)THEN
237 ff(k,iadj) = tmpflux(k,iadj) + (ff(k,iadj)-tmpflux(k,iadj))*aaa
238 ENDIF
239 enddo!next IADJ
240 enddo!next K
241 ENDIF
242 !-----------------------------------------------
243 ! flux sortant
244 !-----------------------------------------------
245 DO k=1,nv46
246 nadj = brick_list(nin,ib)%POLY(icell)%FACE(k)%NAdjCell
247 DO iadj=1,nadj
248 iev = brick_list(nin,ib)%Adjacent_Brick(k,1)
249 ibv = brick_list(nin,ib)%Adjacent_Brick(k,4)
250 ifv = brick_list(nin,ib)%Adjacent_Brick(k,5)
251 icellv = brick_list(nin,ib)%POLY(icell)%FACE(k)%Adjacent_Cell(iadj)
252 IF(tmpflux(k,iadj)>zero)THEN
253 ff(k,iadj) = half * ( ff(k,iadj)*(one-ale%UPWIND%UPWSM)+alph*tmpflux(k,iadj)*(one+ale%UPWIND%UPWSM) )
254
255
256
257 !INTERFACE 22 ONLY------------------------!
258 if(debug_outp)then
259 ie = brick_list(nin,ib)%Id
260 if(ibug22_antidiff==ixs(11,ie) .OR. ibug22_antidiff==-1)then
261
262 print *, " brique =", ixs(11,ie)
263 print *, " icell =", icell
264 print *, " FACE =", k
265 print *, " ALPH =", alph
266 print *, " ALPHv =", alphv(k,iadj)
267 write (*,fmt='(A,6E26.14)')" WAS Flux(J) =", brick_list(nin,ib)%POLY(icell)%FACE(k)%Adjacent_upwFLUX(iadj)
268 write (*,fmt='(A,6E26.14)')" IS Flux(J) =", ff(k,iadj)
269 print *, " ------------------------"
270 endif
271 endif
272 !-----------------------------------------!
273
274 !flux is here updated
275 brick_list(nin,ib)%POLY(icell)%FACE(k)%Adjacent_UpwFLUX(iadj) = ff(k,iadj)
276
277 !adjacent flux is also updated to be consistent and conservative
278 IF(icellv>0)THEN
279 !recherche du flux voisin
280 !OPTIM PLUS TARD : si deja calcule dans sinit, stocker pour economiser acces memoires
281 IF(ibv>0)THEN
282 !--IN CUT CELL BUFFER
283 nadjv = brick_list(nin,ibv)%POLY(icellv)%FACE(ifv)%NAdjCell
284 DO iadjv=1,nadjv
285 IF(brick_list(nin,ibv)%POLY(icellv)%FACE(ifv)%Adjacent_Cell(iadjv)==icell)EXIT
286 !(IB,ICELL,IADjv) <---bijected to---> (IBv,ICELLv,IADJ)
287 ENDDO
288 debug_tmp = brick_list(nin,ibv)%POLY(icellv)%FACE(ifv)%Adjacent_UpwFLUX(iadjv)
289 brick_list(nin,ibv)%POLY(icellv)%FACE(ifv)%Adjacent_UpwFLUX(iadjv) = -ff(k,iadj)
290 ELSE
291 !--NOT IN CUT CELL BUFFER
292 debug_tmp = flux(ifv,iev)
293 flux(ifv,iev) = -ff(k,iadj)
294 ENDIF
295
296 !INTERFACE 22 ONLY------------------------!
297 if(debug_outp)then
298 if(ibug22_antidiff==ixs(11,ie) .OR. ibug22_antidiff==-1)then
299 print *, " => Setting adjacent flux consequently :"
300 print *, " brique.V =", ixs(11,iev)
301 print *, " icell.V =", icellv
302 print *, " FACE.V =", ifv
303 write (*,fmt='(A,6E26.14)')
304 . " WAS Flux(J) =", debug_tmp
305 write (*,fmt='(A,6E26.14)')
306 . " IS Flux(J) =", -ff(k,iadj)
307 print *, " ---"
308 endif
309 endif
310 !-----------------------------------------!
311 ELSE
312 !TRAITEMENT SPMD HERE : see ale51_antidiff3.F
313 ENDIF
314 ENDIF
315 enddo!next IADJ
316 enddo!next K
317 !-----------------------------------------------
318 enddo!next ICELL
319 enddo!next IB
320
321C-------------
322 RETURN
323 END
324C
ale51_antidiff3_int22
subroutine ale51_antidiff3_int22(flux, itrimat, ixs, nv46, elbuf_tab, itask, vfrac)
Definition ale51_antidiff3_int22.F:36
min
#define min(a, b)
Definition macros.h:20
ale_mod
Definition ale_mod.F:149
ale_mod::ale
type(ale_) ale
Definition ale_mod.F:249
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