zfac_process_blfac_slave.F File Reference

Go to the source code of this file.

Functions/Subroutines

recursive subroutine

zmumps_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_s, ptrfac, root, opassw, opeliw, itloc, rhs_mumps, fils, dad, ptrarw, ptraiw, intarr, dblarr, icntl, keep, keep8, dkeep, ipool, lpool, leaf, nd, frere_steps, lptrar, nelt, frtptr, frtelt, istep_to_iniv2, tab_pos_in_pere, lrgroups)

Function/Subroutine Documentation

zmumps_process_blfac_slave()

recursive subroutine zmumps_process_blfac_slave	(	integer	comm_load,
		integer	ass_irecv,
		integer, dimension( lbufr )	bufr,
		integer	lbufr,
		integer	lbufr_bytes,
		integer, dimension(keep(28))	procnode_steps,
		integer	msgsou,
		integer	slavef,
		integer	iwpos,
		integer	iwposcb,
		integer(8)	iptrlu,
		integer(8)	lrlu,
		integer(8)	lrlus,
		integer	n,
		integer, dimension( liw )	iw,
		integer	liw,
		complex(kind=8), dimension( la )	a,
		integer(8)	la,
		integer, dimension(keep(28))	ptrist,
		integer(8), dimension(keep(28))	ptrast,
		integer, dimension(keep(28))	nstk_s,
		integer, dimension(n)	perm,
		integer	comp,
		integer, dimension(n)	step,
		integer, dimension(keep(28))	pimaster,
		integer(8), dimension(keep(28))	pamaster,
		integer(8)	posfac,
		integer	myid,
		integer	comm,
		integer	iflag,
		integer	ierror,
		integer	nbfin,
		integer, dimension(keep(28))	ptlust_s,
		integer(8), dimension(keep(28))	ptrfac,
		type (zmumps_root_struc)	root,
		double precision	opassw,
		double precision	opeliw,
		integer, dimension( n + keep(253))	itloc,
		complex(kind=8), dimension(keep(255))	rhs_mumps,
		integer, dimension( n )	fils,
		integer, dimension( keep(28) )	dad,
		integer(8), dimension( lptrar ), intent(in)	ptrarw,
		integer(8), dimension( lptrar ), intent(in)	ptraiw,
		integer, dimension( keep8(27) )	intarr,
		complex(kind=8), dimension( keep8(26) )	dblarr,
		integer, dimension( 60 )	icntl,
		integer, dimension( 500 )	keep,
		integer(8), dimension(150)	keep8,
		double precision, dimension(230)	dkeep,
		integer, dimension( lpool )	ipool,
		integer	lpool,
		integer	leaf,
		integer, dimension( keep(28) )	nd,
		integer, dimension( keep(28) )	frere_steps,
		integer	lptrar,
		integer	nelt,
		integer, dimension( n + 1 )	frtptr,
		integer, dimension( nelt )	frtelt,
		integer, dimension(keep(71))	istep_to_iniv2,
		integer, dimension(slavef+2,max(1,keep(56)))	tab_pos_in_pere,
		integer, dimension(n), intent(in)	lrgroups )

Definition at line 14 of file zfac_process_blfac_slave.F.

      USE zmumps_buf
      USE zmumps_load
      USE zmumps_lr_core
      USE zmumps_lr_type
      USE zmumps_fac_lr
      USE zmumps_lr_data_m
      USE zmumps_struc_def, ONLY : zmumps_root_struc
      USE zmumps_dynamic_memory_m, ONLY : zmumps_dm_set_dynptr
      USE zmumps_fac_front_aux_m, ONLY : zmumps_get_size_schur_in_front
#if defined(BLR_MT)
!$    USE OMP_LIB
#endif
      IMPLICIT NONE
      TYPE (ZMUMPS_ROOT_STRUC) :: root
      INTEGER ICNTL( 60 ), KEEP( 500 )
      INTEGER(8) KEEP8(150)
      DOUBLE PRECISION       DKEEP(230)
      INTEGER LBUFR, LBUFR_BYTES
      INTEGER COMM_LOAD, ASS_IRECV
      INTEGER BUFR( LBUFR )
      INTEGER N, SLAVEF, IWPOS, IWPOSCB, LIW
      INTEGER(8) :: POSFAC, IPTRLU, LRLU, LRLUS, LA
      INTEGER(8) :: PTRAST(KEEP(28))
      INTEGER(8) :: PAMASTER(KEEP(28))
      INTEGER(8) :: PTRFAC(KEEP(28))
      INTEGER COMP
      INTEGER IFLAG, IERROR, NBFIN, MSGSOU
      INTEGER PROCNODE_STEPS(KEEP(28)), PTRIST(KEEP(28)),
     &        NSTK_S(KEEP(28))
      INTEGER PERM(N), STEP(N), PIMASTER(KEEP(28))
      INTEGER IW( LIW )
      COMPLEX(kind=8) A( LA )
      INTEGER, intent(in) :: LRGROUPS(N)
      INTEGER NELT, LPTRAR
      INTEGER FRTPTR( N + 1 ), FRTELT( NELT )
      INTEGER(8), INTENT(IN) :: PTRAIW( LPTRAR ), PTRARW( LPTRAR )
      INTEGER ISTEP_TO_INIV2(KEEP(71)), 
     &        TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56)))
      INTEGER COMM, MYID
      INTEGER PTLUST_S(KEEP(28))
      INTEGER ITLOC( N + KEEP(253)), FILS( N ), DAD( KEEP(28) )
      COMPLEX(kind=8) :: RHS_MUMPS(KEEP(255))
      INTEGER ND( KEEP(28) ), FRERE_STEPS( KEEP(28) )
      DOUBLE PRECISION OPASSW, OPELIW
      DOUBLE PRECISION FLOP1
      COMPLEX(kind=8) DBLARR( KEEP8(26) )
      INTEGER INTARR( KEEP8(27) )
      INTEGER LEAF, LPOOL 
      INTEGER IPOOL( LPOOL )
      include 'mumps_headers.h'
      include 'mpif.h'
      include 'mumps_tags.h'
      INTEGER :: STATUS(MPI_STATUS_SIZE)
      INTEGER MUMPS_PROCNODE
      EXTERNAL mumps_procnode
      INTEGER INODE, IPOSK, JPOSK, NCOLU, NPIV, POSITION, IERR
      INTEGER(8) POSELT, POSBLOCFACTO
      INTEGER(8) LAELL
      INTEGER(8) :: LA_PTR 
      COMPLEX(kind=8), DIMENSION(:), POINTER :: A_PTR
      INTEGER IOLDPS, LCONT1, NROW1, NCOL1, NPIV1
      INTEGER NSLAVES_TOT, HS, DEST, NSLAVES_FOLLOW
      INTEGER FPERE
      INTEGER(8) CPOS, LPOS
      LOGICAL DYNAMIC_ALLOC
      LOGICAL BLOCKING, SET_IRECV, MESSAGE_RECEIVED
      INTEGER allocok
      INTEGER LR_ACTIVATED_INT
      LOGICAL LR_ACTIVATED, COMPRESS_CB
      INTEGER NB_BLR_U, CURRENT_BLR_U
      TYPE (LRB_TYPE), DIMENSION(:), ALLOCATABLE :: BLR_U
      INTEGER, POINTER, DIMENSION(:) :: BEGS_BLR_U
      TYPE (LRB_TYPE), DIMENSION(:), POINTER :: BLR_LS
      TYPE (LRB_TYPE), POINTER, DIMENSION(:,:) :: CB_LRB
      INTEGER, POINTER, DIMENSION(:) :: BEGS_BLR_LS, BEGS_BLR_COL
      INTEGER    :: NB_BLR_LS, IPANEL,
     &           MAXI_CLUSTER_LS, MAXI_CLUSTER, 
     &           NB_BLR_COL, MAXI_CLUSTER_COL, NPARTSASS_MASTER
      COMPLEX(kind=8), ALLOCATABLE, DIMENSION(:) :: WORK, TAU
      INTEGER, ALLOCATABLE, DIMENSION(:) :: JPVT
      COMPLEX(kind=8), ALLOCATABLE, DIMENSION(:,:) :: BLOCKLR
      DOUBLE PRECISION,ALLOCATABLE,DIMENSION(:) :: RWORK
      INTEGER :: OMP_NUM, LWORK
      INTEGER :: II,JJ
      INTEGER :: NFS4FATHER, NASS1, NELIM, INFO_TMP(2)
      INTEGER :: NVSCHUR_K253, NSLAVES_L, IROW_L
      INTEGER :: NBROWSinF
      DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:) :: M_ARRAY
      COMPLEX(kind=8), ALLOCATABLE, DIMENSION(:) :: UDYNAMIC
      COMPLEX(kind=8) ONE,ALPHA
      parameter(one=(1.0d0,0.0d0), alpha=(-1.0d0,0.0d0))
      dynamic_alloc = .false.
      position  = 0
      CALL mpi_unpack( bufr, lbufr_bytes, position, inode, 1,
     &                 mpi_integer, comm, ierr )
      CALL mpi_unpack( bufr, lbufr_bytes, position, iposk, 1,
     &                 mpi_integer, comm, ierr )
      CALL mpi_unpack( bufr, lbufr_bytes, position, jposk, 1,
     &                 mpi_integer, comm, ierr )
      CALL mpi_unpack( bufr, lbufr_bytes, position, npiv, 1,
     &                 mpi_integer, comm, ierr )
      IF ( npiv .LE. 0 ) THEN
        npiv = - npiv
        WRITE(*,*) myid,':error, received negative NPIV in BLFAC'
        CALL mumps_abort()
      END IF
      CALL mpi_unpack( bufr, lbufr_bytes, position, fpere, 1,
     &                 mpi_integer, comm, ierr )
      CALL mpi_unpack( bufr, lbufr_bytes, position, ncolu, 1,
     &                 mpi_integer, comm, ierr )
      CALL mpi_unpack( bufr, lbufr_bytes, position, 
     &                 lr_activated_int, 1,
     &                 mpi_integer, comm, ierr )
      lr_activated   = (lr_activated_int.EQ.1)
      CALL mpi_unpack( bufr, lbufr_bytes, position, 
     &                 ipanel, 1,
     &                 mpi_integer, comm, ierr )
      IF (lr_activated) THEN
          CALL mpi_unpack( bufr, lbufr_bytes, position,
     &                 nb_blr_u, 1, mpi_integer,
     &                 comm, ierr )
          current_blr_u = 1 
          ALLOCATE(blr_u(max(nb_blr_u,1)),
     &             begs_blr_u(nb_blr_u+2), stat=allocok)
          if (allocok .GT. 0) THEN
             iflag = -13 
             ierror = max(nb_blr_u,1) + nb_blr_u+2
             GOTO 700
          endif
          CALL zmumps_mpi_unpack_lr(bufr, lbufr, lbufr_bytes,
     &                        position, jposk-1, 0, 'V',
     &                        blr_u, nb_blr_u, 
     &                        begs_blr_u(1),
     &                        keep8, comm, ierr, iflag, ierror)
          IF (iflag.LT.0) GOTO 700
      ELSE
      laell = int(npiv,8) * int(ncolu,8)
      CALL zmumps_get_size_needed(
     &        0, laell, .false.,
     &        keep(1), keep8(1),
     &        n, iw, liw, a, la,
     &        lrlu, iptrlu,
     &        iwpos, iwposcb, ptrist, ptrast,
     &        step, pimaster, pamaster, lrlus,
     &        keep(ixsz),comp,dkeep(97),myid, slavef,
     &        procnode_steps, dad, 
     &        iflag, ierror)
      IF (iflag.LT.0) GOTO 700
      lrlu  = lrlu - laell
      lrlus = lrlus - laell
      keep8(67) = min(lrlus, keep8(67))
      keep8(69) = keep8(69) + laell
      keep8(68) = max(keep8(69), keep8(68))
      posblocfacto = posfac
      posfac = posfac + laell
      CALL zmumps_load_mem_update(.false.,.false.,
     &                           la-lrlus,0_8, laell,keep,keep8,lrlus)
      CALL mpi_unpack( bufr, lbufr_bytes, position,
     &                 a(posblocfacto), npiv*ncolu,
     &                 mpi_double_complex,
     &                 comm, ierr )
      ENDIF
      IF (ptrist(step( inode )) .EQ. 0) dynamic_alloc = .true.
      IF ( (ptrist(step( inode )).NE.0) .AND.
     &  (iposk + npiv -1 .GT.
     &   iw(ptrist(step(inode))+3+keep(ixsz))) )THEN
        dynamic_alloc = .true.
      ENDIF
      IF (lr_activated) THEN
       dynamic_alloc = .false.
      ENDIF
      IF (dynamic_alloc)  THEN
        ALLOCATE(udynamic(laell), stat=allocok)
        if (allocok .GT. 0) THEN
          iflag = -13 
          CALL mumps_set_ierror(laell,ierror)
          GOTO 700
        endif
        udynamic(1_8:laell) = a(posblocfacto:posblocfacto+laell-1_8)
        lrlu  = lrlu + laell
        lrlus = lrlus + laell
        keep8(69) = keep8(69) - laell
        posfac = posfac - laell
      CALL zmumps_load_mem_update(.false.,.false.,
     &          la-lrlus,0_8,-laell,keep,keep8,lrlus)
      ENDIF
      IF (ptrist(step( inode )) .EQ. 0) THEN
          CALL 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_s, 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_steps,
     &      lptrar, nelt, frtptr, frtelt, 
     &      istep_to_iniv2, tab_pos_in_pere, .true.
     &               , lrgroups
     &     )
        IF ( iflag .LT. 0 ) GOTO 600
      ENDIF
      DO WHILE ( iposk + npiv -1 .GT.
     &            iw( ptrist(step( inode )) + 3 +keep(ixsz)) )
        msgsou = mumps_procnode( procnode_steps(step(inode)),
     &                           keep(199) )
        blocking  = .true.
        set_irecv = .false.
        message_received = .false.
        CALL zmumps_try_recvtreat( comm_load,
     &    ass_irecv, blocking, set_irecv, message_received,
     &    msgsou, bloc_facto_sym, status, 
     &    bufr, lbufr, lbufr_bytes, procnode_steps, posfac,
     &    iwpos, iwposcb, iptrlu,
     &    lrlu, lrlus, n, iw, liw, a, la, ptrist,
     &    ptlust_s, 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_steps,
     &    lptrar, nelt, frtptr, frtelt,
     &    istep_to_iniv2, tab_pos_in_pere, .true.
     &               , lrgroups
     &      )
        IF ( iflag .LT. 0 ) GOTO 600
      END DO
        set_irecv = .true.
        blocking  = .false.
        message_received = .true.
        CALL zmumps_try_recvtreat( comm_load,
     &    ass_irecv, blocking, set_irecv, message_received,
     &    mpi_any_source, mpi_any_tag, 
     &    status, 
     &    bufr, lbufr, lbufr_bytes, procnode_steps, posfac,
     &    iwpos, iwposcb, iptrlu,
     &    lrlu, lrlus, n, iw, liw, a, la, ptrist,
     &    ptlust_s, 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_steps,
     &    lptrar, nelt, frtptr, frtelt, 
     &    istep_to_iniv2, tab_pos_in_pere, .true. 
     &               , lrgroups
     &     )
      ioldps  = ptrist(step( inode ))
      CALL zmumps_dm_set_dynptr( iw(ioldps+xxs), a, la,
     &     ptrast(step(inode)), iw(ioldps+xxd), iw(ioldps+xxr),
     &     a_ptr, poselt, la_ptr )
      lcont1  = iw( ioldps + keep(ixsz) )
      nrow1   = iw( ioldps + 2  + keep(ixsz))
      npiv1   = iw( ioldps + 3  + keep(ixsz))
      nslaves_tot = iw( ioldps + 5  + keep(ixsz))
      hs      = 6 + nslaves_tot + keep(ixsz)
      ncol1   = lcont1 + npiv1
      IF (lr_activated) THEN
         CALL zmumps_blr_dec_and_retrieve_l (iw(ioldps+xxf), ipanel, 
     &        begs_blr_ls, blr_ls)
         nb_blr_ls = size(begs_blr_ls)-2   
#if defined(blr_mt)          
!$OMP PARALLEL
#endif
         CALL zmumps_blr_update_trailing_i (
     &        a_ptr(poselt), la_ptr, 1_8,
     &        iflag, ierror, ncol1,
     &        begs_blr_ls(1), size(begs_blr_ls),
     &        begs_blr_u(1), size(begs_blr_u),
     &        current_blr_u, 
     &        blr_ls(1),  nb_blr_ls+1,
     &        blr_u(1), nb_blr_u+1,
     &        0,       
     &        .true.,  
     &        0,       
     &        2,       
     &        1,
     &        keep(481), dkeep(11), keep(466), keep(477) 
     &         )
#if defined(BLR_MT)          
!$OMP END PARALLEL
#endif          
          CALL dealloc_blr_panel(blr_u, nb_blr_u, keep8, keep(34))
          IF (allocated(blr_u)) DEALLOCATE(blr_u)
          IF (associated(begs_blr_u)) DEALLOCATE(begs_blr_u)
          IF (iflag.LT.0) GOTO 700
         IF (keep(486).EQ.3) THEN
         CALL zmumps_blr_try_free_panel(iw(ioldps+xxf), ipanel, 
     &                            keep8, keep(34)) 
         ENDIF
      ELSE
      cpos = poselt + int(jposk - 1,8)
      lpos = poselt + int(iposk - 1,8)
      IF ( npiv .GT. 0 ) THEN
          IF (dynamic_alloc) THEN
            CALL zgemm( 'T', 'N', ncolu, nrow1, npiv, alpha,
     &            udynamic(1), npiv,
     &            a_ptr( lpos ), ncol1, one,
     &            a_ptr( cpos ), ncol1 )
          ELSE
            CALL zgemm( 'T', 'N', ncolu, nrow1, npiv, alpha,
     &            a( posblocfacto ), npiv,
     &            a_ptr( lpos ), ncol1, one,
     &            a_ptr( cpos ), ncol1 )
          ENDIF
      ENDIF 
      ENDIF
      IF (npiv .GT. 0) THEN
        flop1 = dble(ncolu*npiv)*dble(2*nrow1)
        flop1 = -flop1
        CALL zmumps_load_update(1, .false., flop1, keep,keep8 )
      ENDIF
      IF ( iw(ioldps+6+keep(ixsz)).EQ.
     &    huge(iw(ioldps+6+keep(ixsz))) ) THEN
          iw(ioldps+6+keep(ixsz)) = 1
      ENDIF
      iw(ioldps+6+keep(ixsz)) =
     &         iw(ioldps+6+keep(ixsz)) + 1
      IF (.NOT.lr_activated) THEN
      IF (dynamic_alloc) THEN
       DEALLOCATE(udynamic)
      ELSE
        lrlu  = lrlu + laell
        lrlus = lrlus + laell
        keep8(69) = keep8(69) - laell
        posfac = posfac - laell
      CALL zmumps_load_mem_update(.false.,.false.,
     &                      la-lrlus,0_8,-laell,keep,keep8,lrlus)
      ENDIF
      ENDIF
      nslaves_follow = iw( ioldps + 5 +keep(ixsz) ) - xtra_slaves_sym
      IF ( iw( ioldps + 6  +keep(ixsz)) .eq. 0 .and.
     &     keep(50) .ne. 0 .and. nslaves_follow .eq. 0 )
     &     THEN
         dest = mumps_procnode( procnode_steps(step(inode)), keep(199) )
         CALL zmumps_buf_send_1int( inode, dest, end_niv2_ldlt,
     &                             comm, keep, ierr )
         IF ( ierr .LT. 0 ) THEN
           write(*,*) ' Internal error in PROCESS_BLFAC_SLAVE.'
           iflag = -99
           GOTO 700
         END IF
      END IF
      IF (iw(ptrist(step(inode)) + 6+keep(ixsz) ) .eq. 0) THEN
           npiv1 = iw( ioldps + 3  + keep(ixsz))
           nass1 = iw( ioldps + 4 + keep(ixsz))  
           nelim = nass1 - npiv1
          compress_cb= .false.
          IF (lr_activated) THEN
            compress_cb = ((iw(ptrist(step(inode))+xxlr).EQ.1).OR.
     &                     (iw(ptrist(step(inode))+xxlr).EQ.3))
             IF (compress_cb.AND.npiv.EQ.0) THEN
              compress_cb = .false.
              iw(ioldps+xxlr) = iw(ioldps+xxlr) -1
             ENDIF
            IF (compress_cb) THEN
              CALL zmumps_blr_retrieve_begs_blr_c (iw(ioldps+xxf), 
     &                  begs_blr_col,  npartsass_master)
              nb_blr_col   = size(begs_blr_col) - 1
              allocate(cb_lrb(nb_blr_ls,nb_blr_col-npartsass_master),
     &                 stat=allocok)
              IF (allocok > 0) THEN
                iflag  = -13
                ierror = nb_blr_ls*(nb_blr_col-npartsass_master)
                GOTO 700
              ENDIF
              DO ii=1,nb_blr_ls
              DO jj=1,nb_blr_col-npartsass_master
                cb_lrb(ii,jj)%M=0
                cb_lrb(ii,jj)%N=0
                NULLIFY(cb_lrb(ii,jj)%Q)
                NULLIFY(cb_lrb(ii,jj)%R)
                cb_lrb(ii,jj)%ISLR = .false.
              ENDDO
              ENDDO
              CALL zmumps_blr_save_cb_lrb(iw(ioldps+xxf),cb_lrb)
              call max_cluster(begs_blr_ls,nb_blr_ls+1,maxi_cluster_ls)
              CALL max_cluster(begs_blr_col,nb_blr_col,maxi_cluster_col)
              maxi_cluster = max(maxi_cluster_ls,
     &         maxi_cluster_col+nelim,npiv)
              lwork = maxi_cluster*maxi_cluster
              omp_num = 1
#if defined(BLR_MT)
!$            omp_num = omp_get_max_threads()
#endif
              ALLOCATE(blocklr(maxi_cluster, omp_num*maxi_cluster),
     &            rwork(2*maxi_cluster*omp_num), 
     &            tau(maxi_cluster*omp_num),
     &            jpvt(maxi_cluster*omp_num), 
     &            work(lwork*omp_num),
     &            stat=allocok)
              IF (allocok > 0 ) THEN
                iflag  = -13
                ierror = omp_num*(lwork + maxi_cluster*(maxi_cluster+4))
                GOTO 700
              ENDIF
              nfs4father = -9999
              IF ( (keep(219).NE.0).AND.(keep(50).EQ.2) ) THEN
               CALL zmumps_blr_retrieve_nfs4father ( iw(ioldps+xxf),
     &             nfs4father )
               nfs4father = max(nfs4father,0) + nelim
              ENDIF
              ALLOCATE(m_array(max(nfs4father,1)), stat=allocok)
              IF (allocok.gt.0) THEN
                iflag = -13
                ierror = max(nfs4father,1)
                GOTO 700
              ENDIF
              begs_blr_col(1+npartsass_master) = 
     &               begs_blr_col(1+npartsass_master) - nelim
              nbrowsinf = 0
              IF ( (keep(219).NE.0).AND.(keep(50).EQ.2).AND.
     &             nfs4father.GT.0  ) THEN
                CALL zmumps_compute_nbrowsinf (
     &                n, inode, fpere, keep, 
     &                ioldps, hs, 
     &                iw, liw, 
     &                nrow1, ncol1, npiv1,
     &                nelim, nfs4father,
     &                nbrowsinf
     &                )
              ENDIF
              IF ((keep(114).EQ.1) .AND. (keep(116).GT.0)
     &            .AND. (keep(50).EQ.2)
     &           ) THEN
                 nslaves_l = iw(ptrist(step(inode)) + 5 + keep(ixsz))
                 irow_l    = ptrist(step(inode)) + 6 + nslaves_l + 
     &                       keep(ixsz)
                 CALL zmumps_get_size_schur_in_front ( 
     &                n, 
     &                nrow1,
     &                keep(116), 
     &                iw(irow_l),
     &                perm, nvschur_k253 )
              ELSE
                 nvschur_k253 = 0
              ENDIF
#if defined(BLR_MT)          
!$OMP PARALLEL
#endif
              CALL zmumps_compress_cb_i(
     &          a_ptr(poselt), la_ptr, 1_8, ncol1,
     &          begs_blr_ls(1), size(begs_blr_ls),
     &          begs_blr_col(1), size(begs_blr_col),
     &          nb_blr_ls, nb_blr_col-npartsass_master,
     &          npartsass_master, 
     &          nrow1, ncol1-npiv1, inode,
     &          iw(ioldps+xxf), 1, 2, iflag, ierror,
     &          dkeep(12), keep(466), keep(484), keep(489),
     &          cb_lrb(1,1),
     &          work, tau, jpvt, lwork, rwork, blocklr,
     &          maxi_cluster, keep8, omp_num,
     &          nfs4father, npiv1, nvschur_k253, keep(1), 
     &          m_array,
     &          nelim, nbrowsinf )
#if defined(BLR_MT)
!$OMP END PARALLEL
#endif
              IF (iflag.LT.0) GOTO 650
              IF ( (keep(219).NE.0).AND.(keep(50).EQ.2).AND.
     &             nfs4father.GT.0  ) THEN
                 info_tmp(1) = iflag
                 info_tmp(2) = ierror
                 CALL zmumps_blr_save_m_array( iw(ioldps+xxf),
     &            m_array, info_tmp)
                 iflag  = info_tmp(1) 
                 ierror = info_tmp(2) 
              ENDIF
 650          CONTINUE         
              IF (allocated(m_array)) DEALLOCATE(m_array)
              IF (allocated(blocklr)) DEALLOCATE(blocklr)
              IF (allocated(rwork)) DEALLOCATE(rwork)
              IF (allocated(tau)) DEALLOCATE(tau)
              IF (allocated(jpvt)) DEALLOCATE(jpvt)
              IF (allocated(work)) DEALLOCATE(work)           
              IF (iflag.LT.0) GOTO 700
            ENDIF 
          ENDIF
         CALL zmumps_end_facto_slave( comm_load, ass_irecv, 
     &    n, inode, fpere, 
     &    root,
     &    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_s, comp, iflag, ierror, perm,
     &    ipool, lpool, leaf, nbfin, slavef,
     &    opassw, opeliw, itloc, rhs_mumps, fils, dad, ptrarw, ptraiw,
     &    intarr,dblarr,icntl,keep,keep8,dkeep,nd,frere_steps,
     &    lptrar, nelt, frtptr, frtelt, 
     &    istep_to_iniv2, tab_pos_in_pere 
     &               , lrgroups
     &     )
       ENDIF 
      RETURN
 700  CONTINUE
      CALL zmumps_bdc_error( myid, slavef, comm, keep )
 600  CONTINUE
      IF (allocated(blr_u)) DEALLOCATE(blr_u)
      IF (compress_cb) THEN
        IF (allocated(blocklr)) DEALLOCATE(blocklr)
        IF (allocated(rwork)) DEALLOCATE(rwork)
        IF (allocated(tau)) DEALLOCATE(tau)
        IF (allocated(jpvt)) DEALLOCATE(jpvt)
        IF (allocated(work)) DEALLOCATE(work)
      ENDIF
      IF (allocated(m_array)) DEALLOCATE(m_array)
      IF (dynamic_alloc) THEN
       IF (allocated(udynamic)) DEALLOCATE(udynamic)
      ENDIF
      RETURN