smumps_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 smumps_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 smumps_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 :: smumps_ooc_init_facto,smumps_new_factor,
     &     smumps_read_ooc,
     &     smumps_solve_alloc_factor_space,
     &     smumps_is_there_free_space,
     &     smumps_ooc_end_solve,
     &     smumps_solve_init_ooc_fwd,smumps_solve_init_ooc_bwd,
     &     smumps_initiate_read_ops,smumps_ooc_init_solve
         INTEGER, PARAMETER, PUBLIC :: typef_both_lu = -99976
         PUBLIC smumps_ooc_io_lu_panel,
     &        smumps_ooc_panel_size
         PRIVATE smumps_ooc_store_loru, 
     &        smumps_ooc_wrt_in_panels_loru
      CONTAINS
      SUBROUTINE smumps_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 smumps_set_strat_io_flags
      FUNCTION smumps_is_there_free_space(INODE,ZONE)
      IMPLICIT NONE
      INTEGER inode,zone
      LOGICAL smumps_is_there_free_space
      smumps_is_there_free_space=(lrlus_solve(zone).GE.
     &     size_of_block(step_ooc(inode),ooc_fct_type))
      RETURN
      END FUNCTION smumps_is_there_free_space
      SUBROUTINE smumps_init_fact_area_size_s(LA)
      IMPLICIT NONE
      INTEGER(8) :: LA
      fact_area_size=la
      END SUBROUTINE smumps_init_fact_area_size_s
      SUBROUTINE smumps_ooc_init_facto(id, MAXS)
      USE smumps_struc_def
      USE smumps_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(smumps_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
      smumps_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 SMUMPS_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 smumps_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 SMUMPS_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 smumps_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 smumps_convert_str_to_chr_array(tmp_dir(1),
     &     id%OOC_TMPDIR, tmpdir_max_length, dim_dir )
      CALL smumps_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 SMUMPS_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 smumps_ooc_init_facto
      SUBROUTINE smumps_new_factor(INODE,PTRFAC,KEEP,KEEP8,
     &     A,LA,SIZE,IERR)
      USE smumps_ooc_buffer
      IMPLICIT NONE
      INTEGER inode,keep(500)
      INTEGER(8) :: la
      INTEGER(8) keep8(150)
      INTEGER(8) :: PTRFAC(keep(28)), size
      REAL 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 smumps_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 smumps_ooc_do_io_and_chbuf(ooc_fct_type,ierr)
            IF(ierr.LT.0)THEN
               RETURN
            ENDIF
            CALL smumps_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 smumps_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 smumps_new_factor
      SUBROUTINE smumps_read_ooc(DEST,INODE,IERR
     &  )
      IMPLICIT NONE
      include 'mpif.h'
      INTEGER ierr,inode
      REAL 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.smumps_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 smumps_ooc_skip_null_size_node()
         ENDIF
      ENDIF
      RETURN
      END SUBROUTINE smumps_read_ooc
      SUBROUTINE smumps_ooc_clean_pending(IERR)
      USE smumps_ooc_buffer
      IMPLICIT NONE
      INTEGER, intent(out):: ierr
      ierr=0
      IF (with_buf) THEN
        CALL smumps_ooc_buf_clean_pending(ierr)
        IF(ierr.LT.0)THEN
           RETURN
        ENDIF
      END IF
      RETURN
      END SUBROUTINE smumps_ooc_clean_pending
      SUBROUTINE smumps_ooc_end_facto(id,IERR)
      USE smumps_ooc_buffer
      USE smumps_struc_def
      IMPLICIT NONE
      TYPE(smumps_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 smumps_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 smumps_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 smumps_ooc_end_facto
      SUBROUTINE smumps_ooc_clean_files(id,IERR)
      USE smumps_struc_def
      IMPLICIT NONE
      EXTERNAL mumps_ooc_remove_file_c
      TYPE(smumps_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 smumps_ooc_clean_files
      SUBROUTINE smumps_clean_ooc_data(id,IERR)
      USE smumps_struc_def
      IMPLICIT NONE
      TYPE(smumps_struc), TARGET :: id
      INTEGER IERR
      ierr=0
      CALL smumps_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 smumps_clean_ooc_data
      SUBROUTINE smumps_ooc_init_solve(id)
      USE smumps_struc_def
      IMPLICIT NONE
      include 'mpif.h'
      TYPE(smumps_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 smumps_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 SMUMPS_OOC_INIT_SOLVE'
         ENDIF
         id%INFO(1) = -13
         id%INFO(2) = id%KEEP(28)
         RETURN
      ENDIF
      smumps_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 smumps_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((real(fact_area_size)-
     &           real(size_solve_emm))/real(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 SMUMPS_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 SMUMPS_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 SMUMPS_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 SMUMPS_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 SMUMPS_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 smumps_ooc_init_solve
      SUBROUTINE smumps_initiate_read_ops(A,LA,PTRFAC,NSTEPS,IERR)
      IMPLICIT NONE
      INTEGER nsteps,ierr
      INTEGER(8) :: la
      REAL 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 smumps_submit_read_for_z(a,la,ptrfac,nsteps,ierr)
               IF(ierr.LT.0)THEN
                  RETURN
               ENDIF
            ENDDO
         ELSE
            CALL smumps_submit_read_for_z(a,la,ptrfac,nsteps,ierr)
            IF(ierr.LT.0)THEN
               RETURN
            ENDIF
         ENDIF
      ENDIF
      RETURN
      END SUBROUTINE smumps_initiate_read_ops
      SUBROUTINE smumps_submit_read_for_z(A,LA,PTRFAC,NSTEPS,IERR)
      IMPLICIT NONE
      INTEGER NSTEPS,IERR
      INTEGER(8) :: LA
      REAL A(LA)
      INTEGER(8) :: PTRFAC(NSTEPS)
      INTEGER ZONE
      CALL smumps_solve_select_zone(zone)
      ierr=0
      CALL smumps_solve_zone_read(zone,a,la,ptrfac,nsteps,ierr)
      RETURN
      END SUBROUTINE smumps_submit_read_for_z 
      SUBROUTINE smumps_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
      REAL 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 smumps_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 smumps_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 smumps_solve_update_pointers(io_req(step_ooc(inode)),
     &        ptrfac,nsteps)
         req_act=req_act-1
      ENDIF
      END SUBROUTINE smumps_read_solve_block
      SUBROUTINE smumps_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 smumps_solve_update_pointers
      SUBROUTINE smumps_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 smumps_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 ', 
     &                 ' SMUMPS_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 ', 
     &       ' SMUMPS_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 ',
     &        ' SMUMPS_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 smumps_update_read_req_node
      SUBROUTINE smumps_free_factors_for_solve(INODE,PTRFAC,NSTEPS,A,
     &     LA,FLAG,IERR)
      IMPLICIT NONE
      INTEGER(8) :: LA
      INTEGER, intent(out):: IERR
      REAL 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 SMUMPS_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 smumps_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 smumps_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 smumps_solve_try_zone_for_read(zone)
         IF((lrlus_solve(zone).GE.min_size_read).OR.
     &        (lrlus_solve(zone).GE.
     &        int(0.3e0*real(size_solve_z(zone)),8)))THEN
            CALL smumps_submit_read_for_z(a,la,ptrfac,nsteps,ierr)
            IF(ierr.LT.0)THEN
               RETURN
            ENDIF
         ELSE
            CALL smumps_solve_select_zone(zone)
         ENDIF
      ENDIF     
      RETURN
      END SUBROUTINE smumps_free_factors_for_solve
      FUNCTION smumps_solve_is_inode_in_mem(INODE,PTRFAC,NSTEPS,A,LA,
     &     IERR)
      IMPLICIT NONE
      INTEGER inode,nsteps
      INTEGER(8) :: la
      INTEGER, INTENT(out)::ierr
      REAL a(la)
      INTEGER (8) :: ptrfac(nsteps)
      INTEGER smumps_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
            smumps_solve_is_inode_in_mem=ooc_node_permuted
         ELSE
            smumps_solve_is_inode_in_mem=ooc_node_not_permuted
         ENDIF
         IF(.NOT.smumps_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 smumps_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 smumps_solve_update_pointers(io_req(step_ooc(inode)),
     &           ptrfac,nsteps)
            req_act=req_act-1
         ELSE
            CALL smumps_solve_upd_node_info(inode,ptrfac,nsteps)
            IF(.NOT.smumps_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 smumps_ooc_skip_null_size_node()
               ENDIF
            ENDIF
         ENDIF
         IF(ooc_state_node(step_ooc(inode)).EQ.permuted)THEN
            smumps_solve_is_inode_in_mem=ooc_node_permuted
         ELSE
            smumps_solve_is_inode_in_mem=ooc_node_not_permuted
         ENDIF
      ELSE
         smumps_solve_is_inode_in_mem=ooc_node_not_in_mem
      ENDIF
      RETURN
      END FUNCTION smumps_solve_is_inode_in_mem
      SUBROUTINE smumps_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 smumps_solve_modify_state_node
      SUBROUTINE smumps_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 smumps_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 smumps_ooc_update_solve_stat(inode,ptrfac,nsteps,1)
      END SUBROUTINE smumps_solve_upd_node_info
      SUBROUTINE smumps_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 smumps_solve_find_zone
      SUBROUTINE smumps_solve_try_zone_for_read(ZONE)
      IMPLICIT NONE
      INTEGER ZONE
      zone=mod((current_solve_read_zone+1),nb_z-1)+1
      END SUBROUTINE smumps_solve_try_zone_for_read
      SUBROUTINE smumps_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 smumps_solve_select_zone
      SUBROUTINE smumps_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))
      REAL 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 smumps_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 smumps_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 smumps_solve_alloc_ptr_upd_b(inode,ptrfac,
     &        keep,keep8,a,zone)
      ELSE
         IF(smumps_is_there_free_space(inode,zone))THEN
            IF(solve_step.EQ.0)THEN
               CALL smumps_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 smumps_solve_alloc_ptr_upd_t(inode,ptrfac,
     &                 keep,keep8,a,zone)
               ELSEIF(iflag.EQ.0)THEN
                  CALL smumps_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 smumps_solve_alloc_ptr_upd_b(inode,ptrfac,
     &                    keep,keep8,a,zone)
                  ENDIF
               ENDIF
            ELSE
               CALL smumps_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 smumps_solve_alloc_ptr_upd_b(inode,ptrfac,
     &                 keep,keep8,a,zone)
               ELSEIF(iflag.EQ.0)THEN
                  CALL smumps_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 smumps_solve_alloc_ptr_upd_t(inode,ptrfac,
     &                    keep,keep8,a,zone)
                  ENDIF
               ENDIF
            ENDIF
            IF(iflag.EQ.0)THEN
               CALL smumps_free_space_for_solve(a,fact_area_size,
     &              requested_size,ptrfac,keep(28),zone,ierr)
               IF(ierr.LT.0)THEN
                  RETURN
               ENDIF
               CALL smumps_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 smumps_solve_alloc_factor_space
      SUBROUTINE smumps_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
      REAL 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 ',
     &            ' SMUMPS_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 smumps_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 ',
     &                 ' SMUMPS_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', 
     &           ' SMUMPS_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 smumps_get_top_area_space
      SUBROUTINE smumps_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)
      REAL 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 ',
     &            ' SMUMPS_GET_BOTTOM_AREA_SPACE',
     &           current_pos_t(zone)-1,pos_hole_b(zone),i,pos_in_mem(i)
            CALL mumps_abort()
         ENDIF
      ENDDO
      IF(free_hole_flag.EQ.1)THEN
         IF(pos_hole_b(zone)+1.LT.current_pos_t(zone)-1)THEN
            i=pos_hole_b(zone)+1
            tmp_node=abs(pos_in_mem(i))
            IF(tmp_node.GT.(n_ooc+1)*nb_z)THEN
               tmp_node=tmp_node-(n_ooc+1)*nb_z
               CALL mumps_wait_request(io_req(step_ooc(tmp_node)),ierr)
               IF(ierr.LT.0)THEN
                 WRITE(*,*)myid_ooc,': Internal error (15) in OOC ',
     &                               err_str_ooc(1:dim_err_str_ooc)
                 CALL mumps_abort() 
                 RETURN
               ENDIF
               req_act=req_act-1
               CALL smumps_solve_update_pointers(
     &              io_req(step_ooc(tmp_node)),ptrfac,nsteps)
               free_hole=abs(ptrfac(step_ooc(tmp_node)))-free_hole_pos
            ELSEIF(tmp_node.EQ.0)THEN
               DO j=i,current_pos_t(zone)-1
                  IF(pos_in_mem(j).NE.0) EXIT
               ENDDO
               IF(pos_in_mem(j).LT.0)THEN
                  WRITE(*,*)myid_ooc,': Internal error (16) in OOC ',
     &                  ' SMUMPS_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 ',
     &           ' SMUMPS_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 smumps_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 ',
     &             'SMUMPS_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 smumps_get_bottom_area_space
      SUBROUTINE smumps_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))
      REAL 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 smumps_solve_alloc_ptr_upd_t
      SUBROUTINE smumps_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))
      REAL A(FACT_AREA_SIZE)
      INTEGER ZONE
      IF(pos_hole_b(zone).EQ.-9999)THEN
         WRITE(*,*)myid_ooc,': Internal error (22) in OOC ',
     &        ' SMUMPS_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 smumps_solve_alloc_ptr_upd_b
      SUBROUTINE smumps_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)
      REAL 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 SMUMPS_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 smumps_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 smumps_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 ',
     &                      ' SMUMPS_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 smumps_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 smumps_free_space_for_solve
      SUBROUTINE smumps_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 ',
     &        ' SMUMPS_OOC_UPDATE_SOLVE_STAT'
         CALL mumps_abort()
      ENDIF
      CALL smumps_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 smumps_ooc_update_solve_stat
      SUBROUTINE smumps_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 smumps_search_solve
      FUNCTION smumps_solve_is_end_reached()
      IMPLICIT NONE
      LOGICAL smumps_solve_is_end_reached
      smumps_solve_is_end_reached=.false.
      IF(solve_step.EQ.0)THEN
         IF(cur_pos_sequence.GT.total_nb_ooc_nodes(ooc_fct_type))THEN
            smumps_solve_is_end_reached=.true.
         ENDIF
      ELSEIF(solve_step.EQ.1)THEN
         IF(cur_pos_sequence.LT.1)THEN
            smumps_solve_is_end_reached=.true.
         ENDIF
      ENDIF
      RETURN
      END FUNCTION smumps_solve_is_end_reached
      SUBROUTINE smumps_solve_zone_read(ZONE,A,LA,PTRFAC,NSTEPS,IERR)
      IMPLICIT NONE
      INTEGER NSTEPS,ZONE
      INTEGER(8), INTENT(IN) :: LA
      INTEGER, intent(out) :: IERR
      REAL 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(smumps_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(smumps_solve_is_end_reached())THEN
                  RETURN
               ENDIF            
               tmp_node=ooc_inode_sequence(cur_pos_sequence,
     &              ooc_fct_type)
            ENDDO
            CALL smumps_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(smumps_solve_is_end_reached())THEN
                  RETURN
               ENDIF              
               tmp_node=ooc_inode_sequence(cur_pos_sequence,
     &              ooc_fct_type)
            ENDDO  
            CALL smumps_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 smumps_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 smumps_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 smumps_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 smumps_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 smumps_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 smumps_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 smumps_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 smumps_solve_zone_read
      SUBROUTINE smumps_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(smumps_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 ',
     &         ' SMUMPS_SOLVE_COMPUTE_READ_SIZE',flag
         CALL mumps_abort()
      ENDIF
      CALL smumps_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 smumps_solve_compute_read_size
      SUBROUTINE smumps_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 smumps_ooc_end_solve
      SUBROUTINE smumps_solve_prepare_pref(PTRFAC,NSTEPS, 
     &            A,LA)
      IMPLICIT NONE
      INTEGER, INTENT(in)       :: NSTEPS
      INTEGER(8), INTENT(INOUT) :: PTRFAC(NSTEPS)
      INTEGER(8), INTENT(IN)    :: LA 
      REAL                   :: 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 smumps_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 smumps_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
.EQ..AND..EQ.                 IF (KEEP_OOC(237)0  KEEP_OOC(235)0) THEN
                    CALL SMUMPS_SOLVE_UPD_NODE_INFO(J,PTRFAC,NSTEPS)
                 ENDIF
               ENDIF
            ENDIF 
      ENDDO
.NE..OR..NE.         IF (KEEP_OOC(237)0  KEEP_OOC(235)0) 
     &      THEN
           IF (COMPRESS_TO_BE_DONE) THEN 
             DO ZONE=1,NB_Z-1
               CALL SMUMPS_FREE_SPACE_FOR_SOLVE(A,LA,
     &         DUMMY_SIZE,PTRFAC,
     &         NSTEPS,ZONE,IERR)
.LT.               IF (IERR  0) THEN
                    WRITE(*,*)MYID_OOC,': internal error mila 5 ', 
     &              ' ierr on return to smumps_free_space_for_solve =', 
     &              IERR
                    CALL MUMPS_ABORT()
               ENDIF
             ENDDO
           ENDIF
         ENDIF
      RETURN
      END SUBROUTINE SMUMPS_SOLVE_PREPARE_PREF
      SUBROUTINE SMUMPS_SOLVE_INIT_OOC_FWD(PTRFAC,NSTEPS,MTYPE,
     &                                    A,LA,DOPREFETCH,IERR)
      IMPLICIT NONE
      INTEGER NSTEPS,MTYPE
      INTEGER, intent(out)::IERR
      INTEGER(8) :: LA
      REAL 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
.NE.      IF (KEEP_OOC(201)1) THEN
        OOC_SOLVE_TYPE_FCT = FCT
      ENDIF
      SOLVE_STEP=0
      CUR_POS_SEQUENCE=1
      MTYPE_OOC=MTYPE
.NE.      IF ( KEEP_OOC(201)1 
.OR..NE.     &   KEEP_OOC(50)0
     &  ) THEN
        CALL SMUMPS_SOLVE_PREPARE_PREF(PTRFAC,NSTEPS,A,LA)
      ELSE 
        CALL SMUMPS_SOLVE_STAT_REINIT_PANEL(KEEP_OOC(28),
     &              KEEP_OOC(38), KEEP_OOC(20) )
      ENDIF
      IF (DOPREFETCH) THEN 
          CALL SMUMPS_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 SMUMPS_SOLVE_INIT_OOC_FWD
      SUBROUTINE SMUMPS_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
      REAL 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
.NE.      IF (KEEP_OOC(201)1) OOC_SOLVE_TYPE_FCT=FCT  
      SOLVE_STEP=1
      CUR_POS_SEQUENCE=TOTAL_NB_OOC_NODES(OOC_FCT_TYPE)
      MTYPE_OOC=MTYPE
.NE.      IF ( KEEP_OOC(201)1 
.OR..NE.     &   KEEP_OOC(50)0
     &  ) THEN
        CALL SMUMPS_SOLVE_PREPARE_PREF(PTRFAC,NSTEPS,A,LA)
.AND.        IF (I_WORKED_ON_ROOT
.GT.     $       ((IROOT0)))THEN
.NE.           IF(SIZE_OF_BLOCK(STEP_OOC(IROOT),OOC_FCT_TYPE)0) THEN
.NOT..NE..OR..NE.              IF ((KEEP_OOC(237)0  KEEP_OOC(235)0)) 
     &             THEN
                 CALL SMUMPS_FREE_FACTORS_FOR_SOLVE ( IROOT,
     &                PTRFAC, KEEP_OOC(28), A, LA,.FALSE.,IERR)
.LT.                 IF (IERR  0) RETURN
              ENDIF
              CALL SMUMPS_SOLVE_FIND_ZONE(IROOT,
     &             ZONE,PTRFAC,NSTEPS)
.EQ.              IF(ZONENB_Z)THEN
                 DUMMY_SIZE=1_8
                 CALL SMUMPS_FREE_SPACE_FOR_SOLVE(A,LA,
     &                DUMMY_SIZE,PTRFAC,
     &                NSTEPS,NB_Z,IERR)
.LT.                 IF (IERR  0) THEN
                    WRITE(*,*)MYID_OOC,': internal error in
     &                   smumps_free_space_for_solve', 
     &                   IERR
                    CALL MUMPS_ABORT()
                 ENDIF
              ENDIF
           ENDIF
        ENDIF
.GT.        IF (NB_Z1) THEN
          CALL SMUMPS_SUBMIT_READ_FOR_Z(A,LA,PTRFAC,
     &                                  KEEP_OOC(28),IERR)
.LT.          IF (IERR  0) RETURN
        ENDIF
      ELSE 
        CALL SMUMPS_SOLVE_STAT_REINIT_PANEL(KEEP_OOC(28),
     &              KEEP_OOC(38), KEEP_OOC(20) )
        CALL SMUMPS_INITIATE_READ_OPS(A,LA,PTRFAC,KEEP_OOC(28),IERR)
.LT.        IF (IERR  0 ) RETURN
      ENDIF
      RETURN
      END SUBROUTINE SMUMPS_SOLVE_INIT_OOC_BWD
      SUBROUTINE SMUMPS_STRUC_STORE_FILE_NAME(id,IERR)
      USE SMUMPS_STRUC_DEF
      IMPLICIT NONE
      TYPE(SMUMPS_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)
.GT.      IF (IERR  0) THEN
.GT.         IF (ICNTL10) THEN
            WRITE(ICNTL1,*) 'pb allocation in ',
     &           'smumps_struc_store_file_name'
         ENDIF
         IERR=-1
.GE.         IF(id%INFO(1)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)
.GT.      IF (IERR  0) THEN
         IERR=-1
.GE.         IF(id%INFO(1)0) THEN
.GT.            IF (ICNTL10) THEN
               WRITE(ICNTL1,*)
     &              'pb allocation in smumps_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 SMUMPS_STRUC_STORE_FILE_NAME
      SUBROUTINE SMUMPS_OOC_OPEN_FILES_FOR_SOLVE(id)
      USE SMUMPS_STRUC_DEF
      IMPLICIT NONE
      TYPE(SMUMPS_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)
.GT.      IF (IERR  0) THEN
         IERR=-1
.GE.         IF(id%INFO(1)0)THEN
.GT.            IF (ICNTL10) THEN
               WRITE(ICNTL1,*)
     &              'pb allocation in smumps_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)
.LT.      IF(IERR0)THEN
.GT.         IF (ICNTL10)
     &   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)
.LT.      IF(IERR0)THEN
.GT.         IF (ICNTL10)
     &   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))
.LT.            IF(IERR0)THEN
.GT.               IF (ICNTL10)
     &         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)
.LT.      IF(IERR0)THEN
.GT.         IF (ICNTL10)
     &   WRITE(ICNTL1,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC)
         id%INFO(1)=IERR
         RETURN
      ENDIF
      DEALLOCATE(NB_FILES)
      RETURN
      END SUBROUTINE SMUMPS_OOC_OPEN_FILES_FOR_SOLVE      
      SUBROUTINE SMUMPS_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 SMUMPS_CONVERT_STR_TO_CHR_ARRAY
      SUBROUTINE SMUMPS_FORCE_WRITE_BUF(IERR)
      USE SMUMPS_OOC_BUFFER
      IMPLICIT NONE
      INTEGER, intent(out) :: IERR
      IERR=0
.NOT.      IF(WITH_BUF)THEN
         RETURN
      ENDIF
      CALL SMUMPS_OOC_DO_IO_AND_CHBUF(OOC_FCT_TYPE,IERR)
      IF (IERR < 0) THEN
        RETURN
      ENDIF
      RETURN
      END SUBROUTINE SMUMPS_FORCE_WRITE_BUF
      SUBROUTINE SMUMPS_OOC_FORCE_WRT_BUF_PANEL(IERR)
      USE SMUMPS_OOC_BUFFER
      IMPLICIT NONE
      INTEGER, intent(out) :: IERR
      INTEGER I
      IERR=0
.NOT.      IF(WITH_BUF)THEN
         RETURN
      ENDIF
      DO I=1,OOC_NB_FILE_TYPE
         CALL SMUMPS_OOC_DO_IO_AND_CHBUF(I,IERR)
         IF (IERR < 0) RETURN         
      ENDDO
      RETURN
      END SUBROUTINE SMUMPS_OOC_FORCE_WRT_BUF_PANEL
       SUBROUTINE SMUMPS_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 SMUMPS_SOLVE_STAT_REINIT_PANEL
      SUBROUTINE SMUMPS_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) 
      REAL, 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                  
.EQ.      IF (KEEP_OOC(50)0 
.AND..EQ.     &         KEEP_OOC(251)2) THEN 
        WRITE_L = .FALSE.
      ELSE
.EQ..OR..EQ.        WRITE_L =  (TYPEFileTYPEF_BOTH_LU  TYPEFileTYPEF_L)
      ENDIF
.EQ..OR..EQ.      WRITE_U =  (TYPEFileTYPEF_BOTH_LU  TYPEFileTYPEF_U)
#if defined(_OPENMP)
.GT..AND..GT.      IF (KEEP_OOC(400)0  KEEP_OOC(405)  0) THEN
.EQ..OR.        IF ( STRAT  STRAT_WRITE_MAX  LAST_CALL ) THEN
          CALL OMP_SET_LOCK(LOCK_FOR_L0OMP)
#if defined(_WIN32)
        ELSE
#else
.NOT.        ELSE IF (  OMP_TEST_LOCK(LOCK_FOR_L0OMP ))  THEN
#endif
          RETURN
        ENDIF
      ENDIF
#endif
      DO_U_FIRST = .FALSE.
.EQ.      IF ( TYPEFileTYPEF_BOTH_LU ) THEN
.GT.         IF ( LNextPiv2beWritten  UNextPiv2beWritten ) THEN
            DO_U_FIRST = .TRUE.
         END IF
      END IF
      IF (DO_U_FIRST) GOTO 200
.AND. 100  IF (WRITE_L  TYPEF_L > 0 ) THEN
         TempFTYPE  = TYPEF_L
.EQ..AND..NOT.         IF ((MonBloc%Typenode2)(MonBloc%MASTER)) 
     &        THEN
           TMPSIZE_OF_BLOCK = SIZE_OF_BLOCK(STEP_OOC(MonBloc%INODE),
     &                                      TempFTYPE)
.LT.           IF (TMPSIZE_OF_BLOCK  0_8) THEN
               TMPSIZE_OF_BLOCK = -TMPSIZE_OF_BLOCK - 1_8
           ENDIF
           LNextPiv2beWritten =
     &     int(
     &          TMPSIZE_OF_BLOCK
     &          / int(MonBloc%NROW,8)
     &        )
     &     + 1
         ENDIF
         CALL SMUMPS_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 )
.LT.         IF (IERR  0) RETURN
         IF (DO_U_FIRST) GOTO 300
      ENDIF
 200  IF (WRITE_U) THEN
         TempFTYPE  = TYPEF_U
         CALL SMUMPS_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) 
.LT.         IF (IERR  0) RETURN
         IF (DO_U_FIRST) GOTO 100
      ENDIF
 300  CONTINUE
#if defined(_OPENMP)
.GT..AND..GT.      IF (KEEP_OOC(400)0  KEEP_OOC(405)  0) THEN
        CALL OMP_UNSET_LOCK(LOCK_FOR_L0OMP)
      ENDIF
#endif
      RETURN
      END SUBROUTINE SMUMPS_OOC_IO_LU_PANEL 
      SUBROUTINE SMUMPS_OOC_STORE_LorU( STRAT, TYPEF, 
     &     AFAC, LAFAC, MonBloc,
     &     IERR,
     &     LorU_NextPiv2beWritten, 
     &     LorU_AddVirtNodeI8, LorUSIZE_OF_BLOCK,
     &     FILESIZE, LAST_CALL
     &     )
      USE SMUMPS_OOC_BUFFER
      IMPLICIT NONE
      INTEGER, INTENT(IN) :: STRAT
      INTEGER, INTENT(IN) :: TYPEF
      INTEGER(8), INTENT(INOUT) :: FILESIZE
      INTEGER(8), INTENT(IN) :: LAFAC
      REAL, 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 = SMUMPS_OOC_PANEL_SIZE(NNMAX)
.NOT..AND.      IF ( (MonBloc%Last) 
.LT.     &     (MonBloc%LastPiv-LorU_NextPiv2beWritten+1SIZE_PANEL))
     &     THEN
        RETURN
      ENDIF
      TMP_ESTIM = .TRUE.
      TOTSIZE = SMUMPS_OOC_NBENTRIES_PANEL_123
     &          (MonBloc%NFS, NNMAX, SIZE_PANEL, MonBloc, TMP_ESTIM)
      IF (MonBloc%Last) THEN
           TMP_ESTIM=.FALSE.
           EFFSIZE = SMUMPS_OOC_NBENTRIES_PANEL_123
     &     (MonBloc%LastPiv, NNMAX, SIZE_PANEL, MonBloc, TMP_ESTIM)
      ELSE
            EFFSIZE = -1034039740327_8
      ENDIF
.EQ..AND..NE.      IF (MonBloc%Typenode3 MonBloc%NFSMonBloc%NCOL) THEN
         WRITE(*,*) 'internal error in smumps_ooc_store_loru for type3',
     &   MonBloc%NFS,MonBloc%NCOL
         CALL MUMPS_ABORT()
      ENDIF
.EQ..AND..NE.      IF (MonBloc%Typenode3 TYPEFTYPEF_L) THEN
         WRITE(*,*) 'internal error in smumps_ooc_store_loru,typef=',
     &   TYPEF, 'for typenode=3'
         CALL MUMPS_ABORT()
      ENDIF
.EQ..AND.      IF (MonBloc%Typenode2
.EQ..AND.     &     TYPEFTYPEF_U
.NOT.     &      MonBloc%MASTER ) THEN
         WRITE(*,*) 'internal error in smumps_ooc_store_loru',
     &   MonBloc%MASTER,MonBloc%Typenode, TYPEF
         CALL MUMPS_ABORT()
      ENDIF
.LT.      HOLE_PROCESSED_BEFORE_CALL  = (LorUSIZE_OF_BLOCK  0_8)
.AND..NOT.      IF (HOLE_PROCESSED_BEFORE_CALL(MonBloc%Last)) THEN
          WRITE(6,*) ' internal error  in smumps_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 =
.NE..OR.     &                    ( LorUSIZE_OF_BLOCK  0_8 
     &                      HOLE_PROCESSED_BEFORE_CALL )
.AND..NOT.      IF (MonBloc%Last   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
.EQ.            IF (AddVirtLibre(TYPEF)
     &           (LorU_AddVirtNodeI8+TOTSIZE) ) THEN
              AddVirtLibre(TYPEF) = LorU_AddVirtNodeI8 + EFFSIZE
            ENDIF
        ELSE
            VIRTUAL_ADDRESS_JUST_RESERVED = .TRUE.
.EQ.            IF (EFFSIZE  0_8) THEN
              LorU_AddVirtNodeI8 = -9999_8
            ELSE
              LorU_AddVirtNodeI8  = AddVirtLibre(TYPEF)
            ENDIF
            AddVirtLibre(TYPEF) = AddVirtLibre(TYPEF) + EFFSIZE
        ENDIF
      ELSE
.NOT.        IF ( VIRT_ADD_RESERVED_BEF_CALL 
     &    ) THEN
          LorU_AddVirtNodeI8 = AddVirtLibre(TYPEF)
          AddVirtLibre(TYPEF) = AddVirtLibre(TYPEF) + TOTSIZE
        ENDIF
      ENDIF
      AddVirtCour = LorU_AddVirtNodeI8 + LorUSIZE_OF_BLOCK
      CALL SMUMPS_OOC_WRT_IN_PANELS_LorU( STRAT, TYPEF, MonBloc,
     &     SIZE_PANEL, 
     &     AFAC, LAFAC,
     &     LorU_NextPiv2beWritten, AddVirtCour, 
     &     TailleEcrite, 
     &     IERR )
.LT.      IF ( IERR  0 ) RETURN
      LorUSIZE_OF_BLOCK = LorUSIZE_OF_BLOCK + TailleEcrite
.EQ.      IF (LorUSIZE_OF_BLOCK0_8 ) THEN
.NOT.        IF (  VIRT_ADD_RESERVED_BEF_CALL
.AND..NOT.     &      VIRTUAL_ADDRESS_JUST_RESERVED )
     &    THEN
          AddVirtLibre(TYPEF) = AddVirtLibre(TYPEF) - TOTSIZE
          LorU_AddVirtNodeI8 = 0_8
        ENDIF
.NOT.      ELSE IF ( 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
.GT.         IF(TMP_SIZE_FACTSIZE_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
.NOT.         IF (MonBloc%Last) THEN
          WRITE(6,*) ' internal error in smumps_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)
.NE..AND.        IF ( INODE_CUR  MonBloc%INODE 
.NE.     &       OOC_VADDR(STEP_OOC(MonBloc%INODE),TYPEF)  -9999 ) THEN
 10       CONTINUE
          ILAST = ICUR
.NE.          IF ( OOC_VADDR(STEP_OOC(INODE_CUR),TYPEF)  -9999_8) THEN
            ADDR_LAST = OOC_VADDR(STEP_OOC(INODE_CUR), TYPEF)
          ENDIF
          ICUR = ICUR - 1
          INODE_CUR = OOC_INODE_SEQUENCE(ICUR,TYPEF)
.EQ.          IF (INODE_CUR  MonBloc%INODE) THEN
            LorUSIZE_OF_BLOCK = ADDR_LAST -
     &                          OOC_VADDR(STEP_OOC(INODE_CUR),TYPEF)
          ELSE
.LE.             IF (ICUR  1) THEN
              WRITE(*,*) "Internal error in SMUMPS_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 SMUMPS_OOC_STORE_LorU
      SUBROUTINE SMUMPS_OOC_WRT_IN_PANELS_LorU(
     &     STRAT, TYPEF, MonBloc,
     &     SIZE_PANEL,
     &     AFAC, LAFAC,
     &     NextPiv2beWritten, AddVirtCour, 
     &     TailleEcrite, IERR )
      USE SMUMPS_OOC_BUFFER
      IMPLICIT NONE
      INTEGER,       INTENT(IN) :: STRAT, TYPEF, SIZE_PANEL
      INTEGER(8)                :: LAFAC
      INTEGER(8),     INTENT(IN) ::  AddVirtCour
      REAL, 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
.GT.      IF ( NextPiv2beWritten  MonBloc%LastPiv ) THEN
        RETURN
      ENDIF
 10   CONTINUE
      NBeff  = min(SIZE_PANEL,MonBloc%LastPiv-I+1 )
.NE..AND..NOT.      IF ((NBeffSIZE_PANEL)  (MonBloc%Last)) THEN
         GOTO 20
      ENDIF
.EQ..AND..AND.      IF (TYPEFTYPEF_LMonBloc%MASTER
.EQ..AND..NE.     &     KEEP_OOC(50)2  MonBloc%Typenode3) THEN
         IF (MonBloc%INDICES(NBeff+I-1) < 0)
     &        THEN
            NBeff=NBeff+1
         ENDIF
      ENDIF
      IEND   = I + NBeff -1
      CALL SMUMPS_COPY_LU_TO_BUFFER( STRAT, TYPEF, MonBloc,
     &     AFAC, LAFAC,
     &     AddVirtDeb, I, IEND, LPANELeff,
     &     IERR)
.LT.      IF ( IERR  0 ) THEN
        RETURN
      ENDIF
.EQ.      IF ( IERR  1 ) THEN
         IERR=0
         GOTO 20
      ENDIF
.EQ.      IF (TYPEF  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
.LE.      IF ( I  MonBloc%LastPiv ) GOTO 10
 20   CONTINUE
      NextPiv2beWritten = I
      RETURN
      END SUBROUTINE SMUMPS_OOC_WRT_IN_PANELS_LorU
      INTEGER(8) FUNCTION SMUMPS_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
.EQ.      IF (NFSorNPIV0) GOTO 100
.NOT..OR..EQ.      IF ( MonBloc%MASTER  MonBloc%Typenode3) THEN
        TOTSIZE = int(NFSorNPIV,8) * int(NNMAX,8)
      ELSE
        I = 1
 10     CONTINUE
        NBeff = min(SIZE_PANEL, NFSorNPIV-I+1)
.EQ.        IF (KEEP_OOC(50)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
.LE.        IF ( I  NFSorNPIV ) GOTO 10
      ENDIF
 100  CONTINUE
      SMUMPS_OOC_NBENTRIES_PANEL_123 = TOTSIZE
      RETURN
      END FUNCTION SMUMPS_OOC_NBENTRIES_PANEL_123
      INTEGER FUNCTION SMUMPS_OOC_PANEL_SIZE( NNMAX )
      IMPLICIT NONE
      INTEGER, INTENT(IN) :: NNMAX
      INTEGER SMUMPS_OOC_GET_PANEL_SIZE
      SMUMPS_OOC_PANEL_SIZE=SMUMPS_OOC_GET_PANEL_SIZE(
     &     int(KEEP_OOC(223),8), NNMAX, KEEP_OOC(227),KEEP_OOC(50))
      RETURN
      END FUNCTION SMUMPS_OOC_PANEL_SIZE
      SUBROUTINE SMUMPS_OOC_SKIP_NULL_SIZE_NODE()
      IMPLICIT NONE
      INTEGER I,TMP_NODE
.NOT.      IF(SMUMPS_SOLVE_IS_END_REACHED())THEN
.EQ.         IF(SOLVE_STEP0)THEN
            I=CUR_POS_SEQUENCE
            TMP_NODE=OOC_INODE_SEQUENCE(CUR_POS_SEQUENCE,
     &           OOC_FCT_TYPE)
.LE..AND.            DO WHILE ((ITOTAL_NB_OOC_NODES(OOC_FCT_TYPE))
     &           (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
.LE.               IF(ITOTAL_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)
.GE..AND.            DO WHILE ((I1)
     &           (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
.GE.               IF(I1)THEN
                  TMP_NODE=OOC_INODE_SEQUENCE(I,OOC_FCT_TYPE)
               ENDIF
            ENDDO
            CUR_POS_SEQUENCE=max(I,1)
         ENDIF
      ENDIF
      RETURN
      END SUBROUTINE SMUMPS_OOC_SKIP_NULL_SIZE_NODE
      SUBROUTINE SMUMPS_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
.GT.      IF (KEEP201  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 SMUMPS_OOC_SET_STATES_ES
      END MODULE SMUMPS_OOC