c/* @(#)matchc.f	1.1      latest revision 6/23/89 14:48:52 */
c # Lu, 7/16/91, changed this sub  for direct matching of t matrix.
      subroutine matchc(tr,ti,trc,tic,ldum,ldmax,aovera,xgam,scoul)
      implicit real*8  (a-h,o-y)
      implicit complex*16 (z)
	  real*8 k0
	  real*8 Mnuc, Mnuc2, MN, Mp, Mp2
      real*8 fc(100),fcp(100),gc(100),gcp(100),scoul(100)
      real*8 fc0(100),fcp0(100),gc0(100),gcp0(100)
c     8/22/90 El, etc. hbarc, etc. defined in common
	  common /kinemt/   El, Ecm, k0, pl, s, Mp2, Mnuc, Mnuc2
	  common /params/   hbarc, pi, Mp, MN, nz, na, nes, nwaves
      common /ranges/   rcoul, rcut
c     ---- --coulomb v included on poten
c     determine complex on-shell tmatrix by matching
            zi = (0., 1.)
c      reset coul functions
            eta = 0.
            rhoc = k0*rcut/hbarc
            lcmax = ldmax
            if (lcmax.le.1) lcmax = 2
            accur = 1.e-14
            step = 999
            nminl = 0
            call rcwfn (rhoc,eta,nminl,lcmax,fc0,fcp0,gc0,gcp0,accur,
     1      step)
c     correction of coulomb for a/(a-1)factor in kmt prescription
            eta = xgam/aovera
            call rcwfn (rhoc,eta,nminl,lcmax,fc,fcp,gc,gcp,accur,step)
	ld = ldum
		    zh0  = cmplx( gc0(ld),  fc0(ld) )
		    zh0p = cmplx( gcp0(ld), fcp0(ld) )
		    zh   = cmplx( gc(ld),   fc(ld) )
		    zhp  = cmplx( gcp(ld),  fcp(ld) )
	ztshort = cmplx( tr, ti )
            zron1 = fcp(ld) * zh0     - zh0p * fc(ld)
            zron2 = fcp(ld) * fc0(ld) - fcp0(ld) * fc(ld)
            zron3 = fcp0(ld) * zh     - zhp * fc0(ld)
            zron4 = zh0p * zh         - zhp * zh0
          ztmatch = (ztshort * zron1 + zron2)/(zron3 + ztshort * zron4)
            trc = dreal(ztmatch)
            tic = dimag(ztmatch)
	return
      end

