OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
aflux3.F File Reference
#include "implicit_f.inc"
#include "mvsiz_p.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "vect01_c.inc"
#include "param_c.inc"
#include "parit_c.inc"
#include "inter22.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine aflux3 (pm, ixs, v, w, x, flux, flu1, ale_connect, nsg, tag22)

Function/Subroutine Documentation

◆ aflux3()

subroutine aflux3 ( pm,
integer, dimension(nixs,numels) ixs,
v,
w,
x,
flux,
flu1,
type(t_ale_connectivity), intent(in) ale_connect,
integer nsg,
tag22 )

Definition at line 32 of file aflux3.F.

33C-----------------------------------------------
34C M o d u l e s
35C-----------------------------------------------
38 use element_mod , only : nixs
39C-----------------------------------------------
40C I m p l i c i t T y p e s
41C-----------------------------------------------
42#include "implicit_f.inc"
43C-----------------------------------------------
44C G l o b a l P a r a m e t e r s
45C-----------------------------------------------
46#include "mvsiz_p.inc"
47C-----------------------------------------------
48C C o m m o n B l o c k s
49C-----------------------------------------------
50#include "com01_c.inc"
51#include "com04_c.inc"
52#include "vect01_c.inc"
53#include "param_c.inc"
54#include "parit_c.inc"
55#include "inter22.inc"
56C-----------------------------------------------
57C D u m m y A r g u m e n t s
58C-----------------------------------------------
59 INTEGER IXS(NIXS,NUMELS), NSG
60 my_real pm(npropm,nummat), v(3,numnod), w(3,numnod), x(3,numnod), flux(6,*), flu1(*)
61 TYPE(t_ale_connectivity), INTENT(IN) :: ALE_CONNECT
62C-----------------------------------------------
63C L o c a l V a r i a b l e s
64C-----------------------------------------------
65 INTEGER MAT(MVSIZ),
66 . NC1(MVSIZ), NC2(MVSIZ), NC3(MVSIZ), NC4(MVSIZ),
67 . NC5(MVSIZ), NC6(MVSIZ), NC7(MVSIZ), NC8(MVSIZ),
68 . I,II
69
71 . x1(mvsiz), x2(mvsiz), x3(mvsiz), x4(mvsiz),
72 . x5(mvsiz), x6(mvsiz), x7(mvsiz), x8(mvsiz),
73 . y1(mvsiz), y2(mvsiz), y3(mvsiz), y4(mvsiz),
74 . y5(mvsiz), y6(mvsiz), y7(mvsiz), y8(mvsiz),
75 . z1(mvsiz), z2(mvsiz), z3(mvsiz), z4(mvsiz),
76 . z5(mvsiz), z6(mvsiz), z7(mvsiz), z8(mvsiz),
77 . n1x(mvsiz),n1y(mvsiz),n1z(mvsiz),
78 . n2x(mvsiz),n2y(mvsiz),n2z(mvsiz),
79 . n3x(mvsiz),n3y(mvsiz),n3z(mvsiz),
80 . n4x(mvsiz),n4y(mvsiz),n4z(mvsiz),
81 . n5x(mvsiz),n5y(mvsiz),n5z(mvsiz),
82 . n6x(mvsiz),n6y(mvsiz),n6z(mvsiz),
83 . flux1(mvsiz), flux2(mvsiz), flux3(mvsiz),
84 . flux4(mvsiz), flux5(mvsiz), flux6(mvsiz),
85 . vx1(mvsiz), vx2(mvsiz), vx3(mvsiz),
86 . vx4(mvsiz), vx5(mvsiz), vx6(mvsiz),
87 . vy1(mvsiz), vy2(mvsiz), vy3(mvsiz),
88 . vy4(mvsiz), vy5(mvsiz), vy6(mvsiz),
89 . vz1(mvsiz), vz2(mvsiz), vz3(mvsiz),
90 . vz4(mvsiz), vz5(mvsiz), vz6(mvsiz),
91 . vdx1(mvsiz), vdx2(mvsiz), vdx3(mvsiz), vdx4(mvsiz),
92 . vdx5(mvsiz), vdx6(mvsiz), vdx7(mvsiz), vdx8(mvsiz),
93 . vdy1(mvsiz), vdy2(mvsiz), vdy3(mvsiz), vdy4(mvsiz),
94 . vdy5(mvsiz), vdy6(mvsiz), vdy7(mvsiz), vdy8(mvsiz),
95 . vdz1(mvsiz), vdz2(mvsiz), vdz3(mvsiz), vdz4(mvsiz),
96 . vdz5(mvsiz), vdz6(mvsiz), vdz7(mvsiz), vdz8(mvsiz),
97 . reduc,upwl(6,mvsiz),
98 . xc(mvsiz),yc(mvsiz),zc(mvsiz),
99 . xf1(mvsiz),yf1(mvsiz),zf1(mvsiz),
100 . xf2(mvsiz),yf2(mvsiz),zf2(mvsiz),
101 . xf3(mvsiz),yf3(mvsiz),zf3(mvsiz),
102 . xf4(mvsiz),yf4(mvsiz),zf4(mvsiz),
103 . xf5(mvsiz),yf5(mvsiz),zf5(mvsiz),
104 . xf6(mvsiz),yf6(mvsiz),zf6(mvsiz),
105 . test
106
107 INTEGER,DIMENSION(:), POINTER :: pIsMain
108
109 my_real :: tag22(mvsiz), ratioface(6)
110
111 my_real,DIMENSION(:), POINTER :: pface !=> BRICK_LIST%POLY()%FACE()%Surf ! WARNING : all pointers begin with 1 not 0
112 my_real,DIMENSION(:) , POINTER :: pfullface
113
114 INTEGER MA,IC,JST(MVSIZ+1)
115 INTEGER MCELL,IB, NIN, NBCUT, IAD2
116C-----------------------------------------------
117C S o u r c e L i n e s
118C-----------------------------------------------
119 !======================================================!
120 ! INITIALIZATION : COORDINATES & RELATIVE VELOCITIES !
121 !======================================================!
122 DO i=lft,llt
123 ii=i+nft
124 mat(i)=ixs(1,ii)
125 !---8 local node numbers NC1 TO NC8 for solid element I ---!
126 nc1(i)=ixs(2,ii)
127 nc2(i)=ixs(3,ii)
128 nc3(i)=ixs(4,ii)
129 nc4(i)=ixs(5,ii)
130 nc5(i)=ixs(6,ii)
131 nc6(i)=ixs(7,ii)
132 nc7(i)=ixs(8,ii)
133 nc8(i)=ixs(9,ii)
134 !
135 !---Coordinates of the 8 nodes
136 x1(i)=x(1,nc1(i))
137 y1(i)=x(2,nc1(i))
138 z1(i)=x(3,nc1(i))
139 !
140 x2(i)=x(1,nc2(i))
141 y2(i)=x(2,nc2(i))
142 z2(i)=x(3,nc2(i))
143 !
144 x3(i)=x(1,nc3(i))
145 y3(i)=x(2,nc3(i))
146 z3(i)=x(3,nc3(i))
147 !
148 x4(i)=x(1,nc4(i))
149 y4(i)=x(2,nc4(i))
150 z4(i)=x(3,nc4(i))
151 !
152 x5(i)=x(1,nc5(i))
153 y5(i)=x(2,nc5(i))
154 z5(i)=x(3,nc5(i))
155 !
156 x6(i)=x(1,nc6(i))
157 y6(i)=x(2,nc6(i))
158 z6(i)=x(3,nc6(i))
159 !
160 x7(i)=x(1,nc7(i))
161 y7(i)=x(2,nc7(i))
162 z7(i)=x(3,nc7(i))
163 !
164 x8(i)=x(1,nc8(i))
165 y8(i)=x(2,nc8(i))
166 z8(i)=x(3,nc8(i))
167 !
168 !Relative velocity on the 8 nodes.
169 ! [VD_node] = [V_node] - [W_node]
170 ! where
171 ! [V_node] : material velocity on node
172 ! [W_node] : grid velocity on node
173 !
174 vdx1(i)=v(1,nc1(i)) - w(1,nc1(i))
175 vdy1(i)=v(2,nc1(i)) - w(2,nc1(i))
176 vdz1(i)=v(3,nc1(i)) - w(3,nc1(i))
177 !
178 vdx2(i)=v(1,nc2(i)) - w(1,nc2(i))
179 vdy2(i)=v(2,nc2(i)) - w(2,nc2(i))
180 vdz2(i)=v(3,nc2(i)) - w(3,nc2(i))
181 !
182 vdx3(i)=v(1,nc3(i)) - w(1,nc3(i))
183 vdy3(i)=v(2,nc3(i)) - w(2,nc3(i))
184 vdz3(i)=v(3,nc3(i)) - w(3,nc3(i))
185 !
186 vdx4(i)=v(1,nc4(i)) - w(1,nc4(i))
187 vdy4(i)=v(2,nc4(i)) - w(2,nc4(i))
188 vdz4(i)=v(3,nc4(i)) - w(3,nc4(i))
189 !
190 vdx5(i)=v(1,nc5(i)) - w(1,nc5(i))
191 vdy5(i)=v(2,nc5(i)) - w(2,nc5(i))
192 vdz5(i)=v(3,nc5(i)) - w(3,nc5(i))
193 !
194 vdx6(i)=v(1,nc6(i)) - w(1,nc6(i))
195 vdy6(i)=v(2,nc6(i)) - w(2,nc6(i))
196 vdz6(i)=v(3,nc6(i)) - w(3,nc6(i))
197 !
198 vdx7(i)=v(1,nc7(i)) - w(1,nc7(i))
199 vdy7(i)=v(2,nc7(i)) - w(2,nc7(i))
200 vdz7(i)=v(3,nc7(i)) - w(3,nc7(i))
201 !
202 vdx8(i)=v(1,nc8(i)) - w(1,nc8(i))
203 vdy8(i)=v(2,nc8(i)) - w(2,nc8(i))
204 vdz8(i)=v(3,nc8(i)) - w(3,nc8(i))
205 END DO
206
207 !======================================================!
208 ! RELATIVE VELOCITIES ON EACH FACE !
209 ! [V_face] = 1/4 Sum([V_node]) !
210 ! Results are divided by 2 at this step : !
211 ! [0.5*V_face] = 1/8 Sum([V_node]) !
212 !======================================================!
213 DO i=lft,llt
214 ! X-component
215 vx1(i)=one_over_8*(vdx1(i)+vdx2(i)+vdx3(i)+vdx4(i))
216 vx2(i)=one_over_8*(vdx3(i)+vdx4(i)+vdx8(i)+vdx7(i))
217 vx3(i)=one_over_8*(vdx5(i)+vdx6(i)+vdx7(i)+vdx8(i))
218 vx4(i)=one_over_8*(vdx1(i)+vdx2(i)+vdx6(i)+vdx5(i))
219 vx5(i)=one_over_8*(vdx2(i)+vdx3(i)+vdx7(i)+vdx6(i))
220 vx6(i)=one_over_8*(vdx1(i)+vdx4(i)+vdx8(i)+vdx5(i))
221 ! Y-component
222 vy1(i)=one_over_8*(vdy1(i)+vdy2(i)+vdy3(i)+vdy4(i))
223 vy2(i)=one_over_8*(vdy3(i)+vdy4(i)+vdy8(i)+vdy7(i))
224 vy3(i)=one_over_8*(vdy5(i)+vdy6(i)+vdy7(i)+vdy8(i))
225 vy4(i)=one_over_8*(vdy1(i)+vdy2(i)+vdy6(i)+vdy5(i))
226 vy5(i)=one_over_8*(vdy2(i)+vdy3(i)+vdy7(i)+vdy6(i))
227 vy6(i)=one_over_8*(vdy1(i)+vdy4(i)+vdy8(i)+vdy5(i))
228 ! Z-component
229 vz1(i)=one_over_8*(vdz1(i)+vdz2(i)+vdz3(i)+vdz4(i))
230 vz2(i)=one_over_8*(vdz3(i)+vdz4(i)+vdz8(i)+vdz7(i))
231 vz3(i)=one_over_8*(vdz5(i)+vdz6(i)+vdz7(i)+vdz8(i))
232 vz4(i)=one_over_8*(vdz1(i)+vdz2(i)+vdz6(i)+vdz5(i))
233 vz5(i)=one_over_8*(vdz2(i)+vdz3(i)+vdz7(i)+vdz6(i))
234 vz6(i)=one_over_8*(vdz1(i)+vdz4(i)+vdz8(i)+vdz5(i))
235 END DO
236
237 !======================================================!
238 ! NORMAL VECTORS ON EACH DACE !
239 ! 2S[n] = [diag1] x [diag2] !
240 ! where !
241 ! [n] : unitary normal vector on face !
242 !======================================================!
243 DO i=lft,llt
244 ! face-1
245 n1x(i)=(y3(i)-y1(i))*(z2(i)-z4(i)) - (z3(i)-z1(i))*(y2(i)-y4(i))
246 n1y(i)=(z3(i)-z1(i))*(x2(i)-x4(i)) - (x3(i)-x1(i))*(z2(i)-z4(i))
247 n1z(i)=(x3(i)-x1(i))*(y2(i)-y4(i)) - (y3(i)-y1(i))*(x2(i)-x4(i))
248 ! Face-2
249 n2x(i)=(y7(i)-y4(i))*(z3(i)-z8(i)) - (z7(i)-z4(i))*(y3(i)-y8(i))
250 n2y(i)=(z7(i)-z4(i))*(x3(i)-x8(i)) - (x7(i)-x4(i))*(z3(i)-z8(i))
251 n2z(i)=(x7(i)-x4(i))*(y3(i)-y8(i)) - (y7(i)-y4(i))*(x3(i)-x8(i))
252 ! Face-3
253 n3x(i)=(y6(i)-y8(i))*(z7(i)-z5(i)) - (z6(i)-z8(i))*(y7(i)-y5(i))
254 n3y(i)=(z6(i)-z8(i))*(x7(i)-x5(i)) - (x6(i)-x8(i))*(z7(i)-z5(i))
255 n3z(i)=(x6(i)-x8(i))*(y7(i)-y5(i)) - (y6(i)-y8(i))*(x7(i)-x5(i))
256 ! Face-4
257 n4x(i)=(y2(i)-y5(i))*(z6(i)-z1(i)) - (z2(i)-z5(i))*(y6(i)-y1(i))
258 n4y(i)=(z2(i)-z5(i))*(x6(i)-x1(i)) - (x2(i)-x5(i))*(z6(i)-z1(i))
259 n4z(i)=(x2(i)-x5(i))*(y6(i)-y1(i)) - (y2(i)-y5(i))*(x6(i)-x1(i))
260 ! Face-5
261 n5x(i)=(y7(i)-y2(i))*(z6(i)-z3(i)) - (z7(i)-z2(i))*(y6(i)-y3(i))
262 n5y(i)=(z7(i)-z2(i))*(x6(i)-x3(i)) - (x7(i)-x2(i))*(z6(i)-z3(i))
263 n5z(i)=(x7(i)-x2(i))*(y6(i)-y3(i)) - (y7(i)-y2(i))*(x6(i)-x3(i))
264 ! Face-6
265 n6x(i)=(y8(i)-y1(i))*(z4(i)-z5(i)) - (z8(i)-z1(i))*(y4(i)-y5(i))
266 n6y(i)=(z8(i)-z1(i))*(x4(i)-x5(i)) - (x8(i)-x1(i))*(z4(i)-z5(i))
267 n6z(i)=(x8(i)-x1(i))*(y4(i)-y5(i)) - (y8(i)-y1(i))*(x4(i)-x5(i))
268 END DO
269
270 !======================================================!
271 ! ELEMENT CLOSURE TEST !
272 ! (If at least there is one domain with closure) !
273 ! 2S [CF].[n] = 0 => [2S*n] = 0 !
274 ! where !
275 ! C: controid element !
276 ! F: face centroid !
277 !======================================================!
278 IF(iclose == 1) THEN
279 DO i=lft,llt
280 ! Solid Element Centorid
281 xc(i)=one_over_8*(x1(i)+x2(i)+x3(i)+x4(i)+x5(i)+x6(i)+x7(i)+x8(i))
282 yc(i)=one_over_8*(y1(i)+y2(i)+y3(i)+y4(i)+y5(i)+y6(i)+y7(i)+y8(i))
283 zc(i)=one_over_8*(z1(i)+z2(i)+z3(i)+z4(i)+z5(i)+z6(i)+z7(i)+z8(i))
284 ! Solid faces centoids
285 ! X-Components
286 xf1(i)=fourth*(x1(i)+x2(i)+x3(i)+x4(i))
287 xf2(i)=fourth*(x3(i)+x4(i)+x8(i)+x7(i))
288 xf3(i)=fourth*(x5(i)+x6(i)+x7(i)+x8(i))
289 xf4(i)=fourth*(x1(i)+x2(i)+x6(i)+x5(i))
290 xf5(i)=fourth*(x2(i)+x3(i)+x7(i)+x6(i))
291 xf6(i)=fourth*(x1(i)+x4(i)+x8(i)+x5(i))
292 ! Y-component
293 yf1(i)=fourth*(y1(i)+y2(i)+y3(i)+y4(i))
294 yf2(i)=fourth*(y3(i)+y4(i)+y8(i)+y7(i))
295 yf3(i)=fourth*(y5(i)+y6(i)+y7(i)+y8(i))
296 yf4(i)=fourth*(y1(i)+y2(i)+y6(i)+y5(i))
297 yf5(i)=fourth*(y2(i)+y3(i)+y7(i)+y6(i))
298 yf6(i)=fourth*(y1(i)+y4(i)+y8(i)+y5(i))
299 ! Component
300 zf1(i)=fourth*(z1(i)+z2(i)+z3(i)+z4(i))
301 zf2(i)=fourth*(z3(i)+z4(i)+z8(i)+z7(i))
302 zf3(i)=fourth*(z5(i)+z6(i)+z7(i)+z8(i))
303 zf4(i)=fourth*(z1(i)+z2(i)+z6(i)+z5(i))
304 zf5(i)=fourth*(z2(i)+z3(i)+z7(i)+z6(i))
305 zf6(i)=fourth*(z1(i)+z4(i)+z8(i)+z5(i))
306 ENDDO
307 ! Face-1
308 DO i=lft,llt
309 test=(xf1(i)-xc(i))*n1x(i)+
310 . (yf1(i)-yc(i))*n1y(i)+
311 . (zf1(i)-zc(i))*n1z(i)
312 IF(test <= 0)THEN
313 n1x(i)=zero
314 n1y(i)=zero
315 n1z(i)=zero
316 ENDIF
317 ENDDO
318 ! Face-2
319 DO i=lft,llt
320 test=(xf2(i)-xc(i))*n2x(i)+
321 . (yf2(i)-yc(i))*n2y(i)+
322 . (zf2(i)-zc(i))*n2z(i)
323 IF(test <= 0)THEN
324 n2x(i)=zero
325 n2y(i)=zero
326 n2z(i)=zero
327 ENDIF
328 ENDDO
329 ! Face-3
330 DO i=lft,llt
331 test=(xf3(i)-xc(i))*n3x(i)+
332 . (yf3(i)-yc(i))*n3y(i)+
333 . (zf3(i)-zc(i))*n3z(i)
334 IF(test <= 0)THEN
335 n3x(i)=zero
336 n3y(i)=zero
337 n3z(i)=zero
338 ENDIF
339 ENDDO
340 ! Face-4
341 DO i=lft,llt
342 test=(xf4(i)-xc(i))*n4x(i)+
343 . (yf4(i)-yc(i))*n4y(i)+
344 . (zf4(i)-zc(i))*n4z(i)
345 IF(test <= zero)THEN
346 n4x(i)=zero
347 n4y(i)=zero
348 n4z(i)=zero
349 ENDIF
350 ENDDO
351 ! Face-5
352 DO i=lft,llt
353 test=(xf5(i)-xc(i))*n5x(i)+
354 . (yf5(i)-yc(i))*n5y(i)+
355 . (zf5(i)-zc(i))*n5z(i)
356 IF(test <= zero)THEN
357 n5x(i)=zero
358 n5y(i)=zero
359 n5z(i)=zero
360 ENDIF
361 ENDDO
362 ! Face-6
363 DO i=lft,llt
364 test=(xf6(i)-xc(i))*n6x(i)+
365 . (yf6(i)-yc(i))*n6y(i)+
366 . (zf6(i)-zc(i))*n6z(i)
367 IF(test <= zero)THEN
368 n6x(i)=zero
369 n6y(i)=zero
370 n6z(i)=zero
371 ENDIF
372 ENDDO
373 ENDIF
374
375 !======================================================!
376 ! FLUXES CALCULATION ON EACH FACE !
377 ! FLUX_face = [V_face].[n] !
378 ! = [0.5*V_face] . [2S*n] !
379 !======================================================!
380 DO i=lft,llt
381 flux1(i)=(vx1(i)*n1x(i)+vy1(i)*n1y(i)+vz1(i)*n1z(i))
382 flux2(i)=(vx2(i)*n2x(i)+vy2(i)*n2y(i)+vz2(i)*n2z(i))
383 flux3(i)=(vx3(i)*n3x(i)+vy3(i)*n3y(i)+vz3(i)*n3z(i))
384 flux4(i)=(vx4(i)*n4x(i)+vy4(i)*n4y(i)+vz4(i)*n4z(i))
385 flux5(i)=(vx5(i)*n5x(i)+vy5(i)*n5y(i)+vz5(i)*n5z(i))
386 flux6(i)=(vx6(i)*n6x(i)+vy6(i)*n6y(i)+vz6(i)*n6z(i))
387 END DO
388
389 !======================================================!
390 ! REDUCTION FACTOR FOR POLYHEDRA FACES !
391 ! interface type22 (cut cell method) !
392 !======================================================!
393 IF(int22 > 0)THEN
394 print *, "**inter22, CURRENTLY EULERIAN ONLY"
395 stop 2204
396 nin = 1
397 DO i=lft,llt
398 ib = nint(tag22(i)) !GBUF%TAG22
399 IF(ib > 0)THEN
400 nbcut = brick_list(nin,ib)%NBCUT
401 IF(nbcut==0)cycle
402 mcell = brick_list(nin,ib)%mainID
403 pface => brick_list(nin,ib)%POLY(mcell)%FACE(1:6)%Surf
404 pismain => brick_list(nin,ib)%POLY(1:9)%IsMain
405 IF(mcell == 0) cycle
406 pfullface => brick_list(nin,ib)%Face_Brick(1:6)
407 ratioface(1) = pface(1) / pfullface(1)
408 ratioface(2) = pface(2) / pfullface(2)
409 ratioface(3) = pface(3) / pfullface(3)
410 ratioface(4) = pface(4) / pfullface(4)
411 ratioface(5) = pface(5) / pfullface(5)
412 ratioface(6) = pface(6) / pfullface(6)
413 flux1(i) = ratioface(1) * flux1(i)
414 flux2(i) = ratioface(2) * flux2(i)
415 flux3(i) = ratioface(3) * flux3(i)
416 flux4(i) = ratioface(4) * flux4(i)
417 flux5(i) = ratioface(5) * flux5(i)
418 flux6(i) = ratioface(6) * flux6(i)
419 ENDIF
420 enddo!next IB
421 ENDIF
422
423 !======================================================!
424 ! TRIMATERIAL CASE INITIALIZATION (LAW51) !
425 ! -->RETURN !
426 !======================================================!
427 IF(nint(pm(19,mat(1))) == 51)THEN
428 DO i=lft,llt
429 flux(1,i)=flux1(i)
430 flux(2,i)=flux2(i)
431 flux(3,i)=flux3(i)
432 flux(4,i)=flux4(i)
433 flux(5,i)=flux5(i)
434 flux(6,i)=flux6(i)
435 ENDDO
436 RETURN
437 ENDIF
438
439 !======================================================!
440 ! UPWIND TREATMENT !
441 ! reading coefficient for mass transportation UPWL !
442 !======================================================!
443 IF (nsg == 1) THEN
444 ma = mat(1)
445 DO i=lft,llt
446 upwl(1,i)=pm(16,ma)
447 upwl(2,i)=pm(16,ma)
448 upwl(3,i)=pm(16,ma)
449 upwl(4,i)=pm(16,ma)
450 upwl(5,i)=pm(16,ma)
451 upwl(6,i)=pm(16,ma)
452 ENDDO
453 ELSE
454 IF (ivector == 0) THEN
455 DO i=lft,llt
456 upwl(1,i)=pm(16,mat(i))
457 upwl(2,i)=pm(16,mat(i))
458 upwl(3,i)=pm(16,mat(i))
459 upwl(4,i)=pm(16,mat(i))
460 upwl(5,i)=pm(16,mat(i))
461 upwl(6,i)=pm(16,mat(i))
462 ENDDO
463 ELSE
464 ic=1
465 jst(ic)=lft
466 DO i=lft+1,llt
467 IF(mat(i) /= mat(i-1)) THEN
468 ic = ic+1
469 jst(ic)=i
470 ENDIF
471 ENDDO
472 jst(ic+1)=llt+1
473 DO ii=1,ic
474 ma = mat(ii)
475 DO i=jst(ii),jst(ii+1)-1
476 upwl(1,i)=pm(16,ma)
477 upwl(2,i)=pm(16,ma)
478 upwl(3,i)=pm(16,ma)
479 upwl(4,i)=pm(16,ma)
480 upwl(5,i)=pm(16,ma)
481 upwl(6,i)=pm(16,ma)
482 ENDDO
483 ENDDO
484 ENDIF
485 ENDIF
486
487 !======================================================!
488 ! BOUNDARY FACE : no volume flux by default !
489 ! slip wall bc !
490 !======================================================!
491 DO i=lft,llt
492 iad2 = ale_connect%ee_connect%iad_connect(i + nft)
493 ! Face1-neighbor check
494 reduc=pm(92,mat(i))
495 ii = ale_connect%ee_connect%connected(iad2 + 1 - 1)
496 IF(ii == 0)THEN
497 flux1(i)=flux1(i)*reduc
498 ENDIF
499 ! Face2-neighbor check
500 ii = ale_connect%ee_connect%connected(iad2 + 2 - 1)
501 IF(ii == 0)THEN
502 flux2(i)=flux2(i)*reduc
503 ENDIF
504 ! Face3-neighbor check
505 ii = ale_connect%ee_connect%connected(iad2 + 3 - 1)
506 IF(ii == 0)THEN
507 flux3(i)=flux3(i)*reduc
508 ENDIF
509 ! Face4-neighbor check
510 ii = ale_connect%ee_connect%connected(iad2 + 4 - 1)
511 IF(ii == 0)THEN
512 flux4(i)=flux4(i)*reduc
513 ENDIF
514 ! Face5-neighbor check
515 ii = ale_connect%ee_connect%connected(iad2 + 5 - 1)
516 IF(ii == 0)THEN
517 flux5(i)=flux5(i)*reduc
518 ENDIF
519 ! Face6-neighbor check
520 ii = ale_connect%ee_connect%connected(iad2 + 6 - 1)
521 IF(ii == 0)THEN
522 flux6(i)=flux6(i)*reduc
523 ENDIF
524 END DO !I=LFT,LLT
525
526 !==========================================================!
527 ! FLUXES OUTPUT !
528 ! FLUX_face = (1-sgn*UPWL)*FLUX_face !
529 ! FLUX_global = SUM (1+sgn*UPWL)*FLUX_face !
530 ! where !
531 ! UPWL : upwind factor for mass transportation !
532 ! sgn : sgn(FLUX_face) !
533 !==========================================================!
534 DO i=lft,llt
535 ! 6 flows we faces
536 flux(1,i)=flux1(i)-upwl(1,i)*abs(flux1(i))
537 flux(2,i)=flux2(i)-upwl(2,i)*abs(flux2(i))
538 flux(3,i)=flux3(i)-upwl(3,i)*abs(flux3(i))
539 flux(4,i)=flux4(i)-upwl(4,i)*abs(flux4(i))
540 flux(5,i)=flux5(i)-upwl(5,i)*abs(flux5(i))
541 flux(6,i)=flux6(i)-upwl(6,i)*abs(flux6(i))
542 ! One global flux
543 flu1(i) =flux1(i)+upwl(1,i)*abs(flux1(i))
544 . +flux2(i)+upwl(2,i)*abs(flux2(i))
545 . +flux3(i)+upwl(3,i)*abs(flux3(i))
546 . +flux4(i)+upwl(4,i)*abs(flux4(i))
547 . +flux5(i)+upwl(5,i)*abs(flux5(i))
548 . +flux6(i)+upwl(6,i)*abs(flux6(i))
549 END DO
550C-----------------------------------------------
551 RETURN
#define my_real
Definition cppsort.cpp:32
type(brick_entity), dimension(:,:), allocatable, target brick_list