← Back to branch summary

~madteam/mg5amcnlo/series2.0

« back to all changes in this revision

Viewing changes to tests/input_files/IOTestsComparison/short_ML_SMQCD_optimized/ddx_ttx/loop_matrix.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:
tests/input_files/IOTestsComparison/short_ML_SMQCD_optimized/ddx_ttx/loop_matrix.f
12
12
C     and helicities for the point in phase space P(0:3,NEXTERNAL)
13
13
C     and external lines W(0:6,NEXTERNAL)
14
14
C     
15
 
C     Process: d d~ > t t~ QED=0 QCD=2 [ virt = QCD ]
 
15
C     Process: d d~ > t t~ QED=0 QCD<=2 [ virt = QCD ]
 
16
C     
 
17
C     Modules
 
18
C     
 
19
      USE ML5_0_POLYNOMIAL_CONSTANTS
16
20
C     
17
21
      IMPLICIT NONE
18
22
C     
52
56
      PARAMETER (NEXTERNAL=4)
53
57
      INTEGER    NWAVEFUNCS,NLOOPWAVEFUNCS
54
58
      PARAMETER (NWAVEFUNCS=6,NLOOPWAVEFUNCS=26)
55
 
      INTEGER MAXLWFSIZE
56
 
      PARAMETER (MAXLWFSIZE=4)
57
 
      INTEGER LOOPMAXCOEFS, VERTEXMAXCOEFS
58
 
      PARAMETER (LOOPMAXCOEFS=15, VERTEXMAXCOEFS=5)
59
59
      INTEGER    NCOMB
60
60
      PARAMETER (NCOMB=16)
61
61
      REAL*8     ZERO
75
75
      INTEGER NSQUAREDSOP1
76
76
      PARAMETER (NSQUAREDSOP1=NSQUAREDSO+1)
77
77
C     The total number of loop reduction libraries
78
 
C     At present, there are only CutTools,PJFry++,IREGI,Golem95
 
78
C     At present, there are only CutTools,PJFry++,IREGI,Golem95,Samurai
 
79
C      and Ninja
79
80
      INTEGER NLOOPLIB
80
 
      PARAMETER (NLOOPLIB=4)
81
 
C     Only CutTools provides QP
 
81
      PARAMETER (NLOOPLIB=6)
 
82
C     Only CutTools or possibly Ninja (if installed with qp support)
 
83
C      provide QP
82
84
      INTEGER QP_NLOOPLIB
83
85
      PARAMETER (QP_NLOOPLIB=1)
84
86
      INTEGER MAXSTABILITYLENGTH
160
162
      REAL*8 BORNBUFF(0:NSQSO_BORN),TMPR
161
163
      REAL*8 BUFFR(3,0:NSQUAREDSO),BUFFR_BIS(3,0:NSQUAREDSO),TEMP(0:3
162
164
     $ ,0:NSQUAREDSO),TEMP1(0:NSQUAREDSO)
 
165
      COMPLEX*16 CTEMP
163
166
      REAL*8 TEMP2
164
167
      COMPLEX*16 COEFS(MAXLWFSIZE,0:VERTEXMAXCOEFS-1,MAXLWFSIZE)
165
168
      COMPLEX*16 CFTOT
170
173
      DATA ((LOOPFILTERBUFF(J,I),J=1,NSQUAREDSO),I=1,NLOOPGROUPS)
171
174
     $ /NSQSOXNLG*.FALSE./
172
175
 
173
 
      LOGICAL AUTOMATIC_TIR_CACHE_CLEARING
174
 
      DATA AUTOMATIC_TIR_CACHE_CLEARING/.TRUE./
175
 
      COMMON/ML5_0_RUNTIME_OPTIONS/AUTOMATIC_TIR_CACHE_CLEARING
 
176
      LOGICAL AUTOMATIC_CACHE_CLEARING
 
177
      DATA AUTOMATIC_CACHE_CLEARING/.TRUE./
 
178
      COMMON/ML5_0_RUNTIME_OPTIONS/AUTOMATIC_CACHE_CLEARING
176
179
 
177
180
      INTEGER IDEN
178
181
      DATA IDEN/36/
202
205
C     
203
206
C     GLOBAL VARIABLES
204
207
C     
 
208
      INCLUDE 'process_info.inc'
205
209
      INCLUDE 'coupl.inc'
206
210
      INCLUDE 'mp_coupl.inc'
207
211
      INCLUDE 'MadLoopParams.inc'
231
235
      COMMON/ML5_0_MP_DONE/MP_DONE
232
236
C     A FLAG TO DENOTE WHETHER THE CORRESPONDING LOOPLIBS ARE
233
237
C      AVAILABLE OR NOT
234
 
      LOGICAL LOOPLIBS_AVAILABLE(4)
235
 
      DATA LOOPLIBS_AVAILABLE/.TRUE.,.FALSE.,.FALSE.,.FALSE./
 
238
      LOGICAL LOOPLIBS_AVAILABLE(6)
 
239
      DATA LOOPLIBS_AVAILABLE/.TRUE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.
 
240
     $ ,.FALSE./
236
241
      COMMON/ML5_0_LOOPLIBS_AV/ LOOPLIBS_AVAILABLE
237
242
C     A FLAG TO DENOTE WHETHER THE CORRESPONDING DIRECTION TESTS
238
243
C      AVAILABLE OR NOT IN THE LOOPLIBS
239
 
C     PJFry++ and Golem95 do not support direction test
240
 
      LOGICAL LOOPLIBS_DIRECTEST(4)
241
 
      DATA LOOPLIBS_DIRECTEST /.TRUE.,.TRUE.,.TRUE.,.TRUE./
242
 
 
 
244
      LOGICAL LOOPLIBS_DIRECTEST(6)
 
245
      DATA LOOPLIBS_DIRECTEST /.TRUE.,.TRUE.,.TRUE.,.TRUE.,.TRUE.
 
246
     $ ,.TRUE./
 
247
C     Specifying for which reduction tool quadruple precision is
 
248
C      available.
 
249
C     The index 0 is dummy and simply means that the corresponding
 
250
C      loop_library is not available
 
251
C     in which case neither is its quadruple precision version.
 
252
      LOGICAL LOOPLIBS_QPAVAILABLE(0:6)
 
253
      DATA LOOPLIBS_QPAVAILABLE /.FALSE.,.TRUE.,.FALSE.,.FALSE.
 
254
     $ ,.FALSE.,.FALSE.,.FALSE./
243
255
C     PS CAN POSSIBILY BE PASSED THROUGH IMPROVE_PS BUT IS NOT
244
256
C      MODIFIED FOR THE PURPOSE OF THE STABILITY TEST
245
257
C     EVEN THOUGH THEY ARE PUT IN COMMON BLOCK, FOR NOW THEY ARE NOT
304
316
      DATA CTCALL_REQ_SO_DONE/.FALSE./
305
317
      DATA FILTER_SO/.FALSE./
306
318
      COMMON/ML5_0_SO_REQS/UVCT_REQ_SO_DONE,MP_UVCT_REQ_SO_DONE
307
 
     $ ,CT_REQ_SO_DONE,MP_CT_REQ_SO_DONE,LOOP_REQ_SO_DONE,MP_LOOP_REQ_S
308
 
     $ O_DONE,CTCALL_REQ_SO_DONE,FILTER_SO
 
319
     $ ,CT_REQ_SO_DONE,MP_CT_REQ_SO_DONE,LOOP_REQ_SO_DONE
 
320
     $ ,MP_LOOP_REQ_SO_DONE,CTCALL_REQ_SO_DONE,FILTER_SO
309
321
 
310
322
C     Allows to forbid the zero helicity double check, no matter the
311
323
C      value in MadLoopParams.dat
334
346
      COMPLEX*32 MPW(20,NWAVEFUNCS)
335
347
      COMMON/ML5_0_MP_W/MPW
336
348
 
337
 
      COMPLEX*16 WL(MAXLWFSIZE,0:LOOPMAXCOEFS-1,MAXLWFSIZE,0:NLOOPWAVEF
338
 
     $ UNCS)
 
349
      COMPLEX*16 WL(MAXLWFSIZE,0:LOOPMAXCOEFS-1,MAXLWFSIZE
 
350
     $ ,0:NLOOPWAVEFUNCS)
339
351
      COMPLEX*16 PL(0:3,0:NLOOPWAVEFUNCS)
340
352
      COMMON/ML5_0_WL/WL,PL
341
353
 
388
400
 
389
401
C     This variable controls the *local* initialization of this
390
402
C      particular SubProcess.
391
 
C     For example, the reading of the filters must be done independentl
392
 
C     y by each SubProcess.
 
403
C     For example, the reading of the filters must be done
 
404
C      independently by each SubProcess.
393
405
      LOGICAL LOCAL_ML_INIT
394
406
      DATA LOCAL_ML_INIT/.TRUE./
395
407
 
 
408
      LOGICAL WARNED_LORENTZ_STAB_TEST_OFF
 
409
      DATA WARNED_LORENTZ_STAB_TEST_OFF/.FALSE./
 
410
      INTEGER NROTATIONS_DP_BU,NROTATIONS_QP_BU
 
411
 
 
412
      LOGICAL FPE_IN_DP_REDUCTION, FPE_IN_QP_REDUCTION
 
413
      DATA FPE_IN_DP_REDUCTION, FPE_IN_QP_REDUCTION/.FALSE.,.FALSE./
 
414
      COMMON/ML5_0_FPE_IN_REDUCTION/FPE_IN_DP_REDUCTION,
 
415
     $  FPE_IN_QP_REDUCTION
396
416
C     ----------
397
417
C     BEGIN CODE
398
418
C     ----------
409
429
        ENDIF
410
430
 
411
431
C       Make sure that NROTATIONS_QP and NROTATIONS_DP are set to zero
412
 
C        if AUTOMATIC_TIR_CACHE_CLEARING is disabled.
413
 
        IF(.NOT.AUTOMATIC_TIR_CACHE_CLEARING) THEN
 
432
C        if AUTOMATIC_CACHE_CLEARING is disabled.
 
433
        IF(.NOT.AUTOMATIC_CACHE_CLEARING) THEN
414
434
          IF(NROTATIONS_DP.NE.0.OR.NROTATIONS_QP.NE.0) THEN
415
 
            WRITE(*,*) '##INFO: AUTOMATIC_TIR_CACHE_CLEARING i'
416
 
     $       //'s disabled, so MadLoop automatically resets NROTATIONS'
417
 
     $       //'_DP and NROTATIONS_QP to 0.'
 
435
            WRITE(*,*) '##INFO: AUTOMATIC_CACHE_CLEARING is disabled,'
 
436
     $       //' so MadLoop automatically resets NROTATIONS_DP and'
 
437
     $       //' NROTATIONS_QP to 0.'
418
438
            NROTATIONS_QP=0
419
439
            NROTATIONS_DP=0
420
440
          ENDIF
421
441
        ENDIF
 
442
 
422
443
      ENDIF
423
444
 
424
445
      IF (LOCAL_ML_INIT) THEN
437
458
          ENDIF
438
459
        ENDDO
439
460
        IF(MLREDUCTIONLIB(1).EQ.0)THEN
440
 
          STOP 'No available loop reduction lib is provided. Make sur'
441
 
     $     //'e MLReductionLib is correct.'
 
461
          STOP 'No available loop reduction lib is provided. Make sure'
 
462
     $     //' MLReductionLib is correct.'
442
463
        ENDIF
443
464
        J=0
444
465
        DO I=1,NLOOPLIB
445
 
          IF(MLREDUCTIONLIB(I).EQ.1)THEN
 
466
          IF(LOOPLIBS_QPAVAILABLE(MLREDUCTIONLIB(I)))THEN
446
467
            J=J+1
447
 
            IF(.NOT.QP_TOOLS_AVAILABLE)QP_TOOLS_AVAILABLE=.TRUE.
 
468
            IF(.NOT.QP_TOOLS_AVAILABLE) THEN
 
469
              QP_TOOLS_AVAILABLE=.TRUE.
 
470
            ENDIF
448
471
            INDEX_QP_TOOLS(J)=I
449
472
          ENDIF
450
473
        ENDDO
460
483
 
461
484
        CALL ML5_0_SET_N_EVALS(N_DP_EVAL,N_QP_EVAL)
462
485
 
 
486
C       Make sure that the loop filter is disabled when there is
 
487
C        spin-2 particles for 2>1 or 1>2 processes
 
488
        IF(MAX_SPIN_EXTERNAL_PARTICLE.GT.3.AND.(NEXTERNAL.LE.3.AND.HELI
 
489
     $CITYFILTERLEVEL.NE.0)) THEN
 
490
          WRITE(*,*) '##INFO: Helicity filter deactivated for 2>1'
 
491
     $     //' processes involving spin 2 particles.'
 
492
          HELICITYFILTERLEVEL = 0
 
493
C         We write a dummy filter for structural reasons here
 
494
          OPEN(1, FILE=HELFILTERFN, ERR=6116, STATUS='NEW'
 
495
     $     ,ACTION='WRITE')
 
496
          DO I=1,NCOMB
 
497
            WRITE(1,*) 1
 
498
          ENDDO
 
499
 6116     CONTINUE
 
500
          CLOSE(1)
 
501
        ENDIF
 
502
 
463
503
        OPEN(1, FILE=COLORNUMFN, ERR=104, STATUS='OLD',          
464
504
     $    ACTION='READ')
465
505
        DO I=1,NCOLORROWS
467
507
        ENDDO
468
508
        GOTO 105
469
509
 104    CONTINUE
470
 
        STOP 'Color factors could not be initialized from fil'
471
 
     $   //'e ML5_0_ColorNumFactors.dat. File not found'
 
510
        STOP 'Color factors could not be initialized from file'
 
511
     $   //' ML5_0_ColorNumFactors.dat. File not found'
472
512
 105    CONTINUE
473
513
        CLOSE(1)
474
514
        OPEN(1, FILE=COLORDENOMFN, ERR=106, STATUS='OLD',          
478
518
        ENDDO
479
519
        GOTO 107
480
520
 106    CONTINUE
481
 
        STOP 'Color factors could not be initialized from fil'
482
 
     $   //'e ML5_0_ColorDenomFactors.dat. File not found'
 
521
        STOP 'Color factors could not be initialized from file'
 
522
     $   //' ML5_0_ColorDenomFactors.dat. File not found'
483
523
 107    CONTINUE
484
524
        CLOSE(1)
485
525
        OPEN(1, FILE=HELCONFIGFN, ERR=108, STATUS='OLD',              
489
529
        ENDDO
490
530
        GOTO 109
491
531
 108    CONTINUE
492
 
        STOP 'Color helictiy configurations could not be initialize'
493
 
     $   //'d from file ML5_0_HelConfigs.dat. File not found'
 
532
        STOP 'Color helictiy configurations could not be initialized'
 
533
     $   //' from file ML5_0_HelConfigs.dat. File not found'
494
534
 109    CONTINUE
495
535
        CLOSE(1)
496
536
 
497
537
C       SETUP OF THE COMMON STARTING EXTERNAL LOOP WAVEFUNCTION
498
538
C       IT IS ALSO PS POINT INDEPENDENT, SO IT CAN BE DONE HERE.
499
539
        DO I=0,3
500
 
          PL(I,0)=(0.0D0,0.0D0)
 
540
          PL(I,0)=DCMPLX(0.0D0,0.0D0)
501
541
        ENDDO
502
542
        DO I=1,MAXLWFSIZE
503
543
          DO J=0,LOOPMAXCOEFS-1
516
556
        ENDIF
517
557
      ENDIF
518
558
 
 
559
C     Make sure that lorentz rotation tests are not used if there is
 
560
C      external loop wavefunction of spin 2 and that one specific
 
561
C      helicity is asked
 
562
      NROTATIONS_DP_BU = NROTATIONS_DP
 
563
      NROTATIONS_QP_BU = NROTATIONS_QP
 
564
      IF(MAX_SPIN_EXTERNAL_PARTICLE.GT.3.AND.USERHEL.NE.-1) THEN
 
565
        IF(.NOT.WARNED_LORENTZ_STAB_TEST_OFF) THEN
 
566
          WRITE(*,*) '##WARNING: Evaluation of a specific helicity was'
 
567
     $     //' asked for this PS point, and there is a spin-2 (or'
 
568
     $     //' higher) particle in the external states.'
 
569
          WRITE(*,*) '##WARNING: As a result, MadLoop disabled the'
 
570
     $     //' Lorentz rotation test for this phase-space point only.'
 
571
          WRITE(*,*) '##WARNING: Further warning of that type'
 
572
     $     //' suppressed.'
 
573
          WARNED_LORENTZ_STAB_TEST_OFF = .TRUE.
 
574
        ENDIF
 
575
        NROTATIONS_QP=0
 
576
        NROTATIONS_DP=0
 
577
        CALL ML5_0_SET_N_EVALS(N_DP_EVAL,N_QP_EVAL)
 
578
      ENDIF
 
579
 
519
580
      IF(NTRY.EQ.0) THEN
520
 
        HELDOUBLECHECKED=(.NOT.DOUBLECHECKHELICITYFILTER).OR.(HELICITYF
521
 
     $   ILTERLEVEL.EQ.0)
 
581
        HELDOUBLECHECKED=(.NOT.DOUBLECHECKHELICITYFILTER)
 
582
     $   .OR.(HELICITYFILTERLEVEL.EQ.0)
522
583
        OPEN(1, FILE=LOOPFILTERFN, ERR=100, STATUS='OLD',          
523
584
     $    ACTION='READ')
524
585
        DO J=1,NLOOPGROUPS
556
617
 103    CONTINUE
557
618
        CLOSE(1)
558
619
        IF (HELICITYFILTERLEVEL.EQ.1) THEN
559
 
C         We must make sure to remove the matching-helicity optimisatio
560
 
C         n, as requested by the user.
 
620
C         We must make sure to remove the matching-helicity
 
621
C          optimisation, as requested by the user.
561
622
          DO J=1,NCOMB
562
623
            IF ((GOODHEL(J).GT.1).OR.(GOODHEL(J).LT.-HELOFFSET)) THEN
563
624
              GOODHEL(J)=1
626
687
        DONEHELDOUBLECHECK=.FALSE.
627
688
      ENDIF
628
689
 
629
 
      CHECKPHASE=(NTRY.LE.CHECKCYCLE).AND.(((.NOT.FOUNDLOOPFILTER
630
 
     $ ).AND.USELOOPFILTER).OR.(.NOT.FOUNDHELFILTER))
 
690
      CHECKPHASE=(NTRY.LE.CHECKCYCLE).AND.(((.NOT.FOUNDLOOPFILTER)
 
691
     $ .AND.USELOOPFILTER).OR.(.NOT.FOUNDHELFILTER))
631
692
 
632
693
      IF (WRITEOUTFILTERS) THEN
633
 
        IF ((HELICITYFILTERLEVEL.NE.0).AND.(.NOT. CHECKPHASE).AND.(.NOT
634
 
     $   .FOUNDHELFILTER)) THEN
635
 
          OPEN(1, FILE=HELFILTERFN, ERR=110, STATUS='NEW',ACTION='WRIT'
636
 
     $     //'E')
 
694
        IF ((HELICITYFILTERLEVEL.NE.0).AND.(.NOT. CHECKPHASE)
 
695
     $   .AND.(.NOT.FOUNDHELFILTER)) THEN
 
696
          OPEN(1, FILE=HELFILTERFN, ERR=110, STATUS='NEW'
 
697
     $     ,ACTION='WRITE')
637
698
          DO I=1,NCOMB
638
699
            WRITE(1,*) GOODHEL(I)
639
700
          ENDDO
642
703
          FOUNDHELFILTER=.TRUE.
643
704
        ENDIF
644
705
 
645
 
        IF ((.NOT. CHECKPHASE).AND.(.NOT.FOUNDLOOPFILTER).AND.USELOOPFI
646
 
     $   LTER) THEN
647
 
          OPEN(1, FILE=LOOPFILTERFN, ERR=111, STATUS='NEW',ACTION='WRI'
648
 
     $     //'TE')
 
706
        IF ((.NOT. CHECKPHASE).AND.(.NOT.FOUNDLOOPFILTER)
 
707
     $   .AND.USELOOPFILTER) THEN
 
708
          OPEN(1, FILE=LOOPFILTERFN, ERR=111, STATUS='NEW'
 
709
     $     ,ACTION='WRITE')
649
710
          DO J=1,NLOOPGROUPS
650
711
            WRITE(1,*) (GOODAMP(I,J),I=1,NSQUAREDSO)
651
712
          ENDDO
700
761
        ENDDO
701
762
      ENDDO
702
763
 
 
764
C     Make sure we start with empty caches
 
765
      IF (AUTOMATIC_CACHE_CLEARING) THEN
 
766
        CALL ML5_0_CLEAR_CACHES()
 
767
      ENDIF
703
768
 
704
769
      IF (IMPROVEPSPOINT.GE.0) THEN
705
 
C       Make the input PS more precise (exact onshell and energy-moment
706
 
C       um conservation)
 
770
C       Make the input PS more precise (exact onshell and
 
771
C        energy-momentum conservation)
707
772
        CALL ML5_0_IMPROVE_PS_POINT_PRECISION(PS)
708
773
      ENDIF
709
774
 
732
797
C      recomputes a rotated PS point
733
798
 200  CONTINUE
734
799
C     For the computation of a rotated version of this PS point we
735
 
C      must reset the TIR cache since this changes the definition of
736
 
C      the loop denominators.
737
 
      CALL ML5_0_CLEAR_TIR_CACHE()
 
800
C      must reset the all MadLoop cache since this changes the
 
801
C      definition of the loop denominators.
 
802
C     We don't check for AUTOMATIC_CACHE_CLEARING here because the
 
803
C      Lorentz test should anyway be disabled if the flag is turned
 
804
C      off.
 
805
      CALL ML5_0_CLEAR_CACHES()
738
806
 208  CONTINUE
739
807
 
740
808
C     MadLoop jumps to this label during initialization when it goes
751
819
 
752
820
      CTCALL_REQ_SO_DONE=.FALSE.
753
821
      FILTER_SO = (.NOT.CHECKPHASE).AND.HELDOUBLECHECKED.AND.(SQSO_TARG
754
 
     $ ET.NE.-1)
 
822
     $ET.NE.-1)
755
823
 
756
824
      DO I=1,NLOOPGROUPS
757
825
        DO J=0,LOOPMAXCOEFS-1
791
859
 
792
860
      DO H=1,NCOMB
793
861
        IF ((HELPICKED.EQ.H).OR.((HELPICKED.EQ.-1).AND.(CHECKPHASE.OR.(
794
 
     $   .NOT.HELDOUBLECHECKED).OR.(GOODHEL(H).GT.-HELOFFSET.AND.GOODHE
795
 
     $   L(H).NE.0)))) THEN
 
862
     $.NOT.HELDOUBLECHECKED).OR.(GOODHEL(H).GT.-HELOFFSET.AND.GOODHEL(H)
 
863
     $   .NE.0)))) THEN
796
864
          DO I=1,NEXTERNAL
797
865
            NHEL(I)=HELC(I,H)
798
866
          ENDDO
801
869
          CT_REQ_SO_DONE=.FALSE.
802
870
          LOOP_REQ_SO_DONE=.FALSE.
803
871
 
804
 
          IF (.NOT.CHECKPHASE.AND.HELDOUBLECHECKED.AND.HELPICKED.EQ.
805
 
     $     -1) THEN
 
872
          IF (.NOT.CHECKPHASE.AND.HELDOUBLECHECKED.AND.HELPICKED.EQ.-1)
 
873
     $      THEN
806
874
            HEL_MULT=GOODHEL(H)
807
875
          ELSE
808
876
            HEL_MULT=1
811
879
 
812
880
C         Helas calls for the born amplitudes and counterterms
813
881
C          associated to given loops
814
 
          CALL IXXXXX(P(0,1),ZERO,NHEL(1),+1*IC(1),W(1,1))
815
 
          CALL OXXXXX(P(0,2),ZERO,NHEL(2),-1*IC(2),W(1,2))
816
 
          CALL OXXXXX(P(0,3),MDL_MT,NHEL(3),+1*IC(3),W(1,3))
817
 
          CALL IXXXXX(P(0,4),MDL_MT,NHEL(4),-1*IC(4),W(1,4))
818
 
          CALL FFV1P0_3(W(1,1),W(1,2),GC_5,ZERO,ZERO,W(1,5))
819
 
C         Amplitude(s) for born diagram with ID 1
820
 
          CALL FFV1_0(W(1,4),W(1,3),W(1,5),GC_5,AMP(1))
821
 
          CALL FFV1P0_3(W(1,4),W(1,3),GC_5,ZERO,ZERO,W(1,6))
822
 
C         Counter-term amplitude(s) for loop diagram number 2
823
 
          CALL R2_GG_1_0(W(1,5),W(1,6),R2_GGQ,AMPL(1,1))
824
 
          CALL R2_GG_1_0(W(1,5),W(1,6),R2_GGQ,AMPL(1,2))
825
 
          CALL R2_GG_1_0(W(1,5),W(1,6),R2_GGQ,AMPL(1,3))
826
 
          CALL R2_GG_1_0(W(1,5),W(1,6),R2_GGQ,AMPL(1,4))
827
 
C         Counter-term amplitude(s) for loop diagram number 5
828
 
          CALL FFV1_0(W(1,1),W(1,2),W(1,6),UV_GQQQ_1EPS,AMPL(2,5))
829
 
          CALL FFV1_0(W(1,1),W(1,2),W(1,6),UV_GQQQ_1EPS,AMPL(2,6))
830
 
          CALL FFV1_0(W(1,1),W(1,2),W(1,6),UV_GQQQ_1EPS,AMPL(2,7))
831
 
          CALL FFV1_0(W(1,1),W(1,2),W(1,6),UV_GQQQ_1EPS,AMPL(2,8))
832
 
          CALL FFV1_0(W(1,1),W(1,2),W(1,6),UV_GQQB,AMPL(1,9))
833
 
          CALL FFV1_0(W(1,1),W(1,2),W(1,6),UV_GQQQ_1EPS,AMPL(2,10))
834
 
          CALL FFV1_0(W(1,1),W(1,2),W(1,6),UV_GQQT,AMPL(1,11))
835
 
          CALL FFV1_0(W(1,1),W(1,2),W(1,6),UV_GQQQ_1EPS,AMPL(2,12))
836
 
          CALL FFV1_0(W(1,1),W(1,2),W(1,6),UV_GQQG_1EPS,AMPL(2,13))
837
 
          CALL FFV1_0(W(1,1),W(1,2),W(1,6),R2_GQQ,AMPL(1,14))
838
 
C         Counter-term amplitude(s) for loop diagram number 7
839
 
          CALL R2_GG_1_R2_GG_3_0(W(1,5),W(1,6),R2_GGQ,R2_GGB,AMPL(1
840
 
     $     ,15))
841
 
C         Counter-term amplitude(s) for loop diagram number 8
842
 
          CALL R2_GG_1_R2_GG_3_0(W(1,5),W(1,6),R2_GGQ,R2_GGT,AMPL(1
843
 
     $     ,16))
844
 
C         Counter-term amplitude(s) for loop diagram number 9
845
 
          CALL FFV1_0(W(1,4),W(1,3),W(1,5),UV_GQQQ_1EPS,AMPL(2,17))
846
 
          CALL FFV1_0(W(1,4),W(1,3),W(1,5),UV_GQQQ_1EPS,AMPL(2,18))
847
 
          CALL FFV1_0(W(1,4),W(1,3),W(1,5),UV_GQQQ_1EPS,AMPL(2,19))
848
 
          CALL FFV1_0(W(1,4),W(1,3),W(1,5),UV_GQQQ_1EPS,AMPL(2,20))
849
 
          CALL FFV1_0(W(1,4),W(1,3),W(1,5),UV_GQQB,AMPL(1,21))
850
 
          CALL FFV1_0(W(1,4),W(1,3),W(1,5),UV_GQQQ_1EPS,AMPL(2,22))
851
 
          CALL FFV1_0(W(1,4),W(1,3),W(1,5),UV_GQQT,AMPL(1,23))
852
 
          CALL FFV1_0(W(1,4),W(1,3),W(1,5),UV_GQQQ_1EPS,AMPL(2,24))
853
 
          CALL FFV1_0(W(1,4),W(1,3),W(1,5),UV_GQQG_1EPS,AMPL(2,25))
854
 
          CALL FFV1_0(W(1,4),W(1,3),W(1,5),R2_GQQ,AMPL(1,26))
855
 
C         Counter-term amplitude(s) for loop diagram number 11
856
 
          CALL R2_GG_1_R2_GG_2_0(W(1,5),W(1,6),R2_GGG_1,R2_GGG_2
857
 
     $     ,AMPL(1,27))
 
882
          CALL ML5_0_HELAS_CALLS_AMPB_1(P,NHEL,H,IC)
858
883
 2000     CONTINUE
859
884
          CT_REQ_SO_DONE=.TRUE.
860
885
 
864
889
C         (if needed by the loop UFO model) are of this type.
865
890
C         Quite often and in principle for all loop UFO models from 
866
891
C         FeynRules, there are none of these type of counterterms.
867
 
C         Amplitude(s) for UVCT diagram with ID 13
868
 
          CALL FFV1_0(W(1,4),W(1,3),W(1,5),GC_5,AMPL(1,28))
869
 
          AMPL(1,28)=AMPL(1,28)*(2.0D0*UVWFCT_T_0)
870
 
C         Amplitude(s) for UVCT diagram with ID 14
871
 
          CALL FFV1_0(W(1,4),W(1,3),W(1,5),GC_5,AMPL(2,29))
872
 
          AMPL(2,29)=AMPL(2,29)*(2.0D0*UVWFCT_B_0_1EPS)
 
892
          CALL ML5_0_HELAS_CALLS_UVCT_1(P,NHEL,H,IC)
873
893
 3000     CONTINUE
874
894
          UVCT_REQ_SO_DONE=.TRUE.
875
895
 
876
 
          DO I=1,NCTAMPS
877
 
            DO J=1,NBORNAMPS
 
896
          DO J=1,NBORNAMPS
 
897
            CTEMP = 2.0D0*HEL_MULT*DCONJG(AMP(J))
 
898
            DO I=1,NCTAMPS
878
899
              CFTOT=DCMPLX(CF_N(I,J)/DBLE(ABS(CF_D(I,J))),0.0D0)
879
900
              IF(CF_D(I,J).LT.0) CFTOT=CFTOT*IMAG1
880
901
              ITEMP = ML5_0_ML5SQSOINDEX(ML5_0_ML5SOINDEX_FOR_LOOP_AMP(
881
 
     $         I),ML5_0_ML5SOINDEX_FOR_BORN_AMP(J))
 
902
     $I),ML5_0_ML5SOINDEX_FOR_BORN_AMP(J))
882
903
              IF (.NOT.FILTER_SO.OR.SQSO_TARGET.EQ.ITEMP) THEN
883
904
                DO K=1,3
884
 
                  TEMP2 = 2.0D0*HEL_MULT*DBLE(CFTOT*AMPL(K,I)
885
 
     $             *DCONJG(AMP(J)))
 
905
                  TEMP2 = DBLE(CFTOT*AMPL(K,I)*CTEMP)
886
906
                  ANS(K,ITEMP)=ANS(K,ITEMP)+TEMP2
887
907
                  ANS(K,0)=ANS(K,0)+TEMP2
888
908
                ENDDO
890
910
            ENDDO
891
911
          ENDDO
892
912
 
893
 
C         Coefficient construction for loop diagram with ID 2
894
 
          CALL FFV1L2_1(PL(0,0),W(1,5),GC_5,ZERO,ZERO,PL(0,1),COEFS)
895
 
          CALL ML5_0_UPDATE_WL_0_1(WL(1,0,1,0),4,COEFS,4,4,WL(1,0,1,1))
896
 
          CALL FFV1L2_1(PL(0,1),W(1,6),GC_5,ZERO,ZERO,PL(0,2),COEFS)
897
 
          CALL ML5_0_UPDATE_WL_1_1(WL(1,0,1,1),4,COEFS,4,4,WL(1,0,1,2))
898
 
          CALL ML5_0_CREATE_LOOP_COEFS(WL(1,0,1,2),2,4,1,1,4,30,H)
899
 
C         Coefficient construction for loop diagram with ID 3
900
 
          CALL FFV1L3_2(PL(0,0),W(1,1),GC_5,ZERO,ZERO,PL(0,3),COEFS)
901
 
          CALL ML5_0_UPDATE_WL_0_1(WL(1,0,1,0),4,COEFS,4,4,WL(1,0,1,3))
902
 
          CALL FFV1L1P0_3(PL(0,3),W(1,2),GC_5,ZERO,ZERO,PL(0,4),COEFS)
903
 
          CALL ML5_0_UPDATE_WL_1_0(WL(1,0,1,3),4,COEFS,4,4,WL(1,0,1,4))
904
 
          CALL FFV1L3_2(PL(0,4),W(1,4),GC_5,MDL_MT,MDL_WT,PL(0,5)
905
 
     $     ,COEFS)
906
 
          CALL ML5_0_UPDATE_WL_1_1(WL(1,0,1,4),4,COEFS,4,4,WL(1,0,1,5))
907
 
          CALL FFV1L1P0_3(PL(0,5),W(1,3),GC_5,ZERO,ZERO,PL(0,6),COEFS)
908
 
          CALL ML5_0_UPDATE_WL_2_0(WL(1,0,1,5),4,COEFS,4,4,WL(1,0,1,6))
909
 
          CALL ML5_0_CREATE_LOOP_COEFS(WL(1,0,1,6),2,4,2,1,1,31,H)
910
 
C         Coefficient construction for loop diagram with ID 4
911
 
          CALL FFV1L3_1(PL(0,4),W(1,3),GC_5,MDL_MT,MDL_WT,PL(0,7)
912
 
     $     ,COEFS)
913
 
          CALL ML5_0_UPDATE_WL_1_1(WL(1,0,1,4),4,COEFS,4,4,WL(1,0,1,7))
914
 
          CALL FFV1L2P0_3(PL(0,7),W(1,4),GC_5,ZERO,ZERO,PL(0,8),COEFS)
915
 
          CALL ML5_0_UPDATE_WL_2_0(WL(1,0,1,7),4,COEFS,4,4,WL(1,0,1,8))
916
 
          CALL ML5_0_CREATE_LOOP_COEFS(WL(1,0,1,8),2,4,3,1,1,32,H)
917
 
C         Coefficient construction for loop diagram with ID 5
918
 
          CALL VVV1L2P0_1(PL(0,4),W(1,6),GC_4,ZERO,ZERO,PL(0,9),COEFS)
919
 
          CALL ML5_0_UPDATE_WL_1_1(WL(1,0,1,4),4,COEFS,4,4,WL(1,0,1,9))
920
 
          CALL ML5_0_CREATE_LOOP_COEFS(WL(1,0,1,9),2,4,4,1,1,33,H)
921
 
C         Coefficient construction for loop diagram with ID 6
922
 
          CALL FFV1L2P0_3(PL(0,0),W(1,1),GC_5,ZERO,ZERO,PL(0,10),COEFS)
923
 
          CALL ML5_0_UPDATE_WL_0_0(WL(1,0,1,0),4,COEFS,4,4,WL(1,0,1
924
 
     $     ,10))
925
 
          CALL FFV1L3_1(PL(0,10),W(1,2),GC_5,ZERO,ZERO,PL(0,11),COEFS)
926
 
          CALL ML5_0_UPDATE_WL_0_1(WL(1,0,1,10),4,COEFS,4,4,WL(1,0,1
927
 
     $     ,11))
928
 
          CALL FFV1L2_1(PL(0,11),W(1,6),GC_5,ZERO,ZERO,PL(0,12),COEFS)
929
 
          CALL ML5_0_UPDATE_WL_1_1(WL(1,0,1,11),4,COEFS,4,4,WL(1,0,1
930
 
     $     ,12))
931
 
          CALL ML5_0_CREATE_LOOP_COEFS(WL(1,0,1,12),2,4,4,1,1,34,H)
932
 
C         Coefficient construction for loop diagram with ID 7
933
 
          CALL FFV1L2_1(PL(0,0),W(1,5),GC_5,MDL_MB,ZERO,PL(0,13),COEFS)
934
 
          CALL ML5_0_UPDATE_WL_0_1(WL(1,0,1,0),4,COEFS,4,4,WL(1,0,1
935
 
     $     ,13))
936
 
          CALL FFV1L2_1(PL(0,13),W(1,6),GC_5,MDL_MB,ZERO,PL(0,14)
937
 
     $     ,COEFS)
938
 
          CALL ML5_0_UPDATE_WL_1_1(WL(1,0,1,13),4,COEFS,4,4,WL(1,0,1
939
 
     $     ,14))
940
 
          CALL ML5_0_CREATE_LOOP_COEFS(WL(1,0,1,14),2,4,5,1,1,35,H)
941
 
C         Coefficient construction for loop diagram with ID 8
942
 
          CALL FFV1L2_1(PL(0,0),W(1,5),GC_5,MDL_MT,MDL_WT,PL(0,15)
943
 
     $     ,COEFS)
944
 
          CALL ML5_0_UPDATE_WL_0_1(WL(1,0,1,0),4,COEFS,4,4,WL(1,0,1
945
 
     $     ,15))
946
 
          CALL FFV1L2_1(PL(0,15),W(1,6),GC_5,MDL_MT,MDL_WT,PL(0,16)
947
 
     $     ,COEFS)
948
 
          CALL ML5_0_UPDATE_WL_1_1(WL(1,0,1,15),4,COEFS,4,4,WL(1,0,1
949
 
     $     ,16))
950
 
          CALL ML5_0_CREATE_LOOP_COEFS(WL(1,0,1,16),2,4,6,1,1,36,H)
951
 
C         Coefficient construction for loop diagram with ID 9
952
 
          CALL FFV1L1P0_3(PL(0,0),W(1,3),GC_5,ZERO,ZERO,PL(0,17),COEFS)
953
 
          CALL ML5_0_UPDATE_WL_0_0(WL(1,0,1,0),4,COEFS,4,4,WL(1,0,1
954
 
     $     ,17))
955
 
          CALL FFV1L3_2(PL(0,17),W(1,4),GC_5,MDL_MT,MDL_WT,PL(0,18)
956
 
     $     ,COEFS)
957
 
          CALL ML5_0_UPDATE_WL_0_1(WL(1,0,1,17),4,COEFS,4,4,WL(1,0,1
958
 
     $     ,18))
959
 
          CALL FFV1L1_2(PL(0,18),W(1,5),GC_5,MDL_MT,MDL_WT,PL(0,19)
960
 
     $     ,COEFS)
961
 
          CALL ML5_0_UPDATE_WL_1_1(WL(1,0,1,18),4,COEFS,4,4,WL(1,0,1
962
 
     $     ,19))
963
 
          CALL ML5_0_CREATE_LOOP_COEFS(WL(1,0,1,19),2,4,7,1,1,37,H)
964
 
C         Coefficient construction for loop diagram with ID 10
965
 
          CALL FFV1L3_1(PL(0,0),W(1,3),GC_5,MDL_MT,MDL_WT,PL(0,20)
966
 
     $     ,COEFS)
967
 
          CALL ML5_0_UPDATE_WL_0_1(WL(1,0,1,0),4,COEFS,4,4,WL(1,0,1
968
 
     $     ,20))
969
 
          CALL FFV1L2P0_3(PL(0,20),W(1,4),GC_5,ZERO,ZERO,PL(0,21)
970
 
     $     ,COEFS)
971
 
          CALL ML5_0_UPDATE_WL_1_0(WL(1,0,1,20),4,COEFS,4,4,WL(1,0,1
972
 
     $     ,21))
973
 
          CALL VVV1L2P0_1(PL(0,21),W(1,5),GC_4,ZERO,ZERO,PL(0,22)
974
 
     $     ,COEFS)
975
 
          CALL ML5_0_UPDATE_WL_1_1(WL(1,0,1,21),4,COEFS,4,4,WL(1,0,1
976
 
     $     ,22))
977
 
          CALL ML5_0_CREATE_LOOP_COEFS(WL(1,0,1,22),2,4,8,1,1,38,H)
978
 
C         Coefficient construction for loop diagram with ID 11
979
 
          CALL VVV1L2P0_1(PL(0,0),W(1,5),GC_4,ZERO,ZERO,PL(0,23),COEFS)
980
 
          CALL ML5_0_UPDATE_WL_0_1(WL(1,0,1,0),4,COEFS,4,4,WL(1,0,1
981
 
     $     ,23))
982
 
          CALL VVV1L2P0_1(PL(0,23),W(1,6),GC_4,ZERO,ZERO,PL(0,24)
983
 
     $     ,COEFS)
984
 
          CALL ML5_0_UPDATE_WL_1_1(WL(1,0,1,23),4,COEFS,4,4,WL(1,0,1
985
 
     $     ,24))
986
 
          CALL ML5_0_CREATE_LOOP_COEFS(WL(1,0,1,24),2,4,1,2,1,39,H)
987
 
C         Coefficient construction for loop diagram with ID 12
988
 
          CALL GHGHGL2_1(PL(0,0),W(1,5),GC_4,ZERO,ZERO,PL(0,25),COEFS)
989
 
          CALL ML5_0_UPDATE_WL_0_1(WL(1,0,1,0),1,COEFS,1,1,WL(1,0,1
990
 
     $     ,25))
991
 
          CALL GHGHGL2_1(PL(0,25),W(1,6),GC_4,ZERO,ZERO,PL(0,26),COEFS)
992
 
          CALL ML5_0_UPDATE_WL_1_1(WL(1,0,1,25),1,COEFS,1,1,WL(1,0,1
993
 
     $     ,26))
994
 
          CALL ML5_0_CREATE_LOOP_COEFS(WL(1,0,1,26),2,1,1,1,1,40,H)
 
913
          CALL ML5_0_COEF_CONSTRUCTION_1(P,NHEL,H,IC)
995
914
 4000     CONTINUE
996
915
          LOOP_REQ_SO_DONE=.TRUE.
997
916
 
1014
933
C      recomputes the same PS point with a different CTMode
1015
934
 300  CONTINUE
1016
935
 
 
936
C     Make sure that the loop calls are performed since this is new
 
937
C      evaluation.
 
938
      CTCALL_REQ_SO_DONE=.FALSE.
 
939
 
1017
940
 
1018
941
 
1019
942
 
1033
956
          S(I_SO,J)=.TRUE.
1034
957
        ENDDO
1035
958
        IF (FILTER_SO.AND.SQSO_TARGET.NE.I_SO) GOTO 5001
1036
 
C       CutTools call for loop numbers 1,10,11
1037
 
        CALL ML5_0_LOOP_2(5,6,DCMPLX(ZERO),DCMPLX(ZERO),2,I_SO,1)
1038
 
C       CutTools call for loop numbers 2
1039
 
        CALL ML5_0_LOOP_4(1,2,4,3,DCMPLX(ZERO),DCMPLX(ZERO),DCMPLX(MDL_
1040
 
     $   MT),DCMPLX(ZERO),2,I_SO,2)
1041
 
C       CutTools call for loop numbers 3
1042
 
        CALL ML5_0_LOOP_4(1,2,3,4,DCMPLX(ZERO),DCMPLX(ZERO),DCMPLX(MDL_
1043
 
     $   MT),DCMPLX(ZERO),2,I_SO,3)
1044
 
C       CutTools call for loop numbers 4,5
1045
 
        CALL ML5_0_LOOP_3(1,2,6,DCMPLX(ZERO),DCMPLX(ZERO),DCMPLX(ZERO)
1046
 
     $   ,2,I_SO,4)
1047
 
C       CutTools call for loop numbers 6
1048
 
        CALL ML5_0_LOOP_2(5,6,DCMPLX(MDL_MB),DCMPLX(MDL_MB),2,I_SO,5)
1049
 
C       CutTools call for loop numbers 7
1050
 
        CALL ML5_0_LOOP_2(5,6,DCMPLX(MDL_MT),DCMPLX(MDL_MT),2,I_SO,6)
1051
 
C       CutTools call for loop numbers 8
1052
 
        CALL ML5_0_LOOP_3(3,4,5,DCMPLX(ZERO),DCMPLX(MDL_MT),DCMPLX(MDL_
1053
 
     $   MT),2,I_SO,7)
1054
 
C       CutTools call for loop numbers 9
1055
 
        CALL ML5_0_LOOP_3(3,4,5,DCMPLX(MDL_MT),DCMPLX(ZERO),DCMPLX(ZERO
1056
 
     $   ),2,I_SO,8)
 
959
        CALL ML5_0_LOOP_CT_CALLS_1(P,NHEL,H,IC)
1057
960
        GOTO 5001
1058
961
 5000   CONTINUE
1059
962
        CTCALL_REQ_SO_DONE=.TRUE.
1076
979
        ENDIF
1077
980
      ENDDO
1078
981
 
 
982
C     Make sure that no NaN is present in the result
 
983
      DO K=1,NSQUAREDSO
 
984
        DO J=1,3
 
985
          IF (.NOT.(ANS(J,K).EQ.ANS(J,K))) THEN
 
986
            IF (DOING_QP_EVALS) THEN
 
987
              FPE_IN_QP_REDUCTION = .TRUE.
 
988
            ELSE
 
989
              FPE_IN_DP_REDUCTION = .TRUE.
 
990
            ENDIF
 
991
          ENDIF
 
992
        ENDDO
 
993
      ENDDO
 
994
 
1079
995
 1226 CONTINUE
1080
996
 
1081
997
      IF (CHECKPHASE.OR.(.NOT.HELDOUBLECHECKED)) THEN
1105
1021
C         SET THE HELICITY FILTER
1106
1022
          IF(.NOT.FOUNDHELFILTER) THEN
1107
1023
            HEL_INCONSISTENT=.FALSE.
1108
 
            IF(ML5_0_ISZERO(DABS(HELSAVED(1,HELPICKED))+DABS(HELSAVED(2
1109
 
     $       ,HELPICKED))+DABS(HELSAVED(3,HELPICKED)),REF/DBLE(NCOMB),
1110
 
     $       -1,-1)) THEN
 
1024
            IF(ML5_0_ISZERO(DABS(HELSAVED(1,HELPICKED))
 
1025
     $       +DABS(HELSAVED(2,HELPICKED))+DABS(HELSAVED(3,HELPICKED))
 
1026
     $       ,REF/DBLE(NCOMB),-1,-1)) THEN
1111
1027
              IF(NTRY.EQ.1) THEN
1112
1028
                GOODHEL(HELPICKED)=-HELOFFSET
1113
1029
              ELSEIF(GOODHEL(HELPICKED).NE.-HELOFFSET) THEN
1114
 
                WRITE(*,*) '##W02A WARNING Inconsistent zero helicit'
1115
 
     $           //'y ',HELPICKED
 
1030
                WRITE(*,*) '##W02A WARNING Inconsistent zero helicity'
 
1031
     $           //' ',HELPICKED
1116
1032
                IF(HELINITSTARTOVER) THEN
1117
 
                  WRITE(*,*) '##I01 INFO Initialization starting ove'
1118
 
     $             //'r because of inconsistency in the helicit'
1119
 
     $             //'y filter setup.'
 
1033
                  WRITE(*,*) '##I01 INFO Initialization starting over'
 
1034
     $             //' because of inconsistency in the helicity filter'
 
1035
     $             //' setup.'
1120
1036
                  NTRY=0
1121
1037
                ELSE
1122
1038
                  HEL_INCONSISTENT=.TRUE.
1139
1055
C                     Make sure we have paired this hel config to the
1140
1056
C                      same one last PS point
1141
1057
                    ELSEIF(GOODHEL(HELPICKED).NE.(-H-HELOFFSET)) THEN
1142
 
                      WRITE(*,*) '##W02B WARNING Inconsistent matchin'
1143
 
     $                 //'g helicity ',HELPICKED
 
1058
                      WRITE(*,*) '##W02B WARNING Inconsistent matching'
 
1059
     $                 //' helicity ',HELPICKED
1144
1060
                      IF(HELINITSTARTOVER) THEN
1145
 
                        WRITE(*,*) '##I01 INFO Initialization startin'
1146
 
     $                   //'g over because of inconsistency in th'
1147
 
     $                   //'e helicity filter setup.'
 
1061
                        WRITE(*,*) '##I01 INFO Initialization starting'
 
1062
     $                   //' over because of inconsistency in the'
 
1063
     $                   //' helicity filter setup.'
1148
1064
                        NTRY=0
1149
1065
                      ELSE
1150
1066
                        HEL_INCONSISTENT=.TRUE.
1157
1073
            IF(HEL_INCONSISTENT) THEN
1158
1074
C             This helicity has unstable filter so we will always
1159
1075
C              compute it by itself.
1160
 
C             We therefore also need to remove it from the multiplicati
1161
 
C             ve factor of the corresponding helicity.
 
1076
C             We therefore also need to remove it from the
 
1077
C              multiplicative factor of the corresponding helicity.
1162
1078
              IF(GOODHEL(HELPICKED).LT.-HELOFFSET) THEN
1163
1079
                GOODHEL(-GOODHEL(HELPICKED)-HELOFFSET)=GOODHEL(
1164
1080
     $           -GOODHEL(HELPICKED)-HELOFFSET)-1
1169
1085
C             Of course if it is one, then we do not need to do
1170
1086
C              anything (because with HELINITSTARTOVER=.FALSE. we only
1171
1087
C              support exactly identical Hels.)
1172
 
              IF(GOODHEL(HELPICKED).GT.-HELOFFSET.AND.GOODHEL(HELPICKED
1173
 
     $         ).NE.1) THEN
 
1088
              IF(GOODHEL(HELPICKED).GT.-HELOFFSET.AND.GOODHEL(HELPICKED)
 
1089
     $         .NE.1) THEN
1174
1090
                NEWHELREF=-1
1175
1091
                DO H=1,NCOMB
1176
1092
                  IF (GOODHEL(H).EQ.(-HELOFFSET-HELPICKED)) THEN
1204
1120
                    WRITE(*,*) '##W02 WARNING Inconsistent loop amp '
1205
1121
     $               ,I,'.'
1206
1122
                    IF(LOOPINITSTARTOVER) THEN
1207
 
                      WRITE(*,*) '##I01 INFO Initialization startin'
1208
 
     $                 //'g over because of inconsistency in the loo'
1209
 
     $                 //'p filter setup.'
 
1123
                      WRITE(*,*) '##I01 INFO Initialization starting'
 
1124
     $                 //' over because of inconsistency in the loop'
 
1125
     $                 //' filter setup.'
1210
1126
                      NTRY=0
1211
1127
                    ELSE
1212
1128
                      GOODAMP(J,I)=.TRUE.
1222
1138
            IF (.NOT.ML5_0_ISZERO(DABS(HELSAVED(1,HELPICKED))
1223
1139
     $       +DABS(HELSAVED(2,HELPICKED))+DABS(HELSAVED(2,HELPICKED))
1224
1140
     $       ,REF/DBLE(NCOMB),-1,-1)) THEN
1225
 
              WRITE(*,*) '##W15 Helicity filter could not be successfu'
1226
 
     $         //'lly double checked.'
1227
 
              WRITE(*,*) '##One reason for this is that you might hav'
1228
 
     $         //'e changed sensible parameters which affected wha'
1229
 
     $         //'t are the zero helicity configurations.'
1230
 
              WRITE(*,*) '##MadLoop will try to reset the Helicit'
1231
 
     $         //'y filter with the next PS points it receives.'
 
1141
              WRITE(*,*) '##W15 Helicity filter could not be'
 
1142
     $         //' successfully double checked.'
 
1143
              WRITE(*,*) '##One reason for this is that you might have'
 
1144
     $         //' changed sensible parameters which affected what are'
 
1145
     $         //' the zero helicity configurations.'
 
1146
              WRITE(*,*) '##MadLoop will try to reset the Helicity'
 
1147
     $         //' filter with the next PS points it receives.'
1232
1148
              NTRY=0
1233
1149
              OPEN(29,FILE=HELFILTERFN,ERR=348)
1234
1150
 348          CONTINUE
1236
1152
            ENDIF
1237
1153
          ENDIF
1238
1154
          IF (GOODHEL(HELPICKED).LT.-HELOFFSET.AND.NTRY.NE.0) THEN
1239
 
            IF(ML5_0_ISSAME(HELSAVED(1,HELPICKED),HELSAVED(1,ABS(GOODHE
1240
 
     $       L(HELPICKED)+HELOFFSET)),REF,.TRUE.).EQ.0) THEN
1241
 
              WRITE(*,*) '##W15 Helicity filter could not be successfu'
1242
 
     $         //'lly double checked.'
1243
 
              WRITE(*,*) '##One reason for this is that you might hav'
1244
 
     $         //'e changed sensible parameters which affected th'
1245
 
     $         //'e helicity dependance relations.'
1246
 
              WRITE(*,*) '##MadLoop will try to reset the Helicit'
1247
 
     $         //'y filter with the next PS points it receives.'
 
1155
            IF(ML5_0_ISSAME(HELSAVED(1,HELPICKED),HELSAVED(1
 
1156
     $       ,ABS(GOODHEL(HELPICKED)+HELOFFSET)),REF,.TRUE.).EQ.0) THEN
 
1157
              WRITE(*,*) '##W15 Helicity filter could not be'
 
1158
     $         //' successfully double checked.'
 
1159
              WRITE(*,*) '##One reason for this is that you might have'
 
1160
     $         //' changed sensible parameters which affected the'
 
1161
     $         //' helicity dependance relations.'
 
1162
              WRITE(*,*) '##MadLoop will try to reset the Helicity'
 
1163
     $         //' filter with the next PS points it receives.'
1248
1164
              NTRY=0
1249
1165
              OPEN(30,FILE=HELFILTERFN,ERR=349)
1250
1166
 349          CONTINUE
1252
1168
            ENDIF
1253
1169
          ENDIF
1254
1170
C         SET HELDOUBLECHECKED TO .TRUE. WHEN DONE
1255
 
C         even if it failed we do not want to redo the check afterwards
1256
 
C          if HELINITSTARTOVER=.FALSE.
 
1171
C         even if it failed we do not want to redo the check
 
1172
C          afterwards if HELINITSTARTOVER=.FALSE.
1257
1173
          IF (HELPICKED.EQ.NCOMB.AND.(NTRY.NE.0.OR..NOT.HELINITSTARTOVE
1258
 
     $     R)) THEN
 
1174
     $R)) THEN
1259
1175
            DONEHELDOUBLECHECK=.TRUE.
1260
1176
          ENDIF
1261
1177
        ENDIF
1281
1197
          IF(NTRY.EQ.0) THEN
1282
1198
            NATTEMPTS=NATTEMPTS+1
1283
1199
            IF(NATTEMPTS.EQ.MAXATTEMPTS) THEN
1284
 
              WRITE(*,*) '##E01 ERROR Could not initialize the filter'
1285
 
     $         //'s in ',MAXATTEMPTS,' trials'
 
1200
              WRITE(*,*) '##E01 ERROR Could not initialize the filters'
 
1201
     $         //' in ',MAXATTEMPTS,' trials'
1286
1202
              STOP 1
1287
1203
            ENDIF
1288
1204
          ENDIF
1299
1215
      ENDDO
1300
1216
 
1301
1217
 
1302
 
      IF(.NOT.CHECKPHASE.AND.HELDOUBLECHECKED.AND.(CTMODERUN.EQ.
1303
 
     $ -1)) THEN
 
1218
      IF(.NOT.CHECKPHASE.AND.HELDOUBLECHECKED.AND.(CTMODERUN.EQ.-1))
 
1219
     $  THEN
1304
1220
        STAB_INDEX=STAB_INDEX+1
1305
 
        IF(DOING_QP_EVALS.AND.MLREDUCTIONLIB(I_LIB).EQ.1) THEN
1306
 
C         NOW,ONLY CUTTOOLS PROVIDES QP
 
1221
        IF(DOING_QP_EVALS.AND.LOOPLIBS_QPAVAILABLE(MLREDUCTIONLIB(I_LIB)
 
1222
     $   )) THEN
 
1223
C         Only run over the reduction algorithms which support
 
1224
C          quadruple precision
1307
1225
          DO I=0,NSQUAREDSO
1308
1226
            DO K=1,3
1309
1227
              QP_RES(K,I,STAB_INDEX)=ANS(K,I)
1317
1235
          ENDDO
1318
1236
        ENDIF
1319
1237
 
1320
 
        IF(DOING_QP_EVALS.AND.MLREDUCTIONLIB(I_LIB).EQ.1) THEN
 
1238
        IF(DOING_QP_EVALS.AND.LOOPLIBS_QPAVAILABLE(MLREDUCTIONLIB(I_LIB)
 
1239
     $   )) THEN
1321
1240
          BASIC_CT_MODE=4
1322
1241
        ELSE
1323
1242
          BASIC_CT_MODE=1
1355
1274
        CTMODE=BASIC_CT_MODE
1356
1275
 
1357
1276
        IF(.NOT.EVAL_DONE(3).AND. ((DOING_QP_EVALS.AND.NROTATIONS_QP.GE
1358
 
     $   .1).OR.((.NOT.DOING_QP_EVALS).AND.NROTATIONS_DP.GE.1)) ) THEN
 
1277
     $.1).OR.((.NOT.DOING_QP_EVALS).AND.NROTATIONS_DP.GE.1)) ) THEN
1359
1278
          EVAL_DONE(3)=.TRUE.
1360
1279
          CALL ML5_0_ROTATE_PS(PS,P,1)
1361
1280
          IF (DOING_QP_EVALS) CALL ML5_0_MP_ROTATE_PS(MP_PS,MP_P,1)
1363
1282
        ENDIF
1364
1283
 
1365
1284
        IF(.NOT.EVAL_DONE(4).AND. ((DOING_QP_EVALS.AND.NROTATIONS_QP.GE
1366
 
     $   .2).OR.((.NOT.DOING_QP_EVALS).AND.NROTATIONS_DP.GE.2)) ) THEN
 
1285
     $.2).OR.((.NOT.DOING_QP_EVALS).AND.NROTATIONS_DP.GE.2)) ) THEN
1367
1286
          EVAL_DONE(4)=.TRUE.
1368
1287
          CALL ML5_0_ROTATE_PS(PS,P,2)
1369
1288
          IF (DOING_QP_EVALS) CALL ML5_0_MP_ROTATE_PS(MP_PS,MP_P,2)
1375
1294
 
1376
1295
C       END OF THE DEFINITIONS OF THE DIFFERENT EVALUATION METHODS
1377
1296
 
1378
 
        IF(DOING_QP_EVALS.AND.MLREDUCTIONLIB(I_LIB).EQ.1) THEN
 
1297
        IF(DOING_QP_EVALS.AND.LOOPLIBS_QPAVAILABLE(MLREDUCTIONLIB(I_LIB)
 
1298
     $   )) THEN
1379
1299
          CALL ML5_0_COMPUTE_ACCURACY(QP_RES,N_QP_EVAL,ACC,ANS)
 
1300
C         If a floating point exception was encountered during the
 
1301
C          reduction,
 
1302
C         the result cannot be trusted at all and we hardset all
 
1303
C          accuracies to 1.0
 
1304
          IF(FPE_IN_QP_REDUCTION) THEN
 
1305
            DO I=0,NSQUAREDSO
 
1306
              ACC(I)=1.0D0
 
1307
            ENDDO
 
1308
          ENDIF
1380
1309
          DO I=0,NSQUAREDSO
1381
1310
            ACCURACY(I)=ACC(I)
1382
1311
          ENDDO
1385
1314
     $     ,.TRUE.)
1386
1315
          IF(MAXVAL(ACC).GE.MLSTABTHRES) THEN
1387
1316
            I_QP_LIB=I_QP_LIB+1
1388
 
            IF(I_QP_LIB.GT.QP_NLOOPLIB.OR.INDEX_QP_TOOLS(I_QP_LIB
1389
 
     $       ).EQ.0)THEN
 
1317
            IF(I_QP_LIB.GT.QP_NLOOPLIB.OR.INDEX_QP_TOOLS(I_QP_LIB)
 
1318
     $       .EQ.0)THEN
1390
1319
              RET_CODE_H=4
1391
1320
              RET_CODE_U=SET_RET_CODE_U(MLREDUCTIONLIB(I_LIB),.TRUE.
1392
1321
     $         ,.FALSE.)
1393
1322
              NEPS=NEPS+1
1394
1323
              CALL ML5_0_COMPUTE_ACCURACY(DP_RES,N_DP_EVAL,TEMP1,TEMP)
 
1324
              CALL ML5_0_COMPUTE_ACCURACY(QP_RES,N_QP_EVAL,ACC,ANS)
1395
1325
              IF(NEPS.LE.10) THEN
1396
 
                WRITE(*,*) '##W03 WARNING An unstable PS point was'
1397
 
     $           ,       ' detected.'
 
1326
                WRITE(*,*) '##W03 WARNING An unstable PS point was',  
 
1327
     $                ' detected.'
 
1328
                IF(FPE_IN_QP_REDUCTION) THEN
 
1329
                  WRITE(*,*) '## The last QP reduction was deemed'
 
1330
     $             //' unstable because a floating point exception was'
 
1331
     $             //' encountered.'
 
1332
                ENDIF
1398
1333
                IF (NSQUAREDSO.NE.1) THEN
1399
 
                  WRITE(*,*) '##Accuracies for each split orde'
1400
 
     $             //'r, starting with the summed case'
1401
 
                  WRITE(*,*) '##DP accuracies (for each split orde'
1402
 
     $             //'r): ',(TEMP1(I),I=0,NSQUAREDSO)
1403
 
                  WRITE(*,*) '##QP accuracies (for each split orde'
1404
 
     $             //'r): ',(ACC(I),I=0,NSQUAREDSO)
 
1334
                  WRITE(*,*) '##Accuracies for each split order,'
 
1335
     $             //' starting with the summed case'
 
1336
                  WRITE(*,*) '##DP accuracies (for each split order):'
 
1337
     $             //' ',(TEMP1(I),I=0,NSQUAREDSO)
 
1338
                  WRITE(*,*) '##QP accuracies (for each split order):'
 
1339
     $             //' ',(ACC(I),I=0,NSQUAREDSO)
1405
1340
                ELSE
1406
1341
                  WRITE(*,*) '##DP accuracy: ',TEMP1(1)
1407
1342
                  WRITE(*,*) '##QP accuracy: ',ACC(1)
1409
1344
                DO J=0,NSQUAREDSO
1410
1345
                  IF (NSQUAREDSO.NE.1.OR.J.NE.0) THEN
1411
1346
                    IF (J.EQ.0) THEN
1412
 
                      WRITE(*,*) 'Details for all split orders summe'
1413
 
     $                 //'d :'
 
1347
                      WRITE(*,*) 'Details for all split orders summed'
 
1348
     $                 //' :'
1414
1349
                    ELSE
1415
1350
                      WRITE(*,*) 'Details for split order index : ',J
1416
1351
                    ENDIF
1430
1365
                ENDDO
1431
1366
              ENDIF
1432
1367
              IF(NEPS.EQ.10) THEN
1433
 
                WRITE(*,*) 'Further output of the details of thes'
1434
 
     $           //'e unstable PS points will now be suppressed.'
 
1368
                WRITE(*,*) 'Further output of the details of these'
 
1369
     $           //' unstable PS points will now be suppressed.'
1435
1370
              ENDIF
1436
1371
            ELSE
 
1372
C             A new reduction tool will be used. Reinitialize the FPE
 
1373
C              flags.
 
1374
              FPE_IN_DP_REDUCTION=.FALSE.
 
1375
              FPE_IN_QP_REDUCTION=.FALSE.
1437
1376
              I_LIB=INDEX_QP_TOOLS(I_QP_LIB)
1438
1377
              EVAL_DONE(1)=.TRUE.
1439
1378
              DO I=2,MAXSTABILITYLENGTH
1449
1388
          ENDIF
1450
1389
        ELSEIF(.NOT.DOING_QP_EVALS)THEN
1451
1390
          CALL ML5_0_COMPUTE_ACCURACY(DP_RES,N_DP_EVAL,ACC,ANS)
 
1391
C         If a floating point exception was encountered during the
 
1392
C          reduction,
 
1393
C         the result cannot be trusted at all and we hardset all
 
1394
C          accuracies to 1.0
 
1395
          IF(FPE_IN_DP_REDUCTION) THEN
 
1396
            DO I=0,NSQUAREDSO
 
1397
              ACC(I)=1.0D0
 
1398
            ENDDO
 
1399
          ENDIF
1452
1400
          IF(MAXVAL(ACC).GE.MLSTABTHRES) THEN
1453
1401
            I_LIB=I_LIB+1
1454
 
            IF((I_LIB.GT.NLOOPLIB.OR.MLREDUCTIONLIB(I_LIB).EQ.0
1455
 
     $       ).AND.QP_TOOLS_AVAILABLE)THEN
 
1402
            IF((I_LIB.GT.NLOOPLIB.OR.MLREDUCTIONLIB(I_LIB).EQ.0)
 
1403
     $       .AND.QP_TOOLS_AVAILABLE)THEN
1456
1404
              I_LIB=INDEX_QP_TOOLS(1)
 
1405
C             A new reduction tool will be used. Reinitialize the FPE
 
1406
C              flags.
 
1407
              FPE_IN_DP_REDUCTION=.FALSE.
 
1408
              FPE_IN_QP_REDUCTION=.FALSE.
1457
1409
              I_QP_LIB=1
1458
1410
              DOING_QP_EVALS=.TRUE.
1459
1411
              EVAL_DONE(1)=.TRUE.
1463
1415
              STAB_INDEX=0
1464
1416
              CTMODE=4
1465
1417
              GOTO 200
1466
 
            ELSEIF(I_LIB.LE.NLOOPLIB.AND.MLREDUCTIONLIB(I_LIB).GT.0
1467
 
     $       )THEN
 
1418
            ELSEIF(I_LIB.LE.NLOOPLIB.AND.MLREDUCTIONLIB(I_LIB).GT.0)
 
1419
     $       THEN
 
1420
C             A new reduction tool will be used. Reinitialize the FPE
 
1421
C              flags.
 
1422
              FPE_IN_DP_REDUCTION=.FALSE.
 
1423
              FPE_IN_QP_REDUCTION=.FALSE.
1468
1424
              EVAL_DONE(1)=.TRUE.
1469
1425
              DO I=2,MAXSTABILITYLENGTH
1470
1426
                EVAL_DONE(I)=.FALSE.
1484
1440
     $         ,.FALSE.)
1485
1441
              NEPS=NEPS+1
1486
1442
              IF(NEPS.LE.10) THEN
1487
 
                WRITE(*,*) '##W03 WARNING An unstable PS point was'
1488
 
     $           ,       ' detected.'
1489
 
                WRITE(*,*) '##W03 WARNING No quadruple precision wil'
1490
 
     $           //'l be used.'
 
1443
                WRITE(*,*) '##W03 WARNING An unstable PS point was',  
 
1444
     $                ' detected.'
 
1445
                WRITE(*,*) '##W03 WARNING No quadruple precision will'
 
1446
     $           //' be used.'
 
1447
                IF(FPE_IN_DP_REDUCTION) THEN
 
1448
                  WRITE(*,*) '## The last DP reduction was deemed'
 
1449
     $             //' unstable because a floating point exception was'
 
1450
     $             //' encountered.'
 
1451
                ENDIF
 
1452
                CALL ML5_0_COMPUTE_ACCURACY(DP_RES,N_DP_EVAL,ACC,ANS)
1491
1453
                IF (NSQUAREDSO.NE.1) THEN
1492
 
                  WRITE(*,*) 'Accuracies for each split orde'
1493
 
     $             //'r, starting with the summed case'
 
1454
                  WRITE(*,*) 'Accuracies for each split order,'
 
1455
     $             //' starting with the summed case'
1494
1456
                  WRITE(*,*) 'DP accuracies (for each split order): '
1495
1457
     $             ,(ACC(I),I=0,NSQUAREDSO)
1496
1458
                ELSE
1499
1461
                DO J=0,NSQUAREDSO
1500
1462
                  IF (NSQUAREDSO.NE.1.OR.J.NE.0) THEN
1501
1463
                    IF (J.EQ.0) THEN
1502
 
                      WRITE(*,*) 'Details for all split orders summe'
1503
 
     $                 //'d :'
 
1464
                      WRITE(*,*) 'Details for all split orders summed'
 
1465
     $                 //' :'
1504
1466
                    ELSE
1505
1467
                      WRITE(*,*) 'Details for split order index : ',J
1506
1468
                    ENDIF
1518
1480
                ENDDO
1519
1481
              ENDIF
1520
1482
              IF(NEPS.EQ.10) THEN
1521
 
                WRITE(*,*) 'Further output of the details of thes'
1522
 
     $           //'e unstable PS points will now be suppressed.'
 
1483
                WRITE(*,*) 'Further output of the details of these'
 
1484
     $           //' unstable PS points will now be suppressed.'
1523
1485
              ENDIF
1524
1486
            ENDIF
1525
1487
          ELSE
1580
1542
        CTMODEINIT=CTMODEINIT_BU
1581
1543
      ENDIF
1582
1544
 
 
1545
C     Reinitialize the Lorentz test if it had been disabled because
 
1546
C      spin-2 particles are in the external states.
 
1547
      NROTATIONS_DP = NROTATIONS_DP_BU
 
1548
      NROTATIONS_QP = NROTATIONS_QP_BU
 
1549
 
1583
1550
C     Reinitialize the check phase logicals and the filters if check
1584
1551
C      bypassed
1585
1552
      IF (BYPASS_CHECK) THEN
1594
1561
          ENDDO
1595
1562
        ENDDO
1596
1563
      ENDIF
 
1564
 
 
1565
C     Make sure that we finish by emptying caches
 
1566
      IF (AUTOMATIC_CACHE_CLEARING) THEN
 
1567
        CALL ML5_0_CLEAR_CACHES()
 
1568
      ENDIF
 
1569
      END
 
1570
 
 
1571
      SUBROUTINE ML5_0_CLEAR_CACHES()
 
1572
C     Clears all the caches used at some point in MadLoop
 
1573
      CALL ML5_0_CLEAR_TIR_CACHE()
1597
1574
      END
1598
1575
 
1599
1576
C     --=========================================--
1601
1578
C     for the main sloopmatrix subroutine
1602
1579
C     --=========================================--
1603
1580
 
1604
 
      LOGICAL FUNCTION ML5_0_ISZERO(TOTEST, REFERENCE_VALUE, LOOP
1605
 
     $ , SOINDEX)
 
1581
      LOGICAL FUNCTION ML5_0_ISZERO(TOTEST, REFERENCE_VALUE, LOOP,
 
1582
     $  SOINDEX)
1606
1583
      IMPLICIT NONE
1607
1584
C     
1608
1585
C     CONSTANTS
1628
1605
C     ----------
1629
1606
      IF(ABS(REFERENCE_VALUE).EQ.0.0D0) THEN
1630
1607
        ML5_0_ISZERO=.FALSE.
1631
 
        WRITE(*,*) '##E02 ERRROR Reference value for comparison i'
1632
 
     $   //'s zero.'
 
1608
        WRITE(*,*) '##E02 ERRROR Reference value for comparison is'
 
1609
     $   //' zero.'
1633
1610
        STOP 1
1634
1611
      ELSE
1635
1612
        ML5_0_ISZERO=((ABS(TOTEST)/ABS(REFERENCE_VALUE)).LT.ZEROTHRES)
1637
1614
 
1638
1615
      IF(LOOP.NE.-1) THEN
1639
1616
        IF((.NOT.ML5_0_ISZERO).AND.(.NOT.S(SOINDEX,LOOP))) THEN
1640
 
          WRITE(*,*) '##W01 WARNING Contribution ',LOOP,' of spli'
1641
 
     $     //'t order ',SOINDEX,' is detected as contributing wit'
1642
 
     $     //'h CR=',(ABS(TOTEST)/ABS(REFERENCE_VALUE)),' but i'
1643
 
     $     //'s unstable.'
 
1617
          WRITE(*,*) '##W01 WARNING Contribution ',LOOP,' of split'
 
1618
     $     //' order ',SOINDEX,' is detected as contributing with CR='
 
1619
     $     ,(ABS(TOTEST)/ABS(REFERENCE_VALUE)),' but is unstable.'
1644
1620
        ENDIF
1645
1621
      ENDIF
1646
1622
 
1650
1626
      IMPLICIT NONE
1651
1627
C     This function compares the result from two different helicity
1652
1628
C      configuration A and B
1653
 
C     It returns 0 if they are not related and (+/-wgt) if A=(+/-wgt)*B
1654
 
C     .
 
1629
C     It returns 0 if they are not related and (+/-wgt) if
 
1630
C      A=(+/-wgt)*B.
1655
1631
C     For now, the only wgt implemented is the integer 1 or -1.
1656
1632
C     If useMax is .TRUE., it uses all implemented weights no matter
1657
1633
C      what is HELINITSTARTOVER
1694
1670
      DO I=1,N_WGT_TO_TRY
1695
1671
        DO J=1,3
1696
1672
          IF (ML5_0_ISZERO(ABS(RESB(J)),REF,-1,-1)) THEN
1697
 
            IF(.NOT.ML5_0_ISZERO(ABS(RESB(J))+ABS(RESA(J)),REF,-1,
1698
 
     $       -1)) THEN
 
1673
            IF(.NOT.ML5_0_ISZERO(ABS(RESB(J))+ABS(RESA(J)),REF,-1,-1))
 
1674
     $        THEN
1699
1675
              GOTO 1231
1700
1676
            ENDIF
1701
1677
C           Be looser for helicity comparison, so bring a factor 100
1702
 
          ELSEIF(.NOT.ML5_0_ISZERO(ABS((RESA(J)/RESB(J))-DBLE(WGT_TO_TR
1703
 
     $     Y(I))),1.0D0,-1,-1)) THEN
 
1678
          ELSEIF(.NOT.ML5_0_ISZERO(ABS((RESA(J)/RESB(J))
 
1679
     $     -DBLE(WGT_TO_TRY(I))),1.0D0,-1,-1)) THEN
1704
1680
            GOTO 1231
1705
1681
          ENDIF
1706
1682
        ENDDO
1710
1686
      ENDDO
1711
1687
      END
1712
1688
 
1713
 
      SUBROUTINE ML5_0_COMPUTE_ACCURACY(FULLLIST, LENGTH, ACC
1714
 
     $ , ESTIMATE)
 
1689
      SUBROUTINE ML5_0_COMPUTE_ACCURACY(FULLLIST, LENGTH, ACC,
 
1690
     $  ESTIMATE)
1715
1691
      IMPLICIT NONE
1716
1692
C     
1717
1693
C     PARAMETERS 
1858
1834
 
1859
1835
      SUBROUTINE ML5_0_GET_ANSWER_DIMENSION(ANS_DIM)
1860
1836
C     
1861
 
C     MadLoop subroutines return an array of dimension ANS(0:3,0:ANS_DI
1862
 
C     M)
 
1837
C     MadLoop subroutines return an array of dimension
 
1838
C      ANS(0:3,0:ANS_DIM)
1863
1839
C     In order for the user program to be able to correctly declare
1864
1840
C      this
1865
1841
C     array when calling MadLoop, this subroutine returns its dimension
1908
1884
 1009   CONTINUE
1909
1885
      ENDDO
1910
1886
 
1911
 
      WRITE(*,*) 'ERROR:: Stopping function ML5_0_ML5SOINDEX_FOR_SQUAR'
1912
 
     $ //'ED_ORDERS'
 
1887
      WRITE(*,*) 'ERROR:: Stopping function ML5_0_ML5SOINDEX_FOR_SQUARE'
 
1888
     $ //'D_ORDERS'
1913
1889
      WRITE(*,*) 'Could not find squared orders ',(ORDERS(I),I=1,NSO)
1914
1890
      STOP
1915
1891
 
1937
1913
C     BEGIN CODE
1938
1914
C     -----------
1939
1915
      IF (AMPID.GT.NBORNAMPS) THEN
1940
 
        WRITE(*,*) 'ERROR:: Born amplitude ID ',AMPID,' above th'
1941
 
     $   //'e maximum ',NBORNAMPS
 
1916
        WRITE(*,*) 'ERROR:: Born amplitude ID ',AMPID,' above the'
 
1917
     $   //' maximum ',NBORNAMPS
1942
1918
      ENDIF
1943
1919
      ML5_0_ML5SOINDEX_FOR_BORN_AMP = BORNAMPORDERS(AMPID)
1944
1920
 
1966
1942
C     BEGIN CODE
1967
1943
C     -----------
1968
1944
      IF (AMPID.GT.NLOOPAMPS) THEN
1969
 
        WRITE(*,*) 'ERROR:: Loop amplitude ID ',AMPID,' above th'
1970
 
     $   //'e maximum ',NLOOPAMPS
 
1945
        WRITE(*,*) 'ERROR:: Loop amplitude ID ',AMPID,' above the'
 
1946
     $   //' maximum ',NLOOPAMPS
1971
1947
      ENDIF
1972
1948
      ML5_0_ML5SOINDEX_FOR_LOOP_AMP = LOOPAMPORDERS(AMPID)
1973
1949
 
1980
1956
C      be hardcoded or 
1981
1957
C     made more elegant using hashtables if its execution speed ever
1982
1958
C      becomes a relevant
1983
 
C     factor. From two split order indices, it return the corresponding
1984
 
C      index in the squared 
 
1959
C     factor. From two split order indices, it return the
 
1960
C      corresponding index in the squared 
1985
1961
C     order canonical ordering.
1986
1962
C     
1987
1963
C     CONSTANTS
2008
1984
C     
2009
1985
      DO I=1,NSO
2010
1986
        SQORDERS(I)=AMPSPLITORDERS(ORDERINDEXA,I)+AMPSPLITORDERS(ORDERI
2011
 
     $   NDEXB,I)
 
1987
     $NDEXB,I)
2012
1988
      ENDDO
2013
1989
      ML5_0_ML5SQSOINDEX=ML5_0_ML5SOINDEX_FOR_SQUARED_ORDERS(SQORDERS)
2014
1990
      END
2047
2023
        RETURN
2048
2024
      ENDIF
2049
2025
 
2050
 
      WRITE(*,*) 'ERROR:: Stopping function ML5_0_ML5GET_SQUARED_ORDER'
2051
 
     $ //'S_FOR_SOINDEX'
 
2026
      WRITE(*,*) 'ERROR:: Stopping function ML5_0_ML5GET_SQUARED_ORDERS'
 
2027
     $ //'_FOR_SOINDEX'
2052
2028
      WRITE(*,*) 'Could not find squared orders index ',SOINDEX
2053
2029
      STOP
2054
2030
 
2087
2063
        RETURN
2088
2064
      ENDIF
2089
2065
 
2090
 
      WRITE(*,*) 'ERROR:: Stopping function ML5_0_ML5GET_ORDERS_FOR_AM'
2091
 
     $ //'PSOINDEX'
 
2066
      WRITE(*,*) 'ERROR:: Stopping function ML5_0_ML5GET_ORDERS_FOR_AMP'
 
2067
     $ //'SOINDEX'
2092
2068
      WRITE(*,*) 'Could not find amplitude split orders index ',SOINDEX
2093
2069
      STOP
2094
2070
 
2095
2071
      END SUBROUTINE
2096
2072
 
2097
2073
 
2098
 
C     This function is not directly useful, but included for completene
2099
 
C     ss
 
2074
C     This function is not directly useful, but included for
 
2075
C      completeness
2100
2076
      INTEGER FUNCTION ML5_0_ML5SOINDEX_FOR_AMPORDERS(ORDERS)
2101
2077
C     
2102
2078
C     This functions returns the integer index identifying the
2131
2107
 1009   CONTINUE
2132
2108
      ENDDO
2133
2109
 
2134
 
      WRITE(*,*) 'ERROR:: Stopping function ML5_0_ML5SOINDEX_FOR_AMPOR'
2135
 
     $ //'DERS'
 
2110
      WRITE(*,*) 'ERROR:: Stopping function ML5_0_ML5SOINDEX_FOR_AMPORD'
 
2111
     $ //'ERS'
2136
2112
      WRITE(*,*) 'Could not find squared orders ',(ORDERS(I),I=1,NSO)
2137
2113
      STOP
2138
2114
 
2159
2135
 
2160
2136
      END SUBROUTINE
2161
2137
 
2162
 
      SUBROUTINE ML5_0_SET_AUTOMATIC_TIR_CACHE_CLEARING(ONOFF)
 
2138
      SUBROUTINE ML5_0_SET_AUTOMATIC_CACHE_CLEARING(ONOFF)
2163
2139
C     
2164
2140
C     This function can be called by the MadLoop user so as to
2165
2141
C      manually chose when
2171
2147
 
2172
2148
      LOGICAL ONOFF
2173
2149
 
2174
 
      LOGICAL AUTOMATIC_TIR_CACHE_CLEARING
2175
 
      DATA AUTOMATIC_TIR_CACHE_CLEARING/.TRUE./
2176
 
      COMMON/ML5_0_RUNTIME_OPTIONS/AUTOMATIC_TIR_CACHE_CLEARING
 
2150
      LOGICAL AUTOMATIC_CACHE_CLEARING
 
2151
      DATA AUTOMATIC_CACHE_CLEARING/.TRUE./
 
2152
      COMMON/ML5_0_RUNTIME_OPTIONS/AUTOMATIC_CACHE_CLEARING
2177
2153
 
2178
2154
      INTEGER N_DP_EVAL, N_QP_EVAL
2179
2155
      COMMON/ML5_0_N_EVALS/N_DP_EVAL,N_QP_EVAL
2180
2156
 
2181
 
      WRITE(*,*) 'Warning: No TIR caching implemented. Call t'
2182
 
     $ //'o SET_AUTOMATIC_TIR_CACHE_CLEARING did nothing.'
 
2157
      WRITE(*,*) 'Warning: No TIR caching implemented. Call to'
 
2158
     $ //' SET_AUTOMATIC_CACHE_CLEARING did nothing.'
2183
2159
      END SUBROUTINE
2184
2160
 
2185
2161
      SUBROUTINE ML5_0_SET_COUPLINGORDERS_TARGET(SOTARGET)
2272
2248
      USER_STAB_PREC = PREC_ASKED
2273
2249
 
2274
2250
      CALL ML5_0_SLOOPMATRIXHEL(P,HEL,ANS)
2275
 
      IF(ALWAYS_TEST_STABILITY.AND.(H.EQ.1.OR.ACCURACY(0).LT.0.0D0)
2276
 
     $ ) THEN
 
2251
      IF(ALWAYS_TEST_STABILITY.AND.(H.EQ.1.OR.ACCURACY(0).LT.0.0D0))
 
2252
     $  THEN
2277
2253
        BYPASS_CHECK = .TRUE.
2278
2254
        CALL ML5_0_SLOOPMATRIXHEL(P,HEL,ANS)
2279
2255
        BYPASS_CHECK = .FALSE.
2296
2272
     $ ,RET_CODE)
2297
2273
C     
2298
2274
C     Inputs are:
2299
 
C     P(0:3, Nexternal)  double  :: Kinematic configuration (E,px,py,pz
2300
 
C     )
 
2275
C     P(0:3, Nexternal)  double  :: Kinematic configuration
 
2276
C      (E,px,py,pz)
2301
2277
C     PEC_ASKED          double  :: Target relative accuracy, -1 for
2302
2278
C      default
2303
2279
C     
2342
2318
C     Stable with IREGI.
2343
2319
C     U == 4
2344
2320
C     Stable with Golem95
 
2321
C     U == 5
 
2322
C     Stable with Samurai
 
2323
C     U == 6
 
2324
C     Stable with Ninja in double precision
 
2325
C     U == 8
 
2326
C     Stable with Ninja in quadruple precision
2345
2327
C     U == 9
2346
2328
C     Stable with CutTools in quadruple precision.         
2347
2329
C     
2382
2364
C     ----------
2383
2365
      USER_STAB_PREC = PREC_ASKED
2384
2366
      CALL ML5_0_SLOOPMATRIX(P,ANS)
2385
 
      IF(ALWAYS_TEST_STABILITY.AND.(H.EQ.1.OR.ACCURACY(0).LT.0.0D0)
2386
 
     $ ) THEN
 
2367
      IF(ALWAYS_TEST_STABILITY.AND.(H.EQ.1.OR.ACCURACY(0).LT.0.0D0))
 
2368
     $  THEN
2387
2369
        BYPASS_CHECK = .TRUE.
2388
2370
        CALL ML5_0_SLOOPMATRIX(P,ANS)
2389
2371
        BYPASS_CHECK = .FALSE.
2408
2390
      CONTINUE
2409
2391
      END
2410
2392
 
2411