Clicky

Fortran Wiki
notab

program testit
! example showing use of NOTABS(3f). Creates a small filter 
! that removes tabs and trailing white space from input
! on files up to 255 characters wide.  For example
!    notabs < infile >outfile
! 
   character(len=255) :: in,out
   integer :: ios  ! error flag from read
   integer :: iout
   do
      read(*,"(a)",iostat=ios)in
      if(ios /= 0)then
         stop
      endif
      call notabs(in,out,iout)
      if(iout == 0)then
         write(*,"(a)")
      else
         write(*,"(a)")out(1:iout)
      endif
   enddo
end program testit

!===================================================================================================================================
subroutine notabs(INSTR,OUTSTR,ILEN)
! @(#) convert tabs in input to spaces in output while maintaining columns, assuming a tab is set every 8 characters
!
! USES:
!       It is often useful to expand tabs in input files to simplify further processing such as tokenizing an input line.
!       Some FORTRAN compilers hate tabs in input files; some printers; some editors will have problems with tabs
! AUTHOR:
!       John S. Urban
!
! SEE ALSO:
!       GNU/Unix commands expand(1) and unexpand(1)
!
   use ISO_FORTRAN_ENV, only : ERROR_UNIT     ! get unit for standard error. if not supported yet,  define ERROR_UNIT for your system (typically 0)
   character(len=*),intent(in)   :: INSTR     ! input line to scan for tab characters
   character(len=*),intent(out)  :: OUTSTR    ! tab-expanded version of INSTR produced
   integer,intent(out)           :: ILEN      ! column position of last character put into output string

   integer,parameter             :: TABSIZE=8 ! assume a tab stop is set every 8th column
   character(len=1)              :: c         ! character read from stdin
   integer                       :: ipos      ! position in OUTSTR to put next character of INSTR
   integer                       :: lenin     ! length of input string trimmed of trailing spaces
   integer                       :: lenout    ! number of characters output string can hold
   integer                       :: i10       ! counter that advances thru input string INSTR one character at a time
!===================================================================================================================================
      IPOS=1                                  ! where to put next character in output string OUTSTR
      lenin=len(INSTR)                        ! length of character variable INSTR
      lenin=len_trim(INSTR(1:lenin))          ! length of INSTR trimmed of trailing spaces
      lenout=len(OUTSTR)                      ! number of characters output string OUTSTR can hold
      OUTSTR=" "                              ! this SHOULD blank-fill string, a buggy machine required a loop to set all characters
!===================================================================================================================================
      do i10=1,lenin                          ! look through input string one character at a time
         c=INSTR(i10:i10)
         if(ichar(c) == 9)then                ! test if character is a tab (ADE (ASCII Decimal Equivalent) of tab character is 9)
            IPOS = IPOS + (TABSIZE - (mod(IPOS-1,TABSIZE)))
         else                                 ! c is anything else other than a tab insert it in output string
            if(IPOS > lenout)then
               write(ERROR_UNIT,*)"*notabs* output string overflow"
               exit
            else
               OUTSTR(IPOS:IPOS)=c
               IPOS=IPOS+1
            endif
         endif
      enddo
!===================================================================================================================================
      ILEN=len_trim(OUTSTR(:IPOS))  ! trim trailing spaces
      return
!===================================================================================================================================
end subroutine notabs
!===================================================================================================================================

category: code