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 CMUMPS_MAPLIG( COMM_LOAD, ASS_IRECV, 14 & BUFR, LBUFR, LBUFR_BYTES, 15 & 16 & INODE_PERE, ISON, NSLAVES_PERE, LIST_SLAVES_PERE, 17 & NFRONT_PERE, NASS_PERE, NFS4FATHER,LMAP, TROW, 18 & PROCNODE_STEPS, SLAVEF, POSFAC, IWPOS, IWPOSCB, IPTRLU, LRLU, 19 & LRLUS, N, IW, 20 & LIW, A, LA, 21 & PTRIST, PTLUST, PTRFAC, 22 & PTRAST, STEP, PIMASTER, PAMASTER, NSTK, COMP, 23 & IFLAG, IERROR, MYID, COMM, NBPROCFILS, IPOOL, LPOOL, LEAF, 24 & NBFIN, ICNTL, KEEP,KEEP8,DKEEP, 25 & root, OPASSW, OPELIW, 26 & ITLOC, RHS_MUMPS, 27 & FILS, PTRARW, PTRAIW, INTARR, DBLARR, ND, FRERE, 28 & LPTRAR, NELT, FRTPTR, FRTELT, 29 & 30 & ISTEP_TO_INIV2, TAB_POS_IN_PERE 31 & , LRGROUPS 32 & ) 33 USE CMUMPS_BUF 34 USE CMUMPS_LOAD 35#if ! defined(NO_FDM_MAPROW) 36 USE MUMPS_FAC_MAPROW_DATA_M 37#endif 38 IMPLICIT NONE 39 INCLUDE 'cmumps_root.h' 40#if ! defined(NO_FDM_MAPROW) 41#endif 42 TYPE (CMUMPS_ROOT_STRUC ) :: root 43 INTEGER LBUFR, LBUFR_BYTES 44 INTEGER ICNTL( 40 ), KEEP(500) 45 INTEGER(8) KEEP8(150) 46 REAL DKEEP(230) 47 INTEGER COMM_LOAD, ASS_IRECV 48 INTEGER BUFR( LBUFR ) 49 INTEGER SLAVEF, NBFIN 50 INTEGER(8) :: LA, IPTRLU, LRLU, LRLUS, POSFAC 51 INTEGER IWPOS, IWPOSCB 52 INTEGER N, LIW 53 INTEGER IW( LIW ) 54 COMPLEX A( LA ) 55 INTEGER, intent(in) :: LRGROUPS(N) 56 INTEGER(8) :: PTRFAC(KEEP(28)) 57 INTEGER(8) :: PTRAST(KEEP(28)) 58 INTEGER(8) :: PAMASTER(KEEP(28)) 59 INTEGER PTRIST(KEEP(28)), PTLUST(KEEP(28)) 60 INTEGER STEP(N), PIMASTER(KEEP(28)) 61 INTEGER PROCNODE_STEPS( KEEP(28) ) 62 INTEGER COMP 63 INTEGER NSTK( KEEP(28) ) 64 INTEGER NBPROCFILS( KEEP(28) ) 65 INTEGER IFLAG, IERROR, COMM, MYID 66 INTEGER LPOOL, LEAF 67 INTEGER IPOOL( LPOOL ) 68 INTEGER INODE_PERE, ISON 69 INTEGER NFS4FATHER 70 INTEGER NBROWS_ALREADY_SENT 71 INTEGER NSLAVES_PERE, NFRONT_PERE, NASS_PERE 72 INTEGER LIST_SLAVES_PERE( * ) 73 INTEGER LMAP 74 INTEGER TROW( LMAP ) 75 DOUBLE PRECISION OPASSW, OPELIW 76 COMPLEX DBLARR(KEEP8(26)) 77 INTEGER INTARR(KEEP8(27)) 78 INTEGER LPTRAR, NELT 79 INTEGER FRTPTR( N+1 ), FRTELT( NELT ) 80 INTEGER ITLOC( N+KEEP(253) ), FILS( N ) 81 COMPLEX :: RHS_MUMPS(KEEP(255)) 82 INTEGER(8), INTENT(IN) :: PTRARW( LPTRAR ), PTRAIW( LPTRAR ) 83 INTEGER ND( KEEP(28) ), FRERE( KEEP(28) ) 84 INTEGER ISTEP_TO_INIV2(KEEP(71)), 85 & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) 86 INCLUDE 'mpif.h' 87 INCLUDE 'mumps_tags.h' 88 INTEGER IERR 89 INTEGER :: STATUS(MPI_STATUS_SIZE) 90 INTEGER NOSLA, I 91 INTEGER I_POSMYIDIN_PERE 92 INTEGER INDICE_PERE 93 INTEGER PDEST, PDEST_MASTER 94 LOGICAL :: LOCAL_ASSEMBLY_TO_BE_DONE 95 INTEGER NROWS_TO_SEND 96 INTEGER PDEST_MASTER_ISON, IPOS_IN_SLAVE 97 LOGICAL DESCLU, SLAVE_ISON 98 LOGICAL BLOCKING, SET_IRECV, MESSAGE_RECEIVED 99 INTEGER MSGSOU, MSGTAG 100 INTEGER LP 101 LOGICAL COMPRESSCB 102 LOGICAL IS_ERROR_BROADCASTED, IS_ofType5or6 103 INTEGER ITYPE, TYPESPLIT 104 INTEGER KEEP253_LOC 105#if ! defined(NO_FDM_MAPROW) 106 INTEGER :: INFO_TMP(2) 107#endif 108 INCLUDE 'mumps_headers.h' 109 INTEGER MUMPS_PROCNODE, MUMPS_TYPENODE, MUMPS_TYPESPLIT 110 EXTERNAL MUMPS_PROCNODE, MUMPS_TYPENODE, MUMPS_TYPESPLIT 111 INTEGER LMAP_LOC, allocok 112 INTEGER, ALLOCATABLE, DIMENSION(:) :: NBROW 113 INTEGER, ALLOCATABLE, DIMENSION(:) :: SLAVES_PERE 114 INTEGER, ALLOCATABLE, DIMENSION(:) :: MAP, PERM 115 IS_ERROR_BROADCASTED = .FALSE. 116 TYPESPLIT = MUMPS_TYPESPLIT(PROCNODE_STEPS(STEP(INODE_PERE)), 117 & SLAVEF) 118 IS_ofType5or6 = ((TYPESPLIT.EQ.5).OR.(TYPESPLIT.EQ.6)) 119 LP = ICNTL(1) 120 IF (ICNTL(4) .LE. 0) LP = -1 121#if ! defined(NO_FDM_MAPROW) 122#endif 123 ALLOCATE(SLAVES_PERE(0:max(1,NSLAVES_PERE)), stat=allocok) 124 if (allocok .GT. 0) THEN 125 IF (LP > 0) write(LP,*) MYID, 126 & ' : PB allocation SLAVES_PERE in CMUMPS_MAPLIG' 127 IFLAG =-13 128 IERROR = NSLAVES_PERE+1 129 GOTO 700 130 endif 131 IF (NSLAVES_PERE.GT.0) 132 &SLAVES_PERE(1:NSLAVES_PERE) = LIST_SLAVES_PERE(1:NSLAVES_PERE) 133 SLAVES_PERE(0) = MUMPS_PROCNODE( PROCNODE_STEPS(STEP(INODE_PERE)), 134 & SLAVEF ) 135 ALLOCATE(NBROW(0:NSLAVES_PERE), stat=allocok) 136 if (allocok .GT. 0) THEN 137 IF (LP>0) write(LP,*) MYID, 138 & ' : PB allocation NBROW in CMUMPS_MAPLIG' 139 IFLAG =-13 140 IERROR = NSLAVES_PERE+1 141 GOTO 670 142 endif 143 LMAP_LOC = LMAP 144 ALLOCATE(MAP(LMAP_LOC), stat=allocok) 145 if (allocok .GT. 0) THEN 146 IF (LP>0) THEN 147 write(LP,*) MYID, ' : PB allocation LMAP in CMUMPS_MAPLIG' 148 ENDIF 149 IFLAG =-13 150 IERROR = LMAP 151 GOTO 680 152 endif 153 MAP( 1 : LMAP ) = TROW( 1 : LMAP ) 154 PDEST_MASTER_ISON = MUMPS_PROCNODE(PROCNODE_STEPS(STEP(ISON)), 155 & SLAVEF) 156 SLAVE_ISON = PDEST_MASTER_ISON .NE. MYID 157 IF (SLAVE_ISON) THEN 158 IF ( PTRIST(STEP( ISON )) .EQ. 0 ) THEN 159 CALL CMUMPS_TREAT_DESCBAND( ISON, COMM_LOAD, 160 & ASS_IRECV, 161 & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, 162 & IWPOS, IWPOSCB, IPTRLU, 163 & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, 164 & PTLUST, PTRFAC, 165 & PTRAST, STEP, PIMASTER, PAMASTER, NSTK, COMP, 166 & IFLAG, IERROR, COMM, 167 & NBPROCFILS, 168 & IPOOL, LPOOL, LEAF, 169 & NBFIN, MYID, SLAVEF, 170 & 171 & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, 172 & FILS, PTRARW, PTRAIW, 173 & INTARR, DBLARR,ICNTL,KEEP,KEEP8,DKEEP,ND, FRERE, LPTRAR, 174 & NELT, FRTPTR, FRTELT, 175 & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. 176 & , LRGROUPS 177 & ) 178 IF ( IFLAG .LT. 0 ) THEN 179 IS_ERROR_BROADCASTED = .TRUE. 180 GOTO 670 181 ENDIF 182 END IF 183#if ! defined(NO_FDM_MAPROW) 184 IF ( 185 & ( IW( PTRIST(STEP(ISON)) + 1 + KEEP(IXSZ) ) .NE. 186 & IW( PTRIST(STEP(ISON)) + 3 + KEEP(IXSZ) ) ) .OR. 187 & ( KEEP(50) .NE. 0 .AND. 188 & IW( PTRIST(STEP(ISON)) + 6 + KEEP(IXSZ) ) .NE. 0 ) ) 189 & THEN 190 INFO_TMP=0 191 CALL MUMPS_FMRD_SAVE_MAPROW( 192 & IW(PTRIST(STEP(ISON))+XXA), 193 & INODE_PERE, ISON, NSLAVES_PERE, NFRONT_PERE, 194 & NASS_PERE, LMAP, NFS4FATHER, 195 & SLAVES_PERE(1:NSLAVES_PERE), 196 & MAP, 197 & INFO_TMP) 198 IF (INFO_TMP(1) < 0) THEN 199 IFLAG = INFO_TMP(1) 200 IERROR = INFO_TMP(2) 201 ENDIF 202 GOTO 670 203 ELSE 204 GOTO 10 205 ENDIF 206#endif 207 DO WHILE ( 208 & ( IW( PTRIST(STEP(ISON)) + 1 + KEEP(IXSZ) ) .NE. 209 & IW( PTRIST(STEP(ISON)) + 3 + KEEP(IXSZ) ) ) .OR. 210 & ( KEEP(50) .NE. 0 .AND. 211 & IW( PTRIST(STEP(ISON)) + 6 + KEEP(IXSZ) ) .NE. 0 ) ) 212 IF ( KEEP(50).eq.0) THEN 213#if defined(IBC_TEST) 214 MSGSOU = IW( PTRIST(STEP(ISON)) + 7 + KEEP(IXSZ) ) 215 MSGTAG = BLOC_FACTO 216#else 217 MSGSOU = PDEST_MASTER_ISON 218 MSGTAG = BLOC_FACTO 219#endif 220 ELSE 221 IF ( IW( PTRIST(STEP(ISON)) + 1 + KEEP(IXSZ) ) .NE. 222 & IW( PTRIST(STEP(ISON)) + 3 + KEEP(IXSZ) ) ) THEN 223#if defined(IBC_TEST) 224 MSGSOU = IW( PTRIST(STEP(ISON)) + 9 + KEEP(IXSZ) ) 225 MSGTAG = BLOC_FACTO_SYM 226#else 227 MSGSOU = PDEST_MASTER_ISON 228 MSGTAG = BLOC_FACTO_SYM 229#endif 230 ELSE 231 MSGSOU = MPI_ANY_SOURCE 232 MSGTAG = BLOC_FACTO_SYM_SLAVE 233 END IF 234 END IF 235 BLOCKING = .TRUE. 236 SET_IRECV= .FALSE. 237 MESSAGE_RECEIVED = .FALSE. 238 CALL CMUMPS_TRY_RECVTREAT( COMM_LOAD, 239 & ASS_IRECV, BLOCKING, SET_IRECV, MESSAGE_RECEIVED, 240 & MSGSOU, MSGTAG, 241 & STATUS, 242 & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, 243 & IWPOS, IWPOSCB, IPTRLU, 244 & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, 245 & PTLUST, PTRFAC, 246 & PTRAST, STEP, PIMASTER, PAMASTER, NSTK, COMP, 247 & IFLAG, IERROR, COMM, 248 & NBPROCFILS, IPOOL, LPOOL, LEAF, NBFIN, MYID, SLAVEF, 249 & 250 & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, 251 & FILS, PTRARW, PTRAIW, 252 & INTARR, DBLARR,ICNTL,KEEP,KEEP8,DKEEP,ND, FRERE, LPTRAR, 253 & NELT, FRTPTR, FRTELT, 254 & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. 255 & , LRGROUPS 256 & ) 257 IF ( IFLAG .LT. 0 ) THEN 258 IS_ERROR_BROADCASTED = .TRUE. 259 GOTO 670 260 ENDIF 261 END DO 262 ENDIF 263#if ! defined(NO_FDM_MAPROW) 264 10 CONTINUE 265#endif 266 IF ( NSLAVES_PERE .EQ. 0 ) THEN 267 NBROW( 0 ) = LMAP_LOC 268 ELSE 269 DO I = 0, NSLAVES_PERE 270 NBROW( I ) = 0 271 END DO 272 DO I = 1, LMAP_LOC 273 INDICE_PERE = MAP( I ) 274 CALL MUMPS_BLOC2_GET_ISLAVE( 275 & KEEP,KEEP8, INODE_PERE, STEP, N, SLAVEF, 276 & ISTEP_TO_INIV2, TAB_POS_IN_PERE, 277 & 278 & NASS_PERE, 279 & NFRONT_PERE - NASS_PERE, 280 & NSLAVES_PERE, 281 & INDICE_PERE, 282 & NOSLA, 283 & IPOS_IN_SLAVE ) 284 NBROW( NOSLA ) = NBROW( NOSLA ) + 1 285 END DO 286 DO I = 1, NSLAVES_PERE 287 NBROW(I)=NBROW(I)+NBROW(I-1) 288 ENDDO 289 ENDIF 290 ALLOCATE(PERM(LMAP_LOC), stat=allocok) 291 IF (allocok .GT. 0) THEN 292 IF (LP.GT.0) THEN 293 write(LP,*) MYID,': PB allocation PERM in CMUMPS_MAPLIG' 294 ENDIF 295 IFLAG =-13 296 IERROR = LMAP_LOC 297 GOTO 670 298 ENDIF 299 KEEP253_LOC = 0 300 DO I = LMAP_LOC, 1, -1 301 INDICE_PERE = MAP( I ) 302 IF (INDICE_PERE > NFRONT_PERE - KEEP(253)) THEN 303 KEEP253_LOC = KEEP253_LOC + 1 304 ENDIF 305 CALL MUMPS_BLOC2_GET_ISLAVE( 306 & KEEP,KEEP8, INODE_PERE, STEP, N, SLAVEF, 307 & ISTEP_TO_INIV2, TAB_POS_IN_PERE, 308 & 309 & NASS_PERE, 310 & NFRONT_PERE - NASS_PERE, 311 & NSLAVES_PERE, 312 & INDICE_PERE, 313 & NOSLA, 314 & IPOS_IN_SLAVE ) 315 PERM( NBROW( NOSLA ) ) = I 316 NBROW( NOSLA ) = NBROW( NOSLA ) - 1 317 ENDDO 318 DO I = 0, NSLAVES_PERE 319 NBROW(I)=NBROW(I)+1 320 END DO 321 PDEST_MASTER = SLAVES_PERE(0) 322 I_POSMYIDIN_PERE = -99999 323 LOCAL_ASSEMBLY_TO_BE_DONE = .FALSE. 324 DO I = 0, NSLAVES_PERE 325 IF (SLAVES_PERE(I) .EQ. MYID) THEN 326 I_POSMYIDIN_PERE = I 327 LOCAL_ASSEMBLY_TO_BE_DONE = .TRUE. 328#if ! defined(NO_FDM_DESCBAND) 329 IF (PTRIST(STEP(INODE_PERE)) .EQ. 0 330 & .AND. MYID .NE. PDEST_MASTER) THEN 331 CALL CMUMPS_TREAT_DESCBAND( INODE_PERE, COMM_LOAD, 332 & ASS_IRECV, 333 & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, 334 & IWPOS, IWPOSCB, IPTRLU, 335 & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, 336 & PTLUST, PTRFAC, 337 & PTRAST, STEP, PIMASTER, PAMASTER, NSTK, COMP, 338 & IFLAG, IERROR, COMM, 339 & NBPROCFILS, IPOOL, LPOOL, LEAF, NBFIN, MYID, SLAVEF, 340 & 341 & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, 342 & FILS, PTRARW, PTRAIW, 343 & INTARR, DBLARR,ICNTL,KEEP,KEEP8,DKEEP,ND, FRERE, LPTRAR, 344 & NELT, FRTPTR, FRTELT, 345 & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. 346 & , LRGROUPS 347 & ) 348 IF ( IFLAG .LT. 0 ) THEN 349 IS_ERROR_BROADCASTED = .TRUE. 350 GOTO 600 351 ENDIF 352 ENDIF 353#endif 354 ENDIF 355 END DO 356 IF (KEEP(120).NE.0 .AND. LOCAL_ASSEMBLY_TO_BE_DONE) THEN 357 CALL CMUMPS_LOCAL_ASSEMBLY_TYPE2(I_POSMYIDIN_PERE, 358 & SLAVES_PERE(I_POSMYIDIN_PERE), 359 & MYID, PDEST_MASTER, ISON, INODE_PERE, 360 & NSLAVES_PERE, NASS_PERE, NFRONT_PERE, NFS4FATHER, 361 & LMAP_LOC, MAP, NBROW, PERM, 362 & IS_ofType5or6, IFLAG, IERROR, 363 & N, SLAVEF, KEEP, NBPROCFILS, IPOOL, LPOOL, STEP, 364 & PROCNODE_STEPS, COMM_LOAD, ISTEP_TO_INIV2, TAB_POS_IN_PERE, 365 & 366 & KEEP8, IW, LIW, A, LA, LRLU, LRLUS, IPTRLU, IWPOSCB, 367 & PTRIST, PTLUST, PTRAST, PAMASTER, PIMASTER, ND, 368 & NELT, FRTPTR, FRTELT, 369 & OPASSW, OPELIW, 370 & ITLOC, RHS_MUMPS, KEEP253_LOC, 371 & FILS, LPTRAR, PTRARW, PTRAIW, INTARR, DBLARR, ICNTL) 372 LOCAL_ASSEMBLY_TO_BE_DONE = .FALSE. 373 IF (IFLAG < 0) THEN 374 GOTO 600 375 ENDIF 376 ENDIF 377 DO I = NSLAVES_PERE, 0, -1 378 PDEST = SLAVES_PERE( I ) 379 IF ( PDEST .NE. MYID ) THEN 380 DESCLU = .FALSE. 381 NBROWS_ALREADY_SENT = 0 382 IF (I == NSLAVES_PERE) THEN 383 NROWS_TO_SEND=LMAP_LOC-NBROW(I)+1 384 ELSE 385 NROWS_TO_SEND=NBROW(I+1)-NBROW(I) 386 ENDIF 387 COMPRESSCB=(IW(PTRIST(STEP(ISON))+XXS).EQ.S_CB1COMP) 388 IERR = -1 389 DO WHILE (IERR .EQ. -1) 390 IF ( IW ( PTRIST(STEP(ISON) )+KEEP(IXSZ) ) 391 & .GT. N + KEEP(253) ) THEN 392 WRITE(*,*) MYID,': Internal error in Maplig' 393 WRITE(*,*) MYID,': PTRIST(STEP(ISON))/N=', 394 & PTRIST(STEP(ISON)), N 395 WRITE(*,*) MYID,': I, NBROW(I)=',I, NBROW(I) 396 WRITE(*,*) MYID,': NSLAVES_PERE=',NSLAVES_PERE 397 WRITE(*,*) MYID,': ISON, INODE_PERE=',ISON,INODE_PERE 398 WRITE(*,*) MYID,': Son header=', 399 & IW(PTRIST(STEP(ISON)): PTRIST(STEP(ISON))+5+KEEP(IXSZ)) 400 CALL MUMPS_ABORT() 401 END IF 402 IF (NROWS_TO_SEND .EQ. 0 .AND. PDEST.NE.PDEST_MASTER) THEN 403 IERR = 0 404 CYCLE 405 ENDIF 406 CALL CMUMPS_BUF_SEND_CONTRIB_TYPE2( NBROWS_ALREADY_SENT, 407 & DESCLU, INODE_PERE, 408 & NFRONT_PERE, NASS_PERE, NFS4FATHER, 409 & NSLAVES_PERE, ISON, 410 & NROWS_TO_SEND, LMAP_LOC, MAP, 411 & PERM(min(LMAP_LOC,NBROW(I))), 412 & IW( PTRIST(STEP(ISON))), 413 & A(PTRAST(STEP(ISON))), I, PDEST, PDEST_MASTER, 414 & COMM, IERR, 415 & 416 & KEEP,KEEP8, STEP, N, SLAVEF, 417 & ISTEP_TO_INIV2, TAB_POS_IN_PERE, COMPRESSCB, 418 & KEEP253_LOC ) 419 IF ( IERR .EQ. -2 ) THEN 420 IFLAG = -17 421 IF (LP .GT. 0) THEN 422 WRITE(LP,*) 423 & "FAILURE: SEND BUFFER TOO SMALL IN CMUMPS_MAPLIG" 424 ENDIF 425 IERROR = (NROWS_TO_SEND + 3 )* KEEP( 34 ) + 426 & NROWS_TO_SEND * IW(PTRIST(STEP(ISON))+KEEP(IXSZ)) 427 & * KEEP( 35 ) 428 GO TO 600 429 END IF 430 IF ( IERR .EQ. -3 ) THEN 431 IF (LP .GT. 0) THEN 432 WRITE(LP,*) 433 & "FAILURE: RECV BUFFER TOO SMALL IN CMUMPS_MAPLIG" 434 ENDIF 435 IFLAG = -20 436 IERROR = (NROWS_TO_SEND + 3 )* KEEP( 34 ) + 437 & NROWS_TO_SEND * IW(PTRIST(STEP(ISON))+KEEP(IXSZ)) 438 & * KEEP( 35 ) 439 GOTO 600 440 ENDIF 441 IF (KEEP(219).NE.0) THEN 442 IF ( IERR .EQ. -4 ) THEN 443 IFLAG = -13 444 IERROR = NFS4FATHER 445 IF (LP .GT. 0) THEN 446 WRITE(LP, *) 447 & "FAILURE: MAX_ARRAY allocation failed IN CMUMPS_MAPLIG" 448 ENDIF 449 GO TO 600 450 END IF 451 END IF 452 IF ( IERR .EQ. -1 ) THEN 453 IF (LOCAL_ASSEMBLY_TO_BE_DONE) THEN 454 CALL CMUMPS_LOCAL_ASSEMBLY_TYPE2(I_POSMYIDIN_PERE, 455 & SLAVES_PERE(I_POSMYIDIN_PERE), 456 & MYID, PDEST_MASTER, ISON, INODE_PERE, 457 & NSLAVES_PERE, NASS_PERE, NFRONT_PERE, NFS4FATHER, 458 & LMAP_LOC, MAP, NBROW, PERM, 459 & IS_ofType5or6, IFLAG, IERROR, 460 & N, SLAVEF, KEEP, NBPROCFILS, IPOOL, LPOOL, STEP, 461 & PROCNODE_STEPS, COMM_LOAD, ISTEP_TO_INIV2, 462 & TAB_POS_IN_PERE, 463 & KEEP8, IW, LIW, A, LA, LRLU, LRLUS, IPTRLU, IWPOSCB, 464 & PTRIST, PTLUST, PTRAST, PAMASTER, PIMASTER, ND, 465 & NELT, FRTPTR, FRTELT, 466 & OPASSW, OPELIW, 467 & ITLOC, RHS_MUMPS, KEEP253_LOC, 468 & FILS, LPTRAR, PTRARW, PTRAIW, INTARR, DBLARR, ICNTL) 469 LOCAL_ASSEMBLY_TO_BE_DONE = .FALSE. 470 IF (IFLAG < 0) THEN 471 GOTO 600 472 ENDIF 473 ELSE 474 BLOCKING = .FALSE. 475 SET_IRECV = .TRUE. 476 MESSAGE_RECEIVED = .FALSE. 477 CALL CMUMPS_TRY_RECVTREAT( COMM_LOAD, 478 & ASS_IRECV, BLOCKING, SET_IRECV, MESSAGE_RECEIVED, 479 & MPI_ANY_SOURCE, MPI_ANY_TAG, 480 & STATUS, 481 & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, 482 & IWPOS, IWPOSCB, IPTRLU, 483 & LRLU, LRLUS, N, IW, LIW, A, LA, 484 & PTRIST, PTLUST, PTRFAC, 485 & PTRAST, STEP, PIMASTER, PAMASTER, NSTK, COMP, 486 & IFLAG, IERROR, COMM, 487 & NBPROCFILS, IPOOL, LPOOL, LEAF, NBFIN, MYID, SLAVEF, 488 & 489 & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, FILS, 490 & PTRARW, PTRAIW, 491 & INTARR,DBLARR,ICNTL,KEEP,KEEP8,DKEEP,ND,FRERE,LPTRAR, 492 & NELT, FRTPTR, FRTELT, 493 & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. 494 & , LRGROUPS 495 & ) 496 IF ( IFLAG .LT. 0 ) THEN 497 IS_ERROR_BROADCASTED=.TRUE. 498 GOTO 600 499 ENDIF 500 END IF 501 END IF 502 ENDDO 503 ENDIF 504 END DO 505 IF (LOCAL_ASSEMBLY_TO_BE_DONE) THEN 506 CALL CMUMPS_LOCAL_ASSEMBLY_TYPE2(I_POSMYIDIN_PERE, 507 & SLAVES_PERE(I_POSMYIDIN_PERE), 508 & MYID, PDEST_MASTER, ISON, INODE_PERE, 509 & NSLAVES_PERE, NASS_PERE, NFRONT_PERE, NFS4FATHER, 510 & LMAP_LOC, MAP, NBROW, PERM, 511 & IS_ofType5or6, IFLAG, IERROR, 512 & N, SLAVEF, KEEP, NBPROCFILS, IPOOL, LPOOL, STEP, 513 & PROCNODE_STEPS, COMM_LOAD, ISTEP_TO_INIV2, TAB_POS_IN_PERE, 514 & 515 & KEEP8, IW, LIW, A, LA, LRLU, LRLUS, IPTRLU, IWPOSCB, 516 & PTRIST, PTLUST, PTRAST, PAMASTER, PIMASTER, ND, 517 & NELT, FRTPTR, FRTELT, 518 & OPASSW, OPELIW, 519 & ITLOC, RHS_MUMPS, KEEP253_LOC, 520 & FILS, LPTRAR, PTRARW, PTRAIW, INTARR, DBLARR, ICNTL) 521 LOCAL_ASSEMBLY_TO_BE_DONE = .FALSE. 522 IF (IFLAG < 0) THEN 523 GOTO 600 524 ENDIF 525 ENDIF 526 ITYPE = MUMPS_TYPENODE(PROCNODE_STEPS(STEP(ISON)), SLAVEF) 527 IF (KEEP(214) .EQ. 2) THEN 528 CALL CMUMPS_STACK_BAND( N, ISON, 529 & PTRIST, PTRAST, PTLUST, PTRFAC, IW, LIW, A, LA, 530 & LRLU, LRLUS, IWPOS, IWPOSCB, POSFAC, COMP, 531 & IPTRLU, OPELIW, STEP, PIMASTER, PAMASTER, 532 & IFLAG, IERROR, SLAVEF, MYID, COMM, KEEP,KEEP8, DKEEP,ITYPE 533 & ) 534 IF (IFLAG .LT. 0) THEN 535 IS_ERROR_BROADCASTED = .TRUE. 536 GOTO 600 537 ENDIF 538 ENDIF 539 CALL CMUMPS_FREE_BAND( N, ISON, PTRIST, PTRAST, IW, LIW, 540 & A, LA, LRLU, LRLUS, IWPOSCB, IPTRLU, 541 & STEP, MYID, KEEP, KEEP8, ITYPE 542 &) 543 600 CONTINUE 544 DEALLOCATE(PERM) 545 670 CONTINUE 546 DEALLOCATE(MAP) 547 680 CONTINUE 548 DEALLOCATE(NBROW) 549 DEALLOCATE(SLAVES_PERE) 550 700 CONTINUE 551 IF (IFLAG .LT. 0 .AND. .NOT. IS_ERROR_BROADCASTED) THEN 552 CALL CMUMPS_BDC_ERROR( MYID, SLAVEF, COMM, KEEP ) 553 ENDIF 554 RETURN 555 END SUBROUTINE CMUMPS_MAPLIG 556 SUBROUTINE CMUMPS_MAPLIG_FILS_NIV1( COMM_LOAD, ASS_IRECV, 557 & BUFR, LBUFR, LBUFR_BYTES, 558 & 559 & INODE_PERE, ISON, NSLAVES_PERE, LIST_SLAVES_PERE, 560 & NFRONT_PERE, NASS_PERE, NFS4FATHER, LMAP, TROW, 561 & PROCNODE_STEPS, SLAVEF, POSFAC, IWPOS, IWPOSCB, IPTRLU, LRLU, 562 & LRLUS, N, IW, 563 & LIW, A, LA, 564 & PTRIST, PTLUST, PTRFAC, 565 & PTRAST, STEP, PIMASTER, PAMASTER, NSTK, COMP, 566 & IFLAG, IERROR, MYID, COMM, NBPROCFILS, IPOOL, LPOOL, LEAF, 567 & NBFIN, ICNTL, KEEP,KEEP8,DKEEP, root, 568 & OPASSW, OPELIW, ITLOC, RHS_MUMPS, 569 & FILS, PTRARW, PTRAIW, INTARR, DBLARR, 570 & ND, FRERE, LPTRAR, NELT, FRTPTR, FRTELT, 571 & 572 & ISTEP_TO_INIV2, TAB_POS_IN_PERE 573 & , LRGROUPS 574 & ) 575 USE CMUMPS_BUF 576 USE CMUMPS_LOAD 577 IMPLICIT NONE 578 INCLUDE 'cmumps_root.h' 579 TYPE (CMUMPS_ROOT_STRUC) :: root 580 INTEGER COMM_LOAD, ASS_IRECV 581 INTEGER ICNTL( 40 ), KEEP(500) 582 INTEGER(8) KEEP8(150) 583 REAL DKEEP(230) 584 INTEGER LBUFR, LBUFR_BYTES 585 INTEGER SLAVEF, NBFIN 586 INTEGER(8) :: LA, IPTRLU, LRLU, LRLUS, POSFAC 587 INTEGER IWPOS, IWPOSCB 588 INTEGER N, LIW 589 COMPLEX A( LA ) 590 INTEGER, intent(in) :: LRGROUPS(N) 591 INTEGER COMP 592 INTEGER IFLAG, IERROR, COMM, MYID 593 INTEGER LPOOL, LEAF 594 INTEGER INODE_PERE, ISON 595 INTEGER NFS4FATHER 596 INTEGER NSLAVES_PERE, NFRONT_PERE, NASS_PERE 597 INTEGER LIST_SLAVES_PERE(NSLAVES_PERE) 598 INTEGER NELIM, LMAP, TROW( LMAP ) 599 DOUBLE PRECISION OPASSW, OPELIW 600 COMPLEX DBLARR(KEEP8(26)) 601 INTEGER INTARR(KEEP8(27)) 602 INTEGER LPTRAR, NELT 603 INTEGER IW( LIW ) 604 INTEGER BUFR( LBUFR ) 605 INTEGER IPOOL( LPOOL ) 606 INTEGER NSTK( KEEP(28) ), ND( KEEP(28) ), FRERE( KEEP(28) ) 607 INTEGER NBPROCFILS( KEEP(28) ) 608 INTEGER(8) :: PTRFAC(KEEP(28)) 609 INTEGER(8) :: PTRAST(KEEP(28)) 610 INTEGER(8) :: PAMASTER(KEEP(28)) 611 INTEGER PTRIST(KEEP(28)), PTLUST(KEEP(28)), 612 & STEP(N), PIMASTER(KEEP(28)) 613 INTEGER PROCNODE_STEPS( KEEP(28) ) 614 INTEGER FRTPTR( N+1 ), FRTELT( NELT ) 615 INTEGER ITLOC( N+KEEP(253) ), FILS( N ) 616 COMPLEX :: RHS_MUMPS(KEEP(255)) 617 INTEGER(8), INTENT(IN) :: PTRARW( LPTRAR ), PTRAIW( LPTRAR ) 618 INTEGER ISTEP_TO_INIV2(KEEP(71)), 619 & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) 620 INTEGER LP 621 INCLUDE 'mpif.h' 622 INCLUDE 'mumps_tags.h' 623 INTEGER :: IERR 624 INTEGER :: STATUS(MPI_STATUS_SIZE) 625 INTEGER NOSLA, I, ISTCHK, ISTCHK_LOC 626 INTEGER NBROWS_ALREADY_SENT 627 INTEGER INDICE_PERE 628 INTEGER INDICE_PERE_ARRAY_ARG(1) 629 INTEGER PDEST, PDEST_MASTER, NFRONT 630 LOGICAL SAME_PROC, DESCLU 631 INTEGER(8) :: APOS, POSROW, ASIZE 632 INTEGER NSLSON, NBCOLS, NROW, NROWS_TO_SEND, 633 & NPIV, NROWS_TO_STACK, II, IROW_SON, 634 & IPOS_IN_SLAVE, DECR 635 INTEGER NBCOLS_EFF 636 LOGICAL BLOCKING, SET_IRECV, MESSAGE_RECEIVED 637 LOGICAL COMPRESSCB 638 INCLUDE 'mumps_headers.h' 639 INTEGER MUMPS_PROCNODE 640 EXTERNAL MUMPS_PROCNODE 641 INTEGER LMAP_LOC, allocok 642 INTEGER, ALLOCATABLE, DIMENSION(:) :: NBROW 643 INTEGER, ALLOCATABLE, DIMENSION(:) :: SLAVES_PERE 644 INTEGER, ALLOCATABLE, DIMENSION(:) :: MAP, PERM 645 LP = ICNTL(1) 646 IF (ICNTL(4) .LE. 0) LP = -1 647 if (NSLAVES_PERE.le.0) then 648 write(6,*) ' error 2 in maplig_fils_niv1 ', NSLAVES_PERE 649 CALL MUMPS_ABORT() 650 endif 651 ALLOCATE(NBROW(0:NSLAVES_PERE), stat=allocok) 652 IF (allocok .GT. 0) THEN 653 IF (LP > 0) 654 & write(LP,*) MYID, 655 & ' : PB allocation NBROW in CMUMPS_MAPLIG_FILS_NIV1' 656 IFLAG =-13 657 IERROR = NSLAVES_PERE+1 658 GOTO 700 659 ENDIF 660 ALLOCATE(SLAVES_PERE(0:NSLAVES_PERE), stat =allocok) 661 IF ( allocok .GT. 0 ) THEN 662 IF (LP > 0) write(LP,*) MYID, 663 & ' : PB allocation SLAVES_PERE in CMUMPS_MAPLIG_FILS_NIV1' 664 IFLAG =-13 665 IERROR = NSLAVES_PERE+1 666 GOTO 700 667 ENDIF 668 SLAVES_PERE(1:NSLAVES_PERE) = LIST_SLAVES_PERE(1:NSLAVES_PERE) 669 SLAVES_PERE(0) = MUMPS_PROCNODE( 670 & PROCNODE_STEPS(STEP(INODE_PERE)), 671 & SLAVEF ) 672 LMAP_LOC = LMAP 673 ALLOCATE(MAP(LMAP_LOC), stat=allocok) 674 if (allocok .GT. 0) THEN 675 IF (LP > 0) write(LP,*) MYID, 676 & ' : PB allocation LMAP in CMUMPS_MAPLIG_FILS_NIV1' 677 IFLAG =-13 678 IERROR = LMAP_LOC 679 GOTO 700 680 endif 681 MAP( 1 : LMAP_LOC ) = TROW( 1 : LMAP_LOC ) 682 DO I = 0, NSLAVES_PERE 683 NBROW( I ) = 0 684 END DO 685 IF (NSLAVES_PERE == 0) THEN 686 NBROW(0) = LMAP_LOC 687 ELSE 688 DO I = 1, LMAP_LOC 689 INDICE_PERE = MAP( I ) 690 CALL MUMPS_BLOC2_GET_ISLAVE( 691 & KEEP,KEEP8, INODE_PERE, STEP, N, SLAVEF, 692 & ISTEP_TO_INIV2, TAB_POS_IN_PERE, 693 & 694 & NASS_PERE, 695 & NFRONT_PERE - NASS_PERE, 696 & NSLAVES_PERE, 697 & INDICE_PERE, 698 & NOSLA, 699 & IPOS_IN_SLAVE ) 700 NBROW( NOSLA ) = NBROW( NOSLA ) + 1 701 END DO 702 DO I = 1, NSLAVES_PERE 703 NBROW(I)=NBROW(I)+NBROW(I-1) 704 ENDDO 705 ENDIF 706 ALLOCATE(PERM(LMAP_LOC), stat=allocok) 707 if (allocok .GT. 0) THEN 708 IF (LP > 0) write(LP,*) MYID, 709 & ': PB allocation PERM in CMUMPS_MAPLIG_FILS_NIV1' 710 IFLAG =-13 711 IERROR = LMAP_LOC 712 GOTO 700 713 endif 714 ISTCHK = PIMASTER(STEP(ISON)) 715 NBCOLS = IW(ISTCHK+KEEP(IXSZ)) 716 DO I = LMAP_LOC, 1, -1 717 INDICE_PERE = MAP( I ) 718 CALL MUMPS_BLOC2_GET_ISLAVE( 719 & KEEP,KEEP8, INODE_PERE, STEP, N, SLAVEF, 720 & ISTEP_TO_INIV2, TAB_POS_IN_PERE, 721 & 722 & NASS_PERE, 723 & NFRONT_PERE - NASS_PERE, 724 & NSLAVES_PERE, 725 & INDICE_PERE, 726 & NOSLA, 727 & IPOS_IN_SLAVE ) 728 PERM( NBROW( NOSLA ) ) = I 729 NBROW( NOSLA ) = NBROW( NOSLA ) - 1 730 ENDDO 731 DO I = 0, NSLAVES_PERE 732 NBROW(I)=NBROW(I)+1 733 END DO 734 PDEST_MASTER = MYID 735 IF ( SLAVES_PERE(0) .NE. MYID ) THEN 736 WRITE(*,*) 'Error 1 in MAPLIG_FILS_NIV1:',MYID, SLAVES_PERE 737 CALL MUMPS_ABORT() 738 END IF 739 PDEST = PDEST_MASTER 740 I = 0 741 ISTCHK = PIMASTER(STEP(ISON)) 742 NBCOLS = IW(ISTCHK+KEEP(IXSZ)) 743 NELIM = IW(ISTCHK+1+KEEP(IXSZ)) 744 NROW = IW(ISTCHK+2+KEEP(IXSZ)) 745 NPIV = IW(ISTCHK+3+KEEP(IXSZ)) 746 IF (NPIV.LT.0) THEN 747 write(6,*) ' Error 2 in CMUMPS_MAPLIG_FILS_NIV1 ', NPIV 748 CALL MUMPS_ABORT() 749 ENDIF 750 NSLSON = IW(ISTCHK+5+KEEP(IXSZ)) 751 NFRONT = NPIV + NBCOLS 752 COMPRESSCB=(IW(PTRIST(STEP(ISON))+XXS) .eq. S_CB1COMP) 753 IF (I == NSLAVES_PERE) THEN 754 NROWS_TO_STACK=LMAP_LOC-NBROW(I)+1 755 ELSE 756 NROWS_TO_STACK=NBROW(I+1)-NBROW(I) 757 ENDIF 758 DECR=1 759 NBPROCFILS(STEP(INODE_PERE)) = 760 & NBPROCFILS(STEP(INODE_PERE)) - DECR 761 NBPROCFILS(STEP(ISON)) = NBPROCFILS(STEP(ISON)) - DECR 762#if ! defined(NO_XXNBPR) 763 IW(PTLUST(STEP(INODE_PERE))+XXNBPR) = 764 & IW(PTLUST(STEP(INODE_PERE))+XXNBPR) - DECR 765 CALL CHECK_EQUAL(NBPROCFILS(STEP(INODE_PERE)), 766 & IW(PTLUST(STEP(INODE_PERE))+XXNBPR)) 767 IW(PTRIST(STEP(ISON))+XXNBPR) = 768 & IW(PTRIST(STEP(ISON))+XXNBPR) - DECR 769 CALL CHECK_EQUAL(NBPROCFILS(STEP(ISON)), 770 & IW(PTRIST(STEP(ISON))+XXNBPR)) 771#endif 772 DO II = 1,NROWS_TO_STACK 773 IROW_SON=PERM(NBROW(I)+II-1) 774 INDICE_PERE = MAP(IROW_SON) 775 CALL MUMPS_BLOC2_GET_ISLAVE( 776 & KEEP,KEEP8, INODE_PERE, STEP, N, SLAVEF, 777 & ISTEP_TO_INIV2, TAB_POS_IN_PERE, 778 & 779 & NASS_PERE, 780 & NFRONT_PERE - NASS_PERE, 781 & NSLAVES_PERE, 782 & INDICE_PERE, 783 & NOSLA, 784 & IPOS_IN_SLAVE ) 785 INDICE_PERE = IPOS_IN_SLAVE 786 IF (COMPRESSCB) THEN 787 IF (NELIM.EQ.0) THEN 788 POSROW = PAMASTER(STEP(ISON)) + 789 & int(IROW_SON,8)*int(IROW_SON-1,8)/2_8 790 ELSE 791 POSROW = PAMASTER(STEP(ISON)) + 792 & int(NELIM+IROW_SON,8)*int(NELIM+IROW_SON-1,8)/2_8 793 ENDIF 794 ELSE 795 POSROW = PAMASTER(STEP(ISON)) + 796 & int(NELIM+IROW_SON-1,8)*int(NBCOLS,8) 797 ENDIF 798 IF (KEEP(50).NE.0) THEN 799 NBCOLS_EFF = NELIM + IROW_SON 800 ELSE 801 NBCOLS_EFF = NBCOLS 802 ENDIF 803 INDICE_PERE_ARRAY_ARG(1) = INDICE_PERE 804 CALL CMUMPS_ASM_SLAVE_MASTER(N, INODE_PERE, IW, LIW, 805 & A, LA, ISON, 1, NBCOLS_EFF, INDICE_PERE_ARRAY_ARG, 806 & A(POSROW), PTLUST, PTRAST, 807 & STEP, PIMASTER, OPASSW, IWPOSCB, 808 & MYID, KEEP,KEEP8,.FALSE.,NBCOLS_EFF) 809 ENDDO 810 IF (KEEP(219).NE.0) THEN 811 IF(NSLAVES_PERE.GT.0 .AND. KEEP(50).EQ.2) THEN 812 IF (COMPRESSCB) THEN 813 POSROW = PAMASTER(STEP(ISON)) 814 & + int(NELIM+NBROW(1),8)*int(NELIM+NBROW(1)-1,8)/2_8 815 ASIZE = int(LMAP_LOC+NELIM,8)*int(NELIM+LMAP_LOC+1,8)/2_8 816 & - int(NELIM+NBROW(1),8)*int(NELIM+NBROW(1)-1,8)/2_8 817 ELSE 818 POSROW = PAMASTER(STEP(ISON)) + 819 & int(NELIM+NBROW(1)-1,8)*int(NBCOLS,8) 820 ASIZE = int(LMAP_LOC-NBROW(1)+1,8) * int(NBCOLS,8) 821 ENDIF 822 CALL CMUMPS_BUF_MAX_ARRAY_MINSIZE(NFS4FATHER,IERR) 823 IF (IERR .NE.0) THEN 824 IF (LP > 0) WRITE(LP,*) MYID, 825 & ": PB allocation MAX_ARRAY during CMUMPS_MAPLIG_FILS_NIV1" 826 IFLAG=-13 827 IERROR=NFS4FATHER 828 GOTO 700 829 ENDIF 830 IF ( LMAP_LOC-NBROW(1)+1-KEEP(253).GT. 0 ) THEN 831 CALL CMUMPS_COMPUTE_MAXPERCOL( 832 & A(POSROW),ASIZE,NBCOLS, 833 & LMAP_LOC-NBROW(1)+1-KEEP(253), 834 & BUF_MAX_ARRAY,NFS4FATHER,COMPRESSCB, 835 & NELIM+NBROW(1)) 836 ELSE 837 CALL CMUMPS_SETMAXTOZERO(BUF_MAX_ARRAY, 838 & NFS4FATHER) 839 ENDIF 840 CALL CMUMPS_ASM_MAX(N, INODE_PERE, IW, LIW, 841 & A, LA, ISON, NFS4FATHER, 842 & BUF_MAX_ARRAY, PTLUST, PTRAST, 843 & STEP, PIMASTER, OPASSW, 844 & IWPOSCB,MYID, KEEP,KEEP8) 845 ENDIF 846 ENDIF 847#if ! defined(NO_XXNBPR) 848 CALL CHECK_EQUAL(NBPROCFILS(STEP(ISON)), 849 & IW(PTRIST(STEP(ISON))+XXNBPR)) 850 IF (IW(PTRIST(STEP(ISON))+XXNBPR) .EQ. 0 851#else 852 IF ( NBPROCFILS(STEP(ISON)) .EQ. 0 853#endif 854 & ) THEN 855 ISTCHK_LOC = PIMASTER(STEP(ISON)) 856 SAME_PROC= ISTCHK_LOC .LT. IWPOSCB 857 IF (SAME_PROC) THEN 858 CALL CMUMPS_RESTORE_INDICES(N, ISON, INODE_PERE, 859 & IWPOSCB, PIMASTER, PTLUST, IW, LIW, STEP, 860 & KEEP,KEEP8) 861 ENDIF 862 ENDIF 863#if ! defined(NO_XXNBPR) 864 CALL CHECK_EQUAL(NBPROCFILS(STEP(INODE_PERE)), 865 & IW(PTLUST(STEP(INODE_PERE))+XXNBPR)) 866 IF ( IW(PTLUST(STEP(INODE_PERE))+XXNBPR) .EQ. 0 867#else 868 IF ( NBPROCFILS(STEP(INODE_PERE)) .EQ. 0 869#endif 870 & ) THEN 871 CALL CMUMPS_INSERT_POOL_N( N, IPOOL, LPOOL, 872 & PROCNODE_STEPS, 873 & SLAVEF, KEEP(28), KEEP(76), KEEP(80), 874 & KEEP(47), STEP, INODE_PERE+N ) 875 IF (KEEP(47) .GE. 3) THEN 876 CALL CMUMPS_LOAD_POOL_UPD_NEW_POOL( 877 & IPOOL, LPOOL, 878 & PROCNODE_STEPS, KEEP,KEEP8, SLAVEF, COMM_LOAD, 879 & MYID, STEP, N, ND, FILS ) 880 ENDIF 881 END IF 882 DO I = 0, NSLAVES_PERE 883 PDEST = SLAVES_PERE( I ) 884 IF ( PDEST .NE. MYID ) THEN 885 NBROWS_ALREADY_SENT = 0 886 95 CONTINUE 887 NFRONT = IW(PIMASTER(STEP(ISON))+KEEP(IXSZ)) 888 NELIM = IW(PIMASTER(STEP(ISON))+1+KEEP(IXSZ)) 889 APOS = PAMASTER(STEP(ISON)) 890 DESCLU = .TRUE. 891 IF (I == NSLAVES_PERE) THEN 892 NROWS_TO_SEND=LMAP_LOC-NBROW(I)+1 893 ELSE 894 NROWS_TO_SEND=NBROW(I+1)-NBROW(I) 895 ENDIF 896 IF ( NROWS_TO_SEND .EQ. 0) CYCLE 897 CALL CMUMPS_BUF_SEND_CONTRIB_TYPE2(NBROWS_ALREADY_SENT, 898 & DESCLU, INODE_PERE, 899 & NFRONT_PERE, NASS_PERE, NFS4FATHER, 900 & NSLAVES_PERE, 901 & ISON, NROWS_TO_SEND, LMAP_LOC, 902 & MAP, PERM(min(LMAP_LOC,NBROW(I))), 903 & IW(PIMASTER(STEP(ISON))), 904 & A(APOS), I, PDEST, PDEST_MASTER, COMM, IERR, 905 & 906 & KEEP,KEEP8, STEP, N, SLAVEF, 907 & ISTEP_TO_INIV2, TAB_POS_IN_PERE, 908 & COMPRESSCB, KEEP(253)) 909 IF ( IERR .EQ. -2 ) THEN 910 IF (LP > 0) WRITE(LP,*) MYID, 911 &": FAILURE, SEND BUFFER TOO SMALL DURING CMUMPS_MAPLIG_FILS_NIV1" 912 IFLAG = -17 913 IERROR = (NROWS_TO_SEND + 3 )* KEEP( 34 ) + 914 & NROWS_TO_SEND * KEEP( 35 ) 915 GO TO 700 916 END IF 917 IF ( IERR .EQ. -3 ) THEN 918 IF (LP > 0) WRITE(LP,*) MYID, 919 &": FAILURE, RECV BUFFER TOO SMALL DURING CMUMPS_MAPLIG_FILS_NIV1" 920 IFLAG = -20 921 IERROR = (NROWS_TO_SEND + 3 )* KEEP( 34 ) + 922 & NROWS_TO_SEND * KEEP( 35 ) 923 GO TO 700 924 ENDIF 925 IF (KEEP(219).NE.0) THEN 926 IF ( IERR .EQ. -4 ) THEN 927 IFLAG = -13 928 IERROR = BUF_LMAX_ARRAY 929 IF (LP > 0) WRITE(LP,*) MYID, 930 &": FAILURE, MAX_ARRAY ALLOC FAILED DURING CMUMPS_MAPLIG_FILS_NIV1" 931 GO TO 700 932 ENDIF 933 ENDIF 934 IF ( IERR .EQ. -1 ) THEN 935 BLOCKING = .FALSE. 936 SET_IRECV = .TRUE. 937 MESSAGE_RECEIVED = .FALSE. 938 CALL CMUMPS_TRY_RECVTREAT( COMM_LOAD, 939 & ASS_IRECV, BLOCKING, SET_IRECV, MESSAGE_RECEIVED, 940 & MPI_ANY_SOURCE, MPI_ANY_TAG, 941 & STATUS, 942 & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, 943 & IWPOS, IWPOSCB, IPTRLU, 944 & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, 945 & PTLUST, PTRFAC, 946 & PTRAST, STEP, PIMASTER, PAMASTER, NSTK, COMP, 947 & IFLAG, IERROR, COMM, 948 & NBPROCFILS, IPOOL, LPOOL, LEAF, NBFIN, MYID, SLAVEF, 949 & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, 950 & FILS, PTRARW, PTRAIW, 951 & INTARR,DBLARR,ICNTL,KEEP,KEEP8,DKEEP,ND,FRERE, 952 & LPTRAR, NELT, FRTPTR, FRTELT, 953 & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. 954 & , LRGROUPS 955 & ) 956 IF ( IFLAG .LT. 0 ) GOTO 600 957 GO TO 95 958 END IF 959 END IF 960 END DO 961 ISTCHK = PTRIST(STEP(ISON)) 962 PTRIST(STEP( ISON )) = -77777777 963 IF ( IW(ISTCHK+KEEP(IXSZ)) .GE. 0 ) THEN 964 WRITE(*,*) 'error 3 in CMUMPS_MAPLIG_FILS_NIV1' 965 CALL MUMPS_ABORT() 966 ENDIF 967 CALL CMUMPS_FREE_BLOCK_CB(.FALSE., MYID, N, ISTCHK, 968 & PAMASTER(STEP(ISON)), 969 & IW, LIW, LRLU, LRLUS, IPTRLU, 970 & IWPOSCB, LA, KEEP,KEEP8, .FALSE. 971 & ) 972 600 CONTINUE 973 DEALLOCATE(NBROW) 974 DEALLOCATE(MAP) 975 DEALLOCATE(PERM) 976 DEALLOCATE(SLAVES_PERE) 977 RETURN 978 700 CONTINUE 979 CALL CMUMPS_BDC_ERROR(MYID, SLAVEF, COMM, KEEP ) 980 RETURN 981 END SUBROUTINE CMUMPS_MAPLIG_FILS_NIV1 982 SUBROUTINE CMUMPS_LOCAL_ASSEMBLY_TYPE2(I, PDEST, MYID, 983 & PDEST_MASTER, ISON, IFATH, NSLAVES_PERE, NASS_PERE, 984 & NFRONT_PERE, NFS4FATHER, LMAP_LOC, MAP, 985 & NBROW, PERM, IS_ofType5or6, IFLAG, IERROR, 986 & N, SLAVEF, KEEP, NBPROCFILS, 987 & IPOOL, LPOOL, STEP, 988 & PROCNODE_STEPS, COMM_LOAD, ISTEP_TO_INIV2, 989 & TAB_POS_IN_PERE, 990 & 991 & KEEP8, IW, LIW, A, LA, LRLU, LRLUS, IPTRLU, IWPOSCB, 992 & PTRIST, PTLUST, PTRAST, PAMASTER, PIMASTER, ND, 993 & NELT, FRTPTR, FRTELT, 994 & OPASSW, OPELIW, 995 & ITLOC, RHS_MUMPS, KEEP253_LOC, 996 & FILS, LPTRAR, PTRARW, PTRAIW, INTARR, DBLARR, ICNTL 997 & ) 998 USE CMUMPS_BUF, ONLY: CMUMPS_BUF_MAX_ARRAY_MINSIZE, 999 & BUF_MAX_ARRAY 1000 USE CMUMPS_LOAD, ONLY : CMUMPS_LOAD_POOL_UPD_NEW_POOL 1001 INTEGER ICNTL(40) 1002 INTEGER, intent(in) :: I, PDEST, MYID, PDEST_MASTER, IFATH, ISON 1003 INTEGER, intent(in) :: N, SLAVEF 1004 INTEGER, intent(in) :: NSLAVES_PERE, NASS_PERE, NFRONT_PERE 1005 INTEGER, intent(in) :: NFS4FATHER 1006 INTEGER, intent(in) :: KEEP(500), STEP(N) 1007 INTEGER, intent(inout) :: NBPROCFILS( KEEP(28) ) 1008 INTEGER, intent(in) :: LMAP_LOC 1009 INTEGER, intent(in) :: NBROW(0:NSLAVES_PERE) 1010 INTEGER, intent(in) :: MAP(LMAP_LOC), PERM(LMAP_LOC) 1011 INTEGER, intent(inout) :: IFLAG, IERROR 1012 INTEGER(8), intent(in) :: KEEP8(150) 1013 INTEGER, intent(in) :: LIW, NELT, LPTRAR 1014 INTEGER(8), intent(in) :: LA 1015 INTEGER(8), intent(inout) :: IPTRLU, LRLU, LRLUS 1016 INTEGER, intent(inout) :: IWPOSCB 1017 INTEGER, intent(inout) :: IW(LIW) 1018 COMPLEX, intent(inout) :: A( LA ) 1019 INTEGER(8) :: PTRAST(KEEP(28)), PAMASTER(KEEP(28)) 1020 INTEGER :: PTRIST(KEEP(28)), PIMASTER(KEEP(28)), ND(KEEP(28)) 1021 INTEGER :: PTLUST(KEEP(28)) 1022 INTEGER, intent(inout) :: ITLOC(N) 1023 INTEGER, intent(in) :: FRTPTR( N+1 ), FRTELT( NELT ) 1024 DOUBLE PRECISION, intent(inout) :: OPASSW, OPELIW 1025 COMPLEX :: RHS_MUMPS(KEEP(255)) 1026 INTEGER, intent(in) :: KEEP253_LOC 1027 INTEGER, intent(in) :: FILS(N) 1028 INTEGER(8), intent(in) :: PTRARW( LPTRAR ), PTRAIW( LPTRAR ) 1029 INTEGER, intent(in) :: PROCNODE_STEPS( KEEP(28) ), COMM_LOAD 1030 INTEGER ISTEP_TO_INIV2(KEEP(71)), 1031 & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) 1032 COMPLEX DBLARR(KEEP8(26)) 1033 INTEGER INTARR(KEEP8(27)) 1034 INTEGER LPOOL 1035 INTEGER IPOOL( LPOOL ) 1036 LOGICAL, intent(in) :: IS_ofType5or6 1037 INCLUDE 'mumps_headers.h' 1038 INCLUDE 'mpif.h' 1039 INTEGER :: ISTCHK, ISTCHK_LOC, NBCOLS, NROW, NPIV, NSLSON, 1040 & NFRONT, LDA_SON, NROWS_TO_STACK, II, INDICE_PERE, 1041 & NOSLA, COLLIST, IPOS_IN_SLAVE, IROW_SON, ITMP, 1042 & NBCOLS_EFF, DECR 1043 LOGICAL :: COMPRESSCB, SAME_PROC 1044 INTEGER(8) :: SIZFR, POSROW, SHIFTCB_SON 1045 INTEGER :: IERR, LP 1046 INTEGER INDICE_PERE_ARRAY_ARG(1) 1047#if ! defined(NO_XXNBPR) 1048 INTEGER :: INBPROCFILS_SON 1049#endif 1050 LP = ICNTL(1) 1051 IF (ICNTL(4) .LE. 0) LP = -1 1052 IF (I == NSLAVES_PERE) THEN 1053 NROWS_TO_STACK = LMAP_LOC - NBROW(I) + 1 1054 ELSE 1055 NROWS_TO_STACK = NBROW(I+1) - NBROW(I) 1056 ENDIF 1057 DECR = 1 1058 IF ( MYID .EQ. PDEST_MASTER ) THEN 1059 NBPROCFILS(STEP(IFATH)) = 1060 & NBPROCFILS(STEP(IFATH)) - DECR 1061#if ! defined(NO_XXNBPR) 1062 IW(PTLUST(STEP(IFATH))+XXNBPR) = 1063 & IW(PTLUST(STEP(IFATH))+XXNBPR) - DECR 1064#endif 1065 IF ( PDEST .EQ. PDEST_MASTER .AND. DECR .NE. 0) THEN 1066 NBPROCFILS(STEP(ISON)) = NBPROCFILS(STEP(ISON)) - DECR 1067#if ! defined(NO_XXNBPR) 1068 IW(PIMASTER(STEP(ISON))+XXNBPR) = 1069 & IW(PIMASTER(STEP(ISON))+XXNBPR) - DECR 1070#endif 1071 ENDIF 1072 ENDIF 1073 ISTCHK = PTRIST(STEP(ISON)) 1074 NBCOLS = IW(ISTCHK+KEEP(IXSZ)) 1075 NROW = IW(ISTCHK+2+KEEP(IXSZ)) 1076 NPIV = IW(ISTCHK+3+KEEP(IXSZ)) 1077 NSLSON = IW(ISTCHK+5+KEEP(IXSZ)) 1078 NFRONT = NPIV + NBCOLS 1079 COMPRESSCB = (IW(ISTCHK+XXS).EQ.S_CB1COMP) 1080 CALL MUMPS_GETI8(SIZFR, IW(ISTCHK+XXR)) 1081 IF (IW(ISTCHK+XXS).EQ.S_NOLCBCONTIG) THEN 1082 LDA_SON = NBCOLS 1083 SHIFTCB_SON = int(NPIV,8)*int(NROW,8) 1084 ELSE IF (IW(ISTCHK+XXS).EQ.S_NOLCLEANED) THEN 1085 LDA_SON = NBCOLS 1086 SHIFTCB_SON = 0_8 1087 ELSE 1088 LDA_SON = NFRONT 1089 SHIFTCB_SON = int(NPIV,8) 1090 ENDIF 1091 IF (PDEST .NE. PDEST_MASTER) THEN 1092 IF ( KEEP(55) .eq. 0 ) THEN 1093 CALL CMUMPS_ASM_SLAVE_TO_SLAVE_INIT 1094 & (N, IFATH, IW, LIW, 1095 & A, LA, NROWS_TO_STACK, NBCOLS, 1096 & OPASSW, OPELIW, STEP, PTRIST, PTRAST, 1097 & ITLOC, RHS_MUMPS, 1098 & FILS, PTRARW, PTRAIW, INTARR, DBLARR, ICNTL, 1099 & KEEP,KEEP8, MYID ) 1100 ELSE 1101 CALL CMUMPS_ELT_ASM_S_2_S_INIT(NELT, FRTPTR, FRTELT, 1102 & N, IFATH, IW, LIW, 1103 & A, LA, NROWS_TO_STACK, NBCOLS, 1104 & OPASSW, OPELIW, STEP, PTRIST, PTRAST, 1105 & ITLOC, RHS_MUMPS, 1106 & FILS, PTRARW, PTRAIW, INTARR, DBLARR, ICNTL, 1107 & KEEP, KEEP8, MYID ) 1108 ENDIF 1109 ENDIF 1110 DO II = 1,NROWS_TO_STACK 1111 IROW_SON = PERM(NBROW(I)+II-1) 1112 INDICE_PERE=MAP(IROW_SON) 1113 CALL MUMPS_BLOC2_GET_ISLAVE( 1114 & KEEP,KEEP8, IFATH, STEP, N, SLAVEF, 1115 & ISTEP_TO_INIV2, TAB_POS_IN_PERE, 1116 & 1117 & NASS_PERE, 1118 & NFRONT_PERE - NASS_PERE, 1119 & NSLAVES_PERE, 1120 & INDICE_PERE, 1121 & NOSLA, 1122 & IPOS_IN_SLAVE ) 1123 INDICE_PERE = IPOS_IN_SLAVE 1124 IF ( COMPRESSCB ) THEN 1125 IF (NBCOLS - NROW .EQ. 0 ) THEN 1126 ITMP = IROW_SON 1127 POSROW = PTRAST(STEP(ISON))+ 1128 & int(ITMP,8) * int(ITMP-1,8) / 2_8 1129 ELSE 1130 ITMP = IROW_SON + NBCOLS - NROW 1131 POSROW = PTRAST(STEP(ISON)) 1132 & + int(ITMP,8) * int(ITMP-1,8) / 2_8 1133 & - int(NBCOLS-NROW,8) * int(NBCOLS-NROW+1,8)/2_8 1134 ENDIF 1135 ELSE 1136 POSROW = PTRAST(STEP(ISON)) + SHIFTCB_SON 1137 & +int(IROW_SON-1,8)*int(LDA_SON,8) 1138 ENDIF 1139 IF (PDEST == PDEST_MASTER) THEN 1140 IF (KEEP(50).NE.0) THEN 1141 NBCOLS_EFF = IROW_SON + NBCOLS - NROW 1142 ELSE 1143 NBCOLS_EFF = NBCOLS 1144 ENDIF 1145 INDICE_PERE_ARRAY_ARG(1) = INDICE_PERE 1146 IF ((IS_ofType5or6).AND.(KEEP(50).EQ.0)) THEN 1147 CALL CMUMPS_ASM_SLAVE_MASTER(N, IFATH, IW, LIW, 1148 & A, LA, ISON, NROWS_TO_STACK, NBCOLS_EFF, 1149 & INDICE_PERE_ARRAY_ARG, 1150 & A(POSROW), PTLUST, PTRAST, 1151 & STEP, PIMASTER, OPASSW, 1152 & IWPOSCB, MYID, KEEP,KEEP8, 1153 & IS_ofType5or6, LDA_SON 1154 & ) 1155 EXIT 1156 ELSE IF ( (KEEP(50).NE.0) .AND. 1157 & (.NOT.COMPRESSCB).AND.(IS_ofType5or6) ) THEN 1158 CALL CMUMPS_ASM_SLAVE_MASTER(N, IFATH, IW, LIW, 1159 & A, LA, ISON, NROWS_TO_STACK, 1160 & NBCOLS_EFF, INDICE_PERE_ARRAY_ARG, 1161 & A(POSROW), PTLUST, PTRAST, 1162 & STEP, PIMASTER, OPASSW, 1163 & IWPOSCB, MYID, KEEP,KEEP8, 1164 & IS_ofType5or6, LDA_SON 1165 &) 1166 EXIT 1167 ELSE 1168 CALL CMUMPS_ASM_SLAVE_MASTER(N, IFATH, IW, LIW, 1169 & A, LA, ISON, 1, NBCOLS_EFF, INDICE_PERE_ARRAY_ARG, 1170 & A(POSROW), PTLUST, PTRAST, 1171 & STEP, PIMASTER, OPASSW, 1172 & IWPOSCB, MYID, KEEP,KEEP8, 1173 & IS_ofType5or6, LDA_SON 1174 &) 1175 ENDIF 1176 ELSE 1177 ISTCHK = PTRIST(STEP(ISON)) 1178 COLLIST = ISTCHK + 6 + KEEP(IXSZ) 1179 & + IW( ISTCHK + 5 +KEEP(IXSZ)) + NROW + NPIV 1180 IF (KEEP(50).NE.0) THEN 1181 NBCOLS_EFF = IROW_SON + NBCOLS - NROW 1182 ELSE 1183 NBCOLS_EFF = NBCOLS 1184 ENDIF 1185 INDICE_PERE_ARRAY_ARG(1) = INDICE_PERE 1186 IF ( (IS_ofType5or6) .AND. 1187 & ( 1188 & ( KEEP(50).EQ.0) 1189 & .OR. 1190 & ( (KEEP(50).NE.0).and. (.NOT.COMPRESSCB) ) 1191 & ) 1192 & ) THEN 1193 CALL CMUMPS_ASM_SLAVE_TO_SLAVE(N, IFATH, 1194 & IW, LIW, 1195 & A, LA, NROWS_TO_STACK, NBCOLS, 1196 & INDICE_PERE_ARRAY_ARG, 1197 & IW( COLLIST ), A(POSROW), 1198 & OPASSW, OPELIW, STEP, PTRIST, PTRAST, 1199 & ITLOC, RHS_MUMPS, 1200 & FILS, ICNTL, KEEP,KEEP8, 1201 & MYID, IS_ofType5or6, LDA_SON) 1202 NBPROCFILS(STEP(IFATH)) = 1203 & NBPROCFILS(STEP(IFATH)) - 1204 & NROWS_TO_STACK 1205#if ! defined(NO_XXNBPR) 1206 IW( PTRIST(STEP(IFATH))+XXNBPR) = 1207 & IW( PTRIST(STEP(IFATH))+XXNBPR) - NROWS_TO_STACK 1208#endif 1209 EXIT 1210 ELSE 1211 CALL CMUMPS_ASM_SLAVE_TO_SLAVE(N, IFATH, 1212 & IW, LIW, 1213 & A, LA, 1, NBCOLS_EFF, INDICE_PERE_ARRAY_ARG, 1214 & IW( COLLIST ), A(POSROW), 1215 & OPASSW, OPELIW, STEP, PTRIST, PTRAST, 1216 & ITLOC, RHS_MUMPS, 1217 & FILS, ICNTL, KEEP,KEEP8, 1218 & MYID, IS_ofType5or6, LDA_SON) 1219 NBPROCFILS(STEP(IFATH)) = 1220 & NBPROCFILS(STEP(IFATH)) - 1 1221#if ! defined(NO_XXNBPR) 1222 IW( PTRIST(STEP(IFATH))+XXNBPR) = 1223 & IW( PTRIST(STEP(IFATH))+XXNBPR) - 1 1224#endif 1225 ENDIF 1226 ENDIF 1227 ENDDO 1228 IF (PDEST.EQ.PDEST_MASTER) THEN 1229 IF (KEEP(219).NE.0) THEN 1230 IF(NSLAVES_PERE.GT.0 .AND. KEEP(50).EQ.2) THEN 1231 IF (COMPRESSCB) THEN 1232 WRITE(*,*) "Error 1 in PARPIV/CMUMPS_MAPLIG" 1233 CALL MUMPS_ABORT() 1234 ELSE 1235 POSROW = PTRAST(STEP(ISON))+SHIFTCB_SON+ 1236 & int(NBROW(1)-1,8)*int(LDA_SON,8) 1237 ENDIF 1238 CALL CMUMPS_BUF_MAX_ARRAY_MINSIZE(NFS4FATHER,IERR) 1239 IF (IERR .NE.0) THEN 1240 IF (LP .GT. 0) THEN 1241 WRITE(LP, *) "MAX_ARRAY allocation failed" 1242 ENDIF 1243 IFLAG=-13 1244 IERROR=NFS4FATHER 1245 RETURN 1246 ENDIF 1247 ITMP=-9999 1248 IF ( LMAP_LOC-NBROW(1)+1-KEEP253_LOC .NE. 0 ) THEN 1249 CALL CMUMPS_COMPUTE_MAXPERCOL( 1250 & A(POSROW), 1251 & SIZFR-SHIFTCB_SON-int(NBROW(1)-1,8)*int(LDA_SON,8), 1252 & LDA_SON, LMAP_LOC-NBROW(1)+1-KEEP253_LOC, 1253 & BUF_MAX_ARRAY,NFS4FATHER,COMPRESSCB,ITMP) 1254 ELSE 1255 CALL CMUMPS_SETMAXTOZERO( 1256 & BUF_MAX_ARRAY, NFS4FATHER) 1257 ENDIF 1258 CALL CMUMPS_ASM_MAX(N, IFATH, IW, LIW, 1259 & A, LA, ISON, NFS4FATHER, 1260 & BUF_MAX_ARRAY, PTLUST, PTRAST, 1261 & STEP, PIMASTER, 1262 & OPASSW,IWPOSCB,MYID, KEEP,KEEP8) 1263 ENDIF 1264 ENDIF 1265 ISTCHK_LOC = PIMASTER(STEP(ISON)) 1266 SAME_PROC= ISTCHK_LOC .LT. IWPOSCB 1267#if ! defined(NO_XXNBPR) 1268 IF ( SAME_PROC ) THEN 1269 INBPROCFILS_SON = PTRIST(STEP(ISON))+XXNBPR 1270 WRITE(*,*) 1271 & "Internal error 0 in CMUMPS_LOCAL_ASSEMBLY_TYPE2", 1272 & INBPROCFILS_SON, PIMASTER(STEP(ISON)) 1273 CALL MUMPS_ABORT() 1274 ELSE 1275 INBPROCFILS_SON = PIMASTER(STEP(ISON))+XXNBPR 1276 ENDIF 1277#endif 1278#if ! defined(NO_XXNBPR) 1279 CALL CHECK_EQUAL( NBPROCFILS(STEP(ISON)), 1280 & IW(INBPROCFILS_SON) ) 1281 IF ( IW(INBPROCFILS_SON) .EQ. 0 ) THEN 1282#else 1283 IF ( NBPROCFILS(STEP(ISON)) .EQ. 0 ) THEN 1284#endif 1285 IF (SAME_PROC) THEN 1286 CALL CMUMPS_RESTORE_INDICES(N, ISON, IFATH, 1287 & IWPOSCB, PIMASTER, PTLUST, IW, LIW, STEP, 1288 & KEEP,KEEP8) 1289 ENDIF 1290 IF (SAME_PROC) THEN 1291 ISTCHK_LOC = PTRIST(STEP(ISON)) 1292 PTRIST(STEP( ISON) ) = -99999999 1293 ELSE 1294 PIMASTER(STEP( ISON )) = -99999999 1295 ENDIF 1296 CALL CMUMPS_FREE_BLOCK_CB(.FALSE., MYID, N, 1297 & ISTCHK_LOC, 1298 & PAMASTER(STEP(ISON)), 1299 & IW, LIW, LRLU, LRLUS, IPTRLU, IWPOSCB, 1300 & LA, KEEP,KEEP8, .FALSE. 1301 & ) 1302 ENDIF 1303#if ! defined(NO_XXNBPR) 1304 CALL CHECK_EQUAL( NBPROCFILS(STEP(IFATH)), 1305 & IW(PTLUST(STEP(IFATH))+XXNBPR) ) 1306 IF ( IW(PTLUST(STEP(IFATH))+XXNBPR) .EQ. 0 1307#else 1308 IF ( NBPROCFILS(STEP(IFATH)) .EQ. 0 1309#endif 1310 & ) THEN 1311 CALL CMUMPS_INSERT_POOL_N( N, IPOOL, LPOOL, 1312 & PROCNODE_STEPS, 1313 & SLAVEF, KEEP(28), KEEP(76), KEEP(80), 1314 & KEEP(47), STEP, IFATH+N ) 1315 IF (KEEP(47) .GE. 3) THEN 1316 CALL CMUMPS_LOAD_POOL_UPD_NEW_POOL( 1317 & IPOOL, LPOOL, 1318 & PROCNODE_STEPS, KEEP,KEEP8, SLAVEF, COMM_LOAD, 1319 & MYID, STEP, N, ND, FILS ) 1320 ENDIF 1321 END IF 1322 ELSE 1323 CALL CMUMPS_ASM_SLAVE_TO_SLAVE_END 1324 & (N, IFATH, IW, LIW, 1325 & NBROW(I), STEP, PTRIST, ITLOC, RHS_MUMPS, 1326 & KEEP,KEEP8) 1327 END IF 1328 RETURN 1329 END SUBROUTINE CMUMPS_LOCAL_ASSEMBLY_TYPE2 1330