HERWIG/src/hwsspc.f

   1
   2 CDECK  ID>, HWSSPC.
   3
   4 *CMZ :-        -26/04/91  11.11.56  by  Bryan Webber
   5
   6 *-- Author :    Bryan Webber
   7
   8 C-----------------------------------------------------------------------
   9
  10       SUBROUTINE HWSSPC
  11
  12 C-----------------------------------------------------------------------
  13
  14 C     REPLACES SPACELIKE PARTONS BY SPECTATORS
  15
  16 C-----------------------------------------------------------------------
  17
  18       INCLUDE 'HERWIG61.INC'
  19
  20       DOUBLE PRECISION HWUSQR,EMSQ,EMTR,EPAR,XPAR,QSQ,PCL(5)
  21
  22       INTEGER KHEP,IP,JP,IDH,IDP,ISP,IDSPC,JHEP
  23
  24       EXTERNAL HWUSQR
  25
  26       IF (IERROR.NE.0) RETURN
  27
  28       DO 50 KHEP=1,NHEP
  29
  30       IF (ISTHEP(KHEP).EQ.145.OR.ISTHEP(KHEP).EQ.146) THEN
  31
  32         IP=ISTHEP(KHEP)-144
  33
  34         JP=IP
  35
  36         IF (JDAHEP(1,IP).NE.0) JP=JDAHEP(1,IP)
  37
  38         IDH=IDHW(JP)
  39
  40         IDP=IDHW(KHEP)
  41
  42         IF (IDH.NE.IDP) THEN
  43
  44           IF (IDH.EQ.59) THEN
  45
  46 C---PHOTON CASE
  47
  48             IF (IDP.LT.7) THEN
  49
  50               IDSPC=IDP+6
  51
  52             ELSEIF (IDP.LT.13) THEN
  53
  54               IDSPC=IDP-6
  55
  56             ELSE
  57
  58               CALL HWWARN('HWSSPC',100,*999)
  59
  60             ENDIF
  61
  62 C---IDENTIFY SPECTATOR
  63
  64 C   (1) QUARK CASE
  65
  66           ELSEIF (IDP.LE.3) THEN
  67
  68             DO 10 ISP=1,12
  69
  70   10        IF (IDH.EQ.NCLDK(LOCN(IDP,ISP))) GOTO 20
  71
  72             CALL HWWARN('HWSSPC',101,*999)
  73
  74   20        IF (ISP.LE.3) THEN
  75
  76               IDSPC=ISP+6
  77
  78             ELSEIF (ISP.LE.9) THEN
  79
  80               IDSPC=ISP+105
  81
  82             ELSE
  83
  84               IDSPC=ISP
  85
  86             ENDIF
  87
  88 C---(2) ANTIQUARK CASE
  89
  90           ELSEIF (IDP.GT.6.AND.IDP.LE.9) THEN
  91
  92             IDP=IDP-6
  93
  94             DO 30 ISP=1,12
  95
  96   30        IF (IDH.EQ.NCLDK(LOCN(ISP,IDP))) GOTO 40
  97
  98             CALL HWWARN('HWSSPC',103,*999)
  99
 100             RETURN
 101
 102   40        IF (ISP.LE.3) THEN
 103
 104               IDSPC=ISP
 105
 106             ELSEIF (ISP.LE.9) THEN
 107
 108               IDSPC=ISP+111
 109
 110             ELSE
 111
 112               IDSPC=ISP-6
 113
 114             ENDIF
 115
 116 C---SPECIAL CASE FOR REMNANT HADRON
 117
 118           ELSEIF (IDH.EQ.71.OR.IDH.EQ.72) THEN
 119
 120             IF (IDP.EQ.13) THEN
 121
 122               IDSPC=IDP
 123
 124             ELSE
 125
 126               CALL HWWARN('HWSSPC',106,*999)
 127
 128             ENDIF
 129
 130           ELSE
 131
 132             CALL HWWARN('HWSSPC',105,*999)
 133
 134           ENDIF
 135
 136 C---REPLACE PARTON BY SPECTATOR
 137
 138           IDHW(KHEP)=IDSPC
 139
 140           IDHEP(KHEP)=IDPDG(IDSPC)
 141
 142           ISTHEP(KHEP)=146+IP
 143
 144           EMSQ=SIGN(PHEP(5,KHEP)**2,PHEP(5,KHEP))
 145
 146           EMTR=EMSQ+PHEP(1,KHEP)**2+PHEP(2,KHEP)**2
 147
 148           EPAR=PHEP(4,KHEP)
 149
 150           CALL HWVDIF(4,PHEP(1,JP),PHEP(1,KHEP),PHEP(1,KHEP))
 151
 152           IF (EPAR**2.LT.10000.*ABS(EMTR)) THEN
 153
 154             CALL HWUMAS(PHEP(1,KHEP))
 155
 156           ELSE
 157
 158 C---COMPUTE SPECTATOR MASS ELIMINATING ROUNDING ERRORS
 159
 160             XPAR=EPAR/PHEP(4,JP)
 161
 162             QSQ=SIGN(PHEP(5,JP)**2,PHEP(5,JP))
 163
 164             PHEP(5,KHEP)=HWUSQR((1.-XPAR)*QSQ+EMSQ-EMTR/XPAR
 165
 166      &                 -((QSQ*XPAR**2-EMTR)/(2*EPAR*XPAR**2))**2*XPAR)
 167
 168           ENDIF
 169
 170 C---CHECK FOR UNPHYSICAL SPECTATOR
 171
 172           IF (PHEP(4,KHEP).LT.ZERO) FROST=.TRUE.
 173
 174 C---FIND MASS OF CORRESPONDING CLUSTER, IF PARTNER IS IN THE SAME JET
 175
 176           IF (QORQQB(IDHW(KHEP))) THEN
 177
 178             JHEP=JMOHEP(2,KHEP)
 179
 180           ELSEIF (QBORQQ(IDHW(KHEP))) THEN
 181
 182             JHEP=JDAHEP(2,KHEP)
 183
 184           ELSE
 185
 186             JHEP=0
 187
 188           ENDIF
 189
 190           IF (JHEP.GT.0) THEN
 191
 192             CALL HWVSUM(4,PHEP(1,KHEP),PHEP(1,JHEP),PCL)
 193
 194             CALL HWUMAS(PCL)
 195
 196 C---IF IT IS NEGATIVE, REJECT
 197
 198             IF (PCL(5).LT.ZERO) FROST=.TRUE.
 199
 200           ENDIF
 201
 202         ENDIF
 203
 204       ENDIF
 205
 206   50  CONTINUE
 207
 208   999 END
 209
 210 CDECK  ID>, HWSSUD.
 211
 212 *CMZ :-        -26/04/91  11.11.56  by  Bryan Webber
 213
 214 *-- Author :    Bryan Webber
 215
 216 C-----------------------------------------------------------------------
 217
 218       FUNCTION HWSSUD(I)
 219
 220 C-----------------------------------------------------------------------
 221
 222       INCLUDE 'HERWIG61.INC'
 223
 224       DOUBLE PRECISION HWSSUD,HWSGQQ,DMIN,QSCA,XLAST,DIST(13)
 225
 226       INTEGER I,N0,IS,ID
 227
 228       EXTERNAL HWSGQQ
 229
 230       COMMON/HWTABC/XLAST,N0,IS,ID
 231
 232       DATA DMIN/1.D-15/
 233
 234       QSCA=QEV(N0+I,IS)
 235
 236       CALL HWSFUN(XLAST,QSCA,IDHW(INHAD),NSTRU,DIST,JNHAD)
 237
 238       IF (ID.EQ.13) DIST(ID)=DIST(ID)*HWSGQQ(QSCA)
 239
 240       IF (DIST(ID).LT.DMIN) DIST(ID)=DMIN
 241
 242       HWSSUD=SUD(N0+I,IS)/DIST(ID)
 243
 244       END