      SUBROUTINE TNUC (jj1,jj2,KP,K,K0,XMN)
C *** SEE R H 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/
      IF (NIFTY(8).EQ.0.OR.NIFTY(8).EQ.2) GO TO 10
      IF (NIFTY(8).EQ. 4) GO TO 10
      IF (NFOLD.EQ.0) GO TO 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) GO TO 20
C     INTIALIZE
      NOPTM = 1
      NCOSS = 6
      CALL GAUSS (NCOSS,012,-1.d0,1.d0,COSK,WTCOS)
      IF (NIFTY(6).NE.3) GO TO 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) GO TO 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
