/
m_common_io.F90
102 lines (78 loc) · 2.02 KB
/
m_common_io.F90
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
module m_common_io
#ifndef DUMMYLIB
use m_common_error, only : FoX_error
implicit none
private
! Basic I/O tools
integer, save :: io_eor
integer, save :: io_eof
integer, save :: io_err
public :: io_eor
public :: io_eof
public :: io_err
public :: get_unit
public :: setup_io
contains
subroutine setup_io()
call find_eor_eof(io_eor, io_eof)
end subroutine setup_io
subroutine get_unit(lun,iostat)
! Get an available Fortran unit number
integer, intent(out) :: lun
integer, intent(out) :: iostat
integer :: i
logical :: unit_used
do i = 10, 99
lun = i
inquire(unit=lun,opened=unit_used)
if (.not. unit_used) then
iostat = 0
return
endif
enddo
iostat = -1
lun = -1
end subroutine get_unit
subroutine find_eor_eof(io_eor,io_eof)
! Determines the values of the iostat values for End of File and
! End of Record (in non-advancing I/O)
#ifdef __NAG__
use f90_iostat
#endif
integer, intent(out) :: io_eor
integer, intent(out) :: io_eof
#ifdef __NAG__
io_eor = ioerr_eor
io_eof = ioerr_eof
#else
integer :: lun, iostat
character(len=1) :: c
call get_unit(lun,iostat)
if (iostat /= 0) call FoX_error("Out of unit numbers")
open(unit=lun,status="scratch",form="formatted", &
action="readwrite",position="rewind",iostat=iostat)
if (iostat /= 0) call FoX_error("Cannot open test file")
write(unit=lun,fmt=*) "a"
write(unit=lun,fmt=*) "b"
rewind(unit=lun)
io_eor = 0
do
read(unit=lun,fmt="(a1)",advance="no",iostat=io_eor) c
if (io_eor /= 0) exit
enddo
io_eof = 0
do
read(unit=lun,fmt=*,iostat=io_eof)
if (io_eof /= 0) exit
enddo
close(unit=lun,status="delete")
#endif
! Invent an io_err ...
io_err = 1
do
if (io_err/=0.and.io_err/=io_eor.and.io_err/=io_eof) exit
io_err = io_err + 1
end do
end subroutine find_eor_eof
#endif
end module m_common_io