c/* @(#)tmatrx.f	1.1      latest revision 6/23/89 14:55:21 */
      subroutine coulomb1(scoul, sigl, aovera, ld, nspin, lxmax)
**********************************************************************
********   This subroutine does the Coulomb phase matching. See Paper ***
********   Lu, Mefford, Landau and Song, Phys. Rev. C 50, 3037, (1994) **

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

      complex*16  zi , ztan
      complex*16  zr34 , zr56 , zrmix , ztjp, ztjm , ztj

      real*8      k0
      real*8      Mnuc , Mnuc2 , MN , Mp , Mp2

      dimension tr(12),ti(12)

      dimension   scoul(100)
      dimension   nifty(20)

      common /kinemt/   El , Ecm , k0, pl , s , Mp2 , Mnuc , Mnuc2
      common /params/   hbarc, pi, Mp, MN, nz, na, nes, nwaves
      common /switch/   nifty
      common /sizes/    achp, acmp, wsp, achn, acmn, wsn
      common /ranges/   rcoul, rcut

      common /Rcomn/    rr , ri , rrb , rib
      common /spins/    nspina , nspinb , nspinc , nspind , nspine
      common /Tcoul/    trc , tic, tr3c, ti3c, tr5c, ti5c, xgam
      common /Tcomn/    tr , ti 

***************************************************************************

      n = nspin
      zi = ( 0. , 1. )
      if (nifty(17).eq.1) aovera = 1.

c ***
c *** stapp convention with blatt-beidenharn phases
c *** rhl change to nspin coding,l-2 subtractn in thepp
c *** ztjp=alpha(j+1,j)=t+     ztjm=alpha(j-1,j)=t-   ztj= alpha**(j+1)
c ***
c *** rhl version,reordered see nspin code and thep sub for stapp convrson


c let run through phase mods with zero sigl
      if (nifty(10) .eq. 0) go to 300
      if (nifty(10) .lt. 3) go to 290
      if (n.ne.8) go to 300
c if nifty(10) eq 3 or 4 the do exact coulomb (either uniform sphere (=3)
c or realistic (=4)


c *** ---- --coulomb v included on poten
c *** determine phase shift by matching
c ***
c ***    determine tan delta(sl) from calculated t*s

c     change 9/90 ldmax = lxmax
      ldmax = lxmax
         jt = ld - 1
         jd = ld
***************** check this out ***********************************
         if(ld.lt.3) then
         if(ld.eq.1) then
c               (ldum = 1 case here)
         singr = tr(1)
         singi = ti(1)
         ljtab = 0
         call matchc2(tr(3),ti(3),tr(6),ti(6),tr(4),
     $     ti(4),tr(5),ti(5),jd,ldmax,aovera,xgam,ljtab)
         call matchc(singr,singi,tr(1),ti(1),ld,ldmax,aovera,
     $              xgam,scoul)
          tugr = tr(7)
          tugi = ti(7)
         call matchc(tugr,tugi,tr(7),ti(7),ld+1,ldmax,aovera,
     $              xgam,scoul)
         else
c             (ldum = 2 case here)   
         ljtab = 1
         call matchc2(tr(1),ti(1),tr(2),ti(2),tr(8),
     $      ti(8),tr(7),ti(7),jt,ldmax,aovera,xgam,ljtab)
         ljtab = 0
         call matchc2(tr(3),ti(3),tr(6),ti(6),tr(4),
     $     ti(4),tr(5),ti(5),jd,ldmax,aovera,xgam,ljtab)
         endif
         else
c            (General case here)
         ljtab = 1
         call matchc2(tr(1),ti(1),tr(2),ti(2),tr(8),
     $      ti(8),tr(7),ti(7),jt,ldmax,aovera,xgam,ljtab)
         ljtab = 0 
         call matchc2(tr(3),ti(3),tr(6),ti(6),tr(4),
     $     ti(4),tr(5),ti(5),jd,ldmax,aovera,xgam,ljtab)
         endif
************* ugly, huh? ******************************************
 290  continue
 300  continue

      RETURN

C *** formats

 1010 format (1h+,65x,4heta=,f10.4,8h  delta=,f10.4,'  sigl=',e14.6)
 1020 format (41h0********** eta greater than 1 **********,//)
 1030 format (1h ,15h  t(k,k,k)=    ,35x,4e14.7)
 1050 format (20x,40hcoulomb phase modified nuclear amplitude/16h   t(k,
     $k.k) =   ,4e14.7)
 3335 format(1h ,19h tr ti (nspin=3-6)=,8e13.5)

      end