subroutine aptatob (asrce, isrce, nchar, idigita, ndigitm, nerr)

ccbeg.
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c                             SUBROUTINE APTATOB
c
c     call aptatob (asrce, isrce, nchar, idigita, ndigitm, nerr)
c
c     Version:  aptatob  Updated    2005 August 22 16:20.
c               aptatob  Originated 2005 June 10 13:40.
c
c     Author:   Arthur L. Edwards, LLNL, L -298, Telephone (925) 422-4123.
c
c
c     Purpose:  To separate the character string in asrce, containing only the
c               digits 0-9, starting at character position isrce, with length
c               nchar, into array idigita with one digit per machine word, and
c               maximum length ndigitm.
c
c     Input:    asrce, isrce, nchar, ndigitm.
c
c     Output:   idigita, nerr.
c
c     Glossary:
c
c     asrce     Input    A character string containing only the digits 0-9,
c                          with at least isrce + nchar - 1 digits, counted from
c                          left to right, starting with 1.
c
c     idigita   Output   An array of ndigita single digits 0-9, one per machine
c                          word, with no leading zeros.  Memory space must be
c                          at least nchar.
c
c     isrce     Input    The character position in asrce at which the character
c                          string begins.  Must be positive.
c
c     nchar     Input    The number of digits in the character string to be put
c                          into array idigita.  Must be positive.
c
c     ndigitm   Input    The maximum length of idigita.
c
c     nerr      Output   Indicates an input error, if not zero.
c                          1 if isrce is not positive.
c                          2 if nchar is not positive.
c                          3 if asrce contains other than digits 0-9, in the
c                            part to be separated.
c                          4 if nchar exceeds ndigitm.
c
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
ccend.

c.... Dimensioned arguments.

      character*1   asrce(1)          ! Character string containing only digits.
      integer       idigita(1)        ! Array of single digits.

c.... Local variables.

      character*1 adig(0:9)           ! Array of ASCII digits.

      data adig / '0', '1', '2', '3', '4', '5', '6', '7', '8', '9' /

      integer     ibeg                ! Initial index in asrce.
      integer     iend                ! Final index in asrce.
      integer     n                   ! Current index in asrce.
      integer     nn                  ! Index in array adig.
      integer     nnn                 ! Index in array idigita.
      integer     nx                  ! Index in array idigita.

cbugc***DEBUG begins.
cbug      character*1 adit
cbug 9901 format (/ 'aptatob translating ASCII digit string to integer',
cbug     &  ' array.' /
cbug     &  '  isrce=',i6,'  nchar=',i3 )
cbug 9902 format ('  asrce = ',64a1)
cbug      adit = '"'
cbug      ibeg = isrce
cbug      iend = isrce + nchar - 1
cbug      write ( 3, 9901) isrce, nchar
cbug      write ( 3, 9902) adit, (asrce(i), i = ibeg, iend), adit
cbugc***DEBUG ends.

c.... Initialize.

      nerr = 0

c.... Test for input errors.

      if (isrce .le. 0) then
        nerr = 1
        go to 210
      endif

      if (nchar .le. 0) then
        nerr = 2
        go to 210
      endif

      ibeg = isrce
      iend = isrce + nchar - 1

      do 100 n = ibeg, iend           ! Loop over source characters.
        do nn = 0, 9                  ! Loop over allowed digits.
          if (asrce(n) .eq. adig(nn)) then
            go to 100
          endif
        enddo                         ! End of loop over allowed digits.
        nerr = 3                      ! Unidentifiable character found.
        go to 210
  100 continue                        ! End of loop over source characters.

      if (nchar .gt. ndigitm) then
        nerr = 4
        go to 210
      endif

c.... Initialize.

      do nx = 1, nchar
        idigita(nx) = 0
      enddo

c.... Identify digits in asrce, store in idigita.

      do 110 n = ibeg, iend           ! Loop over source characters.
        nnn = n - isrce + 1
        do nn = 0, 9                  ! Loop over allowed digits.
          if (asrce(n) .eq. adig(nn)) then
            idigita(nnn) = nn
            go to 110
          endif
        enddo                         ! End of loop over allowed digits.
  110 continue                        ! End of loop over source characters.

  210 continue
cbugc***DEBUG begins.
cbug 9903 format (/ 'aptatob results.  nerr=',i3 )
cbug 9904 format ('  idigita =',6(1x,10i1))
cbug      write ( 3, 9903) nerr
cbug      write ( 3, 9904) (idigita(n), n = 1, nchar)
cbugc***DEBUG ends.
      return

c.... End of subroutine aptatob.      (+1 line.)
      end

UCRL-WEB-209832