]> git.uio.no Git - u/mrichter/AliRoot.git/blame - PDF/spdf/sfwhi3.F
New classes added AliGenExtFile and AliGenScan.
[u/mrichter/AliRoot.git] / PDF / spdf / sfwhi3.F
CommitLineData
fe4da5cc 1*
2* $Id$
3*
4* $Log$
5* Revision 1.1.1.2 1996/10/30 08:30:44 cernlib
6* Version 7.04
7*
8* Revision 1.1.1.1 1996/04/12 15:29:46 plothow
9* Version 7.01
10*
11*
12#include "pdf/pilot.h"
13c-------------------------------------------------------
14 subroutine SFWHI3(ZX,ZQ,ZUV,ZDV,ZUB,ZDB,ZSB,ZCB,ZGL)
15c-------------------------------------------------------
16c WHIT3 parton distribution in the photon
17c
18c INPUT: integer ic : if ic=0 then qc=0
19c else qc is calculated
20c DOUBLE PRECISION Q2 : energy scale Q^2 (GeV^2)
21c DOUBLE PRECISION x : energy fraction
22c
23c OUTPUT: DOUBLE PRECISION qu : up-quark dist.
24c DOUBLE PRECISION qd : down- or strange-quark dist.
25c DOUBLE PRECISION qc : charm-quark dist.
26c DOUBLE PRECISION g : gluon dist.
27c-------------------------------------------------------
28c Modified by M.Tanaka on July 22, 1994.
29c The bug pointed out by M.Drees is fixed.
30c-------------------------------------------------------
31c Modified by I.Watanabe on July 22, 1994.
32c-------------------------------------------------------
33 implicit none
34 external whit3g
35#include "pdf/expdp.inc"
36 + ZX,ZQ,ZUV,ZDV,ZUB,ZDB,ZSB,ZCB,ZGL
37c arg
38 integer ic
39 DOUBLE PRECISION Q2,x
40 DOUBLE PRECISION qu,qd,qc,g
41c const
42 DOUBLE PRECISION q42it,q52it,lam42,lam52
43 DOUBLE PRECISION alinv,mc,PI
44c local
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 WHIT3g
53c parameters
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
59c
60c begin
61 x=ZX
62 Q2=ZQ*ZQ
63 ic=1
64c
65 x1=1.0d0-x
66 x2=x**2
67 mc2q2=mc**2/Q2
68c
69 if(Q2.lt.100.0d0) then
70c under 100 GeV^2
71c
72c set scale s
73 if(Q2.lt.4.0d0) then
74cccc for under 4GeV^2 prescription
75 s= 0.0d0
76 prsccf = log(Q2/LAM42)/ log(Q42IT/LAM42)
77 alstpi = 6.0d0/25.0d0/ log(Q42IT/LAM42)
78 else
79 s= log( log(Q2/LAM42)/ log(Q42IT/LAM42))
80 prsccf = 1.0d0
81 alstpi = 6.0d0/25.0d0/ log(Q2/LAM42)
82 endif
83 s2=s**2
84 s3=s2*s
85 s4=s2**2
86c
87cccccc WHIT3 quark (U100)
88c
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)
94 $ +s3*(-5.040000d-02)
95 A0sea= 1.587000d+00+s*( 5.050000d+00)+s2*(-1.126000d+01)
96 $ +s3*( 7.560000d+00)+s4*(-1.471000d+00)
97 B0sea=-1.006000d-01+s*( 2.259000d-01)+s2*(-1.195000d+00)
98 $ +s3*( 1.175000d+00)+s4*(-4.460000d-01)
99 BB0sea=5.730000d+00+s*( 2.564000d+01)+s2*(-5.870000d+01)
100 $ +s3*( 6.320000d+01)+s4*(-2.577000d+01)
101 C0sea= 2.136000d+01+s*(-7.290000d+01)+s2*( 1.532000d+02)
102 $ +s3*(-1.679000d+02)+s4*( 6.740000d+01)
103c
104 qv = prsccf/alinv/x*
105 $ (A0val+A1val*x+A2val*x2) * x**Bval * x1**Cval
106 qsea= prsccf/alinv/x*
107 $ A0sea * x**(B0sea+BB0sea*x) * x1**C0sea
108c
109 qu = qv/3.0d0 + qsea/6.0d0
110 qu = qu*x
111 ZUV=qu
112 ZUB=qu
113 qd = qv/12.0d0 + qsea/6.0d0
114 qd = qd*x
115 ZDV=qd
116 ZDB=qd
117 ZSB=qd
118c
119 if((ic.ne.0) .and. (x*(1.0d0+4.0d0*mc2q2).lt.1.0d0)) then
120 call WHIT3Q(x,mc2q2,cv,cs)
121 qc = cv/alinv/2.0d0/PI + cs*alstpi
122 qc = qc*x
123 ZCB=qc
124 else
125 qc = 0.0d0
126 ZCB=qc
127 endif
128c
129 g = WHIT3G(x,Q2)
130 g = g*x
131 ZGL=g
132c
133 else
134c over 100 GeV^2
135c
136c set scale s
137 s= log( log(Q2/LAM52)/ log(Q52IT/LAM52))
138 prsccf = 1.0d0
139 alstpi = 6.0d0/23.0d0/ log(Q2/LAM52)
140 s2=s**2
141 s3=s2*s
142 s4=s2**2
143c
144cccccc WHIT3 quark (O100)
145c
146 A0val= 3.058000d+00+s*( 2.474000d+00)+s2*( 1.002000d+00)
147 A1val=-2.182000d+00+s*(-4.480000d+00)+s2*(-2.264000d-01)
148 A2val= 1.522000d+00+s*( 4.300000d+00)+s2*( 1.315000d+00)
149 Bval = 5.170000d-01+s*( 4.030000d-02)+s2*(-2.097000d-02)
150 Cval = 1.655000d-01+s*(-2.064000d-02)+s2*( 5.370000d-02)
151 A0sea= 1.850000d+00+s*(-3.670000d+00)+s2*( 2.714000d+01)
152 $ +s3*(-1.066000d+02)+s4*( 1.309000d+02)
153 B0sea=-2.299000d-01+s*(-4.970000d-01)+s2*( 2.464000d+00)
154 $ +s3*(-9.950000d+00)+s4*( 1.232000d+01)
155 BB0sea=1.042000d+01+s*(-1.074000d+01)+s2*( 1.327000d+02)
156 $ +s3*(-5.390000d+02)+s4*( 6.560000d+02)
157 C0sea= 4.070000d+00+s*( 4.110000d+00)+s2*(-1.719000d+02)
158 $ +s3*( 7.070000d+02)+s4*(-8.590000d+02)
159c
160 qv = 1.0d0/alinv/x*
161 $ (A0val+A1val*x+A2val*x2) * x**Bval * x1**Cval
162 qsea= 1.0d0/alinv/x*
163 $ A0sea * x**(B0sea+BB0sea*x) * x1**C0sea
164c
165 qu = qv/3.0d0 + qsea/6.0d0
166 qu = qu*x
167 ZUV=qu
168 ZUB=qu
169 qd = qv/12.0d0 + qsea/6.0d0
170 qd = qd*x
171 ZDV=qd
172 ZDB=qd
173 ZSB=qd
174 g = WHIT3G(x,Q2)
175 g = g*x
176 ZGL=g
177c
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.948000d-02)+s2*( 2.861000d-02)
192 $ +s3*(-2.036000d-02)
193 B0dcs=-4.130000d-01+s*(-4.390000d-01)+s2*( 1.810000d-01)
194 B1dcs= 5.190000d+00+s*(-7.400000d+00)+s2*( 3.400000d+00)
195 Cdcs = 2.359000d+00+s*( 9.770000d-01)+s2*(-7.730000d+00)
196 $ +s3*( 9.480000d+00)
197c
198 dcv = 1.0d0/alinv/x*
199 $ (A0dcv+x*A1dcv+x2*A2dcv+x2*x*A3dcv) * x**Bdcv * x1**Cdcv
200 dcs = 1.0d0/alinv/x*
201 $ Adcs * x**(B0dcs+B1dcs*x) * x1**Cdcs
202c
203 call WHIT3Q(x,mc*mc/Q2,cv,cs)
204 qc = cv/alinv/2.0d0/PI + cs*alstpi + dcs + dcv
205 qc = qc*x
206 ZCB=qc
207 else
208 qc = 0.0d0
209 ZCB=qc
210 endif
211 endif
212c
213 return
214 end