38
39
40
41
42
43
44
45
46
47
53 use element_mod , only : nixs
54
55
56
57#include "implicit_f.inc"
58
59
60
61#include "mvsiz_p.inc"
62
63
64
65#include "spmd_c.inc"
66#include "com01_c.inc"
67#include "com04_c.inc"
68#include "com08_c.inc"
69#include "vect01_c.inc"
70#include "inter22.inc"
71
72
73
74 INTEGER IXS(NIXS,NUMELS),N4_VOIS(NUMELS+NSVOIS,8),ITAB(),NV46,ITRIMAT
75 my_real flux(nv46,*),alph(*),vol(*),flux_vois(numels+nsvois,nv46)
76 TYPE(t_segvar),INTENT(IN) :: SEGVAR
77 TYPE(t_ale_connectivity), INTENT(IN) :: ALE_CONNECT
78
79
80
81 INTEGER I,J,II,K,JV(),KV(NV46),IFV,NIN, ib, ie,ISKIP(MVSIZ),IEV,IAD2, IAD3
82 my_real vol0,av0,uav0,alphi,ualphi,aaa,ff(nv46),udt,phi0,facev
84 LOGICAL :: debug_outp
85
86
87
88
89
90
91
92 IF(dt1 > zero)THEN
93 udt = one/dt1
94 ELSE
95 udt = zero
96 ENDIF
97
98
99 nin = 1
100
101
102 debug_outp = .false.
103 if(int22>0)then
105 debug_outp = .false.
107 do i=lft,llt
108 ie=i+nft
110 debug_outp=.true.
111 exit
112 endif
113 enddo
115 debug_outp = .true.
116 endif
118 endif
119 if(debug_outp)then
120 print *, " |----ale51_antidiff3.F-----|"
121 print *, " | THREAD INFORMATION |"
122 print *, " |--------------------------|"
123 print *, " NCYCLE =", ncycle
124 print *, " ITRIMAT =", itrimat
125 endif
126 endif
127
128
129 nin = 1
130 iskip(1:mvsiz) = zero
131 IF(int22>0)THEN
132 DO i=lft,llt
133 ib=iiad22(nin,i+nft)
134 IF(ib /= 0)iskip(i)=1
135 ENDDO
136 ENDIF
137
138 DO i=lft,llt
139 IF(iskip(i)==1)cycle
140 ii = i + nft
141 iad2 = ale_connect%ee_connect%iad_connect(ii)
142 vol0 = vol(i)*udt
143 av0 = alph(ii) * vol0
144 uav0 = vol0 - av0
145 alphi = zero
146 ualphi = zero
147 phi0 = zero
148
149
150
151
152 DO k=1,nv46
153 IF(flux(k,ii) > zero)THEN
154 jv(k) = ale_connect%ee_connect%connected(iad2 + k - 1)
155 kv(k) = k
156 IF(jv(k) == 0)THEN
157 jv(k) = ii
158 ff(k) = alph(ii)*flux(k,ii)
159 ELSEIF(jv(k) < 0)THEN
160
161 ff(k) = segvar%PHASE_ALPHA(itrimat,-jv(k)) * flux(k,ii)
162 ELSEIF(jv(k) <= numels)THEN
163 iad3 = ale_connect%ee_connect%iad_connect(jv(k))
164 DO j=1,nv46
165 IF(ale_connect%ee_connect%connected(iad3 + j - 1) == ii) kv(k) = j
166 ENDDO
167 ff(k) = alph(jv(k))*flux(k,ii)
168 ELSE
169
170 ff(k) = alph(jv(k))*flux(k,ii)
171 ENDIF
172
173 alphi = alphi + ff(k)
174
175 phi0 = phi0 + flux(k,ii)
176 ENDIF
177 ENDDO
178
179 ualphi = phi0 - alphi
180
181
182
183 IF(alphi > av0.AND.av0 > zero)THEN
184
185
186
187 aaa = av0 / alphi
188 DO k=1,nv46
189 IF(flux(k,ii) > zero)THEN
190 ff(k) = ff(k) * aaa
191 ENDIF
192 ENDDO
193 ELSEIF(ualphi > uav0.AND.uav0 > zero)THEN
194
195
196
197 aaa = uav0/ualphi
198 DO k=1,nv46
199 IF(flux(k,ii) > zero)THEN
200 ff(k) = flux(k,ii) + (ff(k)-flux(k,ii))*aaa
201 ENDIF
202 ENDDO
203 ENDIF
204
205
206
207 DO k=1,nv46
208 IF(flux(k,ii) > zero)THEN
209 ff(k) = half * ( ff(k)*(one-
ale%UPWIND%UPWSM)+alph(ii)*flux(k,ii)*(one+
ale%UPWIND%UPWSM) )
210
211
212 if(int22>0then
213 if(debug_outp)then
215 print *, " brique =", ixs(11,i+nft)
216 print *, " FACE =", k
217 write (*,fmt='(A,6E26.14)')" WAS Flux(J) =", flux(k,ii)
218 write (*,fmt='(A,6E26.14)')" IS Flux(J) =", ff(k)
219 print *, " ------------------------"
220 endif
221 endif
222 endif
223
224
225
226 flux(k,ii) = ff(k)
227
228 IF(jv(k) < 0)THEN
229
230 ELSEIF(jv(k) <= numels)THEN
231 IF(int22 == 0)THEN
232 debug_tmp = flux(kv(k),jv(k))
233 flux(kv(k),jv(k)) = -flux(k,ii)
234 ELSE
235 IF(iiad22(nin,jv(k))==0)THEN
236
237 debug_tmp = flux(kv(k),jv(k))
238 flux(kv(k),jv(k)) = -flux(k,ii)
239 ELSE
240
241 nin = 1
242 ifv = kv(k)
243
244 debug_tmp =
brick_list(nin,iiad22(nin,jv(k)))%POLY(1)%FACE(ifv)%Adjacent_UpwFLUX(1)
245 brick_list(nin,iiad22(nin,jv(k)))%POLY(1)%FACE(ifv)%Adjacent_UpwFLUX(1) = -flux(k,ii)
246 ENDIF
247 ENDIF
248 ELSE
249 flux_vois(ii,k) = flux(k,ii)
250 n4_vois(ii,1) = itab(ixs(2,ii))
251 n4_vois(ii,2) = itab(ixs(3,ii))
252 n4_vois(ii,3) = itab(ixs(4,ii))
253 n4_vois(ii,4) = itab(ixs(5,ii))
254 n4_vois(ii,5) = itab(ixs(6,ii))
255 n4_vois(ii,6) = itab(ixs(7,ii))
256 n4_vois(ii,7) = itab(ixs(8,ii))
257 n4_vois(ii,8) = itab(ixs(9,ii))
258 ENDIF
259
260
261 if(int22>0)then
262 if(debug_outp)then
264 iev = jv(k)
265 facev=kv(k)
266 print *, " => Setting adjacent flux consequently :"
267 print *, " brique.V=", ixs(11,iev)
268 print *, " FACE.V =", ifv
269 write (*,fmt='(A,6E26.14)')
270 . " WAS Flux(J) =", debug_tmp
271 write (*,fmt='(A,6E26.14)')
272 . " IS Flux(J) =", -flux(k,ii)
273 print *, " ---"
274 endif
275 endif
276 endif
277
278
279 ENDIF
280 ENDDO
281
282
283
284 IF(nsegflu > 0)THEN
285 iad2 = ale_connect%ee_connect%iad_connect(ii)
286 DO k=1,nv46
287 IF(flux(k,ii) < zero .AND. ale_connect%ee_connect%connected(iad2 + k - 1) < 0)THEN
288 flux(k,ii) = segvar%PHASE_ALPHA(itrimat,-ale_connect%ee_connect%connected(iad2 + k - 1))*flux(k,ii)
289 ENDIF
290 ENDDO
291 ENDIF
292
293
294 enddo
295
296 RETURN
type(brick_entity), dimension(:,:), allocatable, target brick_list