~madteam/mg5amcnlo/series2.0

## if (not LoopInduced) {

          INTEGER NBORNAMPS

      PARAMETER (NBORNAMPS=%(nbornamps)d)

## }

      INTEGER    NLOOPAMPS

          PARAMETER (NLOOPAMPS=%(nloopamps)d)

          PARAMETER (NCOLORROWS=NLOOPAMPS)

 

##if(ComputeColorFlows) {

C The variables below are just used in the context of a JAMP consistency check turned off by default.

      LOGICAL DIRECT_ME_COMPUTATION, ME_COMPUTATION_FROM_JAMP

      %(real_dp_format)s RES_FROM_JAMP(0:3,0:NSQUAREDSO)

          common/%(proc_prefix)sDOUBLECHECK_JAMP/RES_FROM_JAMP,DIRECT_ME_COMPUTATION,ME_COMPUTATION_FROM_JAMP

## }

          

      LOGICAL DPW_COPIED

      INTEGER I,J,K,H,HEL_MULT,ITEMP

## if(not AmplitudeReduction){

          %(real_mp_format)s TEMP2

## }else{

          %(real_mp_format)s TEMP2(3)

## }

## if(ComputeColorFlows) {

          %(real_dp_format)s BUFFRES(0:3,0:NSQUAREDSO)

## }

          INTEGER USERHEL

          common/%(proc_prefix)sUSERCHOICE/USERHEL

 

## if(not LoopInduced) {

          %(complex_mp_format)s AMP(NBORNAMPS)

          common/%(proc_prefix)sMP_AMPS/AMP

          %(complex_dp_format)s DP_AMP(NBORNAMPS)

          common/%(proc_prefix)sAMPS/DP_AMP

## }      

## if(not AmplitudeReduction){

## } else {

          %(complex_mp_format)s LOOPCOEFS(0:LOOPMAXCOEFS-1,NLOOPGROUPS)

## }

## if(AmplitudeReduction) {

C This flag is used to prevent the re-computation of the OpenLoop coefficients when changing the CTMode for the stability test.

          LOGICAL SKIP_LOOPNUM_COEFS_CONSTRUCTION

          COMMON/%(proc_prefix)sSKIP_COEFS/SKIP_LOOPNUM_COEFS_CONSTRUCTION

## }

 

## if(not AmplitudeReduction){

## } else {

      %(complex_mp_format)s AMPL(3,NLOOPAMPS)

## } 

## if(AmplitudeReduction){

      %(complex_dp_format)s DP_AMPL(3,NLOOPAMPS)

          common/%(proc_prefix)sAMPL/DP_AMPL

 

      %(complex_dp_format)s LOOPRES(3,NSQUAREDSO,NLOOPGROUPS)

          LOGICAL S(NSQUAREDSO,NLOOPGROUPS)

          common/%(proc_prefix)sLOOPRES/LOOPRES,S

 

          integer I_SO

          common/%(proc_prefix)sI_SO/I_SO

## }

 

## if(AmplitudeReduction){

IF (.NOT.SKIP_LOOPNUM_COEFS_CONSTRUCTION) THEN

## }

## if(not AmplitudeReduction){

## }else{

  DO I=1,NLOOPAMPS

## }

## if(AmplitudeReduction){

ENDIF

## }

 

## if(not LoopInduced) {

DO I=1, NBORNAMPS

  DP_AMP(I) = (0.0d0,0.0d0)

  AMP(I) = (ZERO, ZERO)

ENDDO

## }

 

## if(not AmplitudeReduction){

## }

DPW_COPIED = .False.

  MP_LOOP_REQ_SO_DONE=.FALSE.  

 

  IF (.NOT.CHECKPHASE.AND.HELDOUBLECHECKED.AND.HELPICKED.EQ.-1) THEN

    HEL_MULT=GOODHEL(H)

  ELSE

    HEL_MULT=1

  ENDIF

 

## if(AmplitudeReduction){

  CTCALL_REQ_SO_DONE=.FALSE.

 

C The coefficient were already computed previously with 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)

    ENDDO

  ENDDO

  

 DO K=1, 3

  DO I=1,NLOOPAMPS

    AMPL(K,I)=(ZERO,ZERO)

  ENDDO

ENDDO

## }

## if(not AmplitudeReduction) { 

  DO I=1,NCTAMPS

    DO J=1,NBORNAMPS

      ITEMP = %(proc_prefix)sML5SQSOINDEX(%(proc_prefix)sML5SOINDEX_FOR_LOOP_AMP(I),%(proc_prefix)sML5SOINDEX_FOR_BORN_AMP(J))

          IF (.NOT.FILTER_SO.OR.SQSO_TARGET.EQ.ITEMP) THEN

        DO K=1,3

          TEMP2 = HEL_MULT*2.0e0_16*REAL(CFTOT*AMPL(K,I)*CONJG(AMP(J)),KIND=16)

          ANS(K,ITEMP)=ANS(K,ITEMP)+TEMP2

          ANS(K,0)=ANS(K,0)+TEMP2

        ENDDO

      ENDIF

  ENDDO

## }

## if(AmplitudeReduction) {

## if(not LoopInduced) {

C Copy the multiple precision Born amplitudes computed to the AMP double precision array for its use later if necessary (i.e. color flows for example.)

  DO I=1,NBORNAMPS

    DP_AMP(I)=AMP(I)

  ENDDO

## }

 

C Copy the multiple precision CT amplitudes computed to the AMPL double precision array for its use later if necessary (i.e. color flows for example.)

  DO I=1,NCTAMPS

    DO K=1,3

      DP_AMPL(K,I)=AMPL(K,I)

    ENDDO

  ENDDO

## }

C This needs to be done once since only the momenta of these WF matters.

  IF(.NOT.DPW_COPIED) THEN

    DO I=1,NWAVEFUNCS

      DO J=1,MAXLWFSIZE+4

        DPW(J,I)=DBLE(W(J,I))

      ENDDO

    ENDDO

    DPW_COPIED=.True.

  ENDIF

 

## if(AmplitudeReduction) {

  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 conform to the 

C structure that the call to the LOOP* subroutine takes for processes with Born diagrams.

  I_SO=1

%(loop_CT_calls)s

5000 CONTINUE

  CTCALL_REQ_SO_DONE=.TRUE.

 

C Copy the loop amplitudes computed (whose final result was 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)=DP_AMPL(K,I)

    ENDDO

  ENDDO

 

## if(ComputeColorFlows) {

  IF (DIRECT_ME_COMPUTATION) THEN

## }

  DO I=1,NLOOPAMPS

## if(not LoopInduced) {

    DO J=1,NBORNAMPS

## } else {

    DO J=1,NLOOPAMPS

## }

          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

## if(not LoopInduced) {

      ITEMP = %(proc_prefix)sML5SQSOINDEX(%(proc_prefix)sML5SOINDEX_FOR_LOOP_AMP(I),%(proc_prefix)sML5SOINDEX_FOR_BORN_AMP(J))

      DO K=1,3

        TEMP2(K) = 2.0d0*HEL_MULT*REAL(CFTOT*AMPL(K,I)*CONJG(AMP(J)),KIND=16)

      ENDDO

## } else {

      ITEMP = %(proc_prefix)sML5SQSOINDEX(%(proc_prefix)sML5SOINDEX_FOR_LOOP_AMP(I),%(proc_prefix)sML5SOINDEX_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 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)

## }

C To mimic the structure of the non loop-induced processes, we add here the squared counterterm contribution directly the result ANS and put the loop contributions in the LOOPRES array which will be 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

C This LOOPRES array entries will be added to the main result ANS(*,*) later in the loop_matrix.f file. It is in double precision however, so the cast of the temporary variable TEMP2 is necessary.

          LOOPRES(K,ITEMP,I-NCTAMPS)=LOOPRES(K,ITEMP,I-NCTAMPS)+DBLE(TEMP2(K))

C During the evaluation of the AMPL, we had stored the stability in S(1,*) so we now copy over this flag to the relevant contributing Squared orders.

          S(ITEMP,I-NCTAMPS)=S(1,I-NCTAMPS)

        ENDDO

      ENDIF

    ENDDO

  ENDDO

 

## if(ComputeColorFlows) {

  ENDIF

## }

  

## }

 

 

 

## if(ComputeColorFlows){

C We should compute the color flow either if it contributes to the final result (i.e. not used just for the filtering), or 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)) THEN

C The cumulative quantities must only be computed if that helicity contributes according to user request (second argument of the subroutine below).

  CALL %(proc_prefix)sCOMPUTE_COLOR_FLOWS(HEL_MULT,(H.EQ.USERHEL.OR.USERHEL.EQ.-1))

  IF(ME_COMPUTATION_FROM_JAMP) THEN

    CALL %(proc_prefix)sCOMPUTE_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 form of computation, we directly update the answer.

      DO K=1,3

        DO I=0,NSQUAREDSO

          ANS(K,I)=ANS(K,I)+REAL(BUFFRES(K,I),KIND=16)

        ENDDO

      ENDDO

C     In this case, we temporarily store the compute Born ME in RES_FROM_JAMP(0,I), which will be used to set ANS(0,I) just after the call to this subroutine in loop_matrix.f

      DO I=0,NSQUAREDSO

        RES_FROM_JAMP(0,I)=RES_FROM_JAMP(0,I)+REAL(BUFFRES(0,I),KIND=16)

      ENDDO

C   When setting up the loop filter, it is important to set the quantitied LOOPRES.

C   Notice that you may have a more powerful filter with the direct computation mode because it can filter vanishing loop contributions for a particular squared split order only

C   The quantity LOOPRES defined below is not physical, but it's ok since it is only intended for the loop filtering.

C   In principle it is no longer necessary to compute the quantity below once the loop filter is setup, but it takes a negligible amount of time compare to the quad 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 makes it clear when it is executed.

    ELSEIF(H.EQ.USERHEL.OR.USERHEL.EQ.-1) THEN

C     If both computational method is used, then we must 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

ENDIF

## }

 

  ENDIF

## if(not AmplitudeReduction) {

## }