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