CCL Home Page
Up Directory CCL string.f
c***************************************************************c
c                           LibString 1.0			c
c             (c) 1998 Giulio Vistoli & Alex Pedretti		c
c***************************************************************c

      integer function length(str)
c     return the string length without the blanks characters

      implicit integer (k-l)
      character *(*) str    
      
      lmax=len(str)      
       
c     search the last non blank character
      doi=lmax,1,-1
      if(str(i:i).ne.' ')then
      length=i
      return
      end if
      end do

      length=lmax

      return
      end     
      
      
      logical function isnumber(str)
c     check if the string argument contain a number

      implicit integer (k-l)
      character *(*) str   

      isnumber=.true.
	
      doi=1,length(str)
      if((str(i:i).lt.'0'.or.str(i:i).gt.'9').and.
     $    str(i:i).ne.'.'.and.str(i:i).ne.'-'.and.
     $    str(i:i).ne.'+')then
      isnumber=.false.
      return
      end if
      end do

      return  
      end


      subroutine  right(str,nch,res)
c     return the right string portion

      implicit integer (k-l)
      character *(*) str,res
      
      l=length(str)
      res=str(l-nch+1:l)

      return
      end
      
      
      subroutine union(str,add,res)
c     join two strings

      implicit integer (k-l)
      character *(*) str,res,add
      
      l1=length(str)
      
      res=str
      res(l1+1:l1+length(add))=add
      
      return
      end                      
      
      
      
      
      subroutine uniblk(str,add,nbl,res)
c     join two strings with spacing

      implicit integer (k-l)
      character *(*) str,res,add
      
      l1=length(str)
      
      res=str
      res(l1+1+nbl:l1+length(add)+nbl)=add
      
      return
      end      
      

      subroutine readf(line,str,fl,in,ch,success)
c     parse a string with specified template

      implicit integer (k-l)
      character *(*) str,ch(*)
      character *(*) line
      character *30 word(50) 
      real fl(*),flo
      integer in(*)
      logical success

      success=.true.
      na=0
      ni=0
      nf=0

      call pars(line,word,nw)	

      nn=1

c     if nn field is a string
10    if(str(nn:nn).eq.'a')then
      na=na+1
      ch(na)=word(nn)

c     if nn field is a integer
      elseif(str(nn:nn).eq.'i')then
      ni=ni+1     
      success=isnumber(word(nn))
      if(.not.success)return
      flo=valnum(word(nn))
      in(ni)=int(flo)

c     if nn field is a float
      elseif(str(nn:nn).eq.'f')then
      nf=nf+1     
      success=isnumber(word(nn))
      if(.not.success)return
      fl(nf)=valnum(word(nn))
      end if

c     next field
      nn=nn+1
      if(nn.le.nw.and.nn.le.length(str))goto 10

      return
      end
      
      subroutine pars(str,word,nw)
c     perform the string parsing

      implicit integer (k-l)
      character *(*) str,word(*)
      
      nw=0
      ltot=length(str)
      l=ltot

c     find and skip blank characters
10    if(str(1:1).ne.' ')goto 20     
      str(1:l-1)=str(2:l)
      l=l-1
      goto 10 

20    lf=index(str(1:l),' ')
      nw=nw+1

c     define nw word
      if(lf.eq.0)then
      word(nw)=str(1:l)
      return
      end if

c     define last word
      word(nw)=str(1:lf-1)
      str=str(lf+1:l)
      l=l-lf
      goto 10      

      end
      
      real function valnum(str)
c     return the real value contained into a string

      implicit integer (k-l)
      character *(*) str
      logical segno
      

      segno=.false.
      valnum=0.00
      lu=length(str)
      
c     check the number sign
      if(str(1:1).eq.'-')then
      segno=.true.
      str=str(2:lu)
      lu=lu-1
      end if

c     check if number is float or integer
      if(index(str,'.').ne.0)then
      iin=index(str,'.')-1
      else
      iin=lu
      end if

      ifr=lu-(iin+1)

c     translate the integer portion
      doi=1,iin  
      k=ichar(str(i:i))-48
      valnum=valnum+float(k)*10.00**float(iin-i)
      end do         

      if(iin.eq.lu)goto 10
      str=str(iin+2:lu)

c     translate the decimal portion
      doi=1,ifr  
      k=ichar(str(i:i))-48
      valnum=valnum+float(k)/10.00**float(i)
      end do

10    if(segno)valnum=-valnum

      return
      end     


      subroutine intstr(num,str,l)
c     translate a integer value into string

      implicit integer(k-l)
      character *(*)str
      character *1 cifra(10)
      logical segno

      data cifra /'0','1','2','3','4','5','6','7','8','9'/

      lun=len(str)
      if(lun.gt.30)stop
      segno=.false.

c     check the number sign
      if(num.lt.0)then
      segno=.true.
      num=abs(num)
      end if

c     translate the integer num
      doj=1,lun
      n=num/10**(lun-j)
      num=num-(n*10**(lun-j))
      str(j:j)=cifra(n+1)
      end do

c     if the str length is fixed (l)
      if(l.ne.0)then
      call right(str,l,str)
      str=str(1:l)
      return
      end if

c     else delete zero characters
      l=lun
10    if(str(1:1).ne.'0')goto 20
      str(1:l-1)=str(2:l)
      l=l-1
      goto 10

20    if(segno)then
      str(2:l+1)=str(1:l)
      str(1:1)='-'
      str=str(1:l+1)
      else
      str=str(1:l)
      end if

      return
      end
      

      subroutine flostr(flo,str,ndec)
c     Translate a real*8 value into string
      implicit integer(k-l)
      character *(*)str
      character *20 temp
      real *8 flo
    
c     translate the integer portion
      n=int(flo)
      n1=int(abs(flo))
      call intstr(n,str,0)

c     transform the decimal portion in integer 
      l= length(str)
      n=int((float(abs(flo)-n1))*10**(ndec))
c     translate the decimal portion
      call intstr(n,temp,ndec)

c     join two portion
      str(l+1:l+1)='.'
      str(l+2:l+ndec+1)=temp
      str=str(1:l+ndec+1)

      return
      end
Modified: Wed Mar 19 17:00:00 1997 GMT
Page accessed 9680 times since Sat Apr 17 22:02:21 1999 GMT