37
38
39
40
41
42
43
44
45
51 use element_mod , only :nixs
52
53
54
55#include "implicit_f.inc"
56
57
58
59#include "spmd_c.inc"
60#include "vect01_c.inc"
61#include "com04_c.inc"
62
63
64
65 INTEGER, INTENT(IN) :: NV46
66 my_real,
INTENT(OUT) :: flux(nv46, *)
67 my_real,
INTENT(IN) :: x(3,numnod)
68 INTEGER, INTENT(IN) :: IXS(NIXS,NUMELS)
69 my_real,
INTENT(OUT) :: flux_vois(numels+nsvois, nv46)
70 INTEGER, INTENT(OUT) :: N4_VOIS(NUMELS+NSVOIS,8)
71 INTEGER, INTENT(IN) :: ITAB()
72 INTEGER, INTENT(IN) :: ITRIMAT
73 TYPE(t_segvar),INTENT(IN) :: SEGVAR
74 TYPE(t_ale_connectivity), INTENT(IN) :: ALE_CONNECT
75
76
77
78 INTEGER :: I, II, KK, JJ, IAD2, IAD3
79 INTEGER :: NEIGHBOOR_LIST(NV46), FACE_NEIGHBOOR(NV46)
83 INTEGER :: FACE_TO_NODE_LOCAL_ID(6, 4)
84 my_real ::
norm(3), a(3), b(3), c(3), surf, surf1, surf2
85
86
87
88
89
90 face_to_node_local_id(1, 1) = 1 ; face_to_node_local_id(1, 2) = 4
91 face_to_node_local_id(1, 3) = 3 ; face_to_node_local_id(1, 4) = 2
92
93 face_to_node_local_id(2, 1) = 3 ; face_to_node_local_id(2, 2) = 4
94 face_to_node_local_id(2, 3) = 8 ; face_to_node_local_id(2, 4) = 7
95
96 face_to_node_local_id(3, 1) = 5 ; face_to_node_local_id(3, 2) = 6
97 face_to_node_local_id(3, 3) = 7 ; face_to_node_local_id(3, 4) = 8
98
99 face_to_node_local_id(4, 1) = 1 ; face_to_node_local_id(4, 2) = 2
100 face_to_node_local_id(4, 3) = 6 ; face_to_node_local_id(4, 4) = 5
101
102 face_to_node_local_id(5, 1) = 2 ; face_to_node_local_id(5, 2) = 3
103 face_to_node_local_id(5, 3) = 7 ; face_to_node_local_id(5, 4) = 6
104
105 face_to_node_local_id(6, 1) = 1 ; face_to_node_local_id(6, 2) = 5
106 face_to_node_local_id(6, 3) = 8 ; face_to_node_local_id(6, 4) = 4
107
108
109 DO i = lft, llt
110 ii = i + nft
111 iad2 = ale_connect%ee_connect%iad_connect(ii)
112
116
117 DO kk = 1, nv46
118
119 IF (flux(kk, ii) > zero) THEN
120
121 neighboor_list(kk) = ale_connect%ee_connect%connected(iad2 + kk - 1)
122 face_neighboor(kk) = kk
123 IF (neighboor_list(kk) <= 0) THEN
124 IF(neighboor_list(kk)==0)neighboor_list(kk) = ii
125
126 ELSEIF (neighboor_list(kkTHEN
127 iad3 = ale_connect%ee_connect%iad_connect(neighboor_list(kk))
128
129 DO jj = 1, nv46
130 IF (ale_connect%ee_connect%connected(iad3 + jj - 1) == ii) THEN
131 face_neighboor(kk) = jj
132 ENDIF
133 ENDDO
134 ENDIF
135
136
137 xf = zero
138 yf = zero
139 zf = zero
140
141 a(1:3) = x(1:3, ixs(face_to_node_local_id(kk, 1) + 1, ii))
142 b(1:3) = x(1:3, ixs(face_to_node_local_id(kk, 2) + 1, ii))
143 c(1:3) = x(1:3, ixs(face_to_node_local_id(kk, 3) + 1, ii))
144
145 norm(1) = (b(2) - a(2)) * (c(3) - a(3)) - (b(3) - a(3)) * (c(2) - a(2))
146 norm(2) = (b(3) - a(3)) * (c(1) - a(1)) - (b(1) - a(1)) * (c(3) - a(3))
147 norm(3) = (b(1) - a(1)) * (c(2) - a(2)) - (b(2) - a(2)) * (c(1) - a(1))
148
150 xf = surf1 * third * (a(1) + b(1) + c(1))
151 yf = surf1 * third * (a(2) + b(2) + c(2))
152 zf = surf1 * third * (a(3) + b(3) + c(3))
153
154 a(1:3) = x(1:3, ixs(face_to_node_local_id(kk, 1) + 1, ii))
155 b(1:3) = x(1:3, ixs(face_to_node_local_id(kk, 3) + 1, ii))
156 c(1:3) = x(1:3, ixs(face_to_node_local_id(kk, 4) + 1, ii))
157
158 norm(1) = (b(2) - a(2)) * (c(3) - a(3)) - (b(3) - a(3)) * (c(2) - a(2))
159 norm(2) = (b(3) - a(3)) * (c(1) - a(1)) - (b(1) - a(1)) * (c(3) - a(3))
160 norm(3) = (b(1) - a(1)) * (c(2) - a(2)) - (b(2) - a(2)) * (c(1) - a(1))
161
163 xf = xf + surf2 * third * (a(1) + b(1) + c(1))
164 yf = yf + surf2 * third * (a(2) + b(2) + c(2))
165 zf = zf + surf2 * third * (a(3) + b(3) + c(3))
166
167 surf = surf1 + surf2
168 xf = xf / surf
169 yf = yf / surf
170 zf = zf / surf
171
172
177
178 flux(kk, ii) = alphak * flux(kk, ii)
179 IF (neighboor_list(kk) > 0)THEN
180 IF (neighboor_list(kk) <= numels .AND. neighboor_list(kk) > 0) THEN
181
182 flux(face_neighboor(kk), neighboor_list(kk)) = -flux(kk, ii)
183 ELSE
184
185 flux_vois(ii, kk) = flux(kk, ii)
186 n4_vois(ii, 1) = itab(ixs(2, ii))
187 n4_vois(ii, 2) = itab(ixs(3, ii))
188 n4_vois(ii, 3) = itab(ixs(4, ii))
189 n4_vois(ii, 4) = itab(ixs(5, ii))
190 n4_vois(ii, 5) = itab(ixs(6, ii))
191 n4_vois(ii, 6) = itab(ixs(7, ii))
192 n4_vois(ii, 7) = itab(ixs(8, ii))
193 n4_vois(ii, 8) = itab(ixs(9, ii))
194 ENDIF
195 ENDIF
196 ENDIF
197 ENDDO
198 ENDDO
199
200
201
202
203 IF(nsegflu > 0)THEN
204 DO i = lft, llt
205 ii = i + nft
206 iad2 = ale_connect%ee_connect%iad_connect(ii)
207 DO kk=1,nv46
208 IF(flux(kk,ii) < zero .AND. ale_connect%ee_connect%connected(iad2 + kk - 1) < 0)THEN
209 flux(kk,ii) = segvar%PHASE_ALPHA(itrimat,-ale_connect%ee_connect%connected(iad2 + kk - 1))*flux(kk
210 ENDIF
211 ENDDO
212 ENDDO
213 ENDIF
214
215
norm(diag(diag(diag(inv(mat))) -id.SOL), 2) % destroy mumps instance id.JOB
type(alemuscl_buffer_) alemuscl_buffer