string_to_int Subroutine

private subroutine string_to_int(string, length, ivar, icode)

Routine that converts the ASCII digits in a string to an integer author: P J Knight, CCFE, Culham Science Centre string : input string : contains digits of the number length : input integer : useful length of character string ivar : output integer : value stored in the string icode : output integer : diagnostic flag This routine converts the ASCII digits in string(1:length) to the integer ivar. It is equivalent to doing 'READ(STRING(1:LENGTH),I) IVAR' but this routine conforms to the ANSI standard. Each digit is parsed in turn, the current total is multiplied by ten and the new digit is added. None

Arguments

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

Contents

Source Code


Source Code

  subroutine string_to_int(string,length,ivar,icode)

    !! Routine that converts the ASCII digits in a string to
    !! an integer
    !! author: P J Knight, CCFE, Culham Science Centre
    !! string : input string : contains digits of the number
    !! length : input integer : useful length of character string
    !! ivar : output integer : value stored in the string
    !! icode : output integer : diagnostic flag
    !! This routine converts the ASCII digits in string(1:length)
    !! to the integer ivar. It is equivalent to doing
    !! 'READ(STRING(1:LENGTH),I) IVAR' but this routine conforms
    !! to the ANSI standard.
    !! Each digit is parsed in turn, the current total is multiplied
    !! by ten and the new digit is added.
    !! None
    !
    ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

    implicit none

    !  Arguments

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

    !  Local variables

    character(len=maxlen) :: xstr
    integer :: iptr,izero,xlen
    logical :: negate

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

    ivar = 0
    icode = 0

    if (length <= 0) goto 1000

    negate = .false.
    izero = ichar('0')
    iptr = 1
    xstr = string(1:length)

    ! *** Ignore trailing spaces

    xlen = len_trim(xstr)
    if (xlen <= 0) goto 1000

    ! *** Ignore leading spaces

10  continue
    if (xstr(iptr:iptr) == ' ') then
       iptr = iptr + 1
       if (iptr > xlen) goto 1000
       goto 10
    end if

    ! *** Check for leading + or -

    if (xstr(iptr:iptr) == '+') then
       iptr = iptr + 1
       if (iptr > xlen) goto 1000
    else if (xstr(iptr:iptr) == '-') then
       negate = .true.
       iptr = iptr + 1
       if (iptr > xlen) goto 1000
    else
       continue
    end if

    ! *** Ignore leading zeros

20  continue
    if (xstr(iptr:iptr) == '0') then
       iptr = iptr + 1
       if (iptr > xlen) goto 1000
       goto 20
    end if

    ! *** Check for number too large

    if ((xlen-iptr+1) > 10) then
       if (negate) then
          ivar = -1234567890
       else
          ivar = 1234567890
          write(*,*) '1 Problem with IN file, please check line'
          write(*,*) xstr
          error = .True.
       end if
       icode = 1
       goto 1000
    else if ((xlen-iptr+1) == 10) then
       if (xstr(iptr:xlen) > '2147483647') then
          if (negate) then
             ivar = -1234567890
          else
             ivar = 1234567890
          end if
          icode = 1
          goto 1000
       end if
    else
       continue
    end if

    ! *** Parse the digits

30  continue
    if ((xstr(iptr:iptr) >= '0').and.(xstr(iptr:iptr) <= '9')) then
       ivar = (ivar * 10) + (ichar(xstr(iptr:iptr))-izero)
       iptr = iptr + 1
       if (iptr <= xlen) goto 30

       ! *** This is the normal exit path...

       if (negate) ivar = -ivar

    else
       if(ivar /= 0) then
          write(*,*) 'Problem with IN file, please check line'
          write(*,*) xstr
          write(*,*) 'Comments should be indicated by an asterisk (*)'
          error = .True.
       end if
       icode = 1
    end if

1000 continue

  end subroutine string_to_int