C
C  This file is part of MUMPS 5.8.1, released
C  on Wed Jul 30 16:49:18 UTC 2025
C
C
C  Copyright 1991-2025 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 SMUMPS_END_FACTO_SLAVE(
     &    COMM_LOAD, ASS_IRECV, 
     &    N, INODE, FPERE, 
     &    root, roota,
     &    MYID, COMM,
     &    
     &    BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC,
     &    IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, IW, LIW, A, LA,
     &    PTRIST, PTLUST_S, PTRFAC, PTRAST, STEP, PIMASTER,
     &    PAMASTER,
     &    NSTK, COMP, IFLAG, IERROR, PERM,
     &    IPOOL, LPOOL, LEAF, NBFIN, SLAVEF,
     &    OPASSW, OPELIW, ITLOC, RHS_MUMPS, FILS, DAD, PTRARW, PTRAIW,
     &    PTR8ARR, NINCOLARR, NINROWARR, PTRDEBARR,
     &    INTARR, DBLARR, ICNTL, KEEP,KEEP8,DKEEP, ND, FRERE,
     &    LPTRAR, NELT, FRTPTR, FRTELT, 
     &    ISTEP_TO_INIV2, TAB_POS_IN_PERE 
     &               , LRGROUPS
     &    )
      USE MUMPS_LOAD
#if ! defined(NO_FDM_MAPROW)
      USE MUMPS_FAC_MAPROW_DATA_M
#endif
      USE SMUMPS_LR_DATA_M  
      USE MUMPS_INTR_TYPES, ONLY : MUMPS_ROOT_STRUC
      USE SMUMPS_INTR_TYPES, ONLY : SMUMPS_ROOT_STRUC
      IMPLICIT NONE
      INCLUDE 'mumps_headers.h'
      INCLUDE 'mpif.h'
      INCLUDE 'mumps_tags.h'
      INTEGER INODE, FPERE
      TYPE (MUMPS_ROOT_STRUC) :: root
      TYPE (SMUMPS_ROOT_STRUC) :: roota
      INTEGER COMM, MYID
      INTEGER ICNTL( 60 ), KEEP( 500 )
      INTEGER(8) KEEP8(150)
      REAL    DKEEP(230)
      INTEGER COMM_LOAD, ASS_IRECV
      INTEGER N
      INTEGER LBUFR, LBUFR_BYTES
      INTEGER BUFR( LBUFR )
      INTEGER(8) :: POSFAC, IPTRLU, LRLU, LRLUS, LA
      INTEGER PROCNODE_STEPS(KEEP(28)), PTRIST(KEEP(28)),
     &        NSTK(KEEP(28)), PTLUST_S(KEEP(28))
      INTEGER IWPOS, IWPOSCB
      INTEGER LIW
      INTEGER IW( LIW )
      REAL A( LA )
      INTEGER, intent(in) :: LRGROUPS(KEEP(280))
      INTEGER LPTRAR, NELT
      INTEGER FRTPTR( N+1 ), FRTELT( NELT )
      INTEGER(8) :: PTRAST(KEEP(28))
      INTEGER(8) :: PTRFAC(KEEP(28))
      INTEGER(8) :: PAMASTER(KEEP(28))
      INTEGER STEP(N), PIMASTER(KEEP(28))
      INTEGER COMP, IFLAG, IERROR
      INTEGER PERM(N)
      INTEGER LPOOL, LEAF
      INTEGER IPOOL( LPOOL )
      INTEGER NBFIN, SLAVEF
      DOUBLE PRECISION OPASSW, OPELIW
      INTEGER ITLOC( N + KEEP(253) ), FILS( N ), DAD( KEEP(28) )
      REAL :: RHS_MUMPS(KEEP8(85))
      INTEGER ND( KEEP(28) )
      INTEGER(8), INTENT(IN) :: PTRARW( LPTRAR ), PTRAIW( LPTRAR )
      INTEGER(8), INTENT(IN) :: PTR8ARR(KEEP(193))
      INTEGER, INTENT(IN) :: NINCOLARR(KEEP(194))
      INTEGER, INTENT(IN) :: NINROWARR(KEEP(195))
      INTEGER, INTENT(IN) :: PTRDEBARR(KEEP(196))
      INTEGER FRERE(KEEP(28))
      INTEGER INTARR( KEEP8(27) )
      REAL DBLARR( KEEP8(26) )
      INTEGER ISTEP_TO_INIV2(KEEP(71)), 
     &        TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56)))
      INTEGER MRS_INODE
      INTEGER MRS_ISON
      INTEGER MRS_NSLAVES_PERE
      INTEGER MRS_NASS_PERE
      INTEGER MRS_NFRONT_PERE
      INTEGER MRS_LMAP
      INTEGER MRS_NFS4FATHER
      INTEGER, POINTER, DIMENSION(:) :: MRS_SLAVES_PERE, MRS_TROW
      INTEGER ITYPE2
      INTEGER IHDR_REC
      PARAMETER (ITYPE2=2)
      INTEGER IOLDPS, NROW, LDA
      INTEGER NPIV, LCONT, NELIM, NASS, NCOL_TO_SEND,
     &        SHIFT_LIST_ROW_SON, SHIFT_LIST_COL_SON
      INTEGER(8) :: SHIFT_VAL_SON
      INTEGER(8) :: MEM_GAIN 
      INTEGER(8) :: DYN_SIZE
#if ! defined(NO_FDM_MAPROW)
      TYPE(MAPROW_STRUC_T), POINTER :: MRS
#endif
      INTEGER :: IWHANDLER_SAVE
      INTEGER    :: LRSTATUS
      LOGICAL    :: CB_STORED_IN_BLRSTRUC, COMPRESS_CB
        IF (KEEP(50).EQ.0) THEN
          IHDR_REC=6
        ELSE
          IHDR_REC=8
        ENDIF
        IOLDPS = PTRIST(STEP(INODE))
        IWHANDLER_SAVE = IW(IOLDPS+XXA)
        LRSTATUS = IW(IOLDPS+XXLR)
        COMPRESS_CB    = ((LRSTATUS.EQ.1).OR.
     &                  (LRSTATUS.EQ.3))
        IF (.NOT.
     &       (
     &         (KEEP(486).EQ.2) 
     &       )
     &       .AND..NOT.COMPRESS_CB) THEN
          CALL SMUMPS_BLR_END_FRONT(IW(IOLDPS+XXF), IFLAG, KEEP8,
     &                              KEEP(34))
        ENDIF
        IW(IOLDPS+XXS)=S_ALL
         IOLDPS = PTRIST(STEP(INODE))
         LRSTATUS = IW(IOLDPS+XXLR)
         IF ( (KEEP(214).EQ.1)
     &      ) THEN
          CALL SMUMPS_STACK_BAND( N, INODE,
     &    PTRIST, PTRAST, PTLUST_S, PTRFAC, IW, LIW, A, LA,
     &    LRLU, LRLUS, IWPOS, IWPOSCB, POSFAC, COMP, 
     &    IPTRLU, OPELIW, STEP, PIMASTER, PAMASTER,
     &    IFLAG, IERROR, SLAVEF, PROCNODE_STEPS, DAD, MYID, COMM,
     &    KEEP,KEEP8, DKEEP, ITYPE2
     &     )
          IOLDPS = PTRIST(STEP(INODE)) 
          IF (KEEP(38).NE.FPERE) THEN
            CB_STORED_IN_BLRSTRUC = .FALSE.
            LRSTATUS              = IW(IOLDPS+XXLR)
            IF ((LRSTATUS.EQ.1).OR.(LRSTATUS.EQ.3)) THEN
              CB_STORED_IN_BLRSTRUC = .TRUE.
              IW(IOLDPS+XXS) = S_NOLNOCB
              CALL MUMPS_GETI8(MEM_GAIN, IW(IOLDPS+XXR))
              LRLUS  = LRLUS + MEM_GAIN
              KEEP8(69) = KEEP8(69) - MEM_GAIN
              CALL MUMPS_LOAD_MEM_UPDATE(.FALSE.,.FALSE.,
     &              LA-LRLUS,0_8,-MEM_GAIN,KEEP,KEEP8,LRLUS)
            ELSE
              IW(IOLDPS+XXS)=S_NOLCBNOCONTIG
              CALL MUMPS_GETI8( DYN_SIZE, IW(IOLDPS+XXD))
              IF (DYN_SIZE .GT.0) THEN
              ELSE IF (KEEP(216).NE.3) THEN
               MEM_GAIN=int(IW( IOLDPS + 2 + KEEP(IXSZ) ),8)*
     &                int(IW( IOLDPS + 3 + KEEP(IXSZ) ),8)
               LRLUS = LRLUS+MEM_GAIN
               KEEP8(69) = KEEP8(69) - MEM_GAIN
               CALL MUMPS_LOAD_MEM_UPDATE(.FALSE.,.FALSE.,
     &              LA-LRLUS,0_8,-MEM_GAIN,KEEP,KEEP8,LRLUS)
              ENDIF
            ENDIF
          ENDIF
          CALL MUMPS_GETI8( DYN_SIZE, IW(IOLDPS+XXD))
          IF (DYN_SIZE > 0_8) THEN
          ELSE IF (KEEP(216).EQ.2) THEN
           IF (FPERE.NE.KEEP(38)) THEN
             IF (.NOT. CB_STORED_IN_BLRSTRUC) THEN
                CALL SMUMPS_MAKECBCONTIG(A,LA,PTRAST(STEP(INODE)),
     &            IW( IOLDPS + 2 + KEEP(IXSZ) ),
     &            IW( IOLDPS + KEEP(IXSZ) ),
     &            IW( IOLDPS + 3 + KEEP(IXSZ) )+
     &            IW( IOLDPS + KEEP(IXSZ) ), 0,
     &            IW( IOLDPS + XXS ), 0_8 )
                IW(IOLDPS+XXS)=S_NOLCBCONTIG
             ENDIF
           ENDIF
          ENDIF 
         ENDIF 
      IF ( KEEP(38).EQ.FPERE) THEN
       LCONT  = IW(IOLDPS+KEEP(IXSZ))
       NROW   = IW(IOLDPS+2+KEEP(IXSZ))
       NPIV   = IW(IOLDPS+3+KEEP(IXSZ))
       NASS   = IW(IOLDPS+4+KEEP(IXSZ))
       NELIM  = NASS-NPIV
       NCOL_TO_SEND =  LCONT-NELIM
       SHIFT_LIST_ROW_SON = 6 + IW(IOLDPS+5+KEEP(IXSZ)) + KEEP(IXSZ)
       SHIFT_LIST_COL_SON = SHIFT_LIST_ROW_SON + NROW + NASS
       SHIFT_VAL_SON      = int(NASS,8)
       LDA                = LCONT + NPIV
      IF (IW(IOLDPS+IHDR_REC+KEEP(IXSZ)).EQ.S_ROOTBAND_INIT) THEN
        IW(IOLDPS+IHDR_REC+KEEP(IXSZ)) = S_REC_CONTSTATIC
      ELSE
      ENDIF
       CALL SMUMPS_BUILD_AND_SEND_CB_ROOT( COMM_LOAD, ASS_IRECV, 
     &    N, INODE, FPERE, 
     &    PTRIST, PTRAST, 
     &    root, roota, NROW, NCOL_TO_SEND, SHIFT_LIST_ROW_SON,
     &    SHIFT_LIST_COL_SON , SHIFT_VAL_SON, LDA, 
     &    ROOT_CONT_STATIC, MYID, COMM,
     &    
     &    BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC,
     &    IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, IW, LIW, A, LA,
     &    PTRIST, PTLUST_S, PTRFAC, PTRAST, STEP, PIMASTER,
     &    PAMASTER,
     &    NSTK, COMP, IFLAG, IERROR, PERM,
     &    IPOOL, LPOOL, LEAF, NBFIN, SLAVEF,
     &    OPASSW, OPELIW, ITLOC, RHS_MUMPS, FILS, DAD, PTRARW, PTRAIW,
     &    PTR8ARR, NINCOLARR, NINROWARR, PTRDEBARR,
     &    INTARR,DBLARR,ICNTL,KEEP,KEEP8,DKEEP,.FALSE.,ND,FRERE,
     &    LPTRAR, NELT, FRTPTR, FRTELT, 
     &    ISTEP_TO_INIV2, TAB_POS_IN_PERE 
     &               , LRGROUPS, 0, 0, 0
     &    )
       IF ( IFLAG < 0 ) GOTO 600
       IF (NELIM.EQ.0) THEN
         IF (KEEP(214).EQ.2) THEN
          CALL SMUMPS_STACK_BAND( N, INODE,  
     &    PTRIST, PTRAST, PTLUST_S, PTRFAC, IW, LIW, A, LA,
     &    LRLU, LRLUS, IWPOS, IWPOSCB, POSFAC, COMP,
     &    IPTRLU, OPELIW, STEP, PIMASTER, PAMASTER,
     &    IFLAG, IERROR, SLAVEF, PROCNODE_STEPS, DAD, MYID,
     &    COMM, KEEP,KEEP8,DKEEP, ITYPE2
     &    )
         ENDIF
         CALL SMUMPS_FREE_BAND( N, INODE, PTRIST, PTRAST, IW, LIW,
     &        A, LA, LRLU, LRLUS, IWPOSCB, IPTRLU, STEP,
     &        MYID, KEEP, KEEP8, ITYPE2
     &         )
       ELSE
         IOLDPS = PTRIST(STEP(INODE))
         IF (IW(IOLDPS+IHDR_REC+KEEP(IXSZ)).EQ.S_ROOT2SON_CALLED) THEN
           CALL SMUMPS_FREE_BAND( N, INODE, PTRIST, PTRAST, IW, LIW,
     &        A, LA, LRLU, LRLUS, IWPOSCB, IPTRLU, STEP,
     &        MYID, KEEP, KEEP8, ITYPE2
     &         )
         ELSE
          IW(IOLDPS+IHDR_REC+KEEP(IXSZ)) = S_ROOTBAND_INIT
          IF (KEEP(214).EQ.1.AND.KEEP(216).NE.3) THEN
           IW(IOLDPS+XXS)=S_NOLCBNOCONTIG38
           CALL SMUMPS_SIZEFREEINREC( IW(IOLDPS),
     &                     LIW-IOLDPS+1,
     &                     MEM_GAIN, KEEP(IXSZ) )
           LRLUS = LRLUS + MEM_GAIN
           KEEP8(69) = KEEP8(69) - MEM_GAIN
              CALL MUMPS_LOAD_MEM_UPDATE(.FALSE.,.FALSE.,
     &                LA-LRLUS,0_8,-MEM_GAIN,KEEP,KEEP8,LRLUS)
            IF (KEEP(216).EQ.2) THEN
              CALL SMUMPS_MAKECBCONTIG(A,LA,PTRAST(STEP(INODE)),
     &         IW( IOLDPS + 2 + KEEP(IXSZ) ),
     &         IW( IOLDPS + KEEP(IXSZ) ),
     &         IW( IOLDPS + 3 + KEEP(IXSZ) )+
     &         IW( IOLDPS + KEEP(IXSZ) ),
     &         IW( IOLDPS + 4 + KEEP(IXSZ) ) -
     &         IW( IOLDPS + 3 + KEEP(IXSZ) ),
     &         IW( IOLDPS + XXS ),0_8)
              IW(IOLDPS+XXS)=S_NOLCBCONTIG38
            ENDIF
          ENDIF
         ENDIF 
       ENDIF 
      ENDIF 
 600  CONTINUE
#if ! defined(NO_FDM_MAPROW)
      IOLDPS = PTRIST(STEP(INODE)) 
      IF (FPERE .NE. KEEP(38)) THEN
       IF (MUMPS_FMRD_IS_MAPROW_STORED( IW(IOLDPS+XXA) )) THEN
        CALL MUMPS_FMRD_RETRIEVE_MAPROW( IW(IOLDPS+XXA), MRS )
        IF (FPERE .NE. MRS%INODE) THEN
          WRITE(*,*) " Internal error 1 in SMUMPS_END_FACTO_SLAVE",
     &               INODE, MRS%INODE, FPERE
          CALL MUMPS_ABORT()
        ENDIF
        MRS_INODE        = MRS%INODE
        MRS_ISON         = MRS%ISON
        MRS_NSLAVES_PERE = MRS%NSLAVES_PERE
        MRS_NASS_PERE    = MRS%NASS_PERE
        MRS_NFRONT_PERE  = MRS%NFRONT_PERE
        MRS_LMAP         = MRS%LMAP
        MRS_NFS4FATHER   = MRS%NFS4FATHER
        MRS_SLAVES_PERE  => MRS%SLAVES_PERE
        MRS_TROW         => MRS%TROW
        CALL SMUMPS_MAPLIG( COMM_LOAD, ASS_IRECV,
     &           BUFR, LBUFR, LBUFR_BYTES,
     &  MRS_INODE, MRS_ISON,
     &  MRS_NSLAVES_PERE, MRS_SLAVES_PERE(1),
     &  MRS_NFRONT_PERE, MRS_NASS_PERE, MRS_NFS4FATHER,
     &  MRS_LMAP, MRS_TROW(1),
     &  PROCNODE_STEPS, SLAVEF, POSFAC, IWPOS, IWPOSCB, IPTRLU, LRLU,
     &  LRLUS, N, IW, LIW, A, LA, PTRIST, PTLUST_S, PTRFAC,
     &  PTRAST, STEP, PIMASTER, PAMASTER, NSTK, COMP,
     &  IFLAG, IERROR, MYID, COMM, PERM, IPOOL, LPOOL, LEAF,
     &  NBFIN, ICNTL, KEEP,KEEP8,DKEEP,
     &  root, roota, OPASSW, OPELIW,
     &  ITLOC, RHS_MUMPS,
     &  FILS, DAD, PTRARW, PTRAIW,
     &  PTR8ARR, NINCOLARR, NINROWARR, PTRDEBARR,
     &  INTARR, DBLARR, ND, FRERE,
     &  LPTRAR, NELT, FRTPTR, FRTELT, 
     &
     &  ISTEP_TO_INIV2, TAB_POS_IN_PERE 
     &               , LRGROUPS
     &  )
       CALL MUMPS_FMRD_FREE_MAPROW_STRUC( IWHANDLER_SAVE )
       ENDIF
      ENDIF
#endif
      RETURN
      END SUBROUTINE SMUMPS_END_FACTO_SLAVE
