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

changed format for reading float from('F') to * in IO_floatValue

This commit is contained in:
Franz Roters 2007-04-25 14:38:22 +00:00
parent 033a6a03b3
commit 1fd722e4cf
1 changed files with 65 additions and 65 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

130
trunk/IO.f90
View File

@ -257,10 +257,10 @@
character(len=*), parameter :: sep=achar(32)//achar(9)//achar(10)//achar(13) ! whitespaces character(len=*), parameter :: sep=achar(32)//achar(9)//achar(10)//achar(13) ! whitespaces
integer(pInt) N, part integer(pInt) N, part
integer(pInt) IO_stringPos(1+N*2) integer(pInt) IO_stringPos(1+N*2)
IO_stringPos = -1 IO_stringPos = -1
IO_stringPos(1) = 0 IO_stringPos(1) = 0
part = 1 part = 1
do while ((N<1 .or. part<=N) .and. verify(line(IO_stringPos(part*2-1)+1:),sep)>0) do while ((N<1 .or. part<=N) .and. verify(line(IO_stringPos(part*2-1)+1:),sep)>0)
IO_stringPos(part*2) = IO_stringPos(part*2-1)+verify(line(IO_stringPos(part*2-1)+1:),sep) IO_stringPos(part*2) = IO_stringPos(part*2-1)+verify(line(IO_stringPos(part*2-1)+1:),sep)
IO_stringPos(part*2+1) = IO_stringPos(part*2)+scan(line(IO_stringPos(part*2):),sep)-2 IO_stringPos(part*2+1) = IO_stringPos(part*2)+scan(line(IO_stringPos(part*2):),sep)-2
@ -283,11 +283,11 @@
character(len=*) line character(len=*) line
integer(pInt) positions(*),pos integer(pInt) positions(*),pos
character(len=1+positions(pos*2+1)-positions(pos*2)) IO_stringValue character(len=1+positions(pos*2+1)-positions(pos*2)) IO_stringValue
if (positions(1) < pos) then if (positions(1) < pos) then
IO_stringValue = '' IO_stringValue = ''
else else
IO_stringValue = line(positions(pos*2):positions(pos*2+1)) IO_stringValue = line(positions(pos*2):positions(pos*2+1))
endif endif
return return
@ -324,9 +324,9 @@
real(pReal) IO_floatValue real(pReal) IO_floatValue
integer(pInt) positions(*),pos integer(pInt) positions(*),pos
if (positions(1) >= pos) then if (positions(1) >= pos) then
read(UNIT=line(positions(pos*2):positions(pos*2+1)),ERR=100,FMT='(F)') IO_floatValue read(UNIT=line(positions(pos*2):positions(pos*2+1)),ERR=100,FMT=*) IO_floatValue
return return
endif endif
100 IO_floatValue = -1.0_pReal 100 IO_floatValue = -1.0_pReal
return return
@ -394,10 +394,10 @@
integer(pInt) IO_intValue integer(pInt) IO_intValue
integer(pInt) positions(*),pos integer(pInt) positions(*),pos
if (positions(1) >= pos) then if (positions(1) >= pos) then
read(UNIT=line(positions(pos*2):positions(pos*2+1)),ERR=100,FMT='(I)') IO_intValue read(UNIT=line(positions(pos*2):positions(pos*2+1)),ERR=100,FMT='(I)') IO_intValue
return return
endif endif
100 IO_intValue = -1_pInt 100 IO_intValue = -1_pInt
return return
@ -424,10 +424,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
@ -437,9 +437,9 @@
integer(pInt) i integer(pInt) i
IO_lc = line IO_lc = line
do i=1,len(line) do i=1,len(line)
if(64<iachar(line(i:i)) .and. iachar(line(i:i))<91) IO_lc(i:i)=achar(iachar(line(i:i))+32) if(64<iachar(line(i:i)) .and. iachar(line(i:i))<91) IO_lc(i:i)=achar(iachar(line(i:i))+32)
enddo enddo
return return
END FUNCTION END FUNCTION
@ -458,62 +458,62 @@
integer(pInt) i integer(pInt) i
IO_lc = line IO_lc = line
do i=1,len(line) do i=1,len(line)
if(64<iachar(line(i:i)) .and. iachar(line(i:i))<91) IO_lc(i:i)=achar(iachar(line(i:i))+32) if(64<iachar(line(i:i)) .and. iachar(line(i:i))<91) IO_lc(i:i)=achar(iachar(line(i:i))+32)
enddo enddo
line = IO_lc line = IO_lc
return return
END SUBROUTINE END SUBROUTINE
!******************************************************************** !********************************************************************
! read consecutive lines of ints concatenatred by "c" as last char ! read consecutive lines of ints concatenatred 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)
use prec, only: pReal,pInt use prec, only: pReal,pInt
implicit none implicit none
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=300) line character(len=300) line
IO_continousIntValues(1) = 0 IO_continousIntValues(1) = 0
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 (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
enddo enddo
100 return 100 return
END FUNCTION 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
! in ABAQUS either time step is reduced or execution terminated ! in ABAQUS either time step is reduced or execution terminated
!******************************************************************** !********************************************************************
SUBROUTINE IO_error(ID) SUBROUTINE IO_error(ID)
use prec, only: pInt use prec, only: pInt
implicit none implicit none