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 DMUMPS_FAC_ASM_MASTER_ELT_M 14 CONTAINS 15 SUBROUTINE DMUMPS_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 DMUMPS_BUF 34 USE DMUMPS_LOAD 35 USE DMUMPS_LR_CORE, ONLY : IS_FRONT_BLR_CANDIDATE 36 IMPLICIT NONE 37 INCLUDE 'dmumps_root.h' 38 TYPE (DMUMPS_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 DOUBLE PRECISION :: 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 DOUBLE PRECISION, 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 DOUBLE PRECISION 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 DOUBLE PRECISION, POINTER, DIMENSION(:) :: SON_A 134 INTEGER NCBSON 135 LOGICAL SAME_PROC 136 INTRINSIC real 137 DOUBLE PRECISION ZERO 138 PARAMETER( ZERO = 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 DMUMPS_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 DMUMPS_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 DMUMPS_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 DMUMPS_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 DMUMPS_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 DMUMPS_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 DMUMPS_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 DMUMPS_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 DMUMPS_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 DMUMPS_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 DMUMPS_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 DMUMPS_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 DMUMPS_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 DMUMPS_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 DMUMPS_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 DMUMPS_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 DMUMPS_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 DMUMPS_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 DMUMPS_ASM_NIV1_ELT' 641 ENDIF 642 INFO(2) = NUMSTK 643 ENDIF 644 490 CALL DMUMPS_BDC_ERROR( MYID, SLAVEF, COMM, KEEP ) 645 500 CONTINUE 646 RETURN 647 END SUBROUTINE DMUMPS_FAC_ASM_NIV1_ELT 648 SUBROUTINE DMUMPS_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 DMUMPS_BUF 668 USE DMUMPS_LOAD 669 USE DMUMPS_LR_CORE, ONLY : IS_FRONT_BLR_CANDIDATE 670 IMPLICIT NONE 671 INCLUDE 'dmumps_root.h' 672 TYPE (DMUMPS_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 DOUBLE PRECISION :: 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 DOUBLE PRECISION 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 DOUBLE PRECISION 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 DOUBLE PRECISION ZERO 765 DOUBLE PRECISION RZERO 766 PARAMETER( RZERO = 0.0D0 ) 767 PARAMETER( ZERO = 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 DMUMPS_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 DMUMPS_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 DMUMPS_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 DMUMPS_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 DMUMPS_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 DMUMPS_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 DMUMPS_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 DMUMPS_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 DMUMPS_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 DMUMPS_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 DMUMPS_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 DMUMPS_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 DMUMPS_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 DMUMPS_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 DMUMPS_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 DMUMPS_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 DMUMPS_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 DMUMPS_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 DMUMPS_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 DMUMPS_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))= 1279 & max(dble(A(APOSMAX+int(J-1,8))), 1280 & abs(DBLARR(AINPUT8))) 1281 ENDIF 1282 AINPUT8=AINPUT8+1_8 1283 ENDDO 1284 ENDIF 1285 AII8 = AII8 + J28 - II8 + 1_8 1286 CYCLE 1287 ELSE 1288 IF (KEEP(219).NE.0) THEN 1289 MAXARR = RZERO 1290 ENDIF 1291 DO JJ8=II8,J28 1292 J = INTARR(JJ8) 1293 IF ( J .LE. NASS1) THEN 1294 IF (I.LT.J) THEN 1295 APOS2 = ICT12 + int(J,8)*LDAFS8 1296 ELSE 1297 APOS2 = ICT21 + int(J,8) 1298 ENDIF 1299 A(APOS2) = A(APOS2) + DBLARR(AII8) 1300 ELSE IF (KEEP(219).NE.0.AND.KEEP(50).EQ.2) THEN 1301 MAXARR = max(MAXARR,abs(DBLARR(AII8))) 1302 ENDIF 1303 AII8 = AII8 + 1_8 1304 END DO 1305 IF(KEEP(219).NE.0.AND.KEEP(50) .EQ. 2) THEN 1306 A(APOSMAX+int(I-1,8)) = 1307 & max( MAXARR, dble(A(APOSMAX+int(I-1,8)))) 1308 ENDIF 1309 ENDIF 1310 END IF 1311 END DO 1312 END DO 1313 IF (KEEP(253).GT.0) THEN 1314 POSELT = PTRAST(STEP(INODE)) 1315 IBROT = INODE 1316 IJROW = Pos_First_NUMORG 1317 DO IORG = 1, NUMORG 1318 IF (KEEP(50).EQ.0) THEN 1319 DO J253 = 1, KEEP(253) 1320 APOS = POSELT + 1321 & int(IJROW-1,8) * int(LDAFS,8) + 1322 & int(LDAFS-KEEP(253)+J253-1,8) 1323 A(APOS) = A(APOS) + RHS_MUMPS( (J253-1)*KEEP(254)+IBROT ) 1324 ENDDO 1325 ENDIF 1326 IBROT = FILS(IBROT) 1327 IJROW = IJROW+1 1328 ENDDO 1329 ENDIF 1330 PTRCOL = IOLDPS + HF + NFRONT 1331 PTRROW = IOLDPS + HF + NASS1 1332 PDEST = IOLDPS + 6 + KEEP(IXSZ) 1333 IBC_SOURCE = MYID 1334 DO ISLAVE = 1, NSLAVES 1335 CALL MUMPS_BLOC2_GET_SLAVE_INFO( 1336 & KEEP,KEEP8, INODE, STEP, N, SLAVEF, 1337 & ISTEP_TO_INIV2, TAB_POS_IN_PERE, 1338 & ISLAVE, NCB, 1339 & NSLAVES, 1340 & NBLIG, FIRST_INDEX ) 1341 SHIFT_INDEX = FIRST_INDEX - 1 1342 IERR = -1 1343 DO WHILE (IERR .EQ.-1) 1344 IF ( KEEP(50) .eq. 0 ) THEN 1345 NBCOL = NFRONT 1346 CALL DMUMPS_BUF_SEND_DESC_BANDE( INODE, 1347 & sum(SONROWS_PER_ROW(FIRST_INDEX:FIRST_INDEX+NBLIG-1)), 1348 & NBLIG, IW(PTRROW), NBCOL, IW(PTRCOL), NASS1, 1349 & IZERO, IDUMMY, 1350 & IW(PDEST), IBC_SOURCE, NFRONT, COMM, KEEP, IERR 1351 & , IW(IOLDPS+XXLR) 1352 & ) 1353 ELSE 1354 NBCOL = NASS1+SHIFT_INDEX+NBLIG 1355 CALL DMUMPS_BUF_SEND_DESC_BANDE( INODE, 1356 & sum(SONROWS_PER_ROW(FIRST_INDEX:FIRST_INDEX+NBLIG-1)), 1357 & NBLIG, IW(PTRROW), NBCOL, IW(PTRCOL), NASS1, 1358 & NSLAVES-ISLAVE, 1359 & IW( PTLUST(STEP(INODE))+6+KEEP(IXSZ)+ISLAVE), 1360 & IW(PDEST), IBC_SOURCE, NFRONT, COMM, KEEP, IERR 1361 & , IW(IOLDPS+XXLR) 1362 & ) 1363 ENDIF 1364 IF (IERR.EQ.-1) THEN 1365 BLOCKING = .FALSE. 1366 SET_IRECV = .TRUE. 1367 MESSAGE_RECEIVED = .FALSE. 1368 CALL DMUMPS_TRY_RECVTREAT( COMM_LOAD, ASS_IRECV, 1369 & BLOCKING, SET_IRECV, MESSAGE_RECEIVED, 1370 & MPI_ANY_SOURCE, MPI_ANY_TAG, 1371 & STATUS, BUFR, LBUFR, 1372 & LBUFR_BYTES, 1373 & PROCNODE_STEPS, POSFAC, IWPOS, IWPOSCB, IPTRLU, 1374 & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, 1375 & PTLUST, PTRFAC, 1376 & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, INFO(1), 1377 & INFO(2), COMM, 1378 & NBPROCFILS, 1379 & IPOOL, LPOOL, LEAF, NBFIN, MYID, SLAVEF, 1380 & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, 1381 & FILS, PTRARW, PTRAIW, 1382 & INTARR, DBLARR, ICNTL, KEEP,KEEP8,DKEEP, ND, FRERE, 1383 & NELT+1, NELT, FRT_PTR, FRT_ELT, 1384 & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. 1385 & , LRGROUPS 1386 & ) 1387 IF ( INFO(1) .LT. 0 ) GOTO 500 1388 IF (MESSAGE_RECEIVED) THEN 1389 IOLDPS = PTLUST(STEP(INODE)) 1390 PTRCOL = IOLDPS + HF + NFRONT 1391 PTRROW = IOLDPS + HF + NASS1 + SHIFT_INDEX 1392 ENDIF 1393 ENDIF 1394 ENDDO 1395 IF (IERR .EQ. -2) GOTO 300 1396 IF (IERR .EQ. -3) GOTO 305 1397 PTRROW = PTRROW + NBLIG 1398 PDEST = PDEST + 1 1399 ENDDO 1400 DEALLOCATE(SONROWS_PER_ROW) 1401 IF (NUMSTK.EQ.0) GOTO 500 1402 ISON = IFSON 1403 DO IELL = 1, NUMSTK 1404 ISTCHK = PIMASTER(STEP(ISON)) 1405 NELIM = IW(ISTCHK + 1 + KEEP(IXSZ)) 1406 LSTK = IW(ISTCHK + KEEP(IXSZ)) 1407 NPIVS = IW(ISTCHK + 3 + KEEP(IXSZ)) 1408 IF ( NPIVS .LT. 0 ) NPIVS = 0 1409 NSLSON = IW(ISTCHK + 5 + KEEP(IXSZ)) 1410 HS = 6 + NSLSON + KEEP(IXSZ) 1411 NCOLS = NPIVS + LSTK 1412 SAME_PROC = (ISTCHK.LT.IWPOS) 1413 IF (.NOT.SAME_PROC) THEN 1414 NROWS = IW(ISTCHK + 2 + KEEP(IXSZ) ) 1415 ELSE 1416 NROWS = NCOLS 1417 ENDIF 1418 PDEST = ISTCHK + 6 + KEEP(IXSZ) 1419 NCBSON = LSTK - NELIM 1420 PTRCOL = ISTCHK + HS + NROWS + NPIVS + NELIM 1421 IF (KEEP(219).NE.0.AND.KEEP(50).EQ.2) THEN 1422 NFS4FATHER = NCBSON 1423 DO I=0,NCBSON-1 1424 IF(IW(PTRCOL+I) .GT. NASS1) THEN 1425 NFS4FATHER = I 1426 EXIT 1427 ENDIF 1428 ENDDO 1429 NFS4FATHER = NFS4FATHER + NELIM 1430 ELSE 1431 NFS4FATHER = 0 1432 ENDIF 1433 IF (NSLSON.EQ.0) THEN 1434 NSLSON = 1 1435 PDEST1(1) = MUMPS_PROCNODE(PROCNODE_STEPS(STEP(ISON)), 1436 & SLAVEF) 1437 IF (PDEST1(1).EQ.MYID) THEN 1438 CALL DMUMPS_MAPLIG_FILS_NIV1( COMM_LOAD, ASS_IRECV, 1439 & BUFR, LBUFR, LBUFR_BYTES, 1440 & INODE, ISON, NSLAVES, 1441 & IW( PTLUST(STEP(INODE)) + 6 +KEEP(IXSZ)), 1442 & NFRONT, NASS1, NFS4FATHER, NCBSON, IW( PTRCOL ), 1443 & PROCNODE_STEPS, 1444 & SLAVEF, POSFAC, IWPOS, IWPOSCB, IPTRLU, LRLU, 1445 & LRLUS, N, IW, LIW, A, LA, 1446 & PTRIST, PTLUST, PTRFAC, PTRAST, STEP, 1447 & PIMASTER, PAMASTER, NSTK_S, COMP, 1448 & INFO(1), INFO(2), MYID, COMM, NBPROCFILS, 1449 & IPOOL, LPOOL, LEAF, 1450 & NBFIN, ICNTL, KEEP, KEEP8, DKEEP, root, 1451 & OPASSW, OPELIW, 1452 & ITLOC, RHS_MUMPS, FILS, PTRARW, PTRAIW, INTARR, DBLARR, 1453 & ND, FRERE, NELT+1, NELT, 1454 & FRT_PTR, FRT_ELT, 1455 & ISTEP_TO_INIV2, TAB_POS_IN_PERE 1456 & , LRGROUPS 1457 & ) 1458 IF ( INFO(1) .LT. 0 ) GOTO 500 1459 ELSE 1460 IERR = -1 1461 DO WHILE (IERR.EQ.-1) 1462 PTRCOL = PIMASTER(STEP(ISON)) + HS + NROWS + NPIVS + NELIM 1463 CALL DMUMPS_BUF_SEND_MAPLIG( 1464 & INODE, NFRONT,NASS1,NFS4FATHER, 1465 & ISON, MYID, 1466 & NSLAVES, IW( PTLUST(STEP(INODE)) + 6 +KEEP(IXSZ)), 1467 & IW(PTRCOL), NCBSON, 1468 & COMM, IERR, PDEST1, NSLSON, SLAVEF, 1469 & KEEP,KEEP8, STEP, N, 1470 & ISTEP_TO_INIV2, TAB_POS_IN_PERE 1471 & ) 1472 IF (IERR.EQ.-1) THEN 1473 BLOCKING = .FALSE. 1474 SET_IRECV = .TRUE. 1475 MESSAGE_RECEIVED = .FALSE. 1476 CALL DMUMPS_TRY_RECVTREAT( COMM_LOAD, ASS_IRECV, 1477 & BLOCKING, SET_IRECV, MESSAGE_RECEIVED, 1478 & MPI_ANY_SOURCE, MPI_ANY_TAG, 1479 & STATUS, BUFR, LBUFR, LBUFR_BYTES, 1480 & PROCNODE_STEPS, POSFAC, IWPOS, IWPOSCB, IPTRLU, 1481 & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, 1482 & PTLUST, PTRFAC, 1483 & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, INFO(1), 1484 & INFO(2), COMM, 1485 & NBPROCFILS, 1486 & IPOOL, LPOOL, LEAF, NBFIN, MYID, SLAVEF, 1487 & root,OPASSW, OPELIW, ITLOC, RHS_MUMPS, FILS, 1488 & PTRARW, PTRAIW, 1489 & INTARR, DBLARR, ICNTL, KEEP,KEEP8,DKEEP, ND, FRERE, 1490 & NELT+1, NELT, FRT_PTR, FRT_ELT, 1491 & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. 1492 & , LRGROUPS 1493 & ) 1494 IF ( INFO(1) .LT. 0 ) GOTO 500 1495 ENDIF 1496 ENDDO 1497 IF (IERR .EQ. -2) GOTO 290 1498 IF (IERR .EQ. -3) GOTO 295 1499 ENDIF 1500 ELSE 1501 IF (PIMASTER(STEP(ISON)).GT.0) THEN 1502 IERR = -1 1503 DO WHILE (IERR.EQ.-1) 1504 PTRCOL = PIMASTER(STEP(ISON)) + HS + NROWS + NPIVS + NELIM 1505 PDEST = PIMASTER(STEP(ISON)) + 6 + KEEP(IXSZ) 1506 CALL DMUMPS_BUF_SEND_MAPLIG( 1507 & INODE, NFRONT, NASS1, NFS4FATHER, 1508 & ISON, MYID, 1509 & NSLAVES, IW(PTLUST(STEP(INODE))+6+KEEP(IXSZ)), 1510 & IW(PTRCOL), NCBSON, 1511 & COMM, IERR, IW(PDEST), NSLSON, SLAVEF, 1512 & KEEP,KEEP8, STEP, N, 1513 & ISTEP_TO_INIV2, TAB_POS_IN_PERE 1514 & ) 1515 IF (IERR.EQ.-1) THEN 1516 BLOCKING = .FALSE. 1517 SET_IRECV = .TRUE. 1518 MESSAGE_RECEIVED = .FALSE. 1519 CALL DMUMPS_TRY_RECVTREAT( COMM_LOAD, ASS_IRECV, 1520 & BLOCKING, SET_IRECV, MESSAGE_RECEIVED, 1521 & MPI_ANY_SOURCE, MPI_ANY_TAG, 1522 & STATUS, BUFR, LBUFR, 1523 & LBUFR_BYTES, 1524 & PROCNODE_STEPS, POSFAC, IWPOS, IWPOSCB, IPTRLU, 1525 & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, 1526 & PTLUST, PTRFAC, 1527 & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, INFO(1), 1528 & INFO(2), COMM, 1529 & NBPROCFILS, 1530 & IPOOL, LPOOL, LEAF, NBFIN, MYID, SLAVEF, 1531 & root,OPASSW, OPELIW, ITLOC, RHS_MUMPS, 1532 & FILS, PTRARW, PTRAIW, 1533 & INTARR, DBLARR, ICNTL, KEEP,KEEP8,DKEEP, ND, FRERE, 1534 & NELT+1, NELT, FRT_PTR, FRT_ELT, 1535 & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. 1536 & , LRGROUPS 1537 & ) 1538 IF ( INFO(1) .LT. 0 ) GOTO 500 1539 ENDIF 1540 ENDDO 1541 IF (IERR .EQ. -2) GOTO 290 1542 IF (IERR .EQ. -3) GOTO 295 1543 ENDIF 1544 DO ISLAVE = 0, NSLSON-1 1545 IF (IW(PDEST+ISLAVE).EQ.MYID) THEN 1546 CALL MUMPS_BLOC2_GET_SLAVE_INFO( 1547 & KEEP,KEEP8, ISON, STEP, N, SLAVEF, 1548 & ISTEP_TO_INIV2, TAB_POS_IN_PERE, 1549 & ISLAVE+1, NCBSON, 1550 & NSLSON, 1551 & TROW_SIZE, FIRST_INDEX ) 1552 SHIFT_INDEX = FIRST_INDEX - 1 1553 INDX = PTRCOL + SHIFT_INDEX 1554 CALL DMUMPS_MAPLIG( COMM_LOAD, ASS_IRECV, 1555 & BUFR, LBUFR, LBUFR_BYTES, 1556 & INODE, ISON, NSLAVES, 1557 & IW( PTLUST(STEP(INODE))+6+KEEP(IXSZ)), 1558 & NFRONT, NASS1,NFS4FATHER, 1559 & TROW_SIZE, IW( INDX ), 1560 & PROCNODE_STEPS, 1561 & SLAVEF, POSFAC, IWPOS, IWPOSCB, IPTRLU, LRLU, 1562 & LRLUS, N, IW, LIW, A, LA, 1563 & PTRIST, PTLUST, PTRFAC, PTRAST, STEP, 1564 & PIMASTER, PAMASTER, NSTK_S, COMP, INFO(1), INFO(2), 1565 & MYID, COMM, NBPROCFILS, IPOOL, LPOOL, LEAF, 1566 & NBFIN, ICNTL, KEEP,KEEP8,DKEEP, root, 1567 & OPASSW, OPELIW, ITLOC, RHS_MUMPS, FILS, PTRARW, PTRAIW, 1568 & INTARR, DBLARR, ND, FRERE, 1569 & NELT+1, NELT, FRT_PTR, FRT_ELT, 1570 & 1571 & ISTEP_TO_INIV2, TAB_POS_IN_PERE, LRGROUPS) 1572 IF ( INFO(1) .LT. 0 ) GOTO 500 1573 EXIT 1574 ENDIF 1575 ENDDO 1576 ENDIF 1577 ISON = FRERE(STEP(ISON)) 1578 ENDDO 1579 GOTO 500 1580 250 CONTINUE 1581 IF (INFO(1).EQ.-13) THEN 1582 IF (LPOK) THEN 1583 WRITE( LP, * ) 1584 &' FAILURE IN INTEGER DYNAMIC ALLOCATION DURING 1585 & DMUMPS_FAC_ASM_NIV2_ELT' 1586 ENDIF 1587 INFO(2) = NUMSTK + 1 1588 ENDIF 1589 GOTO 490 1590 245 CONTINUE 1591 IF (LPOK) THEN 1592 WRITE( LP, * ) ' FAILURE ALLOCATING COPY_CAND', 1593 & ' DURING DMUMPS_FAC_ASM_NIV2_ELT' 1594 ENDIF 1595 INFO(1) = -13 1596 INFO(2) = SLAVEF+1 1597 GOTO 490 1598 265 CONTINUE 1599 IF (LPOK) THEN 1600 WRITE( LP, * ) ' FAILURE ALLOCATING TMP_SLAVES_LIST', 1601 & ' DURING DMUMPS_FAC_ASM_NIV2_ELT' 1602 ENDIF 1603 INFO(1) = -13 1604 INFO(2) = SIZE_TMP_SLAVES_LIST 1605 GOTO 490 1606 270 CONTINUE 1607 INFO(1) = -8 1608 INFO(2) = LREQ 1609 IF (LPOK) THEN 1610 WRITE( LP, * ) 1611 & ' FAILURE IN INTEGER ALLOCATION DURING DMUMPS_ASM_NIV2_ELT' 1612 ENDIF 1613 GOTO 490 1614 275 CONTINUE 1615 IF (LPOK) THEN 1616 WRITE( LP, * ) ' FAILURE ALLOCATING SONROWS_PER_ROW', 1617 & ' DURING DMUMPS_ASM_NIV2_ELT' 1618 ENDIF 1619 INFO(1) = -13 1620 INFO(2) = NFRONT-NASS1 1621 GOTO 490 1622 280 CONTINUE 1623 IF (LPOK) THEN 1624 WRITE( LP, * ) 1625 & ' FAILURE, WORKSPACE TOO SMALL DURING DMUMPS_ASM_NIV2_ELT' 1626 ENDIF 1627 INFO(1) = -9 1628 CALL MUMPS_SET_IERROR(LAELL8-LRLUS, INFO(2)) 1629 GOTO 490 1630 290 CONTINUE 1631 IF (LPOK) THEN 1632 WRITE( LP, * ) 1633 &' FAILURE, SEND BUFFER TOO SMALL (1) DURING DMUMPS_ASM_NIV2_ELT' 1634 ENDIF 1635 INFO(1) = -17 1636 LREQ = NCBSON + 6 + NSLSON+KEEP(IXSZ) 1637 INFO(2) = LREQ * KEEP( 34 ) 1638 GOTO 490 1639 295 CONTINUE 1640 IF (LPOK) THEN 1641 WRITE( LP, * ) 1642 &' FAILURE, RECV BUFFER TOO SMALL (1) DURING DMUMPS_ASM_NIV2_ELT' 1643 ENDIF 1644 INFO(1) = -20 1645 LREQ = NCBSON + 6 + NSLSON+KEEP(IXSZ) 1646 INFO(2) = LREQ * KEEP( 34 ) 1647 GOTO 490 1648 300 CONTINUE 1649 IF (LPOK) THEN 1650 WRITE( LP, * ) 1651 &' FAILURE, SEND BUFFER TOO SMALL (2)', 1652 &' DURING DMUMPS_FAC_ASM_NIV2_ELT' 1653 ENDIF 1654 INFO(1) = -17 1655 LREQ = NBLIG + NBCOL + 4 + KEEP(IXSZ) 1656 INFO(2) = LREQ * KEEP( 34 ) 1657 GOTO 490 1658 305 CONTINUE 1659 IF (LPOK) THEN 1660 WRITE( LP, * ) 1661 &' FAILURE, RECV BUFFER TOO SMALL (2)', 1662 &' DURING DMUMPS_FAC_ASM_NIV2_ELT' 1663 ENDIF 1664 INFO(1) = -20 1665 LREQ = NBLIG + NBCOL + 4 + KEEP(IXSZ) 1666 INFO(2) = LREQ * KEEP( 34 ) 1667 GOTO 490 1668 490 CALL DMUMPS_BDC_ERROR( MYID, SLAVEF, COMM, KEEP ) 1669 500 CONTINUE 1670 RETURN 1671 END SUBROUTINE DMUMPS_FAC_ASM_NIV2_ELT 1672 END MODULE DMUMPS_FAC_ASM_MASTER_ELT_M 1673