Initial commit
This commit is contained in:
@@ -0,0 +1,190 @@
|
||||
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 astring*50,cpastring*(*),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
|
||||
|
||||
Reference in New Issue
Block a user