HERWIG/src/hwsfbr.f

   1
   2 CDECK  ID>, HWSFBR.
   3
   4 *CMZ :-        -15/07/92  14.08.45  by  Mike Seymour
   5
   6 *-- Author :    Bryan Webber
   7
   8 C-----------------------------------------------------------------------
   9
  10       SUBROUTINE HWSFBR(X,QQ,FORCED,ID,IW,ID1,ID2,IW1,IW2,Z)
  11
  12 C-----------------------------------------------------------------------
  13
  14 C     FINDS BRANCHING (ID1->ID+ID2) AND Z=X/X1 IN BACKWARD
  15
  16 C     EVOLUTION AT ENERGY FRACTION X AND SCALE QQ
  17
  18 C
  19
  20 C     FORCED=.TRUE. FORCES SPLITTING OF NON-VALENCE PARTON
  21
  22 C
  23
  24 C     IW,IW1,IW2 ARE COLOUR CONNECTION WORDS
  25
  26 C
  27
  28 C     ID1.LT.0 ON RETURN MEANS NO PHASE SPACE
  29
  30 C     ID1.EQ.0 ON RETURN FLAGS REJECTED BRANCHINGS
  31
  32 C-----------------------------------------------------------------------
  33
  34       INCLUDE 'HERWIG61.INC'
  35
  36       DOUBLE PRECISION HWBVMC,HWR,HWUALF,HWUAEM,QP,X,QQ,Z,WQG,WQV,
  37
  38      & WQP,XQV,ZMIN,ZMAX,YMIN,YMAX,DELY,YY,PSUM,EZ,WQN,WR,ZR,WZ,ZZ,AZ,
  39
  40      & PVAL,EY,DIST(13),PROB(13,100),PPHO
  41
  42       INTEGER ID,IW,ID1,ID2,IW1,IW2,NZ,IDHAD,IP,IZ
  43
  44       LOGICAL HWRLOG,HWSVAL,FORCED,NONF,NONV,PHOTPR
  45
  46       EXTERNAL HWBVMC,HWR,HWUALF,HWUAEM,HWRLOG,HWSVAL
  47
  48       ID1=-1
  49
  50       QP=HWBVMC(ID)
  51
  52       WQG=1.-QG/QQ
  53
  54       WQV=1.-QV/QQ
  55
  56       WQP=1.-QP/QQ
  57
  58       XQV=X/WQV
  59
  60       NONV=.NOT.HWSVAL(ID)
  61
  62       NONF=.NOT.FORCED
  63
  64     5 IF (ID.EQ.13) THEN
  65
  66         ZMIN=X
  67
  68         IF (NONF) THEN
  69
  70           ZMAX=WQG
  71
  72         ELSE
  73
  74           ZMAX=WQV
  75
  76         ENDIF
  77
  78       ELSE
  79
  80         IF (NONV) THEN
  81
  82           ZMIN=XQV
  83
  84           IF (NONF) THEN
  85
  86             ZMAX=WQG
  87
  88           ELSE
  89
  90             ZMAX=WQP
  91
  92           ENDIF
  93
  94         ELSE
  95
  96           ZMIN=X
  97
  98           ZMAX=MAX(WQG,WQP)
  99
 100         ENDIF
 101
 102       ENDIF
 103
 104       IF (ZMIN.GE.ZMAX) RETURN
 105
 106       ID1=0
 107
 108 C---INTERPOLATION VARIABLE IS Y=LN(Z/(1-Z))
 109
 110       YMIN=LOG(ZMIN/(1.-ZMIN))
 111
 112       YMAX=LOG(ZMAX/(1.-ZMAX))
 113
 114       DELY=YMAX-YMIN
 115
 116       NZ=MIN(INT(ZBINM*DELY)+1,NZBIN)
 117
 118       DELY=(YMAX-YMIN)/FLOAT(NZ)
 119
 120       YY=YMIN+0.5*DELY
 121
 122       PSUM=0.
 123
 124       IDHAD=IDHW(INHAD)
 125
 126 C---SET UP TABLES FOR CHOOSING BRANCHING
 127
 128       DO 40 IZ=1,NZ
 129
 130       EZ=EXP(YY)
 131
 132       WR=1.+EZ
 133
 134       ZR=WR/EZ
 135
 136       WZ=1./WR
 137
 138       ZZ=WZ*EZ
 139
 140       AZ=WZ*ZZ*HWUALF(5-2*SUDORD,MAX(WZ*QQ,QG))
 141
 142       CALL HWSFUN(X*ZR,QQ,IDHAD,NSTRU,DIST,JNHAD)
 143
 144       IF (ID.NE.13) THEN
 145
 146 C---SPLITTING INTO QUARK
 147
 148         DO 10 IP=1,ID-1
 149
 150    10   PROB(IP,IZ)=PSUM
 151
 152         IF (NONF) PSUM=PSUM+DIST(ID)*AZ*CFFAC*(1.+ZZ*ZZ)*WR
 153
 154         DO 20 IP=ID,12
 155
 156    20   PROB(IP,IZ)=PSUM
 157
 158         PSUM=PSUM+DIST(13)*AZ*0.5*(ZZ*ZZ+WZ*WZ)
 159
 160         PROB(13,IZ)=PSUM
 161
 162       ELSE
 163
 164 C---SPLITTING INTO GLUON
 165
 166         DO 30 IP=1,12
 167
 168         PSUM=PSUM+DIST(IP)*AZ*CFFAC*(1.+WZ*WZ)*ZR
 169
 170    30   PROB(IP,IZ)=PSUM
 171
 172         IF (NONF) PSUM=PSUM+DIST(13)*AZ*2.*CAFAC*(WZ*ZR+ZZ*WR+WZ*ZZ)
 173
 174         PROB(13,IZ)=PSUM
 175
 176       ENDIF
 177
 178    40 YY=YY+DELY
 179
 180    50 PHOTPR=IDHAD.EQ.59.AND.ID.NE.13
 181
 182       IF (PHOTPR) THEN
 183
 184 C---ALLOW ANOMALOUS PHOTON SPLITTING
 185
 186          PPHO=HWUAEM(-QQ*QQ)*CAFAC*(ZMIN**2+(1.-ZMIN)**2)
 187
 188      &        *ICHRG(ID)**2/(18.*PIFAC)
 189
 190          IF (PPHO.GT.(PPHO+PSUM*DELY)*HWR()) THEN
 191
 192 C---ANOMALOUS PHOTON SPLITTING OCCURRED
 193
 194            ID1=59
 195
 196            RETURN
 197
 198          ENDIF
 199
 200        ENDIF
 201
 202       IF (PSUM.LE.ZERO) RETURN
 203
 204 C---CHOOSE Z
 205
 206       PVAL=PSUM*HWR()
 207
 208       DO 60 IZ=1,NZ
 209
 210       IF (PROB(13,IZ).GT.PVAL) GOTO 70
 211
 212    60 CONTINUE
 213
 214       IZ=NZ
 215
 216    70 EY=EXP(YMIN+DELY*(FLOAT(IZ)-HWR()))
 217
 218       ZZ=EY/(1.+EY)
 219
 220 C---CHOOSE BRANCHING
 221
 222       DO 80 IP=1,13
 223
 224       IF (PROB(IP,IZ).GT.PVAL) GOTO 90
 225
 226    80 CONTINUE
 227
 228       IP=13
 229
 230 C---CHECK THAT Z IS INSIDE PHASE SPACE (RETURN IF NOT)
 231
 232    90 CONTINUE
 233
 234       IF (ID.NE.13) THEN
 235
 236         IF (IP.EQ.ID) THEN
 237
 238           IF ((NONV.AND.ZZ*WQP.LT.XQV).OR.ZZ.GT.WQG) THEN
 239
 240             IF (PHOTPR) GOTO 50
 241
 242             RETURN
 243
 244           ENDIF
 245
 246         ELSE
 247
 248           IF (ZZ.LT.XQV.OR.ZZ.GT.WQP) THEN
 249
 250             IF (PHOTPR) GOTO 50
 251
 252             RETURN
 253
 254           ENDIF
 255
 256         ENDIF
 257
 258       ELSE
 259
 260         IF (IP.EQ.ID) THEN
 261
 262           IF (ZZ.LT.XQV.OR.ZZ.GT.WQG) RETURN
 263
 264         ELSEIF (.NOT.HWSVAL(IP)) THEN
 265
 266           WQN=1.-HWBVMC(IP)/QQ
 267
 268           IF (ZZ*WQN.LT.XQV.OR.ZZ.GT.WQN) RETURN
 269
 270         ENDIF
 271
 272       ENDIF
 273
 274 C---EVERYTHING OK: LABEL NEW BRANCHES
 275
 276       Z=ZZ
 277
 278       ID1=IP
 279
 280       IW1=IW*2
 281
 282       IW2=IW1+1
 283
 284       IF (ID.LE.6) THEN
 285
 286         IF (ID1.EQ.13) THEN
 287
 288           ID2=ID+6
 289
 290         ELSE
 291
 292           ID2=13
 293
 294           IW2=IW1
 295
 296         ENDIF
 297
 298       ELSE IF (ID.NE.13) THEN
 299
 300         IF (ID1.EQ.13) THEN
 301
 302           ID2=ID-6
 303
 304           IW2=IW1
 305
 306         ELSE
 307
 308           ID2=13
 309
 310         ENDIF
 311
 312       ELSE
 313
 314         ID2=ID1
 315
 316         IF (ID1.EQ.13) THEN
 317
 318           IF (HWRLOG(HALF)) IW2=IW1
 319
 320         ELSE IF (ID1.GT.6) THEN
 321
 322           IW2=IW1
 323
 324         END IF
 325
 326       END IF
 327
 328       IF (IW2.EQ.IW1) IW1=IW1+1
 329
 330   999 END
 331
 332 CDECK  ID>, HWSFUN.
 333
 334 *CMZ :-        -02/05/91  11.30.51  by  Federico Carminati
 335
 336 *-- Author :    Miscellaneous, combined by Bryan Webber
 337
 338 C-----------------------------------------------------------------------
 339
 340       SUBROUTINE HWSFUN(X,SCALE,IDHAD,NSET,DIST,IBEAM)
 341
 342 C-----------------------------------------------------------------------
 343
 344 C     NUCLEON AND PION STRUCTURE FUNCTIONS DIST=X*QRK(X,Q=SCALE)
 345
 346 C
 347
 348 C     IDHAD = TYPE OF HADRON:
 349
 350 C     73=P  91=PBAR  75=N  93=NBAR  38=PI+  30=PI-  59=PHOTON
 351
 352 C
 353
 354 C     NEW SPECIAL CODES:
 355
 356 C     71=`REMNANT PHOTON' 72=`REMNANT NUCLEON'
 357
 358 C
 359
 360 C     NSET = STRUCTURE FUNCTION SET
 361
 362 C          = 1,2 FOR DUKE+OWENS SETS 1,2 (SOFT/HARD GLUE)
 363
 364 C          = 3,4 FOR EICHTEN ET AL SETS 1,2 (NUCLEON ONLY)
 365
 366 C          = 5   FOR OWENS SET 1.1 (PREPRINT FSU-HEP-910606)
 367
 368 C
 369
 370 C     FOR PHOTON DREES+GRASSIE IS USED
 371
 372 C
 373
 374 C     N.B. IF IBEAM.GT.0.AND.MODPDF(IBEAM).GE.0 THEN NSET IS
 375
 376 C     IGNORED AND CERN PDFLIB WITH AUTHOR GROUP=AUTPDF(IBEAM) AND
 377
 378 C     SET=MODPDF(IBEAM) IS USED.  FOR COMPATABILITY WITH VERSIONS 3
 379
 380 C     AND EARLIER, AUTPDF SHOULD BE SET TO 'MODE'
 381
 382 C     NOTE THAT NO CONSISTENCY CHECK IS MADE, FOR EXAMPLE THAT THE
 383
 384 C     REQUESTED SET FOR A PHOTON IS ACTUALLY A PHOTON SET
 385
 386 C
 387
 388 C     IF (ISPAC.GT.0) SCALE IS REPLACED BY MAX(SCALE,QSPAC)
 389
 390 C
 391
 392 C     FOR PHOTON, IF (PHOMAS.GT.0) THEN QUARK DISTRIBUTIONS ARE
 393
 394 C     SUPPRESSED BY      LOG((Q**2+PHOMAS**2)/(P**2+PHOMAS**2))
 395
 396 C                    L = -------------------------------------- ,
 397
 398 C                        LOG((Q**2+PHOMAS**2)/(     PHOMAS**2))
 399
 400 C     WHILE GLUON DISTRIBUTIONS ARE SUPPRESSED BY L**2,
 401
 402 C     WHERE Q=SCALE AND P=VIRTUALITY OF THE PHOTON
 403
 404 C
 405
 406 C   DUKE+OWENS = D.W.DUKE AND J.F.OWENS, PHYS. REV. D30 (1984) 49 (P/N)
 407
 408 C              + J.F.OWENS, PHYS. REV. D30 (1984) 943 (PI+/-)
 409
 410 C   WITH EXTRA SIGNIFICANT FIGURES VIA ED BERGER
 411
 412 C   WARNING....MOMENTUM SUM RULE BADLY VIOLATED ABOVE 1 TEV
 413
 414 C   DUKE+OWENS SETS 1,2 OBSOLETE. SET 1 UPDATED TO OWENS 1.1 (1991)
 415
 416 C   PION NOT RELIABLE ABOVE SCALE = 50 GEV
 417
 418 C
 419
 420 C   EICHTEN ET AL = E.EICHTEN,I.HINCHLIFFE,K.LANE AND C.QUIGG,
 421
 422 C                   REV. MOD. PHYS. 56 (1984) 579
 423
 424 C   REVISED AS IN   REV. MOD. PHYS. 58 (1986) 1065
 425
 426 C   RELIABLE RANGE : SQRT(5)GEV < SCALE < 10TEV, 1E-4 < X < 1
 427
 428 C
 429
 430 C   DREES+GRASSIE = M.DREES & K.GRASSIE, ZEIT. PHYS. C28 (1985) 451
 431
 432 C   MODIFIED IN     M.DREES & C.S.KIM, DESY 91-039
 433
 434 C                         AND C.S.KIM, DTP/91/16   FOR HEAVY QUARKS
 435
 436 C
 437
 438 C   FOR CERN PDFLIB DETAILS SEE PDFLIB DOC Q ON CERNVM OR
 439
 440 C   CERN_ROOT:[DOC]PDFLIB.TXT ON VXCERN
 441
 442 C-----------------------------------------------------------------------
 443
 444       INCLUDE 'HERWIG61.INC'
 445
 446       DOUBLE PRECISION HWSGAM,X,SCALE,XOLD,QOLD,XMWN,QSCA,SS,SMIN,S,T,
 447
 448      & TMIN,TMAX,VX,AA,VT,WT,UPV,DNV,SEA,STR,CHM,BTM,TOP,GLU,WX,XQSUM,
 449
 450      & DMIN,TPMIN,TPMAX,DIST(13),G(2),Q0(5),QL(5),F(5),A(6,5),
 451
 452      & B(3,6,5,4),XQ(6),TX(6),TT(6),TB(6),NEHLQ(8,2),CEHLQ(6,6,2,8,2),
 453
 454      & BB(4,6,5),VAL(20),USEA,DSEA,TOTAL,SCALEF,FAC,TBMIN(2),TTMIN(2)
 455
 456       REAL HWSDGG,HWSDGQ,XSP,Q2,P2,W2,EMB2,EMC2,ALAM2,XPGA(-6:6),F2GM,
 457
 458      & XPVMD,XPANL,XPANH,XPBEH,XPDIR
 459
 460       COMMON/SASCOM/XPVMD(-6:6),XPANL(-6:6),XPANH(-6:6),XPBEH(-6:6),
 461
 462      &     XPDIR(-6:6)
 463
 464       LOGICAL PDFWRX(2,2),PDFWRQ(2,2)
 465
 466       DOUBLE PRECISION PDFXMN,PDFXMX,PDFQMN,PDFQMX
 467
 468       COMMON /W50513/PDFXMN,PDFXMX,PDFQMN,PDFQMX
 469
 470       INTEGER IDHAD,NSET,IBEAM,IOLD,NOLD,IP,I,J,K,NX,IT,IX,IFL,NFL,
 471
 472      & MPDF,IHAD,ISET,IOP1,IOP2,IP2
 473
 474       CHARACTER*20 PARM(20)
 475
 476       EXTERNAL HWSGAM,HWSDGG,HWSDGQ
 477
 478       SAVE QOLD,IOLD,NOLD,XOLD,SS,S,T,TMIN,TMAX,G,A,TX,TT,TB,IP,NX
 479
 480       DATA PDFWRX,PDFWRQ/8*.TRUE./
 481
 482       DATA (((B(I,J,K,1),I=1,3),J=1,6),K=1,5)/
 483
 484      &3.,0.,0.,.419,.004383,-.007412,
 485
 486      &3.46,.72432,-.065998,4.4,-4.8644,1.3274,
 487
 488      &6*0.,1.,
 489
 490      &0.,0.,.763,-.23696,.025836,4.,.62664,-.019163,
 491
 492      &0.,-.42068,.032809,6*0.,1.265,-1.1323,.29268,
 493
 494      &0.,-.37162,-.028977,8.05,1.5877,-.15291,
 495
 496      &0.,6.3059,-.27342,0.,-10.543,-3.1674,
 497
 498      &0.,14.698,9.798,0.,.13479,-.074693,
 499
 500      &-.0355,-.22237,-.057685,6.3494,3.2649,-.90945,
 501
 502      &0.,-3.0331,1.5042,0.,17.431,-11.255,
 503
 504      &0.,-17.861,15.571,1.564,-1.7112,.63751,
 505
 506      &0.,-.94892,.32505,6.,1.4345,-1.0485,
 507
 508      &9.,-7.1858,.25494,0.,-16.457,10.947,
 509
 510      &0.,15.261,-10.085/
 511
 512       DATA (((B(I,J,K,2),I=1,3),J=1,6),K=1,5)/
 513
 514      &3.,0.,0.,.3743,.013946,-.00031695,
 515
 516      &3.329,.75343,-.076125,6.032,-6.2153,1.5561,
 517
 518      &6*0.,1.,0.,
 519
 520      &0.,.7608,-.2317,.023232,3.83,.62746,-.019155,
 521
 522      &0.,-.41843,.035972,6*0.,1.6714,-1.9168,.58175,
 523
 524      &0.,-.27307,-.16392,9.145,.53045,-.76271,
 525
 526      &0.,15.665,-2.8341,0.,-100.63,44.658,
 527
 528      &0.,223.24,-116.76,0.,.067368,-.030574,
 529
 530      &-.11989,-.23293,-.023273,3.5087,3.6554,-.45313,
 531
 532      &0.,-.47369,.35793,0.,9.5041,-5.4303,
 533
 534      &0.,-16.563,15.524,.8789,-.97093,.43388,
 535
 536      &0.,-1.1612,.4759,4.,1.2271,-.25369,
 537
 538      &9.,-5.6354,-.81747,0.,-7.5438,5.5034,
 539
 540      &0.,-.59649,.12611/
 541
 542       DATA (((B(I,J,K,3),I=1,3),J=1,6),K=1,5)/
 543
 544      &1.,0.,0.,0.4,-0.06212,-0.007109,0.7,0.6478,0.01335,27*0.,
 545
 546      &0.9,-0.2428,0.1386,0.,-0.2120,0.003671,5.0,0.8673,0.04747,
 547
 548      &0.,1.266,-2.215,0.,2.382,0.3482,3*0.,
 549
 550      &0.,0.07928,-0.06134,-0.02212,-0.3785,-0.1088,2.894,9.433,
 551
 552      &-10.852,0.,5.248,-7.187,0.,8.388,-11.61,3*0.,
 553
 554      &0.888,-1.802,1.812,0.,-1.576,1.20,3.11,-0.1317,0.5068,
 555
 556      &6.0,2.801,-12.16,0.,-17.28,20.49,3*0./
 557
 558       DATA (((B(I,J,K,4),I=1,3),J=1,6),K=1,5)/
 559
 560      &1.,0.,0.,0.4,-0.05909,-0.006524,0.628,0.6436,0.01451,27*0.,
 561
 562      &0.90,-0.1417,-0.1740,0.,-0.1697,-0.09623,5.0,-2.474,1.575,
 563
 564      &0.,-2.534,1.378,0.,0.5621,-0.2701,3*0.,
 565
 566      &0.,0.06229,-0.04099,-0.0882,-0.2892,-0.1082,1.924,0.2424,
 567
 568      &2.036,0.,-4.463,5.209,0.,-0.8367,-0.04840,3*0.,
 569
 570      &0.794,-0.9144,0.5966,0.,-1.237,0.6582,2.89,0.5966,-0.2550,
 571
 572      &6.0,-3.671,-2.304,0.,-8.191,7.758,3*0./
 573
 574 C---COEFFTS FOR NEW OWENS 1.1 SET
 575
 576       DATA BB/3.,3*0.,.665,-.1097,-.002442,0.,
 577
 578      &3.614,.8395,-.02186,0.,.8673,-1.6637,.342,0.,
 579
 580      &0.,1.1049,-.2369,5*0.,1.,3*0.,
 581
 582      &.8388,-.2092,.02657,0.,4.667,.7951,.1081,0.,
 583
 584      &0.,-1.0232,.05799,0.,0.,.8616,.153,5*0.,
 585
 586      &.909,-.4023,.006305,0.,
 587
 588      &0.,-.3823,.02766,0.,7.278,-.7904,.8108,0.,
 589
 590      &0.,-1.6629,.5719,0.,0.,-.01333,.5299,0.,
 591
 592      &0.,.1211,-.1739,0.,0.,.09469,-.07066,.01236,
 593
 594      &-.1447,-.402,.1533,-.06479,6.7599,1.6596,.6798,-.8525,
 595
 596      &0.,-4.4559,3.3756,-.9468,
 597
 598      &0.,7.862,-3.6591,.03672,0.,-.2472,-.751,.0487,
 599
 600      &3.017,-4.7347,3.3594,-.9443,0.,-.9342,.5454,-.1668,
 601
 602      &5.304,1.4654,-1.4292,.7569,0.,-3.9141,2.8445,-.8411,
 603
 604      &0.,9.0176,-10.426,4.0983,0.,-5.9602,7.515,-2.7329/
 605
 606 C...THE FOLLOWING DATA LINES ARE COEFFICIENTS NEEDED IN THE
 607
 608 C...EICHTEN, HINCHLIFFE, LANE, QUIGG PROTON STRUCTURE FUNCTION
 609
 610 C...POWERS OF 1-X IN DIFFERENT CASES
 611
 612       DATA NEHLQ/3,4,7,5,7,7,7,7,3,4,7,6,7,7,7,7/
 613
 614 C...EXPANSION COEFFICIENTS FOR UP VALENCE QUARK DISTRIBUTION
 615
 616       DATA (((CEHLQ(IX,IT,NX,1,1),IX=1,6),IT=1,6),NX=1,2)/
 617
 618      1 7.677E-01,-2.087E-01,-3.303E-01,-2.517E-02,-1.570E-02,-1.000E-04,
 619
 620      2-5.326E-01,-2.661E-01, 3.201E-01, 1.192E-01, 2.434E-02, 7.620E-03,
 621
 622      3 2.162E-01, 1.881E-01,-8.375E-02,-6.515E-02,-1.743E-02,-5.040E-03,
 623
 624      4-9.211E-02,-9.952E-02, 1.373E-02, 2.506E-02, 8.770E-03, 2.550E-03,
 625
 626      5 3.670E-02, 4.409E-02, 9.600E-04,-7.960E-03,-3.420E-03,-1.050E-03,
 627
 628      6-1.549E-02,-2.026E-02,-3.060E-03, 2.220E-03, 1.240E-03, 4.100E-04,
 629
 630      1 2.395E-01, 2.905E-01, 9.778E-02, 2.149E-02, 3.440E-03, 5.000E-04,
 631
 632      2 1.751E-02,-6.090E-03,-2.687E-02,-1.916E-02,-7.970E-03,-2.750E-03,
 633
 634      3-5.760E-03,-5.040E-03, 1.080E-03, 2.490E-03, 1.530E-03, 7.500E-04,
 635
 636      4 1.740E-03, 1.960E-03, 3.000E-04,-3.400E-04,-2.900E-04,-1.800E-04,
 637
 638      5-5.300E-04,-6.400E-04,-1.700E-04, 4.000E-05, 6.000E-05, 4.000E-05,
 639
 640      6 1.700E-04, 2.200E-04, 8.000E-05, 1.000E-05,-1.000E-05,-1.000E-05/
 641
 642       DATA (((CEHLQ(IX,IT,NX,1,2),IX=1,6),IT=1,6),NX=1,2)/
 643
 644      1 7.237E-01,-2.189E-01,-2.995E-01,-1.909E-02,-1.477E-02, 2.500E-04,
 645
 646      2-5.314E-01,-2.425E-01, 3.283E-01, 1.119E-01, 2.223E-02, 7.070E-03,
 647
 648      3 2.289E-01, 1.890E-01,-9.859E-02,-6.900E-02,-1.747E-02,-5.080E-03,
 649
 650      4-1.041E-01,-1.084E-01, 2.108E-02, 2.975E-02, 9.830E-03, 2.830E-03,
 651
 652      5 4.394E-02, 5.116E-02,-1.410E-03,-1.055E-02,-4.230E-03,-1.270E-03,
 653
 654      6-1.991E-02,-2.539E-02,-2.780E-03, 3.430E-03, 1.720E-03, 5.500E-04,
 655
 656      1 2.410E-01, 2.884E-01, 9.369E-02, 1.900E-02, 2.530E-03, 2.400E-04,
 657
 658      2 1.765E-02,-9.220E-03,-3.037E-02,-2.085E-02,-8.440E-03,-2.810E-03,
 659
 660      3-6.450E-03,-5.260E-03, 1.720E-03, 3.110E-03, 1.830E-03, 8.700E-04,
 661
 662      4 2.120E-03, 2.320E-03, 2.600E-04,-4.900E-04,-3.900E-04,-2.300E-04,
 663
 664      5-6.900E-04,-8.200E-04,-2.000E-04, 7.000E-05, 9.000E-05, 6.000E-05,
 665
 666      6 2.400E-04, 3.100E-04, 1.100E-04, 0.000E+00,-2.000E-05,-2.000E-05/
 667
 668 C...EXPANSION COEFFICIENTS FOR DOWN VALENCE QUARK DISTRIBUTION
 669
 670       DATA (((CEHLQ(IX,IT,NX,2,1),IX=1,6),IT=1,6),NX=1,2)/
 671
 672      1 3.813E-01,-8.090E-02,-1.634E-01,-2.185E-02,-8.430E-03,-6.200E-04,
 673
 674      2-2.948E-01,-1.435E-01, 1.665E-01, 6.638E-02, 1.473E-02, 4.080E-03,
 675
 676      3 1.252E-01, 1.042E-01,-4.722E-02,-3.683E-02,-1.038E-02,-2.860E-03,
 677
 678      4-5.478E-02,-5.678E-02, 8.900E-03, 1.484E-02, 5.340E-03, 1.520E-03,
 679
 680      5 2.220E-02, 2.567E-02,-3.000E-05,-4.970E-03,-2.160E-03,-6.500E-04,
 681
 682      6-9.530E-03,-1.204E-02,-1.510E-03, 1.510E-03, 8.300E-04, 2.700E-04,
 683
 684      1 1.261E-01, 1.354E-01, 3.958E-02, 8.240E-03, 1.660E-03, 4.500E-04,
 685
 686      2 3.890E-03,-1.159E-02,-1.625E-02,-9.610E-03,-3.710E-03,-1.260E-03,
 687
 688      3-1.910E-03,-5.600E-04, 1.590E-03, 1.590E-03, 8.400E-04, 3.900E-04,
 689
 690      4 6.400E-04, 4.900E-04,-1.500E-04,-2.900E-04,-1.800E-04,-1.000E-04,
 691
 692      5-2.000E-04,-1.900E-04, 0.000E+00, 6.000E-05, 4.000E-05, 3.000E-05,
 693
 694      6 7.000E-05, 8.000E-05, 2.000E-05,-1.000E-05,-1.000E-05,-1.000E-05/
 695
 696       DATA (((CEHLQ(IX,IT,NX,2,2),IX=1,6),IT=1,6),NX=1,2)/
 697
 698      1 3.578E-01,-8.622E-02,-1.480E-01,-1.840E-02,-7.820E-03,-4.500E-04,
 699
 700      2-2.925E-01,-1.304E-01, 1.696E-01, 6.243E-02, 1.353E-02, 3.750E-03,
 701
 702      3 1.318E-01, 1.041E-01,-5.486E-02,-3.872E-02,-1.038E-02,-2.850E-03,
 703
 704      4-6.162E-02,-6.143E-02, 1.303E-02, 1.740E-02, 5.940E-03, 1.670E-03,
 705
 706      5 2.643E-02, 2.957E-02,-1.490E-03,-6.450E-03,-2.630E-03,-7.700E-04,
 707
 708      6-1.218E-02,-1.497E-02,-1.260E-03, 2.240E-03, 1.120E-03, 3.500E-04,
 709
 710      1 1.263E-01, 1.334E-01, 3.732E-02, 7.070E-03, 1.260E-03, 3.400E-04,
 711
 712      2 3.660E-03,-1.357E-02,-1.795E-02,-1.031E-02,-3.880E-03,-1.280E-03,
 713
 714      3-2.100E-03,-3.600E-04, 2.050E-03, 1.920E-03, 9.800E-04, 4.400E-04,
 715
 716      4 7.700E-04, 5.400E-04,-2.400E-04,-3.900E-04,-2.400E-04,-1.300E-04,
 717
 718      5-2.600E-04,-2.300E-04, 2.000E-05, 9.000E-05, 6.000E-05, 4.000E-05,
 719
 720      6 9.000E-05, 1.000E-04, 2.000E-05,-2.000E-05,-2.000E-05,-1.000E-05/
 721
 722 C...EXPANSION COEFFICIENTS FOR UP AND DOWN SEA QUARK DISTRIBUTIONS
 723
 724       DATA (((CEHLQ(IX,IT,NX,3,1),IX=1,6),IT=1,6),NX=1,2)/
 725
 726      1 6.870E-02,-6.861E-02, 2.973E-02,-5.400E-03, 3.780E-03,-9.700E-04,
 727
 728      2-1.802E-02, 1.400E-04, 6.490E-03,-8.540E-03, 1.220E-03,-1.750E-03,
 729
 730      3-4.650E-03, 1.480E-03,-5.930E-03, 6.000E-04,-1.030E-03,-8.000E-05,
 731
 732      4 6.440E-03, 2.570E-03, 2.830E-03, 1.150E-03, 7.100E-04, 3.300E-04,
 733
 734      5-3.930E-03,-2.540E-03,-1.160E-03,-7.700E-04,-3.600E-04,-1.900E-04,
 735
 736      6 2.340E-03, 1.930E-03, 5.300E-04, 3.700E-04, 1.600E-04, 9.000E-05,
 737
 738      1 1.014E+00,-1.106E+00, 3.374E-01,-7.444E-02, 8.850E-03,-8.700E-04,
 739
 740      2 9.233E-01,-1.285E+00, 4.475E-01,-9.786E-02, 1.419E-02,-1.120E-03,
 741
 742      3 4.888E-02,-1.271E-01, 8.606E-02,-2.608E-02, 4.780E-03,-6.000E-04,
 743
 744      4-2.691E-02, 4.887E-02,-1.771E-02, 1.620E-03, 2.500E-04,-6.000E-05,
 745
 746      5 7.040E-03,-1.113E-02, 1.590E-03, 7.000E-04,-2.000E-04, 0.000E+00,
 747
 748      6-1.710E-03, 2.290E-03, 3.800E-04,-3.500E-04, 4.000E-05, 1.000E-05/
 749
 750       DATA (((CEHLQ(IX,IT,NX,3,2),IX=1,6),IT=1,6),NX=1,2)/
 751
 752      1 1.008E-01,-7.100E-02, 1.973E-02,-5.710E-03, 2.930E-03,-9.900E-04,
 753
 754      2-5.271E-02,-1.823E-02, 1.792E-02,-6.580E-03, 1.750E-03,-1.550E-03,
 755
 756      3 1.220E-02, 1.763E-02,-8.690E-03,-8.800E-04,-1.160E-03,-2.100E-04,
 757
 758      4-1.190E-03,-7.180E-03, 2.360E-03, 1.890E-03, 7.700E-04, 4.100E-04,
 759
 760      5-9.100E-04, 2.040E-03,-3.100E-04,-1.050E-03,-4.000E-04,-2.400E-04,
 761
 762      6 1.190E-03,-1.700E-04,-2.000E-04, 4.200E-04, 1.700E-04, 1.000E-04,
 763
 764      1 1.081E+00,-1.189E+00, 3.868E-01,-8.617E-02, 1.115E-02,-1.180E-03,
 765
 766      2 9.917E-01,-1.396E+00, 4.998E-01,-1.159E-01, 1.674E-02,-1.720E-03,
 767
 768      3 5.099E-02,-1.338E-01, 9.173E-02,-2.885E-02, 5.890E-03,-6.500E-04,
 769
 770      4-3.178E-02, 5.703E-02,-2.070E-02, 2.440E-03, 1.100E-04,-9.000E-05,
 771
 772      5 8.970E-03,-1.392E-02, 2.050E-03, 6.500E-04,-2.300E-04, 2.000E-05,
 773
 774      6-2.340E-03, 3.010E-03, 5.000E-04,-3.900E-04, 6.000E-05, 1.000E-05/
 775
 776 C...EXPANSION COEFFICIENTS FOR GLUON DISTRIBUTION
 777
 778       DATA (((CEHLQ(IX,IT,NX,4,1),IX=1,6),IT=1,6),NX=1,2)/
 779
 780      1 9.482E-01,-9.578E-01, 1.009E-01,-1.051E-01, 3.456E-02,-3.054E-02,
 781
 782      2-9.627E-01, 5.379E-01, 3.368E-01,-9.525E-02, 1.488E-02,-2.051E-02,
 783
 784      3 4.300E-01,-8.306E-02,-3.372E-01, 4.902E-02,-9.160E-03, 1.041E-02,
 785
 786      4-1.925E-01,-1.790E-02, 2.183E-01, 7.490E-03, 4.140E-03,-1.860E-03,
 787
 788      5 8.183E-02, 1.926E-02,-1.072E-01,-1.944E-02,-2.770E-03,-5.200E-04,
 789
 790      6-3.884E-02,-1.234E-02, 5.410E-02, 1.879E-02, 3.350E-03, 1.040E-03,
 791
 792      1 2.948E+01,-3.902E+01, 1.464E+01,-3.335E+00, 5.054E-01,-5.915E-02,
 793
 794      2 2.559E+01,-3.955E+01, 1.661E+01,-4.299E+00, 6.904E-01,-8.243E-02,
 795
 796      3-1.663E+00, 1.176E+00, 1.118E+00,-7.099E-01, 1.948E-01,-2.404E-02,
 797
 798      4-2.168E-01, 8.170E-01,-7.169E-01, 1.851E-01,-1.924E-02,-3.250E-03,
 799
 800      5 2.088E-01,-4.355E-01, 2.239E-01,-2.446E-02,-3.620E-03, 1.910E-03,
 801
 802      6-9.097E-02, 1.601E-01,-5.681E-02,-2.500E-03, 2.580E-03,-4.700E-04/
 803
 804       DATA (((CEHLQ(IX,IT,NX,4,2),IX=1,6),IT=1,6),NX=1,2)/
 805
 806      1 2.367E+00, 4.453E-01, 3.660E-01, 9.467E-02, 1.341E-01, 1.661E-02,
 807
 808      2-3.170E+00,-1.795E+00, 3.313E-02,-2.874E-01,-9.827E-02,-7.119E-02,
 809
 810      3 1.823E+00, 1.457E+00,-2.465E-01, 3.739E-02, 6.090E-03, 1.814E-02,
 811
 812      4-1.033E+00,-9.827E-01, 2.136E-01, 1.169E-01, 5.001E-02, 1.684E-02,
 813
 814      5 5.133E-01, 5.259E-01,-1.173E-01,-1.139E-01,-4.988E-02,-2.021E-02,
 815
 816      6-2.881E-01,-3.145E-01, 5.667E-02, 9.161E-02, 4.568E-02, 1.951E-02,
 817
 818      1 3.036E+01,-4.062E+01, 1.578E+01,-3.699E+00, 6.020E-01,-7.031E-02,
 819
 820      2 2.700E+01,-4.167E+01, 1.770E+01,-4.804E+00, 7.862E-01,-1.060E-01,
 821
 822      3-1.909E+00, 1.357E+00, 1.127E+00,-7.181E-01, 2.232E-01,-2.481E-02,
 823
 824      4-2.488E-01, 9.781E-01,-8.127E-01, 2.094E-01,-2.997E-02,-4.710E-03,
 825
 826      5 2.506E-01,-5.427E-01, 2.672E-01,-3.103E-02,-1.800E-03, 2.870E-03,
 827
 828      6-1.128E-01, 2.087E-01,-6.972E-02,-2.480E-03, 2.630E-03,-8.400E-04/
 829
 830 C...EXPANSION COEFFICIENTS FOR STRANGE SEA QUARK DISTRIBUTION
 831
 832       DATA (((CEHLQ(IX,IT,NX,5,1),IX=1,6),IT=1,6),NX=1,2)/
 833
 834      1 4.968E-02,-4.173E-02, 2.102E-02,-3.270E-03, 3.240E-03,-6.700E-04,
 835
 836      2-6.150E-03,-1.294E-02, 6.740E-03,-6.890E-03, 9.000E-04,-1.510E-03,
 837
 838      3-8.580E-03, 5.050E-03,-4.900E-03,-1.600E-04,-9.400E-04,-1.500E-04,
 839
 840      4 7.840E-03, 1.510E-03, 2.220E-03, 1.400E-03, 7.000E-04, 3.500E-04,
 841
 842      5-4.410E-03,-2.220E-03,-8.900E-04,-8.500E-04,-3.600E-04,-2.000E-04,
 843
 844      6 2.520E-03, 1.840E-03, 4.100E-04, 3.900E-04, 1.600E-04, 9.000E-05,
 845
 846      1 9.235E-01,-1.085E+00, 3.464E-01,-7.210E-02, 9.140E-03,-9.100E-04,
 847
 848      2 9.315E-01,-1.274E+00, 4.512E-01,-9.775E-02, 1.380E-02,-1.310E-03,
 849
 850      3 4.739E-02,-1.296E-01, 8.482E-02,-2.642E-02, 4.760E-03,-5.700E-04,
 851
 852      4-2.653E-02, 4.953E-02,-1.735E-02, 1.750E-03, 2.800E-04,-6.000E-05,
 853
 854      5 6.940E-03,-1.132E-02, 1.480E-03, 6.500E-04,-2.100E-04, 0.000E+00,
 855
 856      6-1.680E-03, 2.340E-03, 4.200E-04,-3.400E-04, 5.000E-05, 1.000E-05/
 857
 858       DATA (((CEHLQ(IX,IT,NX,5,2),IX=1,6),IT=1,6),NX=1,2)/
 859
 860      1 6.478E-02,-4.537E-02, 1.643E-02,-3.490E-03, 2.710E-03,-6.700E-04,
 861
 862      2-2.223E-02,-2.126E-02, 1.247E-02,-6.290E-03, 1.120E-03,-1.440E-03,
 863
 864      3-1.340E-03, 1.362E-02,-6.130E-03,-7.900E-04,-9.000E-04,-2.000E-04,
 865
 866      4 5.080E-03,-3.610E-03, 1.700E-03, 1.830E-03, 6.800E-04, 4.000E-04,
 867
 868      5-3.580E-03, 6.000E-05,-2.600E-04,-1.050E-03,-3.800E-04,-2.300E-04,
 869
 870      6 2.420E-03, 9.300E-04,-1.000E-04, 4.500E-04, 1.700E-04, 1.100E-04,
 871
 872      1 9.868E-01,-1.171E+00, 3.940E-01,-8.459E-02, 1.124E-02,-1.250E-03,
 873
 874      2 1.001E+00,-1.383E+00, 5.044E-01,-1.152E-01, 1.658E-02,-1.830E-03,
 875
 876      3 4.928E-02,-1.368E-01, 9.021E-02,-2.935E-02, 5.800E-03,-6.600E-04,
 877
 878      4-3.133E-02, 5.785E-02,-2.023E-02, 2.630E-03, 1.600E-04,-8.000E-05,
 879
 880      5 8.840E-03,-1.416E-02, 1.900E-03, 5.800E-04,-2.500E-04, 1.000E-05,
 881
 882      6-2.300E-03, 3.080E-03, 5.500E-04,-3.700E-04, 7.000E-05, 1.000E-05/
 883
 884 C...EXPANSION COEFFICIENTS FOR CHARM SEA QUARK DISTRIBUTION
 885
 886       DATA (((CEHLQ(IX,IT,NX,6,1),IX=1,6),IT=1,6),NX=1,2)/
 887
 888      1 9.270E-03,-1.817E-02, 9.590E-03,-6.390E-03, 1.690E-03,-1.540E-03,
 889
 890      2 5.710E-03,-1.188E-02, 6.090E-03,-4.650E-03, 1.240E-03,-1.310E-03,
 891
 892      3-3.960E-03, 7.100E-03,-3.590E-03, 1.840E-03,-3.900E-04, 3.400E-04,
 893
 894      4 1.120E-03,-1.960E-03, 1.120E-03,-4.800E-04, 1.000E-04,-4.000E-05,
 895
 896      5 4.000E-05,-3.000E-05,-1.800E-04, 9.000E-05,-5.000E-05,-2.000E-05,
 897
 898      6-4.200E-04, 7.300E-04,-1.600E-04, 5.000E-05, 5.000E-05, 5.000E-05,
 899
 900      1 8.098E-01,-1.042E+00, 3.398E-01,-6.824E-02, 8.760E-03,-9.000E-04,
 901
 902      2 8.961E-01,-1.217E+00, 4.339E-01,-9.287E-02, 1.304E-02,-1.290E-03,
 903
 904      3 3.058E-02,-1.040E-01, 7.604E-02,-2.415E-02, 4.600E-03,-5.000E-04,
 905
 906      4-2.451E-02, 4.432E-02,-1.651E-02, 1.430E-03, 1.200E-04,-1.000E-04,
 907
 908      5 1.122E-02,-1.457E-02, 2.680E-03, 5.800E-04,-1.200E-04, 3.000E-05,
 909
 910      6-7.730E-03, 7.330E-03,-7.600E-04,-2.400E-04, 1.000E-05, 0.000E+00/
 911
 912       DATA (((CEHLQ(IX,IT,NX,6,2),IX=1,6),IT=1,6),NX=1,2)/
 913
 914      1 9.980E-03,-1.945E-02, 1.055E-02,-6.870E-03, 1.860E-03,-1.560E-03,
 915
 916      2 5.700E-03,-1.203E-02, 6.250E-03,-4.860E-03, 1.310E-03,-1.370E-03,
 917
 918      3-4.490E-03, 7.990E-03,-4.170E-03, 2.050E-03,-4.400E-04, 3.300E-04,
 919
 920      4 1.470E-03,-2.480E-03, 1.460E-03,-5.700E-04, 1.200E-04,-1.000E-05,
 921
 922      5-9.000E-05, 1.500E-04,-3.200E-04, 1.200E-04,-6.000E-05,-4.000E-05,
 923
 924      6-4.200E-04, 7.600E-04,-1.400E-04, 4.000E-05, 7.000E-05, 5.000E-05,
 925
 926      1 8.698E-01,-1.131E+00, 3.836E-01,-8.111E-02, 1.048E-02,-1.300E-03,
 927
 928      2 9.626E-01,-1.321E+00, 4.854E-01,-1.091E-01, 1.583E-02,-1.700E-03,
 929
 930      3 3.057E-02,-1.088E-01, 8.022E-02,-2.676E-02, 5.590E-03,-5.600E-04,
 931
 932      4-2.845E-02, 5.164E-02,-1.918E-02, 2.210E-03,-4.000E-05,-1.500E-04,
 933
 934      5 1.311E-02,-1.751E-02, 3.310E-03, 5.100E-04,-1.200E-04, 5.000E-05,
 935
 936      6-8.590E-03, 8.380E-03,-9.200E-04,-2.600E-04, 1.000E-05,-1.000E-05/
 937
 938 C...EXPANSION COEFFICIENTS FOR BOTTOM SEA QUARK DISTRIBUTION
 939
 940       DATA (((CEHLQ(IX,IT,NX,7,1),IX=1,6),IT=1,6),NX=1,2)/
 941
 942      1 9.010E-03,-1.401E-02, 7.150E-03,-4.130E-03, 1.260E-03,-1.040E-03,
 943
 944      2 6.280E-03,-9.320E-03, 4.780E-03,-2.890E-03, 9.100E-04,-8.200E-04,
 945
 946      3-2.930E-03, 4.090E-03,-1.890E-03, 7.600E-04,-2.300E-04, 1.400E-04,
 947
 948      4 3.900E-04,-1.200E-03, 4.400E-04,-2.500E-04, 2.000E-05,-2.000E-05,
 949
 950      5 2.600E-04, 1.400E-04,-8.000E-05, 1.000E-04, 1.000E-05, 1.000E-05,
 951
 952      6-2.600E-04, 3.200E-04, 1.000E-05,-1.000E-05, 1.000E-05,-1.000E-05,
 953
 954      1 8.029E-01,-1.075E+00, 3.792E-01,-7.843E-02, 1.007E-02,-1.090E-03,
 955
 956      2 7.903E-01,-1.099E+00, 4.153E-01,-9.301E-02, 1.317E-02,-1.410E-03,
 957
 958      3-1.704E-02,-1.130E-02, 2.882E-02,-1.341E-02, 3.040E-03,-3.600E-04,
 959
 960      4-7.200E-04, 7.230E-03,-5.160E-03, 1.080E-03,-5.000E-05,-4.000E-05,
 961
 962      5 3.050E-03,-4.610E-03, 1.660E-03,-1.300E-04,-1.000E-05, 1.000E-05,
 963
 964      6-4.360E-03, 5.230E-03,-1.610E-03, 2.000E-04,-2.000E-05, 0.000E+00/
 965
 966       DATA (((CEHLQ(IX,IT,NX,7,2),IX=1,6),IT=1,6),NX=1,2)/
 967
 968      1 8.980E-03,-1.459E-02, 7.510E-03,-4.410E-03, 1.310E-03,-1.070E-03,
 969
 970      2 5.970E-03,-9.440E-03, 4.800E-03,-3.020E-03, 9.100E-04,-8.500E-04,
 971
 972      3-3.050E-03, 4.440E-03,-2.100E-03, 8.500E-04,-2.400E-04, 1.400E-04,
 973
 974      4 5.300E-04,-1.300E-03, 5.600E-04,-2.700E-04, 3.000E-05,-2.000E-05,
 975
 976      5 2.000E-04, 1.400E-04,-1.100E-04, 1.000E-04, 0.000E+00, 0.000E+00,
 977
 978      6-2.600E-04, 3.200E-04, 0.000E+00,-3.000E-05, 1.000E-05,-1.000E-05,
 979
 980      1 8.672E-01,-1.174E+00, 4.265E-01,-9.252E-02, 1.244E-02,-1.460E-03,
 981
 982      2 8.500E-01,-1.194E+00, 4.630E-01,-1.083E-01, 1.614E-02,-1.830E-03,
 983
 984      3-2.241E-02,-5.630E-03, 2.815E-02,-1.425E-02, 3.520E-03,-4.300E-04,
 985
 986      4-7.300E-04, 8.030E-03,-5.780E-03, 1.380E-03,-1.300E-04,-4.000E-05,
 987
 988      5 3.460E-03,-5.380E-03, 1.960E-03,-2.100E-04, 1.000E-05, 1.000E-05,
 989
 990      6-4.850E-03, 5.950E-03,-1.890E-03, 2.600E-04,-3.000E-05, 0.000E+00/
 991
 992 C...EXPANSION COEFFICIENTS FOR TOP SEA QUARK DISTRIBUTION
 993
 994       DATA (((CEHLQ(IX,IT,NX,8,1),IX=1,6),IT=1,6),NX=1,2)/
 995
 996      1 4.410E-03,-7.480E-03, 3.770E-03,-2.580E-03, 7.300E-04,-7.100E-04,
 997
 998      2 3.840E-03,-6.050E-03, 3.030E-03,-2.030E-03, 5.800E-04,-5.900E-04,
 999
1000      3-8.800E-04, 1.660E-03,-7.500E-04, 4.700E-04,-1.000E-04, 1.000E-04,
1001
1002      4-8.000E-05,-1.500E-04, 1.200E-04,-9.000E-05, 3.000E-05, 0.000E+00,
1003
1004      5 1.300E-04,-2.200E-04,-2.000E-05,-2.000E-05,-2.000E-05,-2.000E-05,
1005
1006      6-7.000E-05, 1.900E-04,-4.000E-05, 2.000E-05, 0.000E+00, 0.000E+00,
1007
1008      1 6.623E-01,-9.248E-01, 3.519E-01,-7.930E-02, 1.110E-02,-1.180E-03,
1009
1010      2 6.380E-01,-9.062E-01, 3.582E-01,-8.479E-02, 1.265E-02,-1.390E-03,
1011
1012      3-2.581E-02, 2.125E-02, 4.190E-03,-4.980E-03, 1.490E-03,-2.100E-04,
1013
1014      4 7.100E-04, 5.300E-04,-1.270E-03, 3.900E-04,-5.000E-05,-1.000E-05,
1015
1016      5 3.850E-03,-5.060E-03, 1.860E-03,-3.500E-04, 4.000E-05, 0.000E+00,
1017
1018      6-3.530E-03, 4.460E-03,-1.500E-03, 2.700E-04,-3.000E-05, 0.000E+00/
1019
1020       DATA (((CEHLQ(IX,IT,NX,8,2),IX=1,6),IT=1,6),NX=1,2)/
1021
1022      1 4.260E-03,-7.530E-03, 3.830E-03,-2.680E-03, 7.600E-04,-7.300E-04,
1023
1024      2 3.640E-03,-6.050E-03, 3.030E-03,-2.090E-03, 5.900E-04,-6.000E-04,
1025
1026      3-9.200E-04, 1.710E-03,-8.200E-04, 5.000E-04,-1.200E-04, 1.000E-04,
1027
1028      4-5.000E-05,-1.600E-04, 1.300E-04,-9.000E-05, 3.000E-05, 0.000E+00,
1029
1030      5 1.300E-04,-2.100E-04,-1.000E-05,-2.000E-05,-2.000E-05,-1.000E-05,
1031
1032      6-8.000E-05, 1.800E-04,-5.000E-05, 2.000E-05, 0.000E+00, 0.000E+00,
1033
1034      1 7.146E-01,-1.007E+00, 3.932E-01,-9.246E-02, 1.366E-02,-1.540E-03,
1035
1036      2 6.856E-01,-9.828E-01, 3.977E-01,-9.795E-02, 1.540E-02,-1.790E-03,
1037
1038      3-3.053E-02, 2.758E-02, 2.150E-03,-4.880E-03, 1.640E-03,-2.500E-04,
1039
1040      4 9.200E-04, 4.200E-04,-1.340E-03, 4.600E-04,-8.000E-05,-1.000E-05,
1041
1042      5 4.230E-03,-5.660E-03, 2.140E-03,-4.300E-04, 6.000E-05, 0.000E+00,
1043
1044      6-3.890E-03, 5.000E-03,-1.740E-03, 3.300E-04,-4.000E-05, 0.000E+00/
1045
1046       DATA TBMIN,TTMIN/8.1905,7.4474,11.5528,10.8097/
1047
1048       DATA XOLD,QOLD,IOLD,NOLD/-1.,0.,0,0/
1049
1050       DATA DMIN,Q0,QL/0.,2*2.,2*2.236,2.,.2,.4,.2,.29,.177/
1051
1052       IF (X.LE.ZERO) CALL HWWARN('HWSFUN',100,*999)
1053
1054       XMWN=ONE-X
1055
1056       IF (XMWN.LE.ZERO) THEN
1057
1058         DO 1 I=1,13
1059
1060           DIST(I)=0
1061
1062  1      CONTINUE
1063
1064         RETURN
1065
1066       ENDIF
1067
1068 C---FREEZE THE SCALE IF REQUIRED
1069
1070       SCALEF=SCALE
1071
1072       IF (ISPAC.GT.0) SCALEF=MAX(SCALEF,QSPAC)
1073
1074 C---CHECK IF PDFLIB REQUESTED
1075
1076       IF (IBEAM.EQ.1.OR.IBEAM.EQ.2) THEN
1077
1078         MPDF=MODPDF(IBEAM)
1079
1080       ELSE
1081
1082         MPDF=-1
1083
1084       ENDIF
1085
1086       QSCA=ABS(SCALEF)
1087
1088       IF (IDHAD.EQ.59.OR.IDHAD.EQ.71) THEN
1089
1090         IF (MPDF.GE.0) THEN
1091
1092 C---USE PDFLIB PHOTON STRUCTURE FUNCTIONS
1093
1094           PARM(1)=AUTPDF(IBEAM)
1095
1096           VAL(1)=FLOAT(MPDF)
1097
1098 C---FIX TO CALL SCHULER-SJOSTRAND CODE
1099
1100           IF (AUTPDF(IBEAM).EQ.'SaSph') THEN
1101
1102             XSP=X
1103
1104             IF (    XSP.LE.ZERO) CALL HWWARN('HWSFUN',102,*999)
1105
1106             IF (ONE-XSP.LE.ZERO) CALL HWWARN('HWSFUN',103,*999)
1107
1108             Q2=QSCA**2
1109
1110             ISET=MOD(MODPDF(IBEAM),10)
1111
1112             IOP1=MOD(MODPDF(IBEAM)/10,2)
1113
1114             IOP2=MOD(MODPDF(IBEAM)/20,2)
1115
1116             IP2=MODPDF(IBEAM)/100
1117
1118             IF (IOP2.EQ.0) THEN
1119
1120               P2=0.
1121
1122             ELSE
1123
1124               IHAD=IBEAM
1125
1126               IF (JDAHEP(1,IHAD).NE.0) IHAD=JDAHEP(1,IHAD)
1127
1128               P2=PHEP(5,IHAD)**2
1129
1130             ENDIF
1131
1132             CALL SASGAM(ISET,XSP,Q2,P2,IP2,F2GM,XPGA)
1133
1134             IF (IOP1.EQ.1 .AND. ISTAT.LT.10) THEN
1135
1136               DO 5 I=-6,6
1137
1138  5            XPGA(I)=XPVMD(I)+XPANL(I)+XPBEH(I)+XPDIR(I)
1139
1140             ENDIF
1141
1142             UPV=XPGA(2)
1143
1144             DNV=XPGA(1)
1145
1146             USEA=XPGA(2)
1147
1148             DSEA=XPGA(1)
1149
1150             STR=XPGA(3)
1151
1152             CHM=XPGA(4)
1153
1154             BTM=XPGA(5)
1155
1156             TOP=XPGA(6)
1157
1158             GLU=XPGA(0)
1159
1160           ELSE
1161
1162             CALL PDFSET(PARM,VAL)
1163
1164             IF (X.LT.PDFXMN.AND.PDFWRX(IBEAM,1) .OR.
1165
1166      &          X.GT.PDFXMX.AND.PDFWRX(IBEAM,2)) THEN
1167
1168               CALL HWWARN('HWSFUN',2,*999)
1169
1170               WRITE (6,'(2A)') ' WARNING: PDFLIB CALLED WITH X',
1171
1172      &             ' OUTSIDE ALLOWED RANGE!'
1173
1174               WRITE (6,'(1P,3(A,E9.3))') ' X VALUE=',X,
1175
1176      &             ', MINIMUM=',PDFXMN,', MAXIMUM=',PDFXMX
1177
1178               WRITE (6,'(A)') ' NO FURTHER WARNINGS WILL BE ISSUED'
1179
1180               IF (X.LT.PDFXMN) PDFWRX(IBEAM,1)=.FALSE.
1181
1182               IF (X.GT.PDFXMX) PDFWRX(IBEAM,2)=.FALSE.
1183
1184             ENDIF
1185
1186             IF (QSCA**2.LT.PDFQMN.AND.PDFWRQ(IBEAM,1) .OR.
1187
1188      &          QSCA**2.GT.PDFQMX.AND.PDFWRQ(IBEAM,2)) THEN
1189
1190               CALL HWWARN('HWSFUN',3,*999)
1191
1192               WRITE (6,'(2A)') ' WARNING: PDFLIB CALLED WITH Q',
1193
1194      &             ' OUTSIDE ALLOWED RANGE!'
1195
1196               WRITE (6,'(1P,3(A,E9.3))') ' Q VALUE=',QSCA,
1197
1198      &             ', MINIMUM=',SQRT(PDFQMN),', MAXIMUM=',SQRT(PDFQMX)
1199
1200               WRITE (6,'(A)') ' NO FURTHER WARNINGS WILL BE ISSUED'
1201
1202               IF (QSCA**2.LT.PDFQMN) PDFWRQ(IBEAM,1)=.FALSE.
1203
1204               IF (QSCA**2.GT.PDFQMN) PDFWRQ(IBEAM,2)=.FALSE.
1205
1206             ENDIF
1207
1208             CALL STRUCTM(X,QSCA,UPV,DNV,USEA,DSEA,STR,CHM,BTM,TOP,GLU)
1209
1210           ENDIF
1211
1212           DIST(1)=DSEA
1213
1214           DIST(2)=USEA
1215
1216           DIST(7)=DSEA
1217
1218           DIST(8)=USEA
1219
1220         ELSE
1221
1222           XSP=X
1223
1224           IF (    XSP.LE.ZERO) CALL HWWARN('HWSFUN',102,*999)
1225
1226           IF (ONE-XSP.LE.ZERO) CALL HWWARN('HWSFUN',103,*999)
1227
1228           Q2=SCALEF**2
1229
1230           W2=Q2*(1-X)/X
1231
1232           EMC2=4*RMASS(4)**2
1233
1234           EMB2=4*RMASS(5)**2
1235
1236           ALAM2=0.160
1237
1238           NFL=3
1239
1240           IF (Q2.GT.50.) NFL=4
1241
1242           IF (Q2.GT.500.) NFL=5
1243
1244           STR=HWSDGQ(XSP,Q2,NFL,1)
1245
1246           CHM=HWSDGQ(XSP,Q2,NFL,2)
1247
1248           GLU=HWSDGG(XSP,Q2,NFL)
1249
1250           DIST(1)=STR
1251
1252           DIST(2)=CHM
1253
1254           DIST(7)=STR
1255
1256           DIST(8)=CHM
1257
1258           IF (W2.GT.EMB2) THEN
1259
1260             BTM=STR
1261
1262             IF (W2*ALAM2.LT.Q2*EMB2)
1263
1264      &          BTM=BTM*LOG(W2/EMB2)/LOG(Q2/ALAM2)
1265
1266           ELSE
1267
1268             BTM=0.
1269
1270           ENDIF
1271
1272           IF (W2.GT.EMC2) THEN
1273
1274             IF (W2*ALAM2.LT.Q2*EMC2)
1275
1276      &          CHM=CHM*LOG(W2/EMC2)/LOG(Q2/ALAM2)
1277
1278           ELSE
1279
1280             CHM=0.
1281
1282           ENDIF
1283
1284           TOP=0.
1285
1286         ENDIF
1287
1288 C---INCLUDE SUPPRESSION FROM PHOTON VIRTUALITY IF NECESSARY
1289
1290         IF (PHOMAS.GT.ZERO.AND.(IBEAM.EQ.1.OR.IBEAM.EQ.2)) THEN
1291
1292           IHAD=IBEAM
1293
1294           IF (JDAHEP(1,IHAD).NE.0) IHAD=JDAHEP(1,IHAD)
1295
1296           IF (IDHW(IHAD).EQ.59) THEN
1297
1298             FAC=LOG((QSCA**2+PHOMAS**2)/(PHEP(5,IHAD)**2+PHOMAS**2))/
1299
1300      $          LOG((QSCA**2+PHOMAS**2)/(                PHOMAS**2))
1301
1302             IF (FAC.LT.ZERO) FAC=ZERO
1303
1304             DIST(1)=DIST(1)*FAC
1305
1306             DIST(2)=DIST(2)*FAC
1307
1308             DIST(7)=DIST(7)*FAC
1309
1310             DIST(8)=DIST(8)*FAC
1311
1312             STR=STR*FAC
1313
1314             CHM=CHM*FAC
1315
1316             BTM=BTM*FAC
1317
1318             TOP=TOP*FAC
1319
1320             GLU=GLU*FAC**2
1321
1322           ELSE
1323
1324             CALL HWWARN('HWSFUN',1,*999)
1325
1326           ENDIF
1327
1328         ENDIF
1329
1330         GOTO 900
1331
1332       ENDIF
1333
1334       IF (MPDF.GE.0) THEN
1335
1336 C---USE PDFLIB NUCLEON STRUCTURE FUNCTIONS
1337
1338         PARM(1)=AUTPDF(IBEAM)
1339
1340         VAL(1)=FLOAT(MPDF)
1341
1342         CALL PDFSET(PARM,VAL)
1343
1344         IF (X.LT.PDFXMN.AND.PDFWRX(IBEAM,1) .OR.
1345
1346      &      X.GT.PDFXMX.AND.PDFWRX(IBEAM,2)) THEN
1347
1348           CALL HWWARN('HWSFUN',4,*999)
1349
1350           WRITE (6,'(2A)') ' WARNING: PDFLIB CALLED WITH X',
1351
1352      &         ' OUTSIDE ALLOWED RANGE!'
1353
1354           WRITE (6,'(1P,3(A,E9.3))') ' X VALUE=',X,
1355
1356      &         ', MINIMUM=',PDFXMN,', MAXIMUM=',PDFXMX
1357
1358           WRITE (6,'(A)') ' NO FURTHER WARNINGS WILL BE ISSUED'
1359
1360           IF (X.LT.PDFXMN) PDFWRX(IBEAM,1)=.FALSE.
1361
1362           IF (X.GT.PDFXMX) PDFWRX(IBEAM,2)=.FALSE.
1363
1364         ENDIF
1365
1366         IF (QSCA**2.LT.PDFQMN.AND.PDFWRQ(IBEAM,1) .OR.
1367
1368      &      QSCA**2.GT.PDFQMX.AND.PDFWRQ(IBEAM,2)) THEN
1369
1370           CALL HWWARN('HWSFUN',5,*999)
1371
1372           WRITE (6,'(2A)') ' WARNING: PDFLIB CALLED WITH Q',
1373
1374      &         ' OUTSIDE ALLOWED RANGE!'
1375
1376           WRITE (6,'(1P,3(A,E9.3))') ' Q VALUE=',QSCA,
1377
1378      &         ', MINIMUM=',SQRT(PDFQMN),', MAXIMUM=',SQRT(PDFQMX)
1379
1380           WRITE (6,'(A)') ' NO FURTHER WARNINGS WILL BE ISSUED'
1381
1382           IF (QSCA**2.LT.PDFQMN) PDFWRQ(IBEAM,1)=.FALSE.
1383
1384           IF (QSCA**2.GT.PDFQMN) PDFWRQ(IBEAM,2)=.FALSE.
1385
1386         ENDIF
1387
1388         CALL STRUCTM(X,QSCA,UPV,DNV,USEA,DSEA,STR,CHM,BTM,TOP,GLU)
1389
1390       ELSE
1391
1392         IF (QSCA.LT.Q0(NSET)) QSCA=Q0(NSET)
1393
1394         IF (QSCA.NE.QOLD.OR.IDHAD.NE.IOLD.OR.NSET.NE.NOLD) THEN
1395
1396 C---INITIALIZE
1397
1398           IF (NSET.LT.1.OR.NSET.GT.5) CALL HWWARN('HWSFUN',400,*999)
1399
1400           QOLD=QSCA
1401
1402           IOLD=IDHAD
1403
1404           NOLD=NSET
1405
1406           SS=LOG(QSCA/QL(NSET))
1407
1408           SMIN=LOG(Q0(NSET)/QL(NSET))
1409
1410           IF (NSET.LT.3.OR.NSET.EQ.5) THEN
1411
1412             S=LOG(SS/SMIN)
1413
1414           ELSE
1415
1416             T=2.*SS
1417
1418             TMIN=2.*SMIN
1419
1420             TMAX=2.*LOG(1.E4/QL(NSET))
1421
1422           ENDIF
1423
1424           IF (IDHAD.GE.72) THEN
1425
1426             IF (NSET.LT.3) THEN
1427
1428               IP=NSET
1429
1430               DO 10 I=1,5
1431
1432               DO 10 J=1,6
1433
1434    10         A(J,I)=B(1,J,I,IP)+S*(B(2,J,I,IP)+S*B(3,J,I,IP))
1435
1436               DO 20 K=1,2
1437
1438               AA=ONE+A(2,K)+A(3,K)
1439
1440    20         G(K)=HWSGAM(AA)/((ONE+A(2,K)*A(4,K)/AA)*HWSGAM(A(2,K))
1441
1442      &            *HWSGAM(ONE+A(3,K)))
1443
1444             ELSEIF (NSET.EQ.5) THEN
1445
1446               DO 21 I=1,5
1447
1448               DO 21 J=1,6
1449
1450    21         A(J,I)=BB(1,J,I)+S*(BB(2,J,I)+S*(BB(3,J,I)+S*BB(4,J,I)))
1451
1452               DO 22 K=1,2
1453
1454               AA=ONE+A(2,K)+A(3,K)
1455
1456    22         G(K)=HWSGAM(AA)/((ONE+A(2,K)/AA*(A(4,K)+
1457
1458      &            (ONE+A(2,K))/(ONE+AA)*A(5,K)))*HWSGAM(A(2,K))
1459
1460      &            *HWSGAM(ONE+A(3,K)))
1461
1462             ELSE
1463
1464               IP=NSET-2
1465
1466               VT=MAX(-ONE,MIN(ONE,(2.*T-TMAX-TMIN)/(TMAX-TMIN)))
1467
1468               WT=VT*VT
1469
1470 C...CHEBYSHEV POLYNOMIALS FOR T EXPANSION
1471
1472               TT(1)=1.
1473
1474               TT(2)=VT
1475
1476               TT(3)=   2.*WT- 1.
1477
1478               TT(4)=  (4.*WT- 3.)*VT
1479
1480               TT(5)=  (8.*WT- 8.)*WT+1.
1481
1482               TT(6)=((16.*WT-20.)*WT+5.)*VT
1483
1484             ENDIF
1485
1486           ELSEIF (NSET.LT.3) THEN
1487
1488               IP=NSET+2
1489
1490               DO 30 I=1,5
1491
1492               DO 30 J=1,6
1493
1494    30         A(J,I)=B(1,J,I,IP)+S*(B(2,J,I,IP)+S*B(3,J,I,IP))
1495
1496               AA=ONE+A(2,1)+A(3,1)
1497
1498               G(1)=HWSGAM(AA)/(HWSGAM(A(2,1))*HWSGAM(ONE+A(3,1)))
1499
1500               G(2)=0.
1501
1502            ENDIF
1503
1504         ENDIF
1505
1506 C
1507
1508         IF (NSET.LT.3.OR.NSET.EQ.5) THEN
1509
1510           DO 50 I=1,5
1511
1512    50     F(I)=A(1,I)*X**A(2,I)*XMWN**A(3,I)*(ONE+X*
1513
1514      &        (A(4,I)+X*(A(5,I)  +  X*A(6,I))))
1515
1516           F(1)=F(1)*G(1)
1517
1518           F(2)=F(2)*G(2)
1519
1520           UPV=F(1)-F(2)
1521
1522           DNV=F(2)
1523
1524           SEA=F(3)/6.
1525
1526           STR=SEA
1527
1528           CHM=F(4)
1529
1530           BTM=0.
1531
1532           TOP=0.
1533
1534           GLU=F(5)
1535
1536         ELSE
1537
1538           IF (X.NE.XOLD) THEN
1539
1540             XOLD=X
1541
1542             IF (X.GT.0.1) THEN
1543
1544               NX=1
1545
1546               VX=(2.*X-1.1)/0.9
1547
1548             ELSE
1549
1550               NX=2
1551
1552               VX=MAX(-ONE,(2.*LOG(X)+11.51293)/6.90776)
1553
1554             ENDIF
1555
1556             WX=VX*VX
1557
1558             TX(1)=1.
1559
1560             TX(2)=VX
1561
1562             TX(3)=   2.*WX- 1.
1563
1564             TX(4)=  (4.*WX- 3.)*VX
1565
1566             TX(5)=  (8.*WX- 8.)*WX+1.
1567
1568             TX(6)=((16.*WX-20.)*WX+5.)*VX
1569
1570           ENDIF
1571
1572 C...CALCULATE STRUCTURE FUNCTIONS
1573
1574           DO 120 IFL=1,6
1575
1576           XQSUM=0.
1577
1578           DO 110 IT=1,6
1579
1580           DO 110 IX=1,6
1581
1582   110     XQSUM=XQSUM+CEHLQ(IX,IT,NX,IFL,IP)*TX(IX)*TT(IT)
1583
1584   120     XQ(IFL)=XQSUM*XMWN**NEHLQ(IFL,IP)
1585
1586           UPV=XQ(1)
1587
1588           DNV=XQ(2)
1589
1590           STR=XQ(5)
1591
1592           CHM=XQ(6)
1593
1594           SEA=XQ(3)
1595
1596           GLU=XQ(4)
1597
1598 C...SPECIAL EXPANSION FOR BOTTOM (THRESHOLD EFFECTS)
1599
1600           IF (NFLAV.LT.5.OR.T.LE.TBMIN(IP)) THEN
1601
1602             BTM=0.
1603
1604           ELSE
1605
1606             VT=MAX(-ONE,MIN(ONE,(2.*T-TMAX-TBMIN(IP))/(TMAX-TBMIN(IP))))
1607
1608             WT=VT*VT
1609
1610             TB(1)=1.
1611
1612             TB(2)=VT
1613
1614             TB(3)=   2.*WT- 1.
1615
1616             TB(4)=  (4.*WT- 3.)*VT
1617
1618             TB(5)=  (8.*WT- 8.)*WT+1.
1619
1620             TB(6)=((16.*WT-20.)*WT+5.)*VT
1621
1622             XQSUM=0.
1623
1624             DO 130 IT=1,6
1625
1626             DO 130 IX=1,6
1627
1628   130       XQSUM=XQSUM+CEHLQ(IX,IT,NX,7,IP)*TX(IX)*TB(IT)
1629
1630             BTM=XQSUM*XMWN**NEHLQ(7,IP)
1631
1632           ENDIF
1633
1634 C...SPECIAL EXPANSION FOR TOP (THRESHOLD EFFECTS)
1635
1636           TPMIN=TTMIN(IP)+TMTOP
1637
1638 C---TMTOP=2.*LOG(TOPMAS/30.)
1639
1640           TPMAX=TMAX+TMTOP
1641
1642           IF (NFLAV.LT.6.OR.T.LE.TPMIN) THEN
1643
1644             TOP=0.
1645
1646           ELSE
1647
1648             VT=MAX(-ONE,MIN(ONE,(2.*T-TPMAX-TPMIN)/(TPMAX-TPMIN)))
1649
1650             WT=VT*VT
1651
1652             TB(1)=1.
1653
1654             TB(2)=VT
1655
1656             TB(3)=   2.*WT- 1.
1657
1658             TB(4)=  (4.*WT- 3.)*VT
1659
1660             TB(5)=  (8.*WT- 8.)*WT+1.
1661
1662             TB(6)=((16.*WT-20.)*WT+5.)*VT
1663
1664             XQSUM=0.
1665
1666             DO 150 IT=1,6
1667
1668             DO 150 IX=1,6
1669
1670   150       XQSUM=XQSUM+CEHLQ(IX,IT,NX,8,IP)*TX(IX)*TB(IT)
1671
1672             TOP=XQSUM*XMWN**NEHLQ(8,IP)
1673
1674           ENDIF
1675
1676         ENDIF
1677
1678       ENDIF
1679
1680       IF (MPDF.LT.0) THEN
1681
1682         USEA=SEA
1683
1684         DSEA=USEA
1685
1686       ENDIF
1687
1688       IF (IDHAD.EQ.73.OR.IDHAD.EQ.72) THEN
1689
1690          DIST(1)=DSEA+DNV
1691
1692          DIST(2)=USEA+UPV
1693
1694          DIST(7)=DSEA
1695
1696          DIST(8)=USEA
1697
1698       ELSEIF (IDHAD.EQ.91) THEN
1699
1700          DIST(1)=DSEA
1701
1702          DIST(2)=USEA
1703
1704          DIST(7)=DSEA+DNV
1705
1706          DIST(8)=USEA+UPV
1707
1708       ELSEIF (IDHAD.EQ.75) THEN
1709
1710          DIST(1)=USEA+UPV
1711
1712          DIST(2)=DSEA+DNV
1713
1714          DIST(7)=USEA
1715
1716          DIST(8)=DSEA
1717
1718       ELSEIF (IDHAD.EQ.93) THEN
1719
1720          DIST(1)=USEA
1721
1722          DIST(2)=DSEA
1723
1724          DIST(7)=USEA+UPV
1725
1726          DIST(8)=DSEA+DNV
1727
1728       ELSEIF (IDHAD.EQ.38) THEN
1729
1730          DIST(1)=USEA
1731
1732          DIST(2)=USEA+UPV
1733
1734          DIST(7)=USEA+UPV
1735
1736          DIST(8)=USEA
1737
1738       ELSEIF (IDHAD.EQ.30) THEN
1739
1740          DIST(1)=USEA+UPV
1741
1742          DIST(2)=USEA
1743
1744          DIST(7)=USEA
1745
1746          DIST(8)=USEA+UPV
1747
1748       ELSE
1749
1750          PRINT *,' CALLED HWSFUN FOR IDHAD =',IDHAD
1751
1752          CALL HWWARN('HWSFUN',400,*999)
1753
1754       ENDIF
1755
1756   900 DIST(3)=STR
1757
1758       DIST(4)=CHM
1759
1760       DIST(5)=BTM
1761
1762       DIST(6)=TOP
1763
1764       DIST(9)=STR
1765
1766       DIST(10)=CHM
1767
1768       DIST(11)=BTM
1769
1770       DIST(12)=TOP
1771
1772       DIST(13)=GLU
1773
1774       DO 901 I=1,13
1775
1776       IF (DIST(I).LT.DMIN) DIST(I)=DMIN
1777
1778   901 CONTINUE
1779
1780 C---FOR REMNANT NUCLEONS SWITCH OFF VALENCE QUARKS,
1781
1782 C   WHILE MAINTAINING MOMENTUM SUM RULE
1783
1784       IF (IDHAD.EQ.72) THEN
1785
1786         TOTAL=0
1787
1788         DO 910 I=1,13
1789
1790           TOTAL=TOTAL+DIST(I)
1791
1792  910    CONTINUE
1793
1794         DIST(1)=DIST(1)-DNV
1795
1796         DIST(2)=DIST(2)-UPV
1797
1798         IF (TOTAL.GT.DNV+UPV) THEN
1799
1800           DO 920 I=1,13
1801
1802             DIST(I)=DIST(I)*TOTAL/(TOTAL-DNV-UPV)
1803
1804  920      CONTINUE
1805
1806         ENDIF
1807
1808       ENDIF
1809
1810   999 END
1811
1812 CDECK  ID>, HWSGAM.
1813
1814 *CMZ :-        -26/04/91  11.11.56  by  Bryan Webber
1815
1816 *-- Author :    Adapted by Bryan Webber
1817
1818 C-----------------------------------------------------------------------
1819
1820       FUNCTION HWSGAM(ZINPUT)
1821
1822 C-----------------------------------------------------------------------
1823
1824 C   Gamma function computed by eq. 6.1.40, Abramowitz.
1825
1826 C   B(M) = B2m/(2m *(2m-1)) where B2m is the 2m'th Bernoulli number.
1827
1828 C   HLNTPI = .5*LOG(2.*PI)
1829
1830 C-----------------------------------------------------------------------
1831
1832       DOUBLE PRECISION HWSGAM,ZINPUT,B(10),HLNTPI,Z,SHIFT,G,T,RECZSQ
1833
1834       INTEGER I
1835
1836       DATA B/
1837
1838      1       0.83333333333333333333D-01,   -0.27777777777777777778D-02,
1839
1840      1       0.79365079365079365079D-03,   -0.59523809523809523810D-03,
1841
1842      1       0.84175084175084175084D-03,   -0.19175269175269175269D-02,
1843
1844      1       0.64102564102564102564D-02,   -0.29550653594771241830D-01,
1845
1846      1       0.17964437236883057316D0  ,    -1.3924322169059011164D0  /
1847
1848       DATA HLNTPI/0.91893853320467274178D0/
1849
1850 C
1851
1852 C   Shift argument to large value ( > 20 )
1853
1854 C
1855
1856       Z=ZINPUT
1857
1858       SHIFT=1.
1859
1860    10 IF (Z.LT.20.D0) THEN
1861
1862          SHIFT = SHIFT*Z
1863
1864          Z = Z + 1.D0
1865
1866          GOTO 10
1867
1868       ENDIF
1869
1870 C
1871
1872 C   Compute asymptotic formula
1873
1874 C
1875
1876       G = (Z-.5D0)*LOG(Z) - Z + HLNTPI
1877
1878       T = 1.D0/Z
1879
1880       RECZSQ = T**2
1881
1882       DO 20 I = 1,10
1883
1884          G = G + B(I)*T
1885
1886          T = T*RECZSQ
1887
1888    20 CONTINUE
1889
1890       HWSGAM = EXP(G)/SHIFT
1891
1892       END