To say what the “best” method is depends on whether you are reading from stdin or just
files, whether you need to operate on the data before hitting EOF, what the biggest file
is you need to read, and how many times you need to do it. That being said, here is
one self-contained example. A bit long, but it is extracted from something relatively
general.
Note that a simple but perhaps non-obvious way to handle files like stdin you cannot
read twice is to write it into a Fortran scratch file so you have an actual file you can rewind
and read multiple times; one of the few things not mentioned so far that can be useful
depending on the method you use. For small files I often do not need to know the original
line lengths and for simplicity just read everything into an array of standard strings.
Here is a module that defines a procedure called fileread() that works for simple cases
where that is OK. There are several Open Source versions of routines that do this using
various methods. This one is a cut-down version of one
from General Purpose Fortran.
If you use fpm(1) you can just use that or the module M_io.
An abridged version that is a self-contained module that creates the readfile(3f) procedure:
M_slurp module
MODULE M_slurp
use, intrinsic :: iso_fortran_env, only : stdin=>input_unit, stdout=>output_unit, stderr=>error_unit
implicit none
private
public fileread
integer,parameter,private:: sp=kind(1.0), dp=kind(1.0d0)
character(len=*),parameter,private :: gen='(*(g0,1x))'
CONTAINS
subroutine fileread(FILENAME,pageout)
implicit none
character(*),intent(in) :: FILENAME ! file to read
character(len=:),allocatable,intent(out) :: pageout(:) ! page to hold file in memory
character(len=1),allocatable :: text(:) ! array to hold file in memory
call filebyte(FILENAME,text) ! allocate character array and copy file into it
if(.not.allocated(text))then
write(*,*)'*fileread* failed to load file '//FILENAME
else ! convert array of characters to array of lines
pageout=page(text)
deallocate(text) ! release memory
endif
contains
function page(array) result (table)
!@(#) page(3fp): function to copy char array to page of text
character(len=1),intent(in) :: array(:)
character(len=:),allocatable :: table(:)
integer :: i
integer :: linelength
integer :: length
integer :: lines
integer :: linecount
integer :: position
integer :: sz
character(len=1),parameter :: nl = char(10)
character(len=1),parameter :: cr = char(13)
lines = 0
linelength = 0
length = 0
sz=size(array)
do i = 1,sz
if( array(i) == nl )then
linelength = max(linelength,length)
lines = lines + 1
length = 0
else
length = length + 1
endif
enddo
if( sz > 0 )then
if( array(sz) /= nl )then
lines = lines+1
endif
endif
if(allocated(table))deallocate(table)
allocate(character(len=linelength) :: table(lines))
table(:) = ' '
linecount = 1
position = 1
do i = 1,sz
if( array(i) == nl )then
linecount=linecount+1
position=1
elseif( array(i) == cr )then
elseif( linelength /= 0 )then
table(linecount)(position:position) = array(i)
position = position+1
endif
enddo
end function page
end subroutine fileread
subroutine filebyte(filename,text,length,lines)
implicit none
!@(#) M_slurp::filebyte(3f): allocate text array and read file filename into it
character(*),intent(in) :: filename ! filename to shlep
character(len=1),allocatable,intent(out) :: text(:) ! array to hold file
integer,intent(out),optional :: length ! length of longest line
integer,intent(out),optional :: lines ! number of lines
integer :: nchars=0 ! holds size of file
integer :: igetunit ! use newunit=igetunit in f08
integer :: ios=0 ! used for I/O error status
integer :: length_local
integer :: lines_local
integer :: i
integer :: icount
character(len=256) :: message
character(len=4096) :: label
character(len=:),allocatable :: line
length_local=0
lines_local=0
message=''
open(newunit=igetunit, file=trim(filename), action="read", iomsg=message,&
&form="unformatted", access="stream",status='old',iostat=ios)
label=filename
if(ios == 0)then ! if file was successfully opened
inquire(unit=igetunit, size=nchars)
if(nchars <= 0)then
call stderr_local( '*filebyte* empty file '//trim(label) )
return
endif
! read file into text array
if(allocated(text))deallocate(text) ! make sure text array not allocated
allocate ( text(nchars) ) ! make enough storage to hold file
read(igetunit,iostat=ios,iomsg=message) text ! load input file -> text array
if(ios /= 0)then
call stderr_local( '*filebyte* bad read of '//trim(label)//':'//trim(message) )
endif
else
call stderr_local('*filebyte* '//message)
allocate ( text(0) ) ! make enough storage to hold file
endif
close(iostat=ios,unit=igetunit) ! close if opened successfully or not
if(present(lines).or.present(length))then ! get length of longest line and number of lines
icount=0
do i=1,nchars
if(text(i) == NEW_LINE('A'))then
lines_local=lines_local+1
length_local=max(length_local,icount)
icount=0
endif
icount=icount+1
enddo
if(nchars /= 0)then
if(text(nchars) /= NEW_LINE('A'))then
lines_local=lines_local+1
length_local=max(length_local,icount)
endif
endif
if(present(lines))lines=lines_local
if(present(length))length=length_local
endif
end subroutine filebyte
subroutine stderr_local(message)
character(len=*) :: message
write(stderr,'(a)')trim(message) ! write message to standard error
end subroutine stderr_local
end module M_slurp
A little program to test the module reads the file “testin” in and prints the
lines surrounded with braces and then removes lines beginning with “#”;
except I either made a typo or hit a gfortran bug (works with ifx):kkkkkk
program testit
use M_slurp, only : fileread
implicit none
character(len=:),allocatable :: pageout(:) ! page to hold file in memory
integer :: i
logical,allocatable :: keep(:)
call fileread('testin',pageout)
write(*,*)'write file enclosed in braces'
write(*,*)'size=',size(pageout),',len=',len(pageout)
write(*,'(*(g0))')('[',trim(pageout(i)),']',new_line('A'),i=1,size(pageout))
! remove lines starting with "#"
! A bug inn gfortran? works with ifx
keep=index(adjustl(pageout),'#').ne.1
pageout=pack(pageout,keep)
write(*,*)'remove lines starting with "#"'
write(*,*)'size=',size(pageout),',len=',len(pageout)
write(*,'(*(i5,": ",a,/))')(i,trim(pageout(i)),i=1,size(pageout))
end program testit