From 344eaa5f0915331b416bf150befc2520067c8b08 Mon Sep 17 00:00:00 2001 From: Olivier Mattelaer Date: Fri, 21 Aug 2026 10:47:14 +0200 Subject: [PATCH 1/6] loop-induced: stop the run when the poles do not cancel The vanishing-pole test of a loop-induced matrix element was emitted as Fortran comments (##W04/##W05) in the default MadLoop output and was absent altogether from the optimized one, which is the output every loop-induced madevent run uses. Nothing checked the poles. - add MLPoleCheckThres to MadLoopParams (default 1e-2, <=0 disables) - optimized output: compare |ANS(2,0)|+|ANS(3,0)| to ANS(1,0) once the result is final and STOP on failure; skipped when the reduction tool is not computing the poles (COLLIER with the pole flags off), with a one-time INFO saying so - default output: same check, plus the loop-induced squaring now builds the genuine eps^-1/eps^-2 coefficients of |M|^2 instead of a quantity linear in the pole (which is what needed the unexplained 10**5 fudge) - drop the dead ##W04 block: it tested each loop amplitude separately, but individual loop diagrams do have poles; only their sum is finite --- .../StandAlone/Cards/MadLoopParams.dat | 12 ++++ .../SubProcesses/MadLoopParamReader.f | 5 ++ .../StandAlone/SubProcesses/MadLoopParams.inc | 62 ++++++++++--------- .../loop/loop_matrix_standalone.inc | 3 + .../loop_optimized/loop_matrix_standalone.inc | 31 ++++++++++ madgraph/loop/loop_exporters.py | 46 ++++++++------ madgraph/various/banner.py | 1 + 7 files changed, 112 insertions(+), 48 deletions(-) diff --git a/Template/loop_material/StandAlone/Cards/MadLoopParams.dat b/Template/loop_material/StandAlone/Cards/MadLoopParams.dat index 425d909582..c0fbe34b8b 100644 --- a/Template/loop_material/StandAlone/Cards/MadLoopParams.dat +++ b/Template/loop_material/StandAlone/Cards/MadLoopParams.dat @@ -81,6 +81,18 @@ #MLStabThres !1.0d-3 ! Default :: 1.0d-3 + +! Relative threshold above which a non-vanishing pole of a *loop-induced* +! process is considered an error and stops the run. +! A loop-induced amplitude is finite, so its single and double poles must +! cancel; anything else means the result is wrong. This has no effect on +! processes with a Born, whose poles are not supposed to vanish. +! Set it to a negative value to disable the check. +! Note that the check is inactive when the reduction tool in use does not +! compute the poles at all (COLLIER with COLLIERComputeUV/IRpoles off). +#MLPoleCheckThres +!1.0d-2 +! Default :: 1.0d-2 ! You can add other evaluation method to check for the stability in DP and QP. ! Below you can chose if you want to use zero, one or two rotations of the PS point ! in QP. diff --git a/Template/loop_material/StandAlone/SubProcesses/MadLoopParamReader.f b/Template/loop_material/StandAlone/SubProcesses/MadLoopParamReader.f index d8b4951a10..f042a9b148 100644 --- a/Template/loop_material/StandAlone/SubProcesses/MadLoopParamReader.f +++ b/Template/loop_material/StandAlone/SubProcesses/MadLoopParamReader.f @@ -59,6 +59,9 @@ subroutine MadLoopParamReader(filename, printParam) stop 'MLStabThres must be >= 0' endif + else if (buff .eq. '#MLPoleCheckThres') then + read(666,*,end=999) MLPoleCheckThres + else if (buff .eq. '#COLLIERRequiredAccuracy') then read(666,*,end=999) COLLIERRequiredAccuracy if (COLLIERRequiredAccuracy.le.0.0d0.and. @@ -256,6 +259,7 @@ subroutine MadLoopParamReader(filename, printParam) $ //TRIM(MLReductionLib_str_save) write(*,*) ' > CTModeRun = ',CTModeRun write(*,*) ' > MLStabThres = ',MLStabThres + write(*,*) ' > MLPoleCheckThres = ',MLPoleCheckThres write(*,*) ' > NRotations_DP = ',NRotations_DP write(*,*) ' > NRotations_QP = ',NRotations_QP write(*,*) ' > CTStabThres = ',CTStabThres @@ -324,6 +328,7 @@ subroutine DefaultParam() NRotations_DP=0 NRotations_QP=0 MLStabThres=1.0d-3 + MLPoleCheckThres=1.0d-2 CTStabThres=1.0d-2 CTLoopLibrary=3 CheckCycle=3 diff --git a/Template/loop_material/StandAlone/SubProcesses/MadLoopParams.inc b/Template/loop_material/StandAlone/SubProcesses/MadLoopParams.inc index 008576b237..9faf928aac 100644 --- a/Template/loop_material/StandAlone/SubProcesses/MadLoopParams.inc +++ b/Template/loop_material/StandAlone/SubProcesses/MadLoopParams.inc @@ -1,30 +1,32 @@ -!==================================================================== -! -! Define common block with all general parameters used by MadLoop -! See their definitions in the file MadLoopParams.dat -! -!==================================================================== -! - integer CTModeInit,CTModeRun,CheckCycle,MaxAttempts, - &CTLoopLibrary,NRotations_DP,NRotations_QP,ImprovePSPoint, - &MLReductionLib(8),IREGIMODE,HelicityFilterLevel,COLLIERMode, - &COLLIERGlobalCache - - real*8 MLStabThres,CTStabThres,ZeroThres,OSThres,COLLIERRequiredAccuracy - - logical UseLoopFilter,LoopInitStartOver,DoubleCheckHelicityFilter, - &COLLIERComputeIRpoles,COLLIERComputeUVpoles,COLLIERCanOutput - logical HelInitStartOver,IREGIRECY,WriteOutFilters - logical UseQPIntegrandForNinja, UseQPIntegrandForCutTools - logical COLLIERUseCacheForPoles,COLLIERUseInternalStabilityTest - - common /MADLOOP/CTModeInit,CTModeRun,NRotations_DP,NRotations_QP, - &COLLIERMode,COLLIERGlobalCache, - &ImprovePSPoint,CheckCycle, MaxAttempts,UseLoopFilter,MLStabThres, - &COLLIERRequiredAccuracy, - &CTStabThres,CTLoopLibrary,LoopInitStartOver, - &COLLIERComputeIRpoles,COLLIERComputeUVpoles,COLLIERCanOutput, - &COLLIERUseCacheForPoles,COLLIERUseInternalStabilityTest, - &DoubleCheckHelicityFilter,ZeroThres,OSThres,HelInitStartOver, - &MLReductionLib,IREGIMODE,HelicityFilterLevel,IREGIRECY, - &WriteOutFilters,UseQPIntegrandForNinja,UseQPIntegrandForCutTools +!==================================================================== +! +! Define common block with all general parameters used by MadLoop +! See their definitions in the file MadLoopParams.dat +! +!==================================================================== +! + integer CTModeInit,CTModeRun,CheckCycle,MaxAttempts, + &CTLoopLibrary,NRotations_DP,NRotations_QP,ImprovePSPoint, + &MLReductionLib(8),IREGIMODE,HelicityFilterLevel,COLLIERMode, + &COLLIERGlobalCache + + real*8 MLStabThres,CTStabThres,ZeroThres,OSThres,COLLIERRequiredAccuracy + real*8 MLPoleCheckThres + + logical UseLoopFilter,LoopInitStartOver,DoubleCheckHelicityFilter, + &COLLIERComputeIRpoles,COLLIERComputeUVpoles,COLLIERCanOutput + logical HelInitStartOver,IREGIRECY,WriteOutFilters + logical UseQPIntegrandForNinja, UseQPIntegrandForCutTools + logical COLLIERUseCacheForPoles,COLLIERUseInternalStabilityTest + + common /MADLOOP/CTModeInit,CTModeRun,NRotations_DP,NRotations_QP, + &COLLIERMode,COLLIERGlobalCache, + &ImprovePSPoint,CheckCycle, MaxAttempts,UseLoopFilter,MLStabThres, + &MLPoleCheckThres, + &COLLIERRequiredAccuracy, + &CTStabThres,CTLoopLibrary,LoopInitStartOver, + &COLLIERComputeIRpoles,COLLIERComputeUVpoles,COLLIERCanOutput, + &COLLIERUseCacheForPoles,COLLIERUseInternalStabilityTest, + &DoubleCheckHelicityFilter,ZeroThres,OSThres,HelInitStartOver, + &MLReductionLib,IREGIMODE,HelicityFilterLevel,IREGIRECY, + &WriteOutFilters,UseQPIntegrandForNinja,UseQPIntegrandForCutTools diff --git a/madgraph/iolibs/template_files/loop/loop_matrix_standalone.inc b/madgraph/iolibs/template_files/loop/loop_matrix_standalone.inc index 5fa90a9bdc..e3f23fa31c 100644 --- a/madgraph/iolibs/template_files/loop/loop_matrix_standalone.inc +++ b/madgraph/iolibs/template_files/loop/loop_matrix_standalone.inc @@ -218,6 +218,7 @@ c the previous points DATA FOUND_VALID_REDUCTION_METHOD/.FALSE./ %(real_dp_format)s ACC + %(real_dp_format)s TMPPOLE,TMPPOLETHRES %(real_dp_format)s DP_RES(3,MAXSTABILITYLENGTH) C QP_RES STORES THE QUADRUPLE PRECISION RESULT OBTAINED FROM DIFFERENT EVALUATION METHODS IN ORDER TO ASSESS STABILITY. %(real_dp_format)s QP_RES(3,MAXSTABILITYLENGTH) @@ -928,6 +929,8 @@ ANSRETURNED(1,0)=ANS(1) ANSRETURNED(2,0)=ANS(2) ANSRETURNED(3,0)=ANS(3) +%(loop_induced_pole_check)s + C Reinitialize the check phase logicals and the filters if check bypassed IF (BYPASS_CHECK) THEN CHECKPHASE = OLD_CHECKPHASE diff --git a/madgraph/iolibs/template_files/loop_optimized/loop_matrix_standalone.inc b/madgraph/iolibs/template_files/loop_optimized/loop_matrix_standalone.inc index 6d8316e0c8..dff6267870 100644 --- a/madgraph/iolibs/template_files/loop_optimized/loop_matrix_standalone.inc +++ b/madgraph/iolibs/template_files/loop_optimized/loop_matrix_standalone.inc @@ -185,6 +185,9 @@ C QP_RES STORES THE QUADRUPLE PRECISION RESULT OBTAINED FROM DIFFERENT EVALUATIO INTEGER ITEMP LOGICAL LTEMP %(real_dp_format)s BORNBUFF(0:NSQSO_BORN),TMPR +## if(LoopInduced){ + %(real_dp_format)s TMPD +## } %(real_dp_format)s BUFFR(3,0:NSQUAREDSO),BUFFR_BIS(3,0:NSQUAREDSO),TEMP(0:3,0:NSQUAREDSO),TEMP1(0:NSQUAREDSO) %(complex_dp_format)s CTEMP ## if(not AmplitudeReduction){ @@ -534,6 +537,12 @@ C SKIP THE ONES THAT NOT AVAILABLE IF(MLReductionLib(1).EQ.0)THEN STOP "No available loop reduction lib is provided. Make sure MLReductionLib is correct." ENDIF +## if(LoopInduced){ +C The poles must vanish here, but COLLIER can be asked not to compute them at all. + IF (MLPoleCheckThres.GT.0.0d0.AND.MLReductionLib(1).EQ.7.AND.(.NOT.COLLIERComputeUVpoles.OR..NOT.COLLIERComputeIRpoles)) THEN + WRITE(*,*) '##INFO: The vanishing-pole check of this loop-induced process is disabled because COLLIER is not asked to compute the poles. Set COLLIERComputeUVpoles and COLLIERComputeIRpoles to .TRUE. in MadLoopParams.dat to enable it.' + ENDIF +## } J=0 DO I=1,NLOOPLIB IF(LOOPLIBS_QPAVAILABLE(MLReductionLib(I)))THEN @@ -1880,6 +1889,28 @@ DO I=1,NSQUAREDSO ENDIF ENDDO +## if(LoopInduced){ +C A loop-induced amplitude is finite, so its poles must cancel. If they do not, +C the result is wrong and we must not return it. Skipped when the reduction tool +C does not compute the poles, since ANS(2:3,0) is then identically zero anyway. +IF (MLPoleCheckThres.GT.0.0d0.AND..NOT.CHECKPHASE.AND.HELDOUBLECHECKED.AND.NTRY.GT.0.AND.RET_CODE_H.NE.4.AND.ANS(1,0).NE.0.0d0.AND..NOT.(MLReductionLib(I_LIB).EQ.7.AND.(.NOT.COLLIERComputeUVpoles.OR..NOT.COLLIERComputeIRpoles))) THEN + TMPR = (ABS(ANS(2,0))+ABS(ANS(3,0)))/ABS(ANS(1,0)) +C Never demand more than the accuracy MadLoop itself claims for this point. + TMPD = MLPoleCheckThres + IF (ACCURACY(0).GT.0.0d0) TMPD = MAX(TMPD,10.0d0*ACCURACY(0)) + IF (TMPR.GT.TMPD) THEN + WRITE(*,*) '##E02 ERROR The poles of this loop-induced process do not cancel.' + WRITE(*,*) 'Finite contribution = ',ANS(1,0) + WRITE(*,*) 'single pole contribution = ',ANS(2,0) + WRITE(*,*) 'double pole contribution = ',ANS(3,0) + WRITE(*,*) 'relative size of the poles = ',TMPR + WRITE(*,*) 'tolerated (MLPoleCheckThres)= ',TMPD + CALL %(proc_prefix)sWRITE_MOM(P) + STOP 1 + ENDIF +ENDIF +## } + C Reinitialize the default threshold if it was specified by the user IF (USER_STAB_PREC.GT.0.0d0) THEN MLSTABTHRES=MLSTABTHRES_BU diff --git a/madgraph/loop/loop_exporters.py b/madgraph/loop/loop_exporters.py index c856b53f8d..d12d18f357 100755 --- a/madgraph/loop/loop_exporters.py +++ b/madgraph/loop/loop_exporters.py @@ -1578,12 +1578,6 @@ def write_loopmatrix(self, writer, matrix_element, fortran_model, WRITE(*,*) '##W03 WARNING Contribution ',I WRITE(*,*) ' is unstable for helicity ',H ENDIF -C IF(.NOT.%(proc_prefix)sISZERO(ABS(AMPL(2,I))+ABS(AMPL(3,I)),REF,-1,H)) THEN -C WRITE(*,*) '##W04 WARNING Contribution ',I,' for helicity ',H,' has a contribution to the poles.' -C WRITE(*,*) 'Finite contribution = ',AMPL(1,I) -C WRITE(*,*) 'single pole contribution = ',AMPL(2,I) -C WRITE(*,*) 'double pole contribution = ',AMPL(3,I) -C ENDIF ENDDO 1227 CONTINUE HELPICKED=HELPICKED_BU""")%replace_dict @@ -1592,10 +1586,9 @@ def write_loopmatrix(self, writer, matrix_element, fortran_model, replace_dict['nbornamps_or_nloopamps']='nloopamps' replace_dict['squaring']=\ """ANS(1)=ANS(1)+DBLE(CFTOT*AMPL(1,I)*DCONJG(AMPL(1,J))) - IF (J.EQ.1) THEN - ANS(2)=ANS(2)+DBLE(CFTOT*AMPL(2,I))+DIMAG(CFTOT*AMPL(2,I)) - ANS(3)=ANS(3)+DBLE(CFTOT*AMPL(3,I))+DIMAG(CFTOT*AMPL(3,I)) - ENDIF""" +C The poles below must cancel: the loop-induced amplitude is finite. + ANS(2)=ANS(2)+DBLE(CFTOT*(AMPL(2,I)*DCONJG(AMPL(1,J))+AMPL(1,I)*DCONJG(AMPL(2,J)))) + ANS(3)=ANS(3)+DBLE(CFTOT*(AMPL(3,I)*DCONJG(AMPL(1,J))+AMPL(1,I)*DCONJG(AMPL(3,J))+AMPL(2,I)*DCONJG(AMPL(2,J))))""" else: replace_dict['compute_born']=\ """C Compute the born, for a specific helicity if asked so. @@ -1633,15 +1626,32 @@ def write_loopmatrix(self, writer, matrix_element, fortran_model, "WRITE(*,*) '##W03 WARNING Contribution ',I,' is unstable.'") actualize_ans.extend(["ENDIF","ENDDO"]) replace_dict['actualize_ans']='\n'.join(actualize_ans) + replace_dict['loop_induced_pole_check'] = "" else: - replace_dict['actualize_ans']=\ - ("""C We add five powers to the reference value to loosen a bit the vanishing pole check. -C IF(.NOT.(CHECKPHASE.OR.(.NOT.HELDOUBLECHECKED)).AND..NOT.%(proc_prefix)sISZERO(ABS(ANS(2))+ABS(ANS(3)),ABS(ANS(1))*(10.0d0**5),-1,H)) THEN -C WRITE(*,*) '##W05 WARNING Found a PS point with a contribution to the single pole.' -C WRITE(*,*) 'Finite contribution = ',ANS(1) -C WRITE(*,*) 'single pole contribution = ',ANS(2) -C WRITE(*,*) 'double pole contribution = ',ANS(3) -C ENDIF""")%replace_dict + replace_dict['actualize_ans']="" + # A loop-induced amplitude is finite: a surviving pole means the + # result is wrong, so refuse to return it. This output only ever + # reduces with CutTools, which always computes the poles. + replace_dict['loop_induced_pole_check']=(""" +IF (MLPoleCheckThres.GT.0.0d0.AND..NOT.CHECKPHASE.AND.HELDOUBLECHECKED.AND.NTRY.GT.0.AND.RET_CODE_H.NE.4.AND.ANS(1).NE.0.0d0) THEN + TMPPOLE = (ABS(ANS(2))+ABS(ANS(3)))/ABS(ANS(1)) +C Never demand more than the accuracy MadLoop itself claims for this point. + TMPPOLETHRES = MLPoleCheckThres + IF (ACCURACY(0).GT.0.0d0) TMPPOLETHRES = MAX(TMPPOLETHRES,10.0d0*ACCURACY(0)) + IF (TMPPOLE.GT.TMPPOLETHRES) THEN + WRITE(*,*) '##E02 ERROR The poles of this loop-induced process do not cancel.' + WRITE(*,*) 'Finite contribution = ',ANS(1) + WRITE(*,*) 'single pole contribution = ',ANS(2) + WRITE(*,*) 'double pole contribution = ',ANS(3) + WRITE(*,*) 'relative size of the poles = ',TMPPOLE + WRITE(*,*) 'tolerated (MLPoleCheckThres)= ',TMPPOLETHRES + WRITE(*,*) 'Renormalization scale MU_R = ',MU_R + DO I=1,NEXTERNAL + WRITE (*,'(i2,1x,4e27.17)') I, P(0,I),P(1,I),P(2,I),P(3,I) + ENDDO + STOP 1 + ENDIF +ENDIF""")%replace_dict # Write out the color matrix (CMNum,CMDenom) = self.get_color_matrix(matrix_element) diff --git a/madgraph/various/banner.py b/madgraph/various/banner.py index 1296516a87..005905161e 100755 --- a/madgraph/various/banner.py +++ b/madgraph/various/banner.py @@ -7414,6 +7414,7 @@ def default_setup(self): self.add_param("IREGIRECY", True) self.add_param("CTModeRun", -1) self.add_param("MLStabThres", 1e-3) + self.add_param("MLPoleCheckThres", 1e-2) self.add_param("NRotations_DP", 0) self.add_param("NRotations_QP", 0) self.add_param("ImprovePSPoint", 2) From 3dcb9d93a22704390b32de211f5191bf972c720b Mon Sep 17 00:00:00 2001 From: Olivier Mattelaer Date: Fri, 21 Aug 2026 11:12:07 +0200 Subject: [PATCH 2/6] loop-induced pole check: keep non-loop-induced output byte-identical - gate the new declarations/blocks so a process with a Born produces the exact same loop_matrix.f as before (verified for g g > t t~ [virt=QCD] and by the short_ML_SMQCD_default/optimized IO tests) - keep the COLLIER pole computation on for standalone loop-induced output, otherwise the check can never run there - madevent loop-induced: compare |1eps|+|2eps|, not the signed sum, so a positive single pole cannot hide a negative double pole - update the short_ML_SMQCD_LoopInduced/gg_hh reference --- .../loop/loop_matrix_standalone.inc | 5 +- .../loop_optimized/loop_matrix_standalone.inc | 1 - .../matrix_loop_induced_madevent.inc | 4 +- .../matrix_loop_induced_madevent_group.inc | 4 +- madgraph/loop/loop_exporters.py | 17 +++--- .../gg_hh/loop_matrix.f | 57 +++++++++++-------- 6 files changed, 45 insertions(+), 43 deletions(-) diff --git a/madgraph/iolibs/template_files/loop/loop_matrix_standalone.inc b/madgraph/iolibs/template_files/loop/loop_matrix_standalone.inc index e3f23fa31c..00f9f87b79 100644 --- a/madgraph/iolibs/template_files/loop/loop_matrix_standalone.inc +++ b/madgraph/iolibs/template_files/loop/loop_matrix_standalone.inc @@ -217,8 +217,7 @@ c the previous points LOGICAL FOUND_VALID_REDUCTION_METHOD DATA FOUND_VALID_REDUCTION_METHOD/.FALSE./ - %(real_dp_format)s ACC - %(real_dp_format)s TMPPOLE,TMPPOLETHRES + %(real_dp_format)s ACC%(loop_induced_pole_check_decl)s %(real_dp_format)s DP_RES(3,MAXSTABILITYLENGTH) C QP_RES STORES THE QUADRUPLE PRECISION RESULT OBTAINED FROM DIFFERENT EVALUATION METHODS IN ORDER TO ASSESS STABILITY. %(real_dp_format)s QP_RES(3,MAXSTABILITYLENGTH) @@ -928,9 +927,7 @@ ANSRETURNED(0,0)=ANS(0) ANSRETURNED(1,0)=ANS(1) ANSRETURNED(2,0)=ANS(2) ANSRETURNED(3,0)=ANS(3) - %(loop_induced_pole_check)s - C Reinitialize the check phase logicals and the filters if check bypassed IF (BYPASS_CHECK) THEN CHECKPHASE = OLD_CHECKPHASE diff --git a/madgraph/iolibs/template_files/loop_optimized/loop_matrix_standalone.inc b/madgraph/iolibs/template_files/loop_optimized/loop_matrix_standalone.inc index dff6267870..632074d8b0 100644 --- a/madgraph/iolibs/template_files/loop_optimized/loop_matrix_standalone.inc +++ b/madgraph/iolibs/template_files/loop_optimized/loop_matrix_standalone.inc @@ -1888,7 +1888,6 @@ DO I=1,NSQUAREDSO ENDDO ENDIF ENDDO - ## if(LoopInduced){ C A loop-induced amplitude is finite, so its poles must cancel. If they do not, C the result is wrong and we must not return it. Skipped when the reduction tool diff --git a/madgraph/iolibs/template_files/matrix_loop_induced_madevent.inc b/madgraph/iolibs/template_files/matrix_loop_induced_madevent.inc index 8b9e7df044..c8d72bfa81 100644 --- a/madgraph/iolibs/template_files/matrix_loop_induced_madevent.inc +++ b/madgraph/iolibs/template_files/matrix_loop_induced_madevent.inc @@ -415,11 +415,11 @@ c ---- return endif - IF (U.NE.7.AND.((OneEps+TwoEps)/finite).gt.(1000d0*PREC).AND.(((OneEps+TwoEps)/finite).gt.1.0d-5)) THEN + IF (U.NE.7.AND.((ABS(OneEps)+ABS(TwoEps))/ABS(finite)).gt.(1000d0*PREC).AND.(((ABS(OneEps)+ABS(TwoEps))/ABS(finite)).gt.1.0d-5)) THEN WARNING_COUNTERS(2) = WARNING_COUNTERS(2) + 1 IF (WARNING_COUNTERS(2).le.10) THEN WRITE(*,*) "WARNING : The residue of the single and double pole of the loop matrix element being integrated does not seem to vanish." - WRITE(*,*) " Its contribution relative to the finite part is : ",((OneEps+TwoEps)/finite) + WRITE(*,*) " Its contribution relative to the finite part is : ",((ABS(OneEps)+ABS(TwoEps))/ABS(finite)) WRITE(*,*) " while the estimated numerical accuracy is : ",PREC WRITE(*,*) " MadLoop results (fin, 1eps, 2eps) : ",finite, OneEps, TwoEps WRITE(*,*) " The warning above was triggered when processing the following phase space point:" diff --git a/madgraph/iolibs/template_files/matrix_loop_induced_madevent_group.inc b/madgraph/iolibs/template_files/matrix_loop_induced_madevent_group.inc index 8768bbf88e..8350cb25a9 100644 --- a/madgraph/iolibs/template_files/matrix_loop_induced_madevent_group.inc +++ b/madgraph/iolibs/template_files/matrix_loop_induced_madevent_group.inc @@ -425,11 +425,11 @@ c ---- return endif - IF (U.NE.7.and.((OneEps+TwoEps)/finite).gt.(1000d0*PREC).AND.(((OneEps+TwoEps)/finite).gt.1.0d-5)) THEN + IF (U.NE.7.and.((ABS(OneEps)+ABS(TwoEps))/ABS(finite)).gt.(1000d0*PREC).AND.(((ABS(OneEps)+ABS(TwoEps))/ABS(finite)).gt.1.0d-5)) THEN WARNING_COUNTERS(2) = WARNING_COUNTERS(2) + 1 IF (WARNING_COUNTERS(2).le.10) THEN WRITE(*,*) "WARNING : The residue of the single and double pole of the loop matrix element being integrated does not seem to vanish." - WRITE(*,*) " Its contribution relative to the finite part is : ",((OneEps+TwoEps)/finite) + WRITE(*,*) " Its contribution relative to the finite part is : ",((ABS(OneEps)+ABS(TwoEps))/ABS(finite)) WRITE(*,*) " while the estimated numerical accuracy is : ",PREC WRITE(*,*) " MadLoop results (fin, 1eps, 2eps) : ",finite, OneEps, TwoEps WRITE(*,*) " The warning above was triggered when processing the following phase space point:" diff --git a/madgraph/loop/loop_exporters.py b/madgraph/loop/loop_exporters.py index d12d18f357..15c08c32c0 100755 --- a/madgraph/loop/loop_exporters.py +++ b/madgraph/loop/loop_exporters.py @@ -267,13 +267,10 @@ def finalize(self, matrix_element, cmdhistory, MG5options, outputflag): # (which is the default for standalone usage), COLLIER is faster than Ninja. if self.has_loop_induced: MLCard['MLReductionLib'] = "7|6|1" - # Computing the poles with COLLIER also unnecessarily slows down the code - # It should only be set to True for checks and it's acceptable to remove them - # here because for loop-induced processes they should be zero anyway. - # We keep it active for non-loop induced processes because COLLIER is not the - # main reduction tool in that case, and the poles wouldn't be zero then - MLCard['COLLIERComputeUVpoles'] = False - MLCard['COLLIERComputeIRpoles'] = False + # The COLLIER pole computation is left on here: the poles must vanish + # for a loop-induced process and MadLoop only checks that when they are + # computed. 'check timing'/'check stability' turn them off themselves, + # and so does the madevent event loop, where the cost is not worth it. MLCard.write(pjoin(self.dir_path, 'Cards', 'MadLoopParams_default.dat')) MLCard.write(pjoin(self.dir_path, 'Cards', 'MadLoopParams.dat')) @@ -1627,13 +1624,15 @@ def write_loopmatrix(self, writer, matrix_element, fortran_model, actualize_ans.extend(["ENDIF","ENDDO"]) replace_dict['actualize_ans']='\n'.join(actualize_ans) replace_dict['loop_induced_pole_check'] = "" + replace_dict['loop_induced_pole_check_decl'] = "" else: replace_dict['actualize_ans']="" # A loop-induced amplitude is finite: a surviving pole means the # result is wrong, so refuse to return it. This output only ever # reduces with CutTools, which always computes the poles. - replace_dict['loop_induced_pole_check']=(""" -IF (MLPoleCheckThres.GT.0.0d0.AND..NOT.CHECKPHASE.AND.HELDOUBLECHECKED.AND.NTRY.GT.0.AND.RET_CODE_H.NE.4.AND.ANS(1).NE.0.0d0) THEN + replace_dict['loop_induced_pole_check_decl']=\ + "\n\t %(real_dp_format)s TMPPOLE,TMPPOLETHRES"%replace_dict + replace_dict['loop_induced_pole_check']=("""IF (MLPoleCheckThres.GT.0.0d0.AND..NOT.CHECKPHASE.AND.HELDOUBLECHECKED.AND.NTRY.GT.0.AND.RET_CODE_H.NE.4.AND.ANS(1).NE.0.0d0) THEN TMPPOLE = (ABS(ANS(2))+ABS(ANS(3)))/ABS(ANS(1)) C Never demand more than the accuracy MadLoop itself claims for this point. TMPPOLETHRES = MLPoleCheckThres diff --git a/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced/gg_hh/loop_matrix.f b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced/gg_hh/loop_matrix.f index 9ca243f59f..787e881fca 100644 --- a/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced/gg_hh/loop_matrix.f +++ b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced/gg_hh/loop_matrix.f @@ -229,6 +229,7 @@ SUBROUTINE ML5_0_SLOOPMATRIX(P_USER,ANSRETURNED) DATA FOUND_VALID_REDUCTION_METHOD/.FALSE./ REAL*8 ACC + REAL*8 TMPPOLE,TMPPOLETHRES REAL*8 DP_RES(3,MAXSTABILITYLENGTH) C QP_RES STORES THE QUADRUPLE PRECISION RESULT OBTAINED FROM C DIFFERENT EVALUATION METHODS IN ORDER TO ASSESS STABILITY. @@ -871,14 +872,6 @@ SUBROUTINE ML5_0_SLOOPMATRIX(P_USER,ANSRETURNED) WRITE(*,*) '##W03 WARNING Contribution ',I WRITE(*,*) ' is unstable for helicity ',H ENDIF -C IF(.NOT.ML5_0_ISZERO(ABS(AMPL(2,I))+ABS(AMPL(3,I)),REF,-1,H) -C ) THEN -C WRITE(*,*) '##W04 WARNING Contribution ',I,' for helicity' -C //' ',H,' has a contribution to the poles.' -C WRITE(*,*) 'Finite contribution = ',AMPL(1,I) -C WRITE(*,*) 'single pole contribution = ',AMPL(2,I) -C WRITE(*,*) 'double pole contribution = ',AMPL(3,I) -C ENDIF ENDDO 1227 CONTINUE HELPICKED=HELPICKED_BU @@ -887,12 +880,13 @@ SUBROUTINE ML5_0_SLOOPMATRIX(P_USER,ANSRETURNED) CFTOT=DCMPLX(CF_N(I,J)/DBLE(ABS(CF_D(I,J))),0.0D0) IF(CF_D(I,J).LT.0) CFTOT=CFTOT*IMAG1 ANS(1)=ANS(1)+DBLE(CFTOT*AMPL(1,I)*DCONJG(AMPL(1,J))) - IF (J.EQ.1) THEN - ANS(2)=ANS(2)+DBLE(CFTOT*AMPL(2,I))+DIMAG(CFTOT*AMPL(2 - $ ,I)) - ANS(3)=ANS(3)+DBLE(CFTOT*AMPL(3,I))+DIMAG(CFTOT*AMPL(3 - $ ,I)) - ENDIF +C The poles below must cancel: the loop-induced amplitude +C is finite. + ANS(2)=ANS(2)+DBLE(CFTOT*(AMPL(2,I)*DCONJG(AMPL(1,J)) + $ +AMPL(1,I)*DCONJG(AMPL(2,J)))) + ANS(3)=ANS(3)+DBLE(CFTOT*(AMPL(3,I)*DCONJG(AMPL(1,J)) + $ +AMPL(1,I)*DCONJG(AMPL(3,J))+AMPL(2,I)*DCONJG(AMPL(2,J)) + $ )) ENDDO ENDDO ENDIF @@ -910,16 +904,7 @@ SUBROUTINE ML5_0_SLOOPMATRIX(P_USER,ANSRETURNED) -C We add five powers to the reference value to loosen a bit the -C vanishing pole check. -C IF(.NOT.(CHECKPHASE.OR.(.NOT.HELDOUBLECHECKED)).AND..NOT.ML5_0_IS -C ZERO(ABS(ANS(2))+ABS(ANS(3)),ABS(ANS(1))*(10.0d0**5),-1,H)) THEN -C WRITE(*,*) '##W05 WARNING Found a PS point with a contribution' -C //' to the single pole.' -C WRITE(*,*) 'Finite contribution = ',ANS(1) -C WRITE(*,*) 'single pole contribution = ',ANS(2) -C WRITE(*,*) 'double pole contribution = ',ANS(3) -C ENDIF + 1226 CONTINUE @@ -1193,7 +1178,29 @@ SUBROUTINE ML5_0_SLOOPMATRIX(P_USER,ANSRETURNED) ANSRETURNED(1,0)=ANS(1) ANSRETURNED(2,0)=ANS(2) ANSRETURNED(3,0)=ANS(3) - + IF (MLPOLECHECKTHRES.GT.0.0D0.AND..NOT.CHECKPHASE.AND.HELDOUBLECH + $ECKED.AND.NTRY.GT.0.AND.RET_CODE_H.NE.4.AND.ANS(1).NE.0.0D0) THEN + TMPPOLE = (ABS(ANS(2))+ABS(ANS(3)))/ABS(ANS(1)) +C Never demand more than the accuracy MadLoop itself claims for +C this point. + TMPPOLETHRES = MLPOLECHECKTHRES + IF (ACCURACY(0).GT.0.0D0) TMPPOLETHRES = MAX(TMPPOLETHRES + $ ,10.0D0*ACCURACY(0)) + IF (TMPPOLE.GT.TMPPOLETHRES) THEN + WRITE(*,*) '##E02 ERROR The poles of this loop-induced' + $ //' process do not cancel.' + WRITE(*,*) 'Finite contribution = ',ANS(1) + WRITE(*,*) 'single pole contribution = ',ANS(2) + WRITE(*,*) 'double pole contribution = ',ANS(3) + WRITE(*,*) 'relative size of the poles = ',TMPPOLE + WRITE(*,*) 'tolerated (MLPoleCheckThres)= ',TMPPOLETHRES + WRITE(*,*) 'Renormalization scale MU_R = ',MU_R + DO I=1,NEXTERNAL + WRITE (*,'(i2,1x,4e27.17)') I, P(0,I),P(1,I),P(2,I),P(3,I) + ENDDO + STOP 1 + ENDIF + ENDIF C Reinitialize the check phase logicals and the filters if check C bypassed IF (BYPASS_CHECK) THEN From 1c713cb5d643f3c090cad92bf466a64ec98b65dd Mon Sep 17 00:00:00 2001 From: Olivier Mattelaer Date: Fri, 21 Aug 2026 11:20:36 +0200 Subject: [PATCH 3/6] restore CRLF line endings in MadLoopParams.inc --- .../StandAlone/SubProcesses/MadLoopParams.inc | 64 +++++++++---------- 1 file changed, 32 insertions(+), 32 deletions(-) diff --git a/Template/loop_material/StandAlone/SubProcesses/MadLoopParams.inc b/Template/loop_material/StandAlone/SubProcesses/MadLoopParams.inc index 9faf928aac..1e14c22f64 100644 --- a/Template/loop_material/StandAlone/SubProcesses/MadLoopParams.inc +++ b/Template/loop_material/StandAlone/SubProcesses/MadLoopParams.inc @@ -1,32 +1,32 @@ -!==================================================================== -! -! Define common block with all general parameters used by MadLoop -! See their definitions in the file MadLoopParams.dat -! -!==================================================================== -! - integer CTModeInit,CTModeRun,CheckCycle,MaxAttempts, - &CTLoopLibrary,NRotations_DP,NRotations_QP,ImprovePSPoint, - &MLReductionLib(8),IREGIMODE,HelicityFilterLevel,COLLIERMode, - &COLLIERGlobalCache - - real*8 MLStabThres,CTStabThres,ZeroThres,OSThres,COLLIERRequiredAccuracy - real*8 MLPoleCheckThres - - logical UseLoopFilter,LoopInitStartOver,DoubleCheckHelicityFilter, - &COLLIERComputeIRpoles,COLLIERComputeUVpoles,COLLIERCanOutput - logical HelInitStartOver,IREGIRECY,WriteOutFilters - logical UseQPIntegrandForNinja, UseQPIntegrandForCutTools - logical COLLIERUseCacheForPoles,COLLIERUseInternalStabilityTest - - common /MADLOOP/CTModeInit,CTModeRun,NRotations_DP,NRotations_QP, - &COLLIERMode,COLLIERGlobalCache, - &ImprovePSPoint,CheckCycle, MaxAttempts,UseLoopFilter,MLStabThres, - &MLPoleCheckThres, - &COLLIERRequiredAccuracy, - &CTStabThres,CTLoopLibrary,LoopInitStartOver, - &COLLIERComputeIRpoles,COLLIERComputeUVpoles,COLLIERCanOutput, - &COLLIERUseCacheForPoles,COLLIERUseInternalStabilityTest, - &DoubleCheckHelicityFilter,ZeroThres,OSThres,HelInitStartOver, - &MLReductionLib,IREGIMODE,HelicityFilterLevel,IREGIRECY, - &WriteOutFilters,UseQPIntegrandForNinja,UseQPIntegrandForCutTools +!==================================================================== +! +! Define common block with all general parameters used by MadLoop +! See their definitions in the file MadLoopParams.dat +! +!==================================================================== +! + integer CTModeInit,CTModeRun,CheckCycle,MaxAttempts, + &CTLoopLibrary,NRotations_DP,NRotations_QP,ImprovePSPoint, + &MLReductionLib(8),IREGIMODE,HelicityFilterLevel,COLLIERMode, + &COLLIERGlobalCache + + real*8 MLStabThres,CTStabThres,ZeroThres,OSThres,COLLIERRequiredAccuracy + real*8 MLPoleCheckThres + + logical UseLoopFilter,LoopInitStartOver,DoubleCheckHelicityFilter, + &COLLIERComputeIRpoles,COLLIERComputeUVpoles,COLLIERCanOutput + logical HelInitStartOver,IREGIRECY,WriteOutFilters + logical UseQPIntegrandForNinja, UseQPIntegrandForCutTools + logical COLLIERUseCacheForPoles,COLLIERUseInternalStabilityTest + + common /MADLOOP/CTModeInit,CTModeRun,NRotations_DP,NRotations_QP, + &COLLIERMode,COLLIERGlobalCache, + &ImprovePSPoint,CheckCycle, MaxAttempts,UseLoopFilter,MLStabThres, + &MLPoleCheckThres, + &COLLIERRequiredAccuracy, + &CTStabThres,CTLoopLibrary,LoopInitStartOver, + &COLLIERComputeIRpoles,COLLIERComputeUVpoles,COLLIERCanOutput, + &COLLIERUseCacheForPoles,COLLIERUseInternalStabilityTest, + &DoubleCheckHelicityFilter,ZeroThres,OSThres,HelInitStartOver, + &MLReductionLib,IREGIMODE,HelicityFilterLevel,IREGIRECY, + &WriteOutFilters,UseQPIntegrandForNinja,UseQPIntegrandForCutTools From 9ff2ebfc686aedd7b621cccc47b6813470357182 Mon Sep 17 00:00:00 2001 From: Olivier Mattelaer Date: Fri, 21 Aug 2026 11:21:17 +0200 Subject: [PATCH 4/6] MadLoopParams.dat: separate the new entry from the NRotations preamble --- Template/loop_material/StandAlone/Cards/MadLoopParams.dat | 1 + 1 file changed, 1 insertion(+) diff --git a/Template/loop_material/StandAlone/Cards/MadLoopParams.dat b/Template/loop_material/StandAlone/Cards/MadLoopParams.dat index c0fbe34b8b..59d2ebf98b 100644 --- a/Template/loop_material/StandAlone/Cards/MadLoopParams.dat +++ b/Template/loop_material/StandAlone/Cards/MadLoopParams.dat @@ -93,6 +93,7 @@ #MLPoleCheckThres !1.0d-2 ! Default :: 1.0d-2 + ! You can add other evaluation method to check for the stability in DP and QP. ! Below you can chose if you want to use zero, one or two rotations of the PS point ! in QP. From fa49bf3ea068ab242d04e3ff35be33b965b190b9 Mon Sep 17 00:00:00 2001 From: Olivier Mattelaer Date: Fri, 21 Aug 2026 12:09:24 +0200 Subject: [PATCH 5/6] loop-induced pole check: review fixes - ##E02 was already taken by the zero-reference error: use ##E03 - the ##INFO told users to flip COLLIERComputeUV/IRpoles in the card, which a madevent run overrides at init; say so instead - name the guard conditions (POLES_COMPUTED / DO_POLE_CHECK) so the writer stops splitting a 230-char line mid-identifier - say in the STOP message how to change or disable the tolerance - drop the 10*ACCURACY(0) valve. ACCURACY is the accuracy of the *finite part* and it does not bound the pole residue: a g g > z z g point at threshold comes back H=2, "stable, no rescue needed", with a residue of 5.2e-2. Keying the tolerance on it was simply the wrong instrument. It also never fired -- ACCURACY(0) is -1 whenever the stability test did not run -- so removing it leaves the effective tolerance unchanged. - non-optimized output: use WRITE_MOM like the optimized one, and stop leaving blank lines where ##W05 used to be (Born output unchanged) - IOTest gg_hh now covers BOTH exporters; the optimized one is what every real loop-induced run uses and had no golden file. process_info.inc needs 'git add -f': .gitignore's PROC* pattern matches it on a case-insensitive filesystem, so plain 'git add' skips it silently and the test then dies with "Missing ref. files". --- .../loop/loop_matrix_standalone.inc | 5 +- .../loop_optimized/loop_matrix_standalone.inc | 26 +- madgraph/loop/loop_exporters.py | 26 +- ....%Source%MODEL%actualize_mp_ext_params.inc | 0 .../gg_hh/%..%..%Source%MODEL%coupl.inc | 0 .../gg_hh/%..%..%Source%MODEL%coupl_write.inc | 0 .../gg_hh/%..%..%Source%MODEL%couplings.f | 0 .../gg_hh/%..%..%Source%MODEL%couplings1.f | 0 .../gg_hh/%..%..%Source%MODEL%couplings2.f | 0 .../gg_hh/%..%..%Source%MODEL%couplings3.f | 0 .../%..%..%Source%MODEL%flavor_couplings.f | 0 .../gg_hh/%..%..%Source%MODEL%formats.inc | 0 .../gg_hh/%..%..%Source%MODEL%get_color.f | 0 .../gg_hh/%..%..%Source%MODEL%input.inc | 0 .....%..%Source%MODEL%intparam_definition.inc | 0 .../gg_hh/%..%..%Source%MODEL%makeinc.inc | 0 .../%..%..%Source%MODEL%model_functions.f | 0 .../%..%..%Source%MODEL%model_functions.inc | 0 .../gg_hh/%..%..%Source%MODEL%mp_coupl.inc | 0 ...%..%..%Source%MODEL%mp_coupl_same_name.inc | 0 .../gg_hh/%..%..%Source%MODEL%mp_couplings1.f | 0 .../gg_hh/%..%..%Source%MODEL%mp_couplings2.f | 0 .../gg_hh/%..%..%Source%MODEL%mp_couplings3.f | 0 .../gg_hh/%..%..%Source%MODEL%mp_input.inc | 0 .....%Source%MODEL%mp_intparam_definition.inc | 0 .../gg_hh/%..%..%Source%MODEL%printout.f | 0 .../gg_hh/%..%..%Source%MODEL%rw_para.f | 0 .../gg_hh/%..%..%Source%MODEL%testprog.f | 0 ...oop5_resources%ML5_0_ColorDenomFactors.dat | 0 ...dLoop5_resources%ML5_0_ColorNumFactors.dat | 0 .../%MadLoop5_resources%ML5_0_HelConfigs.dat | 0 .../gg_hh/CT_interface.f | 0 .../gg_hh/check_sa.f | 0 .../gg_hh/improve_ps.f | 0 .../gg_hh/loop_matrix.f | 35 +- .../gg_hh/loop_num.f | 0 .../gg_hh/mp_born_amps_and_wfs.f | 0 .../gg_hh/nexternal.inc | 0 .../gg_hh/ngraphs.inc | 0 .../gg_hh/nsquaredSO.inc | 0 .../gg_hh/pmass.inc | 0 .../gg_hh/process_info.inc | 0 .../gg_hh/unique_id.inc | 0 ....%Source%MODEL%actualize_mp_ext_params.inc | 7 + .../gg_hh/%..%..%Source%MODEL%coupl.inc | 41 + .../gg_hh/%..%..%Source%MODEL%coupl_write.inc | 15 + .../gg_hh/%..%..%Source%MODEL%couplings.f | 158 + .../gg_hh/%..%..%Source%MODEL%couplings1.f | 19 + .../gg_hh/%..%..%Source%MODEL%couplings2.f | 16 + .../gg_hh/%..%..%Source%MODEL%couplings3.f | 29 + .../%..%..%Source%MODEL%flavor_couplings.f | 30 + .../gg_hh/%..%..%Source%MODEL%formats.inc | 30 + .../gg_hh/%..%..%Source%MODEL%get_color.f | 158 + .../gg_hh/%..%..%Source%MODEL%input.inc | 42 + .....%..%Source%MODEL%intparam_definition.inc | 169 + .../gg_hh/%..%..%Source%MODEL%makeinc.inc | 5 + .../%..%..%Source%MODEL%model_functions.f | 1038 ++++++ .../%..%..%Source%MODEL%model_functions.inc | 32 + .../gg_hh/%..%..%Source%MODEL%mp_coupl.inc | 35 + ...%..%..%Source%MODEL%mp_coupl_same_name.inc | 32 + .../gg_hh/%..%..%Source%MODEL%mp_couplings1.f | 20 + .../gg_hh/%..%..%Source%MODEL%mp_couplings2.f | 16 + .../gg_hh/%..%..%Source%MODEL%mp_couplings3.f | 29 + .../gg_hh/%..%..%Source%MODEL%mp_input.inc | 51 + .....%Source%MODEL%mp_intparam_definition.inc | 180 + .../gg_hh/%..%..%Source%MODEL%printout.f | 40 + .../gg_hh/%..%..%Source%MODEL%rw_para.f | 97 + .../gg_hh/%..%..%Source%MODEL%testprog.f | 72 + ...oop5_resources%ML5_0_ColorDenomFactors.dat | 20 + ...dLoop5_resources%ML5_0_ColorNumFactors.dat | 20 + .../%MadLoop5_resources%ML5_0_HelConfigs.dat | 4 + ...op5_resources%ML5_0_LoopColorFlowCoefs.dat | 5 + ...p5_resources%ML5_0_LoopColorFlowMatrix.dat | 3 + .../gg_hh/CT_interface.f | 627 ++++ .../gg_hh/TIR_interface.f | 538 +++ .../gg_hh/check_sa.f | 723 ++++ .../gg_hh/coef_construction_1.f | 215 ++ .../gg_hh/compute_color_flows.f | 571 +++ .../gg_hh/f2py_wrapper.f | 152 + .../gg_hh/helas_calls_ampb_1.f | 116 + .../gg_hh/improve_ps.f | 1014 ++++++ .../gg_hh/loop_CT_calls_1.f | 151 + .../gg_hh/loop_matrix.f | 3213 +++++++++++++++++ .../gg_hh/loop_max_coefs.inc | 2 + .../gg_hh/loop_num.f | 124 + .../gg_hh/mp_coef_construction_1.f | 238 ++ .../gg_hh/mp_compute_loop_coefs.f | 633 ++++ .../gg_hh/mp_helas_calls_ampb_1.f | 101 + .../gg_hh/nexternal.inc | 4 + .../gg_hh/ngraphs.inc | 2 + .../gg_hh/nsquaredSO.inc | 2 + .../gg_hh/pmass.inc | 4 + .../gg_hh/polynomial.f | 592 +++ .../gg_hh/process_info.inc | 6 + .../gg_hh/tir_cache_size.inc | 1 + .../gg_hh/unique_id.inc | 2 + tests/unit_tests/loop/test_loop_exporters.py | 6 +- 97 files changed, 11492 insertions(+), 50 deletions(-) rename tests/input_files/IOTestsComparison/{short_ML_SMQCD_LoopInduced => short_ML_SMQCD_LoopInduced_default}/gg_hh/%..%..%Source%MODEL%actualize_mp_ext_params.inc (100%) rename tests/input_files/IOTestsComparison/{short_ML_SMQCD_LoopInduced => short_ML_SMQCD_LoopInduced_default}/gg_hh/%..%..%Source%MODEL%coupl.inc (100%) rename tests/input_files/IOTestsComparison/{short_ML_SMQCD_LoopInduced => short_ML_SMQCD_LoopInduced_default}/gg_hh/%..%..%Source%MODEL%coupl_write.inc (100%) rename tests/input_files/IOTestsComparison/{short_ML_SMQCD_LoopInduced => short_ML_SMQCD_LoopInduced_default}/gg_hh/%..%..%Source%MODEL%couplings.f (100%) rename tests/input_files/IOTestsComparison/{short_ML_SMQCD_LoopInduced => short_ML_SMQCD_LoopInduced_default}/gg_hh/%..%..%Source%MODEL%couplings1.f (100%) rename tests/input_files/IOTestsComparison/{short_ML_SMQCD_LoopInduced => short_ML_SMQCD_LoopInduced_default}/gg_hh/%..%..%Source%MODEL%couplings2.f (100%) rename tests/input_files/IOTestsComparison/{short_ML_SMQCD_LoopInduced => short_ML_SMQCD_LoopInduced_default}/gg_hh/%..%..%Source%MODEL%couplings3.f (100%) rename tests/input_files/IOTestsComparison/{short_ML_SMQCD_LoopInduced => short_ML_SMQCD_LoopInduced_default}/gg_hh/%..%..%Source%MODEL%flavor_couplings.f (100%) rename tests/input_files/IOTestsComparison/{short_ML_SMQCD_LoopInduced => short_ML_SMQCD_LoopInduced_default}/gg_hh/%..%..%Source%MODEL%formats.inc (100%) rename tests/input_files/IOTestsComparison/{short_ML_SMQCD_LoopInduced => short_ML_SMQCD_LoopInduced_default}/gg_hh/%..%..%Source%MODEL%get_color.f (100%) rename tests/input_files/IOTestsComparison/{short_ML_SMQCD_LoopInduced => short_ML_SMQCD_LoopInduced_default}/gg_hh/%..%..%Source%MODEL%input.inc (100%) rename tests/input_files/IOTestsComparison/{short_ML_SMQCD_LoopInduced => short_ML_SMQCD_LoopInduced_default}/gg_hh/%..%..%Source%MODEL%intparam_definition.inc (100%) rename tests/input_files/IOTestsComparison/{short_ML_SMQCD_LoopInduced => short_ML_SMQCD_LoopInduced_default}/gg_hh/%..%..%Source%MODEL%makeinc.inc (100%) rename tests/input_files/IOTestsComparison/{short_ML_SMQCD_LoopInduced => short_ML_SMQCD_LoopInduced_default}/gg_hh/%..%..%Source%MODEL%model_functions.f (100%) rename tests/input_files/IOTestsComparison/{short_ML_SMQCD_LoopInduced => short_ML_SMQCD_LoopInduced_default}/gg_hh/%..%..%Source%MODEL%model_functions.inc (100%) rename tests/input_files/IOTestsComparison/{short_ML_SMQCD_LoopInduced => short_ML_SMQCD_LoopInduced_default}/gg_hh/%..%..%Source%MODEL%mp_coupl.inc (100%) rename tests/input_files/IOTestsComparison/{short_ML_SMQCD_LoopInduced => short_ML_SMQCD_LoopInduced_default}/gg_hh/%..%..%Source%MODEL%mp_coupl_same_name.inc (100%) rename tests/input_files/IOTestsComparison/{short_ML_SMQCD_LoopInduced => short_ML_SMQCD_LoopInduced_default}/gg_hh/%..%..%Source%MODEL%mp_couplings1.f (100%) rename tests/input_files/IOTestsComparison/{short_ML_SMQCD_LoopInduced => short_ML_SMQCD_LoopInduced_default}/gg_hh/%..%..%Source%MODEL%mp_couplings2.f (100%) rename tests/input_files/IOTestsComparison/{short_ML_SMQCD_LoopInduced => short_ML_SMQCD_LoopInduced_default}/gg_hh/%..%..%Source%MODEL%mp_couplings3.f (100%) rename tests/input_files/IOTestsComparison/{short_ML_SMQCD_LoopInduced => short_ML_SMQCD_LoopInduced_default}/gg_hh/%..%..%Source%MODEL%mp_input.inc (100%) rename tests/input_files/IOTestsComparison/{short_ML_SMQCD_LoopInduced => short_ML_SMQCD_LoopInduced_default}/gg_hh/%..%..%Source%MODEL%mp_intparam_definition.inc (100%) rename tests/input_files/IOTestsComparison/{short_ML_SMQCD_LoopInduced => short_ML_SMQCD_LoopInduced_default}/gg_hh/%..%..%Source%MODEL%printout.f (100%) rename tests/input_files/IOTestsComparison/{short_ML_SMQCD_LoopInduced => short_ML_SMQCD_LoopInduced_default}/gg_hh/%..%..%Source%MODEL%rw_para.f (100%) rename tests/input_files/IOTestsComparison/{short_ML_SMQCD_LoopInduced => short_ML_SMQCD_LoopInduced_default}/gg_hh/%..%..%Source%MODEL%testprog.f (100%) rename tests/input_files/IOTestsComparison/{short_ML_SMQCD_LoopInduced => short_ML_SMQCD_LoopInduced_default}/gg_hh/%MadLoop5_resources%ML5_0_ColorDenomFactors.dat (100%) rename tests/input_files/IOTestsComparison/{short_ML_SMQCD_LoopInduced => short_ML_SMQCD_LoopInduced_default}/gg_hh/%MadLoop5_resources%ML5_0_ColorNumFactors.dat (100%) rename tests/input_files/IOTestsComparison/{short_ML_SMQCD_LoopInduced => short_ML_SMQCD_LoopInduced_default}/gg_hh/%MadLoop5_resources%ML5_0_HelConfigs.dat (100%) rename tests/input_files/IOTestsComparison/{short_ML_SMQCD_LoopInduced => short_ML_SMQCD_LoopInduced_default}/gg_hh/CT_interface.f (100%) rename tests/input_files/IOTestsComparison/{short_ML_SMQCD_LoopInduced => short_ML_SMQCD_LoopInduced_default}/gg_hh/check_sa.f (100%) rename tests/input_files/IOTestsComparison/{short_ML_SMQCD_LoopInduced => short_ML_SMQCD_LoopInduced_default}/gg_hh/improve_ps.f (100%) rename tests/input_files/IOTestsComparison/{short_ML_SMQCD_LoopInduced => short_ML_SMQCD_LoopInduced_default}/gg_hh/loop_matrix.f (98%) rename tests/input_files/IOTestsComparison/{short_ML_SMQCD_LoopInduced => short_ML_SMQCD_LoopInduced_default}/gg_hh/loop_num.f (100%) rename tests/input_files/IOTestsComparison/{short_ML_SMQCD_LoopInduced => short_ML_SMQCD_LoopInduced_default}/gg_hh/mp_born_amps_and_wfs.f (100%) rename tests/input_files/IOTestsComparison/{short_ML_SMQCD_LoopInduced => short_ML_SMQCD_LoopInduced_default}/gg_hh/nexternal.inc (100%) rename tests/input_files/IOTestsComparison/{short_ML_SMQCD_LoopInduced => short_ML_SMQCD_LoopInduced_default}/gg_hh/ngraphs.inc (100%) rename tests/input_files/IOTestsComparison/{short_ML_SMQCD_LoopInduced => short_ML_SMQCD_LoopInduced_default}/gg_hh/nsquaredSO.inc (100%) rename tests/input_files/IOTestsComparison/{short_ML_SMQCD_LoopInduced => short_ML_SMQCD_LoopInduced_default}/gg_hh/pmass.inc (100%) rename tests/input_files/IOTestsComparison/{short_ML_SMQCD_LoopInduced => short_ML_SMQCD_LoopInduced_default}/gg_hh/process_info.inc (100%) rename tests/input_files/IOTestsComparison/{short_ML_SMQCD_LoopInduced => short_ML_SMQCD_LoopInduced_default}/gg_hh/unique_id.inc (100%) create mode 100644 tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%..%..%Source%MODEL%actualize_mp_ext_params.inc create mode 100644 tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%..%..%Source%MODEL%coupl.inc create mode 100644 tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%..%..%Source%MODEL%coupl_write.inc create mode 100644 tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%..%..%Source%MODEL%couplings.f create mode 100644 tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%..%..%Source%MODEL%couplings1.f create mode 100644 tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%..%..%Source%MODEL%couplings2.f create mode 100644 tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%..%..%Source%MODEL%couplings3.f create mode 100644 tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%..%..%Source%MODEL%flavor_couplings.f create mode 100644 tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%..%..%Source%MODEL%formats.inc create mode 100644 tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%..%..%Source%MODEL%get_color.f create mode 100644 tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%..%..%Source%MODEL%input.inc create mode 100644 tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%..%..%Source%MODEL%intparam_definition.inc create mode 100644 tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%..%..%Source%MODEL%makeinc.inc create mode 100644 tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%..%..%Source%MODEL%model_functions.f create mode 100644 tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%..%..%Source%MODEL%model_functions.inc create mode 100644 tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%..%..%Source%MODEL%mp_coupl.inc create mode 100644 tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%..%..%Source%MODEL%mp_coupl_same_name.inc create mode 100644 tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%..%..%Source%MODEL%mp_couplings1.f create mode 100644 tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%..%..%Source%MODEL%mp_couplings2.f create mode 100644 tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%..%..%Source%MODEL%mp_couplings3.f create mode 100644 tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%..%..%Source%MODEL%mp_input.inc create mode 100644 tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%..%..%Source%MODEL%mp_intparam_definition.inc create mode 100644 tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%..%..%Source%MODEL%printout.f create mode 100644 tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%..%..%Source%MODEL%rw_para.f create mode 100644 tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%..%..%Source%MODEL%testprog.f create mode 100644 tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%MadLoop5_resources%ML5_0_ColorDenomFactors.dat create mode 100644 tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%MadLoop5_resources%ML5_0_ColorNumFactors.dat create mode 100644 tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%MadLoop5_resources%ML5_0_HelConfigs.dat create mode 100644 tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%MadLoop5_resources%ML5_0_LoopColorFlowCoefs.dat create mode 100644 tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%MadLoop5_resources%ML5_0_LoopColorFlowMatrix.dat create mode 100644 tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/CT_interface.f create mode 100644 tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/TIR_interface.f create mode 100644 tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/check_sa.f create mode 100644 tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/coef_construction_1.f create mode 100644 tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/compute_color_flows.f create mode 100644 tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/f2py_wrapper.f create mode 100644 tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/helas_calls_ampb_1.f create mode 100644 tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/improve_ps.f create mode 100644 tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/loop_CT_calls_1.f create mode 100644 tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/loop_matrix.f create mode 100644 tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/loop_max_coefs.inc create mode 100644 tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/loop_num.f create mode 100644 tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/mp_coef_construction_1.f create mode 100644 tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/mp_compute_loop_coefs.f create mode 100644 tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/mp_helas_calls_ampb_1.f create mode 100644 tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/nexternal.inc create mode 100644 tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/ngraphs.inc create mode 100644 tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/nsquaredSO.inc create mode 100644 tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/pmass.inc create mode 100644 tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/polynomial.f create mode 100644 tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/process_info.inc create mode 100644 tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/tir_cache_size.inc create mode 100644 tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/unique_id.inc diff --git a/madgraph/iolibs/template_files/loop/loop_matrix_standalone.inc b/madgraph/iolibs/template_files/loop/loop_matrix_standalone.inc index 00f9f87b79..e9435219e9 100644 --- a/madgraph/iolibs/template_files/loop/loop_matrix_standalone.inc +++ b/madgraph/iolibs/template_files/loop/loop_matrix_standalone.inc @@ -689,10 +689,7 @@ IF(SKIPLOOPEVAL) THEN GOTO 1226 ENDIF -%(loop_helas_calls)s - -%(actualize_ans)s - +%(loop_helas_calls)s%(actualize_ans)s 1226 CONTINUE IF (CHECKPHASE.OR.(.NOT.HELDOUBLECHECKED)) THEN diff --git a/madgraph/iolibs/template_files/loop_optimized/loop_matrix_standalone.inc b/madgraph/iolibs/template_files/loop_optimized/loop_matrix_standalone.inc index 632074d8b0..eecaf84b1a 100644 --- a/madgraph/iolibs/template_files/loop_optimized/loop_matrix_standalone.inc +++ b/madgraph/iolibs/template_files/loop_optimized/loop_matrix_standalone.inc @@ -186,7 +186,7 @@ C QP_RES STORES THE QUADRUPLE PRECISION RESULT OBTAINED FROM DIFFERENT EVALUATIO LOGICAL LTEMP %(real_dp_format)s BORNBUFF(0:NSQSO_BORN),TMPR ## if(LoopInduced){ - %(real_dp_format)s TMPD + LOGICAL POLES_COMPUTED, DO_POLE_CHECK ## } %(real_dp_format)s BUFFR(3,0:NSQUAREDSO),BUFFR_BIS(3,0:NSQUAREDSO),TEMP(0:3,0:NSQUAREDSO),TEMP1(0:NSQUAREDSO) %(complex_dp_format)s CTEMP @@ -540,7 +540,7 @@ C SKIP THE ONES THAT NOT AVAILABLE ## if(LoopInduced){ C The poles must vanish here, but COLLIER can be asked not to compute them at all. IF (MLPoleCheckThres.GT.0.0d0.AND.MLReductionLib(1).EQ.7.AND.(.NOT.COLLIERComputeUVpoles.OR..NOT.COLLIERComputeIRpoles)) THEN - WRITE(*,*) '##INFO: The vanishing-pole check of this loop-induced process is disabled because COLLIER is not asked to compute the poles. Set COLLIERComputeUVpoles and COLLIERComputeIRpoles to .TRUE. in MadLoopParams.dat to enable it.' + WRITE(*,*) '##INFO: The vanishing-pole check of this loop-induced process is inactive because COLLIER is not computing the poles. A madevent run turns them off on purpose and the card cannot override that; in a standalone run, set COLLIERComputeUVpoles and COLLIERComputeIRpoles to .TRUE. in MadLoopParams.dat.' ENDIF ## } J=0 @@ -1889,21 +1889,23 @@ DO I=1,NSQUAREDSO ENDIF ENDDO ## if(LoopInduced){ -C A loop-induced amplitude is finite, so its poles must cancel. If they do not, -C the result is wrong and we must not return it. Skipped when the reduction tool -C does not compute the poles, since ANS(2:3,0) is then identically zero anyway. -IF (MLPoleCheckThres.GT.0.0d0.AND..NOT.CHECKPHASE.AND.HELDOUBLECHECKED.AND.NTRY.GT.0.AND.RET_CODE_H.NE.4.AND.ANS(1,0).NE.0.0d0.AND..NOT.(MLReductionLib(I_LIB).EQ.7.AND.(.NOT.COLLIERComputeUVpoles.OR..NOT.COLLIERComputeIRpoles))) THEN +C A loop-induced amplitude is finite: its poles must cancel. +C Nothing to compare against if the reduction tool does not compute them. +POLES_COMPUTED = .NOT.(MLReductionLib(I_LIB).EQ.7.AND.(.NOT.COLLIERComputeUVpoles.OR..NOT.COLLIERComputeIRpoles)) +DO_POLE_CHECK = MLPoleCheckThres.GT.0.0d0.AND.POLES_COMPUTED.AND.NTRY.GT.0 +DO_POLE_CHECK = DO_POLE_CHECK.AND..NOT.CHECKPHASE.AND.HELDOUBLECHECKED +DO_POLE_CHECK = DO_POLE_CHECK.AND.RET_CODE_H.NE.4.AND.ANS(1,0).NE.0.0d0 +IF (DO_POLE_CHECK) THEN TMPR = (ABS(ANS(2,0))+ABS(ANS(3,0)))/ABS(ANS(1,0)) -C Never demand more than the accuracy MadLoop itself claims for this point. - TMPD = MLPoleCheckThres - IF (ACCURACY(0).GT.0.0d0) TMPD = MAX(TMPD,10.0d0*ACCURACY(0)) - IF (TMPR.GT.TMPD) THEN - WRITE(*,*) '##E02 ERROR The poles of this loop-induced process do not cancel.' + IF (TMPR.GT.MLPoleCheckThres) THEN + WRITE(*,*) '##E03 ERROR The poles of this loop-induced process do not cancel.' WRITE(*,*) 'Finite contribution = ',ANS(1,0) WRITE(*,*) 'single pole contribution = ',ANS(2,0) WRITE(*,*) 'double pole contribution = ',ANS(3,0) WRITE(*,*) 'relative size of the poles = ',TMPR - WRITE(*,*) 'tolerated (MLPoleCheckThres)= ',TMPD + WRITE(*,*) 'tolerated = ',MLPoleCheckThres + WRITE(*,*) 'The finite part returned here cannot be trusted, so the run is stopped.' + WRITE(*,*) 'Edit MLPoleCheckThres in MadLoopParams.dat to change this tolerance; a negative value disables the check.' CALL %(proc_prefix)sWRITE_MOM(P) STOP 1 ENDIF diff --git a/madgraph/loop/loop_exporters.py b/madgraph/loop/loop_exporters.py index 15c08c32c0..f97bfbc37f 100755 --- a/madgraph/loop/loop_exporters.py +++ b/madgraph/loop/loop_exporters.py @@ -1622,7 +1622,7 @@ def write_loopmatrix(self, writer, matrix_element, fortran_model, actualize_ans.append(\ "WRITE(*,*) '##W03 WARNING Contribution ',I,' is unstable.'") actualize_ans.extend(["ENDIF","ENDDO"]) - replace_dict['actualize_ans']='\n'.join(actualize_ans) + replace_dict['actualize_ans']='\n\n'+'\n'.join(actualize_ans)+'\n' replace_dict['loop_induced_pole_check'] = "" replace_dict['loop_induced_pole_check_decl'] = "" else: @@ -1631,23 +1631,23 @@ def write_loopmatrix(self, writer, matrix_element, fortran_model, # result is wrong, so refuse to return it. This output only ever # reduces with CutTools, which always computes the poles. replace_dict['loop_induced_pole_check_decl']=\ - "\n\t %(real_dp_format)s TMPPOLE,TMPPOLETHRES"%replace_dict - replace_dict['loop_induced_pole_check']=("""IF (MLPoleCheckThres.GT.0.0d0.AND..NOT.CHECKPHASE.AND.HELDOUBLECHECKED.AND.NTRY.GT.0.AND.RET_CODE_H.NE.4.AND.ANS(1).NE.0.0d0) THEN + ("\n\t %(real_dp_format)s TMPPOLE" + "\n\t LOGICAL DO_POLE_CHECK")%replace_dict + replace_dict['loop_induced_pole_check']=("""DO_POLE_CHECK = MLPoleCheckThres.GT.0.0d0.AND.NTRY.GT.0 +DO_POLE_CHECK = DO_POLE_CHECK.AND..NOT.CHECKPHASE.AND.HELDOUBLECHECKED +DO_POLE_CHECK = DO_POLE_CHECK.AND.RET_CODE_H.NE.4.AND.ANS(1).NE.0.0d0 +IF (DO_POLE_CHECK) THEN TMPPOLE = (ABS(ANS(2))+ABS(ANS(3)))/ABS(ANS(1)) -C Never demand more than the accuracy MadLoop itself claims for this point. - TMPPOLETHRES = MLPoleCheckThres - IF (ACCURACY(0).GT.0.0d0) TMPPOLETHRES = MAX(TMPPOLETHRES,10.0d0*ACCURACY(0)) - IF (TMPPOLE.GT.TMPPOLETHRES) THEN - WRITE(*,*) '##E02 ERROR The poles of this loop-induced process do not cancel.' + IF (TMPPOLE.GT.MLPoleCheckThres) THEN + WRITE(*,*) '##E03 ERROR The poles of this loop-induced process do not cancel.' WRITE(*,*) 'Finite contribution = ',ANS(1) WRITE(*,*) 'single pole contribution = ',ANS(2) WRITE(*,*) 'double pole contribution = ',ANS(3) WRITE(*,*) 'relative size of the poles = ',TMPPOLE - WRITE(*,*) 'tolerated (MLPoleCheckThres)= ',TMPPOLETHRES - WRITE(*,*) 'Renormalization scale MU_R = ',MU_R - DO I=1,NEXTERNAL - WRITE (*,'(i2,1x,4e27.17)') I, P(0,I),P(1,I),P(2,I),P(3,I) - ENDDO + WRITE(*,*) 'tolerated = ',MLPoleCheckThres + WRITE(*,*) 'The finite part returned here cannot be trusted, so the run is stopped.' + WRITE(*,*) 'Edit MLPoleCheckThres in MadLoopParams.dat to change this tolerance; a negative value disables the check.' + CALL %(proc_prefix)sWRITE_MOM(P) STOP 1 ENDIF ENDIF""")%replace_dict diff --git a/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced/gg_hh/%..%..%Source%MODEL%actualize_mp_ext_params.inc b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_default/gg_hh/%..%..%Source%MODEL%actualize_mp_ext_params.inc similarity index 100% rename from tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced/gg_hh/%..%..%Source%MODEL%actualize_mp_ext_params.inc rename to tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_default/gg_hh/%..%..%Source%MODEL%actualize_mp_ext_params.inc diff --git a/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced/gg_hh/%..%..%Source%MODEL%coupl.inc b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_default/gg_hh/%..%..%Source%MODEL%coupl.inc similarity index 100% rename from tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced/gg_hh/%..%..%Source%MODEL%coupl.inc rename to tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_default/gg_hh/%..%..%Source%MODEL%coupl.inc diff --git a/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced/gg_hh/%..%..%Source%MODEL%coupl_write.inc b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_default/gg_hh/%..%..%Source%MODEL%coupl_write.inc similarity index 100% rename from tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced/gg_hh/%..%..%Source%MODEL%coupl_write.inc rename to tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_default/gg_hh/%..%..%Source%MODEL%coupl_write.inc diff --git a/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced/gg_hh/%..%..%Source%MODEL%couplings.f b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_default/gg_hh/%..%..%Source%MODEL%couplings.f similarity index 100% rename from tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced/gg_hh/%..%..%Source%MODEL%couplings.f rename to tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_default/gg_hh/%..%..%Source%MODEL%couplings.f diff --git a/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced/gg_hh/%..%..%Source%MODEL%couplings1.f b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_default/gg_hh/%..%..%Source%MODEL%couplings1.f similarity index 100% rename from tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced/gg_hh/%..%..%Source%MODEL%couplings1.f rename to tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_default/gg_hh/%..%..%Source%MODEL%couplings1.f diff --git a/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced/gg_hh/%..%..%Source%MODEL%couplings2.f b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_default/gg_hh/%..%..%Source%MODEL%couplings2.f similarity index 100% rename from tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced/gg_hh/%..%..%Source%MODEL%couplings2.f rename to tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_default/gg_hh/%..%..%Source%MODEL%couplings2.f diff --git a/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced/gg_hh/%..%..%Source%MODEL%couplings3.f b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_default/gg_hh/%..%..%Source%MODEL%couplings3.f similarity index 100% rename from tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced/gg_hh/%..%..%Source%MODEL%couplings3.f rename to tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_default/gg_hh/%..%..%Source%MODEL%couplings3.f diff --git a/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced/gg_hh/%..%..%Source%MODEL%flavor_couplings.f b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_default/gg_hh/%..%..%Source%MODEL%flavor_couplings.f similarity index 100% rename from tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced/gg_hh/%..%..%Source%MODEL%flavor_couplings.f rename to tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_default/gg_hh/%..%..%Source%MODEL%flavor_couplings.f diff --git a/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced/gg_hh/%..%..%Source%MODEL%formats.inc b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_default/gg_hh/%..%..%Source%MODEL%formats.inc similarity index 100% rename from tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced/gg_hh/%..%..%Source%MODEL%formats.inc rename to tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_default/gg_hh/%..%..%Source%MODEL%formats.inc diff --git a/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced/gg_hh/%..%..%Source%MODEL%get_color.f b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_default/gg_hh/%..%..%Source%MODEL%get_color.f similarity index 100% rename from tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced/gg_hh/%..%..%Source%MODEL%get_color.f rename to tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_default/gg_hh/%..%..%Source%MODEL%get_color.f diff --git a/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced/gg_hh/%..%..%Source%MODEL%input.inc b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_default/gg_hh/%..%..%Source%MODEL%input.inc similarity index 100% rename from tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced/gg_hh/%..%..%Source%MODEL%input.inc rename to tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_default/gg_hh/%..%..%Source%MODEL%input.inc diff --git a/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced/gg_hh/%..%..%Source%MODEL%intparam_definition.inc b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_default/gg_hh/%..%..%Source%MODEL%intparam_definition.inc similarity index 100% rename from tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced/gg_hh/%..%..%Source%MODEL%intparam_definition.inc rename to tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_default/gg_hh/%..%..%Source%MODEL%intparam_definition.inc diff --git a/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced/gg_hh/%..%..%Source%MODEL%makeinc.inc b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_default/gg_hh/%..%..%Source%MODEL%makeinc.inc similarity index 100% rename from tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced/gg_hh/%..%..%Source%MODEL%makeinc.inc rename to tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_default/gg_hh/%..%..%Source%MODEL%makeinc.inc diff --git a/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced/gg_hh/%..%..%Source%MODEL%model_functions.f b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_default/gg_hh/%..%..%Source%MODEL%model_functions.f similarity index 100% rename from tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced/gg_hh/%..%..%Source%MODEL%model_functions.f rename to tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_default/gg_hh/%..%..%Source%MODEL%model_functions.f diff --git a/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced/gg_hh/%..%..%Source%MODEL%model_functions.inc b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_default/gg_hh/%..%..%Source%MODEL%model_functions.inc similarity index 100% rename from tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced/gg_hh/%..%..%Source%MODEL%model_functions.inc rename to tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_default/gg_hh/%..%..%Source%MODEL%model_functions.inc diff --git a/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced/gg_hh/%..%..%Source%MODEL%mp_coupl.inc b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_default/gg_hh/%..%..%Source%MODEL%mp_coupl.inc similarity index 100% rename from tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced/gg_hh/%..%..%Source%MODEL%mp_coupl.inc rename to tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_default/gg_hh/%..%..%Source%MODEL%mp_coupl.inc diff --git a/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced/gg_hh/%..%..%Source%MODEL%mp_coupl_same_name.inc b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_default/gg_hh/%..%..%Source%MODEL%mp_coupl_same_name.inc similarity index 100% rename from tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced/gg_hh/%..%..%Source%MODEL%mp_coupl_same_name.inc rename to tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_default/gg_hh/%..%..%Source%MODEL%mp_coupl_same_name.inc diff --git a/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced/gg_hh/%..%..%Source%MODEL%mp_couplings1.f b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_default/gg_hh/%..%..%Source%MODEL%mp_couplings1.f similarity index 100% rename from tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced/gg_hh/%..%..%Source%MODEL%mp_couplings1.f rename to tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_default/gg_hh/%..%..%Source%MODEL%mp_couplings1.f diff --git a/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced/gg_hh/%..%..%Source%MODEL%mp_couplings2.f b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_default/gg_hh/%..%..%Source%MODEL%mp_couplings2.f similarity index 100% rename from tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced/gg_hh/%..%..%Source%MODEL%mp_couplings2.f rename to tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_default/gg_hh/%..%..%Source%MODEL%mp_couplings2.f diff --git a/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced/gg_hh/%..%..%Source%MODEL%mp_couplings3.f b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_default/gg_hh/%..%..%Source%MODEL%mp_couplings3.f similarity index 100% rename from tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced/gg_hh/%..%..%Source%MODEL%mp_couplings3.f rename to tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_default/gg_hh/%..%..%Source%MODEL%mp_couplings3.f diff --git a/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced/gg_hh/%..%..%Source%MODEL%mp_input.inc b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_default/gg_hh/%..%..%Source%MODEL%mp_input.inc similarity index 100% rename from tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced/gg_hh/%..%..%Source%MODEL%mp_input.inc rename to tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_default/gg_hh/%..%..%Source%MODEL%mp_input.inc diff --git a/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced/gg_hh/%..%..%Source%MODEL%mp_intparam_definition.inc b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_default/gg_hh/%..%..%Source%MODEL%mp_intparam_definition.inc similarity index 100% rename from tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced/gg_hh/%..%..%Source%MODEL%mp_intparam_definition.inc rename to tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_default/gg_hh/%..%..%Source%MODEL%mp_intparam_definition.inc diff --git a/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced/gg_hh/%..%..%Source%MODEL%printout.f b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_default/gg_hh/%..%..%Source%MODEL%printout.f similarity index 100% rename from tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced/gg_hh/%..%..%Source%MODEL%printout.f rename to tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_default/gg_hh/%..%..%Source%MODEL%printout.f diff --git a/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced/gg_hh/%..%..%Source%MODEL%rw_para.f b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_default/gg_hh/%..%..%Source%MODEL%rw_para.f similarity index 100% rename from tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced/gg_hh/%..%..%Source%MODEL%rw_para.f rename to tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_default/gg_hh/%..%..%Source%MODEL%rw_para.f diff --git a/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced/gg_hh/%..%..%Source%MODEL%testprog.f b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_default/gg_hh/%..%..%Source%MODEL%testprog.f similarity index 100% rename from tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced/gg_hh/%..%..%Source%MODEL%testprog.f rename to tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_default/gg_hh/%..%..%Source%MODEL%testprog.f diff --git a/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced/gg_hh/%MadLoop5_resources%ML5_0_ColorDenomFactors.dat b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_default/gg_hh/%MadLoop5_resources%ML5_0_ColorDenomFactors.dat similarity index 100% rename from tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced/gg_hh/%MadLoop5_resources%ML5_0_ColorDenomFactors.dat rename to tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_default/gg_hh/%MadLoop5_resources%ML5_0_ColorDenomFactors.dat diff --git a/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced/gg_hh/%MadLoop5_resources%ML5_0_ColorNumFactors.dat b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_default/gg_hh/%MadLoop5_resources%ML5_0_ColorNumFactors.dat similarity index 100% rename from tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced/gg_hh/%MadLoop5_resources%ML5_0_ColorNumFactors.dat rename to tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_default/gg_hh/%MadLoop5_resources%ML5_0_ColorNumFactors.dat diff --git a/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced/gg_hh/%MadLoop5_resources%ML5_0_HelConfigs.dat b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_default/gg_hh/%MadLoop5_resources%ML5_0_HelConfigs.dat similarity index 100% rename from tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced/gg_hh/%MadLoop5_resources%ML5_0_HelConfigs.dat rename to tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_default/gg_hh/%MadLoop5_resources%ML5_0_HelConfigs.dat diff --git a/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced/gg_hh/CT_interface.f b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_default/gg_hh/CT_interface.f similarity index 100% rename from tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced/gg_hh/CT_interface.f rename to tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_default/gg_hh/CT_interface.f diff --git a/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced/gg_hh/check_sa.f b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_default/gg_hh/check_sa.f similarity index 100% rename from tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced/gg_hh/check_sa.f rename to tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_default/gg_hh/check_sa.f diff --git a/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced/gg_hh/improve_ps.f b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_default/gg_hh/improve_ps.f similarity index 100% rename from tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced/gg_hh/improve_ps.f rename to tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_default/gg_hh/improve_ps.f diff --git a/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced/gg_hh/loop_matrix.f b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_default/gg_hh/loop_matrix.f similarity index 98% rename from tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced/gg_hh/loop_matrix.f rename to tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_default/gg_hh/loop_matrix.f index 787e881fca..0f1094cd1b 100644 --- a/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced/gg_hh/loop_matrix.f +++ b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_default/gg_hh/loop_matrix.f @@ -229,7 +229,8 @@ SUBROUTINE ML5_0_SLOOPMATRIX(P_USER,ANSRETURNED) DATA FOUND_VALID_REDUCTION_METHOD/.FALSE./ REAL*8 ACC - REAL*8 TMPPOLE,TMPPOLETHRES + REAL*8 TMPPOLE + LOGICAL DO_POLE_CHECK REAL*8 DP_RES(3,MAXSTABILITYLENGTH) C QP_RES STORES THE QUADRUPLE PRECISION RESULT OBTAINED FROM C DIFFERENT EVALUATION METHODS IN ORDER TO ASSESS STABILITY. @@ -903,9 +904,6 @@ SUBROUTINE ML5_0_SLOOPMATRIX(P_USER,ANSRETURNED) ENDIF - - - 1226 CONTINUE IF (CHECKPHASE.OR.(.NOT.HELDOUBLECHECKED)) THEN @@ -1178,26 +1176,27 @@ SUBROUTINE ML5_0_SLOOPMATRIX(P_USER,ANSRETURNED) ANSRETURNED(1,0)=ANS(1) ANSRETURNED(2,0)=ANS(2) ANSRETURNED(3,0)=ANS(3) - IF (MLPOLECHECKTHRES.GT.0.0D0.AND..NOT.CHECKPHASE.AND.HELDOUBLECH - $ECKED.AND.NTRY.GT.0.AND.RET_CODE_H.NE.4.AND.ANS(1).NE.0.0D0) THEN + DO_POLE_CHECK = MLPOLECHECKTHRES.GT.0.0D0.AND.NTRY.GT.0 + DO_POLE_CHECK = + $ DO_POLE_CHECK.AND..NOT.CHECKPHASE.AND.HELDOUBLECHECKED + DO_POLE_CHECK = DO_POLE_CHECK.AND.RET_CODE_H.NE.4.AND.ANS(1) + $ .NE.0.0D0 + IF (DO_POLE_CHECK) THEN TMPPOLE = (ABS(ANS(2))+ABS(ANS(3)))/ABS(ANS(1)) -C Never demand more than the accuracy MadLoop itself claims for -C this point. - TMPPOLETHRES = MLPOLECHECKTHRES - IF (ACCURACY(0).GT.0.0D0) TMPPOLETHRES = MAX(TMPPOLETHRES - $ ,10.0D0*ACCURACY(0)) - IF (TMPPOLE.GT.TMPPOLETHRES) THEN - WRITE(*,*) '##E02 ERROR The poles of this loop-induced' + IF (TMPPOLE.GT.MLPOLECHECKTHRES) THEN + WRITE(*,*) '##E03 ERROR The poles of this loop-induced' $ //' process do not cancel.' WRITE(*,*) 'Finite contribution = ',ANS(1) WRITE(*,*) 'single pole contribution = ',ANS(2) WRITE(*,*) 'double pole contribution = ',ANS(3) WRITE(*,*) 'relative size of the poles = ',TMPPOLE - WRITE(*,*) 'tolerated (MLPoleCheckThres)= ',TMPPOLETHRES - WRITE(*,*) 'Renormalization scale MU_R = ',MU_R - DO I=1,NEXTERNAL - WRITE (*,'(i2,1x,4e27.17)') I, P(0,I),P(1,I),P(2,I),P(3,I) - ENDDO + WRITE(*,*) 'tolerated = ',MLPOLECHECKTHRES + WRITE(*,*) 'The finite part returned here cannot be trusted,' + $ //' so the run is stopped.' + WRITE(*,*) 'Edit MLPoleCheckThres in MadLoopParams.dat to' + $ //' change this tolerance; a negative value disables the' + $ //' check.' + CALL ML5_0_WRITE_MOM(P) STOP 1 ENDIF ENDIF diff --git a/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced/gg_hh/loop_num.f b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_default/gg_hh/loop_num.f similarity index 100% rename from tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced/gg_hh/loop_num.f rename to tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_default/gg_hh/loop_num.f diff --git a/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced/gg_hh/mp_born_amps_and_wfs.f b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_default/gg_hh/mp_born_amps_and_wfs.f similarity index 100% rename from tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced/gg_hh/mp_born_amps_and_wfs.f rename to tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_default/gg_hh/mp_born_amps_and_wfs.f diff --git a/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced/gg_hh/nexternal.inc b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_default/gg_hh/nexternal.inc similarity index 100% rename from tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced/gg_hh/nexternal.inc rename to tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_default/gg_hh/nexternal.inc diff --git a/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced/gg_hh/ngraphs.inc b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_default/gg_hh/ngraphs.inc similarity index 100% rename from tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced/gg_hh/ngraphs.inc rename to tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_default/gg_hh/ngraphs.inc diff --git a/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced/gg_hh/nsquaredSO.inc b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_default/gg_hh/nsquaredSO.inc similarity index 100% rename from tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced/gg_hh/nsquaredSO.inc rename to tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_default/gg_hh/nsquaredSO.inc diff --git a/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced/gg_hh/pmass.inc b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_default/gg_hh/pmass.inc similarity index 100% rename from tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced/gg_hh/pmass.inc rename to tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_default/gg_hh/pmass.inc diff --git a/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced/gg_hh/process_info.inc b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_default/gg_hh/process_info.inc similarity index 100% rename from tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced/gg_hh/process_info.inc rename to tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_default/gg_hh/process_info.inc diff --git a/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced/gg_hh/unique_id.inc b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_default/gg_hh/unique_id.inc similarity index 100% rename from tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced/gg_hh/unique_id.inc rename to tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_default/gg_hh/unique_id.inc diff --git a/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%..%..%Source%MODEL%actualize_mp_ext_params.inc b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%..%..%Source%MODEL%actualize_mp_ext_params.inc new file mode 100644 index 0000000000..1cffbeb7cd --- /dev/null +++ b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%..%..%Source%MODEL%actualize_mp_ext_params.inc @@ -0,0 +1,7 @@ +ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc +c written by the UFO converter +ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + + MP__MU_R=MU_R + MP__AS=AS + MP__G=G diff --git a/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%..%..%Source%MODEL%coupl.inc b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%..%..%Source%MODEL%coupl.inc new file mode 100644 index 0000000000..7cee4b4932 --- /dev/null +++ b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%..%..%Source%MODEL%coupl.inc @@ -0,0 +1,41 @@ +ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc +c written by the UFO converter +ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + +C +C NB: VECSIZE_MEMMAX is defined in vector.inc +C NB: vector.inc must be included before coupl.inc +C + + DOUBLE PRECISION G, ALL_G + COMMON/STRONG/ G, ALL_G + + DOUBLE COMPLEX GAL(2) + COMMON/WEAK/ GAL + + DOUBLE PRECISION MU_R, ALL_MU_R + COMMON/RSCALE/ MU_R, ALL_MU_R + + DOUBLE PRECISION NF + PARAMETER(NF=4D0) + DOUBLE PRECISION NL + PARAMETER(NL=2D0) + + DOUBLE PRECISION MDL_MB,MDL_MH,MDL_MT,MDL_MTA,MDL_MW,MDL_MZ + + COMMON/MASSES/ MDL_MB,MDL_MH,MDL_MT,MDL_MTA,MDL_MW,MDL_MZ + + + DOUBLE PRECISION MDL_WH,MDL_WT,MDL_WW,MDL_WZ + + COMMON/WIDTHS/ MDL_WH,MDL_WT,MDL_WW,MDL_WZ + + + DOUBLE COMPLEX, TARGET :: GC_30, GC_33, GC_37 + + DOUBLE COMPLEX, TARGET :: GC_5, R2_GGHB, R2_GGHT, R2_GGHHB, + $ R2_GGHHT + + COMMON/COUPLINGS/ GC_5, R2_GGHB, R2_GGHT, R2_GGHHB, R2_GGHHT, + $ GC_30, GC_33, GC_37 + diff --git a/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%..%..%Source%MODEL%coupl_write.inc b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%..%..%Source%MODEL%coupl_write.inc new file mode 100644 index 0000000000..af52498caa --- /dev/null +++ b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%..%..%Source%MODEL%coupl_write.inc @@ -0,0 +1,15 @@ +ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc +c written by the UFO converter +ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + + WRITE(*,*) ' Couplings of loop_sm' + WRITE(*,*) ' ---------------------------------' + WRITE(*,*) ' ' + WRITE(*,2) 'GC_5 = ', GC_5 + WRITE(*,2) 'R2_GGHb = ', R2_GGHB + WRITE(*,2) 'R2_GGHt = ', R2_GGHT + WRITE(*,2) 'R2_GGHHb = ', R2_GGHHB + WRITE(*,2) 'R2_GGHHt = ', R2_GGHHT + WRITE(*,2) 'GC_30 = ', GC_30 + WRITE(*,2) 'GC_33 = ', GC_33 + WRITE(*,2) 'GC_37 = ', GC_37 diff --git a/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%..%..%Source%MODEL%couplings.f b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%..%..%Source%MODEL%couplings.f new file mode 100644 index 0000000000..99c8315880 --- /dev/null +++ b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%..%..%Source%MODEL%couplings.f @@ -0,0 +1,158 @@ +ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc +c written by the UFO converter +ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + + SUBROUTINE COUP() + USE MODEL_OBJECT + IMPLICIT NONE + DOUBLE PRECISION PI, ZERO + LOGICAL READLHA + PARAMETER (PI=3.141592653589793D0) + PARAMETER (ZERO=0D0) + INCLUDE 'model_functions.inc' + REAL*16 MP__PI, MP__ZERO + PARAMETER (MP__PI=3.1415926535897932384626433832795E0_16) + PARAMETER (MP__ZERO=0E0_16) + INCLUDE 'mp_input.inc' + INCLUDE 'mp_coupl.inc' + + LOGICAL UPDATELOOP + COMMON /TO_UPDATELOOP/UPDATELOOP + INCLUDE 'input.inc' + + + INCLUDE 'coupl.inc' + READLHA = .TRUE. + INCLUDE 'intparam_definition.inc' + IF (UPDATELOOP) THEN + + INCLUDE 'mp_intparam_definition.inc' + + ENDIF + + CALL COUP1() + IF (UPDATELOOP) THEN + + CALL COUP2() + + ENDIF + +C +couplings needed to be evaluated points by points +C + CALL COUP3() +C +couplings in multiple precision +C + IF (UPDATELOOP) THEN + + CALL MP_COUP1() + CALL MP_COUP2() +C +couplings needed to be evaluated points by points +C + CALL MP_COUP3() + + ENDIF + + + RETURN + END + + SUBROUTINE UPDATE_AS_PARAM() + USE MODEL_OBJECT + IMPLICIT NONE + + DOUBLE PRECISION PI, ZERO + LOGICAL READLHA, FIRST + DATA FIRST /.TRUE./ + SAVE FIRST + PARAMETER (PI=3.141592653589793D0) + PARAMETER (ZERO=0D0) + LOGICAL UPDATELOOP + COMMON /TO_UPDATELOOP/UPDATELOOP + INCLUDE 'model_functions.inc' + DOUBLE PRECISION GOTHER + + DOUBLE PRECISION MODEL_SCALE + COMMON /MODEL_SCALE/MODEL_SCALE + + + INCLUDE '../cuts.inc' + DATA MAXJETFLAVOR,FIXED_EXTRA_SCALE,MUE_OVER_REF,MUE_REF_FIXED + $ /5,.FALSE.,1D0,91.188/ + INCLUDE '../run.inc' + + DOUBLE PRECISION ALPHAS + EXTERNAL ALPHAS + + INCLUDE 'input.inc' + INCLUDE 'coupl.inc' + READLHA = .FALSE. + + INCLUDE 'intparam_definition.inc' + + + +C +couplings needed to be evaluated points by points +C + CALL COUP3() + + RETURN + END + + SUBROUTINE UPDATE_AS_PARAM2(MU_R2,AS2 ) + + USE MODEL_OBJECT + IMPLICIT NONE + + DOUBLE PRECISION PI + PARAMETER (PI=3.141592653589793D0) + DOUBLE PRECISION MU_R2, AS2 + + INCLUDE 'model_functions.inc' + INCLUDE 'input.inc' + + INCLUDE 'coupl.inc' + DOUBLE PRECISION MODEL_SCALE + COMMON /MODEL_SCALE/MODEL_SCALE + + + IF (MU_R2.GT.0D0) MU_R = DSQRT(MU_R2) + MODEL_SCALE = DSQRT(MU_R2) + G = SQRT(4.0D0*PI*AS2) + AS = AS2 + + CALL UPDATE_AS_PARAM() + + + RETURN + END + + SUBROUTINE MP_UPDATE_AS_PARAM() + + IMPLICIT NONE + LOGICAL READLHA + INCLUDE 'model_functions.inc' + REAL*16 MP__PI, MP__ZERO + PARAMETER (MP__PI=3.1415926535897932384626433832795E0_16) + PARAMETER (MP__ZERO=0E0_16) + INCLUDE 'mp_input.inc' + INCLUDE 'mp_coupl.inc' + + INCLUDE 'input.inc' + INCLUDE 'coupl.inc' + INCLUDE 'actualize_mp_ext_params.inc' + READLHA = .FALSE. + INCLUDE 'mp_intparam_definition.inc' + + +C +couplings needed to be evaluated points by points +C + CALL MP_COUP3() + + RETURN + END + diff --git a/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%..%..%Source%MODEL%couplings1.f b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%..%..%Source%MODEL%couplings1.f new file mode 100644 index 0000000000..0f3dcdfb97 --- /dev/null +++ b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%..%..%Source%MODEL%couplings1.f @@ -0,0 +1,19 @@ +ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc +c written by the UFO converter +ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + + SUBROUTINE COUP1( ) + USE MODEL_OBJECT + IMPLICIT NONE + + INCLUDE 'model_functions.inc' + + DOUBLE PRECISION PI, ZERO + PARAMETER (PI=3.141592653589793D0) + PARAMETER (ZERO=0D0) + INCLUDE 'input.inc' + INCLUDE 'coupl.inc' + GC_30 = -6.000000D+00*MDL_COMPLEXI*MDL_LAM*MDL_V + GC_33 = -((MDL_COMPLEXI*MDL_YB)/MDL_SQRT__2) + GC_37 = -((MDL_COMPLEXI*MDL_YT)/MDL_SQRT__2) + END diff --git a/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%..%..%Source%MODEL%couplings2.f b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%..%..%Source%MODEL%couplings2.f new file mode 100644 index 0000000000..df7a62fe43 --- /dev/null +++ b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%..%..%Source%MODEL%couplings2.f @@ -0,0 +1,16 @@ +ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc +c written by the UFO converter +ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + + SUBROUTINE COUP2( ) + USE MODEL_OBJECT + IMPLICIT NONE + + INCLUDE 'model_functions.inc' + + DOUBLE PRECISION PI, ZERO + PARAMETER (PI=3.141592653589793D0) + PARAMETER (ZERO=0D0) + INCLUDE 'input.inc' + INCLUDE 'coupl.inc' + END diff --git a/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%..%..%Source%MODEL%couplings3.f b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%..%..%Source%MODEL%couplings3.f new file mode 100644 index 0000000000..6d4ad11e00 --- /dev/null +++ b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%..%..%Source%MODEL%couplings3.f @@ -0,0 +1,29 @@ +ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc +c written by the UFO converter +ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + + SUBROUTINE COUP3( ) + USE MODEL_OBJECT + IMPLICIT NONE + + INCLUDE 'model_functions.inc' + + DOUBLE PRECISION PI, ZERO + PARAMETER (PI=3.141592653589793D0) + PARAMETER (ZERO=0D0) + INCLUDE 'input.inc' + INCLUDE 'coupl.inc' + GC_5 = MDL_COMPLEXI*G + R2_GGHB = 4.000000D+00*(-((MDL_COMPLEXI*MDL_YB)/MDL_SQRT__2)) + $ *(1.000000D+00/2.000000D+00)*(MDL_G__EXP__2/(8.000000D+00*PI**2) + $ )*MDL_MB + R2_GGHT = 4.000000D+00*(-((MDL_COMPLEXI*MDL_YT)/MDL_SQRT__2)) + $ *(1.000000D+00/2.000000D+00)*(MDL_G__EXP__2/(8.000000D+00*PI**2) + $ )*MDL_MT + R2_GGHHB = 4.000000D+00*(-MDL_YB__EXP__2/2.000000D+00) + $ *(1.000000D+00/2.000000D+00)*((MDL_COMPLEXI*MDL_G__EXP__2) + $ /(8.000000D+00*PI**2)) + R2_GGHHT = 4.000000D+00*(-MDL_YT__EXP__2/2.000000D+00) + $ *(1.000000D+00/2.000000D+00)*((MDL_COMPLEXI*MDL_G__EXP__2) + $ /(8.000000D+00*PI**2)) + END diff --git a/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%..%..%Source%MODEL%flavor_couplings.f b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%..%..%Source%MODEL%flavor_couplings.f new file mode 100644 index 0000000000..f954c35c0b --- /dev/null +++ b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%..%..%Source%MODEL%flavor_couplings.f @@ -0,0 +1,30 @@ +ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc +c written by the UFO converter +ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + + + MODULE MODEL_OBJECT + TYPE COUPPTR ! needed to have an array of pointer + SEQUENCE + DOUBLE COMPLEX, POINTER :: P + END TYPE COUPPTR + + TYPE FLV_COUPLING + SEQUENCE + INTEGER :: PARTNER(0) + INTEGER :: PARTNER2(0) + TYPE(COUPPTR) :: VAL(0) + END TYPE FLV_COUPLING + END MODULE MODEL_OBJECT + + + SUBROUTINE INIT_FLV_COUPLINGS() + USE MODEL_OBJECT + IMPLICIT NONE + + INCLUDE 'coupl.inc' + + + + END SUBROUTINE INIT_FLV_COUPLINGS + diff --git a/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%..%..%Source%MODEL%formats.inc b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%..%..%Source%MODEL%formats.inc new file mode 100644 index 0000000000..575c71a465 --- /dev/null +++ b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%..%..%Source%MODEL%formats.inc @@ -0,0 +1,30 @@ +c************************************************************************ +c** ** +c** MadGraph/MadEvent Interface to FeynRules ** +c** ** +c** C. Duhr (Louvain U.) - M. Herquet (NIKHEF) ** +c** ** +c************************************************************************ + +c Formats for printout output + +c Simple real + 1 format(1x,a15,e13.5) +c Simple Complex + 2 format(1x,a15,e13.5,1x,e13.5) +c Real with mass dimension + 3 format(1x,a15,f11.5,' GeV') +c Chiral couplings + 4 format(1x,a15,e13.5,1x,e13.5,a15,e13.5,1x,e13.5) + + +c Formats for helas_coupling output + +c Real + 11 format(a10,e13.5) +c Complex + 12 format(a10,e13.5,1x,e13.5 ) +c Chiral + 13 format(a10,e13.5,1x,e13.5,1x,e13.5,1x,e13.5 ) + + diff --git a/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%..%..%Source%MODEL%get_color.f b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%..%..%Source%MODEL%get_color.f new file mode 100644 index 0000000000..e042c85986 --- /dev/null +++ b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%..%..%Source%MODEL%get_color.f @@ -0,0 +1,158 @@ +ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc +c written by the UFO converter +ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + + FUNCTION GET_COLOR(IPDG) + IMPLICIT NONE + INTEGER GET_COLOR, IPDG + SELECT CASE (IPDG) + CASE(-82) + GET_COLOR=8 + CASE(-24) + GET_COLOR=1 + CASE(-16) + GET_COLOR=1 + CASE(-15) + GET_COLOR=1 + CASE(-14) + GET_COLOR=1 + CASE(-13) + GET_COLOR=1 + CASE(-12) + GET_COLOR=1 + CASE(-11) + GET_COLOR=1 + CASE(-6) + GET_COLOR=-3 + CASE(-5) + GET_COLOR=-3 + CASE(-4) + GET_COLOR=-3 + CASE(-3) + GET_COLOR=-3 + CASE(-2) + GET_COLOR=-3 + CASE(-1) + GET_COLOR=-3 + CASE(1) + GET_COLOR=3 + CASE(2) + GET_COLOR=3 + CASE(3) + GET_COLOR=3 + CASE(4) + GET_COLOR=3 + CASE(5) + GET_COLOR=3 + CASE(6) + GET_COLOR=3 + CASE(11) + GET_COLOR=1 + CASE(12) + GET_COLOR=1 + CASE(13) + GET_COLOR=1 + CASE(14) + GET_COLOR=1 + CASE(15) + GET_COLOR=1 + CASE(16) + GET_COLOR=1 + CASE(21) + GET_COLOR=8 + CASE(22) + GET_COLOR=1 + CASE(23) + GET_COLOR=1 + CASE(24) + GET_COLOR=1 + CASE(25) + GET_COLOR=1 + CASE(82) + GET_COLOR=8 + CASE(7) +C This is dummy particle used in multiparticle vertices + GET_COLOR=2 + CASE DEFAULT + WRITE(*,*)'Error: No color given for pdg ',IPDG + STOP 1 + END SELECT + END + + FUNCTION GET_SPIN(IPDG) + IMPLICIT NONE + INTEGER GET_SPIN, IPDG + SELECT CASE (IPDG) + CASE(-82) + GET_SPIN=1 + CASE(-24) + GET_SPIN=3 + CASE(-16) + GET_SPIN=2 + CASE(-15) + GET_SPIN=2 + CASE(-14) + GET_SPIN=2 + CASE(-13) + GET_SPIN=2 + CASE(-12) + GET_SPIN=2 + CASE(-11) + GET_SPIN=2 + CASE(-6) + GET_SPIN=2 + CASE(-5) + GET_SPIN=2 + CASE(-4) + GET_SPIN=2 + CASE(-3) + GET_SPIN=2 + CASE(-2) + GET_SPIN=2 + CASE(-1) + GET_SPIN=2 + CASE(1) + GET_SPIN=2 + CASE(2) + GET_SPIN=2 + CASE(3) + GET_SPIN=2 + CASE(4) + GET_SPIN=2 + CASE(5) + GET_SPIN=2 + CASE(6) + GET_SPIN=2 + CASE(11) + GET_SPIN=2 + CASE(12) + GET_SPIN=2 + CASE(13) + GET_SPIN=2 + CASE(14) + GET_SPIN=2 + CASE(15) + GET_SPIN=2 + CASE(16) + GET_SPIN=2 + CASE(21) + GET_SPIN=3 + CASE(22) + GET_SPIN=3 + CASE(23) + GET_SPIN=3 + CASE(24) + GET_SPIN=3 + CASE(25) + GET_SPIN=1 + CASE(82) + GET_SPIN=1 + CASE(7) +C This is dummy particle used in multiparticle vertices + GET_SPIN=-2 + CASE DEFAULT + WRITE(*,*)'Error: No spin given for pdg ',IPDG + STOP 1 + END SELECT + END + diff --git a/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%..%..%Source%MODEL%input.inc b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%..%..%Source%MODEL%input.inc new file mode 100644 index 0000000000..31a37f59de --- /dev/null +++ b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%..%..%Source%MODEL%input.inc @@ -0,0 +1,42 @@ +ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc +c written by the UFO converter +ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + + DOUBLE PRECISION MDL_SQRT__AS,MDL_G__EXP__4,MDL_G__EXP__2 + $ ,MDL_G__EXP__3,MDL_MU_R__EXP__2,MDL_LHV,MDL_CONJG__CKM3X3 + $ ,MDL_CONJG__CKM22,MDL_CKM3X3,MDL_CKM33,MDL_CKM22,MDL_NCOL + $ ,MDL_CA,MDL_TF,MDL_CF,MDL_MZ__EXP__2,MDL_MZ__EXP__4,MDL_SQRT__2 + $ ,MDL_MH__EXP__2,MDL_NCOL__EXP__2,MDL_MB__EXP__2,MDL_MT__EXP__2 + $ ,MDL_AEW,MDL_SQRT__AEW,MDL_EE,MDL_MW__EXP__2,MDL_SW2,MDL_CW + $ ,MDL_SQRT__SW2,MDL_SW,MDL_G1,MDL_GW,MDL_V,MDL_V__EXP__2,MDL_LAM + $ ,MDL_YB,MDL_YT,MDL_YTAU,MDL_MUH,MDL_AXIALZUP,MDL_AXIALZDOWN + $ ,MDL_VECTORZUP,MDL_VECTORZDOWN,MDL_VECTORAUP,MDL_VECTORADOWN + $ ,MDL_VECTORWMDXU,MDL_AXIALWMDXU,MDL_VECTORWPUXD,MDL_AXIALWPUXD + $ ,MDL_GW__EXP__2,MDL_CW__EXP__2,MDL_EE__EXP__2,MDL_SW__EXP__2 + $ ,MDL_YB__EXP__2,MDL_YT__EXP__2,AEWM1,MDL_GF,AS,MDL_YMB,MDL_YMT + $ ,MDL_YMTAU + + COMMON/PARAMS_R/ MDL_SQRT__AS,MDL_G__EXP__4,MDL_G__EXP__2 + $ ,MDL_G__EXP__3,MDL_MU_R__EXP__2,MDL_LHV,MDL_CONJG__CKM3X3 + $ ,MDL_CONJG__CKM22,MDL_CKM3X3,MDL_CKM33,MDL_CKM22,MDL_NCOL + $ ,MDL_CA,MDL_TF,MDL_CF,MDL_MZ__EXP__2,MDL_MZ__EXP__4,MDL_SQRT__2 + $ ,MDL_MH__EXP__2,MDL_NCOL__EXP__2,MDL_MB__EXP__2,MDL_MT__EXP__2 + $ ,MDL_AEW,MDL_SQRT__AEW,MDL_EE,MDL_MW__EXP__2,MDL_SW2,MDL_CW + $ ,MDL_SQRT__SW2,MDL_SW,MDL_G1,MDL_GW,MDL_V,MDL_V__EXP__2,MDL_LAM + $ ,MDL_YB,MDL_YT,MDL_YTAU,MDL_MUH,MDL_AXIALZUP,MDL_AXIALZDOWN + $ ,MDL_VECTORZUP,MDL_VECTORZDOWN,MDL_VECTORAUP,MDL_VECTORADOWN + $ ,MDL_VECTORWMDXU,MDL_AXIALWMDXU,MDL_VECTORWPUXD,MDL_AXIALWPUXD + $ ,MDL_GW__EXP__2,MDL_CW__EXP__2,MDL_EE__EXP__2,MDL_SW__EXP__2 + $ ,MDL_YB__EXP__2,MDL_YT__EXP__2,AEWM1,MDL_GF,AS,MDL_YMB,MDL_YMT + $ ,MDL_YMTAU + + + DOUBLE COMPLEX MDL_COMPLEXI,MDL_I1X33,MDL_I2X33,MDL_I3X33 + $ ,MDL_I4X33,MDL_VECTOR_TBGP,MDL_AXIAL_TBGP,MDL_VECTOR_TBGM + $ ,MDL_AXIAL_TBGM + + COMMON/PARAMS_C/ MDL_COMPLEXI,MDL_I1X33,MDL_I2X33,MDL_I3X33 + $ ,MDL_I4X33,MDL_VECTOR_TBGP,MDL_AXIAL_TBGP,MDL_VECTOR_TBGM + $ ,MDL_AXIAL_TBGM + + diff --git a/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%..%..%Source%MODEL%intparam_definition.inc b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%..%..%Source%MODEL%intparam_definition.inc new file mode 100644 index 0000000000..3ab41f07c5 --- /dev/null +++ b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%..%..%Source%MODEL%intparam_definition.inc @@ -0,0 +1,169 @@ +ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc +c written by the UFO converter +ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + +C Parameters that should not be recomputed event by event. +C + IF(READLHA) THEN + + G = 2 * DSQRT(AS*PI) ! for the first init + + MDL_LHV = 1.000000D+00 + + MDL_CONJG__CKM3X3 = 1.000000D+00 + + MDL_CONJG__CKM22 = 1.000000D+00 + + MDL_CKM3X3 = 1.000000D+00 + + MDL_CKM33 = 1.000000D+00 + + MDL_CKM22 = 1.000000D+00 + + MDL_NCOL = 3.000000D+00 + + MDL_CA = 3.000000D+00 + + MDL_TF = 5.000000D-01 + + MDL_CF = (4.000000D+00/3.000000D+00) + + MDL_COMPLEXI = DCMPLX(0.000000D+00,1.000000D+00) + + MDL_MZ__EXP__2 = MDL_MZ**2 + + MDL_MZ__EXP__4 = MDL_MZ**4 + + MDL_SQRT__2 = SQRT(DCMPLX(2.000000D+00)) + + MDL_MH__EXP__2 = MDL_MH**2 + + MDL_NCOL__EXP__2 = MDL_NCOL**2 + + MDL_MB__EXP__2 = MDL_MB**2 + + MDL_MT__EXP__2 = MDL_MT**2 + + MDL_AEW = 1.000000D+00/AEWM1 + + MDL_MW = SQRT(DCMPLX(MDL_MZ__EXP__2/2.000000D+00 + $ +SQRT(DCMPLX(MDL_MZ__EXP__4/4.000000D+00-(MDL_AEW*PI + $ *MDL_MZ__EXP__2)/(MDL_GF*MDL_SQRT__2))))) + + MDL_SQRT__AEW = SQRT(DCMPLX(MDL_AEW)) + + MDL_EE = 2.000000D+00*MDL_SQRT__AEW*SQRT(DCMPLX(PI)) + + MDL_MW__EXP__2 = MDL_MW**2 + + MDL_SW2 = 1.000000D+00-MDL_MW__EXP__2/MDL_MZ__EXP__2 + + MDL_CW = SQRT(DCMPLX(1.000000D+00-MDL_SW2)) + + MDL_SQRT__SW2 = SQRT(DCMPLX(MDL_SW2)) + + MDL_SW = MDL_SQRT__SW2 + + MDL_G1 = MDL_EE/MDL_CW + + MDL_GW = MDL_EE/MDL_SW + + MDL_V = (2.000000D+00*MDL_MW*MDL_SW)/MDL_EE + + MDL_V__EXP__2 = MDL_V**2 + + MDL_LAM = MDL_MH__EXP__2/(2.000000D+00*MDL_V__EXP__2) + + MDL_YB = (MDL_YMB*MDL_SQRT__2)/MDL_V + + MDL_YT = (MDL_YMT*MDL_SQRT__2)/MDL_V + + MDL_YTAU = (MDL_YMTAU*MDL_SQRT__2)/MDL_V + + MDL_MUH = SQRT(DCMPLX(MDL_LAM*MDL_V__EXP__2)) + + MDL_AXIALZUP = (3.000000D+00/2.000000D+00)*(-(MDL_EE*MDL_SW) + $ /(6.000000D+00*MDL_CW))-(1.000000D+00/2.000000D+00)*((MDL_CW + $ *MDL_EE)/(2.000000D+00*MDL_SW)) + + MDL_AXIALZDOWN = (-1.000000D+00/2.000000D+00)*(-(MDL_CW*MDL_EE) + $ /(2.000000D+00*MDL_SW))+(-3.000000D+00/2.000000D+00)*( + $ -(MDL_EE*MDL_SW)/(6.000000D+00*MDL_CW)) + + MDL_VECTORZUP = (1.000000D+00/2.000000D+00)*((MDL_CW*MDL_EE) + $ /(2.000000D+00*MDL_SW))+(5.000000D+00/2.000000D+00)*(-(MDL_EE + $ *MDL_SW)/(6.000000D+00*MDL_CW)) + + MDL_VECTORZDOWN = (1.000000D+00/2.000000D+00)*(-(MDL_CW*MDL_EE) + $ /(2.000000D+00*MDL_SW))+(-1.000000D+00/2.000000D+00)*( + $ -(MDL_EE*MDL_SW)/(6.000000D+00*MDL_CW)) + + MDL_VECTORAUP = (2.000000D+00*MDL_EE)/3.000000D+00 + + MDL_VECTORADOWN = -(MDL_EE)/3.000000D+00 + + MDL_VECTORWMDXU = (1.000000D+00/2.000000D+00)*((MDL_EE) + $ /(MDL_SW*MDL_SQRT__2)) + + MDL_AXIALWMDXU = (-1.000000D+00/2.000000D+00)*((MDL_EE) + $ /(MDL_SW*MDL_SQRT__2)) + + MDL_VECTORWPUXD = (1.000000D+00/2.000000D+00)*((MDL_EE) + $ /(MDL_SW*MDL_SQRT__2)) + + MDL_AXIALWPUXD = -(1.000000D+00/2.000000D+00)*((MDL_EE) + $ /(MDL_SW*MDL_SQRT__2)) + + MDL_I1X33 = MDL_YB*MDL_CONJG__CKM3X3 + + MDL_I2X33 = MDL_YT*MDL_CONJG__CKM3X3 + + MDL_I3X33 = MDL_CKM3X3*MDL_YT + + MDL_I4X33 = MDL_CKM3X3*MDL_YB + + MDL_VECTOR_TBGP = MDL_I1X33-MDL_I2X33 + + MDL_AXIAL_TBGP = -MDL_I2X33-MDL_I1X33 + + MDL_VECTOR_TBGM = MDL_I3X33-MDL_I4X33 + + MDL_AXIAL_TBGM = -MDL_I4X33-MDL_I3X33 + + MDL_GW__EXP__2 = MDL_GW**2 + + MDL_CW__EXP__2 = MDL_CW**2 + + MDL_EE__EXP__2 = MDL_EE**2 + + MDL_SW__EXP__2 = MDL_SW**2 + + MDL_YB__EXP__2 = MDL_YB**2 + + MDL_YT__EXP__2 = MDL_YT**2 + + ENDIF +C +C Parameters that should be recomputed at an event by even basis. +C + AS = G**2/4/PI + + MDL_SQRT__AS = SQRT(DCMPLX(AS)) + + MDL_G__EXP__4 = G**4 + + MDL_G__EXP__2 = G**2 + + MDL_G__EXP__3 = G**3 + + MDL_MU_R__EXP__2 = MU_R**2 + +C +C Parameters that should be updated for the loops. +C +C +C Definition of the EW coupling used in the write out of aqed +C + GAL(1) = 3.5449077018110318D0 / DSQRT(ABS(AEWM1)) + GAL(2) = 1D0 + diff --git a/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%..%..%Source%MODEL%makeinc.inc b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%..%..%Source%MODEL%makeinc.inc new file mode 100644 index 0000000000..699348c3ac --- /dev/null +++ b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%..%..%Source%MODEL%makeinc.inc @@ -0,0 +1,5 @@ +############################################################################# +# written by the UFO converter +############################################################################# + +MODEL = flavor_couplings.o couplings.o lha_read.o printout.o rw_para.o model_functions.o get_color.o couplings1.o couplings2.o couplings3.o mp_couplings1.o mp_couplings2.o mp_couplings3.o \ No newline at end of file diff --git a/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%..%..%Source%MODEL%model_functions.f b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%..%..%Source%MODEL%model_functions.f new file mode 100644 index 0000000000..0a5f1443ac --- /dev/null +++ b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%..%..%Source%MODEL%model_functions.f @@ -0,0 +1,1038 @@ +ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc +c written by the UFO converter +ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + + DOUBLE COMPLEX FUNCTION COND(CONDITION,TRUECASE,FALSECASE) + IMPLICIT NONE + DOUBLE COMPLEX CONDITION,TRUECASE,FALSECASE + IF(CONDITION.EQ.(0.0D0,0.0D0)) THEN + COND=TRUECASE + ELSE + COND=FALSECASE + ENDIF + END + + DOUBLE COMPLEX FUNCTION CONDIF(CONDITION,TRUECASE,FALSECASE) + IMPLICIT NONE + LOGICAL CONDITION + DOUBLE COMPLEX TRUECASE,FALSECASE + IF(CONDITION) THEN + CONDIF=TRUECASE + ELSE + CONDIF=FALSECASE + ENDIF + END + + DOUBLE COMPLEX FUNCTION RECMS(CONDITION,EXPR) + IMPLICIT NONE + LOGICAL CONDITION + DOUBLE COMPLEX EXPR + IF(CONDITION)THEN + RECMS=EXPR + ELSE + RECMS=DCMPLX(DBLE(EXPR)) + ENDIF + END + + DOUBLE COMPLEX FUNCTION REGLOG(ARG_IN) + IMPLICIT NONE + DOUBLE COMPLEX TWOPII + PARAMETER (TWOPII=2.0D0*3.1415926535897932D0*(0.0D0,1.0D0)) + DOUBLE COMPLEX ARG_IN + DOUBLE COMPLEX ARG + ARG=ARG_IN + IF(DABS(DIMAG(ARG)).EQ.0.0D0)THEN + ARG=DCMPLX(DBLE(ARG),0.0D0) + ENDIF + IF(DABS(DBLE(ARG)).EQ.0.0D0)THEN + ARG=DCMPLX(0.0D0,DIMAG(ARG)) + ENDIF + IF(ARG.EQ.(0.0D0,0.0D0)) THEN + REGLOG=(0.0D0,0.0D0) + ELSE + REGLOG=LOG(ARG) + ENDIF + END + + DOUBLE COMPLEX FUNCTION REGLOGP(ARG_IN) + IMPLICIT NONE + DOUBLE COMPLEX TWOPII + PARAMETER (TWOPII=2.0D0*3.1415926535897932D0*(0.0D0,1.0D0)) + DOUBLE COMPLEX ARG_IN + DOUBLE COMPLEX ARG + ARG=ARG_IN + IF(DABS(DIMAG(ARG)).EQ.0.0D0)THEN + ARG=DCMPLX(DBLE(ARG),0.0D0) + ENDIF + IF(DABS(DBLE(ARG)).EQ.0.0D0)THEN + ARG=DCMPLX(0.0D0,DIMAG(ARG)) + ENDIF + IF(ARG.EQ.(0.0D0,0.0D0))THEN + REGLOGP=(0.0D0,0.0D0) + ELSE + IF(DBLE(ARG).LT.0.0D0.AND.DIMAG(ARG).LT.0.0D0)THEN + REGLOGP=LOG(ARG) + TWOPII + ELSE + REGLOGP=LOG(ARG) + ENDIF + ENDIF + END + + DOUBLE COMPLEX FUNCTION REGLOGM(ARG_IN) + IMPLICIT NONE + DOUBLE COMPLEX TWOPII + PARAMETER (TWOPII=2.0D0*3.1415926535897932D0*(0.0D0,1.0D0)) + DOUBLE COMPLEX ARG_IN + DOUBLE COMPLEX ARG + ARG=ARG_IN + IF(DABS(DIMAG(ARG)).EQ.0.0D0)THEN + ARG=DCMPLX(DBLE(ARG),0.0D0) + ENDIF + IF(DABS(DBLE(ARG)).EQ.0.0D0)THEN + ARG=DCMPLX(0.0D0,DIMAG(ARG)) + ENDIF + IF(ARG.EQ.(0.0D0,0.0D0))THEN + REGLOGM=(0.0D0,0.0D0) + ELSE + IF(DBLE(ARG).LT.0.0D0.AND.DIMAG(ARG).GT.0.0D0)THEN + REGLOGM=LOG(ARG) - TWOPII + ELSE + REGLOGM=LOG(ARG) + ENDIF + ENDIF + END + + DOUBLE COMPLEX FUNCTION REGSQRT(ARG_IN) + IMPLICIT NONE + DOUBLE COMPLEX ARG_IN + DOUBLE COMPLEX ARG + ARG=ARG_IN + IF(DABS(DIMAG(ARG)).EQ.0.0D0)THEN + ARG=DCMPLX(DBLE(ARG),0.0D0) + ENDIF + IF(DABS(DBLE(ARG)).EQ.0.0D0)THEN + ARG=DCMPLX(0.0D0,DIMAG(ARG)) + ENDIF + REGSQRT=SQRT(ARG) + END + + DOUBLE COMPLEX FUNCTION GRREGLOG(LOGSW,EXPR1_IN,EXPR2_IN) + IMPLICIT NONE + DOUBLE COMPLEX TWOPII + PARAMETER (TWOPII=2.0D0*3.1415926535897932D0*(0.0D0,1.0D0)) + DOUBLE COMPLEX EXPR1_IN,EXPR2_IN + DOUBLE COMPLEX EXPR1,EXPR2 + DOUBLE PRECISION LOGSW + DOUBLE PRECISION IMAGEXPR + LOGICAL FIRSTSHEET + EXPR1=EXPR1_IN + EXPR2=EXPR2_IN + IF(DABS(DIMAG(EXPR1)).EQ.0.0D0)THEN + EXPR1=DCMPLX(DBLE(EXPR1),0.0D0) + ENDIF + IF(DABS(DBLE(EXPR1)).EQ.0.0D0)THEN + EXPR1=DCMPLX(0.0D0,DIMAG(EXPR1)) + ENDIF + IF(DABS(DIMAG(EXPR2)).EQ.0.0D0)THEN + EXPR2=DCMPLX(DBLE(EXPR2),0.0D0) + ENDIF + IF(DABS(DBLE(EXPR2)).EQ.0.0D0)THEN + EXPR2=DCMPLX(0.0D0,DIMAG(EXPR2)) + ENDIF + IF(EXPR1.EQ.(0.0D0,0.0D0))THEN + GRREGLOG=(0.0D0,0.0D0) + ELSE + IMAGEXPR=DIMAG(EXPR1)*DIMAG(EXPR2) + FIRSTSHEET=IMAGEXPR.GE.0.0D0 + FIRSTSHEET=FIRSTSHEET.OR.DBLE(EXPR1).GE.0.0D0 + FIRSTSHEET=FIRSTSHEET.OR.DBLE(EXPR2).GE.0.0D0 + IF(FIRSTSHEET)THEN + GRREGLOG=LOG(EXPR1) + ELSE + IF(DIMAG(EXPR1).GT.0.0D0)THEN + GRREGLOG=LOG(EXPR1) - LOGSW*TWOPII + ELSE + GRREGLOG=LOG(EXPR1) + LOGSW*TWOPII + ENDIF + ENDIF + ENDIF + END + + MODULE B0F_CACHING + + TYPE B0F_NODE + DOUBLE COMPLEX P2,M12,M22 + DOUBLE COMPLEX VALUE + TYPE(B0F_NODE),POINTER::PARENT + TYPE(B0F_NODE),POINTER::LEFT + TYPE(B0F_NODE),POINTER::RIGHT + END TYPE B0F_NODE + + CONTAINS + + SUBROUTINE B0F_SEARCH(ITEM, HEAD, FIND) + IMPLICIT NONE + TYPE(B0F_NODE),POINTER,INTENT(INOUT)::HEAD,ITEM + LOGICAL,INTENT(OUT)::FIND + TYPE(B0F_NODE),POINTER::ITEM1 + INTEGER::ICOMP + FIND=.FALSE. + NULLIFY(ITEM%PARENT) + NULLIFY(ITEM%LEFT) + NULLIFY(ITEM%RIGHT) + IF(.NOT.ASSOCIATED(HEAD))THEN + HEAD => ITEM + RETURN + ENDIF + ITEM1 => HEAD + DO + ICOMP=B0F_NODE_COMPARE(ITEM,ITEM1) + IF(ICOMP.LT.0)THEN + IF(.NOT.ASSOCIATED(ITEM1%LEFT))THEN + ITEM1%LEFT => ITEM + ITEM%PARENT => ITEM1 + EXIT + ELSE + ITEM1 => ITEM1%LEFT + ENDIF + ELSEIF(ICOMP.GT.0)THEN + IF(.NOT.ASSOCIATED(ITEM1%RIGHT))THEN + ITEM1%RIGHT => ITEM + ITEM%PARENT => ITEM1 + EXIT + ELSE + ITEM1 => ITEM1%RIGHT + ENDIF + ELSE + FIND=.TRUE. + ITEM%VALUE=ITEM1%VALUE + EXIT + ENDIF + ENDDO + RETURN + END + + INTEGER FUNCTION B0F_NODE_COMPARE(ITEM1,ITEM2) RESULT(RES) + IMPLICIT NONE + TYPE(B0F_NODE),POINTER,INTENT(IN)::ITEM1,ITEM2 + RES=COMPLEX_COMPARE(ITEM1%P2,ITEM2%P2) + IF(RES.NE.0)RETURN + RES=COMPLEX_COMPARE(ITEM1%M22,ITEM2%M22) + IF(RES.NE.0)RETURN + RES=COMPLEX_COMPARE(ITEM1%M12,ITEM2%M12) + RETURN + END + + INTEGER FUNCTION REAL_COMPARE(R1,R2) RESULT(RES) + IMPLICIT NONE + DOUBLE PRECISION R1,R2 + DOUBLE PRECISION MAXR,DIFF + DOUBLE PRECISION TINY + PARAMETER (TINY=-1D-14) + MAXR=MAX(ABS(R1),ABS(R2)) + DIFF=R1-R2 + IF(MAXR.LE.1D-99.OR.ABS(DIFF)/MAX(MAXR,1D-99).LE.ABS(TINY))THEN + RES=0 + RETURN + ENDIF + IF(DIFF.GT.0D0)THEN + RES=1 + RETURN + ELSE + RES=-1 + RETURN + ENDIF + END + + INTEGER FUNCTION COMPLEX_COMPARE(C1,C2) RESULT(RES) + IMPLICIT NONE + DOUBLE COMPLEX C1,C2 + DOUBLE PRECISION R1,R2 + R1=DBLE(C1) + R2=DBLE(C2) + RES=REAL_COMPARE(R1,R2) + IF(RES.NE.0)RETURN + R1=DIMAG(C1) + R2=DIMAG(C2) + RES=REAL_COMPARE(R1,R2) + RETURN + END + + END MODULE B0F_CACHING + + DOUBLE COMPLEX FUNCTION B0F(P2,M12,M22) + USE B0F_CACHING + IMPLICIT NONE + DOUBLE COMPLEX P2,M12,M22 + DOUBLE COMPLEX ZERO,TWOPII + PARAMETER (ZERO=(0.0D0,0.0D0)) + PARAMETER (TWOPII=2.0D0*3.1415926535897932D0*(0.0D0,1.0D0)) + DOUBLE PRECISION M,M2,GA,GA2 + DOUBLE PRECISION TINY + PARAMETER (TINY=-1D-14) + DOUBLE COMPLEX LOGTERMS + DOUBLE COMPLEX LOG_TRAJECTORY + LOGICAL USE_CACHING + PARAMETER (USE_CACHING=.TRUE.) + TYPE(B0F_NODE),POINTER::ITEM + TYPE(B0F_NODE),POINTER,SAVE::B0F_BT + INTEGER INIT + SAVE INIT + DATA INIT /0/ + LOGICAL FIND + IF(M12.EQ.ZERO)THEN +C it is a special case +C refer to Eq.(5.48) in arXiv:1804.10017 + M=DBLE(P2) ! M^2 + M2=DBLE(M22) ! M2^2 + IF(M.LT.TINY.OR.M2.LT.TINY)THEN + WRITE(*,*)'ERROR:B0F is not well defined when M^2,M2^2<0' + STOP + ENDIF + M=DSQRT(DABS(M)) + M2=DSQRT(DABS(M2)) + IF(M.EQ.0D0)THEN + GA=0D0 + ELSE + GA=-DIMAG(P2)/M + ENDIF + IF(M2.EQ.0D0)THEN + GA2=0D0 + ELSE + GA2=-DIMAG(M22)/M2 + ENDIF + IF(P2.NE.M22.AND.P2.NE.ZERO.AND.M22.NE.ZERO)THEN + B0F=(M22-P2)/P2*LOG((M22-P2)/M22) + IF(M.GT.M2.AND.GA*M2.GT.GA2*M)THEN + B0F=B0F-TWOPII + ENDIF + RETURN + ELSE + WRITE(*,*)'ERROR:B0F is not supported for a simple form' + STOP + ENDIF + ENDIF +C the general case +C trajectory method as advocated in arXiv:1804.10017 (Eq.(E.47)) + IF(USE_CACHING)THEN + IF(INIT.EQ.0)THEN + NULLIFY(B0F_BT) + INIT=1 + ENDIF + ALLOCATE(ITEM) + ITEM%P2=P2 + ITEM%M12=M12 + ITEM%M22=M22 + FIND=.FALSE. + CALL B0F_SEARCH(ITEM,B0F_BT,FIND) + IF(FIND)THEN + B0F=ITEM%VALUE + DEALLOCATE(ITEM) + RETURN + ELSE + LOGTERMS=LOG_TRAJECTORY(100,P2,M12,M22) + B0F=-LOG(P2/M22)+LOGTERMS + ITEM%VALUE=B0F + RETURN + ENDIF + ELSE + LOGTERMS=LOG_TRAJECTORY(100,P2,M12,M22) + B0F=-LOG(P2/M22)+LOGTERMS + ENDIF + RETURN + END + + DOUBLE COMPLEX FUNCTION SQRT_TRAJECTORY(N_SEG,P2,M12,M22) +C only needed when p2*m12*m22=\=0 + IMPLICIT NONE + INTEGER N_SEG ! number of segments + DOUBLE COMPLEX P2,M12,M22 + DOUBLE COMPLEX ZERO,ONE + PARAMETER (ZERO=(0.0D0,0.0D0),ONE=(1.0D0,0.0D0)) + DOUBLE COMPLEX GAMMA0,GAMMA1 + DOUBLE PRECISION M,GA,DGA,GA_START + DOUBLE PRECISION GAI,INTERSECTION + DOUBLE COMPLEX ARGIM1,ARGI,P2I + DOUBLE COMPLEX GAMMA0I,GAMMA1I + DOUBLE PRECISION TINY + PARAMETER (TINY=-1D-24) + INTEGER I + DOUBLE PRECISION PREFACTOR + IF(ABS(P2*M12*M22).EQ.0D0)THEN + WRITE(*,*)'ERROR:sqrt_trajectory works when p2*m12*m22/=0' + STOP + ENDIF + M=DBLE(P2) ! M^2 + M=DSQRT(DABS(M)) + IF(M.EQ.0D0)THEN + GA=0D0 + ELSE + GA=-DIMAG(P2)/M + ENDIF +C Eq.(5.37) in arXiv:1804.10017 + GAMMA0=ONE+M12/P2-M22/P2 + GAMMA1=M12/P2-DCMPLX(0D0,1D0)*ABS(TINY)/P2 + IF(ABS(GA).EQ.0D0)THEN + SQRT_TRAJECTORY=SQRT(GAMMA0**2-4D0*GAMMA1) + RETURN + ENDIF +C segments from -DABS(tiny*Ga) to Ga + GA_START=-DABS(TINY*GA) + DGA=(GA-GA_START)/N_SEG + PREFACTOR=1D0 + GAI=GA_START + P2I=DCMPLX(M**2,-GAI*M) + GAMMA0I=ONE+M12/P2I-M22/P2I + GAMMA1I=M12/P2I-DCMPLX(0D0,1D0)*ABS(TINY)/P2I + ARGIM1=GAMMA0I**2-4D0*GAMMA1I + DO I=1,N_SEG + GAI=DGA*I+GA_START + P2I=DCMPLX(M**2,-GAI*M) + GAMMA0I=ONE+M12/P2I-M22/P2I + GAMMA1I=M12/P2I-DCMPLX(0D0,1D0)*ABS(TINY)/P2I + ARGI=GAMMA0I**2-4D0*GAMMA1I + IF(DIMAG(ARGI)*DIMAG(ARGIM1).LT.0D0)THEN + INTERSECTION=DIMAG(ARGIM1)*(DBLE(ARGI)-DBLE(ARGIM1)) + INTERSECTION=INTERSECTION/(DIMAG(ARGI)-DIMAG(ARGIM1)) + INTERSECTION=INTERSECTION-DBLE(ARGIM1) + IF(INTERSECTION.GT.0D0)THEN + PREFACTOR=-PREFACTOR + ENDIF + ENDIF + ARGIM1=ARGI + ENDDO + SQRT_TRAJECTORY=SQRT(GAMMA0**2-4D0*GAMMA1)*PREFACTOR + RETURN + END + + DOUBLE COMPLEX FUNCTION LOG_TRAJECTORY(N_SEG,P2,M12,M22) +C sum of log terms appearing in Eq.(5.35) of arXiv:1804.10017 +C only needed when p2*m12*m22=\=0 + IMPLICIT NONE +C 4 possible logarithms appearing in Eq.(5.35) of +C arXiv:1804.10017 +C log(arg(i)) with arg(i) for i=1 to 4 +C i=1: (ga_{+}-1) +C i=2: (ga_{-}-1) +C i=3: (ga_{+}-1)/ga_{+} +C i=4: (ga_{-}-1)/ga_{-} + INTEGER N_SEG ! number of segments + DOUBLE COMPLEX P2,M12,M22 + DOUBLE COMPLEX ZERO,ONE,HALF,TWOPII + PARAMETER (ZERO=(0.0D0,0.0D0),ONE=(1.0D0,0.0D0)) + PARAMETER (HALF=(0.5D0,0.0D0)) + PARAMETER (TWOPII=2.0D0*3.1415926535897932D0*(0.0D0,1.0D0)) + DOUBLE COMPLEX GAMMA0,GAMMAP,GAMMAM,SQRTTERM + DOUBLE PRECISION M,GA,DGA,GA_START + DOUBLE PRECISION GAI,INTERSECTION + DOUBLE COMPLEX ARGIM1(4),ARGI(4),P2I,SQRTTERMI + DOUBLE COMPLEX GAMMA0I,GAMMAPI,GAMMAMI + DOUBLE PRECISION TINY + PARAMETER (TINY=-1D-14) + INTEGER I,J + DOUBLE COMPLEX ADDFACTOR(4) + DOUBLE COMPLEX SQRT_TRAJECTORY + IF(ABS(P2*M12*M22).EQ.0D0)THEN + WRITE(*,*)'ERROR:log_trajectory works when p2*m12*m22/=0' + STOP + ENDIF + M=DBLE(P2) ! M^2 + M=DSQRT(DABS(M)) + IF(M.EQ.0D0)THEN + GA=0D0 + ELSE + GA=-DIMAG(P2)/M + ENDIF +C Eq.(5.36-5.38) in arXiv:1804.10017 + SQRTTERM=SQRT_TRAJECTORY(N_SEG,P2,M12,M22) + GAMMA0=ONE+M12/P2-M22/P2 + GAMMAP=HALF*(GAMMA0+SQRTTERM) + GAMMAM=HALF*(GAMMA0-SQRTTERM) + IF(ABS(GA).EQ.0D0)THEN + LOG_TRAJECTORY=-LOG(GAMMAP-ONE)-LOG(GAMMAM-ONE)+GAMMAP + $ *LOG((GAMMAP-ONE)/GAMMAP)+GAMMAM*LOG((GAMMAM-ONE)/GAMMAM) + RETURN + ENDIF +C segments from -DABS(tiny*Ga) to Ga + GA_START=-DABS(TINY*GA) + DGA=(GA-GA_START)/N_SEG + ADDFACTOR(1:4)=ZERO + GAI=GA_START + P2I=DCMPLX(M**2,-GAI*M) + SQRTTERMI=SQRT_TRAJECTORY(N_SEG,P2I,M12,M22) + GAMMA0I=ONE+M12/P2I-M22/P2I + GAMMAPI=HALF*(GAMMA0I+SQRTTERMI) + GAMMAMI=HALF*(GAMMA0I-SQRTTERMI) + ARGIM1(1)=GAMMAPI-ONE + ARGIM1(2)=GAMMAMI-ONE + ARGIM1(3)=(GAMMAPI-ONE)/GAMMAPI + ARGIM1(4)=(GAMMAMI-ONE)/GAMMAMI + DO I=1,N_SEG + GAI=DGA*I+GA_START + P2I=DCMPLX(M**2,-GAI*M) + SQRTTERMI=SQRT_TRAJECTORY(N_SEG,P2I,M12,M22) + GAMMA0I=ONE+M12/P2I-M22/P2I + GAMMAPI=HALF*(GAMMA0I+SQRTTERMI) + GAMMAMI=HALF*(GAMMA0I-SQRTTERMI) + ARGI(1)=GAMMAPI-ONE + ARGI(2)=GAMMAMI-ONE + ARGI(3)=(GAMMAPI-ONE)/GAMMAPI + ARGI(4)=(GAMMAMI-ONE)/GAMMAMI + DO J=1,4 + IF(DIMAG(ARGI(J))*DIMAG(ARGIM1(J)).LT.0D0)THEN + INTERSECTION=DIMAG(ARGIM1(J))*(DBLE(ARGI(J)) + $ -DBLE(ARGIM1(J))) + INTERSECTION=INTERSECTION/(DIMAG(ARGI(J))-DIMAG(ARGIM1(J) + $ )) + INTERSECTION=INTERSECTION-DBLE(ARGIM1(J)) + IF(INTERSECTION.GT.0D0)THEN + IF(DIMAG(ARGIM1(J)).LT.0)THEN + ADDFACTOR(J)=ADDFACTOR(J)-TWOPII + ELSE + ADDFACTOR(J)=ADDFACTOR(J)+TWOPII + ENDIF + ENDIF + ENDIF + ARGIM1(J)=ARGI(J) + ENDDO + ENDDO + LOG_TRAJECTORY=-(LOG(GAMMAP-ONE)+ADDFACTOR(1))-(LOG(GAMMAM-ONE) + $ +ADDFACTOR(2)) + LOG_TRAJECTORY=LOG_TRAJECTORY+GAMMAP*(LOG((GAMMAP-ONE)/GAMMAP) + $ +ADDFACTOR(3)) + LOG_TRAJECTORY=LOG_TRAJECTORY+GAMMAM*(LOG((GAMMAM-ONE)/GAMMAM) + $ +ADDFACTOR(4)) + RETURN + END + + DOUBLE COMPLEX FUNCTION ARG(COMNUM) + IMPLICIT NONE + DOUBLE COMPLEX COMNUM + DOUBLE COMPLEX IIM + IIM = (0.0D0,1.0D0) + IF(COMNUM.EQ.(0.0D0,0.0D0)) THEN + ARG=(0.0D0,0.0D0) + ELSE + ARG=LOG(COMNUM/ABS(COMNUM))/IIM + ENDIF + END + + + COMPLEX*32 FUNCTION MP_COND(CONDITION,TRUECASE,FALSECASE) + IMPLICIT NONE + COMPLEX*32 CONDITION,TRUECASE,FALSECASE + IF(CONDITION.EQ.(0.0E0_16,0.0E0_16)) THEN + MP_COND=TRUECASE + ELSE + MP_COND=FALSECASE + ENDIF + END + + COMPLEX*32 FUNCTION MP_CONDIF(CONDITION,TRUECASE,FALSECASE) + IMPLICIT NONE + LOGICAL CONDITION + COMPLEX*32 TRUECASE,FALSECASE + IF(CONDITION) THEN + MP_CONDIF=TRUECASE + ELSE + MP_CONDIF=FALSECASE + ENDIF + END + + COMPLEX*32 FUNCTION MP_RECMS(CONDITION,EXPR) + IMPLICIT NONE + LOGICAL CONDITION + COMPLEX*32 EXPR + IF(CONDITION)THEN + MP_RECMS=EXPR + ELSE + MP_RECMS=CMPLX(REAL(EXPR),KIND=16) + ENDIF + END + + + COMPLEX*32 FUNCTION MP_REGLOG(ARG_IN) + IMPLICIT NONE + COMPLEX*32 TWOPII + PARAMETER (TWOPII=2.0E0_16 + $ *3.14169258478796109557151794433593750E0_16*(0.0E0_16 + $ ,1.0E0_16)) + COMPLEX*32 ARG_IN + COMPLEX*32 ARG + ARG=ARG_IN + IF(ABS(IMAGPART(ARG)).EQ.0.0E0_16)THEN + ARG=CMPLX(REAL(ARG,KIND=16),0.0E0_16) + ENDIF + IF(ABS(REAL(ARG,KIND=16)).EQ.0.0E0_16)THEN + ARG=CMPLX(0.0E0_16,IMAGPART(ARG)) + ENDIF + IF(ARG.EQ.(0.0E0_16,0.0E0_16)) THEN + MP_REGLOG=(0.0E0_16,0.0E0_16) + ELSE + MP_REGLOG=LOG(ARG) + ENDIF + END + + COMPLEX*32 FUNCTION MP_REGLOGP(ARG_IN) + IMPLICIT NONE + COMPLEX*32 TWOPII + PARAMETER (TWOPII=2.0E0_16 + $ *3.14169258478796109557151794433593750E0_16*(0.0E0_16 + $ ,1.0E0_16)) + COMPLEX*32 ARG_IN + COMPLEX*32 ARG + ARG=ARG_IN + IF(ABS(IMAGPART(ARG)).EQ.0.0E0_16)THEN + ARG=CMPLX(REAL(ARG,KIND=16),0.0E0_16) + ENDIF + IF(ABS(REAL(ARG,KIND=16)).EQ.0.0E0_16)THEN + ARG=CMPLX(0.0E0_16,IMAGPART(ARG)) + ENDIF + IF(ARG.EQ.(0.0E0_16,0.0E0_16))THEN + MP_REGLOGP=(0.0E0_16,0.0E0_16) + ELSE + IF(REAL(ARG,KIND=16).LT.0.0E0_16.AND.IMAGPART(ARG) + $ .LT.0.0E0_16)THEN + MP_REGLOGP=LOG(ARG) + TWOPII + ELSE + MP_REGLOGP=LOG(ARG) + ENDIF + ENDIF + END + + COMPLEX*32 FUNCTION MP_REGLOGM(ARG_IN) + IMPLICIT NONE + COMPLEX*32 TWOPII + PARAMETER (TWOPII=2.0E0_16 + $ *3.14169258478796109557151794433593750E0_16*(0.0E0_16 + $ ,1.0E0_16)) + COMPLEX*32 ARG_IN + COMPLEX*32 ARG + ARG=ARG_IN + IF(ABS(IMAGPART(ARG)).EQ.0.0E0_16)THEN + ARG=CMPLX(REAL(ARG,KIND=16),0.0E0_16) + ENDIF + IF(ABS(REAL(ARG,KIND=16)).EQ.0.0E0_16)THEN + ARG=CMPLX(0.0E0_16,IMAGPART(ARG)) + ENDIF + IF(ARG.EQ.(0.0E0_16,0.0E0_16))THEN + MP_REGLOGM=(0.0E0_16,0.0E0_16) + ELSE + IF(REAL(ARG,KIND=16).LT.0.0E0_16.AND.IMAGPART(ARG) + $ .GT.0.0E0_16)THEN + MP_REGLOGM=LOG(ARG) - TWOPII + ELSE + MP_REGLOGM=LOG(ARG) + ENDIF + ENDIF + END + + COMPLEX*32 FUNCTION MP_REGSQRT(ARG_IN) + IMPLICIT NONE + COMPLEX*32 ARG_IN + COMPLEX*32 ARG + ARG=ARG_IN + IF(ABS(IMAGPART(ARG)).EQ.0.0E0_16)THEN + ARG=CMPLX(REAL(ARG,KIND=16),0.0E0_16) + ENDIF + IF(ABS(REAL(ARG,KIND=16)).EQ.0.0E0_16)THEN + ARG=CMPLX(0.0E0_16,IMAGPART(ARG)) + ENDIF + MP_REGSQRT=SQRT(ARG) + END + + COMPLEX*32 FUNCTION MP_GRREGLOG(LOGSW,EXPR1_IN,EXPR2_IN) + IMPLICIT NONE + COMPLEX*32 TWOPII + PARAMETER (TWOPII=2.0E0_16 + $ *3.14169258478796109557151794433593750E0_16*(0.0E0_16 + $ ,1.0E0_16)) + COMPLEX*32 EXPR1_IN,EXPR2_IN + COMPLEX*32 EXPR1,EXPR2 + REAL*16 LOGSW + REAL*16 IMAGEXPR + LOGICAL FIRSTSHEET + EXPR1=EXPR1_IN + EXPR2=EXPR2_IN + IF(ABS(IMAGPART(EXPR1)).EQ.0.0E0_16)THEN + EXPR1=CMPLX(REAL(EXPR1,KIND=16),0.0E0_16) + ENDIF + IF(ABS(REAL(EXPR1,KIND=16)).EQ.0.0E0_16)THEN + EXPR1=CMPLX(0.0E0_16,IMAGPART(EXPR1)) + ENDIF + IF(ABS(IMAGPART(EXPR2)).EQ.0.0E0_16)THEN + EXPR2=CMPLX(REAL(EXPR2,KIND=16),0.0E0_16) + ENDIF + IF(ABS(REAL(EXPR2,KIND=16)).EQ.0.0E0_16)THEN + EXPR2=CMPLX(0.0E0_16,IMAGPART(EXPR2)) + ENDIF + IF(EXPR1.EQ.(0.0E0_16,0.0E0_16))THEN + MP_GRREGLOG=(0.0E0_16,0.0E0_16) + ELSE + IMAGEXPR=IMAGPART(EXPR1)*IMAGPART(EXPR2) + FIRSTSHEET=IMAGEXPR.GE.0.0E0_16 + FIRSTSHEET=FIRSTSHEET.OR.REAL(EXPR1,KIND=16).GE.0.0E0_16 + FIRSTSHEET=FIRSTSHEET.OR.REAL(EXPR2,KIND=16).GE.0.0E0_16 + IF(FIRSTSHEET)THEN + MP_GRREGLOG=LOG(EXPR1) + ELSE + IF(IMAGPART(EXPR1).GT.0.0E0_16)THEN + MP_GRREGLOG=LOG(EXPR1) - LOGSW*TWOPII + ELSE + MP_GRREGLOG=LOG(EXPR1) + LOGSW*TWOPII + ENDIF + ENDIF + ENDIF + END + + MODULE MP_B0F_CACHING + + TYPE MP_B0F_NODE + COMPLEX*32 P2,M12,M22 + COMPLEX*32 VALUE + TYPE(MP_B0F_NODE),POINTER::PARENT + TYPE(MP_B0F_NODE),POINTER::LEFT + TYPE(MP_B0F_NODE),POINTER::RIGHT + END TYPE MP_B0F_NODE + + CONTAINS + + SUBROUTINE MP_B0F_SEARCH(ITEM, HEAD, FIND) + IMPLICIT NONE + TYPE(MP_B0F_NODE),POINTER,INTENT(INOUT)::HEAD,ITEM + LOGICAL,INTENT(OUT)::FIND + TYPE(MP_B0F_NODE),POINTER::ITEM1 + INTEGER::ICOMP + FIND=.FALSE. + NULLIFY(ITEM%PARENT) + NULLIFY(ITEM%LEFT) + NULLIFY(ITEM%RIGHT) + IF(.NOT.ASSOCIATED(HEAD))THEN + HEAD => ITEM + RETURN + ENDIF + ITEM1 => HEAD + DO + ICOMP=MP_B0F_NODE_COMPARE(ITEM,ITEM1) + IF(ICOMP.LT.0)THEN + IF(.NOT.ASSOCIATED(ITEM1%LEFT))THEN + ITEM1%LEFT => ITEM + ITEM%PARENT => ITEM1 + EXIT + ELSE + ITEM1 => ITEM1%LEFT + ENDIF + ELSEIF(ICOMP.GT.0)THEN + IF(.NOT.ASSOCIATED(ITEM1%RIGHT))THEN + ITEM1%RIGHT => ITEM + ITEM%PARENT => ITEM1 + EXIT + ELSE + ITEM1 => ITEM1%RIGHT + ENDIF + ELSE + FIND=.TRUE. + ITEM%VALUE=ITEM1%VALUE + EXIT + ENDIF + ENDDO + RETURN + END + + INTEGER FUNCTION MP_B0F_NODE_COMPARE(ITEM1,ITEM2) RESULT(RES) + IMPLICIT NONE + TYPE(MP_B0F_NODE),POINTER,INTENT(IN)::ITEM1,ITEM2 + RES=MP_COMPLEX_COMPARE(ITEM1%P2,ITEM2%P2) + IF(RES.NE.0)RETURN + RES=MP_COMPLEX_COMPARE(ITEM1%M22,ITEM2%M22) + IF(RES.NE.0)RETURN + RES=MP_COMPLEX_COMPARE(ITEM1%M12,ITEM2%M12) + RETURN + END + + INTEGER FUNCTION MP_REAL_COMPARE(R1,R2) RESULT(RES) + IMPLICIT NONE + REAL*16 R1,R2 + REAL*16 MAXR,DIFF + REAL*16 TINY + PARAMETER (TINY=-1.0E-14_16) + MAXR=MAX(ABS(R1),ABS(R2)) + DIFF=R1-R2 + IF(MAXR.LE.1.0E-99_16.OR.ABS(DIFF)/MAX(MAXR,1.0E-99_16) + $ .LE.ABS(TINY))THEN + RES=0 + RETURN + ENDIF + IF(DIFF.GT.0.0E0_16)THEN + RES=1 + RETURN + ELSE + RES=-1 + RETURN + ENDIF + END + + INTEGER FUNCTION MP_COMPLEX_COMPARE(C1,C2) RESULT(RES) + IMPLICIT NONE + COMPLEX*32 C1,C2 + REAL*16 R1,R2 + R1=REAL(C1,KIND=16) + R2=REAL(C2,KIND=16) + RES=MP_REAL_COMPARE(R1,R2) + IF(RES.NE.0)RETURN + R1=IMAGPART(C1) + R2=IMAGPART(C2) + RES=MP_REAL_COMPARE(R1,R2) + RETURN + END + + END MODULE MP_B0F_CACHING + + COMPLEX*32 FUNCTION MP_B0F(P2,M12,M22) + USE MP_B0F_CACHING + IMPLICIT NONE + COMPLEX*32 P2,M12,M22 + COMPLEX*32 ZERO,TWOPII + PARAMETER (ZERO=(0.0E0_16,0.0E0_16)) + PARAMETER (TWOPII=2.0E0_16 + $ *3.14169258478796109557151794433593750E0_16*(0.0E0_16 + $ ,1.0E0_16)) + REAL*16 M,M2,GA,GA2 + REAL*16 TINY + PARAMETER (TINY=-1.0E-14_16) + COMPLEX*32 LOGTERMS + COMPLEX*32 MP_LOG_TRAJECTORY + LOGICAL USE_CACHING + PARAMETER (USE_CACHING=.TRUE.) + TYPE(MP_B0F_NODE),POINTER::ITEM + TYPE(MP_B0F_NODE),POINTER,SAVE::B0F_BT + INTEGER INIT + SAVE INIT + DATA INIT /0/ + LOGICAL FIND + IF(M12.EQ.ZERO)THEN + M=REAL(P2,KIND=16) + M2=REAL(M22,KIND=16) + IF(M.LT.TINY.OR.M2.LT.TINY)THEN + WRITE(*,*)'ERROR:MP_B0F is not well defined when M^2' + $ //',M2^2<0' + STOP + ENDIF + M=SQRT(ABS(M)) + M2=SQRT(ABS(M2)) + IF(M.EQ.0.0E0_16)THEN + GA=0.0E0_16 + ELSE + GA=-IMAGPART(P2)/M + ENDIF + IF(M2.EQ.0.0E0_16)THEN + GA2=0.0E0_16 + ELSE + GA2=-IMAGPART(M22)/M2 + ENDIF + IF(P2.NE.M22.AND.P2.NE.ZERO.AND.M22.NE.ZERO)THEN + MP_B0F=(M22-P2)/P2*LOG((M22-P2)/M22) + IF(M.GT.M2.AND.GA*M2.GT.GA2*M)THEN + MP_B0F=MP_B0F-TWOPII + ENDIF + RETURN + ELSE + WRITE(*,*)'ERROR:MP_B0F is not supported for a simple' + $ //' form' + STOP + ENDIF + ENDIF + IF(USE_CACHING)THEN + IF(INIT.EQ.0)THEN + NULLIFY(B0F_BT) + INIT=1 + ENDIF + ALLOCATE(ITEM) + ITEM%P2=P2 + ITEM%M12=M12 + ITEM%M22=M22 + FIND=.FALSE. + CALL MP_B0F_SEARCH(ITEM, B0F_BT, FIND) + IF(FIND)THEN + MP_B0F=ITEM%VALUE + DEALLOCATE(ITEM) + RETURN + ELSE + LOGTERMS=MP_LOG_TRAJECTORY(100,P2,M12,M22) + MP_B0F=-LOG(P2/M22)+LOGTERMS + ITEM%VALUE=MP_B0F + RETURN + ENDIF + ELSE + LOGTERMS=MP_LOG_TRAJECTORY(100,P2,M12,M22) + MP_B0F=-LOG(P2/M22)+LOGTERMS + ENDIF + RETURN + END + + COMPLEX*32 FUNCTION MP_SQRT_TRAJECTORY(N_SEG,P2,M12,M22) + IMPLICIT NONE + INTEGER N_SEG + COMPLEX*32 P2,M12,M22 + COMPLEX*32 ZERO,ONE + PARAMETER (ZERO=(0.0E0_16,0.0E0_16),ONE=(1.0E0_16,0.0E0_16)) + COMPLEX*32 GAMMA0,GAMMA1 + REAL*16 M,GA,DGA,GA_START + REAL*16 GAI,INTERSECTION + COMPLEX*32 ARGIM1,ARGI,P2I + COMPLEX*32 GAMMA0I,GAMMA1I + REAL*16 TINY + PARAMETER (TINY=-1.0E-24_16) + INTEGER I + REAL*16 PREFACTOR + IF(ABS(P2*M12*M22).EQ.0.0E0_16)THEN + WRITE(*,*)'ERROR:mp_sqrt_trajectory works when p2*m12*m22' + $ //'/=0' + STOP + ENDIF + M=REAL(P2,KIND=16) + M=SQRT(ABS(M)) + IF(M.EQ.0.0E0_16)THEN + GA=0.0E0_16 + ELSE + GA=-IMAGPART(P2)/M + ENDIF + GAMMA0=ONE+M12/P2-M22/P2 + GAMMA1=M12/P2-CMPLX(0.0E0_16,1.0E0_16)*ABS(TINY)/P2 + IF(ABS(GA).EQ.0.0E0_16)THEN + MP_SQRT_TRAJECTORY=SQRT(GAMMA0**2-4.0E0_16*GAMMA1) + RETURN + ENDIF + GA_START=-ABS(TINY*GA) + DGA=(GA-GA_START)/N_SEG + PREFACTOR=1.0E0_16 + GAI=GA_START + P2I=CMPLX(M**2,-GAI*M) + GAMMA0I=ONE+M12/P2I-M22/P2I + GAMMA1I=M12/P2I-CMPLX(0.0E0_16,1.0E0_16)*ABS(TINY)/P2I + ARGIM1=GAMMA0I**2-4.0E0_16*GAMMA1I + DO I=1,N_SEG + GAI=DGA*I+GA_START + P2I=CMPLX(M**2,-GAI*M) + GAMMA0I=ONE+M12/P2I-M22/P2I + GAMMA1I=M12/P2I-CMPLX(0.0E0_16,1.0E0_16)*ABS(TINY)/P2I + ARGI=GAMMA0I**2-4.0E0_16*GAMMA1I + IF(IMAGPART(ARGI)*IMAGPART(ARGIM1).LT.0.0E0_16)THEN + INTERSECTION=IMAGPART(ARGIM1)*(REAL(ARGI,KIND=16) + $ -REAL(ARGIM1,KIND=16)) + INTERSECTION=INTERSECTION/(IMAGPART(ARGI) + $ -IMAGPART(ARGIM1)) + INTERSECTION=INTERSECTION-REAL(ARGIM1,KIND=16) + IF(INTERSECTION.GT.0.0E0_16)THEN + PREFACTOR=-PREFACTOR + ENDIF + ENDIF + ARGIM1=ARGI + ENDDO + MP_SQRT_TRAJECTORY=SQRT(GAMMA0**2-4.0E0_16*GAMMA1)*PREFACTOR + RETURN + END + + COMPLEX*32 FUNCTION MP_LOG_TRAJECTORY(N_SEG,P2,M12,M22) + IMPLICIT NONE + INTEGER N_SEG + COMPLEX*32 P2,M12,M22 + COMPLEX*32 ZERO,ONE,HALF,TWOPII + PARAMETER (ZERO=(0.0E0_16,0.0E0_16),ONE=(1.0E0_16,0.0E0_16)) + PARAMETER (HALF=(0.5E0_16,0.0E0_16)) + PARAMETER (TWOPII=2.0E0_16 + $ *3.14169258478796109557151794433593750E0_16*(0.0E0_16 + $ ,1.0E0_16)) + COMPLEX*32 GAMMA0,GAMMAP,GAMMAM,SQRTTERM + REAL*16 M,GA,DGA,GA_START + REAL*16 GAI,INTERSECTION + COMPLEX*32 ARGIM1(4),ARGI(4),P2I,SQRTTERMI + COMPLEX*32 GAMMA0I,GAMMAPI,GAMMAMI + REAL*16 TINY + PARAMETER (TINY=-1.0E-14_16) + INTEGER I,J + COMPLEX*32 ADDFACTOR(4) + COMPLEX*32 MP_SQRT_TRAJECTORY + IF(ABS(P2*M12*M22).EQ.0.0E0_16)THEN + WRITE(*,*)'ERROR:mp_log_trajectory works when p2*m12*m22' + $ //'/=0' + STOP + ENDIF + M=REAL(P2,KIND=16) + M=SQRT(ABS(M)) + IF(M.EQ.0.0E0_16)THEN + GA=0.0E0_16 + ELSE + GA=-IMAGPART(P2)/M + ENDIF + SQRTTERM=MP_SQRT_TRAJECTORY(N_SEG,P2,M12,M22) + GAMMA0=ONE+M12/P2-M22/P2 + GAMMAP=HALF*(GAMMA0+SQRTTERM) + GAMMAM=HALF*(GAMMA0-SQRTTERM) + IF(ABS(GA).EQ.0.0E0_16)THEN + MP_LOG_TRAJECTORY=-LOG(GAMMAP-ONE)-LOG(GAMMAM-ONE)+GAMMAP + $ *LOG((GAMMAP-ONE)/GAMMAP)+GAMMAM*LOG((GAMMAM-ONE)/GAMMAM) + RETURN + ENDIF + GA_START=-ABS(TINY*GA) + DGA=(GA-GA_START)/N_SEG + ADDFACTOR(1:4)=ZERO + GAI=GA_START + P2I=CMPLX(M**2,-GAI*M) + SQRTTERMI=MP_SQRT_TRAJECTORY(N_SEG,P2I,M12,M22) + GAMMA0I=ONE+M12/P2I-M22/P2I + GAMMAPI=HALF*(GAMMA0I+SQRTTERMI) + GAMMAMI=HALF*(GAMMA0I-SQRTTERMI) + ARGIM1(1)=GAMMAPI-ONE + ARGIM1(2)=GAMMAMI-ONE + ARGIM1(3)=(GAMMAPI-ONE)/GAMMAPI + ARGIM1(4)=(GAMMAMI-ONE)/GAMMAMI + DO I=1,N_SEG + GAI=DGA*I+GA_START + P2I=CMPLX(M**2,-GAI*M) + SQRTTERMI=MP_SQRT_TRAJECTORY(N_SEG,P2I,M12,M22) + GAMMA0I=ONE+M12/P2I-M22/P2I + GAMMAPI=HALF*(GAMMA0I+SQRTTERMI) + GAMMAMI=HALF*(GAMMA0I-SQRTTERMI) + ARGI(1)=GAMMAPI-ONE + ARGI(2)=GAMMAMI-ONE + ARGI(3)=(GAMMAPI-ONE)/GAMMAPI + ARGI(4)=(GAMMAMI-ONE)/GAMMAMI + DO J=1,4 + IF(IMAGPART(ARGI(J))*IMAGPART(ARGIM1(J)).LT.0.0E0_16)THEN + INTERSECTION=IMAGPART(ARGIM1(J))*(REAL(ARGI(J),KIND=16) + $ -REAL(ARGIM1(J),KIND=16)) + INTERSECTION=INTERSECTION/(IMAGPART(ARGI(J)) + $ -IMAGPART(ARGIM1(J))) + INTERSECTION=INTERSECTION-REAL(ARGIM1(J),KIND=16) + IF(INTERSECTION.GT.0.0E0_16)THEN + IF(IMAGPART(ARGIM1(J)).LT.0.0E0_16)THEN + ADDFACTOR(J)=ADDFACTOR(J)-TWOPII + ELSE + ADDFACTOR(J)=ADDFACTOR(J)+TWOPII + ENDIF + ENDIF + ENDIF + ARGIM1(J)=ARGI(J) + ENDDO + ENDDO + MP_LOG_TRAJECTORY=-(LOG(GAMMAP-ONE)+ADDFACTOR(1)) + $ -(LOG(GAMMAM-ONE)+ADDFACTOR(2)) + MP_LOG_TRAJECTORY=MP_LOG_TRAJECTORY+GAMMAP*(LOG((GAMMAP-ONE) + $ /GAMMAP)+ADDFACTOR(3)) + MP_LOG_TRAJECTORY=MP_LOG_TRAJECTORY+GAMMAM*(LOG((GAMMAM-ONE) + $ /GAMMAM)+ADDFACTOR(4)) + RETURN + END + + COMPLEX*32 FUNCTION MP_ARG(COMNUM) + IMPLICIT NONE + COMPLEX*32 COMNUM + COMPLEX*32 IMM + IMM = (0.0E0_16,1.0E0_16) + IF(COMNUM.EQ.(0.0E0_16,0.0E0_16)) THEN + MP_ARG=(0.0E0_16,0.0E0_16) + ELSE + MP_ARG=LOG(COMNUM/ABS(COMNUM))/IMM + ENDIF + END diff --git a/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%..%..%Source%MODEL%model_functions.inc b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%..%..%Source%MODEL%model_functions.inc new file mode 100644 index 0000000000..226ecdc380 --- /dev/null +++ b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%..%..%Source%MODEL%model_functions.inc @@ -0,0 +1,32 @@ +ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc +c written by the UFO converter +ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + + DOUBLE COMPLEX COND + DOUBLE COMPLEX CONDIF + DOUBLE COMPLEX REGLOG + DOUBLE COMPLEX REGLOGP + DOUBLE COMPLEX REGLOGM + DOUBLE COMPLEX REGSQRT + DOUBLE COMPLEX GRREGLOG + DOUBLE COMPLEX RECMS + DOUBLE COMPLEX ARG + DOUBLE COMPLEX B0F + DOUBLE COMPLEX SQRT_TRAJECTORY + DOUBLE COMPLEX LOG_TRAJECTORY + + + COMPLEX*32 MP_COND + COMPLEX*32 MP_CONDIF + COMPLEX*32 MP_REGLOG + COMPLEX*32 MP_REGLOGP + COMPLEX*32 MP_REGLOGM + COMPLEX*32 MP_REGSQRT + COMPLEX*32 MP_GRREGLOG + COMPLEX*32 MP_RECMS + COMPLEX*32 MP_ARG + COMPLEX*32 MP_B0F + COMPLEX*32 MP_SQRT_TRAJECTORY + COMPLEX*32 MP_LOG_TRAJECTORY + + diff --git a/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%..%..%Source%MODEL%mp_coupl.inc b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%..%..%Source%MODEL%mp_coupl.inc new file mode 100644 index 0000000000..88aa8d817c --- /dev/null +++ b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%..%..%Source%MODEL%mp_coupl.inc @@ -0,0 +1,35 @@ +ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc +c written by the UFO converter +ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + + REAL*16 MP__G + COMMON/MP_STRONG/ MP__G + + COMPLEX*32 MP__GAL(2) + COMMON/MP_WEAK/ MP__GAL + + COMPLEX*32 MP__MU_R + COMMON/MP_RSCALE/ MP__MU_R + + + REAL*16 MP__MDL_MB,MP__MDL_MH,MP__MDL_MT,MP__MDL_MTA,MP__MDL_MW + $ ,MP__MDL_MZ + + COMMON/MP_MASSES/ MP__MDL_MB,MP__MDL_MH,MP__MDL_MT,MP__MDL_MTA + $ ,MP__MDL_MW,MP__MDL_MZ + + + REAL*16 MP__MDL_WH,MP__MDL_WT,MP__MDL_WW,MP__MDL_WZ + + COMMON/MP_WIDTHS/ MP__MDL_WH,MP__MDL_WT,MP__MDL_WW,MP__MDL_WZ + + + COMPLEX*32 MP__GC_30,MP__GC_33,MP__GC_37 + + COMPLEX*32 MP__GC_5,MP__R2_GGHB,MP__R2_GGHT,MP__R2_GGHHB + $ ,MP__R2_GGHHT + + COMMON/MP_COUPLINGS/ MP__GC_5,MP__R2_GGHB,MP__R2_GGHT + $ ,MP__R2_GGHHB,MP__R2_GGHHT,MP__GC_30,MP__GC_33,MP__GC_37 + + diff --git a/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%..%..%Source%MODEL%mp_coupl_same_name.inc b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%..%..%Source%MODEL%mp_coupl_same_name.inc new file mode 100644 index 0000000000..a88fb6cd43 --- /dev/null +++ b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%..%..%Source%MODEL%mp_coupl_same_name.inc @@ -0,0 +1,32 @@ +ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc +c written by the UFO converter +ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + + REAL*16 G + COMMON/MP_STRONG/ G + + COMPLEX*32 GAL(2) + COMMON/MP_WEAK/ GAL + + COMPLEX*32 MU_R + COMMON/MP_RSCALE/ MU_R + + + REAL*16 MDL_MB,MDL_MH,MDL_MT,MDL_MTA,MDL_MW,MDL_MZ + + COMMON/MP_MASSES/ MDL_MB,MDL_MH,MDL_MT,MDL_MTA,MDL_MW,MDL_MZ + + + REAL*16 MDL_WH,MDL_WT,MDL_WW,MDL_WZ + + COMMON/MP_WIDTHS/ MDL_WH,MDL_WT,MDL_WW,MDL_WZ + + + COMPLEX*32 GC_30,GC_33,GC_37 + + COMPLEX*32 GC_5,R2_GGHB,R2_GGHT,R2_GGHHB,R2_GGHHT + + COMMON/MP_COUPLINGS/ GC_5,R2_GGHB,R2_GGHT,R2_GGHHB,R2_GGHHT + $ ,GC_30,GC_33,GC_37 + + diff --git a/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%..%..%Source%MODEL%mp_couplings1.f b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%..%..%Source%MODEL%mp_couplings1.f new file mode 100644 index 0000000000..89cf1f0d91 --- /dev/null +++ b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%..%..%Source%MODEL%mp_couplings1.f @@ -0,0 +1,20 @@ +ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc +c written by the UFO converter +ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + + SUBROUTINE MP_COUP1( ) + USE MODEL_OBJECT + IMPLICIT NONE + + INCLUDE 'model_functions.inc' + REAL*16 MP__PI, MP__ZERO + PARAMETER (MP__PI=3.1415926535897932384626433832795E0_16) + PARAMETER (MP__ZERO=0E0_16) + INCLUDE 'mp_input.inc' + INCLUDE 'mp_coupl.inc' + + MP__GC_30 = -6.000000E+00_16*MP__MDL_COMPLEXI*MP__MDL_LAM + $ *MP__MDL_V + MP__GC_33 = -((MP__MDL_COMPLEXI*MP__MDL_YB)/MP__MDL_SQRT__2) + MP__GC_37 = -((MP__MDL_COMPLEXI*MP__MDL_YT)/MP__MDL_SQRT__2) + END diff --git a/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%..%..%Source%MODEL%mp_couplings2.f b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%..%..%Source%MODEL%mp_couplings2.f new file mode 100644 index 0000000000..b69c61d50d --- /dev/null +++ b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%..%..%Source%MODEL%mp_couplings2.f @@ -0,0 +1,16 @@ +ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc +c written by the UFO converter +ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + + SUBROUTINE MP_COUP2( ) + USE MODEL_OBJECT + IMPLICIT NONE + + INCLUDE 'model_functions.inc' + REAL*16 MP__PI, MP__ZERO + PARAMETER (MP__PI=3.1415926535897932384626433832795E0_16) + PARAMETER (MP__ZERO=0E0_16) + INCLUDE 'mp_input.inc' + INCLUDE 'mp_coupl.inc' + + END diff --git a/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%..%..%Source%MODEL%mp_couplings3.f b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%..%..%Source%MODEL%mp_couplings3.f new file mode 100644 index 0000000000..b24fae0304 --- /dev/null +++ b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%..%..%Source%MODEL%mp_couplings3.f @@ -0,0 +1,29 @@ +ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc +c written by the UFO converter +ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + + SUBROUTINE MP_COUP3( ) + USE MODEL_OBJECT + IMPLICIT NONE + + INCLUDE 'model_functions.inc' + REAL*16 MP__PI, MP__ZERO + PARAMETER (MP__PI=3.1415926535897932384626433832795E0_16) + PARAMETER (MP__ZERO=0E0_16) + INCLUDE 'mp_input.inc' + INCLUDE 'mp_coupl.inc' + + MP__GC_5 = MP__MDL_COMPLEXI*MP__G + MP__R2_GGHB = 4.000000E+00_16*(-((MP__MDL_COMPLEXI*MP__MDL_YB) + $ /MP__MDL_SQRT__2))*(1.000000E+00_16/2.000000E+00_16) + $ *(MP__MDL_G__EXP__2/(8.000000E+00_16*MP__PI**2))*MP__MDL_MB + MP__R2_GGHT = 4.000000E+00_16*(-((MP__MDL_COMPLEXI*MP__MDL_YT) + $ /MP__MDL_SQRT__2))*(1.000000E+00_16/2.000000E+00_16) + $ *(MP__MDL_G__EXP__2/(8.000000E+00_16*MP__PI**2))*MP__MDL_MT + MP__R2_GGHHB = 4.000000E+00_16*(-MP__MDL_YB__EXP__2/2.000000E + $ +00_16)*(1.000000E+00_16/2.000000E+00_16)*((MP__MDL_COMPLEXI + $ *MP__MDL_G__EXP__2)/(8.000000E+00_16*MP__PI**2)) + MP__R2_GGHHT = 4.000000E+00_16*(-MP__MDL_YT__EXP__2/2.000000E + $ +00_16)*(1.000000E+00_16/2.000000E+00_16)*((MP__MDL_COMPLEXI + $ *MP__MDL_G__EXP__2)/(8.000000E+00_16*MP__PI**2)) + END diff --git a/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%..%..%Source%MODEL%mp_input.inc b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%..%..%Source%MODEL%mp_input.inc new file mode 100644 index 0000000000..cc57ecc7f4 --- /dev/null +++ b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%..%..%Source%MODEL%mp_input.inc @@ -0,0 +1,51 @@ +ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc +c written by the UFO converter +ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + + REAL*16 MP__MDL_SQRT__AS,MP__MDL_G__EXP__4,MP__MDL_G__EXP__2 + $ ,MP__MDL_G__EXP__3,MP__MDL_MU_R__EXP__2,MP__MDL_LHV + $ ,MP__MDL_CONJG__CKM3X3,MP__MDL_CONJG__CKM22,MP__MDL_CKM3X3 + $ ,MP__MDL_CKM33,MP__MDL_CKM22,MP__MDL_NCOL,MP__MDL_CA,MP__MDL_TF + $ ,MP__MDL_CF,MP__MDL_MZ__EXP__2,MP__MDL_MZ__EXP__4 + $ ,MP__MDL_SQRT__2,MP__MDL_MH__EXP__2,MP__MDL_NCOL__EXP__2 + $ ,MP__MDL_MB__EXP__2,MP__MDL_MT__EXP__2,MP__MDL_AEW + $ ,MP__MDL_SQRT__AEW,MP__MDL_EE,MP__MDL_MW__EXP__2,MP__MDL_SW2 + $ ,MP__MDL_CW,MP__MDL_SQRT__SW2,MP__MDL_SW,MP__MDL_G1,MP__MDL_GW + $ ,MP__MDL_V,MP__MDL_V__EXP__2,MP__MDL_LAM,MP__MDL_YB,MP__MDL_YT + $ ,MP__MDL_YTAU,MP__MDL_MUH,MP__MDL_AXIALZUP,MP__MDL_AXIALZDOWN + $ ,MP__MDL_VECTORZUP,MP__MDL_VECTORZDOWN,MP__MDL_VECTORAUP + $ ,MP__MDL_VECTORADOWN,MP__MDL_VECTORWMDXU,MP__MDL_AXIALWMDXU + $ ,MP__MDL_VECTORWPUXD,MP__MDL_AXIALWPUXD,MP__MDL_GW__EXP__2 + $ ,MP__MDL_CW__EXP__2,MP__MDL_EE__EXP__2,MP__MDL_SW__EXP__2 + $ ,MP__MDL_YB__EXP__2,MP__MDL_YT__EXP__2,MP__AEWM1,MP__MDL_GF + $ ,MP__AS,MP__MDL_YMB,MP__MDL_YMT,MP__MDL_YMTAU + + COMMON/MP_T_PARAMS_R/ MP__MDL_SQRT__AS,MP__MDL_G__EXP__4 + $ ,MP__MDL_G__EXP__2,MP__MDL_G__EXP__3,MP__MDL_MU_R__EXP__2 + $ ,MP__MDL_LHV,MP__MDL_CONJG__CKM3X3,MP__MDL_CONJG__CKM22 + $ ,MP__MDL_CKM3X3,MP__MDL_CKM33,MP__MDL_CKM22,MP__MDL_NCOL + $ ,MP__MDL_CA,MP__MDL_TF,MP__MDL_CF,MP__MDL_MZ__EXP__2 + $ ,MP__MDL_MZ__EXP__4,MP__MDL_SQRT__2,MP__MDL_MH__EXP__2 + $ ,MP__MDL_NCOL__EXP__2,MP__MDL_MB__EXP__2,MP__MDL_MT__EXP__2 + $ ,MP__MDL_AEW,MP__MDL_SQRT__AEW,MP__MDL_EE,MP__MDL_MW__EXP__2 + $ ,MP__MDL_SW2,MP__MDL_CW,MP__MDL_SQRT__SW2,MP__MDL_SW,MP__MDL_G1 + $ ,MP__MDL_GW,MP__MDL_V,MP__MDL_V__EXP__2,MP__MDL_LAM,MP__MDL_YB + $ ,MP__MDL_YT,MP__MDL_YTAU,MP__MDL_MUH,MP__MDL_AXIALZUP + $ ,MP__MDL_AXIALZDOWN,MP__MDL_VECTORZUP,MP__MDL_VECTORZDOWN + $ ,MP__MDL_VECTORAUP,MP__MDL_VECTORADOWN,MP__MDL_VECTORWMDXU + $ ,MP__MDL_AXIALWMDXU,MP__MDL_VECTORWPUXD,MP__MDL_AXIALWPUXD + $ ,MP__MDL_GW__EXP__2,MP__MDL_CW__EXP__2,MP__MDL_EE__EXP__2 + $ ,MP__MDL_SW__EXP__2,MP__MDL_YB__EXP__2,MP__MDL_YT__EXP__2 + $ ,MP__AEWM1,MP__MDL_GF,MP__AS,MP__MDL_YMB,MP__MDL_YMT + $ ,MP__MDL_YMTAU + + + COMPLEX*32 MP__MDL_COMPLEXI,MP__MDL_I1X33,MP__MDL_I2X33 + $ ,MP__MDL_I3X33,MP__MDL_I4X33,MP__MDL_VECTOR_TBGP + $ ,MP__MDL_AXIAL_TBGP,MP__MDL_VECTOR_TBGM,MP__MDL_AXIAL_TBGM + + COMMON/MP_PARAMS_C/ MP__MDL_COMPLEXI,MP__MDL_I1X33,MP__MDL_I2X33 + $ ,MP__MDL_I3X33,MP__MDL_I4X33,MP__MDL_VECTOR_TBGP + $ ,MP__MDL_AXIAL_TBGP,MP__MDL_VECTOR_TBGM,MP__MDL_AXIAL_TBGM + + diff --git a/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%..%..%Source%MODEL%mp_intparam_definition.inc b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%..%..%Source%MODEL%mp_intparam_definition.inc new file mode 100644 index 0000000000..43063749d3 --- /dev/null +++ b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%..%..%Source%MODEL%mp_intparam_definition.inc @@ -0,0 +1,180 @@ +ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc +c written by the UFO converter +ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + +C Parameters that should not be recomputed event by event. +C + IF(READLHA) THEN + + MP__G = 2 * SQRT(MP__AS*MP__PI) ! for the first init + + MP__MDL_LHV = 1.000000E+00_16 + + MP__MDL_CONJG__CKM3X3 = 1.000000E+00_16 + + MP__MDL_CONJG__CKM22 = 1.000000E+00_16 + + MP__MDL_CKM3X3 = 1.000000E+00_16 + + MP__MDL_CKM33 = 1.000000E+00_16 + + MP__MDL_CKM22 = 1.000000E+00_16 + + MP__MDL_NCOL = 3.000000E+00_16 + + MP__MDL_CA = 3.000000E+00_16 + + MP__MDL_TF = 5.000000E-01_16 + + MP__MDL_CF = (4.000000E+00_16/3.000000E+00_16) + + MP__MDL_COMPLEXI = CMPLX(0.000000E+00_16,1.000000E+00_16 + $ ,KIND=16) + + MP__MDL_MZ__EXP__2 = MP__MDL_MZ**2 + + MP__MDL_MZ__EXP__4 = MP__MDL_MZ**4 + + MP__MDL_SQRT__2 = SQRT(CMPLX((2.000000E+00_16),KIND=16)) + + MP__MDL_MH__EXP__2 = MP__MDL_MH**2 + + MP__MDL_NCOL__EXP__2 = MP__MDL_NCOL**2 + + MP__MDL_MB__EXP__2 = MP__MDL_MB**2 + + MP__MDL_MT__EXP__2 = MP__MDL_MT**2 + + MP__MDL_AEW = 1.000000E+00_16/MP__AEWM1 + + MP__MDL_MW = SQRT(CMPLX((MP__MDL_MZ__EXP__2/2.000000E+00_16 + $ +SQRT(CMPLX((MP__MDL_MZ__EXP__4/4.000000E+00_16-(MP__MDL_AEW + $ *MP__PI*MP__MDL_MZ__EXP__2)/(MP__MDL_GF*MP__MDL_SQRT__2)) + $ ,KIND=16))),KIND=16)) + + MP__MDL_SQRT__AEW = SQRT(CMPLX((MP__MDL_AEW),KIND=16)) + + MP__MDL_EE = 2.000000E+00_16*MP__MDL_SQRT__AEW + $ *SQRT(CMPLX((MP__PI),KIND=16)) + + MP__MDL_MW__EXP__2 = MP__MDL_MW**2 + + MP__MDL_SW2 = 1.000000E+00_16-MP__MDL_MW__EXP__2 + $ /MP__MDL_MZ__EXP__2 + + MP__MDL_CW = SQRT(CMPLX((1.000000E+00_16-MP__MDL_SW2),KIND=16)) + + MP__MDL_SQRT__SW2 = SQRT(CMPLX((MP__MDL_SW2),KIND=16)) + + MP__MDL_SW = MP__MDL_SQRT__SW2 + + MP__MDL_G1 = MP__MDL_EE/MP__MDL_CW + + MP__MDL_GW = MP__MDL_EE/MP__MDL_SW + + MP__MDL_V = (2.000000E+00_16*MP__MDL_MW*MP__MDL_SW)/MP__MDL_EE + + MP__MDL_V__EXP__2 = MP__MDL_V**2 + + MP__MDL_LAM = MP__MDL_MH__EXP__2/(2.000000E+00_16 + $ *MP__MDL_V__EXP__2) + + MP__MDL_YB = (MP__MDL_YMB*MP__MDL_SQRT__2)/MP__MDL_V + + MP__MDL_YT = (MP__MDL_YMT*MP__MDL_SQRT__2)/MP__MDL_V + + MP__MDL_YTAU = (MP__MDL_YMTAU*MP__MDL_SQRT__2)/MP__MDL_V + + MP__MDL_MUH = SQRT(CMPLX((MP__MDL_LAM*MP__MDL_V__EXP__2) + $ ,KIND=16)) + + MP__MDL_AXIALZUP = (3.000000E+00_16/2.000000E+00_16)*( + $ -(MP__MDL_EE*MP__MDL_SW)/(6.000000E+00_16*MP__MDL_CW)) + $ -(1.000000E+00_16/2.000000E+00_16)*((MP__MDL_CW*MP__MDL_EE) + $ /(2.000000E+00_16*MP__MDL_SW)) + + MP__MDL_AXIALZDOWN = (-1.000000E+00_16/2.000000E+00_16)*( + $ -(MP__MDL_CW*MP__MDL_EE)/(2.000000E+00_16*MP__MDL_SW))+( + $ -3.000000E+00_16/2.000000E+00_16)*(-(MP__MDL_EE*MP__MDL_SW) + $ /(6.000000E+00_16*MP__MDL_CW)) + + MP__MDL_VECTORZUP = (1.000000E+00_16/2.000000E+00_16) + $ *((MP__MDL_CW*MP__MDL_EE)/(2.000000E+00_16*MP__MDL_SW)) + $ +(5.000000E+00_16/2.000000E+00_16)*(-(MP__MDL_EE*MP__MDL_SW) + $ /(6.000000E+00_16*MP__MDL_CW)) + + MP__MDL_VECTORZDOWN = (1.000000E+00_16/2.000000E+00_16)*( + $ -(MP__MDL_CW*MP__MDL_EE)/(2.000000E+00_16*MP__MDL_SW))+( + $ -1.000000E+00_16/2.000000E+00_16)*(-(MP__MDL_EE*MP__MDL_SW) + $ /(6.000000E+00_16*MP__MDL_CW)) + + MP__MDL_VECTORAUP = (2.000000E+00_16*MP__MDL_EE)/3.000000E + $ +00_16 + + MP__MDL_VECTORADOWN = -(MP__MDL_EE)/3.000000E+00_16 + + MP__MDL_VECTORWMDXU = (1.000000E+00_16/2.000000E+00_16) + $ *((MP__MDL_EE)/(MP__MDL_SW*MP__MDL_SQRT__2)) + + MP__MDL_AXIALWMDXU = (-1.000000E+00_16/2.000000E+00_16) + $ *((MP__MDL_EE)/(MP__MDL_SW*MP__MDL_SQRT__2)) + + MP__MDL_VECTORWPUXD = (1.000000E+00_16/2.000000E+00_16) + $ *((MP__MDL_EE)/(MP__MDL_SW*MP__MDL_SQRT__2)) + + MP__MDL_AXIALWPUXD = -(1.000000E+00_16/2.000000E+00_16) + $ *((MP__MDL_EE)/(MP__MDL_SW*MP__MDL_SQRT__2)) + + MP__MDL_I1X33 = MP__MDL_YB*MP__MDL_CONJG__CKM3X3 + + MP__MDL_I2X33 = MP__MDL_YT*MP__MDL_CONJG__CKM3X3 + + MP__MDL_I3X33 = MP__MDL_CKM3X3*MP__MDL_YT + + MP__MDL_I4X33 = MP__MDL_CKM3X3*MP__MDL_YB + + MP__MDL_VECTOR_TBGP = MP__MDL_I1X33-MP__MDL_I2X33 + + MP__MDL_AXIAL_TBGP = -MP__MDL_I2X33-MP__MDL_I1X33 + + MP__MDL_VECTOR_TBGM = MP__MDL_I3X33-MP__MDL_I4X33 + + MP__MDL_AXIAL_TBGM = -MP__MDL_I4X33-MP__MDL_I3X33 + + MP__MDL_GW__EXP__2 = MP__MDL_GW**2 + + MP__MDL_CW__EXP__2 = MP__MDL_CW**2 + + MP__MDL_EE__EXP__2 = MP__MDL_EE**2 + + MP__MDL_SW__EXP__2 = MP__MDL_SW**2 + + MP__MDL_YB__EXP__2 = MP__MDL_YB**2 + + MP__MDL_YT__EXP__2 = MP__MDL_YT**2 + + ENDIF +C +C Parameters that should be recomputed at an event by even basis. +C + MP__AS = MP__G**2/4/MP__PI + + MP__MDL_SQRT__AS = SQRT(CMPLX((MP__AS),KIND=16)) + + MP__MDL_G__EXP__4 = MP__G**4 + + MP__MDL_G__EXP__2 = MP__G**2 + + MP__MDL_G__EXP__3 = MP__G**3 + + MP__MDL_MU_R__EXP__2 = MP__MU_R**2 + +C +C Parameters that should be updated for the loops. +C +C +C Definition of the EW coupling used in the write out of aqed +C + MP__GAL(1) = 2 * SQRT(MP__PI/ABS(MP__AEWM1)) + MP__GAL(2) = 1D0 + diff --git a/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%..%..%Source%MODEL%printout.f b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%..%..%Source%MODEL%printout.f new file mode 100644 index 0000000000..5b578a9c25 --- /dev/null +++ b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%..%..%Source%MODEL%printout.f @@ -0,0 +1,40 @@ +ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc +c written by the UFO converter +ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + +c************************************************************************ +c** ** +c** MadGraph/MadEvent Interface to FeynRules ** +c** ** +c** C. Duhr (Louvain U.) - M. Herquet (NIKHEF) ** +c** ** +c************************************************************************ + + subroutine printout + use model_object + implicit none + + + include 'coupl.inc' ! needs VECSIZE_MEMMAX (defined in vector.inc) + include 'input.inc' + + include 'formats.inc' + + write(*,*) '*****************************************************' + write(*,*) '* MadGraph/MadEvent *' + write(*,*) '* -------------------------------- *' + write(*,*) '* http://madgraph.hep.uiuc.edu *' + write(*,*) '* http://madgraph.phys.ucl.ac.be *' + write(*,*) '* http://madgraph.roma2.infn.it *' + write(*,*) '* -------------------------------- *' + write(*,*) '* *' + write(*,*) '* PARAMETER AND COUPLING VALUES *' + write(*,*) '* *' + write(*,*) '*****************************************************' + write(*,*) + + include 'param_write.inc' + include 'coupl_write.inc' + + return + end diff --git a/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%..%..%Source%MODEL%rw_para.f b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%..%..%Source%MODEL%rw_para.f new file mode 100644 index 0000000000..b1e7a382e0 --- /dev/null +++ b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%..%..%Source%MODEL%rw_para.f @@ -0,0 +1,97 @@ +c************************************************************************ +c** ** +c** MadGraph/MadEvent Interface to FeynRules ** +c** ** +c** C. Duhr (Louvain U.) - M. Herquet (NIKHEF) ** +c** ** +c************************************************************************ + + subroutine setpara(param_name) + use model_object + implicit none + + character*(*) param_name + logical readlha + + include 'coupl.inc' + include 'input.inc' + include 'model_functions.inc' + include 'mp_coupl.inc' + include 'mp_input.inc' + + integer maxpara + parameter (maxpara=5000) + + integer npara + character*20 param(maxpara),value(maxpara) + + logical updateloop + common /to_updateloop/updateloop + data updateloop /.true./ + + call LHA_loadcard(param_name,npara,param,value) + ! also loop parameters should be initialised here + if (updateloop) then + include 'param_read.inc' + call coup() + else + updateloop=.true. + include 'param_read.inc' + call coup() + updateloop=.false. + endif + return + + end + + subroutine setParamLog(OnOff) + + logical OnOff + logical WriteParamLog + data WriteParamLog/.TRUE./ + common/IOcontrol/WriteParamLog + + WriteParamLog = OnOff + + end + + subroutine setpara2(param_name) + implicit none + + character(512) param_name + + integer k + logical found + + character(512) ParamCardPath + common/ParamCardPath/ParamCardPath + + if (param_name(1:1).ne.' ') then + ! Save the basename of the param_card for the ident_card. + ! If no absolute path was used then this ParamCardPath + ! remains empty + ParamCardPath = '.' + k = LEN(param_name) + found = .False. + do while (k.ge.1.and..not.found) + if (param_name(k:k).eq.'/') then + found=.True. + endif + k=k-1 + enddo + if (k.ge.1) then + ParamCardPath(1:k)=param_name(1:k) + endif + call setpara(param_name) + endif + if (param_name(1:1).eq.'*') then + ! Dummy call to printout so that it is available in the + ! dynamic library for MadLoop BLHA2 + ! In principle the --whole-archive option of ld could be + ! used but it is not always supported + call printout() + call setParamLog(.True.) + endif + return + + end diff --git a/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%..%..%Source%MODEL%testprog.f b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%..%..%Source%MODEL%testprog.f new file mode 100644 index 0000000000..32dc93e98c --- /dev/null +++ b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%..%..%Source%MODEL%testprog.f @@ -0,0 +1,72 @@ +c************************************************************************ +c** ** +c** MadGraph/MadEvent Interface to FeynRules ** +c** ** +c** C. Duhr (Louvain U.) - M. Herquet (NIKHEF) ** +c** ** +c************************************************************************ + + program testprog + + call setpara('param_card.dat') + + + + call printout + + end + +c$$$c +c$$$c program testing the running. need to modify the makefile accordingly +c$$$c +c$$$ program testprog +c$$$ implicit none +c$$$c define the function that run alphas +c$$$ DOUBLE PRECISION ALPHAS +c$$$ EXTERNAL ALPHAS +c$$$c get the value of gs +c$$$ include '../coupl.inc' +c$$$c for initialization of the running +c$$$ include "../alfas.inc" +c$$$c include parameter from the run_card (usefull for the running) +c$$$ INCLUDE '../maxparticles.inc' +c$$$c INCLUDE '../run.inc' +c$$$c local +c$$$ integer i +c$$$ double precision mu,as +c$$$ +c$$$c +c$$$c Scales +c$$$c +c$$$ real*8 scale,scalefact,alpsfact,mue_ref_fixed,mue_over_ref +c$$$ logical fixed_ren_scale,fixed_fac_scale1, fixed_fac_scale2,fixed_couplings,hmult +c$$$ logical fixed_extra_scale +c$$$ integer ickkw,nhmult,asrwgtflavor, dynamical_scale_choice,ievo_eva +c$$$ +c$$$ common/to_scale/scale,scalefact,alpsfact, mue_ref_fixed, mue_over_ref, +c$$$ $ fixed_ren_scale,fixed_fac_scale1, fixed_fac_scale2, +c$$$ $ fixed_couplings, fixed_extra_scale,ickkw,nhmult,hmult,asrwgtflavor, +c$$$ $ dynamical_scale_choice +c$$$ +c$$$ +c$$$ +c$$$c read the param_card +c$$$ call setpara('param_card.dat') +c$$$c define your running for as... +c$$$ fixed_extra_scale = .false. +c$$$ asmz = G**2/(16d0*atan(1d0)) +c$$$ nloop = 2 +c$$$ MUE_OVER_REF = 1d0 +c$$$ +c$$$c loop for the running +c$$$ do i=1,200 +c$$$ scale = 10*i +c$$$ G = SQRT(4d0*PI*ALPHAS(scale)) +c$$$ call UPDATE_AS_PARAM() +c$$$ call printout +c$$$ enddo +c$$$ +c$$$ +c$$$ end +c$$$ +c$$$ diff --git a/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%MadLoop5_resources%ML5_0_ColorDenomFactors.dat b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%MadLoop5_resources%ML5_0_ColorDenomFactors.dat new file mode 100644 index 0000000000..957b78b322 --- /dev/null +++ b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%MadLoop5_resources%ML5_0_ColorDenomFactors.dat @@ -0,0 +1,20 @@ +1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 +1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 +1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 +1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 +1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 +1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 +1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 +1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 +1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 +1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 +1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 +1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 +1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 +1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 +1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 +1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 +1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 +1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 +1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 +1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 diff --git a/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%MadLoop5_resources%ML5_0_ColorNumFactors.dat b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%MadLoop5_resources%ML5_0_ColorNumFactors.dat new file mode 100644 index 0000000000..cbfb2f5f9c --- /dev/null +++ b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%MadLoop5_resources%ML5_0_ColorNumFactors.dat @@ -0,0 +1,20 @@ +2 2 2 2 -2 -2 -2 -2 -2 -2 -2 -2 -2 -2 -2 -2 -2 -2 -2 -2 +2 2 2 2 -2 -2 -2 -2 -2 -2 -2 -2 -2 -2 -2 -2 -2 -2 -2 -2 +2 2 2 2 -2 -2 -2 -2 -2 -2 -2 -2 -2 -2 -2 -2 -2 -2 -2 -2 +2 2 2 2 -2 -2 -2 -2 -2 -2 -2 -2 -2 -2 -2 -2 -2 -2 -2 -2 +-2 -2 -2 -2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 +-2 -2 -2 -2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 +-2 -2 -2 -2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 +-2 -2 -2 -2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 +-2 -2 -2 -2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 +-2 -2 -2 -2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 +-2 -2 -2 -2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 +-2 -2 -2 -2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 +-2 -2 -2 -2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 +-2 -2 -2 -2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 +-2 -2 -2 -2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 +-2 -2 -2 -2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 +-2 -2 -2 -2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 +-2 -2 -2 -2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 +-2 -2 -2 -2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 +-2 -2 -2 -2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 diff --git a/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%MadLoop5_resources%ML5_0_HelConfigs.dat b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%MadLoop5_resources%ML5_0_HelConfigs.dat new file mode 100644 index 0000000000..c317acd87e --- /dev/null +++ b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%MadLoop5_resources%ML5_0_HelConfigs.dat @@ -0,0 +1,4 @@ +-1 -1 0 0 +-1 1 0 0 +1 -1 0 0 +1 1 0 0 diff --git a/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%MadLoop5_resources%ML5_0_LoopColorFlowCoefs.dat b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%MadLoop5_resources%ML5_0_LoopColorFlowCoefs.dat new file mode 100644 index 0000000000..fc290c63c8 --- /dev/null +++ b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%MadLoop5_resources%ML5_0_LoopColorFlowCoefs.dat @@ -0,0 +1,5 @@ +20 # Coefficient for flow number 1 with expr. 1 Tr(1,2) + 1 1 1 1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 + 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 + 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 +EOF \ No newline at end of file diff --git a/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%MadLoop5_resources%ML5_0_LoopColorFlowMatrix.dat b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%MadLoop5_resources%ML5_0_LoopColorFlowMatrix.dat new file mode 100644 index 0000000000..4b0f7dd06d --- /dev/null +++ b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/%MadLoop5_resources%ML5_0_LoopColorFlowMatrix.dat @@ -0,0 +1,3 @@ + 2 + 1 +EOF \ No newline at end of file diff --git a/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/CT_interface.f b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/CT_interface.f new file mode 100644 index 0000000000..600ffe4e92 --- /dev/null +++ b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/CT_interface.f @@ -0,0 +1,627 @@ +C =========================================== +C ===== Beginning of CutTools Interface ===== +C =========================================== + SUBROUTINE ML5_0_CTLOOP(NLOOPLINE,PL,M2L,RANK,RES,STABLE) +C +C Generated by MadGraph5_aMC@NLO v. %(version)s, %(date)s +C By the MadGraph5_aMC@NLO Development Team +C Visit launchpad.net/madgraph5 and amcatnlo.web.cern.ch +C +C Interface between MG5 and CutTools. +C +C Process: g g > h h QCD<=2 QED<=2 [ sqrvirt = QCD ] +C +C +C CONSTANTS +C + INTEGER NEXTERNAL + PARAMETER (NEXTERNAL=4) + LOGICAL CHECKPCONSERVATION + PARAMETER (CHECKPCONSERVATION=.TRUE.) + REAL*8 NORMALIZATION + PARAMETER (NORMALIZATION = 1.D0/(16.D0*3.14159265358979323846D0* + $ *2)) +C +C ARGUMENTS +C + INTEGER NLOOPLINE, RANK + REAL*8 PL(0:3,NLOOPLINE) + REAL*8 PCT(0:3,0:NLOOPLINE-1),ABSPCT(0:3) + REAL*8 REF_P + COMPLEX*16 M2L(NLOOPLINE) + COMPLEX*16 M2LCT(0:NLOOPLINE-1) + COMPLEX*16 RES(3) + LOGICAL STABLE +C +C LOCAL VARIABLES +C + COMPLEX*16 R1, ACC + INTEGER I, J, K + LOGICAL CTINIT, TIRINIT, GOLEMINIT, SAMURAIINIT, NINJAINIT + $ ,COLLIERINIT + COMMON/REDUCTIONCODEINIT/CTINIT,TIRINIT,GOLEMINIT,SAMURAIINIT + $ ,NINJAINIT,COLLIERINIT +C +C EXTERNAL FUNCTIONS +C + EXTERNAL ML5_0_LOOPNUM + EXTERNAL ML5_0_MPLOOPNUM +C +C GLOBAL VARIABLES +C + + INCLUDE 'coupl.inc' + INTEGER CTMODE + REAL*8 LSCALE + COMMON/ML5_0_CT/LSCALE,CTMODE + + INTEGER ID,SQSOINDEX,R + COMMON/ML5_0_LOOP/ID,SQSOINDEX,R + +C ---------- +C BEGIN CODE +C ---------- + +C INITIALIZE CUTTOOLS IF NEEDED + IF (CTINIT) THEN + CTINIT=.FALSE. + CALL ML5_0_INITCT() + CALL CITE('Ossola:2007ax','one-loop reduction with CutTools') + ENDIF + +C YOU CAN FIND THE DETAILS ABOUT THE DIFFERENT CTMODE AT THE +C BEGINNING OF THE FILE CTS_CUTS.F90 IN THE CUTTOOLS DISTRIBUTION + +C CONVERT THE MASSES TO BE COMPLEX + DO I=1,NLOOPLINE + M2LCT(I-1)=M2L(I) + ENDDO + +C CONVERT THE MOMENTA FLOWING IN THE LOOP LINES TO CT CONVENTIONS + DO I=0,3 + ABSPCT(I)=0.D0 + DO J=0,(NLOOPLINE-1) + PCT(I,J)=0.D0 + ENDDO + ENDDO + DO I=0,3 + DO J=1,NLOOPLINE + PCT(I,0)=PCT(I,0)+PL(I,J) + ABSPCT(I)=ABSPCT(I)+ABS(PL(I,J)) + ENDDO + ENDDO + REF_P = MAX(ABSPCT(0), ABSPCT(1),ABSPCT(2),ABSPCT(3)) + DO I=0,3 + ABSPCT(I) = MAX(REF_P*1E-6, ABSPCT(I)) + ENDDO + IF (CHECKPCONSERVATION.AND.REF_P.GT.1D-8) THEN + IF ((PCT(0,0)/ABSPCT(0)).GT.1.D-6) THEN + WRITE(*,*) 'energy is not conserved (flag:CT95)',PCT(0,0) + STOP 'energy is not conserved (flag:CT95)' + ELSEIF ((PCT(1,0)/ABSPCT(1)).GT.1.D-6) THEN + WRITE(*,*) 'px is not conserved (flag:CT95)',PCT(1,0) + STOP 'px is not conserved (flag:CT95)' + ELSEIF ((PCT(2,0)/ABSPCT(2)).GT.1.D-6) THEN + WRITE(*,*) 'py is not conserved (flag:CT95)',PCT(2,0) + STOP 'py is not conserved (flag:CT95)' + ELSEIF ((PCT(3,0)/ABSPCT(3)).GT.1.D-6) THEN + WRITE(*,*) 'pz is not conserved (flag:CT95)',PCT(3,0) + STOP 'pz is not conserved (flag:CT95)' + ENDIF + ENDIF + DO I=0,3 + DO J=1,(NLOOPLINE-1) + DO K=1,J + PCT(I,J)=PCT(I,J)+PL(I,K) + ENDDO + ENDDO + ENDDO + + CALL CTSXCUT(CTMODE,LSCALE,MU_R,NLOOPLINE,ML5_0_LOOPNUM + $ ,ML5_0_MPLOOPNUM,RANK,PCT,M2LCT,RES,ACC,R1,STABLE) + RES(1)=NORMALIZATION*RES(1) + RES(2)=NORMALIZATION*RES(2) + RES(3)=NORMALIZATION*RES(3) +C WRITE(*,*) 'CutTools: Loop ID',ID,' =',RES(1),RES(2),RES(3) + END + + SUBROUTINE ML5_0_INITCT() +C +C INITIALISATION OF CUTTOOLS +C +C LOCAL VARIABLES +C + REAL*8 THRS + LOGICAL EXT_NUM_FOR_R1 +C +C GLOBAL VARIABLES +C + INCLUDE 'MadLoopParams.inc' +C ---------- +C BEGIN CODE +C ---------- + +C DEFAULT PARAMETERS FOR CUTTOOLS +C ------------------------------- +C THRS1 IS THE PRECISION LIMIT BELOW WHICH THE MP ROUTINES +C ACTIVATES + THRS=CTSTABTHRES +C LOOPLIB SET WHAT LIBRARY CT USES +C 1 -> LOOPTOOLS +C 2 -> AVH +C 3 -> QCDLOOP + LOOPLIB=CTLOOPLIBRARY +C MADLOOP'S NUMERATOR IN THE OPEN LOOP IS MUCH FASTER THAN THE +C RECONSTRUCTED ONE IN CT. SO WE BETTER USE MADLOOP ONE IN THIS +C CASE. + EXT_NUM_FOR_R1=.TRUE. +C ------------------------------- + +C The initialization below is for CT v1.8.+ + CALL CTSINIT(THRS,LOOPLIB,EXT_NUM_FOR_R1) +C The initialization below is for the older stable CT v1.7, still +C used for now in the beta release. +C CALL CTSINIT(THRS,LOOPLIB) + + END + + SUBROUTINE ML5_0_BUILD_KINEMATIC_MATRIX(NLOOPLINE,P_LOOP,M2L + $ ,S_MAT) +C +C Helper function that compute the loop kinematic matrix with +C proper thresholds +C NLOOPLINE : Number of loop lines +C P_LOOP : List of external momenta running in the loop, i.e. +C q_i in the denominator (l_i+q_i)**2-m_i**2 +C M2L : List of complex-valued masses running in the loop. +C S_MAT(N,N): Kinematic matrix output. +C +C ARGUMENTS +C + INTEGER NLOOPLINE + REAL*8 P_LOOP(NLOOPLINE,0:3) + COMPLEX*16 M2L(NLOOPLINE) + COMPLEX*16 S_MAT(NLOOPLINE,NLOOPLINE) +C +C GLOBAL VARIABLES +C + INCLUDE 'MadLoopParams.inc' +C +C LOCAL VARIABLES +C + INTEGER I,J,K + COMPLEX*16 DIFFSQ + REAL*8 REF_NORMALIZATION + +C ---------- +C BEGIN CODE +C ---------- + + DO I=1,NLOOPLINE + DO J=1,NLOOPLINE + + IF(I.EQ.J)THEN + S_MAT(I,J)=-(M2L(I)+M2L(J)) + ELSE + DIFFSQ = (DCMPLX(P_LOOP(I,0),0.0D0)-DCMPLX(P_LOOP(J,0) + $ ,0.0D0))**2 + DO K=1,3 + DIFFSQ = DIFFSQ - (DCMPLX(P_LOOP(I,K),0.0D0) + $ -DCMPLX(P_LOOP(J,K),0.0D0))**2 + ENDDO +C Default value of the kinematic matrix + S_MAT(I,J)=DIFFSQ-M2L(I)-M2L(J) +C And we now test various thresholds. Normaly, at most one +C applies. + IF(ABS(M2L(I)).NE.0.0D0)THEN + IF(ABS((DIFFSQ-M2L(I))/M2L(I)).LT.OSTHRES)THEN + S_MAT(I,J)=-M2L(J) + ENDIF + ENDIF + IF(ABS(M2L(J)).NE.0.0D0)THEN + IF(ABS((DIFFSQ-M2L(J))/M2L(J)).LT.OSTHRES)THEN + S_MAT(I,J)=-M2L(I) + ENDIF + ENDIF +C Choose what seems the most appropriate way to compare +C massless onshellness. + REF_NORMALIZATION=0.0D0 +C Here, we chose to base the threshold only on the energy +C component + DO K=0,0 + REF_NORMALIZATION = REF_NORMALIZATION + ABS(P_LOOP(I,K)) + $ + ABS(P_LOOP(J,K)) + ENDDO + REF_NORMALIZATION = (REF_NORMALIZATION/2.0D0)**2 + IF(REF_NORMALIZATION.NE.0.0D0)THEN + IF(ABS(DIFFSQ/REF_NORMALIZATION).LT.OSTHRES)THEN + S_MAT(I,J)=-(M2L(I)+M2L(J)) + ENDIF + ENDIF + ENDIF + + ENDDO + ENDDO + + END + + SUBROUTINE ML5_0_MP_BUILD_KINEMATIC_MATRIX(NLOOPLINE,P_LOOP,M2L + $ ,S_MAT) +C +C Helper function that compute the loop kinematic matrix with +C proper thresholds +C NLOOPLINE : Number of loop lines +C P_LOOP : List of external momenta running in the loop, i.e. +C q_i in the denominator (l_i+q_i)**2-m_i**2 +C M2L : List of complex-valued masses running in the loop. +C S_MAT(N,N): Kinematic matrix output. +C +C ARGUMENTS +C + INTEGER NLOOPLINE + REAL*16 P_LOOP(NLOOPLINE,0:3) + COMPLEX*32 M2L(NLOOPLINE) + COMPLEX*32 S_MAT(NLOOPLINE,NLOOPLINE) +C +C GLOBAL VARIABLES +C + INCLUDE 'MadLoopParams.inc' +C +C LOCAL VARIABLES +C + INTEGER I,J,K + COMPLEX*32 DIFFSQ + REAL*16 REF_NORMALIZATION + +C ---------- +C BEGIN CODE +C ---------- + + DO I=1,NLOOPLINE + DO J=1,NLOOPLINE + + IF(I.EQ.J)THEN + S_MAT(I,J)=-(M2L(I)+M2L(J)) + ELSE + DIFFSQ = (CMPLX(P_LOOP(I,0),0.0E0_16,KIND=16) + $ -CMPLX(P_LOOP(J,0),0.0E0_16,KIND=16))**2 + DO K=1,3 + DIFFSQ = DIFFSQ - (CMPLX(P_LOOP(I,K),0.0E0_16,KIND=16) + $ -CMPLX(P_LOOP(J,K),0.0E0_16,KIND=16))**2 + ENDDO +C Default value of the kinematic matrix + S_MAT(I,J)=DIFFSQ-M2L(I)-M2L(J) +C And we now test various thresholds. Normaly, at most one +C applies. + IF(ABS(M2L(I)).NE.0.0E0_16)THEN + IF(ABS((DIFFSQ-M2L(I))/M2L(I)).LT.OSTHRES)THEN + S_MAT(I,J)=-M2L(J) + ENDIF + ENDIF + IF(ABS(M2L(J)).NE.0.0E0_16)THEN + IF(ABS((DIFFSQ-M2L(J))/M2L(J)).LT.OSTHRES)THEN + S_MAT(I,J)=-M2L(I) + ENDIF + ENDIF +C Choose what seems the most appropriate way to compare +C massless onshellness. + REF_NORMALIZATION=0.0E0_16 +C Here, we chose to base the threshold only on the energy +C component + DO K=0,0 + REF_NORMALIZATION = REF_NORMALIZATION + ABS(P_LOOP(I,K)) + $ + ABS(P_LOOP(J,K)) + ENDDO + REF_NORMALIZATION = (REF_NORMALIZATION/2.0E0_16)**2 + IF(REF_NORMALIZATION.NE.0.0E0_16)THEN + IF(ABS(DIFFSQ/REF_NORMALIZATION).LT.OSTHRES)THEN + S_MAT(I,J)=-(M2L(I)+M2L(J)) + ENDIF + ENDIF + ENDIF + + ENDDO + ENDDO + + END + + + + SUBROUTINE ML5_0_LOOP_4(W1, W2, W3, W4, M1, M2, M3, M4, RANK, + $ SQUAREDSOINDEX, LOOPNUM) + USE ALOHA_OBJECT + INTEGER NEXTERNAL + PARAMETER (NEXTERNAL=4) + INTEGER NLOOPLINE + PARAMETER (NLOOPLINE=4) + INTEGER NLOOPAMPS + PARAMETER (NLOOPAMPS=20) + INTEGER NCTAMPS + PARAMETER (NCTAMPS=4) + INTEGER NWAVEFUNCS + PARAMETER (NWAVEFUNCS=5) + INTEGER NLOOPGROUPS + PARAMETER (NLOOPGROUPS=16) + INTEGER NCOMB + PARAMETER (NCOMB=4) +C These are constants related to the split orders + INTEGER NSQUAREDSO + PARAMETER (NSQUAREDSO=0) +C +C ARGUMENTS +C + INTEGER W1, W2, W3, W4 + COMPLEX*16 M1, M2, M3, M4 + + INTEGER RANK, LSYMFACT +C In this case of a loop-induced process, the SQUAREDSOINDEX +C argument is dummy + INTEGER LOOPNUM, SQUAREDSOINDEX +C +C LOCAL VARIABLES +C + REAL*8 PL(0:3,NLOOPLINE) + REAL*16 MP_PL(0:3,NLOOPLINE) + COMPLEX*16 M2L(NLOOPLINE) + INTEGER PAIRING(NLOOPLINE),WE(4) + INTEGER I, J, K, TEMP,I_LIB + LOGICAL COMPLEX_MASS,DOING_QP + LOGICAL AMP_CONTRIBUTES +C +C GLOBAL VARIABLES +C + INCLUDE 'MadLoopParams.inc' + INTEGER ID,R + COMMON/ML5_0_LOOP/ID,R + + LOGICAL CHECKPHASE, HELDOUBLECHECKED + COMMON/ML5_0_INIT/CHECKPHASE, HELDOUBLECHECKED + + INTEGER HELOFFSET + INTEGER GOODHEL(NCOMB) + LOGICAL GOODAMP(NSQUAREDSO,NLOOPGROUPS) + COMMON/ML5_0_FILTERS/GOODAMP,GOODHEL,HELOFFSET + + COMPLEX*16 LOOPRES(3,NSQUAREDSO,NLOOPGROUPS) + LOGICAL S(NSQUAREDSO,NLOOPGROUPS) + COMMON/ML5_0_LOOPRES/LOOPRES,S + + COMPLEX*16 AMPL(3,NLOOPAMPS) + COMMON/ML5_0_AMPL/AMPL + + TYPE(ALOHA) W(NWAVEFUNCS) + COMMON/ML5_0_W/W + TYPE(MP_ALOHA) MP_W(NWAVEFUNCS) + COMMON/ML5_0_MP_W/MP_W + + REAL*8 LSCALE + INTEGER CTMODE + COMMON/ML5_0_CT/LSCALE,CTMODE + INTEGER LIBINDEX + COMMON/ML5_0_I_LIB/LIBINDEX + +C ---------- +C BEGIN CODE +C ---------- + +C Determine it uses qp or not + DOING_QP = (CTMODE.GE.4) + +C For loop-induced processes, we must reduce this loop amplitude +C if it contributes to any squared split order contribution. + AMP_CONTRIBUTES = .FALSE. + DO I=1,NSQUAREDSO + IF (GOODAMP(I,LOOPNUM)) AMP_CONTRIBUTES=.TRUE. + ENDDO + IF (CHECKPHASE.OR.(.NOT.HELDOUBLECHECKED).OR.AMP_CONTRIBUTES) + $ THEN + WE(1)=W1 + WE(2)=W2 + WE(3)=W3 + WE(4)=W4 + M2L(1)=M4**2 + M2L(2)=M1**2 + M2L(3)=M2**2 + M2L(4)=M3**2 + DO I=1,NLOOPLINE + PAIRING(I)=1 + ENDDO + + R=RANK + ID=LOOPNUM + DO I=0,3 + TEMP=1 + DO J=1,NLOOPLINE + PL(I,J)=0.D0 + IF (DOING_QP) THEN + MP_PL(I,J)=0.0E+0_16 + ENDIF + DO K=TEMP,(TEMP+PAIRING(J)-1) + PL(I,J)=PL(I,J)-W(WE(K))%P(I) + IF (DOING_QP) THEN + MP_PL(I,J)=MP_PL(I,J)-MP_W(WE(K))%P(I) + ENDIF + ENDDO + TEMP=TEMP+PAIRING(J) + ENDDO + ENDDO +C Determine whether the integral is with complex masses or not +C since some reduction libraries, e.g.PJFry++ and IREGI, are +C still +C not able to deal with complex masses + COMPLEX_MASS=.FALSE. + DO I=1,NLOOPLINE + IF(DIMAG(M2L(I)).EQ.0D0)CYCLE + IF(ABS(DIMAG(M2L(I)))/MAX(ABS(M2L(I)),1D-2).GT.1D-15)THEN + COMPLEX_MASS=.TRUE. + EXIT + ENDIF + ENDDO +C Choose the correct loop library + CALL ML5_0_CHOOSE_LOOPLIB(LIBINDEX,NLOOPLINE,RANK,COMPLEX_MASS + $ ,ID,DOING_QP,I_LIB) + IF(MLREDUCTIONLIB(I_LIB).EQ.1)THEN +C CutTools is used + CALL ML5_0_CTLOOP(NLOOPLINE,PL,M2L,RANK,AMPL(1,NCTAMPS + $ +LOOPNUM),S(1,LOOPNUM)) + ELSE +C Tensor Integral Reduction is used + CALL ML5_0_TIRLOOP(1,LOOPNUM,I_LIB,NLOOPLINE,PL,M2L,RANK + $ ,AMPL(1,NCTAMPS+LOOPNUM),S(1,LOOPNUM)) + ENDIF + ELSE + AMPL(1,NCTAMPS+LOOPNUM)=(0.0D0,0.0D0) + AMPL(2,NCTAMPS+LOOPNUM)=(0.0D0,0.0D0) + AMPL(3,NCTAMPS+LOOPNUM)=(0.0D0,0.0D0) + S(1,LOOPNUM)=.TRUE. + ENDIF + END + + SUBROUTINE ML5_0_LOOP_3(W1, W2, W3, M1, M2, M3, RANK, + $ SQUAREDSOINDEX, LOOPNUM) + USE ALOHA_OBJECT + INTEGER NEXTERNAL + PARAMETER (NEXTERNAL=4) + INTEGER NLOOPLINE + PARAMETER (NLOOPLINE=3) + INTEGER NLOOPAMPS + PARAMETER (NLOOPAMPS=20) + INTEGER NCTAMPS + PARAMETER (NCTAMPS=4) + INTEGER NWAVEFUNCS + PARAMETER (NWAVEFUNCS=5) + INTEGER NLOOPGROUPS + PARAMETER (NLOOPGROUPS=16) + INTEGER NCOMB + PARAMETER (NCOMB=4) +C These are constants related to the split orders + INTEGER NSQUAREDSO + PARAMETER (NSQUAREDSO=0) +C +C ARGUMENTS +C + INTEGER W1, W2, W3 + COMPLEX*16 M1, M2, M3 + + INTEGER RANK, LSYMFACT +C In this case of a loop-induced process, the SQUAREDSOINDEX +C argument is dummy + INTEGER LOOPNUM, SQUAREDSOINDEX +C +C LOCAL VARIABLES +C + REAL*8 PL(0:3,NLOOPLINE) + REAL*16 MP_PL(0:3,NLOOPLINE) + COMPLEX*16 M2L(NLOOPLINE) + INTEGER PAIRING(NLOOPLINE),WE(3) + INTEGER I, J, K, TEMP,I_LIB + LOGICAL COMPLEX_MASS,DOING_QP + LOGICAL AMP_CONTRIBUTES +C +C GLOBAL VARIABLES +C + INCLUDE 'MadLoopParams.inc' + INTEGER ID,R + COMMON/ML5_0_LOOP/ID,R + + LOGICAL CHECKPHASE, HELDOUBLECHECKED + COMMON/ML5_0_INIT/CHECKPHASE, HELDOUBLECHECKED + + INTEGER HELOFFSET + INTEGER GOODHEL(NCOMB) + LOGICAL GOODAMP(NSQUAREDSO,NLOOPGROUPS) + COMMON/ML5_0_FILTERS/GOODAMP,GOODHEL,HELOFFSET + + COMPLEX*16 LOOPRES(3,NSQUAREDSO,NLOOPGROUPS) + LOGICAL S(NSQUAREDSO,NLOOPGROUPS) + COMMON/ML5_0_LOOPRES/LOOPRES,S + + COMPLEX*16 AMPL(3,NLOOPAMPS) + COMMON/ML5_0_AMPL/AMPL + + TYPE(ALOHA) W(NWAVEFUNCS) + COMMON/ML5_0_W/W + TYPE(MP_ALOHA) MP_W(NWAVEFUNCS) + COMMON/ML5_0_MP_W/MP_W + + REAL*8 LSCALE + INTEGER CTMODE + COMMON/ML5_0_CT/LSCALE,CTMODE + INTEGER LIBINDEX + COMMON/ML5_0_I_LIB/LIBINDEX + +C ---------- +C BEGIN CODE +C ---------- + +C Determine it uses qp or not + DOING_QP = (CTMODE.GE.4) + +C For loop-induced processes, we must reduce this loop amplitude +C if it contributes to any squared split order contribution. + AMP_CONTRIBUTES = .FALSE. + DO I=1,NSQUAREDSO + IF (GOODAMP(I,LOOPNUM)) AMP_CONTRIBUTES=.TRUE. + ENDDO + IF (CHECKPHASE.OR.(.NOT.HELDOUBLECHECKED).OR.AMP_CONTRIBUTES) + $ THEN + WE(1)=W1 + WE(2)=W2 + WE(3)=W3 + M2L(1)=M3**2 + M2L(2)=M1**2 + M2L(3)=M2**2 + DO I=1,NLOOPLINE + PAIRING(I)=1 + ENDDO + + R=RANK + ID=LOOPNUM + DO I=0,3 + TEMP=1 + DO J=1,NLOOPLINE + PL(I,J)=0.D0 + IF (DOING_QP) THEN + MP_PL(I,J)=0.0E+0_16 + ENDIF + DO K=TEMP,(TEMP+PAIRING(J)-1) + PL(I,J)=PL(I,J)-W(WE(K))%P(I) + IF (DOING_QP) THEN + MP_PL(I,J)=MP_PL(I,J)-MP_W(WE(K))%P(I) + ENDIF + ENDDO + TEMP=TEMP+PAIRING(J) + ENDDO + ENDDO +C Determine whether the integral is with complex masses or not +C since some reduction libraries, e.g.PJFry++ and IREGI, are +C still +C not able to deal with complex masses + COMPLEX_MASS=.FALSE. + DO I=1,NLOOPLINE + IF(DIMAG(M2L(I)).EQ.0D0)CYCLE + IF(ABS(DIMAG(M2L(I)))/MAX(ABS(M2L(I)),1D-2).GT.1D-15)THEN + COMPLEX_MASS=.TRUE. + EXIT + ENDIF + ENDDO +C Choose the correct loop library + CALL ML5_0_CHOOSE_LOOPLIB(LIBINDEX,NLOOPLINE,RANK,COMPLEX_MASS + $ ,ID,DOING_QP,I_LIB) + IF(MLREDUCTIONLIB(I_LIB).EQ.1)THEN +C CutTools is used + CALL ML5_0_CTLOOP(NLOOPLINE,PL,M2L,RANK,AMPL(1,NCTAMPS + $ +LOOPNUM),S(1,LOOPNUM)) + ELSE +C Tensor Integral Reduction is used + CALL ML5_0_TIRLOOP(1,LOOPNUM,I_LIB,NLOOPLINE,PL,M2L,RANK + $ ,AMPL(1,NCTAMPS+LOOPNUM),S(1,LOOPNUM)) + ENDIF + ELSE + AMPL(1,NCTAMPS+LOOPNUM)=(0.0D0,0.0D0) + AMPL(2,NCTAMPS+LOOPNUM)=(0.0D0,0.0D0) + AMPL(3,NCTAMPS+LOOPNUM)=(0.0D0,0.0D0) + S(1,LOOPNUM)=.TRUE. + ENDIF + END + diff --git a/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/TIR_interface.f b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/TIR_interface.f new file mode 100644 index 0000000000..4d4b8b0f5b --- /dev/null +++ b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/TIR_interface.f @@ -0,0 +1,538 @@ + SUBROUTINE ML5_0_TIRLOOP(I_SQSO,I_LOOPGROUP,I_LIB,NLOOPLINE,PL + $ ,M2L,RANK,RES,STABLE) +C +C Generated by MadGraph5_aMC@NLO v. %(version)s, %(date)s +C By the MadGraph5_aMC@NLO Development Team +C Visit launchpad.net/madgraph5 and amcatnlo.web.cern.ch +C +C Interface between MG5 and TIR. +C +C Process: g g > h h QCD<=2 QED<=2 [ sqrvirt = QCD ] +C +C +C CONSTANTS +C + INTEGER NLOOPGROUPS + PARAMETER (NLOOPGROUPS=16) +C These are constants related to the split orders + INTEGER NSQUAREDSO + PARAMETER (NSQUAREDSO=0) + INCLUDE 'loop_max_coefs.inc' + INTEGER NEXTERNAL + PARAMETER (NEXTERNAL=4) + LOGICAL CHECKPCONSERVATION + PARAMETER (CHECKPCONSERVATION=.TRUE.) + REAL*8 NORMALIZATION + PARAMETER (NORMALIZATION = 1.D0/(16.D0*3.14159265358979323846D0* + $ *2)) + INTEGER TIR_CACHE_SIZE + INCLUDE 'tir_cache_size.inc' +C +C ARGUMENTS +C + INTEGER I_SQSO,I_LOOPGROUP,I_LIB + INTEGER NLOOPLINE, RANK + REAL*8 PL(0:3,NLOOPLINE) + REAL*8 PCT(0:3,0:NLOOPLINE-1),ABSPCT(0:3) + REAL*8 REF_P + REAL*8 PDEN(0:3,NLOOPLINE-1) + COMPLEX*16 M2L(NLOOPLINE) + COMPLEX*16 M2LCT(0:NLOOPLINE-1) + COMPLEX*16 RES(3) + LOGICAL STABLE +C +C LOCAL VARIABLES +C + INTEGER I, J, K + INTEGER NLOOPCOEFS + LOGICAL CTINIT, TIRINIT, GOLEMINIT, SAMURAIINIT, NINJAINIT + $ ,COLLIERINIT + COMMON/REDUCTIONCODEINIT/CTINIT,TIRINIT,GOLEMINIT,SAMURAIINIT + $ ,NINJAINIT,COLLIERINIT + +C This variable will be used to detect changes in the TIR library +C used so as to force the reset of the TIR filter. + INTEGER LAST_LIB_USED + DATA LAST_LIB_USED/-1/ + + COMPLEX*16 TIRCOEFS(0:LOOPMAXCOEFS-1,3) + $ ,TIRCOEFSERRORS(0:LOOPMAXCOEFS-1,3) + COMPLEX*16 PJCOEFS(0:LOOPMAXCOEFS-1,3) + INTEGER TIR_CACHE_INDEX + COMPLEX*16 TIRCOEFS_CACHING(3,0:LOOPMAXCOEFS-1,NLOOPGROUPS + $ ,TIR_CACHE_SIZE) + SAVE TIRCOEFS_CACHING +C +C EXTERNAL FUNCTIONS +C + INTEGER ML5_0_TIRCACHE_INDEX +C +C GLOBAL VARIABLES +C + INCLUDE 'MadLoopParams.inc' + + INCLUDE 'coupl.inc' + INTEGER CTMODE + REAL*8 LSCALE + COMMON/ML5_0_CT/LSCALE,CTMODE + + INTEGER ID,R + COMMON/ML5_0_LOOP/ID,R + +C The argument ILIB is the TIR library to be used for that +C specific library. + INTEGER LIBINDEX + COMMON/ML5_0_I_LIB/LIBINDEX + + COMPLEX*16 LOOPCOEFS(0:LOOPMAXCOEFS-1,NLOOPGROUPS) + COMMON/ML5_0_LCOEFS/LOOPCOEFS +C The index 0 of the second dimensions is filled with .false. as +C it makes the implementation simpler this way when the user sets +C TIR_CACHE_SIZE to be 0. + LOGICAL TIR_DONE(NLOOPGROUPS,0:TIR_CACHE_SIZE) + COMMON/ML5_0_TIRCACHING/TIR_DONE +C ---------- +C BEGIN CODE +C ---------- + +C Initialize for the very first time ML is called LAST_ILIB with +C the first ILIB used. + IF(LAST_LIB_USED.EQ.-1) THEN + LAST_LIB_USED = MLREDUCTIONLIB(LIBINDEX) + ELSE +C We changed the TIR library so we must refresh the cache. + IF(MLREDUCTIONLIB(LIBINDEX).NE.LAST_LIB_USED) THEN + LAST_LIB_USED = MLREDUCTIONLIB(LIBINDEX) + CALL ML5_0_CLEAR_TIR_CACHE() + ENDIF + ENDIF + + IF (MLREDUCTIONLIB(I_LIB).EQ.4) THEN +C Golem95 not available + WRITE(*,*) 'ERROR:: Golem95 is not interfaced.' + STOP + ENDIF + +C INITIALIZE TIR IF NEEDED + IF (TIRINIT) THEN + TIRINIT=.FALSE. + CALL ML5_0_INITTIR() + ENDIF + +C CONVERT THE MASSES TO BE COMPLEX + DO I=1,NLOOPLINE + M2LCT(I-1)=M2L(I) + ENDDO + +C CONVERT THE MOMENTA FLOWING IN THE LOOP LINES TO CT CONVENTIONS + DO I=0,3 + ABSPCT(I) = 0.D0 + DO J=0,(NLOOPLINE-1) + PCT(I,J)=0.D0 + ENDDO + ENDDO + DO I=0,3 + DO J=1,NLOOPLINE + PCT(I,0)=PCT(I,0)+PL(I,J) + ABSPCT(I)=ABSPCT(I)+ABS(PL(I,J)) + ENDDO + ENDDO + REF_P = MAX(ABSPCT(0), ABSPCT(1),ABSPCT(2),ABSPCT(3)) + DO I=0,3 + ABSPCT(I) = MAX(REF_P*1E-6, ABSPCT(I)) + ENDDO + + IF (CHECKPCONSERVATION.AND.REF_P.GT.1D-8) THEN + IF ((PCT(0,0)/ABSPCT(0)).GT.1.D-6) THEN + WRITE(*,*) 'energy is not conserved (flag: TIR)',PCT(0,0) + STOP 'energy is not conserved (flag: TIR)' + ELSEIF ((PCT(1,0)/ABSPCT(1)).GT.1.D-6) THEN + WRITE(*,*) 'px is not conserved (flag: TIR)',PCT(1,0) + STOP 'px is not conserved (flag: TIR)' + ELSEIF ((PCT(2,0)/ABSPCT(2)).GT.1.D-6) THEN + WRITE(*,*) 'py is not conserved (flag: TIR)',PCT(2,0) + STOP 'py is not conserved (flag: TIR)' + ELSEIF ((PCT(3,0)/ABSPCT(3)).GT.1.D-6) THEN + WRITE(*,*) 'pz is not conserved (flag: TIR)',PCT(3,0) + STOP 'pz is not conserved (flag: TIR)' + ENDIF + ENDIF + DO I=0,3 + DO J=1,(NLOOPLINE-1) + DO K=1,J + PCT(I,J)=PCT(I,J)+PL(I,K) + ENDDO + ENDDO + ENDDO + + DO I=0,3 + DO J=1,(NLOOPLINE-1) + PDEN(I,J)=PCT(I,J) + ENDDO + ENDDO +C NUMBER OF INDEPEDENT LOOPCOEFS FOR RANK=RANK + NLOOPCOEFS=0 + DO I=0,RANK + NLOOPCOEFS=NLOOPCOEFS+(3+I)*(2+I)*(1+I)/6 + ENDDO + IF (TIR_CACHE_SIZE.EQ.0) THEN + TIR_CACHE_INDEX = 0 + ELSE + TIR_CACHE_INDEX = ML5_0_TIRCACHE_INDEX(CTMODE) +C This way whenever the CTMode exceeds the cache size it rolls +C back to the beginning and MadLoop will have taken care of +C having re-initialized TIR_DONE between labels 200 and 205 in +C loop_matrix.f + TIR_CACHE_INDEX = MOD(TIR_CACHE_INDEX-1,TIR_CACHE_SIZE)+1 + ENDIF + + IF(.NOT.TIR_DONE(I_LOOPGROUP,TIR_CACHE_INDEX))THEN + SELECT CASE(MLREDUCTIONLIB(I_LIB)) + CASE(2) +C PJFry++ + WRITE(*,*) 'ERROR:: PJFRY++ is not interfaced.' + STOP + CASE(3) +C IREGI + WRITE(*,*) 'ERROR:: IREGI is not interfaced.' + STOP + CASE(7) +C COLLIER + WRITE(*,*) 'ERROR:: COLLIER is not interfaced.' + STOP + END SELECT +C The zero index is dummy and means no caching at all since +C TIR_CACHE_SIZE=0. + IF(TIR_CACHE_INDEX.NE.0) THEN + DO I=1,3 + DO J=0,NLOOPCOEFS-1 + TIRCOEFS_CACHING(I,J,I_LOOPGROUP,TIR_CACHE_INDEX) + $ =TIRCOEFS(J,I) + ENDDO + ENDDO + TIR_DONE(I_LOOPGROUP,TIR_CACHE_INDEX)=.TRUE. + ENDIF + ELSE + DO I=1,3 + DO J=0,NLOOPCOEFS-1 + TIRCOEFS(J,I)=TIRCOEFS_CACHING(I,J,I_LOOPGROUP + $ ,TIR_CACHE_INDEX) + ENDDO + ENDDO + ENDIF + DO I=1,3 + RES(I)=(0.0D0,0.0D0) + DO J=0,NLOOPCOEFS-1 + RES(I)=RES(I)+LOOPCOEFS(J,I_LOOPGROUP)*TIRCOEFS(J,I) + ENDDO + ENDDO + RES(1)=NORMALIZATION*RES(1) + RES(2)=NORMALIZATION*RES(2) + RES(3)=NORMALIZATION*RES(3) +C IF(MLReductionLib(I_LIB).EQ.2) THEN +C WRITE(*,*) 'PJFry: Loop ID',ID,' =',RES(1),RES(2),RES(3) +C ELSEIF(MLReductionLib(I_LIB).EQ.3) THEN +C WRITE(*,*) 'Iregi: Loop ID',ID,' =',RES(1),RES(2),RES(3) +C ELSEIF(MLReductionLib(I_LIB).EQ.7) THEN +C WRITE(*,*) 'COLLIER: Loop ID',ID,' =',RES(1),RES(2),RES(3) +C ENDIF + END + + SUBROUTINE ML5_0_SWITCH_ORDER(CTMODE,NLOOPLINE,PL,PDEN,M2L) + IMPLICIT NONE + + INTEGER CTMODE,NLOOPLINE + + REAL*8 PL(0:3,NLOOPLINE) + REAL*8 PDEN(0:3,NLOOPLINE-1) + COMPLEX*16 M2L(NLOOPLINE) + REAL*8 NEW_PL(0:3,NLOOPLINE) + REAL*8 NEW_PDEN(0:3,NLOOPLINE-1) + COMPLEX*16 NEW_M2L(NLOOPLINE) + + INTEGER I,J,K + + IF (CTMODE.NE.2.AND.CTMODE.NE.5) THEN + RETURN + ENDIF + + IF (NLOOPLINE.LE.2) THEN + RETURN + ENDIF + + DO I=1,NLOOPLINE-1 + DO J=0,3 + NEW_PDEN(J,NLOOPLINE-I) = PDEN(J,I) + ENDDO + ENDDO + DO I=1,NLOOPLINE-1 + DO J=0,3 + PDEN(J,I) = NEW_PDEN(J,I) + ENDDO + ENDDO + + DO I=2,NLOOPLINE + NEW_M2L(I)=M2L(NLOOPLINE-I+2) + ENDDO + DO I=2,NLOOPLINE + M2L(I)=NEW_M2L(I) + ENDDO + + + DO I=1,NLOOPLINE + DO J=0,3 + NEW_PL(J,I) = -PL(J,NLOOPLINE+1-I) + ENDDO + ENDDO + DO I=1,NLOOPLINE + DO J=0,3 + PL(J,I) = NEW_PL(J,I) + ENDDO + ENDDO + + END + + SUBROUTINE ML5_0_MP_SWITCH_ORDER(CTMODE,NLOOPLINE,PL,PDEN,M2L) + IMPLICIT NONE + + INTEGER CTMODE,NLOOPLINE + + REAL*16 PL(0:3,NLOOPLINE) + REAL*16 PDEN(0:3,NLOOPLINE-1) + COMPLEX*32 M2L(NLOOPLINE) + REAL*16 NEW_PL(0:3,NLOOPLINE) + REAL*16 NEW_PDEN(0:3,NLOOPLINE-1) + COMPLEX*32 NEW_M2L(NLOOPLINE) + + INTEGER I,J,K + + IF (CTMODE.NE.2.AND.CTMODE.NE.5) THEN + RETURN + ENDIF + + IF (NLOOPLINE.LE.2) THEN + RETURN + ENDIF + + DO I=1,NLOOPLINE-1 + DO J=0,3 + NEW_PDEN(J,NLOOPLINE-I) = PDEN(J,I) + ENDDO + ENDDO + DO I=1,NLOOPLINE-1 + DO J=0,3 + PDEN(J,I) = NEW_PDEN(J,I) + ENDDO + ENDDO + + DO I=2,NLOOPLINE + NEW_M2L(I)=M2L(NLOOPLINE-I+2) + ENDDO + DO I=2,NLOOPLINE + M2L(I)=NEW_M2L(I) + ENDDO + + + DO I=1,NLOOPLINE + DO J=0,3 + NEW_PL(J,I) = -PL(J,NLOOPLINE+1-I) + ENDDO + ENDDO + DO I=1,NLOOPLINE + DO J=0,3 + PL(J,I) = NEW_PL(J,I) + ENDDO + ENDDO + + END + + SUBROUTINE ML5_0_INITTIR() +C +C INITIALISATION OF TIR +C +C LOCAL VARIABLES +C + REAL*8 THRS + LOGICAL EXT_NUM_FOR_R1 +C +C GLOBAL VARIABLES +C + INCLUDE 'MadLoopParams.inc' + LOGICAL CTINIT, TIRINIT, GOLEMINIT, SAMURAIINIT, NINJAINIT + $ ,COLLIERINIT + COMMON/REDUCTIONCODEINIT/CTINIT,TIRINIT,GOLEMINIT,SAMURAIINIT + $ ,NINJAINIT,COLLIERINIT + +C ---------- +C BEGIN CODE +C ---------- + +C DEFAULT PARAMETERS FOR TIR +C ------------------------------- +C THRS1 IS THE PRECISION LIMIT BELOW WHICH THE MP ROUTINES +C ACTIVATES +C USE THE SAME MADLOOP PARAMETER IN CUTTOOLS AND TIR +C IT IS NECESSARY TO INITIALIZE CT BECAUSE IREGI USES THE VERSION +C OF ONELOOP +C FROM CUTTOOLS LIBRARY + THRS=CTSTABTHRES +C LOOPLIB SET WHAT LIBRARY CT USES +C 1 -> LOOPTOOLS +C 2 -> AVH +C 3 -> QCDLOOP + LOOPLIB=CTLOOPLIBRARY +C The initialization below is for CT v1.9.2+ + IF (CTINIT) THEN + CTINIT=.FALSE. + CALL ML5_0_INITCT() + ENDIF + END + + SUBROUTINE ML5_0_CHOOSE_LOOPLIB(LIBINDEX,NLOOPLINE,RANK + $ ,COMPLEX_MASS,LOOP_ID,DOING_QP,I_LIB) +C +C CHOOSE THE CORRECT LOOP LIB +C Example: +C MLReductionLib=3|2|1 and LIBINDEX=3 +C IF THE LOOP IS BEYOND THE SCOPE OF LOOP LIB MLReductionLib(3)=1 +C USE LIBINDEX=1, and LIBINDEX=2 ... +C IF IT IS STILL NOT GOOD,STOP +C + IMPLICIT NONE +C +C CONSTANTS +C + INTEGER NLOOPLIB + PARAMETER (NLOOPLIB=7) + INTEGER QP_NLOOPLIB + PARAMETER (QP_NLOOPLIB=1) + INTEGER NLOOPGROUPS + PARAMETER (NLOOPGROUPS=16) +C +C ARGUMENTS +C + INTEGER LIBINDEX,NLOOPLINE,RANK,I_LIB,LOOP_ID + LOGICAL COMPLEX_MASS,DOING_QP +C +C LOCAL VARIABLES +C + INTEGER I,J_LIB,LIBNUM,SELECT_LIBINDEX + LOGICAL LPASS +C This list specifies what loop involve an Higgs effective vertex +C so that CutTools limitations can be correctly implemented + LOGICAL HAS_AN_HEFT_VERTEX(NLOOPGROUPS) + DATA (HAS_AN_HEFT_VERTEX(I),I= 1, 8) /.FALSE.,.FALSE. + $ ,.FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE./ +C +C GLOBAL VARIABLES +C + INCLUDE 'MadLoopParams.inc' + INCLUDE 'process_info.inc' +C Change the list 'LOOPLIBS_QPAVAILABLE' in +C loop_matrix_standalone.inc to change the list of QPTools +C availables + LOGICAL QP_TOOLS_AVAILABLE + INTEGER INDEX_QP_TOOLS(QP_NLOOPLIB+1) + COMMON/ML5_0_LOOP_TOOLS/QP_TOOLS_AVAILABLE,INDEX_QP_TOOLS + +C ---------- +C BEGIN CODE +C ---------- + + IF(DOING_QP)THEN +C QP EVALUATION, ONLY CUTTOOLS + IF(.NOT.QP_TOOLS_AVAILABLE)THEN + STOP 'No qp tools available, please make sure MLReductionLib' + $ //' is correct' + ENDIF + J_LIB=0 + SELECT_LIBINDEX=LIBINDEX + DO WHILE(J_LIB.EQ.0) + DO I=1,QP_NLOOPLIB + IF(INDEX_QP_TOOLS(I).EQ.SELECT_LIBINDEX)THEN + J_LIB=I + EXIT + ENDIF + ENDDO + IF(J_LIB.EQ.0)THEN + SELECT_LIBINDEX=SELECT_LIBINDEX+1 + IF(SELECT_LIBINDEX.GT.NLOOPLIB.OR.MLREDUCTIONLIB(SELECT_LIB + $INDEX).EQ.0)SELECT_LIBINDEX=1 + ENDIF + ENDDO + I=J_LIB + I_LIB=SELECT_LIBINDEX + LIBNUM=MLREDUCTIONLIB(I_LIB) + DO + CALL DETECT_LOOPLIB(LIBNUM,NLOOPLINE,RANK,COMPLEX_MASS + $ ,HAS_AN_HEFT_VERTEX(LOOP_ID),MAX_SPIN_CONNECTED_TO_LOOP,LPASS) + IF(LPASS)EXIT + I=I+1 + IF(I.GT.QP_NLOOPLIB.AND.INDEX_QP_TOOLS(I).EQ.0)THEN + I=1 + ENDIF + IF(I.EQ.J_LIB)THEN + STOP 'No qp loop library can deal with this integral' + ENDIF + I_LIB=INDEX_QP_TOOLS(I) + LIBNUM=MLREDUCTIONLIB(I_LIB) + ENDDO + ELSE +C DP EVALUATION + I_LIB=LIBINDEX + LIBNUM=MLREDUCTIONLIB(I_LIB) + DO + CALL DETECT_LOOPLIB(LIBNUM,NLOOPLINE,RANK,COMPLEX_MASS + $ ,HAS_AN_HEFT_VERTEX(LOOP_ID),MAX_SPIN_CONNECTED_TO_LOOP,LPASS) + IF(LPASS)EXIT + I_LIB=I_LIB+1 + IF(I_LIB.GT.NLOOPLIB.OR.MLREDUCTIONLIB(I_LIB).EQ.0)THEN + I_LIB=1 + ENDIF + IF(I_LIB.EQ.LIBINDEX)THEN + STOP 'No dp loop library can deal with this integral' + ENDIF + LIBNUM=MLREDUCTIONLIB(I_LIB) + ENDDO + ENDIF + RETURN + END + + SUBROUTINE ML5_0_CLEAR_TIR_CACHE() + IMPLICIT NONE + + INTEGER NLOOPGROUPS + PARAMETER (NLOOPGROUPS=16) + INTEGER TIR_CACHE_SIZE + INCLUDE 'tir_cache_size.inc' + + INTEGER I,J + + LOGICAL TIR_DONE(NLOOPGROUPS,0:TIR_CACHE_SIZE) + COMMON/ML5_0_TIRCACHING/TIR_DONE + + DO I=0,TIR_CACHE_SIZE + DO J=1,NLOOPGROUPS + TIR_DONE(J,I)=.FALSE. + ENDDO + ENDDO + END SUBROUTINE + + INTEGER FUNCTION ML5_0_TIRCACHE_INDEX(CTMODE) +C Mapping function from CTMode to index and the TIR_cache + INTEGER TIR_CACHE_SIZE + INCLUDE 'tir_cache_size.inc' + + INTEGER CTMODE + + ML5_0_TIRCACHE_INDEX=CTMODE + IF(ML5_0_TIRCACHE_INDEX.GT.2) THEN +C This way, the CTMode 4 and 5 are sent to 3 and 4 respectively. + ML5_0_TIRCACHE_INDEX = ML5_0_TIRCACHE_INDEX-1 + ENDIF + +C In principle if we wanted to cache other modes or rotations, we +C could do it here + RETURN + END + diff --git a/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/check_sa.f b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/check_sa.f new file mode 100644 index 0000000000..585c5bd17a --- /dev/null +++ b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/check_sa.f @@ -0,0 +1,723 @@ + PROGRAM DRIVER +C ***************************************************************** +C ******** +C THIS IS THE DRIVER FOR CHECKING THE STANDALONE MATRIX ELEMENT. +C IT USES A SIMPLE PHASE SPACE GENERATOR +C ***************************************************************** +C ******** + IMPLICIT NONE +C +C CONSTANTS +C + REAL*8 ZERO + PARAMETER (ZERO=0D0) + + LOGICAL READPS + PARAMETER (READPS = .FALSE.) + + INTEGER NPSPOINTS + PARAMETER (NPSPOINTS = 10) + +C integer nexternal C number particles (incoming+outgoing) in the +C me + INTEGER NEXTERNAL, NINCOMING + PARAMETER (NEXTERNAL=4,NINCOMING=2) + + CHARACTER(512) MADLOOPRESOURCEPATH + +C +C INCLUDE FILES +C +C the include file with the values of the parameters and masses +C + + INCLUDE 'coupl.inc' +C particle masses + REAL*8 PMASS(NEXTERNAL) +C integer n_max_cg + INCLUDE 'ngraphs.inc' + INCLUDE 'nsquaredSO.inc' + + INCLUDE 'MadLoopParams.inc' + +C +C LOCAL +C + INTEGER I,J,K,L +C four momenta. Energy is the zeroth component. + REAL*8 P(0:3,NEXTERNAL) + INTEGER MATELEM_ARRAY_DIM + REAL*8 , ALLOCATABLE :: MATELEM(:,:) + REAL*8 SQRTS,AO2PI,TOTMASS +C sqrt(s)= center of mass energy + REAL*8 PIN(0:3), POUT(0:3) + CHARACTER*120 BUFF(NEXTERNAL) + INTEGER RETURNCODE, UNITS, TENS, HUNDREDS + INTEGER NSQUAREDSO_LOOP + REAL*8 , ALLOCATABLE :: PREC_FOUND(:) + INTEGER NB_INTER + LOGICAL INIT + DATA INIT/.TRUE./ + COMMON/INITCHECKSA/INIT + + INTEGER NLOOPFLOWS + PARAMETER (NLOOPFLOWS=1) + INTEGER NCOMB + PARAMETER (NCOMB=4) + INTEGER N_CHANGING + PARAMETER (N_CHANGING=2) + INTEGER N_COMB_RHO + PARAMETER (N_COMB_RHO=2) + INTEGER H + INTEGER HELC(NEXTERNAL,NCOMB) + DOUBLE PRECISION ALPHAS, MU_R2 + + DOUBLE COMPLEX INTER_DENS(0:3,0:NSQUAREDSO) + DOUBLE COMPLEX RMATRIX((N_COMB_RHO*(N_COMB_RHO+1))/2, + $ 0:NSQUAREDSO) + DOUBLE PRECISION RES(0:3,0:NSQUAREDSO), SUM_INT + INTEGER HEL_MULT + PARAMETER (HEL_MULT = 1) + INTEGER H1, H2 + +C +C GLOBAL VARIABLES +C +C This is from ML code for the list of split orders selected by +C the process definition +C + INTEGER NLOOPCHOSEN + CHARACTER*20 CHOSEN_LOOP_SO_INDICES(NSQUAREDSO) + LOGICAL CHOSEN_LOOP_SO_CONFIGS(NSQUAREDSO) + COMMON/ML5_0_CHOSEN_LOOP_SQSO/CHOSEN_LOOP_SO_CONFIGS + +C +C EXTERNAL +C + REAL*8 DOT + EXTERNAL DOT + + INTEGER NHEL(NEXTERNAL) + INTEGER, ALLOCATABLE :: POS(:) + INTEGER, ALLOCATABLE :: ALLOW_HEL(:) + DOUBLE COMPLEX, ALLOCATABLE :: INTER(:) + INTEGER SOL + +C +C BEGIN CODE +C + IF (INIT) THEN + INIT=.FALSE. + CALL ML5_0_GET_ANSWER_DIMENSION(MATELEM_ARRAY_DIM) + ALLOCATE(MATELEM(0:3,0:MATELEM_ARRAY_DIM)) + CALL ML5_0_GET_NSQSO_LOOP(NSQUAREDSO_LOOP) + ALLOCATE(PREC_FOUND(0:NSQUAREDSO_LOOP)) +C +C INITIALIZATION CALLS +C +C Call to initialize the values of the couplings, masses and +C widths +C used in the evaluation of the matrix element. The primary +C parameters of the +C models are read from Cards/param_card.dat. The secondary +C parameters are calculated +C in Source/MODEL/couplings.f. The values are stored in common +C blocks that are listed +C in coupl.inc . +C first call to setup the paramaters + CALL SETPARA('param_card.dat') +C set up masses + INCLUDE 'pmass.inc' + + ENDIF + +C Start by initializing what is the squared split orders indices +C chosen + NLOOPCHOSEN=0 + DO I=1,NSQUAREDSO + IF (CHOSEN_LOOP_SO_CONFIGS(I)) THEN + NLOOPCHOSEN=NLOOPCHOSEN+1 + WRITE(CHOSEN_LOOP_SO_INDICES(NLOOPCHOSEN),'(I3,A2)') I,'L)' + ENDIF + ENDDO + + AO2PI=G**2/(8.D0*(3.14159265358979323846D0**2)) + + WRITE(*,*) 'AO2PI=',AO2PI +C Now use a simple multipurpose PS generator (RAMBO) just to get a +C RANDOM set of four momenta of given masses pmass(i) to be used +C to evaluate +C the madgraph matrix-element. +C Alternatevely, here the user can call or set the four momenta at +C his will, see below. +C + IF(NINCOMING.EQ.1) THEN + SQRTS=PMASS(1) + ELSE + TOTMASS = 0.0D0 + DO I=1,NEXTERNAL + TOTMASS = TOTMASS + PMASS(I) + ENDDO +C CMS energy in GEV + SQRTS=MAX(1000D0,2.0D0*TOTMASS) + ENDIF + + CALL PRINTOUT() + + DO K=1,NPSPOINTS + + IF(READPS) THEN + OPEN(967, FILE='PS.input', ERR=976, STATUS='OLD', + $ ACTION='READ') + DO I=1,NEXTERNAL + READ(967,*,END=978) P(0,I),P(1,I),P(2,I),P(3,I) + ENDDO + GOTO 978 + 976 CONTINUE + STOP 'Could not read the PS.input phase-space point.' + 978 CONTINUE + CLOSE(967) + ELSE + IF ((NINCOMING.EQ.2).AND.((NEXTERNAL - NINCOMING .EQ.1))) + $ THEN + IF (PMASS(3).EQ.0.0D0) THEN + STOP 'Cannot generate 2>1 kin. config. with m3=0.0d0' + ELSE +C deal with the case of only one particle in the final +C state + P(0,1) = PMASS(3)/2D0 + P(1,1) = 0D0 + P(2,1) = 0D0 + P(3,1) = PMASS(3)/2D0 + IF (PMASS(1).GT.0D0) THEN + P(3,1) = DSQRT(PMASS(3)**2/4D0 - PMASS(1)**2) + ENDIF + P(0,2) = PMASS(3)/2D0 + P(1,2) = 0D0 + P(2,2) = 0D0 + P(3,2) = -PMASS(3)/2D0 + IF (PMASS(2) > 0D0) THEN + P(3,2) = -DSQRT(PMASS(3)**2/4D0 - PMASS(1)**2) + ENDIF + P(0,3) = PMASS(3) + P(1,3) = 0D0 + P(2,3) = 0D0 + P(3,3) = 0D0 + ENDIF + ELSE + CALL GET_MOMENTA(SQRTS,PMASS,P) + ENDIF + ENDIF + + DO I=0,3 + PIN(I)=0.0D0 + DO J=1,NINCOMING + PIN(I)=PIN(I)+P(I,J) + ENDDO + ENDDO + +C In standalone mode, always use sqrt_s as the renormalization +C scale. + SQRTS=DSQRT(DABS(DOT(PIN(0),PIN(0)))) + MU_R=SQRTS + +C Update the couplings with the new MU_R + CALL UPDATE_AS_PARAM(1) + +C Optionally the user can set where to find the +C MadLoop5_resources folder. +C Otherwise it will look for it automatically and find it if it +C has not +C been moved +C MadLoopResourcePath = '' +C CALL SETMADLOOPPATH(MadLoopResourcePath) +C To force the stabiliy check to also be performed in the +C initialization phase +C CALL ML5_0_FORCE_STABILITY_CHECK(.TRUE.) +C To chose a particular tartget split order, SOTARGET is an +C integer labeling +C the possible squared order couplings contributions (only in +C optimized mode) +C CALL ML5_0_SET_COUPLINGORDERS_TARGET(SOTARGET) + +C +C Now we can call the matrix element +C + CALL ML5_0_SLOOPMATRIX_THRES(P,MATELEM,-1.0D0,PREC_FOUND + $ ,RETURNCODE) + + CALL ML5_0_COMPUTE_RES_FROM_JAMP(RES,HEL_MULT) +C WRITE(*,*) "ML5_0_COMPUTE_RES_FROM_JAMP", RES(1:3,0) + + + IF (K.EQ.NPSPOINTS) THEN + WRITE (*,*) + WRITE (*,*) ' Phase space point:' + WRITE (*,*) + WRITE (*,*) '---------------------------------' + WRITE (*,*) 'n E px py pz m' + DO I=1,NEXTERNAL + WRITE (*,'(i2,1x,5e15.7)') I, P(0,I),P(1,I),P(2,I),P(3,I) + $ ,DSQRT(DABS(DOT(P(0,I),P(0,I)))) + ENDDO + WRITE (*,*) '---------------------------------' + WRITE (*,*) 'Detailed result for each coupling orders' + $ //' combination.' + + WRITE (*,*) '---------------------------------' + WRITE(*,*) 'No split orders defined.' + WRITE (*,*) '---------------------------------' + UNITS=MOD(RETURNCODE,10) + TENS=(MOD(RETURNCODE,100)-UNITS)/10 + HUNDREDS=(RETURNCODE-TENS*10-UNITS)/100 + IF (HUNDREDS.EQ.1) THEN + IF (TENS.EQ.3.OR.TENS.EQ.4) THEN + WRITE(*,*) 'Unknown numerical stability because MadLoop' + $ //' is in the initialization stage.' + ELSE + WRITE(*,*) 'Unknown numerical stability, check CTModeRun' + $ //' value in MadLoopParams.dat.' + ENDIF + ELSEIF (HUNDREDS.EQ.2) THEN + WRITE(*,*) 'Stable kinematic configuration (SPS).' + ELSEIF (HUNDREDS.EQ.3) THEN + WRITE(*,*) 'Unstable kinematic configuration (UPS).' + WRITE(*,*) 'Quadruple precision rescue successful.' + ELSEIF (HUNDREDS.EQ.4) THEN + WRITE(*,*) 'Exceptional kinematic configuration (EPS).' + WRITE(*,*) 'Both double an quadruple precision' + $ //' computations, are unstable.' + ENDIF + IF (TENS.EQ.2.OR.TENS.EQ.4) THEN + WRITE(*,*) 'Quadruple precision computation used.' + ENDIF + IF (HUNDREDS.NE.1) THEN + IF (PREC_FOUND(0).GT.0.0D0) THEN + WRITE(*,'(1x,a23,1x,1e10.2)') 'Relative accuracy =' + $ ,PREC_FOUND(0) + ELSEIF (PREC_FOUND(0).EQ.0.0D0) THEN + WRITE(*,'(1x,a23,1x,1e10.2,1x,a30)') 'Relative accuracy ' + $ //' =',PREC_FOUND(0),'(i.e. beyond double precision)' + ELSE + WRITE(*,*) 'Estimated accuracy could not be computed for' + $ //' an unknown reason.' + ENDIF + ENDIF + WRITE (*,'(1x,a23,3x,i3)') 'MadLoop return code =' + $ ,RETURNCODE + WRITE (*,*) '---------------------------------' + IF (NLOOPCHOSEN.NE.NSQUAREDSO) THEN + WRITE (*,*) 'Selected squared coupling orders combination' + $ //' for the loop summed result below:' + WRITE (*,*) (CHOSEN_LOOP_SO_INDICES(I),I=1,NLOOPCHOSEN) + ENDIF + WRITE (*,*) '---------------------------------' + WRITE (*,*) ' This is a loop induced process, so only the ' + WRITE (*,*) ' unnormalized finite part is output here. Be' + $ //' aware ' + WRITE (*,*) ' that all loops are expected to beUV-finite as' + $ //' no ' + WRITE (*,*) ' renormalization prescription is considered. ' + WRITE (*,*) '---------------------------------' + WRITE (*,*) 'Matrix element finite = ', MATELEM(1,0), + $ ' GeV^',-(2*NEXTERNAL-8) + WRITE (*,*) '---------------------------------' + OPEN(69, FILE='result.dat', ERR=976, ACTION='WRITE') + DO I=1,NEXTERNAL + WRITE (69,'(a2,1x,5ES30.15E3)') 'PS',P(0,I),P(1,I),P(2,I) + $ ,P(3,I) + ENDDO + WRITE (69,'(a3,1x,i3)') 'EXP',-(2*NEXTERNAL-8) + WRITE (69,'(a4,1x,1ES30.15E3)') 'BORN',0.0D0 + WRITE (69,'(a3,1x,1ES30.15E3)') 'FIN',MATELEM(1,0) + WRITE (69,'(a4,1x,1ES30.15E3)') '1EPS',MATELEM(2,0) + WRITE (69,'(a4,1x,1ES30.15E3)') '2EPS',MATELEM(3,0) + WRITE (69,'(a6,1x,1ES30.15E3)') 'ASO2PI',AO2PI + WRITE (69,*) 'Export_Format LoopInduced' + WRITE (69,'(a7,1x,i3)') 'RETCODE',RETURNCODE + WRITE (69,'(a3,1x,1e10.4)') 'ACC',PREC_FOUND(0) + WRITE (69,*) 'Born_kept F' + WRITE (69,*) 'Loop_kept',(CHOSEN_LOOP_SO_CONFIGS(I),I=1 + $ ,NSQUAREDSO) + + WRITE (69,*) 'Split_Orders_Names ' + + CLOSE(69) + ELSE + WRITE (*,*) 'PS Point #',K,' done.' + ENDIF + ENDDO + +C C +C C Copy down here (or read in) the four momenta as a string. +C C +C C +C buff(1)=" 1 0.5630480E+04 0.0000000E+00 0.0000000E+00 +C 0.5630480E+04" +C buff(2)=" 2 0.5630480E+04 0.0000000E+00 0.0000000E+00 +C -0.5630480E+04" +C buff(3)=" 3 0.5466073E+04 0.4443190E+03 0.2446331E+04 +C -0.4864732E+04" +C buff(4)=" 4 0.8785819E+03 -0.2533886E+03 0.2741971E+03 +C 0.7759741E+03" +C buff(5)=" 5 0.4916306E+04 -0.1909305E+03 -0.2720528E+04 +C 0.4088757E+04" +C C +C C Here the k,E,px,py,pz are read from the string into the +C momenta array. +C C k=1,2 : incoming +C C k=3,nexternal : outgoing +C C +C do i=1,nexternal +C read (buff(i),*) k, P(0,i),P(1,i),P(2,i),P(3,i) +C enddo +C +C C print the momenta out +C +C do i=1,nexternal +C write (*,'(i2,1x,5e15.7)') i, P(0,i),P(1,i),P(2,i),P(3,i), +C .dsqrt(dabs(DOT(p(0,i),p(0,i)))) +C enddo +C +C CALL SLOOPMATRIX(P,MATELEM) +C +C write (*,*) "-------------------------------------------------" +C write (*,*) "Matrix element = ", MATELEM(1), " GeV^", +C &-(2*nexternal-8) +C write (*,*) "-------------------------------------------------" + + END + + + DOUBLE PRECISION FUNCTION DOT(P1,P2) +C ************************************************************* +C 4-Vector Dot product +C ************************************************************* + IMPLICIT NONE + DOUBLE PRECISION P1(0:3),P2(0:3) + DOT=P1(0)*P2(0)-P1(1)*P2(1)-P1(2)*P2(2)-P1(3)*P2(3) + END + + + SUBROUTINE GET_MOMENTA(ENERGY,PMASS,P) +C auxiliary function to change convention between madgraph and +C rambo +C four momenta. + IMPLICIT NONE + INTEGER NEXTERNAL, NINCOMING + PARAMETER (NEXTERNAL=4,NINCOMING=2) +C ARGUMENTS + REAL*8 ENERGY,PMASS(NEXTERNAL),P(0:3,NEXTERNAL),PRAMBO(4,10),WGT +C LOCAL + INTEGER I + REAL*8 ETOT2,MOM,M1,M2,E1,E2 + + ETOT2=ENERGY**2 + M1=PMASS(1) + M2=PMASS(2) + MOM=(ETOT2**2 - 2*ETOT2*M1**2 + M1**4 - 2*ETOT2*M2**2 - 2*M1**2 + $ *M2**2 + M2**4)/(4.*ETOT2) + MOM=DSQRT(MOM) + E1=DSQRT(MOM**2+M1**2) + E2=DSQRT(MOM**2+M2**2) +C write (*,*) e1+e2,mom + + IF(NINCOMING.EQ.2) THEN + + P(0,1)=E1 + P(1,1)=0D0 + P(2,1)=0D0 + P(3,1)=MOM + + P(0,2)=E2 + P(1,2)=0D0 + P(2,2)=0D0 + P(3,2)=-MOM + + CALL RAMBO(NEXTERNAL-2,ENERGY,PMASS(3),PRAMBO,WGT) + DO I=3, NEXTERNAL + P(0,I)=PRAMBO(4,I-2) + P(1,I)=PRAMBO(1,I-2) + P(2,I)=PRAMBO(2,I-2) + P(3,I)=PRAMBO(3,I-2) + ENDDO + + ELSEIF(NINCOMING.EQ.1) THEN + + P(0,1)=ENERGY + P(1,1)=0D0 + P(2,1)=0D0 + P(3,1)=0D0 + + CALL RAMBO(NEXTERNAL-1,ENERGY,PMASS(2),PRAMBO,WGT) + DO I=2, NEXTERNAL + P(0,I)=PRAMBO(4,I-1) + P(1,I)=PRAMBO(1,I-1) + P(2,I)=PRAMBO(2,I-1) + P(3,I)=PRAMBO(3,I-1) + ENDDO + ENDIF + + RETURN + END + + + SUBROUTINE RAMBO(N,ET,XM,P,WT) +C ***************************************************************** +C ***** +C RAMBO * +C RA(NDOM) M(OMENTA) B(EAUTIFULLY) O(RGANIZED) +C * +C * +C A DEMOCRATIC MULTI-PARTICLE PHASE SPACE GENERATOR +C * +C AUTHORS: S.D. ELLIS, R. KLEISS, W.J. STIRLING +C * +C THIS IS VERSION 1.0 - WRITTEN BY R. KLEISS +C * +C -- ADJUSTED BY HANS KUIJF, WEIGHTS ARE LOGARITHMIC (20-08-90) +C * +C * +C N = NUMBER OF PARTICLES +C * +C ET = TOTAL CENTRE-OF-MASS ENERGY +C * +C XM = PARTICLE MASSES ( DIM=NEXTERNAL-nincoming ) +C * +C P = PARTICLE MOMENTA ( DIM=(4,NEXTERNAL-nincoming) ) +C * +C WT = WEIGHT OF THE EVENT +C * +C ***************************************************************** +C ***** + IMPLICIT REAL*8(A-H,O-Z) + INTEGER NEXTERNAL, NINCOMING + PARAMETER (NEXTERNAL=4,NINCOMING=2) + DIMENSION XM(*),P(4,*) + DIMENSION Q(4,NEXTERNAL-NINCOMING),Z(NEXTERNAL-NINCOMING),R(4) + $ ,B(3),P2(NEXTERNAL-NINCOMING),XM2(NEXTERNAL-NINCOMING) + $ ,E(NEXTERNAL-NINCOMING),V(NEXTERNAL-NINCOMING),IWARN(5) + SAVE ACC,ITMAX,IBEGIN,IWARN,TWOPI, Z, PO2LOG + DATA ACC/1.D-14/,ITMAX/6/,IBEGIN/0/,IWARN/5*0/ +C +C INITIALIZATION STEP: FACTORIALS FOR THE PHASE SPACE WEIGHT + IF(IBEGIN.NE.0) GOTO 103 + IBEGIN=1 + TWOPI=8.*DATAN(1.D0) + PO2LOG=LOG(TWOPI/4.) + Z(2)=PO2LOG + DO 101 K=3,(NEXTERNAL-NINCOMING) + 101 Z(K)=Z(K-1)+PO2LOG-2.*LOG(DFLOAT(K-2)) + DO 102 K=3,(NEXTERNAL-NINCOMING) + 102 Z(K)=(Z(K)-LOG(DFLOAT(K-1))) +C +C CHECK ON THE NUMBER OF PARTICLES + 103 IF(N.GT.1.AND.N.LT.101) GOTO 104 + PRINT 1001,N + STOP +C +C CHECK WHETHER TOTAL ENERGY IS SUFFICIENT; COUNT NONZERO MASSES + 104 XMT=0. + NM=0 + DO 105 I=1,N + IF(XM(I).NE.0.D0) NM=NM+1 + 105 XMT=XMT+ABS(XM(I)) + IF(XMT.LE.ET) GOTO 201 + PRINT 1002,XMT,ET + STOP +C +C THE PARAMETER VALUES ARE NOW ACCEPTED +C +C GENERATE N MASSLESS MOMENTA IN INFINITE PHASE SPACE + 201 DO 202 I=1,N + R1=RN(1) + C=2.*R1-1. + S=SQRT(1.-C*C) + F=TWOPI*RN(2) + R1=RN(3) + R2=RN(4) + Q(4,I)=-LOG(R1*R2) + Q(3,I)=Q(4,I)*C + Q(2,I)=Q(4,I)*S*COS(F) + 202 Q(1,I)=Q(4,I)*S*SIN(F) +C +C CALCULATE THE PARAMETERS OF THE CONFORMAL TRANSFORMATION + DO 203 I=1,4 + 203 R(I)=0. + DO 204 I=1,N + DO 204 K=1,4 + 204 R(K)=R(K)+Q(K,I) + RMAS=SQRT(R(4)**2-R(3)**2-R(2)**2-R(1)**2) + DO 205 K=1,3 + 205 B(K)=-R(K)/RMAS + G=R(4)/RMAS + A=1./(1.+G) + X=ET/RMAS +C +C TRANSFORM THE Q'S CONFORMALLY INTO THE P'S + DO 207 I=1,N + BQ=B(1)*Q(1,I)+B(2)*Q(2,I)+B(3)*Q(3,I) + DO 206 K=1,3 + 206 P(K,I)=X*(Q(K,I)+B(K)*(Q(4,I)+A*BQ)) + 207 P(4,I)=X*(G*Q(4,I)+BQ) +C +C CALCULATE WEIGHT AND POSSIBLE WARNINGS + WT=PO2LOG + IF(N.NE.2) WT=(2.*N-4.)*LOG(ET)+Z(N) + IF(WT.GE.-180.D0) GOTO 208 + IF(IWARN(1).LE.5) PRINT 1004,WT + IWARN(1)=IWARN(1)+1 + 208 IF(WT.LE. 174.D0) GOTO 209 + IF(IWARN(2).LE.5) PRINT 1005,WT + IWARN(2)=IWARN(2)+1 +C +C RETURN FOR WEIGHTED MASSLESS MOMENTA + 209 IF(NM.NE.0) GOTO 210 +C RETURN LOG OF WEIGHT + WT=WT + RETURN +C +C MASSIVE PARTICLES: RESCALE THE MOMENTA BY A FACTOR X + 210 XMAX=SQRT(1.-(XMT/ET)**2) + DO 301 I=1,N + XM2(I)=XM(I)**2 + 301 P2(I)=P(4,I)**2 + ITER=0 + X=XMAX + ACCU=ET*ACC + 302 F0=-ET + G0=0. + X2=X*X + DO 303 I=1,N + E(I)=SQRT(XM2(I)+X2*P2(I)) + F0=F0+E(I) + 303 G0=G0+P2(I)/E(I) + IF(ABS(F0).LE.ACCU) GOTO 305 + ITER=ITER+1 + IF(ITER.LE.ITMAX) GOTO 304 + PRINT 1006,ITMAX + GOTO 305 + 304 X=X-F0/(X*G0) + GOTO 302 + 305 DO 307 I=1,N + V(I)=X*P(4,I) + DO 306 K=1,3 + 306 P(K,I)=X*P(K,I) + 307 P(4,I)=E(I) +C +C CALCULATE THE MASS-EFFECT WEIGHT FACTOR + WT2=1. + WT3=0. + DO 308 I=1,N + WT2=WT2*V(I)/E(I) + 308 WT3=WT3+V(I)**2/E(I) + WTM=(2.*N-3.)*LOG(X)+LOG(WT2/WT3*ET) +C +C RETURN FOR WEIGHTED MASSIVE MOMENTA + WT=WT+WTM + IF(WT.GE.-180.D0) GOTO 309 + IF(IWARN(3).LE.5) PRINT 1004,WT + IWARN(3)=IWARN(3)+1 + 309 IF(WT.LE. 174.D0) GOTO 310 + IF(IWARN(4).LE.5) PRINT 1005,WT + IWARN(4)=IWARN(4)+1 +C RETURN LOG OF WEIGHT + 310 WT=WT + RETURN +C + 1001 FORMAT(' RAMBO FAILS: # OF PARTICLES =',I5,' IS NOT ALLOWED') + 1002 FORMAT(' RAMBO FAILS: TOTAL MASS =',D15.6,' IS NOT',' SMALLER' + $ //' THAN TOTAL ENERGY =',D15.6) + 1004 FORMAT(' RAMBO WARNS: WEIGHT = EXP(',F20.9,') MAY UNDERFLOW') + 1005 FORMAT(' RAMBO WARNS: WEIGHT = EXP(',F20.9,') MAY OVERFLOW') + 1006 FORMAT(' RAMBO WARNS:',I3,' ITERATIONS DID NOT GIVE THE', + $ ' DESIRED ACCURACY =',D15.6) + END + + FUNCTION RN(IDUMMY) + REAL*8 RN,RAN + SAVE INIT + DATA INIT /1/ + IF (INIT.EQ.1) THEN + INIT=0 + CALL RMARIN(1802,9373) + END IF +C + 10 CALL RANMAR(RAN) + IF (RAN.LT.1D-16) GOTO 10 + RN=RAN +C + END + + + + SUBROUTINE RANMAR(RVEC) +C ----------------- +C Universal random number generator proposed by Marsaglia and Zaman +C in report FSU-SCRI-87-50 +C In this version RVEC is a double precision variable. + IMPLICIT REAL*8(A-H,O-Z) + COMMON/ RASET1 / RANU(97),RANC,RANCD,RANCM + COMMON/ RASET2 / IRANMR,JRANMR + SAVE /RASET1/,/RASET2/ + UNI = RANU(IRANMR) - RANU(JRANMR) + IF(UNI .LT. 0D0) UNI = UNI + 1D0 + RANU(IRANMR) = UNI + IRANMR = IRANMR - 1 + JRANMR = JRANMR - 1 + IF(IRANMR .EQ. 0) IRANMR = 97 + IF(JRANMR .EQ. 0) JRANMR = 97 + RANC = RANC - RANCD + IF(RANC .LT. 0D0) RANC = RANC + RANCM + UNI = UNI - RANC + IF(UNI .LT. 0D0) UNI = UNI + 1D0 + RVEC = UNI + END + + SUBROUTINE RMARIN(IJ,KL) +C ----------------- +C Initializing routine for RANMAR, must be called before generating +C any pseudorandom numbers with RANMAR. The input values should be +C in +C the ranges 0<=ij<=31328 ; 0<=kl<=30081 + IMPLICIT REAL*8(A-H,O-Z) + COMMON/ RASET1 / RANU(97),RANC,RANCD,RANCM + COMMON/ RASET2 / IRANMR,JRANMR + SAVE /RASET1/,/RASET2/ +C This shows correspondence between the simplified input seeds IJ, +C KL +C and the original Marsaglia-Zaman seeds I,J,K,L. +C To get the standard values in the Marsaglia-Zaman paper +C (i=12,j=34 +C k=56,l=78) put ij=1802, kl=9373 + I = MOD( IJ/177 , 177 ) + 2 + J = MOD( IJ , 177 ) + 2 + K = MOD( KL/169 , 178 ) + 1 + L = MOD( KL , 169 ) + DO 300 II = 1 , 97 + S = 0D0 + T = .5D0 + DO 200 JJ = 1 , 24 + M = MOD( MOD(I*J,179)*K , 179 ) + I = J + J = K + K = M + L = MOD( 53*L+1 , 169 ) + IF(MOD(L*M,64) .GE. 32) S = S + T + T = .5D0*T + 200 CONTINUE + RANU(II) = S + 300 CONTINUE + RANC = 362436D0 / 16777216D0 + RANCD = 7654321D0 / 16777216D0 + RANCM = 16777213D0 / 16777216D0 + IRANMR = 97 + JRANMR = 33 + END + + + + + + + diff --git a/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/coef_construction_1.f b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/coef_construction_1.f new file mode 100644 index 0000000000..ff42c56999 --- /dev/null +++ b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/coef_construction_1.f @@ -0,0 +1,215 @@ + SUBROUTINE ML5_0_COEF_CONSTRUCTION_1(P,NHEL,H,IC) +C +C Modules +C + USE ML5_0_POLYNOMIAL_CONSTANTS + USE ALOHA_OBJECT +C + IMPLICIT NONE +C +C CONSTANTS +C + INTEGER NEXTERNAL + PARAMETER (NEXTERNAL=4) + INTEGER NCOMB + PARAMETER (NCOMB=4) + INTEGER NLOOPS, NLOOPGROUPS, NCTAMPS + PARAMETER (NLOOPS=16, NLOOPGROUPS=16, NCTAMPS=4) + INTEGER NLOOPAMPS + PARAMETER (NLOOPAMPS=20) + INTEGER NWAVEFUNCS,NLOOPWAVEFUNCS + PARAMETER (NWAVEFUNCS=5,NLOOPWAVEFUNCS=40) + REAL*8 ZERO + PARAMETER (ZERO=0D0) + REAL*16 MP__ZERO + PARAMETER (MP__ZERO=0.0E0_16) +C These are constants related to the split orders + INTEGER NSO, NSQUAREDSO, NAMPSO + PARAMETER (NSO=0, NSQUAREDSO=0, NAMPSO=0) +C +C ARGUMENTS +C + REAL*8 P(0:3,NEXTERNAL) + INTEGER NHEL(NEXTERNAL), IC(NEXTERNAL) + INTEGER H +C +C LOCAL VARIABLES +C + INTEGER I,J,K + INTEGER FLAVOR(NEXTERNAL) + DATA FLAVOR /NEXTERNAL*1/ + COMPLEX*16 COEFS(MAXLWFSIZE,0:VERTEXMAXCOEFS-1,MAXLWFSIZE) + + LOGICAL DUMMYFALSE + DATA DUMMYFALSE/.FALSE./ +C +C GLOBAL VARIABLES +C + + INCLUDE 'coupl.inc' + INCLUDE 'mp_coupl.inc' + + INTEGER HELOFFSET + INTEGER GOODHEL(NCOMB) + LOGICAL GOODAMP(NSQUAREDSO,NLOOPGROUPS) + COMMON/ML5_0_FILTERS/GOODAMP,GOODHEL,HELOFFSET + + LOGICAL CHECKPHASE + LOGICAL HELDOUBLECHECKED + COMMON/ML5_0_INIT/CHECKPHASE, HELDOUBLECHECKED + + INTEGER SQSO_TARGET + COMMON/ML5_0_SOCHOICE/SQSO_TARGET + + LOGICAL UVCT_REQ_SO_DONE,MP_UVCT_REQ_SO_DONE,CT_REQ_SO_DONE + $ ,MP_CT_REQ_SO_DONE,LOOP_REQ_SO_DONE,MP_LOOP_REQ_SO_DONE + $ ,CTCALL_REQ_SO_DONE,FILTER_SO + COMMON/ML5_0_SO_REQS/UVCT_REQ_SO_DONE,MP_UVCT_REQ_SO_DONE + $ ,CT_REQ_SO_DONE,MP_CT_REQ_SO_DONE,LOOP_REQ_SO_DONE + $ ,MP_LOOP_REQ_SO_DONE,CTCALL_REQ_SO_DONE,FILTER_SO + + INTEGER I_SO + COMMON/ML5_0_I_SO/I_SO + INTEGER I_LIB + COMMON/ML5_0_I_LIB/I_LIB + + TYPE(ALOHA) W(NWAVEFUNCS) + COMMON/ML5_0_W/W + COMPLEX*16 WL(MAXLWFSIZE,0:LOOPMAXCOEFS-1,MAXLWFSIZE, + $ -1:NLOOPWAVEFUNCS) + COMPLEX*16 PL(0:3,-1:NLOOPWAVEFUNCS) + COMMON/ML5_0_WL/WL,PL + + COMPLEX*16 AMPL(3,NLOOPAMPS) + COMMON/ML5_0_AMPL/AMPL + +C +C ---------- +C BEGIN CODE +C ---------- + +C The target squared split order contribution is already reached +C if true. + IF (FILTER_SO.AND.LOOP_REQ_SO_DONE) THEN + GOTO 1001 + ENDIF + +C Coefficient construction for loop diagram with ID 1 + CALL FFV1L1_2(PL(0,0),W(1),GC_5,MDL_MB,ZERO,PL(0,1),COEFS) + CALL ML5_0_UPDATE_WL_0_1(WL(1,0,1,0),4,COEFS,4,4,WL(1,0,1,1)) + CALL FFV1L1_2(PL(0,1),W(2),GC_5,MDL_MB,ZERO,PL(0,2),COEFS) + CALL ML5_0_UPDATE_WL_1_1(WL(1,0,1,1),4,COEFS,4,4,WL(1,0,1,2)) + CALL FFS1L1_2(PL(0,2),W(4),GC_33,MDL_MB,ZERO,PL(0,3),COEFS) + CALL ML5_0_UPDATE_WL_2_1(WL(1,0,1,2),4,COEFS,4,4,WL(1,0,1,3)) + CALL FFS1L1_2(PL(0,3),W(3),GC_33,MDL_MB,ZERO,PL(0,4),COEFS) + CALL ML5_0_UPDATE_WL_3_1(WL(1,0,1,3),4,COEFS,4,4,WL(1,0,1,4)) + CALL ML5_0_CREATE_LOOP_COEFS(WL(1,0,1,4),4,4,1,1,1,5) +C Coefficient construction for loop diagram with ID 2 + CALL FFS1L1_2(PL(0,2),W(3),GC_33,MDL_MB,ZERO,PL(0,5),COEFS) + CALL ML5_0_UPDATE_WL_2_1(WL(1,0,1,2),4,COEFS,4,4,WL(1,0,1,5)) + CALL FFS1L1_2(PL(0,5),W(4),GC_33,MDL_MB,ZERO,PL(0,6),COEFS) + CALL ML5_0_UPDATE_WL_3_1(WL(1,0,1,5),4,COEFS,4,4,WL(1,0,1,6)) + CALL ML5_0_CREATE_LOOP_COEFS(WL(1,0,1,6),4,4,2,1,1,6) +C Coefficient construction for loop diagram with ID 3 + CALL FFS1L1_2(PL(0,2),W(5),GC_33,MDL_MB,ZERO,PL(0,7),COEFS) + CALL ML5_0_UPDATE_WL_2_1(WL(1,0,1,2),4,COEFS,4,4,WL(1,0,1,7)) + CALL ML5_0_CREATE_LOOP_COEFS(WL(1,0,1,7),3,4,3,1,1,7) +C Coefficient construction for loop diagram with ID 4 + CALL FFV1L2_1(PL(0,0),W(1),GC_5,MDL_MB,ZERO,PL(0,8),COEFS) + CALL ML5_0_UPDATE_WL_0_1(WL(1,0,1,0),4,COEFS,4,4,WL(1,0,1,8)) + CALL FFV1L2_1(PL(0,8),W(2),GC_5,MDL_MB,ZERO,PL(0,9),COEFS) + CALL ML5_0_UPDATE_WL_1_1(WL(1,0,1,8),4,COEFS,4,4,WL(1,0,1,9)) + CALL FFS1L2_1(PL(0,9),W(5),GC_33,MDL_MB,ZERO,PL(0,10),COEFS) + CALL ML5_0_UPDATE_WL_2_1(WL(1,0,1,9),4,COEFS,4,4,WL(1,0,1,10)) + CALL ML5_0_CREATE_LOOP_COEFS(WL(1,0,1,10),3,4,4,1,1,8) +C Coefficient construction for loop diagram with ID 5 + CALL FFS1L2_1(PL(0,9),W(4),GC_33,MDL_MB,ZERO,PL(0,11),COEFS) + CALL ML5_0_UPDATE_WL_2_1(WL(1,0,1,9),4,COEFS,4,4,WL(1,0,1,11)) + CALL FFS1L2_1(PL(0,11),W(3),GC_33,MDL_MB,ZERO,PL(0,12),COEFS) + CALL ML5_0_UPDATE_WL_3_1(WL(1,0,1,11),4,COEFS,4,4,WL(1,0,1,12)) + CALL ML5_0_CREATE_LOOP_COEFS(WL(1,0,1,12),4,4,5,1,1,9) +C Coefficient construction for loop diagram with ID 6 + CALL FFS1L1_2(PL(0,1),W(3),GC_33,MDL_MB,ZERO,PL(0,13),COEFS) + CALL ML5_0_UPDATE_WL_1_1(WL(1,0,1,1),4,COEFS,4,4,WL(1,0,1,13)) + CALL FFV1L1_2(PL(0,13),W(2),GC_5,MDL_MB,ZERO,PL(0,14),COEFS) + CALL ML5_0_UPDATE_WL_2_1(WL(1,0,1,13),4,COEFS,4,4,WL(1,0,1,14)) + CALL FFS1L1_2(PL(0,14),W(4),GC_33,MDL_MB,ZERO,PL(0,15),COEFS) + CALL ML5_0_UPDATE_WL_3_1(WL(1,0,1,14),4,COEFS,4,4,WL(1,0,1,15)) + CALL ML5_0_CREATE_LOOP_COEFS(WL(1,0,1,15),4,4,6,1,1,10) +C Coefficient construction for loop diagram with ID 7 + CALL FFS1L2_1(PL(0,9),W(3),GC_33,MDL_MB,ZERO,PL(0,16),COEFS) + CALL ML5_0_UPDATE_WL_2_1(WL(1,0,1,9),4,COEFS,4,4,WL(1,0,1,16)) + CALL FFS1L2_1(PL(0,16),W(4),GC_33,MDL_MB,ZERO,PL(0,17),COEFS) + CALL ML5_0_UPDATE_WL_3_1(WL(1,0,1,16),4,COEFS,4,4,WL(1,0,1,17)) + CALL ML5_0_CREATE_LOOP_COEFS(WL(1,0,1,17),4,4,7,1,1,11) +C Coefficient construction for loop diagram with ID 8 + CALL FFS1L2_1(PL(0,8),W(3),GC_33,MDL_MB,ZERO,PL(0,18),COEFS) + CALL ML5_0_UPDATE_WL_1_1(WL(1,0,1,8),4,COEFS,4,4,WL(1,0,1,18)) + CALL FFV1L2_1(PL(0,18),W(2),GC_5,MDL_MB,ZERO,PL(0,19),COEFS) + CALL ML5_0_UPDATE_WL_2_1(WL(1,0,1,18),4,COEFS,4,4,WL(1,0,1,19)) + CALL FFS1L2_1(PL(0,19),W(4),GC_33,MDL_MB,ZERO,PL(0,20),COEFS) + CALL ML5_0_UPDATE_WL_3_1(WL(1,0,1,19),4,COEFS,4,4,WL(1,0,1,20)) + CALL ML5_0_CREATE_LOOP_COEFS(WL(1,0,1,20),4,4,8,1,1,12) +C Coefficient construction for loop diagram with ID 9 + CALL FFV1L1_2(PL(0,0),W(1),GC_5,MDL_MT,MDL_WT,PL(0,21),COEFS) + CALL ML5_0_UPDATE_WL_0_1(WL(1,0,1,0),4,COEFS,4,4,WL(1,0,1,21)) + CALL FFV1L1_2(PL(0,21),W(2),GC_5,MDL_MT,MDL_WT,PL(0,22),COEFS) + CALL ML5_0_UPDATE_WL_1_1(WL(1,0,1,21),4,COEFS,4,4,WL(1,0,1,22)) + CALL FFS1L1_2(PL(0,22),W(4),GC_37,MDL_MT,MDL_WT,PL(0,23),COEFS) + CALL ML5_0_UPDATE_WL_2_1(WL(1,0,1,22),4,COEFS,4,4,WL(1,0,1,23)) + CALL FFS1L1_2(PL(0,23),W(3),GC_37,MDL_MT,MDL_WT,PL(0,24),COEFS) + CALL ML5_0_UPDATE_WL_3_1(WL(1,0,1,23),4,COEFS,4,4,WL(1,0,1,24)) + CALL ML5_0_CREATE_LOOP_COEFS(WL(1,0,1,24),4,4,9,1,1,13) +C Coefficient construction for loop diagram with ID 10 + CALL FFS1L1_2(PL(0,22),W(3),GC_37,MDL_MT,MDL_WT,PL(0,25),COEFS) + CALL ML5_0_UPDATE_WL_2_1(WL(1,0,1,22),4,COEFS,4,4,WL(1,0,1,25)) + CALL FFS1L1_2(PL(0,25),W(4),GC_37,MDL_MT,MDL_WT,PL(0,26),COEFS) + CALL ML5_0_UPDATE_WL_3_1(WL(1,0,1,25),4,COEFS,4,4,WL(1,0,1,26)) + CALL ML5_0_CREATE_LOOP_COEFS(WL(1,0,1,26),4,4,10,1,1,14) +C Coefficient construction for loop diagram with ID 11 + CALL FFS1L1_2(PL(0,22),W(5),GC_37,MDL_MT,MDL_WT,PL(0,27),COEFS) + CALL ML5_0_UPDATE_WL_2_1(WL(1,0,1,22),4,COEFS,4,4,WL(1,0,1,27)) + CALL ML5_0_CREATE_LOOP_COEFS(WL(1,0,1,27),3,4,11,1,1,15) +C Coefficient construction for loop diagram with ID 12 + CALL FFV1L2_1(PL(0,0),W(1),GC_5,MDL_MT,MDL_WT,PL(0,28),COEFS) + CALL ML5_0_UPDATE_WL_0_1(WL(1,0,1,0),4,COEFS,4,4,WL(1,0,1,28)) + CALL FFV1L2_1(PL(0,28),W(2),GC_5,MDL_MT,MDL_WT,PL(0,29),COEFS) + CALL ML5_0_UPDATE_WL_1_1(WL(1,0,1,28),4,COEFS,4,4,WL(1,0,1,29)) + CALL FFS1L2_1(PL(0,29),W(5),GC_37,MDL_MT,MDL_WT,PL(0,30),COEFS) + CALL ML5_0_UPDATE_WL_2_1(WL(1,0,1,29),4,COEFS,4,4,WL(1,0,1,30)) + CALL ML5_0_CREATE_LOOP_COEFS(WL(1,0,1,30),3,4,12,1,1,16) +C Coefficient construction for loop diagram with ID 13 + CALL FFS1L2_1(PL(0,29),W(4),GC_37,MDL_MT,MDL_WT,PL(0,31),COEFS) + CALL ML5_0_UPDATE_WL_2_1(WL(1,0,1,29),4,COEFS,4,4,WL(1,0,1,31)) + CALL FFS1L2_1(PL(0,31),W(3),GC_37,MDL_MT,MDL_WT,PL(0,32),COEFS) + CALL ML5_0_UPDATE_WL_3_1(WL(1,0,1,31),4,COEFS,4,4,WL(1,0,1,32)) + CALL ML5_0_CREATE_LOOP_COEFS(WL(1,0,1,32),4,4,13,1,1,17) +C Coefficient construction for loop diagram with ID 14 + CALL FFS1L1_2(PL(0,21),W(3),GC_37,MDL_MT,MDL_WT,PL(0,33),COEFS) + CALL ML5_0_UPDATE_WL_1_1(WL(1,0,1,21),4,COEFS,4,4,WL(1,0,1,33)) + CALL FFV1L1_2(PL(0,33),W(2),GC_5,MDL_MT,MDL_WT,PL(0,34),COEFS) + CALL ML5_0_UPDATE_WL_2_1(WL(1,0,1,33),4,COEFS,4,4,WL(1,0,1,34)) + CALL FFS1L1_2(PL(0,34),W(4),GC_37,MDL_MT,MDL_WT,PL(0,35),COEFS) + CALL ML5_0_UPDATE_WL_3_1(WL(1,0,1,34),4,COEFS,4,4,WL(1,0,1,35)) + CALL ML5_0_CREATE_LOOP_COEFS(WL(1,0,1,35),4,4,14,1,1,18) +C Coefficient construction for loop diagram with ID 15 + CALL FFS1L2_1(PL(0,29),W(3),GC_37,MDL_MT,MDL_WT,PL(0,36),COEFS) + CALL ML5_0_UPDATE_WL_2_1(WL(1,0,1,29),4,COEFS,4,4,WL(1,0,1,36)) + CALL FFS1L2_1(PL(0,36),W(4),GC_37,MDL_MT,MDL_WT,PL(0,37),COEFS) + CALL ML5_0_UPDATE_WL_3_1(WL(1,0,1,36),4,COEFS,4,4,WL(1,0,1,37)) + CALL ML5_0_CREATE_LOOP_COEFS(WL(1,0,1,37),4,4,15,1,1,19) +C Coefficient construction for loop diagram with ID 16 + CALL FFS1L2_1(PL(0,28),W(3),GC_37,MDL_MT,MDL_WT,PL(0,38),COEFS) + CALL ML5_0_UPDATE_WL_1_1(WL(1,0,1,28),4,COEFS,4,4,WL(1,0,1,38)) + CALL FFV1L2_1(PL(0,38),W(2),GC_5,MDL_MT,MDL_WT,PL(0,39),COEFS) + CALL ML5_0_UPDATE_WL_2_1(WL(1,0,1,38),4,COEFS,4,4,WL(1,0,1,39)) + CALL FFS1L2_1(PL(0,39),W(4),GC_37,MDL_MT,MDL_WT,PL(0,40),COEFS) + CALL ML5_0_UPDATE_WL_3_1(WL(1,0,1,39),4,COEFS,4,4,WL(1,0,1,40)) + CALL ML5_0_CREATE_LOOP_COEFS(WL(1,0,1,40),4,4,16,1,1,20) + + GOTO 1001 + 4000 CONTINUE + LOOP_REQ_SO_DONE=.TRUE. + 1001 CONTINUE + END + diff --git a/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/compute_color_flows.f b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/compute_color_flows.f new file mode 100644 index 0000000000..41ebad5330 --- /dev/null +++ b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/compute_color_flows.f @@ -0,0 +1,571 @@ +C Set of subroutines to project the Feynman diagrama amplitudes +C AMPL onto the color flow space. + + SUBROUTINE ML5_0_COMPUTE_COLOR_FLOWS(HEL_MULT,DO_CUMULATIVE) + IMPLICIT NONE + LOGICAL DO_CUMULATIVE + INTEGER HEL_MULT + CALL ML5_0_REINITIALIZE_JAMPS() + CALL ML5_0_DO_COMPUTE_COLOR_FLOWS(.FALSE.) + END SUBROUTINE + + SUBROUTINE ML5_0_COMPUTE_COLOR_FLOWS_DERIVED_QUANTITIES(HEL_MULT) + IMPLICIT NONE + INTEGER HEL_MULT + CONTINUE + END SUBROUTINE + + SUBROUTINE ML5_0_DEALLOCATE_COLOR_FLOWS() + IMPLICIT NONE + CALL ML5_0_DO_COMPUTE_COLOR_FLOWS(.TRUE.) + END SUBROUTINE + + SUBROUTINE ML5_0_DO_COMPUTE_COLOR_FLOWS(CLEANUP) + IMPLICIT NONE +C +C CONSTANTS +C + CHARACTER*512 PROC_PREFIX + PARAMETER ( PROC_PREFIX='ML5_0_') + CHARACTER*512 LOOPCOLORFLOWCOEFSNAME + PARAMETER ( LOOPCOLORFLOWCOEFSNAME='LoopColorFlowCoefs.dat') + COMPLEX*16 IMAG1 + PARAMETER (IMAG1=(0.0D0,1.0D0)) + + INTEGER NLOOPAMPS + PARAMETER (NLOOPAMPS=20) + INTEGER NSQUAREDSO, NLOOPAMPSO + PARAMETER (NSQUAREDSO=0, NLOOPAMPSO=0) + INTEGER NLOOPFLOWS + PARAMETER (NLOOPFLOWS=1) +C +C LOCAL VARIABLES +C +C When this subroutine is called with CLEANUP=True, it deallocates +C all its +C arrays + LOGICAL CLEANUP +C Storing concatenated filenames + CHARACTER*512 TMP + CHARACTER*512 LOOPCOLORFLOWCOEFSN + + INTEGER I, J, K, SOINDEX, ARRAY_SIZE + COMPLEX*16 PROJ_COEF + + +C +C FUNCTIONS +C + INTEGER ML5_0_ML5SOINDEX_FOR_BORN_AMP + INTEGER ML5_0_ML5SOINDEX_FOR_LOOP_AMP +C +C GLOBAL VARIABLES +C + CHARACTER(512) MLPATH + COMMON/MLPATH/MLPATH + + COMPLEX*16 AMPL(3,NLOOPAMPS) + COMMON/ML5_0_AMPL/AMPL + COMPLEX*16 JAMPL(3,NLOOPFLOWS,NLOOPAMPSO) + COMMON/ML5_0_JAMPL/JAMPL + + +C Now a more advanced data structure for storing the projection +C coefficient +C This is of course not F77 standard but widely supported by now. + TYPE PROJCOEFFS + INTEGER, DIMENSION(:), ALLOCATABLE :: NUM + INTEGER, DIMENSION(:), ALLOCATABLE :: DENOM + INTEGER, DIMENSION(:), ALLOCATABLE :: AMPID + ENDTYPE PROJCOEFFS + TYPE(PROJCOEFFS), DIMENSION(NLOOPFLOWS), SAVE :: + $ LOOPCOLORPROJECTOR + +C ---------- +C BEGIN CODE +C ---------- + +C CleanUp duties, i.e. array deallocation + IF (CLEANUP) THEN + DO I=1,NLOOPFLOWS + IF(ALLOCATED(LOOPCOLORPROJECTOR(I)%NUM)) + $ DEALLOCATE(LOOPCOLORPROJECTOR(I)%NUM) + IF(ALLOCATED(LOOPCOLORPROJECTOR(I)%DENOM)) + $ DEALLOCATE(LOOPCOLORPROJECTOR(I)%DENOM) + IF(ALLOCATED(LOOPCOLORPROJECTOR(I)%AMPID)) + $ DEALLOCATE(LOOPCOLORPROJECTOR(I)%AMPID) + ENDDO + RETURN + ENDIF + +C Initialization; must allocate array from data files. All arrays +C are allocated at once, so we only need to check if +C LoopColorProjector(0)%Num is allocated and all other arrays +C must share the same status. + IF(.NOT.ALLOCATED(LOOPCOLORPROJECTOR(1)%NUM)) THEN + CALL JOINPATH(MLPATH,PROC_PREFIX,TMP) + CALL JOINPATH(TMP,LOOPCOLORFLOWCOEFSNAME,LOOPCOLORFLOWCOEFSN) + +C Initialize the LoopColorProjector + OPEN(1, FILE=LOOPCOLORFLOWCOEFSN, ERR=201, STATUS='OLD', + $ ACTION='READ') + DO I=1,NLOOPFLOWS + READ(1,*,END=998) ARRAY_SIZE + ALLOCATE(LOOPCOLORPROJECTOR(I)%NUM(ARRAY_SIZE)) + ALLOCATE(LOOPCOLORPROJECTOR(I)%DENOM(ARRAY_SIZE)) + ALLOCATE(LOOPCOLORPROJECTOR(I)%AMPID(ARRAY_SIZE)) + READ(1,*,END=998) (LOOPCOLORPROJECTOR(I)%NUM(J),J=1 + $ ,ARRAY_SIZE) + READ(1,*,END=998) (LOOPCOLORPROJECTOR(I)%DENOM(J),J=1 + $ ,ARRAY_SIZE) + READ(1,*,END=998) (LOOPCOLORPROJECTOR(I)%AMPID(J),J=1 + $ ,ARRAY_SIZE) + ENDDO + GOTO 203 + 201 CONTINUE + STOP 'Color projection coefficients could not be initialized' + $ //' from file ML5_0_LoopColorFlowCoefs.dat.' + 203 CONTINUE + CLOSE(1) + + GOTO 999 + 998 CONTINUE + STOP 'End of file reached. Should not have happened.' + 999 CONTINUE + + ENDIF + +C Here we calculate JAMPB +C Projection of the loop amplitudes + DO I=1,NLOOPFLOWS + DO J=1,SIZE(LOOPCOLORPROJECTOR(I)%AMPID) + SOINDEX = ML5_0_ML5SOINDEX_FOR_LOOP_AMP(LOOPCOLORPROJECTOR(I) + $ %AMPID(J)) + PROJ_COEF=DCMPLX(LOOPCOLORPROJECTOR(I)%NUM(J) + $ /DBLE(ABS(LOOPCOLORPROJECTOR(I)%DENOM(J))),0.0D0) + IF(LOOPCOLORPROJECTOR(I)%DENOM(J).LT.0) PROJ_COEF=PROJ_COEF + $ *IMAG1 + DO K=1,3 + JAMPL(K,I,SOINDEX) = JAMPL(K,I,SOINDEX) + PROJ_COEF*AMPL(K + $ ,LOOPCOLORPROJECTOR(I)%AMPID(J)) + ENDDO + ENDDO + ENDDO + + END SUBROUTINE + +C This subroutine initializes the color flow matrix. + SUBROUTINE ML5_0_INITIALIZE_FLOW_COLORMATRIX() + IMPLICIT NONE +C +C CONSTANTS +C + CHARACTER*512 PROC_PREFIX + PARAMETER ( PROC_PREFIX='ML5_0_') + CHARACTER*512 LOOPCOLORFLOWMATRIXNAME + PARAMETER ( LOOPCOLORFLOWMATRIXNAME='LoopColorFlowMatrix.dat') + + INTEGER NLOOPFLOWS + PARAMETER (NLOOPFLOWS=1) +C +C LOCAL VARIABLES +C +C Storing concatenated filenames + CHARACTER*512 TMP + CHARACTER*512 LOOPCOLORFLOWMATRIXN + INTEGER I, J +C +C GLOBAL VARIABLES +C + CHARACTER(512) MLPATH + COMMON/MLPATH/MLPATH + +C Now a more advanced data structure for storing the projection +C coefficient +C This is of course not F77 standard but widely supported by now. + TYPE COLORCOEFF + SEQUENCE + INTEGER :: NUM + INTEGER :: DENOM + ENDTYPE COLORCOEFF + TYPE(COLORCOEFF), DIMENSION(NLOOPFLOWS,NLOOPFLOWS) :: + $ LOOPCOLORFLOWMATRIX + LOGICAL CMINITIALIZED + DATA CMINITIALIZED/.FALSE./ + COMMON/ML5_0_FLOW_COLOR_MATRIX/LOOPCOLORFLOWMATRIX, CMINITIALIZED + +C ---------- +C BEGIN CODE +C ---------- + +C Initialization + IF(.NOT.CMINITIALIZED) THEN + CMINITIALIZED = .TRUE. + CALL JOINPATH(MLPATH,PROC_PREFIX,TMP) + CALL JOINPATH(TMP,LOOPCOLORFLOWMATRIXNAME,LOOPCOLORFLOWMATRIXN) +C Initialize the LoopColorFlowMatrix + OPEN(1, FILE=LOOPCOLORFLOWMATRIXN, ERR=701, STATUS='OLD', + $ ACTION='READ') + DO I=1,NLOOPFLOWS + READ(1,*,END=898) (LOOPCOLORFLOWMATRIX(I,J)%NUM,J=1 + $ ,NLOOPFLOWS) + READ(1,*,END=898) (LOOPCOLORFLOWMATRIX(I,J)%DENOM,J=1 + $ ,NLOOPFLOWS) + ENDDO + GOTO 703 + 701 CONTINUE + STOP 'Color factors could not be initialized from file' + $ //' ML5_0_BornColorFlowMatrix.dat.' + 703 CONTINUE + CLOSE(1) + + GOTO 899 + 898 CONTINUE + STOP 'End of file reached. Should not have happened.' + 899 CONTINUE + + ENDIF + END SUBROUTINE + + +C This routine is used as a crosscheck only to make sure the loop +C ME computed +C from the JAMP is equal to the amplitude computed directly. It is +C a consistency +C check of the color projection and computation. + + SUBROUTINE ML5_0_COMPUTE_RES_FROM_JAMP(RES,HEL_MULT) + IMPLICIT NONE +C +C CONSTANTS +C + INTEGER NSQUAREDSO, NLOOPAMPSO + PARAMETER (NSQUAREDSO=0, NLOOPAMPSO=0) + INTEGER NLOOPFLOWS + PARAMETER (NLOOPFLOWS=1) +C +C ARGUMENT +C + DOUBLE COMPLEX RES_CPLX(0:3,0:NSQUAREDSO) + REAL*8 RES(0:3,0:NSQUAREDSO) +C HEL_MULT is the helicity multiplier which can be more than one +C if several helicity configuration are mapped onto the one being +C currently computed. + INTEGER HEL_MULT + DOUBLE COMPLEX JAMPL(3,NLOOPFLOWS,NLOOPAMPSO) + COMMON/ML5_0_JAMPL/JAMPL +C +C LOCAL VARIABLES +C + INTEGER I, J +C ---------- +C BEGIN CODE +C ---------- + CALL ML5_0_DO_COMPUTE_INTER_JAMP(RES_CPLX, HEL_MULT, JAMPL, + $ JAMPL) + DO I=0,3 + DO J=0, NSQUAREDSO + RES(I,J) = DREAL(RES_CPLX(I,J)) !RES is real for matrix element computation and complex for density matrix computation. A conversion is necessary + ENDDO + ENDDO + END SUBROUTINE + + + + + + INTEGER FUNCTION ML5_0_GET_HEL_INDEX(NHEL) +C returned th +C + IMPLICIT NONE + INTEGER NEXTERNAL + PARAMETER (NEXTERNAL=4) + INTEGER NCOMB + PARAMETER (NCOMB=4) + LOGICAL FOUND + INTEGER I + INTEGER NHEL(NEXTERNAL) + INTEGER HELC(NEXTERNAL,NCOMB) + COMMON/ML5_0_HELCONFIGS/HELC +C +C START CODE +C + DO ML5_0_GET_HEL_INDEX=1,NCOMB + DO I=1,NEXTERNAL + IF (HELC(I, ML5_0_GET_HEL_INDEX).NE.NHEL(I))THEN + EXIT + ELSE IF (I.EQ.NEXTERNAL) THEN + RETURN + ENDIF + ENDDO + ENDDO + END + + + + + SUBROUTINE ML5_0_DO_COMPUTE_INTER_JAMP(INTER,HEL_MULT,JAMPL1 + $ ,JAMPL2) +C Computation of the interference between JAMPL1 and JAMPL2 +C This subroutine is used to compute the matrix element JAMPL1 = +C JAMPL2 or the density matrix JAMPL1 != JAMPL2 + IMPLICIT NONE +C +C CONSTANTS +C + COMPLEX*16 IMAG1 + PARAMETER (IMAG1=(0.0D0,1.0D0)) + + INTEGER NSQUAREDSO, NLOOPAMPSO, NSO + PARAMETER (NSQUAREDSO=0, NLOOPAMPSO=0, NSO=0) + INTEGER NLOOPFLOWS + PARAMETER (NLOOPFLOWS=1) +C +C ARGUMENT +C + COMPLEX*16 INTER(0:3,0:NSQUAREDSO) +C HEL_MULT is the helicity multiplier which can be more than one +C if several helicity configuration are mapped onto the one being +C currently computed. + INTEGER HEL_MULT +C +C LOCAL VARIABLES +C + INTEGER I, J, K, M, N, ISQSO, DOUBLEFACT + INTEGER LOWERBOUND + INTEGER ORDERS_A(NSO), ORDERS_B(NSO) + COMPLEX*16 COLOR_COEF + COMPLEX*16 TEMP(3) +C +C FUNCTIONS +C +C This function belongs to the loop ME computation (loop_matrix.f) +C and is prefixed with ML5 + INTEGER ML5_0_ML5SQSOINDEX +C This function belongs to the Born ME computation (born_matrix.f) +C and is not prefixed at all + INTEGER ML5_0_SQSOINDEX, ML5_0_SOINDEX_FOR_AMPORDERS +C +C GLOBAL VARIABLES +C + CHARACTER(512) MLPATH + COMMON/MLPATH/MLPATH + INTEGER SQSO_TARGET + COMMON/ML5_0_SOCHOICE/SQSO_TARGET + + + COMPLEX*16 JAMPL1(3,NLOOPFLOWS,NLOOPAMPSO) + COMPLEX*16 JAMPL2(3,NLOOPFLOWS,NLOOPAMPSO) + + + LOGICAL UVCT_REQ_SO_DONE,MP_UVCT_REQ_SO_DONE,CT_REQ_SO_DONE + $ ,MP_CT_REQ_SO_DONE,LOOP_REQ_SO_DONE,MP_LOOP_REQ_SO_DONE + $ ,CTCALL_REQ_SO_DONE,FILTER_SO + COMMON/ML5_0_SO_REQS/UVCT_REQ_SO_DONE,MP_UVCT_REQ_SO_DONE + $ ,CT_REQ_SO_DONE,MP_CT_REQ_SO_DONE,LOOP_REQ_SO_DONE + $ ,MP_LOOP_REQ_SO_DONE,CTCALL_REQ_SO_DONE,FILTER_SO + +C Now a more advanced data structure for storing the projection +C coefficient +C This is of course not F77 standard but widely supported by now. + TYPE COLORCOEFF + SEQUENCE + INTEGER :: NUM + INTEGER :: DENOM + ENDTYPE COLORCOEFF + TYPE(COLORCOEFF), DIMENSION(NLOOPFLOWS,NLOOPFLOWS) :: + $ LOOPCOLORFLOWMATRIX + LOGICAL CMINITIALIZED + COMMON/ML5_0_FLOW_COLOR_MATRIX/LOOPCOLORFLOWMATRIX, CMINITIALIZED + +C ---------- +C BEGIN CODE +C ---------- + +C Initialization + IF(.NOT.CMINITIALIZED) THEN + CALL ML5_0_INITIALIZE_FLOW_COLORMATRIX() + ENDIF + + DO I=0,NSQUAREDSO + DO K=0,3 + INTER(K,I)=0.0D0 + ENDDO + ENDDO + + +C Compute the Loop ME from the loop color flow amplitudes (JAMPL) + DO I=1,NLOOPFLOWS + DO J=I,NLOOPFLOWS + COLOR_COEF=DCMPLX(LOOPCOLORFLOWMATRIX(I,J)%NUM + $ /DBLE(ABS(LOOPCOLORFLOWMATRIX(I,J)%DENOM)),0.0D0) + IF (LOOPCOLORFLOWMATRIX(I,J)%DENOM.LT.0) + $ COLOR_COEF=COLOR_COEF*IMAG1 + DO M=1,NLOOPAMPSO + IF (I.EQ.J) THEN + LOWERBOUND = M + ELSE + LOWERBOUND = 1 + ENDIF + DO N=LOWERBOUND,NLOOPAMPSO + ISQSO = ML5_0_ML5SQSOINDEX(M,N) + IF(J.NE.I) THEN + DOUBLEFACT=2 + ELSEIF (M.NE.N) THEN + DOUBLEFACT=2 + ELSE + DOUBLEFACT=1 + ENDIF +C I have removed the conversion to real because JAMPL1 and +C JAMPL2 are now different. The conversion to dble is +C done later in COMPUTE_RES_FROM_JAMP if we only want the +C matrix element + TEMP(1) = DOUBLEFACT*HEL_MULT*(COLOR_COEF*(JAMPL1(1,I,M) + $ *DCONJG(JAMPL2(1,J,N)))) +C Computing the quantities below is not strictly necessary +C since the result should be finite +C It is however a good cross-check. + TEMP(2) = DOUBLEFACT*HEL_MULT*(COLOR_COEF*(JAMPL1(2,I,M) + $ *DCONJG(JAMPL2(1,J,N)) + JAMPL1(1,I,M)*DCONJG(JAMPL2(2 + $ ,J,N)))) + TEMP(3) = DOUBLEFACT*HEL_MULT*(COLOR_COEF*(JAMPL1(3,I,M) + $ *DCONJG(JAMPL2(1,J,N)) + JAMPL1(1,I,M)*DCONJG(JAMPL2(3 + $ ,J,N))+JAMPL1(2,I,M)*DCONJG(JAMPL2(2,J,N)))) + DO K=1,3 + INTER(K,ISQSO) = INTER(K,ISQSO) + TEMP(K) + ENDDO + IF((.NOT.FILTER_SO).OR.SQSO_TARGET.EQ. + $ -1.OR.SQSO_TARGET.EQ.ISQSO) THEN + DO K=1,3 + INTER(K,0) = INTER(K,0) + TEMP(K) + ENDDO + ENDIF + ENDDO + ENDDO + ENDDO + ENDDO + END SUBROUTINE + + + SUBROUTINE ML5_0_SMATRIXHEL(P,HEL,ANS) + IMPLICIT NONE +C +C CONSTANT +C + INTEGER NEXTERNAL + PARAMETER (NEXTERNAL=4) + INTEGER NCOMB + PARAMETER ( NCOMB=4) + INTEGER NSQSO_BORN + PARAMETER (NSQSO_BORN=0) + + INTEGER NSQUAREDSO + PARAMETER (NSQUAREDSO=0) + INTEGER ANS_DIMENSION + PARAMETER(ANS_DIMENSION=MAX(NSQSO_BORN,NSQUAREDSO)) +CF2PY INTENT(OUT) :: ANS +CF2PY INTENT(IN) ::HEL +CF2PY INTENT(IN) :: P(0:3,NEXTERNAL) + +C +C ARGUMENTS +C + REAL*8 P(0:3,NEXTERNAL) + REAL*8 ANS(0:3,0:ANS_DIMENSION) + INTEGER HEL +C +C GLOBAL VARIABLES +C + INTEGER USERHEL + COMMON/ML5_0_HELUSERCHOICE/USERHEL +C ---------- +C BEGIN CODE +C ---------- + USERHEL=HEL + CALL ML5_0_SLOOPMATRIX(P,ANS) + USERHEL=-1 + + END + + +C This subroutine resets to 0 the common arrays JAMPL, JAMPB and +C possibly JAMPL_FOR_AMP2 if used +C The common array JAMPL_ALL is reseted to 0 in the previous +C subroutine + SUBROUTINE ML5_0_REINITIALIZE_JAMPS() + IMPLICIT NONE +C +C CONSTANTS +C + COMPLEX*16 CMPLXZERO + PARAMETER (CMPLXZERO=(0.0D0,0.0D0)) + REAL*8 ZERO + PARAMETER (ZERO=0.0D0) + INTEGER NLOOPAMPSO + PARAMETER (NLOOPAMPSO=0) + INTEGER NLOOPFLOWS + PARAMETER (NLOOPFLOWS=1) +C +C LOCAL VARIABLES +C + INTEGER I,J,K,L +C +C GLOBAL VARIABLES +C + COMPLEX*16 JAMPL(3,NLOOPFLOWS,NLOOPAMPSO) + COMMON/ML5_0_JAMPL/JAMPL + +C ---------- +C BEGIN CODE +C ---------- + + DO I=1,NLOOPAMPSO + DO J=1,NLOOPFLOWS + DO K=1,3 + JAMPL(K,J,I)=CMPLXZERO + ENDDO + ENDDO + ENDDO + + END SUBROUTINE + + +C This subroutine resets all cumulative (for each helicity) arrays +C in common block and deriving from the color flow computation. +C This subroutine is called by loop_matrix.f at appropriate time +C when these arrays must be reset. +C An example of this is the JAMP2 which must be cumulatively +C computed as loop_matrix.f loops over helicity configs but must +C be resets when loop_matrix.f starts over with helicity one (for +C the stability test for example). + SUBROUTINE ML5_0_REINITIALIZE_CUMULATIVE_ARRAYS() + IMPLICIT NONE +C +C CONSTANTS +C + COMPLEX*16 CMPLXZERO + PARAMETER (CMPLXZERO=(0.0D0,0.0D0)) + REAL*8 ZERO + PARAMETER (ZERO=0.0D0) + INTEGER NLOOPDIAGRAMS + PARAMETER (NLOOPDIAGRAMS=16) + INTEGER NLOOPFLOWS + PARAMETER (NLOOPFLOWS=1) +C +C LOCAL VARIABLES +C + INTEGER I,J,K +C +C GLOBAL VARIABLES +C + +C ---------- +C BEGIN CODE +C ---------- + + + CONTINUE + + END SUBROUTINE + + diff --git a/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/f2py_wrapper.f b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/f2py_wrapper.f new file mode 100644 index 0000000000..0b8734ca04 --- /dev/null +++ b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/f2py_wrapper.f @@ -0,0 +1,152 @@ + SUBROUTINE INITIALISE(PATH) + + CHARACTER(128) PATH +CF2PY intent(in)::path + +C INCLUDE FILES +C +C the include file with the values of the parameters and masses +C + INCLUDE 'coupl.inc' + CALL SETPARA(PATH) + RETURN + END + + SUBROUTINE GET_ME(P, ALPHAS, SCALE2, NHEL , ANS,RETURNCODE) + IMPLICIT NONE +C +C CONSTANTS +C + REAL*8 ZERO + PARAMETER (ZERO=0D0) + +C integer nexternal C number particles (incoming+outgoing) in the +C me + INCLUDE 'nexternal.inc' + +C CHARACTER(512) MADLOOPRESOURCEPATH +C +C INCLUDE FILES +C +C the include file with the values of the parameters and masses +C + INCLUDE 'coupl.inc' +C particle masses + REAL*8 PMASS(NEXTERNAL) +C integer n_max_cg + INCLUDE 'ngraphs.inc' + INCLUDE 'nsquaredSO.inc' + +C LOCAL +C + INTEGER I +C four momenta. Energy is the zeroth component. + REAL*8 P(0:3,NEXTERNAL) + INTEGER MATELEM_ARRAY_DIM + REAL*8 , ALLOCATABLE :: MATELEM(:,:) + INTEGER RETURNCODE + INTEGER NSQUAREDSO_LOOP + REAL*8 , ALLOCATABLE :: PREC_FOUND(:) + + DOUBLE PRECISION ANS + INTEGER NHEL + DOUBLE PRECISION ALPHAS, SCALE2 +CF2PY INTENT(OUT) :: ANS +CF2PY INTENT(OUT) :: RETURNCODE +CF2PY INTENT(IN) :: NHEL +CF2PY INTENT(IN) :: P(0:3,NEXTERNAL) +CF2PY INTENT(IN) :: ALPHAS +CF2PY INTENT(IN) :: SCALE2 +C +C LOCAL BUFFERING OF ANSWER to avoid re-computing +C + INTEGER BUFFER_SIZE + PARAMETER (BUFFER_SIZE=5) + DOUBLE PRECISION OLD_ALPHAS(BUFFER_SIZE) + DOUBLE PRECISION OLD_SCALE2(BUFFER_SIZE) + INTEGER OLD_NHEL(BUFFER_SIZE) + DOUBLE PRECISION OLD_P(0:3,NEXTERNAL,BUFFER_SIZE) + DOUBLE PRECISION OLD_ME(BUFFER_SIZE) + INTEGER OLD_RETURN(BUFFER_SIZE) + INTEGER BUFFER_POSITION + + DATA BUFFER_POSITION /1/ + SAVE OLD_ALPHAS, OLD_SCALE2, OLD_NHEL, OLD_P, BUFFER_POSITION + SAVE OLD_ME, OLD_RETURN +C +C GLOBAL VARIABLES +C +C This is from ML code for the list of split orders selected by +C the process definition +C + INTEGER NLOOPCHOSEN + CHARACTER*20 CHOSEN_LOOP_SO_INDICES(NSQUAREDSO) + LOGICAL CHOSEN_LOOP_SO_CONFIGS(NSQUAREDSO) + COMMON/ML5_0_CHOSEN_LOOP_SQSO/CHOSEN_LOOP_SO_CONFIGS +C +C CHECK BUFFERING +C + DO I=1, BUFFER_SIZE + IF(SCALE2.EQ.OLD_SCALE2(I))THEN + IF(ALPHAS.EQ.OLD_ALPHAS(I).AND.NHEL.EQ.OLD_NHEL(I))THEN + IF(ALL(P.EQ.OLD_P(:,:,I)))THEN + ANS = OLD_ME(I) + RETURNCODE = OLD_RETURN(I) + RETURN + ENDIF + ENDIF + ENDIF + ENDDO +C +C BEGIN CODE +C + CALL ML5_0_FORCE_STABILITY_CHECK(.TRUE.) + CALL ML5_0_GET_ANSWER_DIMENSION(MATELEM_ARRAY_DIM) + ALLOCATE(MATELEM(0:3,0:MATELEM_ARRAY_DIM)) + CALL ML5_0_GET_NSQSO_LOOP(NSQUAREDSO_LOOP) + ALLOCATE(PREC_FOUND(0:NSQUAREDSO_LOOP)) + INCLUDE 'pmass.inc' + +C Start by initializing what is the squared split orders indices +C chosen + NLOOPCHOSEN=0 + DO I=1,NSQUAREDSO + IF (CHOSEN_LOOP_SO_CONFIGS(I)) THEN + NLOOPCHOSEN=NLOOPCHOSEN+1 + WRITE(CHOSEN_LOOP_SO_INDICES(NLOOPCHOSEN),'(I3,A2)') I,'L)' + ENDIF + ENDDO + +C Update the couplings with the new ALPHAS + CALL UPDATE_AS_PARAM2(SCALE2, ALPHAS) + +C +C Now we can call the matrix element +C + IF (NHEL.EQ.0) THEN + CALL ML5_0_SLOOPMATRIX_THRES(P,MATELEM,-1.0D0, PREC_FOUND, + $ RETURNCODE) + ELSE + CALL ML5_0_SLOOPMATRIXHEL_THRES(P,NHEL, MATELEM,-1.0D0, + $ PREC_FOUND, RETURNCODE) + ENDIF + +C loop induce -> only finite part + ANS = MATELEM(1,0) + +C +C Store result for the buffering +C + OLD_ME(BUFFER_POSITION) = ANS + OLD_RETURN(BUFFER_POSITION) = RETURNCODE + BUFFER_POSITION = MOD(BUFFER_POSITION, BUFFER_SIZE) +1 + + END + + + + + + + + diff --git a/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/helas_calls_ampb_1.f b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/helas_calls_ampb_1.f new file mode 100644 index 0000000000..b1df2a7754 --- /dev/null +++ b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/helas_calls_ampb_1.f @@ -0,0 +1,116 @@ + SUBROUTINE ML5_0_HELAS_CALLS_AMPB_1(P,NHEL,H,IC) +C +C Modules +C + USE ML5_0_POLYNOMIAL_CONSTANTS + USE ALOHA_OBJECT +C + IMPLICIT NONE +C +C CONSTANTS +C + INTEGER NEXTERNAL + PARAMETER (NEXTERNAL=4) + INTEGER NCOMB + PARAMETER (NCOMB=4) + INTEGER NLOOPS, NLOOPGROUPS, NCTAMPS + PARAMETER (NLOOPS=16, NLOOPGROUPS=16, NCTAMPS=4) + INTEGER NLOOPAMPS + PARAMETER (NLOOPAMPS=20) + INTEGER NWAVEFUNCS,NLOOPWAVEFUNCS + PARAMETER (NWAVEFUNCS=5,NLOOPWAVEFUNCS=40) + REAL*8 ZERO + PARAMETER (ZERO=0D0) + REAL*16 MP__ZERO + PARAMETER (MP__ZERO=0.0E0_16) +C These are constants related to the split orders + INTEGER NSO, NSQUAREDSO, NAMPSO + PARAMETER (NSO=0, NSQUAREDSO=0, NAMPSO=0) +C +C ARGUMENTS +C + REAL*8 P(0:3,NEXTERNAL) + INTEGER NHEL(NEXTERNAL), IC(NEXTERNAL) + INTEGER H +C +C LOCAL VARIABLES +C + INTEGER I,J,K + INTEGER FLAVOR(NEXTERNAL) + DATA FLAVOR /NEXTERNAL*1/ + COMPLEX*16 COEFS(MAXLWFSIZE,0:VERTEXMAXCOEFS-1,MAXLWFSIZE) + + LOGICAL DUMMYFALSE + DATA DUMMYFALSE/.FALSE./ +C +C GLOBAL VARIABLES +C + + INCLUDE 'coupl.inc' + INCLUDE 'mp_coupl.inc' + + INTEGER HELOFFSET + INTEGER GOODHEL(NCOMB) + LOGICAL GOODAMP(NSQUAREDSO,NLOOPGROUPS) + COMMON/ML5_0_FILTERS/GOODAMP,GOODHEL,HELOFFSET + + LOGICAL CHECKPHASE + LOGICAL HELDOUBLECHECKED + COMMON/ML5_0_INIT/CHECKPHASE, HELDOUBLECHECKED + + INTEGER SQSO_TARGET + COMMON/ML5_0_SOCHOICE/SQSO_TARGET + + LOGICAL UVCT_REQ_SO_DONE,MP_UVCT_REQ_SO_DONE,CT_REQ_SO_DONE + $ ,MP_CT_REQ_SO_DONE,LOOP_REQ_SO_DONE,MP_LOOP_REQ_SO_DONE + $ ,CTCALL_REQ_SO_DONE,FILTER_SO + COMMON/ML5_0_SO_REQS/UVCT_REQ_SO_DONE,MP_UVCT_REQ_SO_DONE + $ ,CT_REQ_SO_DONE,MP_CT_REQ_SO_DONE,LOOP_REQ_SO_DONE + $ ,MP_LOOP_REQ_SO_DONE,CTCALL_REQ_SO_DONE,FILTER_SO + + INTEGER I_SO + COMMON/ML5_0_I_SO/I_SO + INTEGER I_LIB + COMMON/ML5_0_I_LIB/I_LIB + + TYPE(ALOHA) W(NWAVEFUNCS) + COMMON/ML5_0_W/W + COMPLEX*16 WL(MAXLWFSIZE,0:LOOPMAXCOEFS-1,MAXLWFSIZE, + $ -1:NLOOPWAVEFUNCS) + COMPLEX*16 PL(0:3,-1:NLOOPWAVEFUNCS) + COMMON/ML5_0_WL/WL,PL + + COMPLEX*16 AMPL(3,NLOOPAMPS) + COMMON/ML5_0_AMPL/AMPL + +C +C ---------- +C BEGIN CODE +C ---------- + +C The target squared split order contribution is already reached +C if true. + IF (FILTER_SO.AND.CT_REQ_SO_DONE) THEN + GOTO 1001 + ENDIF + + CALL VXXXXX(P(0,1),ZERO,NHEL(1),-1,W(1)) + CALL VXXXXX(P(0,2),ZERO,NHEL(2),-1,W(2)) + CALL SXXXXX(P(0,3),+1,W(3)) + CALL SXXXXX(P(0,4),+1,W(4)) +C Counter-term amplitude(s) for loop diagram number 1 + CALL R2_GGHH_0(W(1),W(2),W(4),W(3),R2_GGHHB,AMPL(1,1)) + CALL SSS1_1(W(3),W(4),GC_30,MDL_MH,MDL_WH,W(5)) +C Counter-term amplitude(s) for loop diagram number 3 + CALL VVS1_0(W(1),W(2),W(5),R2_GGHB,AMPL(1,2)) +C Counter-term amplitude(s) for loop diagram number 9 + CALL R2_GGHH_0(W(1),W(2),W(4),W(3),R2_GGHHT,AMPL(1,3)) +C Counter-term amplitude(s) for loop diagram number 11 + CALL VVS1_0(W(1),W(2),W(5),R2_GGHT,AMPL(1,4)) + + GOTO 1001 + 2000 CONTINUE + CT_REQ_SO_DONE=.TRUE. + 1001 CONTINUE + END + diff --git a/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/improve_ps.f b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/improve_ps.f new file mode 100644 index 0000000000..c7995caea2 --- /dev/null +++ b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/improve_ps.f @@ -0,0 +1,1014 @@ + SUBROUTINE ML5_0_IMPROVE_PS_POINT_PRECISION(P) + IMPLICIT NONE +C +C CONSTANTS +C + INTEGER NEXTERNAL + PARAMETER (NEXTERNAL=4) +C +C ARGUMENTS +C + DOUBLE PRECISION P(0:3,NEXTERNAL) + REAL*16 QP_P(0:3,NEXTERNAL) +C +C LOCAL VARIABLES +C + INTEGER I,J + +C ---------- +C BEGIN CODE +C ---------- + + DO I=1,NEXTERNAL + DO J=0,3 + QP_P(J,I)=P(J,I) + ENDDO + ENDDO + + CALL ML5_0_MP_IMPROVE_PS_POINT_PRECISION(QP_P) + + DO I=1,NEXTERNAL + DO J=0,3 + P(J,I)=QP_P(J,I) + ENDDO + ENDDO + + END + + + SUBROUTINE ML5_0_MP_IMPROVE_PS_POINT_PRECISION(P) + IMPLICIT NONE +C +C CONSTANTS +C + INTEGER NEXTERNAL + PARAMETER (NEXTERNAL=4) +C +C ARGUMENTS +C + REAL*16 P(0:3,NEXTERNAL) +C +C LOCAL VARIABLES +C + INTEGER I,J + INTEGER ERRCODE,ERRCODETMP + REAL*16 NEWP(0:3,NEXTERNAL) +C +C FUNCTIONS +C + LOGICAL ML5_0_MP_IS_PHYSICAL +C +C SAVED VARIABLES +C + INCLUDE 'MadLoopParams.inc' +C +C SAVED VARIABLES +C + INTEGER WARNED + DATA WARNED/0/ + + LOGICAL TOLD_SUPPRESS + DATA TOLD_SUPPRESS/.FALSE./ +C ---------- +C BEGIN CODE +C ---------- + +C ERROR CODES CONVENTION +C +C 1 :: None physical PS point input +C 100-1000 :: Error in the origianl method for restoring +C precision +C 1000-9999 :: Error when restoring precision ala PSMC +C + ERRCODETMP=0 + ERRCODE=0 + + DO J=1,NEXTERNAL + DO I=0,3 + NEWP(I,J)=P(I,J) + ENDDO + ENDDO + +C Check the sanity of the original PS point + IF (.NOT.ML5_0_MP_IS_PHYSICAL(NEWP,WARNED)) THEN + ERRCODE = 1 + WRITE(*,*) 'ERROR:: The input PS point is not precise enough.' + GOTO 100 + ENDIF + +C Now restore the precision + IF (IMPROVEPSPOINT.EQ.1) THEN + CALL ML5_0_MP_PSMC_IMPROVE_PS_POINT_PRECISION(NEWP,ERRCODE + $ ,WARNED) + ELSEIF((IMPROVEPSPOINT.EQ.2).OR.(IMPROVEPSPOINT.LE.0)) THEN + CALL ML5_0_MP_ORIG_IMPROVE_PS_POINT_PRECISION(NEWP,ERRCODE + $ ,WARNED) + ENDIF + IF (ERRCODE.NE.0) THEN + IF (WARNED.LT.20) THEN + WRITE(*,*) 'INFO:: Attempting to rescue the precision' + $ //' improvement with an alternative method.' + WARNED=WARNED+1 + ENDIF + IF (IMPROVEPSPOINT.EQ.1) THEN + CALL ML5_0_MP_ORIG_IMPROVE_PS_POINT_PRECISION(NEWP + $ ,ERRCODETMP,WARNED) + ELSEIF((IMPROVEPSPOINT.EQ.2).OR.(IMPROVEPSPOINT.LE.0)) THEN + CALL ML5_0_MP_PSMC_IMPROVE_PS_POINT_PRECISION(NEWP + $ ,ERRCODETMP,WARNED) + ENDIF + IF (ERRCODETMP.NE.0) GOTO 100 + ENDIF + +C Report to the user or update the PS point. + + GOTO 101 + 100 CONTINUE + IF (WARNED.LT.20) THEN + WRITE(*,*) 'WARNING:: This PS point could not be improved.' + $ //' Error code = ',ERRCODE,ERRCODETMP + CALL ML5_0_MP_WRITE_MOM(P) + WARNED = WARNED +1 + ENDIF + GOTO 102 + 101 CONTINUE + DO J=1,NEXTERNAL + DO I=0,3 + P(I,J)=NEWP(I,J) + ENDDO + ENDDO + 102 CONTINUE + + IF (WARNED.GE.20.AND..NOT.TOLD_SUPPRESS) THEN + WRITE(*,*) 'INFO:: Further warnings from the improve_ps' + $ //' routine will now be supressed.' + TOLD_SUPPRESS=.TRUE. + ENDIF + + END + + + FUNCTION ML5_0_MP_IS_CLOSE(P,NEWP,WARNED) + IMPLICIT NONE +C +C CONSTANTS +C + INTEGER NEXTERNAL + PARAMETER (NEXTERNAL=4) + REAL*16 ZERO + PARAMETER (ZERO=0.0E+00_16) + REAL*16 THRS_CLOSE + PARAMETER (THRS_CLOSE=1.0E-02_16) +C +C ARGUMENTS +C + REAL*16 P(0:3,NEXTERNAL), NEWP(0:3,NEXTERNAL) + LOGICAL ML5_0_MP_IS_CLOSE + INTEGER WARNED +C +C LOCAL VARIABLES +C + INTEGER I,J + REAL*16 REF,REF2 + DOUBLE PRECISION BUFFDP + +C NOW MAKE SURE THE SHIFTED POINT IS NOT TOO FAR FROM THE ORIGINAL +C ONE + ML5_0_MP_IS_CLOSE = .TRUE. + REF = ZERO + REF2 = ZERO + DO J=1,NEXTERNAL + DO I=0,3 + REF2 = REF2 + ABS(P(I,J)) + REF = REF + ABS(P(I,J)-NEWP(I,J)) + ENDDO + ENDDO + + IF ((REF/REF2).GT.THRS_CLOSE) THEN + ML5_0_MP_IS_CLOSE = .FALSE. + IF (WARNED.LT.20) THEN + BUFFDP = (REF/REF2) + WRITE(*,*) 'WARNING:: The improved PS point is too far from' + $ //' the original one',BUFFDP + WARNED=WARNED+1 + ENDIF + ENDIF + + END + + FUNCTION ML5_0_MP_IS_PHYSICAL(P,WARNED) + IMPLICIT NONE +C +C CONSTANTS +C + INTEGER NEXTERNAL + PARAMETER (NEXTERNAL=4) + INTEGER NINITIAL + PARAMETER (NINITIAL=2) + REAL*16 ZERO + PARAMETER (ZERO=0.0E+00_16) + REAL*16 MP__ZERO + PARAMETER (MP__ZERO=ZERO) + REAL*16 ONE + PARAMETER (ONE=1.0E+00_16) + REAL*16 TWO + PARAMETER (TWO=2.0E+00_16) + REAL*16 THRES_ONSHELL + PARAMETER (THRES_ONSHELL=1.0E-02_16) + REAL*16 THRES_FOURMOM + PARAMETER (THRES_FOURMOM=1.0E-06_16) +C +C ARGUMENTS +C + REAL*16 P(0:3,NEXTERNAL) + LOGICAL ML5_0_MP_IS_PHYSICAL + INTEGER WARNED +C +C LOCAL VARIABLES +C + INTEGER I,J + REAL*16 BUFF,REF + REAL*16 MASSES(NEXTERNAL) + DOUBLE PRECISION BUFFDPA,BUFFDPB +C +C GLOBAL VARIABLES +C + + INCLUDE 'mp_coupl.inc' + + MASSES(1)=MP__ZERO + MASSES(2)=MP__ZERO + MASSES(3)=MP__MDL_MH + MASSES(4)=MP__MDL_MH + +C ---------- +C BEGIN CODE +C ---------- + + ML5_0_MP_IS_PHYSICAL = .TRUE. + +C WE FIRST CHECK THAT THE INPUT PS POINT IS REASONABLY PHYSICAL +C FOR THAT WE NEED A REFERENCE SCALE + REF=ZERO + DO J=1,NEXTERNAL + REF=REF+ABS(P(0,J)) + ENDDO + DO I=0,3 + BUFF=ZERO + DO J=1,NINITIAL + BUFF=BUFF-P(I,J) + ENDDO + DO J=NINITIAL+1,NEXTERNAL + BUFF=BUFF+P(I,J) + ENDDO + IF ((BUFF/REF).GT.THRES_FOURMOM) THEN + IF (WARNED.LT.20) THEN + BUFFDPA = (BUFF/REF) + WRITE(*,*) 'ERROR:: Four-momentum conservation is not' + $ //' accurate enough, ',BUFFDPA + CALL ML5_0_MP_WRITE_MOM(P) + WARNED=WARNED+1 + ENDIF + ML5_0_MP_IS_PHYSICAL = .FALSE. + ENDIF + ENDDO + REF = REF / (ONE*NEXTERNAL) + DO I=1,NEXTERNAL + REF=ABS(P(0,I))+ABS(P(1,I))+ABS(P(2,I))+ABS(P(3,I)) + IF ((SQRT(ABS(P(0,I)**2-P(1,I)**2-P(2,I)**2-P(3,I)**2-MASSES(I) + $ **2))/REF).GT.THRES_ONSHELL) THEN + IF (WARNED.LT.20) THEN + BUFFDPA=MASSES(I) + BUFFDPB=(SQRT(ABS(P(0,I)**2-P(1,I)**2-P(2,I)**2-P(3,I)**2 + $ -MASSES(I)**2))/REF) + WRITE(*,*) 'ERROR:: Onshellness of the momentum of' + $ //' particle ',I,' of mass ',BUFFDPA,' is not accurate' + $ //' enough, ',BUFFDPB + CALL ML5_0_MP_WRITE_MOM(P) + WARNED=WARNED+1 + ENDIF + ML5_0_MP_IS_PHYSICAL = .FALSE. + ENDIF + ENDDO + + END + + SUBROUTINE ML5_0_WRITE_MOM(P) + IMPLICIT NONE + INTEGER NEXTERNAL + PARAMETER (NEXTERNAL=4) + INTEGER NINITIAL + PARAMETER (NINITIAL=2) + DOUBLE PRECISION ZERO + PARAMETER (ZERO=0.0D0) + DOUBLE PRECISION ML5_0_MDOT + + INTEGER I,J + +C +C ARGUMENTS +C + DOUBLE PRECISION P(0:3,NEXTERNAL),PSUM(0:3) + DO I=0,3 + PSUM(I)=ZERO + DO J=1,NINITIAL + PSUM(I)=PSUM(I)+P(I,J) + ENDDO + DO J=NINITIAL+1,NEXTERNAL + PSUM(I)=PSUM(I)-P(I,J) + ENDDO + ENDDO + WRITE (*,*) ' Phase space point:' + WRITE (*,*) ' ---------------------' + WRITE (*,*) ' E | px | py | pz | m ' + DO I=1,NEXTERNAL + WRITE (*,'(1x,5e27.17)') P(0,I),P(1,I),P(2,I),P(3,I) + $ ,SQRT(ABS(ML5_0_MDOT(P(0,I),P(0,I)))) + ENDDO + WRITE (*,*) ' Four-momentum conservation sum:' + WRITE (*,'(1x,4e27.17)') PSUM(0),PSUM(1),PSUM(2),PSUM(3) + WRITE (*,*) ' ---------------------' + END + + DOUBLE PRECISION FUNCTION ML5_0_MDOT(P1,P2) + IMPLICIT NONE + DOUBLE PRECISION P1(0:3),P2(0:3) + ML5_0_MDOT=P1(0)*P2(0)-P1(1)*P2(1)-P1(2)*P2(2)-P1(3)*P2(3) + RETURN + END + + SUBROUTINE ML5_0_MP_WRITE_MOM(P) + IMPLICIT NONE + INTEGER NEXTERNAL + PARAMETER (NEXTERNAL=4) + INTEGER NINITIAL + PARAMETER (NINITIAL=2) + REAL*16 ZERO + PARAMETER (ZERO=0.0E+00_16) + REAL*16 ML5_0_MP_MDOT + + INTEGER I,J + +C +C ARGUMENTS +C + REAL*16 P(0:3,NEXTERNAL),PSUM(0:3),DOT + DOUBLE PRECISION DP_P(0:3,NEXTERNAL),DP_PSUM(0:3),DP_DOT + + DO I=0,3 + PSUM(I)=ZERO + DO J=1,NINITIAL + PSUM(I)=PSUM(I)+P(I,J) + ENDDO + DO J=NINITIAL+1,NEXTERNAL + PSUM(I)=PSUM(I)-P(I,J) + ENDDO + ENDDO + +C The GCC4.7 compiler on SLC machines has trouble to write out +C quadruple precision variable with the write(*,*) statement. I +C therefore perform the cast by hand + DO I=0,3 + DP_PSUM(I)=PSUM(I) + DO J=1,NEXTERNAL + DP_P(I,J)=P(I,J) + ENDDO + ENDDO + + WRITE (*,*) ' Phase space point:' + WRITE (*,*) ' ---------------------' + WRITE (*,*) ' E | px | py | pz | m ' + DO I=1,NEXTERNAL + DOT=SQRT(ABS(ML5_0_MP_MDOT(P(0,I),P(0,I)))) + DP_DOT=DOT + WRITE (*,'(1x,5e27.17)') DP_P(0,I),DP_P(1,I),DP_P(2,I),DP_P(3 + $ ,I),DP_DOT + ENDDO + WRITE (*,*) ' Four-momentum conservation sum:' + WRITE (*,'(1x,4e27.17)') DP_PSUM(0),DP_PSUM(1),DP_PSUM(2) + $ ,DP_PSUM(3) + WRITE (*,*) ' ---------------------' + END + + REAL*16 FUNCTION ML5_0_MP_MDOT(P1,P2) + IMPLICIT NONE + REAL*16 P1(0:3),P2(0:3) + ML5_0_MP_MDOT=P1(0)*P2(0)-P1(1)*P2(1)-P1(2)*P2(2)-P1(3)*P2(3) + RETURN + END + +C Rotate_PS rotates the PS point PS (without modifying it) +C stores the result in P and for the quadruple precision +C version , it also modifies the global variables +C PS and MP_DONE accordingly. + + SUBROUTINE ML5_0_ROTATE_PS(P_IN,P,ROTATION) + IMPLICIT NONE +C +C CONSTANTS +C + INTEGER NEXTERNAL + PARAMETER (NEXTERNAL=4) +C +C ARGUMENTS +C + DOUBLE PRECISION P_IN(0:3,NEXTERNAL),P(0:3,NEXTERNAL) + INTEGER ROTATION +C +C LOCAL VARIABLES +C + INTEGER I,J + +C ---------- +C BEGIN CODE +C ---------- + + DO I=1,NEXTERNAL +C rotation=1 => (xp=z,yp=-x,zp=-y) + IF(ROTATION.EQ.1) THEN + P(0,I)=P_IN(0,I) + P(1,I)=P_IN(3,I) + P(2,I)=-P_IN(1,I) + P(3,I)=-P_IN(2,I) +C rotation=2 => (xp=-z,yp=y,zp=x) + ELSEIF(ROTATION.EQ.2) THEN + P(0,I)=P_IN(0,I) + P(1,I)=-P_IN(3,I) + P(2,I)=P_IN(2,I) + P(3,I)=P_IN(1,I) + ELSE + P(0,I)=P_IN(0,I) + P(1,I)=P_IN(1,I) + P(2,I)=P_IN(2,I) + P(3,I)=P_IN(3,I) + ENDIF + ENDDO + + END + + + SUBROUTINE ML5_0_MP_ROTATE_PS(P_IN,P,ROTATION) + IMPLICIT NONE +C +C CONSTANTS +C + INTEGER NEXTERNAL + PARAMETER (NEXTERNAL=4) +C +C ARGUMENTS +C + REAL*16 P_IN(0:3,NEXTERNAL),P(0:3,NEXTERNAL) + INTEGER ROTATION +C +C LOCAL VARIABLES +C + INTEGER I,J +C +C GLOBAL VARIABLES +C + LOGICAL MP_DONE + COMMON/ML5_0_MP_DONE/MP_DONE + +C ---------- +C BEGIN CODE +C ---------- + + DO I=1,NEXTERNAL +C rotation=1 => (xp=z,yp=-x,zp=-y) + IF(ROTATION.EQ.1) THEN + P(0,I)=P_IN(0,I) + P(1,I)=P_IN(3,I) + P(2,I)=-P_IN(1,I) + P(3,I)=-P_IN(2,I) +C rotation=2 => (xp=-z,yp=y,zp=x) + ELSEIF(ROTATION.EQ.2) THEN + P(0,I)=P_IN(0,I) + P(1,I)=-P_IN(3,I) + P(2,I)=P_IN(2,I) + P(3,I)=P_IN(1,I) + ELSE + P(0,I)=P_IN(0,I) + P(1,I)=P_IN(1,I) + P(2,I)=P_IN(2,I) + P(3,I)=P_IN(3,I) + ENDIF + ENDDO + + MP_DONE = .FALSE. + + END + +C ***************************************************************** +C Beginning of the routine for restoring precision with V.H. method +C ***************************************************************** + + SUBROUTINE ML5_0_MP_ORIG_IMPROVE_PS_POINT_PRECISION(P,ERRCODE + $ ,WARNED) + IMPLICIT NONE +C +C CONSTANTS +C + INTEGER NEXTERNAL + PARAMETER (NEXTERNAL=4) + INTEGER NINITIAL + PARAMETER (NINITIAL=2) + REAL*16 ZERO + PARAMETER (ZERO=0.0E+00_16) + REAL*16 MP__ZERO + PARAMETER (MP__ZERO=ZERO) + REAL*16 ONE + PARAMETER (ONE=1.0E+00_16) + REAL*16 TWO + PARAMETER (TWO=2.0E+00_16) + REAL*16 THRS_TEST + PARAMETER (THRS_TEST=1.0E-15_16) +C +C ARGUMENTS +C + REAL*16 P(0:3,NEXTERNAL) + INTEGER ERRCODE, WARNED +C +C FUNCTIONS +C + LOGICAL ML5_0_MP_IS_CLOSE +C +C LOCAL VARIABLES +C + INTEGER I,J, P1, P2 +C PT STANDS FOR PTOT + REAL*16 PT(0:3), NEWP(0:3,NEXTERNAL) + REAL*16 BUFF,REF,REF2,DISCR + REAL*16 MASSES(NEXTERNAL) + REAL*16 SHIFTE(2),SHIFTZ(2) +C +C GLOBAL VARIABLES +C + + INCLUDE 'mp_coupl.inc' + + MASSES(1)=MP__ZERO + MASSES(2)=MP__ZERO + MASSES(3)=MP__MDL_MH + MASSES(4)=MP__MDL_MH + +C ---------- +C BEGIN CODE +C ---------- + ERRCODE = 0 + +C NOW WE MAKE SURE THAT THE PS POINT CAN BE IMPROVED BY THE +C ALGORITHM + REF=ZERO + DO J=1,NEXTERNAL + REF=REF+ABS(P(0,J)) + ENDDO + + IF (NINITIAL.NE.2) ERRCODE = 100 + + IF (ABS(P(1,1)/REF).GT.THRS_TEST.OR.ABS(P(2,1)/REF) + $ .GT.THRS_TEST.OR.ABS(P(1,2)/REF).GT.THRS_TEST.OR.ABS(P(2,2)/REF) + $ .GT.THRS_TEST) ERRCODE = 200 + + IF (MASSES(1).NE.ZERO.OR.MASSES(2).NE.ZERO) ERRCODE = 300 + + DO I=1,NEXTERNAL + IF (P(0,I).LT.ZERO) ERRCODE = 400 + I + ENDDO + + IF (ERRCODE.NE.0) GOTO 100 + +C WE FIRST SHIFT ALL THE FINAL STATE PARTICLES TO MAKE THEM +C EXACTLY ONSHELL + + DO I=0,3 + PT(I)=ZERO + ENDDO + DO I=NINITIAL+1,NEXTERNAL + DO J=0,3 + IF (J.EQ.3) THEN + NEWP(3,I)=SIGN(SQRT(ABS(P(0,I)**2-P(1,I)**2-P(2,I)**2 + $ -MASSES(I)**2)),P(3,I)) + ELSE + NEWP(J,I)=P(J,I) + ENDIF + PT(J)=PT(J)+NEWP(J,I) + ENDDO + ENDDO + +C WE CHOOSE P1 IN THE ALGORITHM TO ALWAYS BE THE PARTICLE WITH +C POSITIVE PZ + IF (P(3,1).GT.ZERO) THEN + P1=1 + P2=2 + ELSEIF (P(3,2).GT.ZERO) THEN + P1=2 + P2=1 + ELSE + ERRCODE = 500 + GOTO 100 + ENDIF + +C Now we calculate the shift to bring to P1 and P2 +C Mathematica gives +C ptotC = {ptotE, ptotX, ptotY, ptotZ}; +C pm1C = {pm1E + sm1E, pm1X, pm1Y, pm1Z + sm1Z}; +C {pm0E + sm0E, ptotX - pm1X, ptotY - pm1Y, pm0Z + sm0Z}; +C sol = Solve[{ptotC[[1]] - pm1C[[1]] - pm0C[[1]] == 0, +C ptotC[[4]] - pm1C[[4]] - pm0C[[4]] == 0, +C pm1C[[1]]^2 - pm1C[[2]]^2 - pm1C[[3]]^2 - pm1C[[4]]^2 == m1M^2, +C pm0C[[1]]^2 - pm0C[[2]]^2 - pm0C[[3]]^2 - pm0C[[4]]^2 == m2M^2}, +C {sm1E, sm1Z, sm0E, sm0Z}] // FullSimplify; +C (solC[[1]] /. {m1M -> 0, m2M -> 0} /. {pm1X -> 0, pm1Y -> 0}) +C END +C + DISCR = -PT(0)**2 + PT(1)**2 + PT(2)**2 + PT(3)**2 + IF (DISCR.LT.ZERO) DISCR = -DISCR + + SHIFTE(1) = (PT(0)*(-TWO*P(0,P1)*PT(0) + PT(0)**2 + PT(1)**2 + + $ PT(2)**2) + (TWO*P(0,P1) - PT(0))*PT(3)**2 + PT(3)*DISCR)/(TWO + $ *(PT(0) - PT(3))*(PT(0) + PT(3))) + SHIFTE(2) = -(PT(0)*(TWO*P(0,P2)*PT(0) - PT(0)**2 + PT(1)**2 + + $ PT(2)**2) + (-TWO*P(0,P2) + PT(0))*PT(3)**2 + PT(3)*DISCR) + $ /(TWO*(PT(0) - PT(3))*(PT(0) + PT(3))) + SHIFTZ(1) = (-TWO*P(3,P1)*(PT(0)**2 - PT(3)**2) + PT(3)*(PT(0)* + $ *2 + PT(1)**2 + PT(2)**2 - PT(3)**2) + PT(0)*DISCR)/(TWO*(PT(0) + $ **2 - PT(3)**2)) + SHIFTZ(2) = -(TWO*P(3,P2)*(PT(0)**2 - PT(3)**2) + PT(3)*(-PT(0)* + $ *2 + PT(1)**2 + PT(2)**2 + PT(3)**2) + PT(0)*DISCR)/(TWO*(PT(0) + $ **2 - PT(3)**2)) + NEWP(0,P1) = P(0,P1)+SHIFTE(1) + NEWP(3,P1) = P(3,P1)+SHIFTZ(1) + NEWP(0,P2) = P(0,P2)+SHIFTE(2) + NEWP(3,P2) = P(3,P2)+SHIFTZ(2) + NEWP(1,P2) = P(1,P2) + NEWP(2,P2) = P(2,P2) + DO J=1,2 + REF=ZERO + DO I=NINITIAL+1,NEXTERNAL + REF = REF + P(J,I) + ENDDO + REF = REF - P(J,P2) + NEWP(J,P1) = REF + ENDDO + + IF (.NOT.ML5_0_MP_IS_CLOSE(P,NEWP,WARNED)) THEN + ERRCODE=999 + GOTO 100 + ENDIF + + DO J=1,NEXTERNAL + DO I=0,3 + P(I,J)=NEWP(I,J) + ENDDO + ENDDO + + 100 CONTINUE + + END + +C ***************************************************************** +C Beginning of the routine for restoring precision a la PSMC +C ***************************************************************** + + SUBROUTINE ML5_0_MP_PSMC_IMPROVE_PS_POINT_PRECISION(P,ERRCODE + $ ,WARNED) + IMPLICIT NONE +C +C CONSTANTS +C + INTEGER NEXTERNAL + PARAMETER (NEXTERNAL=4) + INTEGER NINITIAL + PARAMETER (NINITIAL=2) + REAL*16 ZERO + PARAMETER (ZERO=0.0E+00_16) + REAL*16 MP__ZERO + PARAMETER (MP__ZERO=ZERO) + REAL*16 ONE + PARAMETER (ONE=1.0E+00_16) + REAL*16 TWO + PARAMETER (TWO=2.0E+00_16) + REAL*16 CONSISTENCY_THRES + PARAMETER (CONSISTENCY_THRES=1.0E-25_16) + + INTEGER NAPPROXZEROS + PARAMETER (NAPPROXZEROS=3) + +C +C ARGUMENTS +C + REAL*16 P(0:3,NEXTERNAL) + INTEGER ERRCODE,ERROR,WARNED +C +C FUNCTIONS +C + LOGICAL ML5_0_MP_IS_CLOSE +C +C LOCAL VARIABLES +C + INTEGER I,J, P1, P2 + REAL*16 NEWP(0:3,NEXTERNAL), PBUFF(0:3) + REAL*16 BUFF, BUFF2, XSCALE, APPROX_ZEROS(NAPPROXZEROS) + REAL*16 MASSES(NEXTERNAL) +C +C GLOBAL VARIABLES +C + + INCLUDE 'mp_coupl.inc' + +C ---------- +C BEGIN CODE +C ---------- + + MASSES(1)=MP__ZERO + MASSES(2)=MP__ZERO + MASSES(3)=MP__MDL_MH + MASSES(4)=MP__MDL_MH + + ERRCODE = 0 + XSCALE = ONE + +C Define the seeds which should be tried + APPROX_ZEROS(1)=1.0E+00_16 + APPROX_ZEROS(2)=1.1E+00_16 + APPROX_ZEROS(3)=0.9E+00_16 + +C Start by copying the momenta + DO I=1,NEXTERNAL + DO J=0,3 + NEWP(J,I)=P(J,I) + ENDDO + ENDDO + +C First make sur that the space like momentum is exactly conserved + DO J=0,3 + PBUFF(J)=ZERO + ENDDO + DO I=1,NINITIAL + DO J=1,3 + PBUFF(J)=PBUFF(J)+NEWP(J,I) + ENDDO + ENDDO + DO I=NINITIAL+1,NEXTERNAL-1 + DO J=1,3 + PBUFF(J)=PBUFF(J)-NEWP(J,I) + ENDDO + ENDDO + DO J=1,3 + NEWP(J,NEXTERNAL)=PBUFF(J) + ENDDO + +C Now find the 'x' rescaling factor + DO I=1,NAPPROXZEROS + CALL ML5_0_FINDX(NEWP,APPROX_ZEROS(I),XSCALE,ERROR) + IF(ERROR.EQ.0) THEN + GOTO 1001 + ELSE + ERRCODE=ERRCODE+(10**(I-1))*ERROR + ENDIF + ENDDO + IF (WARNED.LT.20) THEN + WRITE(*,*) 'WARNING:: Could not find the proper rescaling' + $ //' factor x. Restoring precision ala PSMC will therefore not' + $ //' be used.' + WARNED=WARNED+1 + ENDIF + IF (ERRCODE.LT.1000) THEN + ERRCODE=ERRCODE+1000 + ENDIF + GOTO 1000 + 1001 CONTINUE + ERRCODE = 0 + +C Apply the rescaling + DO I=1,NEXTERNAL + DO J=1,3 +C Consider scaling by x**2 for the first particle so that +C the algorithm for numerically solving for XSCALE has a +C non-vanishing +C derivative in the case that all particle are massless. + IF (I.EQ.1) THEN + NEWP(J,I)=NEWP(J,I)*XSCALE**2 + ELSE + NEWP(J,I)=NEWP(J,I)*XSCALE + ENDIF + ENDDO + ENDDO + +C Now restore exact onshellness of the particles. + DO I=1,NEXTERNAL + BUFF=MASSES(I)**2 + DO J=1,3 + BUFF=BUFF+NEWP(J,I)**2 + ENDDO + NEWP(0,I)=SQRT(BUFF) + ENDDO + +C Consistency check + BUFF=ZERO + BUFF2=ZERO + DO I=1,NINITIAL + BUFF=BUFF-NEWP(0,I) + BUFF2=BUFF2+NEWP(0,I) + ENDDO + DO I=NINITIAL+1,NEXTERNAL + BUFF=BUFF+NEWP(0,I) + BUFF2=BUFF2+NEWP(0,I) + ENDDO + IF ((ABS(BUFF)/BUFF2).GT.CONSISTENCY_THRES) THEN + IF (WARNED.LT.20) THEN + WRITE(*,*) 'WARNING:: The consistency check in the a la PSMC' + $ //' precision restoring algorithm failed. The result will' + $ //' therefore not be used.' + WARNED=WARNED+1 + ENDIF + ERRCODE = 1000 + GOTO 1000 + ENDIF + + IF (.NOT.ML5_0_MP_IS_CLOSE(P,NEWP,WARNED)) THEN + ERRCODE=999 + GOTO 1000 + ENDIF + + DO J=1,NEXTERNAL + DO I=0,3 + P(I,J)=NEWP(I,J) + ENDDO + ENDDO + + 1000 CONTINUE + + END + + + SUBROUTINE ML5_0_FINDX(P,SEED,XSCALE,ERROR) + IMPLICIT NONE +C +C CONSTANTS +C + INTEGER NEXTERNAL + PARAMETER (NEXTERNAL=4) + INTEGER NINITIAL + PARAMETER (NINITIAL=2) + REAL*16 ZERO + PARAMETER (ZERO=0.0E+00_16) + REAL*16 MP__ZERO + PARAMETER (MP__ZERO=ZERO) + REAL*16 ONE + PARAMETER (ONE=1.0E+00_16) + REAL*16 TWO + PARAMETER (TWO=2.0E+00_16) + INTEGER MAXITERATIONS + PARAMETER (MAXITERATIONS=8) + REAL*16 CONVERGED + PARAMETER (CONVERGED=1.0E-26_16) +C +C ARGUMENTS +C + REAL*16 P(0:3,NEXTERNAL),SEED,XSCALE + INTEGER ERROR +C +C LOCAL VARIABLES +C + INTEGER I,J,ERR + REAL*16 PVECSQ(NEXTERNAL) + REAL*16 XN, XNP1,FVAL,DVAL + +C ---------- +C BEGIN CODE +C ---------- + + ERROR = 0 + XSCALE = SEED + XN = SEED + XNP1 = SEED + + DO I=1,NEXTERNAL + PVECSQ(I)=P(1,I)**2+P(2,I)**2+P(3,I)**2 + ENDDO + + DO I=1,MAXITERATIONS + CALL ML5_0_FUNCT(PVECSQ(1),XN,.FALSE.,ERR, FVAL) + IF (ERR.NE.0) THEN + ERROR=ERR + GOTO 710 + ENDIF + CALL ML5_0_FUNCT(PVECSQ(1),XN,.TRUE.,ERR, DVAL) + IF (ERR.NE.0) THEN + ERROR=ERR + GOTO 710 + ENDIF + XNP1=XN-(FVAL/DVAL) + IF((ABS(((XNP1-XN)*TWO)/(XNP1+XN))).LT.CONVERGED) THEN + XN=XNP1 + GOTO 700 + ENDIF + XN=XNP1 + ENDDO + ERROR=9 + GOTO 710 + + 700 CONTINUE +C For good measure, we iterate one last time + CALL ML5_0_FUNCT(PVECSQ(1),XN,.FALSE.,ERR, FVAL) + IF (ERR.NE.0) THEN + ERROR=ERR + GOTO 710 + ENDIF + CALL ML5_0_FUNCT(PVECSQ(1),XN,.TRUE.,ERR, DVAL) + IF (ERR.NE.0) THEN + ERROR=ERR + GOTO 710 + ENDIF + + XSCALE=XN-(FVAL/DVAL) + + 710 CONTINUE + + END + + SUBROUTINE ML5_0_FUNCT(PVECSQ,X,DERIVATIVE,ERROR,RES) + IMPLICIT NONE +C +C CONSTANTS +C + INTEGER NEXTERNAL + PARAMETER (NEXTERNAL=4) + INTEGER NINITIAL + PARAMETER (NINITIAL=2) + REAL*16 ZERO + PARAMETER (ZERO=0.0E+00_16) + REAL*16 MP__ZERO + PARAMETER (MP__ZERO=ZERO) + REAL*16 ONE + PARAMETER (ONE=1.0E+00_16) + REAL*16 TWO + PARAMETER (TWO=2.0E+00_16) +C +C ARGUMENTS +C + REAL*16 PVECSQ(NEXTERNAL),X,RES + INTEGER ERROR + LOGICAL DERIVATIVE +C +C LOCAL VARIABLES +C + INTEGER I,J + REAL*16 BUFF,FACTOR + REAL*16 MASSES(NEXTERNAL) +C +C GLOBAL VARIABLES +C + + INCLUDE 'mp_coupl.inc' + +C ---------- +C BEGIN CODE +C ---------- + + MASSES(1)=MP__ZERO + MASSES(2)=MP__ZERO + MASSES(3)=MP__MDL_MH + MASSES(4)=MP__MDL_MH + + ERROR=0 + RES=ZERO + BUFF=ZERO + +C Consider scaling by x**2 for the first particle so that +C the algorithm for numerically solving for XSCALE has a +C non-vanishing +C derivative in the case that all particle are massless. + + DO I=1,NEXTERNAL + IF (I.LE.NINITIAL) THEN + FACTOR=-ONE + ELSE + FACTOR=ONE + ENDIF + IF (I.EQ.1) THEN + BUFF=MASSES(I)**2+PVECSQ(I)*X**4 + ELSE + BUFF=MASSES(I)**2+PVECSQ(I)*X**2 + ENDIF + IF (BUFF.LT.ZERO) THEN + RES=ZERO + ERROR = 1 + GOTO 800 + ENDIF + IF (DERIVATIVE) THEN + IF (I.EQ.1) THEN + RES=RES + FACTOR*((2*X*PVECSQ(I))/SQRT(BUFF)) + ELSE + RES=RES + FACTOR*((X*PVECSQ(I))/SQRT(BUFF)) + ENDIF + ELSE + RES=RES + FACTOR*SQRT(BUFF) + ENDIF + ENDDO + + 800 CONTINUE + + END + diff --git a/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/loop_CT_calls_1.f b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/loop_CT_calls_1.f new file mode 100644 index 0000000000..6664064c8e --- /dev/null +++ b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/loop_CT_calls_1.f @@ -0,0 +1,151 @@ + SUBROUTINE ML5_0_LOOP_CT_CALLS_1(P,NHEL,H,IC) +C +C Modules +C + USE ML5_0_POLYNOMIAL_CONSTANTS + USE ALOHA_OBJECT +C + IMPLICIT NONE +C +C CONSTANTS +C + INTEGER NEXTERNAL + PARAMETER (NEXTERNAL=4) + INTEGER NCOMB + PARAMETER (NCOMB=4) + INTEGER NLOOPS, NLOOPGROUPS, NCTAMPS + PARAMETER (NLOOPS=16, NLOOPGROUPS=16, NCTAMPS=4) + INTEGER NLOOPAMPS + PARAMETER (NLOOPAMPS=20) + INTEGER NWAVEFUNCS,NLOOPWAVEFUNCS + PARAMETER (NWAVEFUNCS=5,NLOOPWAVEFUNCS=40) + REAL*8 ZERO + PARAMETER (ZERO=0D0) + REAL*16 MP__ZERO + PARAMETER (MP__ZERO=0.0E0_16) +C These are constants related to the split orders + INTEGER NSO, NSQUAREDSO, NAMPSO + PARAMETER (NSO=0, NSQUAREDSO=0, NAMPSO=0) +C +C ARGUMENTS +C + REAL*8 P(0:3,NEXTERNAL) + INTEGER NHEL(NEXTERNAL), IC(NEXTERNAL) + INTEGER H +C +C LOCAL VARIABLES +C + INTEGER I,J,K + INTEGER FLAVOR(NEXTERNAL) + DATA FLAVOR /NEXTERNAL*1/ + COMPLEX*16 COEFS(MAXLWFSIZE,0:VERTEXMAXCOEFS-1,MAXLWFSIZE) + + LOGICAL DUMMYFALSE + DATA DUMMYFALSE/.FALSE./ +C +C GLOBAL VARIABLES +C + + INCLUDE 'coupl.inc' + INCLUDE 'mp_coupl.inc' + + INTEGER HELOFFSET + INTEGER GOODHEL(NCOMB) + LOGICAL GOODAMP(NSQUAREDSO,NLOOPGROUPS) + COMMON/ML5_0_FILTERS/GOODAMP,GOODHEL,HELOFFSET + + LOGICAL CHECKPHASE + LOGICAL HELDOUBLECHECKED + COMMON/ML5_0_INIT/CHECKPHASE, HELDOUBLECHECKED + + INTEGER SQSO_TARGET + COMMON/ML5_0_SOCHOICE/SQSO_TARGET + + LOGICAL UVCT_REQ_SO_DONE,MP_UVCT_REQ_SO_DONE,CT_REQ_SO_DONE + $ ,MP_CT_REQ_SO_DONE,LOOP_REQ_SO_DONE,MP_LOOP_REQ_SO_DONE + $ ,CTCALL_REQ_SO_DONE,FILTER_SO + COMMON/ML5_0_SO_REQS/UVCT_REQ_SO_DONE,MP_UVCT_REQ_SO_DONE + $ ,CT_REQ_SO_DONE,MP_CT_REQ_SO_DONE,LOOP_REQ_SO_DONE + $ ,MP_LOOP_REQ_SO_DONE,CTCALL_REQ_SO_DONE,FILTER_SO + + INTEGER I_SO + COMMON/ML5_0_I_SO/I_SO + INTEGER I_LIB + COMMON/ML5_0_I_LIB/I_LIB + + TYPE(ALOHA) W(NWAVEFUNCS) + COMMON/ML5_0_W/W + COMPLEX*16 WL(MAXLWFSIZE,0:LOOPMAXCOEFS-1,MAXLWFSIZE, + $ -1:NLOOPWAVEFUNCS) + COMPLEX*16 PL(0:3,-1:NLOOPWAVEFUNCS) + COMMON/ML5_0_WL/WL,PL + + COMPLEX*16 AMPL(3,NLOOPAMPS) + COMMON/ML5_0_AMPL/AMPL + +C +C ---------- +C BEGIN CODE +C ---------- + +C The target squared split order contribution is already reached +C if true. + IF (FILTER_SO.AND.CTCALL_REQ_SO_DONE) THEN + GOTO 1001 + ENDIF + +C CutTools call for loop # 1 + CALL ML5_0_LOOP_4(1,2,4,3,DCMPLX(MDL_MB),DCMPLX(MDL_MB) + $ ,DCMPLX(MDL_MB),DCMPLX(MDL_MB),4,I_SO,1) +C CutTools call for loop # 2 + CALL ML5_0_LOOP_4(1,2,3,4,DCMPLX(MDL_MB),DCMPLX(MDL_MB) + $ ,DCMPLX(MDL_MB),DCMPLX(MDL_MB),4,I_SO,2) +C CutTools call for loop # 3 + CALL ML5_0_LOOP_3(1,2,5,DCMPLX(MDL_MB),DCMPLX(MDL_MB) + $ ,DCMPLX(MDL_MB),3,I_SO,3) +C CutTools call for loop # 4 + CALL ML5_0_LOOP_3(1,2,5,DCMPLX(MDL_MB),DCMPLX(MDL_MB) + $ ,DCMPLX(MDL_MB),3,I_SO,4) +C CutTools call for loop # 5 + CALL ML5_0_LOOP_4(1,2,4,3,DCMPLX(MDL_MB),DCMPLX(MDL_MB) + $ ,DCMPLX(MDL_MB),DCMPLX(MDL_MB),4,I_SO,5) +C CutTools call for loop # 6 + CALL ML5_0_LOOP_4(1,3,2,4,DCMPLX(MDL_MB),DCMPLX(MDL_MB) + $ ,DCMPLX(MDL_MB),DCMPLX(MDL_MB),4,I_SO,6) +C CutTools call for loop # 7 + CALL ML5_0_LOOP_4(1,2,3,4,DCMPLX(MDL_MB),DCMPLX(MDL_MB) + $ ,DCMPLX(MDL_MB),DCMPLX(MDL_MB),4,I_SO,7) +C CutTools call for loop # 8 + CALL ML5_0_LOOP_4(1,3,2,4,DCMPLX(MDL_MB),DCMPLX(MDL_MB) + $ ,DCMPLX(MDL_MB),DCMPLX(MDL_MB),4,I_SO,8) +C CutTools call for loop # 9 + CALL ML5_0_LOOP_4(1,2,4,3,DCMPLX(MDL_MT),DCMPLX(MDL_MT) + $ ,DCMPLX(MDL_MT),DCMPLX(MDL_MT),4,I_SO,9) +C CutTools call for loop # 10 + CALL ML5_0_LOOP_4(1,2,3,4,DCMPLX(MDL_MT),DCMPLX(MDL_MT) + $ ,DCMPLX(MDL_MT),DCMPLX(MDL_MT),4,I_SO,10) +C CutTools call for loop # 11 + CALL ML5_0_LOOP_3(1,2,5,DCMPLX(MDL_MT),DCMPLX(MDL_MT) + $ ,DCMPLX(MDL_MT),3,I_SO,11) +C CutTools call for loop # 12 + CALL ML5_0_LOOP_3(1,2,5,DCMPLX(MDL_MT),DCMPLX(MDL_MT) + $ ,DCMPLX(MDL_MT),3,I_SO,12) +C CutTools call for loop # 13 + CALL ML5_0_LOOP_4(1,2,4,3,DCMPLX(MDL_MT),DCMPLX(MDL_MT) + $ ,DCMPLX(MDL_MT),DCMPLX(MDL_MT),4,I_SO,13) +C CutTools call for loop # 14 + CALL ML5_0_LOOP_4(1,3,2,4,DCMPLX(MDL_MT),DCMPLX(MDL_MT) + $ ,DCMPLX(MDL_MT),DCMPLX(MDL_MT),4,I_SO,14) +C CutTools call for loop # 15 + CALL ML5_0_LOOP_4(1,2,3,4,DCMPLX(MDL_MT),DCMPLX(MDL_MT) + $ ,DCMPLX(MDL_MT),DCMPLX(MDL_MT),4,I_SO,15) +C CutTools call for loop # 16 + CALL ML5_0_LOOP_4(1,3,2,4,DCMPLX(MDL_MT),DCMPLX(MDL_MT) + $ ,DCMPLX(MDL_MT),DCMPLX(MDL_MT),4,I_SO,16) + + GOTO 1001 + 5000 CONTINUE + CTCALL_REQ_SO_DONE=.TRUE. + 1001 CONTINUE + END + diff --git a/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/loop_matrix.f b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/loop_matrix.f new file mode 100644 index 0000000000..89351a85ff --- /dev/null +++ b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/loop_matrix.f @@ -0,0 +1,3213 @@ +C --=========================================-- +C Main subroutine +C --=========================================-- + + SUBROUTINE ML5_0_SLOOPMATRIX(P_USER,ANS) +C +C Generated by MadGraph5_aMC@NLO v. %(version)s, %(date)s +C By the MadGraph5_aMC@NLO Development Team +C Visit launchpad.net/madgraph5 and amcatnlo.web.cern.ch +C +C Returns amplitude squared summed/avg over colors +C and helicities for the point in phase space P(0:3,NEXTERNAL) +C and external lines W(0:6,NEXTERNAL) +C +C Process: g g > h h QCD<=2 QED<=2 [ sqrvirt = QCD ] +C +C Modules +C + USE ML5_0_POLYNOMIAL_CONSTANTS + USE ALOHA_OBJECT +C + IMPLICIT NONE +C +C USER CUSTOMIZABLE OPTIONS +C +C The variables below are just used in the context of a JAMP +C consistency check turned off by default. + REAL*8 JAMP_DOUBLECHECK_THRES + PARAMETER (JAMP_DOUBLECHECK_THRES=1.0D-9) + LOGICAL DIRECT_ME_COMPUTATION, ME_COMPUTATION_FROM_JAMP +C Modify the logicals below to chose how the ME must be computed +C DIRECT_ME_COMPUTATION = Each loop amplitude is squared +C individually against all amplitudes with its own color factor. +C ME_COMPUTATION_FROM_JAMP = Amplitudes are first projected onto +C color flows (many less of them) which are then squared to form +C the ME. +C When setting both computation method to .TRUE., their systematic +C comparisons will be printed out. + DATA DIRECT_ME_COMPUTATION/.FALSE./ +C When using this MadLoop output for integration with MadEvent, +C ME_COMPUTATION_FROM_JAMP *must* be set to .True. because it is +C necessary to compute the AMP2 setting up the multichanneling. + DATA ME_COMPUTATION_FROM_JAMP/.TRUE./ +C This parameter is designed for the check timing command of MG5. +C It skips the loop reduction. + LOGICAL SKIPLOOPEVAL + PARAMETER (SKIPLOOPEVAL=.FALSE.) +C For timing checks. Stops the code after having only initialized +C its arrays from the external data files + LOGICAL BOOTANDSTOP + PARAMETER (BOOTANDSTOP=.FALSE.) + INTEGER TIR_CACHE_SIZE +C To change memory foot-print of MadLoop, you can change this +C parameter to be 0,1 or 2 *and recompile*. +C Notice that this will impact MadLoop speed performances in the +C context of stability checks. + INCLUDE 'tir_cache_size.inc' +C +C CONSTANTS +C + CHARACTER*512 PARAMFNAME,HELCONFIGFNAME,LOOPFILTERFNAME + CHARACTER*512 COLORNUMFNAME,COLORDENOMFNAME, HELFILTERFNAME + CHARACTER*512 PROC_PREFIX + PARAMETER ( PARAMFNAME='MadLoopParams.dat') + PARAMETER ( HELCONFIGFNAME='HelConfigs.dat') + PARAMETER ( LOOPFILTERFNAME='LoopFilter.dat') + PARAMETER ( HELFILTERFNAME='HelFilter.dat') + PARAMETER ( COLORNUMFNAME='ColorNumFactors.dat') + PARAMETER ( COLORDENOMFNAME='ColorDenomFactors.dat') + PARAMETER ( PROC_PREFIX='ML5_0_') + + INTEGER NLOOPS, NLOOPGROUPS, NCTAMPS + PARAMETER (NLOOPS=16, NLOOPGROUPS=16, NCTAMPS=4) + INTEGER NLOOPAMPS + PARAMETER (NLOOPAMPS=20) + INTEGER NCOLORROWS + PARAMETER (NCOLORROWS=NLOOPAMPS) + INTEGER NEXTERNAL + PARAMETER (NEXTERNAL=4) + INTEGER NINITIAL + PARAMETER (NINITIAL=2) + INTEGER NWAVEFUNCS,NLOOPWAVEFUNCS + PARAMETER (NWAVEFUNCS=5,NLOOPWAVEFUNCS=40) + INTEGER NCOMB + PARAMETER (NCOMB=4) + REAL*8 ZERO + PARAMETER (ZERO=0D0) + REAL*16 MP__ZERO + PARAMETER (MP__ZERO=0E0_16) + COMPLEX*16 IMAG1 + PARAMETER (IMAG1=(0D0,1D0)) +C These are constants related to the split orders + INTEGER NSQSO_BORN + PARAMETER (NSQSO_BORN=0) + + INTEGER NSO, NSQUAREDSO, NAMPSO + PARAMETER (NSO=0, NSQUAREDSO=0, NAMPSO=0) + INTEGER ANS_DIMENSION + PARAMETER(ANS_DIMENSION=MAX(NSQSO_BORN,NSQUAREDSO)) + INTEGER NSQSOXNLG + PARAMETER (NSQSOXNLG=NSQUAREDSO*NLOOPGROUPS) + INTEGER NSQUAREDSOP1 + PARAMETER (NSQUAREDSOP1=NSQUAREDSO+1) +C The total number of loop reduction libraries +C At present, there are only +C CutTools,PJFry++,IREGI,Golem95,Samurai, Ninja and COLLIER + INTEGER NLOOPLIB + PARAMETER (NLOOPLIB=7) +C Only CutTools or possibly Ninja (if installed with qp support) +C provide QP + INTEGER QP_NLOOPLIB + PARAMETER (QP_NLOOPLIB=1) + INTEGER MAXSTABILITYLENGTH + DATA MAXSTABILITYLENGTH/20/ + COMMON/ML5_0_STABILITY_TESTS/MAXSTABILITYLENGTH + +C +C ARGUMENTS +C + REAL*8 P_USER(0:3,NEXTERNAL) +C +C The zeroth component of the second dimension is the result +C summed over all +C contributing split orders. The zeroth component of the first one +C is the Born. +C Notice that the upper bound of the second integer is not number +C of squared orders +C combination for the loops but the maximum between this number +C for the Born +C contributions and the loop ones. There are some cases for which +C the Born contrib. +C has squared split order contributions than the loop does. For +C example +C +C generate u u~ > d d~ QCD^2<=2 QED^2<=99 [virt=QCD] +C +C It is however somehow academical. This is why ANS_DIMENSION is +C not just NSQSO but rather MAX(NSQSO,NSQSO_BORN) +C + REAL*8 ANS(0:3,0:ANS_DIMENSION) +C +C LOCAL VARIABLES +C + INTEGER I,J,K,L,H,HEL_MULT,I_QP_LIB,DUMMY, INDEX_H + + CHARACTER*512 PARAMFN,HELCONFIGFN,LOOPFILTERFN,COLORNUMFN + $ ,COLORDENOMFN,HELFILTERFN + CHARACTER*512 TMP + SAVE PARAMFN + SAVE HELCONFIGFN + SAVE LOOPFILTERFN + SAVE COLORNUMFN + SAVE COLORDENOMFN + SAVE HELFILTERFN + + INTEGER CTMODEINIT_BU + REAL*8 MLSTABTHRES_BU + INTEGER NEWHELREF + LOGICAL HEL_INCONSISTENT + REAL*8 P(0:3,NEXTERNAL) +C DP_RES STORES THE DOUBLE PRECISION RESULT OBTAINED FROM +C DIFFERENT EVALUATION METHODS IN ORDER TO ASSESS STABILITY. +C THE STAB_STAGE COUNTER I CORRESPONDANCE GOES AS FOLLOWS +C I=1 -> ORIGINAL PS, CTMODE=1 +C I=2 -> ORIGINAL PS, CTMODE=2, (ONLY WITH CTMODERUN=-1) +C I=3 -> PS WITH ROTATION 1, CTMODE=1, (ONLY WITH CTMODERUN=-2) +C I=4 -> PS WITH ROTATION 2, CTMODE=1, (ONLY WITH CTMODERUN=-3) +C I=5 -> POSSIBLY MORE EVALUATION METHODS IN THE FUTURE, MAX IS +C MAXSTABILITYLENGTH +C IF UNSTABLE IT GOES TO THE SAME PATTERN BUT STAB_INDEX IS THEN +C I+20. + LOGICAL EVAL_DONE(MAXSTABILITYLENGTH) + LOGICAL DOING_QP_EVALS + INTEGER STAB_INDEX,BASIC_CT_MODE + +C This is used for loop-induced where the reference scale for +C comparisons is inferred from the first 100 points at most +C (notice that the weight of a given kinematic configuration can +C appear more than once because of the stability tests). +C When changing this parameter, make sure to correspondingly +C update the parameter with the same name in MadLoopCommons.f. + INTEGER MAXNREF_EVALS + PARAMETER (MAXNREF_EVALS=100) + REAL*8 REF_EVALS(MAXNREF_EVALS) + DATA REF_EVALS/MAXNREF_EVALS*ZERO/ + INTEGER NPSPOINTS + DATA NPSPOINTS/0/ + + REAL*8 ACC(0:NSQUAREDSO) + REAL*8 DP_RES(3,0:NSQUAREDSO,MAXSTABILITYLENGTH) +C QP_RES STORES THE QUADRUPLE PRECISION RESULT OBTAINED FROM +C DIFFERENT EVALUATION METHODS IN ORDER TO ASSESS STABILITY. + REAL*8 QP_RES(3,0:NSQUAREDSO,MAXSTABILITYLENGTH) + INTEGER NHEL(NEXTERNAL), IC(NEXTERNAL) + INTEGER NATTEMPTS + DATA NATTEMPTS/0/ + DATA IC/NEXTERNAL*1/ + REAL*8 HELSAVED(3,NCOMB) + INTEGER ITEMP + LOGICAL LTEMP + REAL*8 BORNBUFF(0:NSQSO_BORN),TMPR + LOGICAL POLES_COMPUTED, DO_POLE_CHECK + REAL*8 BUFFR(3,0:NSQUAREDSO),BUFFR_BIS(3,0:NSQUAREDSO),TEMP(0:3 + $ ,0:NSQUAREDSO),TEMP1(0:NSQUAREDSO) + COMPLEX*16 CTEMP + REAL*8 TEMP2(3) + REAL*8 BUFFRES(0:3,0:NSQUAREDSO) + COMPLEX*16 COEFS(MAXLWFSIZE,0:VERTEXMAXCOEFS-1,MAXLWFSIZE) + COMPLEX*16 CFTOT + LOGICAL FOUNDHELFILTER,FOUNDLOOPFILTER + DATA FOUNDHELFILTER/.TRUE./ + DATA FOUNDLOOPFILTER/.TRUE./ + LOGICAL LOOPFILTERBUFF(NSQUAREDSO,NLOOPGROUPS) + DATA ((LOOPFILTERBUFF(J,I),J=1,NSQUAREDSO),I=1,NLOOPGROUPS) + $ /NSQSOXNLG*.FALSE./ + + LOGICAL AUTOMATIC_CACHE_CLEARING + DATA AUTOMATIC_CACHE_CLEARING/.TRUE./ + COMMON/ML5_0_RUNTIME_OPTIONS/AUTOMATIC_CACHE_CLEARING + + INTEGER IDEN + DATA IDEN/512/ + INTEGER HELAVGFACTOR + DATA HELAVGFACTOR/4/ +C For a 1>N process, them BEAMTWO_HELAVGFACTOR would be set to 1. + INTEGER BEAMS_HELAVGFACTOR(2) + DATA (BEAMS_HELAVGFACTOR(I),I=1,2)/2,2/ + LOGICAL DONEHELDOUBLECHECK + DATA DONEHELDOUBLECHECK/.FALSE./ + INTEGER NEPS + DATA NEPS/0/ +C Below are variables to bypass the checkphase and insure +C stability check to take place + LOGICAL OLD_CHECKPHASE, OLD_HELDOUBLECHECKED + INTEGER OLD_GOODHEL(NCOMB) + LOGICAL OLD_GOODAMP(NSQUAREDSO,NLOOPGROUPS) + LOGICAL BYPASS_CHECK, ALWAYS_TEST_STABILITY + COMMON/ML5_0_BYPASS_CHECK/BYPASS_CHECK, ALWAYS_TEST_STABILITY +C +C FUNCTIONS +C + INTEGER ML5_0_TIRCACHE_INDEX + INTEGER ML5_0_ML5SOINDEX_FOR_BORN_AMP + INTEGER ML5_0_ML5SOINDEX_FOR_LOOP_AMP + INTEGER ML5_0_ML5SQSOINDEX + INTEGER ML5_0_ISSAME + LOGICAL ML5_0_ISZERO + LOGICAL ML5_0_IS_HEL_SELECTED + INTEGER SET_RET_CODE_U + REAL*8 MEDIAN +C +C GLOBAL VARIABLES +C + INCLUDE 'process_info.inc' + INCLUDE 'unique_id.inc' + + INCLUDE 'coupl.inc' + INCLUDE 'mp_coupl.inc' + INCLUDE 'MadLoopParams.inc' + + REAL*8 RES_FROM_JAMP(0:3,0:NSQUAREDSO) + COMMON/ML5_0_DOUBLECHECK_JAMP/RES_FROM_JAMP + $ ,DIRECT_ME_COMPUTATION,ME_COMPUTATION_FROM_JAMP + + LOGICAL CHOSEN_SO_CONFIGS(NSQUAREDSO) + DATA CHOSEN_SO_CONFIGS// + COMMON/ML5_0_CHOSEN_LOOP_SQSO/CHOSEN_SO_CONFIGS + + INTEGER N_DP_EVAL, N_QP_EVAL + DATA N_DP_EVAL/1/ + DATA N_QP_EVAL/1/ + COMMON/ML5_0_N_EVALS/N_DP_EVAL,N_QP_EVAL + + LOGICAL CHECKPHASE + DATA CHECKPHASE/.TRUE./ + LOGICAL HELDOUBLECHECKED + DATA HELDOUBLECHECKED/.FALSE./ + COMMON/ML5_0_INIT/CHECKPHASE, HELDOUBLECHECKED + INTEGER NTRY + DATA NTRY/0/ + REAL*8 REF + DATA REF/0.0D0/ + + LOGICAL MP_DONE + DATA MP_DONE/.FALSE./ + COMMON/ML5_0_MP_DONE/MP_DONE +C A FLAG TO DENOTE WHETHER THE CORRESPONDING LOOPLIBS ARE +C AVAILABLE OR NOT + LOGICAL LOOPLIBS_AVAILABLE(NLOOPLIB) + DATA LOOPLIBS_AVAILABLE/.TRUE.,.FALSE.,.FALSE.,.FALSE.,.FALSE. + $ ,.FALSE.,.FALSE./ + COMMON/ML5_0_LOOPLIBS_AV/ LOOPLIBS_AVAILABLE +C A FLAG TO DENOTE WHETHER THE CORRESPONDING DIRECTION TESTS +C AVAILABLE OR NOT IN THE LOOPLIBS + LOGICAL LOOPLIBS_DIRECTEST(NLOOPLIB) + DATA LOOPLIBS_DIRECTEST /.TRUE.,.TRUE.,.TRUE.,.TRUE.,.TRUE. + $ ,.TRUE.,.TRUE./ +C Specifying for which reduction tool quadruple precision is +C available. +C The index 0 is dummy and simply means that the corresponding +C loop_library is not available +C in which case neither is its quadruple precision version. + LOGICAL LOOPLIBS_QPAVAILABLE(0:7) + DATA LOOPLIBS_QPAVAILABLE /.FALSE.,.TRUE.,.FALSE.,.FALSE. + $ ,.FALSE.,.FALSE.,.FALSE.,.FALSE./ +C PS CAN POSSIBILY BE PASSED THROUGH IMPROVE_PS BUT IS NOT +C MODIFIED FOR THE PURPOSE OF THE STABILITY TEST +C EVEN THOUGH THEY ARE PUT IN COMMON BLOCK, FOR NOW THEY ARE NOT +C USED ANYWHERE ELSE + REAL*8 PS(0:3,NEXTERNAL) + COMMON/ML5_0_PSPOINT/PS +C AGAIN BELOW, MP_PS IS THE FIXED (POSSIBLY IMPROVED) MP PS POINT +C AND MP_P IS THE ONE WHICH CAN BE MODIFIED (I.E. ROTATED ETC.) +C FOR STABILITY PURPOSE + REAL*16 MP_PS(0:3,NEXTERNAL),MP_P(0:3,NEXTERNAL) + COMMON/ML5_0_MP_PSPOINT/MP_PS,MP_P + + REAL*8 LSCALE + INTEGER CTMODE + COMMON/ML5_0_CT/LSCALE,CTMODE + LOGICAL MP_PS_SET + DATA MP_PS_SET/.FALSE./ + +C The parameter below sets the convention for the helicity filter +C For a given helicity, the attached integer 'i' means +C 'i' in ]-inf;-HELOFFSET[ -> Helicity is equal, up to a sign, to +C helicity number abs(i+HELOFFSET) +C 'i' == -HELOFFSET -> Helicity is analytically zero +C 'i' in ]-HELOFFSET,inf[ -> Helicity is contributing with weight +C 'i'. If it is zero, it is skipped. +C Typically, the hel_offset is 10000 + INTEGER HELOFFSET + DATA HELOFFSET/10000/ + INTEGER GOODHEL(NCOMB) + LOGICAL GOODAMP(NSQUAREDSO,NLOOPGROUPS) + COMMON/ML5_0_FILTERS/GOODAMP,GOODHEL,HELOFFSET + + INTEGER HELPICKED + DATA HELPICKED/-1/ + COMMON/ML5_0_HELCHOICE/HELPICKED + INTEGER USERHEL + DATA USERHEL/-1/ + COMMON/ML5_0_USERCHOICE/USERHEL + +C This integer can be accessed by an external user to set its +C target squared split order. +C If set to a value different than -1, the code will try to avoid +C computing anything which +C does not contribute to contributions of squared split orders +C SQSO_TARGET and below. + INTEGER SQSO_TARGET + DATA SQSO_TARGET/-1/ + COMMON/ML5_0_SOCHOICE/SQSO_TARGET +C The following logical are used to broadcast the fact that the +C target 'required' CT and +C loop split orders contributions have been reached already and +C the rest can be skipped. + LOGICAL UVCT_REQ_SO_DONE,MP_UVCT_REQ_SO_DONE,CT_REQ_SO_DONE + $ ,MP_CT_REQ_SO_DONE,LOOP_REQ_SO_DONE,MP_LOOP_REQ_SO_DONE + $ ,CTCALL_REQ_SO_DONE,FILTER_SO + DATA UVCT_REQ_SO_DONE/.FALSE./ + DATA MP_UVCT_REQ_SO_DONE/.FALSE./ + DATA CT_REQ_SO_DONE/.FALSE./ + DATA MP_CT_REQ_SO_DONE/.FALSE./ + DATA LOOP_REQ_SO_DONE/.FALSE./ + DATA MP_LOOP_REQ_SO_DONE/.FALSE./ + DATA CTCALL_REQ_SO_DONE/.FALSE./ + DATA FILTER_SO/.FALSE./ + COMMON/ML5_0_SO_REQS/UVCT_REQ_SO_DONE,MP_UVCT_REQ_SO_DONE + $ ,CT_REQ_SO_DONE,MP_CT_REQ_SO_DONE,LOOP_REQ_SO_DONE + $ ,MP_LOOP_REQ_SO_DONE,CTCALL_REQ_SO_DONE,FILTER_SO + +C Allows to forbid the zero helicity double check, no matter the +C value in MadLoopParams.dat +C This can be accessed with the SET_FORBID_HEL_DOUBLECHECK +C subroutine of MadLoopCommons.dat + LOGICAL FORBID_HEL_DOUBLECHECK + COMMON/FORBID_HEL_DOUBLECHECK/FORBID_HEL_DOUBLECHECK + + INTEGER I_SO + DATA I_SO/1/ + COMMON/ML5_0_I_SO/I_SO + INTEGER I_LIB + DATA I_LIB/1/ + COMMON/ML5_0_I_LIB/I_LIB + LOGICAL QP_TOOLS_AVAILABLE + DATA QP_TOOLS_AVAILABLE/.FALSE./ + INTEGER INDEX_QP_TOOLS(QP_NLOOPLIB+1) + COMMON/ML5_0_LOOP_TOOLS/QP_TOOLS_AVAILABLE,INDEX_QP_TOOLS + + TYPE(ALOHA) W(NWAVEFUNCS) + COMMON/ML5_0_W/W + + TYPE(MP_ALOHA) MPW(NWAVEFUNCS) + COMMON/ML5_0_MP_W/MPW + + COMPLEX*16 WL(MAXLWFSIZE,0:LOOPMAXCOEFS-1,MAXLWFSIZE, + $ -1:NLOOPWAVEFUNCS) + COMPLEX*16 PL(0:3,-1:NLOOPWAVEFUNCS) + COMMON/ML5_0_WL/WL,PL + + COMPLEX*16 LOOPCOEFS(0:LOOPMAXCOEFS-1,NLOOPGROUPS) + COMMON/ML5_0_LCOEFS/LOOPCOEFS + +C This flag is used to prevent the re-computation of the OpenLoop +C coefficients when changing the CTMode for the stability test. + LOGICAL SKIP_LOOPNUM_COEFS_CONSTRUCTION + DATA SKIP_LOOPNUM_COEFS_CONSTRUCTION/.FALSE./ + COMMON/ML5_0_SKIP_COEFS/SKIP_LOOPNUM_COEFS_CONSTRUCTION + + LOGICAL TIR_DONE(NLOOPGROUPS) + COMMON/ML5_0_TIRCACHING/TIR_DONE + + COMPLEX*16 AMPL(3,NLOOPAMPS) + COMMON/ML5_0_AMPL/AMPL + + COMPLEX*16 LOOPRES(3,NSQUAREDSO,NLOOPGROUPS) + LOGICAL S(NSQUAREDSO,NLOOPGROUPS) + COMMON/ML5_0_LOOPRES/LOOPRES,S + + INTEGER CF_D(NCOLORROWS,NLOOPAMPS) + INTEGER CF_N(NCOLORROWS,NLOOPAMPS) + COMMON/ML5_0_CF/CF_D,CF_N + + INTEGER HELC(NEXTERNAL,NCOMB) + COMMON/ML5_0_HELCONFIGS/HELC + + REAL*8 PREC,USER_STAB_PREC + DATA USER_STAB_PREC/-1.0D0/ + COMMON/ML5_0_USER_STAB_PREC/USER_STAB_PREC + +C Return codes H,T,U correspond to the hundreds, tens and units +C building returncode, i.e. +C RETURNCODE=100*RET_CODE_H+10*RET_CODE_T+RET_CODE_U + + INTEGER RET_CODE_H,RET_CODE_T,RET_CODE_U + REAL*8 ACCURACY(0:NSQUAREDSO) + DATA (ACCURACY(I),I=0,NSQUAREDSO)/NSQUAREDSOP1*1.0D0/ + DATA RET_CODE_H,RET_CODE_T,RET_CODE_U/1,1,0/ + COMMON/ML5_0_ACC/ACCURACY,RET_CODE_H,RET_CODE_T,RET_CODE_U + + LOGICAL MP_DONE_ONCE + DATA MP_DONE_ONCE/.FALSE./ + COMMON/ML5_0_MP_DONE_ONCE/MP_DONE_ONCE + + CHARACTER(512) MLPATH + COMMON/MLPATH/MLPATH + +C This is just so that if the user disabled the computation of +C poles by COLLIER +C using the MadLoop subroutine, we don't overwrite his choice when +C reading the parameters + LOGICAL FORCED_CHOICE_OF_COLLIER_UV_POLE_COMPUTATION, + $ FORCED_CHOICE_OF_COLLIER_IR_POLE_COMPUTATION + LOGICAL COLLIER_UV_POLE_COMPUTATION_CHOICE, + $ COLLIER_IR_POLE_COMPUTATION_CHOICE + DATA FORCED_CHOICE_OF_COLLIER_UV_POLE_COMPUTATION + $ ,FORCED_CHOICE_OF_COLLIER_IR_POLE_COMPUTATION/.FALSE.,.FALSE./ + COMMON/ML5_0_COLLIERPOLESFORCEDCHOICE + $ /FORCED_CHOICE_OF_COLLIER_UV_POLE_COMPUTATION, + $ FORCED_CHOICE_OF_COLLIER_IR_POLE_COMPUTATION + $ ,COLLIER_UV_POLE_COMPUTATION_CHOICE + $ ,COLLIER_IR_POLE_COMPUTATION_CHOICE + +C This variable controls the general initialization which is +C *common* between all MadLoop SubProcesses. +C For example setting the MadLoopPath or reading the ML runtime +C parameters. + LOGICAL ML_INIT + COMMON/ML_INIT/ML_INIT + +C This variable controls the *local* initialization of this +C particular SubProcess. +C For example, the reading of the filters must be done +C independently by each SubProcess. + LOGICAL LOCAL_ML_INIT + DATA LOCAL_ML_INIT/.TRUE./ + + LOGICAL WARNED_LORENTZ_STAB_TEST_OFF + DATA WARNED_LORENTZ_STAB_TEST_OFF/.FALSE./ + INTEGER NROTATIONS_DP_BU,NROTATIONS_QP_BU + + LOGICAL FPE_IN_DP_REDUCTION, FPE_IN_QP_REDUCTION + DATA FPE_IN_DP_REDUCTION, FPE_IN_QP_REDUCTION/.FALSE.,.FALSE./ + COMMON/ML5_0_FPE_IN_REDUCTION/FPE_IN_DP_REDUCTION, + $ FPE_IN_QP_REDUCTION + +C This array specify potential special requirements on the +C helicities to +C consider. POLARIZATIONS(0,0) is -1 if there is not such +C requirement. + INTEGER POLARIZATIONS(0:NEXTERNAL,0:5) + COMMON/ML5_0_BEAM_POL/POLARIZATIONS + +C ---------- +C BEGIN CODE +C ---------- + + IF(ML_INIT) THEN + ML_INIT = .FALSE. + CALL PRINT_MADLOOP_BANNER() + TMP = 'auto' + CALL SETMADLOOPPATH(TMP) + CALL JOINPATH(MLPATH,PARAMFNAME,PARAMFN) + CALL MADLOOPPARAMREADER(PARAMFN,.TRUE.) + IF (FORCED_CHOICE_OF_COLLIER_UV_POLE_COMPUTATION) THEN + COLLIERCOMPUTEUVPOLES = COLLIER_UV_POLE_COMPUTATION_CHOICE + ENDIF + IF (FORCED_CHOICE_OF_COLLIER_IR_POLE_COMPUTATION) THEN + COLLIERCOMPUTEIRPOLES = COLLIER_IR_POLE_COMPUTATION_CHOICE + ENDIF + IF (FORBID_HEL_DOUBLECHECK) THEN + DOUBLECHECKHELICITYFILTER = .FALSE. + ENDIF + +C Make sure that HELFILTERLEVEL is at most 1 if the beam is +C polarized + IF (POLARIZATIONS(0,0).EQ.0) THEN + IF (HELICITYFILTERLEVEL.GT.1) THEN + WRITE(*,*) '##INFO: When using polarized beam, the' + $ //' helicity filter of MadLoop can be at most 1. Now' + $ //' setting HELICITYFILTERLEVEL to 1.' + HELICITYFILTERLEVEL = 1 + ENDIF + ENDIF + + IF(.NOT.LOOPINITSTARTOVER) THEN + WRITE(*,*) '##INFO: For loop-induced processes it is' + $ //' preferable to always set the parameter' + $ //' LoopInitStartOver to True, so it is hard-set here to' + $ //' True.' + LOOPINITSTARTOVER=.TRUE. + ENDIF + IF(.NOT.HELINITSTARTOVER) THEN + WRITE(*,*) '##INFO: For loop-induced processes it is' + $ //' preferable to always set the parameter HelInitStartOver' + $ //' to True, so it is hard-set here to True.' + HELINITSTARTOVER=.TRUE. + ENDIF + IF (CHECKCYCLE.LT.5) THEN + WRITE(*,*) '##INFO: Due to the dynamic setting of the' + $ //' reference scale for contributions comparisons, it is' + $ //' preferable to set the parameter CheckCycle to a value' + $ //' larger than 4, so it is hard-set here to 5.' + CHECKCYCLE=5 + ENDIF + +C Make sure that NROTATIONS_QP and NROTATIONS_DP are set to zero +C if AUTOMATIC_CACHE_CLEARING is disabled. + IF(.NOT.AUTOMATIC_CACHE_CLEARING) THEN + IF(NROTATIONS_DP.NE.0.OR.NROTATIONS_QP.NE.0) THEN + WRITE(*,*) '##INFO: AUTOMATIC_CACHE_CLEARING is disabled,' + $ //' so MadLoop automatically resets NROTATIONS_DP and' + $ //' NROTATIONS_QP to 0.' + NROTATIONS_QP=0 + NROTATIONS_DP=0 + ENDIF + ENDIF + + ENDIF + + IF (LOCAL_ML_INIT) THEN + LOCAL_ML_INIT = .FALSE. + QP_TOOLS_AVAILABLE=.FALSE. + INDEX_QP_TOOLS(1:QP_NLOOPLIB+1)=0 +C SKIP THE ONES THAT NOT AVAILABLE + J=1 + DO I=1,NLOOPLIB + IF(MLREDUCTIONLIB(J).EQ.0)EXIT + IF(.NOT.LOOPLIBS_AVAILABLE(MLREDUCTIONLIB(J)))THEN + MLREDUCTIONLIB(J:NLOOPLIB-1)=MLREDUCTIONLIB(J+1:NLOOPLIB) + MLREDUCTIONLIB(NLOOPLIB)=0 + ELSE + J=J+1 + ENDIF + ENDDO + IF(MLREDUCTIONLIB(1).EQ.0)THEN + STOP 'No available loop reduction lib is provided. Make sure' + $ //' MLReductionLib is correct.' + ENDIF +C The poles must vanish here, but COLLIER can be asked not to +C compute them at all. + IF (MLPOLECHECKTHRES.GT.0.0D0.AND.MLREDUCTIONLIB(1) + $ .EQ.7.AND.(.NOT.COLLIERCOMPUTEUVPOLES.OR..NOT.COLLIERCOMPUTEIR + $POLES)) THEN + WRITE(*,*) '##INFO: The vanishing-pole check of this loop' + $ //'-induced process is inactive because COLLIER is not' + $ //' computing the poles. A madevent run turns them off on' + $ //' purpose and the card cannot override that; in a' + $ //' standalone run, set COLLIERComputeUVpoles and' + $ //' COLLIERComputeIRpoles to .TRUE. in MadLoopParams.dat.' + ENDIF + J=0 + DO I=1,NLOOPLIB + IF(LOOPLIBS_QPAVAILABLE(MLREDUCTIONLIB(I)))THEN + J=J+1 + IF(.NOT.QP_TOOLS_AVAILABLE) THEN + QP_TOOLS_AVAILABLE=.TRUE. + ENDIF + INDEX_QP_TOOLS(J)=I + ENDIF + ENDDO + +C Setup the file paths + CALL JOINPATH(MLPATH,PARAMFNAME,PARAMFN) + CALL JOINPATH(MLPATH,PROC_PREFIX,TMP) + CALL JOINPATH(TMP,HELCONFIGFNAME,HELCONFIGFN) + CALL JOINPATH(TMP,LOOPFILTERFNAME,LOOPFILTERFN) + CALL JOINPATH(TMP,COLORNUMFNAME,COLORNUMFN) + CALL JOINPATH(TMP,COLORDENOMFNAME,COLORDENOMFN) + CALL JOINPATH(TMP,HELFILTERFNAME,HELFILTERFN) + + CALL ML5_0_SET_N_EVALS(N_DP_EVAL,N_QP_EVAL) + +C Make sure that the loop filter is disabled when there is +C spin-2 particles for 2>1 or 1>2 processes + IF(MAX_SPIN_EXTERNAL_PARTICLE.GT.3.AND.(NEXTERNAL.LE.3.AND.HELI + $CITYFILTERLEVEL.NE.0)) THEN + WRITE(*,*) '##INFO: Helicity filter deactivated for 2>1' + $ //' processes involving spin 2 particles.' + HELICITYFILTERLEVEL = 0 +C We write a dummy filter for structural reasons here + OPEN(1, FILE=HELFILTERFN, ERR=6116, STATUS='NEW' + $ ,ACTION='WRITE') + DO I=1,NCOMB + WRITE(1,*) 1 + ENDDO + 6116 CONTINUE + CLOSE(1) + ENDIF + + OPEN(1, FILE=COLORNUMFN, ERR=104, STATUS='OLD', + $ ACTION='READ') + DO I=1,NCOLORROWS + READ(1,*,END=105) (CF_N(I,J),J=1,NLOOPAMPS) + ENDDO + GOTO 105 + 104 CONTINUE + STOP 'Color factors could not be initialized from file' + $ //' ML5_0_ColorNumFactors.dat. File not found' + 105 CONTINUE + CLOSE(1) + OPEN(1, FILE=COLORDENOMFN, ERR=106, STATUS='OLD', + $ ACTION='READ') + DO I=1,NCOLORROWS + READ(1,*,END=107) (CF_D(I,J),J=1,NLOOPAMPS) + ENDDO + GOTO 107 + 106 CONTINUE + STOP 'Color factors could not be initialized from file' + $ //' ML5_0_ColorDenomFactors.dat. File not found' + 107 CONTINUE + CLOSE(1) + OPEN(1, FILE=HELCONFIGFN, ERR=108, STATUS='OLD', + $ ACTION='READ') + DO H=1,NCOMB + READ(1,*,END=109) (HELC(I,H),I=1,NEXTERNAL) + ENDDO + GOTO 109 + 108 CONTINUE + STOP 'Color helictiy configurations could not be initialized' + $ //' from file ML5_0_HelConfigs.dat. File not found' + 109 CONTINUE + CLOSE(1) + +C SETUP OF THE COMMON STARTING EXTERNAL LOOP WAVEFUNCTION +C IT IS ALSO PS POINT INDEPENDENT, SO IT CAN BE DONE HERE. +C The index -1 is for the charge-conjugated fermions with +C flipped fermion flow. + DO I=0,3 + PL(I,-1)=DCMPLX(0.0D0,0.0D0) + PL(I,0)=DCMPLX(0.0D0,0.0D0) + ENDDO + DO I=1,MAXLWFSIZE + DO J=0,LOOPMAXCOEFS-1 + DO K=1,MAXLWFSIZE + WL(I,J,K,-1)=(0.0D0,0.0D0) + IF(I.EQ.K.AND.J.EQ.0) THEN + WL(I,J,K,0)=(1.0D0,0.0D0) + ELSE + WL(I,J,K,0)=(0.0D0,0.0D0) + ENDIF + ENDDO + ENDDO + ENDDO + IF(BOOTANDSTOP) THEN + WRITE(*,*) '##Stopped by user request.' + STOP + ENDIF + ENDIF + +C This is the chare conjugate version of the unit 4-currents in +C the canonical cartesian basis. +C This, for now, is only defined for 4-fermionic currents. + WL(1,0,2,-1) = DCMPLX(-1.0D0,0.0D0) + WL(2,0,1,-1) = DCMPLX(1.0D0,0.0D0) + WL(3,0,4,-1) = DCMPLX(1.0D0,0.0D0) + WL(4,0,3,-1) = DCMPLX(-1.0D0,0.0D0) + +C Make sure that lorentz rotation tests are not used if there is +C external loop wavefunction of spin 2 and that one specific +C helicity is asked + NROTATIONS_DP_BU = NROTATIONS_DP + NROTATIONS_QP_BU = NROTATIONS_QP + IF(MAX_SPIN_EXTERNAL_PARTICLE.GT.3.AND.USERHEL.NE.-1) THEN + IF(.NOT.WARNED_LORENTZ_STAB_TEST_OFF) THEN + WRITE(*,*) '##WARNING: Evaluation of a specific helicity was' + $ //' asked for this PS point, and there is a spin-2 (or' + $ //' higher) particle in the external states.' + WRITE(*,*) '##WARNING: As a result, MadLoop disabled the' + $ //' Lorentz rotation test for this phase-space point only.' + WRITE(*,*) '##WARNING: Further warning of that type' + $ //' suppressed.' + WARNED_LORENTZ_STAB_TEST_OFF = .TRUE. + ENDIF + NROTATIONS_QP=0 + NROTATIONS_DP=0 + CALL ML5_0_SET_N_EVALS(N_DP_EVAL,N_QP_EVAL) + ENDIF + + IF(NTRY.EQ.0) THEN + HELDOUBLECHECKED=(.NOT.DOUBLECHECKHELICITYFILTER) + $ .OR.(HELICITYFILTERLEVEL.EQ.0) + OPEN(1, FILE=LOOPFILTERFN, ERR=100, STATUS='OLD', + $ ACTION='READ') + DO J=1,NLOOPGROUPS + READ(1,*,END=101) (GOODAMP(I,J),I=1,NSQUAREDSO) + ENDDO + GOTO 101 + 100 CONTINUE + FOUNDLOOPFILTER=.FALSE. + DO J=1,NLOOPGROUPS + DO I=1,NSQUAREDSO + GOODAMP(I,J)=(.NOT.USELOOPFILTER) + ENDDO + ENDDO + 101 CONTINUE + CLOSE(1) + + IF (.NOT.USELOOPFILTER) THEN + DO J=1,NLOOPGROUPS + DO I=1,NSQUAREDSO + GOODAMP(I,J)=.TRUE. + ENDDO + ENDDO + ENDIF + + IF (HELICITYFILTERLEVEL.EQ.0) THEN + FOUNDHELFILTER=.TRUE. + DO J=1,NCOMB + GOODHEL(J)=1 + ENDDO + GOTO 122 + ENDIF + OPEN(1, FILE=HELFILTERFN, ERR=102, STATUS='OLD', + $ ACTION='READ') + DO I=1,NCOMB + READ(1,*,END=103) GOODHEL(I) + ENDDO + GOTO 103 + 102 CONTINUE + FOUNDHELFILTER=.FALSE. + DO J=1,NCOMB + GOODHEL(J)=1 + ENDDO + 103 CONTINUE + CLOSE(1) + IF (HELICITYFILTERLEVEL.EQ.1) THEN +C We must make sure to remove the matching-helicity +C optimisation, as requested by the user. + DO J=1,NCOMB + IF ((GOODHEL(J).GT.1).OR.(GOODHEL(J).LT.-HELOFFSET)) THEN + GOODHEL(J)=1 + ENDIF + ENDDO + ENDIF + 122 CONTINUE + ENDIF + +C The born is of course 0 for loop-induced processes. + DO I=0,NSQUAREDSO + ANS(0,I)=0.0D0 + ENDDO + +C For loop-induced, the reference for comparison is set later from +C the total contribution of the previous PS point considered. +C But you can edit here the value to be used for the first PS +C points. + IF (NPSPOINTS.EQ.0) THEN + REF=1.0D-50 + ELSE + IF(NPSPOINTS.GE.MAXNREF_EVALS) THEN + REF=MEDIAN(REF_EVALS,MAXNREF_EVALS) + ELSE + REF=MEDIAN(REF_EVALS,NPSPOINTS) + ENDIF + ENDIF + + MP_DONE=.FALSE. + MP_DONE_ONCE=.FALSE. + MP_PS_SET=.FALSE. + STAB_INDEX=0 + DOING_QP_EVALS=.FALSE. + EVAL_DONE(1)=.TRUE. + DO I=2,MAXSTABILITYLENGTH + EVAL_DONE(I)=.FALSE. + ENDDO + +C For loop-induced processes, we should make sure not to use the +C first points +C to set the filters because it doesn't have a reasonable REF +C scale yet. + IF(.NOT.BYPASS_CHECK.AND.NPSPOINTS.GE.1) THEN + NTRY=NTRY+1 + ENDIF + + IF (USER_STAB_PREC.GT.0.0D0) THEN + MLSTABTHRES_BU=MLSTABTHRES + MLSTABTHRES=USER_STAB_PREC +C In the initialization, I cannot perform stability test and +C therefore guarantee any precision + CTMODEINIT_BU=CTMODEINIT +C So either one choses quad precision directly +C CTMODEINIT=4 +C Or, because this is very slow, we keep the orignal value. The +C accuracy returned is -1 and tells the MC that he should not +C trust the evaluation for checks. + CTMODEINIT=CTMODEINIT_BU + ENDIF + + IF(DONEHELDOUBLECHECK.AND.(.NOT.HELDOUBLECHECKED)) THEN + HELDOUBLECHECKED=.TRUE. + DONEHELDOUBLECHECK=.FALSE. + ENDIF + + CHECKPHASE=(NTRY.LE.CHECKCYCLE).AND.(((.NOT.FOUNDLOOPFILTER) + $ .AND.USELOOPFILTER).OR.(.NOT.FOUNDHELFILTER)) + + IF (WRITEOUTFILTERS) THEN + IF ((HELICITYFILTERLEVEL.NE.0).AND.(.NOT. CHECKPHASE) + $ .AND.(.NOT.FOUNDHELFILTER)) THEN + OPEN(1, FILE=HELFILTERFN, ERR=110, STATUS='NEW' + $ ,ACTION='WRITE') + DO I=1,NCOMB + WRITE(1,*) GOODHEL(I) + ENDDO + 110 CONTINUE + CLOSE(1) + FOUNDHELFILTER=.TRUE. + ENDIF + + IF ((.NOT. CHECKPHASE).AND.(.NOT.FOUNDLOOPFILTER) + $ .AND.USELOOPFILTER) THEN + OPEN(1, FILE=LOOPFILTERFN, ERR=111, STATUS='NEW' + $ ,ACTION='WRITE') + DO J=1,NLOOPGROUPS + WRITE(1,*) (GOODAMP(I,J),I=1,NSQUAREDSO) + ENDDO + 111 CONTINUE + CLOSE(1) + FOUNDLOOPFILTER=.TRUE. + ENDIF + ENDIF + + IF (BYPASS_CHECK) THEN + OLD_CHECKPHASE = CHECKPHASE + OLD_HELDOUBLECHECKED = HELDOUBLECHECKED + CHECKPHASE = .FALSE. + HELDOUBLECHECKED = .TRUE. + DO I=1,NCOMB + OLD_GOODHEL(I)=GOODHEL(I) + GOODHEL(I)=1 + ENDDO + DO I=1,NSQUAREDSO + DO J=1,NLOOPGROUPS + OLD_GOODAMP(I,J)=GOODAMP(I,J) + GOODAMP(I,J)=.TRUE. + ENDDO + ENDDO + ENDIF + + IF(CHECKPHASE.OR.(.NOT.HELDOUBLECHECKED)) THEN + HELPICKED=1 + CTMODE=CTMODEINIT + ELSE + IF (USERHEL.NE.-1) THEN + IF(GOODHEL(USERHEL).EQ.-HELOFFSET) THEN + DO I=0,NSQUAREDSO + ANS(1,I)=0.0D0 + ANS(2,I)=0.0D0 + ANS(3,I)=0.0D0 + ENDDO + GOTO 9999 + ENDIF + ENDIF + HELPICKED=USERHEL + IF (CTMODERUN.NE.-1) THEN + CTMODE=CTMODERUN + ELSE + CTMODE=1 + ENDIF + ENDIF + + DO I=1,NEXTERNAL + DO J=0,3 + PS(J,I)=P_USER(J,I) + ENDDO + ENDDO + +C Make sure we start with empty caches + IF (AUTOMATIC_CACHE_CLEARING) THEN + CALL ML5_0_CLEAR_CACHES() + ENDIF + + + IF (IMPROVEPSPOINT.GE.0) THEN +C Make the input PS more precise (exact onshell and +C energy-momentum conservation) + CALL ML5_0_IMPROVE_PS_POINT_PRECISION(PS) + ENDIF + + DO I=1,NEXTERNAL + DO J=0,3 + P(J,I)=PS(J,I) + ENDDO + ENDDO + + DO K=1, 3 + DO I=0,NSQUAREDSO + BUFFR(K,I)=0.0D0 + ENDDO + DO I=1,NLOOPAMPS + AMPL(K,I)=(0.0D0,0.0D0) + ENDDO + ENDDO + +C Start by using the first available loop reduction library and qp +C library. + I_LIB=1 + I_QP_LIB=1 + + GOTO 208 +C MadLoop jumps to this label during stability checks when it +C recomputes a rotated PS point + 200 CONTINUE +C For the computation of a rotated version of this PS point we +C must reset the all MadLoop cache since this changes the +C definition of the loop denominators. +C We don't check for AUTOMATIC_CACHE_CLEARING here because the +C Lorentz test should anyway be disabled if the flag is turned +C off. + CALL ML5_0_CLEAR_CACHES() + 208 CONTINUE + SKIP_LOOPNUM_COEFS_CONSTRUCTION=.FALSE. + GOTO 308 +C MadLoop jumps to this label during stability checks when it +C recomputes the same PS point with a different CTMode + 300 CONTINUE +C Of course the trick of reusing coefficients when reducing at the +C amplitude level only works when computing one helicity at a time + IF (USERHEL.NE.-1) THEN + SKIP_LOOPNUM_COEFS_CONSTRUCTION = .TRUE. + ENDIF + 308 CONTINUE +C We don't want to re-initialized the following quantities when +C checking the helicity filter. (which jumps to label 205 to +C probe each helicity). +C We however want to re-initialize them for each new computation +C part of the stability check (which jumps to label 200) +C This code is therefore placed before 205 and after 200. + CALL ML5_0_REINITIALIZE_CUMULATIVE_ARRAYS() + IF (ME_COMPUTATION_FROM_JAMP) THEN +C If both ME computational methods have been used, then the ME +C computation from color flows was stored in RES_FROM_JAMP and +C we must reset it here. + DO I=0,NSQUAREDSO + DO K=0,3 + RES_FROM_JAMP(K,I)=0.0D0 + ENDDO + ENDDO + ENDIF + IF ((.NOT.DIRECT_ME_COMPUTATION).AND.ME_COMPUTATION_FROM_JAMP) + $ THEN +C When computing the ME with color flows, the Born ME will be +C computed as well, so we reset here the result obtained from +C the smatrix call above. + DO I=0,NSQUAREDSO + ANS(0,I)=0.0D0 + ENDDO + ENDIF + + +C Even if the user did ask to turn off the automatic TIR cache +C clearing, we must do it now if the CTModeIndex rolls over the +C size of the TIR cache employed. +C Notice that we must do that only when processing a new CT mode +C as part of the stability test and not when computing a new +C helicity as part of the filtering process. +C This we check that we are not in the initialization phase. +C If we are not in CTModeRun=-1, then we never need to clear the +C cache since the TIR will always be used for a unique +C computation (not stab test). +C Also, it is clear that if we are running OPP when reaching this' +C //' line, then we shouldn't clear the TIR cache as it might +C still be useful later. +C Finally, notice that the conditional statement below should +C never be true except you have TIR library supporting quadruple +C precision or when TIR_CACHE_SIZE<2. + IF((.NOT.CHECKPHASE.AND.(HELDOUBLECHECKED)).AND.CTMODERUN.EQ. + $ -1.AND.(MLREDUCTIONLIB(I_LIB).NE.1.AND.MLREDUCTIONLIB(I_LIB) + $ .NE.5).AND.(ML5_0_TIRCACHE_INDEX(CTMODE).EQ.(TIR_CACHE_SIZE+1))) + $ THEN + CALL ML5_0_CLEAR_TIR_CACHE() + ENDIF + + +C MadLoop jumps to this label during initialization when it goes +C to the computation of the next helicity. + 205 CONTINUE + + IF (.NOT.MP_PS_SET.AND.(CTMODE.EQ.0.OR.CTMODE.GE.4)) THEN + CALL ML5_0_SET_MP_PS(P_USER) + MP_PS_SET = .TRUE. + ENDIF + + LSCALE=DSQRT(ABS((P(0,1)+P(0,2))**2-(P(1,1)+P(1,2))**2-(P(2,1) + $ +P(2,2))**2-(P(3,1)+P(3,2))**2)) + + CTCALL_REQ_SO_DONE=.FALSE. + FILTER_SO = (.NOT.CHECKPHASE) + $ .AND.HELDOUBLECHECKED.AND.(SQSO_TARGET.NE.-1) + + + DO I=1,NLOOPGROUPS + DO J=1,3 + DO K=1,NSQUAREDSO + LOOPRES(J,K,I)=(0.0D0,0.0D0) + ENDDO + ENDDO + ENDDO + + DO K=1,3 + DO I=0,NSQUAREDSO + ANS(K,I)=0.0D0 + ENDDO + ENDDO + +C Check if we directly go to multiple precision + IF (CTMODE.GE.4) THEN + CALL ML5_0_MP_COMPUTE_LOOP_COEFS(MP_P,BUFFR_BIS) + IF ((.NOT.DIRECT_ME_COMPUTATION).AND.ME_COMPUTATION_FROM_JAMP) + $ THEN +C If the ME's are computed from the color flows only, we must +C update the NLO part of ANS from BUFFR_BIS and the Born part +C of ANS using RES_FROM_JAMP(0,*) + DO I=0,NSQUAREDSO + ANS(0,I)=RES_FROM_JAMP(0,I) + DO K=1,3 + ANS(K,I)=BUFFR_BIS(K,I) + ENDDO + ENDDO + ENDIF +C We must skip the double precision computation of both loop +C amplitudes and CT amplitudes because they will all be +C computed in MP_COMPUTE_LOOP_COEFS. + GOTO 301 + ENDIF + + DO H=1,NCOMB + IF ((HELPICKED.EQ.H).OR.((HELPICKED.EQ.-1) + $ .AND.(CHECKPHASE.OR.(.NOT.HELDOUBLECHECKED).OR.(GOODHEL(H) + $ .GT.-HELOFFSET.AND.GOODHEL(H).NE.0)))) THEN + +C Handle the possible requirement of specific polarizations + IF ((.NOT.CHECKPHASE) + $ .AND.HELDOUBLECHECKED.AND.POLARIZATIONS(0,0) + $ .EQ.0.AND.(.NOT.ML5_0_IS_HEL_SELECTED(H))) THEN + CYCLE + ENDIF + + DO I=1,NEXTERNAL + NHEL(I)=HELC(I,H) + ENDDO + + UVCT_REQ_SO_DONE=.FALSE. + CT_REQ_SO_DONE=.FALSE. + LOOP_REQ_SO_DONE=.FALSE. + + IF (.NOT.CHECKPHASE.AND.HELDOUBLECHECKED.AND.HELPICKED.EQ.-1) + $ THEN + HEL_MULT=GOODHEL(H) + ELSE + HEL_MULT=1 + ENDIF + + CTCALL_REQ_SO_DONE=.FALSE. + +C The coefficient were already computed previously with +C another CTMode, so we can skip them + IF (SKIP_LOOPNUM_COEFS_CONSTRUCTION) THEN + GOTO 4000 + ENDIF + + DO I=1,NLOOPGROUPS + DO J=0,LOOPMAXCOEFS-1 + LOOPCOEFS(J,I)=(0.0D0,0.0D0) + ENDDO + ENDDO + + DO K=1,3 + DO I=1,NLOOPAMPS + AMPL(K,I)=(0.0D0,0.0D0) + ENDDO + ENDDO + +C Helas calls for the born amplitudes and counterterms +C associated to given loops + CALL ML5_0_HELAS_CALLS_AMPB_1(P,NHEL,H,IC) + 2000 CONTINUE + CT_REQ_SO_DONE=.TRUE. + +C Helas calls for the counterterm of type 'UVtree' in the UFO. +C These are generated irrespectively of the produced loops. +C In general, only wavefunction renormalization counterterms +C (if needed by the loop UFO model) are of this type. +C Quite often and in principle for all loop UFO models from +C FeynRules, there are none of these type of counterterms. + + 3000 CONTINUE + UVCT_REQ_SO_DONE=.TRUE. + + + CALL ML5_0_COEF_CONSTRUCTION_1(P,NHEL,H,IC) + 4000 CONTINUE + LOOP_REQ_SO_DONE=.TRUE. + + IF(SKIPLOOPEVAL.OR.(.NOT.LOOP_REQ_SO_DONE.AND..NOT.MP_LOOP_RE + $Q_SO_DONE)) THEN + GOTO 5000 + ENDIF + DO I=1,NSQUAREDSO + DO J=1,NLOOPGROUPS + S(I,J)=.TRUE. + ENDDO + ENDDO +C We need the dummy argument I_SO for the squared order index +C to conform to the structure that the call to the LOOP* +C subroutine takes for processes with Born diagrams. + I_SO=1 + CALL ML5_0_LOOP_CT_CALLS_1(P,NHEL,H,IC) + 5000 CONTINUE + CTCALL_REQ_SO_DONE=.TRUE. + + IF (DIRECT_ME_COMPUTATION) THEN + DO I=1,NLOOPAMPS + DO J=1,NLOOPAMPS + CFTOT=DCMPLX(CF_N(I,J)/DBLE(ABS(CF_D(I,J))),0.0D0) + IF(CF_D(I,J).LT.0) CFTOT=CFTOT*IMAG1 + ITEMP = + $ ML5_0_ML5SQSOINDEX(ML5_0_ML5SOINDEX_FOR_LOOP_AMP(I) + $ ,ML5_0_ML5SOINDEX_FOR_LOOP_AMP(J)) + TEMP2(1) = HEL_MULT*DBLE(CFTOT*(AMPL(1,I) + $ *DCONJG(AMPL(1,J)))) +C Computing the quantities below is not strictly +C necessary since the result should be finite +C It is however a good cross-check. + TEMP2(2) = HEL_MULT*DBLE(CFTOT*(AMPL(2,I) + $ *DCONJG(AMPL(1,J)) + AMPL(1,I)*DCONJG(AMPL(2,J)))) + TEMP2(3) = HEL_MULT*DBLE(CFTOT*(AMPL(3,I) + $ *DCONJG(AMPL(1,J)) + AMPL(1,I)*DCONJG(AMPL(3,J)) + $ +AMPL(2,I)*DCONJG(AMPL(2,J)))) +C To mimick the structure of the squared amplitude +C reduction, we add here the squared counterterm +C contribution directly to the result ANS() and put the +C loop contributions in the LOOPRES array which will be +C added to ANS later + IF (I.LE.NCTAMPS) THEN + IF (.NOT.FILTER_SO.OR.SQSO_TARGET.EQ.ITEMP) THEN + DO K=1,3 + ANS(K,ITEMP)=ANS(K,ITEMP)+TEMP2(K) + ANS(K,0)=ANS(K,0)+TEMP2(K) + ENDDO + ENDIF + ELSE + DO K=1,3 + LOOPRES(K,ITEMP,I-NCTAMPS)=LOOPRES(K,ITEMP,I + $ -NCTAMPS)+TEMP2(K) +C During the evaluation of the AMPL, we had stored +C the stability in S(1,*) so we now copy over this +C flag to the relevant contributing Squared orders. + S(ITEMP,I-NCTAMPS)=S(1,I-NCTAMPS) + ENDDO + ENDIF + ENDDO + ENDDO + ENDIF + +C We should compute the color flow either if it contributes to +C the final result (i.e. not used just for the filtering), or +C if the computation is only done from the color flows + IF (((.NOT.DIRECT_ME_COMPUTATION) + $ .AND.ME_COMPUTATION_FROM_JAMP) + $ .OR.((H.EQ.USERHEL.OR.USERHEL.EQ.-1).AND.(POLARIZATIONS(0,0) + $ .EQ.-1.OR.ML5_0_IS_HEL_SELECTED(H)))) THEN +C The cumulative quantities must only be computed if that +C helicity contributes according to user request (second +C argument of the subroutine below). + CALL ML5_0_COMPUTE_COLOR_FLOWS(HEL_MULT) + + + IF(ME_COMPUTATION_FROM_JAMP) THEN + CALL ML5_0_COMPUTE_RES_FROM_JAMP(BUFFRES,HEL_MULT) + IF(((.NOT.DIRECT_ME_COMPUTATION) + $ .AND.ME_COMPUTATION_FROM_JAMP)) THEN +C If the computation from the color flow is the only +C form of computation, we directly update the answer. + DO K=0,3 + DO I=0,NSQUAREDSO + ANS(K,I)=ANS(K,I)+BUFFRES(K,I) + ENDDO + ENDDO +C When setting up the loop filter, it is important to +C set the quantitied LOOPRES. +C Notice that you may have a more powerful filter with +C the direct computation mode because it can filter +C vanishing loop contributions for a particular squared +C split order only +C The quantity LOOPRES defined below is not physical,' +C //' but it's ok since it is only intended for the loop +C filtering. + IF(.NOT.FOUNDLOOPFILTER.AND.USELOOPFILTER) THEN + DO J=1,NLOOPGROUPS + DO I=1,NSQUAREDSO + DO K=1,3 + LOOPRES(K,I,J)=LOOPRES(K,I,J)+AMPL(K,NCTAMPS+J) + ENDDO + ENDDO + ENDDO + ENDIF +C The if statement below is not strictly necessary but +C makes it clear when it is executed. + ELSEIF(H.EQ.USERHEL.OR.USERHEL.EQ.-1) THEN +C Make sure that that no polarization constraint filters +C out this helicity + IF (POLARIZATIONS(0,0).EQ. + $ -1.OR.ML5_0_IS_HEL_SELECTED(H)) THEN +C If both computational method is used, then we must +C just update RES_FROM_JAMP + DO K=0,3 + DO I=0,NSQUAREDSO + RES_FROM_JAMP(K,I)=RES_FROM_JAMP(K,I)+BUFFRES(K + $ ,I) + ENDDO + ENDDO + ENDIF + ENDIF + IF (H.EQ.USERHEL.OR.USERHEL.EQ.-1) THEN +C Make sure that that no polarization constraint filters +C out this helicity + IF (POLARIZATIONS(0,0).EQ. + $ -1.OR.ML5_0_IS_HEL_SELECTED(H)) THEN + CALL + $ ML5_0_COMPUTE_COLOR_FLOWS_DERIVED_QUANTITIES(HEL_MU + $LT) + ENDIF + ENDIF + ENDIF + ENDIF + + ENDIF + ENDDO + + + IF(DIRECT_ME_COMPUTATION) THEN +C Lines below are not necessary when computing the ME from color +C flows + DO I=0,NSQUAREDSO + DO J=1,3 + BUFFR_BIS(J,I)=ANS(J,I) + ENDDO + ENDDO + ENDIF + + +C MadLoop jumps to this label just after having called the +C subroutine ML5_0_MP_COMPUTE_LOOP_COEFS to compute OpenLoop +C coefficients in quadruple precision (and not double precision +C as done above) + 301 CONTINUE + + IF(DIRECT_ME_COMPUTATION) THEN +C Lines below are not necessary when computing the ME from color +C flows + DO I=0,NSQUAREDSO + DO J=1,3 + ANS(J,I)=BUFFR_BIS(J,I) + ENDDO + ENDDO + ENDIF + + IF ((.NOT.DIRECT_ME_COMPUTATION).AND.ME_COMPUTATION_FROM_JAMP) + $ THEN +C We can skip the update of ANS if it was computed from color +C flows + GOTO 1226 + ENDIF + + IF(SKIPLOOPEVAL.OR.(.NOT.LOOP_REQ_SO_DONE.AND..NOT.MP_LOOP_REQ_SO + $_DONE)) THEN + GOTO 1226 + ENDIF + + + DO I=1,NLOOPGROUPS + LTEMP=.TRUE. + DO K=1,NSQUAREDSO + IF (.NOT.FILTER_SO.OR.SQSO_TARGET.EQ.K) THEN + IF (.NOT.S(K,I)) LTEMP=.FALSE. + DO J=1,3 + ANS(J,K)=ANS(J,K)+LOOPRES(J,K,I) + ANS(J,0)=ANS(J,0)+LOOPRES(J,K,I) + ENDDO + ENDIF + ENDDO + IF((CTMODERUN.NE.-1).AND..NOT.CHECKPHASE.AND.(.NOT.LTEMP)) THEN + WRITE(*,*) '##W03 WARNING Contribution ',I,' is unstable.' + ENDIF + ENDDO + +C Make sure that no NaN is present in the result + DO K=1,NSQUAREDSO + DO J=1,3 + IF (.NOT.(ANS(J,K).EQ.ANS(J,K))) THEN + IF (DOING_QP_EVALS) THEN + FPE_IN_QP_REDUCTION = .TRUE. + ELSE + FPE_IN_DP_REDUCTION = .TRUE. + ENDIF + ENDIF + ENDDO + ENDDO + + 1226 CONTINUE + + IF (CHECKPHASE.OR.(.NOT.HELDOUBLECHECKED)) THEN + IF((USERHEL.EQ.-1).OR.(USERHEL.EQ.HELPICKED)) THEN +C Make sure that that no polarization constraint filters out +C this helicity + IF (POLARIZATIONS(0,0).EQ. + $ -1.OR.ML5_0_IS_HEL_SELECTED(HELPICKED)) THEN +C TO KEEP TRACK OF THE FINAL ANSWER TO BE RETURNED DURING +C CHECK PHASE + DO I=0,NSQUAREDSO + DO K=1,3 + BUFFR(K,I)=BUFFR(K,I)+ANS(K,I) + ENDDO + ENDDO + ENDIF + ENDIF +C SAVE RESULT OF EACH INDEPENDENT HELICITY FOR COMPARISON DURING +C THE HELICITY FILTER SETUP + HELSAVED(1,HELPICKED)=0.0D0 + HELSAVED(2,HELPICKED)=0.0D0 + HELSAVED(3,HELPICKED)=0.0D0 + DO I=1,NSQUAREDSO + IF (CHOSEN_SO_CONFIGS(I)) THEN + HELSAVED(1,HELPICKED)=HELSAVED(1,HELPICKED)+ANS(1,I) + HELSAVED(2,HELPICKED)=HELSAVED(2,HELPICKED)+ANS(2,I) + HELSAVED(3,HELPICKED)=HELSAVED(3,HELPICKED)+ANS(3,I) + ENDIF + ENDDO + +C We make sure not to perform any check when NTRY is 0 because +C this means that +C the REF scale has not been set to the result of the evaluation +C for the first PS point. + IF (CHECKPHASE.AND.NTRY.NE.0) THEN +C SET THE HELICITY FILTER + IF(.NOT.FOUNDHELFILTER) THEN + HEL_INCONSISTENT=.FALSE. + IF(ML5_0_ISZERO(DABS(HELSAVED(1,HELPICKED)) + $ +DABS(HELSAVED(2,HELPICKED))+DABS(HELSAVED(3,HELPICKED)) + $ ,REF/DBLE(NCOMB),-1,-1)) THEN + IF(NTRY.EQ.1) THEN + GOODHEL(HELPICKED)=-HELOFFSET + ELSEIF(GOODHEL(HELPICKED).NE.-HELOFFSET) THEN + WRITE(*,*) '##W02A WARNING Inconsistent zero helicity' + $ //' ',HELPICKED + IF(HELINITSTARTOVER) THEN + WRITE(*,*) '##I01 INFO Initialization starting over' + $ //' because of inconsistency in the helicity filter' + $ //' setup.' + NTRY=0 + ELSE + HEL_INCONSISTENT=.TRUE. + ENDIF + ENDIF + ELSEIF(HELICITYFILTERLEVEL.GT.1) THEN + DO H=1,HELPICKED-1 + IF(GOODHEL(H).GT.-HELOFFSET) THEN +C Be looser for helicity check, bring a factor 100 + DUMMY=ML5_0_ISSAME(HELSAVED(1,HELPICKED),HELSAVED(1 + $ ,H),REF,.FALSE.) + IF(DUMMY.NE.0) THEN + IF(NTRY.EQ.1) THEN +C Set the matching helicity to be contributing +C once more + GOODHEL(H)=GOODHEL(H)+DUMMY +C Use an offset to clearly show it is linked to an +C other one and to avoid overlap + GOODHEL(HELPICKED)=-H-HELOFFSET +C Make sure we have paired this hel config to the +C same one last PS point + ELSEIF(GOODHEL(HELPICKED).NE.(-H-HELOFFSET)) THEN + WRITE(*,*) '##W02B WARNING Inconsistent matching' + $ //' helicity ',HELPICKED + IF(HELINITSTARTOVER) THEN + WRITE(*,*) '##I01 INFO Initialization starting' + $ //' over because of inconsistency in the' + $ //' helicity filter setup.' + NTRY=0 + ELSE + HEL_INCONSISTENT=.TRUE. + ENDIF + ENDIF + ENDIF + ENDIF + ENDDO + ENDIF + IF(HEL_INCONSISTENT) THEN +C This helicity has unstable filter so we will always +C compute it by itself. +C We therefore also need to remove it from the +C multiplicative factor of the corresponding helicity. + IF(GOODHEL(HELPICKED).LT.-HELOFFSET) THEN + GOODHEL(-GOODHEL(HELPICKED)-HELOFFSET)=GOODHEL( + $ -GOODHEL(HELPICKED)-HELOFFSET)-1 + ENDIF +C If several helicities were matched to that one, we need +C to chose another one as reference and redirect the +C others to this new one +C Of course if it is one, then we do not need to do +C anything (because with HELINITSTARTOVER=.FALSE. we only +C support exactly identical Hels.) + IF(GOODHEL(HELPICKED).GT. + $ -HELOFFSET.AND.GOODHEL(HELPICKED).NE.1) THEN + NEWHELREF=-1 + DO H=1,NCOMB + IF (GOODHEL(H).EQ.(-HELOFFSET-HELPICKED)) THEN + IF (NEWHELREF.EQ.-1) THEN + NEWHELREF=H + GOODHEL(H)=GOODHEL(HELPICKED)-1 + ELSE + GOODHEL(H)=-NEWHELREF-HELOFFSET + ENDIF + ENDIF + ENDDO + ENDIF +C In all cases, from now on this helicity will be computed +C independantly of the others. +C In particular, it is the only thing to do if the +C helicity was flagged not contributing. + GOODHEL(HELPICKED)=1 + ENDIF + ENDIF + +C SET THE LOOP FILTER + IF(.NOT.FOUNDLOOPFILTER.AND.USELOOPFILTER) THEN + DO I=1,NLOOPGROUPS + DO J=1,NSQUAREDSO + IF(.NOT.ML5_0_ISZERO(ABS(LOOPRES(1,J,I))+ABS(LOOPRES(2 + $ ,J,I))+ABS(LOOPRES(3,J,I)),(REF*1.0D-4),I,J)) THEN + IF(NTRY.EQ.1) THEN + GOODAMP(J,I)=.TRUE. + LOOPFILTERBUFF(J,I)=.TRUE. + ELSEIF(.NOT.LOOPFILTERBUFF(J,I)) THEN + WRITE(*,*) '##W02 WARNING Inconsistent loop amp ' + $ ,I,'.' + IF(LOOPINITSTARTOVER) THEN + WRITE(*,*) '##I01 INFO Initialization starting' + $ //' over because of inconsistency in the loop' + $ //' filter setup.' + NTRY=0 + ELSE + GOODAMP(J,I)=.TRUE. + ENDIF + ENDIF + ENDIF + ENDDO + ENDDO + ENDIF + ELSEIF (.NOT.HELDOUBLECHECKED.AND.NTRY.NE.0)THEN +C DOUBLE CHECK THE HELICITY FILTER + IF (GOODHEL(HELPICKED).EQ.-HELOFFSET) THEN + IF (.NOT.ML5_0_ISZERO(DABS(HELSAVED(1,HELPICKED)) + $ +DABS(HELSAVED(2,HELPICKED))+DABS(HELSAVED(2,HELPICKED)) + $ ,REF/DBLE(NCOMB),-1,-1)) THEN + WRITE(*,*) '##W15 Helicity filter could not be' + $ //' successfully double checked.' + WRITE(*,*) '##One reason for this is that you might have' + $ //' changed sensible parameters which affected what are' + $ //' the zero helicity configurations.' + WRITE(*,*) '##MadLoop will try to reset the Helicity' + $ //' filter with the next PS points it receives.' + NTRY=0 + OPEN(29,FILE=HELFILTERFN,ERR=348) + 348 CONTINUE + CLOSE(29,STATUS='delete') + ENDIF + ENDIF + IF (GOODHEL(HELPICKED).LT.-HELOFFSET.AND.NTRY.NE.0) THEN + IF(ML5_0_ISSAME(HELSAVED(1,HELPICKED),HELSAVED(1 + $ ,ABS(GOODHEL(HELPICKED)+HELOFFSET)),REF,.TRUE.).EQ.0) THEN + WRITE(*,*) '##W15 Helicity filter could not be' + $ //' successfully double checked.' + WRITE(*,*) '##One reason for this is that you might have' + $ //' changed sensible parameters which affected the' + $ //' helicity dependance relations.' + WRITE(*,*) '##MadLoop will try to reset the Helicity' + $ //' filter with the next PS points it receives.' + NTRY=0 + OPEN(30,FILE=HELFILTERFN,ERR=349) + 349 CONTINUE + CLOSE(30,STATUS='delete') + ENDIF + ENDIF +C SET HELDOUBLECHECKED TO .TRUE. WHEN DONE +C even if it failed we do not want to redo the check +C afterwards if HELINITSTARTOVER=.FALSE. + IF (HELPICKED.EQ.NCOMB.AND.(NTRY.NE.0.OR..NOT.HELINITSTARTOVE + $R)) THEN + DONEHELDOUBLECHECK=.TRUE. + ENDIF + ENDIF + +C GOTO NEXT HELICITY OR FINISH + IF(HELPICKED.NE.NCOMB) THEN + HELPICKED=HELPICKED+1 + MP_DONE=.FALSE. + GOTO 205 + ELSE +C Useful printout +C do I=1,NCOMB +C write(*,*) 'HELSAVED(1,',I,')=',HELSAVED(1,I) +C write(*,*) 'HELSAVED(2,',I,')=',HELSAVED(2,I) +C write(*,*) 'HELSAVED(3,',I,')=',HELSAVED(3,I) +C write(*,*) ' GOODHEL(',I,')=',GOODHEL(I) +C ENDDO + DO I=0,NSQUAREDSO + DO K=1,3 + ANS(K,I)=BUFFR(K,I) + ENDDO + ENDDO +C Update of REF_EVALS (only for loop-induced processes). + TMPR = ABS(ANS(1,0)) + ABS(ANS(2,0)) + ABS(ANS(3,0)) +C We add one here to the number of PS points used for building +C the reference scale for comparisons. +C It might be that when asking for specific helicities, the +C user started with a vanishing helicity +C not filtered yet. In this case, the new ref would remain +C zero. So we want to check for this +C and wait for a point for which the evaluation isn't be zero. + IF(TMPR.NE.0.0D0) THEN + REF_EVALS(MOD(NPSPOINTS,MAXNREF_EVALS)+1) = TMPR + NPSPOINTS = NPSPOINTS+1 + ENDIF + IF(NTRY.EQ.0) THEN + NATTEMPTS=NATTEMPTS+1 + IF(NATTEMPTS.EQ.MAXATTEMPTS) THEN + WRITE(*,*) '##E01 ERROR Could not initialize the filters' + $ //' in ',MAXATTEMPTS,' trials' + STOP 1 + ENDIF + ENDIF + ENDIF + ELSE +C When not in checking mode, update the ref for the first +C MAXNREF_EVALS points (The ref. scale could still be used +C after this stage if BYPASS_CHECK was set to true at some +C point using SLOOPMATRIX_THRES). +C Is is possible to simply remove the if statement below to have +C a running reference scale which always depends on the +C MAXNREF_EVALS *last* evaluations. + IF (NPSPOINTS.LE.MAXNREF_EVALS) THEN + TMPR = ABS(ANS(1,0)) + ABS(ANS(2,0)) + ABS(ANS(3,0)) + IF (TMPR.NE.0.0D0) THEN + REF_EVALS(MOD(NPSPOINTS,MAXNREF_EVALS)+1) = TMPR + NPSPOINTS = NPSPOINTS+1 + ENDIF + ENDIF + ENDIF + +C When computing the ME from the color flows, we also compute the +C born ME from them, so we must apply the normalization factors +C to the born ME as well. + IF(((.NOT.DIRECT_ME_COMPUTATION).AND.ME_COMPUTATION_FROM_JAMP)) + $ THEN + ITEMP=0 + ELSE + ITEMP=1 + ENDIF + DO K=ITEMP,3 + DO I=0,NSQUAREDSO + ANS(K,I)=ANS(K,I)/DBLE(IDEN) + IF (USERHEL.NE.-1) THEN + ANS(K,I)=ANS(K,I)*HELAVGFACTOR + ELSE + DO J=1,NINITIAL + IF (POLARIZATIONS(J,0).NE.-1) THEN + ANS(K,I)=ANS(K,I)*BEAMS_HELAVGFACTOR(J) + ANS(K,I)=ANS(K,I)/POLARIZATIONS(J,0) + ENDIF + ENDDO + ENDIF + ENDDO + ENDDO + + IF (DIRECT_ME_COMPUTATION.AND.ME_COMPUTATION_FROM_JAMP) THEN + WRITE(*,*) ' ================================= ' + WRITE(*,*) ' === JAMP double-checking test === ' + WRITE(*,*) ' ================================= ' + CALL ML5_0_WRITE_MOM(P) + DO J=1,NSQUAREDSO+1 +C We should finish by the summed orders + I = MOD(J,NSQUAREDSO+1) + IF (I.EQ.0) THEN + WRITE(*,*) ' > Checking the sum of all chosen squared' + $ //' split orders' + ELSE + WRITE(*,*) ' > Checking squared split order #',I + ENDIF + DO K=1,1 + RES_FROM_JAMP(K,I)=RES_FROM_JAMP(K,I)/DBLE(IDEN) + IF (USERHEL.NE.-1) THEN + RES_FROM_JAMP(K,I)=RES_FROM_JAMP(K,I)*HELAVGFACTOR + ELSE + DO L=1,NINITIAL + IF (POLARIZATIONS(L,0).NE.-1) THEN + RES_FROM_JAMP(K,I)=RES_FROM_JAMP(K,I) + $ *BEAMS_HELAVGFACTOR(L) + RES_FROM_JAMP(K,I)=RES_FROM_JAMP(K,I) + $ /POLARIZATIONS(L,0) + ENDIF + ENDDO + ENDIF + IF (K.EQ.0) WRITE(*,*) ' || Born :' + IF (K.EQ.1) WRITE(*,*) ' || Finite part :' + IF (K.EQ.2) WRITE(*,*) ' || Single pole residue :' + IF (K.EQ.3) WRITE(*,*) ' || Double pole residue :' + WRITE(*,*) ' --> Direct result =',ANS(K,I) + WRITE(*,*) ' --> Computed from JAMPS =',RES_FROM_JAMP(K,I) + IF((RES_FROM_JAMP(K,I)+ANS(K,I)).EQ.0.0D0) THEN + TMPR = ABS(RES_FROM_JAMP(K,I)-ANS(K,I)) + ELSE + TMPR = ABS((ANS(K,I)-RES_FROM_JAMP(K,I))/((ANS(K,I) + $ +RES_FROM_JAMP(K,I))/2.0D0)) + ENDIF + WRITE(*,*) ' --> Relative diff. =',TMPR + IF(TMPR.GT.JAMP_DOUBLECHECK_THRES) THEN + STOP 'Consistency cross-check of JAMPS failed.' + ENDIF + ENDDO + ENDDO + WRITE(*,*) ' ================================= ' + ENDIF + + IF(.NOT.CHECKPHASE.AND.HELDOUBLECHECKED.AND.(CTMODERUN.EQ.-1)) + $ THEN + STAB_INDEX=STAB_INDEX+1 + IF(DOING_QP_EVALS.AND.LOOPLIBS_QPAVAILABLE(MLREDUCTIONLIB(I_LIB) + $ )) THEN +C Only run over the reduction algorithms which support +C quadruple precision + DO I=0,NSQUAREDSO + DO K=1,3 + QP_RES(K,I,STAB_INDEX)=ANS(K,I) + ENDDO + ENDDO + ELSE + DO I=0,NSQUAREDSO + DO K=1,3 + DP_RES(K,I,STAB_INDEX)=ANS(K,I) + ENDDO + ENDDO + ENDIF + + IF(DOING_QP_EVALS.AND.LOOPLIBS_QPAVAILABLE(MLREDUCTIONLIB(I_LIB) + $ )) THEN + BASIC_CT_MODE=4 + ELSE + BASIC_CT_MODE=1 + ENDIF + +C BEGINNING OF THE DEFINITIONS OF THE DIFFERENT EVALUATION +C METHODS + + IF(.NOT.EVAL_DONE(2)) THEN + EVAL_DONE(2)=.TRUE. + IF(LOOPLIBS_DIRECTEST(MLREDUCTIONLIB(I_LIB)))THEN + CTMODE=BASIC_CT_MODE+1 + GOTO 300 + ELSE +C If some TIR library would not support the loop direction +C test (they all do for now), then we would just copy the +C answer from mode 1 and carry on. + STAB_INDEX=STAB_INDEX+1 + IF(DOING_QP_EVALS)THEN + DO I=0,NSQUAREDSO + DO K=1,3 + QP_RES(K,I,STAB_INDEX)=ANS(K,I) + ENDDO + ENDDO + ELSE + DO I=0,NSQUAREDSO + DO K=1,3 + DP_RES(K,I,STAB_INDEX)=ANS(K,I) + ENDDO + ENDDO + ENDIF + ENDIF + ENDIF + + CTMODE=BASIC_CT_MODE + + IF(.NOT.EVAL_DONE(3).AND. + $ ((DOING_QP_EVALS.AND.NROTATIONS_QP.GE.1) + $ .OR.((.NOT.DOING_QP_EVALS).AND.NROTATIONS_DP.GE.1)) ) THEN + EVAL_DONE(3)=.TRUE. + CALL ML5_0_ROTATE_PS(PS,P,1) + IF (DOING_QP_EVALS) CALL ML5_0_MP_ROTATE_PS(MP_PS,MP_P,1) + GOTO 200 + ENDIF + + IF(.NOT.EVAL_DONE(4).AND. + $ ((DOING_QP_EVALS.AND.NROTATIONS_QP.GE.2) + $ .OR.((.NOT.DOING_QP_EVALS).AND.NROTATIONS_DP.GE.2)) ) THEN + EVAL_DONE(4)=.TRUE. + CALL ML5_0_ROTATE_PS(PS,P,2) + IF (DOING_QP_EVALS) CALL ML5_0_MP_ROTATE_PS(MP_PS,MP_P,2) + GOTO 200 + ENDIF + + CALL ML5_0_ROTATE_PS(PS,P,0) + IF (DOING_QP_EVALS) CALL ML5_0_MP_ROTATE_PS(MP_PS,MP_P,0) + +C END OF THE DEFINITIONS OF THE DIFFERENT EVALUATION METHODS + + IF(DOING_QP_EVALS.AND.LOOPLIBS_QPAVAILABLE(MLREDUCTIONLIB(I_LIB) + $ )) THEN + CALL ML5_0_COMPUTE_ACCURACY(QP_RES,N_QP_EVAL,ACC,ANS) +C If a floating point exception was encountered during the +C reduction, +C the result cannot be trusted at all and we hardset all +C accuracies to 1.0 + IF(FPE_IN_QP_REDUCTION) THEN + DO I=0,NSQUAREDSO + ACC(I)=1.0D0 + ENDDO + ENDIF + DO I=0,NSQUAREDSO + ACCURACY(I)=ACC(I) + ENDDO + RET_CODE_H=3 + RET_CODE_U=SET_RET_CODE_U(MLREDUCTIONLIB(I_LIB),.TRUE. + $ ,.TRUE.) + IF(MAXVAL(ACC).GE.MLSTABTHRES) THEN + I_QP_LIB=I_QP_LIB+1 + IF(I_QP_LIB.GT.QP_NLOOPLIB.OR.INDEX_QP_TOOLS(I_QP_LIB) + $ .EQ.0)THEN + RET_CODE_H=4 + RET_CODE_U=SET_RET_CODE_U(MLREDUCTIONLIB(I_LIB),.TRUE. + $ ,.FALSE.) + NEPS=NEPS+1 + CALL ML5_0_COMPUTE_ACCURACY(DP_RES,N_DP_EVAL,TEMP1,TEMP) + CALL ML5_0_COMPUTE_ACCURACY(QP_RES,N_QP_EVAL,ACC,ANS) + IF(NEPS.LE.10) THEN + WRITE(*,*) '##W03 WARNING An unstable PS point was', + $ ' detected.' + IF(FPE_IN_QP_REDUCTION) THEN + WRITE(*,*) '## The last QP reduction was deemed' + $ //' unstable because a floating point exception was' + $ //' encountered.' + ENDIF + IF (NSQUAREDSO.NE.1) THEN + WRITE(*,*) '##Accuracies for each split order,' + $ //' starting with the summed case' + WRITE(*,*) '##DP accuracies (for each split order):' + $ //' ',(TEMP1(I),I=0,NSQUAREDSO) + WRITE(*,*) '##QP accuracies (for each split order):' + $ //' ',(ACC(I),I=0,NSQUAREDSO) + ELSE + WRITE(*,*) '##DP accuracy: ',TEMP1(1) + WRITE(*,*) '##QP accuracy: ',ACC(1) + ENDIF + DO J=0,NSQUAREDSO + IF (NSQUAREDSO.NE.1.OR.J.NE.0) THEN + IF (J.EQ.0) THEN + WRITE(*,*) 'Details for all split orders summed' + $ //' :' + ELSE + WRITE(*,*) 'Details for split order index : ',J + ENDIF + WRITE(*,*) 'Best estimate (fin,1eps,2eps):',(ANS(I + $ ,J),I=1,3) + WRITE(*,*) 'Finite double precision evaluations :' + $ ,(DP_RES(1,J,I),I=1,N_DP_EVAL) + WRITE(*,*) 'Finite quad precision evaluations :' + $ ,(QP_RES(1,J,I),I=1,N_QP_EVAL) + ENDIF + ENDDO + WRITE(*,*) 'PS point specification :' + WRITE(*,*) 'Renormalization scale MU_R=',MU_R + DO I=1,NEXTERNAL + WRITE (*,'(i2,1x,4e27.17)') I, P(0,I),P(1,I),P(2,I) + $ ,P(3,I) + ENDDO + ENDIF + IF(NEPS.EQ.10) THEN + WRITE(*,*) 'Further output of the details of these' + $ //' unstable PS points will now be suppressed.' + ENDIF + ELSE +C A new reduction tool will be used. Reinitialize the FPE +C flags. + FPE_IN_DP_REDUCTION=.FALSE. + FPE_IN_QP_REDUCTION=.FALSE. + I_LIB=INDEX_QP_TOOLS(I_QP_LIB) + EVAL_DONE(1)=.TRUE. + DO I=2,MAXSTABILITYLENGTH + EVAL_DONE(I)=.FALSE. + ENDDO + STAB_INDEX=0 + IF(NROTATIONS_QP.GE.1)THEN + GOTO 200 + ELSE + GOTO 300 + ENDIF + ENDIF + ENDIF + ELSEIF(.NOT.DOING_QP_EVALS)THEN + CALL ML5_0_COMPUTE_ACCURACY(DP_RES,N_DP_EVAL,ACC,ANS) +C If a floating point exception was encountered during the +C reduction, +C the result cannot be trusted at all and we hardset all +C accuracies to 1.0 + IF(FPE_IN_DP_REDUCTION) THEN + DO I=0,NSQUAREDSO + ACC(I)=1.0D0 + ENDDO + ENDIF + IF(MAXVAL(ACC).GE.MLSTABTHRES) THEN + I_LIB=I_LIB+1 + IF((I_LIB.GT.NLOOPLIB.OR.MLREDUCTIONLIB(I_LIB).EQ.0) + $ .AND.QP_TOOLS_AVAILABLE)THEN + I_LIB=INDEX_QP_TOOLS(1) +C A new reduction tool will be used. Reinitialize the FPE +C flags. + FPE_IN_DP_REDUCTION=.FALSE. + FPE_IN_QP_REDUCTION=.FALSE. + I_QP_LIB=1 + DOING_QP_EVALS=.TRUE. + EVAL_DONE(1)=.TRUE. + DO I=2,MAXSTABILITYLENGTH + EVAL_DONE(I)=.FALSE. + ENDDO + STAB_INDEX=0 + CTMODE=4 + GOTO 200 + ELSEIF(I_LIB.LE.NLOOPLIB.AND.MLREDUCTIONLIB(I_LIB).GT.0) + $ THEN +C A new reduction tool will be used. Reinitialize the FPE +C flags. + FPE_IN_DP_REDUCTION=.FALSE. + FPE_IN_QP_REDUCTION=.FALSE. + EVAL_DONE(1)=.TRUE. + DO I=2,MAXSTABILITYLENGTH + EVAL_DONE(I)=.FALSE. + ENDDO + STAB_INDEX=0 + IF(NROTATIONS_DP.GE.1)THEN + GOTO 200 + ELSE + GOTO 300 + ENDIF + ELSE + DO I=0,NSQUAREDSO + ACCURACY(I)=ACC(I) + ENDDO + RET_CODE_H=4 + RET_CODE_U=SET_RET_CODE_U(MLREDUCTIONLIB(I_LIB),.FALSE. + $ ,.FALSE.) + NEPS=NEPS+1 + IF(NEPS.LE.10) THEN + WRITE(*,*) '##W03 WARNING An unstable PS point was', + $ ' detected.' + WRITE(*,*) '##W03 WARNING No quadruple precision will' + $ //' be used.' + IF(FPE_IN_DP_REDUCTION) THEN + WRITE(*,*) '## The last DP reduction was deemed' + $ //' unstable because a floating point exception was' + $ //' encountered.' + ENDIF + CALL ML5_0_COMPUTE_ACCURACY(DP_RES,N_DP_EVAL,ACC,ANS) + IF (NSQUAREDSO.NE.1) THEN + WRITE(*,*) 'Accuracies for each split order,' + $ //' starting with the summed case' + WRITE(*,*) 'DP accuracies (for each split order): ' + $ ,(ACC(I),I=0,NSQUAREDSO) + ELSE + WRITE(*,*) 'DP accuracy: ',ACC(1) + ENDIF + DO J=0,NSQUAREDSO + IF (NSQUAREDSO.NE.1.OR.J.NE.0) THEN + IF (J.EQ.0) THEN + WRITE(*,*) 'Details for all split orders summed' + $ //' :' + ELSE + WRITE(*,*) 'Details for split order index : ',J + ENDIF + WRITE(*,*) 'Best estimate (fin,1eps,2eps):',(ANS(I + $ ,J),I=1,3) + WRITE(*,*) 'Finite double precision evaluations :' + $ ,(DP_RES(1,J,I),I=1,N_DP_EVAL) + ENDIF + ENDDO + WRITE(*,*) 'PS point specification :' + WRITE(*,*) 'Renormalization scale MU_R=',MU_R + DO I=1,NEXTERNAL + WRITE (*,'(i2,1x,4e27.17)') I, P(0,I),P(1,I),P(2,I) + $ ,P(3,I) + ENDDO + ENDIF + IF(NEPS.EQ.10) THEN + WRITE(*,*) 'Further output of the details of these' + $ //' unstable PS points will now be suppressed.' + ENDIF + ENDIF + ELSE + DO I=0,NSQUAREDSO + ACCURACY(I)=ACC(I) + ENDDO + RET_CODE_H=2 + RET_CODE_U=SET_RET_CODE_U(MLREDUCTIONLIB(I_LIB),.FALSE. + $ ,.TRUE.) + ENDIF + ENDIF + ELSE + RET_CODE_H=1 + DO I=0,NSQUAREDSO + ACCURACY(I)=-1.0D0 + ENDDO + RET_CODE_U=SET_RET_CODE_U(MLREDUCTIONLIB(I_LIB),.FALSE. + $ ,.FALSE.) + ENDIF + + 9999 CONTINUE + +C Finalize the return code + IF (MP_DONE_ONCE) THEN + RET_CODE_T=2 + ELSE + RET_CODE_T=1 + ENDIF + IF(CHECKPHASE.OR..NOT.HELDOUBLECHECKED) THEN + RET_CODE_H=1 + RET_CODE_U=SET_RET_CODE_U(MLREDUCTIONLIB(I_LIB),.FALSE. + $ ,.FALSE.) + RET_CODE_T=RET_CODE_T+2 + DO I=0,NSQUAREDSO + ACCURACY(I)=-1.0D0 + ENDDO + ENDIF + +C Finally for the summed result in ANS(1:3,0), make sure to only +C consider the squared order asked for by the user. +C Notice that this filtering using CHOSEN_SO_CONFIGS happens +C here only while everywhere else one always considers the sum. + DO J=1,3 + ANS(J,0)=0.0D0 + ENDDO + DO I=1,NSQUAREDSO + IF (CHOSEN_SO_CONFIGS(I)) THEN + DO J=1,3 + ANS(J,0)=ANS(J,0)+ANS(J,I) + ENDDO + ENDIF + ENDDO +C A loop-induced amplitude is finite: its poles must cancel. +C Nothing to compare against if the reduction tool does not +C compute them. + POLES_COMPUTED = .NOT.(MLREDUCTIONLIB(I_LIB) + $ .EQ.7.AND.(.NOT.COLLIERCOMPUTEUVPOLES.OR..NOT.COLLIERCOMPUTEIRPO + $LES)) + DO_POLE_CHECK = + $ MLPOLECHECKTHRES.GT.0.0D0.AND.POLES_COMPUTED.AND.NTRY.GT.0 + DO_POLE_CHECK = + $ DO_POLE_CHECK.AND..NOT.CHECKPHASE.AND.HELDOUBLECHECKED + DO_POLE_CHECK = DO_POLE_CHECK.AND.RET_CODE_H.NE.4.AND.ANS(1,0) + $ .NE.0.0D0 + IF (DO_POLE_CHECK) THEN + TMPR = (ABS(ANS(2,0))+ABS(ANS(3,0)))/ABS(ANS(1,0)) + IF (TMPR.GT.MLPOLECHECKTHRES) THEN + WRITE(*,*) '##E03 ERROR The poles of this loop-induced' + $ //' process do not cancel.' + WRITE(*,*) 'Finite contribution = ',ANS(1,0) + WRITE(*,*) 'single pole contribution = ',ANS(2,0) + WRITE(*,*) 'double pole contribution = ',ANS(3,0) + WRITE(*,*) 'relative size of the poles = ',TMPR + WRITE(*,*) 'tolerated = ',MLPOLECHECKTHRES + WRITE(*,*) 'The finite part returned here cannot be trusted,' + $ //' so the run is stopped.' + WRITE(*,*) 'Edit MLPoleCheckThres in MadLoopParams.dat to' + $ //' change this tolerance; a negative value disables the' + $ //' check.' + CALL ML5_0_WRITE_MOM(P) + STOP 1 + ENDIF + ENDIF + +C Reinitialize the default threshold if it was specified by the +C user + IF (USER_STAB_PREC.GT.0.0D0) THEN + MLSTABTHRES=MLSTABTHRES_BU + CTMODEINIT=CTMODEINIT_BU + ENDIF + +C Reinitialize the Lorentz test if it had been disabled because +C spin-2 particles are in the external states. + NROTATIONS_DP = NROTATIONS_DP_BU + NROTATIONS_QP = NROTATIONS_QP_BU + +C Reinitialize the check phase logicals and the filters if check +C bypassed + IF (BYPASS_CHECK) THEN + CHECKPHASE = OLD_CHECKPHASE + HELDOUBLECHECKED = OLD_HELDOUBLECHECKED + DO I=1,NCOMB + GOODHEL(I)=OLD_GOODHEL(I) + ENDDO + DO I=1,NSQUAREDSO + DO J=1,NLOOPGROUPS + GOODAMP(I,J)=OLD_GOODAMP(I,J) + ENDDO + ENDDO + ENDIF + +C Make sure that we finish by emptying caches + IF (AUTOMATIC_CACHE_CLEARING) THEN + CALL ML5_0_CLEAR_CACHES() + ENDIF + + + END + + SUBROUTINE ML5_0_CLEAR_CACHES() +C +C This routine can be called directly from the user if +C AUTOMATIC_CACHE_CLEARING is set to False. It must then be called +C after +C ech event +C + CALL ML5_0_CLEAR_TIR_CACHE() + END + +C --=========================================-- +C General Helper functions and subroutine +C for the main sloopmatrix subroutine +C --=========================================-- + + LOGICAL FUNCTION ML5_0_IS_HEL_SELECTED(HELID) + IMPLICIT NONE +C +C CONSTANTS +C + INTEGER NEXTERNAL + PARAMETER (NEXTERNAL=4) + INTEGER NCOMB + PARAMETER (NCOMB=4) +C +C ARGUMENTS +C + INTEGER HELID +C +C LOCALS +C + INTEGER I,J + LOGICAL FOUNDIT +C +C GLOBALS +C + INTEGER HELC(NEXTERNAL,NCOMB) + COMMON/ML5_0_HELCONFIGS/HELC + + INTEGER POLARIZATIONS(0:NEXTERNAL,0:5) + COMMON/ML5_0_BEAM_POL/POLARIZATIONS +C ---------- +C BEGIN CODE +C ---------- + + ML5_0_IS_HEL_SELECTED = .TRUE. + IF (POLARIZATIONS(0,0).EQ.-1) THEN + RETURN + ENDIF + + DO I=1,NEXTERNAL + IF (POLARIZATIONS(I,0).EQ.-1) THEN + CYCLE + ENDIF + FOUNDIT = .FALSE. + DO J=1,POLARIZATIONS(I,0) + IF (HELC(I,HELID).EQ.POLARIZATIONS(I,J)) THEN + FOUNDIT = .TRUE. + EXIT + ENDIF + ENDDO + IF(.NOT.FOUNDIT) THEN + ML5_0_IS_HEL_SELECTED = .FALSE. + RETURN + ENDIF + ENDDO + RETURN + + END + + LOGICAL FUNCTION ML5_0_ISZERO(TOTEST, REFERENCE_VALUE, LOOP, + $ SOINDEX) + IMPLICIT NONE +C +C CONSTANTS +C + INTEGER NLOOPGROUPS + PARAMETER (NLOOPGROUPS=16) + INTEGER NSQUAREDSO + PARAMETER (NSQUAREDSO=0) +C +C ARGUMENTS +C + REAL*8 TOTEST, REFERENCE_VALUE + INTEGER LOOP, SOINDEX +C +C GLOBAL +C + INCLUDE 'MadLoopParams.inc' + COMPLEX*16 LOOPRES(3,NSQUAREDSO,NLOOPGROUPS) + LOGICAL S(NSQUAREDSO,NLOOPGROUPS) + COMMON/ML5_0_LOOPRES/LOOPRES,S +C ---------- +C BEGIN CODE +C ---------- + IF(ABS(REFERENCE_VALUE).EQ.0.0D0) THEN + ML5_0_ISZERO=.FALSE. + WRITE(*,*) '##E02 ERRROR Reference value for comparison is' + $ //' zero.' + STOP 1 + ELSE + ML5_0_ISZERO=((ABS(TOTEST)/ABS(REFERENCE_VALUE)).LT.ZEROTHRES) + ENDIF + + IF(LOOP.NE.-1) THEN + IF((.NOT.ML5_0_ISZERO).AND.(.NOT.S(SOINDEX,LOOP))) THEN + WRITE(*,*) '##W01 WARNING Contribution ',LOOP,' of split' + $ //' order ',SOINDEX,' is detected as contributing with CR=' + $ ,(ABS(TOTEST)/ABS(REFERENCE_VALUE)),' but is unstable.' + ENDIF + ENDIF + + END + + INTEGER FUNCTION ML5_0_ISSAME(RESA,RESB,REF,USEMAX) + IMPLICIT NONE +C This function compares the result from two different helicity +C configuration A and B +C It returns 0 if they are not related and (+/-wgt) if +C A=(+/-wgt)*B. +C For now, the only wgt implemented is the integer 1 or -1. +C If useMax is .TRUE., it uses all implemented weights no matter +C what is HELINITSTARTOVER +C +C CONSTANTS +C + INTEGER MAX_WGT_TO_TRY + PARAMETER (MAX_WGT_TO_TRY=2) +C +C ARGUMENTS +C + REAL*8 RESA(3), RESB(3) + REAL*8 REF + LOGICAL USEMAX +C +C LOCAL VARIABLES +C + LOGICAL ML5_0_ISZERO + INTEGER I,J + INTEGER N_WGT_TO_TRY + INTEGER WGT_TO_TRY(MAX_WGT_TO_TRY) + DATA WGT_TO_TRY/1,-1/ +C +C INCLUDES +C + INCLUDE 'MadLoopParams.inc' +C ---------- +C BEGIN CODE +C ---------- + ML5_0_ISSAME=0 + +C If the helicity can be constructed progressively while allowing +C inconsistency, then we only allow for weight one comparisons. + IF (.NOT.HELINITSTARTOVER.AND..NOT.USEMAX) THEN + N_WGT_TO_TRY=1 + ELSE + N_WGT_TO_TRY=MAX_WGT_TO_TRY + ENDIF + + DO I=1,N_WGT_TO_TRY + DO J=1,3 + IF (ML5_0_ISZERO(ABS(RESB(J)),REF,-1,-1)) THEN + IF(.NOT.ML5_0_ISZERO(ABS(RESB(J))+ABS(RESA(J)),REF,-1,-1)) + $ THEN + GOTO 1231 + ENDIF +C Be looser for helicity comparison, so bring a factor 100 + ELSEIF(.NOT.ML5_0_ISZERO(ABS((RESA(J)/RESB(J)) + $ -DBLE(WGT_TO_TRY(I))),1.0D0,-1,-1)) THEN + GOTO 1231 + ENDIF + ENDDO + ML5_0_ISSAME = WGT_TO_TRY(I) + RETURN + 1231 CONTINUE + ENDDO + END + + SUBROUTINE ML5_0_COMPUTE_ACCURACY(FULLLIST, LENGTH, ACC, + $ ESTIMATE) + IMPLICIT NONE +C +C PARAMETERS +C + INTEGER MAXSTABILITYLENGTH + COMMON/ML5_0_STABILITY_TESTS/MAXSTABILITYLENGTH + INTEGER NSQUAREDSO + PARAMETER (NSQUAREDSO=0) +C +C ARGUMENTS +C + REAL*8 FULLLIST(3,0:NSQUAREDSO,MAXSTABILITYLENGTH) + INTEGER LENGTH + REAL*8 ACC(0:NSQUAREDSO), ESTIMATE(0:3,0:NSQUAREDSO) +C +C LOCAL VARIABLES +C + LOGICAL MASK(MAXSTABILITYLENGTH) + LOGICAL MASK3(3) + DATA MASK3/.TRUE.,.TRUE.,.TRUE./ + INTEGER I,J,K + REAL*8 AVG + REAL*8 DIFF + REAL*8 ACCURACIES(3) + REAL*8 LIST(MAXSTABILITYLENGTH) + +C +C GLOBAL VARIABLES +C + LOGICAL CHOSEN_SO_CONFIGS(NSQUAREDSO) + COMMON/ML5_0_CHOSEN_LOOP_SQSO/CHOSEN_SO_CONFIGS + INTEGER I_LIB + COMMON/ML5_0_I_LIB/I_LIB + INCLUDE 'MadLoopParams.inc' + +C ---------- +C BEGIN CODE +C ---------- + DO I=1,LENGTH + MASK(I)=.TRUE. + ENDDO + DO I=LENGTH+1,MAXSTABILITYLENGTH + MASK(I)=.FALSE. +C For some architectures, it is necessary to initialize all the +C elements of fulllist(i,j) +C Beware that if the length provided is incorrect, then this can +C corrup the fulllist given in argument. + DO J=0,NSQUAREDSO + DO K=1,3 + FULLLIST(K,J,I)=0.0D0 + ENDDO + ENDDO + ENDDO + + DO K=0,NSQUAREDSO + + DO I=1,3 + DO J=1,MAXSTABILITYLENGTH + LIST(J)=FULLLIST(I,K,J) + ENDDO + DIFF=MAXVAL(LIST,1,MASK)-MINVAL(LIST,1,MASK) + AVG=(MAXVAL(LIST,1,MASK)+MINVAL(LIST,1,MASK))/2.0D0 + ESTIMATE(I,K)=AVG + IF (AVG.EQ.0.0D0) THEN + ACCURACIES(I)=DIFF + ELSE + ACCURACIES(I)=DIFF/ABS(AVG) + ENDIF + ENDDO + +C The technique below is too sensitive, typically to +C unstablities in very small poles +C acc(k)=MAXVAL(ACCURACIES,1,MASK3) +C The following is used instead + ACC(K) = 0.0D0 + AVG = 0.0D0 + DO I=1,3 + ACC(K) = ACC(K) + ACCURACIES(I)*ABS(ESTIMATE(I,K)) + AVG = AVG + ESTIMATE(I,K) + ENDDO + IF (AVG.NE.0.0D0) THEN + ACC(K) = ACC(K) / ( ABS(AVG) / 3.0D0) + ENDIF + +C When using COLLIER with the internal stability test, the first +C evaluation is typically more reliable so we do not want to +C use the average but rather the first evaluation. + IF (MLREDUCTIONLIB(I_LIB) + $ .EQ.7.AND.COLLIERUSEINTERNALSTABILITYTEST) THEN + DO I=1,3 + ESTIMATE(I,K) = FULLLIST(I,K,1) + ENDDO + ENDIF + +C Make sure to hard-set to zero accuracies of coupling orders +C not included + IF (K.NE.0) THEN + IF (.NOT.CHOSEN_SO_CONFIGS(K)) THEN + ACC(K) = 0.0D0 + ENDIF + ENDIF + +C If NaN are present in the evaluation, automatically set the +C accuracy to 1.0d99. + DO I=1,3 + DO J=1,MAXSTABILITYLENGTH + IF (ISNAN(FULLLIST(I,K,J))) THEN + ACC(K) = 1.0D99 + ENDIF + ENDDO + ENDDO + + ENDDO + + END + + SUBROUTINE ML5_0_SET_N_EVALS(N_DP_EVALS,N_QP_EVALS) + + IMPLICIT NONE + INTEGER N_DP_EVALS, N_QP_EVALS + + INCLUDE 'MadLoopParams.inc' + + IF(CTMODERUN.LE.-1) THEN + N_DP_EVALS=2+NROTATIONS_DP + N_QP_EVALS=2+NROTATIONS_QP + ELSE + N_DP_EVALS=1 + N_QP_EVALS=1 + ENDIF + + IF(N_DP_EVALS.GT.20.OR.N_QP_EVALS.GT.20) THEN + WRITE(*,*) 'ERROR:: Increase hardcoded maxstabilitylength.' + STOP 1 + ENDIF + + END + +C THIS SUBROUTINE SIMPLY SET THE GLOBAL PS CONFIGURATION GLOBAL +C VARIABLES FROM A GIVEN VARIABLE IN DOUBLE PRECISION + SUBROUTINE ML5_0_SET_MP_PS(P) + + INTEGER NEXTERNAL + PARAMETER (NEXTERNAL=4) + REAL*16 MP_PS(0:3,NEXTERNAL),MP_P(0:3,NEXTERNAL) + COMMON/ML5_0_MP_PSPOINT/MP_PS,MP_P + REAL*8 P(0:3,NEXTERNAL) + + DO I=1,NEXTERNAL + DO J=0,3 + MP_PS(J,I)=P(J,I) + ENDDO + ENDDO + CALL ML5_0_MP_IMPROVE_PS_POINT_PRECISION(MP_PS) + DO I=1,NEXTERNAL + DO J=0,3 + MP_P(J,I)=MP_PS(J,I) + ENDDO + ENDDO + + END + +C --=========================================-- +C Functions for dealing with the ordering +C and indexing of split order contributions +C --=========================================-- + + SUBROUTINE ML5_0_GET_NSQSO_LOOP(NSQSO) +C +C Simple subroutine returning the number of squared split order +C contributions returned in ANS when calling sloopmatrix +C + INTEGER NSQUAREDSO + PARAMETER (NSQUAREDSO=0) + + INTEGER NSQSO + + NSQSO=NSQUAREDSO + + END + + SUBROUTINE ML5_0_GET_ANSWER_DIMENSION(ANS_DIM) +C +C MadLoop subroutines return an array of dimension +C ANS(0:3,0:ANS_DIM) +C In order for the user program to be able to correctly declare +C this +C array when calling MadLoop, this subroutine returns its dimension +C + INTEGER NSQUAREDSO + PARAMETER (NSQUAREDSO=0) + INTEGER ANS_DIM + + INTEGER NSQSO_BORN + PARAMETER (NSQSO_BORN=0) + + + ANS_DIM=MAX(NSQSO_BORN,NSQUAREDSO) + + END + + INTEGER FUNCTION ML5_0_ML5SOINDEX_FOR_SQUARED_ORDERS(ORDERS) +C +C This functions returns the integer index identifying the split +C orders list passed in argument which correspond to the values +C of the following list of couplings (and in this order): +C [] +C +C CONSTANTS +C + INTEGER NSO, NSQSO + PARAMETER (NSO=0, NSQSO=0) +C +C ARGUMENTS +C + INTEGER ORDERS(NSO) +C +C LOCAL VARIABLES +C + INTEGER I,J + INTEGER SQPLITORDERS(NSQSO,NSO) + + COMMON/ML5_0_ML5SQPLITORDERS/SQPLITORDERS +C +C BEGIN CODE +C + DO I=1,NSQSO + DO J=1,NSO + IF (ORDERS(J).NE.SQPLITORDERS(I,J)) GOTO 1009 + ENDDO + ML5_0_ML5SOINDEX_FOR_SQUARED_ORDERS = I + RETURN + 1009 CONTINUE + ENDDO + + WRITE(*,*) 'ERROR:: Stopping function' + $ //' ML5_0_ML5SOINDEX_FOR_SQUARED_ORDERS' + WRITE(*,*) 'Could not find squared orders ',(ORDERS(I),I=1,NSO) + STOP + + END + + INTEGER FUNCTION ML5_0_GETORDPOWFROMINDEX_ML5(IORDER, INDX) +C +C Return the power of the IORDER-th order appearing at position +C INDX +C in the split-orders output +C +C [] +C +C CONSTANTS +C + INTEGER NSO, NSQSO + PARAMETER (NSO=0, NSQSO=0) +C +C ARGUMENTS +C + INTEGER ORDERS(NSO) +C +C LOCAL VARIABLES +C + INTEGER I,J + INTEGER SQPLITORDERS(NSQSO,NSO) + +C +C BEGIN CODE +C + IF (IORDER.GT.NSO.OR.IORDER.LT.1) THEN + WRITE(*,*) 'INVALID IORDER ML5', IORDER + WRITE(*,*) 'SHOULD BE BETWEEN 1 AND ', NSO + STOP + ENDIF + + IF (INDX.GT.NSQSO.OR.INDX.LT.1) THEN + WRITE(*,*) 'INVALID INDX ML5', INDX + WRITE(*,*) 'SHOULD BE BETWEEN 1 AND ', NSQSO + STOP + ENDIF + + ML5_0_GETORDPOWFROMINDEX_ML5=SQPLITORDERS(INDX, IORDER) + + END + + INTEGER FUNCTION ML5_0_ML5SOINDEX_FOR_BORN_AMP(AMPID) +C +C For a given born amplitude number, it returns the ID of the +C split orders it has +C +C CONSTANTS +C + INTEGER NBORNAMPS + PARAMETER (NBORNAMPS=0) +C +C ARGUMENTS +C + INTEGER AMPID +C +C LOCAL VARIABLES +C + INTEGER BORNAMPORDERS(NBORNAMPS) + +C ----------- +C BEGIN CODE +C ----------- + IF (AMPID.GT.NBORNAMPS) THEN + WRITE(*,*) 'ERROR:: Born amplitude ID ',AMPID,' above the' + $ //' maximum ',NBORNAMPS + ENDIF + ML5_0_ML5SOINDEX_FOR_BORN_AMP = BORNAMPORDERS(AMPID) + + END + + INTEGER FUNCTION ML5_0_ML5SOINDEX_FOR_LOOP_AMP(AMPID) +C +C For a given loop amplitude number, it returns the ID of the +C split orders it has +C +C CONSTANTS +C + INTEGER NLOOPAMPS + PARAMETER (NLOOPAMPS=20) +C +C ARGUMENTS +C + INTEGER AMPID +C +C LOCAL VARIABLES +C + INTEGER LOOPAMPORDERS(NLOOPAMPS) + +C ----------- +C BEGIN CODE +C ----------- + IF (AMPID.GT.NLOOPAMPS) THEN + WRITE(*,*) 'ERROR:: Loop amplitude ID ',AMPID,' above the' + $ //' maximum ',NLOOPAMPS + ENDIF + ML5_0_ML5SOINDEX_FOR_LOOP_AMP = LOOPAMPORDERS(AMPID) + + END + + + INTEGER FUNCTION ML5_0_ML5SQSOINDEX(ORDERINDEXA, ORDERINDEXB) +C +C This functions plays the role of the interference matrix. It can +C be hardcoded or +C made more elegant using hashtables if its execution speed ever +C becomes a relevant +C factor. From two split order indices, it return the +C corresponding index in the squared +C order canonical ordering. +C +C CONSTANTS +C + INTEGER NSO, NSQUAREDSO, NAMPSO + PARAMETER (NSO=0, NSQUAREDSO=0, NAMPSO=0) +C +C ARGUMENTS +C + INTEGER ORDERINDEXA, ORDERINDEXB +C +C LOCAL VARIABLES +C + INTEGER I, SQORDERS(NSO) + INTEGER AMPSPLITORDERS(NAMPSO,NSO) + + COMMON/ML5_0_ML5AMPSPLITORDERS/AMPSPLITORDERS +C +C FUNCTION +C + INTEGER ML5_0_ML5SOINDEX_FOR_SQUARED_ORDERS +C +C BEGIN CODE +C + DO I=1,NSO + SQORDERS(I)=AMPSPLITORDERS(ORDERINDEXA,I) + $ +AMPSPLITORDERS(ORDERINDEXB,I) + ENDDO + ML5_0_ML5SQSOINDEX=ML5_0_ML5SOINDEX_FOR_SQUARED_ORDERS(SQORDERS) + END + +C This is the inverse subroutine of ML5SOINDEX_FOR_SQUARED_ORDERS. +C Not directly useful, but provided nonetheless. + SUBROUTINE ML5_0_ML5GET_SQUARED_ORDERS_FOR_SOINDEX(SOINDEX + $ ,ORDERS) +C +C This functions returns the orders identified by the squared +C split order index in argument. Order values correspond to +C following list of couplings (and in this order): +C [] +C +C CONSTANTS +C + INTEGER NSO, NSQSO + PARAMETER (NSO=0, NSQSO=0) +C +C ARGUMENTS +C + INTEGER SOINDEX, ORDERS(NSO) +C +C LOCAL VARIABLES +C + INTEGER I + INTEGER SQPLITORDERS(NSQSO,NSO) + COMMON/ML5_0_ML5SQPLITORDERS/SQPLITORDERS +C +C BEGIN CODE +C + IF (SOINDEX.GT.0.AND.SOINDEX.LE.NSQSO) THEN + DO I=1,NSO + ORDERS(I) = SQPLITORDERS(SOINDEX,I) + ENDDO + RETURN + ENDIF + + WRITE(*,*) 'ERROR:: Stopping function' + $ //' ML5_0_ML5GET_SQUARED_ORDERS_FOR_SOINDEX' + WRITE(*,*) 'Could not find squared orders index ',SOINDEX + STOP + + END SUBROUTINE + +C This is the inverse subroutine of getting amplitude SO orders. +C Not directly useful, but provided nonetheless. + SUBROUTINE ML5_0_ML5GET_ORDERS_FOR_AMPSOINDEX(SOINDEX,ORDERS) +C +C This functions returns the orders identified by the split order +C index in argument. Order values correspond to following list of +C couplings (and in this order): +C [] +C +C CONSTANTS +C + INTEGER NSO, NAMPSO + PARAMETER (NSO=0, NAMPSO=0) +C +C ARGUMENTS +C + INTEGER SOINDEX, ORDERS(NSO) +C +C LOCAL VARIABLES +C + INTEGER I + INTEGER AMPSPLITORDERS(NAMPSO,NSO) + COMMON/ML5_0_ML5AMPSPLITORDERS/AMPSPLITORDERS +C +C BEGIN CODE +C + IF (SOINDEX.GT.0.AND.SOINDEX.LE.NAMPSO) THEN + DO I=1,NSO + ORDERS(I) = AMPSPLITORDERS(SOINDEX,I) + ENDDO + RETURN + ENDIF + + WRITE(*,*) 'ERROR:: Stopping function' + $ //' ML5_0_ML5GET_ORDERS_FOR_AMPSOINDEX' + WRITE(*,*) 'Could not find amplitude split orders index ',SOINDEX + STOP + + END SUBROUTINE + + +C This function is not directly useful, but included for +C completeness + INTEGER FUNCTION ML5_0_ML5SOINDEX_FOR_AMPORDERS(ORDERS) +C +C This functions returns the integer index identifying the +C amplitude split orders passed in argument which correspond to +C the values of the following list of couplings (and in this +C order): +C [] +C +C CONSTANTS +C + INTEGER NSO, NAMPSO + PARAMETER (NSO=0, NAMPSO=0) +C +C ARGUMENTS +C + INTEGER ORDERS(NSO) +C +C LOCAL VARIABLES +C + INTEGER I,J + INTEGER AMPSPLITORDERS(NAMPSO,NSO) + COMMON/ML5_0_ML5AMPSPLITORDERS/AMPSPLITORDERS +C +C BEGIN CODE +C + DO I=1,NAMPSO + DO J=1,NSO + IF (ORDERS(J).NE.AMPSPLITORDERS(I,J)) GOTO 1009 + ENDDO + ML5_0_ML5SOINDEX_FOR_AMPORDERS = I + RETURN + 1009 CONTINUE + ENDDO + + WRITE(*,*) 'ERROR:: Stopping function' + $ //' ML5_0_ML5SOINDEX_FOR_AMPORDERS' + WRITE(*,*) 'Could not find squared orders ',(ORDERS(I),I=1,NSO) + STOP + + END + +C --=========================================-- +C Definition of additional access routines +C --=========================================-- + + SUBROUTINE ML5_0_COLLIER_COMPUTE_UV_POLES(ONOFF) +C +C This function can be called by the MadLoop user so as to chose +C to have COLLIER +C compute the UV pole or not (it costs more time). +C + LOGICAL ONOFF + + INCLUDE 'MadLoopParams.inc' + + LOGICAL FORCED_CHOICE_OF_COLLIER_UV_POLE_COMPUTATION, + $ FORCED_CHOICE_OF_COLLIER_IR_POLE_COMPUTATION + LOGICAL COLLIER_UV_POLE_COMPUTATION_CHOICE, + $ COLLIER_IR_POLE_COMPUTATION_CHOICE + COMMON/ML5_0_COLLIERPOLESFORCEDCHOICE + $ /FORCED_CHOICE_OF_COLLIER_UV_POLE_COMPUTATION, + $ FORCED_CHOICE_OF_COLLIER_IR_POLE_COMPUTATION + $ ,COLLIER_UV_POLE_COMPUTATION_CHOICE + $ ,COLLIER_IR_POLE_COMPUTATION_CHOICE + + COLLIERCOMPUTEUVPOLES = ONOFF +C This is just so that if we read the param again, we don't +C overwrite the choice made here + FORCED_CHOICE_OF_COLLIER_UV_POLE_COMPUTATION = .TRUE. + COLLIER_UV_POLE_COMPUTATION_CHOICE = ONOFF + + END SUBROUTINE + + SUBROUTINE ML5_0_COLLIER_COMPUTE_IR_POLES(ONOFF) +C +C This function can be called by the MadLoop user so as to chose +C to have COLLIER +C compute the IR pole or not (it costs more time). +C + LOGICAL ONOFF + + INCLUDE 'MadLoopParams.inc' + + LOGICAL FORCED_CHOICE_OF_COLLIER_UV_POLE_COMPUTATION, + $ FORCED_CHOICE_OF_COLLIER_IR_POLE_COMPUTATION + LOGICAL COLLIER_UV_POLE_COMPUTATION_CHOICE, + $ COLLIER_IR_POLE_COMPUTATION_CHOICE + COMMON/ML5_0_COLLIERPOLESFORCEDCHOICE + $ /FORCED_CHOICE_OF_COLLIER_UV_POLE_COMPUTATION, + $ FORCED_CHOICE_OF_COLLIER_IR_POLE_COMPUTATION + $ ,COLLIER_UV_POLE_COMPUTATION_CHOICE + $ ,COLLIER_IR_POLE_COMPUTATION_CHOICE + + COLLIERCOMPUTEIRPOLES = ONOFF +C This is just so that if we read the param again, we don't +C overwrite the choice made here + FORCED_CHOICE_OF_COLLIER_IR_POLE_COMPUTATION = .TRUE. + COLLIER_IR_POLE_COMPUTATION_CHOICE = ONOFF + + END SUBROUTINE + + SUBROUTINE ML5_0_FORCE_STABILITY_CHECK(ONOFF) +C +C This function can be called by the MadLoop user so as to always +C have stability +C checked, even during initialisation, when calling the *_thres +C routines. +C + LOGICAL ONOFF + + LOGICAL BYPASS_CHECK, ALWAYS_TEST_STABILITY + DATA BYPASS_CHECK, ALWAYS_TEST_STABILITY /.FALSE.,.FALSE./ + COMMON/ML5_0_BYPASS_CHECK/BYPASS_CHECK, ALWAYS_TEST_STABILITY + + ALWAYS_TEST_STABILITY = ONOFF + + END SUBROUTINE + + SUBROUTINE ML5_0_SET_AUTOMATIC_CACHE_CLEARING(ONOFF) +C +C This function can be called by the MadLoop user so as to +C manually chose when +C to reset the TIR cache. +C + IMPLICIT NONE + + INCLUDE 'MadLoopParams.inc' + + LOGICAL ONOFF + + LOGICAL AUTOMATIC_CACHE_CLEARING + DATA AUTOMATIC_CACHE_CLEARING/.TRUE./ + COMMON/ML5_0_RUNTIME_OPTIONS/AUTOMATIC_CACHE_CLEARING + + INTEGER N_DP_EVAL, N_QP_EVAL + COMMON/ML5_0_N_EVALS/N_DP_EVAL,N_QP_EVAL + + + AUTOMATIC_CACHE_CLEARING = ONOFF + + IF (NROTATIONS_DP.NE.0.OR.NROTATIONS_QP.NE.0) THEN + WRITE(*,*) 'Warning: One cannot remove the TIR cache automatic' + $ //' clearing while at the same time keeping Lorentz rotations' + $ //' for stability tests.' + WRITE(*,*) 'MadLoop will therefore automatically set' + $ //' NRotations_DP and NRotations_QP to 0.' + NROTATIONS_DP = 0 + NROTATIONS_QP = 0 + CALL ML5_0_SET_N_EVALS(N_DP_EVAL,N_QP_EVAL) + ENDIF + END SUBROUTINE + + SUBROUTINE ML5_0_SET_COUPLINGORDERS_TARGET(SOTARGET) + IMPLICIT NONE +C +C This routine can be accessed by an external user to set the +C squared split order target. +C If set to a value different than -1, the code will try to avoid +C computing anything which +C does not contribute to contributions of squared split orders +C SQSO_TARGET and below. +C This can considerably speed up the code. However, keep in mind +C that any contribution of +C 'squared order index' larger than SQSO_TARGET cannot be trust. +C +C ARGUMENTS +C + INTEGER SOTARGET +C +C GLOBAL +C + INTEGER SQSO_TARGET + COMMON/ML5_0_SOCHOICE/SQSO_TARGET +C ---------- +C BEGIN CODE +C ---------- + SQSO_TARGET = SOTARGET + END + + SUBROUTINE ML5_0_SET_LEG_POLARIZATION(LEG_ID, LEG_POLARIZATION) + IMPLICIT NONE +C +C ARGUMENTS +C + INTEGER LEG_ID + INTEGER LEG_POLARIZATION +C +C LOCALS +C + INTEGER I + INTEGER LEG_POLARIZATIONS(0:5) +C ---------- +C BEGIN CODE +C ---------- + + IF (LEG_POLARIZATION.EQ.-10000) THEN + LEG_POLARIZATIONS(0)=-1 + DO I=1,5 + LEG_POLARIZATIONS(I)=-10000 + ENDDO + ELSE + LEG_POLARIZATIONS(0)=1 + LEG_POLARIZATIONS(1)=LEG_POLARIZATION + DO I=2,5 + LEG_POLARIZATIONS(I)=-10000 + ENDDO + ENDIF + CALL ML5_0_SET_LEG_POLARIZATIONS(LEG_ID,LEG_POLARIZATIONS) + + END + + SUBROUTINE ML5_0_SET_LEG_POLARIZATIONS(LEG_ID, LEG_POLARIZATIONS) + IMPLICIT NONE +C +C CONSTANTS +C + INTEGER NEXTERNAL + PARAMETER (NEXTERNAL=4) + INTEGER NPOLENTRIES + PARAMETER (NPOLENTRIES=(NEXTERNAL+1)*6) + INTEGER NCOMB + PARAMETER (NCOMB=4) +C +C ARGUMENTS +C + INTEGER LEG_ID + INTEGER LEG_POLARIZATIONS(0:5) +C +C LOCALS +C + INTEGER I,J + LOGICAL ALL_SUMMED_OVER +C +C GLOBALS +C +C Entry 0 of the first dimension is all -1 if there is no +C polarization requirement. +C Then for each leg with ID legID, it is either summed over if +C POLARIZATIONS(legID,0) is -1, or the list of helicity considered +C for that +C leg is POLARIZATIONS(legID,1: POLARIZATIONS(legID,0) ). + INTEGER POLARIZATIONS(0:NEXTERNAL,0:5) + DATA ((POLARIZATIONS(I,J),I=0,NEXTERNAL),J=0,5)/NPOLENTRIES*-1/ + COMMON/ML5_0_BEAM_POL/POLARIZATIONS + + INTEGER BORN_POLARIZATIONS(0:NEXTERNAL,0:5) + COMMON/ML5_0_BORN_BEAM_POL/BORN_POLARIZATIONS + +C ---------- +C BEGIN CODE +C ---------- + + IF (LEG_POLARIZATIONS(0).EQ.-1) THEN + DO I=0,5 + POLARIZATIONS(LEG_ID,I)=-1 + ENDDO + ELSE + DO I=0,LEG_POLARIZATIONS(0) + POLARIZATIONS(LEG_ID,I)=LEG_POLARIZATIONS(I) + ENDDO + DO I=LEG_POLARIZATIONS(0)+1,5 + POLARIZATIONS(LEG_ID,I)=-10000 + ENDDO + ENDIF + + ALL_SUMMED_OVER = .TRUE. + DO I=1,NEXTERNAL + IF (POLARIZATIONS(I,0).NE.-1) THEN + ALL_SUMMED_OVER = .FALSE. + EXIT + ENDIF + ENDDO + IF (ALL_SUMMED_OVER) THEN + DO I=0,5 + POLARIZATIONS(0,I)=-1 + ENDDO + ELSE + DO I=0,5 + POLARIZATIONS(0,I)=0 + ENDDO + ENDIF + + DO I=0,NEXTERNAL + DO J=0,5 + BORN_POLARIZATIONS(I,J) = POLARIZATIONS(I,J) + ENDDO + ENDDO + + + RETURN + + END + + SUBROUTINE ML5_0_SLOOPMATRIXHEL(P,HEL,ANS) + IMPLICIT NONE +C +C CONSTANTS +C + INTEGER NEXTERNAL + PARAMETER (NEXTERNAL=4) + INTEGER NSQUAREDSO + PARAMETER (NSQUAREDSO=0) + INTEGER NSQSO_BORN + PARAMETER (NSQSO_BORN=0) + +C +C ARGUMENTS +C + REAL*8 P(0:3,NEXTERNAL) + INTEGER ANS_DIMENSION + PARAMETER(ANS_DIMENSION=MAX(NSQSO_BORN,NSQUAREDSO)) + REAL*8 ANS(0:3,0:ANS_DIMENSION) + INTEGER HEL, USERHEL + COMMON/ML5_0_USERCHOICE/USERHEL +C ---------- +C BEGIN CODE +C ---------- + USERHEL=HEL + CALL ML5_0_SLOOPMATRIX(P,ANS) + END + + SUBROUTINE ML5_0_SLOOPMATRIXHEL_THRES(P,HEL,ANS,PREC_ASKED + $ ,PREC_FOUND,RET_CODE) + IMPLICIT NONE +C +C CONSTANTS +C + INTEGER NEXTERNAL + PARAMETER (NEXTERNAL=4) + INTEGER NSQUAREDSO + PARAMETER (NSQUAREDSO=0) +C +C ARGUMENTS +C + REAL*8 P(0:3,NEXTERNAL) + INTEGER NSQSO_BORN + PARAMETER (NSQSO_BORN=0) + + INTEGER ANS_DIMENSION + PARAMETER(ANS_DIMENSION=MAX(NSQSO_BORN,NSQUAREDSO)) + REAL*8 ANS(0:3,0:ANS_DIMENSION) + INTEGER HEL, RET_CODE + REAL*8 PREC_ASKED,PREC_FOUND(0:NSQUAREDSO) +C +C LOCAL VARIABLES +C + INTEGER I +C +C GLOBAL VARIABLES +C + REAL*8 USER_STAB_PREC + COMMON/ML5_0_USER_STAB_PREC/USER_STAB_PREC + + INTEGER H,T,U + REAL*8 ACCURACY(0:NSQUAREDSO) + COMMON/ML5_0_ACC/ACCURACY,H,T,U + + LOGICAL BYPASS_CHECK, ALWAYS_TEST_STABILITY + COMMON/ML5_0_BYPASS_CHECK/BYPASS_CHECK, ALWAYS_TEST_STABILITY + +C ---------- +C BEGIN CODE +C ---------- + USER_STAB_PREC = PREC_ASKED + + CALL ML5_0_SLOOPMATRIXHEL(P,HEL,ANS) + IF(ALWAYS_TEST_STABILITY.AND.(H.EQ.1.OR.ACCURACY(0).LT.0.0D0)) + $ THEN + BYPASS_CHECK = .TRUE. + CALL ML5_0_SLOOPMATRIXHEL(P,HEL,ANS) + BYPASS_CHECK = .FALSE. +C Make sure we correctly return an initialization-type T code + IF (T.EQ.2) T=4 + IF (T.EQ.1) T=3 + ENDIF + +C Reset it to default value not to affect next runs + USER_STAB_PREC = -1.0D0 + + DO I=0,NSQUAREDSO + PREC_FOUND(I)=ACCURACY(I) + ENDDO + RET_CODE=100*H+10*T+U + + END + + SUBROUTINE ML5_0_SLOOPMATRIX_THRES(P,ANS,PREC_ASKED,PREC_FOUND + $ ,RET_CODE) +C +C Inputs are: +C P(0:3, Nexternal) double :: Kinematic configuration +C (E,px,py,pz) +C PEC_ASKED double :: Target relative accuracy, -1 for +C default +C +C Outputs are: +C ANS(3) double :: Result (finite, single pole, +C double pole) +C PREC_FOUND double :: Relative accuracy estimated for +C the result +C Returns -1 if no stab test could be performed. +C RET_CODE integer :: Return code. See below for details +C +C Return code conventions: RET_CODE = H*100 + T*10 + U +C +C H == 1 +C Stability unknown. +C H == 2 +C Stable PS (SPS) point. +C No stability rescue was necessary. +C H == 3 +C Unstable PS (UPS) point. +C Stability rescue necessary, and successful. +C H == 4 +C Exceptional PS (EPS) point. +C Stability rescue attempted, but unsuccessful. +C +C T == 1 +C Default computation (double prec.) was performed. +C T == 2 +C Quadruple precision was used for this PS point. +C T == 3 +C MadLoop in initialization phase. Only double precision used. +C T == 4 +C MadLoop in initialization phase. Quadruple precision used. +C +C U == 0 +C Not stable. +C U == 1 +C Stable with CutTools in double precision. +C U == 2 +C Stable with PJFry++. +C U == 3 +C Stable with IREGI. +C U == 4 +C Stable with Golem95 +C U == 5 +C Stable with Samurai +C U == 6 +C Stable with Ninja in double precision +C U == 8 +C Stable with Ninja in quadruple precision +C U == 9 +C Stable with CutTools in quadruple precision. +C + IMPLICIT NONE +C +C CONSTANTS +C + INTEGER NEXTERNAL + PARAMETER (NEXTERNAL=4) + INTEGER NSQUAREDSO + PARAMETER (NSQUAREDSO=0) +C +C ARGUMENTS +C + REAL*8 P(0:3,NEXTERNAL) + INTEGER NSQSO_BORN + PARAMETER (NSQSO_BORN=0) + + INTEGER ANS_DIMENSION + PARAMETER(ANS_DIMENSION=MAX(NSQSO_BORN,NSQUAREDSO)) + REAL*8 ANS(0:3,0:ANS_DIMENSION) + REAL*8 PREC_ASKED,PREC_FOUND(0:NSQUAREDSO) + INTEGER RET_CODE +C +C LOCAL VARIABLES +C + INTEGER I +C +C GLOBAL VARIABLES +C + REAL*8 USER_STAB_PREC + COMMON/ML5_0_USER_STAB_PREC/USER_STAB_PREC + + INTEGER H,T,U + REAL*8 ACCURACY(0:NSQUAREDSO) + COMMON/ML5_0_ACC/ACCURACY,H,T,U + + LOGICAL BYPASS_CHECK, ALWAYS_TEST_STABILITY + COMMON/ML5_0_BYPASS_CHECK/BYPASS_CHECK, ALWAYS_TEST_STABILITY + +C ---------- +C BEGIN CODE +C ---------- + USER_STAB_PREC = PREC_ASKED + CALL ML5_0_SLOOPMATRIX(P,ANS) + IF(ALWAYS_TEST_STABILITY.AND.(H.EQ.1.OR.ACCURACY(0).LT.0.0D0)) + $ THEN + BYPASS_CHECK = .TRUE. + CALL ML5_0_SLOOPMATRIX(P,ANS) + BYPASS_CHECK = .FALSE. +C Make sure we correctly return an initialization-type T code + IF (T.EQ.2) T=4 + IF (T.EQ.1) T=3 + ENDIF + +C Reset it to default value not to affect next runs + USER_STAB_PREC = -1.0D0 + DO I=0,NSQUAREDSO + PREC_FOUND(I)=ACCURACY(I) + ENDDO + RET_CODE=100*H+10*T+U + + END + +C The subroutine below perform clean-up duties for MadLoop like +C de-allocating +C arrays + SUBROUTINE ML5_0_EXIT_MADLOOP() + CALL ML5_0_DEALLOCATE_COLOR_FLOWS() + CONTINUE + END + diff --git a/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/loop_max_coefs.inc b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/loop_max_coefs.inc new file mode 100644 index 0000000000..de62c3e6f4 --- /dev/null +++ b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/loop_max_coefs.inc @@ -0,0 +1,2 @@ + INTEGER LOOPMAXCOEFS + PARAMETER (LOOPMAXCOEFS=70) diff --git a/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/loop_num.f b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/loop_num.f new file mode 100644 index 0000000000..4f1175b438 --- /dev/null +++ b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/loop_num.f @@ -0,0 +1,124 @@ +C THE CORE SUBROUTINE CALLED BY CUTTOOLS WHICH CONTAINS THE HELAS +C CALLS BUILDING THE LOOP + + SUBROUTINE ML5_0_LOOPNUM(Q,RES) +C +C CONSTANTS +C + INTEGER NLOOPGROUPS + PARAMETER (NLOOPGROUPS=16) + INCLUDE 'loop_max_coefs.inc' +C These are constants related to the split orders + INTEGER NSQUAREDSO + PARAMETER (NSQUAREDSO=0) +C +C ARGUMENTS +C + COMPLEX*16 Q(0:3) + COMPLEX*16 RES +C +C GLOBAL VARIABLES +C + INTEGER ID,RANK + COMMON/ML5_0_LOOP/ID,RANK + + COMPLEX*16 LOOPCOEFS(0:LOOPMAXCOEFS-1,NLOOPGROUPS) + COMMON/ML5_0_LCOEFS/LOOPCOEFS + + RES=(0.0D0,0.0D0) + + CALL ML5_0_EVAL_POLY(LOOPCOEFS(0,ID),RANK,-Q,RES) + END + + SUBROUTINE ML5_0_MPLOOPNUM(Q,RES) +C +C MODULE +C + INCLUDE 'cts_mprec.h' +C +C CONSTANTS +C + INTEGER NLOOPGROUPS + PARAMETER (NLOOPGROUPS=16) + INTEGER NEXTERNAL + PARAMETER (NEXTERNAL=4) + INCLUDE 'loop_max_coefs.inc' +C These are constants related to the split orders + INTEGER NSQUAREDSO + PARAMETER (NSQUAREDSO=0) +C +C ARGUMENTS +C + INCLUDE 'cts_mpc.h' + $ , INTENT(IN), DIMENSION(0:3) :: Q + INCLUDE 'cts_mpc.h' + $ , INTENT(OUT) :: RES +C +C LOCAL VARIABLES +C + COMPLEX*32 QRES + REAL*8 DUMMY(3,0:NSQUAREDSO) + REAL*16 QPP(0:3,NEXTERNAL) + COMPLEX*32 QQ(0:3) + INTEGER I,J +C +C GLOBAL VARIABLES +C + LOGICAL MP_DONE + COMMON/ML5_0_MP_DONE/MP_DONE + + INTEGER ID,RANK + COMMON/ML5_0_LOOP/ID,RANK + + COMPLEX*32 LOOPCOEFS(0:LOOPMAXCOEFS-1,NLOOPGROUPS) + COMMON/ML5_0_MP_LCOEFS/LOOPCOEFS + +C MP_PS IS THE FIXED (POSSIBLY IMPROVED) MP PS POINT AND MP_P IS +C THE ONE WHICH CAN BE MODIFIED (I.E. ROTATED ETC.) FOR STABILITY +C PURPOSE + REAL*16 MP_PS(0:3,NEXTERNAL),MP_P(0:3,NEXTERNAL) + COMMON/ML5_0_MP_PSPOINT/MP_PS,MP_P + +C ---------- +C BEGIN CODE +C ---------- + DO I=0,3 + QQ(I) = Q(I) + ENDDO + QRES=(0.0E0_16,0.0E0_16) + + CALL MP_ML5_0_EVAL_POLY(LOOPCOEFS(0,ID),RANK,-QQ,QRES) + RES=QRES + + END + + SUBROUTINE ML5_0_MPLOOPNUM_DUMMY(Q,RES) +C +C MODULE +C + INCLUDE 'cts_mprec.h' +C +C ARGUMENTS +C + INCLUDE 'cts_mpc.h' + $ , INTENT(IN), DIMENSION(0:3) :: Q + INCLUDE 'cts_mpc.h' + $ , INTENT(OUT) :: RES +C +C LOCAL VARIABLES +C + COMPLEX*16 DRES + COMPLEX*16 DQ(0:3) + INTEGER I +C ---------- +C BEGIN CODE +C ---------- + DO I=0,3 + DQ(I) = Q(I) + ENDDO + + CALL ML5_0_LOOPNUM(DQ,DRES) + RES=DRES + + END + diff --git a/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/mp_coef_construction_1.f b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/mp_coef_construction_1.f new file mode 100644 index 0000000000..fcd2998172 --- /dev/null +++ b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/mp_coef_construction_1.f @@ -0,0 +1,238 @@ + SUBROUTINE ML5_0_MP_COEF_CONSTRUCTION_1(P,NHEL,H,IC) +C + USE ML5_0_POLYNOMIAL_CONSTANTS + USE ALOHA_OBJECT + IMPLICIT NONE +C +C CONSTANTS +C + INTEGER NEXTERNAL + PARAMETER (NEXTERNAL=4) + INTEGER NCOMB + PARAMETER (NCOMB=4) + + INTEGER NLOOPS, NLOOPGROUPS, NCTAMPS + PARAMETER (NLOOPS=16, NLOOPGROUPS=16, NCTAMPS=4) + INTEGER NLOOPAMPS + PARAMETER (NLOOPAMPS=20) + INTEGER NWAVEFUNCS,NLOOPWAVEFUNCS + PARAMETER (NWAVEFUNCS=5,NLOOPWAVEFUNCS=40) + REAL*16 ZERO + PARAMETER (ZERO=0.0E0_16) + COMPLEX*32 IZERO + PARAMETER (IZERO=CMPLX(0.0E0_16,0.0E0_16,KIND=16)) +C These are constants related to the split orders + INTEGER NSO, NSQUAREDSO, NAMPSO + PARAMETER (NSO=0, NSQUAREDSO=0, NAMPSO=0) +C +C ARGUMENTS +C + REAL*16 P(0:3,NEXTERNAL) + INTEGER NHEL(NEXTERNAL), IC(NEXTERNAL) + INTEGER H +C +C LOCAL VARIABLES +C + INTEGER I,J,K + INTEGER FLAVOR(NEXTERNAL) + DATA FLAVOR /NEXTERNAL*1/ + COMPLEX*32 COEFS(MAXLWFSIZE,0:VERTEXMAXCOEFS-1,MAXLWFSIZE) +C +C GLOBAL VARIABLES +C + + INCLUDE 'mp_coupl_same_name.inc' + + INTEGER GOODHEL(NCOMB) + LOGICAL GOODAMP(NSQUAREDSO,NLOOPGROUPS) + COMMON/ML5_0_FILTERS/GOODAMP,GOODHEL + + INTEGER SQSO_TARGET + COMMON/ML5_0_SOCHOICE/SQSO_TARGET + + LOGICAL UVCT_REQ_SO_DONE,MP_UVCT_REQ_SO_DONE,CT_REQ_SO_DONE + $ ,MP_CT_REQ_SO_DONE,LOOP_REQ_SO_DONE,MP_LOOP_REQ_SO_DONE + $ ,CTCALL_REQ_SO_DONE,FILTER_SO + COMMON/ML5_0_SO_REQS/UVCT_REQ_SO_DONE,MP_UVCT_REQ_SO_DONE + $ ,CT_REQ_SO_DONE,MP_CT_REQ_SO_DONE,LOOP_REQ_SO_DONE + $ ,MP_LOOP_REQ_SO_DONE,CTCALL_REQ_SO_DONE,FILTER_SO + + TYPE(MP_ALOHA) W(NWAVEFUNCS) + COMMON/ML5_0_MP_W/W + + COMPLEX*32 WL(MAXLWFSIZE,0:LOOPMAXCOEFS-1,MAXLWFSIZE, + $ -1:NLOOPWAVEFUNCS) + COMPLEX*32 PL(0:3,-1:NLOOPWAVEFUNCS) + COMMON/ML5_0_MP_WL/WL,PL + + COMPLEX*32 AMPL(3,NLOOPAMPS) + COMMON/ML5_0_MP_AMPL/AMPL + +C +C ---------- +C BEGIN CODE +C ---------- + +C The target squared split order contribution is already reached +C if true. + IF (FILTER_SO.AND.MP_LOOP_REQ_SO_DONE) THEN + GOTO 1001 + ENDIF + +C Coefficient construction for loop diagram with ID 1 + CALL MP_FFV1L1_2(PL(0,0),W(1),GC_5,MDL_MB,ZERO,PL(0,1),COEFS) + CALL MP_ML5_0_UPDATE_WL_0_1(WL(1,0,1,0),4,COEFS,4,4,WL(1,0,1,1)) + CALL MP_FFV1L1_2(PL(0,1),W(2),GC_5,MDL_MB,ZERO,PL(0,2),COEFS) + CALL MP_ML5_0_UPDATE_WL_1_1(WL(1,0,1,1),4,COEFS,4,4,WL(1,0,1,2)) + CALL MP_FFS1L1_2(PL(0,2),W(4),GC_33,MDL_MB,ZERO,PL(0,3),COEFS) + CALL MP_ML5_0_UPDATE_WL_2_1(WL(1,0,1,2),4,COEFS,4,4,WL(1,0,1,3)) + CALL MP_FFS1L1_2(PL(0,3),W(3),GC_33,MDL_MB,ZERO,PL(0,4),COEFS) + CALL MP_ML5_0_UPDATE_WL_3_1(WL(1,0,1,3),4,COEFS,4,4,WL(1,0,1,4)) + CALL MP_ML5_0_CREATE_LOOP_COEFS(WL(1,0,1,4),4,4,1,1,1,5) +C Coefficient construction for loop diagram with ID 2 + CALL MP_FFS1L1_2(PL(0,2),W(3),GC_33,MDL_MB,ZERO,PL(0,5),COEFS) + CALL MP_ML5_0_UPDATE_WL_2_1(WL(1,0,1,2),4,COEFS,4,4,WL(1,0,1,5)) + CALL MP_FFS1L1_2(PL(0,5),W(4),GC_33,MDL_MB,ZERO,PL(0,6),COEFS) + CALL MP_ML5_0_UPDATE_WL_3_1(WL(1,0,1,5),4,COEFS,4,4,WL(1,0,1,6)) + CALL MP_ML5_0_CREATE_LOOP_COEFS(WL(1,0,1,6),4,4,2,1,1,6) +C Coefficient construction for loop diagram with ID 3 + CALL MP_FFS1L1_2(PL(0,2),W(5),GC_33,MDL_MB,ZERO,PL(0,7),COEFS) + CALL MP_ML5_0_UPDATE_WL_2_1(WL(1,0,1,2),4,COEFS,4,4,WL(1,0,1,7)) + CALL MP_ML5_0_CREATE_LOOP_COEFS(WL(1,0,1,7),3,4,3,1,1,7) +C Coefficient construction for loop diagram with ID 4 + CALL MP_FFV1L2_1(PL(0,0),W(1),GC_5,MDL_MB,ZERO,PL(0,8),COEFS) + CALL MP_ML5_0_UPDATE_WL_0_1(WL(1,0,1,0),4,COEFS,4,4,WL(1,0,1,8)) + CALL MP_FFV1L2_1(PL(0,8),W(2),GC_5,MDL_MB,ZERO,PL(0,9),COEFS) + CALL MP_ML5_0_UPDATE_WL_1_1(WL(1,0,1,8),4,COEFS,4,4,WL(1,0,1,9)) + CALL MP_FFS1L2_1(PL(0,9),W(5),GC_33,MDL_MB,ZERO,PL(0,10),COEFS) + CALL MP_ML5_0_UPDATE_WL_2_1(WL(1,0,1,9),4,COEFS,4,4,WL(1,0,1,10)) + CALL MP_ML5_0_CREATE_LOOP_COEFS(WL(1,0,1,10),3,4,4,1,1,8) +C Coefficient construction for loop diagram with ID 5 + CALL MP_FFS1L2_1(PL(0,9),W(4),GC_33,MDL_MB,ZERO,PL(0,11),COEFS) + CALL MP_ML5_0_UPDATE_WL_2_1(WL(1,0,1,9),4,COEFS,4,4,WL(1,0,1,11)) + CALL MP_FFS1L2_1(PL(0,11),W(3),GC_33,MDL_MB,ZERO,PL(0,12),COEFS) + CALL MP_ML5_0_UPDATE_WL_3_1(WL(1,0,1,11),4,COEFS,4,4,WL(1,0,1,12) + $ ) + CALL MP_ML5_0_CREATE_LOOP_COEFS(WL(1,0,1,12),4,4,5,1,1,9) +C Coefficient construction for loop diagram with ID 6 + CALL MP_FFS1L1_2(PL(0,1),W(3),GC_33,MDL_MB,ZERO,PL(0,13),COEFS) + CALL MP_ML5_0_UPDATE_WL_1_1(WL(1,0,1,1),4,COEFS,4,4,WL(1,0,1,13)) + CALL MP_FFV1L1_2(PL(0,13),W(2),GC_5,MDL_MB,ZERO,PL(0,14),COEFS) + CALL MP_ML5_0_UPDATE_WL_2_1(WL(1,0,1,13),4,COEFS,4,4,WL(1,0,1,14) + $ ) + CALL MP_FFS1L1_2(PL(0,14),W(4),GC_33,MDL_MB,ZERO,PL(0,15),COEFS) + CALL MP_ML5_0_UPDATE_WL_3_1(WL(1,0,1,14),4,COEFS,4,4,WL(1,0,1,15) + $ ) + CALL MP_ML5_0_CREATE_LOOP_COEFS(WL(1,0,1,15),4,4,6,1,1,10) +C Coefficient construction for loop diagram with ID 7 + CALL MP_FFS1L2_1(PL(0,9),W(3),GC_33,MDL_MB,ZERO,PL(0,16),COEFS) + CALL MP_ML5_0_UPDATE_WL_2_1(WL(1,0,1,9),4,COEFS,4,4,WL(1,0,1,16)) + CALL MP_FFS1L2_1(PL(0,16),W(4),GC_33,MDL_MB,ZERO,PL(0,17),COEFS) + CALL MP_ML5_0_UPDATE_WL_3_1(WL(1,0,1,16),4,COEFS,4,4,WL(1,0,1,17) + $ ) + CALL MP_ML5_0_CREATE_LOOP_COEFS(WL(1,0,1,17),4,4,7,1,1,11) +C Coefficient construction for loop diagram with ID 8 + CALL MP_FFS1L2_1(PL(0,8),W(3),GC_33,MDL_MB,ZERO,PL(0,18),COEFS) + CALL MP_ML5_0_UPDATE_WL_1_1(WL(1,0,1,8),4,COEFS,4,4,WL(1,0,1,18)) + CALL MP_FFV1L2_1(PL(0,18),W(2),GC_5,MDL_MB,ZERO,PL(0,19),COEFS) + CALL MP_ML5_0_UPDATE_WL_2_1(WL(1,0,1,18),4,COEFS,4,4,WL(1,0,1,19) + $ ) + CALL MP_FFS1L2_1(PL(0,19),W(4),GC_33,MDL_MB,ZERO,PL(0,20),COEFS) + CALL MP_ML5_0_UPDATE_WL_3_1(WL(1,0,1,19),4,COEFS,4,4,WL(1,0,1,20) + $ ) + CALL MP_ML5_0_CREATE_LOOP_COEFS(WL(1,0,1,20),4,4,8,1,1,12) +C Coefficient construction for loop diagram with ID 9 + CALL MP_FFV1L1_2(PL(0,0),W(1),GC_5,MDL_MT,MDL_WT,PL(0,21),COEFS) + CALL MP_ML5_0_UPDATE_WL_0_1(WL(1,0,1,0),4,COEFS,4,4,WL(1,0,1,21)) + CALL MP_FFV1L1_2(PL(0,21),W(2),GC_5,MDL_MT,MDL_WT,PL(0,22),COEFS) + CALL MP_ML5_0_UPDATE_WL_1_1(WL(1,0,1,21),4,COEFS,4,4,WL(1,0,1,22) + $ ) + CALL MP_FFS1L1_2(PL(0,22),W(4),GC_37,MDL_MT,MDL_WT,PL(0,23) + $ ,COEFS) + CALL MP_ML5_0_UPDATE_WL_2_1(WL(1,0,1,22),4,COEFS,4,4,WL(1,0,1,23) + $ ) + CALL MP_FFS1L1_2(PL(0,23),W(3),GC_37,MDL_MT,MDL_WT,PL(0,24) + $ ,COEFS) + CALL MP_ML5_0_UPDATE_WL_3_1(WL(1,0,1,23),4,COEFS,4,4,WL(1,0,1,24) + $ ) + CALL MP_ML5_0_CREATE_LOOP_COEFS(WL(1,0,1,24),4,4,9,1,1,13) +C Coefficient construction for loop diagram with ID 10 + CALL MP_FFS1L1_2(PL(0,22),W(3),GC_37,MDL_MT,MDL_WT,PL(0,25) + $ ,COEFS) + CALL MP_ML5_0_UPDATE_WL_2_1(WL(1,0,1,22),4,COEFS,4,4,WL(1,0,1,25) + $ ) + CALL MP_FFS1L1_2(PL(0,25),W(4),GC_37,MDL_MT,MDL_WT,PL(0,26) + $ ,COEFS) + CALL MP_ML5_0_UPDATE_WL_3_1(WL(1,0,1,25),4,COEFS,4,4,WL(1,0,1,26) + $ ) + CALL MP_ML5_0_CREATE_LOOP_COEFS(WL(1,0,1,26),4,4,10,1,1,14) +C Coefficient construction for loop diagram with ID 11 + CALL MP_FFS1L1_2(PL(0,22),W(5),GC_37,MDL_MT,MDL_WT,PL(0,27) + $ ,COEFS) + CALL MP_ML5_0_UPDATE_WL_2_1(WL(1,0,1,22),4,COEFS,4,4,WL(1,0,1,27) + $ ) + CALL MP_ML5_0_CREATE_LOOP_COEFS(WL(1,0,1,27),3,4,11,1,1,15) +C Coefficient construction for loop diagram with ID 12 + CALL MP_FFV1L2_1(PL(0,0),W(1),GC_5,MDL_MT,MDL_WT,PL(0,28),COEFS) + CALL MP_ML5_0_UPDATE_WL_0_1(WL(1,0,1,0),4,COEFS,4,4,WL(1,0,1,28)) + CALL MP_FFV1L2_1(PL(0,28),W(2),GC_5,MDL_MT,MDL_WT,PL(0,29),COEFS) + CALL MP_ML5_0_UPDATE_WL_1_1(WL(1,0,1,28),4,COEFS,4,4,WL(1,0,1,29) + $ ) + CALL MP_FFS1L2_1(PL(0,29),W(5),GC_37,MDL_MT,MDL_WT,PL(0,30) + $ ,COEFS) + CALL MP_ML5_0_UPDATE_WL_2_1(WL(1,0,1,29),4,COEFS,4,4,WL(1,0,1,30) + $ ) + CALL MP_ML5_0_CREATE_LOOP_COEFS(WL(1,0,1,30),3,4,12,1,1,16) +C Coefficient construction for loop diagram with ID 13 + CALL MP_FFS1L2_1(PL(0,29),W(4),GC_37,MDL_MT,MDL_WT,PL(0,31) + $ ,COEFS) + CALL MP_ML5_0_UPDATE_WL_2_1(WL(1,0,1,29),4,COEFS,4,4,WL(1,0,1,31) + $ ) + CALL MP_FFS1L2_1(PL(0,31),W(3),GC_37,MDL_MT,MDL_WT,PL(0,32) + $ ,COEFS) + CALL MP_ML5_0_UPDATE_WL_3_1(WL(1,0,1,31),4,COEFS,4,4,WL(1,0,1,32) + $ ) + CALL MP_ML5_0_CREATE_LOOP_COEFS(WL(1,0,1,32),4,4,13,1,1,17) +C Coefficient construction for loop diagram with ID 14 + CALL MP_FFS1L1_2(PL(0,21),W(3),GC_37,MDL_MT,MDL_WT,PL(0,33) + $ ,COEFS) + CALL MP_ML5_0_UPDATE_WL_1_1(WL(1,0,1,21),4,COEFS,4,4,WL(1,0,1,33) + $ ) + CALL MP_FFV1L1_2(PL(0,33),W(2),GC_5,MDL_MT,MDL_WT,PL(0,34),COEFS) + CALL MP_ML5_0_UPDATE_WL_2_1(WL(1,0,1,33),4,COEFS,4,4,WL(1,0,1,34) + $ ) + CALL MP_FFS1L1_2(PL(0,34),W(4),GC_37,MDL_MT,MDL_WT,PL(0,35) + $ ,COEFS) + CALL MP_ML5_0_UPDATE_WL_3_1(WL(1,0,1,34),4,COEFS,4,4,WL(1,0,1,35) + $ ) + CALL MP_ML5_0_CREATE_LOOP_COEFS(WL(1,0,1,35),4,4,14,1,1,18) +C Coefficient construction for loop diagram with ID 15 + CALL MP_FFS1L2_1(PL(0,29),W(3),GC_37,MDL_MT,MDL_WT,PL(0,36) + $ ,COEFS) + CALL MP_ML5_0_UPDATE_WL_2_1(WL(1,0,1,29),4,COEFS,4,4,WL(1,0,1,36) + $ ) + CALL MP_FFS1L2_1(PL(0,36),W(4),GC_37,MDL_MT,MDL_WT,PL(0,37) + $ ,COEFS) + CALL MP_ML5_0_UPDATE_WL_3_1(WL(1,0,1,36),4,COEFS,4,4,WL(1,0,1,37) + $ ) + CALL MP_ML5_0_CREATE_LOOP_COEFS(WL(1,0,1,37),4,4,15,1,1,19) +C Coefficient construction for loop diagram with ID 16 + CALL MP_FFS1L2_1(PL(0,28),W(3),GC_37,MDL_MT,MDL_WT,PL(0,38) + $ ,COEFS) + CALL MP_ML5_0_UPDATE_WL_1_1(WL(1,0,1,28),4,COEFS,4,4,WL(1,0,1,38) + $ ) + CALL MP_FFV1L2_1(PL(0,38),W(2),GC_5,MDL_MT,MDL_WT,PL(0,39),COEFS) + CALL MP_ML5_0_UPDATE_WL_2_1(WL(1,0,1,38),4,COEFS,4,4,WL(1,0,1,39) + $ ) + CALL MP_FFS1L2_1(PL(0,39),W(4),GC_37,MDL_MT,MDL_WT,PL(0,40) + $ ,COEFS) + CALL MP_ML5_0_UPDATE_WL_3_1(WL(1,0,1,39),4,COEFS,4,4,WL(1,0,1,40) + $ ) + CALL MP_ML5_0_CREATE_LOOP_COEFS(WL(1,0,1,40),4,4,16,1,1,20) + + GOTO 1001 + 4000 CONTINUE + MP_LOOP_REQ_SO_DONE=.TRUE. + 1001 CONTINUE + END + diff --git a/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/mp_compute_loop_coefs.f b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/mp_compute_loop_coefs.f new file mode 100644 index 0000000000..073afef667 --- /dev/null +++ b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/mp_compute_loop_coefs.f @@ -0,0 +1,633 @@ + SUBROUTINE ML5_0_MP_COMPUTE_LOOP_COEFS(PS,ANSDP) +C +C Generated by MadGraph5_aMC@NLO v. %(version)s, %(date)s +C By the MadGraph5_aMC@NLO Development Team +C Visit launchpad.net/madgraph5 and amcatnlo.web.cern.ch +C +C Returns amplitude squared summed/avg over colors +C and helicities for the point in phase space P(0:3,NEXTERNAL) +C and external lines W(0:6,NEXTERNAL) +C +C Process: g g > h h QCD<=2 QED<=2 [ sqrvirt = QCD ] +C +C Modules +C + USE ML5_0_POLYNOMIAL_CONSTANTS + USE ALOHA_OBJECT +C + IMPLICIT NONE +C +C CONSTANTS +C + CHARACTER*64 PARAMFILENAME + PARAMETER ( PARAMFILENAME='MadLoopParams.dat') + INTEGER NLOOPS, NLOOPGROUPS, NCTAMPS + PARAMETER (NLOOPS=16, NLOOPGROUPS=16, NCTAMPS=4) + INTEGER NLOOPAMPS + PARAMETER (NLOOPAMPS=20) + INTEGER NCOLORROWS + PARAMETER (NCOLORROWS=NLOOPAMPS) + INTEGER NEXTERNAL + PARAMETER (NEXTERNAL=4) + INTEGER NWAVEFUNCS,NLOOPWAVEFUNCS + PARAMETER (NWAVEFUNCS=5,NLOOPWAVEFUNCS=40) + INTEGER NCOMB + PARAMETER (NCOMB=4) + REAL*16 ZERO + PARAMETER (ZERO=0E0_16) + COMPLEX*32 IMAG1 + PARAMETER (IMAG1=(0E0_16,1E0_16)) + COMPLEX*32 DP_IMAG1 + PARAMETER (DP_IMAG1=(0D0,1D0)) +C These are constants related to the split orders + INTEGER NSO, NSQUAREDSO, NAMPSO + PARAMETER (NSO=0, NSQUAREDSO=0, NAMPSO=0) + +C The variables below are just used in the context of a JAMP +C consistency check turned off by default. + LOGICAL DIRECT_ME_COMPUTATION, ME_COMPUTATION_FROM_JAMP + REAL*8 RES_FROM_JAMP(0:3,0:NSQUAREDSO) + COMMON/ML5_0_DOUBLECHECK_JAMP/RES_FROM_JAMP + $ ,DIRECT_ME_COMPUTATION,ME_COMPUTATION_FROM_JAMP + +C +C ARGUMENTS +C + REAL*16 PS(0:3,NEXTERNAL) + REAL*8 ANSDP(3,0:NSQUAREDSO) +C +C LOCAL VARIABLES +C + LOGICAL DPW_COPIED + LOGICAL COMPUTE_INTEGRAND_IN_QP + INTEGER I,J,K,H,HEL_MULT,ITEMP + REAL*16 TEMP2(3) + REAL*8 DP_TEMP2(3) + COMPLEX*32 CTEMP + COMPLEX*16 DP_CTEMP + + INTEGER NHEL(NEXTERNAL), IC(NEXTERNAL) + REAL*16 MP_P(0:3,NEXTERNAL) + REAL*8 P(0:3,NEXTERNAL) + + DATA IC/NEXTERNAL*1/ + REAL*16 ANS(3,0:NSQUAREDSO) + REAL*8 BUFFRES(0:3,0:NSQUAREDSO) + COMPLEX*32 COEFS(MAXLWFSIZE,0:VERTEXMAXCOEFS-1,MAXLWFSIZE) + COMPLEX*32 CFTOT + COMPLEX*16 DP_CFTOT +C +C FUNCTIONS +C + LOGICAL ML5_0_IS_HEL_SELECTED + INTEGER ML5_0_ML5SOINDEX_FOR_BORN_AMP + INTEGER ML5_0_ML5SOINDEX_FOR_LOOP_AMP + INTEGER ML5_0_ML5SQSOINDEX +C +C GLOBAL VARIABLES +C + + INCLUDE 'mp_coupl_same_name.inc' + + INCLUDE 'MadLoopParams.inc' + + LOGICAL CHECKPHASE, HELDOUBLECHECKED + COMMON/ML5_0_INIT/CHECKPHASE, HELDOUBLECHECKED + + INTEGER HELOFFSET + INTEGER GOODHEL(NCOMB) + LOGICAL GOODAMP(NSQUAREDSO,NLOOPGROUPS) + COMMON/ML5_0_FILTERS/GOODAMP,GOODHEL,HELOFFSET + + INTEGER HELPICKED + COMMON/ML5_0_HELCHOICE/HELPICKED + + INTEGER USERHEL + COMMON/ML5_0_USERCHOICE/USERHEL + + INTEGER SQSO_TARGET + COMMON/ML5_0_SOCHOICE/SQSO_TARGET + + LOGICAL UVCT_REQ_SO_DONE,MP_UVCT_REQ_SO_DONE,CT_REQ_SO_DONE + $ ,MP_CT_REQ_SO_DONE,LOOP_REQ_SO_DONE,MP_LOOP_REQ_SO_DONE + $ ,CTCALL_REQ_SO_DONE,FILTER_SO + COMMON/ML5_0_SO_REQS/UVCT_REQ_SO_DONE,MP_UVCT_REQ_SO_DONE + $ ,CT_REQ_SO_DONE,MP_CT_REQ_SO_DONE,LOOP_REQ_SO_DONE + $ ,MP_LOOP_REQ_SO_DONE,CTCALL_REQ_SO_DONE,FILTER_SO + + TYPE(MP_ALOHA) W(NWAVEFUNCS) + COMMON/ML5_0_MP_W/W + + TYPE(ALOHA) DPW(NWAVEFUNCS) + COMMON/ML5_0_W/DPW + + COMPLEX*32 WL(MAXLWFSIZE,0:LOOPMAXCOEFS-1,MAXLWFSIZE, + $ -1:NLOOPWAVEFUNCS) + COMPLEX*32 PL(0:3,-1:NLOOPWAVEFUNCS) + COMMON/ML5_0_MP_WL/WL,PL + + COMPLEX*16 DP_WL(MAXLWFSIZE,0:LOOPMAXCOEFS-1,MAXLWFSIZE, + $ -1:NLOOPWAVEFUNCS) + COMPLEX*16 DP_PL(0:3,-1:NLOOPWAVEFUNCS) + COMMON/ML5_0_WL/DP_WL,DP_PL + + COMPLEX*32 LOOPCOEFS(0:LOOPMAXCOEFS-1,NLOOPGROUPS) + COMMON/ML5_0_MP_LCOEFS/LOOPCOEFS + + COMPLEX*16 DP_LOOPCOEFS(0:LOOPMAXCOEFS-1,NLOOPGROUPS) + COMMON/ML5_0_LCOEFS/DP_LOOPCOEFS + +C This flag is used to prevent the re-computation of the OpenLoop +C coefficients when changing the CTMode for the stability test. + LOGICAL SKIP_LOOPNUM_COEFS_CONSTRUCTION + COMMON/ML5_0_SKIP_COEFS/SKIP_LOOPNUM_COEFS_CONSTRUCTION + + COMPLEX*32 AMPL(3,NLOOPAMPS) + COMMON/ML5_0_MP_AMPL/AMPL + + COMPLEX*16 DP_AMPL(3,NLOOPAMPS) + COMMON/ML5_0_AMPL/DP_AMPL + + COMPLEX*16 LOOPRES(3,NSQUAREDSO,NLOOPGROUPS) + LOGICAL S(NSQUAREDSO,NLOOPGROUPS) + COMMON/ML5_0_LOOPRES/LOOPRES,S + + INTEGER I_SO + COMMON/ML5_0_I_SO/I_SO + + INTEGER CF_D(NCOLORROWS,NLOOPAMPS) + INTEGER CF_N(NCOLORROWS,NLOOPAMPS) + COMMON/ML5_0_CF/CF_D,CF_N + + INTEGER HELC(NEXTERNAL,NCOMB) + COMMON/ML5_0_HELCONFIGS/HELC + + LOGICAL MP_DONE_ONCE + COMMON/ML5_0_MP_DONE_ONCE/MP_DONE_ONCE + + INTEGER LIBINDEX + COMMON/ML5_0_I_LIB/LIBINDEX + +C This array specify potential special requirements on the +C helicities to +C consider. POLARIZATIONS(0,0) is -1 if there is not such +C requirement. + INTEGER POLARIZATIONS(0:NEXTERNAL,0:5) + COMMON/ML5_0_BEAM_POL/POLARIZATIONS + +C ---------- +C BEGIN CODE +C ---------- + +C Decide whether to really compute the integrand in quadruple +C precision or to fake it and copy the double precision +C computation in the quadruple precision variables. + COMPUTE_INTEGRAND_IN_QP = ((MLREDUCTIONLIB(LIBINDEX) + $ .EQ.6.AND.USEQPINTEGRANDFORNINJA) .OR. (MLREDUCTIONLIB(LIBINDEX) + $ .EQ.1.AND.USEQPINTEGRANDFORCUTTOOLS)) + +C To be on the safe side, we always update the MP params here. +C It can be redundant as this routine can be called a couple of +C times for the same PS point during the stability checks. +C But it is really not time consuming and I would rather be safe. + CALL MP_UPDATE_AS_PARAM() + + MP_DONE_ONCE = .TRUE. + +C AS A SAFETY MEASURE WE FIRST COPY HERE THE PS POINT + DO I=1,NEXTERNAL + DO J=0,3 + MP_P(J,I)=PS(J,I) + P(J,I) = REAL(PS(J,I),KIND=8) + ENDDO + ENDDO + + DO I=0,3 + PL(I,-1)=CMPLX(ZERO,ZERO,KIND=16) + PL(I,0)=CMPLX(ZERO,ZERO,KIND=16) + IF (.NOT.COMPUTE_INTEGRAND_IN_QP) THEN + DP_PL(I,-1)=DCMPLX(0.0D0,0.0D0) + DP_PL(I,0)=DCMPLX(0.0D0,0.0D0) + ENDIF + ENDDO + + IF (.NOT.SKIP_LOOPNUM_COEFS_CONSTRUCTION) THEN + DO I=1,MAXLWFSIZE + DO J=0,LOOPMAXCOEFS-1 + DO K=1,MAXLWFSIZE + WL(I,J,K,-1)=(ZERO,ZERO) + DP_WL(I,J,K,-1)=(0.0D0,0.0D0) + IF (I.EQ.K.AND.J.EQ.0) THEN + WL(I,J,K,0)=(1.0E0_16,ZERO) + ELSE + WL(I,J,K,0)=(ZERO,ZERO) + ENDIF + IF (.NOT.COMPUTE_INTEGRAND_IN_QP) THEN + IF (I.EQ.K.AND.J.EQ.0) THEN + DP_WL(I,J,K,0)=(1.0D0,0.0D0) + ELSE + DP_WL(I,J,K,0)=(0.0D0,0.0D0) + ENDIF + ENDIF + ENDDO + ENDDO + ENDDO + +C This is the chare conjugate version of the unit 4-currents in +C the canonical cartesian basis. +C This, for now, is only defined for 4-fermionic currents. + WL(1,0,2,-1) = (-1.0E0_16,ZERO) + WL(2,0,1,-1) = (1.0E0_16,ZERO) + WL(3,0,4,-1) = (1.0E0_16,ZERO) + WL(4,0,3,-1) = (-1.0E0_16,ZERO) + DP_WL(1,0,2,-1) = DCMPLX(-1.0D0,0.0D0) + DP_WL(2,0,1,-1) = DCMPLX(1.0D0,0.0D0) + DP_WL(3,0,4,-1) = DCMPLX(1.0D0,0.0D0) + DP_WL(4,0,3,-1) = DCMPLX(-1.0D0,0.0D0) + + + DO K=1, 3 + DO I=1,NLOOPAMPS + AMPL(K,I)=(ZERO,ZERO) + IF (.NOT.COMPUTE_INTEGRAND_IN_QP) THEN + DP_AMPL(K,I)=(0.0D0,0.0D0) + ENDIF + ENDDO + ENDDO + + ENDIF + + + + DO K=1,3 + DO J=0,NSQUAREDSO + ANSDP(K,J)=0.0D0 + ANS(K,J)=ZERO + ENDDO + ENDDO + + DPW_COPIED = .FALSE. + DO H=1,NCOMB + IF ((HELPICKED.EQ.H).OR.((HELPICKED.EQ.-1) + $ .AND.(CHECKPHASE.OR.(.NOT.HELDOUBLECHECKED).OR.(GOODHEL(H) + $ .GT.-HELOFFSET.AND.GOODHEL(H).NE.0)))) THEN + +C Handle the possible requirement of specific polarizations + IF ((.NOT.CHECKPHASE) + $ .AND.HELDOUBLECHECKED.AND.POLARIZATIONS(0,0) + $ .EQ.0.AND.(.NOT.ML5_0_IS_HEL_SELECTED(H))) THEN + CYCLE + ENDIF + + DO I=1,NEXTERNAL + NHEL(I)=HELC(I,H) + ENDDO + + IF (COMPUTE_INTEGRAND_IN_QP) THEN + MP_UVCT_REQ_SO_DONE=.FALSE. + MP_CT_REQ_SO_DONE=.FALSE. + MP_LOOP_REQ_SO_DONE=.FALSE. + ELSE + UVCT_REQ_SO_DONE=.FALSE. + CT_REQ_SO_DONE=.FALSE. + LOOP_REQ_SO_DONE=.FALSE. + ENDIF + + IF (.NOT.CHECKPHASE.AND.HELDOUBLECHECKED.AND.HELPICKED.EQ.-1) + $ THEN + HEL_MULT=GOODHEL(H) + ELSE + HEL_MULT=1 + ENDIF + + CTCALL_REQ_SO_DONE=.FALSE. + +C The coefficient were already computed previously with +C another CTMode, so we can skip them + IF (SKIP_LOOPNUM_COEFS_CONSTRUCTION) THEN + GOTO 4000 + ENDIF + + DO I=1,NLOOPGROUPS + DO J=0,LOOPMAXCOEFS-1 + LOOPCOEFS(J,I)=(ZERO,ZERO) + IF (.NOT.COMPUTE_INTEGRAND_IN_QP) THEN + DP_LOOPCOEFS(J,I)=(0.0D0,0.0D0) + ENDIF + ENDDO + ENDDO + + DO K=1, 3 + DO I=1,NLOOPAMPS + AMPL(K,I)=(ZERO,ZERO) + IF (.NOT.COMPUTE_INTEGRAND_IN_QP) THEN + DP_AMPL(K,I)=(0.0D0,0.0D0) + ENDIF + ENDDO + ENDDO + + IF (COMPUTE_INTEGRAND_IN_QP) THEN + CALL ML5_0_MP_HELAS_CALLS_AMPB_1(MP_P,NHEL,H,IC) + CONTINUE + ELSE + CALL ML5_0_HELAS_CALLS_AMPB_1(P,NHEL,H,IC) + CONTINUE + ENDIF + + 2000 CONTINUE + MP_CT_REQ_SO_DONE=.TRUE. + + IF (COMPUTE_INTEGRAND_IN_QP) THEN + + CONTINUE + ELSE + + CONTINUE + ENDIF + + IF (.NOT.COMPUTE_INTEGRAND_IN_QP) THEN +C Copy back to the quantities computed in DP in the QP +C containers (but only those needed) + DO I=1,NCTAMPS + DO K=1,3 + AMPL(K,I)=CMPLX(DP_AMPL(K,I),KIND=16) + ENDDO + ENDDO + DO I=1,NWAVEFUNCS + DO J=1,SIZE(W(I)%W) + W(I)%W(J)=CMPLX(DPW(I)%W(J),KIND=16) + ENDDO + W(I)%P = DPW(I)%P + W(I)%FLV_INDEX = DPW(I)%FLV_INDEX + ENDDO + ENDIF + + 3000 CONTINUE + MP_UVCT_REQ_SO_DONE=.TRUE. + + + IF (COMPUTE_INTEGRAND_IN_QP) THEN + + CALL ML5_0_MP_COEF_CONSTRUCTION_1(MP_P,NHEL,H,IC) + + ELSE + + CALL ML5_0_COEF_CONSTRUCTION_1(P,NHEL,H,IC) + +C Copy back to the coefficients computed in DP in the QP +C containers + DO I=0,LOOPMAXCOEFS-1 + DO K=1,NLOOPGROUPS + LOOPCOEFS(I,K)=CMPLX(DP_LOOPCOEFS(I,K),KIND=16) + ENDDO + ENDDO + ENDIF + + 4000 CONTINUE + MP_LOOP_REQ_SO_DONE=.TRUE. + + IF (COMPUTE_INTEGRAND_IN_QP) THEN + +C Copy the multiple precision CT amplitudes computed to the +C AMPL double precision array for its use later if +C necessary (i.e. color flows for example.) + DO I=1,NCTAMPS + DO K=1,3 + DP_AMPL(K,I)=CMPLX(AMPL(K,I),KIND=8) + ENDDO + ENDDO + + ENDIF + +C Copy the qp wfs to the dp ones as they are used to setup the +C CT calls. +C This needs to be done once since only the momenta of these +C WF matters. + IF(.NOT.DPW_COPIED.AND.COMPUTE_INTEGRAND_IN_QP) THEN + DO I=1,NWAVEFUNCS + DO J=1,SIZE(W(I)%W) + DPW(I)%W(J)=CMPLX(W(I)%W(J),KIND=8) + ENDDO + DPW(I)%P = W(I)%P + DPW(I)%FLV_INDEX = W(I)%FLV_INDEX + ENDDO + DPW_COPIED=.TRUE. + ENDIF + + DO I=1,NSQUAREDSO + DO J=1,NLOOPGROUPS + S(I,J)=.TRUE. + ENDDO + ENDDO + +C We need a dummy argument for the squared order index to +C conform to the +C structure that the call to the LOOP* subroutine takes for +C processes with Born diagrams. + I_SO=1 + CALL ML5_0_LOOP_CT_CALLS_1(P,NHEL,H,IC) + 5000 CONTINUE + CTCALL_REQ_SO_DONE=.TRUE. + +C Copy the loop amplitudes computed (whose final result was +C stored in a double +C precision variable) to the AMPL multiple precision array. + DO I=NCTAMPS+1,NLOOPAMPS + DO K=1,3 + AMPL(K,I)=CMPLX(DP_AMPL(K,I),KIND=16) + ENDDO + ENDDO + + IF (DIRECT_ME_COMPUTATION) THEN + DO I=1,NLOOPAMPS + DO J=1,NLOOPAMPS + + IF (COMPUTE_INTEGRAND_IN_QP) THEN + + CFTOT=CMPLX(CF_N(I,J)/REAL(ABS(CF_D(I,J)),KIND=16) + $ ,0.0E0_16,KIND=16) + IF(CF_D(I,J).LT.0) CFTOT=CFTOT*IMAG1 + ITEMP = + $ ML5_0_ML5SQSOINDEX(ML5_0_ML5SOINDEX_FOR_LOOP_AMP(I) + $ ,ML5_0_ML5SOINDEX_FOR_LOOP_AMP(J)) + TEMP2(1) = HEL_MULT*REAL(CFTOT*AMPL(1,I) + $ *CONJG(AMPL(1,J)),KIND=16) +C Computing the quantities below is not strictly +C necessary since the result should be finite +C It is however a good cross-check. + TEMP2(2) = HEL_MULT*REAL(CFTOT*(AMPL(2,I) + $ *CONJG(AMPL(1,J)) + AMPL(1,I)*CONJG(AMPL(2,J))) + $ ,KIND=16) + TEMP2(3) = HEL_MULT*REAL(CFTOT*(AMPL(3,I) + $ *CONJG(AMPL(1,J)) + AMPL(1,I)*CONJG(AMPL(3,J)) + $ +AMPL(2,I)*CONJG(AMPL(2,J))),KIND=16) + + ELSE + + DP_CFTOT=CMPLX(CF_N(I,J)/REAL(ABS(CF_D(I,J)),KIND=8) + $ ,0.0D0,KIND=8) + IF(CF_D(I,J).LT.0) DP_CFTOT=DP_CFTOT*DP_IMAG1 + ITEMP = + $ ML5_0_ML5SQSOINDEX(ML5_0_ML5SOINDEX_FOR_LOOP_AMP(I) + $ ,ML5_0_ML5SOINDEX_FOR_LOOP_AMP(J)) + DP_TEMP2(1) = HEL_MULT*REAL(DP_CFTOT*DP_AMPL(1,I) + $ *DCONJG(DP_AMPL(1,J)),KIND=8) +C Computing the quantities below is not strictly +C necessary since the result should be finite +C It is however a good cross-check. + DP_TEMP2(2) = HEL_MULT*REAL(DP_CFTOT*(DP_AMPL(2,I) + $ *DCONJG(DP_AMPL(1,J)) + DP_AMPL(1,I) + $ *DCONJG(DP_AMPL(2,J))),KIND=8) + DP_TEMP2(3) = HEL_MULT*REAL(DP_CFTOT*(DP_AMPL(3,I) + $ *DCONJG(DP_AMPL(1,J)) + DP_AMPL(1,I) + $ *DCONJG(DP_AMPL(3,J))+DP_AMPL(2,I)*DCONJG(DP_AMPL(2 + $ ,J))),KIND=8) + + ENDIF + +C To mimic the structure of the non loop-induced +C processes, we add here the squared counterterm +C contribution directly the result ANS and put the loop +C contributions in the LOOPRES array which will be +C added to ANS later + IF (I.LE.NCTAMPS) THEN + IF (.NOT.FILTER_SO.OR.SQSO_TARGET.EQ.ITEMP) THEN + DO K=1,3 + IF (COMPUTE_INTEGRAND_IN_QP) THEN + ANS(K,ITEMP)=ANS(K,ITEMP)+TEMP2(K) + ANS(K,0)=ANS(K,0)+TEMP2(K) + ELSE + ANSDP(K,ITEMP)=ANSDP(K,ITEMP)+DP_TEMP2(K) + ANSDP(K,0)=ANSDP(K,0)+DP_TEMP2(K) + ENDIF + ENDDO + ENDIF + ELSE + DO K=1,3 +C This LOOPRES array entries will be added to the +C main result ANS(*,*) later in the loop_matrix.f +C file. It is in double precision however, so the +C cast of the temporary variable TEMP2 is necessary. + IF (COMPUTE_INTEGRAND_IN_QP) THEN + LOOPRES(K,ITEMP,I-NCTAMPS)=LOOPRES(K,ITEMP,I + $ -NCTAMPS)+DBLE(TEMP2(K)) + ELSE + LOOPRES(K,ITEMP,I-NCTAMPS)=LOOPRES(K,ITEMP,I + $ -NCTAMPS)+DP_TEMP2(K) + ENDIF +C During the evaluation of the AMPL, we had stored +C the stability in S(1,*) so we now copy over this +C flag to the relevant contributing Squared orders. + S(ITEMP,I-NCTAMPS)=S(1,I-NCTAMPS) + ENDDO + ENDIF + ENDDO + ENDDO + + ENDIF + + + + +C We should compute the color flow either if it contributes to +C the final result (i.e. not used just for the filtering), or +C if the computation is only done from the color flows + IF (((.NOT.DIRECT_ME_COMPUTATION) + $ .AND.ME_COMPUTATION_FROM_JAMP) + $ .OR.((H.EQ.USERHEL.OR.USERHEL.EQ.-1).AND.(POLARIZATIONS(0,0) + $ .EQ.-1.OR.ML5_0_IS_HEL_SELECTED(H)))) THEN +C The cumulative quantities must only be computed if that +C helicity contributes according to user request (second +C argument of the subroutine below). + CALL ML5_0_COMPUTE_COLOR_FLOWS(HEL_MULT) + IF(ME_COMPUTATION_FROM_JAMP) THEN + CALL ML5_0_COMPUTE_RES_FROM_JAMP(BUFFRES,HEL_MULT) + IF(((.NOT.DIRECT_ME_COMPUTATION) + $ .AND.ME_COMPUTATION_FROM_JAMP)) THEN +C If the computation from the color flow is the only +C form of computation, we directly update the answer. + DO K=1,3 + DO I=0,NSQUAREDSO + IF (COMPUTE_INTEGRAND_IN_QP) THEN + ANS(K,I)=ANS(K,I)+REAL(BUFFRES(K,I),KIND=16) + ELSE + ANSDP(K,I)=ANSDP(K,I)+BUFFRES(K,I) + ENDIF + ENDDO + ENDDO +C In this case, we temporarily store the compute Born ME +C in RES_FROM_JAMP(0,I), which will be used to set +C ANS(0,I) just after the call to this subroutine in +C loop_matrix.f + DO I=0,NSQUAREDSO + RES_FROM_JAMP(0,I)=RES_FROM_JAMP(0,I)+BUFFRES(0,I) + ENDDO +C When setting up the loop filter, it is important to +C set the quantitied LOOPRES. +C Notice that you may have a more powerful filter with +C the direct computation mode because it can filter +C vanishing loop contributions for a particular squared +C split order only +C The quantity LOOPRES defined below is not physical,' +C //' but it's ok since it is only intended for the loop +C filtering. +C In principle it is no longer necessary to compute the +C quantity below once the loop filter is setup, but it +C takes a negligible amount of time compare to the quad +C prec computations. + DO J=1,NLOOPGROUPS + DO I=1,NSQUAREDSO + DO K=1,3 + LOOPRES(K,I,J)=LOOPRES(K,I,J)+DP_AMPL(K,NCTAMPS + $ +J) + ENDDO + ENDDO + ENDDO +C The if statement below is not strictly necessary but +C makes it clear when it is executed. + ELSEIF(H.EQ.USERHEL.OR.USERHEL.EQ.-1) THEN +C Make sure that that no polarization constraint filters +C out this helicity + IF (POLARIZATIONS(0,0).EQ. + $ -1.OR.ML5_0_IS_HEL_SELECTED(H)) THEN +C If both computational method is used, then we must +C just update RES_FROM_JAMP + DO K=0,3 + DO I=0,NSQUAREDSO + RES_FROM_JAMP(K,I)=RES_FROM_JAMP(K,I)+BUFFRES(K + $ ,I) + ENDDO + ENDDO + ENDIF + ENDIF + IF (H.EQ.USERHEL.OR.USERHEL.EQ.-1) THEN +C Make sure that that no polarization constraint filters +C out this helicity + IF (POLARIZATIONS(0,0).EQ. + $ -1.OR.ML5_0_IS_HEL_SELECTED(H)) THEN + CALL + $ ML5_0_COMPUTE_COLOR_FLOWS_DERIVED_QUANTITIES(HEL_MU + $LT) + ENDIF + ENDIF + ENDIF + ENDIF + + ENDIF + ENDDO + + +C If we were not computing the integrand in QP, then we were +C already updating ANSDP all along, so that fetching it here from +C the QP ANS(:,:) should not be done. + IF (COMPUTE_INTEGRAND_IN_QP) THEN + DO I=1,3 + DO J=0,NSQUAREDSO + ANSDP(I,J)=REAL(ANS(I,J),KIND=8) + ENDDO + ENDDO + ENDIF + + + END + diff --git a/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/mp_helas_calls_ampb_1.f b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/mp_helas_calls_ampb_1.f new file mode 100644 index 0000000000..a0a98c4800 --- /dev/null +++ b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/mp_helas_calls_ampb_1.f @@ -0,0 +1,101 @@ + SUBROUTINE ML5_0_MP_HELAS_CALLS_AMPB_1(P,NHEL,H,IC) +C + USE ML5_0_POLYNOMIAL_CONSTANTS + USE ALOHA_OBJECT + IMPLICIT NONE +C +C CONSTANTS +C + INTEGER NEXTERNAL + PARAMETER (NEXTERNAL=4) + INTEGER NCOMB + PARAMETER (NCOMB=4) + + INTEGER NLOOPS, NLOOPGROUPS, NCTAMPS + PARAMETER (NLOOPS=16, NLOOPGROUPS=16, NCTAMPS=4) + INTEGER NLOOPAMPS + PARAMETER (NLOOPAMPS=20) + INTEGER NWAVEFUNCS,NLOOPWAVEFUNCS + PARAMETER (NWAVEFUNCS=5,NLOOPWAVEFUNCS=40) + REAL*16 ZERO + PARAMETER (ZERO=0.0E0_16) + COMPLEX*32 IZERO + PARAMETER (IZERO=CMPLX(0.0E0_16,0.0E0_16,KIND=16)) +C These are constants related to the split orders + INTEGER NSO, NSQUAREDSO, NAMPSO + PARAMETER (NSO=0, NSQUAREDSO=0, NAMPSO=0) +C +C ARGUMENTS +C + REAL*16 P(0:3,NEXTERNAL) + INTEGER NHEL(NEXTERNAL), IC(NEXTERNAL) + INTEGER H +C +C LOCAL VARIABLES +C + INTEGER I,J,K + INTEGER FLAVOR(NEXTERNAL) + DATA FLAVOR /NEXTERNAL*1/ + COMPLEX*32 COEFS(MAXLWFSIZE,0:VERTEXMAXCOEFS-1,MAXLWFSIZE) +C +C GLOBAL VARIABLES +C + + INCLUDE 'mp_coupl_same_name.inc' + + INTEGER GOODHEL(NCOMB) + LOGICAL GOODAMP(NSQUAREDSO,NLOOPGROUPS) + COMMON/ML5_0_FILTERS/GOODAMP,GOODHEL + + INTEGER SQSO_TARGET + COMMON/ML5_0_SOCHOICE/SQSO_TARGET + + LOGICAL UVCT_REQ_SO_DONE,MP_UVCT_REQ_SO_DONE,CT_REQ_SO_DONE + $ ,MP_CT_REQ_SO_DONE,LOOP_REQ_SO_DONE,MP_LOOP_REQ_SO_DONE + $ ,CTCALL_REQ_SO_DONE,FILTER_SO + COMMON/ML5_0_SO_REQS/UVCT_REQ_SO_DONE,MP_UVCT_REQ_SO_DONE + $ ,CT_REQ_SO_DONE,MP_CT_REQ_SO_DONE,LOOP_REQ_SO_DONE + $ ,MP_LOOP_REQ_SO_DONE,CTCALL_REQ_SO_DONE,FILTER_SO + + TYPE(MP_ALOHA) W(NWAVEFUNCS) + COMMON/ML5_0_MP_W/W + + COMPLEX*32 WL(MAXLWFSIZE,0:LOOPMAXCOEFS-1,MAXLWFSIZE, + $ -1:NLOOPWAVEFUNCS) + COMPLEX*32 PL(0:3,-1:NLOOPWAVEFUNCS) + COMMON/ML5_0_MP_WL/WL,PL + + COMPLEX*32 AMPL(3,NLOOPAMPS) + COMMON/ML5_0_MP_AMPL/AMPL + +C +C ---------- +C BEGIN CODE +C ---------- + +C The target squared split order contribution is already reached +C if true. + IF (FILTER_SO.AND.MP_CT_REQ_SO_DONE) THEN + GOTO 1001 + ENDIF + + CALL MP_VXXXXX(P(0,1),ZERO,NHEL(1),-1,W(1)) + CALL MP_VXXXXX(P(0,2),ZERO,NHEL(2),-1,W(2)) + CALL MP_SXXXXX(P(0,3),+1,W(3)) + CALL MP_SXXXXX(P(0,4),+1,W(4)) +C Counter-term amplitude(s) for loop diagram number 1 + CALL MP_R2_GGHH_0(W(1),W(2),W(4),W(3),R2_GGHHB,AMPL(1,1)) + CALL MP_SSS1_1(W(3),W(4),GC_30,MDL_MH,MDL_WH,W(5)) +C Counter-term amplitude(s) for loop diagram number 3 + CALL MP_VVS1_0(W(1),W(2),W(5),R2_GGHB,AMPL(1,2)) +C Counter-term amplitude(s) for loop diagram number 9 + CALL MP_R2_GGHH_0(W(1),W(2),W(4),W(3),R2_GGHHT,AMPL(1,3)) +C Counter-term amplitude(s) for loop diagram number 11 + CALL MP_VVS1_0(W(1),W(2),W(5),R2_GGHT,AMPL(1,4)) + + GOTO 1001 + 2000 CONTINUE + MP_CT_REQ_SO_DONE=.TRUE. + 1001 CONTINUE + END + diff --git a/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/nexternal.inc b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/nexternal.inc new file mode 100644 index 0000000000..f50affaedb --- /dev/null +++ b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/nexternal.inc @@ -0,0 +1,4 @@ + INTEGER NEXTERNAL + PARAMETER (NEXTERNAL=4) + INTEGER NINCOMING + PARAMETER (NINCOMING=2) diff --git a/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/ngraphs.inc b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/ngraphs.inc new file mode 100644 index 0000000000..e0ac3e6827 --- /dev/null +++ b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/ngraphs.inc @@ -0,0 +1,2 @@ + INTEGER N_MAX_CG + PARAMETER (N_MAX_CG=36) diff --git a/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/nsquaredSO.inc b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/nsquaredSO.inc new file mode 100644 index 0000000000..8060bbf5e8 --- /dev/null +++ b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/nsquaredSO.inc @@ -0,0 +1,2 @@ + INTEGER NSQUAREDSO + PARAMETER (NSQUAREDSO=0) diff --git a/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/pmass.inc b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/pmass.inc new file mode 100644 index 0000000000..c0bcee8829 --- /dev/null +++ b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/pmass.inc @@ -0,0 +1,4 @@ + PMASS(1)=ZERO + PMASS(2)=ZERO + PMASS(3)=ABS(MDL_MH) + PMASS(4)=ABS(MDL_MH) diff --git a/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/polynomial.f b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/polynomial.f new file mode 100644 index 0000000000..7076bd0b44 --- /dev/null +++ b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/polynomial.f @@ -0,0 +1,592 @@ + MODULE ML5_0_POLYNOMIAL_CONSTANTS + IMPLICIT NONE + INCLUDE 'coef_specs.inc' + INCLUDE 'loop_max_coefs.inc' + +C Map associating a rank to each coefficient position + INTEGER COEFTORANK_MAP(0:LOOPMAXCOEFS-1) + DATA COEFTORANK_MAP(0:0)/1*0/ + DATA COEFTORANK_MAP(1:4)/4*1/ + DATA COEFTORANK_MAP(5:14)/10*2/ + DATA COEFTORANK_MAP(15:34)/20*3/ + DATA COEFTORANK_MAP(35:69)/35*4/ + +C Map defining the number of coefficients for a symmetric tensor +C of a given rank + INTEGER NCOEF_R(0:4) + DATA NCOEF_R/1,5,15,35,70/ + +C Map defining the coef position resulting from the multiplication +C of two lower rank coefs. + INTEGER COMB_COEF_POS(0:LOOPMAXCOEFS-1,0:4) + DATA COMB_COEF_POS( 0, 0: 4) / 0, 1, 2, 3, 4/ + DATA COMB_COEF_POS( 1, 0: 4) / 1, 5, 6, 8, 11/ + DATA COMB_COEF_POS( 2, 0: 4) / 2, 6, 7, 9, 12/ + DATA COMB_COEF_POS( 3, 0: 4) / 3, 8, 9, 10, 13/ + DATA COMB_COEF_POS( 4, 0: 4) / 4, 11, 12, 13, 14/ + DATA COMB_COEF_POS( 5, 0: 4) / 5, 15, 16, 19, 25/ + DATA COMB_COEF_POS( 6, 0: 4) / 6, 16, 17, 20, 26/ + DATA COMB_COEF_POS( 7, 0: 4) / 7, 17, 18, 21, 27/ + DATA COMB_COEF_POS( 8, 0: 4) / 8, 19, 20, 22, 28/ + DATA COMB_COEF_POS( 9, 0: 4) / 9, 20, 21, 23, 29/ + DATA COMB_COEF_POS( 10, 0: 4) / 10, 22, 23, 24, 30/ + DATA COMB_COEF_POS( 11, 0: 4) / 11, 25, 26, 28, 31/ + DATA COMB_COEF_POS( 12, 0: 4) / 12, 26, 27, 29, 32/ + DATA COMB_COEF_POS( 13, 0: 4) / 13, 28, 29, 30, 33/ + DATA COMB_COEF_POS( 14, 0: 4) / 14, 31, 32, 33, 34/ + DATA COMB_COEF_POS( 15, 0: 4) / 15, 35, 36, 40, 50/ + DATA COMB_COEF_POS( 16, 0: 4) / 16, 36, 37, 41, 51/ + DATA COMB_COEF_POS( 17, 0: 4) / 17, 37, 38, 42, 52/ + DATA COMB_COEF_POS( 18, 0: 4) / 18, 38, 39, 43, 53/ + DATA COMB_COEF_POS( 19, 0: 4) / 19, 40, 41, 44, 54/ + DATA COMB_COEF_POS( 20, 0: 4) / 20, 41, 42, 45, 55/ + DATA COMB_COEF_POS( 21, 0: 4) / 21, 42, 43, 46, 56/ + DATA COMB_COEF_POS( 22, 0: 4) / 22, 44, 45, 47, 57/ + DATA COMB_COEF_POS( 23, 0: 4) / 23, 45, 46, 48, 58/ + DATA COMB_COEF_POS( 24, 0: 4) / 24, 47, 48, 49, 59/ + DATA COMB_COEF_POS( 25, 0: 4) / 25, 50, 51, 54, 60/ + DATA COMB_COEF_POS( 26, 0: 4) / 26, 51, 52, 55, 61/ + DATA COMB_COEF_POS( 27, 0: 4) / 27, 52, 53, 56, 62/ + DATA COMB_COEF_POS( 28, 0: 4) / 28, 54, 55, 57, 63/ + DATA COMB_COEF_POS( 29, 0: 4) / 29, 55, 56, 58, 64/ + DATA COMB_COEF_POS( 30, 0: 4) / 30, 57, 58, 59, 65/ + DATA COMB_COEF_POS( 31, 0: 4) / 31, 60, 61, 63, 66/ + DATA COMB_COEF_POS( 32, 0: 4) / 32, 61, 62, 64, 67/ + DATA COMB_COEF_POS( 33, 0: 4) / 33, 63, 64, 65, 68/ + DATA COMB_COEF_POS( 34, 0: 4) / 34, 66, 67, 68, 69/ + DATA COMB_COEF_POS( 35, 0: 4) / 35, 70, 71, 76, 91/ + DATA COMB_COEF_POS( 36, 0: 4) / 36, 71, 72, 77, 92/ + DATA COMB_COEF_POS( 37, 0: 4) / 37, 72, 73, 78, 93/ + DATA COMB_COEF_POS( 38, 0: 4) / 38, 73, 74, 79, 94/ + DATA COMB_COEF_POS( 39, 0: 4) / 39, 74, 75, 80, 95/ + DATA COMB_COEF_POS( 40, 0: 4) / 40, 76, 77, 81, 96/ + DATA COMB_COEF_POS( 41, 0: 4) / 41, 77, 78, 82, 97/ + DATA COMB_COEF_POS( 42, 0: 4) / 42, 78, 79, 83, 98/ + DATA COMB_COEF_POS( 43, 0: 4) / 43, 79, 80, 84, 99/ + DATA COMB_COEF_POS( 44, 0: 4) / 44, 81, 82, 85,100/ + DATA COMB_COEF_POS( 45, 0: 4) / 45, 82, 83, 86,101/ + DATA COMB_COEF_POS( 46, 0: 4) / 46, 83, 84, 87,102/ + DATA COMB_COEF_POS( 47, 0: 4) / 47, 85, 86, 88,103/ + DATA COMB_COEF_POS( 48, 0: 4) / 48, 86, 87, 89,104/ + DATA COMB_COEF_POS( 49, 0: 4) / 49, 88, 89, 90,105/ + DATA COMB_COEF_POS( 50, 0: 4) / 50, 91, 92, 96,106/ + DATA COMB_COEF_POS( 51, 0: 4) / 51, 92, 93, 97,107/ + DATA COMB_COEF_POS( 52, 0: 4) / 52, 93, 94, 98,108/ + DATA COMB_COEF_POS( 53, 0: 4) / 53, 94, 95, 99,109/ + DATA COMB_COEF_POS( 54, 0: 4) / 54, 96, 97,100,110/ + DATA COMB_COEF_POS( 55, 0: 4) / 55, 97, 98,101,111/ + DATA COMB_COEF_POS( 56, 0: 4) / 56, 98, 99,102,112/ + DATA COMB_COEF_POS( 57, 0: 4) / 57,100,101,103,113/ + DATA COMB_COEF_POS( 58, 0: 4) / 58,101,102,104,114/ + DATA COMB_COEF_POS( 59, 0: 4) / 59,103,104,105,115/ + DATA COMB_COEF_POS( 60, 0: 4) / 60,106,107,110,116/ + DATA COMB_COEF_POS( 61, 0: 4) / 61,107,108,111,117/ + DATA COMB_COEF_POS( 62, 0: 4) / 62,108,109,112,118/ + DATA COMB_COEF_POS( 63, 0: 4) / 63,110,111,113,119/ + DATA COMB_COEF_POS( 64, 0: 4) / 64,111,112,114,120/ + DATA COMB_COEF_POS( 65, 0: 4) / 65,113,114,115,121/ + DATA COMB_COEF_POS( 66, 0: 4) / 66,116,117,119,122/ + DATA COMB_COEF_POS( 67, 0: 4) / 67,117,118,120,123/ + DATA COMB_COEF_POS( 68, 0: 4) / 68,119,120,121,124/ + DATA COMB_COEF_POS( 69, 0: 4) / 69,122,123,124,125/ + + END MODULE ML5_0_POLYNOMIAL_CONSTANTS + + +C The subroutine to create the loop coefficients form the last +C loop wf. +C In this case of loop-induced process, the reduction is performed +C at the loop +C amplitude level so that no multiplication is performed. + + SUBROUTINE ML5_0_CREATE_LOOP_COEFS(LOOP_WF,RANK,LCUT_SIZE + $ ,LOOP_GROUP_NUMBER,SYMFACT,MULTIPLIER) + USE ML5_0_POLYNOMIAL_CONSTANTS + IMPLICIT NONE +C +C CONSTANTS +C + REAL*8 ZERO,ONE + PARAMETER (ZERO=0.0D0,ONE=1.0D0) + COMPLEX*16 IMAG1 + PARAMETER (IMAG1=(ZERO,ONE)) + COMPLEX*16 CMPLX_ZERO + PARAMETER (CMPLX_ZERO=(ZERO,ZERO)) + INTEGER NLOOPGROUPS + PARAMETER (NLOOPGROUPS=16) + INTEGER NCOMB + PARAMETER (NCOMB=4) +C +C ARGUMENTS +C + COMPLEX*16 LOOP_WF(MAXLWFSIZE,0:LOOPMAXCOEFS-1,MAXLWFSIZE) + INTEGER RANK, SYMFACT, LCUT_SIZE, LOOP_GROUP_NUMBER, MULTIPLIER +C +C LOCAL VARIABLES +C + COMPLEX*16 CONST + INTEGER I,J +C +C GLOBAL VARIABLES +C + COMPLEX*16 LOOPCOEFS(0:LOOPMAXCOEFS-1,NLOOPGROUPS) + COMMON/ML5_0_LCOEFS/LOOPCOEFS +C +C BEGIN CODE +C + CONST=CMPLX((ONE*MULTIPLIER)/SYMFACT,ZERO,KIND=16) + + CALL ML5_0_MERGE_WL(LOOP_WF,RANK,LCUT_SIZE,CONST,LOOPCOEFS(0 + $ ,LOOP_GROUP_NUMBER)) + + END + + +C Now the routines to update the wavefunctions + + + +C The subroutine to create the loop coefficients form the last +C loop wf. +C In this case of loop-induced process, the reduction is performed +C at the loop +C amplitude level so that no multiplication is performed. + + SUBROUTINE MP_ML5_0_CREATE_LOOP_COEFS(LOOP_WF,RANK,LCUT_SIZE + $ ,LOOP_GROUP_NUMBER,SYMFACT,MULTIPLIER) + USE ML5_0_POLYNOMIAL_CONSTANTS + IMPLICIT NONE +C +C CONSTANTS +C + REAL*16 ZERO,ONE + PARAMETER (ZERO=0.0E0_16,ONE=1.0E0_16) + COMPLEX*32 IMAG1 + PARAMETER (IMAG1=(ZERO,ONE)) + COMPLEX*32 CMPLX_ZERO + PARAMETER (CMPLX_ZERO=(ZERO,ZERO)) + INTEGER NLOOPGROUPS + PARAMETER (NLOOPGROUPS=16) + INTEGER NCOMB + PARAMETER (NCOMB=4) +C +C ARGUMENTS +C + COMPLEX*32 LOOP_WF(MAXLWFSIZE,0:LOOPMAXCOEFS-1,MAXLWFSIZE) + INTEGER RANK, SYMFACT, LCUT_SIZE, LOOP_GROUP_NUMBER, MULTIPLIER +C +C LOCAL VARIABLES +C + COMPLEX*32 CONST + INTEGER I,J +C +C GLOBAL VARIABLES +C + COMPLEX*32 LOOPCOEFS(0:LOOPMAXCOEFS-1,NLOOPGROUPS) + COMMON/ML5_0_MP_LCOEFS/LOOPCOEFS +C +C BEGIN CODE +C + CONST=CMPLX((ONE*MULTIPLIER)/SYMFACT,ZERO,KIND=16) + + CALL MP_ML5_0_MERGE_WL(LOOP_WF,RANK,LCUT_SIZE,CONST,LOOPCOEFS(0 + $ ,LOOP_GROUP_NUMBER)) + + END + + +C Now the routines to update the wavefunctions + + + + SUBROUTINE ML5_0_EVAL_POLY(C,R,Q,OUT) + USE ML5_0_POLYNOMIAL_CONSTANTS + COMPLEX*16 C(0:LOOPMAXCOEFS-1) + INTEGER R + COMPLEX*16 Q(0:3) + COMPLEX*16 OUT + + OUT=C(0) + IF (R.GE.1) THEN + OUT=OUT+C(1)*Q(0)+C(2)*Q(1)+C(3)*Q(2)+C(4)*Q(3) + ENDIF + IF (R.GE.2) THEN + OUT=OUT+C(5)*Q(0)*Q(0)+C(6)*Q(0)*Q(1)+C(7)*Q(1)*Q(1)+C(8)*Q(0) + $ *Q(2)+C(9)*Q(1)*Q(2)+C(10)*Q(2)*Q(2)+C(11)*Q(0)*Q(3)+C(12) + $ *Q(1)*Q(3)+C(13)*Q(2)*Q(3)+C(14)*Q(3)*Q(3) + ENDIF + IF (R.GE.3) THEN + OUT=OUT+C(15)*Q(0)*Q(0)*Q(0)+C(16)*Q(0)*Q(0)*Q(1)+C(17)*Q(0) + $ *Q(1)*Q(1)+C(18)*Q(1)*Q(1)*Q(1)+C(19)*Q(0)*Q(0)*Q(2)+C(20) + $ *Q(0)*Q(1)*Q(2)+C(21)*Q(1)*Q(1)*Q(2)+C(22)*Q(0)*Q(2)*Q(2) + $ +C(23)*Q(1)*Q(2)*Q(2)+C(24)*Q(2)*Q(2)*Q(2)+C(25)*Q(0)*Q(0) + $ *Q(3)+C(26)*Q(0)*Q(1)*Q(3)+C(27)*Q(1)*Q(1)*Q(3)+C(28)*Q(0) + $ *Q(2)*Q(3)+C(29)*Q(1)*Q(2)*Q(3)+C(30)*Q(2)*Q(2)*Q(3)+C(31) + $ *Q(0)*Q(3)*Q(3)+C(32)*Q(1)*Q(3)*Q(3)+C(33)*Q(2)*Q(3)*Q(3) + $ +C(34)*Q(3)*Q(3)*Q(3) + ENDIF + IF (R.GE.4) THEN + OUT=OUT+C(35)*Q(0)*Q(0)*Q(0)*Q(0)+C(36)*Q(0)*Q(0)*Q(0)*Q(1) + $ +C(37)*Q(0)*Q(0)*Q(1)*Q(1)+C(38)*Q(0)*Q(1)*Q(1)*Q(1)+C(39) + $ *Q(1)*Q(1)*Q(1)*Q(1)+C(40)*Q(0)*Q(0)*Q(0)*Q(2)+C(41)*Q(0)*Q(0) + $ *Q(1)*Q(2)+C(42)*Q(0)*Q(1)*Q(1)*Q(2)+C(43)*Q(1)*Q(1)*Q(1)*Q(2) + $ +C(44)*Q(0)*Q(0)*Q(2)*Q(2)+C(45)*Q(0)*Q(1)*Q(2)*Q(2)+C(46) + $ *Q(1)*Q(1)*Q(2)*Q(2)+C(47)*Q(0)*Q(2)*Q(2)*Q(2)+C(48)*Q(1)*Q(2) + $ *Q(2)*Q(2)+C(49)*Q(2)*Q(2)*Q(2)*Q(2)+C(50)*Q(0)*Q(0)*Q(0)*Q(3) + $ +C(51)*Q(0)*Q(0)*Q(1)*Q(3)+C(52)*Q(0)*Q(1)*Q(1)*Q(3)+C(53) + $ *Q(1)*Q(1)*Q(1)*Q(3)+C(54)*Q(0)*Q(0)*Q(2)*Q(3)+C(55)*Q(0)*Q(1) + $ *Q(2)*Q(3)+C(56)*Q(1)*Q(1)*Q(2)*Q(3)+C(57)*Q(0)*Q(2)*Q(2)*Q(3) + $ +C(58)*Q(1)*Q(2)*Q(2)*Q(3)+C(59)*Q(2)*Q(2)*Q(2)*Q(3)+C(60) + $ *Q(0)*Q(0)*Q(3)*Q(3)+C(61)*Q(0)*Q(1)*Q(3)*Q(3)+C(62)*Q(1)*Q(1) + $ *Q(3)*Q(3)+C(63)*Q(0)*Q(2)*Q(3)*Q(3)+C(64)*Q(1)*Q(2)*Q(3)*Q(3) + OUT=OUT+C(65)*Q(2)*Q(2)*Q(3)*Q(3)+C(66)*Q(0)*Q(3)*Q(3)*Q(3) + $ +C(67)*Q(1)*Q(3)*Q(3)*Q(3)+C(68)*Q(2)*Q(3)*Q(3)*Q(3)+C(69) + $ *Q(3)*Q(3)*Q(3)*Q(3) + ENDIF + END + + SUBROUTINE MP_ML5_0_EVAL_POLY(C,R,Q,OUT) + USE ML5_0_POLYNOMIAL_CONSTANTS + COMPLEX*32 C(0:LOOPMAXCOEFS-1) + INTEGER R + COMPLEX*32 Q(0:3) + COMPLEX*32 OUT + + OUT=C(0) + IF (R.GE.1) THEN + OUT=OUT+C(1)*Q(0)+C(2)*Q(1)+C(3)*Q(2)+C(4)*Q(3) + ENDIF + IF (R.GE.2) THEN + OUT=OUT+C(5)*Q(0)*Q(0)+C(6)*Q(0)*Q(1)+C(7)*Q(1)*Q(1)+C(8)*Q(0) + $ *Q(2)+C(9)*Q(1)*Q(2)+C(10)*Q(2)*Q(2)+C(11)*Q(0)*Q(3)+C(12) + $ *Q(1)*Q(3)+C(13)*Q(2)*Q(3)+C(14)*Q(3)*Q(3) + ENDIF + IF (R.GE.3) THEN + OUT=OUT+C(15)*Q(0)*Q(0)*Q(0)+C(16)*Q(0)*Q(0)*Q(1)+C(17)*Q(0) + $ *Q(1)*Q(1)+C(18)*Q(1)*Q(1)*Q(1)+C(19)*Q(0)*Q(0)*Q(2)+C(20) + $ *Q(0)*Q(1)*Q(2)+C(21)*Q(1)*Q(1)*Q(2)+C(22)*Q(0)*Q(2)*Q(2) + $ +C(23)*Q(1)*Q(2)*Q(2)+C(24)*Q(2)*Q(2)*Q(2)+C(25)*Q(0)*Q(0) + $ *Q(3)+C(26)*Q(0)*Q(1)*Q(3)+C(27)*Q(1)*Q(1)*Q(3)+C(28)*Q(0) + $ *Q(2)*Q(3)+C(29)*Q(1)*Q(2)*Q(3)+C(30)*Q(2)*Q(2)*Q(3)+C(31) + $ *Q(0)*Q(3)*Q(3)+C(32)*Q(1)*Q(3)*Q(3)+C(33)*Q(2)*Q(3)*Q(3) + $ +C(34)*Q(3)*Q(3)*Q(3) + ENDIF + IF (R.GE.4) THEN + OUT=OUT+C(35)*Q(0)*Q(0)*Q(0)*Q(0)+C(36)*Q(0)*Q(0)*Q(0)*Q(1) + $ +C(37)*Q(0)*Q(0)*Q(1)*Q(1)+C(38)*Q(0)*Q(1)*Q(1)*Q(1)+C(39) + $ *Q(1)*Q(1)*Q(1)*Q(1)+C(40)*Q(0)*Q(0)*Q(0)*Q(2)+C(41)*Q(0)*Q(0) + $ *Q(1)*Q(2)+C(42)*Q(0)*Q(1)*Q(1)*Q(2)+C(43)*Q(1)*Q(1)*Q(1)*Q(2) + $ +C(44)*Q(0)*Q(0)*Q(2)*Q(2)+C(45)*Q(0)*Q(1)*Q(2)*Q(2)+C(46) + $ *Q(1)*Q(1)*Q(2)*Q(2)+C(47)*Q(0)*Q(2)*Q(2)*Q(2)+C(48)*Q(1)*Q(2) + $ *Q(2)*Q(2)+C(49)*Q(2)*Q(2)*Q(2)*Q(2)+C(50)*Q(0)*Q(0)*Q(0)*Q(3) + $ +C(51)*Q(0)*Q(0)*Q(1)*Q(3)+C(52)*Q(0)*Q(1)*Q(1)*Q(3)+C(53) + $ *Q(1)*Q(1)*Q(1)*Q(3)+C(54)*Q(0)*Q(0)*Q(2)*Q(3)+C(55)*Q(0)*Q(1) + $ *Q(2)*Q(3)+C(56)*Q(1)*Q(1)*Q(2)*Q(3)+C(57)*Q(0)*Q(2)*Q(2)*Q(3) + $ +C(58)*Q(1)*Q(2)*Q(2)*Q(3)+C(59)*Q(2)*Q(2)*Q(2)*Q(3)+C(60) + $ *Q(0)*Q(0)*Q(3)*Q(3)+C(61)*Q(0)*Q(1)*Q(3)*Q(3)+C(62)*Q(1)*Q(1) + $ *Q(3)*Q(3)+C(63)*Q(0)*Q(2)*Q(3)*Q(3)+C(64)*Q(1)*Q(2)*Q(3)*Q(3) + OUT=OUT+C(65)*Q(2)*Q(2)*Q(3)*Q(3)+C(66)*Q(0)*Q(3)*Q(3)*Q(3) + $ +C(67)*Q(1)*Q(3)*Q(3)*Q(3)+C(68)*Q(2)*Q(3)*Q(3)*Q(3)+C(69) + $ *Q(3)*Q(3)*Q(3)*Q(3) + ENDIF + END + + SUBROUTINE ML5_0_ADD_COEFS(A,RA,B,RB) + USE ML5_0_POLYNOMIAL_CONSTANTS + INTEGER I + COMPLEX*16 A(0:LOOPMAXCOEFS-1),B(0:LOOPMAXCOEFS-1) + INTEGER RA,RB + + DO I=0,NCOEF_R(RB)-1 + A(I)=A(I)+B(I) + ENDDO + END + + SUBROUTINE MP_ML5_0_ADD_COEFS(A,RA,B,RB) + USE ML5_0_POLYNOMIAL_CONSTANTS + INTEGER I + COMPLEX*32 A(0:LOOPMAXCOEFS-1),B(0:LOOPMAXCOEFS-1) + INTEGER RA,RB + + DO I=0,NCOEF_R(RB)-1 + A(I)=A(I)+B(I) + ENDDO + END + + SUBROUTINE ML5_0_MERGE_WL(WL,R,LCUT_SIZE,CONST,OUT) + USE ML5_0_POLYNOMIAL_CONSTANTS + INTEGER I,J + COMPLEX*16 WL(MAXLWFSIZE,0:LOOPMAXCOEFS-1,MAXLWFSIZE) + INTEGER R,LCUT_SIZE + COMPLEX*16 CONST + COMPLEX*16 OUT(0:LOOPMAXCOEFS-1) + + DO I=1,LCUT_SIZE + DO J=0,NCOEF_R(R)-1 + OUT(J)=OUT(J)+WL(I,J,I)*CONST + ENDDO + ENDDO + END + + SUBROUTINE MP_ML5_0_MERGE_WL(WL,R,LCUT_SIZE,CONST,OUT) + USE ML5_0_POLYNOMIAL_CONSTANTS + INTEGER I,J + COMPLEX*32 WL(MAXLWFSIZE,0:LOOPMAXCOEFS-1,MAXLWFSIZE) + INTEGER R,LCUT_SIZE + COMPLEX*32 CONST + COMPLEX*32 OUT(0:LOOPMAXCOEFS-1) + + DO I=1,LCUT_SIZE + DO J=0,NCOEF_R(R)-1 + OUT(J)=OUT(J)+WL(I,J,I)*CONST + ENDDO + ENDDO + END + + SUBROUTINE ML5_0_UPDATE_WL_0_1(A,LCUT_SIZE,B,IN_SIZE,OUT_SIZE + $ ,OUT) + USE ML5_0_POLYNOMIAL_CONSTANTS + INTEGER I,J,K + COMPLEX*16 A(MAXLWFSIZE,0:LOOPMAXCOEFS-1,MAXLWFSIZE) + COMPLEX*16 B(MAXLWFSIZE,0:VERTEXMAXCOEFS-1,MAXLWFSIZE) + COMPLEX*16 OUT(MAXLWFSIZE,0:LOOPMAXCOEFS-1,MAXLWFSIZE) + INTEGER LCUT_SIZE,IN_SIZE,OUT_SIZE + + DO I=1,LCUT_SIZE + DO J=1,OUT_SIZE + DO K=0,4 + OUT(J,K,I)=(0.0D0,0.0D0) + ENDDO + DO K=1,IN_SIZE + OUT(J,0,I)=OUT(J,0,I)+A(K,0,I)*B(J,0,K) + OUT(J,1,I)=OUT(J,1,I)+A(K,0,I)*B(J,1,K) + OUT(J,2,I)=OUT(J,2,I)+A(K,0,I)*B(J,2,K) + OUT(J,3,I)=OUT(J,3,I)+A(K,0,I)*B(J,3,K) + OUT(J,4,I)=OUT(J,4,I)+A(K,0,I)*B(J,4,K) + ENDDO + ENDDO + ENDDO + END + + SUBROUTINE MP_ML5_0_UPDATE_WL_0_1(A,LCUT_SIZE,B,IN_SIZE,OUT_SIZE + $ ,OUT) + USE ML5_0_POLYNOMIAL_CONSTANTS + INTEGER I,J,K + COMPLEX*32 A(MAXLWFSIZE,0:LOOPMAXCOEFS-1,MAXLWFSIZE) + COMPLEX*32 B(MAXLWFSIZE,0:VERTEXMAXCOEFS-1,MAXLWFSIZE) + COMPLEX*32 OUT(MAXLWFSIZE,0:LOOPMAXCOEFS-1,MAXLWFSIZE) + INTEGER LCUT_SIZE,IN_SIZE,OUT_SIZE + + DO I=1,LCUT_SIZE + DO J=1,OUT_SIZE + DO K=0,4 + OUT(J,K,I)=CMPLX(0.0E0_16,0.0E0_16,KIND=16) + ENDDO + DO K=1,IN_SIZE + OUT(J,0,I)=OUT(J,0,I)+A(K,0,I)*B(J,0,K) + OUT(J,1,I)=OUT(J,1,I)+A(K,0,I)*B(J,1,K) + OUT(J,2,I)=OUT(J,2,I)+A(K,0,I)*B(J,2,K) + OUT(J,3,I)=OUT(J,3,I)+A(K,0,I)*B(J,3,K) + OUT(J,4,I)=OUT(J,4,I)+A(K,0,I)*B(J,4,K) + ENDDO + ENDDO + ENDDO + END + + SUBROUTINE ML5_0_UPDATE_WL_1_1(A,LCUT_SIZE,B,IN_SIZE,OUT_SIZE + $ ,OUT) + USE ML5_0_POLYNOMIAL_CONSTANTS + INTEGER I,J,K + COMPLEX*16 A(MAXLWFSIZE,0:LOOPMAXCOEFS-1,MAXLWFSIZE) + COMPLEX*16 B(MAXLWFSIZE,0:VERTEXMAXCOEFS-1,MAXLWFSIZE) + COMPLEX*16 OUT(MAXLWFSIZE,0:LOOPMAXCOEFS-1,MAXLWFSIZE) + INTEGER LCUT_SIZE,IN_SIZE,OUT_SIZE + + DO I=1,LCUT_SIZE + DO J=1,OUT_SIZE + DO K=0,14 + OUT(J,K,I)=(0.0D0,0.0D0) + ENDDO + DO K=1,IN_SIZE + OUT(J,0,I)=OUT(J,0,I)+A(K,0,I)*B(J,0,K) + OUT(J,1,I)=OUT(J,1,I)+A(K,0,I)*B(J,1,K)+A(K,1,I)*B(J,0,K) + OUT(J,2,I)=OUT(J,2,I)+A(K,0,I)*B(J,2,K)+A(K,2,I)*B(J,0,K) + OUT(J,3,I)=OUT(J,3,I)+A(K,0,I)*B(J,3,K)+A(K,3,I)*B(J,0,K) + OUT(J,4,I)=OUT(J,4,I)+A(K,0,I)*B(J,4,K)+A(K,4,I)*B(J,0,K) + OUT(J,5,I)=OUT(J,5,I)+A(K,1,I)*B(J,1,K) + OUT(J,6,I)=OUT(J,6,I)+A(K,1,I)*B(J,2,K)+A(K,2,I)*B(J,1,K) + OUT(J,7,I)=OUT(J,7,I)+A(K,2,I)*B(J,2,K) + OUT(J,8,I)=OUT(J,8,I)+A(K,1,I)*B(J,3,K)+A(K,3,I)*B(J,1,K) + OUT(J,9,I)=OUT(J,9,I)+A(K,2,I)*B(J,3,K)+A(K,3,I)*B(J,2,K) + OUT(J,10,I)=OUT(J,10,I)+A(K,3,I)*B(J,3,K) + OUT(J,11,I)=OUT(J,11,I)+A(K,1,I)*B(J,4,K)+A(K,4,I)*B(J,1,K) + OUT(J,12,I)=OUT(J,12,I)+A(K,2,I)*B(J,4,K)+A(K,4,I)*B(J,2,K) + OUT(J,13,I)=OUT(J,13,I)+A(K,3,I)*B(J,4,K)+A(K,4,I)*B(J,3,K) + OUT(J,14,I)=OUT(J,14,I)+A(K,4,I)*B(J,4,K) + ENDDO + ENDDO + ENDDO + END + + SUBROUTINE MP_ML5_0_UPDATE_WL_1_1(A,LCUT_SIZE,B,IN_SIZE,OUT_SIZE + $ ,OUT) + USE ML5_0_POLYNOMIAL_CONSTANTS + INTEGER I,J,K + COMPLEX*32 A(MAXLWFSIZE,0:LOOPMAXCOEFS-1,MAXLWFSIZE) + COMPLEX*32 B(MAXLWFSIZE,0:VERTEXMAXCOEFS-1,MAXLWFSIZE) + COMPLEX*32 OUT(MAXLWFSIZE,0:LOOPMAXCOEFS-1,MAXLWFSIZE) + INTEGER LCUT_SIZE,IN_SIZE,OUT_SIZE + + DO I=1,LCUT_SIZE + DO J=1,OUT_SIZE + DO K=0,14 + OUT(J,K,I)=CMPLX(0.0E0_16,0.0E0_16,KIND=16) + ENDDO + DO K=1,IN_SIZE + OUT(J,0,I)=OUT(J,0,I)+A(K,0,I)*B(J,0,K) + OUT(J,1,I)=OUT(J,1,I)+A(K,0,I)*B(J,1,K)+A(K,1,I)*B(J,0,K) + OUT(J,2,I)=OUT(J,2,I)+A(K,0,I)*B(J,2,K)+A(K,2,I)*B(J,0,K) + OUT(J,3,I)=OUT(J,3,I)+A(K,0,I)*B(J,3,K)+A(K,3,I)*B(J,0,K) + OUT(J,4,I)=OUT(J,4,I)+A(K,0,I)*B(J,4,K)+A(K,4,I)*B(J,0,K) + OUT(J,5,I)=OUT(J,5,I)+A(K,1,I)*B(J,1,K) + OUT(J,6,I)=OUT(J,6,I)+A(K,1,I)*B(J,2,K)+A(K,2,I)*B(J,1,K) + OUT(J,7,I)=OUT(J,7,I)+A(K,2,I)*B(J,2,K) + OUT(J,8,I)=OUT(J,8,I)+A(K,1,I)*B(J,3,K)+A(K,3,I)*B(J,1,K) + OUT(J,9,I)=OUT(J,9,I)+A(K,2,I)*B(J,3,K)+A(K,3,I)*B(J,2,K) + OUT(J,10,I)=OUT(J,10,I)+A(K,3,I)*B(J,3,K) + OUT(J,11,I)=OUT(J,11,I)+A(K,1,I)*B(J,4,K)+A(K,4,I)*B(J,1,K) + OUT(J,12,I)=OUT(J,12,I)+A(K,2,I)*B(J,4,K)+A(K,4,I)*B(J,2,K) + OUT(J,13,I)=OUT(J,13,I)+A(K,3,I)*B(J,4,K)+A(K,4,I)*B(J,3,K) + OUT(J,14,I)=OUT(J,14,I)+A(K,4,I)*B(J,4,K) + ENDDO + ENDDO + ENDDO + END + + SUBROUTINE ML5_0_UPDATE_WL_2_1(A,LCUT_SIZE,B,IN_SIZE,OUT_SIZE + $ ,OUT) + USE ML5_0_POLYNOMIAL_CONSTANTS + IMPLICIT NONE + INTEGER I,J,K,L,M + COMPLEX*16 A(MAXLWFSIZE,0:LOOPMAXCOEFS-1,MAXLWFSIZE) + COMPLEX*16 B(MAXLWFSIZE,0:VERTEXMAXCOEFS-1,MAXLWFSIZE) + COMPLEX*16 OUT(MAXLWFSIZE,0:LOOPMAXCOEFS-1,MAXLWFSIZE) + INTEGER LCUT_SIZE,IN_SIZE,OUT_SIZE + INTEGER NEW_POSITION + COMPLEX*16 UPDATER_COEF + +C Welcome to the computational heart of MadLoop... + OUT(:,:,:)=(0.0D0,0.0D0) + DO J=1,OUT_SIZE + DO M=0,4 + DO K=1,IN_SIZE + UPDATER_COEF = B(J,M,K) + IF (UPDATER_COEF.EQ.(0.0D0,0.0D0)) CYCLE + DO L=0,14 + NEW_POSITION = COMB_COEF_POS(L,M) + DO I=1,LCUT_SIZE + OUT(J,NEW_POSITION,I)=OUT(J,NEW_POSITION,I) + A(K,L,I) + $ *UPDATER_COEF + ENDDO + ENDDO + ENDDO + ENDDO + ENDDO + + END + + SUBROUTINE MP_ML5_0_UPDATE_WL_2_1(A,LCUT_SIZE,B,IN_SIZE,OUT_SIZE + $ ,OUT) + USE ML5_0_POLYNOMIAL_CONSTANTS + IMPLICIT NONE + INTEGER I,J,K,L,M + COMPLEX*32 A(MAXLWFSIZE,0:LOOPMAXCOEFS-1,MAXLWFSIZE) + COMPLEX*32 B(MAXLWFSIZE,0:VERTEXMAXCOEFS-1,MAXLWFSIZE) + COMPLEX*32 OUT(MAXLWFSIZE,0:LOOPMAXCOEFS-1,MAXLWFSIZE) + INTEGER LCUT_SIZE,IN_SIZE,OUT_SIZE + INTEGER NEW_POSITION + COMPLEX*32 UPDATER_COEF + +C Welcome to the computational heart of MadLoop... + OUT(:,:,:)=CMPLX(0.0E0_16,0.0E0_16,KIND=16) + DO J=1,OUT_SIZE + DO M=0,4 + DO K=1,IN_SIZE + UPDATER_COEF = B(J,M,K) + IF (UPDATER_COEF.EQ.CMPLX(0.0E0_16,0.0E0_16,KIND=16)) CYCLE + DO L=0,14 + NEW_POSITION = COMB_COEF_POS(L,M) + DO I=1,LCUT_SIZE + OUT(J,NEW_POSITION,I)=OUT(J,NEW_POSITION,I) + A(K,L,I) + $ *UPDATER_COEF + ENDDO + ENDDO + ENDDO + ENDDO + ENDDO + + END + + SUBROUTINE ML5_0_UPDATE_WL_3_1(A,LCUT_SIZE,B,IN_SIZE,OUT_SIZE + $ ,OUT) + USE ML5_0_POLYNOMIAL_CONSTANTS + IMPLICIT NONE + INTEGER I,J,K,L,M + COMPLEX*16 A(MAXLWFSIZE,0:LOOPMAXCOEFS-1,MAXLWFSIZE) + COMPLEX*16 B(MAXLWFSIZE,0:VERTEXMAXCOEFS-1,MAXLWFSIZE) + COMPLEX*16 OUT(MAXLWFSIZE,0:LOOPMAXCOEFS-1,MAXLWFSIZE) + INTEGER LCUT_SIZE,IN_SIZE,OUT_SIZE + INTEGER NEW_POSITION + COMPLEX*16 UPDATER_COEF + +C Welcome to the computational heart of MadLoop... + OUT(:,:,:)=(0.0D0,0.0D0) + DO J=1,OUT_SIZE + DO M=0,4 + DO K=1,IN_SIZE + UPDATER_COEF = B(J,M,K) + IF (UPDATER_COEF.EQ.(0.0D0,0.0D0)) CYCLE + DO L=0,34 + NEW_POSITION = COMB_COEF_POS(L,M) + DO I=1,LCUT_SIZE + OUT(J,NEW_POSITION,I)=OUT(J,NEW_POSITION,I) + A(K,L,I) + $ *UPDATER_COEF + ENDDO + ENDDO + ENDDO + ENDDO + ENDDO + + END + + SUBROUTINE MP_ML5_0_UPDATE_WL_3_1(A,LCUT_SIZE,B,IN_SIZE,OUT_SIZE + $ ,OUT) + USE ML5_0_POLYNOMIAL_CONSTANTS + IMPLICIT NONE + INTEGER I,J,K,L,M + COMPLEX*32 A(MAXLWFSIZE,0:LOOPMAXCOEFS-1,MAXLWFSIZE) + COMPLEX*32 B(MAXLWFSIZE,0:VERTEXMAXCOEFS-1,MAXLWFSIZE) + COMPLEX*32 OUT(MAXLWFSIZE,0:LOOPMAXCOEFS-1,MAXLWFSIZE) + INTEGER LCUT_SIZE,IN_SIZE,OUT_SIZE + INTEGER NEW_POSITION + COMPLEX*32 UPDATER_COEF + +C Welcome to the computational heart of MadLoop... + OUT(:,:,:)=CMPLX(0.0E0_16,0.0E0_16,KIND=16) + DO J=1,OUT_SIZE + DO M=0,4 + DO K=1,IN_SIZE + UPDATER_COEF = B(J,M,K) + IF (UPDATER_COEF.EQ.CMPLX(0.0E0_16,0.0E0_16,KIND=16)) CYCLE + DO L=0,34 + NEW_POSITION = COMB_COEF_POS(L,M) + DO I=1,LCUT_SIZE + OUT(J,NEW_POSITION,I)=OUT(J,NEW_POSITION,I) + A(K,L,I) + $ *UPDATER_COEF + ENDDO + ENDDO + ENDDO + ENDDO + ENDDO + + END diff --git a/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/process_info.inc b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/process_info.inc new file mode 100644 index 0000000000..69212f6d51 --- /dev/null +++ b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/process_info.inc @@ -0,0 +1,6 @@ + + INTEGER MAX_SPIN_CONNECTED_TO_LOOP + PARAMETER(MAX_SPIN_CONNECTED_TO_LOOP=3) + INTEGER MAX_SPIN_EXTERNAL_PARTICLE + PARAMETER(MAX_SPIN_EXTERNAL_PARTICLE=3) + diff --git a/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/tir_cache_size.inc b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/tir_cache_size.inc new file mode 100644 index 0000000000..0e89007264 --- /dev/null +++ b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/tir_cache_size.inc @@ -0,0 +1 @@ + PARAMETER(TIR_CACHE_SIZE=1) diff --git a/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/unique_id.inc b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/unique_id.inc new file mode 100644 index 0000000000..534d4d1b58 --- /dev/null +++ b/tests/input_files/IOTestsComparison/short_ML_SMQCD_LoopInduced_optimized/gg_hh/unique_id.inc @@ -0,0 +1,2 @@ + integer UNIQUE_ID + parameter(UNIQUE_ID=1) \ No newline at end of file diff --git a/tests/unit_tests/loop/test_loop_exporters.py b/tests/unit_tests/loop/test_loop_exporters.py index 3314cd5513..20318b832e 100755 --- a/tests/unit_tests/loop/test_loop_exporters.py +++ b/tests/unit_tests/loop/test_loop_exporters.py @@ -195,12 +195,12 @@ def load_IOTestsUnit(self): orders = {'QCD':2,'QED':0}, files_to_check=IOTests.IOTest.proc_files) - # And the loop induced g g > h h for good measure - # Use only one exporter only here + # And the loop induced g g > h h for good measure. + # 'optimized' is the output every real loop-induced run uses. self.addIOTestsForProcess( testName = 'gg_hh', testFolder = 'short_ML_SMQCD_LoopInduced', particles_ids = [21,21,25,25], - exporters = 'default', + exporters = ['default','optimized'], orders = {'QCD': 2, 'QED': 2} ) def testIO_UnitProcOutputIOTests(self, load_only=False): From 1f6bb8c8682466503047900d366b453f553aca43 Mon Sep 17 00:00:00 2001 From: Olivier Mattelaer Date: Fri, 21 Aug 2026 23:19:23 +0200 Subject: [PATCH 6/6] loop-induced pole check: set the default from measurement, 1e-2 -> 1e-3 Distribution of (|ANS(2,0)|+|ANS(3,0)|)/|ANS(1,0)| over 812 physics-phase points of g g > z z, g g > h h, g g > z z g and g g > h h g, at sqrt(s) from 1.02x to 80x threshold: process median p99 max g g > z z 8.6e-14 3.5e-10 5.9e-10 g g > h h 1.3e-14 1.0e-10 3.9e-09 g g > z z g 2.1e-11 8.1e-06 4.0e-05 g g > h h g 4.7e-13 1.2e-05 5.6e-05 The ceiling is 6e-5, so 1e-3 keeps a factor ~20 of headroom. The response is linear in the injected error, but only for the amplitudes that dominate the pole: perturbing the eps^-1 residue of one of those by d gives a ratio of 0.13*d (z z) to 0.22*d (h h), so 1e-3 catches an error of 0.7% and up where 1e-2 needed 6%. A subdominant amplitude is invisible at any usable threshold -- 10% on amplitude 5 of g g > h h, whose pole sits 3 orders of magnitude below the leading ones, reaches only 8e-6. The gap between the 2->2 and 2->3 rows is not multiplicity scaling: a 2->2 at fixed s has no soft or collinear region and a 2->3 does, so what the jump shows is a singular region appearing, not conditioning degrading with leg count. A 2->4 adds more regions of the same character rather than another four orders of magnitude, which is why 6e-5 is the ceiling worth keeping headroom over and why 1e-4, at 1.8x, is too tight. 1e-3 adds no false positive over 1e-2 on this sample. The only point above either threshold is a soft-gluon g g > z z g configuration at 1.0002x threshold (ratio 5.2e-2) which fails at 1e-2 identically. madevent never samples it because cuts are applied before the ME call, but check_sa and launch do; the durable fix there is to warn on the first violations and stop only on a repeat, which is left as a follow-up. --- .../StandAlone/Cards/MadLoopParams.dat | 13 +++++++++++-- .../StandAlone/SubProcesses/MadLoopParamReader.f | 2 +- madgraph/various/banner.py | 2 +- 3 files changed, 13 insertions(+), 4 deletions(-) diff --git a/Template/loop_material/StandAlone/Cards/MadLoopParams.dat b/Template/loop_material/StandAlone/Cards/MadLoopParams.dat index 59d2ebf98b..5d755941d4 100644 --- a/Template/loop_material/StandAlone/Cards/MadLoopParams.dat +++ b/Template/loop_material/StandAlone/Cards/MadLoopParams.dat @@ -90,9 +90,18 @@ ! Set it to a negative value to disable the check. ! Note that the check is inactive when the reduction tool in use does not ! compute the poles at all (COLLIER with COLLIERComputeUV/IRpoles off). +! The default comes from the measured size of (|1eps|+|2eps|)/|finite| over +! ~800 phase-space points of g g > z z / h h / z z g / h h g, whose ceiling +! is 6.0d-5, leaving a factor ~20 of headroom. At 1.0d-3 an error of 0.7% +! or more on one of the *dominant* pole contributions is caught; an error +! on a subdominant amplitude is not, at any usable threshold. +! Points sitting on a soft or collinear singularity can legitimately reach +! 5.0d-2. A madevent run never sees them, since the cuts are applied before +! the matrix element, but check_sa and launch feed uncut phase-space points, +! so raise this value if you hit it there. #MLPoleCheckThres -!1.0d-2 -! Default :: 1.0d-2 +!1.0d-3 +! Default :: 1.0d-3 ! You can add other evaluation method to check for the stability in DP and QP. ! Below you can chose if you want to use zero, one or two rotations of the PS point diff --git a/Template/loop_material/StandAlone/SubProcesses/MadLoopParamReader.f b/Template/loop_material/StandAlone/SubProcesses/MadLoopParamReader.f index f042a9b148..68d40088d9 100644 --- a/Template/loop_material/StandAlone/SubProcesses/MadLoopParamReader.f +++ b/Template/loop_material/StandAlone/SubProcesses/MadLoopParamReader.f @@ -328,7 +328,7 @@ subroutine DefaultParam() NRotations_DP=0 NRotations_QP=0 MLStabThres=1.0d-3 - MLPoleCheckThres=1.0d-2 + MLPoleCheckThres=1.0d-3 CTStabThres=1.0d-2 CTLoopLibrary=3 CheckCycle=3 diff --git a/madgraph/various/banner.py b/madgraph/various/banner.py index 005905161e..71e5808156 100755 --- a/madgraph/various/banner.py +++ b/madgraph/various/banner.py @@ -7414,7 +7414,7 @@ def default_setup(self): self.add_param("IREGIRECY", True) self.add_param("CTModeRun", -1) self.add_param("MLStabThres", 1e-3) - self.add_param("MLPoleCheckThres", 1e-2) + self.add_param("MLPoleCheckThres", 1e-3) self.add_param("NRotations_DP", 0) self.add_param("NRotations_QP", 0) self.add_param("ImprovePSPoint", 2)