[u/mrichter/AliRoot.git] / TEvtGen / PHOTOS / phoin.F

      SUBROUTINE PHOIN(IP,BOOST,NHEP0)
C.----------------------------------------------------------------------
C.
C.    PHOIN:   PHOtos INput
C.
C.    Purpose:  copies IP branch of the common /PH_HEPEVT/ into /PHOEVT/
C.              moves branch into its CMS system.
C.
C.    Input Parameters:       IP:  pointer of particle starting branch
C.                                 to be copied
C.                        BOOST:   Flag whether boost to CMS was or was 
C     .                            not performed.
C.
C.    Output Parameters:  Commons: /PHOEVT/, /PHOCMS/
C.
C.    Author(s):  Z. Was                          Created at:  24/05/93
C.                                                Last Update: 16/11/93
C.
C.----------------------------------------------------------------------
      IMPLICIT NONE
      INTEGER NMXHEP
      PARAMETER (NMXHEP=10000)
      INTEGER IDHEP,ISTHEP,JDAHEP,JMOHEP,NEVHEP,NHEP
      REAL*8 PHEP,VHEP
      COMMON/PH_HEPEVT/NEVHEP,NHEP,ISTHEP(NMXHEP),IDHEP(NMXHEP),
     &JMOHEP(2,NMXHEP),JDAHEP(2,NMXHEP),PHEP(5,NMXHEP),VHEP(4,NMXHEP)
      INTEGER NMXPHO
      PARAMETER (NMXPHO=10000)
      INTEGER IDPHO,ISTPHO,JDAPHO,JMOPHO,NEVPHO,NPHO
      REAL*8 PPHO,VPHO
      COMMON/PHOEVT/NEVPHO,NPHO,ISTPHO(NMXPHO),IDPHO(NMXPHO),
     &JMOPHO(2,NMXPHO),JDAPHO(2,NMXPHO),PPHO(5,NMXPHO),VPHO(4,NMXPHO)
      INTEGER IP,IP2,I,FIRST,LAST,LL,NA
      LOGICAL BOOST
      INTEGER J,NHEP0
      DOUBLE PRECISION BET(3),GAM,PB
      COMMON /PHOCMS/ BET,GAM
      LOGICAL INTERF,ISEC,IFTOP
      REAL*8 FINT,FSEC
      COMMON /PHOKEY/ FSEC,FINT,INTERF,ISEC,IFTOP
C--
C let's calculate size of the little common entry
        FIRST=JDAHEP(1,IP)
        LAST =JDAHEP(2,IP)
        NPHO=3+LAST-FIRST+NHEP-NHEP0
        NEVPHO=NPHO
C let's take in decaying particle
           IDPHO(1)=IDHEP(IP)
           JDAPHO(1,1)=3
           JDAPHO(2,1)=3+LAST-FIRST
           DO I=1,5
             PPHO(I,1)=PHEP(I,IP)
           ENDDO
C let's take in eventual second mother
         IP2=JMOHEP(2,JDAHEP(1,IP))
         IF((IP2.NE.0).AND.(IP2.NE.IP)) THEN 
           IDPHO(2)=IDHEP(IP2)
           JDAPHO(1,2)=3
           JDAPHO(2,2)=3+LAST-FIRST
           DO I=1,5
             PPHO(I,2)=PHEP(I,IP2)
           ENDDO
         ELSE
           IDPHO(2)=0
           DO I=1,5
             PPHO(I,2)=0.0D0
           ENDDO
         ENDIF
C let's take in daughters
        DO LL=0,LAST-FIRST
           IDPHO(3+LL)=IDHEP(FIRST+LL)
           JMOPHO(1,3+LL)=JMOHEP(1,FIRST+LL)
           IF (JMOHEP(1,FIRST+LL).EQ.IP) JMOPHO(1,3+LL)=1
           DO I=1,5
             PPHO(I,3+LL)=PHEP(I,FIRST+LL)
           ENDDO
        ENDDO
        IF (NHEP.GT.NHEP0) THEN
C let's take in illegitimate daughters
        NA=3+LAST-FIRST 
        DO LL=1,NHEP-NHEP0
           IDPHO(NA+LL)=IDHEP(NHEP0+LL)
           JMOPHO(1,NA+LL)=JMOHEP(1,NHEP0+LL)
           IF (JMOHEP(1,NHEP0+LL).EQ.IP) JMOPHO(1,NA+LL)=1
           DO I=1,5
             PPHO(I,NA+LL)=PHEP(I,NHEP0+LL)
           ENDDO
        ENDDO
C--        there is NHEP-NHEP0 daugters more.
           JDAPHO(2,1)=3+LAST-FIRST+NHEP-NHEP0
        ENDIF
        CALL PHLUPA(1)
        CALL PHCORK(0)
C special case of t tbar production process
        IF(IFTOP) CALL PHOTWO(0)
        BOOST=.FALSE.
C--   Check whether parent is in its rest frame...
      IF (     (ABS(PPHO(4,1)-PPHO(5,1)).GT.PPHO(5,1)*1.D-8)
     $    .AND.(PPHO(5,1).NE.0))                            THEN
        BOOST=.TRUE.
C--
C--   Boost daughter particles to rest frame of parent...
C--   Resultant neutral system already calculated in rest frame !
        DO 10 J=1,3
   10   BET(J)=-PPHO(J,1)/PPHO(5,1)
        GAM=PPHO(4,1)/PPHO(5,1)
        DO 30 I=JDAPHO(1,1),JDAPHO(2,1)
          PB=BET(1)*PPHO(1,I)+BET(2)*PPHO(2,I)+BET(3)*PPHO(3,I)
          DO 20 J=1,3
   20     PPHO(J,I)=PPHO(J,I)+BET(J)*(PPHO(4,I)+PB/(GAM+1.D0))
   30   PPHO(4,I)=GAM*PPHO(4,I)+PB
C--    Finally boost mother as well
          I=1   
          PB=BET(1)*PPHO(1,I)+BET(2)*PPHO(2,I)+BET(3)*PPHO(3,I)
          DO J=1,3
            PPHO(J,I)=PPHO(J,I)+BET(J)*(PPHO(4,I)+PB/(GAM+1.D0))
          ENDDO
          PPHO(4,I)=GAM*PPHO(4,I)+PB
      ENDIF
C special case of t tbar production process
        IF(IFTOP) CALL PHOTWO(1)
      CALL PHLUPA(2)
      END
Commit	Line	Data
da0e9ce3	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