1C 2C This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 3C 4C 5C This version of MUMPS is provided to you free of charge. It is public 6C domain, based on public domain software developed during the Esprit IV 7C European project PARASOL (1996-1999). Since this first public domain 8C version in 1999, research and developments have been supported by the 9C following institutions: CERFACS, CNRS, ENS Lyon, INPT(ENSEEIHT)-IRIT, 10C INRIA, and University of Bordeaux. 11C 12C The MUMPS team at the moment of releasing this version includes 13C Patrick Amestoy, Maurice Bremond, Alfredo Buttari, Abdou Guermouche, 14C Guillaume Joslin, Jean-Yves L'Excellent, Francois-Henry Rouet, Bora 15C Ucar and Clement Weisbecker. 16C 17C We are also grateful to Emmanuel Agullo, Caroline Bousquet, Indranil 18C Chowdhury, Philippe Combes, Christophe Daniel, Iain Duff, Vincent Espirat, 19C Aurelia Fevre, Jacko Koster, Stephane Pralet, Chiara Puglisi, Gregoire 20C Richard, Tzvetomila Slavova, Miroslav Tuma and Christophe Voemel who 21C have been contributing to this project. 22C 23C Up-to-date copies of the MUMPS package can be obtained 24C from the Web pages: 25C http://mumps.enseeiht.fr/ or http://graal.ens-lyon.fr/MUMPS 26C 27C 28C THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY 29C EXPRESSED OR IMPLIED. ANY USE IS AT YOUR OWN RISK. 30C 31C 32C User documentation of any code that uses this software can 33C include this complete notice. You can acknowledge (using 34C references [1] and [2]) the contribution of this package 35C in any scientific publication dependent upon the use of the 36C package. You shall use reasonable endeavours to notify 37C the authors of the package of this publication. 38C 39C [1] P. R. Amestoy, I. S. Duff, J. Koster and J.-Y. L'Excellent, 40C A fully asynchronous multifrontal solver using distributed dynamic 41C scheduling, SIAM Journal of Matrix Analysis and Applications, 42C Vol 23, No 1, pp 15-41 (2001). 43C 44C [2] P. R. Amestoy and A. Guermouche and J.-Y. L'Excellent and 45C S. Pralet, Hybrid scheduling for the parallel solution of linear 46C systems. Parallel Computing Vol 32 (2), pp 136-156 (2006). 47C 48 MODULE CMUMPS_LOAD 49 implicit none 50 PUBLIC :: CMUMPS_188, CMUMPS_185, 51 & CMUMPS_189, CMUMPS_190, 52 & CMUMPS_183, CMUMPS_187, 53 & CMUMPS_186, CMUMPS_409, 54 & CMUMPS_384, CMUMPS_461, 55 & CMUMPS_467, CMUMPS_471, 56 & CMUMPS_472, 57 & CMUMPS_791, CMUMPS_790, 58 & CMUMPS_792, CMUMPS_500, 59 & CMUMPS_501, CMUMPS_520, 60 & CMUMPS_513, 61 & CMUMPS_514, CMUMPS_512 62 & ,CMUMPS_533, 63 & CMUMPS_819, CMUMPS_818, 64 & CMUMPS_820, CMUMPS_554, 65 & CMUMPS_553, 66 & CMUMPS_555 67 DOUBLE PRECISION, DIMENSION(:), 68 & ALLOCATABLE, SAVE, PRIVATE :: LOAD_FLOPS 69 INTEGER, DIMENSION(:), ALLOCATABLE, SAVE, PRIVATE :: BUF_LOAD_RECV 70 INTEGER, SAVE, PRIVATE :: LBUF_LOAD_RECV, LBUF_LOAD_RECV_BYTES 71 INTEGER, SAVE, PRIVATE :: K50, K69, K35 72 INTEGER(8), SAVE, PRIVATE :: MAX_SURF_MASTER 73 LOGICAL, SAVE, PRIVATE :: BDC_MEM, BDC_POOL, BDC_SBTR, 74 & BDC_POOL_MNG, 75 & BDC_M2_MEM,BDC_M2_FLOPS,BDC_MD,REMOVE_NODE_FLAG, 76 & REMOVE_NODE_FLAG_MEM 77 DOUBLE PRECISION, SAVE, PRIVATE :: REMOVE_NODE_COST, 78 & REMOVE_NODE_COST_MEM 79 INTEGER, SAVE, PRIVATE :: SBTR_WHICH_M 80 DOUBLE PRECISION, DIMENSION(:), 81 & ALLOCATABLE, TARGET, SAVE, PRIVATE :: WLOAD 82#if defined(OLD_LOAD_MECHANISM) 83#if defined(CHECK_COHERENCE) 84 INTEGER, SAVE, PRIVATE :: NB_LEVEL2 85 LOGICAL, PRIVATE :: AMI_CHOSEN,IS_DISPLAYED 86#endif 87#endif 88#if ! defined(OLD_LOAD_MECHANISM) 89 INTEGER, DIMENSION(:), ALLOCATABLE, SAVE, PRIVATE :: FUTURE_NIV2 90 DOUBLE PRECISION, SAVE, PRIVATE :: DELTA_LOAD, DELTA_MEM 91#else 92 DOUBLE PRECISION, SAVE, PRIVATE :: LAST_LOAD_SENT, 93 & DM_LAST_MEM_SENT 94#endif 95 INTEGER(8), SAVE, PRIVATE :: CHECK_MEM 96 INTEGER, DIMENSION(:), ALLOCATABLE, SAVE, TARGET, PRIVATE :: 97 & IDWLOAD 98 DOUBLE PRECISION, SAVE, PRIVATE :: COST_SUBTREE 99 DOUBLE PRECISION, SAVE, PRIVATE :: ALPHA 100 DOUBLE PRECISION, SAVE, PRIVATE :: BETA 101 INTEGER, SAVE, PRIVATE :: MYID, NPROCS, COMM_LD 102 DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE, SAVE, 103 & PRIVATE :: POOL_MEM 104 DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE, PRIVATE, 105 & SAVE :: SBTR_MEM 106 DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE, 107 & PRIVATE, SAVE :: SBTR_CUR 108 INTEGER, DIMENSION(:), ALLOCATABLE, 109 & PRIVATE, SAVE :: NB_SON 110 DOUBLE PRECISION, 111 & PRIVATE, SAVE :: SBTR_CUR_LOCAL 112 DOUBLE PRECISION, 113 & PRIVATE, SAVE :: PEAK_SBTR_CUR_LOCAL 114 DOUBLE PRECISION, 115 & PRIVATE, SAVE :: MAX_PEAK_STK 116 DOUBLE PRECISION, SAVE, 117 & PRIVATE :: POOL_LAST_COST_SENT 118 DOUBLE PRECISION, SAVE, 119 & PRIVATE :: MIN_DIFF 120 INTEGER, SAVE :: POS_ID,POS_MEM 121 INTEGER, DIMENSION(:), ALLOCATABLE, SAVE :: CB_COST_ID 122 INTEGER(8), DIMENSION(:), ALLOCATABLE, SAVE 123 & :: CB_COST_MEM 124 PUBLIC :: CB_COST_ID, CB_COST_MEM,POS_MEM,POS_ID 125 DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE :: LU_USAGE 126 INTEGER(8), DIMENSION(:), ALLOCATABLE, SAVE, 127 & PRIVATE::MD_MEM, TAB_MAXS 128 DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE, SAVE ::MEM_SUBTREE 129 INTEGER :: NB_SUBTREES,NIV1_FLAG 130 INTEGER, PRIVATE :: INDICE_SBTR,INDICE_SBTR_ARRAY 131 INTEGER,SAVE :: INSIDE_SUBTREE 132 PUBLIC :: NB_SUBTREES,MEM_SUBTREE,INSIDE_SUBTREE,NIV1_FLAG 133 DOUBLE PRECISION, SAVE, PRIVATE :: DM_SUMLU, 134 & DM_THRES_MEM 135 DOUBLE PRECISION, DIMENSION(:), 136 & ALLOCATABLE, SAVE , PRIVATE:: DM_MEM 137 INTEGER, SAVE, PRIVATE :: POOL_SIZE,ID_MAX_M2 138 DOUBLE PRECISION, SAVE, PRIVATE :: MAX_M2,TMP_M2 139 INTEGER, DIMENSION(:),ALLOCATABLE,SAVE, PRIVATE:: POOL_NIV2 140 DOUBLE PRECISION, DIMENSION(:),ALLOCATABLE,SAVE, 141 & PRIVATE :: POOL_NIV2_COST, NIV2 142 DOUBLE PRECISION, SAVE, PRIVATE :: CHK_LD 143 INTEGER, DIMENSION(:),POINTER, SAVE, PRIVATE :: 144 & PROCNODE_LOAD, STEP_TO_NIV2_LOAD 145 INTEGER, DIMENSION(:),POINTER, SAVE, PRIVATE :: KEEP_LOAD 146 INTEGER, SAVE, PRIVATE :: N_LOAD 147 INTEGER(8), DIMENSION(:), POINTER, SAVE, PRIVATE:: KEEP8_LOAD 148 INTEGER, DIMENSION(:),POINTER, SAVE :: 149 & FILS_LOAD, STEP_LOAD, 150 & FRERE_LOAD, ND_LOAD, 151 & NE_LOAD,DAD_LOAD 152 INTEGER, DIMENSION(:,:),POINTER, SAVE, PRIVATE :: CAND_LOAD 153 INTEGER, DIMENSION(:),POINTER, SAVE, 154 & PRIVATE :: MY_FIRST_LEAF,MY_NB_LEAF, MY_ROOT_SBTR 155 INTEGER, DIMENSION(:),ALLOCATABLE,SAVE, 156 & PRIVATE ::SBTR_FIRST_POS_IN_POOL 157 DOUBLE PRECISION, DIMENSION(:),ALLOCATABLE,SAVE, 158 & PRIVATE ::SBTR_PEAK_ARRAY, 159 & SBTR_CUR_ARRAY 160 DOUBLE PRECISION,DIMENSION(:),POINTER, SAVE :: COST_TRAV 161 INTEGER, DIMENSION(:),POINTER, SAVE :: DEPTH_FIRST_LOAD, 162 & DEPTH_FIRST_SEQ_LOAD,SBTR_ID_LOAD 163 PUBLIC :: DEPTH_FIRST_LOAD,COST_TRAV, FILS_LOAD,STEP_LOAD, 164 & FRERE_LOAD, ND_LOAD,NE_LOAD,DAD_LOAD, 165 & DEPTH_FIRST_SEQ_LOAD,SBTR_ID_LOAD 166 INTEGER, SAVE :: ROOT_CURRENT_SUBTREE,CURRENT_BEST, 167 & SECOND_CURRENT_BEST 168 PUBLIC :: ROOT_CURRENT_SUBTREE,CURRENT_BEST, 169 & SECOND_CURRENT_BEST 170 CONTAINS 171 SUBROUTINE CMUMPS_188( COST_SUBTREE_ARG, K64, K66, 172 & MAXS ) 173 IMPLICIT NONE 174 DOUBLE PRECISION COST_SUBTREE_ARG 175 INTEGER K64, K66 176 INTEGER(8)::MAXS 177 DOUBLE PRECISION T64, T66 178 T64 = max ( dble(K64), dble(1) ) 179 T64 = min ( T64, dble(1000) ) 180 T66 = max (dble(K66), dble(100)) 181 MIN_DIFF = ( T64 / dble(1000) )* 182 & T66 * dble(1000000) 183 DM_THRES_MEM = dble(MAXS/1000_8) 184 COST_SUBTREE = COST_SUBTREE_ARG 185 END SUBROUTINE CMUMPS_188 186 SUBROUTINE CMUMPS_791 ( 187 & INODE, STEP, N, SLAVEF, 188 & PROCNODE_STEPS, KEEP, DAD, FILS, 189 & CAND, ICNTL, COPY_CAND, 190 & NBSPLIT, NUMORG_SPLIT, SLAVES_LIST, 191 & SIZE_SLAVES_LIST 192 & ) 193 IMPLICIT NONE 194 INTEGER, intent(in) :: INODE, N, SIZE_SLAVES_LIST, SLAVEF, 195 & KEEP(500) 196 INTEGER, intent(in) :: STEP(N), DAD (KEEP(28)), ICNTL(40), 197 & PROCNODE_STEPS(KEEP(28)), CAND(SLAVEF+1), 198 & FILS(N) 199 INTEGER, intent(out) :: NBSPLIT, NUMORG_SPLIT 200 INTEGER, intent(inout) :: SLAVES_LIST(SIZE_SLAVES_LIST), 201 & COPY_CAND(SLAVEF+1) 202 INTEGER :: IN, LP, II 203 INTEGER MUMPS_810 204 EXTERNAL MUMPS_810 205 LP = ICNTL(1) 206 IN = INODE 207 NBSPLIT = 0 208 NUMORG_SPLIT = 0 209 DO WHILE 210 & ( 211 & ( MUMPS_810 212 & (PROCNODE_STEPS(STEP(DAD(STEP(IN)))),SLAVEF) 213 & .EQ.5 214 & ) 215 & .OR. 216 & ( MUMPS_810 217 & (PROCNODE_STEPS(STEP(DAD(STEP(IN)))),SLAVEF) 218 & .EQ.6 219 & ) 220 & ) 221 NBSPLIT = NBSPLIT + 1 222 IN = DAD(STEP(IN)) 223 II = IN 224 DO WHILE (II.GT.0) 225 NUMORG_SPLIT = NUMORG_SPLIT + 1 226 II = FILS(II) 227 ENDDO 228 END DO 229 SLAVES_LIST(1:NBSPLIT) = CAND(1:NBSPLIT) 230 COPY_CAND(1:SIZE_SLAVES_LIST-NBSPLIT) = 231 & CAND(1+NBSPLIT:SIZE_SLAVES_LIST) 232 COPY_CAND(SIZE_SLAVES_LIST-NBSPLIT+1:SLAVEF) = -1 233 COPY_CAND(SLAVEF+1) = SIZE_SLAVES_LIST-NBSPLIT 234 RETURN 235 END SUBROUTINE CMUMPS_791 236 SUBROUTINE CMUMPS_790 ( 237 & INODE, STEP, N, SLAVEF, NBSPLIT, NCB, 238 & PROCNODE_STEPS, KEEP, DAD, FILS, ICNTL, 239 & TAB_POS, NSLAVES_NODE 240 & ) 241 IMPLICIT NONE 242 INTEGER, intent(in) :: INODE, N, SLAVEF, NCB, 243 & KEEP(500), NBSPLIT 244 INTEGER, intent(in) :: STEP(N), DAD (KEEP(28)), ICNTL(40), 245 & PROCNODE_STEPS(KEEP(28)), 246 & FILS(N) 247 INTEGER, intent(inout) :: TAB_POS ( SLAVEF+2 ), NSLAVES_NODE 248 INTEGER :: IN, LP, II, NUMORG, NBSPLIT_LOC, I 249 INTEGER MUMPS_810 250 EXTERNAL MUMPS_810 251 DO I= NSLAVES_NODE+1, 1, -1 252 TAB_POS(I+NBSPLIT) = TAB_POS(I) 253 END DO 254 LP = ICNTL(1) 255 IN = INODE 256 NBSPLIT_LOC = 0 257 NUMORG = 0 258 TAB_POS(1) = 1 259 DO WHILE 260 & ( 261 & ( MUMPS_810 262 & (PROCNODE_STEPS(STEP(DAD(STEP(IN)))),SLAVEF) 263 & .EQ.5 264 & ) 265 & .OR. 266 & ( MUMPS_810 267 & (PROCNODE_STEPS(STEP(DAD(STEP(IN)))),SLAVEF) 268 & .EQ.6 269 & ) 270 & ) 271 NBSPLIT_LOC = NBSPLIT_LOC + 1 272 IN = DAD(STEP(IN)) 273 II = IN 274 DO WHILE (II.GT.0) 275 NUMORG = NUMORG + 1 276 II = FILS(II) 277 ENDDO 278 TAB_POS(NBSPLIT_LOC+1) = NUMORG + 1 279 END DO 280 DO I = NBSPLIT+2, NBSPLIT+NSLAVES_NODE+1 281 TAB_POS(I) = TAB_POS(I) + NUMORG 282 ENDDO 283 NSLAVES_NODE = NSLAVES_NODE + NBSPLIT 284 TAB_POS (NSLAVES_NODE+2:SLAVEF+1) = -9999 285 TAB_POS ( SLAVEF+2 ) = NSLAVES_NODE 286 RETURN 287 END SUBROUTINE CMUMPS_790 288 SUBROUTINE CMUMPS_792 ( 289 & INODE, TYPESPLIT, IFSON, 290 & SON_SLAVE_LIST, NSLSON, 291 & STEP, N, SLAVEF, NBSPLIT, NCB, 292 & PROCNODE_STEPS, KEEP, DAD, FILS, ICNTL, 293 & ISTEP_TO_INIV2, INIV2, 294 & TAB_POS_IN_PERE, NSLAVES_NODE, 295 & SLAVES_LIST, SIZE_SLAVES_LIST 296 & ) 297 IMPLICIT NONE 298 INTEGER, intent(in) :: INODE, TYPESPLIT, IFSON, N, SLAVEF, 299 & NCB, KEEP(500), NBSPLIT, 300 & NSLSON, SIZE_SLAVES_LIST 301 INTEGER, intent(in) :: STEP(N), DAD (KEEP(28)), ICNTL(40), 302 & PROCNODE_STEPS(KEEP(28)), 303 & FILS(N), INIV2, 304 & SON_SLAVE_LIST (NSLSON), 305 & ISTEP_TO_INIV2(KEEP(71)) 306 INTEGER, intent(out) :: NSLAVES_NODE 307 INTEGER, intent(inout) :: 308 & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) 309 INTEGER, intent(out) :: SLAVES_LIST (SIZE_SLAVES_LIST) 310 INTEGER :: IN, LP, I, NSLAVES_SONS, 311 & INIV2_FILS, ISHIFT 312 LP = ICNTL(1) 313 IN = INODE 314 INIV2_FILS = ISTEP_TO_INIV2( STEP( IFSON )) 315 NSLAVES_SONS = TAB_POS_IN_PERE (SLAVEF+2, INIV2_FILS) 316 TAB_POS_IN_PERE (1,INIV2) = 1 317 ISHIFT = TAB_POS_IN_PERE (2, INIV2_FILS) -1 318 DO I = 2, NSLAVES_SONS 319 TAB_POS_IN_PERE (I,INIV2) = 320 & TAB_POS_IN_PERE (I+1,INIV2_FILS) - ISHIFT 321 SLAVES_LIST(I-1) = SON_SLAVE_LIST (I) 322 END DO 323 TAB_POS_IN_PERE(NSLAVES_SONS+1:SLAVEF+1,INIV2) = -9999 324 NSLAVES_NODE = NSLAVES_SONS - 1 325 TAB_POS_IN_PERE (SLAVEF+2, INIV2) = NSLAVES_NODE 326 RETURN 327 END SUBROUTINE CMUMPS_792 328 SUBROUTINE CMUMPS_472( 329 & NCBSON_MAX, SLAVEF, 330 & KEEP,KEEP8,ICNTL, 331 & CAND_OF_NODE, 332 & MEM_DISTRIB, NCB, NFRONT, NSLAVES_NODE, 333 & TAB_POS, SLAVES_LIST, SIZE_SLAVES_LIST,INODE) 334 IMPLICIT NONE 335 INTEGER, intent(in) :: KEEP(500),SIZE_SLAVES_LIST 336 INTEGER(8) KEEP8(150) 337 INTEGER, intent(in) :: ICNTL(40) 338 INTEGER, intent(in) :: SLAVEF, NFRONT 339 INTEGER, intent (inout) ::NCB 340 INTEGER, intent(in) :: CAND_OF_NODE(SLAVEF+1) 341 INTEGER, intent(in) :: MEM_DISTRIB(0:SLAVEF-1),INODE 342 INTEGER, intent(in) :: NCBSON_MAX 343 INTEGER, intent(out):: SLAVES_LIST(SIZE_SLAVES_LIST) 344 INTEGER, intent(out):: TAB_POS(SLAVEF+2) 345 INTEGER, intent(out):: NSLAVES_NODE 346 INTEGER i 347 INTEGER LP,MP 348 LP=ICNTL(4) 349 MP=ICNTL(2) 350 IF ( KEEP(48) == 0 .OR. KEEP(48) .EQ. 3 ) THEN 351 CALL CMUMPS_499( 352 & SLAVEF, 353 & KEEP,KEEP8, 354 & CAND_OF_NODE, 355 & MEM_DISTRIB, NCB, NFRONT, NSLAVES_NODE, 356 & TAB_POS, SLAVES_LIST, SIZE_SLAVES_LIST) 357 ELSE IF ( KEEP(48) == 4 ) THEN 358 CALL CMUMPS_504( 359 & SLAVEF, 360 & KEEP,KEEP8, 361 & CAND_OF_NODE, 362 & MEM_DISTRIB, NCB, NFRONT, NSLAVES_NODE, 363 & TAB_POS, SLAVES_LIST, SIZE_SLAVES_LIST,MYID) 364 DO i=1,NSLAVES_NODE 365 IF(TAB_POS(i+1)-TAB_POS(i).LE.0)THEN 366 WRITE(*,*)'probleme de partition dans 367 &CMUMPS_545' 368 CALL MUMPS_ABORT() 369 ENDIF 370 ENDDO 371 ELSE IF ( KEEP(48) == 5 ) THEN 372 CALL CMUMPS_518( 373 & NCBSON_MAX, 374 & SLAVEF, 375 & KEEP,KEEP8, 376 & CAND_OF_NODE, 377 & MEM_DISTRIB, NCB, NFRONT, NSLAVES_NODE, 378 & TAB_POS, SLAVES_LIST, SIZE_SLAVES_LIST,MYID,INODE, 379 & MP,LP) 380 DO i=1,NSLAVES_NODE 381 IF(TAB_POS(i+1)-TAB_POS(i).LE.0)THEN 382 WRITE(*,*)'problem with partition in 383 &CMUMPS_518' 384 CALL MUMPS_ABORT() 385 ENDIF 386 ENDDO 387 ELSE 388 WRITE(*,*) "Strategy 6 not implemented" 389 CALL MUMPS_ABORT() 390 ENDIF 391 RETURN 392 END SUBROUTINE CMUMPS_472 393 SUBROUTINE CMUMPS_499( 394 & SLAVEF, 395 & KEEP,KEEP8, 396 & CAND_OF_NODE, 397 & MEM_DISTRIB, NCB, NFRONT, NSLAVES_NODE, 398 & TAB_POS, SLAVES_LIST, SIZE_SLAVES_LIST) 399 IMPLICIT NONE 400 INTEGER, intent(in) :: KEEP(500),SIZE_SLAVES_LIST 401 INTEGER(8) KEEP8(150) 402 INTEGER, intent(in) :: SLAVEF, NFRONT, NCB 403 INTEGER, intent(in) :: CAND_OF_NODE(SLAVEF+1) 404 INTEGER, intent(in) :: MEM_DISTRIB(0:SLAVEF-1) 405 INTEGER, intent(out):: SLAVES_LIST(SIZE_SLAVES_LIST) 406 INTEGER, intent(out):: TAB_POS(SLAVEF+2) 407 INTEGER, intent(out):: NSLAVES_NODE 408 INTEGER ITEMP, NMB_OF_CAND, NSLAVES_LESS 409 DOUBLE PRECISION MSG_SIZE 410 LOGICAL FORCE_CAND 411 INTEGER MUMPS_12 412 EXTERNAL MUMPS_12 413 IF ( KEEP(48) == 0 .AND. KEEP(50) .NE. 0) THEN 414 write(*,*) "Internal error 2 in CMUMPS_499." 415 CALL MUMPS_ABORT() 416 END IF 417 IF ( KEEP(48) == 3 .AND. KEEP(50) .EQ. 0) THEN 418 write(*,*) "Internal error 3 in CMUMPS_499." 419 CALL MUMPS_ABORT() 420 END IF 421 MSG_SIZE = dble( NFRONT - NCB ) * dble(NCB) 422 IF ( KEEP(24) == 0 .OR. KEEP(24) == 1 ) THEN 423 FORCE_CAND = .FALSE. 424 ELSE 425 FORCE_CAND = (mod(KEEP(24),2).eq.0) 426 END IF 427 IF (FORCE_CAND) THEN 428 ITEMP=CMUMPS_409 429 & (MEM_DISTRIB, 430 & CAND_OF_NODE, 431 & 432 & KEEP(69), SLAVEF, MSG_SIZE, 433 & NMB_OF_CAND ) 434 ELSE 435 ITEMP=CMUMPS_186(KEEP(69),MEM_DISTRIB,MSG_SIZE) 436 NMB_OF_CAND = SLAVEF - 1 437 END IF 438 NSLAVES_LESS = max(ITEMP,1) 439 NSLAVES_NODE = MUMPS_12(KEEP8(21), KEEP(48), 440 & KEEP(50),SLAVEF, 441 & NCB, NFRONT, NSLAVES_LESS, NMB_OF_CAND) 442 CALL MUMPS_441( 443 & KEEP,KEEP8, SLAVEF, 444 & TAB_POS, 445 & NSLAVES_NODE, NFRONT, NCB 446 & ) 447 IF (FORCE_CAND) THEN 448 CALL CMUMPS_384(MEM_DISTRIB(0), 449 & CAND_OF_NODE, SLAVEF, NSLAVES_NODE, 450 & SLAVES_LIST) 451 ELSE 452 CALL CMUMPS_189(MEM_DISTRIB(0), 453 & MSG_SIZE, SLAVES_LIST, NSLAVES_NODE) 454 ENDIF 455 RETURN 456 END SUBROUTINE CMUMPS_499 457 SUBROUTINE CMUMPS_185( id, MEMORY_MD_ARG, MAXS ) 458 USE CMUMPS_COMM_BUFFER 459 USE CMUMPS_STRUC_DEF 460 IMPLICIT NONE 461 TYPE(CMUMPS_STRUC), TARGET :: id 462 INTEGER(8), intent(in) :: MEMORY_MD_ARG 463 INTEGER(8), intent(in) :: MAXS 464 INTEGER K34_LOC,K35_LOC 465 INTEGER allocok, IERR, i, BUF_LOAD_SIZE 466 DOUBLE PRECISION :: MAX_SBTR 467 DOUBLE PRECISION ZERO 468 DOUBLE PRECISION MEMORY_SENT 469 INTEGER,DIMENSION(:),POINTER:: KEEP 470 PARAMETER( ZERO=0.0d0 ) 471 INTEGER WHAT 472 INTEGER(8) MEMORY_MD, LA 473 STEP_TO_NIV2_LOAD=>id%ISTEP_TO_INIV2 474 CAND_LOAD=>id%CANDIDATES 475 ND_LOAD=>id%ND_STEPS 476 KEEP_LOAD=>id%KEEP 477 KEEP =>id%KEEP 478 KEEP8_LOAD=>id%KEEP8 479 FILS_LOAD=>id%FILS 480 FRERE_LOAD=>id%FRERE_STEPS 481 DAD_LOAD=>id%DAD_STEPS 482 PROCNODE_LOAD=>id%PROCNODE_STEPS 483 STEP_LOAD=>id%STEP 484 NE_LOAD=>id%NE_STEPS 485 N_LOAD=id%N 486 ROOT_CURRENT_SUBTREE=-9999 487 MEMORY_MD=MEMORY_MD_ARG 488 LA=MAXS 489 MAX_SURF_MASTER=id%MAX_SURF_MASTER+ 490 & (int(id%KEEP(12),8)*int(id%MAX_SURF_MASTER,8)/int(100,8)) 491 COMM_LD = id%COMM_LOAD 492 MAX_PEAK_STK = 0.0D0 493 K69 = KEEP(69) 494 IF ( KEEP(47) .le. 0 .OR. KEEP(47) .gt. 4 ) THEN 495 write(*,*) "Internal error 1 in CMUMPS_185" 496 CALL MUMPS_ABORT() 497 END IF 498 CHK_LD=dble(0) 499 BDC_MEM = ( KEEP(47) >= 2 ) 500 BDC_POOL = ( KEEP(47) >= 3 ) 501 BDC_SBTR = ( KEEP(47) >= 4 ) 502 BDC_M2_MEM = ( ( KEEP(80) == 2 .OR. KEEP(80) == 3 ) 503 & .AND. KEEP(47) == 4 ) 504 BDC_M2_FLOPS = ( KEEP(80) == 1 505 & .AND. KEEP(47) .GE. 1 ) 506 BDC_MD = (KEEP(86)==1) 507 SBTR_WHICH_M = KEEP(90) 508 REMOVE_NODE_FLAG=.FALSE. 509 REMOVE_NODE_FLAG_MEM=.FALSE. 510 REMOVE_NODE_COST_MEM=dble(0) 511 REMOVE_NODE_COST=dble(0) 512 IF (KEEP(80) .LT. 0 .OR. KEEP(80)>3) THEN 513 WRITE(*,*) "Unimplemented KEEP(80) Strategy" 514 CALL MUMPS_ABORT() 515 ENDIF 516 IF ((KEEP(80) == 2 .OR. KEEP(80)==3 ).AND. KEEP(47).NE.4) 517 & THEN 518 WRITE(*,*) "Internal error 3 in CMUMPS_185" 519 CALL MUMPS_ABORT() 520 END IF 521 IF (KEEP(81) == 1 .AND. KEEP(47) < 2) THEN 522 WRITE(*,*) "Internal error 2 in CMUMPS_185" 523 CALL MUMPS_ABORT() 524 ENDIF 525 BDC_POOL_MNG = ((KEEP(81) == 1).AND.(KEEP(47) >= 2)) 526 IF(KEEP(76).EQ.4)THEN 527 DEPTH_FIRST_LOAD=>id%DEPTH_FIRST 528 ENDIF 529 IF(KEEP(76).EQ.5)THEN 530 COST_TRAV=>id%COST_TRAV 531 ENDIF 532 IF(KEEP(76).EQ.6)THEN 533 DEPTH_FIRST_LOAD=>id%DEPTH_FIRST 534 DEPTH_FIRST_SEQ_LOAD=>id%DEPTH_FIRST_SEQ 535 SBTR_ID_LOAD=>id%SBTR_ID 536 ENDIF 537 IF (BDC_M2_MEM.OR.BDC_M2_FLOPS) THEN 538 ALLOCATE(NIV2(id%NSLAVES), NB_SON(KEEP(28)), 539 & POOL_NIV2(100),POOL_NIV2_COST(100), 540 & stat=allocok) 541 NB_SON=id%NE_STEPS 542 NIV2=dble(0) 543 IF (allocok > 0) THEN 544 WRITE(*,*) 'PB allocation in CMUMPS_185' 545 id%INFO(1) = -13 546 id%INFO(2) = id%NSLAVES + KEEP(28) + 200 547 RETURN 548 ENDIF 549 ENDIF 550 K50 = id%KEEP(50) 551 CALL MPI_COMM_RANK( COMM_LD, MYID, IERR ) 552 NPROCS = id%NSLAVES 553 DM_SUMLU=ZERO 554 POOL_SIZE=0 555 IF(BDC_MD)THEN 556 IF ( allocated(MD_MEM) ) DEALLOCATE(MD_MEM) 557 ALLOCATE( MD_MEM( 0: NPROCS - 1 ), stat=allocok ) 558 IF ( allocok .gt. 0 ) THEN 559 WRITE(*,*) 'PB allocation in CMUMPS_185' 560 id%INFO(1) = -13 561 id%INFO(2) = NPROCS 562 RETURN 563 END IF 564 IF ( allocated(TAB_MAXS) ) DEALLOCATE(TAB_MAXS) 565 ALLOCATE( TAB_MAXS( 0: NPROCS - 1 ), stat=allocok ) 566 IF ( allocok .gt. 0 ) THEN 567 WRITE(*,*) 'PB allocation in CMUMPS_185' 568 id%INFO(1) = -13 569 id%INFO(2) = NPROCS 570 RETURN 571 END IF 572 TAB_MAXS=0_8 573 IF ( allocated(LU_USAGE) ) DEALLOCATE(LU_USAGE) 574 ALLOCATE( LU_USAGE( 0: NPROCS - 1 ), stat=allocok ) 575 IF ( allocok .gt. 0 ) THEN 576 WRITE(*,*) 'PB allocation in CMUMPS_185' 577 id%INFO(1) = -13 578 id%INFO(2) = NPROCS 579 RETURN 580 END IF 581 LU_USAGE=dble(0) 582 MD_MEM=int(0,8) 583 ENDIF 584 IF((KEEP(81).EQ.2).OR.(KEEP(81).EQ.3))THEN 585 ALLOCATE(CB_COST_MEM(2*2000*id%NSLAVES), 586 & stat=allocok) 587 IF (allocok > 0) THEN 588 WRITE(*,*) 'PB allocation in CMUMPS_185' 589 id%INFO(1) = -13 590 id%INFO(2) = id%NSLAVES 591 RETURN 592 ENDIF 593 CB_COST_MEM=int(0,8) 594 ALLOCATE(CB_COST_ID(2000*3), 595 & stat=allocok) 596 IF (allocok > 0) THEN 597 WRITE(*,*) 'PB allocation in CMUMPS_185' 598 id%INFO(1) = -13 599 id%INFO(2) = id%NSLAVES 600 RETURN 601 ENDIF 602 CB_COST_ID=0 603 POS_MEM=1 604 POS_ID=1 605 ENDIF 606#if ! defined(OLD_LOAD_MECHANISM) 607 ALLOCATE(FUTURE_NIV2(NPROCS), stat=allocok) 608 IF (allocok > 0 ) THEN 609 WRITE(*,*) 'PB allocation in CMUMPS_185' 610 id%INFO(1) = -13 611 id%INFO(2) = NPROCS 612 RETURN 613 ENDIF 614 DO i = 1, NPROCS 615 FUTURE_NIV2(i) = id%FUTURE_NIV2(i) 616 IF(BDC_MD)THEN 617 IF(FUTURE_NIV2(i).EQ.0)THEN 618 MD_MEM(i-1)=999999999_8 619 ENDIF 620 ENDIF 621 ENDDO 622 DELTA_MEM=ZERO 623 DELTA_LOAD=ZERO 624#endif 625 CHECK_MEM=0_8 626#if defined(OLD_LOAD_MECHANISM) 627#if defined(CHECK_COHERENCE) 628 NB_LEVEL2=0 629 AMI_CHOSEN=.FALSE. 630 IS_DISPLAYED=.FALSE. 631#endif 632#endif 633 IF(BDC_SBTR.OR.BDC_POOL_MNG)THEN 634 NB_SUBTREES=id%NBSA_LOCAL 635 IF (allocated(MEM_SUBTREE)) DEALLOCATE(MEM_SUBTREE) 636 ALLOCATE(MEM_SUBTREE(id%NBSA_LOCAL),stat=allocok) 637 DO i=1,id%NBSA_LOCAL 638 MEM_SUBTREE(i)=id%MEM_SUBTREE(i) 639 ENDDO 640 MY_FIRST_LEAF=>id%MY_FIRST_LEAF 641 MY_NB_LEAF=>id%MY_NB_LEAF 642 MY_ROOT_SBTR=>id%MY_ROOT_SBTR 643 IF (allocated(SBTR_FIRST_POS_IN_POOL)) 644 & DEALLOCATE(SBTR_FIRST_POS_IN_POOL) 645 ALLOCATE(SBTR_FIRST_POS_IN_POOL(id%NBSA_LOCAL),stat=allocok) 646 INSIDE_SUBTREE=0 647 PEAK_SBTR_CUR_LOCAL = dble(0) 648 SBTR_CUR_LOCAL = dble(0) 649 IF (allocated(SBTR_PEAK_ARRAY)) DEALLOCATE(SBTR_PEAK_ARRAY) 650 ALLOCATE(SBTR_PEAK_ARRAY(id%NBSA_LOCAL),stat=allocok) 651 SBTR_PEAK_ARRAY=dble(0) 652 IF (allocated(SBTR_CUR_ARRAY)) DEALLOCATE(SBTR_CUR_ARRAY) 653 ALLOCATE(SBTR_CUR_ARRAY(id%NBSA_LOCAL),stat=allocok) 654 SBTR_CUR_ARRAY=dble(0) 655 INDICE_SBTR_ARRAY=1 656 NIV1_FLAG=0 657 INDICE_SBTR=1 658 ENDIF 659 IF ( allocated(LOAD_FLOPS) ) DEALLOCATE( LOAD_FLOPS ) 660 ALLOCATE( LOAD_FLOPS( 0: NPROCS - 1 ), stat=allocok ) 661 IF ( allocok .gt. 0 ) THEN 662 WRITE(*,*) 'PB allocation in CMUMPS_185' 663 id%INFO(1) = -13 664 id%INFO(2) = NPROCS 665 RETURN 666 END IF 667 IF ( allocated(WLOAD) ) DEALLOCATE( WLOAD ) 668 ALLOCATE( WLOAD( NPROCS ), stat=allocok ) 669 IF ( allocok .gt. 0 ) THEN 670 WRITE(*,*) 'PB allocation in CMUMPS_185' 671 id%INFO(1) = -13 672 id%INFO(2) = NPROCS 673 RETURN 674 END IF 675 IF ( allocated(IDWLOAD) ) DEALLOCATE( IDWLOAD ) 676 ALLOCATE( IDWLOAD( NPROCS ), stat=allocok ) 677 IF ( allocok .gt. 0 ) THEN 678 WRITE(*,*) 'PB allocation in CMUMPS_185' 679 id%INFO(1) = -13 680 id%INFO(2) = NPROCS 681 RETURN 682 END IF 683 IF ( BDC_MEM ) THEN 684 IF ( allocated(DM_MEM) ) DEALLOCATE( DM_MEM ) 685 ALLOCATE( DM_MEM( 0:NPROCS-1 ), stat=allocok ) 686 IF ( allocok .gt. 0 ) THEN 687 WRITE(*,*) 'PB allocation in CMUMPS_185' 688 id%INFO(1) = -13 689 id%INFO(2) = NPROCS 690 RETURN 691 END IF 692 END IF 693 IF ( BDC_POOL ) THEN 694 IF ( allocated(POOL_MEM) ) DEALLOCATE(POOL_MEM) 695 ALLOCATE( POOL_MEM(0: NPROCS -1), stat=allocok) 696 IF ( allocok .gt. 0 ) THEN 697 WRITE(*,*) 'PB allocation in CMUMPS_185' 698 id%INFO(1) = -13 699 id%INFO(2) = NPROCS 700 RETURN 701 END IF 702 POOL_MEM = dble(0) 703 POOL_LAST_COST_SENT = dble(0) 704 END IF 705 IF ( BDC_SBTR ) THEN 706 IF ( allocated(SBTR_MEM) ) DEALLOCATE(SBTR_MEM) 707 ALLOCATE( SBTR_MEM(0: NPROCS -1), stat=allocok) 708 IF ( allocok .gt. 0 ) THEN 709 WRITE(*,*) 'PB allocation in CMUMPS_185' 710 id%INFO(1) = -13 711 id%INFO(2) = NPROCS 712 RETURN 713 END IF 714 IF ( allocated(SBTR_CUR) ) DEALLOCATE(SBTR_CUR) 715 ALLOCATE( SBTR_CUR(0: NPROCS -1), stat=allocok) 716 IF ( allocok .gt. 0 ) THEN 717 WRITE(*,*) 'PB allocation in CMUMPS_185' 718 id%INFO(1) = -13 719 id%INFO(2) = NPROCS 720 RETURN 721 END IF 722 SBTR_CUR = dble(0) 723 SBTR_MEM = dble(0) 724 END IF 725 CALL MUMPS_546(K34_LOC,K35_LOC) 726 K35 = K35_LOC 727 BUF_LOAD_SIZE = K34_LOC * 2 * ( NPROCS - 1 ) + 728 & NPROCS * ( K35_LOC + K34_LOC ) 729 IF (BDC_MEM) THEN 730 BUF_LOAD_SIZE = BUF_LOAD_SIZE + NPROCS * K35_LOC 731 END IF 732 IF (BDC_SBTR)THEN 733 BUF_LOAD_SIZE = BUF_LOAD_SIZE + NPROCS * K35_LOC 734 ENDIF 735 LBUF_LOAD_RECV = (BUF_LOAD_SIZE+K34_LOC)/K34_LOC 736 LBUF_LOAD_RECV_BYTES = LBUF_LOAD_RECV * K34_LOC 737 IF ( allocated(BUF_LOAD_RECV) ) DEALLOCATE(BUF_LOAD_RECV) 738 ALLOCATE( BUF_LOAD_RECV( LBUF_LOAD_RECV), stat=allocok) 739 IF ( allocok > 0 ) THEN 740 WRITE(*,*) 'PB allocation in CMUMPS_185' 741 id%INFO(1) = -13 742 id%INFO(2) = LBUF_LOAD_RECV 743 RETURN 744 ENDIF 745 BUF_LOAD_SIZE = BUF_LOAD_SIZE * 20 746 CALL CMUMPS_54( BUF_LOAD_SIZE, IERR ) 747 IF ( IERR .LT. 0 ) THEN 748 id%INFO(1) = -13 749 id%INFO(2) = BUF_LOAD_SIZE 750 RETURN 751 END IF 752 DO i = 0, NPROCS - 1 753 LOAD_FLOPS( i ) = ZERO 754 END DO 755#if defined(OLD_LOAD_MECHANISM) 756 LOAD_FLOPS( MYID ) = COST_SUBTREE 757 LAST_LOAD_SENT = ZERO 758#endif 759 IF ( BDC_MEM ) THEN 760 DO i = 0, NPROCS - 1 761 DM_MEM( i )=ZERO 762 END DO 763#if defined(OLD_LOAD_MECHANISM) 764 DM_LAST_MEM_SENT=ZERO 765#endif 766 ENDIF 767 CALL CMUMPS_425(KEEP(69)) 768 IF(BDC_MD)THEN 769 MAX_SBTR=0.0D0 770 IF(BDC_SBTR)THEN 771 DO i=1,id%NBSA_LOCAL 772 MAX_SBTR=max(id%MEM_SUBTREE(i),MAX_SBTR) 773 ENDDO 774 ENDIF 775 MD_MEM(MYID)=MEMORY_MD 776 WHAT=8 777 CALL CMUMPS_460( WHAT, 778 & COMM_LD, NPROCS, 779#if ! defined(OLD_LOAD_MECHANISM) 780 & FUTURE_NIV2, 781#endif 782 & dble(MEMORY_MD),dble(0) ,MYID, IERR ) 783 WHAT=9 784 MEMORY_SENT = dble(LA-MAX_SURF_MASTER)-MAX_SBTR 785 & - max( dble(LA) * dble(3) / dble(100), 786 & dble(2) * dble(max(KEEP(5),KEEP(6))) * dble(KEEP(127))) 787 IF (KEEP(12) > 25) THEN 788 MEMORY_SENT = MEMORY_SENT - 789 & dble(KEEP(12))*0.2d0*dble(LA)/100.0d0 790 ENDIF 791 TAB_MAXS(MYID)=int(MEMORY_SENT,8) 792 CALL CMUMPS_460( WHAT, 793 & COMM_LD, NPROCS, 794#if ! defined(OLD_LOAD_MECHANISM) 795 & FUTURE_NIV2, 796#endif 797 & MEMORY_SENT, 798 & dble(0),MYID, IERR ) 799 ENDIF 800 RETURN 801 END SUBROUTINE CMUMPS_185 802 SUBROUTINE CMUMPS_190( CHECK_FLOPS,PROCESS_BANDE, 803 & INC_LOAD, KEEP,KEEP8 ) 804 USE CMUMPS_COMM_BUFFER 805 IMPLICIT NONE 806 DOUBLE PRECISION INC_LOAD 807 INTEGER KEEP(500) 808 INTEGER(8) KEEP8(150) 809 LOGICAL PROCESS_BANDE 810 INTEGER CHECK_FLOPS 811 INTEGER IERR 812 DOUBLE PRECISION ZERO, SEND_MEM, SEND_LOAD,SBTR_TMP 813 PARAMETER( ZERO=0.0d0 ) 814 INTRINSIC max, abs 815 IF (INC_LOAD == 0.0D0) THEN 816 IF(REMOVE_NODE_FLAG)THEN 817 REMOVE_NODE_FLAG=.FALSE. 818 ENDIF 819 RETURN 820 ENDIF 821 IF((CHECK_FLOPS.NE.0).AND. 822 & (CHECK_FLOPS.NE.1).AND.(CHECK_FLOPS.NE.2))THEN 823 WRITE(*,*)MYID,': Bad value for CHECK_FLOPS' 824 CALL MUMPS_ABORT() 825 ENDIF 826 IF(CHECK_FLOPS.EQ.1)THEN 827 CHK_LD=CHK_LD+INC_LOAD 828 ELSE 829 IF(CHECK_FLOPS.EQ.2)THEN 830 RETURN 831 ENDIF 832 ENDIF 833#if ! defined(OLD_LOAD_MECHANISM) 834 IF ( PROCESS_BANDE ) THEN 835 RETURN 836 ENDIF 837#endif 838 LOAD_FLOPS( MYID ) = max( LOAD_FLOPS( MYID ) + INC_LOAD, ZERO) 839 IF(BDC_M2_FLOPS.AND.REMOVE_NODE_FLAG)THEN 840 IF(INC_LOAD.NE.REMOVE_NODE_COST)THEN 841 IF(INC_LOAD.GT.REMOVE_NODE_COST)THEN 842#if ! defined(OLD_LOAD_MECHANISM) 843 DELTA_LOAD = DELTA_LOAD + 844 & (INC_LOAD-REMOVE_NODE_COST) 845 GOTO 888 846#else 847 GOTO 888 848#endif 849 ELSE 850#if ! defined(OLD_LOAD_MECHANISM) 851 DELTA_LOAD = DELTA_LOAD - 852 & (REMOVE_NODE_COST-INC_LOAD) 853 GOTO 888 854#else 855 GOTO 888 856#endif 857 ENDIF 858 ENDIF 859 GOTO 333 860 ENDIF 861#if ! defined(OLD_LOAD_MECHANISM) 862 DELTA_LOAD = DELTA_LOAD + INC_LOAD 863 888 CONTINUE 864 IF ( DELTA_LOAD > MIN_DIFF .OR. DELTA_LOAD < -MIN_DIFF) THEN 865 SEND_LOAD = DELTA_LOAD 866 IF (BDC_MEM) THEN 867 SEND_MEM = DELTA_MEM 868 ELSE 869 SEND_MEM = ZERO 870 END IF 871#else 872 888 CONTINUE 873 IF ( abs( LOAD_FLOPS ( MYID ) - 874 & LAST_LOAD_SENT ).GT.MIN_DIFF)THEN 875 IERR = 0 876 SEND_LOAD = LOAD_FLOPS( MYID ) 877 IF ( BDC_MEM ) THEN 878 SEND_MEM = DM_MEM(MYID) 879 ELSE 880 SEND_MEM = ZERO 881 END IF 882#endif 883 IF(BDC_SBTR)THEN 884 SBTR_TMP=SBTR_CUR(MYID) 885 ELSE 886 SBTR_TMP=dble(0) 887 ENDIF 888 111 CONTINUE 889 CALL CMUMPS_77( BDC_SBTR,BDC_MEM, 890 & BDC_MD,COMM_LD, NPROCS, 891 & SEND_LOAD, 892 & SEND_MEM,SBTR_TMP, 893 & DM_SUMLU, 894#if ! defined(OLD_LOAD_MECHANISM) 895 & FUTURE_NIV2, 896#endif 897 & MYID, IERR ) 898 IF ( IERR == -1 )THEN 899 CALL CMUMPS_467(COMM_LD, KEEP) 900 GOTO 111 901 ELSE IF ( IERR .NE.0 ) THEN 902 WRITE(*,*) "Internal Error in CMUMPS_190",IERR 903 CALL MUMPS_ABORT() 904 ENDIF 905 IF ( IERR .EQ. 0 ) THEN 906#if ! defined(OLD_LOAD_MECHANISM) 907 DELTA_LOAD = ZERO 908 IF (BDC_MEM) DELTA_MEM = ZERO 909#else 910 LAST_LOAD_SENT = LOAD_FLOPS( MYID ) 911 IF ( BDC_MEM ) DM_LAST_MEM_SENT = DM_MEM( MYID ) 912#endif 913 END IF 914 ENDIF 915 333 CONTINUE 916 IF(REMOVE_NODE_FLAG)THEN 917 REMOVE_NODE_FLAG=.FALSE. 918 ENDIF 919 RETURN 920 END SUBROUTINE CMUMPS_190 921 SUBROUTINE CMUMPS_471( SSARBR, 922 & PROCESS_BANDE_ARG, MEM_VALUE, NEW_LU, INC_MEM_ARG, 923 & KEEP,KEEP8,LRLU) 924 USE CMUMPS_COMM_BUFFER 925 IMPLICIT NONE 926 INTEGER(8), INTENT(IN) :: MEM_VALUE, INC_MEM_ARG, NEW_LU,LRLU 927 LOGICAL, INTENT(IN) :: PROCESS_BANDE_ARG, SSARBR 928 INTEGER IERR, KEEP(500) 929 INTEGER(8) KEEP8(150) 930 DOUBLE PRECISION ZERO, SEND_MEM, SBTR_TMP 931 PARAMETER( ZERO=0.0d0 ) 932 INTRINSIC max, abs 933 INTEGER(8) :: INC_MEM 934 LOGICAL PROCESS_BANDE 935#if defined(OLD_LOAD_MECHANISM) 936 DOUBLE PRECISION TMP_MEM 937#endif 938 PROCESS_BANDE=PROCESS_BANDE_ARG 939 INC_MEM = INC_MEM_ARG 940#if ! defined(OLD_LOAD_MECHANISM) 941 IF ( PROCESS_BANDE .AND. NEW_LU .NE. 0_8) THEN 942 WRITE(*,*) " Internal Error in CMUMPS_471." 943 WRITE(*,*) " NEW_LU must be zero if called from PROCESS_BANDE" 944 CALL MUMPS_ABORT() 945 ENDIF 946#endif 947#if defined(OLD_LOAD_MECHANISM) 948#if defined(CHECK_COHERENCE) 949 IF(PROCESS_BANDE)THEN 950 PROCESS_BANDE=.FALSE. 951 NB_LEVEL2=NB_LEVEL2-1 952 IF(NB_LEVEL2.LT.0)THEN 953 WRITE(*,*)MYID,': problem with NB_LEVEL2' 954 ELSEIF(NB_LEVEL2.EQ.0)THEN 955 IF(IS_DISPLAYED)THEN 956#if defined(STATS_DYNAMIC_MEMORY) 957 WRITE(*,*)MYID,': end of Incoherent state at time=', 958 & MPI_WTIME()-TIME_REF 959#endif 960 IS_DISPLAYED=.FALSE. 961 ENDIF 962 AMI_CHOSEN=.FALSE. 963 ENDIF 964 ENDIF 965 IF((KEEP(73).EQ.0).AND.(NB_LEVEL2.NE.0) 966 & .AND.(.NOT.IS_DISPLAYED))THEN 967 IS_DISPLAYED=.TRUE. 968#if defined(STATS_DYNAMIC_MEMORY) 969 WRITE(*,*)MYID,': Begin of Incoherent state (1) at time=', 970 & MPI_WTIME()-TIME_REF 971#endif 972 ENDIF 973#endif 974#endif 975 DM_SUMLU = DM_SUMLU + dble(NEW_LU) 976 IF(KEEP_LOAD(201).EQ.0)THEN 977 CHECK_MEM = CHECK_MEM + INC_MEM 978 ELSE 979 CHECK_MEM = CHECK_MEM + INC_MEM - NEW_LU 980 ENDIF 981 IF ( MEM_VALUE .NE. CHECK_MEM ) THEN 982 WRITE(*,*)MYID, 983 & ':Problem with increments in CMUMPS_471', 984 & CHECK_MEM, MEM_VALUE, INC_MEM,NEW_LU 985 CALL MUMPS_ABORT() 986 ENDIF 987#if ! defined(OLD_LOAD_MECHANISM) 988 IF (PROCESS_BANDE) THEN 989 RETURN 990 ENDIF 991#endif 992 IF(BDC_POOL_MNG) THEN 993 IF(SBTR_WHICH_M.EQ.0)THEN 994 IF (SSARBR) SBTR_CUR_LOCAL = SBTR_CUR_LOCAL+ 995 & dble(INC_MEM-NEW_LU) 996 ELSE 997 IF (SSARBR) SBTR_CUR_LOCAL = SBTR_CUR_LOCAL+ 998 & dble(INC_MEM) 999 ENDIF 1000 ENDIF 1001 IF ( .NOT. BDC_MEM ) THEN 1002 RETURN 1003 ENDIF 1004#if defined(OLD_LOAD_MECHANISM) 1005 IF(KEEP_LOAD(201).EQ.0)THEN 1006 DM_MEM( MYID ) = dble(CHECK_MEM) - DM_SUMLU 1007 ELSE 1008 DM_MEM( MYID ) = dble(CHECK_MEM) 1009 ENDIF 1010 TMP_MEM = DM_MEM(MYID) 1011#endif 1012 IF (BDC_SBTR .AND. SSARBR) THEN 1013 IF((SBTR_WHICH_M.EQ.0).AND.(KEEP(201).NE.0))THEN 1014 SBTR_CUR(MYID) = SBTR_CUR(MYID)+dble(INC_MEM-NEW_LU) 1015 ELSE 1016 SBTR_CUR(MYID) = SBTR_CUR(MYID)+dble(INC_MEM) 1017 ENDIF 1018 SBTR_TMP = SBTR_CUR(MYID) 1019 ELSE 1020 SBTR_TMP=dble(0) 1021 ENDIF 1022#if ! defined(OLD_LOAD_MECHANISM) 1023 IF ( NEW_LU > 0_8 ) THEN 1024 INC_MEM = INC_MEM - NEW_LU 1025 ENDIF 1026 DM_MEM( MYID ) = DM_MEM(MYID) + dble(INC_MEM) 1027 MAX_PEAK_STK=max(MAX_PEAK_STK,DM_MEM(MYID)) 1028 IF(BDC_M2_MEM.AND.REMOVE_NODE_FLAG_MEM)THEN 1029 IF(dble(INC_MEM).NE.REMOVE_NODE_COST_MEM)THEN 1030 IF(dble(INC_MEM).GT.REMOVE_NODE_COST_MEM)THEN 1031 DELTA_MEM = DELTA_MEM + 1032 & (dble(INC_MEM)-REMOVE_NODE_COST_MEM) 1033 GOTO 888 1034 ELSE 1035 DELTA_MEM = DELTA_MEM - 1036 & (REMOVE_NODE_COST_MEM-dble(INC_MEM)) 1037 GOTO 888 1038 ENDIF 1039 ENDIF 1040 GOTO 333 1041 ENDIF 1042 DELTA_MEM = DELTA_MEM + dble(INC_MEM) 1043 888 CONTINUE 1044 IF ((KEEP(48).NE.5).OR. 1045 & ((KEEP(48).EQ.5).AND.(abs(DELTA_MEM) 1046 & .GE.0.1d0*dble(LRLU))))THEN 1047 IF ( abs(DELTA_MEM) > DM_THRES_MEM ) THEN 1048 SEND_MEM = DELTA_MEM 1049#else 1050 IF(BDC_M2_MEM.AND.REMOVE_NODE_FLAG_MEM)THEN 1051 IF(INC_MEM.NE.REMOVE_NODE_COST_MEM)THEN 1052 IF(INC_MEM.EQ.REMOVE_NODE_COST_MEM)THEN 1053 GOTO 333 1054 ELSEIF(INC_MEM.LT.REMOVE_NODE_COST_MEM)THEN 1055 GOTO 333 1056 ENDIF 1057 ENDIF 1058 ENDIF 1059 IF ((KEEP(48).NE.5).OR. 1060 & ((KEEP(48).EQ.5).AND. 1061 & (abs(TMP_MEM-DM_LAST_MEM_SENT).GE. 1062 & 0.1d0*dble(LRLU))))THEN 1063 IF ( abs( TMP_MEM-DM_LAST_MEM_SENT) > 1064 & DM_THRES_MEM ) THEN 1065 IERR = 0 1066 SEND_MEM = TMP_MEM 1067#endif 1068 111 CONTINUE 1069 CALL CMUMPS_77( 1070 & BDC_SBTR, 1071 & BDC_MEM,BDC_MD, COMM_LD, 1072 & NPROCS, 1073#if ! defined(OLD_LOAD_MECHANISM) 1074 & DELTA_LOAD, 1075#else 1076 & LOAD_FLOPS( MYID ), 1077#endif 1078 & SEND_MEM,SBTR_TMP, 1079 & DM_SUMLU, 1080#if ! defined(OLD_LOAD_MECHANISM) 1081 & FUTURE_NIV2, 1082#endif 1083 & MYID,IERR ) 1084 IF ( IERR == -1 )THEN 1085 CALL CMUMPS_467(COMM_LD, KEEP) 1086 GOTO 111 1087 ELSE IF ( IERR .NE. 0 ) THEN 1088 WRITE(*,*) "Internal Error in CMUMPS_471",IERR 1089 CALL MUMPS_ABORT() 1090 ENDIF 1091 IF ( IERR .EQ. 0 ) THEN 1092#if ! defined(OLD_LOAD_MECHANISM) 1093 DELTA_LOAD = ZERO 1094 DELTA_MEM = ZERO 1095#else 1096 LAST_LOAD_SENT = LOAD_FLOPS ( MYID ) 1097 DM_LAST_MEM_SENT = TMP_MEM 1098#endif 1099 END IF 1100 ENDIF 1101 ENDIF 1102 333 CONTINUE 1103 IF(REMOVE_NODE_FLAG_MEM)THEN 1104 REMOVE_NODE_FLAG_MEM=.FALSE. 1105 ENDIF 1106 END SUBROUTINE CMUMPS_471 1107 INTEGER FUNCTION CMUMPS_186( K69, MEM_DISTRIB,MSG_SIZE ) 1108 IMPLICIT NONE 1109 INTEGER i, NLESS, K69 1110 INTEGER, DIMENSION(0:NPROCS-1) :: MEM_DISTRIB 1111 DOUBLE PRECISION LREF 1112 DOUBLE PRECISION MSG_SIZE 1113 NLESS = 0 1114 DO i=1,NPROCS 1115 IDWLOAD(i) = i - 1 1116 ENDDO 1117 WLOAD(1:NPROCS) = LOAD_FLOPS(0:NPROCS-1) 1118 IF(BDC_M2_FLOPS)THEN 1119 DO i=1,NPROCS 1120 WLOAD(i)=WLOAD(i)+NIV2(i) 1121 ENDDO 1122 ENDIF 1123 IF(K69 .gt. 1) THEN 1124 CALL CMUMPS_426(MEM_DISTRIB,MSG_SIZE,IDWLOAD,NPROCS) 1125 ENDIF 1126 LREF = LOAD_FLOPS(MYID) 1127 DO i=1, NPROCS 1128 IF (WLOAD(i).LT.LREF) NLESS=NLESS+1 1129 ENDDO 1130 CMUMPS_186 = NLESS 1131 RETURN 1132 END FUNCTION CMUMPS_186 1133 SUBROUTINE CMUMPS_189(MEM_DISTRIB,MSG_SIZE,DEST, 1134 & NSLAVES) 1135 IMPLICIT NONE 1136 INTEGER NSLAVES 1137 INTEGER DEST(NSLAVES) 1138 INTEGER, DIMENSION(0:NPROCS - 1) :: MEM_DISTRIB 1139 INTEGER i,J,NBDEST 1140 DOUBLE PRECISION MSG_SIZE 1141 IF ( NSLAVES.eq.NPROCS-1 ) THEN 1142 J = MYID+1 1143 DO i=1,NSLAVES 1144 J=J+1 1145 IF (J.GT.NPROCS) J=1 1146 DEST(i) = J - 1 1147 ENDDO 1148 ELSE 1149 DO i=1,NPROCS 1150 IDWLOAD(i) = i - 1 1151 ENDDO 1152 CALL MUMPS_558(NPROCS, WLOAD, IDWLOAD) 1153 NBDEST = 0 1154 DO i=1, NSLAVES 1155 J = IDWLOAD(i) 1156 IF (J.NE.MYID) THEN 1157 NBDEST = NBDEST+1 1158 DEST(NBDEST) = J 1159 ENDIF 1160 ENDDO 1161 IF (NBDEST.NE.NSLAVES) THEN 1162 DEST(NSLAVES) = IDWLOAD(NSLAVES+1) 1163 ENDIF 1164 IF(BDC_MD)THEN 1165 J=NSLAVES+1 1166 do i=NSLAVES+1,NPROCS 1167 IF(IDWLOAD(i).NE.MYID)THEN 1168 DEST(J)= IDWLOAD(i) 1169 J=J+1 1170 ENDIF 1171 end do 1172 ENDIF 1173 ENDIF 1174 RETURN 1175 END SUBROUTINE CMUMPS_189 1176 SUBROUTINE CMUMPS_183( INFO1, IERR ) 1177 USE CMUMPS_COMM_BUFFER 1178 IMPLICIT NONE 1179 INTEGER, intent(in) :: INFO1 1180 INTEGER, intent(out) :: IERR 1181 IERR=0 1182 DEALLOCATE( LOAD_FLOPS ) 1183 DEALLOCATE( WLOAD ) 1184 DEALLOCATE( IDWLOAD ) 1185#if ! defined(OLD_LOAD_MECHANISM) 1186 DEALLOCATE(FUTURE_NIV2) 1187#endif 1188 IF(BDC_MD)THEN 1189 DEALLOCATE(MD_MEM) 1190 DEALLOCATE(LU_USAGE) 1191 DEALLOCATE(TAB_MAXS) 1192 ENDIF 1193 IF ( BDC_MEM ) DEALLOCATE( DM_MEM ) 1194 IF ( BDC_POOL) DEALLOCATE( POOL_MEM ) 1195 IF ( BDC_SBTR) THEN 1196 DEALLOCATE( SBTR_MEM ) 1197 DEALLOCATE( SBTR_CUR ) 1198 DEALLOCATE(SBTR_FIRST_POS_IN_POOL) 1199 NULLIFY(MY_FIRST_LEAF) 1200 NULLIFY(MY_NB_LEAF) 1201 NULLIFY(MY_ROOT_SBTR) 1202 ENDIF 1203 IF(KEEP_LOAD(76).EQ.4)THEN 1204 NULLIFY(DEPTH_FIRST_LOAD) 1205 ENDIF 1206 IF(KEEP_LOAD(76).EQ.5)THEN 1207 NULLIFY(COST_TRAV) 1208 ENDIF 1209 IF((KEEP_LOAD(76).EQ.4).OR.(KEEP_LOAD(76).EQ.6))THEN 1210 NULLIFY(DEPTH_FIRST_LOAD) 1211 NULLIFY(DEPTH_FIRST_SEQ_LOAD) 1212 NULLIFY(SBTR_ID_LOAD) 1213 ENDIF 1214 IF (BDC_M2_MEM.OR.BDC_M2_FLOPS) THEN 1215 DEALLOCATE(NB_SON,POOL_NIV2,POOL_NIV2_COST, NIV2) 1216 END IF 1217 IF((KEEP_LOAD(81).EQ.2).OR.(KEEP_LOAD(81).EQ.3))THEN 1218 DEALLOCATE(CB_COST_MEM) 1219 DEALLOCATE(CB_COST_ID) 1220 ENDIF 1221 NULLIFY(ND_LOAD) 1222 NULLIFY(KEEP_LOAD) 1223 NULLIFY(KEEP8_LOAD) 1224 NULLIFY(FILS_LOAD) 1225 NULLIFY(FRERE_LOAD) 1226 NULLIFY(PROCNODE_LOAD) 1227 NULLIFY(STEP_LOAD) 1228 NULLIFY(NE_LOAD) 1229 NULLIFY(CAND_LOAD) 1230 NULLIFY(STEP_TO_NIV2_LOAD) 1231 NULLIFY(DAD_LOAD) 1232 IF (BDC_SBTR.OR.BDC_POOL_MNG) THEN 1233 DEALLOCATE(MEM_SUBTREE) 1234 DEALLOCATE(SBTR_PEAK_ARRAY) 1235 DEALLOCATE(SBTR_CUR_ARRAY) 1236 ENDIF 1237 CALL CMUMPS_58( IERR ) 1238 CALL CMUMPS_150( MYID, COMM_LD, 1239 & BUF_LOAD_RECV, LBUF_LOAD_RECV, 1240 & LBUF_LOAD_RECV_BYTES ) 1241 DEALLOCATE(BUF_LOAD_RECV) 1242 END SUBROUTINE CMUMPS_183 1243#if defined (LAMPORT_) 1244 RECURSIVE SUBROUTINE CMUMPS_467(COMM, KEEP) 1245#else 1246 SUBROUTINE CMUMPS_467(COMM, KEEP) 1247#endif 1248 IMPLICIT NONE 1249 INCLUDE 'mpif.h' 1250 INCLUDE 'mumps_tags.h' 1251 INTEGER IERR, MSGTAG, MSGLEN, MSGSOU,COMM 1252 INTEGER KEEP(500) 1253 INTEGER STATUS(MPI_STATUS_SIZE) 1254 LOGICAL FLAG 1255 10 CONTINUE 1256 CALL MPI_IPROBE( MPI_ANY_SOURCE, MPI_ANY_TAG, COMM, 1257 & FLAG, STATUS, IERR ) 1258 IF (FLAG) THEN 1259 KEEP(65)=KEEP(65)+1 1260 MSGTAG = STATUS( MPI_TAG ) 1261 MSGSOU = STATUS( MPI_SOURCE ) 1262 IF ( MSGTAG .NE. UPDATE_LOAD) THEN 1263 write(*,*) "Internal error 1 in CMUMPS_467", 1264 & MSGTAG 1265 CALL MUMPS_ABORT() 1266 ENDIF 1267 CALL MPI_GET_COUNT(STATUS, MPI_PACKED, MSGLEN, IERR) 1268 IF ( MSGLEN > LBUF_LOAD_RECV_BYTES ) THEN 1269 write(*,*) "Internal error 2 in CMUMPS_467", 1270 & MSGLEN, LBUF_LOAD_RECV_BYTES 1271 CALL MUMPS_ABORT() 1272 ENDIF 1273 CALL MPI_RECV( BUF_LOAD_RECV, LBUF_LOAD_RECV_BYTES, 1274 & MPI_PACKED, MSGSOU, MSGTAG, COMM_LD, STATUS, IERR) 1275 CALL CMUMPS_187( MSGSOU, BUF_LOAD_RECV, 1276 & LBUF_LOAD_RECV, LBUF_LOAD_RECV_BYTES ) 1277 GOTO 10 1278 ENDIF 1279 RETURN 1280 END SUBROUTINE CMUMPS_467 1281 RECURSIVE SUBROUTINE CMUMPS_187 1282 & ( MSGSOU, BUFR, LBUFR, LBUFR_BYTES ) 1283 IMPLICIT NONE 1284 INTEGER MSGSOU, LBUFR, LBUFR_BYTES 1285 INTEGER BUFR( LBUFR ) 1286 INCLUDE 'mpif.h' 1287 INTEGER POSITION, IERR, WHAT, NSLAVES, i 1288 DOUBLE PRECISION LOAD_RECEIVED 1289 INTEGER INODE_RECEIVED,NCB_RECEIVED 1290 DOUBLE PRECISION SURF 1291 INTEGER, POINTER, DIMENSION (:) :: LIST_SLAVES 1292 DOUBLE PRECISION, POINTER, DIMENSION (:) :: LOAD_INCR 1293 EXTERNAL MUMPS_330 1294 INTEGER MUMPS_330 1295 POSITION = 0 1296 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, 1297 & WHAT, 1, MPI_INTEGER, 1298 & COMM_LD, IERR ) 1299 IF ( WHAT == 0 ) THEN 1300#if ! defined(OLD_LOAD_MECHANISM) 1301#else 1302#endif 1303 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, 1304 & LOAD_RECEIVED, 1, 1305 & MPI_DOUBLE_PRECISION, 1306 & COMM_LD, IERR ) 1307#if ! defined(OLD_LOAD_MECHANISM) 1308 LOAD_FLOPS( MSGSOU ) = LOAD_FLOPS(MSGSOU) + LOAD_RECEIVED 1309#else 1310 LOAD_FLOPS( MSGSOU ) = LOAD_RECEIVED 1311#endif 1312 IF ( BDC_MEM ) THEN 1313 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, 1314 & LOAD_RECEIVED, 1, MPI_DOUBLE_PRECISION, 1315 & COMM_LD, IERR ) 1316#if ! defined(OLD_LOAD_MECHANISM) 1317 DM_MEM(MSGSOU) = DM_MEM(MSGSOU) + LOAD_RECEIVED 1318#else 1319 DM_MEM(MSGSOU) = LOAD_RECEIVED 1320#endif 1321 MAX_PEAK_STK=max(MAX_PEAK_STK,DM_MEM(MSGSOU)) 1322 END IF 1323 IF(BDC_SBTR)THEN 1324 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, 1325 & LOAD_RECEIVED, 1, MPI_DOUBLE_PRECISION, 1326 & COMM_LD, IERR ) 1327 SBTR_CUR(MSGSOU)=LOAD_RECEIVED 1328 ENDIF 1329 IF(BDC_MD)THEN 1330 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, 1331 & LOAD_RECEIVED, 1, MPI_DOUBLE_PRECISION, 1332 & COMM_LD, IERR ) 1333 IF(KEEP_LOAD(201).EQ.0)THEN 1334 LU_USAGE(MSGSOU)=LOAD_RECEIVED 1335 ENDIF 1336 ENDIF 1337 ELSEIF (( WHAT == 1).OR.(WHAT.EQ.19)) THEN 1338 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, 1339 & NSLAVES, 1, MPI_INTEGER, 1340 & COMM_LD, IERR ) 1341 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, 1342 & INODE_RECEIVED, 1, MPI_INTEGER, 1343 & COMM_LD, IERR ) 1344 LIST_SLAVES => IDWLOAD 1345 LOAD_INCR => WLOAD 1346 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, 1347 & LIST_SLAVES(1), NSLAVES, MPI_INTEGER, 1348 & COMM_LD, IERR) 1349 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, 1350 & LOAD_INCR(1), NSLAVES, MPI_DOUBLE_PRECISION, 1351 & COMM_LD, IERR) 1352#if defined(OLD_LOAD_MECHANISM) 1353#if defined(CHECK_COHERENCE) 1354 WRITE(*,*)MYID,':Receiving M2A from',MSGSOU 1355 i=1 1356 DO WHILE ((i.LE.NSLAVES).AND.(LIST_SLAVES(i).NE.MYID)) 1357 i=i+1 1358 ENDDO 1359 IF(i.LT.(NSLAVES+1))THEN 1360 NB_LEVEL2=NB_LEVEL2+1 1361 WRITE(*,*)MYID,':NB_LEVEL2=',NB_LEVEL2 1362 AMI_CHOSEN=.TRUE. 1363 IF(KEEP_LOAD(73).EQ.1)THEN 1364 IF(.NOT.IS_DISPLAYED)THEN 1365 WRITE(*,*)MYID,': Begin of Incoherent state (2) at time=', 1366 & MPI_WTIME()-TIME_REF 1367 IS_DISPLAYED=.TRUE. 1368 ENDIF 1369 ENDIF 1370 ENDIF 1371 IF(KEEP_LOAD(73).EQ.1) GOTO 344 1372#endif 1373#endif 1374 DO i = 1, NSLAVES 1375#if defined(OLD_LOAD_MECHANISM) 1376 IF ( LIST_SLAVES(i) /= MYID ) THEN 1377#endif 1378 LOAD_FLOPS(LIST_SLAVES(i)) = 1379 & LOAD_FLOPS(LIST_SLAVES(i)) + 1380 & LOAD_INCR(i) 1381#if defined(OLD_LOAD_MECHANISM) 1382 END IF 1383#endif 1384 END DO 1385 IF ( BDC_MEM ) THEN 1386 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, 1387 & LOAD_INCR(1), NSLAVES, MPI_DOUBLE_PRECISION, 1388 & COMM_LD, IERR) 1389 DO i = 1, NSLAVES 1390#if defined(OLD_LOAD_MECHANISM) 1391 IF ( LIST_SLAVES(i) /= MYID ) THEN 1392#endif 1393 DM_MEM(LIST_SLAVES(i)) = DM_MEM(LIST_SLAVES(i)) + 1394 & LOAD_INCR(i) 1395 MAX_PEAK_STK=max(MAX_PEAK_STK,DM_MEM(LIST_SLAVES(i))) 1396#if defined(OLD_LOAD_MECHANISM) 1397 END IF 1398#endif 1399 END DO 1400 END IF 1401 IF(WHAT.EQ.19)THEN 1402 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, 1403 & LOAD_INCR(1), NSLAVES, MPI_DOUBLE_PRECISION, 1404 & COMM_LD, IERR) 1405 CALL CMUMPS_819(INODE_RECEIVED) 1406 CB_COST_ID(POS_ID)=INODE_RECEIVED 1407 CB_COST_ID(POS_ID+1)=NSLAVES 1408 CB_COST_ID(POS_ID+2)=POS_MEM 1409 POS_ID=POS_ID+3 1410 DO i=1,NSLAVES 1411 WRITE(*,*)MYID,':',LIST_SLAVES(i),'->',LOAD_INCR(i) 1412 CB_COST_MEM(POS_MEM)=int(LIST_SLAVES(i),8) 1413 POS_MEM=POS_MEM+1 1414 CB_COST_MEM(POS_MEM)=int(LOAD_INCR(i),8) 1415 POS_MEM=POS_MEM+1 1416 ENDDO 1417 ENDIF 1418#if defined(OLD_LOAD_MECHANISM) 1419#if defined(CHECK_COHERENCE) 1420 344 CONTINUE 1421#endif 1422#endif 1423 NULLIFY( LIST_SLAVES ) 1424 NULLIFY( LOAD_INCR ) 1425 ELSE IF (WHAT == 2 ) THEN 1426 IF ( .not. BDC_POOL ) THEN 1427 WRITE(*,*) "Internal error 2 in CMUMPS_187" 1428 CALL MUMPS_ABORT() 1429 END IF 1430 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, 1431 & LOAD_RECEIVED, 1, 1432 & MPI_DOUBLE_PRECISION, 1433 & COMM_LD, IERR ) 1434 POOL_MEM(MSGSOU)=LOAD_RECEIVED 1435 ELSE IF ( WHAT == 3 ) THEN 1436 IF ( .NOT. BDC_SBTR) THEN 1437 WRITE(*,*) "Internal error 3 in CMUMPS_187" 1438 CALL MUMPS_ABORT() 1439 ENDIF 1440 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, 1441 & LOAD_RECEIVED, 1, 1442 & MPI_DOUBLE_PRECISION, 1443 & COMM_LD, IERR ) 1444 SBTR_MEM(MSGSOU)=SBTR_MEM(MSGSOU)+LOAD_RECEIVED 1445#if ! defined(OLD_LOAD_MECHANISM) 1446 ELSE IF (WHAT == 4) THEN 1447 FUTURE_NIV2(MSGSOU+1)=0 1448 IF(BDC_MD)THEN 1449 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, 1450 & SURF, 1, MPI_DOUBLE_PRECISION, 1451 & COMM_LD, IERR ) 1452 MD_MEM(MSGSOU)=999999999_8 1453 TAB_MAXS(MSGSOU)=TAB_MAXS(MSGSOU)+int(SURF,8) 1454 ENDIF 1455#endif 1456 IF(BDC_M2_MEM.OR.BDC_M2_FLOPS)THEN 1457 ENDIF 1458 ELSE IF (WHAT == 5) THEN 1459 IF((.NOT.BDC_M2_MEM).AND.(.NOT.BDC_M2_FLOPS))THEN 1460 WRITE(*,*) "Internal error 7 in CMUMPS_187" 1461 CALL MUMPS_ABORT() 1462 ENDIF 1463 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, 1464 & INODE_RECEIVED, 1, 1465 & MPI_INTEGER, 1466 & COMM_LD, IERR ) 1467 IF(BDC_M2_MEM) THEN 1468 CALL CMUMPS_816(INODE_RECEIVED) 1469 ELSEIF(BDC_M2_FLOPS) THEN 1470 CALL CMUMPS_817(INODE_RECEIVED) 1471 ENDIF 1472 IF((KEEP_LOAD(81).EQ.2).OR.(KEEP_LOAD(81).EQ.3))THEN 1473 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, 1474 & INODE_RECEIVED, 1, 1475 & MPI_INTEGER, 1476 & COMM_LD, IERR ) 1477 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, 1478 & NCB_RECEIVED, 1, 1479 & MPI_INTEGER, 1480 & COMM_LD, IERR ) 1481 IF( 1482 & MUMPS_330(PROCNODE_LOAD(STEP_LOAD(INODE_RECEIVED)), 1483 & NPROCS).EQ.1 1484 & )THEN 1485 CB_COST_ID(POS_ID)=INODE_RECEIVED 1486 CB_COST_ID(POS_ID+1)=1 1487 CB_COST_ID(POS_ID+2)=POS_MEM 1488 POS_ID=POS_ID+3 1489 CB_COST_MEM(POS_MEM)=int(MSGSOU,8) 1490 POS_MEM=POS_MEM+1 1491 CB_COST_MEM(POS_MEM)=int(NCB_RECEIVED,8)* 1492 & int(NCB_RECEIVED,8) 1493 POS_MEM=POS_MEM+1 1494 ENDIF 1495 ENDIF 1496 ELSE IF ( WHAT == 6 ) THEN 1497 IF((.NOT.BDC_M2_MEM).AND.(.NOT.BDC_M2_FLOPS))THEN 1498 WRITE(*,*) "Internal error 8 in CMUMPS_187" 1499 CALL MUMPS_ABORT() 1500 ENDIF 1501 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, 1502 & LOAD_RECEIVED, 1, 1503 & MPI_DOUBLE_PRECISION, 1504 & COMM_LD, IERR ) 1505 IF(BDC_M2_MEM) THEN 1506 NIV2(MSGSOU+1) = LOAD_RECEIVED 1507 ELSEIF(BDC_M2_FLOPS) THEN 1508 NIV2(MSGSOU+1) = NIV2(MSGSOU+1) + LOAD_RECEIVED 1509 IF(NIV2(MSGSOU+1).LT.0.0D0)THEN 1510 IF(abs(NIV2(MSGSOU+1)).LE. 1511 & sqrt(epsilon(LOAD_RECEIVED)))THEN 1512 NIV2(MSGSOU+1)=0.0D0 1513 ELSE 1514 WRITE(*,*)'problem with NIV2_FLOPS message', 1515 & NIV2(MSGSOU+1),MSGSOU,LOAD_RECEIVED 1516 CALL MUMPS_ABORT() 1517 ENDIF 1518 ENDIF 1519 ENDIF 1520 ELSEIF(WHAT == 17)THEN 1521 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, 1522 & LOAD_RECEIVED, 1, 1523 & MPI_DOUBLE_PRECISION, 1524 & COMM_LD, IERR ) 1525 IF(BDC_M2_MEM) THEN 1526 NIV2(MSGSOU+1) = LOAD_RECEIVED 1527 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, 1528 & LOAD_RECEIVED, 1, 1529 & MPI_DOUBLE_PRECISION, 1530 & COMM_LD, IERR ) 1531 IF(BDC_MD)THEN 1532#if ! defined(OLD_LOAD_MECHANISM) 1533 DM_MEM(MYID)=DM_MEM(MYID)+LOAD_RECEIVED 1534#else 1535 DM_MEM(MYID)=LOAD_RECEIVED 1536#endif 1537 ELSEIF(BDC_POOL)THEN 1538 POOL_MEM(MSGSOU)=LOAD_RECEIVED 1539 ENDIF 1540 ELSEIF(BDC_M2_FLOPS) THEN 1541 NIV2(MSGSOU+1) = NIV2(MSGSOU+1) + LOAD_RECEIVED 1542 IF(NIV2(MSGSOU+1).LT.0.0D0)THEN 1543 WRITE(*,*)'problem with NIV2_FLOPS message', 1544 & NIV2(MSGSOU+1),MSGSOU,LOAD_RECEIVED 1545 CALL MUMPS_ABORT() 1546 ENDIF 1547 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, 1548 & LOAD_RECEIVED, 1, 1549 & MPI_DOUBLE_PRECISION, 1550 & COMM_LD, IERR ) 1551#if ! defined(OLD_LOAD_MECHANISM) 1552 LOAD_FLOPS( MSGSOU ) = LOAD_FLOPS(MSGSOU) + LOAD_RECEIVED 1553#else 1554 LOAD_FLOPS( MSGSOU ) = LOAD_RECEIVED 1555#endif 1556 ENDIF 1557 ELSEIF ( WHAT == 7 ) THEN 1558 IF(.NOT.BDC_MD)THEN 1559 WRITE(*,*)MYID,': Internal error 4 1560 &in CMUMPS_187' 1561 CALL MUMPS_ABORT() 1562 ENDIF 1563 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, 1564 & NSLAVES, 1, MPI_INTEGER, 1565 & COMM_LD, IERR ) 1566 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, 1567 & INODE_RECEIVED, 1, MPI_INTEGER, 1568 & COMM_LD, IERR ) 1569 LIST_SLAVES => IDWLOAD 1570 LOAD_INCR => WLOAD 1571 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, 1572 & LIST_SLAVES(1), NSLAVES, MPI_INTEGER, 1573 & COMM_LD, IERR) 1574 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, 1575 & LOAD_INCR(1), NSLAVES, MPI_DOUBLE_PRECISION, 1576 & COMM_LD, IERR) 1577 DO i = 1, NSLAVES 1578#if defined(OLD_LOAD_MECHANISM) 1579 IF ( LIST_SLAVES(i) /= MYID ) THEN 1580#endif 1581 MD_MEM(LIST_SLAVES(i)) = 1582 & MD_MEM(LIST_SLAVES(i)) + 1583 & int(LOAD_INCR(i),8) 1584#if ! defined(OLD_LOAD_MECHANISM) 1585 IF(FUTURE_NIV2(LIST_SLAVES(i)+1).EQ.0)THEN 1586 MD_MEM(LIST_SLAVES(i))=999999999_8 1587 ENDIF 1588#endif 1589#if defined(OLD_LOAD_MECHANISM) 1590 END IF 1591#endif 1592 END DO 1593 ELSEIF ( WHAT == 8 ) THEN 1594 IF(.NOT.BDC_MD)THEN 1595 WRITE(*,*)MYID,': Internal error 5 1596 &in CMUMPS_187' 1597 CALL MUMPS_ABORT() 1598 ENDIF 1599 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, 1600 & LOAD_RECEIVED, 1, 1601 & MPI_DOUBLE_PRECISION, 1602 & COMM_LD, IERR ) 1603 MD_MEM(MSGSOU)=MD_MEM(MSGSOU)+int(LOAD_RECEIVED,8) 1604#if ! defined(OLD_LOAD_MECHANISM) 1605 IF(FUTURE_NIV2(MSGSOU+1).EQ.0)THEN 1606 MD_MEM(MSGSOU)=999999999_8 1607 ENDIF 1608#endif 1609 ELSEIF ( WHAT == 9 ) THEN 1610 IF(.NOT.BDC_MD)THEN 1611 WRITE(*,*)MYID,': Internal error 6 1612 &in CMUMPS_187' 1613 CALL MUMPS_ABORT() 1614 ENDIF 1615 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, 1616 & LOAD_RECEIVED, 1, 1617 & MPI_DOUBLE_PRECISION, 1618 & COMM_LD, IERR ) 1619 TAB_MAXS(MSGSOU)=int(LOAD_RECEIVED,8) 1620 ELSE 1621 WRITE(*,*) "Internal error 1 in CMUMPS_187" 1622 CALL MUMPS_ABORT() 1623 END IF 1624 RETURN 1625 END SUBROUTINE CMUMPS_187 1626 integer function CMUMPS_409 1627 & (MEM_DISTRIB,CAND, 1628 & K69, 1629 & SLAVEF,MSG_SIZE, 1630 & NMB_OF_CAND ) 1631 implicit none 1632 integer, intent(in) :: K69, SLAVEF 1633 INTEGER, intent(in) :: CAND(SLAVEF+1) 1634 INTEGER, DIMENSION(0:NPROCS - 1), intent(in) :: MEM_DISTRIB 1635 INTEGER, intent(out) :: NMB_OF_CAND 1636 integer i,nless 1637 DOUBLE PRECISION lref 1638 DOUBLE PRECISION MSG_SIZE 1639 nless = 0 1640 NMB_OF_CAND=CAND(SLAVEF+1) 1641 do i=1,NMB_OF_CAND 1642 WLOAD(i)=LOAD_FLOPS(CAND(i)) 1643 IF(BDC_M2_FLOPS)THEN 1644 WLOAD(i)=WLOAD(i)+NIV2(CAND(i)+1) 1645 ENDIF 1646 end do 1647 IF(K69 .gt. 1) THEN 1648 CALL CMUMPS_426(MEM_DISTRIB,MSG_SIZE, 1649 & CAND,NMB_OF_CAND) 1650 ENDIF 1651 lref = LOAD_FLOPS(MYID) 1652 do i=1, NMB_OF_CAND 1653 if (WLOAD(i).lt.lref) nless=nless+1 1654 end do 1655 CMUMPS_409 = nless 1656 return 1657 end function CMUMPS_409 1658 subroutine CMUMPS_384 1659 & (MEM_DISTRIB,CAND, 1660 & 1661 & SLAVEF, 1662 & nslaves_inode, DEST) 1663 implicit none 1664 integer, intent(in) :: nslaves_inode, SLAVEF 1665 integer, intent(in) :: CAND(SLAVEF+1) 1666 integer, dimension(0:NPROCS - 1), intent(in) :: MEM_DISTRIB 1667 integer, intent(out) :: DEST(CAND(SLAVEF+1)) 1668 integer i,j,NMB_OF_CAND 1669 external MUMPS_558 1670 NMB_OF_CAND = CAND(SLAVEF+1) 1671 if(nslaves_inode.ge.NPROCS .or. 1672 & nslaves_inode.gt.NMB_OF_CAND) then 1673 write(*,*)'Internal error in CMUMPS_384', 1674 & nslaves_inode, NPROCS, NMB_OF_CAND 1675 CALL MUMPS_ABORT() 1676 end if 1677 if (nslaves_inode.eq.NPROCS-1) then 1678 j=MYID+1 1679 do i=1,nslaves_inode 1680 if(j.ge.NPROCS) j=0 1681 DEST(i)=j 1682 j=j+1 1683 end do 1684 else 1685 do i=1,NMB_OF_CAND 1686 IDWLOAD(i)=i 1687 end do 1688 call MUMPS_558(NMB_OF_CAND, 1689 & WLOAD(1),IDWLOAD(1) ) 1690 do i=1,nslaves_inode 1691 DEST(i)= CAND(IDWLOAD(i)) 1692 end do 1693 IF(BDC_MD)THEN 1694 do i=nslaves_inode+1,NMB_OF_CAND 1695 DEST(i)= CAND(IDWLOAD(i)) 1696 end do 1697 ENDIF 1698 end if 1699 return 1700 end subroutine CMUMPS_384 1701 SUBROUTINE CMUMPS_425(K69) 1702 IMPLICIT NONE 1703 INTEGER K69 1704 IF (K69 .LE. 4) THEN 1705 ALPHA = 0.0d0 1706 BETA = 0.0d0 1707 RETURN 1708 ENDIF 1709 IF (K69 .EQ. 5) THEN 1710 ALPHA = 0.5d0 1711 BETA = 50000.0d0 1712 RETURN 1713 ENDIF 1714 IF (K69 .EQ. 6) THEN 1715 ALPHA = 0.5d0 1716 BETA = 100000.0d0 1717 RETURN 1718 ENDIF 1719 IF (K69 .EQ. 7) THEN 1720 ALPHA = 0.5d0 1721 BETA = 150000.0d0 1722 RETURN 1723 ENDIF 1724 IF (K69 .EQ. 8) THEN 1725 ALPHA = 1.0d0 1726 BETA = 50000.0d0 1727 RETURN 1728 ENDIF 1729 IF (K69 .EQ. 9) THEN 1730 ALPHA = 1.0d0 1731 BETA = 100000.0d0 1732 RETURN 1733 ENDIF 1734 IF (K69 .EQ. 10) THEN 1735 ALPHA = 1.0d0 1736 BETA = 150000.0d0 1737 RETURN 1738 ENDIF 1739 IF (K69 .EQ. 11) THEN 1740 ALPHA = 1.5d0 1741 BETA = 50000.0d0 1742 RETURN 1743 ENDIF 1744 IF (K69 .EQ. 12) THEN 1745 ALPHA = 1.5d0 1746 BETA = 100000.0d0 1747 RETURN 1748 ENDIF 1749 ALPHA = 1.5d0 1750 BETA = 150000.0d0 1751 RETURN 1752 END SUBROUTINE CMUMPS_425 1753 SUBROUTINE CMUMPS_426(MEM_DISTRIB,MSG_SIZE,ARRAY_ADM,LEN) 1754 IMPLICIT NONE 1755 INTEGER i,LEN 1756 INTEGER, DIMENSION(0:NPROCS-1) :: MEM_DISTRIB 1757 DOUBLE PRECISION MSG_SIZE,FORBIGMSG 1758 INTEGER ARRAY_ADM(LEN) 1759 DOUBLE PRECISION MY_LOAD 1760 FORBIGMSG = 1.0d0 1761 IF (K69 .lt.2) THEN 1762 RETURN 1763 ENDIF 1764 IF(BDC_M2_FLOPS)THEN 1765 MY_LOAD=LOAD_FLOPS(MYID)+NIV2(MYID+1) 1766 ELSE 1767 MY_LOAD=LOAD_FLOPS(MYID) 1768 ENDIF 1769 IF((MSG_SIZE * dble(K35) ) .gt. 3200000.0d0) THEN 1770 FORBIGMSG = 2.0d0 1771 ENDIF 1772 IF (K69 .le. 4) THEN 1773 DO i = 1,LEN 1774 IF ((MEM_DISTRIB(ARRAY_ADM(i)) .EQ. 1) .AND. 1775 & WLOAD(i) .LT. MY_LOAD ) THEN 1776 WLOAD(i) = WLOAD(i)/MY_LOAD 1777 ELSE 1778 IF ( MEM_DISTRIB(ARRAY_ADM(i)) .NE. 1 ) THEN 1779 WLOAD(i) = WLOAD(i) * 1780 & dble(MEM_DISTRIB(ARRAY_ADM(i))) 1781 & * FORBIGMSG 1782 & + dble(2) 1783 ENDIF 1784 ENDIF 1785 ENDDO 1786 RETURN 1787 ENDIF 1788 DO i = 1,LEN 1789 IF ((MEM_DISTRIB(ARRAY_ADM(i)) .EQ. 1) .AND. 1790 & WLOAD(i) .LT. MY_LOAD ) THEN 1791 WLOAD(i) = WLOAD(i) / MY_LOAD 1792 ELSE 1793 IF(MEM_DISTRIB(ARRAY_ADM(i)) .NE. 1) THEN 1794 WLOAD(i) = (WLOAD(i) + 1795 & ALPHA * MSG_SIZE * dble(K35) + 1796 & BETA) * FORBIGMSG 1797 ENDIF 1798 ENDIF 1799 ENDDO 1800 RETURN 1801 END SUBROUTINE CMUMPS_426 1802 SUBROUTINE CMUMPS_461(MYID, SLAVEF, COMM, 1803 & TAB_POS, NASS, KEEP,KEEP8, LIST_SLAVES, NSLAVES,INODE) 1804 USE CMUMPS_COMM_BUFFER 1805 IMPLICIT NONE 1806 INTEGER, INTENT (IN) :: MYID, SLAVEF, COMM, NASS, NSLAVES 1807 INTEGER, INTENT (IN) :: TAB_POS(SLAVEF+2) 1808 INTEGER, INTENT (IN) :: LIST_SLAVES( NSLAVES ) 1809 INTEGER KEEP(500) 1810 INTEGER(8) KEEP8(150) 1811 INTEGER NCB, NFRONT, NBROWS_SLAVE 1812 INTEGER i, IERR,WHAT,INODE 1813 DOUBLE PRECISION MEM_INCREMENT ( NSLAVES ) 1814 DOUBLE PRECISION FLOPS_INCREMENT( NSLAVES ) 1815 DOUBLE PRECISION CB_BAND( NSLAVES ) 1816 IF((KEEP(81).NE.2).AND.(KEEP(81).NE.3))THEN 1817 WHAT=1 1818 ELSE 1819 WHAT=19 1820 ENDIF 1821#if ! defined(OLD_LOAD_MECHANISM) 1822 FUTURE_NIV2(MYID+1) = FUTURE_NIV2(MYID+1) - 1 1823 IF ( FUTURE_NIV2(MYID+1) < 0 ) THEN 1824 WRITE(*,*) "Internal error in CMUMPS_461" 1825 CALL MUMPS_ABORT() 1826 ENDIF 1827 IF ( FUTURE_NIV2(MYID + 1) == 0 ) THEN 1828 112 CONTINUE 1829 CALL CMUMPS_502(COMM,MYID,SLAVEF, 1830 & dble(MAX_SURF_MASTER),IERR) 1831 IF (IERR == -1 ) THEN 1832 CALL CMUMPS_467(COMM_LD, KEEP) 1833 GOTO 112 1834 ELSE IF ( IERR .NE. 0 ) THEN 1835 WRITE(*,*) "Internal Error in CMUMPS_461", 1836 & IERR 1837 CALL MUMPS_ABORT() 1838 ENDIF 1839 TAB_MAXS(MYID) = TAB_MAXS(MYID) + int(MAX_SURF_MASTER,8) 1840 ENDIF 1841#endif 1842 IF ( NSLAVES /= TAB_POS(SLAVEF + 2) ) THEN 1843 write(*,*) "Error 1 in CMUMPS_461", 1844 & NSLAVES, TAB_POS(SLAVEF+2) 1845 CALL MUMPS_ABORT() 1846 ENDIF 1847 NCB = TAB_POS(NSLAVES+1) - 1 1848 NFRONT = NCB + NASS 1849 DO i = 1, NSLAVES 1850 NBROWS_SLAVE = TAB_POS(i+1) - TAB_POS(i) 1851 IF ( KEEP(50) == 0 ) THEN 1852 FLOPS_INCREMENT( i ) = (dble(NBROWS_SLAVE)*dble( NASS ))+ 1853 & dble(NBROWS_SLAVE) * dble(NASS) * 1854 & dble(2*NFRONT-NASS-1) 1855 ELSE 1856 FLOPS_INCREMENT( i ) = dble(NBROWS_SLAVE) * dble(NASS ) * 1857 & dble( 2 * ( NASS + TAB_POS(i+1) - 1 ) 1858 & - NBROWS_SLAVE - NASS + 1 ) 1859 ENDIF 1860 IF ( BDC_MEM ) THEN 1861 IF ( KEEP(50) == 0 ) THEN 1862 MEM_INCREMENT( i ) = dble(NBROWS_SLAVE) * 1863 & dble(NFRONT) 1864 ELSE 1865 MEM_INCREMENT( i ) = dble(NBROWS_SLAVE) * 1866 & dble( NASS + TAB_POS(i+1) - 1 ) 1867 END IF 1868 ENDIF 1869 IF((KEEP(81).NE.2).AND.(KEEP(81).NE.3))THEN 1870 CB_BAND(i)=dble(-999999) 1871 ELSE 1872 IF ( KEEP(50) == 0 ) THEN 1873 CB_BAND( i ) = dble(NBROWS_SLAVE) * 1874 & dble(NFRONT-NASS) 1875 ELSE 1876 CB_BAND( i ) = dble(NBROWS_SLAVE) * 1877 & dble(TAB_POS(i+1)-1) 1878 END IF 1879 ENDIF 1880 END DO 1881 IF((KEEP(81).EQ.2).OR.(KEEP(81).EQ.3))THEN 1882 CB_COST_ID(POS_ID)=INODE 1883 CB_COST_ID(POS_ID+1)=NSLAVES 1884 CB_COST_ID(POS_ID+2)=POS_MEM 1885 POS_ID=POS_ID+3 1886 DO i=1,NSLAVES 1887 CB_COST_MEM(POS_MEM)=int(LIST_SLAVES(i),8) 1888 POS_MEM=POS_MEM+1 1889 CB_COST_MEM(POS_MEM)=int(CB_BAND(i),8) 1890 POS_MEM=POS_MEM+1 1891 ENDDO 1892 ENDIF 1893 111 CONTINUE 1894 CALL CMUMPS_524(BDC_MEM, COMM, MYID, SLAVEF, 1895#if ! defined(OLD_LOAD_MECHANISM) 1896 & FUTURE_NIV2, 1897#endif 1898 & NSLAVES, LIST_SLAVES,INODE, 1899 & MEM_INCREMENT, 1900 & FLOPS_INCREMENT,CB_BAND, WHAT,IERR) 1901 IF ( IERR == -1 ) THEN 1902 CALL CMUMPS_467(COMM_LD, KEEP) 1903 GOTO 111 1904 ELSE IF ( IERR .NE. 0 ) THEN 1905 WRITE(*,*) "Internal Error in CMUMPS_461", 1906 & IERR 1907 CALL MUMPS_ABORT() 1908 ENDIF 1909#if ! defined(OLD_LOAD_MECHANISM) 1910 IF (FUTURE_NIV2(MYID+1) .NE. 0) THEN 1911#endif 1912 DO i = 1, NSLAVES 1913 LOAD_FLOPS(LIST_SLAVES(i)) = LOAD_FLOPS(LIST_SLAVES(i)) 1914 & + FLOPS_INCREMENT(i) 1915 IF ( BDC_MEM ) THEN 1916 DM_MEM(LIST_SLAVES(i)) = DM_MEM(LIST_SLAVES(i)) 1917 & + MEM_INCREMENT(i) 1918 END IF 1919 ENDDO 1920#if ! defined(OLD_LOAD_MECHANISM) 1921 ENDIF 1922#endif 1923 RETURN 1924 END SUBROUTINE CMUMPS_461 1925 SUBROUTINE CMUMPS_500( 1926 & POOL, LPOOL, 1927 & PROCNODE, KEEP,KEEP8, SLAVEF, COMM, MYID, STEP, N, 1928 & ND, FILS ) 1929 USE CMUMPS_COMM_BUFFER 1930 IMPLICIT NONE 1931 INTEGER LPOOL, SLAVEF, COMM, MYID 1932 INTEGER N, KEEP(500) 1933 INTEGER(8) KEEP8(150) 1934 INTEGER POOL( LPOOL ), PROCNODE( KEEP(28) ), STEP( N ) 1935 INTEGER ND( KEEP(28) ), FILS( N ) 1936 INTEGER i, INODE, NELIM, NFR, LEVEL, IERR, WHAT 1937 DOUBLE PRECISION COST 1938 INTEGER NBINSUBTREE,NBTOP,INSUBTREE 1939 INTEGER MUMPS_330 1940 EXTERNAL MUMPS_330 1941 NBINSUBTREE = POOL(LPOOL) 1942 NBTOP = POOL(LPOOL - 1) 1943 INSUBTREE = POOL(LPOOL - 2) 1944 IF(BDC_MD)THEN 1945 RETURN 1946 ENDIF 1947 IF((KEEP(76).EQ.0).OR.(KEEP(76).EQ.2))THEN 1948 IF(NBTOP.NE.0)THEN 1949 DO i = LPOOL-NBTOP-2, min(LPOOL-3,LPOOL-NBTOP-2+3) 1950 INODE = POOL( i ) 1951 IF (INODE .LE. N .AND. INODE .GE. 1 ) THEN 1952 GOTO 20 1953 END IF 1954 END DO 1955 COST=dble(0) 1956 GOTO 30 1957 ELSE 1958 DO i = NBINSUBTREE, max(1,NBINSUBTREE-3), -1 1959 INODE = POOL( i ) 1960 IF (INODE .LE. N .AND. INODE .GE. 1 ) THEN 1961 GOTO 20 1962 END IF 1963 END DO 1964 COST=dble(0) 1965 GOTO 30 1966 ENDIF 1967 ELSE 1968 IF(KEEP(76).EQ.1)THEN 1969 IF(INSUBTREE.EQ.1)THEN 1970 DO i = NBINSUBTREE, max(1,NBINSUBTREE-3), -1 1971 INODE = POOL( i ) 1972 IF (INODE .LE. N .AND. INODE .GE. 1 ) THEN 1973 GOTO 20 1974 END IF 1975 END DO 1976 COST=dble(0) 1977 GOTO 30 1978 ELSE 1979 DO i = LPOOL-NBTOP-2, min(LPOOL-3,LPOOL-NBTOP-2+3) 1980 INODE = POOL( i ) 1981 IF (INODE .LE. N .AND. INODE .GE. 1 ) THEN 1982 GOTO 20 1983 END IF 1984 END DO 1985 COST=dble(0) 1986 GOTO 30 1987 ENDIF 1988 ELSE 1989 WRITE(*,*) 1990 & 'Internal error: Unknown pool management strategy' 1991 CALL MUMPS_ABORT() 1992 ENDIF 1993 ENDIF 1994 20 CONTINUE 1995 i = INODE 1996 NELIM = 0 1997 10 CONTINUE 1998 IF ( i > 0 ) THEN 1999 NELIM = NELIM + 1 2000 i = FILS(i) 2001 GOTO 10 2002 ENDIF 2003 NFR = ND( STEP(INODE) ) 2004 LEVEL = MUMPS_330( PROCNODE(STEP(INODE)), SLAVEF ) 2005 IF (LEVEL .EQ. 1) THEN 2006 COST = dble( NFR ) * dble( NFR ) 2007 ELSE 2008 IF ( KEEP(50) == 0 ) THEN 2009 COST = dble( NFR ) * dble( NELIM ) 2010 ELSE 2011 COST = dble( NELIM ) * dble( NELIM ) 2012 ENDIF 2013 ENDIF 2014 30 CONTINUE 2015 IF ( abs(POOL_LAST_COST_SENT-COST).GT.DM_THRES_MEM ) THEN 2016 WHAT = 2 2017 111 CONTINUE 2018 CALL CMUMPS_460( WHAT, 2019 & COMM, SLAVEF, 2020#if ! defined(OLD_LOAD_MECHANISM) 2021 & FUTURE_NIV2, 2022#endif 2023 & COST, dble(0),MYID, IERR ) 2024 POOL_LAST_COST_SENT = COST 2025 POOL_MEM(MYID)=COST 2026 IF ( IERR == -1 )THEN 2027 CALL CMUMPS_467(COMM_LD, KEEP) 2028 GOTO 111 2029 ELSE IF ( IERR .NE. 0 ) THEN 2030 WRITE(*,*) "Internal Error in CMUMPS_500", 2031 & IERR 2032 CALL MUMPS_ABORT() 2033 ENDIF 2034 ENDIF 2035 RETURN 2036 END SUBROUTINE CMUMPS_500 2037 SUBROUTINE CMUMPS_501( 2038 & OK,INODE,POOL,LPOOL,MYID,SLAVEF,COMM,KEEP,KEEP8) 2039 USE CMUMPS_COMM_BUFFER 2040 IMPLICIT NONE 2041 INTEGER LPOOL,MYID,SLAVEF,COMM,INODE 2042 INTEGER POOL(LPOOL),KEEP(500) 2043 INTEGER(8) KEEP8(150) 2044 INTEGER WHAT,IERR 2045 LOGICAL OK 2046 DOUBLE PRECISION COST 2047 LOGICAL FLAG 2048 EXTERNAL MUMPS_283,MUMPS_170 2049 LOGICAL MUMPS_283,MUMPS_170 2050 IF((INODE.LE.0).OR.(INODE.GT.N_LOAD)) THEN 2051 RETURN 2052 ENDIF 2053 IF (.NOT.MUMPS_170( 2054 & PROCNODE_LOAD(STEP_LOAD(INODE)), NPROCS) 2055 & ) THEN 2056 RETURN 2057 ENDIF 2058 IF(MUMPS_283(PROCNODE_LOAD(STEP_LOAD(INODE)),NPROCS))THEN 2059 IF(NE_LOAD(STEP_LOAD(INODE)).EQ.0)THEN 2060 RETURN 2061 ENDIF 2062 ENDIF 2063 FLAG=.FALSE. 2064 IF(INDICE_SBTR.LE.NB_SUBTREES)THEN 2065 IF(INODE.EQ.MY_FIRST_LEAF(INDICE_SBTR))THEN 2066 FLAG=.TRUE. 2067 ENDIF 2068 ENDIF 2069 IF(FLAG)THEN 2070 SBTR_PEAK_ARRAY(INDICE_SBTR_ARRAY)=MEM_SUBTREE(INDICE_SBTR) 2071 SBTR_CUR_ARRAY(INDICE_SBTR_ARRAY)=SBTR_CUR(MYID) 2072 INDICE_SBTR_ARRAY=INDICE_SBTR_ARRAY+1 2073 WHAT = 3 2074 IF(dble(MEM_SUBTREE(INDICE_SBTR)).GE.DM_THRES_MEM)THEN 2075 111 CONTINUE 2076 CALL CMUMPS_460( 2077 & WHAT, COMM, SLAVEF, 2078#if ! defined(OLD_LOAD_MECHANISM) 2079 & FUTURE_NIV2, 2080#endif 2081 & dble(MEM_SUBTREE(INDICE_SBTR)), dble(0),MYID, IERR ) 2082 IF ( IERR == -1 )THEN 2083 CALL CMUMPS_467(COMM_LD, KEEP) 2084 GOTO 111 2085 ELSE IF ( IERR .NE. 0 ) THEN 2086 WRITE(*,*) 2087 & "Internal Error 1 in CMUMPS_501", 2088 & IERR 2089 CALL MUMPS_ABORT() 2090 ENDIF 2091 ENDIF 2092 SBTR_MEM(MYID)=SBTR_MEM(MYID)+ 2093 & dble(MEM_SUBTREE(INDICE_SBTR)) 2094 INDICE_SBTR=INDICE_SBTR+1 2095 IF(INSIDE_SUBTREE.EQ.0)THEN 2096 INSIDE_SUBTREE=1 2097 ENDIF 2098 ELSE 2099 IF(INODE.EQ.MY_ROOT_SBTR(INDICE_SBTR-1))THEN 2100 WHAT = 3 2101 COST=-SBTR_PEAK_ARRAY(INDICE_SBTR_ARRAY-1) 2102 IF(abs(COST).GE.DM_THRES_MEM)THEN 2103 112 CONTINUE 2104 CALL CMUMPS_460( 2105 & WHAT, COMM, SLAVEF, 2106#if ! defined(OLD_LOAD_MECHANISM) 2107 & FUTURE_NIV2, 2108#endif 2109 & COST, dble(0) ,MYID,IERR ) 2110 IF ( IERR == -1 )THEN 2111 CALL CMUMPS_467(COMM_LD, KEEP) 2112 GOTO 112 2113 ELSE IF ( IERR .NE. 0 ) THEN 2114 WRITE(*,*) 2115 & "Internal Error 3 in CMUMPS_501", 2116 & IERR 2117 CALL MUMPS_ABORT() 2118 ENDIF 2119 ENDIF 2120 INDICE_SBTR_ARRAY=INDICE_SBTR_ARRAY-1 2121 SBTR_MEM(MYID)=SBTR_MEM(MYID)- 2122 & SBTR_PEAK_ARRAY(INDICE_SBTR_ARRAY) 2123 SBTR_CUR(MYID)=SBTR_CUR_ARRAY(INDICE_SBTR_ARRAY) 2124 IF(INDICE_SBTR_ARRAY.EQ.1)THEN 2125 SBTR_CUR(MYID)=dble(0) 2126 INSIDE_SUBTREE=0 2127 ENDIF 2128 ENDIF 2129 ENDIF 2130 CONTINUE 2131 END SUBROUTINE CMUMPS_501 2132 SUBROUTINE CMUMPS_504 2133 & (SLAVEF,KEEP,KEEP8,PROCS,MEM_DISTRIB,NCB,NFRONT, 2134 & NSLAVES_NODE,TAB_POS, 2135 & SLAVES_LIST,SIZE_SLAVES_LIST,MYID) 2136 IMPLICIT NONE 2137 INTEGER, intent(in) :: KEEP(500),SIZE_SLAVES_LIST 2138 INTEGER(8) KEEP8(150) 2139 INTEGER, intent(in) :: SLAVEF, NFRONT, NCB,MYID 2140 INTEGER, intent(in) :: PROCS(SLAVEF+1) 2141 INTEGER, intent(in) :: MEM_DISTRIB(0:SLAVEF-1) 2142 INTEGER, intent(out):: SLAVES_LIST(SIZE_SLAVES_LIST) 2143 INTEGER, intent(out):: TAB_POS(SLAVEF+2) 2144 INTEGER, intent(out):: NSLAVES_NODE 2145 INTEGER NUMBER_OF_PROCS,K47, K48, K50 2146 INTEGER(8) :: K821 2147 DOUBLE PRECISION DK821 2148 INTEGER J 2149 INTEGER KMIN, KMAX 2150 INTEGER OTHERS,CHOSEN,SMALL_SET,ACC 2151 DOUBLE PRECISION SOMME,TMP_SUM 2152 INTEGER AFFECTED 2153 INTEGER ADDITIONNAL_ROWS,i,X,REF,POS 2154 INTEGER(8)::TOTAL_MEM 2155 LOGICAL FORCE_CAND 2156 DOUBLE PRECISION TEMP(SLAVEF),PEAK 2157 INTEGER TEMP_ID(SLAVEF),NB_ROWS(SLAVEF) 2158 EXTERNAL MPI_WTIME 2159 DOUBLE PRECISION MPI_WTIME 2160 IF (KEEP8(21) .GT. 0_8) THEN 2161 write(*,*)MYID, 2162 & ": Internal Error 1 in CMUMPS_504" 2163 CALL MUMPS_ABORT() 2164 ENDIF 2165 K821=abs(KEEP8(21)) 2166 DK821=dble(K821) 2167 K50=KEEP(50) 2168 K48=KEEP(48) 2169 K47=KEEP(47) 2170 IF ( KEEP(24) == 0 .OR. KEEP(24) == 1 ) THEN 2171 FORCE_CAND = .FALSE. 2172 ELSE 2173 FORCE_CAND = (mod(KEEP(24),2).eq.0) 2174 END IF 2175 IF(K48.NE.4)THEN 2176 WRITE(*,*)'CMUMPS_COMPUTE_PARTI_ACTV_MEM_K821 2177 & should be called with KEEP(48) different from 4' 2178 CALL MUMPS_ABORT() 2179 ENDIF 2180 KMIN=1 2181 KMAX=int(K821/int(NFRONT,8)) 2182 IF(FORCE_CAND)THEN 2183 DO i=1,PROCS(SLAVEF+1) 2184 WLOAD(i)=DM_MEM(PROCS(i)) 2185 IDWLOAD(i)=PROCS(i) 2186 ENDDO 2187 NUMBER_OF_PROCS=PROCS(SLAVEF+1) 2188 OTHERS=NUMBER_OF_PROCS 2189 ELSE 2190 NUMBER_OF_PROCS=SLAVEF 2191 WLOAD(1:SLAVEF) = DM_MEM(0:NUMBER_OF_PROCS-1) 2192 DO i=1,NUMBER_OF_PROCS 2193 IDWLOAD(i) = i - 1 2194 ENDDO 2195 OTHERS=NUMBER_OF_PROCS-1 2196 ENDIF 2197 NB_ROWS=0 2198 CALL MUMPS_558(NUMBER_OF_PROCS, WLOAD, IDWLOAD) 2199 TOTAL_MEM=int(NCB,8)*int(NFRONT,8) 2200 SOMME=dble(0) 2201 J=1 2202 PEAK=dble(0) 2203 DO i=1,NUMBER_OF_PROCS 2204 IF((IDWLOAD(i).NE.MYID))THEN 2205 PEAK=max(PEAK,WLOAD(i)) 2206 TEMP_ID(J)=IDWLOAD(i) 2207 TEMP(J)=WLOAD(i) 2208 IF(BDC_SBTR)THEN 2209 TEMP(J)=TEMP(J)+SBTR_MEM(IDWLOAD(i))- 2210 & SBTR_CUR(IDWLOAD(i)) 2211 ENDIF 2212 IF(BDC_POOL)THEN 2213 TEMP(J)=TEMP(J)+POOL_MEM(TEMP_ID(J)) 2214 ENDIF 2215 IF(BDC_M2_MEM)THEN 2216 TEMP(J)=TEMP(J)+NIV2(TEMP_ID(J)+1) 2217 ENDIF 2218 J=J+1 2219 ENDIF 2220 ENDDO 2221 NUMBER_OF_PROCS=J-1 2222 CALL MUMPS_558(NUMBER_OF_PROCS, TEMP, TEMP_ID) 2223 IF(K50.EQ.0)THEN 2224 PEAK=max(PEAK, 2225 & DM_MEM(MYID)+dble(NFRONT)*dble(NFRONT-NCB)) 2226 ELSE 2227 PEAK=max(PEAK, 2228 & DM_MEM(MYID)+dble(NFRONT-NCB)*dble(NFRONT-NCB)) 2229 ENDIF 2230 PEAK=max(PEAK,TEMP(OTHERS)) 2231 SOMME=dble(0) 2232 DO i=1,NUMBER_OF_PROCS 2233 SOMME=SOMME+TEMP(OTHERS)-TEMP(i) 2234 ENDDO 2235 IF(SOMME.LE.dble(TOTAL_MEM)) THEN 2236 GOTO 096 2237 ENDIF 2238 096 CONTINUE 2239 SOMME=dble(0) 2240 DO i=1,OTHERS 2241 SOMME=SOMME+TEMP(OTHERS)-TEMP(i) 2242 ENDDO 2243 IF(dble(TOTAL_MEM).GE.SOMME) THEN 2244#if defined (OLD_PART) 2245 887 CONTINUE 2246#endif 2247 AFFECTED=0 2248 CHOSEN=0 2249 ACC=0 2250 DO i=1,OTHERS 2251 IF(K50.EQ.0)THEN 2252 IF((TEMP(OTHERS)-TEMP(i)).GT.DK821)THEN 2253 TMP_SUM=DK821 2254 ELSE 2255 TMP_SUM=TEMP(OTHERS)-TEMP(i) 2256 ENDIF 2257 X=int(TMP_SUM/dble(NFRONT)) 2258 IF((ACC+X).GT.NCB) X=NCB-ACC 2259 ENDIF 2260 IF(K50.NE.0)THEN 2261 IF((TEMP(OTHERS)-TEMP(i)).GT.DK821)THEN 2262 TMP_SUM=DK821 2263 ELSE 2264 TMP_SUM=TEMP(OTHERS)-TEMP(i) 2265 ENDIF 2266 X=int((-dble(NFRONT-NCB+ACC) 2267 & +sqrt(((dble(NFRONT-NCB+ACC)* 2268 & dble(NFRONT-NCB+ACC))+dble(4)* 2269 & (TMP_SUM))))/ 2270 & dble(2)) 2271 IF((ACC+X).GT.NCB) X=NCB-ACC 2272 IF(X.LE.0) THEN 2273 WRITE(*,*)"Internal Error 2 in 2274 & CMUMPS_504" 2275 CALL MUMPS_ABORT() 2276 ENDIF 2277 ENDIF 2278 NB_ROWS(i)=X 2279 CHOSEN=CHOSEN+1 2280 ACC=ACC+X 2281 IF(NCB-ACC.LT.KMIN) GOTO 111 2282 IF(NCB.EQ.ACC) GOTO 111 2283 ENDDO 2284 111 CONTINUE 2285 IF((ACC.GT.NCB))THEN 2286 X=0 2287 DO i=1,OTHERS 2288 X=X+NB_ROWS(i) 2289 ENDDO 2290 WRITE(*,*)'NCB=',NCB,',SOMME=',X 2291 WRITE(*,*)MYID, 2292 & ": Internal Error 3 in CMUMPS_504" 2293 CALL MUMPS_ABORT() 2294 ENDIF 2295 IF((NCB.NE.ACC))THEN 2296 IF(K50.NE.0)THEN 2297 IF(CHOSEN.NE.0)THEN 2298 ADDITIONNAL_ROWS=NCB-ACC 2299 NB_ROWS(CHOSEN)=NB_ROWS(CHOSEN)+ADDITIONNAL_ROWS 2300 ELSE 2301 TMP_SUM=dble(TOTAL_MEM)/dble(NUMBER_OF_PROCS) 2302 CHOSEN=0 2303 ACC=0 2304 DO i=1,OTHERS 2305 X=int((-dble(NFRONT-NCB+ACC) 2306 & +sqrt(((dble(NFRONT-NCB+ACC)* 2307 & dble(NFRONT-NCB+ACC))+dble(4)* 2308 & (TMP_SUM))))/ 2309 & dble(2)) 2310 IF((ACC+X).GT.NCB) X=NCB-ACC 2311 NB_ROWS(i)=X 2312 CHOSEN=CHOSEN+1 2313 ACC=ACC+X 2314 IF(NCB-ACC.LT.KMIN) GOTO 002 2315 IF(NCB.EQ.ACC) GOTO 002 2316 ENDDO 2317 002 CONTINUE 2318 IF(ACC.LT.NCB)THEN 2319 NB_ROWS(CHOSEN)=NB_ROWS(CHOSEN)+(NCB-ACC) 2320 ENDIF 2321 ENDIF 2322 GOTO 333 2323 ENDIF 2324 ADDITIONNAL_ROWS=NCB-ACC 2325 DO i=CHOSEN,1,-1 2326 IF(int(dble(ADDITIONNAL_ROWS)/ 2327 & dble(i)).NE.0)THEN 2328 GOTO 222 2329 ENDIF 2330 ENDDO 2331 222 CONTINUE 2332 X=int(dble(ADDITIONNAL_ROWS)/dble(i)) 2333 DO J=1,i 2334 NB_ROWS(J)=NB_ROWS(J)+X 2335 ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-X 2336 ENDDO 2337 IF(ADDITIONNAL_ROWS.NE.0) THEN 2338 NB_ROWS(1)=NB_ROWS(1)+ADDITIONNAL_ROWS 2339 ENDIF 2340 ENDIF 2341 333 CONTINUE 2342 IF(NB_ROWS(CHOSEN).EQ.0) CHOSEN=CHOSEN-1 2343 GOTO 889 2344 ELSE 2345 DO i=OTHERS,1,-1 2346 SOMME=dble(0) 2347 DO J=1,i 2348 SOMME=SOMME+TEMP(J) 2349 ENDDO 2350 SOMME=(dble(i)*TEMP(i))-SOMME 2351 IF(dble(TOTAL_MEM).GE.SOMME) GOTO 444 2352 ENDDO 2353 444 CONTINUE 2354 REF=i 2355 DO J=1,i 2356 IF(TEMP(J).EQ.TEMP(i)) THEN 2357 SMALL_SET=J 2358 GOTO 123 2359 ENDIF 2360 ENDDO 2361 123 CONTINUE 2362 IF(i.EQ.1)THEN 2363 NB_ROWS(i)=NCB 2364 CHOSEN=1 2365 GOTO 666 2366 ENDIF 2367 323 CONTINUE 2368 AFFECTED=0 2369 CHOSEN=0 2370 ACC=0 2371 DO i=1,SMALL_SET 2372 IF(K50.EQ.0)THEN 2373 IF((TEMP(SMALL_SET)-TEMP(i)).GT.DK821)THEN 2374 TMP_SUM=DK821 2375 ELSE 2376 TMP_SUM=TEMP(SMALL_SET)-TEMP(i) 2377 ENDIF 2378 X=int(TMP_SUM/dble(NFRONT)) 2379 IF((ACC+X).GT.NCB) X=NCB-ACC 2380 ENDIF 2381 IF(K50.NE.0)THEN 2382 IF((TEMP(SMALL_SET)-TEMP(i)).GT.DK821)THEN 2383 TMP_SUM=DK821 2384 ELSE 2385 TMP_SUM=TEMP(SMALL_SET)-TEMP(i) 2386 ENDIF 2387 X=int((-dble(NFRONT-NCB+ACC) 2388 & +sqrt(((dble(NFRONT-NCB+ACC)* 2389 & dble(NFRONT-NCB+ACC))+dble(4)* 2390 & (TMP_SUM))))/ 2391 & dble(2)) 2392 IF(X.LT.0)THEN 2393 WRITE(*,*)MYID, 2394 & ': Internal error 4 in CMUMPS_504' 2395 CALL MUMPS_ABORT() 2396 ENDIF 2397 IF((ACC+X).GT.NCB) X=NCB-ACC 2398 ENDIF 2399 NB_ROWS(i)=X 2400 ACC=ACC+X 2401 CHOSEN=CHOSEN+1 2402 IF(NCB-ACC.LT.KMIN) GOTO 888 2403 IF(NCB.EQ.ACC) GOTO 888 2404 IF(ACC.GT.NCB) THEN 2405 WRITE(*,*)MYID, 2406 & ': Internal error 5 in CMUMPS_504' 2407 CALL MUMPS_ABORT() 2408 ENDIF 2409 ENDDO 2410 888 CONTINUE 2411 SOMME=dble(0) 2412 X=NFRONT-NCB 2413 IF((ACC.GT.NCB))THEN 2414 WRITE(*,*)MYID, 2415 & ':Internal error 6 in CMUMPS_504' 2416 CALL MUMPS_ABORT() 2417 ENDIF 2418 IF((ACC.LT.NCB))THEN 2419 IF(K50.NE.0)THEN 2420 IF(SMALL_SET.LT.OTHERS)THEN 2421 SMALL_SET=REF+1 2422 REF=SMALL_SET 2423 GOTO 323 2424 ELSE 2425 NB_ROWS(CHOSEN)=NB_ROWS(CHOSEN)+NCB-ACC 2426 GOTO 666 2427 ENDIF 2428 ENDIF 2429 ADDITIONNAL_ROWS=NCB-ACC 2430#if ! defined (OLD_PART) 2431 i=CHOSEN+1 2432 DO WHILE ((ADDITIONNAL_ROWS.NE.0) 2433 & .AND.(i.LE.NUMBER_OF_PROCS)) 2434 J=1 2435#if ! defined (PART1_) 2436 X=int(ADDITIONNAL_ROWS/(i-1)) 2437 IF((X.EQ.0).AND.(ADDITIONNAL_ROWS.NE.0))THEN 2438 DO WHILE ((J.LT.i).AND.(ADDITIONNAL_ROWS.GT.0)) 2439 NB_ROWS(J)=NB_ROWS(J)+1 2440 ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-1 2441 J=J+1 2442 ENDDO 2443 IF(ADDITIONNAL_ROWS.NE.0)THEN 2444 WRITE(*,*)MYID, 2445 & ':Internal error 7 in CMUMPS_504' 2446 CALL MUMPS_ABORT() 2447 ENDIF 2448 GOTO 047 2449 ENDIF 2450 IF((TEMP(1)+dble((NB_ROWS(1)+X)*NFRONT)).LE. 2451 & TEMP(i))THEN 2452 DO WHILE ((ADDITIONNAL_ROWS.NE.0) 2453 & .AND.(J.LT.i)) 2454 AFFECTED=X 2455 IF((AFFECTED+NB_ROWS(J)).GT. 2456 & KMAX)THEN 2457 AFFECTED=KMAX-NB_ROWS(J) 2458 ENDIF 2459 NB_ROWS(J)=NB_ROWS(J)+AFFECTED 2460 ADDITIONNAL_ROWS=ADDITIONNAL_ROWS- 2461 & AFFECTED 2462 J=J+1 2463 ENDDO 2464 ELSE 2465#endif 2466 DO WHILE ((ADDITIONNAL_ROWS.NE.0) 2467 & .AND.(J.LE.i)) 2468 AFFECTED=int((TEMP(i)-(TEMP(J)+ 2469 & (dble(NB_ROWS(J))*dble(NFRONT)))) 2470 & /dble(NFRONT)) 2471 IF((AFFECTED+NB_ROWS(J)).GT.KMAX)THEN 2472 AFFECTED=KMAX-NB_ROWS(J) 2473 ENDIF 2474 IF(AFFECTED.GT.ADDITIONNAL_ROWS)THEN 2475 AFFECTED=ADDITIONNAL_ROWS 2476 ENDIF 2477 NB_ROWS(J)=NB_ROWS(J)+AFFECTED 2478 ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-AFFECTED 2479 J=J+1 2480 ENDDO 2481#if ! defined (PART1_) 2482 ENDIF 2483#endif 2484 i=i+1 2485 ENDDO 2486 047 CONTINUE 2487 IF((ADDITIONNAL_ROWS.EQ.0).AND. 2488 & (i.LT.NUMBER_OF_PROCS))THEN 2489 CHOSEN=i-1 2490 ELSE 2491 CHOSEN=i-2 2492 ENDIF 2493#if ! defined (PART1_) 2494 IF((CHOSEN.EQ.NUMBER_OF_PROCS-1).AND. 2495 & (ADDITIONNAL_ROWS.NE.0))THEN 2496 DO i=1,CHOSEN 2497 NB_ROWS(i)=NB_ROWS(i)+1 2498 ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-1 2499 IF(ADDITIONNAL_ROWS.EQ.0) GOTO 048 2500 ENDDO 2501 048 CONTINUE 2502 ENDIF 2503#endif 2504 IF((CHOSEN.EQ.NUMBER_OF_PROCS-1).AND. 2505 & (ADDITIONNAL_ROWS.NE.0))THEN 2506 i=CHOSEN+1 2507 DO WHILE ((ADDITIONNAL_ROWS.NE.0) 2508 & .AND.(i.LE.NUMBER_OF_PROCS)) 2509 J=1 2510 DO WHILE ((ADDITIONNAL_ROWS.NE.0) 2511 & .AND.(J.LE.i)) 2512 AFFECTED=int((TEMP(i)-(TEMP(J)+ 2513 & (dble(NB_ROWS(J))* 2514 & dble(NFRONT))))/dble(NFRONT)) 2515 IF(AFFECTED.GT.ADDITIONNAL_ROWS)THEN 2516 AFFECTED=ADDITIONNAL_ROWS 2517 ENDIF 2518 NB_ROWS(J)=NB_ROWS(J)+AFFECTED 2519 ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-AFFECTED 2520 J=J+1 2521 ENDDO 2522 i=i+1 2523 ENDDO 2524 CHOSEN=i-2 2525 ENDIF 2526 CONTINUE 2527#else 2528 DO i=CHOSEN,1,-1 2529 IF(int(dble(ADDITIONNAL_ROWS)/ 2530 & dble(i)).NE.0)THEN 2531 GOTO 555 2532 ENDIF 2533 ENDDO 2534 555 CONTINUE 2535 X=int(dble(ADDITIONNAL_ROWS)/dble(i)) 2536 DO J=1,i 2537 IF(NB_ROWS(J)+X.GT.K821/NCB)THEN 2538 ADDITIONNAL_ROWS=ADDITIONNAL_ROWS- 2539 & ((K821/NCB)-NB_ROWS(J)) 2540 NB_ROWS(J)=(K821/NFRONT) 2541 ELSE IF ((TEMP(J)+dble((NB_ROWS(J)+X))* 2542 & dble(NFRONT)).GT. 2543 & PEAK)THEN 2544 AFFECTED=int((PEAK-(TEMP(J)+dble(NB_ROWS(J))* 2545 & dble(NFRONT))/dble(NFRONT)) 2546 ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-AFFECTED 2547 NB_ROWS(J)=NB_ROWS(J)+AFFECTED 2548 ELSE 2549 NB_ROWS(J)=NB_ROWS(J)+X 2550 ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-X 2551 ENDIF 2552 IF(((TEMP(J)+dble(NB_ROWS(J))*dble(NFRONT)) 2553 & .GT. PEAK) 2554 & .AND.(SMALL_SET.LT.OTHERS))THEN 2555 WRITE(*,*)MYID, 2556 & ':Internal error 8 in CMUMPS_504' 2557 SMALL_SET=SMALL_SET+1 2558 CALL MUMPS_ABORT() 2559 ENDIF 2560 ENDDO 2561 SOMME=dble(0) 2562 DO J=1,CHOSEN 2563 SOMME=SOMME+NB_ROWS(J) 2564 ENDDO 2565 IF(ADDITIONNAL_ROWS.NE.0) THEN 2566 DO J=1,CHOSEN 2567 IF(NB_ROWS(J).LT.0)THEN 2568 WRITE(*,*)MYID, 2569 & ':Internal error 9 in CMUMPS_504' 2570 CALL MUMPS_ABORT() 2571 ENDIF 2572 IF ((TEMP(J)+dble(NB_ROWS(J)) 2573 & *dble(NFRONT)).GT. 2574 & PEAK)THEN 2575 WRITE(*,*)MYID, 2576 & ':Internal error 10 in CMUMPS_504' 2577 CALL MUMPS_ABORT() 2578 ENDIF 2579 IF ((TEMP(J)+dble(NB_ROWS(J)+ 2580 & ADDITIONNAL_ROWS)*dble(NFRONT)).GE. 2581 & PEAK)THEN 2582 AFFECTED=int((PEAK-(TEMP(J)+ 2583 & dble(NB_ROWS(J))* 2584 & dble(NFRONT))/dble(NFRONT)) 2585 ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-AFFECTED 2586 NB_ROWS(J)=NB_ROWS(J)+AFFECTED 2587 IF((TEMP(J)+dble(NFRONT)* 2588 & dble(NB_ROWS(J))).GT. 2589 & PEAK)THEN 2590 WRITE(*,*)MYID, 2591 & ':Internal error 11 in CMUMPS_504' 2592 CALL MUMPS_ABORT() 2593 ENDIF 2594 ELSE 2595 NB_ROWS(J)=NB_ROWS(J)+ADDITIONNAL_ROWS 2596 ADDITIONNAL_ROWS=0 2597 ENDIF 2598 IF(ADDITIONNAL_ROWS.EQ.0) GOTO 666 2599 ENDDO 2600 IF(SMALL_SET.EQ.(NUMBER_OF_PROCS)) THEN 2601 NB_ROWS=0 2602 GOTO 887 2603 ENDIF 2604 i=CHOSEN+1 2605 DO WHILE ((ADDITIONNAL_ROWS.NE.0) 2606 & .AND.(i.LE.NUMBER_OF_PROCS)) 2607 IF(NB_ROWS(i)+ADDITIONNAL_ROWS.LT.K821/NFRONT) 2608 & THEN 2609 NB_ROWS(i)=NB_ROWS(i)+ADDITIONNAL_ROWS 2610 ADDITIONNAL_ROWS=0 2611 ELSE 2612 ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-(K821/ 2613 & NFRONT 2614 & -NB_ROWS(i)) 2615 NB_ROWS(i)=K821/NFRONT 2616 ENDIF 2617 i=i+1 2618 ENDDO 2619 CHOSEN=i-1 2620 IF(ADDITIONNAL_ROWS.NE.0)THEN 2621 DO i=CHOSEN,1,-1 2622 IF(int(dble(ADDITIONNAL_ROWS)/dble(i)) 2623 & .NE.0)THEN 2624 GOTO 372 2625 ENDIF 2626 ENDDO 2627 372 CONTINUE 2628 X=int(dble(ADDITIONNAL_ROWS)/dble(i)) 2629 DO J=1,i 2630 NB_ROWS(J)=NB_ROWS(J)+X 2631 ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-X 2632 ENDDO 2633 IF(ADDITIONNAL_ROWS.NE.0) THEN 2634 NB_ROWS(1)=NB_ROWS(1)+ADDITIONNAL_ROWS 2635 ENDIF 2636 ENDIF 2637 ENDIF 2638#endif 2639 ENDIF 2640 666 CONTINUE 2641 SOMME=dble(0) 2642 X=0 2643 POS=0 2644 DO i=1,CHOSEN 2645 IF(K50.NE.0) THEN 2646 IF((TEMP(i)+dble(NB_ROWS(i)) 2647 & *dble(X+NB_ROWS(i)+NFRONT-NCB)) 2648 & .GT.PEAK)THEN 2649 SMALL_SET=SMALL_SET+1 2650 ENDIF 2651 ENDIF 2652 IF(K50.EQ.0) THEN 2653 IF((TEMP(i)+dble(NB_ROWS(i))*dble(NFRONT)) 2654 & .GT.PEAK)THEN 2655 SMALL_SET=SMALL_SET+1 2656 ENDIF 2657 ENDIF 2658 X=X+NB_ROWS(i) 2659 SOMME=SOMME+ dble(NB_ROWS(i)) 2660 ENDDO 2661 ENDIF 2662 889 CONTINUE 2663 J=CHOSEN 2664 X=0 2665 DO i=J,1,-1 2666 IF(NB_ROWS(i).EQ.0)THEN 2667 IF(X.EQ.1)THEN 2668 WRITE(*,*)MYID, 2669 & ':Internal error 12 in CMUMPS_504' 2670 CALL MUMPS_ABORT() 2671 ENDIF 2672 CHOSEN=CHOSEN-1 2673 ELSE 2674 IF(NB_ROWS(i).GT.0)THEN 2675 X=1 2676 ELSE 2677 WRITE(*,*) 2678 & 'Internal error 13 in CMUMPS_504' 2679 CALL MUMPS_ABORT() 2680 ENDIF 2681 ENDIF 2682 ENDDO 2683 NSLAVES_NODE=CHOSEN 2684 TAB_POS(NSLAVES_NODE+1)= NCB+1 2685 TAB_POS(SLAVEF+2) = CHOSEN 2686 POS=1 2687 DO i=1,CHOSEN 2688 SLAVES_LIST(i)=TEMP_ID(i) 2689 TAB_POS(i)=POS 2690 POS=POS+NB_ROWS(i) 2691 IF(NB_ROWS(i).LE.0)THEN 2692 WRITE(*,*) 2693 & 'Internal error 14 in CMUMPS_504' 2694 CALL MUMPS_ABORT() 2695 ENDIF 2696 ENDDO 2697 DO i=CHOSEN+1,NUMBER_OF_PROCS 2698 SLAVES_LIST(i)=TEMP_ID(i) 2699 ENDDO 2700 IF(POS.NE.(NCB+1))THEN 2701 WRITE(*,*) 2702 & 'Internal error 15 in CMUMPS_504' 2703 CALL MUMPS_ABORT() 2704 ENDIF 2705 END SUBROUTINE CMUMPS_504 2706 SUBROUTINE CMUMPS_518 2707 & (NCBSON_MAX,SLAVEF,KEEP,KEEP8, 2708 & PROCS,MEM_DISTRIB,NCB,NFRONT, 2709 & NSLAVES_NODE,TAB_POS, 2710 & SLAVES_LIST,SIZE_SLAVES_LIST,MYID,INODE,MP,LP) 2711 IMPLICIT NONE 2712 INTEGER, intent(in) :: KEEP(500),SIZE_SLAVES_LIST 2713 INTEGER(8) KEEP8(150) 2714 INTEGER, intent(in) :: SLAVEF, NFRONT, NCB,MYID 2715 INTEGER, intent(in) :: NCBSON_MAX 2716 INTEGER, intent(in) :: PROCS(SLAVEF+1) 2717 INTEGER, intent(in) :: MEM_DISTRIB(0:SLAVEF-1),INODE 2718 INTEGER, intent(in) :: MP,LP 2719 INTEGER, intent(out):: SLAVES_LIST(SIZE_SLAVES_LIST) 2720 INTEGER, intent(out):: TAB_POS(SLAVEF+2) 2721 INTEGER, intent(out):: NSLAVES_NODE 2722 INTEGER NUMBER_OF_PROCS,K47,K48, K50,K83,K69 2723 INTEGER(8) :: K821 2724 INTEGER J 2725 INTEGER KMIN, KMAX 2726 INTEGER OTHERS,CHOSEN,SMALL_SET,ACC 2727 DOUBLE PRECISION SOMME,TMP_SUM,DELTA,A,B,C,MASTER_WORK 2728 INTEGER AFFECTED 2729 INTEGER ADDITIONNAL_ROWS,i,X,REF,POS,NELIM 2730 INTEGER(8) X8 2731 LOGICAL FORCE_CAND,SMP 2732 DOUBLE PRECISION BANDE_K821 2733 INTEGER NB_SAT,NB_ZERO 2734 DOUBLE PRECISION TEMP(SLAVEF),TOTAL_COST, MAX_MEM_ALLOW 2735 INTEGER TEMP_ID(SLAVEF),NB_ROWS(SLAVEF) 2736 INTEGER NSLAVES_REF,NCB_FILS 2737 EXTERNAL MPI_WTIME,MUMPS_442 2738 INTEGER MUMPS_442 2739 INTEGER POS_MIN_LOAD,SIZE_MY_SMP,WHAT,ADDITIONNAL_ROWS_SPECIAL 2740 LOGICAL HAVE_TYPE1_SON 2741 DOUBLE PRECISION MIN_LOAD,MAX_LOAD,TEMP_MAX_LOAD 2742 DOUBLE PRECISION MPI_WTIME 2743 DOUBLE PRECISION BUF_SIZE,NELIM_MEM_SIZE 2744 DOUBLE PRECISION MEM_SIZE_STRONG(SLAVEF),MEM_SIZE_WEAK(SLAVEF) 2745 K821=abs(KEEP8(21)) 2746 TEMP_MAX_LOAD=dble(0) 2747 K50=KEEP(50) 2748 K48=KEEP(48) 2749 K47=KEEP(47) 2750 K83=KEEP(83) 2751 K69=0 2752 NCB_FILS=NCBSON_MAX 2753 IF(int(NCB_FILS,8)*int(min(NCB,NCB_FILS),8).GT.K821)THEN 2754 HAVE_TYPE1_SON=.TRUE. 2755 ELSE 2756 HAVE_TYPE1_SON=.FALSE. 2757 ENDIF 2758 SMP=(K69.NE.0) 2759 IF ( KEEP(24) == 0 .OR. KEEP(24) == 1 ) THEN 2760 FORCE_CAND = .FALSE. 2761 ELSE 2762 FORCE_CAND = (mod(KEEP(24),2).eq.0) 2763 END IF 2764 NELIM=NFRONT-NCB 2765 KMAX=int(K821/int(NCB,8)) 2766 IF(FORCE_CAND)THEN 2767 DO i=1,PROCS(SLAVEF+1) 2768 WLOAD(i)=LOAD_FLOPS(PROCS(i)) 2769 IDWLOAD(i)=PROCS(i) 2770 IF (WLOAD(i) < -0.5d0 ) THEN 2771 IF((MP.GT.0).AND.(LP.GE.2))THEN 2772 WRITE(MP,*)MYID,': Warning: negative load ', 2773 & WLOAD(i) 2774 ENDIF 2775 ENDIF 2776 WLOAD(i)=max(WLOAD(i),0.0d0) 2777 ENDDO 2778 NUMBER_OF_PROCS=PROCS(SLAVEF+1) 2779 OTHERS=NUMBER_OF_PROCS 2780 ELSE 2781 NUMBER_OF_PROCS=SLAVEF 2782 WLOAD(1:SLAVEF) = LOAD_FLOPS(0:NUMBER_OF_PROCS-1) 2783 DO i=1,NUMBER_OF_PROCS 2784 IDWLOAD(i) = i - 1 2785 IF (WLOAD(i) < -0.5d0 ) THEN 2786 IF((MP.GT.0).AND.(LP.GE.2))THEN 2787 WRITE(MP,*)MYID,': Negative load ', 2788 & WLOAD(i) 2789 ENDIF 2790 ENDIF 2791 WLOAD(i)=max(WLOAD(i),0.0d0) 2792 ENDDO 2793 OTHERS=NUMBER_OF_PROCS-1 2794 ENDIF 2795 KMAX=int(NCB/OTHERS) 2796 KMIN=MUMPS_442(int(NCB,8)*int(KMAX,8),K50,KMAX,NCB) 2797 NB_ROWS=0 2798 CALL MUMPS_558(NUMBER_OF_PROCS, WLOAD, IDWLOAD) 2799 IF(K50.EQ.0)THEN 2800 TOTAL_COST=dble( NELIM ) * dble ( NCB ) + 2801 & dble(NCB) * dble(NELIM)*dble(2*NFRONT-NELIM-1) 2802 ELSE 2803 TOTAL_COST=dble(NELIM) * dble ( NCB ) * 2804 & dble(NFRONT+1) 2805 ENDIF 2806 CALL MUMPS_511(NFRONT,NELIM,NELIM,K50, 2807 & 2,MASTER_WORK) 2808 SOMME=dble(0) 2809 J=1 2810 IF(FORCE_CAND.AND.(NUMBER_OF_PROCS.GT.K83))THEN 2811 MASTER_WORK=dble(KEEP(88))*MASTER_WORK/dble(100) 2812 ENDIF 2813 IF(FORCE_CAND.AND.(NUMBER_OF_PROCS.LE.K83))THEN 2814 MASTER_WORK=dble(KEEP(87))*MASTER_WORK/dble(100) 2815 ENDIF 2816 IF(MASTER_WORK.LT.dble(1))THEN 2817 MASTER_WORK=dble(1) 2818 ENDIF 2819 NSLAVES_REF=int(TOTAL_COST/MASTER_WORK)+1 2820 IF(FORCE_CAND)THEN 2821 NSLAVES_REF=min(NSLAVES_REF,NUMBER_OF_PROCS) 2822 ELSE 2823 NSLAVES_REF=min(NSLAVES_REF,NUMBER_OF_PROCS-1) 2824 ENDIF 2825 DO i=1,NUMBER_OF_PROCS 2826 IF((IDWLOAD(i).NE.MYID))THEN 2827 TEMP_ID(J)=IDWLOAD(i) 2828 TEMP(J)=WLOAD(i) 2829 IF(BDC_M2_FLOPS)THEN 2830 TEMP(J)=TEMP(J)+NIV2(TEMP_ID(J)+1) 2831 ENDIF 2832 J=J+1 2833 ENDIF 2834 ENDDO 2835 NUMBER_OF_PROCS=J-1 2836 CALL MUMPS_558(NUMBER_OF_PROCS, TEMP, TEMP_ID) 2837 SOMME=dble(0) 2838 TMP_SUM=dble(0) 2839 DO i=1,OTHERS 2840 SOMME=SOMME+TEMP(OTHERS)-TEMP(i) 2841 TMP_SUM=TMP_SUM+TEMP(i) 2842 ENDDO 2843 TMP_SUM=(TMP_SUM/dble(OTHERS))+ 2844 & (TOTAL_COST/dble(OTHERS)) 2845 SIZE_MY_SMP=OTHERS 2846 MIN_LOAD=TEMP(1) 2847 POS_MIN_LOAD=1 2848 IF(.NOT.SMP) MAX_LOAD=TEMP(OTHERS) 2849 IF(SMP)THEN 2850 J=1 2851 DO i=1,OTHERS 2852 IF(MEM_DISTRIB(TEMP_ID(i)).EQ.1)THEN 2853 IF(TEMP(i).LE.TMP_SUM)THEN 2854 WLOAD(J)=TEMP(i) 2855 IDWLOAD(J)=TEMP_ID(i) 2856 J=J+1 2857 ELSE 2858 ENDIF 2859 ENDIF 2860 ENDDO 2861 MAX_LOAD=WLOAD(J-1) 2862 SIZE_MY_SMP=J-1 2863 DO i=1,OTHERS 2864 IF((MEM_DISTRIB(TEMP_ID(i)).NE.1).OR. 2865 & ((MEM_DISTRIB(TEMP_ID(i)).EQ.1).AND. 2866 & (TEMP(i).GE.TMP_SUM)))THEN 2867 WLOAD(J)=TEMP(i) 2868 IDWLOAD(J)=TEMP_ID(i) 2869 J=J+1 2870 ENDIF 2871 ENDDO 2872 TEMP=WLOAD 2873 TEMP_ID=IDWLOAD 2874 ENDIF 2875 IF(BDC_MD)THEN 2876 BUF_SIZE=dble(K821) 2877 IF (KEEP(201).EQ.2) THEN 2878 A=dble(int((dble(KEEP(100))/dble(2))/dble(NELIM))) 2879 IF(K50.EQ.0)THEN 2880 BUF_SIZE=min(BUF_SIZE,A*dble(NCB)) 2881 ELSE 2882 BUF_SIZE=min(BUF_SIZE,A*A) 2883 ENDIF 2884 ENDIF 2885 BUF_SIZE=dble(K821) 2886 DO i=1,NUMBER_OF_PROCS 2887 A=dble(MD_MEM(TEMP_ID(i)))/ 2888 & dble(NELIM) 2889 A=A*dble(NFRONT) 2890 IF(K50.EQ.0)THEN 2891 B=dble(int(dble(NCB)/dble(NUMBER_OF_PROCS))+1)* 2892 & dble(NFRONT) 2893 ELSE 2894 WHAT = 5 2895#if ! defined (OOC_PAR_MEM_SLAVE_SELECT) && ! defined (OOC_PAR_MEM2) 2896 CALL MUMPS_503(WHAT, KEEP,KEEP8, NCB, 2897 & NFRONT, min(NCB,OTHERS), J, X8) 2898#endif 2899 B=dble(X8)+(dble(J)*dble(NELIM)) 2900 ENDIF 2901 NELIM_MEM_SIZE=A+B 2902 MEM_SIZE_WEAK(i)=NELIM_MEM_SIZE 2903 IF((SBTR_WHICH_M.EQ.0).OR.(.NOT.BDC_SBTR))THEN 2904 IF(BDC_M2_MEM)THEN 2905 MEM_SIZE_STRONG(i)= 2906 & dble(TAB_MAXS(TEMP_ID(i)))-DM_MEM(TEMP_ID(i))- 2907 & LU_USAGE(TEMP_ID(i))-NIV2(TEMP_ID(i)+1) 2908 ELSE 2909 MEM_SIZE_STRONG(i)= 2910 & dble(TAB_MAXS(TEMP_ID(i)))-DM_MEM(TEMP_ID(i))- 2911 & LU_USAGE(TEMP_ID(i)) 2912 ENDIF 2913 ELSE 2914 IF(BDC_SBTR)THEN 2915 IF(BDC_M2_MEM)THEN 2916 MEM_SIZE_STRONG(i)= 2917 & dble(TAB_MAXS(TEMP_ID(i)))-DM_MEM(TEMP_ID(i))- 2918 & LU_USAGE(TEMP_ID(i))-NIV2(TEMP_ID(i)+1)- 2919 & (SBTR_MEM(TEMP_ID(i))-SBTR_CUR(TEMP_ID(i))) 2920 ELSE 2921 MEM_SIZE_STRONG(i)= 2922 & dble(TAB_MAXS(TEMP_ID(i)))-DM_MEM(TEMP_ID(i))- 2923 & LU_USAGE(TEMP_ID(i))- 2924 & (SBTR_MEM(TEMP_ID(i))-SBTR_CUR(TEMP_ID(i))) 2925 ENDIF 2926 ENDIF 2927 ENDIF 2928 IF(min(MEM_SIZE_STRONG(i),MEM_SIZE_WEAK(i)).LT.dble(0))THEN 2929 IF(MEM_SIZE_STRONG(i).LT.0.0d0)THEN 2930 MEM_SIZE_STRONG(i)=dble(0) 2931 ELSE 2932 MEM_SIZE_WEAK(i)=dble(0) 2933 ENDIF 2934 ENDIF 2935 ENDDO 2936 ELSE 2937 BUF_SIZE=dble(K821) 2938 DO i=1,NUMBER_OF_PROCS 2939 IF((SBTR_WHICH_M.EQ.0).OR.(.NOT.BDC_SBTR))THEN 2940 IF(BDC_M2_MEM)THEN 2941 MEM_SIZE_STRONG(i)= 2942 & dble(TAB_MAXS(TEMP_ID(i)))-DM_MEM(TEMP_ID(i))- 2943 & LU_USAGE(TEMP_ID(i))-NIV2(TEMP_ID(i)+1) 2944 ELSE 2945 MEM_SIZE_STRONG(i)= 2946 & dble(TAB_MAXS(TEMP_ID(i)))-DM_MEM(TEMP_ID(i))- 2947 & LU_USAGE(TEMP_ID(i)) 2948 ENDIF 2949 ELSE 2950 IF(BDC_SBTR)THEN 2951 IF(BDC_M2_MEM)THEN 2952 MEM_SIZE_STRONG(i)= 2953 & dble(TAB_MAXS(TEMP_ID(i)))-DM_MEM(TEMP_ID(i))- 2954 & LU_USAGE(TEMP_ID(i))-NIV2(TEMP_ID(i)+1)- 2955 & (SBTR_MEM(TEMP_ID(i))-SBTR_CUR(TEMP_ID(i))) 2956 ELSE 2957 MEM_SIZE_STRONG(i)= 2958 & dble(TAB_MAXS(TEMP_ID(i)))-DM_MEM(TEMP_ID(i))- 2959 & LU_USAGE(TEMP_ID(i))- 2960 & (SBTR_MEM(TEMP_ID(i))-SBTR_CUR(TEMP_ID(i))) 2961 ENDIF 2962 ENDIF 2963 ENDIF 2964 MEM_SIZE_STRONG(i)=max(dble(0),MEM_SIZE_STRONG(i)) 2965 MEM_SIZE_WEAK(i)=huge(MEM_SIZE_WEAK(i)) 2966 ENDDO 2967 ENDIF 2968 IF((((NUMBER_OF_PROCS.LE.K83).AND.FORCE_CAND).AND. 2969 & (TOTAL_COST.GE.SOMME)).OR. 2970 & (.NOT.FORCE_CAND).OR. 2971 & (((NUMBER_OF_PROCS+1).GT.K83).AND.FORCE_CAND))THEN 2972 REF=NSLAVES_REF 2973 SMALL_SET=NSLAVES_REF 2974 IF(.NOT.SMP)THEN 2975 DO i=NSLAVES_REF,1,-1 2976 SOMME=dble(0) 2977 DO J=1,i 2978 SOMME=SOMME+TEMP(J) 2979 ENDDO 2980 SOMME=(dble(i)*TEMP(i))-SOMME 2981 IF(TOTAL_COST.GE.SOMME) GOTO 444 2982 ENDDO 2983 444 CONTINUE 2984 REF=i 2985 SMALL_SET=REF 2986 MAX_LOAD=TEMP(SMALL_SET) 2987 ELSE 2988 X=min(SIZE_MY_SMP,NSLAVES_REF) 2989 450 CONTINUE 2990 SOMME=dble(0) 2991 DO J=1,X 2992 SOMME=SOMME+(TEMP(X)-TEMP(J)) 2993 ENDDO 2994 IF(SOMME.GT.TOTAL_COST)THEN 2995 X=X-1 2996 GOTO 450 2997 ELSE 2998 IF(X.LT.SIZE_MY_SMP) THEN 2999 REF=X 3000 SMALL_SET=REF 3001 MAX_LOAD=TEMP(SMALL_SET) 3002 ELSE 3003 X=min(SIZE_MY_SMP,NSLAVES_REF) 3004 J=X+1 3005 MAX_LOAD=TEMP(X) 3006 TMP_SUM=MAX_LOAD 3007 DO i=X+1,OTHERS 3008 IF(TEMP(i).GT.MAX_LOAD)THEN 3009 SOMME=SOMME+(dble(i-1)*(TEMP(i)-MAX_LOAD)) 3010 TMP_SUM=MAX_LOAD 3011 MAX_LOAD=TEMP(i) 3012 ELSE 3013 SOMME=SOMME+(MAX_LOAD-TEMP(i)) 3014 ENDIF 3015 IF(i.EQ.NSLAVES_REF)THEN 3016 SMALL_SET=NSLAVES_REF 3017 REF=SMALL_SET 3018 GOTO 323 3019 ENDIF 3020 IF(SOMME.GT.TOTAL_COST)THEN 3021 REF=i-1 3022 SMALL_SET=i-1 3023 MAX_LOAD=TMP_SUM 3024 GOTO 323 3025 ENDIF 3026 ENDDO 3027 ENDIF 3028 ENDIF 3029 ENDIF 3030 323 CONTINUE 3031 MAX_LOAD=dble(0) 3032 DO i=1,SMALL_SET 3033 MAX_LOAD=max(MAX_LOAD,TEMP(i)) 3034 ENDDO 3035 TEMP_MAX_LOAD=MAX_LOAD 3036 NB_ROWS=0 3037 TMP_SUM=dble(0) 3038 CHOSEN=0 3039 ACC=0 3040 NB_SAT=0 3041 NB_ZERO=0 3042 DO i=1,SMALL_SET 3043 IF(K50.EQ.0)THEN 3044 X=int(BUF_SIZE/dble(NCB+1))-1 3045 BANDE_K821=dble(X)*dble(NFRONT) 3046 ELSE 3047 A=dble(1) 3048 B=dble(ACC+2) 3049 C=-BUF_SIZE+dble(ACC+NELIM) 3050 DELTA=(B*B)-(dble(4)*A*C) 3051 X=int((-B+sqrt(DELTA))/(dble(2)*A)) 3052 IF(X.GT.NCB-ACC) X=NCB-ACC 3053 BANDE_K821=dble(X)*dble(NELIM+ACC+X) 3054 ENDIF 3055 IF(HAVE_TYPE1_SON)THEN 3056 IF(K50.EQ.0)THEN 3057 X=int((BUF_SIZE-dble(NFRONT))/dble(NFRONT+1)) 3058 BANDE_K821=dble(X)*dble(NFRONT) 3059 ELSE 3060 A=dble(1) 3061 B=dble(ACC+2+NELIM) 3062 C=-BUF_SIZE+dble(ACC+NELIM) 3063 DELTA=(B*B)-(dble(4)*A*C) 3064 X=int((-B+sqrt(DELTA))/(dble(2)*A)) 3065 IF(X.GT.NCB-ACC) X=NCB-ACC 3066 BANDE_K821=dble(X)*dble(NELIM+ACC+X) 3067 ENDIF 3068 ENDIF 3069 MAX_MEM_ALLOW=BANDE_K821 3070 IF(BDC_MD)THEN 3071 MAX_MEM_ALLOW=min( 3072 & min(MEM_SIZE_WEAK(i),MEM_SIZE_STRONG(i)), 3073 & BANDE_K821) 3074 MAX_MEM_ALLOW=max(dble(0),MAX_MEM_ALLOW) 3075 ENDIF 3076 IF(K50.EQ.0)THEN 3077 KMAX=int(MAX_MEM_ALLOW/dble(NFRONT)) 3078 X=int((MAX_LOAD-TEMP(i))/ 3079 & (dble(NELIM)*dble(2*NFRONT-NELIM))) 3080 IF(X.GE.KMAX)THEN 3081 IF(KMAX.GE.KMIN)THEN 3082 X=KMAX 3083 NB_SAT=NB_SAT+1 3084 ELSE 3085 X=0 3086 ENDIF 3087 ELSE 3088 IF(X.LT.KMIN)THEN 3089 X=0 3090 ENDIF 3091 ENDIF 3092 IF((ACC+X).GT.NCB) X=NCB-ACC 3093 ENDIF 3094 IF(K50.NE.0)THEN 3095 A=dble(1) 3096 B=dble(ACC+NELIM) 3097 C=dble(-MAX_MEM_ALLOW) 3098 DELTA=((B*B)-(dble(4)*A*C)) 3099 KMAX=int((-B+sqrt(DELTA))/(dble(2)*A)) 3100 A=dble(NELIM) 3101 B=dble(NELIM)*(dble(NELIM)+dble(2*ACC+1)) 3102 C=-(MAX_LOAD-TEMP(i)) 3103 DELTA=(B*B-(dble(4)*A*C)) 3104 X=int((-B+sqrt(DELTA))/(dble(2)*A)) 3105 IF(X.LT.0) THEN 3106 WRITE(*,*)MYID, 3107 & ': Internal error 1 in CMUMPS_518' 3108 CALL MUMPS_ABORT() 3109 ENDIF 3110 IF(X.GE.KMAX)THEN 3111 IF(KMAX.GE.KMIN)THEN 3112 X=KMAX 3113 NB_SAT=NB_SAT+1 3114 ELSE 3115 X=0 3116 ENDIF 3117 ELSE 3118 IF(X.LT.KMIN)THEN 3119 X=0 3120 ENDIF 3121 ENDIF 3122 IF((ACC+X).GT.NCB) X=NCB-ACC 3123 ENDIF 3124 NB_ROWS(i)=X 3125 ACC=ACC+X 3126 CHOSEN=CHOSEN+1 3127 IF(SMP)THEN 3128 IF(MIN_LOAD.GT.TEMP(i))THEN 3129 MIN_LOAD=TEMP(i) 3130 POS_MIN_LOAD=i 3131 ENDIF 3132 ENDIF 3133 TMP_SUM=MAX_LOAD 3134 IF(K50.EQ.0)THEN 3135 MAX_LOAD=max(MAX_LOAD, 3136 & (TEMP(i)+(dble(NELIM) * 3137 & dble(NB_ROWS(i)))+ 3138 & (dble(NB_ROWS(i))*dble(NELIM)* 3139 & dble(2*NFRONT-NELIM-1)))) 3140 ELSE 3141 MAX_LOAD=max(MAX_LOAD, 3142 & TEMP(i)+(dble(NELIM) * dble(NB_ROWS(i)))* 3143 & dble(2*(NELIM+ACC)-NB_ROWS(i) 3144 & -NELIM+1)) 3145 ENDIF 3146 IF(TMP_SUM.LT.MAX_LOAD)THEN 3147 ENDIF 3148 IF(NCB-ACC.LT.KMIN) GOTO 888 3149 IF(NCB.EQ.ACC) GOTO 888 3150 IF(ACC.GT.NCB) THEN 3151 WRITE(*,*)MYID, 3152 & ': Internal error 2 in CMUMPS_518' 3153 CALL MUMPS_ABORT() 3154 ENDIF 3155 ENDDO 3156 888 CONTINUE 3157 SOMME=dble(0) 3158 X=NFRONT-NCB 3159 IF((ACC.GT.NCB))THEN 3160 WRITE(*,*)MYID, 3161 & ': Internal error 3 in CMUMPS_518' 3162 CALL MUMPS_ABORT() 3163 ENDIF 3164 IF((ACC.LT.NCB))THEN 3165 IF(K50.NE.0)THEN 3166 IF(SMALL_SET.LE.OTHERS)THEN 3167 IF((NB_SAT.EQ.SMALL_SET).AND.(SMALL_SET.LT. 3168 & NSLAVES_REF))THEN 3169 SMALL_SET=REF+1 3170 REF=REF+1 3171 NB_ROWS=0 3172 GOTO 323 3173 ENDIF 3174 ADDITIONNAL_ROWS_SPECIAL=NCB-ACC 3175 DO i=1,SMALL_SET 3176 MAX_LOAD=TEMP_MAX_LOAD 3177 ADDITIONNAL_ROWS=NCB-ACC 3178 SOMME=dble(NELIM)* 3179 & dble(ADDITIONNAL_ROWS)* 3180 & dble(2*NFRONT-ADDITIONNAL_ROWS-NELIM 3181 & +1) 3182 SOMME=SOMME/dble(SMALL_SET-NB_SAT) 3183 NB_ROWS=0 3184 NB_ZERO=0 3185 ACC=0 3186 CHOSEN=0 3187 NB_SAT=0 3188 IF(SMP)THEN 3189 MIN_LOAD=TEMP(1) 3190 POS_MIN_LOAD=1 3191 ENDIF 3192 DO J=1,SMALL_SET 3193 A=dble(1) 3194 B=dble(ACC+2) 3195 C=-BUF_SIZE+dble(ACC+NELIM) 3196 DELTA=(B*B)-(dble(4)*A*C) 3197 X=int((-B+sqrt(DELTA))/(dble(2)*A)) 3198 IF(X.GT.NCB-ACC) X=NCB-ACC 3199 BANDE_K821=dble(X)*dble(NELIM+ACC+X) 3200 IF(HAVE_TYPE1_SON)THEN 3201 A=dble(1) 3202 B=dble(ACC+2+NELIM) 3203 C=-BUF_SIZE+dble(ACC+NELIM) 3204 DELTA=(B*B)-(dble(4)*A*C) 3205 X=int((-B+sqrt(DELTA))/(dble(2)*A)) 3206 IF(X.GT.NCB-ACC) X=NCB-ACC 3207 BANDE_K821=dble(X)*dble(NELIM+ACC+X) 3208 ENDIF 3209 MAX_MEM_ALLOW=BANDE_K821 3210 IF(BDC_MD)THEN 3211 MAX_MEM_ALLOW=min( 3212 & min(MEM_SIZE_WEAK(J),MEM_SIZE_STRONG(J)), 3213 & BANDE_K821) 3214 MAX_MEM_ALLOW=max(dble(0), 3215 & MAX_MEM_ALLOW) 3216 ENDIF 3217 A=dble(1) 3218 B=dble(ACC+NELIM) 3219 C=dble(-MAX_MEM_ALLOW) 3220 DELTA=((B*B)-(dble(4)*A*C)) 3221 KMAX=int((-B+sqrt(DELTA))/(dble(2)*A)) 3222 A=dble(NELIM) 3223 B=(dble(NELIM)*dble(NELIM+2*ACC+1)) 3224 C=-(MAX_LOAD-TEMP(J)+SOMME) 3225 DELTA=(B*B-(dble(4)*A*C)) 3226 X=int((-B+sqrt(DELTA))/(dble(2)*A)) 3227 X=X+1 3228 IF(X.LT.0) THEN 3229 WRITE(*,*)MYID, 3230 & ': Internal error 4 in CMUMPS_518' 3231 CALL MUMPS_ABORT() 3232 ENDIF 3233 IF(X.GE.KMAX)THEN 3234 IF(KMAX.GE.KMIN)THEN 3235 X=KMAX 3236 NB_SAT=NB_SAT+1 3237 ELSE 3238 NB_ZERO=NB_ZERO+1 3239 X=0 3240 ENDIF 3241 ELSE 3242 IF(X.LT.min(KMIN,KMAX))THEN 3243 NB_ZERO=NB_ZERO+1 3244 X=0 3245 ENDIF 3246 ENDIF 3247 IF((ACC+X).GT.NCB) X=NCB-ACC 3248 NB_ROWS(J)=X 3249 IF(SMP)THEN 3250 IF(MIN_LOAD.GT.TEMP(J))THEN 3251 MIN_LOAD=TEMP(J) 3252 POS_MIN_LOAD=i 3253 ENDIF 3254 ENDIF 3255 CHOSEN=CHOSEN+1 3256 ACC=ACC+X 3257 TMP_SUM=MAX_LOAD 3258 TEMP_MAX_LOAD=max(TEMP_MAX_LOAD, 3259 & TEMP(J)+(dble(NELIM) * 3260 & dble(NB_ROWS(J)))* 3261 & dble(2*(NELIM+ 3262 & ACC)-NB_ROWS(J) 3263 & -NELIM+1)) 3264 IF(REF.LE.NUMBER_OF_PROCS-1)THEN 3265 IF(TEMP_MAX_LOAD.GT.TEMP(REF+1))THEN 3266 IF(SMALL_SET.LT.NSLAVES_REF)THEN 3267 SMALL_SET=REF+1 3268 REF=REF+1 3269 NB_ROWS=0 3270 GOTO 323 3271 ENDIF 3272 ENDIF 3273 ENDIF 3274 IF(NCB.EQ.ACC) GOTO 666 3275 ENDDO 3276 IF(NB_SAT.EQ.SMALL_SET)THEN 3277 IF(SMALL_SET.LT.NSLAVES_REF)THEN 3278 SMALL_SET=REF+1 3279 REF=REF+1 3280 NB_ROWS=0 3281 GOTO 323 3282 ELSE 3283 GOTO 434 3284 ENDIF 3285 ENDIF 3286 IF(NB_ZERO.EQ.SMALL_SET)THEN 3287 IF(SMALL_SET.LT.NSLAVES_REF)THEN 3288 SMALL_SET=REF+1 3289 REF=REF+1 3290 NB_ROWS=0 3291 GOTO 323 3292 ELSE 3293 GOTO 434 3294 ENDIF 3295 ENDIF 3296 IF((NB_SAT+NB_ZERO).EQ.SMALL_SET)THEN 3297 IF(SMALL_SET.LT.NSLAVES_REF)THEN 3298 SMALL_SET=REF+1 3299 REF=REF+1 3300 NB_ROWS=0 3301 GOTO 323 3302 ELSE 3303 GOTO 434 3304 ENDIF 3305 ENDIF 3306 ENDDO 3307 434 CONTINUE 3308 ADDITIONNAL_ROWS=NCB-ACC 3309 IF(ADDITIONNAL_ROWS.NE.0)THEN 3310 IF(ADDITIONNAL_ROWS.LT.KMIN)THEN 3311 i=CHOSEN 3312 J=ACC 3313 436 CONTINUE 3314 IF(NB_ROWS(i).NE.0)THEN 3315 J=J-NB_ROWS(i) 3316 A=dble(1) 3317 B=dble(J+2) 3318 C=-BUF_SIZE+dble(J+NELIM) 3319 DELTA=(B*B)-(dble(4)*A*C) 3320 X=int((-B+sqrt(DELTA))/(dble(2)*A)) 3321 IF(X.GT.NCB-J) X=NCB-J 3322 BANDE_K821=dble(X)*dble(NELIM+J+X) 3323 IF(HAVE_TYPE1_SON)THEN 3324 A=dble(1) 3325 B=dble(J+2+NELIM) 3326 C=-BUF_SIZE+dble(J+NELIM) 3327 DELTA=(B*B)-(dble(4)*A*C) 3328 X=int((-B+sqrt(DELTA))/(dble(2)*A)) 3329 IF(X.GT.NCB-J) X=NCB-J 3330 BANDE_K821=dble(X)*dble(NELIM+J+X) 3331 ENDIF 3332 MAX_MEM_ALLOW=BANDE_K821 3333 IF(BDC_MD)THEN 3334 MAX_MEM_ALLOW=min( 3335 & min(MEM_SIZE_WEAK(i),MEM_SIZE_STRONG(i)), 3336 & BANDE_K821) 3337 MAX_MEM_ALLOW=max(dble(0), 3338 & MAX_MEM_ALLOW) 3339 ENDIF 3340 A=dble(1) 3341 B=dble(J+NELIM) 3342 C=dble(-MAX_MEM_ALLOW) 3343 DELTA=((B*B)-(dble(4)*A*C)) 3344 KMAX=int((-B+sqrt(DELTA))/(dble(2)*A)) 3345 IF(NB_ROWS(i).NE.KMAX)THEN 3346 IF(NCB-J.LE.KMAX)THEN 3347 NB_ROWS(i)=+NCB-J 3348 ADDITIONNAL_ROWS=0 3349 ENDIF 3350 ENDIF 3351 TEMP_MAX_LOAD=max(TEMP_MAX_LOAD, 3352 & TEMP(i)+ 3353 & (dble(NELIM) * dble(NB_ROWS(i)))* 3354 & dble(2*(NELIM+ 3355 & ACC)-NB_ROWS(i) 3356 & -NELIM+1)) 3357 IF(REF.LE.NUMBER_OF_PROCS-1)THEN 3358 IF(TEMP_MAX_LOAD.GT.TEMP(REF+1))THEN 3359 IF(SMALL_SET.LT.NSLAVES_REF)THEN 3360 SMALL_SET=REF+1 3361 REF=REF+1 3362 NB_ROWS=0 3363 GOTO 323 3364 ENDIF 3365 ENDIF 3366 ENDIF 3367 ELSE 3368 i=i-1 3369 IF(i.NE.0)GOTO 436 3370 ENDIF 3371 IF(ADDITIONNAL_ROWS.NE.0)THEN 3372 i=CHOSEN 3373 IF(i.NE.SMALL_SET)THEN 3374 i=i+1 3375 IF(NB_ROWS(i).NE.0)THEN 3376 WRITE(*,*)MYID, 3377 & ': Internal error 5 in CMUMPS_518' 3378 CALL MUMPS_ABORT() 3379 ENDIF 3380 ENDIF 3381 NB_ROWS(i)=NB_ROWS(i)+ADDITIONNAL_ROWS 3382 ADDITIONNAL_ROWS=0 3383 ENDIF 3384 CHOSEN=i 3385 ENDIF 3386 ENDIF 3387 i=CHOSEN+1 3388 DO WHILE ((ADDITIONNAL_ROWS.NE.0) 3389 & .AND.(i.LE.NUMBER_OF_PROCS)) 3390 IF((TEMP(i).LE.MAX_LOAD))THEN 3391 A=dble(1) 3392 B=dble(ACC+2) 3393 C=-BUF_SIZE+dble(ACC+NELIM) 3394 DELTA=(B*B)-(dble(4)*A*C) 3395 X=int((-B+sqrt(DELTA))/(dble(2)*A)) 3396 IF(X.GT.NCB-ACC) X=NCB-ACC 3397 BANDE_K821=dble(X)*dble(NELIM+ACC+X) 3398 IF(HAVE_TYPE1_SON)THEN 3399 A=dble(1) 3400 B=dble(ACC+2+NELIM) 3401 C=-BUF_SIZE+dble(ACC+NELIM) 3402 DELTA=(B*B)-(dble(4)*A*C) 3403 X=int((-B+sqrt(DELTA))/(dble(2)*A)) 3404 IF(X.GT.NCB-ACC) X=NCB-ACC 3405 BANDE_K821=dble(X)*dble(NELIM+ACC+X) 3406 ENDIF 3407 MAX_MEM_ALLOW=BANDE_K821 3408 IF(BDC_MD)THEN 3409 MAX_MEM_ALLOW=min( 3410 & min(MEM_SIZE_WEAK(i),MEM_SIZE_STRONG(i)), 3411 & BANDE_K821) 3412 MAX_MEM_ALLOW=max(dble(0), 3413 & MAX_MEM_ALLOW) 3414 ENDIF 3415 A=dble(1) 3416 B=dble(ACC+NELIM) 3417 C=dble(-MAX_MEM_ALLOW) 3418 DELTA=((B*B)-(dble(4)*A*C)) 3419 KMAX=int((-B+sqrt(DELTA))/(dble(2)*A)) 3420 A=dble(NELIM) 3421 B=dble(NELIM)*dble(NELIM+2*ACC+1) 3422 C=-(MAX_LOAD-TEMP(i)) 3423 DELTA=(B*B-(dble(4)*A*C)) 3424 X=int((-B+sqrt(DELTA))/(dble(2)*A)) 3425 IF(X.GE.KMAX)THEN 3426 IF(KMAX.GE.KMIN)THEN 3427 X=KMAX 3428 ELSE 3429 X=0 3430 ENDIF 3431 ELSE 3432 IF(X.LT.KMIN)THEN 3433 X=0 3434 ENDIF 3435 ENDIF 3436 IF((ACC+X).GT.NCB) X=NCB-ACC 3437 NB_ROWS(i)=X 3438 ACC=ACC+X 3439 ADDITIONNAL_ROWS=NCB-ACC 3440 ELSE IF((TEMP(i).GT.MAX_LOAD))THEN 3441 MAX_LOAD=TEMP(i) 3442 NB_SAT=0 3443 ACC=0 3444 NB_ROWS=0 3445 DO J=1,i 3446 A=dble(1) 3447 B=dble(ACC+2) 3448 C=-BUF_SIZE+dble(ACC+NELIM) 3449 DELTA=(B*B)-(dble(4)*A*C) 3450 X=int((-B+sqrt(DELTA))/(dble(2)*A)) 3451 IF(X.GT.NCB-ACC) X=NCB-ACC 3452 BANDE_K821=dble(X)*dble(NELIM+ACC+X) 3453 IF(HAVE_TYPE1_SON)THEN 3454 A=dble(1) 3455 B=dble(ACC+2+NELIM) 3456 C=-BUF_SIZE+dble(ACC+NELIM) 3457 DELTA=(B*B)-(dble(4)*A*C) 3458 X=int((-B+sqrt(DELTA))/(dble(2)*A)) 3459 IF(X.GT.NCB-ACC) X=NCB-ACC 3460 BANDE_K821=dble(X)*dble(NELIM+ACC+X) 3461 ENDIF 3462 MAX_MEM_ALLOW=BANDE_K821 3463 IF(BDC_MD)THEN 3464 MAX_MEM_ALLOW=min( 3465 & min(MEM_SIZE_WEAK(J),MEM_SIZE_STRONG(J)), 3466 & BANDE_K821) 3467 MAX_MEM_ALLOW=max(dble(0), 3468 & MAX_MEM_ALLOW) 3469 ENDIF 3470 A=dble(1) 3471 B=dble(ACC+NELIM) 3472 C=dble(-MAX_MEM_ALLOW) 3473 DELTA=((B*B)-(dble(4)*A*C)) 3474 KMAX=int((-B+sqrt(DELTA))/(dble(2)*A)) 3475 A=dble(NELIM) 3476 B=dble(NELIM)*dble(NELIM+2*ACC+1) 3477 C=-(MAX_LOAD-TEMP(J)) 3478 DELTA=(B*B-(dble(4)*A*C)) 3479 X=int((-B+sqrt(DELTA))/(dble(2)*A)) 3480 IF(X.LT.0) THEN 3481 WRITE(*,*)MYID, 3482 & ': Internal error 6 in CMUMPS_518' 3483 CALL MUMPS_ABORT() 3484 ENDIF 3485 IF(X.GE.KMAX)THEN 3486 IF(KMAX.GE.KMIN)THEN 3487 X=KMAX 3488 NB_SAT=NB_SAT+1 3489 ELSE 3490 X=0 3491 ENDIF 3492 ELSE 3493 IF(X.LT.min(KMIN,KMAX))THEN 3494 X=0 3495 ENDIF 3496 ENDIF 3497 IF((ACC+X).GT.NCB) X=NCB-ACC 3498 NB_ROWS(J)=X 3499 IF(SMP)THEN 3500 IF(MIN_LOAD.GT.TEMP(J))THEN 3501 MIN_LOAD=TEMP(J) 3502 POS_MIN_LOAD=i 3503 ENDIF 3504 ENDIF 3505 ACC=ACC+X 3506 MAX_LOAD=max(MAX_LOAD, 3507 & TEMP(J)+ 3508 & (dble(NELIM)*dble(NB_ROWS(J)))* 3509 & dble(2*(NELIM+ 3510 & ACC)-NB_ROWS(J) 3511 & -NELIM+1)) 3512 IF(NCB.EQ.ACC) GOTO 741 3513 IF(NCB-ACC.LT.KMIN) GOTO 210 3514 ENDDO 3515 210 CONTINUE 3516 ENDIF 3517 741 CONTINUE 3518 i=i+1 3519 ADDITIONNAL_ROWS=NCB-ACC 3520 ENDDO 3521 CHOSEN=i-1 3522 IF(ADDITIONNAL_ROWS.NE.0)THEN 3523 ADDITIONNAL_ROWS=NCB-ACC 3524 SOMME=dble(NELIM)*dble(ADDITIONNAL_ROWS)* 3525 & dble(2*NFRONT-ADDITIONNAL_ROWS- 3526 & NELIM+1) 3527 SOMME=SOMME/dble(NUMBER_OF_PROCS) 3528 NB_ROWS=0 3529 ACC=0 3530 CHOSEN=0 3531 IF(SMP)THEN 3532 MIN_LOAD=TEMP(1) 3533 POS_MIN_LOAD=1 3534 ENDIF 3535 DO i=1,OTHERS 3536 A=dble(1) 3537 B=dble(ACC+2) 3538 C=-BUF_SIZE+dble(ACC+NELIM) 3539 DELTA=(B*B)-(dble(4)*A*C) 3540 X=int((-B+sqrt(DELTA))/(dble(2)*A)) 3541 IF(X.GT.NCB-ACC) X=NCB-ACC 3542 BANDE_K821=dble(X)*dble(NELIM+ACC+X) 3543 IF(HAVE_TYPE1_SON)THEN 3544 A=dble(1) 3545 B=dble(ACC+2+NELIM) 3546 C=-BUF_SIZE+dble(ACC+NELIM) 3547 DELTA=(B*B)-(dble(4)*A*C) 3548 X=int((-B+sqrt(DELTA))/(dble(2)*A)) 3549 IF(X.GT.NCB-ACC) X=NCB-ACC 3550 BANDE_K821=dble(X)*dble(NELIM+ACC+X) 3551 ENDIF 3552 MAX_MEM_ALLOW=BANDE_K821 3553 IF(BDC_MD)THEN 3554 MAX_MEM_ALLOW=min( 3555 & min(MEM_SIZE_WEAK(i),MEM_SIZE_STRONG(i)), 3556 & BANDE_K821) 3557 MAX_MEM_ALLOW=max(dble(0), 3558 & MAX_MEM_ALLOW) 3559 ENDIF 3560 A=dble(1) 3561 B=dble(ACC+NELIM) 3562 C=dble(-MAX_MEM_ALLOW) 3563 DELTA=((B*B)-(dble(4)*A*C)) 3564 KMAX=int((-B+sqrt(DELTA))/(dble(2)*A)) 3565 A=dble(NELIM) 3566 B=dble(NELIM)*dble(NELIM+2*ACC+1) 3567 C=-(MAX_LOAD-TEMP(i)+SOMME) 3568 DELTA=(B*B-(dble(4)*A*C)) 3569 X=int((-B+sqrt(DELTA))/(dble(2)*A)) 3570 IF(X.LT.0) THEN 3571 WRITE(*,*)MYID, 3572 & ': Internal error 7 in CMUMPS_518' 3573 CALL MUMPS_ABORT() 3574 ENDIF 3575 IF(X.GE.KMAX)THEN 3576 IF(KMAX.GE.KMIN)THEN 3577 X=KMAX 3578 ELSE 3579 X=0 3580 ENDIF 3581 ELSE 3582 IF(X.LT.min(KMIN,KMAX))THEN 3583 X=min(KMAX,KMIN) 3584 ENDIF 3585 ENDIF 3586 IF((ACC+X).GT.NCB) X=NCB-ACC 3587 NB_ROWS(i)=X 3588 IF(SMP)THEN 3589 IF(MIN_LOAD.GT.TEMP(i))THEN 3590 MIN_LOAD=TEMP(i) 3591 POS_MIN_LOAD=i 3592 ENDIF 3593 ENDIF 3594 CHOSEN=CHOSEN+1 3595 ACC=ACC+X 3596 IF(NCB.EQ.ACC) GOTO 666 3597 IF(NCB-ACC.LT.KMIN) GOTO 488 3598 ENDDO 3599 488 CONTINUE 3600 ADDITIONNAL_ROWS=NCB-ACC 3601 SOMME=dble(NELIM)* 3602 & dble(ADDITIONNAL_ROWS)* 3603 & dble(2*NFRONT-ADDITIONNAL_ROWS- 3604 & NELIM+1) 3605 SOMME=SOMME/dble(NUMBER_OF_PROCS) 3606 NB_ROWS=0 3607 ACC=0 3608 CHOSEN=0 3609 IF(SMP)THEN 3610 MIN_LOAD=TEMP(1) 3611 POS_MIN_LOAD=1 3612 ENDIF 3613 DO i=1,OTHERS 3614 A=dble(1) 3615 B=dble(ACC+2) 3616 C=-BUF_SIZE+dble(ACC+NELIM) 3617 DELTA=(B*B)-(dble(4)*A*C) 3618 X=int((-B+sqrt(DELTA))/(dble(2)*A)) 3619 IF(X.GT.NCB-ACC) X=NCB-ACC 3620 BANDE_K821=dble(X)*dble(NELIM+ACC+X) 3621 IF(HAVE_TYPE1_SON)THEN 3622 A=dble(1) 3623 B=dble(ACC+2+NELIM) 3624 C=-BUF_SIZE+dble(ACC+NELIM) 3625 DELTA=(B*B)-(dble(4)*A*C) 3626 X=int((-B+sqrt(DELTA))/(dble(2)*A)) 3627 IF(X.GT.NCB-ACC) X=NCB-ACC 3628 BANDE_K821=dble(X)*dble(NELIM+ACC+X) 3629 ENDIF 3630 MAX_MEM_ALLOW=BANDE_K821 3631 IF(BDC_MD)THEN 3632 MAX_MEM_ALLOW=min(BANDE_K821, 3633 & MEM_SIZE_STRONG(i)) 3634 MAX_MEM_ALLOW=max(dble(0), 3635 & MAX_MEM_ALLOW) 3636 ENDIF 3637 A=dble(1) 3638 B=dble(ACC+NELIM) 3639 C=dble(-MAX_MEM_ALLOW) 3640 DELTA=((B*B)-(dble(4)*A*C)) 3641 KMAX=int((-B+sqrt(DELTA))/(dble(2)*A)) 3642 A=dble(NELIM) 3643 B=dble(NELIM)*dble(NELIM+2*ACC+1) 3644 C=-(MAX_LOAD-TEMP(i)+SOMME) 3645 DELTA=(B*B-(dble(4)*A*C)) 3646 X=int((-B+sqrt(DELTA))/(dble(2)*A)) 3647 IF(X.LT.0) THEN 3648 WRITE(*,*)MYID, 3649 & ': Internal error 8 in CMUMPS_518' 3650 CALL MUMPS_ABORT() 3651 ENDIF 3652 IF(X.GE.KMAX)THEN 3653 X=KMAX 3654 ELSE 3655 IF(X.LT.KMIN)THEN 3656 X=KMIN 3657 ENDIF 3658 ENDIF 3659 IF((ACC+X).GT.NCB) X=NCB-ACC 3660 NB_ROWS(i)=X 3661 IF(SMP)THEN 3662 IF(MIN_LOAD.GT.TEMP(i))THEN 3663 MIN_LOAD=TEMP(i) 3664 POS_MIN_LOAD=i 3665 ENDIF 3666 ENDIF 3667 CHOSEN=CHOSEN+1 3668 ACC=ACC+X 3669 IF(NCB.EQ.ACC) GOTO 666 3670 IF(NCB-ACC.LT.KMIN) GOTO 477 3671 ENDDO 3672 477 CONTINUE 3673 IF(ACC.NE.NCB)THEN 3674 NB_SAT=0 3675 ACC=0 3676 CHOSEN=0 3677 IF(SMP)THEN 3678 MIN_LOAD=TEMP(1) 3679 POS_MIN_LOAD=1 3680 ENDIF 3681 DO i=1,OTHERS 3682 A=dble(1) 3683 B=dble(ACC+2) 3684 C=-BUF_SIZE+dble(ACC+NELIM) 3685 DELTA=(B*B)-(dble(4)*A*C) 3686 X=int((-B+sqrt(DELTA))/(dble(2)*A)) 3687 IF(X.GT.NCB-ACC) X=NCB-ACC 3688 BANDE_K821=dble(X)*dble(NELIM+ACC+X) 3689 IF(HAVE_TYPE1_SON)THEN 3690 A=dble(1) 3691 B=dble(ACC+2+NELIM) 3692 C=-BUF_SIZE+dble(ACC+NELIM) 3693 DELTA=(B*B)-(dble(4)*A*C) 3694 X=int((-B+sqrt(DELTA))/(dble(2)*A)) 3695 IF(X.GT.NCB-ACC) X=NCB-ACC 3696 BANDE_K821=dble(X)*dble(NELIM+ACC+X) 3697 ENDIF 3698 MAX_MEM_ALLOW=BANDE_K821 3699 IF(BDC_MD)THEN 3700 MAX_MEM_ALLOW=min(BANDE_K821, 3701 & MEM_SIZE_STRONG(i)) 3702 MAX_MEM_ALLOW=max(dble(0), 3703 & MAX_MEM_ALLOW) 3704 ENDIF 3705 A=dble(1) 3706 B=dble(ACC+NELIM) 3707 C=dble(-MAX_MEM_ALLOW) 3708 DELTA=((B*B)-(dble(4)*A*C)) 3709 KMAX=int((-B+sqrt(DELTA))/(dble(2)*A)) 3710 X=KMAX-NB_ROWS(i) 3711 IF((ACC+NB_ROWS(i)+X).GT.NCB) 3712 & X=NCB-(ACC+NB_ROWS(i)) 3713 NB_ROWS(i)=NB_ROWS(i)+X 3714 IF((dble(NB_ROWS(i))* 3715 & dble(NB_ROWS(i)+ACC)).EQ. 3716 & BANDE_K821)THEN 3717 NB_SAT=NB_SAT+1 3718 ENDIF 3719 ACC=ACC+NB_ROWS(i) 3720 IF(SMP)THEN 3721 IF(MIN_LOAD.GT.TEMP(i))THEN 3722 MIN_LOAD=TEMP(i) 3723 POS_MIN_LOAD=i 3724 ENDIF 3725 ENDIF 3726 CHOSEN=CHOSEN+1 3727 IF(NCB.EQ.ACC) GOTO 666 3728 IF(NCB-ACC.LT.KMIN) GOTO 834 3729 ENDDO 3730 834 CONTINUE 3731 ENDIF 3732 IF(ACC.NE.NCB)THEN 3733 ADDITIONNAL_ROWS=NCB-ACC 3734 SOMME=dble(NELIM)* 3735 & dble(ADDITIONNAL_ROWS)* 3736 & dble(2*NFRONT-ADDITIONNAL_ROWS- 3737 & NELIM+1) 3738 SOMME=SOMME/dble(NUMBER_OF_PROCS-NB_SAT) 3739 ACC=0 3740 DO i=1,CHOSEN 3741 A=dble(1) 3742 B=dble(ACC+2) 3743 C=-BUF_SIZE+dble(ACC+NELIM) 3744 DELTA=(B*B)-(dble(4)*A*C) 3745 X=int((-B+sqrt(DELTA))/(dble(2)*A)) 3746 IF(X.GT.NCB-ACC) X=NCB-ACC 3747 BANDE_K821=dble(X)*dble(NELIM+ACC+X) 3748 IF(HAVE_TYPE1_SON)THEN 3749 A=dble(1) 3750 B=dble(ACC+2+NELIM) 3751 C=-BUF_SIZE+dble(ACC+NELIM) 3752 DELTA=(B*B)-(dble(4)*A*C) 3753 X=int((-B+sqrt(DELTA))/(dble(2)*A)) 3754 IF(X.GT.NCB-ACC) X=NCB-ACC 3755 BANDE_K821=dble(X)*dble(NELIM+ACC+X) 3756 ENDIF 3757 IF((dble(NB_ROWS(i))* 3758 & dble(NB_ROWS(i)+ACC)).EQ. 3759 & BANDE_K821)THEN 3760 GOTO 102 3761 ENDIF 3762 A=dble(NELIM) 3763 B=dble(NELIM)* 3764 & dble(NELIM+2*(ACC+NB_ROWS(i))+1) 3765 C=-(SOMME) 3766 DELTA=(B*B-(dble(4)*A*C)) 3767 X=int((-B+sqrt(DELTA))/(dble(2)*A)) 3768 A=dble(1) 3769 B=dble(ACC+NELIM) 3770 C=dble(-BANDE_K821) 3771 DELTA=((B*B)-(dble(4)*A*C)) 3772 KMAX=int((-B+sqrt(DELTA))/(dble(2)*A)) 3773 IF(X.LT.0) THEN 3774 WRITE(*,*)MYID, 3775 & ': Internal error 9 in CMUMPS_518' 3776 CALL MUMPS_ABORT() 3777 ENDIF 3778 IF((ACC+X+NB_ROWS(i)).GT.NCB)THEN 3779 IF((NCB-ACC).GT.KMAX)THEN 3780 NB_ROWS(i)=KMAX 3781 ELSE 3782 NB_ROWS(i)=NCB-ACC 3783 ENDIF 3784 ELSE 3785 IF((NB_ROWS(i)+X).GT.KMAX)THEN 3786 NB_ROWS(i)=KMAX 3787 ELSE 3788 NB_ROWS(i)=NB_ROWS(i)+X 3789 ENDIF 3790 ENDIF 3791 102 CONTINUE 3792 ACC=ACC+NB_ROWS(i) 3793 IF(NCB.EQ.ACC) THEN 3794 CHOSEN=i 3795 GOTO 666 3796 ENDIF 3797 IF(NCB-ACC.LT.KMIN) THEN 3798 CHOSEN=i 3799 GOTO 007 3800 ENDIF 3801 ENDDO 3802 007 CONTINUE 3803 DO i=1,CHOSEN 3804 NB_ROWS(i)=NB_ROWS(i)+1 3805 ACC=ACC+1 3806 IF(ACC.EQ.NCB)GOTO 666 3807 ENDDO 3808 IF(ACC.LT.NCB)THEN 3809 IF(SMP)THEN 3810 NB_ROWS(1)=NB_ROWS(1)+NCB-ACC 3811 ELSE 3812 NB_ROWS(POS_MIN_LOAD)= 3813 & NB_ROWS(POS_MIN_LOAD)+NCB-ACC 3814 ENDIF 3815 ENDIF 3816 ENDIF 3817 GOTO 666 3818 ENDIF 3819 ENDIF 3820 GOTO 666 3821 ENDIF 3822 ADDITIONNAL_ROWS=NCB-ACC 3823 i=CHOSEN+1 3824 IF(NB_SAT.EQ.SMALL_SET) GOTO 777 3825 DO i=1,SMALL_SET 3826 IDWLOAD(i)=i 3827 AFFECTED=int(BUF_SIZE/dble(NCB+1))-1 3828 BANDE_K821=dble(AFFECTED)*dble(NFRONT) 3829 IF(HAVE_TYPE1_SON)THEN 3830 AFFECTED=int((BUF_SIZE-dble(NFRONT))/ 3831 & (dble(NFRONT+1))) 3832 BANDE_K821=dble(AFFECTED)*dble(NFRONT) 3833 ENDIF 3834 MAX_MEM_ALLOW=BANDE_K821 3835 IF(BDC_MD)THEN 3836 MAX_MEM_ALLOW=min( 3837 & min(MEM_SIZE_WEAK(i),MEM_SIZE_STRONG(i)), 3838 & BANDE_K821) 3839 MAX_MEM_ALLOW=max(dble(0),MAX_MEM_ALLOW) 3840 ENDIF 3841 WLOAD(i)=MAX_MEM_ALLOW 3842 ENDDO 3843 CALL MUMPS_558(SMALL_SET, WLOAD, IDWLOAD) 3844 NB_ZERO=0 3845 IF((NB_SAT.EQ.SMALL_SET).AND. 3846 & (SMALL_SET.LT.NSLAVES_REF))THEN 3847 SMALL_SET=REF+1 3848 REF=REF+1 3849 NB_ROWS=0 3850 GOTO 323 3851 ENDIF 3852 IF((NB_SAT.EQ.SMALL_SET).AND. 3853 & (SMALL_SET.LE.NUMBER_OF_PROCS))GOTO 777 3854 AFFECTED=int(ADDITIONNAL_ROWS/(SMALL_SET-NB_SAT)) 3855 AFFECTED=max(AFFECTED,1) 3856 DO i=1,SMALL_SET 3857 KMAX=int(WLOAD(i)/dble(NFRONT)) 3858 IF(NB_ROWS(IDWLOAD(i)).EQ.KMAX)THEN 3859 GOTO 912 3860 ENDIF 3861 IF((NB_ROWS(IDWLOAD(i))+min(AFFECTED, 3862 & ADDITIONNAL_ROWS)).GT.KMAX)THEN 3863 IF(NB_ROWS(IDWLOAD(i)).GT.KMAX)THEN 3864 ENDIF 3865 ADDITIONNAL_ROWS=ADDITIONNAL_ROWS- 3866 & (KMAX-NB_ROWS(IDWLOAD(i))) 3867 NB_ROWS(IDWLOAD(i))=KMAX 3868 NB_SAT=NB_SAT+1 3869 IF(NB_SAT.EQ.SMALL_SET)THEN 3870 IF(SMALL_SET.NE.NSLAVES_REF)THEN 3871 SMALL_SET=REF+1 3872 REF=REF+1 3873 NB_ROWS=0 3874 GOTO 323 3875 ELSE 3876 MAX_LOAD=max(MAX_LOAD, 3877 & (TEMP(IDWLOAD(i))+(dble(NELIM) * 3878 & dble(NB_ROWS(IDWLOAD(i))))+ 3879 & (dble(NB_ROWS(IDWLOAD(i)))* 3880 & dble(NELIM))* 3881 & dble(2*NFRONT-NELIM-1))) 3882 GOTO 777 3883 ENDIF 3884 ENDIF 3885 AFFECTED=int(ADDITIONNAL_ROWS/(SMALL_SET-NB_SAT)) 3886 AFFECTED=max(AFFECTED,1) 3887 ELSE 3888 IF((NB_ROWS(IDWLOAD(i))+min(AFFECTED, 3889 & ADDITIONNAL_ROWS)).GE.KMIN)THEN 3890 X=min(AFFECTED,ADDITIONNAL_ROWS) 3891 NB_ROWS(IDWLOAD(i))=NB_ROWS(IDWLOAD(i))+ 3892 & X 3893 ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-X 3894 ELSE 3895 X=int((MAX_LOAD-TEMP(IDWLOAD(i)))/ 3896 & (dble(NELIM)*dble(2*NFRONT-NELIM))) 3897 IF(X+AFFECTED.GT.ADDITIONNAL_ROWS)THEN 3898 X=ADDITIONNAL_ROWS 3899 ELSE 3900 X=AFFECTED+X 3901 ENDIF 3902 IF(X.GE.KMIN)THEN 3903 NB_ROWS(IDWLOAD(i))=NB_ROWS(IDWLOAD(i))+ 3904 & X 3905 ADDITIONNAL_ROWS=ADDITIONNAL_ROWS- 3906 & X 3907 ELSE 3908 NB_ZERO=NB_ZERO+1 3909 ENDIF 3910 ENDIF 3911 ENDIF 3912 912 CONTINUE 3913 MAX_LOAD=max(MAX_LOAD, 3914 & (TEMP(IDWLOAD(i))+(dble(NELIM)* 3915 & dble(NB_ROWS(IDWLOAD(i))))+ 3916 & (dble(NB_ROWS(IDWLOAD(i)))*dble(NELIM))* 3917 & dble(2*NFRONT-NELIM-1))) 3918 IF(SMALL_SET.LT.NUMBER_OF_PROCS)THEN 3919 IF(MAX_LOAD.GT.TEMP(SMALL_SET+1))THEN 3920 IF(SMALL_SET.LT.NSLAVES_REF)THEN 3921 SMALL_SET=REF+1 3922 REF=REF+1 3923 NB_ROWS=0 3924 GOTO 323 3925 ENDIF 3926 ENDIF 3927 ENDIF 3928 IF(SMALL_SET.EQ.NB_SAT)GOTO 777 3929 IF(ADDITIONNAL_ROWS.EQ.0)THEN 3930 CHOSEN=SMALL_SET 3931 GOTO 049 3932 ENDIF 3933 ENDDO 3934 777 CONTINUE 3935 IF((NB_ZERO.NE.0).AND.(ADDITIONNAL_ROWS.GE.KMIN))THEN 3936 J=NB_ZERO 3937 732 CONTINUE 3938 X=int(ADDITIONNAL_ROWS/(J)) 3939 IF(X.LT.KMIN)THEN 3940 J=J-1 3941 GOTO 732 3942 ENDIF 3943 IF(X*J.LT.ADDITIONNAL_ROWS)THEN 3944 X=X+1 3945 ENDIF 3946 DO i=1,SMALL_SET 3947 AFFECTED=int(BUF_SIZE/dble(NCB+1))-1 3948 BANDE_K821=dble(AFFECTED)*dble(NFRONT) 3949 IF(HAVE_TYPE1_SON)THEN 3950 AFFECTED=int((BUF_SIZE-dble(NFRONT))/ 3951 & dble(NFRONT+1)) 3952 BANDE_K821=dble(AFFECTED)*dble(NFRONT) 3953 ENDIF 3954 MAX_MEM_ALLOW=BANDE_K821 3955 IF(BDC_MD)THEN 3956 MAX_MEM_ALLOW=min( 3957 & min(MEM_SIZE_WEAK(i),MEM_SIZE_STRONG(i)), 3958 & dble(BANDE_K821)) 3959 MAX_MEM_ALLOW=max(dble(0),MAX_MEM_ALLOW) 3960 ENDIF 3961 KMAX=int(MAX_MEM_ALLOW/dble(NFRONT)) 3962 IF(NB_ROWS(i).EQ.0)THEN 3963 IF(X.GT.ADDITIONNAL_ROWS)THEN 3964 X=ADDITIONNAL_ROWS 3965 ENDIF 3966 IF(X.GT.KMAX)THEN 3967 X=KMAX 3968 ENDIF 3969 IF(X.GT.KMIN)THEN 3970 NB_ROWS(i)=X 3971 ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-X 3972 MAX_LOAD=max(MAX_LOAD, 3973 & (TEMP(i)+(dble(NELIM) * 3974 & dble(NB_ROWS(i)))+ 3975 & (dble(NB_ROWS(i))*dble(NELIM))* 3976 & dble(2*NFRONT-NELIM-1))) 3977 ENDIF 3978 ENDIF 3979 ENDDO 3980 ENDIF 3981 i=CHOSEN+1 3982 DO WHILE ((ADDITIONNAL_ROWS.NE.0) 3983 & .AND.(i.LE.NUMBER_OF_PROCS)) 3984 IF((TEMP(i).LE.MAX_LOAD))THEN 3985 AFFECTED=int(BUF_SIZE/dble(NCB+1))-1 3986 BANDE_K821=dble(AFFECTED)*dble(NFRONT) 3987 IF(HAVE_TYPE1_SON)THEN 3988 AFFECTED=int((BUF_SIZE-dble(NFRONT))/ 3989 & dble(NFRONT+1)) 3990 BANDE_K821=dble(AFFECTED)*dble(NFRONT) 3991 ENDIF 3992 MAX_MEM_ALLOW=BANDE_K821 3993 IF(BDC_MD)THEN 3994 MAX_MEM_ALLOW=min( 3995 & min(MEM_SIZE_WEAK(i),MEM_SIZE_STRONG(i)), 3996 & BANDE_K821) 3997 MAX_MEM_ALLOW=max(dble(0),MAX_MEM_ALLOW) 3998 ENDIF 3999 KMAX=int(MAX_MEM_ALLOW/dble(NFRONT)) 4000 AFFECTED=int((MAX_LOAD-TEMP(i))/ 4001 & (dble(NELIM)*dble(2*NFRONT-NELIM))) 4002 IF(AFFECTED.GT.ADDITIONNAL_ROWS)THEN 4003 AFFECTED=ADDITIONNAL_ROWS 4004 ENDIF 4005 IF(NB_ROWS(i).LT.KMAX)THEN 4006 IF((AFFECTED+NB_ROWS(i)).GT.KMAX)THEN 4007 AFFECTED=KMAX-NB_ROWS(i) 4008 NB_SAT=NB_SAT+1 4009 ELSE 4010 IF((AFFECTED+NB_ROWS(i)).LT. 4011 & KMIN)THEN 4012 AFFECTED=0 4013 ENDIF 4014 ENDIF 4015 NB_ROWS(i)=NB_ROWS(i)+AFFECTED 4016 ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-AFFECTED 4017 ENDIF 4018 ELSE IF((TEMP(i).GT.MAX_LOAD))THEN 4019 IF(NB_SAT.EQ.i-1) GOTO 218 4020 X=(ADDITIONNAL_ROWS/(i-1-NB_SAT)) 4021 ACC=1 4022 DO J=1,i-1 4023 TMP_SUM=((dble(NELIM) * dble(NB_ROWS(J)+X)) 4024 & +(dble(NB_ROWS(J)+X)*dble(NELIM))* 4025 & dble(2*NFRONT-NELIM-1)) 4026 IF((TEMP(J)+TMP_SUM).GT.MAX_LOAD)THEN 4027 ACC=0 4028 ENDIF 4029 ENDDO 4030 IF(ACC.EQ.1)THEN 4031 MAX_LOAD=TEMP(i) 4032 J=1 4033 DO WHILE ((ADDITIONNAL_ROWS.NE.0) 4034 & .AND.(J.LT.i)) 4035 AFFECTED=int(BUF_SIZE/dble(NCB+1))-1 4036 BANDE_K821=dble(AFFECTED)*dble(NFRONT) 4037 IF(HAVE_TYPE1_SON)THEN 4038 AFFECTED=int((BUF_SIZE-dble(NFRONT))/ 4039 & dble(NFRONT+1)) 4040 BANDE_K821=dble(AFFECTED)*dble(NFRONT) 4041 ENDIF 4042 AFFECTED=X 4043 MAX_MEM_ALLOW=BANDE_K821 4044 IF(BDC_MD)THEN 4045 MAX_MEM_ALLOW=min( 4046 & min(MEM_SIZE_WEAK(J),MEM_SIZE_STRONG(J)), 4047 & BANDE_K821) 4048 MAX_MEM_ALLOW=max(dble(0), 4049 & MAX_MEM_ALLOW) 4050 ENDIF 4051 KMAX=int(MAX_MEM_ALLOW/dble(NFRONT)) 4052 IF(AFFECTED.GT.ADDITIONNAL_ROWS)THEN 4053 AFFECTED=ADDITIONNAL_ROWS 4054 ENDIF 4055 IF(NB_ROWS(J).LT.KMAX)THEN 4056 IF((AFFECTED+NB_ROWS(J)).GT.KMAX)THEN 4057 AFFECTED=KMAX-NB_ROWS(J) 4058 NB_SAT=NB_SAT+1 4059 ELSE 4060 IF((AFFECTED+NB_ROWS(J)).LT. 4061 & KMIN)THEN 4062 AFFECTED=0 4063 ENDIF 4064 ENDIF 4065 NB_ROWS(J)=NB_ROWS(J)+AFFECTED 4066 ADDITIONNAL_ROWS=ADDITIONNAL_ROWS- 4067 & AFFECTED 4068 ENDIF 4069 J=J+1 4070 ENDDO 4071 ELSE 4072 MAX_LOAD=TEMP(i) 4073 J=1 4074 DO WHILE ((ADDITIONNAL_ROWS.NE.0) 4075 & .AND.(J.LT.i)) 4076 AFFECTED=int(BUF_SIZE/dble(NCB+1))-1 4077 BANDE_K821=dble(AFFECTED)*dble(NFRONT) 4078 IF(HAVE_TYPE1_SON)THEN 4079 AFFECTED=int((BUF_SIZE-dble(NFRONT))/ 4080 & dble(NFRONT+1)) 4081 BANDE_K821=dble(AFFECTED)*dble(NFRONT) 4082 ENDIF 4083 TMP_SUM=((dble(NELIM)* dble(NB_ROWS(J))) 4084 & +(dble(NB_ROWS(J))*dble(NELIM))* 4085 & dble(2*NFRONT-NELIM-1)) 4086 X=int((MAX_LOAD-(TEMP(J)+TMP_SUM))/ 4087 & (dble(NELIM)*dble(2*NFRONT-NELIM))) 4088 IF(X.LT.0)THEN 4089 WRITE(*,*)MYID, 4090 & ': Internal error 10 in CMUMPS_518' 4091 CALL MUMPS_ABORT() 4092 ENDIF 4093 AFFECTED=X 4094 MAX_MEM_ALLOW=BANDE_K821 4095 IF(BDC_MD)THEN 4096 MAX_MEM_ALLOW=min( 4097 & min(MEM_SIZE_WEAK(J),MEM_SIZE_STRONG(J)), 4098 & BANDE_K821) 4099 MAX_MEM_ALLOW=max(dble(0), 4100 & MAX_MEM_ALLOW) 4101 ENDIF 4102 KMAX=int(MAX_MEM_ALLOW/dble(NFRONT)) 4103 IF(AFFECTED.GT.ADDITIONNAL_ROWS)THEN 4104 AFFECTED=ADDITIONNAL_ROWS 4105 ENDIF 4106 IF(NB_ROWS(J).LT.KMAX)THEN 4107 IF((AFFECTED+NB_ROWS(J)).GT.KMAX)THEN 4108 AFFECTED=KMAX-NB_ROWS(J) 4109 NB_SAT=NB_SAT+1 4110 ELSE 4111 IF((AFFECTED+NB_ROWS(J)).LT. 4112 & KMIN)THEN 4113 AFFECTED=0 4114 ENDIF 4115 ENDIF 4116 NB_ROWS(J)=NB_ROWS(J)+AFFECTED 4117 ADDITIONNAL_ROWS=ADDITIONNAL_ROWS- 4118 & AFFECTED 4119 ENDIF 4120 J=J+1 4121 ENDDO 4122 ENDIF 4123 ENDIF 4124 218 CONTINUE 4125 i=i+1 4126 ENDDO 4127 CHOSEN=i-1 4128 IF((CHOSEN.EQ.NUMBER_OF_PROCS-1).AND. 4129 & (ADDITIONNAL_ROWS.NE.0))THEN 4130 DO i=1,CHOSEN 4131 IF(NB_ROWS(i)+1.GE.KMIN)THEN 4132 NB_ROWS(i)=NB_ROWS(i)+1 4133 ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-1 4134 ENDIF 4135 MAX_LOAD=max(MAX_LOAD, 4136 & (TEMP(i)+(dble(NELIM) * 4137 & dble(NB_ROWS(i)))+ 4138 & (dble(NB_ROWS(i))*dble(NELIM))* 4139 & dble(2*NFRONT-NELIM-1))) 4140 IF(ADDITIONNAL_ROWS.EQ.0) GOTO 048 4141 ENDDO 4142 048 CONTINUE 4143 ENDIF 4144 IF((ADDITIONNAL_ROWS.NE.0))THEN 4145 IF(CHOSEN.LT.NUMBER_OF_PROCS)THEN 4146 i=CHOSEN+1 4147 ELSE 4148 IF(CHOSEN.NE.NUMBER_OF_PROCS)THEN 4149 WRITE(*,*)MYID, 4150 & ': Internal error 11 in CMUMPS_518' 4151 CALL MUMPS_ABORT() 4152 ENDIF 4153 i=CHOSEN 4154 ENDIF 4155 DO WHILE ((ADDITIONNAL_ROWS.NE.0) 4156 & .AND.(i.LE.NUMBER_OF_PROCS)) 4157 IF(TEMP(i).LE.MAX_LOAD)THEN 4158 AFFECTED=int(BUF_SIZE/dble(NCB+1))-1 4159 BANDE_K821=dble(AFFECTED)*dble(NFRONT) 4160 IF(HAVE_TYPE1_SON)THEN 4161 AFFECTED=int((BUF_SIZE-dble(NFRONT))/ 4162 & dble(NFRONT+1)) 4163 BANDE_K821=dble(AFFECTED)*dble(NFRONT) 4164 ENDIF 4165 MAX_MEM_ALLOW=BANDE_K821 4166 IF(BDC_MD)THEN 4167 MAX_MEM_ALLOW=min( 4168 & min(MEM_SIZE_WEAK(i),MEM_SIZE_STRONG(i)), 4169 & BANDE_K821) 4170 MAX_MEM_ALLOW=max(dble(0),MAX_MEM_ALLOW) 4171 ENDIF 4172 KMAX=int(MAX_MEM_ALLOW/dble(NFRONT)) 4173 TMP_SUM=((dble(NELIM) * dble(NB_ROWS(i))) 4174 & +(dble(NB_ROWS(i))*dble(NELIM))* 4175 & dble(2*NFRONT-NELIM-1)) 4176 X=int((MAX_LOAD-(TEMP(i)+TMP_SUM))/ 4177 & (dble(NELIM)*dble(2*NFRONT-NELIM))) 4178 AFFECTED=X 4179 IF(X.LT.0)THEN 4180 WRITE(*,*)MYID, 4181 & ': Internal error 12 in CMUMPS_518' 4182 CALL MUMPS_ABORT() 4183 ENDIF 4184 IF(AFFECTED.GT.ADDITIONNAL_ROWS)THEN 4185 AFFECTED=ADDITIONNAL_ROWS 4186 ENDIF 4187 IF(NB_ROWS(i).LT.KMAX)THEN 4188 IF((AFFECTED+NB_ROWS(i)).GT.KMAX)THEN 4189 AFFECTED=KMAX-NB_ROWS(i) 4190 ELSE 4191 IF((AFFECTED+NB_ROWS(i)).LT. 4192 & KMIN)THEN 4193 AFFECTED=0 4194 ENDIF 4195 ENDIF 4196 NB_ROWS(i)=NB_ROWS(i)+AFFECTED 4197 ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-AFFECTED 4198 ENDIF 4199 IF(i.NE.NUMBER_OF_PROCS) GOTO 624 4200 ELSE IF((TEMP(i).GT.MAX_LOAD))THEN 4201 X=int(ADDITIONNAL_ROWS/i-1) 4202 X=max(X,1) 4203 IF((MAX_LOAD+((dble(NELIM)* 4204 & dble(X))+(dble( 4205 & X)*dble(NELIM))*dble( 4206 & (2*NFRONT-NELIM-1)))).LE.TEMP(i))THEN 4207 AFFECTED=X 4208 POS=1 4209 ELSE 4210 POS=0 4211 ENDIF 4212 MAX_LOAD=TEMP(i) 4213 J=1 4214 DO WHILE ((ADDITIONNAL_ROWS.NE.0) 4215 & .AND.(J.LT.i)) 4216 X=int(BUF_SIZE/dble(NCB+1))-1 4217 BANDE_K821=dble(X)*dble(NFRONT) 4218 MAX_MEM_ALLOW=BANDE_K821 4219 IF(HAVE_TYPE1_SON)THEN 4220 X=int((BUF_SIZE-dble(NFRONT))/ 4221 & dble(NFRONT+1)) 4222 BANDE_K821=dble(X)*dble(NFRONT) 4223 ENDIF 4224 IF(BDC_MD)THEN 4225 MAX_MEM_ALLOW=min( 4226 & min(MEM_SIZE_WEAK(J),MEM_SIZE_STRONG(J)), 4227 & BANDE_K821) 4228 MAX_MEM_ALLOW=max(dble(0), 4229 & MAX_MEM_ALLOW) 4230 ENDIF 4231 KMAX=int(MAX_MEM_ALLOW/dble(NFRONT)) 4232 IF(POS.EQ.0)THEN 4233 TMP_SUM=((dble(NELIM) * 4234 & dble(NB_ROWS(J))) 4235 & +(dble(NB_ROWS(J))*dble(NELIM))* 4236 & dble(2*NFRONT-NELIM-1)) 4237 X=int((TEMP(i)-(TEMP(J)+TMP_SUM))/ 4238 & (dble(NELIM)*dble(2*NFRONT- 4239 & NELIM))) 4240 ELSE 4241 X=int(TMP_SUM) 4242 ENDIF 4243 IF(X.GT.ADDITIONNAL_ROWS)THEN 4244 X=ADDITIONNAL_ROWS 4245 ENDIF 4246 IF(NB_ROWS(J).LT.KMAX)THEN 4247 IF((X+NB_ROWS(J)).GT.KMAX)THEN 4248 X=KMAX-NB_ROWS(J) 4249 ELSE 4250 IF((NB_ROWS(J)+X).LT. 4251 & KMIN)THEN 4252 X=0 4253 ENDIF 4254 ENDIF 4255 NB_ROWS(J)=NB_ROWS(J)+X 4256 ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-X 4257 ENDIF 4258 J=J+1 4259 ENDDO 4260 ENDIF 4261 624 CONTINUE 4262 i=i+1 4263 ENDDO 4264 CHOSEN=i-1 4265 IF(ADDITIONNAL_ROWS.NE.0)THEN 4266 ACC=0 4267 DO i=1,CHOSEN 4268 X=int(BUF_SIZE/dble(NCB+1))-1 4269 BANDE_K821=dble(X)*dble(NFRONT) 4270 IF(HAVE_TYPE1_SON)THEN 4271 X=int((BUF_SIZE-dble(NFRONT))/ 4272 & dble(NFRONT+1)) 4273 BANDE_K821=dble(X)*dble(NFRONT) 4274 ENDIF 4275 MAX_MEM_ALLOW=BANDE_K821 4276 IF(BDC_MD)THEN 4277 MAX_MEM_ALLOW=min( 4278 & min(MEM_SIZE_WEAK(i),MEM_SIZE_STRONG(i)), 4279 & BANDE_K821) 4280 MAX_MEM_ALLOW=max(dble(0),MAX_MEM_ALLOW) 4281 ENDIF 4282 KMAX=int(MAX_MEM_ALLOW/dble(NFRONT)) 4283 TMP_SUM=((dble(NELIM) * dble(NB_ROWS(i))) 4284 & +(dble(NB_ROWS(i))*dble(NELIM))* 4285 & dble(2*NFRONT-NELIM-1)) 4286 X=int((MAX_LOAD- 4287 & (TEMP(i)+TMP_SUM))/ 4288 & (dble(NELIM)*dble(2*NFRONT-NELIM))) 4289 IF(X.LT.0)THEN 4290 WRITE(*,*)MYID, 4291 & ': Internal error 13 in CMUMPS_518' 4292 CALL MUMPS_ABORT() 4293 ENDIF 4294 IF(X.GT.ADDITIONNAL_ROWS)THEN 4295 X=ADDITIONNAL_ROWS 4296 ENDIF 4297 IF(NB_ROWS(i).LT.KMAX)THEN 4298 IF((X+NB_ROWS(i)).GE.KMAX)THEN 4299 ADDITIONNAL_ROWS=ADDITIONNAL_ROWS- 4300 & (KMAX-NB_ROWS(i)) 4301 NB_ROWS(i)=KMAX 4302 ELSE 4303 IF((X+NB_ROWS(i)).GE. 4304 & KMIN)THEN 4305 NB_ROWS(i)=NB_ROWS(i)+X 4306 ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-X 4307 ACC=ACC+1 4308 ELSE 4309 ACC=ACC+1 4310 ENDIF 4311 ENDIF 4312 ENDIF 4313 IF(ADDITIONNAL_ROWS.EQ.0)GOTO 049 4314 ENDDO 4315 IF(CHOSEN.LT.NUMBER_OF_PROCS)THEN 4316 CHOSEN=CHOSEN+1 4317 ENDIF 4318 IF(ACC.EQ.0)THEN 4319 ACC=1 4320 ENDIF 4321 X=int(ADDITIONNAL_ROWS/ACC) 4322 X=max(X,1) 4323 ACC=0 4324 DO i=1,CHOSEN 4325 J=int(BUF_SIZE/dble(NCB+1))-1 4326 BANDE_K821=dble(J)*dble(NFRONT) 4327 IF(HAVE_TYPE1_SON)THEN 4328 J=int((BUF_SIZE-dble(NFRONT))/ 4329 & dble(NFRONT+1)) 4330 BANDE_K821=dble(J)*dble(NFRONT) 4331 ENDIF 4332 MAX_MEM_ALLOW=BANDE_K821 4333 IF(BDC_MD)THEN 4334 MAX_MEM_ALLOW=min( 4335 & min(MEM_SIZE_WEAK(i),MEM_SIZE_STRONG(i)), 4336 & BANDE_K821) 4337 MAX_MEM_ALLOW=max(dble(0),MAX_MEM_ALLOW) 4338 ENDIF 4339 KMAX=int(MAX_MEM_ALLOW/dble(NFRONT)) 4340 TMP_SUM=((dble(NELIM) * dble(NB_ROWS(i))) 4341 & +(dble(NB_ROWS(i))*dble(NELIM))* 4342 & dble(2*NFRONT-NELIM-1)) 4343 J=int((MAX_LOAD- 4344 & (TEMP(i)+TMP_SUM))/ 4345 & (dble(NELIM)*dble(2*NFRONT-NELIM))) 4346 IF(NB_ROWS(i).LT.KMAX)THEN 4347 IF((min(X,J)+NB_ROWS(i)).GE.KMAX)THEN 4348 IF((KMAX-NB_ROWS(i)).GT. 4349 & ADDITIONNAL_ROWS)THEN 4350 NB_ROWS(i)=NB_ROWS(i)+ 4351 & ADDITIONNAL_ROWS 4352 ADDITIONNAL_ROWS=0 4353 ELSE 4354 ADDITIONNAL_ROWS=ADDITIONNAL_ROWS- 4355 & (KMAX-NB_ROWS(i)) 4356 NB_ROWS(i)=KMAX 4357 ENDIF 4358 ELSE 4359 IF((min(X,J)+NB_ROWS(i)).GE. 4360 & KMIN)THEN 4361 NB_ROWS(i)=NB_ROWS(i)+min(X,J) 4362 ADDITIONNAL_ROWS=ADDITIONNAL_ROWS- 4363 & min(X,J) 4364 ACC=ACC+1 4365 ENDIF 4366 ENDIF 4367 ENDIF 4368 IF(ADDITIONNAL_ROWS.EQ.0)GOTO 049 4369 ENDDO 4370 IF(ACC.GT.0)THEN 4371 DO i=1,CHOSEN 4372 X=int(BUF_SIZE/dble(NCB+1))-1 4373 BANDE_K821=dble(X)*dble(NFRONT) 4374 IF(HAVE_TYPE1_SON)THEN 4375 X=int((BUF_SIZE-dble(NFRONT))/ 4376 & dble(NFRONT+1)) 4377 BANDE_K821=dble(X)*dble(NFRONT) 4378 ENDIF 4379 MAX_MEM_ALLOW=BANDE_K821 4380 IF(BDC_MD)THEN 4381 MAX_MEM_ALLOW=min( 4382 & min(MEM_SIZE_WEAK(i),MEM_SIZE_STRONG(i)), 4383 & BANDE_K821) 4384 MAX_MEM_ALLOW=max(dble(0), 4385 & MAX_MEM_ALLOW) 4386 ENDIF 4387 KMAX=int(MAX_MEM_ALLOW/dble(NFRONT)) 4388 IF(KMAX-NB_ROWS(i).LT. 4389 & ADDITIONNAL_ROWS)THEN 4390 ADDITIONNAL_ROWS=ADDITIONNAL_ROWS- 4391 & (KMAX-NB_ROWS(i)) 4392 NB_ROWS(i)=KMAX 4393 ELSE 4394 IF(NB_ROWS(i).EQ.0)THEN 4395 IF(min(KMIN,KMAX).LT. 4396 & ADDITIONNAL_ROWS)THEN 4397 NB_ROWS(i)=min(KMIN,KMAX) 4398 ADDITIONNAL_ROWS= 4399 & ADDITIONNAL_ROWS- 4400 & min(KMIN,KMAX) 4401 ENDIF 4402 ELSE 4403 NB_ROWS(i)=NB_ROWS(i)+ 4404 & ADDITIONNAL_ROWS 4405 ADDITIONNAL_ROWS=0 4406 ENDIF 4407 ENDIF 4408 IF(ADDITIONNAL_ROWS.EQ.0)GOTO 049 4409 ENDDO 4410 ENDIF 4411 DO i=1,CHOSEN 4412 IDWLOAD(i)=i 4413 AFFECTED=int(BUF_SIZE/dble(NCB+1))-1 4414 BANDE_K821=dble(AFFECTED)*dble(NFRONT) 4415 IF(HAVE_TYPE1_SON)THEN 4416 AFFECTED=int((BUF_SIZE-dble(NFRONT))/ 4417 & dble(NFRONT+1)) 4418 BANDE_K821=dble(AFFECTED)*dble(NFRONT) 4419 ENDIF 4420 WLOAD(i)=(BANDE_K821-dble(NB_ROWS(i)*NFRONT)) 4421 ENDDO 4422 CALL MUMPS_558(NUMBER_OF_PROCS, WLOAD, 4423 & IDWLOAD) 4424 NB_SAT=0 4425 DO i=1,CHOSEN 4426 X=int(ADDITIONNAL_ROWS/(CHOSEN-NB_SAT)) 4427 X=max(X,1) 4428 AFFECTED=int(BUF_SIZE/dble(NCB+1))-1 4429 BANDE_K821=dble(AFFECTED)*dble(NFRONT) 4430 IF(HAVE_TYPE1_SON)THEN 4431 AFFECTED=int((BUF_SIZE-dble(NFRONT))/ 4432 & dble(NFRONT+1)) 4433 BANDE_K821=dble(AFFECTED)*dble(NFRONT) 4434 ENDIF 4435 IF(BDC_MD)THEN 4436 MAX_MEM_ALLOW=min(BANDE_K821, 4437 & MEM_SIZE_STRONG(i)) 4438 MAX_MEM_ALLOW=max(dble(0),MAX_MEM_ALLOW) 4439 ENDIF 4440 KMAX=int(MAX_MEM_ALLOW/dble(NFRONT)) 4441 IF(NB_ROWS(IDWLOAD(i)).LT.KMAX)THEN 4442 IF((NB_ROWS(IDWLOAD(i))+X).LT.KMAX)THEN 4443 NB_ROWS(IDWLOAD(i))= 4444 & NB_ROWS(IDWLOAD(i))+X 4445 ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-X 4446 ELSE 4447 ADDITIONNAL_ROWS=ADDITIONNAL_ROWS- 4448 & (KMAX-NB_ROWS(IDWLOAD(i))) 4449 NB_ROWS(IDWLOAD(i))=KMAX 4450 ENDIF 4451 ENDIF 4452 IF(NB_ROWS(IDWLOAD(i)).EQ.KMAX)THEN 4453 NB_SAT=NB_SAT+1 4454 ENDIF 4455 IF(ADDITIONNAL_ROWS.EQ.0) GOTO 049 4456 ENDDO 4457 DO i=1,CHOSEN 4458 X=int(BUF_SIZE/dble(NCB+1))-1 4459 BANDE_K821=dble(X)*dble(NFRONT) 4460 IF(HAVE_TYPE1_SON)THEN 4461 X=int((BUF_SIZE-dble(NFRONT))/ 4462 & dble(NFRONT+1)) 4463 BANDE_K821=dble(X)*dble(NFRONT) 4464 ENDIF 4465 MAX_MEM_ALLOW=BANDE_K821 4466 IF(BDC_MD)THEN 4467 MAX_MEM_ALLOW=min(BANDE_K821, 4468 & MEM_SIZE_STRONG(i)) 4469 MAX_MEM_ALLOW=max(dble(0),MAX_MEM_ALLOW) 4470 ENDIF 4471 KMAX=int(MAX_MEM_ALLOW/dble(NFRONT)) 4472 IF(KMAX-NB_ROWS(i).LT.ADDITIONNAL_ROWS)THEN 4473 ADDITIONNAL_ROWS=ADDITIONNAL_ROWS- 4474 & (KMAX-NB_ROWS(i)) 4475 NB_ROWS(i)=KMAX 4476 ELSE 4477 NB_ROWS(i)=NB_ROWS(i)+ADDITIONNAL_ROWS 4478 ADDITIONNAL_ROWS=0 4479 ENDIF 4480 IF(ADDITIONNAL_ROWS.EQ.0)GOTO 049 4481 ENDDO 4482 X=int(ADDITIONNAL_ROWS/CHOSEN) 4483 X=max(X,1) 4484 DO i=1,CHOSEN 4485 ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-X 4486 NB_ROWS(i)=NB_ROWS(i)+X 4487 IF(ADDITIONNAL_ROWS.EQ.0)GOTO 049 4488 ENDDO 4489 NB_ROWS(1)=NB_ROWS(1)+ADDITIONNAL_ROWS 4490 ENDIF 4491 ENDIF 4492 049 CONTINUE 4493 ENDIF 4494 666 CONTINUE 4495 SOMME=dble(0) 4496 X=0 4497 POS=0 4498 DO i=1,CHOSEN 4499 X=X+NB_ROWS(i) 4500 SOMME=SOMME+ dble(NB_ROWS(i)) 4501 ENDDO 4502 GOTO 890 4503 ELSE IF((KEEP(83).GE.NUMBER_OF_PROCS).AND.FORCE_CAND)THEN 4504 MAX_LOAD=dble(0) 4505 DO i=1,OTHERS 4506 MAX_LOAD=max(MAX_LOAD,TEMP(i)) 4507 ENDDO 4508 ACC=0 4509 CHOSEN=0 4510 X=1 4511 DO i=1,OTHERS 4512 ENDDO 4513 DO i=2,OTHERS 4514 IF(TEMP(i).EQ.TEMP(1))THEN 4515 X=X+1 4516 ELSE 4517 GOTO 329 4518 ENDIF 4519 ENDDO 4520 329 CONTINUE 4521 TMP_SUM=TOTAL_COST/dble(X) 4522 TEMP_MAX_LOAD=dble(0) 4523 DO i=1,OTHERS 4524 IF(K50.EQ.0)THEN 4525 X=int(BUF_SIZE/dble(NCB+1))-1 4526 BANDE_K821=dble(X)*dble(NFRONT) 4527 ELSE 4528 A=dble(1) 4529 B=dble(ACC+2) 4530 C=-BUF_SIZE+dble(ACC+NELIM) 4531 DELTA=(B*B)-(dble(4)*A*C) 4532 X=int((-B+sqrt(DELTA))/(dble(2)*A)) 4533 IF(X.GT.NCB-ACC) X=NCB-ACC 4534 BANDE_K821=dble(X)*dble(NELIM+ACC+X) 4535 ENDIF 4536 IF(HAVE_TYPE1_SON)THEN 4537 IF(K50.EQ.0)THEN 4538 X=int((BUF_SIZE-dble(NFRONT))/dble(NFRONT+1)) 4539 BANDE_K821=dble(X)*dble(NFRONT) 4540 ELSE 4541 A=dble(1) 4542 B=dble(ACC+2+NELIM) 4543 C=-BUF_SIZE+dble(ACC+NELIM) 4544 DELTA=(B*B)-(dble(4)*A*C) 4545 X=int((-B+sqrt(DELTA))/(dble(2)*A)) 4546 IF(X.GT.NCB-ACC) X=NCB-ACC 4547 BANDE_K821=dble(X)*dble(NELIM+ACC+X) 4548 ENDIF 4549 ENDIF 4550 MAX_MEM_ALLOW=BANDE_K821 4551 IF(BDC_MD)THEN 4552 MAX_MEM_ALLOW=min(BANDE_K821, 4553 & min(MEM_SIZE_WEAK(i),MEM_SIZE_STRONG(i))) 4554 MAX_MEM_ALLOW=max(dble(0),MAX_MEM_ALLOW) 4555 ENDIF 4556 IF(K50.EQ.0)THEN 4557 KMAX=int(MAX_MEM_ALLOW/dble(NFRONT)) 4558 IF(TMP_SUM+TEMP(i).GT.MAX_LOAD)THEN 4559 SOMME=MAX_LOAD-TEMP(i) 4560 ELSE 4561 SOMME=TMP_SUM 4562 ENDIF 4563 X=int(SOMME/ 4564 & (dble(NELIM)*dble(2*NFRONT-NELIM))) 4565 IF(X.GT.KMAX)THEN 4566 X=KMAX 4567 ELSE 4568 IF(X.LT.KMIN)THEN 4569 X=min(KMIN,KMAX) 4570 ENDIF 4571 ENDIF 4572 IF((ACC+X).GT.NCB) X=NCB-ACC 4573 ENDIF 4574 IF(K50.NE.0)THEN 4575 A=dble(1) 4576 B=dble(ACC+NELIM) 4577 C=dble(-MAX_MEM_ALLOW) 4578 DELTA=((B*B)-(dble(4)*A*C)) 4579 KMAX=int((-B+sqrt(DELTA))/(dble(2)*A)) 4580 A=dble(NELIM) 4581 B=dble(NELIM)*dble(NELIM+2*ACC+1) 4582 IF(TMP_SUM+TEMP(i).GT.MAX_LOAD)THEN 4583 C=-(MAX_LOAD-TEMP(i)) 4584 ELSE 4585 C=-TMP_SUM 4586 ENDIF 4587 DELTA=(B*B-(dble(4)*A*C)) 4588 X=int((-B+sqrt(DELTA))/(dble(2)*A)) 4589 IF(X.LT.0) THEN 4590 WRITE(*,*)MYID, 4591 & ': Internal error 14 in CMUMPS_518' 4592 CALL MUMPS_ABORT() 4593 ENDIF 4594 IF(X.GE.KMAX)THEN 4595 IF(KMAX.GT.KMIN)THEN 4596 X=KMAX 4597 ELSE 4598 X=0 4599 ENDIF 4600 ELSE 4601 IF(X.LE.min(KMIN,KMAX))THEN 4602 IF(KMAX.LT.KMIN)THEN 4603 X=0 4604 ELSE 4605 X=min(KMIN,KMAX) 4606 ENDIF 4607 ENDIF 4608 ENDIF 4609 IF((ACC+X).GT.NCB) X=NCB-ACC 4610 ENDIF 4611 TEMP_MAX_LOAD=max(TEMP_MAX_LOAD,TEMP(i)) 4612 NB_ROWS(i)=X 4613 CHOSEN=CHOSEN+1 4614 ACC=ACC+X 4615 IF(ACC.EQ.NCB) GOTO 541 4616 ENDDO 4617 541 CONTINUE 4618 IF(ACC.LT.NCB)THEN 4619 IF(K50.EQ.0)THEN 4620 ADDITIONNAL_ROWS=NCB-ACC 4621 DO J=1,CHOSEN 4622 AFFECTED=int(BUF_SIZE/dble(NCB+1))-1 4623 BANDE_K821=dble(AFFECTED)*dble(NFRONT) 4624 IF(HAVE_TYPE1_SON)THEN 4625 AFFECTED=int((BUF_SIZE-dble(NFRONT))/ 4626 & dble(NFRONT+1)) 4627 BANDE_K821=dble(AFFECTED)*dble(NFRONT) 4628 ENDIF 4629 MAX_MEM_ALLOW=BANDE_K821 4630 IF(BDC_MD)THEN 4631 MAX_MEM_ALLOW=min( 4632 & min(MEM_SIZE_WEAK(J),MEM_SIZE_STRONG(J)), 4633 & dble(BANDE_K821)) 4634 MAX_MEM_ALLOW=max(dble(0),MAX_MEM_ALLOW) 4635 ENDIF 4636 KMAX=int(MAX_MEM_ALLOW/dble(NFRONT)) 4637 IF((NB_ROWS(J)).LT.KMAX)THEN 4638 IF(ADDITIONNAL_ROWS.GT.(KMAX-NB_ROWS(J)))THEN 4639 ADDITIONNAL_ROWS=ADDITIONNAL_ROWS- 4640 & (KMAX-NB_ROWS(J)) 4641 NB_ROWS(J)=KMAX 4642 ELSE 4643 NB_ROWS(J)=NB_ROWS(J)+ADDITIONNAL_ROWS 4644 ADDITIONNAL_ROWS=0 4645 ENDIF 4646 ENDIF 4647 IF(ADDITIONNAL_ROWS.EQ.0)GOTO 889 4648 ENDDO 4649 X=int(ADDITIONNAL_ROWS/CHOSEN) 4650 X=max(X,1) 4651 DO J=1,CHOSEN 4652 AFFECTED=int(BUF_SIZE/dble(NCB+1))-1 4653 BANDE_K821=dble(AFFECTED)*dble(NFRONT) 4654 IF(HAVE_TYPE1_SON)THEN 4655 AFFECTED=int((BUF_SIZE-dble(NFRONT))/ 4656 & dble(NFRONT+1)) 4657 BANDE_K821=dble(AFFECTED)*dble(NFRONT) 4658 ENDIF 4659 MAX_MEM_ALLOW=BANDE_K821 4660 IF(BDC_MD)THEN 4661 MAX_MEM_ALLOW=min(BANDE_K821, 4662 & MEM_SIZE_STRONG(J)) 4663 MAX_MEM_ALLOW=max(dble(0),MAX_MEM_ALLOW) 4664 ENDIF 4665 KMAX=int(MAX_MEM_ALLOW/dble(NFRONT)) 4666 IF((NB_ROWS(J)+X).GT.KMAX)THEN 4667 ADDITIONNAL_ROWS=ADDITIONNAL_ROWS- 4668 & (KMAX-NB_ROWS(J)) 4669 NB_ROWS(J)=KMAX 4670 ELSE 4671 ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-X 4672 NB_ROWS(J)=NB_ROWS(J)+X 4673 ENDIF 4674 IF(ADDITIONNAL_ROWS.EQ.0)GOTO 889 4675 ENDDO 4676 DO i=1,CHOSEN 4677 X=int(BUF_SIZE/dble(NCB+1))-1 4678 BANDE_K821=dble(X)*dble(NFRONT) 4679 IF(HAVE_TYPE1_SON)THEN 4680 X=int((BUF_SIZE-dble(NFRONT))/ 4681 & dble(NFRONT+1)) 4682 BANDE_K821=dble(X)*dble(NFRONT) 4683 ENDIF 4684 MAX_MEM_ALLOW=BANDE_K821 4685 IF(BDC_MD)THEN 4686 MAX_MEM_ALLOW=min(BANDE_K821, 4687 & MEM_SIZE_STRONG(i)) 4688 MAX_MEM_ALLOW=max(dble(0),MAX_MEM_ALLOW) 4689 ENDIF 4690 KMAX=int(MAX_MEM_ALLOW/dble(NFRONT)) 4691 IF(KMAX-NB_ROWS(i).LT.ADDITIONNAL_ROWS)THEN 4692 ADDITIONNAL_ROWS=ADDITIONNAL_ROWS- 4693 & (KMAX-NB_ROWS(i)) 4694 NB_ROWS(i)=KMAX 4695 ELSE 4696 NB_ROWS(i)=NB_ROWS(i)+ADDITIONNAL_ROWS 4697 ADDITIONNAL_ROWS=0 4698 ENDIF 4699 IF(ADDITIONNAL_ROWS.EQ.0)GOTO 889 4700 ENDDO 4701 DO i=1,NUMBER_OF_PROCS 4702 IDWLOAD(i)=i 4703 AFFECTED=int(BUF_SIZE/dble(NCB+1))-1 4704 BANDE_K821=dble(AFFECTED)*dble(NFRONT) 4705 IF(HAVE_TYPE1_SON)THEN 4706 AFFECTED=int((BUF_SIZE-dble(NFRONT))/ 4707 & dble(NFRONT+1)) 4708 BANDE_K821=dble(AFFECTED)*dble(NFRONT) 4709 ENDIF 4710 WLOAD(i)=(BANDE_K821-(dble(NB_ROWS(i))* 4711 & dble(NFRONT))) 4712 ENDDO 4713 CALL MUMPS_558(NUMBER_OF_PROCS, WLOAD, 4714 & IDWLOAD) 4715 NB_SAT=0 4716 DO i=1,CHOSEN 4717 X=int(ADDITIONNAL_ROWS/(CHOSEN-NB_SAT)) 4718 X=max(X,1) 4719 AFFECTED=int(BUF_SIZE/dble(NCB+1))-1 4720 BANDE_K821=dble(AFFECTED)*dble(NFRONT) 4721 IF(HAVE_TYPE1_SON)THEN 4722 AFFECTED=int((BUF_SIZE-dble(NFRONT))/ 4723 & dble(NFRONT+1)) 4724 BANDE_K821=dble(AFFECTED)*dble(NFRONT) 4725 ENDIF 4726 MAX_MEM_ALLOW=BANDE_K821 4727 KMAX=int(MAX_MEM_ALLOW/dble(NFRONT)) 4728 IF(NB_ROWS(IDWLOAD(i)).LT.KMAX)THEN 4729 IF((NB_ROWS(IDWLOAD(i))+X).LT.KMAX)THEN 4730 NB_ROWS(IDWLOAD(i))= 4731 & NB_ROWS(IDWLOAD(i))+X 4732 ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-X 4733 ELSE 4734 ADDITIONNAL_ROWS=ADDITIONNAL_ROWS- 4735 & (KMAX-NB_ROWS(IDWLOAD(i))) 4736 NB_ROWS(IDWLOAD(i))=KMAX 4737 ENDIF 4738 ENDIF 4739 IF(NB_ROWS(IDWLOAD(i)).EQ.KMAX)THEN 4740 NB_SAT=NB_SAT+1 4741 ENDIF 4742 IF(ADDITIONNAL_ROWS.EQ.0) GOTO 889 4743 ENDDO 4744 GOTO 994 4745 ELSE 4746 ACC=0 4747 CHOSEN=0 4748 DO i=1,OTHERS 4749 A=dble(1) 4750 B=dble(ACC+2) 4751 C=-BUF_SIZE+dble(ACC+NELIM) 4752 DELTA=(B*B)-(dble(4)*A*C) 4753 X=int((-B+sqrt(DELTA))/(dble(2)*A)) 4754 IF(X.GT.NCB-ACC) X=NCB-ACC 4755 BANDE_K821=dble(X)*dble(NELIM+ACC+X) 4756 IF(HAVE_TYPE1_SON)THEN 4757 A=dble(1) 4758 B=dble(ACC+2+NELIM) 4759 C=-BUF_SIZE+dble(ACC+NELIM) 4760 DELTA=(B*B)-(dble(4)*A*C) 4761 X=int((-B+sqrt(DELTA))/(dble(2)*A)) 4762 IF(X.GT.NCB-ACC) X=NCB-ACC 4763 BANDE_K821=dble(X)*dble(NELIM+ACC+X) 4764 ENDIF 4765 MAX_MEM_ALLOW=BANDE_K821 4766 IF(BDC_MD)THEN 4767 MAX_MEM_ALLOW=min(BANDE_K821, 4768 & MEM_SIZE_STRONG(i)) 4769 MAX_MEM_ALLOW=max(dble(0),MAX_MEM_ALLOW) 4770 ENDIF 4771 A=dble(1) 4772 B=dble(ACC+NELIM) 4773 C=dble(-MAX_MEM_ALLOW) 4774 DELTA=((B*B)-(dble(4)*A*C)) 4775 KMAX=int((-B+sqrt(DELTA))/(dble(2)*A)) 4776 X=KMAX-NB_ROWS(i) 4777 IF((ACC+NB_ROWS(i)+X).GT.NCB) 4778 & X=NCB-(ACC+NB_ROWS(i)) 4779 NB_ROWS(i)=NB_ROWS(i)+X 4780 ACC=ACC+NB_ROWS(i) 4781 CHOSEN=CHOSEN+1 4782 IF(NCB.EQ.ACC) GOTO 889 4783 ENDDO 4784 ADDITIONNAL_ROWS=NCB-ACC 4785 ENDIF 4786 ACC=0 4787 CHOSEN=0 4788 DO i=1,OTHERS 4789 A=dble(1) 4790 B=dble(ACC+2) 4791 C=-BUF_SIZE+dble(ACC+NELIM) 4792 DELTA=(B*B)-(dble(4)*A*C) 4793 X=int((-B+sqrt(DELTA))/(dble(2)*A)) 4794 IF(X.GT.NCB-ACC) X=NCB-ACC 4795 BANDE_K821=dble(X)*dble(NELIM+ACC+X) 4796 IF(HAVE_TYPE1_SON)THEN 4797 A=dble(1) 4798 B=dble(ACC+2+NELIM) 4799 C=-BUF_SIZE+dble(ACC+NELIM) 4800 DELTA=(B*B)-(dble(4)*A*C) 4801 X=int((-B+sqrt(DELTA))/(dble(2)*A)) 4802 IF(X.GT.NCB-ACC) X=NCB-ACC 4803 BANDE_K821=dble(X)*dble(NELIM+ACC+X) 4804 ENDIF 4805 MAX_MEM_ALLOW=BANDE_K821 4806 A=dble(1) 4807 B=dble(ACC+NELIM) 4808 C=dble(-MAX_MEM_ALLOW) 4809 DELTA=((B*B)-(dble(4)*A*C)) 4810 KMAX=int((-B+sqrt(DELTA))/(dble(2)*A)) 4811 X=KMAX-NB_ROWS(i) 4812 IF((ACC+NB_ROWS(i)+X).GT.NCB) 4813 & X=NCB-(ACC+NB_ROWS(i)) 4814 NB_ROWS(i)=NB_ROWS(i)+X 4815 ACC=ACC+NB_ROWS(i) 4816 CHOSEN=CHOSEN+1 4817 IF(NCB.EQ.ACC) GOTO 889 4818 ENDDO 4819 ADDITIONNAL_ROWS=NCB-ACC 4820 994 CONTINUE 4821 X=int(dble(ADDITIONNAL_ROWS)/dble(OTHERS)) 4822 IF((X*OTHERS).LT.ADDITIONNAL_ROWS)THEN 4823 X=X+1 4824 ENDIF 4825 DO i=1,OTHERS 4826 NB_ROWS(i)=NB_ROWS(i)+X 4827 ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-X 4828 IF(ADDITIONNAL_ROWS.LT.X)X=ADDITIONNAL_ROWS 4829 ENDDO 4830 CHOSEN=OTHERS 4831 ENDIF 4832 ENDIF 4833 889 CONTINUE 4834 MAX_LOAD=TEMP_MAX_LOAD 4835 890 CONTINUE 4836 J=CHOSEN 4837 X=0 4838 DO i=J,1,-1 4839 IF(NB_ROWS(i).EQ.0)THEN 4840 CHOSEN=CHOSEN-1 4841 ELSE 4842 IF(NB_ROWS(i).GT.0)THEN 4843 X=1 4844 ELSE 4845 WRITE(*,*)MYID, 4846 & ': Internal error 15 in CMUMPS_518' 4847 CALL MUMPS_ABORT() 4848 ENDIF 4849 ENDIF 4850 ENDDO 4851 NSLAVES_NODE=CHOSEN 4852 TAB_POS(NSLAVES_NODE+1)= NCB+1 4853 TAB_POS(SLAVEF+2) = CHOSEN 4854 POS=1 4855 X=1 4856 DO i=1,J 4857 IF(NB_ROWS(i).NE.0)THEN 4858 SLAVES_LIST(X)=TEMP_ID(i) 4859 TAB_POS(X)=POS 4860 POS=POS+NB_ROWS(i) 4861 IF(NB_ROWS(i).LE.0)THEN 4862 WRITE(*,*)MYID, 4863 & ': Internal error 16 in CMUMPS_518' 4864 CALL MUMPS_ABORT() 4865 ENDIF 4866 X=X+1 4867 ENDIF 4868 ENDDO 4869 DO i=CHOSEN+1,NUMBER_OF_PROCS 4870 SLAVES_LIST(i)=TEMP_ID(i) 4871 ENDDO 4872 IF(POS.NE.(NCB+1))THEN 4873 WRITE(*,*)MYID, 4874 & ': Internal error 17 in CMUMPS_518', 4875 & POS,NCB+1 4876 CALL MUMPS_ABORT() 4877 ENDIF 4878 END SUBROUTINE CMUMPS_518 4879 SUBROUTINE CMUMPS_520 4880 & (INODE,UPPER,SLAVEF,KEEP,KEEP8, 4881 & STEP,POOL,LPOOL,PROCNODE,N) 4882 IMPLICIT NONE 4883 INTEGER INODE, LPOOL, SLAVEF, N 4884 INTEGER KEEP(500) 4885 INTEGER(8) KEEP8(150) 4886 INTEGER STEP(KEEP(28)), POOL(LPOOL), PROCNODE(KEEP(28)) 4887 LOGICAL UPPER 4888 INTEGER J 4889 DOUBLE PRECISION MEM_COST 4890 INTEGER NBINSUBTREE,i,NBTOP 4891 EXTERNAL CMUMPS_508, 4892 & MUMPS_170 4893 LOGICAL CMUMPS_508, 4894 & MUMPS_170 4895 NBINSUBTREE = POOL(LPOOL) 4896 NBTOP = POOL(LPOOL - 1) 4897 IF(KEEP(47).LT.2)THEN 4898 WRITE(*,*)'CMUMPS_520 must 4899 & be called with K47>=2' 4900 CALL MUMPS_ABORT() 4901 ENDIF 4902 IF((INODE.GT.0).AND.(INODE.LE.N))THEN 4903 MEM_COST=CMUMPS_543(INODE) 4904 IF((DM_MEM(MYID)+dble(MEM_COST)+ PEAK_SBTR_CUR_LOCAL- 4905 & SBTR_CUR_LOCAL) 4906 & .GT.MAX_PEAK_STK)THEN 4907 DO i=NBTOP-1,1,-1 4908 INODE = POOL( LPOOL - 2 - i) 4909 MEM_COST=CMUMPS_543(INODE) 4910 IF((INODE.LT.0).OR.(INODE.GT.N)) THEN 4911 DO J=i+1,NBTOP,-1 4912 POOL(J-1)=POOL(J) 4913 ENDDO 4914 UPPER=.TRUE. 4915 RETURN 4916 ENDIF 4917 IF((DM_MEM(MYID)+dble(MEM_COST)+PEAK_SBTR_CUR_LOCAL- 4918 & SBTR_CUR_LOCAL).LE. 4919 & MAX_PEAK_STK) THEN 4920 DO J=i+1,NBTOP,-1 4921 POOL(J-1)=POOL(J) 4922 ENDDO 4923 UPPER=.TRUE. 4924 RETURN 4925 ENDIF 4926 ENDDO 4927 IF(NBINSUBTREE.NE.0)THEN 4928 INODE = POOL( NBINSUBTREE ) 4929 IF(.NOT.MUMPS_170(PROCNODE(STEP(INODE)), 4930 & SLAVEF))THEN 4931 WRITE(*,*) 4932 & 'Internal error 1 in CMUMPS_520' 4933 CALL MUMPS_ABORT() 4934 ENDIF 4935 UPPER=.FALSE. 4936 RETURN 4937 ENDIF 4938 INODE=POOL(LPOOL-2-NBTOP) 4939 UPPER=.TRUE. 4940 RETURN 4941 ENDIF 4942 ENDIF 4943 UPPER=.TRUE. 4944 END SUBROUTINE CMUMPS_520 4945 SUBROUTINE CMUMPS_513(WHAT) 4946 IMPLICIT NONE 4947 LOGICAL WHAT 4948 IF(.NOT.BDC_POOL_MNG)THEN 4949 WRITE(*,*)'CMUMPS_513 4950 & should be called when K81>0 and K47>2' 4951 ENDIF 4952 IF(WHAT)THEN 4953 PEAK_SBTR_CUR_LOCAL=PEAK_SBTR_CUR_LOCAL+ 4954 & dble(MEM_SUBTREE(INDICE_SBTR)) 4955 IF(.NOT.BDC_SBTR) INDICE_SBTR=INDICE_SBTR+1 4956 ELSE 4957 PEAK_SBTR_CUR_LOCAL=dble(0) 4958 SBTR_CUR_LOCAL=dble(0) 4959 ENDIF 4960 END SUBROUTINE CMUMPS_513 4961 DOUBLE PRECISION FUNCTION CMUMPS_543( INODE ) 4962 IMPLICIT NONE 4963 INTEGER INODE,LEVEL,i,NELIM,NFR 4964 DOUBLE PRECISION COST 4965 EXTERNAL MUMPS_330 4966 INTEGER MUMPS_330 4967 i = INODE 4968 NELIM = 0 4969 10 CONTINUE 4970 IF ( i > 0 ) THEN 4971 NELIM = NELIM + 1 4972 i = FILS_LOAD(i) 4973 GOTO 10 4974 ENDIF 4975 NFR = ND_LOAD( STEP_LOAD(INODE) ) + KEEP_LOAD(253) 4976 LEVEL = MUMPS_330( PROCNODE_LOAD(STEP_LOAD(INODE)), NPROCS ) 4977 IF (LEVEL .EQ. 1) THEN 4978 COST = dble(NFR) * dble(NFR) 4979 ELSE 4980 IF ( K50 == 0 ) THEN 4981 COST = dble(NFR) * dble(NELIM) 4982 ELSE 4983 COST = dble(NELIM) * dble(NELIM) 4984 ENDIF 4985 ENDIF 4986 CMUMPS_543=COST 4987 RETURN 4988 END FUNCTION CMUMPS_543 4989 RECURSIVE SUBROUTINE CMUMPS_515(FLAG,COST,COMM) 4990 USE CMUMPS_COMM_BUFFER 4991 IMPLICIT NONE 4992 INTEGER COMM,WHAT,IERR 4993 LOGICAL FLAG 4994 DOUBLE PRECISION COST 4995 DOUBLE PRECISION TO_BE_SENT 4996 EXTERNAL MUMPS_330 4997 INTEGER MUMPS_330 4998 IF(FLAG)THEN 4999 WHAT=17 5000 IF(BDC_M2_FLOPS)THEN 5001#if ! defined(OLD_LOAD_MECHANISM) 5002 TO_BE_SENT=DELTA_LOAD-COST 5003 DELTA_LOAD=dble(0) 5004#else 5005 TO_BE_SENT=LAST_LOAD_SENT-COST 5006 LAST_LOAD_SENT=LAST_LOAD_SENT-COST 5007#endif 5008 ELSE IF(BDC_M2_MEM)THEN 5009 IF(BDC_POOL.AND.(.NOT.BDC_MD))THEN 5010 TO_BE_SENT=max(TMP_M2,POOL_LAST_COST_SENT) 5011 POOL_LAST_COST_SENT=TO_BE_SENT 5012 ELSE IF(BDC_MD)THEN 5013#if ! defined(OLD_LOAD_MECHANISM) 5014 DELTA_MEM=DELTA_MEM+TMP_M2 5015 TO_BE_SENT=DELTA_MEM 5016#else 5017 TO_BE_SENT=DM_LAST_MEM_SENT+TMP_M2 5018 DM_LAST_MEM_SENT=DM_LAST_MEM_SENT+TMP_M2 5019#endif 5020 ELSE 5021 TO_BE_SENT=dble(0) 5022 ENDIF 5023 ENDIF 5024 ELSE 5025 WHAT=6 5026 TO_BE_SENT=dble(0) 5027 ENDIF 5028 111 CONTINUE 5029 CALL CMUMPS_460( WHAT, 5030 & COMM, NPROCS, 5031#if ! defined(OLD_LOAD_MECHANISM) 5032 & FUTURE_NIV2, 5033#endif 5034 & COST, 5035 & TO_BE_SENT, 5036 & MYID, IERR ) 5037 IF ( IERR == -1 )THEN 5038 CALL CMUMPS_467(COMM_LD, KEEP_LOAD) 5039 GOTO 111 5040 ELSE IF ( IERR .NE. 0 ) THEN 5041 WRITE(*,*) "Internal Error in CMUMPS_500", 5042 & IERR 5043 CALL MUMPS_ABORT() 5044 ENDIF 5045 RETURN 5046 END SUBROUTINE CMUMPS_515 5047 SUBROUTINE CMUMPS_512(INODE,STEP,NSTEPS,PROCNODE,FRERE, 5048 & NE,COMM,SLAVEF,MYID,KEEP,KEEP8,N) 5049 USE CMUMPS_COMM_BUFFER 5050 IMPLICIT NONE 5051 INTEGER INODE,NSTEPS,MYID,SLAVEF,COMM,N 5052 INTEGER KEEP(500) 5053 INTEGER(8) KEEP8(150) 5054 INTEGER FRERE(NSTEPS),NE(NSTEPS),STEP(N),PROCNODE(NSTEPS) 5055 EXTERNAL MUMPS_170,MUMPS_275 5056 LOGICAL MUMPS_170 5057 INTEGER i,NCB,NELIM 5058 INTEGER MUMPS_275 5059 INTEGER FATHER_NODE,FATHER,WHAT,IERR 5060 EXTERNAL MUMPS_330 5061 INTEGER MUMPS_330 5062 IF((.NOT.BDC_M2_MEM).AND.(.NOT.BDC_M2_FLOPS))THEN 5063 WRITE(*,*)MYID,': Problem in CMUMPS_512' 5064 CALL MUMPS_ABORT() 5065 ENDIF 5066 IF((INODE.LT.0).OR.(INODE.GT.N)) THEN 5067 RETURN 5068 ENDIF 5069 i=INODE 5070 NELIM = 0 5071 10 CONTINUE 5072 IF ( i > 0 ) THEN 5073 NELIM = NELIM + 1 5074 i = FILS_LOAD(i) 5075 GOTO 10 5076 ENDIF 5077 NCB=ND_LOAD(STEP_LOAD(INODE))-NELIM + KEEP_LOAD(253) 5078 WHAT=5 5079 FATHER_NODE=DAD_LOAD(STEP_LOAD(INODE)) 5080 IF (FATHER_NODE.EQ.0) THEN 5081 RETURN 5082 ENDIF 5083 IF((FRERE(STEP(FATHER_NODE)).EQ.0).AND. 5084 & ((FATHER_NODE.EQ.KEEP(38)).OR. 5085 & (FATHER_NODE.EQ.KEEP(20))))THEN 5086 RETURN 5087 ENDIF 5088 IF(MUMPS_170(PROCNODE(STEP(FATHER_NODE)), 5089 & SLAVEF)) THEN 5090 RETURN 5091 ENDIF 5092 FATHER=MUMPS_275(PROCNODE(STEP(FATHER_NODE)),SLAVEF) 5093 IF(FATHER.EQ.MYID)THEN 5094 IF(BDC_M2_MEM)THEN 5095 CALL CMUMPS_816(FATHER_NODE) 5096 ELSEIF(BDC_M2_FLOPS)THEN 5097 CALL CMUMPS_817(FATHER_NODE) 5098 ENDIF 5099 IF((KEEP(81).EQ.2).OR.(KEEP(81).EQ.3))THEN 5100 IF(MUMPS_330(PROCNODE_LOAD(STEP_LOAD(INODE)), 5101 & NPROCS).EQ.1)THEN 5102 CB_COST_ID(POS_ID)=INODE 5103 CB_COST_ID(POS_ID+1)=1 5104 CB_COST_ID(POS_ID+2)=POS_MEM 5105 POS_ID=POS_ID+3 5106 CB_COST_MEM(POS_MEM)=int(MYID,8) 5107 POS_MEM=POS_MEM+1 5108 CB_COST_MEM(POS_MEM)=int(NCB,8)*int(NCB,8) 5109 POS_MEM=POS_MEM+1 5110 ENDIF 5111 ENDIF 5112 GOTO 666 5113 ENDIF 5114 111 CONTINUE 5115 CALL CMUMPS_519(WHAT, COMM, NPROCS, 5116 & FATHER_NODE,INODE,NCB, KEEP(81),MYID, 5117 & FATHER, IERR) 5118 IF (IERR == -1 ) THEN 5119 CALL CMUMPS_467(COMM, KEEP) 5120 GOTO 111 5121 ELSE IF ( IERR .NE. 0 ) THEN 5122 WRITE(*,*) "Internal Error in CMUMPS_512", 5123 & IERR 5124 CALL MUMPS_ABORT() 5125 ENDIF 5126 666 CONTINUE 5127 END SUBROUTINE CMUMPS_512 5128 SUBROUTINE CMUMPS_514(INODE,NUM_CALL) 5129 IMPLICIT NONE 5130 DOUBLE PRECISION MAXI 5131 INTEGER i,J,IND_MAXI 5132 INTEGER INODE,NUM_CALL 5133 IF(BDC_M2_MEM)THEN 5134 IF(((NUM_CALL.EQ.1).AND.(BDC_MD)).OR. 5135 & ((NUM_CALL.EQ.2).AND.(.NOT.BDC_MD)))THEN 5136 RETURN 5137 ENDIF 5138 ENDIF 5139 IF((FRERE_LOAD(STEP_LOAD(INODE)).EQ.0).AND. 5140 & ((INODE.EQ.KEEP_LOAD(38)).OR. 5141 & (INODE.EQ.KEEP_LOAD(20)))) THEN 5142 RETURN 5143 ENDIF 5144 DO i=POOL_SIZE,1,-1 5145 IF(POOL_NIV2(i).EQ.INODE) GOTO 666 5146 ENDDO 5147 NB_SON(STEP_LOAD(INODE))=-1 5148 RETURN 5149 666 CONTINUE 5150 IF(BDC_M2_MEM)THEN 5151 IF(POOL_NIV2_COST(i).EQ.MAX_M2)THEN 5152 TMP_M2=MAX_M2 5153 MAXI=dble(0) 5154 IND_MAXI=-9999 5155 DO J=POOL_SIZE,1,-1 5156 IF(J.NE.i) THEN 5157 IF(POOL_NIV2_COST(J).GT.MAXI)THEN 5158 MAXI=POOL_NIV2_COST(J) 5159 IND_MAXI=J 5160 ENDIF 5161 ENDIF 5162 ENDDO 5163 MAX_M2=MAXI 5164 J=IND_MAXI 5165 REMOVE_NODE_FLAG_MEM=.TRUE. 5166 REMOVE_NODE_COST_MEM=TMP_M2 5167 CALL CMUMPS_515(REMOVE_NODE_FLAG,MAX_M2,COMM_LD) 5168 NIV2(MYID+1)=MAX_M2 5169 ENDIF 5170 ELSEIF(BDC_M2_FLOPS)THEN 5171 REMOVE_NODE_COST=POOL_NIV2_COST(i) 5172 REMOVE_NODE_FLAG=.TRUE. 5173 CALL CMUMPS_515(REMOVE_NODE_FLAG, 5174 & -POOL_NIV2_COST(i),COMM_LD) 5175 NIV2(MYID+1)=NIV2(MYID+1)-POOL_NIV2_COST(i) 5176 ENDIF 5177 DO J=i+1,POOL_SIZE 5178 POOL_NIV2(J-1)=POOL_NIV2(J) 5179 POOL_NIV2_COST(J-1)=POOL_NIV2_COST(J) 5180 ENDDO 5181 POOL_SIZE=POOL_SIZE-1 5182 END SUBROUTINE CMUMPS_514 5183 RECURSIVE SUBROUTINE CMUMPS_816(INODE) 5184 IMPLICIT NONE 5185 INTEGER INODE 5186 EXTERNAL MUMPS_330 5187 INTEGER MUMPS_330 5188 IF((INODE.EQ.KEEP_LOAD(20)).OR. 5189 & (INODE.EQ.KEEP_LOAD(38)))THEN 5190 RETURN 5191 ENDIF 5192 IF(NB_SON(STEP_LOAD(INODE)).EQ.-1)THEN 5193 RETURN 5194 ELSE 5195 IF(NB_SON(STEP_LOAD(INODE)).LT.0)THEN 5196 WRITE(*,*) 5197 & 'Internal error 1 in CMUMPS_816' 5198 CALL MUMPS_ABORT() 5199 ENDIF 5200 ENDIF 5201 NB_SON(STEP_LOAD(INODE))= 5202 & NB_SON(STEP_LOAD(INODE))-1 5203 IF(NB_SON(STEP_LOAD(INODE)).EQ.0)THEN 5204 POOL_NIV2(POOL_SIZE+1)=INODE 5205 POOL_NIV2_COST(POOL_SIZE+1)= 5206 & CMUMPS_543(INODE) 5207 POOL_SIZE=POOL_SIZE+1 5208 IF(POOL_NIV2_COST(POOL_SIZE).GT.MAX_M2)THEN 5209 MAX_M2=POOL_NIV2_COST(POOL_SIZE) 5210 ID_MAX_M2=POOL_NIV2(POOL_SIZE) 5211 CALL CMUMPS_515(REMOVE_NODE_FLAG_MEM,MAX_M2,COMM_LD) 5212 NIV2(1+MYID)=MAX_M2 5213 ENDIF 5214 ENDIF 5215 RETURN 5216 END SUBROUTINE CMUMPS_816 5217 RECURSIVE SUBROUTINE CMUMPS_817(INODE) 5218 IMPLICIT NONE 5219 INTEGER INODE 5220 EXTERNAL MUMPS_330 5221 INTEGER MUMPS_330 5222 IF((INODE.EQ.KEEP_LOAD(20)).OR. 5223 & (INODE.EQ.KEEP_LOAD(38)))THEN 5224 RETURN 5225 ENDIF 5226 IF(NB_SON(STEP_LOAD(INODE)).EQ.-1)THEN 5227 RETURN 5228 ELSE 5229 IF(NB_SON(STEP_LOAD(INODE)).LT.0)THEN 5230 WRITE(*,*) 5231 & 'Internal error 1 in CMUMPS_817' 5232 CALL MUMPS_ABORT() 5233 ENDIF 5234 ENDIF 5235 NB_SON(STEP_LOAD(INODE))= 5236 & NB_SON(STEP_LOAD(INODE))-1 5237 IF(NB_SON(STEP_LOAD(INODE)).EQ.0)THEN 5238 POOL_NIV2(POOL_SIZE+1)=INODE 5239 POOL_NIV2_COST(POOL_SIZE+1)= 5240 & CMUMPS_542(INODE) 5241 POOL_SIZE=POOL_SIZE+1 5242 MAX_M2=POOL_NIV2_COST(POOL_SIZE) 5243 ID_MAX_M2=POOL_NIV2(POOL_SIZE) 5244 CALL CMUMPS_515(REMOVE_NODE_FLAG, 5245 & POOL_NIV2_COST(POOL_SIZE), 5246 & COMM_LD) 5247 NIV2(MYID+1)=POOL_NIV2_COST(POOL_SIZE)+NIV2(MYID+1) 5248 ENDIF 5249 RETURN 5250 END SUBROUTINE CMUMPS_817 5251 DOUBLE PRECISION FUNCTION CMUMPS_542(INODE) 5252 INTEGER INODE 5253 INTEGER NFRONT,NELIM,i,LEVEL 5254 EXTERNAL MUMPS_330 5255 INTEGER MUMPS_330 5256 DOUBLE PRECISION COST 5257 i = INODE 5258 NELIM = 0 5259 10 CONTINUE 5260 IF ( i > 0 ) THEN 5261 NELIM = NELIM + 1 5262 i = FILS_LOAD(i) 5263 GOTO 10 5264 ENDIF 5265 NFRONT = ND_LOAD( STEP_LOAD(INODE) ) + KEEP_LOAD(253) 5266 LEVEL = MUMPS_330( PROCNODE_LOAD(STEP_LOAD(INODE)), NPROCS ) 5267 COST=dble(0) 5268 CALL MUMPS_511(NFRONT,NELIM,NELIM, 5269 & KEEP_LOAD(50),LEVEL,COST) 5270 CMUMPS_542=COST 5271 RETURN 5272 END FUNCTION CMUMPS_542 5273 INTEGER FUNCTION CMUMPS_541( INODE ) 5274 IMPLICIT NONE 5275 INTEGER INODE,NELIM,NFR,SON,IN,i 5276 INTEGER COST_CB 5277 COST_CB=0 5278 i = INODE 5279 10 CONTINUE 5280 IF ( i > 0 ) THEN 5281 i = FILS_LOAD(i) 5282 GOTO 10 5283 ENDIF 5284 SON=-i 5285 DO i=1, NE_LOAD(STEP_LOAD(INODE)) 5286 NFR = ND_LOAD( STEP_LOAD(SON) ) + KEEP_LOAD(253) 5287 IN=SON 5288 NELIM = 0 5289 20 CONTINUE 5290 IF ( IN > 0 ) THEN 5291 NELIM = NELIM + 1 5292 IN = FILS_LOAD(IN) 5293 GOTO 20 5294 ENDIF 5295 COST_CB=COST_CB+((NFR-NELIM)*(NFR-NELIM)) 5296 SON=FRERE_LOAD(STEP_LOAD(SON)) 5297 ENDDO 5298 CMUMPS_541=COST_CB 5299 RETURN 5300 END FUNCTION CMUMPS_541 5301 SUBROUTINE CMUMPS_533(SLAVEF,NMB_OF_CAND, 5302 & TAB_POS, NASS, KEEP,KEEP8, LIST_SLAVES, 5303 & NSLAVES,INODE) 5304 USE CMUMPS_COMM_BUFFER 5305 IMPLICIT NONE 5306 INTEGER, INTENT (IN) :: SLAVEF, NASS, NSLAVES 5307 INTEGER, INTENT (IN) :: TAB_POS(SLAVEF+2) 5308 INTEGER, intent(in) :: NMB_OF_CAND 5309 INTEGER, INTENT (IN) :: LIST_SLAVES( NMB_OF_CAND ) 5310 INTEGER KEEP(500),INODE 5311 INTEGER(8) KEEP8(150) 5312 INTEGER allocok 5313 DOUBLE PRECISION MEM_COST,FCT_COST 5314 DOUBLE PRECISION, DIMENSION(:),ALLOCATABLE ::EMPTY_ARRAY, 5315 & DELTA_MD,EMPTY_ARRAY2 5316 INTEGER NBROWS_SLAVE,i,WHAT,IERR,NPROCS_LOC 5317 LOGICAL FORCE_CAND 5318 MEM_COST=dble(0) 5319 FCT_COST=dble(0) 5320 IF ( KEEP(24) == 0 .OR. KEEP(24) == 1 ) THEN 5321 FORCE_CAND = .FALSE. 5322 NPROCS_LOC=SLAVEF-1 5323 ELSE 5324 FORCE_CAND = (mod(KEEP(24),2).eq.0) 5325 NPROCS_LOC=NMB_OF_CAND 5326 END IF 5327 IF(FORCE_CAND)THEN 5328 CALL CMUMPS_540(INODE,FCT_COST, 5329 & MEM_COST,NPROCS_LOC,NASS) 5330 ELSE 5331 CALL CMUMPS_540(INODE,FCT_COST, 5332 & MEM_COST,SLAVEF-1,NASS) 5333 ENDIF 5334 DO i=1,SLAVEF 5335 IDWLOAD(i)=i-1 5336 ENDDO 5337 ALLOCATE(EMPTY_ARRAY(NPROCS_LOC),DELTA_MD(NPROCS_LOC), 5338 & EMPTY_ARRAY2(NPROCS_LOC), 5339 & stat=allocok) 5340 DO i = 1, NSLAVES 5341 NBROWS_SLAVE = TAB_POS(i+1) - TAB_POS(i) 5342 DELTA_MD( i ) = FCT_COST - dble(NBROWS_SLAVE)* 5343 & dble(NASS) 5344 END DO 5345 IF(FORCE_CAND)THEN 5346 DO i=NSLAVES+1,NPROCS_LOC 5347 DELTA_MD( i ) = FCT_COST 5348 ENDDO 5349 ELSE 5350 DO i=NSLAVES+1,SLAVEF-1 5351 DELTA_MD( i ) = FCT_COST 5352 ENDDO 5353 ENDIF 5354 WHAT=7 5355 111 CONTINUE 5356 CALL CMUMPS_524(.FALSE., COMM_LD, MYID, SLAVEF, 5357#if ! defined(OLD_LOAD_MECHANISM) 5358 & FUTURE_NIV2, 5359#endif 5360 & NPROCS_LOC, LIST_SLAVES,0, 5361 & EMPTY_ARRAY, 5362 & DELTA_MD,EMPTY_ARRAY2,WHAT, IERR) 5363 IF ( IERR == -1 ) THEN 5364 CALL CMUMPS_467(COMM_LD, KEEP) 5365 GOTO 111 5366 ELSE IF ( IERR .NE. 0 ) THEN 5367 WRITE(*,*) "Internal Error in CMUMPS_533", 5368 & IERR 5369 CALL MUMPS_ABORT() 5370 ENDIF 5371#if ! defined(OLD_LOAD_MECHANISM) 5372 IF (FUTURE_NIV2(MYID+1) .NE. 0) THEN 5373#endif 5374 DO i = 1, NSLAVES 5375 MD_MEM(LIST_SLAVES(i))=MD_MEM(LIST_SLAVES(i))+ 5376 & int(DELTA_MD( i ),8) 5377#if ! defined(OLD_LOAD_MECHANISM) 5378 IF(FUTURE_NIV2(LIST_SLAVES(i)+1).EQ.0)THEN 5379 MD_MEM(LIST_SLAVES(i))=999999999_8 5380 ENDIF 5381#endif 5382 ENDDO 5383#if ! defined(OLD_LOAD_MECHANISM) 5384 ENDIF 5385#endif 5386 DEALLOCATE(EMPTY_ARRAY) 5387 DEALLOCATE(DELTA_MD) 5388 END SUBROUTINE CMUMPS_533 5389 SUBROUTINE CMUMPS_540(INODE,FCT_COST, 5390 & MEM_COST,NSLAVES,NELIM) 5391 IMPLICIT NONE 5392 INTEGER INODE,NSLAVES,NFR,NELIM,IN 5393 DOUBLE PRECISION MEM_COST,FCT_COST 5394 NFR=ND_LOAD(STEP_LOAD(INODE)) + KEEP_LOAD(253) 5395 IN = INODE 5396 FCT_COST=dble(int(dble(NFR-NELIM)/dble(NSLAVES))+1)* 5397 & dble(NELIM) 5398 MEM_COST=dble(int(dble(NFR-NELIM)/dble(NSLAVES))+1)* 5399 & dble(NFR) 5400 END SUBROUTINE CMUMPS_540 5401 SUBROUTINE CMUMPS_819(INODE) 5402 IMPLICIT NONE 5403 INTEGER INODE 5404 INTEGER i,J,SON,NSLAVES_TEMP,POS_TEMP,K 5405 INTEGER MUMPS_275 5406 EXTERNAL MUMPS_275 5407 IF((INODE.LT.0).OR.(INODE.GT.N_LOAD))THEN 5408 RETURN 5409 ENDIF 5410 IF(POS_ID.GT.1)THEN 5411 i=INODE 5412 10 CONTINUE 5413 IF ( i > 0 ) THEN 5414 i = FILS_LOAD(i) 5415 GOTO 10 5416 ENDIF 5417 SON=-i 5418 IF(POS_ID.LT.NE_LOAD(STEP_LOAD(INODE))*3)THEN 5419 i=1 5420 ENDIF 5421 DO i=1, NE_LOAD(STEP_LOAD(INODE)) 5422 J=1 5423 DO WHILE (J.LT.POS_ID) 5424 IF(CB_COST_ID(J).EQ.SON)GOTO 295 5425 J=J+3 5426 ENDDO 5427 295 CONTINUE 5428 IF(J.GE.POS_ID)THEN 5429 IF(MUMPS_275( 5430 & PROCNODE_LOAD(STEP_LOAD(INODE)),NPROCS).EQ.MYID)THEN 5431 IF(INODE.EQ.KEEP_LOAD(38))THEN 5432 GOTO 666 5433#if ! defined(OLD_LOAD_MECHANISM) 5434 ELSE 5435 IF(FUTURE_NIV2(MYID+1).NE.0)THEN 5436 WRITE(*,*)MYID,': i did not find ',SON 5437 CALL MUMPS_ABORT() 5438 ENDIF 5439 GOTO 666 5440#endif 5441 ENDIF 5442 ELSE 5443 GOTO 666 5444 ENDIF 5445 ENDIF 5446 NSLAVES_TEMP=CB_COST_ID(J+1) 5447 POS_TEMP=CB_COST_ID(J+2) 5448 DO K=J,POS_ID-1 5449 CB_COST_ID(K)=CB_COST_ID(K+3) 5450 ENDDO 5451 K=POS_TEMP 5452 DO WHILE (K.LE.POS_MEM-1) 5453 CB_COST_MEM(K)=CB_COST_MEM(K+2*NSLAVES_TEMP) 5454 K=K+1 5455 ENDDO 5456 POS_MEM=POS_MEM-2*NSLAVES_TEMP 5457 POS_ID=POS_ID-3 5458 IF((POS_MEM.LT.1).OR.(POS_ID.LT.1))THEN 5459 WRITE(*,*)MYID,': negative pos_mem or pos_id' 5460 CALL MUMPS_ABORT() 5461 ENDIF 5462 666 CONTINUE 5463 SON=FRERE_LOAD(STEP_LOAD(SON)) 5464 ENDDO 5465 ENDIF 5466 END SUBROUTINE CMUMPS_819 5467 SUBROUTINE CMUMPS_820(FLAG) 5468 IMPLICIT NONE 5469 LOGICAL FLAG 5470 INTEGER i 5471 DOUBLE PRECISION MEM 5472 FLAG=.FALSE. 5473 DO i=0,NPROCS-1 5474 MEM=DM_MEM(i)+LU_USAGE(i) 5475 IF(BDC_SBTR)THEN 5476 MEM=MEM+SBTR_MEM(i)-SBTR_CUR(i) 5477 ENDIF 5478 IF((MEM/dble(TAB_MAXS(i))).GT.0.8d0)THEN 5479 FLAG=.TRUE. 5480 GOTO 666 5481 ENDIF 5482 ENDDO 5483 666 CONTINUE 5484 END SUBROUTINE CMUMPS_820 5485 SUBROUTINE CMUMPS_554(NBINSUBTREE,INSUBTREE,NBTOP, 5486 & MIN_COST,SBTR) 5487 IMPLICIT NONE 5488 INTEGER NBINSUBTREE,INSUBTREE,NBTOP 5489 DOUBLE PRECISION MIN_COST 5490 LOGICAL SBTR 5491 INTEGER i 5492 DOUBLE PRECISION TMP_COST,TMP_MIN 5493 TMP_MIN=huge(TMP_MIN) 5494 DO i=0,NPROCS-1 5495 IF(i.NE.MYID)THEN 5496 IF(BDC_SBTR)THEN 5497 TMP_MIN=min(TMP_MIN,dble(TAB_MAXS(i))-(DM_MEM(i)+ 5498 & LU_USAGE(i))-(SBTR_MEM(i)-SBTR_CUR(i))) 5499 ELSE 5500 TMP_MIN=min(TMP_MIN,dble(TAB_MAXS(i))- 5501 & (DM_MEM(i)+LU_USAGE(i))) 5502 ENDIF 5503 ENDIF 5504 ENDDO 5505 IF(NBINSUBTREE.GT.0)THEN 5506 IF(INSUBTREE.EQ.1)THEN 5507 TMP_COST=dble(TAB_MAXS(MYID))-(DM_MEM(MYID)+ 5508 & LU_USAGE(MYID)) 5509 & -(SBTR_MEM(MYID)-SBTR_CUR(MYID)) 5510 ELSE 5511 SBTR=.FALSE. 5512 GOTO 777 5513 ENDIF 5514 ENDIF 5515 TMP_MIN=min(TMP_COST,TMP_MIN) 5516 IF(TMP_MIN.GT.MIN_COST) SBTR=.TRUE. 5517 777 CONTINUE 5518 END SUBROUTINE CMUMPS_554 5519 SUBROUTINE CMUMPS_818(INODE,MAX_MEM,PROC) 5520 IMPLICIT NONE 5521 INTEGER INODE,PROC 5522 INTEGER i,POS,NSLAVES,SLAVE,NCAND,J,NELIM,NCB,NFRONT,SON,K 5523 INTEGER allocok 5524 EXTERNAL MUMPS_330 5525 INTEGER MUMPS_330 5526 DOUBLE PRECISION MAX_MEM 5527 DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE :: MEM_ON_PROCS, 5528 & RECV_BUF 5529 LOGICAL, DIMENSION(:), ALLOCATABLE :: CONCERNED 5530 DOUBLE PRECISION MAX_SENT_MSG 5531#if defined(NOT_ATM_POOL_SPECIAL) 5532 DOUBLE PRECISION TMP 5533#endif 5534 IF((FRERE_LOAD(STEP_LOAD(INODE)).EQ.0) 5535 & .AND.(INODE.EQ.KEEP_LOAD(38)))THEN 5536 RETURN 5537 ENDIF 5538#if defined(NOT_ATM_POOL_SPECIAL) 5539 IF((INODE.LT.0).OR.(INODE.GT.N_LOAD))THEN 5540 MAX_MEM=huge(MAX_MEM) 5541 DO i=0,NPROCS-1 5542 TMP=dble(TAB_MAXS(i))-(DM_MEM(i)+LU_USAGE(i)) 5543 IF(BDC_SBTR)THEN 5544 TMP=TMP-(SBTR_MEM(i)-SBTR_CUR(i)) 5545 ENDIF 5546 MAX_MEM=min(MAX_MEM,TMP) 5547 ENDDO 5548 RETURN 5549 ENDIF 5550#endif 5551 ALLOCATE( MEM_ON_PROCS(0:NPROCS-1), stat=allocok) 5552 IF ( allocok > 0 ) THEN 5553 WRITE(*,*) 'PB allocation in CMUMPS_818' 5554 CALL MUMPS_ABORT() 5555 ENDIF 5556 ALLOCATE( CONCERNED(0:NPROCS-1), stat=allocok) 5557 IF ( allocok > 0 ) THEN 5558 WRITE(*,*) 'PB allocation in CMUMPS_818' 5559 CALL MUMPS_ABORT() 5560 ENDIF 5561 ALLOCATE( RECV_BUF(0:NPROCS-1), stat=allocok) 5562 IF ( allocok > 0 ) THEN 5563 WRITE(*,*) 'PB allocation in CMUMPS_818' 5564 CALL MUMPS_ABORT() 5565 ENDIF 5566 RECV_BUF=dble(0) 5567 MAX_SENT_MSG=dble(0) 5568 i = INODE 5569 NELIM = 0 5570 10 CONTINUE 5571 IF ( i > 0 ) THEN 5572 NELIM = NELIM + 1 5573 i = FILS_LOAD(i) 5574 GOTO 10 5575 ENDIF 5576 SON=-i 5577 NFRONT=ND_LOAD(STEP_LOAD(INODE)) + KEEP_LOAD(253) 5578 NCB=NFRONT-NELIM 5579 IF(MUMPS_330(PROCNODE_LOAD(STEP_LOAD(INODE)), 5580 & NPROCS).EQ.2)THEN 5581 NCAND=CAND_LOAD(NPROCS+1, STEP_TO_NIV2_LOAD(STEP_LOAD(INODE))) 5582 ENDIF 5583 DO i=0,NPROCS-1 5584 IF(i.EQ.MYID)THEN 5585 MEM_ON_PROCS(i)=dble(TAB_MAXS(i))-(DM_MEM(i)+ 5586 & LU_USAGE(i)+ 5587 & CMUMPS_543(INODE)) 5588 IF(BDC_SBTR)THEN 5589 MEM_ON_PROCS(i)=MEM_ON_PROCS(i)-(SBTR_MEM(i)-SBTR_CUR(i)) 5590 ENDIF 5591 CONCERNED(i)=.TRUE. 5592 ELSE 5593 MEM_ON_PROCS(i)=dble(TAB_MAXS(i))-(DM_MEM(i)+LU_USAGE(i)) 5594 IF(BDC_SBTR)THEN 5595 MEM_ON_PROCS(i)=MEM_ON_PROCS(i)-(SBTR_MEM(i)-SBTR_CUR(i)) 5596 ENDIF 5597 IF(BDC_M2_MEM)THEN 5598 MEM_ON_PROCS(i)=MEM_ON_PROCS(i)-NIV2(i+1) 5599 ENDIF 5600 ENDIF 5601 IF(MUMPS_330(PROCNODE_LOAD(STEP_LOAD(INODE)), 5602 & NPROCS).EQ.2)THEN 5603 IF(BDC_MD.AND.(KEEP_LOAD(48).EQ.5))THEN 5604 DO J=1,NCAND 5605 IF(CAND_LOAD(J, STEP_TO_NIV2_LOAD(STEP_LOAD(INODE))) 5606 & .EQ.i)THEN 5607 MEM_ON_PROCS(i)=MEM_ON_PROCS(i)- 5608 & ((dble(NFRONT)*dble(NCB))/dble(NCAND)) 5609 CONCERNED(i)=.TRUE. 5610 GOTO 666 5611 ENDIF 5612 ENDDO 5613 ENDIF 5614 ENDIF 5615 666 CONTINUE 5616 ENDDO 5617 DO K=1, NE_LOAD(STEP_LOAD(INODE)) 5618 i=1 5619 DO WHILE (i.LE.POS_ID) 5620 IF(CB_COST_ID(i).EQ.SON)GOTO 295 5621 i=i+3 5622 ENDDO 5623 295 CONTINUE 5624 IF(i.GE.POS_ID)THEN 5625#if ! defined(OLD_LOAD_MECHANISM) 5626 IF(FUTURE_NIV2(MYID+1).NE.0)THEN 5627 WRITE(*,*)MYID,': ',SON,'has not been found 5628 & in CMUMPS_818' 5629 CALL MUMPS_ABORT() 5630 ENDIF 5631#endif 5632 GOTO 777 5633 ENDIF 5634 NSLAVES=CB_COST_ID(i+1) 5635 POS=CB_COST_ID(i+2) 5636 DO i=1,NSLAVES 5637 SLAVE=int(CB_COST_MEM(POS)) 5638 IF(.NOT.CONCERNED(SLAVE))THEN 5639 MEM_ON_PROCS(SLAVE)=MEM_ON_PROCS(SLAVE)+ 5640 & dble(CB_COST_MEM(POS+1)) 5641 ENDIF 5642 DO J=0,NPROCS-1 5643 IF(CONCERNED(J))THEN 5644 IF(SLAVE.NE.J)THEN 5645 RECV_BUF(J)=max(RECV_BUF(J), 5646 & dble(CB_COST_MEM(POS+1))) 5647 ENDIF 5648 ENDIF 5649 ENDDO 5650 POS=POS+2 5651 ENDDO 5652 777 CONTINUE 5653 SON=FRERE_LOAD(STEP_LOAD(SON)) 5654 ENDDO 5655 MAX_MEM=huge(MAX_MEM) 5656 WRITE(*,*)'NPROCS=',NPROCS,MAX_MEM 5657 DO i=0,NPROCS-1 5658 IF(MAX_MEM.GT.MEM_ON_PROCS(i))THEN 5659 PROC=i 5660 ENDIF 5661 MAX_MEM=min(MEM_ON_PROCS(i),MAX_MEM) 5662 ENDDO 5663 DEALLOCATE(MEM_ON_PROCS) 5664 DEALLOCATE(CONCERNED) 5665 DEALLOCATE(RECV_BUF) 5666 END SUBROUTINE CMUMPS_818 5667 SUBROUTINE CMUMPS_553(MIN_PROC,POOL, 5668 & LPOOL,INODE) 5669 IMPLICIT NONE 5670 INTEGER INODE,LPOOL,MIN_PROC 5671 INTEGER POOL(LPOOL) 5672 EXTERNAL MUMPS_275 5673 INTEGER MUMPS_275 5674 INTEGER i,NBTOP,INSUBTREE,NBINSUBTREE,NODE,FATHER,SON,J 5675 INTEGER SBTR_NB_LEAF,POS,K,allocok,L 5676 INTEGER, ALLOCATABLE, DIMENSION (:) :: TMP_SBTR 5677 NBINSUBTREE = POOL(LPOOL) 5678 NBTOP = POOL(LPOOL - 1) 5679 INSUBTREE = POOL(LPOOL - 2) 5680 IF((KEEP_LOAD(47).EQ.4).AND. 5681 & ((NBINSUBTREE.NE.0)))THEN 5682 DO J=INDICE_SBTR,NB_SUBTREES 5683 NODE=MY_ROOT_SBTR(J) 5684 FATHER=DAD_LOAD(STEP_LOAD(NODE)) 5685 i=FATHER 5686 110 CONTINUE 5687 IF ( i > 0 ) THEN 5688 i = FILS_LOAD(i) 5689 GOTO 110 5690 ENDIF 5691 SON=-i 5692 i=SON 5693 120 CONTINUE 5694 IF ( i > 0 ) THEN 5695 IF(MUMPS_275(PROCNODE_LOAD(STEP_LOAD(i)),NPROCS).EQ. 5696 & MIN_PROC)THEN 5697 SBTR_NB_LEAF=MY_NB_LEAF(J) 5698 POS=SBTR_FIRST_POS_IN_POOL(J) 5699 IF(POOL(POS+SBTR_NB_LEAF).NE.MY_FIRST_LEAF(J))THEN 5700 WRITE(*,*)MYID,': The first leaf is not ok' 5701 CALL MUMPS_ABORT() 5702 ENDIF 5703 ALLOCATE (TMP_SBTR(SBTR_NB_LEAF), stat=allocok) 5704 IF (allocok > 0 ) THEN 5705 WRITE(*,*)MYID,': Not enough space 5706 & for allocation' 5707 CALL MUMPS_ABORT() 5708 ENDIF 5709 POS=SBTR_FIRST_POS_IN_POOL(J) 5710 DO K=1,SBTR_NB_LEAF 5711 TMP_SBTR(K)=POOL(POS+K-1) 5712 ENDDO 5713 DO K=POS+1,NBINSUBTREE-SBTR_NB_LEAF 5714 POOL(K)=POOL(K+SBTR_NB_LEAF) 5715 ENDDO 5716 POS=1 5717 DO K=NBINSUBTREE-SBTR_NB_LEAF+1,NBINSUBTREE 5718 POOL(K)=TMP_SBTR(POS) 5719 POS=POS+1 5720 ENDDO 5721 DO K=INDICE_SBTR,J 5722 SBTR_FIRST_POS_IN_POOL(K)=SBTR_FIRST_POS_IN_POOL(K) 5723 & -SBTR_FIRST_POS_IN_POOL(J) 5724 ENDDO 5725 SBTR_FIRST_POS_IN_POOL(J)=NBINSUBTREE-SBTR_NB_LEAF 5726 POS=MY_FIRST_LEAF(J) 5727 L=MY_NB_LEAF(J) 5728 DO K=INDICE_SBTR,J 5729 MY_FIRST_LEAF(J)=MY_FIRST_LEAF(J+1) 5730 MY_NB_LEAF(J)=MY_NB_LEAF(J+1) 5731 ENDDO 5732 MY_FIRST_LEAF(INDICE_SBTR)=POS 5733 MY_NB_LEAF(INDICE_SBTR)=L 5734 INODE=POOL(NBINSUBTREE) 5735 DEALLOCATE(TMP_SBTR) 5736 RETURN 5737 ENDIF 5738 i = FRERE_LOAD(STEP_LOAD(i)) 5739 GOTO 120 5740 ENDIF 5741 ENDDO 5742 ENDIF 5743 DO J=NBTOP,1,-1 5744#if defined(NOT_ATM_POOL_SPECIAL) 5745 IF ( POOL(LPOOL-2-J) < 0 ) THEN 5746 NODE=-POOL(LPOOL-2-J) 5747 ELSE IF ( POOL(LPOOL-2-J) > N_LOAD ) THEN 5748 NODE = POOL(LPOOL-2-J) - N_LOAD 5749 ELSE 5750 NODE = POOL(LPOOL-2-J) 5751 ENDIF 5752#else 5753 NODE=POOL(LPOOL-2-J) 5754#endif 5755 FATHER=DAD_LOAD(STEP_LOAD(NODE)) 5756 i=FATHER 5757 11 CONTINUE 5758 IF ( i > 0 ) THEN 5759 i = FILS_LOAD(i) 5760 GOTO 11 5761 ENDIF 5762 SON=-i 5763 i=SON 5764 12 CONTINUE 5765 IF ( i > 0 ) THEN 5766 IF(MUMPS_275(PROCNODE_LOAD(STEP_LOAD(i)),NPROCS).EQ. 5767 & MIN_PROC)THEN 5768 INODE=NODE 5769 RETURN 5770 ENDIF 5771 i = FRERE_LOAD(STEP_LOAD(i)) 5772 GOTO 12 5773 ENDIF 5774 ENDDO 5775 END SUBROUTINE CMUMPS_553 5776 SUBROUTINE CMUMPS_555(POOL, LPOOL,KEEP,KEEP8) 5777 IMPLICIT NONE 5778 INTEGER LPOOL,POOL(LPOOL),KEEP(500) 5779 INTEGER(8) KEEP8(150) 5780 INTEGER i,POS 5781 EXTERNAL MUMPS_283 5782 LOGICAL MUMPS_283 5783 IF(.NOT.BDC_SBTR) RETURN 5784 POS=0 5785 DO i=NB_SUBTREES,1,-1 5786 DO WHILE(MUMPS_283( 5787 & PROCNODE_LOAD(STEP_LOAD(POOL(POS+1))), 5788 & NPROCS)) 5789 POS=POS+1 5790 ENDDO 5791 SBTR_FIRST_POS_IN_POOL(i)=POS+1 5792 POS=POS+MY_NB_LEAF(i) 5793 ENDDO 5794 END SUBROUTINE CMUMPS_555 5795 END MODULE CMUMPS_LOAD 5796