TEvtGen/PHOTOS/phoin.F

   1       SUBROUTINE PHOIN(IP,BOOST,NHEP0)
   2 C.----------------------------------------------------------------------
   3 C.
   4 C.    PHOIN:   PHOtos INput
   5 C.
   6 C.    Purpose:  copies IP branch of the common /PH_HEPEVT/ into /PHOEVT/
   7 C.              moves branch into its CMS system.
   8 C.
   9 C.    Input Parameters:       IP:  pointer of particle starting branch
  10 C.                                 to be copied
  11 C.                        BOOST:   Flag whether boost to CMS was or was
  12 C     .                            not performed.
  13 C.
  14 C.    Output Parameters:  Commons: /PHOEVT/, /PHOCMS/
  15 C.
  16 C.    Author(s):  Z. Was                          Created at:  24/05/93
  17 C.                                                Last Update: 16/11/93
  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,IP2,I,FIRST,LAST,LL,NA
  34       LOGICAL BOOST
  35       INTEGER J,NHEP0
  36       DOUBLE PRECISION BET(3),GAM,PB
  37       COMMON /PHOCMS/ BET,GAM
  38       LOGICAL INTERF,ISEC,IFTOP
  39       REAL*8 FINT,FSEC
  40       COMMON /PHOKEY/ FSEC,FINT,INTERF,ISEC,IFTOP
  41 C--
  42 C let's calculate size of the little common entry
  43         FIRST=JDAHEP(1,IP)
  44         LAST =JDAHEP(2,IP)
  45         NPHO=3+LAST-FIRST+NHEP-NHEP0
  46         NEVPHO=NPHO
  47 C let's take in decaying particle
  48            IDPHO(1)=IDHEP(IP)
  49            JDAPHO(1,1)=3
  50            JDAPHO(2,1)=3+LAST-FIRST
  51            DO I=1,5
  52              PPHO(I,1)=PHEP(I,IP)
  53            ENDDO
  54 C let's take in eventual second mother
  55          IP2=JMOHEP(2,JDAHEP(1,IP))
  56          IF((IP2.NE.0).AND.(IP2.NE.IP)) THEN
  57            IDPHO(2)=IDHEP(IP2)
  58            JDAPHO(1,2)=3
  59            JDAPHO(2,2)=3+LAST-FIRST
  60            DO I=1,5
  61              PPHO(I,2)=PHEP(I,IP2)
  62            ENDDO
  63          ELSE
  64            IDPHO(2)=0
  65            DO I=1,5
  66              PPHO(I,2)=0.0D0
  67            ENDDO
  68          ENDIF
  69 C let's take in daughters
  70         DO LL=0,LAST-FIRST
  71            IDPHO(3+LL)=IDHEP(FIRST+LL)
  72            JMOPHO(1,3+LL)=JMOHEP(1,FIRST+LL)
  73            IF (JMOHEP(1,FIRST+LL).EQ.IP) JMOPHO(1,3+LL)=1
  74            DO I=1,5
  75              PPHO(I,3+LL)=PHEP(I,FIRST+LL)
  76            ENDDO
  77         ENDDO
  78         IF (NHEP.GT.NHEP0) THEN
  79 C let's take in illegitimate daughters
  80         NA=3+LAST-FIRST
  81         DO LL=1,NHEP-NHEP0
  82            IDPHO(NA+LL)=IDHEP(NHEP0+LL)
  83            JMOPHO(1,NA+LL)=JMOHEP(1,NHEP0+LL)
  84            IF (JMOHEP(1,NHEP0+LL).EQ.IP) JMOPHO(1,NA+LL)=1
  85            DO I=1,5
  86              PPHO(I,NA+LL)=PHEP(I,NHEP0+LL)
  87            ENDDO
  88         ENDDO
  89 C--        there is NHEP-NHEP0 daugters more.
  90            JDAPHO(2,1)=3+LAST-FIRST+NHEP-NHEP0
  91         ENDIF
  92         CALL PHLUPA(1)
  93         CALL PHCORK(0)
  94 C special case of t tbar production process
  95         IF(IFTOP) CALL PHOTWO(0)
  96         BOOST=.FALSE.
  97 C--   Check whether parent is in its rest frame...
  98       IF (     (ABS(PPHO(4,1)-PPHO(5,1)).GT.PPHO(5,1)*1.D-8)
  99      $    .AND.(PPHO(5,1).NE.0))                            THEN
 100         BOOST=.TRUE.
 101 C--
 102 C--   Boost daughter particles to rest frame of parent...
 103 C--   Resultant neutral system already calculated in rest frame !
 104         DO 10 J=1,3
 105    10   BET(J)=-PPHO(J,1)/PPHO(5,1)
 106         GAM=PPHO(4,1)/PPHO(5,1)
 107         DO 30 I=JDAPHO(1,1),JDAPHO(2,1)
 108           PB=BET(1)*PPHO(1,I)+BET(2)*PPHO(2,I)+BET(3)*PPHO(3,I)
 109           DO 20 J=1,3
 110    20     PPHO(J,I)=PPHO(J,I)+BET(J)*(PPHO(4,I)+PB/(GAM+1.D0))
 111    30   PPHO(4,I)=GAM*PPHO(4,I)+PB
 112 C--    Finally boost mother as well
 113           I=1
 114           PB=BET(1)*PPHO(1,I)+BET(2)*PPHO(2,I)+BET(3)*PPHO(3,I)
 115           DO J=1,3
 116             PPHO(J,I)=PPHO(J,I)+BET(J)*(PPHO(4,I)+PB/(GAM+1.D0))
 117           ENDDO
 118           PPHO(4,I)=GAM*PPHO(4,I)+PB
 119       ENDIF
 120 C special case of t tbar production process
 121         IF(IFTOP) CALL PHOTWO(1)
 122       CALL PHLUPA(2)
 123       END