36
37
38
39 USE multi_fvm_mod
41 use element_mod , only : nixs,nixq,nixtg
42
43
44
45#include "implicit_f.inc"
46
47
48
49#include "com01_c.inc"
50#include "com04_c.inc"
51#include "param_c.inc"
52
53
54
55 INTEGER NSVOIS, NQVOIS, NTGVOIS, PROC, NUMEL,
56 . NUMELS_L,NUMELQ_L,NUMELTG_L,
57 . IXSF(NIXS,) ,IXQF(NIXQ,NQVOIS),IXTGF(NIXTG,NTGVOIS),
58 . IPARG(NPARG,*),CEP(*),CEL(*),
59 . IXS(NIXS,*), (NIXQ,*), IXTG(NIXTG,*),NODLOCAL(*)
60 INTEGER, DIMENSION(*), INTENT(OUT) :: ID_GLOBAL_VOIS,FACE_VOIS
61 TYPE(MULTI_FVM_STRUCT) :: MULTI_FVM
62
63 INTEGER, DIMENSION(*), INTENT(in) :: INDX_S
64 INTEGER, DIMENSION(*), INTENT(in) :: INDX_Q
65 INTEGER, DIMENSION(*), INTENT(in) :: INDX_TG
66
67 INTEGER, DIMENSION(6*NUMELS,*), INTENT(in) :: FACE_ELM_S
68 INTEGER, DIMENSION(4*NUMELQ,*), INTENT(in) :: FACE_ELM_Q
69 INTEGER, DIMENSION(3*NUMELTG,*), INTENT(in) :: FACE_ELM_TG
70 TYPE(t_ale_connectivity), INTENT(INOUT) :: ALE_CONNECTIVITY
71 TYPE(t_connectivity_ext1), INTENT(INOUT) :: ee_connect_l
72 LOGICAL, INTENT(IN) :: ISHADOW
73
74
75
76 INTEGER I, J, K, NG, IFS, IFQ, IFTG,IE_LOC, IV_LOC
77 INTEGER JTUR,JTHE,ITY,IE,NFT,NEL,IV,PROC2,NFT_LOC,IAD1, LGTH, IAD2
78 INTEGER NUMEL_L, TMP, IALEUL
79 INTEGER, DIMENSION(:), ALLOCATABLE :: TAGE, nb_connect_l
80 LOGICAL IS_HEXA,IS_QUAD,IS_TRIA
81
82
83
84
85 numel_l = 0
86 DO ng = 1, ngroup
87 IF (iparg(32, ng) == proc) THEN
88 nel = iparg(2, ng)
89 numel_l = numel_l + nel
90 ENDIF
91 ENDDO
92 ALLOCATE(ee_connect_l%iad_connect(numel_l + 1))
93 ee_connect_l%iad_connect(1:numel_l + 1) = 0
94 ALLOCATE(nb_connect_l(numel_l))
95 nb_connect_l(1:numel_l) = 0
96
97
98 nft_loc = 0
99 DO ng = 1, ngroup
100 IF (iparg(32, ng) == proc) THEN
101 nel = iparg(2, ng)
102 nft = iparg(3, ng)
103 ialeul = iparg(7, ng) + iparg(11, ng)
104 ity = iparg(5,ng)
105 is_hexa=.false.
106 is_quad=.false.
107 is_tria=.false.
108 IF(ity == 1)is_hexa=.true.
109 IF(ity == 2)is_quad=.true.
110 IF(ity == 7 .AND. n2d > 0)is_tria=.true.
111 IF(is_hexa .OR. is_quad .OR. is_tria)THEN
112 IF (ialeul /= 0 .OR. ishadow) THEN
113 DO i = 1, nel
114
115 ie = i + nft
116
117 ie_loc = i + nft_loc
118
119 lgth = ale_connectivity%ee_connect%iad_connect(ie+1)-ale_connectivity%ee_connect%iad_connect
120 nb_connect_l(ie_loc) = lgth
121 ENDDO
122 ENDIF
123 ENDIF
124 nft_loc = nft_loc + nel
125 ENDIF
126 ENDDO
127 ee_connect_l%iad_connect(1) = 1
128 DO i = 2, numel_l + 1
129 ee_connect_l%iad_connect(i) = ee_connect_l%iad_connect(i - 1) + nb_connect_l(i - 1)
130 ENDDO
131 tmp = ee_connect_l%iad_connect(numel_l + 1) - 1
132 ALLOCATE(ee_connect_l%connected(tmp)) ; ee_connect_l%connected(1:tmp) = 0
133 ALLOCATE(ee_connect_l%type(tmp)) ; ee_connect_l%type(1:tmp) = 0
134 ALLOCATE(ee_connect_l%iface2(tmp)) ; ee_connect_l%iface2(1:tmp) = 0
135
136 ALLOCATE(tage(numel))
137 DO i = 1, numel
138 tage(i) = 0
139 ENDDO
140 ifs = 0
141 ifq = 0
142 iftg = 0
143 nft_loc = 0
144
145 DO ng=1,ngroup
146 jtur=iparg(12,ng)
147 jthe=iparg(13,ng)
148 IF(iparg(32,ng)==proc) THEN
149 nel = iparg(2,ng)
150 nft = iparg(3,ng)
151 ity = iparg(5,ng)
152
153 IF(ity==1) THEN
154 DO i = 1, nel
155 ie = i+nft
156 ie_loc = i+nft_loc
157 iad1 = ale_connectivity%ee_connect%iad_connect(ie)
158 lgth = ale_connectivity%ee_connect%iad_connect(ie+1)-ale_connectivity%ee_connect%iad_connect(ie)
159 tage(ie) = cel(ie)
160
161 DO j = 1, lgth
162 iv = ale_connectivity%ee_connect%connected(iad1 + j - 1)
163 iad2 = ee_connect_l%iad_connect(ie_loc) + j - 1
164 IF (iv>0) THEN
165 proc2 = cep(iv)
166 iv_loc = cel(iv)
167 IF(proc2/=proc) THEN
168
169 IF(tage(iv)==0) THEN
170 ifs = ifs + 1
171 tage(iv) = numels_l+ifs
172
173 DO k = 1,1
174 ixsf(k,ifs) = ixs(k,iv)
175 ENDDO
176 DO k = 2,9
177 ixsf(k,ifs) = nodlocal(ixs(k,iv))
178 ENDDO
179 DO k = 10,nixs
180 ixsf(k,ifs) = ixs(k,iv)
181 ENDDO
182 ENDIF
183
184 ee_connect_l%connected(iad2) = tage(iv)
185
186 id_global_vois( (ie_loc-1)*6+j ) = ixs(nixs,iv)
187 DO k=1,indx_s(ie)
188 IF( ixs(nixs,iv)==face_elm_s(6*(ie-1)+k,2) ) THEN
189 face_vois( (ie_loc-1)*6+j ) = face_elm_s(6*(ie-1)+k,1)
190 ENDIF
191 ENDDO
192 ELSE
193
194 ee_connect_l%connected(iad2) = iv_loc
195 id_global_vois( (ie_loc-1)*6+j ) = ixs(nixs,iv)
196 ENDIF
197 ELSE
198 ee_connect_l%connected(iad2) = iv
199 id_global_vois( (ie_loc-1)*6+j ) = 0
200 ENDIF
201 ee_connect_l%type(iad2) = ale_connectivity%ee_connect%type(iad1 + j - 1)
202 ee_connect_l%iface2(iad2) = ale_connectivity%ee_connect%iface2(iad1 + j - 1)
203 ENDDO
204 ENDDO
205 nft_loc = nft_loc + nel
206 ELSEIF(ity==2) THEN
207
208 DO i = 1, nel
209 ie = i+nft
210 ie_loc = i+nft_loc
211 iad1 = ale_connectivity%ee_connect%iad_connect(ie)
212 lgth = ale_connectivity%ee_connect%iad_connect(ie+1)-ale_connectivity%ee_connect%iad_connect(ie)
213 tage(ie) = cel(ie)
214
215 DO j = 1, lgth
216 iv = ale_connectivity%ee_connect%connected(iad1 + j - 1)
217 iad2 = ee_connect_l%iad_connect(ie_loc) + j - 1
218 IF (iv>0) THEN
219 proc2 = cep(iv)
220 iv_loc = cel(iv)
221 IF(proc2/=proc) THEN
222
223 IF(tage(iv)==0) THEN
224 ifq = ifq + 1
225 tage(iv) = numelq_l+ifq
226
227 DO k = 1,1
228 ixqf(k,ifq) = ixq(k,iv)
229 ENDDO
230 DO k = 2,5
231 ixqf(k,ifq) = nodlocal(ixq(k,iv))
232 ENDDO
233 DO k = 6,nixq
234 ixqf(k,ifq) = ixq(k,iv)
235 ENDDO
236 ENDIF
237
238 ee_connect_l%connected(iad2) = tage(iv)
239 id_global_vois( (ie_loc-1)*4+j ) = ixq(nixq,iv)
240 DO k=1,indx_q(ie)
241 IF( ixq(nixq,iv)==face_elm_q(4*(ie-1)+k,2) ) THEN
242 face_vois( (ie_loc-1)*4+j ) = face_elm_q(4*(ie-1)+k,1)
243 ENDIF
244 ENDDO
245 ELSE
246
247 ee_connect_l%connected(iad2) = iv_loc
248 id_global_vois( (ie_loc-1)*4+j ) = ixq(nixq,iv)
249 ENDIF
250 ELSE
251 ee_connect_l%connected(iad2) = iv
252 id_global_vois( (ie_loc-1)*4+j ) = 0
253 ENDIF
254 ee_connect_l%type(iad2) = ale_connectivity%ee_connect%type(iad1 + j - 1)
255 ee_connect_l%iface2(iad2) = ale_connectivity%ee_connect%iface2(iad1 + j - 1)
256 ENDDO
257 ENDDO
258 nft_loc = nft_loc + nel
259 ELSEIF(ity == 7 .AND. (n2d /= 0 .AND. multi_fvm%IS_USED)) THEN
260
261 DO i = 1, nel
262 ie = i+nft
263 ie_loc = i+nft_loc
264 iad1 = ale_connectivity%ee_connect%iad_connect(ie)
265 lgth = ale_connectivity%ee_connect%iad_connect(ie+1)-ale_connectivity%ee_connect%iad_connect(ie)
266 tage(ie) = cel(ie)
267
268 DO j = 1, 3
269 iv = ale_connectivity%ee_connect%connected(iad1 + j - 1)
270 iad2 = ee_connect_l%iad_connect(ie_loc) + j - 1
271 IF (iv>0) THEN
272 proc2 = cep(iv)
273 iv_loc = cel(iv)
274 IF(proc2/=proc) THEN
275
276 IF(tage(iv)==0) THEN
277 iftg = iftg + 1
278 tage(iv) = numeltg_l+iftg
279
280 DO k = 1,1
281 ixtgf(k,iftg) = ixtg(k,iv)
282 ENDDO
283 DO k = 2,4
284 ixtgf(k,iftg) = nodlocal(ixtg(k,iv))
285 ENDDO
286 DO k = 5,nixtg
287 ixtgf(k,iftg) = ixtg(k,iv)
288 ENDDO
289 ENDIF
290
291 ee_connect_l%connected(iad2) = tage(iv)
292 id_global_vois( (ie_loc-1)*3+j ) = ixtg(nixtg,iv)
293
294 DO k=1,indx_tg(ie)
295 IF( ixtg(nixtg,iv)==face_elm_tg(3*(ie-1)+k,2) ) THEN
296 face_vois( (ie_loc-1)*3+j ) = face_elm_tg(3*(ie-1)+k,1)
297 ENDIF
298 ENDDO
299
300 ELSE
301
302 ee_connect_l%connected(iad2) = iv_loc
303 id_global_vois( (ie_loc-1
304 ENDIF
305 ELSE
306 ee_connect_l%connected(iad2) = iv
307 id_global_vois( (ie_loc-1)*3+j ) = 0
308 ENDIF
309 ee_connect_l%type(iad2) = ale_connectivity%ee_connect%type(iad1 + j - 1)
310 ee_connect_l%iface2(iad2) = ale_connectivity%ee_connect%iface2(iad1 + j - 1)
311 ENDDO
312 ENDDO
313 nft_loc = nft_loc + nel
314 ENDIF
315 ENDIF
316 ENDDO
317 DEALLOCATE(tage)
318 DEALLOCATE(nb_connect_l)
319 RETURN