File: pick-dir/rmblank.f90

    1       SUBROUTINE RMBLANK(Stin,Stout)
    2       IMPLICIT NONE
    3 !
    4 ! Dummy arguments
    5 !
    6       CHARACTER(*) :: Stin , Stout
    7       INTENT (IN) Stin
    8       INTENT (INOUT) Stout
    9 !
   10 ! Local variables
   11 !
   12       INTEGER :: i , iblankindex , icurrent , il
   13       INTEGER :: LEN
   14       CHARACTER :: tmpst
   15 !
   16 !-----------------------------------------------------------------------
   17 !
   18 !     written by:   David Lary
   19 !
   20 !     started:      7/1/1993
   21 !
   22 !     last updated: 22/1/2004
   23 !
   24 !----------------------------------------------------------------------
   25 !
   26 !     remove blanks.
   27 !
   28 !----------------------------------------------------------------------
   29 !
   30       il = LEN(Stin)
   31       iblankindex = il
   32       icurrent = 1
   33 !
   34       DO i = 1 , il
   35          IF ( Stin(i:i)/=" ' ) THEN
   36             tmpst = Stin(i:i)
   37             Stout(icurrent:icurrent) = tmpst
   38             icurrent = icurrent + 1
   39          ENDIF
   40       ENDDO
   41 !
   42 !     blank rest of string.
   43       il = LEN(Stout)
   44       DO i = icurrent , il
   45          Stout(i:i) = " '
   46       ENDDO
   47 !
   48 !-----------------------------------------------------------------------
   49 !
   50       END SUBROUTINE RMBLANK