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 37 of file a22conv3.F.

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