get_substring Subroutine

private subroutine get_substring(string, icode)

Routine that extracts a substring from a line of the input file author: P J Knight, CCFE, Culham Science Centre string : output string : extracted string icode : output integer : diagnostic flag This routine extracts a string from the current line of the input file, i.e. the value of a string variable as specified by the user. Unlike routine get_substring_trim, this routine does not truncate the string found at its first non-leading blank. None

Arguments

Type IntentOptional AttributesName
character(len=*), intent(out) :: string
integer, intent(out) :: icode

Contents

Source Code


Source Code

  subroutine get_substring(string,icode)

    !! Routine that extracts a substring from a line of the input file
    !! author: P J Knight, CCFE, Culham Science Centre
    !! string : output string : extracted string
    !! icode  : output integer : diagnostic flag
    !! This routine extracts a string from the current line of
    !! the input file, i.e. the value of a string variable as specified
    !! by the user. Unlike routine
    !! <A HREF="get_substring_trim.html">get_substring_trim</A>,
    !! this routine does not truncate the string found at its first
    !! non-leading blank.
    !! None
    !
    ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

    implicit none

    !  Arguments

    integer, intent(out) :: icode
    character(len=*), intent(out) :: string

    !  Local variables

    character(len=maxlen) :: varval
    integer :: varlen

    ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

    ! *** 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:)
    varlen = len_trim(varval)

    if (varlen <= 0) varlen = iptr

    ! *** 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

    ! *** Write the text into the variable

    string = varval

    goto 1000

60  continue
    icode = 1

1000 continue

  end subroutine get_substring