← Back to branch summary

~maddevelopers/mg5amcnlo/2.7.3-lepcoll

« back to all changes in this revision

Viewing changes to tests/input_files/IOTestsComparison/IOExportFKSTest/test_ppw_fksall/%SubProcesses%P0_dxu_wp%matrix_3.f

  • Committer: olivier-mattelaer
  • Date: 2021-04-15 15:17:31 UTC
  • mfrom: (78.75.499 3.0)
  • Revision ID: olivier-mattelaer-20210415151731-oq9o5fen2y141m5o
merge with 3.1.0

Show diffs side-by-side

added added

removed removed

Lines of Context:
tests/input_files/IOTestsComparison/IOExportFKSTest/test_ppw_fksall/%SubProcesses%P0_dxu_wp%matrix_3.f
1
 
      SUBROUTINE SMATRIX_3(P,ANS)
 
1
      SUBROUTINE SMATRIX3(P,ANS_SUMMED)
 
2
C     
 
3
C     Generated by MadGraph5_aMC@NLO v. %(version)s, %(date)s
 
4
C     By the MadGraph5_aMC@NLO Development Team
 
5
C     Visit launchpad.net/madgraph5 and amcatnlo.web.cern.ch
 
6
C     
 
7
C     
 
8
C     Return the sum of the split orders which are required in
 
9
C      orders.inc (NLO_ORDERS)
 
10
C     
 
11
C     
 
12
C     Process: d~ g > w+ u~ [ all = QED QCD ] QCD^2<=2 QED^2<=2
 
13
C     Process: s~ g > w+ c~ [ all = QED QCD ] QCD^2<=2 QED^2<=2
 
14
C     
 
15
C     
 
16
C     CONSTANTS
 
17
C     
 
18
      IMPLICIT NONE
 
19
      INTEGER    NEXTERNAL
 
20
      PARAMETER (NEXTERNAL=4)
 
21
      INTEGER NSQAMPSO
 
22
      PARAMETER (NSQAMPSO=1)
 
23
C     
 
24
C     ARGUMENTS 
 
25
C     
 
26
      REAL*8 P(0:3,NEXTERNAL), ANS_SUMMED
 
27
C     
 
28
C     VARIABLES
 
29
C     
 
30
      INTEGER I,J
 
31
      REAL*8 ANS(0:NSQAMPSO)
 
32
      LOGICAL KEEP_ORDER(NSQAMPSO), FIRSTTIME
 
33
      INCLUDE 'orders.inc'
 
34
      DATA KEEP_ORDER / NSQAMPSO*.TRUE. /
 
35
      DATA FIRSTTIME / .TRUE. /
 
36
      INTEGER AMP_ORDERS(NSPLITORDERS)
 
37
      DOUBLE PRECISION ANS_MAX, TINY
 
38
      PARAMETER (TINY = 1D-12)
 
39
      DOUBLE PRECISION       WGT_ME_BORN,WGT_ME_REAL
 
40
      COMMON /C_WGT_ME_TREE/ WGT_ME_BORN,WGT_ME_REAL
 
41
C     
 
42
C     FUNCTIONS
 
43
C     
 
44
      INTEGER GETORDPOWFROMINDEX3
 
45
      INTEGER ORDERS_TO_AMP_SPLIT_POS
 
46
C     
 
47
C     BEGIN CODE
 
48
C     
 
49
 
 
50
C     look for orders which match the nlo order constraint 
 
51
 
 
52
      IF (FIRSTTIME) THEN
 
53
        DO I = 1, NSQAMPSO
 
54
          DO J = 1, NSPLITORDERS
 
55
            IF(GETORDPOWFROMINDEX3(J, I) .GT. NLO_ORDERS(J)) THEN
 
56
              KEEP_ORDER(I) = .FALSE.
 
57
              EXIT
 
58
            ENDIF
 
59
          ENDDO
 
60
          IF (KEEP_ORDER(I)) THEN
 
61
            WRITE(*,*) 'REAL 3: keeping split order ', I
 
62
          ELSE
 
63
            WRITE(*,*) 'REAL 3: not keeping split order ', I
 
64
          ENDIF
 
65
        ENDDO
 
66
        FIRSTTIME = .FALSE.
 
67
      ENDIF
 
68
 
 
69
      CALL SMATRIX3_SPLITORDERS(P,ANS)
 
70
      ANS_SUMMED = 0D0
 
71
      ANS_MAX = 0D0
 
72
 
 
73
C     reset the amp_split array
 
74
      AMP_SPLIT(1:AMP_SPLIT_SIZE) = 0D0
 
75
 
 
76
      DO I = 1, NSQAMPSO
 
77
        ANS_MAX = MAX(DABS(ANS(I)),ANS_MAX)
 
78
      ENDDO
 
79
 
 
80
      DO I = 1, NSQAMPSO
 
81
        IF (KEEP_ORDER(I)) THEN
 
82
          ANS_SUMMED = ANS_SUMMED + ANS(I)
 
83
C         keep track of the separate pieces correspoinding to
 
84
C          different coupling combinations
 
85
          DO J = 1, NSPLITORDERS
 
86
            AMP_ORDERS(J) = GETORDPOWFROMINDEX3(J, I)
 
87
          ENDDO
 
88
          IF (ABS(ANS(I)).GT.ANS_MAX*TINY)
 
89
     $      AMP_SPLIT(ORDERS_TO_AMP_SPLIT_POS(AMP_ORDERS)) = ANS(I)
 
90
        ENDIF
 
91
      ENDDO
 
92
 
 
93
C     avoid fake non-zeros
 
94
      IF (DABS(ANS_SUMMED).LT.TINY*ANS_MAX) ANS_SUMMED=0D0
 
95
 
 
96
      WGT_ME_REAL = ANS_SUMMED
 
97
 
 
98
      END
 
99
 
 
100
 
 
101
 
 
102
      SUBROUTINE SMATRIX3_SPLITORDERS(P,ANS)
2
103
C     
3
104
C     Generated by MadGraph5_aMC@NLO v. %(version)s, %(date)s
4
105
C     By the MadGraph5_aMC@NLO Development Team
8
109
C     and helicities
9
110
C     for the point in phase space P(0:3,NEXTERNAL)
10
111
C     
11
 
C     Process: d~ g > w+ u~ WEIGHTED<=3 [ all = QCD ]
12
 
C     Process: s~ g > w+ c~ WEIGHTED<=3 [ all = QCD ]
 
112
C     Process: d~ g > w+ u~ [ all = QED QCD ] QCD^2<=2 QED^2<=2
 
113
C     Process: s~ g > w+ c~ [ all = QED QCD ] QCD^2<=2 QED^2<=2
13
114
C     
14
115
      IMPLICIT NONE
15
116
C     
18
119
      INCLUDE 'nexternal.inc'
19
120
      INTEGER     NCOMB
20
121
      PARAMETER ( NCOMB=24)
 
122
      INTEGER NSQAMPSO
 
123
      PARAMETER (NSQAMPSO=1)
21
124
C     
22
125
C     ARGUMENTS 
23
126
C     
24
 
      REAL*8 P(0:3,NEXTERNAL),ANS
25
 
      DOUBLE PRECISION       WGT_ME_BORN,WGT_ME_REAL
26
 
      COMMON /C_WGT_ME_TREE/ WGT_ME_BORN,WGT_ME_REAL
 
127
      REAL*8 P(0:3,NEXTERNAL),ANS(0:NSQAMPSO)
27
128
C     
28
129
C     LOCAL VARIABLES 
29
130
C     
30
 
      INTEGER IHEL,IDEN,I,T_IDENT(NCOMB)
31
 
      REAL*8 MATRIX_3
32
 
      REAL*8 T,T_SAVE(NCOMB)
 
131
      INTEGER IHEL,IDEN,I,J,T_IDENT(NCOMB)
 
132
      REAL*8 T(0:NSQAMPSO),T_SAVE(NCOMB,0:NSQAMPSO)
33
133
      SAVE T_SAVE,T_IDENT
34
134
      INTEGER NHEL(NEXTERNAL,NCOMB)
35
135
      DATA (NHEL(I,   1),I=1,4) /-1,-1,-1, 1/
65
165
C     BEGIN CODE
66
166
C     ----------
67
167
      NTRY=NTRY+1
68
 
      ANS = 0D0
 
168
      DO I=0,NSQAMPSO
 
169
        ANS(I) = 0D0
 
170
      ENDDO
69
171
      DO IHEL=1,NCOMB
70
172
        IF (GOODHEL(IHEL) .OR. NTRY .LT. 2) THEN
71
173
          IF (NTRY.LT.2) THEN
72
174
C           for the first ps-point, check for helicities that give
73
175
C           identical matrix elements
74
 
            T=MATRIX_3(P ,NHEL(1,IHEL))
75
 
            T_SAVE(IHEL)=T
 
176
            CALL MATRIX_3(P ,NHEL(1,IHEL),T)
 
177
            DO I=0,NSQAMPSO
 
178
              T_SAVE(IHEL,I)=T(I)
 
179
            ENDDO
76
180
            T_IDENT(IHEL)=-1
77
181
            DO I=1,IHEL-1
78
 
              IF (T.EQ.0D0) EXIT
79
 
              IF (T_SAVE(I).EQ.0D0) CYCLE
80
 
              IF (ABS(T/T_SAVE(I)-1D0) .LT. 1D-12) THEN
81
 
C               WRITE (*,*) 'FOUND IDENTICAL',T,IHEL,T_SAVE(I),I
82
 
                T_IDENT(IHEL) = I
83
 
              ENDIF
 
182
              IF (T(0).EQ.0D0) EXIT
 
183
              IF (T_SAVE(I,0).EQ.0D0) CYCLE
 
184
              DO J = 0, NSQAMPSO
 
185
                IF (ABS(T(J)/T_SAVE(I,J)-1D0) .GT. 1D-12) GOTO 444
 
186
              ENDDO
 
187
              T_IDENT(IHEL) = I
 
188
 444          CONTINUE
84
189
            ENDDO
85
190
          ELSE
86
191
            IF (T_IDENT(IHEL).GT.0) THEN
87
192
C             if two helicity states are identical, dont recompute
88
 
              T=T_SAVE(T_IDENT(IHEL))
89
 
              T_SAVE(IHEL)=T
 
193
              DO I=0,NSQAMPSO
 
194
                T(I)=T_SAVE(T_IDENT(IHEL),I)
 
195
                T_SAVE(IHEL,I)=T(I)
 
196
              ENDDO
90
197
            ELSE
91
 
              T=MATRIX_3(P ,NHEL(1,IHEL))
92
 
              T_SAVE(IHEL)=T
 
198
              CALL MATRIX_3(P ,NHEL(1,IHEL),T)
 
199
              DO I=0,NSQAMPSO
 
200
                T_SAVE(IHEL,I)=T(I)
 
201
              ENDDO
93
202
            ENDIF
94
203
          ENDIF
95
204
C         add to the sum of helicities
96
 
          ANS=ANS+T
97
 
          IF (T .NE. 0D0 .AND. .NOT. GOODHEL(IHEL)) THEN
 
205
          DO I=1,NSQAMPSO  !keep loop from 1!!
 
206
            ANS(I)=ANS(I)+T(I)
 
207
          ENDDO
 
208
          IF (T(0) .NE. 0D0 .AND. .NOT. GOODHEL(IHEL)) THEN
98
209
            GOODHEL(IHEL)=.TRUE.
99
210
          ENDIF
100
211
        ENDIF
101
212
      ENDDO
102
 
      ANS=ANS/DBLE(IDEN)
103
 
      WGT_ME_REAL=ANS
 
213
      DO I=1,NSQAMPSO
 
214
        ANS(I)=ANS(I)/DBLE(IDEN)
 
215
        ANS(0)=ANS(0)+ANS(I)
 
216
      ENDDO
104
217
      END
105
218
 
106
219
 
107
 
      REAL*8 FUNCTION MATRIX_3(P,NHEL)
 
220
      SUBROUTINE MATRIX_3(P,NHEL,RES)
108
221
C     
109
222
C     Generated by MadGraph5_aMC@NLO v. %(version)s, %(date)s
110
223
C     By the MadGraph5_aMC@NLO Development Team
113
226
C     Returns amplitude squared summed/avg over colors
114
227
C     for the point with external lines W(0:6,NEXTERNAL)
115
228
C     
116
 
C     Process: d~ g > w+ u~ WEIGHTED<=3 [ all = QCD ]
117
 
C     Process: s~ g > w+ c~ WEIGHTED<=3 [ all = QCD ]
 
229
C     Process: d~ g > w+ u~ [ all = QED QCD ] QCD^2<=2 QED^2<=2
 
230
C     Process: s~ g > w+ c~ [ all = QED QCD ] QCD^2<=2 QED^2<=2
118
231
C     
119
232
      IMPLICIT NONE
120
233
C     
124
237
      PARAMETER (NGRAPHS=2)
125
238
      INTEGER    NWAVEFUNCS, NCOLOR
126
239
      PARAMETER (NWAVEFUNCS=5, NCOLOR=1)
 
240
      INTEGER NAMPSO, NSQAMPSO
 
241
      PARAMETER (NAMPSO=1, NSQAMPSO=1)
127
242
      REAL*8     ZERO
128
243
      PARAMETER (ZERO=0D0)
129
244
      COMPLEX*16 IMAG1
135
250
C     
136
251
      REAL*8 P(0:3,NEXTERNAL)
137
252
      INTEGER NHEL(NEXTERNAL)
 
253
      REAL*8 RES(0:NSQAMPSO)
138
254
C     
139
255
C     LOCAL VARIABLES 
140
256
C     
141
 
      INTEGER I,J
 
257
      INTEGER I,J,M,N
142
258
      INTEGER IC(NEXTERNAL)
143
259
      DATA IC /NEXTERNAL*1/
144
 
      REAL*8 CF(NCOLOR,NCOLOR)
145
 
      COMPLEX*16 ZTEMP, AMP(NGRAPHS), JAMP(NCOLOR), W(8,NWAVEFUNCS)
 
260
      REAL*8  CF(NCOLOR,NCOLOR)
 
261
      COMPLEX*16 ZTEMP, AMP(NGRAPHS), JAMP(NCOLOR,NAMPSO), W(8
 
262
     $ ,NWAVEFUNCS)
146
263
      COMPLEX*16 TMP_JAMP(0)
147
264
C     
 
265
C     FUNCTION
 
266
C     
 
267
      INTEGER SQSOINDEX3
 
268
C     
148
269
C     COLOR DATA
149
270
C     
150
271
      DATA (CF(I,  1),I=  1,  1) /4.000000000000000D+00/
162
283
      CALL FFV2_1(W(1,1),W(1,3),GC_11,ZERO,ZERO,W(1,5))
163
284
C     Amplitude(s) for diagram number 2
164
285
      CALL FFV1_0(W(1,4),W(1,5),W(1,2),GC_5,AMP(2))
165
 
      JAMP(1) = (-1.000000000000000D+00)*AMP(1)+(-1.000000000000000D
 
286
C     JAMPs contributing to orders QCD=1 QED=1
 
287
      JAMP(1,1) = (-1.000000000000000D+00)*AMP(1)+(-1.000000000000000D
166
288
     $ +00)*AMP(2)
167
 
      MATRIX_3 = 0.D0
168
 
      DO I = 1, NCOLOR
169
 
        ZTEMP = (0.D0,0.D0)
170
 
        DO J = 1, NCOLOR
171
 
          ZTEMP = ZTEMP + CF(J,I)*JAMP(J)
172
 
        ENDDO
173
 
        MATRIX_3 = MATRIX_3+ZTEMP*DCONJG(JAMP(I))
174
 
      ENDDO
 
289
 
 
290
      DO I=0,NSQAMPSO
 
291
        RES(I)=0D0
 
292
      ENDDO
 
293
      DO M = 1, NAMPSO
 
294
        DO I = 1, NCOLOR
 
295
          ZTEMP = (0.D0,0.D0)
 
296
          DO J = 1, NCOLOR
 
297
            ZTEMP = ZTEMP + CF(J,I)*JAMP(J,M)
 
298
          ENDDO
 
299
          DO N = 1, NAMPSO
 
300
            RES(SQSOINDEX3(M,N)) = RES(SQSOINDEX3(M,N)) + ZTEMP
 
301
     $       *DCONJG(JAMP(I,N))
 
302
          ENDDO
 
303
        ENDDO
 
304
      ENDDO
 
305
 
 
306
      DO I=1,NSQAMPSO
 
307
        RES(0)=RES(0)+RES(I)
 
308
      ENDDO
 
309
 
 
310
      END
 
311
 
 
312
C     
 
313
C     Helper functions to deal with the split orders.
 
314
C     
 
315
 
 
316
      INTEGER FUNCTION SQSOINDEX3(AMPORDERA,AMPORDERB)
 
317
C     
 
318
C     This functions plays the role of the interference matrix. It can
 
319
C      be hardcoded or 
 
320
C     made more elegant using hashtables if its execution speed ever
 
321
C      becomes a relevant
 
322
C     factor. From two split order indices of the jamps, it return the
 
323
C      corresponding
 
324
C     index in the squared order canonical ordering.
 
325
C     
 
326
C     CONSTANTS
 
327
C     
 
328
      IMPLICIT NONE
 
329
      INTEGER NAMPSO, NSQAMPSO
 
330
      PARAMETER (NAMPSO=1, NSQAMPSO=1)
 
331
      INTEGER NSPLITORDERS
 
332
      PARAMETER (NSPLITORDERS=2)
 
333
C     
 
334
C     ARGUMENTS
 
335
C     
 
336
      INTEGER AMPORDERA, AMPORDERB
 
337
C     
 
338
C     LOCAL VARIABLES
 
339
C     
 
340
      INTEGER I, SQORDERS(NSPLITORDERS)
 
341
      INTEGER AMPSPLITORDERS(NAMPSO,NSPLITORDERS)
 
342
      DATA (AMPSPLITORDERS(  1,I),I=  1,  2) /    1,    1/
 
343
C     
 
344
C     FUNCTION
 
345
C     
 
346
      INTEGER SQSOINDEX_FROM_ORDERS3
 
347
C     
 
348
C     BEGIN CODE
 
349
C     
 
350
      DO I=1,NSPLITORDERS
 
351
        SQORDERS(I)=AMPSPLITORDERS(AMPORDERA,I)
 
352
     $   +AMPSPLITORDERS(AMPORDERB,I)
 
353
      ENDDO
 
354
      SQSOINDEX3=SQSOINDEX_FROM_ORDERS3(SQORDERS)
 
355
      END
 
356
 
 
357
 
 
358
 
 
359
      INTEGER FUNCTION SQSOINDEX_FROM_ORDERS3(ORDERS)
 
360
C     
 
361
C     From a list of values for the split orders, this function
 
362
C      returns the
 
363
C     corresponding index in the squared orders canonical ordering.
 
364
C     
 
365
      IMPLICIT NONE
 
366
      INTEGER NSQAMPSO
 
367
      PARAMETER (NSQAMPSO=1)
 
368
      INTEGER NSPLITORDERS
 
369
      PARAMETER (NSPLITORDERS=2)
 
370
C     
 
371
C     ARGUMENTS
 
372
C     
 
373
      INTEGER ORDERS(NSPLITORDERS)
 
374
C     
 
375
C     LOCAL VARIABLES
 
376
C     
 
377
      INTEGER I,J
 
378
      INTEGER SQSPLITORDERS(NSQAMPSO,NSPLITORDERS)
 
379
C     the values listed below are for QCD, QED
 
380
      DATA (SQSPLITORDERS(  1,I),I=  1,  2) /    2,    2/
 
381
C     
 
382
C     BEGIN CODE
 
383
C     
 
384
      DO I=1,NSQAMPSO
 
385
        DO J=1,NSPLITORDERS
 
386
          IF (ORDERS(J).NE.SQSPLITORDERS(I,J)) GOTO 1009
 
387
        ENDDO
 
388
        SQSOINDEX_FROM_ORDERS3 = I
 
389
        RETURN
 
390
 1009   CONTINUE
 
391
      ENDDO
 
392
 
 
393
      WRITE(*,*) 'ERROR:: Stopping function sqsoindex_from_orders'
 
394
      WRITE(*,*) 'Could not find squared orders ',(ORDERS(I),I=1
 
395
     $ ,NSPLITORDERS)
 
396
      STOP
 
397
 
 
398
      END
 
399
 
 
400
 
 
401
 
 
402
      INTEGER FUNCTION GETORDPOWFROMINDEX3(IORDER, INDX)
 
403
C     
 
404
C     Return the power of the IORDER-th order appearing at position
 
405
C      INDX
 
406
C     in the split-orders output
 
407
C     
 
408
      IMPLICIT NONE
 
409
      INTEGER NSQAMPSO
 
410
      PARAMETER (NSQAMPSO=1)
 
411
      INTEGER NSPLITORDERS
 
412
      PARAMETER (NSPLITORDERS=2)
 
413
C     
 
414
C     ARGUMENTS
 
415
C     
 
416
      INTEGER IORDER, INDX
 
417
C     
 
418
C     LOCAL VARIABLES
 
419
C     
 
420
      INTEGER I
 
421
      INTEGER SQSPLITORDERS(NSQAMPSO,NSPLITORDERS)
 
422
C     the values listed below are for QCD, QED
 
423
      DATA (SQSPLITORDERS(  1,I),I=  1,  2) /    2,    2/
 
424
C     
 
425
C     BEGIN CODE
 
426
C     
 
427
      IF (IORDER.GT.NSPLITORDERS.OR.IORDER.LT.1) THEN
 
428
        WRITE(*,*) 'INVALID IORDER 3', IORDER
 
429
        WRITE(*,*) 'SHOULD BE BETWEEN 1 AND ', NSPLITORDERS
 
430
        STOP
 
431
      ENDIF
 
432
 
 
433
      IF (INDX.GT.NSQAMPSO.OR.INDX.LT.1) THEN
 
434
        WRITE(*,*) 'INVALID INDX 3', INDX
 
435
        WRITE(*,*) 'SHOULD BE BETWEEN 1 AND ', NSQAMPSO
 
436
        STOP
 
437
      ENDIF
 
438
 
 
439
      GETORDPOWFROMINDEX3=SQSPLITORDERS(INDX, IORDER)
 
440
      END
 
441
 
 
442
 
 
443
 
 
444
      SUBROUTINE GET_NSQSO_REAL3(NSQSO)
 
445
C     
 
446
C     Simple subroutine returning the number of squared split order
 
447
C     contributions returned in ANS when calling SMATRIX_SPLITORDERS
 
448
C     
 
449
      IMPLICIT NONE
 
450
      INTEGER NSQAMPSO
 
451
      PARAMETER (NSQAMPSO=1)
 
452
      INTEGER NSQSO
 
453
 
 
454
      NSQSO=NSQAMPSO
 
455
 
175
456
      END
176
457