← Back to branch summary

~maddevelopers/mg5amcnlo/new_clustering

« back to all changes in this revision

Viewing changes to tests/input_files/IOTestsComparison/IOExportFKSTest/test_pptt_fks_loonly/%SubProcesses%P0_gg_ttx%sborn_sf.f

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

Show diffs side-by-side

added added

removed removed

Lines of Context:
tests/input_files/IOTestsComparison/IOExportFKSTest/test_pptt_fks_loonly/%SubProcesses%P0_gg_ttx%sborn_sf.f
1
1
      SUBROUTINE SBORN_SF(P_BORN,M,N,WGT)
2
2
      IMPLICIT NONE
3
3
      INCLUDE 'nexternal.inc'
4
 
      DOUBLE PRECISION P_BORN(0:3,NEXTERNAL-1),WGT
5
 
      DOUBLE COMPLEX WGT1(2)
6
 
      INTEGER M,N
7
 
 
8
 
C     b_sf_001 links partons 1 and 2 
9
 
      IF ((M.EQ.1 .AND. N.EQ.2).OR.(M.EQ.2 .AND. N.EQ.1)) THEN
10
 
        CALL SB_SF_001(P_BORN,WGT)
11
 
 
12
 
C       b_sf_002 links partons 1 and 3 
13
 
      ELSEIF ((M.EQ.1 .AND. N.EQ.3).OR.(M.EQ.3 .AND. N.EQ.1)) THEN
14
 
        CALL SB_SF_002(P_BORN,WGT)
15
 
 
16
 
C       b_sf_003 links partons 1 and 4 
17
 
      ELSEIF ((M.EQ.1 .AND. N.EQ.4).OR.(M.EQ.4 .AND. N.EQ.1)) THEN
18
 
        CALL SB_SF_003(P_BORN,WGT)
19
 
 
20
 
C       b_sf_004 links partons 2 and 3 
21
 
      ELSEIF ((M.EQ.2 .AND. N.EQ.3).OR.(M.EQ.3 .AND. N.EQ.2)) THEN
22
 
        CALL SB_SF_004(P_BORN,WGT)
23
 
 
24
 
C       b_sf_005 links partons 2 and 4 
25
 
      ELSEIF ((M.EQ.2 .AND. N.EQ.4).OR.(M.EQ.4 .AND. N.EQ.2)) THEN
26
 
        CALL SB_SF_005(P_BORN,WGT)
27
 
 
28
 
C       b_sf_006 links partons 3 and 3 
29
 
      ELSEIF (M.EQ.3 .AND. N.EQ.3) THEN
30
 
        CALL SB_SF_006(P_BORN,WGT)
31
 
 
32
 
C       b_sf_007 links partons 3 and 4 
33
 
      ELSEIF ((M.EQ.3 .AND. N.EQ.4).OR.(M.EQ.4 .AND. N.EQ.3)) THEN
34
 
        CALL SB_SF_007(P_BORN,WGT)
35
 
 
36
 
C       b_sf_008 links partons 4 and 4 
37
 
      ELSEIF (M.EQ.4 .AND. N.EQ.4) THEN
38
 
        CALL SB_SF_008(P_BORN,WGT)
39
 
 
40
 
      ELSE
41
 
        WGT = 0D0
 
4
      INCLUDE 'coupl.inc'
 
5
      DOUBLE PRECISION P_BORN(0:3,NEXTERNAL-1), WGT
 
6
      INTEGER NSQAMPSO
 
7
      PARAMETER (NSQAMPSO = 1)
 
8
 
 
9
C     return the color-linked borns if i_fks is a color octet, 
 
10
C     the charge-linked if it is a color singlet
 
11
      DOUBLE COMPLEX WGT_BORN(2,0:NSQAMPSO)
 
12
      DOUBLE PRECISION WGT_COL
 
13
      DOUBLE PRECISION CHARGEPROD
 
14
      INTEGER I,M,N
 
15
      INCLUDE 'orders.inc'
 
16
      COMPLEX*16 ANS_CNT(2, NSPLITORDERS)
 
17
      COMMON /C_BORN_CNT/ ANS_CNT
 
18
      LOGICAL KEEP_ORDER_CNT(NSPLITORDERS, NSQAMPSO)
 
19
      COMMON /C_KEEP_ORDER_CNT/ KEEP_ORDER_CNT
 
20
      DOUBLE PRECISION CHARGES_BORN(NEXTERNAL-1)
 
21
      COMMON /C_CHARGES_BORN/CHARGES_BORN
 
22
      LOGICAL NEED_COLOR_LINKS, NEED_CHARGE_LINKS
 
23
      COMMON /C_NEED_LINKS/NEED_COLOR_LINKS, NEED_CHARGE_LINKS
 
24
      DOUBLE PRECISION PMASS(NEXTERNAL), ZERO
 
25
      PARAMETER (ZERO=0D0)
 
26
      DOUBLE PRECISION AMP_SPLIT_SOFT(AMP_SPLIT_SIZE)
 
27
      COMMON /TO_AMP_SPLIT_SOFT/AMP_SPLIT_SOFT
 
28
 
 
29
      CHARGEPROD = 0D0
 
30
 
 
31
      IF (NEED_COLOR_LINKS.AND.NEED_CHARGE_LINKS) THEN
 
32
        WRITE(*,*) 'ERROR IN SBORN_SF, both color and charged links'
 
33
     $   //' are needed'
 
34
        STOP
 
35
      ENDIF
 
36
C     check if need color or charge links, and include the gs/w**2
 
37
C      term here
 
38
      IF (NEED_COLOR_LINKS) THEN
 
39
C       link partons 1 and 2 
 
40
        IF ((M.EQ.1 .AND. N.EQ.2).OR.(M.EQ.2 .AND. N.EQ.1)) THEN
 
41
          CALL SB_SF_001(P_BORN,WGT_COL)
 
42
C         link partons 1 and 3 
 
43
        ELSEIF ((M.EQ.1 .AND. N.EQ.3).OR.(M.EQ.3 .AND. N.EQ.1)) THEN
 
44
          CALL SB_SF_002(P_BORN,WGT_COL)
 
45
C         link partons 1 and 4 
 
46
        ELSEIF ((M.EQ.1 .AND. N.EQ.4).OR.(M.EQ.4 .AND. N.EQ.1)) THEN
 
47
          CALL SB_SF_003(P_BORN,WGT_COL)
 
48
C         link partons 2 and 3 
 
49
        ELSEIF ((M.EQ.2 .AND. N.EQ.3).OR.(M.EQ.3 .AND. N.EQ.2)) THEN
 
50
          CALL SB_SF_004(P_BORN,WGT_COL)
 
51
C         link partons 2 and 4 
 
52
        ELSEIF ((M.EQ.2 .AND. N.EQ.4).OR.(M.EQ.4 .AND. N.EQ.2)) THEN
 
53
          CALL SB_SF_005(P_BORN,WGT_COL)
 
54
C         link partons 3 and 3 
 
55
        ELSEIF (M.EQ.3 .AND. N.EQ.3) THEN
 
56
          CALL SB_SF_006(P_BORN,WGT_COL)
 
57
C         link partons 3 and 4 
 
58
        ELSEIF ((M.EQ.3 .AND. N.EQ.4).OR.(M.EQ.4 .AND. N.EQ.3)) THEN
 
59
          CALL SB_SF_007(P_BORN,WGT_COL)
 
60
C         link partons 4 and 4 
 
61
        ELSEIF (M.EQ.4 .AND. N.EQ.4) THEN
 
62
          CALL SB_SF_008(P_BORN,WGT_COL)
 
63
        ENDIF
 
64
 
 
65
        WGT = WGT_COL * G**2
 
66
C       update the amp_split_soft, which is summed in sbornsoft
 
67
        AMP_SPLIT_SOFT(1:AMP_SPLIT_SIZE) =
 
68
     $    DBLE(AMP_SPLIT_CNT(1:AMP_SPLIT_SIZE,1,QCD_POS)) * G**2
 
69
 
 
70
      ELSE IF (NEED_CHARGE_LINKS) THEN
 
71
        CHARGEPROD = CHARGES_BORN(M) * CHARGES_BORN(N)
 
72
        IF ((M.LE.NINCOMING.AND.N.GT.NINCOMING) .OR.
 
73
     $    (N.LE.NINCOMING.AND.M.GT.NINCOMING)) CHARGEPROD = -
 
74
     $    CHARGEPROD
 
75
C       add a factor 1/2 for the self-eikonal soft link
 
76
        IF (M.EQ.N) CHARGEPROD = CHARGEPROD / 2D0
 
77
        WGT = DBLE(ANS_CNT(1, QED_POS)) * CHARGEPROD * DBLE(GAL(1))**2
 
78
C       update the amp_split_soft, which is summed in sbornsoft
 
79
        AMP_SPLIT_SOFT(1:AMP_SPLIT_SIZE) =
 
80
     $    DBLE(AMP_SPLIT_CNT(1:AMP_SPLIT_SIZE,1,QED_POS)) * CHARGEPROD
 
81
     $    * DBLE(GAL(1))**2
42
82
      ENDIF
43
83
 
44
84
      RETURN
45
85
      END
 
86