      Subroutine tkcm (kapo)
c *** see RH Landau, Program lpott, 1981
c     Subroutine to calculate and store kn amplitudes
c     author. Manuel Paez
c     see tkpmar for eigenchannel code, same partial wave code as pions
      Implicit Real*8(a-h,i,k,m,o-z)
      Dimension nifty(20), d(14,100), eta(14,100), kap(100), t(14), tx
     1(14), bn(16), bnuc(20), rewave(14,100), imwave(14,100), bnf(16),
     2 bnucf(20)
      Common /sec2/ bnuc,bn,bnucf,bnf,t,tx,hbarc,pi,mpi,mn,nz,nes,nwaves
     1,nifty,na
      Common /nlspfl/ gin(14,100),kapg(100),denom(14,25),ecmden(25),fmn,
     1rewave,imwave,kap,nkapgs,necms
ccc   Equivalence (rewave(1,1),d(1,1)), (imwave(1,1),eta(1,1))
c
      data ndata/1/
      kap0 = kapo
      If (kapo.le.-100.) ndata = 1
      kapo = abs(kapo)
ccc   If (nifty(8).lt.2) GoTo 90
      If (nifty(8).eq.4) GoTo 90
      If (ndata.eq.0) GoTo 90
c     set up table of t matrices 73 energies from 0 to qmax=730mev/c
      nes = 73
      qmax = 730.
      kaph = qmax/nes
c       use watts phases,only good for pl gt 700
c       yet,only store starting at 700-so will use
c     intialize
      nes = 13
      nwaves = 14
      kaph = 50
      Rewind 1
      rhl = 4*pi*pi
      Write (6,160) nes,nwaves
      kappa = 0.
      Rewind 3
      Write (3,190) nes
c     Do loop over tabulates momemta, use tknm for t
      Do 50 nkap=1,nes
         If (nkap.gt.12.and.nifty(8).ne.5) GoTo 10
         kappa = kaph*nkap
         If (nkap.eq.1) kappa = 1.
         kap(nkap) = kappa
         Call tkpmar (kappa)
         GoTo 30
c     Read in phases from cards,now sep for watts
 10      Read (1,150) kap(nkap),(eta(nwave,nkap),d(nwave,nkap),nwave=1,
     1   nwaves)
         Write (6,170) kap(nkap),(eta(nwave,nkap),d(nwave,nkap),nwave=1,
     1   nwaves)
         kk = kap(nkap)
         kappa = kk
         epikap = Sqrt(mpi*mpi+kk*kk)
         enkap = Sqrt(mn*mn+kk*kk)
         ftot = -(epikap+enkap)/rhl/epikap/enkap
         factor = ftot/kk
         Do 20 nwave=1,nwaves
            et = eta(nwave,nkap)
            dd = d(nwave,nkap)*pi/180.
            t(nwave) = 0.5*et*sin(2.*dd)*factor
            tx(nwave) = 0.5*(1.-et*cos(2.*dd))*factor
 20      Continue
 30      Do 40 nwave=1,nwaves
            rewave(nwave,nkap) = t(nwave)
            imwave(nwave,nkap) = tx(nwave)
 40      Continue
c     store t s on unit 3,fold latter.
         Write (3,180) kappa,(t(nwave),tx(nwave),nwave=1,14)
 50   Continue
      Rewind 3
c     tabulation Done, print out interpolates If needed
      Write (6,190) nes,nwaves
      Write (6,210) (kap(ne),(rewave(nwave,ne),imwave(nwave,ne),nwave=1,
     114),ne=1,nes)
      Do 80 ne=1,nes
         Do 60 nwave=1,14
            t(nwave) = rewave(nwave,ne)
            tx(nwave) = imwave(nwave,ne)
 60      Continue
c     form partial wave decomp of k+p,k+n amplitudes
         Call kmixup (bn,bnf,t,tx)
c     temp sorteage for print out
         Do 70 nwave=1,14
            d(nwave,ne) = bn(nwave)
            If (nwave.le.12) eta(nwave+2,ne) = bnf(nwave+4)
 70      Continue
         eta(1,ne) = bn(15)
         eta(2,ne) = bn(16)
 80   Continue
      rhl1 = 0.
      Write (6,220)
      Write (6,230) (kap(ne),(d(nwave,ne),nwave=1,13,2),eta(1,ne),(d
     1(nwav,ne),nwav=2,14,2),eta(2,ne),ne=1,nes)
      Write (6,240)
      Write (6,230) (kap(ne),rhl1,rhl1,(eta(nwave,ne),nwave=3,13,2),rhl1
     1,rhl1,(eta(nwav,ne),nwav=4,14,2),ne=1,nes)
 90   kappa = kapo
      If (ndata.eq.0) GoTo 100
      ndata = 0
      If (nifty(8).eq.4) GoTo 110
c     amplitudes all stored, interpolate on kappa, using 2 point
c     lagra. amplitudes all stored on 3, Read back
      Read (3,190) nstore
      Read (3,180) (kap(ne),(rewave(nwave,ne),imwave(nwave,ne),nwave=1,
     114),ne=1,nstore)
      Rewind 3
      If (nes.le.nstore) GoTo 100
      Write (6,200) nstore
      nes = nstore
 100  Continue
      If(nifty(8).eq.4)GoTo 110
      x = kappa
c       If kap lt kap(1) ,interp will use first value
      If (kappa.le.kap(1)) GoTo 120
      If (kappa.gt.kap(nes)) x = kap(nes)
      If (kappa.gt.kap(1)) GoTo 120
c     kappa lt 1st tabulated,or nifty(8)=4,use formula
 110  Call tkpmar (kappa)
      Call kmixup (bn,bnf,t,tx)
      Return
c     here t and tx refer to interpolates values of rewave and imwave
 120  Call lagrng (x,kap,t,rewave,nes,14,2,100,14)
      Call lagrng (x,kap,tx,imwave,nes,14,2,100,14)
c     check for setting 2 body ampltds =0
      If ((nifty(7).ne.1).and.(nifty(7).ne.2)) GoTo 140
c     nif(7)=1,set p,d,f=0   nif(7)=2, set d,f=0
      ni = 5
      If (nifty(7).eq.2) ni = 9
      Do 130 nl=ni,16
         bn(nl) = 0.
         bnf(nl) = 0.
 130  Continue
      Return
 140  Call kmixup (bn,bnf,t,tx)
      Return
c     -----formats
c
 150  format (13f6.1/8f6.1/8f6.1)
 160  format (51h0 calculation of kaon- nucleon amplitudes from Read,
     1 23h in phases ,nes,nwaves=,2i10//)
 170  format (1h ,13f8.2/8f8.2/8f8.2)
 180  format (7e11.4/6e11.4/6e11.4/6e11.4/4e11.4)
 190  format (2i5)
 200  format (23h ********nes.gt.nstore=,i5,20hnes set =nstore*****,//)
 210  format (5h kap=,f10.2,10e11.4/14x,10e11.4/14x,8e11.4)
 220  format (1x,'separate k*+ proton and neutron partial wave,
     1  ---non-flip --- t matrices at c.m. momentum kap'/1x,
     2  '1st line Real parts,second line imag'/1x,
     3  'kap swave p swave n pwave p pwave n,
     4   dwave p dwave n fwafe p fwave n   '//)
 230  format (f8.2,10x,8e12.4,/18x,8e12.4)
 240  format (1x,'separate k*+ proton and neutron partial wave,
     1   ---spin-flip ---(t matrices at c.m. momentum kap'/1x,
     2   '1st line Real parts,second line imag'/1x,
     3   'kap swave p swave n pwave p pwave n,
     4   dwave p dwave n fwafe p fwave n   '//)
      End
