1C
2C  This file is part of MUMPS 5.1.2, released
3C  on Mon Oct  2 07:37:01 UTC 2017
4C
5C
6C  Copyright 1991-2017 CERFACS, CNRS, ENS Lyon, INP Toulouse, Inria,
7C  University of Bordeaux.
8C
9C  This version of MUMPS is provided to you free of charge. It is
10C  released under the CeCILL-C license:
11C  http://www.cecill.info/licences/Licence_CeCILL-C_V1-en.html
12C
13      MODULE MUMPS_OOC_COMMON
14      IMPLICIT NONE
15      INTEGER, PARAMETER :: FCT = 0
16      INTEGER, PARAMETER, PUBLIC :: TYPEF_INVALID = -999999
17      INTEGER, PUBLIC  ::  TYPEF_L, TYPEF_U, TYPEF_CB
18      INTEGER OOC_NB_FILE_TYPE, OOC_FCT_TYPE
19      INTEGER, DIMENSION(:,:),POINTER :: OOC_INODE_SEQUENCE
20      INTEGER(8), DIMENSION(:,:),POINTER :: OOC_VADDR
21      INTEGER,DIMENSION(:),POINTER:: KEEP_OOC
22      INTEGER ICNTL1
23      INTEGER(8), DIMENSION(:),ALLOCATABLE :: AddVirtLibre
24      LOGICAL,SAVE :: STRAT_IO_ASYNC,WITH_BUF,SOLVE
25      INTEGER, DIMENSION(:),POINTER :: STEP_OOC,PROCNODE_OOC
26      INTEGER, SAVE :: MYID_OOC,SLAVEF_OOC,LOW_LEVEL_STRAT_IO
27      INTEGER(8), SAVE :: HBUF_SIZE, DIM_BUF_IO
28      INTEGER ERR_STR_OOC_MAX_LEN
29      PARAMETER(ERR_STR_OOC_MAX_LEN = 512)
30      CHARACTER(len=1):: ERR_STR_OOC(ERR_STR_OOC_MAX_LEN)
31      INTEGER DIM_ERR_STR_OOC
32      TYPE IO_BLOCK
33        INTEGER :: INODE
34        LOGICAL :: MASTER
35        INTEGER :: Typenode
36        INTEGER :: NROW, NCOL, NFS
37        LOGICAL :: Last
38        INTEGER :: LastPiv
39        INTEGER :: LastPanelWritten_L
40        INTEGER :: LastPanelWritten_U
41        INTEGER,POINTER,DIMENSION(:) :: INDICES
42      END TYPE
43      PUBLIC IO_BLOCK
44      INTEGER, PUBLIC :: STRAT_WRITE_MAX, STRAT_TRY_WRITE
45      PARAMETER (STRAT_WRITE_MAX=1, STRAT_TRY_WRITE=2)
46      END MODULE MUMPS_OOC_COMMON
47      SUBROUTINE MUMPS_OOC_CONVERT_2INTTOBIGINT(INT1,INT2,BIGINT)
48      IMPLICIT NONE
49      INTEGER INT1,INT2
50      INTEGER(8) BIGINT
51      INTEGER(8) TMP1,TMP2,CONV
52      PARAMETER (CONV=1073741824_8)
53      TMP1=int(INT1,kind=kind(TMP1))
54      TMP2=int(INT2,kind=kind(TMP2))
55      BIGINT=(TMP1*CONV)+TMP2
56      RETURN
57      END SUBROUTINE MUMPS_OOC_CONVERT_2INTTOBIGINT
58      SUBROUTINE MUMPS_OOC_CONVERT_BIGINTTO2INT(INT1,INT2,BIGINT)
59      IMPLICIT NONE
60      INTEGER INT1,INT2
61      INTEGER(8) BIGINT
62      INTEGER(8) TMP1,TMP2,CONV
63      PARAMETER (CONV=1073741824_8)
64      TMP1=BIGINT/CONV
65      TMP2=mod(BIGINT,CONV)
66      INT1=int(TMP1)
67      INT2=int(TMP2)
68      RETURN
69      END SUBROUTINE MUMPS_OOC_CONVERT_BIGINTTO2INT
70      SUBROUTINE MUMPS_OOC_INIT_FILETYPE
71     &           (TYPEF_L,TYPEF_U,TYPEF_CB,K201, K251, K50,
72     &            TYPEF_INVALID)
73      IMPLICIT NONE
74      INTEGER, intent(out):: TYPEF_L, TYPEF_U, TYPEF_CB
75      INTEGER, intent(in) :: K201, K251, K50
76      INTEGER, intent(in) :: TYPEF_INVALID
77      IF (K201 .EQ. 1 .AND. K50.EQ.0) THEN
78        IF ( K251.NE.2 ) THEN
79          TYPEF_L  = 1
80          TYPEF_U  = 2
81          TYPEF_CB = 3
82        ELSE
83          TYPEF_U  = 1
84          TYPEF_L  = TYPEF_INVALID
85          TYPEF_CB = 2
86        ENDIF
87      ELSE
88         TYPEF_L = 1
89         TYPEF_U = TYPEF_INVALID
90         TYPEF_CB=2
91      ENDIF
92      RETURN
93      END SUBROUTINE MUMPS_OOC_INIT_FILETYPE
94      INTEGER FUNCTION MUMPS_OOC_GET_FCT_TYPE
95     &                 (FWDORBWD, MTYPE, K201, K50)
96      USE MUMPS_OOC_COMMON
97      INTEGER,     intent(in) :: MTYPE, K201, K50
98      CHARACTER(len=1), intent(in) :: FWDORBWD
99      IF ( (TYPEF_L .NE. 1 .AND. TYPEF_L .NE. TYPEF_INVALID)
100     &     .OR. (TYPEF_U .NE. 1 .AND. TYPEF_U .NE. 2 .AND.
101     &           TYPEF_U .NE. TYPEF_INVALID) ) THEN
102        WRITE(*,*) "Internal error 1 in MUMPS_OOC_GET_FCT_TYPE",
103     &              TYPEF_L, TYPEF_U
104        CALL MUMPS_ABORT()
105      ENDIF
106      IF (FWDORBWD .NE. 'F' .AND. FWDORBWD .NE. 'B') THEN
107        WRITE(*,*) "Internal error in MUMPS_OOC_GET_FCT_TYPE,",FWDORBWD
108        CALL MUMPS_ABORT()
109      ENDIF
110      IF (K201 .EQ. 1) THEN
111        IF (FWDORBWD .EQ. 'F') THEN
112         IF((MTYPE.NE.1).AND.(K50.EQ.0))THEN
113           MUMPS_OOC_GET_FCT_TYPE=TYPEF_U
114         ELSE
115           MUMPS_OOC_GET_FCT_TYPE=TYPEF_L
116         ENDIF
117        ELSE
118          IF(K50.EQ.0)THEN
119            IF(MTYPE.NE.1)THEN
120              MUMPS_OOC_GET_FCT_TYPE=TYPEF_L
121            ELSE
122              MUMPS_OOC_GET_FCT_TYPE=TYPEF_U
123            ENDIF
124          ELSE
125            MUMPS_OOC_GET_FCT_TYPE=TYPEF_L
126          ENDIF
127        ENDIF
128      ELSE
129        MUMPS_OOC_GET_FCT_TYPE = 1
130      ENDIF
131      RETURN
132      END FUNCTION MUMPS_OOC_GET_FCT_TYPE
133