changed format for reading float from('F') to * in IO_floatValue
This commit is contained in:
Franz Roters
parent
033a6a03b3
commit
1fd722e4cf
130
trunk/IO.f90
130
trunk/IO.f90
|
|
@ -257,10 +257,10 @@
|
|||
character(len=*), parameter :: sep=achar(32)//achar(9)//achar(10)//achar(13) ! whitespaces
|
||||
integer(pInt) N, part
|
||||
integer(pInt) IO_stringPos(1+N*2)
|
||||
|
||||
|
||||
IO_stringPos = -1
|
||||
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)
|
||||
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
|
||||
|
|
@ -283,11 +283,11 @@
|
|||
character(len=*) line
|
||||
integer(pInt) positions(*),pos
|
||||
character(len=1+positions(pos*2+1)-positions(pos*2)) IO_stringValue
|
||||
|
||||
if (positions(1) < pos) then
|
||||
IO_stringValue = ''
|
||||
|
||||
if (positions(1) < pos) then
|
||||
IO_stringValue = ''
|
||||
else
|
||||
IO_stringValue = line(positions(pos*2):positions(pos*2+1))
|
||||
IO_stringValue = line(positions(pos*2):positions(pos*2+1))
|
||||
endif
|
||||
return
|
||||
|
||||
|
|
@ -324,9 +324,9 @@
|
|||
real(pReal) IO_floatValue
|
||||
integer(pInt) positions(*),pos
|
||||
|
||||
if (positions(1) >= pos) then
|
||||
read(UNIT=line(positions(pos*2):positions(pos*2+1)),ERR=100,FMT='(F)') IO_floatValue
|
||||
return
|
||||
if (positions(1) >= pos) then
|
||||
read(UNIT=line(positions(pos*2):positions(pos*2+1)),ERR=100,FMT=*) IO_floatValue
|
||||
return
|
||||
endif
|
||||
100 IO_floatValue = -1.0_pReal
|
||||
return
|
||||
|
|
@ -394,10 +394,10 @@
|
|||
integer(pInt) IO_intValue
|
||||
integer(pInt) positions(*),pos
|
||||
|
||||
if (positions(1) >= pos) then
|
||||
read(UNIT=line(positions(pos*2):positions(pos*2+1)),ERR=100,FMT='(I)') IO_intValue
|
||||
return
|
||||
endif
|
||||
if (positions(1) >= pos) then
|
||||
read(UNIT=line(positions(pos*2):positions(pos*2+1)),ERR=100,FMT='(I)') IO_intValue
|
||||
return
|
||||
endif
|
||||
100 IO_intValue = -1_pInt
|
||||
return
|
||||
|
||||
|
|
@ -424,10 +424,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
|
||||
|
|
@ -437,9 +437,9 @@
|
|||
integer(pInt) i
|
||||
|
||||
IO_lc = 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)
|
||||
enddo
|
||||
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)
|
||||
enddo
|
||||
return
|
||||
|
||||
END FUNCTION
|
||||
|
|
@ -458,62 +458,62 @@
|
|||
integer(pInt) i
|
||||
|
||||
IO_lc = 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)
|
||||
enddo
|
||||
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)
|
||||
enddo
|
||||
line = IO_lc
|
||||
return
|
||||
|
||||
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
|
||||
|
||||
|
||||
!********************************************************************
|
||||
! 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
|
||||
! in ABAQUS either time step is reduced or execution terminated
|
||||
!********************************************************************
|
||||
SUBROUTINE IO_error(ID)
|
||||
SUBROUTINE IO_error(ID)
|
||||
|
||||
use prec, only: pInt
|
||||
implicit none
|
||||
|
|
|
|||
Loading…
Reference in New Issue