#include "isajet/pilot.h" FUNCTION STRUC(X,QSQ,IQ,IH) C C Compute structure functions X*F(X,QSQ) C ISTRUC=1,2 obsolete C ISTRUC=3 for Eichten, Hinchliffe, Lane, and Quigg (1984) C solution 1 C ISTRUC=4 Duke and Owens, Phys. Rev. D30, 49. C solution 1 C ISTRUC=5 CTEQ Collaboration, Phys. Lett. 304B, 159 C fit CTEQ2L (lowest order QCD) C ISTRUC=6 CTEQ Collaboration, Phys. Rev. D51, 4763 (1995) C fit CTEQ3L (lowest order QCD) C ISTRUC=-999 PDFLIB interface. Parameters are passed by call C to PDFSET in READIN. C Quark types-- C IQ=1 2 3 4 5 6 7 8 9 10 11 12 13 C GL UP UB DN DB ST SB CH CB BT BB TP TB C Hadron types-- C IH=+1120 -1120 +1220 -1220 C P AP N AN C C For IBM compatibility require STRUC > SFMIN = 1.E-10 C Ver. 7.23: Simplify type mapping and fix PDF error for pbar C #if defined(CERNLIB_IMPNONE) IMPLICIT NONE #endif #include "isajet/itapes.inc" #include "isajet/qcdpar.inc" C E1STRC contains all the coefficients for Eichten, etal, C solution 1. It is equivalenced to arrays for the 16 sets of C coefficients. DIMENSION E1STRC(6,6,16),E1POW(8),IE1FIT(13) DIMENSION E1UPHI(6,6),E1DNHI(6,6),E1UBHI(6,6),E1GLHI(6,6), $E1STHI(6,6),E1CHHI(6,6),E1BTHI(6,6),E1TPHI(6,6) DIMENSION E1UPLO(6,6),E1DNLO(6,6),E1UBLO(6,6),E1GLLO(6,6), $E1STLO(6,6),E1CHLO(6,6),E1BTLO(6,6),E1TPLO(6,6) EQUIVALENCE (E1UPHI(1,1),E1STRC(1,1,1)) EQUIVALENCE (E1DNHI(1,1),E1STRC(1,1,2)) EQUIVALENCE (E1UBHI(1,1),E1STRC(1,1,3)) EQUIVALENCE (E1GLHI(1,1),E1STRC(1,1,4)) EQUIVALENCE (E1STHI(1,1),E1STRC(1,1,5)) EQUIVALENCE (E1CHHI(1,1),E1STRC(1,1,6)) EQUIVALENCE (E1BTHI(1,1),E1STRC(1,1,7)) EQUIVALENCE (E1TPHI(1,1),E1STRC(1,1,8)) EQUIVALENCE (E1UPLO(1,1),E1STRC(1,1,9)) EQUIVALENCE (E1DNLO(1,1),E1STRC(1,1,10)) EQUIVALENCE (E1UBLO(1,1),E1STRC(1,1,11)) EQUIVALENCE (E1GLLO(1,1),E1STRC(1,1,12)) EQUIVALENCE (E1STLO(1,1),E1STRC(1,1,13)) EQUIVALENCE (E1CHLO(1,1),E1STRC(1,1,14)) EQUIVALENCE (E1BTLO(1,1),E1STRC(1,1,15)) EQUIVALENCE (E1TPLO(1,1),E1STRC(1,1,16)) DIMENSION CHEBX(6),CHEBQ(6) C REAL X,QSQ,STRUC REAL BETA,CHEB1,CHEB2,CHEB3,CHEB4,CHEB5,AMASS,E1POW,FD,CHEBX, $E1STRC,E1UPHI,CHEBQ,AD,ETA3,GUD,ETA2,ETA4,FUD,AUD,GD,E1GLLO, $E1UBLO,E1DNLO,E1STLO,E1TPLO,E1BTLO,E1CHLO,E1UPLO,E1GLHI,E1UBHI, $E1DNHI,E1STHI,E1TPHI,E1BTHI,ETA1,T,TMAX,TMIN,AMQ,Q2MIN,W2,W1, $SFMIN,T1,A1,A0,SS,B1,C2,B2,A2,S,X1,TERM,E1CHHI,Q2,GAMMA INTEGER IQ,IH INTEGER IE1FIT,IFIT,IFIT2,JX,JQ,ISHFT,IIQ C CTEQ declarations REAL A3,A4,A5,SBL,QI,Q,SB,SB2,SB3 INTEGER IFL INTEGER IQPB(13),IQN(13),IQNB(13) #if defined(CERNLIB_SINGLE) REAL SEA,VAL,P012,P34,P5 #endif #if defined(CERNLIB_DOUBLE) DOUBLE PRECISION SEA,VAL,P012,P34,P5 #endif C PDFLIB declarations #if (defined(CERNLIB_PDFLIB))&&(defined(CERNLIB_SINGLE)) REAL DX,DSCALE,DXPDF(-6:6) #endif #if (defined(CERNLIB_PDFLIB))&&(defined(CERNLIB_DOUBLE)) DOUBLE PRECISION DX,DSCALE,DXPDF(-6:6) #endif #if defined(CERNLIB_PDFLIB) INTEGER IQMAP(13) DATA IQMAP/0,2,-2,1,-1,3,-3,4,-4,5,-5,6,-6/ #endif C C Map pbar, n, nbar types to p type DATA IQPB/1,3,2,5,4,7,6,9,8,11,10,13,12/ DATA IQN /1,4,5,2,3,6,7,8,9,10,11,12,13/ DATA IQNB/1,5,4,3,2,7,6,9,8,11,10,13,12/ C C Eichten etal solution 1 constants C corrected coefficients from Ian Hinchliffe, 3 June 1986. DATA E1UPHI/ $ 0.76772, -0.20874, -0.33026, -0.02517, -0.01570, -0.00010, $ -0.53259, -0.26612, 0.32007, 0.11918, 0.02434, 0.00762, $ 0.21618, 0.18812, -0.08375, -0.06515, -0.01743, -0.00504, $ -0.09211, -0.09952, 0.01373, 0.02506, 0.00877, 0.00255, $ 0.03670, 0.04409, 0.00096, -0.00796, -0.00342, -0.00105, $ -0.01549, -0.02026, -0.00306, 0.00222, 0.00124, 0.00041/ DATA E1DNHI/ $ 0.38130, -0.08090, -0.16336, -0.02185, -0.00843, -0.00062, $ -0.29475, -0.14348, 0.16650, 0.06638, 0.01473, 0.00408, $ 0.12518, 0.10422, -0.04722, -0.03683, -0.01038, -0.00286, $ -0.05478, -0.05678, 0.00890, 0.01484, 0.00534, 0.00152, $ 0.02220, 0.02567, -0.00003, -0.00497, -0.00216, -0.00065, $ -0.00953, -0.01204, -0.00151, 0.00151, 0.00083, 0.00027/ DATA E1UBHI/ $ 0.06870, -0.06861, 0.02973, -0.00540, 0.00378, -0.00097, $ -0.01802, 0.00014, 0.00649, -0.00854, 0.00122, -0.00175, $ -0.00465, 0.00148, -0.00593, 0.00060, -0.00103, -0.00008, $ 0.00644, 0.00257, 0.00283, 0.00115, 0.00071, 0.00033, $ -0.00393, -0.00254, -0.00116, -0.00077, -0.00036, -0.00019, $ 0.00234, 0.00193, 0.00053, 0.00037, 0.00016, 0.00009/ DATA E1GLHI/ $ 0.94819, -0.95779, 0.10085, -0.10510, 0.03456, -0.03054, $ -0.96265, 0.53790, 0.33684, -0.09525, 0.01488, -0.02051, $ 0.43004, -0.08306, -0.33719, 0.04902, -0.00916, 0.01041, $ -0.19249, -0.01790, 0.21830, 0.00749, 0.00414, -0.00186, $ 0.08183, 0.01926, -0.10718, -0.01944, -0.00277, -0.00052, $ -0.03884, -0.01234, 0.05410, 0.01879, 0.00335, 0.00104/ DATA E1STHI/ $ 0.04968, -0.04173, 0.02102, -0.00327, 0.00324, -0.00067, $ -0.00615, -0.01294, 0.00674, -0.00689, 0.00090, -0.00151, $ -0.00858, 0.00505, -0.00490, -0.00016, -0.00094, -0.00015, $ 0.00784, 0.00151, 0.00222, 0.00140, 0.00070, 0.00035, $ -0.00441, -0.00222, -0.00089, -0.00085, -0.00036, -0.00020, $ 0.00252, 0.00184, 0.00041, 0.00039, 0.00016, 0.00009/ DATA E1CHHI/ $ 0.00927, -0.01817, 0.00959, -0.00639, 0.00169, -0.00154, $ 0.00571, -0.01188, 0.00609, -0.00465, 0.00124, -0.00131, $ -0.00396, 0.00710, -0.00359, 0.00184, -0.00039, 0.00034, $ 0.00112, -0.00196, 0.00112, -0.00048, 0.00010, -0.00004, $ 0.00004, -0.00003, -0.00018, 0.00009, -0.00005, -0.00002, $ -0.00042, 0.00073, -0.00016, 0.00005, 0.00005, 0.00005/ DATA E1BTHI/ $ 0.00901, -0.01401, 0.00715, -0.00413, 0.00126, -0.00104, $ 0.00628, -0.00932, 0.00478, -0.00289, 0.00091, -0.00082, $ -0.00293, 0.00409, -0.00189, 0.00076, -0.00023, 0.00014, $ 0.00039, -0.00120, 0.00044, -0.00025, 0.00002, -0.00002, $ 0.00026, 0.00014, -0.00008, 0.00010, 0.00001, 0.00001, $ -0.00026, 0.00032, 0.00001, -0.00001, 0.00001, -0.00001/ DATA E1TPHI/ $ 0.00441, -0.00748, 0.00377, -0.00258, 0.00073, -0.00071, $ 0.00384, -0.00605, 0.00303, -0.00203, 0.00058, -0.00059, $ -0.00088, 0.00166, -0.00075, 0.00047, -0.00010, 0.00010, $ -0.00008, -0.00015, 0.00012, -0.00009, 0.00003, 0.00000, $ 0.00013, -0.00022, -0.00002, -0.00002, -0.00002, -0.00002, $ -0.00007, 0.00019, -0.00004, 0.00002, 0.00000, 0.00000/ DATA E1UPLO/ $ 0.23946, 0.29055, 0.09778, 0.02149, 0.00344, 0.00050, $ 0.01751, -0.00609, -0.02687, -0.01916, -0.00797, -0.00275, $ -0.00576, -0.00504, 0.00108, 0.00249, 0.00153, 0.00075, $ 0.00174, 0.00196, 0.00030, -0.00034, -0.00029, -0.00018, $ -0.00053, -0.00064, -0.00017, 0.00004, 0.00006, 0.00004, $ 0.00017, 0.00022, 0.00008, 0.00001, -0.00001, -0.00001/ DATA E1DNLO/ $ 0.12613, 0.13542, 0.03958, 0.00824, 0.00166, 0.00045, $ 0.00389, -0.01159, -0.01625, -0.00961, -0.00371, -0.00126, $ -0.00191, -0.00056, 0.00159, 0.00159, 0.00084, 0.00039, $ 0.00064, 0.00049, -0.00015, -0.00029, -0.00018, -0.00010, $ -0.00020, -0.00019, 0.00000, 0.00006, 0.00004, 0.00003, $ 0.00007, 0.00008, 0.00002, -0.00001, -0.00001, -0.00001/ DATA E1UBLO/ $ 1.01386, -1.10585, 0.33739, -0.07444, 0.00885, -0.00087, $ 0.92334, -1.28541, 0.44755, -0.09786, 0.01419, -0.00112, $ 0.04888, -0.12708, 0.08606, -0.02608, 0.00478, -0.00060, $ -0.02691, 0.04887, -0.01771, 0.00162, 0.00025, -0.00006, $ 0.00704, -0.01113, 0.00159, 0.00070, -0.00020, 0.00000, $ -0.00171, 0.00229, 0.00038, -0.00035, 0.00004, 0.00001/ DATA E1GLLO/ $ 29.47734,-39.02468, 14.63570, -3.33516, 0.50538, -0.05915, $ 25.58960,-39.54527, 16.61420, -4.29861, 0.69036, -0.08243, $ -1.66291, 1.17624, 1.11844, -0.70986, 0.19481, -0.02404, $ -0.21679, 0.81705, -0.71688, 0.18507, -0.01924, -0.00325, $ 0.20880, -0.43547, 0.22391, -0.02446, -0.00362, 0.00191, $ -0.09097, 0.16009, -0.05681, -0.00250, 0.00258, -0.00047/ DATA E1STLO/ $ 0.92351, -1.08483, 0.34642, -0.07210, 0.00914, -0.00091, $ 0.93146, -1.27376, 0.45122, -0.09775, 0.01380, -0.00131, $ 0.04739, -0.12960, 0.08482, -0.02642, 0.00476, -0.00057, $ -0.02653, 0.04953, -0.01735, 0.00175, 0.00028, -0.00006, $ 0.00694, -0.01132, 0.00148, 0.00065, -0.00021, 0.00000, $ -0.00168, 0.00234, 0.00042, -0.00034, 0.00005, 0.00001/ DATA E1CHLO/ $ 0.80983, -1.04168, 0.33980, -0.06824, 0.00876, -0.00090, $ 0.89606, -1.21708, 0.43386, -0.09287, 0.01304, -0.00129, $ 0.03058, -0.10402, 0.07604, -0.02415, 0.00460, -0.00050, $ -0.02451, 0.04432, -0.01651, 0.00143, 0.00012, -0.00010, $ 0.01122, -0.01457, 0.00268, 0.00058, -0.00012, 0.00003, $ -0.00773, 0.00733, -0.00076, -0.00024, 0.00001, 0.00000/ DATA E1BTLO/ $ 0.80288, -1.07532, 0.37920, -0.07843, 0.01007, -0.00109, $ 0.79033, -1.09887, 0.41532, -0.09301, 0.01317, -0.00141, $ -0.01704, -0.01130, 0.02882, -0.01341, 0.00304, -0.00036, $ -0.00072, 0.00723, -0.00516, 0.00108, -0.00005, -0.00004, $ 0.00305, -0.00461, 0.00166, -0.00013, -0.00001, 0.00001, $ -0.00436, 0.00523, -0.00161, 0.00020, -0.00002, 0.00000/ DATA E1TPLO/ $ 0.66233, -0.92481, 0.35193, -0.07930, 0.01110, -0.00118, $ 0.63797, -0.90619, 0.35816, -0.08479, 0.01265, -0.00139, $ -0.02581, 0.02125, 0.00419, -0.00498, 0.00149, -0.00021, $ 0.00071, 0.00053, -0.00127, 0.00039, -0.00005, -0.00001, $ 0.00385, -0.00506, 0.00186, -0.00035, 0.00004, 0.00000, $ -0.00353, 0.00446, -0.00150, 0.00027, -0.00003, 0.00000/ C E1POW gives powers of (1-x). C IE1FIT points to fit for each value of IQ. DATA E1POW/3.,4.,7.,5.,7.,7.,7.,7./ DATA IE1FIT/4,1,3,2,3,5,5,6,6,7,7,8,8/ C Minimum value for STRUC DATA SFMIN/1.E-10/ C C BETA(W1,W2)=GAMMA(W1)*GAMMA(W2)/GAMMA(W1+W2) C Chebyshev polynomials CHEB1(X)=X CHEB2(X)=2.*X**2-1. CHEB3(X)=X*(-3.+4.*X**2) CHEB4(X)=1.+X**2*(-8.+8.*X**2) CHEB5(X)=X*(5.+X**2*(-20.+16.*X**2)) C C Entry -- check for unphysical X C IF(X.LE.0..OR.X.GE..9999) THEN STRUC=0. GO TO 9999 ENDIF C C Determine equivalent quark type IIQ for proton C IF(IH.EQ.1120) THEN IIQ=IQ ELSEIF(IH.EQ.-1120) THEN IIQ=IQPB(IQ) ELSEIF(IH.EQ.1220) THEN IIQ=IQN(IQ) ELSEIF(IH.EQ.-1220) THEN IIQ=IQNB(IQ) ELSE C This should never happen STRUC=0 RETURN ENDIF C C Select structure function fit. C IF(ISTRUC.EQ.3) GO TO 1000 IF(ISTRUC.EQ.4) GO TO 2000 IF(ISTRUC.EQ.5) GO TO 3000 IF(ISTRUC.EQ.6) GO TO 3100 #if defined(CERNLIB_PDFLIB) IF(ISTRUC.EQ.-999) GO TO 9000 #endif STRUC=0. GO TO 9999 C C Calculate Eichten etal structure fcn for type IIQ C 1000 STRUC=0. Q2=QSQ IF(Q2.LT.5.) Q2=5. T=ALOG(Q2/ALAM2) TMAX=ALOG(1.E8/ALAM2) IF(IIQ.GT.9) GO TO 1001 Q2MIN=5. GO TO 1002 1001 AMQ=AMASS(IIQ/2) Q2MIN=4.*AMQ**2/(1.-X) IF(Q2.LT.Q2MIN) GO TO 9999 1002 TMIN=ALOG(Q2MIN/ALAM2) T1=(2.*T-(TMAX+TMIN))/(TMAX-TMIN) CHEBQ(1)=1. CHEBQ(2)=CHEB1(T1) CHEBQ(3)=CHEB2(T1) CHEBQ(4)=CHEB3(T1) CHEBQ(5)=CHEB4(T1) CHEBQ(6)=CHEB5(T1) C x.gt.0.1 IF(X.LT.0.1) GO TO 1010 X1=(2.*X-1.1)/.9 ISHFT=0 GO TO 1020 C x.lt.0.1 1010 X1=(2.*ALOG(X)+11.51293)/6.90776 ISHFT=8 C IFIT is pointer for Eichten quark type. C IFIT2 is pointer for function -- shifted by 8 for x<0.1 1020 IFIT=IE1FIT(IIQ) IFIT2=IFIT+ISHFT CHEBX(1)=1. CHEBX(2)=CHEB1(X1) CHEBX(3)=CHEB2(X1) CHEBX(4)=CHEB3(X1) CHEBX(5)=CHEB4(X1) CHEBX(6)=CHEB5(X1) TERM=0. DO 1030 JQ=1,6 DO 1030 JX=1,6 1030 TERM=TERM+E1STRC(JX,JQ,IFIT2)*CHEBQ(JQ)*CHEBX(JX) TERM=TERM*(1.-X)**E1POW(IFIT) STRUC=ABS(TERM) IF(IFIT.GT.2) GO TO 9999 C Add sea term for valence quarks TERM=0. DO 1040 JQ=1,6 DO 1040 JX=1,6 1040 TERM=TERM+E1STRC(JX,JQ,3+ISHFT)*CHEBQ(JQ)*CHEBX(JX) TERM=TERM*(1.-X)**E1POW(3) STRUC=STRUC+ABS(TERM) GO TO 9999 C C Calculate Duke-Owens structure function for type IIQ. C 2000 STRUC=0. Q2=QSQ IF(Q2.LT.4.) Q2=4. S=ALOG(ALOG(Q2/ALAM2)/ALOG(4./ALAM2)) SS=S*S C x*f(x) for gl IF(IIQ.EQ.1) THEN A0=1.56-1.71*S+.638*SS A1=-0.949*S+.325*SS B1=6.+1.44*S-1.05*SS A2=9.-7.19*S+.255*SS B2=-16.5*S+10.9*SS C2=15.3*S-10.1*SS STRUC=A0*X**A1*(1.-X)**B1*(1.+A2*X+B2*X**2+C2*X**3) C x*f(x) for up,ub,dn,db,st,sb ELSEIF(IIQ.LE.7) THEN A0=1.265-1.132*S+.293*SS A1=-.372*S-.029*SS B1=8.05+1.59*S-.153*SS A2=6.31*S-.273*SS B2=-10.5*S-3.17*SS C2=14.7*S+9.80*SS STRUC=A0*X**A1*(1.-X)**B1*(1.+A2*X+B2*X**2+C2*X**3)/6. IF(IIQ.EQ.2.OR.IIQ.EQ.4) THEN ETA1=.419+.004*S-.007*SS ETA2=3.46+.724*S-.066*SS GUD=4.40-4.86*S+1.33*SS ETA3=.763-.237*S+.026*SS ETA4=4.00+.627*S-.019*SS GD=-.421*S+.033*SS AUD=3./(BETA(ETA1,ETA2+1.)*(1.+GUD*ETA1/(ETA1+ETA2+1.))) FUD=AUD*X**ETA1*(1.-X)**ETA2*(1.+GUD*X) AD=1./(BETA(ETA3,ETA4+1.)*(1.+GD*ETA3/(ETA3+ETA4+1.))) FD=AD*X**ETA3*(1.-X)**ETA4*(1.+GD*X) IF(IIQ.EQ.2) STRUC=STRUC+FUD-FD IF(IIQ.EQ.4) STRUC=STRUC+FD ENDIF C x*f(x) for ch,cb ELSEIF(IIQ.LE.9) THEN A0=.135*S-.0075*SS A1=-.036-.222*S-.058*SS B1=6.35+3.26*S-.909*SS A2=-3.03*S+1.50*SS B2=17.4*S-11.3*SS C2=-17.9*S+15.6*SS STRUC=A0*X**A1*(1.-X)**B1*(1.+A2*X+B2*X**2+C2*X**3) C x*f(x)=0 for bt,bb,tp,tb ELSE STRUC=0. ENDIF GO TO 9999 C C Calculate CTEQ2L distribution for type IIQ C 3000 STRUC=0 IFL=IIQ/2 C Set up thresholds Q=SQRT(QSQ) IF(IFL.LE.4) THEN QI=1.6 ELSEIF(IFL.EQ.5) THEN QI=5.0 ELSEIF(IFL.EQ.6) THEN QI=180 ELSE RETURN ENDIF IF(Q.LT.QI) THEN Q=QI IF(IFL.GE.4) GO TO 9999 ENDIF C Hard code lambda=0.190 SBL=LOG(Q/0.190)/LOG(QI/0.190) SB=LOG (SBL) SB2=SB*SB SB3=SB2*SB C Calculate sea part IF(IFL.EQ.0) THEN A0=EXP(-0.6510E+00-0.1128E+01*SB-0.6239E-01*SB2-0.8838E-01*SB3) A1=-0.2590E+00+0.1822E+00*SB-0.2682E+00*SB2+0.9422E-01*SB3 A2= 0.4607E+01+0.7792E+00*SB+0.8937E+00*SB2-0.5553E+00*SB3 A3= 0.1627E+02-0.1114E+02*SB+0.4928E+01*SB2-0.1715E+01*SB3 A4= 0.1236E+01+0.1945E+00*SB-0.3297E+00*SB2+0.6489E-01*SB3 A5= 0.0000E+00+0.3346E+01*SB-0.2337E+01*SB2+0.7850E+00*SB3 ELSEIF(IFL.EQ.1) THEN A0=EXP(-0.1508E+01-0.5560E+00*SB-0.3523E+00*SB2+0.6562E-01*SB3) A1=-0.3223E+00+0.2095E-01*SB-0.2049E-02*SB2-0.3475E-01*SB3 A2= 0.9469E+01-0.3923E+01*SB+0.4333E+01*SB2-0.1654E+01*SB3 A3= 0.1646E+02-0.1082E+02*SB+0.8941E+01*SB2-0.5494E+01*SB3 A4= 0.2908E+01+0.2162E+01*SB-0.3233E+01*SB2+0.1267E+01*SB3 A5=-0.5819E+00+0.3914E+00*SB+0.6460E+00*SB2-0.3239E+00*SB3 ELSEIF(IFL.EQ.2) THEN A0=EXP(-0.1951E+01-0.3435E+01*SB+0.3424E+01*SB2-0.1249E+01*SB3) A1=-0.2942E+00+0.4408E+00*SB-0.5453E+00*SB2+0.1552E+00*SB3 A2= 0.9782E+01-0.3454E+01*SB+0.4510E+01*SB2-0.1649E+01*SB3 A3= 0.4999E+02-0.1993E+02*SB-0.2039E+01*SB2+0.5694E+00*SB3 A4= 0.1938E+01-0.1351E+01*SB+0.1386E+01*SB2-0.5324E+00*SB3 A5=-0.2410E+00+0.3434E+01*SB-0.3334E+01*SB2+0.1067E+01*SB3 ELSEIF(IFL.EQ.3) THEN A0=EXP(-0.1804E+01-0.4381E+01*SB-0.3699E+00*SB2+0.3878E+00*SB3) A1=-0.1000E-02-0.9334E+00*SB+0.7156E+00*SB2-0.2029E+00*SB3 A2= 0.6896E+01+0.2462E+01*SB-0.2885E+01*SB2+0.8701E+00*SB3 A3= 0.0000E+00+0.5589E+01*SB+0.1047E+02*SB2+0.3000E+02*SB3 A4= 0.1000E-02-0.5600E-02*SB+0.5618E-02*SB2+0.6598E-02*SB3 A5= 0.0000E+00-0.3151E+01*SB+0.4025E+01*SB2-0.1232E+01*SB3 ELSEIF(IFL.EQ.4) THEN A0=SB**0.7860E+00*EXP(-0.5041E+01-0.3357E+00*SB-0.4718E+00*SB2) A1=-0.4989E+00+0.9571E+00*SB-0.1359E+01*SB2+0.5384E+00*SB3 A2= 0.5986E+01-0.8541E+01*SB+0.1274E+02*SB2-0.5275E+01*SB3 A3= 0.8121E+01-0.1753E+02*SB+0.2194E+02*SB2-0.8538E+01*SB3 A4= 0.9290E-01-0.4390E+00*SB+0.6162E+00*SB2-0.2231E+00*SB3 A5=-0.1257E+01+0.5677E+01*SB-0.5977E+01*SB2+0.2387E+01*SB3 ELSEIF(IFL.EQ.5) THEN A0=SB**0.4537E+00*EXP(-0.3269E+01-0.5398E+01*SB+0.2893E+01*SB2) A1=-0.1977E+00-0.4126E+00*SB+0.7058E+00*SB2-0.4038E+00*SB3 A2= 0.4522E+01+0.6167E-01*SB-0.1849E+00*SB2+0.7345E+00*SB3 A3=-0.1003E+01+0.1531E+01*SB+0.4515E+01*SB2-0.4368E+01*SB3 A4= 0.3579E-01+0.1919E+00*SB-0.7268E+00*SB2+0.5192E+00*SB3 A5= 0.5129E+00+0.2447E+01*SB-0.1989E+01*SB2+0.7529E+00*SB3 ELSEIF(IFL.EQ.6) THEN A0=SB**0.7178E+00*EXP(-0.7327E+01+0.2277E+01*SB+0.3913E+01*SB2) A1=-0.9842E-01-0.2362E+01*SB+0.8851E+01*SB2-0.7208E+01*SB3 A2= 0.5552E+01-0.8935E+01*SB+0.2676E+02*SB2-0.1344E+02*SB3 A3= 0.1593E+01-0.3505E+01*SB-0.1234E+01*SB2-0.1867E+02*SB3 A4=-0.1723E+00+0.1530E+01*SB+0.2323E+01*SB2-0.9344E+01*SB3 A5= 0.2081E+01+0.1939E+01*SB-0.3273E+01*SB2+0.9935E+01*SB3 ENDIF P012=A0*(X**A1)*((1.-X)**A2) P34=(1.+A3*(X**A4)) P5=(LOG(1.+1./X))**A5 SEA=P012*P34*P5 C Add valence part IF(IIQ.NE.2.AND.IIQ.NE.4) THEN STRUC=SEA GO TO 9999 ELSEIF(IIQ.EQ.2) THEN A0=EXP(-0.1806E+01-0.6672E-01*SB-0.2605E+00*SB2+0.2341E-01*SB3) A1= 0.1750E+00+0.3872E-01*SB-0.2189E-01*SB2+0.1415E-01*SB3 A2= 0.3322E+01+0.7786E+00*SB-0.2902E+00*SB2+0.1517E+00*SB3 A3= 0.4414E+02-0.1987E+02*SB+0.2597E+01*SB2+0.2670E+01*SB3 A4= 0.9610E+00-0.2864E+00*SB-0.5524E-01*SB2+0.6229E-01*SB3 A5= 0.0000E+00+0.2658E+00*SB-0.4728E-02*SB2+0.6048E-01*SB3 ELSEIF(IIQ.EQ.4) THEN A0=EXP( 0.8000E-01+0.7364E+00*SB-0.2714E+01*SB2+0.1311E+01*SB3) A1= 0.4930E+00-0.2001E+00*SB+0.5784E+00*SB2-0.2915E+00*SB3 A2= 0.3001E+01+0.3538E+01*SB-0.6155E+01*SB2+0.3083E+01*SB3 A3=-0.1000E+01+0.3871E+01*SB-0.8334E+01*SB2+0.4219E+01*SB3 A4= 0.2986E+01+0.1597E+01*SB-0.3368E+01*SB2+0.1644E+01*SB3 A5= 0.0000E+00-0.9256E+00*SB+0.3570E+01*SB2-0.1777E+01*SB3 ENDIF P012=A0*(X**A1)*((1.-X)**A2) P34=(1.+A3*(X**A4)) P5=(LOG(1.+1./X))**A5 VAL=P012*P34*P5 STRUC=VAL+SEA GO TO 9999 C C Calculate CTEQ3L distribution for type IIQ C 3100 STRUC=0 IFL=IIQ/2 C Set up thresholds Q=SQRT(QSQ) IF(IFL.LE.4) THEN QI=1.6 ELSEIF(IFL.EQ.5) THEN QI=5.0 ELSEIF(IFL.EQ.6) THEN QI=180 ELSE RETURN ENDIF IF(Q.LT.QI) THEN Q=QI IF(IFL.GE.4) GO TO 9999 ENDIF C Hard code lambda=0.177 SBL=LOG(Q/0.177)/LOG(QI/0.177) SB=LOG (SBL) SB2=SB*SB SB3=SB2*SB C Calculate sea part IF(IFL.EQ.0) THEN A0=Exp(-0.7631E+00-0.7241E+00*SB -0.1170E+01*SB2+0.5343E+00*SB3) A1=-0.3573E+00+0.3469E+00*SB -0.3396E+00*SB2+0.9188E-01*SB3 A2= 0.5604E+01+0.7458E+00*SB -0.5082E+00*SB2+0.1844E+00*SB3 A3= 0.1549E+02-0.1809E+02*SB +0.1162E+02*SB2-0.3483E+01*SB3 A4= 0.9881E+00+0.1364E+00*SB -0.4421E+00*SB2+0.2051E+00*SB3 A5=-0.9505E-01+0.3259E+01*SB -0.1547E+01*SB2+0.2918E+00*SB3 ELSEIF(IFL.EQ.1) THEN A0=Exp(-0.2740E+01-0.7987E-01*SB -0.9015E+00*SB2-0.9872E-01*SB3) A1=-0.3909E+00+0.1244E+00*SB -0.4487E-01*SB2+0.1277E-01*SB3 A2= 0.9163E+01+0.2823E+00*SB -0.7720E+00*SB2-0.9360E-02*SB3 A3= 0.1080E+02-0.3915E+01*SB -0.1153E+01*SB2+0.2649E+01*SB3 A4= 0.9894E+00-0.1647E+00*SB -0.9426E-02*SB2+0.2945E-02*SB3 A5=-0.3395E+00+0.6998E+00*SB +0.7000E+00*SB2-0.6730E-01*SB3 ELSEIF(IFL.EQ.2) THEN A0=Exp(-0.2449E+01-0.3513E+01*SB +0.4529E+01*SB2-0.2031E+01*SB3) A1=-0.4050E+00+0.3411E+00*SB -0.3669E+00*SB2+0.1109E+00*SB3 A2= 0.7470E+01-0.2982E+01*SB +0.5503E+01*SB2-0.2419E+01*SB3 A3= 0.1503E+02+0.1638E+01*SB -0.8772E+01*SB2+0.3852E+01*SB3 A4= 0.1137E+01-0.1006E+01*SB +0.1485E+01*SB2-0.6389E+00*SB3 A5=-0.5299E+00+0.3160E+01*SB -0.3104E+01*SB2+0.1219E+01*SB3 ELSEIF(IFL.EQ.3) THEN A0=Exp(-0.3640E+01+0.1250E+01*SB -0.2914E+01*SB2+0.8390E+00*SB3) A1=-0.3595E+00-0.5259E-01*SB +0.3122E+00*SB2-0.1642E+00*SB3 A2= 0.7305E+01+0.9727E+00*SB -0.9788E+00*SB2-0.5193E-01*SB3 A3= 0.1198E+02-0.1799E+02*SB +0.2614E+02*SB2-0.1091E+02*SB3 A4= 0.9882E+00-0.6101E+00*SB +0.9737E+00*SB2-0.4935E+00*SB3 A5=-0.1186E+00-0.3231E+00*SB +0.3074E+01*SB2-0.1274E+01*SB3 ELSEIF(IFL.EQ.4) THEN A0=SB**0.1122E+01*Exp(-0.3718E+01-0.1335E+01*SB +0.1651E-01*SB2) A1=-0.4719E+00+0.7509E+00*SB -0.8420E+00*SB2+0.2901E+00*SB3 A2= 0.6194E+01-0.1641E+01*SB +0.4907E+01*SB2-0.2523E+01*SB3 A3= 0.4426E+01-0.4270E+01*SB +0.6581E+01*SB2-0.3474E+01*SB3 A4= 0.2683E+00+0.9876E+00*SB -0.7612E+00*SB2+0.1780E+00*SB3 A5=-0.4547E+00+0.4410E+01*SB -0.3712E+01*SB2+0.1245E+01*SB3 ELSEIF(IFL.EQ.5) THEN A0=SB**0.9838E+00*Exp(-0.2548E+01-0.7660E+01*SB +0.3702E+01*SB2) A1=-0.3122E+00-0.2120E+00*SB +0.5716E+00*SB2-0.3773E+00*SB3 A2= 0.6257E+01-0.8214E-01*SB -0.2537E+01*SB2+0.2981E+01*SB3 A3=-0.6723E+00+0.2131E+01*SB +0.9599E+01*SB2-0.7910E+01*SB3 A4= 0.9169E-01+0.4295E-01*SB -0.5017E+00*SB2+0.3811E+00*SB3 A5= 0.2402E+00+0.2656E+01*SB -0.1586E+01*SB2+0.2880E+00*SB3 ELSEIF(IFL.EQ.6) THEN A0=SB**0.1001E+01*Exp(-0.6934E+01+0.3050E+01*SB -0.6943E+00*SB2) A1=-0.1713E+00-0.5167E+00*SB +0.1241E+01*SB2-0.1703E+01*SB3 A2= 0.6169E+01+0.3023E+01*SB -0.1972E+02*SB2+0.1069E+02*SB3 A3= 0.4439E+01-0.1746E+02*SB +0.1225E+02*SB2+0.8350E+00*SB3 A4= 0.5458E+00-0.4586E+00*SB +0.9089E+00*SB2-0.4049E+00*SB3 A5= 0.3207E+01-0.3362E+01*SB +0.5877E+01*SB2-0.7659E+01*SB3 ENDIF P012=A0*(X**A1)*((1.-X)**A2) P34=(1.+A3*(X**A4)) P5=(LOG(1.+1./X))**A5 SEA=P012*P34*P5 C Add valence part IF(IIQ.NE.2.AND.IIQ.NE.4) THEN STRUC=SEA GO TO 9999 ELSEIF(IIQ.EQ.2) THEN A0=Exp( 0.1907E+00+0.4205E-01*SB +0.2752E+00*SB2-0.3171E+00*SB3) A1= 0.4611E+00+0.2331E-01*SB -0.3403E-01*SB2+0.3174E-01*SB3 A2= 0.3504E+01+0.5739E+00*SB +0.2676E+00*SB2-0.1553E+00*SB3 A3= 0.7452E+01-0.6742E+01*SB +0.2849E+01*SB2-0.1964E+00*SB3 A4= 0.1116E+01-0.3435E+00*SB +0.2865E+00*SB2-0.1288E+00*SB3 A5= 0.6659E-01+0.2714E+00*SB -0.2688E+00*SB2+0.2763E+00*SB3 ELSEIF(IIQ.EQ.4) THEN A0=Exp( 0.1141E+00+0.4764E+00*SB -0.1745E+01*SB2+0.7728E+00*SB3) A1= 0.4275E+00-0.1290E+00*SB +0.3609E+00*SB2-0.1689E+00*SB3 A2= 0.3000E+01+0.2946E+01*SB -0.4117E+01*SB2+0.1989E+01*SB3 A3=-0.1302E+01+0.2322E+01*SB -0.4258E+01*SB2+0.2109E+01*SB3 A4= 0.2586E+01-0.1920E+00*SB -0.3754E+00*SB2+0.2731E+00*SB3 A5=-0.2251E+00-0.5374E+00*SB +0.2245E+01*SB2-0.1034E+01*SB3 ENDIF P012=A0*(X**A1)*((1.-X)**A2) P34=(1.+A3*(X**A4)) P5=(LOG(1.+1./X))**A5 VAL=P012*P34*P5 STRUC=VAL+SEA GO TO 9999 C C Calculate PDFLIB distributions and return one for type IIQ. C #if defined(CERNLIB_PDFLIB) 9000 CONTINUE DX=X DSCALE=DSQRT(DBLE(QSQ)) CALL PFTOPDG(DX,DSCALE,DXPDF) STRUC=DXPDF(IQMAP(IIQ)) #endif C C Require minimum value for STRUC C 9999 IF(STRUC.LT.SFMIN) STRUC=SFMIN RETURN END