dfac_process_message.F

Go to the documentation of this file.

C
C  This file is part of MUMPS 5.5.1, released
C  on Tue Jul 12 13:17:24 UTC 2022
C
C
C  Copyright 1991-2022 CERFACS, CNRS, ENS Lyon, INP Toulouse, Inria,
C  Mumps Technologies, University of Bordeaux.
C
C  This version of MUMPS is provided to you free of charge. It is
C  released under the CeCILL-C license 
C  (see doc/CeCILL-C_V1-en.txt, doc/CeCILL-C_V1-fr.txt, and
C  https://cecill.info/licences/Licence_CeCILL-C_V1-en.html)
C
      RECURSIVE SUBROUTINE dmumps_traiter_message(
     &    COMM_LOAD, ASS_IRECV,
     &    MSGSOU, MSGTAG, MSGLEN,
     &    BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC,
     &    IWPOS, IWPOSCB, IPTRLU,
     &    LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST,
     &    PTLUST, PTRFAC,
     &    PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP,
     &    IFLAG, IERROR, COMM,
     &    PERM, IPOOL, LPOOL, LEAF, NBFIN, MYID, SLAVEF,
     &
     &    root, OPASSW, OPELIW, ITLOC, RHS_MUMPS,
     &    FILS, DAD, PTRARW, PTRAIW,
     &    INTARR, DBLARR, ICNTL, KEEP,KEEP8,DKEEP, ND, FRERE,
     &    LPTRAR, NELT, FRTPTR, FRTELT,
     &
     &    ISTEP_TO_INIV2, TAB_POS_IN_PERE
     &               , LRGROUPS
     &    )
      USE dmumps_load
      USE dmumps_struc_def, ONLY : dmumps_root_struc
      IMPLICIT NONE
      include 'mumps_headers.h'
      TYPE (DMUMPS_ROOT_STRUC) :: root
      INTEGER msgsou, msgtag, msglen
      INTEGER lbufr, lbufr_bytes
      INTEGER bufr( lbufr )
      INTEGER keep(500), icntl( 60 )
      INTEGER(8) keep8(150)
      DOUBLE PRECISION    dkeep(230)
      INTEGER(8) :: posfac, iptrlu, lrlu, lrlus, la
      INTEGER iwpos, iwposcb
      INTEGER n, liw
      INTEGER iw( liw )
      INTEGER, intent(in) :: lrgroups(n)
      DOUBLE PRECISION a( la )
      INTEGER(8) :: ptrfac(keep(28))
      INTEGER(8) :: ptrast(keep(28))
      INTEGER(8) :: pamaster(keep(28))
      INTEGER ptrist(keep(28)), ptlust(keep(28))
      INTEGER step(n), pimaster(keep(28))
      INTEGER comp
      INTEGER nstk_s(keep(28)), procnode_steps( keep(28) )
      INTEGER perm(n)
      INTEGER iflag, ierror, comm
      INTEGER lpool, leaf
      INTEGER ipool( lpool )
      INTEGER comm_load, ass_irecv
      INTEGER myid, slavef, nbfin
      DOUBLE PRECISION opassw, opeliw
      INTEGER nelt, lptrar
      INTEGER frtptr( n+1), frtelt( nelt )
      INTEGER itloc( n+keep(253) ), fils( n ), dad(keep(28))
      DOUBLE PRECISION :: rhs_mumps(keep(255))
      INTEGER(8), INTENT(IN) :: ptrarw( lptrar ), ptraiw( lptrar )
      INTEGER nd( keep(28) ), frere( keep(28) )
      INTEGER istep_to_iniv2(keep(71)),
     &        tab_pos_in_pere(slavef+2,max(1,keep(56)))
      INTEGER intarr( keep8(27) )
      DOUBLE PRECISION dblarr( keep8(26) )
      INTEGER iniv2, ishift, ibeg
      INTEGER ishift_hdr
      INTEGER mumps_procnode, mumps_typenode
      EXTERNAL mumps_procnode, mumps_typenode
      LOGICAL flag
      INTEGER mp, lp
      INTEGER tmp( 2 )
      INTEGER nbrecu, position, inode, ison, iroot
      INTEGER nslaves_pere, nfront_pere, nass_pere,
     &     lmap, fpere, nelim,
     &     hdmaplig,nfs4father,
     &     tot_root_size, tot_cont_to_recv
      DOUBLE PRECISION flop1
      CHARACTER(LEN=35) :: subname
      include 'mumps_tags.h'
      include 'mpif.h'
      INTEGER :: ierr
      INTEGER :: status(mpi_status_size)
      mp = icntl(2)
      lp = icntl(1)
      subname="??????"
      CALL dmumps_load_recv_msgs(comm_load)
      IF ( msgtag .EQ. racine ) THEN
          position = 0
          CALL mpi_unpack( bufr, lbufr_bytes, position, nbrecu,
     &     1, mpi_integer, comm, ierr)
          nbrecu = bufr( 1 )
          nbfin =  nbfin - nbrecu
      ELSEIF ( msgtag .EQ. noeud ) THEN
          CALL dmumps_process_node( myid, keep, keep8, dkeep,
     &    bufr, lbufr, lbufr_bytes,
     &    iwpos, iwposcb, iptrlu,
     &    lrlu, lrlus, n, iw, liw, a, la, slavef, procnode_steps, dad,
     &    ptrist, ptrast,
     &    step, pimaster, pamaster,
     &    nstk_s, comp, fpere, flag, iflag, ierror, comm,
     &    itloc, rhs_mumps )
          subname="dmumps_process_node"
.LT.          IF ( IFLAG  0 ) GO TO 500
          IF ( FLAG ) THEN
            CALL DMUMPS_INSERT_POOL_N(N, IPOOL, LPOOL,
     &           PROCNODE_STEPS, SLAVEF, KEEP(199), KEEP(28), KEEP(76),
     &           KEEP(80), KEEP(47), STEP, FPERE )
.GE.            IF (KEEP(47)  3) THEN
               CALL DMUMPS_LOAD_POOL_UPD_NEW_POOL(
     &              IPOOL, LPOOL,
     &              PROCNODE_STEPS, KEEP,KEEP8, SLAVEF, COMM_LOAD,
     &              MYID, STEP, N, ND, FILS )
            ENDIF
            CALL MUMPS_ESTIM_FLOPS( FPERE, N,
     &           PROCNODE_STEPS,KEEP(199),
     &           ND, FILS, FRERE, STEP, PIMASTER,
     &           KEEP(28), KEEP(50), KEEP(253), FLOP1,
     &           IW, LIW, KEEP(IXSZ) )
.NE.            IF (FPEREKEEP(20))
     &        CALL DMUMPS_LOAD_UPDATE(1,.FALSE.,FLOP1,KEEP,KEEP8)
          ENDIF
.EQ.      ELSEIF ( MSGTAG  END_NIV2_LDLT ) THEN
          INODE = BUFR( 1 )
          CALL DMUMPS_INSERT_POOL_N(N, IPOOL, LPOOL,
     &         PROCNODE_STEPS, SLAVEF, KEEP(199),
     &         KEEP(28), KEEP(76), KEEP(80), KEEP(47),
     &         STEP, -INODE )
.GE.          IF (KEEP(47)  3) THEN
             CALL DMUMPS_LOAD_POOL_UPD_NEW_POOL(
     &            IPOOL, LPOOL,
     &            PROCNODE_STEPS, KEEP,KEEP8, SLAVEF, COMM_LOAD,
     &            MYID, STEP, N, ND, FILS )
          ENDIF
.EQ.      ELSEIF ( MSGTAG  TERREUR ) THEN
          IFLAG  = -001
          IERROR = MSGSOU
          GOTO 100
.EQ.      ELSEIF ( MSGTAG  MAITRE_DESC_BANDE ) THEN
        CALL DMUMPS_PROCESS_DESC_BANDE( MYID,BUFR, LBUFR,
     &    LBUFR_BYTES, IWPOS,
     &    IWPOSCB,
     &    IPTRLU, LRLU, LRLUS, 
     &    N, IW, LIW, A, LA, SLAVEF, PROCNODE_STEPS, DAD,
     &    PTRIST, PTRAST, STEP, PIMASTER, PAMASTER, COMP,
     &    KEEP, KEEP8, DKEEP, ITLOC, RHS_MUMPS, ISTEP_TO_INIV2, 
#if ! defined (NO_FDM_DESCBAND)
     &    -1,
#endif
     &    IFLAG, IERROR )
          SUBNAME="dmumps_process_desc_bande"
.LT.        IF ( IFLAG  0 ) GO to 500
.EQ.      ELSEIF ( MSGTAG  MAITRE2           ) THEN
        CALL DMUMPS_PROCESS_MASTER2(MYID,BUFR, LBUFR, LBUFR_BYTES,
     &    PROCNODE_STEPS, SLAVEF, IWPOS, IWPOSCB,
     &    IPTRLU, LRLU, LRLUS, N, IW, LIW, A, LA,
     &    PTRIST, PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP,
     &    IFLAG, IERROR, COMM, COMM_LOAD,
     &    IPOOL, LPOOL, LEAF,
     &    KEEP, KEEP8, DKEEP, ND, FILS, DAD, FRERE, ITLOC, RHS_MUMPS,
     &    ISTEP_TO_INIV2, TAB_POS_IN_PERE )
          SUBNAME="dmumps_process_master2"
.LT.        IF ( IFLAG  0 ) GO to 500
.EQ..OR.      ELSEIF ( MSGTAG  BLOC_FACTO  
.EQ.     &         MSGTAG  BLOC_FACTO_RELAY ) THEN
        CALL DMUMPS_PROCESS_BLOCFACTO( COMM_LOAD, ASS_IRECV,
     &   BUFR,  LBUFR, LBUFR_BYTES,
     &   PROCNODE_STEPS, MSGSOU,
     &   SLAVEF, IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, N, IW, LIW,
     &   A, LA, PTRIST, PTRAST, NSTK_S, PERM,
     &   COMP, STEP, PIMASTER, PAMASTER, POSFAC,
     &   MYID, COMM , IFLAG, IERROR, NBFIN,
     &
     &    PTLUST, PTRFAC, root, OPASSW, OPELIW, ITLOC, RHS_MUMPS,
     &    FILS, DAD, PTRARW, PTRAIW, INTARR, DBLARR,
     &    ICNTL, KEEP,KEEP8,DKEEP, IPOOL, LPOOL, LEAF, ND, FRERE,
     &    LPTRAR, NELT, FRTPTR, FRTELT,
     &    ISTEP_TO_INIV2, TAB_POS_IN_PERE  
     &               , LRGROUPS
     &     )
.EQ.      ELSEIF ( MSGTAG  BLOC_FACTO_SYM_SLAVE    ) THEN
        CALL DMUMPS_PROCESS_BLFAC_SLAVE( COMM_LOAD, ASS_IRECV,
     &   BUFR, LBUFR,
     &   LBUFR_BYTES, PROCNODE_STEPS, MSGSOU,
     &   SLAVEF, IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, N, IW, LIW,
     &   A, LA, PTRIST, PTRAST, NSTK_S, PERM,
     &   COMP, STEP, PIMASTER, PAMASTER, POSFAC,
     &   MYID, COMM, IFLAG, IERROR, NBFIN,
     &
     &    PTLUST, PTRFAC, root, OPASSW, OPELIW, ITLOC, RHS_MUMPS,
     &    FILS, DAD, PTRARW, PTRAIW, INTARR, DBLARR,
     &    ICNTL, KEEP,KEEP8,DKEEP, IPOOL, LPOOL, LEAF, ND, FRERE,
     &    LPTRAR, NELT, FRTPTR, FRTELT,
     &    ISTEP_TO_INIV2, TAB_POS_IN_PERE  
     &               , LRGROUPS
     &     )
.EQ.      ELSEIF ( MSGTAG  BLOC_FACTO_SYM    ) THEN
        CALL DMUMPS_PROCESS_SYM_BLOCFACTO( COMM_LOAD, ASS_IRECV,
     &   BUFR, LBUFR,
     &   LBUFR_BYTES, PROCNODE_STEPS, MSGSOU,
     &   SLAVEF, IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, N, IW, LIW,
     &   A, LA, PTRIST, PTRAST, NSTK_S, PERM,
     &   COMP, STEP, PIMASTER, PAMASTER, POSFAC,
     &   MYID, COMM, IFLAG, IERROR, NBFIN,
     &
     &    PTLUST, PTRFAC, root, OPASSW, OPELIW, ITLOC, RHS_MUMPS,
     &    FILS, DAD, PTRARW, PTRAIW, INTARR, DBLARR,
     &    ICNTL,KEEP,KEEP8,DKEEP,IPOOL, LPOOL, LEAF, ND, FRERE,
     &    LPTRAR, NELT, FRTPTR, FRTELT,
     &    ISTEP_TO_INIV2, TAB_POS_IN_PERE
     &        , LRGROUPS
     & )
.EQ.      ELSEIF ( MSGTAG  CONTRIB_TYPE2    ) THEN
        CALL DMUMPS_PROCESS_CONTRIB_TYPE2( COMM_LOAD, ASS_IRECV,
     &       MSGLEN, BUFR, LBUFR,
     &       LBUFR_BYTES, PROCNODE_STEPS,
     &       SLAVEF, IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, POSFAC,
     &       N, IW, LIW, A, LA, PTRIST,
     &       PTLUST, PTRFAC, PTRAST,
     &       STEP, PIMASTER, PAMASTER, PERM, COMP, root,
     &       OPASSW, OPELIW, ITLOC, RHS_MUMPS, NSTK_S, FILS, DAD,
     &       PTRARW, PTRAIW, INTARR, DBLARR, NBFIN, MYID, COMM,
     &       ICNTL,KEEP,KEEP8,DKEEP,IFLAG, IERROR, IPOOL, LPOOL, LEAF,
     &       ND, FRERE, LPTRAR, NELT, FRTPTR, FRTELT,
     &       ISTEP_TO_INIV2, TAB_POS_IN_PERE
     &               , LRGROUPS
     &       )
.LT.        IF ( IFLAG  0 ) GO TO 100
.EQ.      ELSEIF ( MSGTAG  MAPLIG            ) THEN
         HDMAPLIG = 7
         INODE        = BUFR( 1 )
         ISON         = BUFR( 2 )
         NSLAVES_PERE = BUFR( 3 )
         NFRONT_PERE  = BUFR( 4 )
         NASS_PERE    = BUFR( 5 )
         LMAP         = BUFR( 6 )
         NFS4FATHER   = BUFR( 7 )
.NE.         IF ( NSLAVES_PERE0 ) THEN
            INIV2 = ISTEP_TO_INIV2 ( STEP(INODE) )
            ISHIFT = NSLAVES_PERE+1
            TAB_POS_IN_PERE(1:NSLAVES_PERE+1, INIV2) =
     &           BUFR(HDMAPLIG+1:HDMAPLIG+1+NSLAVES_PERE)
            TAB_POS_IN_PERE(SLAVEF+2, INIV2) = NSLAVES_PERE
         ELSE
            ISHIFT = 0
         ENDIF
         IBEG = HDMAPLIG+1+ISHIFT
         CALL DMUMPS_MAPLIG( COMM_LOAD, ASS_IRECV,
     &    BUFR, LBUFR, LBUFR_BYTES,
     &    INODE, ISON, NSLAVES_PERE,
     &    BUFR(IBEG),
     &    NFRONT_PERE, NASS_PERE, NFS4FATHER,LMAP,
     &    BUFR(IBEG+NSLAVES_PERE),
     &    PROCNODE_STEPS, SLAVEF, POSFAC, IWPOS, IWPOSCB,
     &    IPTRLU, LRLU, LRLUS, N, IW, LIW, A, LA,
     &    PTRIST, PTLUST, PTRFAC, PTRAST, STEP, PIMASTER, PAMASTER,
     &    NSTK_S, COMP,
     &    IFLAG, IERROR, MYID, COMM, PERM,
     &    IPOOL, LPOOL, LEAF, NBFIN, ICNTL, KEEP,KEEP8,DKEEP, root,
     &    OPASSW, OPELIW,
     &    ITLOC, RHS_MUMPS, FILS, DAD, PTRARW, PTRAIW, INTARR, DBLARR,
     &    ND, FRERE, LPTRAR, NELT, FRTPTR, FRTELT,
     &
     &    ISTEP_TO_INIV2, TAB_POS_IN_PERE
     &               , LRGROUPS
     &    )
.LT.         IF ( IFLAG  0 ) GO TO 100
.EQ.      ELSE IF ( MSGTAG  ROOT_CONT_STATIC ) THEN
        CALL DMUMPS_PROCESS_CONTRIB_TYPE3(
     &        BUFR, LBUFR, LBUFR_BYTES,
     &        root, N, IW, LIW, A, LA, 
     &        LRLU, IPTRLU, IWPOS, IWPOSCB,
     &        PTRIST, PTLUST, PTRFAC, PTRAST,
     &        STEP, PIMASTER, PAMASTER,
     &        COMP, LRLUS, IPOOL, LPOOL, LEAF,
     &        FILS, DAD, MYID,
     &        LPTRAR, NELT, FRTPTR, FRTELT,
     &        PTRAIW, PTRARW, INTARR, DBLARR,
     &        KEEP, KEEP8, DKEEP, IFLAG, IERROR, COMM, COMM_LOAD,
     &        ITLOC, RHS_MUMPS,
     &        ND, PROCNODE_STEPS, SLAVEF, OPASSW)
        SUBNAME="dmumps_process_contrib_type3"
.LT.        IF ( IFLAG  0 ) GO TO 500
.EQ.      ELSE IF ( MSGTAG  ROOT_NON_ELIM_CB ) THEN
        IROOT  = KEEP( 38 )
        MSGSOU = MUMPS_PROCNODE( PROCNODE_STEPS(STEP(IROOT)), 
     &           KEEP(199) )
.EQ.        IF ( PTLUST( STEP(IROOT))  0 ) THEN
          KEEP(266)=KEEP(266)-1
          CALL MPI_RECV( TMP, 2 * KEEP(34), MPI_PACKED,
     &                   MSGSOU, ROOT_2SLAVE,
     &                   COMM, STATUS, IERR )
          CALL DMUMPS_PROCESS_ROOT2SLAVE( TMP( 1 ), TMP( 2 ),
     &    root,
     &    BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC,
     &    IWPOS, IWPOSCB, IPTRLU,
     &    LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST,
     &    PTLUST, PTRFAC,
     &    PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP,
     &    IFLAG, IERROR, COMM, COMM_LOAD,
     &    IPOOL, LPOOL, LEAF,
     &    NBFIN, MYID, SLAVEF,
     &
     &    OPASSW, OPELIW, ITLOC, RHS_MUMPS, FILS, DAD,
     &    LPTRAR, NELT, FRTPTR, FRTELT,
     &    PTRARW, PTRAIW,
     &    INTARR, DBLARR, ICNTL, KEEP,KEEP8, DKEEP,ND )
          SUBNAME="dmumps_process_root2slave"
.LT.          IF ( IFLAG  0 ) GOTO 500
        END IF
        CALL DMUMPS_PROCESS_CONTRIB_TYPE3(
     &       BUFR, LBUFR, LBUFR_BYTES,
     &       root, N, IW, LIW, A, LA, 
     &       LRLU, IPTRLU, IWPOS, IWPOSCB,
     &       PTRIST, PTLUST, PTRFAC, PTRAST, STEP, PIMASTER, PAMASTER,
     &       COMP, LRLUS, IPOOL, LPOOL, LEAF,
     &       FILS, DAD, MYID,
     &       LPTRAR, NELT, FRTPTR, FRTELT,
     &       PTRAIW, PTRARW, INTARR, DBLARR,
     &       KEEP, KEEP8, DKEEP, IFLAG, IERROR, COMM, COMM_LOAD,
     &       ITLOC, RHS_MUMPS,
     &       ND, PROCNODE_STEPS, SLAVEF, OPASSW )
          SUBNAME="dmumps_process_contrib_type3"
.LT.        IF ( IFLAG  0 ) GO TO 500
.EQ.      ELSE IF ( MSGTAG  ROOT_2SON ) THEN
         ISON  = BUFR( 1 )
         NELIM = BUFR( 2 )
         CALL DMUMPS_PROCESS_ROOT2SON( COMM_LOAD, ASS_IRECV,
     &    ISON, NELIM, root,
     &    BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC,
     &    IWPOS, IWPOSCB, IPTRLU,
     &    LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST,
     &    PTLUST, PTRFAC,
     &    PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP,
     &    IFLAG, IERROR, COMM,
     &    PERM, IPOOL, LPOOL, LEAF, NBFIN, MYID, SLAVEF,
     &
     &    OPASSW, OPELIW, ITLOC, RHS_MUMPS,
     &    FILS, DAD, PTRARW, PTRAIW,
     &    INTARR,DBLARR,ICNTL,KEEP,KEEP8,DKEEP,ND, FRERE,
     &    LPTRAR, NELT, FRTPTR, FRTELT,
     &    ISTEP_TO_INIV2, TAB_POS_IN_PERE 
     &               , LRGROUPS
     &     )
.LT.          IF ( IFLAG  0 ) GO TO 100
.NE.         IF ( MYIDMUMPS_PROCNODE(PROCNODE_STEPS(STEP(ISON)), 
     &                               KEEP(199)) ) THEN
.EQ.          IF (KEEP(50)0) THEN
            ISHIFT_HDR = 6
          ELSE
            ISHIFT_HDR = 8
          ENDIF
.EQ.          IF (IW(PTRIST(STEP(ISON))+ISHIFT_HDR+KEEP(IXSZ))
     &                                 S_REC_CONTSTATIC) THEN
             IW(PTRIST(STEP(ISON))+ISHIFT_HDR+KEEP(IXSZ)) =
     &                                        S_ROOT2SON_CALLED
          ELSE
             CALL DMUMPS_FREE_BAND( N, ISON, PTRIST, PTRAST,
     &       IW, LIW, A, LA, LRLU, LRLUS, IWPOSCB,
     &       IPTRLU, STEP, MYID, KEEP, KEEP8,
     &       MUMPS_TYPENODE(PROCNODE_STEPS(STEP(ISON)),KEEP(199))
     &       )
          ENDIF
         ENDIF
.EQ.      ELSE IF ( MSGTAG  ROOT_2SLAVE ) THEN
          TOT_ROOT_SIZE    = BUFR( 1 )
          TOT_CONT_TO_RECV = BUFR( 2 )
          CALL DMUMPS_PROCESS_ROOT2SLAVE( TOT_ROOT_SIZE,
     &    TOT_CONT_TO_RECV, root,
     &    BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC,
     &    IWPOS, IWPOSCB, IPTRLU,
     &    LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST,
     &    PTLUST, PTRFAC,
     &    PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP,
     &    IFLAG, IERROR, COMM, COMM_LOAD,
     &    IPOOL, LPOOL, LEAF,
     &    NBFIN, MYID, SLAVEF,
     &
     &    OPASSW, OPELIW, ITLOC, RHS_MUMPS, FILS, DAD,
     &    LPTRAR, NELT, FRTPTR, FRTELT,
     &    PTRARW, PTRAIW,
     &    INTARR, DBLARR, ICNTL, KEEP,KEEP8, DKEEP, ND )
.LT.          IF ( IFLAG  0 ) GO TO 100
.EQ.      ELSE IF ( MSGTAG  ROOT_NELIM_INDICES ) THEN
         ISON         = BUFR( 1 )
         NELIM        = BUFR( 2 )
         NSLAVES_PERE = BUFR( 3 )
         CALL DMUMPS_PROCESS_RTNELIND( root,
     &    ISON, NELIM, NSLAVES_PERE, BUFR(4), BUFR(4+BUFR(2)),
     &    BUFR(4+2*BUFR(2)),
     &
     &    PROCNODE_STEPS,
     &    IWPOS, IWPOSCB, IPTRLU,
     &    LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST,
     &    PTLUST, PTRFAC,
     &    PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S,
     &    ITLOC, RHS_MUMPS, COMP,
     &    IFLAG, IERROR,
     &    IPOOL, LPOOL, LEAF, MYID, SLAVEF,
     &    KEEP, KEEP8, DKEEP,
     &    COMM, COMM_LOAD, FILS, DAD, ND)
          SUBNAME="dmumps_process_rtnelind"
.LT.         IF ( IFLAG  0 ) GO TO 500
.EQ.      ELSE IF ( MSGTAG  UPDATE_LOAD ) THEN
         WRITE(*,*) "internal error 3 in dmumps_traiter_message"
         CALL MUMPS_ABORT()
.EQ.      ELSE IF ( MSGTAG  TAG_DUMMY   ) THEN
      ELSE
         IF ( LP > 0 )
     &     WRITE(LP,*) MYID,
     &': Internal error, routine DMUMPS_TRAITER_MESSAGE.',MSGTAG
         IFLAG = -100
         IERROR= MSGTAG
         GOTO 500
      ENDIF
 100  CONTINUE
      RETURN
 500  CONTINUE
.GT..AND..GE.      IF ( ICNTL(1)  0  ICNTL(4)1 ) THEN
        LP=ICNTL(1)
.EQ.        IF (IFLAG-9) THEN
         WRITE(LP,*) 'FAILURE, WORKSPACE TOO SMALL DURING ',SUBNAME
        ENDIF
.EQ.        IF (IFLAG-8) THEN
         WRITE(LP,*) 'FAILURE IN INTEGER ALLOCATION DURING ',SUBNAME
        ENDIF
.EQ.        IF (IFLAG-13) THEN
         WRITE(LP,*) 'FAILURE IN DYNAMIC ALLOCATION DURING ',SUBNAME
        ENDIF
      ENDIF
      CALL DMUMPS_BDC_ERROR( MYID, SLAVEF, COMM, KEEP )
      RETURN
      END SUBROUTINE DMUMPS_TRAITER_MESSAGE
      RECURSIVE SUBROUTINE DMUMPS_RECV_AND_TREAT(
     &    COMM_LOAD, ASS_IRECV,
     &    STATUS,
     &    BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC,
     &    IWPOS, IWPOSCB, IPTRLU,
     &    LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST,
     &    PTLUST, PTRFAC,
     &    PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP,
     &    IFLAG, IERROR, COMM,
     &    PERM, IPOOL, LPOOL, LEAF, NBFIN, MYID, SLAVEF,
     &
     &    root, OPASSW, OPELIW, ITLOC, RHS_MUMPS,
     &    FILS, DAD, PTRARW, PTRAIW,
     &    INTARR, DBLARR, ICNTL, KEEP,KEEP8,DKEEP, ND, FRERE,
     &    LPTRAR, NELT, FRTPTR, FRTELT ,
     &
     &    ISTEP_TO_INIV2, TAB_POS_IN_PERE
     &               , LRGROUPS
     &    )
      USE DMUMPS_STRUC_DEF, ONLY : DMUMPS_ROOT_STRUC
      IMPLICIT NONE
      INCLUDE 'mpif.h'
      INCLUDE 'mumps_tags.h'
      TYPE (DMUMPS_ROOT_STRUC) :: root
      INTEGER :: STATUS(MPI_STATUS_SIZE)
      INTEGER KEEP(500), ICNTL(60)
      INTEGER(8) KEEP8(150)
      DOUBLE PRECISION       DKEEP(230)
      INTEGER COMM_LOAD, ASS_IRECV
      INTEGER LBUFR, LBUFR_BYTES
      INTEGER BUFR( LBUFR )
      INTEGER(8) :: POSFAC, LA, IPTRLU, LRLU, LRLUS
      INTEGER IWPOS, IWPOSCB
      INTEGER N, LIW
      INTEGER IW( LIW )
      DOUBLE PRECISION A( LA )
      INTEGER, intent(in) :: LRGROUPS(N)
      INTEGER(8) :: PTRFAC(KEEP(28))
      INTEGER(8) :: PTRAST(KEEP(28))
      INTEGER(8) :: PAMASTER(KEEP(28))
      INTEGER PTRIST( KEEP(28) ),
     &        PTLUST( KEEP(28) )
      INTEGER STEP(N), PIMASTER(KEEP(28))
      INTEGER COMP
      INTEGER NSTK_S(KEEP(28)), PROCNODE_STEPS( KEEP(28) )
      INTEGER PERM(N)
      INTEGER IFLAG, IERROR, COMM
      INTEGER LPOOL, LEAF
      INTEGER IPOOL( LPOOL )
      INTEGER MYID, SLAVEF, NBFIN
      DOUBLE PRECISION OPASSW, OPELIW
      INTEGER NELT, LPTRAR
      INTEGER FRTPTR( N+1 ), FRTELT( NELT )
      INTEGER ITLOC( N+KEEP(253) ), FILS( N ), DAD( KEEP(28) )
      DOUBLE PRECISION :: RHS_MUMPS(KEEP(255))
      INTEGER(8), INTENT(IN) :: PTRARW( LPTRAR ), PTRAIW( LPTRAR )
      INTEGER ND( KEEP(28) ), FRERE( KEEP(28) )
      INTEGER ISTEP_TO_INIV2(KEEP(71)),
     &        TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56)))
      INTEGER INTARR( KEEP8(27) )
      DOUBLE PRECISION DBLARR( KEEP8(26) )
      INTEGER MSGSOU, MSGTAG, MSGLEN, IERR
      MSGSOU = STATUS( MPI_SOURCE )
      MSGTAG = STATUS( MPI_TAG )
      CALL MPI_GET_COUNT( STATUS, MPI_PACKED, MSGLEN, IERR )
.GT.      IF ( MSGLEN  LBUFR_BYTES ) THEN
        IFLAG  = -20
        IERROR = MSGLEN
         WRITE(*,*) ' RECEPTION BUF TOO SMALL, Msgtag/len=',
     &                MSGTAG,MSGLEN
        CALL DMUMPS_BDC_ERROR( MYID, SLAVEF, COMM, KEEP )
        RETURN
       ENDIF
       KEEP(266)=KEEP(266)-1
       CALL MPI_RECV( BUFR, LBUFR_BYTES, MPI_PACKED, MSGSOU,
     &                 MSGTAG,
     &                 COMM, STATUS, IERR )
       CALL DMUMPS_TRAITER_MESSAGE(
     &      COMM_LOAD, ASS_IRECV,
     &      MSGSOU, MSGTAG, MSGLEN, BUFR, LBUFR,
     &      LBUFR_BYTES,
     &      PROCNODE_STEPS, POSFAC,
     &      IWPOS, IWPOSCB, IPTRLU,
     &      LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST,
     &      PTLUST, PTRFAC,
     &      PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, IFLAG,
     &      IERROR, COMM,
     &      PERM, IPOOL, LPOOL, LEAF, NBFIN, MYID, SLAVEF,
     &
     &      root, OPASSW, OPELIW, ITLOC, RHS_MUMPS,
     &      FILS, DAD, PTRARW, PTRAIW,
     &      INTARR, DBLARR, ICNTL, KEEP,KEEP8,DKEEP, ND, FRERE,
     &      LPTRAR, NELT, FRTPTR, FRTELT,
     &
     &      ISTEP_TO_INIV2, TAB_POS_IN_PERE
     &               , LRGROUPS
     &      )
      RETURN
      END SUBROUTINE DMUMPS_RECV_AND_TREAT
      RECURSIVE SUBROUTINE DMUMPS_TRY_RECVTREAT(
     &    COMM_LOAD, ASS_IRECV, BLOCKING, SET_IRECV,
     &    MESSAGE_RECEIVED, MSGSOU, MSGTAG,
     &    STATUS,
     &    BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC,
     &    IWPOS, IWPOSCB, IPTRLU,
     &    LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST,
     &    PTLUST, PTRFAC,
     &    PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP,
     &    IFLAG, IERROR, COMM, PERM,
     &    IPOOL, LPOOL, LEAF, NBFIN, MYID, SLAVEF,
     &
     &    root, OPASSW, OPELIW, ITLOC, RHS_MUMPS,
     &    FILS, DAD, PTRARW, PTRAIW,
     &    INTARR, DBLARR, ICNTL, KEEP,KEEP8,DKEEP, ND, FRERE,
     &    LPTRAR, NELT, FRTPTR, FRTELT,
     &
     &    ISTEP_TO_INIV2, TAB_POS_IN_PERE,
     &    STACK_RIGHT_AUTHORIZED, LRGROUPS )
      USE DMUMPS_LOAD
      USE DMUMPS_STRUC_DEF, ONLY : DMUMPS_ROOT_STRUC
      IMPLICIT NONE
      INCLUDE 'mpif.h'
      INCLUDE 'mumps_tags.h'
      TYPE (DMUMPS_ROOT_STRUC) :: root
      INTEGER :: STATUS(MPI_STATUS_SIZE)
      LOGICAL, INTENT (IN)  :: BLOCKING
      LOGICAL, INTENT (IN)  :: SET_IRECV
      LOGICAL, INTENT (INOUT) :: MESSAGE_RECEIVED
      INTEGER, INTENT (IN) :: MSGSOU, MSGTAG
      INTEGER KEEP(500), ICNTL(60)
      INTEGER(8) KEEP8(150)
      DOUBLE PRECISION       DKEEP(230)
      INTEGER LBUFR, LBUFR_BYTES
      INTEGER COMM_LOAD, ASS_IRECV
      INTEGER BUFR( LBUFR )
      INTEGER(8) :: LA, POSFAC, IPTRLU, LRLU, LRLUS
      INTEGER IWPOS, IWPOSCB
      INTEGER N, LIW
      INTEGER IW( LIW )
      DOUBLE PRECISION A( LA )
      INTEGER, intent(in) :: LRGROUPS(N)
      INTEGER(8) :: PTRAST(KEEP(28))
      INTEGER(8) :: PTRFAC(KEEP(28))
      INTEGER(8) :: PAMASTER(KEEP(28))
      INTEGER PTRIST( KEEP(28) ),
     &        PTLUST(KEEP(28))
      INTEGER STEP(N),
     & PIMASTER(KEEP(28))
      INTEGER COMP
      INTEGER NSTK_S(KEEP(28)), PROCNODE_STEPS( KEEP(28) )
      INTEGER PERM(N)
      INTEGER IFLAG, IERROR, COMM
      INTEGER LPOOL, LEAF
      INTEGER IPOOL( LPOOL )
      INTEGER MYID, SLAVEF, NBFIN
      DOUBLE PRECISION OPASSW, OPELIW
      INTEGER NELT, LPTRAR
      INTEGER FRTPTR( N+1 ), FRTELT( NELT )
      INTEGER ITLOC( N + KEEP(253) ), FILS( N ), DAD( KEEP(28) )
      DOUBLE PRECISION :: RHS_MUMPS(KEEP(255))
      INTEGER(8), INTENT(IN) :: PTRARW( LPTRAR ), PTRAIW( LPTRAR )
      INTEGER ND( KEEP(28) ), FRERE( KEEP(28) )
      INTEGER ISTEP_TO_INIV2(KEEP(71)),
     &        TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56)))
      INTEGER INTARR( KEEP8(27) )
      DOUBLE PRECISION DBLARR( KEEP8(26) )
      LOGICAL, intent(in) :: STACK_RIGHT_AUTHORIZED
       LOGICAL FLAG, RIGHT_MESS, FLAGbis
       INTEGER LP, MSGSOU_LOC, MSGTAG_LOC, MSGLEN_LOC
       INTEGER IERR
       INTEGER :: STATUS_BIS(MPI_STATUS_SIZE)
       INTEGER, SAVE :: RECURS = 0
      CALL DMUMPS_LOAD_RECV_MSGS(COMM_LOAD)
.NOT.      IF (  STACK_RIGHT_AUTHORIZED ) THEN
          RETURN
      ENDIF
      RECURS = RECURS + 1
      LP = ICNTL(1)
.LT.      IF (ICNTL(4)1) LP=-1
      IF ( MESSAGE_RECEIVED ) THEN
        MSGSOU_LOC = MPI_ANY_SOURCE
        MSGTAG_LOC = MPI_ANY_TAG
        GOTO 250
      ENDIF
.NE.      IF ( ASS_IRECV  MPI_REQUEST_NULL) THEN
.NE.        IF (KEEP(117)0) THEN
         WRITE(*,*) "problem of active irecv with keep(117)=",KEEP(117)
         CALL MUMPS_ABORT()
        ENDIF
        RIGHT_MESS = .TRUE.
        IF (BLOCKING) THEN
          CALL MPI_WAIT(ASS_IRECV,
     &                STATUS, IERR)
          FLAG = .TRUE.
.NE..OR.          IF ( ( (MSGSOUMPI_ANY_SOURCE) 
.NE.     &      (MSGTAGMPI_ANY_TAG) )  ) THEN
.NE.            IF ( MSGSOUMPI_ANY_SOURCE) THEN
.EQ.              RIGHT_MESS = MSGSOUSTATUS(MPI_SOURCE)
            ENDIF
.NE.            IF ( MSGTAGMPI_ANY_TAG) THEN
              RIGHT_MESS =
.EQ..AND.     &        ( (MSGTAGSTATUS(MPI_TAG))RIGHT_MESS )
            ENDIF
.NOT.            IF (RIGHT_MESS) THEN
              CALL MPI_PROBE(MSGSOU,MSGTAG,
     &           COMM, STATUS_BIS, IERR)
            ENDIF
          ENDIF
        ELSE 
          CALL MPI_TEST(ASS_IRECV,
     &             FLAG, STATUS, IERR)
        ENDIF
.LT.        IF (IERR0) THEN
          IFLAG = -20
.GT.          IF (LP0)
     &    write(LP,*) ' Error return from MPI_TEST ',
     &     IFLAG, ' in DMUMPS_TRY_RECVTREAT'
          CALL DMUMPS_BDC_ERROR( MYID, SLAVEF, COMM, KEEP )
          RETURN
        ENDIF
        IF ( FLAG ) THEN
          KEEP(266)=KEEP(266)-1
          MESSAGE_RECEIVED = .TRUE.
          MSGSOU_LOC = STATUS( MPI_SOURCE )
          MSGTAG_LOC = STATUS( MPI_TAG )
          CALL MPI_GET_COUNT( STATUS, MPI_PACKED, MSGLEN_LOC, IERR )
.NOT.           IF (RIGHT_MESS) RECURS = RECURS + 10
          CALL DMUMPS_TRAITER_MESSAGE( COMM_LOAD, ASS_IRECV,
     &      MSGSOU_LOC, MSGTAG_LOC, MSGLEN_LOC, BUFR, LBUFR,
     &      LBUFR_BYTES,
     &      PROCNODE_STEPS, POSFAC,
     &      IWPOS, IWPOSCB, IPTRLU,
     &      LRLU, LRLUS, N, IW, LIW, A, LA,
     &      PTRIST, PTLUST, PTRFAC,
     &      PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, IFLAG,
     &      IERROR, COMM,
     &      PERM, IPOOL, LPOOL, LEAF, NBFIN, MYID, SLAVEF,
     &
     &      root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, FILS, DAD,
     &      PTRARW, PTRAIW,
     &      INTARR, DBLARR, ICNTL, KEEP,KEEP8,DKEEP, ND, FRERE,
     &      LPTRAR, NELT, FRTPTR, FRTELT,
     &      ISTEP_TO_INIV2, TAB_POS_IN_PERE
     &               , LRGROUPS
     &      )
.NOT.          IF (RIGHT_MESS) RECURS = RECURS - 10
.LT.          IF ( IFLAG  0 ) RETURN
.NOT.          IF (RIGHT_MESS) THEN
.NE.             IF (ASS_IRECV  MPI_REQUEST_NULL) THEN
                CALL MUMPS_ABORT()
            ENDIF
            CALL MPI_IPROBE(MSGSOU,MSGTAG,
     &           COMM, FLAGbis, STATUS, IERR)
            IF (FLAGbis) THEN
               MSGSOU_LOC = STATUS( MPI_SOURCE )
               MSGTAG_LOC = STATUS( MPI_TAG )
               CALL DMUMPS_RECV_AND_TREAT( COMM_LOAD, ASS_IRECV,
     &            STATUS, BUFR, LBUFR,
     &            LBUFR_BYTES,
     &            PROCNODE_STEPS, POSFAC,
     &            IWPOS, IWPOSCB, IPTRLU,
     &            LRLU, LRLUS, N, IW, LIW, A, LA,
     &            PTRIST, PTLUST, PTRFAC,
     &            PTRAST, STEP, PIMASTER, PAMASTER,
     &            NSTK_S, COMP, IFLAG,
     &            IERROR, COMM,
     &            PERM, IPOOL, LPOOL,LEAF,NBFIN,MYID,SLAVEF,
     &
     &            root, OPASSW, OPELIW, ITLOC, RHS_MUMPS,
     &            FILS, DAD, PTRARW, PTRAIW,
     &            INTARR, DBLARR, ICNTL,
     &            KEEP,KEEP8, DKEEP,ND, FRERE,
     &            LPTRAR, NELT, FRTPTR, FRTELT,
     &            ISTEP_TO_INIV2, TAB_POS_IN_PERE
     &               , LRGROUPS
     &            )
.LT.                  IF ( IFLAG  0 ) RETURN
            ENDIF
          ENDIF
       ENDIF
      ELSE
        IF (BLOCKING) THEN
           CALL MPI_PROBE(MSGSOU,MSGTAG,
     &           COMM, STATUS, IERR)
           FLAG = .TRUE.
        ELSE
           CALL MPI_IPROBE( MPI_ANY_SOURCE, MPI_ANY_TAG,
     &           COMM, FLAG, STATUS, IERR)
        ENDIF
        IF (FLAG) THEN
          MSGSOU_LOC = STATUS( MPI_SOURCE )
          MSGTAG_LOC = STATUS( MPI_TAG )
          MESSAGE_RECEIVED = .TRUE.
          CALL DMUMPS_RECV_AND_TREAT( COMM_LOAD, ASS_IRECV,
     &      STATUS, BUFR, LBUFR,
     &      LBUFR_BYTES,
     &      PROCNODE_STEPS, POSFAC,
     &      IWPOS, IWPOSCB, IPTRLU,
     &      LRLU, LRLUS, N, IW, LIW, A, LA,
     &      PTRIST, PTLUST, PTRFAC,
     &      PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, IFLAG,
     &      IERROR, COMM,
     &      PERM, IPOOL, LPOOL, LEAF, NBFIN, MYID, SLAVEF,
     &
     &      root, OPASSW, OPELIW, ITLOC, RHS_MUMPS,
     &      FILS, DAD, PTRARW, PTRAIW,
     &      INTARR, DBLARR, ICNTL, KEEP,KEEP8,DKEEP, ND, FRERE,
     &      LPTRAR, NELT, FRTPTR, FRTELT,
     &      ISTEP_TO_INIV2, TAB_POS_IN_PERE
     &               , LRGROUPS
     &   )
.LT.          IF ( IFLAG  0 ) RETURN
        ENDIF
      ENDIF
 250  CONTINUE
      RECURS  = RECURS - 1
.EQ.      IF ( NBFIN  0 ) RETURN
.GT.      IF ( RECURS  3 ) RETURN
.EQ..AND..AND.      IF ( KEEP(36)1  SET_IRECV  
.EQ..AND.     &      (ASS_IRECVMPI_REQUEST_NULL) 
     &    MESSAGE_RECEIVED ) THEN
       CALL MPI_IRECV ( BUFR(1),
     &      LBUFR_BYTES, MPI_PACKED, MPI_ANY_SOURCE,
     &      MPI_ANY_TAG, COMM,
     &      ASS_IRECV, IERR )
      ENDIF
      RETURN
      END SUBROUTINE DMUMPS_TRY_RECVTREAT
      SUBROUTINE DMUMPS_CANCEL_IRECV( INFO1,
     &    KEEP, ASS_IRECV,
     &    BUFR, LBUFR, LBUFR_BYTES,
     &    COMM,
     &    MYID, SLAVEF)
      USE DMUMPS_BUF
      IMPLICIT NONE
      INCLUDE 'mpif.h'
      INCLUDE 'mumps_tags.h'
      INTEGER LBUFR, LBUFR_BYTES
      INTEGER ASS_IRECV
      INTEGER BUFR( LBUFR )
      INTEGER COMM
      INTEGER MYID, SLAVEF, INFO1, DEST
      INTEGER, INTENT(INOUT) :: KEEP(500)
      INTEGER :: STATUS(MPI_STATUS_SIZE)
      LOGICAL NO_ACTIVE_IRECV
      INTEGER IERR, DUMMY
      INTRINSIC mod
.EQ.      IF (SLAVEF  1) RETURN
.EQ.      IF (ASS_IRECVMPI_REQUEST_NULL) THEN
        NO_ACTIVE_IRECV=.TRUE.
      ELSE
        CALL MPI_TEST(ASS_IRECV, NO_ACTIVE_IRECV,
     &                STATUS, IERR)
        IF (NO_ACTIVE_IRECV) THEN
          KEEP(266) = KEEP(266) - 1
        ENDIF
      ENDIF
      CALL MPI_BARRIER(COMM,IERR)
      DUMMY = 1
      DEST = mod(MYID+1, SLAVEF)
      CALL DMUMPS_BUF_SEND_1INT
     &    (DUMMY, DEST, TAG_DUMMY, COMM, KEEP, IERR)
      IF (NO_ACTIVE_IRECV) THEN
        CALL MPI_RECV( BUFR, LBUFR,
     &             MPI_INTEGER, MPI_ANY_SOURCE,
     &             TAG_DUMMY, COMM, STATUS, IERR )
      ELSE
        CALL MPI_WAIT(ASS_IRECV,
     &                STATUS, IERR)
      ENDIF
      KEEP(266)=KEEP(266)-1
      RETURN
      END SUBROUTINE DMUMPS_CANCEL_IRECV
      SUBROUTINE DMUMPS_CLEAN_PENDING(
     &    INFO1, KEEP, BUFR, LBUFR, LBUFR_BYTES,
     &    COMM_NODES, COMM_LOAD, SLAVEF,
     &    CLEAN_COMM_NODES, CLEAN_COMM_LOAD )
      USE DMUMPS_BUF
      IMPLICIT NONE
      INTEGER, INTENT(IN)    :: LBUFR, LBUFR_BYTES
      INTEGER, INTENT(OUT)   :: BUFR( LBUFR )
      INTEGER, INTENT(IN)    :: COMM_NODES, COMM_LOAD, SLAVEF, INFO1
      INTEGER, INTENT(INOUT) :: KEEP(500)
      LOGICAL, INTENT(IN)    :: CLEAN_COMM_LOAD, CLEAN_COMM_NODES
      INCLUDE 'mpif.h'
      INCLUDE 'mumps_tags.h'
      INTEGER :: STATUS(MPI_STATUS_SIZE)
      LOGICAL :: FLAG, BUFFERS_EMPTY, BUFFERS_EMPTY_ON_ALL_PROCS
      INTEGER :: MSGSOU_LOC, MSGTAG_LOC, MSGLEN_LOC
      INTEGER ::  COMM_EFF
      INTEGER :: IERR
      INTEGER :: IBUF_EMPTY, IBUF_EMPTY_ON_ALL_PROCS
      INTEGER :: TOTAL_SEND_MINUS_RECV266
      INTEGER :: TOTAL_SEND_MINUS_RECV267
.EQ.      IF (SLAVEF1) RETURN
.NOT..AND..NOT.      IF ( CLEAN_COMM_NODES   CLEAN_COMM_LOAD) THEN
        RETURN
      ENDIF
      DO WHILE (.TRUE.) 
        FLAG = .TRUE.
        DO WHILE ( FLAG )
          FLAG = .FALSE.
          IF (CLEAN_COMM_NODES) THEN
.NOT.            IF (  FLAG ) THEN
              COMM_EFF = COMM_NODES
              CALL MPI_IPROBE(MPI_ANY_SOURCE,MPI_ANY_TAG,
     &             COMM_NODES, FLAG, STATUS, IERR)
            END IF
          END IF
          IF (CLEAN_COMM_LOAD) THEN
.NOT.            IF (  FLAG ) THEN
              COMM_EFF = COMM_LOAD
              CALL MPI_IPROBE( MPI_ANY_SOURCE, MPI_ANY_TAG,
     &             COMM_LOAD, FLAG, STATUS, IERR)
            END IF
          END IF
          IF (FLAG) THEN
            MSGSOU_LOC = STATUS( MPI_SOURCE )
            MSGTAG_LOC = STATUS( MPI_TAG )
.EQ.            IF (COMM_EFF  COMM_NODES) THEN
              KEEP(266) = KEEP(266) - 1
            ELSE
              KEEP(267) = KEEP(267) - 1
            ENDIF
            CALL MPI_GET_COUNT( STATUS, MPI_PACKED, MSGLEN_LOC, IERR )
.LE.            IF (MSGLEN_LOC  LBUFR_BYTES) THEN
              CALL MPI_RECV( BUFR, LBUFR_BYTES,
     &             MPI_PACKED, MSGSOU_LOC,
     &             MSGTAG_LOC, COMM_EFF, STATUS, IERR )
            ENDIF
          ENDIF
        END DO
        CALL DMUMPS_BUF_ALL_EMPTY( CLEAN_COMM_NODES,
     &                             CLEAN_COMM_LOAD,
     &                             BUFFERS_EMPTY )
        IF ( BUFFERS_EMPTY ) THEN
          IBUF_EMPTY = 0
        ELSE
          IBUF_EMPTY = 1
        ENDIF
        IF (CLEAN_COMM_NODES) THEN
          COMM_EFF = COMM_NODES
        ELSE
          COMM_EFF = COMM_LOAD
        ENDIF
        CALL MPI_ALLREDUCE(IBUF_EMPTY,
     &                     IBUF_EMPTY_ON_ALL_PROCS,
     &                     1, MPI_INTEGER, MPI_MAX,
     &                     COMM_EFF, IERR)
        IF ( IBUF_EMPTY_ON_ALL_PROCS == 0) THEN
          BUFFERS_EMPTY_ON_ALL_PROCS = .TRUE.
        ELSE
          BUFFERS_EMPTY_ON_ALL_PROCS = .FALSE.
        ENDIF
        IF (BUFFERS_EMPTY_ON_ALL_PROCS) THEN
          IF (CLEAN_COMM_NODES) THEN
            CALL MPI_ALLREDUCE(KEEP(266),
     &                     TOTAL_SEND_MINUS_RECV266,
     &                     1, MPI_INTEGER, MPI_SUM,
     &                     COMM_EFF, IERR)
          ELSE
            TOTAL_SEND_MINUS_RECV266 = 0
          ENDIF
          IF (CLEAN_COMM_LOAD) THEN
            CALL MPI_ALLREDUCE(KEEP(267), 
     &                     TOTAL_SEND_MINUS_RECV267,
     &                     1, MPI_INTEGER, MPI_SUM,
     &                     COMM_EFF, IERR)
          ELSE
             TOTAL_SEND_MINUS_RECV267 = 0
          ENDIF
.EQ..AND.          IF (TOTAL_SEND_MINUS_RECV266  0 
.EQ.     &        TOTAL_SEND_MINUS_RECV267  0) THEN
            EXIT
          ENDIF
        ENDIF
      ENDDO
      RETURN
      END SUBROUTINE DMUMPS_CLEAN_PENDING