ISAJET/code/iframs.F

   1 #include "isajet/pilot.h"
   2       SUBROUTINE IFRAMS(N1,N2,IFR,PAIR)
   3 C----------------------------------------------------------------------
   4 C-
   5 C-   Purpose and Methods :
   6 C-     Initialize a center of mass frame for partons N1 to N2
   7 C-     partons must be consecutive unless PAIR is true
   8 C-
   9 C-   Inputs  :
  10 C-   N1  = first parton
  11 C-   N2  = last parton
  12 C-   IFR = index of frame
  13 C-   PAIR= if false N1, N2 denote a range
  14 C-      if true N1 and N2 form a pair
  15 C-
  16 C-   Created  14-AUG-1991   Serban D. Protopopescu
  17 C-
  18 C----------------------------------------------------------------------
  19 #if defined(CERNLIB_IMPNONE)
  20       IMPLICIT NONE
  21 #endif
  22 #include "isajet/pjets.inc"
  23 #include "isajet/jetset.inc"
  24 #include "isajet/jwork.inc"
  25 #include "isajet/frame.inc"
  26       INTEGER I,J,K,JADD,N1,N2,IFR
  27       DOUBLE PRECISION DPASS(5),DSUM(5)
  28       LOGICAL PAIR
  29 C----------------------------------------------------------------------
  30 C
  31       IF ( N2-N1.EQ.1.OR.PAIR ) THEN
  32         JMATCH(N1)=N2
  33         JMATCH(N2)=N1
  34         JADD=N2-N1
  35       ELSE
  36         JADD=1
  37         DO 201 I=N1,N2
  38           JMATCH(I)=JPACK*N1+N2
  39 201     CONTINUE
  40       ENDIF
  41 C          Need double precision boosts
  42       CALL DBLVEC(PJSET(1,N1),DSUM)
  43       DO 211 I=N1+JADD,N2
  44         CALL DBLVEC(PJSET(1,I),DPASS)
  45         DO 210 K=1,4
  46 210     DSUM(K)=DSUM(K)+DPASS(K)
  47         DSUM(5)=DSQRT(DSUM(4)**2-DSUM(1)**2-DSUM(2)**2-DSUM(3)**2)
  48 211   CONTINUE
  49       DO 212 K=1,5
  50         FRAME(K,IFR)=DSUM(K)
  51 212   CONTINUE
  52 C
  53 C          Set up and generate final state QCD parton shower.
  54 C          Boost PJSET with -FRAME.
  55 C
  56       DO 240 J=N1,N2,JADD
  57         CALL DBOOST(-1,FRAME(1,IFR),PJSET(1,J))
  58 240   CONTINUE
  59 C
  60 999   RETURN
  61       END