1 double precision function reada(a,istart,ll) 2 implicit double precision (a-h,o-z) 3 character*1 a(ll) 4 logical multi,scient 5 6 nine = ichar('9') 7 izero = ichar('0') 8 minus = ichar('-') 9 iplus = ichar('+') 10 idot = ichar('.') 11 ie = ichar('E') 12 iee = ichar('e') 13 id = ichar('D') 14 idd = ichar('d') 15 idig = 0 16 k1 = 0 17 k2 = 0 18 k3 = 0 19 one = 1.d0 20 x = 1.d0 21 do j=istart,ll 22 n = ichar(a(j)) 23 if((n.le.nine.and.n.ge.izero).or. n.eq.minus.or.n.eq.idot) 24 & goto 7 25 end do 26 reada = 0.d0 27 return 28 297 continue 30c before the dot 31 do i=j,ll 32 n = ichar(a(i)) 33 if (n.le.nine.and.n.ge.izero) then 34 idig = idig + 1 35 if (idig.gt.10) then 36 ii = i 37 goto 90 38 endif 39 k1 = k1*10 + n - izero 40 elseif (n.eq.minus.and.i.eq.j) then 41 one = -1.d0 42 elseif (n.eq.idot) then 43 goto 30 44 else 45 ii = i 46 goto 90 47 endif 48 end do 4930 continue 50c after the dot 51 idig = 0 52 do ii=i+1,ll 53 n = ichar(a(ii)) 54 if (n.le.nine.and.n.ge.izero) then 55 idig = idig + 1 56 if (idig.gt.9) goto 90 57 k2 = k2*10 + n - izero 58 x = x /10 59 elseif (n.eq.minus.and.ii.eq.i) then 60 x = -x 61 else 62 goto 90 63 endif 64 end do 6590 continue 66 scient = .false. 67 do jj=ii,ll 68 n = ichar(a(jj)) 69 if (n.eq.ie.or.n.eq.iee.or.n.eq.id.or.n.eq.idd) goto 95 70 end do 71 goto 100 7295 continue 73 if (jj.lt.159) then 74 scient = .true. 75 n = ichar(a(jj+1)) 76 if (n.eq.minus.or.n.eq.iplus) then 77 multi = .true. 78 if (n.eq.minus) multi = .false. 79 idig = 0 80 do j=jj+2,ll 81 n = ichar(a(j)) 82 if (n.le.nine.and.n.ge.izero) then 83 idig = idig + 1 84 if (idig.gt.9) goto 90 85 k3 = k3*10 + n - izero 86 else 87 goto 100 88 endif 89 end do 90 endif 91 endif 92 93100 continue 94 reada = one * ( k1 + k2 * x) 95 if (scient) then 96 if (multi) then 97 reada = reada * 10**k3 98 else 99 if (k3.gt.25) then 100 reada = 0.0d0 101 else 102 reada = reada / 10**k3 103 endif 104 endif 105 endif 106 107 return 108 end 109