********************************************************************* **** The same parametrization as in CJKL.f but for **** **** calculations according to the "ACOT2(chi)" approach **** **** described in "application.ps" available at **** **** http//www.fuw.edu.pl/~pjank/param.html **** **** (part of P.Jankowski's PhD thesis) **** **** **** **** LO parametrization of the parton densities in the real **** **** photon for the CJKL fit based on **** **** **** **** F.Cornet, P.Jankowski, M.Krawczyk and A.Lorca **** **** "A New 5 Flavour LO Analysis and Parametrization **** **** of Parton Distributions in the Real Photon" **** **** Phys. Rev. D68: 014010, 2003 **** **** hep-ph/0212160 **** ********************************************************************* **** **** **** valid for 10^(-5) < x < 1 and 1 < Q^2 < 2*10^5 GeV^2 **** **** **** **** x - Bjorken x variable **** **** xc - chi_c calculated for the given process **** **** xb - chi_b calculated for the given process **** **** Q2 - square of momentum scale (in GeV**2) **** **** XPDF(-5:5) - matrix containing x*f(x,Q2)/alfa **** **** **** **** PDF = -5 , -4 , -3 , -2 , -1 ,0 ,1,2,3,4,5 **** **** b_bar,c_bar,s_bar,u_bar,d_bar,gl,d,u,s,c,b **** **** **** **** heavy quarks masses: **** **** M_charm=1.3, M_beauty=4.3 GeV **** **** **** **** Lambda_QCD values for active N_f falvours: **** **** N_f= 3 4 5 **** **** 0.314 0.280 0.221 GeV **** **** **** **** LIPARTS: only light partons (gl,d,u,s) **** **** PARTONS: (gl,d,u,s,c,b) parton densities **** **** **** ********************************************************************* **** Evolution, parametrization, checks performed and programs **** **** written by **** **** Pawel Jankowski, (pjank@fuw.edu.pl) **** **** Institute of Theoretical Physics, **** **** Warsaw University **** **** ul. Hoza 69 **** **** 00-681 Warsaw **** **** Poland **** **** **** **** Last changes - 26 May 2004 **** ********************************************************************* SUBROUTINE LIPARTS(x,xc,xb,Q2,XPDF) IMPLICIT DOUBLE PRECISION (a-z) dimension XPDF(-3:3),PART(-5:5) integer I **** x * par / alfa **** call PARAM(1,x,xc,xb,Q2,PART) do 1 I=-3,3 1 XPDF(I)=PART(I) END SUBROUTINE PARTONS(x,xc,xb,Q2,XPDF) IMPLICIT DOUBLE PRECISION (a-z) dimension XPDF(-5:5) **** x * par / alfa **** call PARAM(2,x,xc,xb,Q2,XPDF) END ********************************** SUBROUTINE PARAM(OPT,x,xc,xb,Q2,XPDF) IMPLICIT DOUBLE PRECISION (a-z) dimension XPDF(-5:5) logical t integer OPT,I mc = 1.3d0 mc2 = mc*mc mb = 4.3d0 mb2 = mb*mb xc = xc/(1.d0+4.d0*mc2/Q2) xb = xb/(1.d0+4.d0*mb2/Q2) call POINTLIKE(OPT,x,xc,xb,Q2,glpl,uppl,dnpl,chpl,btpl) call HADRONLIKE(OPT,x,xc,xb,Q2,glhd,vlhd,sthd,chhd,bthd) **** x * par / alfa **** XPDF(0) = glhd + glpl XPDF(2) = 0.5d0*vlhd + sthd + uppl XPDF(1) = 0.5d0*vlhd + sthd + dnpl XPDF(3) = sthd + dnpl XPDF(4) = chhd + chpl XPDF(5) = bthd + btpl do 1 I=1,5 1 XPDF(-I) = XPDF(I) do 3 I=-5,5 3 if (XPDF(I).LT.0.d0) XPDF(I)=0.d0 end ********************************************************************* ********************************************************************* SUBROUTINE POINTLIKE(OPT,x,xc,xb,Q2,glpl,uppl,dnpl,chpl,btpl) IMPLICIT DOUBLE PRECISION (a-z) dimension pargl(19),parup(19),pardn(19) dimension parch1(21),parch2(21),parbt1(21),parbt2(21) integer OPT chpl = 0.d0 btpl = 0.d0 mc = 1.3d0 mc2 = mc*mc mb = 4.3d0 mb2 = mb*mb xmaxc = 1.d0/(1.d0+4.d0*mc2/Q2) xmaxb = 1.d0/(1.d0+4.d0*mb2/Q2) **** gluon **** data pargl/ -0.43865d0, 2.7174d0, 0.36752d0, 0.086893d0, % 0.010556d0, -0.099005d0, 1.0648d0, 3.6717d0, 2.1944d0, % 0.236795d0, -0.19994d0, -0.34992d0, 0.049525d0, 0.34830d0, % 0.14342d0, 2.5071d0, 1.9358d0, -0.11849d0, 0.028124d0 / **** up **** data parup/ -1.0711d0, 3.1320d0, 0.69243d0, % -0.058266d0, 0.0097377d0, -0.0068345d0, % 0.22297d0, 6.4289d0, 1.7302d0, 0.87940d0, % 2.6878d0, 0.20506d0, -0.10617d0, 0.15211d0, % 0.013567d0, 2.2802d0, 0.76997d0, -0.110241d0, % -0.040252d0 / **** down = str **** data pardn/ -1.1357d0, 3.1187d0, 0.66290d0, % 0.098814d0, -0.092892d0, -0.0066140d0, % -0.31385d0, 6.4671d0, 1.6996d0, 11.777d0, % -11.124d0, -0.067300d0, 0.049949d0, 0.020427d0, % -0.0037558d0, 2.2834d0, 0.84262d0, 0.034760d0, % -0.20135d0 / **** charm **** data parch1/ 2.9808d0, 28.682d0, 2.4863d0, % -0.18826d0, 0.18508d0, -0.0014153d0, -0.48961d0, % 0.20911d0, 2.7644d0, -7.6307d0, 394.58d0, % 0.13565d0, -0.11764d0, -0.011510d0, 0.18810d0, % -2.8544d0, 0.93717d0, 5.6807d0, -541.82d0, % 14.256d0, 200.82d0 / data parch2/ -1.8095d0, 7.9399d0, 0.041563d0, % -0.54831d0, 0.19484d0, -0.39046d0, 0.12717d0, % 8.7191d0, 4.2616d0, -0.30307d0, 7.2383d0, % 0.33412d0, 0.041562d0, 0.37194d0, 0.059280d0, % 3.0194d0, 0.73993d0, 0.29430d0, -1.5995d0, % 0.d0, 0.d0 / **** bottom **** data parbt1/ 2.2849d0, 6.0408d0, -0.11577d0, % -0.26971d0, 0.27033d0, 0.0022862d0, 0.30807d0, % 14.812d0, 1.7148d0, 3.8140d0, 2.2292d0, % 0.17942d0, -0.18358d0, -0.0016837d0, -0.10490d0, % -1.2977d0, 2.3532d0, -1.0514d0, 20.194d0, % 0.0061059d0, 0.053734d0 / data parbt2/ -5.0607d0, 16.590d0, 0.87190d0, % -0.72790d0, -0.62903d0, -2.4467d0, 0.56575d0, % 1.4687d0, 1.1706d0, -0.084651d0, 9.6036d0, % 0.36549d0, 0.56817d0, 1.6783d0, -0.19120d0, % 9.6071d0, 0.99674d0, -0.083206d0, -3.4864d0, % 0.d0,0.d0 / glpl = pl(x,Q2,pargl) uppl = pl(x,Q2,parup) dnpl = pl(x,Q2,pardn) if (OPT.EQ.1) goto 1 if (xc.LT.xmaxc) then if (Q2.LE.10.d0) then chpl = cpl(xc,Q2,parch1) else chpl = cpl(xc,Q2,parch2) endif chpl = x/xc*chpl endif if (xb.LT.xmaxb) then if (Q2.LE.100.d0) then btpl = bpl(xb,Q2,parbt1) else btpl = bpl(xb,Q2,parbt2) endif btpl = x/xb*btpl endif 1 continue END ********************** ********************** SUBROUTINE HADRONLIKE(OPT,x,xc,xb,Q2,glhd,vlhd,sthd,chhd,bthd) IMPLICIT DOUBLE PRECISION (a-z) dimension pargl(18),parvl(10),parst(14) dimension parch1(17),parch2(17),parbt1(16),parbt2(16) integer OPT chhd = 0.d0 bthd = 0.d0 mc = 1.3d0 mc2 = mc*mc mb = 4.3d0 mb2 = mb*mb xmaxc = 1.d0/(1.d0+4.d0*mc2/Q2) xmaxb = 1.d0/(1.d0+4.d0*mb2/Q2) **** gluon **** data pargl/ 0.59945d0, 1.1285d0, -0.19898d0, % 1.9942d0, -1.9848d0, -0.34948d0, 1.0012d0, % 1.2287d0, 4.9230d0, 0.21294d0, 0.57414d0, % -1.8306d0, 1.4136d0, 0.47058d0, 0.99767d0, % 2.4447d0, 0.18526d0, 2.7450d0 / **** valence **** data parvl/ 1.0898d0, 0.78391d0, 0.42654d0, % -1.6576d0, 0.96155d0, 0.38087d0, -0.068720d0, % -1.2128d0, 1.7075d0, 1.8441d0 / **** strange **** data parst/ 0.71660d0, 0.72289d0, 0.60478d0, % 4.2106d0, 4.1494d0, 4.5179d0, 5.2812d0, % 1.0497d0, -0.21562d0, 0.036160d0, -0.85835d0, % 0.34866d0, 1.9219d0, -0.15200d0 / **** charm **** data parch1/ 5.6729d0, 1.6248d0, -2586.4d0, 2695.0d0, % 1.5146d0, -3.9185d0, 3.6126d0, 1.4575d0, % -0.70433d0, 1910.1d0, -1688.2d0, 3.1028d0, % 11.738d0, -1.0291d0, 0.d0, 0.d0, 0.d0 / data parch2/ -1.6470d0, -0.78809d0, -2.0561d0, % 2.1266d0, 3.0301d0, 4.1282d0, 0.89599d0, % 0.72738d0, 0.90278d0, 0.75576d0, 0.66383d0, % -1.7499d0, 1.6929d0, 1.2761d0, -0.15061d0, % -0.26292d0, 1.6466d0 / **** bottom **** data parbt1/ -10.210d0, 0.82278d0, -99.613d0, % 492.61d0, 3.3917d0, 5.6829d0, -2.0137d0, % -2.2296d0, 0.081818d0, 171.25d0, -420.45d0, % 0.084256d0, -0.23571d0, 4.6955d0, 0.d0, 0.d0 / data parbt2/ 2.4198d0, -0.98933d0, -2.1109d0, % 9.0196d0, 3.6455d0, 4.6196d0, 0.66454d0, % 0.40703d0, 0.42366d0, 1.2711d0, -3.6082d0, % -4.1353d0, 2.4212d0, 1.1109d0, 0.15817d0, 2.3615d0 / glhd = glu(x,Q2,pargl) vlhd = val(x,Q2,parvl) sthd = str(x,Q2,parst) if (OPT.EQ.1) goto 1 if (xc.LT.xmaxc) then if (Q2.LE.10.d0) then chhd = chm(xc,Q2,parch1) else chhd = chm(xc,Q2,parch2) endif chhd = x/xc*chhd endif if (xb.LT.xmaxb) then if (Q2.LE.100.d0) then bthd = bot(xb,Q2,parbt1) else bthd = bot(xb,Q2,parbt2) endif bthd = x/xb*bthd endif 1 continue END ******************************************************************** **** POINT-LIKE **** ******************************************************************** DOUBLE PRECISION FUNCTION pl(x,Q2,PAR) IMPLICIT DOUBLE PRECISION (a-z) dimension PAR(19) Parameter (Pi=3.1415926535897932d0) Lam2 = 0.221d0*0.221d0 s = DLOG(DLOG(Q2/Lam2)/DLOG(0.25d0/Lam2)) dlg = DLOG(1.d0/x) alfa = PAR(1) alfap = PAR(2) beta = PAR(3) A = PAR(4) + PAR(12)*s B = PAR(5) + PAR(13)*s C = PAR(6) + PAR(14)*s D = PAR(7) + PAR(15)*s E = PAR(8) + PAR(16)*s EP = PAR(9) + PAR(17)*s AS = PAR(10) + PAR(18)*s BS = PAR(11) + PAR(19)*s pl = s**alfa*x**AS*(A+B*DSQRT(x)+C*x**BS) pl = pl + s**alfap*DEXP(-E + DSQRT(EP*s**beta*dlg)) pl = 9.d0/(4.d0*Pi)*DLOG(Q2/Lam2)*pl*(1.d0-x)**D END ********** ********** DOUBLE PRECISION FUNCTION cpl(x,Q2,PAR) IMPLICIT DOUBLE PRECISION (a-z) dimension PAR(21) Parameter (Pi=3.1415926535897932d0) Lam2 = 0.221d0*0.221d0 s = DLOG(DLOG(Q2/Lam2)/DLOG(0.25d0/Lam2)) s2 = s*s cpl = 0.d0 y = x + 1.d0 - Q2/(Q2+6.76d0) if (y.GE.1.d0) goto 10 dlg = DLOG(1.d0/x) alfa = PAR(1) alfap = PAR(2) beta = PAR(3) A = PAR(4) + PAR(12)*s B = PAR(5) + PAR(13)*s C = PAR(6) + PAR(14)*s D = PAR(7) + PAR(15)*s E = PAR(8) + PAR(16)*s + PAR(20)*s2 EP = PAR(9) + PAR(17)*s AS = PAR(10) + PAR(18)*s BS = PAR(11) + PAR(19)*s + PAR(21)*s2 cpl = s**alfa*y**AS*(A+B*DSQRT(y)+C*y**BS) cpl = cpl + s**alfap*DEXP(-E + DSQRT(EP*s**beta*dlg)) cpl = 9.d0/(4.d0*Pi)*DLOG(Q2/Lam2)*cpl*(1.d0-y)**D 10 continue END ********** ********** DOUBLE PRECISION FUNCTION bpl(x,Q2,PAR) IMPLICIT DOUBLE PRECISION (a-z) dimension PAR(21) Parameter (Pi=3.1415926535897932d0) Lam2 = 0.221d0*0.221d0 s = DLOG(DLOG(Q2/Lam2)/DLOG(0.25d0/Lam2)) s2 = s*s ds = DSQRT(s) bpl = 0.d0 y = x + 1.d0 - Q2/(Q2+73.96d0) if (y.GE.1.d0) goto 10 dlg = DLOG(1.d0/x) alfa = PAR(1) alfap = PAR(2) beta = PAR(3) A = PAR(4) + PAR(12)*s B = PAR(5) + PAR(13)*s + PAR(20)*s2 C = PAR(6) + PAR(14)*s D = PAR(7) + PAR(15)*s E = PAR(8) + PAR(16)*s EP = PAR(9) + PAR(17)*s + PAR(21)*ds AS = PAR(10) + PAR(18)*s BS = PAR(11) + PAR(19)*s bpl = s**alfa*y**AS*(A+B*DSQRT(y)+C*y**BS) bpl = bpl + s**alfap*DEXP(-E + DSQRT(EP*s**beta*dlg)) bpl = 9.d0/(4.d0*Pi)*DLOG(Q2/Lam2)*bpl*(1.d0-y)**D 10 continue END ******************************************************************** **** HADRON-LIKE **** ******************************************************************** DOUBLE PRECISION FUNCTION val(x,Q2,PAR) IMPLICIT DOUBLE PRECISION (a-z) dimension PAR(10) Parameter (Pi=3.1415926535897932d0) Lam2 = 0.221d0*0.221d0 s = DLOG(DLOG(Q2/Lam2)/DLOG(0.25d0/Lam2)) AC = PAR(1) + PAR(6)*s AS = PAR(2) + PAR(7)*s BC = PAR(3) + PAR(8)*s C = PAR(4) + PAR(9)*s D = PAR(5) + PAR(10)*s val = AC*x**AS*(1.d0+BC*DSQRT(x)+C*x) val = val*(1.d0-x)**D END ********** ********** DOUBLE PRECISION FUNCTION glu(x,Q2,PAR) IMPLICIT DOUBLE PRECISION (a-z) dimension PAR(18) Parameter (Pi=3.1415926535897932d0) Lam2 = 0.221d0*0.221d0 s = DLOG(DLOG(Q2/Lam2)/DLOG(0.25d0/Lam2)) dlg = DLOG(1.d0/x) alfa = PAR(1) beta = PAR(2) AC = PAR(3) + PAR(11)*s BC = PAR(4) + PAR(12)*s C = PAR(5) + PAR(13)*s AS = PAR(6) + PAR(14)*s BS = PAR(7) + PAR(15)*s E = PAR(8) + PAR(16)*s EP = PAR(9) + PAR(17)*s D = PAR(10) + PAR(18)*s glu = x**AS*(AC+BC*DSQRT(x)+C*x) glu = glu + s**alfa*DEXP(-E+DSQRT(EP*s**beta*dlg)) glu = glu*(1.d0-x)**D END ********** ********** DOUBLE PRECISION FUNCTION str(x,Q2,PAR) IMPLICIT DOUBLE PRECISION (a-z) dimension PAR(14) Parameter (Pi=3.1415926535897932d0) Lam2 = 0.221d0*0.221d0 s = DLOG(DLOG(Q2/Lam2)/DLOG(0.25d0/Lam2)) dlg = DLOG(1.d0/x) alfa = PAR(1) AS = PAR(2) + PAR(9)*s AC = PAR(3) + PAR(10)*s BC = PAR(4) + PAR(11)*s D = PAR(5) + PAR(12)*s E = PAR(6) + PAR(13)*s EP = PAR(7) + PAR(14)*s beta = PAR(8) str = s**alfa/(dlg**AS)*(1.d0+AC*DSQRT(x)+BC*x) str = str*(1.d0-x)**D*DEXP(-E+DSQRT(EP*s**beta*dlg)) END ********** ********** DOUBLE PRECISION FUNCTION chm(x,Q2,PAR) IMPLICIT DOUBLE PRECISION (a-z) dimension PAR(17) Parameter (Pi=3.1415926535897932d0) Lam2 = 0.221d0*0.221d0 s = DLOG(DLOG(Q2/Lam2)/DLOG(0.25d0/Lam2)) s2 = s*s chm = 0.d0 y = x + 1.d0 - Q2/(Q2+6.76d0) if (y.GE.1.d0) goto 10 dlg = DLOG(1.d0/x) alfa = PAR(1) AS = PAR(2) + PAR(9)*s AC = PAR(3) + PAR(10)*s BC = PAR(4) + PAR(11)*s D = PAR(5) + PAR(12)*s + PAR(17)*s2 E = PAR(6) + PAR(13)*s + PAR(16)*s2 EP = PAR(7) + PAR(14)*s + PAR(15)*s2 beta = PAR(8) chm = s**alfa/(dlg**AS)*(1.d0+AC*DSQRT(y)+BC*y) chm = chm*(1.d0-y)**D*DEXP(-E+EP*DSQRT(s**beta*dlg)) 10 continue END ********** ********** DOUBLE PRECISION FUNCTION bot(x,Q2,PAR) IMPLICIT DOUBLE PRECISION (a-z) dimension PAR(16) Parameter (Pi=3.1415926535897932d0) Lam2 = 0.221d0*0.221d0 s = DLOG(DLOG(Q2/Lam2)/DLOG(0.25d0/Lam2)) s2 = s*s bot = 0.d0 y = x + 1.d0 - Q2/(Q2+73.96d0) if (y.GE.1.d0) goto 10 dlg = DLOG(1.d0/x) alfa = PAR(1) AS = PAR(2) + PAR(9)*s + PAR(15)*s2 AC = PAR(3) + PAR(10)*s BC = PAR(4) + PAR(11)*s D = PAR(5) + PAR(12)*s + PAR(16)*s2 E = PAR(6) + PAR(13)*s EP = PAR(7) + PAR(14)*s beta = PAR(8) bot = s**alfa/(dlg**AS)*(1.d0+AC*DSQRT(y)+BC*y) bot = bot*(1.d0-y)**D*DEXP(-E+EP*DSQRT(s**beta*dlg)) 10 continue END