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