170
171
172
173
174
175
176
177
179
180
181
182#include "implicit_f.inc"
183
184
185
186#include "com01_c.inc"
187
188
189
190 TYPE(t_ale_connectivity), INTENT(IN) :: ALE_CONNECTIVITY
191 INTEGER, INTENT(IN) :: CEP(*), CEL(*)
192 INTEGER, DIMENSION(NUMNOD), INTENT(IN) :: NODLOCAL
193 INTEGER, DIMENSION(NUMNOD_L), INTENT(IN) :: NODGLOBAL
194 INTEGER, INTENT(IN) :: PROC, NUMNOD, NUMNOD_L, NUMEL, NUMEL_L, , NUMELQ_L, NUMELTG_L
195 INTEGER, INTENT(IN) :: NERVOIS, NESVOIS
196 INTEGER, INTENT(INOUT) :: NSVOIS, NQVOIS, NTGVOIS
197 INTEGER, DIMENSION(NUMEL), INTENT(INOUT)
198INTEGER, INTENT(INOUT) :: LEN_IA
199 INTEGER, INTENT(IN) :: IXS(11,*)
200
201
202
203 INTEGER :: INODE, IAD, IAD1,
204INTEGER, DIMENSION(:), ALLOCATABLE :: TAGELE
205 INTEGER, DIMENSION(:, :), ALLOCATABLE :: TAGELE_L
206 INTEGER, DIMENSION(:), ALLOCATABLE
207INTEGER, DIMENSION(:), ALLOCATABLE :: CPULOCALER, CPULOCALES, TAGER, TAGES
208 INTEGER, DIMENSION(:), ALLOCATABLE :: IDX, TMP, TMP2, PROC_LIST
209 INTEGER :: ELEM1_L,
210 LOGICAL :: OK_RC
211
212
213
214 ALLOCATE(tagele(numel))
215 tagele(1:numel) = 0
216 ALLOCATE(tagele_l(nspmd, numel_l))
217 tagele_l(1:nspmd, 1:numel_l) = 0
218 elemid_l(1:numel) = 0
219 ALLOCATE(lercvois(nervois))
220 lercvois(1:nervois) = 0
221 ALLOCATE(lesdvois(nesvois))
222 lercvois(1:nervois) = 0
223 ALLOCATE(nercvois(nspmd + 1))
224 nercvois(1:nspmd + 1) = 0
225 ALLOCATE(nesdvois(nspmd + 1))
226 nesdvois(1:nspmd + 1) = 0
227 ALLOCATE(tager(nervois))
228 tager(1:nervois) = 0
229 ALLOCATE(cpulocaler(nervois))
230 cpulocaler(1:nervois) = 0
231 ALLOCATE(tages(nesvois))
232 tages(1:nesvois) = 0
233 ALLOCATE(cpulocales(nesvois))
234 cpulocales(1:nesvois) = 0
235 ALLOCATE(idx(
max(nervois, nesvois)))
236 idx(1:
max(nervois, nesvois)) = 0
237 ALLOCATE(tmp(
max(nervois, nesvois)))
238 tmp(1:
max(nervois, nesvois)) = 0
239 ALLOCATE(tmp2(
max(nervois, nesvois)))
240 tmp2(1:
max(nervois, nesvois)) = 0
241
242 ife = 0
243 jfe = 0
244
245 DO inode = 1, numnod_l
246 node_id = nodglobal(inode)
247 iad1 = ale_connectivity%NE_CONNECT%IAD_CONNECT(node_id)
248 iad2 = ale_connectivity%NE_CONNECT%IAD_CONNECT(node_id + 1) - 1
249 IF (iad2 >= iad1) ALLOCATE(proc_list(iad2 - iad1 + 1))
250 ok_rc = .false.
251 DO iad = iad1, iad2
252 ielem = ale_connectivity%NE_CONNECT%CONNECTED(iad)
253 ielem_l = cel(ielem)
254 proc2 = cep(ielem)
255 proc_list(iad - iad1 + 1) = proc2
256 IF (proc2 == proc) THEN
257 ok_rc = .true.
258 elemid_l(ielem) = ielem_l
259 ENDIF
260 ENDDO
261
262 IF (ok_rc) THEN
263 DO iad = iad1, iad2
264 ielem = ale_connectivity%NE_CONNECT%CONNECTED(iad)
265 ielem_l = cel(ielem)
266 proc2 = proc_list(iad - iad1 + 1)
267 IF (proc2 /= proc) THEN
268 IF (tagele(ielem) == 0) THEN
269 tagele(ielem) = 1
270 ife = ife + 1
271 IF (ale_connectivity%NE_CONNECT%TYPE(iad) == 1) THEN
272 elemid_l(ielem) = numels_l + ife
273 lercvois(ife) = numels_l + ife
274 ELSE IF (ale_connectivity%NE_CONNECT%TYPE(iad) == 2) THEN
275 elemid_l(ielem) = numelq_l + ife
276 lercvois(ife) = numelq_l + ife
277 ELSE IF (ale_connectivity%NE_CONNECT%TYPE(iad) == 3) THEN
278 elemid_l(ielem) = numeltg_l + ife
279 lercvois(ife) = numeltg_l + ife
280 ENDIF
281 nercvois(proc2 + 1) = nercvois(proc2 + 1) + 1
282 tager(ife) = ielem
283 cpulocaler(ife) = proc2
284 ENDIF
285 ENDIF
286 ENDDO
287 ENDIF
288 DO iad = iad1, iad2
289 IF (proc_list(iad - iad1 + 1) == proc) THEN
290 elem1_l = cel(ale_connectivity%NE_CONNECT%CONNECTED(iad))
291 DO ii = iad1, iad2
292 IF (ii /= iad) THEN
293 elem2_l = cel(ale_connectivity%NE_CONNECT%CONNECTED(ii))
294 proc2 = proc_list(ii - iad1 + 1)
295 IF (proc2 /= proc) THEN
296 IF (tagele_l(proc2 + 1, elem1_l) == 0) THEN
297 tagele_l(proc2 + 1, elem1_l) = 1
298 nesdvois(proc2 + 1) = nesdvois(proc2 + 1) + 1
299 jfe = jfe + 1
300 lesdvois(jfe) = elem1_l
301 tages(jfe) = ale_connectivity%NE_CONNECT%CONNECTED(iad)
302 cpulocales(jfe) = proc2
303 ENDIF
304 ENDIF
305 ENDIF
306 ENDDO
307 ENDIF
308 ENDDO
309
310 IF (ALLOCATED(proc_list)) DEALLOCATE(proc_list)
311 ENDDO
312
313 DO p = 1, nspmd
314 nercvois(nspmd + 1) = nercvois(nspmd + 1) + nercvois(p)
315 nesdvois(nspmd + 1) = nesdvois(nspmd + 1) + nesdvois(p)
316 ENDDO
317
318
319 DO ii = 1, nervois
320 tmp(ii) = tager(ii)
321 tmp2(ii) = lercvois(ii)
322 idx(ii) = ii
323 ENDDO
325
326 DO ii = 1, nervois
327 tager(ii) = tmp(idx(ii))
328 lercvois(ii) = tmp2(idx(ii))
329 ENDDO
330 DO ii = 1, nervois
331 tmp2(ii) = lercvois(ii)
332 ENDDO
333
334 iad = 1
335 DO WHILE (iad <= nervois)
336 DO iad1 = iad, nervois
337 IF (cpulocaler(iad) /= cpulocaler(iad1)) THEN
338 EXIT
339 ENDIF
340 ENDDO
341 DO ii = iad, iad1 - 1
342 idx(ii) = ii
343 ENDDO
344 CALL quicksort_i2(tager(iad:iad1 - 1), idx(iad:iad1 - 1), 1, iad1 - iad)
345 iad = iad1
346 ENDDO
347
348 DO ii = 1, nervois
349 lercvois(ii) = tmp2(idx(ii))
350 ENDDO
351
352
353 DO ii = 1, nesvois
354 tmp(ii) = tages(ii)
355 tmp2(ii) = lesdvois(ii)
356 idx(ii) = ii
357 ENDDO
359
360 DO ii = 1, nesvois
361 tages(ii) = tmp(idx(ii))
362 lesdvois(ii) = tmp2(idx(ii))
363 ENDDO
364 DO ii = 1, nesvois
365 tmp2(ii) = lesdvois(ii)
366 ENDDO
367
368 iad = 1
369 DO WHILE (iad <= nesvois)
370 DO iad1 = iad, nesvois
371 IF (cpulocales(iad) /= cpulocales(iad1)) THEN
372 EXIT
373 ENDIF
374 ENDDO
375 DO ii = iad, iad1 - 1
376 idx(ii) = ii
377 ENDDO
378 CALL quicksort_i2(tages(iad:iad1 - 1), idx(iad:iad1 - 1), 1, iad1 - iad)
379 iad = iad1
380 ENDDO
381
382 DO ii = 1, nesvois
383 lesdvois(ii) = tmp2(idx(ii))
384 ENDDO
385
387 len_ia = len_ia + nspmd + 1
389 len_ia = len_ia + nervois
391 len_ia = len_ia + nspmd + 1
393 len_ia = len_ia + nesvois
394
395 DEALLOCATE(tagele, tagele_l, nercvois, nesdvois, lercvois, lesdvois,
396 . cpulocaler, cpulocales, tager, tages, tmp, tmp2, idx)
recursive subroutine quicksort_i2(a, idx, first, last)
void write_i_c(int *w, int *len)