HERWIG/src/hwbrc2.f

   1
   2 CDECK  ID>, HWBRC2.
   3
   4 *CMZ :-        -20/07/99  10:56:12  by  Peter Richardson
   5
   6 *-- Author :    Peter Richardson
   7
   8 C-----------------------------------------------------------------------
   9
  10       SUBROUTINE HWBRC2(COLP,IHEP,JC,CON,BVVUSE,BVVHRD)
  11
  12 C-----------------------------------------------------------------------
  13
  14 C--Function to search in the jet for the particle
  15
  16 C-----------------------------------------------------------------------
  17
  18       INCLUDE 'HERWIG61.INC'
  19
  20       INTEGER JC,JD,QHEP,LHEP,IHEP,JHEP,IDM,NCOUNT,ID,IP,IDM2,COLP
  21
  22       LOGICAL CON,BVVUSE,FLA,AFLA,BVVHRD
  23
  24       FLA(IP)  = (IP.LE.6.OR.(IP.GE.115.AND.IP.LE.120).
  25
  26      &           OR.(IP.GE.401.AND.IP.LE.406).
  27
  28      &           OR.(IP.GE.413.AND.IP.LE.418))
  29
  30       AFLA(IP) = ((IP.LE.12.AND.IP.GE.7).OR.(IP.GE.109.AND.IP.LE.114).
  31
  32      &           OR.(IP.GE.407.AND.IP.LE.412).
  33
  34      &           OR.(IP.GE.419.AND.IP.LE.424))
  35
  36       ID = IDHW(IHEP)
  37
  38       COLP = 0
  39
  40 C--begining and end of jet
  41
  42       IF(JDAHEP(1,JC).NE.0) THEN
  43
  44         JC=JDAHEP(1,JC)
  45
  46         JD=JDAHEP(2,JC)
  47
  48       ELSE
  49
  50         COLP = JC
  51
  52         RETURN
  53
  54       ENDIF
  55
  56       IF (JD.LT.JC) JD=JC
  57
  58       LHEP=0
  59
  60       IF(CON) THEN
  61
  62 C--SEARCH FOR A COLOUR PARTNER
  63
  64         DO 110 JHEP=JC,JD
  65
  66           IDM = IDHW(JHEP)
  67
  68         IF (ISTHEP(JHEP).LT.145.OR.ISTHEP(JHEP).GT.152) GOTO 110
  69
  70         IF(AFLA(ID).AND.IDM.EQ.13) GOTO 110
  71
  72         IF (JDAHEP(2,JHEP).EQ.IHEP) LHEP=JHEP
  73
  74         IF ((BVVUSE.AND.JMOHEP(2,JHEP).NE.0).OR.
  75
  76      &      (.NOT.BVVUSE.AND.JDAHEP(2,JHEP).NE.0)) GOTO 110
  77
  78         IF(BVVUSE.AND.ABS(IDHEP(JHEP)).GT.1000000) THEN
  79
  80           IF(BVVHRD.AND.AFLA(ID)) THEN
  81
  82             CONTINUE
  83
  84           ELSE
  85
  86             RETURN
  87
  88           ENDIF
  89
  90         ENDIF
  91
  92         IF(BVVUSE.AND.(
  93
  94      &      ((FLA(ID).OR.ID.EQ.13.OR.ID.EQ.449).AND.AFLA(IDM)).
  95
  96      &  OR.(AFLA(ID).AND.(FLA(IDM).OR.IDM.EQ.13.OR.IDM.EQ.449))))
  97
  98      &     GOTO 110
  99
 100         IF(AFLA(ID).AND.(IDM.EQ.59.OR.IDM.EQ.449.OR.IDM.EQ.13)) GOTO 110
 101
 102 C---JOIN IHEP AND JHEP
 103
 104         COLP=JHEP
 105
 106         IF(BVVUSE.OR.(ID.GE.7.AND.ID.LE.12.
 107
 108      &     AND.((IDM.GE.7.AND.IDM.LE.12)))) RETURN
 109
 110         IF(IHEP.NE.HRDCOL(1,2).AND.
 111
 112      &     (((FLA(ID).OR.ID.EQ.13.OR.ID.EQ.449.OR.ID.EQ.59)
 113
 114      &       .AND.(AFLA(IDM).OR.IDM.EQ.13.OR.IDM.EQ.449.OR.IDM.EQ.59))
 115
 116      &     .OR.(AFLA(ID).AND.(FLA(IDM).OR.IDM.EQ.59))))
 117
 118      &    JDAHEP(2,JHEP)=IHEP
 119
 120         RETURN
 121
 122  110    CONTINUE
 123
 124         IF (LHEP.NE.0) COLP=LHEP
 125
 126 C--Additional Baryon number violating piece
 127
 128         IF(COLP.EQ.0) THEN
 129
 130           IDM2= IDHW(JC)
 131
 132          IF(JMOHEP(1,JC).LT.6) THEN
 133
 134            IF(IDM2.LE.6) THEN
 135
 136              IDM2= IDM2+6
 137
 138            ELSEIF(IDM2.GT.6) THEN
 139
 140              IDM2=IDM2-6
 141
 142            ENDIF
 143
 144          ENDIF
 145
 146           IF(IHEP.EQ.HRDCOL(1,2).OR.
 147
 148      &     ((FLA(ID).OR.ID.EQ.13.OR.ID.EQ.449.OR.ID.EQ.15.OR.ID.EQ.59)
 149
 150      &       .AND.(AFLA(IDM2).OR.IDM2.EQ.13.OR.IDM2.EQ.13))) THEN
 151
 152               QHEP = JD+1
 153
 154  12           QHEP = QHEP-1
 155
 156               IF(IDHEP(QHEP).EQ.0) GOTO 12
 157
 158               IF(IDHW(QHEP).EQ.59) THEN
 159
 160               IF(JC.EQ.JD.AND.IDHW(JMOHEP(1,QHEP)).EQ.59) THEN
 161
 162                 COLP = IHEP
 163
 164                 RETURN
 165
 166               ELSE
 167
 168                 GOTO 12
 169
 170               ENDIF
 171
 172               ENDIF
 173
 174               NCOUNT = 0
 175
 176  11           IF(JDAHEP(2,QHEP).NE.0) THEN
 177
 178                 IF(JMOHEP(2,JDAHEP(2,QHEP)).EQ.QHEP.AND.
 179
 180      &             JDAHEP(2,QHEP).NE.QHEP) THEN
 181
 182                  IF(JDAHEP(2,QHEP).GE.JC.AND.JDAHEP(2,QHEP).LE.JD) THEN
 183
 184                    QHEP = JDAHEP(2,QHEP)
 185
 186                    NCOUNT = NCOUNT+1
 187
 188                    IF(NCOUNT.LT.NHEP) GOTO 11
 189
 190                  ENDIF
 191
 192                 ENDIF
 193
 194               ENDIF
 195
 196             ELSE
 197
 198             QHEP = JC
 199
 200  13         QHEP = QHEP+1
 201
 202             IF(IDHEP(QHEP).EQ.0) GOTO 13
 203
 204             IF(IDHW(QHEP).EQ.59) THEN
 205
 206               IF(JC.EQ.JD.AND.IDHW(JMOHEP(1,QHEP)).EQ.59) THEN
 207
 208                 COLP = IHEP
 209
 210                 RETURN
 211
 212               ELSE
 213
 214                 GOTO 13
 215
 216               ENDIF
 217
 218             ENDIF
 219
 220             NCOUNT = 0
 221
 222  9          IF(JMOHEP(2,QHEP).NE.0) THEN
 223
 224             IF(JDAHEP(2,JMOHEP(2,QHEP)).EQ.QHEP.AND.
 225
 226      &         JMOHEP(2,QHEP).NE.QHEP) THEN
 227
 228                IF(JMOHEP(2,QHEP).GE.JC.AND.JMOHEP(2,QHEP).LE.JD) THEN
 229
 230                  QHEP = JMOHEP(2,QHEP)
 231
 232                  NCOUNT = NCOUNT+1
 233
 234                  IF(NCOUNT.LT.NHEP) GOTO 9
 235
 236                ENDIF
 237
 238             ENDIF
 239
 240             ENDIF
 241
 242           ENDIF
 243
 244           IF(ABS(IDHEP(QHEP)).LT.1000000) COLP=QHEP
 245
 246         ENDIF
 247
 248       ELSE
 249
 250 C--Search for an anticolour partner
 251
 252         DO 210 JHEP=JC,JD
 253
 254         IF (ISTHEP(JHEP).LT.145.OR.ISTHEP(JHEP).GT.152) GOTO 210
 255
 256         IF (JMOHEP(2,JHEP).EQ.IHEP) LHEP=JHEP
 257
 258         IF (JMOHEP(2,JHEP).NE.0) GOTO 210
 259
 260 C---JOIN IHEP AND JHEP
 261
 262         COLP=JHEP
 263
 264         RETURN
 265
 266  210   CONTINUE
 267
 268        IF (LHEP.NE.0) COLP=LHEP
 269
 270 C--New piece
 271
 272        IF(COLP.EQ.0) THEN
 273
 274          IDM2=IDHW(JC)
 275
 276          IF(JMOHEP(1,JC).LT.6) THEN
 277
 278            IF(IDM2.LE.6) THEN
 279
 280              IDM2= IDM2+6
 281
 282            ELSEIF(IDM2.GT.6) THEN
 283
 284              IDM2=IDM2-6
 285
 286            ENDIF
 287
 288          ENDIF
 289
 290 C--Additional Baryon number violating piece
 291
 292         IF((FLA(ID).AND.AFLA(IDM2)).OR.
 293
 294      & ((AFLA(ID).OR.ID.EQ.13.OR.ID.EQ.449.OR.ID.EQ.15.OR.ID.EQ.59)
 295
 296      &    .AND.(FLA(IDM2).OR.IDM2.EQ.13.OR.IDM2.EQ.449))) THEN
 297
 298          QHEP = JC
 299
 300  211     QHEP = QHEP+1
 301
 302          IF(IDHEP(QHEP).EQ.0) GOTO 211
 303
 304          IF(IDHW(QHEP).EQ.59) THEN
 305
 306            IF(JC.EQ.JD.AND.IDHW(JMOHEP(1,QHEP)).EQ.59) THEN
 307
 308              COLP = IHEP
 309
 310              RETURN
 311
 312            ELSE
 313
 314              GOTO 211
 315
 316            ENDIF
 317
 318          ENDIF
 319
 320          NCOUNT = 0
 321
 322  209     IF(JMOHEP(2,QHEP).NE.0) THEN
 323
 324            IF(JDAHEP(2,JMOHEP(2,QHEP)).EQ.QHEP.AND.
 325
 326      &        JMOHEP(2,QHEP).NE.QHEP) THEN
 327
 328               IF(JMOHEP(2,QHEP).GE.JC.AND.JMOHEP(2,QHEP).LE.JD) THEN
 329
 330                 QHEP = JMOHEP(2,QHEP)
 331
 332                 NCOUNT = NCOUNT+1
 333
 334                 IF(NCOUNT.LT.NHEP) GOTO 209
 335
 336               ENDIF
 337
 338            ENDIF
 339
 340          ENDIF
 341
 342         IF(QHEP.NE.0) COLP=QHEP
 343
 344         IF(JDAHEP(2,QHEP).EQ.0.AND.IHEP.NE.6) THEN
 345
 346           IDM2= IDHW(QHEP)
 347
 348           IF(FLA(IHEP).AND.FLA(QHEP).OR.
 349
 350      &       ((AFLA(IHEP).OR.ID.EQ.13.OR.ID.EQ.449).AND.
 351
 352      &        (AFLA(QHEP).OR.IDM2.EQ.13.OR.IDM2.EQ.449)))
 353
 354      &        JDAHEP(2,QHEP)=IHEP
 355
 356         ENDIF
 357
 358         ELSE
 359
 360          QHEP = JD+1
 361
 362  220     QHEP = QHEP-1
 363
 364          IF(IDHEP(QHEP).EQ.0) GOTO 220
 365
 366          IF(IDHW(QHEP).EQ.59) THEN
 367
 368            IF(JC.EQ.JD.AND.IDHW(JMOHEP(1,QHEP)).EQ.59) THEN
 369
 370              COLP = IHEP
 371
 372              RETURN
 373
 374            ELSE
 375
 376              GOTO 220
 377
 378            ENDIF
 379
 380          ENDIF
 381
 382           NCOUNT = 0
 383
 384  219       IF(JDAHEP(2,QHEP).NE.0) THEN
 385
 386             IF(JMOHEP(2,JDAHEP(2,QHEP)).EQ.QHEP) THEN
 387
 388               IF(JDAHEP(2,QHEP).GE.JC.AND.JDAHEP(2,QHEP).LE.JD) THEN
 389
 390                 QHEP = JDAHEP(2,QHEP)
 391
 392                 NCOUNT = NCOUNT+1
 393
 394                 IF(NCOUNT.LT.200) GOTO 219
 395
 396               ENDIF
 397
 398             ENDIF
 399
 400           ENDIF
 401
 402         IF(QHEP.NE.0) COLP=QHEP
 403
 404         IDM2 = IDHW(QHEP)
 405
 406         IF(JDAHEP(2,QHEP).EQ.0.AND.
 407
 408      &     (((AFLA(ID).OR.ID.EQ.13).AND.(AFLA(IDM2).OR.IDM2.EQ.13)).OR.
 409
 410      &     (FLA(ID).AND.FLA(IDM2)))) JDAHEP(2,QHEP)=IHEP
 411
 412         ENDIF
 413
 414        ENDIF
 415
 416       ENDIF
 417
 418       END