1module m_reader 2 3use m_io 4 5private 6 7integer, parameter, public :: BUFFER_NOT_CONNECTED = -2048 8integer, private, parameter :: MAXLENGTH = 1024 9 10type, public :: file_buffer_t 11private 12 logical :: connected 13 logical :: eof 14 integer :: lun 15 character(len=50) :: filename 16 integer :: counter 17 character(len=MAXLENGTH) :: buffer 18 integer :: line 19 integer :: col 20 integer :: pos 21 integer :: nchars 22 logical :: debug 23end type file_buffer_t 24 25public :: get_character, sync_file 26public :: line, column, nchars_processed 27public :: open_file, close_file_buffer, rewind_file, mark_eof_file 28public :: eof_file 29 30private :: fill_buffer 31 32CONTAINS 33 34!----------------------------------------- 35! 36subroutine open_file(fname,fb,iostat,record_size,verbose) 37character(len=*), intent(in) :: fname 38type(file_buffer_t), intent(out) :: fb 39integer, intent(out) :: iostat 40integer, intent(in), optional :: record_size 41logical, intent(in), optional :: verbose 42 43iostat = 0 44 45call setup_io() 46 47fb%connected = .false. 48 49call get_unit(fb%lun,iostat) 50if (iostat /= 0) then 51 if (fb%debug) print *, "Cannot get unit" 52 return 53endif 54 55if (present(verbose)) then 56 fb%debug = verbose 57else 58 fb%debug = .false. 59endif 60 61if (present(record_size)) then 62 open(unit=fb%lun,file=fname,form="formatted",status="old", & 63 action="read",position="rewind",recl=record_size,iostat=iostat) 64else 65 open(unit=fb%lun,file=fname,form="formatted",status="old", & 66 action="read",position="rewind",recl=65536,iostat=iostat) 67endif 68if (iostat /= 0) then 69 if (fb%debug) print *, "Cannot open file ", trim(fname), " iostat: ", iostat 70 return 71endif 72 73fb%connected = .true. 74fb%counter = 0 75fb%eof = .false. 76fb%line = 1 77fb%col = 0 78fb%filename = fname 79fb%pos = 0 80fb%nchars = 0 81fb%buffer = "" 82 83end subroutine open_file 84 85!------------------------------------------------- 86subroutine rewind_file(fb) 87type(file_buffer_t), intent(inout) :: fb 88 89fb%eof = .false. 90fb%counter = 0 91fb%line = 1 92fb%col = 0 93fb%pos = 0 94fb%nchars = 0 95fb%buffer = "" 96 97rewind(unit=fb%lun) 98 99end subroutine rewind_file 100!----------------------------------------- 101subroutine mark_eof_file(fb) 102type(file_buffer_t), intent(inout) :: fb 103 104fb%eof = .true. 105 106end subroutine mark_eof_file 107 108!----------------------------------------- 109subroutine close_file_buffer(fb) 110type(file_buffer_t), intent(inout) :: fb 111 112if (fb%connected) then 113 close(unit=fb%lun) 114 fb%connected = .false. 115endif 116 117end subroutine close_file_buffer 118 119!------------------------------------------------- 120function eof_file(fb) result (res) 121type(file_buffer_t), intent(in) :: fb 122logical :: res 123 124res = fb%eof 125 126end function eof_file 127!----------------------------------------- 128!----------------------------------------- 129! New version, able to cope with arbitrarily long lines 130! (still need to specify a big enough record_size if necessary) 131! 132subroutine fill_buffer(fb,iostat) 133type(file_buffer_t), intent(inout) :: fb 134integer, intent(out) :: iostat 135! 136! 137character(len=81) :: str ! 80 seems like a good compromise? 138 ! (1 extra for added newline, see below) 139integer :: len=-1 ! initialization for buggy compilers 140! 141read(unit=fb%lun,iostat=iostat,advance="no",size=len,fmt="(a80)") str 142 143if (iostat == io_eof) then 144 145 ! End of file 146 if (fb%debug) print *, "End of file." 147 return 148 149else if (iostat > 0) then 150 151 ! Hard i/o error 152 if (fb%debug) print *, "Hard i/o error. iostat:", iostat 153 RETURN 154 155else 156! 157 if (fb%debug) then 158 print *, "Buffer: len, iostat", len, iostat 159 print *, trim(str) 160 endif 161 162 fb%pos = 0 163 164 if (iostat == 0) then 165 166 ! Normal read, with more stuff left on the line 167 ! 168 fb%buffer = str(1:len) 169 fb%nchars = len 170 171 else ! (end of record) 172 ! 173 ! End of record. We mark it with an LF, whatever it is the native marker. 174 ! 175!! fb%buffer = str(1:len) // char(10) 176 fb%buffer = str(1:len) !! Avoid allocation of string 177 len = len + 1 !! by compiler 178 fb%buffer(len:len) = char(10) 179 fb%nchars = len 180 iostat = 0 181 endif 182 183endif 184 185end subroutine fill_buffer 186 187!--------------------------------------------------------------- 188subroutine get_character(fb,c,iostat) 189character(len=1), intent(out) :: c 190type(file_buffer_t), intent(inout) :: fb 191integer, intent(out) :: iostat 192 193character(len=1) :: c_next 194 195if (.not. fb%connected) then 196 iostat = BUFFER_NOT_CONNECTED 197 return 198endif 199 200if (fb%pos >= fb%nchars) then 201 call fill_buffer(fb,iostat) 202 if (iostat /= 0) return 203endif 204fb%pos = fb%pos + 1 205c = fb%buffer(fb%pos:fb%pos) 206fb%counter = fb%counter + 1 ! Raw counter 207fb%col = fb%col + 1 208! 209! Deal with end-of-line handling on the processor... 210! 211if (c == char(10)) then 212 ! Our own marker for end of line 213 fb%line = fb%line + 1 214 fb%col = 0 215endif 216if (c == char(13)) then 217 c_next = fb%buffer(fb%pos+1:fb%pos+1) 218 if (c_next == char(10)) then 219 ! 220 ! Found CRLF. We replace it by LF, as per specs. 221 c = c_next 222 fb%pos = fb%pos + 1 223 if (fb%debug) print *, "-/-> Removed CR before LF in get_character" 224 else 225 ! Replace single CR by LF 226 c = char(10) 227 if (fb%debug) print *, "-/-> Changed CR to LF in get_character -- line++" 228 ! 229 endif 230 ! In both cases we increase the line counter and reset the column 231 ! 232 fb%line = fb%line + 1 233 fb%col = 0 234endif 235 236iostat = 0 237 238end subroutine get_character 239 240!---------------------------------------------------- 241!---------------------------------------------------- 242! Error Location functions 243! 244function line(fb) result (ll) 245type(file_buffer_t), intent(in) :: fb 246integer :: ll 247 248ll = fb%line 249end function line 250 251!---------------------------------------------------- 252function column(fb) result (col) 253type(file_buffer_t), intent(in) :: fb 254integer :: col 255 256col = fb%col 257end function column 258!---------------------------------------------------- 259!---------------------------------------------------- 260function nchars_processed(fb) result (nc) 261type(file_buffer_t), intent(in) :: fb 262integer :: nc 263 264nc = fb%counter 265end function nchars_processed 266!---------------------------------------------------- 267 268subroutine sync_file(fb,iostat) 269type(file_buffer_t), intent(inout) :: fb 270integer, intent(out) :: iostat 271! 272! Repositions the file so that it matches with 273! the stored file_buffer information 274! 275integer :: target_counter 276character(len=1) :: c 277 278target_counter = fb%counter 279call rewind_file(fb) 280iostat = 0 281do 282 if (fb%counter == target_counter) exit 283 call get_character(fb,c,iostat) 284 if (iostat /= 0) return 285enddo 286 287end subroutine sync_file 288 289end module m_reader 290 291 292 293 294 295 296 297 298 299