40 real*8 rvalue8, frac8, exp8, ten8
42 character decpt*1, e*1, plus*1, minus*1, t*1
43 parameter(decpt=
'.', e=
'E', plus=
'+', minus=
'-')
46 parameter(error = 1, no_error = 0, no_text = 0)
47 parameter(max_exp = 27, max_digits = 9)
53 call
strip(text, start, end)
54 if (start .eq. no_text)
then
67 do while (( i .le. end) .and. (text(i:i) .ne. decpt))
77 do while ((i .le. end) .and. (text(i:i) .ne. e))
82 else if (i .eq. end)
then
89 if ((iexp .gt. 0) .and. (idecpt .ge. iexp))
then
105 call
strip(text((iexp+1):end), istart_exp, iend_exp)
106 if ((end-iexp-1) .ne. (iend_exp-istart_exp))
then
113 call
conv_to_int(text((iexp+1):end), ivalue, isign, iflag)
114 if ((iflag .eq. error) .or. (ivalue .gt. max_exp))
then
118 exp8 = ten8 ** (ivalue*isign)
127 if (idecpt .gt. 0)
then
131 t = text((idecpt+1):(idecpt+1))
132 if (iexp .gt. 0)
then
136 if (idecpt .lt. (iexp-1))
then
142 if ((t .eq. plus) .or. (t .eq. minus))
then
147 call
strip(text((idecpt+1):(iexp-1)),
148 & istart_frac, iend_frac)
149 if ((iexp-idecpt-2) .ne. (iend_frac-istart_frac))
then
155 & ifrac, isign, iflag)
156 if (iflag .eq. error)
then
161 num_digits = (iexp - idecpt - 1)
162 if (num_digits .gt. max_digits)
then
166 frac8 = dfloat(ifrac) * (ten8 ** (-1*num_digits))
173 if (idecpt .lt. end)
then
178 if ((t .eq. plus) .or. (t .eq. minus))
then
183 call
strip(text((idecpt+1):end),
184 & istart_frac, iend_frac)
185 if ((end-idecpt-1) .ne. (iend_frac-istart_frac))
then
190 call
conv_to_int(text((idecpt+1):end), ifrac, isign,
192 if (iflag .eq. error)
then
197 num_digits =
end - idecpt
198 if (num_digits .gt. max_digits)
then
202 frac8 = dfloat(ifrac) * (ten8 ** (-1*num_digits))
215 t = text(start:start)
216 if (idecpt .gt. start)
then
220 if (idecpt .gt. (start+1))
then
226 call
strip(text(start:idecptm),
227 & istart_int, iend_int)
228 if ((idecpt-1-start) .ne. (iend_int-istart_int))
then
233 call
conv_to_int(text(start:idecptm), int, intsign,
235 if (iflag .eq. error)
then
244 if (t .eq. plus)
then
247 else if (t .eq. minus)
then
252 if (iflag .eq. error)
then
260 else if (idecpt .eq. start)
then
267 else if (iexp .gt. start)
then
271 if (iexp .gt. (start+1))
then
276 call
strip(text(start:(iexp-1)), istart_int, iend_int)
277 if ((iexp-1-start) .ne. (iend_int-istart_int))
then
282 call
conv_to_int(text(start:(iexp-1)), int, intsign, iflag)
283 if (iflag .eq. error)
then
292 if (t .eq. plus)
then
295 else if (t .eq. minus)
then
300 if (iflag .eq. error)
then
308 else if (iexp .eq. start)
then
320 call
conv_to_int(text(start:end), int, intsign, iflag)
321 if (iflag .eq. error)
then
330 rvalue8 = (dfloat(int) + frac8) * exp8
331 if (intsign .lt. 0)
then
332 rvalue = -sngl(rvalue8)
334 rvalue = sngl(rvalue8)
subroutine conv_to_int(text, intmag, intsign, flag)
subroutine strip(text, start, end)
subroutine text_to_real(text, rvalue, flag)