src/strings.f

Fortran project SIMRES, source module src/strings.f.

Source module last modified on Thu, 31 Mar 2005, 11:56;
HTML image of Fortran source automatically generated by for2html on Mon, 23 May 2005, 21:29.


#///////////////////////////////////////////////////////////////////////////
#////                                                                  
#////  strings.f - v.1.2, (c) J.Saroun, 1999-2001                      
#////                                                                
#////  String handling subroutines for RESTRAX                         
#////                                                              
#///////////////////////////////////////////////////////////////////////////
#////
#//// 
#////  CALL FINDPAR(LINE,IPAR,ISTART,ILEN)
#////   .... find possition of the IPAR-th parameter on the LINE
#//// 
#////  + other useful routines for handling strings
#////
#///////////////////////////////////////////////////////////////////////////

#     -----------------------------------------------------------------
      SUBROUTINE READ_R8(name, line, result, ierr)
#     Read REAL*8 number from the LINE identified by NAME
#     suppose format "NAME=number " or "NAME number "
#     -----------------------------------------------------------------

      implicit none
      character*(*) line,name
      integer*4 l,istart,ilen,i,iname,lname,ierr
      real*8 z,result
      
      ierr=0
      call BOUNDS(name,iname,lname)
      l=len(line)
      i=index(line,name(iname:iname+lname-1))
#// identifier NAME found
      if(i.gt.0) then   
        i=i+lname   ! i=first character after NAME
        istart=1
        call FINDPAR(line(i:l-i+1),1,istart,ilen)  ! find next substring
        istart=istart+i-1
#// skip the '=' character
        if(ilen.ge.1.and.line(istart:istart).eq. '=') istart=istart+1
#// try to read number from the rest of the line
        read(line(istart:l),*,err=99) z 
        result=z            
      else
        ierr=-1  ! NAME not found
      endif
      
      return
99    ierr=-2    ! cannot read value
      end      
      
#     -----------------------------------------------------------------
      SUBROUTINE READ_I4(name,line,result,ierr)
#     Read INTEGER*4 number from the LINE identified by NAME
#     suppose format "NAME=number " or "NAME number "
#     -----------------------------------------------------------------

      implicit none
      character*(*) line,name
      integer*4 l,istart,ilen,i,iname,lname,ierr
      integer*4 z,result

      ierr=0      
      call BOUNDS(name,iname,lname)
      l=len(line)
      i=index(line,name(iname:iname+lname-1))
#// identifier NAME found
      if(i.gt.0) then   
        i=i+lname   ! NAME ends before the i-th character
        istart=1
        call FINDPAR(line(i:l-i+1),1,istart,ilen)  ! find next substring
        istart=istart+i-1
#// skip the '=' character
        if(ilen.ge.1.and.line(istart:istart).eq. '=') istart=istart+1
#// try to read number from the rest of the line
        read(line(istart:l),*,err=99) z 
        result=z            
      else
        ierr=-1  ! NAME not found
      endif
      return
99    ierr=-2    ! cannot read value
      end      
      
#     -----------------------------------------------------------------
      SUBROUTINE READ_STR(name,line,result,ierr)
#     Read STRING from the LINE identified by NAME
#     suppose format "NAME=string"
#     -----------------------------------------------------------------

      implicit none
      character*(*) line,name
      integer*4 l,istart,ilen,i,iname,lname,ierr,lr
      character*(*) result
            
      ierr=0      
      call BOUNDS(name,iname,lname)
      l=len(line)
      lr=len(result)
      i=index(line,name(iname:iname+lname-1)// '=')
      if (i.gt.1.and.name(1:1).ne. '=') i=0   ! space delimiter must precede the name
#      write(*,*) I,L,' ',NAME
#// identifier NAME found
      if(i.gt.0) then   
        i=i+lname+1   ! NAME= ends before the i-th character
#        write(*,*) i,' >'//LINE(i:L-i+1)
        istart=1
        call FINDPAR(line(i:l-i+1),1,istart,ilen)  ! find next substring
        if (ilen.gt.lr) ilen=lr
        if(ilen.gt.0.and.line(i+istart-1:i+istart-1).ne. ' ') then
#// result is all after the delimiter (=)
          istart=istart+i-1
          result=line(istart:istart+ilen-1) 
        else
          result= ' '        
        endif                
      else
        ierr=-1  ! NAME not found
      endif
      
      end      

#     -----------------------------------------------------------------
      SUBROUTINE FINDPAR(line,ipar,istart,ilen)
#     Finds IPAR-th parameter found on LINE, starting from 
#     ISTART-th character 
#     returns starting position in ISTART and length in ILEN 
#     -----------------------------------------------------------------
      implicit none
      character*(*) line
      integer*4 l,i1,i2,ipar,istart,ilen,k      

1     format(a)

      ilen=0
      
      l=len(line)
      i1=istart
      i2=0
      do k=1,ipar
        if (i1.lt.1) i1=1
        do while (i1.le.l.and.line(i1:i1).eq. ' ')
         i1=i1+1
        end do
        if ((i1.eq.l.and.line(i1:i1).eq. ' ').or.(i1.gt.l)) then
          istart=0
          ilen=0
          return
        endif    
        i2=i1
        do while (i2.le.l.and.line(i2:i2).ne. ' ')
         i2=i2+1
        end do
        if (k.lt.ipar) i1=i2
      enddo  
      ilen=i2-i1
      istart=i1
      end
      
#     ---------------------------------------------------
      character*(*) FUNCTION STRIP(line)
#     removes initial and terminal spaces
#     ---------------------------------------------------
      implicit none
      character*(*) line
      integer*4 l,i
      l=len(line)
      if (l.eq.0) then
         STRIP= ' '
         return
      endif   
      do while (line(l:l).eq. ' '.and.l.gt.0)
         l=l-1
      enddo
      i=1
      do while (line(i:i).eq. ' '.and.i.lt.l)
         i=i+1
      enddo
      if (i.gt.l) then
         STRIP= ' '
      else
         STRIP=line(i:l) 
      endif 
      end  

#     ---------------------------------------------------
      character*(*) FUNCTION CONCAT(str1,str2)
#     connects 2 strings without spaces in between
#     ---------------------------------------------------
      implicit none
      character*(*) str1,str2
      integer*4 i1,i2,j1,j2
      call BOUNDS(str1,i1,j1)
      call BOUNDS(str2,i2,j2)
      CONCAT=str1(i1:i1+j1-1)//str2(i2:i2+j2-1)
      end
      
 
#     ---------------------------------------------------
      SUBROUTINE BOUNDS(line,istart,ilen)
#     get position of string by stripping off the surrounding spaces
#     ---------------------------------------------------
      implicit none
      character*(*) line
      integer*4 l,i,istart,ilen
      l=len(line)
      istart=1
      if (l.eq.0) then
         ilen=0
         return
      endif   
      do while (line(l:l).eq. ' '.and.l.gt.0)
         l=l-1
      enddo
      i=1
      do while (line(i:i).eq. ' '.and.i.lt.l)
         i=i+1
      enddo
      if (i.gt.l) then
         ilen=0
      else
         istart=i
         ilen=l-i+1
      endif 
      end  
     
#     ---------------------------------------------------
      SUBROUTINE STRCOMPACT(line,istart,ilen)
#     remove multiplied spaces, return start (ISTART) and length (ILEN) of the resulting string
#     NOTE: line is modified !
#     ---------------------------------------------------
      implicit none
      character*(*) line
      integer*4 l,i,j,istart,ilen
      l=len(line)
      i=1
      do while (i.lt.l)
        if (line(i:i+1).eq. '  ') then
           do j=i+1,l-1 
             line(j:j)=line(j+1:j+1)
           enddo
           line(l:l)= ' '
           l=l-1  
        else
           i=i+1
        endif
      enddo
      call BOUNDS(line,istart,ilen)
      
      end  

#     -------------------------------------------------------------------
      integer*4 FUNCTION TRUELEN(line)
#     return true length of the string 
#     (without trailing spaces or NULL characters)
#     -------------------------------------------------------------------
      implicit none
      character*(*) line
      integer*4 l
      TRUELEN=0
      l=len(line)
      if (l.eq.0) then
         TRUELEN=0
         return
      endif   
      do while (l.gt.0. and.(line(l:l).eq. ' '.or.line(l:l).eq.char(0)))
         l=l-1
      enddo
      TRUELEN=l
      end 

#     ---------------------------------------------------
      SUBROUTINE WRITELINE(line,iu)
#     writes string without surrounding spaces 
#     ---------------------------------------------------
      implicit none
      character*(*) line
      integer*4 l,is,iu
      call BOUNDS(line,is,l)
1     format(a)
      write(iu,1) line(is:is+l-1)
      end 
      

#     ---------------------------------------------------
      character*(*) FUNCTION UPCASE(line)
#     converts LINE to uppercase     
#     ---------------------------------------------------
      implicit none
      character*(*) line
      integer*4 l,i
      l=len(line)
      do i=1,l
         if((line(i:i).ge. 'a').and.(line(i:i).le. 'z')) then
            UPCASE(i:i)=char(ichar(line(i:i))-32)
         else
            UPCASE(i:i)=line(i:i)   
         endif  
      enddo 
      end

#     ---------------------------------------------------
      SUBROUTINE MKUPCASE(line)
#     converts LINE to uppercase     
#     ---------------------------------------------------
      implicit none
      character*(*) line
      integer*4 l,i
      l=len(line)
      do i=1,l
         if((line(i:i).ge. 'a').and.(line(i:i).le. 'z')) then
            line(i:i)=char(ichar(line(i:i))-32)
         endif  
      enddo 
      end


#     ---------------------------------------------------
      logical*4 FUNCTION IsNumber(line) 
#     true if LINE is a number 
#     ---------------------------------------------------
      implicit none
      character*(*) line
      integer*4 l
      real*8 rnum
      l=len(line)
      if (l.le.0.or.(index( 'tTfF',line(1:1)).gt.0)) goto 10
      read(line(1:l),*,err=10)  rnum
      IsNumber=.true.
      return
10    IsNumber=.false.      
      end
      
#     ---------------------------------------------------
      logical*4 FUNCTION IsInteger(line) 
#     true if LINE is an integer 
#     ---------------------------------------------------
      implicit none
      character*(*) line
      integer*4 l
      integer*4 inum
      l=len(line)
      if (l.le.0.or.(index( 'tTfF',line(1:1)).gt.0)) goto 10
      read(line(1:l),*,err=10)  inum
      IsInteger=.true.
      return
10    IsInteger=.false.
      end
      

#---------------------------------------------------
      SUBROUTINE GETLINPARG(line,ret,n,nos) 
# Get numerical arguments from the line and store them in RET
#---------------------------------------------------
      implicit none
      character*(*) line
      integer*4 nos,n,ierr,is,l,i
      real*8 ret(n)
      logical*4 IsNumber
      
      nos=0
      do i=1,n
         ret(i)=0
      enddo   
      ierr=0
      is=1
      do while (ierr.eq.0.and.is.lt.len(line))    ! read parameters
         call FINDPAR(line,1,is,l)
         if (l.gt.0) then
            if (IsNumber(line(is:is+l-1))) then
              read(line(is:is+l-1),*,iostat=ierr,err=100) ret(nos+1)
              nos=nos+1 
              is=is+l 
            else
              ierr=1 
            endif  
         else
            ierr=1
         endif
100      continue
      enddo
      end