← Back to branch summary

~maddevelopers/mg5amcnlo/2.9.4

« back to all changes in this revision

Viewing changes to vendor/CutTools/src/qcdloop/qlkfn.f

pass to v2.0.0

Show diffs side-by-side

added added

removed removed

Lines of Context:
vendor/CutTools/src/qcdloop/qlkfn.f
 
1
      subroutine qlkfn(cx,ieps,xpi,xm,xmp)
 
2
*************************************************************************
 
3
*                                                                       *
 
4
*       RKE & GZ: adapted from ffzkfn routine (19/02/2008)
 
5
*       Calculate the K-function given in Eq. 2.7 of                    *
 
6
*       %\cite{Beenakker:1988jr}                                        *
 
7
*       \bibitem{Beenakker:1988jr}                                      *
 
8
*        W.~Beenakker and A.~Denner,                                    *
 
9
*  %``INFRARED DIVERGENT SCALAR BOX INTEGRALS WITH APPLICATIONS IN THE  *
 
10
*  %ELECTROWEAK STANDARD MODEL,''                                       *
 
11
*       Nucl.\ Phys.\  B {\bf 338}, 349 (1990).                         *
 
12
*       %%CITATION = NUPHA,B338,349;%%                                  *
 
13
*                                                                       *
 
14
*                             1-sqrt(1-4*m*mp/(z-(m-mp)^2))             *
 
15
*               K(p^2,m,mp) = -----------------------------             *
 
16
*                             1+sqrt(1-4*m*mp/(z-(m-mp)^2))             *
 
17
*                                                                       *
 
18
*       and fill x(1) = -K, x(2) = 1+K, x(3) = 1-K                      *
 
19
*       the roots are allowed to be imaginary                           *
 
20
*       ieps gives the sign of the imaginary part of -K: 1 -> +i*eps    *
 
21
*                                                                       *
 
22
*************************************************************************
 
23
      implicit none
 
24
      include 'qlconstants.f'
 
25
      LOGICAL qlzero
 
26
      DOUBLE PRECISION xpi,xm,xmp,xx1,ieps
 
27
      DOUBLE COMPLEX root,invopr,cx(3),rat
 
28
 
 
29
      if  ((xm .eq. 0d0) .or. (xmp .eq. 0d0)) then
 
30
      write(6,*) 'Error in qlkfn,xm,xmp=',xm,xmp
 
31
      stop 
 
32
      endif
 
33
 
 
34
      xx1 = xpi - (xm-xmp)**2
 
35
      rat=dcmplx(xx1/(4d0*xm*xmp))
 
36
 
 
37
      if (qlzero(dble(rat))) then
 
38
           cx(2) = -2d0*im*sqrt(rat)+2d0*rat
 
39
           cx(1) = cone-cx(2)
 
40
           cx(3) = ctwo-cx(2) 
 
41
      else
 
42
 
 
43
           root = sqrt((rat-cone)/rat)
 
44
           invopr = cone/(cone+root)
 
45
           cx(1) = -invopr**2/rat
 
46
           cx(2) = ctwo*invopr
 
47
           cx(3) = ctwo*root*invopr
 
48
       endif    
 
49
       ieps = 1d0
 
50
       return
 
51
       end