added IO_continousIntValues

trunk/IO.f90

@@ -418,10 +418,10 @@
  END FUNCTION
 
 
-!********************************************************************
-! change character in line to lower case
-!********************************************************************
- FUNCTION IO_lc (line)
+!********************************************************************
+! change character in line to lower case
+!********************************************************************
+ FUNCTION IO_lc (line)
 
  use prec, only: pInt
  implicit none
@@ -461,6 +461,47 @@
  END SUBROUTINE
 
 
+!********************************************************************
+! read consecutive lines of ints concatenatred by "c" as last char
+! or range of values a "to" b
+!********************************************************************
+ FUNCTION IO_continousIntValues (unit,maxN)
+
+ use prec, only: pReal,pInt
+ implicit none
+
+ integer(pInt)  unit,maxN,i
+ integer(pInt), dimension(1+maxN) :: IO_continousIntValues
+ integer(pInt), dimension(67) :: pos  ! allow for 32 values excl "c"
+ character(len=300) line
+
+ IO_continousIntValues(1) = 0
+ do
+   read(unit,'(A300)',end=100) line
+   pos = IO_stringPos(line,33)
+   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)
+       IO_continousIntValues(1) = IO_continousIntValues(1)+1
+	   IO_continousIntValues(1+IO_continousIntValues(1)) = i
+     enddo
+	 exit
+   else
+     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)) = IO_intValue(line,pos,i)
+     enddo
+     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)) = IO_intValue(line,pos,pos(1))
+       exit
+     endif
+   endif
+ enddo
+100 return
+
+ END FUNCTION
+
+
 !********************************************************************
 ! write error statements to standard out
 ! and terminate the Marc run with exit #9xxx