hijing/src/luedit.f

0001
0002 C*********************************************************************
0003
0004       SUBROUTINE LUEDIT(MEDIT)
0005
0006 C...Purpose: to perform global manipulations on the event record,
0007 C...in particular to exclude unstable or undetectable partons/particles.
0008       COMMON/LUJETS/N,K(9000,5),P(9000,5),V(9000,5)
0009       SAVE /LUJETS/
0010       COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
0011       SAVE /LUDAT1/
0012       COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
0013       SAVE /LUDAT2/
0014       DIMENSION NS(2),PTS(2),PLS(2)
0015
0016 C...Remove unwanted partons/particles.
0017       IF((MEDIT.GE.0.AND.MEDIT.LE.3).OR.MEDIT.EQ.5) THEN
0018         IMAX=N
0019         IF(MSTU(2).GT.0) IMAX=MSTU(2)
0020         I1=MAX(1,MSTU(1))-1
0021         DO 110 I=MAX(1,MSTU(1)),IMAX
0022         IF(K(I,1).EQ.0.OR.K(I,1).GT.20) GOTO 110
0023         IF(MEDIT.EQ.1) THEN
0024           IF(K(I,1).GT.10) GOTO 110
0025         ELSEIF(MEDIT.EQ.2) THEN
0026           IF(K(I,1).GT.10) GOTO 110
0027           KC=LUCOMP(K(I,2))
0028           IF(KC.EQ.0.OR.KC.EQ.12.OR.KC.EQ.14.OR.KC.EQ.16.OR.KC.EQ.18)
0029      &    GOTO 110
0030         ELSEIF(MEDIT.EQ.3) THEN
0031           IF(K(I,1).GT.10) GOTO 110
0032           KC=LUCOMP(K(I,2))
0033           IF(KC.EQ.0) GOTO 110
0034           IF(KCHG(KC,2).EQ.0.AND.LUCHGE(K(I,2)).EQ.0) GOTO 110
0035         ELSEIF(MEDIT.EQ.5) THEN
0036           IF(K(I,1).EQ.13.OR.K(I,1).EQ.14) GOTO 110
0037           KC=LUCOMP(K(I,2))
0038           IF(KC.EQ.0) GOTO 110
0039           IF(K(I,1).GE.11.AND.KCHG(KC,2).EQ.0) GOTO 110
0040         ENDIF
0041
0042 C...Pack remaining partons/particles. Origin no longer known.
0043         I1=I1+1
0044         DO 100 J=1,5
0045         K(I1,J)=K(I,J)
0046         P(I1,J)=P(I,J)
0047   100   V(I1,J)=V(I,J)
0048         K(I1,3)=0
0049   110   CONTINUE
0050         N=I1
0051
0052 C...Selective removal of class of entries. New position of retained.
0053       ELSEIF(MEDIT.GE.11.AND.MEDIT.LE.15) THEN
0054         I1=0
0055         DO 120 I=1,N
0056         K(I,3)=MOD(K(I,3),MSTU(5))
0057         IF(MEDIT.EQ.11.AND.K(I,1).LT.0) GOTO 120
0058         IF(MEDIT.EQ.12.AND.K(I,1).EQ.0) GOTO 120
0059         IF(MEDIT.EQ.13.AND.(K(I,1).EQ.11.OR.K(I,1).EQ.12.OR.
0060      &  K(I,1).EQ.15).AND.K(I,2).NE.94) GOTO 120
0061         IF(MEDIT.EQ.14.AND.(K(I,1).EQ.13.OR.K(I,1).EQ.14.OR.
0062      &  K(I,2).EQ.94)) GOTO 120
0063         IF(MEDIT.EQ.15.AND.K(I,1).GE.21) GOTO 120
0064         I1=I1+1
0065         K(I,3)=K(I,3)+MSTU(5)*I1
0066   120   CONTINUE
0067
0068 C...Find new event history information and replace old.
0069         DO 140 I=1,N
0070         IF(K(I,1).LE.0.OR.K(I,1).GT.20.OR.K(I,3)/MSTU(5).EQ.0) GOTO 140
0071         ID=I
0072   130   IM=MOD(K(ID,3),MSTU(5))
0073         IF(MEDIT.EQ.13.AND.IM.GT.0.AND.IM.LE.N) THEN
0074           IF((K(IM,1).EQ.11.OR.K(IM,1).EQ.12.OR.K(IM,1).EQ.15).AND.
0075      &    K(IM,2).NE.94) THEN
0076             ID=IM
0077             GOTO 130
0078           ENDIF
0079         ELSEIF(MEDIT.EQ.14.AND.IM.GT.0.AND.IM.LE.N) THEN
0080           IF(K(IM,1).EQ.13.OR.K(IM,1).EQ.14.OR.K(IM,2).EQ.94) THEN
0081             ID=IM
0082             GOTO 130
0083           ENDIF
0084         ENDIF
0085         K(I,3)=MSTU(5)*(K(I,3)/MSTU(5))
0086         IF(IM.NE.0) K(I,3)=K(I,3)+K(IM,3)/MSTU(5)
0087         IF(K(I,1).NE.3.AND.K(I,1).NE.13.AND.K(I,1).NE.14) THEN
0088           IF(K(I,4).GT.0.AND.K(I,4).LE.MSTU(4)) K(I,4)=
0089      &    K(K(I,4),3)/MSTU(5)
0090           IF(K(I,5).GT.0.AND.K(I,5).LE.MSTU(4)) K(I,5)=
0091      &    K(K(I,5),3)/MSTU(5)
0092         ELSE
0093           KCM=MOD(K(I,4)/MSTU(5),MSTU(5))
0094           IF(KCM.GT.0.AND.KCM.LE.MSTU(4)) KCM=K(KCM,3)/MSTU(5)
0095           KCD=MOD(K(I,4),MSTU(5))
0096           IF(KCD.GT.0.AND.KCD.LE.MSTU(4)) KCD=K(KCD,3)/MSTU(5)
0097           K(I,4)=MSTU(5)**2*(K(I,4)/MSTU(5)**2)+MSTU(5)*KCM+KCD
0098           KCM=MOD(K(I,5)/MSTU(5),MSTU(5))
0099           IF(KCM.GT.0.AND.KCM.LE.MSTU(4)) KCM=K(KCM,3)/MSTU(5)
0100           KCD=MOD(K(I,5),MSTU(5))
0101           IF(KCD.GT.0.AND.KCD.LE.MSTU(4)) KCD=K(KCD,3)/MSTU(5)
0102           K(I,5)=MSTU(5)**2*(K(I,5)/MSTU(5)**2)+MSTU(5)*KCM+KCD
0103         ENDIF
0104   140   CONTINUE
0105
0106 C...Pack remaining entries.
0107         I1=0
0108         DO 160 I=1,N
0109         IF(K(I,3)/MSTU(5).EQ.0) GOTO 160
0110         I1=I1+1
0111         DO 150 J=1,5
0112         K(I1,J)=K(I,J)
0113         P(I1,J)=P(I,J)
0114   150   V(I1,J)=V(I,J)
0115         K(I1,3)=MOD(K(I1,3),MSTU(5))
0116   160   CONTINUE
0117         N=I1
0118
0119 C...Save top entries at bottom of LUJETS commonblock.
0120       ELSEIF(MEDIT.EQ.21) THEN
0121         IF(2*N.GE.MSTU(4)) THEN
0122           CALL LUERRM(11,'(LUEDIT:) no more memory left in LUJETS')
0123           RETURN
0124         ENDIF
0125         DO 170 I=1,N
0126         DO 170 J=1,5
0127         K(MSTU(4)-I,J)=K(I,J)
0128         P(MSTU(4)-I,J)=P(I,J)
0129   170   V(MSTU(4)-I,J)=V(I,J)
0130         MSTU(32)=N
0131
0132 C...Restore bottom entries of commonblock LUJETS to top.
0133       ELSEIF(MEDIT.EQ.22) THEN
0134         DO 180 I=1,MSTU(32)
0135         DO 180 J=1,5
0136         K(I,J)=K(MSTU(4)-I,J)
0137         P(I,J)=P(MSTU(4)-I,J)
0138   180   V(I,J)=V(MSTU(4)-I,J)
0139         N=MSTU(32)
0140
0141 C...Mark primary entries at top of commonblock LUJETS as untreated.
0142       ELSEIF(MEDIT.EQ.23) THEN
0143         I1=0
0144         DO 190 I=1,N
0145         KH=K(I,3)
0146         IF(KH.GE.1) THEN
0147           IF(K(KH,1).GT.20) KH=0
0148         ENDIF
0149         IF(KH.NE.0) GOTO 200
0150         I1=I1+1
0151   190   IF(K(I,1).GT.10.AND.K(I,1).LE.20) K(I,1)=K(I,1)-10
0152   200   N=I1
0153
0154 C...Place largest axis along z axis and second largest in xy plane.
0155       ELSEIF(MEDIT.EQ.31.OR.MEDIT.EQ.32) THEN
0156         CALL LUDBRB(1,N+MSTU(3),0.,-ULANGL(P(MSTU(61),1),
0157      &  P(MSTU(61),2)),0D0,0D0,0D0)
0158         CALL LUDBRB(1,N+MSTU(3),-ULANGL(P(MSTU(61),3),
0159      &  P(MSTU(61),1)),0.,0D0,0D0,0D0)
0160         CALL LUDBRB(1,N+MSTU(3),0.,-ULANGL(P(MSTU(61)+1,1),
0161      &  P(MSTU(61)+1,2)),0D0,0D0,0D0)
0162         IF(MEDIT.EQ.31) RETURN
0163
0164 C...Rotate to put slim jet along +z axis.
0165         DO 210 IS=1,2
0166         NS(IS)=0
0167         PTS(IS)=0.
0168   210   PLS(IS)=0.
0169         DO 220 I=1,N
0170         IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 220
0171         IF(MSTU(41).GE.2) THEN
0172           KC=LUCOMP(K(I,2))
0173           IF(KC.EQ.0.OR.KC.EQ.12.OR.KC.EQ.14.OR.KC.EQ.16.OR.
0174      &    KC.EQ.18) GOTO 220
0175           IF(MSTU(41).GE.3.AND.KCHG(KC,2).EQ.0.AND.LUCHGE(K(I,2)).EQ.0)
0176      &    GOTO 220
0177         ENDIF
0178         IS=2.-SIGN(0.5,P(I,3))
0179         NS(IS)=NS(IS)+1
0180         PTS(IS)=PTS(IS)+SQRT(P(I,1)**2+P(I,2)**2)
0181   220   CONTINUE
0182         IF(NS(1)*PTS(2)**2.LT.NS(2)*PTS(1)**2)
0183      &  CALL LUDBRB(1,N+MSTU(3),PARU(1),0.,0D0,0D0,0D0)
0184
0185 C...Rotate to put second largest jet into -z,+x quadrant.
0186         DO 230 I=1,N
0187         IF(P(I,3).GE.0.) GOTO 230
0188         IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 230
0189         IF(MSTU(41).GE.2) THEN
0190           KC=LUCOMP(K(I,2))
0191           IF(KC.EQ.0.OR.KC.EQ.12.OR.KC.EQ.14.OR.KC.EQ.16.OR.
0192      &    KC.EQ.18) GOTO 230
0193           IF(MSTU(41).GE.3.AND.KCHG(KC,2).EQ.0.AND.LUCHGE(K(I,2)).EQ.0)
0194      &    GOTO 230
0195         ENDIF
0196         IS=2.-SIGN(0.5,P(I,1))
0197         PLS(IS)=PLS(IS)-P(I,3)
0198   230   CONTINUE
0199         IF(PLS(2).GT.PLS(1)) CALL LUDBRB(1,N+MSTU(3),0.,PARU(1),
0200      &  0D0,0D0,0D0)
0201       ENDIF
0202
0203       RETURN
0204       END