~maddevelopers/mg5amcnlo/3.0.2-alpha0

« back to all changes in this revision

Viewing changes to HELAS/jssxxx.F

Added Template and HELAS into bzr

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
      subroutine jssxxx(s1,s2,gc,vmass,vwidth , jss)
 
2
c
 
3
c This subroutine computes an off-shell vector current from the vector-
 
4
c scalar-scalar coupling.  The coupling is absent in the minimal SM in
 
5
c unitary gauge.  The propagator is given in Feynman gauge for a
 
6
c massless vector and in unitary gauge for a massive vector.
 
7
c
 
8
c input:
 
9
c       complex s1(3)          : first  scalar                        s1
 
10
c       complex s2(3)          : second scalar                        s2
 
11
c       complex gc             : coupling constant (s1 charge)
 
12
c       real    vmass          : mass  of output vector v
 
13
c       real    vwidth         : width of output vector v
 
14
c
 
15
c examples of the coupling constant g for susy particles are as follows:
 
16
c   -----------------------------------------------------------
 
17
c   |    s1    | (q,i3) of s1  ||   v=A   |   v=Z   |   v=W   |
 
18
c   -----------------------------------------------------------
 
19
c   | nu~_l    | (  0  , +1/2) ||   ---   |  gzn(1) |  gwf(1) |
 
20
c   | e~_l     | ( -1  , -1/2) ||  gal(1) |  gzl(1) |  gwf(1) |
 
21
c   | u~_l     | (+2/3 , +1/2) ||  gau(1) |  gzu(1) |  gwf(1) |
 
22
c   | d~_l     | (-1/3 , -1/2) ||  gad(1) |  gzd(1) |  gwf(1) |
 
23
c   -----------------------------------------------------------
 
24
c   | e~_r-bar | ( +1  ,  0  ) || -gal(2) | -gzl(2) | -gwf(2) |
 
25
c   | u~_r-bar | (-2/3 ,  0  ) || -gau(2) | -gzu(2) | -gwf(2) |
 
26
c   | d~_r-bar | (+1/3 ,  0  ) || -gad(2) | -gzd(2) | -gwf(2) |
 
27
c   -----------------------------------------------------------
 
28
c where the s1 charge is defined by the flowing-OUT quantum number.
 
29
c
 
30
c output:
 
31
c       complex jss(6)         : vector current            j^mu(v:s1,s2)
 
32
c     
 
33
      implicit none
 
34
      double complex s1(3),s2(3),gc,jss(6),dg,adg
 
35
      double complex cm2        ! mass**2- I Gamma mass (Fabio)
 
36
      double precision pp(0:3),pa(0:3),q(0:3),vmass,vwidth
 
37
      double precision q2,vm2,mp2,ma2,m2d
 
38
 
 
39
      double precision rZero
 
40
      parameter( rZero = 0.0d0 )
 
41
 
 
42
#ifdef HELAS_CHECK
 
43
      double complex cZero
 
44
      parameter( cZero = ( 0.0d0, 0.0d0 ) )
 
45
      integer stdo
 
46
      parameter( stdo = 6 )
 
47
#endif
 
48
c
 
49
#ifdef HELAS_CHECK
 
50
      if ( s1(1).eq.cZero ) then
 
51
         write(stdo,*) ' helas-warn  : s1 in jssxxx is zero scalar'
 
52
      endif
 
53
      if ( abs(s1(2))+abs(s1(3)).eq.rZero ) then
 
54
         write(stdo,*)
 
55
     &        ' helas-error : s1 in jssxxx has zero momentum'
 
56
      endif
 
57
      if ( abs(s2(1)).eq.rZero ) then
 
58
         write(stdo,*) ' helas-warn  : s2 in jssxxx is zero scalar'
 
59
      endif
 
60
      if ( abs(s2(2))+abs(s2(3)).eq.rZero ) then
 
61
         write(stdo,*)
 
62
     &        ' helas-error : s2 in jssxxx has zero momentum'
 
63
      endif
 
64
      if ( gc.eq.cZero ) then
 
65
         write(stdo,*) ' helas-error : gc in jssxxx is zero coupling'
 
66
      endif
 
67
      if ( vmass.lt.rZero ) then
 
68
         write(stdo,*) ' helas-error : vmass in jssxxx is negative'
 
69
         write(stdo,*) '             : vmass = ',vmass
 
70
      endif
 
71
      if ( vwidth.lt.rZero ) then
 
72
         write(stdo,*) ' helas-error : vwidth in jssxxx is negative'
 
73
         write(stdo,*) '             : vwidth = ',vwidth
 
74
      endif
 
75
#endif
 
76
 
 
77
      jss(5) = s1(2)+s2(2)
 
78
      jss(6) = s1(3)+s2(3)
 
79
 
 
80
      q(0) = dble( jss(5))
 
81
      q(1) = dble( jss(6))
 
82
      q(2) = dimag(jss(6))
 
83
      q(3) = dimag(jss(5))
 
84
      q2 = q(0)**2-(q(1)**2+q(2)**2+q(3)**2)
 
85
      vm2 = vmass**2
 
86
 
 
87
#ifdef HELAS_CHECK
 
88
      if ( abs(jss(5))+abs(jss(6)).eq.rZero ) then
 
89
         write(stdo,*)
 
90
     &        ' helas-error : jss in jssxxx has zero momentum'
 
91
      endif
 
92
      if ( vwidth.eq.rZero .and. q2.eq.vm2 ) then
 
93
         write(stdo,*)
 
94
     &        ' helas-error : jss in jssxxx is on vmass pole'
 
95
         write(stdo,*)
 
96
     &        '             : q     = ',q(0),q(1),q(2),q(3)
 
97
         write(stdo,*) 
 
98
     &        '             : abs(q)= ',sqrt(abs(q2))
 
99
         jss(1) = cZero
 
100
         jss(2) = cZero
 
101
         jss(3) = cZero
 
102
         jss(4) = cZero
 
103
         return
 
104
      endif
 
105
#endif
 
106
 
 
107
      if ( vmass.ne.rZero ) then
 
108
 
 
109
         dg = gc/dcmplx( q2-vm2, vmass*vwidth )
 
110
c  For the running width, use below instead of the above dg.
 
111
c         dg = g/dcmplx( q2-vm2, max(vwidth*q2/vmass,rZero) )
 
112
 
 
113
 
 
114
         adg = dg*s1(1)*s2(1)
 
115
 
 
116
         pp(0) = dble( s1(2))
 
117
         pp(1) = dble( s1(3))
 
118
         pp(2) = dimag(s1(3))
 
119
         pp(3) = dimag(s1(2))
 
120
         pa(0) = dble( s2(2))
 
121
         pa(1) = dble( s2(3))
 
122
         pa(2) = dimag(s2(3))
 
123
         pa(3) = dimag(s2(2))
 
124
         mp2 = pp(0)**2-(pp(1)**2+pp(2)**2+pp(3)**2)
 
125
         ma2 = pa(0)**2-(pa(1)**2+pa(2)**2+pa(3)**2)
 
126
         m2d = mp2-ma2
 
127
 
 
128
c     Fabio's implementation of the fixed width
 
129
         cm2=dcmplx( vm2, -vmass*vwidth )
 
130
c     jss(1) = adg*( (pp(0)-pa(0)) - q(0)*m2d/vm2)
 
131
c     jss(2) = adg*( (pp(1)-pa(1)) - q(1)*m2d/vm2)
 
132
c     jss(3) = adg*( (pp(2)-pa(2)) - q(2)*m2d/vm2)
 
133
c     jss(4) = adg*( (pp(3)-pa(3)) - q(3)*m2d/vm2)
 
134
         jss(1) = adg*( (pp(0)-pa(0)) - q(0)*m2d/cm2)
 
135
         jss(2) = adg*( (pp(1)-pa(1)) - q(1)*m2d/cm2)
 
136
         jss(3) = adg*( (pp(2)-pa(2)) - q(2)*m2d/cm2)
 
137
         jss(4) = adg*( (pp(3)-pa(3)) - q(3)*m2d/cm2)
 
138
 
 
139
      else
 
140
 
 
141
         adg = gc*s1(1)*s2(1)/q2
 
142
 
 
143
         jss(1) = adg*dble( s1(2)-s2(2))
 
144
         jss(2) = adg*dble( s1(3)-s2(3))
 
145
         jss(3) = adg*dimag(s1(3)-s2(3))
 
146
         jss(4) = adg*dimag(s1(2)-s2(2))
 
147
 
 
148
      endif
 
149
c
 
150
      return
 
151
      end