~maddevelopers/mg5amcnlo/2.7.1.3

« back to all changes in this revision

Viewing changes to tests/input_files/IOTestsComparison/short_ML_SMQCD_optimized/ddx_ttx/CT_interface.f

  • Committer: olivier Mattelaer
  • Date: 2016-05-12 11:00:18 UTC
  • mfrom: (262.1.150 2.3.4)
  • Revision ID: olivier.mattelaer@uclouvain.be-20160512110018-sevb79f0wm4g8mpp
pass to 2.4.0

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
C     ===========================================
 
2
C     ===== Beginning of CutTools Interface =====
 
3
C     ===========================================
1
4
      SUBROUTINE ML5_0_CTLOOP(NLOOPLINE,PL,M2L,RANK,RES,STABLE)
2
5
C     
3
6
C     Generated by MadGraph5_aMC@NLO v. %(version)s, %(date)s
6
9
C     
7
10
C     Interface between MG5 and CutTools.
8
11
C     
9
 
C     Process: d d~ > t t~ QED=0 QCD=2 [ virt = QCD ]
 
12
C     Process: d d~ > t t~ QED=0 QCD<=2 [ virt = QCD ]
10
13
C     
11
14
C     
12
15
C     CONSTANTS 
23
26
C     
24
27
      INTEGER NLOOPLINE, RANK
25
28
      REAL*8 PL(0:3,NLOOPLINE)
26
 
      REAL*8 PCT(0:3,0:NLOOPLINE-1)
 
29
      REAL*8 PCT(0:3,0:NLOOPLINE-1),ABSPCT(0:3)
 
30
      REAL*8 REF_P
27
31
      COMPLEX*16 M2L(NLOOPLINE)
28
32
      COMPLEX*16 M2LCT(0:NLOOPLINE-1)
29
33
      COMPLEX*16 RES(3)
33
37
C     
34
38
      COMPLEX*16 R1, ACC
35
39
      INTEGER I, J, K
36
 
      LOGICAL CTINIT, TIRINIT, GOLEMINIT
37
 
      COMMON/REDUCTIONCODEINIT/CTINIT,TIRINIT,GOLEMINIT
 
40
      LOGICAL CTINIT, TIRINIT, GOLEMINIT, SAMURAIINIT, NINJAINIT
 
41
      COMMON/REDUCTIONCODEINIT/CTINIT,TIRINIT,GOLEMINIT,SAMURAIINIT
 
42
     $ ,NINJAINIT
38
43
C     
39
44
C     EXTERNAL FUNCTIONS
40
45
C     
71
76
 
72
77
C     CONVERT THE MOMENTA FLOWING IN THE LOOP LINES TO CT CONVENTIONS
73
78
      DO I=0,3
 
79
        ABSPCT(I)=0.D0
74
80
        DO J=0,(NLOOPLINE-1)
75
81
          PCT(I,J)=0.D0
76
82
        ENDDO
78
84
      DO I=0,3
79
85
        DO J=1,NLOOPLINE
80
86
          PCT(I,0)=PCT(I,0)+PL(I,J)
 
87
          ABSPCT(I)=ABSPCT(I)+ABS(PL(I,J))
81
88
        ENDDO
82
89
      ENDDO
83
 
      IF (CHECKPCONSERVATION) THEN
84
 
        IF (PCT(0,0).GT.1.D-6) THEN
85
 
          WRITE(*,*) 'energy is not conserved ',PCT(0,0)
86
 
          STOP 'energy is not conserved'
87
 
        ELSEIF (PCT(1,0).GT.1.D-6) THEN
88
 
          WRITE(*,*) 'px is not conserved ',PCT(1,0)
89
 
          STOP 'px is not conserved'
90
 
        ELSEIF (PCT(2,0).GT.1.D-6) THEN
91
 
          WRITE(*,*) 'py is not conserved ',PCT(2,0)
92
 
          STOP 'py is not conserved'
93
 
        ELSEIF (PCT(3,0).GT.1.D-6) THEN
94
 
          WRITE(*,*) 'pz is not conserved ',PCT(3,0)
95
 
          STOP 'pz is not conserved'
 
90
      REF_P = MAX(ABSPCT(0), ABSPCT(1),ABSPCT(2),ABSPCT(3))
 
91
      DO I=0,3
 
92
        ABSPCT(I) = MAX(REF_P*1E-6, ABSPCT(I))
 
93
      ENDDO
 
94
      IF (CHECKPCONSERVATION.AND.REF_P.GT.1D-8) THEN
 
95
        IF ((PCT(0,0)/ABSPCT(0)).GT.1.D-6) THEN
 
96
          WRITE(*,*) 'energy is not conserved (flag:CT95)',PCT(0,0)
 
97
          STOP 'energy is not conserved (flag:CT95)'
 
98
        ELSEIF ((PCT(1,0)/ABSPCT(1)).GT.1.D-6) THEN
 
99
          WRITE(*,*) 'px is not conserved (flag:CT95)',PCT(1,0)
 
100
          STOP 'px is not conserved (flag:CT95)'
 
101
        ELSEIF ((PCT(2,0)/ABSPCT(2)).GT.1.D-6) THEN
 
102
          WRITE(*,*) 'py is not conserved (flag:CT95)',PCT(2,0)
 
103
          STOP 'py is not conserved (flag:CT95)'
 
104
        ELSEIF ((PCT(3,0)/ABSPCT(3)).GT.1.D-6) THEN
 
105
          WRITE(*,*) 'pz is not conserved (flag:CT95)',PCT(3,0)
 
106
          STOP 'pz is not conserved (flag:CT95)'
96
107
        ENDIF
97
108
      ENDIF
98
109
      DO I=0,3
108
119
      RES(1)=NORMALIZATION*2.0D0*DBLE(RES(1))
109
120
      RES(2)=NORMALIZATION*2.0D0*DBLE(RES(2))
110
121
      RES(3)=NORMALIZATION*2.0D0*DBLE(RES(3))
111
 
C     WRITE(*,*) 'Loop ID',ID,' =',RES(1),RES(2),RES(3)
 
122
C     WRITE(*,*) 'CutTools: Loop ID',ID,' =',RES(1),RES(2),RES(3)
112
123
      END
113
124
 
114
125
      SUBROUTINE ML5_0_INITCT()
151
162
 
152
163
      END
153
164
 
154
 
      SUBROUTINE ML5_0_LOOP_4(W1, W2, W3, W4, M1, M2, M3, M4,  RANK
155
 
     $ , SQUAREDSOINDEX, LOOPNUM)
 
165
      SUBROUTINE ML5_0_BUILD_KINEMATIC_MATRIX(NLOOPLINE,P_LOOP,M2L
 
166
     $ ,S_MAT)
 
167
C     
 
168
C     Helper function that compute the loop kinematic matrix with
 
169
C      proper thresholds
 
170
C     NLOOPLINE : Number of loop lines
 
171
C     P_LOOP    : List of external momenta running in the loop, i.e.
 
172
C      q_i in the denominator (l_i+q_i)**2-m_i**2
 
173
C     M2L       : List of complex-valued masses running in the loop.
 
174
C     S_MAT(N,N): Kinematic matrix output.
 
175
C     
 
176
C     ARGUMENTS
 
177
C     
 
178
      INTEGER NLOOPLINE
 
179
      REAL*8 P_LOOP(NLOOPLINE,0:3)
 
180
      COMPLEX*16 M2L(NLOOPLINE)
 
181
      COMPLEX*16 S_MAT(NLOOPLINE,NLOOPLINE)
 
182
C     
 
183
C     GLOBAL VARIABLES
 
184
C     
 
185
      INCLUDE 'MadLoopParams.inc'
 
186
C     
 
187
C     LOCAL VARIABLES
 
188
C     
 
189
      INTEGER I,J,K
 
190
      COMPLEX*16 DIFFSQ
 
191
      REAL*8 REF_NORMALIZATION
 
192
 
 
193
C     ----------
 
194
C     BEGIN CODE
 
195
C     ----------
 
196
 
 
197
      DO I=1,NLOOPLINE
 
198
        DO J=1,NLOOPLINE
 
199
 
 
200
          IF(I.EQ.J)THEN
 
201
            S_MAT(I,J)=-(M2L(I)+M2L(J))
 
202
          ELSE
 
203
            DIFFSQ = (DCMPLX(P_LOOP(I,0),0.0D0)-DCMPLX(P_LOOP(J,0)
 
204
     $       ,0.0D0))**2
 
205
            DO K=1,3
 
206
              DIFFSQ = DIFFSQ - (DCMPLX(P_LOOP(I,K),0.0D0)
 
207
     $         -DCMPLX(P_LOOP(J,K),0.0D0))**2
 
208
            ENDDO
 
209
C           Default value of the kinematic matrix
 
210
            S_MAT(I,J)=DIFFSQ-M2L(I)-M2L(J)
 
211
C           And we now test various thresholds. Normaly, at most one
 
212
C            applies.
 
213
            IF(ABS(M2L(I)).NE.0.0D0)THEN
 
214
              IF(ABS((DIFFSQ-M2L(I))/M2L(I)).LT.OSTHRES)THEN
 
215
                S_MAT(I,J)=-M2L(J)
 
216
              ENDIF
 
217
            ENDIF
 
218
            IF(ABS(M2L(J)).NE.0.0D0)THEN
 
219
              IF(ABS((DIFFSQ-M2L(J))/M2L(J)).LT.OSTHRES)THEN
 
220
                S_MAT(I,J)=-M2L(I)
 
221
              ENDIF
 
222
            ENDIF
 
223
C           Choose what seems the most appropriate way to compare
 
224
C           massless onshellness.
 
225
            REF_NORMALIZATION=0.0D0
 
226
C           Here, we chose to base the threshold only on the energy
 
227
C            component
 
228
            DO K=0,0
 
229
              REF_NORMALIZATION = REF_NORMALIZATION + ABS(P_LOOP(I,K))
 
230
     $          + ABS(P_LOOP(J,K))
 
231
            ENDDO
 
232
            REF_NORMALIZATION = (REF_NORMALIZATION/2.0D0)**2
 
233
            IF(REF_NORMALIZATION.NE.0.0D0)THEN
 
234
              IF(ABS(DIFFSQ/REF_NORMALIZATION).LT.OSTHRES)THEN
 
235
                S_MAT(I,J)=-(M2L(I)+M2L(J))
 
236
              ENDIF
 
237
            ENDIF
 
238
          ENDIF
 
239
 
 
240
        ENDDO
 
241
      ENDDO
 
242
 
 
243
      END
 
244
 
 
245
      SUBROUTINE ML5_0_MP_BUILD_KINEMATIC_MATRIX(NLOOPLINE,P_LOOP,M2L
 
246
     $ ,S_MAT)
 
247
C     
 
248
C     Helper function that compute the loop kinematic matrix with
 
249
C      proper thresholds
 
250
C     NLOOPLINE : Number of loop lines
 
251
C     P_LOOP    : List of external momenta running in the loop, i.e.
 
252
C      q_i in the denominator (l_i+q_i)**2-m_i**2
 
253
C     M2L       : List of complex-valued masses running in the loop.
 
254
C     S_MAT(N,N): Kinematic matrix output.
 
255
C     
 
256
C     ARGUMENTS
 
257
C     
 
258
      INTEGER NLOOPLINE
 
259
      REAL*16 P_LOOP(NLOOPLINE,0:3)
 
260
      COMPLEX*32 M2L(NLOOPLINE)
 
261
      COMPLEX*32 S_MAT(NLOOPLINE,NLOOPLINE)
 
262
C     
 
263
C     GLOBAL VARIABLES
 
264
C     
 
265
      INCLUDE 'MadLoopParams.inc'
 
266
C     
 
267
C     LOCAL VARIABLES
 
268
C     
 
269
      INTEGER I,J,K
 
270
      COMPLEX*32 DIFFSQ
 
271
      REAL*16 REF_NORMALIZATION
 
272
 
 
273
C     ----------
 
274
C     BEGIN CODE
 
275
C     ----------
 
276
 
 
277
      DO I=1,NLOOPLINE
 
278
        DO J=1,NLOOPLINE
 
279
 
 
280
          IF(I.EQ.J)THEN
 
281
            S_MAT(I,J)=-(M2L(I)+M2L(J))
 
282
          ELSE
 
283
            DIFFSQ = (CMPLX(P_LOOP(I,0),0.0E0_16,KIND=16)
 
284
     $       -CMPLX(P_LOOP(J,0),0.0E0_16,KIND=16))**2
 
285
            DO K=1,3
 
286
              DIFFSQ = DIFFSQ - (CMPLX(P_LOOP(I,K),0.0E0_16,KIND=16)
 
287
     $         -CMPLX(P_LOOP(J,K),0.0E0_16,KIND=16))**2
 
288
            ENDDO
 
289
C           Default value of the kinematic matrix
 
290
            S_MAT(I,J)=DIFFSQ-M2L(I)-M2L(J)
 
291
C           And we now test various thresholds. Normaly, at most one
 
292
C            applies.
 
293
            IF(ABS(M2L(I)).NE.0.0E0_16)THEN
 
294
              IF(ABS((DIFFSQ-M2L(I))/M2L(I)).LT.OSTHRES)THEN
 
295
                S_MAT(I,J)=-M2L(J)
 
296
              ENDIF
 
297
            ENDIF
 
298
            IF(ABS(M2L(J)).NE.0.0E0_16)THEN
 
299
              IF(ABS((DIFFSQ-M2L(J))/M2L(J)).LT.OSTHRES)THEN
 
300
                S_MAT(I,J)=-M2L(I)
 
301
              ENDIF
 
302
            ENDIF
 
303
C           Choose what seems the most appropriate way to compare
 
304
C           massless onshellness.
 
305
            REF_NORMALIZATION=0.0E0_16
 
306
C           Here, we chose to base the threshold only on the energy
 
307
C            component
 
308
            DO K=0,0
 
309
              REF_NORMALIZATION = REF_NORMALIZATION + ABS(P_LOOP(I,K))
 
310
     $          + ABS(P_LOOP(J,K))
 
311
            ENDDO
 
312
            REF_NORMALIZATION = (REF_NORMALIZATION/2.0E0_16)**2
 
313
            IF(REF_NORMALIZATION.NE.0.0E0_16)THEN
 
314
              IF(ABS(DIFFSQ/REF_NORMALIZATION).LT.OSTHRES)THEN
 
315
                S_MAT(I,J)=-(M2L(I)+M2L(J))
 
316
              ENDIF
 
317
            ENDIF
 
318
          ENDIF
 
319
 
 
320
        ENDDO
 
321
      ENDDO
 
322
 
 
323
      END
 
324
 
 
325
 
 
326
 
 
327
      SUBROUTINE ML5_0_LOOP_4(W1, W2, W3, W4, M1, M2, M3, M4,  RANK,
 
328
     $  SQUAREDSOINDEX, LOOPNUM)
156
329
      INTEGER    NEXTERNAL
157
330
      PARAMETER (NEXTERNAL=4)
158
331
      INTEGER    NLOOPLINE
178
351
C     LOCAL VARIABLES 
179
352
C     
180
353
      REAL*8 PL(0:3,NLOOPLINE)
 
354
      REAL*16 MP_PL(0:3,NLOOPLINE)
181
355
      COMPLEX*16 M2L(NLOOPLINE)
182
356
      INTEGER PAIRING(NLOOPLINE),WE(4)
183
357
      INTEGER I, J, K, TEMP,I_LIB
204
378
 
205
379
      COMPLEX*16 W(20,NWAVEFUNCS)
206
380
      COMMON/ML5_0_W/W
 
381
      COMPLEX*32 MP_W(20,NWAVEFUNCS)
 
382
      COMMON/ML5_0_MP_W/MP_W
 
383
 
207
384
      REAL*8 LSCALE
208
385
      INTEGER CTMODE
209
386
      COMMON/ML5_0_CT/LSCALE,CTMODE
214
391
C     BEGIN CODE
215
392
C     ----------
216
393
 
 
394
C     Determine it uses qp or not
 
395
      DOING_QP = (CTMODE.GE.4)
 
396
 
217
397
      IF (CHECKPHASE.OR.(.NOT.HELDOUBLECHECKED).OR.GOODAMP(SQUAREDSOIND
218
 
     $ EX,LOOPNUM)) THEN
 
398
     $EX,LOOPNUM)) THEN
219
399
        WE(1)=W1
220
400
        WE(2)=W2
221
401
        WE(3)=W3
235
415
          TEMP=1
236
416
          DO J=1,NLOOPLINE
237
417
            PL(I,J)=0.D0
 
418
            IF (DOING_QP) THEN
 
419
              MP_PL(I,J)=0.0E+0_16
 
420
            ENDIF
238
421
            DO K=TEMP,(TEMP+PAIRING(J)-1)
239
422
              PL(I,J)=PL(I,J)-DBLE(W(1+I,WE(K)))
 
423
              IF (DOING_QP) THEN
 
424
                MP_PL(I,J)=MP_PL(I,J)-REAL(MP_W(1+I,WE(K)),KIND=16)
 
425
              ENDIF
240
426
            ENDDO
241
427
            TEMP=TEMP+PAIRING(J)
242
428
          ENDDO
253
439
            EXIT
254
440
          ENDIF
255
441
        ENDDO
256
 
C       Determine it uses qp or not
257
 
        DOING_QP=.FALSE.
258
 
        IF(CTMODE.GE.4)DOING_QP=.TRUE.
259
442
C       Choose the correct loop library
260
443
        CALL ML5_0_CHOOSE_LOOPLIB(LIBINDEX,NLOOPLINE,RANK,COMPLEX_MASS
261
 
     $   ,DOING_QP,I_LIB)
 
444
     $   ,ID,DOING_QP,I_LIB)
262
445
        IF(MLREDUCTIONLIB(I_LIB).EQ.1)THEN
263
 
C         USE CUTTOOLS
264
 
          CALL ML5_0_CTLOOP(NLOOPLINE,PL,M2L,RANK,LOOPRES(1,SQUAREDSOIN
265
 
     $     DEX,LOOPNUM),S(SQUAREDSOINDEX,LOOPNUM))
 
446
C         CutTools is used
 
447
          CALL ML5_0_CTLOOP(NLOOPLINE,PL,M2L,RANK,LOOPRES(1
 
448
     $     ,SQUAREDSOINDEX,LOOPNUM),S(SQUAREDSOINDEX,LOOPNUM))
266
449
        ELSE
267
 
C         USE TIR
 
450
C         Tensor Integral Reduction is used 
268
451
          CALL ML5_0_TIRLOOP(SQUAREDSOINDEX,LOOPNUM,I_LIB,NLOOPLINE,PL
269
 
     $     ,M2L,RANK,LOOPRES(1,SQUAREDSOINDEX,LOOPNUM),S(SQUAREDSOINDEX
270
 
     $     ,LOOPNUM))
 
452
     $     ,M2L,RANK,LOOPRES(1,SQUAREDSOINDEX,LOOPNUM)
 
453
     $     ,S(SQUAREDSOINDEX,LOOPNUM))
271
454
        ENDIF
272
455
      ELSE
273
456
        LOOPRES(1,SQUAREDSOINDEX,LOOPNUM)=(0.0D0,0.0D0)
277
460
      ENDIF
278
461
      END
279
462
 
280
 
      SUBROUTINE ML5_0_LOOP_3(W1, W2, W3, M1, M2, M3,  RANK, SQUAREDSOI
281
 
     $ NDEX, LOOPNUM)
 
463
      SUBROUTINE ML5_0_LOOP_3(W1, W2, W3, M1, M2, M3,  RANK,
 
464
     $  SQUAREDSOINDEX, LOOPNUM)
282
465
      INTEGER    NEXTERNAL
283
466
      PARAMETER (NEXTERNAL=4)
284
467
      INTEGER    NLOOPLINE
304
487
C     LOCAL VARIABLES 
305
488
C     
306
489
      REAL*8 PL(0:3,NLOOPLINE)
 
490
      REAL*16 MP_PL(0:3,NLOOPLINE)
307
491
      COMPLEX*16 M2L(NLOOPLINE)
308
492
      INTEGER PAIRING(NLOOPLINE),WE(3)
309
493
      INTEGER I, J, K, TEMP,I_LIB
330
514
 
331
515
      COMPLEX*16 W(20,NWAVEFUNCS)
332
516
      COMMON/ML5_0_W/W
 
517
      COMPLEX*32 MP_W(20,NWAVEFUNCS)
 
518
      COMMON/ML5_0_MP_W/MP_W
 
519
 
333
520
      REAL*8 LSCALE
334
521
      INTEGER CTMODE
335
522
      COMMON/ML5_0_CT/LSCALE,CTMODE
340
527
C     BEGIN CODE
341
528
C     ----------
342
529
 
 
530
C     Determine it uses qp or not
 
531
      DOING_QP = (CTMODE.GE.4)
 
532
 
343
533
      IF (CHECKPHASE.OR.(.NOT.HELDOUBLECHECKED).OR.GOODAMP(SQUAREDSOIND
344
 
     $ EX,LOOPNUM)) THEN
 
534
     $EX,LOOPNUM)) THEN
345
535
        WE(1)=W1
346
536
        WE(2)=W2
347
537
        WE(3)=W3
359
549
          TEMP=1
360
550
          DO J=1,NLOOPLINE
361
551
            PL(I,J)=0.D0
 
552
            IF (DOING_QP) THEN
 
553
              MP_PL(I,J)=0.0E+0_16
 
554
            ENDIF
362
555
            DO K=TEMP,(TEMP+PAIRING(J)-1)
363
556
              PL(I,J)=PL(I,J)-DBLE(W(1+I,WE(K)))
 
557
              IF (DOING_QP) THEN
 
558
                MP_PL(I,J)=MP_PL(I,J)-REAL(MP_W(1+I,WE(K)),KIND=16)
 
559
              ENDIF
364
560
            ENDDO
365
561
            TEMP=TEMP+PAIRING(J)
366
562
          ENDDO
377
573
            EXIT
378
574
          ENDIF
379
575
        ENDDO
380
 
C       Determine it uses qp or not
381
 
        DOING_QP=.FALSE.
382
 
        IF(CTMODE.GE.4)DOING_QP=.TRUE.
383
576
C       Choose the correct loop library
384
577
        CALL ML5_0_CHOOSE_LOOPLIB(LIBINDEX,NLOOPLINE,RANK,COMPLEX_MASS
385
 
     $   ,DOING_QP,I_LIB)
 
578
     $   ,ID,DOING_QP,I_LIB)
386
579
        IF(MLREDUCTIONLIB(I_LIB).EQ.1)THEN
387
 
C         USE CUTTOOLS
388
 
          CALL ML5_0_CTLOOP(NLOOPLINE,PL,M2L,RANK,LOOPRES(1,SQUAREDSOIN
389
 
     $     DEX,LOOPNUM),S(SQUAREDSOINDEX,LOOPNUM))
 
580
C         CutTools is used
 
581
          CALL ML5_0_CTLOOP(NLOOPLINE,PL,M2L,RANK,LOOPRES(1
 
582
     $     ,SQUAREDSOINDEX,LOOPNUM),S(SQUAREDSOINDEX,LOOPNUM))
390
583
        ELSE
391
 
C         USE TIR
 
584
C         Tensor Integral Reduction is used 
392
585
          CALL ML5_0_TIRLOOP(SQUAREDSOINDEX,LOOPNUM,I_LIB,NLOOPLINE,PL
393
 
     $     ,M2L,RANK,LOOPRES(1,SQUAREDSOINDEX,LOOPNUM),S(SQUAREDSOINDEX
394
 
     $     ,LOOPNUM))
 
586
     $     ,M2L,RANK,LOOPRES(1,SQUAREDSOINDEX,LOOPNUM)
 
587
     $     ,S(SQUAREDSOINDEX,LOOPNUM))
395
588
        ENDIF
396
589
      ELSE
397
590
        LOOPRES(1,SQUAREDSOINDEX,LOOPNUM)=(0.0D0,0.0D0)
401
594
      ENDIF
402
595
      END
403
596
 
404
 
      SUBROUTINE ML5_0_LOOP_2(W1, W2, M1, M2,  RANK, SQUAREDSOINDEX
405
 
     $ , LOOPNUM)
 
597
      SUBROUTINE ML5_0_LOOP_2(W1, W2, M1, M2,  RANK, SQUAREDSOINDEX,
 
598
     $  LOOPNUM)
406
599
      INTEGER    NEXTERNAL
407
600
      PARAMETER (NEXTERNAL=4)
408
601
      INTEGER    NLOOPLINE
428
621
C     LOCAL VARIABLES 
429
622
C     
430
623
      REAL*8 PL(0:3,NLOOPLINE)
 
624
      REAL*16 MP_PL(0:3,NLOOPLINE)
431
625
      COMPLEX*16 M2L(NLOOPLINE)
432
626
      INTEGER PAIRING(NLOOPLINE),WE(2)
433
627
      INTEGER I, J, K, TEMP,I_LIB
454
648
 
455
649
      COMPLEX*16 W(20,NWAVEFUNCS)
456
650
      COMMON/ML5_0_W/W
 
651
      COMPLEX*32 MP_W(20,NWAVEFUNCS)
 
652
      COMMON/ML5_0_MP_W/MP_W
 
653
 
457
654
      REAL*8 LSCALE
458
655
      INTEGER CTMODE
459
656
      COMMON/ML5_0_CT/LSCALE,CTMODE
464
661
C     BEGIN CODE
465
662
C     ----------
466
663
 
 
664
C     Determine it uses qp or not
 
665
      DOING_QP = (CTMODE.GE.4)
 
666
 
467
667
      IF (CHECKPHASE.OR.(.NOT.HELDOUBLECHECKED).OR.GOODAMP(SQUAREDSOIND
468
 
     $ EX,LOOPNUM)) THEN
 
668
     $EX,LOOPNUM)) THEN
469
669
        WE(1)=W1
470
670
        WE(2)=W2
471
671
        M2L(1)=M2**2
481
681
          TEMP=1
482
682
          DO J=1,NLOOPLINE
483
683
            PL(I,J)=0.D0
 
684
            IF (DOING_QP) THEN
 
685
              MP_PL(I,J)=0.0E+0_16
 
686
            ENDIF
484
687
            DO K=TEMP,(TEMP+PAIRING(J)-1)
485
688
              PL(I,J)=PL(I,J)-DBLE(W(1+I,WE(K)))
 
689
              IF (DOING_QP) THEN
 
690
                MP_PL(I,J)=MP_PL(I,J)-REAL(MP_W(1+I,WE(K)),KIND=16)
 
691
              ENDIF
486
692
            ENDDO
487
693
            TEMP=TEMP+PAIRING(J)
488
694
          ENDDO
499
705
            EXIT
500
706
          ENDIF
501
707
        ENDDO
502
 
C       Determine it uses qp or not
503
 
        DOING_QP=.FALSE.
504
 
        IF(CTMODE.GE.4)DOING_QP=.TRUE.
505
708
C       Choose the correct loop library
506
709
        CALL ML5_0_CHOOSE_LOOPLIB(LIBINDEX,NLOOPLINE,RANK,COMPLEX_MASS
507
 
     $   ,DOING_QP,I_LIB)
 
710
     $   ,ID,DOING_QP,I_LIB)
508
711
        IF(MLREDUCTIONLIB(I_LIB).EQ.1)THEN
509
 
C         USE CUTTOOLS
510
 
          CALL ML5_0_CTLOOP(NLOOPLINE,PL,M2L,RANK,LOOPRES(1,SQUAREDSOIN
511
 
     $     DEX,LOOPNUM),S(SQUAREDSOINDEX,LOOPNUM))
 
712
C         CutTools is used
 
713
          CALL ML5_0_CTLOOP(NLOOPLINE,PL,M2L,RANK,LOOPRES(1
 
714
     $     ,SQUAREDSOINDEX,LOOPNUM),S(SQUAREDSOINDEX,LOOPNUM))
512
715
        ELSE
513
 
C         USE TIR
 
716
C         Tensor Integral Reduction is used 
514
717
          CALL ML5_0_TIRLOOP(SQUAREDSOINDEX,LOOPNUM,I_LIB,NLOOPLINE,PL
515
 
     $     ,M2L,RANK,LOOPRES(1,SQUAREDSOINDEX,LOOPNUM),S(SQUAREDSOINDEX
516
 
     $     ,LOOPNUM))
 
718
     $     ,M2L,RANK,LOOPRES(1,SQUAREDSOINDEX,LOOPNUM)
 
719
     $     ,S(SQUAREDSOINDEX,LOOPNUM))
517
720
        ENDIF
518
721
      ELSE
519
722
        LOOPRES(1,SQUAREDSOINDEX,LOOPNUM)=(0.0D0,0.0D0)