HIJING/hipyset1_35/luedit_hijing.F

   1 * $Id$
   2
   3 C*********************************************************************
   4
   5       SUBROUTINE LUEDIT_HIJING(MEDIT)
   6
   7 C...Purpose: to perform global manipulations on the event record,
   8 C...in particular to exclude unstable or undetectable partons/particles.
   9 #include "lujets_hijing.inc"
  10 #include "ludat1_hijing.inc"
  11 #include "ludat2_hijing.inc"
  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_HIJING(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_HIJING(K(I,2))
  31           IF(KC.EQ.0) GOTO 110
  32           IF(KCHG(KC,2).EQ.0.AND.LUCHGE_HIJING(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_HIJING(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   100   V(I1,J)=V(I,J)
  46         K(I1,3)=0
  47   110   CONTINUE
  48         N=I1
  49
  50 C...Selective removal of class of entries. New position of retained.
  51       ELSEIF(MEDIT.GE.11.AND.MEDIT.LE.15) THEN
  52         I1=0
  53         DO 120 I=1,N
  54         K(I,3)=MOD(K(I,3),MSTU(5))
  55         IF(MEDIT.EQ.11.AND.K(I,1).LT.0) GOTO 120
  56         IF(MEDIT.EQ.12.AND.K(I,1).EQ.0) GOTO 120
  57         IF(MEDIT.EQ.13.AND.(K(I,1).EQ.11.OR.K(I,1).EQ.12.OR.
  58      &  K(I,1).EQ.15).AND.K(I,2).NE.94) GOTO 120
  59         IF(MEDIT.EQ.14.AND.(K(I,1).EQ.13.OR.K(I,1).EQ.14.OR.
  60      &  K(I,2).EQ.94)) GOTO 120
  61         IF(MEDIT.EQ.15.AND.K(I,1).GE.21) GOTO 120
  62         I1=I1+1
  63         K(I,3)=K(I,3)+MSTU(5)*I1
  64   120   CONTINUE
  65
  66 C...Find new event history information and replace old.
  67         DO 140 I=1,N
  68         IF(K(I,1).LE.0.OR.K(I,1).GT.20.OR.K(I,3)/MSTU(5).EQ.0) GOTO 140
  69         ID=I
  70   130   IM=MOD(K(ID,3),MSTU(5))
  71         IF(MEDIT.EQ.13.AND.IM.GT.0.AND.IM.LE.N) THEN
  72           IF((K(IM,1).EQ.11.OR.K(IM,1).EQ.12.OR.K(IM,1).EQ.15).AND.
  73      &    K(IM,2).NE.94) THEN
  74             ID=IM
  75             GOTO 130
  76           ENDIF
  77         ELSEIF(MEDIT.EQ.14.AND.IM.GT.0.AND.IM.LE.N) THEN
  78           IF(K(IM,1).EQ.13.OR.K(IM,1).EQ.14.OR.K(IM,2).EQ.94) THEN
  79             ID=IM
  80             GOTO 130
  81           ENDIF
  82         ENDIF
  83         K(I,3)=MSTU(5)*(K(I,3)/MSTU(5))
  84         IF(IM.NE.0) K(I,3)=K(I,3)+K(IM,3)/MSTU(5)
  85         IF(K(I,1).NE.3.AND.K(I,1).NE.13.AND.K(I,1).NE.14) THEN
  86           IF(K(I,4).GT.0.AND.K(I,4).LE.MSTU(4)) K(I,4)=
  87      &    K(K(I,4),3)/MSTU(5)
  88           IF(K(I,5).GT.0.AND.K(I,5).LE.MSTU(4)) K(I,5)=
  89      &    K(K(I,5),3)/MSTU(5)
  90         ELSE
  91           KCM=MOD(K(I,4)/MSTU(5),MSTU(5))
  92           IF(KCM.GT.0.AND.KCM.LE.MSTU(4)) KCM=K(KCM,3)/MSTU(5)
  93           KCD=MOD(K(I,4),MSTU(5))
  94           IF(KCD.GT.0.AND.KCD.LE.MSTU(4)) KCD=K(KCD,3)/MSTU(5)
  95           K(I,4)=MSTU(5)**2*(K(I,4)/MSTU(5)**2)+MSTU(5)*KCM+KCD
  96           KCM=MOD(K(I,5)/MSTU(5),MSTU(5))
  97           IF(KCM.GT.0.AND.KCM.LE.MSTU(4)) KCM=K(KCM,3)/MSTU(5)
  98           KCD=MOD(K(I,5),MSTU(5))
  99           IF(KCD.GT.0.AND.KCD.LE.MSTU(4)) KCD=K(KCD,3)/MSTU(5)
 100           K(I,5)=MSTU(5)**2*(K(I,5)/MSTU(5)**2)+MSTU(5)*KCM+KCD
 101         ENDIF
 102   140   CONTINUE
 103
 104 C...Pack remaining entries.
 105         I1=0
 106         DO 160 I=1,N
 107         IF(K(I,3)/MSTU(5).EQ.0) GOTO 160
 108         I1=I1+1
 109         DO 150 J=1,5
 110         K(I1,J)=K(I,J)
 111         P(I1,J)=P(I,J)
 112   150   V(I1,J)=V(I,J)
 113         K(I1,3)=MOD(K(I1,3),MSTU(5))
 114   160   CONTINUE
 115         N=I1
 116
 117 C...Save top entries at bottom of LUJETS_HIJING commonblock.
 118       ELSEIF(MEDIT.EQ.21) THEN
 119         IF(2*N.GE.MSTU(4)) THEN
 120            CALL LUERRM_HIJING(11
 121      $          ,'(LUEDIT_HIJING:) no more memory left in LUJETS_HIJING'
 122      $          )
 123           RETURN
 124         ENDIF
 125         DO 170 I=1,N
 126         DO 170 J=1,5
 127         K(MSTU(4)-I,J)=K(I,J)
 128         P(MSTU(4)-I,J)=P(I,J)
 129   170   V(MSTU(4)-I,J)=V(I,J)
 130         MSTU(32)=N
 131
 132 C...Restore bottom entries of commonblock LUJETS_HIJING to top.
 133       ELSEIF(MEDIT.EQ.22) THEN
 134         DO 180 I=1,MSTU(32)
 135         DO 180 J=1,5
 136         K(I,J)=K(MSTU(4)-I,J)
 137         P(I,J)=P(MSTU(4)-I,J)
 138   180   V(I,J)=V(MSTU(4)-I,J)
 139         N=MSTU(32)
 140
 141 C...Mark primary entries at top of commonblock LUJETS_HIJING as untreated.
 142       ELSEIF(MEDIT.EQ.23) THEN
 143         I1=0
 144         DO 190 I=1,N
 145         KH=K(I,3)
 146         IF(KH.GE.1) THEN
 147           IF(K(KH,1).GT.20) KH=0
 148         ENDIF
 149         IF(KH.NE.0) GOTO 200
 150         I1=I1+1
 151   190   IF(K(I,1).GT.10.AND.K(I,1).LE.20) K(I,1)=K(I,1)-10
 152   200   N=I1
 153
 154 C...Place largest axis along z axis and second largest in xy plane.
 155       ELSEIF(MEDIT.EQ.31.OR.MEDIT.EQ.32) THEN
 156         CALL LUDBRB_HIJING(1,N+MSTU(3),0.,-ULANGL_HIJING(P(MSTU(61),1),
 157      &  P(MSTU(61),2)),0D0,0D0,0D0)
 158         CALL LUDBRB_HIJING(1,N+MSTU(3),-ULANGL_HIJING(P(MSTU(61),3),
 159      &  P(MSTU(61),1)),0.,0D0,0D0,0D0)
 160         CALL LUDBRB_HIJING(1,N+MSTU(3),0.,-ULANGL_HIJING(P(MSTU(61)+1,1)
 161      $       ,P(MSTU(61)+1,2)),0D0,0D0,0D0)
 162         IF(MEDIT.EQ.31) RETURN
 163
 164 C...Rotate to put slim jet along +z axis.
 165         DO 210 IS=1,2
 166         NS(IS)=0
 167         PTS(IS)=0.
 168   210   PLS(IS)=0.
 169         DO 220 I=1,N
 170         IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 220
 171         IF(MSTU(41).GE.2) THEN
 172           KC=LUCOMP_HIJING(K(I,2))
 173           IF(KC.EQ.0.OR.KC.EQ.12.OR.KC.EQ.14.OR.KC.EQ.16.OR.
 174      &    KC.EQ.18) GOTO 220
 175           IF(MSTU(41).GE.3.AND.KCHG(KC,2).EQ.0.AND.LUCHGE_HIJING(K(I,2))
 176      $         .EQ.0)GOTO 220
 177         ENDIF
 178         IS=2.-SIGN(0.5,P(I,3))
 179         NS(IS)=NS(IS)+1
 180         PTS(IS)=PTS(IS)+SQRT(P(I,1)**2+P(I,2)**2)
 181   220   CONTINUE
 182         IF(NS(1)*PTS(2)**2.LT.NS(2)*PTS(1)**2)
 183      &  CALL LUDBRB_HIJING(1,N+MSTU(3),PARU(1),0.,0D0,0D0,0D0)
 184
 185 C...Rotate to put second largest jet into -z,+x quadrant.
 186         DO 230 I=1,N
 187         IF(P(I,3).GE.0.) GOTO 230
 188         IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 230
 189         IF(MSTU(41).GE.2) THEN
 190           KC=LUCOMP_HIJING(K(I,2))
 191           IF(KC.EQ.0.OR.KC.EQ.12.OR.KC.EQ.14.OR.KC.EQ.16.OR.
 192      &    KC.EQ.18) GOTO 230
 193           IF(MSTU(41).GE.3.AND.KCHG(KC,2).EQ.0.AND.LUCHGE_HIJING(K(I,2))
 194      $         .EQ.0)GOTO 230
 195         ENDIF
 196         IS=2.-SIGN(0.5,P(I,1))
 197         PLS(IS)=PLS(IS)-P(I,3)
 198   230   CONTINUE
 199         IF(PLS(2).GT.PLS(1)) CALL LUDBRB_HIJING(1,N+MSTU(3),0.,PARU(1),
 200      &  0D0,0D0,0D0)
 201       ENDIF
 202
 203       RETURN
 204       END