]>
Commit | Line | Data |
---|---|---|
da0e9ce3 | 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 |