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