c/* %W%      latest revision %G% %U% */
      subroutine PRAMPS (Tlab)
***********************************************************************

c *** Computes and prints out the elementary pn and pp amplitudes

      implicit real*8 (a-h, i, k, m, o-z)

      character*80   SCCSID

      complex*16  Ap,  An,  Bp,  Bn,  Cp,  Cn,  Dp,  Dn,  Ep,  En
      complex*16  A2p, A2n, B2p, B2n, C2p, C2n, D2p, D2n, E2p, E2n
      complex*16  zi
      dimension nifty(20)
CCC	increase dimensionality to include other off-diagonal
CCC	ra(7)--> ra(14); r(7)-->r(14) : pjd 4/4/93
c      dimension t(40), tx(40), ra(7), rax(7)
      dimension t(40), tx(40), ra(14), rax(14)
CCC
      dimension ApB(4), AmB(4), CpD(4), CmD(4), E(4)

      common /params/   hbarc, pi, xMp, xMN, nz, na, nes, nwaves
      common /switch/   nifty
      common /tjmats/   t, tx, ra, rax
      common /amplit/   Ap, An, Bp, Bn, Cp, Cn, Dp, Dn, Ep, En


c>>>> FIRST EXECUTABLE STATEMENT <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

      zi     = (0.0, 1.0)
      sr10   = sqrt(10.)
      Mn     = 938.9264
      Mp     = Mn
      cthnuc = 0.0

c *** Kinematics

      Ecm = sqrt(2. * Mn * (Tlab + 2. * Mn))
      s   = Ecm * Ecm
      k = sqrt((s - (Mn + Mp) * (Mn + Mp)) * (s - (Mn - Mp) * (Mn - Mp))
     $                                   /4./s)
      Epofk = sqrt(Mp * Mp + k * k)
      Enofk = sqrt(Mn * Mn + k * k)
      ftot  = -(Epofk + Enofk)/4./pi/pi/Epofk/Enofk
      factor = ftot/k
      fac3  = sr10 * 197.33/ftot

      call tncm (k)


c *** If phases are being read in won't need to repeat later
c     so set nifty(8) to 0 to prevent ***

      nifty(8) = 0

c *** Compute A, B, C, D, E of Bistricky, Lehar and Winternitz
c *** Journal de Physique 39, 1, 1978, eq. 2.14

      write(6,*) 'p-N Amplitudes from PNCRS 2.9'
      write(6,15) Ecm, k, epofk, ftot, factor
      write(6,*)
      write(6,141)
      write(6,*)

      do 11 n = 0,180
         rad = n * pi/180.
         x  = cos(rad)

         call damps (x, ApB, AmB, CpD, CmD, E)

****** tm 9/03/91 Amps write E amp that is used ******************
c        write(11,1969) n, E(1), E(2), E(3), E(4)
c1969    format(i4,4e12.4)
******************************************************************
         A2p = Ap * fac3
         A2n = An * fac3
         B2p = Bp * fac3
         B2n = Bn * fac3
         C2p = Cp * fac3
         C2n = Cn * fac3
         D2p = Dp * fac3
         D2n = Dn * fac3
         E2p = Ep * fac3
         E2n = En * fac3

c______________________________________________________________________________
c  Write out the real part of the amplitudes
c______________________________________________________________________________

         ReA2p = A2p
         ReA2n = A2n
         ReB2p = B2p
         ReB2n = B2n
         ReC2p = C2p
         ReC2n = C2n
         ReD2p = D2p
         ReD2n = D2n
         ReE2p = E2p
         ReE2n = E2n
         if( nifty(20) .eq. 1 .OR. nifty(20) .eq. 3 ) then
            write(6,210) n, ReA2p, ReA2n, ReB2p, ReB2n, ReC2p, ReC2n,
     $                      ReD2p, ReD2n, ReE2p, ReE2n
         endif

c______________________________________________________________________________
c  Now write out the imaginary part of the amplitudes
c______________________________________________________________________________

         ImA2p = -zi*(A2p)
         ImA2n = -zi*(A2n)
         ImB2p = -zi*(B2p)
         ImB2n = -zi*(B2n)
         ImC2p = -zi*(C2p)
         ImC2n = -zi*(C2n)
         ImD2p = -zi*(D2p)
         ImD2n = -zi*(D2n)
         ImE2p = -zi*(E2p)
         ImE2n = -zi*(E2n)
         if( nifty(20) .eq. 1 .OR. nifty(20) .eq. 3 ) then
            write(6,220) ImA2p, ImA2n, ImB2p, ImB2n, ImC2p, ImC2n,
     $                   ImD2p, ImD2n, ImE2p, ImE2n
         endif

 11   continue

      if( nifty(20) .eq. 1 .OR. nifty(20) .eq. 3 ) then
         write(6,230)
      endif
      return

c *** FORMATS **********************************************************

  15  format(' ','Ecm    = ', f13.5, ' MeV',/,
     $          ' k      = ', f13.5, ' MeV',/,
     $          ' Epofk  = ', f13.5, ' MeV',/,
     $          ' ftot   = ', e13.5, ' 1/MeV**2',/,
     $          ' factor = ', e13.5, ' 1/MeV**2'    )

 141  format(' ',' theta ',  5x, 'Ap', 10x, 'An', 10x, 'Bp', 10x, 'Bn',
     $                      10x, 'Cp', 10x, 'Cn', 10x, 'Dp', 10x, 'Dn',
     $                      10x, 'Ep', 10x, 'En')
 142  format(' ',' theta ',  5x, 'Fsp', 9x, 'Fsn', 9x, 'Fvp', 9x, 'Fvn',
     $                       9x, 'Ftp', 9x, 'Ftn', 9x, 'Fpp', 9x, 'Fpn',
     $                       9x, 'Fap', 9x, 'Fan')
 210  format(' ', i6, 10(e12.3))
 220  format(' ', 6x,   10(e12.3))
 230  format('1')
      end