TEvtGen/PHOTOS/phobos.F

   1       SUBROUTINE PHOBOS(IP,PBOOS1,PBOOS2,FIRST,LAST)
   2 C.----------------------------------------------------------------------
   3 C.
   4 C.    PHOBOS:   PHOton radiation in decays BOoSt routine
   5 C.
   6 C.    Purpose:  Boost particles  in  cascade decay  to parent rest frame
   7 C.              and boost back with modified boost vector.
   8 C.
   9 C.    Input Parameters:       IP:  pointer of particle starting chain
  10 C.                                 to be boosted
  11 C.                        PBOOS1:  Boost vector to rest frame,
  12 C.                        PBOOS2:  Boost vector to modified frame,
  13 C.                        FIRST:   Pointer to first particle to be boos-
  14 C.                                 ted (/PH_HEPEVT/),
  15 C.                        LAST:    Pointer to last  particle to be boos-
  16 C.                                 ted (/PH_HEPEVT/).
  17 C.
  18 C.    Output Parameters:  Common /PH_HEPEVT/.
  19 C.
  20 C.    Author(s):  B. van Eijk                     Created at:  13/02/90
  21 C.                Z. Was                          Last Update: 16/11/93
  22 C.
  23 C.----------------------------------------------------------------------
  24       IMPLICIT NONE
  25       DOUBLE PRECISION BET1(3),BET2(3),GAM1,GAM2,PB,DATA
  26       INTEGER I,J,FIRST,LAST,MAXSTA,NSTACK,IP
  27       PARAMETER (MAXSTA=10000)
  28       INTEGER STACK(MAXSTA)
  29       REAL*8 PBOOS1(5),PBOOS2(5)
  30       INTEGER NMXHEP
  31       PARAMETER (NMXHEP=10000)
  32       INTEGER IDHEP,ISTHEP,JDAHEP,JMOHEP,NEVHEP,NHEP
  33       REAL*8 PHEP,VHEP
  34       COMMON/PH_HEPEVT/NEVHEP,NHEP,ISTHEP(NMXHEP),IDHEP(NMXHEP),
  35      &JMOHEP(2,NMXHEP),JDAHEP(2,NMXHEP),PHEP(5,NMXHEP),VHEP(4,NMXHEP)
  36       IF ((LAST.EQ.0).OR.(LAST.LT.FIRST)) RETURN
  37       NSTACK=0
  38       DO 10 J=1,3
  39         BET1(J)=-PBOOS1(J)/PBOOS1(5)
  40    10 BET2(J)=PBOOS2(J)/PBOOS2(5)
  41       GAM1=PBOOS1(4)/PBOOS1(5)
  42       GAM2=PBOOS2(4)/PBOOS2(5)
  43 C--
  44 C--   Boost vector to parent rest frame...
  45    20 DO 50 I=FIRST,LAST
  46         PB=BET1(1)*PHEP(1,I)+BET1(2)*PHEP(2,I)+BET1(3)*PHEP(3,I)
  47         IF (JMOHEP(1,I).EQ.IP) THEN
  48          DO 30 J=1,3
  49    30    PHEP(J,I)=PHEP(J,I)+BET1(J)*(PHEP(4,I)+PB/(GAM1+1.D0))
  50          PHEP(4,I)=GAM1*PHEP(4,I)+PB
  51 C--
  52 C--    ...and boost back to modified parent frame.
  53          PB=BET2(1)*PHEP(1,I)+BET2(2)*PHEP(2,I)+BET2(3)*PHEP(3,I)
  54          DO 40 J=1,3
  55    40    PHEP(J,I)=PHEP(J,I)+BET2(J)*(PHEP(4,I)+PB/(GAM2+1.D0))
  56          PHEP(4,I)=GAM2*PHEP(4,I)+PB
  57          IF (JDAHEP(1,I).NE.0) THEN
  58            NSTACK=NSTACK+1
  59 C--
  60 C--    Check on stack length...
  61            IF (NSTACK.GT.MAXSTA) THEN
  62              DATA=NSTACK
  63              CALL PHOERR(7,'PHOBOS',DATA)
  64            ENDIF
  65            STACK(NSTACK)=I
  66          ENDIF
  67         ENDIF
  68    50 CONTINUE
  69       IF (NSTACK.NE.0) THEN
  70 C--
  71 C--   Now go one step further in the decay tree...
  72         FIRST=JDAHEP(1,STACK(NSTACK))
  73         LAST=JDAHEP(2,STACK(NSTACK))
  74         IP=STACK(NSTACK)
  75         NSTACK=NSTACK-1
  76         GOTO 20
  77       ENDIF
  78       RETURN
  79       END