PYTHIA/jetset/luedit.F

   1
   2 C*********************************************************************
   3
   4       SUBROUTINE LUEDIT(MEDIT)
   5
   6 C...Purpose: to perform global manipulations on the event record,
   7 C...in particular to exclude unstable or undetectable partons/particles.
   8       COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5)
   9       COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
  10       COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
  11       SAVE /LUJETS/,/LUDAT1/,/LUDAT2/
  12       DIMENSION NS(2),PTS(2),PLS(2)
  13
  14 C...Remove unwanted partons/particles.
  15       IF((MEDIT.GE.0.AND.MEDIT.LE.3).OR.MEDIT.EQ.5) THEN
  16         IMAX=N
  17         IF(MSTU(2).GT.0) IMAX=MSTU(2)
  18         I1=MAX(1,MSTU(1))-1
  19         DO 110 I=MAX(1,MSTU(1)),IMAX
  20         IF(K(I,1).EQ.0.OR.K(I,1).GT.20) GOTO 110
  21         IF(MEDIT.EQ.1) THEN
  22           IF(K(I,1).GT.10) GOTO 110
  23         ELSEIF(MEDIT.EQ.2) THEN
  24           IF(K(I,1).GT.10) GOTO 110
  25           KC=LUCOMP(K(I,2))
  26           IF(KC.EQ.0.OR.KC.EQ.12.OR.KC.EQ.14.OR.KC.EQ.16.OR.KC.EQ.18)
  27      &    GOTO 110
  28         ELSEIF(MEDIT.EQ.3) THEN
  29           IF(K(I,1).GT.10) GOTO 110
  30           KC=LUCOMP(K(I,2))
  31           IF(KC.EQ.0) GOTO 110
  32           IF(KCHG(KC,2).EQ.0.AND.LUCHGE(K(I,2)).EQ.0) GOTO 110
  33         ELSEIF(MEDIT.EQ.5) THEN
  34           IF(K(I,1).EQ.13.OR.K(I,1).EQ.14) GOTO 110
  35           KC=LUCOMP(K(I,2))
  36           IF(KC.EQ.0) GOTO 110
  37           IF(K(I,1).GE.11.AND.KCHG(KC,2).EQ.0) GOTO 110
  38         ENDIF
  39
  40 C...Pack remaining partons/particles. Origin no longer known.
  41         I1=I1+1
  42         DO 100 J=1,5
  43         K(I1,J)=K(I,J)
  44         P(I1,J)=P(I,J)
  45         V(I1,J)=V(I,J)
  46   100   CONTINUE
  47         K(I1,3)=0
  48   110   CONTINUE
  49         IF(I1.LT.N) MSTU(3)=0
  50         IF(I1.LT.N) MSTU(70)=0
  51         N=I1
  52
  53 C...Selective removal of class of entries. New position of retained.
  54       ELSEIF(MEDIT.GE.11.AND.MEDIT.LE.15) THEN
  55         I1=0
  56         DO 120 I=1,N
  57         K(I,3)=MOD(K(I,3),MSTU(5))
  58         IF(MEDIT.EQ.11.AND.K(I,1).LT.0) GOTO 120
  59         IF(MEDIT.EQ.12.AND.K(I,1).EQ.0) GOTO 120
  60         IF(MEDIT.EQ.13.AND.(K(I,1).EQ.11.OR.K(I,1).EQ.12.OR.
  61      &  K(I,1).EQ.15).AND.K(I,2).NE.94) GOTO 120
  62         IF(MEDIT.EQ.14.AND.(K(I,1).EQ.13.OR.K(I,1).EQ.14.OR.
  63      &  K(I,2).EQ.94)) GOTO 120
  64         IF(MEDIT.EQ.15.AND.K(I,1).GE.21) GOTO 120
  65         I1=I1+1
  66         K(I,3)=K(I,3)+MSTU(5)*I1
  67   120   CONTINUE
  68
  69 C...Find new event history information and replace old.
  70         DO 140 I=1,N
  71         IF(K(I,1).LE.0.OR.K(I,1).GT.20.OR.K(I,3)/MSTU(5).EQ.0) GOTO 140
  72         ID=I
  73   130   IM=MOD(K(ID,3),MSTU(5))
  74         IF(MEDIT.EQ.13.AND.IM.GT.0.AND.IM.LE.N) THEN
  75           IF((K(IM,1).EQ.11.OR.K(IM,1).EQ.12.OR.K(IM,1).EQ.15).AND.
  76      &    K(IM,2).NE.94) THEN
  77             ID=IM
  78             GOTO 130
  79           ENDIF
  80         ELSEIF(MEDIT.EQ.14.AND.IM.GT.0.AND.IM.LE.N) THEN
  81           IF(K(IM,1).EQ.13.OR.K(IM,1).EQ.14.OR.K(IM,2).EQ.94) THEN
  82             ID=IM
  83             GOTO 130
  84           ENDIF
  85         ENDIF
  86         K(I,3)=MSTU(5)*(K(I,3)/MSTU(5))
  87         IF(IM.NE.0) K(I,3)=K(I,3)+K(IM,3)/MSTU(5)
  88         IF(K(I,1).NE.3.AND.K(I,1).NE.13.AND.K(I,1).NE.14) THEN
  89           IF(K(I,4).GT.0.AND.K(I,4).LE.MSTU(4)) K(I,4)=
  90      &    K(K(I,4),3)/MSTU(5)
  91           IF(K(I,5).GT.0.AND.K(I,5).LE.MSTU(4)) K(I,5)=
  92      &    K(K(I,5),3)/MSTU(5)
  93         ELSE
  94           KCM=MOD(K(I,4)/MSTU(5),MSTU(5))
  95           IF(KCM.GT.0.AND.KCM.LE.MSTU(4)) KCM=K(KCM,3)/MSTU(5)
  96           KCD=MOD(K(I,4),MSTU(5))
  97           IF(KCD.GT.0.AND.KCD.LE.MSTU(4)) KCD=K(KCD,3)/MSTU(5)
  98           K(I,4)=MSTU(5)**2*(K(I,4)/MSTU(5)**2)+MSTU(5)*KCM+KCD
  99           KCM=MOD(K(I,5)/MSTU(5),MSTU(5))
 100           IF(KCM.GT.0.AND.KCM.LE.MSTU(4)) KCM=K(KCM,3)/MSTU(5)
 101           KCD=MOD(K(I,5),MSTU(5))
 102           IF(KCD.GT.0.AND.KCD.LE.MSTU(4)) KCD=K(KCD,3)/MSTU(5)
 103           K(I,5)=MSTU(5)**2*(K(I,5)/MSTU(5)**2)+MSTU(5)*KCM+KCD
 104         ENDIF
 105   140   CONTINUE
 106
 107 C...Pack remaining entries.
 108         I1=0
 109         MSTU90=MSTU(90)
 110         MSTU(90)=0
 111         DO 170 I=1,N
 112         IF(K(I,3)/MSTU(5).EQ.0) GOTO 170
 113         I1=I1+1
 114         DO 150 J=1,5
 115         K(I1,J)=K(I,J)
 116         P(I1,J)=P(I,J)
 117         V(I1,J)=V(I,J)
 118   150   CONTINUE
 119         K(I1,3)=MOD(K(I1,3),MSTU(5))
 120         DO 160 IZ=1,MSTU90
 121         IF(I.EQ.MSTU(90+IZ)) THEN
 122           MSTU(90)=MSTU(90)+1
 123           MSTU(90+MSTU(90))=I1
 124           PARU(90+MSTU(90))=PARU(90+IZ)
 125         ENDIF
 126   160   CONTINUE
 127   170   CONTINUE
 128         IF(I1.LT.N) MSTU(3)=0
 129         IF(I1.LT.N) MSTU(70)=0
 130         N=I1
 131
 132 C...Fill in some missing daughter pointers (lost in colour flow).
 133       ELSEIF(MEDIT.EQ.16) THEN
 134         DO 190 I=1,N
 135         IF(K(I,1).LE.10.OR.K(I,1).GT.20) GOTO 190
 136         IF(K(I,4).NE.0.OR.K(I,5).NE.0) GOTO 190
 137 C...Find daughters who point to mother.
 138         DO 180 I1=I+1,N
 139         IF(K(I1,3).NE.I) THEN
 140         ELSEIF(K(I,4).EQ.0) THEN
 141           K(I,4)=I1
 142         ELSE
 143           K(I,5)=I1
 144         ENDIF
 145   180   CONTINUE
 146         IF(K(I,5).EQ.0) K(I,5)=K(I,4)
 147         IF(K(I,4).NE.0) GOTO 190
 148 C...Find daughters who point to documentation version of mother.
 149         IM=K(I,3)
 150         IF(IM.LE.0.OR.IM.GE.I) GOTO 190
 151         IF(K(IM,1).LE.20.OR.K(IM,1).GT.30) GOTO 190
 152         IF(K(IM,2).NE.K(I,2).OR.ABS(P(IM,5)-P(I,5)).GT.1E-2) GOTO 190
 153         DO 182 I1=I+1,N
 154         IF(K(I1,3).NE.IM) THEN
 155         ELSEIF(K(I,4).EQ.0) THEN
 156           K(I,4)=I1
 157         ELSE
 158           K(I,5)=I1
 159         ENDIF
 160   182   CONTINUE
 161         IF(K(I,5).EQ.0) K(I,5)=K(I,4)
 162         IF(K(I,4).NE.0) GOTO 190
 163 C...Find daughters who point to documentation daughters who,
 164 C...in their turn, point to documentation mother.
 165         ID1=IM
 166         ID2=IM
 167         DO 184 I1=IM+1,I-1
 168         IF(K(I1,3).EQ.IM.AND.K(I1,1).GT.20.AND.K(I1,1).LE.30) THEN
 169           ID2=I1
 170           IF(ID1.EQ.IM) ID1=I1
 171         ENDIF
 172   184   CONTINUE
 173         DO 186 I1=I+1,N
 174         IF(K(I1,3).NE.ID1.AND.K(I1,3).NE.ID2) THEN
 175         ELSEIF(K(I,4).EQ.0) THEN
 176           K(I,4)=I1
 177         ELSE
 178           K(I,5)=I1
 179         ENDIF
 180   186   CONTINUE
 181         IF(K(I,5).EQ.0) K(I,5)=K(I,4)
 182   190   CONTINUE
 183
 184 C...Save top entries at bottom of LUJETS commonblock.
 185       ELSEIF(MEDIT.EQ.21) THEN
 186         IF(2*N.GE.MSTU(4)) THEN
 187           CALL LUERRM(11,'(LUEDIT:) no more memory left in LUJETS')
 188           RETURN
 189         ENDIF
 190         DO 210 I=1,N
 191         DO 200 J=1,5
 192         K(MSTU(4)-I,J)=K(I,J)
 193         P(MSTU(4)-I,J)=P(I,J)
 194         V(MSTU(4)-I,J)=V(I,J)
 195   200   CONTINUE
 196   210   CONTINUE
 197         MSTU(32)=N
 198
 199 C...Restore bottom entries of commonblock LUJETS to top.
 200       ELSEIF(MEDIT.EQ.22) THEN
 201         DO 230 I=1,MSTU(32)
 202         DO 220 J=1,5
 203         K(I,J)=K(MSTU(4)-I,J)
 204         P(I,J)=P(MSTU(4)-I,J)
 205         V(I,J)=V(MSTU(4)-I,J)
 206   220   CONTINUE
 207   230   CONTINUE
 208         N=MSTU(32)
 209
 210 C...Mark primary entries at top of commonblock LUJETS as untreated.
 211       ELSEIF(MEDIT.EQ.23) THEN
 212         I1=0
 213         DO 240 I=1,N
 214         KH=K(I,3)
 215         IF(KH.GE.1) THEN
 216           IF(K(KH,1).GT.20) KH=0
 217         ENDIF
 218         IF(KH.NE.0) GOTO 250
 219         I1=I1+1
 220         IF(K(I,1).GT.10.AND.K(I,1).LE.20) K(I,1)=K(I,1)-10
 221   240   CONTINUE
 222   250   N=I1
 223
 224 C...Place largest axis along z axis and second largest in xy plane.
 225       ELSEIF(MEDIT.EQ.31.OR.MEDIT.EQ.32) THEN
 226         CALL LUDBRB(1,N+MSTU(3),0.,-ULANGL(P(MSTU(61),1),
 227      &  P(MSTU(61),2)),0D0,0D0,0D0)
 228         CALL LUDBRB(1,N+MSTU(3),-ULANGL(P(MSTU(61),3),
 229      &  P(MSTU(61),1)),0.,0D0,0D0,0D0)
 230         CALL LUDBRB(1,N+MSTU(3),0.,-ULANGL(P(MSTU(61)+1,1),
 231      &  P(MSTU(61)+1,2)),0D0,0D0,0D0)
 232         IF(MEDIT.EQ.31) RETURN
 233
 234 C...Rotate to put slim jet along +z axis.
 235         DO 260 IS=1,2
 236         NS(IS)=0
 237         PTS(IS)=0.
 238         PLS(IS)=0.
 239   260   CONTINUE
 240         DO 270 I=1,N
 241         IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 270
 242         IF(MSTU(41).GE.2) THEN
 243           KC=LUCOMP(K(I,2))
 244           IF(KC.EQ.0.OR.KC.EQ.12.OR.KC.EQ.14.OR.KC.EQ.16.OR.
 245      &    KC.EQ.18) GOTO 270
 246           IF(MSTU(41).GE.3.AND.KCHG(KC,2).EQ.0.AND.LUCHGE(K(I,2)).EQ.0)
 247      &    GOTO 270
 248         ENDIF
 249         IS=2.-SIGN(0.5,P(I,3))
 250         NS(IS)=NS(IS)+1
 251         PTS(IS)=PTS(IS)+SQRT(P(I,1)**2+P(I,2)**2)
 252   270   CONTINUE
 253         IF(NS(1)*PTS(2)**2.LT.NS(2)*PTS(1)**2)
 254      &  CALL LUDBRB(1,N+MSTU(3),PARU(1),0.,0D0,0D0,0D0)
 255
 256 C...Rotate to put second largest jet into -z,+x quadrant.
 257         DO 280 I=1,N
 258         IF(P(I,3).GE.0.) GOTO 280
 259         IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 280
 260         IF(MSTU(41).GE.2) THEN
 261           KC=LUCOMP(K(I,2))
 262           IF(KC.EQ.0.OR.KC.EQ.12.OR.KC.EQ.14.OR.KC.EQ.16.OR.
 263      &    KC.EQ.18) GOTO 280
 264           IF(MSTU(41).GE.3.AND.KCHG(KC,2).EQ.0.AND.LUCHGE(K(I,2)).EQ.0)
 265      &    GOTO 280
 266         ENDIF
 267         IS=2.-SIGN(0.5,P(I,1))
 268         PLS(IS)=PLS(IS)-P(I,3)
 269   280   CONTINUE
 270         IF(PLS(2).GT.PLS(1)) CALL LUDBRB(1,N+MSTU(3),0.,PARU(1),
 271      &  0D0,0D0,0D0)
 272       ENDIF
 273
 274       RETURN
 275       END