ISAJET/code/ipartns.F

   1 #include "isajet/pilot.h"
   2       SUBROUTINE IPARTNS(NPRTNS,IDS,PRTNS,IDQ,WEIGHT,WZDK)
   3 C----------------------------------------------------------------------
   4 C-
   5 C-   Purpose and Methods :
   6 C-     fill PJETS array from a list of input partons
   7 C-   Inputs  :
   8 C-     NPRTNS          = number of partons
   9 C-     IDS(NPRTNS)     = parton ids
  10 C-     PRTNS(4,NPRTNS) = parton 4 vectors
  11 C-     IDQ(2)          = initial partons
  12 C-     WEIGHT          = weight
  13 C-     WZDK            = if true last 2 partons are from W,Z decay
  14 C-
  15 C-
  16 C-   Created   8-OCT-1991   Serban D. Protopopescu
  17 C-   Updated  17-APR-1996   Serban D. Protopopescu
  18 C-    added entry evcuts to supply evolution limits
  19 C-    modified DrellYan (keys(3)) to stay within VECBOS jet ranking
  20 C-   Updated  16-JUN-1998   F. Paige
  21 C-    Removed ISAZEB dependence: use ISPJET and do not call ISPETA
  22 C-
  23 C----------------------------------------------------------------------
  24 #if defined(CERNLIB_IMPNONE)
  25       IMPLICIT NONE
  26 #endif
  27       INTEGER NPRTNS,IDS(NPRTNS),IDQ(2)
  28       REAL    PRTNS(4,NPRTNS),WEIGHT
  29       LOGICAL WZDK
  30 #include "isajet/final.inc"
  31 #include "isajet/idrun.inc"
  32 #include "isajet/jetpar.inc"
  33 #include "isajet/keys.inc"
  34 #include "isajet/nodcay.inc"
  35 #include "isajet/partcl.inc"
  36 #include "isajet/pjets.inc"
  37 #include "isajet/primar.inc"
  38 #include "isajet/q1q2.inc"
  39 #include "isajet/totals.inc"
  40       REAL    SUM(4),AMASS
  41       INTEGER K,J,IWZ,ID,NQS
  42       INTEGER MAXQ
  43       PARAMETER (MAXQ=15)
  44       INTEGER I,NP,JDORD(MAXQ),JIORD(MAXQ),NPJ
  45       REAL    ETAQ(MAXQ),PHIQ(MAXQ),THQ(MAXQ),PTQ(MAXQ)
  46       REAL    ETCUT,ETIN,RCUT,RIN,R
  47       REAL    PPI
  48       REAL    PXPT(MAXQ),PXETA(MAXQ),PXPHI(MAXQ)
  49       LOGICAL DOEVOL,DOEVIN
  50       DOUBLE PRECISION PI, TWOPI, HALFPI, RADIAN
  51       PARAMETER (PI=        3.1415 92653 58979 32384 6 D0)
  52       PARAMETER (TWOPI=     6.2831 85307 17958 64769 3 D0)
  53       PARAMETER (HALFPI=    1.5707 96326 79489 66192 3 D0)
  54       PARAMETER (RADIAN= 0.0174532 92519 94329 5769237 D0)
  55 C----------------------------------------------------------------------
  56 C
  57       NJET=0
  58 C
  59 C          handle W's and Z's
  60 C
  61       IEVT=IEVT+1
  62       IWZ=0
  63       NQS=NPRTNS
  64       IF(WZDK) NQS=NPRTNS-2
  65       DO 1 J=1,NPRTNS
  66         ID=IABS(IDS(J))
  67         IF(ID.GT.79) THEN
  68           IF(ID.EQ.90) JWTYP=4
  69           IF(IDS(J).EQ.80) JWTYP=2
  70           IF(IDS(J).EQ.-80) JWTYP=3
  71           IDENTW=IDS(J)
  72           DO 2 K=1,4
  73             QWJET(K)=PRTNS(K,J)
  74    2      CONTINUE
  75           QWJET(5)=SQRT(QWJET(4)**2-QWJET(1)**2-QWJET(2)**2-QWJET(3)**2)
  76           IWZ=J
  77         ENDIF
  78    1  CONTINUE
  79       DO 4 J=NQS+1,NPRTNS
  80         ID=IABS(IDS(J))
  81         NJET=NJET+1
  82         DO 3 K=1,4
  83           PJETS(K,NJET)=PRTNS(K,J)
  84     3   CONTINUE
  85         IDJETS(NJET)=IDS(J)
  86         PJETS(5,NJET)=AMASS(ID)
  87     4 CONTINUE
  88 C          W,Z decays were not in input
  89       IF(IWZ.NE.0.AND.NJET.EQ.0) THEN
  90         NJET=2
  91         CALL ISWDKY
  92       ENDIF
  93 C
  94 C      fill with the other partons
  95 C
  96       DO 5 K=1,4
  97         SUM(K)=0
  98    5  CONTINUE
  99       DO 11 J=1,NQS
 100         ID=IABS(IDS(J))
 101         IF(IWZ.NE.J.AND.ID.LT.11) THEN
 102           NJET=NJET+1
 103           IDJETS(NJET)=IDS(J)
 104           DO 12 K=1,4
 105             PJETS(K,NJET)=PRTNS(K,J)
 106   12      CONTINUE
 107           PJETS(5,NJET)=PRTNS(4,J)**2-PRTNS(1,J)**2-PRTNS(2,J)**2-
 108      $      PRTNS(3,J)**2
 109           IF ( PJETS(5,NJET).GT.0. ) THEN
 110             PJETS(5,NJET)=SQRT(PJETS(5,NJET))
 111           ELSE
 112             PJETS(4,NJET)=SQRT(PRTNS(4,J)**2-PJETS(5,NJET))
 113             PJETS(5,NJET)=0.
 114           ENDIF
 115         ENDIF
 116         DO 13 K=1,4
 117           SUM(K)=SUM(K)+PRTNS(K,J)
 118   13    CONTINUE
 119   11  CONTINUE
 120 C
 121 C        eta and phi of incoming partons
 122       IF(DOEVOL) THEN
 123         NP=NQS-1
 124         DO 114 I=1,NP
 125           PPI=SQRT(PRTNS(1,I)**2+PRTNS(2,I)**2+PRTNS(3,I)**2)
 126           IF(PPI.GT.0.AND.PPI.GT.ABS(PRTNS(3,I))) THEN
 127             THQ(I)=ACOS(PRTNS(3,I)/PPI)
 128             ETAQ(I)=-LOG(TAN(THQ(I)/2))
 129           ELSE
 130             THQ(I)=0
 131             ETAQ(I)=SIGN(999.,PRTNS(3,I))
 132           ENDIF
 133           PTQ(I)=SQRT(PRTNS(1,I)**2+PRTNS(2,I)**2)
 134           IF(PTQ(I).GT.0) THEN
 135             PHIQ(I)=ATAN2(PRTNS(2,I),PRTNS(1,I))
 136             IF(PHIQ(I).LT.0) PHIQ(I)=PHIQ(I)+TWOPI
 137           ELSE
 138             PHIQ(I)=0
 139           ENDIF
 140  114    CONTINUE
 141 C
 142 C ... Order partons in pt
 143 C
 144         DO 115 I = 1 , NP
 145           JIORD(I) = I
 146           PXPT(I)=PTQ(I)
 147  115    CONTINUE
 148         CALL ISASRT(PXPT(1),NP,JIORD)
 149         DO 116 I = 1 , NP
 150           PXPT(I)=PTQ(I)
 151           PXETA(I)=ETAQ(I)
 152           PXPHI(I)=PHIQ(I)
 153           JDORD(I) = JIORD(NP-I+1)
 154  116    CONTINUE
 155         DO 117 I = 1 , NP
 156           PTQ(I)=PXPT(JDORD(I))
 157           ETAQ(I)=PXETA(JDORD(I))
 158           PHIQ(I)=PXPHI(JDORD(I))
 159  117    CONTINUE
 160       ENDIF
 161 C
 162 C
 163   15  CONTINUE
 164       PBEAM(1)=(ECM-SUM(4)-SUM(3))/2.
 165       PBEAM(2)=(ECM-SUM(4)+SUM(3))/2.
 166       QSQ=SQRT(SUM(4)**2-SUM(3)**2-SUM(2)**2-SUM(1)**2)
 167       CALL RANFMT
 168       NPTCL=0
 169       IF(KEYS(3)) THEN
 170         STDDY=.FALSE.
 171         IF(NQS.EQ.1.OR.NJET.LT.3) STDDY=.TRUE.
 172       ENDIF
 173       CALL IPRTNS(NQS,PRTNS,IDQ)
 174       IF(.NOT.NOEVOL) THEN
 175         CALL EVOLVE
 176 C
 177 C            special check for VECBOS
 178         IF(DOEVOL) THEN
 179 C       Find parton jets
 180           CALL ISPJET(RCUT,ETCUT,NPJ,PXPT,PXPHI,PXETA)
 181           IF(NPJ.GE.NP.AND.PXPT(NP).GT.PTQ(NP)) THEN
 182             R=SQRT((PXETA(NP)-ETAQ(NP))**2+(PXPHI(NP)-PHIQ(NP))**2)
 183             IF(R.GT.RCUT) GOTO 15
 184           ENDIF
 185         ENDIF
 186 C
 187         IF(.NOT.NOHADR) THEN
 188           CALL FRGMNT
 189           CALL MBIAS
 190         ENDIF
 191       ENDIF
 192       WT=WEIGHT
 193       SUMWT=SUMWT+WT
 194       SIGF=SUMWT
 195       NKINF=IEVT
 196       NEVENT=IEVT
 197   999 RETURN
 198 C
 199 C     Entry point to set parameters
 200 C
 201       ENTRY EVCUTS(RIN,ETIN,DOEVIN)
 202       RCUT=RIN
 203       ETCUT=ETIN
 204       DOEVOL=DOEVIN
 205       RETURN
 206       END