← Back to branch summary

~maddevelopers/mg5amcnlo/3.0.2-alpha0

« back to all changes in this revision

Viewing changes to HELAS/jgggxx.F

Added Template and HELAS into bzr

Show diffs side-by-side

added added

removed removed

Lines of Context:
HELAS/jgggxx.F
 
1
      subroutine jgggxx(w1,w2,w3,g, jw3w)
 
2
c
 
3
c This subroutine computes an off-shell W+, W-, W3, Z or photon current
 
4
c from the four-point gauge boson coupling, including the contributions
 
5
c of W exchange diagrams.  The vector propagator is given in Feynman
 
6
c gauge for a photon and in unitary gauge for W and Z bosons.  If one
 
7
c sets wmass=0.0, then the ggg-->g current is given (see sect 2.9.1 of
 
8
c the manual).
 
9
c
 
10
c input:
 
11
c       complex w1(6)          : first  vector                        w1
 
12
c       complex w2(6)          : second vector                        w2
 
13
c       complex w3(6)          : third  vector                        w3
 
14
c       real    g             : first  coupling constant
 
15
c                                                  (see the table below)
 
16
c
 
17
c output:
 
18
c       complex jw3w(6)        : W current             j^mu(w':w1,w2,w3)
 
19
c
 
20
      implicit none
 
21
      double complex w1(6),w2(6),w3(6),jw3w(6)
 
22
      double complex dw1(0:3),dw2(0:3),dw3(0:3)
 
23
      double complex jj(0:3),dv,w32,w13
 
24
      double precision p1(0:3),p2(0:3),p3(0:3),q(0:3),g,dg2,q2
 
25
 
 
26
      double precision rZero, rOne
 
27
      parameter( rZero = 0.0d0, rOne = 1.0d0 )
 
28
 
 
29
#ifdef HELAS_CHECK
 
30
      integer stdo
 
31
      parameter( stdo = 6 )
 
32
#endif
 
33
c
 
34
#ifdef HELAS_CHECK
 
35
      if ( abs(w1(1))+abs(w1(2))+abs(w1(3))+abs(w1(4)).eq.rZero ) then
 
36
         write(stdo,*) ' helas-warn  : w1 in jgggxx is zero vector'
 
37
      endif
 
38
      if ( abs(w1(5))+abs(w1(6)).eq.rZero ) then
 
39
         write(stdo,*)
 
40
     &        ' helas-error : w1 in jgggxx has zero momentum'
 
41
      endif
 
42
      if ( abs(w2(1))+abs(w2(2))+abs(w2(3))+abs(w2(4)).eq.rZero ) then
 
43
         write(stdo,*) ' helas-warn  : w2 in jgggxx is zero vector'
 
44
      endif
 
45
      if ( abs(w2(5))+abs(w2(6)).eq.rZero ) then
 
46
         write(stdo,*)
 
47
     &        ' helas-error : w2 in jgggxx has zero momentum'
 
48
      endif
 
49
      if ( abs(w3(1))+abs(w3(2))+abs(w3(3))+abs(w3(4)).eq.rZero ) then
 
50
         write(stdo,*) ' helas-warn  : w3 in jgggxx is zero vector'
 
51
      endif
 
52
      if ( abs(w3(5))+abs(w3(6)).eq.rZero ) then
 
53
         write(stdo,*)
 
54
     &        ' helas-error : w3 in jgggxx has zero momentum'
 
55
      endif 
 
56
      if ( g.eq.rZero ) then
 
57
         write(stdo,*) ' helas-error : g in jgggxx is zero coupling'
 
58
      endif
 
59
#endif
 
60
 
 
61
      jw3w(5) = w1(5)+w2(5)+w3(5)
 
62
      jw3w(6) = w1(6)+w2(6)+w3(6)
 
63
 
 
64
#ifdef HELAS_CHECK
 
65
      if ( abs(jw3w(5))+abs(jw3w(6)).eq.rZero ) then
 
66
         write(stdo,*)
 
67
     &        ' helas-error : jw3w in jw3wxx has zero momentum'
 
68
      endif
 
69
#endif
 
70
 
 
71
      dw1(0) = dcmplx(w1(1))
 
72
      dw1(1) = dcmplx(w1(2))
 
73
      dw1(2) = dcmplx(w1(3))
 
74
      dw1(3) = dcmplx(w1(4))
 
75
      dw2(0) = dcmplx(w2(1))
 
76
      dw2(1) = dcmplx(w2(2))
 
77
      dw2(2) = dcmplx(w2(3))
 
78
      dw2(3) = dcmplx(w2(4))
 
79
      dw3(0) = dcmplx(w3(1))
 
80
      dw3(1) = dcmplx(w3(2))
 
81
      dw3(2) = dcmplx(w3(3))
 
82
      dw3(3) = dcmplx(w3(4))
 
83
      p1(0) = dble(      w1(5))
 
84
      p1(1) = dble(      w1(6))
 
85
      p1(2) = dble(dimag(w1(6)))
 
86
      p1(3) = dble(dimag(w1(5)))
 
87
      p2(0) = dble(      w2(5))
 
88
      p2(1) = dble(      w2(6))
 
89
      p2(2) = dble(dimag(w2(6)))
 
90
      p2(3) = dble(dimag(w2(5)))
 
91
      p3(0) = dble(      w3(5))
 
92
      p3(1) = dble(      w3(6))
 
93
      p3(2) = dble(dimag(w3(6)))
 
94
      p3(3) = dble(dimag(w3(5)))
 
95
      q(0) = -(p1(0)+p2(0)+p3(0))
 
96
      q(1) = -(p1(1)+p2(1)+p3(1))
 
97
      q(2) = -(p1(2)+p2(2)+p3(2))
 
98
      q(3) = -(p1(3)+p2(3)+p3(3))
 
99
 
 
100
      q2 = q(0)**2 -(q(1)**2 +q(2)**2 +q(3)**2)
 
101
 
 
102
      dg2 = dble(g)*dble(g)
 
103
 
 
104
      dv = rOne/dcmplx( q2 )
 
105
 
 
106
      w32 = dw3(0)*dw2(0)-dw3(1)*dw2(1)-dw3(2)*dw2(2)-dw3(3)*dw2(3)
 
107
 
 
108
      w13 = dw1(0)*dw3(0)-dw1(1)*dw3(1)-dw1(2)*dw3(2)-dw1(3)*dw3(3)
 
109
 
 
110
      jj(0) = dg2*( dw1(0)*w32 - dw2(0)*w13 )
 
111
      jj(1) = dg2*( dw1(1)*w32 - dw2(1)*w13 )
 
112
      jj(2) = dg2*( dw1(2)*w32 - dw2(2)*w13 )
 
113
      jj(3) = dg2*( dw1(3)*w32 - dw2(3)*w13 )
 
114
 
 
115
      jw3w(1) = dcmplx( jj(0)*dv )
 
116
      jw3w(2) = dcmplx( jj(1)*dv )
 
117
      jw3w(3) = dcmplx( jj(2)*dv )
 
118
      jw3w(4) = dcmplx( jj(3)*dv )
 
119
c
 
120
      return
 
121
      end