]> git.uio.no Git - u/mrichter/AliRoot.git/blame - PDF/spdf/sfwhi6.F
git://git.uio.no / u / mrichter / AliRoot.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
This commit was generated by cvs2svn to compensate for changes in r1907,
[u/mrichter/AliRoot.git] / PDF / spdf / sfwhi6.F
CommitLineData
21886bb6 1*
2* $Id$
3*
4* $Log$
5* Revision 1.1.1.2 1996/10/30 08:30:46 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 SFWHI6(ZX,ZQ,ZUV,ZDV,ZUB,ZDB,ZSB,ZCB,ZGL)
15c-------------------------------------------------------
16c WHIT6 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 WHIT6G
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 WHIT6G
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 WHIT6 quark (U100)
88c
89 A0val= 2.540000d+00+s*( 2.000000d+00)+s2*( 7.180000d-01)
90 A1val= 6.230000d-02+s*(-7.010000d+00)+s2*( 1.251000d-01)
91 A2val=-1.642000d-01+s*(-4.360000d-01)+s2*( 1.048000d+01)
92 $ +s3*(-5.200000d+00)
93 Bval = 6.990000d-01+s*(-2.796000d-02)+s2*(-3.650000d-03)
94 Cval = 4.420000d-01+s*(-1.255000d+00)+s2*( 1.941000d+00)
95 $ +s3*(-9.950000d-01)
96 A0sea= 3.180000d+00+s*( 8.690000d+00)+s2*(-2.287000d+01)
97 $ +s3*( 1.896000d+01)+s4*(-5.140000d+00)
98 B0sea=-1.003000d-01+s*( 1.603000d-01)+s2*(-1.037000d+00)
99 $ +s3*( 9.440000d-01)+s4*(-2.915000d-01)
100 BB0sea=5.690000d+00+s*( 1.867000d+01)+s2*(-4.670000d+01)
101 $ +s3*( 5.050000d+01)+s4*(-1.835000d+01)
102 C0sea= 2.149000d+01+s*(-5.650000d+01)+s2*( 1.293000d+02)
103 $ +s3*(-1.459000d+02)+s4*( 5.750000d+01)
104c
105 qv = prsccf/alinv/x*
106 $ (A0val+A1val*x+A2val*x2) * x**Bval * x1**Cval
107 qsea= prsccf/alinv/x*
108 $ A0sea * x**(B0sea+BB0sea*x) * x1**C0sea
109c
110 qu = qv/3.0d0 + qsea/6.0d0
111 qu = qu*x
112 ZUV=qu
113 ZUB=qu
114 qd = qv/12.0d0 + qsea/6.0d0
115 qd = qd*x
116 ZDV=qd
117 ZDB=qd
118 ZSB=qd
119c
120 if((ic.ne.0) .and. (x*(1.0d0+4.0d0*mc2q2).lt.1.0d0)) then
121 call WHIT6Q(x,mc2q2,cv,cs)
122 qc = cv/alinv/2.0d0/PI + cs*alstpi
123 qc = qc*x
124 ZCB=qc
125 else
126 qc = 0.0d0
127 ZCB=qc
128 endif
129c
130 g = WHIT6G(x,Q2)
131 g = g*x
132 ZGL=g
133c
134 else
135c over 100 GeV^2
136c
137c set scale s
138 s= log( log(Q2/LAM52)/ log(Q52IT/LAM52))
139 prsccf = 1.0d0
140 alstpi = 6.0d0/23.0d0/ log(Q2/LAM52)
141 s2=s**2
142 s3=s2*s
143 s4=s2**2
144c
145cccccc WHIT6 quark (O100)
146c
147 A0val= 4.270000d+00+s*( 3.096000d+00)+s2*( 1.621000d+00)
148 A1val=-4.740000d+00+s*(-6.900000d+00)+s2*(-2.439000d+00)
149 A2val= 2.837000d+00+s*( 6.460000d+00)+s2*( 4.100000d+00)
150 Bval = 6.780000d-01+s*(-3.940000d-02)+s2*( 1.758000d-02)
151 Cval = 1.728000d-01+s*(-2.493000d-02)+s2*( 1.451000d-01)
152 A0sea= 3.340000d+00+s*(-5.610000d+00)+s2*( 5.000000d+01)
153 $ +s3*(-2.207000d+02)+s4*( 3.028000d+02)
154 B0sea=-2.402000d-01+s*(-4.090000d-01)+s2*( 2.263000d+00)
155 $ +s3*(-1.050000d+01)+s4*( 1.487000d+01)
156 BB0sea=8.790000d+00+s*(-8.860000d+00)+s2*( 1.640000d+02)
157 $ +s3*(-7.120000d+02)+s4*( 9.730000d+02)
158 C0sea= 9.160000d+00+s*( 9.290000d+00)+s2*(-2.784000d+02)
159 $ +s3*( 1.175000d+03)+s4*(-1.592000d+03)
160c
161 qv = 1.0d0/alinv/x*
162 $ (A0val+A1val*x+A2val*x2) * x**Bval * x1**Cval
163 qsea= 1.0d0/alinv/x*
164 $ A0sea * x**(B0sea+BB0sea*x) * x1**C0sea
165c
166 qu = qv/3.0d0 + qsea/6.0d0
167 qu = qu*x
168 ZUV=qu
169 ZUB=qu
170 qd = qv/12.0d0 + qsea/6.0d0
171 qd = qd*x
172 ZDV=qd
173 ZDB=qd
174 ZSB=qd
175 g = WHIT6G(x,Q2)
176 g = g*x
177 ZGL=g
178c
179 if((ic.ne.0) .and. (x*(1.0d0+4.0d0*mc2q2).lt.1.0d0)) then
180 A0dcv= s*( 1.219000d-01)+s2*( 6.200000d+00)
181 $ +s3*(-2.504000d+01)+s4*( 3.098000d+01)
182 A1dcv= s*( 1.913000d+00)+s2*(-7.690000d+01)
183 $ +s3*( 3.180000d+02)+s4*(-3.920000d+02)
184 A2dcv= s*(-7.160000d+00)+s2*( 2.503000d+02)
185 $ +s3*(-1.062000d+03)+s4*( 1.308000d+03)
186 A3dcv= s*( 3.190000d+00)+s2*(-2.301000d+02)
187 $ +s3*( 1.012000d+03)+s4*(-1.250000d+03)
188 Bdcv = 4.990000d-01+s*( 3.470000d+00)+s2*(-1.526000d+01)
189 $ +s3*( 1.967000d+01)
190 Cdcv = 3.290000d-01+s*( 8.240000d+00)+s2*(-3.800000d+01)
191 $ +s3*( 4.630000d+01)
192 Adcs = s*(-4.990000d-02)+s2*( 1.026000d-01)
193 $ +s3*(-7.870000d-02)
194 B0dcs=-3.610000d-01+s*(-5.760000d-01)+s2*( 2.257000d-01)
195 B1dcs= 7.680000d+00+s*(-8.830000d+00)+s2*( 3.880000d+00)
196 Cdcs = 2.548000d+00+s*( 6.910000d-01)+s2*(-8.700000d+00)
197 $ +s3*( 1.065000d+01)
198c
199 dcv = 1.0d0/alinv/x*
200 $ (A0dcv+x*A1dcv+x2*A2dcv+x2*x*A3dcv) * x**Bdcv * x1**Cdcv
201 dcs = 1.0d0/alinv/x*
202 $ Adcs * x**(B0dcs+B1dcs*x) * x1**Cdcs
203c
204 call WHIT6Q(x,mc*mc/Q2,cv,cs)
205 qc = cv/alinv/2.0d0/PI + cs*alstpi + dcs + dcv
206 qc = qc*x
207 ZCB=qc
208 else
209 qc = 0.0d0
210 ZCB=qc
211 endif
212 endif
213c
214 return
215 end