HERWIG/src/hwmodk.f

   1
   2 CDECK  ID>, HWMODK.
   3
   4 *CMZ :-        -27/07/99  13.33.03  by  Mike Seymour
   5
   6 *-- Author :    Ian Knowles
   7
   8 C-----------------------------------------------------------------------
   9
  10       SUBROUTINE HWMODK(IDKTMP,BRTMP,IMETMP,
  11
  12      & IATMP,IBTMP,ICTMP,IDTMP,IETMP)
  13
  14 C-----------------------------------------------------------------------
  15
  16 C     Takes the decay, IDKTMP -> I-(A+B+C+D+E)-TMP, and simply stores it
  17
  18 C     if internal pointers not set up (.NOT.DKPSET) else if pre-existing
  19
  20 C     mode updates branching ratio BRTMP and matrix element code IMETMP,
  21
  22 C     if -ve leaves as is. If a new mode adds to table and if consistent
  23
  24 C     adjusts pointers,  sets CMMOM (for two-body mode) and resets RSTAB
  25
  26 C     if necessary.  The branching ratios of any other IDKTMP decays are
  27
  28 C     scaled by (1.-BRTMP)/(1.-BR_OLD)
  29
  30 C-----------------------------------------------------------------------
  31
  32       INCLUDE 'HERWIG61.INC'
  33
  34       DOUBLE PRECISION HWUPCM,BRTMP,SCALE,EPS
  35
  36       INTEGER IDKTMP,IMETMP,IATMP,IBTMP,ICTMP,IDTMP,IETMP,IDKY,ITMP(5),
  37
  38      & L,I,J,K,JPREV
  39
  40       LOGICAL MATCH(5)
  41
  42       CHARACTER*8 CDUM
  43
  44       EXTERNAL HWUPCM
  45
  46       PARAMETER (EPS=1.D-6)
  47
  48 C Convert to internal format
  49
  50       CALL HWUIDT(1,IDKTMP,IDKY,CDUM)
  51
  52       IF (IDKY.EQ.20) THEN
  53
  54         WRITE(6,10) IDKTMP
  55
  56   10    FORMAT(1X,'Particle decaying,',I7,', is not recognised')
  57
  58         RETURN
  59
  60       ENDIF
  61
  62       CALL HWUIDT(1,IATMP,ITMP(1),CDUM)
  63
  64       CALL HWUIDT(1,IBTMP,ITMP(2),CDUM)
  65
  66       CALL HWUIDT(1,ICTMP,ITMP(3),CDUM)
  67
  68       CALL HWUIDT(1,IDTMP,ITMP(4),CDUM)
  69
  70       CALL HWUIDT(1,IETMP,ITMP(5),CDUM)
  71
  72 C If internal pointers not yet set up simply store decay
  73
  74       IF (.NOT.DKPSET) THEN
  75
  76         NDKYS=NDKYS+1
  77
  78         IF (NDKYS.GT.NMXDKS) CALL HWWARN('HWMODK',100,*999)
  79
  80         IDK(NDKYS)=IDKY
  81
  82         BRFRAC(NDKYS)=BRTMP
  83
  84         NME(NDKYS)=IMETMP
  85
  86         DO 20 I=1,5
  87
  88   20    IDKPRD(I,NDKYS)=ITMP(I)
  89
  90       ELSE
  91
  92         IF (NMODES(IDKY).GT.0) THEN
  93
  94 C First search to see if mode pre-exists
  95
  96           IF ((ITMP(2).GE.1.AND.ITMP(2).LE.13).OR.
  97
  98      &        (ITMP(3).GE.1.AND.ITMP(3).LE.13)) THEN
  99
 100 C Partonic respect order
 101
 102             L=LSTRT(IDKY)
 103
 104             DO 30 K=1,NMODES(IDKY)
 105
 106                 IF (ITMP(1).EQ.IDKPRD(1,L).AND.
 107
 108      &              ITMP(2).EQ.IDKPRD(2,L).AND.
 109
 110      &              ITMP(3).EQ.IDKPRD(3,L).AND.
 111
 112      &              ITMP(4).EQ.IDKPRD(4,L).AND.
 113
 114      &              ITMP(5).EQ.IDKPRD(5,L)) GOTO 90
 115
 116   30        L=LNEXT(L)
 117
 118           ELSE
 119
 120 C Allow for different order in matching
 121
 122             L=LSTRT(IDKY)
 123
 124             DO 70 I=1,NMODES(IDKY)
 125
 126             DO 40 J=1,5
 127
 128   40        MATCH(J)=.FALSE.
 129
 130             DO 60 J=1,5
 131
 132             DO 50 K=1,5
 133
 134             IF (.NOT.MATCH(K).AND.ITMP(K).EQ.IDKPRD(J,L)) THEN
 135
 136               MATCH(K)=.TRUE.
 137
 138               GOTO 60
 139
 140             ENDIF
 141
 142   50        CONTINUE
 143
 144   60        CONTINUE
 145
 146             IF (MATCH(1).AND.MATCH(2).AND.MATCH(3).AND.
 147
 148      &          MATCH(4).AND.MATCH(5)) GOTO 90
 149
 150   70        L=LNEXT(L)
 151
 152           ENDIF
 153
 154         ENDIF
 155
 156 C A new mode put decay products in table
 157
 158         NDKYS=NDKYS+1
 159
 160         IF (NDKYS.GT.NMXDKS) CALL HWWARN('HWMODK',101,*999)
 161
 162         DO 80 I=1,5
 163
 164   80    IDKPRD(I,NDKYS)=ITMP(I)
 165
 166 C If decay consistent set up new pointers
 167
 168         CALL HWDCHK(IDKY,NDKYS,*980)
 169
 170         IF (NMODES(IDKY).EQ.0) THEN
 171
 172           LSTRT(IDKY)=NDKYS
 173
 174           IF (RLTIM(IDKY).LT.PLTCUT.AND.RMASS(IDKY).NE.ZERO) THEN
 175
 176             RSTAB(IDKY)=.FALSE.
 177
 178             DKLTM(IDKY)=RLTIM(IDKY)*RMASS(IDKY)/HBAR
 179
 180           ELSE
 181
 182             RSTAB(IDKY)=.TRUE.
 183
 184           ENDIF
 185
 186         ELSE
 187
 188           LNEXT(L)=NDKYS
 189
 190         ENDIF
 191
 192         NMODES(IDKY)=NMODES(IDKY)+1
 193
 194         LNEXT(NDKYS)=NDKYS
 195
 196         L=NDKYS
 197
 198 C Set CMMOM if two body decay
 199
 200         IF (NPRODS(L).EQ.2) CMMOM(L)=
 201
 202      &   HWUPCM(RMASS(IDKY),RMASS(IDKPRD(1,L)),RMASS(IDKPRD(2,L)))
 203
 204 C A Pre-existing mode, line L, add/update ME code and BR, scaling all
 205
 206 C other branching fractions
 207
 208   90    IF (IMETMP.GT.0) NME(L)=IMETMP
 209
 210         IF (ABS(BRTMP-1.).LT.EPS) THEN
 211
 212 C This modes dominant: eliminate others
 213
 214           NMODES(IDKY)=1
 215
 216           LSTRT(IDKY)=L
 217
 218           BRFRAC(L)=ONE
 219
 220           LNEXT(L)=L
 221
 222         ELSEIF (ABS(BRTMP).LT.EPS) THEN
 223
 224 C This mode insignificant: eliminate it
 225
 226           IF (NMODES(IDKY).EQ.1) THEN
 227
 228             RSTAB(IDKY)=.TRUE.
 229
 230           ELSE
 231
 232             J=LSTRT(IDKY)
 233
 234             IF (J.EQ.L) THEN
 235
 236               LSTRT(IDKY)=LNEXT(J)
 237
 238             ELSE
 239
 240               JPREV=J
 241
 242               DO 100 I=2,NMODES(IDKY)
 243
 244               J=LNEXT(J)
 245
 246               IF (J.EQ.L) LNEXT(JPREV)=LNEXT(J)
 247
 248   100         JPREV=J
 249
 250             ENDIF
 251
 252 C           Rescale other modes
 253
 254             SCALE=ONE/(ONE-BRFRAC(L))
 255
 256             J=LSTRT(IDKY)
 257
 258             DO 110 I=1,NMODES(IDKY)-1
 259
 260             BRFRAC(J)=SCALE*BRFRAC(J)
 261
 262   110       J=LNEXT(J)
 263
 264           ENDIF
 265
 266           NMODES(IDKY)=NMODES(IDKY)-1
 267
 268         ELSE
 269
 270 C Rescale all other modes
 271
 272           IF (NMODES(IDKY).EQ.1) THEN
 273
 274             BRFRAC(L)=ONE
 275
 276           ELSE
 277
 278             IF (L.EQ.NDKYS) THEN
 279
 280               SCALE=ONE-BRTMP
 281
 282             ELSE
 283
 284               SCALE=(ONE-BRTMP)/(ONE-BRFRAC(L))
 285
 286             ENDIF
 287
 288             J=LSTRT(IDKY)
 289
 290             DO 120 I=1,NMODES(IDKY)
 291
 292             IF (J.NE.L) BRFRAC(J)=SCALE*BRFRAC(J)
 293
 294   120       J=LNEXT(J)
 295
 296             BRFRAC(L)=BRTMP
 297
 298           ENDIF
 299
 300         ENDIF
 301
 302       ENDIF
 303
 304       GOTO 999
 305
 306   980 WRITE(6,990)
 307
 308   990 FORMAT(1X,'Decay mode inconsistent, no modifications made')
 309
 310   999 RETURN
 311
 312       END