]>
Commit | Line | Data |
---|---|---|
1 | #include "isajet/pilot.h" | |
2 | FUNCTION STRUC(X,QSQ,IQ,IH) | |
3 | ||
4 | C | |
5 | C Compute structure functions X*F(X,QSQ) | |
6 | C ISTRUC=1,2 obsolete | |
7 | C ISTRUC=3 for Eichten, Hinchliffe, Lane, and Quigg (1984) | |
8 | C solution 1 | |
9 | C ISTRUC=4 Duke and Owens, Phys. Rev. D30, 49. | |
10 | C solution 1 | |
11 | C ISTRUC=5 CTEQ Collaboration, Phys. Lett. 304B, 159 | |
12 | C fit CTEQ2L (lowest order QCD) | |
13 | C ISTRUC=6 CTEQ Collaboration, Phys. Rev. D51, 4763 (1995) | |
14 | C fit CTEQ3L (lowest order QCD) | |
15 | C ISTRUC=-999 PDFLIB interface. Parameters are passed by call | |
16 | C to PDFSET in READIN. | |
17 | C Quark types-- | |
18 | C IQ=1 2 3 4 5 6 7 8 9 10 11 12 13 | |
19 | C GL UP UB DN DB ST SB CH CB BT BB TP TB | |
20 | C Hadron types-- | |
21 | C IH=+1120 -1120 +1220 -1220 | |
22 | C P AP N AN | |
23 | C | |
24 | C For IBM compatibility require STRUC > SFMIN = 1.E-10 | |
25 | C Ver. 7.23: Simplify type mapping and fix PDF error for pbar | |
26 | C | |
27 | #if defined(CERNLIB_IMPNONE) | |
28 | IMPLICIT NONE | |
29 | #endif | |
30 | #include "isajet/itapes.inc" | |
31 | #include "isajet/qcdpar.inc" | |
32 | C E1STRC contains all the coefficients for Eichten, etal, | |
33 | C solution 1. It is equivalenced to arrays for the 16 sets of | |
34 | C coefficients. | |
35 | DIMENSION E1STRC(6,6,16),E1POW(8),IE1FIT(13) | |
36 | DIMENSION E1UPHI(6,6),E1DNHI(6,6),E1UBHI(6,6),E1GLHI(6,6), | |
37 | $E1STHI(6,6),E1CHHI(6,6),E1BTHI(6,6),E1TPHI(6,6) | |
38 | DIMENSION E1UPLO(6,6),E1DNLO(6,6),E1UBLO(6,6),E1GLLO(6,6), | |
39 | $E1STLO(6,6),E1CHLO(6,6),E1BTLO(6,6),E1TPLO(6,6) | |
40 | EQUIVALENCE (E1UPHI(1,1),E1STRC(1,1,1)) | |
41 | EQUIVALENCE (E1DNHI(1,1),E1STRC(1,1,2)) | |
42 | EQUIVALENCE (E1UBHI(1,1),E1STRC(1,1,3)) | |
43 | EQUIVALENCE (E1GLHI(1,1),E1STRC(1,1,4)) | |
44 | EQUIVALENCE (E1STHI(1,1),E1STRC(1,1,5)) | |
45 | EQUIVALENCE (E1CHHI(1,1),E1STRC(1,1,6)) | |
46 | EQUIVALENCE (E1BTHI(1,1),E1STRC(1,1,7)) | |
47 | EQUIVALENCE (E1TPHI(1,1),E1STRC(1,1,8)) | |
48 | EQUIVALENCE (E1UPLO(1,1),E1STRC(1,1,9)) | |
49 | EQUIVALENCE (E1DNLO(1,1),E1STRC(1,1,10)) | |
50 | EQUIVALENCE (E1UBLO(1,1),E1STRC(1,1,11)) | |
51 | EQUIVALENCE (E1GLLO(1,1),E1STRC(1,1,12)) | |
52 | EQUIVALENCE (E1STLO(1,1),E1STRC(1,1,13)) | |
53 | EQUIVALENCE (E1CHLO(1,1),E1STRC(1,1,14)) | |
54 | EQUIVALENCE (E1BTLO(1,1),E1STRC(1,1,15)) | |
55 | EQUIVALENCE (E1TPLO(1,1),E1STRC(1,1,16)) | |
56 | DIMENSION CHEBX(6),CHEBQ(6) | |
57 | C | |
58 | REAL X,QSQ,STRUC | |
59 | REAL BETA,CHEB1,CHEB2,CHEB3,CHEB4,CHEB5,AMASS,E1POW,FD,CHEBX, | |
60 | $E1STRC,E1UPHI,CHEBQ,AD,ETA3,GUD,ETA2,ETA4,FUD,AUD,GD,E1GLLO, | |
61 | $E1UBLO,E1DNLO,E1STLO,E1TPLO,E1BTLO,E1CHLO,E1UPLO,E1GLHI,E1UBHI, | |
62 | $E1DNHI,E1STHI,E1TPHI,E1BTHI,ETA1,T,TMAX,TMIN,AMQ,Q2MIN,W2,W1, | |
63 | $SFMIN,T1,A1,A0,SS,B1,C2,B2,A2,S,X1,TERM,E1CHHI,Q2,GAMMA | |
64 | INTEGER IQ,IH | |
65 | INTEGER IE1FIT,IFIT,IFIT2,JX,JQ,ISHFT,IIQ | |
66 | C CTEQ declarations | |
67 | REAL A3,A4,A5,SBL,QI,Q,SB,SB2,SB3 | |
68 | INTEGER IFL | |
69 | INTEGER IQPB(13),IQN(13),IQNB(13) | |
70 | #if defined(CERNLIB_SINGLE) | |
71 | REAL SEA,VAL,P012,P34,P5 | |
72 | #endif | |
73 | #if defined(CERNLIB_DOUBLE) | |
74 | DOUBLE PRECISION SEA,VAL,P012,P34,P5 | |
75 | #endif | |
76 | C PDFLIB declarations | |
77 | #if (defined(CERNLIB_PDFLIB))&&(defined(CERNLIB_SINGLE)) | |
78 | REAL DX,DSCALE,DXPDF(-6:6) | |
79 | #endif | |
80 | #if (defined(CERNLIB_PDFLIB))&&(defined(CERNLIB_DOUBLE)) | |
81 | DOUBLE PRECISION DX,DSCALE,DXPDF(-6:6) | |
82 | #endif | |
83 | #if defined(CERNLIB_PDFLIB) | |
84 | INTEGER IQMAP(13) | |
85 | DATA IQMAP/0,2,-2,1,-1,3,-3,4,-4,5,-5,6,-6/ | |
86 | #endif | |
87 | C | |
88 | C Map pbar, n, nbar types to p type | |
89 | DATA IQPB/1,3,2,5,4,7,6,9,8,11,10,13,12/ | |
90 | DATA IQN /1,4,5,2,3,6,7,8,9,10,11,12,13/ | |
91 | DATA IQNB/1,5,4,3,2,7,6,9,8,11,10,13,12/ | |
92 | C | |
93 | C Eichten etal solution 1 constants | |
94 | C corrected coefficients from Ian Hinchliffe, 3 June 1986. | |
95 | DATA E1UPHI/ | |
96 | $ 0.76772, -0.20874, -0.33026, -0.02517, -0.01570, -0.00010, | |
97 | $ -0.53259, -0.26612, 0.32007, 0.11918, 0.02434, 0.00762, | |
98 | $ 0.21618, 0.18812, -0.08375, -0.06515, -0.01743, -0.00504, | |
99 | $ -0.09211, -0.09952, 0.01373, 0.02506, 0.00877, 0.00255, | |
100 | $ 0.03670, 0.04409, 0.00096, -0.00796, -0.00342, -0.00105, | |
101 | $ -0.01549, -0.02026, -0.00306, 0.00222, 0.00124, 0.00041/ | |
102 | DATA E1DNHI/ | |
103 | $ 0.38130, -0.08090, -0.16336, -0.02185, -0.00843, -0.00062, | |
104 | $ -0.29475, -0.14348, 0.16650, 0.06638, 0.01473, 0.00408, | |
105 | $ 0.12518, 0.10422, -0.04722, -0.03683, -0.01038, -0.00286, | |
106 | $ -0.05478, -0.05678, 0.00890, 0.01484, 0.00534, 0.00152, | |
107 | $ 0.02220, 0.02567, -0.00003, -0.00497, -0.00216, -0.00065, | |
108 | $ -0.00953, -0.01204, -0.00151, 0.00151, 0.00083, 0.00027/ | |
109 | DATA E1UBHI/ | |
110 | $ 0.06870, -0.06861, 0.02973, -0.00540, 0.00378, -0.00097, | |
111 | $ -0.01802, 0.00014, 0.00649, -0.00854, 0.00122, -0.00175, | |
112 | $ -0.00465, 0.00148, -0.00593, 0.00060, -0.00103, -0.00008, | |
113 | $ 0.00644, 0.00257, 0.00283, 0.00115, 0.00071, 0.00033, | |
114 | $ -0.00393, -0.00254, -0.00116, -0.00077, -0.00036, -0.00019, | |
115 | $ 0.00234, 0.00193, 0.00053, 0.00037, 0.00016, 0.00009/ | |
116 | DATA E1GLHI/ | |
117 | $ 0.94819, -0.95779, 0.10085, -0.10510, 0.03456, -0.03054, | |
118 | $ -0.96265, 0.53790, 0.33684, -0.09525, 0.01488, -0.02051, | |
119 | $ 0.43004, -0.08306, -0.33719, 0.04902, -0.00916, 0.01041, | |
120 | $ -0.19249, -0.01790, 0.21830, 0.00749, 0.00414, -0.00186, | |
121 | $ 0.08183, 0.01926, -0.10718, -0.01944, -0.00277, -0.00052, | |
122 | $ -0.03884, -0.01234, 0.05410, 0.01879, 0.00335, 0.00104/ | |
123 | DATA E1STHI/ | |
124 | $ 0.04968, -0.04173, 0.02102, -0.00327, 0.00324, -0.00067, | |
125 | $ -0.00615, -0.01294, 0.00674, -0.00689, 0.00090, -0.00151, | |
126 | $ -0.00858, 0.00505, -0.00490, -0.00016, -0.00094, -0.00015, | |
127 | $ 0.00784, 0.00151, 0.00222, 0.00140, 0.00070, 0.00035, | |
128 | $ -0.00441, -0.00222, -0.00089, -0.00085, -0.00036, -0.00020, | |
129 | $ 0.00252, 0.00184, 0.00041, 0.00039, 0.00016, 0.00009/ | |
130 | DATA E1CHHI/ | |
131 | $ 0.00927, -0.01817, 0.00959, -0.00639, 0.00169, -0.00154, | |
132 | $ 0.00571, -0.01188, 0.00609, -0.00465, 0.00124, -0.00131, | |
133 | $ -0.00396, 0.00710, -0.00359, 0.00184, -0.00039, 0.00034, | |
134 | $ 0.00112, -0.00196, 0.00112, -0.00048, 0.00010, -0.00004, | |
135 | $ 0.00004, -0.00003, -0.00018, 0.00009, -0.00005, -0.00002, | |
136 | $ -0.00042, 0.00073, -0.00016, 0.00005, 0.00005, 0.00005/ | |
137 | DATA E1BTHI/ | |
138 | $ 0.00901, -0.01401, 0.00715, -0.00413, 0.00126, -0.00104, | |
139 | $ 0.00628, -0.00932, 0.00478, -0.00289, 0.00091, -0.00082, | |
140 | $ -0.00293, 0.00409, -0.00189, 0.00076, -0.00023, 0.00014, | |
141 | $ 0.00039, -0.00120, 0.00044, -0.00025, 0.00002, -0.00002, | |
142 | $ 0.00026, 0.00014, -0.00008, 0.00010, 0.00001, 0.00001, | |
143 | $ -0.00026, 0.00032, 0.00001, -0.00001, 0.00001, -0.00001/ | |
144 | DATA E1TPHI/ | |
145 | $ 0.00441, -0.00748, 0.00377, -0.00258, 0.00073, -0.00071, | |
146 | $ 0.00384, -0.00605, 0.00303, -0.00203, 0.00058, -0.00059, | |
147 | $ -0.00088, 0.00166, -0.00075, 0.00047, -0.00010, 0.00010, | |
148 | $ -0.00008, -0.00015, 0.00012, -0.00009, 0.00003, 0.00000, | |
149 | $ 0.00013, -0.00022, -0.00002, -0.00002, -0.00002, -0.00002, | |
150 | $ -0.00007, 0.00019, -0.00004, 0.00002, 0.00000, 0.00000/ | |
151 | DATA E1UPLO/ | |
152 | $ 0.23946, 0.29055, 0.09778, 0.02149, 0.00344, 0.00050, | |
153 | $ 0.01751, -0.00609, -0.02687, -0.01916, -0.00797, -0.00275, | |
154 | $ -0.00576, -0.00504, 0.00108, 0.00249, 0.00153, 0.00075, | |
155 | $ 0.00174, 0.00196, 0.00030, -0.00034, -0.00029, -0.00018, | |
156 | $ -0.00053, -0.00064, -0.00017, 0.00004, 0.00006, 0.00004, | |
157 | $ 0.00017, 0.00022, 0.00008, 0.00001, -0.00001, -0.00001/ | |
158 | DATA E1DNLO/ | |
159 | $ 0.12613, 0.13542, 0.03958, 0.00824, 0.00166, 0.00045, | |
160 | $ 0.00389, -0.01159, -0.01625, -0.00961, -0.00371, -0.00126, | |
161 | $ -0.00191, -0.00056, 0.00159, 0.00159, 0.00084, 0.00039, | |
162 | $ 0.00064, 0.00049, -0.00015, -0.00029, -0.00018, -0.00010, | |
163 | $ -0.00020, -0.00019, 0.00000, 0.00006, 0.00004, 0.00003, | |
164 | $ 0.00007, 0.00008, 0.00002, -0.00001, -0.00001, -0.00001/ | |
165 | DATA E1UBLO/ | |
166 | $ 1.01386, -1.10585, 0.33739, -0.07444, 0.00885, -0.00087, | |
167 | $ 0.92334, -1.28541, 0.44755, -0.09786, 0.01419, -0.00112, | |
168 | $ 0.04888, -0.12708, 0.08606, -0.02608, 0.00478, -0.00060, | |
169 | $ -0.02691, 0.04887, -0.01771, 0.00162, 0.00025, -0.00006, | |
170 | $ 0.00704, -0.01113, 0.00159, 0.00070, -0.00020, 0.00000, | |
171 | $ -0.00171, 0.00229, 0.00038, -0.00035, 0.00004, 0.00001/ | |
172 | DATA E1GLLO/ | |
173 | $ 29.47734,-39.02468, 14.63570, -3.33516, 0.50538, -0.05915, | |
174 | $ 25.58960,-39.54527, 16.61420, -4.29861, 0.69036, -0.08243, | |
175 | $ -1.66291, 1.17624, 1.11844, -0.70986, 0.19481, -0.02404, | |
176 | $ -0.21679, 0.81705, -0.71688, 0.18507, -0.01924, -0.00325, | |
177 | $ 0.20880, -0.43547, 0.22391, -0.02446, -0.00362, 0.00191, | |
178 | $ -0.09097, 0.16009, -0.05681, -0.00250, 0.00258, -0.00047/ | |
179 | DATA E1STLO/ | |
180 | $ 0.92351, -1.08483, 0.34642, -0.07210, 0.00914, -0.00091, | |
181 | $ 0.93146, -1.27376, 0.45122, -0.09775, 0.01380, -0.00131, | |
182 | $ 0.04739, -0.12960, 0.08482, -0.02642, 0.00476, -0.00057, | |
183 | $ -0.02653, 0.04953, -0.01735, 0.00175, 0.00028, -0.00006, | |
184 | $ 0.00694, -0.01132, 0.00148, 0.00065, -0.00021, 0.00000, | |
185 | $ -0.00168, 0.00234, 0.00042, -0.00034, 0.00005, 0.00001/ | |
186 | DATA E1CHLO/ | |
187 | $ 0.80983, -1.04168, 0.33980, -0.06824, 0.00876, -0.00090, | |
188 | $ 0.89606, -1.21708, 0.43386, -0.09287, 0.01304, -0.00129, | |
189 | $ 0.03058, -0.10402, 0.07604, -0.02415, 0.00460, -0.00050, | |
190 | $ -0.02451, 0.04432, -0.01651, 0.00143, 0.00012, -0.00010, | |
191 | $ 0.01122, -0.01457, 0.00268, 0.00058, -0.00012, 0.00003, | |
192 | $ -0.00773, 0.00733, -0.00076, -0.00024, 0.00001, 0.00000/ | |
193 | DATA E1BTLO/ | |
194 | $ 0.80288, -1.07532, 0.37920, -0.07843, 0.01007, -0.00109, | |
195 | $ 0.79033, -1.09887, 0.41532, -0.09301, 0.01317, -0.00141, | |
196 | $ -0.01704, -0.01130, 0.02882, -0.01341, 0.00304, -0.00036, | |
197 | $ -0.00072, 0.00723, -0.00516, 0.00108, -0.00005, -0.00004, | |
198 | $ 0.00305, -0.00461, 0.00166, -0.00013, -0.00001, 0.00001, | |
199 | $ -0.00436, 0.00523, -0.00161, 0.00020, -0.00002, 0.00000/ | |
200 | DATA E1TPLO/ | |
201 | $ 0.66233, -0.92481, 0.35193, -0.07930, 0.01110, -0.00118, | |
202 | $ 0.63797, -0.90619, 0.35816, -0.08479, 0.01265, -0.00139, | |
203 | $ -0.02581, 0.02125, 0.00419, -0.00498, 0.00149, -0.00021, | |
204 | $ 0.00071, 0.00053, -0.00127, 0.00039, -0.00005, -0.00001, | |
205 | $ 0.00385, -0.00506, 0.00186, -0.00035, 0.00004, 0.00000, | |
206 | $ -0.00353, 0.00446, -0.00150, 0.00027, -0.00003, 0.00000/ | |
207 | C E1POW gives powers of (1-x). | |
208 | C IE1FIT points to fit for each value of IQ. | |
209 | DATA E1POW/3.,4.,7.,5.,7.,7.,7.,7./ | |
210 | DATA IE1FIT/4,1,3,2,3,5,5,6,6,7,7,8,8/ | |
211 | C Minimum value for STRUC | |
212 | DATA SFMIN/1.E-10/ | |
213 | C | |
214 | C | |
215 | BETA(W1,W2)=GAMMA(W1)*GAMMA(W2)/GAMMA(W1+W2) | |
216 | C Chebyshev polynomials | |
217 | CHEB1(X)=X | |
218 | CHEB2(X)=2.*X**2-1. | |
219 | CHEB3(X)=X*(-3.+4.*X**2) | |
220 | CHEB4(X)=1.+X**2*(-8.+8.*X**2) | |
221 | CHEB5(X)=X*(5.+X**2*(-20.+16.*X**2)) | |
222 | C | |
223 | C Entry -- check for unphysical X | |
224 | C | |
225 | IF(X.LE.0..OR.X.GE..9999) THEN | |
226 | STRUC=0. | |
227 | GO TO 9999 | |
228 | ENDIF | |
229 | C | |
230 | C Determine equivalent quark type IIQ for proton | |
231 | C | |
232 | IF(IH.EQ.1120) THEN | |
233 | IIQ=IQ | |
234 | ELSEIF(IH.EQ.-1120) THEN | |
235 | IIQ=IQPB(IQ) | |
236 | ELSEIF(IH.EQ.1220) THEN | |
237 | IIQ=IQN(IQ) | |
238 | ELSEIF(IH.EQ.-1220) THEN | |
239 | IIQ=IQNB(IQ) | |
240 | ELSE | |
241 | C This should never happen | |
242 | STRUC=0 | |
243 | RETURN | |
244 | ENDIF | |
245 | C | |
246 | C Select structure function fit. | |
247 | C | |
248 | IF(ISTRUC.EQ.3) GO TO 1000 | |
249 | IF(ISTRUC.EQ.4) GO TO 2000 | |
250 | IF(ISTRUC.EQ.5) GO TO 3000 | |
251 | IF(ISTRUC.EQ.6) GO TO 3100 | |
252 | #if defined(CERNLIB_PDFLIB) | |
253 | IF(ISTRUC.EQ.-999) GO TO 9000 | |
254 | #endif | |
255 | STRUC=0. | |
256 | GO TO 9999 | |
257 | C | |
258 | C Calculate Eichten etal structure fcn for type IIQ | |
259 | C | |
260 | 1000 STRUC=0. | |
261 | Q2=QSQ | |
262 | IF(Q2.LT.5.) Q2=5. | |
263 | T=ALOG(Q2/ALAM2) | |
264 | TMAX=ALOG(1.E8/ALAM2) | |
265 | IF(IIQ.GT.9) GO TO 1001 | |
266 | Q2MIN=5. | |
267 | GO TO 1002 | |
268 | 1001 AMQ=AMASS(IIQ/2) | |
269 | Q2MIN=4.*AMQ**2/(1.-X) | |
270 | IF(Q2.LT.Q2MIN) GO TO 9999 | |
271 | 1002 TMIN=ALOG(Q2MIN/ALAM2) | |
272 | T1=(2.*T-(TMAX+TMIN))/(TMAX-TMIN) | |
273 | CHEBQ(1)=1. | |
274 | CHEBQ(2)=CHEB1(T1) | |
275 | CHEBQ(3)=CHEB2(T1) | |
276 | CHEBQ(4)=CHEB3(T1) | |
277 | CHEBQ(5)=CHEB4(T1) | |
278 | CHEBQ(6)=CHEB5(T1) | |
279 | C x.gt.0.1 | |
280 | IF(X.LT.0.1) GO TO 1010 | |
281 | X1=(2.*X-1.1)/.9 | |
282 | ISHFT=0 | |
283 | GO TO 1020 | |
284 | C x.lt.0.1 | |
285 | 1010 X1=(2.*ALOG(X)+11.51293)/6.90776 | |
286 | ISHFT=8 | |
287 | C IFIT is pointer for Eichten quark type. | |
288 | C IFIT2 is pointer for function -- shifted by 8 for x<0.1 | |
289 | 1020 IFIT=IE1FIT(IIQ) | |
290 | IFIT2=IFIT+ISHFT | |
291 | CHEBX(1)=1. | |
292 | CHEBX(2)=CHEB1(X1) | |
293 | CHEBX(3)=CHEB2(X1) | |
294 | CHEBX(4)=CHEB3(X1) | |
295 | CHEBX(5)=CHEB4(X1) | |
296 | CHEBX(6)=CHEB5(X1) | |
297 | TERM=0. | |
298 | DO 1030 JQ=1,6 | |
299 | DO 1030 JX=1,6 | |
300 | 1030 TERM=TERM+E1STRC(JX,JQ,IFIT2)*CHEBQ(JQ)*CHEBX(JX) | |
301 | TERM=TERM*(1.-X)**E1POW(IFIT) | |
302 | STRUC=ABS(TERM) | |
303 | IF(IFIT.GT.2) GO TO 9999 | |
304 | C Add sea term for valence quarks | |
305 | TERM=0. | |
306 | DO 1040 JQ=1,6 | |
307 | DO 1040 JX=1,6 | |
308 | 1040 TERM=TERM+E1STRC(JX,JQ,3+ISHFT)*CHEBQ(JQ)*CHEBX(JX) | |
309 | TERM=TERM*(1.-X)**E1POW(3) | |
310 | STRUC=STRUC+ABS(TERM) | |
311 | GO TO 9999 | |
312 | C | |
313 | C Calculate Duke-Owens structure function for type IIQ. | |
314 | C | |
315 | 2000 STRUC=0. | |
316 | Q2=QSQ | |
317 | IF(Q2.LT.4.) Q2=4. | |
318 | S=ALOG(ALOG(Q2/ALAM2)/ALOG(4./ALAM2)) | |
319 | SS=S*S | |
320 | C x*f(x) for gl | |
321 | IF(IIQ.EQ.1) THEN | |
322 | A0=1.56-1.71*S+.638*SS | |
323 | A1=-0.949*S+.325*SS | |
324 | B1=6.+1.44*S-1.05*SS | |
325 | A2=9.-7.19*S+.255*SS | |
326 | B2=-16.5*S+10.9*SS | |
327 | C2=15.3*S-10.1*SS | |
328 | STRUC=A0*X**A1*(1.-X)**B1*(1.+A2*X+B2*X**2+C2*X**3) | |
329 | C x*f(x) for up,ub,dn,db,st,sb | |
330 | ELSEIF(IIQ.LE.7) THEN | |
331 | A0=1.265-1.132*S+.293*SS | |
332 | A1=-.372*S-.029*SS | |
333 | B1=8.05+1.59*S-.153*SS | |
334 | A2=6.31*S-.273*SS | |
335 | B2=-10.5*S-3.17*SS | |
336 | C2=14.7*S+9.80*SS | |
337 | STRUC=A0*X**A1*(1.-X)**B1*(1.+A2*X+B2*X**2+C2*X**3)/6. | |
338 | IF(IIQ.EQ.2.OR.IIQ.EQ.4) THEN | |
339 | ETA1=.419+.004*S-.007*SS | |
340 | ETA2=3.46+.724*S-.066*SS | |
341 | GUD=4.40-4.86*S+1.33*SS | |
342 | ETA3=.763-.237*S+.026*SS | |
343 | ETA4=4.00+.627*S-.019*SS | |
344 | GD=-.421*S+.033*SS | |
345 | AUD=3./(BETA(ETA1,ETA2+1.)*(1.+GUD*ETA1/(ETA1+ETA2+1.))) | |
346 | FUD=AUD*X**ETA1*(1.-X)**ETA2*(1.+GUD*X) | |
347 | AD=1./(BETA(ETA3,ETA4+1.)*(1.+GD*ETA3/(ETA3+ETA4+1.))) | |
348 | FD=AD*X**ETA3*(1.-X)**ETA4*(1.+GD*X) | |
349 | IF(IIQ.EQ.2) STRUC=STRUC+FUD-FD | |
350 | IF(IIQ.EQ.4) STRUC=STRUC+FD | |
351 | ENDIF | |
352 | C x*f(x) for ch,cb | |
353 | ELSEIF(IIQ.LE.9) THEN | |
354 | A0=.135*S-.0075*SS | |
355 | A1=-.036-.222*S-.058*SS | |
356 | B1=6.35+3.26*S-.909*SS | |
357 | A2=-3.03*S+1.50*SS | |
358 | B2=17.4*S-11.3*SS | |
359 | C2=-17.9*S+15.6*SS | |
360 | STRUC=A0*X**A1*(1.-X)**B1*(1.+A2*X+B2*X**2+C2*X**3) | |
361 | C x*f(x)=0 for bt,bb,tp,tb | |
362 | ELSE | |
363 | STRUC=0. | |
364 | ENDIF | |
365 | GO TO 9999 | |
366 | C | |
367 | C Calculate CTEQ2L distribution for type IIQ | |
368 | C | |
369 | 3000 STRUC=0 | |
370 | IFL=IIQ/2 | |
371 | C Set up thresholds | |
372 | Q=SQRT(QSQ) | |
373 | IF(IFL.LE.4) THEN | |
374 | QI=1.6 | |
375 | ELSEIF(IFL.EQ.5) THEN | |
376 | QI=5.0 | |
377 | ELSEIF(IFL.EQ.6) THEN | |
378 | QI=180 | |
379 | ELSE | |
380 | RETURN | |
381 | ENDIF | |
382 | IF(Q.LT.QI) THEN | |
383 | Q=QI | |
384 | IF(IFL.GE.4) GO TO 9999 | |
385 | ENDIF | |
386 | C Hard code lambda=0.190 | |
387 | SBL=LOG(Q/0.190)/LOG(QI/0.190) | |
388 | SB=LOG (SBL) | |
389 | SB2=SB*SB | |
390 | SB3=SB2*SB | |
391 | C Calculate sea part | |
392 | IF(IFL.EQ.0) THEN | |
393 | A0=EXP(-0.6510E+00-0.1128E+01*SB-0.6239E-01*SB2-0.8838E-01*SB3) | |
394 | A1=-0.2590E+00+0.1822E+00*SB-0.2682E+00*SB2+0.9422E-01*SB3 | |
395 | A2= 0.4607E+01+0.7792E+00*SB+0.8937E+00*SB2-0.5553E+00*SB3 | |
396 | A3= 0.1627E+02-0.1114E+02*SB+0.4928E+01*SB2-0.1715E+01*SB3 | |
397 | A4= 0.1236E+01+0.1945E+00*SB-0.3297E+00*SB2+0.6489E-01*SB3 | |
398 | A5= 0.0000E+00+0.3346E+01*SB-0.2337E+01*SB2+0.7850E+00*SB3 | |
399 | ELSEIF(IFL.EQ.1) THEN | |
400 | A0=EXP(-0.1508E+01-0.5560E+00*SB-0.3523E+00*SB2+0.6562E-01*SB3) | |
401 | A1=-0.3223E+00+0.2095E-01*SB-0.2049E-02*SB2-0.3475E-01*SB3 | |
402 | A2= 0.9469E+01-0.3923E+01*SB+0.4333E+01*SB2-0.1654E+01*SB3 | |
403 | A3= 0.1646E+02-0.1082E+02*SB+0.8941E+01*SB2-0.5494E+01*SB3 | |
404 | A4= 0.2908E+01+0.2162E+01*SB-0.3233E+01*SB2+0.1267E+01*SB3 | |
405 | A5=-0.5819E+00+0.3914E+00*SB+0.6460E+00*SB2-0.3239E+00*SB3 | |
406 | ELSEIF(IFL.EQ.2) THEN | |
407 | A0=EXP(-0.1951E+01-0.3435E+01*SB+0.3424E+01*SB2-0.1249E+01*SB3) | |
408 | A1=-0.2942E+00+0.4408E+00*SB-0.5453E+00*SB2+0.1552E+00*SB3 | |
409 | A2= 0.9782E+01-0.3454E+01*SB+0.4510E+01*SB2-0.1649E+01*SB3 | |
410 | A3= 0.4999E+02-0.1993E+02*SB-0.2039E+01*SB2+0.5694E+00*SB3 | |
411 | A4= 0.1938E+01-0.1351E+01*SB+0.1386E+01*SB2-0.5324E+00*SB3 | |
412 | A5=-0.2410E+00+0.3434E+01*SB-0.3334E+01*SB2+0.1067E+01*SB3 | |
413 | ELSEIF(IFL.EQ.3) THEN | |
414 | A0=EXP(-0.1804E+01-0.4381E+01*SB-0.3699E+00*SB2+0.3878E+00*SB3) | |
415 | A1=-0.1000E-02-0.9334E+00*SB+0.7156E+00*SB2-0.2029E+00*SB3 | |
416 | A2= 0.6896E+01+0.2462E+01*SB-0.2885E+01*SB2+0.8701E+00*SB3 | |
417 | A3= 0.0000E+00+0.5589E+01*SB+0.1047E+02*SB2+0.3000E+02*SB3 | |
418 | A4= 0.1000E-02-0.5600E-02*SB+0.5618E-02*SB2+0.6598E-02*SB3 | |
419 | A5= 0.0000E+00-0.3151E+01*SB+0.4025E+01*SB2-0.1232E+01*SB3 | |
420 | ELSEIF(IFL.EQ.4) THEN | |
421 | A0=SB**0.7860E+00*EXP(-0.5041E+01-0.3357E+00*SB-0.4718E+00*SB2) | |
422 | A1=-0.4989E+00+0.9571E+00*SB-0.1359E+01*SB2+0.5384E+00*SB3 | |
423 | A2= 0.5986E+01-0.8541E+01*SB+0.1274E+02*SB2-0.5275E+01*SB3 | |
424 | A3= 0.8121E+01-0.1753E+02*SB+0.2194E+02*SB2-0.8538E+01*SB3 | |
425 | A4= 0.9290E-01-0.4390E+00*SB+0.6162E+00*SB2-0.2231E+00*SB3 | |
426 | A5=-0.1257E+01+0.5677E+01*SB-0.5977E+01*SB2+0.2387E+01*SB3 | |
427 | ELSEIF(IFL.EQ.5) THEN | |
428 | A0=SB**0.4537E+00*EXP(-0.3269E+01-0.5398E+01*SB+0.2893E+01*SB2) | |
429 | A1=-0.1977E+00-0.4126E+00*SB+0.7058E+00*SB2-0.4038E+00*SB3 | |
430 | A2= 0.4522E+01+0.6167E-01*SB-0.1849E+00*SB2+0.7345E+00*SB3 | |
431 | A3=-0.1003E+01+0.1531E+01*SB+0.4515E+01*SB2-0.4368E+01*SB3 | |
432 | A4= 0.3579E-01+0.1919E+00*SB-0.7268E+00*SB2+0.5192E+00*SB3 | |
433 | A5= 0.5129E+00+0.2447E+01*SB-0.1989E+01*SB2+0.7529E+00*SB3 | |
434 | ELSEIF(IFL.EQ.6) THEN | |
435 | A0=SB**0.7178E+00*EXP(-0.7327E+01+0.2277E+01*SB+0.3913E+01*SB2) | |
436 | A1=-0.9842E-01-0.2362E+01*SB+0.8851E+01*SB2-0.7208E+01*SB3 | |
437 | A2= 0.5552E+01-0.8935E+01*SB+0.2676E+02*SB2-0.1344E+02*SB3 | |
438 | A3= 0.1593E+01-0.3505E+01*SB-0.1234E+01*SB2-0.1867E+02*SB3 | |
439 | A4=-0.1723E+00+0.1530E+01*SB+0.2323E+01*SB2-0.9344E+01*SB3 | |
440 | A5= 0.2081E+01+0.1939E+01*SB-0.3273E+01*SB2+0.9935E+01*SB3 | |
441 | ENDIF | |
442 | P012=A0*(X**A1)*((1.-X)**A2) | |
443 | P34=(1.+A3*(X**A4)) | |
444 | P5=(LOG(1.+1./X))**A5 | |
445 | SEA=P012*P34*P5 | |
446 | C Add valence part | |
447 | IF(IIQ.NE.2.AND.IIQ.NE.4) THEN | |
448 | STRUC=SEA | |
449 | GO TO 9999 | |
450 | ELSEIF(IIQ.EQ.2) THEN | |
451 | A0=EXP(-0.1806E+01-0.6672E-01*SB-0.2605E+00*SB2+0.2341E-01*SB3) | |
452 | A1= 0.1750E+00+0.3872E-01*SB-0.2189E-01*SB2+0.1415E-01*SB3 | |
453 | A2= 0.3322E+01+0.7786E+00*SB-0.2902E+00*SB2+0.1517E+00*SB3 | |
454 | A3= 0.4414E+02-0.1987E+02*SB+0.2597E+01*SB2+0.2670E+01*SB3 | |
455 | A4= 0.9610E+00-0.2864E+00*SB-0.5524E-01*SB2+0.6229E-01*SB3 | |
456 | A5= 0.0000E+00+0.2658E+00*SB-0.4728E-02*SB2+0.6048E-01*SB3 | |
457 | ELSEIF(IIQ.EQ.4) THEN | |
458 | A0=EXP( 0.8000E-01+0.7364E+00*SB-0.2714E+01*SB2+0.1311E+01*SB3) | |
459 | A1= 0.4930E+00-0.2001E+00*SB+0.5784E+00*SB2-0.2915E+00*SB3 | |
460 | A2= 0.3001E+01+0.3538E+01*SB-0.6155E+01*SB2+0.3083E+01*SB3 | |
461 | A3=-0.1000E+01+0.3871E+01*SB-0.8334E+01*SB2+0.4219E+01*SB3 | |
462 | A4= 0.2986E+01+0.1597E+01*SB-0.3368E+01*SB2+0.1644E+01*SB3 | |
463 | A5= 0.0000E+00-0.9256E+00*SB+0.3570E+01*SB2-0.1777E+01*SB3 | |
464 | ENDIF | |
465 | P012=A0*(X**A1)*((1.-X)**A2) | |
466 | P34=(1.+A3*(X**A4)) | |
467 | P5=(LOG(1.+1./X))**A5 | |
468 | VAL=P012*P34*P5 | |
469 | STRUC=VAL+SEA | |
470 | GO TO 9999 | |
471 | C | |
472 | C Calculate CTEQ3L distribution for type IIQ | |
473 | C | |
474 | 3100 STRUC=0 | |
475 | IFL=IIQ/2 | |
476 | C Set up thresholds | |
477 | Q=SQRT(QSQ) | |
478 | IF(IFL.LE.4) THEN | |
479 | QI=1.6 | |
480 | ELSEIF(IFL.EQ.5) THEN | |
481 | QI=5.0 | |
482 | ELSEIF(IFL.EQ.6) THEN | |
483 | QI=180 | |
484 | ELSE | |
485 | RETURN | |
486 | ENDIF | |
487 | IF(Q.LT.QI) THEN | |
488 | Q=QI | |
489 | IF(IFL.GE.4) GO TO 9999 | |
490 | ENDIF | |
491 | C Hard code lambda=0.177 | |
492 | SBL=LOG(Q/0.177)/LOG(QI/0.177) | |
493 | SB=LOG (SBL) | |
494 | SB2=SB*SB | |
495 | SB3=SB2*SB | |
496 | C Calculate sea part | |
497 | IF(IFL.EQ.0) THEN | |
498 | A0=Exp(-0.7631E+00-0.7241E+00*SB -0.1170E+01*SB2+0.5343E+00*SB3) | |
499 | A1=-0.3573E+00+0.3469E+00*SB -0.3396E+00*SB2+0.9188E-01*SB3 | |
500 | A2= 0.5604E+01+0.7458E+00*SB -0.5082E+00*SB2+0.1844E+00*SB3 | |
501 | A3= 0.1549E+02-0.1809E+02*SB +0.1162E+02*SB2-0.3483E+01*SB3 | |
502 | A4= 0.9881E+00+0.1364E+00*SB -0.4421E+00*SB2+0.2051E+00*SB3 | |
503 | A5=-0.9505E-01+0.3259E+01*SB -0.1547E+01*SB2+0.2918E+00*SB3 | |
504 | ELSEIF(IFL.EQ.1) THEN | |
505 | A0=Exp(-0.2740E+01-0.7987E-01*SB -0.9015E+00*SB2-0.9872E-01*SB3) | |
506 | A1=-0.3909E+00+0.1244E+00*SB -0.4487E-01*SB2+0.1277E-01*SB3 | |
507 | A2= 0.9163E+01+0.2823E+00*SB -0.7720E+00*SB2-0.9360E-02*SB3 | |
508 | A3= 0.1080E+02-0.3915E+01*SB -0.1153E+01*SB2+0.2649E+01*SB3 | |
509 | A4= 0.9894E+00-0.1647E+00*SB -0.9426E-02*SB2+0.2945E-02*SB3 | |
510 | A5=-0.3395E+00+0.6998E+00*SB +0.7000E+00*SB2-0.6730E-01*SB3 | |
511 | ELSEIF(IFL.EQ.2) THEN | |
512 | A0=Exp(-0.2449E+01-0.3513E+01*SB +0.4529E+01*SB2-0.2031E+01*SB3) | |
513 | A1=-0.4050E+00+0.3411E+00*SB -0.3669E+00*SB2+0.1109E+00*SB3 | |
514 | A2= 0.7470E+01-0.2982E+01*SB +0.5503E+01*SB2-0.2419E+01*SB3 | |
515 | A3= 0.1503E+02+0.1638E+01*SB -0.8772E+01*SB2+0.3852E+01*SB3 | |
516 | A4= 0.1137E+01-0.1006E+01*SB +0.1485E+01*SB2-0.6389E+00*SB3 | |
517 | A5=-0.5299E+00+0.3160E+01*SB -0.3104E+01*SB2+0.1219E+01*SB3 | |
518 | ELSEIF(IFL.EQ.3) THEN | |
519 | A0=Exp(-0.3640E+01+0.1250E+01*SB -0.2914E+01*SB2+0.8390E+00*SB3) | |
520 | A1=-0.3595E+00-0.5259E-01*SB +0.3122E+00*SB2-0.1642E+00*SB3 | |
521 | A2= 0.7305E+01+0.9727E+00*SB -0.9788E+00*SB2-0.5193E-01*SB3 | |
522 | A3= 0.1198E+02-0.1799E+02*SB +0.2614E+02*SB2-0.1091E+02*SB3 | |
523 | A4= 0.9882E+00-0.6101E+00*SB +0.9737E+00*SB2-0.4935E+00*SB3 | |
524 | A5=-0.1186E+00-0.3231E+00*SB +0.3074E+01*SB2-0.1274E+01*SB3 | |
525 | ELSEIF(IFL.EQ.4) THEN | |
526 | A0=SB**0.1122E+01*Exp(-0.3718E+01-0.1335E+01*SB +0.1651E-01*SB2) | |
527 | A1=-0.4719E+00+0.7509E+00*SB -0.8420E+00*SB2+0.2901E+00*SB3 | |
528 | A2= 0.6194E+01-0.1641E+01*SB +0.4907E+01*SB2-0.2523E+01*SB3 | |
529 | A3= 0.4426E+01-0.4270E+01*SB +0.6581E+01*SB2-0.3474E+01*SB3 | |
530 | A4= 0.2683E+00+0.9876E+00*SB -0.7612E+00*SB2+0.1780E+00*SB3 | |
531 | A5=-0.4547E+00+0.4410E+01*SB -0.3712E+01*SB2+0.1245E+01*SB3 | |
532 | ELSEIF(IFL.EQ.5) THEN | |
533 | A0=SB**0.9838E+00*Exp(-0.2548E+01-0.7660E+01*SB +0.3702E+01*SB2) | |
534 | A1=-0.3122E+00-0.2120E+00*SB +0.5716E+00*SB2-0.3773E+00*SB3 | |
535 | A2= 0.6257E+01-0.8214E-01*SB -0.2537E+01*SB2+0.2981E+01*SB3 | |
536 | A3=-0.6723E+00+0.2131E+01*SB +0.9599E+01*SB2-0.7910E+01*SB3 | |
537 | A4= 0.9169E-01+0.4295E-01*SB -0.5017E+00*SB2+0.3811E+00*SB3 | |
538 | A5= 0.2402E+00+0.2656E+01*SB -0.1586E+01*SB2+0.2880E+00*SB3 | |
539 | ELSEIF(IFL.EQ.6) THEN | |
540 | A0=SB**0.1001E+01*Exp(-0.6934E+01+0.3050E+01*SB -0.6943E+00*SB2) | |
541 | A1=-0.1713E+00-0.5167E+00*SB +0.1241E+01*SB2-0.1703E+01*SB3 | |
542 | A2= 0.6169E+01+0.3023E+01*SB -0.1972E+02*SB2+0.1069E+02*SB3 | |
543 | A3= 0.4439E+01-0.1746E+02*SB +0.1225E+02*SB2+0.8350E+00*SB3 | |
544 | A4= 0.5458E+00-0.4586E+00*SB +0.9089E+00*SB2-0.4049E+00*SB3 | |
545 | A5= 0.3207E+01-0.3362E+01*SB +0.5877E+01*SB2-0.7659E+01*SB3 | |
546 | ENDIF | |
547 | P012=A0*(X**A1)*((1.-X)**A2) | |
548 | P34=(1.+A3*(X**A4)) | |
549 | P5=(LOG(1.+1./X))**A5 | |
550 | SEA=P012*P34*P5 | |
551 | C Add valence part | |
552 | IF(IIQ.NE.2.AND.IIQ.NE.4) THEN | |
553 | STRUC=SEA | |
554 | GO TO 9999 | |
555 | ELSEIF(IIQ.EQ.2) THEN | |
556 | A0=Exp( 0.1907E+00+0.4205E-01*SB +0.2752E+00*SB2-0.3171E+00*SB3) | |
557 | A1= 0.4611E+00+0.2331E-01*SB -0.3403E-01*SB2+0.3174E-01*SB3 | |
558 | A2= 0.3504E+01+0.5739E+00*SB +0.2676E+00*SB2-0.1553E+00*SB3 | |
559 | A3= 0.7452E+01-0.6742E+01*SB +0.2849E+01*SB2-0.1964E+00*SB3 | |
560 | A4= 0.1116E+01-0.3435E+00*SB +0.2865E+00*SB2-0.1288E+00*SB3 | |
561 | A5= 0.6659E-01+0.2714E+00*SB -0.2688E+00*SB2+0.2763E+00*SB3 | |
562 | ELSEIF(IIQ.EQ.4) THEN | |
563 | A0=Exp( 0.1141E+00+0.4764E+00*SB -0.1745E+01*SB2+0.7728E+00*SB3) | |
564 | A1= 0.4275E+00-0.1290E+00*SB +0.3609E+00*SB2-0.1689E+00*SB3 | |
565 | A2= 0.3000E+01+0.2946E+01*SB -0.4117E+01*SB2+0.1989E+01*SB3 | |
566 | A3=-0.1302E+01+0.2322E+01*SB -0.4258E+01*SB2+0.2109E+01*SB3 | |
567 | A4= 0.2586E+01-0.1920E+00*SB -0.3754E+00*SB2+0.2731E+00*SB3 | |
568 | A5=-0.2251E+00-0.5374E+00*SB +0.2245E+01*SB2-0.1034E+01*SB3 | |
569 | ENDIF | |
570 | P012=A0*(X**A1)*((1.-X)**A2) | |
571 | P34=(1.+A3*(X**A4)) | |
572 | P5=(LOG(1.+1./X))**A5 | |
573 | VAL=P012*P34*P5 | |
574 | STRUC=VAL+SEA | |
575 | GO TO 9999 | |
576 | C | |
577 | C Calculate PDFLIB distributions and return one for type IIQ. | |
578 | C | |
579 | #if defined(CERNLIB_PDFLIB) | |
580 | 9000 CONTINUE | |
581 | DX=X | |
582 | DSCALE=DSQRT(DBLE(QSQ)) | |
583 | CALL PFTOPDG(DX,DSCALE,DXPDF) | |
584 | STRUC=DXPDF(IQMAP(IIQ)) | |
585 | #endif | |
586 | C | |
587 | C Require minimum value for STRUC | |
588 | C | |
589 | 9999 IF(STRUC.LT.SFMIN) STRUC=SFMIN | |
590 | RETURN | |
591 | END |