~maddevelopers/mg5amcnlo/new_clustering

« back to all changes in this revision

Viewing changes to tests/input_files/IOTestsComparison/IOExportFKSTest/test_wprod_fksew/%SubProcesses%P0_dxu_veep%V0_dxu_veep%mp_compute_loop_coefs.f

  • Committer: Rikkert Frederix
  • Date: 2021-09-09 15:51:40 UTC
  • mfrom: (78.75.502 3.2.1)
  • Revision ID: frederix@physik.uzh.ch-20210909155140-rg6umfq68h6h47cf
merge with 3.2.1

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
      SUBROUTINE MP_COMPUTE_LOOP_COEFS(PS,ANSDP)
 
2
C     
 
3
C     Generated by MadGraph5_aMC@NLO v. %(version)s, %(date)s
 
4
C     By the MadGraph5_aMC@NLO Development Team
 
5
C     Visit launchpad.net/madgraph5 and amcatnlo.web.cern.ch
 
6
C     
 
7
C     Returns amplitude squared summed/avg over colors
 
8
C     and helicities for the point in phase space P(0:3,NEXTERNAL)
 
9
C     and external lines W(0:6,NEXTERNAL)
 
10
C     
 
11
C     Process: d~ u > ve e+ [ all = QCD QED ] QCD^2<=0 QED^2<=6
 
12
C     Process: s~ c > ve e+ [ all = QCD QED ] QCD^2<=0 QED^2<=6
 
13
C     
 
14
C     Modules
 
15
C     
 
16
      USE POLYNOMIAL_CONSTANTS
 
17
C     
 
18
      IMPLICIT NONE
 
19
C     
 
20
C     CONSTANTS
 
21
C     
 
22
      CHARACTER*64 PARAMFILENAME
 
23
      PARAMETER ( PARAMFILENAME='MadLoopParams.dat')
 
24
      INTEGER NBORNAMPS
 
25
      PARAMETER (NBORNAMPS=1)
 
26
      INTEGER    NLOOPS, NLOOPGROUPS, NCTAMPS
 
27
      PARAMETER (NLOOPS=35, NLOOPGROUPS=25, NCTAMPS=15)
 
28
      INTEGER    NLOOPAMPS
 
29
      PARAMETER (NLOOPAMPS=50)
 
30
      INTEGER    NCOLORROWS
 
31
      PARAMETER (NCOLORROWS=NLOOPAMPS)
 
32
      INTEGER    NEXTERNAL
 
33
      PARAMETER (NEXTERNAL=4)
 
34
      INTEGER    NWAVEFUNCS,NLOOPWAVEFUNCS
 
35
      PARAMETER (NWAVEFUNCS=6,NLOOPWAVEFUNCS=73)
 
36
      INTEGER    NCOMB
 
37
      PARAMETER (NCOMB=16)
 
38
      REAL*16    ZERO
 
39
      PARAMETER (ZERO=0E0_16)
 
40
      COMPLEX*32 IMAG1
 
41
      PARAMETER (IMAG1=(0E0_16,1E0_16))
 
42
      COMPLEX*32 DP_IMAG1
 
43
      PARAMETER (DP_IMAG1=(0D0,1D0))
 
44
C     These are constants related to the split orders
 
45
      INTEGER    NSO, NSQUAREDSO, NAMPSO
 
46
      PARAMETER (NSO=2, NSQUAREDSO=1, NAMPSO=2)
 
47
 
 
48
 
 
49
C     
 
50
C     ARGUMENTS 
 
51
C     
 
52
      REAL*16 PS(0:3,NEXTERNAL)
 
53
      REAL*8 ANSDP(3,0:NSQUAREDSO)
 
54
C     
 
55
C     LOCAL VARIABLES 
 
56
C     
 
57
      LOGICAL DPW_COPIED
 
58
      LOGICAL COMPUTE_INTEGRAND_IN_QP
 
59
      INTEGER I,J,K,H,HEL_MULT,ITEMP
 
60
      REAL*16 TEMP2
 
61
      REAL*8 DP_TEMP2
 
62
      COMPLEX*32 CTEMP
 
63
      COMPLEX*16 DP_CTEMP
 
64
 
 
65
      INTEGER NHEL(NEXTERNAL), IC(NEXTERNAL)
 
66
      REAL*16 MP_P(0:3,NEXTERNAL)
 
67
      REAL*8 P(0:3,NEXTERNAL)
 
68
 
 
69
      DATA IC/NEXTERNAL*1/
 
70
      REAL*16 ANS(3,0:NSQUAREDSO)
 
71
      COMPLEX*32 COEFS(MAXLWFSIZE,0:VERTEXMAXCOEFS-1,MAXLWFSIZE)
 
72
      COMPLEX*32 CFTOT
 
73
      COMPLEX*16 DP_CFTOT
 
74
C     
 
75
C     FUNCTIONS
 
76
C     
 
77
      LOGICAL IS_HEL_SELECTED
 
78
      INTEGER ML5SOINDEX_FOR_BORN_AMP
 
79
      INTEGER ML5SOINDEX_FOR_LOOP_AMP
 
80
      INTEGER ML5SQSOINDEX
 
81
C     
 
82
C     GLOBAL VARIABLES
 
83
C     
 
84
      INCLUDE 'mp_coupl_same_name.inc'
 
85
 
 
86
      INCLUDE 'MadLoopParams.inc'
 
87
 
 
88
      LOGICAL CHECKPHASE, HELDOUBLECHECKED
 
89
      COMMON/INIT/CHECKPHASE, HELDOUBLECHECKED
 
90
 
 
91
      INTEGER HELOFFSET
 
92
      INTEGER GOODHEL(NCOMB)
 
93
      LOGICAL GOODAMP(NSQUAREDSO,NLOOPGROUPS)
 
94
      COMMON/FILTERS/GOODAMP,GOODHEL,HELOFFSET
 
95
 
 
96
      INTEGER HELPICKED
 
97
      COMMON/HELCHOICE/HELPICKED
 
98
 
 
99
      INTEGER USERHEL
 
100
      COMMON/USERCHOICE/USERHEL
 
101
 
 
102
      INTEGER SQSO_TARGET
 
103
      COMMON/SOCHOICE/SQSO_TARGET
 
104
 
 
105
      LOGICAL UVCT_REQ_SO_DONE,MP_UVCT_REQ_SO_DONE,CT_REQ_SO_DONE
 
106
     $ ,MP_CT_REQ_SO_DONE,LOOP_REQ_SO_DONE,MP_LOOP_REQ_SO_DONE
 
107
     $ ,CTCALL_REQ_SO_DONE,FILTER_SO
 
108
      COMMON/SO_REQS/UVCT_REQ_SO_DONE,MP_UVCT_REQ_SO_DONE
 
109
     $ ,CT_REQ_SO_DONE,MP_CT_REQ_SO_DONE,LOOP_REQ_SO_DONE
 
110
     $ ,MP_LOOP_REQ_SO_DONE,CTCALL_REQ_SO_DONE,FILTER_SO
 
111
 
 
112
      COMPLEX*32 AMP(NBORNAMPS)
 
113
      COMMON/MP_AMPS/AMP
 
114
      COMPLEX*16 DP_AMP(NBORNAMPS)
 
115
      COMMON/AMPS/DP_AMP
 
116
      COMPLEX*32 W(20,NWAVEFUNCS)
 
117
      COMMON/MP_W/W
 
118
 
 
119
      COMPLEX*16 DPW(20,NWAVEFUNCS)
 
120
      COMMON/W/DPW
 
121
 
 
122
      COMPLEX*32 WL(MAXLWFSIZE,0:LOOPMAXCOEFS-1,MAXLWFSIZE,
 
123
     $ -1:NLOOPWAVEFUNCS)
 
124
      COMPLEX*32 PL(0:3,-1:NLOOPWAVEFUNCS)
 
125
      COMMON/MP_WL/WL,PL
 
126
 
 
127
      COMPLEX*16 DP_WL(MAXLWFSIZE,0:LOOPMAXCOEFS-1,MAXLWFSIZE,
 
128
     $ -1:NLOOPWAVEFUNCS)
 
129
      COMPLEX*16 DP_PL(0:3,-1:NLOOPWAVEFUNCS)
 
130
      COMMON/WL/DP_WL,DP_PL
 
131
 
 
132
      COMPLEX*32 LOOPCOEFS(0:LOOPMAXCOEFS-1,NSQUAREDSO,NLOOPGROUPS)
 
133
      COMMON/MP_LCOEFS/LOOPCOEFS
 
134
 
 
135
      COMPLEX*16 DP_LOOPCOEFS(0:LOOPMAXCOEFS-1,NSQUAREDSO,NLOOPGROUPS)
 
136
      COMMON/LCOEFS/DP_LOOPCOEFS
 
137
 
 
138
 
 
139
      COMPLEX*32 AMPL(3,NCTAMPS)
 
140
      COMMON/MP_AMPL/AMPL
 
141
 
 
142
      COMPLEX*16 DP_AMPL(3,NCTAMPS)
 
143
      COMMON/AMPL/DP_AMPL
 
144
 
 
145
 
 
146
      INTEGER CF_D(NCOLORROWS,NBORNAMPS)
 
147
      INTEGER CF_N(NCOLORROWS,NBORNAMPS)
 
148
      COMMON/CF/CF_D,CF_N
 
149
 
 
150
      INTEGER HELC(NEXTERNAL,NCOMB)
 
151
      COMMON/HELCONFIGS/HELC
 
152
 
 
153
      LOGICAL MP_DONE_ONCE
 
154
      COMMON/MP_DONE_ONCE/MP_DONE_ONCE
 
155
 
 
156
      INTEGER LIBINDEX
 
157
      COMMON/I_LIB/LIBINDEX
 
158
 
 
159
C     This array specify potential special requirements on the
 
160
C      helicities to
 
161
C     consider. POLARIZATIONS(0,0) is -1 if there is not such
 
162
C      requirement.
 
163
      INTEGER POLARIZATIONS(0:NEXTERNAL,0:5)
 
164
      COMMON/BEAM_POL/POLARIZATIONS
 
165
 
 
166
C     ----------
 
167
C     BEGIN CODE
 
168
C     ----------
 
169
 
 
170
C     Decide whether to really compute the integrand in quadruple
 
171
C      precision or to fake it and copy the double precision
 
172
C      computation in the quadruple precision variables.
 
173
      COMPUTE_INTEGRAND_IN_QP = ((MLREDUCTIONLIB(LIBINDEX)
 
174
     $ .EQ.6.AND.USEQPINTEGRANDFORNINJA) .OR. (MLREDUCTIONLIB(LIBINDEX)
 
175
     $ .EQ.1.AND.USEQPINTEGRANDFORCUTTOOLS))
 
176
 
 
177
C     To be on the safe side, we always update the MP params here.
 
178
C     It can be redundant as this routine can be called a couple of
 
179
C      times for the same PS point during the stability checks.
 
180
C     But it is really not time consuming and I would rather be safe.
 
181
      CALL MP_UPDATE_AS_PARAM()
 
182
 
 
183
      MP_DONE_ONCE = .TRUE.
 
184
 
 
185
C     AS A SAFETY MEASURE WE FIRST COPY HERE THE PS POINT
 
186
      DO I=1,NEXTERNAL
 
187
        DO J=0,3
 
188
          MP_P(J,I)=PS(J,I)
 
189
          P(J,I) = REAL(PS(J,I),KIND=8)
 
190
        ENDDO
 
191
      ENDDO
 
192
 
 
193
      DO I=0,3
 
194
        PL(I,-1)=CMPLX(ZERO,ZERO,KIND=16)
 
195
        PL(I,0)=CMPLX(ZERO,ZERO,KIND=16)
 
196
        IF (.NOT.COMPUTE_INTEGRAND_IN_QP) THEN
 
197
          DP_PL(I,-1)=DCMPLX(0.0D0,0.0D0)
 
198
          DP_PL(I,0)=DCMPLX(0.0D0,0.0D0)
 
199
        ENDIF
 
200
      ENDDO
 
201
 
 
202
      DO I=1,MAXLWFSIZE
 
203
        DO J=0,LOOPMAXCOEFS-1
 
204
          DO K=1,MAXLWFSIZE
 
205
            WL(I,J,K,-1)=(ZERO,ZERO)
 
206
            DP_WL(I,J,K,-1)=(0.0D0,0.0D0)
 
207
            IF (I.EQ.K.AND.J.EQ.0) THEN
 
208
              WL(I,J,K,0)=(1.0E0_16,ZERO)
 
209
            ELSE
 
210
              WL(I,J,K,0)=(ZERO,ZERO)
 
211
            ENDIF
 
212
            IF (.NOT.COMPUTE_INTEGRAND_IN_QP) THEN
 
213
              IF (I.EQ.K.AND.J.EQ.0) THEN
 
214
                DP_WL(I,J,K,0)=(1.0D0,0.0D0)
 
215
              ELSE
 
216
                DP_WL(I,J,K,0)=(0.0D0,0.0D0)
 
217
              ENDIF
 
218
            ENDIF
 
219
          ENDDO
 
220
        ENDDO
 
221
      ENDDO
 
222
 
 
223
C     This is the chare conjugate version of the unit 4-currents in
 
224
C      the canonical cartesian basis.
 
225
C     This, for now, is only defined for 4-fermionic currents.
 
226
      WL(1,0,2,-1) = (-1.0E0_16,ZERO)
 
227
      WL(2,0,1,-1) = (1.0E0_16,ZERO)
 
228
      WL(3,0,4,-1) = (1.0E0_16,ZERO)
 
229
      WL(4,0,3,-1) = (-1.0E0_16,ZERO)
 
230
      DP_WL(1,0,2,-1) = DCMPLX(-1.0D0,0.0D0)
 
231
      DP_WL(2,0,1,-1) = DCMPLX(1.0D0,0.0D0)
 
232
      DP_WL(3,0,4,-1) = DCMPLX(1.0D0,0.0D0)
 
233
      DP_WL(4,0,3,-1) = DCMPLX(-1.0D0,0.0D0)
 
234
 
 
235
 
 
236
      DO K=1, 3
 
237
        DO I=1,NCTAMPS
 
238
          AMPL(K,I)=(ZERO,ZERO)
 
239
          IF (.NOT.COMPUTE_INTEGRAND_IN_QP) THEN
 
240
            DP_AMPL(K,I)=(0.0D0,0.0D0)
 
241
          ENDIF
 
242
        ENDDO
 
243
      ENDDO
 
244
 
 
245
 
 
246
      DO I=1, NBORNAMPS
 
247
        DP_AMP(I) = (0.0D0,0.0D0)
 
248
        AMP(I) = (ZERO, ZERO)
 
249
      ENDDO
 
250
 
 
251
      DO I=1,NLOOPGROUPS
 
252
        DO J=0,LOOPMAXCOEFS-1
 
253
          DO K=1,NSQUAREDSO
 
254
            LOOPCOEFS(J,K,I)=(ZERO,ZERO)
 
255
            IF (.NOT.COMPUTE_INTEGRAND_IN_QP) THEN
 
256
              DP_LOOPCOEFS(J,K,I)=(0.0D0,0.0D0)
 
257
            ENDIF
 
258
          ENDDO
 
259
        ENDDO
 
260
      ENDDO
 
261
 
 
262
      DO K=1,3
 
263
        DO J=0,NSQUAREDSO
 
264
          ANSDP(K,J)=0.0D0
 
265
          ANS(K,J)=ZERO
 
266
        ENDDO
 
267
      ENDDO
 
268
 
 
269
      DPW_COPIED = .FALSE.
 
270
      DO H=1,NCOMB
 
271
        IF ((HELPICKED.EQ.H).OR.((HELPICKED.EQ.-1)
 
272
     $   .AND.(CHECKPHASE.OR.(.NOT.HELDOUBLECHECKED).OR.(GOODHEL(H)
 
273
     $   .GT.-HELOFFSET.AND.GOODHEL(H).NE.0)))) THEN
 
274
 
 
275
C         Handle the possible requirement of specific polarizations
 
276
          IF ((.NOT.CHECKPHASE)
 
277
     $     .AND.HELDOUBLECHECKED.AND.POLARIZATIONS(0,0)
 
278
     $     .EQ.0.AND.(.NOT.IS_HEL_SELECTED(H))) THEN
 
279
            CYCLE
 
280
          ENDIF
 
281
 
 
282
          DO I=1,NEXTERNAL
 
283
            NHEL(I)=HELC(I,H)
 
284
          ENDDO
 
285
 
 
286
          IF (COMPUTE_INTEGRAND_IN_QP) THEN
 
287
            MP_UVCT_REQ_SO_DONE=.FALSE.
 
288
            MP_CT_REQ_SO_DONE=.FALSE.
 
289
            MP_LOOP_REQ_SO_DONE=.FALSE.
 
290
          ELSE
 
291
            UVCT_REQ_SO_DONE=.FALSE.
 
292
            CT_REQ_SO_DONE=.FALSE.
 
293
            LOOP_REQ_SO_DONE=.FALSE.
 
294
          ENDIF
 
295
 
 
296
          IF (.NOT.CHECKPHASE.AND.HELDOUBLECHECKED.AND.HELPICKED.EQ.-1)
 
297
     $      THEN
 
298
            HEL_MULT=GOODHEL(H)
 
299
          ELSE
 
300
            HEL_MULT=1
 
301
          ENDIF
 
302
 
 
303
 
 
304
          IF (COMPUTE_INTEGRAND_IN_QP) THEN
 
305
            CALL MP_HELAS_CALLS_AMPB_1(MP_P,NHEL,H,IC)
 
306
            CONTINUE
 
307
          ELSE
 
308
            CALL HELAS_CALLS_AMPB_1(P,NHEL,H,IC)
 
309
            CONTINUE
 
310
          ENDIF
 
311
 
 
312
 2000     CONTINUE
 
313
          MP_CT_REQ_SO_DONE=.TRUE.
 
314
 
 
315
          IF (COMPUTE_INTEGRAND_IN_QP) THEN
 
316
 
 
317
            CONTINUE
 
318
          ELSE
 
319
 
 
320
            CONTINUE
 
321
          ENDIF
 
322
 
 
323
          IF (.NOT.COMPUTE_INTEGRAND_IN_QP) THEN
 
324
C           Copy back to the quantities computed in DP in the QP
 
325
C            containers (but only those needed)
 
326
            DO I=1,NBORNAMPS
 
327
              AMP(I)=CMPLX(DP_AMP(I),KIND=16)
 
328
            ENDDO
 
329
            DO I=1,NCTAMPS
 
330
              DO K=1,3
 
331
                AMPL(K,I)=CMPLX(DP_AMPL(K,I),KIND=16)
 
332
              ENDDO
 
333
            ENDDO
 
334
            DO I=1,NWAVEFUNCS
 
335
              DO J=1,MAXLWFSIZE+4
 
336
                W(J,I)=CMPLX(DPW(J,I),KIND=16)
 
337
              ENDDO
 
338
            ENDDO
 
339
          ENDIF
 
340
 
 
341
 3000     CONTINUE
 
342
          MP_UVCT_REQ_SO_DONE=.TRUE.
 
343
 
 
344
          IF (COMPUTE_INTEGRAND_IN_QP) THEN
 
345
 
 
346
            DO J=1,NBORNAMPS
 
347
              CTEMP = HEL_MULT*2.0E0_16*CONJG(AMP(J))
 
348
              DO I=1,NCTAMPS
 
349
                CFTOT=CMPLX(CF_N(I,J)/REAL(ABS(CF_D(I,J)),KIND=16)
 
350
     $           ,0.0E0_16,KIND=16)
 
351
                IF(CF_D(I,J).LT.0) CFTOT=CFTOT*IMAG1
 
352
                ITEMP = ML5SQSOINDEX(ML5SOINDEX_FOR_LOOP_AMP(I)
 
353
     $           ,ML5SOINDEX_FOR_BORN_AMP(J))
 
354
                IF (.NOT.FILTER_SO.OR.SQSO_TARGET.EQ.ITEMP) THEN
 
355
                  DO K=1,3
 
356
                    TEMP2 = REAL(CFTOT*AMPL(K,I)*CTEMP,KIND=16)
 
357
                    ANS(K,ITEMP)=ANS(K,ITEMP)+TEMP2
 
358
                    ANS(K,0)=ANS(K,0)+TEMP2
 
359
                  ENDDO
 
360
                ENDIF
 
361
              ENDDO
 
362
            ENDDO
 
363
 
 
364
          ELSE
 
365
 
 
366
            DO J=1,NBORNAMPS
 
367
              DP_CTEMP = HEL_MULT*2.0D0*DCONJG(DP_AMP(J))
 
368
              DO I=1,NCTAMPS
 
369
                DP_CFTOT=CMPLX(CF_N(I,J)/REAL(ABS(CF_D(I,J)),KIND=8)
 
370
     $           ,0.0D0,KIND=8)
 
371
                IF(CF_D(I,J).LT.0) DP_CFTOT=DP_CFTOT*DP_IMAG1
 
372
                ITEMP = ML5SQSOINDEX(ML5SOINDEX_FOR_LOOP_AMP(I)
 
373
     $           ,ML5SOINDEX_FOR_BORN_AMP(J))
 
374
                IF (.NOT.FILTER_SO.OR.SQSO_TARGET.EQ.ITEMP) THEN
 
375
                  DO K=1,3
 
376
                    DP_TEMP2 = REAL(DP_CFTOT*DP_AMPL(K,I)*DP_CTEMP
 
377
     $               ,KIND=8)
 
378
                    ANSDP(K,ITEMP)=ANSDP(K,ITEMP)+DP_TEMP2
 
379
                    ANSDP(K,0)=ANSDP(K,0)+DP_TEMP2
 
380
                  ENDDO
 
381
                ENDIF
 
382
              ENDDO
 
383
            ENDDO
 
384
 
 
385
          ENDIF
 
386
 
 
387
 
 
388
          IF (COMPUTE_INTEGRAND_IN_QP) THEN
 
389
 
 
390
            CALL MP_COEF_CONSTRUCTION_1(MP_P,NHEL,H,IC)
 
391
 
 
392
          ELSE
 
393
 
 
394
            CALL COEF_CONSTRUCTION_1(P,NHEL,H,IC)
 
395
 
 
396
C           Copy back to the coefficients computed in DP in the QP
 
397
C            containers
 
398
            DO I=0,LOOPMAXCOEFS-1
 
399
              DO K=1,NLOOPGROUPS
 
400
                DO J=1,NSQUAREDSO
 
401
                  LOOPCOEFS(I,J,K)=CMPLX(DP_LOOPCOEFS(I,J,K),KIND=16)
 
402
                ENDDO
 
403
              ENDDO
 
404
            ENDDO
 
405
          ENDIF
 
406
 
 
407
 4000     CONTINUE
 
408
          MP_LOOP_REQ_SO_DONE=.TRUE.
 
409
 
 
410
 
 
411
C         Copy the qp wfs to the dp ones as they are used to setup the
 
412
C          CT calls.
 
413
C         This needs to be done once since only the momenta of these
 
414
C          WF matters.
 
415
          IF(.NOT.DPW_COPIED.AND.COMPUTE_INTEGRAND_IN_QP) THEN
 
416
            DO I=1,NWAVEFUNCS
 
417
              DO J=1,MAXLWFSIZE+4
 
418
                DPW(J,I)=CMPLX(W(J,I),KIND=8)
 
419
              ENDDO
 
420
            ENDDO
 
421
            DPW_COPIED=.TRUE.
 
422
          ENDIF
 
423
 
 
424
 
 
425
 
 
426
 
 
427
 
 
428
        ENDIF
 
429
      ENDDO
 
430
 
 
431
 
 
432
C     If we were not computing the integrand in QP, then we were
 
433
C      already updating ANSDP all along, so that fetching it here from
 
434
C      the QP ANS(:,:) should not be done.
 
435
      IF (COMPUTE_INTEGRAND_IN_QP) THEN
 
436
        DO I=1,3
 
437
          DO J=0,NSQUAREDSO
 
438
            ANSDP(I,J)=REAL(ANS(I,J),KIND=8)
 
439
          ENDDO
 
440
        ENDDO
 
441
      ENDIF
 
442
 
 
443
C     Grouping of loop diagrams now done directly when creating the
 
444
C      LOOPCOEFS.
 
445
C     If some kind of coefficient merging was done above, do not
 
446
C      forget to copy back the LOOPCOEFS merged into DP_LOOPCOEFS if
 
447
C      COMPUTE_INTEGRAND_IN_QP is False.
 
448
 
 
449
      END
 
450