More volume overlaps corrected
[u/mrichter/AliRoot.git] / ISAJET / code / evol06.F
CommitLineData
0795afa3 1#include "isajet/pilot.h"
2 SUBROUTINE EVOL06
3C----------------------------------------------------------------------
4C-
5C- Purpose and Methods :
6C- Setup for process 6 (WPAIR)
7C- Lorentz frames and perform initial and final QCD jet
8C- evolution in leading-log approximation.
9C-
10C- Created 13-AUG-1991 Frank E. Paige,Serban D. Protopopescu
11C-
12C----------------------------------------------------------------------
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
26C----------------------------------------------------------------------
27C
28C Copy momenta from /PJETS/ to /JETSET/
29 N0JETS=NJSET+1
30 CALL IPJSET
31C
32C 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
40135 PJSET(K,NJSET)=PPAIR(K,J)
41130 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
46140 CONTINUE
47 NJSAVE=NJSET
48C
49C Set flags and maximum off-shell masses and generate
50C initial QCD parton shower.
51C
52 CALL ISTRAD(1.0)
53C
54 IF(NJSET.LT.0) RETURN
55C
56C Final state evolution.
57C Define Lorentz frames and JMATCH pointers for jet evolution
58C and fragmentation.
59C
60 DO 200 I=3,NJSAVE,2
61 JMATCH(I)=I+1
62200 JMATCH(I+1)=I
63 DO 230 I=1,2
64 DO 231 K=1,5
65231 FRAME(K,I)=PJSET(K,N0JETS+I-1)
66 IFRAME(I)=I
67230 CONTINUE
68C
69C Set up and generate final state QCD parton shower.
70C Boost PJSET with -FRAME.
71C
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
77C Do this boost in double precision for 32-bit machines
78 CALL DBOOST(-1,FRAME(1,JET),PJSET(1,J))
79240 CONTINUE
80C
81C Set maximum off-shell masses and JDCAY flags.
82C
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
89330 CONTINUE
90C
91C Produce final-state QCD parton cascade
92C
93 CALL QCDJET(NJFINL)
94C
95 RETURN
96 END