Routine that extracts a real value from a line of the input file author: P J Knight, CCFE, Culham Science Centre rval : output real : extracted real value icode : output integer : diagnostic flag This routine extracts a real value from the current line of the input file, i.e. the value of a real variable as specified by the user. None
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
real(kind=dp), | intent(out) | :: | rval | |||
integer, | intent(out) | :: | icode |
subroutine get_value_real(rval,icode)
!! Routine that extracts a real value from a line of the input file
!! author: P J Knight, CCFE, Culham Science Centre
!! rval : output real : extracted real value
!! icode : output integer : diagnostic flag
!! This routine extracts a real value from the current line of
!! the input file, i.e. the value of a real variable as specified
!! by the user.
!! None
!
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
implicit none
! Arguments
integer, intent(out) :: icode
real(dp), intent(out) :: rval
! Local variables
character(len=maxlen) :: varval
integer :: varlen
integer :: foundComma, foundAst
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! *** Ignore leading spaces
10 continue
if (iptr <= linelen) then
if (line(iptr:iptr) == ' ') then
iptr = iptr + 1
goto 10
end if
end if
if (iptr > linelen) goto 60
! *** Put rest of line into varval (makes it easier to parse)
varval = line(iptr:)
! *** Exclude any input after * or , - these denote an input comment
varlen = len_trim(varval)
foundComma = varlen
foundAst = varlen
if (index(varval,',') > 0) then
foundComma = index(varval,',') - 1
end if
if (index(varval,'*') > 0) then
foundAst = index(varval,'*') - 1
end if
varlen = min(varlen, foundComma, foundAst)
if (varlen <= 0) varlen = index(varval,' ') - 1
if (varlen <= 0) varlen = iptr
varval = varval(:varlen)
varlen = len_trim(varval)
! *** Update pointer
iptr = iptr + varlen
! *** Ignore trailing spaces
50 continue
if (line(iptr:iptr) == ' ') then
iptr = iptr + 1
if (iptr <= linelen) goto 50
end if
! *** Ignore comma, if present
if (iptr <= linelen) then
if (line(iptr:iptr) == ',') iptr = iptr + 1
end if
! *** Convert the ASCII text into a real value
call string_to_real(varval,varlen,rval,icode)
goto 1000
60 continue
icode = 1
1000 continue
end subroutine get_value_real