front_data_mgt_m.F

Go to the documentation of this file.

C
C  This file is part of MUMPS 5.5.1, released
C  on Tue Jul 12 13:17:24 UTC 2022
C
C
C  Copyright 1991-2022 CERFACS, CNRS, ENS Lyon, INP Toulouse, Inria,
C  Mumps Technologies, University of Bordeaux.
C
C  This version of MUMPS is provided to you free of charge. It is
C  released under the CeCILL-C license 
C  (see doc/CeCILL-C_V1-en.txt, doc/CeCILL-C_V1-fr.txt, and
C  https://cecill.info/licences/Licence_CeCILL-C_V1-en.html)
C
      MODULE mumps_front_data_mgt_m
      IMPLICIT NONE
      PRIVATE
C     --------------------------------------------
C     This module contains routines to manage
C     handlers of various data associated to
C     active fronts *during the factorization*.
C
C     It should be initialized at the beginning
C     of the factorization and terminated at the
C     end of the factorization.
C
C     There are two types of data, see below.
C
C     'A' is for active type 2 fronts: list must
C         be empty at the end of the factorization
C
C     'F' will be for general fronts -- currently used
C         for BLR fronts, in three situations:
C         1/ factorization of type 2 symmetric active fronts 
C            (requires temporary storage of BLR panels)      
C         2/ LRSOLVE: BLR factors are kept until solution phase
C            (liberated in JOB=-2 or at the beginning of a new facto)      
C         3/ LRCB: CB is dynamically allocated and compressed
C            (liberated before the end of the factorization)      
C
C     Only handlers are managed in this module.
C     The data itself is in the module above using it.
C     For example, FAC_MAPROW_DATA_M manages MAPROW
C     messages that arrive too early. It handles an
C     array that contains all early MAPROW messages
C     and that is indexed with the handlers managed
C     by MUMPS_FRONT_DATA_MGT_M.
C
C     --------------------------------------------
C
C     ===============
C     Public routines
C     ===============
      PUBLIC :: mumps_fdm_init,
     &          mumps_fdm_end,
     &          mumps_fdm_start_idx,
     &          mumps_fdm_end_idx
     &          , mumps_fdm_mod_to_struc
     &          , mumps_fdm_struc_to_mod
     &          , mumps_save_restore_front_data
C     STACK_FREE_IDX(1:NB_FREE_IDX) holds the NB_FREE_IDX indices
C                                   of free handlers
C     STACK_FREE_IDX(NB_FREE_IDX+1:size(STACK_FREE_IDX)) is trash data
      TYPE fdm_struc_t
        INTEGER :: nb_free_idx
        INTEGER, DIMENSION(:), POINTER :: stack_free_idx => null()
        INTEGER, DIMENSION(:), POINTER :: count_access   => null()
      END TYPE fdm_struc_t
      TYPE (fdm_struc_t), TARGET, SAVE :: fdm_a, fdm_f
      CONTAINS
C
      SUBROUTINE mumps_fdm_init(WHAT, INITIAL_SIZE, INFO)
C
C     Purpose:
C     =======
C
C     Initialize handler data ('A' or 'F')
C
C     Arguments:
C     =========
C
      INTEGER, INTENT(IN) :: initial_size
      CHARACTER, INTENT(IN) :: what  ! 'A' or 'F'
      INTEGER, INTENT(INOUT) :: info(2)
c
C     Local variables:
C     ===============
c
      INTEGER :: ierr
      TYPE (fdm_struc_t), POINTER :: fdm_ptr
C
      CALL mumps_fdm_set_ptr(what, fdm_ptr)
      ALLOCATE( fdm_ptr%STACK_FREE_IDX(initial_size),
     &          fdm_ptr%COUNT_ACCESS  (initial_size), stat=ierr )
      IF (ierr < 0) THEN
        info(1) = -13
        info(2) = initial_size * 2
        RETURN
      ENDIF
      CALL mumps_fdm_set_all_free(fdm_ptr)
      RETURN
      END SUBROUTINE mumps_fdm_init
C
      SUBROUTINE mumps_fdm_end(WHAT)
C
C     Purpose:
C     =======
C     Free module datastructures associated to "WHAT" at
C     the end of a phase (typically factorization).
C
      CHARACTER, INTENT(IN) :: what
C
C     Local variables
C     ===============
c
      TYPE (fdm_struc_t), POINTER :: fdm_ptr
C
      CALL mumps_fdm_set_ptr(what, fdm_ptr)
      IF (associated(fdm_ptr%STACK_FREE_IDX)) THEN
          DEALLOCATE(fdm_ptr%STACK_FREE_IDX)
          NULLIFY(fdm_ptr%STACK_FREE_IDX)
          fdm_ptr%NB_FREE_IDX=0
      ELSE
C         Should not be called twice or when array is unassociated
          WRITE(*,*) "Internal error 1 in MUMPS_FDM_END", what
          CALL mumps_abort()
      ENDIF
      IF (associated(fdm_ptr%COUNT_ACCESS)) THEN
          DEALLOCATE(fdm_ptr%COUNT_ACCESS)
          NULLIFY(fdm_ptr%COUNT_ACCESS)
      ELSE
C     Should not be called twice or when array is unassociated
          WRITE(*,*) "Internal error 2 in MUMPS_FDM_END", what
          CALL mumps_abort()
      ENDIF
      RETURN
      END SUBROUTINE mumps_fdm_end
C
      SUBROUTINE mumps_fdm_mod_to_struc(WHAT, id_FDM_ENCODING,INFO)
C
C     Purpose:
C     =======
C
C     Save module information in struture.
C     id_FDM_ENCODING corresponds to id%FDM_F_ENCODING
C     This version requires that WHAT is equal to 'F'.
C
C     id_FDM_ENDODING takes responsibility of pointing to module
C     FDM_F information. This typically allows data from the module
C     to be passed from factorization to solve through the instance
C     and manage multiple instances.
C
      CHARACTER, INTENT(IN) :: what
      INTEGER, INTENT(INOUT) :: info(2)
#if defined(mumps_f2003)
      CHARACTER, DIMENSION(:), POINTER, intent(inout) ::
     &                                           id_fdm_encoding
#else
      CHARACTER, DIMENSION(:), POINTER :: id_fdm_encoding
#endif
C
C     Local variables
C     ===============
C
C     Character array of arbitrary dimension 1     
      CHARACTER :: char_array(1)
      INTEGER :: char_length, ierr
c
      IF (what .NE. 'F') THEN
        WRITE(*,*) "Internal error 1 in MUMPS_FDM_MOD_TO_STRUC"
        CALL mumps_abort()
      ENDIF
      IF (associated(id_fdm_encoding)) THEN
C     Should be unassociated for this to work
        WRITE(*,*) "Internal error 2 in MUMPS_FDM_MOD_TO_STRUC"
        CALL mumps_abort()
      ENDIF
      char_length=size(transfer(fdm_f,char_array))
      ALLOCATE(id_fdm_encoding(char_length), stat=ierr )
      IF (ierr < 0) THEN
        info(1) = -13
        info(2) = char_length
        RETURN
      ENDIF
C     ------------------------------
C     Fill contents of pointer array
C     with FDM_F derived datatype
C     ------------------------------
      id_fdm_encoding = transfer(fdm_f,char_array)
C     ----------------------------------------------
C     FDM_F is not to be used again before a call to
C     MUMPS_FDM_STRUC_TO_MOD, invalidate its content
C     ----------------------------------------------
      fdm_f%NB_FREE_IDX=-9999999
      NULLIFY(fdm_f%STACK_FREE_IDX)
      NULLIFY(fdm_f%COUNT_ACCESS)
      RETURN
      END SUBROUTINE mumps_fdm_mod_to_struc
C
      SUBROUTINE mumps_fdm_struc_to_mod(WHAT, id_FDM_ENCODING)
C
C     Purpose:
C     =======
C
C     Set module pointer information from id_FDM_ENCODING) typically
C     at beginning of solve. Suppress from structure since
C     responsibility of pointing to module data is now inside
C     the module.
C
      CHARACTER, INTENT(IN) :: what
#if defined(MUMPS_F2003)
      CHARACTER, DIMENSION(:), POINTER, intent(inout)
     &                                        :: id_fdm_encoding
#else
      CHARACTER, DIMENSION(:), POINTER :: id_fdm_encoding
#endif
C
C     Local variables
C     ===============
C
      IF (.NOT.associated(id_fdm_encoding)) THEN
        WRITE(*,*) "Internal error 1 in MUMPS_FDM_STRUC_TO_MOD"
      ENDIF
      fdm_f=transfer(id_fdm_encoding,fdm_f)
C     Module is now responsible for accessing data.
      DEALLOCATE(id_fdm_encoding)
      NULLIFY(id_fdm_encoding)
      RETURN
      END SUBROUTINE mumps_fdm_struc_to_mod
C
      SUBROUTINE mumps_fdm_start_idx(WHAT, FROM, IWHANDLER, INFO)
C
C     Purpose:
C     =======
C
C     Return a new free index/handler
C     (typically stored in IW)
C
      CHARACTER, INTENT(IN)  :: what
      CHARACTER(LEN=*), INTENT(IN)  :: from !For debugging purposes only
      INTEGER, INTENT(INOUT) :: iwhandler
      INTEGER, INTENT(INOUT) :: info(2)
c
C     Local variables
C     ===============
C
      INTEGER :: old_size, new_size, ierr
      INTEGER :: i
      INTEGER, DIMENSION(:), POINTER :: tmp_count_access
      TYPE(fdm_struc_t), POINTER :: fdm_ptr
      CALL mumps_fdm_set_ptr(what, fdm_ptr)
C
      IF (iwhandler .GT. 0) THEN
C       Already started, counter should at least be 1
         IF (fdm_ptr%COUNT_ACCESS(iwhandler) .LT. 1) THEN
          WRITE(*,*) "Internal error 1 in MUMPS_FDM_START_IDX",
     &    fdm_ptr%COUNT_ACCESS(iwhandler)
          CALL mumps_abort()
        ENDIF
        GOTO 100
      ENDIF
C
      IF (fdm_ptr%NB_FREE_IDX .EQ. 0) THEN
        old_size = size(fdm_ptr%STACK_FREE_IDX)
        new_size = (old_size * 3) / 2 + 1 ! or something else
        fdm_ptr%NB_FREE_IDX = new_size - old_size
        DEALLOCATE(fdm_ptr%STACK_FREE_IDX)
        ALLOCATE(fdm_ptr%STACK_FREE_IDX(new_size),
     &           tmp_count_access(new_size), stat=ierr)
        IF (ierr < 0) THEN
          info(1) = -13
          info(2) = new_size
          RETURN
        ENDIF
C       All new handlers indices are created 
        DO i=1, fdm_ptr%NB_FREE_IDX
          fdm_ptr%STACK_FREE_IDX(i)=new_size-i+1
        ENDDO
C       Count access: copy old ones
        DO i=1, old_size
          tmp_count_access(i)=fdm_ptr%COUNT_ACCESS(i)
        ENDDO
        DO i=old_size+1, new_size
          tmp_count_access(i)=0
        ENDDO
        DEALLOCATE(fdm_ptr%COUNT_ACCESS)
        fdm_ptr%COUNT_ACCESS=>tmp_count_access
      ENDIF
C
      iwhandler = fdm_ptr%STACK_FREE_IDX(fdm_ptr%NB_FREE_IDX)
      fdm_ptr%NB_FREE_IDX = fdm_ptr%NB_FREE_IDX - 1
 100  CONTINUE
C     Number of modules accessing this handler
      fdm_ptr%COUNT_ACCESS(iwhandler)=fdm_ptr%COUNT_ACCESS(iwhandler)+1
      RETURN
      END SUBROUTINE mumps_fdm_start_idx
C
      SUBROUTINE mumps_fdm_end_idx(WHAT, FROM, IWHANDLER)
C
C     Purpose:
C     =======
C
C     Notify than an index/handler has been freed.
C     Mark it free for future reuse.
C
      CHARACTER, INTENT(IN) :: what
      CHARACTER(LEN=*), INTENT(IN) :: from ! for debug purposes only
      INTEGER, INTENT(INOUT) :: iwhandler
      TYPE(fdm_struc_t), POINTER :: fdm_ptr
C
      CALL mumps_fdm_set_ptr(what, fdm_ptr)
      IF (iwhandler .LE.0) THEN
C     Already ended
        WRITE(*,*) "Internal error 1 in MUMPS_FDM_END_IDX",iwhandler
        CALL mumps_abort()
      ENDIF
      fdm_ptr%COUNT_ACCESS(iwhandler)=fdm_ptr%COUNT_ACCESS(iwhandler)-1
      IF (fdm_ptr%COUNT_ACCESS(iwhandler) .LT. 0) THEN
C     Negative counter!
        WRITE(*,*) "Internal error 2 in MUMPS_FDM_END_IDX",
     &  iwhandler, fdm_ptr%COUNT_ACCESS(iwhandler)
        CALL mumps_abort()
      ENDIF
      IF (fdm_ptr%COUNT_ACCESS(iwhandler) .EQ.0 ) THEN
         IF (fdm_ptr%NB_FREE_IDX .GE. size(fdm_ptr%STACK_FREE_IDX)) THEN
          WRITE(*,*) "Internal error 3 in MUMPS_FDM_END_IDX"
          CALL mumps_abort()
        ENDIF
        fdm_ptr%NB_FREE_IDX = fdm_ptr%NB_FREE_IDX + 1
C       Having incremented the nb of free handlers we
C       store the index (IWHANDLER) that has been
C       effectively released for future reuse.
        fdm_ptr%STACK_FREE_IDX(fdm_ptr%NB_FREE_IDX) = iwhandler
        iwhandler = -8888 ! has been used and is now free
      ENDIF
C
      RETURN
      END SUBROUTINE mumps_fdm_end_idx
C     ===================
C     Private subroutines
C     ===================
      SUBROUTINE mumps_fdm_set_ptr(WHAT, FDM_PTR)
      CHARACTER, INTENT(IN) :: WHAT
#if defined(MUMPS_F2003)
      TYPE(fdm_struc_t), POINTER, INTENT(OUT) :: FDM_PTR
#else
      TYPE(fdm_struc_t), POINTER :: FDM_PTR
#endif
C
      IF ( what .EQ. 'A' ) THEN
        fdm_ptr => fdm_a
      ELSE IF ( what .EQ. 'F' ) THEN
        fdm_ptr => fdm_f
      ELSE
C     Should be called with either A or F
        WRITE(*,*) "Internal error 1 in MUMPS_FDM_INIT"
        WRITE(*,*) "Allowed arguments for WHAT are A or F"
        CALL mumps_abort()
      ENDIF
      END SUBROUTINE mumps_fdm_set_ptr
      SUBROUTINE mumps_fdm_set_all_free(FDM_PTR)
C
C     Purpose:
C     =======
C     Initialize the stack of free elements for the first time
C
      TYPE(fdm_struc_t), POINTER :: FDM_PTR
      INTEGER :: I
      fdm_ptr%NB_FREE_IDX = size(fdm_ptr%STACK_FREE_IDX)
      DO i = 1, fdm_ptr%NB_FREE_IDX
        fdm_ptr%STACK_FREE_IDX(i)=fdm_ptr%NB_FREE_IDX-i+1
        fdm_ptr%COUNT_ACCESS  (i)=0
      ENDDO
      RETURN
      END SUBROUTINE mumps_fdm_set_all_free
C
!     ---------- MUMPS_SAVE_RESTORE_FRONT_DATA ----------------------- !
      SUBROUTINE mumps_save_restore_front_data(id_FDM_F_ENCODING
     &                 ,unit,MYID,mode
     &                 ,SIZE_GEST,SIZE_VARIABLES
     &                 ,SIZE_INT, TOTAL_FILE_SIZE,TOTAL_STRUC_SIZE
     &                 ,size_read,size_allocated,size_written
     &                 ,INFO)
      IMPLICIT NONE
C  =======
C  Purpose
C  =======
C
C     This routine is designed to manage a FDM_STRUC_T structure (save, restore, compute memory)
C     
C  ==========
C  Parameters
C  ==========
C
C     FDM_STRUC           : TYPE (FDM_STRUC_T) : the main structure
C
C     unit                : The unit of the file to be written or read
C
C     mode                : the type of operation to be performed by the routine 
C                           memory_save  = compute the size of the save file and of the structure
C                           save         = save the instace
C                           restore      = restore the instace
C
C     TOTAL_FILE_SIZE     : size of the file to be written or read
C
C     TOTAL_STRUC_SIZE    : size of the structure to be saved or restored
C
C     SIZE_INT            : size of an integer       
C
C     INFO                : copies of of INFO(1) and INFO(2) to allow save/restore of failled instaces
C      
      CHARACTER, DIMENSION(:), POINTER :: id_fdm_f_encoding
      INTEGER,intent(IN)::unit,myid
      CHARACTER(len=*),intent(IN) :: mode
      INTEGER,INTENT(OUT) :: size_gest
      INTEGER(8),intent(OUT) :: size_variables
      INTEGER(8),intent(IN) :: total_file_size,total_struc_size
      INTEGER,intent(INOUT):: info(2)
      INTEGER,intent(IN):: size_int
      INTEGER(8),intent(INOUT):: size_read,size_allocated,size_written
      INTEGER:: nbrecords,nbsubrecords
      INTEGER:: size_gest_fdm_f
      INTEGER(8):: size_variables_fdm_f
      INTEGER(4) :: i4
      nbrecords=0
      size_gest_fdm_f=0
      size_variables_fdm_f=0_8
      size_gest=0
      size_variables=0_8
      if((trim(mode).EQ."memory_save").OR.(trim(mode).EQ."save")) then
         call mumps_fdm_struc_to_mod("F",id_fdm_f_encoding)
      endif
      if(trim(mode).EQ."memory_save") then
         CALL mumps_save_restore_fdm_struc(
     &        fdm_f
     &        ,unit,myid,"memory_save"
     &        ,size_gest_fdm_f
     &        ,size_variables_fdm_f
     &        ,size_int,total_file_size,total_struc_size
     &        ,size_read,size_allocated,size_written
     &        ,info)
      elseif(trim(mode).EQ."save") then
         CALL mumps_save_restore_fdm_struc(
     &        fdm_f
     &        ,unit,myid,"save"
     &        ,size_gest_fdm_f
     &        ,size_variables_fdm_f
     &        ,size_int,total_file_size,total_struc_size
     &        ,size_read,size_allocated,size_written
     &        ,info)
         IF ( info(1) .LT. 0 ) GOTO 100
      elseif(trim(mode).EQ."restore") then
         CALL mumps_save_restore_fdm_struc(
     &        fdm_f
     &        ,unit,myid,"restore"
     &        ,size_gest_fdm_f
     &        ,size_variables_fdm_f
     &        ,size_int, total_file_size,total_struc_size
     &        ,size_read,size_allocated,size_written
     &        ,info)
         IF ( info(1) .LT. 0 ) GOTO 100
      endif
      if(trim(mode).EQ."memory_save") then
C     If the size to write (SIZE_VARIABLES) is greater than 2^31
C     Subrecords are created which need to be taken into account in
C     the file size computation
         nbsubrecords=int(size_variables/huge(i4))
         IF(nbsubrecords.GT.0) then
            nbrecords=nbrecords+nbsubrecords
         ENDIF
      elseif(trim(mode).EQ."save") then
         size_written=size_written+size_variables
     &        +int(size_gest,kind=8)
#if !defined(MUMPS_F2003)
         size_written=size_written
     &        +int(2*size_int*nbrecords,kind=8)
#endif
      elseif(trim(mode).EQ."restore") then
         size_allocated=size_allocated+size_variables
         size_read=size_read+size_variables
     &        +int(size_gest,kind=8)
#if !defined(MUMPS_F2003)
         size_read=size_read
     &        +int(2*size_int*nbrecords,kind=8)
#endif
      endif
      if(trim(mode).EQ."memory_save") then
         size_variables=size_variables+size_variables_fdm_f
         size_gest=size_gest+size_gest_fdm_f
#if !defined(MUMPS_F2003)
C     If the file is not written with access="stream", which is only done in MUMPS_F2003,
C     the record length's is written at the beginning and at the end of each record
C     This is done using 2 INTEGERs so we use 2*SIZE_INT more space for each record
         size_gest=size_gest+2*size_int*nbrecords
#endif
      endif
      call mumps_fdm_mod_to_struc("F",id_fdm_f_encoding,info(1))
 100  continue
      RETURN
      END SUBROUTINE mumps_save_restore_front_data
!     --------------------------------- MUMPS_SAVE_RESTORE_BLR_STRUC ----------------------------- !
      SUBROUTINE mumps_save_restore_fdm_struc(FDM_STRUC
     &     ,unit,MYID,mode
     &     ,Local_SIZE_GEST,Local_SIZE_VARIABLES
     &     ,SIZE_INT ,TOTAL_FILE_SIZE,TOTAL_STRUC_SIZE
     &     ,size_read,size_allocated,size_written
     &     ,INFO)     
      IMPLICIT NONE
C  =======
C  Purpose
C  =======
C
C     This routine is designed to manage a BLR_STRUC_T structure (save, restore, compute memory)
C     
C  ==========
C  Parameters
C  ==========
C
C     BLR_STRUC           : TYPE (BLR_STRUC_T) : the main structure
C
C     unit                : The unit of the file to be written or read
C
C     mode                : the type of operation to be performed by the routine 
C                           memory_save  = compute the size of the save file and of the structure
C                           save         = save the instace
C                           restore      = restore the instace
C
C     TOTAL_FILE_SIZE     : size of the file to be written or read
C
C     TOTAL_STRUC_SIZE    : size of the structure to be saved or restored
C
C     SIZE_INT            : size of an integer      
C
C     INFO1/INFO2         : copies of of INFO(1) and INFO(2) to allow save/restore of failled instaces
C
      TYPE(fdm_struc_t) :: FDM_STRUC
      INTEGER,intent(IN)::unit,MYID
      CHARACTER(len=*),intent(IN) :: mode
      INTEGER,INTENT(OUT) :: Local_SIZE_GEST
      INTEGER(8),intent(OUT) :: Local_SIZE_VARIABLES
      INTEGER,intent(INOUT):: INFO(2)
      INTEGER,intent(IN):: SIZE_INT
      INTEGER(8),intent(IN) :: TOTAL_FILE_SIZE,TOTAL_STRUC_SIZE
      INTEGER(8),intent(INOUT):: size_read,size_allocated,size_written
      INTEGER :: NBVARIABLES_FDM_STRUC_T
      parameter(nbvariables_fdm_struc_t = 3)
      CHARACTER(len=30), dimension(NBVARIABLES_FDM_STRUC_T)::
     &     variables_fdm_struc_t
      CHARACTER(len=30) :: TMP_STRING
      INTEGER(8),dimension(NBVARIABLES_FDM_STRUC_T)::
     &     size_variables_fdm_struc_t
      INTEGER,dimension(NBVARIABLES_FDM_STRUC_T)::SIZE_GEST_FDM_STRUC_T
      INTEGER,dimension(NBVARIABLES_FDM_STRUC_T)::NbRecords_FDM_STRUC_T
      INTEGER:: size_array1,dummy,allocok
      INTEGER:: err,i1,NbSubRecords,Local_NbRecords
      INTEGER(4) :: I4
      variables_fdm_struc_t(1)="NB_FREE_IDX"
      variables_fdm_struc_t(2)="STACK_FREE_IDX"
      variables_fdm_struc_t(3)="COUNT_ACCESS"
      size_variables_fdm_struc_t(:)=0_8
      size_gest_fdm_struc_t(:)=0
      nbrecords_fdm_struc_t(:)=0 
C     
C     BEGINNING OF THE MAIN LOOP ON ALL VARIABLES OF THE STRUCTURE
C
      DO i1=1,nbvariables_fdm_struc_t 
         tmp_string = variables_fdm_struc_t(i1)
         SELECT CASE(tmp_string)
         CASE("NB_FREE_IDX")
            nbrecords_fdm_struc_t(i1)=1
            if(trim(mode).EQ."memory_save") then
               size_variables_fdm_struc_t(i1)=size_int
            elseif(trim(mode).EQ."save") then
               size_variables_fdm_struc_t(i1)=size_int
               write(unit,iostat=err) fdm_struc%NB_FREE_IDX
               if(err.ne.0) then
                  info(1) = -72
                  CALL mumps_seti8toi4(total_file_size-size_written,
     &                 info(2))
               endif
               IF ( info(1) .LT. 0 ) GOTO 100
            elseif(trim(mode).EQ."restore") then
               size_variables_fdm_struc_t(i1)=size_int
               read(unit,iostat=err) fdm_struc%NB_FREE_IDX
               if(err.ne.0) THEN
                  info(1) = -75
                  CALL mumps_seti8toi4(total_file_size-size_read
     &                 ,info(2))
               endif 
               IF ( info(1) .LT. 0 ) GOTO 100
            endif
         CASE("STACK_FREE_IDX")
            nbrecords_fdm_struc_t(i1)=2
            if(trim(mode).EQ."memory_save") then
               IF(associated(fdm_struc%STACK_FREE_IDX)) THEN
                  size_gest_fdm_struc_t(i1)=size_int
                  size_variables_fdm_struc_t(i1)=
     &                 size(fdm_struc%STACK_FREE_IDX,1)*size_int
               ELSE
                  size_gest_fdm_struc_t(i1)=size_int*2
                  size_variables_fdm_struc_t(i1)=0_8
               ENDIF
            elseif(trim(mode).EQ."save") then
               IF(associated(fdm_struc%STACK_FREE_IDX)) THEN
                  size_gest_fdm_struc_t(i1)=size_int
                  size_variables_fdm_struc_t(i1)=
     &                 size(fdm_struc%STACK_FREE_IDX,1)*size_int
                  write(unit,iostat=err)
     &                 size(fdm_struc%STACK_FREE_IDX,1)
                  if(err.ne.0) then
                     info(1) = -72
                     CALL mumps_seti8toi4(total_file_size-size_written,
     &                    info(2))
                  endif
                  IF ( info(1) .LT. 0 ) GOTO 100
                  write(unit,iostat=err) fdm_struc%STACK_FREE_IDX
               ELSE
                  size_gest_fdm_struc_t(i1)=size_int*2
                  size_variables_fdm_struc_t(i1)=0_8
                  write(unit,iostat=err) -999
                  if(err.ne.0) then
                     info(1) = -72
                     CALL mumps_seti8toi4(total_file_size-size_written,
     &                    info(2))
                  endif
                  IF ( info(1) .LT. 0 ) GOTO 100
                  write(unit,iostat=err) -999
               ENDIF 
               if(err.ne.0) then
                  info(1) = -72
                  CALL mumps_seti8toi4(total_file_size-size_written,
     &                 info(2))
               endif
               IF ( info(1) .LT. 0 ) GOTO 100
            elseif(trim(mode).EQ."restore") then
               nullify(fdm_struc%STACK_FREE_IDX)
               read(unit,iostat=err) size_array1
               if(err.ne.0) THEN
                  info(1) = -75
                  CALL mumps_seti8toi4(total_file_size-size_read
     &                 ,info(2))
               endif
               IF ( info(1) .LT. 0 ) GOTO 100
               if(size_array1.EQ.-999) then
                  size_gest_fdm_struc_t(i1)=size_int*2
                  size_variables_fdm_struc_t(i1)=0_8
                  read(unit,iostat=err) dummy
               else
                  size_gest_fdm_struc_t(i1)=size_int
                  size_variables_fdm_struc_t(i1)=size_array1*size_int
                  allocate(fdm_struc%STACK_FREE_IDX(size_array1),
     &                 stat=allocok)
                  if (allocok .GT. 0) THEN
                     info(1) = -78
                     CALL mumps_seti8toi4(
     &                    total_struc_size-size_allocated
     &                    ,info(2))
                  endif
                  read(unit,iostat=err) fdm_struc%STACK_FREE_IDX
               endif
               IF ( info(1) .LT. 0 ) GOTO 100
               if(err.ne.0) THEN
                  info(1) = -75
                  CALL mumps_seti8toi4(total_file_size-size_read
     &                 ,info(2))
               endif
               IF ( info(1) .LT. 0 ) GOTO 100
            endif
         CASE("COUNT_ACCESS")
            nbrecords_fdm_struc_t(i1)=2
            if(trim(mode).EQ."memory_save") then
               IF(associated(fdm_struc%COUNT_ACCESS)) THEN
                  size_gest_fdm_struc_t(i1)=size_int
                  size_variables_fdm_struc_t(i1)=
     &                 size(fdm_struc%COUNT_ACCESS,1)*size_int
               ELSE
                  size_gest_fdm_struc_t(i1)=size_int*2
                  size_variables_fdm_struc_t(i1)=0_8
               ENDIF
            elseif(trim(mode).EQ."save") then
               IF(associated(fdm_struc%COUNT_ACCESS)) THEN
                  size_gest_fdm_struc_t(i1)=size_int
                  size_variables_fdm_struc_t(i1)=
     &                 size(fdm_struc%COUNT_ACCESS,1)*size_int
                  write(unit,iostat=err)
     &                 size(fdm_struc%COUNT_ACCESS,1)
                  if(err.ne.0) then
                     info(1) = -72
                     CALL mumps_seti8toi4(total_file_size-size_written,
     &                    info(2))
                  endif
                  IF ( info(1) .LT. 0 ) GOTO 100
                  write(unit,iostat=err) fdm_struc%COUNT_ACCESS
               ELSE
                  size_gest_fdm_struc_t(i1)=size_int*2
                  size_variables_fdm_struc_t(i1)=0_8
                  write(unit,iostat=err) -999
                  if(err.ne.0) then
                     info(1) = -72
                     CALL mumps_seti8toi4(total_file_size-size_written,
     &                    info(2))
                  endif
                  IF ( info(1) .LT. 0 ) GOTO 100
                  write(unit,iostat=err) -999
               ENDIF 
               if(err.ne.0) then
                  info(1) = -72
                  CALL mumps_seti8toi4(total_file_size-size_written,
     &                 info(2))
               endif
               IF ( info(1) .LT. 0 ) GOTO 100
            elseif(trim(mode).EQ."restore") then
               nullify(fdm_struc%COUNT_ACCESS)
               read(unit,iostat=err) size_array1
               if(err.ne.0) THEN
                  info(1) = -75
                  CALL mumps_seti8toi4(total_file_size-size_read
     &                 ,info(2))
               endif
               IF ( info(1) .LT. 0 ) GOTO 100
               if(size_array1.EQ.-999) then
                  size_gest_fdm_struc_t(i1)=size_int*2
                  size_variables_fdm_struc_t(i1)=0_8
                  read(unit,iostat=err) dummy
               else
                  size_gest_fdm_struc_t(i1)=size_int
                  size_variables_fdm_struc_t(i1)=size_array1*size_int
                  allocate(fdm_struc%COUNT_ACCESS(size_array1),
     &                 stat=allocok)
                  if (allocok .GT. 0) THEN
                     info(1) = -78
                     CALL mumps_seti8toi4(
     &                    total_struc_size-size_allocated
     &                    ,info(2))
                  endif
                  read(unit,iostat=err) fdm_struc%COUNT_ACCESS
               endif
               IF ( info(1) .LT. 0 ) GOTO 100
               if(err.ne.0) THEN
                  info(1) = -75
                  CALL mumps_seti8toi4(total_file_size-size_read
     &                 ,info(2))
               endif
               IF ( info(1) .LT. 0 ) GOTO 100
            endif
         CASE DEFAULT
         END SELECT
         if(trim(mode).EQ."memory_save") then
C     If the size to write (SIZE_VARIABLES_FDM_STRUC_T(i1)) is greater than 2^31
C     Subrecords are created which need to be taken into account in
C     the file size computation
            nbsubrecords=int(size_variables_fdm_struc_t(i1)/huge(i4))
            IF(nbsubrecords.GT.0) then
               nbrecords_fdm_struc_t(i1)=nbrecords_fdm_struc_t(i1)
     &              +nbsubrecords
            ENDIF
         elseif(trim(mode).EQ."save") then
            size_written=size_written+size_variables_fdm_struc_t(i1)
     &           +int(size_gest_fdm_struc_t(i1),kind=8)
#if !defined(MUMPS_F2003)
            size_written=size_written
     &           +int(2*size_int*nbrecords_fdm_struc_t(i1),kind=8)
#endif
         elseif(trim(mode).EQ."restore") then
            size_allocated=size_allocated+
     &           size_variables_fdm_struc_t(i1)
            size_read=size_read+size_variables_fdm_struc_t(i1)
     &           +int(size_gest_fdm_struc_t(i1),kind=8)
#if !defined(MUMPS_F2003)
            size_read=size_read
     &           +int(2*size_int*nbrecords_fdm_struc_t(i1),kind=8)
#endif
         endif
      ENDDO
      if(trim(mode).EQ."memory_save") then
         local_size_variables=sum(size_variables_fdm_struc_t)
         local_size_gest=sum(size_gest_fdm_struc_t)        
#if !defined(MUMPS_F2003)
         local_nbrecords=sum(nbrecords_fdm_struc_t)
         local_size_gest=local_size_gest+2*size_int*local_nbrecords
#endif
      endif
 100  continue
      RETURN
      END SUBROUTINE mumps_save_restore_fdm_struc
      END MODULE mumps_front_data_mgt_m