[Shootout-list] f95 count-words program mkII
Simon Geard
simon@whiteowl.co.uk
Fri, 25 Mar 2005 19:11:34 +0000
This is a multi-part message in MIME format.
--------------090902080105020500080701
Content-Type: text/plain; charset=ISO-8859-1; format=flowed
Content-Transfer-Encoding: 7bit
Attached is the tidied version of the count-words program I submitted
the other day. I've moved the string handling code into a string module
to make the main code cleaner. For the intel compiler the correct
compilation line is
ifort string.f90 count-words.f90 -O3 -static-libcxa -o count-words
but this might not be true of g95 which I think you're linking to as well.
I have tested this against the c++ version and the output is identical
so I'm not sure why the current version is showing an error. My command
line is
./count-words < datafile
If there is still an error perhaps you could mail me the command line
you're using and the result you're getting so that I can diagnose the fault.
Thanks,
Simon
--------------090902080105020500080701
Content-Type: text/plain;
name="count-words.f90"
Content-Transfer-Encoding: 7bit
Content-Disposition: inline;
filename="count-words.f90"
! The Great Computer Language Shootout
! http://shootout.alioth.debian.org/
!
! contributed by Simon Geard, 25/03/2005
!
! ifort string.f90 count-words.f90 -O3 -static-libcxa -o count-words
!
!
program countWords
use string
implicit none
type(str) :: line
integer :: nlines = 0 ! Line counter
integer :: nwords = 0 ! Word counter
integer :: nchars = 0 ! Char counter
integer :: i, nread
logical :: finished
! Read and count
readFile: do
call getLine(line, finished)
if (finished) exit readFile
nlines = nlines + 1
nwords = nwords + numWords(line)
nchars = nchars + line%nchars
end do readFile
100 continue
nchars = nchars + nlines ! Have to add the number lines
write(*,'(2(i0,a),i0)') nlines, ' ', nwords, ' ', nchars
stop
end program countWords
--------------090902080105020500080701
Content-Type: text/plain;
name="string.f90"
Content-Transfer-Encoding: 7bit
Content-Disposition: inline;
filename="string.f90"
module string
integer, parameter, private :: rsize = 64
type str
! A string type that is dynamically allocatable
character(len=rsize), dimension(:), allocatable :: s
integer :: nblocks ! The number of blocks of size rsize required for the string
integer :: nchars ! The number of chars
end type str
interface assignment(=)
module procedure assign_str_str
end interface
contains
subroutine assign_str_str(to, from)
type(str), intent(out) :: to
type(str), intent(in) :: from
allocate(to%s(from%nblocks))
to%s = from%s
to%nblocks = from%nblocks
to%nchars = from%nchars
end subroutine assign_str_str
subroutine getLine(rline, finished)
! Read an arbitrary length line from stdin
type(str), intent(out) :: rline
logical, intent(out) :: finished
integer, parameter :: tab = 9
integer, parameter :: space = 32
integer :: nread
character(len=8) argv
type(str) :: work
character(len=rsize) :: str_blk
character(len=rsize), dimension(:), pointer :: line
integer :: nlines = 0
integer :: nwords = 0
integer :: ngaps
allocate(rline%s(4096/rsize)) ! Allocate 4096 chars for the line (max allowed)
rline%nblocks = 0
rline%nchars = 0
readLine: do
rline%nblocks = rline%nblocks+1
read(5,fmt='(a)',end=100,eor=10,size=nread,advance='no') str_blk
if (rline%nblocks > size(rline%s)) then
call enlargeLine
end if
rline%s(rline%nblocks) = str_blk(1:nread)
rline%nchars = rline%nchars + nread
end do readLine
10 continue
if (rline%nblocks > size(rline%s)) then
call enlargeLine
end if
rline%nchars = rline%nchars + nread
if (nread == 0) then
rline%nblocks = rline%nblocks - 1
else
rline%s(rline%nblocks) = str_blk(1:nread)
end if
finished = .false.
return
100 continue
finished = .true.
return
contains
subroutine enlargeLine
! Allocate more memory for a line if requested
allocate(work%s(size(rline%s)))
work = rline
deallocate(rline%s)
allocate(rline%s(2*size(work%s)))
rline = work
deallocate(work%s)
end subroutine enlargeLine
end subroutine getLine
integer function numWords(rline)
! Count the number of words
type(str), intent(in), target :: rline
integer, parameter :: tab = 9
integer, parameter :: space = 32
integer :: i, j, ng
logical :: ingap, started
character(len=rsize), pointer :: line
integer, pointer :: bline
ingap = .false.
ng = 0
started = .false.
! Search in the 1st block
bline => rline%nblocks
if (bline == 0) then
numWords = 0
return
end if
line => rline%s(1)
do i=1,len(line)
if (.not. started) then
started = (line(i:i) /= ' ')
elseif ( .not. ingap .and. (line(i:i) .eq. ' ' .or. line(i:i) .eq. achar(tab))) then
ng = ng + 1
ingap = .true.
elseif (ingap .and. ischar(line(i:i))) then
ingap = .false.
end if
end do
if (bline == 1) then
if (ingap) ng = ng - 1
numWords = ng + 1
return
end if
! Do the next n-2 blocks
do j=2,bline-1
line => rline%s(j)
do i=1,len(line)
if (.not. started) then
started = (line(i:i) /= ' ')
elseif (.not. ingap .and. (line(i:i) .eq. ' ' .or. line(i:i) .eq. achar(tab))) then
ng = ng + 1
ingap = .true.
elseif (ingap .and. ischar(line(i:i))) then
ingap = .false.
end if
end do
end do
! Do the last block
line =>rline%s(bline)
do i=1,len(trim(line))
if (.not. started) then
started = (line(i:i) /= ' ')
elseif (.not. ingap .and. (line(i:i) .eq. ' ' .or. line(i:i) .eq. achar(tab))) then
ng = ng + 1
ingap = .true.
else if (ingap .and. ischar(line(i:i))) then
ingap = .false.
end if
end do
numWords = ng + 1
end function numWords
logical function ischar(c)
character, intent(in) :: c
ischar = (iachar(c) > 32 .and. iachar(c) < 127)
end function ischar
subroutine print(line)
! Diagnostic print procedure
type(str), intent(in) :: line
integer :: i
write(*,'(i0,a)',advance='no') line%nblocks,' '
do i=1,line%nblocks-1
write(*,'(a)',advance='no') line%s(i)
end do
write(*,'(a)',advance='yes') line%s(line%nblocks)
end subroutine print
end module string
--------------090902080105020500080701--