50.9.3
by Johan Alwall
Added Template and HELAS into bzr |
1 |
subroutine jvsshx(vc,sc1,sc2,g1,xm,xw , jvs) |
2 |
c
|
|
3 |
c- by RF - Mar. 2006
|
|
4 |
c
|
|
5 |
c
|
|
6 |
c This subroutine computes an off-shell vector current from the vector-
|
|
7 |
c vector-Higgs-Higgs effective coupling.
|
|
8 |
c
|
|
9 |
implicit none |
|
10 |
c-- dimension of the current set to arbitrary length
|
|
171.1.12
by mattelaer-olivier
remove all include in HELAS routine (g77 compatibility) |
11 |
INTEGER DIM |
12 |
PARAMETER(DIM=18) |
|
13 |
c include "dimension.inc"
|
|
50.9.3
by Johan Alwall
Added Template and HELAS into bzr |
14 |
double complex vc(DIM),sc1(DIM),sc2(DIM),jvs(DIM) |
15 |
double complex jvs1(DIM),jvs2(DIM),dg,qvc |
|
16 |
double precision qp1,p12,p13,p14,p23,p24,p34 |
|
17 |
double precision p1(4),q(4),xm,xw,q2,vm2 |
|
18 |
double complex g1(2) |
|
19 |
||
20 |
jvs(5) = vc(5)+sc1(2)+sc2(2) |
|
21 |
jvs(6) = vc(6)+sc1(3)+sc2(3) |
|
22 |
||
23 |
p1(1) = dble( vc(5)) |
|
24 |
p1(2) = dble( vc(6)) |
|
25 |
p1(3) = dimag(vc(6)) |
|
26 |
p1(4) = dimag(vc(5)) |
|
27 |
||
28 |
q(1) = -dble( jvs(5)) |
|
29 |
q(2) = -dble( jvs(6)) |
|
30 |
q(3) = -dimag(jvs(6)) |
|
31 |
q(4) = -dimag(jvs(5)) |
|
32 |
||
33 |
q2 = q(1)**2 - q(2)**2 - q(3)**2 - q(4)**2 |
|
34 |
||
35 |
jvs1(1) = (0D0,0D0) |
|
36 |
jvs1(2) = (0D0,0D0) |
|
37 |
jvs1(3) = (0D0,0D0) |
|
38 |
jvs1(4) = (0D0,0D0) |
|
39 |
jvs2(1) = (0D0,0D0) |
|
40 |
jvs2(2) = (0D0,0D0) |
|
41 |
jvs2(3) = (0D0,0D0) |
|
42 |
jvs2(4) = (0D0,0D0) |
|
43 |
||
44 |
dg = sc1(1)*sc2(1) /q2 |
|
45 |
||
46 |
if (g1(1).NE.(0D0,0D0)) then |
|
47 |
qvc = vc(1)*q(1) - vc(2)*q(2) - vc(3)*q(3) - vc(4)*q(4) |
|
48 |
qp1 = q(1)*p1(1) - q(2)*p1(2) - q(3)*p1(3) - q(4)*p1(4) |
|
49 |
|
|
50 |
jvs1(1) = g1(1)* (vc(1)*qp1 - p1(1)*qvc) |
|
51 |
jvs1(2) = g1(1)* (vc(2)*qp1 - p1(2)*qvc) |
|
52 |
jvs1(3) = g1(1)* (vc(3)*qp1 - p1(3)*qvc) |
|
53 |
jvs1(4) = g1(1)* (vc(4)*qp1 - p1(4)*qvc) |
|
54 |
endif |
|
55 |
||
56 |
if (g1(2).NE.(0D0,0D0)) then |
|
57 |
p12 = p1(1)*q(2) - p1(2)*q(1) |
|
58 |
p13 = p1(1)*q(3) - p1(3)*q(1) |
|
59 |
p14 = p1(1)*q(4) - p1(4)*q(1) |
|
60 |
p23 = p1(2)*q(3) - p1(3)*q(2) |
|
61 |
p24 = p1(2)*q(4) - p1(4)*q(2) |
|
62 |
p34 = p1(3)*q(4) - p1(4)*q(3) |
|
63 |
||
64 |
||
65 |
jvs2(1)= - g1(2)* (-vc(2)*p34 +vc(3)*p24 -vc(4)*p23) |
|
66 |
jvs2(2)= g1(2)* ( vc(1)*p34 -vc(3)*p14 +vc(4)*p13) |
|
67 |
jvs2(3)= g1(2)* (-vc(1)*p24 +vc(2)*p14 -vc(4)*p12) |
|
68 |
jvs2(4)= g1(2)* ( vc(1)*p23 -vc(2)*p13 +vc(3)*p12) |
|
69 |
endif |
|
70 |
||
71 |
||
72 |
jvs(1) = dg * (jvs1(1) + jvs2(1)) |
|
73 |
jvs(2) = dg * (jvs1(2) + jvs2(2)) |
|
74 |
jvs(3) = dg * (jvs1(3) + jvs2(3)) |
|
75 |
jvs(4) = dg * (jvs1(4) + jvs2(4)) |
|
76 |
||
77 |
return |
|
78 |
end |