subroutine aptsuba (astem, lstem, asub, lsub, nchar,
     &              asink, lsink, nerr)

ccbeg.
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c                             SUBROUTINE APTSUBA
c
c     call aptsuba (astem, lstem, asub, lsub, nchar,
c                   asink, lsink, nerr)
c
c     Version:  aptsuba  Updated    2004 January 23 13:30.
c               aptsuba  Originated 2004 January 23 13:30.
c
c     Authors:  Arthur L. Edwards, LLNL, L-298, Telephone (925) 422-4123.
c
c
c     Purpose:  To store a string astem of length lstem, and if lsub is
c               positive, a left parenthesis "(", a string asub of length
c               lsub, and a right parenthesis ")", totaling
c               lsink = lstem + lsub + 2 characters, in string asink
c               of length nchar, and right-fill with blanks.
c               Flag nerr indicates any input error.
c
c     Input:    astem, lstem, asub, lsub, nchar.
c
c     Output:   asink, lsink, nerr.
c
c     Calls: aptchmv (in ~/work/apt/src on gps01, toofast18llnlgov) 
c
c     Glossary:
c
c     asink     Output   A character string of type character, with a length of
c                          at least nchar > 0.
c
c     astem     Input    A character string of type character, with a length of
c                          at least lstem > 0.
c
c     asub      Input    A character string of type character, with a length of
c                          at least lsub => 0.
c
c     lsink     Output   The number of characters moved into asink, starting at
c                          the first (leftmost) character.
c                          If lsub = 0, lsink = lstem.
c                          If lsub > 0, lsink = lstem + lsub + 2.
c                          Any remaining characters to the right will be filled
c                          with blanks.
c
c     lstem     Input    The number of characters in astem to be moved into
c                          asink, starting at the first (leftmost) character
c                          of asink.  Must be positive.
c
c     lsub      Input    The number of characters in string asub to be moved
c                          into asink, after astem and, if lsub is positive,
c                          after a left parenthesis "(", and followed by a
c                          right parenthesis ")".  Must not be negative.
c
c     nchar     Input    The number of characters in the string asink.
c
c     nerr      Output   Indicates an input error, if not zero:
c                          1 if lstem is not positive.
c                          2 if lsub is negative.
c                          3 if nchar is not at least lstem + lsub + 2.
c
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
ccend.

c.... Declarations for arguments.

      dimension astem   (1)           ! First string to be stored in asink.
      character*1  astem              ! First string to be stored in asink.

      dimension asub   (1)           ! Third string to be stored in asink.
      character*1  asub              ! Third string to be stored in asink.

      dimension asink   (1)           ! String with astem, "(", asink, ")".
      character*1  asink              ! String with astem, "(", asink, ")".

c.... Local variables.

      character*1  apar1              ! A left parenthesis.
      character*1  apar2              ! A right parenthesis.

cbugc***DEBUG begins.
cbug      character*1  aquote             ! A quotation mark.
cbug      aquote = '"'
cbug 9901 format (/ 'aptsuba storing astem and asub,' /
cbug     &          'with lengths lstem =',i4,', lsub =',i4, /
cbug     &          'into asink, with length nchar =',i4,'.' )
cbug 9902 format ('astem = ',72a1)
cbug 9903 format ('asub = ',72a1)
cbug      write ( 3, 9901) lstem, lsub, nchar
cbug      write ( 3, 9902) aquote, (astem(n), n = 1, lstem), aquote
cbug      write ( 3, 9903) aquote, (asub(n), n = 1, lsub), aquote
cbugc***DEBUG ends.

c.... Initialize.

      apar1 = "("
      apar2 = ")"

c.... Fill asink with blanks.

      if (nchar .gt. 0) then
        do 110 n = 1, nchar
          asink(n) = ' '
  110   continue
      endif

c.... Test for input errors.

      nerr  = 0
      lsink = 0

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

      if (lsub .lt. 0) then
        nerr = 2
        go to 210
      endif

      if (lsub .gt. 0) then
        lsink = lstem + lsub + 2
      else
        lsink = lstem
      endif

      if (nchar .lt. lsink) then
        nerr = 3
        go to 210
      endif

c.... Put astem into asink.

      iput = 1

      call aptchmv (astem, 1, lstem, asink, iput, nerr)

      iput = iput + lstem

      if (lsub .eq. 0) go to 210

      call aptchmv (apar1, 1, 1, asink, iput, nerr)

      iput = iput + 1

      call aptchmv (asub, 1, lsub, asink, iput, nerr)

      iput = iput + lsub

      call aptchmv (apar2, 1, 1, asink, iput, nerr)

  210 continue
cbugc***DEBUG begins.
cbug 9904 format (/ 'aptsuba results:  nerr =',i2,', lsink =',i5)
cbug 9905 format ('asink = ',72a1)
cbug      write ( 3, 9904) nerr, lsink
cbug      write ( 3, 9905) aquote, (asink(n), n = 1, lsink), aquote
cbugc***DEBUG ends.

      return

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

UCRL-WEB-209832