fixed broken IO_continousIntValues to be aware of element (or other)

sets
-This line, and those below, will be ignored--


M    IO.f90
This commit is contained in:
William Counts 2007-10-23 13:08:27 +00:00
parent 9043b4374e
commit ca0e2e55df
1 changed files with 17 additions and 6 deletions

View File

@ -503,7 +503,7 @@
! read consecutive lines of ints concatenated by "c" as last char ! read consecutive lines of ints concatenated by "c" as last char
! or range of values a "to" b ! or range of values a "to" b
!******************************************************************** !********************************************************************
FUNCTION IO_continousIntValues (unit,maxN) FUNCTION IO_continousIntValues (unit,maxN,lookupName,lookupMap,lookupMaxN)
use prec, only: pReal,pInt use prec, only: pReal,pInt
implicit none implicit none
@ -511,26 +511,37 @@
integer(pInt) unit,maxN,i integer(pInt) unit,maxN,i
integer(pInt), dimension(1+maxN) :: IO_continousIntValues integer(pInt), dimension(1+maxN) :: IO_continousIntValues
integer(pInt), dimension(67) :: pos ! allow for 32 values excl "c" integer(pInt), dimension(67) :: pos ! allow for 32 values excl "c"
character(len=64), dimension(:) :: lookupName
integer(pInt) :: lookupMaxN
integer(pInt), dimension(:,:) :: lookupMap
character(len=300) line character(len=300) line
IO_continousIntValues(1) = 0 IO_continousIntValues = 0_pInt
do do
read(unit,'(A300)',end=100) line read(unit,'(A300)',end=100) line
pos = IO_stringPos(line,33) pos = IO_stringPos(line,33)
if (IO_lc(IO_stringValue(line,pos,2)) == 'to' ) then ! found range indicator if (verify(IO_stringValue(line,pos,1),"0123456789") > 0) then ! a non-int, i.e. set name
do i = 1,lookupMaxN ! loop over known set names
if (IO_stringValue(line,pos,1) == lookupName(i)) then ! found matching name
IO_continousIntValues = lookupMap(:,i) ! return resp. entity list
exit
endif
enddo
exit
else if (IO_lc(IO_stringValue(line,pos,2)) == 'to' ) then ! found range indicator
do i = IO_intValue(line,pos,1),IO_intValue(line,pos,3) do i = IO_intValue(line,pos,1),IO_intValue(line,pos,3)
IO_continousIntValues(1) = IO_continousIntValues(1)+1 IO_continousIntValues(1) = IO_continousIntValues(1)+1
IO_continousIntValues(1+IO_continousIntValues(1)) = i IO_continousIntValues(1+IO_continousIntValues(1)) = i
enddo enddo
exit exit
else else
do i = 1,pos(1)-1 ! interpret up to second to last value do i = 1,pos(1)-1 ! interpret up to second to last value
IO_continousIntValues(1) = IO_continousIntValues(1)+1 IO_continousIntValues(1) = IO_continousIntValues(1)+1
IO_continousIntValues(1+IO_continousIntValues(1)) = IO_intValue(line,pos,i) IO_continousIntValues(1+IO_continousIntValues(1)) = IO_intValue(line,pos,i)
enddo enddo
if ( IO_lc(IO_stringValue(line,pos,pos(1))) /= 'c' ) then ! line finished, read last value if ( IO_lc(IO_stringValue(line,pos,pos(1))) /= 'c' ) then ! line finished, read last value
IO_continousIntValues(1) = IO_continousIntValues(1)+1 IO_continousIntValues(1) = IO_continousIntValues(1)+1
IO_continousIntValues(1+IO_continousIntValues(1)) = IO_intValue(line,pos,pos(1)) IO_continousIntValues(1+IO_continousIntValues(1)) = IO_intValue(line,pos,pos(1))
exit exit
endif endif
endif endif