HIJING/hipyset1_35/lu4ent_hijing.F

   1 * $Id$
   2
   3 C*********************************************************************
   4
   5       SUBROUTINE LU4ENT_HIJING(IP,KF1,KF2,KF3,KF4,PECM,X1,X2,X4,X12,X14)
   6
   7 C...Purpose: to store four partons or particles in their CM frame, with
   8 C...the first along the +z axis, the last in the xz plane with x > 0
   9 C...and the second having y < 0 and y > 0 with equal probability.
  10 #include "lujets_hijing.inc"
  11 #include "ludat1_hijing.inc"
  12 #include "ludat2_hijing.inc"
  13
  14 C...Standard checks.
  15       MSTU(28)=0
  16       IF(MSTU(12).GE.1) CALL LULIST_HIJING(0)
  17       IPA=MAX(1,IABS(IP))
  18       IF(IPA.GT.MSTU(4)-3) CALL LUERRM_HIJING(21,
  19      &'(LU4ENT_HIJING:) writing outside LUJETS_HIJING momory')
  20       KC1=LUCOMP_HIJING(KF1)
  21       KC2=LUCOMP_HIJING(KF2)
  22       KC3=LUCOMP_HIJING(KF3)
  23       KC4=LUCOMP_HIJING(KF4)
  24       IF(KC1.EQ.0.OR.KC2.EQ.0.OR.KC3.EQ.0.OR.KC4.EQ.0) CALL
  25      $     LUERRM_HIJING(12,'(LU4ENT_HIJING:) unknown flavour code')
  26
  27 C...Find masses. Reset K, P and V vectors.
  28       PM1=0.
  29       IF(MSTU(10).EQ.1) PM1=P(IPA,5)
  30       IF(MSTU(10).GE.2) PM1=ULMASS_HIJING(KF1)
  31       PM2=0.
  32       IF(MSTU(10).EQ.1) PM2=P(IPA+1,5)
  33       IF(MSTU(10).GE.2) PM2=ULMASS_HIJING(KF2)
  34       PM3=0.
  35       IF(MSTU(10).EQ.1) PM3=P(IPA+2,5)
  36       IF(MSTU(10).GE.2) PM3=ULMASS_HIJING(KF3)
  37       PM4=0.
  38       IF(MSTU(10).EQ.1) PM4=P(IPA+3,5)
  39       IF(MSTU(10).GE.2) PM4=ULMASS_HIJING(KF4)
  40       DO 100 I=IPA,IPA+3
  41       DO 100 J=1,5
  42       K(I,J)=0
  43       P(I,J)=0.
  44   100 V(I,J)=0.
  45
  46 C...Check flavours.
  47       KQ1=KCHG(KC1,2)*ISIGN(1,KF1)
  48       KQ2=KCHG(KC2,2)*ISIGN(1,KF2)
  49       KQ3=KCHG(KC3,2)*ISIGN(1,KF3)
  50       KQ4=KCHG(KC4,2)*ISIGN(1,KF4)
  51       IF(KQ1.EQ.0.AND.KQ2.EQ.0.AND.KQ3.EQ.0.AND.KQ4.EQ.0) THEN
  52       ELSEIF(KQ1.NE.0.AND.KQ2.EQ.2.AND.KQ3.EQ.2.AND.(KQ1+KQ4.EQ.0.OR.
  53      &KQ1+KQ4.EQ.4)) THEN
  54       ELSEIF(KQ1.NE.0.AND.KQ1+KQ2.EQ.0.AND.KQ3.NE.0.AND.KQ3+KQ4.EQ.0.)
  55      &THEN
  56       ELSE
  57          CALL LUERRM_HIJING(2
  58      $        ,'(LU4ENT_HIJING:) unphysical flavour combination')
  59       ENDIF
  60       K(IPA,2)=KF1
  61       K(IPA+1,2)=KF2
  62       K(IPA+2,2)=KF3
  63       K(IPA+3,2)=KF4
  64
  65 C...Store partons/particles in K vectors for normal case.
  66       IF(IP.GE.0) THEN
  67         K(IPA,1)=1
  68         IF(KQ1.NE.0.AND.(KQ2.NE.0.OR.KQ3.NE.0.OR.KQ4.NE.0)) K(IPA,1)=2
  69         K(IPA+1,1)=1
  70         IF(KQ2.NE.0.AND.KQ1+KQ2.NE.0.AND.(KQ3.NE.0.OR.KQ4.NE.0))
  71      &  K(IPA+1,1)=2
  72         K(IPA+2,1)=1
  73         IF(KQ3.NE.0.AND.KQ4.NE.0) K(IPA+2,1)=2
  74         K(IPA+3,1)=1
  75
  76 C...Store partons for parton shower evolution from q-g-g-qbar or
  77 C...g-g-g-g event.
  78       ELSEIF(KQ1+KQ2.NE.0) THEN
  79          IF(KQ1.EQ.0.OR.KQ2.EQ.0.OR.KQ3.EQ.0.OR.KQ4.EQ.0) CALL
  80      $        LUERRM_HIJING(2
  81      $        ,'(LU4ENT_HIJING:) requested flavours can not develop'/
  82      $        /' parton shower')
  83         K(IPA,1)=3
  84         K(IPA+1,1)=3
  85         K(IPA+2,1)=3
  86         K(IPA+3,1)=3
  87         KCS=4
  88         IF(KQ1.EQ.-1) KCS=5
  89         K(IPA,KCS)=MSTU(5)*(IPA+1)
  90         K(IPA,9-KCS)=MSTU(5)*(IPA+3)
  91         K(IPA+1,KCS)=MSTU(5)*(IPA+2)
  92         K(IPA+1,9-KCS)=MSTU(5)*IPA
  93         K(IPA+2,KCS)=MSTU(5)*(IPA+3)
  94         K(IPA+2,9-KCS)=MSTU(5)*(IPA+1)
  95         K(IPA+3,KCS)=MSTU(5)*IPA
  96         K(IPA+3,9-KCS)=MSTU(5)*(IPA+2)
  97
  98 C...Store partons for parton shower evolution from q-qbar-q-qbar event.
  99       ELSE
 100          IF(KQ1.EQ.0.OR.KQ2.EQ.0.OR.KQ3.EQ.0.OR.KQ4.EQ.0) CALL
 101      $        LUERRM_HIJING(2
 102      $        ,'(LU4ENT_HIJING:) requested flavours can not develop'/
 103      $        /' parton shower')
 104         K(IPA,1)=3
 105         K(IPA+1,1)=3
 106         K(IPA+2,1)=3
 107         K(IPA+3,1)=3
 108         K(IPA,4)=MSTU(5)*(IPA+1)
 109         K(IPA,5)=K(IPA,4)
 110         K(IPA+1,4)=MSTU(5)*IPA
 111         K(IPA+1,5)=K(IPA+1,4)
 112         K(IPA+2,4)=MSTU(5)*(IPA+3)
 113         K(IPA+2,5)=K(IPA+2,4)
 114         K(IPA+3,4)=MSTU(5)*(IPA+2)
 115         K(IPA+3,5)=K(IPA+3,4)
 116       ENDIF
 117
 118 C...Check kinematics.
 119       MKERR=0
 120       IF(0.5*X1*PECM.LE.PM1.OR.0.5*X2*PECM.LE.PM2.OR.0.5*(2.-X1-X2-X4)*
 121      &PECM.LE.PM3.OR.0.5*X4*PECM.LE.PM4) MKERR=1
 122       PA1=SQRT(MAX(0.,(0.5*X1*PECM)**2-PM1**2))
 123       PA2=SQRT(MAX(0.,(0.5*X2*PECM)**2-PM2**2))
 124       PA3=SQRT(MAX(0.,(0.5*(2.-X1-X2-X4)*PECM)**2-PM3**2))
 125       PA4=SQRT(MAX(0.,(0.5*X4*PECM)**2-PM4**2))
 126       X24=X1+X2+X4-1.-X12-X14+(PM3**2-PM1**2-PM2**2-PM4**2)/PECM**2
 127       CTHE4=(X1*X4-2.*X14)*PECM**2/(4.*PA1*PA4)
 128       IF(ABS(CTHE4).GE.1.002) MKERR=1
 129       CTHE4=MAX(-1.,MIN(1.,CTHE4))
 130       STHE4=SQRT(1.-CTHE4**2)
 131       CTHE2=(X1*X2-2.*X12)*PECM**2/(4.*PA1*PA2)
 132       IF(ABS(CTHE2).GE.1.002) MKERR=1
 133       CTHE2=MAX(-1.,MIN(1.,CTHE2))
 134       STHE2=SQRT(1.-CTHE2**2)
 135       CPHI2=((X2*X4-2.*X24)*PECM**2-4.*PA2*CTHE2*PA4*CTHE4)/
 136      &(4.*PA2*STHE2*PA4*STHE4)
 137       IF(ABS(CPHI2).GE.1.05) MKERR=1
 138       CPHI2=MAX(-1.,MIN(1.,CPHI2))
 139       IF(MKERR.EQ.1) CALL LUERRM_HIJING(13,
 140      &'(LU4ENT_HIJING:) unphysical kinematical variable setup')
 141
 142 C...Store partons/particles in P vectors.
 143       P(IPA,3)=PA1
 144       P(IPA,4)=SQRT(PA1**2+PM1**2)
 145       P(IPA,5)=PM1
 146       P(IPA+3,1)=PA4*STHE4
 147       P(IPA+3,3)=PA4*CTHE4
 148       P(IPA+3,4)=SQRT(PA4**2+PM4**2)
 149       P(IPA+3,5)=PM4
 150       P(IPA+1,1)=PA2*STHE2*CPHI2
 151       P(IPA+1,2)=PA2*STHE2*SQRT(1.-CPHI2**2)*(-1.)**INT(RLU_HIJING(0)+0
 152      $     .5)
 153       P(IPA+1,3)=PA2*CTHE2
 154       P(IPA+1,4)=SQRT(PA2**2+PM2**2)
 155       P(IPA+1,5)=PM2
 156       P(IPA+2,1)=-P(IPA+1,1)-P(IPA+3,1)
 157       P(IPA+2,2)=-P(IPA+1,2)
 158       P(IPA+2,3)=-P(IPA,3)-P(IPA+1,3)-P(IPA+3,3)
 159       P(IPA+2,4)=SQRT(P(IPA+2,1)**2+P(IPA+2,2)**2+P(IPA+2,3)**2+PM3**2)
 160       P(IPA+2,5)=PM3
 161
 162 C...Set N. Optionally fragment/decay.
 163       N=IPA+3
 164       IF(IP.EQ.0) CALL LUEXEC_HIJING
 165
 166       RETURN
 167       END