]>
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 |