ISAJET/code/decps2.F

   1 #include "isajet/pilot.h"
   2       SUBROUTINE DECPS2(IP,NADD,PGEN,PREST,BETA,GAMMA)
   3 C
   4 C          Carry out decays using masses from DECPS1 or special matrix
   5 C          elements.
   6 C          Auxiliary routine for DECAY.
   7 C
   8 #if defined(CERNLIB_IMPNONE)
   9       IMPLICIT NONE
  10 #endif
  11 C
  12 #include "isajet/itapes.inc"
  13 #include "isajet/partcl.inc"
  14 #include "isajet/const.inc"
  15 C
  16       INTEGER IP,NADD
  17       REAL PGEN(5,5),PREST(4,6)
  18       REAL PCM,DBLPCM,RANF
  19       REAL U(3),BETA(3)
  20       REAL QCM,PHI,A,B,C,GAMMA,BP
  21       INTEGER I,J,NADD1,II,K,K1
  22 C
  23 C          Function definitions.
  24 C
  25 #if defined(CERNLIB_SINGLE)
  26       PCM(A,B,C)=SQRT((A-B-C)*(A+B+C)*(A-B+C)*(A+B-C))/(2.*A)
  27 #endif
  28 #if defined(CERNLIB_DOUBLE)
  29       PCM(A,B,C)=DBLPCM(A,B,C)
  30 #endif
  31 C
  32 C          Carry out two-body decays in PGEN frames.
  33 C
  34       NADD1=NADD-1
  35 100   CONTINUE
  36       DO 110 I=1,NADD1
  37         QCM=PCM(PGEN(5,I),PGEN(5,I+1),PPTCL(5,NPTCL+I))
  38         U(3)=2.*RANF()-1.
  39         PHI=2.*PI*RANF()
  40         U(1)=SQRT(1.-U(3)**2)*COS(PHI)
  41         U(2)=SQRT(1.-U(3)**2)*SIN(PHI)
  42         DO 120 J=1,3
  43           PPTCL(J,NPTCL+I)=QCM*U(J)
  44           PGEN(J,I+1)=-PPTCL(J,NPTCL+I)
  45 120     CONTINUE
  46         PPTCL(4,NPTCL+I)=SQRT(QCM**2+PPTCL(5,NPTCL+I)**2)
  47         PGEN(4,I+1)=SQRT(QCM**2+PGEN(5,I+1)**2)
  48 110   CONTINUE
  49 C
  50       DO 130 J=1,4
  51         PPTCL(J,NPTCL+NADD)=PGEN(J,NADD)
  52 130   CONTINUE
  53 C
  54 C          Boost PGEN frames to lab frame, saving momenta in rest frame.
  55 C
  56       DO 200 II=1,NADD1
  57         I=NADD-II
  58         DO 210 J=1,3
  59           BETA(J)=PGEN(J,I)/PGEN(4,I)
  60 210     CONTINUE
  61         GAMMA=PGEN(4,I)/PGEN(5,I)
  62         DO 220 K=I,NADD
  63           K1=NPTCL+K
  64           BP=BETA(1)*PPTCL(1,K1)+BETA(2)*PPTCL(2,K1)+BETA(3)*PPTCL(3,K1)
  65           DO 230 J=1,3
  66             PREST(J,K)=PPTCL(J,K1)
  67             PPTCL(J,K1)=PPTCL(J,K1)+GAMMA*BETA(J)*(PPTCL(4,K1)
  68      $      +BP*GAMMA/(GAMMA+1.))
  69 230       CONTINUE
  70           PREST(4,K)=PPTCL(4,K1)
  71           PPTCL(4,K1)=GAMMA*(PPTCL(4,K1)+BP)
  72 220     CONTINUE
  73 200   CONTINUE
  74 C
  75       RETURN
  76       END