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

preventing array index out of bounds in case of empty line, removed to goto statements

This commit is contained in:
Martin Diehl 2012-11-07 09:31:46 +00:00
parent 5214b93342
commit 9b99825ac6
1 changed files with 54 additions and 44 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

96
code/IO.f90
View File

@ -462,24 +462,30 @@ function IO_hybridIA(Nast,ODFfileName)
real(pReal), dimension(:,:,:), allocatable :: dV_V real(pReal), dimension(:,:,:), allocatable :: dV_V
character(len=80) :: line character(len=80) :: line
call IO_open_file(999_pInt,ODFfileName)
!--- parse header of ODF file --- !--- parse header of ODF file ---
call IO_open_file(999_pInt,ODFfileName)
IO_hybridIA = -1.0_pReal ! initialize return value for case of error
!--- limits in phi1, Phi, phi2 --- !--- limits in phi1, Phi, phi2 ---
read(999,fmt=fileFormat,end=100) line read(999,fmt=fileFormat,end=100) line
myPos = IO_stringPos(line,3_pInt) myPos = IO_stringPos(line,3_pInt)
if (myPos(1).ne.3) goto 100 if (myPos(1) == 3) then ! found 3 chunks
do i=1_pInt,3_pInt forall(i=1_pInt:3_pInt) limits(i) = IO_floatValue(line,myPos,i)*INRAD
limits(i) = IO_floatValue(line,myPos,i)*INRAD else ! wrong line format
enddo close(999)
return
endif
!--- deltas in phi1, Phi, phi2 --- !--- deltas in phi1, Phi, phi2 ---
read(999,fmt=fileFormat,end=100) line read(999,fmt=fileFormat,end=100) line
myPos = IO_stringPos(line,3_pInt) myPos = IO_stringPos(line,3_pInt)
if (myPos(1).ne.3) goto 100 if (myPos(1) == 3) then ! found 3 chunks
do i=1_pInt,3_pInt forall(i=1_pInt:3_pInt) deltas(i) = IO_floatValue(line,myPos,i)*INRAD
deltas(i) = IO_floatValue(line,myPos,i)*INRAD else ! wrong line format
enddo close(999)
return
endif
steps = nint(limits/deltas,pInt) steps = nint(limits/deltas,pInt)
allocate(dV_V(steps(3),steps(2),steps(1))) allocate(dV_V(steps(3),steps(2),steps(1)))
@ -569,12 +575,8 @@ function IO_hybridIA(Nast,ODFfileName)
IO_hybridIA(3,i) = deltas(3)*(real(mod(bin ,steps(3)),pReal)+center) ! phi2 IO_hybridIA(3,i) = deltas(3)*(real(mod(bin ,steps(3)),pReal)+center) ! phi2
binSet(j) = binSet(i) binSet(j) = binSet(i)
enddo enddo
close(999)
return
! on error 100 close(999)
100 IO_hybridIA = -1.0_pReal
close(999)
end function IO_hybridIA end function IO_hybridIA
@ -1058,13 +1060,13 @@ character(len=300) pure function IO_extractValue(line,key)
character(len=*), parameter :: sep = achar(61) ! '=' character(len=*), parameter :: sep = achar(61) ! '='
integer :: myPos ! no pInt (scan returns default integer) integer :: myPos ! no pInt (scan returns default integer)
IO_extractValue = '' IO_extractValue = ''
myPos = scan(line,sep) myPos = scan(line,sep)
if (myPos > 0 .and. line(:myPos-1) == key(:myPos-1)) & ! key matches expected key if (myPos > 0 .and. line(:myPos-1) == key(:myPos-1)) & ! key matches expected key
IO_extractValue = line(myPos+1:) ! extract value IO_extractValue = line(myPos+1:) ! extract value
end function IO_extractValue end function IO_extractValue
@ -1124,17 +1126,20 @@ integer(pInt) function IO_countContinuousIntValues(myUnit)
do do
read(myUnit,'(A300)',end=100) line read(myUnit,'(A300)',end=100) line
myPos = IO_stringPos(line,maxNchunks) myPos = IO_stringPos(line,maxNchunks)
if (IO_lc(IO_stringValue(line,myPos,2_pInt)) == 'to' ) then ! found range indicator if (myPos(1) < 1_pInt) then ! empty line
IO_countContinuousIntValues = 1_pInt + IO_intValue(line,myPos,3_pInt) - IO_intValue(line,myPos,1_pInt) exit
exit ! only one single range indicator allowed elseif (IO_lc(IO_stringValue(line,myPos,2_pInt)) == 'to' ) then ! found range indicator
else if (IO_lc(IO_stringValue(line,myPos,2_pInt)) == 'of' ) then ! found multiple entries indicator IO_countContinuousIntValues = 1_pInt + IO_intValue(line,myPos,3_pInt) &
- IO_intValue(line,myPos,1_pInt)
exit ! only one single range indicator allowed
else if (IO_lc(IO_stringValue(line,myPos,2_pInt)) == 'of' ) then ! found multiple entries indicator
IO_countContinuousIntValues = IO_intValue(line,myPos,1_pInt) IO_countContinuousIntValues = IO_intValue(line,myPos,1_pInt)
exit ! only one single multiplier allowed exit ! only one single multiplier allowed
else else
IO_countContinuousIntValues = IO_countContinuousIntValues+myPos(1)-1_pInt ! add line's count when assuming 'c' IO_countContinuousIntValues = IO_countContinuousIntValues+myPos(1)-1_pInt ! add line's count when assuming 'c'
if ( IO_lc(IO_stringValue(line,myPos,myPos(1))) /= 'c' ) then ! line finished, read last value if ( IO_lc(IO_stringValue(line,myPos,myPos(1))) /= 'c' ) then ! line finished, read last value
IO_countContinuousIntValues = IO_countContinuousIntValues+1_pInt IO_countContinuousIntValues = IO_countContinuousIntValues+1_pInt
exit ! data ended exit ! data ended
endif endif
endif endif
enddo enddo
@ -1190,10 +1195,12 @@ function IO_continuousIntValues(myUnit,maxN,lookupName,lookupMap,lookupMaxN)
do do
read(myUnit,'(A65536)',end=100) line read(myUnit,'(A65536)',end=100) line
myPos = IO_stringPos(line,maxNchunks) myPos = IO_stringPos(line,maxNchunks)
if (verify(IO_stringValue(line,myPos,1_pInt),'0123456789') > 0) then ! a non-int, i.e. set name if (myPos(1) < 1_pInt) then ! empty line
do i = 1_pInt, lookupMaxN ! loop over known set names exit
if (IO_stringValue(line,myPos,1_pInt) == lookupName(i)) then ! found matching name elseif (verify(IO_stringValue(line,myPos,1_pInt),'0123456789') > 0) then ! a non-int, i.e. set name
IO_continuousIntValues = lookupMap(:,i) ! return resp. entity list do i = 1_pInt, lookupMaxN ! loop over known set names
if (IO_stringValue(line,myPos,1_pInt) == lookupName(i)) then ! found matching name
IO_continuousIntValues = lookupMap(:,i) ! return resp. entity list
exit exit
endif endif
enddo enddo
@ -1209,11 +1216,11 @@ function IO_continuousIntValues(myUnit,maxN,lookupName,lookupMap,lookupMaxN)
IO_continuousIntValues(2:IO_continuousIntValues(1)+1) = IO_intValue(line,myPos,3_pInt) IO_continuousIntValues(2:IO_continuousIntValues(1)+1) = IO_intValue(line,myPos,3_pInt)
exit exit
else else
do i = 1_pInt,myPos(1)-1_pInt ! interpret up to second to last value do i = 1_pInt,myPos(1)-1_pInt ! interpret up to second to last value
IO_continuousIntValues(1) = IO_continuousIntValues(1) + 1_pInt IO_continuousIntValues(1) = IO_continuousIntValues(1) + 1_pInt
IO_continuousIntValues(1+IO_continuousIntValues(1)) = IO_intValue(line,myPos,i) IO_continuousIntValues(1+IO_continuousIntValues(1)) = IO_intValue(line,myPos,i)
enddo enddo
if ( IO_lc(IO_stringValue(line,myPos,myPos(1))) /= 'c' ) then ! line finished, read last value if ( IO_lc(IO_stringValue(line,myPos,myPos(1))) /= 'c' ) then ! line finished, read last value
IO_continuousIntValues(1) = IO_continuousIntValues(1) + 1_pInt IO_continuousIntValues(1) = IO_continuousIntValues(1) + 1_pInt
IO_continuousIntValues(1+IO_continuousIntValues(1)) = IO_intValue(line,myPos,myPos(1)) IO_continuousIntValues(1+IO_continuousIntValues(1)) = IO_intValue(line,myPos,myPos(1))
exit exit
@ -1237,25 +1244,24 @@ function IO_continuousIntValues(myUnit,maxN,lookupName,lookupMap,lookupMaxN)
do l = 1_pInt,c do l = 1_pInt,c
read(myUnit,'(A65536)',end=100) line read(myUnit,'(A65536)',end=100) line
myPos = IO_stringPos(line,maxNchunks) myPos = IO_stringPos(line,maxNchunks)
if (verify(IO_stringValue(line,myPos,1_pInt),'0123456789') > 0) then ! a non-int, i.e. set names follow on this line if (verify(IO_stringValue(line,myPos,1_pInt),'0123456789') > 0) then ! a non-int, i.e. set names follow on this line
do i = 1_pInt,myPos(1) ! loop over set names in line do i = 1_pInt,myPos(1) ! loop over set names in line
do j = 1_pInt,lookupMaxN ! look thru known set names do j = 1_pInt,lookupMaxN ! look thru known set names
if (IO_stringValue(line,myPos,i) == lookupName(j)) then ! found matching name if (IO_stringValue(line,myPos,i) == lookupName(j)) then ! found matching name
first = 2_pInt + IO_continuousIntValues(1) ! where to start appending data first = 2_pInt + IO_continuousIntValues(1) ! where to start appending data
last = first + lookupMap(1,j) - 1_pInt ! up to where to append data last = first + lookupMap(1,j) - 1_pInt ! up to where to append data
IO_continuousIntValues(first:last) = lookupMap(2:1+lookupMap(1,j),j) ! add resp. entity list IO_continuousIntValues(first:last) = lookupMap(2:1+lookupMap(1,j),j) ! add resp. entity list
IO_continuousIntValues(1) = IO_continuousIntValues(1) + lookupMap(1,j) ! count them IO_continuousIntValues(1) = IO_continuousIntValues(1) + lookupMap(1,j) ! count them
endif endif
enddo enddo
enddo enddo
else if (rangeGeneration) then ! range generation else if (rangeGeneration) then ! range generation
do i = IO_intValue(line,myPos,1_pInt),IO_intValue(line,myPos,2_pInt),max(1_pInt,IO_intValue(line,myPos,3_pInt)) do i = IO_intValue(line,myPos,1_pInt),IO_intValue(line,myPos,2_pInt),max(1_pInt,IO_intValue(line,myPos,3_pInt))
IO_continuousIntValues(1) = IO_continuousIntValues(1) + 1_pInt IO_continuousIntValues(1) = IO_continuousIntValues(1) + 1_pInt
IO_continuousIntValues(1+IO_continuousIntValues(1)) = i IO_continuousIntValues(1+IO_continuousIntValues(1)) = i
enddo enddo
else ! read individual elem nums else ! read individual elem nums
do i = 1_pInt,myPos(1) do i = 1_pInt,myPos(1)
! write(*,*)'IO_CIV-int',IO_intValue(line,myPos,i)
IO_continuousIntValues(1) = IO_continuousIntValues(1) + 1_pInt IO_continuousIntValues(1) = IO_continuousIntValues(1) + 1_pInt
IO_continuousIntValues(1+IO_continuousIntValues(1)) = IO_intValue(line,myPos,i) IO_continuousIntValues(1+IO_continuousIntValues(1)) = IO_intValue(line,myPos,i)
enddo enddo
@ -1265,6 +1271,10 @@ function IO_continuousIntValues(myUnit,maxN,lookupName,lookupMap,lookupMaxN)
100 end function IO_continuousIntValues 100 end function IO_continuousIntValues
!--------------------------------------------------------------------------------------------------
!> @brief returns format string for integer values without leading zeros
!--------------------------------------------------------------------------------------------------
pure function IO_intOut(intToPrint) pure function IO_intOut(intToPrint)
implicit none implicit none
character(len=16) :: N_Digits character(len=16) :: N_Digits