← Back to branch summary

~maddevelopers/mg5amcnlo/3.0.2-alpha0

« back to all changes in this revision

Viewing changes to HELAS/jiokxx.F

Added Template and HELAS into bzr

Show diffs side-by-side

added added

removed removed

Lines of Context:
HELAS/jiokxx.F
 
1
      subroutine jiokxx(fi,fo,g,tmass,twidth , uio)
 
2
c
 
3
c This subroutine computes an amplitude of the fermion-fermion-vector
 
4
c coupling.
 
5
c
 
6
c input:
 
7
c       complex fi(6)          : flow-in  fermion                   |fi>
 
8
c       complex fo(6)          : flow-out fermion                   <fo|
 
9
c       complex g(1)           : coupling constant                 -kappa/8
 
10
c       real    g(2)           : fermion mass                        m_f
 
11
c
 
12
c output:
 
13
c       complex uio(18)        : outgoing tensor    T_{mu,vu} = T(mu+4*(vu-1))
 
14
c     
 
15
      implicit none
 
16
      double complex fi(18), fo(18), uio(18),g(2)
 
17
      double precision fmass,tmass,twidth
 
18
 
 
19
      double complex tc(4,4),tc1(4,4),fgamf(4),ffm
 
20
      double complex fkslaf,fgamfk(4,4),prop,denom
 
21
      double precision k(4),pp,m2,p(4),eta(4,4)
 
22
      integer i,j,ii,jj
 
23
 
 
24
      double complex ci
 
25
      parameter( ci = ( 0.0d0, 1.0d0 ) )
 
26
 
 
27
      fmass = dreal(g(2))
 
28
      do i=1,16
 
29
         uio(i)=(0d0,0d0)
 
30
      enddo
 
31
 
 
32
      m2 = tmass**2
 
33
      uio(17) = fi(5)-fo(5)
 
34
      uio(18) = fi(6)-fo(6)
 
35
 
 
36
      p(1) = dble( uio(17))/tmass
 
37
      p(2) = dble( uio(18))/tmass
 
38
      p(3) = dimag(uio(18))/tmass
 
39
      p(4) = dimag(uio(17))/tmass
 
40
 
 
41
      k(1) = dble( fi(5)+fo(5))
 
42
      k(2) = dble( fi(6)+fo(6))
 
43
      k(3) = dimag(fi(6)+fo(6))
 
44
      k(4) = dimag(fi(5)+fo(5))
 
45
 
 
46
      pp = p(1)**2 - p(2)**2 - p(3)**2 - p(4)**2
 
47
 
 
48
      denom = dcmplx(pp*m2 - m2,tmass*twidth)
 
49
 
 
50
      fgamf(1) =     fi(3)*fo(1)+fi(4)*fo(2)+fi(1)*fo(3)+fi(2)*fo(4)
 
51
      fgamf(2) =     fi(4)*fo(1)+fi(3)*fo(2)-fi(2)*fo(3)-fi(1)*fo(4)
 
52
      fgamf(3) =ci*(-fi(4)*fo(1)+fi(3)*fo(2)+fi(2)*fo(3)-fi(1)*fo(4))
 
53
      fgamf(4) =     fi(3)*fo(1)-fi(4)*fo(2)-fi(1)*fo(3)+fi(2)*fo(4)
 
54
      ffm = 2d0*fmass*(fo(1)*fi(1)+fo(2)*fi(2)+fo(3)*fi(3)+fo(4)*fi(4))
 
55
      fkslaf  = k(1)* fgamf(1)-k(2)* fgamf(2)-
 
56
     &          k(3)* fgamf(3)-k(4)* fgamf(4)
 
57
      do i=1,3
 
58
         do j=1+1,4
 
59
            eta(i,j)=0d0
 
60
            eta(j,i)=eta(i,j)
 
61
         enddo
 
62
      enddo
 
63
      eta(1,1)= 1d0
 
64
      eta(2,2)=-1d0
 
65
      eta(3,3)=-1d0
 
66
      eta(4,4)=-1d0
 
67
 
 
68
c vertex
 
69
c upper triangle:
 
70
      do i=2,4
 
71
      do j=1,i-1
 
72
      tc(i,j)=fgamf(i)*k(j)+fgamf(j)*k(i)
 
73
c lower triangle:
 
74
      tc(j,i)=tc(i,j)
 
75
      enddo
 
76
c diagonal terms:
 
77
      tc(i,i)=2d0*(fgamf(i)*k(i)+(fkslaf-ffm))
 
78
      enddo
 
79
      tc(1,1)=2d0*(fgamf(1)*k(1)-(fkslaf-ffm))
 
80
      
 
81
c make indices upper indices before contracting with propagator
 
82
      do i=2,4
 
83
         tc(1,i)=-tc(1,i)
 
84
         tc(i,1)=-tc(i,1)
 
85
      enddo
 
86
 
 
87
 
 
88
 
 
89
c multiply by propagator
 
90
      do i=1,4
 
91
         do j=1,4
 
92
            do ii=1,4
 
93
               do jj=1,4
 
94
                  uio(i+4*(j-1))=uio(i+4*(j-1))+
 
95
     &            (
 
96
     &                    (eta(i,ii)-p(i)*p(ii))*(eta(j,jj)-p(j)*p(jj))+
 
97
     &                    (eta(i,jj)-p(i)*p(jj))*(eta(j,ii)-p(j)*p(ii))-
 
98
     &            2d0/3d0*(eta(i,j)-p(i)*p(j))*(eta(ii,jj)-p(ii)*p(jj))
 
99
     &            )
 
100
     &            *tc(ii,jj)*g(1)/denom
 
101
               enddo
 
102
            enddo
 
103
         enddo
 
104
      enddo
 
105
 
 
106
      return
 
107
      end