C******************************************************************** subroutine efdsgps(tpi,ierr) * ----------------------------------------------------- c * ( purpose ) C Called by efdsg.F c * ( input ) * tpi : pion energy in lab frame (MeV) * * ( output ) * Common block phase shifts * ierr : error flag * * ( history ) * Creation: R. Tacik * 2010-06: P.de Perio - Add IERR flag * - Tables loaded here and not from file implicit none character first_line integer int, i, ierr real tpi real dummy real xint,frac logical first /.true./ C real s11(134),s31(134) C real p11(134),p31(134),p13(134),p33(134) C real d13(134),d33(134),d15(134),d35(134) C real xs11,xs31,xp11,xp31,xp13,xp33,xd13,xd33,xd15,xd35 C common /phases/ xs11,xs31,xp11,xp31,xp13,xp33,xd13,xd33,xd15,xd35 C common /savep/ s11, s31, p11, p31, p13, p33, d13, d33, d15, d35 #include "efdsg.h" REAL s11(134) REAL s31(134) REAL p11(134) REAL p31(134) REAL p13(134) REAL p33(134) REAL d13(134) REAL d33(134) REAL d15(134) REAL d35(134) DATA s11 / $ 2.28,4.47,5.79,6.75,7.5,8.1,8.59, $ 9,9.35,9.68,9.97,10.23,10.49,10.72, $ 10.96,11.18,11.42,11.66,11.91,12.17,12.46, $ 12.77,13.12,13.5,13.93,14.4,14.94,15.55, $ 16.24,17.03,17.94,19,20.25,21.75,23.6, $ 25.98,29.36,36.36,38.41,39.59,38.29,33.54, $ 26.45,20.28,16.67,15.22,15.19,16.13,17.84, $ 20.26,23.46,27.55,32.65,38.85,46.05,53.92, $ 61.97,69.72,76.86,83.26,88.91,93.84,98.13, $ 101.85,105.06,107.84,110.25,-67.66,-65.85,-64.28, $ -62.92,-61.73,-60.7,-59.81,-59.05,-58.38,-57.81, $ -57.33,-56.91,-56.56,-56.27,-56.03,-55.84,-55.68, $ -55.57,-55.48,-55.42,-55.39,-55.38,-55.38,-55.41, $ -55.45,-55.5,-55.56,-55.63,-55.7,-55.78,-55.86, $ -55.94,-56.02,-56.1,-56.17,-56.24,-56.3,-56.36, $ -56.4,-56.43,-56.44,-56.44,-56.42,-56.38,-56.32, $ -56.24,-56.13,-56,-55.84,-55.65,-55.43,-55.17, $ -54.88,-54.55,-54.19,-53.78,-53.34,-52.87,-52.35, $ -51.8,-51.22,-50.6,-49.96,-49.29,-48.6,-47.9, $ -47.19/ DATA s31 / $ -1.12,-2.61,-3.88,-5.11,-6.3,-7.46,-8.58, $ -9.68,-10.74,-11.76,-12.75,-13.7,-14.61,-15.5, $ -16.35,-17.17,-17.97,-18.75,-19.5,-20.23,-20.93, $ -21.62,-22.28,-22.93,-23.54,-24.13,-24.69,-25.21, $ -25.71,-26.16,-26.57,-26.94,-27.26,-27.52,-27.73, $ -27.87,-27.94,-27.94,-27.85,-27.67,-27.4,-27.04, $ -26.6,-26.1,-25.61,-25.23,-25.18,-25.74,-27.36, $ -30.47,-35.11,-40.47,-45.29,-48.83,-51.15,-52.57, $ -53.41,-53.88,-54.15,-54.28,-54.35,-54.39,-54.41, $ -54.44,-54.48,-54.53,-54.6,-54.68,-54.79,-54.9, $ -55.03,-55.17,-55.32,-55.47,-55.63,-55.79,-55.96, $ -56.13,-56.29,-56.46,-56.63,-56.8,-56.96,-57.12, $ -57.28,-57.44,-57.6,-57.75,-57.89,-58.04,-58.17, $ -58.31,-58.44,-58.56,-58.68,-58.8,-58.91,-59.02, $ -59.12,-59.21,-59.3,-59.39,-59.47,-59.54,-59.61, $ -59.67,-59.73,-59.78,-59.83,-59.87,-59.9,-59.93, $ -59.95,-59.97,-59.97,-59.98,-59.97,-59.96,-59.94, $ -59.92,-59.88,-59.84,-59.8,-59.74,-59.68,-59.61, $ -59.53,-59.45,-59.35,-59.25,-59.14,-59.02,-58.89, $ -58.75/ DATA p11 / $ -0.04,-0.28,-0.55,-0.78,-0.95,-1.02,-0.99, $ -0.85,-0.58,-0.17,0.38,1.08,1.96,3.03, $ 4.29,5.78,7.51,9.51,11.8,14.4,17.33, $ 20.6,24.19,28.06,32.14,36.33,40.54,44.69, $ 48.73,52.63,56.41,60.07,63.63,67.1,70.5, $ 73.83,77.09,80.26,83.33,86.31,89.16,91.9, $ 94.52,97.02,99.41,101.68,103.86,105.95,107.96, $ 109.91,111.8,113.65,115.47,117.27,119.05,120.83, $ 122.61,124.41,126.24,128.09,129.99,131.94,133.95, $ 136.03,138.2,140.49,142.9,-34.53,-31.77,-28.78, $ -25.53,-21.96,-18.05,-13.77,-9.15,-4.23,0.85, $ 5.96,10.93,15.62,19.96,23.9,27.45,30.65, $ 33.54,36.15,38.53,40.7,42.71,44.57,46.3, $ 47.92,49.45,50.89,52.27,53.57,54.83,56.03, $ 57.18,58.29,59.36,60.41,61.41,62.4,63.35, $ 64.28,65.19,66.08,66.96,67.81,68.65,69.48, $ 70.3,71.1,71.89,72.68,73.45,74.22,74.98, $ 75.74,76.49,77.24,77.98,78.73,79.46,80.2, $ 80.94,81.67,82.41,83.14,83.88,84.61,85.35, $ 86.08/ DATA p31 / $ -0.03,-0.22,-0.49,-0.81,-1.17,-1.55,-1.96, $ -2.39,-2.84,-3.3,-3.77,-4.25,-4.73,-5.22, $ -5.71,-6.2,-6.69,-7.18,-7.66,-8.14,-8.62, $ -9.09,-9.56,-10.03,-10.5,-10.97,-11.45,-11.94, $ -12.44,-12.94,-13.45,-13.96,-14.47,-14.98,-15.48, $ -15.98,-16.47,-16.95,-17.41,-17.86,-18.29,-18.7, $ -19.08,-19.45,-19.79,-20.11,-20.4,-20.67,-20.92, $ -21.14,-21.33,-21.51,-21.65,-21.78,-21.88,-21.96, $ -22.02,-22.06,-22.09,-22.1,-22.09,-22.08,-22.05, $ -22.02,-21.98,-21.94,-21.9,-21.86,-21.83,-21.81, $ -21.79,-21.79,-21.8,-21.83,-21.87,-21.94,-22.03, $ -22.14,-22.27,-22.43,-22.62,-22.82,-23.06,-23.32, $ -23.6,-23.91,-24.24,-24.59,-24.97,-25.37,-25.79, $ -26.22,-26.68,-27.15,-27.63,-28.13,-28.64,-29.16, $ -29.7,-30.23,-30.78,-31.33,-31.89,-32.45,-33.01, $ -33.57,-34.14,-34.7,-35.26,-35.83,-36.38,-36.94, $ -37.49,-38.04,-38.59,-39.13,-39.67,-40.2,-40.73, $ -41.25,-41.77,-42.29,-42.8,-43.31,-43.81,-44.31, $ -44.8,-45.29,-45.78,-46.27,-46.75,-47.23,-47.71, $ -48.19/ DATA p13 / $ -0.02,-0.13,-0.29,-0.47,-0.67,-0.88,-1.09, $ -1.3,-1.52,-1.73,-1.95,-2.16,-2.36,-2.56, $ -2.76,-2.95,-3.13,-3.31,-3.48,-3.64,-3.8, $ -3.94,-4.08,-4.21,-4.32,-4.43,-4.53,-4.61, $ -4.69,-4.75,-4.79,-4.83,-4.85,-4.85,-4.84, $ -4.81,-4.76,-4.7,-4.62,-4.53,-4.41,-4.28, $ -4.13,-3.97,-3.8,-3.61,-3.41,-3.21,-3.01, $ -2.81,-2.63,-2.46,-2.32,-2.22,-2.15,-2.14, $ -2.18,-2.28,-2.44,-2.66,-2.94,-3.27,-3.65, $ -4.07,-4.52,-4.98,-5.46,-5.94,-6.41,-6.88, $ -7.33,-7.76,-8.17,-8.55,-8.91,-9.25,-9.57, $ -9.87,-10.14,-10.4,-10.64,-10.86,-11.07,-11.27, $ -11.45,-11.62,-11.78,-11.93,-12.08,-12.21,-12.35, $ -12.47,-12.59,-12.71,-12.82,-12.93,-13.03,-13.14, $ -13.24,-13.34,-13.44,-13.53,-13.63,-13.72,-13.82, $ -13.92,-14.01,-14.11,-14.2,-14.3,-14.4,-14.5, $ -14.59,-14.69,-14.8,-14.9,-15,-15.11,-15.21, $ -15.32,-15.43,-15.54,-15.65,-15.77,-15.89,-16, $ -16.12,-16.24,-16.37,-16.49,-16.62,-16.75,-16.88, $ -17.02/ DATA p33 / $ 0.15,1.28,3.15,5.76,9.2,13.65,19.37, $ 26.66,35.84,47.04,59.87,73.35,86.15,97.32, $ 106.59,114.11,120.2,125.19,129.35,132.87,135.9, $ 138.56,140.92,143.05,144.99,146.78,148.46,150.03, $ 151.52,152.94,154.3,155.61,156.87,158.08,159.25, $ 160.37,161.45,162.49,163.48,164.43,165.34,166.2, $ 167.02,167.8,168.54,169.24,169.91,170.53,171.13, $ 171.69,172.22,172.72,173.2,173.66,174.09,174.5, $ 174.9,175.28,175.65,176,176.34,176.67,176.99, $ 177.3,177.6,177.89,178.18,-1.54,-1.27,-1, $ -0.75,-0.5,-0.25,-0.02,0.21,0.43,0.64, $ 0.84,1.03,1.22,1.39,1.55,1.7,1.85, $ 1.98,2.1,2.21,2.3,2.39,2.46,2.53, $ 2.58,2.62,2.65,2.67,2.68,2.68,2.66, $ 2.64,2.61,2.58,2.53,2.48,2.42,2.35, $ 2.28,2.21,2.13,2.05,1.96,1.87,1.78, $ 1.69,1.59,1.5,1.4,1.31,1.22,1.13, $ 1.03,0.95,0.86,0.77,0.69,0.61,0.54, $ 0.46,0.39,0.32,0.26,0.2,0.14,0.09, $ 0.04/ DATA d13 / $ 0,0,0.02,0.04,0.08,0.14,0.22, $ 0.32,0.44,0.59,0.77,0.98,1.22,1.5, $ 1.81,2.15,2.54,2.96,3.43,3.94,4.5, $ 5.13,5.82,6.58,7.42,8.36,9.42,10.6, $ 11.94,13.47,15.23,17.27,19.67,22.54,26, $ 30.26,35.64,42.67,52.45,67.2,88.8,110.04, $ 124.32,133.79,140.63,145.87,150.06,153.49,156.35, $ 158.79,160.89,162.73,164.35,165.79,167.1,168.28, $ 169.36,170.35,171.27,172.12,172.91,173.65,174.35, $ 175,175.62,176.2,176.74,-2.74,-2.26,-1.8, $ -1.37,-0.96,-0.58,-0.22,0.11,0.42,0.71, $ 0.98,1.23,1.45,1.66,1.85,2.02,2.17, $ 2.31,2.42,2.53,2.61,2.68,2.74,2.78, $ 2.81,2.83,2.84,2.83,2.81,2.78,2.74, $ 2.69,2.64,2.57,2.49,2.41,2.32,2.22, $ 2.12,2.01,1.89,1.77,1.64,1.51,1.37, $ 1.23,1.09,0.94,0.79,0.63,0.48,0.32, $ 0.16,0,-0.17,-0.33,-0.5,-0.66,-0.83, $ -0.99,-1.16,-1.33,-1.49,-1.66,-1.82,-1.99, $ -2.15/ DATA d33 / $ 0,0,0.01,0.02,0.03,0.05,0.07, $ 0.09,0.12,0.14,0.17,0.19,0.21,0.23, $ 0.25,0.27,0.28,0.29,0.3,0.31,0.32, $ 0.33,0.35,0.36,0.37,0.39,0.4,0.42, $ 0.44,0.46,0.48,0.51,0.53,0.56,0.59, $ 0.63,0.66,0.7,0.73,0.76,0.79,0.81, $ 0.81,0.79,0.75,0.67,0.55,0.38,0.14, $ -0.19,-0.6,-1.11,-1.72,-2.42,-3.21,-4.06, $ -4.95,-5.84,-6.71,-7.52,-8.27,-8.93,-9.51, $ -10.01,-10.43,-10.77,-11.06,-11.29,-11.48,-11.64, $ -11.77,-11.87,-11.96,-12.04,-12.11,-12.17,-12.22, $ -12.28,-12.33,-12.38,-12.44,-12.49,-12.55,-12.61, $ -12.67,-12.74,-12.8,-12.87,-12.95,-13.03,-13.11, $ -13.19,-13.27,-13.36,-13.46,-13.55,-13.65,-13.75, $ -13.85,-13.95,-14.06,-14.17,-14.28,-14.4,-14.52, $ -14.63,-14.75,-14.88,-15,-15.13,-15.26,-15.39, $ -15.52,-15.66,-15.79,-15.93,-16.07,-16.21,-16.35, $ -16.5,-16.64,-16.79,-16.94,-17.09,-17.24,-17.39, $ -17.55,-17.7,-17.86,-18.02,-18.18,-18.34,-18.5, $ -18.66/ DATA d15 / $ 0,0.01,0.03,0.06,0.11,0.17,0.24, $ 0.33,0.42,0.52,0.62,0.73,0.84,0.96, $ 1.09,1.21,1.34,1.47,1.61,1.75,1.89, $ 2.04,2.19,2.35,2.52,2.69,2.87,3.07, $ 3.27,3.49,3.72,3.96,4.23,4.52,4.83, $ 5.16,5.53,5.93,6.37,6.86,7.39,7.98, $ 8.64,9.37,10.19,11.1,12.11,13.24,14.49, $ 15.86,17.33,18.86,20.34,21.58,22.2,21.43, $ 17.76,8.91,-3.84,-13.19,-17.6,-19.26,-19.61, $ -19.36,-18.83,-18.19,-17.51,-16.83,-16.19,-15.58, $ -15,-14.47,-13.98,-13.52,-13.1,-12.7,-12.33, $ -11.99,-11.67,-11.36,-11.08,-10.82,-10.56,-10.33, $ -10.1,-9.89,-9.68,-9.49,-9.3,-9.13,-8.96, $ -8.8,-8.64,-8.5,-8.35,-8.22,-8.09,-7.96, $ -7.85,-7.73,-7.63,-7.53,-7.43,-7.34,-7.26, $ -7.18,-7.1,-7.04,-6.98,-6.93,-6.88,-6.84, $ -6.81,-6.78,-6.76,-6.75,-6.75,-6.75,-6.77, $ -6.78,-6.81,-6.85,-6.89,-6.94,-6.99,-7.06, $ -7.13,-7.2,-7.29,-7.37,-7.46,-7.56,-7.66, $ -7.76/ DATA d35 / $ 0,0,-0.01,-0.03,-0.05,-0.08,-0.11, $ -0.16,-0.2,-0.25,-0.31,-0.36,-0.42,-0.49, $ -0.55,-0.62,-0.69,-0.76,-0.83,-0.9,-0.98, $ -1.05,-1.12,-1.19,-1.26,-1.33,-1.4,-1.47, $ -1.54,-1.6,-1.67,-1.73,-1.79,-1.85,-1.91, $ -1.96,-2.02,-2.07,-2.11,-2.16,-2.2,-2.25, $ -2.28,-2.32,-2.35,-2.38,-2.41,-2.43,-2.45, $ -2.47,-2.49,-2.5,-2.51,-2.51,-2.52,-2.51, $ -2.51,-2.5,-2.49,-2.47,-2.45,-2.43,-2.4, $ -2.37,-2.34,-2.3,-2.26,-2.22,-2.18,-2.13, $ -2.08,-2.02,-1.97,-1.91,-1.85,-1.79,-1.73, $ -1.67,-1.61,-1.55,-1.5,-1.44,-1.39,-1.34, $ -1.3,-1.26,-1.23,-1.2,-1.18,-1.17,-1.16, $ -1.17,-1.17,-1.19,-1.21,-1.24,-1.27,-1.3, $ -1.33,-1.36,-1.39,-1.42,-1.44,-1.46,-1.48, $ -1.49,-1.49,-1.49,-1.48,-1.47,-1.46,-1.44, $ -1.42,-1.4,-1.37,-1.35,-1.32,-1.29,-1.26, $ -1.23,-1.19,-1.16,-1.13,-1.1,-1.08,-1.05, $ -1.02,-1,-0.97,-0.95,-0.93,-0.91,-0.89, $ -0.88/ ierr = 0 C if (first) then C open (unit=10,file='phases.said.wi08',status='old') C read (10,'(a)') first_line C do i = 1, 70 C read (10,*) dummy,s11(i),s31(i),p11(i),p31(i),p13(i), C & p33(i),d13(i),d33(i),d15(i),d35(i) C end do C close (10) C first = .false. C end if if (tpi.lt.5.) then write (6,*) 'efdsgps: No phaseshifts available for tpi < 5' ierr = 1 return C Note: Tables filled up to 2000 MeV else if (tpi.gt.2000.) then write (6,*) 'efdsgps: No phaseshifts available & for tpi > 2000' ierr = 2 return else xint = (tpi-5.)/15. + 1. int = ifix(xint) frac = (tpi - 15.*float(int))/15. C Quick fix for bug: C Sometimes tpi=NAN and crashes if ( tpi .ne. tpi ) then write (6,*) 'efdsgps: Warning: TPI=NAN' ierr = 3 return end if xs11 = s11(int) + frac*( s11(int+1) - s11(int) ) xs31 = s31(int) + frac*( s31(int+1) - s31(int) ) xp11 = p11(int) + frac*( p11(int+1) - p11(int) ) xp31 = p31(int) + frac*( p31(int+1) - p31(int) ) xp13 = p13(int) + frac*( p13(int+1) - p13(int) ) xp33 = p33(int) + frac*( p33(int+1) - p33(int) ) xd13 = d13(int) + frac*( d13(int+1) - d13(int) ) xd33 = d33(int) + frac*( d33(int+1) - d33(int) ) xd15 = d15(int) + frac*( d15(int+1) - d15(int) ) xd35 = d35(int) + frac*( d35(int+1) - d35(int) ) end if return end