Re: Parsing challenge to reduce blanks

Here is my 3 statement solution as advertised..

! -------------
program demo ! blank reduction
character(27) :: line1= ' the quick brown fox' ! exact len
character(30) :: line2= ' the quick brown fox '
line1 = reduce_blanks(line1)
write (*,*) trim(line1) //' jumps' ! " the quick brown fox jumps"
line2 = reduce_blanks(line2)
write (*,*) trim(line2) //' jumps' ! " the quick brown fox jumps"
stop
contains
! --------------------------
function reduce_blanks(line) result (outline)
character(*) :: line
character(len(line)) :: outline
character :: a(len(line))

a = transfer(line,a)
forall (i=1:size(a)-1, a(i)==' '.and.a(i+1)==' ') a(i) = char(0)
outline = transfer(pack(a,a /= char(0), spread(' ',1,size(a))), outline)

end function reduce_blanks
end program


.