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 SUBROUTINE SMUMPS_FAC_STACK(COMM_LOAD, ASS_IRECV, 14 & N, INODE, TYPE, TYPEF, 15 & LA, IW, LIW, A, 16 & IFLAG, IERROR, OPELIW, NELVAW, NMAXNPIV, 17 & PTRIST, PTLUST_S, 18 & PTRFAC, PTRAST, 19 & STEP, PIMASTER, PAMASTER, NE, 20 & POSFAC, LRLU, LRLUS, IPTRLU, ICNTL, KEEP,KEEP8,DKEEP, 21 & COMP, IWPOS, IWPOSCB, PROCNODE_STEPS, SLAVEF, 22 & FPERE, COMM, MYID, 23 & IPOOL, LPOOL, LEAF, NSTK_S, 24 & NBPROCFILS, 25 & BUFR, LBUFR, LBUFR_BYTES, NBFIN, root, 26 & OPASSW, ITLOC, RHS_MUMPS, 27 & FILS, PTRARW, PTRAIW, INTARR, DBLARR, 28 & ND, FRERE, LPTRAR, NELT, FRTPTR, FRTELT, 29 & ISTEP_TO_INIV2, TAB_POS_IN_PERE 30 & , LRGROUPS 31 & ) 32 USE SMUMPS_BUF 33 USE SMUMPS_LOAD 34 IMPLICIT NONE 35 INCLUDE 'smumps_root.h' 36 TYPE (SMUMPS_ROOT_STRUC) :: root 37 INTEGER COMM_LOAD, ASS_IRECV 38 INTEGER COMM, MYID, TYPE, TYPEF 39 INTEGER N, LIW, INODE,IFLAG,IERROR 40 INTEGER ICNTL(40), KEEP(500) 41 REAL DKEEP(230) 42 INTEGER(8) KEEP8(150) 43 INTEGER(8) :: LA, POSFAC, LRLU, LRLUS, IPTRLU 44 INTEGER IWPOSCB, IWPOS, 45 & FPERE, SLAVEF, NELVAW, NMAXNPIV 46 INTEGER IW(LIW),PROCNODE_STEPS(KEEP(28)) 47 INTEGER(8) :: PTRAST (KEEP(28)) 48 INTEGER(8) :: PTRFAC (KEEP(28)) 49 INTEGER(8) :: PAMASTER(KEEP(28)) 50 INTEGER PTRIST(KEEP(28)), PTLUST_S(KEEP(28)) 51 INTEGER STEP(N), PIMASTER(KEEP(28)), NE(KEEP(28)) 52 REAL A(LA) 53 INTEGER, intent(in) :: LRGROUPS(N) 54 DOUBLE PRECISION OPASSW, OPELIW 55 REAL DBLARR(KEEP8(26)) 56 INTEGER INTARR(KEEP8(27)) 57 INTEGER ITLOC( N + KEEP(253) ), FILS( N ), 58 & ND( KEEP(28) ), FRERE( KEEP(28) ) 59 REAL :: RHS_MUMPS(KEEP(255)) 60 INTEGER ISTEP_TO_INIV2(KEEP(71)), 61 & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) 62 INTEGER NELT, LPTRAR 63 INTEGER FRTPTR( N+1 ), FRTELT( NELT ) 64 INTEGER(8), INTENT(IN) :: PTRAIW( LPTRAR ), PTRARW( LPTRAR ) 65 INTEGER LPOOL, LEAF, COMP 66 INTEGER IPOOL( LPOOL ) 67 INTEGER NSTK_S( KEEP(28) ) 68 INTEGER NBPROCFILS( KEEP(28) ) 69 INTEGER LBUFR, LBUFR_BYTES 70 INTEGER BUFR( LBUFR ) 71 INTEGER NBFIN 72 INTEGER NFRONT_ESTIM,NELIM_ESTIM 73 INTEGER MUMPS_PROCNODE 74 EXTERNAL MUMPS_PROCNODE 75 INCLUDE 'mpif.h' 76 INCLUDE 'mumps_tags.h' 77 INTEGER :: STATUS(MPI_STATUS_SIZE) 78 INTEGER LP 79 INTEGER NBROWS_ALREADY_SENT 80 INTEGER(8) :: POSELT, OPSFAC 81 INTEGER(8) :: IOLD, INEW, FACTOR_POS 82 INTEGER NSLAVES, NCB, 83 & H_INODE, IERR, NBCOL, NBROW, NBROW_SEND, 84 & NBROW_STACK, NBCOL_STACK, NELIM 85 INTEGER NCBROW_ALREADY_MOVED, NCBROW_PREVIOUSLY_MOVED, 86 &NCBROW_NEWLY_MOVED 87 INTEGER(8) :: LAST_ALLOWED_POS 88 INTEGER(8) :: LREQCB, MIN_SPACE_IN_PLACE 89 INTEGER(8) :: SHIFT_VAL_SON 90 INTEGER SHIFT_LIST_ROW_SON, 91 & SHIFT_LIST_COL_SON, 92 & LIST_ROW_SON, LIST_COL_SON, LIST_SLAVES 93 INTEGER IOLDPS,NFRONT,NPIV,NASS,IOLDP1,PTROWEND, 94 & LREQI, LCONT 95 INTEGER I,LDA, INIV2 96 INTEGER MSGDEST, MSGTAG, CHK_LOAD 97 INCLUDE 'mumps_headers.h' 98 LOGICAL COMPRESSCB, MUST_COMPACT_FACTORS 99 LOGICAL INPLACE 100 INTEGER(8) :: SIZE_INPLACE 101 INTEGER INTSIZ 102 DOUBLE PRECISION FLOP1, FLOP1_EFFECTIVE 103 LOGICAL BLOCKING, SET_IRECV, MESSAGE_RECEIVED 104 LOGICAL SSARBR, SSARBR_ROOT, MUMPS_INSSARBR, 105 & MUMPS_IN_OR_ROOT_SSARBR, MUMPS_ROOTSSARBR 106 EXTERNAL MUMPS_INSSARBR, MUMPS_IN_OR_ROOT_SSARBR, 107 & MUMPS_ROOTSSARBR 108 LP = ICNTL(1) 109 IF (ICNTL(4) .LE. 0) LP = -1 110 INPLACE = .FALSE. 111 MIN_SPACE_IN_PLACE = 0_8 112 IOLDPS = PTLUST_S(STEP(INODE)) 113 INTSIZ = IW(IOLDPS+XXI) 114 NFRONT = IW(IOLDPS+KEEP(IXSZ)) 115 NPIV = IW(IOLDPS + 1+KEEP(IXSZ)) 116 NMAXNPIV = max(NPIV, NMAXNPIV) 117 NASS = iabs(IW(IOLDPS + 2+KEEP(IXSZ))) 118 NSLAVES= IW(IOLDPS+5+KEEP(IXSZ)) 119 H_INODE= 6 + NSLAVES + KEEP(IXSZ) 120 LCONT = NFRONT - NPIV 121 NBCOL = LCONT 122 SSARBR = MUMPS_INSSARBR(PROCNODE_STEPS(STEP(INODE)),SLAVEF) 123 SSARBR_ROOT = MUMPS_IN_OR_ROOT_SSARBR 124 & (PROCNODE_STEPS(STEP(INODE)),SLAVEF) 125 LREQCB = 0_8 126 INPLACE = .FALSE. 127 COMPRESSCB= ((KEEP(215).EQ.0) 128 & .AND.(KEEP(50).NE.0) 129 & .AND.(TYPEF.EQ.1 130 & .OR.TYPEF.EQ.2 131 & ) 132 & .AND.(TYPE.EQ.1)) 133 MUST_COMPACT_FACTORS = .TRUE. 134 IF (KEEP(201).EQ.1 .OR. KEEP(201).EQ.-1) THEN 135 MUST_COMPACT_FACTORS = .FALSE. 136 ENDIF 137 IF ((FPERE.EQ.0).AND.(NASS.NE.NPIV)) THEN 138 IFLAG = -10 139 GOTO 600 140 ENDIF 141 NBROW = LCONT 142 IF (TYPE.EQ.2) NBROW = NASS - NPIV 143 IF ((KEEP(50).NE.0).AND.(TYPE.EQ.2)) THEN 144 LDA = NASS 145 ELSE 146 LDA = NFRONT 147 ENDIF 148 NBROW_SEND = NBROW 149 NELIM = NASS-NPIV 150 IF (TYPEF.EQ.2) NBROW_SEND = NELIM 151 POSELT = PTRAST(STEP(INODE)) 152 IF (POSELT .ne. PTRFAC(STEP(INODE))) THEN 153 WRITE(*,*) MYID,":Error 1 in SMUMPS_FAC_STACK:" 154 WRITE(*,*) "INODE, PTRAST, PTRFAC =", 155 & INODE, PTRAST(STEP(INODE)), PTRFAC(STEP(INODE)) 156 WRITE(*,*) "COMPRESSCB, NFRONT, NPIV, NASS, NSLAVES", 157 & COMPRESSCB, NFRONT, NPIV, NASS, NSLAVES 158 WRITE(*,*) "TYPE, TYPEF, FPERE ", 159 & TYPE, TYPEF, FPERE 160 CALL MUMPS_ABORT() 161 END IF 162 NELVAW = NELVAW + NASS - NPIV 163 IF (KEEP(50) .eq. 0) THEN 164 KEEP8(10) = KEEP8(10) + int(NPIV,8) * int(NFRONT,8) 165 ELSE 166 KEEP8(10) = KEEP8(10) + ( int(NPIV,8)*int(NPIV+1,8) )/ 2_8 167 ENDIF 168 KEEP8(10) = KEEP8(10) + int(NBROW,8) * int(NPIV,8) 169 CALL MUMPS_GET_FLOPS_COST( NFRONT, NPIV, NASS, 170 & KEEP(50), TYPE,FLOP1 ) 171 IF ( (.NOT. SSARBR_ROOT) .and. TYPE == 1) THEN 172 IF (NE(STEP(INODE))==0) THEN 173 CHK_LOAD=0 174 ELSE 175 CHK_LOAD=1 176 ENDIF 177 CALL SMUMPS_LOAD_UPDATE(CHK_LOAD, .FALSE., -FLOP1, 178 & KEEP,KEEP8) 179 ENDIF 180 FLOP1_EFFECTIVE = FLOP1 181 OPELIW = OPELIW + FLOP1 182 IF ( NPIV .NE. NASS ) THEN 183 CALL MUMPS_GET_FLOPS_COST( NFRONT, NASS, NASS, 184 & KEEP(50), TYPE,FLOP1 ) 185 IF (.NOT. SSARBR_ROOT ) THEN 186 IF (NE(STEP(INODE))==0) THEN 187 CHK_LOAD=0 188 ELSE 189 CHK_LOAD=1 190 ENDIF 191 CALL SMUMPS_LOAD_UPDATE(CHK_LOAD, .FALSE., 192 & FLOP1_EFFECTIVE-FLOP1, 193 & KEEP,KEEP8) 194 ENDIF 195 END IF 196 IF ( SSARBR_ROOT ) THEN 197 NFRONT_ESTIM=ND(STEP(INODE)) + KEEP(253) 198 NELIM_ESTIM=NASS-(NFRONT-NFRONT_ESTIM) 199 CALL MUMPS_GET_FLOPS_COST(NFRONT_ESTIM,NELIM_ESTIM,NELIM_ESTIM, 200 & KEEP(50),1,FLOP1) 201 END IF 202 FLOP1=-FLOP1 203 IF (SSARBR_ROOT) THEN 204 CALL SMUMPS_LOAD_UPDATE(0,.FALSE.,FLOP1,KEEP,KEEP8) 205 ELSE 206 CALL SMUMPS_LOAD_UPDATE(2,.FALSE.,FLOP1,KEEP,KEEP8) 207 ENDIF 208 IF ( FPERE .EQ. 0 ) THEN 209 IF ( KEEP(253) .NE. 0 .AND. KEEP(201).NE.-1 210 & .AND. KEEP(201).NE.1 ) THEN 211 MUST_COMPACT_FACTORS = .TRUE. 212 GOTO 190 213 ELSE 214 MUST_COMPACT_FACTORS = .FALSE. 215 GOTO 190 216 ENDIF 217 ENDIF 218 IF ( FPERE.EQ.KEEP(38) ) THEN 219 NCB = NFRONT - NASS 220 SHIFT_LIST_ROW_SON = H_INODE + NASS 221 SHIFT_LIST_COL_SON = H_INODE + NFRONT + NASS 222 SHIFT_VAL_SON = int(NASS,8)*int(NFRONT+1,8) 223 IF (TYPE.EQ.1) THEN 224 CALL SMUMPS_BUILD_AND_SEND_CB_ROOT( 225 & COMM_LOAD, ASS_IRECV, 226 & N, INODE, FPERE, 227 & PTLUST_S, PTRAST, 228 & root, NCB, NCB, SHIFT_LIST_ROW_SON, 229 & SHIFT_LIST_COL_SON , SHIFT_VAL_SON, NFRONT, 230 & ROOT_CONT_STATIC, MYID, COMM, 231 & 232 & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, 233 & IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, IW, LIW, A, LA, 234 & PTRIST, PTLUST_S, PTRFAC, 235 & PTRAST, STEP, PIMASTER, PAMASTER, 236 & NSTK_S, COMP, IFLAG, IERROR, NBPROCFILS, 237 & IPOOL, LPOOL, LEAF, NBFIN, SLAVEF, 238 & OPASSW, OPELIW, ITLOC, RHS_MUMPS, FILS, PTRARW, PTRAIW, 239 & INTARR,DBLARR,ICNTL,KEEP,KEEP8,DKEEP,.FALSE., ND, FRERE, 240 & LPTRAR, NELT, FRTPTR, FRTELT, 241 & ISTEP_TO_INIV2, TAB_POS_IN_PERE 242 & , LRGROUPS 243 & ) 244 IF (IFLAG < 0 ) GOTO 500 245 ENDIF 246 MSGDEST= MUMPS_PROCNODE(PROCNODE_STEPS(STEP(FPERE)),SLAVEF) 247 IOLDPS = PTLUST_S(STEP(INODE)) 248 LIST_ROW_SON = IOLDPS + H_INODE + NPIV 249 LIST_COL_SON = IOLDPS + H_INODE + NFRONT + NPIV 250 LIST_SLAVES = IOLDPS + 6 + KEEP(IXSZ) 251 IF (MSGDEST.EQ.MYID) THEN 252 CALL SMUMPS_PROCESS_RTNELIND( root, 253 & INODE, NELIM, NSLAVES, IW(LIST_ROW_SON), 254 & IW(LIST_COL_SON), IW(LIST_SLAVES), 255 & 256 & PROCNODE_STEPS, IWPOS, IWPOSCB, IPTRLU, 257 & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, 258 & PTLUST_S, PTRFAC, 259 & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, 260 & ITLOC, RHS_MUMPS, COMP, 261 & IFLAG, IERROR, 262 & IPOOL, LPOOL, LEAF, MYID, SLAVEF, 263 & KEEP, KEEP8, DKEEP, 264 & COMM, COMM_LOAD, FILS, ND) 265 IF (IFLAG.LT.0) GOTO 600 266 ELSE 267 IERR = -1 268 DO WHILE (IERR.EQ.-1) 269 CALL SMUMPS_BUF_SEND_RTNELIND( INODE, NELIM, 270 & IW(LIST_ROW_SON), IW(LIST_COL_SON), NSLAVES, 271 & IW(LIST_SLAVES), MSGDEST, COMM, KEEP, IERR) 272 IF ( IERR .EQ. -1 ) THEN 273 BLOCKING =.FALSE. 274 SET_IRECV =.TRUE. 275 MESSAGE_RECEIVED = .FALSE. 276 CALL SMUMPS_TRY_RECVTREAT( COMM_LOAD, ASS_IRECV, 277 & BLOCKING, SET_IRECV, MESSAGE_RECEIVED, 278 & MPI_ANY_SOURCE, MPI_ANY_TAG, 279 & STATUS, 280 & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, 281 & IWPOS, IWPOSCB, IPTRLU, 282 & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, 283 & PTLUST_S, PTRFAC, 284 & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, 285 & IFLAG, IERROR, COMM, 286 & NBPROCFILS, 287 & IPOOL, LPOOL, LEAF, 288 & NBFIN, MYID, SLAVEF, 289 & 290 & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, 291 & FILS, PTRARW, PTRAIW, 292 & INTARR, DBLARR, ICNTL, KEEP,KEEP8,DKEEP, 293 & ND, FRERE, LPTRAR, NELT, 294 & FRTPTR, FRTELT, 295 & ISTEP_TO_INIV2, TAB_POS_IN_PERE, 296 & .TRUE. 297 & , LRGROUPS 298 & ) 299 IF ( IFLAG .LT. 0 ) GOTO 500 300 IOLDPS = PTLUST_S(STEP(INODE)) 301 LIST_ROW_SON = IOLDPS + H_INODE + NPIV 302 LIST_COL_SON = IOLDPS + H_INODE + NFRONT + NPIV 303 LIST_SLAVES = IOLDPS + 6 + KEEP(IXSZ) 304 ENDIF 305 ENDDO 306 IF ( IERR .EQ. -2 ) THEN 307 IERROR = ( 3 + NSLAVES + 2 * NELIM ) * KEEP( 34 ) 308 IFLAG = - 17 309 GOTO 600 310 ELSE IF ( IERR .EQ. -3 ) THEN 311 IERROR = ( 3 + NSLAVES + 2 * NELIM ) * KEEP( 34 ) 312 IFLAG = -20 313 GOTO 600 314 ENDIF 315 ENDIF 316 IF (NELIM.EQ.0) THEN 317 POSELT = PTRAST(STEP(INODE)) 318 OPSFAC = POSELT + int(NPIV,8) * int(NFRONT,8) + int(NPIV,8) 319 GOTO 190 320 ELSE 321 GOTO 500 322 ENDIF 323 ENDIF 324 OPSFAC = POSELT + int(NPIV,8) * int(LDA,8) + int(NPIV,8) 325 IF ( MUMPS_PROCNODE(PROCNODE_STEPS(STEP(FPERE)), 326 & SLAVEF) .NE. MYID ) THEN 327 MSGTAG =NOEUD 328 MSGDEST=MUMPS_PROCNODE( PROCNODE_STEPS(STEP(FPERE)), SLAVEF ) 329 IERR = -1 330 NBROWS_ALREADY_SENT = 0 331 DO WHILE (IERR.EQ.-1) 332 IF ( (TYPE.EQ.1) .AND. (TYPEF.EQ.1) ) THEN 333 CALL SMUMPS_BUF_SEND_CB( NBROWS_ALREADY_SENT, 334 & INODE, FPERE, NFRONT, 335 & LCONT, NASS, NPIV, IW( IOLDPS + H_INODE + NPIV ), 336 & IW( IOLDPS + H_INODE + NPIV + NFRONT ), 337 & A( OPSFAC ), COMPRESSCB, 338 & MSGDEST, MSGTAG, COMM, KEEP, IERR ) 339 ELSE 340 IF ( TYPE.EQ.2 ) THEN 341 INIV2 = ISTEP_TO_INIV2 ( STEP(INODE) ) 342 ELSE 343 INIV2 = -9999 344 ENDIF 345 CALL SMUMPS_BUF_SEND_MAITRE2( NBROWS_ALREADY_SENT, 346 & FPERE, INODE, 347 & NBROW_SEND, IW(IOLDPS + H_INODE + NPIV ), 348 & NBCOL, IW(IOLDPS + H_INODE + NPIV + NFRONT ), 349 & A(OPSFAC), LDA, NELIM, TYPE, 350 & NSLAVES, IW(IOLDPS+6+KEEP(IXSZ)), MSGDEST, 351 & COMM, IERR, 352 & 353 & SLAVEF, KEEP,KEEP8, INIV2, TAB_POS_IN_PERE ) 354 END IF 355 IF ( IERR .EQ. -1 ) THEN 356 BLOCKING = .FALSE. 357 SET_IRECV = .TRUE. 358 MESSAGE_RECEIVED = .FALSE. 359 CALL SMUMPS_TRY_RECVTREAT( COMM_LOAD, ASS_IRECV, 360 & BLOCKING, SET_IRECV, MESSAGE_RECEIVED, 361 & MPI_ANY_SOURCE, MPI_ANY_TAG, 362 & STATUS, 363 & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, 364 & IWPOS, IWPOSCB, IPTRLU, 365 & LRLU, LRLUS, N, IW, LIW, A, LA, 366 & PTRIST, PTLUST_S, PTRFAC, 367 & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, 368 & IFLAG, IERROR, COMM, 369 & NBPROCFILS, IPOOL, LPOOL, LEAF, 370 & NBFIN, MYID, SLAVEF, 371 & 372 & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, 373 & FILS, PTRARW, PTRAIW, 374 & INTARR, DBLARR, ICNTL, KEEP,KEEP8,DKEEP, ND, FRERE, 375 & LPTRAR, NELT, FRTPTR, FRTELT, 376 & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. 377 & , LRGROUPS ) 378 IF ( IFLAG .LT. 0 ) GOTO 500 379 ENDIF 380 IOLDPS = PTLUST_S(STEP( INODE )) 381 OPSFAC = POSELT + int(NPIV,8) * int(LDA,8) + int(NPIV,8) 382 END DO 383 IF ( IERR .EQ. -2 .OR. IERR .EQ. -3 ) THEN 384 IF ( (TYPE.EQ.1) .AND. (TYPEF.EQ.1) ) THEN 385 IERROR = ( 2*LCONT + 9 ) * KEEP( 34 ) + 386 & LCONT*LCONT * KEEP( 35 ) 387 ELSE IF (KEEP(50).ne.0 .AND. TYPE .eq. 2 ) THEN 388 IERROR = ( NBROW_SEND + NBCOL+ 5 + NSLAVES) 389 & * KEEP( 34 ) + 390 & NBROW_SEND*NBROW_SEND*KEEP( 35 ) 391 ELSE 392 IERROR = ( NBROW_SEND + NBCOL+ 5 + NSLAVES) * KEEP( 34 ) + 393 & NBROW_SEND*NBCOL*KEEP( 35 ) 394 ENDIF 395 IF (IERR .EQ. -2) THEN 396 IFLAG = -17 397 IF ( LP > 0 ) THEN 398 WRITE(LP, *) MYID, 399 & ": FAILURE, SEND BUFFER TOO SMALL DURING 400 & SMUMPS_FAC_STACK", TYPE, TYPEF 401 ENDIF 402 ENDIF 403 IF (IERR .EQ. -3) THEN 404 IFLAG = -20 405 IF ( LP > 0 ) THEN 406 WRITE(LP, *) MYID, 407 & ": FAILURE, RECV BUFFER TOO SMALL DURING 408 & SMUMPS_FAC_STACK", TYPE, TYPEF 409 ENDIF 410 ENDIF 411 GOTO 600 412 ENDIF 413 ENDIF 414 IF ( MUMPS_PROCNODE(PROCNODE_STEPS(STEP(FPERE)), 415 & SLAVEF) .EQ. MYID ) THEN 416 LREQI = 2 + KEEP(IXSZ) 417 NBROW_STACK = NBROW 418 NBROW_SEND = 0 419 IF ((KEEP(50).NE.0).AND.(TYPE.EQ.2)) THEN 420 NBCOL_STACK = NBROW 421 ELSE 422 NBCOL_STACK = NBCOL 423 ENDIF 424 ELSE 425 NBROW_STACK = NBROW-NBROW_SEND 426 NBCOL_STACK = NBCOL 427 LREQI = 6 + NBROW_STACK + NBCOL + KEEP(IXSZ) 428 IF (.NOT. (TYPE.EQ.1 .AND. TYPEF.EQ.2 ) ) GOTO 190 429 IF (FPERE.EQ.0) GOTO 190 430 ENDIF 431 IF (COMPRESSCB) THEN 432 LREQCB = ( int(NBCOL_STACK,8) * int( NBCOL_STACK + 1, 8) ) / 2_8 433 & - ( int(NBROW_SEND ,8) * int( NBROW_SEND + 1, 8) ) / 2_8 434 ELSE 435 LREQCB = int(NBROW_STACK,8) * int(NBCOL_STACK,8) 436 ENDIF 437 INPLACE = ( KEEP(234).NE.0 ) 438 IF (KEEP(50).NE.0 .AND. TYPE .EQ. 2) INPLACE = .FALSE. 439 INPLACE = INPLACE .OR. .NOT. MUST_COMPACT_FACTORS 440 INPLACE = INPLACE .AND. 441 & ( PTLUST_S(STEP(INODE)) + INTSIZ .EQ. IWPOS ) 442 MIN_SPACE_IN_PLACE = 0_8 443 IF ( INPLACE .AND. KEEP(50).eq. 0 .AND. 444 & MUST_COMPACT_FACTORS) THEN 445 MIN_SPACE_IN_PLACE = int(NBCOL_STACK,8) 446 ENDIF 447 IF ( MIN_SPACE_IN_PLACE .GT. LREQCB ) THEN 448 INPLACE = .FALSE. 449 ENDIF 450 CALL SMUMPS_ALLOC_CB( INPLACE, MIN_SPACE_IN_PLACE, 451 & SSARBR, .FALSE., 452 & MYID,N,KEEP,KEEP8,DKEEP,IW, LIW, A, LA, 453 & LRLU, IPTRLU,IWPOS,IWPOSCB, 454 & PTRIST,PTRAST,STEP, PIMASTER,PAMASTER, 455 & LREQI, LREQCB, INODE, S_NOTFREE, .TRUE., 456 & COMP, LRLUS, IFLAG, IERROR ) 457 IF (IFLAG.LT.0) GOTO 600 458 PTRIST(STEP(INODE)) = IWPOSCB+1 459 IF ( MUMPS_PROCNODE(PROCNODE_STEPS(STEP(FPERE)), 460 & SLAVEF) .EQ. MYID ) THEN 461 PIMASTER (STEP(INODE)) = PTLUST_S(STEP(INODE)) 462 PAMASTER(STEP(INODE)) = IPTRLU + 1_8 463 PTRAST(STEP(INODE)) = -99999999_8 464 IW(IWPOSCB+1+KEEP(IXSZ)) = min(-NBCOL_STACK,-1) 465 IW(IWPOSCB+2+KEEP(IXSZ)) = NBROW_STACK 466 IF (COMPRESSCB) IW(IWPOSCB+1+XXS) = S_CB1COMP 467 ELSE 468 PTRAST(STEP(INODE)) = IPTRLU+1_8 469 IF (COMPRESSCB) IW(IWPOSCB+1+XXS)=S_CB1COMP 470 IW(IWPOSCB+1+KEEP(IXSZ)) = NBCOL 471 IW(IWPOSCB+2+KEEP(IXSZ)) = 0 472 IW(IWPOSCB+3+KEEP(IXSZ)) = NBROW_STACK 473 IW(IWPOSCB+4+KEEP(IXSZ)) = 0 474 IW(IWPOSCB+5+KEEP(IXSZ)) = 1 475 IW(IWPOSCB+6+KEEP(IXSZ)) = 0 476 IOLDP1 = PTLUST_S(STEP(INODE))+H_INODE 477 PTROWEND = IWPOSCB+6+NBROW_STACK+KEEP(IXSZ) 478 DO I = 1, NBROW_STACK 479 IW(IWPOSCB+7+KEEP(IXSZ)+I-1) = 480 & IW(IOLDP1+NFRONT-NBROW_STACK+I-1) 481 ENDDO 482 DO I = 1, NBCOL 483 IW(PTROWEND+I)=IW(IOLDP1+NFRONT+NPIV+I-1) 484 ENDDO 485 END IF 486 IF ( KEEP(50).NE.0 .AND. TYPE .EQ. 1 487 & .AND. MUST_COMPACT_FACTORS ) THEN 488 POSELT = PTRFAC(STEP(INODE)) 489 CALL SMUMPS_COMPACT_FACTORS(A(POSELT), LDA, 490 & NPIV, NBROW, KEEP(50), 491 & int(LDA,8)*int(NBROW+NPIV,8)) 492 MUST_COMPACT_FACTORS = .FALSE. 493 ENDIF 494 IF ( KEEP(50).EQ.0 .AND. MUST_COMPACT_FACTORS ) 495 & THEN 496 LAST_ALLOWED_POS = POSELT + int(LDA,8)*int(NPIV+NBROW-1,8) 497 & + int(NPIV,8) 498 ELSE 499 LAST_ALLOWED_POS = -1_8 500 ENDIF 501 NCBROW_ALREADY_MOVED = 0 502 10 CONTINUE 503 NCBROW_PREVIOUSLY_MOVED = NCBROW_ALREADY_MOVED 504 IF (IPTRLU .LT. POSFAC ) THEN 505 CALL SMUMPS_COPY_CB_RIGHT_TO_LEFT( A, LA, LDA, 506 & POSELT, IPTRLU, NPIV, NBCOL_STACK, NBROW_STACK, 507 & NBROW_SEND, LREQCB, KEEP, COMPRESSCB, 508 & LAST_ALLOWED_POS, NCBROW_ALREADY_MOVED ) 509 ELSE 510 CALL SMUMPS_COPY_CB_LEFT_TO_RIGHT( A, LA, LDA, 511 & POSELT, IPTRLU, NPIV, NBCOL_STACK, NBROW_STACK, 512 & NBROW_SEND, LREQCB, KEEP, COMPRESSCB ) 513 NCBROW_ALREADY_MOVED = NBROW_STACK 514 ENDIF 515 IF (LAST_ALLOWED_POS .NE. -1_8) THEN 516 MUST_COMPACT_FACTORS =.FALSE. 517 IF ( NCBROW_ALREADY_MOVED .EQ. NBROW_STACK ) THEN 518 NCBROW_ALREADY_MOVED = NCBROW_ALREADY_MOVED + NBROW_SEND 519 ENDIF 520 NCBROW_NEWLY_MOVED = NCBROW_ALREADY_MOVED 521 & - NCBROW_PREVIOUSLY_MOVED 522 FACTOR_POS = POSELT + 523 & int(LDA,8)*int(NPIV+NBROW-NCBROW_ALREADY_MOVED,8) 524 CALL SMUMPS_COMPACT_FACTORS_UNSYM( A(FACTOR_POS), LDA, NPIV, 525 & NCBROW_NEWLY_MOVED, 526 & int(NCBROW_NEWLY_MOVED,8) * int(LDA,8) ) 527 INEW = FACTOR_POS + int(NPIV,8) * int(NCBROW_NEWLY_MOVED,8) 528 IOLD = INEW + int(NCBROW_NEWLY_MOVED,8) * int(NBCOL_STACK,8) 529 DO I = 1, NCBROW_PREVIOUSLY_MOVED*NPIV 530 A(INEW) = A(IOLD) 531 IOLD = IOLD + 1_8 532 INEW = INEW + 1_8 533 ENDDO 534 KEEP8(8)=KEEP8(8) + int(NCBROW_PREVIOUSLY_MOVED,8) 535 & * int(NPIV,8) 536 LAST_ALLOWED_POS = INEW 537 IF (NCBROW_ALREADY_MOVED.LT.NBROW_STACK) THEN 538 GOTO 10 539 ENDIF 540 ENDIF 541 190 CONTINUE 542 IF (MUST_COMPACT_FACTORS) THEN 543 POSELT = PTRFAC(STEP(INODE)) 544 CALL SMUMPS_COMPACT_FACTORS(A(POSELT), LDA, 545 & NPIV, NBROW, KEEP(50), 546 & int(LDA,8)*int(NBROW+NPIV,8)) 547 MUST_COMPACT_FACTORS = .FALSE. 548 ENDIF 549 IOLDPS = PTLUST_S(STEP(INODE)) 550 IW(IOLDPS+KEEP(IXSZ)) = NBCOL 551 IW(IOLDPS + 1+KEEP(IXSZ)) = NASS - NPIV 552 IF (TYPE.EQ.2) THEN 553 IW(IOLDPS + 2+KEEP(IXSZ)) = NASS 554 ELSE 555 IW(IOLDPS + 2+KEEP(IXSZ)) = NFRONT 556 ENDIF 557 IW(IOLDPS + 3+KEEP(IXSZ)) = NPIV 558 IF (INPLACE) THEN 559 SIZE_INPLACE = LREQCB - MIN_SPACE_IN_PLACE 560 ELSE 561 SIZE_INPLACE = 0_8 562 ENDIF 563 CALL SMUMPS_COMPRESS_LU(SIZE_INPLACE,MYID,N,IOLDPS,TYPE, IW, LIW, 564 & A, LA, POSFAC, LRLU, LRLUS, 565 & IWPOS, PTRAST, PTRFAC, STEP, KEEP,KEEP8, SSARBR,INODE,IERR 566 & , LRGROUPS, NASS 567 & ) 568 IF(IERR.LT.0)THEN 569 IFLAG=IERR 570 IERROR=0 571 GOTO 600 572 ENDIF 573 500 CONTINUE 574 RETURN 575 600 CONTINUE 576 IF (IFLAG .NE. -1) THEN 577 CALL SMUMPS_BDC_ERROR( MYID, SLAVEF, COMM, KEEP ) 578 ENDIF 579 RETURN 580 END SUBROUTINE SMUMPS_FAC_STACK 581