Subroutine tkpmar (kapo)
c *** see RH Landau, Program lpott, 1981
      Implicit  Real*8   (a-h,o-z)
      Complex*16 f,finvrs
      Real*8 kapo,kap0,mpi,mn
      Dimension a(60), b(36), l(12), c(12)
      Common /sec2/ bnuc(20),bn(16),bnucf(20),bnf(16),t(14),tx(14),hbarc
     1,pi,mpi,mn,nz,nes,nwaves,nifty(20),na
c     this Subroutine computes the scattering amplitudes
c     in scattering of kaons by nuclei
c
c        are the parameters in the order s11 1,2/,p11/34/,
c     p13(56),s01( 7 8),p01(9 10),p03(11 12),
c     d13(13 14),d15(15 16),f15(17 18),
c     d03(19 20) ,d05 (21 22),f05(23 24)
c     data for l=0 for s; l=1 for p etc. is samer order as
c     a and b
c
      data a/-4.411,8.227,-4.684,-5.622,6.058,
     1-88.99,6.348,-17.96,385.4,-322.2,
     2131.8,922.5,-3706.,4308.,-1656.,
     3-40.44,105.6,-109.2,49.15,-7.685,
     432.79,-93.22,138.0,-141.2,78.04,
     5-148.8,736.8,-2391.,3150.,-1379.,
     6-16730.,49640.,-51600.,18330.,0.0,
     7-16480.,31200.,-11030.,-3861.,0.0,
     8-86130.,116900.,-34300.,0.0,0.0,
     9946.9,1145.,-6468.,4631.,0.0,
     a-8333.,33490.,-46810.,21000.,0.0,
     b100800.,-205900.,106000.,0.0,0.0/
      data b/0.04681,0.4275,0.04227,
     12.141,1.010,-2.463,
     20.02872,6.975,-5.452,
     3-0.4951,0.3532,0.3254,
     4-0.4178,1.526,-0.4097,
     53.956,-19.11,16.87,
     61.400,-.9053,0.0,
     713.08,-10.32,0.0,
     8.4692,-5.670,0.0,
     9.5173,1.623,0.0,
     a4.282,-.4003,.0,
     b1.788,.002683,0.0/,nint/0/
      data l/0,1,1,0,1,1,2,2,3,2,2,3/
      kap0 = kapo
      If (nint.ne.0) GoTo 10
c     first time initialize
      nint = 1
      pz1 = (938.9264/139.576)**2
      pz2 = (493.668/139.576)**2
      t(13) = 0.
      t(14) = 0.
      tx(13) = 0.
      tx(14) = 0.
      pz7 = 4*(3.14159**2)*(139.576**2)
      n = 5
      qmax = 727.0377158237/139.576
      qin = 310.551636821/139.576
      r3 = qmax-qin
      m = 3
 10   q = kapo/139.576
      jm = 0
      jn = 0
      If (q.gt.qmax) q = qmax
c     this loop  computes the amplitudes corresponding
c     to the order:s11,p11,p13,s01,p01,p03,d13
c     d15,f15,d03,d05,f05
      enucl = Sqrt((q**2)+pz1)
      ekaon = Sqrt((q**2)+pz2)
      e = -(ekaon+enucl)/((ekaon*enucl)*pz7*q)
      Do 20 i=1,12
         c(i) = (q**((2*l(i)+1)))/(1.+(q/qin)**(2*l(i)+1))
 20   Continue
c     the next loop computes the sum in eq 2.11
      r5 = q-(qin)
      r4 = r5/r3
      Do 50 i=1,12
         sumn = 0.
         Do 30 n1=1,n
            n2 = n1+jn
            n3 = n1-1
            sumn1 = (a(n2))*((q/(qmax))**n3)
            sumn = sumn+sumn1
 30      Continue
         jn = jn+5
         r = 0.
         Do 40 m1=1,m
            m2 = m1+jm
            r1 = ((r4)**m1)*(b(m2))
            r = r+r1
 40      Continue
c     last loop computes r in eq.2.13
c     next index exhausts all values for the b s
         jm = jm+3
         finrl = sumn/c(i)
c     to use the theta function
         finvim = -1.
         If (q.gt.qin) finvim = -(1.+(r**2))
         finvrs = cmplx(finrl,finvim)
c     f from formula 2.11
         f = 1./finvrs
         tre = dReal(f)
         tim = dimag(f)
         t(i) = tre*e
         tx(i) = tim*e
 50   Continue
      Call kmixup (bn,bnf,t,tx)
      Return
      End