C C $Id: rdnum.F,v 1.3 1998/07/16 16:40:33 jjv5 Exp $ C C------------------------------------------------------------------------ CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C contains all the routines to convert strings to numbers C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC subroutine rdnum(string,istart,value,ierror) c c extracts a double precision floating point number from a character c string. the field of search starts at string(istart:istart) or c after the first equals sign following the istart position. the c number is returned in value. if an error is encountered, ierror c is set to one. this routine expects that there are no blank spaces c embedded anywhere within the numerical field. c implicit double precision (a-h,o-z) character string*(*),char*1,efield(4)*1 data efield /'E','e','D','d'/ save efield ierror = 0 ibeg = istart istop = len(string) iend = istop do 10 i=istart,istop if(string(i:i).eq.' ')then iend = i-1 go to 20 endif 10 continue 20 if(iend.lt.ibeg)then ierror = 1 go to 1000 endif ieq = index(string(ibeg:iend),'=') if(ieq.ne.0) ibeg = ibeg + ieq call getnum(string,ibeg,iend,value,ierror) 1000 return end c c cc------------------------------------------------------------cc cc------------------------------------------------------------cc subroutine getnum(string,ibeg,iend,value,ierror) implicit double precision(a-h,o-z) character string*(*),char*1,efield(4)*1 data efield /'E','e','D','d'/ save efield CC-----------------------------------------------------CC value = 0.0d0 c c check for algebraic sign. c char = string(ibeg:ibeg) if(char.eq.'-')then asign = -1.0d0 ibeg = ibeg + 1 elseif(char.eq.'+')then asign = 1.0d0 ibeg = ibeg + 1 else asign = 1.0d0 endif if(ibeg.gt.iend)then ierror = 1 go to 1000 endif c c first determine the whole number equivalent of whatever is c to the left of any decimal point. c idecml = index(string(ibeg:iend),'.') if(idecml.eq.1)then if(ibeg.eq.iend)then c c number is just a decimal point. assume a value of zero. c value = 0.0d0 go to 1000 endif xleft = 0.0d0 ibeg = ibeg+1 else i1 = ibeg if(idecml.eq.0)then i2 = iend else i2 = ibeg+idecml-2 endif call whole(string,i1,i2,xleft,ierror) if(ierror.ne.0) go to 1000 value = xleft*asign if(idecml.eq.0.or.i2.eq.(iend-1)) go to 1000 ibeg = i2+2 endif c c determine the whole number equivalent of whatever is to the c right of the decimal point. account for e or d field format. c do 30 i=1,4 ie = index(string(ibeg:iend),efield(i)) if(ie.ne.0) go to 40 30 continue 40 if(ie.eq.1)then value = xleft*asign ibeg = ibeg + 1 else i1 = ibeg if(ie.eq.0)then i2 = iend else i2 = ibeg+ie-2 endif call whole(string,i1,i2,xright,ierror) if(ierror.ne.0) go to 1000 xright = xright*10.0d0**(i1-i2-1) value = value + xright*asign if(ie.eq.0.or.i2.eq.(iend-1)) go to 1000 ibeg = i2+2 endif c c get the exponential portion. c char = string(ibeg:ibeg) if(char.eq.'-')then esign = -1.0d0 ibeg = ibeg + 1 elseif(char.eq.'+')then esign = 1.0d0 ibeg = ibeg + 1 else esign = 1.0d0 endif if(ibeg.gt.iend) go to 1000 i1 = ibeg i2 = iend call whole(string,i1,i2,expart,ierror) if(ierror.ne.0) go to 1000 value = value*10.0d0**(esign*expart) 1000 return end c c c CC------------------------------------------------------------CC CC------------------------------------------------------------CC subroutine whole(string,ibeg,iend,value,ierror) c c returns the whole number in the field string(ibeg:iend). only c the numbers 0-9 are allowed to be present. c implicit double precision (a-h,o-z) character string*(*) ierror = 0 value = 0.0d0 ichar0 = ichar('0') do 10 i=ibeg,iend idigit = ichar(string(i:i)) - ichar0 if(idigit.lt.0.or.idigit.gt.9)then ierror = 1 go to 1000 endif value = 10.0d0*value + idigit 10 continue 1000 return end c c CC------------------------------------------------------------CC CC------------------------------------------------------------CC subroutine rdinum(string,istart,ivalue,ierror) implicit double precision (a-h,o-z) character string*(*),char*1,efield(4)*1 ierror = 0 ibeg = istart istop = len(string) iend = istop do 10 i=istart,istop if(string(i:i).eq.' ')then iend = i-1 go to 20 endif 10 continue 20 if(iend.lt.ibeg)then ierror = 1 go to 1000 endif ieq = index(string(ibeg:iend),'=') if(ieq.ne.0) ibeg = ibeg + ieq call getinum(string,ibeg,iend,ivalue,ierror) write(*,*)'string',string,ierror 1000 return end CC------------------------------------------------------------CC CC------------------------------------------------------------CC subroutine getinum(string,ib,ie,ivalue,ierror) implicit double precision (a-h,o-z) character string*(*),char*1,efield(4)*1 ierror = 0 ivalue = 0 if (string(ib:ib) .eq. '-') then ib = ib + 1 isign = -1 elseif (string(ib:ib) .eq. '+') then ib = ib + 1 isign = 1 else isign = 1 endif call iwhole(string,ib,ie,ivalue,ierror) ivalue = ivalue * isign 1000 return end CC------------------------------------------------------------CC CC------------------------------------------------------------CC subroutine iwhole(string,ibeg,iend,ivalue,ierror) c c returns the whole number in the field string(ibeg:iend). only c the numbers 0-9 are allowed to be present. c character string*(*) ivalue = 0 ichar0 = ichar('0') do 10 i=ibeg,iend idigit = ichar(string(i:i)) - ichar0 if(idigit.lt.0.or.idigit.gt.9)then ierror = 1 go to 1000 endif ivalue = 10*ivalue + idigit 10 continue 1000 return end CC------------------------------------------------------------CC CC------------------------------------------------------------CC subroutine iatoi(str, istart, lstr, integ, ierror) implicit double precision(a-h,o-z) character str*(*), ch logical int, min integ = 0 izero = ichar('0') nstr = len(str) do i=istart,nstr ch = str(i:i) call whatis2(ch, int, min) if (.not.int) goto 20 enddo 20 lstr = i-1 if (lstr.eq.0) return call getinum(str,istart,lstr,integ,ierror) end CC------------------------------------------------------------CC CC------------------------------------------------------------CC subroutine iatoimp(str, istart, lstr, integ, ierror) implicit double precision(a-h,o-z) character str*(*), ch logical int, min integ = 0 izero = ichar('0') nstr = len(str) do i=istart,nstr ch = str(i:i) call whatis1i(ch, int) if (.not.int) goto 20 enddo 20 lstr = i-1 if (lstr.eq.0) return call getinum(str,istart,lstr,integ,ierror) end