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