OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
cana_aux.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#if defined(__ve__)
15#if defined(VHOFFLOAD)
16#include 've.h'
17#endif
18#endif
19 MODULE cmumps_ana_aux_m
20 IMPLICIT NONE
21 CONTAINS
22 SUBROUTINE cmumps_ana_f(N, NZ8, IRN, ICN, LIWALLOC,
23 & IKEEP1, IKEEP2, IKEEP3,
24 & IORD, NFSIZ, FILS, FRERE, LISTVAR_SCHUR, SIZE_SCHUR,
25 & ICNTL, INFO, KEEP,KEEP8, NSLAVES, PIV,
26 & CNTL4, COLSCA, ROWSCA
27#if defined(metis) || defined(parmetis) || defined(metis4) || defined(parmetis3)
28 & , metis_options
29#endif
30 & , norig_arg, sizeofblocks, gcomp_provided_in, gcomp
31 & )
32 USE mumps_ana_ord_wrappers
33 USE mumps_ana_blk_m, ONLY : compact_graph_t
34 IMPLICIT NONE
35 INTEGER, INTENT(IN) :: N, SIZE_SCHUR, NSLAVES
36 INTEGER(8), INTENT(IN) :: NZ8
37 INTEGER(8), INTENT(IN) :: LIWALLOC
38 INTEGER, INTENT(in) :: LISTVAR_SCHUR(:)
39 INTEGER, POINTER :: IRN(:), ICN(:)
40 INTEGER, INTENT(IN) :: ICNTL(60)
41 INTEGER, INTENT(INOUT) :: IORD
42 INTEGER, INTENT(INOUT) :: INFO(80), KEEP(500)
43 INTEGER(8), INTENT(INOUT) :: KEEP8(150)
44 INTEGER, INTENT(OUT) :: NFSIZ(:), FILS(:), FRERE(:)
45 INTEGER, INTENT(INOUT) :: PIV(:)
46 INTEGER, INTENT(INOUT) :: IKEEP1(:), IKEEP2(:), IKEEP3(:)
47 REAL :: CNTL4
48 REAL, POINTER :: COLSCA(:), ROWSCA(:)
49#if defined(metis) || defined(parmetis) || defined(metis4) || defined(parmetis3)
50 INTEGER, INTENT(IN) :: METIS_OPTIONS(40)
51#endif
52 INTEGER, INTENT(IN), OPTIONAL :: NORIG_ARG
53 INTEGER, INTENT(IN), OPTIONAL :: SIZEOFBLOCKS(N)
54 LOGICAL, INTENT(IN), OPTIONAL :: GCOMP_PROVIDED_IN
55 TYPE(compact_graph_t), OPTIONAL :: GCOMP
56 INTEGER, DIMENSION(:), ALLOCATABLE, TARGET :: IWALLOC
57 INTEGER, DIMENSION(:), POINTER :: IW
58 INTEGER(8), DIMENSION(:), ALLOCATABLE, TARGET :: IPEALLOC
59 INTEGER(8), DIMENSION(:), POINTER :: IPE
60 INTEGER(8), DIMENSION(:), ALLOCATABLE :: IPQ8
61 INTEGER, DIMENSION(:,:), ALLOCATABLE :: PTRAR
62 INTEGER, DIMENSION(:), ALLOCATABLE :: PARENT
63 INTEGER, DIMENSION(:), ALLOCATABLE :: IWL1
64 INTEGER NBBUCK
65 INTEGER, DIMENSION(:), ALLOCATABLE :: WTEMP
66 INTEGER IERR
67 INTEGER I, K, NCMPA, IN, IFSON
68 INTEGER(8) :: J8, I8
69 INTEGER :: NORIG
70 INTEGER(8) :: IFIRST, ILAST
71 INTEGER(8) IWFR8
72 INTEGER NEMIN, LP, MP, LDIAG, ITEMP, symmetry
73 INTEGER NBQD, AvgDens
74 LOGICAL PROK, COMPRESS_SCHUR, LPOK, COMPUTE_PERM
75#if defined(metis) || defined(parmetis) || defined(metis4) || defined(parmetis3)
76#if defined(metis4) || defined(parmetis3)
77 INTEGER NUMFLAG
78#endif
79 INTEGER METIS_IDX_SIZE
80 INTEGER OPT_METIS_SIZE
81#endif
82#if defined(scotch) || defined(ptscotch)
83 INTEGER :: SCOTCH_INT_SIZE
84#endif
85#if defined(pord)
86 INTEGER :: PORD_INT_SIZE
87#endif
88 REAL, DIMENSION(:), ALLOCATABLE :: COLSCA_TEMP
89 INTEGER THRESH, IVersion
90 LOGICAL AGG6
91 INTEGER MINSYM
92 PARAMETER (MINSYM=50)
93 INTEGER(8) :: K79REF
94 parameter(k79ref=12000000_8)
95 INTEGER, PARAMETER :: LIDUMMY = 1
96 INTEGER :: IDUMMY(1)
97 INTEGER MTRANS, COMPRESS,NCMP,IERROR,J,JPERM,NCST
98 INTEGER TOTEL
99#if defined(pord)
100 INTEGER TOTW
101#endif
102 INTEGER WEIGHTUSED
103#if defined(scotch) || defined(ptscotch)
104 INTEGER WEIGHTREQUESTED
105#endif
106 LOGICAL SCOTCH_SYMBOLIC
107 LOGICAL IDENT,SPLITROOT
108 LOGICAL FREE_CENTRALIZED_MATRIX
109 LOGICAL GCOMP_PROVIDED
110 LOGICAL INPLACE64_GRAPH_COPY, INPLACE64_RESTORE_GRAPH
111 INTEGER(8) :: LIW8, NZG8
112 DOUBLE PRECISION TIMEB
113 EXTERNAL mumps_ana_h, cmumps_ana_j,
114 & cmumps_ana_k, cmumps_ana_gnew,
115 & cmumps_ana_lnew, cmumps_ana_m
116#if defined(OLDDFS)
117 EXTERNAL cmumps_ana_l
118#endif
119 EXTERNAL cmumps_gnew_schur
120 EXTERNAL cmumps_ldlt_compress, cmumps_expand_permutation,
121 & cmumps_set_constraints
122 IF (liwalloc.GT.0_8) THEN
123 ALLOCATE( iwalloc(liwalloc), stat = ierr )
124 IF ( ierr .GT. 0 ) THEN
125 info( 1 ) = -7
126 CALL mumps_set_ierror(liwalloc,info(2))
127 GOTO 90
128 ENDIF
129 ENDIF
130 ALLOCATE( iwl1(n), stat = ierr )
131 IF ( ierr .GT. 0 ) THEN
132 info( 1 ) = -7
133 info( 2 ) = n
134 GOTO 90
135 ENDIF
136 ALLOCATE( ipealloc(n+1), stat = ierr )
137 IF ( ierr .GT. 0 ) THEN
138 info( 1 ) = -7
139 info( 2 ) = (n+1)*keep(10)
140 GOTO 90
141 ENDIF
142 ALLOCATE( ptrar(n,3), stat = ierr )
143 IF ( ierr .GT. 0 ) THEN
144 info( 1 ) = -7
145 info( 2 ) = 3*n
146 GOTO 90
147 ENDIF
148 scotch_symbolic=(keep(270).EQ.0)
149 symmetry = info(8)
150 nbqd = 0
151 gcomp_provided=.false.
152 weightused = 0
153 norig = n
154 IF (present(norig_arg)) THEN
155 norig=norig_arg
156 ENDIF
157 IF (present(gcomp_provided_in))
158 & gcomp_provided = gcomp_provided_in
159 IF (gcomp_provided.AND.(.NOT. present(gcomp))) THEN
160 info(1) = -900
161 WRITE(6,*) " INTERNAL ERROR in MUMPS(ANA_F) ",
162 & gcomp_provided_in, present(gcomp)
163 info(2) = 1
164 RETURN
165 ENDIF
166 IF ( (liwalloc.EQ.0_8).AND.(.not.gcomp_provided)) THEN
167 info(1) = -900
168 WRITE(6,*) " INTERNAL ERROR in MUMPS(ANA_F) ",
169 & "LIWALLOC, GCOMP_PROVIDED=", liwalloc, gcomp_provided
170 info(2) = 2
171 RETURN
172 ENDIF
173 IF (gcomp_provided) THEN
174 nzg8 = gcomp%NZG
175 liw8 = nzg8 + int(gcomp%NG,8)+1_8
176 iw => gcomp%ADJ(1:liw8)
177 ipe => gcomp%IPE(1:gcomp%NG+1)
178 DO i=1,gcomp%NG
179 ptrar(i,2) = int(ipe(i+1)-ipe(i))
180 ENDDO
181 ELSE
182 liw8 = liwalloc
183 nzg8 = nz8
184 iw => iwalloc(1:liw8)
185 ipe => ipealloc(1:n+1)
186 ENDIF
187 lp = icntl(1)
188 mp = icntl(3)
189 lpok = ((lp.GT.0).AND.(icntl(4).GE.1))
190 prok = ((mp.GT.0).AND.(icntl(4).GE.2))
191 ldiag = icntl(4)
192 compress_schur = .false.
193 IF (prok) THEN
194 IF (present(gcomp)) THEN
195 WRITE(mp,'(A,I10,A,I13,A)') " Processing a graph of size:", n
196 & ," with ", gcomp%NZG, " edges"
197 ELSE
198 WRITE(mp,'(A,I10)') " Processing a graph of size:", n
199 ENDIF
200 ENDIF
201 IF (gcomp_provided) THEN
202 free_centralized_matrix = .false.
203 ELSE
204 free_centralized_matrix = (
205 & (keep(54).EQ.3).AND.
206 & (keep(494).EQ.0).AND.
207 & (keep(106).NE.3)
208 & )
209 ENDIF
210 inplace64_graph_copy = .false.
211 inplace64_restore_graph = .true.
212 IF (keep(1).LT.0) keep(1) = 0
213 nemin = keep(1)
214 IF (ldiag.GT.2 .AND. mp.GT.0) THEN
215 IF (present(sizeofblocks)) THEN
216 k = min(10,gcomp%NG)
217 IF (ldiag.EQ.4) k = gcomp%NG
218 WRITE (mp,99909) n, nzg8, info(1)
219 i8= 0_8
220 WRITE(mp,'(A)') " Graph adjacency "
221 DO j=1, k
222 ifirst = gcomp%IPE(j)
223 ilast= min(gcomp%IPE(j+1)-1,gcomp%IPE(j)+k-1)
224 write(mp,'(A,I10)') " .... node/column:", j
225 write(mp,'(8X,10I9)')
226 & (gcomp%ADJ(i8),i8=ifirst,ilast)
227 ENDDO
228 ELSE
229 j8 = min(nzg8, 10_8)
230 IF (ldiag .EQ.4) j8 = nzg8
231 WRITE (mp,99999) n, nzg8, liw8, info(1)
232 IF (j8.GT.0_8) WRITE (mp,99998) (irn(i8),icn(i8),i8=1_8,j8)
233 ENDIF
234 k = min0(10,n)
235 IF (ldiag.EQ.4) k = n
236 IF (iord.EQ.1 .AND. k.GT.0) THEN
237 WRITE (mp,99997) (ikeep1(i),i=1,k)
238 ENDIF
239 ENDIF
240 ncmp = n
241 IF (keep(60).NE.0) THEN
242 IF ((size_schur.LE.0 ).OR.
243 & (size_schur.GE.n) ) GOTO 90
244 ENDIF
245#if defined(metis) || defined(parmetis) || defined(metis4) || defined(parmetis3)
246 IF ( ( keep(60).NE.0).AND.(size_schur.GT.0)
247 & .AND.
248 & ((iord.EQ.7).OR.(iord.EQ.5))
249 & )THEN
250 compress_schur=.true.
251 ncmp = n-size_schur
252 ALLOCATE(ipq8(n),stat=ierr)
253 IF ( ierr .GT. 0 ) THEN
254 info( 1 ) = -7
255 info( 2 ) = n*keep(10)
256 ENDIF
257 CALL cmumps_gnew_schur(n,ncmp,nz8,irn(1), icn(1), iw(1), liw8,
258 & ipe(1), ptrar(1,2),
259 & ipq8, iwl1, iwfr8, keep8(126), keep8(127),
260 & info(1), info(2), icntl, symmetry,
261 & keep(50), nbqd, avgdens,
262 & keep(264), keep(265),
263 & listvar_schur(1), size_schur, frere(1), fils(1),
264 & inplace64_graph_copy)
265 info(8) = symmetry
266 inplace64_graph_copy = inplace64_graph_copy.AND.
267 & (.NOT.free_centralized_matrix)
268 DEALLOCATE(ipq8)
269 iord = 5
270 keep(95) = 1
271 nbqd = 0
272 ELSE
273#endif
274 IF (gcomp_provided) THEN
275 iwfr8 = gcomp%NZG+1_8
276 ELSE
277 ALLOCATE(ipq8(n),stat=ierr)
278 IF ( ierr .GT. 0 ) THEN
279 info( 1 ) = -7
280 info( 2 ) = n*keep(10)
281 ENDIF
282 IF ( prok ) THEN
283 CALL mumps_secdeb( timeb )
284 ENDIF
285 CALL cmumps_ana_gnew(n,nz8,irn(1), icn(1), iw(1), liw8,
286 & ipe(1), ptrar(1,2),
287 & ipq8, iwl1, iwfr8, keep8(126), keep8(127),
288 & info(1), info(2), icntl, symmetry,
289 & keep(50), nbqd, avgdens, keep(264), keep(265),
290 & .true., inplace64_graph_copy)
291 info(8) = symmetry
292 inplace64_graph_copy = inplace64_graph_copy.AND.
293 & (.NOT.free_centralized_matrix)
294 DEALLOCATE(ipq8)
295 ENDIF
296#if defined(metis) || defined(parmetis) || defined(metis4) || defined(parmetis3)
297 ENDIF
298#endif
299 IF(nbqd .GT. 0) THEN
300 IF( keep(50) .EQ. 2 .AND. icntl(12) .EQ. 0 ) THEN
301 IF(keep(95) .NE. 1) THEN
302 IF ( prok )
303 & WRITE( mp,*)
304 & 'Compressed/constrained ordering set OFF'
305 keep(95) = 1
306 ENDIF
307 ENDIF
308 ENDIF
309 IF ( (keep(60).NE.0) .AND. (iord.GT.1) .AND.
310 & .NOT. compress_schur ) THEN
311 iord = 0
312 ENDIF
313 IF ( (keep(50).EQ.2)
314 & .AND. (keep(95) .EQ. 3)
315 & .AND. (iord .EQ. 7) ) THEN
316 iord = 2
317 ENDIF
318 CALL mumps_set_ordering( norig, keep,
319 & keep(50), nslaves, iord,
320 & nbqd, avgdens,
321 & prok, mp )
322 IF(keep(50) .EQ. 2) THEN
323 IF(keep(95) .EQ. 3 .AND. iord .NE. 2) THEN
324 IF (prok) WRITE(mp,*)
325 & 'WARNING: CMUMPS_ANA_F constrained ordering not '//
326 & ' available with selected ordering. Move to' //
327 & ' compressed ordering.'
328 keep(95) = 2
329 ENDIF
330 ELSE
331 keep(95) = 1
332 ENDIF
333 mtrans = keep(23)
334 compress = keep(95) - 1
335 IF(compress .GT. 0 .AND. keep(52) .EQ. -2) THEN
336 IF(cntl4 .GE. 0.0e0) THEN
337 IF (keep(1).LE.8) THEN
338 nemin = 16
339 ELSE
340 nemin = 2*keep(1)
341 ENDIF
342 ENDIF
343 ENDIF
344 IF(mtrans .GT. 0 .AND. keep(50) .EQ. 2) THEN
345 keep(23) = 0
346 ENDIF
347 IF (compress .EQ. 2) THEN
348 IF (iord.NE.2) THEN
349 WRITE(*,*) "IORD not compatible with COMPRESS:",
350 & iord, compress
351 CALL mumps_abort()
352 ENDIF
353 CALL cmumps_set_constraints(
354 & n,piv(1),frere(1),fils(1),nfsiz(1),ikeep1(1),
355 & ncst,keep,keep8, rowsca(1)
356 & )
357 ENDIF
358 IF ( iord .NE. 1 ) THEN
359 IF (compress .GE. 1) THEN
360 ALLOCATE(ipq8(n),stat=ierr)
361 IF ( ierr .GT. 0 ) THEN
362 info( 1 ) = -7
363 info( 2 ) = n*keep(10)
364 ENDIF
365 CALL cmumps_ldlt_compress(
366 & n, nz8, irn(1), icn(1), piv(1),
367 & ncmp, iw(1), liw8, ipe(1), ptrar(1,2), ipq8,
368 & iwl1, fils(1), iwfr8,
369 & ierror, keep, keep8, icntl, inplace64_graph_copy)
370 DEALLOCATE(ipq8)
371 symmetry = 100
372 ENDIF
373 IF ( (symmetry.LT.minsym).AND.(keep(50).EQ.0) ) THEN
374 IF(keep(23) .EQ. 7 ) THEN
375 keep(23) = -5
376 GOTO 90
377 ELSE IF(keep(23) .EQ. -9876543) THEN
378 ident = .true.
379 keep(23) = 5
380 IF (prok) WRITE(mp,'(A)')
381 & ' ... Apply column permutation (already computed)'
382 DO j=1,n
383 jperm = piv(j)
384 fils(jperm) = j
385 IF (jperm.NE.j) ident = .false.
386 ENDDO
387 IF (.NOT.ident) THEN
388 DO j8=1_8,nz8
389 j = icn(j8)
390 IF ((j.LE.0).OR.(j.GT.n)) cycle
391 icn(j8) = fils(j)
392 ENDDO
393 ALLOCATE(colsca_temp(n), stat=ierr)
394 IF ( ierr > 0 ) THEN
395 info( 1 ) = -7
396 info( 2 ) = n
397 GOTO 90
398 ENDIF
399 DO j = 1, n
400 colsca_temp(j)=colsca(j)
401 ENDDO
402 DO j=1, n
403 colsca(fils(j))=colsca_temp(j)
404 ENDDO
405 DEALLOCATE(colsca_temp)
406 IF (prok)
407 & WRITE(mp,'(/A)')
408 & ' WARNING input matrix data modified'
409 ALLOCATE(ipq8(n),stat=ierr)
410 IF ( ierr .GT. 0 ) THEN
411 info( 1 ) = -7
412 info( 2 ) = n*keep(10)
413 ENDIF
414 CALL cmumps_ana_gnew
415 & (n,nz8,irn(1), icn(1), iw(1), liw8,
416 & ipe(1), ptrar(1,2),
417 & ipq8, iwl1, iwfr8, keep8(126), keep8(127),
418 & info(1), info(2), icntl, symmetry, keep(50),
419 & nbqd, avgdens, keep(264), keep(265),
420 & .true.,inplace64_graph_copy)
421 info(8) = symmetry
422 DEALLOCATE(ipq8)
423 ncmp = n
424 ELSE
425 keep(23) = 0
426 ENDIF
427 ENDIF
428 ELSE IF (keep(23) .EQ. 7 .OR. keep(23) .EQ. -9876543 ) THEN
429 IF (prok) WRITE(mp,'(A)')
430 & ' ... No column permutation'
431 keep(23) = 0
432 ENDIF
433 ENDIF
434 IF (free_centralized_matrix
435 & .AND.compress.EQ.0.AND.(.NOT.compress_schur)) THEN
436 deallocate(irn)
437 NULLIFY(irn)
438 deallocate(icn)
439 NULLIFY(icn)
440 ENDIF
441 inplace64_restore_graph =
442 & inplace64_restore_graph.AND.(compress.NE.1)
443 ALLOCATE( parent( n ), stat = ierr )
444 IF ( ierr .GT. 0 ) THEN
445 info( 1 ) = -7
446 info( 2 ) = n
447 GOTO 90
448 ENDIF
449 IF (iord.NE.1 .AND. iord.NE.5) THEN
450 IF ( keep(60) .NE. 0 ) THEN
451 iord = 0
452 ENDIF
453 IF (prok) THEN
454 IF (iord.EQ.2) THEN
455 WRITE(mp,'(A)') ' Ordering based on AMF '
456#if defined(scotch) || defined(ptscotch)
457 ELSE IF (iord.EQ.3) THEN
458 WRITE(mp,'(A)') ' Ordering based on SCOTCH '
459#endif
460#if defined(pord)
461 ELSE IF (iord.EQ.4) THEN
462 WRITE(mp,'(A)') ' ordering based on pord '
463#endif
464.EQ. ELSE IF (IORD6) THEN
465 WRITE(MP,'(a)') ' ordering based on qamd '
466 ELSE
467 WRITE(MP,'(a)') ' ordering based on amd '
468 ENDIF
469 ENDIF
470 IF ( PROK ) THEN
471 CALL MUMPS_SECDEB( TIMEB )
472 ENDIF
473.NE. IF ( KEEP(60) 0 ) THEN
474 CALL MUMPS_HAMD(N, LIW8, IPE(1), IWFR8, PTRAR(1,2), IW(1),
475 & IWL1, IKEEP1(1),
476 & IKEEP2(1), NCMPA, FILS(1), IKEEP3(1),
477 & PTRAR, PTRAR(1,3),
478 & PARENT,
479 & LISTVAR_SCHUR(1), SIZE_SCHUR)
480 IF (KEEP(60)==1) THEN
481 KEEP(20) = LISTVAR_SCHUR(1)
482 ELSE
483 KEEP(38) = LISTVAR_SCHUR(1)
484 ENDIF
485 ELSE
486 IF ( .FALSE. ) THEN
487#if defined(pord)
488.EQ. ELSEIF (IORD 4) THEN
489 CALL MUMPS_PORD_INTSIZE(PORD_INT_SIZE)
490 TOTW = N
491.EQ. IF ( (COMPRESS 1)
492.OR. &
493.NE..AND. & ( (NORIGN)present(SIZEOFBLOCKS) )
494 & ) THEN
495.EQ. IF (COMPRESS 1) THEN
496 DO I=1,KEEP(93)/2
497 IWL1(I) = 2
498 ENDDO
499 DO I=1+KEEP(93)/2,NCMP
500 IWL1(I) = 1
501 ENDDO
502 ELSE IF
503.NE..AND. & ( (NORIGN)present(SIZEOFBLOCKS) ) THEN
504 TOTW = NORIG
505 DO I= 1, N
506 IWL1(I) = SIZEOFBLOCKS(I)
507 ENDDO
508 ENDIF
509.EQ. IF (PORD_INT_SIZE 64) THEN
510 CALL MUMPS_PORDF_WND_MIXEDto64(NCMP, IWFR8-1_8,
511 & IPE, IW,
512 & IWL1, NCMPA, TOTW, PARENT,
513 & INFO(1), LP, LPOK, KEEP(10),
514 & INPLACE64_GRAPH_COPY
515 & )
516.EQ. ELSE IF (PORD_INT_SIZE 32) THEN
517 CALL MUMPS_PORDF_WND_MIXEDto32(NCMP, IWFR8-1_8,
518 & IPE, IW,
519 & IWL1, NCMPA, TOTW, PARENT,
520 & INFO(1), LP, LPOK, KEEP(10))
521 ELSE
522 WRITE(*,*)
523 & "Internal error in PORD wrappers, PORD_INT_SIZE=",
524 & PORD_INT_SIZE
525 CALL MUMPS_ABORT()
526 ENDIF
527.NE. IF ( NCMPA 0 ) THEN
528 write(6,*) ' out pord, ncmpa=', NCMPA
529 INFO( 1 ) = -9999
530 INFO( 2 ) = 4
531 GOTO 90
532 ENDIF
533.LT. IF (INFO(1) 0) GOTO 90
534.EQ. IF (COMPRESS1) THEN
535 CALL CMUMPS_GET_ELIM_TREE(NCMP,PARENT,IWL1,FILS(1))
536 CALL CMUMPS_GET_PERM_FROM_PE(NCMP,PARENT,IKEEP1(1),
537 & FRERE(1),PTRAR(1,1))
538 DO I=1,NCMP
539 IKEEP2(IKEEP1(I))=I
540 ENDDO
541 ENDIF
542 ELSE
543.EQ. IF (PORD_INT_SIZE64) THEN
544 CALL MUMPS_PORDF_MIXEDto64(NCMP, IWFR8-1_8, IPE,
545 & IW,
546 & IWL1, NCMPA, PARENT,
547 & INFO(1), LP, LPOK, KEEP(10),
548 & INPLACE64_GRAPH_COPY
549 & )
550.EQ. ELSE IF (PORD_INT_SIZE32) THEN
551 CALL MUMPS_PORDF_MIXEDto32(NCMP, IWFR8-1_8, IPE,
552 & IW,
553 & IWL1, NCMPA, PARENT,
554 & INFO(1), LP, LPOK, KEEP(10))
555 ELSE
556 WRITE(*,*)
557 & "Internal error in PORD wrappers, PORD_INT_SIZE=",
558 & PORD_INT_SIZE
559 CALL MUMPS_ABORT()
560 ENDIF
561 ENDIF
562.NE. IF ( NCMPA 0 ) THEN
563 write(6,*) ' out pord, ncmpa=', NCMPA
564 INFO( 1 ) = -9999
565 INFO( 2 ) = 4
566 GOTO 90
567 ENDIF
568.LT. IF (INFO(1) 0) GOTO 90
569#endif
570#if defined(scotch) || defined(ptscotch)
571.EQ. ELSEIF (IORD 3) THEN
572 CALL MUMPS_SCOTCH_INTSIZE(SCOTCH_INT_SIZE)
573.EQ. IF ( (COMPRESS 1)
574.OR. &
575.NE..AND. & ( (NORIGN)present(SIZEOFBLOCKS) )
576 & ) THEN
577 WEIGHTREQUESTED=1
578.EQ. IF (COMPRESS 1) THEN
579 DO I=1,KEEP(93)/2
580 IWL1(I) = 2
581 ENDDO
582 DO I=1+KEEP(93)/2,NCMP
583 IWL1(I) = 1
584 ENDDO
585 ELSE IF
586.NE..AND. & ( (NORIGN)present(SIZEOFBLOCKS) ) THEN
587 DO I= 1, N
588 IWL1(I) = SIZEOFBLOCKS(I)
589 ENDDO
590 ENDIF
591 ELSE
592 WEIGHTREQUESTED = 0
593 DO I= 1, N
594 IWL1(I) = 1
595 ENDDO
596 ENDIF
597.EQ. IF (SCOTCH_INT_SIZE32) THEN
598.EQ. IF (KEEP(10)1) THEN
599 INFO(1) = -52
600 INFO(2) = 2
601 ELSE
602 CALL MUMPS_SCOTCH_MIXEDto32(NCMP,
603 & IWFR8-1_8, IPE,
604 & PARENT, IWFR8,
605 & PTRAR(1,2), IW, IWL1, IKEEP1,
606 & IKEEP2, NCMPA, INFO, LP, LPOK,
607 & WEIGHTUSED, WEIGHTREQUESTED, SCOTCH_SYMBOLIC)
608 ENDIF
609.EQ. ELSE IF (SCOTCH_INT_SIZE64) THEN
610 CALL MUMPS_SCOTCH_MIXEDto64(NCMP,
611 & IWFR8-1_8, IPE,
612 & PARENT, IWFR8,
613 & PTRAR(1,2), IW, IWL1, IKEEP1,
614 & IKEEP2, NCMPA, INFO, LP, LPOK, KEEP(10),
615 & INPLACE64_GRAPH_COPY,
616 & WEIGHTUSED, WEIGHTREQUESTED, SCOTCH_SYMBOLIC)
617 ELSE
618 WRITE(*,*)
619 & "Internal error in SCOTCH wrappers, SCOTCH_INT_SIZE=",
620 & SCOTCH_INT_SIZE
621 CALL MUMPS_ABORT()
622 ENDIF
623.LT. IF (INFO(1) 0) GOTO 90
624.NOT. IF ( SCOTCH_SYMBOLIC) THEN
625.EQ. IF ( COMPRESS 1 ) THEN
626 CALL CMUMPS_EXPAND_PERMUTATION(N,NCMP,KEEP(94),
627 & KEEP(93),PIV(1),IKEEP1(1),IKEEP2(1))
628 COMPRESS = -1
629 ENDIF
630.EQ. ELSE IF ( (COMPRESS 1)
631.OR. &
632.NE..AND..AND. & ( (NORIGN)present(SIZEOFBLOCKS)
633.EQ. & (WEIGHTUSED0) )
634 & ) THEN
635 CALL CMUMPS_GET_ELIM_TREE(NCMP,PARENT,IWL1,FILS(1))
636 CALL CMUMPS_GET_PERM_FROM_PE(NCMP,PARENT,IKEEP1(1),
637 & FRERE(1),PTRAR(1,1))
638 DO I=1,NCMP
639 IKEEP2(IKEEP1(I))=I
640 ENDDO
641 ENDIF
642#endif
643.EQ. ELSEIF (IORD 2) THEN
644 NBBUCK = 2*N
645 COMPUTE_PERM=.FALSE.
646.GE. IF(COMPRESS 1) THEN
647 COMPUTE_PERM=.TRUE.
648 DO I=1,KEEP(93)/2
649 IWL1(I) = 2
650 ENDDO
651 DO I=1+KEEP(93)/2,NCMP
652 IWL1(I) = 1
653 ENDDO
654 TOTEL = KEEP(93)+KEEP(94)
655 ELSE
656 IWL1(1) = -1
657 TOTEL = N
658 ENDIF
659 IF (present(SIZEOFBLOCKS)) THEN
660.GE. IF (COMPRESS1) THEN
661 CALL MUMPS_ABORT()
662 ENDIF
663 NBBUCK = max(NBBUCK, NORIG-N)
664 NBBUCK = max(NBBUCK, 2*NORIG)
665 NCMP = N
666 TOTEL = NORIG
667 DO I= 1, N
668 IWL1(I) = SIZEOFBLOCKS(I)
669 ENDDO
670 ENDIF
671 ALLOCATE( WTEMP ( 0: NBBUCK + 1), stat = IERR )
672.GT. IF ( IERR 0 ) THEN
673 INFO( 1 ) = -7
674 INFO( 2 ) = NBBUCK+2
675 GOTO 90
676 ENDIF
677.LE. IF(COMPRESS 1) THEN
678 CALL MUMPS_HAMF4
679 & (TOTEL, NCMP, COMPUTE_PERM, NBBUCK, LIW8, IPE(1),
680 & IWFR8, PTRAR(1,2),
681 & IW(1), IWL1, IKEEP1(1), IKEEP2(1), NCMPA, FILS(1),
682 & IKEEP3(1), PTRAR, PTRAR(1,3), WTEMP, PARENT(1))
683 ELSE
684 IF(PROK) WRITE(MP,'(a)')
685 & ' constrained ordering based on amf'
686 CALL MUMPS_CST_AMF(NCMP, NBBUCK, LIW8, IPE(1),
687 & IWFR8, PTRAR(1,2),
688 & IW(1), IWL1, IKEEP1(1), IKEEP2(1), NCMPA, FILS(1),
689 & IKEEP3(1), PTRAR, PTRAR(1,3), WTEMP,
690 & NFSIZ(1), FRERE(1), PARENT(1))
691 ENDIF
692 DEALLOCATE(WTEMP)
693.EQ. ELSEIF (IORD 6) THEN
694 ALLOCATE( WTEMP ( N ), stat = IERR )
695.GT. IF ( IERR 0 ) THEN
696 INFO( 1 ) = -7
697 INFO( 2 ) = N
698 GOTO 90
699 ENDIF
700 THRESH = 1
701 IVersion = 2
702 COMPUTE_PERM=.FALSE.
703.EQ. IF(COMPRESS 1) THEN
704 COMPUTE_PERM=.TRUE.
705 DO I=1,KEEP(93)/2
706 IWL1(I) = 2
707 ENDDO
708 DO I=1+KEEP(93)/2,NCMP
709 IWL1(I) = 1
710 ENDDO
711 TOTEL = KEEP(93)+KEEP(94)
712 ELSE
713 IWL1(1) = -1
714 TOTEL = N
715 ENDIF
716 IF (present(SIZEOFBLOCKS)) THEN
717.EQ. IF (COMPRESS1) THEN
718 CALL MUMPS_ABORT()
719 ENDIF
720 NCMP = N
721 TOTEL = NORIG
722 DO I= 1, N
723 IWL1(I) = SIZEOFBLOCKS(I)
724 ENDDO
725 ENDIF
726 CALL MUMPS_QAMD
727 & (TOTEL,COMPUTE_PERM,IVersion, THRESH, WTEMP,
728 & NCMP, LIW8, IPE(1), IWFR8, PTRAR(1,2), IW(1),
729 & IWL1, IKEEP1(1), IKEEP2(1), NCMPA, FILS(1),
730 & IKEEP3(1), PTRAR, PTRAR(1,3), PARENT(1))
731 DEALLOCATE(WTEMP)
732 ELSE
733 COMPUTE_PERM=.FALSE.
734.EQ. IF(COMPRESS 1) THEN
735 COMPUTE_PERM=.TRUE.
736 DO I=1,KEEP(93)/2
737 IWL1(I) = 2
738 ENDDO
739 DO I=1+KEEP(93)/2,NCMP
740 IWL1(I) = 1
741 ENDDO
742 TOTEL = KEEP(93)+KEEP(94)
743 ELSE
744 IWL1(1) = -1
745 TOTEL = N
746 ENDIF
747 IF (present(SIZEOFBLOCKS)) THEN
748.EQ. IF (COMPRESS1) THEN
749 CALL MUMPS_ABORT()
750 ENDIF
751 NCMP = N
752 TOTEL = NORIG
753 DO I= 1, N
754 IWL1(I) = SIZEOFBLOCKS(I)
755 ENDDO
756 ENDIF
757 CALL MUMPS_ANA_H(TOTEL, COMPUTE_PERM,
758 & NCMP, LIW8, IPE(1), IWFR8, PTRAR(1,2),
759 & IW(1), IWL1, IKEEP1(1), IKEEP2(1), NCMPA, FILS(1),
760 & IKEEP3(1), PTRAR, PTRAR(1,3), PARENT(1))
761 ENDIF
762 ENDIF
763.GE. IF(COMPRESS 1) THEN
764 CALL CMUMPS_EXPAND_PERMUTATION(N,NCMP,KEEP(94),KEEP(93),
765 & PIV(1),IKEEP1(1),IKEEP2(1))
766 COMPRESS = -1
767 ENDIF
768 IF ( PROK ) THEN
769 CALL MUMPS_SECFIN( TIMEB )
770#if defined(scotch) || defined(ptscotch)
771.EQ. IF (IORD3) THEN
772 WRITE( MP, '(a,f12.4)' )
773 & ' elapsed time spent in scotch reordering =', TIMEB
774 ENDIF
775#endif
776 ENDIF
777 ENDIF
778#if defined(metis) || defined(parmetis) || defined(metis4) || defined(parmetis3)
779.EQ. IF (IORD5) THEN
780 IF (PROK) THEN
781 WRITE(MP,'(a)') ' ordering based on metis'
782 ENDIF
783 IF ( PROK ) THEN
784 CALL MUMPS_SECDEB( TIMEB )
785 ENDIF
786 CALL MUMPS_METIS_IDXSIZE(METIS_IDX_SIZE)
787.EQ..AND..NE. IF (KEEP(10)1METIS_IDX_SIZE64) THEN
788 INFO(1) = -52
789 INFO(2) = 1
790 GOTO 90
791 ENDIF
792#if defined(metis4) || defined(parmetis3)
793 NUMFLAG = 1
794 OPT_METIS_SIZE = 8
795#else
796 OPT_METIS_SIZE = 40
797#endif
798.EQ. IF (COMPRESS 1) THEN
799 DO I=1,KEEP(93)/2
800 FRERE(I) = 2
801 ENDDO
802 DO I=KEEP(93)/2+1,NCMP
803 FRERE(I) = 1
804 ENDDO
805#if defined(metis4) || defined(parmetis3)
806.EQ. IF (METIS_IDX_SIZE 32) THEN
807 CALL MUMPS_METIS_NODEWND_MIXEDto32(
808 & NCMP, IPE, IW, FRERE,
809 & NUMFLAG, METIS_OPTIONS(1), OPT_METIS_SIZE,
810 & IKEEP2, IKEEP1, INFO(1), LP, LPOK )
811.EQ. ELSE IF (METIS_IDX_SIZE 64) THEN
812 CALL MUMPS_METIS_NODEWND_MIXEDto64(
813 & NCMP, IPE, IW, FRERE,
814 & NUMFLAG, METIS_OPTIONS(1), OPT_METIS_SIZE,
815 & IKEEP2, IKEEP1, INFO(1), LP, LPOK, KEEP(10),
816 & INPLACE64_GRAPH_COPY )
817 ELSE
818 WRITE(*,*)
819 & "Internal error in METIS wrappers, METIS_IDX_SIZE=",
820 & METIS_IDX_SIZE
821 CALL MUMPS_ABORT()
822 ENDIF
823 ELSE
824.NE..AND. IF ((NORIGN)present(SIZEOFBLOCKS)) THEN
825 DO I=1, N
826 FRERE(I) = SIZEOFBLOCKS(I)
827 ENDDO
828.EQ. IF (METIS_IDX_SIZE 32) THEN
829 CALL MUMPS_METIS_NODEWND_MIXEDto32(
830 & NCMP, IPE, IW, FRERE,
831 & NUMFLAG, METIS_OPTIONS(1), OPT_METIS_SIZE,
832 & IKEEP2, IKEEP1, INFO(1), LP, LPOK )
833.EQ. ELSE IF (METIS_IDX_SIZE 64) THEN
834 CALL MUMPS_METIS_NODEWND_MIXEDto64(
835 & NCMP, IPE, IW, FRERE,
836 & NUMFLAG, METIS_OPTIONS(1), OPT_METIS_SIZE,
837 & IKEEP2, IKEEP1, INFO(1), LP, LPOK, KEEP(10),
838 & INPLACE64_GRAPH_COPY )
839 ELSE
840 WRITE(*,*)
841 & "Internal error in METIS wrappers, METIS_IDX_SIZE=",
842 & METIS_IDX_SIZE
843 CALL MUMPS_ABORT()
844 ENDIF
845 ELSE
846.EQ. IF (METIS_IDX_SIZE 32) THEN
847 CALL MUMPS_METIS_NODEND_MIXEDto32(
848 & NCMP, IPE, IW, NUMFLAG,
849 & METIS_OPTIONS(1), OPT_METIS_SIZE,
850 & IKEEP2, IKEEP1, INFO(1), LP, LPOK )
851.EQ. ELSE IF (METIS_IDX_SIZE 64) THEN
852 CALL MUMPS_METIS_NODEND_MIXEDto64(
853 & NCMP, IPE, IW, NUMFLAG,
854 & METIS_OPTIONS(1), OPT_METIS_SIZE,
855 & IKEEP2, IKEEP1, INFO(1), LP,LPOK,KEEP(10),
856 & LIW8, INPLACE64_GRAPH_COPY,
857 & INPLACE64_RESTORE_GRAPH)
858 ELSE
859 WRITE(*,*)
860 & "Internal error in METIS wrappers, METIS_IDX_SIZE=",
861 & METIS_IDX_SIZE
862 CALL MUMPS_ABORT()
863 ENDIF
864 ENDIF
865 ENDIF
866#else
867 ELSE
868 IF (present(SIZEOFBLOCKS)) THEN
869 DO I=1,N
870 FRERE(I) = SIZEOFBLOCKS(I)
871 ENDDO
872 ELSE
873 DO I=1,NCMP
874 FRERE(I) = 1
875 ENDDO
876 ENDIF
877 ENDIF
878.EQ. IF (METIS_IDX_SIZE 32) THEN
879 CALL MUMPS_METIS_NODEND_MIXEDto32(
880 & NCMP, IPE, IW, FRERE,
881 & METIS_OPTIONS(1), OPT_METIS_SIZE,
882 & IKEEP2, IKEEP1, INFO(1), LP, LPOK )
883.EQ. ELSE IF (METIS_IDX_SIZE 64) THEN
884 CALL MUMPS_METIS_NODEND_MIXEDto64(
885 & NCMP, IPE, IW, FRERE,
886 & METIS_OPTIONS(1), OPT_METIS_SIZE,
887 & IKEEP2, IKEEP1, INFO(1), LP,LPOK,KEEP(10),
888 & LIW8, INPLACE64_GRAPH_COPY,
889 & INPLACE64_RESTORE_GRAPH)
890 ELSE
891 IF (LPOK) WRITE(LP,*)
892 & "Internal error in METIS wrappers, METIS_IDX_SIZE=",
893 & METIS_IDX_SIZE
894 CALL MUMPS_ABORT()
895 ENDIF
896#endif
897.LT. IF (INFO(1) 0) GOTO 90
898 IF ( PROK ) THEN
899 CALL MUMPS_SECFIN( TIMEB )
900 WRITE( MP, '(a,f12.4)' )
901 & ' elapsed time spent in metis reordering =', TIMEB
902 ENDIF
903 IF ( COMPRESS_SCHUR ) THEN
904 CALL CMUMPS_EXPAND_PERM_SCHUR(
905 & N, NCMP, IKEEP1(1),IKEEP2(1),
906 & LISTVAR_SCHUR(1), SIZE_SCHUR, FILS(1))
907 COMPRESS = -1
908 ENDIF
909.EQ. IF (COMPRESS 1) THEN
910 CALL CMUMPS_EXPAND_PERMUTATION(N,NCMP,KEEP(94),
911 & KEEP(93),PIV(1),IKEEP1(1),IKEEP2(1))
912 COMPRESS = -1
913 ENDIF
914 ENDIF
915#endif
916 IF (PROK) THEN
917.EQ. IF (IORD1) THEN
918 WRITE(MP,'(a)') ' ordering given is used'
919 ENDIF
920 ENDIF
921.EQ..OR..EQ..OR..EQ. IF (IORD1 IORD5 COMPRESS-1
922.OR..EQ..AND..NOT. & ( (IORD3)(SCOTCH_SYMBOLIC) )
923.OR. &
924.NE..AND..AND..EQ. & ( (NORIGN)present(SIZEOFBLOCKS) (IORD3)
925.AND..EQ. & (WEIGHTUSED0)
926 & )
927 & ) THEN
928.EQ..OR..EQ..OR..EQ. IF ((KEEP(106)1)(KEEP(106)2)(KEEP(106)4)
929.OR..NE. & (KEEP(60)0)) THEN
930.EQ. IF ( COMPRESS -1 ) THEN
931 ALLOCATE(IPQ8(N),stat=IERR)
932.GT. IF ( IERR 0 ) THEN
933 INFO( 1 ) = -7
934 INFO( 2 ) = N*KEEP(10)
935 ENDIF
936 CALL CMUMPS_ANA_GNEW(N,NZ8,IRN(1),ICN(1),IW(1),LIW8,
937 & IPE(1), PTRAR(1,2),
938 & IPQ8, IWL1, IWFR8, KEEP8(126), KEEP8(127),
939 & INFO(1), INFO(2), ICNTL, symmetry, KEEP(50),
940 & NBQD, AvgDens, KEEP(264),KEEP(265), .TRUE.,
941 & INPLACE64_GRAPH_COPY)
942 DEALLOCATE(IPQ8)
943 ENDIF
944 COMPRESS = 0
945.EQ. IF (KEEP(106)2) THEN
946 IF (PROK) THEN
947 WRITE(MP,*) " SYMBOLIC based on column counts "
948 ENDIF
949 IF (present(SIZEOFBLOCKS)) THEN
950 DO I=1, N
951 FRERE(I) = SIZEOFBLOCKS(I)
952 ENDDO
953 ELSE
954 FRERE(1) = -1
955 ENDIF
956 CALL MUMPS_WRAP_GINP94 (
957 & N, IPE(1), IW(1), IWFR8,
958 & IKEEP1(1),
959 & FRERE(1),
960 & KEEP(60), LISTVAR_SCHUR(1), SIZE_SCHUR,
961 & KEEP(378),
962 & IWL1, PARENT,
963 & IKEEP2(1), IKEEP3(1), NFSIZ(1),
964 & PTRAR(1,1), PTRAR(1,2), PTRAR(1,3),
965 & INFO )
966.LT. IF (INFO(1)0) GOTO 90
967.EQ..AND..EQ..AND. ELSE IF ((KEEP(106)4)(KEEP(60)0)
968.NOT..OR..EQ. & (present(SIZEOFBLOCKS) (NORIGN))
969 & ) THEN
970 WRITE(MP,*) " Undefined option for ICNTL(58) "
971 INFO(1)= -99998
972 GOTO 90
973 ELSE
974 ALLOCATE( WTEMP ( 2*N ), stat = IERR )
975.GT. IF ( IERR 0 ) THEN
976 INFO( 1 ) = -7
977 INFO( 2 ) = 2*N
978 GOTO 90
979 ENDIF
980 THRESH = -1
981 IF (KEEP(60) == 0) THEN
982 ITEMP = 0
983 ELSE
984 ITEMP = SIZE_SCHUR
985 ENDIF
986 AGG6 =.FALSE.
987 IF (present(SIZEOFBLOCKS)) THEN
988 DO I=1, N
989 IWL1(I) = SIZEOFBLOCKS(I)
990 ENDDO
991 TOTEL = NORIG
992 ELSE
993 IWL1(1) = -1
994 TOTEL = N
995 ENDIF
996 CALL MUMPS_SYMQAMD(THRESH, WTEMP,
997 & N, TOTEL, LIW8, IPE(1), IWFR8, PTRAR(1,2), IW(1),
998 & IWL1(1), WTEMP(N+1),
999 & IKEEP2(1), NCMPA, FILS(1), IKEEP3(1), PTRAR,
1000 & PTRAR(1,3),IKEEP1(1), LISTVAR_SCHUR(1), ITEMP,
1001 & AGG6, PARENT)
1002 DEALLOCATE(WTEMP)
1003 ENDIF
1004 ELSE
1005 CALL CMUMPS_ANA_J(N, NZ8, IRN(1), ICN(1), IKEEP1(1), IW(1),
1006 & LIW8, IPE(1),
1007 & PTRAR(1,2), IWL1, IWFR8,
1008 & INFO(1),INFO(2), MP)
1009.EQ. IF (KEEP(60) 0) THEN
1010 ITEMP = 0
1011 ELSE
1012 ITEMP = SIZE_SCHUR
1013 ENDIF
1014 CALL CMUMPS_ANA_K(N, IPE(1), IW(1), LIW8, IWFR8, IKEEP1(1),
1015 & IKEEP2(1), IWL1,
1016 & PTRAR, NCMPA, ITEMP, PARENT)
1017 ENDIF
1018 ENDIF
1019.NE. IF (KEEP(60) 0) THEN
1020 IF (KEEP(60)==1) THEN
1021 KEEP(20) = LISTVAR_SCHUR(1)
1022 ELSE
1023 KEEP(38) = LISTVAR_SCHUR(1)
1024 ENDIF
1025 ENDIF
1026#if defined(OLDDFS)
1027 CALL CMUMPS_ANA_L
1028 & (N, PARENT, IWL1, IKEEP1(1), IKEEP2(1), IKEEP3(1),
1029 & NFSIZ, INFO(6), FILS(1), FRERE(1), PTRAR(1,3),
1030 & NEMIN, KEEP(60))
1031#else
1032 IF (allocated(IPEALLOC)) DEALLOCATE(IPEALLOC)
1033 ALLOCATE(WTEMP(N), stat=IERR)
1034.GT. IF ( IERR 0 ) THEN
1035 INFO( 1 ) = -7
1036 INFO( 2 ) = N
1037 GOTO 90
1038 ENDIF
1039 IF (present(SIZEOFBLOCKS)) THEN
1040 CALL CMUMPS_ANA_LNEW
1041 & (N, PARENT, IWL1, IKEEP1(1), IKEEP2(1), IKEEP3(1),
1042 & NFSIZ(1), PTRAR, INFO(6), FILS(1), FRERE(1),
1043 & PTRAR(1,3), NEMIN, WTEMP, KEEP(60),
1044 & KEEP(20),KEEP(38),PTRAR(1,2),KEEP(104),IW(1),KEEP(50),
1045.EQ. & ICNTL(13), KEEP(37), KEEP(197), NSLAVES, KEEP(250)1
1046 & , .TRUE. , SIZEOFBLOCKS, N
1047 & )
1048 ELSE
1049 CALL CMUMPS_ANA_LNEW
1050 & (N, PARENT, IWL1, IKEEP1(1), IKEEP2(1), IKEEP3(1),
1051 & NFSIZ(1), PTRAR, INFO(6), FILS(1), FRERE(1),
1052 & PTRAR(1,3), NEMIN, WTEMP, KEEP(60),
1053 & KEEP(20),KEEP(38),PTRAR(1,2),KEEP(104),IW(1),KEEP(50),
1054.EQ. & ICNTL(13), KEEP(37), KEEP(197), NSLAVES, KEEP(250)1
1055 & , .FALSE., IDUMMY, LIDUMMY )
1056 ENDIF
1057 DEALLOCATE(WTEMP)
1058#endif
1059.NE. IF (KEEP(60)0) THEN
1060 IF (KEEP(60)==1) THEN
1061 IN = KEEP(20)
1062 ELSE
1063 IN = KEEP(38)
1064 ENDIF
1065.GT. DO WHILE (IN0)
1066 IN = FILS (IN)
1067 END DO
1068 IFSON = -IN
1069 IF (KEEP(60)==1) THEN
1070 IN = KEEP(20)
1071 ELSE
1072 IN = KEEP(38)
1073 ENDIF
1074 DO I=2,SIZE_SCHUR
1075 FILS(IN) = LISTVAR_SCHUR (I)
1076 IN = FILS(IN)
1077 FRERE (IN) = N+1
1078 ENDDO
1079 FILS(IN) = -IFSON
1080 ENDIF
1081 CALL CMUMPS_ANA_M(IKEEP2(1),
1082 & PTRAR(1,3), INFO(6),
1083 & INFO(5), KEEP(2), KEEP(50),
1084 & KEEP8(101), KEEP(108), KEEP(5),
1085 & KEEP(6), KEEP(226), KEEP(253))
1086 KEEP(59) = INFO(5)
1087.NE. IF ( KEEP(53) 0 ) THEN
1088 CALL MUMPS_MAKE1ROOT( N, FRERE(1), FILS(1), NFSIZ(1),
1089 & KEEP(20) )
1090 END IF
1091.AND..GT. IF ( (KEEP(48) == 4 KEEP8(21)0_8)
1092.OR. &
1093.AND..GT. & (KEEP (48)==5 KEEP8(21) 0_8 )
1094.OR. &
1095.NE..AND..GT. & (KEEP(24)0KEEP8(21)0_8) ) THEN
1096 CALL CMUMPS_SET_K821_SURFACE(KEEP8(21), KEEP(2),
1097 & KEEP(48), KEEP(50), NSLAVES)
1098 END IF
1099.LT..OR..GT. IF (KEEP(210)0KEEP(210)2) THEN
1100 KEEP(210)=0
1101 ENDIF
1102.EQ..AND..GT. IF (KEEP(210)0KEEP(201)0) THEN
1103 KEEP(210)=1
1104 ENDIF
1105.EQ..AND..EQ. IF (KEEP(210)0KEEP(201)0) THEN
1106 KEEP(210)=2
1107 ENDIF
1108.EQ. IF (KEEP(210)2) THEN
1109 KEEP8(79)=huge(KEEP8(79))
1110 ENDIF
1111.EQ..AND..LE. IF (KEEP(210)1KEEP8(79)0_8) THEN
1112 KEEP8(79)=K79REF * int(NSLAVES,8)
1113 ENDIF
1114.EQ..OR..EQ..OR. IF ( (KEEP(79)0)(KEEP(79)2)
1115.EQ..OR..EQ..OR. & (KEEP(79)3)(KEEP(79)5)
1116.EQ. & (KEEP(79)6)
1117 & ) THEN
1118.EQ. IF (KEEP(210)1) THEN
1119 SPLITROOT = .FALSE.
1120.GE. IF ( KEEP(62)1) THEN
1121 IWL1(1) = -1
1122 IF (present(SIZEOFBLOCKS)) THEN
1123 DO I= 1, N
1124 IWL1(I) = SIZEOFBLOCKS(I)
1125 ENDDO
1126 ENDIF
1127 CALL CMUMPS_CUTNODES(N, FRERE(1), FILS(1), NFSIZ(1),
1128 & IWL1(1), N, INFO(6),
1129 & NSLAVES, KEEP,KEEP8, SPLITROOT,
1130 & MP, LDIAG, INFO(1), INFO(2))
1131.LT. IF (INFO(1)0) GOTO 90
1132 IF (PROK) THEN
1133 WRITE(MP,*) " Number of split nodes in pre-splitting=",
1134 & KEEP(61)
1135 ENDIF
1136 ENDIF
1137 ENDIF
1138 ENDIF
1139.GT..AND..GT..OR. SPLITROOT = ((ICNTL(13)0 NSLAVESICNTL(13))
1140.EQ. & ICNTL(13)-1 )
1141.NE. IF (KEEP(53) 0) THEN
1142 SPLITROOT = .TRUE.
1143 ENDIF
1144.AND..EQ. SPLITROOT = (SPLITROOT( (KEEP(60)0) ))
1145 IF (SPLITROOT) THEN
1146 IWL1(1) = -1
1147 IF (present(SIZEOFBLOCKS)) THEN
1148 DO I= 1, N
1149 IWL1(I) = SIZEOFBLOCKS(I)
1150 ENDDO
1151 ENDIF
1152 CALL CMUMPS_CUTNODES(N, FRERE(1), FILS(1), NFSIZ(1),
1153 & IWL1(1), N, INFO(6),
1154 & NSLAVES, KEEP,KEEP8, SPLITROOT,
1155 & MP, LDIAG, INFO(1), INFO(2))
1156.LT. IF (INFO(1)0) GOTO 90
1157.NE. IF ( KEEP(53) 0 ) THEN
1158 CALL MUMPS_MAKE1ROOT( N, FRERE(1), FILS(1), NFSIZ(1),
1159 & KEEP(20) )
1160 ENDIF
1161 ENDIF
1162.GT..AND..GT. IF (LDIAG2 MP0) THEN
1163 K = min0(10,N)
1164.EQ. IF (LDIAG4) K = N
1165.GT. IF (K0) WRITE (MP,99987) (NFSIZ(I),I=1,K)
1166.GT. IF (K0) WRITE (MP,99989) (FILS(I),I=1,K)
1167.GT. IF (K0) WRITE (MP,99988) (FRERE(I),I=1,K)
1168 ENDIF
1169 GO TO 90
1170 90 CONTINUE
1171.NE. IF (INFO(1) 0) THEN
1172.GT..AND..GE. IF ((LP0)(ICNTL(4)1))
1173 & WRITE (LP,99996) INFO(1), INFO(2)
1174 ENDIF
1175 IF (allocated(IWALLOC)) DEALLOCATE(IWALLOC)
1176 IF (allocated(IWL1)) DEALLOCATE(IWL1)
1177 IF (allocated(IPEALLOC)) DEALLOCATE(IPEALLOC)
1178 IF (allocated(PTRAR)) DEALLOCATE(PTRAR)
1179 IF (allocated(PARENT)) DEALLOCATE(PARENT)
1180 RETURN
118199999 FORMAT (/'entering ordering phase with ...'/
1182 & ' n nnz liw info(1)'/,
1183 & 6X, I10, I11, I12, I10)
118499998 FORMAT ('matrix entries: irn() icn()'/
1185 & (I12, I9, I12, I9, I12, I9))
118699909 FORMAT (/'entering ordering phase with graph dimensions ...'/
1187 & ' |v| |e| info(1)'/,
1188 & 10X, I10, I13, I10)
118999997 FORMAT ('ikeep1(.)=', 10I8/(12X, 10I8))
119099996 FORMAT
1191 & (/'** error/warning return ** from analysis * info(1:2)= ',
1192 & (I3, I16))
119399989 FORMAT ('fils(.) =', 10I9/(11X, 10I9))
119499988 FORMAT ('frere(.) =', 10I9/(11X, 10I9))
119599987 FORMAT ('nfsiz(.) =', 10I9/(11X, 10I9))
1196 END SUBROUTINE CMUMPS_ANA_F
1197 SUBROUTINE CMUMPS_ANA_N_DIST( id, PTRAR )
1198 USE CMUMPS_STRUC_DEF, ONLY : CMUMPS_STRUC
1199 IMPLICIT NONE
1200 include 'mpif.h'
1201 TYPE(CMUMPS_STRUC), INTENT(INOUT), TARGET :: id
1202 INTEGER(8), INTENT(OUT), TARGET :: PTRAR(:)
1203 INTEGER :: IERR, allocok
1204 INTEGER :: IOLD, JOLD, INEW, JNEW
1205 INTEGER(8) :: K, INZ
1206 INTEGER, POINTER :: IIRN(:), IJCN(:)
1207 INTEGER(8), POINTER :: IWORK1(:), IWORK2(:)
1208 LOGICAL :: IDO
1209.EQ. IF(id%KEEP(54) 3) THEN
1210 IIRN => id%IRN_loc
1211 IJCN => id%JCN_loc
1212 INZ = id%KEEP8(29)
1213 IWORK1 => PTRAR(id%N+1:id%N+id%N)
1214 allocate(IWORK2(id%N),stat=allocok)
1215 IF (allocok > 0 ) THEN
1216 id%INFO(1) = -7
1217 id%INFO(2) = id%N
1218 RETURN
1219 ENDIF
1220 IDO = .TRUE.
1221 ELSE
1222 IIRN => id%IRN
1223 IJCN => id%JCN
1224 INZ = id%KEEP8(28)
1225 IWORK1 => PTRAR(1:id%N)
1226 IWORK2 => PTRAR(id%N+1:id%N+id%N)
1227.EQ. IDO = id%MYID 0
1228 END IF
1229 DO 50 IOLD=1,id%N
1230 IWORK1(IOLD) = 0_8
1231 IWORK2(IOLD) = 0_8
1232 50 CONTINUE
1233 IF(IDO) THEN
1234 DO 70 K=1_8,INZ
1235 IOLD = IIRN(K)
1236 JOLD = IJCN(K)
1237.GT..OR..GT..OR..LT. IF ( (IOLDid%N)(JOLDid%N)(IOLD1)
1238.OR..LT. & (JOLD1) ) GOTO 70
1239.NE. IF (IOLDJOLD) THEN
1240 INEW = id%SYM_PERM(IOLD)
1241 JNEW = id%SYM_PERM(JOLD)
1242.EQ. IF ( id%KEEP( 50 ) 0 ) THEN
1243.LT. IF (INEWJNEW) THEN
1244 IWORK2(IOLD) = IWORK2(IOLD) + 1_8
1245 ELSE
1246 IWORK1(JOLD) = IWORK1(JOLD) + 1_8
1247 ENDIF
1248 ELSE
1249.LT. IF ( INEW JNEW ) THEN
1250 IWORK1( IOLD ) = IWORK1( IOLD ) + 1_8
1251 ELSE
1252 IWORK1( JOLD ) = IWORK1( JOLD ) + 1_8
1253 END IF
1254 ENDIF
1255 ENDIF
1256 70 CONTINUE
1257 END IF
1258.EQ. IF (id%KEEP(54) 3) THEN
1259 CALL MPI_ALLREDUCE(IWORK1(1), PTRAR(1), id%N,
1260 & MPI_INTEGER8, MPI_SUM, id%COMM, IERR )
1261 CALL MPI_ALLREDUCE(IWORK2(1), PTRAR(id%N+1), id%N,
1262 & MPI_INTEGER8, MPI_SUM, id%COMM, IERR )
1263 deallocate(IWORK2)
1264 ELSE
1265 CALL MPI_BCAST( PTRAR(1), 2*id%N, MPI_INTEGER8,
1266 & 0, id%COMM, IERR )
1267 END IF
1268 RETURN
1269 END SUBROUTINE CMUMPS_ANA_N_DIST
1270 SUBROUTINE CMUMPS_ANA_O( N, NZ, MTRANS, PERM, IKEEPALLOC,
1271 & idIRN, idJCN, idA, idROWSCA, idCOLSCA, WORK2, KEEP,
1272 & ICNTL, INFO, INFOG )
1273 IMPLICIT NONE
1274 INTEGER, INTENT(IN) :: N
1275 INTEGER(8), INTENT(IN) :: NZ
1276 INTEGER, INTENT(OUT) :: PERM(:)
1277 INTEGER, POINTER, DIMENSION(:) :: idIRN, idJCN
1278 COMPLEX, POINTER, DIMENSION(:) :: idA
1279 REAL, POINTER, DIMENSION(:) :: idROWSCA, idCOLSCA
1280 INTEGER, TARGET :: IKEEPALLOC(3*N)
1281 INTEGER, INTENT(INOUT) :: MTRANS
1282 INTEGER :: KEEP(500)
1283 INTEGER, INTENT(IN) :: ICNTL(60)
1284 INTEGER, INTENT(INOUT) :: INFO(80)
1285 INTEGER, INTENT(INOUT) :: INFOG(80)
1286 INTEGER, TARGET :: WORK2(N)
1287 INTEGER :: allocok
1288 INTEGER, ALLOCATABLE, DIMENSION(:) :: IW
1289 REAL, ALLOCATABLE, DIMENSION(:) :: S2
1290 TARGET :: S2
1291 INTEGER ICNTL64(10), INFO64(10)
1292 INTEGER ICNTL_SYM_MWM(10),INFO_SYM_MWM(10)
1293 REAL CNTL64(10)
1294 INTEGER MPRINT,LP, MP
1295 INTEGER JPERM
1296 INTEGER NUMNZ, I, J, JPOS
1297 LOGICAL PROK, IDENT, DUPPLI
1298 INTEGER K50, KER_SIZE, NZER_DIAG, MTRANSLOC,RZ_DIAG
1299 INTEGER(8) :: LIWG
1300 INTEGER(8), DIMENSION(:), ALLOCATABLE :: IPE
1301 INTEGER(8), DIMENSION(:), ALLOCATABLE :: IPQ8
1302 INTEGER :: LSC
1303 INTEGER(8) :: NZTOT, NZREAL, IPIW, LIW, LIWMIN, NZsave,
1304 & K, KPOS, LDW, LDWMIN, IRNW, RSPOS, CSPOS,
1305 & LS2,J8, N8
1306 LOGICAL SCALINGLOC
1307 INTEGER,POINTER,DIMENSION(:) :: ZERODIAG
1308 INTEGER,POINTER,DIMENSION(:) :: STR_KER
1309 INTEGER,POINTER,DIMENSION(:) :: MARKED
1310 INTEGER,POINTER,DIMENSION(:) :: FLAG
1311 INTEGER,POINTER,DIMENSION(:) :: PIV_OUT
1312 REAL THEMIN, THEMAX, COLNORM,MAXDBL, ABSAK
1313 REAL ZERO,TWO,ONE
1314 PARAMETER(ZERO = 0.0E0,TWO = 2.0E0,ONE = 1.0E0)
1315 N8 = int(N,8)
1316 MPRINT = ICNTL(3)
1317 LP = ICNTL(1)
1318 MP = ICNTL(2)
1319.GT..AND..GE. PROK = ((MPRINT0)(ICNTL(4)2))
1320 K50 = KEEP(50)
1321 SCALINGLOC = .FALSE.
1322.EQ. IF(KEEP(52) -2) THEN
1323.not. IF(associated(idA)) THEN
1324 ELSE
1325 SCALINGLOC = .TRUE.
1326 ENDIF
1327.EQ. ELSE IF(KEEP(52) 77) THEN
1328 SCALINGLOC = .TRUE.
1329.NE..AND..NE. IF( MTRANS 5 MTRANS 6
1330.AND..NE. & MTRANS 7) THEN
1331 SCALINGLOC = .FALSE.
1332 ENDIF
1333.not. IF(associated(idA)) THEN
1334 SCALINGLOC = .FALSE.
1335 IF (PROK)
1336 & WRITE(MPRINT,*) 'analysis: auto scaling off because ',
1337 & 'a not provided at analysis '
1338 ENDIF
1339 ENDIF
1340.EQ..AND..NE..AND. IF ( (KEEP(50)2)(ICNTL(8)-2)
1341.EQ..OR..EQ. & (MTRANS 7 KEEP(95) 0) ) THEN
1342 ZERODIAG => IKEEPALLOC(1:N)
1343 ZERODIAG = 0
1344 NZER_DIAG = N
1345 RZ_DIAG = 0
1346 DO K=1,NZ
1347 I = idIRN(K)
1348 J = idJCN(K)
1349.NE. IF (IJ) CYCLE
1350.LE..AND..GE. IF ( (JN)(J1) ) THEN
1351.EQ. IF(ZERODIAG(I) 0) THEN
1352 ZERODIAG(I) = 1
1353 IF(associated(idA)) THEN
1354 ABSAK= abs(idA(K))
1355.EQ. IF(ABSAK real(0.0E0)) THEN
1356 RZ_DIAG = RZ_DIAG + 1
1357 ENDIF
1358 ENDIF
1359 NZER_DIAG = NZER_DIAG - 1
1360 ENDIF
1361 ENDIF
1362 ENDDO
1363.LT. IF( (NZER_DIAG+RZ_DIAG) (N/10) ) THEN
1364 MTRANS = 0
1365 KEEP(95) =1
1366 GOTO 500
1367 ENDIF
1368 ENDIF
1369 IF(SCALINGLOC) THEN
1370 IF (PROK) WRITE(MPRINT,*)
1371 & 'scaling will be computed during analysis'
1372 ENDIF
1373.NE..AND..NOT. IF( MTRANS0 (associated(idA)) ) MTRANS=1
1374 MTRANSLOC = MTRANS
1375.LT..OR..GT. IF (MTRANS0 MTRANS7) GO TO 500
1376.EQ. IF (K50 0) THEN
1377.NOT..AND..EQ. IF( SCALINGLOC MTRANS 7) THEN
1378 GO TO 500
1379 ENDIF
1380 IF(SCALINGLOC) THEN
1381.NE. IF (MTRANSLOC6) THEN
1382 MTRANSLOC = 5
1383 ENDIF
1384 ENDIF
1385 ELSE
1386.EQ. IF (MTRANS 7) MTRANSLOC = 5
1387 ENDIF
1388.AND..NE..AND. IF(SCALINGLOC MTRANSLOC 5
1389.NE. & MTRANSLOC 6 ) THEN
1390 IF (PROK) WRITE(MPRINT,*)
1391 & 'warning scaling required: set mtrans option to 5'
1392 MTRANSLOC = 5
1393 ENDIF
1394.EQ. IF (N1) THEN
1395 MTRANS=0
1396 GO TO 500
1397 ENDIF
1398.NE. IF(K50 0) THEN
1399 NZTOT = 2_8*NZ+N8
1400 ELSE
1401 NZTOT = NZ
1402 ENDIF
1403 ZERODIAG => IKEEPALLOC(1:N)
1404 STR_KER => IKEEPALLOC(N+1:2*N)
1405 CALL CMUMPS_MTRANSI(ICNTL64,CNTL64)
1406 ICNTL64(1) = ICNTL(1)
1407 ICNTL64(2) = ICNTL(2)
1408 ICNTL64(3) = ICNTL(3)
1409 ICNTL64(4) = -1
1410.EQ. IF (ICNTL(4)3) ICNTL64(4) = 0
1411.EQ. IF (ICNTL(4)4) ICNTL64(4) = 1
1412 ICNTL64(5) = -1
1413 IF (PROK) THEN
1414 WRITE(MPRINT,'(a,i3)')
1415 & 'compute maximum matching(maximum transversal):',
1416 & MTRANSLOC
1417.EQ. IF (MTRANSLOC1)
1418 & WRITE(MPRINT,'(a,i3)')' ... job =',MTRANSLOC
1419.EQ. IF (MTRANSLOC2)
1420 & WRITE(MPRINT,'(a,i3,a)')
1421 & ' ... job =',MTRANSLOC,': bottleneck thesis'
1422.EQ. IF (MTRANSLOC3)
1423 & WRITE(MPRINT,'(a,i3,a)')
1424 & ' ... job =',MTRANSLOC,': bottleneck simax'
1425.EQ. IF (MTRANSLOC4)
1426 & WRITE(MPRINT,'(a,i3,a)')
1427 & ' ... job =',MTRANSLOC,': maximize sum diagonal'
1428.EQ..OR..EQ. IF (MTRANSLOC5 MTRANSLOC6)
1429 & WRITE(MPRINT,'(a,i3,a)')
1430 & ' ... job =',MTRANSLOC,
1431 & ': maximize product diagonal and scale'
1432 ENDIF
1433 INFOG(23) = MTRANSLOC
1434 CNTL64(2) = huge(CNTL64(2))
1435 IRNW = 1
1436 IPIW = IRNW + NZTOT
1437.EQ. IF (MTRANSLOC1) LIWMIN = 5_8*N8
1438.EQ. IF (MTRANSLOC2) LIWMIN = 3_8*N8
1439.EQ. IF (MTRANSLOC3) LIWMIN = 10_8*N8 + NZTOT
1440.EQ. IF (MTRANSLOC4) LIWMIN = 2_8*N8
1441.EQ. IF (MTRANSLOC5) LIWMIN = 5_8*N8
1442.EQ. IF (MTRANSLOC6) LIWMIN = 5_8*N8 + NZTOT
1443 LIW = LIWMIN
1444 LIWG = LIW + NZTOT
1445 ALLOCATE(IW(LIWG), stat=allocok)
1446.GT. IF (allocok 0 ) THEN
1447 GOTO 410
1448 ENDIF
1449 ALLOCATE( IPQ8(N), IPE(N+1), stat = allocok )
1450.GT. IF ( allocok 0 ) THEN
1451 INFO( 1 ) = -7
1452 INFO( 2 ) = (2*N+1)*KEEP(10)
1453 GOTO 500
1454 ENDIF
1455.EQ. IF (MTRANSLOC1) THEN
1456 LDWMIN = N8+3_8
1457 ENDIF
1458.EQ. IF (MTRANSLOC2) LDWMIN = max( N8+NZTOT , N8+3_8 )
1459.EQ. IF (MTRANSLOC3) LDWMIN = max( NZTOT+1_8 , N8+3_8 )
1460.EQ. IF (MTRANSLOC4) LDWMIN = 2_8 * N8 +
1461 & max( NZTOT , N8+3_8 )
1462.EQ. IF (MTRANSLOC5) LDWMIN = 3_8*N8 + NZTOT
1463.EQ. IF (MTRANSLOC6) LDWMIN = 4_8*N8 + NZTOT
1464 LDW = LDWMIN
1465 ALLOCATE(S2(LDW), stat=allocok)
1466.GT. IF (allocok 0 ) THEN
1467 GOTO 430
1468 ENDIF
1469.NE. IF(MTRANSLOC 1) LDW = LDW-NZTOT
1470 RSPOS = NZTOT
1471 CSPOS = RSPOS+N8
1472 NZREAL = 0_8
1473 DO 5 J=1,N
1474 IPQ8(J) = 0_8
1475 5 CONTINUE
1476.EQ. IF(K50 0) THEN
1477 DO 10 K=1,NZ
1478 I = idIRN(K)
1479 J = idJCN(K)
1480.LE..AND..GE..AND. IF ( (JN)(J1)
1481.LE..AND..GE. & (IN)(I1) ) THEN
1482 IPQ8(J) = IPQ8(J) + 1_8
1483 NZREAL = NZREAL + 1_8
1484 ENDIF
1485 10 CONTINUE
1486 ELSE
1487 ZERODIAG = 0
1488 NZER_DIAG = N
1489 RZ_DIAG = 0
1490 DO K=1,NZ
1491 I = idIRN(K)
1492 J = idJCN(K)
1493.LE..AND..GE..AND. IF ( (JN)(J1)
1494.LE..AND..GE. & (IN)(I1) ) THEN
1495 IPQ8(J) = IPQ8(J) + 1_8
1496 NZREAL = NZREAL + 1_8
1497.NE. IF(I J) THEN
1498 IPQ8(I) = IPQ8(I) + 1_8
1499 NZREAL = NZREAL + 1_8
1500 ELSE
1501.EQ. IF (ZERODIAG(I) 0) THEN
1502 ZERODIAG(I) = 1
1503 IF(associated(idA)) THEN
1504 ABSAK= abs(idA(K))
1505.EQ. IF(ABSAK real(0.0E0)) THEN
1506 RZ_DIAG = RZ_DIAG + 1
1507 ENDIF
1508 ZERODIAG(I) = exponent(ABSAK)
1509.EQ. if ( ZERODIAG(I)0) ZERODIAG(I)=1
1510 ENDIF
1511 NZER_DIAG = NZER_DIAG - 1
1512 ELSE
1513 IF(associated(idA)) THEN
1514 ABSAK= abs(idA(K))
1515 ZERODIAG(I) = ZERODIAG(I)+ exponent(ABSAK)
1516.EQ. if ( ZERODIAG(I)0) ZERODIAG(I)=1
1517 ENDIF
1518 ENDIF
1519 ENDIF
1520 ENDIF
1521 ENDDO
1522.GE. IF(MTRANSLOC 4) THEN
1523 DO I =1, N
1524.EQ. IF(ZERODIAG(I) 0) THEN
1525 IPQ8(I) = IPQ8(I) + 1_8
1526 NZREAL = NZREAL + 1_8
1527 ENDIF
1528 ENDDO
1529 ENDIF
1530 ENDIF
1531 IPE(1) = 1
1532 DO 20 J=1,N
1533 IPE(J+1) = IPE(J)+IPQ8(J)
1534 20 CONTINUE
1535 DO 25 J=1, N
1536 IPQ8(J ) = IPE(J)
1537 25 CONTINUE
1538.EQ. IF(K50 0) THEN
1539.EQ. IF (MTRANSLOC1) THEN
1540 DO K=1,NZ
1541 I = idIRN(K)
1542 J = idJCN(K)
1543.LE..AND..GE..AND. IF ( (JN)(J1)
1544.LE..AND..GE. & (IN)(I1)) THEN
1545 KPOS = IPQ8(J)
1546 IW(IRNW+KPOS-1_8) = I
1547 IPQ8(J) = IPQ8(J) + 1_8
1548 ENDIF
1549 END DO
1550 ELSE
1551.not. IF ( associated(idA)) THEN
1552 INFO(1) = -22
1553 INFO(2) = 4
1554 GOTO 500
1555 ENDIF
1556 DO K=1,NZ
1557 I = idIRN(K)
1558 J = idJCN(K)
1559.LE..AND..GE..AND. IF ( (JN)(J1)
1560.LE..AND..GE. & (IN)(I1)) THEN
1561 KPOS = IPQ8(J)
1562 IW(IRNW+KPOS-1) = I
1563 S2(KPOS) = abs(idA(K))
1564 IPQ8(J) = IPQ8(J) + 1_8
1565 ENDIF
1566 END DO
1567 ENDIF
1568 ELSE
1569.EQ. IF (MTRANSLOC1) THEN
1570 DO K=1,NZ
1571 I = idIRN(K)
1572 J = idJCN(K)
1573.LE..AND..GE..AND. IF ( (JN)(J1)
1574.LE..AND..GE. & (IN)(I1)) THEN
1575 KPOS = IPQ8(J)
1576 IW(IRNW+KPOS-1) = I
1577 IPQ8(J) = IPQ8(J) + 1_8
1578.NE. IF(IJ) THEN
1579 KPOS = IPQ8(I)
1580 IW(IRNW+KPOS-1) = J
1581 IPQ8(I) = IPQ8(I) + 1_8
1582 ENDIF
1583 ENDIF
1584 ENDDO
1585 ELSE
1586.not. IF ( associated(idA) ) THEN
1587 INFO(1) = -22
1588 INFO(2) = 4
1589 GOTO 500
1590 ENDIF
1591 THEMAX = ZERO
1592 THEMIN = huge(THEMIN)
1593 DO K=1,NZ
1594 I = idIRN(K)
1595 J = idJCN(K)
1596.LE..AND..GE..AND. IF ( (JN)(J1)
1597.LE..AND..GE. & (IN)(I1)) THEN
1598 KPOS = IPQ8(J)
1599 IW(IRNW+KPOS-1_8) = I
1600 S2(KPOS) = abs(idA(K))
1601 IPQ8(J) = IPQ8(J) + 1_8
1602.GT. IF(abs(idA(K)) THEMAX) THEN
1603 THEMAX = abs(idA(K))
1604.LT. ELSE IF(abs(idA(K)) THEMIN
1605.AND..GT. & abs(idA(K)) ZERO) THEN
1606 THEMIN = abs(idA(K))
1607 ENDIF
1608.NE. IF(IJ) THEN
1609 KPOS = IPQ8(I)
1610 IW(IRNW+KPOS-1) = J
1611 S2(KPOS) = abs(idA(K))
1612 IPQ8(I) = IPQ8(I) + 1_8
1613 ENDIF
1614 ENDIF
1615 ENDDO
1616 DO I =1, N
1617.EQ. IF(ZERODIAG(I) 0) THEN
1618 KPOS = IPQ8(I)
1619 IW(IRNW+KPOS-1) = I
1620 S2(KPOS) = ZERO
1621 IPQ8(I) = IPQ8(I) + 1_8
1622 ENDIF
1623 ENDDO
1624.NE. IF ( THEMAX ZERO ) THEN
1625 CNTL64(2) = (log(THEMAX/THEMIN))*(real(N))
1626 & - log(THEMIN) + ONE
1627 ENDIF
1628 ENDIF
1629 ENDIF
1630 DUPPLI = .FALSE.
1631 NZsave = NZREAL
1632 FLAG => IKEEPALLOC(2*N+1:3*N)
1633.NE. IF(MTRANSLOC1) THEN
1634 CALL CMUMPS_SUPPRESS_DUPPLI_VAL(N,NZREAL,IPE(1),IW(IRNW),S2,
1635 & PERM(1),IPQ8(1))
1636 ELSE
1637 CALL CMUMPS_SUPPRESS_DUPPLI_STR(N,NZREAL,IPE(1),IW(IRNW),
1638 & PERM(1))
1639 ENDIF
1640.NE. IF(NZREAL NZsave) DUPPLI = .TRUE.
1641 LS2 = NZTOT
1642.EQ. IF ( MTRANSLOC 1 ) THEN
1643 LS2 = 1_8
1644 LDW = 1_8
1645 ENDIF
1646 CALL CMUMPS_MTRANS_DRIVER(MTRANSLOC ,N, N, NZREAL,
1647 & IPE, IW(IRNW), S2(1), LS2,
1648 & NUMNZ, PERM(1), LIW, IW(IPIW), LDW, S2(LS2+1),
1649 & IPQ8,
1650 & ICNTL64, CNTL64, INFO64, INFO)
1651.LT. IF (INFO(1)0) THEN
1652.GT..AND..GE. IF (LP0 ICNTL(4)1)
1653 & WRITE(LP,'(a,i5)')
1654 & ' not enough memory in maxtrans info(1)=',INFO(1)
1655 GOTO 500
1656 ENDIF
1657.LT. IF (INFO64(1)0) THEN
1658.GT..AND..GE. IF (LP0 ICNTL(4)1)
1659 & WRITE(LP,'(a,i5)')
1660 & ' internal error in maxtrans info(1)=',INFO64(1)
1661 INFO(1) = -9964
1662 INFO(2) = INFO64(1)
1663 GO TO 500
1664 ENDIF
1665.GT. IF (INFO64(1)0) THEN
1666.GT..AND..GE. IF (MP0 ICNTL(4)2)
1667 & WRITE(MP,'(a,i5)')
1668 & ' warning in maxtrans info(1)=',INFO64(1)
1669 ENDIF
1670 KER_SIZE = 0
1671.EQ. IF(K50 2) THEN
1672 DO I=1,N
1673.EQ. IF(ZERODIAG(I) 0) THEN
1674.EQ. IF(PERM(I) I) THEN
1675 KER_SIZE = KER_SIZE + 1
1676 PERM(I) = -I
1677 STR_KER(KER_SIZE) = I
1678 ENDIF
1679 ENDIF
1680 ENDDO
1681 ENDIF
1682.LT. IF (NUMNZN) GO TO 400
1683.EQ. IF(K50 0) THEN
1684 IDENT = .TRUE.
1685.EQ. IF (MTRANS 0 ) GOTO 102
1686 DO 80 J=1,N
1687 JPERM = PERM(J)
1688 IW(IRNW+int(JPERM-1,8)) = J
1689.NE. IF (JPERMJ) IDENT = .FALSE.
1690 80 CONTINUE
1691 IF(IDENT) THEN
1692 MTRANS = 0
1693 ELSE
1694.EQ. IF(MTRANS 7) THEN
1695 MTRANS = -9876543
1696 GOTO 102
1697 ENDIF
1698 IF (PROK) WRITE(MPRINT,'(a)')
1699 & ' ... apply column permutation'
1700 DO 100 K=1,NZ
1701 J = idJCN(K)
1702.LE..OR..GT. IF ((J0)(JN)) GO TO 100
1703 idJCN(K) = IW(IRNW+int(J-1,8))
1704 100 CONTINUE
1705.GT..AND..GE. IF (MP0 ICNTL(4)2)
1706 & WRITE(MP,'(/a)')
1707 & ' warning input matrix data modified'
1708 ENDIF
1709 102 CONTINUE
1710 IF (SCALINGLOC) THEN
1711 IF ( associated(idCOLSCA))
1712 & DEALLOCATE( idCOLSCA )
1713 IF ( associated(idROWSCA))
1714 & DEALLOCATE( idROWSCA )
1715 ALLOCATE( idCOLSCA(N), stat=allocok)
1716.GT. IF (allocok 0) THEN
1717 INFO(1)=-5
1718 INFO(2)=N
1719.GE..AND..GE. IF ((LP0)(ICNTL(4)1)) THEN
1720 WRITE (LP,'(/a)') '** error in cmumps_ana_o'
1721 WRITE (LP,'(a)')
1722 & '** failure during allocation of colsca'
1723 GOTO 500
1724 ENDIF
1725 ENDIF
1726 ALLOCATE( idROWSCA(N), stat=allocok)
1727.GT. IF (allocok 0) THEN
1728 INFO(1)=-5
1729 INFO(2)=N
1730.GE..AND..GE. IF ((LP0)(ICNTL(4)1)) THEN
1731 WRITE (LP,'(/a)') '** error in cmumps_ana_o'
1732 WRITE (LP,'(a)')
1733 & '** failure during allocation of rowsca'
1734 GOTO 500
1735 ENDIF
1736 ENDIF
1737 KEEP(52) = -2
1738 KEEP(74) = 1
1739 MAXDBL = log(huge(MAXDBL))
1740 DO J=1,N
1741.GT. IF(S2(RSPOS+J) MAXDBL) THEN
1742 S2(RSPOS+J) = ZERO
1743 ENDIF
1744.GT. IF(S2(CSPOS+J) MAXDBL) THEN
1745 S2(CSPOS+J)= ZERO
1746 ENDIF
1747 ENDDO
1748 DO 105 J=1,N
1749 J8 = int(J,8)
1750 idROWSCA(J) = exp(S2(RSPOS+J8))
1751.EQ. IF(idROWSCA(J) ZERO) THEN
1752 idROWSCA(J) = ONE
1753 ENDIF
1754.EQ..OR..EQ. IF ( MTRANS -9876543 MTRANS 0 ) THEN
1755 idCOLSCA(J)= exp(S2(CSPOS+J8))
1756.EQ. IF(idCOLSCA(J) ZERO) THEN
1757 idCOLSCA(J) = ONE
1758 ENDIF
1759 ELSE
1760 idCOLSCA(IW(IRNW+J8-1_8))= exp(S2(CSPOS+J8))
1761.EQ. IF(idCOLSCA(IW(IRNW+J8-1_8)) ZERO) THEN
1762 idCOLSCA(IW(IRNW+J8-1_8)) = ONE
1763 ENDIF
1764 ENDIF
1765 105 CONTINUE
1766 ENDIF
1767 ELSE
1768 IDENT = .FALSE.
1769 IF(SCALINGLOC) THEN
1770 IF ( associated(idCOLSCA)) DEALLOCATE( idCOLSCA )
1771 IF ( associated(idROWSCA)) DEALLOCATE( idROWSCA )
1772 ALLOCATE( idCOLSCA(N), stat=allocok)
1773.GT. IF (allocok 0) THEN
1774 INFO(1)=-5
1775 INFO(2)=N
1776.GE..AND..GE. IF ((LP0)(ICNTL(4)1)) THEN
1777 WRITE (LP,'(/a)') '** error in cmumps_ana_o'
1778 WRITE (LP,'(a)')
1779 & '** failure during allocation of colsca'
1780 GOTO 500
1781 ENDIF
1782 ENDIF
1783 ALLOCATE( idROWSCA(N), stat=allocok)
1784.GT. IF (allocok 0) THEN
1785 INFO(1)=-5
1786 INFO(2)=N
1787.GE..AND..GE. IF ((LP0)(ICNTL(4)1)) THEN
1788 WRITE (LP,'(/a)') '** error in cmumps_ana_o'
1789 WRITE (LP,'(a)')
1790 & '** failure during allocation of rowsca'
1791 GOTO 500
1792 ENDIF
1793 ENDIF
1794 KEEP(52) = -2
1795 KEEP(74) = 1
1796 MAXDBL = log(huge(MAXDBL))
1797 DO J=1,N
1798 J8 = int(J,8)
1799.GT. IF(S2(RSPOS+J8)+S2(CSPOS+J8) MAXDBL) THEN
1800 S2(RSPOS+J8) = ZERO
1801 S2(CSPOS+J8)= ZERO
1802 ENDIF
1803 ENDDO
1804 DO J=1,N
1805 J8 = int(J,8)
1806.GT. IF(PERM(J) 0) THEN
1807 idROWSCA(J) =
1808 & exp((S2(RSPOS+J8)+S2(CSPOS+J8))/TWO)
1809.EQ. IF(idROWSCA(J) ZERO) THEN
1810 idROWSCA(J) = ONE
1811 ENDIF
1812 idCOLSCA(J)= idROWSCA(J)
1813 ENDIF
1814 ENDDO
1815 DO JPOS=1,KER_SIZE
1816 I = STR_KER(JPOS)
1817 COLNORM = ZERO
1818 DO K = IPE(I),IPE(I+1) - 1
1819 IF ( PERM( IW( IRNW+K-1_8) ) > 0 ) THEN
1820 COLNORM = max(COLNORM,S2(J))
1821 ENDIF
1822 ENDDO
1823 COLNORM = exp(COLNORM)
1824 idROWSCA(I) = ONE / COLNORM
1825 idCOLSCA(I) = idROWSCA(I)
1826 ENDDO
1827 ENDIF
1828.EQ..OR..EQ. IF(MTRANS 7 KEEP(95) 0) THEN
1829.LT. IF( (NZER_DIAG+RZ_DIAG) (N/10)
1830.AND..EQ. & KEEP(95) 0) THEN
1831 MTRANS = 0
1832 KEEP(95) = 1
1833 GOTO 390
1834 ELSE
1835.EQ. IF(KEEP(95) 0) THEN
1836 IF(SCALINGLOC) THEN
1837 KEEP(95) = 3
1838 ELSE
1839 KEEP(95) = 2
1840 ENDIF
1841 ENDIF
1842.EQ. IF(MTRANS 7) MTRANS = 5
1843 ENDIF
1844 ENDIF
1845.EQ. IF(MTRANS 0) GOTO 390
1846 ICNTL_SYM_MWM = 0
1847 INFO_SYM_MWM = 0
1848.EQ..OR..EQ..OR. IF(MTRANS 5 MTRANS 6
1849.EQ. & MTRANS 7) THEN
1850 ICNTL_SYM_MWM(1) = 0
1851 ICNTL_SYM_MWM(2) = 1
1852.EQ. ELSE IF(MTRANS 4) THEN
1853 ICNTL_SYM_MWM(1) = 2
1854 ICNTL_SYM_MWM(2) = 1
1855 ELSE
1856 ICNTL_SYM_MWM(1) = 0
1857 ICNTL_SYM_MWM(2) = 1
1858 ENDIF
1859 MARKED => IKEEPALLOC(N+1:2*N)
1860 FLAG => IKEEPALLOC(2*N+1:3*N)
1861 PIV_OUT => WORK2(1:N)
1862.LT. IF(MTRANSLOC 4) THEN
1863 LSC = 1
1864 ELSE
1865 LSC = 2*N
1866 ENDIF
1867 CALL CMUMPS_SYM_MWM(
1868 & N, NZREAL, IPE, IW(IRNW), S2(1),LSC, PERM(1),
1869 & ZERODIAG(1),
1870 & ICNTL_SYM_MWM, S2(LSC+1),MARKED(1),FLAG(1),
1871 & PIV_OUT(1), INFO_SYM_MWM)
1872.NE. IF(INFO_SYM_MWM(1) 0) THEN
1873 WRITE(*,*) '** error in cmumps_ana_o'
1874 RETURN
1875 ENDIF
1876.EQ. IF(INFO_SYM_MWM(3) N) THEN
1877 IDENT = .TRUE.
1878.EQ..AND. ELSEIF ( (ICNTL(12)0)
1879.GT. & ( (N-INFO_SYM_MWM(4)-INFO_SYM_MWM(3)) N/10 )
1880 & ) THEN
1881 IDENT = .TRUE.
1882 KEEP(95) = 1
1883 ELSE
1884 DO I=1,N
1885 PERM(I) = PIV_OUT(I)
1886 ENDDO
1887 ENDIF
1888 KEEP(93) = INFO_SYM_MWM(4)
1889 KEEP(94) = INFO_SYM_MWM(3)
1890 IF (IDENT) MTRANS=0
1891 ENDIF
1892.EQ. 390 IF(MTRANS 0) THEN
1893 KEEP(95) = 1
1894 IF (PROK) THEN
1895 WRITE (MPRINT,'(a)')
1896 & ' ... column permutation not used'
1897 ENDIF
1898 ENDIF
1899 GO TO 500
1900.GE..AND..GE. 400 IF ((LP0)(ICNTL(4)1))
1901 & WRITE (LP,'(/a)') '** error: matrix is structurally singular'
1902 INFO(1) = -6
1903 INFO(2) = NUMNZ
1904 GOTO 500
1905.GE..AND..GE. 410 IF ((LP0)(ICNTL(4)1)) THEN
1906 WRITE (LP,'(/a)') '** error in cmumps_ana_o'
1907 WRITE (LP,'(a,i14)')
1908 & '** failure during allocation of INTEGER array of size ',
1909 & LIWG
1910 ENDIF
1911 INFO(1) = -7
1912 CALL MUMPS_SET_IERROR(LIWG,INFO(2))
1913 GOTO 500
1914.GE..AND..GE. 430 IF ((LP0)(ICNTL(4)1)) THEN
1915 WRITE (LP,'(/A)') '** Error in CMUMPS_ANA_O'
1916 WRITE (LP,'(A)') '** Failure during allocation of S2'
1917 ENDIF
1918 INFO(1) = -5
1919 CALL MUMPS_SET_IERROR(LDW,INFO(2))
1920 500 CONTINUE
1921 IF (allocated(IW)) DEALLOCATE(IW)
1922 IF (allocated(S2)) DEALLOCATE(S2)
1923 IF (allocated(IPE)) DEALLOCATE(IPE)
1924 IF (allocated(IPQ8)) DEALLOCATE(IPQ8)
1925 RETURN
1926 END SUBROUTINE CMUMPS_ANA_O
1927 END MODULE CMUMPS_ANA_AUX_M
1928 SUBROUTINE CMUMPS_ANA_K(N,IPE, IW, LW, IWFR, IPS, IPV,
1929 & NV, FLAG,
1930 & NCMPA, SIZE_SCHUR, PARENT)
1931 IMPLICIT NONE
1932 INTEGER, INTENT(IN) :: N, SIZE_SCHUR
1933 INTEGER, INTENT(IN) :: IPS(N)
1934 INTEGER(8), INTENT(IN) :: LW
1935 INTEGER, INTENT(OUT) :: NCMPA
1936 INTEGER, INTENT(OUT) :: IPV(N), NV(N), PARENT(N)
1937 INTEGER(8), INTENT(INOUT) :: IWFR
1938 INTEGER(8), INTENT(INOUT) :: IPE(N)
1939 INTEGER, INTENT(INOUT) :: IW(LW)
1940 INTEGER, INTENT(OUT) :: FLAG(N)
1941 INTEGER I,J,ML,MS,ME,MINJS,IE,KDUMMY
1942 INTEGER LN,JS,JE
1943 INTEGER(8) :: JP, JP1, JP2, LWFR, IP
1944 DO 10 I=1,N
1945 FLAG(I) = 0
1946 NV(I) = 0
1947 J = IPS(I)
1948 IPV(J) = I
1949 10 CONTINUE
1950 NCMPA = 0
1951 DO 100 ML=1,N-SIZE_SCHUR
1952 MS = IPV(ML)
1953 ME = MS
1954 FLAG(MS) = ME
1955 IP = IWFR
1956 MINJS = N
1957 IE = ME
1958 DO 70 KDUMMY=1,N
1959 JP = IPE(IE)
1960 LN = 0
1961.LE. IF (JP0_8) GO TO 60
1962 LN = IW(JP)
1963 DO 50 JP1=1_8,int(LN,8)
1964 JP = JP + 1_8
1965 JS = IW(JP)
1966.EQ. IF (FLAG(JS)ME) GO TO 50
1967 FLAG(JS) = ME
1968.LT. IF (IWFRLW) GO TO 40
1969 IPE(IE) = JP
1970 IW(JP) = LN - int(JP1)
1971 CALL CMUMPS_ANA_D(N, IPE, IW, IP-1_8, LWFR, NCMPA)
1972 JP2 = IWFR - 1
1973 IWFR = LWFR
1974.GT. IF (IPJP2) GO TO 30
1975 DO 20 JP=IP,JP2
1976 IW(IWFR) = IW(JP)
1977 IWFR = IWFR + 1_8
1978 20 CONTINUE
1979 30 IP = LWFR
1980 JP = IPE(IE)
1981 40 IW(IWFR) = JS
1982 MINJS = min0(MINJS,IPS(JS)+0)
1983 IWFR = IWFR + 1_8
1984 50 CONTINUE
1985 60 IPE(IE) = int(-ME,8)
1986 JE = NV(IE)
1987 NV(IE) = LN + 1
1988 IE = JE
1989.EQ. IF (IE0) GO TO 80
1990 70 CONTINUE
1991.GT. 80 IF (IWFRIP) GO TO 90
1992 IPE(ME) = 0_8
1993 NV(ME) = 1
1994 GO TO 100
1995 90 MINJS = IPV(MINJS)
1996 NV(ME) = NV(MINJS)
1997 NV(MINJS) = ME
1998 IW(IWFR) = IW(IP)
1999 IW(IP) = int(IWFR - IP)
2000 IPE(ME) = IP
2001 IWFR = IWFR + 1_8
2002 100 CONTINUE
2003 IF (SIZE_SCHUR == 0) GOTO 500
2004 DO ML = N-SIZE_SCHUR+1,N
2005 ME = IPV(ML)
2006 IE = ME
2007 DO KDUMMY=1,N
2008 JP = IPE(IE)
2009 LN = 0
2010.LE. IF (JP0_8) GO TO 160
2011 LN = IW(JP)
2012 160 IPE(IE) = int(-IPV(N-SIZE_SCHUR+1),8)
2013 JE = NV(IE)
2014 NV(IE) = LN + 1
2015 IE = JE
2016.EQ. IF (IE0) GO TO 190
2017 ENDDO
2018 190 NV(ME) = 0
2019 IPE(ME) = int(-IPV(N-SIZE_SCHUR+1),8)
2020 ENDDO
2021 ME = IPV(N-SIZE_SCHUR+1)
2022 IPE(ME) = 0_8
2023 NV(ME) = SIZE_SCHUR
2024 500 DO I=1,N
2025 PARENT(I) = int(IPE(I))
2026 ENDDO
2027 RETURN
2028 END SUBROUTINE CMUMPS_ANA_K
2029 SUBROUTINE CMUMPS_ANA_J(N, NZ, IRN, ICN, PERM,
2030 & IW, LW, IPE, IQ, FLAG,
2031 & IWFR, IFLAG, IERROR, MP)
2032 INTEGER, INTENT(IN) :: N
2033 INTEGER(8), INTENT(IN) :: NZ, LW
2034 INTEGER, INTENT(IN) :: IRN(NZ), ICN(NZ)
2035 INTEGER, INTENT(IN) :: PERM(N)
2036 INTEGER, INTENT(IN) :: MP
2037 INTEGER(8), INTENT(OUT):: IWFR
2038 INTEGER, INTENT(OUT) :: IERROR
2039 INTEGER, INTENT(OUT) :: IQ(N)
2040 INTEGER(8), INTENT(OUT) :: IPE(N)
2041 INTEGER, INTENT(OUT) :: IW(LW)
2042 INTEGER, INTENT(OUT) :: FLAG(N)
2043 INTEGER, INTENT(INOUT) :: IFLAG
2044 INTEGER :: I,J,LBIG,IN,LEN,JDUMMY,L1
2045 INTEGER(8) :: K, K1, K2, KL, KID
2046 IERROR = 0
2047 DO 10 I=1,N
2048 IQ(I) = 0
2049 10 CONTINUE
2050 DO 80 K=1_8,NZ
2051 I = IRN(K)
2052 J = ICN(K)
2053 IW(K) = -I
2054.EQ. IF (IJ) GOTO 40
2055.GT. IF (IJ) GOTO 30
2056.GE..AND..LE. IF (I1 JN) GO TO 60
2057 GO TO 50
2058.GE..AND..LE. 30 IF (J1 IN) GO TO 60
2059 GO TO 50
2060 40 IW(K) = 0
2061.GE..AND..LE. IF (I1 IN) GO TO 80
2062 50 IERROR = IERROR + 1
2063 IW(K) = 0
2064.LE..AND..GT. IF (IERROR1 MP0) WRITE (MP,99999)
2065.LE..AND..GT. IF (IERROR10 MP0) WRITE (MP,99998) K, I, J
2066 GO TO 80
2067.GT. 60 IF (PERM(J)PERM(I)) GO TO 70
2068 IQ(J) = IQ(J) + 1
2069 GO TO 80
2070 70 IQ(I) = IQ(I) + 1
2071 80 CONTINUE
2072.GE. IF (IERROR1) THEN
2073.EQ. IF (mod(IFLAG,2) 0) IFLAG = IFLAG+1
2074 ENDIF
2075 IWFR = 1_8
2076 LBIG = 0
2077 DO 100 I=1,N
2078 L1 = IQ(I)
2079 LBIG = max0(L1,LBIG)
2080 IWFR = IWFR + int(L1,8)
2081 IPE(I) = IWFR - 1_8
2082 100 CONTINUE
2083 DO 140 K=1_8,NZ
2084 I = -IW(K)
2085.LE. IF (I0) GO TO 140
2086 KL = K
2087 IW(K) = 0
2088 DO 130 KID=1,NZ
2089 J = ICN(KL)
2090.LT. IF (PERM(I)PERM(J)) GO TO 110
2091 KL = IPE(J)
2092 IPE(J) = KL - 1_8
2093 IN = IW(KL)
2094 IW(KL) = I
2095 GO TO 120
2096 110 KL = IPE(I)
2097 IPE(I) = KL - 1_8
2098 IN = IW(KL)
2099 IW(KL) = J
2100 120 I = -IN
2101.LE. IF (I0) GO TO 140
2102 130 CONTINUE
2103 140 CONTINUE
2104 K = IWFR - 1_8
2105 KL = K + int(N,8)
2106 IWFR = KL + 1_8
2107 DO 170 I=1,N
2108 FLAG(I) = 0
2109 J = N + 1 - I
2110 LEN = IQ(J)
2111.LE. IF (LEN0) GO TO 160
2112 DO 150 JDUMMY=1,LEN
2113 IW(KL) = IW(K)
2114 K = K - 1_8
2115 KL = KL - 1_8
2116 150 CONTINUE
2117 160 IPE(J) = KL
2118 KL = KL - 1_8
2119 170 CONTINUE
2120.GE. IF (LBIGhuge(N)) GO TO 190
2121 DO 180 I=1,N
2122 K = IPE(I)
2123 IW(K) = IQ(I)
2124.EQ. IF (IQ(I)0) IPE(I) = 0_8
2125 180 CONTINUE
2126 GO TO 230
2127 190 IWFR = 1_8
2128 DO 220 I=1,N
2129 K1 = IPE(I) + 1_8
2130 K2 = IPE(I) + int(IQ(I),8)
2131.LE. IF (K1K2) GO TO 200
2132 IPE(I) = 0_8
2133 GO TO 220
2134 200 IPE(I) = IWFR
2135 IWFR = IWFR + 1_8
2136 DO 210 K=K1,K2
2137 J = IW(K)
2138.EQ. IF (FLAG(J)I) GO TO 210
2139 IW(IWFR) = J
2140 IWFR = IWFR + 1_8
2141 FLAG(J) = I
2142 210 CONTINUE
2143 K = IPE(I)
2144 IW(K) = int(IWFR - K - 1_8)
2145 220 CONTINUE
2146 230 RETURN
214799999 FORMAT (' *** WARNING MESSAGE FROM CMUMPS_ANA_J ***' )
214899998 FORMAT (I6, ' NON-ZERO (IN ROW, I6, 11H AND COLUMN ', I6,
2149 & ') IGNORED')
2150 END SUBROUTINE CMUMPS_ANA_J
2151 SUBROUTINE CMUMPS_ANA_D(N, IPE, IW, LW, IWFR,NCMPA)
2152 INTEGER, INTENT(IN) :: N
2153 INTEGER(8), INTENT(IN) :: LW
2154 INTEGER(8), INTENT(OUT) :: IWFR
2155 INTEGER(8), INTENT(INOUT):: IPE(N)
2156 INTEGER, INTENT(INOUT) :: NCMPA
2157 INTEGER, INTENT(INOUT) :: IW(LW)
2158 INTEGER :: I, IR
2159 INTEGER(8) :: K1, K, K2, LWFR
2160 NCMPA = NCMPA + 1
2161 DO 10 I=1,N
2162 K1 = IPE(I)
2163.LE. IF (K10_8) GO TO 10
2164 IPE(I) = int(IW(K1), 8)
2165 IW(K1) = -I
2166 10 CONTINUE
2167 IWFR = 1_8
2168 LWFR = IWFR
2169 DO 60 IR=1,N
2170.GT. IF (LWFRLW) GO TO 70
2171 DO 20 K=LWFR,LW
2172.LT. IF (IW(K)0) GO TO 30
2173 20 CONTINUE
2174 GO TO 70
2175 30 I = -IW(K)
2176 IW(IWFR) = int(IPE(I))
2177 IPE(I) = int(IWFR,8)
2178 K1 = K + 1_8
2179 K2 = K + int(IW(IWFR),8)
2180 IWFR = IWFR + 1_8
2181.GT. IF (K1K2) GO TO 50
2182 DO 40 K=K1,K2
2183 IW(IWFR) = IW(K)
2184 IWFR = IWFR + 1_8
2185 40 CONTINUE
2186 50 LWFR = K2 + 1_8
2187 60 CONTINUE
2188 70 RETURN
2189 END SUBROUTINE CMUMPS_ANA_D
2190#if defined(OLDDFS)
2191 SUBROUTINE CMUMPS_ANA_L(N, IPE, NV, IPS, NE, NA, NFSIZ,
2192 & NSTEPS,
2193 & FILS, FRERE,NDD,NEMIN, KEEP60)
2194 INTEGER N,NSTEPS
2195 INTEGER NDD(N)
2196 INTEGER FILS(N), FRERE(N)
2197 INTEGER IPS(N), NE(N), NA(N), NFSIZ(N)
2198 INTEGER IPE(N), NV(N)
2199 INTEGER NEMIN, KEEP60
2200 INTEGER I,IF,IS,NR,NR1,INS,INL,INB,INF,INFS,INSW
2201 INTEGER K,L,ISON,IN,INP,IFSON,INC,INO
2202 INTEGER INOS,IB,IL
2203 DO 10 I=1,N
2204 IPS(I) = 0
2205 NE(I) = 0
2206 10 CONTINUE
2207 DO 20 I=1,N
2208.GT. IF (NV(I)0) GO TO 20
2209 IF = -IPE(I)
2210 IS = -IPS(IF)
2211.GT. IF (IS0) IPE(I) = IS
2212 IPS(IF) = -I
2213 20 CONTINUE
2214 NR = N + 1
2215 DO 50 I=1,N
2216.LE. IF (NV(I)0) GO TO 50
2217 IF = -IPE(I)
2218.NE. IF (IF0) THEN
2219 IS = -IPS(IF)
2220.GT. IF (IS0) IPE(I) = IS
2221 IPS(IF) = -I
2222 ELSE
2223 NR = NR - 1
2224 NE(NR) = I
2225 ENDIF
2226 50 CONTINUE
2227 DO 999 I=1,N
2228 FILS(I) = IPS(I)
2229 999 CONTINUE
2230 NR1 = NR
2231 INS = 0
2232.GT. 1000 IF (NR1N) GO TO 1151
2233 INS = NE(NR1)
2234 NR1 = NR1 + 1
2235 1070 INL = FILS(INS)
2236.LT. IF (INL0) THEN
2237 INS = -INL
2238 GO TO 1070
2239 ENDIF
2240.LT. 1080 IF (IPE(INS)0) THEN
2241 INS = -IPE(INS)
2242 FILS(INS) = 0
2243 GO TO 1080
2244 ENDIF
2245.EQ. IF (IPE(INS)0) THEN
2246 INS = 0
2247 GO TO 1000
2248 ENDIF
2249 INB = IPE(INS)
2250.EQ. IF (NV(INB)0) THEN
2251 INS = INB
2252 GO TO 1070
2253 ENDIF
2254.GE. IF (NV(INB)NV(INS)) THEN
2255 INS = INB
2256 GO TO 1070
2257 ENDIF
2258 INF = INB
2259 1090 INF = IPE(INF)
2260.GT. IF (INF0) GO TO 1090
2261 INF = -INF
2262 INFS = -FILS(INF)
2263.EQ. IF (INFSINS) THEN
2264 FILS(INF) = -INB
2265 IPS(INF) = -INB
2266 IPE(INS) = IPE(INB)
2267 IPE(INB) = INS
2268 INS = INB
2269 GO TO 1070
2270 ENDIF
2271 INSW = INFS
2272 1100 INFS = IPE(INSW)
2273.NE. IF (INFSINS) THEN
2274 INSW = INFS
2275 GO TO 1100
2276 ENDIF
2277 IPE(INS) = IPE(INB)
2278 IPE(INB) = INS
2279 IPE(INSW)= INB
2280 INS =INB
2281 GO TO 1070
2282 1151 CONTINUE
2283 DO 51 I=1,N
2284 FRERE(I) = IPE(I)
2285 FILS(I) = IPS(I)
2286 51 CONTINUE
2287 IS = 1
2288 I = 0
2289 IL = 0
2290 DO 160 K=1,N
2291.GT. IF (I0) GO TO 60
2292 I = NE(NR)
2293 NE(NR) = 0
2294 NR = NR + 1
2295 IL = N
2296 NA(N) = 0
2297 60 DO 70 L=1,N
2298.GE. IF (IPS(I)0) GO TO 80
2299 ISON = -IPS(I)
2300 IPS(I) = 0
2301 I = ISON
2302 IL = IL - 1
2303 NA(IL) = 0
2304 70 CONTINUE
2305 80 IPS(I) = K
2306 NE(IS) = NE(IS) + 1
2307.GT. IF (NV(I)0) GO TO 89
2308 IN = I
2309 81 IN = FRERE(IN)
2310.GT. IF (IN0) GO TO 81
2311 IF = -IN
2312 IN = IF
2313 82 INL = IN
2314 IN = FILS(IN)
2315.GT. IF (IN0) GO TO 82
2316 IFSON = -IN
2317 FILS(INL) = I
2318 IN = I
2319 83 INP = IN
2320 IN = FILS(IN)
2321.GT. IF (IN0) GO TO 83
2322.EQ. IF (IFSON I) GO TO 86
2323 FILS(INP) = -IFSON
2324 IN = IFSON
2325 84 INC =IN
2326 IN = FRERE(IN)
2327.NE. IF (INI) GO TO 84
2328 FRERE(INC) = FRERE(I)
2329 GO TO 120
2330.LT. 86 IF (FRERE(I)0) FILS(INP) = 0
2331.GT. IF (FRERE(I)0) FILS(INP) = -FRERE(I)
2332 GO TO 120
2333.LT. 89 IF (ILN) NA(IL+1) = NA(IL+1) + 1
2334 NA(IS) = NA(IL)
2335 NDD(IS) = NV(I)
2336 NFSIZ(I) = NV(I)
2337.LT. IF (NA(IS)1) GO TO 110
2338.NE..AND. IF ( (KEEP600)
2339.EQ. & (NE(IS)NDD(IS)) ) GOTO 110
2340.EQ. IF (NDD(IS-1)-NE(IS-1)NDD(IS)) GO TO 100
2341.GE..AND. IF ((NE(IS-1)NEMIN)
2342.GE. & (NE(IS)NEMIN) ) GO TO 110
2343.GE. IF (2*NE(IS-1)*(NDD(IS)-NDD(IS-1)+NE(IS-1))
2344 & ((NDD(IS)+NE(IS-1))*
2345 & (NDD(IS)+NE(IS-1))*NEMIN/100)) GO TO 110
2346 100 NA(IS-1) = NA(IS-1) + NA(IS) - 1
2347 NDD(IS-1) = NDD(IS) + NE(IS-1)
2348 NE(IS-1) = NE(IS) + NE(IS-1)
2349 NE(IS) = 0
2350 IN=I
2351 101 INL = IN
2352 IN = FILS(IN)
2353.GT. IF (IN0) GO TO 101
2354 IFSON = -IN
2355 IN = IFSON
2356 102 INO = IN
2357 IN = FRERE(IN)
2358.GT. IF (IN0) GO TO 102
2359 FILS(INL) = INO
2360 NFSIZ(I) = NDD(IS-1)
2361 IN = INO
2362 103 INP = IN
2363 IN = FILS(IN)
2364.GT. IF (IN0) GO TO 103
2365 INOS = -IN
2366.EQ. IF (IFSONINO) GO TO 107
2367 IN = IFSON
2368 FILS(INP) = -IFSON
2369 105 INS = IN
2370 IN = FRERE(IN)
2371.NE. IF (ININO) GO TO 105
2372.EQ. IF (INOS0) FRERE(INS) = -I
2373.NE. IF (INOS0) FRERE(INS) = INOS
2374.EQ. IF (INOS0) GO TO 109
2375 107 IN = INOS
2376.EQ. IF (IN0) GO TO 109
2377 108 INT = IN
2378 IN = FRERE(IN)
2379.GT. IF (IN0) GO TO 108
2380 FRERE(INT) = -I
2381 109 CONTINUE
2382 GO TO 120
2383 110 IS = IS + 1
2384 120 IB = IPE(I)
2385.LT. IF (IB0) GOTO 150
2386.EQ. IF (IB0) GOTO 140
2387 NA(IL) = 0
2388 140 I = IB
2389 GO TO 160
2390 150 I = -IB
2391 IL = IL + 1
2392 160 CONTINUE
2393 NSTEPS = IS - 1
2394 DO 170 I=1,N
2395 K = FILS(I)
2396.GT. IF (K0) THEN
2397 FRERE(K) = N + 1
2398 NFSIZ(K) = 0
2399 ENDIF
2400 170 CONTINUE
2401 RETURN
2402 END SUBROUTINE CMUMPS_ANA_L
2403#else
2404 SUBROUTINE CMUMPS_ANA_LNEW(N, IPE, NV, IPS, NE, NA, NFSIZ,
2405 & NODE, NSTEPS,
2406 & FILS, FRERE, ND, NEMIN, SUBORD, KEEP60,
2407 & KEEP20, KEEP38, NAMALG,NAMALGMAX,
2408 & CUMUL,KEEP50, ICNTL13, KEEP37, KEEP197, NSLAVES,
2409 & ALLOW_AMALG_TINY_NODES
2410 & , BLKON, SIZEOFBLOCKS, LSIZEOFBLOCKS
2411 & )
2412 IMPLICIT NONE
2413 INTEGER N, NSTEPS, KEEP60, KEEP20, KEEP38, KEEP50
2414 INTEGER ND(N), NFSIZ(N)
2415 INTEGER IPE(N), FILS(N), FRERE(N), SUBORD(N)
2416 INTEGER NV(N), IPS(N), NE(N), NA(N), NODE(N)
2417 INTEGER NEMIN,AMALG_COUNT
2418 INTEGER NAMALG(N),NAMALGMAX, CUMUL(N)
2419 DOUBLE PRECISION SIZE_DADI_AMALGAMATED, PERCENT_FILL
2420 DOUBLE PRECISION ACCU, FLOPS_FATHER, FLOPS_SON,
2421 & FLOPS_AVANT, FLOPS_APRES
2422 INTEGER ICNTL13, KEEP37, NSLAVES
2423 LOGICAL ALLOW_AMALG_TINY_NODES
2424 INTEGER KEEP197
2425 LOGICAL, INTENT(IN) :: BLKON
2426 INTEGER, INTENT(IN) :: LSIZEOFBLOCKS
2427 INTEGER, INTENT(IN) :: SIZEOFBLOCKS(LSIZEOFBLOCKS)
2428#if defined(NOAMALGTOFATHER)
2429#else
2430#endif
2431 INTEGER I,IF,IS,NR,INS
2432 INTEGER K,L,ISON,IN,IFSON,INO
2433 INTEGER INOS,IB,IL
2434 INTEGER IPERM
2435 INTEGER MAXNODE
2436#if defined(NOAMALGTOFATHER)
2437 INTEGER INB,INF,INFS,INL,INSW,INT1,NR1
2438#else
2439 INTEGER DADI
2440#endif
2441 LOGICAL AMALG_TO_father_OK
2442 AMALG_COUNT = 0
2443 DO 10 I=1,N
2444 CUMUL(I)= 0
2445 IPS(I) = 0
2446 NE(I) = 0
2447 SUBORD(I) = 0
2448 NAMALG(I) = 0
2449 10 CONTINUE
2450 DO I=1,N
2451 IF (BLKON) THEN
2452 NODE(I) = SIZEOFBLOCKS(I)
2453 ELSE
2454 NODE(I) = 1
2455 ENDIF
2456 ENDDO
2457 FRERE(1:N) = IPE(1:N)
2458 NR = N + 1
2459 MAXNODE = 1
2460 DO 50 I=1,N
2461 IF = -FRERE(I)
2462.EQ. IF (NV(I)0) THEN
2463.NE. IF (SUBORD(IF)0) SUBORD(I) = SUBORD(IF)
2464 SUBORD(IF) = I
2465 IF (BLKON) THEN
2466 NODE(IF) = NODE(IF)+SIZEOFBLOCKS(I)
2467 ELSE
2468 NODE(IF) = NODE(IF)+1
2469 ENDIF
2470 MAXNODE = max(NODE(IF),MAXNODE)
2471 ELSE
2472.NE. IF (IF0) THEN
2473 IS = -IPS(IF)
2474.GT. IF (IS0) FRERE(I) = IS
2475 IPS(IF) = -I
2476 ELSE
2477 NR = NR - 1
2478 NE(NR) = I
2479 ENDIF
2480 ENDIF
2481 50 CONTINUE
2482 MAXNODE = int(dble(MAXNODE)*dble(NEMIN) / dble(100))
2483 MAXNODE = max(MAXNODE,2000)
2484#if defined(NOAMALGTOFATHER)
2485 DO 999 I=1,N
2486 FILS(I) = IPS(I)
2487 999 CONTINUE
2488 NR1 = NR
2489 INS = 0
2490.GT. 1000 IF (NR1N) GO TO 1151
2491 INS = NE(NR1)
2492 NR1 = NR1 + 1
2493 1070 INL = FILS(INS)
2494.LT. IF (INL0) THEN
2495 INS = -INL
2496 GO TO 1070
2497 ENDIF
2498.LT. 1080 IF (FRERE(INS)0) THEN
2499 INS = -FRERE(INS)
2500 FILS(INS) = 0
2501 GO TO 1080
2502 ENDIF
2503.EQ. IF (FRERE(INS)0) THEN
2504 INS = 0
2505 GO TO 1000
2506 ENDIF
2507 INB = FRERE(INS)
2508.GE. IF (NV(INB)NV(INS)) THEN
2509 INS = INB
2510 GO TO 1070
2511 ENDIF
2512 INF = INB
2513 1090 INF = FRERE(INF)
2514.GT. IF (INF0) GO TO 1090
2515 INF = -INF
2516 INFS = -FILS(INF)
2517.EQ. IF (INFSINS) THEN
2518 FILS(INF) = -INB
2519 IPS(INF) = -INB
2520 FRERE(INS) = FRERE(INB)
2521 FRERE(INB) = INS
2522 ELSE
2523 INSW = INFS
2524 1100 INFS = FRERE(INSW)
2525.NE. IF (INFSINS) THEN
2526 INSW = INFS
2527 GO TO 1100
2528 ENDIF
2529 FRERE(INS) = FRERE(INB)
2530 FRERE(INB) = INS
2531 FRERE(INSW)= INB
2532 ENDIF
2533 INS = INB
2534 GO TO 1070
2535 1151 CONTINUE
2536#endif
2537 DO 51 I=1,N
2538 FILS(I) = IPS(I)
2539 51 CONTINUE
2540 IS = 1
2541 I = 0
2542 IPERM = 1
2543 DO 160 K=1,N
2544 AMALG_TO_father_OK=.FALSE.
2545.LE. IF (I0) THEN
2546.GT. IF (NRN) EXIT
2547 I = NE(NR)
2548 NE(NR) = 0
2549 NR = NR + 1
2550 IL = N
2551 NA(N) = 0
2552 ENDIF
2553 DO 70 L=1,N
2554.GE. IF (IPS(I)0) EXIT
2555 ISON = -IPS(I)
2556 IPS(I) = 0
2557 I = ISON
2558 IL = IL - 1
2559 NA(IL) = 0
2560 70 CONTINUE
2561#if ! defined(NOAMALGTOFATHER)
2562 DADI = -IPE(I)
2563.NE..AND. IF ( (DADI0)
2564 & (
2565.EQ..OR. & (KEEP600)
2566.NE..AND..NE. & ( (KEEP20DADI)(KEEP38DADI) )
2567 & )
2568 & ) THEN
2569 ACCU = dble(2)*dble(NODE(I))*dble(NV(DADI)-NV(I)+NODE(I))
2570 SIZE_DADI_AMALGAMATED =
2571 & dble(NV(DADI)+NODE(I)) *
2572 & dble(NV(DADI)+NODE(I))
2573 PERCENT_FILL = dble(100) * ACCU / SIZE_DADI_AMALGAMATED
2574 ACCU = ACCU + dble(CUMUL(I))
2575 AMALG_TO_father_OK = (
2576.LE..AND..LE. & ( (NODE(I)MAXNODE)(NODE(DADI)MAXNODE) )
2577.OR. &
2578.LE..and..GT. & ( (NODE(I)NEMIN NODE(DADI) MAXNODE)
2579.OR..LE..and..GT. & (NODE(DADI)NEMIN NODE(I)MAXNODE)))
2580.AND. AMALG_TO_father_OK = ( AMALG_TO_father_OK
2581 & ( PERCENT_FILL < dble(NEMIN) ) )
2582.EQ. IF (KEEP197 1 ) THEN
2583.OR. AMALG_TO_father_OK = AMALG_TO_father_OK
2584.LE..AND..LT. & ( NODE(I)2*NEMIN NODE(DADI)4*NEMIN)
2585 ENDIF
2586.AND. AMALG_TO_father_OK = ( AMALG_TO_father_OK
2587.LE. & ( ACCU / SIZE_DADI_AMALGAMATED dble(NEMIN)) )
2588 IF (AMALG_TO_father_OK) THEN
2589 CALL MUMPS_GET_FLOPS_COST(NV(I),NODE(I),NODE(I),
2590 & KEEP50,1,FLOPS_SON)
2591 CALL MUMPS_GET_FLOPS_COST(NV(DADI),NODE(DADI),
2592 & NODE(DADI),
2593 & KEEP50,1,FLOPS_FATHER)
2594 FLOPS_AVANT = FLOPS_FATHER+FLOPS_SON
2595 & + max(dble(200.0) * dble(NV(I)-NODE(I))
2596 & * dble(NV(I)-NODE(I)),
2597 & dble(10000.0))
2598 CALL MUMPS_GET_FLOPS_COST(NV(DADI)+NODE(I),
2599 & NODE(DADI)+NODE(I),
2600 & NODE(DADI)+NODE(I),
2601 & KEEP50,1,FLOPS_APRES)
2602.GT. IF (FLOPS_APRESFLOPS_AVANT*
2603 & (dble(1)+dble(max(8,NEMIN)-8)/dble(100))) THEN
2604 AMALG_TO_father_OK = .FALSE.
2605 ENDIF
2606 ENDIF
2607.GT..AND..GT. IF ( (NV(I) 50*NV(DADI)) (NSLAVES1)
2608.AND..LE. & (ICNTL130)
2609.AND..GT. & (NV(I) KEEP37) ) THEN
2610.LT. IF ( ( ACCU / SIZE_DADI_AMALGAMATED ) 0.2 ) THEN
2611 AMALG_TO_father_OK = .TRUE.
2612 ENDIF
2613 ENDIF
2614.AND. IF ( ALLOW_AMALG_TINY_NODES
2615.LE. & NODE(I) * 900 NV(DADI) - NAMALG(DADI)) THEN
2616 IF ( NAMALG(DADI) < (NV(DADI)-NAMALG(DADI))/50 ) THEN
2617 AMALG_TO_father_OK = .TRUE.
2618 NAMALG(DADI) = NAMALG(DADI) + NODE(I)
2619 ENDIF
2620 ENDIF
2621.EQ. IF ( DADI -FRERE(I)
2622.AND..EQ. & -FILS(DADI)I
2623 & ) THEN
2624.OR. AMALG_TO_father_OK = ( AMALG_TO_father_OK
2625.EQ. & ( NV(I)-NODE(I)NV(DADI)) )
2626 ENDIF
2627 IF (AMALG_TO_father_OK) THEN
2628 CUMUL(DADI)=CUMUL(DADI)+nint(ACCU)
2629 NAMALG(DADI) = NAMALG(DADI) + NAMALG(I)
2630 AMALG_COUNT = AMALG_COUNT+1
2631 IN = DADI
2632.EQ. 75 IF (SUBORD(IN)0) GOTO 76
2633 IN = SUBORD(IN)
2634 GOTO 75
2635 76 CONTINUE
2636 SUBORD(IN) = I
2637 NV(I) = 0
2638 IFSON = -FILS(DADI)
2639.EQ. IF (IFSONI) THEN
2640.LT. IF (FILS(I)0) THEN
2641 FILS(DADI) = FILS(I)
2642 GOTO 78
2643 ELSE
2644.GT. IF (FRERE(I)0) THEN
2645 FILS(DADI) = -FRERE(I)
2646 ELSE
2647 FILS(DADI) = 0
2648 ENDIF
2649 GOTO 90
2650 ENDIF
2651 ENDIF
2652 IN = IFSON
2653 77 INS = IN
2654 IN = FRERE(IN)
2655.NE. IF (INI) GOTO 77
2656.LT. IF (FILS(I) 0) THEN
2657 FRERE(INS) = -FILS(I)
2658 ELSE
2659 FRERE(INS) = FRERE(I)
2660 GOTO 90
2661 ENDIF
2662 78 CONTINUE
2663 IN = -FILS(I)
2664 79 INO = IN
2665 IN = FRERE(IN)
2666.GT. IF (IN0) GOTO 79
2667 FRERE(INO) = FRERE(I)
2668 90 CONTINUE
2669 NODE(DADI) = NODE(DADI)+ NODE(I)
2670 NV(DADI) = NV(DADI) + NODE(I)
2671 NA(IL+1) = NA(IL+1) + NA(IL)
2672 GOTO 120
2673 ENDIF
2674 ENDIF
2675#endif
2676 NE(IS) = NE(IS) + NODE(I)
2677.LT. IF (ILN) NA(IL+1) = NA(IL+1) + 1
2678 NA(IS) = NA(IL)
2679 ND(IS) = NV(I)
2680 NODE(I) = IS
2681 IPS(I) = IPERM
2682 IPERM = IPERM + 1
2683 IN = I
2684.EQ. 777 IF (SUBORD(IN)0) GO TO 778
2685 IN = SUBORD(IN)
2686 NODE(IN) = IS
2687 IPS(IN) = IPERM
2688 IPERM = IPERM + 1
2689 GO TO 777
2690.LE. 778 IF (NA(IS)0) GO TO 110
2691#if defined(NOAMALGTOFATHER)
2692.NE..AND. IF ( (KEEP600)
2693.EQ. & (NE(IS)ND(IS)) ) GOTO 110
2694.EQ. IF (ND(IS-1)-NE(IS-1)ND(IS)) THEN
2695 GO TO 100
2696 ENDIF
2697.GE. IF(NAMALG(IS-1) NAMALGMAX) THEN
2698 GOTO 110
2699 ENDIF
2700.GE..AND. IF ((NE(IS-1)NEMIN)
2701.GE. & (NE(IS)NEMIN) ) GO TO 110
2702.GE. IF (2*NE(IS-1)*(ND(IS)-ND(IS-1)+NE(IS-1))
2703 & ((ND(IS)+NE(IS-1))*
2704 & (ND(IS)+NE(IS-1))*NEMIN/100)) GO TO 110
2705 NAMALG(IS-1) = NAMALG(IS-1)+1
2706 100 NA(IS-1) = NA(IS-1) + NA(IS) - 1
2707 ND(IS-1) = ND(IS) + NE(IS-1)
2708 NE(IS-1) = NE(IS) + NE(IS-1)
2709 NE(IS) = 0
2710 NODE(I) = IS-1
2711 IFSON = -FILS(I)
2712 IN = IFSON
2713 102 INO = IN
2714 IN = FRERE(IN)
2715.GT. IF (IN0) GO TO 102
2716 NV(INO) = 0
2717 IN = I
2718.EQ. 888 IF (SUBORD(IN)0) GO TO 889
2719 IN = SUBORD(IN)
2720 GO TO 888
2721 889 SUBORD(IN) = INO
2722 INOS = -FILS(INO)
2723.EQ. IF (IFSONINO) THEN
2724 FILS(I) = -INOS
2725 GO TO 107
2726 ENDIF
2727 IN = IFSON
2728 105 INS = IN
2729 IN = FRERE(IN)
2730.NE. IF (ININO) GO TO 105
2731.EQ. IF (INOS0) THEN
2732 FRERE(INS) = -I
2733 GO TO 120
2734 ELSE
2735 FRERE(INS) = INOS
2736 ENDIF
2737 107 IN = INOS
2738.EQ. IF (IN0) GO TO 120
2739 108 INT1 = IN
2740 IN = FRERE(IN)
2741.GT. IF (IN0) GO TO 108
2742 FRERE(INT1) = -I
2743 GO TO 120
2744#endif
2745 110 IS = IS + 1
2746 120 IB = FRERE(I)
2747.GE. IF (IB0) THEN
2748.GT. IF (IB0) NA(IL) = 0
2749 I = IB
2750 ELSE
2751 I = -IB
2752 IL = IL + 1
2753 ENDIF
2754 160 CONTINUE
2755 NSTEPS = IS - 1
2756 DO I=1, N
2757.EQ. IF (NV(I)0) THEN
2758 FRERE(I) = N+1
2759 NFSIZ(I) = 0
2760 ELSE
2761 NFSIZ(I) = ND(NODE(I))
2762.NE. IF (SUBORD(I) 0) THEN
2763 INOS = -FILS(I)
2764 INO = I
2765.NE. DO WHILE (SUBORD(INO)0)
2766 IS = SUBORD(INO)
2767 FILS(INO) = IS
2768 INO = IS
2769 END DO
2770 FILS(INO) = -INOS
2771 ENDIF
2772 ENDIF
2773 ENDDO
2774 RETURN
2775 END SUBROUTINE CMUMPS_ANA_LNEW
2776#endif
2777 SUBROUTINE CMUMPS_ANA_M(NE, ND, NSTEPS,
2778 & MAXFR, MAXELIM, K50, SIZEFAC_TOT, MAXNPIV,
2779 & K5,K6,PANEL_SIZE,K253)
2780 IMPLICIT NONE
2781 INTEGER, INTENT(in) :: NSTEPS, K50, K253, K5, K6
2782 INTEGER, INTENT(in) :: NE(NSTEPS), ND(NSTEPS)
2783 INTEGER, INTENT(out) :: MAXNPIV, PANEL_SIZE
2784 INTEGER, INTENT(out) :: MAXFR, MAXELIM
2785 INTEGER(8), INTENT(out):: SIZEFAC_TOT
2786 INTEGER ITREE, NFR, NELIM
2787 INTEGER LKJIB
2788 INTEGER(8) :: SIZEFAC
2789 LKJIB = max(K5,K6)
2790 MAXFR = 0
2791 MAXELIM = 0
2792 MAXNPIV = 0
2793 PANEL_SIZE = 0
2794 SIZEFAC_TOT = 0_8
2795 DO ITREE=1,NSTEPS
2796 NELIM = NE(ITREE)
2797 NFR = ND(ITREE) + K253
2798.GT. IF (NFRMAXFR) MAXFR = NFR
2799.GT. IF (NFR-NELIMMAXELIM) MAXELIM = NFR - NELIM
2800.GT. IF (NELIM MAXNPIV) THEN
2801 MAXNPIV = NELIM
2802 ENDIF
2803.EQ. IF (K500) THEN
2804 SIZEFAC = (2_8*int(NFR,8) - int(NELIM,8))*int(NELIM,8)
2805 PANEL_SIZE = max(PANEL_SIZE, NFR*(LKJIB+1))
2806 ELSE
2807 SIZEFAC = int(NFR,8) * int(NELIM,8)
2808 PANEL_SIZE = max(PANEL_SIZE, NELIM*(LKJIB+1))
2809 PANEL_SIZE = max(PANEL_SIZE, (NFR-NELIM)*(LKJIB+1))
2810 ENDIF
2811 SIZEFAC_TOT = SIZEFAC_TOT + SIZEFAC
2812 END DO
2813 RETURN
2814 END SUBROUTINE CMUMPS_ANA_M
2815 SUBROUTINE CMUMPS_ANA_R( N, FILS, FRERE,
2816 & NSTK, NA )
2817 IMPLICIT NONE
2818 INTEGER, INTENT(IN) :: N
2819 INTEGER, INTENT(IN) :: FILS(N), FRERE(N)
2820 INTEGER, INTENT(OUT) :: NSTK(N), NA(N)
2821 INTEGER NBROOT, NBLEAF, ILEAF, I, IN, ISON
2822 NA = 0
2823 NSTK = 0
2824 NBROOT = 0
2825 ILEAF = 1
2826 DO 11 I=1,N
2827.EQ. IF (FRERE(I) N+1) CYCLE
2828.EQ. IF (FRERE(I)0) NBROOT = NBROOT + 1
2829 IN = I
2830 12 IN = FILS(IN)
2831.GT. IF (IN0) GO TO 12
2832.EQ. IF (IN0) THEN
2833 NA(ILEAF) = I
2834 ILEAF = ILEAF + 1
2835 CYCLE
2836 ENDIF
2837 ISON = -IN
2838 13 NSTK(I) = NSTK(I) + 1
2839 ISON = FRERE(ISON)
2840.GT. IF (ISON0) GO TO 13
2841 11 CONTINUE
2842 NBLEAF = ILEAF-1
2843.GT. IF (N1) THEN
2844.GT. IF (NBLEAFN-2) THEN
2845.EQ. IF (NBLEAFN-1) THEN
2846 NA(N-1) = -NA(N-1)-1
2847 NA(N) = NBROOT
2848 ELSE
2849 NA(N) = -NA(N)-1
2850 ENDIF
2851 ELSE
2852 NA(N-1) = NBLEAF
2853 NA(N) = NBROOT
2854 ENDIF
2855 ENDIF
2856 RETURN
2857 END SUBROUTINE CMUMPS_ANA_R
2858 SUBROUTINE CMUMPS_DIAG_ANA
2859 &( MYID, COMM, KEEP,KEEP8, INFO, INFOG, RINFO, RINFOG, ICNTL,
2860 & SIZE_SCHUR )
2861 IMPLICIT NONE
2862 INTEGER, INTENT(IN) :: COMM, MYID, KEEP(500), INFO(80),
2863 & ICNTL(60), INFOG(80), SIZE_SCHUR
2864 INTEGER(8), INTENT(IN) :: KEEP8(150)
2865 REAL, INTENT(IN) :: RINFO(40), RINFOG(40)
2866 INCLUDE 'mpif.h'
2867 INTEGER MASTER, MPG
2868 INTEGER ITMP
2869 PARAMETER( MASTER = 0 )
2870 MPG = ICNTL(3)
2871.eq..and..GT..AND..GE. IF ( MYIDMASTERMPG0ICNTL(4)2) THEN
2872 ITMP = KEEP(13)
2873.EQ. IF (ICNTL(15)0) ITMP = 0
2874 WRITE(MPG, 99992) INFO(1), INFO(2),
2875 & KEEP8(109), KEEP8(111), INFOG(4),
2876 & INFOG(5), KEEP(28), INFOG(32), INFOG(7), KEEP(23),
2877 & ICNTL(7), KEEP(12),
2878 & ITMP,
2879 & ICNTL(18),
2880 & KEEP(106),
2881 & KEEP(56), KEEP(61), RINFOG(1)
2882.GT. IF (KEEP(95)1)
2883 & WRITE(MPG, 99993) KEEP(95)
2884.GT. IF (KEEP(54)0) WRITE(MPG, 99994) KEEP(54)
2885.GT. IF (KEEP(60)0) WRITE(MPG, 99995) KEEP(60), SIZE_SCHUR
2886.GT. IF (KEEP(253)0) WRITE(MPG, 99996) KEEP(253)
2887 ENDIF
2888 RETURN
288999992 FORMAT(/'Leaving analysis phase with ...'/
2890 & ' INFOG(1) =',I16/
2891 & ' infog(2) =',I16/
2892 & ' -- (20) number of entries in factors(estim.) =',I16/
2893 & ' -- (3) real space for factors(estimated) =',I16/
2894 & ' -- (4) Integer space for factors (estimated) =',I16/
2895 & ' -- (5) maximum frontal size (estimated) =',I16/
2896 & ' -- (6) number of nodes in the tree =',I16/
2897 & ' -- (32) Type of analysis effectively used =',I16/
2898 & ' -- (7) ordering option effectively used =',I16/
2899 & ' icntl(6) maximum transversal option =',I16/
2900 & ' icntl(7) pivot order option =',I16/
2901 & ' icntl(14) percentage of memory relaxation =',I16/
2902 & ' icntl(15) analysis by block effectively used =',I16/
2903 & ' icntl(18) distributed input matrix(on if >0) =',I16/
2904 & ' icntl(58) symbolic factorization option =',I16/
2905 & ' number of level 2 nodes =',I16/
2906 & ' number of split nodes =',I16/
2907 & ' rinfog(1) operations during elimination(estim)=',
2908 & 1PD10.3)
290999993 FORMAT(' ordering compressed/constrained(icntl(12)) =',I16)
291099994 FORMAT(' distributed matrix entry format (icntl(18)) =',I16)
291199995 FORMAT(' effective schur option(icntl(19)) =',I16/
2912 & ' Size of schur(size_schur) =',I16)
291399996 FORMAT(' forward solution during factorization, nrhs =',I16)
2914 END SUBROUTINE CMUMPS_DIAG_ANA
2915 SUBROUTINE CMUMPS_CUTNODES
2916 & ( N, FRERE, FILS, NFSIZ, SIZEOFBLOCKS, LSIZEOFBLOCKS,
2917 & NSTEPS, NSLAVES,
2918 & KEEP, KEEP8, SPLITROOT, MP, LDIAG, INFO1, INFO2 )
2919 IMPLICIT NONE
2920 INTEGER N, NSTEPS, NSLAVES, KEEP(500)
2921 INTEGER(8) KEEP8(150)
2922 INTEGER FRERE( N ), FILS( N ), NFSIZ( N )
2923 INTEGER LSIZEOFBLOCKS
2924 INTEGER SIZEOFBLOCKS(LSIZEOFBLOCKS)
2925 LOGICAL SPLITROOT
2926 INTEGER MP, LDIAG
2927 INTEGER INFO1, INFO2
2928 INTEGER, DIMENSION(:), ALLOCATABLE :: IPOOL
2929 INTEGER INODE, DEPTH, I, IBEG, IEND, IIPOOL, NROOT
2930 INTEGER MAX_DEPTH, ISON, TOT_CUT, MAX_CUT, STRAT
2931 INTEGER(8) :: K79
2932 INTEGER NFRONT, K82, allocok
2933 LOGICAL BLKON
2934.NOT..EQ. BLKON = (SIZEOFBLOCKS(1)-1)
2935 K79 = KEEP8(79)
2936 K82 = abs(KEEP(82))
2937 STRAT= KEEP(62)
2938.EQ. IF (KEEP(210)1) THEN
2939 MAX_DEPTH = 2*NSLAVES*K82
2940 STRAT = STRAT/4
2941 ELSE
2942.eq..AND..NOT. IF (( NSLAVES 1 ) ( SPLITROOT) ) RETURN
2943.EQ. IF (NSLAVES1) THEN
2944 MAX_DEPTH=1
2945 ELSE
2946 MAX_DEPTH = int( log( real( NSLAVES - 1 ) )
2947 & / log(2.0E0) )
2948 ENDIF
2949 ENDIF
2950 ALLOCATE(IPOOL(NSTEPS+1), stat=allocok)
2951.GT. IF (allocok0) THEN
2952 INFO1= -7
2953 INFO2= NSTEPS+1
2954 RETURN
2955 ENDIF
2956 NROOT = 0
2957 DO INODE = 1, N
2958.eq. IF ( FRERE(INODE) 0 ) THEN
2959 NROOT = NROOT + 1
2960 IPOOL( NROOT ) = INODE
2961 END IF
2962 END DO
2963 IBEG = 1
2964 IEND = NROOT
2965 IIPOOL = NROOT + 1
2966 IF (SPLITROOT) THEN
2967 MAX_DEPTH=0
2968 ENDIF
2969 DO DEPTH = 1, MAX_DEPTH
2970 DO I = IBEG, IEND
2971 INODE = IPOOL( I )
2972 ISON = INODE
2973.GT. DO WHILE ( ISON 0 )
2974 ISON = FILS( ISON )
2975 END DO
2976 ISON = - ISON
2977.GT. DO WHILE ( ISON 0 )
2978 IPOOL( IIPOOL ) = ISON
2979 IIPOOL = IIPOOL + 1
2980 ISON = FRERE( ISON )
2981 END DO
2982 END DO
2983 IPOOL( IBEG ) = -IPOOL( IBEG )
2984 IBEG = IEND + 1
2985 IEND = IIPOOL - 1
2986 END DO
2987 IPOOL( IBEG ) = -IPOOL( IBEG )
2988 TOT_CUT = 0
2989 IF (SPLITROOT) THEN
2990 MAX_CUT = NROOT*max(K82,2)
2991 INODE = abs(IPOOL(1))
2992 NFRONT = NFSIZ( INODE )
2993 K79 = max(
2994 & int(NFRONT,8)*int(NFRONT,8)/(int(K82+1,8)*int(K82+1,8)),
2995 & 9_8)
2996.NE. IF (KEEP(53)0) THEN
2997 MAX_CUT = NFRONT
2998 K79 = 121_8*121_8
2999 ELSE
3000 K79 = min(2000_8*2000_8,K79)
3001.EQ. IF (KEEP(376) 1) THEN
3002 K79 = min(int(KEEP(9)+1,8)*int(KEEP(9)+1,8),K79)
3003 ENDIF
3004 ENDIF
3005 ELSE
3006 MAX_CUT = 2 * NSLAVES
3007.EQ. IF (KEEP(210)1) THEN
3008 MAX_CUT = 4 * (MAX_CUT + 4)
3009 ENDIF
3010 ENDIF
3011 DEPTH = -1
3012 DO I = 1, IIPOOL - 1
3013 INODE = IPOOL( I )
3014.LT. IF ( INODE 0 ) THEN
3015 INODE = -INODE
3016 DEPTH = DEPTH + 1
3017 END IF
3018 CALL CMUMPS_SPLIT_1NODE
3019 & ( INODE, N, FRERE, FILS, NFSIZ, NSTEPS, NSLAVES,
3020 & KEEP,KEEP8, TOT_CUT, STRAT, DEPTH,
3021 & K79, SPLITROOT, MP, LDIAG,
3022 & BLKON, SIZEOFBLOCKS, LSIZEOFBLOCKS )
3023 IF ( TOT_CUT > MAX_CUT ) EXIT
3024 END DO
3025 KEEP(61) = TOT_CUT
3026 DEALLOCATE(IPOOL)
3027 RETURN
3028 END SUBROUTINE CMUMPS_CUTNODES
3029 RECURSIVE SUBROUTINE CMUMPS_SPLIT_1NODE
3030 & ( INODE, N, FRERE, FILS, NFSIZ, NSTEPS, NSLAVES, KEEP,KEEP8,
3031 & TOT_CUT, STRAT, DEPTH, K79, SPLITROOT, MP, LDIAG,
3032 & BLKON, SIZEOFBLOCKS, LSIZEOFBLOCKS )
3033 IMPLICIT NONE
3034 INTEGER(8) :: K79
3035 INTEGER INODE, N, NSTEPS, NSLAVES, KEEP(500), STRAT,
3036 & DEPTH, TOT_CUT, MP, LDIAG
3037 INTEGER(8) KEEP8(150)
3038 INTEGER FRERE( N ), FILS( N ), NFSIZ( N )
3039 LOGICAL SPLITROOT
3040 LOGICAL BLKON
3041 INTEGER LSIZEOFBLOCKS
3042 INTEGER SIZEOFBLOCKS(LSIZEOFBLOCKS)
3043 INTEGER I, IN, NPIV, NFRONT, NSLAVES_ESTIM
3044 REAL WK_SLAVE, WK_MASTER
3045 INTEGER INODE_SON, INODE_FATH, IN_SON, IN_FATH, IN_GRANDFATH
3046 INTEGER NPIV_COMPG, NPIV_SON_COMPG, NPIV_FATH_COMPG
3047 INTEGER NPIV_SON, NPIV_FATH, NPIV_TEMP
3048 INTEGER NCB, NSLAVESMIN, NSLAVESMAX
3049 INTEGER MUMPS_BLOC2_GET_NSLAVESMIN,
3050 & MUMPS_BLOC2_GET_NSLAVESMAX
3051 EXTERNAL MUMPS_BLOC2_GET_NSLAVESMIN,
3052 & MUMPS_BLOC2_GET_NSLAVESMAX
3053.EQ..AND..EQ..OR. IF ( (KEEP(210)1KEEP(60)0)
3054 & (SPLITROOT) ) THEN
3055.eq. IF ( FRERE ( INODE ) 0 ) THEN
3056 NFRONT = NFSIZ( INODE )
3057 NPIV = NFRONT
3058 IF (BLKON) THEN
3059 IN = INODE
3060 NPIV_COMPG = 0
3061 DO WHILE( IN > 0 )
3062 NPIV_COMPG = NPIV_COMPG + 1
3063 IN = FILS( IN )
3064 ENDDO
3065 ELSE
3066 NPIV_COMPG = NPIV
3067 ENDIF
3068 NCB = 0
3069.GT. IF ( int(NFRONT,8)*int(NFRONT,8)K79
3070 & ) THEN
3071 GOTO 333
3072 ENDIF
3073 ENDIF
3074 ENDIF
3075.eq. IF ( FRERE ( INODE ) 0 ) RETURN
3076 NFRONT = NFSIZ( INODE )
3077 IN = INODE
3078 NPIV = 0
3079 NPIV_COMPG = 0
3080 DO WHILE( IN > 0 )
3081 IF (BLKON) THEN
3082 NPIV = NPIV + SIZEOFBLOCKS(IN)
3083 ENDIF
3084 NPIV_COMPG = NPIV_COMPG + 1
3085 IN = FILS( IN )
3086 END DO
3087.NOT. IF (BLKON) NPIV = NPIV_COMPG
3088 NCB = NFRONT - NPIV
3089.LE. IF ( (NFRONT - (NPIV/2)) KEEP(9)) RETURN
3090.and..OR. IF ((KEEP(50) == 0int(NFRONT,8) * int(NPIV,8) > K79 )
3091.NE..and. &(KEEP(50) 0int(NPIV,8) * int(NPIV,8) > K79 )) GOTO 333
3092.EQ. IF (KEEP(210)1) THEN
3093 NSLAVESMIN = 1
3094 NSLAVESMAX = 64
3095 NSLAVES_ESTIM = 32+NSLAVES
3096 ELSE
3097 NSLAVESMIN = MUMPS_BLOC2_GET_NSLAVESMIN
3098 & ( NSLAVES, KEEP(48), KEEP8(21), KEEP(50),
3099 & NFRONT, NCB, KEEP(375), KEEP(119))
3100 NSLAVESMAX = MUMPS_BLOC2_GET_NSLAVESMAX
3101 & ( NSLAVES, KEEP(48), KEEP8(21), KEEP(50),
3102 & NFRONT, NCB, KEEP(375), KEEP(119))
3103 NSLAVES_ESTIM = max (1,
3104 & nint( real(NSLAVESMAX-NSLAVESMIN)/real(3) )
3105 & )
3106 NSLAVES_ESTIM = min (NSLAVES_ESTIM, NSLAVES-1)
3107 ENDIF
3108.eq. IF ( KEEP(50) 0 ) THEN
3109 WK_MASTER = 0.6667E0 *
3110 & real(NPIV)*real(NPIV)*real(NPIV) +
3111 & real(NPIV)*real(NPIV)*real(NCB)
3112 WK_SLAVE = real( NPIV ) * real( NCB ) *
3113 & ( 2.0E0 * real(NFRONT) - real(NPIV) )
3114 & / real(NSLAVES_ESTIM)
3115 ELSE
3116 WK_MASTER = real(NPIV)*real(NPIV)*real(NPIV) / real(3)
3117 WK_SLAVE =
3118 & (real(NPIV)*real(NCB)*real(NFRONT))
3119 & / real(NSLAVES_ESTIM)
3120 ENDIF
3121.EQ. IF (KEEP(210)1) THEN
3122 IF ( real( 100 + STRAT )
3123.GE. & * WK_SLAVE / real(100) WK_MASTER ) RETURN
3124 ELSE
3125 IF ( real( 100 + STRAT * max( DEPTH-1, 1 ) )
3126.GE. & * WK_SLAVE / real(100) WK_MASTER ) RETURN
3127 ENDIF
3128 333 CONTINUE
3129.LE. IF (NPIV 1 ) RETURN
3130 NPIV_SON = max(NPIV/2,1)
3131 NPIV_FATH = NPIV - NPIV_SON
3132 IF (SPLITROOT) THEN
3133 IF (NCB .NE .0) THEN
3134 WRITE(*,*) "Error splitting"
3135 CALL MUMPS_ABORT()
3136 ENDIF
3137 NPIV_FATH = min(int(sqrt(real(K79))), int(NPIV/2))
3138 NPIV_SON = NPIV - NPIV_FATH
3139 ENDIF
3140 INODE_SON = INODE
3141 IF (BLKON) THEN
3142 NPIV_TEMP = 0
3143 NPIV_SON_COMPG = 0
3144 IN_SON = INODE
3145 DO WHILE (IN_SON > 0)
3146 NPIV_TEMP = NPIV_TEMP + SIZEOFBLOCKS(IN_SON)
3147 NPIV_SON_COMPG = NPIV_SON_COMPG +1
3148.GE. IF (NPIV_TEMPNPIV_SON) EXIT
3149 IN_SON = FILS( IN_SON )
3150 END DO
3151 NPIV_FATH_COMPG = NPIV_COMPG - NPIV_SON_COMPG
3152 NPIV_SON = NPIV_TEMP
3153 NPIV_FATH = NPIV - NPIV_SON
3154 ELSE
3155 NPIV_SON_COMPG = NPIV_SON
3156 NPIV_FATH_COMPG = NPIV_FATH
3157 IN_SON = INODE
3158 DO I = 1, NPIV_SON_COMPG - 1
3159 IN_SON = FILS( IN_SON )
3160 END DO
3161 ENDIF
3162.EQ. IF (NPIV_FATH_COMPG0) RETURN
3163 NSTEPS = NSTEPS + 1
3164 TOT_CUT = TOT_CUT + 1
3165 INODE_FATH = FILS( IN_SON )
3166.LT. IF ( INODE_FATH 0 ) THEN
3167 write(*,*) 'error: inode_fath < 0 ', INODE_FATH
3168 END IF
3169 IN_FATH = INODE_FATH
3170 DO WHILE ( FILS( IN_FATH ) > 0 )
3171 IN_FATH = FILS( IN_FATH )
3172 END DO
3173 FRERE( INODE_FATH ) = FRERE( INODE_SON )
3174 FRERE( INODE_SON ) = - INODE_FATH
3175 FILS ( IN_SON ) = FILS( IN_FATH )
3176 FILS ( IN_FATH ) = - INODE_SON
3177 IN = FRERE( INODE_FATH )
3178 DO WHILE ( IN > 0 )
3179 IN = FRERE( IN )
3180 END DO
3181.eq. IF ( IN 0 ) GO TO 10
3182 IN = -IN
3183 DO WHILE ( FILS( IN ) > 0 )
3184 IN = FILS( IN )
3185 END DO
3186 IN_GRANDFATH = IN
3187.eq. IF ( FILS( IN_GRANDFATH ) - INODE_SON ) THEN
3188 FILS( IN_GRANDFATH ) = -INODE_FATH
3189 ELSE
3190 IN = IN_GRANDFATH
3191 IN = - FILS ( IN )
3192 DO WHILE ( FRERE( IN ) > 0 )
3193.eq. IF ( FRERE( IN ) INODE_SON ) THEN
3194 FRERE( IN ) = INODE_FATH
3195 GOTO 10
3196 END IF
3197 IN = FRERE( IN )
3198 END DO
3199 WRITE(*,*) 'error 2 in split node',
3200 & IN_GRANDFATH, IN, FRERE(IN)
3201 END IF
3202 10 CONTINUE
3203 NFSIZ(INODE_SON) = NFRONT
3204 NFSIZ(INODE_FATH) = NFRONT - NPIV_SON
3205 KEEP(2) = max( KEEP(2), NFRONT - NPIV_SON )
3206 IF (SPLITROOT) THEN
3207 RETURN
3208 ENDIF
3209 CALL CMUMPS_SPLIT_1NODE
3210 & ( INODE_FATH, N, FRERE, FILS, NFSIZ, NSTEPS,
3211 & NSLAVES, KEEP,KEEP8, TOT_CUT, STRAT, DEPTH,
3212 & K79, SPLITROOT, MP, LDIAG,
3213 & BLKON, SIZEOFBLOCKS, LSIZEOFBLOCKS )
3214.NOT. IF ( SPLITROOT) THEN
3215 CALL CMUMPS_SPLIT_1NODE
3216 & ( INODE_SON, N, FRERE, FILS, NFSIZ, NSTEPS,
3217 & NSLAVES, KEEP,KEEP8, TOT_CUT, STRAT, DEPTH,
3218 & K79, SPLITROOT, MP, LDIAG,
3219 & BLKON, SIZEOFBLOCKS, LSIZEOFBLOCKS )
3220 ENDIF
3221 RETURN
3222 END SUBROUTINE CMUMPS_SPLIT_1NODE
3223 SUBROUTINE CMUMPS_ANA_GNEW
3224 & (N, NZ, IRN, ICN, IW, LW, IPE, LEN,
3225 & IQ, FLAG, IWFR,
3226 & NRORM, NIORM, IFLAG,IERROR, ICNTL,
3227 & symmetry, SYM, NBQD, AvgDens,
3228 & KEEP264, KEEP265, PRINTSTAT,
3229 & INPLACE64_GRAPH_COPY
3230 & )
3231 IMPLICIT NONE
3232 INTEGER, intent(in) :: N, SYM
3233 INTEGER(8), intent(in) :: LW
3234 INTEGER(8), intent(in) :: NZ
3235 INTEGER, intent(in) :: ICNTL(60)
3236 INTEGER, intent(in) :: IRN(NZ), ICN(NZ)
3237 INTEGER, intent(out) :: IERROR, symmetry
3238 INTEGER, intent(out) :: NBQD, AvgDens
3239 INTEGER, intent(out) :: LEN(N), IW(LW)
3240 INTEGER(8), intent(out):: IWFR
3241 INTEGER(8), intent(out):: NRORM, NIORM
3242 INTEGER(8), intent(out):: IPE(N+1)
3243 INTEGER, intent(inout) :: IFLAG, KEEP264, KEEP265
3244 INTEGER(8), intent(out):: IQ(N)
3245 INTEGER, intent(out) :: FLAG(N)
3246 LOGICAL, intent(in) :: PRINTSTAT
3247 LOGICAL, intent(inout) :: INPLACE64_GRAPH_COPY
3248 INTEGER :: MP, MPG, I, J, N1
3249 INTEGER :: NBERR, THRESH
3250 INTEGER(8) :: K8, K1, K2, LAST, NDUP
3251 INTEGER(8) :: NZOFFA, NDIAGA, L, N8
3252 REAL :: RSYM
3253 INTRINSIC nint
3254 MP = ICNTL(2)
3255 MPG= ICNTL(3)
3256 NZOFFA = 0_8
3257 NDIAGA = 0
3258 IERROR = 0
3259 N8 = int(N,8)
3260 DO I=1,N+1
3261 IPE(I) = 0_8
3262 ENDDO
3263.EQ. IF (KEEP2640) THEN
3264.EQ..AND..EQ. IF ((SYM0)(KEEP265-1)) THEN
3265 DO K8=1_8,NZ
3266 I = IRN(K8)
3267 J = ICN(K8)
3268.GT..OR..GT..OR..LT. IF ((IN)(JN)(I1)
3269.OR..LT. & (J1)) THEN
3270 IERROR = IERROR + 1
3271 ELSE
3272.NE. IF (IJ) THEN
3273 IPE(I) = IPE(I) + 1_8
3274 NZOFFA = NZOFFA + 1_8
3275 ELSE
3276 NDIAGA = NDIAGA + 1_8
3277 ENDIF
3278 ENDIF
3279 ENDDO
3280 ELSE
3281 DO K8=1_8,NZ
3282 I = IRN(K8)
3283 J = ICN(K8)
3284.GT..OR..GT..OR..LT. IF ((IN)(JN)(I1)
3285.OR..LT. & (J1)) THEN
3286 IERROR = IERROR + 1
3287 ELSE
3288.NE. IF (IJ) THEN
3289 IPE(I) = IPE(I) + 1_8
3290 IPE(J) = IPE(J) + 1_8
3291 NZOFFA = NZOFFA + 1_8
3292 ELSE
3293 NDIAGA = NDIAGA + 1_8
3294 ENDIF
3295 ENDIF
3296 ENDDO
3297 ENDIF
3298 ELSE
3299.EQ..AND..EQ. IF ((SYM0)(KEEP265-1)) THEN
3300 DO K8=1_8,NZ
3301 I = IRN(K8)
3302 J = ICN(K8)
3303.EQ. IF (IJ) THEN
3304 NDIAGA = NDIAGA + 1_8
3305 ELSE
3306 IPE(I) = IPE(I) + 1_8
3307 NZOFFA = NZOFFA + 1_8
3308 ENDIF
3309 ENDDO
3310 ELSE
3311 DO K8=1_8,NZ
3312 I = IRN(K8)
3313 J = ICN(K8)
3314.NE. IF (IJ) THEN
3315 IPE(I) = IPE(I) + 1_8
3316 IPE(J) = IPE(J) + 1_8
3317 NZOFFA = NZOFFA + 1_8
3318 ELSE
3319 NDIAGA = NDIAGA + 1_8
3320 ENDIF
3321 ENDDO
3322 ENDIF
3323 ENDIF
3324 NIORM = NZOFFA + 3_8*N8
3325.GE. IF (IERROR1) THEN
3326 NBERR = 0
3327.EQ. IF (mod(IFLAG,2) 0) IFLAG = IFLAG+1
3328.GT..AND..GE. IF ((MP0)(ICNTL(4)2)) THEN
3329 WRITE (MP,99999)
3330 DO 70 K8=1_8,NZ
3331 I = IRN(K8)
3332 J = ICN(K8)
3333.GT..OR..GT..OR..LT. IF ((IN)(JN)(I1)
3334.OR..LT. & (J1)) THEN
3335 NBERR = NBERR + 1
3336.LE. IF (NBERR10) THEN
3337.GT..OR..EQ..OR. IF (mod(K8,10_8)3_8 mod(K8,10_8)0_8
3338.LE..AND..LE. & (10_8K8 K820_8)) THEN
3339 WRITE (MP,'(i16,a,i10,a,i10,a)')
3340 & K8,'th entry(in row',I,' and column',J,') ignored'
3341 ELSE
3342.EQ. IF (mod(K8,10_8)1_8)
3343 & WRITE(MP,'(i16,a,i10,a,i10,a)')
3344 & K8,'st entry(in row',I,' and column',J,') ignored'
3345.EQ. IF (mod(K8,10_8)2_8)
3346 & WRITE(MP,'(i16,a,i10,a,i10,a)')
3347 & K8,'nd entry(in row',I,' and column',J,') ignored'
3348.EQ. IF (mod(K8,10_8)3_8)
3349 & WRITE(MP,'(i16,a,i10,a,i10,a)')
3350 & K8,'rd entry(in row',I,' and column',J,') ignored'
3351 ENDIF
3352 ELSE
3353 GO TO 100
3354 ENDIF
3355 ENDIF
3356 70 CONTINUE
3357 ENDIF
3358 ENDIF
3359 100 NRORM = NIORM - 2_8*N8
3360 IQ(1) = 1_8
3361 N1 = N - 1
3362.GT. IF (N10) THEN
3363 DO I=1,N1
3364 IQ(I+1) = IPE(I) + IQ(I)
3365 ENDDO
3366 ENDIF
3367 LAST = max(IPE(N)+IQ(N)-1,IQ(N))
3368 FLAG(1:N) = 0
3369 IPE(1:N) = IQ(1:N)
3370 IW(1:LAST) = 0
3371 IWFR = LAST + 1_8
3372.EQ. IF (KEEP264 0) THEN
3373.EQ..AND..EQ. IF ((SYM0)(KEEP265-1)) THEN
3374 DO K8=1_8,NZ
3375 I = IRN(K8)
3376 J = ICN(K8)
3377.NE. IF (IJ) THEN
3378.GE..AND..LE. IF ((J1)(IN)) THEN
3379 IW(IQ(I)) = J
3380 IQ(I) = IQ(I) + 1
3381 ENDIF
3382 ENDIF
3383 ENDDO
3384.EQ. ELSE IF (KEEP2651) THEN
3385 DO K8=1_8,NZ
3386 I = IRN(K8)
3387 J = ICN(K8)
3388.NE. IF (IJ) THEN
3389.GE..AND..LE. IF ((J1)(IN)) THEN
3390 IW(IQ(J)) = I
3391 IQ(J) = IQ(J) + 1
3392 IW(IQ(I)) = J
3393 IQ(I) = IQ(I) + 1
3394 ENDIF
3395 ENDIF
3396 ENDDO
3397 ELSE
3398 DO K8=1_8,NZ
3399 I = IRN(K8)
3400 J = ICN(K8)
3401.NE. IF (IJ) THEN
3402.LT. IF (IJ) THEN
3403.GE..AND..LE. IF ((I1)(JN)) THEN
3404 IW(IQ(I)) = -J
3405 IQ(I) = IQ(I) + 1
3406 ENDIF
3407 ELSE
3408.GE..AND..LE. IF ((J1)(IN)) THEN
3409 IW(IQ(J)) = -I
3410 IQ(J) = IQ(J) + 1
3411 ENDIF
3412 ENDIF
3413 ENDIF
3414 ENDDO
3415 ENDIF
3416 ELSE
3417.EQ..AND..EQ. IF ((SYM0)(KEEP265-1)) THEN
3418 DO K8=1_8,NZ
3419 I = IRN(K8)
3420 J = ICN(K8)
3421.NE. IF (IJ) THEN
3422 IW(IQ(I)) = J
3423 IQ(I) = IQ(I) + 1
3424 ENDIF
3425 ENDDO
3426.EQ. ELSE IF (KEEP2651) THEN
3427 DO K8=1_8,NZ
3428 I = IRN(K8)
3429 J = ICN(K8)
3430.NE. IF (IJ) THEN
3431 IW(IQ(J)) = I
3432 IQ(J) = IQ(J) + 1
3433 IW(IQ(I)) = J
3434 IQ(I) = IQ(I) + 1
3435 ENDIF
3436 ENDDO
3437 ELSE
3438 DO K8=1_8,NZ
3439 I = IRN(K8)
3440 J = ICN(K8)
3441.NE. IF (IJ) THEN
3442.LT. IF (IJ) THEN
3443 IW(IQ(I)) = -J
3444 IQ(I) = IQ(I) + 1
3445 ELSE
3446 IW(IQ(J)) = -I
3447 IQ(J) = IQ(J) + 1
3448 ENDIF
3449 ENDIF
3450 ENDDO
3451 ENDIF
3452 ENDIF
3453.EQ. IF (KEEP2650) THEN
3454 NDUP = 0_8
3455 DO I=1,N
3456 K1 = IPE(I)
3457 K2 = IQ(I) - 1_8
3458.GT. IF (K1K2) THEN
3459 LEN(I) = 0
3460 ELSE
3461 DO K8=K1,K2
3462 J = -IW(K8)
3463.LE. IF (J0) EXIT
3464.EQ. IF (FLAG(J)I) THEN
3465 NDUP = NDUP + 1_8
3466 IW(K8) = 0
3467 ELSE
3468 L = IQ(J)
3469 IW(L) = I
3470 IQ(J) = L + 1
3471 IW(K8) = J
3472 FLAG(J) = I
3473 ENDIF
3474 END DO
3475 LEN(I) = int((IQ(I) - IPE(I)))
3476 ENDIF
3477 ENDDO
3478.NE. IF (NDUP0_8) THEN
3479 IWFR = 1_8
3480 DO I=1,N
3481.EQ. IF (LEN(I)0) THEN
3482 IPE(I) = IWFR
3483 CYCLE
3484 ENDIF
3485 K1 = IPE(I)
3486 K2 = K1 + LEN(I) - 1
3487 L = IWFR
3488 IPE(I) = IWFR
3489 DO 270 K8=K1,K2
3490.NE. IF (IW(K8)0) THEN
3491 IW(IWFR) = IW(K8)
3492 IWFR = IWFR + 1_8
3493 ENDIF
3494 270 CONTINUE
3495 LEN(I) = int(IWFR - L)
3496 ENDDO
3497 ELSE
3498 KEEP265 = 1
3499 ENDIF
3500 IPE(N+1) = IPE(N) + int(LEN(N),8)
3501 IWFR = IPE(N+1)
3502 ELSE
3503 IPE(1) = 1_8
3504 DO I = 1, N
3505 LEN(I) = int(IQ(I) - IPE(I))
3506 ENDDO
3507 DO I = 1, N
3508 IPE(I+1) = IPE(I) + int(LEN(I),8)
3509 ENDDO
3510 IWFR = IPE(N+1)
3511 ENDIF
3512 symmetry = 100
3513.EQ. IF (SYM0) THEN
3514 RSYM = real(NDIAGA+2_8*NZOFFA - (IWFR-1_8))/
3515 & real(NZOFFA+NDIAGA)
3516.EQ..AND..EQ. IF ((KEEP2650) (NZOFFA - (IWFR-1_8))0_8)
3517 & THEN
3518 KEEP265 = -1
3519 ENDIF
3520 symmetry = min(nint (100.0E0*RSYM), 100)
3521 IF (PRINTSTAT) THEN
3522.GT..AND..GE. IF ((MPG 0)(ICNTL(4)2) )
3523 & write(MPG,'(a,i5)')
3524 & ' ... structural symmetry(in percent)=', symmetry
3525.GT..AND..NE..AND..GE. IF (MP0 MPGMP (ICNTL(4)2) )
3526 & write(MP,'(a,i5)')
3527 & ' ... structural symmetry(in percent)=', symmetry
3528 ENDIF
3529 ELSE
3530 ENDIF
3531 AvgDens = nint(real(IWFR-1_8)/real(N))
3532 THRESH = AvgDens*50 - AvgDens/10 + 1
3533 NBQD = 0
3534.GT. IF (N2) THEN
3535 DO I= 1, N
3536 J = max(LEN(I),1)
3537.GT. IF (JTHRESH) NBQD = NBQD+1
3538 ENDDO
3539 ENDIF
3540.GE. INPLACE64_GRAPH_COPY = (LW2*(IWFR-1_8))
3541 IF (PRINTSTAT) THEN
3542.GT..AND..GE. IF (MPG 0(ICNTL(4)2))
3543 & write(MPG,'(a,1i5)')
3544 & ' average density of rows/columns =', AvgDens
3545.GT..AND..NE..AND..GE. IF (MP0 MPGMP(ICNTL(4)2))
3546 & write(MP,'(a,1i5)')
3547 & ' average density of rows/columns =', AvgDens
3548 ENDIF
3549 RETURN
355099999 FORMAT (/'*** warning message from analysis routine ***')
3551 END SUBROUTINE CMUMPS_ANA_GNEW
3552 SUBROUTINE CMUMPS_SET_K821_SURFACE
3553 & (KEEP821, KEEP2, KEEP48 ,KEEP50, NSLAVES)
3554 IMPLICIT NONE
3555 INTEGER NSLAVES, KEEP2, KEEP48, KEEP50
3556 INTEGER (8) :: KEEP821
3557 INTEGER(8) KEEP2_SQUARE, NSLAVES8
3558 NSLAVES8= int(NSLAVES,8)
3559 KEEP2_SQUARE = int(KEEP2,8) * int(KEEP2,8)
3560 KEEP821 = max(KEEP821*int(KEEP2,8),1_8)
3561#if defined(t3e)
3562 KEEP821 = min(1500000_8, KEEP821)
3563#elif defined(SP_)
3564 KEEP821 = min(3000000_8, KEEP821)
3565#else
3566 KEEP821 = min(2000000_8, KEEP821)
3567#endif
3568#if defined(t3e)
3569.GT. IF (NSLAVES 64) THEN
3570 KEEP821 =
3571 & min(8_8*KEEP2_SQUARE/NSLAVES8+1_8, KEEP821)
3572 ELSE
3573 KEEP821 =
3574 & min(4_8*KEEP2_SQUARE/NSLAVES8+1_8, KEEP821)
3575 ENDIF
3576#else
3577.GT. IF (NSLAVES64) THEN
3578 KEEP821 =
3579 & min(6_8*KEEP2_SQUARE/NSLAVES8+1_8, KEEP821)
3580 ELSE
3581 KEEP821 =
3582 & min(4_8*KEEP2_SQUARE/NSLAVES8+1_8, KEEP821)
3583 ENDIF
3584#endif
3585.EQ. IF (KEEP50 0 ) THEN
3586 KEEP821 = max(KEEP821,(7_8*KEEP2_SQUARE /
3587 & 4_8 / int(max(NSLAVES-1,1),8)) + int(KEEP2,8))
3588 ELSE
3589 KEEP821 = max(KEEP821,(7_8*KEEP2_SQUARE /
3590 & 4_8 / int(max(NSLAVES-1,1),8)) + int(KEEP2,8))
3591 ENDIF
3592.EQ. IF (KEEP50 0 ) THEN
3593#if defined(t3e)
3594 KEEP821 = max(KEEP821,200000_8)
3595#else
3596 KEEP821 = max(KEEP821,300000_8)
3597#endif
3598 ELSE
3599#if defined(t3e)
3600 KEEP821 = max(KEEP821,40000_8)
3601#else
3602 KEEP821 = max(KEEP821,80000_8)
3603#endif
3604 ENDIF
3605 KEEP821 = -KEEP821
3606 RETURN
3607 END SUBROUTINE CMUMPS_SET_K821_SURFACE
3608 SUBROUTINE CMUMPS_MTRANS_DRIVER(JOB,M,N,NE,
3609 & IP,IRN,A,LA,NUM,PERM,LIW,IW,LDW,DW,
3610 & IPQ8,
3611 & ICNTL,CNTL,INFO, INFOMUMPS)
3612 IMPLICIT NONE
3613 INTEGER :: NICNTL, NCNTL, NINFO, INFOMUMPS(80)
3614 PARAMETER (NICNTL=10, NCNTL=10, NINFO=10)
3615 INTEGER :: JOB,M,N,NUM
3616 INTEGER(8), INTENT(IN) :: NE, LIW,LDW, LA
3617 INTEGER(8) :: IP(N+1), IPQ8(N)
3618 INTEGER :: IRN(NE),PERM(M),IW(LIW)
3619 INTEGER :: ICNTL(NICNTL),INFO(NINFO)
3620 REAL :: A(LA)
3621 REAL :: DW(LDW),CNTL(NCNTL)
3622 INTEGER(8), DIMENSION(:), ALLOCATABLE :: IWtemp8
3623 INTEGER :: allocok
3624 INTEGER :: I,J,WARN1,WARN2,WARN4
3625 INTEGER(8) :: K
3626 REAL :: FACT,ZERO,ONE,RINF,RINF2,RINF3
3627 PARAMETER (ZERO=0.0E+00,ONE=1.0E+0)
3628 EXTERNAL CMUMPS_MTRANSZ,CMUMPS_MTRANSB,CMUMPS_MTRANSR,
3629 & CMUMPS_MTRANSS,CMUMPS_MTRANSW
3630 INTRINSIC abs,log
3631 RINF = CNTL(2)
3632 RINF2 = huge(RINF2)/real(2*N)
3633 RINF3 = 0.0E0
3634 WARN1 = 0
3635 WARN2 = 0
3636 WARN4 = 0
3637.LT..OR..GT. IF (JOB1 JOB6) THEN
3638 INFO(1) = -1
3639 INFO(2) = JOB
3640.GE. IF (ICNTL(1)0) WRITE(ICNTL(1),9001) INFO(1),'job',job
3641 GO TO 99
3642 ENDIF
3643 IF (m.LT.1 .OR. m.LT.n) THEN
3644 info(1) = -2
3645 info(2) = m
3646 IF (icntl(1).GE.0) WRITE(icntl(1),9001) info(1),'M',m
3647 GO TO 99
3648 ENDIF
3649 IF (n.LT.1) THEN
3650 info(1) = -2
3651 info(2) = n
3652 IF (icntl(1).GE.0) WRITE(icntl(1),9001) info(1),'N',n
3653 GO TO 99
3654 ENDIF
3655 IF (ne.LT.1) THEN
3656 info(1) = -3
3657 CALL mumps_set_ierror(ne,info(2))
3658 IF (icntl(1).GE.0) WRITE(icntl(1),9001) info(1),'NE',ne
3659 GO TO 99
3660 ENDIF
3661 IF (job.EQ.1) k = int(4*n + m,8)
3662 IF (job.EQ.2) k = int(n + 2*m,8)
3663 IF (job.EQ.3) k = int(8*n + 2*m + ne,8)
3664 IF (job.EQ.4) k = int(n + m,8)
3665 IF (job.EQ.5) k = int(3*n + 2*m,8)
3666 IF (job.EQ.6) k = int(3*n + 2*m + ne,8)
3667 IF (liw.LT.k) THEN
3668 info(1) = -4
3669 CALL mumps_set_ierror(k,info(2))
3670 IF (icntl(1).GE.0) WRITE(icntl(1),9004) info(1),k
3671 GO TO 99
3672 ENDIF
3673 IF (job.GT.1) THEN
3674 IF (job.EQ.2) k = int( m,8)
3675 IF (job.EQ.3) k = int(1,8)
3676 IF (job.EQ.4) k = int( 2*m,8)
3677 IF (job.EQ.5) k = int(n + 2*m,8)
3678 IF (job.EQ.6) k = int(n + 3*m,8)
3679 IF (ldw .LT. k) THEN
3680 info(1) = -5
3681 CALL mumps_set_ierror(k,info(2))
3682 IF (icntl(1).GE.0) WRITE(icntl(1),9005) info(1),k
3683 GO TO 99
3684 ENDIF
3685 ENDIF
3686 IF (icntl(5).EQ.0) THEN
3687 DO 3 i = 1,m
3688 iw(i) = 0
3689 3 CONTINUE
3690 DO 6 j = 1,n
3691 DO 4 k = ip(j),ip(j+1)-1_8
3692 i = irn(k)
3693 IF (i.LT.1 .OR. i.GT.m) THEN
3694 info(1) = -6
3695 info(2) = j
3696 IF (icntl(1).GE.0) WRITE(icntl(1),9006) info(1),j,i
3697 GO TO 99
3698 ENDIF
3699 IF (iw(i).EQ.j) THEN
3700 info(1) = -7
3701 info(2) = j
3702 IF (icntl(1).GE.0) WRITE(icntl(1),9007) info(1),j,i
3703 GO TO 99
3704 ELSE
3705 iw(i) = j
3706 ENDIF
3707 4 CONTINUE
3708 6 CONTINUE
3709 ENDIF
3710 IF (icntl(3).GT.0) THEN
3711 IF (icntl(4).EQ.0 .OR. icntl(4).EQ.1) THEN
3712 WRITE(icntl(3),9020) job,m,n,ne
3713 IF (icntl(4).EQ.0) THEN
3714 WRITE(icntl(3),9021) (ip(j),j=1,min(10,n+1))
3715 WRITE(icntl(3),9022) (irn(k),k=1_8,min(10_8,ne))
3716 IF (job.GT.1) WRITE(icntl(3),9023)
3717 & (a(k),k=1_8,min(10_8,ne))
3718 ELSEIF (icntl(4).EQ.1) THEN
3719 WRITE(icntl(3),9021) (ip(j),j=1,n+1)
3720 WRITE(icntl(3),9022) (irn(k),k=1_8,ne)
3721 IF (job.GT.1) WRITE(icntl(3),9023) (a(k),k=1_8,ne)
3722 ENDIF
3723 WRITE(icntl(3),9024) (icntl(j),j=1,nicntl)
3724 WRITE(icntl(3),9025) (cntl(j),j=1,ncntl)
3725 ENDIF
3726 ENDIF
3727 DO 8 i=1,ninfo
3728 info(i) = 0
3729 8 CONTINUE
3730 IF (job.EQ.1) THEN
3731 DO 10 j = 1,n
3732 iw(j) = int(ip(j+1) - ip(j))
3733 10 CONTINUE
3734 CALL cmumps_mtransz(m,n,irn,ne,ip,iw(1),perm,num,
3735 & iw(n+1),iw(2*n+1),iw(3*n+1),iw(3*n+m+1))
3736 GO TO 90
3737 ENDIF
3738 IF (job.EQ.2) THEN
3739 dw(1) = max(zero,cntl(1))
3740 CALL cmumps_mtransb(m,n,ne,ip,irn,a,perm,num,
3741 & iw(1),ipq8,iw(n+1),iw(n+m+1),dw,rinf2)
3742 GO TO 90
3743 ENDIF
3744 IF (job.EQ.3) THEN
3745 DO 20 k = 1,ne
3746 iw(k) = irn(k)
3747 20 CONTINUE
3748 CALL cmumps_mtransr(n,ne,ip,iw,a)
3749 fact = max(zero,cntl(1))
3750 CALL cmumps_mtranss(m,n,ne,ip,iw(1),a,perm,num,iw(ne+1),
3751 & iw(ne+n+1),iw(ne+2*n+1),iw(ne+3*n+1),iw(ne+4*n+1),
3752 & iw(ne+5*n+1),iw(ne+5*n+m+1),fact,rinf2)
3753 GO TO 90
3754 ENDIF
3755 IF ((job.EQ.4).OR.(job.EQ.5).or.(job.EQ.6)) THEN
3756 ALLOCATE(iwtemp8(m+n+n), stat=allocok)
3757 IF (allocok.GT.0) THEN
3758 infomumps(1) = -7
3759 infomumps(2) = m+n+n
3760 GOTO 90
3761 ENDIF
3762 ENDIF
3763 IF (job.EQ.4) THEN
3764 DO 50 j = 1,n
3765 fact = zero
3766 DO 30 k = ip(j),ip(j+1)-1_8
3767 IF (abs(a(k)).GT.fact) fact = abs(a(k))
3768 30 CONTINUE
3769 IF(fact .GT. rinf3) rinf3 = fact
3770 DO 40 k = ip(j),ip(j+1)-1_8
3771 a(k) = fact - abs(a(k))
3772 40 CONTINUE
3773 50 CONTINUE
3774 dw(1) = max(zero,cntl(1))
3775 dw(2) = rinf3
3776 iwtemp8(1) = int(job,8)
3777 CALL cmumps_mtransw(m,n,ne,ip,irn,a,perm,num,
3778 & iwtemp8(1),iw(1),iwtemp8(n+1),ipq8,iw(n+1),
3779 & iwtemp8(2*n+1),
3780 & dw(1),dw(m+1),rinf2)
3781 DEALLOCATE(iwtemp8)
3782 GO TO 90
3783 ENDIF
3784 IF (job.EQ.5 .or. job.EQ.6) THEN
3785 rinf3=one
3786 IF (job.EQ.5) THEN
3787 DO 75 j = 1,n
3788 fact = zero
3789 DO 60 k = ip(j),ip(j+1)-1_8
3790 IF (a(k).GT.fact) fact = a(k)
3791 60 CONTINUE
3792 dw(2*m+j) = fact
3793 IF (fact.NE.zero) THEN
3794 fact = log(fact)
3795 IF(fact .GT. rinf3) rinf3=fact
3796 DO 70 k = ip(j),ip(j+1)-1_8
3797 IF (a(k).NE.zero) THEN
3798 a(k) = fact - log(a(k))
3799 IF(a(k) .GT. rinf3) rinf3=a(k)
3800 ELSE
3801 a(k) = fact + rinf
3802 ENDIF
3803 70 CONTINUE
3804 ELSE
3805 DO 71 k = ip(j),ip(j+1)-1_8
3806 a(k) = one
3807 71 CONTINUE
3808 ENDIF
3809 75 CONTINUE
3810 ENDIF
3811 IF (job.EQ.6) THEN
3812 DO 175 k = 1,ne
3813 iw(3*n+2*m+k) = irn(k)
3814 175 CONTINUE
3815 DO 61 i = 1,m
3816 dw(2*m+n+i) = zero
3817 61 CONTINUE
3818 DO 63 j = 1,n
3819 DO 62 k = ip(j),ip(j+1)-1_8
3820 i = irn(k)
3821 IF (a(k).GT.dw(2*m+n+i)) THEN
3822 dw(2*m+n+i) = a(k)
3823 ENDIF
3824 62 CONTINUE
3825 63 CONTINUE
3826 DO 64 i = 1,m
3827 IF (dw(2*m+n+i).NE.zero) THEN
3828 dw(2*m+n+i) = 1.0e0/dw(2*m+n+i)
3829 ENDIF
3830 64 CONTINUE
3831 DO 66 j = 1,n
3832 DO 65 k = ip(j),ip(j+1)-1
3833 i = irn(k)
3834 a(k) = dw(2*m+n+i) * a(k)
3835 65 CONTINUE
3836 66 CONTINUE
3837 CALL cmumps_mtransr(n,ne,ip,iw(3*n+2*m+1),a)
3838 DO 176 j = 1,n
3839 IF (ip(j).NE.ip(j+1)) THEN
3840 fact = a(ip(j))
3841 ELSE
3842 fact = zero
3843 ENDIF
3844 dw(2*m+j) = fact
3845 IF (fact.NE.zero) THEN
3846 fact = log(fact)
3847 DO 170 k = ip(j),ip(j+1)-1_8
3848 IF (a(k).NE.zero) THEN
3849 a(k) = fact - log(a(k))
3850 IF(a(k) .GT. rinf3) rinf3=a(k)
3851 ELSE
3852 a(k) = fact + rinf
3853 ENDIF
3854 170 CONTINUE
3855 ELSE
3856 DO 171 k = ip(j),ip(j+1)-1_8
3857 a(k) = one
3858 171 CONTINUE
3859 ENDIF
3860 176 CONTINUE
3861 ENDIF
3862 dw(1) = max(zero,cntl(1))
3863 rinf3 = rinf3+one
3864 dw(2) = rinf3
3865 iwtemp8(1) = int(job,8)
3866 IF (job.EQ.5) THEN
3867 CALL cmumps_mtransw(m,n,ne,ip,irn,a,perm,num,
3868 & iwtemp8(1),iw(1),iwtemp8(n+1),ipq8,iw(n+1),
3869 & iwtemp8(2*n+1),
3870 & dw(1),dw(m+1),rinf2)
3871 ENDIF
3872 IF (job.EQ.6) THEN
3873 CALL cmumps_mtransw(m,n,ne,ip,iw(3*n+2*m+1),a,perm,num,
3874 & iwtemp8(1),iw(1),iwtemp8(n+1),ipq8,iw(n+1),
3875 & iwtemp8(2*n+1),
3876 & dw(1),dw(m+1),rinf2)
3877 ENDIF
3878 IF ((job.EQ.5).or.(job.EQ.6)) THEN
3879 DEALLOCATE(iwtemp8)
3880 ENDIF
3881 IF (job.EQ.6) THEN
3882 DO 79 i = 1,m
3883 IF (dw(2*m+n+i).NE.0.0e0) THEN
3884 dw(i) = dw(i) + log(dw(2*m+n+i))
3885 ENDIF
3886 79 CONTINUE
3887 ENDIF
3888 IF (num.EQ.n) THEN
3889 DO 80 j = 1,n
3890 IF (dw(2*m+j).NE.zero) THEN
3891 dw(m+j) = dw(m+j) - log(dw(2*m+j))
3892 ELSE
3893 dw(m+j) = zero
3894 ENDIF
3895 80 CONTINUE
3896 ENDIF
3897 fact = 0.5e0*log(rinf2)
3898 DO 86 i = 1,m
3899 IF (dw(i).LT.fact) GO TO 86
3900 warn2 = 2
3901 GO TO 90
3902 86 CONTINUE
3903 DO 87 j = 1,n
3904 IF (dw(m+j).LT.fact) GO TO 87
3905 warn2 = 2
3906 GO TO 90
3907 87 CONTINUE
3908 ENDIF
3909 90 IF (infomumps(1).LT.0) RETURN
3910 IF (num.LT.n) warn1 = 1
3911 IF (job.EQ.4 .OR. job.EQ.5 .OR. job.EQ.6) THEN
3912 IF (cntl(1).LT.zero) warn4 = 4
3913 ENDIF
3914 IF (info(1).EQ.0) THEN
3915 info(1) = warn1 + warn2 + warn4
3916 IF (info(1).GT.0 .AND. icntl(2).GT.0) THEN
3917 WRITE(icntl(2),9010) info(1)
3918 IF (warn1.EQ.1) WRITE(icntl(2),9011)
3919 IF (warn2.EQ.2) WRITE(icntl(2),9012)
3920 IF (warn4.EQ.4) WRITE(icntl(2),9014)
3921 ENDIF
3922 ENDIF
3923 IF (icntl(3).GE.0) THEN
3924 IF (icntl(4).EQ.0 .OR. icntl(4).EQ.1) THEN
3925 WRITE(icntl(3),9030) (info(j),j=1,2)
3926 WRITE(icntl(3),9031) num
3927 IF (icntl(4).EQ.0) THEN
3928 WRITE(icntl(3),9032) (perm(j),j=1,min(10,m))
3929 IF (job.EQ.5 .OR. job.EQ.6) THEN
3930 WRITE(icntl(3),9033) (dw(j),j=1,min(10,m))
3931 WRITE(icntl(3),9034) (dw(m+j),j=1,min(10,n))
3932 ENDIF
3933 ELSEIF (icntl(4).EQ.1) THEN
3934 WRITE(icntl(3),9032) (perm(j),j=1,m)
3935 IF (job.EQ.5 .OR. job.EQ.6) THEN
3936 WRITE(icntl(3),9033) (dw(j),j=1,m)
3937 WRITE(icntl(3),9034) (dw(m+j),j=1,n)
3938 ENDIF
3939 ENDIF
3940 ENDIF
3941 ENDIF
3942 99 RETURN
3943 9001 FORMAT (' ****** Error in CMUMPS_MTRANSA. INFO(1) = ',i2,
3944 & ' because ',(a),' = ',i14)
3945 9004 FORMAT (' ****** Error in CMUMPS_MTRANSA. INFO(1) = ',i2/
3946 & ' LIW too small, must be at least ',i14)
3947 9005 FORMAT (' ****** Error in CMUMPS_MTRANSA. INFO(1) = ',i2/
3948 & ' LDW too small, must be at least ',i14)
3949 9006 FORMAT (' ****** Error in CMUMPS_MTRANSA. INFO(1) = ',i2/
3950 & ' Column ',i8,
3951 & ' contains an entry with invalid row index ',i8)
3952 9007 FORMAT (' ****** Error in CMUMPS_MTRANSA. INFO(1) = ',i2/
3953 & ' Column ',i8,
3954 & ' contains two or more entries with row index ',i8)
3955 9010 FORMAT (' ****** Warning from CMUMPS_MTRANSA. INFO(1) = ',i2)
3956 9011 FORMAT (' - The matrix is structurally singular.')
3957 9012 FORMAT (' - Some scaling factors may be too large.')
3958 9014 FORMAT (' - CNTL(1) is negative and was treated as zero.')
3959 9020 FORMAT (' ****** Input parameters for CMUMPS_MTRANSA:'/
3960 & ' JOB =',i10/' M =',i10/' N =',i10/' NE =',i14)
3961 9021 FORMAT (' IP(1:N+1) = ',8i8/(15x,8i8))
3962 9022 FORMAT (' IRN(1:NE) = ',8i8/(15x,8i8))
3963 9023 FORMAT (' A(1:NE) = ',4(1pd14.4)/(15x,4(1pd14.4)))
3964 9024 FORMAT (' ICNTL(1:10) = ',8i8/(15x,2i8))
3965 9025 FORMAT (' CNTL(1:10) = ',4(1pd14.4)/(15x,4(1pd14.4)))
3966 9030 FORMAT (' ****** Output parameters for CMUMPS_MTRANSA:'/
3967 & ' INFO(1:2) = ',2i8)
3968 9031 FORMAT (' NUM = ',i8)
3969 9032 FORMAT (' PERM(1:M) = ',8i8/(15x,8i8))
3970 9033 FORMAT (' DW(1:M) = ',5(f11.3)/(15x,5(f11.3)))
3971 9034 FORMAT (' DW(M+1:M+N) = ',5(f11.3)/(15x,5(f11.3)))
3972 END SUBROUTINE cmumps_mtrans_driver
3973 SUBROUTINE cmumps_suppress_duppli_val(N,NZ,IP,IRN,A,FLAG,POSI)
3974 IMPLICIT NONE
3975 INTEGER, INTENT(IN) :: N
3976 INTEGER(8), INTENT(INOUT) :: NZ
3977 INTEGER(8), INTENT(INOUT) :: IP(N+1)
3978 INTEGER, INTENT(INOUT) :: IRN(NZ)
3979 REAL, INTENT(INOUT) :: A(NZ)
3980 INTEGER, INTENT(OUT) :: FLAG(N)
3981 INTEGER(8), INTENT(OUT) :: POSI(N)
3982 INTEGER :: ROW, COL
3983 INTEGER(8) :: K, WR_POS, BEG_COL, SV_POS
3984 flag = 0
3985 wr_pos = 1_8
3986 DO col=1,n
3987 beg_col = wr_pos
3988 DO k=ip(col),ip(col+1)-1_8
3989 row = irn(k)
3990 IF(flag(row) .NE. col) THEN
3991 irn(wr_pos) = row
3992 a(wr_pos) = a(k)
3993 flag(row) = col
3994 posi(row) = wr_pos
3995 wr_pos = wr_pos+1
3996 ELSE
3997 sv_pos = posi(row)
3998 a(sv_pos) = a(sv_pos) + a(k)
3999 ENDIF
4000 ENDDO
4001 ip(col) = beg_col
4002 ENDDO
4003 ip(n+1) = wr_pos
4004 nz = wr_pos-1_8
4005 RETURN
4006 END SUBROUTINE cmumps_suppress_duppli_val
4007 SUBROUTINE cmumps_suppress_duppli_str(N,NZ,IP,IRN,FLAG)
4008 IMPLICIT NONE
4009 INTEGER, INTENT(IN) :: N
4010 INTEGER(8), INTENT(INOUT) :: NZ
4011 INTEGER(8), INTENT(INOUT) :: IP(N+1)
4012 INTEGER, INTENT(INOUT) :: IRN(NZ)
4013 INTEGER, INTENT(OUT) :: FLAG(N)
4014 INTEGER :: ROW, COL
4015 INTEGER(8) :: K, WR_POS, BEG_COL
4016 flag = 0
4017 wr_pos = 1_8
4018 DO col=1,n
4019 beg_col = wr_pos
4020 DO k=ip(col),ip(col+1)-1_8
4021 row = irn(k)
4022 IF(flag(row) .NE. col) THEN
4023 irn(wr_pos) = row
4024 flag(row) = col
4025 wr_pos = wr_pos+1_8
4026 ENDIF
4027 ENDDO
4028 ip(col) = beg_col
4029 ENDDO
4030 ip(n+1) = wr_pos
4031 nz = wr_pos-1_8
4032 RETURN
4033 END SUBROUTINE cmumps_suppress_duppli_str
4034 SUBROUTINE cmumps_sort_perm( N, NA, LNA, NE_STEPS,
4035 & PERM, FILS,
4036 & DAD_STEPS, STEP, NSTEPS,
4037 & KEEP60, KEEP20, KEEP38,
4038 & INFO)
4039 IMPLICIT NONE
4040 INTEGER, INTENT(IN) :: N, NSTEPS, LNA
4041 INTEGER, INTENT(IN) :: FILS( N ), STEP(N), NA(LNA)
4042 INTEGER, INTENT(IN) :: DAD_STEPS ( NSTEPS ), NE_STEPS (NSTEPS)
4043 INTEGER, INTENT(IN) :: KEEP60, KEEP20, KEEP38
4044 INTEGER, INTENT(INOUT) :: INFO(80)
4045 INTEGER, INTENT(OUT) :: PERM( N )
4046 INTEGER :: IPERM, INODE, IN, ISCHUR
4047 INTEGER :: INBLEAF, INBROOT, allocok
4048 INTEGER, ALLOCATABLE, DIMENSION (:) :: POOL, NSTK
4049 inbleaf = na(1)
4050 inbroot = na(2)
4051 ALLOCATE(pool(inbleaf), nstk(nsteps), stat=allocok)
4052 IF (allocok > 0 ) THEN
4053 info(1) = -7
4054 info(2) = inbleaf + nsteps
4055 RETURN
4056 ENDIF
4057 pool(1:inbleaf) = na(3:2+inbleaf)
4058 nstk(1:nsteps) = ne_steps(1:nsteps)
4059 ischur = 0
4060 IF ( keep60.GT.0 ) THEN
4061 ischur = max(keep20, keep38)
4062 ENDIF
4063 iperm = 1
4064 DO WHILE ( inbleaf .NE. 0 )
4065 inode = pool( inbleaf )
4066 inbleaf = inbleaf - 1
4067 in = inode
4068 IF (inode.NE.ischur) THEN
4069 DO WHILE ( in .GT. 0 )
4070 perm( in ) = iperm
4071 iperm = iperm + 1
4072 in = fils( in )
4073 END DO
4074 ENDIF
4075 in = dad_steps(step( inode ))
4076 IF ( in .eq. 0 ) THEN
4077 inbroot = inbroot - 1
4078 ELSE
4079 nstk( step(in) ) = nstk( step(in) ) - 1
4080 IF ( nstk( step(in) ) .eq. 0 ) THEN
4081 inbleaf = inbleaf + 1
4082 pool( inbleaf ) = in
4083 END IF
4084 END IF
4085 END DO
4086 IF (iperm.LE.n) THEN
4087 IF (ischur.GT.0) THEN
4088 in = ischur
4089 DO WHILE ( in .GT. 0 )
4090 perm( in ) = iperm
4091 iperm = iperm + 1
4092 in = fils( in )
4093 END DO
4094 ENDIF
4095 ENDIF
4096 DEALLOCATE(pool, nstk)
4097 RETURN
4098 END SUBROUTINE cmumps_sort_perm
4099 SUBROUTINE cmumps_expand_tree_steps( ICNTL,
4100 & N, NBLK, BLKPTR, BLKVAR,
4101 & FILS_OLD, FILS_NEW, NSTEPS,
4102 & STEP_OLD, STEP_NEW, PAR2_NODES, NB_NIV2,
4103 & DAD_STEPS, FRERE_STEPS,
4104 & NA, LNA, LRGROUPS_OLD, LRGROUPS_NEW,
4105 & K20, K38
4106 & )
4107 IMPLICIT NONE
4108 INTEGER, INTENT(IN) :: N, NBLK, ICNTL(60), NSTEPS, LNA,
4109 & nb_niv2
4110 INTEGER, INTENT(IN) :: BLKPTR(NBLK+1), BLKVAR(N)
4111 INTEGER, INTENT(IN) :: FILS_OLD(NBLK), STEP_OLD(NBLK),
4112 & lrgroups_old(nblk)
4113 INTEGER, INTENT(OUT) :: FILS_NEW(N), STEP_NEW(N),
4114 & lrgroups_new(n)
4115 INTEGER, INTENT(INOUT) :: DAD_STEPS(NSTEPS), FRERE_STEPS(NSTEPS)
4116 INTEGER, INTENT(INOUT) :: NA(LNA), PAR2_NODES(NB_NIV2), K20, K38
4117 INTEGER :: IB, I, IBFS, IBNB, IFS, INB
4118 INTEGER NBLEAF, NBROOT, ISTEP, IGROUP
4119 INTEGER :: II
4120 IF (K20.GT.0) K20 = blkvar(blkptr(k20))
4121 IF (k38.GT.0) k38 = blkvar(blkptr(k38))
4122 nbleaf = na(1)
4123 nbroot = na(2)
4124 IF (nblk.GT.1) THEN
4125 DO i= 3, 3+nbleaf+nbroot-1
4126 ibnb = na(i)
4127 inb = blkvar(blkptr(ibnb))
4128 na(i) = inb
4129 ENDDO
4130 ENDIF
4131 IF (par2_nodes(1).GT.0) THEN
4132 DO i=1, nb_niv2
4133 ibnb = par2_nodes(i)
4134 inb = blkvar(blkptr(ibnb))
4135 par2_nodes(i) = inb
4136 ENDDO
4137 ENDIF
4138 DO i= 1, nsteps
4139 ibnb = dad_steps(i)
4140 IF (ibnb.EQ.0) THEN
4141 inb = 0
4142 ELSE
4143 inb = blkvar(blkptr(ibnb))
4144 ENDIF
4145 dad_steps(i) = inb
4146 ENDDO
4147 DO i= 1, nsteps
4148 ibnb = frere_steps(i)
4149 IF (ibnb.EQ.0) THEN
4150 inb = 0
4151 ELSE
4152 inb = blkvar(blkptr(abs(ibnb)))
4153 IF (ibnb.LT.0) inb=-inb
4154 ENDIF
4155 frere_steps(i) = inb
4156 ENDDO
4157 DO ib=1, nblk
4158 ibfs = fils_old(ib)
4159 IF (ibfs.EQ.0) THEN
4160 ifs = 0
4161 ELSE
4162 ifs = blkvar(blkptr(abs(ibfs)))
4163 IF (ibfs.LT.0) ifs=-ifs
4164 ENDIF
4165 IF (blkptr(ib+1)-blkptr(ib).EQ.0) cycle
4166 DO ii=blkptr(ib), blkptr(ib+1)-1
4167 IF (ii.LT. blkptr(ib+1)-1) THEN
4168 fils_new(blkvar(ii))= blkvar(ii+1)
4169 ELSE
4170 fils_new(blkvar(ii))= ifs
4171 ENDIF
4172 ENDDO
4173 ENDDO
4174 DO ib=1, nblk
4175 istep = step_old(ib)
4176 IF (blkptr(ib+1)-blkptr(ib).EQ.0) cycle
4177 IF (istep.LT.0) THEN
4178 DO ii=blkptr(ib), blkptr(ib+1)-1
4179 step_new(blkvar(ii)) = istep
4180 ENDDO
4181 ELSE
4182 i = blkvar(blkptr(ib))
4183 step_new(i) = istep
4184 DO ii=blkptr(ib)+1, blkptr(ib+1)-1
4185 step_new(blkvar(ii)) = -istep
4186 ENDDO
4187 ENDIF
4188 ENDDO
4189 DO ib=1, nblk
4190 igroup = lrgroups_old(ib)
4191 IF (blkptr(ib+1)-blkptr(ib).EQ.0) cycle
4192 DO ii=blkptr(ib), blkptr(ib+1)-1
4193 lrgroups_new(blkvar(ii)) = igroup
4194 ENDDO
4195 ENDDO
4196 RETURN
4197 END SUBROUTINE cmumps_expand_tree_steps
4198 SUBROUTINE cmumps_dist_avoid_copies(N,NSLAVES,
4199 & ICNTL,INFOG, NE, NFSIZ,
4200 & FRERE, FILS,
4201 & KEEP,KEEP8,PROCNODE,
4202 & SSARBR,NBSA,PEAK,IERR
4203 & , SIZEOFBLOCKS, LSIZEOFBLOCKS
4204 & )
4205 USE mumps_static_mapping
4206 IMPLICIT NONE
4207 INTEGER N, NSLAVES, NBSA, IERR
4208 INTEGER ICNTL(60),INFOG(80),KEEP(500)
4209 INTEGER(8) KEEP8(150)
4210 INTEGER NE(N),NFSIZ(N),FRERE(N),FILS(N),PROCNODE(N)
4211 INTEGER SSARBR(N)
4212 REAL PEAK
4213 INTEGER, intent(IN) :: LSIZEOFBLOCKS
4214 INTEGER, intent(IN) :: SIZEOFBLOCKS(LSIZEOFBLOCKS)
4215 CALL mumps_distribute(n,nslaves,
4216 & icntl,infog, ne, nfsiz,
4217 & frere, fils,
4218 & keep,keep8,procnode,
4219 & ssarbr,nbsa,dble(peak),ierr
4220 & , sizeofblocks, lsizeofblocks
4221 & )
4222 RETURN
4223 END SUBROUTINE cmumps_dist_avoid_copies
4224 SUBROUTINE cmumps_set_procnode(INODE, PROCNODE, VALUE, FILS, N)
4225 INTEGER, intent(in) :: INODE, N, VALUE
4226 INTEGER, intent(in) :: FILS(N)
4227 INTEGER, intent(inout) :: PROCNODE(N)
4228 INTEGER IN
4229 in=inode
4230 DO WHILE ( in > 0 )
4231 procnode( in ) = VALUE
4232 in=fils( in )
4233 ENDDO
4234 RETURN
4235 END SUBROUTINE cmumps_set_procnode
mumps_abort
#define mumps_abort
Definition VE_Metis.h:25
mumps_ana_h
subroutine mumps_ana_h(totel, compute_perm, n, iwlen, pe, pfree, len, iw, nv, elen, last, ncmpa, degree, head, next, w, parent)
Definition ana_orderings.F:164
mumps_set_ordering
subroutine mumps_set_ordering(n, keep, sym, nprocs, iord, nbqd, avgdens, prok, mp)
Definition ana_set_ordering.F:17
cmumps_ldlt_compress
subroutine cmumps_ldlt_compress(n, nz, irn, icn, piv, ncmp, iw, lw, ipe, len, iq, flag, icmp, iwfr, ierror, keep, keep8, icntl, inplace64_graph_copy)
Definition cana_LDLT_preprocess.F:127
cmumps_set_constraints
subroutine cmumps_set_constraints(n, piv, frere, fils, nfsiz, ikeep, ncst, keep, keep8, rowsca)
Definition cana_LDLT_preprocess.F:18
cmumps_gnew_schur
subroutine cmumps_gnew_schur(na, n, nz, irn, icn, iw, lw, ipe, len, iq, flag, iwfr, nrorm, niorm, iflag, ierror, icntl, symmetry, sym, nbqd, avgdens, keep264, keep265, listvar_schur, size_schur, atoao, aotoa, inplace64_graph_copy)
Definition cana_LDLT_preprocess.F:564
cmumps_expand_permutation
subroutine cmumps_expand_permutation(n, ncmp, n11, n22, piv, invperm, perm)
Definition cana_LDLT_preprocess.F:90
cmumps_expand_tree_steps
subroutine cmumps_expand_tree_steps(icntl, n, nblk, blkptr, blkvar, fils_old, fils_new, nsteps, step_old, step_new, par2_nodes, nb_niv2, dad_steps, frere_steps, na, lna, lrgroups_old, lrgroups_new, k20, k38)
Definition cana_aux.F:4107
cmumps_ana_gnew
subroutine cmumps_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 cana_aux.F:3231
cmumps_ana_k
subroutine cmumps_ana_k(n, ipe, iw, lw, iwfr, ips, ipv, nv, flag, ncmpa, size_schur, parent)
Definition cana_aux.F:1931
cmumps_sort_perm
subroutine cmumps_sort_perm(n, na, lna, ne_steps, perm, fils, dad_steps, step, nsteps, keep60, keep20, keep38, info)
Definition cana_aux.F:4039
cmumps_suppress_duppli_str
subroutine cmumps_suppress_duppli_str(n, nz, ip, irn, flag)
Definition cana_aux.F:4008
cmumps_mtrans_driver
subroutine cmumps_mtrans_driver(job, m, n, ne, ip, irn, a, la, num, perm, liw, iw, ldw, dw, ipq8, icntl, cntl, info, infomumps)
Definition cana_aux.F:3612
cmumps_ana_j
subroutine cmumps_ana_j(n, nz, irn, icn, perm, iw, lw, ipe, iq, flag, iwfr, iflag, ierror, mp)
Definition cana_aux.F:2032
cmumps_set_procnode
subroutine cmumps_set_procnode(inode, procnode, value, fils, n)
Definition cana_aux.F:4225
cmumps_ana_m
subroutine cmumps_ana_m(ne, nd, nsteps, maxfr, maxelim, k50, sizefac_tot, maxnpiv, k5, k6, panel_size, k253)
Definition cana_aux.F:2780
cmumps_dist_avoid_copies
subroutine cmumps_dist_avoid_copies(n, nslaves, icntl, infog, ne, nfsiz, frere, fils, keep, keep8, procnode, ssarbr, nbsa, peak, ierr, sizeofblocks, lsizeofblocks)
Definition cana_aux.F:4205
cmumps_suppress_duppli_val
subroutine cmumps_suppress_duppli_val(n, nz, ip, irn, a, flag, posi)
Definition cana_aux.F:3974
cmumps_ana_lnew
subroutine cmumps_ana_lnew(n, ipe, nv, ips, ne, na, nfsiz, node, nsteps, fils, frere, nd, nemin, subord, keep60, keep20, keep38, namalg, namalgmax, cumul, keep50, icntl13, keep37, keep197, nslaves, allow_amalg_tiny_nodes, blkon, sizeofblocks, lsizeofblocks)
Definition cana_aux.F:2412
cmumps_mtranss
subroutine cmumps_mtranss(m, n, ne, ip, irn, a, iperm, numx, w, len, lenl, lenh, fc, iw, iw4, rlx, rinf)
Definition cana_mtrans.F:570
cmumps_mtransz
subroutine cmumps_mtransz(m, n, irn, lirn, ip, lenc, iperm, num, pr, arp, cv, out)
Definition cana_mtrans.F:1084
cmumps_mtransb
subroutine cmumps_mtransb(m, n, ne, ip, irn, a, iperm, num, jperm, pr, q, l, d, rinf)
Definition cana_mtrans.F:62
cmumps_mtransr
subroutine cmumps_mtransr(n, ne, ip, irn, a)
Definition cana_mtrans.F:485
cmumps_mtransw
subroutine cmumps_mtransw(m, n, ne, ip, irn, a, iperm, num, jperm, l32, out, pr, q, l, u, d, rinf)
Definition cana_mtrans.F:793
the
end diagonal values have been computed in the(sparse) matrix id.SOL
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
for
for(i8=*sizetab-1;i8 >=0;i8--)
Definition mumps_common.c:91
cmumps_ana_aux_m
Definition cana_aux.F:19
cmumps_ana_aux_m::cmumps_ana_f
subroutine cmumps_ana_f(n, nz8, irn, icn, liwalloc, ikeep1, ikeep2, ikeep3, iord, nfsiz, fils, frere, listvar_schur, size_schur, icntl, info, keep, keep8, nslaves, piv, cntl4, colsca, rowsca, norig_arg, sizeofblocks, gcomp_provided_in, gcomp)
Definition cana_aux.F:32
cmumps_ana_aux_m::cmumps_ana_o
subroutine cmumps_ana_o(n, nz, mtrans, perm, ikeepalloc, idirn, idjcn, ida, idrowsca, idcolsca, work2, keep, icntl, info, infog)
Definition cana_aux.F:1273
mumps_ana_blk_m
Definition ana_blk_m.F:14
mumps_ana_ord_wrappers
Definition ana_orderings_wrappers_m.F:19
mumps_static_mapping
Definition mumps_static_mapping.F:14
mumps_static_mapping::mumps_distribute
subroutine, public mumps_distribute(n, slavef, icntl, info, ne, nfsiz, frere, fils, keep, keep8, procnode, ssarbr, nbsa, peak, istat, sizeofblocks, lsizeofblocks)
Definition mumps_static_mapping.F:94
split
void split(mapping_t *, PORD_INT, PORD_INT, PORD_INT, PORD_INT *, PORD_INT *, FLOAT *, PORD_INT)
mumps_ana_blk_m::compact_graph_t
Definition ana_blk_m.F:24
mumps_set_ierror
subroutine mumps_set_ierror(size8, ierror)
Definition tools_common.F:865
mumps_secdeb
subroutine mumps_secdeb(t)
Definition tools_common.F:270