← Back to branch summary

~madteam/mg5amcnlo/series2.0

« back to all changes in this revision

Viewing changes to tests/input_files/IOTestsComparison/IOExportV4IOTest/export_matrix_element_v4_madevent_group/super_auto_dsig.f

  • Committer: olivier Mattelaer
  • Date: 2015-03-05 00:14:16 UTC
  • mfrom: (258.1.9 2.3)
  • mto: (258.8.1 2.3)
  • mto: This revision was merged to the branch mainline in revision 259.
  • Revision ID: olivier.mattelaer@uclouvain.be-20150305001416-y9mzeykfzwnl9t0j
partial merge

Show diffs side-by-side

added added

removed removed

Lines of Context:
tests/input_files/IOTestsComparison/IOExportV4IOTest/export_matrix_element_v4_madevent_group/super_auto_dsig.f
 
1
      DOUBLE PRECISION FUNCTION DSIG(PP,WGT,IMODE)
 
2
C     ****************************************************
 
3
C     
 
4
C     Generated by MadGraph5_aMC@NLO v. %(version)s, %(date)s
 
5
C     By the MadGraph5_aMC@NLO Development Team
 
6
C     Visit launchpad.net/madgraph5 and amcatnlo.web.cern.ch
 
7
C     
 
8
C     Process: u u~ > u u~
 
9
C     Process: u u~ > d d~
 
10
C     
 
11
C     RETURNS DIFFERENTIAL CROSS SECTION 
 
12
C     FOR MULTIPLE PROCESSES IN PROCESS GROUP
 
13
C     Input:
 
14
C     pp    4 momentum of external particles
 
15
C     wgt   weight from Monte Carlo
 
16
C     imode 0 run, 1 init, 2 reweight,
 
17
C     3 finalize, 4 only PDFs
 
18
C     Output:
 
19
C     Amplitude squared and summed
 
20
C     ****************************************************
 
21
      USE DISCRETESAMPLER
 
22
      IMPLICIT NONE
 
23
C     
 
24
C     CONSTANTS
 
25
C     
 
26
      INCLUDE 'genps.inc'
 
27
      INCLUDE 'maxconfigs.inc'
 
28
      INCLUDE 'nexternal.inc'
 
29
      INCLUDE 'maxamps.inc'
 
30
      REAL*8     PI
 
31
      PARAMETER (PI=3.1415926D0)
 
32
C     
 
33
C     ARGUMENTS 
 
34
C     
 
35
      DOUBLE PRECISION PP(0:3,NEXTERNAL), WGT
 
36
      INTEGER IMODE
 
37
C     
 
38
C     LOCAL VARIABLES 
 
39
C     
 
40
      INTEGER LMAPPED
 
41
      INTEGER I,J,K,LUN,ICONF,IMIRROR,NPROC
 
42
      SAVE NPROC
 
43
      INTEGER SYMCONF(0:LMAXCONFIGS)
 
44
      SAVE SYMCONF
 
45
      DOUBLE PRECISION SUMPROB,TOTWGT,R,XDUM
 
46
      INTEGER CONFSUB(MAXSPROC,LMAXCONFIGS)
 
47
      INCLUDE 'config_subproc_map.inc'
 
48
      INTEGER PERMS(NEXTERNAL,LMAXCONFIGS)
 
49
      INCLUDE 'symperms.inc'
 
50
      LOGICAL MIRRORPROCS(MAXSPROC)
 
51
      INCLUDE 'mirrorprocs.inc'
 
52
C     SELPROC is vector of selection weights for the subprocesses
 
53
C     SUMWGT is vector of total weight for the subprocesses
 
54
C     NUMEVTS is vector of event calls for the subprocesses
 
55
      DOUBLE PRECISION SELPROC(2, MAXSPROC,LMAXCONFIGS)
 
56
      DOUBLE PRECISION SUMWGT(2, MAXSPROC,LMAXCONFIGS)
 
57
      INTEGER NUMEVTS(2, MAXSPROC,LMAXCONFIGS)
 
58
      INTEGER LARGEDIM
 
59
      PARAMETER (LARGEDIM=2*MAXSPROC*LMAXCONFIGS)
 
60
      DATA SELPROC/LARGEDIM*0D0/
 
61
      DATA SUMWGT/LARGEDIM*0D0/
 
62
      DATA NUMEVTS/LARGEDIM*0/
 
63
      SAVE SELPROC,SUMWGT,NUMEVTS
 
64
      REAL*8 MC_GROUPED_PROC_JACOBIAN
 
65
      INTEGER GROUPED_MC_GRID_STATUS
 
66
C     
 
67
C     EXTERNAL FUNCTIONS
 
68
C     
 
69
      INTEGER NEXTUNOPEN
 
70
      DOUBLE PRECISION DSIGPROC
 
71
      EXTERNAL NEXTUNOPEN,DSIGPROC
 
72
C     
 
73
C     GLOBAL VARIABLES
 
74
C     
 
75
      INCLUDE 'coupl.inc'
 
76
      INCLUDE 'run.inc'
 
77
C     ICONFIG has this config number
 
78
      INTEGER MAPCONFIG(0:LMAXCONFIGS), ICONFIG
 
79
      COMMON/TO_MCONFIGS/MAPCONFIG, ICONFIG
 
80
C     IPROC has the present process number
 
81
      INTEGER IPROC
 
82
      COMMON/TO_MIRROR/IMIRROR, IPROC
 
83
C     CM_RAP has parton-parton system rapidity
 
84
      DOUBLE PRECISION CM_RAP
 
85
      LOGICAL SET_CM_RAP
 
86
      COMMON/TO_CM_RAP/SET_CM_RAP,CM_RAP
 
87
C     Keep track of whether cuts already calculated for this event
 
88
      LOGICAL CUTSDONE,CUTSPASSED
 
89
      COMMON/TO_CUTSDONE/CUTSDONE,CUTSPASSED
 
90
C     To be able to control when the matrix<i> subroutine can add
 
91
C      entries to the grid for the MC over helicity configuration
 
92
      LOGICAL ALLOW_HELICITY_GRID_ENTRIES
 
93
      DATA ALLOW_HELICITY_GRID_ENTRIES/.TRUE./
 
94
      COMMON/TO_ALLOW_HELICITY_GRID_ENTRIES/ALLOW_HELICITY_GRID_ENTRIES
 
95
C     To limit the number of calls to switchmom, use in DSIGPROC the
 
96
C      cached variable last_iconfig. It is in this subroutine as well
 
97
C      so that we can set it to -1 to ignore caching (to prevent
 
98
C      undesired effect if this subroutine is called from elsewhere
 
99
C      and to 0 to reset the cache.
 
100
      INTEGER LAST_ICONF
 
101
      DATA LAST_ICONF/-1/
 
102
      COMMON/TO_LAST_ICONF/LAST_ICONF
 
103
 
 
104
C     ----------
 
105
C     BEGIN CODE
 
106
C     ----------
 
107
      DSIG=0D0
 
108
 
 
109
C     Make sure cuts are evaluated for first subprocess
 
110
      CUTSDONE=.FALSE.
 
111
      CUTSPASSED=.FALSE.
 
112
 
 
113
      IF(IMODE.EQ.1)THEN
 
114
C       Set up process information from file symfact
 
115
        LUN=NEXTUNOPEN()
 
116
        IPROC=1
 
117
        SYMCONF(IPROC)=ICONFIG
 
118
        OPEN(UNIT=LUN,FILE='../symfact.dat',STATUS='OLD',ERR=20)
 
119
        DO WHILE(.TRUE.)
 
120
          READ(LUN,*,ERR=10,END=10) XDUM, ICONF
 
121
          IF(ICONF.EQ.-MAPCONFIG(ICONFIG))THEN
 
122
            IPROC=IPROC+1
 
123
            SYMCONF(IPROC)=INT(XDUM)
 
124
          ENDIF
 
125
        ENDDO
 
126
 10     SYMCONF(0)=IPROC
 
127
        CLOSE(LUN)
 
128
        RETURN
 
129
 20     SYMCONF(0)=IPROC
 
130
        WRITE(*,*)'Error opening symfact.dat. No permutations used.'
 
131
        RETURN
 
132
      ELSE IF(IMODE.EQ.2)THEN
 
133
C       Output weights and number of events
 
134
        SUMPROB=0D0
 
135
        DO J=1,SYMCONF(0)
 
136
          DO I=1,MAXSPROC
 
137
            DO K=1,2
 
138
              SUMPROB=SUMPROB+SUMWGT(K,I,J)
 
139
            ENDDO
 
140
          ENDDO
 
141
        ENDDO
 
142
        WRITE(*,*)'Relative summed weights:'
 
143
        DO J=1,SYMCONF(0)
 
144
          WRITE(*,'(4E12.4)')((SUMWGT(K,I,J)/SUMPROB,K=1,2),I=1
 
145
     $     ,MAXSPROC)
 
146
        ENDDO
 
147
        SUMPROB=0D0
 
148
        DO J=1,SYMCONF(0)
 
149
          DO I=1,MAXSPROC
 
150
            DO K=1,2
 
151
              SUMPROB=SUMPROB+NUMEVTS(K,I,J)
 
152
            ENDDO
 
153
          ENDDO
 
154
        ENDDO
 
155
        WRITE(*,*)'Relative number of events:'
 
156
        DO J=1,SYMCONF(0)
 
157
          WRITE(*,'(4E12.4)')((NUMEVTS(K,I,J)/SUMPROB,K=1,2),I=1
 
158
     $     ,MAXSPROC)
 
159
        ENDDO
 
160
        WRITE(*,*)'Events:'
 
161
        DO J=1,SYMCONF(0)
 
162
          WRITE(*,'(4I12)')((NUMEVTS(K,I,J),K=1,2),I=1,MAXSPROC)
 
163
        ENDDO
 
164
C       Reset weights and number of events
 
165
        DO J=1,SYMCONF(0)
 
166
          DO I=1,MAXSPROC
 
167
            DO K=1,2
 
168
              NUMEVTS(K,I,J)=0
 
169
              SUMWGT(K,I,J)=0D0
 
170
            ENDDO
 
171
          ENDDO
 
172
        ENDDO
 
173
        RETURN
 
174
      ELSE IF(IMODE.EQ.3)THEN
 
175
C       No finalize needed
 
176
        RETURN
 
177
      ENDIF
 
178
 
 
179
C     IMODE.EQ.0, regular run mode
 
180
      IF(MC_GROUPED_SUBPROC.AND.DS_GET_DIM_STATUS('grouped_processes'
 
181
     $ ).EQ.-1) THEN
 
182
        CALL DS_REGISTER_DIMENSION('grouped_processes', 0)
 
183
        CALL DS_SET_MIN_POINTS(10,'grouped_processes')
 
184
        DO J=1,SYMCONF(0)
 
185
          DO IPROC=1,MAXSPROC
 
186
            IF(CONFSUB(IPROC,SYMCONF(J)).NE.0) THEN
 
187
              DO IMIRROR=1,2
 
188
                IF(IMIRROR.EQ.1.OR.MIRRORPROCS(IPROC))THEN
 
189
                  CALL MAP_3_TO_1(J,IPROC,IMIRROR,MAXSPROC,2,LMAPPED)
 
190
                  CALL DS_ADD_BIN('grouped_processes',LMAPPED)
 
191
                ENDIF
 
192
              ENDDO
 
193
            ENDIF
 
194
          ENDDO
 
195
        ENDDO
 
196
      ENDIF
 
197
      IF(MC_GROUPED_SUBPROC.AND.DS_DIM_INDEX(RUN_GRID, 'PDF_convolutio'
 
198
     $ //'n',.TRUE.).EQ.-1) THEN
 
199
        CALL DS_REGISTER_DIMENSION('PDF_convolution', 0, ALL_GRIDS=.FAL
 
200
     $   SE.)
 
201
      ENDIF
 
202
 
 
203
C     Select among the subprocesses based on PDF weight
 
204
      SUMPROB=0D0
 
205
C     Turn caching on in dsigproc to avoid too many calls to switchmom
 
206
      LAST_ICONF=0
 
207
      DO J=1,SYMCONF(0)
 
208
        DO IPROC=1,MAXSPROC
 
209
          IF(CONFSUB(IPROC,SYMCONF(J)).NE.0) THEN
 
210
            DO IMIRROR=1,2
 
211
              IF(IMIRROR.EQ.1.OR.MIRRORPROCS(IPROC))THEN
 
212
C               Calculate PDF weight for all subprocesses
 
213
                SELPROC(IMIRROR,IPROC,J)=DSIGPROC(PP,J,IPROC,IMIRROR
 
214
     $           ,SYMCONF,CONFSUB,1D0,4)
 
215
                IF(MC_GROUPED_SUBPROC) THEN
 
216
                  CALL MAP_3_TO_1(J,IPROC,IMIRROR,MAXSPROC,2,LMAPPED)
 
217
                  CALL DS_ADD_ENTRY('PDF_convolution',LMAPPED
 
218
     $             ,SELPROC(IMIRROR,IPROC,J),.TRUE.)
 
219
                ENDIF
 
220
                SUMPROB=SUMPROB+SELPROC(IMIRROR,IPROC,J)
 
221
                IF(IMIRROR.EQ.2)THEN
 
222
C                 Need to flip back x values
 
223
                  XDUM=XBK(1)
 
224
                  XBK(1)=XBK(2)
 
225
                  XBK(2)=XDUM
 
226
                  CM_RAP=-CM_RAP
 
227
                ENDIF
 
228
              ENDIF
 
229
            ENDDO
 
230
          ENDIF
 
231
        ENDDO
 
232
      ENDDO
 
233
C     Turn caching in dsigproc back off to avoid side effects.
 
234
      LAST_ICONF=-1
 
235
 
 
236
C     Cannot make a selection with all PDFs to zero, so we return now
 
237
      IF(SUMPROB.EQ.0.0D0) THEN
 
238
        RETURN
 
239
      ENDIF
 
240
 
 
241
C     Perform the selection
 
242
      CALL RANMAR(R)
 
243
 
 
244
C     It is important to cache the status before adding any entries to
 
245
C      this grid in this
 
246
C     routine since it might change it
 
247
      GROUPED_MC_GRID_STATUS = DS_GET_DIM_STATUS('grouped_processes')
 
248
 
 
249
      IF (MC_GROUPED_SUBPROC.AND.GROUPED_MC_GRID_STATUS.EQ.0) THEN
 
250
C       We must initialize the grid and probe all channels
 
251
        SUMPROB=0.0D0
 
252
C       Turn caching on in dsigproc to avoid too many calls to
 
253
C        switchmom
 
254
        LAST_ICONF=0
 
255
        DO J=1,SYMCONF(0)
 
256
          DO I=1,MAXSPROC
 
257
            IF(CONFSUB(I,SYMCONF(J)).NE.0) THEN
 
258
              DO K=1,2
 
259
                IF(K.EQ.1.OR.MIRRORPROCS(I))THEN
 
260
                  IPROC=I
 
261
                  ICONF=J
 
262
                  IMIRROR=K
 
263
C                 The IMODE=5 computes the matrix_element only,
 
264
C                  without PDF convolution 
 
265
                  DSIG=DSIGPROC(PP,ICONF,IPROC,IMIRROR,SYMCONF,CONFSUB
 
266
     $             ,WGT,5)
 
267
                  CALL MAP_3_TO_1(J,I,K,MAXSPROC,2,LMAPPED)
 
268
                  IF (SELPROC(K,I,J).NE.0.0D0) THEN
 
269
                    CALL DS_ADD_ENTRY('grouped_processes',LMAPPED,DSIG)
 
270
                  ENDIF
 
271
                  IF(K.EQ.2)THEN
 
272
C                   Need to flip back x values
 
273
                    XDUM=XBK(1)
 
274
                    XBK(1)=XBK(2)
 
275
                    XBK(2)=XDUM
 
276
                    CM_RAP=-CM_RAP
 
277
                  ENDIF
 
278
                  SELPROC(K,I,J) = DSIG*SELPROC(K,I,J)
 
279
                  SUMPROB = SUMPROB + SELPROC(K,I,J)
 
280
                ENDIF
 
281
              ENDDO
 
282
            ENDIF
 
283
          ENDDO
 
284
        ENDDO
 
285
C       Turn caching in dsigproc back off to avoid side effects.
 
286
        LAST_ICONF=-1
 
287
C       If these additional entries were enough to initialize the
 
288
C        gird, then update it
 
289
C       To do this check we must *not* used the cached varianble
 
290
C        grouped_MC_grid_status
 
291
        IF(DS_GET_DIM_STATUS('grouped_processes').GE.1) THEN
 
292
          CALL DS_UPDATE_GRID('grouped_processes')
 
293
          CALL RESET_CUMULATIVE_VARIABLE()
 
294
        ENDIF
 
295
      ENDIF
 
296
 
 
297
C     If we are still initializing the grid or simply not using one at
 
298
C      all, then we pick a point based on PDF only.
 
299
      IF (.NOT.MC_GROUPED_SUBPROC.OR.GROUPED_MC_GRID_STATUS.EQ.0) THEN
 
300
        R=R*SUMPROB
 
301
        ICONF=0
 
302
        IPROC=0
 
303
        TOTWGT=0D0
 
304
        DO J=1,SYMCONF(0)
 
305
          DO I=1,MAXSPROC
 
306
            DO K=1,2
 
307
              TOTWGT=TOTWGT+SELPROC(K,I,J)
 
308
              IF(R.LT.TOTWGT)THEN
 
309
                IPROC=I
 
310
                ICONF=J
 
311
                IMIRROR=K
 
312
                GOTO 50
 
313
              ENDIF
 
314
            ENDDO
 
315
          ENDDO
 
316
        ENDDO
 
317
 50     CONTINUE
 
318
 
 
319
        IF(IPROC.EQ.0) RETURN
 
320
 
 
321
C       Update weigth w.r.t SELPROC normalized to selection probability
 
322
 
 
323
        WGT=WGT*(SUMPROB/SELPROC(IMIRROR,IPROC,ICONF))
 
324
 
 
325
      ELSE
 
326
C       We are using the grouped_processes grid and it is initialized.
 
327
        CALL DS_GET_POINT('grouped_processes',R,LMAPPED,MC_GROUPED_PROC
 
328
     $   _JACOBIAN,'norm',(/'PDF_convolution'/))
 
329
        WGT=WGT*MC_GROUPED_PROC_JACOBIAN
 
330
        CALL MAP_1_TO_3(LMAPPED,MAXSPROC,2,ICONF,IPROC,IMIRROR)
 
331
      ENDIF
 
332
 
 
333
C     Redo clustering to ensure consistent with final IPROC
 
334
      CUTSDONE=.FALSE.
 
335
 
 
336
      IF(GROUPED_MC_GRID_STATUS.EQ.0) THEN
 
337
C       If we were in the initialization phase of the grid for MC over
 
338
C        grouped processes, we must instruct the matrix<i> subroutine
 
339
C        not to add again an entry in the grid for this PS point at
 
340
C        the call DSIGPROC just below.
 
341
        ALLOW_HELICITY_GRID_ENTRIES = .FALSE.
 
342
      ENDIF
 
343
C     Call DSIGPROC to calculate sigma for process
 
344
      DSIG=DSIGPROC(PP,ICONF,IPROC,IMIRROR,SYMCONF,CONFSUB,WGT,IMODE)
 
345
C     Reset ALLOW_HELICITY_GRID_ENTRIES
 
346
      ALLOW_HELICITY_GRID_ENTRIES = .TRUE.
 
347
 
 
348
      IF(GROUPED_MC_GRID_STATUS.GE.1) THEN
 
349
        CALL MAP_3_TO_1(ICONF,IPROC,IMIRROR,MAXSPROC,2,LMAPPED)
 
350
        CALL DS_ADD_ENTRY('grouped_processes',LMAPPED,(DSIG/SELPROC(IMI
 
351
     $   RROR,IPROC,ICONF)))
 
352
      ENDIF
 
353
 
 
354
      IF(DSIG.GT.0D0)THEN
 
355
C       Update summed weight and number of events
 
356
        SUMWGT(IMIRROR,IPROC,ICONF)=SUMWGT(IMIRROR,IPROC,ICONF)
 
357
     $   +DABS(DSIG*WGT)
 
358
        NUMEVTS(IMIRROR,IPROC,ICONF)=NUMEVTS(IMIRROR,IPROC,ICONF)+1
 
359
      ENDIF
 
360
 
 
361
      RETURN
 
362
      END
 
363
 
 
364
      FUNCTION DSIGPROC(PP,ICONF,IPROC,IMIRROR,SYMCONF,CONFSUB,WGT
 
365
     $ ,IMODE)
 
366
C     ****************************************************
 
367
C     RETURNS DIFFERENTIAL CROSS SECTION 
 
368
C     FOR A PROCESS
 
369
C     Input:
 
370
C     pp    4 momentum of external particles
 
371
C     wgt   weight from Monte Carlo
 
372
C     imode 0 run, 1 init, 2 reweight, 3 finalize
 
373
C     Output:
 
374
C     Amplitude squared and summed
 
375
C     ****************************************************
 
376
 
 
377
      IMPLICIT NONE
 
378
 
 
379
      INCLUDE 'genps.inc'
 
380
      INCLUDE 'maxconfigs.inc'
 
381
      INCLUDE 'nexternal.inc'
 
382
      INCLUDE 'maxamps.inc'
 
383
      INCLUDE 'coupl.inc'
 
384
      INCLUDE 'run.inc'
 
385
C     
 
386
C     ARGUMENTS 
 
387
C     
 
388
      DOUBLE PRECISION DSIGPROC
 
389
      DOUBLE PRECISION PP(0:3,NEXTERNAL), WGT
 
390
      INTEGER ICONF,IPROC,IMIRROR,IMODE
 
391
      INTEGER SYMCONF(0:LMAXCONFIGS)
 
392
      INTEGER CONFSUB(MAXSPROC,LMAXCONFIGS)
 
393
C     
 
394
C     GLOBAL VARIABLES
 
395
C     
 
396
C     SUBDIAG is vector of diagram numbers for this config
 
397
C     IB gives which beam is which (for mirror processes)
 
398
      INTEGER SUBDIAG(MAXSPROC),IB(2)
 
399
      COMMON/TO_SUB_DIAG/SUBDIAG,IB
 
400
C     ICONFIG has this config number
 
401
      INTEGER MAPCONFIG(0:LMAXCONFIGS), ICONFIG
 
402
      COMMON/TO_MCONFIGS/MAPCONFIG, ICONFIG
 
403
C     CM_RAP has parton-parton system rapidity
 
404
      DOUBLE PRECISION CM_RAP
 
405
      LOGICAL SET_CM_RAP
 
406
      COMMON/TO_CM_RAP/SET_CM_RAP,CM_RAP
 
407
C     To limit the number of calls to switchmom, use in DSIGPROC the
 
408
C      cached variable last_iconfig. When set to -1, it ignores
 
409
C      caching (to prevent undesired effect if this subroutine is
 
410
C      called from elsewhere) and when set to 0, it resets the cache.
 
411
      INTEGER LAST_ICONF
 
412
      DATA LAST_ICONF/-1/
 
413
      COMMON/TO_LAST_ICONF/LAST_ICONF
 
414
C     
 
415
C     EXTERNAL FUNCTIONS
 
416
C     
 
417
      DOUBLE PRECISION DSIG1,DSIG2
 
418
      LOGICAL PASSCUTS
 
419
C     
 
420
C     LOCAL VARIABLES 
 
421
C     
 
422
      DOUBLE PRECISION P1(0:3,NEXTERNAL),XDUM
 
423
      INTEGER I,J,K,JC(NEXTERNAL)
 
424
      INTEGER PERMS(NEXTERNAL,LMAXCONFIGS)
 
425
      INCLUDE 'symperms.inc'
 
426
      SAVE P1,JC
 
427
 
 
428
      IF (LAST_ICONF.EQ.-1.OR.LAST_ICONF.NE.ICONF) THEN
 
429
 
 
430
        ICONFIG=SYMCONF(ICONF)
 
431
        DO I=1,MAXSPROC
 
432
          SUBDIAG(I) = CONFSUB(I,SYMCONF(ICONF))
 
433
        ENDDO
 
434
 
 
435
C       Set momenta according to this permutation
 
436
        CALL SWITCHMOM(PP,P1,PERMS(1,MAPCONFIG(ICONFIG)),JC,NEXTERNAL)
 
437
 
 
438
        IF (LAST_ICONF.NE.-1) THEN
 
439
          LAST_ICONF = ICONF
 
440
        ENDIF
 
441
      ENDIF
 
442
 
 
443
      IB(1)=1
 
444
      IB(2)=2
 
445
 
 
446
      IF(IMIRROR.EQ.2)THEN
 
447
C       Flip momenta (rotate around x axis)
 
448
        DO I=1,NEXTERNAL
 
449
          P1(2,I)=-P1(2,I)
 
450
          P1(3,I)=-P1(3,I)
 
451
        ENDDO
 
452
C       Flip beam identity
 
453
        IB(1)=2
 
454
        IB(2)=1
 
455
C       Flip x values (to get boost right)
 
456
        XDUM=XBK(1)
 
457
        XBK(1)=XBK(2)
 
458
        XBK(2)=XDUM
 
459
C       Flip CM_RAP (to get rapidity right)
 
460
        CM_RAP=-CM_RAP
 
461
      ENDIF
 
462
 
 
463
      DSIGPROC=0D0
 
464
 
 
465
      IF (PASSCUTS(P1)) THEN
 
466
        IF(IPROC.EQ.1) DSIGPROC=DSIG1(P1,WGT,IMODE)  ! u u~ > u u~
 
467
        IF(IPROC.EQ.2) DSIGPROC=DSIG2(P1,WGT,IMODE)  ! u u~ > d d~
 
468
      ENDIF
 
469
 
 
470
      IF (LAST_ICONF.NE.-1.AND.IMIRROR.EQ.2) THEN
 
471
C       Flip back local momenta P1 if cached
 
472
        DO I=1,NEXTERNAL
 
473
          P1(2,I)=-P1(2,I)
 
474
          P1(3,I)=-P1(3,I)
 
475
        ENDDO
 
476
      ENDIF
 
477
 
 
478
      RETURN
 
479
 
 
480
      END
 
481
 
 
482
 
 
483
C     -----------------------------------------
 
484
C     Subroutine to map three positive integers
 
485
C     I, J and K with upper bounds J_bound and
 
486
C     K_bound to a one_dimensional
 
487
C     index L
 
488
C     -----------------------------------------
 
489
 
 
490
      SUBROUTINE MAP_3_TO_1(I,J,K,J_BOUND,K_BOUND,L)
 
491
      IMPLICIT NONE
 
492
      INTEGER, INTENT(IN)  :: I,J,K,J_BOUND,K_BOUND
 
493
      INTEGER, INTENT(OUT) :: L
 
494
 
 
495
      L = I*(J_BOUND*(K_BOUND+1)+K_BOUND+1)+J*(K_BOUND+1)+K
 
496
 
 
497
      END SUBROUTINE MAP_3_TO_1
 
498
 
 
499
C     -----------------------------------------
 
500
C     Subroutine to map back the positive 
 
501
C     integer L to the three integers 
 
502
C     I, J and K with upper bounds
 
503
C     J_bound and K_bound.
 
504
C     -----------------------------------------
 
505
 
 
506
      SUBROUTINE MAP_1_TO_3(L,J_BOUND,K_BOUND,I,J,K)
 
507
      IMPLICIT NONE
 
508
      INTEGER, INTENT(OUT)  :: I,J,K
 
509
      INTEGER, INTENT(IN)   :: L, J_BOUND, K_BOUND
 
510
      INTEGER               :: L_RUN
 
511
 
 
512
      L_RUN = L
 
513
      I = L_RUN/(J_BOUND*(K_BOUND+1)+K_BOUND+1)
 
514
      L_RUN = L_RUN - I*((J_BOUND*(K_BOUND+1)+K_BOUND+1))
 
515
      J = L_RUN/(K_BOUND+1)
 
516
      L_RUN = L_RUN - J*(K_BOUND+1)
 
517
      K  = L_RUN
 
518
 
 
519
      END SUBROUTINE MAP_1_TO_3
 
520
 
 
521
 
 
522
C     
 
523
C     Functionality to handling grid
 
524
C     
 
525
 
 
526
      SUBROUTINE WRITE_GOOD_HEL(STREAM_ID)
 
527
      IMPLICIT NONE
 
528
      INTEGER STREAM_ID
 
529
      INTEGER                 NCOMB
 
530
      PARAMETER (             NCOMB=16)
 
531
      LOGICAL GOODHEL(NCOMB, 2)
 
532
      INTEGER NTRY(2)
 
533
      COMMON/BLOCK_GOODHEL/NTRY,GOODHEL
 
534
      WRITE(STREAM_ID,*) GOODHEL
 
535
      RETURN
 
536
      END
 
537
 
 
538
 
 
539
      SUBROUTINE READ_GOOD_HEL(STREAM_ID)
 
540
      IMPLICIT NONE
 
541
      INCLUDE 'genps.inc'
 
542
      INTEGER STREAM_ID
 
543
      INTEGER                 NCOMB
 
544
      PARAMETER (             NCOMB=16)
 
545
      LOGICAL GOODHEL(NCOMB, 2)
 
546
      INTEGER NTRY(2)
 
547
      COMMON/BLOCK_GOODHEL/NTRY,GOODHEL
 
548
      READ(STREAM_ID,*) GOODHEL
 
549
      NTRY(1) = MAXTRIES + 1
 
550
      NTRY(2) = MAXTRIES + 1
 
551
      RETURN
 
552
      END
 
553
 
 
554
      SUBROUTINE INIT_GOOD_HEL()
 
555
      IMPLICIT NONE
 
556
      INTEGER                 NCOMB
 
557
      PARAMETER (             NCOMB=16)
 
558
      LOGICAL GOODHEL(NCOMB, 2)
 
559
      INTEGER NTRY(2)
 
560
      INTEGER I
 
561
 
 
562
      DO I=1,NCOMB
 
563
        GOODHEL(I,1) = .FALSE.
 
564
        GOODHEL(I,2) = .FALSE.
 
565
      ENDDO
 
566
      NTRY(1) = 0
 
567
      NTRY(2) = 0
 
568
      END
 
569
 
 
570
      INTEGER FUNCTION GET_MAXSPROC()
 
571
      IMPLICIT NONE
 
572
      INCLUDE 'maxamps.inc'
 
573
 
 
574
      GET_MAXSPROC = MAXSPROC
 
575
      RETURN
 
576
      END
 
577
 
 
578
 
 
579
 
 
580
 
 
581
 
 
582