added fixed format line reading

This commit is contained in:
Philip Eisenlohr 2007-03-21 14:45:03 +00:00
parent ae644e4b09
commit 7ec7d1af72
1 changed files with 88 additions and 0 deletions

View File

@ -7,6 +7,8 @@
!--------------------------- !---------------------------
! function IO_open_file(unit,relPath) ! function IO_open_file(unit,relPath)
! function IO_open_inputFile(unit) ! function IO_open_inputFile(unit)
! FUNCTION IO_hybridIA(Nast,ODFfileName)
! private FUNCTION hybridIA_reps(dV_V,steps,C)
! function IO_stringPos(line,N) ! function IO_stringPos(line,N)
! function IO_stringValue(line,positions,pos) ! function IO_stringValue(line,positions,pos)
! function IO_floatValue(line,positions,pos) ! function IO_floatValue(line,positions,pos)
@ -283,6 +285,24 @@
END FUNCTION END FUNCTION
!********************************************************************
! read string value at pos from line
!********************************************************************
FUNCTION IO_fixedStringValue (line,ends,pos)
use prec, only: pReal,pInt
implicit none
character(len=*) line
integer(pInt) ends(*),pos
character(len=positions(pos)-positions(pos-1)) IO_stringValue
IO_fixedStringValue = line(ends(pos-1)+1:ends(pos))
return
END FUNCTION
!******************************************************************** !********************************************************************
! read float value at pos from line ! read float value at pos from line
!******************************************************************** !********************************************************************
@ -303,6 +323,54 @@
END FUNCTION END FUNCTION
!********************************************************************
! read float value at pos from line
!********************************************************************
FUNCTION IO_fixedFloatValue (line,ends,pos)
use prec, only: pReal,pInt
implicit none
character(len=*) line
real(pReal) IO_fixedFloatValue
integer(pInt) ends(*),pos
READ(UNIT=line(ends(pos-1)+1:ends(pos)),ERR=100,FMT='(F)') IO_fixedFloatValue
return
100 IO_fixedFloatValue = -1.0_pReal
return
END FUNCTION
!********************************************************************
! read float value at pos from line
!********************************************************************
FUNCTION IO_fixedFloatValue (line,ends,pos)
use prec, only: pReal,pInt
implicit none
character(len=*) line
real(pReal) IO_fixedFloatValue,base,expon
integer(pInt) ends(*),pos,pos_exp
pos_exp = scan(line(ends(pos-1)+1:ends(pos),'+-',back=.true.)
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)+pos_exp:ends(pos)),ERR=100,FMT='(F)') expon
else
READ(UNIT=line(ends(pos-1)+1:ends(pos)),ERR=100,FMT='(F)') base
expon = 0.0_pReal
endif
IO_fixedNoEFloatValue = base*10.0_pReal**expon
return
100 IO_fixedNoEFloatValue = -1.0_pReal
return
END FUNCTION
!******************************************************************** !********************************************************************
! read int value at pos from line ! read int value at pos from line
!******************************************************************** !********************************************************************
@ -323,6 +391,26 @@
END FUNCTION END FUNCTION
!********************************************************************
! read int value at pos from fixed format line
!********************************************************************
FUNCTION IO_fixedIntValue (line,ends,pos)
use prec, only: pReal,pInt
implicit none
character(len=*) line
integer(pInt) IO_fixedIntValue
integer(pInt) ends(*),pos
READ(UNIT=line(ends(pos-1)+1:ends(pos)),ERR=100,FMT='(I)') IO_fixedIntValue
return
100 IO_fixedIntValue = -1_pInt
return
END FUNCTION
!******************************************************************** !********************************************************************
! change character in line to lower case ! change character in line to lower case
!******************************************************************** !********************************************************************