36
37
38
39
40
41
42
43
44
45
49 use element_mod , only : nixq
50
51
52
53#include "implicit_f.inc"
54
55
56
57#include "spmd_c.inc"
58#include "com04_c.inc"
59#include "com08_c.inc"
60#include "vect01_c.inc"
61
62
63
64 INTEGER IXQ(NIXQ,NUMELQ),N4_VOIS(NUMELQ+NQVOIS,4),ITAB(NUMNOD)
65 INTEGER,INTENT(IN) :: ITRIMAT
66 my_real flux(4,*),alph(*),vol(*),flux_vois(numelq+nqvois,6)
67 TYPE(t_segvar),INTENT(IN) :: SEGVAR
68 TYPE(t_ale_connectivity), INTENT(IN) :: ALE_CONNECT
69
70
71
72 INTEGER I,II,K,JV(6),KV(6),IAD2,IAD3
74 . vol0,av0,uav0,alphi,ualphi,aaa,ff(6),udt,phi0
75
76
77
78 jv = -huge(jv(1))
79 kv = -huge(kv(1))
80 ff = -huge(ff(1))
81
82
83
84 IF(dt1 > zero)THEN
85 udt = one/dt1
86 ELSE
87 udt = zero
88 ENDIF
89
90 DO i=lft,llt
91 ii = i + nft
92 iad2 = ale_connect%ee_connect%iad_connect(ii)
93 vol0 = vol(i)*udt
94 av0 = alph(ii) * vol0
95 uav0 = vol0 - av0
96 alphi = zero
97 ualphi = zero
98 phi0 = zero
99
100
101
102 DO k=1,4
103 IF(flux(k,ii) > zero)THEN
104 jv(k) = ale_connect%ee_connect%connected(iad2 + k - 1)
105 kv(k) = k
106 IF(jv(k) == 0)THEN
107 jv(k) = ii
108 ff(k) = alph(ii)*flux(k,ii)
109 ELSEIF(jv(k) < 0)THEN
110
111 ff(k) = segvar%PHASE_ALPHA(itrimat,-jv(k)) *flux(k,ii)
112 ELSEIF(jv(k) <= numelq)THEN
113 iad3 = ale_connect%ee_connect%iad_connect(jv(k))
114 IF
115 IF(ale_connect%ee_connect%connected(iad3 + 2 - 1) == ii) kv(k) = 2
116 IF(ale_connect%ee_connect%connected(iad3 + 3 - 1) == ii) kv(k) = 3
117 IF(ale_connect%ee_connect%connected(iad3 + 4 - 1) == ii) kv(k) = 4
118 ff(k) = alph(jv(k))*flux(k,ii)
119 ELSE
120
121 ff(k) = alph(jv(k))*flux(k,ii)
122 ENDIF
123
124 alphi = alphi + ff(k)
125
126 phi0 = phi0 + flux(k,ii)
127 ENDIF
128 ENDDO
129
130 ualphi = phi0 - alphi
131
132
133
134 IF(alphi > av0.AND.av0 > zero)THEN
135
136
137
138 aaa = av0 / alphi
139 DO k=1,4
140 IF(flux(k,ii) > zero)THEN
141 ff(k) = ff(k) * aaa
142 ENDIF
143 ENDDO
144 ELSEIF(ualphi > uav0.AND.uav0 > zero)THEN
145
146
147
148
149 aaa = uav0/ualphi
150 DO k=1,4
151 IF(flux(k,ii) > zero)THEN
152 ff(k) = flux(k,ii) + (ff(k)-flux(k,ii))*aaa
153 ENDIF
154 ENDDO
155
156 ENDIF
157
158
159
160 DO k=1,4
161 IF(flux(k,ii) > zero)THEN
162 ff(k) = 0.5* (ff(k)*(1.-
ale%UPWIND%UPWSM)
163 . + alph(ii)*flux(k,ii)*(1.+
ale%UPWIND%UPWSM))
164 flux(k,ii) = ff(k)
165 IF(jv(k) < 0)THEN
166
167 ELSEIF(jv(k) <= numelq)THEN
168 flux(kv(k),jv(k)) = -flux(k,ii)
169 ELSE
170 flux_vois(ii,k) = flux(k,ii)
171 n4_vois(ii,1) = itab(ixq(2,ii))
172 n4_vois(ii,2) = itab(ixq(3,ii))
173 n4_vois(ii,3) = itab(ixq(4,ii))
174 n4_vois(ii,4) = itab(ixq(5,ii))
175 ENDIF
176 ENDIF
177 ENDDO
178
179
180
181 IF(nsegflu > 0)THEN
182 iad2 = ale_connect%ee_connect%iad_connect(ii)
183 DO k=1,4
184 IF(flux(k,ii) < zero .AND. ale_connect%ee_connect%connected(iad2 + k - 1) < 0)THEN
185 flux(k,ii) = segvar%PHASE_ALPHA(itrimat,-ale_connect%ee_connect%connected(iad2 + k - 1))*flux(k,ii)
186 ENDIF
187 ENDDO
188 ENDIF
189
190 enddo
191
192 RETURN