compact Function

public function compact(str, char) result(outstr)

NAME

compact(3f) - [M_strings:WHITESPACE] converts contiguous whitespace
to a single character (or nothing)
(LICENSE:PD)

SYNOPSIS

function compact(STR,CHAR) result (OUTSTR)

 character(len=*),intent(in)          :: STR
 character(len=*),intent(in),optional :: CHAR
 character(len=len(str))              :: OUTSTR

DESCRIPTION

COMPACT(3f) converts multiple spaces, tabs and control characters
(called "whitespace") to a single character or nothing. Leading
whitespace is removed.

OPTIONS

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.

RETURNS

OUTSTR  string of same length as input string but with all contiguous
        whitespace reduced to a single space and leading whitespace
        removed

EXAMPLES

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

AUTHOR

John S. Urban

LICENSE

Public Domain

Arguments

Type IntentOptional Attributes Name
character(len=*), intent(in) :: str
character(len=*), intent(in), optional :: char

Return Value character(len=len)


Contents

Source Code

compact

Source Code

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