1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
|
subroutine wwwwxx(wm1,wp1,wm2,wp2,gwwa,gwwz , vertex)
c
c This subroutine computes an amplitude of the four-point W-/W+ coupling.
c
c input:
c complex wm1(0:3) : first flow-out W- wm1
c complex wp1(0:3) : first flow-out W+ wp1
c complex wm2(0:3) : second flow-out W- wm2
c complex wp2(0:3) : second flow-out W+ wp2
c real gwwa : coupling constant of W and A gwwa
c real gwwz : coupling constant of W and Z gwwz
c real zmass : mass of Z
c real zwidth : width of Z
c
c output:
c complex vertex : amplitude gamma(wm1,wp1,wm2,wp2)
c
implicit none
double complex wm1(6),wp1(6),wm2(6),wp2(6),vertex
double complex dv1(0:3),dv2(0:3),dv3(0:3),dv4(0:3),dvertx
double complex v12,v13,v14,v23,v24,v34
double precision pwm1(0:3),pwp1(0:3),pwm2(0:3),pwp2(0:3)
double precision gwwa,gwwz
double precision rZero, rOne, rTwo
parameter( rZero = 0.0d0, rOne = 1.0d0, rTwo = 2.0d0 )
#ifdef HELAS_CHECK
double precision pm
double precision epsi
parameter( epsi = 2.0d-5 )
integer stdo
parameter( stdo = 6 )
#endif
c
pwm1(0) = dble( wm1(5))
pwm1(1) = dble( wm1(6))
pwm1(2) = dimag(wm1(6))
pwm1(3) = dimag(wm1(5))
pwp1(0) = dble( wp1(5))
pwp1(1) = dble( wp1(6))
pwp1(2) = dimag(wp1(6))
pwp1(3) = dimag(wp1(5))
pwm2(0) = dble( wm2(5))
pwm2(1) = dble( wm2(6))
pwm2(2) = dimag(wm2(6))
pwm2(3) = dimag(wm2(5))
pwp2(0) = dble( wp2(5))
pwp2(1) = dble( wp2(6))
pwp2(2) = dimag(wp2(6))
pwp2(3) = dimag(wp2(5))
#ifdef HELAS_CHECK
if ( abs(wm1(1))+abs(wm1(2))
& +abs(wm1(3))+abs(wm1(4)).eq.rZero ) then
write(stdo,*) ' helas-warn : wm1 in wwwwxx is zero vector'
endif
if ( abs(wm1(5))+abs(wm1(5)).eq.rZero ) then
write(stdo,*)
& ' helas-error : wm1 in wwwwxx has zero momentum'
endif
if ( abs(wp1(1))+abs(wp1(2))
& +abs(wp1(3))+abs(wp1(4)).eq.rZero ) then
write(stdo,*) ' helas-warn : wp1 in wwwwxx is zero vector'
endif
if ( abs(wp1(5))+abs(wp1(5)).eq.rZero ) then
write(stdo,*)
& ' helas-error : wp1 in wwwwxx has zero momentum'
endif
if ( abs(wm2(1))+abs(wm2(2))
& +abs(wm2(3))+abs(wm2(4)).eq.rZero ) then
write(stdo,*) ' helas-warn : wm2 in wwwwxx is zero vector'
endif
if ( abs(wm2(5))+abs(wm2(5)).eq.rZero ) then
write(stdo,*)
& ' helas-error : wm2 in wwwwxx has zero momentum'
endif
if ( abs(wp2(1))+abs(wp2(2))
& +abs(wp2(3))+abs(wp2(4)).eq.rZero ) then
write(stdo,*) ' helas-warn : wp2 in wwwwxx is zero vector'
endif
if ( abs(wp2(5))+abs(wp2(5)).eq.rZero ) then
write(stdo,*)
& ' helas-error : wp2 in wwwwxx has zero momentum'
endif
pm = max( abs(pwm1(0)),abs(pwp1(0)),abs(pwm2(0)),abs(pwp2(0)),
& abs(pwm1(1)),abs(pwp1(1)),abs(pwm2(1)),abs(pwp2(1)),
& abs(pwm1(2)),abs(pwp1(2)),abs(pwm2(2)),abs(pwp2(2)),
& abs(pwm1(3)),abs(pwp1(3)),abs(pwm2(3)),abs(pwp2(3)) )
if ( abs(wm1(5)+wp1(5)+wm2(5)+wp2(5))
& +abs(wm1(6)+wp1(6)+wm2(6)+wp2(6)).ge.pm*epsi ) then
write(stdo,*)
& ' helas-error : wm1,wp1,wm2,wp2 in wwwwxx'
write(stdo,*)
& ' : have not balanced momenta'
endif
if ( gwwa.eq.rZero ) then
write(stdo,*) ' helas-error : gwwa in wwwwxx is zero coupling'
endif
if ( gwwz.eq.rZero ) then
write(stdo,*)
& ' helas-error : gwwz in wwwwxx is zero coupling'
endif
if ( gwwa.lt.rZero .or. gwwa.ge.gwwz ) then
write(stdo,*)
& ' helas-warn : gwwa/gwwz in wwwwxx are non-standard couplings'
write(stdo,*)
& ' : gwwa = ',gwwa,' gwwz = ',gwwz
endif
#endif
dv1(0) = dcmplx(wm1(1))
dv1(1) = dcmplx(wm1(2))
dv1(2) = dcmplx(wm1(3))
dv1(3) = dcmplx(wm1(4))
dv2(0) = dcmplx(wp1(1))
dv2(1) = dcmplx(wp1(2))
dv2(2) = dcmplx(wp1(3))
dv2(3) = dcmplx(wp1(4))
dv3(0) = dcmplx(wm2(1))
dv3(1) = dcmplx(wm2(2))
dv3(2) = dcmplx(wm2(3))
dv3(3) = dcmplx(wm2(4))
dv4(0) = dcmplx(wp2(1))
dv4(1) = dcmplx(wp2(2))
dv4(2) = dcmplx(wp2(3))
dv4(3) = dcmplx(wp2(4))
v12 = dv1(0)*dv2(0)-dv1(1)*dv2(1)-dv1(2)*dv2(2)-dv1(3)*dv2(3)
v13 = dv1(0)*dv3(0)-dv1(1)*dv3(1)-dv1(2)*dv3(2)-dv1(3)*dv3(3)
v14 = dv1(0)*dv4(0)-dv1(1)*dv4(1)-dv1(2)*dv4(2)-dv1(3)*dv4(3)
v23 = dv2(0)*dv3(0)-dv2(1)*dv3(1)-dv2(2)*dv3(2)-dv2(3)*dv3(3)
v24 = dv2(0)*dv4(0)-dv2(1)*dv4(1)-dv2(2)*dv4(2)-dv2(3)*dv4(3)
v34 = dv3(0)*dv4(0)-dv3(1)*dv4(1)-dv3(2)*dv4(2)-dv3(3)*dv4(3)
dvertx = (v12*v34 + v14*v23 - rTwo*v13*v24)*(gwwa**2+gwwz**2)
vertex = -dcmplx( dvertx )
c
return
end
|