V3FIT
safe_open_mod.f90
1  MODULE safe_open_mod
2 !
3 ! Module for performing a "safe" open of a file for
4 ! a Fortran read/write operation. Makes sure the requested file
5 ! unit number is not in use, and increments it until an unused
6 ! unit is found
7 !
8  CONTAINS
9 
10  SUBROUTINE safe_open(iunit, istat, filename, filestat, &
11  & fileform, record_in, access_in, delim_in)
12 !
13 ! Module for performing a "safe" open of a file for
14 ! a Fortran read/write operation. Makes sure the requested file
15 ! unit number is not in use, and increments it until an unused
16 ! unit is found
17 !
18 ! Note that:
19 ! 1) the actual i/o unit number used is returned in the first argument.
20 ! 2) the status variable from the OPEN command is returned as the second
21 ! argument.
22 
23 ! Here are some examples of usage:
24 !
25 ! To open an existing namelist input file:
26 ! CALL safe_open(iou,istat,nli_file_name,'old','formatted')
27 !
28 ! To create a file, in order to write to it:
29 ! CALL safe_open(iou,istat,my_output_file_name,'replace','formatted')
30 !
31 ! To create an output file, with 'NONE' as delimiter for characters for
32 ! list-directed output and Namelist output
33 ! CALL safe_open(iou,istat,my_output_file_name,'replace',
34 ! & 'formatted',delim_in='none')
35 
36 ! JDH 08-30-2004.
37 ! Based on Steve Hirshman's original safe_open routine
38 ! Rearranged comments, continuation lines, some statement ordering.
39 ! Should be NO change in functionality.
40 !
41 ! JDH 2010-06-09
42 ! Added coding for DELIM specification
43 
44 
45  IMPLICIT NONE
46 !-----------------------------------------------
47 ! D u m m y A r g u m e n t s
48 !-----------------------------------------------
49  INTEGER, INTENT(inout) :: iunit
50  INTEGER, INTENT(out) :: istat
51  CHARACTER(LEN=*), INTENT(in) :: filename, filestat, fileform
52  INTEGER, INTENT(in), OPTIONAL :: record_in
53  CHARACTER(LEN=*), INTENT(in), OPTIONAL :: access_in
54  CHARACTER(LEN=*), INTENT(in), OPTIONAL :: delim_in
55 !-----------------------------------------------
56 ! L o c a l V a r i a b l e s
57 !-----------------------------------------------
58  CHARACTER(LEN=*), PARAMETER :: cdelim = "apostrophe", &
59  cform="formatted", cunform="unformatted", &
60  cscratch="scratch", cseq="sequential"
61  CHARACTER(LEN=10) :: acc_type
62  CHARACTER(LEN=10) :: delim_type
63  LOGICAL :: lopen, lexist, linvalid
64 !-----------------------------------------------
65 ! Start of Executable Code
66 !-----------------------------------------------
67 
68 !-----------------------------------------------
69 !
70 ! Check that unit is not already opened
71 ! Increment iunit until find one that is not in use
72 !
73  linvalid = .true.
74  IF (iunit < 0) THEN
75  WRITE (6, *) 'In safe_open, requested unit was uninitialized: IUNIT=', iunit
76  iunit = 10
77  END IF
78  DO WHILE (linvalid)
79  INQUIRE(iunit, exist=lexist, opened=lopen, iostat=istat)
80  linvalid = (istat.ne.0 .or. .not.lexist) .or. lopen
81  IF (.not.linvalid) EXIT
82  iunit = iunit + 1
83  END DO
84 
85 ! JDH 08-24-2004 This next IF(Present) clause seems to be duplicated below.
86 ! I think one of the two should be eliminated, for clarity.
87 
88  IF (PRESENT(access_in)) THEN
89  acc_type = trim(access_in)
90  ELSE
91  acc_type = cseq
92  END IF
93 
94 ! Why not call this variable lscratch?
95  lexist = (filestat(1:1).eq.'s') .or. (filestat(1:1).eq.'S') !Scratch file
96 
97 ! JDH 08-24-2004 Below is nearly exact duplicate of IF(Present) clause
98 ! from above
99 
100  IF (PRESENT(access_in)) THEN
101  acc_type = trim(access_in)
102  ELSE
103  acc_type = 'SEQUENTIAL'
104  END IF
105 
106 ! JDH 2010-06-09. Coding for DELIM
107  IF (PRESENT(delim_in)) THEN
108  SELECT CASE (delim_in(1:1))
109  CASE ('n', 'N')
110  delim_type = 'none'
111  CASE ('q', 'Q')
112  delim_type = 'quote'
113  CASE DEFAULT
114  delim_type = cdelim
115  END SELECT
116  ELSE
117  delim_type = cdelim
118  ENDIF
119 
120 ! Here are the actual OPEN commands. Eight different cases.
121  SELECT CASE (fileform(1:1))
122  CASE ('u', 'U')
123  IF (PRESENT(record_in)) THEN
124  IF (lexist) THEN ! unformatted, record length specified, scratch
125  OPEN(unit=iunit, form=cunform, status=cscratch, &
126  & recl=record_in, access=acc_type, iostat=istat)
127  ELSE ! unformatted, record length specified, non-scratch
128  OPEN(unit=iunit, file=trim(filename), form=cunform, &
129  & status=trim(filestat), recl=record_in, &
130  & access=acc_type, iostat=istat)
131  END IF
132  ELSE
133  IF (lexist) THEN ! unformatted, record length unspecified, scratch
134  OPEN(unit=iunit, form=cunform, status=cscratch, &
135  & access=acc_type, iostat=istat)
136  ELSE ! unformatted, record length unspecified, non-scratch
137  OPEN(unit=iunit, file=trim(filename), form=cunform, &
138  & status=trim(filestat), access=acc_type,iostat=istat)
139  END IF
140  END IF
141 
142  CASE DEFAULT
143  IF (PRESENT(record_in)) THEN
144  IF (lexist) THEN ! formatted, record length specified, scratch
145  OPEN(unit=iunit, form=cform, status=cscratch, &
146  delim=trim(delim_type), recl=record_in, &
147  access=acc_type, iostat=istat)
148  ELSE ! formatted, record length specified, non-scratch
149  OPEN(unit=iunit, file=trim(filename), form=cform, &
150  status=trim(filestat), delim=trim(delim_type), &
151  recl=record_in, access=acc_type, iostat=istat)
152  END IF
153  ELSE
154  IF (lexist) THEN ! formatted, record length unspecified, scratch
155  OPEN(unit=iunit, form=cform, status=cscratch, &
156  delim=trim(delim_type), access=acc_type, &
157  iostat=istat)
158  ELSE ! formatted, record length unspecified, non-scratch
159  OPEN(unit=iunit, file=trim(filename), form=cform, &
160  status=trim(filestat), delim=trim(delim_type), &
161  access=acc_type, iostat=istat)
162  END IF
163  END IF
164 
165  END SELECT
166 
167  END SUBROUTINE safe_open
168 
169  END MODULE safe_open_mod