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