5 * Revision 1.1.1.2 1996/10/30 08:30:42 cernlib
8 * Revision 1.1.1.1 1996/04/12 15:29:46 plothow
12 #include "pdf/pilot.h"
13 c-------------------------------------------------------
14 subroutine SFWHI1(ZX,ZQ,ZUV,ZDV,ZUB,ZDB,ZSB,ZCB,ZGL)
15 c-------------------------------------------------------
16 c WHIT1 parton distribution in the photon
18 c INPUT: integer ic : if ic=0 then qc=0
19 c else qc is calculated
20 c DOUBLE PRECISION Q2 : energy scale Q^2 (GeV^2)
21 c DOUBLE PRECISION x : energy fraction
23 c OUTPUT: DOUBLE PRECISION qu : up-quark dist.
24 c DOUBLE PRECISION qd : down- or strange-quark dist.
25 c DOUBLE PRECISION qc : charm-quark dist.
26 c DOUBLE PRECISION g : gluon dist.
27 c-------------------------------------------------------
28 c Modified by M.Tanaka on July 22, 1994.
29 c The bug pointed out by M.Drees is fixed.
30 c-------------------------------------------------------
31 c Modified by I.Watanabe on July 22, 1994.
32 c-------------------------------------------------------
35 #include "pdf/expdp.inc"
36 + ZX,ZQ,ZUV,ZDV,ZUB,ZDB,ZSB,ZCB,ZGL
40 DOUBLE PRECISION qu,qd,qc,g
42 DOUBLE PRECISION q42it,q52it,lam42,lam52
43 DOUBLE PRECISION alinv,mc,PI
45 DOUBLE PRECISION qv,qsea,cv,cs,dcv,dcs
46 DOUBLE PRECISION A0val,A1val,A2val,Bval,Cval,
47 $ A0sea,B0sea,BB0sea,C0sea
48 DOUBLE PRECISION A0dcv,A1dcv,A2dcv,A3dcv,Bdcv,Cdcv
49 DOUBLE PRECISION Adcs, B0dcs, B1dcs, Cdcs
50 DOUBLE PRECISION x1,x2,mc2q2
51 DOUBLE PRECISION s,s2,s3,s4,prsccf,alstpi
52 DOUBLE PRECISION WHIT1G
54 parameter(lam42=0.16d0, lam52=0.091411319d0)
55 parameter(Q42IT=4.0d0, Q52IT=100.0d0)
56 parameter(alinv=137.036d0, mc=1.5d0)
57 parameter(pi=3.14159265358979323846d0)
58 common /scale/ s,s2,s3,s4,prsccf
69 if(Q2.lt.100.0d0) then
74 cccc for under 4GeV^2 prescription
76 prsccf = log(Q2/LAM42)/ log(Q42IT/LAM42)
77 alstpi = 6.0d0/25.0d0/ log(Q42IT/LAM42)
79 s= log( log(Q2/LAM42)/ log(Q42IT/LAM42))
81 alstpi = 6.0d0/25.0d0/ log(Q2/LAM42)
87 cccccc WHIT1 quark (U100)
89 A0val= 1.882000d+00+s*( 1.213000d+00)+s2*( 6.970000d-01)
90 A1val= s*(-2.361000d+00)+s2*(-1.136000d+00)
91 A2val= s*( 5.280000d-01)+s2*( 2.406000d+00)
92 Bval = 5.000000d-01+s*( 2.107000d-02)+s2*( 4.130000d-03)
93 Cval = 2.500000d-01+s*(-2.376000d-01)+s2*( 2.018000d-01)
95 A0sea= 6.510000d-01+s*( 1.291000d+00)+s2*(-4.470000d+00)
96 $ +s3*( 5.140000d+00)+s4*(-2.091000d+00)
97 B0sea=-3.820000d-02+s*( 9.010000d-02)+s2*(-1.356000d+00)
98 $ +s3*( 1.582000d+00)+s4*(-6.440000d-01)
99 BB0sea=2.084000d+00+s*( 7.740000d+00)+s2*(-2.970000d+01)
100 $ +s3*( 3.860000d+01)+s4*(-1.705000d+01)
101 C0sea= 7.000000d+00+s*(-1.608000d+01)+s2*( 4.670000d+01)
102 $ +s3*(-5.710000d+01)+s4*( 2.386000d+01)
105 $ (A0val+A1val*x+A2val*x2) * x**Bval * x1**Cval
106 qsea= prsccf/alinv/x*
107 $ A0sea * x**(B0sea+BB0sea*x) * x1**C0sea
109 qu = qv/3.0d0 + qsea/6.0d0
113 qd = qv/12.0d0 + qsea/6.0d0
119 if((ic.ne.0) .and. (x*(1.0d0+4.0d0*mc2q2).lt.1.0d0)) then
120 call WHIT1Q(x,mc2q2,cv,cs)
121 qc = cv/alinv/2.0d0/PI + cs*alstpi
137 s= log( log(Q2/LAM52)/ log(Q52IT/LAM52))
139 alstpi = 6.0d0/23.0d0/ log(Q2/LAM52)
144 cccccc WHIT1 quark (O100)
146 A0val= 3.058000d+00+s*( 2.474000d+00)+s2*( 1.002000d+00)
147 A1val=-2.182000d+00+s*(-4.480000d+00)+s2*(-2.251000d-01)
148 A2val= 1.522000d+00+s*( 4.310000d+00)+s2*( 1.314000d+00)
149 Bval = 5.170000d-01+s*( 4.040000d-02)+s2*(-2.100000d-02)
150 Cval = 1.655000d-01+s*(-2.062000d-02)+s2*( 5.360000d-02)
151 A0sea= 6.250000d-01+s*(-5.890000d-01)+s2*( 4.180000d+00)
152 $ +s3*(-1.206000d+01)+s4*( 1.257000d+01)
153 B0sea=-2.492000d-01+s*(-4.110000d-01)+s2*( 9.660000d-01)
154 $ +s3*(-2.584000d+00)+s4*( 2.670000d+00)
155 BB0sea=2.100000d+00+s*(-5.750000d+00)+s2*( 4.780000d+01)
156 $ +s3*(-1.407000d+02)+s4*( 1.476000d+02)
157 C0sea= 4.780000d+00+s*( 4.860000d+00)+s2*(-4.890000d+01)
158 $ +s3*( 1.477000d+02)+s4*(-1.602000d+02)
161 $ (A0val+A1val*x+A2val*x2) * x**Bval * x1**Cval
163 $ A0sea * x**(B0sea+BB0sea*x) * x1**C0sea
165 qu = qv/3.0d0 + qsea/6.0d0
169 qd = qv/12.0d0 + qsea/6.0d0
178 if((ic.ne.0) .and. (x*(1.0d0+4.0d0*mc2q2).lt.1.0d0)) then
179 A0dcv= s*( 1.219000d-01)+s2*( 6.200000d+00)
180 $ +s3*(-2.504000d+01)+s4*( 3.098000d+01)
181 A1dcv= s*( 1.913000d+00)+s2*(-7.690000d+01)
182 $ +s3*( 3.180000d+02)+s4*(-3.920000d+02)
183 A2dcv= s*(-7.160000d+00)+s2*( 2.503000d+02)
184 $ +s3*(-1.062000d+03)+s4*( 1.308000d+03)
185 A3dcv= s*( 3.190000d+00)+s2*(-2.301000d+02)
186 $ +s3*( 1.012000d+03)+s4*(-1.250000d+03)
187 Bdcv = 4.990000d-01+s*( 3.470000d+00)+s2*(-1.526000d+01)
188 $ +s3*( 1.967000d+01)
189 Cdcv = 3.290000d-01+s*( 8.240000d+00)+s2*(-3.800000d+01)
190 $ +s3*( 4.630000d+01)
191 Adcs = s*(-1.815000d-02)+s2*( 2.043000d-03)
192 $ +s3*(-4.130000d-03)
193 B0dcs=-3.086000d-01+s*(-2.565000d-01)+s2*( 9.840000d-02)
194 B1dcs= 1.376000d+00+s*(-4.630000d-01)+s2*( 1.232000d+00)
195 Cdcs = 3.650000d+00+s*( 7.290000d-01)+s2*(-7.570000d+00)
196 $ +s3*( 7.790000d+00)
199 $ (A0dcv+x*A1dcv+x2*A2dcv+x2*x*A3dcv) * x**Bdcv * x1**Cdcv
201 $ Adcs * x**(B0dcs+B1dcs*x) * x1**Cdcs
203 call WHIT1Q(x,mc*mc/Q2,cv,cs)
204 qc = cv/alinv/2.0d0/PI + cs*alstpi + dcs + dcv