1C 2C This file is part of MUMPS 5.1.2, released 3C on Mon Oct 2 07:37:01 UTC 2017 4C 5C 6C Copyright 1991-2017 CERFACS, CNRS, ENS Lyon, INP Toulouse, Inria, 7C 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 http://www.cecill.info/licences/Licence_CeCILL-C_V1-en.html 12C 13 SUBROUTINE DMUMPS_ANA_F(N, NZ8, IRN, ICN, LIW8, IKEEP, 14 & IORD, NFSIZ, FILS, FRERE, LISTVAR_SCHUR, SIZE_SCHUR, 15 & ICNTL, INFO, KEEP,KEEP8, NSLAVES, PIV, id) 16 USE DMUMPS_STRUC_DEF 17 USE MUMPS_ANA_ORD_WRAPPERS 18 IMPLICIT NONE 19 INTEGER, INTENT(IN) :: N, SIZE_SCHUR, NSLAVES 20 INTEGER(8), INTENT(IN) :: NZ8 21 INTEGER(8), INTENT(IN) :: LIW8 22 INTEGER, INTENT(IN) :: LISTVAR_SCHUR(SIZE_SCHUR) 23 INTEGER, INTENT(IN) :: IRN(NZ8) 24 INTEGER, INTENT(IN) :: ICNTL(40) 25 INTEGER, INTENT(INOUT) :: ICN(NZ8) 26 INTEGER, INTENT(INOUT) :: IORD 27 INTEGER, INTENT(INOUT) :: IKEEP(N,3) 28 INTEGER, INTENT(OUT) :: NFSIZ(N), FILS(N), FRERE(N) 29 INTEGER, INTENT(INOUT) :: INFO(40), KEEP(500) 30 INTEGER(8), INTENT(INOUT) :: KEEP8(150) 31 TYPE (DMUMPS_STRUC) :: id 32 INTEGER, DIMENSION(:), ALLOCATABLE :: IW 33 INTEGER(8), DIMENSION(:), ALLOCATABLE :: IPE 34 INTEGER(8), DIMENSION(:), ALLOCATABLE :: IPQ8 35 INTEGER, DIMENSION(:,:), ALLOCATABLE :: PTRAR 36 INTEGER, DIMENSION(:), ALLOCATABLE :: PARENT 37 INTEGER, DIMENSION(:), ALLOCATABLE :: IWL1 38 INTEGER NBBUCK 39 INTEGER, DIMENSION(:), ALLOCATABLE :: WTEMP 40 INTEGER IERR 41 INTEGER I, K, NCMPA, IN, IFSON 42 INTEGER(8) :: J8, I8 43 INTEGER(8) IWFR8 44 INTEGER NEMIN, LP, MP, LDIAG, ITEMP, symmetry 45 INTEGER NBQD, AvgDens 46 LOGICAL PROK, COMPRESS_SCHUR, LPOK 47#if defined(metis4) || defined(parmetis3) 48 INTEGER NUMFLAG 49#endif 50#if defined(metis) || defined(parmetis) || defined(metis4) || defined(parmetis3) 51 INTEGER METIS_IDX_SIZE 52 INTEGER OPT_METIS_SIZE 53 INTEGER, DIMENSION(:), ALLOCATABLE :: OPTIONS_METIS 54#endif 55#if defined(scotch) || defined(ptscotch) 56 INTEGER :: SCOTCH_INT_SIZE 57#endif 58#if defined(pord) 59 INTEGER :: PORD_INT_SIZE 60#endif 61 DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE :: COLSCA_TEMP 62 INTEGER THRESH, IVersion 63 LOGICAL AGG6 64 INTEGER MINSYM 65 PARAMETER (MINSYM=50) 66 INTEGER(8) :: K79REF 67 PARAMETER(K79REF=12000000_8) 68 INTEGER PIV(N) 69 INTEGER MTRANS, COMPRESS,NCMP,IERROR,J,JPERM,NCST 70 INTEGER TOTEL 71 LOGICAL IDENT,SPLITROOT 72 DOUBLE PRECISION TIMEB 73 EXTERNAL MUMPS_ANA_H, DMUMPS_ANA_J, 74 & DMUMPS_ANA_K, DMUMPS_ANA_GNEW, 75 & DMUMPS_ANA_LNEW, DMUMPS_ANA_M 76#if defined(OLDDFS) 77 EXTERNAL DMUMPS_ANA_L 78#endif 79 EXTERNAL DMUMPS_GNEW_SCHUR 80 EXTERNAL DMUMPS_LDLT_COMPRESS, DMUMPS_EXPAND_PERMUTATION, 81 & DMUMPS_SET_CONSTRAINTS 82 ALLOCATE( IW (LIW8), stat = IERR ) 83 IF ( IERR .GT. 0 ) THEN 84 INFO( 1 ) = -7 85 CALL MUMPS_SET_IERROR(LIW8,INFO(2)) 86 GOTO 90 87 ENDIF 88 ALLOCATE( IWL1 (N), stat = IERR ) 89 IF ( IERR .GT. 0 ) THEN 90 INFO( 1 ) = -7 91 INFO( 2 ) = N 92 GOTO 90 93 ENDIF 94 ALLOCATE( IPE(N+1), stat = IERR ) 95 IF ( IERR .GT. 0 ) THEN 96 INFO( 1 ) = -7 97 INFO( 2 ) = (N+1)*KEEP(10) 98 GOTO 90 99 ENDIF 100 ALLOCATE( PTRAR (N,3), stat = IERR ) 101 IF ( IERR .GT. 0 ) THEN 102 INFO( 1 ) = -7 103 INFO( 2 ) = 3*N 104 GOTO 90 105 ENDIF 106 LP = ICNTL(1) 107 MP = ICNTL(3) 108 LPOK = ((LP.GT.0).AND.(ICNTL(4).GE.1)) 109 PROK = ((MP.GT.0).AND.(ICNTL(4).GE.2)) 110 LDIAG = ICNTL(4) 111 COMPRESS_SCHUR = .FALSE. 112 IF (KEEP(1).LT.0) KEEP(1) = 0 113 NEMIN = KEEP(1) 114 IF (LDIAG.GT.2 .AND. MP.GT.0) THEN 115 WRITE (MP,99999) N, NZ8, LIW8, INFO(1) 116 J8 = min(10_8,NZ8) 117 IF (LDIAG.EQ.4) J8 = NZ8 118 IF (J8.GT.0_8) WRITE (MP,99998) (IRN(I8),ICN(I8),I8=1_8,J8) 119 K = min0(10,N) 120 IF (LDIAG.EQ.4) K = N 121 IF (IORD.EQ.1 .AND. K.GT.0) THEN 122 WRITE (MP,99997) (IKEEP(I,1),I=1,K) 123 ENDIF 124 ENDIF 125 NCMP = N 126 IF (KEEP(60).NE.0) THEN 127 IF ((SIZE_SCHUR.LE.0 ).OR. 128 & (SIZE_SCHUR.GE.N) ) GOTO 90 129 ENDIF 130#if defined(metis) || defined(parmetis) || defined(metis4) || defined(parmetis3) 131 IF ( ( KEEP(60).NE.0).AND.(SIZE_SCHUR.GT.0) 132 & .AND. 133 & ((IORD.EQ.7).OR.(IORD.EQ.5)) 134 & )THEN 135 COMPRESS_SCHUR=.TRUE. 136 NCMP = N-SIZE_SCHUR 137 ALLOCATE(IPQ8(N),stat=IERR) 138 IF ( IERR .GT. 0 ) THEN 139 INFO( 1 ) = -7 140 INFO( 2 ) = N*KEEP(10) 141 ENDIF 142 CALL DMUMPS_GNEW_SCHUR(N,NCMP,NZ8,IRN, ICN, IW(1), LIW8, 143 & IPE, PTRAR(1,2), 144 & IPQ8, IWL1, IWFR8, KEEP8(126), KEEP8(127), 145 & INFO(1), INFO(2), ICNTL, symmetry, 146 & KEEP(50), NBQD, AvgDens, 147 & KEEP(264), KEEP(265), 148 & LISTVAR_SCHUR, SIZE_SCHUR, FRERE, FILS) 149 DEALLOCATE(IPQ8) 150 IORD = 5 151 KEEP(95) = 1 152 NBQD = 0 153 ELSE 154#endif 155 ALLOCATE(IPQ8(N),stat=IERR) 156 IF ( IERR .GT. 0 ) THEN 157 INFO( 1 ) = -7 158 INFO( 2 ) = N*KEEP(10) 159 ENDIF 160 CALL DMUMPS_ANA_GNEW(N,NZ8,IRN, ICN, IW(1), LIW8, 161 & IPE, PTRAR(1,2), 162 & IPQ8, IWL1, IWFR8, KEEP8(126), KEEP8(127), 163 & INFO(1), INFO(2), ICNTL, symmetry, 164 & KEEP(50), NBQD, AvgDens, KEEP(264), KEEP(265)) 165 DEALLOCATE(IPQ8) 166#if defined(metis) || defined(parmetis) || defined(metis4) || defined(parmetis3) 167 ENDIF 168#endif 169 INFO(8) = symmetry 170 IF(NBQD .GT. 0) THEN 171 IF( KEEP(50) .EQ. 2 .AND. ICNTL(12) .LE. 1 ) THEN 172 IF(KEEP(95) .NE. 1) THEN 173 IF ( PROK ) 174 & WRITE( MP,*) 175 & 'Compressed/constrained ordering set OFF' 176 KEEP(95) = 1 177 ENDIF 178 ENDIF 179 ENDIF 180 IF ( (KEEP(60).NE.0) .AND. (IORD.GT.1) .AND. 181 & .NOT. COMPRESS_SCHUR ) THEN 182 IORD = 0 183 ENDIF 184 IF ( (KEEP(50).EQ.2) 185 & .AND. (KEEP(95) .EQ. 3) 186 & .AND. (IORD .EQ. 7) ) THEN 187 IORD = 2 188 ENDIF 189 CALL MUMPS_SET_ORDERING( N, KEEP(50), NSLAVES, IORD, 190 & symmetry, NBQD, AvgDens, 191 & PROK, MP ) 192 IF(KEEP(50) .EQ. 2) THEN 193 IF(KEEP(95) .EQ. 3 .AND. IORD .NE. 2) THEN 194 IF (PROK) WRITE(MP,*) 195 & 'WARNING: DMUMPS_ANA_F constrained ordering not '// 196 & ' available with selected ordering. Move to' // 197 & ' compressed ordering.' 198 KEEP(95) = 2 199 ENDIF 200 IF(KEEP(95) .EQ. 2 .AND. IORD .EQ. 0) THEN 201 IF (PROK) WRITE(MP,*) 202 & 'WARNING: DMUMPS_ANA_F AMD not available with ', 203 & ' compressed ordering -> move to QAMD' 204 IORD = 6 205 ENDIF 206 ELSE 207 KEEP(95) = 1 208 ENDIF 209 MTRANS = KEEP(23) 210 COMPRESS = KEEP(95) - 1 211 IF(COMPRESS .GT. 0 .AND. KEEP(52) .EQ. -2) THEN 212 IF(id%CNTL(4) .GE. 0.0D0) THEN 213 IF (KEEP(1).LE.8) THEN 214 NEMIN = 16 215 ELSE 216 NEMIN = 2*KEEP(1) 217 ENDIF 218 IF (PROK) 219 & WRITE(MP,*) 'Setting static pivoting ON, COMPRESS =', 220 & COMPRESS 221 ENDIF 222 ENDIF 223 IF(MTRANS .GT. 0 .AND. KEEP(50) .EQ. 2) THEN 224 KEEP(23) = 0 225 ENDIF 226 IF(COMPRESS .EQ. 2) THEN 227 IF (IORD.NE.2) THEN 228 WRITE(*,*) "IORD not compatible with COMPRESS:", 229 & IORD, COMPRESS 230 CALL MUMPS_ABORT() 231 ENDIF 232 CALL DMUMPS_SET_CONSTRAINTS( 233 & N,PIV,FRERE,FILS,NFSIZ,IKEEP, 234 & NCST,KEEP,KEEP8,id) 235 ENDIF 236 IF ( IORD .NE. 1 ) THEN 237 IF(COMPRESS .GE. 1) THEN 238 ALLOCATE(IPQ8(N),stat=IERR) 239 IF ( IERR .GT. 0 ) THEN 240 INFO( 1 ) = -7 241 INFO( 2 ) = N*KEEP(10) 242 ENDIF 243 CALL DMUMPS_LDLT_COMPRESS( 244 & N, NZ8, IRN, ICN, PIV, 245 & NCMP, IW(1), LIW8, IPE, PTRAR(1,2), IPQ8, 246 & IWL1, FILS, IWFR8, 247 & IERROR, KEEP, KEEP8, ICNTL) 248 DEALLOCATE(IPQ8) 249 symmetry = 100 250 ENDIF 251 IF ( (symmetry.LT.MINSYM).AND.(KEEP(50).EQ.0) ) THEN 252 IF(KEEP(23) .EQ. 7 ) THEN 253 KEEP(23) = -5 254 GOTO 90 255 ELSE IF(KEEP(23) .EQ. -9876543) THEN 256 IDENT = .TRUE. 257 KEEP(23) = 5 258 IF (PROK) WRITE(MP,'(A)') 259 & ' ... Apply column permutation (already computed)' 260 DO J=1,N 261 JPERM = PIV(J) 262 FILS(JPERM) = J 263 IF (JPERM.NE.J) IDENT = .FALSE. 264 ENDDO 265 IF (.NOT.IDENT) THEN 266 DO J8=1_8,NZ8 267 J = ICN(J8) 268 IF ((J.LE.0).OR.(J.GT.N)) CYCLE 269 ICN(J8) = FILS(J) 270 ENDDO 271 ALLOCATE(COLSCA_TEMP(N), stat=IERR) 272 IF ( IERR > 0 ) THEN 273 INFO( 1 ) = -7 274 INFO( 2 ) = N 275 GOTO 90 276 ENDIF 277 DO J = 1, N 278 COLSCA_TEMP(J)=id%COLSCA(J) 279 ENDDO 280 DO J=1, N 281 id%COLSCA(FILS(J))=COLSCA_TEMP(J) 282 ENDDO 283 DEALLOCATE(COLSCA_TEMP) 284 IF (PROK) 285 & WRITE(MP,'(/A)') 286 & ' WARNING input matrix data modified' 287 ALLOCATE(IPQ8(N),stat=IERR) 288 IF ( IERR .GT. 0 ) THEN 289 INFO( 1 ) = -7 290 INFO( 2 ) = N*KEEP(10) 291 ENDIF 292 CALL DMUMPS_ANA_GNEW 293 & (N,NZ8,IRN, ICN, IW(1), LIW8, IPE, PTRAR(1,2), 294 & IPQ8, IWL1, IWFR8, KEEP8(126), KEEP8(127), 295 & INFO(1), INFO(2), ICNTL, symmetry, KEEP(50), 296 & NBQD, AvgDens, KEEP(264), KEEP(265)) 297 DEALLOCATE(IPQ8) 298 INFO(8) = symmetry 299 NCMP = N 300 ELSE 301 KEEP(23) = 0 302 ENDIF 303 ENDIF 304 ELSE IF (KEEP(23) .EQ. 7 .OR. KEEP(23) .EQ. -9876543 ) THEN 305 IF (PROK) WRITE(MP,'(A)') 306 & ' ... No column permutation' 307 KEEP(23) = 0 308 ENDIF 309 ENDIF 310 ALLOCATE( PARENT ( N ), stat = IERR ) 311 IF ( IERR .GT. 0 ) THEN 312 INFO( 1 ) = -7 313 INFO( 2 ) = N 314 GOTO 90 315 ENDIF 316 IF (IORD.NE.1 .AND. IORD.NE.5) THEN 317 IF (PROK) THEN 318 IF (IORD.EQ.2) THEN 319 WRITE(MP,'(A)') ' Ordering based on AMF ' 320#if defined(scotch) || defined(ptscotch) 321 ELSE IF (IORD.EQ.3) THEN 322 WRITE(MP,'(A)') ' Ordering based on SCOTCH ' 323#endif 324#if defined(pord) 325 ELSE IF (IORD.EQ.4) THEN 326 WRITE(MP,'(A)') ' Ordering based on PORD ' 327#endif 328 ELSE IF (IORD.EQ.6) THEN 329 WRITE(MP,'(A)') ' Ordering based on QAMD ' 330 ELSE 331 WRITE(MP,'(A)') ' Ordering based on AMD ' 332 ENDIF 333 ENDIF 334 IF ( PROK ) THEN 335 CALL MUMPS_SECDEB( TIMEB ) 336 ENDIF 337 IF ( KEEP(60) .NE. 0 ) THEN 338 CALL MUMPS_HAMD(N, LIW8, IPE, IWFR8, PTRAR(1,2), IW(1), 339 & IWL1, IKEEP, 340 & IKEEP(1,2), NCMPA, FILS, IKEEP(1,3), PTRAR, PTRAR(1,3), 341 & PARENT, 342 & LISTVAR_SCHUR, SIZE_SCHUR) 343 IF (KEEP(60)==1) THEN 344 KEEP(20) = LISTVAR_SCHUR(1) 345 ELSE 346 KEEP(38) = LISTVAR_SCHUR(1) 347 ENDIF 348 ELSE 349 IF ( .FALSE. ) THEN 350#if defined(pord) 351 ELSEIF (IORD .EQ. 4) THEN 352 CALL MUMPS_PORD_INTSIZE(PORD_INT_SIZE) 353 IF(COMPRESS .EQ. 1) THEN 354 DO I=1,KEEP(93)/2 355 IWL1(I) = 2 356 ENDDO 357 DO I=1+KEEP(93)/2,NCMP 358 IWL1(I) = 1 359 ENDDO 360 IF (PORD_INT_SIZE .EQ. 64) THEN 361 CALL MUMPS_PORDF_WND_MIXEDto64(NCMP, IWFR8-1_8, 362 & IPE, IW, 363 & IWL1, NCMPA, N, PARENT, 364 & INFO(1), LP, LPOK, KEEP(10)) 365 ELSE IF (PORD_INT_SIZE .EQ. 32) THEN 366 CALL MUMPS_PORDF_WND_MIXEDto32(NCMP, IWFR8-1_8, 367 & IPE, IW, 368 & IWL1, NCMPA, N, PARENT, 369 & INFO(1), LP, LPOK, KEEP(10)) 370 ELSE 371 WRITE(*,*) 372 & "Internal error in PORD wrappers, PORD_INT_SIZE=", 373 & PORD_INT_SIZE 374 CALL MUMPS_ABORT() 375 ENDIF 376 IF ( NCMPA .NE. 0 ) THEN 377 write(6,*) ' Out PORD, NCMPA=', NCMPA 378 INFO( 1 ) = -9999 379 INFO( 2 ) = 4 380 GOTO 90 381 ENDIF 382 IF (INFO(1) .LT.0) GOTO 90 383 CALL DMUMPS_GET_ELIM_TREE(NCMP,PARENT,IWL1,FILS) 384 CALL DMUMPS_GET_PERM_FROM_PE(NCMP,PARENT,IKEEP(1,1), 385 & FRERE,PTRAR(1,1)) 386 DO I=1,NCMP 387 IKEEP(IKEEP(I,1),2)=I 388 ENDDO 389 ELSE 390 IF (PORD_INT_SIZE.EQ.64) THEN 391 CALL MUMPS_PORDF_MIXEDto64(NCMP, IWFR8-1_8, IPE, 392 & IW(1), 393 & IWL1, NCMPA, PARENT, 394 & INFO(1), LP, LPOK, KEEP(10)) 395 ELSE IF (PORD_INT_SIZE.EQ.32) THEN 396 CALL MUMPS_PORDF_MIXEDto32(NCMP, IWFR8-1_8, IPE, 397 & IW(1), 398 & IWL1, NCMPA, PARENT, 399 & INFO(1), LP, LPOK, KEEP(10)) 400 ELSE 401 WRITE(*,*) 402 & "Internal error in PORD wrappers, PORD_INT_SIZE=", 403 & PORD_INT_SIZE 404 CALL MUMPS_ABORT() 405 ENDIF 406 ENDIF 407 IF ( NCMPA .NE. 0 ) THEN 408 write(6,*) ' Out PORD, NCMPA=', NCMPA 409 INFO( 1 ) = -9999 410 INFO( 2 ) = 4 411 GOTO 90 412 ENDIF 413 IF (INFO(1) .LT. 0) GOTO 90 414#endif 415#if defined(scotch) || defined(ptscotch) 416 ELSEIF (IORD .EQ. 3) THEN 417 CALL MUMPS_SCOTCH_INTSIZE(SCOTCH_INT_SIZE) 418 IF (SCOTCH_INT_SIZE.EQ.32) THEN 419 IF (KEEP(10).EQ.1) THEN 420 INFO(1) = -52 421 INFO(2) = 2 422 ELSE 423 CALL MUMPS_SCOTCH_MIXEDto32(NCMP, 424 & IWFR8-1_8, IPE, 425 & PARENT, IWFR8, 426 & PTRAR(1,2), IW(1), IWL1, IKEEP, 427 & IKEEP(1,2), NCMPA, INFO, LP, LPOK) 428 ENDIF 429 ELSE IF (SCOTCH_INT_SIZE.EQ.64) THEN 430 CALL MUMPS_SCOTCH_MIXEDto64(NCMP, 431 & IWFR8-1_8, IPE, 432 & PARENT, IWFR8, 433 & PTRAR(1,2), IW(1), IWL1, IKEEP, 434 & IKEEP(1,2), NCMPA, INFO, LP, LPOK, KEEP(10)) 435 ELSE 436 WRITE(*,*) 437 & "Internal error in SCOTCH wrappers, SCOTCH_INT_SIZE=", 438 & SCOTCH_INT_SIZE 439 CALL MUMPS_ABORT() 440 ENDIF 441 IF (INFO(1) .LT. 0) GOTO 90 442 IF (COMPRESS .EQ. 1) THEN 443 CALL DMUMPS_GET_ELIM_TREE(NCMP,PARENT,IWL1,FILS) 444 CALL DMUMPS_GET_PERM_FROM_PE(NCMP,PARENT,IKEEP(1,1), 445 & FRERE,PTRAR(1,1)) 446 DO I=1,NCMP 447 IKEEP(IKEEP(I,1),2)=I 448 ENDDO 449 ENDIF 450#endif 451 ELSEIF (IORD .EQ. 2) THEN 452 NBBUCK = 2*N 453 ALLOCATE( WTEMP ( 0: NBBUCK + 1), stat = IERR ) 454 IF ( IERR .GT. 0 ) THEN 455 INFO( 1 ) = -7 456 INFO( 2 ) = NBBUCK+2 457 GOTO 90 458 ENDIF 459 IF(COMPRESS .GE. 1) THEN 460 DO I=1,KEEP(93)/2 461 IWL1(I) = 2 462 ENDDO 463 DO I=1+KEEP(93)/2,NCMP 464 IWL1(I) = 1 465 ENDDO 466 ELSE 467 IWL1(1) = -1 468 ENDIF 469 IF(COMPRESS .LE. 1) THEN 470 CALL MUMPS_HAMF4(NCMP, NBBUCK, LIW8, IPE, 471 & IWFR8, PTRAR(1,2), 472 & IW(1), IWL1, IKEEP, IKEEP(1,2), NCMPA, FILS, 473 & IKEEP(1,3), PTRAR, PTRAR(1,3), WTEMP, PARENT) 474 ELSE 475 IF(PROK) WRITE(MP,'(A)') 476 & ' Constrained Ordering based on AMF' 477 CALL MUMPS_CST_AMF(NCMP, NBBUCK, LIW8, IPE, 478 & IWFR8, PTRAR(1,2), 479 & IW(1), IWL1, IKEEP, IKEEP(1,2), NCMPA, FILS, 480 & IKEEP(1,3), PTRAR, PTRAR(1,3), WTEMP, 481 & NFSIZ, FRERE, PARENT) 482 ENDIF 483 DEALLOCATE(WTEMP) 484 ELSEIF (IORD .EQ. 6) THEN 485 ALLOCATE( WTEMP ( N ), stat = IERR ) 486 IF ( IERR .GT. 0 ) THEN 487 INFO( 1 ) = -7 488 INFO( 2 ) = N 489 GOTO 90 490 ENDIF 491 THRESH = 1 492 IVersion = 2 493 IF(COMPRESS .EQ. 1) THEN 494 DO I=1,KEEP(93)/2 495 IWL1(I) = 2 496 ENDDO 497 DO I=1+KEEP(93)/2,NCMP 498 IWL1(I) = 1 499 ENDDO 500 TOTEL = KEEP(93)+KEEP(94) 501 ELSE 502 IWL1(1) = -1 503 TOTEL = N 504 ENDIF 505 CALL MUMPS_QAMD(TOTEL,IVersion, THRESH, WTEMP, 506 & NCMP, LIW8, IPE, IWFR8, PTRAR(1,2), IW(1), 507 & IWL1, IKEEP, IKEEP(1,2), NCMPA, FILS, 508 & IKEEP(1,3), PTRAR, PTRAR(1,3), PARENT) 509 DEALLOCATE(WTEMP) 510 ELSE 511 CALL MUMPS_ANA_H(NCMP, LIW8, IPE, IWFR8, PTRAR(1,2), 512 & IW(1), IWL1, IKEEP, IKEEP(1,2), NCMPA, FILS, 513 & IKEEP(1,3), PTRAR, PTRAR(1,3), PARENT) 514 ENDIF 515 ENDIF 516 IF(COMPRESS .GE. 1) THEN 517 CALL DMUMPS_EXPAND_PERMUTATION(N,NCMP,KEEP(94),KEEP(93), 518 & PIV,IKEEP(1,1),IKEEP(1,2)) 519 COMPRESS = -1 520 ENDIF 521 IF ( PROK ) THEN 522 CALL MUMPS_SECFIN( TIMEB ) 523#if defined(scotch) || defined(ptscotch) 524 IF (IORD.EQ.3) THEN 525 WRITE( MP, '(A,F12.4)' ) 526 & ' ELAPSED TIME SPENT IN SCOTCH reordering =', TIMEB 527 ENDIF 528#endif 529 ENDIF 530 ENDIF 531#if defined(metis) || defined(parmetis) || defined(metis4) || defined(parmetis3) 532 IF (IORD.EQ.5) THEN 533 IF (PROK) THEN 534 WRITE(MP,'(A)') ' Ordering based on METIS' 535 ENDIF 536 IF ( PROK ) THEN 537 CALL MUMPS_SECDEB( TIMEB ) 538 ENDIF 539 CALL MUMPS_METIS_IDXSIZE(METIS_IDX_SIZE) 540 IF (KEEP(10).EQ.1.AND.METIS_IDX_SIZE.NE.64) THEN 541 INFO(1) = -52 542 INFO(2) = 1 543 GOTO 90 544 ENDIF 545#if defined(metis4) || defined(parmetis3) 546 NUMFLAG = 1 547 OPT_METIS_SIZE = 8 548 ALLOCATE( OPTIONS_METIS (OPT_METIS_SIZE ), stat = IERR ) 549 IF ( IERR .GT. 0 ) THEN 550 INFO( 1 ) = -7 551 INFO( 2 ) = OPT_METIS_SIZE 552 GOTO 90 553 ENDIF 554 OPTIONS_METIS(1) = 0 555#else 556 OPT_METIS_SIZE = 40 557 OPT_METIS_SIZE = OPT_METIS_SIZE + 60 558 ALLOCATE( OPTIONS_METIS (OPT_METIS_SIZE ), stat = IERR ) 559 IF ( IERR .GT. 0 ) THEN 560 INFO( 1 ) = -7 561 INFO( 2 ) = OPT_METIS_SIZE 562 GOTO 90 563 ENDIF 564 CALL METIS_SETDEFAULTOPTIONS(OPTIONS_METIS) 565 OPTIONS_METIS(18) = 1 566#endif 567 IF (COMPRESS .EQ. 1) THEN 568 DO I=1,KEEP(93)/2 569 FRERE(I) = 2 570 ENDDO 571 DO I=KEEP(93)/2+1,NCMP 572 FRERE(I) = 1 573 ENDDO 574#if defined(metis4) || defined(parmetis3) 575 IF (METIS_IDX_SIZE .EQ.32) THEN 576 CALL MUMPS_METIS_NODEWND_MIXEDto32( 577 & NCMP, IPE, IW(1),FRERE(1), 578 & NUMFLAG, OPTIONS_METIS, OPT_METIS_SIZE, 579 & IKEEP(1,2), IKEEP(1,1), INFO(1), LP, LPOK ) 580 ELSE IF (METIS_IDX_SIZE .EQ.64) THEN 581 CALL MUMPS_METIS_NODEWND_MIXEDto64( 582 & NCMP, IPE, IW(1),FRERE(1), 583 & NUMFLAG, OPTIONS_METIS, OPT_METIS_SIZE, 584 & IKEEP(1,2), IKEEP(1,1), INFO(1), LP, LPOK, KEEP(10) ) 585 ELSE 586 WRITE(*,*) 587 & "Internal error in METIS wrappers, METIS_IDX_SIZE=", 588 & METIS_IDX_SIZE 589 CALL MUMPS_ABORT() 590 ENDIF 591 ELSE 592 IF (METIS_IDX_SIZE .EQ.32) THEN 593 CALL MUMPS_METIS_NODEND_MIXEDto32( 594 & NCMP, IPE, IW(1), NUMFLAG, 595 & OPTIONS_METIS, OPT_METIS_SIZE, 596 & IKEEP(1,2), IKEEP(1,1), INFO(1), LP, LPOK ) 597 ELSE IF (METIS_IDX_SIZE .EQ.64) THEN 598 CALL MUMPS_METIS_NODEND_MIXEDto64( 599 & NCMP, IPE, IW(1), NUMFLAG, 600 & OPTIONS_METIS, OPT_METIS_SIZE, 601 & IKEEP(1,2), IKEEP(1,1), INFO(1), LP,LPOK,KEEP(10)) 602 ELSE 603 WRITE(*,*) 604 & "Internal error in METIS wrappers, METIS_IDX_SIZE=", 605 & METIS_IDX_SIZE 606 CALL MUMPS_ABORT() 607 ENDIF 608 ENDIF 609#else 610 ELSE 611 DO I=1,NCMP 612 FRERE(I) = 1 613 ENDDO 614 ENDIF 615 IF (METIS_IDX_SIZE .EQ. 32) THEN 616 CALL MUMPS_METIS_NODEND_MIXEDto32( 617 & NCMP, IPE, IW(1),FRERE(1), 618 & OPTIONS_METIS, OPT_METIS_SIZE, 619 & IKEEP(1,2), IKEEP(1,1), INFO(1), LP, LPOK ) 620 ELSE IF (METIS_IDX_SIZE .EQ. 64) THEN 621 CALL MUMPS_METIS_NODEND_MIXEDto64( 622 & NCMP, IPE, IW(1),FRERE(1), 623 & OPTIONS_METIS, OPT_METIS_SIZE, 624 & IKEEP(1,2), IKEEP(1,1), INFO(1), LP,LPOK,KEEP(10) ) 625 ELSE 626 IF (LPOK) WRITE(LP,*) 627 & "Internal error in METIS wrappers, METIS_IDX_SIZE=", 628 & METIS_IDX_SIZE 629 CALL MUMPS_ABORT() 630 ENDIF 631#endif 632 IF (INFO(1) .LT.0) GOTO 90 633 IF ( PROK ) THEN 634 CALL MUMPS_SECFIN( TIMEB ) 635 WRITE( MP, '(A,F12.4)' ) 636 & ' ELAPSED TIME SPENT IN METIS reordering =', TIMEB 637 ENDIF 638 DEALLOCATE (OPTIONS_METIS) 639 IF ( COMPRESS_SCHUR ) THEN 640 CALL DMUMPS_EXPAND_PERM_SCHUR( 641 & N, NCMP, IKEEP(1,1),IKEEP(1,2), 642 & LISTVAR_SCHUR, SIZE_SCHUR, FILS) 643 COMPRESS = -1 644 ENDIF 645 IF (COMPRESS .EQ. 1) THEN 646 CALL DMUMPS_EXPAND_PERMUTATION(N,NCMP,KEEP(94), 647 & KEEP(93),PIV,IKEEP(1,1),IKEEP(1,2)) 648 COMPRESS = -1 649 ENDIF 650 ENDIF 651#endif 652 IF (PROK) THEN 653 IF (IORD.EQ.1) THEN 654 WRITE(MP,'(A)') ' Ordering given is used' 655 ENDIF 656 ENDIF 657 IF ((IORD.EQ.1) 658 & ) THEN 659 DO K=1,N 660 PTRAR(K,1) = 0 661 ENDDO 662 DO K=1,N 663 IF ((IKEEP(K,1).LE.0).OR.(IKEEP(K,1).GT.N)) 664 & GO TO 40 665 IF (PTRAR(IKEEP(K,1),1).EQ.1) THEN 666 GOTO 40 667 ELSE 668 PTRAR(IKEEP(K,1),1) = 1 669 ENDIF 670 ENDDO 671 ENDIF 672 IF (IORD.EQ.1 .OR. IORD.EQ.5 .OR. COMPRESS.EQ.-1) THEN 673 IF ((KEEP(106)==1).OR.(KEEP(60).NE.0)) THEN 674 IF ( COMPRESS .EQ. -1 ) THEN 675 ALLOCATE(IPQ8(N),stat=IERR) 676 IF ( IERR .GT. 0 ) THEN 677 INFO( 1 ) = -7 678 INFO( 2 ) = N*KEEP(10) 679 ENDIF 680 CALL DMUMPS_ANA_GNEW(N,NZ8,IRN, ICN, IW(1), LIW8, 681 & IPE, PTRAR(1,2), 682 & IPQ8, IWL1, IWFR8, KEEP8(126), KEEP8(127), 683 & INFO(1), INFO(2), ICNTL, symmetry, KEEP(50), 684 & NBQD, AvgDens, KEEP(264),KEEP(265)) 685 DEALLOCATE(IPQ8) 686 INFO(8) = symmetry 687 ENDIF 688 COMPRESS = 0 689 ALLOCATE( WTEMP ( 2*N ), stat = IERR ) 690 IF ( IERR .GT. 0 ) THEN 691 INFO( 1 ) = -7 692 INFO( 2 ) = 2*N 693 GOTO 90 694 ENDIF 695 THRESH = -1 696 IF (KEEP(60) == 0) THEN 697 ITEMP = 0 698 ELSE 699 ITEMP = SIZE_SCHUR 700 IF (KEEP(60)==1) THEN 701 KEEP(20) = LISTVAR_SCHUR(1) 702 ELSE 703 KEEP(38) = LISTVAR_SCHUR(1) 704 ENDIF 705 ENDIF 706 AGG6 =.FALSE. 707 CALL MUMPS_SYMQAMD(THRESH, WTEMP, 708 & N, LIW8, IPE, IWFR8, PTRAR(1,2), IW, 709 & IWL1, WTEMP(N+1), 710 & IKEEP(1,2), NCMPA, FILS, IKEEP(1,3), PTRAR, 711 & PTRAR(1,3),IKEEP(1,1), LISTVAR_SCHUR, ITEMP, 712 & AGG6, PARENT) 713 DEALLOCATE(WTEMP) 714 ELSE 715 CALL DMUMPS_ANA_J(N, NZ8, IRN, ICN, IKEEP, IW(1), 716 & LIW8, IPE, 717 & PTRAR(1,2), IWL1, IWFR8, 718 & INFO(1),INFO(2), MP) 719 IF (KEEP(60) .EQ. 0) THEN 720 ITEMP = 0 721 ELSE 722 ITEMP = SIZE_SCHUR 723 ENDIF 724 CALL DMUMPS_ANA_K(N, IPE, IW, LIW8, IWFR8, IKEEP, 725 & IKEEP(1,2), IWL1, 726 & PTRAR, NCMPA, ITEMP, PARENT) 727 IF (KEEP(60) .EQ. 0) THEN 728 IF (KEEP(60) .EQ. 1) THEN 729 KEEP(20) = LISTVAR_SCHUR(1) 730 ELSE 731 KEEP(38) = LISTVAR_SCHUR(1) 732 ENDIF 733 ENDIF 734 ENDIF 735 ENDIF 736#if defined(OLDDFS) 737 CALL DMUMPS_ANA_L 738 & (N, PARENT, IWL1, IKEEP(1,1), IKEEP(1,2), IKEEP(1,3), 739 & NFSIZ, INFO(6), FILS, FRERE, PTRAR(1,3), NEMIN, KEEP(60)) 740#else 741 IF (allocated(IPE)) DEALLOCATE(IPE) 742 ALLOCATE(WTEMP(N), stat=IERR) 743 IF ( IERR .GT. 0 ) THEN 744 INFO( 1 ) = -7 745 INFO( 2 ) = N 746 GOTO 90 747 ENDIF 748 CALL DMUMPS_ANA_LNEW 749 & (N, PARENT, IWL1, IKEEP(1,1), IKEEP(1,2), IKEEP(1,3), 750 & NFSIZ, PTRAR, INFO(6), FILS, FRERE, 751 & PTRAR(1,3), NEMIN, WTEMP, KEEP(60), 752 & KEEP(20),KEEP(38),PTRAR(1,2),KEEP(104),IW(1),KEEP(50), 753 & ICNTL(13), KEEP(37), NSLAVES, KEEP(250).EQ.1) 754 DEALLOCATE(WTEMP) 755#endif 756 IF (KEEP(60).NE.0) THEN 757 IF (KEEP(60)==1) THEN 758 IN = KEEP(20) 759 ELSE 760 IN = KEEP(38) 761 ENDIF 762 DO WHILE (IN.GT.0) 763 IN = FILS (IN) 764 END DO 765 IFSON = -IN 766 IF (KEEP(60)==1) THEN 767 IN = KEEP(20) 768 ELSE 769 IN = KEEP(38) 770 ENDIF 771 DO I=2,SIZE_SCHUR 772 FILS(IN) = LISTVAR_SCHUR (I) 773 IN = FILS(IN) 774 FRERE (IN) = N+1 775 ENDDO 776 FILS(IN) = -IFSON 777 ENDIF 778 CALL DMUMPS_ANA_M(IKEEP(1,2), 779 & PTRAR(1,3), INFO(6), 780 & INFO(5), KEEP(2), KEEP(50), 781 & KEEP(101),KEEP(108),KEEP(5), 782 & KEEP(6), KEEP(226), KEEP(253)) 783 IF ( KEEP(53) .NE. 0 ) THEN 784 CALL MUMPS_MAKE1ROOT( N, FRERE, FILS, NFSIZ, KEEP(20) ) 785 END IF 786 IF ( (KEEP(48) == 4 .AND. KEEP8(21).GT.0_8) 787 & .OR. 788 & (KEEP (48)==5 .AND. KEEP8(21) .GT. 0_8 ) 789 & .OR. 790 & (KEEP(24).NE.0.AND.KEEP8(21).GT.0_8) ) THEN 791 CALL DMUMPS_SET_K821_SURFACE(KEEP8(21), KEEP(2), 792 & KEEP(48), KEEP(50), NSLAVES) 793 END IF 794 IF (KEEP(210).LT.0.OR.KEEP(210).GT.2) KEEP(210)=0 795 IF (KEEP(210).EQ.0.AND.KEEP(201).GT.0) KEEP(210)=1 796 IF (KEEP(210).EQ.0.AND.KEEP(201).EQ.0) KEEP(210)=2 797 IF (KEEP(210).EQ.2) KEEP8(79)=huge(KEEP8(79)) 798 IF (KEEP(210).EQ.1.AND.KEEP8(79).LE.0_8) THEN 799 KEEP8(79)=K79REF * int(NSLAVES,8) 800 ENDIF 801 IF ( (KEEP(79).EQ.0).OR.(KEEP(79).EQ.2).OR. 802 & (KEEP(79).EQ.3).OR.(KEEP(79).EQ.5).OR. 803 & (KEEP(79).EQ.6) 804 & ) THEN 805 IF (KEEP(210).EQ.1) THEN 806 SPLITROOT = .FALSE. 807 IF ( KEEP(62).GE.1) THEN 808 CALL DMUMPS_CUTNODES(N, FRERE, FILS, NFSIZ,INFO(6), 809 & NSLAVES, KEEP,KEEP8, SPLITROOT, 810 & MP, LDIAG, INFO(1), INFO(2)) 811 IF (INFO(1).LT.0) GOTO 90 812 IF (PROK) THEN 813 WRITE(MP,*) " Number of split nodes in pre-splitting=", 814 & KEEP(61) 815 ENDIF 816 ENDIF 817 ENDIF 818 ENDIF 819 SPLITROOT = ((ICNTL(13).GT.0 .AND. NSLAVES.GT.ICNTL(13)) .OR. 820 & ICNTL(13).EQ.-1 ) 821 IF (KEEP(53) .NE. 0) THEN 822 SPLITROOT = .TRUE. 823 ENDIF 824 SPLITROOT = (SPLITROOT.AND.( (KEEP(60).EQ.0) )) 825 IF (SPLITROOT) THEN 826 CALL DMUMPS_CUTNODES(N, FRERE, FILS, NFSIZ,INFO(6), 827 & NSLAVES, KEEP,KEEP8, SPLITROOT, 828 & MP, LDIAG, INFO(1), INFO(2)) 829 IF (INFO(1).LT.0) GOTO 90 830 IF ( KEEP(53) .NE. 0 ) THEN 831 CALL MUMPS_MAKE1ROOT( N, FRERE, FILS, NFSIZ, KEEP(20) ) 832 ENDIF 833 ENDIF 834 IF (LDIAG.GT.2 .AND. MP.GT.0) THEN 835 K = min0(10,N) 836 IF (LDIAG.EQ.4) K = N 837 IF (K.GT.0) WRITE (MP,99987) (NFSIZ(I),I=1,K) 838 IF (K.GT.0) WRITE (MP,99989) (FILS(I),I=1,K) 839 IF (K.GT.0) WRITE (MP,99988) (FRERE(I),I=1,K) 840 ENDIF 841 GO TO 90 842 40 INFO(1) = -4 843 INFO(2) = K 844 GOTO 90 845 90 CONTINUE 846 IF (INFO(1) .NE. 0) THEN 847 IF ((LP.GT.0).AND.(ICNTL(4).GE.1)) 848 & WRITE (LP,99996) INFO(1), INFO(2) 849 ENDIF 850 IF (allocated(IW)) DEALLOCATE(IW) 851 IF (allocated(IWL1)) DEALLOCATE(IWL1) 852 IF (allocated(IPE)) DEALLOCATE(IPE) 853 IF (allocated(PTRAR)) DEALLOCATE(PTRAR) 854 IF (allocated(PARENT)) DEALLOCATE(PARENT) 855 RETURN 85699999 FORMAT (/'Entering analysis phase with ...'/ 857 & ' N NNZ LIW INFO(1)'/, 858 & 9X, I8, I11, I12, I14) 85999998 FORMAT ('Matrix entries: IRN() ICN()'/ 860 & (I12, I7, I12, I7, I12, I7)) 86199997 FORMAT ('IKEEP(.,1)=', 10I6/(12X, 10I6)) 86299996 FORMAT (/'** Error return ** from Analysis * INFO(1:2)= ', 863 & (I3, I16)) 86499989 FORMAT ('FILS (.) =', 10I6/(12X, 10I6)) 86599988 FORMAT ('FRERE(.) =', 10I6/(12X, 10I6)) 86699987 FORMAT ('NFSIZ(.) =', 10I6/(12X, 10I6)) 867 END SUBROUTINE DMUMPS_ANA_F 868 SUBROUTINE DMUMPS_ANA_K(N,IPE, IW, LW, IWFR, IPS, IPV, 869 & NV, FLAG, 870 & NCMPA, SIZE_SCHUR, PARENT) 871 IMPLICIT NONE 872 INTEGER, INTENT(IN) :: N, SIZE_SCHUR 873 INTEGER, INTENT(IN) :: IPS(N) 874 INTEGER(8), INTENT(IN) :: LW 875 INTEGER, INTENT(OUT) :: NCMPA 876 INTEGER, INTENT(OUT) :: IPV(N), NV(N), PARENT(N) 877 INTEGER(8), INTENT(INOUT) :: IWFR 878 INTEGER(8), INTENT(INOUT) :: IPE(N) 879 INTEGER, INTENT(INOUT) :: IW(LW) 880 INTEGER, INTENT(OUT) :: FLAG(N) 881 INTEGER I,J,ML,MS,ME,MINJS,IE,KDUMMY 882 INTEGER LN,JS,JE 883 INTEGER(8) :: JP, JP1, JP2, LWFR, IP 884 DO 10 I=1,N 885 FLAG(I) = 0 886 NV(I) = 0 887 J = IPS(I) 888 IPV(J) = I 889 10 CONTINUE 890 NCMPA = 0 891 DO 100 ML=1,N-SIZE_SCHUR 892 MS = IPV(ML) 893 ME = MS 894 FLAG(MS) = ME 895 IP = IWFR 896 MINJS = N 897 IE = ME 898 DO 70 KDUMMY=1,N 899 JP = IPE(IE) 900 LN = 0 901 IF (JP.LE.0_8) GO TO 60 902 LN = IW(JP) 903 DO 50 JP1=1_8,int(LN,8) 904 JP = JP + 1_8 905 JS = IW(JP) 906 IF (FLAG(JS).EQ.ME) GO TO 50 907 FLAG(JS) = ME 908 IF (IWFR.LT.LW) GO TO 40 909 IPE(IE) = JP 910 IW(JP) = LN - int(JP1) 911 CALL DMUMPS_ANA_D(N, IPE, IW, IP-1_8, LWFR, NCMPA) 912 JP2 = IWFR - 1 913 IWFR = LWFR 914 IF (IP.GT.JP2) GO TO 30 915 DO 20 JP=IP,JP2 916 IW(IWFR) = IW(JP) 917 IWFR = IWFR + 1_8 918 20 CONTINUE 919 30 IP = LWFR 920 JP = IPE(IE) 921 40 IW(IWFR) = JS 922 MINJS = min0(MINJS,IPS(JS)+0) 923 IWFR = IWFR + 1_8 924 50 CONTINUE 925 60 IPE(IE) = int(-ME,8) 926 JE = NV(IE) 927 NV(IE) = LN + 1 928 IE = JE 929 IF (IE.EQ.0) GO TO 80 930 70 CONTINUE 931 80 IF (IWFR.GT.IP) GO TO 90 932 IPE(ME) = 0_8 933 NV(ME) = 1 934 GO TO 100 935 90 MINJS = IPV(MINJS) 936 NV(ME) = NV(MINJS) 937 NV(MINJS) = ME 938 IW(IWFR) = IW(IP) 939 IW(IP) = int(IWFR - IP) 940 IPE(ME) = IP 941 IWFR = IWFR + 1_8 942 100 CONTINUE 943 IF (SIZE_SCHUR == 0) GOTO 500 944 DO ML = N-SIZE_SCHUR+1,N 945 ME = IPV(ML) 946 IE = ME 947 DO KDUMMY=1,N 948 JP = IPE(IE) 949 LN = 0 950 IF (JP.LE.0_8) GO TO 160 951 LN = IW(JP) 952 160 IPE(IE) = int(-IPV(N-SIZE_SCHUR+1),8) 953 JE = NV(IE) 954 NV(IE) = LN + 1 955 IE = JE 956 IF (IE.EQ.0) GO TO 190 957 ENDDO 958 190 NV(ME) = 0 959 IPE(ME) = int(-IPV(N-SIZE_SCHUR+1),8) 960 ENDDO 961 ME = IPV(N-SIZE_SCHUR+1) 962 IPE(ME) = 0_8 963 NV(ME) = SIZE_SCHUR 964 500 DO I=1,N 965 PARENT(I) = int(IPE(I)) 966 ENDDO 967 RETURN 968 END SUBROUTINE DMUMPS_ANA_K 969 SUBROUTINE DMUMPS_ANA_J(N, NZ, IRN, ICN, PERM, 970 & IW, LW, IPE, IQ, FLAG, 971 & IWFR, IFLAG, IERROR, MP) 972 INTEGER, INTENT(IN) :: N 973 INTEGER(8), INTENT(IN) :: NZ, LW 974 INTEGER, INTENT(IN) :: IRN(NZ), ICN(NZ) 975 INTEGER, INTENT(IN) :: PERM(N) 976 INTEGER, INTENT(IN) :: MP 977 INTEGER(8), INTENT(OUT):: IWFR 978 INTEGER, INTENT(OUT) :: IERROR 979 INTEGER, INTENT(OUT) :: IQ(N) 980 INTEGER(8), INTENT(OUT) :: IPE(N) 981 INTEGER, INTENT(OUT) :: IW(LW) 982 INTEGER, INTENT(OUT) :: FLAG(N) 983 INTEGER, INTENT(INOUT) :: IFLAG 984 INTEGER :: I,J,LBIG,IN,LEN,JDUMMY,L1 985 INTEGER(8) :: K, K1, K2, KL, KID 986 IERROR = 0 987 DO 10 I=1,N 988 IQ(I) = 0 989 10 CONTINUE 990 DO 80 K=1_8,NZ 991 I = IRN(K) 992 J = ICN(K) 993 IW(K) = -I 994 IF (I.EQ.J) GOTO 40 995 IF (I.GT.J) GOTO 30 996 IF (I.GE.1 .AND. J.LE.N) GO TO 60 997 GO TO 50 998 30 IF (J.GE.1 .AND. I.LE.N) GO TO 60 999 GO TO 50 1000 40 IW(K) = 0 1001 IF (I.GE.1 .AND. I.LE.N) GO TO 80 1002 50 IERROR = IERROR + 1 1003 IW(K) = 0 1004 IF (IERROR.LE.1 .AND. MP.GT.0) WRITE (MP,99999) 1005 IF (IERROR.LE.10 .AND. MP.GT.0) WRITE (MP,99998) K, I, J 1006 GO TO 80 1007 60 IF (PERM(J).GT.PERM(I)) GO TO 70 1008 IQ(J) = IQ(J) + 1 1009 GO TO 80 1010 70 IQ(I) = IQ(I) + 1 1011 80 CONTINUE 1012 IF (IERROR.GE.1) THEN 1013 IF (mod(IFLAG,2) .EQ. 0) IFLAG = IFLAG+1 1014 ENDIF 1015 IWFR = 1_8 1016 LBIG = 0 1017 DO 100 I=1,N 1018 L1 = IQ(I) 1019 LBIG = max0(L1,LBIG) 1020 IWFR = IWFR + int(L1,8) 1021 IPE(I) = IWFR - 1_8 1022 100 CONTINUE 1023 DO 140 K=1_8,NZ 1024 I = -IW(K) 1025 IF (I.LE.0) GO TO 140 1026 KL = K 1027 IW(K) = 0 1028 DO 130 KID=1,NZ 1029 J = ICN(KL) 1030 IF (PERM(I).LT.PERM(J)) GO TO 110 1031 KL = IPE(J) 1032 IPE(J) = KL - 1_8 1033 IN = IW(KL) 1034 IW(KL) = I 1035 GO TO 120 1036 110 KL = IPE(I) 1037 IPE(I) = KL - 1_8 1038 IN = IW(KL) 1039 IW(KL) = J 1040 120 I = -IN 1041 IF (I.LE.0) GO TO 140 1042 130 CONTINUE 1043 140 CONTINUE 1044 K = IWFR - 1_8 1045 KL = K + int(N,8) 1046 IWFR = KL + 1_8 1047 DO 170 I=1,N 1048 FLAG(I) = 0 1049 J = N + 1 - I 1050 LEN = IQ(J) 1051 IF (LEN.LE.0) GO TO 160 1052 DO 150 JDUMMY=1,LEN 1053 IW(KL) = IW(K) 1054 K = K - 1_8 1055 KL = KL - 1_8 1056 150 CONTINUE 1057 160 IPE(J) = KL 1058 KL = KL - 1_8 1059 170 CONTINUE 1060 IF (LBIG.GE.huge(N)) GO TO 190 1061 DO 180 I=1,N 1062 K = IPE(I) 1063 IW(K) = IQ(I) 1064 IF (IQ(I).EQ.0) IPE(I) = 0_8 1065 180 CONTINUE 1066 GO TO 230 1067 190 IWFR = 1_8 1068 DO 220 I=1,N 1069 K1 = IPE(I) + 1_8 1070 K2 = IPE(I) + int(IQ(I),8) 1071 IF (K1.LE.K2) GO TO 200 1072 IPE(I) = 0_8 1073 GO TO 220 1074 200 IPE(I) = IWFR 1075 IWFR = IWFR + 1_8 1076 DO 210 K=K1,K2 1077 J = IW(K) 1078 IF (FLAG(J).EQ.I) GO TO 210 1079 IW(IWFR) = J 1080 IWFR = IWFR + 1_8 1081 FLAG(J) = I 1082 210 CONTINUE 1083 K = IPE(I) 1084 IW(K) = int(IWFR - K - 1_8) 1085 220 CONTINUE 1086 230 RETURN 108799999 FORMAT (' *** WARNING MESSAGE FROM DMUMPS_ANA_J ***' ) 108899998 FORMAT (I6, ' NON-ZERO (IN ROW, I6, 11H AND COLUMN ', I6, 1089 & ') IGNORED') 1090 END SUBROUTINE DMUMPS_ANA_J 1091 SUBROUTINE DMUMPS_ANA_D(N, IPE, IW, LW, IWFR,NCMPA) 1092 INTEGER, INTENT(IN) :: N 1093 INTEGER(8), INTENT(IN) :: LW 1094 INTEGER(8), INTENT(OUT) :: IWFR 1095 INTEGER(8), INTENT(INOUT):: IPE(N) 1096 INTEGER, INTENT(INOUT) :: NCMPA 1097 INTEGER, INTENT(INOUT) :: IW(LW) 1098 INTEGER :: I, IR 1099 INTEGER(8) :: K1, K, K2, LWFR 1100 NCMPA = NCMPA + 1 1101 DO 10 I=1,N 1102 K1 = IPE(I) 1103 IF (K1.LE.0_8) GO TO 10 1104 IPE(I) = int(IW(K1), 8) 1105 IW(K1) = -I 1106 10 CONTINUE 1107 IWFR = 1_8 1108 LWFR = IWFR 1109 DO 60 IR=1,N 1110 IF (LWFR.GT.LW) GO TO 70 1111 DO 20 K=LWFR,LW 1112 IF (IW(K).LT.0) GO TO 30 1113 20 CONTINUE 1114 GO TO 70 1115 30 I = -IW(K) 1116 IW(IWFR) = int(IPE(I)) 1117 IPE(I) = int(IWFR,8) 1118 K1 = K + 1_8 1119 K2 = K + int(IW(IWFR),8) 1120 IWFR = IWFR + 1_8 1121 IF (K1.GT.K2) GO TO 50 1122 DO 40 K=K1,K2 1123 IW(IWFR) = IW(K) 1124 IWFR = IWFR + 1_8 1125 40 CONTINUE 1126 50 LWFR = K2 + 1_8 1127 60 CONTINUE 1128 70 RETURN 1129 END SUBROUTINE DMUMPS_ANA_D 1130#if defined(OLDDFS) 1131 SUBROUTINE DMUMPS_ANA_L(N, IPE, NV, IPS, NE, NA, NFSIZ, 1132 & NSTEPS, 1133 & FILS, FRERE,NDD,NEMIN, KEEP60) 1134 INTEGER N,NSTEPS 1135 INTEGER NDD(N) 1136 INTEGER FILS(N), FRERE(N) 1137 INTEGER IPS(N), NE(N), NA(N), NFSIZ(N) 1138 INTEGER IPE(N), NV(N) 1139 INTEGER NEMIN, KEEP60 1140 INTEGER I,IF,IS,NR,NR1,INS,INL,INB,INF,INFS,INSW 1141 INTEGER K,L,ISON,IN,INP,IFSON,INC,INO 1142 INTEGER INOS,IB,IL 1143 DO 10 I=1,N 1144 IPS(I) = 0 1145 NE(I) = 0 1146 10 CONTINUE 1147 DO 20 I=1,N 1148 IF (NV(I).GT.0) GO TO 20 1149 IF = -IPE(I) 1150 IS = -IPS(IF) 1151 IF (IS.GT.0) IPE(I) = IS 1152 IPS(IF) = -I 1153 20 CONTINUE 1154 NR = N + 1 1155 DO 50 I=1,N 1156 IF (NV(I).LE.0) GO TO 50 1157 IF = -IPE(I) 1158 IF (IF.NE.0) THEN 1159 IS = -IPS(IF) 1160 IF (IS.GT.0) IPE(I) = IS 1161 IPS(IF) = -I 1162 ELSE 1163 NR = NR - 1 1164 NE(NR) = I 1165 ENDIF 1166 50 CONTINUE 1167 DO 999 I=1,N 1168 FILS(I) = IPS(I) 1169 999 CONTINUE 1170 NR1 = NR 1171 INS = 0 1172 1000 IF (NR1.GT.N) GO TO 1151 1173 INS = NE(NR1) 1174 NR1 = NR1 + 1 1175 1070 INL = FILS(INS) 1176 IF (INL.LT.0) THEN 1177 INS = -INL 1178 GO TO 1070 1179 ENDIF 1180 1080 IF (IPE(INS).LT.0) THEN 1181 INS = -IPE(INS) 1182 FILS(INS) = 0 1183 GO TO 1080 1184 ENDIF 1185 IF (IPE(INS).EQ.0) THEN 1186 INS = 0 1187 GO TO 1000 1188 ENDIF 1189 INB = IPE(INS) 1190 IF (NV(INB).EQ.0) THEN 1191 INS = INB 1192 GO TO 1070 1193 ENDIF 1194 IF (NV(INB).GE.NV(INS)) THEN 1195 INS = INB 1196 GO TO 1070 1197 ENDIF 1198 INF = INB 1199 1090 INF = IPE(INF) 1200 IF (INF.GT.0) GO TO 1090 1201 INF = -INF 1202 INFS = -FILS(INF) 1203 IF (INFS.EQ.INS) THEN 1204 FILS(INF) = -INB 1205 IPS(INF) = -INB 1206 IPE(INS) = IPE(INB) 1207 IPE(INB) = INS 1208 INS = INB 1209 GO TO 1070 1210 ENDIF 1211 INSW = INFS 1212 1100 INFS = IPE(INSW) 1213 IF (INFS.NE.INS) THEN 1214 INSW = INFS 1215 GO TO 1100 1216 ENDIF 1217 IPE(INS) = IPE(INB) 1218 IPE(INB) = INS 1219 IPE(INSW)= INB 1220 INS =INB 1221 GO TO 1070 1222 1151 CONTINUE 1223 DO 51 I=1,N 1224 FRERE(I) = IPE(I) 1225 FILS(I) = IPS(I) 1226 51 CONTINUE 1227 IS = 1 1228 I = 0 1229 IL = 0 1230 DO 160 K=1,N 1231 IF (I.GT.0) GO TO 60 1232 I = NE(NR) 1233 NE(NR) = 0 1234 NR = NR + 1 1235 IL = N 1236 NA(N) = 0 1237 60 DO 70 L=1,N 1238 IF (IPS(I).GE.0) GO TO 80 1239 ISON = -IPS(I) 1240 IPS(I) = 0 1241 I = ISON 1242 IL = IL - 1 1243 NA(IL) = 0 1244 70 CONTINUE 1245 80 IPS(I) = K 1246 NE(IS) = NE(IS) + 1 1247 IF (NV(I).GT.0) GO TO 89 1248 IN = I 1249 81 IN = FRERE(IN) 1250 IF (IN.GT.0) GO TO 81 1251 IF = -IN 1252 IN = IF 1253 82 INL = IN 1254 IN = FILS(IN) 1255 IF (IN.GT.0) GO TO 82 1256 IFSON = -IN 1257 FILS(INL) = I 1258 IN = I 1259 83 INP = IN 1260 IN = FILS(IN) 1261 IF (IN.GT.0) GO TO 83 1262 IF (IFSON .EQ. I) GO TO 86 1263 FILS(INP) = -IFSON 1264 IN = IFSON 1265 84 INC =IN 1266 IN = FRERE(IN) 1267 IF (IN.NE.I) GO TO 84 1268 FRERE(INC) = FRERE(I) 1269 GO TO 120 1270 86 IF (FRERE(I).LT.0) FILS(INP) = 0 1271 IF (FRERE(I).GT.0) FILS(INP) = -FRERE(I) 1272 GO TO 120 1273 89 IF (IL.LT.N) NA(IL+1) = NA(IL+1) + 1 1274 NA(IS) = NA(IL) 1275 NDD(IS) = NV(I) 1276 NFSIZ(I) = NV(I) 1277 IF (NA(IS).LT.1) GO TO 110 1278 IF ( (KEEP60.NE.0).AND. 1279 & (NE(IS).EQ.NDD(IS)) ) GOTO 110 1280 IF (NDD(IS-1)-NE(IS-1).EQ.NDD(IS)) GO TO 100 1281 IF ((NE(IS-1).GE.NEMIN).AND. 1282 & (NE(IS).GE.NEMIN) ) GO TO 110 1283 IF (2*NE(IS-1)*(NDD(IS)-NDD(IS-1)+NE(IS-1)).GE. 1284 & ((NDD(IS)+NE(IS-1))* 1285 & (NDD(IS)+NE(IS-1))*NEMIN/100)) GO TO 110 1286 100 NA(IS-1) = NA(IS-1) + NA(IS) - 1 1287 NDD(IS-1) = NDD(IS) + NE(IS-1) 1288 NE(IS-1) = NE(IS) + NE(IS-1) 1289 NE(IS) = 0 1290 IN=I 1291 101 INL = IN 1292 IN = FILS(IN) 1293 IF (IN.GT.0) GO TO 101 1294 IFSON = -IN 1295 IN = IFSON 1296 102 INO = IN 1297 IN = FRERE(IN) 1298 IF (IN.GT.0) GO TO 102 1299 FILS(INL) = INO 1300 NFSIZ(I) = NDD(IS-1) 1301 IN = INO 1302 103 INP = IN 1303 IN = FILS(IN) 1304 IF (IN.GT.0) GO TO 103 1305 INOS = -IN 1306 IF (IFSON.EQ.INO) GO TO 107 1307 IN = IFSON 1308 FILS(INP) = -IFSON 1309 105 INS = IN 1310 IN = FRERE(IN) 1311 IF (IN.NE.INO) GO TO 105 1312 IF (INOS.EQ.0) FRERE(INS) = -I 1313 IF (INOS.NE.0) FRERE(INS) = INOS 1314 IF (INOS.EQ.0) GO TO 109 1315 107 IN = INOS 1316 IF (IN.EQ.0) GO TO 109 1317 108 INT = IN 1318 IN = FRERE(IN) 1319 IF (IN.GT.0) GO TO 108 1320 FRERE(INT) = -I 1321 109 CONTINUE 1322 GO TO 120 1323 110 IS = IS + 1 1324 120 IB = IPE(I) 1325 IF (IB.LT.0) GOTO 150 1326 IF (IB.EQ.0) GOTO 140 1327 NA(IL) = 0 1328 140 I = IB 1329 GO TO 160 1330 150 I = -IB 1331 IL = IL + 1 1332 160 CONTINUE 1333 NSTEPS = IS - 1 1334 DO 170 I=1,N 1335 K = FILS(I) 1336 IF (K.GT.0) THEN 1337 FRERE(K) = N + 1 1338 NFSIZ(K) = 0 1339 ENDIF 1340 170 CONTINUE 1341 RETURN 1342 END SUBROUTINE DMUMPS_ANA_L 1343#else 1344 SUBROUTINE DMUMPS_ANA_LNEW(N, IPE, NV, IPS, NE, NA, NFSIZ, 1345 & NODE, NSTEPS, 1346 & FILS, FRERE, ND, NEMIN, SUBORD, KEEP60, 1347 & KEEP20, KEEP38, NAMALG,NAMALGMAX, 1348 & CUMUL,KEEP50, ICNTL13, KEEP37, NSLAVES, 1349 & ALLOW_AMALG_TINY_NODES) 1350 IMPLICIT NONE 1351 INTEGER N, NSTEPS, KEEP60, KEEP20, KEEP38, KEEP50 1352 INTEGER ND(N), NFSIZ(N) 1353 INTEGER IPE(N), FILS(N), FRERE(N), SUBORD(N) 1354 INTEGER NV(N), IPS(N), NE(N), NA(N), NODE(N) 1355 INTEGER NEMIN,AMALG_COUNT 1356 INTEGER NAMALG(N),NAMALGMAX, CUMUL(N) 1357 DOUBLE PRECISION SIZE_DADI_AMALGAMATED, PERCENT_FILL 1358 DOUBLE PRECISION ACCU, FLOPS_FATHER, FLOPS_SON, 1359 & FLOPS_AVANT, FLOPS_APRES 1360 INTEGER ICNTL13, KEEP37, NSLAVES 1361 LOGICAL ALLOW_AMALG_TINY_NODES 1362#if defined(NOAMALGTOFATHER) 1363#else 1364#endif 1365 INTEGER I,IF,IS,NR,INS 1366 INTEGER K,L,ISON,IN,IFSON,INO 1367 INTEGER INOS,IB,IL 1368 INTEGER IPERM 1369 INTEGER MAXNODE 1370#if defined(NOAMALGTOFATHER) 1371 INTEGER INB,INF,INFS,INL,INSW,INT,NR1 1372#else 1373 INTEGER DADI 1374 LOGICAL AMALG_TO_father_OK 1375#endif 1376 AMALG_COUNT = 0 1377 DO 10 I=1,N 1378 CUMUL(I)= 0 1379 IPS(I) = 0 1380 NE(I) = 0 1381 NODE(I) = 1 1382 SUBORD(I) = 0 1383 NAMALG(I) = 0 1384 10 CONTINUE 1385 FRERE(1:N) = IPE(1:N) 1386 NR = N + 1 1387 MAXNODE = 1 1388 DO 50 I=1,N 1389 IF = -FRERE(I) 1390 IF (NV(I).EQ.0) THEN 1391 IF (SUBORD(IF).NE.0) SUBORD(I) = SUBORD(IF) 1392 SUBORD(IF) = I 1393 NODE(IF) = NODE(IF)+1 1394 MAXNODE = max(NODE(IF),MAXNODE) 1395 ELSE 1396 IF (IF.NE.0) THEN 1397 IS = -IPS(IF) 1398 IF (IS.GT.0) FRERE(I) = IS 1399 IPS(IF) = -I 1400 ELSE 1401 NR = NR - 1 1402 NE(NR) = I 1403 ENDIF 1404 ENDIF 1405 50 CONTINUE 1406 MAXNODE = int(dble(MAXNODE)*dble(NEMIN) / dble(100)) 1407 MAXNODE = max(MAXNODE,2000) 1408#if defined(NOAMALGTOFATHER) 1409 DO 999 I=1,N 1410 FILS(I) = IPS(I) 1411 999 CONTINUE 1412 NR1 = NR 1413 INS = 0 1414 1000 IF (NR1.GT.N) GO TO 1151 1415 INS = NE(NR1) 1416 NR1 = NR1 + 1 1417 1070 INL = FILS(INS) 1418 IF (INL.LT.0) THEN 1419 INS = -INL 1420 GO TO 1070 1421 ENDIF 1422 1080 IF (FRERE(INS).LT.0) THEN 1423 INS = -FRERE(INS) 1424 FILS(INS) = 0 1425 GO TO 1080 1426 ENDIF 1427 IF (FRERE(INS).EQ.0) THEN 1428 INS = 0 1429 GO TO 1000 1430 ENDIF 1431 INB = FRERE(INS) 1432 IF (NV(INB).GE.NV(INS)) THEN 1433 INS = INB 1434 GO TO 1070 1435 ENDIF 1436 INF = INB 1437 1090 INF = FRERE(INF) 1438 IF (INF.GT.0) GO TO 1090 1439 INF = -INF 1440 INFS = -FILS(INF) 1441 IF (INFS.EQ.INS) THEN 1442 FILS(INF) = -INB 1443 IPS(INF) = -INB 1444 FRERE(INS) = FRERE(INB) 1445 FRERE(INB) = INS 1446 ELSE 1447 INSW = INFS 1448 1100 INFS = FRERE(INSW) 1449 IF (INFS.NE.INS) THEN 1450 INSW = INFS 1451 GO TO 1100 1452 ENDIF 1453 FRERE(INS) = FRERE(INB) 1454 FRERE(INB) = INS 1455 FRERE(INSW)= INB 1456 ENDIF 1457 INS = INB 1458 GO TO 1070 1459#endif 1460 DO 51 I=1,N 1461 FILS(I) = IPS(I) 1462 51 CONTINUE 1463 IS = 1 1464 I = 0 1465 IPERM = 1 1466 DO 160 K=1,N 1467 AMALG_TO_father_OK=.FALSE. 1468 IF (I.LE.0) THEN 1469 IF (NR.GT.N) EXIT 1470 I = NE(NR) 1471 NE(NR) = 0 1472 NR = NR + 1 1473 IL = N 1474 NA(N) = 0 1475 ENDIF 1476 DO 70 L=1,N 1477 IF (IPS(I).GE.0) EXIT 1478 ISON = -IPS(I) 1479 IPS(I) = 0 1480 I = ISON 1481 IL = IL - 1 1482 NA(IL) = 0 1483 70 CONTINUE 1484#if ! defined(NOAMALGTOFATHER) 1485 DADI = -IPE(I) 1486 IF ( (DADI.NE.0) .AND. 1487 & ( 1488 & (KEEP60.EQ.0).OR. 1489 & ( (KEEP20.NE.DADI).AND.(KEEP38.NE.DADI) ) 1490 & ) 1491 & ) THEN 1492 ACCU = dble(2)*dble(NODE(I))*dble(NV(DADI)-NV(I)+NODE(I)) 1493 SIZE_DADI_AMALGAMATED = 1494 & dble(NV(DADI)+NODE(I)) * 1495 & dble(NV(DADI)+NODE(I)) 1496 PERCENT_FILL = dble(100) * ACCU / SIZE_DADI_AMALGAMATED 1497 ACCU = ACCU + dble(CUMUL(I)) 1498 AMALG_TO_father_OK = ( 1499 & ( (NODE(I).LE.MAXNODE).AND.(NODE(DADI).LE.MAXNODE) ) 1500 & .OR. 1501 & ( (NODE(I).LE.NEMIN.and. NODE(DADI).GT. MAXNODE) 1502 & .OR.(NODE(DADI).LE.NEMIN .and. NODE(I).GT.MAXNODE))) 1503 AMALG_TO_father_OK = ( AMALG_TO_father_OK .AND. 1504 & ( PERCENT_FILL < dble(NEMIN) ) ) 1505 AMALG_TO_father_OK = ( AMALG_TO_father_OK .AND. 1506 & ( ACCU / SIZE_DADI_AMALGAMATED .LE. dble(NEMIN)) ) 1507 IF (AMALG_TO_father_OK) THEN 1508 CALL MUMPS_GET_FLOPS_COST(NV(I),NODE(I),NODE(I), 1509 & KEEP50,1,FLOPS_SON) 1510 CALL MUMPS_GET_FLOPS_COST(NV(DADI),NODE(DADI), 1511 & NODE(DADI), 1512 & KEEP50,1,FLOPS_FATHER) 1513 FLOPS_AVANT = FLOPS_FATHER+FLOPS_SON 1514 & + max(dble(200.0) * dble(NV(I)-NODE(I)) 1515 & * dble(NV(I)-NODE(I)), 1516 & dble(10000.0)) 1517 CALL MUMPS_GET_FLOPS_COST(NV(DADI)+NODE(I), 1518 & NODE(DADI)+NODE(I), 1519 & NODE(DADI)+NODE(I), 1520 & KEEP50,1,FLOPS_APRES) 1521 IF (FLOPS_APRES.GT.FLOPS_AVANT* 1522 & (dble(1)+dble(max(8,NEMIN)-8)/dble(100))) THEN 1523 AMALG_TO_father_OK = .FALSE. 1524 ENDIF 1525 ENDIF 1526 IF ( (NV(I).GT. 50*NV(DADI)).AND. (NSLAVES.GT.1) 1527 & .AND. (ICNTL13.LE.0) 1528 & .AND. (NV(I).GT. KEEP37) ) THEN 1529 AMALG_TO_father_OK = .TRUE. 1530 ENDIF 1531 IF ( ALLOW_AMALG_TINY_NODES .AND. 1532 & NODE(I) * 900 .LE. NV(DADI) - NAMALG(DADI)) THEN 1533 IF ( NAMALG(DADI) < (NV(DADI)-NAMALG(DADI))/50 ) THEN 1534 AMALG_TO_father_OK = .TRUE. 1535 NAMALG(DADI) = NAMALG(DADI) + NODE(I) 1536 ENDIF 1537 ENDIF 1538 IF ( DADI .EQ. -FRERE(I) 1539 & .AND. -FILS(DADI).EQ.I 1540 & ) THEN 1541 AMALG_TO_father_OK = ( AMALG_TO_father_OK .OR. 1542 & ( NV(I)-NODE(I).EQ.NV(DADI)) ) 1543 ENDIF 1544 IF (AMALG_TO_father_OK) THEN 1545 CUMUL(DADI)=CUMUL(DADI)+nint(ACCU) 1546 NAMALG(DADI) = NAMALG(DADI) + NAMALG(I) 1547 AMALG_COUNT = AMALG_COUNT+1 1548 IN = DADI 1549 75 IF (SUBORD(IN).EQ.0) GOTO 76 1550 IN = SUBORD(IN) 1551 GOTO 75 1552 76 CONTINUE 1553 SUBORD(IN) = I 1554 NV(I) = 0 1555 IFSON = -FILS(DADI) 1556 IF (IFSON.EQ.I) THEN 1557 IF (FILS(I).LT.0) THEN 1558 FILS(DADI) = FILS(I) 1559 GOTO 78 1560 ELSE 1561 IF (FRERE(I).GT.0) THEN 1562 FILS(DADI) = -FRERE(I) 1563 ELSE 1564 FILS(DADI) = 0 1565 ENDIF 1566 GOTO 90 1567 ENDIF 1568 ENDIF 1569 IN = IFSON 1570 77 INS = IN 1571 IN = FRERE(IN) 1572 IF (IN.NE.I) GOTO 77 1573 IF (FILS(I) .LT.0) THEN 1574 FRERE(INS) = -FILS(I) 1575 ELSE 1576 FRERE(INS) = FRERE(I) 1577 GOTO 90 1578 ENDIF 1579 78 CONTINUE 1580 IN = -FILS(I) 1581 79 INO = IN 1582 IN = FRERE(IN) 1583 IF (IN.GT.0) GOTO 79 1584 FRERE(INO) = FRERE(I) 1585 90 CONTINUE 1586 NODE(DADI) = NODE(DADI)+ NODE(I) 1587 NV(DADI) = NV(DADI) + NODE(I) 1588 NA(IL+1) = NA(IL+1) + NA(IL) 1589 GOTO 120 1590 ENDIF 1591 ENDIF 1592#endif 1593 NE(IS) = NE(IS) + NODE(I) 1594 IF (IL.LT.N) NA(IL+1) = NA(IL+1) + 1 1595 NA(IS) = NA(IL) 1596 ND(IS) = NV(I) 1597 NODE(I) = IS 1598 IPS(I) = IPERM 1599 IPERM = IPERM + 1 1600 IN = I 1601 777 IF (SUBORD(IN).EQ.0) GO TO 778 1602 IN = SUBORD(IN) 1603 NODE(IN) = IS 1604 IPS(IN) = IPERM 1605 IPERM = IPERM + 1 1606 GO TO 777 1607 778 IF (NA(IS).LE.0) GO TO 110 1608#if defined(NOAMALGTOFATHER) 1609 IF ( (KEEP60.NE.0).AND. 1610 & (NE(IS).EQ.ND(IS)) ) GOTO 110 1611 IF (ND(IS-1)-NE(IS-1).EQ.ND(IS)) THEN 1612 GO TO 100 1613 ENDIF 1614 IF(NAMALG(IS-1) .GE. NAMALGMAX) THEN 1615 GOTO 110 1616 ENDIF 1617 IF ((NE(IS-1).GE.NEMIN).AND. 1618 & (NE(IS).GE.NEMIN) ) GO TO 110 1619 IF (2*NE(IS-1)*(ND(IS)-ND(IS-1)+NE(IS-1)).GE. 1620 & ((ND(IS)+NE(IS-1))* 1621 & (ND(IS)+NE(IS-1))*NEMIN/100)) GO TO 110 1622 NAMALG(IS-1) = NAMALG(IS-1)+1 1623 100 NA(IS-1) = NA(IS-1) + NA(IS) - 1 1624 ND(IS-1) = ND(IS) + NE(IS-1) 1625 NE(IS-1) = NE(IS) + NE(IS-1) 1626 NE(IS) = 0 1627 NODE(I) = IS-1 1628 IFSON = -FILS(I) 1629 IN = IFSON 1630 102 INO = IN 1631 IN = FRERE(IN) 1632 IF (IN.GT.0) GO TO 102 1633 NV(INO) = 0 1634 IN = I 1635 888 IF (SUBORD(IN).EQ.0) GO TO 889 1636 IN = SUBORD(IN) 1637 GO TO 888 1638 889 SUBORD(IN) = INO 1639 INOS = -FILS(INO) 1640 IF (IFSON.EQ.INO) THEN 1641 FILS(I) = -INOS 1642 GO TO 107 1643 ENDIF 1644 IN = IFSON 1645 105 INS = IN 1646 IN = FRERE(IN) 1647 IF (IN.NE.INO) GO TO 105 1648 IF (INOS.EQ.0) THEN 1649 FRERE(INS) = -I 1650 GO TO 120 1651 ELSE 1652 FRERE(INS) = INOS 1653 ENDIF 1654 107 IN = INOS 1655 IF (IN.EQ.0) GO TO 120 1656 108 INT = IN 1657 IN = FRERE(IN) 1658 IF (IN.GT.0) GO TO 108 1659 FRERE(INT) = -I 1660 GO TO 120 1661#endif 1662 110 IS = IS + 1 1663 120 IB = FRERE(I) 1664 IF (IB.GE.0) THEN 1665 IF (IB.GT.0) NA(IL) = 0 1666 I = IB 1667 ELSE 1668 I = -IB 1669 IL = IL + 1 1670 ENDIF 1671 160 CONTINUE 1672 NSTEPS = IS - 1 1673 DO I=1, N 1674 IF (NV(I).EQ.0) THEN 1675 FRERE(I) = N+1 1676 NFSIZ(I) = 0 1677 ELSE 1678 NFSIZ(I) = ND(NODE(I)) 1679 IF (SUBORD(I) .NE.0) THEN 1680 INOS = -FILS(I) 1681 INO = I 1682 DO WHILE (SUBORD(INO).NE.0) 1683 IS = SUBORD(INO) 1684 FILS(INO) = IS 1685 INO = IS 1686 END DO 1687 FILS(INO) = -INOS 1688 ENDIF 1689 ENDIF 1690 ENDDO 1691 RETURN 1692 END SUBROUTINE DMUMPS_ANA_LNEW 1693#endif 1694 SUBROUTINE DMUMPS_ANA_M(NE, ND, NSTEPS, 1695 & MAXFR, MAXELIM, K50, MAXFAC, MAXNPIV, 1696 & K5,K6,PANEL_SIZE,K253) 1697 IMPLICIT NONE 1698 INTEGER NSTEPS,MAXNPIV 1699 INTEGER MAXFR, MAXELIM, K50, MAXFAC 1700 INTEGER K5,K6,PANEL_SIZE,K253 1701 INTEGER NE(NSTEPS), ND(NSTEPS) 1702 INTEGER ITREE, NFR, NELIM 1703 INTEGER LKJIB 1704 LKJIB = max(K5,K6) 1705 MAXFR = 0 1706 MAXFAC = 0 1707 MAXELIM = 0 1708 MAXNPIV = 0 1709 PANEL_SIZE = 0 1710 DO ITREE=1,NSTEPS 1711 NELIM = NE(ITREE) 1712 NFR = ND(ITREE) + K253 1713 IF (NFR.GT.MAXFR) MAXFR = NFR 1714 IF (NFR-NELIM.GT.MAXELIM) MAXELIM = NFR - NELIM 1715 IF (NELIM .GT. MAXNPIV) THEN 1716 MAXNPIV = NELIM 1717 ENDIF 1718 IF (K50.EQ.0) THEN 1719 MAXFAC = max(MAXFAC, (2*NFR - NELIM)*NELIM ) 1720 PANEL_SIZE = max(PANEL_SIZE, NFR*(LKJIB+1)) 1721 ELSE 1722 MAXFAC = max(MAXFAC, NFR * NELIM) 1723 PANEL_SIZE = max(PANEL_SIZE, NELIM*(LKJIB+1)) 1724 PANEL_SIZE = max(PANEL_SIZE, (NFR-NELIM)*(LKJIB+1)) 1725 ENDIF 1726 END DO 1727 RETURN 1728 END SUBROUTINE DMUMPS_ANA_M 1729 SUBROUTINE DMUMPS_ANA_R( N, FILS, FRERE, 1730 & NSTK, NA ) 1731 IMPLICIT NONE 1732 INTEGER, INTENT(IN) :: N 1733 INTEGER, INTENT(IN) :: FILS(N), FRERE(N) 1734 INTEGER, INTENT(OUT) :: NSTK(N), NA(N) 1735 INTEGER NBROOT, NBLEAF, ILEAF, I, IN, ISON 1736 NA = 0 1737 NSTK = 0 1738 NBROOT = 0 1739 ILEAF = 1 1740 DO 11 I=1,N 1741 IF (FRERE(I).EQ. N+1) CYCLE 1742 IF (FRERE(I).EQ.0) NBROOT = NBROOT + 1 1743 IN = I 1744 12 IN = FILS(IN) 1745 IF (IN.GT.0) GO TO 12 1746 IF (IN.EQ.0) THEN 1747 NA(ILEAF) = I 1748 ILEAF = ILEAF + 1 1749 CYCLE 1750 ENDIF 1751 ISON = -IN 1752 13 NSTK(I) = NSTK(I) + 1 1753 ISON = FRERE(ISON) 1754 IF (ISON.GT.0) GO TO 13 1755 11 CONTINUE 1756 NBLEAF = ILEAF-1 1757 IF (N.GT.1) THEN 1758 IF (NBLEAF.GT.N-2) THEN 1759 IF (NBLEAF.EQ.N-1) THEN 1760 NA(N-1) = -NA(N-1)-1 1761 NA(N) = NBROOT 1762 ELSE 1763 NA(N) = -NA(N)-1 1764 ENDIF 1765 ELSE 1766 NA(N-1) = NBLEAF 1767 NA(N) = NBROOT 1768 ENDIF 1769 ENDIF 1770 RETURN 1771 END SUBROUTINE DMUMPS_ANA_R 1772 SUBROUTINE DMUMPS_ANA_O( N, NZ, MTRANS, PERM, 1773 & id, ICNTL, INFO) 1774 USE DMUMPS_STRUC_DEF 1775 IMPLICIT NONE 1776 TYPE (DMUMPS_STRUC) :: id 1777 INTEGER, INTENT(IN) :: N 1778 INTEGER(8), INTENT(IN) :: NZ 1779 INTEGER, INTENT(OUT) :: PERM(N) 1780 INTEGER, INTENT(INOUT) :: MTRANS 1781 INTEGER, INTENT(IN) :: ICNTL(40) 1782 INTEGER, INTENT(INOUT) :: INFO(40) 1783 INTEGER :: allocok 1784 INTEGER, ALLOCATABLE, DIMENSION(:) :: IW 1785 DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:) :: S2 1786 TARGET :: S2 1787 INTEGER ICNTL64(10), INFO64(10) 1788 INTEGER ICNTL_SYM_MWM(10),INFO_SYM_MWM(10) 1789 DOUBLE PRECISION CNTL64(10) 1790 INTEGER MPRINT,LP, MP 1791 INTEGER JPERM 1792 INTEGER NUMNZ, I, J, JPOS 1793 LOGICAL PROK, IDENT, DUPPLI 1794 INTEGER K50, KER_SIZE, NZER_DIAG, MTRANSLOC,RZ_DIAG 1795 INTEGER(8) :: LIWG 1796 INTEGER(8), DIMENSION(:), ALLOCATABLE :: IPE 1797 INTEGER(8), DIMENSION(:), ALLOCATABLE :: IPQ8 1798 INTEGER :: LSC 1799 INTEGER(8) :: NZTOT, NZREAL, IPIW, LIW, LIWMIN, NZsave, 1800 & K, KPOS, LDW, LDWMIN, IRNW, RSPOS, CSPOS, 1801 & LS2,J8, N8 1802 LOGICAL SCALINGLOC 1803 INTEGER,POINTER,DIMENSION(:) :: ZERODIAG 1804 INTEGER,POINTER,DIMENSION(:) :: STR_KER 1805 INTEGER,POINTER,DIMENSION(:) :: MARKED 1806 INTEGER,POINTER,DIMENSION(:) :: FLAG 1807 INTEGER,POINTER,DIMENSION(:) :: PIV_OUT 1808 DOUBLE PRECISION THEMIN, THEMAX, COLNORM,MAXDBL 1809 DOUBLE PRECISION ZERO,TWO,ONE 1810 PARAMETER(ZERO = 0.0D0,TWO = 2.0D0,ONE = 1.0D0) 1811 N8 = int(N,8) 1812 MPRINT = ICNTL(3) 1813 LP = ICNTL(1) 1814 MP = ICNTL(2) 1815 PROK = ((MPRINT.GT.0).AND.(ICNTL(4).GE.2)) 1816 IF (PROK) WRITE(MPRINT,101) 1817 101 FORMAT(/'****** Preprocessing of original matrix '/) 1818 K50 = id%KEEP(50) 1819 SCALINGLOC = .FALSE. 1820 IF(id%KEEP(52) .EQ. -2) THEN 1821 IF(.not.associated(id%A)) THEN 1822 INFO(1) = -22 1823 INFO(2) = 4 1824 GOTO 500 1825 ELSE 1826 SCALINGLOC = .TRUE. 1827 ENDIF 1828 ELSE IF(id%KEEP(52) .EQ. 77) THEN 1829 SCALINGLOC = .TRUE. 1830 IF(K50 .NE. 2) THEN 1831 IF( MTRANS .NE. 5 .AND. MTRANS .NE. 6 1832 & .AND. MTRANS .NE. 7) THEN 1833 SCALINGLOC = .FALSE. 1834 IF (PROK) 1835 & WRITE(MPRINT,*) 'Analysis: auto scaling set OFF' 1836 ENDIF 1837 ENDIF 1838 IF(.not.associated(id%A)) THEN 1839 SCALINGLOC = .FALSE. 1840 IF (PROK) 1841 & WRITE(MPRINT,*) 'Analysis: auto scaling set OFF' 1842 ENDIF 1843 ENDIF 1844 IF(SCALINGLOC) THEN 1845 IF (PROK) WRITE(MPRINT,*) 1846 & 'Scaling will be computed during analysis' 1847 ENDIF 1848 MTRANSLOC = MTRANS 1849 IF (MTRANS.LT.0 .OR. MTRANS.GT.7) GO TO 500 1850 IF (K50 .EQ. 0) THEN 1851 IF(.NOT. SCALINGLOC .AND. MTRANS .EQ. 7) THEN 1852 GO TO 500 1853 ENDIF 1854 IF(SCALINGLOC) THEN 1855 MTRANSLOC = 5 1856 ENDIF 1857 ELSE 1858 IF (MTRANS .EQ. 7) MTRANSLOC = 5 1859 ENDIF 1860 IF(SCALINGLOC .AND. MTRANSLOC .NE. 5 .AND. 1861 & MTRANSLOC .NE. 6 ) THEN 1862 IF (PROK) WRITE(MPRINT,*) 1863 & 'WARNING scaling required: set MTRANS option to 5' 1864 MTRANSLOC = 5 1865 ENDIF 1866 IF (N.EQ.1) THEN 1867 MTRANS=0 1868 GO TO 500 1869 ENDIF 1870 IF(K50 .NE. 0) THEN 1871 NZTOT = 2_8*NZ+N8 1872 ELSE 1873 NZTOT = NZ 1874 ENDIF 1875 ZERODIAG => id%IS1(N+1:2*N) 1876 STR_KER => id%IS1(2*N+1:3*N) 1877 CALL DMUMPS_MTRANSI(ICNTL64,CNTL64) 1878 ICNTL64(1) = ICNTL(1) 1879 ICNTL64(2) = ICNTL(2) 1880 ICNTL64(3) = ICNTL(2) 1881 ICNTL64(4) = -1 1882 IF (ICNTL(4).EQ.3) ICNTL64(4) = 0 1883 IF (ICNTL(4).EQ.4) ICNTL64(4) = 1 1884 ICNTL64(5) = -1 1885 IF (PROK) THEN 1886 WRITE(MPRINT,'(A,I3)') 1887 & 'Compute maximum matching (Maximum Transversal):', 1888 & MTRANSLOC 1889 IF (MTRANSLOC.EQ.1) 1890 & WRITE(MPRINT,'(A,I3)')' ... JOB =',MTRANSLOC 1891 IF (MTRANSLOC.EQ.2) 1892 & WRITE(MPRINT,'(A,I3,A)') 1893 & ' ... JOB =',MTRANSLOC,': BOTTLENECK THESIS' 1894 IF (MTRANSLOC.EQ.3) 1895 & WRITE(MPRINT,'(A,I3,A)') 1896 & ' ... JOB =',MTRANSLOC,': BOTTLENECK SIMAX' 1897 IF (MTRANSLOC.EQ.4) 1898 & WRITE(MPRINT,'(A,I3,A)') 1899 & ' ... JOB =',MTRANSLOC,': MAXIMIZE SUM DIAGONAL' 1900 IF (MTRANSLOC.EQ.5 .OR. MTRANSLOC.EQ.6) 1901 & WRITE(MPRINT,'(A,I3,A)') 1902 & ' ... JOB =',MTRANSLOC, 1903 & ': MAXIMIZE PRODUCT DIAGONAL AND SCALE' 1904 ENDIF 1905 id%INFOG(23) = MTRANSLOC 1906 CNTL64(2) = huge(CNTL64(2)) 1907 IRNW = 1 1908 IPIW = IRNW + NZTOT 1909 IF (MTRANSLOC.EQ.1) LIWMIN = 5_8*N8 1910 IF (MTRANSLOC.EQ.2) LIWMIN = 3_8*N8 1911 IF (MTRANSLOC.EQ.3) LIWMIN = 10_8*N8 + NZTOT 1912 IF (MTRANSLOC.EQ.4) LIWMIN = 2_8*N8 1913 IF (MTRANSLOC.EQ.5) LIWMIN = 5_8*N8 1914 IF (MTRANSLOC.EQ.6) LIWMIN = 5_8*N8 + NZTOT 1915 LIW = LIWMIN 1916 LIWG = LIW + NZTOT 1917 ALLOCATE(IW(LIWG), stat=allocok) 1918 IF (allocok .GT. 0 ) GOTO 410 1919 ALLOCATE( IPQ8(N), IPE(N+1), stat = allocok ) 1920 IF ( allocok .GT. 0 ) THEN 1921 INFO( 1 ) = -7 1922 INFO( 2 ) = (2*N+1)*id%KEEP(10) 1923 GOTO 500 1924 ENDIF 1925 IF (MTRANSLOC.EQ.1) THEN 1926 LDWMIN = N8+3_8 1927 ENDIF 1928 IF (MTRANSLOC.EQ.2) LDWMIN = max( N8+NZTOT , N8+3_8 ) 1929 IF (MTRANSLOC.EQ.3) LDWMIN = max( NZTOT+1_8 , N8+3_8 ) 1930 IF (MTRANSLOC.EQ.4) LDWMIN = 2_8 * N8 + 1931 & max( NZTOT , N8+3_8 ) 1932 IF (MTRANSLOC.EQ.5) LDWMIN = 3_8*N8 + NZTOT 1933 IF (MTRANSLOC.EQ.6) LDWMIN = 4_8*N8 + NZTOT 1934 LDW = LDWMIN 1935 ALLOCATE(S2(LDW), stat=allocok) 1936 IF (allocok .GT. 0 ) GOTO 430 1937 IF(MTRANSLOC .NE. 1) LDW = LDW-NZTOT 1938 RSPOS = NZTOT 1939 CSPOS = RSPOS+N8 1940 NZREAL = 0_8 1941 DO 5 J=1,N 1942 IPQ8(J) = 0_8 1943 5 CONTINUE 1944 IF(K50 .EQ. 0) THEN 1945 DO 10 K=1,NZ 1946 I = id%IRN(K) 1947 J = id%JCN(K) 1948 IF ( (J.LE.N).AND.(J.GE.1).AND. 1949 & (I.LE.N).AND.(I.GE.1) ) THEN 1950 IPQ8(J) = IPQ8(J) + 1_8 1951 NZREAL = NZREAL + 1_8 1952 ENDIF 1953 10 CONTINUE 1954 ELSE 1955 ZERODIAG = 0 1956 NZER_DIAG = N 1957 RZ_DIAG = 0 1958 DO K=1,NZ 1959 I = id%IRN(K) 1960 J = id%JCN(K) 1961 IF ( (J.LE.N).AND.(J.GE.1).AND. 1962 & (I.LE.N).AND.(I.GE.1) ) THEN 1963 IPQ8(J) = IPQ8(J) + 1_8 1964 NZREAL = NZREAL + 1_8 1965 IF(I .NE. J) THEN 1966 IPQ8(I) = IPQ8(I) + 1_8 1967 NZREAL = NZREAL + 1_8 1968 ELSE 1969 IF(ZERODIAG(I) .EQ. 0) THEN 1970 ZERODIAG(I) = 1 1971 IF(associated(id%A)) THEN 1972 IF(abs(id%A(K)) .EQ. dble(0.0D0)) THEN 1973 RZ_DIAG = RZ_DIAG + 1 1974 ENDIF 1975 ENDIF 1976 NZER_DIAG = NZER_DIAG - 1 1977 ENDIF 1978 ENDIF 1979 ENDIF 1980 ENDDO 1981 IF(MTRANSLOC .GE. 4) THEN 1982 DO I =1, N 1983 IF(ZERODIAG(I) .EQ. 0) THEN 1984 IPQ8(I) = IPQ8(I) + 1_8 1985 NZREAL = NZREAL + 1_8 1986 ENDIF 1987 ENDDO 1988 ENDIF 1989 ENDIF 1990 IPE(1) = 1 1991 DO 20 J=1,N 1992 IPE(J+1) = IPE(J)+IPQ8(J) 1993 20 CONTINUE 1994 DO 25 J=1, N 1995 IPQ8(J ) = IPE(J) 1996 25 CONTINUE 1997 IF(K50 .EQ. 0) THEN 1998 IF (MTRANSLOC.EQ.1) THEN 1999 DO K=1,NZ 2000 I = id%IRN(K) 2001 J = id%JCN(K) 2002 IF ( (J.LE.N).AND.(J.GE.1) .AND. 2003 & (I.LE.N).AND.(I.GE.1)) THEN 2004 KPOS = IPQ8(J) 2005 IW(IRNW+KPOS-1_8) = I 2006 IPQ8(J) = IPQ8(J) + 1_8 2007 ENDIF 2008 END DO 2009 ELSE 2010 IF ( .not.associated(id%A)) THEN 2011 INFO(1) = -22 2012 INFO(2) = 4 2013 GOTO 500 2014 ENDIF 2015 DO K=1,NZ 2016 I = id%IRN(K) 2017 J = id%JCN(K) 2018 IF ( (J.LE.N).AND.(J.GE.1) .AND. 2019 & (I.LE.N).AND.(I.GE.1)) THEN 2020 KPOS = IPQ8(J) 2021 IW(IRNW+KPOS-1) = I 2022 S2(KPOS) = abs(id%A(K)) 2023 IPQ8(J) = IPQ8(J) + 1_8 2024 ENDIF 2025 END DO 2026 ENDIF 2027 ELSE 2028 IF (MTRANSLOC.EQ.1) THEN 2029 DO K=1,NZ 2030 I = id%IRN(K) 2031 J = id%JCN(K) 2032 IF ( (J.LE.N).AND.(J.GE.1) .AND. 2033 & (I.LE.N).AND.(I.GE.1)) THEN 2034 KPOS = IPQ8(J) 2035 IW(IRNW+KPOS-1) = I 2036 IPQ8(J) = IPQ8(J) + 1_8 2037 IF(I.NE.J) THEN 2038 KPOS = IPQ8(I) 2039 IW(IRNW+KPOS-1) = J 2040 IPQ8(I) = IPQ8(I) + 1_8 2041 ENDIF 2042 ENDIF 2043 ENDDO 2044 ELSE 2045 IF ( .not.associated(id%A)) THEN 2046 INFO(1) = -22 2047 INFO(2) = 4 2048 GOTO 500 2049 ENDIF 2050 K = 1_8 2051 THEMIN = ZERO 2052 DO 2053 IF(THEMIN .NE. ZERO) EXIT 2054 THEMIN = abs(id%A(K)) 2055 K = K+1_8 2056 ENDDO 2057 THEMAX = THEMIN 2058 DO K=1,NZ 2059 I = id%IRN(K) 2060 J = id%JCN(K) 2061 IF ( (J.LE.N).AND.(J.GE.1) .AND. 2062 & (I.LE.N).AND.(I.GE.1)) THEN 2063 KPOS = IPQ8(J) 2064 IW(IRNW+KPOS-1_8) = I 2065 S2(KPOS) = abs(id%A(K)) 2066 IPQ8(J) = IPQ8(J) + 1_8 2067 IF(abs(id%A(K)) .GT. THEMAX) THEN 2068 THEMAX = abs(id%A(K)) 2069 ELSE IF(abs(id%A(K)) .LT. THEMIN 2070 & .AND. abs(id%A(K)).GT. ZERO) THEN 2071 THEMIN = abs(id%A(K)) 2072 ENDIF 2073 IF(I.NE.J) THEN 2074 KPOS = IPQ8(I) 2075 IW(IRNW+KPOS-1) = J 2076 S2(KPOS) = abs(id%A(K)) 2077 IPQ8(I) = IPQ8(I) + 1_8 2078 ENDIF 2079 ENDIF 2080 ENDDO 2081 DO I =1, N 2082 IF(ZERODIAG(I) .EQ. 0) THEN 2083 KPOS = IPQ8(I) 2084 IW(IRNW+KPOS-1) = I 2085 S2(KPOS) = ZERO 2086 IPQ8(I) = IPQ8(I) + 1_8 2087 ENDIF 2088 ENDDO 2089 CNTL64(2) = (log(THEMAX/THEMIN))*(dble(N)) 2090 & - log(THEMIN) + ONE 2091 ENDIF 2092 ENDIF 2093 DUPPLI = .FALSE. 2094 NZsave = NZREAL 2095 FLAG => id%IS1(3*N+1:4*N) 2096 IF(MTRANSLOC.NE.1) THEN 2097 CALL DMUMPS_SUPPRESS_DUPPLI_VAL(N,NZREAL,IPE(1),IW(IRNW),S2, 2098 & PERM,IPQ8(1)) 2099 ELSE 2100 CALL DMUMPS_SUPPRESS_DUPPLI_STR(N,NZREAL,IPE(1),IW(IRNW), 2101 & PERM) 2102 ENDIF 2103 IF(NZREAL .NE. NZsave) DUPPLI = .TRUE. 2104 LS2 = NZTOT 2105 IF ( MTRANSLOC .EQ. 1 ) THEN 2106 LS2 = 1_8 2107 LDW = 1_8 2108 ENDIF 2109 CALL DMUMPS_MTRANS_DRIVER(MTRANSLOC ,N, N, NZREAL, 2110 & IPE, IW(IRNW), S2(1), LS2, 2111 & NUMNZ, PERM, LIW, IW(IPIW), LDW, S2(LS2+1), 2112 & IPQ8, 2113 & ICNTL64, CNTL64, INFO64, INFO) 2114 IF (INFO(1).LT.0) THEN 2115 IF (LP.GT.0 .AND. ICNTL(4).GE.1) 2116 & WRITE(LP,'(A,I5)') 2117 & ' Not enough memory in MAXTRANS INFO(1)=',INFO(1) 2118 GOTO 500 2119 ENDIF 2120 IF (INFO64(1).LT.0) THEN 2121 IF (LP.GT.0 .AND. ICNTL(4).GE.1) 2122 & WRITE(LP,'(A,I5)') 2123 & ' INTERNAL ERROR in MAXTRANS INFO(1)=',INFO64(1) 2124 INFO(1) = -9964 2125 INFO(2) = INFO64(1) 2126 GO TO 500 2127 ENDIF 2128 IF (INFO64(1).GT.0) THEN 2129 IF (MP.GT.0 .AND. ICNTL(4).GE.2) 2130 & WRITE(MP,'(A,I5)') 2131 & ' WARNING in MAXTRANS INFO(1)=',INFO64(1) 2132 ENDIF 2133 KER_SIZE = 0 2134 IF(K50 .EQ. 2) THEN 2135 DO I=1,N 2136 IF(ZERODIAG(I) .EQ. 0) THEN 2137 IF(PERM(I) .EQ. I) THEN 2138 KER_SIZE = KER_SIZE + 1 2139 PERM(I) = -I 2140 STR_KER(KER_SIZE) = I 2141 ENDIF 2142 ENDIF 2143 ENDDO 2144 ENDIF 2145 IF (NUMNZ.LT.N) GO TO 400 2146 IF(K50 .EQ. 0) THEN 2147 IDENT = .TRUE. 2148 IF (MTRANS .EQ. 0 ) GOTO 102 2149 DO 80 J=1,N 2150 JPERM = PERM(J) 2151 IW(IRNW+int(JPERM-1,8)) = J 2152 IF (JPERM.NE.J) IDENT = .FALSE. 2153 80 CONTINUE 2154 IF(IDENT) THEN 2155 MTRANS = 0 2156 ELSE 2157 IF(MTRANS .EQ. 7) THEN 2158 MTRANS = -9876543 2159 GOTO 102 2160 ENDIF 2161 IF (PROK) WRITE(MPRINT,'(A)') 2162 & ' ... Apply column permutation' 2163 DO 100 K=1,NZ 2164 J = id%JCN(K) 2165 IF ((J.LE.0).OR.(J.GT.N)) GO TO 100 2166 id%JCN(K) = IW(IRNW+int(J-1,8)) 2167 100 CONTINUE 2168 IF (MP.GT.0 .AND. ICNTL(4).GE.2) 2169 & WRITE(MP,'(/A)') 2170 & ' WARNING input matrix data modified' 2171 ENDIF 2172 102 CONTINUE 2173 IF (SCALINGLOC) THEN 2174 IF ( associated(id%COLSCA)) 2175 & DEALLOCATE( id%COLSCA ) 2176 IF ( associated(id%ROWSCA)) 2177 & DEALLOCATE( id%ROWSCA ) 2178 ALLOCATE( id%COLSCA(N), stat=allocok) 2179 IF (allocok .GT.0) THEN 2180 id%INFO(1)=-5 2181 id%INFO(2)=N 2182 IF ((LP.GE.0).AND.(ICNTL(4).GE.1)) THEN 2183 WRITE (LP,'(/A)') '** Error in DMUMPS_ANA_O' 2184 WRITE (LP,'(A)') 2185 & '** Failure during allocation of COLSCA' 2186 GOTO 500 2187 ENDIF 2188 ENDIF 2189 ALLOCATE( id%ROWSCA(N), stat=allocok) 2190 IF (allocok .GT.0) THEN 2191 id%INFO(1)=-5 2192 id%INFO(2)=N 2193 IF ((LP.GE.0).AND.(ICNTL(4).GE.1)) THEN 2194 WRITE (LP,'(/A)') '** Error in DMUMPS_ANA_O' 2195 WRITE (LP,'(A)') 2196 & '** Failure during allocation of ROWSCA' 2197 GOTO 500 2198 ENDIF 2199 ENDIF 2200 id%KEEP(52) = -2 2201 id%KEEP(74) = 1 2202 MAXDBL = log(huge(MAXDBL)) 2203 DO J=1,N 2204 IF(S2(RSPOS+J) .GT. MAXDBL) THEN 2205 S2(RSPOS+J) = ZERO 2206 ENDIF 2207 IF(S2(CSPOS+J) .GT. MAXDBL) THEN 2208 S2(CSPOS+J)= ZERO 2209 ENDIF 2210 ENDDO 2211 DO 105 J=1,N 2212 J8 = int(J,8) 2213 id%ROWSCA(J) = exp(S2(RSPOS+J8)) 2214 IF(id%ROWSCA(J) .EQ. ZERO) THEN 2215 id%ROWSCA(J) = ONE 2216 ENDIF 2217 IF ( MTRANS .EQ. -9876543 .OR. MTRANS.EQ. 0 ) THEN 2218 id%COLSCA(J)= exp(S2(CSPOS+J8)) 2219 IF(id%COLSCA(J) .EQ. ZERO) THEN 2220 id%COLSCA(J) = ONE 2221 ENDIF 2222 ELSE 2223 id%COLSCA(IW(IRNW+J8-1_8))= exp(S2(CSPOS+J8)) 2224 IF(id%COLSCA(IW(IRNW+J8-1_8)) .EQ. ZERO) THEN 2225 id%COLSCA(IW(IRNW+J8-1_8)) = ONE 2226 ENDIF 2227 ENDIF 2228 105 CONTINUE 2229 ENDIF 2230 ELSE 2231 IDENT = .FALSE. 2232 IF(SCALINGLOC) THEN 2233 IF ( associated(id%COLSCA)) DEALLOCATE( id%COLSCA ) 2234 IF ( associated(id%ROWSCA)) DEALLOCATE( id%ROWSCA ) 2235 ALLOCATE( id%COLSCA(N), stat=allocok) 2236 IF (allocok .GT.0) THEN 2237 id%INFO(1)=-5 2238 id%INFO(2)=N 2239 IF ((LP.GE.0).AND.(ICNTL(4).GE.1)) THEN 2240 WRITE (LP,'(/A)') '** Error in DMUMPS_ANA_O' 2241 WRITE (LP,'(A)') 2242 & '** Failure during allocation of COLSCA' 2243 GOTO 500 2244 ENDIF 2245 ENDIF 2246 ALLOCATE( id%ROWSCA(N), stat=allocok) 2247 IF (allocok .GT.0) THEN 2248 id%INFO(1)=-5 2249 id%INFO(2)=N 2250 IF ((LP.GE.0).AND.(ICNTL(4).GE.1)) THEN 2251 WRITE (LP,'(/A)') '** Error in DMUMPS_ANA_O' 2252 WRITE (LP,'(A)') 2253 & '** Failure during allocation of ROWSCA' 2254 GOTO 500 2255 ENDIF 2256 ENDIF 2257 id%KEEP(52) = -2 2258 id%KEEP(74) = 1 2259 MAXDBL = log(huge(MAXDBL)) 2260 DO J=1,N 2261 J8 = int(J,8) 2262 IF(S2(RSPOS+J8)+S2(CSPOS+J8) .GT. MAXDBL) THEN 2263 S2(RSPOS+J8) = ZERO 2264 S2(CSPOS+J8)= ZERO 2265 ENDIF 2266 ENDDO 2267 DO J=1,N 2268 J8 = int(J,8) 2269 IF(PERM(J) .GT. 0) THEN 2270 id%ROWSCA(J) = 2271 & exp((S2(RSPOS+J8)+S2(CSPOS+J8))/TWO) 2272 IF(id%ROWSCA(J) .EQ. ZERO) THEN 2273 id%ROWSCA(J) = ONE 2274 ENDIF 2275 id%COLSCA(J)= id%ROWSCA(J) 2276 ENDIF 2277 ENDDO 2278 DO JPOS=1,KER_SIZE 2279 I = STR_KER(JPOS) 2280 COLNORM = ZERO 2281 DO K = IPE(I),IPE(I+1) - 1 2282 IF ( PERM( IW( IRNW+K-1_8) ) > 0 ) THEN 2283 COLNORM = max(COLNORM,S2(J)) 2284 ENDIF 2285 ENDDO 2286 COLNORM = exp(COLNORM) 2287 id%ROWSCA(I) = ONE / COLNORM 2288 id%COLSCA(I) = id%ROWSCA(I) 2289 ENDDO 2290 ENDIF 2291 IF(MTRANS .EQ. 7 .OR. id%KEEP(95) .EQ. 0) THEN 2292 IF( (NZER_DIAG+RZ_DIAG) .LT. (N/10) 2293 & .AND. id%KEEP(95) .EQ. 0) THEN 2294 MTRANS = 0 2295 id%KEEP(95) = 1 2296 GOTO 390 2297 ELSE 2298 IF(id%KEEP(95) .EQ. 0) THEN 2299 IF(SCALINGLOC) THEN 2300 id%KEEP(95) = 3 2301 ELSE 2302 id%KEEP(95) = 2 2303 ENDIF 2304 ENDIF 2305 IF(MTRANS .EQ. 7) MTRANS = 5 2306 ENDIF 2307 ENDIF 2308 IF(MTRANS .EQ. 0) GOTO 390 2309 ICNTL_SYM_MWM = 0 2310 INFO_SYM_MWM = 0 2311 IF(MTRANS .EQ. 5 .OR. MTRANS .EQ. 6 .OR. 2312 & MTRANS .EQ. 7) THEN 2313 ICNTL_SYM_MWM(1) = 0 2314 ICNTL_SYM_MWM(2) = 1 2315 ELSE IF(MTRANS .EQ. 4) THEN 2316 ICNTL_SYM_MWM(1) = 2 2317 ICNTL_SYM_MWM(2) = 1 2318 ELSE 2319 ICNTL_SYM_MWM(1) = 0 2320 ICNTL_SYM_MWM(2) = 1 2321 ENDIF 2322 MARKED => id%IS1(2*N+1:3*N) 2323 FLAG => id%IS1(3*N+1:4*N) 2324 PIV_OUT => id%IS1(4*N+1:5*N) 2325 IF(MTRANSLOC .LT. 4) THEN 2326 LSC = 1 2327 ELSE 2328 LSC = 2*N 2329 ENDIF 2330 CALL DMUMPS_SYM_MWM( 2331 & N, NZREAL, IPE, IW(IRNW), S2(1),LSC, PERM, 2332 & ZERODIAG(1), 2333 & ICNTL_SYM_MWM, S2(LSC+1),MARKED(1),FLAG(1), 2334 & PIV_OUT(1), INFO_SYM_MWM) 2335 IF(INFO_SYM_MWM(1) .NE. 0) THEN 2336 WRITE(*,*) '** Error in DMUMPS_ANA_O' 2337 RETURN 2338 ENDIF 2339 IF(INFO_SYM_MWM(3) .EQ. N) THEN 2340 IDENT = .TRUE. 2341 ELSEIF( (N-INFO_SYM_MWM(4)-INFO_SYM_MWM(3)) .GT. N/10 2342 & ) THEN 2343 IDENT = .TRUE. 2344 id%KEEP(95) = 1 2345 ELSE 2346 DO I=1,N 2347 PERM(I) = PIV_OUT(I) 2348 ENDDO 2349 ENDIF 2350 id%KEEP(93) = INFO_SYM_MWM(4) 2351 id%KEEP(94) = INFO_SYM_MWM(3) 2352 IF (IDENT) MTRANS=0 2353 ENDIF 2354 390 IF(MTRANS .EQ. 0) THEN 2355 id%KEEP(95) = 1 2356 IF (PROK) THEN 2357 WRITE (MPRINT,'(A)') 2358 & ' ... Column permutation not used' 2359 ENDIF 2360 ENDIF 2361 GO TO 500 2362 400 IF ((LP.GE.0).AND.(ICNTL(4).GE.1)) 2363 & WRITE (LP,'(/A)') '** Error: Matrix is structurally singular' 2364 INFO(1) = -6 2365 INFO(2) = NUMNZ 2366 GOTO 500 2367 410 IF ((LP.GE.0).AND.(ICNTL(4).GE.1)) THEN 2368 WRITE (LP,'(/A)') '** Error in DMUMPS_ANA_O' 2369 WRITE (LP,'(A,I14)') 2370 & '** Failure during allocation of INTEGER array of size ', 2371 & LIWG 2372 ENDIF 2373 INFO(1) = -7 2374 CALL MUMPS_SET_IERROR(LIWG,INFO(2)) 2375 GOTO 500 2376 430 IF ((LP.GE.0).AND.(ICNTL(4).GE.1)) THEN 2377 WRITE (LP,'(/A)') '** Error in DMUMPS_ANA_O' 2378 WRITE (LP,'(A)') '** Failure during allocation of S2' 2379 ENDIF 2380 INFO(1) = -5 2381 CALL MUMPS_SET_IERROR(LDW,INFO(2)) 2382 500 CONTINUE 2383 IF (allocated(IW)) DEALLOCATE(IW) 2384 IF (allocated(S2)) DEALLOCATE(S2) 2385 IF (allocated(IPE)) DEALLOCATE(IPE) 2386 IF (allocated(IPQ8)) DEALLOCATE(IPQ8) 2387 RETURN 2388 END SUBROUTINE DMUMPS_ANA_O 2389 SUBROUTINE DMUMPS_DIAG_ANA 2390 &( MYID, COMM, KEEP,KEEP8, INFO, INFOG, RINFO, RINFOG, ICNTL ) 2391 IMPLICIT NONE 2392 INTEGER COMM, MYID, KEEP(500), INFO(40), ICNTL(40), INFOG(40) 2393 INTEGER(8) KEEP8(150) 2394 DOUBLE PRECISION RINFO(40), RINFOG(40) 2395 INCLUDE 'mpif.h' 2396 INTEGER MASTER, MPG 2397 PARAMETER( MASTER = 0 ) 2398 MPG = ICNTL(3) 2399 IF ( MYID.eq.MASTER.and.MPG.GT.0.AND.ICNTL(4).GE.2) THEN 2400 WRITE(MPG, 99992) INFO(1), INFO(2), 2401 & KEEP8(109), KEEP8(111), INFOG(4), 2402 & INFOG(5), KEEP(28), INFOG(32), INFOG(7), KEEP(23), ICNTL(7), 2403 & KEEP(12), KEEP(56), KEEP(61), RINFOG(1) 2404 IF (KEEP(95).GT.1) 2405 & WRITE(MPG, 99993) KEEP(95) 2406 IF (KEEP(54).GT.0) WRITE(MPG, 99994) KEEP(54) 2407 IF (KEEP(60).GT.0) WRITE(MPG, 99995) KEEP(60) 2408 IF (KEEP(253).GT.0) WRITE(MPG, 99996) KEEP(253) 2409 ENDIF 2410 RETURN 241199992 FORMAT(/'Leaving analysis phase with ...'/ 2412 & 'INFOG(1) =',I16/ 2413 & 'INFOG(2) =',I16/ 2414 & ' -- (20) Number of entries in factors (estim.) =',I16/ 2415 & ' -- (3) Storage of factors (REAL, estimated) =',I16/ 2416 & ' -- (4) Storage of factors (INT , estimated) =',I16/ 2417 & ' -- (5) Maximum frontal size (estimated) =',I16/ 2418 & ' -- (6) Number of nodes in the tree =',I16/ 2419 & ' -- (32) Type of analysis effectively used =',I16/ 2420 & ' -- (7) Ordering option effectively used =',I16/ 2421 & 'ICNTL(6) Maximum transversal option =',I16/ 2422 & 'ICNTL(7) Pivot order option =',I16/ 2423 & 'Percentage of memory relaxation (effective) =',I16/ 2424 & 'Number of level 2 nodes =',I16/ 2425 & 'Number of split nodes =',I16/ 2426 & 'RINFOG(1) Operations during elimination (estim)= ',1PD10.3) 242799993 FORMAT('Ordering compressed/constrained (ICNTL(12)) =',I16) 242899994 FORMAT('Distributed matrix entry format (ICNTL(18)) =',I16) 242999995 FORMAT('Effective Schur option (ICNTL(19)) =',I16) 243099996 FORMAT('Forward solution during factorization, NRHS =',I16) 2431 END SUBROUTINE DMUMPS_DIAG_ANA 2432 SUBROUTINE DMUMPS_CUTNODES 2433 & ( N, FRERE, FILS, NFSIZ, NSTEPS, NSLAVES, 2434 & KEEP, KEEP8, SPLITROOT, MP, LDIAG, INFO1, INFO2 ) 2435 IMPLICIT NONE 2436 INTEGER N, NSTEPS, NSLAVES, KEEP(500) 2437 INTEGER(8) KEEP8(150) 2438 INTEGER FRERE( N ), FILS( N ), NFSIZ( N ) 2439 LOGICAL SPLITROOT 2440 INTEGER MP, LDIAG 2441 INTEGER INFO1, INFO2 2442 INTEGER, DIMENSION(:), ALLOCATABLE :: IPOOL 2443 INTEGER INODE, DEPTH, I, IBEG, IEND, IIPOOL, NROOT 2444 INTEGER MAX_DEPTH, ISON, TOT_CUT, MAX_CUT, STRAT 2445 INTEGER(8) :: K79 2446 INTEGER NFRONT, K82, allocok 2447 K79 = KEEP8(79) 2448 K82 = abs(KEEP(82)) 2449 STRAT= KEEP(62) 2450 IF (KEEP(210).EQ.1) THEN 2451 MAX_DEPTH = 2*NSLAVES*K82 2452 STRAT = STRAT/4 2453 ELSE 2454 IF (( NSLAVES .eq. 1 ).AND. (.NOT. SPLITROOT) ) RETURN 2455 IF (NSLAVES.EQ.1) THEN 2456 MAX_DEPTH=1 2457 ELSE 2458 MAX_DEPTH = int( log( dble( NSLAVES - 1 ) ) 2459 & / log(2.0D0) ) 2460 ENDIF 2461 ENDIF 2462 ALLOCATE(IPOOL(NSTEPS+1), stat=allocok) 2463 IF (allocok.GT.0) THEN 2464 INFO1= -7 2465 INFO2= NSTEPS+1 2466 RETURN 2467 ENDIF 2468 NROOT = 0 2469 DO INODE = 1, N 2470 IF ( FRERE(INODE) .eq. 0 ) THEN 2471 NROOT = NROOT + 1 2472 IPOOL( NROOT ) = INODE 2473 END IF 2474 END DO 2475 IBEG = 1 2476 IEND = NROOT 2477 IIPOOL = NROOT + 1 2478 IF (SPLITROOT) THEN 2479 MAX_DEPTH=0 2480 ENDIF 2481 DO DEPTH = 1, MAX_DEPTH 2482 DO I = IBEG, IEND 2483 INODE = IPOOL( I ) 2484 ISON = INODE 2485 DO WHILE ( ISON .GT. 0 ) 2486 ISON = FILS( ISON ) 2487 END DO 2488 ISON = - ISON 2489 DO WHILE ( ISON .GT. 0 ) 2490 IPOOL( IIPOOL ) = ISON 2491 IIPOOL = IIPOOL + 1 2492 ISON = FRERE( ISON ) 2493 END DO 2494 END DO 2495 IPOOL( IBEG ) = -IPOOL( IBEG ) 2496 IBEG = IEND + 1 2497 IEND = IIPOOL - 1 2498 END DO 2499 IPOOL( IBEG ) = -IPOOL( IBEG ) 2500 TOT_CUT = 0 2501 IF (SPLITROOT) THEN 2502 MAX_CUT = NROOT*max(K82,2) 2503 INODE = abs(IPOOL(1)) 2504 NFRONT = NFSIZ( INODE ) 2505 K79 = max( 2506 & int(NFRONT,8)*int(NFRONT,8)/(int(K82+1,8)*int(K82+1,8)), 2507 & 1_8) 2508 IF (KEEP(53).NE.0) THEN 2509 MAX_CUT = NFRONT 2510 K79 = 121_8*121_8 2511 ELSE 2512 K79 = min(2000_8*2000_8,K79) 2513 ENDIF 2514 ELSE 2515 MAX_CUT = 2 * NSLAVES 2516 IF (KEEP(210).EQ.1) THEN 2517 MAX_CUT = 4 * (MAX_CUT + 4) 2518 ENDIF 2519 ENDIF 2520 DEPTH = -1 2521 DO I = 1, IIPOOL - 1 2522 INODE = IPOOL( I ) 2523 IF ( INODE .LT. 0 ) THEN 2524 INODE = -INODE 2525 DEPTH = DEPTH + 1 2526 END IF 2527 CALL DMUMPS_SPLIT_1NODE 2528 & ( INODE, N, FRERE, FILS, NFSIZ, NSTEPS, NSLAVES, 2529 & KEEP,KEEP8, TOT_CUT, STRAT, DEPTH, 2530 & K79, SPLITROOT, MP, LDIAG ) 2531 IF ( TOT_CUT > MAX_CUT ) EXIT 2532 END DO 2533 KEEP(61) = TOT_CUT 2534 DEALLOCATE(IPOOL) 2535 RETURN 2536 END SUBROUTINE DMUMPS_CUTNODES 2537 RECURSIVE SUBROUTINE DMUMPS_SPLIT_1NODE 2538 & ( INODE, N, FRERE, FILS, NFSIZ, NSTEPS, NSLAVES, KEEP,KEEP8, 2539 & TOT_CUT, STRAT, DEPTH, K79, SPLITROOT, MP, LDIAG ) 2540 IMPLICIT NONE 2541 INTEGER(8) :: K79 2542 INTEGER INODE, N, NSTEPS, NSLAVES, KEEP(500), STRAT, 2543 & DEPTH, TOT_CUT, MP, LDIAG 2544 INTEGER(8) KEEP8(150) 2545 INTEGER FRERE( N ), FILS( N ), NFSIZ( N ) 2546 LOGICAL SPLITROOT 2547 INTEGER I, IN, NPIV, NFRONT, NSLAVES_ESTIM 2548 DOUBLE PRECISION WK_SLAVE, WK_MASTER 2549 INTEGER INODE_SON, INODE_FATH, IN_SON, IN_FATH, IN_GRANDFATH 2550 INTEGER NPIV_SON, NPIV_FATH 2551 INTEGER NCB, NSLAVESMIN, NSLAVESMAX 2552 INTEGER MUMPS_BLOC2_GET_NSLAVESMIN, 2553 & MUMPS_BLOC2_GET_NSLAVESMAX 2554 EXTERNAL MUMPS_BLOC2_GET_NSLAVESMIN, 2555 & MUMPS_BLOC2_GET_NSLAVESMAX 2556 IF ( (KEEP(210).EQ.1.AND.KEEP(60).EQ.0) .OR. 2557 & (SPLITROOT) ) THEN 2558 IF ( FRERE ( INODE ) .eq. 0 ) THEN 2559 NFRONT = NFSIZ( INODE ) 2560 NPIV = NFRONT 2561 NCB = 0 2562 IF ( int(NFRONT,8)*int(NFRONT,8).GT.K79 2563 & ) THEN 2564 GOTO 333 2565 ENDIF 2566 ENDIF 2567 ENDIF 2568 IF ( FRERE ( INODE ) .eq. 0 ) RETURN 2569 NFRONT = NFSIZ( INODE ) 2570 IN = INODE 2571 NPIV = 0 2572 DO WHILE( IN > 0 ) 2573 IN = FILS( IN ) 2574 NPIV = NPIV + 1 2575 END DO 2576 NCB = NFRONT - NPIV 2577 IF ( (NFRONT - (NPIV/2)) .LE. KEEP(9)) RETURN 2578 IF ((KEEP(50) == 0.and.int(NFRONT,8) * int(NPIV,8) > K79 ) .OR. 2579 &(KEEP(50) .NE.0.and.int(NPIV,8) * int(NPIV,8) > K79 )) GOTO 333 2580 IF (KEEP(210).EQ.1) THEN 2581 NSLAVESMIN = 1 2582 NSLAVESMAX = 64 2583 NSLAVES_ESTIM = 32+NSLAVES 2584 ELSE 2585 NSLAVESMIN = MUMPS_BLOC2_GET_NSLAVESMIN 2586 & ( NSLAVES, KEEP(48), KEEP8(21), KEEP(50), 2587 & NFRONT, NCB, KEEP(375)) 2588 NSLAVESMAX = MUMPS_BLOC2_GET_NSLAVESMAX 2589 & ( NSLAVES, KEEP(48), KEEP8(21), KEEP(50), 2590 & NFRONT, NCB, KEEP(375)) 2591 NSLAVES_ESTIM = max (1, 2592 & nint( dble(NSLAVESMAX-NSLAVESMIN)/dble(3) ) 2593 & ) 2594 NSLAVES_ESTIM = min (NSLAVES_ESTIM, NSLAVES-1) 2595 ENDIF 2596 IF ( KEEP(50) .eq. 0 ) THEN 2597 WK_MASTER = 0.6667D0 * 2598 & dble(NPIV)*dble(NPIV)*dble(NPIV) + 2599 & dble(NPIV)*dble(NPIV)*dble(NCB) 2600 WK_SLAVE = dble( NPIV ) * dble( NCB ) * 2601 & ( 2.0D0 * dble(NFRONT) - dble(NPIV) ) 2602 & / dble(NSLAVES_ESTIM) 2603 ELSE 2604 WK_MASTER = dble(NPIV)*dble(NPIV)*dble(NPIV) / dble(3) 2605 WK_SLAVE = 2606 & (dble(NPIV)*dble(NCB)*dble(NFRONT)) 2607 & / dble(NSLAVES_ESTIM) 2608 ENDIF 2609 IF (KEEP(210).EQ.1) THEN 2610 IF ( dble( 100 + STRAT ) 2611 & * WK_SLAVE / dble(100) .GE. WK_MASTER ) RETURN 2612 ELSE 2613 IF ( dble( 100 + STRAT * max( DEPTH-1, 1 ) ) 2614 & * WK_SLAVE / dble(100) .GE. WK_MASTER ) RETURN 2615 ENDIF 2616 333 CONTINUE 2617 IF (NPIV .LE. 1 ) RETURN 2618 NSTEPS = NSTEPS + 1 2619 TOT_CUT = TOT_CUT + 1 2620 NPIV_SON = max(NPIV/2,1) 2621 NPIV_FATH = NPIV - NPIV_SON 2622 IF (SPLITROOT) THEN 2623 IF (NCB .NE .0) THEN 2624 WRITE(*,*) "Error splitting" 2625 CALL MUMPS_ABORT() 2626 ENDIF 2627 NPIV_FATH = min(int(sqrt(dble(K79))), int(NPIV/2)) 2628 NPIV_SON = NPIV - NPIV_FATH 2629 ENDIF 2630 INODE_SON = INODE 2631 IN_SON = INODE 2632 DO I = 1, NPIV_SON - 1 2633 IN_SON = FILS( IN_SON ) 2634 END DO 2635 INODE_FATH = FILS( IN_SON ) 2636 IF ( INODE_FATH .LT. 0 ) THEN 2637 write(*,*) 'Error: INODE_FATH < 0 ', INODE_FATH 2638 END IF 2639 IN_FATH = INODE_FATH 2640 DO WHILE ( FILS( IN_FATH ) > 0 ) 2641 IN_FATH = FILS( IN_FATH ) 2642 END DO 2643 FRERE( INODE_FATH ) = FRERE( INODE_SON ) 2644 FRERE( INODE_SON ) = - INODE_FATH 2645 FILS ( IN_SON ) = FILS( IN_FATH ) 2646 FILS ( IN_FATH ) = - INODE_SON 2647 IN = FRERE( INODE_FATH ) 2648 DO WHILE ( IN > 0 ) 2649 IN = FRERE( IN ) 2650 END DO 2651 IF ( IN .eq. 0 ) GO TO 10 2652 IN = -IN 2653 DO WHILE ( FILS( IN ) > 0 ) 2654 IN = FILS( IN ) 2655 END DO 2656 IN_GRANDFATH = IN 2657 IF ( FILS( IN_GRANDFATH ) .eq. - INODE_SON ) THEN 2658 FILS( IN_GRANDFATH ) = -INODE_FATH 2659 ELSE 2660 IN = IN_GRANDFATH 2661 IN = - FILS ( IN ) 2662 DO WHILE ( FRERE( IN ) > 0 ) 2663 IF ( FRERE( IN ) .eq. INODE_SON ) THEN 2664 FRERE( IN ) = INODE_FATH 2665 GOTO 10 2666 END IF 2667 IN = FRERE( IN ) 2668 END DO 2669 WRITE(*,*) 'ERROR 2 in SPLIT NODE', 2670 & IN_GRANDFATH, IN, FRERE(IN) 2671 END IF 2672 10 CONTINUE 2673 NFSIZ(INODE_SON) = NFRONT 2674 NFSIZ(INODE_FATH) = NFRONT - NPIV_SON 2675 KEEP(2) = max( KEEP(2), NFRONT - NPIV_SON ) 2676 IF (SPLITROOT) THEN 2677 RETURN 2678 ENDIF 2679 CALL DMUMPS_SPLIT_1NODE 2680 & ( INODE_FATH, N, FRERE, FILS, NFSIZ, NSTEPS, 2681 & NSLAVES, KEEP,KEEP8, TOT_CUT, STRAT, DEPTH, 2682 & K79, SPLITROOT, MP, LDIAG ) 2683 IF (.NOT. SPLITROOT) THEN 2684 CALL DMUMPS_SPLIT_1NODE 2685 & ( INODE_SON, N, FRERE, FILS, NFSIZ, NSTEPS, 2686 & NSLAVES, KEEP,KEEP8, TOT_CUT, STRAT, DEPTH, 2687 & K79, SPLITROOT, MP, LDIAG ) 2688 ENDIF 2689 RETURN 2690 END SUBROUTINE DMUMPS_SPLIT_1NODE 2691 SUBROUTINE DMUMPS_ANA_GNEW 2692 & (N, NZ, IRN, ICN, IW, LW, IPE, LEN, 2693 & IQ, FLAG, IWFR, 2694 & NRORM, NIORM, IFLAG,IERROR, ICNTL, 2695 & symmetry, SYM, NBQD, AvgDens, 2696 & KEEP264, KEEP265) 2697 IMPLICIT NONE 2698 INTEGER, intent(in) :: N, SYM 2699 INTEGER(8), intent(in) :: LW 2700 INTEGER(8), intent(in) :: NZ 2701 INTEGER, intent(in) :: ICNTL(40) 2702 INTEGER, intent(in) :: IRN(NZ), ICN(NZ) 2703 INTEGER, intent(out) :: IERROR, symmetry 2704 INTEGER, intent(out) :: NBQD, AvgDens 2705 INTEGER, intent(out) :: LEN(N), IW(LW) 2706 INTEGER(8), intent(out):: IWFR 2707 INTEGER(8), intent(out):: NRORM, NIORM 2708 INTEGER(8), intent(out):: IPE(N+1) 2709 INTEGER, intent(inout) :: IFLAG, KEEP264, KEEP265 2710 INTEGER(8), intent(out):: IQ(N) 2711 INTEGER, intent(out) :: FLAG(N) 2712 INTEGER :: MP, MPG, I, J, N1 2713 INTEGER :: NBERR, THRESH 2714 INTEGER(8) :: K8, K1, K2, LAST, NDUP 2715 INTEGER(8) :: NZOFFA, NDIAGA, L, N8 2716 DOUBLE PRECISION :: RSYM 2717 INTRINSIC nint 2718 MP = ICNTL(2) 2719 MPG= ICNTL(3) 2720 NZOFFA = 0_8 2721 NDIAGA = 0 2722 IERROR = 0 2723 N8 = int(N,8) 2724 DO I=1,N+1 2725 IPE(I) = 0_8 2726 ENDDO 2727 IF (KEEP264.EQ.0) THEN 2728 IF ((SYM.EQ.0).AND.(KEEP265.EQ.-1)) THEN 2729 DO K8=1_8,NZ 2730 I = IRN(K8) 2731 J = ICN(K8) 2732 IF ((I.GT.N).OR.(J.GT.N).OR.(I.LT.1) 2733 & .OR.(J.LT.1)) THEN 2734 IERROR = IERROR + 1 2735 ELSE 2736 IF (I.NE.J) THEN 2737 IPE(I) = IPE(I) + 1_8 2738 NZOFFA = NZOFFA + 1_8 2739 ELSE 2740 NDIAGA = NDIAGA + 1_8 2741 ENDIF 2742 ENDIF 2743 ENDDO 2744 ELSE 2745 DO K8=1_8,NZ 2746 I = IRN(K8) 2747 J = ICN(K8) 2748 IF ((I.GT.N).OR.(J.GT.N).OR.(I.LT.1) 2749 & .OR.(J.LT.1)) THEN 2750 IERROR = IERROR + 1 2751 ELSE 2752 IF (I.NE.J) THEN 2753 IPE(I) = IPE(I) + 1_8 2754 IPE(J) = IPE(J) + 1_8 2755 NZOFFA = NZOFFA + 1_8 2756 ELSE 2757 NDIAGA = NDIAGA + 1_8 2758 ENDIF 2759 ENDIF 2760 ENDDO 2761 ENDIF 2762 IF (IERROR.GE.1) THEN 2763 KEEP264 = 0 2764 ELSE 2765 KEEP264 = 1 2766 ENDIF 2767 ELSE 2768 IF ((SYM.EQ.0).AND.(KEEP265.EQ.-1)) THEN 2769 DO K8=1_8,NZ 2770 I = IRN(K8) 2771 J = ICN(K8) 2772 IF (I.EQ.J) THEN 2773 NDIAGA = NDIAGA + 1_8 2774 ELSE 2775 IPE(I) = IPE(I) + 1_8 2776 NZOFFA = NZOFFA + 1_8 2777 ENDIF 2778 ENDDO 2779 ELSE 2780 DO K8=1_8,NZ 2781 I = IRN(K8) 2782 J = ICN(K8) 2783 IF (I.NE.J) THEN 2784 IPE(I) = IPE(I) + 1_8 2785 IPE(J) = IPE(J) + 1_8 2786 NZOFFA = NZOFFA + 1_8 2787 ELSE 2788 NDIAGA = NDIAGA + 1_8 2789 ENDIF 2790 ENDDO 2791 ENDIF 2792 ENDIF 2793 NIORM = NZOFFA + 3_8*N8 2794 IF (IERROR.GE.1) THEN 2795 NBERR = 0 2796 IF (mod(IFLAG,2) .EQ. 0) IFLAG = IFLAG+1 2797 IF ((MP.GT.0).AND.(ICNTL(4).GE.2)) THEN 2798 WRITE (MP,99999) 2799 DO 70 K8=1_8,NZ 2800 I = IRN(K8) 2801 J = ICN(K8) 2802 IF ((I.GT.N).OR.(J.GT.N).OR.(I.LT.1) 2803 & .OR.(J.LT.1)) THEN 2804 NBERR = NBERR + 1 2805 IF (NBERR.LE.10) THEN 2806 IF (mod(K8,10_8).GT.3_8 .OR. mod(K8,10_8).EQ.0_8 .OR. 2807 & (10_8.LE.K8 .AND. K8.LE.20_8)) THEN 2808 WRITE (MP,'(I16,A,I10,A,I10,A)') 2809 & K8,'th entry (in row',I,' and column',J,') ignored' 2810 ELSE 2811 IF (mod(K8,10_8).EQ.1_8) 2812 & WRITE(MP,'(I16,A,I10,A,I10,A)') 2813 & K8,'st entry (in row',I,' and column',J,') ignored' 2814 IF (mod(K8,10_8).EQ.2_8) 2815 & WRITE(MP,'(I16,A,I10,A,I10,A)') 2816 & K8,'nd entry (in row',I,' and column',J,') ignored' 2817 IF (mod(K8,10_8).EQ.3_8) 2818 & WRITE(MP,'(I16,A,I10,A,I10,A)') 2819 & K8,'rd entry (in row',I,' and column',J,') ignored' 2820 ENDIF 2821 ELSE 2822 GO TO 100 2823 ENDIF 2824 ENDIF 2825 70 CONTINUE 2826 ENDIF 2827 ENDIF 2828 100 NRORM = NIORM - 2_8*N8 2829 IQ(1) = 1_8 2830 N1 = N - 1 2831 IF (N1.GT.0) THEN 2832 DO I=1,N1 2833 IQ(I+1) = IPE(I) + IQ(I) 2834 ENDDO 2835 ENDIF 2836 LAST = max(IPE(N)+IQ(N)-1,IQ(N)) 2837 FLAG(1:N) = 0 2838 IPE(1:N) = IQ(1:N) 2839 IW(1:LAST) = 0 2840 IWFR = LAST + 1_8 2841 IF (KEEP264 .EQ. 0) THEN 2842 IF ((SYM.EQ.0).AND.(KEEP265.EQ.-1)) THEN 2843 DO K8=1_8,NZ 2844 I = IRN(K8) 2845 J = ICN(K8) 2846 IF (I.NE.J) THEN 2847 IF ((J.GE.1).AND.(I.LE.N)) THEN 2848 IW(IQ(I)) = J 2849 IQ(I) = IQ(I) + 1 2850 ENDIF 2851 ENDIF 2852 ENDDO 2853 ELSE IF (KEEP265.EQ.1) THEN 2854 DO K8=1_8,NZ 2855 I = IRN(K8) 2856 J = ICN(K8) 2857 IF (I.NE.J) THEN 2858 IF ((J.GE.1).AND.(I.LE.N)) THEN 2859 IW(IQ(J)) = I 2860 IQ(J) = IQ(J) + 1 2861 IW(IQ(I)) = J 2862 IQ(I) = IQ(I) + 1 2863 ENDIF 2864 ENDIF 2865 ENDDO 2866 ELSE 2867 DO K8=1_8,NZ 2868 I = IRN(K8) 2869 J = ICN(K8) 2870 IF (I.NE.J) THEN 2871 IF (I.LT.J) THEN 2872 IF ((I.GE.1).AND.(J.LE.N)) THEN 2873 IW(IQ(I)) = -J 2874 IQ(I) = IQ(I) + 1 2875 ENDIF 2876 ELSE 2877 IF ((J.GE.1).AND.(I.LE.N)) THEN 2878 IW(IQ(J)) = -I 2879 IQ(J) = IQ(J) + 1 2880 ENDIF 2881 ENDIF 2882 ENDIF 2883 ENDDO 2884 ENDIF 2885 ELSE 2886 IF ((SYM.EQ.0).AND.(KEEP265.EQ.-1)) THEN 2887 DO K8=1_8,NZ 2888 I = IRN(K8) 2889 J = ICN(K8) 2890 IF (I.NE.J) THEN 2891 IW(IQ(I)) = J 2892 IQ(I) = IQ(I) + 1 2893 ENDIF 2894 ENDDO 2895 ELSE IF (KEEP265.EQ.1) THEN 2896 DO K8=1_8,NZ 2897 I = IRN(K8) 2898 J = ICN(K8) 2899 IF (I.NE.J) THEN 2900 IW(IQ(J)) = I 2901 IQ(J) = IQ(J) + 1 2902 IW(IQ(I)) = J 2903 IQ(I) = IQ(I) + 1 2904 ENDIF 2905 ENDDO 2906 ELSE 2907 DO K8=1_8,NZ 2908 I = IRN(K8) 2909 J = ICN(K8) 2910 IF (I.NE.J) THEN 2911 IF (I.LT.J) THEN 2912 IW(IQ(I)) = -J 2913 IQ(I) = IQ(I) + 1 2914 ELSE 2915 IW(IQ(J)) = -I 2916 IQ(J) = IQ(J) + 1 2917 ENDIF 2918 ENDIF 2919 ENDDO 2920 ENDIF 2921 ENDIF 2922 IF (KEEP265.EQ.0) THEN 2923 NDUP = 0_8 2924 DO I=1,N 2925 K1 = IPE(I) 2926 K2 = IQ(I) - 1_8 2927 IF (K1.GT.K2) THEN 2928 LEN(I) = 0 2929 ELSE 2930 DO K8=K1,K2 2931 J = -IW(K8) 2932 IF (J.LE.0) EXIT 2933 L = IQ(J) 2934 IQ(J) = L + 1 2935 IF (FLAG(J).EQ.I) THEN 2936 NDUP = NDUP + 1_8 2937 IW(K8) = 0 2938 ELSE 2939 IW(L) = I 2940 IW(K8) = J 2941 FLAG(J) = I 2942 ENDIF 2943 END DO 2944 LEN(I) = int((IQ(I) - IPE(I))) 2945 ENDIF 2946 ENDDO 2947 IF (NDUP.NE.0_8) THEN 2948 IWFR = 1_8 2949 DO I=1,N 2950 IF (LEN(I).EQ.0) THEN 2951 IPE(I) = IWFR 2952 CYCLE 2953 ENDIF 2954 K1 = IPE(I) 2955 K2 = K1 + LEN(I) - 1 2956 L = IWFR 2957 IPE(I) = IWFR 2958 DO 270 K8=K1,K2 2959 IF (IW(K8).NE.0) THEN 2960 IW(IWFR) = IW(K8) 2961 IWFR = IWFR + 1_8 2962 ENDIF 2963 270 CONTINUE 2964 LEN(I) = int(IWFR - L) 2965 ENDDO 2966 ELSE 2967 KEEP265 = 1 2968 ENDIF 2969 IPE(N+1) = IPE(N) + int(LEN(N),8) 2970 IWFR = IPE(N+1) 2971 ELSE 2972 IPE(1) = 1_8 2973 DO I = 1, N 2974 LEN(I) = int(IQ(I) - IPE(I)) 2975 ENDDO 2976 DO I = 1, N 2977 IPE(I+1) = IPE(I) + int(LEN(I),8) 2978 ENDDO 2979 IWFR = IPE(N+1) 2980 ENDIF 2981 symmetry = 100 2982 IF (SYM.EQ.0) THEN 2983 RSYM = dble(NDIAGA+2_8*NZOFFA - (IWFR-1_8))/ 2984 & dble(NZOFFA+NDIAGA) 2985 IF ((KEEP265.EQ.0) .AND. (NZOFFA - (IWFR-1_8)).EQ.0_8) THEN 2986 KEEP265 = -1 2987 ENDIF 2988 symmetry = min(nint (100.0D0*RSYM), 100) 2989 IF ((MPG .GT. 0).AND.(ICNTL(4).GE.2) ) 2990 & write(MPG,'(A,I5)') 2991 & ' ... Structural symmetry (in percent)=', symmetry 2992 IF (MP.GT.0 .AND. MPG.NE.MP.AND. (ICNTL(4).GE.2) ) 2993 & write(MP,'(A,I5)') 2994 & ' ... Structural symmetry (in percent)=', symmetry 2995 ELSE 2996 symmetry = 100 2997 ENDIF 2998 AvgDens = nint(dble(IWFR-1_8)/dble(N)) 2999 THRESH = AvgDens*50 - AvgDens/10 + 1 3000 NBQD = 0 3001 IF (N.GT.2) THEN 3002 DO I= 1, N 3003 J = max(LEN(I),1) 3004 IF (J.GT.THRESH) NBQD = NBQD+1 3005 ENDDO 3006 ENDIF 3007 IF (MPG .GT. 0.AND.(ICNTL(4).GE.2)) 3008 & write(MPG,'(A,1I5)') 3009 & ' Average density of rows/columns =', AvgDens 3010 IF (MP.GT.0 .AND. MPG.NE.MP.AND.(ICNTL(4).GE.2)) 3011 & write(MP,'(A,1I5)') 3012 & ' Average density of rows/columns =', AvgDens 3013 RETURN 301499999 FORMAT (/'*** Warning message from analysis routine ***') 3015 END SUBROUTINE DMUMPS_ANA_GNEW 3016 SUBROUTINE DMUMPS_SET_K821_SURFACE 3017 & (KEEP821, KEEP2, KEEP48 ,KEEP50, NSLAVES) 3018 IMPLICIT NONE 3019 INTEGER NSLAVES, KEEP2, KEEP48, KEEP50 3020 INTEGER (8) :: KEEP821 3021 INTEGER(8) KEEP2_SQUARE, NSLAVES8 3022 NSLAVES8= int(NSLAVES,8) 3023 KEEP2_SQUARE = int(KEEP2,8) * int(KEEP2,8) 3024 KEEP821 = max(KEEP821*int(KEEP2,8),1_8) 3025#if defined(t3e) 3026 KEEP821 = min(1500000_8, KEEP821) 3027#elif defined(SP_) 3028 KEEP821 = min(3000000_8, KEEP821) 3029#else 3030 KEEP821 = min(2000000_8, KEEP821) 3031#endif 3032#if defined(t3e) 3033 IF (NSLAVES .GT. 64) THEN 3034 KEEP821 = 3035 & min(8_8*KEEP2_SQUARE/NSLAVES8+1_8, KEEP821) 3036 ELSE 3037 KEEP821 = 3038 & min(4_8*KEEP2_SQUARE/NSLAVES8+1_8, KEEP821) 3039 ENDIF 3040#else 3041 IF (NSLAVES.GT.64) THEN 3042 KEEP821 = 3043 & min(6_8*KEEP2_SQUARE/NSLAVES8+1_8, KEEP821) 3044 ELSE 3045 KEEP821 = 3046 & min(4_8*KEEP2_SQUARE/NSLAVES8+1_8, KEEP821) 3047 ENDIF 3048#endif 3049 IF (KEEP50 .EQ. 0 ) THEN 3050 KEEP821 = max(KEEP821,(7_8*KEEP2_SQUARE / 3051 & 4_8 / int(max(NSLAVES-1,1),8)) + int(KEEP2,8)) 3052 ELSE 3053 KEEP821 = max(KEEP821,(7_8*KEEP2_SQUARE / 3054 & 4_8 / int(max(NSLAVES-1,1),8)) + int(KEEP2,8)) 3055 ENDIF 3056 IF (KEEP50 .EQ. 0 ) THEN 3057#if defined(t3e) 3058 KEEP821 = max(KEEP821,200000_8) 3059#else 3060 KEEP821 = max(KEEP821,300000_8) 3061#endif 3062 ELSE 3063#if defined(t3e) 3064 KEEP821 = max(KEEP821,40000_8) 3065#else 3066 KEEP821 = max(KEEP821,80000_8) 3067#endif 3068 ENDIF 3069 KEEP821 = -KEEP821 3070 RETURN 3071 END SUBROUTINE DMUMPS_SET_K821_SURFACE 3072 SUBROUTINE DMUMPS_MTRANS_DRIVER(JOB,M,N,NE, 3073 & IP,IRN,A,LA,NUM,PERM,LIW,IW,LDW,DW, 3074 & IPQ8, 3075 & ICNTL,CNTL,INFO, INFOMUMPS) 3076 IMPLICIT NONE 3077 INTEGER :: NICNTL, NCNTL, NINFO, INFOMUMPS(40) 3078 PARAMETER (NICNTL=10, NCNTL=10, NINFO=10) 3079 INTEGER :: JOB,M,N,NUM 3080 INTEGER(8), INTENT(IN) :: NE, LIW,LDW, LA 3081 INTEGER(8) :: IP(N+1), IPQ8(N) 3082 INTEGER :: IRN(NE),PERM(M),IW(LIW) 3083 INTEGER :: ICNTL(NICNTL),INFO(NINFO) 3084 DOUBLE PRECISION :: A(LA) 3085 DOUBLE PRECISION :: DW(LDW),CNTL(NCNTL) 3086 INTEGER(8), DIMENSION(:), ALLOCATABLE :: IWtemp8 3087 INTEGER :: allocok 3088 INTEGER :: I,J,WARN1,WARN2,WARN4 3089 INTEGER(8) :: K 3090 DOUBLE PRECISION :: FACT,ZERO,ONE,RINF,RINF2,RINF3 3091 PARAMETER (ZERO=0.0D+00,ONE=1.0D+0) 3092 EXTERNAL DMUMPS_MTRANSZ,DMUMPS_MTRANSB,DMUMPS_MTRANSR, 3093 & DMUMPS_MTRANSS,DMUMPS_MTRANSW 3094 INTRINSIC abs,log 3095 RINF = CNTL(2) 3096 RINF2 = huge(RINF2)/dble(2*N) 3097 RINF3 = 0.0D0 3098 WARN1 = 0 3099 WARN2 = 0 3100 WARN4 = 0 3101 IF (JOB.LT.1 .OR. JOB.GT.6) THEN 3102 INFO(1) = -1 3103 INFO(2) = JOB 3104 IF (ICNTL(1).GE.0) WRITE(ICNTL(1),9001) INFO(1),'JOB',JOB 3105 GO TO 99 3106 ENDIF 3107 IF (M.LT.1 .OR. M.LT.N) THEN 3108 INFO(1) = -2 3109 INFO(2) = M 3110 IF (ICNTL(1).GE.0) WRITE(ICNTL(1),9001) INFO(1),'M',M 3111 GO TO 99 3112 ENDIF 3113 IF (N.LT.1) THEN 3114 INFO(1) = -2 3115 INFO(2) = N 3116 IF (ICNTL(1).GE.0) WRITE(ICNTL(1),9001) INFO(1),'N',N 3117 GO TO 99 3118 ENDIF 3119 IF (NE.LT.1) THEN 3120 INFO(1) = -3 3121 CALL MUMPS_SET_IERROR(NE,INFO(2)) 3122 IF (ICNTL(1).GE.0) WRITE(ICNTL(1),9001) INFO(1),'NE',NE 3123 GO TO 99 3124 ENDIF 3125 IF (JOB.EQ.1) K = int(4*N + M,8) 3126 IF (JOB.EQ.2) K = int(N + 2*M,8) 3127 IF (JOB.EQ.3) K = int(8*N + 2*M + NE,8) 3128 IF (JOB.EQ.4) K = int(N + M,8) 3129 IF (JOB.EQ.5) K = int(3*N + 2*M,8) 3130 IF (JOB.EQ.6) K = int(3*N + 2*M + NE,8) 3131 IF (LIW.LT.K) THEN 3132 INFO(1) = -4 3133 CALL MUMPS_SET_IERROR(K,INFO(2)) 3134 IF (ICNTL(1).GE.0) WRITE(ICNTL(1),9004) INFO(1),K 3135 GO TO 99 3136 ENDIF 3137 IF (JOB.GT.1) THEN 3138 IF (JOB.EQ.2) K = int( M,8) 3139 IF (JOB.EQ.3) K = int(1,8) 3140 IF (JOB.EQ.4) K = int( 2*M,8) 3141 IF (JOB.EQ.5) K = int(N + 2*M,8) 3142 IF (JOB.EQ.6) K = int(N + 3*M,8) 3143 IF (LDW .LT. K) THEN 3144 INFO(1) = -5 3145 CALL MUMPS_SET_IERROR(K,INFO(2)) 3146 IF (ICNTL(1).GE.0) WRITE(ICNTL(1),9005) INFO(1),K 3147 GO TO 99 3148 ENDIF 3149 ENDIF 3150 IF (ICNTL(5).EQ.0) THEN 3151 DO 3 I = 1,M 3152 IW(I) = 0 3153 3 CONTINUE 3154 DO 6 J = 1,N 3155 DO 4 K = IP(J),IP(J+1)-1_8 3156 I = IRN(K) 3157 IF (I.LT.1 .OR. I.GT.M) THEN 3158 INFO(1) = -6 3159 INFO(2) = J 3160 IF (ICNTL(1).GE.0) WRITE(ICNTL(1),9006) INFO(1),J,I 3161 GO TO 99 3162 ENDIF 3163 IF (IW(I).EQ.J) THEN 3164 INFO(1) = -7 3165 INFO(2) = J 3166 IF (ICNTL(1).GE.0) WRITE(ICNTL(1),9007) INFO(1),J,I 3167 GO TO 99 3168 ELSE 3169 IW(I) = J 3170 ENDIF 3171 4 CONTINUE 3172 6 CONTINUE 3173 ENDIF 3174 IF (ICNTL(3).GE.0) THEN 3175 IF (ICNTL(4).EQ.0 .OR. ICNTL(4).EQ.1) THEN 3176 WRITE(ICNTL(3),9020) JOB,M,N,NE 3177 IF (ICNTL(4).EQ.0) THEN 3178 WRITE(ICNTL(3),9021) (IP(J),J=1,min(10,N+1)) 3179 WRITE(ICNTL(3),9022) (IRN(K),K=1_8,min(10_8,NE)) 3180 IF (JOB.GT.1) WRITE(ICNTL(3),9023) 3181 & (A(K),K=1_8,min(10_8,NE)) 3182 ELSEIF (ICNTL(4).EQ.1) THEN 3183 WRITE(ICNTL(3),9021) (IP(J),J=1,N+1) 3184 WRITE(ICNTL(3),9022) (IRN(K),K=1_8,NE) 3185 IF (JOB.GT.1) WRITE(ICNTL(3),9023) (A(K),K=1_8,NE) 3186 ENDIF 3187 WRITE(ICNTL(3),9024) (ICNTL(J),J=1,NICNTL) 3188 WRITE(ICNTL(3),9025) (CNTL(J),J=1,NCNTL) 3189 ENDIF 3190 ENDIF 3191 DO 8 I=1,NINFO 3192 INFO(I) = 0 3193 8 CONTINUE 3194 IF (JOB.EQ.1) THEN 3195 DO 10 J = 1,N 3196 IW(J) = int(IP(J+1) - IP(J)) 3197 10 CONTINUE 3198 CALL DMUMPS_MTRANSZ(M,N,IRN,NE,IP,IW(1),PERM,NUM, 3199 & IW(N+1),IW(2*N+1),IW(3*N+1),IW(3*N+M+1)) 3200 GO TO 90 3201 ENDIF 3202 IF (JOB.EQ.2) THEN 3203 DW(1) = max(ZERO,CNTL(1)) 3204 CALL DMUMPS_MTRANSB(M,N,NE,IP,IRN,A,PERM,NUM, 3205 & IW(1),IPQ8,IW(N+1),IW(N+M+1),DW,RINF2) 3206 GO TO 90 3207 ENDIF 3208 IF (JOB.EQ.3) THEN 3209 DO 20 K = 1,NE 3210 IW(K) = IRN(K) 3211 20 CONTINUE 3212 CALL DMUMPS_MTRANSR(N,NE,IP,IW,A) 3213 FACT = max(ZERO,CNTL(1)) 3214 CALL DMUMPS_MTRANSS(M,N,NE,IP,IW(1),A,PERM,NUM,IW(NE+1), 3215 & IW(NE+N+1),IW(NE+2*N+1),IW(NE+3*N+1),IW(NE+4*N+1), 3216 & IW(NE+5*N+1),IW(NE+5*N+M+1),FACT,RINF2) 3217 GO TO 90 3218 ENDIF 3219 IF ((JOB.EQ.4).OR.(JOB.EQ.5).or.(JOB.EQ.6)) THEN 3220 ALLOCATE(IWtemp8(M+N+N), stat=allocok) 3221 IF (allocok.GT.0) THEN 3222 INFOMUMPS(1) = -7 3223 INFOMUMPS(2) = M+N+N 3224 GOTO 90 3225 ENDIF 3226 ENDIF 3227 IF (JOB.EQ.4) THEN 3228 DO 50 J = 1,N 3229 FACT = ZERO 3230 DO 30 K = IP(J),IP(J+1)-1_8 3231 IF (abs(A(K)).GT.FACT) FACT = abs(A(K)) 3232 30 CONTINUE 3233 IF(FACT .GT. RINF3) RINF3 = FACT 3234 DO 40 K = IP(J),IP(J+1)-1_8 3235 A(K) = FACT - abs(A(K)) 3236 40 CONTINUE 3237 50 CONTINUE 3238 DW(1) = max(ZERO,CNTL(1)) 3239 DW(2) = RINF3 3240 IWtemp8(1) = int(JOB,8) 3241 CALL DMUMPS_MTRANSW(M,N,NE,IP,IRN,A,PERM,NUM, 3242 & IWtemp8(1),IW(1),IWtemp8(N+1),IPQ8,IW(N+1), 3243 & IWtemp8(2*N+1), 3244 & DW(1),DW(M+1),RINF2) 3245 DEALLOCATE(IWtemp8) 3246 GO TO 90 3247 ENDIF 3248 IF (JOB.EQ.5 .or. JOB.EQ.6) THEN 3249 RINF3=ONE 3250 IF (JOB.EQ.5) THEN 3251 DO 75 J = 1,N 3252 FACT = ZERO 3253 DO 60 K = IP(J),IP(J+1)-1_8 3254 IF (A(K).GT.FACT) FACT = A(K) 3255 60 CONTINUE 3256 DW(2*M+J) = FACT 3257 IF (FACT.NE.ZERO) THEN 3258 FACT = log(FACT) 3259 IF(FACT .GT. RINF3) RINF3=FACT 3260 DO 70 K = IP(J),IP(J+1)-1_8 3261 IF (A(K).NE.ZERO) THEN 3262 A(K) = FACT - log(A(K)) 3263 IF(A(K) .GT. RINF3) RINF3=A(K) 3264 ELSE 3265 A(K) = FACT + RINF 3266 ENDIF 3267 70 CONTINUE 3268 ELSE 3269 DO 71 K = IP(J),IP(J+1)-1_8 3270 A(K) = ONE 3271 71 CONTINUE 3272 ENDIF 3273 75 CONTINUE 3274 ENDIF 3275 IF (JOB.EQ.6) THEN 3276 DO 175 K = 1,NE 3277 IW(3*N+2*M+K) = IRN(K) 3278 175 CONTINUE 3279 DO 61 I = 1,M 3280 DW(2*M+N+I) = ZERO 3281 61 CONTINUE 3282 DO 63 J = 1,N 3283 DO 62 K = IP(J),IP(J+1)-1_8 3284 I = IRN(K) 3285 IF (A(K).GT.DW(2*M+N+I)) THEN 3286 DW(2*M+N+I) = A(K) 3287 ENDIF 3288 62 CONTINUE 3289 63 CONTINUE 3290 DO 64 I = 1,M 3291 IF (DW(2*M+N+I).NE.ZERO) THEN 3292 DW(2*M+N+I) = 1.0D0/DW(2*M+N+I) 3293 ENDIF 3294 64 CONTINUE 3295 DO 66 J = 1,N 3296 DO 65 K = IP(J),IP(J+1)-1 3297 I = IRN(K) 3298 A(K) = DW(2*M+N+I) * A(K) 3299 65 CONTINUE 3300 66 CONTINUE 3301 CALL DMUMPS_MTRANSR(N,NE,IP,IW(3*N+2*M+1),A) 3302 DO 176 J = 1,N 3303 IF (IP(J).NE.IP(J+1)) THEN 3304 FACT = A(IP(J)) 3305 ELSE 3306 FACT = ZERO 3307 ENDIF 3308 DW(2*M+J) = FACT 3309 IF (FACT.NE.ZERO) THEN 3310 FACT = log(FACT) 3311 DO 170 K = IP(J),IP(J+1)-1_8 3312 IF (A(K).NE.ZERO) THEN 3313 A(K) = FACT - log(A(K)) 3314 IF(A(K) .GT. RINF3) RINF3=A(K) 3315 ELSE 3316 A(K) = FACT + RINF 3317 ENDIF 3318 170 CONTINUE 3319 ELSE 3320 DO 171 K = IP(J),IP(J+1)-1_8 3321 A(K) = ONE 3322 171 CONTINUE 3323 ENDIF 3324 176 CONTINUE 3325 ENDIF 3326 DW(1) = max(ZERO,CNTL(1)) 3327 RINF3 = RINF3+ONE 3328 DW(2) = RINF3 3329 IWtemp8(1) = int(JOB,8) 3330 IF (JOB.EQ.5) THEN 3331 CALL DMUMPS_MTRANSW(M,N,NE,IP,IRN,A,PERM,NUM, 3332 & IWtemp8(1),IW(1),IWtemp8(N+1),IPQ8,IW(N+1), 3333 & IWtemp8(2*N+1), 3334 & DW(1),DW(M+1),RINF2) 3335 ENDIF 3336 IF (JOB.EQ.6) THEN 3337 CALL DMUMPS_MTRANSW(M,N,NE,IP,IW(3*N+2*M+1),A,PERM,NUM, 3338 & IWtemp8(1),IW(1),IWtemp8(N+1),IPQ8,IW(N+1), 3339 & IWtemp8(2*N+1), 3340 & DW(1),DW(M+1),RINF2) 3341 ENDIF 3342 IF ((JOB.EQ.5).or.(JOB.EQ.6)) THEN 3343 DEALLOCATE(IWtemp8) 3344 ENDIF 3345 IF (JOB.EQ.6) THEN 3346 DO 79 I = 1,M 3347 IF (DW(2*M+N+I).NE.0.0D0) THEN 3348 DW(I) = DW(I) + log(DW(2*M+N+I)) 3349 ENDIF 3350 79 CONTINUE 3351 ENDIF 3352 IF (NUM.EQ.N) THEN 3353 DO 80 J = 1,N 3354 IF (DW(2*M+J).NE.ZERO) THEN 3355 DW(M+J) = DW(M+J) - log(DW(2*M+J)) 3356 ELSE 3357 DW(M+J) = ZERO 3358 ENDIF 3359 80 CONTINUE 3360 ENDIF 3361 FACT = 0.5D0*log(RINF2) 3362 DO 86 I = 1,M 3363 IF (DW(I).LT.FACT) GO TO 86 3364 WARN2 = 2 3365 GO TO 90 3366 86 CONTINUE 3367 DO 87 J = 1,N 3368 IF (DW(M+J).LT.FACT) GO TO 87 3369 WARN2 = 2 3370 GO TO 90 3371 87 CONTINUE 3372 ENDIF 3373 90 IF (INFOMUMPS(1).LT.0) RETURN 3374 IF (NUM.LT.N) WARN1 = 1 3375 IF (JOB.EQ.4 .OR. JOB.EQ.5 .OR. JOB.EQ.6) THEN 3376 IF (CNTL(1).LT.ZERO) WARN4 = 4 3377 ENDIF 3378 IF (INFO(1).EQ.0) THEN 3379 INFO(1) = WARN1 + WARN2 + WARN4 3380 IF (INFO(1).GT.0 .AND. ICNTL(2).GT.0) THEN 3381 WRITE(ICNTL(2),9010) INFO(1) 3382 IF (WARN1.EQ.1) WRITE(ICNTL(2),9011) 3383 IF (WARN2.EQ.2) WRITE(ICNTL(2),9012) 3384 IF (WARN4.EQ.4) WRITE(ICNTL(2),9014) 3385 ENDIF 3386 ENDIF 3387 IF (ICNTL(3).GE.0) THEN 3388 IF (ICNTL(4).EQ.0 .OR. ICNTL(4).EQ.1) THEN 3389 WRITE(ICNTL(3),9030) (INFO(J),J=1,2) 3390 WRITE(ICNTL(3),9031) NUM 3391 IF (ICNTL(4).EQ.0) THEN 3392 WRITE(ICNTL(3),9032) (PERM(J),J=1,min(10,M)) 3393 IF (JOB.EQ.5 .OR. JOB.EQ.6) THEN 3394 WRITE(ICNTL(3),9033) (DW(J),J=1,min(10,M)) 3395 WRITE(ICNTL(3),9034) (DW(M+J),J=1,min(10,N)) 3396 ENDIF 3397 ELSEIF (ICNTL(4).EQ.1) THEN 3398 WRITE(ICNTL(3),9032) (PERM(J),J=1,M) 3399 IF (JOB.EQ.5 .OR. JOB.EQ.6) THEN 3400 WRITE(ICNTL(3),9033) (DW(J),J=1,M) 3401 WRITE(ICNTL(3),9034) (DW(M+J),J=1,N) 3402 ENDIF 3403 ENDIF 3404 ENDIF 3405 ENDIF 3406 99 RETURN 3407 9001 FORMAT (' ****** Error in DMUMPS_MTRANSA. INFO(1) = ',I2, 3408 & ' because ',(A),' = ',I14) 3409 9004 FORMAT (' ****** Error in DMUMPS_MTRANSA. INFO(1) = ',I2/ 3410 & ' LIW too small, must be at least ',I14) 3411 9005 FORMAT (' ****** Error in DMUMPS_MTRANSA. INFO(1) = ',I2/ 3412 & ' LDW too small, must be at least ',I14) 3413 9006 FORMAT (' ****** Error in DMUMPS_MTRANSA. INFO(1) = ',I2/ 3414 & ' Column ',I8, 3415 & ' contains an entry with invalid row index ',I8) 3416 9007 FORMAT (' ****** Error in DMUMPS_MTRANSA. INFO(1) = ',I2/ 3417 & ' Column ',I8, 3418 & ' contains two or more entries with row index ',I8) 3419 9010 FORMAT (' ****** Warning from DMUMPS_MTRANSA. INFO(1) = ',I2) 3420 9011 FORMAT (' - The matrix is structurally singular.') 3421 9012 FORMAT (' - Some scaling factors may be too large.') 3422 9014 FORMAT (' - CNTL(1) is negative and was treated as zero.') 3423 9020 FORMAT (' ****** Input parameters for DMUMPS_MTRANSA:'/ 3424 & ' JOB =',I10/' M =',I10/' N =',I10/' NE =',I14) 3425 9021 FORMAT (' IP(1:N+1) = ',8I8/(15X,8I8)) 3426 9022 FORMAT (' IRN(1:NE) = ',8I8/(15X,8I8)) 3427 9023 FORMAT (' A(1:NE) = ',4(1PD14.4)/(15X,4(1PD14.4))) 3428 9024 FORMAT (' ICNTL(1:10) = ',8I8/(15X,2I8)) 3429 9025 FORMAT (' CNTL(1:10) = ',4(1PD14.4)/(15X,4(1PD14.4))) 3430 9030 FORMAT (' ****** Output parameters for DMUMPS_MTRANSA:'/ 3431 & ' INFO(1:2) = ',2I8) 3432 9031 FORMAT (' NUM = ',I8) 3433 9032 FORMAT (' PERM(1:M) = ',8I8/(15X,8I8)) 3434 9033 FORMAT (' DW(1:M) = ',5(F11.3)/(15X,5(F11.3))) 3435 9034 FORMAT (' DW(M+1:M+N) = ',5(F11.3)/(15X,5(F11.3))) 3436 END SUBROUTINE DMUMPS_MTRANS_DRIVER 3437 SUBROUTINE DMUMPS_SUPPRESS_DUPPLI_VAL(N,NZ,IP,IRN,A,FLAG,POSI) 3438 IMPLICIT NONE 3439 INTEGER, INTENT(IN) :: N 3440 INTEGER(8), INTENT(INOUT) :: NZ 3441 INTEGER(8), INTENT(INOUT) :: IP(N+1) 3442 INTEGER, INTENT(INOUT) :: IRN(NZ) 3443 DOUBLE PRECISION, INTENT(INOUT) :: A(NZ) 3444 INTEGER, INTENT(OUT) :: FLAG(N) 3445 INTEGER(8), INTENT(OUT) :: POSI(N) 3446 INTEGER :: ROW, COL 3447 INTEGER(8) :: K, WR_POS, BEG_COL, SV_POS 3448 FLAG = 0 3449 WR_POS = 1_8 3450 DO COL=1,N 3451 BEG_COL = WR_POS 3452 DO K=IP(COL),IP(COL+1)-1_8 3453 ROW = IRN(K) 3454 IF(FLAG(ROW) .NE. COL) THEN 3455 IRN(WR_POS) = ROW 3456 A(WR_POS) = A(K) 3457 FLAG(ROW) = COL 3458 POSI(ROW) = WR_POS 3459 WR_POS = WR_POS+1 3460 ELSE 3461 SV_POS = POSI(ROW) 3462 A(SV_POS) = A(SV_POS) + A(K) 3463 ENDIF 3464 ENDDO 3465 IP(COL) = BEG_COL 3466 ENDDO 3467 IP(N+1) = WR_POS 3468 NZ = WR_POS-1_8 3469 RETURN 3470 END SUBROUTINE DMUMPS_SUPPRESS_DUPPLI_VAL 3471 SUBROUTINE DMUMPS_SUPPRESS_DUPPLI_STR(N,NZ,IP,IRN,FLAG) 3472 IMPLICIT NONE 3473 INTEGER, INTENT(IN) :: N 3474 INTEGER(8), INTENT(INOUT) :: NZ 3475 INTEGER(8), INTENT(INOUT) :: IP(N+1) 3476 INTEGER, INTENT(INOUT) :: IRN(NZ) 3477 INTEGER, INTENT(OUT) :: FLAG(N) 3478 INTEGER :: ROW, COL 3479 INTEGER(8) :: K, WR_POS, BEG_COL 3480 FLAG = 0 3481 WR_POS = 1_8 3482 DO COL=1,N 3483 BEG_COL = WR_POS 3484 DO K=IP(COL),IP(COL+1)-1_8 3485 ROW = IRN(K) 3486 IF(FLAG(ROW) .NE. COL) THEN 3487 IRN(WR_POS) = ROW 3488 FLAG(ROW) = COL 3489 WR_POS = WR_POS+1_8 3490 ENDIF 3491 ENDDO 3492 IP(COL) = BEG_COL 3493 ENDDO 3494 IP(N+1) = WR_POS 3495 NZ = WR_POS-1_8 3496 RETURN 3497 END SUBROUTINE DMUMPS_SUPPRESS_DUPPLI_STR 3498 SUBROUTINE DMUMPS_SORT_PERM( N, NA, LNA, NE_STEPS, 3499 & PERM, FILS, 3500 & DAD_STEPS, STEP, NSTEPS, INFO) 3501 IMPLICIT NONE 3502 INTEGER, INTENT(IN) :: N, NSTEPS, LNA 3503 INTEGER, INTENT(IN) :: FILS( N ), STEP(N), NA(LNA) 3504 INTEGER, INTENT(IN) :: DAD_STEPS ( NSTEPS ), NE_STEPS (NSTEPS) 3505 INTEGER, INTENT(INOUT) :: INFO(40) 3506 INTEGER, INTENT(OUT) :: PERM( N ) 3507 INTEGER :: IPERM, INODE, IN 3508 INTEGER :: INBLEAF, INBROOT, allocok 3509 INTEGER, ALLOCATABLE, DIMENSION (:) :: POOL, NSTK 3510 INBLEAF = NA(1) 3511 INBROOT = NA(2) 3512 ALLOCATE(POOL(INBLEAF), NSTK(NSTEPS), stat=allocok) 3513 IF (allocok > 0 ) THEN 3514 INFO(1) = -7 3515 INFO(2) = INBLEAF + NSTEPS 3516 RETURN 3517 ENDIF 3518 POOL(1:INBLEAF) = NA(3:2+INBLEAF) 3519 NSTK(1:NSTEPS) = NE_STEPS(1:NSTEPS) 3520 IPERM = 1 3521 DO WHILE ( INBLEAF .NE. 0 ) 3522 INODE = POOL( INBLEAF ) 3523 INBLEAF = INBLEAF - 1 3524 IN = INODE 3525 DO WHILE ( IN .GT. 0 ) 3526 PERM ( IN ) = IPERM 3527 IPERM = IPERM + 1 3528 IN = FILS( IN ) 3529 END DO 3530 IN = DAD_STEPS(STEP( INODE )) 3531 IF ( IN .eq. 0 ) THEN 3532 INBROOT = INBROOT - 1 3533 ELSE 3534 NSTK( STEP(IN) ) = NSTK( STEP(IN) ) - 1 3535 IF ( NSTK( STEP(IN) ) .eq. 0 ) THEN 3536 INBLEAF = INBLEAF + 1 3537 POOL( INBLEAF ) = IN 3538 END IF 3539 END IF 3540 END DO 3541 DEALLOCATE(POOL, NSTK) 3542 RETURN 3543 END SUBROUTINE DMUMPS_SORT_PERM 3544 SUBROUTINE DMUMPS_ANA_N_PAR( id, PTRAR ) 3545 USE DMUMPS_STRUC_DEF 3546 IMPLICIT NONE 3547 include 'mpif.h' 3548 TYPE(DMUMPS_STRUC), INTENT(IN), TARGET :: id 3549 INTEGER(8), INTENT(OUT), TARGET :: PTRAR(id%N,2) 3550 INTEGER :: IERR 3551 INTEGER :: IOLD, JOLD, INEW, JNEW 3552 INTEGER(8) :: K, INZ 3553 INTEGER, POINTER :: IIRN(:), IJCN(:) 3554 INTEGER(8), POINTER :: IWORK1(:), IWORK2(:) 3555 LOGICAL :: IDO 3556 IF(id%KEEP(54) .EQ. 3) THEN 3557 IIRN => id%IRN_loc 3558 IJCN => id%JCN_loc 3559 INZ = id%KEEP8(29) 3560 IWORK1 => PTRAR(1:id%N,2) 3561 allocate(IWORK2(id%N)) 3562 IDO = .TRUE. 3563 ELSE 3564 IIRN => id%IRN 3565 IJCN => id%JCN 3566 INZ = id%KEEP8(28) 3567 IWORK1 => PTRAR(1:id%N,1) 3568 IWORK2 => PTRAR(1:id%N,2) 3569 IDO = id%MYID .EQ. 0 3570 END IF 3571 DO 50 IOLD=1,id%N 3572 IWORK1(IOLD) = 0_8 3573 IWORK2(IOLD) = 0_8 3574 50 CONTINUE 3575 IF(IDO) THEN 3576 DO 70 K=1_8,INZ 3577 IOLD = IIRN(K) 3578 JOLD = IJCN(K) 3579 IF ( (IOLD.GT.id%N).OR.(JOLD.GT.id%N).OR.(IOLD.LT.1) 3580 & .OR.(JOLD.LT.1) ) GOTO 70 3581 IF (IOLD.NE.JOLD) THEN 3582 INEW = id%SYM_PERM(IOLD) 3583 JNEW = id%SYM_PERM(JOLD) 3584 IF ( id%KEEP( 50 ) .EQ. 0 ) THEN 3585 IF (INEW.LT.JNEW) THEN 3586 IWORK2(IOLD) = IWORK2(IOLD) + 1_8 3587 ELSE 3588 IWORK1(JOLD) = IWORK1(JOLD) + 1_8 3589 ENDIF 3590 ELSE 3591 IF ( INEW .LT. JNEW ) THEN 3592 IWORK1( IOLD ) = IWORK1( IOLD ) + 1_8 3593 ELSE 3594 IWORK1( JOLD ) = IWORK1( JOLD ) + 1_8 3595 END IF 3596 ENDIF 3597 ENDIF 3598 70 CONTINUE 3599 END IF 3600 IF (id%KEEP(54) .EQ. 3) THEN 3601 CALL MPI_ALLREDUCE(IWORK1(1), PTRAR(1,1), id%N, MPI_INTEGER8, 3602 & MPI_SUM, id%COMM, IERR ) 3603 CALL MPI_ALLREDUCE(IWORK2(1), PTRAR(1,2), id%N, MPI_INTEGER8, 3604 & MPI_SUM, id%COMM, IERR ) 3605 deallocate(IWORK2) 3606 ELSE 3607 CALL MPI_BCAST( PTRAR, 2*id%N, MPI_INTEGER8, 3608 & 0, id%COMM, IERR ) 3609 END IF 3610 RETURN 3611 END SUBROUTINE DMUMPS_ANA_N_PAR 3612 SUBROUTINE DMUMPS_DIST_AVOID_COPIES(N,NSLAVES, 3613 & ICNTL,INFOG, NE, NFSIZ, 3614 & FRERE, FILS, 3615 & KEEP,KEEP8,PROCNODE, 3616 & SSARBR,NBSA,PEAK,IERR 3617 & ) 3618 USE MUMPS_STATIC_MAPPING 3619 IMPLICIT NONE 3620 INTEGER N, NSLAVES, NBSA, IERR 3621 INTEGER ICNTL(40),INFOG(40),KEEP(500) 3622 INTEGER(8) KEEP8(150) 3623 INTEGER NE(N),NFSIZ(N),FRERE(N),FILS(N),PROCNODE(N) 3624 INTEGER SSARBR(N) 3625 DOUBLE PRECISION PEAK 3626 CALL MUMPS_DISTRIBUTE(N,NSLAVES, 3627 & ICNTL,INFOG, NE, NFSIZ, 3628 & FRERE, FILS, 3629 & KEEP,KEEP8,PROCNODE, 3630 & SSARBR,NBSA,dble(PEAK),IERR 3631 & ) 3632 RETURN 3633 END SUBROUTINE DMUMPS_DIST_AVOID_COPIES 3634 SUBROUTINE DMUMPS_SET_PROCNODE(INODE, PROCNODE, VALUE, FILS, N) 3635 INTEGER, intent(in) :: INODE, N, VALUE 3636 INTEGER, intent(in) :: FILS(N) 3637 INTEGER, intent(inout) :: PROCNODE(N) 3638 INTEGER IN 3639 IN=INODE 3640 DO WHILE ( IN > 0 ) 3641 PROCNODE( IN ) = VALUE 3642 IN=FILS( IN ) 3643 ENDDO 3644 RETURN 3645 END SUBROUTINE DMUMPS_SET_PROCNODE 3646