zmumps_ooc.F

Go to the documentation of this file.

C
C  This file is part of MUMPS 5.5.1, released
C  on Tue Jul 12 13:17:24 UTC 2022
C
C
C  Copyright 1991-2022 CERFACS, CNRS, ENS Lyon, INP Toulouse, Inria,
C  Mumps Technologies, University of Bordeaux.
C
C  This version of MUMPS is provided to you free of charge. It is
C  released under the CeCILL-C license 
C  (see doc/CeCILL-C_V1-en.txt, doc/CeCILL-C_V1-fr.txt, and
C  https://cecill.info/licences/Licence_CeCILL-C_V1-en.html)
C
      MODULE zmumps_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
.EQ.      IF(FREE_HOLE_FLAG1)THEN
.LT.         IF(POS_HOLE_B(ZONE)+1CURRENT_POS_T(ZONE)-1)THEN
            I=POS_HOLE_B(ZONE)+1
            TMP_NODE=abs(POS_IN_MEM(I))
.GT.            IF(TMP_NODE(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)
.LT.               IF(IERR0)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
.EQ.            ELSEIF(TMP_NODE0)THEN
               DO J=I,CURRENT_POS_T(ZONE)-1
.NE.                  IF(POS_IN_MEM(J)0) EXIT
               ENDDO
.LT.               IF(POS_IN_MEM(J)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