← Back to branch summary

~maddevelopers/mg5amcnlo/new_clustering

« back to all changes in this revision

Viewing changes to tests/input_files/IOTestsComparison/IOExportFKSTest/test_ppw_fksall/%SubProcesses%P0_dxu_wp%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_ppw_fksall/%SubProcesses%P0_dxu_wp%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
 
      ELSE
13
 
        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
        ENDIF
 
43
 
 
44
        WGT = WGT_COL * G**2
 
45
C       update the amp_split_soft, which is summed in sbornsoft
 
46
        AMP_SPLIT_SOFT(1:AMP_SPLIT_SIZE) =
 
47
     $    DBLE(AMP_SPLIT_CNT(1:AMP_SPLIT_SIZE,1,QCD_POS)) * G**2
 
48
 
 
49
      ELSE IF (NEED_CHARGE_LINKS) THEN
 
50
        CHARGEPROD = CHARGES_BORN(M) * CHARGES_BORN(N)
 
51
        IF ((M.LE.NINCOMING.AND.N.GT.NINCOMING) .OR.
 
52
     $    (N.LE.NINCOMING.AND.M.GT.NINCOMING)) CHARGEPROD = -
 
53
     $    CHARGEPROD
 
54
C       add a factor 1/2 for the self-eikonal soft link
 
55
        IF (M.EQ.N) CHARGEPROD = CHARGEPROD / 2D0
 
56
        WGT = DBLE(ANS_CNT(1, QED_POS)) * CHARGEPROD * DBLE(GAL(1))**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,QED_POS)) * CHARGEPROD
 
60
     $    * DBLE(GAL(1))**2
14
61
      ENDIF
15
62
 
16
63
      RETURN
17
64
      END
 
65