← 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_ag_ttx%matrix_3.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_ag_ttx%matrix_3.f
 
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: a d > t t~ d [ real = QED QCD ] QCD^2<=4 QED^2<=2
 
13
C     Process: a s > t t~ s [ real = QED QCD ] QCD^2<=4 QED^2<=2
 
14
C     
 
15
C     
 
16
C     CONSTANTS
 
17
C     
 
18
      IMPLICIT NONE
 
19
      INTEGER    NEXTERNAL
 
20
      PARAMETER (NEXTERNAL=5)
 
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)
 
103
C     
 
104
C     Generated by MadGraph5_aMC@NLO v. %(version)s, %(date)s
 
105
C     By the MadGraph5_aMC@NLO Development Team
 
106
C     Visit launchpad.net/madgraph5 and amcatnlo.web.cern.ch
 
107
C     
 
108
C     Returns amplitude squared summed/avg over colors
 
109
C     and helicities
 
110
C     for the point in phase space P(0:3,NEXTERNAL)
 
111
C     
 
112
C     Process: a d > t t~ d [ real = QED QCD ] QCD^2<=4 QED^2<=2
 
113
C     Process: a s > t t~ s [ real = QED QCD ] QCD^2<=4 QED^2<=2
 
114
C     
 
115
      IMPLICIT NONE
 
116
C     
 
117
C     CONSTANTS
 
118
C     
 
119
      INCLUDE 'nexternal.inc'
 
120
      INTEGER     NCOMB
 
121
      PARAMETER ( NCOMB=32)
 
122
      INTEGER NSQAMPSO
 
123
      PARAMETER (NSQAMPSO=1)
 
124
C     
 
125
C     ARGUMENTS 
 
126
C     
 
127
      REAL*8 P(0:3,NEXTERNAL),ANS(0:NSQAMPSO)
 
128
C     
 
129
C     LOCAL VARIABLES 
 
130
C     
 
131
      INTEGER IHEL,IDEN,I,J,T_IDENT(NCOMB)
 
132
      REAL*8 T(0:NSQAMPSO),T_SAVE(NCOMB,0:NSQAMPSO)
 
133
      SAVE T_SAVE,T_IDENT
 
134
      INTEGER NHEL(NEXTERNAL,NCOMB)
 
135
      DATA (NHEL(I,   1),I=1,5) /-1, 1,-1, 1,-1/
 
136
      DATA (NHEL(I,   2),I=1,5) /-1, 1,-1, 1, 1/
 
137
      DATA (NHEL(I,   3),I=1,5) /-1, 1,-1,-1,-1/
 
138
      DATA (NHEL(I,   4),I=1,5) /-1, 1,-1,-1, 1/
 
139
      DATA (NHEL(I,   5),I=1,5) /-1, 1, 1, 1,-1/
 
140
      DATA (NHEL(I,   6),I=1,5) /-1, 1, 1, 1, 1/
 
141
      DATA (NHEL(I,   7),I=1,5) /-1, 1, 1,-1,-1/
 
142
      DATA (NHEL(I,   8),I=1,5) /-1, 1, 1,-1, 1/
 
143
      DATA (NHEL(I,   9),I=1,5) /-1,-1,-1, 1,-1/
 
144
      DATA (NHEL(I,  10),I=1,5) /-1,-1,-1, 1, 1/
 
145
      DATA (NHEL(I,  11),I=1,5) /-1,-1,-1,-1,-1/
 
146
      DATA (NHEL(I,  12),I=1,5) /-1,-1,-1,-1, 1/
 
147
      DATA (NHEL(I,  13),I=1,5) /-1,-1, 1, 1,-1/
 
148
      DATA (NHEL(I,  14),I=1,5) /-1,-1, 1, 1, 1/
 
149
      DATA (NHEL(I,  15),I=1,5) /-1,-1, 1,-1,-1/
 
150
      DATA (NHEL(I,  16),I=1,5) /-1,-1, 1,-1, 1/
 
151
      DATA (NHEL(I,  17),I=1,5) / 1, 1,-1, 1,-1/
 
152
      DATA (NHEL(I,  18),I=1,5) / 1, 1,-1, 1, 1/
 
153
      DATA (NHEL(I,  19),I=1,5) / 1, 1,-1,-1,-1/
 
154
      DATA (NHEL(I,  20),I=1,5) / 1, 1,-1,-1, 1/
 
155
      DATA (NHEL(I,  21),I=1,5) / 1, 1, 1, 1,-1/
 
156
      DATA (NHEL(I,  22),I=1,5) / 1, 1, 1, 1, 1/
 
157
      DATA (NHEL(I,  23),I=1,5) / 1, 1, 1,-1,-1/
 
158
      DATA (NHEL(I,  24),I=1,5) / 1, 1, 1,-1, 1/
 
159
      DATA (NHEL(I,  25),I=1,5) / 1,-1,-1, 1,-1/
 
160
      DATA (NHEL(I,  26),I=1,5) / 1,-1,-1, 1, 1/
 
161
      DATA (NHEL(I,  27),I=1,5) / 1,-1,-1,-1,-1/
 
162
      DATA (NHEL(I,  28),I=1,5) / 1,-1,-1,-1, 1/
 
163
      DATA (NHEL(I,  29),I=1,5) / 1,-1, 1, 1,-1/
 
164
      DATA (NHEL(I,  30),I=1,5) / 1,-1, 1, 1, 1/
 
165
      DATA (NHEL(I,  31),I=1,5) / 1,-1, 1,-1,-1/
 
166
      DATA (NHEL(I,  32),I=1,5) / 1,-1, 1,-1, 1/
 
167
      LOGICAL GOODHEL(NCOMB)
 
168
      DATA GOODHEL/NCOMB*.FALSE./
 
169
      INTEGER NTRY
 
170
      DATA NTRY/0/
 
171
      DATA IDEN/12/
 
172
C     ----------
 
173
C     BEGIN CODE
 
174
C     ----------
 
175
      NTRY=NTRY+1
 
176
      DO I=0,NSQAMPSO
 
177
        ANS(I) = 0D0
 
178
      ENDDO
 
179
      DO IHEL=1,NCOMB
 
180
        IF (GOODHEL(IHEL) .OR. NTRY .LT. 2) THEN
 
181
          IF (NTRY.LT.2) THEN
 
182
C           for the first ps-point, check for helicities that give
 
183
C           identical matrix elements
 
184
            CALL MATRIX_3(P ,NHEL(1,IHEL),T)
 
185
            DO I=0,NSQAMPSO
 
186
              T_SAVE(IHEL,I)=T(I)
 
187
            ENDDO
 
188
            T_IDENT(IHEL)=-1
 
189
            DO I=1,IHEL-1
 
190
              IF (T(0).EQ.0D0) EXIT
 
191
              IF (T_SAVE(I,0).EQ.0D0) CYCLE
 
192
              DO J = 0, NSQAMPSO
 
193
                IF (ABS(T(J)/T_SAVE(I,J)-1D0) .GT. 1D-12) GOTO 444
 
194
              ENDDO
 
195
              T_IDENT(IHEL) = I
 
196
 444          CONTINUE
 
197
            ENDDO
 
198
          ELSE
 
199
            IF (T_IDENT(IHEL).GT.0) THEN
 
200
C             if two helicity states are identical, dont recompute
 
201
              DO I=0,NSQAMPSO
 
202
                T(I)=T_SAVE(T_IDENT(IHEL),I)
 
203
                T_SAVE(IHEL,I)=T(I)
 
204
              ENDDO
 
205
            ELSE
 
206
              CALL MATRIX_3(P ,NHEL(1,IHEL),T)
 
207
              DO I=0,NSQAMPSO
 
208
                T_SAVE(IHEL,I)=T(I)
 
209
              ENDDO
 
210
            ENDIF
 
211
          ENDIF
 
212
C         add to the sum of helicities
 
213
          DO I=1,NSQAMPSO  !keep loop from 1!!
 
214
            ANS(I)=ANS(I)+T(I)
 
215
          ENDDO
 
216
          IF (T(0) .NE. 0D0 .AND. .NOT. GOODHEL(IHEL)) THEN
 
217
            GOODHEL(IHEL)=.TRUE.
 
218
          ENDIF
 
219
        ENDIF
 
220
      ENDDO
 
221
      DO I=1,NSQAMPSO
 
222
        ANS(I)=ANS(I)/DBLE(IDEN)
 
223
        ANS(0)=ANS(0)+ANS(I)
 
224
      ENDDO
 
225
      END
 
226
 
 
227
 
 
228
      SUBROUTINE MATRIX_3(P,NHEL,RES)
 
229
C     
 
230
C     Generated by MadGraph5_aMC@NLO v. %(version)s, %(date)s
 
231
C     By the MadGraph5_aMC@NLO Development Team
 
232
C     Visit launchpad.net/madgraph5 and amcatnlo.web.cern.ch
 
233
C     
 
234
C     Returns amplitude squared summed/avg over colors
 
235
C     for the point with external lines W(0:6,NEXTERNAL)
 
236
C     
 
237
C     Process: a d > t t~ d [ real = QED QCD ] QCD^2<=4 QED^2<=2
 
238
C     Process: a s > t t~ s [ real = QED QCD ] QCD^2<=4 QED^2<=2
 
239
C     
 
240
      IMPLICIT NONE
 
241
C     
 
242
C     CONSTANTS
 
243
C     
 
244
      INTEGER    NGRAPHS
 
245
      PARAMETER (NGRAPHS=4)
 
246
      INTEGER    NWAVEFUNCS, NCOLOR
 
247
      PARAMETER (NWAVEFUNCS=8, NCOLOR=2)
 
248
      INTEGER NAMPSO, NSQAMPSO
 
249
      PARAMETER (NAMPSO=1, NSQAMPSO=1)
 
250
      REAL*8     ZERO
 
251
      PARAMETER (ZERO=0D0)
 
252
      COMPLEX*16 IMAG1
 
253
      PARAMETER (IMAG1=(0D0,1D0))
 
254
      INCLUDE 'nexternal.inc'
 
255
      INCLUDE 'coupl.inc'
 
256
C     
 
257
C     ARGUMENTS 
 
258
C     
 
259
      REAL*8 P(0:3,NEXTERNAL)
 
260
      INTEGER NHEL(NEXTERNAL)
 
261
      REAL*8 RES(0:NSQAMPSO)
 
262
C     
 
263
C     LOCAL VARIABLES 
 
264
C     
 
265
      INTEGER I,J,M,N
 
266
      INTEGER IC(NEXTERNAL)
 
267
      DATA IC /NEXTERNAL*1/
 
268
      REAL*8  CF(NCOLOR,NCOLOR)
 
269
      COMPLEX*16 ZTEMP, AMP(NGRAPHS), JAMP(NCOLOR,NAMPSO), W(8
 
270
     $ ,NWAVEFUNCS)
 
271
      COMPLEX*16 TMP_JAMP(3)
 
272
C     
 
273
C     FUNCTION
 
274
C     
 
275
      INTEGER SQSOINDEX3
 
276
C     
 
277
C     COLOR DATA
 
278
C     
 
279
      DATA (CF(I,  1),I=  1,  2) /9.000000000000000D+00
 
280
     $ ,3.000000000000000D+00/
 
281
C     1 T(3,2) T(5,4)
 
282
      DATA (CF(I,  2),I=  1,  2) /3.000000000000000D+00
 
283
     $ ,9.000000000000000D+00/
 
284
C     1 T(3,4) T(5,2)
 
285
C     ----------
 
286
C     BEGIN CODE
 
287
C     ----------
 
288
      CALL VXXXXX(P(0,1),ZERO,NHEL(1),-1*IC(1),W(1,1))
 
289
      CALL IXXXXX(P(0,2),ZERO,NHEL(2),+1*IC(2),W(1,2))
 
290
      CALL OXXXXX(P(0,3),MDL_MT,NHEL(3),+1*IC(3),W(1,3))
 
291
      CALL IXXXXX(P(0,4),MDL_MT,NHEL(4),-1*IC(4),W(1,4))
 
292
      CALL OXXXXX(P(0,5),ZERO,NHEL(5),+1*IC(5),W(1,5))
 
293
      CALL FFV1_2(W(1,2),W(1,1),GC_1,ZERO,ZERO,W(1,6))
 
294
      CALL FFV1P0_3(W(1,4),W(1,3),GC_11,ZERO,ZERO,W(1,7))
 
295
C     Amplitude(s) for diagram number 1
 
296
      CALL FFV1_0(W(1,6),W(1,5),W(1,7),GC_11,AMP(1))
 
297
      CALL FFV1_1(W(1,3),W(1,1),GC_2,MDL_MT,MDL_WT,W(1,6))
 
298
      CALL FFV1P0_3(W(1,2),W(1,5),GC_11,ZERO,ZERO,W(1,8))
 
299
C     Amplitude(s) for diagram number 2
 
300
      CALL FFV1_0(W(1,4),W(1,6),W(1,8),GC_11,AMP(2))
 
301
      CALL FFV1_2(W(1,4),W(1,1),GC_2,MDL_MT,MDL_WT,W(1,6))
 
302
C     Amplitude(s) for diagram number 3
 
303
      CALL FFV1_0(W(1,6),W(1,3),W(1,8),GC_11,AMP(3))
 
304
      CALL FFV1_1(W(1,5),W(1,1),GC_1,ZERO,ZERO,W(1,6))
 
305
C     Amplitude(s) for diagram number 4
 
306
      CALL FFV1_0(W(1,2),W(1,6),W(1,7),GC_11,AMP(4))
 
307
C     JAMPs contributing to orders QCD=2 QED=1
 
308
      TMP_JAMP(2) = AMP(3) +  AMP(4)  ! used 2 times
 
309
      TMP_JAMP(1) = AMP(1) +  AMP(2)  ! used 2 times
 
310
      TMP_JAMP(3) = TMP_JAMP(2) +  TMP_JAMP(1)  ! used 2 times
 
311
      JAMP(1,1) = (-5.000000000000000D-01)*TMP_JAMP(3)
 
312
      JAMP(2,1) = (1.666666666666667D-01)*TMP_JAMP(3)
 
313
 
 
314
      DO I=0,NSQAMPSO
 
315
        RES(I)=0D0
 
316
      ENDDO
 
317
      DO M = 1, NAMPSO
 
318
        DO I = 1, NCOLOR
 
319
          ZTEMP = (0.D0,0.D0)
 
320
          DO J = 1, NCOLOR
 
321
            ZTEMP = ZTEMP + CF(J,I)*JAMP(J,M)
 
322
          ENDDO
 
323
          DO N = 1, NAMPSO
 
324
            RES(SQSOINDEX3(M,N)) = RES(SQSOINDEX3(M,N)) + ZTEMP
 
325
     $       *DCONJG(JAMP(I,N))
 
326
          ENDDO
 
327
        ENDDO
 
328
      ENDDO
 
329
 
 
330
      DO I=1,NSQAMPSO
 
331
        RES(0)=RES(0)+RES(I)
 
332
      ENDDO
 
333
 
 
334
      END
 
335
 
 
336
C     
 
337
C     Helper functions to deal with the split orders.
 
338
C     
 
339
 
 
340
      INTEGER FUNCTION SQSOINDEX3(AMPORDERA,AMPORDERB)
 
341
C     
 
342
C     This functions plays the role of the interference matrix. It can
 
343
C      be hardcoded or 
 
344
C     made more elegant using hashtables if its execution speed ever
 
345
C      becomes a relevant
 
346
C     factor. From two split order indices of the jamps, it return the
 
347
C      corresponding
 
348
C     index in the squared order canonical ordering.
 
349
C     
 
350
C     CONSTANTS
 
351
C     
 
352
      IMPLICIT NONE
 
353
      INTEGER NAMPSO, NSQAMPSO
 
354
      PARAMETER (NAMPSO=1, NSQAMPSO=1)
 
355
      INTEGER NSPLITORDERS
 
356
      PARAMETER (NSPLITORDERS=2)
 
357
C     
 
358
C     ARGUMENTS
 
359
C     
 
360
      INTEGER AMPORDERA, AMPORDERB
 
361
C     
 
362
C     LOCAL VARIABLES
 
363
C     
 
364
      INTEGER I, SQORDERS(NSPLITORDERS)
 
365
      INTEGER AMPSPLITORDERS(NAMPSO,NSPLITORDERS)
 
366
      DATA (AMPSPLITORDERS(  1,I),I=  1,  2) /    2,    1/
 
367
C     
 
368
C     FUNCTION
 
369
C     
 
370
      INTEGER SQSOINDEX_FROM_ORDERS3
 
371
C     
 
372
C     BEGIN CODE
 
373
C     
 
374
      DO I=1,NSPLITORDERS
 
375
        SQORDERS(I)=AMPSPLITORDERS(AMPORDERA,I)
 
376
     $   +AMPSPLITORDERS(AMPORDERB,I)
 
377
      ENDDO
 
378
      SQSOINDEX3=SQSOINDEX_FROM_ORDERS3(SQORDERS)
 
379
      END
 
380
 
 
381
 
 
382
 
 
383
      INTEGER FUNCTION SQSOINDEX_FROM_ORDERS3(ORDERS)
 
384
C     
 
385
C     From a list of values for the split orders, this function
 
386
C      returns the
 
387
C     corresponding index in the squared orders canonical ordering.
 
388
C     
 
389
      IMPLICIT NONE
 
390
      INTEGER NSQAMPSO
 
391
      PARAMETER (NSQAMPSO=1)
 
392
      INTEGER NSPLITORDERS
 
393
      PARAMETER (NSPLITORDERS=2)
 
394
C     
 
395
C     ARGUMENTS
 
396
C     
 
397
      INTEGER ORDERS(NSPLITORDERS)
 
398
C     
 
399
C     LOCAL VARIABLES
 
400
C     
 
401
      INTEGER I,J
 
402
      INTEGER SQSPLITORDERS(NSQAMPSO,NSPLITORDERS)
 
403
C     the values listed below are for QCD, QED
 
404
      DATA (SQSPLITORDERS(  1,I),I=  1,  2) /    4,    2/
 
405
C     
 
406
C     BEGIN CODE
 
407
C     
 
408
      DO I=1,NSQAMPSO
 
409
        DO J=1,NSPLITORDERS
 
410
          IF (ORDERS(J).NE.SQSPLITORDERS(I,J)) GOTO 1009
 
411
        ENDDO
 
412
        SQSOINDEX_FROM_ORDERS3 = I
 
413
        RETURN
 
414
 1009   CONTINUE
 
415
      ENDDO
 
416
 
 
417
      WRITE(*,*) 'ERROR:: Stopping function sqsoindex_from_orders'
 
418
      WRITE(*,*) 'Could not find squared orders ',(ORDERS(I),I=1
 
419
     $ ,NSPLITORDERS)
 
420
      STOP
 
421
 
 
422
      END
 
423
 
 
424
 
 
425
 
 
426
      INTEGER FUNCTION GETORDPOWFROMINDEX3(IORDER, INDX)
 
427
C     
 
428
C     Return the power of the IORDER-th order appearing at position
 
429
C      INDX
 
430
C     in the split-orders output
 
431
C     
 
432
      IMPLICIT NONE
 
433
      INTEGER NSQAMPSO
 
434
      PARAMETER (NSQAMPSO=1)
 
435
      INTEGER NSPLITORDERS
 
436
      PARAMETER (NSPLITORDERS=2)
 
437
C     
 
438
C     ARGUMENTS
 
439
C     
 
440
      INTEGER IORDER, INDX
 
441
C     
 
442
C     LOCAL VARIABLES
 
443
C     
 
444
      INTEGER I
 
445
      INTEGER SQSPLITORDERS(NSQAMPSO,NSPLITORDERS)
 
446
C     the values listed below are for QCD, QED
 
447
      DATA (SQSPLITORDERS(  1,I),I=  1,  2) /    4,    2/
 
448
C     
 
449
C     BEGIN CODE
 
450
C     
 
451
      IF (IORDER.GT.NSPLITORDERS.OR.IORDER.LT.1) THEN
 
452
        WRITE(*,*) 'INVALID IORDER 3', IORDER
 
453
        WRITE(*,*) 'SHOULD BE BETWEEN 1 AND ', NSPLITORDERS
 
454
        STOP
 
455
      ENDIF
 
456
 
 
457
      IF (INDX.GT.NSQAMPSO.OR.INDX.LT.1) THEN
 
458
        WRITE(*,*) 'INVALID INDX 3', INDX
 
459
        WRITE(*,*) 'SHOULD BE BETWEEN 1 AND ', NSQAMPSO
 
460
        STOP
 
461
      ENDIF
 
462
 
 
463
      GETORDPOWFROMINDEX3=SQSPLITORDERS(INDX, IORDER)
 
464
      END
 
465
 
 
466
 
 
467
 
 
468
      SUBROUTINE GET_NSQSO_REAL3(NSQSO)
 
469
C     
 
470
C     Simple subroutine returning the number of squared split order
 
471
C     contributions returned in ANS when calling SMATRIX_SPLITORDERS
 
472
C     
 
473
      IMPLICIT NONE
 
474
      INTEGER NSQAMPSO
 
475
      PARAMETER (NSQAMPSO=1)
 
476
      INTEGER NSQSO
 
477
 
 
478
      NSQSO=NSQAMPSO
 
479
 
 
480
      END
 
481