← 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_fksrealew/%SubProcesses%P0_ag_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_fksrealew/%SubProcesses%P0_ag_ttx%sborn_sf.f
 
1
      SUBROUTINE SBORN_SF(P_BORN,M,N,WGT)
 
2
      IMPLICIT NONE
 
3
      INCLUDE 'nexternal.inc'
 
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 2 and 3 
 
40
        IF ((M.EQ.2 .AND. N.EQ.3).OR.(M.EQ.3 .AND. N.EQ.2)) THEN
 
41
          CALL SB_SF_001(P_BORN,WGT_COL)
 
42
C         link partons 2 and 4 
 
43
        ELSEIF ((M.EQ.2 .AND. N.EQ.4).OR.(M.EQ.4 .AND. N.EQ.2)) THEN
 
44
          CALL SB_SF_002(P_BORN,WGT_COL)
 
45
C         link partons 3 and 3 
 
46
        ELSEIF (M.EQ.3 .AND. N.EQ.3) THEN
 
47
          CALL SB_SF_003(P_BORN,WGT_COL)
 
48
C         link partons 3 and 4 
 
49
        ELSEIF ((M.EQ.3 .AND. N.EQ.4).OR.(M.EQ.4 .AND. N.EQ.3)) THEN
 
50
          CALL SB_SF_004(P_BORN,WGT_COL)
 
51
C         link partons 4 and 4 
 
52
        ELSEIF (M.EQ.4 .AND. N.EQ.4) THEN
 
53
          CALL SB_SF_005(P_BORN,WGT_COL)
 
54
        ENDIF
 
55
 
 
56
        WGT = WGT_COL * G**2
 
57
C       update the amp_split_soft, which is summed in sbornsoft
 
58
        AMP_SPLIT_SOFT(1:AMP_SPLIT_SIZE) =
 
59
     $    DBLE(AMP_SPLIT_CNT(1:AMP_SPLIT_SIZE,1,QCD_POS)) * G**2
 
60
 
 
61
      ELSE IF (NEED_CHARGE_LINKS) THEN
 
62
        CHARGEPROD = CHARGES_BORN(M) * CHARGES_BORN(N)
 
63
        IF ((M.LE.NINCOMING.AND.N.GT.NINCOMING) .OR.
 
64
     $    (N.LE.NINCOMING.AND.M.GT.NINCOMING)) CHARGEPROD = -
 
65
     $    CHARGEPROD
 
66
C       add a factor 1/2 for the self-eikonal soft link
 
67
        IF (M.EQ.N) CHARGEPROD = CHARGEPROD / 2D0
 
68
        WGT = DBLE(ANS_CNT(1, QED_POS)) * CHARGEPROD * DBLE(GAL(1))**2
 
69
C       update the amp_split_soft, which is summed in sbornsoft
 
70
        AMP_SPLIT_SOFT(1:AMP_SPLIT_SIZE) =
 
71
     $    DBLE(AMP_SPLIT_CNT(1:AMP_SPLIT_SIZE,1,QED_POS)) * CHARGEPROD
 
72
     $    * DBLE(GAL(1))**2
 
73
      ENDIF
 
74
 
 
75
      RETURN
 
76
      END
 
77