C
C  This file is part of MUMPS 5.1.2, released
C  on Mon Oct  2 07:37:01 UTC 2017
C
C
C  Copyright 1991-2017 CERFACS, CNRS, ENS Lyon, INP Toulouse, Inria,
C  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  http://www.cecill.info/licences/Licence_CeCILL-C_V1-en.html
C
      SUBROUTINE ZMUMPS_PROCESS_DESC_BANDE( MYID, BUFR, LBUFR, 
     &     LBUFR_BYTES,
     &     IWPOS, IWPOSCB,
     &     IPTRLU, LRLU, LRLUS,
     &     TNBPROCFILS, N, IW, LIW, A, LA,
     &     PTRIST, PTRAST, STEP, PIMASTER, PAMASTER, COMP,
     &     KEEP,KEEP8, DKEEP, ITLOC, RHS_MUMPS, ISTEP_TO_INIV2,
#if ! defined(NO_FDM_DESCBAND)
     &     IWHANDLER_IN,
#endif
     &     IFLAG, IERROR )
      USE ZMUMPS_LOAD
#if ! defined(NO_FDM_DESCBAND)
      USE MUMPS_FAC_DESCBAND_DATA_M
#endif
      IMPLICIT NONE
      INTEGER MYID
      INTEGER KEEP(500)
      INTEGER(8) KEEP8(150)
      DOUBLE PRECISION DKEEP(230)
      INTEGER LBUFR, LBUFR_BYTES
      INTEGER BUFR( LBUFR )
      INTEGER(8) :: IPTRLU, LRLU, LRLUS, LA
      INTEGER IWPOS, IWPOSCB, N, LIW
      INTEGER IW( LIW )
      COMPLEX(kind=8) A( LA )
      INTEGER(8) :: PAMASTER(KEEP(28))
      INTEGER(8) :: PTRAST(KEEP(28))
      INTEGER PTRIST(KEEP(28)), STEP(N), 
     & PIMASTER(KEEP(28)), 
     & TNBPROCFILS( KEEP(28) ), ITLOC( N + KEEP(253) )
      COMPLEX(kind=8) :: RHS_MUMPS(KEEP(255))
      INTEGER :: ISTEP_TO_INIV2(KEEP(71))
#if ! defined(NO_FDM_DESCBAND)
      INTEGER IWHANDLER_IN
#endif
      INTEGER COMP, IFLAG, IERROR
      INTEGER INODE, NBPROCFILS, NCOL, NROW, NASS, NSLAVES
      INTEGER NSLAVES_RECU, NFRONT
      INTEGER LREQ
      INTEGER :: IBUFR
      INTEGER(8) :: LREQCB
#if ! defined(NO_FDM_DESCBAND)
      INTEGER :: IWHANDLER_LOC
#endif
      DOUBLE PRECISION FLOP1
      INCLUDE 'mumps_headers.h'
#if ! defined(NO_FDM_DESCBAND)
      INTEGER :: INFO_TMP(2)
#else
#endif
      INTEGER :: LRSTATUS
      INODE = BUFR( 2 )
      NBPROCFILS = BUFR( 3 )
      NROW = BUFR( 4 )
      NCOL = BUFR( 5 )
      NASS = BUFR( 6 )
      NFRONT = BUFR( 7 )
      NSLAVES_RECU = BUFR( 8 )
      LRSTATUS =  BUFR( 9 )
      IBUFR    = 10
#if ! defined(NO_FDM_DESCBAND)
      IWHANDLER_LOC = IWHANDLER_IN
      IF ((IWHANDLER_IN .LE. 0) .AND.
     &   (INODE .NE. INODE_WAITED_FOR)) THEN
        INFO_TMP=0
        CALL MUMPS_FDBD_SAVE_DESCBAND(INODE, BUFR(1), BUFR,
     &                                IWHANDLER_LOC, INFO_TMP)
        IF (INFO_TMP(1) < 0) THEN
          IFLAG = INFO_TMP(1)
          IERROR = INFO_TMP(2)
          RETURN
        ENDIF
        GOTO 555
      ENDIF
#endif
      IF ( KEEP(50) .eq. 0 ) THEN
         FLOP1 = dble( NASS * NROW ) +
     &     dble(NROW*NASS)*dble(2*NCOL-NASS-1)
      ELSE
         FLOP1 = dble( NASS ) * dble( NROW )
     &            * dble( 2 * NCOL - NROW - NASS + 1)
      END IF
      CALL ZMUMPS_LOAD_UPDATE(1,.TRUE.,FLOP1, KEEP,KEEP8)
      IF ( KEEP(50) .eq. 0 ) THEN
        NSLAVES = NSLAVES_RECU + XTRA_SLAVES_UNSYM
      ELSE
        NSLAVES = NSLAVES_RECU + XTRA_SLAVES_SYM   
      END IF
      LREQ   = NROW + NCOL + 6 + NSLAVES + KEEP(IXSZ)
      LREQCB = int(NCOL,8) * int(NROW,8)
      CALL ZMUMPS_ALLOC_CB(.FALSE., 0_8, .FALSE.,.TRUE.,
     &   MYID,N, KEEP, KEEP8, DKEEP, IW, LIW, A, LA,
     &   LRLU, IPTRLU,IWPOS,IWPOSCB,
     &   PTRIST,PTRAST, STEP, PIMASTER,PAMASTER,
     &   LREQ, LREQCB, INODE, S_ACTIVE, .TRUE.,
     &   COMP, LRLUS, IFLAG, IERROR
     &     )
      IF ( IFLAG .LT. 0 ) RETURN
      PTRIST(STEP(INODE)) = IWPOSCB + 1
      PTRAST(STEP(INODE)) = IPTRLU  + 1_8
#     if ! defined(NO_FDM_DESCBAND)
 555  CONTINUE
#     endif
#     if ! defined(NO_FDM_DESCBAND)
        IF ((IWHANDLER_IN .LE. 0) .AND.
     &     (INODE .NE. INODE_WAITED_FOR)) THEN
          RETURN
        ENDIF
        IW(IWPOSCB+1+XXA) = IWHANDLER_LOC
#     endif
      IW( IWPOSCB + 1+KEEP(IXSZ) ) = NCOL
      IW( IWPOSCB + 2+KEEP(IXSZ) ) = - NASS
      IW( IWPOSCB + 3+KEEP(IXSZ) ) = NROW
      IW( IWPOSCB + 4+KEEP(IXSZ) ) = 0
      IW( IWPOSCB + 5+KEEP(IXSZ) ) = NASS
      IW( IWPOSCB + 6+KEEP(IXSZ) ) = NSLAVES
      IW( IWPOSCB + 7+KEEP(IXSZ)+NSLAVES : 
     &           IWPOSCB + 6+KEEP(IXSZ)+NSLAVES + NROW + NCOL )
     &= BUFR( IBUFR + NSLAVES_RECU :
     &        IBUFR + NSLAVES_RECU + NROW + NCOL - 1 )
      IF ( KEEP(50) .eq. 0 ) THEN
        IW( IWPOSCB + 7+KEEP(IXSZ) ) = S_ROOTBAND_INIT
        IF (NSLAVES_RECU.GT.0) THEN
          write(6,*) " Internal error in ZMUMPS_PROCESS_DESC_BANDE "
          CALL MUMPS_ABORT()
        ENDIF
      ELSE
        IW( IWPOSCB+7+KEEP(IXSZ) ) = huge(IW(IWPOSCB+7+KEEP(IXSZ)))
        IW( IWPOSCB + 8+KEEP(IXSZ) ) = NFRONT
        IW( IWPOSCB + 9+KEEP(IXSZ) ) = S_ROOTBAND_INIT
        IW( IWPOSCB + 7+XTRA_SLAVES_SYM+KEEP(IXSZ):
     &      IWPOSCB + 6+XTRA_SLAVES_SYM+KEEP(IXSZ)+NSLAVES_RECU ) =
     &       BUFR( IBUFR: IBUFR - 1 + NSLAVES_RECU )
      END IF
      TNBPROCFILS(STEP( INODE )) = NBPROCFILS
#     if ! defined(NO_XXNBPR)
      IW(IWPOSCB+1+XXNBPR)=NBPROCFILS
#     endif
      IW(IWPOSCB+1+XXLR)=LRSTATUS
      IF (NBPROCFILS .EQ. 0) THEN
      ENDIF
      RETURN
      END SUBROUTINE ZMUMPS_PROCESS_DESC_BANDE
      RECURSIVE SUBROUTINE ZMUMPS_TREAT_DESCBAND( INODE,
     &    COMM_LOAD, ASS_IRECV,
     &    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, NBPROCFILS,
     &    IPOOL, LPOOL, LEAF, NBFIN, MYID, SLAVEF,
     &
     &    root, OPASSW, OPELIW, ITLOC, RHS_MUMPS,
     &    FILS, 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
     & )
#     if ! defined(NO_FDM_DESCBAND)
      USE MUMPS_FAC_DESCBAND_DATA_M
#     endif
      IMPLICIT NONE
      INCLUDE 'zmumps_root.h'
      INTEGER, INTENT(IN) :: INODE  
      TYPE (ZMUMPS_ROOT_STRUC) :: root
      INTEGER KEEP(500), ICNTL(40)
      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 )
      COMPLEX(kind=8) 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 NBPROCFILS( KEEP(28) )
      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 )
      COMPLEX(kind=8) :: 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)))
      COMPLEX(kind=8) DBLARR( KEEP8(26) )
      INTEGER INTARR( KEEP8(27) )
      LOGICAL, intent(in) :: STACK_RIGHT_AUTHORIZED
      INCLUDE 'mpif.h'
      INCLUDE 'mumps_tags.h'
      INCLUDE 'mumps_headers.h'
      LOGICAL :: BLOCKING, SET_IRECV, MESSAGE_RECEIVED
      INTEGER :: STATUS(MPI_STATUS_SIZE)
      INTEGER :: SRC_DESCBAND
#if ! defined(NO_FDM_DESCBAND)
      INTEGER :: IWHANDLER
      TYPE(DESCBAND_STRUC_T), POINTER :: DESCBAND_STRUC
#endif
      INTEGER MUMPS_PROCNODE
      EXTERNAL MUMPS_PROCNODE
      SRC_DESCBAND = MUMPS_PROCNODE( PROCNODE_STEPS(STEP(INODE)),
     &           SLAVEF )
#     if ! defined(NO_FDM_DESCBAND)
      IF (MUMPS_FDBD_IS_DESCBAND_STORED( INODE, IWHANDLER )) THEN 
        CALL MUMPS_FDBD_RETRIEVE_DESCBAND(IWHANDLER, DESCBAND_STRUC)
        CALL ZMUMPS_PROCESS_DESC_BANDE( MYID, DESCBAND_STRUC%BUFR(1),
     &       DESCBAND_STRUC%LBUFR,
     &       LBUFR_BYTES,
     &       IWPOS, IWPOSCB,
     &       IPTRLU, LRLU, LRLUS,
     &       NBPROCFILS, N, IW, LIW, A, LA,
     &       PTRIST, PTRAST, STEP, PIMASTER, PAMASTER, COMP,
     &       KEEP, KEEP8, DKEEP, ITLOC, RHS_MUMPS, ISTEP_TO_INIV2,
     &       IWHANDLER,
     &       IFLAG, IERROR )
        IF (IFLAG .LT. 0) GOTO 500 
        CALL MUMPS_FDBD_FREE_DESCBAND_STRUC(IW(PTRIST(STEP(INODE))+XXA))
      ELSE 
        IF (INODE_WAITED_FOR.GT.0) THEN
          WRITE(*,*) " Internal error 1 in ZMUMPS_TREAT_DESCBAND",
     &    INODE, INODE_WAITED_FOR
          CALL MUMPS_ABORT()
        ENDIF
        INODE_WAITED_FOR = INODE
#     endif
      DO WHILE (PTRIST(STEP(INODE)) .EQ. 0)
        BLOCKING = .TRUE.
        SET_IRECV = .FALSE.
        MESSAGE_RECEIVED = .FALSE.
        CALL ZMUMPS_TRY_RECVTREAT(COMM_LOAD,
     &    ASS_IRECV, BLOCKING, SET_IRECV, MESSAGE_RECEIVED,
     &    SRC_DESCBAND, MAITRE_DESC_BANDE,
     &    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,
     &    NBPROCFILS, IPOOL, LPOOL, LEAF,
     &    NBFIN, MYID, SLAVEF,
     &    root, OPASSW, OPELIW, ITLOC, RHS_MUMPS,
     &    FILS, PTRARW, PTRAIW,
     &    INTARR, DBLARR, ICNTL, KEEP,KEEP8,DKEEP, ND, FRERE,
     &    LPTRAR, NELT, FRTPTR, FRTELT, 
     &    ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. 
     &    , LRGROUPS
     &    )
        IF (IFLAG .LT. 0) THEN
          RETURN
        ENDIF
      ENDDO
#     if ! defined(NO_FDM_DESCBAND)
        INODE_WAITED_FOR = -1
      ENDIF
#     endif
      RETURN
 500  CONTINUE
      CALL ZMUMPS_BDC_ERROR( MYID, SLAVEF, COMM, KEEP )
      RETURN
      END SUBROUTINE ZMUMPS_TREAT_DESCBAND