C
C  This file is part of MUMPS 5.8.1, released
C  on Wed Jul 30 16:49:18 UTC 2025
C
C
C  Copyright 1991-2025 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_OOC_COMMON
      IMPLICIT NONE
      INTEGER, PARAMETER :: FCT = 0 
      INTEGER, PARAMETER, PUBLIC :: TYPEF_INVALID = -999999
      INTEGER, PUBLIC  ::  TYPEF_L, TYPEF_U, TYPEF_CB
      INTEGER OOC_NB_FILE_TYPE, OOC_FCT_TYPE
      INTEGER, PARAMETER :: FILENAMELENGTH=1300
      INTEGER, DIMENSION(:,:),POINTER :: OOC_INODE_SEQUENCE
      INTEGER(8), DIMENSION(:,:),POINTER :: OOC_VADDR
      INTEGER,DIMENSION(:),POINTER:: KEEP_OOC
      INTEGER ICNTL1 
      INTEGER(8), DIMENSION(:),ALLOCATABLE :: AddVirtLibre
      LOGICAL,SAVE :: STRAT_IO_ASYNC,WITH_BUF,SOLVE
      INTEGER, DIMENSION(:),POINTER :: PROCNODE_OOC  => null()
      INTEGER, DIMENSION(:),POINTER :: STEP_OOC      => null()
      INTEGER, SAVE :: MYID_OOC,SLAVEF_OOC,LOW_LEVEL_STRAT_IO
      INTEGER(8), SAVE :: HBUF_SIZE, DIM_BUF_IO
      INTEGER ERR_STR_OOC_MAX_LEN
      PARAMETER(ERR_STR_OOC_MAX_LEN = 512)
      CHARACTER(len=1):: ERR_STR_OOC(ERR_STR_OOC_MAX_LEN)
      INTEGER DIM_ERR_STR_OOC
      TYPE IO_BLOCK
        INTEGER :: INODE
        LOGICAL :: MASTER
        INTEGER :: Typenode
        INTEGER :: NROW, NCOL, NFS
        LOGICAL :: Last
        INTEGER :: LastPiv
        INTEGER :: LastPanelWritten_L 
        INTEGER :: LastPanelWritten_U 
        INTEGER,POINTER,DIMENSION(:) :: INDICES
      END TYPE
      PUBLIC IO_BLOCK
      INTEGER, PUBLIC :: STRAT_WRITE_MAX, STRAT_TRY_WRITE
      PARAMETER (STRAT_WRITE_MAX=1, STRAT_TRY_WRITE=2)
      END MODULE MUMPS_OOC_COMMON
      SUBROUTINE MUMPS_OOC_CONVERT_2INTTOBIGINT(INT1,INT2,BIGINT)
      IMPLICIT NONE
      INTEGER INT1,INT2
      INTEGER(8) BIGINT
      INTEGER(8) TMP1,TMP2,CONV
      PARAMETER (CONV=1073741824_8) 
      TMP1=int(INT1,kind=kind(TMP1))
      TMP2=int(INT2,kind=kind(TMP2))
      BIGINT=(TMP1*CONV)+TMP2
      RETURN
      END SUBROUTINE MUMPS_OOC_CONVERT_2INTTOBIGINT
      SUBROUTINE MUMPS_OOC_CONVERT_BIGINTTO2INT(INT1,INT2,BIGINT)
      IMPLICIT NONE
      INTEGER INT1,INT2
      INTEGER(8) BIGINT
      INTEGER(8) TMP1,TMP2,CONV
      PARAMETER (CONV=1073741824_8) 
      TMP1=BIGINT/CONV
      TMP2=mod(BIGINT,CONV)
      INT1=int(TMP1)
      INT2=int(TMP2)
      RETURN
      END SUBROUTINE MUMPS_OOC_CONVERT_BIGINTTO2INT
      SUBROUTINE MUMPS_OOC_INIT_FILETYPE
     &           (TYPEF_L,TYPEF_U,TYPEF_CB,K201, K251, K50,
     &            TYPEF_INVALID)
      IMPLICIT NONE
      INTEGER, intent(out):: TYPEF_L, TYPEF_U, TYPEF_CB
      INTEGER, intent(in) :: K201, K251, K50
      INTEGER, intent(in) :: TYPEF_INVALID
      IF (K201 .EQ. 1 .AND. K50.EQ.0) THEN
        IF ( K251.NE.2 ) THEN
          TYPEF_L  = 1
          TYPEF_U  = 2
          TYPEF_CB = 3 
        ELSE
          TYPEF_U  = 1
          TYPEF_L  = TYPEF_INVALID 
          TYPEF_CB = 2 
        ENDIF
      ELSE 
         TYPEF_L = 1
         TYPEF_U = TYPEF_INVALID 
         TYPEF_CB=2 
      ENDIF
      RETURN
      END SUBROUTINE MUMPS_OOC_INIT_FILETYPE
      INTEGER FUNCTION MUMPS_OOC_GET_FCT_TYPE
     &                 (FWDORBWD, MTYPE, K201, K50)
      USE MUMPS_OOC_COMMON 
      INTEGER,     intent(in) :: MTYPE, K201, K50
      CHARACTER(len=1), intent(in) :: FWDORBWD
      IF ( (TYPEF_L .NE. 1 .AND. TYPEF_L .NE. TYPEF_INVALID)
     &     .OR. (TYPEF_U .NE. 1 .AND. TYPEF_U .NE. 2 .AND.
     &           TYPEF_U .NE. TYPEF_INVALID) ) THEN
        WRITE(*,*) "Internal error 1 in MUMPS_OOC_GET_FCT_TYPE",
     &              TYPEF_L, TYPEF_U
        CALL MUMPS_ABORT()
      ENDIF
      IF (FWDORBWD .NE. 'F' .AND. FWDORBWD .NE. 'B') THEN
        WRITE(*,*) "Internal error in MUMPS_OOC_GET_FCT_TYPE,",FWDORBWD
        CALL MUMPS_ABORT()
      ENDIF
      IF (K201 .EQ. 1) THEN  
        IF (FWDORBWD .EQ. 'F') THEN
         IF((MTYPE.NE.1).AND.(K50.EQ.0))THEN
           MUMPS_OOC_GET_FCT_TYPE=TYPEF_U
         ELSE
           MUMPS_OOC_GET_FCT_TYPE=TYPEF_L
         ENDIF
        ELSE 
          IF(K50.EQ.0)THEN
            IF(MTYPE.NE.1)THEN
              MUMPS_OOC_GET_FCT_TYPE=TYPEF_L
            ELSE
              MUMPS_OOC_GET_FCT_TYPE=TYPEF_U
            ENDIF
          ELSE
            MUMPS_OOC_GET_FCT_TYPE=TYPEF_L
          ENDIF
        ENDIF
      ELSE  
        MUMPS_OOC_GET_FCT_TYPE = 1
      ENDIF
      RETURN
      END FUNCTION MUMPS_OOC_GET_FCT_TYPE
