| 0795afa3 |
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 |
git://git.uio.no / u / mrichter / AliRoot.git / blame