← Back to branch summary

~maddevelopers/mg5amcnlo/2.9.4

« back to all changes in this revision

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

pass to v2.0.0

Show diffs side-by-side

added added

removed removed

Lines of Context:
vendor/CutTools/src/qcdloop/npoin.f
 
1
*###[ NPOIN:
 
2
        subroutine NPOIN(npoint)
 
3
***#[*comment:***********************************************************
 
4
*                                                                       *
 
5
*       entry point to the AA and FF routines compatible with Veltman's *
 
6
*       NPOIN for FormF.                                                *
 
7
*                                                                       *
 
8
*       Input:  npoin   integer         specifies which function        *
 
9
*               DEL     real            infinity                        *
 
10
*               PX(1-6) real            momenta squared (Pauli metric)  *
 
11
*               RM(2-4) real            masses squared                  *
 
12
*                                                                       *
 
13
*       Output: B0,B0PM,B1,B1PM,B2      complex         if npoint=2     *
 
14
*               C0,C1,C2,C3             complex         if npoint=3     *
 
15
*               D0,D1,D2,D3,D4          complex         if npoint=4     *
 
16
*               (all in blank common)                                   *
 
17
*                                                                       *
 
18
***#]*comment:***********************************************************
 
19
*  #[ declarations:
 
20
        implicit none
 
21
*
 
22
*       arguments
 
23
*
 
24
        integer npoint
 
25
*
 
26
*       local variables
 
27
*
 
28
        integer init,i,l2,l3,l4,ier
 
29
        DOUBLE PRECISION xmu,xpc(6),xpd(13)
 
30
        DOUBLE COMPLEX cab(2),cbi(4),acbi(2),cac(3),cbc(12),cci(13),
 
31
     +          cbd(12),ccd(28),cdi(24)
 
32
        save init,l2,l3,l4
 
33
*
 
34
*       common blocks
 
35
*
 
36
        DOUBLE COMPLEX B0,B0PM,B1,B1PM,B2,CC0,CC1,CC2,CC3,D0,D1,D2,D3,D4
 
37
        DOUBLE PRECISION PX(6),RM(4),DEL
 
38
        common PX,RM,DEL,
 
39
     +          B0,B0PM,B1,B1PM,B2(2),CC0,CC1(2),CC2(4),CC3(6),
 
40
     +          D0,D1(3),D2(7),D3(13),D4(22)
 
41
        include 'ff.h'
 
42
        include 'aa.h'
 
43
*
 
44
*       data
 
45
*
 
46
        data xmu /0.D0/
 
47
        data l2,l3,l4 /2,3,3/
 
48
        data init /0/
 
49
*  #] declarations:
 
50
*  #[ initialisations:
 
51
        if ( init.eq.0 ) then
 
52
            init = 1
 
53
            do 10 i=1,22
 
54
                D4(i) = 0
 
55
   10       continue
 
56
            print *,'NPOIN: warning: D4 is not yet supported'
 
57
            print *,'NPOIN: warning: B1'' seems also not yet supported'
 
58
            call ffini
 
59
        endif
 
60
        ier = 0
 
61
        nevent = nevent + 1
 
62
*  #] initialisations:
 
63
*  #[ 2point:
 
64
        if ( npoint.eq.2 ) then
 
65
            aderiv = .TRUE.
 
66
            call aaxbx(cab,cbi,acbi,del,xmu,-PX(1),RM(1),RM(2),l2,ier)
 
67
            B0     = cipi2*cbi(1)
 
68
            B1     = cipi2*cbi(2)
 
69
            B2(1)  = cipi2*cbi(3)
 
70
            B2(2)  =-cipi2*cbi(4)
 
71
            B0PM   = cipi2*acbi(1)
 
72
            B1PM   = cipi2*acbi(2)
 
73
*  #] 2point:
 
74
*  #[ 3point:
 
75
        elseif ( npoint.eq.3 ) then
 
76
            xpc(1) = RM(1)
 
77
            xpc(2) = RM(2)
 
78
            xpc(3) = RM(3)
 
79
            xpc(4) =-PX(1)
 
80
            xpc(5) =-PX(2)
 
81
            xpc(6) =-PX(5)
 
82
            call aaxcx(cac,cbc,cci,del,xmu,xpc,l3,ier)
 
83
            CC0     =-cipi2*cci(1)
 
84
            CC1(1)  =-cipi2*cci(2)
 
85
            CC1(2)  =-cipi2*cci(3)
 
86
            CC2(1)  =-cipi2*cci(4)
 
87
            CC2(2)  =-cipi2*cci(5)
 
88
            CC2(3)  =-cipi2*cci(6)
 
89
            CC2(4)  =+cipi2*cci(7)
 
90
            CC3(1)  =-cipi2*cci(8)
 
91
            CC3(2)  =-cipi2*cci(9)
 
92
            CC3(3)  =-cipi2*cci(10)
 
93
            CC3(4)  =-cipi2*cci(11)
 
94
            CC3(5)  =+cipi2*cci(12)
 
95
            CC3(6)  =+cipi2*cci(13)
 
96
*  #] 3point:
 
97
*  #[ 4point:
 
98
        elseif ( npoint.eq.4 ) then
 
99
            xpd(1) = RM(1)
 
100
            xpd(2) = RM(2)
 
101
            xpd(3) = RM(3)
 
102
            xpd(4) = RM(4)
 
103
            xpd(5) =-PX(1)
 
104
            xpd(6) =-PX(2)
 
105
            xpd(7) =-PX(3)
 
106
            xpd(8) =-PX(4)
 
107
            xpd(9) =-PX(5)
 
108
            xpd(10)=-PX(6)
 
109
            xpd(11)= 0.D0
 
110
            xpd(12)= 0.D0
 
111
            xpd(13)= 0.D0
 
112
            call aaxdx(cbd,ccd,cdi,del,xmu,xpd,l4,ier)
 
113
            D0     = cipi2*cdi(1)
 
114
            D1(1)  = cipi2*cdi(2)
 
115
            D1(2)  = cipi2*cdi(3)
 
116
            D1(3)  = cipi2*cdi(4)
 
117
            D2(1)  = cipi2*cdi(5)
 
118
            D2(2)  = cipi2*cdi(6)
 
119
            D2(3)  = cipi2*cdi(7)
 
120
            D2(4)  = cipi2*cdi(8)
 
121
            D2(5)  = cipi2*cdi(9)
 
122
            D2(6)  = cipi2*cdi(10)
 
123
            D2(7)  =-cipi2*cdi(11)
 
124
            D3(1)  = cipi2*cdi(12)
 
125
            D3(2)  = cipi2*cdi(13)
 
126
            D3(3)  = cipi2*cdi(14)
 
127
            D3(4)  = cipi2*cdi(15)
 
128
            D3(5)  = cipi2*cdi(16)
 
129
            D3(6)  = cipi2*cdi(17)
 
130
            D3(7)  = cipi2*cdi(18)
 
131
            D3(8)  = cipi2*cdi(19)
 
132
            D3(9)  = cipi2*cdi(20)
 
133
            D3(10) = cipi2*cdi(21)
 
134
            D3(11) =-cipi2*cdi(22)
 
135
            D3(12) =-cipi2*cdi(23)
 
136
            D3(13) =-cipi2*cdi(24)
 
137
*  #] 4point:
 
138
*  #[ finish:
 
139
        else
 
140
            print *,'NPOIN: error: npoint should be 2,3 or 4; not ',
 
141
     +          npoint
 
142
            stop
 
143
        endif
 
144
        if ( ier .gt. 10 ) then
 
145
            print *,'NPOIN: warning: more than 10 digits lost: ',ier
 
146
            print *,'npoint = ',npoint
 
147
            print *,'RM = ',RM
 
148
            print *,'PX = ',PX
 
149
            if ( ltest ) call ffwarn(998,ier,x0,x0)
 
150
        endif
 
151
*  #] finish:
 
152
*###] NPOIN:
 
153
        end
 
154
*###[ AA0:
 
155
        DOUBLE COMPLEX function AA0(XM,DEL)
 
156
***#[*comment:***********************************************************
 
157
*                                                                       *
 
158
*       provides an interface to FF compatible with FormF by M. Veltman *
 
159
*                                                                       *
 
160
*       Input:  XM      real            mass                            *
 
161
*               DEL     real            infinity                        *
 
162
*                                                                       *
 
163
*       Output: A0      complex                                         *
 
164
*                                                                       *
 
165
***#]*comment:***********************************************************
 
166
*  #[ declarations:
 
167
        implicit none
 
168
*
 
169
*       arguments
 
170
*
 
171
        DOUBLE PRECISION XM,DEL
 
172
*
 
173
*       my variables
 
174
*
 
175
        DOUBLE COMPLEX ca0
 
176
        integer ier,init
 
177
        save init
 
178
*
 
179
*       common blocks
 
180
*
 
181
        include 'ff.h'
 
182
*
 
183
*       data
 
184
*
 
185
        data init /0/
 
186
*  #] declarations:
 
187
*  #[ initialisations:
 
188
        if ( init .eq. 0 ) then
 
189
            init = 1
 
190
            call ffini
 
191
        endif
 
192
*  #] initialisations:
 
193
*  #[ calculations:
 
194
        nevent = nevent + 1
 
195
        ier = 0
 
196
        call ffxa0(ca0,DEL,x0,XM,ier)
 
197
        AA0 = -ca0*cipi2
 
198
*  #] calculations:
 
199
*###] AA0:
 
200
        end
 
201
*###[ ALIJ:
 
202
        DOUBLE PRECISION function ALIJ(P22,P12,P1P2,P20,P10,DELE,PM2)
 
203
        DOUBLE PRECISION P22,P12,P1P2,P20,P10,DELE,PM2
 
204
        print *,'ALIJ: error: not implemented'
 
205
*       stupid fort!
 
206
        ALIJ = 0
 
207
*###] ALIJ:
 
208
        end