PHOS/shaker/lu2ent.f

   1 *CMZ :          17/07/98  15.44.31  by  Federico Carminati
   2 *-- Author :
   3 C*********************************************************************
   4
   5       SUBROUTINE LU2ENT(IP,KF1,KF2,PECM)
   6
   7 C...Purpose: to store two partons/particles in their CM frame,
   8 C...with the first along the +z axis.
   9 *KEEP,LUJETS.
  10       COMMON /LUJETS/ N,K(200000,5),P(200000,5),V(200000,5)
  11       SAVE /LUJETS/
  12 *KEEP,LUDAT1.
  13       COMMON /LUDAT1/ MSTU(200),PARU(200),MSTJ(200),PARJ(200)
  14       SAVE /LUDAT1/
  15 *KEEP,LUDAT2.
  16       COMMON /LUDAT2/ KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
  17       SAVE /LUDAT2/
  18 *KEND.
  19
  20 C...Standard checks.
  21       MSTU(28)=0
  22       IF(MSTU(12).GE.1) CALL LULIST(0)
  23       IPA=MAX(1,IABS(IP))
  24       IF(IPA.GT.MSTU(4)-1) CALL LUERRM(21,
  25      &'(LU2ENT:) writing outside LUJETS memory')
  26       KC1=LUCOMP(KF1)
  27       KC2=LUCOMP(KF2)
  28       IF(KC1.EQ.0.OR.KC2.EQ.0) CALL LUERRM(12,
  29      &'(LU2ENT:) unknown flavour code')
  30
  31 C...Find masses. Reset K, P and V vectors.
  32       PM1=0.
  33       IF(MSTU(10).EQ.1) PM1=P(IPA,5)
  34       IF(MSTU(10).GE.2) PM1=ULMASS(KF1)
  35       PM2=0.
  36       IF(MSTU(10).EQ.1) PM2=P(IPA+1,5)
  37       IF(MSTU(10).GE.2) PM2=ULMASS(KF2)
  38       DO 100 I=IPA,IPA+1
  39       DO 100 J=1,5
  40       K(I,J)=0
  41       P(I,J)=0.
  42   100 V(I,J)=0.
  43
  44 C...Check flavours.
  45       KQ1=KCHG(KC1,2)*ISIGN(1,KF1)
  46       KQ2=KCHG(KC2,2)*ISIGN(1,KF2)
  47       IF(KQ1+KQ2.NE.0.AND.KQ1+KQ2.NE.4) CALL LUERRM(2,
  48      &'(LU2ENT:) unphysical flavour combination')
  49       K(IPA,2)=KF1
  50       K(IPA+1,2)=KF2
  51
  52 C...Store partons/particles in K vectors for normal case.
  53       IF(IP.GE.0) THEN
  54         K(IPA,1)=1
  55         IF(KQ1.NE.0.AND.KQ2.NE.0) K(IPA,1)=2
  56         K(IPA+1,1)=1
  57
  58 C...Store partons in K vectors for parton shower evolution.
  59       ELSE
  60         IF(KQ1.EQ.0.OR.KQ2.EQ.0) CALL LUERRM(2,
  61      &  '(LU2ENT:) requested flavours can not develop parton shower')
  62         K(IPA,1)=3
  63         K(IPA+1,1)=3
  64         K(IPA,4)=MSTU(5)*(IPA+1)
  65         K(IPA,5)=K(IPA,4)
  66         K(IPA+1,4)=MSTU(5)*IPA
  67         K(IPA+1,5)=K(IPA+1,4)
  68       ENDIF
  69
  70 C...Check kinematics and store partons/particles in P vectors.
  71       IF(PECM.LE.PM1+PM2) CALL LUERRM(13,
  72      &'(LU2ENT:) energy smaller than sum of masses')
  73       PA=SQRT(MAX(0.,(PECM**2-PM1**2-PM2**2)**2-(2.*PM1*PM2)**2))/
  74      &(2.*PECM)
  75       P(IPA,3)=PA
  76       P(IPA,4)=SQRT(PM1**2+PA**2)
  77       P(IPA,5)=PM1
  78       P(IPA+1,3)=-PA
  79       P(IPA+1,4)=SQRT(PM2**2+PA**2)
  80       P(IPA+1,5)=PM2
  81
  82 C...Set N. Optionally fragment/decay.
  83       N=IPA+1
  84       IF(IP.EQ.0) CALL LUEXEC
  85
  86       RETURN
  87       END