Line data    Source code

       1            0 :       character*(*) function strcompr(s)
       2              : c
       3              : c  removes blanks from string s and returns result
       4              : c  Original version 12/12/04
       5              : c
       6              :       character*(*) s
       7              :       character*80 s1
       8            0 :       l=len(s)
       9              : c
      10            0 :       i1=0
      11            0 :       do i=1,l
      12            0 :         if(s(i:i).ne.' ') then
      13            0 :           i1=i1+1
      14            0 :           s1(i1:i1) = s(i:i)
      15              :         end if
      16              :       end do
      17              : c
      18            0 :       if(i1.gt.0) then
      19            0 :         strcompr=s1(1:i1)
      20              :       else
      21            0 :         strcompr=''
      22              :       end if
      23            0 :       return
      24            0 :       end