1C 2C This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 3C 4C 5C This version of MUMPS is provided to you free of charge. It is public 6C domain, based on public domain software developed during the Esprit IV 7C European project PARASOL (1996-1999). Since this first public domain 8C version in 1999, research and developments have been supported by the 9C following institutions: CERFACS, CNRS, ENS Lyon, INPT(ENSEEIHT)-IRIT, 10C INRIA, and University of Bordeaux. 11C 12C The MUMPS team at the moment of releasing this version includes 13C Patrick Amestoy, Maurice Bremond, Alfredo Buttari, Abdou Guermouche, 14C Guillaume Joslin, Jean-Yves L'Excellent, Francois-Henry Rouet, Bora 15C Ucar and Clement Weisbecker. 16C 17C We are also grateful to Emmanuel Agullo, Caroline Bousquet, Indranil 18C Chowdhury, Philippe Combes, Christophe Daniel, Iain Duff, Vincent Espirat, 19C Aurelia Fevre, Jacko Koster, Stephane Pralet, Chiara Puglisi, Gregoire 20C Richard, Tzvetomila Slavova, Miroslav Tuma and Christophe Voemel who 21C have been contributing to this project. 22C 23C Up-to-date copies of the MUMPS package can be obtained 24C from the Web pages: 25C http://mumps.enseeiht.fr/ or http://graal.ens-lyon.fr/MUMPS 26C 27C 28C THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY 29C EXPRESSED OR IMPLIED. ANY USE IS AT YOUR OWN RISK. 30C 31C 32C User documentation of any code that uses this software can 33C include this complete notice. You can acknowledge (using 34C references [1] and [2]) the contribution of this package 35C in any scientific publication dependent upon the use of the 36C package. You shall use reasonable endeavours to notify 37C the authors of the package of this publication. 38C 39C [1] P. R. Amestoy, I. S. Duff, J. Koster and J.-Y. L'Excellent, 40C A fully asynchronous multifrontal solver using distributed dynamic 41C scheduling, SIAM Journal of Matrix Analysis and Applications, 42C Vol 23, No 1, pp 15-41 (2001). 43C 44C [2] P. R. Amestoy and A. Guermouche and J.-Y. L'Excellent and 45C S. Pralet, Hybrid scheduling for the parallel solution of linear 46C systems. Parallel Computing Vol 32 (2), pp 136-156 (2006). 47C 48 MODULE DMUMPS_COMM_BUFFER 49 PRIVATE 50 PUBLIC :: DMUMPS_61, DMUMPS_528, 51 & DMUMPS_53 , DMUMPS_57 , 52 & DMUMPS_55, DMUMPS_59, 53 & DMUMPS_54,DMUMPS_58, 54 & DMUMPS_66, DMUMPS_78, 55 & DMUMPS_62, DMUMPS_68, 56 & DMUMPS_71, DMUMPS_70, 57 & DMUMPS_67, 58 & DMUMPS_65, DMUMPS_64, 59 & DMUMPS_72, 60 & DMUMPS_648, DMUMPS_76, 61 & DMUMPS_73, DMUMPS_74, 62 & DMUMPS_63,DMUMPS_77, 63 & DMUMPS_60, 64 & DMUMPS_524, DMUMPS_469, 65 & DMUMPS_460, DMUMPS_502, 66 & DMUMPS_519 ,DMUMPS_620 67 & ,DMUMPS_617 68 INTEGER NEXT, REQ, CONTENT, OVHSIZE 69 PARAMETER( NEXT = 0, REQ = 1, CONTENT = 2, OVHSIZE = 2 ) 70 INTEGER, SAVE :: SIZEofINT, SIZEofREAL, BUF_MYID 71 TYPE DMUMPS_COMM_BUFFER_TYPE 72 INTEGER LBUF, HEAD, TAIL,LBUF_INT, ILASTMSG 73 INTEGER, DIMENSION(:),POINTER :: CONTENT 74 END TYPE DMUMPS_COMM_BUFFER_TYPE 75 TYPE ( DMUMPS_COMM_BUFFER_TYPE ), SAVE :: BUF_CB 76 TYPE ( DMUMPS_COMM_BUFFER_TYPE ), SAVE :: BUF_SMALL 77 TYPE ( DMUMPS_COMM_BUFFER_TYPE ), SAVE :: BUF_LOAD 78 INTEGER, SAVE :: SIZE_RBUF_BYTES 79 INTEGER BUF_LMAX_ARRAY 80 DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE :: BUF_MAX_ARRAY 81 PUBLIC :: BUF_LMAX_ARRAY, BUF_MAX_ARRAY 82 CONTAINS 83 SUBROUTINE DMUMPS_528( MYID ) 84 IMPLICIT NONE 85 INTEGER MYID 86 BUF_MYID = MYID 87 RETURN 88 END SUBROUTINE DMUMPS_528 89 SUBROUTINE DMUMPS_61( IntSize, RealSize ) 90 IMPLICIT NONE 91 INTEGER IntSize, RealSize 92 SIZEofINT = IntSize 93 SIZEofREAL = RealSize 94 NULLIFY(BUF_CB %CONTENT) 95 NULLIFY(BUF_SMALL%CONTENT) 96 NULLIFY(BUF_LOAD%CONTENT) 97 BUF_CB%LBUF = 0 98 BUF_CB%LBUF_INT = 0 99 BUF_CB%HEAD = 1 100 BUF_CB%TAIL = 1 101 BUF_CB%ILASTMSG = 1 102 BUF_SMALL%LBUF = 0 103 BUF_SMALL%LBUF_INT = 0 104 BUF_SMALL%HEAD = 1 105 BUF_SMALL%TAIL = 1 106 BUF_SMALL%ILASTMSG = 1 107 BUF_LOAD%LBUF = 0 108 BUF_LOAD%LBUF_INT = 0 109 BUF_LOAD%HEAD = 1 110 BUF_LOAD%TAIL = 1 111 BUF_LOAD%ILASTMSG = 1 112 RETURN 113 END SUBROUTINE DMUMPS_61 114 SUBROUTINE DMUMPS_53( SIZE, IERR ) 115 IMPLICIT NONE 116 INTEGER SIZE, IERR 117 CALL DMUMPS_2( BUF_CB, SIZE, IERR ) 118 RETURN 119 END SUBROUTINE DMUMPS_53 120 SUBROUTINE DMUMPS_55( SIZE, IERR ) 121 IMPLICIT NONE 122 INTEGER SIZE, IERR 123 CALL DMUMPS_2( BUF_SMALL, SIZE, IERR ) 124 RETURN 125 END SUBROUTINE DMUMPS_55 126 SUBROUTINE DMUMPS_54( SIZE, IERR ) 127 IMPLICIT NONE 128 INTEGER SIZE, IERR 129 CALL DMUMPS_2( BUF_LOAD, SIZE, IERR ) 130 RETURN 131 END SUBROUTINE DMUMPS_54 132 SUBROUTINE DMUMPS_58( IERR ) 133 IMPLICIT NONE 134 INTEGER IERR 135 CALL DMUMPS_3( BUF_LOAD, IERR ) 136 RETURN 137 END SUBROUTINE DMUMPS_58 138 SUBROUTINE DMUMPS_620() 139 IMPLICIT NONE 140 IF (allocated( BUF_MAX_ARRAY)) DEALLOCATE( BUF_MAX_ARRAY ) 141 RETURN 142 END SUBROUTINE DMUMPS_620 143 SUBROUTINE DMUMPS_617(NFS4FATHER,IERR) 144 IMPLICIT NONE 145 INTEGER IERR, NFS4FATHER 146 IERR = 0 147 IF (allocated( BUF_MAX_ARRAY)) THEN 148 IF (BUF_LMAX_ARRAY .GE. NFS4FATHER) RETURN 149 DEALLOCATE( BUF_MAX_ARRAY ) 150 ENDIF 151 ALLOCATE(BUF_MAX_ARRAY(NFS4FATHER),stat=IERR) 152 BUF_LMAX_ARRAY=NFS4FATHER 153 RETURN 154 END SUBROUTINE DMUMPS_617 155 SUBROUTINE DMUMPS_57( IERR ) 156 IMPLICIT NONE 157 INTEGER IERR 158 CALL DMUMPS_3( BUF_CB, IERR ) 159 RETURN 160 END SUBROUTINE DMUMPS_57 161 SUBROUTINE DMUMPS_59( IERR ) 162 IMPLICIT NONE 163 INTEGER IERR 164 CALL DMUMPS_3( BUF_SMALL, IERR ) 165 RETURN 166 END SUBROUTINE DMUMPS_59 167 SUBROUTINE DMUMPS_2( BUF, SIZE, IERR ) 168 IMPLICIT NONE 169 TYPE ( DMUMPS_COMM_BUFFER_TYPE ) :: BUF 170 INTEGER SIZE, IERR 171 IERR = 0 172 BUF%LBUF = SIZE 173 BUF%LBUF_INT = ( SIZE + SIZEofINT - 1 ) / SIZEofINT 174 IF ( associated ( BUF%CONTENT ) ) DEALLOCATE( BUF%CONTENT ) 175 ALLOCATE( BUF%CONTENT( BUF%LBUF_INT ), stat = IERR ) 176 IF (IERR .NE. 0) THEN 177 NULLIFY( BUF%CONTENT ) 178 IERR = -1 179 BUF%LBUF = 0 180 BUF%LBUF_INT = 0 181 END IF 182 BUF%HEAD = 1 183 BUF%TAIL = 1 184 BUF%ILASTMSG = 1 185 RETURN 186 END SUBROUTINE DMUMPS_2 187 SUBROUTINE DMUMPS_3( BUF, IERR ) 188 IMPLICIT NONE 189 TYPE ( DMUMPS_COMM_BUFFER_TYPE ) :: BUF 190 INCLUDE 'mpif.h' 191 INTEGER IERR 192 INTEGER STATUS( MPI_STATUS_SIZE ) 193 LOGICAL FLAG 194 IF ( .NOT. associated ( BUF%CONTENT ) ) THEN 195 BUF%HEAD = 1 196 BUF%LBUF = 0 197 BUF%LBUF_INT = 0 198 BUF%TAIL = 1 199 BUF%ILASTMSG = 1 200 RETURN 201 END IF 202 DO WHILE ( BUF%HEAD.NE.0 .AND. BUF%HEAD .NE. BUF%TAIL ) 203 CALL MPI_TEST(BUF%CONTENT( BUF%HEAD + REQ ), FLAG, 204 & STATUS, IERR) 205 IF ( .not. FLAG ) THEN 206 WRITE(*,*) '** Warning: trying to cancel a request.' 207 WRITE(*,*) '** This might be problematic on SGI' 208 CALL MPI_CANCEL( BUF%CONTENT( BUF%HEAD + REQ ), IERR ) 209 CALL MPI_REQUEST_FREE( BUF%CONTENT( BUF%HEAD + REQ ), IERR ) 210 END IF 211 BUF%HEAD = BUF%CONTENT( BUF%HEAD + NEXT ) 212 END DO 213 DEALLOCATE( BUF%CONTENT ) 214 NULLIFY( BUF%CONTENT ) 215 BUF%LBUF = 0 216 BUF%LBUF_INT = 0 217 BUF%HEAD = 1 218 BUF%TAIL = 1 219 BUF%ILASTMSG = 1 220 RETURN 221 END SUBROUTINE DMUMPS_3 222 SUBROUTINE DMUMPS_66( NBROWS_ALREADY_SENT, 223 & INODE, FPERE, NFRONT, LCONT, 224 & NASS, NPIV, 225 & IWROW, IWCOL, A, COMPRESSCB, 226 & DEST, TAG, COMM, IERR ) 227 IMPLICIT NONE 228 INTEGER DEST, TAG, COMM, IERR 229 INTEGER NBROWS_ALREADY_SENT 230 INTEGER INODE, FPERE, NFRONT, LCONT, NASS, NPIV 231 INTEGER IWROW( LCONT ), IWCOL( LCONT ) 232 DOUBLE PRECISION A( * ) 233 LOGICAL COMPRESSCB 234 INCLUDE 'mpif.h' 235 INTEGER NBROWS_PACKET 236 INTEGER POSITION, IREQ, IPOS, I, J1 237 INTEGER SIZE1, SIZE2, SIZE_PACK, SIZE_AV, SIZE_AV_REALS 238 INTEGER IZERO, IONE 239 INTEGER SIZECB 240 INTEGER LCONT_SENT 241 INTEGER DEST2(1) 242 PARAMETER( IZERO = 0, IONE = 1 ) 243 LOGICAL RECV_BUF_SMALLER_THAN_SEND 244 DOUBLE PRECISION TMP 245 DEST2(1) = DEST 246 IERR = 0 247 IF (NBROWS_ALREADY_SENT .EQ. 0) THEN 248 CALL MPI_PACK_SIZE( 11 + LCONT + LCONT, MPI_INTEGER, 249 & COMM, SIZE1, IERR) 250 ELSE 251 CALL MPI_PACK_SIZE( 5, MPI_INTEGER, COMM, SIZE1, IERR) 252 ENDIF 253 CALL DMUMPS_79( BUF_CB, SIZE_AV ) 254 IF ( SIZE_AV .LT. SIZE_RBUF_BYTES ) THEN 255 RECV_BUF_SMALLER_THAN_SEND = .FALSE. 256 ELSE 257 SIZE_AV = SIZE_RBUF_BYTES 258 RECV_BUF_SMALLER_THAN_SEND = .TRUE. 259 ENDIF 260 SIZE_AV_REALS = ( SIZE_AV - SIZE1 ) / SIZEofREAL 261 IF (SIZE_AV_REALS < 0 ) THEN 262 NBROWS_PACKET = 0 263 ELSE 264 IF (COMPRESSCB) THEN 265 TMP=2.0D0*dble(NBROWS_ALREADY_SENT)+1.0D0 266 NBROWS_PACKET = int( 267 & ( sqrt( TMP * TMP 268 & + 8.0D0 * dble(SIZE_AV_REALS)) - TMP ) 269 & / 2.0D0 ) 270 ELSE 271 NBROWS_PACKET = SIZE_AV_REALS / LCONT 272 ENDIF 273 ENDIF 274 10 CONTINUE 275 NBROWS_PACKET = max(0, 276 & min(NBROWS_PACKET, LCONT - NBROWS_ALREADY_SENT)) 277 IF (NBROWS_PACKET .EQ. 0 .AND. LCONT .NE. 0) THEN 278 IF (RECV_BUF_SMALLER_THAN_SEND) THEN 279 IERR = -3 280 GOTO 100 281 ELSE 282 IERR = -1 283 GOTO 100 284 ENDIF 285 ENDIF 286 IF (COMPRESSCB) THEN 287 SIZECB = (NBROWS_ALREADY_SENT*NBROWS_PACKET)+(NBROWS_PACKET 288 & *(NBROWS_PACKET+1))/2 289 ELSE 290 SIZECB = NBROWS_PACKET * LCONT 291 ENDIF 292 CALL MPI_PACK_SIZE( SIZECB, MPI_DOUBLE_PRECISION, 293 & COMM, SIZE2, IERR ) 294 SIZE_PACK = SIZE1 + SIZE2 295 IF (SIZE_PACK .GT. SIZE_AV ) THEN 296 NBROWS_PACKET = NBROWS_PACKET - 1 297 IF (NBROWS_PACKET > 0) THEN 298 GOTO 10 299 ELSE 300 IF (RECV_BUF_SMALLER_THAN_SEND) THEN 301 IERR=-3 302 GOTO 100 303 ELSE 304 IERR = -1 305 GOTO 100 306 ENDIF 307 ENDIF 308 ENDIF 309 IF (NBROWS_PACKET + NBROWS_ALREADY_SENT.NE.LCONT .AND. 310 & SIZE_PACK .LT. SIZE_RBUF_BYTES / 4 311 & .AND. 312 & .NOT. RECV_BUF_SMALLER_THAN_SEND) 313 & THEN 314 IERR = -1 315 GOTO 100 316 ENDIF 317 CALL DMUMPS_4( BUF_CB, IPOS, IREQ, SIZE_PACK, IERR, 318 & IONE , DEST2 319 & ) 320 IF (IERR .EQ. -1 .OR. IERR .EQ. -2) THEN 321 NBROWS_PACKET = NBROWS_PACKET - 1 322 IF ( NBROWS_PACKET > 0 ) GOTO 10 323 ENDIF 324 IF ( IERR .LT. 0 ) GOTO 100 325 POSITION = 0 326 CALL MPI_PACK( INODE, 1, MPI_INTEGER, 327 & BUF_CB%CONTENT( IPOS ), SIZE_PACK, 328 & POSITION, COMM, IERR ) 329 CALL MPI_PACK( FPERE, 1, MPI_INTEGER, 330 & BUF_CB%CONTENT( IPOS ), SIZE_PACK, 331 & POSITION, COMM, IERR ) 332 IF (COMPRESSCB) THEN 333 LCONT_SENT=-LCONT 334 ELSE 335 LCONT_SENT=LCONT 336 ENDIF 337 CALL MPI_PACK( LCONT_SENT, 1, MPI_INTEGER, 338 & BUF_CB%CONTENT( IPOS ), SIZE_PACK, 339 & POSITION, COMM, IERR ) 340 CALL MPI_PACK( NBROWS_ALREADY_SENT, 1, MPI_INTEGER, 341 & BUF_CB%CONTENT( IPOS ), SIZE_PACK, 342 & POSITION, COMM, IERR ) 343 CALL MPI_PACK( NBROWS_PACKET, 1, MPI_INTEGER, 344 & BUF_CB%CONTENT( IPOS ), SIZE_PACK, 345 & POSITION, COMM, IERR ) 346 IF (NBROWS_ALREADY_SENT == 0) THEN 347 CALL MPI_PACK( LCONT, 1, MPI_INTEGER, 348 & BUF_CB%CONTENT( IPOS ), SIZE_PACK, 349 & POSITION, COMM, IERR ) 350 CALL MPI_PACK( NASS-NPIV, 1, MPI_INTEGER, 351 & BUF_CB%CONTENT( IPOS ), SIZE_PACK, 352 & POSITION, COMM, IERR ) 353 CALL MPI_PACK( LCONT , 1, MPI_INTEGER, 354 & BUF_CB%CONTENT( IPOS ), SIZE_PACK, 355 & POSITION, COMM, IERR ) 356 CALL MPI_PACK( IZERO, 1, MPI_INTEGER, 357 & BUF_CB%CONTENT( IPOS ), SIZE_PACK, 358 & POSITION, COMM, IERR ) 359 CALL MPI_PACK( IONE, 1, MPI_INTEGER, 360 & BUF_CB%CONTENT( IPOS ), SIZE_PACK, 361 & POSITION, COMM, IERR ) 362 CALL MPI_PACK( IZERO, 1, MPI_INTEGER, 363 & BUF_CB%CONTENT( IPOS ), SIZE_PACK, 364 & POSITION, COMM, IERR ) 365 CALL MPI_PACK( IWROW, LCONT, MPI_INTEGER, 366 & BUF_CB%CONTENT( IPOS ), SIZE_PACK, 367 & POSITION, COMM, IERR ) 368 CALL MPI_PACK( IWCOL, LCONT, MPI_INTEGER, 369 & BUF_CB%CONTENT( IPOS ), SIZE_PACK, 370 & POSITION, COMM, IERR ) 371 ENDIF 372 IF ( LCONT .NE. 0 ) THEN 373 J1 = 1 + NBROWS_ALREADY_SENT * NFRONT 374 IF (COMPRESSCB) THEN 375 DO I = NBROWS_ALREADY_SENT+1, 376 & NBROWS_ALREADY_SENT+NBROWS_PACKET 377 CALL MPI_PACK( A( J1 ), I, MPI_DOUBLE_PRECISION, 378 & BUF_CB%CONTENT( IPOS ), SIZE_PACK, 379 & POSITION, COMM, IERR ) 380 J1 = J1 + NFRONT 381 END DO 382 ELSE 383 DO I = NBROWS_ALREADY_SENT+1, 384 & NBROWS_ALREADY_SENT+NBROWS_PACKET 385 CALL MPI_PACK( A( J1 ), LCONT, MPI_DOUBLE_PRECISION, 386 & BUF_CB%CONTENT( IPOS ), SIZE_PACK, 387 & POSITION, COMM, IERR ) 388 J1 = J1 + NFRONT 389 END DO 390 ENDIF 391 END IF 392 CALL MPI_ISEND( BUF_CB%CONTENT( IPOS ), POSITION, MPI_PACKED, 393 & DEST, TAG, COMM, BUF_CB%CONTENT( IREQ ), IERR ) 394 IF ( SIZE_PACK .LT. POSITION ) THEN 395 WRITE(*,*) 'Error Try_send_cb: SIZE, POSITION=',SIZE_PACK, 396 & POSITION 397 CALL MUMPS_ABORT() 398 END IF 399 IF ( SIZE_PACK .NE. POSITION ) 400 & CALL DMUMPS_1( BUF_CB, POSITION ) 401 NBROWS_ALREADY_SENT = NBROWS_ALREADY_SENT + NBROWS_PACKET 402 IF (NBROWS_ALREADY_SENT .NE. LCONT ) THEN 403 IERR = -1 404 RETURN 405 ENDIF 406 100 CONTINUE 407 RETURN 408 END SUBROUTINE DMUMPS_66 409 SUBROUTINE DMUMPS_72( NRHS, INODE, IFATH, 410 & EFF_CB_SIZE, LD_CB, LD_PIV, NPIV, CB, SOL, 411 & DEST, COMM, IERR ) 412 IMPLICIT NONE 413 INTEGER NRHS, INODE, IFATH, EFF_CB_SIZE, LD_CB, LD_PIV, NPIV 414 INTEGER DEST, COMM, IERR 415 DOUBLE PRECISION CB( LD_CB*(NRHS-1)+EFF_CB_SIZE ) 416 DOUBLE PRECISION SOL( max(1, LD_PIV*(NRHS-1)+NPIV) ) 417 INCLUDE 'mpif.h' 418 INCLUDE 'mumps_tags.h' 419 INTEGER SIZE, SIZE1, SIZE2, K 420 INTEGER POSITION, IREQ, IPOS 421 INTEGER IONE 422 INTEGER DEST2(1) 423 PARAMETER ( IONE=1 ) 424 DEST2(1) = DEST 425 IERR = 0 426 CALL MPI_PACK_SIZE( 4, MPI_INTEGER, COMM, SIZE1, IERR ) 427 CALL MPI_PACK_SIZE( NRHS * (EFF_CB_SIZE + NPIV), 428 & MPI_DOUBLE_PRECISION, COMM, 429 & SIZE2, IERR ) 430 SIZE = SIZE1 + SIZE2 431 CALL DMUMPS_4( BUF_CB, IPOS, IREQ, SIZE, IERR, 432 & IONE , DEST2 433 & ) 434 IF ( IERR .LT. 0 ) THEN 435 RETURN 436 ENDIF 437 POSITION = 0 438 CALL MPI_PACK( INODE, 1, MPI_INTEGER, 439 & BUF_CB%CONTENT( IPOS ), SIZE, 440 & POSITION, COMM, IERR ) 441 CALL MPI_PACK( IFATH, 1, MPI_INTEGER, 442 & BUF_CB%CONTENT( IPOS ), SIZE, 443 & POSITION, COMM, IERR ) 444 CALL MPI_PACK( EFF_CB_SIZE , 1, MPI_INTEGER, 445 & BUF_CB%CONTENT( IPOS ), SIZE, 446 & POSITION, COMM, IERR ) 447 CALL MPI_PACK( NPIV , 1, MPI_INTEGER, 448 & BUF_CB%CONTENT( IPOS ), SIZE, 449 & POSITION, COMM, IERR ) 450 DO K = 1, NRHS 451 CALL MPI_PACK( CB ( 1 + LD_CB * (K-1) ), 452 & EFF_CB_SIZE, MPI_DOUBLE_PRECISION, 453 & BUF_CB%CONTENT( IPOS ), SIZE, 454 & POSITION, COMM, IERR ) 455 END DO 456 IF ( NPIV .GT. 0 ) THEN 457 DO K=1, NRHS 458 CALL MPI_PACK( SOL(1+LD_PIV*(K-1)), 459 & NPIV, MPI_DOUBLE_PRECISION, 460 & BUF_CB%CONTENT( IPOS ), SIZE, 461 & POSITION, COMM, IERR ) 462 ENDDO 463 END IF 464 CALL MPI_ISEND( BUF_CB%CONTENT( IPOS ), POSITION, MPI_PACKED, 465 & DEST, Master2Slave, COMM, 466 & BUF_CB%CONTENT( IREQ ), IERR ) 467 IF ( SIZE .LT. POSITION ) THEN 468 WRITE(*,*) 'Try_send_master2slave: SIZE, POSITION = ', 469 & SIZE, POSITION 470 CALL MUMPS_ABORT() 471 END IF 472 IF ( SIZE .NE. POSITION ) CALL DMUMPS_1( BUF_CB, POSITION ) 473 RETURN 474 END SUBROUTINE DMUMPS_72 475 SUBROUTINE DMUMPS_78( NRHS, NODE1, NODE2, NCB, LDW, 476 & LONG, 477 & IW, W, 478 & DEST, TAG, COMM, IERR ) 479 IMPLICIT NONE 480 INTEGER LDW, DEST, TAG, COMM, IERR 481 INTEGER NRHS, NODE1, NODE2, NCB, LONG 482 INTEGER IW( max( 1, LONG ) ) 483 DOUBLE PRECISION W( max( 1, LDW * NRHS ) ) 484 INCLUDE 'mpif.h' 485 INTEGER POSITION, IREQ, IPOS 486 INTEGER SIZE1, SIZE2, SIZE, K 487 INTEGER IONE 488 INTEGER DEST2(1) 489 PARAMETER ( IONE=1 ) 490 DEST2(1)=DEST 491 IERR = 0 492 IF ( NODE2 .EQ. 0 ) THEN 493 CALL MPI_PACK_SIZE( 2+LONG, MPI_INTEGER, COMM, SIZE1, IERR ) 494 ELSE 495 CALL MPI_PACK_SIZE( 4+LONG, MPI_INTEGER, COMM, SIZE1, IERR ) 496 END IF 497 SIZE2 = 0 498 IF ( LONG .GT. 0 ) THEN 499 CALL MPI_PACK_SIZE( NRHS*LONG, MPI_DOUBLE_PRECISION, 500 & COMM, SIZE2, IERR ) 501 END IF 502 SIZE = SIZE1 + SIZE2 503 CALL DMUMPS_4( BUF_CB, IPOS, IREQ, SIZE, IERR, 504 & IONE , DEST2 505 & ) 506 IF ( IERR .LT. 0 ) THEN 507 RETURN 508 ENDIF 509 POSITION = 0 510 CALL MPI_PACK( NODE1, 1, MPI_INTEGER, 511 & BUF_CB%CONTENT( IPOS ), SIZE, 512 & POSITION, COMM, IERR ) 513 IF ( NODE2 .NE. 0 ) THEN 514 CALL MPI_PACK( NODE2, 1, MPI_INTEGER, 515 & BUF_CB%CONTENT( IPOS ), SIZE, 516 & POSITION, COMM, IERR ) 517 CALL MPI_PACK( NCB, 1, MPI_INTEGER, 518 & BUF_CB%CONTENT( IPOS ), SIZE, 519 & POSITION, COMM, IERR ) 520 END IF 521 CALL MPI_PACK( LONG, 1, MPI_INTEGER, 522 & BUF_CB%CONTENT( IPOS ), SIZE, 523 & POSITION, COMM, IERR ) 524 IF ( LONG .GT. 0 ) THEN 525 CALL MPI_PACK( IW, LONG, MPI_INTEGER, 526 & BUF_CB%CONTENT( IPOS ), SIZE, 527 & POSITION, COMM, IERR ) 528 DO K=1, NRHS 529 CALL MPI_PACK( W(1+(K-1)*LDW), LONG, MPI_DOUBLE_PRECISION, 530 & BUF_CB%CONTENT( IPOS ), SIZE, 531 & POSITION, COMM, IERR ) 532 END DO 533 END IF 534 CALL MPI_ISEND( BUF_CB%CONTENT( IPOS ), POSITION, MPI_PACKED, 535 & DEST, TAG, COMM, BUF_CB%CONTENT( IREQ ), IERR ) 536 IF ( SIZE .NE. POSITION ) CALL DMUMPS_1( BUF_CB, POSITION ) 537 RETURN 538 END SUBROUTINE DMUMPS_78 539 SUBROUTINE DMUMPS_62( I, DEST, TAG, COMM, IERR ) 540 IMPLICIT NONE 541 INTEGER I 542 INTEGER DEST, TAG, COMM, IERR 543 INCLUDE 'mpif.h' 544 INTEGER IPOS, IREQ, MSG_SIZE, POSITION 545 INTEGER IONE 546 INTEGER DEST2(1) 547 PARAMETER ( IONE=1 ) 548 DEST2(1)=DEST 549 IERR = 0 550 CALL MPI_PACK_SIZE( 1, MPI_INTEGER, 551 & COMM, MSG_SIZE, IERR ) 552 CALL DMUMPS_4( BUF_SMALL, IPOS, IREQ, MSG_SIZE, IERR, 553 & IONE , DEST2 554 & ) 555 IF ( IERR .LT. 0 ) THEN 556 write(6,*) ' Internal error in DMUMPS_62', 557 & ' Buf size (bytes)= ',BUF_SMALL%LBUF 558 RETURN 559 ENDIF 560 POSITION=0 561 CALL MPI_PACK( I, 1, 562 & MPI_INTEGER, BUF_SMALL%CONTENT( IPOS ), 563 & MSG_SIZE, 564 & POSITION, COMM, IERR ) 565 CALL MPI_ISEND( BUF_SMALL%CONTENT(IPOS), MSG_SIZE, 566 & MPI_PACKED, DEST, TAG, COMM, 567 & BUF_SMALL%CONTENT( IREQ ), IERR ) 568 RETURN 569 END SUBROUTINE DMUMPS_62 570 SUBROUTINE DMUMPS_469(FLAG) 571 LOGICAL FLAG 572 LOGICAL FLAG1, FLAG2, FLAG3 573 CALL DMUMPS_468( BUF_SMALL, FLAG1 ) 574 CALL DMUMPS_468( BUF_CB, FLAG2 ) 575 CALL DMUMPS_468( BUF_LOAD, FLAG3 ) 576 FLAG = FLAG1 .AND. FLAG2 .AND. FLAG3 577 RETURN 578 END SUBROUTINE DMUMPS_469 579 SUBROUTINE DMUMPS_468( B, FLAG ) 580 TYPE ( DMUMPS_COMM_BUFFER_TYPE ) :: B 581 LOGICAL :: FLAG 582 INTEGER SIZE_AVAIL 583 CALL DMUMPS_79(B, SIZE_AVAIL) 584 FLAG = ( B%HEAD == B%TAIL ) 585 RETURN 586 END SUBROUTINE DMUMPS_468 587 SUBROUTINE DMUMPS_79( B, SIZE_AV ) 588 IMPLICIT NONE 589 TYPE ( DMUMPS_COMM_BUFFER_TYPE ) :: B 590 INTEGER SIZE_AV 591 INCLUDE 'mpif.h' 592 INTEGER IERR 593 INTEGER STATUS( MPI_STATUS_SIZE ) 594 LOGICAL FLAG 595 IF ( B%HEAD .NE. B%TAIL ) THEN 596 10 CONTINUE 597 CALL MPI_TEST( B%CONTENT( B%HEAD + REQ ), FLAG, STATUS, IERR ) 598 IF ( FLAG ) THEN 599 B%HEAD = B%CONTENT( B%HEAD + NEXT ) 600 IF ( B%HEAD .EQ. 0 ) B%HEAD = B%TAIL 601 IF ( B%HEAD .NE. B%TAIL ) GOTO 10 602 END IF 603 END IF 604 IF ( B%HEAD .EQ. B%TAIL ) THEN 605 B%HEAD = 1 606 B%TAIL = 1 607 B%ILASTMSG = 1 608 END IF 609 IF ( B%HEAD .LE. B%TAIL ) THEN 610 SIZE_AV = max( B%LBUF_INT - B%TAIL, B%HEAD - 2 ) 611 ELSE 612 SIZE_AV = B%HEAD - B%TAIL - 1 613 END IF 614 SIZE_AV = min(SIZE_AV - OVHSIZE, SIZE_AV) 615 SIZE_AV = SIZE_AV * SIZEofINT 616 RETURN 617 END SUBROUTINE DMUMPS_79 618 SUBROUTINE DMUMPS_4( B, IPOS, IREQ, MSG_SIZE, IERR, 619 & NDEST , PDEST 620 & ) 621 IMPLICIT NONE 622 TYPE ( DMUMPS_COMM_BUFFER_TYPE ) :: B 623 INTEGER, INTENT(IN) :: MSG_SIZE 624 INTEGER, INTENT(OUT) :: IPOS, IREQ, IERR 625 INTEGER NDEST 626 INTEGER, INTENT(IN) :: PDEST(max(1,NDEST)) 627 INCLUDE 'mpif.h' 628 INTEGER MSG_SIZE_INT 629 INTEGER IBUF 630 LOGICAL FLAG 631 INTEGER STATUS( MPI_STATUS_SIZE ) 632 IERR = 0 633 IF ( B%HEAD .NE. B%TAIL ) THEN 634 10 CONTINUE 635 CALL MPI_TEST( B%CONTENT( B%HEAD + REQ ), FLAG, STATUS, IERR ) 636 IF ( FLAG ) THEN 637 B%HEAD = B%CONTENT( B%HEAD + NEXT ) 638 IF ( B%HEAD .EQ. 0 ) B%HEAD = B%TAIL 639 IF ( B%HEAD .NE. B%TAIL ) GOTO 10 640 END IF 641 END IF 642 IF ( B%HEAD .EQ. B%TAIL ) THEN 643 B%HEAD = 1 644 B%TAIL = 1 645 B%ILASTMSG = 1 646 END iF 647 MSG_SIZE_INT = ( MSG_SIZE + ( SIZEofINT - 1 ) ) / SIZEofINT 648 MSG_SIZE_INT = MSG_SIZE_INT + OVHSIZE 649 FLAG = ( ( B%HEAD .LE. B%TAIL ) 650 & .AND. ( 651 & ( MSG_SIZE_INT .LE. B%LBUF_INT - B%TAIL ) 652 & .OR. ( MSG_SIZE_INT .LE. B%HEAD - 2 ) ) ) 653 & .OR. 654 & ( ( B%HEAD .GT. B%TAIL ) 655 & .AND. ( MSG_SIZE_INT .LE. B%HEAD - B%TAIL - 1 ) ) 656 IF ( .NOT. FLAG 657 & ) THEN 658 IERR = -1 659 IF ( MSG_SIZE_INT .GT. B%LBUF_INT - 1 ) then 660 IERR = -2 661 ENDIF 662 IPOS = -1 663 IREQ = -1 664 RETURN 665 END IF 666 IF ( B%HEAD .LE. B%TAIL ) THEN 667 IF ( MSG_SIZE_INT .LE. B%LBUF_INT - B%TAIL + 1 ) THEN 668 IBUF = B%TAIL 669 ELSE IF ( MSG_SIZE_INT .LE. B%HEAD - 1 ) THEN 670 IBUF = 1 671 END IF 672 ELSE 673 IBUF = B%TAIL 674 END IF 675 B%CONTENT( B%ILASTMSG + NEXT ) = IBUF 676 B%ILASTMSG = IBUF 677 B%TAIL = IBUF + MSG_SIZE_INT 678 B%CONTENT( IBUF + NEXT ) = 0 679 IPOS = IBUF + CONTENT 680 IREQ = IBUF + REQ 681 RETURN 682 END SUBROUTINE DMUMPS_4 683 SUBROUTINE DMUMPS_1( BUF, SIZE ) 684 IMPLICIT NONE 685 TYPE ( DMUMPS_COMM_BUFFER_TYPE ) :: BUF 686 INTEGER SIZE 687 INTEGER SIZE_INT 688 SIZE_INT = ( SIZE + SIZEofINT - 1 ) / SIZEofINT 689 SIZE_INT = SIZE_INT + OVHSIZE 690 BUF%TAIL = BUF%ILASTMSG + SIZE_INT 691 RETURN 692 END SUBROUTINE DMUMPS_1 693 SUBROUTINE DMUMPS_68( 694 & INODE, NBPROCFILS, NLIG, ILIG, NCOL, ICOL, 695 & NASS, NSLAVES, LIST_SLAVES, 696 & DEST, NFRONT, COMM, IERR ) 697 IMPLICIT NONE 698 INTEGER COMM, IERR, NFRONT 699 INTEGER INODE 700 INTEGER NLIG, NCOL, NASS, NSLAVES 701 INTEGER NBPROCFILS, DEST 702 INTEGER ILIG( NLIG ) 703 INTEGER ICOL( NCOL ) 704 INTEGER LIST_SLAVES( NSLAVES ) 705 INCLUDE 'mpif.h' 706 INCLUDE 'mumps_tags.h' 707 INTEGER SIZE, POSITION, IPOS, IREQ 708 INTEGER IONE 709 INTEGER DEST2(1) 710 PARAMETER ( IONE=1 ) 711 DEST2(1) = DEST 712 IERR = 0 713 SIZE = ( 6 + NLIG + NCOL + NSLAVES + 1 ) * SIZEofINT 714 IF (SIZE.GT.SIZE_RBUF_BYTES ) THEN 715 IERR = -2 716 RETURN 717 END IF 718 CALL DMUMPS_4( BUF_CB, IPOS, IREQ, SIZE, IERR, 719 & IONE , DEST2 720 & ) 721 IF ( IERR .LT. 0 ) THEN 722 RETURN 723 ENDIF 724 POSITION = IPOS 725 BUF_CB%CONTENT( POSITION ) = INODE 726 POSITION = POSITION + 1 727 BUF_CB%CONTENT( POSITION ) = NBPROCFILS 728 POSITION = POSITION + 1 729 BUF_CB%CONTENT( POSITION ) = NLIG 730 POSITION = POSITION + 1 731 BUF_CB%CONTENT( POSITION ) = NCOL 732 POSITION = POSITION + 1 733 BUF_CB%CONTENT( POSITION ) = NASS 734 POSITION = POSITION + 1 735 BUF_CB%CONTENT( POSITION ) = NFRONT 736 POSITION = POSITION + 1 737 BUF_CB%CONTENT( POSITION ) = NSLAVES 738 POSITION = POSITION + 1 739 IF (NSLAVES.GT.0) THEN 740 BUF_CB%CONTENT( POSITION: POSITION + NSLAVES - 1 ) = 741 & LIST_SLAVES( 1: NSLAVES ) 742 POSITION = POSITION + NSLAVES 743 ENDIF 744 BUF_CB%CONTENT( POSITION:POSITION + NLIG - 1 ) = ILIG 745 POSITION = POSITION + NLIG 746 BUF_CB%CONTENT( POSITION:POSITION + NCOL - 1 ) = ICOL 747 POSITION = POSITION + NCOL 748 POSITION = POSITION - IPOS 749 IF ( POSITION * SIZEofINT .NE. SIZE ) THEN 750 WRITE(*,*) 'Error in DMUMPS_68 :', 751 & ' wrong estimated size' 752 CALL MUMPS_ABORT() 753 END IF 754 CALL MPI_ISEND( BUF_CB%CONTENT( IPOS ), SIZE, MPI_PACKED, 755 & DEST, MAITRE_DESC_BANDE, COMM, 756 & BUF_CB%CONTENT( IREQ ), IERR ) 757 RETURN 758 END SUBROUTINE DMUMPS_68 759 SUBROUTINE DMUMPS_70( NBROWS_ALREADY_SENT, 760 & IPERE, ISON, NROW, 761 & IROW, NCOL, ICOL, VAL, LDA, NELIM, TYPE_SON, 762 & NSLAVES, SLAVES, DEST, COMM, IERR, 763 & 764 & SLAVEF, KEEP,KEEP8, INIV2, TAB_POS_IN_PERE ) 765 IMPLICIT NONE 766 INTEGER NBROWS_ALREADY_SENT 767 INTEGER LDA, NELIM, TYPE_SON 768 INTEGER IPERE, ISON, NROW, NCOL, NSLAVES 769 INTEGER IROW( NROW ) 770 INTEGER ICOL( NCOL ) 771 INTEGER SLAVES( NSLAVES ) 772 DOUBLE PRECISION VAL(LDA, *) 773 INTEGER IPOS, IREQ, DEST, COMM, IERR 774 INTEGER SLAVEF, KEEP(500), INIV2 775 INTEGER(8) KEEP8(150) 776 INTEGER TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) 777 INCLUDE 'mpif.h' 778 INCLUDE 'mumps_tags.h' 779 INTEGER SIZE1, SIZE2, SIZE3, SIZE_PACK, POSITION, I 780 INTEGER NBROWS_PACKET, NCOL_SEND 781 INTEGER SIZE_AV 782 LOGICAL RECV_BUF_SMALLER_THAN_SEND 783 INTEGER IONE 784 INTEGER DEST2(1) 785 PARAMETER ( IONE=1 ) 786 DEST2(1) = DEST 787 IERR = 0 788 IF ( NELIM .NE. NROW ) THEN 789 WRITE(*,*) 'Error in TRY_SEND_MAITRE2:',NELIM, NROW 790 CALL MUMPS_ABORT() 791 END IF 792 IF (NBROWS_ALREADY_SENT .EQ. 0) THEN 793 CALL MPI_PACK_SIZE( NROW+NCOL+7+NSLAVES, MPI_INTEGER, 794 & COMM, SIZE1, IERR ) 795 IF ( ( KEEP(48).NE. 0 ).AND.(TYPE_SON .eq. 2 )) THEN 796 CALL MPI_PACK_SIZE( NSLAVES+1, MPI_INTEGER, 797 & COMM, SIZE3, IERR ) 798 ELSE 799 SIZE3 = 0 800 ENDIF 801 SIZE1=SIZE1+SIZE3 802 ELSE 803 CALL MPI_PACK_SIZE(7, MPI_INTEGER,COMM,SIZE1,IERR) 804 ENDIF 805 IF ( KEEP(50).ne.0 .AND. TYPE_SON .eq. 2 ) THEN 806 NCOL_SEND = NROW 807 ELSE 808 NCOL_SEND = NCOL 809 ENDIF 810 CALL DMUMPS_79( BUF_CB, SIZE_AV ) 811 IF (SIZE_AV .LT. SIZE_RBUF_BYTES) THEN 812 RECV_BUF_SMALLER_THAN_SEND = .FALSE. 813 ELSE 814 RECV_BUF_SMALLER_THAN_SEND = .TRUE. 815 SIZE_AV = SIZE_RBUF_BYTES 816 ENDIF 817 IF (NROW .GT. 0 ) THEN 818 NBROWS_PACKET = (SIZE_AV - SIZE1) / NCOL_SEND / SIZEofREAL 819 NBROWS_PACKET = min(NBROWS_PACKET, NROW - NBROWS_ALREADY_SENT) 820 NBROWS_PACKET = max(NBROWS_PACKET, 0) 821 ELSE 822 NBROWS_PACKET =0 823 ENDIF 824 IF (NBROWS_PACKET .EQ. 0 .AND. NROW .NE. 0) THEN 825 IF (RECV_BUF_SMALLER_THAN_SEND) THEN 826 IERR=-3 827 GOTO 100 828 ELSE 829 IERR=-1 830 GOTO 100 831 ENDIF 832 ENDIF 833 10 CONTINUE 834 CALL MPI_PACK_SIZE( NBROWS_PACKET * NCOL_SEND, 835 & MPI_DOUBLE_PRECISION, 836 & COMM, SIZE2, IERR ) 837 SIZE_PACK = SIZE1 + SIZE2 838 IF (SIZE_PACK .GT. SIZE_AV) THEN 839 NBROWS_PACKET = NBROWS_PACKET - 1 840 IF ( NBROWS_PACKET .GT. 0 ) THEN 841 GOTO 10 842 ELSE 843 IF (RECV_BUF_SMALLER_THAN_SEND) THEN 844 IERR = -3 845 GOTO 100 846 ELSE 847 IERR = -1 848 GOTO 100 849 ENDIF 850 ENDIF 851 ENDIF 852 IF (NBROWS_PACKET + NBROWS_ALREADY_SENT.NE.NROW .AND. 853 & SIZE_PACK - SIZE1 .LT. ( SIZE_RBUF_BYTES - SIZE1 ) / 2 854 & .AND. 855 & .NOT. RECV_BUF_SMALLER_THAN_SEND) 856 & THEN 857 IERR = -1 858 GOTO 100 859 ENDIF 860 CALL DMUMPS_4( BUF_CB, IPOS, IREQ, SIZE_PACK, IERR, 861 & IONE , DEST2 862 & ) 863 IF ( IERR .LT. 0 ) THEN 864 GOTO 100 865 ENDIF 866 POSITION = 0 867 CALL MPI_PACK( IPERE, 1, MPI_INTEGER, 868 & BUF_CB%CONTENT( IPOS ), SIZE_PACK, 869 & POSITION, COMM, IERR ) 870 CALL MPI_PACK( ISON, 1, MPI_INTEGER, 871 & BUF_CB%CONTENT( IPOS ), SIZE_PACK, 872 & POSITION, COMM, IERR ) 873 CALL MPI_PACK( NSLAVES, 1, MPI_INTEGER, 874 & BUF_CB%CONTENT( IPOS ), SIZE_PACK, 875 & POSITION, COMM, IERR ) 876 CALL MPI_PACK( NROW, 1, MPI_INTEGER, 877 & BUF_CB%CONTENT( IPOS ), SIZE_PACK, 878 & POSITION, COMM, IERR ) 879 CALL MPI_PACK( NCOL, 1, MPI_INTEGER, 880 & BUF_CB%CONTENT( IPOS ), SIZE_PACK, 881 & POSITION, COMM, IERR ) 882 CALL MPI_PACK( NBROWS_ALREADY_SENT, 1, MPI_INTEGER, 883 & BUF_CB%CONTENT( IPOS ), SIZE_PACK, 884 & POSITION, COMM, IERR ) 885 CALL MPI_PACK( NBROWS_PACKET, 1, MPI_INTEGER, 886 & BUF_CB%CONTENT( IPOS ), SIZE_PACK, 887 & POSITION, COMM, IERR ) 888 IF (NBROWS_ALREADY_SENT .EQ. 0) THEN 889 IF (NSLAVES.GT.0) THEN 890 CALL MPI_PACK( SLAVES, NSLAVES, MPI_INTEGER, 891 & BUF_CB%CONTENT( IPOS ), SIZE_PACK, 892 & POSITION, COMM, IERR ) 893 ENDIF 894 CALL MPI_PACK( IROW, NROW, MPI_INTEGER, 895 & BUF_CB%CONTENT( IPOS ), SIZE_PACK, 896 & POSITION, COMM, IERR ) 897 CALL MPI_PACK( ICOL, NCOL, MPI_INTEGER, 898 & BUF_CB%CONTENT( IPOS ), SIZE_PACK, 899 & POSITION, COMM, IERR ) 900 IF ( ( KEEP(48).NE. 0 ).AND.(TYPE_SON .eq. 2 ) ) THEN 901 CALL MPI_PACK( TAB_POS_IN_PERE(1,INIV2), NSLAVES+1, 902 & MPI_INTEGER, 903 & BUF_CB%CONTENT( IPOS ), SIZE_PACK, 904 & POSITION, COMM, IERR ) 905 ENDIF 906 ENDIF 907 IF (NBROWS_PACKET.GE.1) THEN 908 DO I=NBROWS_ALREADY_SENT+1, 909 & NBROWS_ALREADY_SENT+NBROWS_PACKET 910 CALL MPI_PACK( VAL(1,I), NCOL_SEND, 911 & MPI_DOUBLE_PRECISION, 912 & BUF_CB%CONTENT( IPOS ), SIZE_PACK, 913 & POSITION, COMM, IERR ) 914 ENDDO 915 ENDIF 916 CALL MPI_ISEND( BUF_CB%CONTENT( IPOS ), POSITION, MPI_PACKED, 917 & DEST, MAITRE2, COMM, 918 & BUF_CB%CONTENT( IREQ ), IERR ) 919 IF ( SIZE_PACK .LT. POSITION ) THEN 920 write(*,*) 'Try_send_maitre2, SIZE,POSITION=', 921 & SIZE_PACK,POSITION 922 CALL MUMPS_ABORT() 923 END IF 924 IF ( SIZE_PACK .NE. POSITION ) 925 & CALL DMUMPS_1( BUF_CB, POSITION ) 926 NBROWS_ALREADY_SENT = NBROWS_ALREADY_SENT + NBROWS_PACKET 927 IF ( NBROWS_ALREADY_SENT .NE. NROW ) THEN 928 IERR = -1 929 ENDIF 930 100 CONTINUE 931 RETURN 932 END SUBROUTINE DMUMPS_70 933 SUBROUTINE DMUMPS_67(NBROWS_ALREADY_SENT, 934 & DESC_IN_LU, 935 & IPERE, NFRONT_PERE, NASS_PERE, NFS4FATHER, 936 & NSLAVES_PERE, 937 & ISON, NBROW, LMAP, MAPROW, PERM, IW_CBSON, A_CBSON, 938 & ISLAVE, PDEST, PDEST_MASTER, COMM, IERR, 939 & 940 & KEEP,KEEP8, STEP, N, SLAVEF, 941 & ISTEP_TO_INIV2, TAB_POS_IN_PERE, 942 & COMPRESSCB, KEEP253_LOC ) 943 IMPLICIT NONE 944 INTEGER NBROWS_ALREADY_SENT 945 INTEGER, INTENT (in) :: KEEP253_LOC 946 INTEGER IPERE, ISON, NBROW 947 INTEGER PDEST, ISLAVE, COMM, IERR 948 INTEGER PDEST_MASTER, NASS_PERE, NSLAVES_PERE, 949 & NFRONT_PERE, LMAP 950 INTEGER MAPROW( LMAP ), PERM( max(1, NBROW )) 951 INTEGER IW_CBSON( * ) 952 DOUBLE PRECISION A_CBSON( * ) 953 LOGICAL DESC_IN_LU, COMPRESSCB 954 INTEGER KEEP(500), N , SLAVEF 955 INTEGER(8) KEEP8(150) 956 INTEGER STEP(N), 957 & ISTEP_TO_INIV2(KEEP(71)), 958 & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) 959 INCLUDE 'mpif.h' 960 INCLUDE 'mumps_tags.h' 961 INTEGER NFS4FATHER,SIZE3,PS1,NCA,LROW1 962 INTEGER(8) :: ASIZE 963 LOGICAL COMPUTE_MAX 964 INTEGER NBROWS_PACKET 965 INTEGER MAX_ROW_LENGTH 966 INTEGER LROW, NELIM 967 INTEGER(8) :: SIZFR, ITMP8 968 INTEGER NPIV, NFRONT, HS 969 INTEGER SIZE_PACK, SIZE1, SIZE2, POSITION,I 970 INTEGER SIZE_INTEGERS, B, SIZE_REALS, TMPSIZE, ONEorTWO, SIZE_AV 971 INTEGER NBINT, L 972 INTEGER(8) :: APOS, SHIFTCB_SON, LDA_SON8 973 INTEGER IPOS_IN_SLAVE 974 INTEGER STATE_SON 975 INTEGER INDICE_PERE, NROW, IPOS, IREQ, NOSLA 976 INTEGER IONE, J, THIS_ROW_LENGTH 977 INTEGER SIZE_DESC_BANDE, DESC_BANDE_BYTES 978 LOGICAL RECV_BUF_SMALLER_THAN_SEND 979 LOGICAL NOT_ENOUGH_SPACE 980 INTEGER PDEST2(1) 981 PARAMETER ( IONE=1 ) 982 INCLUDE 'mumps_headers.h' 983 DOUBLE PRECISION ZERO 984 PARAMETER (ZERO = 0.0D0) 985 COMPUTE_MAX = (KEEP(219) .NE. 0) .AND. 986 & (KEEP(50) .EQ. 2) .AND. 987 & (PDEST.EQ.PDEST_MASTER) 988 IF (NBROWS_ALREADY_SENT == 0) THEN 989 IF (COMPUTE_MAX) THEN 990 CALL DMUMPS_617(NFS4FATHER,IERR) 991 IF (IERR .NE. 0) THEN 992 IERR = -4 993 RETURN 994 ENDIF 995 ENDIF 996 ENDIF 997 PDEST2(1) = PDEST 998 IERR = 0 999 LROW = IW_CBSON( 1 + KEEP(IXSZ)) 1000 NELIM = IW_CBSON( 2 + KEEP(IXSZ)) 1001 NPIV = IW_CBSON( 4 + KEEP(IXSZ)) 1002 IF ( NPIV .LT. 0 ) THEN 1003 NPIV = 0 1004 END IF 1005 NROW = IW_CBSON( 3 + KEEP(IXSZ)) 1006 NFRONT = LROW + NPIV 1007 HS = 6 + IW_CBSON( 6 + KEEP(IXSZ)) + KEEP(IXSZ) 1008 CALL MUMPS_729( SIZFR, IW_CBSON( 1 + XXR ) ) 1009 STATE_SON = IW_CBSON(1+XXS) 1010 IF (STATE_SON .EQ. S_NOLCBCONTIG) THEN 1011 LDA_SON8 = int(LROW,8) 1012 SHIFTCB_SON = int(NPIV,8)*int(NROW,8) 1013 ELSE IF (STATE_SON .EQ. S_NOLCLEANED) THEN 1014 LDA_SON8 = int(LROW,8) 1015 SHIFTCB_SON = 0_8 1016 ELSE 1017 LDA_SON8 = int(NFRONT,8) 1018 SHIFTCB_SON = int(NPIV,8) 1019 ENDIF 1020 CALL DMUMPS_79( BUF_CB, SIZE_AV ) 1021 IF (PDEST .EQ. PDEST_MASTER) THEN 1022 SIZE_DESC_BANDE=0 1023 ELSE 1024 SIZE_DESC_BANDE=(7+SLAVEF+KEEP(127)*2) 1025 SIZE_DESC_BANDE=SIZE_DESC_BANDE+int(dble(KEEP(12))* 1026 & dble(SIZE_DESC_BANDE)/100.0D0) 1027 SIZE_DESC_BANDE=max(SIZE_DESC_BANDE, 1028 & 7+NSLAVES_PERE+NFRONT_PERE+NFRONT_PERE-NASS_PERE) 1029 ENDIF 1030 DESC_BANDE_BYTES=SIZE_DESC_BANDE*SIZEofINT 1031 IF ( SIZE_AV .LT. SIZE_RBUF_BYTES-DESC_BANDE_BYTES ) THEN 1032 RECV_BUF_SMALLER_THAN_SEND = .FALSE. 1033 ELSE 1034 RECV_BUF_SMALLER_THAN_SEND = .TRUE. 1035 SIZE_AV = SIZE_RBUF_BYTES-DESC_BANDE_BYTES 1036 ENDIF 1037 SIZE1=0 1038 IF (NBROWS_ALREADY_SENT==0) THEN 1039 IF(COMPUTE_MAX) THEN 1040 CALL MPI_PACK_SIZE(1, MPI_INTEGER, 1041 & COMM, PS1, IERR ) 1042 IF(NFS4FATHER .GT. 0) THEN 1043 CALL MPI_PACK_SIZE( NFS4FATHER, MPI_DOUBLE_PRECISION, 1044 & COMM, SIZE1, IERR ) 1045 ENDIF 1046 SIZE1 = SIZE1+PS1 1047 ENDIF 1048 ENDIF 1049 IF (KEEP(50) .EQ. 0) THEN 1050 ONEorTWO = 1 1051 ELSE 1052 ONEorTWO = 2 1053 ENDIF 1054 IF (PDEST .EQ.PDEST_MASTER) THEN 1055 L = 0 1056 ELSE IF (KEEP(50) .EQ. 0) THEN 1057 L = LROW 1058 ELSE 1059 L = LROW + PERM(1) - LMAP + NBROWS_ALREADY_SENT - 1 1060 ONEorTWO=ONEorTWO+1 1061 ENDIF 1062 NBINT = 6 + L 1063 CALL MPI_PACK_SIZE( NBINT, MPI_INTEGER, 1064 & COMM, TMPSIZE, IERR ) 1065 SIZE1 = SIZE1 + TMPSIZE 1066 SIZE_AV = SIZE_AV - SIZE1 1067 NOT_ENOUGH_SPACE=.FALSE. 1068 IF (SIZE_AV .LT.0 ) THEN 1069 NBROWS_PACKET = 0 1070 NOT_ENOUGH_SPACE=.TRUE. 1071 ELSE 1072 IF ( KEEP(50) .EQ. 0 ) THEN 1073 NBROWS_PACKET = 1074 & SIZE_AV / ( ONEorTWO*SIZEofINT+LROW*SIZEofREAL) 1075 ELSE 1076 B = 2 * ONEorTWO + 1077 & ( 1 + 2 * LROW + 2 * PERM(1) + 2 * NBROWS_ALREADY_SENT ) 1078 & * SIZEofREAL / SIZEofINT 1079 NBROWS_PACKET=int((dble(-B)+sqrt((dble(B)*dble(B))+ 1080 & dble(4)*dble(2*SIZE_AV)/dble(SIZEofINT) * 1081 & dble(SIZEofREAL/SIZEofINT)))* 1082 & dble(SIZEofINT) / dble(2) / dble(SIZEofREAL)) 1083 ENDIF 1084 ENDIF 1085 10 CONTINUE 1086 NBROWS_PACKET = max( 0, 1087 & min( NBROWS_PACKET, NBROW - NBROWS_ALREADY_SENT)) 1088 NOT_ENOUGH_SPACE = NOT_ENOUGH_SPACE .OR. 1089 & (NBROWS_PACKET .EQ.0.AND. NBROW.NE.0) 1090 IF (NOT_ENOUGH_SPACE) THEN 1091 IF (RECV_BUF_SMALLER_THAN_SEND) THEN 1092 IERR = -3 1093 GOTO 100 1094 ELSE 1095 IERR = -1 1096 GOTO 100 1097 ENDIF 1098 ENDIF 1099 IF (KEEP(50).EQ.0) THEN 1100 MAX_ROW_LENGTH = -99999 1101 SIZE_REALS = NBROWS_PACKET * LROW 1102 ELSE 1103 SIZE_REALS = ( LROW + PERM(1) + NBROWS_ALREADY_SENT ) * 1104 & NBROWS_PACKET + ( NBROWS_PACKET * ( NBROWS_PACKET + 1) ) / 2 1105 MAX_ROW_LENGTH = LROW+PERM(1)-LMAP+NBROWS_ALREADY_SENT 1106 & + NBROWS_PACKET-1 1107 ENDIF 1108 SIZE_INTEGERS = ONEorTWO* NBROWS_PACKET 1109 CALL MPI_PACK_SIZE( SIZE_REALS, MPI_DOUBLE_PRECISION, 1110 & COMM, SIZE2, IERR) 1111 CALL MPI_PACK_SIZE( SIZE_INTEGERS, MPI_INTEGER, 1112 & COMM, SIZE3, IERR) 1113 IF (SIZE2 + SIZE3 .GT. SIZE_AV ) THEN 1114 NBROWS_PACKET = NBROWS_PACKET -1 1115 IF (NBROWS_PACKET .GT. 0 ) THEN 1116 GOTO 10 1117 ELSE 1118 IF (RECV_BUF_SMALLER_THAN_SEND) THEN 1119 IERR = -3 1120 GOTO 100 1121 ELSE 1122 IERR = -1 1123 GOTO 100 1124 ENDIF 1125 ENDIF 1126 ENDIF 1127 SIZE_PACK = SIZE1 + SIZE2 + SIZE3 1128#if ! defined(DBG_SMB3) 1129 IF (NBROWS_PACKET + NBROWS_ALREADY_SENT.NE.NBROW .AND. 1130 & SIZE_PACK .LT. SIZE_RBUF_BYTES / 4 .AND. 1131 & .NOT. RECV_BUF_SMALLER_THAN_SEND) 1132 & THEN 1133 IERR = -1 1134 GOTO 100 1135 ENDIF 1136#endif 1137 CALL DMUMPS_4( BUF_CB, IPOS, IREQ, SIZE_PACK, IERR, 1138 & IONE , PDEST2 1139 & ) 1140 IF (IERR .EQ. -1 .OR. IERR.EQ. -2) THEN 1141 NBROWS_PACKET = NBROWS_PACKET - 1 1142 IF (NBROWS_PACKET > 0 ) GOTO 10 1143 ENDIF 1144 IF ( IERR .LT. 0 ) GOTO 100 1145 IF (SIZE_PACK.GT.SIZE_RBUF_BYTES ) THEN 1146 IERR = -3 1147 GOTO 100 1148 ENDIF 1149 POSITION = 0 1150 CALL MPI_PACK( IPERE, 1, MPI_INTEGER, 1151 & BUF_CB%CONTENT( IPOS ), SIZE_PACK, 1152 & POSITION, COMM, IERR ) 1153 CALL MPI_PACK( ISON, 1, MPI_INTEGER, 1154 & BUF_CB%CONTENT( IPOS ), SIZE_PACK, 1155 & POSITION, COMM, IERR ) 1156 CALL MPI_PACK( NBROW, 1, MPI_INTEGER, 1157 & BUF_CB%CONTENT( IPOS ), SIZE_PACK, 1158 & POSITION, COMM, IERR ) 1159 IF (KEEP(50)==0) THEN 1160 CALL MPI_PACK( LROW, 1, MPI_INTEGER, 1161 & BUF_CB%CONTENT( IPOS ), SIZE_PACK, 1162 & POSITION, COMM, IERR ) 1163 ELSE 1164 CALL MPI_PACK( MAX_ROW_LENGTH, 1, MPI_INTEGER, 1165 & BUF_CB%CONTENT( IPOS ), SIZE_PACK, 1166 & POSITION, COMM, IERR ) 1167 ENDIF 1168 CALL MPI_PACK( NBROWS_ALREADY_SENT, 1, MPI_INTEGER, 1169 & BUF_CB%CONTENT( IPOS ), SIZE_PACK, 1170 & POSITION, COMM, IERR ) 1171 CALL MPI_PACK( NBROWS_PACKET, 1, MPI_INTEGER, 1172 & BUF_CB%CONTENT( IPOS ), SIZE_PACK, 1173 & POSITION, COMM, IERR ) 1174 IF ( PDEST .NE. PDEST_MASTER ) THEN 1175 IF (KEEP(50)==0) THEN 1176 CALL MPI_PACK( IW_CBSON( HS + NROW + NPIV + 1 ), LROW, 1177 & MPI_INTEGER, 1178 & BUF_CB%CONTENT( IPOS ), SIZE_PACK, 1179 & POSITION, COMM, IERR ) 1180 ELSE 1181 IF (MAX_ROW_LENGTH > 0) THEN 1182 CALL MPI_PACK( IW_CBSON( HS + NROW + NPIV + 1 ), 1183 & MAX_ROW_LENGTH, 1184 & MPI_INTEGER, 1185 & BUF_CB%CONTENT( IPOS ), SIZE_PACK, 1186 & POSITION, COMM, IERR ) 1187 ENDIF 1188 ENDIF 1189 END IF 1190 DO J=NBROWS_ALREADY_SENT+1,NBROWS_ALREADY_SENT+NBROWS_PACKET 1191 I = PERM(J) 1192 INDICE_PERE=MAPROW(I) 1193 CALL MUMPS_47( 1194 & KEEP,KEEP8, IPERE, STEP, N, SLAVEF, 1195 & ISTEP_TO_INIV2, TAB_POS_IN_PERE, 1196 & 1197 & NASS_PERE, 1198 & NFRONT_PERE - NASS_PERE, 1199 & NSLAVES_PERE, 1200 & INDICE_PERE, 1201 & NOSLA, 1202 & IPOS_IN_SLAVE ) 1203 INDICE_PERE = IPOS_IN_SLAVE 1204 CALL MPI_PACK( INDICE_PERE, 1, MPI_INTEGER, 1205 & BUF_CB%CONTENT( IPOS ), SIZE_PACK, 1206 & POSITION, COMM, IERR ) 1207 ENDDO 1208 DO J=NBROWS_ALREADY_SENT+1,NBROWS_ALREADY_SENT+NBROWS_PACKET 1209 I = PERM(J) 1210 INDICE_PERE=MAPROW(I) 1211 CALL MUMPS_47( 1212 & KEEP,KEEP8, IPERE, STEP, N, SLAVEF, 1213 & ISTEP_TO_INIV2, TAB_POS_IN_PERE, 1214 & 1215 & NASS_PERE, 1216 & NFRONT_PERE - NASS_PERE, 1217 & NSLAVES_PERE, 1218 & INDICE_PERE, 1219 & NOSLA, 1220 & IPOS_IN_SLAVE ) 1221 IF (KEEP(50).ne.0) THEN 1222 THIS_ROW_LENGTH = LROW + I - LMAP 1223 CALL MPI_PACK( THIS_ROW_LENGTH, 1, MPI_INTEGER, 1224 & BUF_CB%CONTENT( IPOS ), SIZE_PACK, 1225 & POSITION, COMM, IERR ) 1226 ELSE 1227 THIS_ROW_LENGTH = LROW 1228 ENDIF 1229 IF (DESC_IN_LU) THEN 1230 IF ( COMPRESSCB ) THEN 1231 IF (NELIM.EQ.0) THEN 1232 ITMP8 = int(I,8) 1233 ELSE 1234 ITMP8 = int(NELIM+I,8) 1235 ENDIF 1236 APOS = ITMP8 * (ITMP8-1_8) / 2_8 + 1_8 1237 ELSE 1238 APOS = int(I+NELIM-1, 8) * int(LROW,8) + 1_8 1239 ENDIF 1240 ELSE 1241 IF ( COMPRESSCB ) THEN 1242 IF ( LROW .EQ. NROW ) THEN 1243 ITMP8 = int(I,8) 1244 APOS = ITMP8 * (ITMP8-1_8)/2_8 + 1_8 1245 ELSE 1246 ITMP8 = int(I + LROW - NROW,8) 1247 APOS = ITMP8 * (ITMP8-1_8)/2_8 + 1_8 - 1248 & int(LROW - NROW, 8) * int(LROW-NROW+1,8) / 2_8 1249 ENDIF 1250 ELSE 1251 APOS = int( I - 1, 8 ) * LDA_SON8 + SHIFTCB_SON + 1_8 1252 ENDIF 1253 ENDIF 1254 CALL MPI_PACK( A_CBSON( APOS ), THIS_ROW_LENGTH, 1255 & MPI_DOUBLE_PRECISION, 1256 & BUF_CB%CONTENT( IPOS ), SIZE_PACK, 1257 & POSITION, COMM, IERR ) 1258 ENDDO 1259 IF (NBROWS_ALREADY_SENT == 0) THEN 1260 IF (COMPUTE_MAX) THEN 1261 CALL MPI_PACK(NFS4FATHER,1, 1262 & MPI_INTEGER, 1263 & BUF_CB%CONTENT( IPOS ), SIZE_PACK, 1264 & POSITION, COMM, IERR ) 1265 IF(NFS4FATHER .GT. 0) THEN 1266 BUF_MAX_ARRAY(1:NFS4FATHER) = ZERO 1267 IF(MAPROW(NROW) .GT. NASS_PERE) THEN 1268 DO PS1=1,NROW 1269 IF(MAPROW(PS1).GT.NASS_PERE) EXIT 1270 ENDDO 1271 IF (DESC_IN_LU) THEN 1272 IF (COMPRESSCB) THEN 1273 APOS = int(NELIM+PS1,8) * int(NELIM+PS1-1,8) / 1274 & 2_8 + 1_8 1275 NCA = -44444 1276 ASIZE = int(NROW,8) * int(NROW+1,8)/2_8 - 1277 & int(NELIM+PS1,8) * int(NELIM+PS1-1,8)/2_8 1278 LROW1 = PS1 + NELIM 1279 ELSE 1280 APOS = int(PS1+NELIM-1,8) * int(LROW,8) + 1_8 1281 NCA = LROW 1282 ASIZE = int(NCA,8) * int(NROW-PS1+1,8) 1283 LROW1 = LROW 1284 ENDIF 1285 ELSE 1286 IF (COMPRESSCB) THEN 1287 IF (NPIV.NE.0) THEN 1288 WRITE(*,*) "Error in PARPIV/DMUMPS_67" 1289 CALL MUMPS_ABORT() 1290 ENDIF 1291 LROW1=LROW-NROW+PS1 1292 ITMP8 = int(PS1 + LROW - NROW,8) 1293 APOS = ITMP8 * (ITMP8 - 1_8) / 2_8 + 1_8 - 1294 & int(LROW-NROW,8)*int(LROW-NROW+1,8)/2_8 1295 ASIZE = int(LROW,8)*int(LROW+1,8)/2_8 - 1296 & ITMP8*(ITMP8-1_8)/2_8 1297 NCA = -555555 1298 ELSE 1299 APOS = int(PS1-1,8) * LDA_SON8 + 1_8 + SHIFTCB_SON 1300 NCA = int(LDA_SON8) 1301 ASIZE = SIZFR - (SHIFTCB_SON - 1302 & int(PS1-1,8) * LDA_SON8) 1303 LROW1=-666666 1304 ENDIF 1305 ENDIF 1306 IF ( NROW-PS1+1-KEEP253_LOC .NE. 0 ) THEN 1307 CALL DMUMPS_618( 1308 & A_CBSON(APOS),ASIZE,NCA, 1309 & NROW-PS1+1-KEEP253_LOC, 1310 & BUF_MAX_ARRAY,NFS4FATHER,COMPRESSCB,LROW1) 1311 ENDIF 1312 ENDIF 1313 CALL MPI_PACK(BUF_MAX_ARRAY, NFS4FATHER, 1314 & MPI_DOUBLE_PRECISION, 1315 & BUF_CB%CONTENT( IPOS ), SIZE_PACK, 1316 & POSITION, COMM, IERR ) 1317 ENDIF 1318 ENDIF 1319 ENDIF 1320 CALL MPI_ISEND( BUF_CB%CONTENT( IPOS ), POSITION, MPI_PACKED, 1321 & PDEST, CONTRIB_TYPE2, COMM, 1322 & BUF_CB%CONTENT( IREQ ), IERR ) 1323 IF ( SIZE_PACK.LT. POSITION ) THEN 1324 WRITE(*,*) ' contniv2: SIZE, POSITION =',SIZE_PACK, POSITION 1325 WRITE(*,*) ' NBROW, LROW = ', NBROW, LROW 1326 CALL MUMPS_ABORT() 1327 END IF 1328 IF ( SIZE_PACK .NE. POSITION ) 1329 & CALL DMUMPS_1( BUF_CB, POSITION ) 1330 NBROWS_ALREADY_SENT=NBROWS_ALREADY_SENT + NBROWS_PACKET 1331 IF (NBROWS_ALREADY_SENT .NE. NBROW ) THEN 1332 IERR = -1 1333 ENDIF 1334 100 CONTINUE 1335 RETURN 1336 END SUBROUTINE DMUMPS_67 1337 SUBROUTINE DMUMPS_71( 1338 & INODE, NFRONT, NASS1, NFS4FATHER, 1339 & ISON, MYID, NSLAVES, SLAVES_PERE, 1340 & TROW, NCBSON, 1341 & COMM, IERR, 1342 & DEST, NDEST, SLAVEF, 1343 & 1344 & KEEP,KEEP8, STEP, N, 1345 & ISTEP_TO_INIV2, TAB_POS_IN_PERE 1346 & 1347 & ) 1348 IMPLICIT NONE 1349 INTEGER INODE, NFRONT, NASS1, NCBSON, NSLAVES, 1350 & NDEST 1351 INTEGER SLAVEF, MYID, ISON 1352 INTEGER TROW( NCBSON ) 1353 INTEGER DEST( NDEST ) 1354 INTEGER SLAVES_PERE( NSLAVES ) 1355 INTEGER COMM, IERR 1356 INTEGER KEEP(500), N 1357 INTEGER(8) KEEP8(150) 1358 INTEGER STEP(N), 1359 & ISTEP_TO_INIV2(KEEP(71)), 1360 & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) 1361 INCLUDE 'mpif.h' 1362 INCLUDE 'mumps_tags.h' 1363 INTEGER SIZE_AV, IDEST, NSEND, SIZE, NFS4FATHER 1364 INTEGER TROW_SIZE, POSITION, INDX, INIV2 1365 INTEGER IPOS, IREQ 1366 INTEGER IONE 1367 PARAMETER ( IONE=1 ) 1368 INTEGER NASS_SON 1369 NASS_SON = -99998 1370 IERR = 0 1371 IF ( NDEST .eq. 1 ) THEN 1372 IF ( DEST(1).EQ.MYID ) GOTO 500 1373 SIZE = SIZEofINT * ( 7 + NSLAVES + NCBSON ) 1374 IF (( NSLAVES.GT.0 ) .AND. (KEEP(48).NE.0) ) THEN 1375 SIZE = SIZE + SIZEofINT * ( NSLAVES + 1 ) 1376 ENDIF 1377 CALL DMUMPS_4( BUF_CB, IPOS, IREQ, SIZE, IERR, 1378 & IONE, DEST 1379 & ) 1380 IF (IERR .LT. 0 ) THEN 1381 RETURN 1382 ENDIF 1383 IF (SIZE.GT.SIZE_RBUF_BYTES ) THEN 1384 IERR = -3 1385 RETURN 1386 END IF 1387 POSITION = IPOS 1388 BUF_CB%CONTENT( POSITION ) = INODE 1389 POSITION = POSITION + 1 1390 BUF_CB%CONTENT( POSITION ) = ISON 1391 POSITION = POSITION + 1 1392 BUF_CB%CONTENT( POSITION ) = NSLAVES 1393 POSITION = POSITION + 1 1394 BUF_CB%CONTENT( POSITION ) = NFRONT 1395 POSITION = POSITION + 1 1396 BUF_CB%CONTENT( POSITION ) = NASS1 1397 POSITION = POSITION + 1 1398 BUF_CB%CONTENT( POSITION ) = NCBSON 1399 POSITION = POSITION + 1 1400 BUF_CB%CONTENT( POSITION ) = NFS4FATHER 1401 POSITION = POSITION + 1 1402 IF (( NSLAVES.GT.0 ) .AND. (KEEP(48).NE.0) ) THEN 1403 INIV2 = ISTEP_TO_INIV2 ( STEP(INODE) ) 1404 BUF_CB%CONTENT( POSITION: POSITION + NSLAVES ) 1405 & = TAB_POS_IN_PERE(1:NSLAVES+1,INIV2) 1406 POSITION = POSITION + NSLAVES + 1 1407 ENDIF 1408 IF ( NSLAVES .NE. 0 ) THEN 1409 BUF_CB%CONTENT( POSITION: POSITION + NSLAVES - 1 ) 1410 & = SLAVES_PERE( 1: NSLAVES ) 1411 POSITION = POSITION + NSLAVES 1412 END IF 1413 BUF_CB%CONTENT( POSITION:POSITION+NCBSON-1 ) = 1414 & TROW( 1: NCBSON ) 1415 POSITION = POSITION + NCBSON 1416 POSITION = POSITION - IPOS 1417 IF ( POSITION * SIZEofINT .NE. SIZE ) THEN 1418 WRITE(*,*) 'Error in DMUMPS_71 :', 1419 & ' wrong estimated size' 1420 CALL MUMPS_ABORT() 1421 END IF 1422 CALL MPI_ISEND( BUF_CB%CONTENT( IPOS ), SIZE, 1423 & MPI_PACKED, 1424 & DEST( NDEST ), MAPLIG, COMM, 1425 & BUF_CB%CONTENT( IREQ ), 1426 & IERR ) 1427 ELSE 1428 NSEND = 0 1429 DO IDEST = 1, NDEST 1430 IF ( DEST( IDEST ) .ne. MYID ) NSEND = NSEND + 1 1431 END DO 1432 SIZE = SIZEofINT * 1433 & ( ( OVHSIZE + 7 + NSLAVES )* NSEND + NCBSON ) 1434 IF (( NSLAVES.GT.0 ) .AND. (KEEP(48).NE.0) ) THEN 1435 SIZE = SIZE + SIZEofINT * NSEND*( NSLAVES + 1 ) 1436 ENDIF 1437 CALL DMUMPS_79( BUF_CB, SIZE_AV ) 1438 IF ( SIZE_AV .LT. SIZE ) THEN 1439 IERR = -1 1440 RETURN 1441 END IF 1442 DO IDEST= 1, NDEST 1443 CALL MUMPS_49( 1444 & KEEP,KEEP8, ISON, STEP, N, SLAVEF, 1445 & ISTEP_TO_INIV2, TAB_POS_IN_PERE, 1446 & IDEST, NCBSON, 1447 & NDEST, 1448 & TROW_SIZE, INDX ) 1449 SIZE = SIZEofINT * ( NSLAVES + TROW_SIZE + 7 ) 1450 IF (( NSLAVES.GT.0 ) .AND. (KEEP(48).NE.0) ) THEN 1451 SIZE = SIZE + SIZEofINT * ( NSLAVES + 1 ) 1452 ENDIF 1453 IF ( MYID .NE. DEST( IDEST ) ) THEN 1454 CALL DMUMPS_4( BUF_CB, IPOS, IREQ, SIZE, IERR, 1455 & IONE, DEST(IDEST) 1456 & ) 1457 IF ( IERR .LT. 0 ) THEN 1458 WRITE(*,*) 'Problem in DMUMPS_4: IERR<0' 1459 CALL MUMPS_ABORT() 1460 END IF 1461 IF (SIZE.GT.SIZE_RBUF_BYTES) THEN 1462 IERR = -3 1463 RETURN 1464 ENDIF 1465 POSITION = IPOS 1466 BUF_CB%CONTENT( POSITION ) = INODE 1467 POSITION = POSITION + 1 1468 BUF_CB%CONTENT( POSITION ) = ISON 1469 POSITION = POSITION + 1 1470 BUF_CB%CONTENT( POSITION ) = NSLAVES 1471 POSITION = POSITION + 1 1472 BUF_CB%CONTENT( POSITION ) = NFRONT 1473 POSITION = POSITION + 1 1474 BUF_CB%CONTENT( POSITION ) = NASS1 1475 POSITION = POSITION + 1 1476 BUF_CB%CONTENT( POSITION ) = TROW_SIZE 1477 POSITION = POSITION + 1 1478 BUF_CB%CONTENT( POSITION ) = NFS4FATHER 1479 POSITION = POSITION + 1 1480 IF (( NSLAVES.GT.0 ) .AND. (KEEP(48).NE.0) ) THEN 1481 INIV2 = ISTEP_TO_INIV2 ( STEP(INODE) ) 1482 BUF_CB%CONTENT( POSITION: POSITION + NSLAVES ) 1483 & = TAB_POS_IN_PERE(1:NSLAVES+1,INIV2) 1484 POSITION = POSITION + NSLAVES + 1 1485 ENDIF 1486 IF ( NSLAVES .NE. 0 ) THEN 1487 BUF_CB%CONTENT( POSITION: POSITION + NSLAVES - 1 ) 1488 & = SLAVES_PERE( 1: NSLAVES ) 1489 POSITION = POSITION + NSLAVES 1490 END IF 1491 BUF_CB%CONTENT( POSITION:POSITION+TROW_SIZE-1 ) = 1492 & TROW( INDX: INDX + TROW_SIZE - 1 ) 1493 POSITION = POSITION + TROW_SIZE 1494 POSITION = POSITION - IPOS 1495 IF ( POSITION * SIZEofINT .NE. SIZE ) THEN 1496 WRITE(*,*) ' ERROR 1 in TRY_SEND_MAPLIG:', 1497 & 'Wrong estimated size' 1498 CALL MUMPS_ABORT() 1499 END IF 1500 CALL MPI_ISEND( BUF_CB%CONTENT( IPOS ), SIZE, 1501 & MPI_PACKED, 1502 & DEST( IDEST ), MAPLIG, COMM, 1503 & BUF_CB%CONTENT( IREQ ), 1504 & IERR ) 1505 END IF 1506 END DO 1507 END IF 1508 500 CONTINUE 1509 RETURN 1510 END SUBROUTINE DMUMPS_71 1511 SUBROUTINE DMUMPS_65( INODE, NFRONT, 1512 & NCOL, NPIV, FPERE, LASTBL, IPIV, VAL, 1513 & PDEST, NDEST, KEEP50, NB_BLOC_FAC, COMM, IERR ) 1514 IMPLICIT NONE 1515 INTEGER INODE, NCOL, NPIV, FPERE, NFRONT, NDEST 1516 INTEGER IPIV( NPIV ) 1517 DOUBLE PRECISION VAL( NFRONT, * ) 1518 INTEGER PDEST( NDEST ) 1519 INTEGER KEEP50, NB_BLOC_FAC, COMM, IERR 1520 LOGICAL LASTBL 1521 INCLUDE 'mpif.h' 1522 INCLUDE 'mumps_tags.h' 1523 INTEGER POSITION, IREQ, IPOS, SIZE1, SIZE2, SIZE, 1524 & IDEST, IPOSMSG, I 1525 INTEGER NPIVSENT 1526 INTEGER SSS, SS2 1527 IERR = 0 1528 IF ( LASTBL ) THEN 1529 IF ( KEEP50 .eq. 0 ) THEN 1530 CALL MPI_PACK_SIZE( 4 + NPIV + ( NDEST - 1 ) * OVHSIZE, 1531 & MPI_INTEGER, COMM, SIZE1, IERR ) 1532 ELSE 1533 CALL MPI_PACK_SIZE( 6 + NPIV + ( NDEST - 1 ) * OVHSIZE, 1534 & MPI_INTEGER, COMM, SIZE1, IERR ) 1535 END IF 1536 ELSE 1537 IF ( KEEP50 .eq. 0 ) THEN 1538 CALL MPI_PACK_SIZE( 3 + NPIV + ( NDEST - 1 ) * OVHSIZE, 1539 & MPI_INTEGER, COMM, SIZE1, IERR ) 1540 ELSE 1541 CALL MPI_PACK_SIZE( 4 + NPIV + ( NDEST - 1 ) * OVHSIZE, 1542 & MPI_INTEGER, COMM, SIZE1, IERR ) 1543 END IF 1544 END IF 1545 SIZE2 = 0 1546 IF (NPIV.GT.0) 1547 & CALL MPI_PACK_SIZE( NPIV*NCOL, MPI_DOUBLE_PRECISION, 1548 & COMM, SIZE2, IERR ) 1549 SIZE = SIZE1 + SIZE2 1550 CALL DMUMPS_4( BUF_CB, IPOS, IREQ, SIZE, IERR, 1551 & NDEST , PDEST 1552 & ) 1553 IF ( IERR .LT. 0 ) THEN 1554 RETURN 1555 ENDIF 1556 IF (SIZE.GT.SIZE_RBUF_BYTES) THEN 1557 SSS = 0 1558 IF ( LASTBL ) THEN 1559 IF ( KEEP50 .eq. 0 ) THEN 1560 CALL MPI_PACK_SIZE( 4 + NPIV , 1561 & MPI_INTEGER, COMM, SSS, IERR ) 1562 ELSE 1563 CALL MPI_PACK_SIZE( 6 + NPIV , 1564 & MPI_INTEGER, COMM, SSS, IERR ) 1565 END IF 1566 ELSE 1567 IF ( KEEP50 .eq. 0 ) THEN 1568 CALL MPI_PACK_SIZE( 3 + NPIV , 1569 & MPI_INTEGER, COMM, SSS, IERR ) 1570 ELSE 1571 CALL MPI_PACK_SIZE( 4 + NPIV , 1572 & MPI_INTEGER, COMM, SSS, IERR ) 1573 END IF 1574 END IF 1575 IF (NPIV.GT.0) 1576 & CALL MPI_PACK_SIZE( NPIV*NCOL, MPI_DOUBLE_PRECISION, 1577 & COMM, SS2, IERR ) 1578 SSS = SSS + SS2 1579 IF (SSS.GT.SIZE_RBUF_BYTES) THEN 1580 IERR = -2 1581 RETURN 1582 ENDIF 1583 ENDIF 1584 BUF_CB%ILASTMSG = BUF_CB%ILASTMSG + ( NDEST - 1 ) * OVHSIZE 1585 IPOS = IPOS - OVHSIZE 1586 DO IDEST = 1, NDEST - 1 1587 BUF_CB%CONTENT( IPOS + ( IDEST - 1 ) * OVHSIZE ) = 1588 & IPOS + IDEST * OVHSIZE 1589 END DO 1590 BUF_CB%CONTENT( IPOS + ( NDEST - 1 ) * OVHSIZE ) = 0 1591 IPOSMSG = IPOS + OVHSIZE * NDEST 1592 POSITION = 0 1593 CALL MPI_PACK( INODE, 1, MPI_INTEGER, 1594 & BUF_CB%CONTENT( IPOSMSG ), SIZE, 1595 & POSITION, COMM, IERR ) 1596 NPIVSENT = NPIV 1597 IF (LASTBL) NPIVSENT = -NPIV 1598 CALL MPI_PACK( NPIVSENT, 1, MPI_INTEGER, 1599 & BUF_CB%CONTENT( IPOSMSG ), SIZE, 1600 & POSITION, COMM, IERR ) 1601 IF ( LASTBL .or. KEEP50.ne.0 ) THEN 1602 CALL MPI_PACK( FPERE, 1, MPI_INTEGER, 1603 & BUF_CB%CONTENT( IPOSMSG ), SIZE, 1604 & POSITION, COMM, IERR ) 1605 END IF 1606 IF ( LASTBL .AND. KEEP50 .NE. 0 ) THEN 1607 CALL MPI_PACK( NDEST, 1, MPI_INTEGER, 1608 & BUF_CB%CONTENT( IPOSMSG ), SIZE, 1609 & POSITION, COMM, IERR ) 1610 CALL MPI_PACK( NB_BLOC_FAC, 1, MPI_INTEGER, 1611 & BUF_CB%CONTENT( IPOSMSG ), SIZE, 1612 & POSITION, COMM, IERR ) 1613 END IF 1614 CALL MPI_PACK( NCOL, 1, MPI_INTEGER, 1615 & BUF_CB%CONTENT( IPOSMSG ), SIZE, 1616 & POSITION, COMM, IERR ) 1617 IF ( NPIV.GT.0) THEN 1618 CALL MPI_PACK( IPIV, NPIV, MPI_INTEGER, 1619 & BUF_CB%CONTENT( IPOSMSG ), SIZE, 1620 & POSITION, COMM, IERR ) 1621 DO I = 1, NPIV 1622 CALL MPI_PACK( VAL(1,I), NCOL, 1623 & MPI_DOUBLE_PRECISION, 1624 & BUF_CB%CONTENT( IPOSMSG ), SIZE, 1625 & POSITION, COMM, IERR ) 1626 END DO 1627 ENDIF 1628 DO IDEST = 1, NDEST 1629 IF ( KEEP50.eq.0) THEN 1630 CALL MPI_ISEND( BUF_CB%CONTENT( IPOSMSG ), POSITION, MPI_PACKED, 1631 & PDEST(IDEST), BLOC_FACTO, COMM, 1632 & BUF_CB%CONTENT( IREQ + ( IDEST-1 ) * OVHSIZE ), 1633 & IERR ) 1634 ELSE 1635 CALL MPI_ISEND( BUF_CB%CONTENT( IPOSMSG ), POSITION, MPI_PACKED, 1636 & PDEST(IDEST), BLOC_FACTO_SYM, COMM, 1637 & BUF_CB%CONTENT( IREQ + ( IDEST-1 ) * OVHSIZE ), 1638 & IERR ) 1639 END IF 1640 END DO 1641 SIZE = SIZE - ( NDEST - 1 ) * OVHSIZE * SIZEofINT 1642 IF ( SIZE .LT. POSITION ) THEN 1643 WRITE(*,*) ' Error sending blocfacto : size < position' 1644 WRITE(*,*) ' Size,position=',SIZE,POSITION 1645 CALL MUMPS_ABORT() 1646 END IF 1647 IF ( SIZE .NE. POSITION ) CALL DMUMPS_1( BUF_CB, POSITION ) 1648 RETURN 1649 END SUBROUTINE DMUMPS_65 1650 SUBROUTINE DMUMPS_64( INODE, 1651 & NPIV, FPERE, IPOSK, JPOSK, UIP21K, NCOLU, 1652 & NDEST, PDEST, COMM, IERR ) 1653 IMPLICIT NONE 1654 INTEGER INODE, NCOLU, IPOSK, JPOSK, NPIV, NDEST, FPERE 1655 DOUBLE PRECISION UIP21K( NPIV, NCOLU ) 1656 INTEGER PDEST( NDEST ) 1657 INTEGER COMM, IERR 1658 INCLUDE 'mpif.h' 1659 INCLUDE 'mumps_tags.h' 1660 INTEGER POSITION, IREQ, IPOS, SIZE1, SIZE2, SIZE, 1661 & IDEST, IPOSMSG, SSS, SS2 1662 IERR = 0 1663 CALL MPI_PACK_SIZE( 6 + ( NDEST - 1 ) * OVHSIZE, 1664 & MPI_INTEGER, COMM, SIZE1, IERR ) 1665 CALL MPI_PACK_SIZE( abs(NPIV)*NCOLU, MPI_DOUBLE_PRECISION, 1666 & COMM, SIZE2, IERR ) 1667 SIZE = SIZE1 + SIZE2 1668 IF (SIZE.GT.SIZE_RBUF_BYTES) THEN 1669 CALL MPI_PACK_SIZE( 6 , 1670 & MPI_INTEGER, COMM, SSS, IERR ) 1671 CALL MPI_PACK_SIZE( abs(NPIV)*NCOLU, MPI_DOUBLE_PRECISION, 1672 & COMM, SS2, IERR ) 1673 SSS = SSS+SS2 1674 IF (SSS.GT.SIZE_RBUF_BYTES) THEN 1675 IERR = -2 1676 RETURN 1677 ENDIF 1678 END IF 1679 CALL DMUMPS_4( BUF_CB, IPOS, IREQ, SIZE, IERR, 1680 & NDEST, PDEST 1681 & ) 1682 IF ( IERR .LT. 0 ) THEN 1683 RETURN 1684 ENDIF 1685 BUF_CB%ILASTMSG = BUF_CB%ILASTMSG + ( NDEST - 1 ) * OVHSIZE 1686 IPOS = IPOS - OVHSIZE 1687 DO IDEST = 1, NDEST - 1 1688 BUF_CB%CONTENT( IPOS + ( IDEST - 1 ) * OVHSIZE ) = 1689 & IPOS + IDEST * OVHSIZE 1690 END DO 1691 BUF_CB%CONTENT( IPOS + ( NDEST - 1 ) * OVHSIZE ) = 0 1692 IPOSMSG = IPOS + OVHSIZE * NDEST 1693 POSITION = 0 1694 CALL MPI_PACK( INODE, 1, MPI_INTEGER, 1695 & BUF_CB%CONTENT( IPOSMSG ), SIZE, 1696 & POSITION, COMM, IERR ) 1697 CALL MPI_PACK( IPOSK, 1, MPI_INTEGER, 1698 & BUF_CB%CONTENT( IPOSMSG ), SIZE, 1699 & POSITION, COMM, IERR ) 1700 CALL MPI_PACK( JPOSK, 1, MPI_INTEGER, 1701 & BUF_CB%CONTENT( IPOSMSG ), SIZE, 1702 & POSITION, COMM, IERR ) 1703 CALL MPI_PACK( NPIV, 1, MPI_INTEGER, 1704 & BUF_CB%CONTENT( IPOSMSG ), SIZE, 1705 & POSITION, COMM, IERR ) 1706 CALL MPI_PACK( FPERE, 1, MPI_INTEGER, 1707 & BUF_CB%CONTENT( IPOSMSG ), SIZE, 1708 & POSITION, COMM, IERR ) 1709 CALL MPI_PACK( NCOLU, 1, MPI_INTEGER, 1710 & BUF_CB%CONTENT( IPOSMSG ), SIZE, 1711 & POSITION, COMM, IERR ) 1712 CALL MPI_PACK( UIP21K, abs(NPIV) * NCOLU, 1713 & MPI_DOUBLE_PRECISION, 1714 & BUF_CB%CONTENT( IPOSMSG ), SIZE, 1715 & POSITION, COMM, IERR ) 1716 DO IDEST = 1, NDEST 1717 CALL MPI_ISEND( BUF_CB%CONTENT( IPOSMSG ), POSITION, MPI_PACKED, 1718 & PDEST(IDEST), BLOC_FACTO_SYM_SLAVE, COMM, 1719 & BUF_CB%CONTENT( IREQ + ( IDEST-1 ) * OVHSIZE ), 1720 & IERR ) 1721 END DO 1722 SIZE = SIZE - ( NDEST - 1 ) * OVHSIZE * SIZEofINT 1723 IF ( SIZE .LT. POSITION ) THEN 1724 WRITE(*,*) ' Error sending blfac slave : size < position' 1725 WRITE(*,*) ' Size,position=',SIZE,POSITION 1726 CALL MUMPS_ABORT() 1727 END IF 1728 IF ( SIZE .NE. POSITION ) CALL DMUMPS_1( BUF_CB, POSITION ) 1729 RETURN 1730 END SUBROUTINE DMUMPS_64 1731 SUBROUTINE DMUMPS_648( N, ISON, 1732 & NBCOL_SON, NBROW_SON, INDCOL_SON, INDROW_SON, 1733 & LD_SON, VAL_SON, TAG, SUBSET_ROW, SUBSET_COL, 1734 & NSUBSET_ROW, NSUBSET_COL, 1735 & NSUPROW, NSUPCOL, 1736 & NPROW, NPCOL, MBLOCK, RG2L_ROW, RG2L_COL, 1737 & NBLOCK, PDEST, COMM, IERR , 1738 & TAB, TABSIZE, TRANSP, SIZE_PACK, 1739 & N_ALREADY_SENT, KEEP, BBPCBP ) 1740 IMPLICIT NONE 1741 INTEGER N, ISON, NBCOL_SON, NBROW_SON, NSUBSET_ROW, NSUBSET_COL 1742 INTEGER NPROW, NPCOL, MBLOCK, NBLOCK, LD_SON 1743 INTEGER BBPCBP 1744 INTEGER PDEST, TAG, COMM, IERR 1745 INTEGER INDCOL_SON( NBCOL_SON ), INDROW_SON( NBROW_SON ) 1746 INTEGER SUBSET_ROW( NSUBSET_ROW ), SUBSET_COL( NSUBSET_COL ) 1747 INTEGER, DIMENSION(:) :: RG2L_ROW 1748 INTEGER, DIMENSION(:) :: RG2L_COL 1749 INTEGER NSUPROW, NSUPCOL 1750 INTEGER(8), INTENT(IN) :: TABSIZE 1751 INTEGER SIZE_PACK 1752 INTEGER KEEP(500) 1753 DOUBLE PRECISION VAL_SON( LD_SON, * ), TAB(*) 1754 LOGICAL TRANSP 1755 INTEGER N_ALREADY_SENT 1756 INCLUDE 'mpif.h' 1757 INTEGER SIZE1, SIZE2, SIZE_AV, POSITION 1758 INTEGER SIZE_CBP, SIZE_TMP 1759 INTEGER IREQ, IPOS, ITAB 1760 INTEGER ISUB, JSUB, I, J 1761 INTEGER ILOC_ROOT, JLOC_ROOT 1762 INTEGER IPOS_ROOT, JPOS_ROOT 1763 INTEGER IONE 1764 LOGICAL RECV_BUF_SMALLER_THAN_SEND 1765 INTEGER PDEST2(1) 1766 PARAMETER ( IONE=1 ) 1767 INTEGER N_PACKET 1768 INTEGER NSUBSET_ROW_EFF, NSUBSET_COL_EFF, NSUPCOL_EFF 1769 PDEST2(1) = PDEST 1770 IERR = 0 1771 IF ( NSUBSET_ROW * NSUBSET_COL .NE. 0 ) THEN 1772 CALL DMUMPS_79( BUF_CB, SIZE_AV ) 1773 IF (SIZE_AV .LT. SIZE_RBUF_BYTES) THEN 1774 RECV_BUF_SMALLER_THAN_SEND = .FALSE. 1775 ELSE 1776 RECV_BUF_SMALLER_THAN_SEND = .TRUE. 1777 SIZE_AV = SIZE_RBUF_BYTES 1778 ENDIF 1779 SIZE_AV = min(SIZE_AV, SIZE_RBUF_BYTES) 1780 CALL MPI_PACK_SIZE(8 + NSUBSET_COL, 1781 & MPI_INTEGER, COMM, SIZE1, IERR ) 1782 SIZE_CBP = 0 1783 IF (N_ALREADY_SENT .EQ. 0 .AND. 1784 & min(NSUPROW,NSUPCOL) .GT.0) THEN 1785 CALL MPI_PACK_SIZE(NSUPROW, MPI_INTEGER, COMM, 1786 & SIZE_CBP, IERR) 1787 CALL MPI_PACK_SIZE(NSUPCOL, MPI_INTEGER, COMM, 1788 & SIZE_TMP, IERR) 1789 SIZE_CBP = SIZE_CBP + SIZE_TMP 1790 CALL MPI_PACK_SIZE(NSUPROW*NSUPCOL, 1791 & MPI_DOUBLE_PRECISION, COMM, 1792 & SIZE_TMP, IERR) 1793 SIZE_CBP = SIZE_CBP + SIZE_TMP 1794 SIZE1 = SIZE1 + SIZE_CBP 1795 ENDIF 1796 IF (BBPCBP.EQ.1) THEN 1797 NSUBSET_COL_EFF = NSUBSET_COL - NSUPCOL 1798 NSUPCOL_EFF = 0 1799 ELSE 1800 NSUBSET_COL_EFF = NSUBSET_COL 1801 NSUPCOL_EFF = NSUPCOL 1802 ENDIF 1803 NSUBSET_ROW_EFF = NSUBSET_ROW - NSUPROW 1804 N_PACKET = 1805 & (SIZE_AV - SIZE1) / (SIZEofINT + NSUBSET_COL_EFF * SIZEofREAL) 1806 10 CONTINUE 1807 N_PACKET = min( N_PACKET, 1808 & NSUBSET_ROW_EFF-N_ALREADY_SENT ) 1809 IF (N_PACKET .LE. 0 .AND. 1810 & NSUBSET_ROW_EFF-N_ALREADY_SENT.GT.0) THEN 1811 IF (RECV_BUF_SMALLER_THAN_SEND) THEN 1812 IERR=-3 1813 GOTO 100 1814 ELSE 1815 IERR = -1 1816 GOTO 100 1817 ENDIF 1818 ENDIF 1819 CALL MPI_PACK_SIZE( 8 + NSUBSET_COL_EFF + N_PACKET, 1820 & MPI_INTEGER, COMM, SIZE1, IERR ) 1821 SIZE1 = SIZE1 + SIZE_CBP 1822 CALL MPI_PACK_SIZE( N_PACKET * NSUBSET_COL_EFF, 1823 & MPI_DOUBLE_PRECISION, 1824 & COMM, SIZE2, IERR ) 1825 SIZE_PACK = SIZE1 + SIZE2 1826 IF (SIZE_PACK .GT. SIZE_AV) THEN 1827 N_PACKET = N_PACKET - 1 1828 IF ( N_PACKET > 0 ) THEN 1829 GOTO 10 1830 ELSE 1831 IF (RECV_BUF_SMALLER_THAN_SEND) THEN 1832 IERR = -3 1833 GOTO 100 1834 ELSE 1835 IERR = -1 1836 GOTO 100 1837 ENDIF 1838 ENDIF 1839 ENDIF 1840#if ! defined(DBG_SMB3) 1841 IF (N_PACKET + N_ALREADY_SENT .NE. NSUBSET_ROW - NSUPROW 1842 & .AND. 1843 & SIZE_PACK .LT. SIZE_RBUF_BYTES / 4 1844 & .AND. .NOT. RECV_BUF_SMALLER_THAN_SEND) 1845 & THEN 1846 IERR = -1 1847 GOTO 100 1848 ENDIF 1849#endif 1850 ELSE 1851 N_PACKET = 0 1852 CALL MPI_PACK_SIZE(8,MPI_INTEGER, COMM, SIZE_PACK, IERR ) 1853 END IF 1854 CALL DMUMPS_4( BUF_CB, IPOS, IREQ, SIZE_PACK, IERR, 1855 & IONE, PDEST2 1856 & ) 1857 IF ( IERR .LT. 0 ) GOTO 100 1858 IF ( SIZE_PACK.GT.SIZE_RBUF_BYTES ) THEN 1859 IERR = -3 1860 GOTO 100 1861 ENDIF 1862 POSITION = 0 1863 CALL MPI_PACK( ISON, 1, MPI_INTEGER, 1864 & BUF_CB%CONTENT( IPOS ), 1865 & SIZE_PACK, POSITION, COMM, IERR ) 1866 CALL MPI_PACK( NSUBSET_ROW, 1, MPI_INTEGER, 1867 & BUF_CB%CONTENT( IPOS ), 1868 & SIZE_PACK, POSITION, COMM, IERR ) 1869 CALL MPI_PACK( NSUPROW, 1, MPI_INTEGER, 1870 & BUF_CB%CONTENT( IPOS ), 1871 & SIZE_PACK, POSITION, COMM, IERR ) 1872 CALL MPI_PACK( NSUBSET_COL, 1, MPI_INTEGER, 1873 & BUF_CB%CONTENT( IPOS ), 1874 & SIZE_PACK, POSITION, COMM, IERR ) 1875 CALL MPI_PACK( NSUPCOL, 1, MPI_INTEGER, 1876 & BUF_CB%CONTENT( IPOS ), 1877 & SIZE_PACK, POSITION, COMM, IERR ) 1878 CALL MPI_PACK( N_ALREADY_SENT, 1, MPI_INTEGER, 1879 & BUF_CB%CONTENT( IPOS ), 1880 & SIZE_PACK, POSITION, COMM, IERR ) 1881 CALL MPI_PACK( N_PACKET, 1, MPI_INTEGER, 1882 & BUF_CB%CONTENT( IPOS ), 1883 & SIZE_PACK, POSITION, COMM, IERR ) 1884 CALL MPI_PACK( BBPCBP, 1, MPI_INTEGER, 1885 & BUF_CB%CONTENT( IPOS ), 1886 & SIZE_PACK, POSITION, COMM, IERR ) 1887 IF ( NSUBSET_ROW * NSUBSET_COL .NE. 0 ) THEN 1888 IF (N_ALREADY_SENT .EQ. 0 .AND. 1889 & min(NSUPROW, NSUPCOL) .GT. 0) THEN 1890 DO ISUB = NSUBSET_ROW-NSUPROW+1, NSUBSET_ROW 1891 I = SUBSET_ROW( ISUB ) 1892 IPOS_ROOT = RG2L_ROW(INDCOL_SON( I )) 1893 ILOC_ROOT = MBLOCK 1894 & * ( ( IPOS_ROOT - 1 ) / ( MBLOCK * NPROW ) ) 1895 & + mod( IPOS_ROOT - 1, MBLOCK ) + 1 1896 CALL MPI_PACK( ILOC_ROOT, 1, MPI_INTEGER, 1897 & BUF_CB%CONTENT( IPOS ), 1898 & SIZE_PACK, POSITION, COMM, IERR ) 1899 ENDDO 1900 DO ISUB = NSUBSET_COL-NSUPCOL+1, NSUBSET_COL 1901 J = SUBSET_COL( ISUB ) 1902 JPOS_ROOT = INDROW_SON( J ) - N 1903 JLOC_ROOT = NBLOCK 1904 & * ( ( JPOS_ROOT - 1 ) / ( NBLOCK * NPCOL ) ) 1905 & + mod( JPOS_ROOT - 1, NBLOCK ) + 1 1906 CALL MPI_PACK( JLOC_ROOT, 1, MPI_INTEGER, 1907 & BUF_CB%CONTENT( IPOS ), 1908 & SIZE_PACK, POSITION, COMM, IERR ) 1909 ENDDO 1910 IF ( TABSIZE.GE.int(NSUPROW,8)*int(NSUPCOL,8) ) THEN 1911 ITAB = 1 1912 DO JSUB = NSUBSET_ROW - NSUPROW+1, NSUBSET_ROW 1913 J = SUBSET_ROW(JSUB) 1914 DO ISUB = NSUBSET_COL - NSUPCOL+1, NSUBSET_COL 1915 I = SUBSET_COL(ISUB) 1916 TAB(ITAB) = VAL_SON(J, I) 1917 ITAB = ITAB + 1 1918 ENDDO 1919 ENDDO 1920 CALL MPI_PACK(TAB(1), NSUPROW*NSUPCOL, 1921 & MPI_DOUBLE_PRECISION, 1922 & BUF_CB%CONTENT( IPOS ), 1923 & SIZE_PACK, POSITION, COMM, IERR ) 1924 ELSE 1925 DO JSUB = NSUBSET_ROW - NSUPROW+1, NSUBSET_ROW 1926 J = SUBSET_ROW(JSUB) 1927 DO ISUB = NSUBSET_COL - NSUPCOL+1, NSUBSET_COL 1928 I = SUBSET_COL(ISUB) 1929 CALL MPI_PACK(VAL_SON(J,I), 1, 1930 & MPI_DOUBLE_PRECISION, 1931 & BUF_CB%CONTENT( IPOS ), 1932 & SIZE_PACK, POSITION, COMM, IERR ) 1933 ENDDO 1934 ENDDO 1935 ENDIF 1936 ENDIF 1937 IF ( .NOT. TRANSP ) THEN 1938 DO ISUB = N_ALREADY_SENT+1, N_ALREADY_SENT+N_PACKET 1939 I = SUBSET_ROW( ISUB ) 1940 IPOS_ROOT = RG2L_ROW( INDROW_SON( I ) ) 1941 ILOC_ROOT = MBLOCK 1942 & * ( ( IPOS_ROOT - 1 ) / ( MBLOCK * NPROW ) ) 1943 & + mod( IPOS_ROOT - 1, MBLOCK ) + 1 1944 CALL MPI_PACK( ILOC_ROOT, 1, MPI_INTEGER, 1945 & BUF_CB%CONTENT( IPOS ), 1946 & SIZE_PACK, POSITION, COMM, IERR ) 1947 END DO 1948 DO JSUB = 1, NSUBSET_COL_EFF - NSUPCOL_EFF 1949 J = SUBSET_COL( JSUB ) 1950 JPOS_ROOT = RG2L_COL( INDCOL_SON( J ) ) 1951 JLOC_ROOT = NBLOCK 1952 & * ( ( JPOS_ROOT - 1 ) / ( NBLOCK * NPCOL ) ) 1953 & + mod( JPOS_ROOT - 1, NBLOCK ) + 1 1954 CALL MPI_PACK( JLOC_ROOT, 1, MPI_INTEGER, 1955 & BUF_CB%CONTENT( IPOS ), 1956 & SIZE_PACK, POSITION, COMM, IERR ) 1957 END DO 1958 DO JSUB = NSUBSET_COL_EFF-NSUPCOL_EFF+1, NSUBSET_COL_EFF 1959 J = SUBSET_COL( JSUB ) 1960 JPOS_ROOT = INDCOL_SON( J ) - N 1961 JLOC_ROOT = NBLOCK 1962 & * ( ( JPOS_ROOT - 1 ) / ( NBLOCK * NPCOL ) ) 1963 & + mod( JPOS_ROOT - 1, NBLOCK ) + 1 1964 CALL MPI_PACK( JLOC_ROOT, 1, MPI_INTEGER, 1965 & BUF_CB%CONTENT( IPOS ), 1966 & SIZE_PACK, POSITION, COMM, IERR ) 1967 ENDDO 1968 ELSE 1969 DO JSUB = N_ALREADY_SENT+1, N_ALREADY_SENT+N_PACKET 1970 J = SUBSET_ROW( JSUB ) 1971 IPOS_ROOT = RG2L_ROW( INDCOL_SON( J ) ) 1972 ILOC_ROOT = MBLOCK 1973 & * ( ( IPOS_ROOT - 1 ) / ( MBLOCK * NPROW ) ) 1974 & + mod( IPOS_ROOT - 1, MBLOCK ) + 1 1975 CALL MPI_PACK( ILOC_ROOT, 1, MPI_INTEGER, 1976 & BUF_CB%CONTENT( IPOS ), 1977 & SIZE_PACK, POSITION, COMM, IERR ) 1978 END DO 1979 DO ISUB = 1, NSUBSET_COL_EFF - NSUPCOL_EFF 1980 I = SUBSET_COL( ISUB ) 1981 JPOS_ROOT = RG2L_COL( INDROW_SON( I ) ) 1982 JLOC_ROOT = NBLOCK 1983 & * ( ( JPOS_ROOT - 1 ) / ( NBLOCK * NPCOL ) ) 1984 & + mod( JPOS_ROOT - 1, NBLOCK ) + 1 1985 CALL MPI_PACK( JLOC_ROOT, 1, MPI_INTEGER, 1986 & BUF_CB%CONTENT( IPOS ), 1987 & SIZE_PACK, POSITION, COMM, IERR ) 1988 END DO 1989 DO ISUB = NSUBSET_COL_EFF - NSUPCOL_EFF + 1, NSUBSET_COL_EFF 1990 I = SUBSET_COL( ISUB ) 1991 JPOS_ROOT = INDROW_SON(I) - N 1992 JLOC_ROOT = NBLOCK 1993 & * ( ( JPOS_ROOT - 1 ) / ( NBLOCK * NPCOL ) ) 1994 & + mod( JPOS_ROOT - 1, NBLOCK ) + 1 1995 CALL MPI_PACK( JLOC_ROOT, 1, MPI_INTEGER, 1996 & BUF_CB%CONTENT( IPOS ), 1997 & SIZE_PACK, POSITION, COMM, IERR ) 1998 ENDDO 1999 END IF 2000 IF ( TABSIZE.GE.int(N_PACKET,8)*int(NSUBSET_COL_EFF,8) ) THEN 2001 IF ( .NOT. TRANSP ) THEN 2002 ITAB = 1 2003 DO ISUB = N_ALREADY_SENT+1, 2004 & N_ALREADY_SENT+N_PACKET 2005 I = SUBSET_ROW( ISUB ) 2006 DO JSUB = 1, NSUBSET_COL_EFF 2007 J = SUBSET_COL( JSUB ) 2008 TAB( ITAB ) = VAL_SON(J,I) 2009 ITAB = ITAB + 1 2010 END DO 2011 END DO 2012 CALL MPI_PACK(TAB(1), NSUBSET_COL_EFF*N_PACKET, 2013 & MPI_DOUBLE_PRECISION, 2014 & BUF_CB%CONTENT( IPOS ), 2015 & SIZE_PACK, POSITION, COMM, IERR ) 2016 ELSE 2017 ITAB = 1 2018 DO JSUB = N_ALREADY_SENT+1, N_ALREADY_SENT+N_PACKET 2019 J = SUBSET_ROW( JSUB ) 2020 DO ISUB = 1, NSUBSET_COL_EFF 2021 I = SUBSET_COL( ISUB ) 2022 TAB( ITAB ) = VAL_SON( J, I ) 2023 ITAB = ITAB + 1 2024 END DO 2025 END DO 2026 CALL MPI_PACK(TAB(1), NSUBSET_COL_EFF*N_PACKET, 2027 & MPI_DOUBLE_PRECISION, 2028 & BUF_CB%CONTENT( IPOS ), 2029 & SIZE_PACK, POSITION, COMM, IERR ) 2030 END IF 2031 ELSE 2032 IF ( .NOT. TRANSP ) THEN 2033 DO ISUB = N_ALREADY_SENT+1, N_ALREADY_SENT+N_PACKET 2034 I = SUBSET_ROW( ISUB ) 2035 DO JSUB = 1, NSUBSET_COL_EFF 2036 J = SUBSET_COL( JSUB ) 2037 CALL MPI_PACK( VAL_SON( J, I ), 1, 2038 & MPI_DOUBLE_PRECISION, 2039 & BUF_CB%CONTENT( IPOS ), 2040 & SIZE_PACK, POSITION, COMM, IERR ) 2041 END DO 2042 END DO 2043 ELSE 2044 DO JSUB = N_ALREADY_SENT+1, N_ALREADY_SENT+N_PACKET 2045 J = SUBSET_ROW( JSUB ) 2046 DO ISUB = 1, NSUBSET_COL_EFF 2047 I = SUBSET_COL( ISUB ) 2048 CALL MPI_PACK( VAL_SON( J, I ), 1, 2049 & MPI_DOUBLE_PRECISION, 2050 & BUF_CB%CONTENT( IPOS ), 2051 & SIZE_PACK, POSITION, COMM, IERR ) 2052 END DO 2053 END DO 2054 END IF 2055 ENDIF 2056 END IF 2057 CALL MPI_ISEND( BUF_CB%CONTENT( IPOS ), POSITION, MPI_PACKED, 2058 & PDEST, TAG, COMM, BUF_CB%CONTENT( IREQ ), IERR ) 2059 IF ( SIZE_PACK .LT. POSITION ) THEN 2060 WRITE(*,*) ' Error sending contribution to root:Size<positn' 2061 WRITE(*,*) ' Size,position=',SIZE_PACK,POSITION 2062 CALL MUMPS_ABORT() 2063 END IF 2064 IF ( SIZE_PACK .NE. POSITION ) 2065 & CALL DMUMPS_1( BUF_CB, POSITION ) 2066 N_ALREADY_SENT = N_ALREADY_SENT + N_PACKET 2067 IF (NSUBSET_ROW * NSUBSET_COL .NE. 0) THEN 2068 IF ( N_ALREADY_SENT.NE.NSUBSET_ROW_EFF ) IERR = -1 2069 ENDIF 2070 100 CONTINUE 2071 RETURN 2072 END SUBROUTINE DMUMPS_648 2073 SUBROUTINE DMUMPS_76( ISON, NELIM, 2074 & NELIM_ROW, NELIM_COL, NSLAVES, SLAVES, 2075 & DEST, COMM, IERR ) 2076 INTEGER ISON, NELIM 2077 INTEGER NSLAVES, DEST, COMM, IERR 2078 INTEGER NELIM_ROW( NELIM ), NELIM_COL( NELIM ) 2079 INTEGER SLAVES( NSLAVES ) 2080 INCLUDE 'mpif.h' 2081 INCLUDE 'mumps_tags.h' 2082 INTEGER SIZE, POSITION, IPOS, IREQ 2083 INTEGER IONE 2084 INTEGER DEST2(1) 2085 PARAMETER ( IONE=1 ) 2086 DEST2(1) = DEST 2087 IERR = 0 2088 SIZE = ( 3 + NSLAVES + 2 * NELIM ) * SIZEofINT 2089 CALL DMUMPS_4( BUF_CB, IPOS, IREQ, SIZE, IERR, 2090 & IONE, DEST2 2091 & ) 2092 IF ( IERR .LT. 0 ) THEN 2093 RETURN 2094 ENDIF 2095 IF (SIZE.GT.SIZE_RBUF_BYTES) THEN 2096 IERR = -3 2097 RETURN 2098 ENDIF 2099 POSITION = IPOS 2100 BUF_CB%CONTENT( POSITION ) = ISON 2101 POSITION = POSITION + 1 2102 BUF_CB%CONTENT( POSITION ) = NELIM 2103 POSITION = POSITION + 1 2104 BUF_CB%CONTENT( POSITION ) = NSLAVES 2105 POSITION = POSITION + 1 2106 BUF_CB%CONTENT( POSITION: POSITION + NELIM - 1 ) = NELIM_ROW 2107 POSITION = POSITION + NELIM 2108 BUF_CB%CONTENT( POSITION: POSITION + NELIM - 1 ) = NELIM_COL 2109 POSITION = POSITION + NELIM 2110 BUF_CB%CONTENT( POSITION: POSITION + NSLAVES - 1 ) = SLAVES 2111 POSITION = POSITION + NSLAVES 2112 POSITION = POSITION - IPOS 2113 IF ( POSITION * SIZEofINT .NE. SIZE ) THEN 2114 WRITE(*,*) 'Error in DMUMPS_BUF_SEND_ROOT_NELIM_INDICES:', 2115 & 'wrong estimated size' 2116 CALL MUMPS_ABORT() 2117 END IF 2118 CALL MPI_ISEND( BUF_CB%CONTENT( IPOS ), SIZE, 2119 & MPI_PACKED, 2120 & DEST, ROOT_NELIM_INDICES, COMM, 2121 & BUF_CB%CONTENT( IREQ ), IERR ) 2122 RETURN 2123 END SUBROUTINE DMUMPS_76 2124 SUBROUTINE DMUMPS_74( ISON, NELIM_ROOT, 2125 & DEST, COMM, IERR ) 2126 IMPLICIT NONE 2127 INTEGER ISON, NELIM_ROOT, DEST, COMM, IERR 2128 INCLUDE 'mpif.h' 2129 INCLUDE 'mumps_tags.h' 2130 INTEGER IPOS, IREQ, SIZE 2131 INTEGER IONE 2132 INTEGER DEST2(1) 2133 PARAMETER ( IONE=1 ) 2134 DEST2(1)=DEST 2135 IERR = 0 2136 SIZE = 2 * SIZEofINT 2137 CALL DMUMPS_4( BUF_SMALL, IPOS, IREQ, SIZE, IERR, 2138 & IONE, DEST2 2139 & ) 2140 IF ( IERR .LT. 0 ) THEN 2141 WRITE(*,*) 'Internal error 1 with small buffers ' 2142 CALL MUMPS_ABORT() 2143 END IF 2144 IF ( IERR .LT. 0 ) THEN 2145 RETURN 2146 ENDIF 2147 BUF_SMALL%CONTENT( IPOS ) = ISON 2148 BUF_SMALL%CONTENT( IPOS + 1 ) = NELIM_ROOT 2149 CALL MPI_ISEND( BUF_SMALL%CONTENT( IPOS ), SIZE, 2150 & MPI_PACKED, 2151 & DEST, ROOT_2SON, COMM, 2152 & BUF_SMALL%CONTENT( IREQ ), IERR ) 2153 RETURN 2154 END SUBROUTINE DMUMPS_74 2155 SUBROUTINE DMUMPS_73 2156 & ( TOT_ROOT_SIZE, TOT_CONT2RECV, DEST, COMM, IERR ) 2157 IMPLICIT NONE 2158 INTEGER TOT_ROOT_SIZE, TOT_CONT2RECV, DEST, COMM, IERR 2159 INCLUDE 'mpif.h' 2160 INCLUDE 'mumps_tags.h' 2161 INTEGER SIZE, IPOS, IREQ 2162 INTEGER IONE 2163 INTEGER DEST2(1) 2164 PARAMETER ( IONE=1 ) 2165 IERR = 0 2166 DEST2(1) = DEST 2167 SIZE = 2 * SIZEofINT 2168 CALL DMUMPS_4( BUF_SMALL, IPOS, IREQ, SIZE, IERR, 2169 & IONE, DEST2 2170 & ) 2171 IF ( IERR .LT. 0 ) THEN 2172 WRITE(*,*) 'Internal error 2 with small buffers ' 2173 CALL MUMPS_ABORT() 2174 END IF 2175 IF ( IERR .LT. 0 ) THEN 2176 RETURN 2177 ENDIF 2178 BUF_SMALL%CONTENT( IPOS ) = TOT_ROOT_SIZE 2179 BUF_SMALL%CONTENT( IPOS + 1 ) = TOT_CONT2RECV 2180 CALL MPI_ISEND( BUF_SMALL%CONTENT( IPOS ), SIZE, 2181 & MPI_PACKED, 2182 & DEST, ROOT_2SLAVE, COMM, 2183 & BUF_SMALL%CONTENT( IREQ ), IERR ) 2184 RETURN 2185 END SUBROUTINE DMUMPS_73 2186 SUBROUTINE DMUMPS_63 2187 & ( NRHS, INODE, W, LW, LD_W, DEST,MSGTAG,COMM,IERR ) 2188 IMPLICIT NONE 2189 INTEGER NRHS, INODE,LW,COMM,IERR,DEST,MSGTAG, LD_W 2190 DOUBLE PRECISION W(LD_W, *) 2191 INCLUDE 'mpif.h' 2192 INTEGER SIZE, SIZE1, SIZE2 2193 INTEGER POSITION, IREQ, IPOS 2194 INTEGER IONE, K 2195 INTEGER DEST2(1) 2196 PARAMETER ( IONE=1 ) 2197 IERR = 0 2198 DEST2(1) = DEST 2199 CALL MPI_PACK_SIZE( 2 , MPI_INTEGER, COMM, SIZE1, IERR ) 2200 CALL MPI_PACK_SIZE( LW*NRHS, MPI_DOUBLE_PRECISION, COMM, 2201 & SIZE2, IERR ) 2202 SIZE = SIZE1 + SIZE2 2203 CALL DMUMPS_4( BUF_CB, IPOS, IREQ, SIZE, IERR, 2204 & IONE, DEST2 2205 & ) 2206 IF ( IERR .LT. 0 ) THEN 2207 RETURN 2208 ENDIF 2209 POSITION = 0 2210 CALL MPI_PACK( INODE, 1, MPI_INTEGER, 2211 & BUF_CB%CONTENT( IPOS ), SIZE, 2212 & POSITION, COMM, IERR ) 2213 CALL MPI_PACK( LW , 1, MPI_INTEGER, 2214 & BUF_CB%CONTENT( IPOS ), SIZE, 2215 & POSITION, COMM, IERR ) 2216 DO K=1, NRHS 2217 CALL MPI_PACK( W(1,K), LW, MPI_DOUBLE_PRECISION, 2218 & BUF_CB%CONTENT( IPOS ), SIZE, 2219 & POSITION, COMM, IERR ) 2220 END DO 2221 CALL MPI_ISEND( BUF_CB%CONTENT( IPOS ), POSITION, MPI_PACKED, 2222 & DEST, MSGTAG, COMM, 2223 & BUF_CB%CONTENT( IREQ ), IERR ) 2224 IF ( SIZE .LT. POSITION ) THEN 2225 WRITE(*,*) 'Try_update: SIZE, POSITION = ', 2226 & SIZE, POSITION 2227 CALL MUMPS_ABORT() 2228 END IF 2229 IF ( SIZE .NE. POSITION ) CALL DMUMPS_1( BUF_CB, POSITION ) 2230 RETURN 2231 END SUBROUTINE DMUMPS_63 2232 SUBROUTINE DMUMPS_77 2233 & ( BDC_SBTR,BDC_MEM,BDC_MD, COMM, NPROCS, LOAD, 2234 & MEM,SBTR_CUR, 2235 & LU_USAGE, 2236#if ! defined(OLD_LOAD_MECHANISM) 2237 & FUTURE_NIV2, 2238#endif 2239 & MYID, IERR) 2240 IMPLICIT NONE 2241 INTEGER COMM, NPROCS, MYID, IERR 2242#if ! defined(OLD_LOAD_MECHANISM) 2243 INTEGER FUTURE_NIV2(NPROCS) 2244#endif 2245 DOUBLE PRECISION LU_USAGE 2246 DOUBLE PRECISION LOAD 2247 DOUBLE PRECISION MEM,SBTR_CUR 2248 LOGICAL BDC_MEM,BDC_SBTR,BDC_MD 2249 INCLUDE 'mpif.h' 2250 INCLUDE 'mumps_tags.h' 2251 INTEGER POSITION, IREQ, IPOS, SIZE1, SIZE2, SIZE 2252 INTEGER I, NDEST, IDEST, IPOSMSG, WHAT, NREALS 2253 INTEGER IZERO 2254 INTEGER MYID2(1) 2255 PARAMETER ( IZERO=0 ) 2256 IERR = 0 2257 MYID2(1) = MYID 2258 NDEST = NPROCS - 1 2259#if ! defined(OLD_LOAD_MECHANISM) 2260 NDEST = 0 2261 DO I = 1, NPROCS 2262 IF ( I .NE. MYID + 1 .AND. FUTURE_NIV2(I).NE.0) THEN 2263 NDEST = NDEST + 1 2264 ENDIF 2265 ENDDO 2266#endif 2267 IF ( NDEST .eq. 0 ) THEN 2268 RETURN 2269 ENDIF 2270 CALL MPI_PACK_SIZE( 1 + (NDEST-1) * OVHSIZE, 2271 & MPI_INTEGER, COMM, 2272 & SIZE1, IERR ) 2273 NREALS = 1 2274 IF (BDC_MEM) THEN 2275 NREALS = 2 2276 ENDIf 2277 IF (BDC_SBTR)THEN 2278 NREALS = 3 2279 ENDIF 2280 IF(BDC_MD)THEN 2281 NREALS=NREALS+1 2282 ENDIF 2283 CALL MPI_PACK_SIZE( NREALS, MPI_DOUBLE_PRECISION, 2284 & COMM, SIZE2, IERR ) 2285 SIZE = SIZE1 + SIZE2 2286 CALL DMUMPS_4( BUF_LOAD, IPOS, IREQ, SIZE, IERR, 2287 & IZERO, MYID2 2288 & ) 2289 IF ( IERR .LT. 0 ) THEN 2290 RETURN 2291 ENDIF 2292 BUF_LOAD%ILASTMSG = BUF_LOAD%ILASTMSG + ( NDEST - 1 ) * OVHSIZE 2293 IPOS = IPOS - OVHSIZE 2294 DO IDEST = 1, NDEST - 1 2295 BUF_LOAD%CONTENT( IPOS + ( IDEST - 1 ) * OVHSIZE ) = 2296 & IPOS + IDEST * OVHSIZE 2297 END DO 2298 BUF_LOAD%CONTENT( IPOS + ( NDEST - 1 ) * OVHSIZE ) = 0 2299 IPOSMSG = IPOS + OVHSIZE * NDEST 2300 WHAT = 0 2301 POSITION = 0 2302 CALL MPI_PACK( WHAT, 1, MPI_INTEGER, 2303 & BUF_LOAD%CONTENT( IPOSMSG ), SIZE, 2304 & POSITION, COMM, IERR ) 2305 CALL MPI_PACK( LOAD, 1, MPI_DOUBLE_PRECISION, 2306 & BUF_LOAD%CONTENT( IPOSMSG ), SIZE, 2307 & POSITION, COMM, IERR ) 2308 IF (BDC_MEM) THEN 2309 CALL MPI_PACK( MEM, 1, MPI_DOUBLE_PRECISION, 2310 & BUF_LOAD%CONTENT( IPOSMSG ), SIZE, 2311 & POSITION, COMM, IERR ) 2312 END IF 2313 IF (BDC_SBTR) THEN 2314 CALL MPI_PACK( SBTR_CUR, 1, MPI_DOUBLE_PRECISION, 2315 & BUF_LOAD%CONTENT( IPOSMSG ), SIZE, 2316 & POSITION, COMM, IERR ) 2317 END IF 2318 IF(BDC_MD)THEN 2319 CALL MPI_PACK( LU_USAGE, 1, MPI_DOUBLE_PRECISION, 2320 & BUF_LOAD%CONTENT( IPOSMSG ), SIZE, 2321 & POSITION, COMM, IERR ) 2322 ENDIF 2323 IDEST = 0 2324 DO I = 0, NPROCS - 1 2325#if ! defined(OLD_LOAD_MECHANISM) 2326 IF ( I .NE. MYID .AND. FUTURE_NIV2(I+1) .NE. 0) THEN 2327#else 2328 IF ( I .ne. MYID ) THEN 2329#endif 2330 IDEST = IDEST + 1 2331 CALL MPI_ISEND( BUF_LOAD%CONTENT( IPOSMSG ), 2332 & POSITION, MPI_PACKED, I, 2333 & UPDATE_LOAD, COMM, 2334 & BUF_LOAD%CONTENT( IREQ+(IDEST-1)*OVHSIZE ), 2335 & IERR ) 2336 END IF 2337 END DO 2338 SIZE = SIZE - ( NDEST - 1 ) * OVHSIZE * SIZEofINT 2339 IF ( SIZE .LT. POSITION ) THEN 2340 WRITE(*,*) ' Error in DMUMPS_77' 2341 WRITE(*,*) ' Size,position=',SIZE,POSITION 2342 CALL MUMPS_ABORT() 2343 END IF 2344 IF ( SIZE .NE. POSITION ) 2345 & CALL DMUMPS_1( BUF_LOAD, POSITION ) 2346 RETURN 2347 END SUBROUTINE DMUMPS_77 2348 SUBROUTINE DMUMPS_460 2349 & ( WHAT, COMM, NPROCS, 2350#if ! defined(OLD_LOAD_MECHANISM) 2351 & FUTURE_NIV2, 2352#endif 2353 & LOAD,UPD_LOAD, 2354 & MYID, IERR) 2355 IMPLICIT NONE 2356 INTEGER COMM, NPROCS, MYID, IERR, WHAT 2357 DOUBLE PRECISION LOAD,UPD_LOAD 2358 INCLUDE 'mpif.h' 2359 INCLUDE 'mumps_tags.h' 2360 INTEGER POSITION, IREQ, IPOS, SIZE1, SIZE2, SIZE 2361 INTEGER I, NDEST, IDEST, IPOSMSG, NREALS 2362 INTEGER IZERO 2363 INTEGER MYID2(1) 2364#if ! defined(OLD_LOAD_MECHANISM) 2365 INTEGER FUTURE_NIV2(NPROCS) 2366#endif 2367 PARAMETER ( IZERO=0 ) 2368 IERR = 0 2369 IF (WHAT .NE. 2 .AND. WHAT .NE. 3 .AND. 2370 & WHAT.NE.6.AND. WHAT.NE.8 .AND.WHAT.NE.9.AND. 2371 & WHAT.NE.17) THEN 2372 WRITE(*,*) 2373 & "Internal error 1 in DMUMPS_460",WHAT 2374 END IF 2375 MYID2(1) = MYID 2376 NDEST = NPROCS - 1 2377#if ! defined(OLD_LOAD_MECHANISM) 2378 NDEST = 0 2379 DO I = 1, NPROCS 2380 IF ( I .NE. MYID + 1 .AND. FUTURE_NIV2(I).NE.0) THEN 2381 NDEST = NDEST + 1 2382 ENDIF 2383 ENDDO 2384#endif 2385 IF ( NDEST .eq. 0 ) THEN 2386 RETURN 2387 ENDIF 2388 CALL MPI_PACK_SIZE( 1 + (NDEST-1) * OVHSIZE, 2389 & MPI_INTEGER, COMM, 2390 & SIZE1, IERR ) 2391 IF((WHAT.NE.17).AND.(WHAT.NE.10))THEN 2392 NREALS = 1 2393 ELSE 2394 NREALS = 2 2395 ENDIF 2396 CALL MPI_PACK_SIZE( NREALS, MPI_DOUBLE_PRECISION, 2397 & COMM, SIZE2, IERR ) 2398 SIZE = SIZE1 + SIZE2 2399 CALL DMUMPS_4( BUF_LOAD, IPOS, IREQ, SIZE, IERR, 2400 & IZERO, MYID2 2401 & ) 2402 IF ( IERR .LT. 0 ) THEN 2403 RETURN 2404 ENDIF 2405 BUF_LOAD%ILASTMSG = BUF_LOAD%ILASTMSG + ( NDEST - 1 ) * OVHSIZE 2406 IPOS = IPOS - OVHSIZE 2407 DO IDEST = 1, NDEST - 1 2408 BUF_LOAD%CONTENT( IPOS + ( IDEST - 1 ) * OVHSIZE ) = 2409 & IPOS + IDEST * OVHSIZE 2410 END DO 2411 BUF_LOAD%CONTENT( IPOS + ( NDEST - 1 ) * OVHSIZE ) = 0 2412 IPOSMSG = IPOS + OVHSIZE * NDEST 2413 POSITION = 0 2414 CALL MPI_PACK( WHAT, 1, MPI_INTEGER, 2415 & BUF_LOAD%CONTENT( IPOSMSG ), SIZE, 2416 & POSITION, COMM, IERR ) 2417 CALL MPI_PACK( LOAD, 1, MPI_DOUBLE_PRECISION, 2418 & BUF_LOAD%CONTENT( IPOSMSG ), SIZE, 2419 & POSITION, COMM, IERR ) 2420 IF((WHAT.EQ.17).OR.(WHAT.EQ.10))THEN 2421 CALL MPI_PACK( UPD_LOAD, 1, MPI_DOUBLE_PRECISION, 2422 & BUF_LOAD%CONTENT( IPOSMSG ), SIZE, 2423 & POSITION, COMM, IERR ) 2424 ENDIF 2425 IDEST = 0 2426 DO I = 0, NPROCS - 1 2427#if ! defined(OLD_LOAD_MECHANISM) 2428 IF ( I .NE. MYID .AND. FUTURE_NIV2(I+1) .NE. 0) THEN 2429#else 2430 IF ( I .ne. MYID ) THEN 2431#endif 2432 IDEST = IDEST + 1 2433 CALL MPI_ISEND( BUF_LOAD%CONTENT( IPOSMSG ), 2434 & POSITION, MPI_PACKED, I, 2435 & UPDATE_LOAD, COMM, 2436 & BUF_LOAD%CONTENT( IREQ+(IDEST-1)*OVHSIZE ), 2437 & IERR ) 2438 END IF 2439 END DO 2440 SIZE = SIZE - ( NDEST - 1 ) * OVHSIZE * SIZEofINT 2441 IF ( SIZE .LT. POSITION ) THEN 2442 WRITE(*,*) ' Error in DMUMPS_460' 2443 WRITE(*,*) ' Size,position=',SIZE,POSITION 2444 CALL MUMPS_ABORT() 2445 END IF 2446 IF ( SIZE .NE. POSITION ) 2447 & CALL DMUMPS_1( BUF_LOAD, POSITION ) 2448 RETURN 2449 END SUBROUTINE DMUMPS_460 2450 SUBROUTINE DMUMPS_519 2451 & ( WHAT, COMM, NPROCS, 2452 & FATHER_NODE,INODE,NCB,K81, 2453 & MYID,REMOTE, IERR) 2454 IMPLICIT NONE 2455 INTEGER COMM, NPROCS, MYID, IERR, WHAT,REMOTE 2456 INTEGER FATHER_NODE,INODE 2457 INCLUDE 'mpif.h' 2458 INCLUDE 'mumps_tags.h' 2459 INTEGER POSITION, IREQ, IPOS, SIZE 2460 INTEGER NDEST, IDEST, IPOSMSG 2461 INTEGER IZERO,NCB,K81 2462 INTEGER MYID2(1) 2463 PARAMETER ( IZERO=0 ) 2464 MYID2(1) = MYID 2465 NDEST = 1 2466 IF ( NDEST .eq. 0 ) THEN 2467 RETURN 2468 ENDIF 2469 IF((K81.EQ.2).OR.(K81.EQ.3))THEN 2470 CALL MPI_PACK_SIZE( 4 + OVHSIZE, 2471 & MPI_INTEGER, COMM, 2472 & SIZE, IERR ) 2473 ELSE 2474 CALL MPI_PACK_SIZE( 2 + OVHSIZE, 2475 & MPI_INTEGER, COMM, 2476 & SIZE, IERR ) 2477 ENDIF 2478 CALL DMUMPS_4( BUF_LOAD, IPOS, IREQ, SIZE, IERR, 2479 & IZERO, MYID2 2480 & ) 2481 IF ( IERR .LT. 0 ) THEN 2482 RETURN 2483 ENDIF 2484 BUF_LOAD%ILASTMSG = BUF_LOAD%ILASTMSG + ( NDEST - 1 ) * OVHSIZE 2485 IPOS = IPOS - OVHSIZE 2486 DO IDEST = 1, NDEST - 1 2487 BUF_LOAD%CONTENT( IPOS + ( IDEST - 1 ) * OVHSIZE ) = 2488 & IPOS + IDEST * OVHSIZE 2489 END DO 2490 BUF_LOAD%CONTENT( IPOS + ( NDEST - 1 ) * OVHSIZE ) = 0 2491 IPOSMSG = IPOS + OVHSIZE * NDEST 2492 POSITION = 0 2493 CALL MPI_PACK( WHAT, 1, MPI_INTEGER, 2494 & BUF_LOAD%CONTENT( IPOSMSG ), SIZE, 2495 & POSITION, COMM, IERR ) 2496 CALL MPI_PACK( FATHER_NODE, 1, MPI_INTEGER, 2497 & BUF_LOAD%CONTENT( IPOSMSG ), SIZE, 2498 & POSITION, COMM, IERR ) 2499 IF((K81.EQ.2).OR.(K81.EQ.3))THEN 2500 CALL MPI_PACK( INODE, 1, MPI_INTEGER, 2501 & BUF_LOAD%CONTENT( IPOSMSG ), SIZE, 2502 & POSITION, COMM, IERR ) 2503 CALL MPI_PACK( NCB, 1, MPI_INTEGER, 2504 & BUF_LOAD%CONTENT( IPOSMSG ), SIZE, 2505 & POSITION, COMM, IERR ) 2506 ENDIF 2507 IDEST = 1 2508 CALL MPI_ISEND( BUF_LOAD%CONTENT( IPOSMSG ), 2509 & POSITION, MPI_PACKED, REMOTE, 2510 & UPDATE_LOAD, COMM, 2511 & BUF_LOAD%CONTENT( IREQ+(IDEST-1)*OVHSIZE ), 2512 & IERR ) 2513 SIZE = SIZE - ( NDEST - 1 ) * OVHSIZE * SIZEofINT 2514 IF ( SIZE .LT. POSITION ) THEN 2515 WRITE(*,*) ' Error in DMUMPS_519' 2516 WRITE(*,*) ' Size,position=',SIZE,POSITION 2517 CALL MUMPS_ABORT() 2518 END IF 2519 IF ( SIZE .NE. POSITION ) 2520 & CALL DMUMPS_1( BUF_LOAD, POSITION ) 2521 RETURN 2522 END SUBROUTINE DMUMPS_519 2523 SUBROUTINE DMUMPS_502( COMM, MYID, NPROCS, 2524 & MAX_SURF_MASTER,IERR) 2525 IMPLICIT NONE 2526 INCLUDE 'mpif.h' 2527 INCLUDE 'mumps_tags.h' 2528 INTEGER IPOS, IREQ, IDEST, IPOSMSG, POSITION, I 2529 INTEGER COMM, MYID, IERR, NPROCS 2530 DOUBLE PRECISION MAX_SURF_MASTER 2531 INTEGER IZERO 2532 INTEGER MYID2(1) 2533 PARAMETER ( IZERO=0 ) 2534 INTEGER NDEST, NINTS, NREALS, SIZE, SIZE1, SIZE2 2535 INTEGER WHAT 2536 IERR = 0 2537 MYID2(1) = MYID 2538 NDEST = NPROCS - 1 2539 NINTS = 1 + ( NDEST-1 ) * OVHSIZE 2540 NREALS = 1 2541 CALL MPI_PACK_SIZE( NINTS, 2542 & MPI_INTEGER, COMM, 2543 & SIZE1, IERR ) 2544 CALL MPI_PACK_SIZE( NREALS, 2545 & MPI_DOUBLE_PRECISION, COMM, 2546 & SIZE2, IERR ) 2547 SIZE=SIZE1+SIZE2 2548 CALL DMUMPS_4( BUF_LOAD, IPOS, IREQ, SIZE, IERR, 2549 & IZERO, MYID2 ) 2550 IF ( IERR .LT. 0 ) THEN 2551 RETURN 2552 ENDIF 2553 BUF_LOAD%ILASTMSG = BUF_LOAD%ILASTMSG + ( NDEST - 1 ) * OVHSIZE 2554 IPOS = IPOS - OVHSIZE 2555 DO IDEST = 1, NDEST - 1 2556 BUF_LOAD%CONTENT( IPOS + ( IDEST - 1 ) * OVHSIZE ) = 2557 & IPOS + IDEST * OVHSIZE 2558 END DO 2559 BUF_LOAD%CONTENT( IPOS + ( NDEST - 1 ) * OVHSIZE ) = 0 2560 IPOSMSG = IPOS + OVHSIZE * NDEST 2561 POSITION = 0 2562 WHAT = 4 2563 CALL MPI_PACK( WHAT, 1, MPI_INTEGER, 2564 & BUF_LOAD%CONTENT( IPOSMSG ), SIZE, 2565 & POSITION, COMM, IERR ) 2566 CALL MPI_PACK( MAX_SURF_MASTER, 1, MPI_DOUBLE_PRECISION, 2567 & BUF_LOAD%CONTENT( IPOSMSG ), SIZE, 2568 & POSITION, COMM, IERR ) 2569 IDEST = 0 2570 DO I = 0, NPROCS - 1 2571 IF ( I .ne. MYID ) THEN 2572 IDEST = IDEST + 1 2573 CALL MPI_ISEND( BUF_LOAD%CONTENT( IPOSMSG ), 2574 & POSITION, MPI_PACKED, I, 2575 & UPDATE_LOAD, COMM, 2576 & BUF_LOAD%CONTENT( IREQ+(IDEST-1)*OVHSIZE ), 2577 & IERR ) 2578 END IF 2579 END DO 2580 SIZE = SIZE - ( NDEST - 1 ) * OVHSIZE * SIZEofINT 2581 IF ( SIZE .LT. POSITION ) THEN 2582 WRITE(*,*) ' Error in DMUMPS_524' 2583 WRITE(*,*) ' Size,position=',SIZE,POSITION 2584 CALL MUMPS_ABORT() 2585 END IF 2586 IF ( SIZE .NE. POSITION ) 2587 & CALL DMUMPS_1( BUF_LOAD, POSITION ) 2588 RETURN 2589 END SUBROUTINE DMUMPS_502 2590 SUBROUTINE DMUMPS_524( BDC_MEM, 2591 & COMM, MYID, NPROCS, 2592#if ! defined(OLD_LOAD_MECHANISM) 2593 & FUTURE_NIV2, 2594#endif 2595 & NSLAVES, 2596 & LIST_SLAVES,INODE, 2597 & MEM_INCREMENT, FLOPS_INCREMENT,CB_BAND, WHAT, 2598 & IERR ) 2599 IMPLICIT NONE 2600 INCLUDE 'mpif.h' 2601 INCLUDE 'mumps_tags.h' 2602 LOGICAL BDC_MEM 2603 INTEGER COMM, MYID, NPROCS, NSLAVES, IERR 2604#if ! defined(OLD_LOAD_MECHANISM) 2605 INTEGER FUTURE_NIV2(NPROCS) 2606#endif 2607 INTEGER LIST_SLAVES(NSLAVES),INODE 2608 DOUBLE PRECISION MEM_INCREMENT(NSLAVES) 2609 DOUBLE PRECISION FLOPS_INCREMENT(NSLAVES) 2610 DOUBLE PRECISION CB_BAND(NSLAVES) 2611 INTEGER NDEST, NINTS, NREALS, SIZE1, SIZE2, SIZE 2612 INTEGER IPOS, IPOSMSG, IREQ, POSITION 2613 INTEGER I, IDEST, WHAT 2614 INTEGER IZERO 2615 INTEGER MYID2(1) 2616 PARAMETER ( IZERO=0 ) 2617 MYID2(1)=MYID 2618 IERR = 0 2619#if ! defined(OLD_LOAD_MECHANISM) 2620 NDEST = 0 2621 DO I = 1, NPROCS 2622 IF ( I .NE. MYID + 1 .AND. FUTURE_NIV2(I).NE.0) THEN 2623 NDEST = NDEST + 1 2624 ENDIF 2625 ENDDO 2626#else 2627 NDEST = NPROCS - 1 2628#endif 2629 IF ( NDEST == 0 ) THEN 2630 RETURN 2631 ENDIF 2632 NINTS = 2 + NSLAVES + ( NDEST - 1 ) * OVHSIZE + 1 2633 NREALS = NSLAVES 2634 IF (BDC_MEM) NREALS = NREALS + NSLAVES 2635 IF(WHAT.EQ.19) THEN 2636 NREALS = NREALS + NSLAVES 2637 ENDIF 2638 CALL MPI_PACK_SIZE( NINTS, 2639 & MPI_INTEGER, COMM, 2640 & SIZE1, IERR ) 2641 CALL MPI_PACK_SIZE( NREALS, MPI_DOUBLE_PRECISION, 2642 & COMM, SIZE2, IERR ) 2643 SIZE = SIZE1+SIZE2 2644 CALL DMUMPS_4( BUF_LOAD, IPOS, IREQ, SIZE, IERR, 2645 & IZERO, MYID2 ) 2646 IF ( IERR .LT. 0 ) THEN 2647 RETURN 2648 ENDIF 2649 BUF_LOAD%ILASTMSG = BUF_LOAD%ILASTMSG + ( NDEST - 1 ) * OVHSIZE 2650 IPOS = IPOS - OVHSIZE 2651 DO IDEST = 1, NDEST - 1 2652 BUF_LOAD%CONTENT( IPOS + ( IDEST - 1 ) * OVHSIZE ) = 2653 & IPOS + IDEST * OVHSIZE 2654 END DO 2655 BUF_LOAD%CONTENT( IPOS + ( NDEST - 1 ) * OVHSIZE ) = 0 2656 IPOSMSG = IPOS + OVHSIZE * NDEST 2657 POSITION = 0 2658 CALL MPI_PACK( WHAT, 1, MPI_INTEGER, 2659 & BUF_LOAD%CONTENT( IPOSMSG ), SIZE, 2660 & POSITION, COMM, IERR ) 2661 CALL MPI_PACK( NSLAVES, 1, MPI_INTEGER, 2662 & BUF_LOAD%CONTENT( IPOSMSG ), SIZE, 2663 & POSITION, COMM, IERR ) 2664 CALL MPI_PACK( INODE, 1, MPI_INTEGER, 2665 & BUF_LOAD%CONTENT( IPOSMSG ), SIZE, 2666 & POSITION, COMM, IERR ) 2667 CALL MPI_PACK( LIST_SLAVES, NSLAVES, MPI_INTEGER, 2668 & BUF_LOAD%CONTENT( IPOSMSG ), SIZE, 2669 & POSITION, COMM, IERR ) 2670 CALL MPI_PACK( FLOPS_INCREMENT, NSLAVES, 2671 & MPI_DOUBLE_PRECISION, 2672 & BUF_LOAD%CONTENT( IPOSMSG ), SIZE, 2673 & POSITION, COMM, IERR ) 2674 IF (BDC_MEM) THEN 2675 CALL MPI_PACK( MEM_INCREMENT, NSLAVES, 2676 & MPI_DOUBLE_PRECISION, 2677 & BUF_LOAD%CONTENT( IPOSMSG ), SIZE, 2678 & POSITION, COMM, IERR ) 2679 END IF 2680 IF(WHAT.EQ.19)THEN 2681 CALL MPI_PACK( CB_BAND, NSLAVES, 2682 & MPI_DOUBLE_PRECISION, 2683 & BUF_LOAD%CONTENT( IPOSMSG ), SIZE, 2684 & POSITION, COMM, IERR ) 2685 ENDIF 2686 IDEST = 0 2687 DO I = 0, NPROCS - 1 2688#if ! defined(OLD_LOAD_MECHANISM) 2689 IF ( I .NE. MYID .AND. FUTURE_NIV2(I+1) .NE. 0) THEN 2690#else 2691 IF ( I .NE. MYID ) THEN 2692#endif 2693 IDEST = IDEST + 1 2694 CALL MPI_ISEND( BUF_LOAD%CONTENT( IPOSMSG ), 2695 & POSITION, MPI_PACKED, I, 2696 & UPDATE_LOAD, COMM, 2697 & BUF_LOAD%CONTENT( IREQ+(IDEST-1)*OVHSIZE ), 2698 & IERR ) 2699 END IF 2700 END DO 2701 SIZE = SIZE - ( NDEST - 1 ) * OVHSIZE * SIZEofINT 2702 IF ( SIZE .LT. POSITION ) THEN 2703 WRITE(*,*) ' Error in DMUMPS_524' 2704 WRITE(*,*) ' Size,position=',SIZE,POSITION 2705 CALL MUMPS_ABORT() 2706 END IF 2707 IF ( SIZE .NE. POSITION ) 2708 & CALL DMUMPS_1( BUF_LOAD, POSITION ) 2709 RETURN 2710 END SUBROUTINE DMUMPS_524 2711 SUBROUTINE DMUMPS_60 2712 & ( DMUMPS_LBUFR_BYTES) 2713 IMPLICIT NONE 2714 INTEGER DMUMPS_LBUFR_BYTES 2715 SIZE_RBUF_BYTES = DMUMPS_LBUFR_BYTES 2716 RETURN 2717 END SUBROUTINE DMUMPS_60 2718 END MODULE DMUMPS_COMM_BUFFER 2719