c/* %W% latest revision %G% %U% */ c/* Revised version (pjd) March 93 for choice of graz, f-ratios c/* and pest off-shell via nifty(12) = 0, 1 and 2 respectively c/* Revision began: 26/03/93 c/* Last revsion : 06/04/93 c/* subroutine TNOFF2 (kappap, kappa, ekap0, kp, k, costh) ************************************************************************ c *** See R.H. Landau's program LPOTT, 1981 c *** c *** Calculates the off-shell p-N amplitudes in the p-N center of c *** momentum frame from the on-shell amplitudes obtained from TNCM c *** tlpt(kp,k,ko) = tcl(lt) *g*gp/go2/2/pi/pi...n.b.2pi2 c c *** negative ke can be handled,but only for nlsp case c *** this subroutine was extended to include proton or c *** neutron scattering. implicit real*8 (a-h, i, k, m, o-z) integer ix CCC for both off-diagonal components complex*16 zi, zsig(40), zsig2(14) c complex*16 zi, zsig(40), zsig2(7) complex*16 zsigll,zsigllp,zsiglpl,zsiglplp CCC dimension nifty(20) dimension bnuc(40), bnucf(40), bn(40), bnf(40) dimension retij(40), imtij(40) CCC Consider both off-diagonal components (pjd 4/4/93) dimension Ret(40), Imt(40), Retmix(14), Imtmix(14) c dimension Ret(40), Imt(40), Retmix(7), Imtmix(7) CCC g(40) --> g(54) pjd 26/3/93 dimension g(54), gg(14) dimension g1(54) CCC dimension g(40), gg(7) dimension tapb(4), tamb(4), tcpd(4), tcmd(4), tel(4) common /bandt/ bnuc, bn, bnucf, bnf, retij, imtij common /params/ hbarc, pi, mpi, mn, nz, na, nes, nwaves common /switch/ nifty common /tjmats/ Ret, Imt, Retmix, Imtmix common /Tmats/ tapb, tamb, tcpd, tcmd, tel c *** data ix /0/ c >>> FIRST EXECUTABLE STATEMENT <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< c if (ix .ne. 0 .AND. nifty(1) .ne. 9) go to 10 c *** Initialize ix = 1 mnpi = mn + mpi mnpi2 = mnpi**2 mnpi10 = mnpi + 0.5 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 12 IF (s .ne. 0.) kappa0 = SQRT( (s - mnpi2)*(s - mnmpi2)/4./s ) call TNCM (kappa0) go to 70 c *** Negative ke case, set zsig = denom**-1 30 continue c *** Redefine on shell kappao s = mnpi10**2 go to 12 c *** t = ton * g(k) * g(kp)/g(ko)**2 70 do 80 n = 1,32 zsig(n) = retij(n) + zi * imtij(n) 80 continue c *** for Retmix and Imtmix (see TNCM) do 85 n = 1,14 CCC do 85 n = 1,7 zsig2(n) = Retmix(n) + zi * Imtmix(n) 85 continue c *** nlsp form c *** ton * 2 * pi * pi/g(ko)**2 = 1/denom CCC added pjd 26/3/93. For GRAZ nifty(12) = 0 CCC f-ratios = 1 CCC Pest = 2 IF(nifty(12).eq.0) THEN CCC if(kappa0.eq.1.e-06) write(7,*) 'More than once bad.' call GRAZPT (kappa0, g) do 100 n = 1,32 c ************ 10/01/90 tm warning ******* if (g(n).eq.0.) write(6,*) '** warning g(n)= 0 in tnoff' if (g(n).ne.0.) zsig(n) = zsig(n)/(g(n)**2) if (g(n).eq.0.) zsig(n) = (0., 0.) 100 continue c *** Call gg = g to facilitate the multiplication gg(1) = g(1) gg(2) = g(4) gg(3) = g(2) gg(4) = g(7) gg(5) = g(3) gg(6) = g(10) gg(7) = g(24) do 105 n = 1,7 IF (gg(n) .ne. 0.) then CCC zsig2(n) = zsig2(n)/( gg(n)**2 ) zsig2(n+7) = zsig2(n+7)/( gg(n)**2 ) endif IF (gg(n) .eq. 0.) then zsig2(n) = (0., 0.) zsig2(n+7) = (0., 0.) CCC write(6,*) ' *** warning in tnoff2' endif 105 continue CCC ENDIF CCC c *** Multiply by g(kp) CCC added pjd 26/3/93 IF(nifty(12).eq.0) THEN CCC call GRAZPT (kappap, g) gg(1) = g(1) gg(2) = g(4) gg(3) = g(2) gg(4) = g(7) gg(5) = g(3) gg(6) = g(10) gg(7) = g(24) do 150 n=1,32 zsig(n) = zsig(n) * g(n) 150 continue do 152 n = 1,7 zsig2(n) = zsig2(n) * gg(n) zsig2(n+7) = zsig2(n+7) * gg(n) 152 continue CCC ELSEIF(NIFTY(12).EQ.1) THEN CTVM CALL FRATIOS(KAPPAP,KAPPA,KAPPA0,G,G1) c/* since coupled f's are rank 2, must sum in a slighly more c/* involved way do 250 n=1,32 c First select uncoupled if(n.ne.6.and.n.ne.7.and.n.ne.9.and.n.ne.10.and.n.ne.12.and. 1 n.ne.25.and.n.ne.17.and.n.ne.18.and.n.ne.20.and.n.ne.21. 2 and.n.ne.23.and.n.ne.27.and.n.ne.29.and.n.ne.31) then zsig(n) = zsig(n)*g(n) elseif(n.eq.6) then CCC 3P2-3F2 channel zsigll = g(6)*zsig(6)+g(43)*zsig2(2) zsigllp = g(6)*zsig2(2)+g(43)*zsig(7) zsiglpl = g(44)*zsig(6)+g(7)*zsig2(2) zsiglplp = g(44)*zsig2(2)+g(7)*zsig(7) zsig(6) = zsigll zsig2(2) = zsigllp zsig2(9) = zsiglpl zsig(7) = zsiglplp elseif(n.eq.9) then CCC 3F4-3H4 channel zsigll = g(9)*zsig(9)+g(47)*zsig2(4) zsigllp = g(9)*zsig2(4)+g(47)*zsig(10) zsiglpl = g(48)*zsig(9)+g(10)*zsig2(4) zsiglplp = g(48)*zsig2(4)+g(10)*zsig(10) zsig(9) = zsigll zsig2(4) = zsigllp zsig2(11) = zsiglpl zsig(10) = zsiglplp elseif(n.eq.12) then CCC 3H6-3J6 channel zsigll = g(12)*zsig(12)+g(51)*zsig2(6) zsigllp = g(12)*zsig2(6)+g(51)*zsig(25) zsiglpl = g(52)*zsig(12)+g(25)*zsig2(6) zsiglplp = g(52)*zsig2(6)+g(25)*zsig(25) zsig(12) = zsigll zsig2(6) = zsigllp zsig2(13) = zsiglpl zsig(25) = zsiglplp elseif(n.eq.17) then CCC 3S1-3D1 channel zsigll = g(17)*zsig(17)+g(41)*zsig2(1) zsigllp = g(17)*zsig2(1)+g(41)*zsig(18) zsiglpl = g(42)*zsig(17)+g(18)*zsig2(1) zsiglplp = g(42)*zsig2(1)+g(18)*zsig(18) zsig(17) = zsigll zsig2(1) = zsigllp zsig2(8) = zsiglpl zsig(18) = zsiglplp elseif(n.eq.20) then CCC 3D3-3G3 channel zsigll = g(20)*zsig(20)+g(45)*zsig2(3) zsigllp = g(20)*zsig2(3)+g(45)*zsig(21) zsiglpl = g(46)*zsig(20)+g(21)*zsig2(3) zsiglplp = g(46)*zsig2(3)+g(21)*zsig(21) zsig(20) = zsigll zsig2(3) = zsigllp zsig2(10) = zsiglpl zsig(21) = zsiglplp elseif(n.eq.23) then CCC 3G5-3I5 channel zsigll = g(23)*zsig(23)+g(49)*zsig2(5) zsigllp = g(23)*zsig2(5)+g(49)*zsig(27) zsiglpl = g(50)*zsig(23)+g(27)*zsig2(5) zsiglplp = g(50)*zsig2(5)+g(27)*zsig(27) zsig(23) = zsigll zsig2(5) = zsigllp zsig2(12) = zsiglpl zsig(27) = zsiglplp elseif(n.eq.29) then CCC 3I7-3K7 channel zsigll = g(29)*zsig(29)+g(53)*zsig2(7) zsigllp = g(29)*zsig2(7)+g(53)*zsig(31) zsiglpl = g(54)*zsig(29)+g(31)*zsig2(7) zsiglplp = g(54)*zsig2(7)+g(31)*zsig(31) zsig(29) = zsigll zsig2(7) = zsigllp zsig2(14) = zsiglpl zsig(31) = zsiglplp endif 250 continue CCC elseif(nifty(12).eq.2)then CCC CCC PEST f-ratios CCC CTVM call pestpt(kappap,kappa,kappa0,g,g1) gg(1) = g(41) gg(2) = g(43) gg(3) = g(45) gg(8) = g(42) gg(9) = g(44) gg(10) = g(46) gg(4) = g(8) gg(5) = g(3) gg(6) = g(10) gg(7) = g(24) gg(11) = g(8) gg(12) = g(3) gg(13) = g(10) gg(14) = g(24) do 450 n=1,32 zsig(n) = zsig(n) * g(n) 450 continue do 452 n = 1,14 zsig2(n) = zsig2(n) * gg(n) 452 continue ENDIF CCC c *** Multiply by g(k) CCC added pjd 26/3/93 IF(NIFTY(12).eq.0) THEN CCC call GRAZPT (kappa, g) gg(1) = g(1) gg(2) = g(4) gg(3) = g(2) gg(4) = g(7) gg(5) = g(3) gg(6) = g(10) gg(7) = g(24) do 160 n = 1,32 zsig(n) = zsig(n) * g(n) 160 continue do 165 n = 1,7 zsig2(n) = zsig2(n) * gg(n) zsig2(n+7) = zsig2(n+7) * gg(n) 165 continue ELSEIF(NIFTY(12).eq.1)then do 253 n=1,54 253 g(n) = g1(n) c/* since coupled f's are rank 2, must sum in a slighly more c/* involved way do 251 n=1,32 c First select uncoupled if(n.ne.6.and.n.ne.7.and.n.ne.9.and.n.ne.10.and.n.ne.12.and. 1 n.ne.25.and.n.ne.17.and.n.ne.18.and.n.ne.20.and.n.ne.21. 2 and.n.ne.23.and.n.ne.27.and.n.ne.29.and.n.ne.31) then zsig(n) = zsig(n)*g(n) elseif(n.eq.6) then CCC 3P2-3F2 channel zsigll = g(6)*zsig(6)+g(43)*zsig2(2) zsiglpl = g(6)*zsig2(9)+g(43)*zsig(7) zsigllp = g(44)*zsig(6)+g(7)*zsig2(2) zsiglplp = g(44)*zsig2(9)+g(7)*zsig(7) zsig(6) = zsigll zsig2(2) = zsigllp zsig2(9) = zsiglpl zsig(7) = zsiglplp elseif(n.eq.9) then CCC 3F4-3H4 channel zsigll = g(9)*zsig(9)+g(47)*zsig2(4) zsiglpl = g(9)*zsig2(11)+g(47)*zsig(10) zsigllp = g(48)*zsig(9)+g(10)*zsig2(4) zsiglplp = g(48)*zsig2(11)+g(10)*zsig(10) zsig(9) = zsigll zsig2(4) = zsigllp zsig2(11) = zsiglpl zsig(10) = zsiglplp elseif(n.eq.12) then CCC 3H6-3J6 channel zsigll = g(12)*zsig(12)+g(51)*zsig2(6) zsiglpl = g(12)*zsig2(13)+g(51)*zsig(25) zsigllp = g(52)*zsig(12)+g(25)*zsig2(6) zsiglplp = g(52)*zsig2(13)+g(25)*zsig(25) zsig(12) = zsigll zsig2(6) = zsigllp zsig2(13) = zsiglpl zsig(25) = zsiglplp elseif(n.eq.17) then CCC 3S1-3D1 channel zsigll = g(17)*zsig(17)+g(41)*zsig2(1) zsiglpl = g(17)*zsig2(8)+g(41)*zsig(18) zsigllp = g(42)*zsig(17)+g(18)*zsig2(1) zsiglplp = g(42)*zsig2(8)+g(18)*zsig(18) zsig(17) = zsigll zsig2(1) = zsigllp zsig2(8) = zsiglpl zsig(18) = zsiglplp elseif(n.eq.20) then CCC 3D3-3G3 channel zsigll = g(20)*zsig(20)+g(45)*zsig2(3) zsiglpl = g(20)*zsig2(10)+g(45)*zsig(21) zsigllp = g(46)*zsig(20)+g(21)*zsig2(3) zsiglplp = g(46)*zsig2(10)+g(21)*zsig(21) zsig(20) = zsigll zsig2(3) = zsigllp zsig2(10) = zsiglpl zsig(21) = zsiglplp elseif(n.eq.23) then CCC 3G5-3I5 channel zsigll = g(23)*zsig(23)+g(49)*zsig2(5) zsiglpl = g(23)*zsig2(12)+g(49)*zsig(27) zsigllp = g(50)*zsig(23)+g(27)*zsig2(5) zsiglplp = g(50)*zsig2(12)+g(27)*zsig(27) zsig(23) = zsigll zsig2(5) = zsigllp zsig2(12) = zsiglpl zsig(27) = zsiglplp elseif(n.eq.29) then CCC 3I7-3K7 channel zsigll = g(29)*zsig(29)+g(53)*zsig2(7) zsiglpl = g(29)*zsig2(14)+g(53)*zsig(31) zsigllp = g(54)*zsig(29)+g(31)*zsig2(7) zsiglplp = g(54)*zsig2(14)+g(31)*zsig(31) zsig(29) = zsigll zsig2(7) = zsigllp zsig2(14) = zsiglpl zsig(31) = zsiglplp endif 251 continue CCC elseif(nifty(12).eq.2)then CCC CCC PEST f-ratios CCC CCC call pestpt(kappa,kappa0,g) do 353 n=1,54 353 g(n) = g1(n) gg(1) = g(41) gg(2) = g(43) gg(3) = g(45) gg(8) = g(42) gg(9) = g(44) gg(10) = g(46) gg(4) = g(8) gg(5) = g(3) gg(6) = g(10) gg(7) = g(24) gg(11) = g(8) gg(12) = g(3) gg(13) = g(10) gg(14) = g(24) do 550 n=1,32 zsig(n) = zsig(n) * g(n) 550 continue do 552 n = 1,14 zsig2(n) = zsig2(n) * gg(n) 552 continue ENDIF CCC c *** Determine Re and Im parts of t do 180 n = 1,32 Ret(n) = zsig(n) Imt(n) = -zi * (zsig(n)) retij(n) = Ret(n) imtij(n) = Imt(n) 180 continue do 185 n = 1,14 C do 185 n = 1,7 Retmix(n) = zsig2(n) Imtmix(n) = -zi * (zsig2(n)) 185 continue c *** Form partial wave decomposition from channels x = costh call DAMPS (x, tapb, tamb, tcpd, tcmd, tel) c *** Set selective parts = 0 do 914 n = 1,4 IF (nifty(18) .eq. 1 .OR. nifty(18) .eq. 3) then tel(n) = 0. endif IF (nifty(18) .eq. 2 .OR. nifty(18) .eq. 3) then tapb(n) = 0. endif 914 continue do 200 j = 1,36 IF (bn(2) .eq. 0.) go to 210 IF (abs(bn(j)/bn(2)) .le. 1.e-5) then bn(j) = 0. bnf(j) = 0. endif 200 continue 210 continue RETURN end