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