← 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_fksreal/%SubProcesses%P0_uxu_ttx%born_hel.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_fksreal/%SubProcesses%P0_uxu_ttx%born_hel.f
1
 
      SUBROUTINE SBORN_HEL(P1,ANS)
 
1
      SUBROUTINE SBORN_HEL(P,ANS_SUMMED)
 
2
C     
 
3
C     Return the sum of the split orders which are required in
 
4
C      orders.inc (BORN_ORDERS)
 
5
C     Also the values needed for the counterterms are stored in the
 
6
C      C_BORN_CNT common block
 
7
C     
 
8
C     
 
9
C     CONSTANTS
 
10
C     
 
11
      IMPLICIT NONE
 
12
      INCLUDE 'nexternal.inc'
 
13
      INTEGER NSQAMPSO
 
14
      PARAMETER (NSQAMPSO=1)
 
15
C     
 
16
C     ARGUMENTS 
 
17
C     
 
18
      REAL*8 P(0:3,NEXTERNAL-1), ANS_SUMMED
 
19
C     
 
20
C     VARIABLES
 
21
C     
 
22
      INTEGER I, J
 
23
      INCLUDE 'orders.inc'
 
24
      REAL*8 ANS(0:NSQAMPSO)
 
25
      INCLUDE 'born_nhel.inc'
 
26
      DOUBLE PRECISION WGT_HEL(NSQAMPSO, MAX_BHEL)
 
27
      COMMON/C_BORN_HEL_SPLIT/WGT_HEL
 
28
      DOUBLE PRECISION WGT_HEL_SUMMED(MAX_BHEL)
 
29
      COMMON/C_BORN_HEL/WGT_HEL_SUMMED
 
30
C     
 
31
C     FUNCTIONS
 
32
C     
 
33
      INTEGER GETORDPOWFROMINDEX_B
 
34
C     
 
35
C     BEGIN CODE
 
36
C     
 
37
C     Store all the orders that come from the diagrams, regardless
 
38
C     of the fact that they satisfy or not the squared-orders
 
39
C      constraints
 
40
 
 
41
 
 
42
C     look for orders which match the born order constraint 
 
43
      CALL SBORN_HEL_SPLITORDERS(P,ANS)
 
44
      ANS_SUMMED = 0D0
 
45
      DO J = 1, MAX_BHEL
 
46
        WGT_HEL_SUMMED(J) = 0D0
 
47
      ENDDO
 
48
      DO I = 1, NSQAMPSO
 
49
        ANS_SUMMED = ANS_SUMMED + ANS(I)
 
50
        DO J = 1, MAX_BHEL
 
51
          WGT_HEL_SUMMED(J) = WGT_HEL_SUMMED(J) + WGT_HEL(I,J)
 
52
        ENDDO
 
53
      ENDDO
 
54
 
 
55
      RETURN
 
56
      END
 
57
 
 
58
 
 
59
      SUBROUTINE SBORN_HEL_SPLITORDERS(P1,ANS)
2
60
C     
3
61
C     Generated by MadGraph5_aMC@NLO v. %(version)s, %(date)s
4
62
C     By the MadGraph5_aMC@NLO Development Team
8
66
C     AND HELICITIES
9
67
C     FOR THE POINT IN PHASE SPACE P1(0:3,NEXTERNAL-1)
10
68
C     
11
 
C     Process: u~ u > t t~ WEIGHTED<=2 [ real = QCD ]
12
 
C     Process: c~ c > t t~ WEIGHTED<=2 [ real = QCD ]
13
 
C     Process: d~ d > t t~ WEIGHTED<=2 [ real = QCD ]
14
 
C     Process: s~ s > t t~ WEIGHTED<=2 [ real = QCD ]
 
69
C     Process: u~ u > t t~ [ real = QED QCD ] QCD^2<=6 QED^2<=0
 
70
C     Process: c~ c > t t~ [ real = QED QCD ] QCD^2<=6 QED^2<=0
 
71
C     Process: d~ d > t t~ [ real = QED QCD ] QCD^2<=6 QED^2<=0
 
72
C     Process: s~ s > t t~ [ real = QED QCD ] QCD^2<=6 QED^2<=0
15
73
C     
16
74
      IMPLICIT NONE
17
75
C     
21
79
      INCLUDE 'born_nhel.inc'
22
80
      INTEGER     NCOMB
23
81
      PARAMETER ( NCOMB=  16 )
 
82
      INTEGER NSQAMPSO
 
83
      PARAMETER (NSQAMPSO=1)
24
84
      INTEGER    THEL
25
85
      PARAMETER (THEL=NCOMB*6)
26
86
      INTEGER NGRAPHS
27
 
      PARAMETER (NGRAPHS = 1)
 
87
      PARAMETER (NGRAPHS=   1)
28
88
C     
29
89
C     ARGUMENTS 
30
90
C     
31
 
      REAL*8 P1(0:3,NEXTERNAL-1),ANS
 
91
      REAL*8 P1(0:3,NEXTERNAL-1),ANS(0:NSQAMPSO)
32
92
C     
33
93
C     LOCAL VARIABLES 
34
94
C     
35
 
      INTEGER IHEL,IDEN,J
36
 
      REAL*8 BORN_HEL
 
95
      INTEGER IHEL,IDEN,I,J
 
96
      DOUBLE PRECISION T(NSQAMPSO)
37
97
      INTEGER IDEN_VALUES(6)
38
98
      DATA IDEN_VALUES /36, 36, 36, 36, 36, 36/
39
99
C     
47
107
      COMMON/CCALCULATEDBORN/CALCULATEDBORN
48
108
      INTEGER NFKSPROCESS
49
109
      COMMON/C_NFKSPROCESS/NFKSPROCESS
50
 
      DOUBLE PRECISION WGT_HEL(MAX_BHEL)
51
 
      COMMON/C_BORN_HEL/WGT_HEL
52
 
 
 
110
      DOUBLE PRECISION WGT_HEL(NSQAMPSO, MAX_BHEL)
 
111
      COMMON/C_BORN_HEL_SPLIT/WGT_HEL
53
112
C     ----------
54
113
C     BEGIN CODE
55
114
C     ----------
59
118
          IF (SAVEMOM(J,1).NE.P1(0,J) .OR. SAVEMOM(J,2).NE.P1(3,J))
60
119
     $      THEN
61
120
            CALCULATEDBORN=.FALSE.
62
 
            WRITE (*,*) 'momenta not the same in Born_hel'
 
121
            WRITE(*,*) 'Error in sborn_hel_splitorders: momenta not'
 
122
     $       //' the same in the born'
63
123
            STOP
64
124
          ENDIF
65
125
        ENDDO
66
126
      ELSE
67
 
        WRITE(*,*) 'Error in born_hel: should be called only with'
68
 
     $   //' calculatedborn = true'
 
127
        WRITE(*,*) 'Error in sborn_hel_splitorders: this should be'
 
128
     $   //' called only with calculatedborn = true'
69
129
        STOP
70
130
      ENDIF
71
 
      ANS = 0D0
 
131
      DO I=0,NSQAMPSO
 
132
        ANS(I) = 0D0
 
133
      ENDDO
72
134
      DO IHEL=1,NCOMB
73
 
        WGT_HEL(IHEL)=0D0
74
135
        IF (GOODHEL(IHEL,NFKSPROCESS)) THEN
75
 
          WGT_HEL(IHEL)=BORN_HEL(P1,IHEL)/DBLE(IDEN)
76
 
          ANS=ANS+WGT_HEL(IHEL)
 
136
          CALL BORN_HEL_SPLITORDERS(P1,IHEL,T)
 
137
          DO I=1,NSQAMPSO
 
138
            WGT_HEL(I, IHEL) = T(I) / DBLE(IDEN)
 
139
            ANS(I)=ANS(I)+T(I)
 
140
          ENDDO
77
141
        ENDIF
78
142
      ENDDO
 
143
      DO I=1,NSQAMPSO
 
144
        ANS(I)=ANS(I)/DBLE(IDEN)
 
145
        ANS(0)=ANS(0)+ANS(I)
 
146
      ENDDO
79
147
      END
80
148
 
81
149
 
82
 
      REAL*8 FUNCTION BORN_HEL(P,HELL)
 
150
      SUBROUTINE BORN_HEL_SPLITORDERS(P,HELL,ANS)
83
151
C     
84
152
C     Generated by MadGraph5_aMC@NLO v. %(version)s, %(date)s
85
153
C     By the MadGraph5_aMC@NLO Development Team
87
155
C     RETURNS AMPLITUDE SQUARED SUMMED/AVG OVER COLORS
88
156
C     FOR THE POINT WITH EXTERNAL LINES W(0:6,NEXTERNAL-1)
89
157
 
90
 
C     Process: u~ u > t t~ WEIGHTED<=2 [ real = QCD ]
91
 
C     Process: c~ c > t t~ WEIGHTED<=2 [ real = QCD ]
92
 
C     Process: d~ d > t t~ WEIGHTED<=2 [ real = QCD ]
93
 
C     Process: s~ s > t t~ WEIGHTED<=2 [ real = QCD ]
 
158
C     Process: u~ u > t t~ [ real = QED QCD ] QCD^2<=6 QED^2<=0
 
159
C     Process: c~ c > t t~ [ real = QED QCD ] QCD^2<=6 QED^2<=0
 
160
C     Process: d~ d > t t~ [ real = QED QCD ] QCD^2<=6 QED^2<=0
 
161
C     Process: s~ s > t t~ [ real = QED QCD ] QCD^2<=6 QED^2<=0
94
162
C     
95
163
      IMPLICIT NONE
96
164
C     
97
165
C     CONSTANTS
98
166
C     
 
167
      INTEGER NAMPSO, NSQAMPSO
 
168
      PARAMETER (NAMPSO=1, NSQAMPSO=1)
99
169
      INTEGER     NGRAPHS
100
170
      PARAMETER ( NGRAPHS = 1 )
101
 
      INTEGER    NCOLOR
 
171
      INTEGER NCOLOR
102
172
      PARAMETER (NCOLOR=2)
103
173
      REAL*8     ZERO
104
174
      PARAMETER (ZERO=0D0)
111
181
C     
112
182
      REAL*8 P(0:3,NEXTERNAL-1)
113
183
      INTEGER HELL
 
184
      REAL*8 ANS(NSQAMPSO)
114
185
C     
115
186
C     LOCAL VARIABLES 
116
187
C     
117
 
      INTEGER I,J
118
 
      REAL*8 DENOM(NCOLOR), CF(NCOLOR,NCOLOR)
119
 
      COMPLEX*16 ZTEMP, AMP(NGRAPHS), JAMP(NCOLOR)
 
188
      INTEGER I,J,M,N
 
189
      REAL*8 CF(NCOLOR,NCOLOR)
 
190
      COMPLEX*16 ZTEMP, AMP(NGRAPHS), JAMP(NCOLOR,NAMPSO)
 
191
      COMPLEX*16 TMP_JAMP(0)
120
192
C     
121
193
C     GLOBAL VARIABLES
122
194
C     
125
197
      LOGICAL CALCULATEDBORN
126
198
      COMMON/CCALCULATEDBORN/CALCULATEDBORN
127
199
C     
 
200
C     FUNCTION
 
201
C     
 
202
      INTEGER SQSOINDEXB
 
203
C     
128
204
C     COLOR DATA
129
205
C     
130
 
      DATA DENOM(1)/1/
131
 
      DATA (CF(I,  1),I=  1,  2) /    9,    3/
 
206
      DATA (CF(I,  1),I=  1,  2) /9.000000000000000D+00
 
207
     $ ,3.000000000000000D+00/
132
208
C     1 T(1,2) T(3,4)
133
 
      DATA DENOM(2)/1/
134
 
      DATA (CF(I,  2),I=  1,  2) /    3,    9/
 
209
      DATA (CF(I,  2),I=  1,  2) /3.000000000000000D+00
 
210
     $ ,9.000000000000000D+00/
135
211
C     1 T(1,4) T(3,2)
136
212
C     ----------
137
213
C     BEGIN CODE
138
214
C     ----------
139
215
      IF (.NOT. CALCULATEDBORN) THEN
140
 
        WRITE(*,*) 'Error in born_hel.f: this should be called only'
141
 
     $   //' with calculatedborn = true'
 
216
        WRITE(*,*) 'Error in b_sf: color_linked borns should be called'
 
217
     $   //' only with calculatedborn = true'
142
218
        STOP
143
219
      ELSEIF (CALCULATEDBORN) THEN
144
220
        DO I=1,NGRAPHS
145
221
          AMP(I)=SAVEAMP(I,HELL)
146
222
        ENDDO
147
223
      ENDIF
148
 
      JAMP(1)=+1D0/2D0*(-1D0/3D0*AMP(1))
149
 
      JAMP(2)=+1D0/2D0*(+AMP(1))
150
 
      BORN_HEL = 0.D0
151
 
      DO I = 1, NCOLOR
152
 
        ZTEMP = (0.D0,0.D0)
153
 
        DO J = 1, NCOLOR
154
 
          ZTEMP = ZTEMP + CF(J,I)*JAMP(J)
155
 
        ENDDO
156
 
        BORN_HEL =BORN_HEL+ZTEMP*DCONJG(JAMP(I))/DENOM(I)
157
 
      ENDDO
158
 
      END
 
224
C     JAMPs contributing to orders QCD=2 QED=0
 
225
      JAMP(1,1) = (-1.666666666666667D-01)*AMP(1)
 
226
      JAMP(2,1) = (5.000000000000000D-01)*AMP(1)
 
227
      DO I = 1, NSQAMPSO
 
228
        ANS(I) = 0D0
 
229
      ENDDO
 
230
      DO M = 1, NAMPSO
 
231
        DO I = 1, NCOLOR
 
232
          ZTEMP = (0.D0,0.D0)
 
233
          DO J = 1, NCOLOR
 
234
            ZTEMP = ZTEMP + CF(J,I)*JAMP(J,M)
 
235
          ENDDO
 
236
          ANS(SQSOINDEXB(M,M))=ANS(SQSOINDEXB(M,M))+ZTEMP
 
237
     $     *DCONJG(JAMP(I,M))
 
238
        ENDDO
 
239
      ENDDO
 
240
      END
 
241
 
 
242
 
 
243
 
 
244
 
 
245
      SUBROUTINE PICKHELICITYMC(P,GOODHEL,HEL,IHEL_OUT,VOL)
 
246
      IMPLICIT NONE
 
247
      INCLUDE 'nexternal.inc'
 
248
      INCLUDE 'born_nhel.inc'
 
249
      DOUBLE PRECISION P(0:3, NEXTERNAL-1)
 
250
      INTEGER GOODHEL(MAX_BHEL),HEL(0:MAX_BHEL)
 
251
      INTEGER IHEL_OUT
 
252
      DOUBLE PRECISION VOL
 
253
 
 
254
      INTEGER NSQAMPSO
 
255
      PARAMETER (NSQAMPSO=1)
 
256
      DOUBLE PRECISION WGT_HEL(NSQAMPSO, MAX_BHEL)
 
257
      COMMON/C_BORN_HEL_SPLIT/WGT_HEL
 
258
      DOUBLE PRECISION SUM_HEL(NSQAMPSO)
 
259
      INTEGER I, IHEL
 
260
 
 
261
      INTEGER N_NONZERO_ORD
 
262
      DOUBLE PRECISION SUM_ALL
 
263
      DOUBLE PRECISION ACCUM, TARGET
 
264
      DOUBLE PRECISION BORN_WGT_RECOMP_DIRECT
 
265
 
 
266
      DOUBLE PRECISION RAN2
 
267
 
 
268
      CALL SBORN_HEL(P,BORN_WGT_RECOMP_DIRECT)
 
269
 
 
270
C     Loop over the various orders of squared Feynman diagrams and
 
271
C      compute for each order the sum
 
272
      N_NONZERO_ORD = 0
 
273
      SUM_ALL = 0D0
 
274
      DO I = 1, NSQAMPSO
 
275
        SUM_HEL(I) = 0D0
 
276
        DO IHEL = 1, HEL(0)
 
277
          IF (WGT_HEL(I, HEL(IHEL)).LT.0D0) THEN
 
278
            WRITE(*,*) 'Helicities from squared diagrams must be > 0  !'
 
279
            STOP 1
 
280
          ENDIF
 
281
          SUM_HEL(I)=SUM_HEL(I) + WGT_HEL(I, HEL(IHEL))
 
282
     $     *DBLE(GOODHEL(IHEL))
 
283
        ENDDO
 
284
        IF (SUM_HEL(I).GT.0D0) THEN
 
285
          N_NONZERO_ORD = N_NONZERO_ORD + 1
 
286
          SUM_ALL = SUM_ALL + SUM_HEL(I)
 
287
        ENDIF
 
288
      ENDDO
 
289
 
 
290
 
 
291
      TARGET=RAN2()
 
292
      IHEL=1
 
293
      ACCUM=0D0
 
294
 
 
295
      DO I = 1, NSQAMPSO
 
296
        IF (SUM_HEL(I).EQ.0D0) CYCLE
 
297
        ACCUM=ACCUM+WGT_HEL(I,HEL(IHEL))/SUM_HEL(I)*DBLE(GOODHEL(IHEL))
 
298
     $   /N_NONZERO_ORD
 
299
      ENDDO
 
300
 
 
301
      DO WHILE (ACCUM.LT.TARGET)
 
302
        IHEL=IHEL+1
 
303
        DO I = 1, NSQAMPSO
 
304
          IF (SUM_HEL(I).EQ.0D0) CYCLE
 
305
          ACCUM=ACCUM+WGT_HEL(I,HEL(IHEL))/SUM_HEL(I)
 
306
     $     *DBLE(GOODHEL(IHEL))/N_NONZERO_ORD
 
307
        ENDDO
 
308
      ENDDO
 
309
 
 
310
      VOL=0D0
 
311
      DO I = 1, NSQAMPSO
 
312
        IF (SUM_HEL(I).EQ.0D0) CYCLE
 
313
        VOL=VOL+WGT_HEL(I,HEL(IHEL))/SUM_HEL(I)*DBLE(GOODHEL(IHEL))
 
314
     $   /N_NONZERO_ORD
 
315
      ENDDO
 
316
 
 
317
 
 
318
      IHEL_OUT=IHEL
 
319
 
 
320
      RETURN
 
321
      END
 
322
 
 
323
 
159
324