TEvtGen/PHOTOS/phoout.F

   1       SUBROUTINE PHOOUT(IP,BOOST,NHEP0)
   2 C.----------------------------------------------------------------------
   3 C.
   4 C.    PHOOUT:   PHOtos OUTput
   5 C.
   6 C.    Purpose:  copies back IP branch of the common /PH_HEPEVT/ from
   7 C.              /PHOEVT/ moves branch back from its CMS system.
   8 C.
   9 C.    Input Parameters:       IP:  pointer of particle starting branch
  10 C.                                 to be given back.
  11 C.                        BOOST:   Flag whether boost to CMS was or was
  12 C     .                            not performed.
  13 C.
  14 C.    Output Parameters:  Common /PHOEVT/,
  15 C.
  16 C.    Author(s):  Z. Was                          Created at:  24/05/93
  17 C.                                                Last Update:
  18 C.
  19 C.----------------------------------------------------------------------
  20       IMPLICIT NONE
  21       INTEGER NMXHEP
  22       PARAMETER (NMXHEP=10000)
  23       INTEGER IDHEP,ISTHEP,JDAHEP,JMOHEP,NEVHEP,NHEP
  24       REAL*8 PHEP,VHEP
  25       COMMON/PH_HEPEVT/NEVHEP,NHEP,ISTHEP(NMXHEP),IDHEP(NMXHEP),
  26      &JMOHEP(2,NMXHEP),JDAHEP(2,NMXHEP),PHEP(5,NMXHEP),VHEP(4,NMXHEP)
  27       INTEGER NMXPHO
  28       PARAMETER (NMXPHO=10000)
  29       INTEGER IDPHO,ISTPHO,JDAPHO,JMOPHO,NEVPHO,NPHO
  30       REAL*8 PPHO,VPHO
  31       COMMON/PHOEVT/NEVPHO,NPHO,ISTPHO(NMXPHO),IDPHO(NMXPHO),
  32      &JMOPHO(2,NMXPHO),JDAPHO(2,NMXPHO),PPHO(5,NMXPHO),VPHO(4,NMXPHO)
  33       INTEGER IP,LL,FIRST,LAST,I
  34       LOGICAL BOOST
  35       INTEGER NN,J,K,NHEP0,NA
  36       DOUBLE PRECISION BET(3),GAM,PB
  37       COMMON /PHOCMS/ BET,GAM
  38       IF(NPHO.EQ.NEVPHO) RETURN
  39 C--   When parent was not in its rest-frame, boost back...
  40       CALL PHLUPA(10)
  41       IF (BOOST) THEN
  42         DO 110 J=JDAPHO(1,1),JDAPHO(2,1)
  43           PB=-BET(1)*PPHO(1,J)-BET(2)*PPHO(2,J)-BET(3)*PPHO(3,J)
  44           DO 100 K=1,3
  45   100     PPHO(K,J)=PPHO(K,J)-BET(K)*(PPHO(4,J)+PB/(GAM+1.D0))
  46   110   PPHO(4,J)=GAM*PPHO(4,J)+PB
  47 C--   ...boost photon, or whatever else has shown up
  48         DO NN=NEVPHO+1,NPHO
  49           PB=-BET(1)*PPHO(1,NN)-BET(2)*PPHO(2,NN)-BET(3)*PPHO(3,NN)
  50           DO 120 K=1,3
  51   120     PPHO(K,NN)=PPHO(K,NN)-BET(K)*(PPHO(4,NN)+PB/(GAM+1.D0))
  52           PPHO(4,NN)=GAM*PPHO(4,NN)+PB
  53         ENDDO
  54       ENDIF
  55         FIRST=JDAHEP(1,IP)
  56         LAST =JDAHEP(2,IP)
  57 C let's take in original daughters
  58         DO LL=0,LAST-FIRST
  59          IDHEP(FIRST+LL) = IDPHO(3+LL)
  60            DO I=1,5
  61              PHEP(I,FIRST+LL) = PPHO(I,3+LL)
  62            ENDDO
  63         ENDDO
  64 C let's take newcomers to the end of HEPEVT.
  65         NA=3+LAST-FIRST
  66         DO LL=1,NPHO-NA
  67          IDHEP(NHEP0+LL) = IDPHO(NA+LL)
  68          ISTHEP(NHEP0+LL)=ISTPHO(NA+LL)
  69          JMOHEP(1,NHEP0+LL)=IP
  70          JMOHEP(2,NHEP0+LL)=JMOHEP(2,JDAHEP(1,IP))
  71          JDAHEP(1,NHEP0+LL)=0
  72          JDAHEP(2,NHEP0+LL)=0
  73            DO I=1,5
  74              PHEP(I,NHEP0+LL) = PPHO(I,NA+LL)
  75            ENDDO
  76         ENDDO
  77         NHEP=NHEP+NPHO-NEVPHO
  78         CALL PHLUPA(20)
  79       END