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 RECURSIVE SUBROUTINE DMUMPS_PROCESS_SYM_BLOCFACTO( 14 & COMM_LOAD, ASS_IRECV, 15 & BUFR, LBUFR, 16 & LBUFR_BYTES, PROCNODE_STEPS, MSGSOU, 17 & SLAVEF, IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, N, IW, LIW, 18 & A, LA, PTRIST, PTRAST, NSTK_S, NBPROCFILS, 19 & COMP, STEP, PIMASTER, PAMASTER, POSFAC, 20 & MYID, COMM, IFLAG, IERROR, NBFIN, 21 & 22 & PTLUST_S, PTRFAC, root, OPASSW, OPELIW, 23 & ITLOC, RHS_MUMPS, FILS, 24 & PTRARW, PTRAIW, INTARR, DBLARR, 25 & ICNTL,KEEP,KEEP8,DKEEP,IPOOL, LPOOL, LEAF, ND, FRERE_STEPS, 26 & LPTRAR, NELT, FRTPTR, FRTELT, 27 & ISTEP_TO_INIV2, TAB_POS_IN_PERE 28 & , LRGROUPS 29 & ) 30 USE DMUMPS_BUF 31 USE DMUMPS_LOAD 32 USE DMUMPS_OOC 33 USE DMUMPS_LR_CORE 34 USE DMUMPS_LR_TYPE 35 USE DMUMPS_LR_STATS 36 USE DMUMPS_FAC_LR 37 USE DMUMPS_ANA_LR 38 USE DMUMPS_LR_DATA_M 39!$ USE OMP_LIB 40 IMPLICIT NONE 41 INCLUDE 'dmumps_root.h' 42 INCLUDE 'mumps_headers.h' 43 TYPE (DMUMPS_ROOT_STRUC) :: root 44 INTEGER ICNTL( 40 ), KEEP( 500 ) 45 INTEGER(8) KEEP8(150) 46 DOUBLE PRECISION DKEEP(230) 47 INTEGER COMM_LOAD, ASS_IRECV 48 INTEGER LBUFR, LBUFR_BYTES 49 INTEGER BUFR( LBUFR ) 50 INTEGER N, SLAVEF, IWPOS, IWPOSCB, LIW 51 INTEGER(8) IPTRLU, LRLU, LRLUS, LA, POSFAC 52 INTEGER COMP 53 INTEGER IFLAG, IERROR, NBFIN, MSGSOU 54 INTEGER PROCNODE_STEPS(KEEP(28)), PTRIST(KEEP(28)), 55 & NSTK_S(KEEP(28)) 56 INTEGER(8) PTRAST(KEEP(28)), PTRFAC(KEEP(28)), PAMASTER(KEEP(28)) 57 INTEGER NBPROCFILS( KEEP(28) ), STEP(N), 58 & PIMASTER(KEEP(28)) 59 INTEGER IW( LIW ) 60 DOUBLE PRECISION A( LA ) 61 INTEGER, intent(in) :: LRGROUPS(N) 62 INTEGER LPTRAR, NELT 63 INTEGER FRTPTR( N+1 ), FRTELT( NELT ) 64 INTEGER COMM, MYID 65 INTEGER PTLUST_S(KEEP(28)), 66 & ITLOC(N+KEEP(253)), FILS(N), ND(KEEP(28)) 67 DOUBLE PRECISION :: RHS_MUMPS(KEEP(255)) 68 INTEGER(8), INTENT(IN) :: PTRAIW( LPTRAR ), PTRARW( LPTRAR ) 69 INTEGER FRERE_STEPS(KEEP(28)) 70 DOUBLE PRECISION OPASSW, OPELIW 71 DOUBLE PRECISION FLOP1 72 INTEGER INTARR( KEEP8(27) ) 73 DOUBLE PRECISION DBLARR( KEEP8(26) ) 74 INTEGER LEAF, LPOOL 75 INTEGER IPOOL( LPOOL ) 76 INTEGER ISTEP_TO_INIV2(KEEP(71)), 77 & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) 78 INTEGER PIVI 79 INTEGER (8) POSPV1,POSPV2,OFFDAG,LPOS1 80 INTEGER J2 81 DOUBLE PRECISION MULT1,MULT2, A11, DETPIV, A22, A12 82 INCLUDE 'mpif.h' 83 INCLUDE 'mumps_tags.h' 84 INTEGER :: STATUS(MPI_STATUS_SIZE) 85 INTEGER LP 86 INTEGER INODE, POSITION, NPIV, IERR 87 INTEGER NCOL, LD_BLOCFACTO 88 INTEGER(8) LAELL, POSBLOCFACTO 89 INTEGER(8) POSELT 90 INTEGER IOLDPS, LCONT1, NASS1, NROW1, NCOL1, NPIV1 91 INTEGER NSLAV1, HS, ISW, DEST 92 INTEGER ICT11 93 INTEGER(8) LPOS, LPOS2, DPOS, UPOS 94 INTEGER (8) IPOS, KPOS 95 INTEGER I, IPIV, FPERE, NSLAVES_TOT, 96 & NSLAVES_FOLLOW, NB_BLOC_FAC 97 INTEGER IPOSK, JPOSK, NPIVSENT, Block, IROW, BLSIZE 98 INTEGER allocok, TO_UPDATE_CPT_END 99 DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE :: UIP21K 100 INTEGER, DIMENSION(:), ALLOCATABLE :: LIST_SLAVES_FOLLOW 101 LOGICAL LASTBL 102 INTEGER SRC_DESCBAND 103 LOGICAL BLOCKING, SET_IRECV, MESSAGE_RECEIVED 104 DOUBLE PRECISION ONE,ALPHA 105 PARAMETER (ONE = 1.0D0, ALPHA=-1.0D0) 106 INTEGER(8) :: LAFAC 107 INTEGER LIWFAC, STRAT, NextPivDummy 108 LOGICAL LAST_CALL 109 TYPE(IO_BLOCK) :: MonBloc 110 INTEGER LRELAY_INFO 111 LOGICAL COUNTER_WAS_HUGE 112 INTEGER TO_UPDATE_CPT_RECUR 113 LOGICAL :: SEND_LR 114 INTEGER :: XSIZE, CURRENT_BLR, NSLAVES_PREC, INFO_TMP(2) 115 INTEGER :: SEND_LR_INT, NELIM, NB_BLR_LM, NB_BLR_LS, 116 & MAXI_CLUSTER_LM, MAXI_CLUSTER_LS, MAXI_CLUSTER, 117 & NPARTSASS, NPARTSCB, NPARTSCB_COL, NPARTSASS_COL, 118 & NB_BLR_COL, MAXI_CLUSTER_COL 119 INTEGER :: NPARTSASS_MASTER, IPANEL, NB_ACCESSES_INIT 120 TYPE (LRB_TYPE), DIMENSION(:), ALLOCATABLE :: BLR_LM 121 TYPE (LRB_TYPE), DIMENSION(:), POINTER :: BLR_LS 122 INTEGER, POINTER, DIMENSION(:) :: BEGS_BLR_LM, BEGS_BLR_LS, 123 & BEGS_BLR_COL 124 LOGICAL KEEP_BEGS_BLR_LS, KEEP_BEGS_BLR_COL, KEEP_BLR_LS 125 DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:) :: WORK, TAU 126 INTEGER, ALLOCATABLE, DIMENSION(:) :: JPVT 127 DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:) :: BLOCKLR 128 INTEGER T1, T2, COUNT_RATE, LWORK 129 DOUBLE PRECISION,ALLOCATABLE,DIMENSION(:) :: RWORK 130 INTEGER :: OMP_NUM, MY_NUM 131 INTEGER MUMPS_PROCNODE 132 EXTERNAL MUMPS_PROCNODE 133 LP = ICNTL(1) 134 IF (ICNTL(4) .LE. 0) LP = -1 135 POSITION = 0 136 TO_UPDATE_CPT_END = -654321 137 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, INODE, 1, 138 & MPI_INTEGER, COMM, IERR ) 139 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, NPIV, 1, 140 & MPI_INTEGER, COMM, IERR ) 141 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, FPERE, 1, 142 & MPI_INTEGER, COMM, IERR ) 143 LASTBL = (NPIV.LE.0) 144 IF (LASTBL) THEN 145 NPIV = -NPIV 146 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, NSLAVES_TOT, 1, 147 & MPI_INTEGER, COMM, IERR ) 148 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, NB_BLOC_FAC, 1, 149 & MPI_INTEGER, COMM, IERR ) 150 ENDIF 151 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, NCOL, 1, 152 & MPI_INTEGER, COMM, IERR ) 153 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, NELIM, 1, 154 & MPI_INTEGER, COMM, IERR ) 155 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, 156 & NPARTSASS_MASTER, 1, 157 & MPI_INTEGER, COMM, IERR ) 158 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, IPANEL, 159 & 1, MPI_INTEGER, COMM, IERR ) 160 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, SEND_LR_INT, 1, 161 & MPI_INTEGER, COMM, IERR ) 162 IF ( SEND_LR_INT .EQ. 1) THEN 163 SEND_LR = .TRUE. 164 ELSE 165 SEND_LR = .FALSE. 166 ENDIF 167 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, NSLAVES_TOT, 1, 168 & MPI_INTEGER, COMM, IERR ) 169 XSIZE = KEEP(IXSZ) 170 KEEP_BEGS_BLR_LS =.FALSE. 171 KEEP_BEGS_BLR_COL =.FALSE. 172 KEEP_BLR_LS =.FALSE. 173 IF ( SEND_LR ) THEN 174 LAELL = int(NPIV,8) * int(NPIV+NELIM,8) 175 ELSE 176 LAELL = int(NPIV,8) * int(NCOL,8) 177 ENDIF 178 IF ( NPIV.GT.0 ) THEN 179 IF ( LRLU .LT. LAELL .OR. IWPOS + NPIV - 1 .GT. IWPOSCB ) THEN 180 IF ( LRLUS .LT. LAELL ) THEN 181 IFLAG = -9 182 CALL MUMPS_SET_IERROR(LAELL-LRLUS, IERROR) 183 IF (LP > 0 ) WRITE(LP,*) MYID, 184 &": FAILURE IN DMUMPS_PROCESS_SYM_BLOCFACTO, 185 & REAL WORKSPACE TOO SMALL" 186 GOTO 700 187 END IF 188 CALL DMUMPS_COMPRE_NEW(N, KEEP(28), IW, LIW, A, LA, 189 & LRLU, IPTRLU, 190 & IWPOS, IWPOSCB, PTRIST, PTRAST, 191 & STEP, PIMASTER, PAMASTER, KEEP(216),LRLUS, 192 & KEEP(IXSZ),COMP,DKEEP(97),MYID) 193 IF ( LRLU .NE. LRLUS ) THEN 194 WRITE(*,*) 'PB compress DMUMPS_PROCESS_SYM_BLOCFACTO,", 195 & " LRLU,LRLUS=' 196 & ,LRLU,LRLUS 197 IFLAG = -9 198 CALL MUMPS_SET_IERROR(LAELL-LRLUS,IERROR) 199 GOTO 700 200 END IF 201 IF ( IWPOS + NPIV - 1 .GT. IWPOSCB ) THEN 202 IF (LP > 0 ) WRITE(LP,*) MYID, 203 &": FAILURE IN DMUMPS_PROCESS_SYM_BLOCFACTO, 204 & INTEGER WORKSPACE TOO SMALL" 205 IFLAG = -8 206 IERROR = IWPOS + NPIV - 1 - IWPOSCB 207 GOTO 700 208 END IF 209 END IF 210 LRLU = LRLU - LAELL 211 LRLUS = LRLUS - LAELL 212 KEEP8(70) = KEEP8(70) - LAELL 213 KEEP8(71) = KEEP8(71) - LAELL 214 ENDIF 215 KEEP8(67) = min(LRLUS, KEEP8(67)) 216 KEEP8(68) = min(KEEP8(70), KEEP8(68)) 217 KEEP8(69) = min(KEEP8(71), KEEP8(69)) 218 POSBLOCFACTO = POSFAC 219 POSFAC = POSFAC + LAELL 220 CALL DMUMPS_LOAD_MEM_UPDATE(.FALSE.,.FALSE., 221 & LA-LRLUS,0_8,LAELL,KEEP,KEEP8,LRLUS) 222 IF ( NPIV.EQ.0 ) THEN 223 IPIV = 1 224 LD_BLOCFACTO = NPIV+NELIM 225 ELSE 226 IPIV = IWPOS 227 IWPOS = IWPOS + NPIV 228 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, 229 & IW( IPIV ), NPIV, 230 & MPI_INTEGER, COMM, IERR ) 231 IF ( SEND_LR ) THEN 232 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, 233 & A(POSBLOCFACTO), NPIV*(NPIV+NELIM), 234 & MPI_DOUBLE_PRECISION, 235 & COMM, IERR ) 236 LD_BLOCFACTO = NPIV+NELIM 237 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, 238 & NB_BLR_LM, 1, MPI_INTEGER, 239 & COMM, IERR ) 240 ALLOCATE(BLR_LM(max(NB_BLR_LM,1))) 241 ALLOCATE(BEGS_BLR_LM(NB_BLR_LM+2)) 242 CALL DMUMPS_MPI_UNPACK_LR( 243 & BUFR, LBUFR, LBUFR_BYTES, POSITION, NPIV, NELIM, 244 & 'V', BLR_LM, NB_BLR_LM, KEEP(470), 245 & BEGS_BLR_LM(1), KEEP8, COMM, IERR, IFLAG, IERROR) 246 IF (IFLAG.LT.0) GOTO 700 247 ELSE 248 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, 249 & A(POSBLOCFACTO), NPIV*NCOL, MPI_DOUBLE_PRECISION, 250 & COMM, IERR ) 251 LD_BLOCFACTO = NCOL 252 ENDIF 253 ENDIF 254 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, 255 & LRELAY_INFO, 1, 256 & MPI_INTEGER, COMM, IERR ) 257 IF (PTRIST(STEP( INODE )) .EQ. 0) THEN 258 SRC_DESCBAND = 259 & MUMPS_PROCNODE( PROCNODE_STEPS(STEP(INODE)), SLAVEF ) 260 CALL DMUMPS_TREAT_DESCBAND( INODE, COMM_LOAD, ASS_IRECV, 261 & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, 262 & IWPOS, IWPOSCB, IPTRLU, 263 & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, 264 & PTLUST_S, PTRFAC, 265 & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, 266 & IFLAG, IERROR, COMM, 267 & NBPROCFILS, 268 & IPOOL, LPOOL, LEAF, 269 & NBFIN, MYID, SLAVEF, 270 & 271 & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, 272 & FILS, PTRARW, PTRAIW, 273 & INTARR, DBLARR,ICNTL,KEEP,KEEP8,DKEEP,ND, FRERE_STEPS, 274 & LPTRAR, NELT, FRTPTR, FRTELT, 275 & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. 276 & , LRGROUPS 277 & ) 278 IF ( IFLAG .LT. 0 ) GOTO 600 279 ENDIF 280 IF ( IW( PTRIST(STEP(INODE)) + 3 + KEEP(IXSZ)) .EQ. 0 ) THEN 281#if ! defined(NO_XXNBPR) 282 CALL CHECK_EQUAL(NBPROCFILS(STEP(INODE)), 283 & IW(PTRIST(STEP(INODE))+XXNBPR)) 284 DO WHILE ( IW(PTRIST(STEP(INODE)) + XXNBPR) .NE. 0) 285#else 286 DO WHILE ( NBPROCFILS( STEP(INODE)) .NE. 0 ) 287#endif 288 BLOCKING = .TRUE. 289 SET_IRECV=.FALSE. 290 MESSAGE_RECEIVED = .FALSE. 291 CALL DMUMPS_TRY_RECVTREAT( COMM_LOAD, ASS_IRECV, 292 & BLOCKING, SET_IRECV, MESSAGE_RECEIVED, 293 & MPI_ANY_SOURCE, CONTRIB_TYPE2, 294 & STATUS, 295 & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, 296 & IWPOS, IWPOSCB, IPTRLU, 297 & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, 298 & PTLUST_S, PTRFAC, 299 & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, 300 & IFLAG, IERROR, COMM, 301 & NBPROCFILS, IPOOL, LPOOL, LEAF, NBFIN, MYID, SLAVEF, 302 & 303 & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, 304 & FILS, PTRARW, PTRAIW, 305 & INTARR, DBLARR,ICNTL,KEEP,KEEP8,DKEEP,ND, FRERE_STEPS, 306 & LPTRAR, NELT, FRTPTR, FRTELT, 307 & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. 308 & , LRGROUPS 309 & ) 310 IF ( IFLAG .LT. 0 ) GOTO 600 311 END DO 312 ENDIF 313 SET_IRECV = .TRUE. 314 BLOCKING = .FALSE. 315 MESSAGE_RECEIVED = .TRUE. 316 CALL DMUMPS_TRY_RECVTREAT( COMM_LOAD, ASS_IRECV, 317 & BLOCKING, SET_IRECV, MESSAGE_RECEIVED, 318 & MPI_ANY_SOURCE, MPI_ANY_TAG, 319 & STATUS, 320 & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, 321 & IWPOS, IWPOSCB, IPTRLU, 322 & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, 323 & PTLUST_S, PTRFAC, 324 & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, 325 & IFLAG, IERROR, COMM, 326 & NBPROCFILS, IPOOL, LPOOL, LEAF, NBFIN, MYID, SLAVEF, 327 & 328 & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, 329 & FILS, PTRARW, PTRAIW, 330 & INTARR, DBLARR,ICNTL,KEEP,KEEP8,DKEEP,ND, FRERE_STEPS, 331 & LPTRAR, NELT, FRTPTR, FRTELT, 332 & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. 333 & , LRGROUPS 334 & ) 335 IOLDPS = PTRIST(STEP(INODE)) 336 POSELT = PTRAST(STEP(INODE)) 337 LCONT1 = IW( IOLDPS + KEEP(IXSZ)) 338 NASS1 = IW( IOLDPS + 1 + KEEP(IXSZ)) 339 IF ( NASS1 < 0 ) THEN 340 NASS1 = -NASS1 341 IW( IOLDPS + 1 + KEEP(IXSZ)) = NASS1 342 IF (KEEP(55) .EQ. 0) THEN 343 CALL DMUMPS_ASM_SLAVE_ARROWHEADS(INODE, N, IW, LIW, 344 & IOLDPS, A, LA, POSELT, KEEP, KEEP8, ITLOC, FILS, PTRAIW, 345 & PTRARW, INTARR, DBLARR, KEEP8(27), KEEP8(26), RHS_MUMPS) 346 ELSE 347 CALL DMUMPS_ASM_SLAVE_ELEMENTS(INODE, N, NELT, IW, LIW, 348 & IOLDPS, A, LA, POSELT, KEEP, KEEP8, ITLOC, FILS, PTRAIW, 349 & PTRARW, INTARR, DBLARR, KEEP8(27), KEEP8(26), 350 & FRTPTR, FRTELT, RHS_MUMPS) 351 ENDIF 352 ENDIF 353 NROW1 = IW( IOLDPS + 2 + KEEP(IXSZ)) 354 NPIV1 = IW( IOLDPS + 3 + KEEP(IXSZ)) 355 NSLAV1 = IW( IOLDPS + 5 + KEEP(IXSZ)) 356 NSLAVES_FOLLOW = NSLAV1 - XTRA_SLAVES_SYM 357 HS = 6 + NSLAV1 + KEEP(IXSZ) 358 NCOL1 = LCONT1 + NPIV1 359 IF ( LASTBL ) THEN 360 TO_UPDATE_CPT_END = ( NSLAVES_TOT - NSLAVES_FOLLOW - 1 ) * 361 & NB_BLOC_FAC 362 END IF 363 IF (NPIV.GT.0) THEN 364 IF ( NPIV1 + NCOL .NE. NASS1 ) THEN 365 WRITE(*,*) 'SymBLFC Error: NPIV1 + NCOL .NE. NASS1 :', 366 & NPIV1,NCOL,NASS1 367 CALL MUMPS_ABORT() 368 END IF 369 ICT11 = IOLDPS+HS+NROW1+NPIV1 - 1 370 DO I = 1, NPIV 371 PIVI = abs(IW(IPIV+I-1)) 372 IF (PIVI.EQ.I) CYCLE 373 ISW = IW(ICT11+I) 374 IW(ICT11+I) = IW(ICT11+PIVI) 375 IW(ICT11+PIVI) = ISW 376 IPOS = POSELT + int(NPIV1 + I - 1,8) 377 KPOS = POSELT + int(NPIV1 + PIVI - 1,8) 378 CALL dswap(NROW1, A(IPOS), NCOL1, A(KPOS), NCOL1) 379 ENDDO 380 IF (.NOT.SEND_LR) THEN 381 ALLOCATE( UIP21K( NPIV * NROW1 ), stat = allocok ) 382 IF ( allocok .GT. 0 ) THEN 383 IF (LP > 0 ) WRITE(LP,*) MYID, 384 &": ALLOCATION FAILURE FOR UIP21K IN DMUMPS_PROCESS_SYM_BLOCFACTO" 385 IFLAG = -13 386 IERROR = NPIV * NROW1 387 GOTO 700 388 END IF 389 ELSE 390 ALLOCATE( UIP21K( 1 ), stat = allocok ) 391 IF ( allocok .GT. 0 ) THEN 392 IF (LP > 0 ) WRITE(LP,*) MYID, 393 &": ALLOCATION FAILURE FOR UIP21K IN DMUMPS_PROCESS_SYM_BLOCFACTO" 394 IFLAG = -13 395 IERROR = NPIV * 1 396 GOTO 700 397 END IF 398 ENDIF 399 IF ( NSLAVES_FOLLOW .NE. 0 .and. NPIV .NE. 0 ) THEN 400 ALLOCATE( LIST_SLAVES_FOLLOW ( NSLAVES_FOLLOW ), 401 & stat = allocok ) 402 IF ( allocok .GT. 0 ) THEN 403 IF (LP > 0 ) WRITE(LP,*) MYID, 404 &": ALLOCATION FAILURE FOR LIST_SLAVES_FOLLOW 405 & IN DMUMPS_PROCESS_SYM_BLOCFACTO" 406 IFLAG = -13 407 IERROR = NSLAVES_FOLLOW 408 GOTO 700 409 END IF 410 LIST_SLAVES_FOLLOW(1:NSLAVES_FOLLOW)= 411 & IW(IOLDPS+6+XTRA_SLAVES_SYM+KEEP(IXSZ): 412 & IOLDPS+5+XTRA_SLAVES_SYM+KEEP(IXSZ)+NSLAVES_FOLLOW) 413 END IF 414 IF (KEEP(486) .GT. 0) THEN 415 CALL SYSTEM_CLOCK(T1) 416 ENDIF 417 CALL dtrsm( 'L', 'U', 'T', 'U', NPIV, NROW1, ONE, 418 & A( POSBLOCFACTO ), LD_BLOCFACTO, 419 & A(POSELT+int(NPIV1,8)), NCOL1 ) 420 IF (KEEP(486) .GT. 0) THEN 421 CALL SYSTEM_CLOCK(T2,COUNT_RATE) 422 ACC_TRSM_TIME = ACC_TRSM_TIME + 423 & DBLE(T2-T1)/DBLE(COUNT_RATE) 424 ENDIF 425 IF (.NOT.SEND_LR) THEN 426 LPOS = POSELT + int(NPIV1,8) 427 UPOS = 1_8 428 DO I = 1, NROW1 429 UIP21K( UPOS: UPOS + int(NPIV-1,8) ) = 430 & A(LPOS: LPOS+int(NPIV-1,8)) 431 LPOS = LPOS + int(NCOL1,8) 432 UPOS = UPOS + int(NPIV,8) 433 END DO 434 ENDIF 435 LPOS = POSELT + int(NPIV1,8) 436 DPOS = POSBLOCFACTO 437 I = 1 438 DO 439 IF(I .GT. NPIV) EXIT 440 IF(IW(IPIV+I-1) .GT. 0) THEN 441 A11 = ONE/A(DPOS) 442 CALL dscal( NROW1, A11, A(LPOS), NCOL1 ) 443 LPOS = LPOS + 1_8 444 DPOS = DPOS + int(LD_BLOCFACTO + 1,8) 445 I = I+1 446 ELSE 447 POSPV1 = DPOS 448 POSPV2 = DPOS+ int(LD_BLOCFACTO + 1,8) 449 OFFDAG = POSPV1+1_8 450 A11 = A(POSPV1) 451 A22 = A(POSPV2) 452 A12 = A(OFFDAG) 453 DETPIV = A11*A22 - A12**2 454 A22 = A11/DETPIV 455 A11 = A(POSPV2)/DETPIV 456 A12 = -A12/DETPIV 457 LPOS1 = LPOS 458 DO J2 = 1,NROW1 459 MULT1 = A11*A(LPOS1)+A12*A(LPOS1+1_8) 460 MULT2 = A12*A(LPOS1)+A22*A(LPOS1+1_8) 461 A(LPOS1) = MULT1 462 A(LPOS1+1_8) = MULT2 463 LPOS1 = LPOS1 + int(NCOL1,8) 464 ENDDO 465 LPOS = LPOS + 2_8 466 DPOS = POSPV2 + int(LD_BLOCFACTO + 1,8) 467 I = I+2 468 ENDIF 469 ENDDO 470 ENDIF 471 IF (SEND_LR) THEN 472 NSLAVES_PREC = NSLAVES_TOT - NSLAVES_FOLLOW -1 473 ENDIF 474 IF (NPIV.GT.0) THEN 475 IF (NROW1.LE.0) CALL MUMPS_ABORT() 476 IF (SEND_LR) THEN 477 IF (NPIV1.NE.0) THEN 478 CALL DMUMPS_BLR_RETRIEVE_BEGS_BLR_L (IW(IOLDPS+XXF), 479 & BEGS_BLR_LS) 480 KEEP_BEGS_BLR_LS = .TRUE. 481 NB_BLR_LS = size(BEGS_BLR_LS) - 2 482 NPARTSCB = NB_BLR_LS 483 ELSE 484 CALL GET_CUT(IW(IOLDPS+HS:IOLDPS+HS+NROW1-1), 0, 485 & NROW1, LRGROUPS, NPARTSCB, 486 & NPARTSASS, BEGS_BLR_LS) 487 CALL REGROUPING2(BEGS_BLR_LS, NPARTSASS, 0, NPARTSCB, 488 & NROW1-0, KEEP(488), .TRUE., KEEP(472)) 489 NB_BLR_LS = NPARTSCB 490 ENDIF 491 call MAX_CLUSTER(BEGS_BLR_LM,NB_BLR_LM+1,MAXI_CLUSTER_LM) 492 call MAX_CLUSTER(BEGS_BLR_LS,NB_BLR_LS+1,MAXI_CLUSTER_LS) 493 MAXI_CLUSTER=max(MAXI_CLUSTER_LS,MAXI_CLUSTER_LM,NPIV) 494 IF (KEEP(489).EQ.1) THEN 495 IF (NPIV1.EQ.0) THEN 496 CALL GET_CUT(IW(IOLDPS+HS+NROW1:IOLDPS+HS+NROW1+NCOL1-1), 497 & NASS1, 498 & NCOL1-NASS1, LRGROUPS, NPARTSCB_COL, 499 & NPARTSASS_COL, BEGS_BLR_COL) 500 CALL REGROUPING2(BEGS_BLR_COL, NPARTSASS_COL, NASS1, 501 & NPARTSCB_COL, 502 & NCOL1-NASS1, KEEP(488), .FALSE., KEEP(472)) 503 NB_BLR_COL = NPARTSCB_COL + NPARTSASS_COL 504 ELSE 505 CALL DMUMPS_BLR_RETRIEVE_BEGS_BLR_C (IW(IOLDPS+XXF), 506 & BEGS_BLR_COL, NPARTSASS_MASTER) 507 KEEP_BEGS_BLR_COL = .TRUE. 508 NB_BLR_COL = size(BEGS_BLR_COL) - 1 509 NPARTSCB_COL = NB_BLR_COL - NPARTSASS_MASTER 510 ENDIF 511 CALL MAX_CLUSTER(BEGS_BLR_COL,NB_BLR_COL,MAXI_CLUSTER_COL) 512 MAXI_CLUSTER = max(MAXI_CLUSTER,MAXI_CLUSTER_COL) 513 ELSE 514 NULLIFY(BEGS_BLR_COL) 515 ENDIF 516 IF (NPIV1.EQ.0) THEN 517 INFO_TMP(1) = IFLAG 518 INFO_TMP(2) = IERROR 519 NB_ACCESSES_INIT=0 520 IF (NSLAVES_PREC.GT.0) THEN 521 NB_ACCESSES_INIT=NSLAVES_PREC+1 522 ENDIF 523 CALL DMUMPS_BLR_INIT_FRONT(IW(IOLDPS+XXF), 524 & .TRUE., .TRUE., .TRUE., NPARTSASS_MASTER, 525 & BEGS_BLR_LS, BEGS_BLR_COL, NB_ACCESSES_INIT, 526 & INFO_TMP) 527 IFLAG = INFO_TMP(1) 528 IERROR = INFO_TMP(2) 529 IF (IFLAG.LT.0) GOTO 700 530 ENDIF 531 LWORK = MAXI_CLUSTER*MAXI_CLUSTER 532 OMP_NUM = 1 533#if defined(BLR_MT) 534!$ OMP_NUM = OMP_GET_MAX_THREADS() 535#endif 536 ALLOCATE(BLOCKLR(MAXI_CLUSTER, OMP_NUM*MAXI_CLUSTER), 537 & RWORK(2*MAXI_CLUSTER*OMP_NUM), 538 & TAU(MAXI_CLUSTER*OMP_NUM), 539 & JPVT(MAXI_CLUSTER*OMP_NUM), 540 & WORK(LWORK*OMP_NUM), 541 & stat=allocok) 542 IF (allocok > 0 ) THEN 543 IFLAG = -13 544 IERROR = OMP_NUM*(LWORK + MAXI_CLUSTER*(MAXI_CLUSTER+4)) 545 write(6,*) 'ERROR 2 allocate temporary BLR blocks during', 546 & ' DMUMPS_PROCESS_SYM_BLOCFACTO', IERROR 547 GOTO 700 548 ENDIF 549 CURRENT_BLR = 1 550 ALLOCATE(BLR_LS(NB_BLR_LS)) 551 CALL SYSTEM_CLOCK(T1) 552 MY_NUM=0 553#if defined(BLR_MT) 554!$OMP PARALLEL PRIVATE(MY_NUM) 555!$ MY_NUM = OMP_GET_THREAD_NUM() 556#endif 557 CALL DMUMPS_COMPRESS_PANEL(A, LA, POSELT, IFLAG, IERROR, 558 & NCOL1, 559 & BEGS_BLR_LS, NB_BLR_LS+1, DKEEP(8), KEEP(473), BLR_LS, 560 & CURRENT_BLR, 'V', WORK, TAU, JPVT, LWORK, RWORK, 561 & BLOCKLR, MAXI_CLUSTER, NELIM, 562 & .TRUE., 563 & NPIV, NPIV1, 564 & 2, KEEP(483), KEEP(470), KEEP8 565 & ) 566 IF (IFLAG.LT.0) GOTO 300 567#if defined(BLR_MT) 568!$OMP BARRIER 569!$OMP MASTER 570#endif 571 CALL SYSTEM_CLOCK(T2,COUNT_RATE) 572 ACC_DEMOTING_TIME = ACC_DEMOTING_TIME + 573 & DBLE(T2-T1)/DBLE(COUNT_RATE) 574 CALL SYSTEM_CLOCK(T1) 575#if defined(BLR_MT) 576!$OMP END MASTER 577#endif 578 300 CONTINUE 579#if defined(BLR_MT) 580!$OMP END PARALLEL 581#endif 582 IF (IFLAG.LT.0) GOTO 700 583 ENDIF 584 ENDIF 585 IF ( (KEEP(201).eq.1) .AND. 586 & ( .NOT. SEND_LR .OR. (NPIV.EQ.0) .OR. 587 & (KEEP(485).EQ.0) ) 588 & ) THEN 589 MonBloc%INODE = INODE 590 MonBloc%MASTER = .FALSE. 591 MonBloc%Typenode = 2 592 MonBloc%NROW = NROW1 593 MonBloc%NCOL = NCOL1 594 MonBloc%NFS = NASS1 595 MonBloc%LastPiv = NPIV1 + NPIV 596 MonBloc%LastPanelWritten_L = -9999 597 MonBloc%LastPanelWritten_U = -9999 598 NULLIFY(MonBloc%INDICES) 599 MonBloc%Last = LASTBL 600 STRAT = STRAT_TRY_WRITE 601 NextPivDummy = -8888 602 LIWFAC = IW(IOLDPS+XXI) 603 CALL MUMPS_GETI8(LAFAC, IW(IOLDPS+XXR)) 604 LAST_CALL=.FALSE. 605 CALL DMUMPS_OOC_IO_LU_PANEL( STRAT, TYPEF_L, A(POSELT), 606 & LAFAC, MonBloc, NextPivDummy, NextPivDummy, 607 & IW(IOLDPS), LIWFAC, MYID, KEEP8(31), IFLAG,LAST_CALL) 608 ENDIF 609 IF (NPIV.GT.0) THEN 610 IF (SEND_LR) THEN 611 IF (NELIM.GT.0) THEN 612 LPOS2 = POSELT + int(NPIV1,8) 613 UPOS = POSBLOCFACTO+int(NPIV,8) 614 LPOS = LPOS2 + int(NPIV,8) 615 CALL dgemm('N','N', NELIM,NROW1,NPIV,ALPHA, 616 & A(UPOS),LD_BLOCFACTO, 617 & A(LPOS2),NCOL1,ONE, A(LPOS),NCOL1) 618 ENDIF 619#if defined(BLR_MT) 620!$OMP PARALLEL PRIVATE(MY_NUM) 621!$ MY_NUM = OMP_GET_THREAD_NUM() 622#endif 623 CALL DMUMPS_SLAVE_BLR_UPD_TRAIL_LDLT(A, LA, POSELT, 624 & IFLAG, IERROR, NCOL1, NROW1, 625 & POSBLOCFACTO, 626 & LD_BLOCFACTO, 627 & BEGS_BLR_LM, NB_BLR_LM+1, BLR_LM, NPIV1, 628 & BEGS_BLR_LS, NB_BLR_LS+1, BLR_LS, 0, 629 & CURRENT_BLR, CURRENT_BLR, 630 & IW(IPIV), 631 & BLOCKLR(1:MAXI_CLUSTER,MY_NUM*MAXI_CLUSTER+1), 632 & MAXI_CLUSTER, 633 & KEEP(481), DKEEP(8), KEEP(477) 634 & ) 635#if defined(BLR_MT) 636!$OMP END PARALLEL 637#endif 638 CALL SYSTEM_CLOCK(T2,COUNT_RATE) 639 ACC_UPDT_TIME = ACC_UPDT_TIME + 640 & DBLE(T2-T1)/DBLE(COUNT_RATE) 641 CALL STATS_STORE_BLR_PANEL_MRY(BLR_LS, 642 & 0, NPARTSCB, 'V', 2) 643 IF (KEEP(485).NE.0) THEN 644 CALL SYSTEM_CLOCK(T1) 645 CALL DMUMPS_DECOMPRESS_PANEL(A, LA, POSELT, NCOL1, 646 & .FALSE., 647 & NPIV1+1, 648 & 1, 649 & NB_BLR_LS+1, BLR_LS, 650 & CURRENT_BLR, 'V', NCOL1, KEEP(470)) 651 CALL SYSTEM_CLOCK(T2,COUNT_RATE) 652 ACC_PROMOTING_TIME = ACC_PROMOTING_TIME + 653 & DBLE(T2-T1)/DBLE(COUNT_RATE) 654 IF (KEEP(201).eq.1) THEN 655 MonBloc%INODE = INODE 656 MonBloc%MASTER = .FALSE. 657 MonBloc%Typenode = 2 658 MonBloc%NROW = NROW1 659 MonBloc%NCOL = NCOL1 660 MonBloc%NFS = NASS1 661 MonBloc%LastPiv = NPIV1 + NPIV 662 MonBloc%LastPanelWritten_L = -9999 663 MonBloc%LastPanelWritten_U = -9999 664 NULLIFY(MonBloc%INDICES) 665 MonBloc%Last = LASTBL 666 STRAT = STRAT_TRY_WRITE 667 NextPivDummy = -8888 668 LIWFAC = IW(IOLDPS+XXI) 669 CALL MUMPS_GETI8(LAFAC, IW(IOLDPS+XXR)) 670 LAST_CALL=.FALSE. 671 CALL DMUMPS_OOC_IO_LU_PANEL( STRAT, TYPEF_L, A(POSELT), 672 & LAFAC, MonBloc, NextPivDummy, NextPivDummy, 673 & IW(IOLDPS), LIWFAC, MYID, KEEP8(31), IFLAG,LAST_CALL) 674 ENDIF 675 ENDIF 676 CALL DEALLOC_BLR_PANEL (BLR_LM, NB_BLR_LM, KEEP8, .FALSE.) 677 DEALLOCATE(BLR_LM) 678 IF (NSLAVES_PREC.GT.0) THEN 679 CALL DMUMPS_BLR_SAVE_PANEL_LORU( 680 & IW(IOLDPS+XXF), 681 & 0, 682 & IPANEL,BLR_LS) 683 KEEP_BLR_LS = .TRUE. 684 ENDIF 685 ELSE 686 LPOS2 = POSELT + int(NPIV1,8) 687 UPOS = POSBLOCFACTO+int(NPIV,8) 688 LPOS = LPOS2 + int(NPIV,8) 689 CALL dgemm('N','N', NCOL-NPIV,NROW1,NPIV,ALPHA,A(UPOS),NCOL, 690 & A(LPOS2),NCOL1,ONE, A(LPOS),NCOL1) 691 DPOS = POSELT + int(NCOL1 - NROW1,8) 692 IF ( NROW1 .GT. KEEP(7) ) THEN 693 BLSIZE = KEEP(8) 694 ELSE 695 BLSIZE = NROW1 696 ENDIF 697 IF ( NROW1 .GT. 0 ) THEN 698 DO IROW = 1, NROW1, BLSIZE 699 Block = min( BLSIZE, NROW1 - IROW + 1 ) 700 DPOS = POSELT + int(NCOL1 - NROW1,8) 701 & + int( IROW - 1, 8 ) * int( NCOL1 + 1, 8 ) 702 LPOS2 = POSELT + int(NPIV1,8) 703 & + int( IROW - 1, 8 ) * int( NCOL1, 8 ) 704 UPOS = int( IROW - 1, 8 ) * int(NPIV, 8) + 1_8 705 DO I = 1, Block 706 CALL dgemv( 'T', NPIV, Block-I+1, ALPHA, 707 & A( LPOS2 + int(I - 1,8) * int(NCOL1,8) ), NCOL1, 708 & UIP21K( UPOS + int(NPIV,8) * int( I - 1, 8 ) ), 709 & 1, ONE, A(DPOS+int(NCOL1+1,8)*int(I-1,8)),NCOL1 ) 710 END DO 711 IF ( NROW1-IROW+1-Block .ne. 0 ) 712 & CALL dgemm( 'T', 'N', Block, NROW1-IROW+1-Block, NPIV, ALPHA, 713 & UIP21K( UPOS ), NPIV, 714 & A( LPOS2 + int(Block,8) * int(NCOL1,8) ), NCOL1, ONE, 715 & A( DPOS + int(Block,8) * int(NCOL1,8) ), NCOL1 ) 716 ENDDO 717 ENDIF 718 ENDIF 719 FLOP1 = dble(NROW1) * dble(NPIV) * 720 & dble( 2 * NCOL - NPIV + NROW1 +1 ) 721 FLOP1 = -FLOP1 722 CALL DMUMPS_LOAD_UPDATE( 1, .FALSE., FLOP1, KEEP,KEEP8 ) 723 ENDIF 724 IW(IOLDPS+KEEP(IXSZ)) = IW(IOLDPS+KEEP(IXSZ)) - NPIV 725 IW(IOLDPS + 3+KEEP(IXSZ)) = IW(IOLDPS+3+KEEP(IXSZ)) + NPIV 726 IF (LASTBL) IW(IOLDPS+1+KEEP(IXSZ)) = IW(IOLDPS + 3+KEEP(IXSZ)) 727 IF ( .NOT. SEND_LR ) THEN 728 LRLU = LRLU + LAELL 729 LRLUS = LRLUS + LAELL 730 KEEP8(70) = KEEP8(70) + LAELL 731 KEEP8(71) = KEEP8(71) + LAELL 732 POSFAC = POSFAC - LAELL 733 IWPOS = IWPOS - NPIV 734 CALL DMUMPS_LOAD_MEM_UPDATE(.FALSE.,.FALSE., 735 & LA-LRLUS,0_8,-LAELL,KEEP,KEEP8,LRLUS) 736 ENDIF 737 IF ( NSLAVES_FOLLOW .NE. 0 .and. NPIV .NE. 0 ) THEN 738 IPOSK = NPIV1 + 1 739 JPOSK = NCOL1 - NROW1 + 1 740 NPIVSENT = NPIV 741 IERR = -1 742 DO WHILE ( IERR .eq. -1 ) 743 CALL DMUMPS_BUF_SEND_BLFAC_SLAVE( 744 & INODE, NPIVSENT, FPERE, 745 & IPOSK, JPOSK, 746 & UIP21K, NROW1, 747 & NSLAVES_FOLLOW, 748 & LIST_SLAVES_FOLLOW(1), 749 & COMM, KEEP, 750 & SEND_LR, BLR_LS, IPANEL, 751 & A, LA, POSBLOCFACTO, LD_BLOCFACTO, 752 & IW(IPIV), MAXI_CLUSTER, 753 & IERR ) 754 IF (IERR .EQ. -1 ) THEN 755 IOLDPS = PTRIST(STEP(INODE)) 756 IF ( IW(IOLDPS+6+KEEP(IXSZ)) .eq. 757 & huge(IW(IOLDPS+6+KEEP(IXSZ))) ) THEN 758 COUNTER_WAS_HUGE=.TRUE. 759 IW(IOLDPS+6+KEEP(IXSZ)) = 1 760 ELSE 761 COUNTER_WAS_HUGE=.FALSE. 762 ENDIF 763 TO_UPDATE_CPT_RECUR = 764 & ( NSLAVES_TOT - NSLAVES_FOLLOW - 1 ) * 765 & (2*NASS1/KEEP(6)) 766 IW(IOLDPS+6+KEEP(IXSZ)) = 767 & IW(IOLDPS+6+KEEP(IXSZ)) - TO_UPDATE_CPT_RECUR - 10 768 BLOCKING = .FALSE. 769 SET_IRECV= .TRUE. 770 MESSAGE_RECEIVED = .FALSE. 771 CALL DMUMPS_TRY_RECVTREAT( COMM_LOAD, ASS_IRECV, 772 & BLOCKING, SET_IRECV, MESSAGE_RECEIVED, 773 & MPI_ANY_SOURCE, MPI_ANY_TAG, 774 & STATUS, 775 & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, 776 & IWPOS, IWPOSCB, IPTRLU, 777 & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, 778 & PTLUST_S, PTRFAC, 779 & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, 780 & IFLAG, IERROR, COMM, 781 & NBPROCFILS, IPOOL, LPOOL, LEAF, NBFIN, MYID, SLAVEF, 782 & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, 783 & FILS, PTRARW, PTRAIW, 784 & INTARR, DBLARR,ICNTL,KEEP,KEEP8,DKEEP,ND, FRERE_STEPS, 785 & LPTRAR, NELT, FRTPTR, FRTELT, 786 & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. 787 & , LRGROUPS 788 & ) 789 IOLDPS = PTRIST(STEP(INODE)) 790 IW(IOLDPS+6+KEEP(IXSZ)) = 791 & IW(IOLDPS+6+KEEP(IXSZ)) + TO_UPDATE_CPT_RECUR + 10 792 IF ( COUNTER_WAS_HUGE .AND. 793 & IW(IOLDPS+6+KEEP(IXSZ)).EQ.1 ) THEN 794 IW(IOLDPS+6+KEEP(IXSZ)) = huge(IW(IOLDPS+6+KEEP(IXSZ))) 795 ENDIF 796 IF ( IFLAG .LT. 0 ) GOTO 600 797 END IF 798 END DO 799#if defined(IBC_TEST) 800 WRITE(*,*) MYID,":Send2slave worked" 801#endif 802 IF ( IERR .eq. -2 ) THEN 803 IF (LP > 0 ) WRITE(LP,*) MYID, 804 &": FAILURE, SEND BUFFER TOO SMALL DURING 805 & DMUMPS_PROCESS_SYM_BLOCFACTO" 806 WRITE(LP,*) "NPIV=", NPIV, "NROW1=",NROW1 807 IFLAG = -17 808 IERROR = 5 * KEEP(34) + NPIV * NROW1 * KEEP(35) 809 GOTO 700 810 END IF 811 IF ( IERR .eq. -3 ) THEN 812 IF (LP > 0 ) WRITE(LP,*) MYID, 813 &": FAILURE, RECV BUFFER TOO SMALL DURING 814 & DMUMPS_PROCESS_SYM_BLOCFACTO" 815 IFLAG = -20 816 IERROR = 5 * KEEP(34) + NPIV * NROW1 * KEEP(35) 817 GOTO 700 818 END IF 819 DEALLOCATE(LIST_SLAVES_FOLLOW) 820 END IF 821 IF ( NPIV.GT. 0 .AND. SEND_LR ) THEN 822 IF (NSLAVES_PREC.GT.0) THEN 823 IOLDPS = PTRIST(STEP(INODE)) 824 CALL DMUMPS_BLR_DEC_AND_TRYFREE_L(IW(IOLDPS+XXF),IPANEL, 825 & KEEP8, .TRUE.) 826 ENDIF 827 LRLU = LRLU + LAELL 828 LRLUS = LRLUS + LAELL 829 KEEP8(70) = KEEP8(70) + LAELL 830 KEEP8(71) = KEEP8(71) + LAELL 831 POSFAC = POSFAC - LAELL 832 IWPOS = IWPOS - NPIV 833 CALL DMUMPS_LOAD_MEM_UPDATE(.FALSE.,.FALSE., 834 & LA-LRLUS,0_8,-LAELL,KEEP,KEEP8,LRLUS) 835 ENDIF 836 IF ( NPIV .NE. 0 ) THEN 837 IF (allocated(UIP21K)) DEALLOCATE( UIP21K ) 838 ENDIF 839 IOLDPS = PTRIST(STEP(INODE)) 840 IF (LASTBL) THEN 841 IF (KEEP(486).NE.0) THEN 842 IF (SEND_LR) THEN 843 CALL STATS_COMPUTE_FLOP_SLAVE_TYPE2(NROW1, NCOL1, NASS1, 844 & KEEP(50), INODE) 845 ELSE 846 CALL UPD_FLOP_FRFRONT_SLAVE(NROW1, NCOL1, NASS1, 847 & KEEP(50), INODE) 848 ENDIF 849 ENDIF 850 IF ( IW(IOLDPS+6+KEEP(IXSZ)).EQ. 851 & huge(IW(IOLDPS+6+KEEP(IXSZ))) ) THEN 852 IW(IOLDPS+6+KEEP(IXSZ)) = 1 853 ENDIF 854 IW(IOLDPS+6+KEEP(IXSZ)) = IW(IOLDPS+6+KEEP(IXSZ)) 855 & - TO_UPDATE_CPT_END 856 & - 1 857 IF ( IW(IOLDPS+6+KEEP(IXSZ) ) .eq. 0 858 & .and. KEEP(50) .ne. 0 .and. NSLAVES_FOLLOW .eq. 0 859 & .and. NSLAVES_TOT.NE.1 ) THEN 860 DEST = MUMPS_PROCNODE( PROCNODE_STEPS(STEP(INODE)), SLAVEF ) 861 CALL DMUMPS_BUF_SEND_1INT( INODE, DEST, END_NIV2_LDLT, 862 & COMM, KEEP, IERR ) 863 IF ( IERR .LT. 0 ) THEN 864 write(*,*) ' Internal error in PROCESS_SYM_BLOCFACTO.' 865 IFLAG = -99 866 GOTO 700 867 END IF 868 ENDIF 869 END IF 870 IF (IW(IOLDPS+6+KEEP(IXSZ)) .eq. 0 ) THEN 871 IF (SEND_LR) THEN 872 IF (KEEP(489) .EQ. 1) THEN 873 CALL DMUMPS_FAKE_COMPRESS_CB(A, LA, POSELT, NCOL1, 874 & BEGS_BLR_LS, NB_BLR_LS+1, 875 & BEGS_BLR_COL, NB_BLR_COL, NPARTSASS_MASTER, 876 & DKEEP(8), NASS1, NROW1, 877 & KEEP(50), WORK, TAU, JPVT, LWORK, RWORK, 878 & BLOCKLR, MAXI_CLUSTER, STEP_STATS(INODE), 2, 879 & .TRUE., 0, KEEP(484)) 880 ENDIF 881 ENDIF 882 CALL DMUMPS_END_FACTO_SLAVE( COMM_LOAD, ASS_IRECV, 883 & N, INODE, FPERE, 884 & root, 885 & MYID, COMM, 886 & 887 & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, 888 & IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, IW, LIW, A, LA, 889 & PTRIST, PTLUST_S, PTRFAC, PTRAST, STEP, PIMASTER, 890 & PAMASTER, 891 & NSTK_S, COMP, IFLAG, IERROR, NBPROCFILS, 892 & IPOOL, LPOOL, LEAF, NBFIN, SLAVEF, 893 & OPASSW, OPELIW, ITLOC, RHS_MUMPS, FILS, PTRARW, PTRAIW, 894 & INTARR,DBLARR,ICNTL,KEEP,KEEP8,DKEEP,ND,FRERE_STEPS, 895 & LPTRAR, NELT, FRTPTR, FRTELT, 896 & ISTEP_TO_INIV2, TAB_POS_IN_PERE 897 & , LRGROUPS 898 & ) 899 ENDIF 900 IF (SEND_LR) THEN 901 IF (allocated(RWORK)) DEALLOCATE(RWORK) 902 IF (allocated(work)) DEALLOCATE(WORK) 903 IF (allocated(TAU)) DEALLOCATE(TAU) 904 IF (allocated(JPVT)) DEALLOCATE(JPVT) 905 IF (allocated(BLOCKLR)) DEALLOCATE(BLOCKLR) 906 IF (NPIV.GT.0) THEN 907 IF (.NOT.KEEP_BEGS_BLR_LS) THEN 908 IF (associated(BEGS_BLR_LS)) DEALLOCATE(BEGS_BLR_LS) 909 ENDIF 910 IF (.NOT.KEEP_BLR_LS) THEN 911 CALL DEALLOC_BLR_PANEL (BLR_LS, NB_BLR_LS, KEEP8, .TRUE.) 912 IF (associated(BLR_LS)) DEALLOCATE(BLR_LS) 913 ENDIF 914 IF (associated(BEGS_BLR_LM)) DEALLOCATE(BEGS_BLR_LM) 915 IF (.NOT.KEEP_BEGS_BLR_COL) THEN 916 IF (KEEP(489).EQ.1) THEN 917 IF (associated(BEGS_BLR_COL)) THEN 918 DEALLOCATE( BEGS_BLR_COL) 919 ENDIF 920 ENDIF 921 ENDIF 922 ENDIF 923 ENDIF 924 600 CONTINUE 925#if defined(IBC_TEST) 926 write(6,*) MYID,' :Exiting DMUMPS_PROCESS_SYM_BLOCFACTO for 927 &INODE=', INODE 928#endif 929 RETURN 930 700 CONTINUE 931 CALL DMUMPS_BDC_ERROR( MYID, SLAVEF, COMM, KEEP ) 932 RETURN 933 END SUBROUTINE DMUMPS_PROCESS_SYM_BLOCFACTO 934