ISAJET/code/struc.F

   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