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