More volume overlaps corrected
[u/mrichter/AliRoot.git] / ISAJET / code / decss3.F
CommitLineData
0795afa3 1#include "isajet/pilot.h"
2 FUNCTION DECSS3(IP,MEA)
3C
4C Compute matrix element for mode MEA of particle IP using
5C poles and couplings in /DKYSS3/.
6C Auxiliary routine for DECAY.
7C
8#if defined(CERNLIB_IMPNONE)
9 IMPLICIT NONE
10#endif
11C
12#include "isajet/itapes.inc"
13#include "isajet/partcl.inc"
14#include "isajet/const.inc"
15#include "isajet/dkyss3.inc"
16C
17 LOGICAL KIN(4),KINP(4)
18 INTEGER IP,MEA,I,J,JP,II,PTYPE1,PTYPE2
19 REAL DECSS3
20 REAL AM0SQ,AM1SQ,AM2SQ,AM3SQ,S12,S13,S23
21 REAL D12,D13,D23,D01,D02,D03,AS,BS,CS,DS,MSQ
22 REAL DOT4
23 COMPLEX A,B,C,D,AC,BC,CC,DC,AP,BP,CP,DP,APC,BPC,CPC,DPC,MMPD
24C
25 DOT4(I,J)=PPTCL(4,I)*PPTCL(4,J)-PPTCL(1,I)*PPTCL(1,J)-
26 $PPTCL(2,I)*PPTCL(2,J)-PPTCL(3,I)*PPTCL(3,J)
27C
28C Kinematics
29C
30 AM0SQ=PPTCL(5,IP)**2
31 AM1SQ=PPTCL(5,NPTCL+1)**2
32 AM2SQ=PPTCL(5,NPTCL+2)**2
33 AM3SQ=PPTCL(5,NPTCL+3)**2
34 D12=DOT4(NPTCL+1,NPTCL+2)
35 D13=DOT4(NPTCL+1,NPTCL+3)
36 D23=DOT4(NPTCL+2,NPTCL+3)
37 D01=DOT4(IP,NPTCL+1)
38 D02=DOT4(IP,NPTCL+2)
39 D03=DOT4(IP,NPTCL+3)
40 S12=2*D12+AM1SQ+AM2SQ
41 S13=2*D13+AM1SQ+AM3SQ
42 S23=2*D23+AM2SQ+AM3SQ
43C
44C Generic matrix element
45C
46C Loop over diagrams
47 DECSS3=0.
48 DO J=J1SS3(MEA),J2SS3(MEA)
49 PTYPE1=KSS3(J)
50 A=ZISS3(1,J)
51 B=ZISS3(2,J)
52 C=ZFSS3(1,J)
53 D=ZFSS3(2,J)
54 AC=CONJG(A)
55 BC=CONJG(B)
56 CC=CONJG(C)
57 DC=CONJG(D)
58 AS=A*AC
59 BS=B*BC
60 CS=C*CC
61 DS=D*DC
62 DO JP=J,J2SS3(MEA)
63 MSQ=0.
64 DO II=1,4
65 KIN(II)=.FALSE.
66 KINP(II)=.FALSE.
67 END DO
68 IF ((PPTCL(5,IP)-PPTCL(5,NPTCL+1)).LT.AMSS3(J)) KIN(1)=.TRUE.
69 IF ((PPTCL(5,IP)-PPTCL(5,NPTCL+3)).LT.AMSS3(J)) KIN(2)=.TRUE.
70 IF ((PPTCL(5,IP)-PPTCL(5,NPTCL+2)).LT.AMSS3(J)) KIN(3)=.TRUE.
71 IF ((PPTCL(5,IP)-PPTCL(5,NPTCL+1)).LT.AMSS3(J)) KIN(4)=.TRUE.
72 IF ((PPTCL(5,IP)-PPTCL(5,NPTCL+1)).LT.AMSS3(JP)) KINP(1)=.TRUE.
73 IF ((PPTCL(5,IP)-PPTCL(5,NPTCL+3)).LT.AMSS3(JP)) KINP(2)=.TRUE.
74 IF ((PPTCL(5,IP)-PPTCL(5,NPTCL+2)).LT.AMSS3(JP)) KINP(3)=.TRUE.
75 IF ((PPTCL(5,IP)-PPTCL(5,NPTCL+1)).LT.AMSS3(JP)) KINP(4)=.TRUE.
76 IF (J.EQ.JP) THEN
77 IF (PTYPE1.EQ.1.AND.KIN(1)) THEN
78 MSQ=32*(((AS+BS)*(CS+DS)+4*REAL(A*BC*C*DC))*D03*D12+
79 $ ((AS+BS)*(CS+DS)-4*REAL(A*BC*C*DC))*D02*D13+
80 $ (BS-AS)*(CS+DS)*SQRT(AM0SQ*AM1SQ)*D23)/
81 $ (S23-AMSS3(J)**2)**2
82 ELSE IF (PTYPE1.EQ.2.AND.KIN(2)) THEN
83 MSQ=16*(AS+BS)*(CS+DS)*D03*D12/(S12-AMSS3(J)**2)**2
84 ELSE IF (PTYPE1.EQ.3.AND.KIN(3)) THEN
85 MSQ=16*(AS+BS)*(CS+DS)*D02*D13/(S13-AMSS3(J)**2)**2
86 ELSE IF (PTYPE1.EQ.4.AND.KIN(4)) THEN
87 MSQ=16*((AS+BS)*(CS+DS)*D01*D23+(AS-BS)*(CS+DS)*D23*
88 $ SQRT(AM0SQ*AM1SQ))/(S23-AMSS3(J)**2)**2
89 END IF
90 END IF
91 IF (J.NE.JP) THEN
92 PTYPE2=KSS3(JP)
93 AP=ZISS3(1,JP)
94 BP=ZISS3(2,JP)
95 CP=ZFSS3(1,JP)
96 DP=ZFSS3(2,JP)
97 APC=CONJG(AP)
98 BPC=CONJG(BP)
99 CPC=CONJG(CP)
100 DPC=CONJG(DP)
101 IF (PTYPE1.EQ.2.AND.PTYPE2.EQ.2.AND.KIN(2).AND.KINP(2)) THEN
102 MMPD=16*D12*D03*(A*APC+B*BPC)*(C*CPC+D*DPC)/
103 $ (S12-AMSS3(J)**2)/(S12-AMSS3(JP)**2)
104 MSQ=2*REAL(MMPD)
105 END IF
106 IF (PTYPE1.EQ.3.AND.PTYPE2.EQ.3.AND.KIN(3).AND.KINP(3)) THEN
107 MMPD=16*D13*D02*(A*APC+B*BPC)*(C*CPC+D*DPC)/
108 $ (S13-AMSS3(J)**2)/(S13-AMSS3(JP)**2)
109 MSQ=2*REAL(MMPD)
110 END IF
111 IF (PTYPE1.EQ.4.AND.PTYPE2.EQ.4.AND.KIN(4).AND.KINP(4)) THEN
112 MMPD=16*D23*(D01*(A*APC+B*BPC)*(C*CPC+D*DPC)+
113 $ SQRT(AM0SQ*AM1SQ)*(A*APC-B*BPC)*(C*CPC-D*DPC))/
114 $ (S23-AMSS3(J)**2)/(S23-AMSS3(JP)**2)
115 MSQ=2*REAL(MMPD)
116 END IF
117 IF (PTYPE1.EQ.1.AND.PTYPE2.EQ.3.AND.KIN(1).AND.KINP(3)) THEN
118 MMPD=(16*D13*D02*((A*C-B*D)*(-APC*CPC+BPC*DPC)+
119 $ (A*D-B*C)*(APC*DPC-BPC*CPC))+
120 $ 8*D23*SQRT(AM0SQ*AM1SQ)*((A*C+B*D)*(APC*CPC-BPC*DPC)-
121 $ (A*D+B*C)*(APC*DPC-BPC*CPC)))/
122 $ (S23-AMSS3(J)**2)/(S13-AMSS3(JP)**2)
123 MSQ=2*REAL(MMPD)
124 END IF
125 IF (PTYPE1.EQ.1.AND.PTYPE2.EQ.2.AND.KIN(1).AND.KINP(2)) THEN
126 MMPD=(16*D12*D03*((A*C+B*D)*(-APC*CPC+BPC*DPC)+
127 $ (A*D+B*C)*(APC*DPC-BPC*CPC))+
128 $ 8*D23*SQRT(AM0SQ*AM1SQ)*((A*C-B*D)*(APC*CPC-BPC*DPC)+
129 $ (-A*D+B*C)*(APC*DPC+BPC*CPC)))/
130 $ (S23-AMSS3(J)**2)/(S12-AMSS3(JP)**2)
131 MSQ=2*REAL(MMPD)
132 END IF
133 IF (PTYPE1.EQ.3.AND.PTYPE2.EQ.4.AND.KIN(3).AND.KINP(4)) THEN
134 MMPD=((8*D13*D23+4*D23*AM1SQ)*((A*C+B*D)*(APC*CPC+BPC*DPC)+
135 $ (A*D+B*C)*(APC*DPC+BPC*CPC))+
136 $ 4*D23*SQRT(AM0SQ*AM1SQ)*((A*C+B*D)*(APC*CPC-BPC*DPC)+
137 $ (A*D+B*C)*(APC*DPC-BPC*CPC)))/
138 $ (S13-AMSS3(J)**2)/(S23-AMSS3(JP)**2)
139 MSQ=2*REAL(MMPD)
140 END IF
141 IF (PTYPE1.EQ.2.AND.PTYPE2.EQ.4.AND.KIN(2).AND.KINP(4)) THEN
142 MMPD=-((8*D12*D23+4*D23*AM1SQ)*((A*C+B*D)*(APC*CPC+BPC*DPC)+
143 $ (A*D+B*C)*(APC*DPC+BPC*CPC))+
144 $ 4*D23*SQRT(AM0SQ*AM1SQ)*((A*C+B*D)*(APC*CPC-BPC*DPC)+
145 $ (A*D+B*C)*(APC*DPC-BPC*CPC)))/
146 $ (S12-AMSS3(J)**2)/(S23-AMSS3(JP)**2)
147 MSQ=2*REAL(MMPD)
148 END IF
149 IF (PTYPE1.EQ.2.AND.PTYPE2.EQ.3.AND.KIN(2).AND.KINP(3)) THEN
150 MMPD=((8*D12*D13-4*D23*AM1SQ)*((A*C+B*D)*(APC*CPC+BPC*DPC)+
151 $ (A*D+B*C)*(APC*DPC+BPC*CPC))-
152 $ 4*D23*SQRT(AM0SQ*AM1SQ)*((A*C-B*D)*(APC*CPC-BPC*DPC)+
153 $ (A*D-B*C)*(APC*DPC-BPC*CPC)))/
154 $ (S12-AMSS3(J)**2)/(S13-AMSS3(JP)**2)
155 MSQ=2*REAL(MMPD)
156 END IF
157 END IF
158 DECSS3=DECSS3+MSQ
159 END DO
160 END DO
161C
162 RETURN
163 END