HERWIG/src/hwsbrn.f

   1
   2 CDECK  ID>, HWSBRN.
   3
   4 *CMZ :-        -18/10/99  19.08.45  by  Mike Seymour
   5
   6 *-- Author :    Bryan Webber
   7
   8 C-----------------------------------------------------------------------
   9
  10       SUBROUTINE HWSBRN(KPAR)
  11
  12 C-----------------------------------------------------------------------
  13
  14 C     DOES BRANCHING OF SPACELIKE PARTON KPAR
  15
  16 C-----------------------------------------------------------------------
  17
  18       INCLUDE 'HERWIG61.INC'
  19
  20       DOUBLE PRECISION HWBVMC,HWR,HWRUNI,HWSTAB,HWUALF,HWUTAB,HWSGQQ,
  21
  22      & HWSSUD,XLAST,QNOW,QLST,QP,QMIN,QLAM,QSAV,SMAX,SLST,SNOW,RN,SUDA,
  23
  24      & SUDB,ZZ,ENOW,XI,PMOM,DIST(13),DMIN,X1,X2,REJFAC,OTHXI,OTHZ,QTMP,
  25
  26      & PTMP(2),JAC,OTHJAC,S,T,U
  27
  28       INTEGER N0,IS,ID,ID1,ID2,IDHAD,N1,I,MQ,NTRY,NDEL,NA,NB,IW1,IW2,
  29
  30      & KPAR,LPAR,MPAR,ISUD(13),IREJ,NREJ
  31
  32       LOGICAL HWSVAL,FORCE,VALPAR,FTMP
  33
  34       EXTERNAL HWBVMC,HWR,HWRUNI,HWSTAB,HWUALF,HWUTAB,HWSGQQ,HWSSUD,
  35
  36      & HWSVAL
  37
  38       COMMON/HWTABC/XLAST,N0,IS,ID
  39
  40       DATA ISUD,DMIN/2,2,3,4,5,6,2,2,3,4,5,6,1,1.D-15/
  41
  42       IF (IERROR.NE.0) RETURN
  43
  44       ID=IDPAR(KPAR)
  45
  46 C--TEST FOR PARTON TYPE
  47
  48       IF (ID.LE.13) THEN
  49
  50         IS=ISUD(ID)
  51
  52       ELSEIF (ID.GE.208) THEN
  53
  54         IS=7
  55
  56       ELSE
  57
  58         IS=0
  59
  60       END IF
  61
  62       QNOW=-1.
  63
  64       IF (IS.NE.0) THEN
  65
  66 C--SPACELIKE PARTON BRANCHING
  67
  68         QLST=PPAR(1,KPAR)
  69
  70         IDHAD=IDHW(INHAD)
  71
  72         VALPAR=HWSVAL(ID)
  73
  74         QP=HWBVMC(ID)
  75
  76         XLAST=XFACT*PPAR(4,KPAR)
  77
  78         IF (XLAST.GE.ONE) CALL HWWARN('HWSBRN',107,*999)
  79
  80 C--SET UP Q BOUNDARY
  81
  82         IF (VALPAR) THEN
  83
  84           QMIN=QG/(1.-XLAST)
  85
  86         ELSEIF (ID.EQ.13) THEN
  87
  88           QMIN=QV/(1.-XLAST)
  89
  90         ELSE
  91
  92           QMIN=.5*(QP+QV+SQRT((QP-QV)**2+4.*QP*QV*XLAST))/(1.-XLAST)
  93
  94         ENDIF
  95
  96         QSAV=QMIN
  97
  98         IF (QMIN.LE.QSPAC.AND.ISPAC.LT.2) THEN
  99
 100           QMIN=QSPAC
 101
 102           N1=NSPAC(IS)
 103
 104         ELSEIF (QMIN.LE.QEV(1,IS)) THEN
 105
 106           QMIN=QEV(1,IS)
 107
 108           N1=1
 109
 110         ELSE
 111
 112           DO 110 I=2,NQEV
 113
 114           IF (QEV(I,IS).GT.QMIN) GOTO 120
 115
 116   110     CONTINUE
 117
 118   120     N1=I-1
 119
 120         ENDIF
 121
 122         N0=N1-1
 123
 124         MQ=NQEV-N0
 125
 126         NTRY=0
 127
 128   125   NTRY=NTRY+1
 129
 130         NREJ=1
 131
 132         IF (QLST.GT.QMIN.AND..NOT.NOSPAC.OR..NOT.VALPAR) THEN
 133
 134           IF (QLST.LE.QMIN) THEN
 135
 136 C--CHECK PHASE SPACE FOR FORCED SPLITTING OF NON-VALENCE PARTON
 137
 138             IF (QLST.LT.QSAV) CALL HWWARN('HWSBRN',ISLENT*105,*999)
 139
 140             FORCE=.TRUE.
 141
 142             QNOW=(QLST/QSAV)**HWR()*QSAV
 143
 144           ELSE
 145
 146 C--ENHANCE EMISSION BY A FACTOR OF TWO IF THIS BRANCH
 147
 148 C  IS CAPABLE OF BEING THE HARDEST SO FAR
 149
 150            IF (QLST.GT.HARDST) NREJ=2
 151
 152            QTMP=-1
 153
 154            DO 300 IREJ=1,NREJ
 155
 156 C--FIND NEW VALUE OF SUD/DIST
 157
 158             CALL HWSFUN(XLAST,QMIN,IDHAD,NSTRU,DIST,JNHAD)
 159
 160             IF (ID.EQ.13) DIST(ID)=DIST(ID)*HWSGQQ(QMIN)
 161
 162             IF (DIST(ID).LT.DMIN) DIST(ID)=DMIN
 163
 164             SMAX=HWUTAB(SUD(N1,IS),QEV(N1,IS),MQ,QMIN,INTER)/DIST(ID)
 165
 166             CALL HWSFUN(XLAST,QLST,IDHAD,NSTRU,DIST,JNHAD)
 167
 168             IF (ID.EQ.13) DIST(ID)=DIST(ID)*HWSGQQ(QLST)
 169
 170             IF (DIST(ID).LT.DMIN) DIST(ID)=DMIN
 171
 172             SLST=HWUTAB(SUD(N1,IS),QEV(N1,IS),MQ,QLST,INTER)/DIST(ID)
 173
 174             RN=HWR()
 175
 176             IF (RN.EQ.ZERO) THEN
 177
 178               SNOW=SLST*2.
 179
 180             ELSE
 181
 182               SNOW=SLST/RN
 183
 184             ENDIF
 185
 186             IF (VALPAR.AND.SNOW.GE.SMAX) GOTO 200
 187
 188             IF (SNOW.LT.SMAX.AND..NOT.NOSPAC) THEN
 189
 190               FORCE=.FALSE.
 191
 192             ELSE
 193
 194 C--FORCE SPLITTING OF NON-VALENCE PARTON
 195
 196               FORCE=.TRUE.
 197
 198               QNOW=(MIN(QLST,1.1*QMIN)/QSAV)**HWR()*QSAV
 199
 200             ENDIF
 201
 202             IF (QNOW.LT.ZERO) THEN
 203
 204 C--BRANCHING OCCURS. FIRST CHECK FOR MONOTONIC FORM FACTOR
 205
 206               SUDA=SMAX
 207
 208               NDEL=32
 209
 210               NA=N1
 211
 212   130         NB=NA+NDEL
 213
 214               IF (NB.GT.NQEV) CALL HWWARN('HWSBRN',103,*999)
 215
 216               CALL HWSFUN(XLAST,QEV(NB,IS),IDHAD,NSTRU,DIST,JNHAD)
 217
 218               IF (ID.EQ.13) DIST(ID)=DIST(ID)*HWSGQQ(QEV(NB,IS))
 219
 220               IF (DIST(ID).LT.DMIN) DIST(ID)=DMIN
 221
 222               SUDB=SUD(NB,IS)/DIST(ID)
 223
 224               IF (SUDB.GT.SUDA) THEN
 225
 226                 SUDA=SUDB
 227
 228                 NA=NB
 229
 230                 GOTO 130
 231
 232               ELSEIF (NA.NE.N1) THEN
 233
 234                 IF (SUDB.LT.SNOW) THEN
 235
 236                   NDEL=NDEL/2
 237
 238                   IF (NDEL.EQ.0) CALL HWWARN('HWSBRN',100,*999)
 239
 240                   GOTO 130
 241
 242                 ENDIF
 243
 244                 N1=NB
 245
 246                 N0=N1-1
 247
 248                 MQ=NQEV-N0
 249
 250               ENDIF
 251
 252 C--NOW FIND NEW Q
 253
 254               QNOW=HWSTAB(QEV(N1,IS),HWSSUD,MQ,SNOW,INTER)
 255
 256               IF (QNOW.LE.QMIN.OR.QNOW.GT.QLST) THEN
 257
 258 C--INTERPOLATION PROBLEM: USE LINEAR INSTEAD
 259
 260 C                CALL HWWARN('HWSBRN',1,*999)
 261
 262                 QNOW=HWRUNI(0,QMIN,QLST)
 263
 264               ENDIF
 265
 266             ENDIF
 267
 268  200        CONTINUE
 269
 270             IF (QNOW.GT.QTMP) THEN
 271
 272               QTMP=QNOW
 273
 274               FTMP=FORCE
 275
 276             ENDIF
 277
 278             QNOW=-1
 279
 280  300       CONTINUE
 281
 282            QNOW=QTMP
 283
 284            FORCE=FTMP
 285
 286           ENDIF
 287
 288           IF (QNOW.LT.ZERO) GOTO 210
 289
 290 C--NOW FIND NEW X
 291
 292           CALL HWSFBR(XLAST,QNOW,FORCE,ID,1,ID1,ID2,IW1,IW2,ZZ)
 293
 294           IF (ID1.LT.0) THEN
 295
 296 C--NO PHASE SPACE FOR BRANCHING
 297
 298             FROST=.TRUE.
 299
 300             RETURN
 301
 302           ELSEIF (ID1.EQ.0) THEN
 303
 304 C--BRANCHING REJECTED: REDUCE Q AND REPEAT
 305
 306             IF (NTRY.GT.NBTRY.OR.IERROR.NE.0)
 307
 308      $           CALL HWWARN('HWSBRN',102,*999)
 309
 310             QLST=QNOW
 311
 312             QNOW=-1.
 313
 314             GOTO 125
 315
 316           ELSEIF (ID1.EQ.59) THEN
 317
 318 C--ANOMALOUS PHOTON SPLITTING: ADD PT TO INTRINSIC PT AND STOP BRANCHING
 319
 320             IF (IDHAD.NE.59) CALL HWWARN('HWSBRN',109,*999)
 321
 322             ENOW=PPAR(4,KPAR)/XLAST
 323
 324             XI=(QNOW/ENOW)**2
 325
 326             QLAM=QNOW*(1.-XLAST)
 327
 328             IF ((2.-XI)*QLAM**2.GT.EMSCA**2) THEN
 329
 330 C--BRANCHING REJECTED: REDUCE Q AND REPEAT
 331
 332               IF (NTRY.GT.NBTRY) CALL HWWARN('HWSBRN',110,*999)
 333
 334               QLST=QNOW
 335
 336               QNOW=-1.
 337
 338               GOTO 125
 339
 340             ENDIF
 341
 342             CALL HWRAZM(QNOW*(1.-XLAST),PTMP(1),PTMP(2))
 343
 344             CALL HWVSUM(2,PTMP,PTINT(1,JNHAD),PTINT(1,JNHAD))
 345
 346             PTINT(3,JNHAD)=PTINT(1,JNHAD)**2+PTINT(2,JNHAD)**2
 347
 348             ANOMSC(1,JNHAD)=QNOW
 349
 350             ANOMSC(2,JNHAD)=QNOW*(1.-XLAST)
 351
 352             QNOW=-1.
 353
 354             QLST=QNOW
 355
 356             GOTO 125
 357
 358           ELSEIF (FORCE.AND..NOT.HWSVAL(ID1).AND.ID1.NE.13) THEN
 359
 360 C--FORCED BRANCHING PRODUCED A NON-VALENCE PARTON: TRY AGAIN
 361
 362             IF (NTRY.GT.NBTRY) CALL HWWARN('HWSBRN',108,*999)
 363
 364             QLST=QNOW
 365
 366             QNOW=-1.
 367
 368             GOTO 125
 369
 370           ENDIF
 371
 372         ENDIF
 373
 374   210   CONTINUE
 375
 376         IF (QNOW.GT.ZERO) THEN
 377
 378 C--BRANCHING HAS OCCURRED
 379
 380           ENOW=PPAR(4,KPAR)/ZZ
 381
 382           XI=(QNOW/ENOW)**2
 383
 384           QLAM=QNOW*(1.-ZZ)
 385
 386           IF (SUDORD.EQ.1.AND.HWUALF(2,QLAM).LT.HWR() .OR.
 387
 388      &        (2.-XI)*QLAM**2.GT.EMSCA**2.AND..NOT.FORCE) THEN
 389
 390 C--BRANCHING REJECTED: REDUCE Q AND REPEAT
 391
 392               IF (NTRY.GT.NBTRY) CALL HWWARN('HWSBRN',104,*999)
 393
 394               QLST=QNOW
 395
 396               QNOW=-1.
 397
 398               GOTO 125
 399
 400           ENDIF
 401
 402 C--IF THIS IS HARDEST EMISSION SO FAR, APPLY MATRIX-ELEMENT CORRECTION
 403
 404           IF (.NOT.FORCE) THEN
 405
 406             REJFAC=1
 407
 408             IF (QLAM.GT.HARDST .AND. ID.NE.13) THEN
 409
 410               IF (MOD(ISTHEP(JCOPAR(1,1)),10).GE.3) THEN
 411
 412 C---COLOUR PARTNER IS OUTGOING (X1=XP, X2=ZP)
 413
 414                 X2=SQRT((ZZ**2-(1-ZZ)*XI)**2+2*(ZZ*(1-ZZ))**2*XI*(2-XI))
 415
 416                 X1=(ZZ**2+(1-ZZ)*XI-X2)/(2*(1-ZZ)*XI)
 417
 418                 X2=(ZZ**2-(1-ZZ)*XI+X2)/(2*ZZ**2)
 419
 420                 IF (ID2.EQ.13) THEN
 421
 422 C---GLUON EMISSION
 423
 424                   REJFAC=ZZ**3*(1-X1-X2+2*X1*X2)
 425
 426      $                 /(X1**2*(1-ZZ)*(ZZ+XI*(1-ZZ)))
 427
 428      $                 *(1+ZZ**2)/((1-ZZ)*XI)
 429
 430      $                 *(1-X1)*(1-X2)/
 431
 432      $                 (1+(1-X1-X2+2*X1*X2)**2+2*(1-X1)*(1-X2)*X1*X2)
 433
 434 C---CHECK WHETHER IT IS IN THE OVERLAP REGION
 435
 436                   OTHXI=2*(1-X1)/(1-X1+2*(3*X1-2)*X2*(1-X2))
 437
 438                   IF (OTHXI.LT.ONE) THEN
 439
 440                     OTHZ=(1-(2*X2-1)*SQRT((3*X1-2)/X1))/2
 441
 442                     REJFAC=REJFAC+SQRT(3-2/X1)/(X1**2*OTHZ*(1-OTHZ))
 443
 444      $               *(1+(1-OTHZ)**2)/(OTHZ*OTHXI)
 445
 446      $               *(1-X1)*(1-X2)/
 447
 448      $               (1+(1-X1-X2+2*X1*X2)**2+2*(1-X1)*(1-X2)*X1*X2)
 449
 450                   ENDIF
 451
 452                 ELSEIF (ID1.EQ.13) THEN
 453
 454 C---GLUON SPLITTING
 455
 456                   REJFAC=ZZ**3*(1-X1-X2+2*X1*X2)
 457
 458      $                 /(X1**2*(1-ZZ)*(ZZ+XI*(1-ZZ)))
 459
 460      $                 *(ZZ**2+(1-ZZ)**2)/XI
 461
 462      $                 *(1-X2)/
 463
 464      $                 ((  X1+X2-2*X1*X2)**2+2*(1-X1)*(1-X2)*X1*X2
 465
 466      $                 +(1-X1-X2+2*X1*X2)**2+2*(1-X1)*(1-X2)*X1*X2)
 467
 468                 ENDIF
 469
 470               ELSE
 471
 472 C---COLOUR PARTNER IS ALSO INCOMING
 473
 474                 T=-(1-ZZ)*XI/ZZ**2
 475
 476                 S=2*(ZZ**2+(1-ZZ)*XI)/(ZZ**2*(2*ZZ+XI*(1-ZZ)))
 477
 478                 U=1-S-T
 479
 480                 JAC=-T*(1-T)/S**2*ZZ**5/(XI*(1-ZZ)**2*(ZZ+XI*(1-ZZ)))
 481
 482                 IF (ID2.EQ.13) THEN
 483
 484 C---GLUON EMISSION
 485
 486                   REJFAC=(1+ZZ**2)/((1-ZZ)*ZZ*XI)
 487
 488      &                 *JAC*S**2*T*U/((1-U)**2+(1-T)**2)
 489
 490 C---CHECK WHETHER IT IS IN THE OVERLAPPING REGION
 491
 492                   OTHZ=(1+SQRT(1-2*U*(1-U)/S))/U
 493
 494                   OTHXI=2*(1-OTHZ+T/S)/(1-OTHZ)
 495
 496                   IF (OTHXI.LT.OTHZ**2) THEN
 497
 498                     OTHJAC=-U*(1-U)/S**2*OTHZ**5/(OTHXI*
 499
 500      &                   (1-OTHZ)**2*(OTHZ+OTHXI*(1-OTHZ)))
 501
 502                     REJFAC=REJFAC+(1+OTHZ**2)/((1-OTHZ)*OTHZ*OTHXI)
 503
 504      &                   *OTHJAC*S**2*T*U/((1-U)**2+(1-T)**2)
 505
 506                   ENDIF
 507
 508                 ELSEIF (ID1.EQ.13) THEN
 509
 510 C---GLUON SPLITTING
 511
 512                   REJFAC=-((1-ZZ)**2+ZZ**2)/(ZZ*XI)
 513
 514      &                 *JAC*S**3*T/((1-S)**2+(1-T)**2)
 515
 516                 ENDIF
 517
 518               ENDIF
 519
 520             ENDIF
 521
 522             IF (NREJ*REJFAC*HWR().GT.ONE) THEN
 523
 524               QLST=QNOW
 525
 526               QNOW=-1.
 527
 528               GOTO 125
 529
 530             ENDIF
 531
 532             IF (QLAM.GT.HARDST) HARDST=QLAM
 533
 534           ENDIF
 535
 536           IF (IW2.GT.IW1) THEN
 537
 538             LPAR=NPAR+1
 539
 540             MPAR=NPAR+2
 541
 542 C---NEW MOTHER-DAUGHTER RELATIONS
 543
 544 C   N.B. DEFINED MOVING AWAY FROM HARD PROCESS
 545
 546             JDAPAR(1,KPAR)=LPAR
 547
 548             JDAPAR(2,KPAR)=MPAR
 549
 550 C---NEW COLOUR CONNECTIONS
 551
 552             JCOPAR(3,KPAR)=MPAR
 553
 554             JCOPAR(4,KPAR)=LPAR
 555
 556             JCOPAR(1,MPAR)=KPAR
 557
 558             JCOPAR(2,MPAR)=LPAR
 559
 560             JCOPAR(1,LPAR)=MPAR
 561
 562             JCOPAR(2,LPAR)=KPAR
 563
 564           ELSE
 565
 566             MPAR=NPAR+1
 567
 568             LPAR=NPAR+2
 569
 570             JDAPAR(1,KPAR)=MPAR
 571
 572             JDAPAR(2,KPAR)=LPAR
 573
 574             JCOPAR(3,KPAR)=LPAR
 575
 576             JCOPAR(4,KPAR)=MPAR
 577
 578             JCOPAR(1,MPAR)=LPAR
 579
 580             JCOPAR(2,MPAR)=KPAR
 581
 582             JCOPAR(1,LPAR)=KPAR
 583
 584             JCOPAR(2,LPAR)=MPAR
 585
 586           ENDIF
 587
 588           JMOPAR(1,LPAR)=KPAR
 589
 590           JMOPAR(1,MPAR)=KPAR
 591
 592           IDPAR(LPAR)=ID1
 593
 594           IDPAR(MPAR)=ID2
 595
 596           TMPAR(LPAR)=.FALSE.
 597
 598           TMPAR(MPAR)=.TRUE.
 599
 600           PPAR(1,LPAR)=QNOW
 601
 602           PPAR(2,LPAR)=XI
 603
 604           PPAR(4,LPAR)=ENOW
 605
 606           PPAR(1,MPAR)=QNOW*(1.-ZZ)
 607
 608           PPAR(2,MPAR)=XI
 609
 610           PPAR(4,MPAR)=ENOW*(1.-ZZ)
 611
 612           NPAR=NPAR+2
 613
 614         ENDIF
 615
 616       ENDIF
 617
 618       IF (QNOW.LT.ZERO) THEN
 619
 620 C--BRANCHING STOPS
 621
 622         JDAPAR(1,KPAR)=0
 623
 624         JDAPAR(2,KPAR)=0
 625
 626         JCOPAR(3,KPAR)=0
 627
 628         JCOPAR(4,KPAR)=0
 629
 630         IF (ID.LE.13) THEN
 631
 632 C---PUT SPECTATOR (APPROXIMATELY) ON-SHELL
 633
 634           XLAST=XFACT*PPAR(4,KPAR)
 635
 636           IF ((1-XLAST)**2.LT.(RMASS(ID)**2+PTINT(3,JNHAD))*XFACT**2)
 637
 638      &         THEN
 639
 640             FROST=.TRUE.
 641
 642             RETURN
 643
 644           ENDIF
 645
 646           PPAR(5,KPAR)=-(RMASS(ID)**2*XLAST+PTINT(3,JNHAD))/(1.-XLAST)
 647
 648      &         +XLAST*SIGN(PHEP(5,INHAD)**2,PHEP(5,INHAD))
 649
 650         ELSEIF (ID.EQ.IDHW(INHAD)) THEN
 651
 652 C---IF INCOMING PARTON IS INCOMING BEAM, ALLOW IT TO BE OFF-SHELL
 653
 654           PPAR(5,KPAR)=SIGN(PHEP(5,INHAD)**2,PHEP(5,INHAD))
 655
 656         ELSE
 657
 658           PPAR(5,KPAR)=RMASS(ID)**2
 659
 660         ENDIF
 661
 662         PMOM=PPAR(4,KPAR)**2-PPAR(5,KPAR)
 663
 664         IF (PMOM.LT.ZERO) THEN
 665
 666           FROST=.TRUE.
 667
 668           RETURN
 669
 670         ENDIF
 671
 672         PPAR(3,KPAR)=SQRT(PMOM)
 673
 674       ENDIF
 675
 676   999 END
 677
 678 CDECK  ID>, HWSDGG.
 679
 680 *CMZ :=        =26/04/91  12.47.48  by  Federico Carminati
 681
 682 *-- Author :    Drees, Grassie, Charchula, modified by Bryan Webber
 683
 684 C ===============================================================
 685
 686 C  DREES & GRASSIE PARAMETRIZATION OF PHOTON STRUCTURE FUNCTION
 687
 688 C
 689
 690 C    HWSDGQ(X,Q2,NFL,NCH) - X*QUARK_IN_PHOTON/ALPHA  (!)
 691
 692 C    HWSDGG(X,Q2,NFL)     - X*GLUON_IN_PHOTON/ALPHA  (!)
 693
 694 C WHERE:
 695
 696 C        (INTEGER) NCH - QUARK CHARGE: 1 FOR 1/3
 697
 698 C                                      2 FOR 2/3
 699
 700 C        (INTEGER) NFL - NUMBER OF QUARK FLAVOURS /3 OR 4/
 701
 702 C                   Q2 - SQUARE OF MOMENTUM Q /IN GEV2/
 703
 704 C                   X  - LONGITUDINAL FRACTION
 705
 706 C  LAMBDA=0.4 GEV
 707
 708 C
 709
 710 C       NFL=3:     1 < Q2 < 50   GEV^2
 711
 712 C       NFL=4:    20 < Q2 < 500  GEV^2
 713
 714 C       NFL=5:   200 < Q2 < 10^4 GEV^2
 715
 716 C
 717
 718 C
 719
 720 C  KRZYSZTOF CHARCHULA  /14.02.1989/
 721
 722 C================================================================
 723
 724 C
 725
 726 C PS. Note that for the case of three flavors, one has to add
 727
 728 C the QPM charm contribution for getting F2.
 729
 730 C
 731
 732 C================================================================
 733
 734 C MODIFIED FOR HERWIG BY BRW 19/4/91
 735
 736 C--- -----------------------------------------------
 737
 738 C        GLUON PART OF THE PHOTON SF
 739
 740 C--- -----------------------------------------------
 741
 742       FUNCTION HWSDGG(X,Q2,NFL)
 743
 744       IMPLICIT REAL (A-H,P-Z)
 745
 746       INTEGER NFL
 747
 748       DIMENSION A(3,4,3),AT(3)
 749
 750       ALAM2=0.160
 751
 752       T=LOG(Q2/ALAM2)
 753
 754 C- ---  CHECK WHETHER NFL  HAVE RIGHT VALUES -----
 755
 756       IF (.NOT.((NFL.EQ.3).OR.(NFL.EQ.4).OR.(NFL.EQ.5)))THEN
 757
 758  130   WRITE(6,131)
 759
 760  131   FORMAT(' NUMBER OF FLAVOURS(NFL) HAS NOT BEEN SET TO: 3,4 OR 5;'/
 761
 762      *'          NFL=3 IS ASSUMED')
 763
 764        NFL=3
 765
 766       ELSEIF (T.LE.0) THEN
 767
 768        WRITE(6,132)
 769
 770  132   FORMAT(' HWSDGG CALLED WITH SCALE < LAMBDA. RETURNING ZERO.')
 771
 772        HWSDGG=0
 773
 774        RETURN
 775
 776       ENDIF
 777
 778 C ------ INITIALIZATION OF PARAMETERS ARRAY -----
 779
 780       DATA(((A(I,J,K),I=1,3),J=1,4),K=1,3)/
 781
 782      + -0.20700,-0.19870, 5.11900,
 783
 784      +  0.61580, 0.62570,-0.27520,
 785
 786      +  1.07400, 8.35200,-6.99300,
 787
 788      +  0.00000, 5.02400, 2.29800,
 789
 790      +    0.8926E-2, 0.05090,-0.23130,
 791
 792      +    0.659400, 0.27740, 0.13820,
 793
 794      +    0.476600,-0.39060, 6.54200,
 795
 796      +    0.019750,-0.32120, 0.51620,
 797
 798      +  0.031970, -0.618E-2, -0.1216,
 799
 800      +  1.0180,    0.94760,  0.90470,
 801
 802      +  0.24610,  -0.60940,  2.6530,
 803
 804      +  0.027070, -0.010670, 0.2003E-2/
 805
 806 C ------ Q2 DEPENDENCE -----------
 807
 808       LF=NFL-2
 809
 810       DO 20 I=1,3
 811
 812         AT(I)=A(I,1,LF)*T**A(I,2,LF)+A(I,3,LF)*T**(-A(I,4,LF))
 813
 814  20   CONTINUE
 815
 816 C ------ GLUON DISTRIBUTION -------------
 817
 818       HWSDGG=AT(1)*X**AT(2)*(1.0-X)**AT(3)/137.
 819
 820       RETURN
 821
 822       END