ISAJET/code/evol06.F

   1 #include "isajet/pilot.h"
   2       SUBROUTINE EVOL06
   3 C----------------------------------------------------------------------
   4 C-
   5 C-   Purpose and Methods :
   6 C-        Setup for process 6 (WPAIR)
   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/jetset.inc"
  20 #include "isajet/jwork.inc"
  21 #include "isajet/jwork2.inc"
  22 #include "isajet/keys.inc"
  23 #include "isajet/frame.inc"
  24       REAL    OFF,BP
  25       INTEGER I,K,J,NJSAVE,NJFINL,JTRUE
  26 C----------------------------------------------------------------------
  27 C
  28 C          Copy momenta from /PJETS/ to /JETSET/
  29       N0JETS=NJSET+1
  30       CALL IPJSET
  31 C
  32 C          Add extra momenta for WPAIR
  33       N0PAIR=NJSET+1
  34       DO 130 J=1,NPAIR
  35         NJSET=NJSET+1
  36         JORIG(NJSET)=JPACK*JPAIR(J)
  37         JTYPE(NJSET)=IDPAIR(J)
  38         JDCAY(NJSET)=0
  39         DO 135 K=1,5
  40 135     PJSET(K,NJSET)=PPAIR(K,J)
  41 130   CONTINUE
  42       DO 140 J=1,NPAIR,2
  43         JET=JPAIR(J)
  44         JTRUE=N0PAIR+J-1
  45         JDCAY(N0JETS+JET-1)=JTRUE*JPACK+JTRUE+1
  46 140   CONTINUE
  47       NJSAVE=NJSET
  48 C
  49 C          Set flags and maximum off-shell masses and generate
  50 C          initial QCD parton shower.
  51 C
  52       CALL ISTRAD(1.0)
  53 C
  54       IF(NJSET.LT.0) RETURN
  55 C
  56 C          Final state evolution.
  57 C          Define Lorentz frames and JMATCH pointers for jet evolution
  58 C          and fragmentation.
  59 C
  60       DO 200 I=3,NJSAVE,2
  61         JMATCH(I)=I+1
  62 200   JMATCH(I+1)=I
  63       DO 230 I=1,2
  64         DO 231 K=1,5
  65 231     FRAME(K,I)=PJSET(K,N0JETS+I-1)
  66         IFRAME(I)=I
  67 230   CONTINUE
  68 C
  69 C          Set up and generate final state QCD parton shower.
  70 C          Boost PJSET with -FRAME.
  71 C
  72       DO 240 J=1,NJSAVE
  73         JET=JORIG(J)/JPACK
  74         IF(JET.EQ.0) JET=3
  75         IF(JET.GT.10) GO TO 240
  76         IF(IDJETS(JET).EQ.10) GO TO 240
  77 C          Do this boost in double precision for 32-bit machines
  78         CALL DBOOST(-1,FRAME(1,JET),PJSET(1,J))
  79 240   CONTINUE
  80 C
  81 C          Set maximum off-shell masses and JDCAY flags.
  82 C
  83       NJFINL=N0PAIR
  84       DO 330 J=1,NPAIR
  85         IF(IABS(JTYPE(N0PAIR+J-1)).LT.10) THEN
  86           PJSET(5,N0PAIR+J-1)=PJETS(5,JPAIR(J))
  87           JDCAY(N0PAIR+J-1)=-1
  88         ENDIF
  89 330   CONTINUE
  90 C
  91 C          Produce final-state QCD parton cascade
  92 C
  93       CALL QCDJET(NJFINL)
  94 C
  95       RETURN
  96       END