192 lines
4.7 KiB
FortranFixed
192 lines
4.7 KiB
FortranFixed
subroutine extCharToFloatNum(numchar0,cpastring,f,ierr)
|
|
implicit none
|
|
!Transform a string of length numchar consisting all numbers (e.g. 1234 or 12.19, .123,
|
|
!or 12.89d+5 or 12.89d-5, d could have been D, e, or E) into a double precision float
|
|
!number.
|
|
!ierr=0, successful conversion
|
|
! =1, conversion failed
|
|
character(*)::cpastring
|
|
character astring*50,c*1,d*1
|
|
double precision f,fsign,factor
|
|
integer ipos1,ipos2,ideci,k,j,i,m,numchar0,
|
|
& numchar,ierr,ispartnum,nlength
|
|
|
|
nlength=len(trim(cpastring))
|
|
!
|
|
!return error with empty string
|
|
if(nlength.eq.0)then
|
|
f=-9999.0d0
|
|
ierr=1
|
|
return
|
|
endif
|
|
if(index(cpastring,'n').ne.0)then
|
|
!in case of 'nan'
|
|
f=-9999.0d0
|
|
ierr=1
|
|
return
|
|
endif
|
|
if(index(cpastring,'N').ne.0)then
|
|
!in case of 'NAN'
|
|
f=-9999.0d0
|
|
ierr=1
|
|
return
|
|
endif
|
|
!First remove space and change '.123' to '0.123'
|
|
ipos1=0
|
|
numchar=0
|
|
i=0
|
|
10 i=i+1
|
|
if(numchar.eq.nlength)goto 11
|
|
c=cpastring(i:i)
|
|
if(ispartnum(c).eq.1)then
|
|
if(ipos1.eq.0)ipos1=i
|
|
numchar=numchar+1
|
|
goto 10
|
|
else
|
|
if(numchar.eq.0)goto 10
|
|
endif
|
|
11 astring=cpastring(ipos1:(ipos1+numchar-1))
|
|
if(astring(numchar:numchar).eq.'.')then
|
|
astring=astring(1:numchar)//'0'
|
|
numchar=numchar+1
|
|
endif
|
|
if(astring(1:1).eq.'.')then
|
|
astring='0'//astring(1:numchar)
|
|
numchar=numchar+1
|
|
endif
|
|
if(astring(1:2).eq.'-.')then
|
|
astring='-0.'//astring(3:numchar)
|
|
numchar=numchar+1
|
|
endif
|
|
if(astring(1:2).eq.'+.')then
|
|
astring='0.'//astring(3:numchar)
|
|
endif
|
|
ierr=1
|
|
f=-9999.0d0
|
|
fsign=1.0d0
|
|
ipos1=1
|
|
190 c=astring(ipos1:ipos1)
|
|
if(ispartnum(c).eq.1)goto 200
|
|
ipos1=ipos1+1
|
|
goto 190
|
|
200 ipos2=ipos1+numchar-1
|
|
if(astring(ipos1:ipos1).eq.'-')then
|
|
ipos1=ipos1+1
|
|
fsign=-1.0d0
|
|
else
|
|
if(astring(ipos1:ipos1).eq.'+')ipos1=ipos1+1
|
|
endif
|
|
ideci=index(astring,'.')
|
|
if(ideci.eq.0)then
|
|
!1234, 1234e+6, 1234e-6,1234e6, e can be E, d, or D
|
|
m=ipos2
|
|
else
|
|
m=ideci-1
|
|
endif
|
|
factor=1.0d0
|
|
k=0
|
|
j=0
|
|
i=m
|
|
210 c=astring(i:i)
|
|
if(c.eq.'+'.or.c.eq.'-')then
|
|
if(i.eq.m)return
|
|
if(i.gt.(ipos1+1))then
|
|
i=i-1
|
|
d=astring(i:i)
|
|
if(d.eq.'e'.or.d.eq.'E'.or.d.eq.'d'.or.d.eq.'D')then
|
|
if(c.eq.'+')then
|
|
factor=10.0d0**(dble(k))
|
|
else
|
|
factor=10.0d0**(dble(-k))
|
|
endif
|
|
else
|
|
return
|
|
endif
|
|
k=0
|
|
j=0
|
|
else
|
|
return
|
|
endif
|
|
else
|
|
if(c.eq.'e'.or.c.eq.'E'.or.c.eq.'d'.or.c.eq.'D')then
|
|
if(i.eq.m)return
|
|
if(i.gt.ipos1)then
|
|
factor=10.0d0**(dble(k))
|
|
k=0
|
|
j=0
|
|
else
|
|
return
|
|
endif
|
|
else
|
|
if((ichar(c)-48).ge.0.and.(ichar(c)-48).le.9)then
|
|
k=k+(ichar(c)-48)*(10**j)
|
|
j=j+1
|
|
else
|
|
return
|
|
endif
|
|
endif
|
|
endif
|
|
if(i.gt.ipos1)then
|
|
i=i-1
|
|
goto 210
|
|
endif
|
|
f=dble(k)*factor
|
|
k=0
|
|
if(ideci.gt.0)then
|
|
!18.27 type of character
|
|
i=ideci+1
|
|
220 c=astring(i:i)
|
|
if((ichar(c)-48).ge.0.and.(ichar(c)-48).le.9)then
|
|
k=k+1
|
|
f=f+dble(ichar(c)-48)*(10.0d0**(-k))
|
|
if(i.lt.ipos2)then
|
|
i=i+1
|
|
goto 220
|
|
endif
|
|
else
|
|
if(c.eq.'e'.or.c.eq.'E'.or.c.eq.'d'.or.c.eq.'D')then
|
|
if(i.eq.ipos2)return
|
|
if(astring(ipos2:ipos2).eq.'+'.or.
|
|
& astring(ipos2:ipos2).eq.'-')return
|
|
i=i+1
|
|
c=astring(i:i)
|
|
ipos1=i+1
|
|
if(c.eq.'-')then
|
|
m=0
|
|
else
|
|
m=1
|
|
if(c.ne.'+')then
|
|
if((ichar(c)-48).ge.0.and.(ichar(c)-48).le.9)then
|
|
ipos1=i
|
|
else
|
|
return
|
|
endif
|
|
endif
|
|
endif
|
|
k=0
|
|
j=0
|
|
do i=ipos2,ipos1,-1
|
|
c=astring(i:i)
|
|
if((ichar(c)-48).ge.0.and.(ichar(c)-48).le.9)then
|
|
k=k+(ichar(c)-48)*(10**j)
|
|
j=j+1
|
|
else
|
|
return
|
|
endif
|
|
enddo
|
|
if(m.eq.0)then
|
|
f=f/(10.0d0**dble(k))
|
|
else
|
|
f=f*(10.0d0**dble(k))
|
|
endif
|
|
else
|
|
return
|
|
endif
|
|
endif
|
|
endif
|
|
f=f*fsign
|
|
ierr=0
|
|
return
|
|
end subroutine extCharToFloatNum
|
|
|