1#if defined HAVE_CONFIG_H
2#include "config.h"
3#endif
4
5!!@LICENSE
6!
7!     MODULE m_io
8!
9! Copyright Alberto Garcia, 1996, 1997, 1998
10!
11! This module implements an interface to the FORTRAN logical unit
12! system. Based on code by Richard Maine.
13!
14! Alberto Garcia, December 30, 1996
15! Rewritten as a single subroutine
16! with multiple entry points, March 7, 1998
17! Now hybrid to comply with Siesta "die" interface.
18! Converted to a module by J.M.Soler. Aug. 2009
19! Convert to F90 by Nick R. Papior, Feb, 2018
20!---------------------------------------------------------------
21!
22MODULE m_io
23  !
24  !-----------------------------------------------------------------
25  !
26  !     Used module procedures
27  !
28  USE sys, only: die   ! Termination routine
29
30  implicit none
31  !
32  !-----------------------------------------------------------------
33  !
34  !     Public procedures provided by this module
35  !
36  PUBLIC :: io_seterr  ! Set standard error unit
37  PUBLIC :: io_setout  ! Set standard output unit
38  PUBLIC :: io_geterr  ! Get standard error unit
39  PUBLIC :: io_getout  ! Get standard output unit
40  PUBLIC :: io_assign  ! Get some available IO unit and reserve it
41  PUBLIC :: io_reserve ! Reserve a specific IO unit
42  PUBLIC :: io_close   ! Close and free a given IO unit
43  PUBLIC :: io_status   ! Print all used IO units
44
45  PRIVATE ! Nothing is declared public below this point
46  !
47  !----------------------------------------------------------------
48  !
49  !     Module variables
50  !
51  !     Logical unit management. Units 0 to min_lun-1 are "reserved",
52  !     since most of the "typical" files (output, etc) use them.
53  !
54  !     Logical units min_lun to min_max are managed by this module.
55  !
56  integer, parameter:: min_lun = 10
57  integer, parameter:: max_lun = 99
58  integer, parameter:: nunits = max_lun-min_lun+1
59  integer, save:: stdout = 6
60  integer, save:: stderr = 0
61  logical, save:: lun_is_free(min_lun:max_lun) = .true.
62  !
63  !-----------------------------------------------------------------
64  !
65  !     Internal and dummy variables
66  !
67  integer  :: i, iostat
68  logical  :: used, named, opened
69  character:: filename*50, form*11
70  !
71CONTAINS
72  !
73  !-----------------------------------------------------------------
74  !
75  !     Simple interfaces to modify standard units
76  !
77  subroutine io_seterr(unit)
78    integer,intent(in):: unit
79    stderr = unit
80  end subroutine io_seterr
81  !
82  !-----------------------------------------------------------------
83  !
84  subroutine io_setout(unit)
85    integer,intent(in):: unit
86    stdout = unit
87  end subroutine io_setout
88  !
89  !-----------------------------------------------------------------
90  !
91  subroutine io_geterr(unit)
92    integer,intent(out):: unit
93    unit = stderr
94  end subroutine io_geterr
95  !
96  !-----------------------------------------------------------------
97  !
98  subroutine io_getout(unit)
99    integer,intent(out):: unit
100    unit = stdout
101  end subroutine io_getout
102  !
103  !------------------------------------------------------------------
104  !
105  !     Logical unit management
106  !
107  subroutine io_assign(lun)
108    integer,intent(out):: lun
109    !
110    !     Looks for a free unit and assigns it to lun
111    !
112    do lun= min_lun, max_lun
113      if (lun_is_free(lun)) then
114        inquire(unit=lun, opened=used, iostat=iostat)
115        if (iostat .ne. 0) used = .true.
116        lun_is_free(lun) = .false.
117        if (.not. used) return
118      endif
119    enddo
120    call die('No luns available in io_assign')
121
122  end subroutine io_assign
123  !
124  !------------------------------------------------------------------
125  !
126  subroutine io_reserve(lun)
127    integer,intent(in):: lun
128    !
129    !     Useful to specify that one needs to use a particular unit number
130    !
131    !     For example, assume some legacy code expects to work with unit 15:
132    !
133    !     call io_reserve(15)   ! this call at the beginning of the program
134    !     ...
135    !     open(15,....)
136    !
137    inquire(unit=lun, opened=used, iostat=iostat)
138    if (iostat .ne. 0) used = .true.
139    if (used) call die('Cannot reserve unit. Already connected')
140    if (lun .ge. min_lun .and. lun .le. max_lun) &
141        lun_is_free(lun) = .false.
142
143  end subroutine io_reserve
144  !
145  !------------------------------------------------------------------
146  !
147  subroutine io_close(lun)
148    integer,intent(in):: lun
149    !
150    !     Use this routine instead of a simple close!!
151    !
152    close(lun)
153    if (lun .ge. min_lun .and. lun .le. max_lun) &
154        lun_is_free(lun) = .true.
155
156  end subroutine io_close
157  !
158  !------------------------------------------------------------------
159  !
160  subroutine io_status
161    !
162    !     Prints a list of the connected logical units and the names of
163    !     the associated files
164    !
165
166    write(stdout,'(a)') '******** io_status ********'
167    do i = 0, max_lun
168      inquire(i,opened=opened,named=named,name=filename, &
169          form=form,iostat=iostat)
170      if (iostat .eq. 0) then
171        if (opened) then
172          if (named) then
173            write(stdout,'(i4,5x,a,5x,a)') i, form, filename
174          else
175            write(stdout,'(i4,5x,a,5x,a)') i, form, 'No name available'
176          endif
177        endif
178      else
179        write(stdout,'(i4,5x,a,5x,a)') i, 'Iostat error'
180      endif
181    enddo
182    write(stdout,'(a)') '********           ********'
183
184  end subroutine io_status
185
186END MODULE m_io
187
188