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