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