subroutine aptbrev (idiga, ndiga, nerr)

ccbeg.
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c                             SUBROUTINE APTBREV
c
c     call aptbrev (idiga, ndiga, nerr)
c
c     Version:  aptbrev  Updated    2006 May 12 13:40.
c               aptbrev  Originated 2005 May 20 14:00.
c
c     Author:   Arthur L. Edwards, LLNL, L-298, Telephone (925) 422-4123.
c
c
c     Purpose:  To reverse the order of the integer array idiga, of length
c               ndiga, if ndiga is 2 or more.
c
c               Flag nerr indicates any input error.
c
c               See aptdtob, aptbadd, aptbsub, aptbmul, aptbdiv, aptbpow,
c               aptbrtn, aptbfac.
c
c     Input:    idiga.
c
c     Output:   idiga, nerr.
c
c     Glossary:
c
c     idiga     In/Out   An integer array of length ndiga, to be reversed.
c
c     ndiga     Input    The length of integer array idiga.
c
c     nerr      Output   Indicates an input error, if not zero.
c                          1 if ndiga is negative.
c
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
ccend.

c.... Dimensioned arguments.

      integer idiga(1)

c.... Local variables.

      integer idigx
      integer n
      integer nmid

cbugc***DEBUG begins.
cbug 9901 format (/ 'aptbrev reversing the integer array idiga,',
cbug     &  ' of length ndiga =',i7,'.')
cbug 9902 format ('  a    n =',i7,', idiga =',i7,'.')
cbug      write ( 3, 9901) ndiga
cbug      write ( 3, 9902) (n, idiga(n), n = 1, ndiga)
cbugc***DEBUG ends.

c.... Test for input errors.

      nerr = 0

      if (ndiga .lt. 0) then
        nerr = 1
        go to 210
      elseif (ndiga .lt. 2) then
        go to 210
      endif

c.... Reverse the order of array idiga.

      nmid = ndiga / 2
      do n = 1, nmid
        nrev        = ndiga - n + 1
        idigx       = idiga(n)
        idiga(n)    = idiga(nrev)
        idiga(nrev) = idigx
      enddo

  210 continue

      if (nerr .ne. 0) then
        ndiga = 0
        idiga(1) = -999999
      endif
cbugc***DEBUG begins.
cbug 9911 format (/ 'aptbrev results:  nerr=',i2,'.')
cbug      write ( 3, 9911) nerr
cbug      write ( 3, 9902) (n, idiga(n), n = 1, ndiga)
cbugc***DEBUG ends.
      return

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

UCRL-WEB-209832