]>
Commit | Line | Data |
---|---|---|
da0e9ce3 | 1 | SUBROUTINE PHOBOS(IP,PBOOS1,PBOOS2,FIRST,LAST) |
2 | C.---------------------------------------------------------------------- | |
3 | C. | |
4 | C. PHOBOS: PHOton radiation in decays BOoSt routine | |
5 | C. | |
6 | C. Purpose: Boost particles in cascade decay to parent rest frame | |
7 | C. and boost back with modified boost vector. | |
8 | C. | |
9 | C. Input Parameters: IP: pointer of particle starting chain | |
10 | C. to be boosted | |
11 | C. PBOOS1: Boost vector to rest frame, | |
12 | C. PBOOS2: Boost vector to modified frame, | |
13 | C. FIRST: Pointer to first particle to be boos- | |
14 | C. ted (/PH_HEPEVT/), | |
15 | C. LAST: Pointer to last particle to be boos- | |
16 | C. ted (/PH_HEPEVT/). | |
17 | C. | |
18 | C. Output Parameters: Common /PH_HEPEVT/. | |
19 | C. | |
20 | C. Author(s): B. van Eijk Created at: 13/02/90 | |
21 | C. Z. Was Last Update: 16/11/93 | |
22 | C. | |
23 | C.---------------------------------------------------------------------- | |
24 | IMPLICIT NONE | |
25 | DOUBLE PRECISION BET1(3),BET2(3),GAM1,GAM2,PB,DATA | |
26 | INTEGER I,J,FIRST,LAST,MAXSTA,NSTACK,IP | |
27 | PARAMETER (MAXSTA=10000) | |
28 | INTEGER STACK(MAXSTA) | |
29 | REAL*8 PBOOS1(5),PBOOS2(5) | |
30 | INTEGER NMXHEP | |
31 | PARAMETER (NMXHEP=10000) | |
32 | INTEGER IDHEP,ISTHEP,JDAHEP,JMOHEP,NEVHEP,NHEP | |
33 | REAL*8 PHEP,VHEP | |
34 | COMMON/PH_HEPEVT/NEVHEP,NHEP,ISTHEP(NMXHEP),IDHEP(NMXHEP), | |
35 | &JMOHEP(2,NMXHEP),JDAHEP(2,NMXHEP),PHEP(5,NMXHEP),VHEP(4,NMXHEP) | |
36 | IF ((LAST.EQ.0).OR.(LAST.LT.FIRST)) RETURN | |
37 | NSTACK=0 | |
38 | DO 10 J=1,3 | |
39 | BET1(J)=-PBOOS1(J)/PBOOS1(5) | |
40 | 10 BET2(J)=PBOOS2(J)/PBOOS2(5) | |
41 | GAM1=PBOOS1(4)/PBOOS1(5) | |
42 | GAM2=PBOOS2(4)/PBOOS2(5) | |
43 | C-- | |
44 | C-- Boost vector to parent rest frame... | |
45 | 20 DO 50 I=FIRST,LAST | |
46 | PB=BET1(1)*PHEP(1,I)+BET1(2)*PHEP(2,I)+BET1(3)*PHEP(3,I) | |
47 | IF (JMOHEP(1,I).EQ.IP) THEN | |
48 | DO 30 J=1,3 | |
49 | 30 PHEP(J,I)=PHEP(J,I)+BET1(J)*(PHEP(4,I)+PB/(GAM1+1.D0)) | |
50 | PHEP(4,I)=GAM1*PHEP(4,I)+PB | |
51 | C-- | |
52 | C-- ...and boost back to modified parent frame. | |
53 | PB=BET2(1)*PHEP(1,I)+BET2(2)*PHEP(2,I)+BET2(3)*PHEP(3,I) | |
54 | DO 40 J=1,3 | |
55 | 40 PHEP(J,I)=PHEP(J,I)+BET2(J)*(PHEP(4,I)+PB/(GAM2+1.D0)) | |
56 | PHEP(4,I)=GAM2*PHEP(4,I)+PB | |
57 | IF (JDAHEP(1,I).NE.0) THEN | |
58 | NSTACK=NSTACK+1 | |
59 | C-- | |
60 | C-- Check on stack length... | |
61 | IF (NSTACK.GT.MAXSTA) THEN | |
62 | DATA=NSTACK | |
63 | CALL PHOERR(7,'PHOBOS',DATA) | |
64 | ENDIF | |
65 | STACK(NSTACK)=I | |
66 | ENDIF | |
67 | ENDIF | |
68 | 50 CONTINUE | |
69 | IF (NSTACK.NE.0) THEN | |
70 | C-- | |
71 | C-- Now go one step further in the decay tree... | |
72 | FIRST=JDAHEP(1,STACK(NSTACK)) | |
73 | LAST=JDAHEP(2,STACK(NSTACK)) | |
74 | IP=STACK(NSTACK) | |
75 | NSTACK=NSTACK-1 | |
76 | GOTO 20 | |
77 | ENDIF | |
78 | RETURN | |
79 | END |