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 ZMUMPS_BACKSLV_RECV_AND_TREAT( 14 & BLOQ, FLAG, 15 & BUFR, LBUFR, LBUFR_BYTES, 16 & MYID, SLAVEF, COMM, 17 & N, IWCB, LIWW, POSIWCB, 18 & W, LWC, POSWCB, 19 & IIPOOL, NBFINF, PTRICB, PTRACB, INFO, 20 & IPOOL, LPOOL, PANEL_POS, LPANEL_POS, 21 & STEP, FRERE, FILS, PROCNODE_STEPS, 22 & PLEFTW, KEEP, KEEP8, DKEEP, 23 & PTRIST, PTRFAC, IW, LIW, A, LA, W2, MYLEAFE, 24 & NRHS, MTYPE, 25 & RHSCOMP, LRHSCOMP, POSINRHSCOMP_BWD 26 & , TO_PROCESS, SIZE_TO_PROCESS 27 & , FROM_PP ) 28 IMPLICIT NONE 29 LOGICAL BLOQ, FLAG 30 INTEGER LBUFR, LBUFR_BYTES 31 INTEGER BUFR( LBUFR ) 32 INTEGER MYID, SLAVEF, COMM 33 INTEGER N, LIWW 34 INTEGER IWCB( LIWW ) 35 INTEGER(8), intent(in) :: LWC 36 COMPLEX(kind=8) W( LWC ) 37 INTEGER POSIWCB 38 INTEGER IIPOOL, LPOOL 39 INTEGER IPOOL( LPOOL ) 40 INTEGER LPANEL_POS 41 INTEGER PANEL_POS( LPANEL_POS ) 42 INTEGER NBFINF, INFO(40), KEEP(500) 43 INTEGER(8) :: POSWCB, PLEFTW 44 INTEGER(8) KEEP8(150) 45 DOUBLE PRECISION, INTENT(INOUT) :: DKEEP(230) 46 INTEGER PROCNODE_STEPS( KEEP(28) ), FRERE( KEEP(28) ) 47 INTEGER PTRICB(KEEP(28)), STEP( N ), FILS( N ) 48 INTEGER(8) :: PTRACB(KEEP(28)) 49 INTEGER LIW 50 INTEGER(8) :: LA 51 INTEGER PTRIST(KEEP(28)), IW( LIW ) 52 INTEGER (8) :: PTRFAC(KEEP(28)) 53 COMPLEX(kind=8) A( LA ), W2( KEEP(133) ) 54 INTEGER NRHS 55 INTEGER MYLEAFE, MTYPE 56 INTEGER LRHSCOMP, POSINRHSCOMP_BWD(N) 57#if defined(RHSCOMP_BYROWS) 58 COMPLEX(kind=8) RHSCOMP(NRHS,LRHSCOMP) 59#else 60 COMPLEX(kind=8) RHSCOMP(LRHSCOMP,NRHS) 61#endif 62 INTEGER SIZE_TO_PROCESS 63 LOGICAL TO_PROCESS(SIZE_TO_PROCESS) 64 LOGICAL, intent(in) :: FROM_PP 65 INCLUDE 'mpif.h' 66 INCLUDE 'mumps_tags.h' 67 INTEGER MSGSOU, MSGTAG, MSGLEN 68 INTEGER :: STATUS(MPI_STATUS_SIZE) 69 INTEGER :: IERR 70 DOUBLE PRECISION :: TIME_TMP 71 FLAG = .FALSE. 72 IF ( BLOQ ) THEN 73 CALL MPI_PROBE( MPI_ANY_SOURCE, MPI_ANY_TAG, 74 & COMM, STATUS, IERR ) 75 FLAG = .TRUE. 76 ELSE 77 CALL MPI_IPROBE( MPI_ANY_SOURCE, MPI_ANY_TAG, COMM, 78 & FLAG, STATUS, IERR ) 79 END IF 80 IF (FLAG) THEN 81 KEEP(266)=KEEP(266)-1 82 MSGSOU=STATUS(MPI_SOURCE) 83 MSGTAG=STATUS(MPI_TAG) 84 CALL MPI_GET_COUNT( STATUS, MPI_PACKED, MSGLEN, IERR ) 85 IF ( MSGLEN .GT. LBUFR_BYTES ) THEN 86 INFO(1) = -20 87 INFO(2) = MSGLEN 88 CALL ZMUMPS_BDC_ERROR( MYID, SLAVEF, COMM, KEEP ) 89 ELSE 90 CALL MPI_RECV(BUFR, LBUFR_BYTES, MPI_PACKED, MSGSOU, 91 & MSGTAG, COMM, STATUS, IERR) 92 CALL ZMUMPS_BACKSLV_TRAITER_MESSAGE( MSGTAG, MSGSOU, 93 & BUFR, LBUFR, LBUFR_BYTES, 94 & MYID, SLAVEF, COMM, 95 & N, IWCB, LIWW, POSIWCB, 96 & W, LWC, POSWCB, 97 & IIPOOL, NBFINF, PTRICB, PTRACB, INFO, 98 & IPOOL, LPOOL, PANEL_POS, LPANEL_POS, STEP, 99 & FRERE, FILS, PROCNODE_STEPS, PLEFTW, 100 & KEEP, KEEP8, DKEEP, 101 & PTRIST, PTRFAC, IW, LIW, A, LA, W2, MYLEAFE, 102 & NRHS, MTYPE, 103 & RHSCOMP, LRHSCOMP, POSINRHSCOMP_BWD 104 & , TO_PROCESS, SIZE_TO_PROCESS 105 & , FROM_PP 106 & ) 107 END IF 108 END IF 109 RETURN 110 END SUBROUTINE ZMUMPS_BACKSLV_RECV_AND_TREAT 111 RECURSIVE SUBROUTINE ZMUMPS_BACKSLV_TRAITER_MESSAGE( 112 & MSGTAG, MSGSOU, 113 & BUFR, LBUFR, LBUFR_BYTES, 114 & MYID, SLAVEF, COMM, 115 & N, IWCB, LIWW, POSIWCB, 116 & W, LWC, POSWCB, 117 & IIPOOL, NBFINF, PTRICB, PTRACB, INFO, 118 & IPOOL, LPOOL, PANEL_POS, LPANEL_POS, STEP, 119 & FRERE, FILS, PROCNODE_STEPS, PLEFTW, 120 & KEEP, KEEP8, DKEEP, 121 & PTRIST, PTRFAC, IW, LIW, A, LA, W2, MYLEAFE, 122 & NRHS, MTYPE, 123 & RHSCOMP, LRHSCOMP, POSINRHSCOMP_BWD 124 & , TO_PROCESS, SIZE_TO_PROCESS 125 & , FROM_PP 126 & ) 127 USE ZMUMPS_OOC 128 USE ZMUMPS_BUF 129 IMPLICIT NONE 130 INTEGER MSGTAG, MSGSOU 131 INTEGER LBUFR, LBUFR_BYTES 132 INTEGER BUFR( LBUFR ) 133 INTEGER MYID, SLAVEF, COMM 134 INTEGER N, LIWW 135 INTEGER IWCB( LIWW ) 136 INTEGER(8), intent(in) :: LWC 137 COMPLEX(kind=8) W( LWC ) 138 INTEGER POSIWCB 139 INTEGER IIPOOL, LPOOL, LPANEL_POS 140 INTEGER IPOOL( LPOOL ) 141 INTEGER PANEL_POS( LPANEL_POS ) 142 INTEGER NBFINF, INFO(40), KEEP(500) 143 INTEGER(8) :: POSWCB, PLEFTW 144 INTEGER(8) KEEP8(150) 145 DOUBLE PRECISION, INTENT(INOUT) :: DKEEP(230) 146 INTEGER PTRICB(KEEP(28)), STEP( N ), FILS( N ) 147 INTEGER(8) :: PTRACB(KEEP(28)) 148 INTEGER FRERE(KEEP(28)) 149 INTEGER PROCNODE_STEPS(KEEP(28)) 150 INTEGER LIW 151 INTEGER(8) :: LA 152 INTEGER IW( LIW ), PTRIST( KEEP(28) ) 153 INTEGER(8) :: PTRFAC(KEEP(28)) 154 COMPLEX(kind=8) A( LA ), W2( KEEP(133) ) 155 INTEGER NRHS 156 INTEGER MYLEAFE, MTYPE 157 INTEGER LRHSCOMP, POSINRHSCOMP_BWD(N) 158#if defined(RHSCOMP_BYROWS) 159 COMPLEX(kind=8) RHSCOMP(NRHS,LRHSCOMP) 160#else 161 COMPLEX(kind=8) RHSCOMP(LRHSCOMP,NRHS) 162#endif 163 INTEGER TMP_NBPANELS, I_PIVRPTR, I_PIVR 164 LOGICAL MUST_BE_PERMUTED 165 INTEGER SIZE_TO_PROCESS 166 LOGICAL TO_PROCESS(SIZE_TO_PROCESS), NO_CHILDREN 167 LOGICAL, intent(in) :: FROM_PP 168 INCLUDE 'mpif.h' 169 INCLUDE 'mumps_tags.h' 170 INTEGER POSITION, IF, INODE, IERR, LONG, DUMMY(1) 171 INTEGER(8) :: P_UPDATE, P_SOL_MAS 172 INTEGER :: LIELL, K 173 INTEGER(8) :: APOS, IST 174 INTEGER NPIV, NROW_L, IPOS, NROW_RECU 175 INTEGER(8) :: IFR8 176 INTEGER I, JJ, IN, PROCDEST, J1, J2, LDA 177 INTEGER NSLAVES, NELIM, J, POSINDICES, INODEPOS, 178 & IPOSINRHSCOMP, IPOSINRHSCOMP_TMP, IPOSINRHSCOMP_PANEL 179 DOUBLE PRECISION :: TIME_TMP 180 INTEGER JBDEB, JBFIN, NRHS_B, allocok 181 LOGICAL FLAG 182 COMPLEX(kind=8) ZERO, ALPHA, ONE 183 PARAMETER (ZERO=(0.0D0,0.0D0), 184 & ONE=(1.0D0,0.0D0), 185 & ALPHA=(-1.0D0,0.0D0)) 186 INCLUDE 'mumps_headers.h' 187 INTEGER POOL_FIRST_POS, TMP 188 LOGICAL,DIMENSION(:),ALLOCATABLE :: DEJA_SEND 189 INTEGER MUMPS_PROCNODE 190 EXTERNAL MUMPS_PROCNODE, ztrsv, ztrsm, zgemv, zgemm 191 INTEGER :: NCB 192 INTEGER(8) :: APOSDEB, NBENTRIES_ALLPANELS 193 INTEGER(8) :: PTWCB, PTWCB_PANEL 194 INTEGER LDAJ, NBJ, LIWFAC, 195 & NBJLAST, NPIV_LAST, PANEL_SIZE, 196 & NCB_PANEL, TYPEF 197 LOGICAL TWOBYTWO 198 INTEGER BEG_PANEL 199 INTEGER IPANEL, NPANELS 200 ALLOCATE(DEJA_SEND( 0:SLAVEF-1 ), stat=allocok) 201 if(allocok.ne.0) then 202 INFO(1)=-13 203 INFO(2)=SLAVEF 204 WRITE(6,*) MYID,' Allocation error of DEJA_SEND ' 205 & //'in bwd solve COMPSO' 206 GOTO 260 207 END IF 208 DUMMY(1)=0 209 IF (MSGTAG .EQ. FEUILLE) THEN 210 NBFINF = NBFINF - 1 211 ELSE IF (MSGTAG .EQ. NOEUD) THEN 212 POSITION = 0 213 CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION, 214 & INODE, 1, MPI_INTEGER, 215 & COMM, IERR) 216 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, 217 & JBDEB, 1, MPI_INTEGER, COMM, IERR ) 218 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, 219 & JBFIN, 1, MPI_INTEGER, COMM, IERR ) 220 CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION, 221 & LONG, 1, MPI_INTEGER, 222 & COMM, IERR) 223 NRHS_B = JBFIN-JBDEB+1 224 IF ( POSIWCB - LONG .LT. 0 225 & .OR. POSWCB - PLEFTW + 1_8 .LT. LONG ) THEN 226 CALL ZMUMPS_COMPSO(N, KEEP(28), IWCB, 227 & LIWW, W, LWC, 228 & POSWCB, POSIWCB, PTRICB, PTRACB) 229 IF (POSIWCB - LONG .LT. 0) THEN 230 INFO(1)=-14 231 INFO(2)=-POSIWCB + LONG 232 WRITE(6,*) MYID,' Internal error in bwd solve COMPSO' 233 GOTO 260 234 END IF 235 IF ( POSWCB - PLEFTW + 1_8 .LT. LONG ) THEN 236 INFO(1) = -11 237 CALL MUMPS_SET_IERROR(LONG + PLEFTW - POSWCB - 1_8, 238 & INFO(2)) 239 WRITE(6,*) MYID,' Internal error in bwd solve COMPSO' 240 GOTO 260 241 END IF 242 ENDIF 243 POSIWCB = POSIWCB - LONG 244 POSWCB = POSWCB - LONG 245 IF (LONG .GT. 0) THEN 246 CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION, 247 & IWCB(POSIWCB + 1), 248 & LONG, MPI_INTEGER, COMM, IERR) 249 DO K=JBDEB,JBFIN 250 CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION, 251 & W(POSWCB + 1), LONG, 252 & MPI_DOUBLE_COMPLEX, COMM, IERR) 253 DO JJ=0, LONG-1 254 IPOSINRHSCOMP = abs(POSINRHSCOMP_BWD(IWCB(POSIWCB+1+JJ))) 255 IF ( (IPOSINRHSCOMP.EQ.0) .OR. 256 & ( IPOSINRHSCOMP.GT.N ) ) CYCLE 257#if defined(RHSCOMP_BYROWS) 258 RHSCOMP(K,IPOSINRHSCOMP) = W(POSWCB+1+JJ) 259#else 260 RHSCOMP(IPOSINRHSCOMP,K) = W(POSWCB+1+JJ) 261#endif 262 ENDDO 263 ENDDO 264 POSIWCB = POSIWCB + LONG 265 POSWCB = POSWCB + LONG 266 ENDIF 267 POOL_FIRST_POS = IIPOOL 268 IF ( KEEP(237).GT. 0 ) THEN 269 IF (.NOT.TO_PROCESS(STEP(INODE))) 270 & GOTO 1010 271 ENDIF 272 IPOOL( IIPOOL ) = INODE 273 IIPOOL = IIPOOL + 1 274 1010 CONTINUE 275 IF = FRERE( STEP(INODE) ) 276 DO WHILE ( IF .GT. 0 ) 277 IF ( MUMPS_PROCNODE(PROCNODE_STEPS(STEP(IF)), 278 & SLAVEF) .eq. MYID ) THEN 279 IF ( KEEP(237).GT. 0 ) THEN 280 IF (.NOT.TO_PROCESS(STEP(IF))) THEN 281 IF = FRERE(STEP(IF)) 282 CYCLE 283 ENDIF 284 ENDIF 285 IPOOL( IIPOOL ) = IF 286 IIPOOL = IIPOOL + 1 287 END IF 288 IF = FRERE( STEP( IF ) ) 289 END DO 290 DO I=1,(IIPOOL-POOL_FIRST_POS)/2 291 TMP=IPOOL(POOL_FIRST_POS+I-1) 292 IPOOL(POOL_FIRST_POS+I-1)=IPOOL(IIPOOL-I) 293 IPOOL(IIPOOL-I)=TMP 294 ENDDO 295 ELSE IF ( MSGTAG .EQ. BACKSLV_MASTER2SLAVE ) THEN 296 POSITION = 0 297 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, 298 & INODE, 1, MPI_INTEGER, COMM, IERR ) 299 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, 300 & NROW_RECU, 1, MPI_INTEGER, COMM, IERR ) 301 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, 302 & JBDEB, 1, MPI_INTEGER, COMM, IERR ) 303 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, 304 & JBFIN, 1, MPI_INTEGER, COMM, IERR ) 305 NRHS_B = JBFIN-JBDEB+1 306 IPOS = PTRIST( STEP(INODE) ) + KEEP(IXSZ) 307 NPIV = - IW( IPOS ) 308 NROW_L = IW( IPOS + 1 ) 309 IF (KEEP(201).GT.0) THEN 310 CALL ZMUMPS_SOLVE_GET_OOC_NODE( 311 & INODE,PTRFAC,KEEP,A,LA,STEP, 312 & KEEP8,N,MUST_BE_PERMUTED,IERR) 313 IF(IERR.LT.0)THEN 314 INFO(1)=IERR 315 INFO(2)=0 316 GOTO 260 317 ENDIF 318 ENDIF 319 APOS = PTRFAC(IW( IPOS + 3 )) 320 IF ( NROW_L .NE. NROW_RECU ) THEN 321 WRITE(*,*) 'Error1 in 41S : NROW L/RECU=',NROW_L, NROW_RECU 322 CALL MUMPS_ABORT() 323 END IF 324 LONG = NROW_L + NPIV 325 IF ( POSWCB - LONG*NRHS_B .LT. PLEFTW - 1_8 ) THEN 326 CALL ZMUMPS_COMPSO( N, KEEP(28), IWCB, 327 & LIWW, W, LWC, 328 & POSWCB, POSIWCB, PTRICB, PTRACB) 329 IF ( POSWCB - LONG*NRHS_B .LT. PLEFTW - 1_8 ) THEN 330 INFO(1) = -11 331 CALL MUMPS_SET_IERROR(LONG * NRHS_B- POSWCB,INFO(2)) 332 WRITE(6,*) MYID,' Internal error in bwd solve COMPSO' 333 GOTO 260 334 END IF 335 END IF 336 P_UPDATE = PLEFTW 337 P_SOL_MAS = PLEFTW + NPIV * NRHS_B 338 PLEFTW = P_SOL_MAS + NROW_L * NRHS_B 339 DO K=JBDEB, JBFIN 340 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, 341 & W( P_SOL_MAS+(K-JBDEB)*NROW_L),NROW_L, 342 & MPI_DOUBLE_COMPLEX, 343 & COMM, IERR ) 344 ENDDO 345 IF (KEEP(201).EQ.1) THEN 346#if defined(MUMPS_USE_BLAS2) 347 IF ( NRHS_B == 1 ) THEN 348 CALL zgemv( 'T', NROW_L, NPIV, ALPHA, A( APOS ), NROW_L, 349 & W( P_SOL_MAS ), 1, ZERO, 350 & W( P_UPDATE ), 1 ) 351 ELSE 352#endif 353 CALL zgemm( 'T', 'N', NPIV, NRHS_B, NROW_L, ALPHA, A(APOS), 354 & NROW_L, W( P_SOL_MAS ), NROW_L, ZERO, W( P_UPDATE ), 355 & NPIV ) 356#if defined(MUMPS_USE_BLAS2) 357 ENDIF 358#endif 359 ELSE 360#if defined(MUMPS_USE_BLAS2) 361 IF ( NRHS_B == 1 ) THEN 362 CALL zgemv( 'N', NPIV, NROW_L, ALPHA, A( APOS ), NPIV, 363 & W( P_SOL_MAS ), 1, ZERO, 364 & W( P_UPDATE ), 1 ) 365 ELSE 366#endif 367 CALL zgemm( 'N', 'N', NPIV, NRHS_B, NROW_L, ALPHA, A(APOS), 368 & NPIV, W( P_SOL_MAS ), NROW_L, ZERO, W( P_UPDATE ), 369 & NPIV ) 370#if defined(MUMPS_USE_BLAS2) 371 END IF 372#endif 373 ENDIF 374 IF (KEEP(201).GT.0) THEN 375 CALL ZMUMPS_FREE_FACTORS_FOR_SOLVE(INODE,PTRFAC,KEEP(28), 376 & A,LA,.TRUE.,IERR) 377 IF(IERR.LT.0)THEN 378 INFO(1)=IERR 379 INFO(2)=0 380 GOTO 260 381 ENDIF 382 ENDIF 383 PLEFTW = PLEFTW - NROW_L * NRHS_B 384 100 CONTINUE 385 CALL ZMUMPS_BUF_SEND_BACKVEC( NRHS_B, INODE, 386 & W(P_UPDATE), 387 & NPIV, NPIV, 388 & MSGSOU, 389 & BACKSLV_UPDATERHS, 390 & JBDEB, JBFIN, 391 & KEEP, COMM, IERR ) 392 IF ( IERR .EQ. -1 ) THEN 393 CALL ZMUMPS_BACKSLV_RECV_AND_TREAT( 394 & .FALSE., FLAG, 395 & BUFR, LBUFR, LBUFR_BYTES, 396 & MYID, SLAVEF, COMM, 397 & N, IWCB, LIWW, POSIWCB, 398 & W, LWC, POSWCB, 399 & IIPOOL, NBFINF, PTRICB, PTRACB, INFO, 400 & IPOOL, LPOOL, PANEL_POS, LPANEL_POS, STEP, 401 & FRERE, FILS, PROCNODE_STEPS, PLEFTW, 402 & KEEP, KEEP8, DKEEP, 403 & PTRIST, PTRFAC, IW, LIW, A, LA, W2, MYLEAFE, 404 & NRHS, MTYPE, 405 & RHSCOMP, LRHSCOMP, POSINRHSCOMP_BWD 406 & , TO_PROCESS, SIZE_TO_PROCESS 407 & , FROM_PP ) 408 IF ( INFO( 1 ) .LT. 0 ) GOTO 270 409 GOTO 100 410 ELSE IF ( IERR .EQ. -2 ) THEN 411 INFO( 1 ) = -17 412 INFO( 2 ) = NRHS_B * NPIV * KEEP(35) + 4 * KEEP(34) 413 GOTO 260 414 ELSE IF ( IERR .EQ. -3 ) THEN 415 INFO( 1 ) = -20 416 INFO( 2 ) = NRHS_B * NPIV * KEEP(35) + 4 * KEEP(34) 417 GOTO 260 418 END IF 419 PLEFTW = PLEFTW - NPIV * NRHS_B 420 ELSE IF ( MSGTAG .EQ. BACKSLV_UPDATERHS ) THEN 421 POSITION = 0 422 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, 423 & INODE, 1, MPI_INTEGER, COMM, IERR ) 424 IPOS = PTRIST(STEP(INODE)) + 2 + KEEP(IXSZ) 425 LIELL = IW(IPOS-2)+IW(IPOS+1) 426 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, 427 & NPIV, 1, MPI_INTEGER, COMM, IERR ) 428 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, 429 & JBDEB, 1, MPI_INTEGER, COMM, IERR ) 430 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, 431 & JBFIN, 1, MPI_INTEGER, COMM, IERR ) 432 NRHS_B = JBFIN-JBDEB+1 433 NELIM = IW(IPOS-1) 434 IPOS = IPOS + 1 435 NPIV = IW(IPOS) 436 IPOS = IPOS + 1 437 NSLAVES = IW( IPOS + 1 ) 438 IPOS = IPOS + 1 + NSLAVES 439 INODEPOS = PTRIST(STEP(INODE)) + KEEP(IXSZ) + 4 440 IF ( KEEP(50) .eq. 0 ) THEN 441 LDA = LIELL 442 ELSE 443 LDA = NPIV 444 ENDIF 445 IF ( MTYPE .EQ. 1 .AND. KEEP(50).EQ.0 ) THEN 446 J1 = IPOS + LIELL + 1 447 J2 = IPOS + NPIV + LIELL 448 ELSE 449 J1 = IPOS + 1 450 J2 = IPOS + NPIV 451 ENDIF 452 IPOSINRHSCOMP = POSINRHSCOMP_BWD(IW(J1)) 453 DO K=JBDEB, JBFIN 454 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, 455 & W2, NPIV, MPI_DOUBLE_COMPLEX, 456 & COMM, IERR ) 457 I = 1 458 IF ( (KEEP(253).NE.0) .AND. 459 & (IW(PTRIST(STEP(INODE))+XXS).EQ.C_FINI+NSLAVES) 460 & ) THEN 461 DO JJ = J1,J2 462#if defined(RHSCOMP_BYROWS) 463 RHSCOMP(K,IPOSINRHSCOMP+JJ-J1) = W2(I) 464#else 465 RHSCOMP(IPOSINRHSCOMP+JJ-J1,K) = W2(I) 466#endif 467 I = I+1 468 ENDDO 469 ELSE 470 DO JJ = J1,J2 471#if defined(RHSCOMP_BYROWS) 472 RHSCOMP(K,IPOSINRHSCOMP+JJ-J1) = 473 & RHSCOMP(K,IPOSINRHSCOMP+JJ-J1) + W2(I) 474#else 475 RHSCOMP(IPOSINRHSCOMP+JJ-J1,K) = 476 & RHSCOMP(IPOSINRHSCOMP+JJ-J1,K) + W2(I) 477#endif 478 I = I+1 479 ENDDO 480 ENDIF 481 ENDDO 482 IW(PTRIST(STEP(INODE))+XXS) = 483 & IW(PTRIST(STEP(INODE))+XXS) - 1 484 IF ( IW(PTRIST(STEP(INODE))+XXS).EQ.C_FINI ) THEN 485 IF (KEEP(201).GT.0) THEN 486 CALL ZMUMPS_SOLVE_GET_OOC_NODE( 487 & INODE,PTRFAC,KEEP,A,LA,STEP, 488 & KEEP8,N,MUST_BE_PERMUTED,IERR) 489 IF(IERR.LT.0)THEN 490 INFO(1)=IERR 491 INFO(2)=0 492 GOTO 260 493 ENDIF 494 IF (KEEP(201).EQ.1 .AND. KEEP(50).NE.1) THEN 495 CALL ZMUMPS_OOC_PP_CHECK_PERM_FREED( 496 & IW(IPOS+1+2*LIELL), 497 & MUST_BE_PERMUTED ) 498 ENDIF 499 ENDIF 500 APOS = PTRFAC(IW(INODEPOS)) 501 IF (KEEP(201).EQ.1) THEN 502 LIWFAC = IW(PTRIST(STEP(INODE))+XXI) 503 TYPEF = TYPEF_L 504 NROW_L = NPIV+NELIM 505 PANEL_SIZE = ZMUMPS_OOC_PANEL_SIZE(NROW_L) 506 IF (PANEL_SIZE.LT.0) THEN 507 WRITE(6,*) ' Internal error in bwd solve PANEL_SIZE=', 508 & PANEL_SIZE 509 CALL MUMPS_ABORT() 510 ENDIF 511 ENDIF 512 IF ( POSIWCB - 2 .LT. 0 .or. 513 & POSWCB - LIELL*NRHS_B .LT. PLEFTW - 1_8 ) THEN 514 CALL ZMUMPS_COMPSO( N, KEEP(28), IWCB, 515 & LIWW, W, LWC, 516 & POSWCB, POSIWCB, PTRICB, PTRACB) 517 IF ( POSWCB - LIELL*NRHS_B .LT. PLEFTW - 1_8 ) THEN 518 INFO( 1 ) = -11 519 CALL MUMPS_SET_IERROR( LIELL*NRHS_B - POSWCB-PLEFTW+1_8, 520 & INFO(2) ) 521 GOTO 260 522 END IF 523 IF ( POSIWCB - 2 .LT. 0 ) THEN 524 INFO( 1 ) = -14 525 INFO( 2 ) = 2 - POSIWCB 526 GO TO 260 527 END IF 528 END IF 529 POSIWCB = POSIWCB - 2 530 POSWCB = POSWCB - LIELL*NRHS_B 531 PTRICB(STEP( INODE )) = POSIWCB + 1 532 PTRACB(STEP( INODE )) = POSWCB + 1_8 533 IWCB( PTRICB(STEP( INODE )) ) = LIELL*NRHS_B 534 IWCB( PTRICB(STEP( INODE )) + 1 ) = 1 535 IPOS = PTRIST(STEP(INODE)) + KEEP(IXSZ) + 5 + NSLAVES 536 IF ( MTYPE.EQ.1 .AND. KEEP(50).EQ.0 ) THEN 537 POSINDICES = IPOS + LIELL + 1 538 ELSE 539 POSINDICES = IPOS + 1 540 END IF 541 IPOSINRHSCOMP = POSINRHSCOMP_BWD(IW(J1)) 542 IFR8 = PTRACB(STEP( INODE )) 543 IF (KEEP(350).EQ.0) THEN 544 DO K=JBDEB, JBFIN 545 DO JJ = J1, J2 546 W(IFR8+JJ-J1+(K-JBDEB)*LIELL) = 547#if defined(RHSCOMP_BYROWS) 548 & RHSCOMP(K,IPOSINRHSCOMP+JJ-J1) 549#else 550 & RHSCOMP(IPOSINRHSCOMP+JJ-J1,K) 551#endif 552 END DO 553 END DO 554 ELSE IF (KEEP(350).eq.1.OR.KEEP(350).EQ.2) THEN 555 ELSE 556 WRITE(*,*) "Internal error ZMUMPS_BACKSLV_TRAITER_MESSAGE" 557 CALL MUMPS_ABORT() 558 ENDIF 559 IFR8 = PTRACB(STEP(INODE))+NPIV-1 560 IF ( MTYPE .EQ. 1 .AND. KEEP(50).EQ.0 ) THEN 561 J1 = IPOS + LIELL + NPIV + 1 562 J2 = IPOS + 2 * LIELL 563 ELSE 564 J1 = IPOS + NPIV + 1 565 J2 = IPOS + LIELL 566 END IF 567 IF (KEEP(350).EQ.0) THEN 568 DO JJ = J1, J2-KEEP(253) 569 J = IW(JJ) 570 IFR8 = IFR8 + 1 571 IPOSINRHSCOMP_TMP = abs(POSINRHSCOMP_BWD(J)) 572 DO K=JBDEB, JBFIN 573#if defined(RHSCOMP_BYROWS) 574 W(IFR8+(K-JBDEB)*LIELL) = RHSCOMP(K,IPOSINRHSCOMP_TMP) 575#else 576 W(IFR8+(K-JBDEB)*LIELL) = RHSCOMP(IPOSINRHSCOMP_TMP,K) 577#endif 578 ENDDO 579 ENDDO 580 ELSE IF (KEEP(350).EQ.1.OR.KEEP(350).EQ.2) THEN 581 CALL ZMUMPS_SOL_BWD_GTHR( JBDEB, JBFIN, J1, J2, 582 & RHSCOMP, NRHS, LRHSCOMP, 583 & W(PTRACB(STEP(INODE))), LIELL, NPIV+1, 584 & IW, LIW, KEEP, N, POSINRHSCOMP_BWD ) 585 IFR8 = IFR8 + J2-KEEP(253)-J1+1 586 ELSE 587 WRITE(*,*) "Internal error ZMUMPS_BACKSLV_TRAITER_MESSAGE" 588 CALL MUMPS_ABORT() 589 ENDIF 590 IF ( KEEP(201).EQ.1 .AND. 591 & (( NELIM .GT. 0 ).OR. (MTYPE.NE.1 ))) THEN 592 J = NPIV / PANEL_SIZE 593 TWOBYTWO = KEEP(50).EQ.2 .AND. KEEP(105).GT.0 594 IF (TWOBYTWO) THEN 595 CALL ZMUMPS_BUILD_PANEL_POS(PANEL_SIZE, PANEL_POS, 596 & LPANEL_POS, IW(IPOS+1+LIELL), NPIV, NPANELS, 597 & NROW_L, NBENTRIES_ALLPANELS) 598 ELSE 599 IF (NPIV.EQ.J*PANEL_SIZE) THEN 600 NPIV_LAST = NPIV 601 NBJLAST = PANEL_SIZE 602 NPANELS = J 603 ELSE 604 NPIV_LAST = (J+1)* PANEL_SIZE 605 NBJLAST = NPIV-J*PANEL_SIZE 606 NPANELS = J+1 607 ENDIF 608 NBENTRIES_ALLPANELS = 609 & int(NROW_L,8) * int(NPIV,8) 610 & - int( ( J * ( J - 1 ) ) /2,8 ) 611 & * int(PANEL_SIZE,8) * int(PANEL_SIZE,8) 612 & - int(J,8) 613 & * int(mod(NPIV, PANEL_SIZE),8) 614 & * int(PANEL_SIZE,8) 615 JJ=NPIV_LAST 616 ENDIF 617 APOSDEB = APOS + NBENTRIES_ALLPANELS 618 DO IPANEL=NPANELS,1,-1 619 IF (TWOBYTWO) THEN 620 NBJ = PANEL_POS(IPANEL+1)-PANEL_POS(IPANEL) 621 BEG_PANEL = PANEL_POS(IPANEL) 622 ELSE 623 IF (JJ.EQ.NPIV_LAST) THEN 624 NBJ = NBJLAST 625 ELSE 626 NBJ = PANEL_SIZE 627 ENDIF 628 BEG_PANEL = JJ- PANEL_SIZE+1 629 ENDIF 630 LDAJ = NROW_L-BEG_PANEL+1 631 APOSDEB = APOSDEB - int(NBJ,8)*int(LDAJ,8) 632 PTWCB = PTRACB(STEP(INODE)) 633 PTWCB_PANEL = PTRACB(STEP(INODE)) + int(BEG_PANEL - 1,8) 634 IPOSINRHSCOMP_PANEL = IPOSINRHSCOMP + BEG_PANEL - 1 635 NCB_PANEL = LDAJ - NBJ 636 NCB = NROW_L - NPIV 637 IF (KEEP(50).NE.1 .AND.MUST_BE_PERMUTED) THEN 638 CALL ZMUMPS_GET_OOC_PERM_PTR(TYPEF, TMP_NBPANELS, 639 & I_PIVRPTR, I_PIVR, IPOS + 1 + 2 * LIELL, IW, LIW) 640 CALL ZMUMPS_PERMUTE_PANEL( 641 & IW(I_PIVR + IW(I_PIVRPTR+IPANEL-1)-IW(I_PIVRPTR)), 642 & NPIV-IW(I_PIVRPTR+IPANEL-1)+1, 643 & IW(I_PIVRPTR+IPANEL-1)-1, 644 & A(APOSDEB), 645 & LDAJ, NBJ, BEG_PANEL-1) 646 ENDIF 647#if defined(MUMPS_USE_BLAS2) 648 IF ( NRHS_B == 1 ) THEN 649 IF (NCB_PANEL.NE.0) THEN 650 IF (KEEP(350).EQ.0) THEN 651 CALL zgemv( 'T', NCB_PANEL, NBJ, ALPHA, 652 & A( APOSDEB + int(NBJ,8) ), LDAJ, 653 & W( PTWCB_PANEL + int(NBJ,8) ), 654 & 1, ONE, 655 & W(PTWCB_PANEL), 1 ) 656 ELSE 657 IF (NCB_PANEL - NCB.NE. 0) THEN 658 CALL zgemv( 'T', NCB_PANEL-NCB, NBJ, ALPHA, 659 & A( APOSDEB + int(NBJ,8) ), LDAJ, 660# if defined(RHSCOMP_BYROWS) 661 & RHSCOMP(JBDEB,IPOSINRHSCOMP_PANEL+NBJ), 662 & 1, ONE, 663 & RHSCOMP(JBDEB,IPOSINRHSCOMP_PANEL), 1 ) 664# else 665 & RHSCOMP(IPOSINRHSCOMP_PANEL+NBJ,JBDEB), 666 & 1, ONE, 667 & RHSCOMP(IPOSINRHSCOMP_PANEL,JBDEB), 1 ) 668# endif 669 ENDIF 670 IF (NCB .NE. 0) THEN 671 CALL zgemv( 'T', NCB, NBJ, ALPHA, 672 & A( APOSDEB + int(LDAJ-NCB,8) ), LDAJ, 673 & W( PTWCB + NPIV ), 674 & 1, ONE, 675# if defined(RHSCOMP_BYROWS) 676 & RHSCOMP(JBDEB,IPOSINRHSCOMP_PANEL), 1 ) 677# else 678 & RHSCOMP(IPOSINRHSCOMP_PANEL,JBDEB), 1 ) 679# endif 680 ENDIF 681 ENDIF 682 ENDIF 683 IF (KEEP(350).eq.0) THEN 684 CALL ztrsv('L','T','U', NBJ, A(APOSDEB), LDAJ, 685 & W(PTWCB_PANEL), 1) 686 ELSE 687 CALL ztrsv('L','T','U', NBJ, A(APOSDEB), LDAJ, 688#if defined(RHSCOMP_BYROWS) 689 & RHSCOMP(JBDEB,IPOSINRHSCOMP_PANEL), 1) 690#else 691 & RHSCOMP(IPOSINRHSCOMP_PANEL,JBDEB), 1) 692#endif 693 ENDIF 694 ELSE 695#endif 696 IF (NCB_PANEL.NE.0) THEN 697 IF (KEEP(350).eq.0) THEN 698 CALL zgemm( 'T', 'N', NBJ, NRHS_B, NCB_PANEL, ALPHA, 699 & A(APOSDEB +int(NBJ,8)), LDAJ, 700 & W(PTWCB_PANEL+int(NBJ,8)),LIELL, 701 & ONE, W(PTWCB_PANEL),LIELL) 702 ELSE 703#if defined(RHSCOMP_BYROWS) 704 WRITE(*,*) 705 & "Internal error in ZMUMPS_BACKSLV_TRAITER_MESSAGE" 706 CALL MUMPS_ABORT() 707#else 708 IF (NCB_PANEL - NCB .NE. 0) THEN 709 CALL zgemm( 'T', 'N', NBJ, NRHS_B, 710 & NCB_PANEL-NCB, ALPHA, 711 & A(APOSDEB +int(NBJ,8)), LDAJ, 712 & RHSCOMP(IPOSINRHSCOMP_PANEL+NBJ,JBDEB), LRHSCOMP, 713 & ONE, RHSCOMP(IPOSINRHSCOMP_PANEL,JBDEB), LRHSCOMP) 714 ENDIF 715 IF (NCB .NE. 0) THEN 716 CALL zgemm( 'T', 'N', NBJ, NRHS_B, NCB, ALPHA, 717 & A(APOSDEB +int(LDAJ-NCB,8)), LDAJ, 718 & W( PTWCB+NPIV ), LIELL, 719 & ONE, RHSCOMP(IPOSINRHSCOMP_PANEL,JBDEB),LRHSCOMP) 720 ENDIF 721#endif 722 ENDIF 723 ENDIF 724 IF (KEEP(350).eq.0) THEN 725 CALL ztrsm('L','L','T','U',NBJ, NRHS_B, ONE, 726 & A(APOSDEB), 727 & LDAJ, W(PTWCB_PANEL), LIELL) 728 ELSE 729#if defined(RHSCOMP_BYROWS) 730 WRITE(*,*) 731 & "Internal error in ZMUMPS_BACKSLV_TRAITER_MESSAGE" 732 CALL MUMPS_ABORT() 733#else 734 CALL ztrsm('L','L','T','U',NBJ, NRHS_B, ONE, 735 & A(APOSDEB), 736 & LDAJ, RHSCOMP(IPOSINRHSCOMP_PANEL,JBDEB), LRHSCOMP) 737#endif 738 ENDIF 739#if defined(MUMPS_USE_BLAS2) 740 ENDIF 741#endif 742 IF (.NOT. TWOBYTWO) JJ=BEG_PANEL-1 743 ENDDO 744 GOTO 1234 745 ENDIF 746 IF (NELIM .GT.0) THEN 747 IF ( KEEP(50) .eq. 0 ) THEN 748 IST = APOS + int(NPIV,8) * int(LIELL,8) 749 ELSE 750 IST = APOS + int(NPIV,8) * int(NPIV,8) 751 END IF 752 IF ( NRHS_B == 1 ) THEN 753 IF (KEEP(350).EQ.0) THEN 754 CALL zgemv( 'N', NPIV, NELIM, ALPHA, 755 & A( IST ), NPIV, 756 & W( NPIV + PTRACB(STEP(INODE)) ), 757 & 1, ONE, 758 & W(PTRACB(STEP(INODE))), 1 ) 759 ELSE 760 CALL zgemv( 'N', NPIV, NELIM, ALPHA, 761 & A( IST ), NPIV, 762 & W( NPIV + PTRACB(STEP(INODE)) ), 763 & 1, ONE, 764#if defined(RHSCOMP_BYROWS) 765 & RHSCOMP(JBDEB,IPOSINRHSCOMP), 1) 766#else 767 & RHSCOMP(IPOSINRHSCOMP,JBDEB), 1) 768#endif 769 ENDIF 770 ELSE 771 IF (KEEP(350).EQ.0) THEN 772 CALL zgemm( 'N', 'N', NPIV, NRHS_B, NELIM, ALPHA, 773 & A(IST), NPIV, W(NPIV+PTRACB(STEP(INODE))),LIELL, 774 & ONE, W(PTRACB(STEP(INODE))),LIELL) 775 ELSE 776#if defined(RHSCOMP_BYROWS) 777 WRITE(*,*) 778 & "Internal error in ZMUMPS_BACKSLV_TRAITER_MESSAGE" 779 CALL MUMPS_ABORT() 780#else 781 CALL zgemm( 'N', 'N', NPIV, NRHS_B, NELIM, ALPHA, 782 & A(IST), NPIV, W(NPIV+PTRACB(STEP(INODE))),LIELL, 783 & ONE, RHSCOMP(IPOSINRHSCOMP,JBDEB), LRHSCOMP) 784#endif 785 ENDIF 786 END IF 787 ENDIF 788#if defined(MUMPS_USE_BLAS2) 789 IF ( NRHS_B == 1 ) THEN 790 IF (KEEP(350).EQ.0) THEN 791 CALL ztrsv( 'U', 'N', 'U', NPIV, A(APOS), LDA, 792 & W(PTRACB(STEP(INODE))),1) 793 ELSE 794 CALL ztrsv( 'U', 'N', 'U', NPIV, A(APOS), LDA, 795#if defined(RHSCOMP_BYROWS) 796 & RHSCOMP(JBDEB,IPOSINRHSCOMP), 1) 797#else 798 & RHSCOMP(IPOSINRHSCOMP,JBDEB), 1) 799#endif 800 ENDIF 801 ELSE 802#endif 803 IF (KEEP(350).EQ.0) THEN 804 CALL ztrsm( 'L','U', 'N', 'U', NPIV, NRHS_B, ONE, 805 & A(APOS), LDA, 806 & W(PTRACB(STEP(INODE))),LIELL) 807 ELSE 808#if defined(RHSCOMP_BYROWS) 809 WRITE(*,*) 810 & "Internal error in ZMUMPS_BACKSLV_TRAITER_MESSAGE" 811 CALL MUMPS_ABORT() 812#else 813 CALL ztrsm( 'L','U', 'N', 'U', NPIV, NRHS_B, ONE, 814 & A(APOS), LDA, 815 & RHSCOMP(IPOSINRHSCOMP,JBDEB), LRHSCOMP) 816#endif 817 ENDIF 818#if defined(MUMPS_USE_BLAS2) 819 END IF 820#endif 821 1234 CONTINUE 822 IF (KEEP(201).GT.0) THEN 823 CALL ZMUMPS_FREE_FACTORS_FOR_SOLVE(INODE,PTRFAC,KEEP(28), 824 & A,LA,.TRUE.,IERR) 825 IF(IERR.LT.0)THEN 826 INFO(1)=IERR 827 INFO(2)=0 828 GOTO 260 829 ENDIF 830 ENDIF 831 IPOS = PTRIST(STEP(INODE)) + KEEP(IXSZ) + 6 + NSLAVES 832 IPOSINRHSCOMP = POSINRHSCOMP_BWD(IW(IPOS)) 833 IF (KEEP(350).EQ.0) THEN 834 IPOSINRHSCOMP_TMP = IPOSINRHSCOMP 835 DO I = 1, NPIV 836 DO K=JBDEB,JBFIN 837#if defined(RHSCOMP_BYROWS) 838 RHSCOMP( K, IPOSINRHSCOMP_TMP ) = 839 & W( PTRACB(STEP(INODE))+I-1 + (K-JBDEB)*LIELL ) 840#else 841 RHSCOMP( IPOSINRHSCOMP_TMP , K ) = 842 & W( PTRACB(STEP(INODE))+I-1 + (K-JBDEB)*LIELL ) 843#endif 844 ENDDO 845 IPOSINRHSCOMP_TMP = IPOSINRHSCOMP_TMP + 1 846 END DO 847 ELSE IF (KEEP(350).EQ.1.OR.KEEP(350).EQ.2) THEN 848 ELSE 849 WRITE(*,*)"Internal error in ZMUMPS_BACKSLV_TRAITER_MESSAGE" 850 CALL MUMPS_ABORT() 851 ENDIF 852 IN = INODE 853 200 IN = FILS(IN) 854 IF (IN .GT. 0) GOTO 200 855 IF (IN .EQ. 0) THEN 856 MYLEAFE = MYLEAFE - 1 857 IF (MYLEAFE .EQ. 0) THEN 858 CALL ZMUMPS_MCAST2( DUMMY, 1, MPI_INTEGER, MYID, COMM, 859 & FEUILLE, SLAVEF, KEEP ) 860 NBFINF = NBFINF - 1 861 ENDIF 862 IWCB( PTRICB(STEP(INODE)) + 1 ) = 0 863 CALL ZMUMPS_FREETOPSO(N, KEEP(28), 864 & IWCB, LIWW, W, LWC, 865 & POSWCB, POSIWCB, PTRICB, PTRACB) 866 GOTO 270 867 ENDIF 868 DO I = 0, SLAVEF - 1 869 DEJA_SEND( I ) = .FALSE. 870 END DO 871 IN = -IN 872 IF ( KEEP(237).GT.0 ) THEN 873 NO_CHILDREN = .TRUE. 874 ELSE 875 NO_CHILDREN = .FALSE. 876 ENDIF 877 DO WHILE (IN.GT.0) 878 IF ( KEEP(237).GT.0 ) THEN 879 IF (.NOT.TO_PROCESS(STEP(IN))) THEN 880 IN = FRERE(STEP(IN)) 881 CYCLE 882 ELSE 883 NO_CHILDREN = .FALSE. 884 ENDIF 885 ENDIF 886 POOL_FIRST_POS = IIPOOL 887 IF (MUMPS_PROCNODE(PROCNODE_STEPS(STEP(IN)), 888 & SLAVEF) .EQ. MYID) THEN 889 IPOOL(IIPOOL ) = IN 890 IIPOOL = IIPOOL + 1 891 ELSE 892 PROCDEST = MUMPS_PROCNODE( PROCNODE_STEPS(STEP(IN)), 893 & SLAVEF ) 894 IF ( .NOT. DEJA_SEND( PROCDEST ) ) THEN 895 110 CONTINUE 896 CALL ZMUMPS_BUF_SEND_VCB( NRHS_B, IN, 0, 0, 897 & LIELL, LIELL-KEEP(253), 898 & IW( POSINDICES ) , 899 & W( PTRACB(STEP(INODE)) ), JBDEB, JBFIN, 900 & RHSCOMP(1, 1), NRHS, LRHSCOMP, 901 & IPOSINRHSCOMP, NPIV, KEEP, 902 & PROCDEST, NOEUD, COMM, IERR ) 903 IF ( IERR .EQ. -1 ) THEN 904 CALL ZMUMPS_BACKSLV_RECV_AND_TREAT( 905 & .FALSE., FLAG, 906 & BUFR, LBUFR, LBUFR_BYTES, 907 & MYID, SLAVEF, COMM, 908 & N, IWCB, LIWW, POSIWCB, 909 & W, LWC, POSWCB, 910 & IIPOOL, NBFINF, PTRICB, PTRACB, INFO, 911 & IPOOL, LPOOL, PANEL_POS, LPANEL_POS, STEP, 912 & FRERE, FILS, PROCNODE_STEPS, PLEFTW, 913 & KEEP, KEEP8, DKEEP, 914 & PTRIST, PTRFAC, IW, LIW, A, LA, W2, MYLEAFE, 915 & NRHS, MTYPE, 916 & RHSCOMP, LRHSCOMP, POSINRHSCOMP_BWD 917 & , TO_PROCESS, SIZE_TO_PROCESS 918 & , FROM_PP ) 919 IF ( INFO( 1 ) .LT. 0 ) GOTO 270 920 GOTO 110 921 ELSE IF ( IERR .eq. -2 ) THEN 922 INFO(1) = -17 923 INFO(2) = LIELL * NRHS_B * KEEP(35) + 924 & ( LIELL + 4 ) * KEEP(34) 925 GOTO 260 926 ELSE IF ( IERR .eq. -3 ) THEN 927 INFO(1) = -20 928 INFO(2) = LIELL * NRHS_B * KEEP(35) + 929 & ( LIELL + 4 ) * KEEP(34) 930 GOTO 260 931 END IF 932 DEJA_SEND( PROCDEST ) = .TRUE. 933 END IF 934 END IF 935 IN = FRERE( STEP( IN ) ) 936 END DO 937 IF (NO_CHILDREN) THEN 938 MYLEAFE = MYLEAFE - 1 939 IF (MYLEAFE .EQ. 0) THEN 940 CALL ZMUMPS_MCAST2( DUMMY, 1, MPI_INTEGER, MYID, 941 & COMM, FEUILLE, SLAVEF, KEEP ) 942 NBFINF = NBFINF - 1 943 ENDIF 944 IWCB( PTRICB(STEP(INODE)) + 1 ) = 0 945 CALL ZMUMPS_FREETOPSO( N, KEEP(28), 946 & IWCB, LIWW, W, LWC, 947 & POSWCB, POSIWCB, PTRICB, PTRACB) 948 GOTO 270 949 ENDIF 950 DO I=1,(IIPOOL-POOL_FIRST_POS)/2 951 TMP=IPOOL(POOL_FIRST_POS+I-1) 952 IPOOL(POOL_FIRST_POS+I-1)=IPOOL(IIPOOL-I) 953 IPOOL(IIPOOL-I)=TMP 954 ENDDO 955 IWCB( PTRICB(STEP( INODE )) + 1 ) = 0 956 CALL ZMUMPS_FREETOPSO( N, KEEP(28), 957 & IWCB, LIWW, W, LWC, 958 & POSWCB, POSIWCB, PTRICB, PTRACB) 959 END IF 960 ELSE IF (MSGTAG.EQ.TERREUR) THEN 961 INFO(1) = -001 962 INFO(2) = MSGSOU 963 GO TO 270 964 ELSE IF ( (MSGTAG.EQ.UPDATE_LOAD).OR. 965 & (MSGTAG.EQ.TAG_DUMMY) ) THEN 966 GO TO 270 967 ELSE 968 INFO(1) = -100 969 INFO(2) = MSGTAG 970 GOTO 260 971 ENDIF 972 GO TO 270 973 260 CONTINUE 974 CALL ZMUMPS_BDC_ERROR( MYID, SLAVEF, COMM, KEEP ) 975 270 CONTINUE 976 DEALLOCATE(DEJA_SEND) 977 RETURN 978 CALL ZMUMPS_BDC_ERROR( MYID, SLAVEF, COMM, KEEP ) 979 RETURN 980 END SUBROUTINE ZMUMPS_BACKSLV_TRAITER_MESSAGE 981 SUBROUTINE ZMUMPS_BUILD_PANEL_POS(PANEL_SIZE, PANEL_POS, 982 & LEN_PANEL_POS, INDICES, NPIV, 983 & NPANELS, NFRONT_OR_NASS, 984 & NBENTRIES_ALLPANELS) 985 IMPLICIT NONE 986 INTEGER, intent (in) :: PANEL_SIZE, NPIV 987 INTEGER, intent (in) :: INDICES(NPIV) 988 INTEGER, intent (in) :: LEN_PANEL_POS 989 INTEGER, intent (out) :: NPANELS 990 INTEGER, intent (out) :: PANEL_POS(LEN_PANEL_POS) 991 INTEGER, intent (in) :: NFRONT_OR_NASS 992 INTEGER(8), intent(out):: NBENTRIES_ALLPANELS 993 INTEGER NPANELS_MAX, I, NBeff 994 INTEGER(8) :: NBENTRIES_THISPANEL 995 NBENTRIES_ALLPANELS = 0_8 996 NPANELS_MAX = (NPIV+PANEL_SIZE-1)/PANEL_SIZE 997 IF (LEN_PANEL_POS .LT. NPANELS_MAX + 1) THEN 998 WRITE(*,*) "Error 1 in ZMUMPS_BUILD_PANEL_POS", 999 & LEN_PANEL_POS,NPANELS_MAX 1000 CALL MUMPS_ABORT() 1001 ENDIF 1002 I = 1 1003 NPANELS = 0 1004 IF (I .GT. NPIV) RETURN 1005 10 CONTINUE 1006 NPANELS = NPANELS + 1 1007 PANEL_POS(NPANELS) = I 1008 NBeff = min(PANEL_SIZE, NPIV-I+1) 1009 IF ( INDICES(I+NBeff-1) < 0) THEN 1010 NBeff=NBeff+1 1011 ENDIF 1012 NBENTRIES_THISPANEL = int(NFRONT_OR_NASS-I+1,8) * int(NBeff,8) 1013 NBENTRIES_ALLPANELS = NBENTRIES_ALLPANELS + NBENTRIES_THISPANEL 1014 I=I+NBeff 1015 IF ( I .LE. NPIV ) GOTO 10 1016 PANEL_POS(NPANELS+1)=NPIV+1 1017 RETURN 1018 END SUBROUTINE ZMUMPS_BUILD_PANEL_POS 1019