223031012
/
DAMASK_EICMD
mirror of https://github.com/achalhp/DAMASK_EICMD.git
1
0
Fork 0
Code Issues Projects Releases Wiki Activity

added IO_continousIntValues

This commit is contained in:
William Counts 2007-04-04 08:49:00 +00:00
parent 5db61c19d3
commit f055a7b037
1 changed files with 45 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

49
trunk/IO.f90
View File

@ -418,10 +418,10 @@
END FUNCTION END FUNCTION
!******************************************************************** !********************************************************************
! change character in line to lower case ! change character in line to lower case
!******************************************************************** !********************************************************************
FUNCTION IO_lc (line) FUNCTION IO_lc (line)
use prec, only: pInt use prec, only: pInt
implicit none implicit none
@ -461,6 +461,47 @@
END SUBROUTINE 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 ! write error statements to standard out
! and terminate the Marc run with exit #9xxx ! and terminate the Marc run with exit #9xxx