1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
|
!
! Copyright (C) 1996-2016 The SIESTA group
! This file is distributed under the terms of the
! GNU General Public License: see COPYING in the top directory
! or http://www.gnu.org/copyleft/gpl.txt.
! See Docs/Contributors.txt for a list of contributors.
!
c
c Copyright Alberto Garcia, 1996, 1997, 1998
c
c This module implements an interface to the FORTRAN logical unit
c system. Based on code by Richard Maine.
c
c
c Alberto Garcia, December 30, 1996
c Rewritten as a single subroutine
c with multiple entry points, March 7, 1998
c Now hybrid to comply with Siesta "die" interface.
c---------------------------------------------------------------
c
subroutine io
use sys, only: die
c
c Logical unit management. Units 0 to min_lun-1 are "reserved",
c since most of the "typical" files (output, etc) use them.
c
c Logical units min_lun to min_max are managed by this module.
implicit none
c
c----------------------------------------------------------------
c Module variables
c
integer stdout, stderr
integer min_lun, max_lun, nunits
parameter (min_lun=10, max_lun=99, nunits=max_lun-min_lun+1)
logical lun_is_free(min_lun:max_lun)
save stdout, stderr, lun_is_free
c-----------------------------------------------------------------
c
c Internal and dummy variables
c
integer i, unit, lun, iostat
logical used, named, opened
character filename*50, form*11
c
c-----------------------------------------------------------------
c Initialization section
c
data lun_is_free /nunits*.true./
data stdout, stderr /6,0/
c-----------------------------------------------------------------
c
c Executable routines
c
c Simple interfaces to modify standard units
c
entry io_seterr(unit)
stderr = unit
return
entry io_setout(unit)
stdout = unit
return
entry io_geterr(unit)
unit = stderr
return
entry io_getout(unit)
unit = stdout
return
c
c------------------------------------------------------------------
c
c Logical unit management
c
entry io_assign(lun)
c
c Looks for a free unit and assigns it to lun
c
do lun= min_lun, max_lun
if (lun_is_free(lun)) then
inquire(unit=lun, opened=used, iostat=iostat)
if (iostat .ne. 0) used = .true.
lun_is_free(lun) = .false.
if (.not. used) return
endif
enddo
call die('No luns available in io_assign')
c
c===
c
entry io_reserve(lun)
c
c Useful to specify that one needs to use a particular unit number
c
c For example, assume some legacy code expects to work with unit 15:
c
c call io_reserve(15) ! this call at the beginning of the program
c ...
c open(15,....)
c
inquire(unit=lun, opened=used, iostat=iostat)
if (iostat .ne. 0) used = .true.
if (used) call die('Cannot reserve unit. Already connected')
if (lun .ge. min_lun .and. lun .le. max_lun)
$ lun_is_free(lun) = .false.
return
c
c===
c
entry io_close(lun)
c
c Use this routine instead of a simple close!!
c
close(lun)
if (lun .ge. min_lun .and. lun .le. max_lun)
$ lun_is_free(lun) = .true.
return
c
c===
c
entry io_status
c
c Prints a list of the connected logical units and the names of
c the associated files
c
write(stdout,'(a)') '******** io_status ********'
do i = 0, max_lun
inquire(i,opened=opened,named=named,name=filename,
$ form=form,iostat=iostat)
if (iostat .eq. 0) then
if (opened) then
if (named) then
write(stdout,9000) i, form, filename
else
write(stdout,9000) i, form, 'No name available'
endif
endif
else
write(stdout,9000) i, 'Iostat error'
endif
enddo
write(stdout,'(a)') '******** ********'
9000 format(i4,5x,a,5x,a)
return
end
|