mumps_ooc_common.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_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, 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 :: step_ooc,procnode_ooc
      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