More volume overlaps corrected
[u/mrichter/AliRoot.git] / ISAJET / code / evolve.F
1 #include "isajet/pilot.h"
2       SUBROUTINE EVOLVE
3 C----------------------------------------------------------------------
4 C-
5 C-   Purpose and Methods : 
6 C-        Call for each process a subroutine to set up
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/keys.inc"
24 #include "isajet/frame.inc"
25       REAL BP,PINCOM
26       INTEGER I,K,J,JJET,IFR
27 C----------------------------------------------------------------------
28 C          Initialize
29       NJSET=0
30       N0JETS=0
31       N0W=0
32       N0PAIR=0
33 C
34 C          Copy momenta from /PINITS/ to /JETSET/
35       IF(.NOT.KEYS(2)) THEN
36         DO 100 I=1,2
37           NJSET=NJSET+1
38           JORIG(NJSET)=JPACK*(10+I)
39           JTYPE(NJSET)=IDINIT(I)
40           JDCAY(NJSET)=JPACK*I+I
41           DO 105 K=1,5
42 105       PJSET(K,NJSET)=PINITS(K,I)
43 100     CONTINUE
44       ENDIF
45 C
46 C       Handle each process separately
47 C
48       IF(KEYS(1).OR.KEYS(8)) THEN
49         CALL EVOL01
50       ELSEIF(KEYS(2)) THEN
51         CALL EVOL02
52       ELSEIF(KEYS(3)) THEN
53         CALL EVOL03
54       ELSEIF(KEYS(5)) THEN
55         CALL EVOL05
56       ELSEIF(KEYS(6).OR.KEYS(10)) THEN
57         CALL EVOL06
58       ELSEIF(KEYS(7).OR.KEYS(9)) THEN
59         CALL EVOL07
60       ELSEIF(KEYS(11)) THEN
61         CALL EVOL11
62       ELSEIF(KEYS(12)) THEN
63         CALL EVOL01
64       ENDIF
65 C
66       IF(NJSET.LT.0) RETURN
67 C
68 C          Boost /JETSET/ partons back to PP COM
69 C
70       DO 500 J=1,NJSET
71         JJET=JORIG(J)/JPACK
72         IF ( JJET.EQ.0 ) THEN
73           IFR=1
74         ELSE
75           IF(JJET.GT.10) GO TO 500
76           IF(IDJETS(JJET).EQ.10.AND.KEYS(6)) GO TO 500
77           IFR=IFRAME(JJET)
78         ENDIF
79         BP=0.
80         DO 505 K=1,3
81 505     BP=BP+FRAME(K,IFR)*PJSET(K,J)
82         BP=BP/FRAME(5,IFR)
83         DO 510 K=1,3
84 510     PJSET(K,J)=PJSET(K,J)+FRAME(K,IFR)*PJSET(4,J)/FRAME(5,IFR)
85      1  +FRAME(K,IFR)*BP/(FRAME(4,IFR)+FRAME(5,IFR))
86         PJSET(4,J)=FRAME(4,IFR)*PJSET(4,J)/FRAME(5,IFR)+BP
87 500   CONTINUE
88 C
89 C          Reset PBEAM
90       DO 530 J=1,NJSET
91         IF(JDCAY(J).EQ.JPACK*J+J) THEN
92           JJET=JORIG(J)/JPACK-10
93           PINCOM=.5*(PJSET(4,J)+ABS(PJSET(3,J)))
94           PBEAM(JJET)=HALFE-PINCOM
95         ENDIF
96 530   CONTINUE
97 C
98 C          Check for zero energy partons
99       CALL IRMOV0
100 C
101       RETURN
102       END