dilate Function

public function dilate(instr) result(outstr)

NAME

dilate(3f) - [M_strings:NONALPHA] expand tab characters
(LICENSE:PD)

SYNOPSIS

function dilate(INSTR) result(OUTSTR)

 character(len=*),intent=(in)  :: INSTR
 character(len=:),allocatable  :: OUTSTR

DESCRIPTION

 dilate() converts tabs in INSTR to spaces in OUTSTR.  It assumes a
 tab is set every 8 characters. Trailing spaces are removed.

 In addition, trailing carriage returns and line feeds are removed
 (they are usually a problem created by going to and from MSWindows).

OPTIONS

 instr     Input line to remove tabs from

RESULTS

 outstr    Output string with tabs expanded.

EXAMPLES

Sample program:

program demo_dilate

use M_strings, only : dilate
implicit none
character(len=:),allocatable :: in
integer                      :: i
   in='  this is my string  '
   ! change spaces to tabs to make a sample input
   do i=1,len(in)
      if(in(i:i) == ' ')in(i:i)=char(9)
   enddo
   write(*,'(a)')in,dilate(in)
end program demo_dilate

Arguments

Type IntentOptional Attributes Name
character(len=*), intent(in) :: instr

Return Value character(len=:), allocatable


Source Code

function dilate(instr) result(outstr)

   character(len=*), intent(in)  :: instr        ! input line to scan for tab characters
   character(len=:), allocatable :: outstr       ! tab-expanded version of INSTR produced
   integer                       :: i
   integer                       :: icount
   integer                       :: lgth
   icount = 0
   do i = 1, len(instr)
      if (instr(i:i) == char(9)) icount = icount + 1
   end do
   allocate (character(len=(len(instr) + 8*icount)) :: outstr)
   call notabs(instr, outstr, lgth)
   outstr = outstr(:lgth)

end function dilate