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_OOC
      USE MUMPS_OOC_COMMON
!$    USE OMP_LIB, ONLY : OMP_LOCK_KIND, OMP_SET_LOCK, OMP_UNSET_LOCK,
!$   &                    OMP_INIT_LOCK, OMP_DESTROY_LOCK, OMP_TEST_LOCK
      IMPLICIT NONE
!$     INTEGER(KIND=OMP_LOCK_KIND) :: LOCK_FOR_L0OMP
      INTEGER NOT_IN_MEM,BEING_READ,NOT_USED,PERMUTED,USED,
     &     USED_NOT_PERMUTED,ALREADY_USED
      PARAMETER (NOT_IN_MEM=0,BEING_READ=-1,NOT_USED=-2,
     &     PERMUTED=-3,USED=-4,USED_NOT_PERMUTED=-5,ALREADY_USED=-6)
      INTEGER OOC_NODE_NOT_IN_MEM,OOC_NODE_PERMUTED,
     &     OOC_NODE_NOT_PERMUTED
      PARAMETER (OOC_NODE_NOT_IN_MEM=-20,
     &     OOC_NODE_PERMUTED=-21,OOC_NODE_NOT_PERMUTED=-22)
      INTEGER(8), DIMENSION(:,:),POINTER :: SIZE_OF_BLOCK
      INTEGER, DIMENSION(:),POINTER :: TOTAL_NB_OOC_NODES
      INTEGER :: OOC_SOLVE_TYPE_FCT
      INTEGER, DIMENSION(:),ALLOCATABLE :: IO_REQ
      INTEGER(8), DIMENSION(:), ALLOCATABLE:: LRLUS_SOLVE
      INTEGER(8), DIMENSION(:), ALLOCATABLE:: SIZE_SOLVE_Z,
     & LRLU_SOLVE_T, POSFAC_SOLVE, IDEB_SOLVE_Z, LRLU_SOLVE_B
      INTEGER, DIMENSION(:),ALLOCATABLE :: PDEB_SOLVE_Z
      INTEGER (8),SAVE :: FACT_AREA_SIZE,
     &     SIZE_ZONE_SOLVE,SIZE_SOLVE_EMM,TMP_SIZE_FACT,
     &     MAX_SIZE_FACTOR_OOC
      INTEGER(8), SAVE :: MIN_SIZE_READ
      INTEGER, SAVE :: TMP_NB_NODES, MAX_NB_NODES_FOR_ZONE,MAX_NB_REQ,
     &     CURRENT_SOLVE_READ_ZONE,
     &     CUR_POS_SEQUENCE,NB_Z,SOLVE_STEP,
     &     NB_ZONE_REQ,MTYPE_OOC,NB_ACT
     &     ,NB_CALLED,REQ_ACT,NB_CALL
      INTEGER(8), SAVE :: OOC_VADDR_PTR
      INTEGER(8), SAVE :: SIZE_ZONE_REQ
      DOUBLE PRECISION,SAVE :: MAX_OOC_FILE_SIZE
      INTEGER(8), DIMENSION(:), ALLOCATABLE :: SIZE_OF_READ, READ_DEST
      INTEGER,DIMENSION(:),ALLOCATABLE :: FIRST_POS_IN_READ,
     &     READ_MNG,REQ_TO_ZONE,POS_HOLE_T,
     &     POS_HOLE_B,REQ_ID,OOC_STATE_NODE
      INTEGER ZMUMPS_ELEMENTARY_DATA_SIZE,N_OOC
      INTEGER, DIMENSION(:), ALLOCATABLE :: POS_IN_MEM, INODE_TO_POS
      INTEGER, DIMENSION(:), ALLOCATABLE :: CURRENT_POS_T,CURRENT_POS_B
      LOGICAL IS_ROOT_SPECIAL
      INTEGER SPECIAL_ROOT_NODE
      PUBLIC :: ZMUMPS_OOC_INIT_FACTO,ZMUMPS_NEW_FACTOR,
     &     ZMUMPS_READ_OOC,
     &     ZMUMPS_SOLVE_ALLOC_FACTOR_SPACE,
     &     ZMUMPS_IS_THERE_FREE_SPACE,
     &     ZMUMPS_OOC_END_SOLVE,
     &     ZMUMPS_SOLVE_INIT_OOC_FWD,ZMUMPS_SOLVE_INIT_OOC_BWD,
     &     ZMUMPS_INITIATE_READ_OPS,ZMUMPS_OOC_INIT_SOLVE
         INTEGER, PARAMETER, PUBLIC :: TYPEF_BOTH_LU = -99976
         PUBLIC ZMUMPS_OOC_IO_LU_PANEL,
     &        ZMUMPS_OOC_PANEL_SIZE
         PRIVATE ZMUMPS_OOC_STORE_LorU, 
     &        ZMUMPS_OOC_WRT_IN_PANELS_LorU
      CONTAINS
      SUBROUTINE ZMUMPS_SET_STRAT_IO_FLAGS( STRAT_IO_ARG,
     & STRAT_IO_ASYNC_ARG, WITH_BUF_ARG, LOW_LEVEL_STRAT_IO_ARG )
      IMPLICIT NONE
      INTEGER, intent(out) :: LOW_LEVEL_STRAT_IO_ARG
      LOGICAL, intent(out) :: STRAT_IO_ASYNC_ARG, WITH_BUF_ARG
      INTEGER, intent(in)  :: STRAT_IO_ARG
      INTEGER TMP
      CALL MUMPS_OOC_IS_ASYNC_AVAIL(TMP)
      STRAT_IO_ASYNC_ARG=.FALSE.
      WITH_BUF_ARG=.FALSE.
      IF(TMP.EQ.1)THEN
         IF((STRAT_IO_ARG.EQ.1).OR.(STRAT_IO_ARG.EQ.2))THEN
            STRAT_IO_ASYNC=.TRUE.
            WITH_BUF=.FALSE.
         ELSEIF((STRAT_IO_ARG.EQ.4).OR.(STRAT_IO_ARG.EQ.5))THEN
            STRAT_IO_ASYNC_ARG=.TRUE.
            WITH_BUF_ARG=.TRUE.
         ELSEIF(STRAT_IO_ARG.EQ.3)THEN
            STRAT_IO_ASYNC_ARG=.FALSE.
            WITH_BUF_ARG=.TRUE.
         ENDIF
         LOW_LEVEL_STRAT_IO_ARG=mod(STRAT_IO_ARG,3)
      ELSE
         LOW_LEVEL_STRAT_IO_ARG=0
         IF(STRAT_IO_ARG.GE.3)THEN
            WITH_BUF_ARG=.TRUE.
         ENDIF
      ENDIF
      RETURN
      END SUBROUTINE ZMUMPS_SET_STRAT_IO_FLAGS
      FUNCTION ZMUMPS_IS_THERE_FREE_SPACE(INODE,ZONE)
      IMPLICIT NONE
      INTEGER INODE,ZONE
      LOGICAL ZMUMPS_IS_THERE_FREE_SPACE
      ZMUMPS_IS_THERE_FREE_SPACE=(LRLUS_SOLVE(ZONE).GE.
     &     SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE))
      RETURN
      END FUNCTION ZMUMPS_IS_THERE_FREE_SPACE
      SUBROUTINE ZMUMPS_INIT_FACT_AREA_SIZE_S(LA)
      IMPLICIT NONE
      INTEGER(8) :: LA
      FACT_AREA_SIZE=LA
      END SUBROUTINE ZMUMPS_INIT_FACT_AREA_SIZE_S
      SUBROUTINE ZMUMPS_OOC_INIT_FACTO(id, MAXS)
      USE ZMUMPS_STRUC_DEF
      USE ZMUMPS_OOC_BUFFER
      IMPLICIT NONE
      INTEGER TMPDIR_MAX_LENGTH, PREFIX_MAX_LENGTH
      PARAMETER (TMPDIR_MAX_LENGTH=255, PREFIX_MAX_LENGTH=63)
      INTEGER(8), intent(in) :: MAXS  
      TYPE(ZMUMPS_STRUC), TARGET :: id
      INTEGER IERR
      INTEGER allocok
      INTEGER ASYNC
      CHARACTER(len=1):: TMP_DIR(TMPDIR_MAX_LENGTH),
     &            TMP_PREFIX(PREFIX_MAX_LENGTH)
      INTEGER DIM_DIR,DIM_PREFIX
      INTEGER, DIMENSION(:), ALLOCATABLE :: FILE_FLAG_TAB
      INTEGER TMP
      INTEGER K211_LOC
      ICNTL1=id%ICNTL(1)
      MAX_SIZE_FACTOR_OOC=0_8
      N_OOC=id%N
      ASYNC=0
      SOLVE=.FALSE.
      IERR=0
      IF (id%KEEP(400).GT.0) THEN
!$      CALL OMP_INIT_LOCK( LOCK_FOR_L0OMP )
      ENDIF
      IF(allocated(IO_REQ))THEN
         DEALLOCATE(IO_REQ)
      ENDIF
      IF(associated(KEEP_OOC))THEN
         NULLIFY(KEEP_OOC)
      ENDIF
      IF(associated(STEP_OOC))THEN
         NULLIFY(STEP_OOC)
      ENDIF
      IF(associated(PROCNODE_OOC))THEN
         NULLIFY(PROCNODE_OOC)
      ENDIF
      IF(associated(OOC_INODE_SEQUENCE))THEN
         NULLIFY(OOC_INODE_SEQUENCE)
      ENDIF
      IF(associated(TOTAL_NB_OOC_NODES))THEN
         NULLIFY(TOTAL_NB_OOC_NODES)
      ENDIF
      IF(associated(SIZE_OF_BLOCK))THEN
         NULLIFY(SIZE_OF_BLOCK)
      ENDIF
      IF(associated(OOC_VADDR))THEN
         NULLIFY(OOC_VADDR)
      ENDIF
      IF(allocated(I_CUR_HBUF_NEXTPOS))THEN
         DEALLOCATE(I_CUR_HBUF_NEXTPOS)
      ENDIF
      OOC_NB_FILE_TYPE=id%OOC_NB_FILE_TYPE
      IF(IERR.LT.0)THEN
         IF (ICNTL1 > 0)
     &   WRITE(ICNTL1,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC)
         id%INFO(1) = IERR
         id%INFO(2) = 0
         RETURN
      ENDIF
      CALL MUMPS_OOC_INIT_FILETYPE(TYPEF_L, TYPEF_U, TYPEF_CB,
     &     id%KEEP(201), id%KEEP(251), id%KEEP(50), TYPEF_INVALID )
      IF (id%KEEP(201).EQ.2) THEN
        OOC_FCT_TYPE=1
      ENDIF
      STEP_OOC=>id%STEP
      PROCNODE_OOC=>id%PROCNODE_STEPS
      MYID_OOC=id%MYID
      SLAVEF_OOC=id%NSLAVES
      KEEP_OOC => id%KEEP
      SIZE_OF_BLOCK=>id%OOC_SIZE_OF_BLOCK
      OOC_VADDR=>id%OOC_VADDR
      IF(id%KEEP(107).GT.0)THEN
         SIZE_SOLVE_EMM=max(id%KEEP8(19),int(dble(MAXS)*
     &        0.9d0*0.2d0,8))
         SIZE_ZONE_SOLVE=max(SIZE_SOLVE_EMM,
     &        int((dble(MAXS)*0.9d0-
     &        dble(SIZE_SOLVE_EMM))/dble(id%KEEP(107)),8))
         IF(SIZE_ZONE_SOLVE.EQ.SIZE_SOLVE_EMM)THEN
            SIZE_SOLVE_EMM=id%KEEP8(19)
            SIZE_ZONE_SOLVE=int((dble(MAXS)*0.9d0-
     &           dble(SIZE_SOLVE_EMM))/dble(id%KEEP(107)),8)
         ENDIF
      ELSE
         SIZE_ZONE_SOLVE=int(dble(MAXS)*0.9d0,8)
         SIZE_SOLVE_EMM=SIZE_ZONE_SOLVE
      ENDIF
      ZMUMPS_ELEMENTARY_DATA_SIZE = id%KEEP(35)
      SIZE_OF_BLOCK=0_8
      ALLOCATE(id%OOC_NB_FILES(OOC_NB_FILE_TYPE), stat=allocok)
      IF (allocok .GT. 0) THEN
         IF (ICNTL1.GT.0) THEN
            WRITE(ICNTL1,*) 'PB allocation in ZMUMPS_INIT_OOC'
         ENDIF
         id%INFO(1) = -13
         id%INFO(2) = OOC_NB_FILE_TYPE
         RETURN
      ENDIF
      id%OOC_NB_FILES=0
      OOC_VADDR_PTR=0_8
      CALL ZMUMPS_SET_STRAT_IO_FLAGS( id%KEEP(99), STRAT_IO_ASYNC,
     &                                WITH_BUF, LOW_LEVEL_STRAT_IO )
      TMP_SIZE_FACT=0_8
      TMP_NB_NODES=0
      MAX_NB_NODES_FOR_ZONE=0
      OOC_INODE_SEQUENCE=>id%OOC_INODE_SEQUENCE
      ALLOCATE(I_CUR_HBUF_NEXTPOS(OOC_NB_FILE_TYPE),
     &     stat=allocok)
      IF (allocok .GT. 0) THEN
         IF (ICNTL1.GT.0) THEN
            WRITE(ICNTL1,*) 'PB allocation in ZMUMPS_INIT_OOC'
         ENDIF
         id%INFO(1) = -13
         id%INFO(2) = OOC_NB_FILE_TYPE
         RETURN
      ENDIF
      I_CUR_HBUF_NEXTPOS = 1
      IF(WITH_BUF)THEN
         CALL ZMUMPS_INIT_OOC_BUF(id%INFO(1),id%INFO(2),IERR)
         IF(IERR.LT.0)THEN
            RETURN
         ENDIF
      ENDIF
      IF(STRAT_IO_ASYNC)THEN
         ASYNC=1
      ENDIF
      DIM_ERR_STR_OOC = ERR_STR_OOC_MAX_LEN
      CALL MUMPS_LOW_LEVEL_INIT_ERR_STR(DIM_ERR_STR_OOC,ERR_STR_OOC)
      DIM_DIR=len(trim(id%OOC_TMPDIR))
      DIM_PREFIX=len(trim(id%OOC_PREFIX))
      CALL ZMUMPS_CONVERT_STR_TO_CHR_ARRAY(TMP_DIR(1),
     &     id%OOC_TMPDIR, TMPDIR_MAX_LENGTH, DIM_DIR )
      CALL ZMUMPS_CONVERT_STR_TO_CHR_ARRAY(TMP_PREFIX(1),
     &     id%OOC_PREFIX, PREFIX_MAX_LENGTH, DIM_PREFIX)
      CALL MUMPS_LOW_LEVEL_INIT_PREFIX(DIM_PREFIX, TMP_PREFIX)
      CALL MUMPS_LOW_LEVEL_INIT_TMPDIR(DIM_DIR, TMP_DIR)
      ALLOCATE(FILE_FLAG_TAB(OOC_NB_FILE_TYPE),
     &     stat=allocok)
      IF (allocok .GT. 0) THEN
         IF (ICNTL1 .GT. 0) THEN
            WRITE(ICNTL1,*) 'PB allocation in ZMUMPS_INIT_OOC'
         ENDIF
         id%INFO(1) = -13
         id%INFO(2) = OOC_NB_FILE_TYPE
         RETURN
      ENDIF
      FILE_FLAG_TAB(1:OOC_NB_FILE_TYPE)=0
      IERR=0
      TMP=int(id%KEEP8(11)/1000000_8)+1
      IF((id%KEEP(201).EQ.1).AND.(id%KEEP(50).EQ.0)
     &   ) THEN
         TMP=max(1,TMP/2)
      ENDIF
      CALL MUMPS_LOW_LEVEL_INIT_OOC_C(MYID_OOC,TMP,
     &     id%KEEP(35),LOW_LEVEL_STRAT_IO,K211_LOC,OOC_NB_FILE_TYPE,
     &     FILE_FLAG_TAB,IERR)
      IF(IERR.LT.0)THEN
         IF (ICNTL1 .GT. 0 ) THEN
           WRITE(ICNTL1,*)MYID_OOC,': PB in MUMPS_LOW_LEVEL_INIT_OOC_C'
           WRITE(ICNTL1,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC)
         ENDIF
         id%INFO(1) = IERR
         id%INFO(2) = 0
         RETURN
      ENDIF
      CALL MUMPS_GET_MAX_FILE_SIZE_C(MAX_OOC_FILE_SIZE)
      DEALLOCATE(FILE_FLAG_TAB)
      RETURN
      END SUBROUTINE ZMUMPS_OOC_INIT_FACTO
      SUBROUTINE ZMUMPS_NEW_FACTOR(INODE,PTRFAC,KEEP,KEEP8,
     &     A,LA,SIZE,IERR)
      USE ZMUMPS_OOC_BUFFER
      IMPLICIT NONE
      INTEGER INODE,KEEP(500)
      INTEGER(8) :: LA
      INTEGER(8) KEEP8(150)
      INTEGER(8) :: PTRFAC(KEEP(28)), SIZE
      COMPLEX(kind=8) A(LA)
      INTEGER IERR,NODE,ASYNC,REQUEST
      LOGICAL IO_C
      INTEGER ADDR_INT1,ADDR_INT2
      INTEGER TYPE
      INTEGER SIZE_INT1,SIZE_INT2
      TYPE=FCT
      IF(STRAT_IO_ASYNC)THEN
         ASYNC=1
      ELSE
         ASYNC=0
      ENDIF
      IERR=0
      IO_C=.TRUE.
      SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE)=SIZE
      MAX_SIZE_FACTOR_OOC=max(MAX_SIZE_FACTOR_OOC,SIZE)
      OOC_VADDR(STEP_OOC(INODE),OOC_FCT_TYPE)=OOC_VADDR_PTR
      OOC_VADDR_PTR=OOC_VADDR_PTR+SIZE
      TMP_SIZE_FACT=TMP_SIZE_FACT+SIZE
      TMP_NB_NODES=TMP_NB_NODES+1
      IF(TMP_SIZE_FACT.GT.SIZE_ZONE_SOLVE)THEN
         MAX_NB_NODES_FOR_ZONE=max(MAX_NB_NODES_FOR_ZONE,TMP_NB_NODES)
         TMP_SIZE_FACT=0_8
         TMP_NB_NODES=0
      ENDIF
      IF (.NOT. WITH_BUF) THEN
         CALL MUMPS_OOC_CONVERT_BIGINTTO2INT(ADDR_INT1,ADDR_INT2,
     &        OOC_VADDR(STEP_OOC(INODE),OOC_FCT_TYPE))
         CALL MUMPS_OOC_CONVERT_BIGINTTO2INT(SIZE_INT1,SIZE_INT2,
     &        SIZE)
         CALL MUMPS_LOW_LEVEL_WRITE_OOC_C(LOW_LEVEL_STRAT_IO,
     &       A(PTRFAC(STEP_OOC(INODE))),SIZE_INT1,SIZE_INT2,
     &       INODE,REQUEST,TYPE,ADDR_INT1,ADDR_INT2,IERR)
        IF(IERR.LT.0)THEN
           IF (ICNTL1.GT.0)
     &     WRITE(ICNTL1,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC)
           RETURN
        ENDIF
        IF(I_CUR_HBUF_NEXTPOS(OOC_FCT_TYPE).GT.KEEP_OOC(28))THEN
             WRITE(*,*)MYID_OOC,': Internal error (37) in OOC '
             CALL MUMPS_ABORT()
        ENDIF
        OOC_INODE_SEQUENCE(I_CUR_HBUF_NEXTPOS(OOC_FCT_TYPE),
     &       OOC_FCT_TYPE)=INODE
        I_CUR_HBUF_NEXTPOS(OOC_FCT_TYPE)=
     &       I_CUR_HBUF_NEXTPOS(OOC_FCT_TYPE)+1
      ELSE
         IF(SIZE.LE.HBUF_SIZE)THEN
            CALL ZMUMPS_OOC_COPY_DATA_TO_BUFFER
     &           (A(PTRFAC(STEP_OOC(INODE))),SIZE,IERR)
            OOC_INODE_SEQUENCE(I_CUR_HBUF_NEXTPOS(OOC_FCT_TYPE),
     &           OOC_FCT_TYPE) = INODE
            I_CUR_HBUF_NEXTPOS(OOC_FCT_TYPE) =
     &           I_CUR_HBUF_NEXTPOS(OOC_FCT_TYPE) + 1
            PTRFAC(STEP_OOC(INODE))=-777777_8
            RETURN
         ELSE
            CALL ZMUMPS_OOC_DO_IO_AND_CHBUF(OOC_FCT_TYPE,IERR)
            IF(IERR.LT.0)THEN
               RETURN
            ENDIF
            CALL ZMUMPS_OOC_DO_IO_AND_CHBUF(OOC_FCT_TYPE,IERR)
            IF(IERR.LT.0)THEN
               RETURN
            ENDIF
            CALL MUMPS_OOC_CONVERT_BIGINTTO2INT(ADDR_INT1,ADDR_INT2,
     &           OOC_VADDR(STEP_OOC(INODE),OOC_FCT_TYPE))
            CALL MUMPS_OOC_CONVERT_BIGINTTO2INT(SIZE_INT1,SIZE_INT2,
     &           SIZE)
            CALL MUMPS_LOW_LEVEL_WRITE_OOC_C(LOW_LEVEL_STRAT_IO,
     &           A(PTRFAC(STEP_OOC(INODE))),SIZE_INT1,SIZE_INT2,
     &           INODE,REQUEST,TYPE,ADDR_INT1,ADDR_INT2,IERR)
            IF(IERR.LT.0)THEN
               IF (ICNTL1.GT.0)
     &         WRITE(*,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC)
               RETURN
            ENDIF
            IF(I_CUR_HBUF_NEXTPOS(OOC_FCT_TYPE).GT.KEEP_OOC(28))THEN
             WRITE(*,*)MYID_OOC,': Internal error (38) in OOC '
             CALL MUMPS_ABORT()
            ENDIF
            OOC_INODE_SEQUENCE(I_CUR_HBUF_NEXTPOS(OOC_FCT_TYPE),
     &           OOC_FCT_TYPE)=INODE
            I_CUR_HBUF_NEXTPOS(OOC_FCT_TYPE)=
     &           I_CUR_HBUF_NEXTPOS(OOC_FCT_TYPE)+1
            CALL ZMUMPS_OOC_NEXT_HBUF(OOC_FCT_TYPE)
         ENDIF
      END IF
      NODE=-9999
      PTRFAC(STEP_OOC(INODE))=-777777_8
      IF(STRAT_IO_ASYNC)THEN
         IERR=0
         CALL MUMPS_WAIT_REQUEST(REQUEST,IERR)
         IF(IERR.LT.0)THEN
            IF (ICNTL1 .GT. 0)
     &      WRITE(ICNTL1,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC)
            RETURN
         ENDIF
      ENDIF
      RETURN
      END SUBROUTINE ZMUMPS_NEW_FACTOR
      SUBROUTINE ZMUMPS_READ_OOC(DEST,INODE,IERR
     &  )
      IMPLICIT NONE
      INCLUDE 'mpif.h'
      INTEGER IERR,INODE
      COMPLEX(kind=8) DEST
      INTEGER ASYNC
      LOGICAL IO_C
      INTEGER ADDR_INT1,ADDR_INT2
      INTEGER TYPE
      INTEGER SIZE_INT1,SIZE_INT2
      TYPE=OOC_SOLVE_TYPE_FCT
      IF(SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE)
     &     .EQ.0_8)THEN
         GOTO 555      
      ENDIF
      IF(STRAT_IO_ASYNC)THEN
        ASYNC=1
      ELSE
        ASYNC=0
      ENDIF
      IERR=0
      IO_C=.TRUE.
      OOC_STATE_NODE(STEP_OOC(INODE))=NOT_USED
      CALL MUMPS_OOC_CONVERT_BIGINTTO2INT(ADDR_INT1,ADDR_INT2,
     &     OOC_VADDR(STEP_OOC(INODE),OOC_FCT_TYPE))
      CALL MUMPS_OOC_CONVERT_BIGINTTO2INT(SIZE_INT1,SIZE_INT2,
     &     SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE))
      CALL MUMPS_LOW_LEVEL_DIRECT_READ(DEST,
     &     SIZE_INT1,SIZE_INT2,
     &     TYPE,ADDR_INT1,ADDR_INT2,IERR)
      IF(IERR.LT.0)THEN
         IF (ICNTL1.GT.0) THEN
           WRITE(ICNTL1,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC)
           WRITE(ICNTL1,*)MYID_OOC,
     &     ': Problem in MUMPS_LOW_LEVEL_DIRECT_READ'
         ENDIF
         RETURN
      ENDIF
 555  CONTINUE
      IF(.NOT.ZMUMPS_SOLVE_IS_END_REACHED())THEN
         IF(OOC_INODE_SEQUENCE(CUR_POS_SEQUENCE,OOC_FCT_TYPE).EQ.
     &        INODE)THEN
            IF(SOLVE_STEP.EQ.0)THEN
               CUR_POS_SEQUENCE=CUR_POS_SEQUENCE+1
            ELSEIF(SOLVE_STEP.EQ.1)THEN
               CUR_POS_SEQUENCE=CUR_POS_SEQUENCE-1
            ENDIF
            CALL ZMUMPS_OOC_SKIP_NULL_SIZE_NODE()
         ENDIF
      ENDIF
      RETURN
      END SUBROUTINE ZMUMPS_READ_OOC
      SUBROUTINE ZMUMPS_OOC_CLEAN_PENDING(IERR)
      USE ZMUMPS_OOC_BUFFER
      IMPLICIT NONE
      INTEGER, intent(out):: IERR
      IERR=0
      IF (WITH_BUF) THEN
        CALL ZMUMPS_OOC_BUF_CLEAN_PENDING(IERR)
        IF(IERR.LT.0)THEN
           RETURN
        ENDIF
      END IF
      RETURN
      END SUBROUTINE ZMUMPS_OOC_CLEAN_PENDING
      SUBROUTINE ZMUMPS_OOC_END_FACTO(id,IERR)
      USE ZMUMPS_OOC_BUFFER
      USE ZMUMPS_STRUC_DEF
      IMPLICIT NONE
      TYPE(ZMUMPS_STRUC), TARGET :: id
      INTEGER, intent(out) :: IERR
      INTEGER I,SOLVE_OR_FACTO
      IERR=0
      IF (id%KEEP(400).GT.0) THEN
!$      CALL OMP_DESTROY_LOCK( LOCK_FOR_L0OMP )
      ENDIF
      IF(WITH_BUF)THEN
         CALL ZMUMPS_END_OOC_BUF()
      ENDIF
      IF(associated(KEEP_OOC))THEN
         NULLIFY(KEEP_OOC)
      ENDIF
      IF(associated(STEP_OOC))THEN
         NULLIFY(STEP_OOC)
      ENDIF
      IF(associated(PROCNODE_OOC))THEN
         NULLIFY(PROCNODE_OOC)
      ENDIF
      IF(associated(OOC_INODE_SEQUENCE))THEN
         NULLIFY(OOC_INODE_SEQUENCE)
      ENDIF
      IF(associated(TOTAL_NB_OOC_NODES))THEN
         NULLIFY(TOTAL_NB_OOC_NODES)
      ENDIF
      IF(associated(SIZE_OF_BLOCK))THEN
         NULLIFY(SIZE_OF_BLOCK)
      ENDIF
      IF(associated(OOC_VADDR))THEN
         NULLIFY(OOC_VADDR)
      ENDIF
      CALL MUMPS_OOC_END_WRITE_C(IERR)
      IF(IERR.LT.0)THEN
         IF (ICNTL1 .GT. 0)
     &   WRITE(ICNTL1,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC)
         GOTO 500
      ENDIF
      id%OOC_MAX_NB_NODES_FOR_ZONE=max(MAX_NB_NODES_FOR_ZONE,
     &     TMP_NB_NODES)
      IF(allocated(I_CUR_HBUF_NEXTPOS))THEN
         DO I=1,OOC_NB_FILE_TYPE
            id%OOC_TOTAL_NB_NODES(I)=I_CUR_HBUF_NEXTPOS(I)-1
         ENDDO
         DEALLOCATE(I_CUR_HBUF_NEXTPOS)
      ENDIF
      id%KEEP8(20)=MAX_SIZE_FACTOR_OOC
      CALL ZMUMPS_STRUC_STORE_FILE_NAME(id,IERR)
      IF(IERR.LT.0)THEN
         GOTO 500
      ENDIF
 500  CONTINUE
      SOLVE_OR_FACTO=0
      CALL MUMPS_CLEAN_IO_DATA_C(MYID_OOC,SOLVE_OR_FACTO,IERR)
      IF(IERR.LT.0)THEN
         IF (ICNTL1.GT.0)
     &   WRITE(ICNTL1,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC)
         RETURN
      ENDIF
      RETURN
      END SUBROUTINE ZMUMPS_OOC_END_FACTO
      SUBROUTINE ZMUMPS_OOC_CLEAN_FILES(id,IERR)
      USE ZMUMPS_STRUC_DEF
      IMPLICIT NONE
      EXTERNAL MUMPS_OOC_REMOVE_FILE_C
      TYPE(ZMUMPS_STRUC), TARGET :: id
      INTEGER IERR
      INTEGER I,J,I1,K
      CHARACTER(len=1):: TMP_NAME(350)
      IERR=0
      K=1
      IF(.NOT. id%ASSOCIATED_OOC_FILES) THEN
        IF(associated(id%OOC_FILE_NAMES).AND.
     &       associated(id%OOC_FILE_NAME_LENGTH))THEN
           DO I1=1,id%OOC_NB_FILE_TYPE
              DO I=1,id%OOC_NB_FILES(I1)
                 DO J=1,id%OOC_FILE_NAME_LENGTH(K)
                    TMP_NAME(J)=id%OOC_FILE_NAMES(K,J)
                 ENDDO
                 CALL MUMPS_OOC_REMOVE_FILE_C(IERR, TMP_NAME(1))
                 IF(IERR.LT.0)THEN
                    IF (ICNTL1.GT.0)THEN
                       WRITE(ICNTL1,*)MYID_OOC,': ',
     &                      ERR_STR_OOC(1:DIM_ERR_STR_OOC)
                       RETURN
                    ENDIF
                 ENDIF
                 K=K+1
              ENDDO
           ENDDO
        ENDIF
      ENDIF
      IF(associated(id%OOC_FILE_NAMES))THEN
         DEALLOCATE(id%OOC_FILE_NAMES)
         NULLIFY(id%OOC_FILE_NAMES)
      ENDIF
      IF(associated(id%OOC_FILE_NAME_LENGTH))THEN
         DEALLOCATE(id%OOC_FILE_NAME_LENGTH)
         NULLIFY(id%OOC_FILE_NAME_LENGTH)
      ENDIF      
      IF(associated(id%OOC_NB_FILES))THEN
         DEALLOCATE(id%OOC_NB_FILES)
         NULLIFY(id%OOC_NB_FILES)
      ENDIF
      RETURN
      END SUBROUTINE ZMUMPS_OOC_CLEAN_FILES
      SUBROUTINE ZMUMPS_CLEAN_OOC_DATA(id,IERR)
      USE ZMUMPS_STRUC_DEF
      IMPLICIT NONE
      TYPE(ZMUMPS_STRUC), TARGET :: id
      INTEGER IERR
      IERR=0
      CALL ZMUMPS_OOC_CLEAN_FILES(id,IERR)
      IF(associated(id%OOC_TOTAL_NB_NODES))THEN
         DEALLOCATE(id%OOC_TOTAL_NB_NODES)
         NULLIFY(id%OOC_TOTAL_NB_NODES)
      ENDIF
      IF(associated(id%OOC_INODE_SEQUENCE))THEN
         DEALLOCATE(id%OOC_INODE_SEQUENCE)
         NULLIFY(id%OOC_INODE_SEQUENCE)
      ENDIF
      IF(associated(id%OOC_SIZE_OF_BLOCK))THEN
         DEALLOCATE(id%OOC_SIZE_OF_BLOCK)
         NULLIFY(id%OOC_SIZE_OF_BLOCK)
      ENDIF
      IF(associated(id%OOC_VADDR))THEN
         DEALLOCATE(id%OOC_VADDR)
         NULLIFY(id%OOC_VADDR)
      ENDIF
      RETURN
      END SUBROUTINE ZMUMPS_CLEAN_OOC_DATA
      SUBROUTINE ZMUMPS_OOC_INIT_SOLVE(id)
      USE ZMUMPS_STRUC_DEF
      IMPLICIT NONE
      INCLUDE 'mpif.h'
      TYPE(ZMUMPS_STRUC), TARGET :: id
      INTEGER TMP,I,J
      INTEGER(8) :: TMP_SIZE8
      INTEGER allocok,IERR
      EXTERNAL MUMPS_PROCNODE
      INTEGER MUMPS_PROCNODE
      INTEGER MASTER_ROOT
      IERR=0
      ICNTL1=id%ICNTL(1)
      SOLVE=.TRUE.
      N_OOC=id%N
      IF(allocated(LRLUS_SOLVE))THEN
         DEALLOCATE(LRLUS_SOLVE)
      ENDIF
      IF(allocated(LRLU_SOLVE_T))THEN
         DEALLOCATE(LRLU_SOLVE_T)
      ENDIF
      IF(allocated(LRLU_SOLVE_B))THEN
         DEALLOCATE(LRLU_SOLVE_B)
      ENDIF
      IF(allocated(POSFAC_SOLVE))THEN
         DEALLOCATE(POSFAC_SOLVE)
      ENDIF
      IF(allocated(IDEB_SOLVE_Z))THEN
         DEALLOCATE(IDEB_SOLVE_Z)
      ENDIF
      IF(allocated(PDEB_SOLVE_Z))THEN
         DEALLOCATE(PDEB_SOLVE_Z)
      ENDIF
      IF(allocated(SIZE_SOLVE_Z))THEN
         DEALLOCATE(SIZE_SOLVE_Z)
      ENDIF
      IF(allocated(CURRENT_POS_T))THEN
         DEALLOCATE(CURRENT_POS_T)
      ENDIF
      IF(allocated(CURRENT_POS_B))THEN
         DEALLOCATE(CURRENT_POS_B)
      ENDIF
      IF(allocated(POS_HOLE_T))THEN
         DEALLOCATE(POS_HOLE_T)
      ENDIF
      IF(allocated(POS_HOLE_B))THEN
         DEALLOCATE(POS_HOLE_B)
      ENDIF
      IF(allocated(OOC_STATE_NODE))THEN
         DEALLOCATE(OOC_STATE_NODE)
      ENDIF
      IF(allocated(POS_IN_MEM))THEN
         DEALLOCATE(POS_IN_MEM)
      ENDIF
      IF(allocated(INODE_TO_POS))THEN
         DEALLOCATE(INODE_TO_POS)
      ENDIF
      IF(allocated(SIZE_OF_READ))THEN
         DEALLOCATE(SIZE_OF_READ)
      ENDIF
      IF(allocated(FIRST_POS_IN_READ))THEN
         DEALLOCATE(FIRST_POS_IN_READ)
      ENDIF
      IF(allocated(READ_DEST))THEN
         DEALLOCATE(READ_DEST)
      ENDIF
      IF(allocated(READ_MNG))THEN
         DEALLOCATE(READ_MNG)
      ENDIF
      IF(allocated(REQ_TO_ZONE))THEN
         DEALLOCATE(REQ_TO_ZONE)
      ENDIF
      IF(allocated(REQ_ID))THEN
         DEALLOCATE(REQ_ID)
      ENDIF
      IF(allocated(IO_REQ))THEN
         DEALLOCATE(IO_REQ)
      ENDIF
      IF(associated(KEEP_OOC))THEN
         NULLIFY(KEEP_OOC)
      ENDIF
      IF(associated(STEP_OOC))THEN
         NULLIFY(STEP_OOC)
      ENDIF
      IF(associated(PROCNODE_OOC))THEN
         NULLIFY(PROCNODE_OOC)
      ENDIF
      IF(associated(TOTAL_NB_OOC_NODES))THEN
         NULLIFY(TOTAL_NB_OOC_NODES)
      ENDIF
      IF(associated(SIZE_OF_BLOCK))THEN
         NULLIFY(SIZE_OF_BLOCK)
      ENDIF
      IF(associated(OOC_INODE_SEQUENCE))THEN
         NULLIFY(OOC_INODE_SEQUENCE)
      ENDIF
      OOC_NB_FILE_TYPE=id%OOC_NB_FILE_TYPE
      CALL MUMPS_OOC_INIT_FILETYPE(TYPEF_L, TYPEF_U, TYPEF_CB,
     &     id%KEEP(201), id%KEEP(251), id%KEEP(50), TYPEF_INVALID )
      DIM_ERR_STR_OOC = ERR_STR_OOC_MAX_LEN
      CALL MUMPS_LOW_LEVEL_INIT_ERR_STR(DIM_ERR_STR_OOC,ERR_STR_OOC)
      CALL ZMUMPS_OOC_OPEN_FILES_FOR_SOLVE(id)
      IF(id%INFO(1).LT.0)THEN
         RETURN
      ENDIF
      STEP_OOC=>id%STEP
      PROCNODE_OOC=>id%PROCNODE_STEPS
      SLAVEF_OOC=id%NSLAVES
      MYID_OOC=id%MYID
      KEEP_OOC => id%KEEP
      SIZE_OF_BLOCK=>id%OOC_SIZE_OF_BLOCK
      OOC_INODE_SEQUENCE=>id%OOC_INODE_SEQUENCE
      OOC_VADDR=>id%OOC_VADDR
      ALLOCATE(IO_REQ(id%KEEP(28)),
     &     stat=allocok)
      IF (allocok .GT. 0) THEN
         IF (ICNTL1.GT.0) THEN
            WRITE(ICNTL1,*) 'PB allocation in ZMUMPS_OOC_INIT_SOLVE'
         ENDIF
         id%INFO(1) = -13
         id%INFO(2) = id%KEEP(28)
         RETURN
      ENDIF
      ZMUMPS_ELEMENTARY_DATA_SIZE = id%KEEP(35)
      MAX_NB_NODES_FOR_ZONE=id%OOC_MAX_NB_NODES_FOR_ZONE
      TOTAL_NB_OOC_NODES=>id%OOC_TOTAL_NB_NODES
      CALL ZMUMPS_SET_STRAT_IO_FLAGS( id%KEEP(204), STRAT_IO_ASYNC,
     & WITH_BUF, LOW_LEVEL_STRAT_IO)
      IF(id%KEEP(107).GT.0)THEN
         SIZE_SOLVE_EMM=max(id%KEEP8(20),
     &        FACT_AREA_SIZE / 5_8)
         SIZE_ZONE_SOLVE=max(SIZE_SOLVE_EMM,
     &        int((dble(FACT_AREA_SIZE)-
     &        dble(SIZE_SOLVE_EMM))/dble(id%KEEP(107)),8))
         SIZE_ZONE_SOLVE=max(SIZE_ZONE_SOLVE,0_8)
         IF(SIZE_ZONE_SOLVE.EQ.SIZE_SOLVE_EMM)THEN
            SIZE_SOLVE_EMM=id%KEEP8(20)
            SIZE_ZONE_SOLVE=int((dble(FACT_AREA_SIZE)-
     &           dble(SIZE_SOLVE_EMM))/dble(id%KEEP(107)),8)
            SIZE_ZONE_SOLVE=max(SIZE_ZONE_SOLVE,0_8)
         ENDIF
      ELSE
         SIZE_ZONE_SOLVE=FACT_AREA_SIZE
         SIZE_SOLVE_EMM=SIZE_ZONE_SOLVE
      ENDIF
      IF(SIZE_SOLVE_EMM.LT.id%KEEP8(20))THEN
         IF (ICNTL1.GT.0)
     &   WRITE(ICNTL1,*)MYID_OOC,': More space needed for
     & solution step in ZMUMPS_OOC_INIT_SOLVE'
         id%INFO(1) = -11
         CALL MUMPS_SET_IERROR(id%KEEP8(20), id%INFO(2))
      ENDIF
      TMP=MAX_NB_NODES_FOR_ZONE
      CALL MPI_ALLREDUCE(TMP,MAX_NB_NODES_FOR_ZONE,1,
     &     MPI_INTEGER,MPI_MAX,id%COMM_NODES, IERR)
      NB_Z=KEEP_OOC(107)+1
      ALLOCATE(POS_IN_MEM(MAX_NB_NODES_FOR_ZONE*NB_Z),
     &     INODE_TO_POS(KEEP_OOC(28)),
     &     stat=allocok)
      IF (allocok .GT. 0) THEN
         IF (ICNTL1.GT.0) THEN
            WRITE(ICNTL1,*) 'PB allocation in ZMUMPS_OOC_INIT_SOLVE'
         ENDIF
         id%INFO(1) = -13
         id%INFO(2) = id%KEEP(28)+(MAX_NB_NODES_FOR_ZONE*NB_Z)
         RETURN
      ENDIF
      ALLOCATE(OOC_STATE_NODE(KEEP_OOC(28)),stat=allocok)
      IF (allocok .GT. 0) THEN
         IF (ICNTL1.GT.0) THEN
            WRITE(ICNTL1,*) 'PB allocation in ZMUMPS_OOC_INIT_SOLVE'
         ENDIF
         id%INFO(1) = -13
         id%INFO(2) = id%KEEP(28)
         RETURN
      ENDIF
      OOC_STATE_NODE(1:KEEP_OOC(28))=0
      INODE_TO_POS=0
      POS_IN_MEM=0
      ALLOCATE(LRLUS_SOLVE(NB_Z), LRLU_SOLVE_T(NB_Z),LRLU_SOLVE_B(NB_Z),
     &     POSFAC_SOLVE(NB_Z),IDEB_SOLVE_Z(NB_Z),
     &     PDEB_SOLVE_Z(NB_Z),SIZE_SOLVE_Z(NB_Z),
     &     CURRENT_POS_T(NB_Z),CURRENT_POS_B(NB_Z),
     &     POS_HOLE_T(NB_Z),POS_HOLE_B(NB_Z),
     &     stat=allocok)
      IF (allocok .GT. 0) THEN
         IF (ICNTL1.GT.0) THEN
            WRITE(ICNTL1,*) 'PB allocation in ZMUMPS_OOC_INIT_SOLVE'
         ENDIF
         id%INFO(1) = -13
         id%INFO(2) = 9*(NB_Z+1)
         RETURN
      ENDIF
      IERR=0
      CALL MUMPS_GET_MAX_NB_REQ_C(MAX_NB_REQ,IERR)
      ALLOCATE(SIZE_OF_READ(MAX_NB_REQ),FIRST_POS_IN_READ(MAX_NB_REQ),
     &     READ_DEST(MAX_NB_REQ),READ_MNG(MAX_NB_REQ),
     &     REQ_TO_ZONE(MAX_NB_REQ),REQ_ID(MAX_NB_REQ),stat=allocok)
      SIZE_OF_READ=-9999_8
      FIRST_POS_IN_READ=-9999
      READ_DEST=-9999_8
      READ_MNG=-9999
      REQ_TO_ZONE=-9999
      REQ_ID=-9999
      IF (allocok .GT. 0) THEN
         IF (ICNTL1.GT.0) THEN
            WRITE(ICNTL1,*) 'PB allocation in ZMUMPS_OOC_INIT_SOLVE'
         ENDIF
         id%INFO(1) = -13
         id%INFO(2) = 6*(NB_Z+1)
         RETURN
      ENDIF
      MIN_SIZE_READ=min(max((1024_8*1024_8)/int(id%KEEP(35),8),
     &                       SIZE_ZONE_SOLVE/3_8),
     &                  SIZE_ZONE_SOLVE)
      TMP_SIZE8=1_8
      J=1
      DO I=1,NB_Z-1
         IDEB_SOLVE_Z(I)=TMP_SIZE8
         POSFAC_SOLVE(I)=TMP_SIZE8
         LRLUS_SOLVE(I)=SIZE_ZONE_SOLVE
         LRLU_SOLVE_T(I)=SIZE_ZONE_SOLVE
         LRLU_SOLVE_B(I)=0_8
         SIZE_SOLVE_Z(I)=SIZE_ZONE_SOLVE
         CURRENT_POS_T(I)=J
         CURRENT_POS_B(I)=J
         PDEB_SOLVE_Z(I)=J
         POS_HOLE_T(I)=J
         POS_HOLE_B(I)=J
         J=J+MAX_NB_NODES_FOR_ZONE
         TMP_SIZE8=TMP_SIZE8+SIZE_ZONE_SOLVE
      ENDDO
      IDEB_SOLVE_Z(NB_Z)=TMP_SIZE8
      PDEB_SOLVE_Z(NB_Z)=J
      POSFAC_SOLVE(NB_Z)=TMP_SIZE8
      LRLUS_SOLVE(NB_Z)=SIZE_SOLVE_EMM
      LRLU_SOLVE_T(NB_Z)=SIZE_SOLVE_EMM
      LRLU_SOLVE_B(NB_Z)=0_8
      SIZE_SOLVE_Z(NB_Z)=SIZE_SOLVE_EMM
      CURRENT_POS_T(NB_Z)=J
      CURRENT_POS_B(NB_Z)=J
      POS_HOLE_T(NB_Z)=J
      POS_HOLE_B(NB_Z)=J
      IO_REQ=-77777
      REQ_ACT=0
      OOC_STATE_NODE(1:KEEP_OOC(28))=NOT_IN_MEM
      IF(KEEP_OOC(38).NE.0)THEN
         MASTER_ROOT=MUMPS_PROCNODE(
     &                  PROCNODE_OOC(STEP_OOC( KEEP_OOC(38))),
     &                  KEEP_OOC(199) )
         SPECIAL_ROOT_NODE=KEEP_OOC(38)
      ELSEIF(KEEP_OOC(20).NE.0)THEN
         MASTER_ROOT=MUMPS_PROCNODE(
     &                  PROCNODE_OOC(STEP_OOC( KEEP_OOC(20))),
     &                  KEEP_OOC(199) )
         SPECIAL_ROOT_NODE=KEEP_OOC(20)
      ELSE
         MASTER_ROOT=-111111
         SPECIAL_ROOT_NODE=-2222222
      ENDIF
      IF ( KEEP_OOC(60).EQ.0 .AND.
     &     ( 
     &     (KEEP_OOC(38).NE.0 .AND.  id%root%yes) 
     &     .OR.
     &     (KEEP_OOC(20).NE.0 .AND. MYID_OOC.EQ.MASTER_ROOT)) 
     &     ) 
     &     THEN
        IS_ROOT_SPECIAL = .TRUE.
      ELSE
        IS_ROOT_SPECIAL = .FALSE.
      ENDIF
      NB_ZONE_REQ=0
      SIZE_ZONE_REQ=0_8
      CURRENT_SOLVE_READ_ZONE=0
      NB_CALLED=0
      NB_CALL=0
      SOLVE_STEP=-9999
      RETURN
      END SUBROUTINE ZMUMPS_OOC_INIT_SOLVE
      SUBROUTINE ZMUMPS_INITIATE_READ_OPS(A,LA,PTRFAC,NSTEPS,IERR)
      IMPLICIT NONE
      INTEGER NSTEPS,IERR
      INTEGER(8) :: LA
      COMPLEX(kind=8) A(LA)
      INTEGER(8) :: PTRFAC(NSTEPS)
      INTEGER I
      IERR=0
      IF(NB_Z.GT.1)THEN
         IF(STRAT_IO_ASYNC)THEN
            DO I=1,NB_Z-1
               CALL ZMUMPS_SUBMIT_READ_FOR_Z(A,LA,PTRFAC,NSTEPS,IERR)
               IF(IERR.LT.0)THEN
                  RETURN
               ENDIF
            ENDDO
         ELSE
            CALL ZMUMPS_SUBMIT_READ_FOR_Z(A,LA,PTRFAC,NSTEPS,IERR)
            IF(IERR.LT.0)THEN
               RETURN
            ENDIF
         ENDIF
      ENDIF
      RETURN
      END SUBROUTINE ZMUMPS_INITIATE_READ_OPS
      SUBROUTINE ZMUMPS_SUBMIT_READ_FOR_Z(A,LA,PTRFAC,NSTEPS,IERR)
      IMPLICIT NONE
      INTEGER NSTEPS,IERR
      INTEGER(8) :: LA
      COMPLEX(kind=8) A(LA)
      INTEGER(8) :: PTRFAC(NSTEPS)
      INTEGER ZONE
      CALL ZMUMPS_SOLVE_SELECT_ZONE(ZONE)
      IERR=0
      CALL ZMUMPS_SOLVE_ZONE_READ(ZONE,A,LA,PTRFAC,NSTEPS,IERR)
      RETURN
      END SUBROUTINE ZMUMPS_SUBMIT_READ_FOR_Z 
      SUBROUTINE ZMUMPS_READ_SOLVE_BLOCK(DEST,INDICE,SIZE,
     &     ZONE,PTRFAC,NSTEPS,POS_SEQ,NB_NODES,FLAG,IERR)
      IMPLICIT NONE
      INCLUDE 'mpif.h'
      INTEGER ZONE,NSTEPS,FLAG,POS_SEQ,NB_NODES
      COMPLEX(kind=8) DEST
      INTEGER (8) :: INDICE, SIZE, PTRFAC(NSTEPS)
      INTEGER REQUEST,INODE,IERR
      INTEGER ADDR_INT1,ADDR_INT2
      INTEGER TYPE
      INTEGER SIZE_INT1,SIZE_INT2
      TYPE=OOC_SOLVE_TYPE_FCT
      IERR=0
      INODE=OOC_INODE_SEQUENCE(POS_SEQ,OOC_FCT_TYPE)
      CALL MUMPS_OOC_CONVERT_BIGINTTO2INT(ADDR_INT1,ADDR_INT2,
     &     OOC_VADDR(STEP_OOC(INODE),OOC_FCT_TYPE))
      CALL MUMPS_OOC_CONVERT_BIGINTTO2INT(SIZE_INT1,SIZE_INT2,
     &     SIZE)
      CALL MUMPS_LOW_LEVEL_READ_OOC_C(LOW_LEVEL_STRAT_IO,
     &     DEST,SIZE_INT1,SIZE_INT2,
     &     INODE,REQUEST,TYPE,ADDR_INT1,ADDR_INT2,IERR)
      IF(IERR.LT.0)THEN
         IF (ICNTL1.GT.0)
     &   WRITE(ICNTL1,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC)
         RETURN
      ENDIF
      IF(STRAT_IO_ASYNC)THEN
         CALL ZMUMPS_UPDATE_READ_REQ_NODE(INODE,SIZE,INDICE,ZONE,
     &        REQUEST,POS_SEQ,NB_NODES,FLAG,PTRFAC,NSTEPS,IERR)
         IF(IERR.LT.0)THEN
            RETURN
         ENDIF
      ELSE
         CALL ZMUMPS_UPDATE_READ_REQ_NODE(INODE,SIZE,INDICE,ZONE,
     &        REQUEST,POS_SEQ,NB_NODES,FLAG,PTRFAC,NSTEPS,IERR)
         IF(IERR.LT.0)THEN
            RETURN
         ENDIF
         CALL ZMUMPS_SOLVE_UPDATE_POINTERS(IO_REQ(STEP_OOC(INODE)),
     &        PTRFAC,NSTEPS)
         REQ_ACT=REQ_ACT-1
      ENDIF
      END SUBROUTINE ZMUMPS_READ_SOLVE_BLOCK
      SUBROUTINE ZMUMPS_SOLVE_UPDATE_POINTERS(REQUEST,PTRFAC,
     &     NSTEPS)
      IMPLICIT NONE
      INTEGER NSTEPS,REQUEST
      INTEGER (8) :: PTRFAC(NSTEPS)
      INTEGER (8) :: LAST, POS_IN_S, J
      INTEGER ZONE
      INTEGER POS_REQ,I,TMP_NODE,POS_IN_MANAGE
      INTEGER (8) SIZE
      LOGICAL DONT_USE
      EXTERNAL MUMPS_TYPENODE,MUMPS_PROCNODE
      INTEGER MUMPS_TYPENODE,MUMPS_PROCNODE
      POS_REQ=mod(REQUEST,MAX_NB_REQ)+1
      SIZE=SIZE_OF_READ(POS_REQ)
      I=FIRST_POS_IN_READ(POS_REQ)
      POS_IN_S=READ_DEST(POS_REQ)
      POS_IN_MANAGE=READ_MNG(POS_REQ)
      ZONE=REQ_TO_ZONE(POS_REQ)
      DONT_USE=.FALSE.
      J=0_8
      DO WHILE((J.LT.SIZE).AND.(I.LE.TOTAL_NB_OOC_NODES(OOC_FCT_TYPE)))
         TMP_NODE=OOC_INODE_SEQUENCE(I,OOC_FCT_TYPE)
         LAST=SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE)
         IF(LAST.EQ.0_8)THEN
            I=I+1
            CYCLE
         ENDIF
         IF((INODE_TO_POS(STEP_OOC(TMP_NODE)).NE.0).AND.
     &        (INODE_TO_POS(STEP_OOC(TMP_NODE)).LT.
     &        -((N_OOC+1)*NB_Z)))THEN
            DONT_USE=
     &           (((MTYPE_OOC.EQ.1).AND.(KEEP_OOC(50).EQ.0).AND.
     &           (SOLVE_STEP.EQ.1).AND.
     &           ((MUMPS_TYPENODE(PROCNODE_OOC(STEP_OOC(TMP_NODE)),
     &           KEEP_OOC(199)).EQ.2).AND.(MUMPS_PROCNODE(
     &           PROCNODE_OOC(STEP_OOC(TMP_NODE)),KEEP_OOC(199)).NE.
     &           MYID_OOC)))
     &           .OR.
     &           ((MTYPE_OOC.NE.1).AND.(KEEP_OOC(50).EQ.0).AND.
     &           (SOLVE_STEP.EQ.0).AND.
     &           ((MUMPS_TYPENODE(PROCNODE_OOC(STEP_OOC(TMP_NODE)),
     &           KEEP_OOC(199)).EQ.2).AND.(MUMPS_PROCNODE(
     &           PROCNODE_OOC(STEP_OOC(TMP_NODE)),KEEP_OOC(199)).NE.
     &           MYID_OOC)))).OR.
     &           (OOC_STATE_NODE(STEP_OOC(TMP_NODE)).EQ.ALREADY_USED)
            IF(DONT_USE)THEN
               PTRFAC(STEP_OOC(TMP_NODE))=-POS_IN_S
            ELSE
               PTRFAC(STEP_OOC(TMP_NODE))=POS_IN_S
            ENDIF
            IF(abs(PTRFAC(STEP_OOC(TMP_NODE))).LT.
     &           IDEB_SOLVE_Z(ZONE))THEN
               WRITE(*,*)MYID_OOC,': Inernal error (42) in OOC ', 
     &              PTRFAC(STEP_OOC(TMP_NODE)),IDEB_SOLVE_Z(ZONE)
               CALL MUMPS_ABORT()
            ENDIF
            IF(abs(PTRFAC(STEP_OOC(TMP_NODE))).GT.
     &           (IDEB_SOLVE_Z(ZONE)+SIZE_SOLVE_Z(ZONE)-1_8))THEN
               WRITE(*,*)MYID_OOC,': Inernal error (43) in OOC '
               CALL MUMPS_ABORT()
            ENDIF
            IF(DONT_USE)THEN
               POS_IN_MEM(POS_IN_MANAGE)=-TMP_NODE
               INODE_TO_POS(STEP_OOC(TMP_NODE))=-POS_IN_MANAGE
               IF(OOC_STATE_NODE(STEP_OOC(TMP_NODE)).NE.
     &              ALREADY_USED)THEN
                  OOC_STATE_NODE(STEP_OOC(TMP_NODE))=USED_NOT_PERMUTED
               ENDIF
               LRLUS_SOLVE(ZONE)=LRLUS_SOLVE(ZONE)+LAST
            ELSE
               POS_IN_MEM(POS_IN_MANAGE)=TMP_NODE
               INODE_TO_POS(STEP_OOC(TMP_NODE))=POS_IN_MANAGE
               OOC_STATE_NODE(STEP_OOC(TMP_NODE))=NOT_USED
            ENDIF
            IO_REQ(STEP_OOC(TMP_NODE))=-7777
         ELSE
            POS_IN_MEM(POS_IN_MANAGE)=0
         ENDIF
         POS_IN_S=POS_IN_S+LAST
         POS_IN_MANAGE=POS_IN_MANAGE+1
         J=J+LAST
         I=I+1
      ENDDO
      SIZE_OF_READ(POS_REQ)=-9999_8
      FIRST_POS_IN_READ(POS_REQ)=-9999
      READ_DEST(POS_REQ)=-9999_8
      READ_MNG(POS_REQ)=-9999
      REQ_TO_ZONE(POS_REQ)=-9999
      REQ_ID(POS_REQ)=-9999
      RETURN
      END SUBROUTINE ZMUMPS_SOLVE_UPDATE_POINTERS
      SUBROUTINE ZMUMPS_UPDATE_READ_REQ_NODE(INODE,SIZE,DEST,ZONE,
     &     REQUEST,POS_SEQ,NB_NODES,FLAG,PTRFAC,NSTEPS,IERR)
      IMPLICIT NONE
      INTEGER INODE,ZONE,REQUEST,FLAG,POS_SEQ,NB_NODES,NSTEPS
      INTEGER(8) :: SIZE
      INTEGER(8) :: PTRFAC(NSTEPS)
      INTEGER(8) :: DEST, LOCAL_DEST, J8
      INTEGER I,TMP_NODE,LOC_I,POS_REQ,NB
      INTEGER(8)::LAST
      INTEGER, intent(out) :: IERR
      IERR=0
      IF(CUR_POS_SEQUENCE.GT.TOTAL_NB_OOC_NODES(OOC_FCT_TYPE))THEN
         RETURN
      ENDIF
      NB=0
      LOCAL_DEST=DEST
      I=POS_SEQ
      POS_REQ=mod(REQUEST,MAX_NB_REQ)+1
      IF(REQ_ID(POS_REQ).NE.-9999)THEN
         CALL MUMPS_WAIT_REQUEST(REQ_ID(POS_REQ),IERR)
         IF(IERR.LT.0)THEN
            IF (ICNTL1.GT.0)
     &      WRITE(ICNTL1,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC)
            RETURN
         ENDIF
         CALL ZMUMPS_SOLVE_UPDATE_POINTERS(REQUEST,PTRFAC,NSTEPS)
         REQ_ACT=REQ_ACT-1
      ENDIF
      SIZE_OF_READ(POS_REQ)=SIZE
      FIRST_POS_IN_READ(POS_REQ)=I
      READ_DEST(POS_REQ)=DEST
      IF(FLAG.EQ.0)THEN
         READ_MNG(POS_REQ)=CURRENT_POS_B(ZONE)-NB_NODES+1
      ELSEIF(FLAG.EQ.1)THEN
         READ_MNG(POS_REQ)=CURRENT_POS_T(ZONE)
      ENDIF
      REQ_TO_ZONE(POS_REQ)=ZONE
      REQ_ID(POS_REQ)=REQUEST
      J8=0_8
      IF(FLAG.EQ.0)THEN
         LOC_I=CURRENT_POS_B(ZONE)-NB_NODES+1
      ENDIF
      DO WHILE((J8.LT.SIZE).AND.(I.LE.TOTAL_NB_OOC_NODES(OOC_FCT_TYPE)))
         TMP_NODE=OOC_INODE_SEQUENCE(I,OOC_FCT_TYPE)
         LAST=SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE)
         IF(LAST.EQ.0_8)THEN
            INODE_TO_POS(STEP_OOC(TMP_NODE))=1
            OOC_STATE_NODE(STEP_OOC(TMP_NODE))=NOT_USED
            I=I+1
            CYCLE
         ENDIF
         IF((IO_REQ(STEP_OOC(TMP_NODE)).GE.0).OR.
     &        (INODE_TO_POS(STEP_OOC(TMP_NODE)).NE.0))THEN
            IF(FLAG.EQ.1)THEN
               POS_IN_MEM(CURRENT_POS_T(ZONE))=0
            ELSEIF(FLAG.EQ.0)THEN
               POS_IN_MEM(CURRENT_POS_B(ZONE))=0
            ENDIF
         ELSE
            IO_REQ(STEP_OOC(TMP_NODE))=REQUEST
            LRLUS_SOLVE(ZONE)=LRLUS_SOLVE(ZONE)-LAST
            IF(FLAG.EQ.1)THEN
               IF(POSFAC_SOLVE(ZONE).EQ.IDEB_SOLVE_Z(ZONE))THEN
                  POS_HOLE_B(ZONE)=-9999
                  CURRENT_POS_B(ZONE)=-9999
                  LRLU_SOLVE_B(ZONE)=0_8
               ENDIF
               POSFAC_SOLVE(ZONE)=POSFAC_SOLVE(ZONE)+LAST
               LRLU_SOLVE_T(ZONE)=LRLU_SOLVE_T(ZONE)-LAST
               POS_IN_MEM(CURRENT_POS_T(ZONE))=-TMP_NODE-
     &              ((N_OOC+1)*NB_Z)
               INODE_TO_POS(STEP_OOC(TMP_NODE))=-CURRENT_POS_T(ZONE)-
     &              ((N_OOC+1)*NB_Z)
               OOC_STATE_NODE(STEP_OOC(TMP_NODE))=BEING_READ
               PTRFAC(STEP_OOC(TMP_NODE))=-LOCAL_DEST
               LOCAL_DEST=LOCAL_DEST+SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),
     &              OOC_FCT_TYPE)
            ELSEIF(FLAG.EQ.0)THEN
               LRLU_SOLVE_B(ZONE)=LRLU_SOLVE_B(ZONE)-LAST
               POS_IN_MEM(LOC_I)=-TMP_NODE-((N_OOC+1)*NB_Z)
               IF(LOC_I.EQ.POS_HOLE_T(ZONE))THEN
                  IF(POS_HOLE_T(ZONE).LT.CURRENT_POS_T(ZONE))THEN
                     POS_HOLE_T(ZONE)=POS_HOLE_T(ZONE)+1
                  ENDIF
               ENDIF
               INODE_TO_POS(STEP_OOC(TMP_NODE))=-LOC_I-((N_OOC+1)*NB_Z)
               OOC_STATE_NODE(STEP_OOC(TMP_NODE))=BEING_READ
               PTRFAC(STEP_OOC(TMP_NODE))=-LOCAL_DEST
               LOCAL_DEST=LOCAL_DEST+SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),
     &              OOC_FCT_TYPE)
            ELSE
             WRITE(*,*)MYID_OOC,': Internal error (39) in OOC ',
     &                 ' Invalid Flag Value in ', 
     &                 ' ZMUMPS_UPDATE_READ_REQ_NODE',FLAG
             CALL MUMPS_ABORT()
            ENDIF
         ENDIF
         IF(POS_IN_MEM(CURRENT_POS_T(ZONE)).NE.0)THEN
            IF(POS_IN_MEM(CURRENT_POS_T(ZONE)).EQ.
     &           POS_IN_MEM(PDEB_SOLVE_Z(ZONE)))THEN
               IF(CURRENT_POS_T(ZONE).NE.PDEB_SOLVE_Z(ZONE))THEN
             WRITE(*,*)MYID_OOC,': Internal error (40) in OOC ',
     &                      CURRENT_POS_T(ZONE),
     &                 PDEB_SOLVE_Z(ZONE),
     &                 POS_IN_MEM(CURRENT_POS_T(ZONE)),
     &                 POS_IN_MEM(PDEB_SOLVE_Z(ZONE))
             CALL MUMPS_ABORT()
               ENDIF
            ENDIF
         ENDIF
         J8=J8+LAST
         IF(LRLUS_SOLVE(ZONE).LT.0_8)THEN
             WRITE(*,*)MYID_OOC,': Internal error (41) in OOC ',
     &           ' LRLUS_SOLVE must be (1) > 0',
     &           LRLUS_SOLVE(ZONE)
             CALL MUMPS_ABORT()
         ENDIF
         I=I+1
         IF(FLAG.EQ.1)THEN
            CURRENT_POS_T(ZONE)=CURRENT_POS_T(ZONE)+1
            IF(CURRENT_POS_T(ZONE).GT.
     &           MAX_NB_NODES_FOR_ZONE+PDEB_SOLVE_Z(ZONE))THEN
               WRITE(*,*)MYID_OOC,': Internal error (1) in OOC '
               CALL MUMPS_ABORT()
            ENDIF
            POS_HOLE_T(ZONE)=CURRENT_POS_T(ZONE)
         ELSEIF(FLAG.EQ.0)THEN
            IF(POS_HOLE_B(ZONE).LT.PDEB_SOLVE_Z(ZONE))THEN
               WRITE(*,*)MYID_OOC,': Internal error (2) in OOC ', 
     &              POS_HOLE_B(ZONE),LOC_I
               CALL MUMPS_ABORT()
            ENDIF
            CURRENT_POS_B(ZONE)=CURRENT_POS_B(ZONE)-1
            POS_HOLE_B(ZONE)=CURRENT_POS_B(ZONE)
            IF(POS_HOLE_B(ZONE).LT.PDEB_SOLVE_Z(ZONE))THEN
               POS_HOLE_B(ZONE)=-9999
               LRLU_SOLVE_B(ZONE)=0_8
            ENDIF
         ELSE
            WRITE(*,*)MYID_OOC,': Internal error (3) in OOC ', 
     &       ' Invalid Flag Value in ', 
     &       ' ZMUMPS_UPDATE_READ_REQ_NODE',FLAG
            CALL MUMPS_ABORT()
         ENDIF
         IF(FLAG.EQ.0)THEN
            LOC_I=LOC_I+1
         ENDIF
         NB=NB+1
      ENDDO
      IF(NB.NE.NB_NODES)THEN
         WRITE(*,*)MYID_OOC,': Internal error (4) in OOC ',
     &        ' ZMUMPS_UPDATE_READ_REQ_NODE ',NB,NB_NODES
      ENDIF
      IF(SOLVE_STEP.EQ.0)THEN
         CUR_POS_SEQUENCE=I
      ELSE
         CUR_POS_SEQUENCE=POS_SEQ-1
      ENDIF
      RETURN
      END SUBROUTINE ZMUMPS_UPDATE_READ_REQ_NODE
      SUBROUTINE ZMUMPS_FREE_FACTORS_FOR_SOLVE(INODE,PTRFAC,NSTEPS,A,
     &     LA,FLAG,IERR)
      IMPLICIT NONE
      INTEGER(8) :: LA
      INTEGER, intent(out):: IERR
      COMPLEX(kind=8) A(LA)
      INTEGER INODE,NSTEPS
      INTEGER(8) :: PTRFAC(NSTEPS)
      LOGICAL FLAG
      INTEGER(8) FREE_SIZE
      INTEGER TMP,TMP_NODE,I,ZONE,J, FREE_HOLE_FLAG
      INTEGER WHICH
      INTEGER(8) :: DUMMY_SIZE
      DUMMY_SIZE=1_8
      IERR = 0
      WHICH=-1
      IF(INODE_TO_POS(STEP_OOC(INODE)).LE.0)THEN
         WRITE(*,*)MYID_OOC,': Internal error (5) in OOC ',
     &            ' Problem in ZMUMPS_FREE_FACTORS_FOR_SOLVE',
     &        INODE, STEP_OOC(INODE), INODE_TO_POS(STEP_OOC(INODE))
         CALL MUMPS_ABORT()
      ENDIF
      IF(SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE).EQ.0_8)THEN
         INODE_TO_POS(STEP_OOC(INODE))=0
         OOC_STATE_NODE(STEP_OOC(INODE))=ALREADY_USED
         RETURN
      ENDIF
      CALL ZMUMPS_SOLVE_FIND_ZONE(INODE,ZONE,PTRFAC,NSTEPS)
      TMP=INODE_TO_POS(STEP_OOC(INODE))
      INODE_TO_POS(STEP_OOC(INODE))=-TMP
      POS_IN_MEM(TMP)=-INODE
      PTRFAC(STEP_OOC(INODE))=-PTRFAC(STEP_OOC(INODE))
      IF (KEEP_OOC(237).eq.0) THEN
         IF(OOC_STATE_NODE(STEP_OOC(INODE)).NE.PERMUTED)THEN
         WRITE(*,*)MYID_OOC,': INTERNAL ERROR (53) in OOC',INODE,
     &        OOC_STATE_NODE(STEP_OOC(INODE))
         CALL MUMPS_ABORT()
       ENDIF
      ENDIF
      OOC_STATE_NODE(STEP_OOC(INODE))=USED
      LRLUS_SOLVE(ZONE)=LRLUS_SOLVE(ZONE)+
     &        SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE)         
      IF(LRLUS_SOLVE(ZONE).LT.0_8)THEN
         WRITE(*,*)MYID_OOC,': Internal error (6) in OOC ',
     &        ': LRLUS_SOLVE must be (2) > 0'
         CALL MUMPS_ABORT()
      ENDIF
      IF(ZONE.EQ.NB_Z)THEN
         IF(INODE.NE.SPECIAL_ROOT_NODE)THEN
            CALL ZMUMPS_FREE_SPACE_FOR_SOLVE(A,FACT_AREA_SIZE,
     &           DUMMY_SIZE,PTRFAC,KEEP_OOC(28),ZONE,IERR)
         ENDIF
      ELSE
         FREE_HOLE_FLAG=0
         IF(SOLVE_STEP.EQ.0)THEN
            IF(TMP.GT.POS_HOLE_B(ZONE))THEN
               WHICH=0
            ELSEIF(TMP.LT.POS_HOLE_T(ZONE))THEN
               WHICH=1
            ENDIF
         ELSEIF(SOLVE_STEP.EQ.1)THEN
            IF(TMP.LT.POS_HOLE_T(ZONE))THEN
               WHICH=1
            ELSEIF(TMP.GT.POS_HOLE_B(ZONE))THEN
               WHICH=0
            ENDIF
         ENDIF
         IF(WHICH.EQ.1)THEN
            J=max(PDEB_SOLVE_Z(ZONE),POS_HOLE_T(ZONE))
            J=min(J,PDEB_SOLVE_Z(ZONE)+MAX_NB_NODES_FOR_ZONE-1)
            FREE_SIZE=0_8
            DO I=J,TMP,-1
               IF((POS_IN_MEM(I).LT.0).AND.(POS_IN_MEM(I).GT.
     &              -(N_OOC+1)*NB_Z))THEN
                  TMP_NODE=-POS_IN_MEM(I)
                  FREE_SIZE=FREE_SIZE+SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),
     &                 OOC_FCT_TYPE)
               ELSEIF(POS_IN_MEM(I).NE.0)THEN
                  GOTO 666
               ENDIF
            ENDDO
            POS_HOLE_T(ZONE)=TMP
 666        CONTINUE
         ELSEIF(WHICH.EQ.0)THEN
            J=max(PDEB_SOLVE_Z(ZONE),POS_HOLE_B(ZONE))
            J=min(J,PDEB_SOLVE_Z(ZONE)+MAX_NB_NODES_FOR_ZONE-1)
            FREE_SIZE=0_8
            DO I=J,TMP
               IF((POS_IN_MEM(I).LT.0).AND.(POS_IN_MEM(I).GT.
     &              -(N_OOC+1)*NB_Z))THEN
                  TMP_NODE=-POS_IN_MEM(I)
                  FREE_SIZE=FREE_SIZE+SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),
     &                 OOC_FCT_TYPE)
               ELSEIF(POS_IN_MEM(I).NE.0)THEN
                  IF(J.EQ.PDEB_SOLVE_Z(ZONE))THEN
                     POS_HOLE_B(ZONE)=-9999
                     LRLU_SOLVE_B(ZONE)=0_8
                     CURRENT_POS_B(ZONE)=-9999
                  ENDIF
                  GOTO 777
               ENDIF
            ENDDO
            POS_HOLE_B(ZONE)=TMP
 777        CONTINUE
         ENDIF
      IERR=0
      ENDIF
      IF((NB_Z.GT.1).AND.FLAG)THEN
         CALL ZMUMPS_SOLVE_TRY_ZONE_FOR_READ(ZONE)
         IF((LRLUS_SOLVE(ZONE).GE.MIN_SIZE_READ).OR.
     &        (LRLUS_SOLVE(ZONE).GE.
     &        int(0.3D0*dble(SIZE_SOLVE_Z(ZONE)),8)))THEN
            CALL ZMUMPS_SUBMIT_READ_FOR_Z(A,LA,PTRFAC,NSTEPS,IERR)
            IF(IERR.LT.0)THEN
               RETURN
            ENDIF
         ELSE
            CALL ZMUMPS_SOLVE_SELECT_ZONE(ZONE)
         ENDIF
      ENDIF     
      RETURN
      END SUBROUTINE ZMUMPS_FREE_FACTORS_FOR_SOLVE
      FUNCTION ZMUMPS_SOLVE_IS_INODE_IN_MEM(INODE,PTRFAC,NSTEPS,A,LA,
     &     IERR)
      IMPLICIT NONE
      INTEGER INODE,NSTEPS
      INTEGER(8) :: LA
      INTEGER, INTENT(out)::IERR
      COMPLEX(kind=8) A(LA)
      INTEGER (8) :: PTRFAC(NSTEPS)
      INTEGER ZMUMPS_SOLVE_IS_INODE_IN_MEM
      IERR=0
      IF(INODE_TO_POS(STEP_OOC(INODE)).GT.0)THEN
         IF(OOC_STATE_NODE(STEP_OOC(INODE)).EQ.PERMUTED)THEN
            ZMUMPS_SOLVE_IS_INODE_IN_MEM=OOC_NODE_PERMUTED
         ELSE
            ZMUMPS_SOLVE_IS_INODE_IN_MEM=OOC_NODE_NOT_PERMUTED
         ENDIF
         IF(.NOT.ZMUMPS_SOLVE_IS_END_REACHED())THEN
            IF(OOC_INODE_SEQUENCE(CUR_POS_SEQUENCE,OOC_FCT_TYPE)
     &           .EQ.INODE)THEN
               IF(SOLVE_STEP.EQ.0)THEN
                  CUR_POS_SEQUENCE=CUR_POS_SEQUENCE+1
               ELSEIF(SOLVE_STEP.EQ.1)THEN
                  CUR_POS_SEQUENCE=CUR_POS_SEQUENCE-1
               ENDIF
               CALL ZMUMPS_OOC_SKIP_NULL_SIZE_NODE()
            ENDIF
         ENDIF
      ELSEIF(INODE_TO_POS(STEP_OOC(INODE)).LT.0)THEN
         IF(INODE_TO_POS(STEP_OOC(INODE)).LT.-((N_OOC+1)*NB_Z))THEN
            CALL MUMPS_WAIT_REQUEST(IO_REQ(STEP_OOC(INODE)),IERR)
            IF(IERR.LT.0)THEN
               IF (ICNTL1.GT.0)
     &         WRITE(ICNTL1,*)MYID_OOC,': Internal error (7) in OOC ',
     &                   ERR_STR_OOC(1:DIM_ERR_STR_OOC)
               RETURN
            ENDIF
            CALL ZMUMPS_SOLVE_UPDATE_POINTERS(IO_REQ(STEP_OOC(INODE)),
     &           PTRFAC,NSTEPS)
            REQ_ACT=REQ_ACT-1
         ELSE
            CALL ZMUMPS_SOLVE_UPD_NODE_INFO(INODE,PTRFAC,NSTEPS)
            IF(.NOT.ZMUMPS_SOLVE_IS_END_REACHED())THEN
               IF(OOC_INODE_SEQUENCE(CUR_POS_SEQUENCE,OOC_FCT_TYPE).EQ.
     &              INODE)THEN
                  IF(SOLVE_STEP.EQ.0)THEN
                     CUR_POS_SEQUENCE=CUR_POS_SEQUENCE+1
                  ELSEIF(SOLVE_STEP.EQ.1)THEN
                     CUR_POS_SEQUENCE=CUR_POS_SEQUENCE-1
                  ENDIF
                  CALL ZMUMPS_OOC_SKIP_NULL_SIZE_NODE()
               ENDIF
            ENDIF
         ENDIF
         IF(OOC_STATE_NODE(STEP_OOC(INODE)).EQ.PERMUTED)THEN
            ZMUMPS_SOLVE_IS_INODE_IN_MEM=OOC_NODE_PERMUTED
         ELSE
            ZMUMPS_SOLVE_IS_INODE_IN_MEM=OOC_NODE_NOT_PERMUTED
         ENDIF
      ELSE
         ZMUMPS_SOLVE_IS_INODE_IN_MEM=OOC_NODE_NOT_IN_MEM
      ENDIF
      RETURN
      END FUNCTION ZMUMPS_SOLVE_IS_INODE_IN_MEM
      SUBROUTINE ZMUMPS_SOLVE_MODIFY_STATE_NODE(INODE)
      IMPLICIT NONE
      INTEGER INODE
      IF ( (KEEP_OOC(237).EQ.0)
     &     .AND. (KEEP_OOC(235).EQ.0) ) THEN
      IF(OOC_STATE_NODE(STEP_OOC(INODE)).NE.NOT_USED)THEN
         WRITE(*,*)MYID_OOC,': INTERNAL ERROR (51) in OOC',INODE,
     &        OOC_STATE_NODE(STEP_OOC(INODE))
         CALL MUMPS_ABORT()
       ENDIF
      ENDIF
      OOC_STATE_NODE(STEP_OOC(INODE))=PERMUTED
      END SUBROUTINE ZMUMPS_SOLVE_MODIFY_STATE_NODE
      SUBROUTINE ZMUMPS_SOLVE_UPD_NODE_INFO(INODE,PTRFAC,NSTEPS)
      IMPLICIT NONE
      INTEGER INODE,NSTEPS
      INTEGER (8) :: PTRFAC(NSTEPS)
      INTEGER ZONE
      INODE_TO_POS(STEP_OOC(INODE))=-INODE_TO_POS(STEP_OOC(INODE))
      POS_IN_MEM(INODE_TO_POS(STEP_OOC(INODE)))=
     &     -POS_IN_MEM(INODE_TO_POS(STEP_OOC(INODE)))
      PTRFAC(STEP_OOC(INODE))=-PTRFAC(STEP_OOC(INODE))
      IF(OOC_STATE_NODE(STEP_OOC(INODE)).EQ.USED_NOT_PERMUTED)THEN
         OOC_STATE_NODE(STEP_OOC(INODE))=NOT_USED
      ELSEIF(OOC_STATE_NODE(STEP_OOC(INODE)).EQ.USED)THEN
         OOC_STATE_NODE(STEP_OOC(INODE))=PERMUTED
      ELSE
         WRITE(*,*)MYID_OOC,': Internal error (52) in OOC',INODE,
     &        OOC_STATE_NODE(STEP_OOC(INODE)),
     &        INODE_TO_POS(STEP_OOC(INODE))
         CALL MUMPS_ABORT()
      ENDIF
      CALL ZMUMPS_SEARCH_SOLVE(PTRFAC(STEP_OOC(INODE)),ZONE)
      IF(INODE_TO_POS(STEP_OOC(INODE)).LE.POS_HOLE_B(ZONE))THEN
         IF(INODE_TO_POS(STEP_OOC(INODE)).GT.
     &        PDEB_SOLVE_Z(ZONE))THEN
            POS_HOLE_B(ZONE)=
     &           INODE_TO_POS(STEP_OOC(INODE))-1
         ELSE
            CURRENT_POS_B(ZONE)=-9999
            POS_HOLE_B(ZONE)=-9999
            LRLU_SOLVE_B(ZONE)=0_8
         ENDIF
      ENDIF
      IF(INODE_TO_POS(STEP_OOC(INODE)).GE.POS_HOLE_T(ZONE))THEN
         IF(INODE_TO_POS(STEP_OOC(INODE)).LT.
     &        CURRENT_POS_T(ZONE)-1)THEN
            POS_HOLE_T(ZONE)=INODE_TO_POS(STEP_OOC(INODE))+1
         ELSE
            POS_HOLE_T(ZONE)=CURRENT_POS_T(ZONE)
         ENDIF
      ENDIF
      CALL ZMUMPS_OOC_UPDATE_SOLVE_STAT(INODE,PTRFAC,NSTEPS,1)
      END SUBROUTINE ZMUMPS_SOLVE_UPD_NODE_INFO
      SUBROUTINE ZMUMPS_SOLVE_FIND_ZONE(INODE,ZONE,PTRFAC,NSTEPS)
      IMPLICIT NONE
      INTEGER INODE,ZONE,NSTEPS
      INTEGER (8) :: PTRFAC(NSTEPS)
      ZONE=1
      DO WHILE (ZONE.LE.NB_Z)
         IF(PTRFAC(STEP_OOC(INODE)).LT.IDEB_SOLVE_Z(ZONE))THEN
            ZONE=ZONE-1
            EXIT
         ENDIF
         ZONE=ZONE+1
      ENDDO
      IF(ZONE.EQ.NB_Z+1)THEN
         ZONE=ZONE-1
      ENDIF
      END SUBROUTINE ZMUMPS_SOLVE_FIND_ZONE
      SUBROUTINE ZMUMPS_SOLVE_TRY_ZONE_FOR_READ(ZONE)
      IMPLICIT NONE
      INTEGER ZONE
      ZONE=mod((CURRENT_SOLVE_READ_ZONE+1),NB_Z-1)+1
      END SUBROUTINE ZMUMPS_SOLVE_TRY_ZONE_FOR_READ
      SUBROUTINE ZMUMPS_SOLVE_SELECT_ZONE(ZONE)
      IMPLICIT NONE
      INTEGER ZONE
      IF(NB_Z.GT.1)THEN
         CURRENT_SOLVE_READ_ZONE=mod((CURRENT_SOLVE_READ_ZONE+1),NB_Z-1)
         ZONE=CURRENT_SOLVE_READ_ZONE+1
      ELSE
         ZONE=NB_Z
      ENDIF
      END SUBROUTINE ZMUMPS_SOLVE_SELECT_ZONE
      SUBROUTINE ZMUMPS_SOLVE_ALLOC_FACTOR_SPACE(INODE,PTRFAC,
     &     KEEP,KEEP8,
     &     A,IERR)
      IMPLICIT NONE
      INTEGER INODE,KEEP(500)
      INTEGER, intent(out)::IERR
      INTEGER(8) KEEP8(150)
      INTEGER(8) :: PTRFAC(KEEP(28))
      COMPLEX(kind=8) A(FACT_AREA_SIZE)
      INTEGER(8) :: REQUESTED_SIZE
      INTEGER ZONE,IFLAG
      IERR=0
      IFLAG=0
      IF(SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE)
     &     .EQ.0_8)THEN
         INODE_TO_POS(STEP_OOC(INODE))=1
         OOC_STATE_NODE(STEP_OOC(INODE))=NOT_USED
         PTRFAC(STEP_OOC(INODE))=1_8
         RETURN
      ENDIF
      REQUESTED_SIZE=SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE)
      ZONE=NB_Z
      IF(CURRENT_POS_T(ZONE).GT.
     &     (PDEB_SOLVE_Z(ZONE)+MAX_NB_NODES_FOR_ZONE-1))THEN
         CALL ZMUMPS_FREE_SPACE_FOR_SOLVE(A,FACT_AREA_SIZE,
     &        REQUESTED_SIZE,PTRFAC,KEEP(28),ZONE,IERR)
         IF(IERR.LT.0)THEN
            RETURN
         ENDIF
      ENDIF
      IF((LRLU_SOLVE_T(ZONE).GT.SIZE_OF_BLOCK(STEP_OOC(INODE),
     &     OOC_FCT_TYPE)).AND.
     &     (CURRENT_POS_T(ZONE).LE.
     &     (PDEB_SOLVE_Z(ZONE)+MAX_NB_NODES_FOR_ZONE-1)))THEN
         CALL ZMUMPS_SOLVE_ALLOC_PTR_UPD_T(INODE,PTRFAC,
     &        KEEP,KEEP8,A,ZONE)
      ELSEIF(LRLU_SOLVE_B(ZONE).GT.SIZE_OF_BLOCK(STEP_OOC(INODE),
     &        OOC_FCT_TYPE).AND.
     &        (CURRENT_POS_B(ZONE).GT.0))THEN
         CALL ZMUMPS_SOLVE_ALLOC_PTR_UPD_B(INODE,PTRFAC,
     &        KEEP,KEEP8,A,ZONE)
      ELSE
         IF(ZMUMPS_IS_THERE_FREE_SPACE(INODE,ZONE))THEN
            IF(SOLVE_STEP.EQ.0)THEN
               CALL ZMUMPS_GET_TOP_AREA_SPACE(A,FACT_AREA_SIZE,
     &              REQUESTED_SIZE,PTRFAC,
     &              KEEP(28),ZONE,IFLAG,IERR)
               IF(IERR.LT.0)THEN
                  RETURN
               ENDIF
               IF(IFLAG.EQ.1)THEN
                  CALL ZMUMPS_SOLVE_ALLOC_PTR_UPD_T(INODE,PTRFAC,
     &                 KEEP,KEEP8,A,ZONE)
               ELSEIF(IFLAG.EQ.0)THEN
                  CALL ZMUMPS_GET_BOTTOM_AREA_SPACE(A,FACT_AREA_SIZE,
     &                 REQUESTED_SIZE,PTRFAC,
     &                 KEEP(28),ZONE,IFLAG,IERR)           
                  IF(IERR.LT.0)THEN
                     RETURN
                  ENDIF
                  IF(IFLAG.EQ.1)THEN
                     CALL ZMUMPS_SOLVE_ALLOC_PTR_UPD_B(INODE,PTRFAC,
     &                    KEEP,KEEP8,A,ZONE)
                  ENDIF
               ENDIF
            ELSE
               CALL ZMUMPS_GET_BOTTOM_AREA_SPACE(A,FACT_AREA_SIZE,
     &              REQUESTED_SIZE,PTRFAC,
     &              KEEP(28),ZONE,IFLAG,IERR)               
               IF(IERR.LT.0)THEN
                  RETURN
               ENDIF
               IF(IFLAG.EQ.1)THEN
                  CALL ZMUMPS_SOLVE_ALLOC_PTR_UPD_B(INODE,PTRFAC,
     &                 KEEP,KEEP8,A,ZONE)
               ELSEIF(IFLAG.EQ.0)THEN
                  CALL ZMUMPS_GET_TOP_AREA_SPACE(A,FACT_AREA_SIZE,
     &                 REQUESTED_SIZE,PTRFAC,
     &                 KEEP(28),ZONE,IFLAG,IERR)
                  IF(IERR.LT.0)THEN
                     RETURN
                  ENDIF
                  IF(IFLAG.EQ.1)THEN
                     CALL ZMUMPS_SOLVE_ALLOC_PTR_UPD_T(INODE,PTRFAC,
     &                    KEEP,KEEP8,A,ZONE)
                  ENDIF
               ENDIF
            ENDIF
            IF(IFLAG.EQ.0)THEN
               CALL ZMUMPS_FREE_SPACE_FOR_SOLVE(A,FACT_AREA_SIZE,
     &              REQUESTED_SIZE,PTRFAC,KEEP(28),ZONE,IERR)
               IF(IERR.LT.0)THEN
                  RETURN
               ENDIF
               CALL ZMUMPS_SOLVE_ALLOC_PTR_UPD_T(INODE,PTRFAC,
     &              KEEP,KEEP8,A,ZONE)
            ENDIF
         ELSE
            WRITE(*,*)MYID_OOC,': Internal error (8) in OOC ',
     &                         ' Not enough space for Solve',INODE,
     &           SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE),
     &           LRLUS_SOLVE(ZONE)
            CALL MUMPS_ABORT()
         ENDIF
      ENDIF
      IF(LRLUS_SOLVE(ZONE).LT.0_8)THEN
         WRITE(*,*)MYID_OOC,': Internal error (9) in OOC ',
     &                      ' LRLUS_SOLVE must be (3) > 0'
         CALL MUMPS_ABORT()
      ENDIF
      RETURN
      END SUBROUTINE ZMUMPS_SOLVE_ALLOC_FACTOR_SPACE
      SUBROUTINE ZMUMPS_GET_TOP_AREA_SPACE(A,LA,REQUESTED_SIZE,PTRFAC,
     &     NSTEPS,ZONE,FLAG,IERR)
      IMPLICIT NONE
      INTEGER NSTEPS,ZONE,FLAG
      INTEGER(8) :: REQUESTED_SIZE, LA
      INTEGER(8) :: PTRFAC(NSTEPS)
      INTEGER(8) :: FREE_SIZE, FREE_HOLE, FREE_HOLE_POS
      COMPLEX(kind=8) A(LA)
      INTEGER I,TMP_NODE,FREE_HOLE_FLAG, J
      INTEGER, intent(out)::IERR
      IERR=0
      FLAG=0
      IF(LRLU_SOLVE_T(ZONE).EQ.SIZE_SOLVE_Z(ZONE).AND.     
     &     (.NOT.(CURRENT_POS_T(ZONE)
     &     .GT.PDEB_SOLVE_Z(ZONE)+MAX_NB_NODES_FOR_ZONE-1)))THEN
         GOTO 50
      ENDIF
      J=max(POS_HOLE_B(ZONE),PDEB_SOLVE_Z(ZONE))
      J=min(J,PDEB_SOLVE_Z(ZONE)+MAX_NB_NODES_FOR_ZONE-1)
      DO I=POS_HOLE_T(ZONE)-1,J,-1
         IF((POS_IN_MEM(I).LT.0).AND.(POS_IN_MEM(I).GT.
     &        -(N_OOC+1)*NB_Z))THEN
            TMP_NODE=-POS_IN_MEM(I)
         ELSEIF(POS_IN_MEM(I).NE.0)THEN
            EXIT
         ENDIF
      ENDDO
      POS_HOLE_T(ZONE)=I+1
      IF((POS_HOLE_T(ZONE).EQ.PDEB_SOLVE_Z(ZONE)).OR.
     &     (POS_HOLE_T(ZONE).LE.POS_HOLE_B(ZONE)).OR.
     &     (POS_HOLE_T(ZONE).EQ.POS_HOLE_B(ZONE)+1))THEN
         CURRENT_POS_B(ZONE)=-9999
         POS_HOLE_B(ZONE)=-9999
         LRLU_SOLVE_B(ZONE)=0_8
         POS_HOLE_T(ZONE)=PDEB_SOLVE_Z(ZONE)
      ENDIF
      FREE_HOLE=0_8
      FREE_SIZE=0_8
      FREE_HOLE_FLAG=0      
      FREE_HOLE_POS=POSFAC_SOLVE(ZONE)
      DO I=CURRENT_POS_T(ZONE)-1,POS_HOLE_T(ZONE),-1
         IF((POS_IN_MEM(I).LT.0).AND.(POS_IN_MEM(I).GT.
     &        -(N_OOC+1)*NB_Z))THEN
            TMP_NODE=-POS_IN_MEM(I)
            IF(FREE_HOLE_FLAG.EQ.1)THEN
               FREE_HOLE=FREE_HOLE_POS-
     &              (abs(PTRFAC(STEP_OOC(TMP_NODE)))+
     &              SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE))
               FREE_HOLE_FLAG=0
               FREE_SIZE=FREE_SIZE+FREE_HOLE
            ENDIF
            FREE_HOLE_POS=abs(PTRFAC(STEP_OOC(TMP_NODE)))
            PTRFAC(STEP_OOC(TMP_NODE))=-777777_8
            INODE_TO_POS(STEP_OOC(TMP_NODE))=0
            OOC_STATE_NODE(STEP_OOC(TMP_NODE))=ALREADY_USED
            POS_IN_MEM(I)=0
            FREE_SIZE=FREE_SIZE+SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),
     &           OOC_FCT_TYPE)
         ELSEIF(POS_IN_MEM(I).EQ.0)THEN
            FREE_HOLE_FLAG=1
         ELSEIF(POS_IN_MEM(I).NE.0)THEN
            WRITE(*,*)MYID_OOC,': Internal error (10) in OOC ',
     &            ' ZMUMPS_GET_TOP_AREA_SPACE',
     &           CURRENT_POS_T(ZONE)-1,POS_HOLE_T(ZONE),I
            CALL MUMPS_ABORT()
         ENDIF
      ENDDO
      IF(POS_HOLE_T(ZONE).EQ.PDEB_SOLVE_Z(ZONE))THEN
         IF(FREE_HOLE_FLAG.EQ.0)THEN
            FREE_HOLE_FLAG=1
         ENDIF
      ENDIF
      IF(FREE_HOLE_FLAG.EQ.1)THEN
         IF(POS_HOLE_T(ZONE)-1.GT.PDEB_SOLVE_Z(ZONE))THEN
            I=POS_HOLE_T(ZONE)-1
            TMP_NODE=abs(POS_IN_MEM(I))
            IF(TMP_NODE.GT.(N_OOC+1)*NB_Z)THEN
               TMP_NODE=TMP_NODE-(N_OOC+1)*NB_Z
               CALL MUMPS_WAIT_REQUEST(IO_REQ(STEP_OOC(TMP_NODE)),IERR)
               IF(IERR.LT.0)THEN
                  WRITE(*,*)MYID_OOC,': Internal error (11) in OOC ',
     &                               ERR_STR_OOC(1:DIM_ERR_STR_OOC)
                  CALL MUMPS_ABORT()    
                  RETURN
               ENDIF
               REQ_ACT=REQ_ACT-1
               CALL ZMUMPS_SOLVE_UPDATE_POINTERS(
     &              IO_REQ(STEP_OOC(TMP_NODE)),PTRFAC,NSTEPS)
               FREE_HOLE=FREE_HOLE_POS-
     &              (abs(PTRFAC(STEP_OOC(TMP_NODE)))+
     &              SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE))
            ELSEIF(TMP_NODE.EQ.0)THEN
               DO J=I,PDEB_SOLVE_Z(ZONE),-1
                  IF(POS_IN_MEM(J).NE.0) EXIT
               ENDDO
               IF(POS_IN_MEM(J).LT.0)THEN
                  WRITE(*,*)MYID_OOC,': Internal error (12) in OOC ',
     &                 ' ZMUMPS_GET_TOP_AREA_SPACE'
                  CALL MUMPS_ABORT()
               ENDIF
               IF(J.GE.PDEB_SOLVE_Z(ZONE))THEN
                  TMP_NODE=POS_IN_MEM(J)
                  FREE_HOLE=FREE_HOLE_POS-
     &                 (abs(PTRFAC(STEP_OOC(TMP_NODE)))+
     &                 SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE))
               ELSE
                  FREE_HOLE=FREE_HOLE_POS-IDEB_SOLVE_Z(ZONE)
               ENDIF
            ELSEIF(TMP_NODE.LT.0)THEN
               WRITE(*,*)MYID_OOC,': Internal error (13) in OOC', 
     &           ' ZMUMPS_GET_TOP_AREA_SPACE'
               CALL MUMPS_ABORT()
            ELSE
               FREE_HOLE=FREE_HOLE_POS-
     &              (abs(PTRFAC(STEP_OOC(TMP_NODE)))+
     &              SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE))
            ENDIF
         ELSE
            FREE_HOLE=FREE_HOLE_POS-IDEB_SOLVE_Z(ZONE)
         ENDIF
         FREE_SIZE=FREE_SIZE+FREE_HOLE
      ENDIF
      CURRENT_POS_T(ZONE)=POS_HOLE_T(ZONE)
      LRLU_SOLVE_T(ZONE)=LRLU_SOLVE_T(ZONE)+FREE_SIZE
      POSFAC_SOLVE(ZONE)=POSFAC_SOLVE(ZONE)-FREE_SIZE
 50   CONTINUE
      IF(REQUESTED_SIZE.LE.LRLU_SOLVE_T(ZONE))THEN
         FLAG=1
      ELSE
         FLAG=0
      ENDIF
      RETURN
      END SUBROUTINE ZMUMPS_GET_TOP_AREA_SPACE
      SUBROUTINE ZMUMPS_GET_BOTTOM_AREA_SPACE(A,LA,REQUESTED_SIZE,
     &     PTRFAC,NSTEPS,ZONE,FLAG,IERR)
      IMPLICIT NONE
      INTEGER NSTEPS,ZONE,FLAG
      INTEGER (8) :: REQUESTED_SIZE
      INTEGER (8) :: LA
      INTEGER (8) :: PTRFAC(NSTEPS)
      COMPLEX(kind=8) A(LA)
      INTEGER(8) :: FREE_SIZE, FREE_HOLE_POS, FREE_HOLE
      INTEGER I,J,TMP_NODE,FREE_HOLE_FLAG
      INTEGER, intent(out) :: IERR
      IERR=0
      FLAG=0
      IF(LRLU_SOLVE_B(ZONE).EQ.SIZE_SOLVE_Z(ZONE))THEN
         GOTO 50
      ENDIF
      IF(POS_HOLE_B(ZONE).EQ.-9999)THEN
         GOTO 50
      ENDIF
      J=max(PDEB_SOLVE_Z(ZONE),POS_HOLE_T(ZONE))
      J=min(J,PDEB_SOLVE_Z(ZONE)+MAX_NB_NODES_FOR_ZONE-1)
      FREE_SIZE = 0_8
      DO I=POS_HOLE_B(ZONE)+1,J
         IF((POS_IN_MEM(I).LT.0).AND.(POS_IN_MEM(I).GT.
     &        -(N_OOC+1)*NB_Z))THEN
            TMP_NODE=-POS_IN_MEM(I)
            FREE_SIZE=FREE_SIZE+SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),
     &           OOC_FCT_TYPE)
         ELSEIF(POS_IN_MEM(I).NE.0)THEN
            EXIT
         ENDIF
      ENDDO
      POS_HOLE_B(ZONE)=I-1
      IF((POS_HOLE_T(ZONE).EQ.PDEB_SOLVE_Z(ZONE)).OR.
     &     (POS_HOLE_T(ZONE).LE.POS_HOLE_B(ZONE)).OR.
     &     (POS_HOLE_T(ZONE).EQ.POS_HOLE_B(ZONE)+1))THEN
         CURRENT_POS_B(ZONE)=-9999
         POS_HOLE_B(ZONE)=-9999
         LRLU_SOLVE_B(ZONE)=0_8
         POS_HOLE_T(ZONE)=PDEB_SOLVE_Z(ZONE)
      ENDIF
      FREE_HOLE=0_8
      FREE_SIZE=0_8
      FREE_HOLE_FLAG=0
      FREE_HOLE_POS=IDEB_SOLVE_Z(ZONE)
      IF(POS_HOLE_B(ZONE).EQ.-9999)THEN
         GOTO 50
      ENDIF
      DO I=PDEB_SOLVE_Z(ZONE),POS_HOLE_B(ZONE)
         IF((POS_IN_MEM(I).LE.0).AND.(POS_IN_MEM(I).GT.
     &        -(N_OOC+1)*NB_Z))THEN
            TMP_NODE=-POS_IN_MEM(I)
            IF(TMP_NODE.NE.0)THEN
               IF(I.EQ.PDEB_SOLVE_Z(ZONE))THEN
                  IF(abs(PTRFAC(STEP_OOC(TMP_NODE))).NE.
     &                 IDEB_SOLVE_Z(ZONE))THEN
                     FREE_SIZE=FREE_SIZE+abs(PTRFAC(STEP_OOC(TMP_NODE)))
     &                    -IDEB_SOLVE_Z(ZONE)
                  ENDIF
               ENDIF
               IF(FREE_HOLE_FLAG.EQ.1)THEN
                  FREE_HOLE=abs(PTRFAC(STEP_OOC(TMP_NODE)))-
     &                 FREE_HOLE_POS
                  FREE_HOLE_FLAG=0
                  FREE_SIZE=FREE_SIZE+FREE_HOLE
               ENDIF
               FREE_HOLE_POS=abs(PTRFAC(STEP_OOC(TMP_NODE)))+
     &              SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE)
               PTRFAC(STEP_OOC(TMP_NODE))=-777777_8
               INODE_TO_POS(STEP_OOC(TMP_NODE))=0
               OOC_STATE_NODE(STEP_OOC(TMP_NODE))=ALREADY_USED
               FREE_SIZE=FREE_SIZE+SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),
     &              OOC_FCT_TYPE)
            ELSE
               FREE_HOLE_FLAG=1
            ENDIF
            POS_IN_MEM(I)=0
         ELSEIF(POS_IN_MEM(I).NE.0)THEN
            WRITE(*,*)MYID_OOC,': Internal error (14) in OOC ',
     &            ' ZMUMPS_GET_BOTTOM_AREA_SPACE',
     &           CURRENT_POS_T(ZONE)-1,POS_HOLE_B(ZONE),I,POS_IN_MEM(I)
            CALL MUMPS_ABORT()
         ENDIF
      ENDDO
      IF(FREE_HOLE_FLAG.EQ.1)THEN
         IF(POS_HOLE_B(ZONE)+1.LT.CURRENT_POS_T(ZONE)-1)THEN
            I=POS_HOLE_B(ZONE)+1
            TMP_NODE=abs(POS_IN_MEM(I))
            IF(TMP_NODE.GT.(N_OOC+1)*NB_Z)THEN
               TMP_NODE=TMP_NODE-(N_OOC+1)*NB_Z
               CALL MUMPS_WAIT_REQUEST(IO_REQ(STEP_OOC(TMP_NODE)),IERR)
               IF(IERR.LT.0)THEN
                 WRITE(*,*)MYID_OOC,': Internal error (15) in OOC ',
     &                               ERR_STR_OOC(1:DIM_ERR_STR_OOC)
                 CALL MUMPS_ABORT() 
                 RETURN
               ENDIF
               REQ_ACT=REQ_ACT-1
               CALL ZMUMPS_SOLVE_UPDATE_POINTERS(
     &              IO_REQ(STEP_OOC(TMP_NODE)),PTRFAC,NSTEPS)
               FREE_HOLE=abs(PTRFAC(STEP_OOC(TMP_NODE)))-FREE_HOLE_POS
            ELSEIF(TMP_NODE.EQ.0)THEN
               DO J=I,CURRENT_POS_T(ZONE)-1
                  IF(POS_IN_MEM(J).NE.0) EXIT
               ENDDO
               IF(POS_IN_MEM(J).LT.0)THEN
                  WRITE(*,*)MYID_OOC,': Internal error (16) in OOC ',
     &                  ' ZMUMPS_GET_BOTTOM_AREA_SPACE'
                  CALL MUMPS_ABORT()
               ENDIF
               IF(J.LE.CURRENT_POS_T(ZONE)-1)THEN
                  TMP_NODE=POS_IN_MEM(J)
                  FREE_HOLE=abs(PTRFAC(STEP_OOC(TMP_NODE)))-
     &                 FREE_HOLE_POS
               ELSE
                  FREE_HOLE=POSFAC_SOLVE(ZONE)-FREE_HOLE_POS
               ENDIF
            ELSEIF(TMP_NODE.LT.0)THEN
               WRITE(*,*)MYID_OOC,': Internal error (17) in OOC ',
     &           ' ZMUMPS_GET_BOTTOM_AREA_SPACE'
               CALL MUMPS_ABORT()
            ELSE
               FREE_HOLE=abs(PTRFAC(STEP_OOC(TMP_NODE)))-
     &              FREE_HOLE_POS
            ENDIF
         ELSE
            FREE_HOLE=POSFAC_SOLVE(ZONE)-FREE_HOLE_POS
         ENDIF
         FREE_SIZE=FREE_SIZE+FREE_HOLE
      ENDIF
      LRLU_SOLVE_B(ZONE)=FREE_SIZE
      IF(POS_HOLE_B(ZONE).LT.CURRENT_POS_T(ZONE)-1)THEN
         TMP_NODE=POS_IN_MEM(POS_HOLE_B(ZONE)+1)
         IF(TMP_NODE.LT.-(N_OOC+1)*NB_Z)THEN
            TMP_NODE=abs(TMP_NODE)-(N_OOC+1)*NB_Z
            CALL MUMPS_WAIT_REQUEST(IO_REQ(STEP_OOC(TMP_NODE)),IERR)
            IF(IERR.LT.0)THEN
               WRITE(*,*)MYID_OOC,': Internal error (18) in OOC ',
     &                            ERR_STR_OOC(1:DIM_ERR_STR_OOC)
               CALL MUMPS_ABORT()
               RETURN
            ENDIF
            REQ_ACT=REQ_ACT-1
            CALL ZMUMPS_SOLVE_UPDATE_POINTERS(
     &           IO_REQ(STEP_OOC(TMP_NODE)),PTRFAC,NSTEPS)
         ENDIF
         LRLU_SOLVE_B(ZONE)=LRLU_SOLVE_B(ZONE)+
     &        (abs(PTRFAC(STEP_OOC(abs(TMP_NODE))))-IDEB_SOLVE_Z(ZONE)-
     &        LRLU_SOLVE_B(ZONE))
      ENDIF
      CURRENT_POS_B(ZONE)=POS_HOLE_B(ZONE)
 50   CONTINUE
      IF((POS_HOLE_B(ZONE).EQ.-9999).AND.
     &     (LRLU_SOLVE_B(ZONE).NE.0_8))THEN
         WRITE(*,*)MYID_OOC,': Internal error (19) in OOC ',
     &             'ZMUMPS_GET_BOTTOM_AREA_SPACE'
         CALL MUMPS_ABORT()
      ENDIF
      IF((REQUESTED_SIZE.LE.LRLU_SOLVE_B(ZONE)).AND.
     &     (POS_HOLE_B(ZONE).NE.-9999))THEN
         FLAG=1
      ELSE
         FLAG=0
      ENDIF
      END SUBROUTINE ZMUMPS_GET_BOTTOM_AREA_SPACE
      SUBROUTINE ZMUMPS_SOLVE_ALLOC_PTR_UPD_T(INODE,PTRFAC,
     &           KEEP,KEEP8, A,ZONE)
      IMPLICIT NONE
      INTEGER INODE,KEEP(500)
      INTEGER(8) KEEP8(150)
      INTEGER(8) :: PTRFAC(KEEP(28))
      COMPLEX(kind=8) A(FACT_AREA_SIZE)
      INTEGER ZONE
      LRLU_SOLVE_T(ZONE)=LRLU_SOLVE_T(ZONE)-
     &     SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE)
      LRLUS_SOLVE(ZONE)=LRLUS_SOLVE(ZONE)-
     &     SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE)
      PTRFAC(STEP_OOC(INODE))=POSFAC_SOLVE(ZONE)
      OOC_STATE_NODE(STEP_OOC(INODE))=NOT_USED
      IF(POSFAC_SOLVE(ZONE).EQ.IDEB_SOLVE_Z(ZONE))THEN
         POS_HOLE_B(ZONE)=-9999
         CURRENT_POS_B(ZONE)=-9999
         LRLU_SOLVE_B(ZONE)=0_8
      ENDIF
      IF(PTRFAC(STEP_OOC(INODE)).LT.IDEB_SOLVE_Z(ZONE))THEN
         WRITE(*,*)MYID_OOC,': Internal error (20) in OOC ',
     &                      ' Problem avec debut (2)',INODE,
     &              PTRFAC(STEP_OOC(INODE)),IDEB_SOLVE_Z(ZONE),ZONE
         CALL MUMPS_ABORT()
      ENDIF
      INODE_TO_POS(STEP_OOC(INODE))=CURRENT_POS_T(ZONE)
      POS_IN_MEM(CURRENT_POS_T(ZONE))=INODE
      IF(CURRENT_POS_T(ZONE).GT.(PDEB_SOLVE_Z(ZONE)+
     &     MAX_NB_NODES_FOR_ZONE-1))THEN
         WRITE(*,*)MYID_OOC,': Internal error (21) in OOC ',
     &                      ' Problem with CURRENT_POS_T',
     &        CURRENT_POS_T(ZONE),ZONE
         CALL MUMPS_ABORT()
      ENDIF
      CURRENT_POS_T(ZONE)=CURRENT_POS_T(ZONE)+1
      POS_HOLE_T(ZONE)=CURRENT_POS_T(ZONE)
      POS_HOLE_T(ZONE)=CURRENT_POS_T(ZONE)
      POSFAC_SOLVE(ZONE)=POSFAC_SOLVE(ZONE)+
     &     SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE)
      END SUBROUTINE ZMUMPS_SOLVE_ALLOC_PTR_UPD_T
      SUBROUTINE ZMUMPS_SOLVE_ALLOC_PTR_UPD_B(INODE,PTRFAC,
     &     KEEP,KEEP8,
     &     A,ZONE)
      IMPLICIT NONE
      INTEGER INODE,KEEP(500)
      INTEGER(8) KEEP8(150)
      INTEGER(8) :: PTRFAC(KEEP(28))
      COMPLEX(kind=8) A(FACT_AREA_SIZE)
      INTEGER ZONE
      IF(POS_HOLE_B(ZONE).EQ.-9999)THEN
         WRITE(*,*)MYID_OOC,': Internal error (22) in OOC ',
     &        ' ZMUMPS_SOLVE_ALLOC_PTR_UPD_B'
         CALL MUMPS_ABORT()
      ENDIF
      LRLUS_SOLVE(ZONE)=LRLUS_SOLVE(ZONE)-
     &     SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE)
      LRLU_SOLVE_B(ZONE)=LRLU_SOLVE_B(ZONE)-
     &        SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE)
      PTRFAC(STEP_OOC(INODE))=IDEB_SOLVE_Z(ZONE)+
     &     LRLU_SOLVE_B(ZONE)
      OOC_STATE_NODE(STEP_OOC(INODE))=NOT_USED
      IF(PTRFAC(STEP_OOC(INODE)).LT.IDEB_SOLVE_Z(ZONE))THEN
         WRITE(*,*)MYID_OOC,': Internal error (23) in OOC ',
     &              PTRFAC(STEP_OOC(INODE)),IDEB_SOLVE_Z(ZONE)
         CALL MUMPS_ABORT()
      ENDIF
      INODE_TO_POS(STEP_OOC(INODE))=CURRENT_POS_B(ZONE)
      IF(CURRENT_POS_B(ZONE).EQ.0)THEN
         WRITE(*,*)MYID_OOC,': Internal error (23b) in OOC '
         CALL MUMPS_ABORT()
      ENDIF
      POS_IN_MEM(CURRENT_POS_B(ZONE))=INODE
      CURRENT_POS_B(ZONE)=CURRENT_POS_B(ZONE)-1
      POS_HOLE_B(ZONE)=CURRENT_POS_B(ZONE)
      END SUBROUTINE ZMUMPS_SOLVE_ALLOC_PTR_UPD_B
      SUBROUTINE ZMUMPS_FREE_SPACE_FOR_SOLVE(A,LA,REQUESTED_SIZE,PTRFAC,
     &     NSTEPS,ZONE,IERR)
      IMPLICIT NONE
      INTEGER(8) :: LA, REQUESTED_SIZE
      INTEGER NSTEPS,ZONE
      INTEGER, intent(out) :: IERR
      INTEGER(8) :: PTRFAC(NSTEPS)
      COMPLEX(kind=8) A(LA)
      INTEGER (8) :: APOS_FIRST_FREE,
     &               SIZE_HOLE,
     &               FREE_HOLE,
     &               FREE_HOLE_POS
      INTEGER J,I,TMP_NODE, NB_FREE, IPOS_FIRST_FREE
      INTEGER(8) :: K8, AREA_POINTER
      INTEGER FREE_HOLE_FLAG
      IERR=0
      IF(LRLU_SOLVE_T(ZONE).EQ.SIZE_SOLVE_Z(ZONE))THEN
         RETURN
      ENDIF
      AREA_POINTER=IDEB_SOLVE_Z(ZONE)
      SIZE_HOLE=0_8
      DO I=PDEB_SOLVE_Z(ZONE),CURRENT_POS_T(ZONE)-1
         IF((POS_IN_MEM(I).LE.0).AND.
     &        (POS_IN_MEM(I).GT.-((N_OOC+1)*NB_Z))) GOTO 666
         TMP_NODE=abs(POS_IN_MEM(I))
         IF(TMP_NODE.GT.((N_OOC+1)*NB_Z))THEN
            TMP_NODE=TMP_NODE-((N_OOC+1)*NB_Z)
         ENDIF
         AREA_POINTER=AREA_POINTER+
     &        abs(SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE))
      ENDDO
 666  CONTINUE
      IF((I.EQ.CURRENT_POS_T(ZONE)-1).AND.
     &     (PDEB_SOLVE_Z(ZONE).NE.CURRENT_POS_T(ZONE)-1))THEN
         IF((POS_IN_MEM(I).GT.0).OR.
     &        (POS_IN_MEM(I).LT.-((N_OOC+1)*NB_Z)))THEN
            WRITE(*,*)MYID_OOC,': Internal error (25) in OOC ',
     &                      ': There are no free blocks ',
     &         'in ZMUMPS_FREE_SPACE_FOR_SOLVE',PDEB_SOLVE_Z(ZONE),
     &           CURRENT_POS_T(ZONE)
            CALL MUMPS_ABORT()
         ENDIF
      ENDIF
      IF(POS_IN_MEM(I).EQ.0)THEN
         APOS_FIRST_FREE=AREA_POINTER
         FREE_HOLE_POS=AREA_POINTER
      ELSE
         TMP_NODE=abs(POS_IN_MEM(I))
         APOS_FIRST_FREE=abs(PTRFAC(STEP_OOC(TMP_NODE)))
      ENDIF
      IF(POS_IN_MEM(PDEB_SOLVE_Z(ZONE)).NE.0)THEN
         IF(POS_IN_MEM(PDEB_SOLVE_Z(ZONE)).LT.-((N_OOC+1)*NB_Z))THEN
            TMP_NODE=abs(POS_IN_MEM(PDEB_SOLVE_Z(ZONE)))-
     &           ((N_OOC+1)*NB_Z)
            CALL MUMPS_WAIT_REQUEST(IO_REQ(STEP_OOC(TMP_NODE)),IERR)
            IF(IERR.LT.0)THEN
               RETURN
            ENDIF
            REQ_ACT=REQ_ACT-1
            CALL ZMUMPS_SOLVE_UPDATE_POINTERS(
     &           IO_REQ(STEP_OOC(TMP_NODE)),PTRFAC,NSTEPS)
         ELSE
            TMP_NODE=abs(POS_IN_MEM(PDEB_SOLVE_Z(ZONE)))            
         ENDIF
         IF(abs(PTRFAC(STEP_OOC(TMP_NODE))).NE.IDEB_SOLVE_Z(ZONE))THEN
            IF((POS_IN_MEM(I).NE.0).OR.(I.EQ.CURRENT_POS_T(ZONE)))THEN
               SIZE_HOLE=abs(PTRFAC(STEP_OOC(TMP_NODE)))-
     &              IDEB_SOLVE_Z(ZONE)
            ENDIF
            APOS_FIRST_FREE=IDEB_SOLVE_Z(ZONE)
            IF(POS_IN_MEM(PDEB_SOLVE_Z(ZONE)).GT.0)THEN
               DO J=PDEB_SOLVE_Z(ZONE),I-1
                  TMP_NODE=POS_IN_MEM(J)
                  IF(TMP_NODE.LE.0)THEN
                     IF(TMP_NODE.LT.-((N_OOC+1)*NB_Z))THEN
                        TMP_NODE=abs(POS_IN_MEM(J))-((N_OOC+1)*NB_Z)
                        CALL MUMPS_WAIT_REQUEST(
     &                       IO_REQ(STEP_OOC(TMP_NODE)),IERR)
                        IF(IERR.LT.0)THEN
                           RETURN
                        ENDIF
                        REQ_ACT=REQ_ACT-1
                        CALL ZMUMPS_SOLVE_UPDATE_POINTERS(
     &                       IO_REQ(STEP_OOC(TMP_NODE)),PTRFAC,NSTEPS)
                        TMP_NODE=POS_IN_MEM(J)
                     ELSE
                    WRITE(*,*)MYID_OOC,': Internal error (26) in OOC ',
     &                      ' ZMUMPS_FREE_SPACE_FOR_SOLVE',TMP_NODE,
     &                       J,I-1,(N_OOC+1)*NB_Z
                    CALL MUMPS_ABORT()
                     ENDIF
                  ENDIF
                  DO K8=1_8,
     &                  SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE)
                     A(APOS_FIRST_FREE+K8-1_8)=
     &                    A(PTRFAC(STEP_OOC(TMP_NODE))+K8-1_8)
                  ENDDO
                  PTRFAC(STEP_OOC(TMP_NODE))=APOS_FIRST_FREE
                  APOS_FIRST_FREE=APOS_FIRST_FREE+
     &                 SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE)
               ENDDO
            ENDIF
         ENDIF
      ENDIF
      NB_FREE=0
      FREE_HOLE=0_8
      FREE_HOLE_FLAG=0
      DO J=I,CURRENT_POS_T(ZONE)-1
         TMP_NODE=abs(POS_IN_MEM(J))
         IF(POS_IN_MEM(J).LT.-((N_OOC+1)*NB_Z))THEN               
            TMP_NODE=TMP_NODE-((N_OOC+1)*NB_Z)
            CALL MUMPS_WAIT_REQUEST(IO_REQ(STEP_OOC(TMP_NODE)),IERR)
            IF(IERR.LT.0)THEN
               RETURN
            ENDIF
            REQ_ACT=REQ_ACT-1
            CALL ZMUMPS_SOLVE_UPDATE_POINTERS(
     &           IO_REQ(STEP_OOC(TMP_NODE)),PTRFAC,NSTEPS)
            TMP_NODE=abs(POS_IN_MEM(J))
         ENDIF
         IF(POS_IN_MEM(J).GT.0)THEN
            DO K8=1_8,SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE)
               A(APOS_FIRST_FREE+K8-1_8)=
     &         A(PTRFAC(STEP_OOC(TMP_NODE))+K8-1_8)
            ENDDO
            IF(FREE_HOLE_FLAG.EQ.1)THEN
               FREE_HOLE=abs(PTRFAC(STEP_OOC(TMP_NODE)))-
     &              FREE_HOLE_POS
               FREE_HOLE_FLAG=0
               SIZE_HOLE=SIZE_HOLE+FREE_HOLE
            ENDIF
            FREE_HOLE_POS=abs(PTRFAC(STEP_OOC(TMP_NODE)))+
     &           SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE)
            PTRFAC(STEP_OOC(TMP_NODE))=APOS_FIRST_FREE
            APOS_FIRST_FREE=APOS_FIRST_FREE+
     &           SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE)
         ELSEIF(POS_IN_MEM(J).EQ.0)THEN
            FREE_HOLE_FLAG=1
            NB_FREE=NB_FREE+1
         ELSE                   
            NB_FREE=NB_FREE+1
            IF(FREE_HOLE_FLAG.EQ.1)THEN
               FREE_HOLE=abs(PTRFAC(STEP_OOC(TMP_NODE)))-
     &              FREE_HOLE_POS
               FREE_HOLE_FLAG=0
               SIZE_HOLE=SIZE_HOLE+FREE_HOLE
            ENDIF
            FREE_HOLE_POS=abs(PTRFAC(STEP_OOC(TMP_NODE)))+
     &           SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE)
            SIZE_HOLE=SIZE_HOLE+SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),
     &           OOC_FCT_TYPE)
            PTRFAC(STEP_OOC(abs(POS_IN_MEM(J))))=-77777_8
         ENDIF
      ENDDO
      IF(FREE_HOLE_FLAG.EQ.1)THEN
         FREE_HOLE=POSFAC_SOLVE(ZONE)-FREE_HOLE_POS
         FREE_HOLE_FLAG=0
         SIZE_HOLE=SIZE_HOLE+FREE_HOLE
      ENDIF
      IPOS_FIRST_FREE=I
      DO J=I,CURRENT_POS_T(ZONE)-1
         IF(POS_IN_MEM(J).LT.0)THEN
            TMP_NODE=abs(POS_IN_MEM(J))
            INODE_TO_POS(STEP_OOC(TMP_NODE))=0
            POS_IN_MEM(J)=0
            OOC_STATE_NODE(STEP_OOC(TMP_NODE))=ALREADY_USED
          ELSEIF(POS_IN_MEM(J).GT.0)THEN
             TMP_NODE=abs(POS_IN_MEM(J))
             POS_IN_MEM(IPOS_FIRST_FREE)=POS_IN_MEM(J)
             INODE_TO_POS(STEP_OOC(TMP_NODE))=IPOS_FIRST_FREE
             IPOS_FIRST_FREE=IPOS_FIRST_FREE+1
         ENDIF
      ENDDO
      LRLU_SOLVE_T(ZONE)=LRLU_SOLVE_T(ZONE)+SIZE_HOLE
      POSFAC_SOLVE(ZONE)=POSFAC_SOLVE(ZONE)-SIZE_HOLE
      CURRENT_POS_T(ZONE)=CURRENT_POS_T(ZONE)-NB_FREE
      POS_HOLE_T(ZONE)=CURRENT_POS_T(ZONE)
      LRLU_SOLVE_B(ZONE)=0_8
      POS_HOLE_B(ZONE)=-9999
      CURRENT_POS_B(ZONE)=-9999
      LRLU_SOLVE_B(ZONE)=0_8
      IF(LRLU_SOLVE_T(ZONE).NE.LRLUS_SOLVE(ZONE))THEN
         WRITE(*,*)MYID_OOC,': Internal error (27) in OOC ',
     &                 LRLU_SOLVE_T(ZONE),
     &                 LRLUS_SOLVE(ZONE)
         CALL MUMPS_ABORT()
      ENDIF
      LRLU_SOLVE_T(ZONE)=LRLUS_SOLVE(ZONE)
      IF(LRLUS_SOLVE(ZONE).LT.0_8)THEN
         WRITE(*,*)MYID_OOC,': Internal error (28) in OOC ',
     &                      ' LRLUS_SOLVE must be (4) > 0'
         CALL MUMPS_ABORT()
      ENDIF
      IF(POSFAC_SOLVE(ZONE).LT.IDEB_SOLVE_Z(ZONE))THEN
         WRITE(*,*)MYID_OOC,': Internal error (29) in OOC ',
     &        POSFAC_SOLVE(ZONE),IDEB_SOLVE_Z(ZONE)
         CALL MUMPS_ABORT()
      ENDIF
      IF(POSFAC_SOLVE(ZONE).NE.(IDEB_SOLVE_Z(ZONE)+SIZE_SOLVE_Z(ZONE)-
     &     LRLUS_SOLVE(ZONE)))THEN
         WRITE(*,*)MYID_OOC,': Internal error (30) in OOC ',
     &                      ' Problem avec debut POSFAC_SOLVE',
     &        POSFAC_SOLVE(ZONE),(SIZE_SOLVE_Z(ZONE)-
     &     LRLUS_SOLVE(ZONE))+IDEB_SOLVE_Z(ZONE),LRLUS_SOLVE(ZONE)
         CALL MUMPS_ABORT()
      ENDIF
      IF(POSFAC_SOLVE(ZONE).GT.
     &     (IDEB_SOLVE_Z(ZONE)+SIZE_SOLVE_Z(ZONE)-1_8))THEN
         WRITE(*,*)MYID_OOC,': Internal error (31) in OOC ',
     &        POSFAC_SOLVE(ZONE),IDEB_SOLVE_Z(ZONE)+
     &        SIZE_SOLVE_Z(ZONE)-1_8
         CALL MUMPS_ABORT()
      ENDIF
      RETURN
      END SUBROUTINE ZMUMPS_FREE_SPACE_FOR_SOLVE
      SUBROUTINE ZMUMPS_OOC_UPDATE_SOLVE_STAT(INODE,PTRFAC,NSTEPS,FLAG)
      IMPLICIT NONE
      INTEGER INODE,NSTEPS,FLAG
      INTEGER (8) :: PTRFAC(NSTEPS)
      INTEGER ZONE
      IF((FLAG.LT.0).OR.(FLAG.GT.1))THEN
         WRITE(*,*)MYID_OOC,': Internal error (32) in OOC ',
     &        ' ZMUMPS_OOC_UPDATE_SOLVE_STAT'
         CALL MUMPS_ABORT()
      ENDIF
      CALL ZMUMPS_SEARCH_SOLVE(PTRFAC(STEP_OOC(INODE)),ZONE)
      IF(LRLUS_SOLVE(ZONE).LT.0_8)THEN
         WRITE(*,*)MYID_OOC,': Internal error (33) in OOC ',
     &        ' LRLUS_SOLVE must be (5) ++ > 0'
         CALL MUMPS_ABORT()
      ENDIF      
      IF(FLAG.EQ.0)THEN
         LRLUS_SOLVE(ZONE)=LRLUS_SOLVE(ZONE)+
     &        SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE)
      ELSE
         LRLUS_SOLVE(ZONE)=LRLUS_SOLVE(ZONE)-
     &        SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE)         
      ENDIF
      IF(LRLUS_SOLVE(ZONE).LT.0_8)THEN
         WRITE(*,*)MYID_OOC,': Internal error (34) in OOC ',
     &                      ' LRLUS_SOLVE must be (5) > 0'
         CALL MUMPS_ABORT()
      ENDIF
      END SUBROUTINE ZMUMPS_OOC_UPDATE_SOLVE_STAT
      SUBROUTINE ZMUMPS_SEARCH_SOLVE(ADDR,ZONE)
      IMPLICIT NONE
      INTEGER (8) :: ADDR
      INTEGER ZONE
      INTEGER I
      I=1
      DO WHILE (I.LE.NB_Z)
         IF(ADDR.LT.IDEB_SOLVE_Z(I))THEN
            EXIT
         ENDIF
         I=I+1
      ENDDO
      ZONE=I-1
      END SUBROUTINE ZMUMPS_SEARCH_SOLVE
      FUNCTION ZMUMPS_SOLVE_IS_END_REACHED()
      IMPLICIT NONE
      LOGICAL ZMUMPS_SOLVE_IS_END_REACHED
      ZMUMPS_SOLVE_IS_END_REACHED=.FALSE.
      IF(SOLVE_STEP.EQ.0)THEN
         IF(CUR_POS_SEQUENCE.GT.TOTAL_NB_OOC_NODES(OOC_FCT_TYPE))THEN
            ZMUMPS_SOLVE_IS_END_REACHED=.TRUE.
         ENDIF
      ELSEIF(SOLVE_STEP.EQ.1)THEN
         IF(CUR_POS_SEQUENCE.LT.1)THEN
            ZMUMPS_SOLVE_IS_END_REACHED=.TRUE.
         ENDIF
      ENDIF
      RETURN
      END FUNCTION ZMUMPS_SOLVE_IS_END_REACHED
      SUBROUTINE ZMUMPS_SOLVE_ZONE_READ(ZONE,A,LA,PTRFAC,NSTEPS,IERR)
      IMPLICIT NONE
      INTEGER NSTEPS,ZONE
      INTEGER(8), INTENT(IN) :: LA
      INTEGER, intent(out) :: IERR
      COMPLEX(kind=8) A(LA)
      INTEGER(8) :: PTRFAC(NSTEPS)
      INTEGER(8) :: SIZE, DEST
      INTEGER(8) :: NEEDED_SIZE
      INTEGER FLAG,TMP_FLAG,POS_SEQ,TMP_NODE,
     &     NB_NODES
      IERR=0
      TMP_FLAG=0
      FLAG=0
      IF(ZMUMPS_SOLVE_IS_END_REACHED())THEN
         RETURN
      ENDIF      
      IF(SOLVE_STEP.EQ.0)THEN
         IF(CUR_POS_SEQUENCE.LE.TOTAL_NB_OOC_NODES(OOC_FCT_TYPE))THEN
            TMP_NODE=OOC_INODE_SEQUENCE(CUR_POS_SEQUENCE,
     &           OOC_FCT_TYPE)
            DO WHILE(SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE).GT.
     &           SIZE_SOLVE_Z(ZONE))
               CUR_POS_SEQUENCE=CUR_POS_SEQUENCE+1
               IF(ZMUMPS_SOLVE_IS_END_REACHED())THEN
                  RETURN
               ENDIF            
               TMP_NODE=OOC_INODE_SEQUENCE(CUR_POS_SEQUENCE,
     &              OOC_FCT_TYPE)
            ENDDO
            CALL ZMUMPS_OOC_SKIP_NULL_SIZE_NODE()      
            NEEDED_SIZE=max(MIN_SIZE_READ,
     &           SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE))
         ELSE
            NEEDED_SIZE=MIN_SIZE_READ
         ENDIF
      ELSEIF(SOLVE_STEP.EQ.1)THEN
         IF(CUR_POS_SEQUENCE.GE.1)THEN
            TMP_NODE=OOC_INODE_SEQUENCE(CUR_POS_SEQUENCE,
     &           OOC_FCT_TYPE)
            DO WHILE(SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE).GT.
     &           SIZE_SOLVE_Z(ZONE))
               CUR_POS_SEQUENCE=CUR_POS_SEQUENCE-1
               IF(ZMUMPS_SOLVE_IS_END_REACHED())THEN
                  RETURN
               ENDIF              
               TMP_NODE=OOC_INODE_SEQUENCE(CUR_POS_SEQUENCE,
     &              OOC_FCT_TYPE)
            ENDDO  
            CALL ZMUMPS_OOC_SKIP_NULL_SIZE_NODE()      
            NEEDED_SIZE=max(MIN_SIZE_READ,
     &           SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE))
         ELSE
            NEEDED_SIZE=MIN_SIZE_READ
         ENDIF
      ENDIF
      IF(LRLUS_SOLVE(ZONE).LT.NEEDED_SIZE)THEN
         RETURN
      ELSEIF((LRLU_SOLVE_T(ZONE).LT.NEEDED_SIZE).AND.
     &        (LRLU_SOLVE_B(ZONE).LT.NEEDED_SIZE).AND.
     &        (dble(LRLUS_SOLVE(ZONE)).LT.0.3d0*
     &         dble(SIZE_SOLVE_Z(ZONE)))) THEN
         RETURN
      ENDIF
      IF((LRLU_SOLVE_T(ZONE).GT.NEEDED_SIZE).AND.(SOLVE_STEP.EQ.0).AND.
     &     ((CURRENT_POS_T(ZONE)-PDEB_SOLVE_Z(ZONE)+1).LT.
     &     MAX_NB_NODES_FOR_ZONE))THEN
         FLAG=1
      ELSE
         IF(SOLVE_STEP.EQ.0)THEN
            CALL ZMUMPS_GET_TOP_AREA_SPACE(A,FACT_AREA_SIZE,
     &           NEEDED_SIZE,PTRFAC,NSTEPS,ZONE,TMP_FLAG,IERR)
            IF(IERR.LT.0)THEN
               RETURN
            ENDIF
            FLAG=1
            IF(TMP_FLAG.EQ.0)THEN
               CALL ZMUMPS_GET_BOTTOM_AREA_SPACE(A,FACT_AREA_SIZE,
     &              NEEDED_SIZE,PTRFAC,NSTEPS,ZONE,TMP_FLAG,IERR)
               IF(IERR.LT.0)THEN
                  RETURN
               ENDIF
               FLAG=0
            ENDIF
         ELSE
            CALL ZMUMPS_GET_BOTTOM_AREA_SPACE(A,FACT_AREA_SIZE,
     &           NEEDED_SIZE,PTRFAC,NSTEPS,ZONE,TMP_FLAG,IERR)
            IF(IERR.LT.0)THEN
               RETURN
            ENDIF
            FLAG=0
            IF(TMP_FLAG.EQ.0)THEN
               CALL ZMUMPS_GET_TOP_AREA_SPACE(A,FACT_AREA_SIZE,
     &              NEEDED_SIZE,PTRFAC,NSTEPS,ZONE,TMP_FLAG,IERR)
               IF(IERR.LT.0)THEN
                  RETURN
               ENDIF
               FLAG=1
            ENDIF
         ENDIF
         IF(TMP_FLAG.EQ.0)THEN
            CALL ZMUMPS_FREE_SPACE_FOR_SOLVE(A,FACT_AREA_SIZE,
     &           NEEDED_SIZE,PTRFAC,NSTEPS,ZONE,IERR)
            IF(IERR.LT.0)THEN
               RETURN
            ENDIF
            FLAG=1
         ENDIF
      ENDIF
      CALL ZMUMPS_SOLVE_COMPUTE_READ_SIZE(ZONE,SIZE,DEST,POS_SEQ,
     &     NB_NODES,FLAG,PTRFAC,NSTEPS)
      IF(SIZE.EQ.0_8)THEN
         RETURN
      ENDIF
      NB_ZONE_REQ=NB_ZONE_REQ+1
      SIZE_ZONE_REQ=SIZE_ZONE_REQ+SIZE
      REQ_ACT=REQ_ACT+1
      CALL ZMUMPS_READ_SOLVE_BLOCK(A(DEST),DEST,SIZE,ZONE,PTRFAC,NSTEPS,
     &     POS_SEQ,NB_NODES,FLAG,IERR)
      IF(IERR.LT.0)THEN
         RETURN
      ENDIF
      END SUBROUTINE ZMUMPS_SOLVE_ZONE_READ
      SUBROUTINE ZMUMPS_SOLVE_COMPUTE_READ_SIZE(ZONE,SIZE,DEST,POS_SEQ,
     &     NB_NODES,FLAG,PTRFAC,NSTEPS)
      IMPLICIT NONE
      INTEGER(8) :: SIZE, DEST
      INTEGER ZONE,FLAG,POS_SEQ,NSTEPS
      INTEGER(8) :: PTRFAC(NSTEPS), MAX_SIZE, LAST, J8
      INTEGER I,START_NODE,K,MAX_NB,
     &     NB_NODES
      INTEGER NB_NODES_LOC
      LOGICAL ALREADY
      IF(ZMUMPS_SOLVE_IS_END_REACHED())THEN
         SIZE=0_8
         RETURN
      ENDIF
      IF(FLAG.EQ.0)THEN
         MAX_SIZE=LRLU_SOLVE_B(ZONE)
         MAX_NB=max(0,CURRENT_POS_B(ZONE)-PDEB_SOLVE_Z(ZONE)+1)
      ELSEIF(FLAG.EQ.1)THEN
         MAX_SIZE=LRLU_SOLVE_T(ZONE)
         MAX_NB=MAX_NB_NODES_FOR_ZONE
      ELSE
         WRITE(*,*)MYID_OOC,': Internal error (35) in OOC ',
     &                      ' Unknown Flag value in ',
     &         ' ZMUMPS_SOLVE_COMPUTE_READ_SIZE',FLAG
         CALL MUMPS_ABORT()
      ENDIF
      CALL ZMUMPS_OOC_SKIP_NULL_SIZE_NODE()
      I=CUR_POS_SEQUENCE
      START_NODE=OOC_INODE_SEQUENCE(I,OOC_FCT_TYPE)
      ALREADY=.FALSE.
      NB_NODES=0
      NB_NODES_LOC=0
      IF(ZONE.EQ.NB_Z)THEN
         SIZE=SIZE_OF_BLOCK(STEP_OOC(START_NODE),OOC_FCT_TYPE)
      ELSE
         J8=0_8
         IF(FLAG.EQ.0)THEN
            K=0
         ELSEIF(FLAG.EQ.1)THEN
            K=CURRENT_POS_T(ZONE)-PDEB_SOLVE_Z(ZONE)+1
         ENDIF
         IF(SOLVE_STEP.EQ.0)THEN
            I=CUR_POS_SEQUENCE
            DO WHILE(I.LE.TOTAL_NB_OOC_NODES(OOC_FCT_TYPE))
               IF(SIZE_OF_BLOCK(STEP_OOC(OOC_INODE_SEQUENCE(I,
     &              OOC_FCT_TYPE)),
     &              OOC_FCT_TYPE)
     &              .NE.0_8)THEN
                  EXIT
               ENDIF
               I=I+1
            ENDDO
            CUR_POS_SEQUENCE=min(I,TOTAL_NB_OOC_NODES(OOC_FCT_TYPE))
            I=CUR_POS_SEQUENCE
            DO WHILE((J8.LE.MAX_SIZE).AND.
     &           (I.LE.TOTAL_NB_OOC_NODES(OOC_FCT_TYPE)).AND.
     &           (K.LT.MAX_NB) )
               LAST=SIZE_OF_BLOCK(STEP_OOC(OOC_INODE_SEQUENCE(I,
     &              OOC_FCT_TYPE)),
     &              OOC_FCT_TYPE)
               IF(LAST.EQ.0_8)THEN
                  IF(.NOT.ALREADY)THEN
                     CUR_POS_SEQUENCE=CUR_POS_SEQUENCE+1
                  ENDIF
                  I=I+1
                  NB_NODES_LOC=NB_NODES_LOC+1
                  CYCLE
               ENDIF
               IF((INODE_TO_POS(STEP_OOC(OOC_INODE_SEQUENCE(I,
     &              OOC_FCT_TYPE)))
     &              .NE.0).OR.
     &              (IO_REQ(STEP_OOC(OOC_INODE_SEQUENCE(I,
     &              OOC_FCT_TYPE))).GE.
     &              0))THEN
                  IF(.NOT.ALREADY)THEN
                     CUR_POS_SEQUENCE=CUR_POS_SEQUENCE+1
                     I=I+1
                     CYCLE
                  ELSE
                     EXIT
                  ENDIF
               ENDIF
               ALREADY=.TRUE.
               J8=J8+LAST
               I=I+1
               K=K+1
               NB_NODES_LOC=NB_NODES_LOC+1
               NB_NODES=NB_NODES+1
            ENDDO
            IF(J8.GT.MAX_SIZE)THEN
               SIZE=J8-LAST
               NB_NODES=NB_NODES-1
               NB_NODES_LOC=NB_NODES_LOC-1
            ELSE
               SIZE=J8
            ENDIF
            DO WHILE (CUR_POS_SEQUENCE+NB_NODES_LOC-1.GE.
     &                             CUR_POS_SEQUENCE)
               IF(SIZE_OF_BLOCK(STEP_OOC(
     &              OOC_INODE_SEQUENCE(CUR_POS_SEQUENCE+NB_NODES-1,
     &              OOC_FCT_TYPE)),
     &              OOC_FCT_TYPE)
     &              .NE.0_8)THEN
                  EXIT
               ENDIF
               NB_NODES_LOC=NB_NODES_LOC-1
            ENDDO
            POS_SEQ=CUR_POS_SEQUENCE
         ELSEIF(SOLVE_STEP.EQ.1)THEN
            DO WHILE(I.GE.1)
               IF(SIZE_OF_BLOCK(STEP_OOC(OOC_INODE_SEQUENCE(I,
     &              OOC_FCT_TYPE)),
     &              OOC_FCT_TYPE)
     &              .NE.0_8)THEN
                  EXIT
               ENDIF
               I=I-1
            ENDDO
            CUR_POS_SEQUENCE=max(I,1)
            I=CUR_POS_SEQUENCE
            DO WHILE((J8.LE.MAX_SIZE).AND.(I.GE.1).AND.
     &           (K.LT.MAX_NB))
               LAST=SIZE_OF_BLOCK(STEP_OOC(OOC_INODE_SEQUENCE(I,
     &              OOC_FCT_TYPE)),
     &              OOC_FCT_TYPE)
               IF(LAST.EQ.0_8)THEN
                  IF(.NOT.ALREADY)THEN
                     CUR_POS_SEQUENCE=CUR_POS_SEQUENCE-1
                  ENDIF
                  NB_NODES_LOC=NB_NODES_LOC+1
                  I=I-1
                  CYCLE
               ENDIF
               IF((INODE_TO_POS(STEP_OOC(OOC_INODE_SEQUENCE(I,
     &              OOC_FCT_TYPE)))
     &              .NE.0).OR.
     &              (IO_REQ(STEP_OOC(OOC_INODE_SEQUENCE(I,
     &              OOC_FCT_TYPE))).GE.
     &              0))THEN
                  IF(.NOT.ALREADY)THEN
                     I=I-1
                     CUR_POS_SEQUENCE=CUR_POS_SEQUENCE-1
                     CYCLE
                  ELSE
                     EXIT
                  ENDIF
               ENDIF
               ALREADY=.TRUE.
               J8=J8+LAST
               I=I-1
               K=K+1
               NB_NODES=NB_NODES+1
               NB_NODES_LOC=NB_NODES_LOC+1
            ENDDO
            IF(J8.GT.MAX_SIZE)THEN
               SIZE=J8-LAST
               NB_NODES=NB_NODES-1
               NB_NODES_LOC=NB_NODES_LOC-1
            ELSE
               SIZE=J8
            ENDIF
            I=CUR_POS_SEQUENCE-NB_NODES_LOC+1
            DO WHILE (I.LE.CUR_POS_SEQUENCE)
               IF(SIZE_OF_BLOCK(STEP_OOC(
     &              OOC_INODE_SEQUENCE(I,OOC_FCT_TYPE)),
     &              OOC_FCT_TYPE).NE.0_8)THEN
                  EXIT
               ENDIF
               I=I+1
               NB_NODES_LOC=NB_NODES_LOC-1
            ENDDO
            POS_SEQ=CUR_POS_SEQUENCE-NB_NODES_LOC+1
         ENDIF
      ENDIF
      IF(FLAG.EQ.0)THEN
         DEST=IDEB_SOLVE_Z(ZONE)+LRLU_SOLVE_B(ZONE)-SIZE
      ELSE
         DEST=POSFAC_SOLVE(ZONE)
      ENDIF
      END SUBROUTINE ZMUMPS_SOLVE_COMPUTE_READ_SIZE
      SUBROUTINE ZMUMPS_OOC_END_SOLVE(IERR)
      IMPLICIT NONE
      INTEGER SOLVE_OR_FACTO
      INTEGER, intent(out) :: IERR
      IERR=0
      IF(allocated(LRLUS_SOLVE))THEN
         DEALLOCATE(LRLUS_SOLVE)
      ENDIF
      IF(allocated(LRLU_SOLVE_T))THEN
         DEALLOCATE(LRLU_SOLVE_T)
      ENDIF
      IF(allocated(LRLU_SOLVE_B))THEN
         DEALLOCATE(LRLU_SOLVE_B)
      ENDIF
      IF(allocated(POSFAC_SOLVE))THEN
         DEALLOCATE(POSFAC_SOLVE)
      ENDIF
      IF(allocated(IDEB_SOLVE_Z))THEN
         DEALLOCATE(IDEB_SOLVE_Z)
      ENDIF
      IF(allocated(PDEB_SOLVE_Z))THEN
         DEALLOCATE(PDEB_SOLVE_Z)
      ENDIF
      IF(allocated(SIZE_SOLVE_Z))THEN
         DEALLOCATE(SIZE_SOLVE_Z)
      ENDIF
      IF(allocated(CURRENT_POS_T))THEN
         DEALLOCATE(CURRENT_POS_T)
      ENDIF
      IF(allocated(CURRENT_POS_B))THEN
         DEALLOCATE(CURRENT_POS_B)
      ENDIF
      IF(allocated(POS_HOLE_T))THEN
         DEALLOCATE(POS_HOLE_T)
      ENDIF
      IF(allocated(POS_HOLE_B))THEN
         DEALLOCATE(POS_HOLE_B)
      ENDIF
      IF(allocated(OOC_STATE_NODE))THEN
         DEALLOCATE(OOC_STATE_NODE)
      ENDIF
      IF(allocated(POS_IN_MEM))THEN
         DEALLOCATE(POS_IN_MEM)
      ENDIF
      IF(allocated(INODE_TO_POS))THEN
         DEALLOCATE(INODE_TO_POS)
      ENDIF
      IF(allocated(IO_REQ))THEN
         DEALLOCATE(IO_REQ)
      ENDIF
      IF(allocated(SIZE_OF_READ))THEN
         DEALLOCATE(SIZE_OF_READ)
      ENDIF
      IF(allocated(FIRST_POS_IN_READ))THEN
         DEALLOCATE(FIRST_POS_IN_READ)
      ENDIF
      IF(allocated(READ_DEST))THEN
         DEALLOCATE(READ_DEST)
      ENDIF
      IF(allocated(READ_MNG))THEN
         DEALLOCATE(READ_MNG)
      ENDIF
      IF(allocated(REQ_TO_ZONE))THEN
         DEALLOCATE(REQ_TO_ZONE)
      ENDIF
      IF(allocated(REQ_ID))THEN
         DEALLOCATE(REQ_ID)
      ENDIF
      SOLVE_OR_FACTO=1
      CALL MUMPS_CLEAN_IO_DATA_C(MYID_OOC,SOLVE_OR_FACTO,IERR)
      IF(IERR.LT.0)THEN
         IF (ICNTL1.GT.0)
     &   WRITE(ICNTL1,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC)
         RETURN
      ENDIF
      END SUBROUTINE ZMUMPS_OOC_END_SOLVE
      SUBROUTINE ZMUMPS_SOLVE_PREPARE_PREF(PTRFAC,NSTEPS, 
     &            A,LA)
      IMPLICIT NONE
      INTEGER, INTENT(in)       :: NSTEPS
      INTEGER(8), INTENT(INOUT) :: PTRFAC(NSTEPS)
      INTEGER(8), INTENT(IN)    :: LA 
      COMPLEX(kind=8)                   :: A(LA)
      INTEGER    :: I, TMP, ZONE, IPAS, IBEG, IEND
      INTEGER(8) :: SAVE_PTR
      LOGICAL    :: COMPRESS_TO_BE_DONE, SET_POS_SEQUENCE
      INTEGER    :: J, IERR
      INTEGER(8) :: DUMMY_SIZE
      COMPRESS_TO_BE_DONE         = .FALSE. 
      DUMMY_SIZE                  = 1_8
      IERR                        = 0   
      SET_POS_SEQUENCE            = .TRUE.
      IF(SOLVE_STEP.EQ.0)THEN
        IBEG = 1
        IEND = TOTAL_NB_OOC_NODES(OOC_FCT_TYPE)
        IPAS = 1
      ELSE
        IBEG = TOTAL_NB_OOC_NODES(OOC_FCT_TYPE)
        IEND = 1
        IPAS = -1
      ENDIF
      DO I=IBEG,IEND,IPAS
            J = OOC_INODE_SEQUENCE(I,OOC_FCT_TYPE)
            TMP=INODE_TO_POS(STEP_OOC(J))
            IF(TMP.EQ.0)THEN
               IF (SET_POS_SEQUENCE) THEN
                 SET_POS_SEQUENCE = .FALSE.
                 CUR_POS_SEQUENCE = I
               ENDIF
               IF (KEEP_OOC(237).EQ.0 .AND. KEEP_OOC(235).EQ.0) THEN
                 OOC_STATE_NODE(STEP_OOC(J)) = NOT_IN_MEM
               ENDIF
               CYCLE
            ELSE IF(TMP.LT.0)THEN
               IF(TMP.GT.-(N_OOC+1)*NB_Z)THEN
                  SAVE_PTR=PTRFAC(STEP_OOC(J))
                  PTRFAC(STEP_OOC(J)) = abs(SAVE_PTR)
                  CALL ZMUMPS_SOLVE_FIND_ZONE(J,
     &                 ZONE,PTRFAC,NSTEPS)
                  PTRFAC(STEP_OOC(J)) = SAVE_PTR
                  IF(ZONE.EQ.NB_Z)THEN
                     IF(J.NE.SPECIAL_ROOT_NODE)THEN
                        WRITE(*,*)MYID_OOC,': Internal error 6 ', 
     &                       ' Node ', J, 
     &                       ' is in status USED in the
     &                        emmergency buffer '
                        CALL MUMPS_ABORT()
                     ENDIF                     
                  ENDIF
                 IF (KEEP_OOC(237).NE.0 .OR. KEEP_OOC(235).NE.0) 
     &              THEN
                  IF (OOC_STATE_NODE(STEP_OOC(J)).EQ.NOT_IN_MEM) THEN
                     OOC_STATE_NODE(STEP_OOC(J)) = USED
                     IF((SOLVE_STEP.NE.0).AND.(J.NE.SPECIAL_ROOT_NODE)
     &                    .AND.(ZONE.NE.NB_Z))THEN
                        CALL ZMUMPS_SOLVE_UPD_NODE_INFO(J,PTRFAC,NSTEPS)
                     ENDIF
                     CYCLE
                  ELSEIF(OOC_STATE_NODE(STEP_OOC(J)).EQ.USED)
     &                    THEN
                    COMPRESS_TO_BE_DONE         = .TRUE.
                  ELSE
                    WRITE(*,*)MYID_OOC,': Internal error Mila 4 ', 
     &              ' wrong node status :', OOC_STATE_NODE(STEP_OOC(J)),
     &              ' on node ', J
                    CALL MUMPS_ABORT()
                  ENDIF
                 ENDIF
                 IF (KEEP_OOC(237).EQ.0 .AND. KEEP_OOC(235).EQ.0) THEN
                    CALL ZMUMPS_SOLVE_UPD_NODE_INFO(J,PTRFAC,NSTEPS)
                 ENDIF
               ENDIF
            ENDIF 
      ENDDO
         IF (KEEP_OOC(237).NE.0 .OR. KEEP_OOC(235).NE.0) 
     &      THEN
           IF (COMPRESS_TO_BE_DONE) THEN 
             DO ZONE=1,NB_Z-1
               CALL ZMUMPS_FREE_SPACE_FOR_SOLVE(A,LA,
     &         DUMMY_SIZE,PTRFAC,
     &         NSTEPS,ZONE,IERR)
               IF (IERR .LT. 0) THEN
                    WRITE(*,*)MYID_OOC,': Internal error Mila 5 ', 
     &              ' IERR on return to ZMUMPS_FREE_SPACE_FOR_SOLVE =', 
     &              IERR
                    CALL MUMPS_ABORT()
               ENDIF
             ENDDO
           ENDIF
         ENDIF
      RETURN
      END SUBROUTINE ZMUMPS_SOLVE_PREPARE_PREF
      SUBROUTINE ZMUMPS_SOLVE_INIT_OOC_FWD(PTRFAC,NSTEPS,MTYPE,
     &                                    A,LA,DOPREFETCH,IERR)
      IMPLICIT NONE
      INTEGER NSTEPS,MTYPE
      INTEGER, intent(out)::IERR
      INTEGER(8) :: LA
      COMPLEX(kind=8) A(LA)
      INTEGER(8) :: PTRFAC(NSTEPS)
      LOGICAL DOPREFETCH
      INTEGER MUMPS_OOC_GET_FCT_TYPE
      EXTERNAL MUMPS_OOC_GET_FCT_TYPE
      IERR = 0
      OOC_FCT_TYPE=MUMPS_OOC_GET_FCT_TYPE("F",MTYPE,KEEP_OOC(201),
     &                                    KEEP_OOC(50))
      OOC_SOLVE_TYPE_FCT = OOC_FCT_TYPE - 1
      IF (KEEP_OOC(201).NE.1) THEN
        OOC_SOLVE_TYPE_FCT = FCT
      ENDIF
      SOLVE_STEP=0
      CUR_POS_SEQUENCE=1
      MTYPE_OOC=MTYPE
      IF ( KEEP_OOC(201).NE.1 
     &  .OR. KEEP_OOC(50).NE.0
     &  ) THEN
        CALL ZMUMPS_SOLVE_PREPARE_PREF(PTRFAC,NSTEPS,A,LA)
      ELSE 
        CALL ZMUMPS_SOLVE_STAT_REINIT_PANEL(KEEP_OOC(28),
     &              KEEP_OOC(38), KEEP_OOC(20) )
      ENDIF
      IF (DOPREFETCH) THEN 
          CALL ZMUMPS_INITIATE_READ_OPS(A,LA,PTRFAC,
     &                                 KEEP_OOC(28),IERR)
      ELSE
          CUR_POS_SEQUENCE = TOTAL_NB_OOC_NODES(OOC_FCT_TYPE)
      ENDIF
      RETURN
      END SUBROUTINE ZMUMPS_SOLVE_INIT_OOC_FWD
      SUBROUTINE ZMUMPS_SOLVE_INIT_OOC_BWD(PTRFAC,NSTEPS,MTYPE,
     &           I_WORKED_ON_ROOT,IROOT,A,LA,IERR)
      IMPLICIT NONE
      INTEGER NSTEPS
      INTEGER(8) :: LA
      INTEGER(8) :: PTRFAC(NSTEPS)
      INTEGER MTYPE
      INTEGER IROOT
      LOGICAL I_WORKED_ON_ROOT
      INTEGER, intent(out):: IERR
      COMPLEX(kind=8) A(LA)
      INTEGER(8) :: DUMMY_SIZE
      INTEGER ZONE
      INTEGER MUMPS_OOC_GET_FCT_TYPE
      EXTERNAL MUMPS_OOC_GET_FCT_TYPE
      IERR=0
      OOC_FCT_TYPE=MUMPS_OOC_GET_FCT_TYPE("B",MTYPE,KEEP_OOC(201),
     &                                    KEEP_OOC(50))
      OOC_SOLVE_TYPE_FCT = OOC_FCT_TYPE - 1
      IF (KEEP_OOC(201).NE.1) OOC_SOLVE_TYPE_FCT=FCT  
      SOLVE_STEP=1
      CUR_POS_SEQUENCE=TOTAL_NB_OOC_NODES(OOC_FCT_TYPE)
      MTYPE_OOC=MTYPE
      IF ( KEEP_OOC(201).NE.1 
     &  .OR. KEEP_OOC(50).NE.0
     &  ) THEN
        CALL ZMUMPS_SOLVE_PREPARE_PREF(PTRFAC,NSTEPS,A,LA)
        IF (I_WORKED_ON_ROOT.AND.
     $       ((IROOT.GT.0)))THEN
           IF(SIZE_OF_BLOCK(STEP_OOC(IROOT),OOC_FCT_TYPE).NE.0) THEN
              IF (.NOT.(KEEP_OOC(237).NE.0 .OR. KEEP_OOC(235).NE.0)) 
     &             THEN
                 CALL ZMUMPS_FREE_FACTORS_FOR_SOLVE ( IROOT,
     &                PTRFAC, KEEP_OOC(28), A, LA,.FALSE.,IERR)
                 IF (IERR .LT. 0) RETURN
              ENDIF
              CALL ZMUMPS_SOLVE_FIND_ZONE(IROOT,
     &             ZONE,PTRFAC,NSTEPS)
              IF(ZONE.EQ.NB_Z)THEN
                 DUMMY_SIZE=1_8
                 CALL ZMUMPS_FREE_SPACE_FOR_SOLVE(A,LA,
     &                DUMMY_SIZE,PTRFAC,
     &                NSTEPS,NB_Z,IERR)
                 IF (IERR .LT. 0) THEN
                    WRITE(*,*)MYID_OOC,': Internal error in
     &                   ZMUMPS_FREE_SPACE_FOR_SOLVE', 
     &                   IERR
                    CALL MUMPS_ABORT()
                 ENDIF
              ENDIF
           ENDIF
        ENDIF
        IF (NB_Z.GT.1) THEN
          CALL ZMUMPS_SUBMIT_READ_FOR_Z(A,LA,PTRFAC,
     &                                  KEEP_OOC(28),IERR)
          IF (IERR .LT. 0) RETURN
        ENDIF
      ELSE 
        CALL ZMUMPS_SOLVE_STAT_REINIT_PANEL(KEEP_OOC(28),
     &              KEEP_OOC(38), KEEP_OOC(20) )
        CALL ZMUMPS_INITIATE_READ_OPS(A,LA,PTRFAC,KEEP_OOC(28),IERR)
        IF (IERR .LT. 0 ) RETURN
      ENDIF
      RETURN
      END SUBROUTINE ZMUMPS_SOLVE_INIT_OOC_BWD
      SUBROUTINE ZMUMPS_STRUC_STORE_FILE_NAME(id,IERR)
      USE ZMUMPS_STRUC_DEF
      IMPLICIT NONE
      TYPE(ZMUMPS_STRUC), TARGET :: id
      INTEGER, intent(out) :: IERR
      INTEGER I,DIM,J,TMP,SIZE,K,I1
      CHARACTER(len=1):: TMP_NAME(350)
      EXTERNAL MUMPS_OOC_GET_NB_FILES_C, MUMPS_OOC_GET_FILE_NAME_C
      IERR=0
      SIZE=0
      DO J=1,OOC_NB_FILE_TYPE
         TMP=J-1
         CALL MUMPS_OOC_GET_NB_FILES_C(TMP,I)
         id%OOC_NB_FILES(J)=I
         SIZE=SIZE+I
      ENDDO
      IF(associated(id%OOC_FILE_NAMES))THEN
         DEALLOCATE(id%OOC_FILE_NAMES)
         NULLIFY(id%OOC_FILE_NAMES)
      ENDIF
      ALLOCATE(id%OOC_FILE_NAMES(SIZE,350),stat=IERR)
      IF (IERR .GT. 0) THEN
         IF (ICNTL1.GT.0) THEN
            WRITE(ICNTL1,*) 'PB allocation in ',
     &           'ZMUMPS_STRUC_STORE_FILE_NAME'
         ENDIF
         IERR=-1
         IF(id%INFO(1).GE.0)THEN
            id%INFO(1) = -13
            id%INFO(2) = SIZE*350
            RETURN
         ENDIF
      ENDIF
      IF(associated(id%OOC_FILE_NAME_LENGTH))THEN
         DEALLOCATE(id%OOC_FILE_NAME_LENGTH)
         NULLIFY(id%OOC_FILE_NAME_LENGTH)
      ENDIF
      ALLOCATE(id%OOC_FILE_NAME_LENGTH(SIZE),stat=IERR)
      IF (IERR .GT. 0) THEN
         IERR=-1
         IF(id%INFO(1).GE.0) THEN
            IF (ICNTL1.GT.0) THEN
               WRITE(ICNTL1,*)
     &              'PB allocation in ZMUMPS_STRUC_STORE_FILE_NAME'
            ENDIF
            id%INFO(1) = -13
            id%INFO(2) = SIZE
            RETURN
         ENDIF
      ENDIF
      K=1
      DO I1=1,OOC_NB_FILE_TYPE
         TMP=I1-1
         DO I=1,id%OOC_NB_FILES(I1)
            CALL MUMPS_OOC_GET_FILE_NAME_C(TMP,I,DIM,TMP_NAME(1))
            DO J=1,DIM+1
               id%OOC_FILE_NAMES(K,J)=TMP_NAME(J)
            ENDDO
            id%OOC_FILE_NAME_LENGTH(K)=DIM+1
            K=K+1
         ENDDO
      ENDDO
      END SUBROUTINE ZMUMPS_STRUC_STORE_FILE_NAME
      SUBROUTINE ZMUMPS_OOC_OPEN_FILES_FOR_SOLVE(id)
      USE ZMUMPS_STRUC_DEF
      IMPLICIT NONE
      TYPE(ZMUMPS_STRUC), TARGET :: id
      CHARACTER(len=1):: TMP_NAME(350)
      INTEGER I,I1,TMP,J,K,L,DIM,IERR
      INTEGER, DIMENSION(:),ALLOCATABLE :: NB_FILES
      INTEGER K211
      ALLOCATE(NB_FILES(OOC_NB_FILE_TYPE),stat=IERR)
      IF (IERR .GT. 0) THEN
         IERR=-1
         IF(id%INFO(1).GE.0)THEN
            IF (ICNTL1.GT.0) THEN
               WRITE(ICNTL1,*)
     &              'PB allocation in ZMUMPS_OOC_OPEN_FILES_FOR_SOLVE'
            ENDIF
            id%INFO(1) = -13
            id%INFO(2) = OOC_NB_FILE_TYPE
            RETURN
         ENDIF
      ENDIF
      IERR=0
      NB_FILES=id%OOC_NB_FILES
      I=id%MYID
      K=id%KEEP(35)
      L=mod(id%KEEP(204),3)
      K211=id%KEEP(211)
      CALL MUMPS_OOC_ALLOC_POINTERS_C(OOC_NB_FILE_TYPE,NB_FILES,IERR)
      IF(IERR.LT.0)THEN
         IF (ICNTL1.GT.0)
     &   WRITE(ICNTL1,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC)
         id%INFO(1)=IERR
         RETURN
      ENDIF
      CALL MUMPS_OOC_INIT_VARS_C(I,K,L,K211,IERR)
      IF(IERR.LT.0)THEN
         IF (ICNTL1.GT.0)
     &   WRITE(ICNTL1,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC)
         id%INFO(1)=IERR
         RETURN
      ENDIF
      K=1
      DO I1=1,OOC_NB_FILE_TYPE
         DO I=1,NB_FILES(I1)
            DIM=id%OOC_FILE_NAME_LENGTH(K)
            DO J=1,DIM
               TMP_NAME(J)=id%OOC_FILE_NAMES(K,J)
            ENDDO
            TMP=I1-1
            CALL MUMPS_OOC_SET_FILE_NAME_C(TMP,I,DIM,IERR,TMP_NAME(1))
            IF(IERR.LT.0)THEN
               IF (ICNTL1.GT.0)
     &         WRITE(ICNTL1,*)MYID_OOC,': ',
     &         ERR_STR_OOC(1:DIM_ERR_STR_OOC)
               id%INFO(1)=IERR
               RETURN
            ENDIF
            K=K+1
         ENDDO
      ENDDO
      CALL MUMPS_OOC_START_LOW_LEVEL(IERR)
      IF(IERR.LT.0)THEN
         IF (ICNTL1.GT.0)
     &   WRITE(ICNTL1,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC)
         id%INFO(1)=IERR
         RETURN
      ENDIF
      DEALLOCATE(NB_FILES)
      RETURN
      END SUBROUTINE ZMUMPS_OOC_OPEN_FILES_FOR_SOLVE      
      SUBROUTINE ZMUMPS_CONVERT_STR_TO_CHR_ARRAY(DEST,SRC,NB,NB_EFF)
      IMPLICIT NONE
      INTEGER NB, NB_EFF
      CHARACTER(LEN=NB):: SRC
      CHARACTER(len=1):: DEST(NB)
      INTEGER I
      DO I=1,NB_EFF
         DEST(I)=SRC(I:I)
      ENDDO
      END SUBROUTINE ZMUMPS_CONVERT_STR_TO_CHR_ARRAY
      SUBROUTINE ZMUMPS_FORCE_WRITE_BUF(IERR)
      USE ZMUMPS_OOC_BUFFER
      IMPLICIT NONE
      INTEGER, intent(out) :: IERR
      IERR=0
      IF(.NOT.WITH_BUF)THEN
         RETURN
      ENDIF
      CALL ZMUMPS_OOC_DO_IO_AND_CHBUF(OOC_FCT_TYPE,IERR)
      IF (IERR < 0) THEN
        RETURN
      ENDIF
      RETURN
      END SUBROUTINE ZMUMPS_FORCE_WRITE_BUF
      SUBROUTINE ZMUMPS_OOC_FORCE_WRT_BUF_PANEL(IERR)
      USE ZMUMPS_OOC_BUFFER
      IMPLICIT NONE
      INTEGER, intent(out) :: IERR
      INTEGER I
      IERR=0
      IF(.NOT.WITH_BUF)THEN
         RETURN
      ENDIF
      DO I=1,OOC_NB_FILE_TYPE
         CALL ZMUMPS_OOC_DO_IO_AND_CHBUF(I,IERR)
         IF (IERR < 0) RETURN         
      ENDDO
      RETURN
      END SUBROUTINE ZMUMPS_OOC_FORCE_WRT_BUF_PANEL
       SUBROUTINE ZMUMPS_SOLVE_STAT_REINIT_PANEL(NSTEPS,
     &     KEEP38, KEEP20)
      IMPLICIT NONE
      INTEGER NSTEPS
      INTEGER I, J
      INTEGER(8) :: TMP_SIZE8
      INTEGER KEEP38, KEEP20
      INODE_TO_POS = 0
      POS_IN_MEM   = 0
      OOC_STATE_NODE(1:NSTEPS)=0
      TMP_SIZE8=1_8
      J=1
      DO I=1,NB_Z-1
         IDEB_SOLVE_Z(I)=TMP_SIZE8
         PDEB_SOLVE_Z(I)=J
         POSFAC_SOLVE(I)=TMP_SIZE8
         LRLUS_SOLVE(I) =SIZE_ZONE_SOLVE
         LRLU_SOLVE_T(I)=SIZE_ZONE_SOLVE
         LRLU_SOLVE_B(I)=0_8
         SIZE_SOLVE_Z(I)=SIZE_ZONE_SOLVE
         CURRENT_POS_T(I)=J
         CURRENT_POS_B(I)=J
         POS_HOLE_T(I)   =J
         POS_HOLE_B(I)   =J
         J = J + MAX_NB_NODES_FOR_ZONE
         TMP_SIZE8 = TMP_SIZE8 + SIZE_ZONE_SOLVE
      ENDDO
      IDEB_SOLVE_Z(NB_Z)=TMP_SIZE8
      PDEB_SOLVE_Z(NB_Z)=J
      POSFAC_SOLVE(NB_Z)=TMP_SIZE8
      LRLUS_SOLVE(NB_Z) =SIZE_SOLVE_EMM
      LRLU_SOLVE_T(NB_Z)=SIZE_SOLVE_EMM
      LRLU_SOLVE_B(NB_Z)=0_8
      SIZE_SOLVE_Z(NB_Z)=SIZE_SOLVE_EMM
      CURRENT_POS_T(NB_Z)=J
      CURRENT_POS_B(NB_Z)=J
      POS_HOLE_T(NB_Z)   =J
      POS_HOLE_B(NB_Z)   =J
      IO_REQ=-77777
      SIZE_OF_READ=-9999_8
      FIRST_POS_IN_READ=-9999
      READ_DEST=-9999_8
      READ_MNG=-9999
      REQ_TO_ZONE=-9999
      REQ_ID=-9999
      RETURN
      END SUBROUTINE ZMUMPS_SOLVE_STAT_REINIT_PANEL
      SUBROUTINE ZMUMPS_OOC_IO_LU_PANEL 
     &     ( STRAT, TYPEFile, 
     &     AFAC, LAFAC, MonBloc,
     &     LNextPiv2beWritten, UNextPiv2beWritten,
     &     IW, LIWFAC,
     &     MYID, FILESIZE, IERR , LAST_CALL)
      IMPLICIT NONE
      TYPE(IO_BLOCK), INTENT(INOUT):: MonBloc
      INTEGER(8) :: LAFAC
      INTEGER,        INTENT(IN)   :: STRAT, LIWFAC,
     &     MYID, TYPEFile
      INTEGER,   INTENT(INOUT)        :: IW(0:LIWFAC-1) 
      COMPLEX(kind=8), INTENT(IN) :: AFAC(LAFAC)
      INTEGER,   INTENT(INOUT) :: LNextPiv2beWritten, 
     &     UNextPiv2beWritten
      INTEGER(8), INTENT(INOUT) :: FILESIZE
      INTEGER,   INTENT(OUT) :: IERR
      LOGICAL,   INTENT(IN)  :: LAST_CALL
      INTEGER(8) :: TMPSIZE_OF_BLOCK
      INTEGER :: TempFTYPE
      LOGICAL WRITE_L, WRITE_U
      LOGICAL DO_U_FIRST
      INCLUDE 'mumps_headers.h'
      IERR = 0                  
      IF (KEEP_OOC(50).EQ.0 
     &         .AND.KEEP_OOC(251).EQ.2) THEN 
        WRITE_L = .FALSE.
      ELSE
        WRITE_L =  (TYPEFile.EQ.TYPEF_BOTH_LU .OR. TYPEFile.EQ.TYPEF_L)
      ENDIF
      WRITE_U =  (TYPEFile.EQ.TYPEF_BOTH_LU .OR. TYPEFile.EQ.TYPEF_U)
#if defined(_OPENMP)
      IF (KEEP_OOC(400).GT.0 .AND. KEEP_OOC(405) .GT. 0) THEN
        IF ( STRAT .EQ. STRAT_WRITE_MAX .OR. LAST_CALL ) THEN
          CALL OMP_SET_LOCK(LOCK_FOR_L0OMP)
#if defined(_WIN32)
        ELSE
#else
        ELSE IF ( .NOT. OMP_TEST_LOCK(LOCK_FOR_L0OMP ))  THEN
#endif
          RETURN
        ENDIF
      ENDIF
#endif
      DO_U_FIRST = .FALSE.
      IF ( TYPEFile.EQ.TYPEF_BOTH_LU ) THEN
         IF ( LNextPiv2beWritten .GT. UNextPiv2beWritten ) THEN
            DO_U_FIRST = .TRUE.
         END IF
      END IF
      IF (DO_U_FIRST) GOTO 200
 100  IF (WRITE_L .AND. TYPEF_L > 0 ) THEN
         TempFTYPE  = TYPEF_L
         IF ((MonBloc%Typenode.EQ.2).AND.(.NOT.MonBloc%MASTER)) 
     &        THEN
           TMPSIZE_OF_BLOCK = SIZE_OF_BLOCK(STEP_OOC(MonBloc%INODE),
     &                                      TempFTYPE)
           IF (TMPSIZE_OF_BLOCK .LT. 0_8) THEN
               TMPSIZE_OF_BLOCK = -TMPSIZE_OF_BLOCK - 1_8
           ENDIF
           LNextPiv2beWritten =
     &     int(
     &          TMPSIZE_OF_BLOCK
     &          / int(MonBloc%NROW,8)
     &        )
     &     + 1
         ENDIF
         CALL ZMUMPS_OOC_STORE_LorU( STRAT,
     &        TempFTYPE, AFAC, LAFAC, MonBloc,
     &        IERR,
     &        LNextPiv2beWritten, 
     &        OOC_VADDR(STEP_OOC(MonBloc%INODE),TempFTYPE),
     &        SIZE_OF_BLOCK(STEP_OOC(MonBloc%INODE),TempFTYPE),
     &        FILESIZE, LAST_CALL )
         IF (IERR .LT. 0) RETURN
         IF (DO_U_FIRST) GOTO 300
      ENDIF
 200  IF (WRITE_U) THEN
         TempFTYPE  = TYPEF_U
         CALL ZMUMPS_OOC_STORE_LorU( STRAT,
     &        TempFTYPE, AFAC, LAFAC, MonBloc,
     &        IERR,
     &        UNextPiv2beWritten,
     &        OOC_VADDR(STEP_OOC(MonBloc%INODE),TempFTYPE),
     &        SIZE_OF_BLOCK(STEP_OOC(MonBloc%INODE),TempFTYPE),
     &        FILESIZE, LAST_CALL) 
         IF (IERR .LT. 0) RETURN
         IF (DO_U_FIRST) GOTO 100
      ENDIF
 300  CONTINUE
#if defined(_OPENMP)
      IF (KEEP_OOC(400).GT.0 .AND. KEEP_OOC(405) .GT. 0) THEN
        CALL OMP_UNSET_LOCK(LOCK_FOR_L0OMP)
      ENDIF
#endif
      RETURN
      END SUBROUTINE ZMUMPS_OOC_IO_LU_PANEL 
      SUBROUTINE ZMUMPS_OOC_STORE_LorU( STRAT, TYPEF, 
     &     AFAC, LAFAC, MonBloc,
     &     IERR,
     &     LorU_NextPiv2beWritten, 
     &     LorU_AddVirtNodeI8, LorUSIZE_OF_BLOCK,
     &     FILESIZE, LAST_CALL
     &     )
      USE ZMUMPS_OOC_BUFFER
      IMPLICIT NONE
      INTEGER, INTENT(IN) :: STRAT
      INTEGER, INTENT(IN) :: TYPEF
      INTEGER(8), INTENT(INOUT) :: FILESIZE
      INTEGER(8), INTENT(IN) :: LAFAC
      COMPLEX(kind=8), INTENT(IN) :: AFAC(LAFAC)
      INTEGER, INTENT(INOUT) :: LorU_NextPiv2beWritten
      INTEGER(8), INTENT(INOUT) :: LorU_AddVirtNodeI8
      INTEGER(8), INTENT(INOUT) :: LorUSIZE_OF_BLOCK
      TYPE(IO_BLOCK), INTENT(INOUT) :: MonBloc
      INTEGER, INTENT(OUT)  :: IERR
      LOGICAL, INTENT(IN)   :: LAST_CALL
      INTEGER NNMAX
      INTEGER(8) :: TOTSIZE, EFFSIZE
      INTEGER(8) :: TailleEcrite
      INTEGER SIZE_PANEL
      INTEGER(8) :: AddVirtCour
      LOGICAL VIRT_ADD_RESERVED_BEF_CALL
      LOGICAL VIRTUAL_ADDRESS_JUST_RESERVED
      LOGICAL HOLE_PROCESSED_BEFORE_CALL
      LOGICAL TMP_ESTIM
      INTEGER ICUR, INODE_CUR, ILAST
      INTEGER(8) :: ADDR_LAST
      IERR = 0
      IF (TYPEF == TYPEF_L ) THEN 
         NNMAX = MonBloc%NROW   
      ELSE
         NNMAX = MonBloc%NCOL
      ENDIF
      SIZE_PANEL = ZMUMPS_OOC_PANEL_SIZE(NNMAX)
      IF ( (.NOT.MonBloc%Last) .AND.
     &     (MonBloc%LastPiv-LorU_NextPiv2beWritten+1.LT.SIZE_PANEL))
     &     THEN
        RETURN
      ENDIF
      TMP_ESTIM = .TRUE.
      TOTSIZE = ZMUMPS_OOC_NBENTRIES_PANEL_123
     &          (MonBloc%NFS, NNMAX, SIZE_PANEL, MonBloc, TMP_ESTIM)
      IF (MonBloc%Last) THEN
           TMP_ESTIM=.FALSE.
           EFFSIZE = ZMUMPS_OOC_NBENTRIES_PANEL_123
     &     (MonBloc%LastPiv, NNMAX, SIZE_PANEL, MonBloc, TMP_ESTIM)
      ELSE
            EFFSIZE = -1034039740327_8
      ENDIF
      IF (MonBloc%Typenode.EQ.3.AND. MonBloc%NFS.NE.MonBloc%NCOL) THEN
         WRITE(*,*) 'Internal error in ZMUMPS_OOC_STORE_LorU for type3',
     &   MonBloc%NFS,MonBloc%NCOL
         CALL MUMPS_ABORT()
      ENDIF
      IF (MonBloc%Typenode.EQ.3.AND. TYPEF.NE.TYPEF_L) THEN
         WRITE(*,*) 'Internal error in ZMUMPS_OOC_STORE_LorU,TYPEF=',
     &   TYPEF, 'for typenode=3'
         CALL MUMPS_ABORT()
      ENDIF
      IF (MonBloc%Typenode.EQ.2.AND.
     &     TYPEF.EQ.TYPEF_U.AND.
     &     .NOT. MonBloc%MASTER ) THEN
         WRITE(*,*) 'Internal error in ZMUMPS_OOC_STORE_LorU',
     &   MonBloc%MASTER,MonBloc%Typenode, TYPEF
         CALL MUMPS_ABORT()
      ENDIF
      HOLE_PROCESSED_BEFORE_CALL  = (LorUSIZE_OF_BLOCK .LT. 0_8)
      IF (HOLE_PROCESSED_BEFORE_CALL.AND.(.NOT.MonBloc%Last)) THEN
          WRITE(6,*) ' Internal error  in ZMUMPS_OOC_STORE_LorU ', 
     &    ' last is false after earlier calls with last=true'
          CALL MUMPS_ABORT()
      ENDIF
      IF (HOLE_PROCESSED_BEFORE_CALL) THEN
        LorUSIZE_OF_BLOCK = - LorUSIZE_OF_BLOCK - 1_8
        TOTSIZE = -99999999_8
      ENDIF
      VIRTUAL_ADDRESS_JUST_RESERVED = .FALSE.
      VIRT_ADD_RESERVED_BEF_CALL =
     &                    ( LorUSIZE_OF_BLOCK .NE. 0_8 .OR.
     &                      HOLE_PROCESSED_BEFORE_CALL )
      IF (MonBloc%Last .AND. .NOT. HOLE_PROCESSED_BEFORE_CALL) THEN
        KEEP_OOC(228) = max(KEEP_OOC(228),
     &        (MonBloc%LastPiv+SIZE_PANEL-1) / SIZE_PANEL)
        IF (VIRT_ADD_RESERVED_BEF_CALL) THEN
            IF (AddVirtLibre(TYPEF).EQ.
     &           (LorU_AddVirtNodeI8+TOTSIZE) ) THEN
              AddVirtLibre(TYPEF) = LorU_AddVirtNodeI8 + EFFSIZE
            ENDIF
        ELSE
            VIRTUAL_ADDRESS_JUST_RESERVED = .TRUE.
            IF (EFFSIZE .EQ. 0_8) THEN
              LorU_AddVirtNodeI8 = -9999_8
            ELSE
              LorU_AddVirtNodeI8  = AddVirtLibre(TYPEF)
            ENDIF
            AddVirtLibre(TYPEF) = AddVirtLibre(TYPEF) + EFFSIZE
        ENDIF
      ELSE
        IF (.NOT. VIRT_ADD_RESERVED_BEF_CALL 
     &    ) THEN
          LorU_AddVirtNodeI8 = AddVirtLibre(TYPEF)
          AddVirtLibre(TYPEF) = AddVirtLibre(TYPEF) + TOTSIZE
        ENDIF
      ENDIF
      AddVirtCour = LorU_AddVirtNodeI8 + LorUSIZE_OF_BLOCK
      CALL ZMUMPS_OOC_WRT_IN_PANELS_LorU( STRAT, TYPEF, MonBloc,
     &     SIZE_PANEL, 
     &     AFAC, LAFAC,
     &     LorU_NextPiv2beWritten, AddVirtCour, 
     &     TailleEcrite, 
     &     IERR )
      IF ( IERR .LT. 0 ) RETURN
      LorUSIZE_OF_BLOCK = LorUSIZE_OF_BLOCK + TailleEcrite
      IF (LorUSIZE_OF_BLOCK.EQ.0_8 ) THEN
        IF ( .NOT. VIRT_ADD_RESERVED_BEF_CALL
     &    .AND. .NOT. VIRTUAL_ADDRESS_JUST_RESERVED )
     &    THEN
          AddVirtLibre(TYPEF) = AddVirtLibre(TYPEF) - TOTSIZE
          LorU_AddVirtNodeI8 = 0_8
        ENDIF
      ELSE IF (.NOT. VIRT_ADD_RESERVED_BEF_CALL ) THEN
          VIRTUAL_ADDRESS_JUST_RESERVED = .TRUE.
      ENDIF
      IF ( VIRTUAL_ADDRESS_JUST_RESERVED) THEN
         OOC_INODE_SEQUENCE(I_CUR_HBUF_NEXTPOS(TYPEF),
     &        TYPEF) = MonBloc%INODE
         I_CUR_HBUF_NEXTPOS(TYPEF) = I_CUR_HBUF_NEXTPOS(TYPEF) + 1
         IF (MonBloc%Last) THEN
           MAX_SIZE_FACTOR_OOC=max(MAX_SIZE_FACTOR_OOC,EFFSIZE)
           TMP_SIZE_FACT=TMP_SIZE_FACT+EFFSIZE
         ELSE
           MAX_SIZE_FACTOR_OOC=max(MAX_SIZE_FACTOR_OOC,TOTSIZE)
           TMP_SIZE_FACT=TMP_SIZE_FACT+TOTSIZE
         ENDIF
         TMP_NB_NODES=TMP_NB_NODES+1
         IF(TMP_SIZE_FACT.GT.SIZE_ZONE_SOLVE)THEN
            MAX_NB_NODES_FOR_ZONE=max(MAX_NB_NODES_FOR_ZONE,
     &           TMP_NB_NODES)
            TMP_SIZE_FACT=0_8
            TMP_NB_NODES=0
         ENDIF
      ENDIF
      IF (MonBloc%Last) THEN
        LorUSIZE_OF_BLOCK = - LorUSIZE_OF_BLOCK - 1_8
      ENDIF
      IF (LAST_CALL) THEN
         IF (.NOT.MonBloc%Last) THEN
          WRITE(6,*) ' Internal error in ZMUMPS_OOC_STORE_LorU ', 
     &               ' LAST and LAST_CALL are incompatible '
          CALL MUMPS_ABORT()
        ENDIF
        LorUSIZE_OF_BLOCK = - LorUSIZE_OF_BLOCK - 1_8
        ICUR      = I_CUR_HBUF_NEXTPOS(TYPEF) - 1
        INODE_CUR = OOC_INODE_SEQUENCE(ICUR,TYPEF)
        ADDR_LAST = AddVirtLibre(TYPEF)
        IF ( INODE_CUR .NE. MonBloc%INODE .AND.
     &       OOC_VADDR(STEP_OOC(MonBloc%INODE),TYPEF) .NE. -9999 ) THEN
 10       CONTINUE
          ILAST = ICUR
          IF ( OOC_VADDR(STEP_OOC(INODE_CUR),TYPEF) .NE. -9999_8) THEN
            ADDR_LAST = OOC_VADDR(STEP_OOC(INODE_CUR), TYPEF)
          ENDIF
          ICUR = ICUR - 1
          INODE_CUR = OOC_INODE_SEQUENCE(ICUR,TYPEF)
          IF (INODE_CUR .EQ. MonBloc%INODE) THEN
            LorUSIZE_OF_BLOCK = ADDR_LAST -
     &                          OOC_VADDR(STEP_OOC(INODE_CUR),TYPEF)
          ELSE
             IF (ICUR .LE. 1) THEN
              WRITE(*,*) "Internal error in ZMUMPS_OOC_STORE_LorU"
              WRITE(*,*) "Did not find current node in sequence"
              CALL MUMPS_ABORT()
            ENDIF
            GOTO 10
          ENDIF
        ENDIF
        FILESIZE  = FILESIZE + LorUSIZE_OF_BLOCK
      ENDIF
      RETURN
      END SUBROUTINE ZMUMPS_OOC_STORE_LorU
      SUBROUTINE ZMUMPS_OOC_WRT_IN_PANELS_LorU(
     &     STRAT, TYPEF, MonBloc,
     &     SIZE_PANEL,
     &     AFAC, LAFAC,
     &     NextPiv2beWritten, AddVirtCour, 
     &     TailleEcrite, IERR )
      USE ZMUMPS_OOC_BUFFER
      IMPLICIT NONE
      INTEGER,       INTENT(IN) :: STRAT, TYPEF, SIZE_PANEL
      INTEGER(8)                :: LAFAC
      INTEGER(8),     INTENT(IN) ::  AddVirtCour
      COMPLEX(kind=8), INTENT(IN) :: AFAC(LAFAC)
      INTEGER,       INTENT(INOUT) :: NextPiv2beWritten
      TYPE(IO_BLOCK),INTENT(INOUT) :: MonBloc   
      INTEGER(8),      INTENT(OUT) :: TailleEcrite
      INTEGER, INTENT(OUT)  :: IERR
      INTEGER   :: I, NBeff, LPANELeff, IEND
      INTEGER(8) :: AddVirtDeb
      IERR = 0
      TailleEcrite = 0_8
      AddVirtDeb   = AddVirtCour
      I = NextPiv2beWritten
      IF ( NextPiv2beWritten .GT. MonBloc%LastPiv ) THEN
        RETURN
      ENDIF
 10   CONTINUE
      NBeff  = min(SIZE_PANEL,MonBloc%LastPiv-I+1 )
      IF ((NBeff.NE.SIZE_PANEL) .AND. (.NOT.MonBloc%Last)) THEN
         GOTO 20
      ENDIF
      IF (TYPEF.EQ.TYPEF_L.AND.MonBloc%MASTER.AND.
     &     KEEP_OOC(50).EQ.2 .AND. MonBloc%Typenode.NE.3) THEN
         IF (MonBloc%INDICES(NBeff+I-1) < 0)
     &        THEN
            NBeff=NBeff+1
         ENDIF
      ENDIF
      IEND   = I + NBeff -1
      CALL ZMUMPS_COPY_LU_TO_BUFFER( STRAT, TYPEF, MonBloc,
     &     AFAC, LAFAC,
     &     AddVirtDeb, I, IEND, LPANELeff,
     &     IERR)
      IF ( IERR .LT. 0 ) THEN
        RETURN
      ENDIF
      IF ( IERR .EQ. 1 ) THEN
         IERR=0
         GOTO 20
      ENDIF
      IF (TYPEF .EQ. TYPEF_L) THEN
         MonBloc%LastPanelWritten_L = MonBloc%LastPanelWritten_L+1
      ELSE
         MonBloc%LastPanelWritten_U = MonBloc%LastPanelWritten_U+1
      ENDIF
      AddVirtDeb   = AddVirtDeb + int(LPANELeff,8)
      TailleEcrite = TailleEcrite + int(LPANELeff,8)
      I=I+NBeff
      IF ( I .LE. MonBloc%LastPiv ) GOTO 10
 20   CONTINUE
      NextPiv2beWritten = I
      RETURN
      END SUBROUTINE ZMUMPS_OOC_WRT_IN_PANELS_LorU
      INTEGER(8) FUNCTION ZMUMPS_OOC_NBENTRIES_PANEL_123
     &      (NFSorNPIV, NNMAX, SIZE_PANEL, MonBloc, ESTIM)
      IMPLICIT NONE
      TYPE(IO_BLOCK), INTENT(IN):: MonBloc
      INTEGER, INTENT(IN) :: NFSorNPIV, NNMAX, SIZE_PANEL
      LOGICAL, INTENT(IN) :: ESTIM
      INTEGER :: I, NBeff
      INTEGER(8) :: TOTSIZE
      TOTSIZE = 0_8
      IF (NFSorNPIV.EQ.0) GOTO 100
      IF (.NOT. MonBloc%MASTER .OR. MonBloc%Typenode.EQ.3) THEN
        TOTSIZE = int(NFSorNPIV,8) * int(NNMAX,8)
      ELSE
        I = 1
 10     CONTINUE
        NBeff = min(SIZE_PANEL, NFSorNPIV-I+1)
        IF (KEEP_OOC(50).EQ.2) THEN
          IF (ESTIM) THEN
            NBeff = NBeff + 1
          ELSE
             IF (MonBloc%INDICES(I+NBeff-1) < 0) THEN
            NBeff = NBeff + 1
            ENDIF
          ENDIF
        ENDIF
        TOTSIZE = TOTSIZE + 
     &           int(NNMAX-I+1,8) * int(NBeff,8)
        I = I + NBeff
        IF ( I .LE. NFSorNPIV ) GOTO 10
      ENDIF
 100  CONTINUE
      ZMUMPS_OOC_NBENTRIES_PANEL_123 = TOTSIZE
      RETURN
      END FUNCTION ZMUMPS_OOC_NBENTRIES_PANEL_123
      INTEGER FUNCTION ZMUMPS_OOC_PANEL_SIZE( NNMAX )
      IMPLICIT NONE
      INTEGER, INTENT(IN) :: NNMAX
      INTEGER ZMUMPS_OOC_GET_PANEL_SIZE
      ZMUMPS_OOC_PANEL_SIZE=ZMUMPS_OOC_GET_PANEL_SIZE(
     &     int(KEEP_OOC(223),8), NNMAX, KEEP_OOC(227),KEEP_OOC(50))
      RETURN
      END FUNCTION ZMUMPS_OOC_PANEL_SIZE
      SUBROUTINE ZMUMPS_OOC_SKIP_NULL_SIZE_NODE()
      IMPLICIT NONE
      INTEGER I,TMP_NODE
      IF(.NOT.ZMUMPS_SOLVE_IS_END_REACHED())THEN
         IF(SOLVE_STEP.EQ.0)THEN
            I=CUR_POS_SEQUENCE
            TMP_NODE=OOC_INODE_SEQUENCE(CUR_POS_SEQUENCE,
     &           OOC_FCT_TYPE)
            DO WHILE ((I.LE.TOTAL_NB_OOC_NODES(OOC_FCT_TYPE)).AND.
     &           (SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE)
     &           .EQ.0_8))
               INODE_TO_POS(STEP_OOC(TMP_NODE))=1
               OOC_STATE_NODE(STEP_OOC(TMP_NODE))=NOT_USED
               I=I+1
               IF(I.LE.TOTAL_NB_OOC_NODES(OOC_FCT_TYPE))THEN
                  TMP_NODE=OOC_INODE_SEQUENCE(I,OOC_FCT_TYPE)
               ENDIF
            ENDDO
            CUR_POS_SEQUENCE=min(I,TOTAL_NB_OOC_NODES(OOC_FCT_TYPE))
         ELSE
            I=CUR_POS_SEQUENCE
            TMP_NODE=OOC_INODE_SEQUENCE(CUR_POS_SEQUENCE,
     &           OOC_FCT_TYPE)
            DO WHILE ((I.GE.1).AND.
     &           (SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE)
     &           .EQ.0_8))
               INODE_TO_POS(STEP_OOC(TMP_NODE))=1
               OOC_STATE_NODE(STEP_OOC(TMP_NODE))=NOT_USED
               I=I-1
               IF(I.GE.1)THEN
                  TMP_NODE=OOC_INODE_SEQUENCE(I,OOC_FCT_TYPE)
               ENDIF
            ENDDO
            CUR_POS_SEQUENCE=max(I,1)
         ENDIF
      ENDIF
      RETURN
      END SUBROUTINE ZMUMPS_OOC_SKIP_NULL_SIZE_NODE
      SUBROUTINE ZMUMPS_OOC_SET_STATES_ES(N,KEEP201,
     &           Pruned_List,nb_prun_nodes,STEP)
      IMPLICIT NONE
      INTEGER, INTENT(IN) :: N, KEEP201, nb_prun_nodes
      INTEGER, INTENT(IN) :: STEP(N),
     &                       Pruned_List(nb_prun_nodes)
      INTEGER I, ISTEP
      IF (KEEP201 .GT. 0) THEN
        OOC_STATE_NODE(:) = ALREADY_USED  
        DO I = 1, nb_prun_nodes
          ISTEP = STEP(Pruned_List(I))
          OOC_STATE_NODE(ISTEP) = NOT_IN_MEM 
        ENDDO
      ENDIF
      RETURN
      END SUBROUTINE ZMUMPS_OOC_SET_STATES_ES
      END MODULE ZMUMPS_OOC
