      Subroutine tpirsl (kappa,ni,ddum,w,tr,ti)
c *** see RH Landau, Program lpott, 1981
c     calc of pin phases  and amplitudes with rowe,salomon,Landau
c     formula, or Landau s for higher l
      Implicit Real*8 (a-h,i,k,m,o-z)
      Dimension a(14), b(14), c(14), xx(14), w0(14), q0(14), gam(14)
c       use rowe,salomon,Landau for low e s,p,d13,d15;Landau for others
c
      data mpi,mn,pi,kold/139.578e+0,938.903,3.141593e+0,0./,
     1 a/-11.2,-2.91,11.4,16.8,-5.7,-1.31,11.2e-13,-3.15e-12,
     2 8.31e-18,5.46e-17,0.109,0.112,-38.26e-18,7.43e-18/,
     3 b/-30.7,3.45,-15.4,-35.4,25.4,1.22,-0.369e-14,0.118e-13,
     4 -0.363e-19,-0.236e-18,-0.031,-0.270,0.205e-18,-0.222e-19/,
     5 c/21.,-1.5,7.2,27.,-29.,-0.4,0.,0.,0.,0.,0.003,0.19,0.,0./,
     6 xx/.31,.22,.99,.44,.61,.23,0.,0.,0.,0.,.54,.43,0.,0./,
     7 w0/1655.,1850.,1233.,1550.,1435.,1815.,0.,0.,0.,0.,
     8 1525.,1670.,0.,0./,
     9 q0/550.,678.,228.,477.,393.,656.,0.,0.,0.,0.,459.,560.,0.,0./,
     a gam/170.,200.,116.,105.,230.,255.,0.,0.,0.,0.,125.,155.,0.,0./
      If (abs(kappa-kold).lt.1.e-03) GoTo 10
      kold = kappa
      rhl = kappa*kappa
      If (kappa.eq.0.) kappa = 1.e-10
      epikap = Sqrt(mpi*mpi+rhl)
      enkap = Sqrt(mn*mn+rhl)
      w = epikap+enkap
      s = w*w
      factor = (-1./kappa)*w/4./pi/pi/epikap/enkap
      q = kappa/mpi
      q2 = q*q
      q4 = q2*q2
c     determine l value for formula
 10   If ((ni.eq.1).or.(ni.eq.4)) l = 0
      If ((ni.eq.2).or.(ni.eq.3).or.(ni.eq.5).or.(ni.eq.6)) l = 1
      If ((ni.eq.7).or.(ni.eq.8).or.(ni.eq.11).or.(ni.eq.12)) l = 2
      If ((ni.eq.9).or.(ni.eq.10).or.(ni.eq.13).or.(ni.eq.14)) l = 3
      jj = 2*l+1
      If ((ni.eq.7).or.(ni.eq.8).or.(ni.eq.9).or.(ni.eq.10).or.(ni.eq.13
     1).or.(ni.eq.14)) GoTo 20
      rhl = q0(ni)/mpi
      del = (q**jj)*(a(ni)*1.e-2+b(ni)*q2*1.e-3+c(ni)*q4*1.e-4+xx(ni)*
     1gam(ni)*w0(ni)/(rhl**jj)/(w0(ni)*w0(ni)-s))
      ddum = atan(del)
      GoTo 30
c     no salomon fit, use old rhl fit
 20   ddum = (a(ni)+b(ni)*kappa)*(kappa**jj)*pi/180.
 30   tr = 0.5*factor*sin(2.*ddum)
      ti = 0.5*factor*(1.-cos(2.*ddum))
      Return
      End
