1#define THIS_FILE "io_fdf.F90"
2!=====================================================================
3!
4! This file is part of the FDF package.
5!
6! This module implements an interface to the FORTRAN logical unit
7! system. Based on code by Richard Maine.
8!
9! Logical unit management. Units 0 to min_lun-1 are "reserved",
10! since most of the "typical" files (output, etc) use them.
11!
12! Logical units min_lun to min_max are managed by this module.
13!
14!
15! September 2007
16!
17!
18!=====================================================================
19
20#define ERROR_UNIT  0
21#define OUTPUT_UNIT 6
22
23MODULE io_fdf
24  USE utils
25  USE prec
26  USE iso_fortran_env
27  implicit none
28
29! General callable functions
30  public :: io_seterr, io_setout
31  public :: io_geterr, io_getout
32
33  public :: io_assign, io_reserve
34  public :: io_close, io_status
35
36
37! Error and Output Units
38  integer(ip), private :: stderr = ERROR_UNIT,                          &
39                          stdout = OUTPUT_UNIT
40
41! Unit control variables
42  integer(ip), parameter, private :: min_lun = 10, max_lun = 99
43  integer(ip), parameter, private :: nunits = max_lun-min_lun+1
44  logical, private                :: lun_is_free(min_lun:max_lun) = .TRUE.
45
46
47  CONTAINS
48
49!
50!   Set IO error unit
51!
52    SUBROUTINE io_seterr(unit)
53      implicit none
54!-------------------------------------------------------------- Output Variables
55      integer(ip), intent(inout) :: unit
56!------------------------------------------------------------------------- BEGIN
57      stderr = unit
58      RETURN
59!--------------------------------------------------------------------------- END
60    END SUBROUTINE io_seterr
61
62!
63!   Set IO output unit
64!
65    SUBROUTINE io_setout(unit)
66      implicit none
67!-------------------------------------------------------------- Output Variables
68      integer(ip), intent(inout) :: unit
69!------------------------------------------------------------------------- BEGIN
70      stdout = unit
71      RETURN
72!--------------------------------------------------------------------------- END
73    END SUBROUTINE io_setout
74
75!
76!   Get IO error unit
77!
78    SUBROUTINE io_geterr(unit)
79      implicit none
80!-------------------------------------------------------------- Output Variables
81      integer(ip), intent(inout) :: unit
82!------------------------------------------------------------------------- BEGIN
83      unit = stderr
84      RETURN
85!--------------------------------------------------------------------------- END
86    END SUBROUTINE io_geterr
87
88!
89!   Get IO output unit
90!
91    SUBROUTINE io_getout(unit)
92      implicit none
93!-------------------------------------------------------------- Output Variables
94      integer(ip), intent(inout) :: unit
95!------------------------------------------------------------------------- BEGIN
96      unit = stdout
97      RETURN
98!--------------------------------------------------------------------------- END
99    END SUBROUTINE io_getout
100
101
102!
103!   Looks for a free unit and assigns it to lun
104!
105    SUBROUTINE io_assign(lun)
106      implicit none
107!-------------------------------------------------------------- Output Variables
108      integer(ip), intent(inout) :: lun
109
110!--------------------------------------------------------------- Local Variables
111      logical                    :: used, found
112      integer(ip)                :: i, iostat
113
114!------------------------------------------------------------------------- BEGIN
115
116      i     = min_lun
117      found = .FALSE.
118      do while((.not. found) .and. (i .le. max_lun))
119        if (lun_is_free(i)) then
120
121          INQUIRE(unit=i, opened=used, iostat=iostat)
122          if (iostat .ne. 0) used = .TRUE.
123          if (.not. used) then
124            lun   = i
125            found = .TRUE.
126          endif
127
128          lun_is_free(i) = .FALSE.
129        endif
130
131        i = i + 1
132      enddo
133
134      if (.not. found) then
135        call die('IO module: io_assign', 'No LUNs available',           &
136                 THIS_FILE, __LINE__)
137      endif
138
139      RETURN
140!--------------------------------------------------------------------------- END
141    END SUBROUTINE io_assign
142
143!
144!   Useful to specify that one needs to use a particular unit number
145!   for example, assume some legacy code expects to work with unit 15:
146!   call io_reserve(15)   ! this call at the beginning of the program
147!   ...
148!   open(15,....)
149!
150    SUBROUTINE io_reserve(lun)
151      implicit none
152!-------------------------------------------------------------- Output Variables
153      integer(ip), intent(inout) :: lun
154
155!--------------------------------------------------------------- Local Variables
156      logical                    :: used
157      character(80)              :: msg
158      integer(ip)                :: iostat
159
160!------------------------------------------------------------------------- BEGIN
161      INQUIRE(unit=lun, opened=used, iostat=iostat)
162      if (iostat .ne. 0) used = .TRUE.
163      if (used) then
164        write(msg,'(a,i3,a)')                                           &
165             'Cannot reserve unit',lun,'. Already connected'
166        call die('IO module: io_reserve', msg, THIS_FILE, __LINE__)
167      endif
168
169      if ((lun .ge. min_lun) .and. (lun .le. max_lun))                  &
170        lun_is_free(lun) = .FALSE.
171
172      RETURN
173!--------------------------------------------------------------------------- END
174    END SUBROUTINE io_reserve
175
176!
177!   Use this routine instead of a simple close
178!
179    SUBROUTINE io_close(lun)
180      implicit none
181!-------------------------------------------------------------- Output Variables
182      integer(ip), intent(inout) :: lun
183
184!------------------------------------------------------------------------- BEGIN
185      CLOSE(lun)
186      if ((lun .ge. min_lun) .and. (lun .le. max_lun))                  &
187        lun_is_free(lun) = .TRUE.
188
189      RETURN
190!--------------------------------------------------------------------------- END
191    END SUBROUTINE io_close
192
193!
194!   Prints a list of the connected logical units and the names of
195!   the associated files
196!
197    SUBROUTINE io_status()
198      implicit none
199!--------------------------------------------------------------- Local Variables
200      logical       :: opened, named
201      character(80) :: filename
202      character(11) :: form
203      integer(ip)   :: i, iostat
204
205!------------------------------------------------------------------------- BEGIN
206      write(stdout,'(a)') '******** io_status ********'
207      do i= 0, max_lun
208        INQUIRE(i, opened=opened, named=named, name=filename,           &
209                form=form, iostat=iostat)
210        if (iostat .eq. 0) then
211          if (opened) then
212            if (named) then
213              write(stdout,'(i4,5x,a,5x,a)') i, form, filename
214            else
215              write(stdout,'(i4,5x,a,5x,a)') i, form, 'No name available'
216            endif
217          endif
218        else
219          write(stdout,'(i4,5x,a,5x,a)') i, 'IOSTAT error'
220        endif
221      enddo
222      write(stdout,'(a)') '********           ********'
223
224      RETURN
225!--------------------------------------------------------------------------- END
226    END SUBROUTINE io_status
227
228END MODULE io_fdf
229