]> git.uio.no Git - u/mrichter/AliRoot.git/blame - PDF/spdf/sfwhi5.F
git://git.uio.no / u / mrichter / AliRoot.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Changes to compile on Solaris 10 with f90 (Intel x86 platform). It does't like contin...
[u/mrichter/AliRoot.git] / PDF / spdf / sfwhi5.F
CommitLineData
21886bb6 1*
2* $Id$
3*
4* $Log$
7ef50f50 5* Revision 1.4 2000/09/18 10:02:36 hristov
6* Makefile added to PDF8
7*
21886bb6 8* Revision 1.1.1.2 1996/10/30 08:30:46 cernlib
9* Version 7.04
10*
11* Revision 1.1.1.1 1996/04/12 15:29:46 plothow
12* Version 7.01
13*
14*
15#include "pdf/pilot.h"
16c-------------------------------------------------------
17 subroutine SFWHI5(ZX,ZQ,ZUV,ZDV,ZUB,ZDB,ZSB,ZCB,ZGL)
18c-------------------------------------------------------
19c WHIT5 parton distribution in the photon
20c
21c INPUT: integer ic : if ic=0 then qc=0
22c else qc is calculated
23c DOUBLE PRECISION Q2 : energy scale Q^2 (GeV^2)
24c DOUBLE PRECISION x : energy fraction
25c
26c OUTPUT: DOUBLE PRECISION qu : up-quark dist.
27c DOUBLE PRECISION qd : down- or strange-quark dist.
28c DOUBLE PRECISION qc : charm-quark dist.
29c DOUBLE PRECISION g : gluon dist.
30c-------------------------------------------------------
31c Modified by M.Tanaka on July 22, 1994.
32c The bug pointed out by M.Drees is fixed.
33c-------------------------------------------------------
34c Modified by I.Watanabe on July 22, 1994.
35c-------------------------------------------------------
36 implicit none
37 external WHIT5G
7ef50f50 38#if defined(CERNLIB_DOUBLE)
39 DOUBLE PRECISION
40#endif
41#if defined(CERNLIB_SINGLE)
42 REAL
43#endif
21886bb6 44 + ZX,ZQ,ZUV,ZDV,ZUB,ZDB,ZSB,ZCB,ZGL
45c arg
46 integer ic
47 DOUBLE PRECISION Q2,x
48 DOUBLE PRECISION qu,qd,qc,g
49c const
50 DOUBLE PRECISION q42it,q52it,lam42,lam52
51 DOUBLE PRECISION alinv,mc,PI
52c local
53 DOUBLE PRECISION qv,qsea,cv,cs,dcv,dcs
54 DOUBLE PRECISION A0val,A1val,A2val,Bval,Cval,
55 $ A0sea,B0sea,BB0sea,C0sea
56 DOUBLE PRECISION A0dcv,A1dcv,A2dcv,A3dcv,Bdcv,Cdcv
57 DOUBLE PRECISION Adcs, B0dcs, B1dcs, Cdcs
58 DOUBLE PRECISION x1,x2,mc2q2
59 DOUBLE PRECISION s,s2,s3,s4,prsccf,alstpi
60 DOUBLE PRECISION WHIT5G
61c parameters
62 parameter(lam42=0.16d0, lam52=0.091411319d0)
63 parameter(Q42IT=4.0d0, Q52IT=100.0d0)
64 parameter(alinv=137.036d0, mc=1.5d0)
65 parameter(pi=3.14159265358979323846d0)
66 common /scale/ s,s2,s3,s4,prsccf
67c
68c begin
69 x=ZX
70 Q2=ZQ*ZQ
71 ic=1
72c
73 x1=1.0d0-x
74 x2=x**2
75 mc2q2=mc**2/Q2
76c
77 if(Q2.lt.100.0d0) then
78c under 100 GeV^2
79c
80c set scale s
81 if(Q2.lt.4.0d0) then
82cccc for under 4GeV^2 prescription
83 s= 0.0d0
84 prsccf = log(Q2/LAM42)/ log(Q42IT/LAM42)
85 alstpi = 6.0d0/25.0d0/ log(Q42IT/LAM42)
86 else
87 s= log( log(Q2/LAM42)/ log(Q42IT/LAM42))
88 prsccf = 1.0d0
89 alstpi = 6.0d0/25.0d0/ log(Q2/LAM42)
90 endif
91 s2=s**2
92 s3=s2*s
93 s4=s2**2
94c
95cccccc WHIT5 quark (U100)
96c
97 A0val= 2.540000d+00+s*( 2.000000d+00)+s2*( 7.180000d-01)
98 A1val= 6.230000d-02+s*(-7.010000d+00)+s2*( 1.251000d-01)
99 A2val=-1.642000d-01+s*(-4.360000d-01)+s2*( 1.048000d+01)
100 $ +s3*(-5.200000d+00)
101 Bval = 6.990000d-01+s*(-2.796000d-02)+s2*(-3.650000d-03)
102 Cval = 4.420000d-01+s*(-1.255000d+00)+s2*( 1.941000d+00)
103 $ +s3*(-9.950000d-01)
104 A0sea= 2.227000d+00+s*( 5.720000d+00)+s2*(-1.295000d+01)
105 $ +s3*( 7.220000d+00)+s4*(-2.514000d-01)
106 B0sea=-8.810000d-02+s*( 1.465000d-01)+s2*(-9.750000d-01)
107 $ +s3*( 7.820000d-01)+s4*(-2.074000d-01)
108 BB0sea=3.370000d+00+s*( 1.416000d+01)+s2*(-3.150000d+01)
109 $ +s3*( 2.789000d+01)+s4*(-8.710000d+00)
110 C0sea= 1.581000d+01+s*(-3.630000d+01)+s2*( 7.710000d+01)
111 $ +s3*(-7.810000d+01)+s4*( 2.948000d+01)
112c
113 qv = prsccf/alinv/x*
114 $ (A0val+A1val*x+A2val*x2) * x**Bval * x1**Cval
115 qsea= prsccf/alinv/x*
116 $ A0sea * x**(B0sea+BB0sea*x) * x1**C0sea
117c
118 qu = qv/3.0d0 + qsea/6.0d0
119 qu = qu*x
120 ZUV=qu
121 ZUB=qu
122 qd = qv/12.0d0 + qsea/6.0d0
123 qd = qd*x
124 ZDV=qd
125 ZDB=qd
126 ZSB=qd
127c
128 if((ic.ne.0) .and. (x*(1.0d0+4.0d0*mc2q2).lt.1.0d0)) then
129 call WHIT5Q(x,mc2q2,cv,cs)
130 qc = cv/alinv/2.0d0/PI + cs*alstpi
131 qc = qc*x
132 ZCB=qc
133 else
134 qc = 0.0d0
135 ZCB=qc
136 endif
137c
138 g = WHIT5G(x,Q2)
139 g = g*x
140 ZGL=g
141c
142 else
143c over 100 GeV^2
144c
145c set scale s
146 s= log( log(Q2/LAM52)/ log(Q52IT/LAM52))
147 prsccf = 1.0d0
148 alstpi = 6.0d0/23.0d0/ log(Q2/LAM52)
149 s2=s**2
150 s3=s2*s
151 s4=s2**2
152c
153cccccc WHIT5 quark (O100)
154c
155 A0val= 4.270000d+00+s*( 3.096000d+00)+s2*( 1.617000d+00)
156 A1val=-4.740000d+00+s*(-6.900000d+00)+s2*(-2.417000d+00)
157 A2val= 2.837000d+00+s*( 6.470000d+00)+s2*( 4.070000d+00)
158 Bval = 6.780000d-01+s*(-3.940000d-02)+s2*( 1.750000d-02)
159 Cval = 1.728000d-01+s*(-2.457000d-02)+s2*( 1.440000d-01)
160 A0sea= 2.318000d+00+s*(-3.760000d+00)+s2*( 2.026000d+01)
161 $ +s3*(-5.950000d+01)+s4*( 5.900000d+01)
162 B0sea=-2.425000d-01+s*(-4.360000d-01)+s2*( 1.241000d+00)
163 $ +s3*(-3.510000d+00)+s4*( 3.360000d+00)
164 BB0sea=5.330000d+00+s*(-8.680000d+00)+s2*( 7.420000d+01)
165 $ +s3*(-2.070000d+02)+s4*( 1.967000d+02)
166 C0sea= 8.480000d+00+s*( 9.310000d+00)+s2*(-1.041000d+02)
167 $ +s3*( 2.801000d+02)+s4*(-2.663000d+02)
168c
169 qv = 1.0d0/alinv/x*
170 $ (A0val+A1val*x+A2val*x2) * x**Bval * x1**Cval
171 qsea= 1.0d0/alinv/x*
172 $ A0sea * x**(B0sea+BB0sea*x) * x1**C0sea
173c
174 qu = qv/3.0d0 + qsea/6.0d0
175 qu = qu*x
176 ZUV=qu
177 ZUB=qu
178 qd = qv/12.0d0 + qsea/6.0d0
179 qd = qd*x
180 ZDV=qd
181 ZDB=qd
182 ZSB=qd
183 g = WHIT5G(x,Q2)
184 g = g*x
185 ZGL=g
186c
187 if((ic.ne.0) .and. (x*(1.0d0+4.0d0*mc2q2).lt.1.0d0)) then
188 A0dcv= s*( 1.219000d-01)+s2*( 6.200000d+00)
189 $ +s3*(-2.504000d+01)+s4*( 3.098000d+01)
190 A1dcv= s*( 1.913000d+00)+s2*(-7.690000d+01)
191 $ +s3*( 3.180000d+02)+s4*(-3.920000d+02)
192 A2dcv= s*(-7.160000d+00)+s2*( 2.503000d+02)
193 $ +s3*(-1.062000d+03)+s4*( 1.308000d+03)
194 A3dcv= s*( 3.190000d+00)+s2*(-2.301000d+02)
195 $ +s3*( 1.012000d+03)+s4*(-1.250000d+03)
196 Bdcv = 4.990000d-01+s*( 3.470000d+00)+s2*(-1.526000d+01)
197 $ +s3*( 1.967000d+01)
198 Cdcv = 3.290000d-01+s*( 8.240000d+00)+s2*(-3.800000d+01)
199 $ +s3*( 4.630000d+01)
200 Adcs = s*(-6.580000d-02)+s2*( 1.059000d-01)
201 $ +s3*(-6.630000d-02)
202 B0dcs=-2.750000d-01+s*(-4.760000d-01)+s2*( 1.191000d-01)
203 B1dcs= 6.370000d+00+s*(-5.320000d+00)+s2*( 1.986000d+00)
204 Cdcs = 3.400000d+00+s*( 3.750000d-01)+s2*(-8.790000d+00)
205 $ +s3*( 1.001000d+01)
206c
207 dcv = 1.0d0/alinv/x*
208 $ (A0dcv+x*A1dcv+x2*A2dcv+x2*x*A3dcv) * x**Bdcv * x1**Cdcv
209 dcs = 1.0d0/alinv/x*
210 $ Adcs * x**(B0dcs+B1dcs*x) * x1**Cdcs
211c
212 call WHIT5Q(x,mc*mc/Q2,cv,cs)
213 qc = cv/alinv/2.0d0/PI + cs*alstpi + dcs + dcv
214 qc = qc*x
215 ZCB=qc
216 else
217 qc = 0.0d0
218 ZCB=qc
219 endif
220 endif
221c
222 return
223 end