OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
a22conv3.F File Reference
#include "implicit_f.inc"
#include "mvsiz_p.inc"
#include "com01_c.inc"
#include "com08_c.inc"
#include "task_c.inc"
#include "inter22.inc"
#include "param_c.inc"
#include "comlock.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine a22conv3 (phi, iflg, itrimat, nvar, itask, elbuf_tab, ixs, iparg)

Function/Subroutine Documentation

◆ a22conv3()

subroutine a22conv3 ( phi,
integer iflg,
integer itrimat,
integer nvar,
integer itask,
type (elbuf_struct_), dimension(ngroup), target elbuf_tab,
integer, dimension(nixs,*) ixs,
integer, dimension(nparg,*) iparg )

Definition at line 36 of file a22conv3.F.

40C-----------------------------------------------
41C D e s c r i p t i o n
42C-----------------------------------------------
43C 'alefvm' is related to a collocated scheme (built from FVM and based on Godunov scheme)
44C which was temporarily introduced for experimental option /INTER/TYPE22 (FSI coupling with cut cell method)
45C This cut cell method is not completed, abandoned, and is not an official option.
46C There is no other use for this scheme which is automatically enabled when /INTER/TYPE22 is defined (INT22>0 => IALEFVM=1).
47C
48C This subroutine is handling transportation with
49C polyhedra from cut cells
50C In cut cell buffer :
51C %PHI is the physical value
52C %dPHI is the transported quantity : can be negative for small SECONDARY cells
53C Stability of small cell issue is handled by stacking %dPHI using MAIN cell
54C and its linked SECONDARY cells.
55C
56C %UpwFLux(6,9,5) : flux on polyhedra full face
57C %Adjacent_upwFLUX : list of flux on a given polyhedra face. To be used for transportation because may be not conform
58C
59C-----------------------------------------------
60C M o d u l e s
61C-----------------------------------------------
62 USE i22tri_mod
63 USE elbufdef_mod
64 USE i22bufbric_mod
65 USE alefvm_mod , only:alefvm_param
66 USE multimat_param_mod , ONLY : m51_n0phas, m51_nvphas
67C-----------------------------------------------
68C I m p l i c i t T y p e s
69C-----------------------------------------------
70#include "implicit_f.inc"
71#include "mvsiz_p.inc"
72C-----------------------------------------------
73C D u m m y A r g u m e n t s
74C-----------------------------------------------
75 INTEGER IFLG,ITASK,NVAR, IXS(NIXS,*),IPARG(NPARG,*)
76 my_real phi(*)
77 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP), TARGET :: ELBUF_TAB
78C-----------------------------------------------
79C C o m m o n B l o c k s
80C-----------------------------------------------
81#include "com01_c.inc"
82#include "com08_c.inc"
83#include "task_c.inc"
84#include "inter22.inc"
85#include "param_c.inc"
86#include "comlock.inc"
87C-----------------------------------------------
88C L o c a l V a r i a b l e s
89C-----------------------------------------------
90 INTEGER IE, IV,J,ITRIMAT,NIN,NBF,NBL,IB,IADJ,NG,IDLOC,IBV,JV,ICELL,ICELLv,NCELL,NUM, MCELL,MLW, NADJ, LLT_
91 my_real valvois,valel,vl, dphi
92 TYPE(L_BUFEL_) , POINTER :: LBUF
93 TYPE(BUF_MAT_) , POINTER :: MBUF
94 my_real, DIMENSION(:), POINTER :: var, prho , peint
95 INTEGER :: ADD, ADD0 ,K
96 INTEGER,DIMENSION(:,:), POINTER :: pAdjBRICK
97 my_real, target :: nothing(2)
98 integer, target :: inothing(2,2)
99 LOGICAL :: debug_outp
100C-----------------------------------------------
101
102 !---------------------------------------------------------!
103 ! INITIALIZATION !
104 !---------------------------------------------------------!
105 valvois = 0
106 nin = 1
107 nbf = 1+itask*nb/nthread
108 nbl = (itask+1)*nb/nthread
109 nbl = min(nbl,nb)
110 nothing = 0
111 inothing = 0
112 var => nothing
113 prho => nothing
114 peint => nothing
115 padjbrick => inothing
116
117 !---------------------------------------------------------!
118 ! SECONDARY CELLS : GET MATERIAL BUFFER VALUE (%PHI) !
119 !---------------------------------------------------------!
120 ! ALREADY DONE IN ACONVE()
121
122 !---------------------------------------------------------!
123 ! DEBUG OUTPUT !
124 !---------------------------------------------------------!
125 !INTERFACE 22 ONLY - OUTPUT---------------!
126 debug_outp = .false.
127 if(ibug22_convec/=0)then
128 debug_outp = .false.
129 if(ibug22_convec>0)then
130 do ib=nbf,nbl
131 ie=brick_list(nin,ib)%id
132 if(ixs(11,ie)==ibug22_convec)then
133 debug_outp=.true.
134 exit
135 endif
136 enddo
137 elseif(ibug22_convec==-1)then
138 debug_outp = .true.
139 endif
140 if(((itrimat>0) .and. (ibug22_itrimat/=trimat)))debug_outp=.false.
141 if(((itrimat>0) .and. (ibug22_itrimat==-1)))debug_outp=.true.
142 endif
143
144
145
146 !---------------------------------------------------------!
147 ! CELL TRANSPORTATION (CUT CELL BUFFER) !
148 !---------------------------------------------------------!
149 DO ib=nbf,nbl
150 ie = brick_list(nin,ib)%ID
151 vl = zero
152 ncell = brick_list(nin,ib)%NBCUT
153 icell = 0
154 dphi = zero
155 mlw = brick_list(nin,ib)%MLW
156 IF(itrimat/=0 .AND. mlw/=51)cycle
157 DO WHILE (icell<=ncell) ! loop on polyhedron {1:NCELL} U {9}
158 icell = icell +1
159 IF (icell>ncell .AND. ncell/=0)icell=9
160 brick_list(nin,ib)%POLY(icell)%dPHI = zero !init
161 padjbrick => brick_list(nin,ib)%Adjacent_Brick(1:6,1:5)
162 DO j=1,6
163 nadj = brick_list(nin,ib)%POLY(icell)%FACE(j)%NAdjCell
164 DO iadj=1,nadj !plusieurs voisins possible par face.
165 iv = padjbrick(j,1)
166 ibv = padjbrick(j,4)
167 jv = padjbrick(j,5)
168 icellv = brick_list(nin,ib)%POLY(icell)%FACE(j)%Adjacent_Cell(iadj)
169 IF(iv>0)THEN
170 IF(ibv==0)THEN
171 valvois = phi(iv)
172 ELSE
173 !IBv>0
174 valvois = brick_list(nin,ibv)%POLY(icellv)%PHI
175 ENDIF
176 ELSEIF(iv==0)THEN
177 valvois = phi(ie)
178 !ELSE
179 ! VALVOIS = PHI(-IV+IOFF)
180 ENDIF
181! dPHI = dPHI + (VALVOIS * BRICK_LIST(NIN,IB)%upwFLUX(J,ICELL))
182 dphi = dphi + (valvois * brick_list(nin,ib)%POLY(icell)%FACE(j)%Adjacent_upwFLUX(iadj))
183 enddo!next IADJ
184 enddo!next J
185 valel = brick_list(nin,ib)%POLY(icell)%PHI
186 dphi = dphi + valel* brick_list(nin,ib)%POLY(icell)%Adjacent_FLU1
187 dphi = -half * dt1 * dphi
188 brick_list(nin,ib)%POLY(icell)%dPHI = dphi
189 dphi = zero
190 enddo!next ICELL
191 ENDDO
192
193 !-------------!
194 CALL my_barrier
195 !-------------!
196
197 !---------------------------------------------------------!
198 ! SECONDARY CELLS STACK !
199 !---------------------------------------------------------!
200 !STACK SECONDARY cells values from ones connected to current main cell
201 IF(int22>0)THEN
202 nin = 1
203 DO ib=nbf,nbl
204 num = brick_list(nin,ib)%SecndList%Num
205 mcell = brick_list(nin,ib)%mainID
206 dphi = zero
207 mlw = brick_list(nin,ib)%MLW
208 IF(itrimat/=0 .AND. mlw/=51)cycle
209 DO k=1,num
210 ibv = brick_list(nin,ib)%SecndList%IBV(k)
211 icellv = brick_list(nin,ib)%SecndList%ICELLv(k)
212 dphi = dphi + brick_list(nin,ibv)%POLY(icellv)%dPHI != PHI(J)
213 ENDDO
214 dphi = dphi + brick_list(nin,ib)%POLY(mcell)%dPHI
215 brick_list(nin,ib)%POLY(mcell)%dPHI = dphi
216 enddo!next IB
217 ENDIF
218
219 !---------------------------------------------------------!
220 ! MAIN CELL CONVECTION !
221 !---------------------------------------------------------!
222 DO ib=nbf,nbl
223 ie = brick_list(nin,ib)%ID
224 mlw = brick_list(nin,ib)%MLW
225 mcell = brick_list(nin,ib)%mainID
226 dphi = brick_list(nin,ib)%POLY(mcell)%dPHI
227 ng = brick_list(nin,ib)%NG
228 idloc = brick_list(nin,ib)%IDLOC
229 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(1,1,1)
230 mbuf => elbuf_tab(ng)%BUFLY(1)%MAT(1,1,1)
231 llt_ = iparg(2,ng)
232 mlw = brick_list(nin,ib)%MLW
233 IF(itrimat/=0 .AND. mlw/=51)cycle
234
235 !----------------------------!
236 ! N V A R = 1 !
237 !----------------------------!
238 IF (nvar == 1) THEN
239 IF(itrimat==0 .OR. mlw/=51)THEN
240 prho => lbuf%RHO(1:llt_)
241 ELSE
242 !USE PHASIS DATA
243 add0 = m51_n0phas + (itrimat-1)*m51_nvphas
244 add = add0 + 9 ! ADD+9 => RHO
245 k = llt_*(add-1) ! UVAR(I,ADD) = UVAR(K+I)
246 prho => mbuf%VAR(k+1:k+llt_)
247 END IF
248 var => prho
249 !----------------------------!
250 ! N V A R = 2 !
251 !----------------------------!
252 ELSEIF (nvar == 2) THEN
253 IF(itrimat==0 .OR. mlw/=51)THEN
254 peint=> lbuf%EINT(1:llt_)
255 ELSE
256 !USE PHASIS DATA
257 add0 = m51_n0phas + (itrimat-1)*m51_nvphas
258 add = add0 + 8 ! ADD+9 => RHO
259 k = llt_*(add-1) ! UVAR(I,ADD) = UVAR(K+I)
260 peint => mbuf%VAR(k+1:k+llt_)
261 END IF
262 var => peint
263 !----------------------------!
264 ! N V A R = 3 !
265 !----------------------------!
266 ELSEIF (nvar == 3) THEN
267 var => elbuf_tab(ng)%BUFLY(1)%LBUF(1,1,1)%RK(1:llt_)
268 !----------------------------!
269 ! N V A R = 4 !
270 !----------------------------!
271 ELSEIF (nvar == 4) THEN
272 var => elbuf_tab(ng)%BUFLY(1)%LBUF(1,1,1)%RE(1:llt_)
273 !----------------------------!
274 ! N V A R = 5 !
275 !----------------------------!
276 ELSEIF (nvar == 5) THEN
277 var => elbuf_tab(ng)%BUFLY(1)%MAT(1,1,1)%VAR(1:llt_)
278 !----------------------------!
279 ! N V A R = 6 !
280 !----------------------------!
281 ELSEIF (nvar == 6) THEN
282 IF(alefvm_param%IEnabled>0)THEN
283 var => elbuf_tab(ng)%GBUF%MOM( 1 : llt_ )
284 ENDIF
285 !----------------------------!
286 ! N V A R = 7 !
287 !----------------------------!
288 ELSEIF (nvar == 7) THEN
289 IF(alefvm_param%IEnabled>0)THEN
290 var => elbuf_tab(ng)%GBUF%MOM( llt_*1+1 : llt_*1+llt_ )
291 ENDIF
292 !----------------------------!
293 ! N V A R = 8 !
294 !----------------------------!
295 ELSEIF (nvar == 8) THEN
296 IF(alefvm_param%IEnabled>0)THEN
297 var => elbuf_tab(ng)%GBUF%MOM( llt_*2+1 : llt_*2+llt_ )
298 ENDIF
299 !----------------------------!
300 ! N V A R = 9 !
301 !----------------------------!
302 ELSEIF (nvar == 9) THEN
303 !
304 ENDIF
305 !----------------------------!
306 ! TRANSPORTS CONVECTIFS !
307 !----------------------------!
308 IF(mlw/=51.AND.itrimat>0)THEN !si law51 dans jdd TRIMAT=4
309 cycle
310 ELSE
311 var(idloc) = var(idloc) + dphi !transport convectif des voisins additionels
312
313
314 ENDIF
315
316 enddo!next IB
317
318
319
320 !INTERFACE 22 ONLY------------------------!
321
322 !INTERFACE 22 ONLY------------------------!
323 if(debug_outp .AND. nvar==ibug22_nvar)then
324 call my_barrier
325 if(itask==0)then
326 print *, " |--------a22conv3.F--------|"
327 print *, " | THREAD INFORMATION |"
328 print *, " |--------------------------|"
329 print *, " NCYCLE =", ncycle
330 print *, " ITRIMAT =", itrimat
331 do ib=1,nb
332 ie = brick_list(nin,ib)%ID
333 mlw = brick_list(nin,ib)%MLW
334 mcell = brick_list(nin,ib)%mainID
335 dphi = brick_list(nin,ib)%POLY(mcell)%dPHI
336 ng = brick_list(nin,ib)%NG
337 idloc = brick_list(nin,ib)%IDLOC
338 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(1,1,1)
339 mbuf => elbuf_tab(ng)%BUFLY(1)%MAT(1,1,1)
340 llt_ = iparg(2,ng)
341 if(itrimat>0 .and. mlw/=51)cycle
342 ie = brick_list(nin,ib)%id
343 IF(itrimat==0)THEN
344 prho => lbuf%RHO(1:llt_)
345 ELSE
346 !USE PHASIS DATA
347 add0 = m51_n0phas + (itrimat-1)*m51_nvphas
348 add = add0 + 9 ! ADD+9 => RHO
349 k = llt_*(add-1) ! UVAR(I,ADD) = UVAR(K+I)
350 prho => mbuf%VAR(k+1:k+llt_)
351 END IF
352 if(ibug22_convec > 0 .and. brick_list(nin,ib)%id==ibug22_convec )cycle
353 if(nvar==1)then
354 var => prho
355 else
356 var => peint
357 endif
358 print *, " brique=", ixs(11,ie)
359 print *, " NVAR=", nvar
360 print *, " dval=", dphi
361 print *, " was:", var(idloc)-dphi
362 print *, " is:", var(idloc)
363 print *, " MLW:", mlw
364 print *, " ------------------------"
365 enddo
366 endif
367 endif
368
369 !-----------------------------------------!
370
371
372 !----------------------------!
373 ! MOMENTUM DATA !
374 !----------------------------!
375 IF(trimat>0.AND.iflg==1)THEN
376 !A TRAITER
377 !QMV(6,I) = QMV(6,I) - VL(6,I) - VALEL(I)*QMV(12,I)
378 ENDIF
379C-----------
380 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
min
#define min(a, b)
Definition macros.h:20
alefvm_mod
Definition alefvm_mod.F:88
alefvm_mod::alefvm_param
type(alefvm_param_), target alefvm_param
Definition alefvm_mod.F:121
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_nvar
integer ibug22_nvar
Definition cut-cell-search_mod.F:388
i22tri_mod::ibug22_convec
integer ibug22_convec
Definition cut-cell-search_mod.F:261
i22tri_mod::ibug22_itrimat
integer ibug22_itrimat
Definition cut-cell-search_mod.F:393
nvar
integer function nvar(text)
Definition nvar.F:32
my_barrier
subroutine my_barrier
Definition machine.F:31