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 CMUMPS_INIT_POOL_LAST3(IPOOL, LPOOL, LEAF) 14 USE CMUMPS_LOAD 15 IMPLICIT NONE 16 INTEGER LPOOL, LEAF 17 INTEGER IPOOL(LPOOL) 18 IPOOL(LPOOL-2) = 0 19 IPOOL(LPOOL-1) = 0 20 IPOOL(LPOOL) = LEAF-1 21 RETURN 22 END SUBROUTINE CMUMPS_INIT_POOL_LAST3 23 SUBROUTINE CMUMPS_INSERT_POOL_N 24 & (N, POOL, LPOOL, PROCNODE, SLAVEF, 25 & K28, K76, K80, K47, STEP, INODE) 26 USE CMUMPS_LOAD 27 IMPLICIT NONE 28 INTEGER N, INODE, LPOOL, K28, SLAVEF, K76, K80, K47 29 INTEGER STEP(N), POOL(LPOOL), PROCNODE(K28) 30 EXTERNAL MUMPS_IN_OR_ROOT_SSARBR 31 LOGICAL MUMPS_IN_OR_ROOT_SSARBR, ATM_CURRENT_NODE 32 INTEGER NBINSUBTREE, NBTOP, INODE_EFF,POS_TO_INSERT 33 INTEGER IPOS1, IPOS2, ISWAP 34 INTEGER NODE,J,I 35 ATM_CURRENT_NODE = ( K76 == 2 .OR. K76 ==3 .OR. 36 & K76==4 .OR. K76==5) 37 NBINSUBTREE = POOL(LPOOL) 38 NBTOP = POOL(LPOOL - 1) 39 IF (INODE > N ) THEN 40 INODE_EFF = INODE - N 41 ELSE IF (INODE < 0) THEN 42 INODE_EFF = - INODE 43 ELSE 44 INODE_EFF = INODE 45 ENDIF 46 IF(((INODE.GT.0).AND.(INODE.LE.N)).AND.(.NOT. 47 & MUMPS_IN_OR_ROOT_SSARBR(PROCNODE(STEP(INODE_EFF)), 48 & SLAVEF)) 49 & ) THEN 50 IF ((K80 == 1 .AND. K47 .GE. 1) .OR. 51 & (( K80 == 2 .OR. K80==3 ) .AND. 52 & ( K47 == 4 ))) THEN 53 CALL CMUMPS_REMOVE_NODE(INODE,1) 54 ENDIF 55 ENDIF 56 IF ( MUMPS_IN_OR_ROOT_SSARBR(PROCNODE(STEP(INODE_EFF)), 57 & SLAVEF) ) THEN 58 POOL(NBINSUBTREE + 1 ) = INODE 59 NBINSUBTREE = NBINSUBTREE + 1 60 ELSE 61 POS_TO_INSERT=NBTOP+1 62 IF((K76.EQ.4).OR.(K76.EQ.5).OR.(K76.EQ.6))THEN 63#if defined(NOT_ATM_POOL_SPECIAL) 64 J=NBTOP 65#else 66 IF((INODE.GT.N).OR.(INODE.LE.0))THEN 67 DO J=NBTOP,1,-1 68 IF((POOL(LPOOL-2-J).GT.0) 69 & .AND.(POOL(LPOOL-2-J).LE.N))THEN 70 GOTO 333 71 ENDIF 72 IF ( POOL(LPOOL-2-J) < 0 ) THEN 73 NODE=-POOL(LPOOL-2-J) 74 ELSE IF ( POOL(LPOOL-2-J) > N ) THEN 75 NODE = POOL(LPOOL-2-J) - N 76 ELSE 77 NODE = POOL(LPOOL-2-J) 78 ENDIF 79 IF((K76.EQ.4).OR.(K76.EQ.6))THEN 80 IF(DEPTH_FIRST_LOAD(STEP(NODE)).GE. 81 & DEPTH_FIRST_LOAD(STEP(INODE_EFF)))THEN 82 GOTO 333 83 ENDIF 84 ENDIF 85 IF(K76.EQ.5)THEN 86 IF(COST_TRAV(STEP(NODE)).LE. 87 & COST_TRAV(STEP(INODE_EFF)))THEN 88 GOTO 333 89 ENDIF 90 ENDIF 91 POS_TO_INSERT=POS_TO_INSERT-1 92 ENDDO 93 IF(J.EQ.0) J=1 94 333 CONTINUE 95 DO I=NBTOP,POS_TO_INSERT,-1 96 POOL(LPOOL-2-I-1)=POOL(LPOOL-2-I) 97 ENDDO 98 POOL(LPOOL-2-POS_TO_INSERT)=INODE 99 NBTOP = NBTOP + 1 100 GOTO 20 101 ENDIF 102 DO J=NBTOP,1,-1 103 IF((POOL(LPOOL-2-J).GT.0).AND.(POOL(LPOOL-2-J).LE.N))THEN 104 GOTO 888 105 ENDIF 106 POS_TO_INSERT=POS_TO_INSERT-1 107 ENDDO 108 888 CONTINUE 109#endif 110 DO I=J,1,-1 111#if defined(NOT_ATM_POOL_SPECIAL) 112 IF ( POOL(LPOOL-2-I) < 0 ) THEN 113 NODE=-POOL(LPOOL-2-I) 114 ELSE IF ( POOL(LPOOL-2-I) > N ) THEN 115 NODE = POOL(LPOOL-2-I) - N 116 ELSE 117 NODE = POOL(LPOOL-2-I) 118 ENDIF 119#else 120 NODE=POOL(LPOOL-2-I) 121#endif 122 IF((K76.EQ.4).OR.(K76.EQ.6))THEN 123 IF(DEPTH_FIRST_LOAD(STEP(NODE)).GE. 124 & DEPTH_FIRST_LOAD(STEP(INODE_EFF)))THEN 125 GOTO 999 126 ENDIF 127 ENDIF 128 IF(K76.EQ.5)THEN 129 IF(COST_TRAV(STEP(NODE)).LE. 130 & COST_TRAV(STEP(INODE_EFF)))THEN 131 GOTO 999 132 ENDIF 133 ENDIF 134 POS_TO_INSERT=POS_TO_INSERT-1 135 ENDDO 136 IF(I.EQ.0) I=1 137 999 CONTINUE 138 DO J=NBTOP,POS_TO_INSERT,-1 139 POOL(LPOOL-2-J-1)=POOL(LPOOL-2-J) 140 ENDDO 141 POOL(LPOOL-2-POS_TO_INSERT)=INODE 142 NBTOP = NBTOP + 1 143 GOTO 20 144 ENDIF 145 POOL( LPOOL - 2 - ( NBTOP + 1 ) ) = INODE 146 NBTOP = NBTOP + 1 147 IPOS1 = LPOOL - 2 - NBTOP 148 IPOS2 = LPOOL - 2 - NBTOP + 1 149 10 CONTINUE 150 IF ( IPOS2 == LPOOL - 2 ) GOTO 20 151 IF ( POOL(IPOS1) < 0 ) GOTO 20 152 IF ( POOL(IPOS2) < 0 ) GOTO 30 153 IF ( ATM_CURRENT_NODE ) THEN 154 IF ( POOL(IPOS1) > N ) GOTO 20 155 IF ( POOL(IPOS2) > N ) GOTO 30 156 END IF 157 GOTO 20 158 30 CONTINUE 159 ISWAP = POOL(IPOS1) 160 POOL(IPOS1) = POOL(IPOS2) 161 POOL(IPOS2) = ISWAP 162 IPOS1 = IPOS1 + 1 163 IPOS2 = IPOS2 + 1 164 GOTO 10 165 20 CONTINUE 166 ENDIF 167 POOL(LPOOL) = NBINSUBTREE 168 POOL(LPOOL - 1) = NBTOP 169 RETURN 170 END SUBROUTINE CMUMPS_INSERT_POOL_N 171 LOGICAL FUNCTION CMUMPS_POOL_EMPTY(POOL, LPOOL) 172 IMPLICIT NONE 173 INTEGER LPOOL 174 INTEGER POOL(LPOOL) 175 INTEGER NBINSUBTREE, NBTOP 176 NBINSUBTREE = POOL(LPOOL) 177 NBTOP = POOL(LPOOL - 1) 178 CMUMPS_POOL_EMPTY = (NBINSUBTREE + NBTOP == 0) 179 RETURN 180 END FUNCTION CMUMPS_POOL_EMPTY 181 SUBROUTINE CMUMPS_EXTRACT_POOL( N, POOL, LPOOL, PROCNODE, SLAVEF, 182 & STEP, INODE, KEEP,KEEP8, MYID, ND, 183 & FORCE_EXTRACT_TOP_SBTR ) 184 USE CMUMPS_LOAD 185 IMPLICIT NONE 186 INTEGER INODE, LPOOL, SLAVEF, N 187 INTEGER KEEP(500) 188 INTEGER(8) KEEP8(150) 189 INTEGER STEP(N), POOL(LPOOL), PROCNODE(KEEP(28)), 190 & ND(KEEP(28)) 191 EXTERNAL MUMPS_INSSARBR, MUMPS_ROOTSSARBR, CMUMPS_POOL_EMPTY 192 LOGICAL MUMPS_INSSARBR, MUMPS_ROOTSSARBR, CMUMPS_POOL_EMPTY 193 EXTERNAL MUMPS_PROCNODE 194 INTEGER MUMPS_PROCNODE 195 INTEGER NBINSUBTREE, NBTOP, INSUBTREE, INODE_EFF, MYID 196 LOGICAL LEFT, ATOMIC_SUBTREE,UPPER,FLAG_MEM,SBTR_FLAG,PROC_FLAG 197 LOGICAL FORCE_EXTRACT_TOP_SBTR 198 INTEGER NODE_TO_EXTRACT,I,J,MIN_PROC 199 NBINSUBTREE = POOL(LPOOL) 200 NBTOP = POOL(LPOOL - 1) 201 INSUBTREE = POOL(LPOOL - 2) 202 IF ( KEEP(76) > 6 .OR. KEEP(76) < 0 ) THEN 203 WRITE(*,*) "Error 2 in CMUMPS_EXTRACT_POOL: unknown strategy" 204 CALL MUMPS_ABORT() 205 ENDIF 206 ATOMIC_SUBTREE = ( KEEP(76) == 1 .OR. KEEP(76) == 3) 207 IF ( CMUMPS_POOL_EMPTY(POOL, LPOOL) ) THEN 208 WRITE(*,*) "Error 1 in CMUMPS_EXTRACT_POOL" 209 CALL MUMPS_ABORT() 210 ENDIF 211 IF ( .NOT. ATOMIC_SUBTREE ) THEN 212 LEFT = (NBTOP == 0) 213 IF(.NOT.LEFT)THEN 214 IF((KEEP(76).EQ.4).OR.(KEEP(76).EQ.5))THEN 215 IF(NBINSUBTREE.EQ.0)THEN 216 LEFT=.FALSE. 217 ELSE 218 IF ( POOL(NBINSUBTREE) < 0 ) THEN 219 I = -POOL(NBINSUBTREE) 220 ELSE IF ( POOL(NBINSUBTREE) > N ) THEN 221 I = POOL(NBINSUBTREE) - N 222 ELSE 223 I = POOL(NBINSUBTREE) 224 ENDIF 225 IF ( POOL(LPOOL-2-NBTOP) < 0 ) THEN 226 J = -POOL(LPOOL-2-NBTOP) 227 ELSE IF ( POOL(LPOOL-2-NBTOP) > N ) THEN 228 J = POOL(LPOOL-2-NBTOP) - N 229 ELSE 230 J = POOL(LPOOL-2-NBTOP) 231 ENDIF 232 IF(KEEP(76).EQ.4)THEN 233 IF(DEPTH_FIRST_LOAD(STEP(J)).GE. 234 & DEPTH_FIRST_LOAD(STEP(I)))THEN 235 LEFT=.TRUE. 236 ELSE 237 LEFT=.FALSE. 238 ENDIF 239 ENDIF 240 IF(KEEP(76).EQ.5)THEN 241 IF(COST_TRAV(STEP(J)).LE. 242 & COST_TRAV(STEP(I)))THEN 243 LEFT=.TRUE. 244 ELSE 245 LEFT=.FALSE. 246 ENDIF 247 ENDIF 248 ENDIF 249 ENDIF 250 ENDIF 251 ELSE 252 IF ( INSUBTREE == 1 ) THEN 253 IF (NBINSUBTREE == 0) THEN 254 WRITE(*,*) "Error 3 in CMUMPS_EXTRACT_POOL" 255 CALL MUMPS_ABORT() 256 ENDIF 257 LEFT = .TRUE. 258 ELSE 259 LEFT = ( NBTOP == 0) 260 ENDIF 261 ENDIF 262 222 CONTINUE 263 IF ( LEFT ) THEN 264 INODE = POOL( NBINSUBTREE ) 265 IF(KEEP(81).EQ.2)THEN 266#if ! defined(NOT_ATM_POOL_SPECIAL) 267 IF((INODE.GE.0).AND.(INODE.LE.N))THEN 268#endif 269 CALL CMUMPS_MEM_NODE_SELECT(INODE,POOL,LPOOL,N, 270 & STEP,KEEP,KEEP8,PROCNODE,SLAVEF,MYID,SBTR_FLAG, 271 & PROC_FLAG,MIN_PROC) 272 IF(.NOT.SBTR_FLAG)THEN 273 WRITE(*,*)MYID,': ca a change pour moi' 274 LEFT=.FALSE. 275 GOTO 222 276 ENDIF 277#if ! defined(NOT_ATM_POOL_SPECIAL) 278 ENDIF 279#endif 280 ELSEIF(KEEP(81).EQ.3)THEN 281#if ! defined(NOT_ATM_POOL_SPECIAL) 282 IF((INODE.GE.0).AND.(INODE.LE.N))THEN 283#endif 284 NODE_TO_EXTRACT=INODE 285 FLAG_MEM=.FALSE. 286 CALL CMUMPS_LOAD_CHK_MEMCST_POOL(FLAG_MEM) 287 IF(FLAG_MEM)THEN 288 CALL CMUMPS_MEM_NODE_SELECT(INODE,POOL,LPOOL,N, 289 & STEP,KEEP,KEEP8, 290 & PROCNODE,SLAVEF,MYID,SBTR_FLAG, 291 & PROC_FLAG,MIN_PROC) 292 IF(.NOT.SBTR_FLAG)THEN 293 LEFT=.FALSE. 294 WRITE(*,*)MYID,': ca a change pour moi (2)' 295 GOTO 222 296 ENDIF 297 ENDIF 298#if ! defined(NOT_ATM_POOL_SPECIAL) 299 ENDIF 300#endif 301 ENDIF 302 NBINSUBTREE = NBINSUBTREE - 1 303 IF ( INODE < 0 ) THEN 304 INODE_EFF = -INODE 305 ELSE IF ( INODE > N ) THEN 306 INODE_EFF = INODE - N 307 ELSE 308 INODE_EFF = INODE 309 ENDIF 310 IF ( MUMPS_INSSARBR( PROCNODE(STEP(INODE_EFF)), SLAVEF) ) THEN 311 IF((KEEP(47).GE.2.AND.KEEP(81).EQ.1).AND. 312 & (INSUBTREE.EQ.0))THEN 313 CALL CMUMPS_LOAD_SET_SBTR_MEM(.TRUE.) 314 ENDIF 315 INSUBTREE = 1 316 ELSE IF ( MUMPS_ROOTSSARBR( PROCNODE(STEP(INODE_EFF)), 317 & SLAVEF)) THEN 318 IF((KEEP(47).GE.2.AND.KEEP(81).EQ.1).AND. 319 & (INSUBTREE.EQ.1))THEN 320 CALL CMUMPS_LOAD_SET_SBTR_MEM(.FALSE.) 321 ENDIF 322 INSUBTREE = 0 323 END IF 324 ELSE 325 IF (NBTOP < 1 ) THEN 326 WRITE(*,*) "Error 5 in CMUMPS_EXTRACT_POOL", NBTOP 327 CALL MUMPS_ABORT() 328 ENDIF 329 INODE = POOL( LPOOL - 2 - NBTOP ) 330 IF(KEEP(81).EQ.1)THEN 331 CALL CMUMPS_LOAD_POOL_CHECK_MEM 332 & (INODE,UPPER,SLAVEF,KEEP,KEEP8, 333 & STEP,POOL,LPOOL,PROCNODE,N) 334 IF(UPPER)THEN 335 GOTO 666 336 ELSE 337 NBINSUBTREE=NBINSUBTREE-1 338 IF ( MUMPS_INSSARBR( PROCNODE(STEP(INODE)), 339 & SLAVEF) ) THEN 340 INSUBTREE = 1 341 ELSE IF ( MUMPS_ROOTSSARBR( PROCNODE(STEP(INODE)), 342 & SLAVEF)) THEN 343 INSUBTREE = 0 344 ENDIF 345 GOTO 777 346 ENDIF 347 ENDIF 348 IF(KEEP(81).EQ.2)THEN 349 CALL CMUMPS_MEM_NODE_SELECT(INODE,POOL,LPOOL,N,STEP, 350 & KEEP,KEEP8, 351 & PROCNODE,SLAVEF,MYID,SBTR_FLAG,PROC_FLAG,MIN_PROC) 352 IF(SBTR_FLAG)THEN 353 LEFT=.TRUE. 354 WRITE(*,*)MYID,': ca a change pour moi (3)' 355 GOTO 222 356 ENDIF 357 ELSE 358 IF(KEEP(81).EQ.3)THEN 359#if ! defined(NOT_ATM_POOL_SPECIAL) 360 IF((INODE.GE.0).AND.(INODE.LE.N))THEN 361#endif 362 NODE_TO_EXTRACT=INODE 363 FLAG_MEM=.FALSE. 364 CALL CMUMPS_LOAD_CHK_MEMCST_POOL(FLAG_MEM) 365 IF(FLAG_MEM)THEN 366 CALL CMUMPS_MEM_NODE_SELECT(INODE,POOL,LPOOL,N, 367 & STEP,KEEP,KEEP8, 368 & PROCNODE,SLAVEF,MYID,SBTR_FLAG, 369 & PROC_FLAG,MIN_PROC) 370 IF(SBTR_FLAG)THEN 371 LEFT=.TRUE. 372 WRITE(*,*)MYID,': ca a change pour moi (4)' 373 GOTO 222 374 ENDIF 375 ELSE 376 CALL CMUMPS_LOAD_CLEAN_MEMINFO_POOL(INODE) 377 ENDIF 378#if ! defined(NOT_ATM_POOL_SPECIAL) 379 ENDIF 380#endif 381 ENDIF 382 ENDIF 383 666 CONTINUE 384 NBTOP = NBTOP - 1 385 IF((INODE.GT.0).AND.(INODE.LE.N))THEN 386 IF ((( KEEP(80) == 2 .OR. KEEP(80)==3 ) .AND. 387 & ( KEEP(47) == 4 ))) THEN 388 CALL CMUMPS_REMOVE_NODE(INODE,2) 389 ENDIF 390 ENDIF 391 IF ( INODE < 0 ) THEN 392 INODE_EFF = -INODE 393 ELSE IF ( INODE > N ) THEN 394 INODE_EFF = INODE - N 395 ELSE 396 INODE_EFF = INODE 397 ENDIF 398 END IF 399 777 CONTINUE 400 POOL(LPOOL) = NBINSUBTREE 401 POOL(LPOOL - 1) = NBTOP 402 POOL(LPOOL - 2) = INSUBTREE 403 RETURN 404 END SUBROUTINE CMUMPS_EXTRACT_POOL 405 SUBROUTINE CMUMPS_MEM_CONS_MNG(INODE,POOL,LPOOL,N,STEP, 406 & KEEP,KEEP8, 407 & PROCNODE,SLAVEF,MYID,SBTR,FLAG_SAME_PROC,MIN_PROC) 408 USE CMUMPS_LOAD 409 IMPLICIT NONE 410 INTEGER INODE,LPOOL,N,MYID,SLAVEF,PROC,MIN_PROC 411 INTEGER POOL(LPOOL),KEEP(500),STEP(N),PROCNODE(KEEP(28)) 412 INTEGER(8) KEEP8(150) 413 INTEGER MUMPS_PROCNODE 414 EXTERNAL MUMPS_PROCNODE 415 LOGICAL SBTR,FLAG_SAME_PROC 416 INTEGER POS_TO_EXTRACT,NODE_TO_EXTRACT,NBTOP,I,INSUBTREE, 417 & NBINSUBTREE 418 DOUBLE PRECISION MIN_COST, TMP_COST 419 NBINSUBTREE = POOL(LPOOL) 420 NBTOP = POOL(LPOOL - 1) 421 INSUBTREE = POOL(LPOOL - 2) 422 MIN_COST=huge(MIN_COST) 423 TMP_COST=huge(TMP_COST) 424 FLAG_SAME_PROC=.FALSE. 425 SBTR=.FALSE. 426 MIN_PROC=-9999 427#if ! defined(NOT_ATM_POOL_SPECIAL) 428 IF((INODE.GT.0).AND.(INODE.LE.N))THEN 429#endif 430 POS_TO_EXTRACT=-1 431 NODE_TO_EXTRACT=-1 432 DO I=NBTOP,1,-1 433 IF(NODE_TO_EXTRACT.LT.0)THEN 434 POS_TO_EXTRACT=I 435 NODE_TO_EXTRACT=POOL(LPOOL-2-I) 436 CALL CMUMPS_LOAD_COMP_MAXMEM_POOL(NODE_TO_EXTRACT, 437 & TMP_COST,PROC) 438 MIN_COST=TMP_COST 439 MIN_PROC=PROC 440 ELSE 441 CALL CMUMPS_LOAD_COMP_MAXMEM_POOL(POOL(LPOOL-2-I), 442 & TMP_COST,PROC) 443 IF((PROC.NE.MIN_PROC).OR.(TMP_COST.NE.MIN_COST))THEN 444 FLAG_SAME_PROC=.TRUE. 445 ENDIF 446 IF(TMP_COST.GT.MIN_COST)THEN 447 POS_TO_EXTRACT=I 448 NODE_TO_EXTRACT=POOL(LPOOL-2-I) 449 MIN_COST=TMP_COST 450 MIN_PROC=PROC 451 ENDIF 452 ENDIF 453 ENDDO 454 IF((KEEP(47).EQ.4).AND.(NBINSUBTREE.NE.0))THEN 455 CALL CMUMPS_CHECK_SBTR_COST(NBINSUBTREE,INSUBTREE,NBTOP, 456 & MIN_COST,SBTR) 457 IF(SBTR)THEN 458 WRITE(*,*)MYID,': selecting from subtree' 459 RETURN 460 ENDIF 461 ENDIF 462 IF((.NOT.SBTR).AND.(.NOT.FLAG_SAME_PROC))THEN 463 WRITE(*,*)MYID,': I must search for a task 464 & to save My friend' 465 RETURN 466 ENDIF 467 INODE = NODE_TO_EXTRACT 468 DO I=POS_TO_EXTRACT,NBTOP 469 IF(I.NE.NBTOP)THEN 470 POOL(LPOOL-2-I)=POOL(LPOOL-2-I-1) 471 ENDIF 472 ENDDO 473 POOL(LPOOL-2-NBTOP)=INODE 474 CALL CMUMPS_LOAD_CLEAN_MEMINFO_POOL(INODE) 475#if ! defined(NOT_ATM_POOL_SPECIAL) 476 ELSE 477 ENDIF 478#endif 479 END SUBROUTINE CMUMPS_MEM_CONS_MNG 480 SUBROUTINE CMUMPS_MEM_NODE_SELECT(INODE,POOL,LPOOL,N,STEP, 481 & KEEP,KEEP8, 482 & PROCNODE,SLAVEF,MYID,SBTR_FLAG,PROC_FLAG,MIN_PROC) 483 USE CMUMPS_LOAD 484 IMPLICIT NONE 485 INTEGER INODE,LPOOL,N,SLAVEF,MYID,MIN_PROC 486 INTEGER POOL(LPOOL),KEEP(500),PROCNODE(KEEP(28)),STEP(N) 487 INTEGER(8) KEEP8(150) 488 LOGICAL SBTR_FLAG,PROC_FLAG 489 EXTERNAL MUMPS_INSSARBR 490 LOGICAL MUMPS_INSSARBR 491 INTEGER NODE_TO_EXTRACT,I,POS_TO_EXTRACT,NBTOP,NBINSUBTREE 492 NBTOP= POOL(LPOOL - 1) 493 NBINSUBTREE = POOL(LPOOL) 494 IF(NBTOP.GT.0)THEN 495 WRITE(*,*)MYID,': NBTOP=',NBTOP 496 ENDIF 497 SBTR_FLAG=.FALSE. 498 PROC_FLAG=.FALSE. 499 CALL CMUMPS_MEM_CONS_MNG(INODE,POOL,LPOOL,N,STEP,KEEP,KEEP8, 500 & PROCNODE,SLAVEF,MYID,SBTR_FLAG,PROC_FLAG,MIN_PROC) 501 IF(SBTR_FLAG)THEN 502 RETURN 503 ENDIF 504 IF(MIN_PROC.EQ.-9999)THEN 505#if ! defined(NOT_ATM_POOL_SPECIAL) 506 IF((INODE.GT.0).AND.(INODE.LT.N))THEN 507#endif 508 SBTR_FLAG=(NBINSUBTREE.NE.0) 509#if ! defined(NOT_ATM_POOL_SPECIAL) 510 ENDIF 511#endif 512 RETURN 513 ENDIF 514 IF(.NOT.PROC_FLAG)THEN 515 NODE_TO_EXTRACT=INODE 516 IF((INODE.GE.0).AND.(INODE.LE.N))THEN 517 CALL CMUMPS_FIND_BEST_NODE_FOR_MEM(MIN_PROC,POOL, 518 & LPOOL,INODE) 519 IF(MUMPS_INSSARBR(PROCNODE(STEP(INODE)), 520 & SLAVEF))THEN 521 WRITE(*,*)MYID,': Extracting from a subtree 522 & for helping',MIN_PROC 523 SBTR_FLAG=.TRUE. 524 RETURN 525 ELSE 526 IF(NODE_TO_EXTRACT.NE.INODE)THEN 527 WRITE(*,*)MYID,': Extracting from top 528 & inode=',INODE,'for helping',MIN_PROC 529 ENDIF 530 CALL CMUMPS_LOAD_CLEAN_MEMINFO_POOL(INODE) 531 ENDIF 532 ENDIF 533 DO I=1,NBTOP 534 IF (POOL(LPOOL-2-I).EQ.INODE)THEN 535 GOTO 452 536 ENDIF 537 ENDDO 538 452 CONTINUE 539 POS_TO_EXTRACT=I 540 DO I=POS_TO_EXTRACT,NBTOP-1 541 POOL(LPOOL-2-I)=POOL(LPOOL-2-I-1) 542 ENDDO 543 POOL(LPOOL-2-NBTOP)=INODE 544 ENDIF 545 END SUBROUTINE CMUMPS_MEM_NODE_SELECT 546 SUBROUTINE CMUMPS_GET_INODE_FROM_POOL 547 & ( IPOOL, LPOOL, III, LEAF, 548 & INODE, STRATEGIE ) 549 IMPLICIT NONE 550 INTEGER, INTENT(IN) :: STRATEGIE, LPOOL 551 INTEGER IPOOL (LPOOL) 552 INTEGER III,LEAF 553 INTEGER, INTENT(OUT) :: INODE 554 LEAF = LEAF - 1 555 INODE = IPOOL( LEAF ) 556 RETURN 557 END SUBROUTINE CMUMPS_GET_INODE_FROM_POOL 558