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 ZMUMPS_FAC_ASM_MASTER_ELT_M 14 CONTAINS 15 SUBROUTINE ZMUMPS_FAC_ASM_NIV1_ELT( COMM_LOAD, ASS_IRECV, 16 & NELT, FRT_PTR, FRT_ELT, 17 & N, INODE, IW, LIW, A, LA, INFO, ND, 18 & FILS, FRERE, DAD, MAXFRW, root, 19 & OPASSW, OPELIW, PTRIST, PTLUST, PTRFAC, PTRAST, 20 & STEP, PIMASTER, PAMASTER,PTRARW, 21 & PTRAIW, ITLOC, RHS_MUMPS, NSTEPS, SON_LEVEL2, 22 & COMP, LRLU, IPTRLU, IWPOS, IWPOSCB, POSFAC, LRLUS, 23 & ICNTL, KEEP,KEEP8,DKEEP,INTARR,LINTARR,DBLARR,LDBLARR, 24 & 25 & NSTK_S,NBPROCFILS, PROCNODE_STEPS, SLAVEF, COMM,MYID, 26 & BUFR, LBUFR, LBUFR_BYTES, NBFIN, IPOOL, LPOOL, LEAF, 27 & PERM, 28 & ISTEP_TO_INIV2, TAB_POS_IN_PERE 29 & , LRGROUPS 30 & ) 31!$ USE OMP_LIB 32 USE MUMPS_BUILD_SORT_INDEX_ELT_M 33 USE ZMUMPS_BUF 34 USE ZMUMPS_LOAD 35 USE ZMUMPS_LR_CORE, ONLY : IS_FRONT_BLR_CANDIDATE 36 IMPLICIT NONE 37 INCLUDE 'zmumps_root.h' 38 TYPE (ZMUMPS_ROOT_STRUC) :: root 39 INTEGER COMM_LOAD, ASS_IRECV 40 INTEGER IZERO 41 PARAMETER (IZERO=0) 42 INTEGER N,LIW,NSTEPS 43 INTEGER NELT 44 INTEGER(8) LA, LRLU, LRLUS, IPTRLU, POSFAC 45 INTEGER KEEP(500), ICNTL(40) 46 INTEGER(8) KEEP8(150) 47 DOUBLE PRECISION DKEEP(230) 48 INTEGER, INTENT(INOUT) :: INFO(2) 49 INTEGER INODE,MAXFRW, 50 & IWPOSCB, COMP 51 INTEGER, TARGET :: IWPOS 52 INTEGER IDUMMY(1) 53 INTEGER, PARAMETER :: LIDUMMY = 1 54 INTEGER, TARGET :: IW(LIW) 55 INTEGER(8), INTENT(IN) :: PTRARW(NELT+1), PTRAIW(NELT+1) 56 INTEGER ITLOC(N+KEEP(253)), 57 & ND(KEEP(28)), PERM(N), 58 & FILS(N), FRERE(KEEP(28)), DAD(KEEP(28)), 59 & PTRIST(KEEP(28)), PTLUST(KEEP(28)), 60 & STEP(N), PIMASTER(KEEP(28)) 61 COMPLEX(kind=8) :: RHS_MUMPS(KEEP(255)) 62 INTEGER(8) :: PTRFAC(KEEP(28)), PTRAST(KEEP(28)), 63 & PAMASTER(KEEP(28)) 64 INTEGER COMM, NBFIN, SLAVEF, MYID 65 INTEGER ISTEP_TO_INIV2(KEEP(71)), 66 & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) 67 LOGICAL SON_LEVEL2 68 COMPLEX(kind=8), TARGET :: A(LA) 69 INTEGER, INTENT(IN) :: LRGROUPS(N) 70 DOUBLE PRECISION OPASSW, OPELIW 71 INTEGER FRT_PTR(N+1), FRT_ELT(NELT) 72 INTEGER(8), INTENT(IN) :: LINTARR, LDBLARR 73 COMPLEX(kind=8) DBLARR(LDBLARR) 74 INTEGER INTARR(LINTARR) 75 INTEGER LPOOL, LEAF 76 INTEGER LBUFR, LBUFR_BYTES 77 INTEGER IPOOL( LPOOL ) 78 INTEGER NBPROCFILS(KEEP(28)), NSTK_S(KEEP(28)) 79 INTEGER PROCNODE_STEPS(KEEP(28)) 80 INTEGER BUFR( LBUFR ) 81 INTEGER ETATASS 82 LOGICAL COMPRESSCB 83 INTEGER(8) :: LCB 84 INTEGER MUMPS_TYPENODE 85 EXTERNAL MUMPS_TYPENODE 86 INCLUDE 'mpif.h' 87 INTEGER :: IERR 88 INTEGER :: STATUS(MPI_STATUS_SIZE) 89!$ INTEGER :: NOMP 90 INCLUDE 'mumps_headers.h' 91 INTEGER LP, HS, HF 92 LOGICAL LPOK 93 INTEGER NBPANELS_L, NBPANELS_U 94 INTEGER IN,NUMSTK,NASS,ISON,IFSON,NASS1,IELL 95 INTEGER NFS4FATHER 96 INTEGER(8) NFRONT8, LAELL8 97 INTEGER NFRONT,NFRONT_EFF,ISTCHK,LSTK,LREQ 98 INTEGER LREQ_OOC 99 INTEGER(8) LSTK8, SIZFR8 100 INTEGER SIZFI, NCB 101 INTEGER :: J253 102#if ! defined(ZERO_TRIANGLE) 103 INTEGER(8) :: NUMROWS, JJ3 104#endif 105 INTEGER :: TOPDIAG 106!$ INTEGER :: CHUNK 107!$ INTEGER(8) :: CHUNK8 108 INTEGER(8) APOS, APOS2, LAPOS2 109 INTEGER(8) POSELT, POSEL1, ICT12, ICT21 110 INTEGER(8) IACHK 111 INTEGER(8) JJ2 112 INTEGER(8) :: JJ8, J18, J28 113 INTEGER(8) :: AINPUT8, AII8 114 INTEGER :: K1, K2, K3, KK, KK1 115 INTEGER NCOLS, NROWS, LDA_SON 116 INTEGER NELIM, 117 & IORG, IBROT 118 INTEGER JPOS,ICT11, IJROW 119 INTEGER Pos_First_NUMORG,NUMORG,IOLDPS, 120 & NUMELT, ELBEG 121 INTEGER :: J 122 INTEGER NSLAVES, NSLSON, NPIVS, NPIV_ANA, NPIV 123 INTEGER PTRCOL, ISLAVE, PDEST,LEVEL 124 LOGICAL LEVEL1, NIV1 125 INTEGER TROW_SIZE, INDX, FIRST_INDEX, SHIFT_INDEX 126 INTEGER ELTI 127 INTEGER(8) :: SIZE_ELTI8 128 INTEGER(8) :: II8 129 INTEGER :: I 130 LOGICAL BLOCKING, SET_IRECV, MESSAGE_RECEIVED 131 INTEGER, POINTER :: SON_IWPOS 132 INTEGER, POINTER, DIMENSION(:) :: SON_IW 133 COMPLEX(kind=8), POINTER, DIMENSION(:) :: SON_A 134 INTEGER NCBSON 135 LOGICAL SAME_PROC 136 INTRINSIC real 137 COMPLEX(kind=8) ZERO 138 PARAMETER( ZERO = (0.0D0,0.0D0) ) 139 LOGICAL MUMPS_INSSARBR, SSARBR 140 EXTERNAL MUMPS_INSSARBR 141 DOUBLE PRECISION FLOP1,FLOP1_EFF 142 EXTERNAL MUMPS_IN_OR_ROOT_SSARBR 143 LOGICAL MUMPS_IN_OR_ROOT_SSARBR 144!$ NOMP = OMP_GET_MAX_THREADS() 145 LP = ICNTL(1) 146 LPOK = ((LP.GT.0).AND.(ICNTL(4).GE.1)) 147 NFS4FATHER = -1 148 ETATASS = 0 149 COMPRESSCB =.FALSE. 150 IN = INODE 151 NBPROCFILS(STEP(IN)) = 0 152 LEVEL = MUMPS_TYPENODE(PROCNODE_STEPS(STEP(INODE)),SLAVEF) 153 IF (LEVEL.NE.1) THEN 154 WRITE(*,*) 'INTERNAL ERROR 1 in ZMUMPS_FAC_ASM_NIV1_ELT ' 155 CALL MUMPS_ABORT() 156 END IF 157 NSLAVES = 0 158 HF = 6 + NSLAVES + KEEP(IXSZ) 159 NUMELT = FRT_PTR(INODE+1) - FRT_PTR(INODE) 160 IF ( NUMELT .ne. 0 ) THEN 161 ELBEG = FRT_PTR(INODE) 162 ELSE 163 ELBEG = 1 164 END IF 165 NUMORG = 0 166 DO WHILE (IN.GT.0) 167 NUMORG = NUMORG + 1 168 IN = FILS(IN) 169 END DO 170 NPIV_ANA=NUMORG 171 NSTEPS = NSTEPS + 1 172 NUMSTK = 0 173 NASS = 0 174 IFSON = -IN 175 ISON = IFSON 176 IF (ISON .NE. 0) THEN 177 DO WHILE (ISON .GT. 0) 178 NUMSTK = NUMSTK + 1 179 SON_IW => IW 180 NASS = NASS + SON_IW(PIMASTER(STEP(ISON))+1+KEEP(IXSZ)) 181 ISON = FRERE(STEP(ISON)) 182 END DO 183 ENDIF 184 NFRONT = ND(STEP(INODE)) + NASS + KEEP(253) 185 NASS1 = NASS + NUMORG 186 LREQ_OOC = 0 187 IF (KEEP(201).EQ.1) THEN 188 CALL ZMUMPS_OOC_GET_PP_SIZES(KEEP(50), NFRONT, NFRONT, NASS1, 189 & NBPANELS_L, NBPANELS_U, LREQ_OOC) 190 ENDIF 191 LREQ = HF + 2 * NFRONT + LREQ_OOC 192 IF ((IWPOS + LREQ -1) .GT. IWPOSCB) THEN 193 CALL ZMUMPS_COMPRE_NEW(N, KEEP(28), 194 & IW, LIW, A, LA, 195 & LRLU, IPTRLU, 196 & IWPOS, IWPOSCB, PTRIST, PTRAST, 197 & STEP, PIMASTER, PAMASTER, KEEP(216),LRLUS, 198 & KEEP(IXSZ), COMP, DKEEP(97), MYID) 199 IF (LRLU .NE. LRLUS) THEN 200 WRITE( *, * ) 'PB compress ZMUMPS_FAC_ASM_NIV1_ELT' 201 WRITE( *, * ) 'LRLU,LRLUS=',LRLU,LRLUS 202 GOTO 270 203 END IF 204 IF ((IWPOS + LREQ -1) .GT. IWPOSCB) GOTO 270 205 END IF 206 IOLDPS = IWPOS 207 IWPOS = IWPOS + LREQ 208 NIV1 = .TRUE. 209 CALL MUMPS_ELT_BUILD_SORT( 210 & NUMELT, FRT_ELT(ELBEG), 211 & MYID, INODE, N, IOLDPS, HF, 212 & NFRONT, NFRONT_EFF, PERM, 213 & NASS1, NASS, NUMSTK, NUMORG, IWPOSCB, 214 & IFSON, STEP, PIMASTER, PTRIST, PTRAIW, NELT, IW, LIW, 215 & INTARR, LINTARR, ITLOC, FILS, FRERE, 216 & KEEP, 217 & SON_LEVEL2, NIV1, NBPROCFILS, INFO(1), 218 & DAD,PROCNODE_STEPS, SLAVEF, 219 & FRT_PTR, FRT_ELT, Pos_First_NUMORG, 220 & IDUMMY, LIDUMMY 221 & ) 222 IF (INFO(1).LT.0) GOTO 300 223 IF (NFRONT_EFF.NE.NFRONT) THEN 224 IF (NFRONT.GT.NFRONT_EFF) THEN 225 IF(MUMPS_IN_OR_ROOT_SSARBR(PROCNODE_STEPS(STEP(INODE)), 226 & SLAVEF))THEN 227 NPIV=NASS1-(NFRONT_EFF-ND(STEP(INODE))) 228 CALL MUMPS_GET_FLOPS_COST(ND(STEP(INODE))+KEEP(253), 229 & NPIV,NPIV, 230 & KEEP(50),1,FLOP1) 231 NPIV=NPIV_ANA 232 CALL MUMPS_GET_FLOPS_COST(ND(STEP(INODE))+KEEP(253), 233 & NPIV,NPIV, 234 & KEEP(50),1,FLOP1_EFF) 235 CALL ZMUMPS_LOAD_UPDATE(0,.FALSE.,FLOP1-FLOP1_EFF, 236 & KEEP,KEEP8) 237 ENDIF 238 IWPOS = IWPOS - ((2*NFRONT)-(2*NFRONT_EFF)) 239 NFRONT = NFRONT_EFF 240 LREQ = HF + 2 * NFRONT + LREQ_OOC 241 ELSE 242 IF (LPOK) THEN 243 WRITE(LP,*) 244 & ' ERROR 1 during ass_niv1_ELT', NFRONT, NFRONT_EFF 245 ENDIF 246 GOTO 270 247 ENDIF 248 ENDIF 249 IF (KEEP(201).EQ.1.AND.KEEP(50).NE.1) THEN 250 CALL ZMUMPS_OOC_PP_SET_PTR(KEEP(50), 251 & NBPANELS_L, NBPANELS_U, NASS1, 252 & IOLDPS + HF + 2 * NFRONT, IW, LIW) 253 ENDIF 254 NCB = NFRONT - NASS1 255 MAXFRW = max0(MAXFRW, NFRONT) 256 ICT11 = IOLDPS + HF - 1 + NFRONT 257 NFRONT8=int(NFRONT,8) 258 LAELL8 = NFRONT8 * NFRONT8 259 IF (LRLU .LT. LAELL8) THEN 260 IF (LRLUS .LT. LAELL8) THEN 261 GOTO 280 262 ELSE 263 CALL ZMUMPS_COMPRE_NEW(N, KEEP(28), IW, LIW, A, LA, 264 & LRLU, IPTRLU, 265 & IWPOS, IWPOSCB, PTRIST, PTRAST, 266 & STEP, PIMASTER, PAMASTER, KEEP(216),LRLUS, 267 & KEEP(IXSZ), COMP, DKEEP(97),MYID) 268 IF (LRLU .NE. LRLUS) THEN 269 IF (LPOK) THEN 270 WRITE(LP, * ) 'PB compress ZMUMPS_FAC_ASM_NIV1_ELT' 271 WRITE(LP, * ) 'LRLU,LRLUS=',LRLU,LRLUS 272 ENDIF 273 GOTO 280 274 END IF 275 END IF 276 END IF 277 LRLU = LRLU - LAELL8 278 LRLUS = LRLUS - LAELL8 279 KEEP8(67) = min(LRLUS, KEEP8(67)) 280 KEEP8(70) = KEEP8(70) - LAELL8 281 KEEP8(68) = min(KEEP8(70), KEEP8(68)) 282 KEEP8(71) = KEEP8(71) - LAELL8 283 KEEP8(69) = min(KEEP8(71), KEEP8(69)) 284 POSELT = POSFAC 285 POSFAC = POSFAC + LAELL8 286 SSARBR=MUMPS_INSSARBR(PROCNODE_STEPS(STEP(INODE)),SLAVEF) 287 CALL ZMUMPS_LOAD_MEM_UPDATE(SSARBR,.FALSE., 288 & LA-LRLUS, 289 & 0_8, 290 & LAELL8, 291 & KEEP,KEEP8, 292 & LRLUS) 293#if defined(ZERO_TRIANGLE) 294 LAPOS2 = POSELT + LAELL8 - 1_8 295 A(POSELT:LAPOS2) = ZERO 296#else 297 IF ( KEEP(50) .eq. 0 .OR. NFRONT .LT. KEEP(63) ) THEN 298 LAPOS2 = POSELT + LAELL8 - 1_8 299!$ CHUNK8=3000 300!$OMP PARALLEL DO PRIVATE(JJ8) SCHEDULE(STATIC, CHUNK8) 301!$OMP& IF (LAPOS2 - POSELT > int(KEEP(361),8) .AND. NOMP .GT. 1) 302 DO JJ8 = POSELT, LAPOS2 303 A( JJ8 ) = ZERO 304 ENDDO 305!$OMP END PARALLEL DO 306 ELSE 307 NUMROWS = NFRONT8 308 TOPDIAG = max(KEEP(7), KEEP(8), KEEP(57), KEEP(58))-1 309!$ CHUNK = max(KEEP(360)/2, 310!$ & ( ((int(NUMROWS)+NOMP-1) / NOMP + 2) / 3) ) 311!$OMP PARALLEL DO PRIVATE(APOS,JJ3) SCHEDULE(STATIC, CHUNK ) 312!$OMP& IF (int(NUMROWS - 1) .GT. KEEP(360) .AND. NOMP .GT. 1) 313 DO JJ8 = 0_8, NUMROWS - 1_8 314 APOS = POSELT + JJ8 * NFRONT8 315 JJ3 = min( NFRONT8 - 1_8, JJ8 + TOPDIAG ) 316 A(APOS:APOS + JJ3) = ZERO 317 ENDDO 318!$OMP END PARALLEL DO 319 END IF 320#endif 321 NASS = NASS1 322 PTRAST(STEP(INODE)) = POSELT 323 PTRFAC(STEP(INODE)) = POSELT 324 PTLUST(STEP(INODE)) = IOLDPS 325 IW(IOLDPS+XXI) = LREQ 326 CALL MUMPS_STOREI8(LAELL8,IW(IOLDPS+XXR)) 327 IW(IOLDPS+XXS) = -9999 328 IW(IOLDPS+XXN) = -99999 329 IW(IOLDPS+XXP) = -99999 330 IW(IOLDPS+XXA) = -99999 331 IW(IOLDPS+XXF) = -99999 332 IW(IOLDPS+XXLR)= -99999 333 CALL IS_FRONT_BLR_CANDIDATE(INODE, NFRONT, NASS1, KEEP(486), 334 & KEEP(489), KEEP(490), KEEP(491), KEEP(492), N, LRGROUPS, 335 & IW(IOLDPS+XXLR)) 336#if defined(NO_XXNBPR) 337 IW(IOLDPS+XXNBPR)=-99999 338#else 339 CALL CHECK_EQUAL(NBPROCFILS(STEP(INODE)),IW(IOLDPS+XXNBPR)) 340#endif 341 IW(IOLDPS + KEEP(IXSZ)) = NFRONT 342 IW(IOLDPS + KEEP(IXSZ)+ 1) = 0 343 IW(IOLDPS + KEEP(IXSZ) + 2) = -NASS1 344 IW(IOLDPS + KEEP(IXSZ) + 3) = -NASS1 345 IW(IOLDPS + KEEP(IXSZ) + 4) = STEP(INODE) 346 IW(IOLDPS + KEEP(IXSZ) + 5) = NSLAVES 347 IF (NUMSTK.NE.0) THEN 348 ISON = IFSON 349 DO 220 IELL = 1, NUMSTK 350 ISTCHK = PIMASTER(STEP(ISON)) 351 SON_IW => IW 352 SON_IWPOS => IWPOS 353 SON_A => A 354 LSTK = SON_IW(ISTCHK + KEEP(IXSZ)) 355 LSTK8 = int(LSTK,8) 356 NELIM = SON_IW(ISTCHK + 1+KEEP(IXSZ)) 357 NPIVS = SON_IW(ISTCHK + 3+KEEP(IXSZ)) 358 IF ( NPIVS .LT. 0 ) NPIVS = 0 359 NSLSON = SON_IW(ISTCHK + KEEP(IXSZ) + 5) 360 HS = 6 + KEEP(IXSZ) + NSLSON 361 NCOLS = NPIVS + LSTK 362 SAME_PROC = (ISTCHK.LT.SON_IWPOS) 363 IF ( SAME_PROC ) THEN 364 COMPRESSCB = 365 & ( SON_IW(PTRIST(STEP(ISON))+XXS) .EQ. S_CB1COMP ) 366 ELSE 367 COMPRESSCB = ( SON_IW(ISTCHK + XXS) .EQ. S_CB1COMP ) 368 ENDIF 369 LEVEL1 = NSLSON.EQ.0 370 IF (.NOT.SAME_PROC) THEN 371 NROWS = SON_IW( ISTCHK + KEEP(IXSZ) + 2) 372 ELSE 373 NROWS = NCOLS 374 ENDIF 375 SIZFI = HS + NROWS + NCOLS 376 K1 = ISTCHK + HS + NROWS + NPIVS 377 IF ( .NOT. LEVEL1 .AND. NELIM.EQ.0 ) GOTO 205 378 IF (LEVEL1) THEN 379 K2 = K1 + LSTK - 1 380 IF (COMPRESSCB) THEN 381 SIZFR8 = (LSTK8*(LSTK8+1_8)/2_8) 382 ELSE 383 SIZFR8 = LSTK8*LSTK8 384 ENDIF 385 ELSE 386 IF ( KEEP(50).eq.0 ) THEN 387 SIZFR8 = int(NELIM,8) * LSTK8 388 ELSE 389 SIZFR8 = int(NELIM,8) * int(NELIM,8) 390 END IF 391 K2 = K1 + NELIM - 1 392 ENDIF 393 OPASSW = OPASSW + dble(SIZFR8) 394 IACHK = PAMASTER(STEP(ISON)) 395 IF ( KEEP(50) .eq. 0 ) THEN 396 POSEL1 = PTRAST(STEP(INODE)) - NFRONT8 397 IF (K2.GE.K1) THEN 398 DO 170 KK = K1, K2 399 APOS = POSEL1 + int(SON_IW(KK),8) * NFRONT8 400 DO 160 KK1 = 1, LSTK 401 JJ2 = APOS + int(SON_IW(K1 + KK1 - 1) - 1,8) 402 A(JJ2) = A(JJ2) + SON_A(IACHK + int(KK1 - 1,8)) 403 160 CONTINUE 404 IACHK = IACHK + LSTK8 405 170 CONTINUE 406 END IF 407 ELSE 408 IF (LEVEL1) THEN 409 LDA_SON = LSTK 410 ELSE 411 LDA_SON = NELIM 412 ENDIF 413 IF (COMPRESSCB) THEN 414 LCB = SIZFR8 415 ELSE 416 LCB = int(LDA_SON,8) * int(K2-K1+1,8) 417 ENDIF 418 IF (LCB .GT. 0) THEN 419 CALL ZMUMPS_LDLT_ASM_NIV12(A, LA, SON_A(IACHK), 420 & PTRAST(STEP( INODE )), NFRONT, NASS1, 421 & LDA_SON, LCB, 422 & SON_IW( K1 ), K2 - K1 + 1, NELIM, ETATASS, 423 & COMPRESSCB 424 & ) 425 ENDIF 426 ENDIF 427 205 IF (LEVEL1) THEN 428 IF (SAME_PROC) ISTCHK = PTRIST(STEP(ISON)) 429 IF (SAME_PROC) THEN 430 IF (KEEP(50).NE.0) THEN 431 K2 = K1 + LSTK - 1 432 DO KK = K1, K2 433 SON_IW(KK) = SON_IW(KK - NROWS) 434 ENDDO 435 ELSE 436 K2 = K1 + LSTK - 1 437 K3 = K1 + NELIM 438 DO KK = K3, K2 439 SON_IW(KK) = SON_IW(KK - NROWS) 440 ENDDO 441 IF (NELIM .NE. 0) THEN 442 K3 = K3 - 1 443 DO KK = K1, K3 444 JPOS = SON_IW(KK) + ICT11 445 SON_IW(KK) = IW(JPOS) 446 ENDDO 447 ENDIF 448 ENDIF 449 ENDIF 450 IF ( SAME_PROC ) THEN 451 PTRIST(STEP( ISON )) = -99999999 452 ELSE 453 PIMASTER(STEP( ISON )) = -99999999 454 ENDIF 455 CALL ZMUMPS_FREE_BLOCK_CB(SSARBR, MYID, N, ISTCHK, 456 & IACHK, 457 & IW, LIW, LRLU, LRLUS, IPTRLU, 458 & IWPOSCB, LA, KEEP,KEEP8, .FALSE. 459 & ) 460 ELSE 461 PDEST = ISTCHK + 6 + KEEP(IXSZ) 462 NCBSON = LSTK - NELIM 463 PTRCOL = ISTCHK + HS + NROWS + NPIVS + NELIM 464 DO ISLAVE = 0, NSLSON-1 465 IF (IW(PDEST+ISLAVE).EQ.MYID) THEN 466 CALL MUMPS_BLOC2_GET_SLAVE_INFO( 467 & KEEP,KEEP8, ISON, STEP, N, SLAVEF, 468 & ISTEP_TO_INIV2, TAB_POS_IN_PERE, 469 & ISLAVE+1, NCBSON, 470 & NSLSON, 471 & TROW_SIZE, FIRST_INDEX ) 472 SHIFT_INDEX = FIRST_INDEX - 1 473 INDX = PTRCOL + SHIFT_INDEX 474 CALL ZMUMPS_MAPLIG( COMM_LOAD, ASS_IRECV, 475 & BUFR, LBUFR, LBUFR_BYTES, 476 & INODE, ISON, NSLAVES, IDUMMY, 477 & NFRONT, NASS1,NFS4FATHER, 478 & TROW_SIZE, IW( INDX ), 479 & PROCNODE_STEPS, 480 & SLAVEF, POSFAC, IWPOS, IWPOSCB, IPTRLU, LRLU, 481 & LRLUS, N, IW, 482 & LIW, A, LA, 483 & PTRIST, PTLUST, PTRFAC, PTRAST, STEP, 484 & PIMASTER, PAMASTER, NSTK_S, COMP, 485 & INFO(1), INFO(2), MYID, COMM, NBPROCFILS, IPOOL, LPOOL, 486 & LEAF, NBFIN, ICNTL, KEEP,KEEP8,DKEEP, root, 487 & OPASSW, OPELIW, ITLOC, RHS_MUMPS, FILS, PTRARW, PTRAIW, 488 & INTARR, DBLARR, ND, FRERE, 489 & NELT+1, NELT, FRT_PTR, FRT_ELT, 490 & 491 & ISTEP_TO_INIV2, TAB_POS_IN_PERE 492 & , LRGROUPS 493 & ) 494 IF ( INFO(1) .LT. 0 ) GOTO 500 495 EXIT 496 ENDIF 497 END DO 498 IF (PIMASTER(STEP(ISON)).GT.0) THEN 499 IERR = -1 500 DO WHILE (IERR.EQ.-1) 501 PTRCOL = PIMASTER(STEP(ISON)) + HS + NROWS + NPIVS + NELIM 502 PDEST = PIMASTER(STEP(ISON)) + 6 + KEEP(IXSZ) 503 CALL ZMUMPS_BUF_SEND_MAPLIG( INODE, NFRONT, 504 & NASS1, NFS4FATHER,ISON, MYID, 505 & IZERO, IDUMMY, IW(PTRCOL), NCBSON, 506 & COMM, IERR, IW(PDEST), NSLSON, 507 & SLAVEF, 508 & KEEP,KEEP8, STEP, N, 509 & ISTEP_TO_INIV2, TAB_POS_IN_PERE 510 & ) 511 IF (IERR.EQ.-1) THEN 512 BLOCKING = .FALSE. 513 SET_IRECV = .TRUE. 514 MESSAGE_RECEIVED = .FALSE. 515 CALL ZMUMPS_TRY_RECVTREAT( COMM_LOAD, ASS_IRECV, 516 & BLOCKING, SET_IRECV, MESSAGE_RECEIVED, 517 & MPI_ANY_SOURCE, MPI_ANY_TAG, 518 & STATUS, 519 & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, 520 & IWPOS, IWPOSCB, IPTRLU, 521 & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, 522 & PTLUST, PTRFAC, 523 & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, 524 & INFO(1), INFO(2), COMM, 525 & NBPROCFILS, 526 & IPOOL, LPOOL, LEAF, 527 & NBFIN, MYID, SLAVEF, 528 & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, 529 & FILS, PTRARW, PTRAIW, 530 & INTARR, DBLARR, ICNTL, KEEP, KEEP8,DKEEP, ND, FRERE, 531 & NELT+1, NELT, FRT_PTR, FRT_ELT, 532 & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. 533 & , LRGROUPS 534 & ) 535 IF ( INFO(1) .LT. 0 ) GOTO 500 536 ENDIF 537 END DO 538 IF (IERR .EQ. -2) GOTO 290 539 IF (IERR .EQ. -3) GOTO 295 540 ENDIF 541 ENDIF 542 ISON = FRERE(STEP(ISON)) 543 220 CONTINUE 544 END IF 545 DO IELL=ELBEG,ELBEG+NUMELT-1 546 ELTI = FRT_ELT(IELL) 547 J18= PTRAIW(ELTI) 548 J28= PTRAIW(ELTI+1)-1 549 AII8 = PTRARW(ELTI) 550 SIZE_ELTI8 = J28 - J18 + 1_8 551 DO II8=J18,J28 552 I = INTARR(II8) 553 IF (KEEP(50).EQ.0) THEN 554 AINPUT8 = AII8 + II8 - J18 555 ICT12 = POSELT + int(I-1,8) * NFRONT8 556 DO JJ8=J18,J28 557 APOS2 = ICT12 + int(INTARR(JJ8) - 1,8) 558 A(APOS2) = A(APOS2) + DBLARR(AINPUT8) 559 AINPUT8 = AINPUT8 + SIZE_ELTI8 560 END DO 561 ELSE 562 ICT12 = POSELT + int(- NFRONT + I - 1,8) 563 ICT21 = POSELT + int(I-1,8)*NFRONT8 - 1_8 564 DO JJ8=II8,J28 565 J = INTARR(JJ8) 566 IF (I.LT.J) THEN 567 APOS2 = ICT12 + int(J,8)*NFRONT8 568 ELSE 569 APOS2 = ICT21 + int(J,8) 570 ENDIF 571 A(APOS2) = A(APOS2) + DBLARR(AII8) 572 AII8 = AII8 + 1_8 573 END DO 574 END IF 575 END DO 576 END DO 577 IF (KEEP(253).GT.0) THEN 578 POSELT = PTRAST(STEP(INODE)) 579 IBROT = INODE 580 IJROW = Pos_First_NUMORG 581 DO IORG = 1, NUMORG 582 IF (KEEP(50).EQ.0) THEN 583 DO J253=1, KEEP(253) 584 APOS = POSELT+ 585 & int(IJROW-1,8) * NFRONT8 + 586 & int(NFRONT-KEEP(253)+J253-1,8) 587 A(APOS) = A(APOS) + RHS_MUMPS( (J253-1)*KEEP(254)+IBROT ) 588 ENDDO 589 ELSE 590 DO J253=1, KEEP(253) 591 APOS = POSELT+ 592 & int(NFRONT-KEEP(253)+J253-1,8) * NFRONT8 + 593 & int(IJROW-1,8) 594 A(APOS) = A(APOS) + RHS_MUMPS( (J253-1)*KEEP(254)+IBROT ) 595 ENDDO 596 ENDIF 597 IBROT = FILS(IBROT) 598 IJROW = IJROW+1 599 ENDDO 600 ENDIF 601 GOTO 500 602 270 CONTINUE 603 INFO(1) = -8 604 INFO(2) = LREQ 605 IF (LPOK) THEN 606 WRITE( LP, * ) 607 &' FAILURE IN INTEGER ALLOCATION DURING ZMUMPS_ASM_NIV1_ELT' 608 ENDIF 609 GOTO 490 610 280 CONTINUE 611 INFO(1) = -9 612 CALL MUMPS_SET_IERROR(LAELL8-LRLUS, INFO(2)) 613 IF (LPOK) THEN 614 WRITE( LP, * ) 615 &' FAILURE, WORKSPACE TOO SMALL DURING ZMUMPS_ASM_NIV1_ELT' 616 ENDIF 617 GOTO 500 618 290 CONTINUE 619 IF (LPOK) THEN 620 WRITE( LP, * ) 621 & ' FAILURE, SEND BUFFER TOO SMALL DURING ZMUMPS_ASM_NIV1_ELT' 622 ENDIF 623 INFO(1) = -17 624 LREQ = NCBSON + 6+NSLSON+KEEP(IXSZ) 625 INFO(2) = LREQ * KEEP( 34 ) 626 GOTO 490 627 295 CONTINUE 628 IF (LPOK) THEN 629 WRITE( LP, * ) 630 & ' FAILURE, RECV BUFFER TOO SMALL DURING ZMUMPS_ASM_NIV1_ELT' 631 ENDIF 632 INFO(1) = -20 633 LREQ = NCBSON + 6+NSLSON+KEEP(IXSZ) 634 INFO(2) = LREQ * KEEP( 34 ) 635 GOTO 490 636 300 CONTINUE 637 IF (INFO(1).EQ.-13) THEN 638 IF (LPOK) THEN 639 WRITE( LP, * ) ' FAILURE IN INTEGER', 640 & ' DYNAMIC ALLOCATION DURING ZMUMPS_ASM_NIV1_ELT' 641 ENDIF 642 INFO(2) = NUMSTK 643 ENDIF 644 490 CALL ZMUMPS_BDC_ERROR( MYID, SLAVEF, COMM, KEEP ) 645 500 CONTINUE 646 RETURN 647 END SUBROUTINE ZMUMPS_FAC_ASM_NIV1_ELT 648 SUBROUTINE ZMUMPS_FAC_ASM_NIV2_ELT( COMM_LOAD, ASS_IRECV, 649 & NELT, FRT_PTR, FRT_ELT, 650 & N, INODE, IW, LIW, A, LA, INFO, 651 & ND, FILS, FRERE, DAD, 652 & CAND, 653 & ISTEP_TO_INIV2, TAB_POS_IN_PERE, 654 & MAXFRW, root, 655 & OPASSW, OPELIW, PTRIST, PTLUST, PTRFAC, 656 & PTRAST, STEP, PIMASTER, PAMASTER, PTRARW, NSTK_S, 657 & PTRAIW, ITLOC, RHS_MUMPS, NSTEPS, 658 & COMP, LRLU, IPTRLU, IWPOS, IWPOSCB, POSFAC, LRLUS, 659 & ICNTL, KEEP, KEEP8,DKEEP,INTARR,LINTARR,DBLARR,LDBLARR, 660 & NBPROCFILS, PROCNODE_STEPS, SLAVEF, COMM,MYID, 661 & BUFR, LBUFR, LBUFR_BYTES, NBFIN, LEAF, IPOOL, LPOOL, 662 & PERM, MEM_DISTRIB 663 & , LRGROUPS 664 & ) 665!$ USE OMP_LIB 666 USE MUMPS_BUILD_SORT_INDEX_ELT_M 667 USE ZMUMPS_BUF 668 USE ZMUMPS_LOAD 669 USE ZMUMPS_LR_CORE, ONLY : IS_FRONT_BLR_CANDIDATE 670 IMPLICIT NONE 671 INCLUDE 'zmumps_root.h' 672 TYPE (ZMUMPS_ROOT_STRUC) :: root 673 INTEGER COMM_LOAD, ASS_IRECV 674 INTEGER N,LIW,NSTEPS, NBFIN 675 INTEGER NELT 676 INTEGER KEEP(500), ICNTL(40) 677 INTEGER(8) KEEP8(150) 678 DOUBLE PRECISION DKEEP(230) 679 INTEGER(8) :: LRLUS, LRLU, IPTRLU, POSFAC, LA 680 INTEGER, INTENT(INOUT) :: INFO(2) 681 INTEGER INODE,MAXFRW, LPOOL, LEAF, 682 & IWPOS, IWPOSCB, COMP, SLAVEF 683 INTEGER, DIMENSION(0:SLAVEF - 1) :: MEM_DISTRIB 684 INTEGER IPOOL(LPOOL) 685 INTEGER(8) :: PTRAST(KEEP(28)) 686 INTEGER(8) :: PTRFAC(KEEP(28)) 687 INTEGER(8) :: PAMASTER(KEEP(28)) 688 INTEGER(8), INTENT(IN) :: PTRARW(NELT+1), PTRAIW(NELT+1) 689 INTEGER IW(LIW), ITLOC(N+KEEP(253)), 690 & ND(KEEP(28)), 691 & FILS(N), FRERE(KEEP(28)), DAD (KEEP(28)), 692 & PTRIST(KEEP(28)), PTLUST(KEEP(28)), 693 & STEP(N), 694 & PIMASTER(KEEP(28)), 695 & NSTK_S(KEEP(28)), PERM(N) 696 COMPLEX(kind=8) :: RHS_MUMPS(KEEP(255)) 697 INTEGER CAND(SLAVEF+1, max(1,KEEP(56))) 698 INTEGER ISTEP_TO_INIV2(KEEP(71)), 699 & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) 700 COMPLEX(kind=8) A(LA) 701 INTEGER, intent(in) :: LRGROUPS(N) 702 DOUBLE PRECISION OPASSW, OPELIW 703 INTEGER FRT_PTR(N+1), FRT_ELT(NELT) 704 INTEGER(8), INTENT(IN) :: LINTARR,LDBLARR 705 COMPLEX(kind=8) DBLARR(LDBLARR) 706 INTEGER INTARR(LINTARR) 707 INTEGER MYID, COMM 708 INTEGER LBUFR, LBUFR_BYTES 709 INTEGER NBPROCFILS(KEEP(28)), PROCNODE_STEPS(KEEP(28)) 710 INTEGER BUFR( LBUFR ) 711 INCLUDE 'mumps_headers.h' 712 INCLUDE 'mpif.h' 713 INTEGER :: IERR 714 INTEGER :: STATUS(MPI_STATUS_SIZE) 715!$ INTEGER :: NOMP 716 INTEGER LP, HS, HF, HF_OLD, NCBSON, NSLAVES_OLD 717 LOGICAL LPOK 718 INTEGER NCBSON_MAX 719 INTEGER IN,NUMSTK,NASS,ISON,IFSON,NASS1,IELL 720 INTEGER :: IBC_SOURCE 721 INTEGER NFS4FATHER 722 INTEGER NFRONT,NFRONT_EFF,ISTCHK,LSTK,LREQ 723 INTEGER(8) :: LAELL8 724 INTEGER LREQ_OOC 725 INTEGER NBPANELS_L, NBPANELS_U 726 LOGICAL COMPRESSCB 727 INTEGER(8) :: LCB 728 INTEGER NCB 729 INTEGER MP 730 INTEGER :: K1, K2, KK, KK1 731 INTEGER :: J253 732 INTEGER(8) :: AII8, AINPUT8, II8 733 INTEGER(8) :: J18,J28,JJ8 734 INTEGER(8) :: LAPOS2, JJ2, JJ3 735 INTEGER(8) :: NFRONT8, POSELT, POSEL1, LDAFS8, 736 & IACHK, ICT12, ICT21 737 INTEGER(8) APOS, APOS2 738#if ! defined(ZERO_TRIANGLE) 739 INTEGER :: TOPDIAG 740#endif 741!$ INTEGER :: CHUNK 742!$ INTEGER(8) :: CHUNK8 743 INTEGER NELIM,NPIVS,NCOLS,NROWS, 744 & IORG 745 INTEGER LDAFS, LDA_SON, IJROW, IBROT 746 INTEGER Pos_First_NUMORG,NBCOL,NUMORG,IOLDPS 747 INTEGER NSLAVES, NSLSON 748 INTEGER NBLIG, PTRCOL, PTRROW, PDEST 749 INTEGER PDEST1(1) 750 INTEGER :: ISLAVE 751 INTEGER ELTI 752 INTEGER(8) :: SIZE_ELTI8 753 INTEGER :: I, J 754 INTEGER :: ELBEG, NUMELT 755 LOGICAL SAME_PROC, NIV1, SON_LEVEL2 756 LOGICAL BLOCKING, SET_IRECV, MESSAGE_RECEIVED 757 INTEGER TROW_SIZE, INDX, FIRST_INDEX, SHIFT_INDEX 758 INTEGER ETATASS 759 INTEGER IZERO 760 INTEGER IDUMMY(1) 761 PARAMETER( IZERO = 0 ) 762 INTEGER MUMPS_PROCNODE, MUMPS_TYPENODE, MUMPS_TYPESPLIT 763 EXTERNAL MUMPS_PROCNODE, MUMPS_TYPENODE, MUMPS_TYPESPLIT 764 COMPLEX(kind=8) ZERO 765 DOUBLE PRECISION RZERO 766 PARAMETER( RZERO = 0.0D0 ) 767 PARAMETER( ZERO = (0.0D0,0.0D0) ) 768 logical :: force_cand 769 INTEGER(8) :: APOSMAX 770 DOUBLE PRECISION MAXARR 771 INTEGER INIV2, SIZE_TMP_SLAVES_LIST, allocok 772 INTEGER NCB_SPLIT, SIZE_LIST_SPLIT, NBSPLIT, 773 & NUMORG_SPLIT, TYPESPLIT 774 INTEGER, ALLOCATABLE, DIMENSION(:) :: TMP_SLAVES_LIST, COPY_CAND 775 INTEGER, ALLOCATABLE, DIMENSION(:) :: SONROWS_PER_ROW 776 INTEGER :: NMB_OF_CAND, NMB_OF_CAND_ORIG 777 LOGICAL :: IS_ofType5or6, SPLIT_MAP_RESTART 778!$ NOMP = OMP_GET_MAX_THREADS() 779 MP = ICNTL(2) 780 LP = ICNTL(1) 781 LPOK = ((LP.GT.0).AND.(ICNTL(4).GE.1)) 782 COMPRESSCB=.FALSE. 783 ETATASS = 0 784 IN = INODE 785 NBPROCFILS(STEP(IN)) = 0 786 NSTEPS = NSTEPS + 1 787 NUMELT = FRT_PTR(INODE+1) - FRT_PTR(INODE) 788 IF ( NUMELT .NE. 0 ) THEN 789 ELBEG = FRT_PTR(INODE) 790 ELSE 791 ELBEG = 1 792 END IF 793 NUMORG = 0 794 DO WHILE (IN.GT.0) 795 NUMORG = NUMORG + 1 796 IN = FILS(IN) 797 ENDDO 798 NUMSTK = 0 799 NASS = 0 800 IFSON = -IN 801 ISON = IFSON 802 NCBSON_MAX = 0 803 DO WHILE (ISON .GT. 0) 804 NUMSTK = NUMSTK + 1 805 IF ( KEEP(48)==5 .AND. 806 & MUMPS_TYPENODE(PROCNODE_STEPS(STEP(ISON)), 807 & SLAVEF) .EQ. 1) THEN 808 NCBSON_MAX = 809 & max(NCBSON_MAX,IW(PIMASTER(STEP(ISON))+KEEP(IXSZ))) 810 ENDIF 811 NASS = NASS + IW(PIMASTER(STEP(ISON)) + 1 + KEEP(IXSZ)) 812 ISON = FRERE(STEP(ISON)) 813 ENDDO 814 NFRONT = ND(STEP(INODE)) + NASS + KEEP(253) 815 MAXFRW = max0(MAXFRW, NFRONT) 816 NASS1 = NASS + NUMORG 817 NCB = NFRONT - NASS1 818 IF((KEEP(24).eq.0).or.(KEEP(24).eq.1)) then 819 force_cand=.FALSE. 820 ELSE 821 force_cand=(mod(KEEP(24),2).eq.0) 822 end if 823 TYPESPLIT = MUMPS_TYPESPLIT (PROCNODE_STEPS(STEP(INODE)), 824 & SLAVEF) 825 IS_ofType5or6 = (TYPESPLIT.EQ.5 .OR. TYPESPLIT.EQ.6) 826 ISTCHK = PIMASTER(STEP(IFSON)) 827 PDEST = ISTCHK + 6 + KEEP(IXSZ) 828 NSLSON = IW(ISTCHK + KEEP(IXSZ) + 5) 829 SPLIT_MAP_RESTART = .FALSE. 830 IF (force_cand) THEN 831 INIV2 = ISTEP_TO_INIV2( STEP( INODE )) 832 NMB_OF_CAND = CAND( SLAVEF+1, INIV2 ) 833 NMB_OF_CAND_ORIG = NMB_OF_CAND 834 SIZE_TMP_SLAVES_LIST = NMB_OF_CAND 835 IF (IS_ofType5or6) THEN 836 DO I=NMB_OF_CAND+1,SLAVEF 837 IF ( CAND( I, INIV2 ).LT.0) EXIT 838 NMB_OF_CAND = NMB_OF_CAND +1 839 ENDDO 840 SIZE_TMP_SLAVES_LIST = NSLSON-1 841 WRITE(6,*) "NMB_OF_CAND, SIZE_TMP_SLAVES_LIST ", 842 & NMB_OF_CAND, SIZE_TMP_SLAVES_LIST 843 IF (INODE.EQ.-999999) THEN 844 SPLIT_MAP_RESTART = .TRUE. 845 ENDIF 846 ENDIF 847 IF (IS_ofType5or6.AND.SPLIT_MAP_RESTART) THEN 848 TYPESPLIT = 4 849 IS_ofType5or6 = .FALSE. 850 SIZE_TMP_SLAVES_LIST = NMB_OF_CAND 851 CAND (SLAVEF+1, INIV2) = SIZE_TMP_SLAVES_LIST 852 ENDIF 853 ELSE 854 INIV2 = 1 855 SIZE_TMP_SLAVES_LIST = SLAVEF - 1 856 NMB_OF_CAND = SLAVEF - 1 857 NMB_OF_CAND_ORIG = SLAVEF - 1 858 ENDIF 859 ALLOCATE(TMP_SLAVES_LIST(SIZE_TMP_SLAVES_LIST),stat=allocok) 860 IF (allocok > 0 ) THEN 861 GOTO 265 862 ENDIF 863 TYPESPLIT = MUMPS_TYPESPLIT (PROCNODE_STEPS(STEP(INODE)), 864 & SLAVEF) 865 IF ( (TYPESPLIT.EQ.4) 866 & .OR.(TYPESPLIT.EQ.5).OR.(TYPESPLIT.EQ.6) 867 & ) THEN 868 IF (TYPESPLIT.EQ.4) THEN 869 ALLOCATE(COPY_CAND(SLAVEF+1),stat=allocok) 870 IF (allocok > 0 ) THEN 871 GOTO 245 872 ENDIF 873 CALL ZMUMPS_SPLIT_PREP_PARTITION ( 874 & INODE, STEP, N, SLAVEF, 875 & PROCNODE_STEPS, KEEP, DAD, FILS, 876 & CAND(1,INIV2), ICNTL, COPY_CAND, 877 & NBSPLIT, NUMORG_SPLIT, TMP_SLAVES_LIST(1), 878 & SIZE_TMP_SLAVES_LIST 879 & ) 880 NCB_SPLIT = NCB-NUMORG_SPLIT 881 SIZE_LIST_SPLIT = SIZE_TMP_SLAVES_LIST - NBSPLIT 882 CALL ZMUMPS_LOAD_SET_PARTITION( NCBSON_MAX, SLAVEF, KEEP,KEEP8, 883 & ICNTL, COPY_CAND, 884 & MEM_DISTRIB(0), NCB_SPLIT, NFRONT, NSLAVES, 885 & TAB_POS_IN_PERE(1,INIV2), 886 & TMP_SLAVES_LIST(NBSPLIT+1), 887 & SIZE_LIST_SPLIT,INODE ) 888 DEALLOCATE (COPY_CAND) 889 CALL ZMUMPS_SPLIT_POST_PARTITION ( 890 & INODE, STEP, N, SLAVEF, NBSPLIT, NCB, 891 & PROCNODE_STEPS, KEEP, DAD, FILS, 892 & ICNTL, 893 & TAB_POS_IN_PERE(1,INIV2), 894 & NSLAVES 895 & ) 896 IF (SPLIT_MAP_RESTART) THEN 897 IS_ofType5or6 = .TRUE. 898 TYPESPLIT = MUMPS_TYPESPLIT (PROCNODE_STEPS(STEP(INODE)), 899 & SLAVEF) 900 CAND( SLAVEF+1, INIV2 ) = NMB_OF_CAND_ORIG 901 ENDIF 902 ELSE 903 ISTCHK = PIMASTER(STEP(IFSON)) 904 PDEST = ISTCHK + 6 + KEEP(IXSZ) 905 NSLSON = IW(ISTCHK + KEEP(IXSZ) + 5) 906 CALL ZMUMPS_SPLIT_PROPAGATE_PARTI ( 907 & INODE, TYPESPLIT, IFSON, 908 & CAND(1,INIV2), NMB_OF_CAND_ORIG, 909 & IW(PDEST), NSLSON, 910 & STEP, N, SLAVEF, 911 & PROCNODE_STEPS, KEEP, DAD, FILS, 912 & ICNTL, ISTEP_TO_INIV2, INIV2, 913 & TAB_POS_IN_PERE, NSLAVES, 914 & TMP_SLAVES_LIST, 915 & SIZE_TMP_SLAVES_LIST 916 & ) 917 ENDIF 918 ELSE 919 CALL ZMUMPS_LOAD_SET_PARTITION( NCBSON_MAX, SLAVEF, KEEP,KEEP8, 920 & ICNTL, CAND(1,INIV2), 921 & MEM_DISTRIB(0), NCB, NFRONT, NSLAVES, 922 & TAB_POS_IN_PERE(1,INIV2), 923 & TMP_SLAVES_LIST, 924 & SIZE_TMP_SLAVES_LIST,INODE ) 925 ENDIF 926 HF = NSLAVES + 6 + KEEP(IXSZ) 927 LREQ_OOC = 0 928 IF (KEEP(201).EQ.1) THEN 929 CALL ZMUMPS_OOC_GET_PP_SIZES(KEEP(50), NASS1, NFRONT, NASS1, 930 & NBPANELS_L, NBPANELS_U, LREQ_OOC) 931 ENDIF 932 LREQ = HF + 2 * NFRONT + LREQ_OOC 933 IF ((IWPOS + LREQ -1) .GT. IWPOSCB) THEN 934 CALL ZMUMPS_COMPRE_NEW(N, KEEP(28), 935 & IW, LIW, A, LA, 936 & LRLU, IPTRLU, 937 & IWPOS, IWPOSCB, PTRIST, PTRAST, 938 & STEP, PIMASTER, PAMASTER, 939 & KEEP(216),LRLUS,KEEP(IXSZ), 940 & COMP, DKEEP(97), MYID) 941 IF (LRLU .NE. LRLUS) THEN 942 IF (LPOK) THEN 943 WRITE(LP, * ) 'PB compress ZMUMPS_FAC_ASM_NIV2_ELT', 944 & 'LRLU,LRLUS=',LRLU,LRLUS 945 ENDIF 946 GOTO 270 947 ENDIF 948 IF ((IWPOS + LREQ -1) .GT. IWPOSCB) GOTO 270 949 ENDIF 950 IOLDPS = IWPOS 951 IWPOS = IWPOS + LREQ 952 NIV1 = .FALSE. 953 ALLOCATE(SONROWS_PER_ROW(NFRONT-NASS1), stat=allocok) 954 IF (allocok > 0) GOTO 275 955 CALL MUMPS_ELT_BUILD_SORT( 956 & NUMELT, FRT_ELT(ELBEG), 957 & MYID, INODE, N, IOLDPS, HF, 958 & NFRONT, NFRONT_EFF, PERM, 959 & NASS1, NASS, NUMSTK, NUMORG, IWPOSCB, 960 & IFSON, STEP, PIMASTER, PTRIST, PTRAIW, NELT, IW, LIW, 961 & INTARR, LINTARR, ITLOC, FILS, FRERE, 962 & KEEP, SON_LEVEL2, NIV1, NBPROCFILS, INFO(1), 963 & DAD,PROCNODE_STEPS, SLAVEF, 964 & FRT_PTR, FRT_ELT, Pos_First_NUMORG, 965 & SONROWS_PER_ROW, NFRONT - NASS1) 966 IF (INFO(1).LT.0) GOTO 250 967 IF ( NFRONT .NE. NFRONT_EFF ) THEN 968 IF ( 969 & (TYPESPLIT.EQ.5) .OR. (TYPESPLIT.EQ.6)) THEN 970 WRITE(6,*) ' Internal error 1 in fac_ass due to splitting ', 971 & ' INODE, NFRONT, NFRONT_EFF =', INODE, NFRONT, NFRONT_EFF 972 WRITE(6,*) ' SPLITTING NOT YET READY FOR THAT' 973 CALL MUMPS_ABORT() 974 ENDIF 975 IF (NFRONT.GT.NFRONT_EFF) THEN 976 NCB = NFRONT_EFF - NASS1 977 NSLAVES_OLD = NSLAVES 978 HF_OLD = HF 979 IF (TYPESPLIT.EQ.4) THEN 980 ALLOCATE(COPY_CAND(SLAVEF+1),stat=allocok) 981 IF (allocok > 0 ) THEN 982 GOTO 245 983 ENDIF 984 CALL ZMUMPS_SPLIT_PREP_PARTITION ( 985 & INODE, STEP, N, SLAVEF, 986 & PROCNODE_STEPS, KEEP, DAD, FILS, 987 & CAND(1,INIV2), ICNTL, COPY_CAND, 988 & NBSPLIT, NUMORG_SPLIT, TMP_SLAVES_LIST(1), 989 & SIZE_TMP_SLAVES_LIST 990 & ) 991 NCB_SPLIT = NCB-NUMORG_SPLIT 992 SIZE_LIST_SPLIT = SIZE_TMP_SLAVES_LIST - NBSPLIT 993 CALL ZMUMPS_LOAD_SET_PARTITION( NCBSON_MAX, 994 & SLAVEF, KEEP,KEEP8, 995 & ICNTL, COPY_CAND, 996 & MEM_DISTRIB(0), NCB_SPLIT, NFRONT_EFF, NSLAVES, 997 & TAB_POS_IN_PERE(1,INIV2), 998 & TMP_SLAVES_LIST(NBSPLIT+1), 999 & SIZE_LIST_SPLIT,INODE ) 1000 DEALLOCATE (COPY_CAND) 1001 CALL ZMUMPS_SPLIT_POST_PARTITION ( 1002 & INODE, STEP, N, SLAVEF, NBSPLIT, NCB, 1003 & PROCNODE_STEPS, KEEP, DAD, FILS, 1004 & ICNTL, 1005 & TAB_POS_IN_PERE(1,INIV2), 1006 & NSLAVES 1007 & ) 1008 ELSE 1009 CALL ZMUMPS_LOAD_SET_PARTITION( NCBSON_MAX, 1010 & SLAVEF, KEEP, KEEP8, ICNTL, 1011 & CAND(1,INIV2), 1012 & MEM_DISTRIB(0), NCB, NFRONT_EFF, NSLAVES, 1013 & TAB_POS_IN_PERE(1,INIV2), 1014 & TMP_SLAVES_LIST, SIZE_TMP_SLAVES_LIST,INODE ) 1015 ENDIF 1016 HF = NSLAVES + 6 + KEEP(IXSZ) 1017 IWPOS = IWPOS - ((2*NFRONT)-(2*NFRONT_EFF)) - 1018 & (NSLAVES_OLD - NSLAVES) 1019 IF (NSLAVES_OLD .NE. NSLAVES) THEN 1020 IF (NSLAVES_OLD > NSLAVES) THEN 1021 DO KK=0,2*NFRONT_EFF-1 1022 IW(IOLDPS+HF+KK)=IW(IOLDPS+HF_OLD+KK) 1023 ENDDO 1024 ELSE 1025 IF (IWPOS - 1 > IWPOSCB ) GOTO 270 1026 DO KK=2*NFRONT_EFF-1, 0, -1 1027 IW(IOLDPS+HF+KK) = IW(IOLDPS+HF_OLD+KK) 1028 ENDDO 1029 END IF 1030 END IF 1031 NFRONT = NFRONT_EFF 1032 LREQ = HF + 2 * NFRONT + LREQ_OOC 1033 ELSE 1034 IF (LPOK) THEN 1035 WRITE(LP,*) ' INTERNAL ERROR 2 during ass_niv2' 1036 ENDIF 1037 GOTO 270 1038 ENDIF 1039 ENDIF 1040 NFRONT8=int(NFRONT,8) 1041 IF (KEEP(201).EQ.1.AND.KEEP(50).NE.1) THEN 1042 CALL ZMUMPS_OOC_PP_SET_PTR(KEEP(50), 1043 & NBPANELS_L, NBPANELS_U, NASS1, 1044 & IOLDPS + HF + 2 * NFRONT, IW, LIW) 1045 ENDIF 1046 MAXFRW = max0(MAXFRW, NFRONT) 1047 PTLUST(STEP(INODE)) = IOLDPS 1048 IW(IOLDPS+KEEP(IXSZ)) = NFRONT 1049 IW(IOLDPS + 1+KEEP(IXSZ)) = 0 1050 IW(IOLDPS + 2+KEEP(IXSZ)) = -NASS1 1051 IW(IOLDPS + 3+KEEP(IXSZ)) = -NASS1 1052 IW(IOLDPS + 4+KEEP(IXSZ)) = STEP(INODE) 1053 IW(IOLDPS+5+KEEP(IXSZ)) = NSLAVES 1054 IW(IOLDPS+6+KEEP(IXSZ):IOLDPS+5+NSLAVES+KEEP(IXSZ))= 1055 & TMP_SLAVES_LIST(1:NSLAVES) 1056#if defined(OLD_LOAD_MECHANISM) 1057#if ! defined (CHECK_COHERENCE) 1058 IF ( KEEP(73) .EQ. 0 ) THEN 1059#endif 1060#endif 1061 CALL ZMUMPS_LOAD_MASTER_2_ALL(MYID, SLAVEF, COMM_LOAD, 1062 & TAB_POS_IN_PERE(1,ISTEP_TO_INIV2(STEP(INODE))), 1063 & NASS1, KEEP, KEEP8, IW(IOLDPS+6+KEEP(IXSZ)), NSLAVES,INODE) 1064#if defined(OLD_LOAD_MECHANISM) 1065#if ! defined (CHECK_COHERENCE) 1066 ENDIF 1067#endif 1068#endif 1069 IF(KEEP(86).EQ.1)THEN 1070 IF(mod(KEEP(24),2).eq.0)THEN 1071 CALL ZMUMPS_LOAD_SEND_MD_INFO(SLAVEF, 1072 & CAND(SLAVEF+1,INIV2), 1073 & CAND(1,INIV2), 1074 & TAB_POS_IN_PERE(1,ISTEP_TO_INIV2(STEP(INODE))), 1075 & NASS1, KEEP,KEEP8, TMP_SLAVES_LIST, 1076 & NSLAVES,INODE) 1077 ELSEIF((KEEP(24).EQ.0).OR.(KEEP(24).EQ.1))THEN 1078 CALL ZMUMPS_LOAD_SEND_MD_INFO(SLAVEF, 1079 & SLAVEF-1, 1080 & TMP_SLAVES_LIST, 1081 & TAB_POS_IN_PERE(1,ISTEP_TO_INIV2(STEP(INODE))), 1082 & NASS1, KEEP,KEEP8, TMP_SLAVES_LIST, 1083 & NSLAVES,INODE) 1084 ENDIF 1085 ENDIF 1086 DEALLOCATE(TMP_SLAVES_LIST) 1087 IF (KEEP(50).EQ.0) THEN 1088 LAELL8 = int(NASS1,8) * NFRONT8 1089 LDAFS = NFRONT 1090 LDAFS8 = NFRONT8 1091 ELSE 1092 LAELL8 = int(NASS1,8)*int(NASS1,8) 1093 IF(KEEP(219).NE.0.AND.KEEP(50) .EQ. 2) 1094 & LAELL8 = LAELL8+int(NASS1,8) 1095 LDAFS = NASS1 1096 LDAFS8 = int(NASS1,8) 1097 ENDIF 1098 IF (LRLU .LT. LAELL8) THEN 1099 IF (LRLUS .LT. LAELL8) THEN 1100 GOTO 280 1101 ELSE 1102 CALL ZMUMPS_COMPRE_NEW(N, KEEP(28), IW, LIW, A, LA, 1103 & LRLU, IPTRLU, 1104 & IWPOS, IWPOSCB, PTRIST, PTRAST, 1105 & STEP, PIMASTER, PAMASTER, KEEP(216), LRLUS, 1106 & KEEP(IXSZ), COMP, DKEEP(97), MYID) 1107 IF (LRLU .NE. LRLUS) THEN 1108 IF (LPOK) THEN 1109 WRITE(LP, * ) 'PB compress ZMUMPS_FAC_ASM_NIV2_ELT' 1110 WRITE(LP, * ) 'LRLU,LRLUS=',LRLU,LRLUS 1111 ENDIF 1112 GOTO 280 1113 ENDIF 1114 ENDIF 1115 ENDIF 1116 LRLU = LRLU - LAELL8 1117 LRLUS = LRLUS - LAELL8 1118 KEEP8(67) = min(LRLUS, KEEP8(67)) 1119 KEEP8(70) = KEEP8(70) - LAELL8 1120 KEEP8(68) = min(KEEP8(70), KEEP8(68)) 1121 KEEP8(71) = KEEP8(71) - LAELL8 1122 KEEP8(69) = min(KEEP8(71), KEEP8(69)) 1123 POSELT = POSFAC 1124 PTRAST(STEP(INODE)) = POSELT 1125 PTRFAC(STEP(INODE)) = POSELT 1126 POSFAC = POSFAC + LAELL8 1127 IW(IOLDPS+XXI) = LREQ 1128 CALL MUMPS_STOREI8(LAELL8,IW(IOLDPS+XXR)) 1129 IW(IOLDPS+XXS) = -9999 1130 IW(IOLDPS+XXN) = -99999 1131 IW(IOLDPS+XXP) = -99999 1132 IW(IOLDPS+XXA) = -99999 1133 IW(IOLDPS+XXF) = -99999 1134 IW(IOLDPS+XXLR)= -99999 1135 CALL IS_FRONT_BLR_CANDIDATE(INODE, NFRONT, NASS1, KEEP(486), 1136 & KEEP(489), KEEP(490), KEEP(491), KEEP(492), N, LRGROUPS, 1137 & IW(IOLDPS+XXLR)) 1138#if defined(NO_XXNBPR) 1139 IW(IOLDPS+XXNBPR)=-99999 1140#else 1141 CALL CHECK_EQUAL(NBPROCFILS(STEP(INODE)), IW(IOLDPS+XXNBPR)) 1142#endif 1143 CALL ZMUMPS_LOAD_MEM_UPDATE(.FALSE.,.FALSE.,LA-LRLUS,0_8,LAELL8, 1144 & KEEP,KEEP8, 1145 & LRLUS) 1146 POSEL1 = POSELT - LDAFS8 1147#if defined(ZERO_TRIANGLE) 1148 LAPOS2 = POSELT + LAELL8 - 1_8 1149 A(POSELT:LAPOS2) = ZERO 1150#else 1151 IF ( KEEP(50) .eq. 0 .OR. LDAFS .lt. KEEP(63) ) THEN 1152 LAPOS2 = POSELT + LAELL8 - 1_8 1153!$ CHUNK8 = max(int(KEEP(361)/2,8), 1154!$ & (LAELL8+NOMP-1) / NOMP ) 1155!$OMP PARALLEL DO PRIVATE(JJ8) SCHEDULE(STATIC, CHUNK8) 1156!$OMP& IF (LAPOS2 - POSELT > int(KEEP(361),8) .AND. NOMP .GT. 1) 1157 DO JJ8 = POSELT, LAPOS2 1158 A(JJ8) = ZERO 1159 ENDDO 1160 ELSE 1161 TOPDIAG = max(KEEP(7), KEEP(8))-1 1162!$ CHUNK = max(KEEP(360)/2, 1163!$ & ( (( LDAFS + NOMP -1 ) / NOMP + 2) / 3) ) 1164 APOS = POSELT 1165!$OMP PARALLEL DO PRIVATE(APOS,JJ3) SCHEDULE(STATIC, CHUNK) 1166!$OMP& IF (LDAFS - 1 .GT. KEEP(360) .AND. NOMP .GT. 1) 1167 DO JJ8 = 0_8, int(LDAFS-1,8) 1168 APOS = POSELT + JJ8 * int(LDAFS,8) 1169 JJ3 = min( int(LDAFS,8) - 1_8, JJ8 + TOPDIAG ) 1170 A(APOS:APOS+JJ3) = ZERO 1171 END DO 1172!$OMP END PARALLEL DO 1173 IF (KEEP(219).NE.0.AND.KEEP(50).EQ.2) THEN 1174 APOSMAX = POSELT + int(NASS1,8)*int(NASS1,8) 1175 A(APOSMAX:APOSMAX+int(LDAFS-1,8))=ZERO 1176 ENDIF 1177 END IF 1178#endif 1179 IF ((NUMSTK.NE.0).AND.(NASS.NE.0)) THEN 1180 ISON = IFSON 1181 DO 220 IELL = 1, NUMSTK 1182 ISTCHK = PIMASTER(STEP(ISON)) 1183 NELIM = IW(ISTCHK + KEEP(IXSZ) + 1) 1184 IF (NELIM.EQ.0) GOTO 210 1185 LSTK = IW(ISTCHK + KEEP(IXSZ)) 1186 NPIVS = IW(ISTCHK + KEEP(IXSZ) + 3) 1187 IF (NPIVS.LT.0) NPIVS=0 1188 NSLSON = IW(ISTCHK + KEEP(IXSZ) + 5) 1189 HS = 6 + KEEP(IXSZ) + NSLSON 1190 NCOLS = NPIVS + LSTK 1191 SAME_PROC = (ISTCHK.LT.IWPOS) 1192 IF ( SAME_PROC ) THEN 1193 COMPRESSCB=( IW(PTRIST(STEP(ISON))+XXS) .EQ. S_CB1COMP ) 1194 ELSE 1195 COMPRESSCB=( IW(ISTCHK + XXS) .EQ. S_CB1COMP ) 1196 ENDIF 1197 IF (.NOT.SAME_PROC) THEN 1198 NROWS = IW(ISTCHK + KEEP(IXSZ) + 2) 1199 ELSE 1200 NROWS = NCOLS 1201 ENDIF 1202 OPASSW = OPASSW + dble(NELIM*LSTK) 1203 K1 = ISTCHK + HS + NROWS + NPIVS 1204 K2 = K1 + NELIM - 1 1205 IACHK = PAMASTER(STEP(ISON)) 1206 IF (KEEP(50).eq.0) THEN 1207 IF (IS_ofType5or6) THEN 1208 APOS = POSELT 1209 DO JJ8 = 1_8, int(NELIM,8)*int(LSTK,8) 1210 A(APOS+JJ8-1_8) = A(APOS+JJ8-1_8) + A(IACHK+JJ8-1_8) 1211 ENDDO 1212 ELSE 1213 DO 170 KK = K1, K2 1214 APOS = POSEL1 + int(IW(KK),8) * LDAFS8 1215 DO 160 KK1 = 1, LSTK 1216 JJ2 = APOS + int(IW(K1 + KK1 - 1),8) - 1_8 1217 A(JJ2) = A(JJ2) + A(IACHK + int(KK1 - 1,8)) 1218 160 CONTINUE 1219 IACHK = IACHK + int(LSTK,8) 1220 170 CONTINUE 1221 ENDIF 1222 ELSE 1223 IF (NSLSON.EQ.0) THEN 1224 LDA_SON = LSTK 1225 ELSE 1226 LDA_SON = NELIM 1227 ENDIF 1228 IF (COMPRESSCB) THEN 1229 LCB = (int(NELIM,8)*int(NELIM+1,8))/2_8 1230 ELSE 1231 LCB = int(LDA_SON,8)*int(NELIM,8) 1232 ENDIF 1233 IF (LCB .GT. 0) THEN 1234 CALL ZMUMPS_LDLT_ASM_NIV12(A, LA, A(IACHK), 1235 & POSELT, LDAFS, NASS1, 1236 & LDA_SON, LCB, 1237 & IW( K1 ), NELIM, NELIM, ETATASS, 1238 & COMPRESSCB 1239 & ) 1240 ENDIF 1241 ENDIF 1242 210 ISON = FRERE(STEP(ISON)) 1243 220 CONTINUE 1244 ENDIF 1245 APOSMAX = POSELT + int(NASS1,8)*int(NASS1,8) 1246 IF (KEEP(219).NE.0) THEN 1247 IF (KEEP(50).EQ.2) THEN 1248 A( APOSMAX: APOSMAX+int(NASS1-1,8))=ZERO 1249 ENDIF 1250 ENDIF 1251 DO IELL=ELBEG,ELBEG+NUMELT-1 1252 ELTI = FRT_ELT(IELL) 1253 J18= PTRAIW(ELTI) 1254 J28= PTRAIW(ELTI+1) - 1_8 1255 AII8 = PTRARW(ELTI) 1256 SIZE_ELTI8 = J28 - J18 + 1_8 1257 DO II8=J18,J28 1258 I = INTARR(II8) 1259 IF (KEEP(50).EQ.0) THEN 1260 IF (I.LE.NASS1) THEN 1261 AINPUT8 = AII8 + II8 - J18 1262 ICT12 = POSELT + int(I-1,8) * LDAFS8 1263 DO JJ8=J18,J28 1264 APOS2 = ICT12 + int(INTARR(JJ8) - 1,8) 1265 A(APOS2) = A(APOS2) + DBLARR(AINPUT8) 1266 AINPUT8 = AINPUT8 + SIZE_ELTI8 1267 END DO 1268 ENDIF 1269 ELSE 1270 ICT12 = POSELT - LDAFS8 + int(I,8) - 1_8 1271 ICT21 = POSELT + int(I-1,8)*LDAFS8 - 1_8 1272 IF ( I .GT. NASS1 ) THEN 1273 IF (KEEP(219).NE.0 .AND. KEEP(50).EQ.2) THEN 1274 AINPUT8=AII8 1275 DO JJ8=II8,J28 1276 J=INTARR(JJ8) 1277 IF (J.LE.NASS1) THEN 1278 A(APOSMAX+int(J-1,8))=cmplx( 1279 & max(dble(A(APOSMAX+int(J-1,8))), 1280 & abs(DBLARR(AINPUT8))), 1281 & kind=kind(A) 1282 & ) 1283 ENDIF 1284 AINPUT8=AINPUT8+1_8 1285 ENDDO 1286 ENDIF 1287 AII8 = AII8 + J28 - II8 + 1_8 1288 CYCLE 1289 ELSE 1290 IF (KEEP(219).NE.0) THEN 1291 MAXARR = RZERO 1292 ENDIF 1293 DO JJ8=II8,J28 1294 J = INTARR(JJ8) 1295 IF ( J .LE. NASS1) THEN 1296 IF (I.LT.J) THEN 1297 APOS2 = ICT12 + int(J,8)*LDAFS8 1298 ELSE 1299 APOS2 = ICT21 + int(J,8) 1300 ENDIF 1301 A(APOS2) = A(APOS2) + DBLARR(AII8) 1302 ELSE IF (KEEP(219).NE.0.AND.KEEP(50).EQ.2) THEN 1303 MAXARR = max(MAXARR,abs(DBLARR(AII8))) 1304 ENDIF 1305 AII8 = AII8 + 1_8 1306 END DO 1307 IF(KEEP(219).NE.0.AND.KEEP(50) .EQ. 2) THEN 1308 A(APOSMAX+int(I-1,8)) = cmplx( 1309 & max( MAXARR, dble(A(APOSMAX+int(I-1,8)))), 1310 & kind=kind(A) 1311 & ) 1312 ENDIF 1313 ENDIF 1314 END IF 1315 END DO 1316 END DO 1317 IF (KEEP(253).GT.0) THEN 1318 POSELT = PTRAST(STEP(INODE)) 1319 IBROT = INODE 1320 IJROW = Pos_First_NUMORG 1321 DO IORG = 1, NUMORG 1322 IF (KEEP(50).EQ.0) THEN 1323 DO J253 = 1, KEEP(253) 1324 APOS = POSELT + 1325 & int(IJROW-1,8) * int(LDAFS,8) + 1326 & int(LDAFS-KEEP(253)+J253-1,8) 1327 A(APOS) = A(APOS) + RHS_MUMPS( (J253-1)*KEEP(254)+IBROT ) 1328 ENDDO 1329 ENDIF 1330 IBROT = FILS(IBROT) 1331 IJROW = IJROW+1 1332 ENDDO 1333 ENDIF 1334 PTRCOL = IOLDPS + HF + NFRONT 1335 PTRROW = IOLDPS + HF + NASS1 1336 PDEST = IOLDPS + 6 + KEEP(IXSZ) 1337 IBC_SOURCE = MYID 1338 DO ISLAVE = 1, NSLAVES 1339 CALL MUMPS_BLOC2_GET_SLAVE_INFO( 1340 & KEEP,KEEP8, INODE, STEP, N, SLAVEF, 1341 & ISTEP_TO_INIV2, TAB_POS_IN_PERE, 1342 & ISLAVE, NCB, 1343 & NSLAVES, 1344 & NBLIG, FIRST_INDEX ) 1345 SHIFT_INDEX = FIRST_INDEX - 1 1346 IERR = -1 1347 DO WHILE (IERR .EQ.-1) 1348 IF ( KEEP(50) .eq. 0 ) THEN 1349 NBCOL = NFRONT 1350 CALL ZMUMPS_BUF_SEND_DESC_BANDE( INODE, 1351 & sum(SONROWS_PER_ROW(FIRST_INDEX:FIRST_INDEX+NBLIG-1)), 1352 & NBLIG, IW(PTRROW), NBCOL, IW(PTRCOL), NASS1, 1353 & IZERO, IDUMMY, 1354 & IW(PDEST), IBC_SOURCE, NFRONT, COMM, KEEP, IERR 1355 & , IW(IOLDPS+XXLR) 1356 & ) 1357 ELSE 1358 NBCOL = NASS1+SHIFT_INDEX+NBLIG 1359 CALL ZMUMPS_BUF_SEND_DESC_BANDE( INODE, 1360 & sum(SONROWS_PER_ROW(FIRST_INDEX:FIRST_INDEX+NBLIG-1)), 1361 & NBLIG, IW(PTRROW), NBCOL, IW(PTRCOL), NASS1, 1362 & NSLAVES-ISLAVE, 1363 & IW( PTLUST(STEP(INODE))+6+KEEP(IXSZ)+ISLAVE), 1364 & IW(PDEST), IBC_SOURCE, NFRONT, COMM, KEEP, IERR 1365 & , IW(IOLDPS+XXLR) 1366 & ) 1367 ENDIF 1368 IF (IERR.EQ.-1) THEN 1369 BLOCKING = .FALSE. 1370 SET_IRECV = .TRUE. 1371 MESSAGE_RECEIVED = .FALSE. 1372 CALL ZMUMPS_TRY_RECVTREAT( COMM_LOAD, ASS_IRECV, 1373 & BLOCKING, SET_IRECV, MESSAGE_RECEIVED, 1374 & MPI_ANY_SOURCE, MPI_ANY_TAG, 1375 & STATUS, BUFR, LBUFR, 1376 & LBUFR_BYTES, 1377 & PROCNODE_STEPS, POSFAC, IWPOS, IWPOSCB, IPTRLU, 1378 & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, 1379 & PTLUST, PTRFAC, 1380 & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, INFO(1), 1381 & INFO(2), COMM, 1382 & NBPROCFILS, 1383 & IPOOL, LPOOL, LEAF, NBFIN, MYID, SLAVEF, 1384 & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, 1385 & FILS, PTRARW, PTRAIW, 1386 & INTARR, DBLARR, ICNTL, KEEP,KEEP8,DKEEP, ND, FRERE, 1387 & NELT+1, NELT, FRT_PTR, FRT_ELT, 1388 & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. 1389 & , LRGROUPS 1390 & ) 1391 IF ( INFO(1) .LT. 0 ) GOTO 500 1392 IF (MESSAGE_RECEIVED) THEN 1393 IOLDPS = PTLUST(STEP(INODE)) 1394 PTRCOL = IOLDPS + HF + NFRONT 1395 PTRROW = IOLDPS + HF + NASS1 + SHIFT_INDEX 1396 ENDIF 1397 ENDIF 1398 ENDDO 1399 IF (IERR .EQ. -2) GOTO 300 1400 IF (IERR .EQ. -3) GOTO 305 1401 PTRROW = PTRROW + NBLIG 1402 PDEST = PDEST + 1 1403 ENDDO 1404 DEALLOCATE(SONROWS_PER_ROW) 1405 IF (NUMSTK.EQ.0) GOTO 500 1406 ISON = IFSON 1407 DO IELL = 1, NUMSTK 1408 ISTCHK = PIMASTER(STEP(ISON)) 1409 NELIM = IW(ISTCHK + 1 + KEEP(IXSZ)) 1410 LSTK = IW(ISTCHK + KEEP(IXSZ)) 1411 NPIVS = IW(ISTCHK + 3 + KEEP(IXSZ)) 1412 IF ( NPIVS .LT. 0 ) NPIVS = 0 1413 NSLSON = IW(ISTCHK + 5 + KEEP(IXSZ)) 1414 HS = 6 + NSLSON + KEEP(IXSZ) 1415 NCOLS = NPIVS + LSTK 1416 SAME_PROC = (ISTCHK.LT.IWPOS) 1417 IF (.NOT.SAME_PROC) THEN 1418 NROWS = IW(ISTCHK + 2 + KEEP(IXSZ) ) 1419 ELSE 1420 NROWS = NCOLS 1421 ENDIF 1422 PDEST = ISTCHK + 6 + KEEP(IXSZ) 1423 NCBSON = LSTK - NELIM 1424 PTRCOL = ISTCHK + HS + NROWS + NPIVS + NELIM 1425 IF (KEEP(219).NE.0.AND.KEEP(50).EQ.2) THEN 1426 NFS4FATHER = NCBSON 1427 DO I=0,NCBSON-1 1428 IF(IW(PTRCOL+I) .GT. NASS1) THEN 1429 NFS4FATHER = I 1430 EXIT 1431 ENDIF 1432 ENDDO 1433 NFS4FATHER = NFS4FATHER + NELIM 1434 ELSE 1435 NFS4FATHER = 0 1436 ENDIF 1437 IF (NSLSON.EQ.0) THEN 1438 NSLSON = 1 1439 PDEST1(1) = MUMPS_PROCNODE(PROCNODE_STEPS(STEP(ISON)), 1440 & SLAVEF) 1441 IF (PDEST1(1).EQ.MYID) THEN 1442 CALL ZMUMPS_MAPLIG_FILS_NIV1( COMM_LOAD, ASS_IRECV, 1443 & BUFR, LBUFR, LBUFR_BYTES, 1444 & INODE, ISON, NSLAVES, 1445 & IW( PTLUST(STEP(INODE)) + 6 +KEEP(IXSZ)), 1446 & NFRONT, NASS1, NFS4FATHER, NCBSON, IW( PTRCOL ), 1447 & PROCNODE_STEPS, 1448 & SLAVEF, POSFAC, IWPOS, IWPOSCB, IPTRLU, LRLU, 1449 & LRLUS, N, IW, LIW, A, LA, 1450 & PTRIST, PTLUST, PTRFAC, PTRAST, STEP, 1451 & PIMASTER, PAMASTER, NSTK_S, COMP, 1452 & INFO(1), INFO(2), MYID, COMM, NBPROCFILS, 1453 & IPOOL, LPOOL, LEAF, 1454 & NBFIN, ICNTL, KEEP, KEEP8, DKEEP, root, 1455 & OPASSW, OPELIW, 1456 & ITLOC, RHS_MUMPS, FILS, PTRARW, PTRAIW, INTARR, DBLARR, 1457 & ND, FRERE, NELT+1, NELT, 1458 & FRT_PTR, FRT_ELT, 1459 & ISTEP_TO_INIV2, TAB_POS_IN_PERE 1460 & , LRGROUPS 1461 & ) 1462 IF ( INFO(1) .LT. 0 ) GOTO 500 1463 ELSE 1464 IERR = -1 1465 DO WHILE (IERR.EQ.-1) 1466 PTRCOL = PIMASTER(STEP(ISON)) + HS + NROWS + NPIVS + NELIM 1467 CALL ZMUMPS_BUF_SEND_MAPLIG( 1468 & INODE, NFRONT,NASS1,NFS4FATHER, 1469 & ISON, MYID, 1470 & NSLAVES, IW( PTLUST(STEP(INODE)) + 6 +KEEP(IXSZ)), 1471 & IW(PTRCOL), NCBSON, 1472 & COMM, IERR, PDEST1, NSLSON, SLAVEF, 1473 & KEEP,KEEP8, STEP, N, 1474 & ISTEP_TO_INIV2, TAB_POS_IN_PERE 1475 & ) 1476 IF (IERR.EQ.-1) THEN 1477 BLOCKING = .FALSE. 1478 SET_IRECV = .TRUE. 1479 MESSAGE_RECEIVED = .FALSE. 1480 CALL ZMUMPS_TRY_RECVTREAT( COMM_LOAD, ASS_IRECV, 1481 & BLOCKING, SET_IRECV, MESSAGE_RECEIVED, 1482 & MPI_ANY_SOURCE, MPI_ANY_TAG, 1483 & STATUS, BUFR, LBUFR, LBUFR_BYTES, 1484 & PROCNODE_STEPS, POSFAC, IWPOS, IWPOSCB, IPTRLU, 1485 & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, 1486 & PTLUST, PTRFAC, 1487 & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, INFO(1), 1488 & INFO(2), COMM, 1489 & NBPROCFILS, 1490 & IPOOL, LPOOL, LEAF, NBFIN, MYID, SLAVEF, 1491 & root,OPASSW, OPELIW, ITLOC, RHS_MUMPS, FILS, 1492 & PTRARW, PTRAIW, 1493 & INTARR, DBLARR, ICNTL, KEEP,KEEP8,DKEEP, ND, FRERE, 1494 & NELT+1, NELT, FRT_PTR, FRT_ELT, 1495 & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. 1496 & , LRGROUPS 1497 & ) 1498 IF ( INFO(1) .LT. 0 ) GOTO 500 1499 ENDIF 1500 ENDDO 1501 IF (IERR .EQ. -2) GOTO 290 1502 IF (IERR .EQ. -3) GOTO 295 1503 ENDIF 1504 ELSE 1505 IF (PIMASTER(STEP(ISON)).GT.0) THEN 1506 IERR = -1 1507 DO WHILE (IERR.EQ.-1) 1508 PTRCOL = PIMASTER(STEP(ISON)) + HS + NROWS + NPIVS + NELIM 1509 PDEST = PIMASTER(STEP(ISON)) + 6 + KEEP(IXSZ) 1510 CALL ZMUMPS_BUF_SEND_MAPLIG( 1511 & INODE, NFRONT, NASS1, NFS4FATHER, 1512 & ISON, MYID, 1513 & NSLAVES, IW(PTLUST(STEP(INODE))+6+KEEP(IXSZ)), 1514 & IW(PTRCOL), NCBSON, 1515 & COMM, IERR, IW(PDEST), NSLSON, SLAVEF, 1516 & KEEP,KEEP8, STEP, N, 1517 & ISTEP_TO_INIV2, TAB_POS_IN_PERE 1518 & ) 1519 IF (IERR.EQ.-1) THEN 1520 BLOCKING = .FALSE. 1521 SET_IRECV = .TRUE. 1522 MESSAGE_RECEIVED = .FALSE. 1523 CALL ZMUMPS_TRY_RECVTREAT( COMM_LOAD, ASS_IRECV, 1524 & BLOCKING, SET_IRECV, MESSAGE_RECEIVED, 1525 & MPI_ANY_SOURCE, MPI_ANY_TAG, 1526 & STATUS, BUFR, LBUFR, 1527 & LBUFR_BYTES, 1528 & PROCNODE_STEPS, POSFAC, IWPOS, IWPOSCB, IPTRLU, 1529 & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, 1530 & PTLUST, PTRFAC, 1531 & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, INFO(1), 1532 & INFO(2), COMM, 1533 & NBPROCFILS, 1534 & IPOOL, LPOOL, LEAF, NBFIN, MYID, SLAVEF, 1535 & root,OPASSW, OPELIW, ITLOC, RHS_MUMPS, 1536 & FILS, PTRARW, PTRAIW, 1537 & INTARR, DBLARR, ICNTL, KEEP,KEEP8,DKEEP, ND, FRERE, 1538 & NELT+1, NELT, FRT_PTR, FRT_ELT, 1539 & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. 1540 & , LRGROUPS 1541 & ) 1542 IF ( INFO(1) .LT. 0 ) GOTO 500 1543 ENDIF 1544 ENDDO 1545 IF (IERR .EQ. -2) GOTO 290 1546 IF (IERR .EQ. -3) GOTO 295 1547 ENDIF 1548 DO ISLAVE = 0, NSLSON-1 1549 IF (IW(PDEST+ISLAVE).EQ.MYID) THEN 1550 CALL MUMPS_BLOC2_GET_SLAVE_INFO( 1551 & KEEP,KEEP8, ISON, STEP, N, SLAVEF, 1552 & ISTEP_TO_INIV2, TAB_POS_IN_PERE, 1553 & ISLAVE+1, NCBSON, 1554 & NSLSON, 1555 & TROW_SIZE, FIRST_INDEX ) 1556 SHIFT_INDEX = FIRST_INDEX - 1 1557 INDX = PTRCOL + SHIFT_INDEX 1558 CALL ZMUMPS_MAPLIG( COMM_LOAD, ASS_IRECV, 1559 & BUFR, LBUFR, LBUFR_BYTES, 1560 & INODE, ISON, NSLAVES, 1561 & IW( PTLUST(STEP(INODE))+6+KEEP(IXSZ)), 1562 & NFRONT, NASS1,NFS4FATHER, 1563 & TROW_SIZE, IW( INDX ), 1564 & PROCNODE_STEPS, 1565 & SLAVEF, POSFAC, IWPOS, IWPOSCB, IPTRLU, LRLU, 1566 & LRLUS, N, IW, LIW, A, LA, 1567 & PTRIST, PTLUST, PTRFAC, PTRAST, STEP, 1568 & PIMASTER, PAMASTER, NSTK_S, COMP, INFO(1), INFO(2), 1569 & MYID, COMM, NBPROCFILS, IPOOL, LPOOL, LEAF, 1570 & NBFIN, ICNTL, KEEP,KEEP8,DKEEP, root, 1571 & OPASSW, OPELIW, ITLOC, RHS_MUMPS, FILS, PTRARW, PTRAIW, 1572 & INTARR, DBLARR, ND, FRERE, 1573 & NELT+1, NELT, FRT_PTR, FRT_ELT, 1574 & 1575 & ISTEP_TO_INIV2, TAB_POS_IN_PERE, LRGROUPS) 1576 IF ( INFO(1) .LT. 0 ) GOTO 500 1577 EXIT 1578 ENDIF 1579 ENDDO 1580 ENDIF 1581 ISON = FRERE(STEP(ISON)) 1582 ENDDO 1583 GOTO 500 1584 250 CONTINUE 1585 IF (INFO(1).EQ.-13) THEN 1586 IF (LPOK) THEN 1587 WRITE( LP, * ) 1588 &' FAILURE IN INTEGER DYNAMIC ALLOCATION DURING 1589 & ZMUMPS_FAC_ASM_NIV2_ELT' 1590 ENDIF 1591 INFO(2) = NUMSTK + 1 1592 ENDIF 1593 GOTO 490 1594 245 CONTINUE 1595 IF (LPOK) THEN 1596 WRITE( LP, * ) ' FAILURE ALLOCATING COPY_CAND', 1597 & ' DURING ZMUMPS_FAC_ASM_NIV2_ELT' 1598 ENDIF 1599 INFO(1) = -13 1600 INFO(2) = SLAVEF+1 1601 GOTO 490 1602 265 CONTINUE 1603 IF (LPOK) THEN 1604 WRITE( LP, * ) ' FAILURE ALLOCATING TMP_SLAVES_LIST', 1605 & ' DURING ZMUMPS_FAC_ASM_NIV2_ELT' 1606 ENDIF 1607 INFO(1) = -13 1608 INFO(2) = SIZE_TMP_SLAVES_LIST 1609 GOTO 490 1610 270 CONTINUE 1611 INFO(1) = -8 1612 INFO(2) = LREQ 1613 IF (LPOK) THEN 1614 WRITE( LP, * ) 1615 & ' FAILURE IN INTEGER ALLOCATION DURING ZMUMPS_ASM_NIV2_ELT' 1616 ENDIF 1617 GOTO 490 1618 275 CONTINUE 1619 IF (LPOK) THEN 1620 WRITE( LP, * ) ' FAILURE ALLOCATING SONROWS_PER_ROW', 1621 & ' DURING ZMUMPS_ASM_NIV2_ELT' 1622 ENDIF 1623 INFO(1) = -13 1624 INFO(2) = NFRONT-NASS1 1625 GOTO 490 1626 280 CONTINUE 1627 IF (LPOK) THEN 1628 WRITE( LP, * ) 1629 & ' FAILURE, WORKSPACE TOO SMALL DURING ZMUMPS_ASM_NIV2_ELT' 1630 ENDIF 1631 INFO(1) = -9 1632 CALL MUMPS_SET_IERROR(LAELL8-LRLUS, INFO(2)) 1633 GOTO 490 1634 290 CONTINUE 1635 IF (LPOK) THEN 1636 WRITE( LP, * ) 1637 &' FAILURE, SEND BUFFER TOO SMALL (1) DURING ZMUMPS_ASM_NIV2_ELT' 1638 ENDIF 1639 INFO(1) = -17 1640 LREQ = NCBSON + 6 + NSLSON+KEEP(IXSZ) 1641 INFO(2) = LREQ * KEEP( 34 ) 1642 GOTO 490 1643 295 CONTINUE 1644 IF (LPOK) THEN 1645 WRITE( LP, * ) 1646 &' FAILURE, RECV BUFFER TOO SMALL (1) DURING ZMUMPS_ASM_NIV2_ELT' 1647 ENDIF 1648 INFO(1) = -20 1649 LREQ = NCBSON + 6 + NSLSON+KEEP(IXSZ) 1650 INFO(2) = LREQ * KEEP( 34 ) 1651 GOTO 490 1652 300 CONTINUE 1653 IF (LPOK) THEN 1654 WRITE( LP, * ) 1655 &' FAILURE, SEND BUFFER TOO SMALL (2)', 1656 &' DURING ZMUMPS_FAC_ASM_NIV2_ELT' 1657 ENDIF 1658 INFO(1) = -17 1659 LREQ = NBLIG + NBCOL + 4 + KEEP(IXSZ) 1660 INFO(2) = LREQ * KEEP( 34 ) 1661 GOTO 490 1662 305 CONTINUE 1663 IF (LPOK) THEN 1664 WRITE( LP, * ) 1665 &' FAILURE, RECV BUFFER TOO SMALL (2)', 1666 &' DURING ZMUMPS_FAC_ASM_NIV2_ELT' 1667 ENDIF 1668 INFO(1) = -20 1669 LREQ = NBLIG + NBCOL + 4 + KEEP(IXSZ) 1670 INFO(2) = LREQ * KEEP( 34 ) 1671 GOTO 490 1672 490 CALL ZMUMPS_BDC_ERROR( MYID, SLAVEF, COMM, KEEP ) 1673 500 CONTINUE 1674 RETURN 1675 END SUBROUTINE ZMUMPS_FAC_ASM_NIV2_ELT 1676 END MODULE ZMUMPS_FAC_ASM_MASTER_ELT_M 1677