      SUBROUTINE TNOFF (jj1,jj2,KAPPAP,KAPPA,EKAP0,KP,K,CTHNUC)
C *** SEE R H LANDAU, PROGRAM LPOTT, 1981
C     SUBROUTINE TNOFF(K*,K,K0) CALCULATES THE OFF-SHELL PI-N AMPLITUDE
C     IN PI-N C.M. FROM ON SHELL AMPLTD-CALC WITH TPICM
C     TLPT(KP,K,KO) = TCL(LT) *G*GP/GO2/2/PI/PI...N.B.2PI2
C         THIS SUB ALSO FOLDS THE T*S (ALL ENERGIES AT ONCE) AND RE-STOR
C
C     NIFTY(4)= 0 SIG=1, CONSTANT OFF-SHELL WITH ON SHELL VALUS
C          1 NLSP FORM OFF SHELL
C          6 LOCAL LAPLACIAN FORM ,GENRLZED TO D $ F WAVES
C     NIFTY(8)=   0, NO FERMI FOLDING
C                 =1, FERMI SMEAR(FOLDING) INPUT T MATRICES
C
C       NEGATIVE KE CAN BE HANDLED,BUT ONLY FOR NLSP CASE
      IMPLICIT REAL*8(A-H,I,K,M,O-Z)
      INTEGER IX
      COMPLEX*16 ZI,ZSIG(14),NSIG(14),DDINV
      DIMENSION NIFTY(20), BNUC(20), BNUCF(20), BN(16), BNF(16), RETIJ
     1(14), IMTIJ(14), RT(14), IT(14), GIN(14,100), G(14), KAPG(100),
     2 DENOM(14,25), ECMDEN(25), SIGL(14)
      COMMON /SEC2/ BNUC,BN,BNUCF,BNF,RETIJ,IMTIJ,HBARC,PI,MPI,MN,NZ,NES
     1,NWAVES,NIFTY,NA
      COMMON /NLSPFL/ GIN,KAPG,DENOM,ECMDEN,FMN,REW(14,100),AIMW(14,100)
     1,AKAPD(100),NKAPGS,NECMS
      COMMON /ENPAUL/ PF,AK,AKD,CSKKD,XI,E,XON
      COMMON /ENQAV/ XIP
	common /twob/ t2body(17,17,2,14)
C
      DATA SIGL/2*1.,3*-1.,1.,-1.,1.,5*-1.,1./,IX/0/
      IF (IX.NE.0) GO TO 10
C     INTIALIZE
      IX = 1
      MNPI = MN+MPI
      MNPI2 = MNPI**2
      MNPI10 = MNPI+10.
      MNMPI2 = (MN-MPI)**2
      TWOPI2 = 2.*PI*PI
      HBARTH = 197.33
      PF = 150./HBARTH
      XI = MN/MNPI
      ZI = (0.,1.)
      KAPPA0 = 1.E-06
 10   CONTINUE
      IF (EKAP0.LT.MNPI10) GO TO 30
      S = EKAP0*EKAP0
      IF (S.NE.0.) KAPPA0 = SQRT((S-MNPI2)*(S-MNMPI2)/4./S)
 20   CALL TNCM (KAPPA0)
      GO TO 70
C     NEGATIVE KE CASE,SET ZSIG=DENOM**-1
 30   IF (NIFTY(4).GT.1) GO TO 50
      IF (NIFTY(4).EQ.0) GO TO 60
      CALL LAGRNG (EKAP0,ECMDEN,G,DENOM,NECMS,14,2,25,14)
      DO 40 N=1,14
         ZSIG(N) = 0.
C     SET D&F OR MAYBE P WAVES =0
         IF((NIFTY(7).EQ.2.OR.NIFTY(7).EQ.5).AND.N.GT.6)G(N)=0.
         IF(NIFTY(7).EQ.1.AND.(N.NE.1.AND.N.NE.4))G(N)=0.
C     NO IMAG PART FOR DENOM IF SUBTHRESHOLD
C     T(LPT CONVENTION)=T(CORONIS-LANDAU)/TWOPI2
         IF (G(N).NE.0.) ZSIG(N) = SIGL(N)/G(N)/TWOPI2
 40   CONTINUE
      GO TO 110
 50   WRITE (6,330) EKAP0
      STOP
C      SPECIAL G=CONST CASE,FOR E LT 0 SET KAPPA0=EPSILON
 60   KAPPA0 = 0.000001
      GO TO 20
C     T=G(K)*G(KP)/DENOM=TON*G(K)*G(KP)/G(KO)**2
 70   DO 80 N=1,14
         ZSIG(N) = RETIJ(N)+ZI*IMTIJ(N)
         RT(N) = RETIJ(N)
         IT(N) = IMTIJ(N)
 80   CONTINUE
C      WRITE OUT FOR PAULI
C     WRITE(6,991)(RT(N),IT(N),N=1,6)
C     991 FORMAT(" BEFORE PAULI,RT,IT=",20X,6E15.6)
C     992 FORMAT(" AFTER PAULI AND OFF-SHELL FACTOR,RT,IT=",6E15.6)
C     .END OF PAULI WRITE OUT
      N = NIFTY(4)+1
      GO TO (170,90,50,50,50,50,190,50,50,50), N
C     NLSP FORM
C     TON*2*PI*PI/G(KO)**2=1/DENOM
 90   CALL LAGRNG (KAPPA0,KAPG,G,GIN,NKAPGS,14,2,100,14)
      DO 100 N=1,14
         IF (G(N).NE.0.) ZSIG(N) = ZSIG(N)/(G(N)**2)
         IF (G(N).EQ.0.) ZSIG(N) = (0.,0.)
 100  CONTINUE
 110  CONTINUE
      IF(NIFTY(9) .EQ.0) GO TO 140
C     INCLUDE PAULI VIA THOMAS'S PROCEDURE
C     ZSIG=1/DENOM,WHERE T=G*G'/DENOM
C     NOW DENOM =DENOM+DDINV
      AK = K/HBARTH
      AKD = KP/HBARTH
      CSKKD = CTHNUC
      E = (EKAP0-MNPI)/HBARTH
      XON = -.000001
      IF (E.LE.0.) GO TO 120
C      USE THOMAS'S PROCEDURE FOR CONSISTANCY IN INTEGRAL PTS
      E = (KAPPA0**2/2./938.91+SQRT(137.3**2+KAPPA0**2)-137.3)/HBARTH
 120  IF (E.GT.0.) XON = KAPPA0/HBARTH
      DO 130 N=1,14
         IF (N.GT.6) GO TO 130
C     NB CHANGE TO RHLCODE FROM THOMAS S CRAZYCODE
         NCH = N
         CALL PAULI (DDINV,NCH)
         IF (ABS(ZSIG(N)).NE.0.) ZSIG(N) = 1/ZSIG(N)/TWOPI2
         IF ((KAPPAP.EQ.KAPPA).AND.(ABS(KAPPA-KAPPA0).LE.1.E-4)) WRITE
     1   (6,340) NCH,K,DDINV,ZSIG(N)
         ZSIG(N) = ZSIG(N)+DDINV
         IF (ABS(ZSIG(N)).NE.0.) ZSIG(N) = 1/ZSIG(N)/TWOPI2
 130  CONTINUE
C     MULT BY G(KP)
 140  CALL LAGRNG (KAPPAP,KAPG,G,GIN,NKAPGS,14,2,100,14)
C     SAVE G(P) NEEDED FOR P11 POLE REMOVAL
      IF (ABS(FMN).GE.1.E-04) TP11 = G(5)
      DO 150 N=1,14
         ZSIG(N) = ZSIG(N)*G(N)
 150  CONTINUE
C     MULT BY G(K)
      CALL LAGRNG (KAPPA,KAPG,G,GIN,NKAPGS,14,2,100,14)
C     CONSTRUCT TP11 FOR POLE REMOVAL
      IF (ABS(FMN).GE.1.E-04) TP11 = TP11*G(5)
      DO 160 N=1,14
         ZSIG(N) = ZSIG(N)*G(N)
  160  CONTINUE
      IF ((EKAP0.LT.MNPI10).OR.(ABS(FMN).LT.1.E-04)) GO TO 170
C     REMOVE RESIDUE OF P11 POLE IF ABOVE THRESHOLD
      TP11 = TP11*SIGL(5)/(EKAP0-MN)/FMN/TWOPI2
      ZSIG(5) = ZSIG(5)-TP11
C     TEMP PRINT OUT
C      WRITE (6,350) EKAP0,KAPPAP,ZSIG(5),TP11
 170  CONTINUE
C     CONSTANT OFF SHELL CASE,OR  DETERMINE RE AND IM PARTS OF T
      DO 180 N=1,14
         RT(N) = ZSIG(N)
         IT(N) = -ZI*ZSIG(N)
         RETIJ(N) = RT(N)
         IMTIJ(N) = IT(N)
 180  CONTINUE
c	store off-shell two_body t matrix
	do n = 1,14
	t2body(jj1,jj2,1,n) = rt(n)
	t2body(jj1,jj2,2,n) = it(n)
	enddo
C     FORM PARTIAL WAVE DECOM FROM CHANNELS
 190  CONTINUE
      CALL MIXUP (BN,BNF,RT,IT,NIFTY(1))
      DO 200 J=1,16
         IF (BN(2).EQ.0.) GO TO 210
         IF (ABS(BN(J)/BN(2)).LE.1.E-5) BN(J) = 0.
         IF (ABS(BNF(J)/BN(2)).LE.1.E-5) BNF(J) = 0.
 200  CONTINUE
 210  IF (NIFTY(4).EQ.6) GO TO 220
      RETURN
C     ------LOCAL LAPLACIAN TYPE FORM  FOR BOTH NEUTRON AND PROTONE DITR
 220  A = KAPPAP**2+KAPPA**2
      B = -2.*KAPPAP*KAPPA
      A0 = 2.*KAPPA0**2
      A2 = A*A
      B2 = B*B
      A02 = A0*A0
      RHL = B/A0
      RHL2 = RHL*RHL
      RHL3 = RHL2*RHL
C      S
      ZSIG(5) = BN(1)+ZI*BN(2)
      NSIG(5) = BN(3)+ZI*BN(4)
C      P
      ZSIG(2) = BN(5)+ZI*BN(6)
      NSIG(2) = BN(7)+ZI*BN(8)
C      D
      ZSIG(3) = BN(9)+ZI*BN(10)
      NSIG(3) = BN(11)+ZI*BN(12)
C     F
      ZSIG(4) = BN(13)+ZI*BN(14)
      NSIG(4) = BN(15)+ZI*BN(16)
C     SWAVE OFF SHELL
      IF ((BN(1).EQ.0.).AND.(BN(2).EQ.0.)) GO TO 230
      ZSIG(1) = 1.+(ZSIG(2)/ZSIG(5))*(A0-A)/A0+(1.5/A02)*(ZSIG(3)/ZSIG(5
     1))*(A2+B2/3.+2.*A02/3.-2.*A*A0)-2.5*(ZSIG(4)/ZSIG(5)/A0/A02)*(A2*A
     2+A*B2-.4*A02*A0+2.4*A02*A-3.*A0*A2-A0*B2)
      ZSIG(5) = ZSIG(5)*ZSIG(1)
      BN(1) = ZSIG(5)
      BN(2) = -ZI*ZSIG(5)
 230  IF ((BN(3).EQ.0.).AND.(BN(4).EQ.0.)) GO TO 240
      NSIG(1) = 1.+(NSIG(2)/NSIG(5))*(A0-A)/A0+(1.5/A02)*(NSIG(3)/NSIG(5
     1))*(A2+B2/3.+2.*A02/3.-2.*A*A0)-2.5*(NSIG(4)/NSIG(5)/A0/A02)*(A2*A
     2+A*B2-.4*A02*A0+2.4*A02*A-3.*A0*A2-A0*B2)
      NSIG(5) = NSIG(5)*NSIG(1)
      BN(3) = NSIG(5)
      BN(4) = -ZI*NSIG(5)
C     PWAVE
 240  IF ((BN(5).EQ.0.).AND.(BN(6).EQ.0.)) GO TO 250
      ZSIG(1) = -RHL*(1.+(ZSIG(4)/ZSIG(2)/2./A02)*(15.*A2+3.*B2+12.*A02-
     130.*A*A0)+3.*(ZSIG(3)/ZSIG(2)/A0)*(A0-A))
      ZSIG(2) = ZSIG(2)*ZSIG(1)
      BN(5) = ZSIG(2)
      BN(6) = -ZI*ZSIG(2)
C      D WAVE
 250  IF ((BN(7).EQ.0.).AND.(BN(8).EQ.0.)) GO TO 260
      NSIG(1) = -RHL*(1.+(NSIG(4)/NSIG(2)/2./A02)*(15.*A2+3.*B2+12.*A02-
     130.*A*A0)+3.*(NSIG(3)/NSIG(2)/A0)*(A0-A))
      NSIG(2) = NSIG(2)*NSIG(1)
      BN(7) = NSIG(2)
      BN(8) = -ZI*NSIG(2)
 260  IF ((BN(9).EQ.0.).AND.(BN(10).EQ.0.)) GO TO 270
      ZSIG(1) = RHL2*(1.+5.*(ZSIG(4)/ZSIG(3))*(1.-A/A0))
      ZSIG(3) = ZSIG(1)*ZSIG(3)
      BN(9) = ZSIG(3)
      BN(10) = -ZI*ZSIG(3)
 270  IF ((BN(11).EQ.0.).AND.(BN(12).EQ.0.)) GO TO 280
      NSIG(1) = RHL2*(1.+5.*(NSIG(4)/NSIG(3))*(1.-A/A0))
      NSIG(3) = NSIG(1)*NSIG(3)
      BN(11) = NSIG(3)
      BN(12) = -ZI*NSIG(3)
C     F WAVE
 280  BN(13) = -RHL3*BN(13)
      BN(14) = -RHL3*BN(14)
      BN(15) = -RHL3*BN(15)
      BN(16) = -RHL3*BN(16)
      IF (NIFTY(6).NE.3) GO TO 320
C     FLIP PARTS OFF SHELL WITH LAPLACIAN
C     USE DIFFERENT RELATNS THAN NONFLIP, SINCE USING PL PRIMES
C     PWAVE
      DO 290 J=5,8
         BNF(J) = BNF(J)+3.*BNF(J+4)+6.*BNF(J+8)-(3.*A/A0)*(BNF(J+4)+5.*
     1   BNF(J+8))+((15.*A2+3.*B2)/2./A02)*BNF(J+8)
 290  CONTINUE
C     DWAVE
      DO 300 J=9,12
         BNF(J) = (A*B*5./A02)*BNF(J+4)-(B/A0)*(BNF(J)+5.*BNF(J+4))+(B2/
     1   A02)*BNF(J+4)
 300  CONTINUE
C     F WAVE
      DO 310 J=13,16
         BNF(J) = (B2/A02)*BNF(J)
 310  CONTINUE
 320  RETURN
C
 330  FORMAT (43H //////////TNOFF CALLED FOR NEG KE,NON-NLSP,/7H EKAP0=,
     1E14.3)
 340  FORMAT (28H PAULI SUPP FOR NCH,K=KP=K0=,I2,F10.3,12H DDINV,DINV=,
     12E15.3)
 350  FORMAT (32H P11 POLE REMOVAL,E,KP,K,Z,TP11=,6E14.3)
      END
