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