File: /nfs/home/0/users/jenkins/mfix.git/model/open_file.f

1     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvC
2     !                                                                      C
3     !  Module name: OPEN_FILE                                              C
4     !  Purpose: open a file                                                C
5     !                                                                      C
6     !  Author: P. Nicoletti                               Date: 12-DEC-91  C
7     !  Reviewer: P. Nicoletti, W. Rogers, M. Syamlal      Date: 24-JAN-92  C
8     !                                                                      C
9     !  Revision Number:                                                    C
10     !  Purpose:                                                            C
11     !  Author:                                            Date: dd-mmm-yy  C
12     !  Reviewer:                                          Date: dd-mmm-yy  C
13     !                                                                      C
14     !  Literature/Document References:                                     C
15     !                                                                      C
16     !  Variables referenced:                                               C
17     !  Variables modified:                                                 C
18     !                                                                      C
19     !  Local variables:                                                    C
20     !                                                                      C
21     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^C
22           SUBROUTINE OPEN_FILE(FILENAME, NB, IUNIT, EXT, FULL_NAME,        &
23              OPEN_STAT, OPEN_ACCESS, OPEN_FORM, IRECL, IER)
24     
25           use cdist
26           use compar
27     
28           IMPLICIT NONE
29     
30     ! Dummy Arguments
31     !---------------------------------------------------------------------//
32     ! FILENAME (without extension)
33           CHARACTER(LEN=*), INTENT(IN) :: FILENAME
34     ! File extension.
35           CHARACTER(LEN=*), INTENT(IN) :: EXT
36     ! FILENAME + EXTENSION
37           CHARACTER(LEN=*), INTENT(INOUT) :: FULL_NAME
38     ! File status (NEW, OLD, UNKNOWN)
39           CHARACTER(LEN=*), INTENT(IN) :: OPEN_STAT
40     ! File access method ('SEQUENTIAL', 'DIRECT')
41           CHARACTER(LEN=*), INTENT(IN) :: OPEN_ACCESS
42     ! Open form ('FORMATTED' or 'UNFORMATTED')
43           CHARACTER(LEN=*)   OPEN_FORM
44     ! Index to first blank character in FILENAME
45           INTEGER, INTENT(IN) :: NB
46     ! Unit number to open
47           INTEGER, INTENT(IN) :: IUNIT
48     ! Record length
49           INTEGER, INTENT(IN) :: IRECL
50     ! Integer Error index:
51     ! 000 - no error
52     ! 100 - NEW run with existing files in directory
53     ! 101 - OLD run missing RES and/or SPx files
54     ! 102 - Unknown OPEN_STAT
55           INTEGER, INTENT(OUT) :: IER
56     
57     ! Local Variables
58     !---------------------------------------------------------------------//
59     ! Logical used to store result of file INQUIRE
60           LOGICAL :: FILE_EXISTS
61     
62     ! Logicals that determine if files should be index.
63           LOGICAL :: RES_IDX  ! Index RES files
64           LOGICAL :: SPX_IDX  ! Index SPx files
65           LOGICAL :: USE_IDX  ! Use the IDX value
66     
67     ! Initialize the error flag.
68           IER = 0
69     
70     ! Conditions for indexing the RES files for distributed IO.
71           RES_IDX = (myPE .NE. PE_IO) .OR. (.NOT.bStart_with_one_RES)
72     ! Conditions for indexing the SPX files for distributed IO.
73           SPX_IDX = .TRUE.
74     
75     ! Flag for indexing files.
76           USE_IDX = bDist_IO .AND. (                                       &
77              (SPX_IDX .AND. (EXT(2:3) .EQ. 'SP')) .OR.                     &
78              (RES_IDX .AND. (EXT(2:4) .EQ. 'RES')))
79     
80     ! Construct the file name.
81           FULL_NAME = ''
82           IF(USE_IDX)THEN
83              WRITE(FULL_NAME,1000) FILENAME(1:NB-1), myPE, EXT(1:4)
84           ELSE
85              WRITE(FULL_NAME,1001) FILENAME(1:NB-1), EXT(1:4)
86           ENDIF
87     
88     ! Check to see if the file already exists in the run directory.
89           INQUIRE(FILE=trim(FULL_NAME),EXIST=FILE_EXISTS)
90     
91     ! NEW files should not be in the run directory.
92           IF(FILE_EXISTS .AND. (OPEN_STAT == 'NEW')) THEN
93              IER = 100; RETURN
94     ! OLD files must be in the run directory.
95           ELSEIF(.NOT. FILE_EXISTS .AND. OPEN_STAT .EQ. 'OLD') THEN
96              IER = 101; RETURN
97           ENDIF
98     
99     ! Open direct access files.
100           IF (OPEN_ACCESS == 'DIRECT') THEN
101              OPEN (UNIT=IUNIT, FILE=trim(FULL_NAME), STATUS=OPEN_STAT,     &
102                 RECL=IRECL, ACCESS=OPEN_ACCESS, FORM=OPEN_FORM, IOSTAT=IER)
103           ELSE
104     ! No matter the status passed to the routine, the file is created as
105     ! NEW if it doesn't exist in the run directory.
106              IF(.NOT.FILE_EXISTS) THEN
107                 OPEN(UNIT=IUNIT, FILE=trim(FULL_NAME), STATUS='NEW',       &
108                    ACCESS=OPEN_ACCESS, FORM=OPEN_FORM, IOSTAT=IER)
109              ELSEIF(OPEN_STAT == 'REPLACE') THEN
110                 OPEN(UNIT=IUNIT, FILE=trim(FULL_NAME), STATUS=OPEN_STAT,   &
111                    ACCESS=OPEN_ACCESS, FORM=OPEN_FORM, IOSTAT=IER)
112              ELSEIF(OPEN_STAT == 'APPEND' .OR. OPEN_STAT == 'UNKNOWN') THEN
113                 OPEN(UNIT=IUNIT, FILE=trim(FULL_NAME), STATUS='UNKNOWN',   &
114                    ACCESS=OPEN_ACCESS, FORM=OPEN_FORM, POSITION='APPEND',  &
115                    IOSTAT=IER)
116              ELSE
117                 IER = 102
118              ENDIF
119           ENDIF
120     
121           RETURN
122     
123      1000 FORMAT(A,'_',I5.5,A4)
124      1001 FORMAT(A,A4)
125     
126           END SUBROUTINE OPEN_FILE
127