cfac_b.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
      SUBROUTINE cmumps_fac_b( N, S_IS_POINTERS, LA, LIW, SYM_PERM,
     & NA, LNA, NE_STEPS, NFSIZ, FILS, STEP, FRERE, DAD, CAND, 
     & ISTEP_TO_INIV2, TAB_POS_IN_PERE, PTRAR, LDPTRAR, PTRIST,
     & PTLUST_S, PTRFAC, IW1, IW2, ITLOC, RHS_MUMPS, POOL, LPOOL,
     &  CNTL1, ICNTL, INFO, RINFO, KEEP, KEEP8, PROCNODE_STEPS, SLAVEF,
     & COMM_NODES, MYID, MYID_NODES, BUFR, LBUFR, LBUFR_BYTES,
     & CMUMPS_LBUF, INTARR, DBLARR, root, NELT, FRTPTR, FRTELT,
     & COMM_LOAD, ASS_IRECV, SEUIL, SEUIL_LDLT_NIV2, MEM_DISTRIB,
     & DKEEP, PIVNUL_LIST, LPN_LIST, LRGROUPS
     & ,IPOOL_B_L0_OMP, LPOOL_B_L0_OMP, IPOOL_A_L0_OMP,
     & LPOOL_A_L0_OMP, L_VIRT_L0_OMP, VIRT_L0_OMP,
     & VIRT_L0_OMP_MAPPING, L_PHYS_L0_OMP, PHYS_L0_OMP, PERM_L0_OMP,
     & PTR_LEAFS_L0_OMP, L0_OMP_MAPPING, LL0_OMP_MAPPING, THREAD_LA,
     & L0_OMP_FACTORS, LL0_OMP_FACTORS, I4_L0_OMP, NBSTATS_I4,
     & NBCOLS_I4, I8_L0_OMP, NBSTATS_I8, NBCOLS_I8
     &     )
      USE cmumps_load 
      USE cmumps_buf, ONLY : cmumps_buf_alloc_cb, cmumps_buf_deall_cb
      USE cmumps_fac_s_is_pointers_m, ONLY : s_is_pointers_t
      USE omp_lib
      USE mumps_tps_m
      USE cmumps_tps_m
      USE cmumps_fac_omp_m
      USE cmumps_struc_def, ONLY : cmumps_root_struc
     &                           , cmumps_l0ompfac_t
      IMPLICIT NONE
      include 'mpif.h'
      TYPE (CMUMPS_ROOT_STRUC) :: root
      INTEGER(8) :: LA
      INTEGER N,LIW,LPOOL,SLAVEF,COMM_NODES
      INTEGER MYID, MYID_NODES,LNA
      TYPE (S_IS_POINTERS_T) :: S_IS_POINTERS
      REAL RINFO(40)
      INTEGER, INTENT( IN ) :: LBUFR, LBUFR_BYTES
      INTEGER :: BUFR( LBUFR )
      INTEGER, INTENT( IN ) :: CMUMPS_LBUF
      INTEGER, DIMENSION(0:SLAVEF - 1) :: MEM_DISTRIB
      INTEGER NELT, LDPTRAR
      INTEGER FRTPTR(*), FRTELT(*)
      INTEGER LRGROUPS(N)
      REAL CNTL1
      INTEGER   ICNTL(60)
      INTEGER   INFO(80), KEEP(500)
      INTEGER(8) KEEP8(150)
      INTEGER   SYM_PERM(N), NA(LNA),
     &          ne_steps(keep(28)), fils(n),
     &          frere(keep(28)), nfsiz(keep(28)), 
     &          dad(keep(28))
      INTEGER   CAND(SLAVEF+1, max(1,KEEP(56)))
      INTEGER   STEP(N)
      INTEGER(8), INTENT(IN) :: PTRAR(LDPTRAR,2)
      INTEGER(8) :: PTRFAC(KEEP(28))
      INTEGER   PTRIST(KEEP(28)), PTLUST_S(KEEP(28))
      INTEGER   IW1(2*KEEP(28)), ITLOC(N+KEEP(253)), POOL(LPOOL)
      COMPLEX :: RHS_MUMPS(KEEP(255))
      INTEGER(8) :: IW2(2*KEEP(28))
      INTEGER   PROCNODE_STEPS(KEEP(28))
      INTEGER   COMM_LOAD, ASS_IRECV
      INTEGER   ISTEP_TO_INIV2(KEEP(71)), 
     &          tab_pos_in_pere(slavef+2,max(1,keep(56)))
      COMPLEX   DBLARR(KEEP8(26))
      INTEGER   INTARR(KEEP8(27))
      REAL SEUIL, SEUIL_LDLT_NIV2
      INTEGER LPN_LIST
      INTEGER PIVNUL_LIST(LPN_LIST)
      REAL DKEEP(230)
      INTEGER, INTENT (IN) :: LPOOL_B_L0_OMP
      INTEGER, INTENT (IN) :: IPOOL_B_L0_OMP( LPOOL_B_L0_OMP )
      INTEGER, INTENT (IN) :: LPOOL_A_L0_OMP
      INTEGER, INTENT (IN) :: IPOOL_A_L0_OMP( LPOOL_A_L0_OMP )
      INTEGER, INTENT (IN) :: L_PHYS_L0_OMP
      INTEGER, INTENT (IN) :: PHYS_L0_OMP( L_PHYS_L0_OMP )
      INTEGER, INTENT (IN) :: L_VIRT_L0_OMP
      INTEGER, INTENT (IN) :: VIRT_L0_OMP( L_VIRT_L0_OMP )
      INTEGER, INTENT (IN) :: VIRT_L0_OMP_MAPPING( L_VIRT_L0_OMP )
      INTEGER, INTENT (IN) :: PERM_L0_OMP( L_PHYS_L0_OMP )
      INTEGER, INTENT (IN) :: PTR_LEAFS_L0_OMP( L_PHYS_L0_OMP + 1)
      INTEGER, INTENT (IN) :: LL0_OMP_MAPPING
      INTEGER, INTENT (OUT):: L0_OMP_MAPPING( LL0_OMP_MAPPING )
      INTEGER, INTENT (IN) :: LL0_OMP_FACTORS
      TYPE(cmumps_l0ompfac_t), INTENT (OUT) :: L0_OMP_FACTORS(
     &                                         ll0_omp_factors )
      INTEGER, INTENT (IN) :: NBSTATS_I4, NBSTATS_I8
      INTEGER, INTENT (IN) :: NBCOLS_I4, NBCOLS_I8
      INTEGER, INTENT (IN) :: I4_L0_OMP(NBSTATS_I4, NBCOLS_I4)
      INTEGER(8), INTENT (IN) :: I8_L0_OMP(NBSTATS_I8, NBCOLS_I8)
      INTEGER(8), INTENT ( IN ) :: THREAD_LA
       INTEGER, EXTERNAL :: MUMPS_PROCNODE
      INTEGER allocok
      REAL UULOC
      INTEGER IERR
      INTEGER LP, MPRINT
      LOGICAL LPOK
      INTEGER NSTK,PTRAST
      INTEGER PIMASTER, PAMASTER
      LOGICAL PROK
      REAL,PARAMETER :: ZERO = 0.0e0
      INTEGER I
      INTEGER LTPS_ARR
      TYPE (MUMPS_TPS_T), DIMENSION(:), ALLOCATABLE :: MUMPS_TPS_ARR
      TYPE (CMUMPS_TPS_T), DIMENSION(:), ALLOCATABLE :: CMUMPS_TPS_ARR
      INTEGER NBROOT_UNDER_L0
      INTEGER :: NSTEPSDONE
      DOUBLE PRECISION :: OPASS, OPELI
      INTEGER :: NELVA, COMP
      INTEGER :: MAXFRT, NTOTPV, NMAXNPIV, NOFFNEGPV
      INTEGER :: NB22T1, NB22T2, NBTINY, DET_EXP, DET_SIGN
      COMPLEX :: DET_MANT
      INTEGER :: NTOTPVTOT
      INTEGER(8) :: POSFAC, LRLU, IPTRLU, LRLUS
      INTEGER IWPOS, LEAF, NBROOT, NROOT
      INTEGER    :: LIW_ARG_FAC_PAR
      INTEGER(8) :: LA_ARG_FAC_PAR
      COMPLEX, TARGET:: CDUMMY(1)
      INTEGER, TARGET :: IDUMMY(1)
      LOGICAL :: IW_DUMMY, A_DUMMY
      keep(41)=0
      keep(42)=0
      lp     = icntl(1)
      lpok   = (lp.GT.0) .AND. (icntl(4).GE.1)
      mprint = icntl(2)
      prok   = (mprint.GT.0) .AND. (icntl(4).GE.2)
      uuloc = cntl1
      pimaster   = 1
      nstk       = pimaster + keep(28)
      ptrast = 1
      pamaster = 1 + keep(28)
      IF (keep(4).LE.0) keep(4)=32
      IF (keep(5).LE.0) keep(5)=16
      IF (keep(5).GT.keep(4)) keep(5) = keep(4)
      IF (keep(6).LE.0) keep(6)=24
      IF (keep(3).LE.keep(4)) keep(3)=keep(4)*2
      IF (keep(6).GT.keep(3)) keep(6) = keep(3)
      posfac = 1_8
      iwpos  = 1
      lrlu = la
      lrlus = lrlu
      keep8(63) = 0_8
      keep8(64) = 0_8
      keep8(65) = 0_8
      keep8(66) = 0_8
      keep8(68) = 0_8
      keep8(69) = 0_8
      keep8(70) = 0_8
      keep8(71) = 0_8
      keep8(73) = 0_8
      keep8(74) = 0_8
      iptrlu = lrlu
      nstepsdone = 0
      opass      = 0.0d0
      opeli      = 0.0d0
      nelva      = 0
      comp       = 0
      maxfrt     = 0  
      nmaxnpiv   = 0
      ntotpv     = 0
      noffnegpv  = 0
      nb22t1     = 0  
      nb22t2     = 0  
      nbtiny     = 0  
      det_exp    = 0
      det_sign   = 1
      det_mant   = cmplx(1.0e0,0.0e0, kind=kind(1.0e0))
      iw1(nstk:nstk+keep(28)-1) = ne_steps(1:keep(28))
      CALL mumps_init_nroot_dist(n, nbroot, nroot,
     &                     myid_nodes,
     &                     slavef, na, lna,
     &                     keep, step,
     &                     procnode_steps)
      IF (keep(400) .GT. 0
     &   ) THEN
         IF (lpool .NE. lpool_a_l0_omp) THEN
          WRITE(*,*) "Check LPOOL vs. LPOOL_A_L0_OMP",
     &    lpool, lpool_a_l0_omp, keep(28)
          CALL mumps_abort()
        ENDIF
        DO i = 1, lpool
          pool(i) = ipool_a_l0_omp(i)
        ENDDO
      ELSE
        CALL mumps_init_pool_dist(n, leaf,
     &                     myid_nodes,
     &                     slavef, na, lna,
     &                     keep,keep8, step,
     &                     procnode_steps,
     &                     pool, lpool)
        CALL cmumps_init_pool_last3(pool, lpool, leaf)     
      ENDIF  
      CALL cmumps_load_init_sbtr_struct(pool, lpool,keep,keep8)
      IF ( keep( 38 ) .NE. 0 ) THEN
        nbroot = nbroot + root%NPROW * root%NPCOL - 1
      END IF
      IF ( root%yes )  THEN 
         IF ( mumps_procnode( procnode_steps(step(keep(38))),
     &                                       keep(199) )
     &         .NE. myid_nodes ) THEN
             nroot = nroot + 1
         END IF
      END IF
      ptrist(1:keep(28))=0
      ptlust_s(1:keep(28))=0
      ptrfac(1:keep(28))=-99999_8
      iw2(ptrast:ptrast+keep(28)-1)=0_8
      iw1(pimaster:pimaster+keep(28)-1)=-99999_8
      keep(405) = 0
      dkeep(95)=0.0d0 
      dkeep(96)=0.0d0 
      nbroot_under_l0 = 0
      IF (keep(400).GT.0
     &   ) THEN
        keep(405)=1
        ALLOCATE( mumps_tps_arr( keep(400) ), stat=allocok )
        IF (allocok .GT. 0) THEN
          IF (lpok) THEN
            WRITE(lp,*) "Problem allocating MUMPS_TPS_ARR",
     &                keep(400) 
          ENDIF
          CALL mumps_abort()
        ENDIF
        ALLOCATE( cmumps_tps_arr( keep(400) ), stat=allocok )
        IF (allocok .GT. 0) THEN
          WRITE(*,*) "Problem allocating CMUMPS_TPS_ARR", keep(400)
          CALL mumps_abort()
        ENDIF
        CALL cmumps_fac_l0_omp(n,liw, iw1(nstk), nfsiz,
     &  fils,step, frere, dad, istep_to_iniv2, tab_pos_in_pere, ptrist,
     &  iw2(ptrast), iw1(pimaster), iw2(pamaster), ptrar(1,2), 
     &  ptrar(1,1), 
     &  itloc, rhs_mumps, rinfo, nroot, nbroot, nbroot_under_l0,
     &  uuloc, icntl, ptlust_s, ptrfac, info, keep, keep8,
     &  procnode_steps,slavef, comm_nodes, myid_nodes, bufr,
     &  lbufr,lbufr_bytes,intarr,dblarr,root, sym_perm, nelt, frtptr,
     &  frtelt, ldptrar, comm_load, ass_irecv, seuil, seuil_ldlt_niv2,
     &  mem_distrib, ne_steps, dkeep,pivnul_list,lpn_list,
     &  lpool_b_l0_omp, ipool_b_l0_omp, l_virt_l0_omp,
     &  virt_l0_omp, virt_l0_omp_mapping, l_phys_l0_omp, phys_l0_omp,
     &  perm_l0_omp, ptr_leafs_l0_omp, l0_omp_mapping, ll0_omp_mapping,
     &  thread_la, mumps_tps_arr, cmumps_tps_arr, nstepsdone,
     &  opass, opeli, nelva, comp, maxfrt, nmaxnpiv, ntotpv, noffnegpv,
     &  nb22t1, nbtiny, det_exp, det_mant, det_sign,
     &  lrgroups(1), l0_omp_factors, ll0_omp_factors,
     &  i4_l0_omp, nbstats_i4, nbcols_i4,
     &  i8_l0_omp, nbstats_i8, nbcols_i8 )
        keep(405)=0
        dkeep(16) = opeli
        keep8(75)=keep8(76)
        keep8(63)=keep8(74)
        keep8(62) = keep8(74)-keep8(62)
        IF (info(1) .LT. 0) THEN
          keep8(69) = keep8(73)
        ENDIF
        keep8(74) = keep8(73)
        IF ((info(1).GE.0).AND.(keep8(74).GT.keep8(75))) THEN
          info(1) = -19
          CALL mumps_set_ierror (
     &             keep8(74)-keep8(75), info(2))
          IF (lpok) THEN
            WRITE(lp,'(/A/,A,I8,A,I10/,A/,A/)')
     &     '** ERROR: memory allowed (ICNTL(23)) is not large enough:',
     &     '   INFO(1)=',  info(1), ' INFO(2)=',  info(2),
     &     '   memory used at the end of the treatment of L0 thread ',
     &     '   does not enable processing nodes above L0 thread '
          ENDIF
        ENDIF
        keep8(66) = keep8(68)
        keep8(65) = keep8(64) + keep8(71) 
      ENDIF
        keep8(67) = lrlus
      IF (associated(s_is_pointers%IW)) THEN
        WRITE(*,*) " Internal error CMUMPS_FAC_B IW"
        CALL mumps_abort()
      ENDIF
      IF (info(1) .GE. 0 ) THEN
        ALLOCATE(s_is_pointers%IW(liw), stat=allocok)
        IF (allocok .GT.0) THEN
          info(1) = -13
          info(2) = liw
          IF (lpok) THEN
            WRITE(lp,*) 
     &     'Allocation error for id%IS(',liw,') on worker',
     &      myid_nodes
          ENDIF
        ENDIF
      ENDIF
      IF (info(1) .GE. 0) THEN
        IF (.NOT. associated(s_is_pointers%A)) THEN
          ALLOCATE(s_is_pointers%A(la), stat=allocok)
          IF (allocok .GT. 0) THEN
            info(1) = -13
            CALL mumps_seti8toi4(la, info(2))
            DEALLOCATE(s_is_pointers%IW); NULLIFY(s_is_pointers%IW)
            keep8(23)=0_8
          ELSE
            keep8(23)=la
          ENDIF
        ENDIF
      ENDIF
      IF (info(1) .GE. 0) THEN
        CALL cmumps_buf_alloc_cb( cmumps_lbuf, ierr )
        IF ( ierr .NE. 0 ) THEN
          info(1)= -13
          info(2)= (cmumps_lbuf+keep(34)-1)/keep(34)
          IF (lpok) THEN
            WRITE(lp,*) 
     &     'Allocation error in CMUMPS_BUF_ALLOC_CB'
     &     ,info(2), ' on worker', myid_nodes
          ENDIF
          DEALLOCATE(s_is_pointers%IW); NULLIFY(s_is_pointers%IW)
          DEALLOCATE(s_is_pointers%A); NULLIFY(s_is_pointers%A)
        END IF
      ENDIF
      IF ( keep(400) .EQ. 0
     &   ) THEN
         ltps_arr = 1
         ALLOCATE( mumps_tps_arr(1))
         ALLOCATE(cmumps_tps_arr(1))
      ELSE
         ltps_arr = keep(400)
      ENDIF
      iw_dummy = .false.
      a_dummy = .false.
      IF (info(1) .GE. 0) THEN
        liw_arg_fac_par = liw
        la_arg_fac_par  = la
      ELSE
        liw_arg_fac_par = 1
        la_arg_fac_par  = 1_8
        IF (.NOT. associated(s_is_pointers%IW)) THEN
          s_is_pointers%IW => idummy
          iw_dummy = .true.
        ENDIF
        IF (.NOT. associated(s_is_pointers%A)) THEN
          s_is_pointers%A  => cdummy
          a_dummy = .true.
        ENDIF
      ENDIF
      IF ( info(1) .LT. 0 ) THEN
        CALL cmumps_bdc_error( myid_nodes, slavef, comm_nodes, keep )
      ENDIF
      keep(398)=nstepsdone
      CALL cmumps_fac_par_i(n,s_is_pointers%IW(1),liw_arg_fac_par,
     & s_is_pointers%A(1),la_arg_fac_par,iw1(nstk),
     & nfsiz,fils,step,frere,dad,cand,istep_to_iniv2, tab_pos_in_pere,
     & nstepsdone, opass, opeli, nelva, comp, maxfrt, nmaxnpiv, ntotpv,
     & noffnegpv, nb22t1, nb22t2, nbtiny, det_exp, det_mant, det_sign,
     & ptrist, iw2(ptrast), iw1(pimaster), iw2(pamaster),
     & ptrar(1,2), ptrar(1,1),          
     & itloc, rhs_mumps, pool, lpool,
     & l0_omp_mapping, ll0_omp_mapping,
     & mumps_tps_arr, cmumps_tps_arr, ltps_arr,
     & rinfo, posfac, iwpos, lrlu, iptrlu, lrlus, leaf, nroot, nbroot,
     & nbroot_under_l0,
     & uuloc, icntl, ptlust_s, ptrfac, info, keep, keep8,
     & procnode_steps,slavef,myid,comm_nodes, myid_nodes, bufr, lbufr,
     & lbufr_bytes, intarr, dblarr, root, sym_perm, nelt, frtptr,
     & frtelt, ldptrar, comm_load, ass_irecv, seuil, seuil_ldlt_niv2,
     & mem_distrib,ne_steps, dkeep(1),pivnul_list(1),lpn_list,
     & lrgroups(1) )
      IF (iw_dummy) THEN
        NULLIFY( s_is_pointers%IW )
      ENDIF
      IF (a_dummy) THEN
        NULLIFY( s_is_pointers%A )
      ENDIF
      CALL cmumps_buf_deall_cb( ierr )
      rinfo(2)  = real(opass)
      rinfo(3)  = real(opeli)
      info(13)  = nelva
      info(14)  = comp
      keep(33)  = maxfrt; info(11)  = maxfrt
      keep(246) = nmaxnpiv
      keep(89)  = ntotpv; info(23)  = ntotpv
      info(12)  = noffnegpv
      keep(103) = nb22t1
      keep(105) = nb22t2
      keep(98)  = nbtiny
      IF (keep(258) .NE. 0) THEN
        keep(260) = keep(260) * det_sign
        keep(259) = keep(259) + det_exp
        CALL cmumps_updatedeter( det_mant, dkeep(6), keep(259) )
      ENDIF
      IF (keep(400) .GT. 0
     &  ) THEN
        IF (ll0_omp_factors.NE.keep(400)) THEN
          WRITE(*,*) "Internal error in CMUMPS_FAC_B, KEEP(400), L..=",
     &    keep(400), ll0_omp_factors
          CALL mumps_abort()
        ENDIF
        IF ( info(1) .GE. 0 ) THEN
          CALL cmumps_l0omp_copy_iw(s_is_pointers%IW,
     &    liw, iwpos, mumps_tps_arr, keep, ptlust_s,
     &    icntl, info)
        ENDIF
!$OMP   PARALLEL DO
        DO i=1, keep(400)
          IF (info(1) .LT. 0) THEN
            IF ( associated( l0_omp_factors(i)%A ) ) THEN
              DEALLOCATE( l0_omp_factors(i)%A )
              NULLIFY   ( l0_omp_factors(i)%A )
              CALL mumps_dm_fac_upd_dyn_memcnts(
     &        -l0_omp_factors(i)%LA, .true., 
     &        keep8, info(1), info(2), .true., .false. )
            ENDIF
            l0_omp_factors(i)%LA  =  -99999_8
          ENDIF
          IF (associated(mumps_tps_arr(i)%IW)) THEN
            DEALLOCATE(mumps_tps_arr(i)%IW)
            NULLIFY(mumps_tps_arr(i)%IW)
            CALL mumps_dm_fac_upd_dyn_memcnts(
     &              -((int(mumps_tps_arr(i)%LIW,8) * int(keep(34),8))
     &              / int(keep(35),8)),
     &      .true., 
     &      keep8, info(1), info(2), .true., .false. )
          ENDIF
        ENDDO
!$OMP   END PARALLEL DO
      ENDIF
      IF (allocated(mumps_tps_arr)) THEN
        DEALLOCATE(mumps_tps_arr)
      ENDIF
      IF (allocated(cmumps_tps_arr)) THEN
        DEALLOCATE(cmumps_tps_arr)
      ENDIF
      posfac = posfac -1_8
      iwpos = iwpos -1
      IF (keep(201).LE.0) THEN
        IF (keep(201) .EQ. -1 .AND. info(1) .LT. 0) THEN
          posfac = 0_8
        ENDIF
        keep8(31) = posfac 
         rinfo(6)  = zero
      ELSE
         rinfo(6)  = real(keep8(31)*int(keep(35),8))/1e6
      ENDIF
      keep8(48) = keep8(31)+keep8(71)+keep8(64)
      keep(32) = iwpos
      CALL mumps_seti8toi4(keep8(48), info(9))
      info(10) = keep(32)
      keep8(67) = la - keep8(67)
      CALL mpi_allreduce(ntotpv, ntotpvtot, 1, mpi_integer, mpi_sum, 
     &                comm_nodes, ierr)
      IF ( ( (info(1).EQ.-10 .OR. info(1).EQ.-40)
     &       .AND. (ntotpvtot.EQ.n) )
     &     .OR. ( ntotpvtot.GT.n ) ) THEN
       write(*,*) ' Error 1 NTOTPVTOT=', ntotpvtot,n
       CALL mumps_abort()
      ENDIF
      IF ( (keep(19).NE.0 ) .AND. (ntotpvtot.NE.n) .AND. 
     &     (info(1).GE.0) )  THEN
       write(*,*) ' Error 2 NTOTPVTOT=', ntotpvtot 
       CALL mumps_abort()
      ENDIF
      IF ( (info(1) .GE. 0 ) 
     &      .AND. (ntotpvtot.NE.n) ) THEN
         info(1) = -10
      ENDIF
      IF (info(1).EQ.-10) THEN
         info(2) = ntotpvtot
      ENDIF
      IF (prok) THEN
        WRITE (mprint,99980) info(1), info(2),
     &       keep(28), keep8(48), info(10), info(11)
        IF(keep(50) .EQ. 0) THEN
          WRITE(mprint,99982) info(12)
        ENDIF
        WRITE (mprint, 99986)
     &       info(13), info(14), rinfo(2), rinfo(3)
        IF (keep(97) .NE. 0) THEN
           WRITE (mprint, 99987)  info(25)
        ENDIF
      ENDIF
      RETURN
99980 FORMAT (/' LEAVING FACTORIZATION PHASE WITH ...'/
     &      ' INFO (1)                                      =',i15/
     &      '  --- (2)                                      =',i15/
     &      '           Number of nodes in the tree         =',i15/
     &      ' INFO (9)  Real space for factors              =',i15/
     &      '  --- (10) Integer space for factors           =',i15/
     &      '  --- (11) Maximum size of frontal matrices    =',i15)
99982 FORMAT ('  --- (12) Number of off diagonal pivots       =',i15)
99986 FORMAT ('  --- (13) Number of delayed pivots            =',i15/
     &      '  --- (14) Number of memory compresses         =',i15/
     &  ' RINFO(2)  Operations during node assembly     =',1pd10.3/
     &  ' -----(3)  Operations during node elimination  =',1pd10.3)
99987 FORMAT (' INFO (25) Number of tiny pivots(static)       =',i15)
      END SUBROUTINE cmumps_fac_b
      SUBROUTINE cmumps_fac_par_i(N, IW, LIW, A, LA, NSTK_STEPS,
     & ND,FILS,STEP, FRERE, DAD, CAND, ISTEP_TO_INIV2,
     & TAB_POS_IN_PERE, NSTEPSDONE, OPASS, OPELI, NELVA, COMP,
     & MAXFRT, NMAXNPIV, NTOTPV, NOFFNEGPV, NB22T1, NB22T2, NBTINY,
     & DET_EXP, DET_MANT, DET_SIGN, PTRIST, PTRAST, PIMASTER, PAMASTER,
     & PTRARW, PTRAIW, ITLOC, RHS_MUMPS, IPOOL, LPOOL,
     & L0_OMP_MAPPING, LL0_OMP_MAPPING,
     & MUMPS_TPS_ARR, CMUMPS_TPS_ARR, LTPS_ARR,
     & RINFO, POSFAC ,IWPOS, LRLU, IPTRLU, LRLUS, LEAF, NBROOT, NBRTOT,
     & NBROOT_UNDER_L0, 
     & UU, ICNTL, PTLUST, PTRFAC, INFO, KEEP, KEEP8,
     & PROCNODE_STEPS, SLAVEF, MYID, COMM_NODES, MYID_NODES,
     & BUFR, LBUFR, LBUFR_BYTES, INTARR, DBLARR, root,
     & PERM, NELT, FRTPTR, FRTELT, LPTRAR, COMM_LOAD, ASS_IRECV,
     & SEUIL, SEUIL_LDLT_NIV2, MEM_DISTRIB, NE, DKEEP,
     & PIVNUL_LIST,LPN_LIST, LRGROUPS )
      USE cmumps_load
      USE cmumps_ooc
      USE cmumps_fac_asm_master_m
      USE cmumps_fac_asm_master_elt_m
      USE cmumps_fac1_ldlt_m
      USE cmumps_fac2_ldlt_m
      USE cmumps_fac1_lu_m
      USE cmumps_fac2_lu_m
      USE omp_lib
      USE mumps_tps_m
      USE cmumps_tps_m
      USE cmumps_struc_def, ONLY : cmumps_root_struc
      USE cmumps_fac_par_m, ONLY : cmumps_fac_par
      IMPLICIT NONE
      TYPE (CMUMPS_ROOT_STRUC) :: root
      INTEGER N, LIW, LPTRAR, NSTEPSDONE, INFO(80)
      DOUBLE PRECISION, INTENT(INOUT) :: OPASS, OPELI
      INTEGER, INTENT(INOUT) :: NELVA, COMP
      INTEGER, INTENT(INOUT) :: MAXFRT, NTOTPV, NMAXNPIV, NOFFNEGPV
      INTEGER, INTENT(INOUT) :: NB22T1, NB22T2, NBTINY
      INTEGER, INTENT(INOUT) :: DET_SIGN, DET_EXP
      COMPLEX, INTENT(INOUT) :: DET_MANT
      INTEGER(8) :: LA
      COMPLEX :: A(LA)
      INTEGER SLAVEF, COMM_NODES, MYID, MYID_NODES
      INTEGER, DIMENSION(0: SLAVEF - 1) :: MEM_DISTRIB
      INTEGER KEEP(500), ICNTL(60)
      INTEGER(8) KEEP8(150)
      INTEGER LPOOL
      INTEGER PROCNODE_STEPS(KEEP(28))
      INTEGER ITLOC(N+KEEP(253))
      COMPLEX :: RHS_MUMPS(KEEP(255))
      INTEGER IW(LIW), NSTK_STEPS(KEEP(28))
      INTEGER(8), INTENT(IN) :: PTRARW(LPTRAR), PTRAIW(LPTRAR)
      INTEGER ND(KEEP(28))
      INTEGER FILS(N),PTRIST(KEEP(28))
      INTEGER STEP(N), FRERE(KEEP(28)), DAD(KEEP(28))
      INTEGER PIMASTER(KEEP(28))
      INTEGER PTLUST(KEEP(28)), PERM(N)
      INTEGER CAND(SLAVEF+1,max(1,KEEP(56)))
      INTEGER   ISTEP_TO_INIV2(KEEP(71)),
     &          tab_pos_in_pere(slavef+2,max(1,keep(56)))
      INTEGER IPOOL(LPOOL)
      INTEGER NE(KEEP(28))
      REAL RINFO(40)
      INTEGER(8) :: PAMASTER(KEEP(28)), PTRAST(KEEP(28))
      INTEGER(8) :: PTRFAC(KEEP(28))
      INTEGER(8) :: POSFAC, LRLU, LRLUS, IPTRLU
      INTEGER IWPOS, LEAF, NBROOT, NBRTOT
      INTEGER, INTENT(in) :: NBROOT_UNDER_L0
      INTEGER COMM_LOAD, ASS_IRECV
      REAL UU, SEUIL, SEUIL_LDLT_NIV2
      INTEGER NELT
      INTEGER FRTPTR( N+1 ), FRTELT( NELT )
      INTEGER LBUFR, LBUFR_BYTES
      INTEGER BUFR( LBUFR )
      COMPLEX DBLARR( KEEP8(26) )
      INTEGER INTARR( KEEP8(27) )
      INTEGER LPN_LIST
      INTEGER PIVNUL_LIST(LPN_LIST)
      REAL DKEEP(230)
      INTEGER LRGROUPS(N)
      INTEGER, INTENT( IN ) :: LTPS_ARR, LL0_OMP_MAPPING
      TYPE (MUMPS_TPS_T)  ::  MUMPS_TPS_ARR(LTPS_ARR)
      TYPE (CMUMPS_TPS_T) :: CMUMPS_TPS_ARR(LTPS_ARR)
      INTEGER, INTENT( IN ) :: L0_OMP_MAPPING( LL0_OMP_MAPPING )
      CALL cmumps_fac_par( n, iw, liw, a, la, nstk_steps,
     & nd,fils,step, frere, dad, cand, istep_to_iniv2, tab_pos_in_pere,
     & nstepsdone, opass, opeli, nelva, comp, maxfrt, nmaxnpiv, ntotpv,
     & noffnegpv, nb22t1, nb22t2, nbtiny, det_exp, det_mant, det_sign,
     & ptrist, ptrast, pimaster, pamaster, ptrarw, ptraiw,
     & itloc, rhs_mumps, ipool, lpool,
     & l0_omp_mapping, ll0_omp_mapping,
     & mumps_tps_arr, cmumps_tps_arr, ltps_arr,
     & rinfo, posfac ,iwpos, lrlu, iptrlu, lrlus, leaf, nbroot, nbrtot,
     & nbroot_under_l0, 
     & uu, icntl, ptlust, ptrfac, info, keep,keep8,
     & procnode_steps,slavef,myid, comm_nodes, myid_nodes,
     & bufr,lbufr,lbufr_bytes,intarr,dblarr,root, perm, nelt,
     & frtptr, frtelt, lptrar, comm_load, ass_irecv,
     & seuil, seuil_ldlt_niv2, mem_distrib, ne, dkeep,
     & pivnul_list,lpn_list, lrgroups )
      RETURN
      END SUBROUTINE cmumps_fac_par_i