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