dilate(3f) - [M_strings:NONALPHA] expand tab characters
(LICENSE:PD)
function dilate(INSTR) result(OUTSTR)
character(len=*),intent=(in) :: INSTR
character(len=:),allocatable :: OUTSTR
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).
instr Input line to remove tabs from
outstr Output string with tabs expanded.
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
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
character(len=*), | intent(in) | :: | instr |
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