OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
zana_lr.F
Go to the documentation of this file.
1C
2C This file is part of MUMPS 5.5.1, released
3C on Tue Jul 12 13:17:24 UTC 2022
4C
5C
6C Copyright 1991-2022 CERFACS, CNRS, ENS Lyon, INP Toulouse, Inria,
7C Mumps Technologies, University of Bordeaux.
8C
9C This version of MUMPS is provided to you free of charge. It is
10C released under the CeCILL-C license
11C (see doc/CeCILL-C_V1-en.txt, doc/CeCILL-C_V1-fr.txt, and
12C https://cecill.info/licences/Licence_CeCILL-C_V1-en.html)
13C
14 MODULE zmumps_ana_lr
15 USE zmumps_lr_core
16 USE zmumps_lr_stats
17 USE mumps_lr_common
18 USE mumps_ana_ord_wrappers
19 USE mumps_ana_blk_m, ONLY: lmatrix_t
20!$ USE OMP_LIB, ONLY: omp_get_max_threads
21 IMPLICIT NONE
22 CONTAINS
23 SUBROUTINE get_cut(IWR, NASS, NCB, LRGROUPS, NPARTSCB,
24 & NPARTSASS, CUT)
25 INTEGER, INTENT(IN) :: NASS, NCB
26 INTEGER, INTENT(IN) :: IWR(*)
27 INTEGER, INTENT(IN), DIMENSION(:) :: LRGROUPS
28 INTEGER, INTENT(OUT) :: NPARTSCB, NPARTSASS
29 INTEGER, POINTER, DIMENSION(:) :: CUT
30 INTEGER :: I, CURRENT_PART, CUTBUILDER,allocok
31 INTEGER, ALLOCATABLE, DIMENSION(:) :: BIG_CUT
32 ALLOCATE(big_cut(max(nass,1)+ncb+1),stat=allocok)
33 IF(allocok.GT.0) THEN
34 write(*,*) "Allocation error of BIG_CUT in GET_CUT"
35 CALL mumps_abort()
36 ENDIF
37 current_part = lrgroups(iwr(1))
38 big_cut(1) = 1
39 big_cut(2) = 2
40 cutbuilder = 2
41 npartsass = 0
42 npartscb = 0
43 DO i = 2,nass + ncb
44 IF (lrgroups(iwr(i)) == current_part) THEN
45 big_cut(cutbuilder) = big_cut(cutbuilder) + 1
46 ELSE
47 cutbuilder = cutbuilder + 1
48 big_cut(cutbuilder) = big_cut(cutbuilder-1) + 1
49 current_part = lrgroups(iwr(i))
50 END IF
51 IF (i == nass) npartsass = cutbuilder - 1
52 END DO
53 IF (nass.EQ.1) npartsass= 1
54 npartscb = cutbuilder - 1 - npartsass
55 ALLOCATE(cut(max(npartsass,1)+npartscb+1),stat=allocok)
56 IF(allocok.GT.0) THEN
57 write(*,*) "Allocation error of CUT in GET_CUT"
58 CALL mumps_abort()
59 ENDIF
60 IF (npartsass.EQ.0) THEN
61 cut(1) = 1
62 cut(2:2+npartscb) = big_cut(1:1+npartscb)
63 ELSE
64 cut = big_cut(1:npartsass+npartscb+1)
65 ENDIF
66 if(allocated(big_cut)) DEALLOCATE(big_cut)
67 END SUBROUTINE get_cut
68 SUBROUTINE sep_grouping(NV, VLIST, N, NZ, LRGROUPS, NBGROUPS, IW,
69 & LW, IPE, LEN, GROUP_SIZE, HALO_DEPTH, TRACE, WORKH, NODE,
70 & GEN2HALO, K482, K472, K469, SEP_SIZE, MAXSIZE_PARTS,
71 & KEEP10, LP, LPOK, IFLAG, IERROR)
72 INTEGER(8), INTENT(IN) :: NZ, LW
73 INTEGER, INTENT(IN) :: NV, N, GROUP_SIZE, HALO_DEPTH
74 INTEGER, INTENT(IN) :: IW(LW), LEN(N), NODE, K482
75 INTEGER(8), INTENT(IN) :: IPE(N+1)
76 INTEGER, INTENT(IN) :: K472, K469, SEP_SIZE, KEEP10, LP
77 LOGICAL :: LPOK
78 INTEGER, INTENT(INOUT) :: NBGROUPS, WORKH(N)
79 INTEGER, INTENT(INOUT) :: VLIST(NV), TRACE(N)
80 INTEGER :: LRGROUPS(:)
81 INTEGER, INTENT(INOUT) :: GEN2HALO(N)
82 INTEGER, INTENT(INOUT) :: IFLAG, IERROR
83 INTEGER, INTENT(INOUT) :: MAXSIZE_PARTS
84 INTEGER(8), ALLOCATABLE, DIMENSION(:) :: IPTRHALO
85 INTEGER, ALLOCATABLE, DIMENSION(:) :: PARTS, JCNHALO
86 INTEGER(8) :: HALOEDGENBR
87 INTEGER :: NHALO,
88 & nbgroups_kway, i, group_size2, lrgroups_sign, ierr
89 INTEGER :: MAXSIZE_PARTS_LOC
90#if defined (metis) || defined (parmetis) || defined (metis4) || defined (parmetis3)
91 INTEGER :: METIS_IDX_SIZE
92#endif
93#if defined (scotch) || defined (ptscotch)
94 INTEGER :: SCOTCH_IDX_SIZE
95#endif
96 CALL compute_blr_vcs(k472, group_size2, group_size, nv)
97 nbgroups_kway = max(
98 & int(dble(nv+group_size2-1)/dble(group_size2))
99 & ,1)
100 IF (nv .GE. sep_size) THEN
101 lrgroups_sign = 1
102 ELSE
103 lrgroups_sign = -1
104 ENDIF
105 IF (nbgroups_kway > 1) THEN
106 IF (k469.EQ.3) THEN
107!$OMP CRITICAL(gethalo_cri)
108 CALL gethalonodes(n, iw, lw, ipe, vlist, nv, halo_depth,
109 & nhalo, trace, workh, node, len, haloedgenbr,
110 & gen2halo)
111 ALLOCATE(parts(nhalo), iptrhalo(nhalo+1),
112 & jcnhalo(haloedgenbr), stat=ierr)
113 IF (ierr.GT.0) THEN
114 IF (lpok) WRITE(lp,*)
115 & " Error allocate integer array of size: ",
116 & int(nhalo+(keep10*(nhalo+1)),8) + haloedgenbr
117 iflag = -7
118 CALL mumps_set_ierror
119 & (int(nhalo+(keep10*(nhalo+1)),8) + haloedgenbr,
120 & ierror)
121 ENDIF
122 CALL gethalograph(workh, nhalo, n, iw, lw, ipe, iptrhalo,
123 & jcnhalo, haloedgenbr,trace,node, gen2halo)
124!$OMP END CRITICAL(gethalo_cri)
125 IF (iflag.LT.0) RETURN
126 ELSE
127 CALL gethalonodes(n, iw, lw, ipe, vlist, nv, halo_depth,
128 & nhalo, trace, workh, node, len, haloedgenbr,
129 & gen2halo)
130 ALLOCATE(parts(nhalo), iptrhalo(nhalo+1),
131 & jcnhalo(haloedgenbr), stat=ierr)
132 IF (ierr.GT.0) THEN
133 IF (lpok) WRITE(lp,*)
134 & " Error allocate integer array of size: ",
135 & int(nhalo+(keep10*(nhalo+1)),8) + haloedgenbr
136 iflag = -7
137 CALL mumps_set_ierror
138 & (int(nhalo+(keep10*(nhalo+1)),8) + haloedgenbr,
139 & ierror)
140 RETURN
141 ENDIF
142 CALL gethalograph(workh, nhalo, n, iw, lw, ipe, iptrhalo,
143 & jcnhalo, haloedgenbr,trace,node, gen2halo)
144 ENDIF
145 IF (k482.EQ.1) THEN
146#if defined (metis) || defined (parmetis) || defined (metis4) || defined (parmetis3)
147 CALL mumps_metis_idxsize(metis_idx_size)
148 IF (metis_idx_size .EQ. 64) THEN
149 CALL mumps_metis_kway_mixedto64(nhalo, haloedgenbr,
150 & iptrhalo,
151 & jcnhalo,
152 & nbgroups_kway, parts, lp, lpok, keep10,
153 & iflag, ierror)
154 ELSE
155 IF (keep10.EQ.1) THEN
156 iflag = -52
157 ierror = 1
158 ELSE
159 CALL mumps_metis_kway_mixedto32(nhalo, haloedgenbr,
160 & iptrhalo,
161 & jcnhalo,
162 & nbgroups_kway, parts, lp, lpok, keep10,
163 & iflag, ierror)
164 ENDIF
165 ENDIF
166#endif
167 ELSE IF (k482.EQ.2) THEN
168#if defined (scotch) || defined (ptscotch)
169 CALL mumps_scotch_intsize(scotch_idx_size)
170 IF (scotch_idx_size .EQ. 32) THEN
171 IF (keep10.EQ.1) THEN
172 iflag = -52
173 ierror = 2
174 ELSE
175 CALL mumps_scotch_kway_mixedto32(
176 & nhalo, haloedgenbr, iptrhalo, jcnhalo,
177 & nbgroups_kway, parts, lp, lpok, keep10,
178 & iflag, ierror)
179 ENDIF
180 ELSE
181 CALL mumps_scotch_kway_mixedto64(
182 & nhalo, haloedgenbr, iptrhalo, jcnhalo,
183 & nbgroups_kway, parts, lp, lpok, keep10,
184 & iflag, ierror)
185 END IF
186#endif
187 ELSE
188 WRITE(6,*) " Internal ERROR K482=", k482
189 CALL mumps_abort()
190 END IF
191 IF (iflag.LT.0) GOTO 500
192 CALL get_global_groups(parts, vlist, nv,
193 & nbgroups_kway, lrgroups, n, nbgroups, lrgroups_sign,
194 & maxsize_parts_loc)
195 maxsize_parts = max(maxsize_parts, maxsize_parts_loc)
196 ELSE
197 maxsize_parts = max(maxsize_parts,nv)
198!$OMP CRITICAL(lrgrouping_cri)
199 DO i=1,nv
200 lrgroups(vlist(i)) = lrgroups_sign*(nbgroups + 1)
201 END DO
202 nbgroups = nbgroups + 1
203!$OMP END CRITICAL(lrgrouping_cri)
204 END IF
205 500 IF (allocated(iptrhalo)) then
206 DEALLOCATE(iptrhalo)
207 ENDIF
208 IF (allocated(parts)) then
209 DEALLOCATE(parts)
210 ENDIF
211 IF (allocated(jcnhalo)) then
212 DEALLOCATE(jcnhalo )
213 ENDIF
214 RETURN
215 END SUBROUTINE sep_grouping
216 SUBROUTINE sep_grouping_ab (NV, NVEXPANDED,
217 & VLIST, N, LRGROUPS, NBGROUPS, LUMAT, SIZEOFBLOCKS,
218 & GROUP_SIZE, HALO_DEPTH, TRACE, WORKH, NODE,
219 & GEN2HALO, K482, K472, K469, SEP_SIZE, MAXSIZE_PARTS,
220 & KEEP10, LP, LPOK, IFLAG, IERROR)
221 TYPE(lmatrix_t) :: LUMAT
222 INTEGER, INTENT(IN) :: NV, NVEXPANDED,
223 & n, group_size, halo_depth
224 INTEGER, INTENT(IN) :: SIZEOFBLOCKS(N)
225 INTEGER, INTENT(IN) :: NODE, K482
226 INTEGER, INTENT(IN) :: K472, K469, SEP_SIZE, KEEP10, LP
227 LOGICAL :: LPOK
228 INTEGER, INTENT(INOUT) :: NBGROUPS, WORKH(N)
229 INTEGER, INTENT(INOUT) :: VLIST(NV), TRACE(N)
230 INTEGER :: LRGROUPS(:)
231 INTEGER, INTENT(INOUT) :: GEN2HALO(N)
232 INTEGER, INTENT(INOUT) :: IFLAG, IERROR
233 INTEGER, INTENT(INOUT) :: MAXSIZE_PARTS
234 INTEGER(8), ALLOCATABLE, DIMENSION(:) :: IPTRHALO
235 INTEGER, ALLOCATABLE, DIMENSION(:) :: PARTS, JCNHALO
236 INTEGER, ALLOCATABLE, DIMENSION(:) :: VWGT
237 INTEGER(8) :: HALOEDGENBR
238 INTEGER :: NHALO,
239 & nbgroups_kway, i, group_size2, lrgroups_sign, ierr
240 INTEGER :: MAXSIZE_PARTS_LOC
241 DOUBLE PRECISION :: COMPRESS_RATIO
242#if defined (metis) || defined (parmetis) || defined (metis4) || defined (parmetis3)
243 INTEGER :: METIS_IDX_SIZE
244#endif
245#if defined (scotch) || defined (ptscotch)
246 INTEGER :: SCOTCH_IDX_SIZE
247#endif
248 CALL compute_blr_vcs(k472, group_size2, group_size, nvexpanded)
249 compress_ratio= dble(nvexpanded)/dble(nv)
250 nbgroups_kway = max(
251 & int(dble(nvexpanded+group_size2-1)/dble(group_size2))
252 & ,1)
253 nbgroups_kway = min(nbgroups_kway, nv)
254 IF (nvexpanded .GE. sep_size) THEN
255 lrgroups_sign = 1
256 ELSE
257 lrgroups_sign = -1
258 ENDIF
259 IF (nbgroups_kway > 1) THEN
260 IF (k469.EQ.3) THEN
261!$OMP CRITICAL(gethalo_cri)
262 CALL gethalonodes_ab(n, lumat, vlist, nv, halo_depth,
263 & nhalo, trace, workh, node, haloedgenbr,
264 & gen2halo)
265 ALLOCATE(parts(nhalo), iptrhalo(nhalo+1),
266 & jcnhalo(haloedgenbr), vwgt(nhalo), stat=ierr)
267 IF (ierr.GT.0) THEN
268 IF (lpok) WRITE(lp,*)
269 & " Error allocate integer array of size: ",
270 & int(2*nhalo+(keep10*(nhalo+1)),8) + haloedgenbr
271 iflag = -7
272 CALL mumps_set_ierror
273 & (int(2*nhalo+(keep10*(nhalo+1)),8) + haloedgenbr,
274 & ierror)
275 ENDIF
276 DO i=1, nhalo
277 vwgt(i) = sizeofblocks(workh(i))
278 ENDDO
279 CALL gethalograph_ab(workh, nv,
280 & nhalo, n, lumat, iptrhalo,
281 & jcnhalo, haloedgenbr,trace,node, gen2halo, parts)
282!$omp END CRITICAL(gethalo_cri)
283 IF (iflag.LT.0) RETURN
284 ELSE
285 CALL gethalonodes_ab(n, lumat, vlist, nv, halo_depth,
286 & nhalo, trace, workh, node, haloedgenbr,
287 & gen2halo)
288 ALLOCATE(parts(nhalo), iptrhalo(nhalo+1),
289 & jcnhalo(haloedgenbr), vwgt(nhalo), stat=ierr)
290 IF (ierr.GT.0) THEN
291 IF (lpok) WRITE(lp,*)
292 & " Error allocate integer array of size: ",
293 & int(2*nhalo+(keep10*(nhalo+1)),8) + haloedgenbr
294 iflag = -7
295 CALL mumps_set_ierror
296 & (int(2*nhalo+(keep10*(nhalo+1)),8) + haloedgenbr,
297 & ierror)
298 RETURN
299 ENDIF
300 DO i=1, nhalo
301 vwgt(i) = sizeofblocks(workh(i))
302 ENDDO
303 CALL gethalograph_ab(workh, nv,
304 & nhalo, n, lumat, iptrhalo,
305 & jcnhalo, haloedgenbr,trace,node, gen2halo, parts)
306 ENDIF
307 IF (k482.EQ.1) THEN
308#if defined (metis) || defined (parmetis) || defined (metis4) || defined (parmetis3)
309 CALL mumps_metis_idxsize(metis_idx_size)
310 IF (metis_idx_size .EQ. 64) THEN
311 CALL mumps_metis_kway_ab_mixedto64(nhalo, haloedgenbr,
312 & iptrhalo,
313 & jcnhalo,
314 & nbgroups_kway, parts, vwgt, lp, lpok, keep10,
315 & iflag, ierror)
316 ELSE
317 IF (keep10.EQ.1) THEN
318 iflag = -52
319 ierror = 1
320 ELSE
321 CALL mumps_metis_kway_ab_mixedto32(nhalo, haloedgenbr,
322 & iptrhalo,
323 & jcnhalo,
324 & nbgroups_kway, parts, vwgt, lp, lpok, keep10,
325 & iflag, ierror)
326 ENDIF
327 ENDIF
328#endif
329 ELSE IF (k482.EQ.2) THEN
330#if defined (scotch) || defined (ptscotch)
331 CALL mumps_scotch_intsize(scotch_idx_size)
332 IF (scotch_idx_size .EQ. 32) THEN
333 IF (keep10.EQ.1) THEN
334 iflag = -52
335 ierror = 2
336 ELSE
337 CALL mumps_scotch_kway_mixedto32(
338 & nhalo, haloedgenbr, iptrhalo, jcnhalo,
339 & nbgroups_kway, parts, lp, lpok, keep10,
340 & iflag, ierror)
341 ENDIF
342 ELSE
343 CALL mumps_scotch_kway_mixedto64(
344 & nhalo, haloedgenbr, iptrhalo, jcnhalo,
345 & nbgroups_kway, parts, lp, lpok, keep10,
346 & iflag, ierror)
347 END IF
348#endif
349 ELSE
350 WRITE(6,*) " Internal ERROR K482=", k482
351 CALL mumps_abort()
352 END IF
353 IF (iflag.LT.0) GOTO 500
354 CALL get_global_groups(parts,vlist, nv,
355 & nbgroups_kway, lrgroups, n, nbgroups, lrgroups_sign,
356 & maxsize_parts_loc)
357 maxsize_parts = max( maxsize_parts,
358 & int(dble(maxsize_parts_loc*compress_ratio)) )
359 ELSE
360 maxsize_parts = max(maxsize_parts,nv)
361!$OMP CRITICAL(lrgrouping_cri)
362 DO i=1,nv
363 lrgroups(vlist(i)) = lrgroups_sign*(nbgroups + 1)
364 END DO
365 nbgroups = nbgroups + 1
366!$OMP END CRITICAL(lrgrouping_cri)
367 END IF
368 500 IF (allocated(iptrhalo)) then
369 DEALLOCATE(iptrhalo)
370 ENDIF
371 IF (allocated(parts)) then
372 DEALLOCATE(parts)
373 ENDIF
374 IF (allocated(jcnhalo)) then
375 DEALLOCATE(jcnhalo )
376 ENDIF
377 IF (allocated(vwgt)) then
378 DEALLOCATE(vwgt)
379 ENDIF
380 RETURN
381 END SUBROUTINE sep_grouping_ab
382 SUBROUTINE gethalonodes_ab(N, LUMAT, IND, NIND, PMAX,
383 & NHALO, TRACE, WORKH, NODE, HALOEDGENBR,
384 & GEN2HALO)
385 TYPE(lmatrix_t) :: LUMAT
386 INTEGER,DIMENSION(:),INTENT(IN) :: IND
387 INTEGER, INTENT(IN) :: N, NODE
388 INTEGER, INTENT(IN) :: PMAX,NIND
389 INTEGER, INTENT(OUT) :: NHALO
390 INTEGER, INTENT(INOUT) :: TRACE(N), WORKH(N)
391 INTEGER :: GEN2HALO(N)
392 INTEGER(8), INTENT(OUT) :: HALOEDGENBR
393 INTEGER :: I, J, II
394 INTEGER :: HALOI, NB, NEWNHALO
395 INTEGER(8) :: SEPEDGES_TOTAL,
396 & sepedges_internal
397 workh(1:nind) = ind
398 nhalo = nind
399 newnhalo = 0
400 haloedgenbr = 0_8
401 sepedges_total = 0_8
402 sepedges_internal = 0_8
403 DO i=1,nind
404 haloi = workh(i)
405 gen2halo(haloi) = i
406 IF (trace(haloi) .NE. node) THEN
407 trace(haloi) = node
408 END IF
409 ENDDO
410 DO i=1,nind
411 haloi = workh(i)
412 nb = lumat%COL(haloi)%NBINCOL
413 sepedges_total = sepedges_total + int(nb,8)
414 DO j=1, nb
415 ii = lumat%COL(haloi)%IRN(j)
416 IF (trace(ii).NE.node) THEN
417 newnhalo = newnhalo + 1
418 workh(nhalo+newnhalo) = ii
419 gen2halo(ii) = nhalo+newnhalo
420 trace(ii) = node
421 ELSE
422 IF (gen2halo(ii).LE.nhalo) THEN
423 sepedges_internal = sepedges_internal + 1_8
424 ENDIF
425 ENDIF
426 ENDDO
427 END DO
428 haloedgenbr = sepedges_total +
429 & (sepedges_total - sepedges_internal)
430 nhalo = nhalo + newnhalo
431 END SUBROUTINE gethalonodes_ab
432 SUBROUTINE gethalograph_ab(HALO,NSEP,NHALO,
433 & N,LUMAT,IPTRHALO,JCNHALO,
434 & HALOEDGENBR,TRACE,NODE, GEN2HALO, IQ)
435 INTEGER, INTENT(IN) :: N
436 TYPE(lmatrix_t) :: LUMAT
437 INTEGER,INTENT(IN):: NSEP, NHALO, NODE
438 INTEGER,INTENT(IN):: GEN2HALO(N)
439 INTEGER,DIMENSION(NHALO),INTENT(IN) :: HALO
440 INTEGER, INTENT(IN) :: TRACE(N)
441 INTEGER(8),INTENT(IN) :: HALOEDGENBR
442 INTEGER(8), INTENT(OUT) :: IPTRHALO(NHALO+1)
443 INTEGER, INTENT(OUT) :: JCNHALO(HALOEDGENBR)
444 INTEGER :: IQ(NHALO)
445 INTEGER::I,J,NB,II,JJ,HALOI,HALOJ
446 DO I=nsep+1, nhalo
447 iq(i) = 0
448 ENDDO
449 DO i=1,nsep
450 haloi = halo(i)
451 nb = lumat%COL(haloi)%NBINCOL
452 iq(i) = nb
453 DO jj=1, nb
454 ii = lumat%COL(haloi)%IRN(jj)
455 j = gen2halo(ii)
456 IF (j.GT.nsep) THEN
457 iq(j) = iq(j) + 1
458 ENDIF
459 ENDDO
460 ENDDO
461 iptrhalo(1) = 1_8
462 DO i=1,nhalo
463 iptrhalo(i+1) = iptrhalo(i)+int(iq(i),8)
464 ENDDO
465 DO i=1,nsep
466 haloi = halo(i)
467 nb = lumat%COL(haloi)%NBINCOL
468 DO jj=1, nb
469 haloj = lumat%COL(haloi)%IRN(jj)
470 j = gen2halo(haloj)
471 jcnhalo(iptrhalo(i)) = j
472 iptrhalo(i) = iptrhalo(i) + 1
473 IF (j.GT.nsep) THEN
474 jcnhalo(iptrhalo(j)) = i
475 iptrhalo(j) = iptrhalo(j) + 1
476 ENDIF
477 ENDDO
478 ENDDO
479 iptrhalo(1) = 1_8
480 DO i=1,nhalo
481 iptrhalo(i+1) = iptrhalo(i)+int(iq(i),8)
482 ENDDO
483 END SUBROUTINE gethalograph_ab
484 SUBROUTINE get_global_groups(PARTS, SEP, NSEP, NPARTS,
485 & LRGROUPS, N, NBGROUPS, LRGROUPS_SIGN,
486 & MAXSIZE_PARTS_LOC)
487 INTEGER,INTENT(IN) :: NSEP, N, LRGROUPS_SIGN
488 INTEGER :: PARTS(:)
489 INTEGER,DIMENSION(:),INTENT(INOUT) :: SEP
490 INTEGER, INTENT(INOUT) :: NPARTS
491 INTEGER, INTENT(INOUT) :: NBGROUPS
492 INTEGER :: LRGROUPS(:)
493 INTEGER, INTENT(OUT) :: MAXSIZE_PARTS_LOC
494 INTRINSIC maxval
495 INTEGER:: I,CNT,NB_PARTS_WITHOUT_SEP_NODE,allocok
496 INTEGER:: TARGET_SIZE_KWAY
497 INTEGER:: MAXSIZE_PARTS_LOC_NEW
498 INTEGER,DIMENSION(:),ALLOCATABLE::SIZES, RIGHTPART
499 INTEGER,DIMENSION(:),ALLOCATABLE::PARTPTR
500#if ! defined(NO_SPLIT_IN_BLRGROUPING)
501 INTEGER :: NB_PARTS_WITH_SPLIT, IP, SZ_FINAL, II, NB_SPLIT
502 INTEGER :: TARGET_SIZE_SPLIT
503#endif
504 INTEGER,DIMENSION(:),ALLOCATABLE :: NEWSEP
505 ALLOCATE( newsep(nsep),
506 & sizes(nparts),
507 & rightpart(nparts),
508 & partptr(nparts+1),stat=allocok)
509 IF(allocok.GT.0) THEN
510 write(*,*) "Allocation error in GET_GLOBAL_GROUPS"
511 CALL mumps_abort()
512 ENDIF
513 target_size_kway = (nsep+nparts-1) / nparts
514 target_size_split = 2*target_size_kway
515 nb_parts_without_sep_node = 0
516 rightpart = 0
517 sizes = 0
518 DO i=1,nsep
519 sizes(parts(i)) = sizes(parts(i)) + 1
520 END DO
521 maxsize_parts_loc = maxval(sizes)
522 cnt = 0
523 partptr(1)=1
524 DO i=2,nparts+1
525 partptr(i) = partptr(i-1) + sizes(i-1)
526 IF (sizes(i-1)==0) THEN
527 nb_parts_without_sep_node = nb_parts_without_sep_node + 1
528 ELSE
529 cnt = cnt + 1
530 rightpart(i-1) = cnt
531#if ! defined(NO_SPLIT_IN_BLRGROUPING)
532 sizes(cnt) = sizes(i-1)
533#endif
534 END IF
535 END DO
536 nparts = nparts - nb_parts_without_sep_node
537#if ! defined(NO_SPLIT_IN_BLRGROUPING)
538 IF (maxsize_parts_loc.LT.target_size_split) THEN
539#endif
540!$OMP CRITICAL(lrgrouping_cri)
541 DO i=1,nsep
542 newsep(partptr(parts(i))) = sep(i)
543 lrgroups(sep(i)) = lrgroups_sign*(rightpart(parts(i))
544 & + nbgroups)
545 partptr(parts(i)) =
546 & partptr(parts(i)) + 1
547 END DO
548 nbgroups = nbgroups + nparts
549!$OMP END CRITICAL(lrgrouping_cri)
550 sep = newsep
551#if ! defined(NO_SPLIT_IN_BLRGROUPING)
552 ELSE
553 DO i=1,nsep
554 newsep(partptr(parts(i))) = sep(i)
555 partptr(parts(i)) =
556 & partptr(parts(i)) + 1
557 END DO
558 sep = newsep
559 partptr(1)=1
560 DO i=2,nparts+1
561 partptr(i) = partptr(i-1) + sizes(i-1)
562 ENDDO
563 nb_parts_with_split = 0
564 maxsize_parts_loc_new = 0
565!$OMP CRITICAL(lrgrouping_cri)
566 DO ip=1,nparts
567 nb_split = (sizes(ip) + target_size_split-1)
568 & / target_size_split
569 sz_final = (sizes(ip) + nb_split-1) / nb_split
570 maxsize_parts_loc_new = max(maxsize_parts_loc_new,
571 & sz_final)
572 DO i=partptr(ip), partptr(ip+1)-1, sz_final
573 nb_parts_with_split = nb_parts_with_split +1
574 DO ii=i, min(i+sz_final-1,partptr(ip+1)-1)
575 lrgroups(sep(ii)) = lrgroups_sign*(nb_parts_with_split
576 & + nbgroups)
577 ENDDO
578 ENDDO
579 ENDDO
580 nbgroups = nbgroups + nb_parts_with_split
581!$OMP END CRITICAL(lrgrouping_cri)
582 nparts = nb_parts_with_split
583 maxsize_parts_loc = maxsize_parts_loc_new
584 ENDIF
585#endif
586 DEALLOCATE(newsep,sizes,rightpart,partptr)
587 END SUBROUTINE get_global_groups
588 SUBROUTINE gethalonodes(N, IW, LW, IPE, IND, NIND, PMAX,
589 & NHALO, TRACE, WORKH, NODE, LEN, CNT,
590 & GEN2HALO)
591 INTEGER,DIMENSION(:),INTENT(IN) :: IND
592 INTEGER(8), INTENT(IN) :: LW
593 INTEGER, INTENT(IN) :: N, NODE
594 INTEGER, INTENT(IN) :: IW(LW), LEN(N)
595 INTEGER(8), INTENT(IN) :: IPE(N+1)
596 INTEGER, INTENT(IN) :: PMAX,NIND
597 INTEGER, INTENT(OUT) :: NHALO
598 INTEGER, INTENT(INOUT) :: TRACE(N), WORKH(N)
599 INTEGER :: GEN2HALO(N)
600 INTEGER(8), INTENT(OUT) :: CNT
601 INTEGER :: DEPTH, I, LAST_LVL_START
602 INTEGER :: HALOI
603 INTEGER(8) :: J
604 workh(1:nind) = ind
605 last_lvl_start = 1
606 nhalo = nind
607 cnt = 0
608 DO i=1,nind
609 haloi = workh(i)
610 gen2halo(haloi) = i
611 IF (trace(haloi) .NE. node) THEN
612 trace(haloi) = node
613 END IF
614 DO j=ipe(haloi),ipe(haloi+1)-1
615 IF (trace(iw(j)).EQ.node) THEN
616 cnt = cnt + 2
617 END IF
618 END DO
619 END DO
620 DO depth=1,pmax
621 CALL neighborhood(workh, nhalo, n, iw, lw, ipe,
622 & trace, node, len, cnt, last_lvl_start,
623 & depth, pmax, gen2halo)
624 END DO
625 END SUBROUTINE gethalonodes
626 SUBROUTINE neighborhood(HALO, NHALO, N, IW, LW, IPE,
627 & TRACE, NODE, LEN, CNT, LAST_LVL_START,
628 & DEPTH, PMAX, GEN2HALO)
629 INTEGER, INTENT(IN) :: N, NODE, DEPTH, PMAX
630 INTEGER,INTENT(INOUT) :: NHALO, GEN2HALO(N)
631 INTEGER, INTENT(INOUT) :: LAST_LVL_START
632 INTEGER(8), INTENT(INOUT) :: CNT
633 INTEGER,DIMENSION(:),INTENT(INOUT) :: HALO
634 INTEGER(8), INTENT(IN) :: LW
635 INTEGER(8), INTENT(IN) :: IPE(N+1)
636 INTEGER, TARGET, INTENT(IN) :: IW(LW)
637 INTEGER, INTENT(IN) :: LEN(N)
638 INTEGER,DIMENSION(:) :: TRACE
639 INTEGER :: AvgDens, THRESH
640 INTEGER :: I,INEI,NADJI,NEWNHALO, NEIGH
641 INTEGER, DIMENSION(:), POINTER :: ADJI
642 INTEGER(8) :: J
643 newnhalo = 0
644 avgdens = nint(dble(ipe(n+1)-1_8)/dble(n))
645 thresh = avgdens*10
646 DO i=last_lvl_start,nhalo
647 nadji = len(halo(i))
648 IF (nadji.GT.thresh) cycle
649 adji => iw(ipe(halo(i)):ipe(halo(i)+1)-1)
650 DO inei=1,nadji
651 IF (trace(adji(inei)) .NE. node) THEN
652 neigh = adji(inei)
653 IF (len(neigh).GT.thresh) cycle
654 trace(neigh) = node
655 newnhalo = newnhalo + 1
656 halo(nhalo+newnhalo) = neigh
657 gen2halo(neigh) = nhalo + newnhalo
658 DO j=ipe(neigh),ipe(neigh+1)-1
659 IF (trace(iw(j)).EQ.node) THEN
660 cnt = cnt + 2
661 END IF
662 END DO
663 END IF
664 END DO
665 END DO
666 last_lvl_start = nhalo + 1
667 nhalo = nhalo + newnhalo
668 END SUBROUTINE neighborhood
669 SUBROUTINE gethalograph(HALO,NHALO,N,IW,LW,IPE,IPTRHALO,JCNHALO,
670 & HALOEDGENBR,TRACE,NODE, GEN2HALO)
671 INTEGER, INTENT(IN) :: N
672 INTEGER,INTENT(IN):: NHALO, NODE
673 INTEGER,INTENT(IN):: GEN2HALO(N)
674 INTEGER,DIMENSION(NHALO),INTENT(IN) :: HALO
675 INTEGER(8), INTENT(IN) :: LW
676 INTEGER(8), INTENT(IN) :: IPE(N+1)
677 INTEGER, INTENT(IN) :: IW(LW), TRACE(N)
678 INTEGER(8),INTENT(IN) :: HALOEDGENBR
679 INTEGER(8), INTENT(OUT) :: IPTRHALO(NHALO+1)
680 INTEGER, INTENT(OUT) :: JCNHALO(HALOEDGENBR)
681 INTEGER::I,IPTR_CNT,JCN_CNT,HALOI
682 INTEGER(8) :: J, CNT
683 cnt = 0
684 iptr_cnt = 2
685 jcn_cnt = 1
686 iptrhalo(1) = 1
687 DO i=1,nhalo
688 haloi = halo(i)
689 DO j=ipe(haloi),ipe(haloi+1)-1
690 IF (trace(iw(j))==node) THEN
691 cnt = cnt + 1
692 jcnhalo(jcn_cnt) = gen2halo(iw(j))
693 jcn_cnt = jcn_cnt + 1
694 END IF
695 END DO
696 iptrhalo(iptr_cnt) = cnt + 1
697 iptr_cnt = iptr_cnt + 1
698 END DO
699 END SUBROUTINE gethalograph
700 SUBROUTINE get_groups(NHALO,PARTS,SEP,NSEP,NPARTS,
701 & CUT,NEWSEP,PERM,IPERM)
702 INTEGER,INTENT(IN) :: NHALO,NSEP
703 INTEGER,DIMENSION(:),INTENT(IN) :: SEP
704 INTEGER,POINTER,DIMENSION(:)::PARTS
705 INTEGER,POINTER,DIMENSION(:)::CUT,NEWSEP,PERM,
706 & iperm
707 INTEGER,INTENT(INOUT) :: NPARTS
708 INTEGER::I,CNT,NB_PARTS_WITHOUT_SEP_NODE,allocok
709 INTEGER,DIMENSION(:),ALLOCATABLE::SIZES
710 INTEGER,DIMENSION(:),ALLOCATABLE::PARTPTR
711 ALLOCATE(newsep(nsep),stat=allocok)
712 IF(allocok.GT.0) THEN
713 write(*,*) "Allocation error in GET_GROUPS"
714 CALL mumps_abort()
715 ENDIF
716 ALLOCATE(perm(nsep),stat=allocok)
717 IF(allocok.GT.0) THEN
718 write(*,*) "Allocation error in GET_GROUPS"
719 CALL mumps_abort()
720 ENDIF
721 ALLOCATE(iperm(nsep),stat=allocok)
722 IF(allocok.GT.0) THEN
723 write(*,*) "Allocation error in GET_GROUPS"
724 CALL mumps_abort()
725 ENDIF
726 ALLOCATE(sizes(nparts),stat=allocok)
727 IF(allocok.GT.0) THEN
728 write(*,*) "Allocation error in GET_GROUPS"
729 CALL mumps_abort()
730 ENDIF
731 ALLOCATE(partptr(nparts+1),stat=allocok)
732 IF(allocok.GT.0) THEN
733 write(*,*) "Allocation error in GET_GROUPS"
734 CALL mumps_abort()
735 ENDIF
736 nb_parts_without_sep_node = 0
737 sizes = 0
738 DO i=1,nsep
739 sizes(parts(i)) =
740 & sizes(parts(i))+1
741 END DO
742 partptr(1)=1
743 DO i=2,nparts+1
744 partptr(i) = partptr(i-1) + sizes(i-1)
745 IF (sizes(i-1)==0) THEN
746 nb_parts_without_sep_node = nb_parts_without_sep_node + 1
747 END IF
748 END DO
749 ALLOCATE(cut(nparts-nb_parts_without_sep_node+1),stat=allocok)
750 IF(allocok.GT.0) THEN
751 write(*,*) "Allocation error in GET_GROUPS"
752 CALL mumps_abort()
753 ENDIF
754 cut(1) = 1
755 cnt = 2
756 DO i=2,nparts+1
757 IF (sizes(i-1).NE.0) THEN
758 cut(cnt) = partptr(i)
759 cnt = cnt + 1
760 END IF
761 END DO
762 nparts = nparts - nb_parts_without_sep_node
763 cut(nparts+1) = nsep+1
764 DO i=1,nsep
765 newsep(partptr(parts(i))) = sep(i)
766 perm(partptr(parts(i))) = i
767 iperm(i) = partptr(parts(i))
768 partptr(parts(i)) =
769 & partptr(parts(i)) + 1
770 END DO
771 DEALLOCATE(sizes,partptr)
772 END SUBROUTINE get_groups
773 SUBROUTINE zmumps_lr_grouping(N, NZ8, NSTEPS, IRN, JCN, FILS,
774 & FRERE_STEPS, DAD_STEPS, NE_STEPS, STEP, NA, LNA,
775 & LRGROUPS, SYM, ICNTL, HALO_DEPTH, GROUP_SIZE, SEP_SIZE,
776 & K38, K20, K60,
777 & IFLAG, IERROR, K264, K265, K482, K472, MAXFRONT, K10,
778 & K54, K142, LPOK, LP, GATHER_MATRIX_ALLOCATED)
779 IMPLICIT NONE
780 INTEGER, INTENT(IN) :: N, NSTEPS, LNA, SYM,
781 & halo_depth, sep_size, group_size
782 INTEGER(8), INTENT(IN) :: NZ8
783 INTEGER, INTENT(INOUT) :: IFLAG, IERROR
784 INTEGER, INTENT(INOUT) :: K38, K20, K264, K265
785 INTEGER, INTENT(IN) :: K482, K10, K60, K54
786 INTEGER, INTENT(IN) :: LP
787 INTEGER, INTENT(OUT) :: K142
788 LOGICAL, INTENT(IN) :: LPOK
789 INTEGER, POINTER, DIMENSION(:) :: IRN, JCN
790 INTEGER, INTENT(IN) :: NE_STEPS(:), ICNTL(60)
791 INTEGER :: FILS(:), FRERE_STEPS(:), STEP(:),
792 & na(:), dad_steps(:), lrgroups(:)
793 INTEGER, INTENT(IN) :: K472, MAXFRONT
794 LOGICAL, INTENT(INOUT) :: GATHER_MATRIX_ALLOCATED
795 INTEGER :: K482_LOC, K38ou20
796 INTEGER :: I, F, PV, NV, NLEAVES, NROOTS, PP, C, NF, NODE,
797 & symtry, nbqd, ad
798 INTEGER(8) :: LW, IWFR, NRORM, NIORM
799 INTEGER :: LPTR, RPTR, NBGROUPS
800 LOGICAL :: FIRST
801 INTEGER, ALLOCATABLE, DIMENSION (:) :: POOL, PVS, WORK
802 INTEGER, ALLOCATABLE, DIMENSION (:) :: LEN, IW
803 INTEGER(8), ALLOCATABLE, DIMENSION (:) :: IPE, IQ
804 INTEGER, ALLOCATABLE, DIMENSION (:) :: TRACE, WORKH, GEN2HALO
805 INTEGER :: STEP_SCALAPACK_ROOT
806 INTEGER :: GROUP_SIZE2, IERR
807 LOGICAL :: INPLACE64_GRAPH_COPY
808 k38ou20=max(k38,k20)
809 IF (k38ou20.GT.0) THEN
810 step_scalapack_root = step(k38ou20)
811 ELSE
812 step_scalapack_root = 0
813 ENDIF
814 IF((k482.LE.0) .OR. (k482.GT.3)) THEN
815#if defined(parmetis) || defined(metis) || defined(parmetis3) || defined(metis4)
816 k482_loc = 1
817#elif defined(ptscotch) || defined(scotch)
818 k482_loc = 2
819#else
820 k482_loc = 3
821#endif
822 ELSE IF (k482.EQ.1) THEN
823#if !defined(parmetis) && !defined(metis) && !defined(parmetis3) && !defined(metis4)
824#if defined(ptscotch) || defined(scotch)
825 k482_loc = 2
826#else
827 k482_loc = 3
828#endif
829#else
830 k482_loc = 1
831#endif
832 ELSE IF (k482.EQ.2) THEN
833#if !defined(ptscotch) && !defined(scotch)
834#if defined(parmetis) || defined(metis) || defined(parmetis3) || defined(metis4)
835 k482_loc = 1
836#else
837 k482_loc = 3
838#endif
839#else
840 k482_loc = 2
841#endif
842 ELSE IF (k482.EQ.3) THEN
843 k482_loc = 3
844 END IF
845 nbgroups = 0
846 IF (k265.EQ.-1) THEN
847 lw = nz8
848 ELSE
849 lw = 2_8 * nz8
850 ENDIF
851 ALLOCATE(iw(lw), ipe(n+1), len(n), iq(n),
852 & pool(na(1)), pvs(nsteps),
853 & stat=ierr)
854 IF (ierr.GT.0) THEN
855 IF (lpok) WRITE(lp,*) " Error allocate integer array of size: ",
856 * lw+int(n,8)+int(k10*(2*n+1),8)
857 iflag = -7
858 CALL mumps_set_ierror(lw+int(n,8)+int(k10*(2*n+1),8),ierror)
859 GOTO 500
860 ENDIF
861 CALL zmumps_ana_gnew(n, nz8, irn(1), jcn(1), iw(1), lw, ipe(1),
862 & len(1), iq(1), lrgroups(1), iwfr, nrorm, niorm,
863 & iflag, ierror,
864 & icntl(1) , symtry, sym, nbqd, ad, k264, k265,.false.,
865 & inplace64_graph_copy)
866 IF (k54.EQ.3) THEN
867 deallocate(irn)
868 deallocate(jcn)
869 NULLIFY(irn)
870 NULLIFY(jcn)
871 gather_matrix_allocated = .false.
872 ENDIF
873 IF (allocated(iq)) DEALLOCATE(iq)
874 lrgroups = -1
875 nleaves = na(1)
876 nroots = na(2)
877 lptr = 2+nleaves
878 rptr = 2+nleaves+nroots
879 DO i = 1, nroots
880 pool(i) = na(2+nleaves+i)
881 END DO
882 pp = nroots
883 ALLOCATE(work(maxfront), trace(n), workh(n), gen2halo(n),
884 & stat=ierr)
885 IF (ierr.GT.0) THEN
886 IF (lpok) WRITE(lp,*) " Error allocate integer array of size: ",
887 * 3*n+maxfront
888 iflag = -7
889 ierror = 3*n+maxfront
890 RETURN
891 ENDIF
892 trace = 0
893 k142 = 0
894 DO WHILE(pp .GT. 0)
895 pv = abs(pool(pp))
896 node = step(pv)
897 first = pool(pp) .LT. 0
898 nv = 0
899 f = pv
900 DO WHILE(f .GT. 0)
901 nv = nv+1
902 work(nv) = f
903 f = fils(f)
904 END DO
905 CALL compute_blr_vcs(k472, group_size2, group_size, nv)
906 IF (nv .GE. group_size2) THEN
907 IF ( (k482_loc.EQ.3)
908 & .OR.
909 & ( (k60.NE.0).AND.(work(1).EQ.k38ou20) )
910 & )
911 & THEN
912 DO i=1,nv
913 lrgroups(work(i))=nbgroups+1+(i-1)/group_size2
914 END DO
915 nbgroups = nbgroups + (nv-1)/group_size2 + 1
916 ELSE
917 CALL sep_grouping(nv, work(1), n, nz8,
918 & lrgroups, nbgroups, iw(1), lw, ipe(1), len(1),
919 & group_size, halo_depth, trace(1), workh(1), node,
920 & gen2halo(1), k482_loc, k472, 0, sep_size, k142,
921 & k10, lp, lpok, iflag, ierror)
922 IF (iflag.LT.0) GOTO 500
923 END IF
924 ELSE
925 IF (nv .GE. sep_size) THEN
926 DO i = 1, nv
927 lrgroups( work(i) ) = (nbgroups + 1)
928 ENDDO
929 ELSE
930 DO i = 1, nv
931 lrgroups( work(i) ) = -(nbgroups + 1)
932 ENDDO
933 ENDIF
934 nbgroups = nbgroups + 1
935 ENDIF
936 CALL mumps_upd_tree(nv, nsteps, n, first, lptr, rptr, f,
937 & work(1),
938 & fils, frere_steps, step, dad_steps,
939 & ne_steps, na, lna, pvs(1), k38ou20,
940 & step_scalapack_root)
941 IF (step_scalapack_root.GT.0) THEN
942 IF (k38.GT.0) THEN
943 k38 = k38ou20
944 ELSE
945 k20 = k38ou20
946 ENDIF
947 ENDIF
948 pp = pp-1
949 nf = ne_steps(node)
950 IF(nf .GT. 0) THEN
951 pp = pp+1
952 pool(pp) = f
953 c = step(-f)
954 f = frere_steps(c)
955 DO WHILE(f .GT. 0)
956 pp = pp+1
957 pool(pp) = f
958 c = step(f)
959 f = frere_steps(c)
960 END DO
961 END IF
962 END DO
963 500 IF (allocated(pool)) DEALLOCATE(pool)
964 IF (allocated(pvs)) DEALLOCATE(pvs)
965 IF (allocated(work)) DEALLOCATE(work)
966 IF (allocated(ipe)) DEALLOCATE(ipe)
967 IF (allocated(len)) DEALLOCATE(len)
968 IF (allocated(trace)) DEALLOCATE(trace)
969 IF (allocated(workh)) DEALLOCATE(workh)
970 IF (allocated(gen2halo)) DEALLOCATE(gen2halo)
971 RETURN
972 END SUBROUTINE zmumps_lr_grouping
973 SUBROUTINE zmumps_lr_grouping_new(N, NZ8, NSTEPS, IRN, JCN, FILS,
974 & FRERE_STEPS, DAD_STEPS, STEP, NA, LNA, LRGROUPS,
975 & SYM, ICNTL, HALO_DEPTH, GROUP_SIZE, SEP_SIZE, K38, K20,
976 & K60, IFLAG, IERROR, K264, K265, K482, K472, MAXFRONT, K469,
977 & K10, K54, K142, LPOK, LP, GATHER_MATRIX_ALLOCATED)
978 IMPLICIT NONE
979 INTEGER, INTENT(IN) :: N, NSTEPS, LNA, SYM,
980 & halo_depth, sep_size, group_size
981 INTEGER(8), INTENT(IN) :: NZ8
982 INTEGER, INTENT(INOUT) :: IFLAG, IERROR
983 INTEGER, INTENT(INOUT) :: K38, K20, K264, K265
984 INTEGER, INTENT(IN) :: K482, K10, MAXFRONT, K60, K54
985 INTEGER, INTENT(IN) :: LP
986 LOGICAL, INTENT(IN) :: LPOK
987 INTEGER, POINTER, DIMENSION(:) :: IRN, JCN
988 INTEGER, INTENT(IN) :: ICNTL(60)
989 INTEGER, POINTER :: FILS(:), FRERE_STEPS(:), STEP(:),
990 & na(:), dad_steps(:), lrgroups(:)
991 INTEGER, INTENT(IN) :: K472, K469
992 LOGICAL, INTENT(INOUT) :: GATHER_MATRIX_ALLOCATED
993 INTEGER, INTENT(OUT) :: K142
994 INTEGER :: K482_LOC, K469_LOC, K38ou20
995 INTEGER :: I, F, PV, NV, NODE,
996 & symtry, nbqd, ad
997 LOGICAL :: PVSCHANGED
998 INTEGER(8) :: LW, IWFR, NRORM, NIORM
999 INTEGER :: NBGROUPS, NBGROUPS_local
1000 INTEGER, ALLOCATABLE, DIMENSION (:) :: PVS, WORK
1001 INTEGER, ALLOCATABLE, DIMENSION (:) :: LEN, IW
1002 INTEGER(8), ALLOCATABLE, DIMENSION (:) :: IPE, IQ
1003 INTEGER, ALLOCATABLE, DIMENSION (:) :: TRACE, WORKH,
1004 & GEN2HALO
1005 INTEGER, ALLOCATABLE, DIMENSION (:) :: TRACE_PRV, WORKH_PRV,
1006 & GEN2HALO_PRV
1007 INTEGER :: STEP_SCALAPACK_ROOT
1008 INTEGER :: GROUP_SIZE2, IERR, OMP_NUM
1009 INTEGER :: IERR_PRIV
1010 LOGICAL :: INPLACE64_GRAPH_COPY
1011#if defined(ptscotch) || defined(scotch)
1012 INTEGER :: VSCOTCH
1013 LOGICAL :: SCOTCH_IS_THREAD_SAFE
1014 INTEGER :: PTHREAD_NUMBER, NOMP
1015#endif
1016 k38ou20=max(k38,k20)
1017 IF (k38ou20.GT.0) THEN
1018 step_scalapack_root = step(k38ou20)
1019 ELSE
1020 step_scalapack_root = 0
1021 ENDIF
1022 IF((k482.LE.0) .OR. (k482.GT.3)) THEN
1023#if defined(parmetis) || defined(metis) || defined(parmetis3) || defined(metis4)
1024 k482_loc = 1
1025#elif defined(ptscotch) || defined(scotch)
1026 k482_loc = 2
1027#else
1028 k482_loc = 3
1029#endif
1030 ELSE IF (k482.EQ.1) THEN
1031#if !defined(parmetis) && !defined(metis) && !defined(parmetis3) && !defined(metis4)
1032#if defined(ptscotch) || defined(scotch)
1033 k482_loc = 2
1034#else
1035 k482_loc = 3
1036#endif
1037#else
1038 k482_loc = 1
1039#endif
1040 ELSE IF (k482.EQ.2) THEN
1041#if !defined(ptscotch) && !defined(scotch)
1042#if defined(parmetis) || defined(metis) || defined(parmetis3) || defined(metis4)
1043 k482_loc = 1
1044#else
1045 k482_loc = 3
1046#endif
1047#else
1048 k482_loc = 2
1049#endif
1050 ELSE IF (k482.EQ.3) THEN
1051 k482_loc = 3
1052 END IF
1053 k469_loc = k469
1054#if defined(ptscotch) || defined(scotch)
1055 scotch_is_thread_safe = .false.
1056 IF (k482_loc.EQ.2) THEN
1057 CALL mumps_scotch_version (vscotch)
1058 IF (vscotch.GE.7) scotch_is_thread_safe=.true.
1059 ENDIF
1060 IF (k482_loc.EQ.2.AND.(.NOT.scotch_is_thread_safe) ) THEN
1061 k469_loc = 1
1062 ENDIF
1063#endif
1064 nbgroups = 0
1065 lw = 2_8 * nz8
1066 ALLOCATE(iw(lw), ipe(n+1), len(n), iq(n),
1067 & pvs(nsteps),
1068 & stat=ierr)
1069 IF (ierr.GT.0) THEN
1070 IF (lpok) WRITE(lp,*) " Error allocate integer array of size: ",
1071 * lw+int(n,8)+int(k10*(2*n+1),8)
1072 iflag = -7
1073 CALL mumps_set_ierror(lw+int(n,8)+int(k10*(2*n+1),8),ierror)
1074 GOTO 501
1075 ENDIF
1076 CALL zmumps_ana_gnew(n, nz8, irn(1), jcn(1), iw(1), lw, ipe(1),
1077 & len(1), iq(1), lrgroups(1), iwfr, nrorm, niorm,
1078 & iflag, ierror,
1079 & icntl(1) , symtry, sym, nbqd, ad, k264, k265,.false.,
1080 & inplace64_graph_copy)
1081 IF (k54.EQ.3) THEN
1082 deallocate(irn)
1083 deallocate(jcn)
1084 NULLIFY(irn)
1085 NULLIFY(jcn)
1086 gather_matrix_allocated = .false.
1087 ENDIF
1088 IF (allocated(iq)) DEALLOCATE(iq)
1089 lrgroups = -1
1090 IF (k469_loc.NE.2) THEN
1091 ALLOCATE(trace(n), workh(n), gen2halo(n),
1092 & stat=ierr)
1093 IF (ierr.GT.0) THEN
1094 IF (lpok) WRITE(lp,*) " Error allocate integer array of ",
1095 * "size: ", 3*n
1096 iflag = -7
1097 ierror = 3*n
1098 GOTO 501
1099 ENDIF
1100 ENDIF
1101#if defined(ptscotch) || defined(scotch)
1102 IF (k482_loc.EQ.2) THEN
1103 nomp=0
1104!$ NOMP=omp_get_max_threads()
1105 IF (nomp .GT. 0) THEN
1106 CALL mumps_scotch_get_pthread_number (pthread_number)
1107 nomp =1
1108 CALL mumps_scotch_set_pthread_number (nomp)
1109 ENDIF
1110 ENDIF
1111#endif
1112 k142 = 0
1113 pvschanged = .false.
1114 omp_num = 1
1115!$ OMP_NUM = omp_get_max_threads()
1116 omp_num = min(omp_num,8)
1117!$OMP PARALLEL PRIVATE(I, NODE, PV, NV, F, GROUP_SIZE2, WORK, IERR_PRIV,
1118!$OMP& WORKH_PRV, TRACE_PRV, GEN2HALO_PRV, NBGROUPS_local
1119!$OMP& )
1120!$OMP& REDUCTION( max : K142)
1121!$OMP& IF (K469_LOC.GT.1) NUM_THREADS(OMP_NUM)
1122 ALLOCATE(work(maxfront), stat=ierr_priv)
1123 IF (ierr_priv.GT.0) THEN
1124 IF (lpok) WRITE(lp,*) " Error allocate integer array of ",
1125 * "size: ", maxfront
1126!$OMP ATOMIC WRITE
1127 iflag = -7
1128!$OMP END ATOMIC
1129!$OMP ATOMIC WRITE
1130 ierror = maxfront
1131!$OMP END ATOMIC
1132 ENDIF
1133 IF (ierr_priv .EQ. 0 .AND. k469_loc.EQ.2) THEN
1134 ALLOCATE(trace_prv(n), workh_prv(n), gen2halo_prv(n),
1135 & stat=ierr_priv)
1136 IF (ierr_priv.GT.0) THEN
1137 IF (lpok) WRITE(lp,*) " Error allocate integer array of ",
1138 * "size: ", 3*n
1139!$OMP ATOMIC WRITE
1140 iflag = -7
1141!$OMP END ATOMIC
1142!$OMP ATOMIC WRITE
1143 ierror = 3*n
1144!$OMP END ATOMIC
1145 ENDIF
1146 ENDIF
1147!$OMP BARRIER
1148 IF (iflag .LT. 0 ) THEN
1149 GOTO 500
1150 ENDIF
1151 IF (k469_loc.EQ.2) THEN
1152 trace_prv = 0
1153 ELSE
1154!$OMP SINGLE
1155 trace = 0
1156!$OMP END SINGLE
1157 ENDIF
1158!$OMP DO
1159 DO i = 1,n
1160 IF (step(i).GT.0) pvs(step(i)) = i
1161 END DO
1162!$OMP END DO
1163!$OMP DO SCHEDULE(DYNAMIC,1)
1164 DO node=nsteps,1,-1
1165 IF (iflag.LT.0) cycle
1166 pv = pvs(node)
1167 nv = 0
1168 f = pv
1169 DO WHILE(f .GT. 0)
1170 nv = nv+1
1171 work(nv) = f
1172 f = fils(f)
1173 END DO
1174 CALL compute_blr_vcs(k472, group_size2, group_size, nv)
1175 IF (nv .GE. group_size2) THEN
1176 IF ( (k482_loc.EQ.3)
1177 & .OR.
1178 & ( (k60.NE.0).AND.(work(1).EQ.k38ou20) )
1179 & )
1180 & THEN
1181!$OMP CRITICAL(lrgrouping_cri)
1182 DO i=1,nv
1183 lrgroups(work(i))=nbgroups+1+(i-1)/group_size2
1184 END DO
1185 nbgroups = nbgroups + (nv-1)/group_size2 + 1
1186!$OMP END CRITICAL(lrgrouping_cri)
1187 ELSE
1188 IF (k469_loc .EQ. 2) THEN
1189 CALL sep_grouping(nv, work(1), n, nz8,
1190 & lrgroups, nbgroups, iw(1), lw, ipe(1), len(1),
1191 & group_size, halo_depth, trace_prv, workh_prv,
1192 & node, gen2halo_prv, k482_loc, k472, k469_loc,
1193 & sep_size, k142, k10, lp, lpok, iflag, ierror)
1194 ELSE
1195 CALL sep_grouping(nv, work(1), n, nz8,
1196 & lrgroups, nbgroups, iw(1), lw, ipe(1), len(1),
1197 & group_size, halo_depth, trace, workh,
1198 & node, gen2halo, k482_loc, k472, k469_loc,
1199 & sep_size, k142, k10, lp, lpok, iflag, ierror)
1200 ENDIF
1201 IF (iflag.LT.0) cycle
1202 pvs(node) = work(1)
1203!$OMP ATOMIC WRITE
1204 pvschanged = .true.
1205!$OMP END ATOMIC
1206 step(work(1)) = abs(step(work(1)))
1207 IF (step(work(1)).EQ.step_scalapack_root) THEN
1208 IF (k38.GT.0) THEN
1209 k38 = work(1)
1210 ELSE
1211 k20 = work(1)
1212 ENDIF
1213 ENDIF
1214 DO i=1, nv-1
1215 step(work(i+1)) = -step(work(1))
1216 IF (fils(work(i)).LE.0) THEN
1217 fils(work(nv)) = fils(work(i))
1218 ENDIF
1219 fils(work(i)) = work(i+1)
1220 ENDDO
1221 ENDIF
1222 ELSE
1223!$OMP CRITICAL(lrgrouping_cri)
1224 nbgroups = nbgroups + 1
1225 nbgroups_local = nbgroups
1226!$OMP END CRITICAL(lrgrouping_cri)
1227 IF (nv .GE. sep_size) THEN
1228 DO i = 1, nv
1229 lrgroups( work(i) ) = nbgroups_local
1230 ENDDO
1231 ELSE
1232 DO i = 1, nv
1233 lrgroups( work(i) ) = -nbgroups_local
1234 ENDDO
1235 ENDIF
1236 ENDIF
1237 ENDDO
1238!$OMP END DO
1239 IF (iflag.LT.0) GOTO 500
1240 IF (.NOT.pvschanged) GOTO 500
1241!$OMP DO
1242 DO node = 1,nsteps
1243 IF(frere_steps(node) .GT. 0) THEN
1244 frere_steps(node) = pvs(abs(step(frere_steps(node))))
1245 ELSE IF(frere_steps(node) .LT. 0) THEN
1246 frere_steps(node) = -pvs(abs(step(dad_steps(node))))
1247 ENDIF
1248 IF(dad_steps(node) .NE. 0) THEN
1249 dad_steps(node) = pvs(abs(step(dad_steps(node))))
1250 END IF
1251 ENDDO
1252!$OMP END DO NOWAIT
1253!$OMP DO
1254 DO i=3,lna
1255 na(i) = pvs(abs(step(na(i))))
1256 ENDDO
1257!$OMP END DO NOWAIT
1258!$OMP DO
1259 DO i=1,n
1260 IF (fils(i).LT.0) THEN
1261 fils(i) = -pvs(abs(step(-fils(i))))
1262 ENDIF
1263 ENDDO
1264!$OMP END DO
1265 500 CONTINUE
1266 IF (allocated(work)) DEALLOCATE(work)
1267 IF (k469_loc.EQ.2) THEN
1268 IF (allocated(trace_prv)) DEALLOCATE(trace_prv)
1269 IF (allocated(workh_prv)) DEALLOCATE(workh_prv)
1270 IF (allocated(gen2halo_prv)) DEALLOCATE(gen2halo_prv)
1271 ENDIF
1272!$OMP END PARALLEL
1273#if defined(ptscotch) || defined(scotch)
1274 IF (k482_loc.EQ.2.AND.nomp .GT. 0) THEN
1275 CALL mumps_scotch_set_pthread_number (pthread_number)
1276 ENDIF
1277#endif
1278 501 CONTINUE
1279 IF (k469_loc.NE.2) THEN
1280 IF (allocated(trace)) DEALLOCATE(trace)
1281 IF (allocated(workh)) DEALLOCATE(workh)
1282 IF (allocated(gen2halo)) DEALLOCATE(gen2halo)
1283 ENDIF
1284 IF (allocated(pvs)) DEALLOCATE(pvs)
1285 IF (allocated(ipe)) DEALLOCATE(ipe)
1286 IF (allocated(len)) DEALLOCATE(len)
1287 RETURN
1288 END SUBROUTINE zmumps_lr_grouping_new
1289 SUBROUTINE zmumps_ab_lr_grouping(N, MAPCOL, SIZEMAPCOL,
1290 & NSTEPS, LUMAT, FILS,
1291 & FRERE_STEPS, DAD_STEPS, STEP, NA, LNA, LRGROUPS,
1292 & SIZEOFBLOCKS, SYM, ICNTL, HALO_DEPTH, GROUP_SIZE,
1293 & SEP_SIZE, K38, K20,
1294 & K60, IFLAG, IERROR, K264, K265, K482, K472, MAXFRONT, K469,
1295 & K10, K54, K142, LPOK, LP, MYID, COMM)
1296 IMPLICIT NONE
1297 INTEGER, INTENT(IN) :: MYID, COMM
1298 TYPE(lmatrix_t) :: LUMAT
1299 INTEGER, INTENT(IN) :: N, NSTEPS, LNA, SYM,
1300 & halo_depth, sep_size, group_size
1301 INTEGER, INTENT(IN) :: SIZEMAPCOL
1302 INTEGER, INTENT(IN) :: MAPCOL(SIZEMAPCOL)
1303 INTEGER, INTENT(INOUT) :: IFLAG, IERROR
1304 INTEGER, INTENT(INOUT) :: K38, K20, K264, K265
1305 INTEGER, INTENT(IN) :: K482, K10, MAXFRONT, K60, K54
1306 INTEGER, INTENT(IN) :: LP
1307 LOGICAL, INTENT(IN) :: LPOK
1308 INTEGER, INTENT(OUT) :: K142
1309 INTEGER, INTENT(IN) :: ICNTL(60)
1310 INTEGER, POINTER :: FILS(:), FRERE_STEPS(:), STEP(:),
1311 & na(:), dad_steps(:), lrgroups(:)
1312 INTEGER, INTENT(IN) :: SIZEOFBLOCKS(N)
1313 INTEGER, INTENT(IN) :: K472, K469
1314 INTEGER :: K482_LOC, K469_LOC, K38ou20
1315 INTEGER :: I, F, PV, NV, NVEXPANDED, NODE
1316 DOUBLE PRECISION :: COMPRESS_RATIO
1317 LOGICAL :: PVSCHANGED
1318 INTEGER :: NBGROUPS, NBGROUPS_local
1319 INTEGER, ALLOCATABLE, DIMENSION (:) :: PVS, WORK
1320 INTEGER, ALLOCATABLE, DIMENSION (:) :: TRACE, WORKH,
1321 & gen2halo
1322 INTEGER, ALLOCATABLE, DIMENSION (:) :: TRACE_PRV, WORKH_PRV,
1323 & gen2halo_prv
1324 INTEGER :: STEP_SCALAPACK_ROOT
1325 INTEGER :: GROUP_SIZE2, IERR, OMP_NUM
1326 INTEGER :: IERR_PRIV
1327 LOGICAL :: MAPCOL_PROVIDED
1328#if defined(ptscotch) || defined(scotch)
1329 INTEGER :: VSCOTCH
1330 LOGICAL :: SCOTCH_IS_THREAD_SAFE
1331 INTEGER :: PTHREAD_NUMBER, NOMP
1332#endif
1333 mapcol_provided = (mapcol(1).GE.0)
1334 k38ou20=max(k38,k20)
1335 IF (k38ou20.GT.0) THEN
1336 step_scalapack_root = step(k38ou20)
1337 ELSE
1338 step_scalapack_root = 0
1339 ENDIF
1340 IF((k482.LE.0) .OR. (k482.GT.3)) THEN
1341#if defined(parmetis) || defined(metis) || defined(parmetis3) || defined(metis4)
1342 k482_loc = 1
1343#elif defined(ptscotch) || defined(scotch)
1344 k482_loc = 2
1345#else
1346 k482_loc = 3
1347#endif
1348 ELSE IF (k482.EQ.1) THEN
1349#if !defined(parmetis) && !defined(metis) && !defined(parmetis3) && !defined(metis4)
1350#if defined(ptscotch) || defined(scotch)
1351 k482_loc = 2
1352#else
1353 k482_loc = 3
1354#endif
1355#else
1356 k482_loc = 1
1357#endif
1358 ELSE IF (k482.EQ.2) THEN
1359#if !defined(ptscotch) && !defined(scotch)
1360#if defined(parmetis) || defined(metis) || defined(parmetis3) || defined(metis4)
1361 k482_loc = 1
1362#else
1363 k482_loc = 3
1364#endif
1365#else
1366 k482_loc = 2
1367#endif
1368 ELSE IF (k482.EQ.3) THEN
1369 k482_loc = 3
1370 END IF
1371 k469_loc = k469
1372#if defined(ptscotch) || defined(scotch)
1373 scotch_is_thread_safe = .false.
1374 IF (k482_loc.EQ.2) THEN
1375 CALL mumps_scotch_version (vscotch)
1376 IF (vscotch.GE.7) scotch_is_thread_safe=.true.
1377 ENDIF
1378 IF (k482_loc.EQ.2.AND.(.NOT.scotch_is_thread_safe) ) THEN
1379 k469_loc = 1
1380 ENDIF
1381#endif
1382 nbgroups = 0
1383 ALLOCATE( pvs(nsteps), stat=ierr)
1384 IF (ierr.GT.0) THEN
1385 iflag = -7
1386 ierror = nsteps
1387 IF (lpok) WRITE(lp,*) " Error allocate integer array of ",
1388 * "size: ", ierror
1389 GOTO 501
1390 ENDIF
1391 lrgroups = -1
1392 IF (k469_loc.NE.2) THEN
1393 ALLOCATE(trace(n), workh(n), gen2halo(n),
1394 & stat=ierr)
1395 IF (ierr.GT.0) THEN
1396 IF (lpok) WRITE(lp,*) " Error allocate integer array of ",
1397 * "size: ", 3*n
1398 iflag = -7
1399 ierror = 3*n
1400 GOTO 501
1401 ENDIF
1402 ENDIF
1403#if defined(ptscotch) || defined(scotch)
1404 IF (k482_loc.EQ.2) THEN
1405 nomp=0
1406!$ NOMP=omp_get_max_threads()
1407 IF (nomp .GT. 0) THEN
1408 CALL mumps_scotch_get_pthread_number (pthread_number)
1409 nomp =1
1410 CALL mumps_scotch_set_pthread_number (nomp)
1411 ENDIF
1412 ENDIF
1413#endif
1414 k142 = 0
1415 pvschanged = .false.
1416 omp_num = 1
1417!$ OMP_NUM = omp_get_max_threads()
1418 omp_num = min(omp_num,8)
1419!$OMP PARALLEL PRIVATE(I, NODE, PV, NV, F, GROUP_SIZE2, WORK, IERR_PRIV,
1420!$omp& workh_prv, trace_prv, gen2halo_prv, nbgroups_local,
1421!$OMP& NVEXPANDED, COMPRESS_RATIO
1422!$OMP& )
1423!$OMP& REDUCTION( max : K142)
1424!$OMP& IF (K469_LOC.GT.1) NUM_THREADS(OMP_NUM)
1425 ALLOCATE(work(maxfront), stat=ierr_priv)
1426 IF (ierr_priv.GT.0) THEN
1427 IF (lpok) WRITE(lp,*) " error allocate integer array of ",
1428 * "size: ", MAXFRONT
1429!$OMP ATOMIC WRITE
1430 IFLAG = -7
1431!$OMP END ATOMIC
1432!$OMP ATOMIC WRITE
1433 IERROR = MAXFRONT
1434!$OMP END ATOMIC
1435 ENDIF
1436.EQ..AND..EQ. IF (IERR_PRIV 0 K469_LOC2) THEN
1437 ALLOCATE(TRACE_PRV(N), WORKH_PRV(N), GEN2HALO_PRV(N),
1438 & STAT=IERR_PRIV)
1439.GT. IF (IERR_PRIV0) THEN
1440 IF (LPOK) WRITE(LP,*) " Error allocate integer array of ",
1441 * "size: ", 3*N
1442!$OMP ATOMIC WRITE
1443 IFLAG = -7
1444!$OMP ATOMIC WRITE
1445 IERROR = 3*N
1446 ENDIF
1447 ENDIF
1448!$OMP BARRIER
1449.LT. IF (IFLAG 0 ) THEN
1450 GOTO 500
1451 ENDIF
1452.EQ. IF (K469_LOC2) THEN
1453 TRACE_PRV = 0
1454 ELSE
1455!$OMP SINGLE
1456 TRACE = 0
1457!$OMP END SINGLE
1458 ENDIF
1459!$OMP DO
1460 DO I = 1,N
1461.GT. IF (STEP(I)0) PVS(STEP(I)) = I
1462 END DO
1463!$OMP END DO
1464!$OMP DO SCHEDULE(DYNAMIC,1)
1465 DO NODE=NSTEPS,1,-1
1466.LT. IF (IFLAG0) CYCLE
1467 IF (MAPCOL_PROVIDED) THEN
1468.NE. IF (MAPCOL(NODE)MYID) THEN
1469 PVS(NODE) = -999
1470 CYCLE
1471 ENDIF
1472 ENDIF
1473 PV = PVS(NODE)
1474 NV = 0
1475 NVEXPANDED = 0
1476 F = PV
1477.GT. DO WHILE(F 0)
1478 NV = NV+1
1479 NVEXPANDED = NVEXPANDED+SIZEOFBLOCKS(F)
1480 WORK(NV) = F
1481 F = FILS(F)
1482 END DO
1483 COMPRESS_RATIO = dble(NVEXPANDED)/dble(NV)
1484 CALL COMPUTE_BLR_VCS(K472, GROUP_SIZE2, GROUP_SIZE, NVEXPANDED)
1485.GE. IF (NVEXPANDED GROUP_SIZE2) THEN
1486.EQ. IF ( (K482_LOC3)
1487.OR. &
1488.NE..AND..EQ. & ( (K600)(WORK(1)K38ou20) )
1489 & )
1490 & THEN
1491 GROUP_SIZE2 = max(int(dble(GROUP_SIZE2)/COMPRESS_RATIO), 1)
1492!$OMP CRITICAL(lrgrouping_cri)
1493 DO I=1,NV
1494 LRGROUPS(WORK(I))=NBGROUPS+1+(I-1)/GROUP_SIZE2
1495 END DO
1496 NBGROUPS = NBGROUPS + (NV-1)/GROUP_SIZE2 + 1
1497!$OMP END CRITICAL(lrgrouping_cri)
1498 ELSE
1499.EQ. IF (K469_LOC 2) THEN
1500 CALL SEP_GROUPING_AB(NV, NVEXPANDED, WORK(1), N,
1501 & LRGROUPS, NBGROUPS, LUMAT, SIZEOFBLOCKS,
1502 & GROUP_SIZE, HALO_DEPTH, TRACE_PRV, WORKH_PRV,
1503 & NODE, GEN2HALO_PRV, K482_LOC, K472, K469_LOC,
1504 & SEP_SIZE, K142, K10, LP, LPOK, IFLAG, IERROR)
1505 ELSE
1506 CALL SEP_GROUPING_AB(NV, NVEXPANDED, WORK(1), N,
1507 & LRGROUPS, NBGROUPS, LUMAT, SIZEOFBLOCKS,
1508 & GROUP_SIZE, HALO_DEPTH, TRACE, WORKH,
1509 & NODE, GEN2HALO, K482_LOC, K472, K469_LOC,
1510 & SEP_SIZE, K142, K10, LP, LPOK, IFLAG, IERROR)
1511 ENDIF
1512.LT. IF (IFLAG0) CYCLE
1513 PVS(NODE) = WORK(1)
1514!$OMP ATOMIC WRITE
1515 PVSCHANGED = .TRUE.
1516!$OMP END ATOMIC
1517 STEP(WORK(1)) = ABS(STEP(WORK(1)))
1518.EQ. IF (STEP(WORK(1))STEP_SCALAPACK_ROOT) THEN
1519.GT. IF (K380) THEN
1520 K38 = WORK(1)
1521 ELSE
1522 K20 = WORK(1)
1523 ENDIF
1524 ENDIF
1525 DO I=1, NV-1
1526 STEP(WORK(I+1)) = -STEP(WORK(1))
1527.LE. IF (FILS(WORK(I))0) THEN
1528 FILS(WORK(NV)) = FILS(WORK(I))
1529 ENDIF
1530 FILS(WORK(I)) = WORK(I+1)
1531 ENDDO
1532 ENDIF
1533 ELSE
1534!$OMP CRITICAL(lrgrouping_cri)
1535 NBGROUPS = NBGROUPS + 1
1536 NBGROUPS_local = NBGROUPS
1537!$OMP END CRITICAL(lrgrouping_cri)
1538.GE. IF (NVEXPANDED SEP_SIZE) THEN
1539 DO I = 1, NV
1540 LRGROUPS( WORK(I) ) = NBGROUPS_local
1541 ENDDO
1542 ELSE
1543 DO I = 1, NV
1544 LRGROUPS( WORK(I) ) = -NBGROUPS_local
1545 ENDDO
1546 ENDIF
1547 ENDIF
1548 ENDDO
1549!$OMP END DO
1550.LT. IF (IFLAG0) GOTO 500
1551.NOT. IF (PVSCHANGED) GOTO 500
1552!$OMP DO
1553 DO NODE = 1,NSTEPS
1554.GT. IF(FRERE_STEPS(NODE) 0) THEN
1555 FRERE_STEPS(NODE) = PVS(ABS(STEP(FRERE_STEPS(NODE))))
1556.LT. ELSE IF(FRERE_STEPS(NODE) 0) THEN
1557 FRERE_STEPS(NODE) = -PVS(ABS(STEP(DAD_STEPS(NODE))))
1558 ENDIF
1559.NE. IF(DAD_STEPS(NODE) 0) THEN
1560 DAD_STEPS(NODE) = PVS(ABS(STEP(DAD_STEPS(NODE))))
1561 END IF
1562 ENDDO
1563!$OMP END DO NOWAIT
1564!$OMP DO
1565 DO I=3,LNA
1566 NA(I) = PVS(ABS(STEP(NA(I))))
1567 ENDDO
1568!$OMP END DO NOWAIT
1569!$OMP DO
1570 DO I=1,N
1571.LT. IF (FILS(I)0) THEN
1572 FILS(I) = -PVS(ABS(STEP(-FILS(I))))
1573 ENDIF
1574 ENDDO
1575!$OMP END DO
1576 500 CONTINUE
1577 IF (allocated(WORK)) DEALLOCATE(WORK)
1578.EQ. IF (K469_LOC2) THEN
1579 IF (allocated(TRACE_PRV)) DEALLOCATE(TRACE_PRV)
1580 IF (allocated(WORKH_PRV)) DEALLOCATE(WORKH_PRV)
1581 IF (allocated(GEN2HALO_PRV)) DEALLOCATE(GEN2HALO_PRV)
1582 ENDIF
1583!$OMP END PARALLEL
1584#if defined(ptscotch) || defined(scotch)
1585.EQ..AND..GT. IF (K482_LOC2NOMP 0) THEN
1586 CALL MUMPS_SCOTCH_SET_PTHREAD_NUMBER (PTHREAD_NUMBER)
1587 ENDIF
1588#endif
1589 501 CONTINUE
1590.NE. IF (K469_LOC2) THEN
1591 IF (allocated(TRACE)) DEALLOCATE(TRACE)
1592 IF (allocated(WORKH)) DEALLOCATE(WORKH)
1593 IF (allocated(GEN2HALO)) DEALLOCATE(GEN2HALO)
1594 ENDIF
1595 IF (allocated(PVS)) DEALLOCATE(PVS)
1596 RETURN
1597 END SUBROUTINE ZMUMPS_AB_LR_GROUPING
1598 SUBROUTINE ZMUMPS_AB_LR_MPI_GROUPING(
1599 & N, MAPCOL, SIZEMAPCOL,
1600 & NSTEPS, LUMAT, FILS,
1601 & FRERE_STEPS, DAD_STEPS, STEP, NA, LNA, LRGROUPS,
1602 & SIZEOFBLOCKS, SYM, ICNTL, HALO_DEPTH, GROUP_SIZE,
1603 & SEP_SIZE, K38, K20,
1604 & K60, IFLAG, IERROR, K264, K265, K482, K472, MAXFRONT, K469,
1605 & K10, K54, K142, LPOK, LP,
1606 & COMM, MYID, NPROCS
1607 & )
1608 IMPLICIT NONE
1609 INCLUDE 'mpif.h'
1610 INCLUDE 'mumps_tags.h'
1611 INTEGER :: IERR_MPI, MASTER
1612 PARAMETER( MASTER = 0 )
1613 INTEGER :: STATUS(MPI_STATUS_SIZE)
1614 INTEGER, INTENT(IN) :: MYID, COMM, NPROCS
1615 TYPE(LMATRIX_T) :: LUMAT
1616 INTEGER, INTENT(IN) :: N, NSTEPS, LNA, SYM,
1617 & HALO_DEPTH, SEP_SIZE, GROUP_SIZE
1618 INTEGER, INTENT(IN) :: SIZEMAPCOL
1619 INTEGER, INTENT(IN) :: MAPCOL(SIZEMAPCOL)
1620 INTEGER, INTENT(INOUT) :: IFLAG, IERROR
1621 INTEGER, INTENT(INOUT) :: K38, K20, K264, K265
1622 INTEGER, INTENT(IN) :: K482, K10, MAXFRONT, K60, K54
1623 INTEGER, INTENT(IN) :: LP
1624 LOGICAL, INTENT(IN) :: LPOK
1625 INTEGER, INTENT(OUT) :: K142
1626 INTEGER, INTENT(IN) :: ICNTL(60)
1627 INTEGER, POINTER :: FILS(:), FRERE_STEPS(:), STEP(:),
1628 & NA(:), DAD_STEPS(:), LRGROUPS(:)
1629 INTEGER, INTENT(IN) :: SIZEOFBLOCKS(N)
1630 INTEGER, INTENT(IN) :: K472, K469
1631 INTEGER :: K482_LOC, K469_LOC, K38ou20, K142_GLOB
1632 INTEGER :: I, F, PV, NV, NVEXPANDED, NODE
1633 DOUBLE PRECISION :: COMPRESS_RATIO
1634 LOGICAL :: PVSCHANGED
1635 INTEGER :: PVSCHANGED_INT, PVSCHANGED_INT_GLOB, IPROC
1636 INTEGER :: NBGROUPS, NBGROUPS_local
1637 INTEGER, ALLOCATABLE, DIMENSION (:) :: PVS, WORK
1638 INTEGER :: NBGROUPS_sent
1639 INTEGER :: NBNODES_LOC, SIZE_SENT, ISHIFT,
1640 & MSGSOU, ILOOP
1641 INTEGER, ALLOCATABLE, DIMENSION (:) :: TRACE, WORKH,
1642 & GEN2HALO
1643 INTEGER, ALLOCATABLE, DIMENSION (:) :: TRACE_PRV, WORKH_PRV,
1644 & GEN2HALO_PRV
1645 INTEGER :: STEP_SCALAPACK_ROOT
1646 INTEGER :: GROUP_SIZE2, IERR, OMP_NUM
1647 INTEGER :: IERR_PRIV
1648 LOGICAL :: MAPCOL_PROVIDED
1649#if defined(ptscotch) || defined(scotch)
1650 INTEGER :: VSCOTCH
1651 LOGICAL :: SCOTCH_IS_THREAD_SAFE
1652 INTEGER :: PTHREAD_NUMBER, NOMP
1653#endif
1654.GE. MAPCOL_PROVIDED = (MAPCOL(1)0)
1655 K38ou20=max(K38,K20)
1656.GT. IF (K38ou200) THEN
1657 STEP_SCALAPACK_ROOT = STEP(K38ou20)
1658 ELSE
1659 STEP_SCALAPACK_ROOT = 0
1660 ENDIF
1661 IF (MAPCOL_PROVIDED) THEN
1662 CALL MPI_BCAST( FILS(1), N, MPI_INTEGER,
1663 & MASTER, COMM, IERR )
1664 ENDIF
1665.LE..OR..GT. IF((K4820) (K4823)) THEN
1666#if defined(parmetis) || defined(metis) || defined(parmetis3) || defined(metis4)
1667 K482_LOC = 1
1668#elif defined(ptscotch) || defined(scotch)
1669 K482_LOC = 2
1670#else
1671 K482_LOC = 3
1672#endif
1673.EQ. ELSE IF (K4821) THEN
1674#if !defined(parmetis) && !defined(metis) && !defined(parmetis3) && !defined(metis4)
1675#if defined(ptscotch) || defined(scotch)
1676 K482_LOC = 2
1677#else
1678 K482_LOC = 3
1679#endif
1680#else
1681 K482_LOC = 1
1682#endif
1683.EQ. ELSE IF (K4822) THEN
1684#if !defined(ptscotch) && !defined(scotch)
1685#if defined(parmetis) || defined(metis) || defined(parmetis3) || defined(metis4)
1686 K482_LOC = 1
1687#else
1688 K482_LOC = 3
1689#endif
1690#else
1691 K482_LOC = 2
1692#endif
1693.EQ. ELSE IF (K4823) THEN
1694 K482_LOC = 3
1695 END IF
1696 K469_LOC = K469
1697#if defined(ptscotch) || defined(scotch)
1698 SCOTCH_IS_THREAD_SAFE = .FALSE.
1699.EQ. IF (K482_LOC2) THEN
1700 CALL MUMPS_SCOTCH_VERSION (VSCOTCH)
1701.GE. IF (VSCOTCH7) SCOTCH_IS_THREAD_SAFE=.TRUE.
1702 ENDIF
1703.EQ..AND..NOT. IF (K482_LOC2(SCOTCH_IS_THREAD_SAFE) ) THEN
1704 K469_LOC = 1
1705 ENDIF
1706#endif
1707 NBGROUPS = 0
1708 K142 = 0
1709 ALLOCATE( PVS(NSTEPS), STAT=IERR)
1710.GT. IF (IERR0) THEN
1711 IFLAG = -7
1712 IERROR = NSTEPS
1713 IF (LPOK) WRITE(LP,*) " Error allocate integer array of ",
1714 * "size: ", IERROR
1715 GOTO 491
1716 ENDIF
1717 LRGROUPS = -1
1718.NE. IF (K469_LOC2) THEN
1719 ALLOCATE(TRACE(N), WORKH(N), GEN2HALO(N),
1720 & STAT=IERR)
1721.GT. IF (IERR0) THEN
1722 IF (LPOK) WRITE(LP,*) " Error allocate integer array of ",
1723 * "size: ", 3*N
1724 IFLAG = -7
1725 IERROR = 3*N
1726 GOTO 491
1727 ENDIF
1728 ENDIF
1729491 CONTINUE
1730 CALL MUMPS_PROPINFO( ICNTL(1), IFLAG,
1731 & COMM, MYID )
1732.LT. IF (IFLAG0) GOTO 501
1733#if defined(ptscotch) || defined(scotch)
1734 NOMP=0
1735.EQ. IF (K482_LOC2) THEN
1736!$ NOMP=omp_get_max_threads()
1737.GT. IF (NOMP 0) THEN
1738 CALL MUMPS_SCOTCH_GET_PTHREAD_NUMBER (PTHREAD_NUMBER)
1739 NOMP =1
1740 CALL MUMPS_SCOTCH_SET_PTHREAD_NUMBER (NOMP)
1741 ENDIF
1742 ENDIF
1743#endif
1744 K142 = 0
1745 PVSCHANGED = .FALSE.
1746 OMP_NUM = 1
1747!$ OMP_NUM = omp_get_max_threads()
1748 OMP_NUM = min(OMP_NUM,8)
1749!$OMP PARALLEL PRIVATE(I, NODE, PV, NV, F, GROUP_SIZE2, WORK, IERR_PRIV,
1750!$OMP& WORKH_PRV, TRACE_PRV, GEN2HALO_PRV, NBGROUPS_local,
1751!$OMP& NVEXPANDED, COMPRESS_RATIO, IPROC
1752!$OMP& )
1753!$OMP& REDUCTION( max : K142)
1754.GT.!$OMP& IF (K469_LOC1) NUM_THREADS(OMP_NUM)
1755 ALLOCATE(WORK(2*MAXFRONT+1), STAT=IERR_PRIV)
1756.GT. IF (IERR_PRIV0) THEN
1757 IF (LPOK) WRITE(LP,*) " Error allocate integer array of ",
1758 * "size: ", 2*MAXFRONT+1
1759!$OMP ATOMIC WRITE
1760 IFLAG = -7
1761!$OMP END ATOMIC
1762!$OMP ATOMIC WRITE
1763 IERROR = 2*MAXFRONT+1
1764!$OMP END ATOMIC
1765 ENDIF
1766.EQ..AND..EQ. IF (IERR_PRIV 0 K469_LOC2) THEN
1767 ALLOCATE(TRACE_PRV(N), WORKH_PRV(N), GEN2HALO_PRV(N),
1768 & STAT=IERR_PRIV)
1769.GT. IF (IERR_PRIV0) THEN
1770 IF (LPOK) WRITE(LP,*) " Error allocate integer array of ",
1771 * "size: ", 3*N
1772!$OMP ATOMIC WRITE
1773 IFLAG = -7
1774!$OMP END ATOMIC
1775!$OMP ATOMIC WRITE
1776 IERROR = 3*N
1777!$OMP END ATOMIC
1778 ENDIF
1779 ENDIF
1780!$OMP BARRIER
1781.LT. IF (IFLAG 0 ) THEN
1782 GOTO 498
1783 ENDIF
1784.EQ. IF (K469_LOC2) THEN
1785 TRACE_PRV = 0
1786 ELSE
1787!$OMP SINGLE
1788 TRACE = 0
1789!$OMP END SINGLE
1790 ENDIF
1791!$OMP DO
1792 DO I = 1,N
1793.GT. IF (STEP(I)0) PVS(STEP(I)) = I
1794 END DO
1795!$OMP END DO
1796!$OMP DO SCHEDULE(DYNAMIC,1)
1797 DO NODE=NSTEPS,1,-1
1798.LT. IF (IFLAG0) CYCLE
1799 IF (MAPCOL_PROVIDED) THEN
1800 IPROC = MAPCOL(NODE)
1801.NE. IF (IPROCMYID) THEN
1802 PVS(NODE) = -999
1803 CYCLE
1804 ENDIF
1805 ENDIF
1806 PV = PVS(NODE)
1807 NV = 0
1808 NVEXPANDED = 0
1809 F = PV
1810.GT. DO WHILE(F 0)
1811 NV = NV+1
1812 NVEXPANDED = NVEXPANDED+SIZEOFBLOCKS(F)
1813 WORK(NV) = F
1814 F = FILS(F)
1815 END DO
1816 COMPRESS_RATIO = dble(NVEXPANDED)/dble(NV)
1817 CALL COMPUTE_BLR_VCS(K472, GROUP_SIZE2, GROUP_SIZE, NVEXPANDED)
1818.GE. IF (NVEXPANDED GROUP_SIZE2) THEN
1819.EQ. IF ( (K482_LOC3)
1820.OR. &
1821.NE..AND..EQ. & ( (K600)(WORK(1)K38ou20) )
1822 & )
1823 & THEN
1824 GROUP_SIZE2 = max(int(dble(GROUP_SIZE2)/COMPRESS_RATIO), 1)
1825!$OMP CRITICAL(lrgrouping_cri)
1826 DO I=1,NV
1827 LRGROUPS(WORK(I))=NBGROUPS+1+(I-1)/GROUP_SIZE2
1828 END DO
1829 NBGROUPS = NBGROUPS + (NV-1)/GROUP_SIZE2 + 1
1830!$OMP END CRITICAL(lrgrouping_cri)
1831 ELSE
1832.EQ. IF (K469_LOC 2) THEN
1833 CALL SEP_GROUPING_AB(NV, NVEXPANDED, WORK(1), N,
1834 & LRGROUPS, NBGROUPS, LUMAT, SIZEOFBLOCKS,
1835 & GROUP_SIZE, HALO_DEPTH, TRACE_PRV, WORKH_PRV,
1836 & NODE, GEN2HALO_PRV, K482_LOC, K472, K469_LOC,
1837 & SEP_SIZE, K142, K10, LP, LPOK, IFLAG, IERROR)
1838 ELSE
1839 CALL SEP_GROUPING_AB(NV, NVEXPANDED, WORK(1), N,
1840 & LRGROUPS, NBGROUPS, LUMAT, SIZEOFBLOCKS,
1841 & GROUP_SIZE, HALO_DEPTH, TRACE, WORKH,
1842 & NODE, GEN2HALO, K482_LOC, K472, K469_LOC,
1843 & SEP_SIZE, K142, K10, LP, LPOK, IFLAG, IERROR)
1844 ENDIF
1845.LT. IF (IFLAG0) CYCLE
1846 PVS(NODE) = WORK(1)
1847!$OMP ATOMIC WRITE
1848 PVSCHANGED = .TRUE.
1849!$OMP END ATOMIC
1850 STEP(WORK(1)) = ABS(STEP(WORK(1)))
1851.EQ. IF (STEP(WORK(1))STEP_SCALAPACK_ROOT) THEN
1852.GT. IF (K380) THEN
1853 K38 = WORK(1)
1854 ELSE
1855 K20 = WORK(1)
1856 ENDIF
1857 ENDIF
1858 DO I=1, NV-1
1859 STEP(WORK(I+1)) = -STEP(WORK(1))
1860.LE. IF (FILS(WORK(I))0) THEN
1861 FILS(WORK(NV)) = FILS(WORK(I))
1862 ENDIF
1863 FILS(WORK(I)) = WORK(I+1)
1864 ENDDO
1865 ENDIF
1866 ELSE
1867!$OMP ATOMIC CAPTURE
1868 NBGROUPS = NBGROUPS + 1
1869 NBGROUPS_local = NBGROUPS
1870!$OMP END ATOMIC
1871.GE. IF (NVEXPANDED SEP_SIZE) THEN
1872 DO I = 1, NV
1873 LRGROUPS( WORK(I) ) = NBGROUPS_local
1874 ENDDO
1875 ELSE
1876 DO I = 1, NV
1877 LRGROUPS( WORK(I) ) = -NBGROUPS_local
1878 ENDDO
1879 ENDIF
1880 ENDIF
1881 ENDDO
1882!$OMP END DO
1883 498 CONTINUE
1884!$OMP MASTER
1885 CALL MUMPS_PROPINFO( ICNTL(1), IFLAG,
1886 & COMM, MYID )
1887!$OMP END MASTER
1888!$OMP BARRIER
1889.LT. IF (IFLAG0) GOTO 500
1890.EQ. IF (K469_LOC2) THEN
1891 IF (allocated(TRACE_PRV)) DEALLOCATE(TRACE_PRV)
1892 IF (allocated(WORKH_PRV)) DEALLOCATE(WORKH_PRV)
1893 IF (allocated(GEN2HALO_PRV)) DEALLOCATE(GEN2HALO_PRV)
1894 ENDIF
1895!$OMP MASTER
1896.NE. IF (K469_LOC2) THEN
1897 IF (allocated(WORKH)) DEALLOCATE(WORKH)
1898 IF (allocated(TRACE)) DEALLOCATE(TRACE)
1899 IF (allocated(GEN2HALO)) DEALLOCATE(GEN2HALO)
1900 ENDIF
1901!$OMP END MASTER
1902.NOT. IF (MAPCOL_PROVIDED) THEN
1903!$OMP MASTER
1904 IF (PVSCHANGED) THEN
1905 PVSCHANGED_INT_GLOB = 1
1906 ELSE
1907 PVSCHANGED_INT_GLOB = 0
1908 ENDIF
1909!$OMP END MASTER
1910 ELSE
1911!$OMP MASTER
1912 IF (PVSCHANGED) THEN
1913 PVSCHANGED_INT = 1
1914 ELSE
1915 PVSCHANGED_INT = 0
1916 ENDIF
1917 CALL MPI_ALLREDUCE( PVSCHANGED_INT, PVSCHANGED_INT_GLOB, 1,
1918 & MPI_INTEGER,
1919 & MPI_MAX, COMM, IERR_MPI )
1920 PVSCHANGED_INT_GLOB = 1
1921.NE. IF (PVSCHANGED_INT_GLOB0) THEN
1922.GT. IF (NPROCS1) THEN
1923 ALLOCATE(WORKH(2*N+3*NSTEPS+1), STAT=IERR_PRIV)
1924.GT. IF (IERR_PRIV0) THEN
1925 IF (LPOK) WRITE(LP,*)
1926 & " Error allocate integer array of ",
1927 & "size: ", 2*MAXFRONT+1
1928 IFLAG = -7
1929 IERROR = 2*N+3*NSTEPS+1
1930 ENDIF
1931 CALL MUMPS_PROPINFO( ICNTL(1), IFLAG,
1932 & COMM, MYID )
1933.LT. IF (IFLAG0) GOTO 499
1934.EQ. IF (MYIDMASTER) THEN
1935 IPROC = 0
1936.NE. DO WHILE (IPROCNPROCS-1)
1937 IPROC = IPROC + 1
1938 CALL MPI_RECV( NBNODES_LOC, 1, MPI_INTEGER,
1939 & MPI_ANY_SOURCE,
1940 & GROUPING, COMM, STATUS, IERR )
1941 MSGSOU = STATUS( MPI_SOURCE )
1942.EQ. IF (NBNODES_LOC0) THEN
1943 CYCLE
1944 ENDIF
1945 CALL MPI_RECV( NBGROUPS_sent, 1, MPI_INTEGER,
1946 & MSGSOU, GROUPING, COMM, STATUS, IERR )
1947 CALL MPI_RECV( SIZE_SENT, 1, MPI_INTEGER,
1948 & MSGSOU, GROUPING, COMM, STATUS, IERR )
1949 CALL MPI_RECV( WORKH, SIZE_SENT, MPI_INTEGER,
1950 & MSGSOU, GROUPING, COMM, STATUS, IERR )
1951 ISHIFT = 0
1952 DO ILOOP=1, NBNODES_LOC
1953 ISHIFT = ISHIFT+1
1954 NODE = WORKH (ISHIFT)
1955 ISHIFT = ISHIFT+1
1956 NV = WORKH(ISHIFT)
1957 PVS(NODE) = WORKH(ISHIFT+1)
1958 STEP(WORKH(ISHIFT+1)) = NODE
1959.EQ. IF (STEP(WORKH(ISHIFT+1))STEP_SCALAPACK_ROOT) THEN
1960.GT. IF (K380) THEN
1961 K38 = WORKH(ISHIFT+1)
1962 ELSE
1963 K20 = WORKH(ISHIFT+1)
1964 END IF
1965 END IF
1966 DO I=2, NV
1967 STEP(WORKH(I+ISHIFT)) = -NODE
1968 END DO
1969 DO I=1, NV
1970 FILS(WORKH(I+ISHIFT)) = WORKH(I+1+ISHIFT)
1971.LT. IF (WORKH(NV+1+I+ISHIFT)0) THEN
1972 LRGROUPS(WORKH(I+ISHIFT)) =
1973 & - NBGROUPS + WORKH(NV+1+I+ISHIFT)
1974 ELSE
1975 LRGROUPS(WORKH(I+ISHIFT)) =
1976 & NBGROUPS + WORKH(NV+1+I+ISHIFT)
1977 END IF
1978 END DO
1979 ISHIFT = ISHIFT + 2*NV +1
1980 END DO
1981 NBGROUPS = NBGROUPS + NBGROUPS_sent
1982 ENDDO
1983 ELSE
1984 NBNODES_LOC = 0
1985 SIZE_SENT = 0
1986 ISHIFT = 0
1987 DO NODE = 1,NSTEPS
1988 IPROC = MAPCOL(NODE)
1989.EQ. IF (IPROCMYID) THEN
1990 NBNODES_LOC = NBNODES_LOC + 1
1991 ISHIFT = ISHIFT +1
1992 WORKH(ISHIFT) = NODE
1993 ISHIFT = ISHIFT +1
1994 NV = 0
1995 F = PVS(NODE)
1996.GT. DO WHILE (F0)
1997 NV = NV + 1
1998 WORKH(NV+ISHIFT) = F
1999 F = FILS(F)
2000 ENDDO
2001 WORKH(ISHIFT) = NV
2002 WORKH(NV+1+ISHIFT) = F
2003 DO I=1, NV
2004 WORKH(NV+1+I+ISHIFT) = LRGROUPS(WORKH(I+ISHIFT))
2005 ENDDO
2006 ISHIFT = ISHIFT + 2*NV+1
2007 ENDIF
2008 ENDDO
2009 SIZE_SENT = ISHIFT
2010 CALL MPI_SEND( NBNODES_LOC, 1, MPI_INTEGER, MASTER,
2011 & GROUPING, COMM, IERR )
2012.GT. IF (NBNODES_LOC0) THEN
2013 CALL MPI_SEND( NBGROUPS, 1, MPI_INTEGER, MASTER,
2014 & GROUPING, COMM, IERR )
2015 CALL MPI_SEND( SIZE_SENT, 1, MPI_INTEGER, MASTER,
2016 & GROUPING, COMM, IERR )
2017 CALL MPI_SEND( WORKH, SIZE_SENT, MPI_INTEGER, MASTER,
2018 & GROUPING, COMM, IERR )
2019 ENDIF
2020 ENDIF
2021 ENDIF
2022 ENDIF
2023 499 CONTINUE
2024!$OMP END MASTER
2025 ENDIF
2026!$OMP BARRIER
2027.LT. IF (IFLAG0) GOTO 500
2028.EQ. IF (MYIDMASTER) THEN
2029.EQ. IF (PVSCHANGED_INT_GLOB0) GOTO 500
2030!$OMP DO
2031 DO NODE = 1,NSTEPS
2032.GT. IF(FRERE_STEPS(NODE) 0) THEN
2033 FRERE_STEPS(NODE) = PVS(ABS(STEP(FRERE_STEPS(NODE))))
2034.LT. ELSE IF(FRERE_STEPS(NODE) 0) THEN
2035 FRERE_STEPS(NODE) = -PVS(ABS(STEP(DAD_STEPS(NODE))))
2036 ENDIF
2037.NE. IF(DAD_STEPS(NODE) 0) THEN
2038 DAD_STEPS(NODE) = PVS(ABS(STEP(DAD_STEPS(NODE))))
2039 END IF
2040 ENDDO
2041!$OMP END DO NOWAIT
2042!$OMP DO
2043 DO I=3,LNA
2044 NA(I) = PVS(ABS(STEP(NA(I))))
2045 ENDDO
2046!$OMP END DO NOWAIT
2047!$OMP DO
2048 DO I=1,N
2049.LT. IF (FILS(I)0) THEN
2050 FILS(I) = -PVS(ABS(STEP(-FILS(I))))
2051 ENDIF
2052 ENDDO
2053!$OMP END DO
2054 ENDIF
2055 500 CONTINUE
2056 IF (allocated(WORK)) DEALLOCATE(WORK)
2057.EQ. IF (K469_LOC2) THEN
2058 IF (allocated(TRACE_PRV)) DEALLOCATE(TRACE_PRV)
2059 IF (allocated(WORKH_PRV)) DEALLOCATE(WORKH_PRV)
2060 IF (allocated(GEN2HALO_PRV)) DEALLOCATE(GEN2HALO_PRV)
2061 ENDIF
2062!$OMP END PARALLEL
2063 K142_GLOB = 0
2064 CALL MPI_REDUCE( K142, K142_GLOB, 1,
2065 & MPI_INTEGER,
2066 & MPI_MAX, MASTER, COMM, IERR_MPI )
2067 K142 = K142_GLOB
2068#if defined(ptscotch) || defined(scotch)
2069.EQ..AND..GT. IF (K482_LOC2NOMP 0) THEN
2070 CALL MUMPS_SCOTCH_SET_PTHREAD_NUMBER (PTHREAD_NUMBER)
2071 ENDIF
2072#endif
2073 501 CONTINUE
2074.NE. IF (K469_LOC2) THEN
2075 IF (allocated(TRACE)) DEALLOCATE(TRACE)
2076 IF (allocated(WORKH)) DEALLOCATE(WORKH)
2077 IF (allocated(GEN2HALO)) DEALLOCATE(GEN2HALO)
2078 ENDIF
2079 IF (allocated(PVS)) DEALLOCATE(PVS)
2080 RETURN
2081 END SUBROUTINE ZMUMPS_AB_LR_MPI_GROUPING
2082 END MODULE ZMUMPS_ANA_LR
mumps_abort
#define mumps_abort
Definition VE_Metis.h:25
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
mumps_ana_blk_m
Definition ana_blk_m.F:14
mumps_ana_ord_wrappers
Definition ana_orderings_wrappers_m.F:19
mumps_lr_common
Definition lr_common.F:14
mumps_lr_common::compute_blr_vcs
subroutine compute_blr_vcs(k472, ibcksz, maxsize, nass)
Definition lr_common.F:18
zmumps_ana_lr
Definition zana_lr.F:14
zmumps_ana_lr::get_cut
subroutine get_cut(iwr, nass, ncb, lrgroups, npartscb, npartsass, cut)
Definition zana_lr.F:25
zmumps_ana_lr::sep_grouping_ab
subroutine sep_grouping_ab(nv, nvexpanded, vlist, n, lrgroups, nbgroups, lumat, sizeofblocks, group_size, halo_depth, trace, workh, node, gen2halo, k482, k472, k469, sep_size, maxsize_parts, keep10, lp, lpok, iflag, ierror)
Definition zana_lr.F:221
zmumps_ana_lr::neighborhood
subroutine neighborhood(halo, nhalo, n, iw, lw, ipe, trace, node, len, cnt, last_lvl_start, depth, pmax, gen2halo)
Definition zana_lr.F:629
zmumps_ana_lr::get_groups
subroutine get_groups(nhalo, parts, sep, nsep, nparts, cut, newsep, perm, iperm)
Definition zana_lr.F:702
zmumps_ana_lr::gethalograph_ab
subroutine gethalograph_ab(halo, nsep, nhalo, n, lumat, iptrhalo, jcnhalo, haloedgenbr, trace, node, gen2halo, iq)
Definition zana_lr.F:435
zmumps_ana_lr::zmumps_lr_grouping
subroutine zmumps_lr_grouping(n, nz8, nsteps, irn, jcn, fils, frere_steps, dad_steps, ne_steps, step, na, lna, lrgroups, sym, icntl, halo_depth, group_size, sep_size, k38, k20, k60, iflag, ierror, k264, k265, k482, k472, maxfront, k10, k54, k142, lpok, lp, gather_matrix_allocated)
Definition zana_lr.F:779
zmumps_ana_lr::sep_grouping
subroutine sep_grouping(nv, vlist, n, nz, lrgroups, nbgroups, iw, lw, ipe, len, group_size, halo_depth, trace, workh, node, gen2halo, k482, k472, k469, sep_size, maxsize_parts, keep10, lp, lpok, iflag, ierror)
Definition zana_lr.F:72
zmumps_ana_lr::gethalonodes_ab
subroutine gethalonodes_ab(n, lumat, ind, nind, pmax, nhalo, trace, workh, node, haloedgenbr, gen2halo)
Definition zana_lr.F:385
zmumps_ana_lr::gethalograph
subroutine gethalograph(halo, nhalo, n, iw, lw, ipe, iptrhalo, jcnhalo, haloedgenbr, trace, node, gen2halo)
Definition zana_lr.F:671
zmumps_ana_lr::zmumps_lr_grouping_new
subroutine zmumps_lr_grouping_new(n, nz8, nsteps, irn, jcn, fils, frere_steps, dad_steps, step, na, lna, lrgroups, sym, icntl, halo_depth, group_size, sep_size, k38, k20, k60, iflag, ierror, k264, k265, k482, k472, maxfront, k469, k10, k54, k142, lpok, lp, gather_matrix_allocated)
Definition zana_lr.F:978
zmumps_ana_lr::get_global_groups
subroutine get_global_groups(parts, sep, nsep, nparts, lrgroups, n, nbgroups, lrgroups_sign, maxsize_parts_loc)
Definition zana_lr.F:487
zmumps_ana_lr::zmumps_ab_lr_grouping
subroutine zmumps_ab_lr_grouping(n, mapcol, sizemapcol, nsteps, lumat, fils, frere_steps, dad_steps, step, na, lna, lrgroups, sizeofblocks, sym, icntl, halo_depth, group_size, sep_size, k38, k20, k60, iflag, ierror, k264, k265, k482, k472, maxfront, k469, k10, k54, k142, lpok, lp, myid, comm)
Definition zana_lr.F:1296
zmumps_ana_lr::gethalonodes
subroutine gethalonodes(n, iw, lw, ipe, ind, nind, pmax, nhalo, trace, workh, node, len, cnt, gen2halo)
Definition zana_lr.F:591
zmumps_lr_core
Definition zlr_core.F:18
zmumps_lr_stats
Definition zlr_stats.F:14
mumps_ana_blk_m::lmatrix_t
Definition ana_blk_m.F:19
mumps_set_ierror
subroutine mumps_set_ierror(size8, ierror)
Definition tools_common.F:865
zmumps_ana_gnew
subroutine zmumps_ana_gnew(n, nz, irn, icn, iw, lw, ipe, len, iq, flag, iwfr, nrorm, niorm, iflag, ierror, icntl, symmetry, sym, nbqd, avgdens, keep264, keep265, printstat, inplace64_graph_copy)
Definition zana_aux.F:3231