compact(3f) - [M_strings:WHITESPACE] converts contiguous whitespace
to a single character (or nothing)
(LICENSE:PD)
function compact(STR,CHAR) result (OUTSTR)
character(len=*),intent(in) :: STR
character(len=*),intent(in),optional :: CHAR
character(len=len(str)) :: OUTSTR
COMPACT(3f) converts multiple spaces, tabs and control characters
(called "whitespace") to a single character or nothing. Leading
whitespace is removed.
STR input string to reduce or remove whitespace from
CHAR By default the character that replaces adjacent
whitespace is a space. If the optional CHAR parameter is supplied
it will be used to replace the whitespace. If a null character is
supplied for CHAR whitespace is removed.
OUTSTR string of same length as input string but with all contiguous
whitespace reduced to a single space and leading whitespace
removed
Sample Program:
program demo_compact
use M_strings, only : compact
implicit none
! produces 'This is a test '
write(*,*)compact(' This is a test ')
! produces 'Thisisatest '
write(*,*)compact(' This is a test ',char='')
! produces 'This:is:a:test '
write(*,*)compact(' This is a test ',char=':')
! note CHAR is used to replace the whitespace, but if CHAR is
! in the original string it is just copied
write(*,*)compact('A AA A AAAAA',char='A')
! produces (original A characters are left as-is) 'AAAAAAAAAAAA'
! not 'A'
end program demo_compact
Expected output
>This is a test
>Thisisatest
>This:is:a:test
>AAAAAAAAAAAA
John S. Urban
Public Domain
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
character(len=*), | intent(in) | :: | str | |||
character(len=*), | intent(in), | optional | :: | char |
function compact(str,char) result (outstr)
! ident_47="@(#) M_strings compact(3f) Converts white-space to single spaces; removes leading spaces"
character(len=*),intent(in) :: str
character(len=*),intent(in),optional :: char
character(len=len(str)) :: outstr
character(len=1) :: ch
integer :: i
integer :: position_in_output
logical :: last_was_space
character(len=1) :: char_p
logical :: nospace
if(present(char))then
char_p=char
if(len(char) == 0)then
nospace=.true.
else
nospace=.false.
endif
else
char_p=' '
nospace=.false.
endif
outstr=' '
last_was_space=.false.
position_in_output=0
IFSPACE: do i=1,len_trim(str)
ch=str(i:i)
select case(iachar(ch))
case(0:32,127) ! space or tab character or control character
if(position_in_output == 0)then ! still at beginning so ignore leading whitespace
cycle IFSPACE
elseif(.not.last_was_space) then ! if have not already put out a space output one
if(.not.nospace)then
position_in_output=position_in_output+1
outstr(position_in_output:position_in_output)=char_p
endif
endif
last_was_space=.true.
case(:-1,33:126,128:) ! not a space, quote, or control character so copy it
position_in_output=position_in_output+1
outstr(position_in_output:position_in_output)=ch
last_was_space=.false.
end select
enddo IFSPACE
end function compact