fixed flaws in fixedFormat number extraction

This commit is contained in:
William Counts 2007-03-28 10:00:49 +00:00
parent d121fbc9dd
commit 6d3155efcb
1 changed files with 23 additions and 15 deletions

View File

@ -251,10 +251,10 @@
character(len=*), parameter :: sep=achar(32)//achar(9)//achar(10)//achar(13) ! whitespaces character(len=*), parameter :: sep=achar(32)//achar(9)//achar(10)//achar(13) ! whitespaces
integer(pInt) N, part integer(pInt) N, part
integer(pInt) IO_stringPos(1+N*2) integer(pInt) IO_stringPos(1+N*2)
IO_stringPos = -1 IO_stringPos = -1
IO_stringPos(1) = 0 IO_stringPos(1) = 0
part = 1 part = 1
do while ((N<1 .or. part<=N) .and. verify(line(IO_stringPos(part*2-1)+1:),sep)>0) do while ((N<1 .or. part<=N) .and. verify(line(IO_stringPos(part*2-1)+1:),sep)>0)
IO_stringPos(part*2) = IO_stringPos(part*2-1)+verify(line(IO_stringPos(part*2-1)+1:),sep) IO_stringPos(part*2) = IO_stringPos(part*2-1)+verify(line(IO_stringPos(part*2-1)+1:),sep)
IO_stringPos(part*2+1) = IO_stringPos(part*2)+scan(line(IO_stringPos(part*2):),sep)-2 IO_stringPos(part*2+1) = IO_stringPos(part*2)+scan(line(IO_stringPos(part*2):),sep)-2
@ -277,8 +277,12 @@
character(len=*) line character(len=*) line
integer(pInt) positions(*),pos integer(pInt) positions(*),pos
character(len=1+positions(pos*2+1)-positions(pos*2)) IO_stringValue character(len=1+positions(pos*2+1)-positions(pos*2)) IO_stringValue
IO_stringValue = line(positions(pos*2):positions(pos*2+1)) if (positions(1) < pos) then
IO_stringValue = ''
else
IO_stringValue = line(positions(pos*2):positions(pos*2+1))
endif
return return
END FUNCTION END FUNCTION
@ -294,9 +298,9 @@
character(len=*) line character(len=*) line
integer(pInt) ends(*),pos integer(pInt) ends(*),pos
character(len=ends(pos)-ends(pos-1)) IO_fixedStringValue character(len=ends(pos+1)-ends(pos)) IO_fixedStringValue
IO_fixedStringValue = line(ends(pos-1)+1:ends(pos)) IO_fixedStringValue = line(ends(pos)+1:ends(pos+1))
return return
END FUNCTION END FUNCTION
@ -314,8 +318,10 @@
real(pReal) IO_floatValue real(pReal) IO_floatValue
integer(pInt) positions(*),pos integer(pInt) positions(*),pos
read(UNIT=line(positions(pos*2):positions(pos*2+1)),ERR=100,FMT='(F)') IO_floatValue if (positions(1) >= pos) then
return read(UNIT=line(positions(pos*2):positions(pos*2+1)),ERR=100,FMT='(F)') IO_floatValue
return
endif
100 IO_floatValue = -1.0_pReal 100 IO_floatValue = -1.0_pReal
return return
@ -354,12 +360,12 @@
real(pReal) IO_fixedNoEFloatValue,base real(pReal) IO_fixedNoEFloatValue,base
integer(pInt) ends(*),pos,pos_exp,expon integer(pInt) ends(*),pos,pos_exp,expon
pos_exp = scan(line(ends(pos-1)+1:ends(pos)),'+-',back=.true.) pos_exp = scan(line(ends(pos)+1:ends(pos+1)),'+-',back=.true.)
if (pos_exp > 1) then if (pos_exp > 1) then
read(UNIT=line(ends(pos-1)+1:ends(pos-1)+pos_exp-1),ERR=100,FMT='(F)') base read(UNIT=line(ends(pos)+1:ends(pos)+pos_exp-1),ERR=100,FMT='(F)') base
read(UNIT=line(ends(pos-1)+pos_exp:ends(pos)),ERR=100,FMT='(I)') expon read(UNIT=line(ends(pos)+pos_exp:ends(pos+1)),ERR=100,FMT='(I)') expon
else else
read(UNIT=line(ends(pos-1)+1:ends(pos)),ERR=100,FMT='(F)') base read(UNIT=line(ends(pos)+1:ends(pos+1)),ERR=100,FMT='(F)') base
expon = 0_pInt expon = 0_pInt
endif endif
IO_fixedNoEFloatValue = base*10.0_pReal**expon IO_fixedNoEFloatValue = base*10.0_pReal**expon
@ -382,8 +388,10 @@
integer(pInt) IO_intValue integer(pInt) IO_intValue
integer(pInt) positions(*),pos integer(pInt) positions(*),pos
read(UNIT=line(positions(pos*2):positions(pos*2+1)),ERR=100,FMT='(I)') IO_intValue if (positions(1) >= pos) then
return read(UNIT=line(positions(pos*2):positions(pos*2+1)),ERR=100,FMT='(I)') IO_intValue
return
endif
100 IO_intValue = -1_pInt 100 IO_intValue = -1_pInt
return return
@ -402,7 +410,7 @@
integer(pInt) IO_fixedIntValue integer(pInt) IO_fixedIntValue
integer(pInt) ends(*),pos integer(pInt) ends(*),pos
read(UNIT=line(ends(pos-1)+1:ends(pos)),ERR=100,FMT='(I)') IO_fixedIntValue read(UNIT=line(ends(pos)+1:ends(pos+1)),ERR=100,FMT='(I)') IO_fixedIntValue
return return
100 IO_fixedIntValue = -1_pInt 100 IO_fixedIntValue = -1_pInt
return return