1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125
|
* ffT13.F
* part of the complex four-point function
* this file is part of LoopTools
* last modified 8 Dec 10 th
#include "externals.h"
* T13 = \int_0^1 dx \int_0^x dy
* y/( (rg y^2 + rh xy + cd x + cj y + cf + I signf) *
* (ra y^2 + rc xy + cd x + ce y + cf + I signf) )
* with signf = -eps
* variables "signX" is the sign of im(X) in case X becomes real.
* No extra term is needed.
* Nov 11 2008
double complex function ffT13(ra, rc, rg, rh,
& cd, ce, cf, signf, cj, ier)
implicit none
double precision ra, rc, rg, rh, signf
double complex cd, ce, cf, cj
integer ier
#include "ff.h"
double complex ck, cl, cn, cy(2), crdetq4
double complex cbj(4), ccj(4)
double complex ffS3nAll1, ffS3nAll2
double precision sn, scj, sy(2), raj(4)
double complex ffS2, ffS3n
external ffS2, ffS3n
* the coefficients of the 4 log arguments
raj(1) = ra
raj(2) = rg
raj(3) = rg + rh
raj(4) = ra + rc
cbj(1) = ce + rc
cbj(2) = cj + rh
cbj(3) = cd + cj
cbj(4) = ce + cd
ccj(1) = cf + cd
ccj(2) = cf + cd
ccj(3) = cf
ccj(4) = cf
* the ieps is the same for all
scj = signf
* the prefactor 1/(S V - T U)
* eq. (S V - T U) = K y^2 + L y + N == 0
* Leading Landau singularity can occur if y1 = y2 and eps -> 0
* the ieps is needed for the roots
ck = rh*ra - rc*rg
cl = (ra - rg)*cd + rh*ce - rc*cj
cn = (rh - rc)*cf + cd*(ce - cj)
* the ieps for cn
sn = signf*(rh - rc)
* if (rh - rc) = 0 then we are at the boundary of phase space
* and sn is irrelevant
if( abs(ck) .lt. precx ) then
if( abs(cl) .lt. precx ) then
if( abs(cn) .lt. precx ) then
call fferr(99, ier)
ffT13 = 0
return
endif
* the case ny = 0, (SV - TU) = N = constant
* no extra term is needed
ffT13 = -1/cn*(
& ffS2(raj(1), cbj(1), ccj(1), scj, ier) -
& ffS2(raj(2), cbj(2), ccj(2), scj, ier) +
& ffS2(raj(3), cbj(3), ccj(3), scj, ier) -
& ffS2(raj(4), cbj(4), ccj(4), scj, ier) )
return
endif
* the case ny = 1, (S V - T U) = L y + N
cy(1) = -cn/cl
* ieps for this root
sy(1) = -sn*DBLE(cl)
if( sy(1) .eq. 0 ) sy(1) = signf
ffS3nAll1 =
& ffS3n(cy(1), sy(1), raj(1), cbj(1), ccj(1), scj, ier) -
& ffS3n(cy(1), sy(1), raj(2), cbj(2), ccj(2), scj, ier) +
& ffS3n(cy(1), sy(1), raj(3), cbj(3), ccj(3), scj, ier) -
& ffS3n(cy(1), sy(1), raj(4), cbj(4), ccj(4), scj, ier)
ffT13 = -ffS3nAll1/cl
return
endif
* the case ny = 2, (SV - TU) = K y^2 + L y + N
crdetq4 = sqrt(cl**2 - 4*ck*cn)
cy(1) = -.5D0/ck*(cl + crdetq4)
cy(2) = -.5D0/ck*(cl - crdetq4)
if( abs(cy(1)) .gt. abs(cy(2)) ) then
cy(2) = cn/(ck*cy(1))
else
cy(1) = cn/(ck*cy(2))
endif
* calculate the signs of img(cy1) and img(cy2) which are related to ieps
sy(1) = sn*DBLE(crdetq4)
if( sy(1) .eq. 0 ) sy(1) = signf
sy(2) = -sy(1)
ffS3nAll1 =
& ffS3n(cy(1), sy(1), raj(1), cbj(1), ccj(1), scj, ier) -
& ffS3n(cy(1), sy(1), raj(2), cbj(2), ccj(2), scj, ier) +
& ffS3n(cy(1), sy(1), raj(3), cbj(3), ccj(3), scj, ier) -
& ffS3n(cy(1), sy(1), raj(4), cbj(4), ccj(4), scj, ier)
ffS3nAll2 =
& ffS3n(cy(2), sy(2), raj(1), cbj(1), ccj(1), scj, ier) -
& ffS3n(cy(2), sy(2), raj(2), cbj(2), ccj(2), scj, ier) +
& ffS3n(cy(2), sy(2), raj(3), cbj(3), ccj(3), scj, ier) -
& ffS3n(cy(2), sy(2), raj(4), cbj(4), ccj(4), scj, ier)
ffT13 = (ffS3nAll1 - ffS3nAll2)/crdetq4
end
|