Fortran Wiki
M_slurp
filter ASCII on stdin
Fortran does not yet have a portable method of opening preassigned files like stdin as a stream. This makes it problematic to create filters, a ubiquitious component of GNU/Linux and Unix environments.
One possibility is to call C routines such as getchar(). Another is to use non-portable methods to open stdin, but INQUIRE() and OPEN() and CLOSE() operate in platform-specific ways with pre-assigned files in particular so this is generally a solution only for one compiler and/or operating system environment.
But if the input is plain ASCII with line lengths less than the Fortran line length (generally in the range of 2G on most modern platforms) and the file is going to be read into a fixed-width character array the M_slurp module shown below may be re-used to create such small filter programs. It reads ASCII files from stdin until an end-of-file is encountered and returns a character array.
This is a common operation when multiple passes through the text are required.
Note that if the file can be processed line by line reading the file into memory is not technically needed. Reading the file into memory and not starting processing until an end-of-file can limit the size of the file that can be processed based on the amount of memory available. Even so, it is reasonable to use this method as long as the files are small enough as it encapsulates all the I/O into a single call, which as you will see is very appealing.
A few example programs follow showing uses of the M_slurp module:
- reverse order of lines in a file
- sort lines removing leading spaces
- expand tabs, trim whitespace from end of lines
- line up double-colon strings in Fortran code.
- convert text to a Fortran character variable declaration
- all characters to uppercase
- all characters to lowercase
reverse order of lines in a file
So just to get started, read stdin till end-of-file, then write from last line to first to stdout.
program bottomup
!@(#) print file from last line to first
use M_slurp, only: readstdin
implicit none
character(len=:),allocatable :: pageout(:)
integer :: i
call readstdin(pageout)
write(*,'(a)')(trim(pageout(i)),i=size(pageout),1,-1)
end program bottomupsort ignoring leading spaces
program sortup
!@(#) trim leading spaces and sort lines
use M_slurp, only: readstdin
implicit none
character(len=:),allocatable :: pageout(:)
integer :: i
call readstdin(pageout)
pageout=adjustl(pageout)
pageout=cqsort(pageout)
write(*,'(a)')(trim(pageout(i)),i=size(pageout),1,-1)
contains
recursive function cqsort(d) result(sorted)
!@(#) Compact implementation of the QuickSort algorithm
! This is derived from an example in "Modern Fortran in Practice" by Arjen Markus. As such,
! this work (cqsort) is licensed under the Creative Commons Attribution 3.0 Unported License.
! To view a copy of this license, visit http://creativecommons.org/licenses/by/3.0/
character(len=*),intent(in) :: d(:)
character(len=len(d)) :: sorted(1:size(d))
if (size(d) > 1) then
sorted = [character(len=len(d)) :: cqsort(pack(d(2:),d(2:)>d(1))),d(1),cqsort(pack(d(2:),d(2:)<=d(1)))]
else
sorted = d
endif
end function cqsort
end program sortupexpand tabs, trim whitespace from end of lines
program cleanup
!@(#) expand tabs in file
use M_slurp, only: readstdin
implicit none
character(len=:),allocatable :: pageout(:)
integer :: i
call readstdin(pageout)
write(*,'(a)')(dilate(pageout(i)),i=1,size(pageout))
contains
function dilate(instr) result(outstr)
!@(#) M_strings::dilate(3f): convert tabs to spaces and trim line, removing CRLF chars
character(len=*),intent(in) :: instr ! input line to scan for tab characters
character(len=:),allocatable :: outstr ! tab-expanded version of INSTR produced
integer,parameter :: tabsize=8 ! assume a tab stop is set every 8th column
integer :: ipos ! position in OUTSTR to put next character of INSTR
integer :: istep ! counter advances thru string INSTR one char at a time
integer :: i, icount
icount=0 ! number of tab characters in input
do i=1,len(instr)
if(iachar(instr(i:i))==9)icount=icount+1
enddo
allocate(character(len=(len(instr)+8*icount)) :: outstr)
outstr(:)=" " ! this SHOULD blank-fill string
ipos=1 ! where to put next character in output string OUTSTR
SCAN_LINE: do istep=1,len_trim(instr) ! look through input string one character at a time
EXPAND_TABS : select case (iachar(instr(istep:istep)))! take different actions based on character found
case(9) ! if character is a horizontal tab and move pointer out to appropriate column
ipos = ipos + (tabsize - (mod(ipos-1,tabsize)))
case(10,13) ! convert carriage-return and new-line to space ,typically to handle DOS-format files
ipos=ipos+1
case default ! character is anything else other than a tab,newline,or return.
outstr(ipos:ipos)=instr(istep:istep)
ipos=ipos+1
end select EXPAND_TABS
enddo SCAN_LINE
outstr=trim(outstr)
end function dilate
end program cleanupline up double-colon strings in Fortran code.
This program is a small filter that can be invoked from editors to line up the double-colon strings in declarations.
If you know how to filter regions of text through an external program with your editor, you can mark a region of lines like this …
Input file:
logical :: glob
character(len=*) :: tame ! A string without wildcards
character(len=*) :: wild ! A (potentially) corresponding string with wildcards
character(len=len(tame)+1) :: tametext
character(len=len(wild)+1):: wildtext
character(len=1),parameter::NULL=char(0)
integer ::wlen
integer :: ti, wi
integer:: i
character(len=:),allocatable :: tbookmark, wbookmarkand run it through the program and it should line up like
Output file:
logical :: glob
character(len=*) :: tame ! A string without wildcards
character(len=*) :: wild ! A (potentially) corresponding string with wildcards
character(len=len(tame)+1) :: tametext
character(len=len(wild)+1) :: wildtext
character(len=1),parameter :: NULL=char(0)
integer :: wlen
integer :: ti, wi
integer :: i
character(len=:),allocatable :: tbookmark, wbookmark This lets you prettify the declarations with double-colons in it.
program lineup
!@(#) line up :: string, mostly for pretty Fortran declarations
use M_slurp, only: readstdin
implicit none
character(len=:),allocatable :: pageout(:) ! page to hold file in memory
character(len=:),allocatable :: left,right
integer :: i, j, k, ii, imax
call readstdin(pageout)
imax=0
do i=1,size(pageout)
j=index(pageout(i),'::')
if(j.gt.1)then
j=len_trim(pageout(i)(:j-1))+2
endif
imax=max(imax,j)
enddo
do i=1,size(pageout)
j= index(pageout(i),'::')
if( j.ge.2)then
left=trim(pageout(i)(:j-1))
write(*,'(*(g0))')stretch(left,imax-1),':: ',adjustl(trim(pageout(i)(j+2:)))
else
write(*,'(*(g0))')trim(pageout(i))
endif
enddo
end program lineupconvert text to a Fortran character variable declaration
Given a text file such as the following:
Glib jocks quiz nymph to vex dwarf.
How quickly daft jumping zebras vex!
Jackdaws love my big sphinx of quartz.
Pack my box with five dozen liquor jugs.
Sphinx of black quartz, judge my vow.
The five boxing wizards jump quickly.
The quick brown fox jumps over the lazy dog
Waltz, bad nymph, for quick jigs vex.now you can easily change a plain text file into a variable definition to easily create messages, help text, and other text blocks:
var pangrams < filepangrams=[ character(len=43) :: &
'Glib jocks quiz nymph to vex dwarf. ',&
'How quickly daft jumping zebras vex! ',&
'Jackdaws love my big sphinx of quartz. ',&
'Pack my box with five dozen liquor jugs. ',&
'Sphinx of black quartz, judge my vow. ',&
'The five boxing wizards jump quickly. ',&
'The quick brown fox jumps over the lazy dog',&
'Waltz, bad nymph, for quick jigs vex. ']program txt2f90
! program to convert text file to Fortran character definition
use M_slurp, only: readstdin, stretch
implicit none
character(len=:),allocatable :: pageout(:) ! array to hold file in memory
integer :: j, iwidth, isize
character(len=:),allocatable :: varname
varname=argn(1,'text')
call readstdin(pageout)
iwidth=len(pageout)
isize=size(pageout)
write(*,'(a,i0,a)')trim(varname)//'=[ character(len=',iwidth,') :: &' ! write file
if(isize.gt.1) write(*,'("''",a,"'',&")') (stretch(sub(pageout(j)),iwidth),j=1,isize-1)
write(*,'("''",a,"'']")') stretch(sub(pageout(isize)),iwidth)
contains
function sub(string) result(stringout)
!@(#) change single quote to two single quotes
character(len=*),intent(in) :: string
character(len=:),allocatable :: stringout
integer :: i
stringout=''
do i=1,len(string)
select case(string(i:i))
case("'")
stringout=stringout//"''"
case default
stringout=stringout//string(i:i)
endselect
enddo
end function sub
function argn(nth,default) result(arg)
! get nth argument from command line
implicit none
integer :: count, nth, argument_length, istat
character(len=:),allocatable :: arg
character(len=*),intent(in) :: default
arg=default
call get_command_argument(number=nth,length=argument_length,status=istat)
if(istat.eq.0)then
if(allocated(arg))deallocate(arg)
allocate(character(len=argument_length) :: arg)
call get_command_argument(nth, arg,status=istat)
endif
if(istat.ne.0)arg=default
if(arg.eq.'')arg=default
end function argn
end program txt2f90all characters to uppercase
program uppercase
use,intrinsic::iso_fortran_env,only:int8
!@(#) print file converted to uppercase
use M_slurp, only: readstdin, writedown
implicit none
character(len=:),allocatable :: pageout(:)
integer :: i
call readstdin(pageout)
pageout=toupper(pageout)
call writedown(pageout)
contains
elemental pure function toupper(str) result (string)
! Changes a string to uppercase
character(*), intent(in) :: str
character(len(str)) :: string
integer :: i
integer(kind=int8), parameter :: ade_a = iachar('a'), ade_z = iachar('z')
integer(kind=int8), parameter :: diff = iachar('A',kind=int8) - iachar('a',kind=int8)
integer(kind=int8) :: ade_char
do concurrent(i=1:len(str))
ade_char = iachar(str(i:i), int8)
if (ade_char >= ade_a .and. ade_char <= ade_z) ade_char = ade_char + diff
string(i:i) = achar(ade_char)
enddo
if(len(str).eq.0)string = str
end function toupper
end program uppercaseall characters to lowercase
program lowercase
use,intrinsic::iso_fortran_env,only:int8
use M_slurp, only: readstdin, writedown
!@(#) print file converted to lowercase
implicit none
character(len=:),allocatable :: pageout(:)
integer :: i
call readstdin(pageout)
pageout=tolower(pageout)
call writedown(pageout)
contains
elemental pure function tolower(str) result (string)
! Changes a string to lowercase
character(*), intent(in) :: str
character(len(str)) :: string
integer :: i
integer,parameter :: diff = iachar('A')-iachar('a')
string = str
do concurrent (i = 1:len_trim(str))
select case (str(i:i))
case ('A':'Z')
string(i:i) = achar(iachar(str(i:i))-diff)
case default
end select
enddo
end function tolower
end program lowercaseSource for module M_slurp:
module M_slurp
private
public readstdin, blame, stretch, getline
use, intrinsic :: iso_fortran_env, only : stderr=>ERROR_UNIT,stdin=>INPUT_UNIT
contains
function stretch(line,length) result(strout)
!@(#) M_strings stretch(3f) return string padded to at least specified length
character(len=*),intent(in) :: line
integer,intent(in) :: length
character(len=:),allocatable :: strout
allocate(character(len=max(length,len(line))) :: strout)
strout(:)=line
end function stretch
subroutine readstdin(pageout)
implicit none
character(len=:),allocatable,intent(out) :: pageout(:) ! page to hold file in memory
character(len=1),allocatable :: text(:) ! array to hold file in memory
call file_to_byte(text) ! allocate character array and copy file into it
if(allocated(text))then
pageout=page(text)
deallocate(text) ! release memory
else
pageout=[character(len=0):: ]
endif
contains
function page(array) result (table)
! ident_5="@(#) 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 readstdin
subroutine file_to_byte(text)
implicit none
! ident_6="@(#) M_io file_to_byte(3f) allocate text array and read stdin into it"
character(len=1),allocatable,intent(out) :: text(:) ! array to hold file
integer :: nchars=0 ! holds size of file
integer :: igetunit ! use newunit=igetunit in f08
integer :: iostat=0 ! used for I/O error status
integer :: i
integer :: icount
character(len=256) :: message
character(len=4096) :: label
character(len=:),allocatable :: line
label=''
message=''
! copy stdin to a scratch file
call copystdin_ascii()
if(iostat == 0)then ! if file was successfully opened
inquire(unit=igetunit, size=nchars)
if(nchars <= 0)then
call blame( '*file_to_byte* 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=iostat,iomsg=message) text ! load input file -> text array
if(iostat /= 0)then
call blame( '*file_to_byte* bad read of '//trim(label)//':'//trim(message) )
endif
else
call blame('*file_to_byte* '//message)
allocate ( text(0) ) ! make enough storage to hold file
endif
close(iostat=iostat,unit=igetunit) ! close if opened successfully or not
contains
subroutine copystdin_ascii()
integer :: iostat
open(newunit=igetunit, iomsg=message,&
&form="unformatted", access="stream",status='scratch',iostat=iostat)
open(unit=stdin,pad='yes')
INFINITE: do while (getline(line,iostat=iostat)==0)
if(is_iostat_eor(iostat))then
! EOR does not imply NEW_LINE so could add NEW_LINE to end of file
write(igetunit)line,new_line('a')
else
write(igetunit)line
endif
enddo INFINITE
rewind(igetunit,iostat=iostat,iomsg=message)
end subroutine copystdin_ascii
subroutine blame(message)
character(len=*) :: message
write(stderr,'(a)')trim(message) ! write message to standard error
end subroutine blame
end subroutine file_to_byte
function getline(line,iostat) result(ier)
implicit none
! ident_11="@(#) M_io getline(3f) read a line from stdin into allocatable string up to line length limit"
character(len=:),allocatable,intent(out) :: line
integer,intent(out) :: iostat
character(len=4096) :: message
integer,parameter :: buflen=1024
character(len=:),allocatable :: line_local
character(len=buflen) :: buffer
integer :: isize
integer :: ier
line_local=''
iostat=huge(0)
ier=0
INFINITE: do ! read characters from line and append to result
read(stdin,pad='yes',iostat=iostat,fmt='(a)',advance='no', &
& size=isize,iomsg=message) buffer ! read next buffer (might use stream I/O for files
if(isize > 0)line_local=line_local//buffer(:isize) ! append what was read to result
if(is_iostat_eor(iostat))then ! if hit EOR reading is complete
exit INFINITE ! end of reading line
elseif(iostat /= 0)then ! end of file or error
line=trim(message)
ier=iostat
exit INFINITE
endif
enddo INFINITE
line=line_local ! trim line
end function getline
subroutine writedown(text)
!@(*) write text array to stdout trimmed from top line down
character(len=*),intent(in) :: text(:)
integer :: i
write(stdout,'(a)')(trim(text(i)),i=1,size(text))
end subroutine writedown
subroutine writeup(text)
!@(*) write text array to stdout trimmed from bottom line up
character(len=*),intent(in) :: text(:)
integer :: i
write(stdout,'(a)')(trim(text(i)),i=size(text),1,-1)
end subroutine writeup
end module M_slurpFixed string replacements, string searches, case conversions, … all become much easier to create when a simple call can read stdin into a character array. Fortran (unlike rumours to the contrary) has very flexible character processing capabilities. It is generally the missing support for easy raw I/O and system utilities that has limited the use of Fortran for applications such as TUI utilities and simple CLI utilities.
Recent additions like the ISO_C_BINDING interface and support of stream I/O has made that much easier, but somehow the most common use of stream I/O (ie. filters of stdin) were overlooked.
For other solutions, including raw I/O and binary data files see the GPF modules M_io, M_system, M_path, and M_strings.
Based on information found in GPF
See Also
Small Fortran Tools on Fortran Discourse
category: code