      Subroutine tnuc (jj1,jj2,kp,k,k0,xmn)
c *** see RH Landau, Program lpott, 1981
c     Subroutine tnuc--kinematically transforms and maps t from pi-nucle
c     nucleus c.m.
c     bn is partial wave amplitude in pi-nucleon c.m.
c     bnuc is partial wave amplitude in pi-nucleus c.m.
c
c     nifty(5)=0, completely on shell kinematics
c              1, on shell angles, off shell tmatrix factor
c              2, off shell angles(apprx) and off shell t matrix facotr
c               3  off shell angles(exact) and off shell tmatrix factor
c                 5  e3b
c                 6 e3b with folding
c               7  e3b +aay magic vector for angles
c
c     k0 = on shell value of k         kp= kprime = final off-shell k
c     k = intial,possibly off shell, value of momentum
c     all these moment a in pi-nucleus c.m.
      Implicit Real*8 (a-h,i,k,m,o-z)
      Real*8 cosk(12),wtcos(12)
      Dimension nifty(20), bnuc(20), bnucf(20), bn(16), bnf(16), retij
     1(14), imtij(14), tofth(8)
      Common /sec2/ bnuc,bn,bnucf,bnf,retij,imtij,hbarc,pi,mpi,mn,nz,nes
     1,nwaves,nifty,na
c
      data noptm/0/,nfold/1/
ccc   If (nifty(8).eq.0.or.nifty(8).eq.2) GoTo 10
      If (nifty(8).eq.2) GoTo 10
      If (nifty(8).eq. 4) GoTo 10
      If (nfold.eq.0) GoTo 10
c     t matrices not yet folded,fold and store
      nifty(5) = 0
      nifty(2) = 0
      Write (6,90)
      nfold = 0
      Call tncm (k0)
      Call tfold
 10   Continue
c       card removed
c     spin dependent part, Done numerically
c     code for spin dependent a,mplitdis
c      (1) retp-no       (5) retp-spin
c     (2)  imtp-no spin          (6) imtp spin
c     (3)  retn-no spin          (7)  retnspin
c     (4)  imtn no spin          (8)  imtn- spnin
c     independent ampliutudses
c     optimal choice of momemtnum  and/or spin included
c     calculate patl wave decomp numerically
      If (noptm.eq.1) GoTo 20
c     intialize
      noptm = 1
      ncoss = 6
      Call Gauss (ncoss,012,-1.d0,1.d0,cosk,wtcos)
      If (nifty(6).ne.3) GoTo 20
      a1 = 5./12.
      a2 = 7./24.
 20   Continue
      Do 30 nl=1,20
         bnucf(nl) = 0.
         bnuc(nl) = 0.
 30   Continue
c     Do loop over costh
      Do 80 ncos=1,ncoss
         x = cosk(ncos)
         wt = wtcos(ncos)
         Call tnucth (jj1,jj2,kp,k,k0,x,tofth,xmn)
         pl2 = 1.5*x*x-0.5
         pl3 = 2.5*x**3-1.5*x
         pl4 = (35.*x**4-30.*x*x+3.)/8.
c     pl contiains (2l+1)/2 facor
         pl = 1.*0.5
         Do 50 j=1,17,4
            If (j.ge.5) pl = x*1.5
            If (j.ge.9) pl = pl2*2.5
            If (j.ge.13) pl = pl3*3.5
            If (j.ge.17) pl = pl4*4.5
            Do 40 jj=1,4
               ji = j+jj-1
               bnuc(ji) = bnuc(ji)+wt*tofth(jj)*pl
 40         Continue
 50      Continue
         If (nifty(6).ne.3) GoTo 80
         pl1 = 1.
         pl2 = 3.*x
         pl3 = 0.5*(15.*x*x-3.)
         pl4 = 0.5*(35.*x**3-15.*x)
c     n.b. plp cpntains (2l+1)/2l/l+1 factor
         plp = pl1*0.75
         wt = wt*Sqrt(1.-x*x)
         Do 70 j=5,17,4
            If (j.ge.9) plp = pl2*a1
            If (j.ge.13) plp = pl3*a2
            If (j.ge.17) plp = pl4*0.225
            Do 60 jj=1,4
               ji = j+jj-1
               bnucf(ji) = bnucf(ji)+wt*tofth(jj+4)*plp
 60         Continue
 70      Continue
 80   Continue
      Return
c
 90   format (43h parameters changed for folding,n(5)=n(2)=0/55h save t
     1matrics now folded and use again If want folded/)
      End
