ISAJET/code/evol07.F

   1 #include "isajet/pilot.h"
   2       SUBROUTINE EVOL07
   3 C----------------------------------------------------------------------
   4 C-
   5 C-   Purpose and Methods :
   6 C-        Setup for process 7 (HIGGS)
   7 C-        Lorentz frames and perform initial and final QCD jet
   8 C-        evolution in leading-log approximation.
   9 C-
  10 C-   Created  13-AUG-1991   Frank E. Paige,Serban D. Protopopescu
  11 C-
  12 C----------------------------------------------------------------------
  13 #if defined(CERNLIB_IMPNONE)
  14       IMPLICIT NONE
  15 #endif
  16 #include "isajet/primar.inc"
  17 #include "isajet/jetpar.inc"
  18 #include "isajet/pjets.inc"
  19 #include "isajet/pinits.inc"
  20 #include "isajet/jetset.inc"
  21 #include "isajet/jwork.inc"
  22 #include "isajet/jwork2.inc"
  23 #include "isajet/frame.inc"
  24       REAL    EVOLMS,BP
  25       INTEGER I,K,J,NJSAVE,NJFINL,JTRUE
  26       DOUBLE PRECISION DPASS(5),DSUM(5)
  27       INTEGER IDABS1,IDABS2
  28 C----------------------------------------------------------------------
  29 C
  30 C          Copy momenta from /PJETS/ to /JETSET/
  31       N0JETS=NJSET+1
  32       CALL IPJSET
  33 C
  34 C          Add extra momenta for WPAIR
  35       IDABS1=IABS(IDJETS(1))
  36       IDABS2=IABS(IDJETS(2))
  37       IF(IDABS1.EQ.80.OR.IDABS1.EQ.90.OR.IDABS2.EQ.80.OR.
  38      $IDABS2.EQ.90) THEN
  39         N0PAIR=NJSET+1
  40         DO 130 J=1,NPAIR
  41           NJSET=NJSET+1
  42           JORIG(NJSET)=JPACK*JPAIR(J)
  43           JTYPE(NJSET)=IDPAIR(J)
  44           JDCAY(NJSET)=0
  45           DO 135 K=1,5
  46 135       PJSET(K,NJSET)=PPAIR(K,J)
  47 130     CONTINUE
  48         DO 140 J=1,NPAIR,2
  49           JET=JPAIR(J)
  50           JTRUE=N0PAIR+J-1
  51           JDCAY(N0JETS+JET-1)=JTRUE*JPACK+JTRUE+1
  52 140     CONTINUE
  53       ENDIF
  54       NJSAVE=NJSET
  55 C
  56 C          Set flags and maximum off-shell masses and generate
  57 C          initial QCD parton shower.
  58 C
  59       IF(IABS(IDINIT(1)).LT.80) THEN
  60         CALL ISTRAD(1.0)
  61         IF(NJSET.LT.0) RETURN
  62 C
  63 C
  64 C          Special initial state evolution for W-W fusion.
  65       ELSE
  66         CALL HEVOLV
  67         IF(NJSET.LT.0) RETURN
  68         DO 141 J=1,NJSET
  69 141     JMATCH(J)=0
  70         DO 142 JET=1,2
  71           J=NJSET+1-2*JET
  72           PJSET(5,J)=-PJSET(5,JET)
  73 142     JDCAY(J)=-2
  74         CALL QCDINI(NJSET-3,NJSET-1)
  75         IF(NJSET.LT.0) RETURN
  76       ENDIF
  77 C
  78 C
  79 C          Final state evolution.
  80 C          Define Lorentz frames and JMATCH pointers for jet evolution
  81 C          and fragmentation.
  82 C
  83       DO 200 I=3,NJSAVE,2
  84         JMATCH(I)=I+1
  85         JMATCH(I+1)=I
  86 200   CONTINUE
  87       IF(NPAIR.EQ.0) THEN
  88         CALL DBLVEC(PJSET(1,N0JETS),DSUM)
  89         CALL DBLVEC(PJSET(1,N0JETS+1),DPASS)
  90         DO 231 K=1,4
  91 231     DSUM(K)=DSUM(K)+DPASS(K)
  92         DSUM(5)=DSQRT(DSUM(4)**2-DSUM(1)**2-DSUM(2)**2-DSUM(3)**2)
  93         DO 232 K=1,5
  94           FRAME(K,1)=DSUM(K)
  95           FRAME(K,2)=FRAME(K,1)
  96 232     CONTINUE
  97       ELSE
  98         DO 233 I=1,2
  99           DO 234 K=1,5
 100             FRAME(K,I)=PJSET(K,N0JETS+I-1)
 101 234       CONTINUE
 102           IFRAME(I)=I
 103 233     CONTINUE
 104       ENDIF
 105 C
 106 C          Set up and generate final state QCD parton shower.
 107 C          Boost PJSET with -FRAME.
 108 C
 109       DO 240 J=1,NJSAVE
 110         JET=JORIG(J)/JPACK
 111         IF(JET.EQ.0) JET=3
 112         IF(JET.GT.10) GO TO 240
 113 C          Do this boost in double precision for 32-bit machines
 114         CALL DBOOST(-1,FRAME(1,JET),PJSET(1,J))
 115 240   CONTINUE
 116 C
 117 C          Set maximum off-shell masses and JDCAY flags.
 118 C
 119       IF(NPAIR.EQ.0) THEN
 120         NJFINL=N0JETS
 121         DO 340 J=N0JETS,NJSAVE
 122           IF(IABS(JTYPE(J)).LT.10) THEN
 123             PJSET(5,J)=EVOLMS(J,1.0)
 124             JDCAY(J)=-1
 125           ENDIF
 126 340     CONTINUE
 127       ELSE
 128         NJFINL=N0PAIR
 129         DO 341 J=1,NPAIR
 130           IF(IABS(JTYPE(N0PAIR+J-1)).LT.10) THEN
 131             PJSET(5,N0PAIR+J-1)=PJETS(5,JPAIR(J))
 132             JDCAY(N0PAIR+J-1)=-1
 133           ENDIF
 134 341     CONTINUE
 135       ENDIF
 136 C
 137 C          Produce final-state QCD parton cascade
 138 C
 139       CALL QCDJET(NJFINL)
 140 C
 141       RETURN
 142       END