      SUBROUTINE TKPMAR (KAPO)
C *** SEE R H 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) GO TO 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
