|
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
|