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