Permalink
Fetching contributors…
Cannot retrieve contributors at this time
103 lines (78 sloc) 2.02 KB
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