zfac_omp_m.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
      MODULE zmumps_fac_omp_m
      INTEGER(8), PARAMETER :: underl0 = -20_8
      INTEGER(8), PARAMETER :: copynotstarted = -19_8
      INTEGER(8), PARAMETER :: waitmem = -18_8
      INTEGER(8), PARAMETER :: copyfactorsfinished = -17_8
      INTEGER(8), PARAMETER :: allocatevidercbencours = -16_8
      INTEGER(8), PARAMETER :: finished = -15_8
      CONTAINS
      SUBROUTINE zmumps_fac_l0_omp(N,LIW, NSTK_STEPS, ND,
     & FILS,STEP, FRERE, DAD, ISTEP_TO_INIV2, TAB_POS_IN_PERE,
     & PTRIST, PTRAST, PIMASTER, PAMASTER, PTRARW, PTRAIW, ITLOC,
     & RHS_MUMPS, RINFO, NBROOT, NBRTOT, NBROOT_UNDER_L0, UU, ICNTL,
     & PTLUST_S, PTRFAC, INFO, KEEP, KEEP8, PROCNODE_STEPS,SLAVEF,
     & 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,
     &  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, ZMUMPS_TPS_ARR,
     &  NSTEPSW, OPASSW, OPELIW, NELVAW, COMP,
     &  MAXFRW, NMAXNPIVW, NPVW, NOFFNEGW,
     &  NB22T1W, NBTINYW, DET_EXPW, DET_MANTW, DET_SIGNW,
     &  LRGROUPS, L0_OMP_FACTORS, LL0_OMP_FACTORS,
     &  I4_L0_OMP, NBSTATS_I4, NBCOLS_I4,
     &  I8_L0_OMP, NBSTATS_I8, NBCOLS_I8 )
      USE zmumps_load
!$    USE OMP_LIB
      USE mumps_tps_m, ONLY : mumps_tps_t
      USE zmumps_tps_m, ONLY : zmumps_tps_t
      USE zmumps_lr_stats
      USE zmumps_struc_def, ONLY : zmumps_root_struc,
     &                             zmumps_l0ompfac_t
      USE zmumps_dynamic_memory_m, ONLY :
     &                             zmumps_dm_fac_alloc_allowed
      IMPLICIT NONE
      include 'mpif.h'
      include 'mumps_tags.h'
      include 'mumps_headers.h'
      TYPE (ZMUMPS_ROOT_STRUC) :: root
      INTEGER N,LIW, LPTRAR, 
     &        NSTEPSW, INFO(80)
      INTEGER SLAVEF, COMM_NODES, MYID_NODES
      INTEGER, DIMENSION(0: SLAVEF - 1) :: MEM_DISTRIB
      INTEGER KEEP(500), ICNTL(60)
      INTEGER(8) KEEP8(150)
      INTEGER(8), INTENT(IN) :: THREAD_LA
      INTEGER PROCNODE_STEPS(KEEP(28))
      INTEGER ITLOC(N+KEEP(253))
      COMPLEX(kind=8) :: RHS_MUMPS(KEEP(255))
      INTEGER 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_S(KEEP(28)), PERM(N)
      INTEGER   ISTEP_TO_INIV2(KEEP(71)),
     &          tab_pos_in_pere(slavef+2,max(1,keep(56)))
      INTEGER NE(KEEP(28))
      DOUBLE PRECISION RINFO(40)
      INTEGER(8) :: PAMASTER(KEEP(28)), PTRAST(KEEP(28))
      INTEGER(8) :: PTRFAC(KEEP(28))
      INTEGER NBROOT 
      INTEGER NBRTOT 
      INTEGER, intent(out) :: NBROOT_UNDER_L0 
      INTEGER COMM_LOAD, ASS_IRECV
      DOUBLE PRECISION UU, SEUIL, SEUIL_LDLT_NIV2
      INTEGER NELT
      INTEGER FRTPTR( N+1 ), FRTELT( NELT )
      INTEGER LBUFR, LBUFR_BYTES
      INTEGER BUFR( LBUFR )
      COMPLEX(kind=8) DBLARR( KEEP8(26) )
      INTEGER INTARR( KEEP8(27) )
      INTEGER LPN_LIST
      INTEGER PIVNUL_LIST(LPN_LIST)
      DOUBLE PRECISION DKEEP(230)
      DOUBLE PRECISION :: OPASSW, OPELIW
      INTEGER LRGROUPS(N)
      INTEGER, INTENT ( IN )  :: LPOOL_B_L0_OMP
      INTEGER, INTENT ( IN )  :: IPOOL_B_L0_OMP
     &                           ( lpool_b_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 )
      TYPE (MUMPS_TPS_T), DIMENSION(:) :: MUMPS_TPS_ARR
      TYPE (ZMUMPS_TPS_T), DIMENSION(:) :: ZMUMPS_TPS_ARR
      INTEGER, INTENT ( IN )  :: LL0_OMP_FACTORS
      TYPE (ZMUMPS_L0OMPFAC_T), INTENT(INOUT) ::
     &                        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)
      EXTERNAL MUMPS_TYPENODE, MUMPS_PROCNODE
      INTEGER MUMPS_TYPENODE, MUMPS_PROCNODE
      LOGICAL MUMPS_INSSARBR,MUMPS_ROOTSSARBR
      EXTERNAL mumps_inssarbr,mumps_rootssarbr
      LOGICAL ZMUMPS_POOL_EMPTY
      EXTERNAL zmumps_pool_empty, zmumps_extract_pool
      INTEGER numroc
      EXTERNAL numroc
      INTEGER :: MYTHREAD_ID, ITH  
      INTEGER :: THREAD_ID_P       
      DOUBLE PRECISION, PARAMETER :: DZERO = 0.0d0, done = 1.0d0
      INTEGER INODE, LEAF
      INTEGER TYPEF
      INTEGER NBFIN
      INTEGER TYPE
      LOGICAL AVOID_DELAYED
      INTEGER NBROOT_PROCESSED
      INTEGER MAXFRW, NPVW, NMAXNPIVW, NOFFNEGW, NELVAW, COMP
      INTEGER :: NB22T1W, NBTINYW, DET_EXPW, DET_SIGNW
      COMPLEX(kind=8) :: DET_MANTW
      DOUBLE PRECISION FLOP_ESTIM_ACC
#if defined(PANEL)
      INTEGER(8) :: LAFAC
      INTEGER LIWFAC, STRAT, TYPEFile, NextPiv2beWritten
      INTEGER(8) :: ITMP8
#endif
      INTEGER :: LPOOL_P
      INTEGER, DIMENSION(:), ALLOCATABLE :: IPOOL_P
      INTEGER(8) :: TO_ALLOCATE
      INTEGER, DIMENSION(:), ALLOCATABLE    :: ID
      INTEGER(8), DIMENSION(:), ALLOCATABLE :: VAL
      INTEGER(8), ALLOCATABLE, DIMENSION(:) :: STATE, SIZE_COPIED
      INTEGER ::  NbWaitMem, NbFinished, NbOnGoingCopies, NbUnderL0
      INTEGER(8) :: KEEP8_77_SAVE
      DOUBLE PRECISION :: GTIME
      INTEGER(8) :: MEMDISPO_UNDERL0, MEMDISPO_PERTHREAD
      INTEGER    :: BLR_STRAT
      INTEGER :: VIRTUAL_TASK, PHYSICAL_TASK
      INTEGER :: IFATH
      INTEGER :: I, INFO_P(2), allocok
      INTEGER(8) :: I8
!$    INTEGER(8) :: CHUNK8 
!$    LOGICAL    :: OMP_FLAG
!$    INTEGER    :: NOMP_SAVE
      CALL mumps_load_disable()
      gtime = mpi_wtime()
      l0_omp_mapping = 0
      nbroot_processed  = 0
      nstepsw           = 0
      opassw         = dzero
      opeliw         = dzero
      nelvaw            = 0
      comp              = 0
      maxfrw            = 0 
      nmaxnpivw         = 0 
      noffnegw          = 0 
      flop_estim_acc = dzero
      npvw              = 0 
      nb22t1w           = 0 
      nbtinyw           = 0 
      det_expw          = 0 
      det_mantw         = cmplx(1.0d0,0.0d0, kind=kind(1.0d0))
      det_signw         = 1
      DO ith = 1, keep(400)
        NULLIFY(mumps_tps_arr(ith)%IW)
        NULLIFY(mumps_tps_arr(ith)%ITLOC)
        NULLIFY(zmumps_tps_arr(ith)%A)
        CALL zmumps_set_maxs_maxis_thread(
     &     mumps_tps_arr(ith)%LA,
     &     mumps_tps_arr(ith)%LIW, blr_strat,
     &     keep,
     &     i4_l0_omp(1,ith), nbstats_i4,
     &     i8_l0_omp(1,ith), nbstats_i8)
      ENDDO
      IF (keep8(4) .NE. 0_8) THEN
        CALL zmumps_ma_eff_mem_dispo ( 
     &       mumps_tps_arr, keep(400),keep8, keep, 
     &       n, blr_strat, lpool_b_l0_omp, 
     &       i8_l0_omp, nbstats_i8,
     &       memdispo_underl0   
     &      )
        memdispo_underl0 = max(memdispo_underl0/2_8,0_8)
        keep8(77) = keep8(77) + memdispo_underl0
        memdispo_perthread = 0_8
        IF (memdispo_underl0.GT.0) THEN
         memdispo_perthread = memdispo_underl0/(int(keep(400),8))
        ENDIF
        DO ith = 1, keep(400)
          mumps_tps_arr(ith)%LA =  mumps_tps_arr(ith)%LA + 
     &                             memdispo_perthread
        ENDDO
      ENDIF
      DO ith = 1, keep(400)
        mumps_tps_arr(ith)%LRLU  = mumps_tps_arr(ith)%LA
        mumps_tps_arr(ith)%LRLUS = mumps_tps_arr(ith)%LA
        mumps_tps_arr(ith)%LRLUSM  = mumps_tps_arr(ith)%LA
        mumps_tps_arr(ith)%IPTRLU  = mumps_tps_arr(ith)%LA
        mumps_tps_arr(ith)%POSFAC  = 1_8
        mumps_tps_arr(ith)%IWPOS   = 1
        mumps_tps_arr(ith)%IWPOSCB = mumps_tps_arr(ith)%LIW
      ENDDO
      IF (keep(406) .EQ. 2 ) THEN
        ALLOCATE(state(keep(400)), size_copied(keep(400)), stat=allocok)
        IF (allocok .GT. 0 ) THEN
          WRITE(*,*) "Problem allocating STATE/SIZE_COPIED", keep(400)
          CALL mumps_abort()
        ENDIF
        CALL zmumps_perform_copies_init( state, keep8_77_save,
     &  nbwaitmem, nbfinished, nbongoingcopies, nbunderl0, 
     &  keep, keep8 )
      ENDIF
!$OMP PARALLEL
!$OMP& SHARED ( IPOOL_B_L0_OMP, LPOOL_B_L0_OMP )
!$OMP& PRIVATE ( VIRTUAL_TASK, PHYSICAL_TASK,
!$OMP&     IPOOL_P, LPOOL_P, LEAF, INODE, IFATH, INFO_P, I, I8,
!$OMP&     TO_ALLOCATE, THREAD_ID_P,
!$OMP&     TYPE, TYPEF, AVOID_DELAYED, NOMP_SAVE, allocok )
!$OMP& REDUCTION ( + : NPVW, OPASSW, OPELIW, NOFFNEGW, NELVAW, COMP,
!$OMP&                 NB22T1W, NBTINYW, DET_EXPW,
!$OMP&                 FLOP_ESTIM_ACC, NBROOT_PROCESSED, NSTEPSW )
!$OMP& REDUCTION ( * : DET_MANTW, DET_SIGNW )
!$OMP& REDUCTION ( max : MAXFRW, NMAXNPIVW )
      thread_id_p = 1
!$    THREAD_ID_P = OMP_GET_THREAD_NUM () + 1
!$OMP BARRIER
!$    NOMP_SAVE = omp_get_max_threads()
!$    CALL omp_set_num_threads(1)
      lpool_p           = lpool_b_l0_omp
      leaf              = 1
      info_p            = 0
      avoid_delayed     = .false.
      virtual_task      = 0
!$    IF ( omp_get_num_threads() .NE. KEEP(400) ) THEN
!$      INFO_P(1)=-58
!$      INFO_P(2)=-100-omp_get_num_threads()
!$      GOTO 700
!$    ENDIF
      CALL zmumps_dm_fac_alloc_allowed( mumps_tps_arr(thread_id_p)%LA,
     &                                  keep8,
     &                                  info_p(1), info_p(2) )
      IF (info_p(1) .LT. 0) GOTO 700
      ALLOCATE ( zmumps_tps_arr(thread_id_p)%A(
     &           max(1_8,mumps_tps_arr(thread_id_p)%LA) ),
     &           stat=allocok)
      IF (allocok.GT.0) THEN
          info_p(1) = -13
          CALL mumps_seti8toi4( mumps_tps_arr(thread_id_p)%LA,
     &                          info_p(2))
          GOTO 700
      ELSE
          CALL mumps_dm_fac_upd_dyn_memcnts(
     &       mumps_tps_arr(thread_id_p)%LA,
     &       keep(405).EQ.1,
     &       keep8, info_p(1), info_p(2),
     &       .false., .false. ) 
          IF (info_p(1) .LT. 0) THEN
            GOTO 700
          ENDIF
      ENDIF
      to_allocate = 
     & ((int(mumps_tps_arr(thread_id_p)%LIW,8) * int(keep(34),8 )) /
     &   int(keep(35),8 ))+
     & ((int(lpool_p,8) * int(keep(34),8 )) / int(keep(35),8 ))+
     & ((int(n+keep(253),8) * int(keep(34),8 )) / int(keep(35),8 ))
      CALL zmumps_dm_fac_alloc_allowed( to_allocate,
     &            keep8, info_p(1), info_p(2) )
      IF ( info_p(1) .LT. 0 ) GOTO 700
      ALLOCATE ( mumps_tps_arr(thread_id_p)%IW(
     &                          mumps_tps_arr(thread_id_p)%LIW ),
     &           ipool_p( lpool_p ),
     &           mumps_tps_arr(thread_id_p)%ITLOC ( n + keep(253) ),
     &           stat = allocok )
      IF ( allocok .GT. 0 ) THEN
          info_p(1) = -13
          info_p(2) = mumps_tps_arr(thread_id_p)%LIW +
     &                lpool_p + n+keep(253)
          GOTO 700
      ELSE
          CALL mumps_dm_fac_upd_dyn_memcnts( to_allocate,
     &       keep(405).EQ.1, keep8,
     &       info_p(1), info_p(2), .true., .false. )
          IF (info_p(1) .LT. 0) THEN
            GOTO 700
          ENDIF
      ENDIF
      CALL zmumps_alloc_cb( .false., 0_8,
     &     .false., .false., myid_nodes, n, keep, keep8, dkeep,
     &     mumps_tps_arr(thread_id_p)%IW(1),
     &     mumps_tps_arr(thread_id_p)%LIW,
     &     zmumps_tps_arr(thread_id_p)%A(1),
     &     mumps_tps_arr(thread_id_p)%LA,
     &     mumps_tps_arr(thread_id_p)%LRLU,
     &     mumps_tps_arr(thread_id_p)%IPTRLU,
     &     mumps_tps_arr(thread_id_p)%IWPOS,
     &     mumps_tps_arr(thread_id_p)%IWPOSCB,
     &     slavef, procnode_steps, dad,
     &     ptrist, ptrast, step, pimaster,
     &     pamaster, keep(ixsz), 0_8, -444, -444, .true.,
     &     comp, mumps_tps_arr(thread_id_p)%LRLUS,
     &     mumps_tps_arr(thread_id_p)%LRLUSM,
     &     info_p(1), info_p(2)
     &     )
      CALL zmumps_init_pool_last3( ipool_p(1), lpool_p,
     &           leaf )
      mumps_tps_arr(thread_id_p)%ITLOC = 0
600   CONTINUE
      virtual_task = virtual_task + 1
      IF ( virtual_task .LT. l_virt_l0_omp ) THEN
        IF ( virt_l0_omp_mapping( virtual_task ) .EQ. thread_id_p ) THEN
       DO physical_task =
     &       virt_l0_omp( virtual_task ),
     &       virt_l0_omp( virtual_task + 1 ) - 1
        DO i = ptr_leafs_l0_omp( perm_l0_omp( physical_task )+1 ) + 1,
     &         ptr_leafs_l0_omp( perm_l0_omp( physical_task ) )
          IF (ipool_b_l0_omp(i) .GT. 0) THEN 
            CALL zmumps_insert_pool_n( n, ipool_p(1),
     &      lpool_p,
     &      procnode_steps, slavef, keep(199), keep(28), 3, 0, 1, step,
     &      ipool_b_l0_omp(i) )
          END IF
        END DO
        DO WHILE (
     &    .NOT. zmumps_pool_empty( ipool_p(1), lpool_p )
     &    .AND. info_p(1) .GE. 0 ) 
          CALL zmumps_extract_pool( n, ipool_p(1), lpool_p,
     &    procnode_steps, slavef, step, inode, keep, keep8, myid_nodes,
     &    nd, .false. ) 
 10       CONTINUE
          l0_omp_mapping( step( inode ) ) = thread_id_p
          ifath = dad( step( inode ) )
          TYPE = 1
          IF ( ifath .NE. 0 ) THEN
              typef = 1
          ELSE
              typef = -9999
          ENDIF
          CALL zmumps_process_front_niv1( comm_load, ass_irecv, n,
     &  inode, TYPE, typef, mumps_tps_arr(thread_id_p)%LA, MUMPS_TPS_ARR
     &  (thread_id_p)%IW(1), mumps_tps_arr(thread_id_p)%LIW,
     &  zmumps_tps_arr(thread_id_p)%A(1), maxfrw, noffnegw, npvw,
     &  nb22t1w, nbtinyw, det_expw, det_mantw, det_signw, info_p, uu,
     &  seuil, seuil_ldlt_niv2, opeliw, nelvaw, nmaxnpivw, nstepsw,
     &  ptrist, ptlust_s, ptrfac, ptrast, step, pimaster, pamaster,
     &  ne, mumps_tps_arr(thread_id_p)%POSFAC,
     &  mumps_tps_arr(thread_id_p)%LRLU,
     &  mumps_tps_arr(thread_id_p)%LRLUS, mumps_tps_arr(thread_id_p)%
     %  LRLUSM, mumps_tps_arr(thread_id_p)%IPTRLU, icntl, keep, keep8,
     &  dkeep, pivnul_list, lpn_list, comp, mumps_tps_arr(thread_id_p)%
     &  iwpos, mumps_tps_arr(thread_id_p)%IWPOSCB, procnode_steps,
     &  slavef, ifath, comm_nodes, myid_nodes, ipool_p, lpool_p, leaf,
     &  perm, nstk_steps, bufr, lbufr, lbufr_bytes,
     &  nbfin, root, opassw, mumps_tps_arr(thread_id_p)%ITLOC(1),
     &  rhs_mumps, fils, ptrarw, ptraiw, intarr, dblarr, nd, frere, dad,
     &  lptrar, nelt, frtptr, frtelt, istep_to_iniv2, tab_pos_in_pere, 
     &  lrgroups, flop_estim_acc )
          IF (info_p(1) .LT. 0) THEN
            GOTO 700
          ENDIF
          IF ( ifath .NE. 0 ) THEN
              IF ( phys_l0_omp( perm_l0_omp( physical_task ) )
     &             .NE. inode ) THEN
                  nstk_steps( step( ifath ) ) =
     &             nstk_steps( step( ifath ) ) - 1
                  IF ( nstk_steps( step( ifath ) ) .EQ. 0 ) THEN
                       inode = ifath
                       GOTO 10
                  ENDIF
              ELSE
!$OMP ATOMIC UPDATE
                  nstk_steps( step( ifath ) ) =
     &             nstk_steps( step( ifath ) ) - 1
!$OMP END ATOMIC
              END IF
          ELSE
            nbroot_processed = nbroot_processed + 1
          END IF
        END DO
       END DO
      ENDIF
      GOTO 600
      ENDIF
 700  CONTINUE
      IF (associated(mumps_tps_arr(thread_id_p)%ITLOC)) THEN
        DEALLOCATE(mumps_tps_arr(thread_id_p)%ITLOC)
        NULLIFY(mumps_tps_arr(thread_id_p)%ITLOC)
        CALL mumps_dm_fac_upd_dyn_memcnts(
     &      -(int(n+keep(253),8) * int(keep(34),8 )) / int(keep(35),8),
     &      keep(405).EQ.1, keep8,
     &      info_p(1), info_p(2), .true., .false. )
      ENDIF
      IF (allocated(ipool_p)) THEN
        DEALLOCATE(ipool_p);
        CALL mumps_dm_fac_upd_dyn_memcnts(
     &      -(int(lpool_p,8) * int(keep(34),8 )) / int(keep(35),8),
     &      keep(405).EQ.1, keep8,
     &      info_p(1), info_p(2), .true., .false. )
      ENDIF
      IF ( keep(406) .EQ. 2) THEN
        CALL zmumps_perform_copies( thread_id_p,
     &  mumps_tps_arr, zmumps_tps_arr,
     &  l0_omp_factors, ll0_omp_factors,
     &  state, size_copied,
     &  nbwaitmem, nbfinished, nbongoingcopies, nbunderl0,
     &  myid_nodes, n, slavef,
     &  step, ptrast, pamaster, procnode_steps, dad,
     &  keep, keep8, info_p
     &  )
      ELSE
       IF ((keep(407) .EQ. 1) .OR. (keep(406) .EQ.1) ) THEN
        IF (info_p(1) .GE. 0) THEN
          CALL zmumps_dm_cbstatic2dynamic_i  
     &    (2,   
     &     0_8, 
     &    .false., 
     &    myid_nodes, n, slavef, keep, keep8,
     &    mumps_tps_arr(thread_id_p)%IW(1),
     &    mumps_tps_arr(thread_id_p)%LIW,
     &    mumps_tps_arr(thread_id_p)%IWPOSCB, 
     &    mumps_tps_arr(thread_id_p)%IWPOS,
     &   zmumps_tps_arr(thread_id_p)%A(1),
     &    mumps_tps_arr(thread_id_p)%LA,
     &    mumps_tps_arr(thread_id_p)%LRLU,
     &    mumps_tps_arr(thread_id_p)%IPTRLU,
     &    mumps_tps_arr(thread_id_p)%LRLUS,
     &    step, ptrast, pamaster, procnode_steps, dad,
     &    info_p(1), info_p(2) )
        ENDIF
       ENDIF
       IF (keep(406) .EQ.1) THEN
        IF (info_p(1) .GE.0 )THEN 
          to_allocate = max(mumps_tps_arr(thread_id_p)%POSFAC-1,1_8)
          CALL zmumps_dm_fac_alloc_allowed( to_allocate,
     &             keep8, info_p(1), info_p(2) )
        ENDIF
        IF (info_p(1) .GE.0 )THEN 
          ALLOCATE(l0_omp_factors(thread_id_p)%A(to_allocate),
     &           stat=allocok)
          IF (allocok .GT. 0) THEN
            info_p(1) = -13
            CALL mumps_seti8toi4(to_allocate, info_p(2))
            l0_omp_factors(thread_id_p)%LA = 0_8
          ELSE
            l0_omp_factors(thread_id_p)%LA =
     &                           mumps_tps_arr(thread_id_p)%POSFAC-1_8
            CALL mumps_dm_fac_upd_dyn_memcnts(
     &         l0_omp_factors(thread_id_p)%LA, keep(405).EQ.1, keep8,
     &         info_p(1), info_p(2), .true., .false. )
          ENDIF
        ENDIF
        IF (info_p(1) .GE.0 ) THEN
          DO i8 = 1_8, mumps_tps_arr(thread_id_p)%POSFAC-1_8
            l0_omp_factors(thread_id_p)%A(i8) =
     &                             zmumps_tps_arr(thread_id_p)%A(i8)
          ENDDO
        ENDIF
        IF ( associated(zmumps_tps_arr(thread_id_p)%A)) THEN
          DEALLOCATE(zmumps_tps_arr(thread_id_p)%A)
          NULLIFY(zmumps_tps_arr(thread_id_p)%A)
          CALL mumps_dm_fac_upd_dyn_memcnts(
     &                  -mumps_tps_arr(thread_id_p)%LA,
     &                  keep(405).EQ.1, 
     &                  keep8,
     &                  info_p(1), info_p(2),
     &                  .false., .false. ) 
          IF (info_p(1) .GE. 0) THEN
!$OMP       ATOMIC UPDATE
            keep8(69) = keep8(69) - l0_omp_factors(thread_id_p)%LA
!$OMP       END ATOMIC 
          ENDIF
        ENDIF
      ENDIF  
      ENDIF
      IF (info_p(1) .LT.0) THEN
!$OMP CRITICAL(critical_info)
        info(1) = info_p(1)
        info(2) = info_p(2)
!$OMP END CRITICAL(critical_info)
      ELSE IF (info_p(1) .GE. 0) THEN
!$OMP CRITICAL(critical_info)
        IF (info(1) .EQ. 0) THEN
          info(1) = info_p(1)
          info(2) = info_p(2)
        ENDIF
!$OMP END CRITICAL(critical_info)
      ENDIF
#if defined(WORKAROUNDINTELILP64OPENMPLIMITATION)
!$    CALL omp_set_num_threads(int(NOMP_SAVE,4))
#else
!$    CALL omp_set_num_threads(NOMP_SAVE)
#endif
!$OMP END PARALLEL
      IF (info(1) .LT. 0) THEN
        IF (icntl(1) .GT. 0 .AND. icntl(4) .GE.1 ) THEN
          WRITE(icntl(1),'(A,I6,I16,A,I5,A)')
     &    "** ERROR DURING L0_OMP: INFO(1:2)=",
     &    info(1), info(2), " (MPI worker ", myid_nodes,")"
        ENDIF
      ENDIF
      IF ( keep(406) .EQ. 0 ) THEN
       ALLOCATE(id(keep(400)), val(keep(400)),
     &          stat = allocok)
       IF ( allocok .GT. 0 ) THEN
          info(1) = -13
          info(2) = keep(400)
          GOTO 800
       ENDIF
       DO mythread_id = 1, keep(400)
         val(mythread_id) =  mumps_tps_arr( mythread_id )%POSFAC-1_8
         id(mythread_id)  =  mythread_id
       ENDDO
       CALL mumps_sort_int8(keep(400), val, id) 
       DO ith=1, keep(400)
        mythread_id = id(ith)
        IF ((keep(407).NE.1) .AND. (keep(406).EQ.0)) THEN
          IF (info(1) .GE. 0) THEN
          CALL zmumps_dm_cbstatic2dynamic_i  
     &    (2,   
     &     0_8, 
     &    .false., 
     &    myid_nodes, n, slavef, keep, keep8,
     &    mumps_tps_arr(mythread_id)%IW(1),
     &    mumps_tps_arr(mythread_id)%LIW,
     &    mumps_tps_arr(mythread_id)%IWPOSCB, 
     &    mumps_tps_arr(mythread_id)%IWPOS,
     &   zmumps_tps_arr(mythread_id)%A(1),
     &    mumps_tps_arr(mythread_id)%LA,
     &    mumps_tps_arr(mythread_id)%LRLU,
     &    mumps_tps_arr(mythread_id)%IPTRLU,
     &    mumps_tps_arr(mythread_id)%LRLUS,
     &    step, ptrast, pamaster, procnode_steps, dad,
     &    info(1), info(2) )
          ENDIF
        ENDIF
        IF (keep(406).EQ.0) THEN
         IF (info(1) .GE. 0 )THEN
          to_allocate = max(mumps_tps_arr(mythread_id)%POSFAC-1,1_8)
          CALL zmumps_dm_fac_alloc_allowed( to_allocate,
     &             keep8, info(1), info(2) )
         ENDIF
         IF (info(1) .GE.0 ) THEN 
           ALLOCATE(l0_omp_factors(mythread_id)%A(to_allocate),
     &            stat=allocok)
           IF (allocok .GT. 0) THEN
            info(1) = -13
            CALL mumps_seti8toi4(to_allocate, info(2))
            l0_omp_factors(mythread_id)%LA = 0_8
           ELSE
            l0_omp_factors(mythread_id)%LA =
     &                          mumps_tps_arr(mythread_id)%POSFAC-1_8
            CALL mumps_dm_fac_upd_dyn_memcnts(
     &        l0_omp_factors(mythread_id)%LA,
     &        keep(405).EQ.1, keep8,
     &        info(1), info(2), .true., .false. )
           ENDIF
         ENDIF
         IF (info(1) .GE. 0) THEN
!$         CHUNK8 = max( int(KEEP(361),8),
!$   &     (MUMPS_TPS_ARR(MYTHREAD_ID)%POSFAC+KEEP(400)-2_8) /
!$   &     KEEP(400) )
!$         OMP_FLAG = ( (MUMPS_TPS_ARR(MYTHREAD_ID)%POSFAC-1_8 >
!$   &                                               int(KEEP(361),8))
!$   &                  .AND. (KEEP(400).GT.1)
!$   &                 )
!$OMP      PARALLEL DO PRIVATE(I8) SCHEDULE(STATIC, CHUNK8)
!$OMP&     IF (OMP_FLAG) 
           DO i8 = 1_8, mumps_tps_arr(mythread_id)%POSFAC-1_8
             l0_omp_factors(mythread_id)%A(i8) =
     &                               zmumps_tps_arr(mythread_id)%A(i8)
           ENDDO
!$OMP      END PARALLEL DO 
         ENDIF
         IF ( associated(zmumps_tps_arr(mythread_id)%A)) THEN
           DEALLOCATE(zmumps_tps_arr(mythread_id)%A)
           NULLIFY(zmumps_tps_arr(mythread_id)%A)
           CALL mumps_dm_fac_upd_dyn_memcnts( 
     &                     -mumps_tps_arr(mythread_id)%LA,
     &                     keep(405).EQ.1, keep8,
     &                     info(1), info(2),
     &                     .false., .false. ) 
           IF (info(1).GE.0) THEN
             keep8(69) = keep8(69) - l0_omp_factors(mythread_id)%LA
           ENDIF
         ENDIF
        ENDIF
       ENDDO
       IF (ALLOCATED(id)) DEALLOCATE(id)
       IF (ALLOCATED(val)) DEALLOCATE(val)
      ENDIF
  800 CONTINUE
      keep8(64) = 0_8
      DO i = 1, keep(400)
        keep8(64) = keep8(64) + mumps_tps_arr(i)%POSFAC - 1_8
      ENDDO
      keep8(62) = 0_8
      DO i = 1, keep(400)
        keep8(62) = keep8(62) + mumps_tps_arr(i)%LRLUSM
      ENDDO
      nbroot_under_l0 = nbroot_processed
      dkeep(95) = mpi_wtime() - gtime 
      time_update          = time_update/dble(keep(400))
      time_update_lrlr1    = time_update_lrlr1/dble(keep(400))
      time_update_lrlr2    = time_update_lrlr2/dble(keep(400))
      time_update_lrlr3    = time_update_lrlr3/dble(keep(400))
      time_update_frlr     = time_update_frlr/dble(keep(400))
      time_update_frfr     = time_update_frfr/dble(keep(400))
      time_midblk_compress = time_midblk_compress/dble(keep(400))
      time_compress        = time_compress/dble(keep(400))
      time_frswap_compress = time_frswap_compress/dble(keep(400))
      time_cb_compress     = time_cb_compress/dble(keep(400))
      time_panel           = time_panel/dble(keep(400))
      time_fac_i           = time_fac_i/dble(keep(400))
      time_fac_mq          = time_fac_mq/dble(keep(400))
      time_fac_sq          = time_fac_sq/dble(keep(400))
      time_frfronts        = time_frfronts/dble(keep(400))
      time_lrtrsm          = time_lrtrsm/dble(keep(400))
      time_frtrsm          = time_frtrsm/dble(keep(400))
      time_lr_module       = time_lr_module/dble(keep(400))
      time_decomp          = time_decomp/dble(keep(400))
      time_diagcopy        = time_diagcopy/dble(keep(400))
      time_decomp_ucfs     = time_decomp_ucfs/dble(keep(400))
      time_decomp_asm1     = time_decomp_asm1/dble(keep(400))
      time_decomp_locasm2  = time_decomp_locasm2/dble(keep(400))
      time_decomp_maplig1  = time_decomp_maplig1/dble(keep(400))
      time_decomp_asms2s   = time_decomp_asms2s/dble(keep(400))
      time_decomp_asms2m   = time_decomp_asms2m/dble(keep(400))
      CALL mumps_load_enable()
      CALL zmumps_load_update(0,.false., flop_estim_acc,keep,keep8)
      RETURN
      END SUBROUTINE zmumps_fac_l0_omp
      SUBROUTINE zmumps_set_maxs_maxis_thread(MAXS_BASE_RELAXED8TH,
     &     MAXIS_BASE_RELAXEDTH, BLR_STRAT,
     &     KEEP,
     &     I4_L0_OMPTH, NBSTATS_I4,
     &     I8_L0_OMPTH, NBSTATS_I8)
      IMPLICIT NONE
      INTEGER, INTENT(IN)     :: KEEP(500), NBSTATS_I4, NBSTATS_I8
      INTEGER, INTENT(IN)     :: I4_L0_OMPTH(NBSTATS_I4)
      INTEGER(8), INTENT(IN)  :: I8_L0_OMPTH(NBSTATS_I8)
      INTEGER(8), INTENT(OUT) :: MAXS_BASE_RELAXED8TH
      INTEGER, INTENT(OUT)    :: MAXIS_BASE_RELAXEDTH
      INTEGER, INTENT(OUT)    :: BLR_STRAT 
      INTEGER    :: PERLU
      INTEGER(8) :: MAXS_BASE8TH
      INTEGER(8) :: MAXIS_BASE_RELAXEDTH8
      perlu = keep(12)
      CALL zmumps_set_blrstrat_and_maxs ( maxs_base8th,
     &     maxs_base_relaxed8th, blr_strat, keep(1),
     &     i8_l0_ompth(2), i8_l0_ompth(3), i8_l0_ompth(5),
     &     i8_l0_ompth(6), i8_l0_ompth(7), i8_l0_ompth(8) )
      IF ( keep(201) .EQ. 0 ) THEN
        maxis_base_relaxedth8 = int(i4_l0_ompth(2),8)  
      ELSE
        maxis_base_relaxedth8 = int(i4_l0_ompth(4),8)  
      ENDIF
      maxis_base_relaxedth8 = max( 1_8,
     &            maxis_base_relaxedth8 + 3 * max(perlu,10) *
     &            ( maxis_base_relaxedth8 / 100 + 1 )
     &  )
      maxis_base_relaxedth8 = min(maxis_base_relaxedth8,
     &                            int( huge( maxis_base_relaxedth ) ,8)
     &                           )
      maxis_base_relaxedth  = int( maxis_base_relaxedth8 )
      RETURN
      END SUBROUTINE zmumps_set_maxs_maxis_thread
      SUBROUTINE zmumps_ma_eff_mem_dispo(
     &     MUMPS_TPS_ARR, NBTHREADS, KEEP8, KEEP,
     &     N, BLR_STRAT, LPOOL_P,
     &     I8_L0_OMP, NBSTATS_I8,
     &     MEMDISPO_UNDERL0)
      USE mumps_tps_m, ONLY : mumps_tps_t
      IMPLICIT NONE
      INTEGER, INTENT(IN)     :: N, BLR_STRAT, KEEP(500)
      INTEGER, INTENT(IN)     :: NBSTATS_I8, NBTHREADS, LPOOL_P
      INTEGER(8), INTENT(IN)  :: KEEP8(150)
      INTEGER(8), INTENT(IN)  :: I8_L0_OMP(NBSTATS_I8,NBTHREADS)
      INTEGER(8), INTENT(OUT) :: MEMDISPO_UNDERL0
      TYPE (MUMPS_TPS_T), INTENT(IN) :: MUMPS_TPS_ARR(:)
      INTEGER    :: PERLU, ITH, ITHMIN, ITHMIN_if_LRLU, OOC_STRAT
      INTEGER(8) :: TO_ALLOCATE, BLR_RELATED, COPY_RELATED
      INTEGER(8) :: MIN_NRLADU_underL0, MIN_NRLADU_if_LR_LU_underL0
      perlu     = keep(12)
      ooc_strat = keep(201)
      to_allocate = 0_8
      DO ith = 1, nbthreads
         to_allocate = to_allocate +
     &   ((int(mumps_tps_arr(ith)%LIW,8) * int(keep(34),8 )) /
     &     int(keep(35),8 ))
     &   + mumps_tps_arr(ith)%LA
      ENDDO
      to_allocate = to_allocate + int(nbthreads,8)* (
     & ((int(lpool_p,8) * int(keep(34),8 )) / int(keep(35),8 )) +
     & ((int(n+keep(253),8) * int(keep(34),8 )) / int(keep(35),8 ))
     & )
      blr_related = 0_8
      DO ith = 1, nbthreads
         IF (blr_strat.EQ.1) THEN
           blr_related = blr_related +
     &        i8_l0_omp(10,ith) + 
     &        int(perlu,8) * ( i8_l0_omp(10,ith) / 100_8 + 1_8)
         ELSE  IF (blr_strat.EQ.2) THEN
           blr_related = blr_related +
     &        i8_l0_omp(13,ith) + 
     &        int(perlu,8) * ( i8_l0_omp(13,ith) / 100_8 + 1_8)
         ELSE IF (blr_strat.EQ.3) THEN
           blr_related = blr_related +
     &        i8_l0_omp(8,ith) + 
     &        int(perlu,8) * ( i8_l0_omp(8,ith) / 100_8 + 1_8)
         ENDIF
      ENDDO
      copy_related = 0_8
      ithmin = 1
      ithmin_if_lrlu = 1 
      min_nrladu_if_lr_lu_underl0 = i8_l0_omp(4,1)
      min_nrladu_underl0          = i8_l0_omp(1,1)
      DO ith = 1, nbthreads
        IF (i8_l0_omp(1,ith).LT.min_nrladu_underl0)
     &      THEN
             min_nrladu_underl0 = i8_l0_omp(1,ith)
             ithmin = ith
        ENDIF
        IF (i8_l0_omp(4,ith).LT.min_nrladu_if_lr_lu_underl0) 
     &      THEN
            min_nrladu_if_lr_lu_underl0 = i8_l0_omp(4,ith)
            ithmin_if_lrlu = ith
        ENDIF
      ENDDO
      IF (blr_strat.EQ.0) THEN
        IF (ooc_strat .LE. 0 .AND. ooc_strat .NE. -1 ) THEN
         copy_related = copy_related +     
     &         i8_l0_omp(1,ithmin) +  
     &         i8_l0_omp(23, ithmin)  
        ELSE
         copy_related = copy_related +     
     &         i8_l0_omp(23, ithmin)  
        ENDIF
      ELSE
        IF (ooc_strat .LE. 0 .AND. ooc_strat .NE. -1 ) THEN
         copy_related = copy_related +     
     &    i8_l0_omp(4,ithmin_if_lrlu) + 
     &    i8_l0_omp(23,ithmin_if_lrlu )  
        ELSE
         copy_related = copy_related +     
     &    i8_l0_omp(23, ithmin_if_lrlu)  
        ENDIF
      ENDIF
      copy_related = copy_related +
     &   int(perlu,8)*(copy_related / 100_8 + 1_8 )
      to_allocate       = to_allocate + copy_related + blr_related
      memdispo_underl0  = keep8(75) - to_allocate
      RETURN
      END SUBROUTINE zmumps_ma_eff_mem_dispo
      SUBROUTINE zmumps_l0omp_copy_iw( IW, LIW, IWPOS,
     &                                 MUMPS_TPS_ARR, KEEP,
     &                                 PTLUST, ICNTL, INFO )
      USE mumps_tps_m, ONLY : mumps_tps_t
      IMPLICIT NONE
      INTEGER                     :: KEEP(500)
      INTEGER, INTENT( IN )       :: LIW
      INTEGER, INTENT( INOUT )    :: IW(:) 
      INTEGER, INTENT( INOUT )    :: IWPOS
      INTEGER, INTENT( INOUT )    :: PTLUST(KEEP(28))
      INTEGER, INTENT( IN )       :: ICNTL(60)
      INTEGER, INTENT( INOUT )    :: INFO(80)
      TYPE (MUMPS_TPS_T), TARGET  :: MUMPS_TPS_ARR(:)
      INTEGER :: ITHREAD, JTHREAD
      INTEGER :: REQUESTED_SIZE
      INTEGER :: IWPOS_TO_COPY 
      INTEGER :: LOC_IPOS
      INTEGER :: LOC_SIZE, LOC_ISTEP
      TYPE (MUMPS_TPS_T), POINTER :: MUMPS_TPS
      include 'mumps_headers.h'
      REQUESTED_SIZE = 0
      DO ITHREAD = 1, size(MUMPS_TPS_ARR)
        MUMPS_TPS => MUMPS_TPS_ARR(ITHREAD)
        REQUESTED_SIZE = REQUESTED_SIZE + MUMPS_TPS%IWPOS - 1
      ENDDO
.LT.      IF ( LIW - IWPOS + 1  REQUESTED_SIZE ) THEN
        WRITE(*,*) " LIW too small in ZMUMPS_L0OMP_COPY_IW !!", LIW,
     &  REQUESTED_SIZE
        INFO(1) = -8
        INFO(2) = REQUESTED_SIZE-LIW+IWPOS-1
.GT..AND..GE.        IF ( ICNTL(1)  0  ICNTL(4)1) THEN
          WRITE(ICNTL(1),*) " ** ERROR IN ZMUMPS_L0OMP_COPY_IW: ",
     &    "LIW TOO SMALL TO COPY LOCAL FACTOR INFORMATION",
     &    INFO(2)
        ENDIF
        GOTO 500
      ENDIF
      DO ITHREAD = 1, size(MUMPS_TPS_ARR)
        MUMPS_TPS => MUMPS_TPS_ARR(ITHREAD)
        IWPOS_TO_COPY = IWPOS
        DO JTHREAD=1, ITHREAD - 1
          IWPOS_TO_COPY = IWPOS_TO_COPY+MUMPS_TPS_ARR(JTHREAD)%IWPOS-1
        ENDDO
        IW(IWPOS_TO_COPY: IWPOS_TO_COPY+MUMPS_TPS%IWPOS - 2) =
     &                              MUMPS_TPS%IW(1:MUMPS_TPS%IWPOS-1)
        LOC_IPOS = 1
.NE.        DO WHILE ( LOC_IPOS  MUMPS_TPS%IWPOS )
          LOC_SIZE  = MUMPS_TPS%IW(LOC_IPOS+XXI)
          LOC_ISTEP = MUMPS_TPS%IW(LOC_IPOS+KEEP(IXSZ)+4)
          PTLUST(LOC_ISTEP) = IWPOS_TO_COPY+LOC_IPOS-1
          LOC_IPOS = LOC_IPOS + LOC_SIZE
        ENDDO
      ENDDO
      IWPOS = IWPOS + REQUESTED_SIZE
 500  CONTINUE
      RETURN
      END SUBROUTINE ZMUMPS_L0OMP_COPY_IW
      SUBROUTINE ZMUMPS_PERFORM_COPIES_INIT( STATE, KEEP8_77_SAVE,
     & NbWaitMem, NbFinished, NbOnGoingCopies, NbUnderL0,
     & KEEP, KEEP8 )
      INTEGER, INTENT(IN)    :: KEEP(500)
      INTEGER(8), INTENT(IN) :: KEEP8(150)
      INTEGER, INTENT(OUT)   :: NbWaitMem,
     &                          NbFinished,
     &                          NbOnGoingCopies,
     &                          NbUnderL0
      INTEGER(8), INTENT(OUT) :: STATE(KEEP(400)), KEEP8_77_SAVE
      INTEGER :: ITH
      NbWaitMem       = 0
      NbFinished      = 0
      NbOnGoingCopies = 0
      NbUnderL0       = KEEP(400)
      DO ITH=1, KEEP(400)
        STATE(ITH) = UnderL0
      ENDDO
      KEEP8_77_SAVE = KEEP8(77)
      RETURN
      END SUBROUTINE ZMUMPS_PERFORM_COPIES_INIT
      SUBROUTINE ZMUMPS_PERFORM_COPIES( THREAD_ID_P, 
     &           MUMPS_TPS_ARR, ZMUMPS_TPS_ARR,
     &           L0_OMP_FACTORS, LL0_OMP_FACTORS,
     &           STATE, SIZE_COPIED,
     &           NbWaitMem, NbFinished, NbOngoingCopies, NbUnderL0,
     &           MYID_NODES, N, SLAVEF,
     &           STEP, PTRAST, PAMASTER, PROCNODE_STEPS, DAD,
     &           KEEP, KEEP8, INFO_P
     &           )
      USE MUMPS_TPS_M, ONLY : MUMPS_TPS_T
      USE ZMUMPS_TPS_M, ONLY : ZMUMPS_TPS_T
      USE ZMUMPS_STRUC_DEF, ONLY : ZMUMPS_L0OMPFAC_T
      INTEGER :: KEEP(500)
      INTEGER(8) :: KEEP8(150)
      INTEGER, INTENT(IN) :: THREAD_ID_P
      INTEGER, INTENT(INOUT) :: INFO_P(2)
      INTEGER, INTENT(IN) :: MYID_NODES, N, SLAVEF
      INTEGER, INTENT(IN) ::  STEP(N), DAD(KEEP(28))
      INTEGER(8), INTENT(IN) :: PAMASTER(KEEP(28)), PTRAST(KEEP(28))
      INTEGER, INTENT(IN) :: PROCNODE_STEPS(KEEP(28))
      INTEGER, INTENT(INOUT) :: NbWaitMem,
     &                          NbFinished,
     &                          NbOnGoingCopies,
     &                          NbUnderL0
      INTEGER(8), INTENT(INOUT) :: STATE( KEEP(400) )
      INTEGER(8), INTENT(INOUT) :: SIZE_COPIED(KEEP(400) )
      TYPE (MUMPS_TPS_T), DIMENSION(:) :: MUMPS_TPS_ARR
      TYPE (ZMUMPS_TPS_T), DIMENSION(:) :: ZMUMPS_TPS_ARR
      INTEGER, INTENT ( IN )  :: LL0_OMP_FACTORS
      TYPE (ZMUMPS_L0OMPFAC_T), INTENT(INOUT) ::
     &                        L0_OMP_FACTORS(LL0_OMP_FACTORS)
      INTEGER :: LOCAL_ACTION
      INTEGER, PARAMETER :: NOTHING            = 0
      INTEGER, PARAMETER :: FREE_WORK_MYID     = 1
      INTEGER, PARAMETER :: COPY_FACTORS       = 2
      INTEGER, PARAMETER :: AllocateViderCB    = 3
      INTEGER, PARAMETER :: DORMIR             = 4
      INTEGER(8)       :: COPY_START, CHUNK8, I8, TO_ALLOCATE
      INTEGER          :: ITH, K
      INTEGER          :: allocok
      INTEGER(8) :: PeakAuthorized_P
      INTEGER(8) :: MemNeeded_P, MemNeededForCB_P, MemDispo_P,
     &        CBCopiedToDynamic_P, LRLUS_SAVE_P
      INTEGER(8) :: KEEP8_71, KEEP8_73
!$OMP CRITICAL(L0_COPIES)
      STATE(THREAD_ID_P) = CopyNotStarted
.LT.      IF ( INFO_P(1)  0 ) THEN
        NbFinished = NbFinished + 1
        STATE(THREAD_ID_P) = Finished
      ENDIF
      DO ITH = 1, KEEP(400)
.EQ.       IF ( STATE(ITH)  WaitMem ) THEN
         STATE(ITH)=CopyNotStarted
       ENDIF
      ENDDO
      NbWaitMem       = 0
!$OMP END CRITICAL(L0_COPIES)
.NE.      DO WHILE ( NbFinished  KEEP(400) )
        LOCAL_ACTION = DORMIR
!$OMP CRITICAL(L0_COPIES)
.EQ.        IF ( NbFinished KEEP(400)) THEN
         LOCAL_ACTION = NOTHING
.EQ.        ELSE IF ( (NbFinished+NbWaitMem)  KEEP(400) ) THEN
!$OMP ATOMIC READ
            KEEP8_73 = KEEP8(73)
!$OMP END ATOMIC
!$OMP ATOMIC READ
            KEEP8_71 = KEEP8(71)
!$OMP END ATOMIC
            MemDispo_P  = KEEP8(77)  - (KEEP8_73 -KEEP8_71)
            MemDispo_P  = min(MemDispo_P, KEEP8(75)-KEEP8_73)
            MemNeeded_P = huge(MemNeeded_P)
            DO ITH = 1, KEEP(400)
.EQ.             IF (STATE(ITH)WaitMem) THEN
               MemNeeded_P = min( MemNeeded_P,
     &                     MUMPS_TPS_ARR(ITH)%LA -
     &                     MUMPS_TPS_ARR(ITH)%LRLUS )
             ENDIF
            ENDDO
.LT.            IF ((KEEP8(75)-KEEP8_73)MemNeeded_P) THEN
              INFO_P(1)  = -19
              CALL MUMPS_SET_IERROR (
     &             MemNeeded_P-(KEEP8(75)-KEEP8_73), INFO_P(2))
              DO ITH = 1, KEEP(400)
               STATE(ITH) = Finished
              ENDDO
              NbFinished = KEEP(400)
            ELSE
              KEEP8(77) = MemNeeded_P + (KEEP8_73 -KEEP8_71)
              DO ITH = 1, KEEP(400)
.EQ.                IF ( STATE(ITH)  WaitMem ) THEN
                  STATE(ITH)=CopyNotStarted
                ENDIF
              ENDDO
              NbWaitMem = 0
            ENDIF
            LOCAL_ACTION = NOTHING
        ELSE
         SELECT CASE (STATE(THREAD_ID_P))
          CASE ( CopyFactorsFinished )
           LOCAL_ACTION = FREE_WORK_MYID
          CASE ( CopyNotStarted )
!$OMP ATOMIC READ
           KEEP8_73 = KEEP8(73)
!$OMP END ATOMIC
!$OMP ATOMIC READ
           KEEP8_71 = KEEP8(71)
!$OMP END ATOMIC
           PeakAuthorized_P = KEEP8(77)
           MemDispo_P  = PeakAuthorized_P - (KEEP8_73 -KEEP8_71)
           MemDispo_P  = min(MemDispo_P, KEEP8(75)-KEEP8_73)
           MemNeeded_P = MUMPS_TPS_ARR(THREAD_ID_P)%LA -
     &                  MUMPS_TPS_ARR(THREAD_ID_P)%LRLUS
           MemNeededForCB_P = MemNeeded_P - 
     &                   ( MUMPS_TPS_ARR(THREAD_ID_P)%POSFAC - 1_8 )
.GE.           IF ( MemDispo_P  MemNeeded_P ) THEN
!$OMP ATOMIC CAPTURE
             KEEP8(73) = KEEP8(73) + MemNeeded_P
             KEEP8_73  = KEEP8(73)
!$OMP END ATOMIC
!$OMP ATOMIC READ
             KEEP8_71 = KEEP8(71)
!$OMP END ATOMIC
             MemDispo_P  = PeakAuthorized_P - (KEEP8_73 -KEEP8_71)
             MemDispo_P  = min(MemDispo_P, KEEP8(75)-KEEP8_73)
.LT.             IF ( MemDispo_P  0 ) THEN
!$OMP ATOMIC UPDATE
               KEEP8(73) = KEEP8(73) - MemNeeded_P
!$OMP END ATOMIC
.NE.               IF ( STATE(THREAD_ID_P)  WaitMem ) THEN
                 STATE( THREAD_ID_P ) = WaitMem
                 NbWaitMem = NbWaitMem + 1
               ENDIF
             ELSE
!$OMP ATOMIC UPDATE
              KEEP8(74) = max(KEEP8(74), KEEP8_73 )
!$OMP END ATOMIC
.EQ.              IF ( STATE( THREAD_ID_P )  WaitMem ) THEN
               NbWaitMem = NbWaitMem - 1
              ENDIF
              STATE( THREAD_ID_P ) = AllocateViderCBEnCours
              LOCAL_ACTION    = AllocateViderCB
              NbOngoingCopies = NbOnGoingCopies + 1
             ENDIF
           ELSE
.NE.            IF ( STATE(THREAD_ID_P)  WaitMem ) THEN
              STATE( THREAD_ID_P ) = WaitMem
              NbWaitMem = NbWaitMem + 1
            ENDIF
           ENDIF
          CASE DEFAULT
           ITH = -1
           DO K = THREAD_ID_P, THREAD_ID_P + KEEP(400) - 1
            IF ( K > KEEP(400) ) THEN
              ITH = K - KEEP(400)
            ELSE 
              ITH = K
            ENDIF
.GE..AND.            IF ( STATE(ITH)  0  
.LT.     &           STATE(ITH)  MUMPS_TPS_ARR(ITH)%POSFAC - 1_8 ) THEN
              EXIT
            ELSE
              ITH = -1
            ENDIF
           ENDDO
.GT.           IF ( ITH  0 ) THEN
            LOCAL_ACTION = COPY_FACTORS
            COPY_START = STATE(ITH) + 1
            CHUNK8 = max(
     &
     &      int(KEEP(361),8),
     &
     &       (MUMPS_TPS_ARR(ITH)%POSFAC+KEEP(400)-2_8) / 
     &        (int(KEEP(400)*2,8))
     &
     &      )
.EQ.            IF (KEEP(72)  1) THEN
              CHUNK8 = 4_8
            ENDIF
            CHUNK8 = min( CHUNK8,
     &      MUMPS_TPS_ARR(ITH)%POSFAC - 1_8 - COPY_START + 1_8
     &      )
            STATE(ITH) = STATE(ITH) + CHUNK8
           ENDIF
         END SELECT
        ENDIF
!$OMP END CRITICAL(L0_COPIES)
        SELECT CASE ( LOCAL_ACTION )
          CASE ( FREE_WORK_MYID )
            IF ( associated(ZMUMPS_TPS_ARR(THREAD_ID_P)%A) ) THEN
              DEALLOCATE(ZMUMPS_TPS_ARR(THREAD_ID_P)%A)
              NULLIFY(ZMUMPS_TPS_ARR(THREAD_ID_P)%A)
              CALL MUMPS_DM_FAC_UPD_DYN_MEMCNTS(
     &                  -MUMPS_TPS_ARR(THREAD_ID_P)%LA,
.EQ.     &                  KEEP(405)1, 
     &                  KEEP8,
     &                  INFO_P(1), INFO_P(2),
     &                  .FALSE., .FALSE. ) 
.GE.              IF (INFO_P(1)  0) THEN
!$OMP           ATOMIC UPDATE
                KEEP8(69) = KEEP8(69) - L0_OMP_FACTORS(THREAD_ID_P)%LA
!$OMP           END ATOMIC
!$OMP CRITICAL(L0_COPIES)
                DO ITH = 1, KEEP(400)
.EQ.                  IF ( STATE(ITH)  WaitMem ) THEN
                    STATE(ITH)=CopyNotStarted
                  ENDIF
                ENDDO
                NbWaitMem       = 0
                NbFinished      = NbFinished + 1
                STATE( THREAD_ID_P ) = Finished
                NbOnGoingCopies = NbOnGoingCopies -1
!$OMP END CRITICAL(L0_COPIES)
              ENDIF
            ENDIF
          CASE ( AllocateViderCB )
          TO_ALLOCATE = max(MUMPS_TPS_ARR(THREAD_ID_P)%POSFAC-1_8,1_8)
          ALLOCATE( L0_OMP_FACTORS(THREAD_ID_P)%A(TO_ALLOCATE),
     &              stat=allocok )
.GT.          IF ( allocok  0 ) THEN
            INFO_P(1) = -13
            CALL MUMPS_SETI8TOI4(TO_ALLOCATE, INFO_P(2))
            L0_OMP_FACTORS(THREAD_ID_P)%LA = 0_8
!$OMP CRITICAL(L0_COPIES)
!$OMP ATOMIC UPDATE
            KEEP8(73) = KEEP8(73) - MemNeeded_P
!$OMP END ATOMIC
!$OMP END CRITICAL(L0_COPIES)
          ELSE
            L0_OMP_FACTORS(THREAD_ID_P)%LA =
     &                          MUMPS_TPS_ARR(THREAD_ID_P)%POSFAC-1_8
!$OMP ATOMIC UPDATE
            KEEP8(69) = KEEP8(69) + L0_OMP_FACTORS(THREAD_ID_P)%LA
!$OMP END ATOMIC
!$OMP CRITICAL(L0_COPIES)
            IF ( MUMPS_TPS_ARR(THREAD_ID_P)%POSFAC-1_8 == 0_8 ) THEN
              STATE(THREAD_ID_P) = CopyFactorsFinished
            ELSE
              STATE      ( THREAD_ID_P ) = 0
              SIZE_COPIED( THREAD_ID_P ) = 0
            ENDIF
!$OMP END CRITICAL(L0_COPIES)
            LRLUS_SAVE_P = MUMPS_TPS_ARR(THREAD_ID_P)%LRLUS
            CALL ZMUMPS_DM_CBSTATIC2DYNAMIC_I  
     &      (3,   
     &       0_8, 
     &      .FALSE., 
     &      MYID_NODES, N, SLAVEF, KEEP, KEEP8,
     &      MUMPS_TPS_ARR(THREAD_ID_P)%IW(1),
     &      MUMPS_TPS_ARR(THREAD_ID_P)%LIW,
     &      MUMPS_TPS_ARR(THREAD_ID_P)%IWPOSCB, 
     &      MUMPS_TPS_ARR(THREAD_ID_P)%IWPOS,
     &     ZMUMPS_TPS_ARR(THREAD_ID_P)%A(1),
     &      MUMPS_TPS_ARR(THREAD_ID_P)%LA,
     &      MUMPS_TPS_ARR(THREAD_ID_P)%LRLU,
     &      MUMPS_TPS_ARR(THREAD_ID_P)%IPTRLU,
     &      MUMPS_TPS_ARR(THREAD_ID_P)%LRLUS,
     &      STEP, PTRAST, PAMASTER, PROCNODE_STEPS, DAD,
     &      INFO_P(1), INFO_P(2) )
            CBCopiedToDynamic_P = 
     &      MUMPS_TPS_ARR(THREAD_ID_P)%LRLUS - LRLUS_SAVE_P
.LT.            IF (INFO_P(1)  0 ) THEN
!$OMP ATOMIC UPDATE
              KEEP8(73) = KEEP8(73) -
     &                      ( MemNeededForCB_P - CBCopiedToDynamic_P )
!$OMP END ATOMIC
            ELSE
            ENDIF
          ENDIF
          CASE ( COPY_FACTORS )
          DO I8 = COPY_START, COPY_START + CHUNK8 - 1
            L0_OMP_FACTORS(ITH)%A(I8) = ZMUMPS_TPS_ARR(ITH)%A(I8)
          ENDDO
!$OMP CRITICAL(L0_COPIES)
          SIZE_COPIED(ITH) = SIZE_COPIED(ITH) + CHUNK8
.EQ.          IF ( SIZE_COPIED(ITH)  L0_OMP_FACTORS(ITH)%LA ) THEN
            STATE(ITH) = CopyFactorsFinished
          ENDIF
!$OMP END CRITICAL(L0_COPIES)
          CASE ( NOTHING )
          CASE ( DORMIR )
          CALL MUMPS_USLEEP(1000)
          CASE DEFAULT
          WRITE(*,*) " Internal error in ZMUMPS_PERFORM_COPIES",
     &    LOCAL_ACTION
        END SELECT
      ENDDO
      RETURN
      END SUBROUTINE ZMUMPS_PERFORM_COPIES
      END MODULE ZMUMPS_FAC_OMP_M
      RECURSIVE SUBROUTINE ZMUMPS_PROCESS_FRONT_NIV1( COMM_LOAD,
     & ASS_IRECV, N, INODE, TYPE, TYPEF, LA, IW, LIW, A,
     & MAXFRW, NOFFNEGW, NPVW, NB22T1W, NBTINYW,
     & DET_EXPW, DET_MANTW, DET_SIGNW,
     & INFO_P, UU, SEUIL, SEUIL_LDLT_NIV2,
     & OPELIW, NELVAW, NMAXNPIVW, NSTEPSW, PTRIST, PTLUST_S,
     & PTRFAC, PTRAST, STEP, PIMASTER, PAMASTER, NE, POSFAC, 
     & LRLU, LRLUS, LRLUSM, IPTRLU, ICNTL, KEEP, KEEP8, DKEEP,
     & PIVNUL_LIST, LPN_LIST, COMP, IWPOS, IWPOSCB, PROCNODE_STEPS,
     & SLAVEF, IFATH, COMM_NODES, MYID_NODES, IPOOL_P,
     & LPOOL_P, LEAF, PERM, NSTK_STEPS, BUFR, LBUFR,
     & LBUFR_BYTES, NBFIN, root, OPASSW, ITLOC, RHS_MUMPS, FILS,
     & PTRARW, PTRAIW, INTARR, DBLARR, ND, FRERE, DAD, LPTRAR, NELT,
     & FRTPTR, FRTELT, ISTEP_TO_INIV2, TAB_POS_IN_PERE, LRGROUPS,
     & FLOP_ESTIM_ACC )
      USE ZMUMPS_FAC_ASM_MASTER_M
      USE ZMUMPS_FAC_ASM_MASTER_ELT_M
      USE ZMUMPS_FAC1_LU_M
      USE ZMUMPS_FAC1_LDLT_M
      USE ZMUMPS_STRUC_DEF, ONLY : ZMUMPS_ROOT_STRUC
      IMPLICIT NONE
      INCLUDE 'mumps_headers.h'
      TYPE (ZMUMPS_ROOT_STRUC) :: root
      INTEGER COMM_LOAD, ASS_IRECV
      INTEGER COMM_NODES, MYID_NODES, TYPE, TYPEF
      INTEGER N, LIW, INODE,INFO_P(2)
      INTEGER ICNTL(60), KEEP(500)
      DOUBLE PRECISION    DKEEP(230)
      DOUBLE PRECISION UU, SEUIL, SEUIL_LDLT_NIV2
      INTEGER(8) KEEP8(150)
      INTEGER(8) :: LA, POSFAC, LRLU, LRLUS, LRLUSM, IPTRLU
      INTEGER IWPOSCB, IWPOS,
     &        IFATH, SLAVEF, NELVAW, NMAXNPIVW, NSTEPSW
      INTEGER IW(LIW),PROCNODE_STEPS(KEEP(28))
      INTEGER(8) :: PTRAST  (KEEP(28))
      INTEGER(8) :: PTRFAC  (KEEP(28))
      INTEGER(8) :: PAMASTER(KEEP(28))
      INTEGER PTRIST(KEEP(28)), PTLUST_S(KEEP(28))
      INTEGER STEP(N), PIMASTER(KEEP(28)), NE(KEEP(28))
      COMPLEX(kind=8)    A(LA)
      INTEGER :: MAXFRW, NOFFNEGW, NPVW, NBTINYW
      INTEGER, intent(in) :: LRGROUPS(N)
      DOUBLE PRECISION OPASSW, OPELIW
      COMPLEX(kind=8) DBLARR(KEEP8(26))
      INTEGER INTARR(KEEP8(27)) 
      INTEGER ITLOC( N + KEEP(253) ), FILS( N ),
     &        ND( KEEP(28) ), FRERE( KEEP(28) )
      INTEGER DAD( KEEP(28) )
      COMPLEX(kind=8) :: RHS_MUMPS(KEEP(255))
      INTEGER ISTEP_TO_INIV2(KEEP(71)), 
     &        TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56)))
      INTEGER NELT, LPTRAR
      INTEGER FRTPTR( N+1 ), FRTELT( NELT )
      INTEGER(8), INTENT(IN) :: PTRAIW( LPTRAR ), PTRARW( LPTRAR )
      INTEGER LEAF, COMP
      INTEGER :: NB22T1W, DET_EXPW, DET_SIGNW
      COMPLEX(kind=8) :: DET_MANTW
      INTEGER PERM( N )
      INTEGER NSTK_STEPS( KEEP(28) )
      INTEGER LBUFR, LBUFR_BYTES
      INTEGER BUFR( LBUFR )
      INTEGER NBFIN
      INTEGER :: LPN_LIST
      INTEGER :: PIVNUL_LIST(LPN_LIST)
      DOUBLE PRECISION FLOP_ESTIM_ACC
      INTEGER, INTENT(IN) :: LPOOL_P
      INTEGER, INTENT(IN) :: IPOOL_P(LPOOL_P)
      INTEGER :: IOLDPS, JOBASS, ETATASS
      INTEGER(8) :: POSELT
      LOGICAL :: AVOID_DELAYED, SON_LEVEL2
      JOBASS  = 0
      ETATASS = 0
.EQ.      IF ( KEEP(55)  0 ) THEN
          JOBASS = 0
          CALL ZMUMPS_FAC_ASM_NIV1( COMM_LOAD, ASS_IRECV, N, INODE,
     &    IW, LIW, A, LA,
     &    INFO_P, ND, FILS, FRERE, DAD, MAXFRW, root, OPASSW,
     &    OPELIW, PTRIST, PTLUST_S, PTRFAC, PTRAST, STEP, PIMASTER,
     &    PAMASTER, PTRARW, PTRAIW, ITLOC, RHS_MUMPS, NSTEPSW,
     &    SON_LEVEL2,COMP, LRLU, IPTRLU,
     &    IWPOS, IWPOSCB, POSFAC,
     &    LRLUS, LRLUSM, ICNTL, KEEP, KEEP8, DKEEP, 
     &    INTARR, KEEP8(27), DBLARR, KEEP8(26),
     &    NSTK_STEPS, PROCNODE_STEPS, SLAVEF, COMM_NODES,
     &    MYID_NODES, BUFR, LBUFR, LBUFR_BYTES, NBFIN, IPOOL_P,
     &    LPOOL_P, LEAF, PERM, ISTEP_TO_INIV2, TAB_POS_IN_PERE,
     &    JOBASS, ETATASS
     &    , LRGROUPS
     &    )
      ELSE
          CALL ZMUMPS_FAC_ASM_NIV1_ELT(COMM_LOAD,ASS_IRECV,NELT,FRTPTR,
     &    FRTELT, N, INODE, IW, LIW, A,
     &    LA, INFO_P, ND, FILS, FRERE, DAD, MAXFRW,
     &    root, OPASSW, OPELIW, PTRIST, PTLUST_S, PTRFAC, PTRAST, STEP,
     &    PIMASTER, PAMASTER, PTRARW, PTRAIW, ITLOC,
     &    RHS_MUMPS, NSTEPSW, SON_LEVEL2, COMP, LRLU,
     &    IPTRLU, IWPOS, IWPOSCB,
     &    POSFAC, LRLUS, LRLUSM, ICNTL, KEEP, KEEP8, DKEEP,
     &    INTARR, KEEP8(27), DBLARR, KEEP8(26),
     &    NSTK_STEPS, PROCNODE_STEPS, SLAVEF,
     &    COMM_NODES, MYID_NODES, BUFR, LBUFR, LBUFR_BYTES, NBFIN,
     &    IPOOL_P, LPOOL_P, LEAF, PERM, ISTEP_TO_INIV2,
     &    TAB_POS_IN_PERE
     &    , LRGROUPS
     &    )
      ENDIF
.LT.      IF (INFO_P(1)  0) THEN
        RETURN
      ENDIF
.EQ.      AVOID_DELAYED = ( ( IFATH  KEEP(20)
.OR.     &                  
.EQ.     &                    IFATH  KEEP(38) )
.AND.     &                
.NE.     &                  ( KEEP(60)  0 ) )
      POSELT = PTRAST(STEP(INODE))
      IOLDPS = PTLUST_S(STEP(INODE))
.EQ.      IF ( KEEP(50)  0 ) THEN
          CALL ZMUMPS_FAC1_LU( N, INODE,
     &    IW, LIW,
     &    A, LA, IOLDPS,
     &    POSELT,
     &    INFO_P(1), INFO_P(2), UU, NOFFNEGW, NPVW, NBTINYW,
     &    DET_EXPW, DET_MANTW, DET_SIGNW,
     &    KEEP, KEEP8,
     &    STEP, PROCNODE_STEPS, MYID_NODES, SLAVEF,
     &    SEUIL, AVOID_DELAYED, ETATASS,
     &    DKEEP(1), PIVNUL_LIST(1), LPN_LIST, IWPOS 
     &    , LRGROUPS
     &    , PERM
     &    )
      ELSE
          IW( IOLDPS + 4 + KEEP(IXSZ) ) = 1
          CALL ZMUMPS_FAC1_LDLT( N, INODE,
     &    IW, LIW, A,
     &    LA,
     &    IOLDPS, POSELT,
     &    INFO_P(1), INFO_P(2), UU, NOFFNEGW, NPVW,
     &    NB22T1W, NBTINYW, DET_EXPW, DET_MANTW, DET_SIGNW,
     &    KEEP, KEEP8, MYID_NODES, SEUIL,
     &    AVOID_DELAYED,
     &    ETATASS,
     &    DKEEP(1), PIVNUL_LIST(1), LPN_LIST, IWPOS
     &    , LRGROUPS
     &    , PERM
     &    )
          IW(IOLDPS + 4 + KEEP(IXSZ)) = STEP(INODE)
      ENDIF
.LT.      IF (INFO_P(1)  0) THEN
        RETURN
      ENDIF
      CALL ZMUMPS_FAC_STACK( COMM_LOAD, ASS_IRECV, N, INODE, TYPE,
     &TYPEF, LA, IW, LIW, A,
     &INFO_P(1), INFO_P(2), OPELIW, NELVAW, NMAXNPIVW, PTRIST, PTLUST_S,
     &PTRFAC, PTRAST, STEP, PIMASTER, PAMASTER, NE, POSFAC, 
     &LRLU, LRLUS, LRLUSM, IPTRLU, ICNTL, KEEP,
     &KEEP8, DKEEP,
     &COMP,IWPOS, IWPOSCB, PROCNODE_STEPS,
     &SLAVEF, IFATH, COMM_NODES, MYID_NODES, IPOOL_P,
     &LPOOL_P, LEAF, NSTK_STEPS, PERM, BUFR, LBUFR,
     &LBUFR_BYTES, NBFIN, root, OPASSW, ITLOC, RHS_MUMPS,
     &FILS, DAD, PTRARW, PTRAIW, INTARR, DBLARR, ND, FRERE,
     &LPTRAR, NELT, FRTPTR, FRTELT, ISTEP_TO_INIV2, TAB_POS_IN_PERE, 
     & LRGROUPS,
     & FLOP_ESTIM_ACC
     &)
      RETURN
      END SUBROUTINE ZMUMPS_PROCESS_FRONT_NIV1