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