File indexing completed on 2024-04-06 12:13:52
0001
0002
0003
0004
0005
0006
0007
0008
0009
0010
0011
0012
0013
0014
0015
0016
0017
0018
0019
0020
0021
0022
0023
0024
0025
0026
0027 SUBROUTINE MGINIT(npara,param,value)
0028
0029
0030 IMPLICIT NONE
0031
0032 integer npara
0033 character*20 param(*),value(*)
0034
0035
0036
0037
0038
0039 INTEGER MSTP,MSTI,MRPY
0040 DOUBLE PRECISION PARP,PARI,RRPY
0041 COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200)
0042 COMMON/PYDATR/MRPY(6),RRPY(100)
0043
0044
0045 INTEGER MAXPUP
0046 PARAMETER (MAXPUP=100)
0047 INTEGER IDBMUP,PDFGUP,PDFSUP,IDWTUP,NPRUP,LPRUP
0048 DOUBLE PRECISION EBMUP,XSECUP,XERRUP,XMAXUP
0049 COMMON/HEPRUP/IDBMUP(2),EBMUP(2),PDFGUP(2),PDFSUP(2),
0050 & IDWTUP,NPRUP,XSECUP(MAXPUP),XERRUP(MAXPUP),XMAXUP(MAXPUP),
0051 & LPRUP(MAXPUP)
0052
0053
0054 INTEGER LNHIN,LNHOUT,MSCAL,IEVNT,ICKKW,ISCALE
0055 COMMON/UPPRIV/LNHIN,LNHOUT,MSCAL,IEVNT,ICKKW,ISCALE
0056 DATA LNHIN,LNHOUT,MSCAL,IEVNT,ICKKW,ISCALE/77,6,1,0,0,1/
0057 SAVE /UPPRIV/
0058
0059
0060 double precision etcjet,rclmax,etaclmax,qcut,clfact,showerkt
0061 integer maxjets,minjets,iexcfile,ktsche,mektsc,nexcres,excres(30)
0062 integer nqmatch,nexcproc,iexcproc(MAXPUP),iexcval(MAXPUP)
0063 logical nosingrad,jetprocs
0064 common/MEMAIN/etcjet,rclmax,etaclmax,qcut,showerkt,clfact,
0065 $ maxjets,minjets,iexcfile,ktsche,mektsc,nexcres,excres,
0066 $ nqmatch,nexcproc,iexcproc,iexcval,nosingrad,jetprocs
0067
0068
0069
0070
0071
0072
0073
0074
0075
0076
0077
0078
0079
0080
0081
0082
0083
0084
0085
0086
0087
0088
0089
0090
0091
0092
0093
0094
0095
0096
0097
0098
0099
0100
0101
0102
0103
0104
0105
0106
0107
0108
0109
0110
0111
0112
0113
0114
0115
0116
0117
0118
0119
0120
0121
0122
0123
0124
0125
0126
0127
0128
0129
0130
0131
0132
0133
0134
0135
0136
0137
0138
0139
0140
0141
0142
0143
0144
0145
0146
0147
0148
0149
0150
0151
0152
0153
0154
0155
0156
0157 integer i
0158 call initpydata
0159 write(*,*)"MGINIT: ickkw is ",ickkw
0160 write(*,*)"MGINIT: ktscheme is ",mektsc
0161 write(*,*)"MGINIT: QCut is ",qcut
0162 write(*,*)"MGINIT: Showerkt is ",showerkt
0163 do 10 i = 1, nexcres
0164 write(*,*) 'EXCRES(', i,')=',EXCRES(i)
0165 10 continue
0166
0167 IF(ABS(IDBMUP(1)).EQ.11.AND.ABS(IDBMUP(2)).EQ.11.AND.
0168 $ IDBMUP(1).EQ.-IDBMUP(2).AND.ktsche.EQ.0)THEN
0169 ktsche=1
0170 ELSE IF(ktsche.EQ.0) THEN
0171 ktsche=4313
0172 ENDIF
0173
0174
0175
0176
0177
0178 IF(ickkw.gt.0) CALL set_matching(npara,param,value)
0179
0180
0181 CALL PYGIVE('MSTP(98)=1')
0182
0183
0184
0185
0186
0187
0188
0189
0190
0191
0192
0193 RETURN
0194
0195
0196
0197
0198
0199 END
0200
0201
0202
0203
0204
0205 SUBROUTINE MGEVNT
0206
0207 IMPLICIT NONE
0208
0209
0210 INTEGER MSTP,MSTI
0211 DOUBLE PRECISION PARP,PARI
0212 COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200)
0213
0214
0215 INTEGER MAXPUP
0216 PARAMETER (MAXPUP=100)
0217 INTEGER IDBMUP,PDFGUP,PDFSUP,IDWTUP,NPRUP,LPRUP
0218 DOUBLE PRECISION EBMUP,XSECUP,XERRUP,XMAXUP
0219 COMMON/HEPRUP/IDBMUP(2),EBMUP(2),PDFGUP(2),PDFSUP(2),
0220 & IDWTUP,NPRUP,XSECUP(MAXPUP),XERRUP(MAXPUP),XMAXUP(MAXPUP),
0221 & LPRUP(MAXPUP)
0222
0223 INTEGER MAXNUP
0224 PARAMETER (MAXNUP=500)
0225 INTEGER NUP,IDPRUP,IDUP,ISTUP,MOTHUP,ICOLUP
0226 DOUBLE PRECISION XWGTUP,SCALUP,AQEDUP,AQCDUP,PUP,VTIMUP,SPINUP
0227 COMMON/HEPEUP/NUP,IDPRUP,XWGTUP,SCALUP,AQEDUP,AQCDUP,IDUP(MAXNUP),
0228 & ISTUP(MAXNUP),MOTHUP(2,MAXNUP),ICOLUP(2,MAXNUP),PUP(5,MAXNUP),
0229 & VTIMUP(MAXNUP),SPINUP(MAXNUP)
0230
0231 INTEGER PYCOMP,KCHG,MINT,NPART,NPARTD,IPART,MAXNUR
0232 DOUBLE PRECISION PMAS,PARF,VCKM,VINT,PTPART
0233
0234 COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4)
0235 COMMON/PYINT1/MINT(400),VINT(400)
0236 PARAMETER (MAXNUR=1000)
0237 COMMON/PYPART/NPART,NPARTD,IPART(MAXNUR),PTPART(MAXNUR)
0238
0239
0240 INTEGER LNHIN,LNHOUT,MSCAL,IEVNT,ICKKW,ISCALE
0241 COMMON/UPPRIV/LNHIN,LNHOUT,MSCAL,IEVNT,ICKKW,ISCALE
0242
0243
0244 double precision etcjet,rclmax,etaclmax,qcut,clfact,showerkt
0245 integer maxjets,minjets,iexcfile,ktsche,mektsc,nexcres,excres(30)
0246 integer nqmatch,nexcproc,iexcproc(MAXPUP),iexcval(MAXPUP)
0247 logical nosingrad,jetprocs
0248 common/MEMAIN/etcjet,rclmax,etaclmax,qcut,showerkt,clfact,
0249 $ maxjets,minjets,iexcfile,ktsche,mektsc,nexcres,excres,
0250 $ nqmatch,nexcproc,iexcproc,iexcval,nosingrad,jetprocs
0251
0252
0253 INTEGER NLJETS,IEXC,Ifile
0254 DOUBLE PRECISION PTCLUS
0255 COMMON/MEMAEV/PTCLUS(20),NLJETS,IEXC,Ifile
0256
0257
0258 INTEGER I,NEX,KP(MAXNUP),MOTH,NUPREAD,II,iexcl
0259 DOUBLE PRECISION PSUM,ESUM
0260
0261 INTEGER MAXLEN
0262 PARAMETER (MAXLEN=200)
0263
0264
0265 INTEGER iexclusive
0266 EXTERNAL iexclusive
0267
0268
0269
0270
0271
0272
0273
0274
0275
0276
0277
0278
0279
0280
0281
0282
0283
0284
0285
0286
0287 NUPREAD=NUP
0288
0289
0290 ESUM=0d0
0291 PSUM=0d0
0292 NEX=2
0293 NUP=1
0294
0295 DO 120 I=1,NUPREAD
0296
0297
0298
0299
0300
0301
0302
0303 IF(ISTUP(NUP).EQ.2) PUP(3,NUP)=0
0304 IF(ISTUP(NUP).EQ.1)THEN
0305 NEX=NEX+1
0306
0307 IF(PUP(5,NUP).EQ.0D0.AND.IABS(IDUP(NUP)).GT.3
0308 $ .AND.IDUP(NUP).LT.21) THEN
0309
0310 PUP(5,NUP)=PMAS(IABS(PYCOMP(IDUP(NUP))),1)
0311 PUP(3,NUP)=SIGN(SQRT(MAX(0d0,PUP(4,NUP)**2-PUP(5,NUP)**2-
0312 $ PUP(1,NUP)**2-PUP(2,NUP)**2)),PUP(3,NUP))
0313 ENDIF
0314 PSUM=PSUM+PUP(3,NUP)
0315
0316 MOTH=MOTHUP(1,NUP)
0317 DO WHILE (MOTH.GT.2)
0318 PUP(3,MOTH)=PUP(3,MOTH)+PUP(3,NUP)
0319 MOTH=MOTHUP(1,MOTH)
0320 ENDDO
0321 ENDIF
0322 NUP=NUP+1
0323 120 CONTINUE
0324 NUP=NUP-1
0325
0326
0327
0328
0329
0330 DO I=1,NUP
0331 IF(ISTUP(I).EQ.2)THEN
0332 PUP(5,I)=SQRT(PUP(4,I)**2-PUP(1,I)**2-PUP(2,I)**2-
0333 $ PUP(3,I)**2)
0334 ENDIF
0335 ENDDO
0336
0337
0338
0339
0340
0341
0342
0343
0344
0345
0346
0347
0348
0349
0350
0351
0352 ESUM=PUP(4,1)+PUP(4,2)
0353
0354
0355
0356
0357
0358
0359
0360
0361
0362
0363
0364
0365
0366
0367
0368
0369 IF(ickkw.eq.0.AND.MSCAL.GT.0) CALL PYMASC(SCALUP)
0370
0371
0372
0373
0374
0375
0376
0377
0378 IF(ickkw.gt.0) THEN
0379
0380
0381
0382
0383 NLJETS=0
0384 NPART=0
0385
0386 do i=3,NUP
0387
0388 if(ISTUP(i).ne.1) cycle
0389
0390 NPART=NPART+1
0391 IPART(NPART)=i
0392 if(iabs(IDUP(i)).gt.nqmatch.and.IDUP(i).ne.21) cycle
0393 if(MOTHUP(1,i).gt.2) cycle
0394
0395 IF((ABS(IDBMUP(1)).NE.11.OR.IDBMUP(1).NE.-IDBMUP(2)).AND.
0396 $ nosingrad) THEN
0397 DO II=3,NUP
0398 IF(II.NE.i.AND.ISTUP(II).EQ.1)THEN
0399 IF((IDUP(II).EQ.-IDUP(i).OR.
0400 $ IDUP(i).EQ.21.AND.IDUP(II).EQ.21).AND.
0401 $ ICOLUP(1,II).EQ.ICOLUP(2,i).AND.
0402 $ ICOLUP(2,II).EQ.ICOLUP(1,i))then
0403
0404 CALL PYLIST(7)
0405 GOTO 140
0406 endif
0407 ENDIF
0408 ENDDO
0409 ENDIF
0410 NLJETS=NLJETS+1
0411
0412 PTCLUS(NLJETS)=PTPART(NPART)
0413
0414
0415 140 continue
0416 enddo
0417 CALL ALPSOR(PTCLUS,nljets,KP,1)
0418
0419 if(jetprocs) IDPRUP=LPRUP(NLJETS-MINJETS+1)
0420
0421 IF(ickkw.eq.1) THEN
0422
0423 iexcl=iexclusive(IDPRUP)
0424 if((IEXCFILE.EQ.0.and.NLJETS.eq.MAXJETS.or.
0425 $ iexcl.eq.0).and.
0426 $ iexcl.ne.1)then
0427 IEXC=0
0428 else if(iexcl.eq.-1)then
0429 IEXC=-1
0430 else
0431 IEXC=1
0432 endif
0433 ENDIF
0434 ENDIF
0435
0436 RETURN
0437
0438
0439
0440
0441
0442
0443
0444
0445 END
0446
0447
0448
0449
0450
0451 SUBROUTINE MGVETO(IPVETO)
0452
0453 IMPLICIT NONE
0454
0455
0456
0457
0458
0459
0460 INTEGER MINT
0461 DOUBLE PRECISION VINT
0462 COMMON/PYINT1/MINT(400),VINT(400)
0463 INTEGER MSTP,MSTI
0464 DOUBLE PRECISION PARP,PARI
0465 COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200)
0466
0467
0468 INTEGER MAXNUP
0469 PARAMETER (MAXNUP=500)
0470 INTEGER NUP,IDPRUP,IDUP,ISTUP,MOTHUP,ICOLUP
0471 DOUBLE PRECISION XWGTUP,SCALUP,AQEDUP,AQCDUP,PUP,VTIMUP,SPINUP
0472 COMMON/HEPEUP/NUP,IDPRUP,XWGTUP,SCALUP,AQEDUP,AQCDUP,
0473 & IDUP(MAXNUP),ISTUP(MAXNUP),MOTHUP(2,MAXNUP),
0474 & ICOLUP(2,MAXNUP),PUP(5,MAXNUP),VTIMUP(MAXNUP),
0475 & SPINUP(MAXNUP)
0476
0477 INTEGER MAXPUP
0478 PARAMETER (MAXPUP=100)
0479 INTEGER IDBMUP,PDFGUP,PDFSUP,IDWTUP,NPRUP,LPRUP
0480 DOUBLE PRECISION EBMUP,XSECUP,XERRUP,XMAXUP
0481 COMMON/HEPRUP/IDBMUP(2),EBMUP(2),PDFGUP(2),PDFSUP(2),
0482 & IDWTUP,NPRUP,XSECUP(MAXPUP),XERRUP(MAXPUP),XMAXUP(MAXPUP),
0483 & LPRUP(MAXPUP)
0484
0485 INTEGER NMXHEP,NEVHEP,NHEP,ISTHEP,IDHEP,JMOHEP,JDAHEP
0486 PARAMETER (NMXHEP=4000)
0487 COMMON/HEPEVT/NEVHEP,NHEP,ISTHEP(NMXHEP),IDHEP(NMXHEP),
0488 &JMOHEP(2,NMXHEP),JDAHEP(2,NMXHEP),PHEP(5,NMXHEP),VHEP(4,NMXHEP)
0489 DOUBLE PRECISION PHEP,VHEP
0490 SAVE /HEPEVT/
0491 INTEGER IPVETO
0492
0493 INTEGER MNCY,MNCPHI,NCY,NCPHI,NJMAX,JETNO,NCJET
0494 DOUBLE PRECISION YCMIN,YCMAX,DELY,DELPHI,ET,STHCAL,CTHCAL,CPHCAL,
0495 & SPHCAL,PCJET,ETJET
0496 PARAMETER (MNCY=200)
0497 PARAMETER (MNCPHI=200)
0498 COMMON/CALORM/DELY,DELPHI,ET(MNCY,MNCPHI),
0499 $CTHCAL(MNCY),STHCAL(MNCY),CPHCAL(MNCPHI),SPHCAL(MNCPHI),
0500 $YCMIN,YCMAX,NCY,NCPHI
0501 PARAMETER (NJMAX=500)
0502 COMMON/GETCOMM/PCJET(4,NJMAX),ETJET(NJMAX),JETNO(MNCY,MNCPHI),
0503 $NCJET
0504 DOUBLE PRECISION PI
0505 PARAMETER (PI=3.141593D0)
0506
0507 DOUBLE PRECISION PSERAP
0508 INTEGER K(NJMAX),KP(NJMAX),kpj(njmax)
0509
0510
0511 INTEGER NMAX,NN,NSUB,JET,NJETM,IHARD,IP1,IP2
0512 DOUBLE PRECISION PP,PJET
0513 DOUBLE PRECISION ECUT,Y,YCUT
0514 PARAMETER (NMAX=512)
0515 DIMENSION JET(NMAX),Y(NMAX),PP(4,NMAX),PJET(4,NMAX)
0516 INTEGER NNM
0517 DOUBLE PRECISION YM(NMAX),PPM(4,NMAX)
0518
0519
0520 INTEGER NMAXKT,NUM,HIST
0521 PARAMETER (NMAXKT=512)
0522 DOUBLE PRECISION PPP,KT,ETOT,RSQ,KTP,KTS,KTLAST
0523 COMMON /KTCOMM/ETOT,RSQ,PPP(9,NMAXKT),KTP(NMAXKT,NMAXKT),
0524 $ KTS(NMAXKT),KT(NMAXKT),KTLAST(NMAXKT),HIST(NMAXKT),NUM
0525
0526
0527 INTEGER LNHIN,LNHOUT,MSCAL,IEVNT,ICKKW,ISCALE
0528 COMMON/UPPRIV/LNHIN,LNHOUT,MSCAL,IEVNT,ICKKW,ISCALE
0529
0530
0531
0532
0533
0534
0535
0536
0537
0538
0539 double precision etcjet,rclmax,etaclmax,qcut,clfact,showerkt
0540 integer maxjets,minjets,iexcfile,ktsche,mektsc,nexcres,excres(30)
0541 integer nqmatch,nexcproc,iexcproc(MAXPUP),iexcval(MAXPUP)
0542 logical nosingrad,jetprocs
0543 common/MEMAIN/etcjet,rclmax,etaclmax,qcut,showerkt,clfact,
0544 $ maxjets,minjets,iexcfile,ktsche,mektsc,nexcres,excres,
0545 $ nqmatch,nexcproc,iexcproc,iexcval,nosingrad,jetprocs
0546
0547
0548 INTEGER NLJETS,IEXC,Ifile
0549 DOUBLE PRECISION PTCLUS
0550 COMMON/MEMAEV/PTCLUS(20),NLJETS,IEXC,Ifile
0551
0552 INTEGER nvarev,nvar2
0553 PARAMETER (nvarev=57,nvar2=6)
0554
0555 REAL*4 varev(nvarev)
0556 COMMON/HISTDAT/varev
0557
0558
0559 INTEGER NPART,NPARTD,IPART,MAXNUR
0560 DOUBLE PRECISION PTPART
0561 PARAMETER (MAXNUR=1000)
0562 COMMON/PYPART/NPART,NPARTD,IPART(MAXNUR),PTPART(MAXNUR)
0563
0564 INTEGER flag
0565 COMMON/OUTTREE/flag
0566
0567 CHARACTER*8 htit(nvarev),htit2(nvar2)
0568 DATA htit/'Npart','Qjet1','Qjet2','Qjet3','Qjet4',
0569 $ 'Ptcjet1','Ptcjet2','Ptcjet3','Ptcjet4',
0570 $ 'Etacjet1','Etacjet2','Etacjet3','Etacjet4',
0571 $ 'Phicjet1','Phicjet2','Phicjet3','Phicjet4',
0572 $ 'Ptjet1','Ptjet2','Ptjet3','Ptjet4',
0573 $ 'Etajet1','Etajet2','Etajet3','Etajet4',
0574 $ 'Phijet1','Phijet2','Phijet3','Phijet4',
0575 $ 'Idres1','Ptres1','Etares1','Phires1',
0576 $ 'Idres2','Ptres2','Etares2','Phires2',
0577 $ 'Ptlep1','Etmiss','Htjets',
0578 $ 'Ptb','Etab','Ptbbar','Etabbar','Ptbj','Etabj',
0579 $ 'Qpar1','Qpar2','Qpar3','Qpar4',
0580 $ 'Ptpar1','Ptpar2','Ptpar3','Ptpar4',
0581 $ 'Ncjets','Njets','Nfile'/
0582 DATA htit2/'Npart','Qjet1','Qjet2','Qjet3','Qjet4','Nfile'/
0583
0584
0585
0586
0587
0588
0589 double precision tiny
0590 parameter (tiny=1d-3)
0591 integer idbg
0592 data idbg/0/
0593
0594 integer i,j,ihep,nmatch,jrmin,KPT(MAXNUP),nres,ii
0595 double precision etajet,phijet,delr,dphi,delrmin,ptjet
0596 double precision p(4,10),pt(10),eta(10),phi(10)
0597 INTEGER IMO
0598 logical norad(20)
0599 REAL*4 var2(nvar2)
0600
0601
0602
0603
0604
0605
0606
0607
0608
0609
0610 IPVETO=0
0611 YCUT=-1.0
0612
0613
0614 IF(ICKKW.LE.0.OR.IEXC.eq.-1) RETURN
0615
0616 IF(NLJETS.LT.MINJETS.OR.NLJETS.GT.MAXJETS)THEN
0617 if(idbg.eq.1)
0618 $ WRITE(LNHOUT,*) 'Failed due to NLJETS ',NLJETS,' < ',MINJETS,
0619 $ ' or > ',MAXJETS
0620 GOTO 999
0621 ENDIF
0622
0623
0624 NRES=0
0625 DO I=1,NUP
0626
0627 IF(ISTUP(I).EQ.2)THEN
0628
0629 DO J=1,nexcres
0630
0631 IF(IDUP(I).EQ.EXCRES(J)) NRES=NRES+1
0632 ENDDO
0633 ENDIF
0634 ENDDO
0635 IF(NRES.GT.0)THEN
0636
0637
0638
0639 GOTO 999
0640 ENDIF
0641
0642
0643 jrmin = 0
0644
0645
0646
0647
0648
0649
0650
0651
0652
0653
0654
0655
0656
0657
0658
0659
0660
0661 if(idbg.eq.1) then
0662 write(LNHOUT,*) ' '
0663 write(LNHOUT,*) 'new event '
0664
0665 CALL PYLIST(7)
0666 CALL PYLIST(5)
0667 write(LNHOUT,*) 'PARTONS'
0668 endif
0669 i=0
0670 do ihep=3,nup
0671 NORAD(ihep)=.false.
0672 if((ABS(IDBMUP(1)).NE.11.OR.IDBMUP(1).NE.-IDBMUP(2)).AND.
0673 $ MOTHUP(1,ihep).gt.2) goto 100
0674 if(ISTUP(ihep).ne.1.or.
0675 $ (iabs(IDUP(ihep)).gt.nqmatch.and.IDUP(ihep).ne.21)) cycle
0676
0677
0678 IF((ABS(IDBMUP(1)).NE.11.OR.IDBMUP(1).NE.-IDBMUP(2)).AND.
0679 $ nosingrad)THEN
0680 DO II=3,NUP
0681 IF(II.NE.ihep.AND.ISTUP(II).EQ.1)THEN
0682 IF((IDUP(II).EQ.-IDUP(ihep).OR.
0683 $ IDUP(ihep).EQ.21.AND.IDUP(II).EQ.21).AND.
0684 $ ICOLUP(1,II).EQ.ICOLUP(2,ihep).AND.
0685 $ ICOLUP(2,II).EQ.ICOLUP(1,ihep))
0686 $ GOTO 100
0687 ENDIF
0688 ENDDO
0689 ENDIF
0690 i=i+1
0691 do j=1,4
0692 p(j,i)=pup(j,ihep)
0693 enddo
0694 pt(i)=sqrt(p(1,i)**2+p(2,i)**2)
0695 if(i.LE.4) varev(50+i)=pt(i)
0696 eta(i)=-log(tan(0.5d0*atan2(pt(i)+tiny,p(3,i))))
0697 phi(i)=atan2(p(2,i),p(1,i))
0698 if(idbg.eq.1) then
0699 write(LNHOUT,*) pt(i),eta(i),phi(i)
0700 endif
0701 cycle
0702 100 norad(ihep)=.true.
0703 enddo
0704 if(i.ne.NLJETS)then
0705 print *,'Error in UPVETO: Wrong number of jets found ',i,NLJETS
0706 CALL PYLIST(7)
0707 CALL PYLIST(2)
0708 stop
0709 endif
0710
0711 DO I=1,3
0712 DO J=4,I+1,-1
0713 IF(varev(50+J).GT.varev(50+I))THEN
0714 PTJET=varev(50+J)
0715 varev(50+J)=varev(50+I)
0716 varev(50+I)=PTJET
0717 ENDIF
0718 ENDDO
0719 ENDDO
0720
0721 DO ihep=1,NHEP
0722
0723 IF(ISTHEP(ihep).EQ.1.AND.iabs(IDHEP(ihep)).GT.5.AND.
0724 $ IDHEP(ihep).NE.21) THEN
0725 ISTHEP(ihep)=2
0726 ELSEIF(ISTHEP(ihep).EQ.1.AND.JMOHEP(1,ihep).GT.0) then
0727 IMO=JMOHEP(1,ihep)
0728 DO WHILE(IMO.GT.0)
0729
0730 IF(IMO.le.NUP-2.and.norad(IMO+2)) GOTO 105
0731 IMO=JMOHEP(1,IMO)
0732 ENDDO
0733 cycle
0734 105 ISTHEP(ihep)=2
0735 ENDIF
0736 ENDDO
0737
0738
0739
0740
0741
0742
0743
0744
0745 DO ihep=1,NHEP
0746
0747 if ( jmohep(1,ihep) .gt. 0 ) then
0748
0749
0750
0751 IF(ISTHEP(JMOHEP(1,ihep)).EQ.2
0752 $ .AND.iabs(IDHEP(JMOHEP(1,ihep))).GT.nqmatch.AND.
0753 $ iabs(IDHEP(JMOHEP(1,ihep))).LT.6) THEN
0754
0755
0756
0757
0758 ISTHEP(ihep)=2
0759 ENDIF
0760 IF(ISTHEP(ihep).eq.1.AND.iabs(IDHEP(ihep)).GT.
0761 $ nqmatch.AND.iabs(IDHEP(ihep)).LT.6.AND.
0762 $ ISTHEP(JMOHEP(1,ihep)).EQ.2.AND.iabs(IDHEP(JMOHEP(1,ihep)))
0763 $ .EQ.21) goto 999
0764
0765 endif
0766
0767 ENDDO
0768
0769
0770
0771
0772
0773
0774
0775
0776
0777
0778
0779 DO I=1,4
0780 var2(1+I)=-1
0781 varev(46+I)=-1
0782 varev(50+I)=-1
0783 ENDDO
0784
0785 I=0
0786 if(idbg.eq.1) then
0787 do i=1,nhep
0788 write(LNHOUT,1000)i,isthep(i),idhep(i),jmohep(1,i),jmohep(2,i)
0789 $ ,phep(1,i),phep(2,i),phep(3,i)
0790 enddo
0791 1000 format(5(i4,1x),3(f12.5,1x))
0792 endif
0793
0794 IF(ICKKW.EQ.2) GOTO 150
0795 IF(MSTP(61).eq.0..and.MSTP(71).eq.0)then
0796
0797 ELSE IF(qcut.le.0d0)then
0798
0799
0800 IF(clfact.EQ.0d0) clfact=1.5d0
0801
0802
0803
0804
0805
0806 IF(NLJETS.GT.0) CALL ALPSOR(pt,nljets,KP,2)
0807
0808
0809 YCMAX=ETACLMAX+RCLMAX
0810 YCMIN=-YCMAX
0811 CALL CALINIM
0812 CALL CALDELM(1,1)
0813 CALL GETJETM(RCLMAX,ETCJET,ETACLMAX)
0814
0815 IF(NCJET.GT.0) CALL ALPSOR(ETJET,NCJET,K,2)
0816 if(idbg.eq.1) then
0817 write(LNHOUT,*) 'JETS'
0818 do i=1,ncjet
0819 j=k(ncjet+1-i)
0820 ETAJET=PSERAP(PCJET(1,j))
0821 PHIJET=ATAN2(PCJET(2,j),PCJET(1,j))
0822 write(LNHOUT,*) etjet(j),etajet,phijet
0823 enddo
0824 endif
0825 IF(NCJET.LT.NLJETS) THEN
0826 if(idbg.eq.1)
0827 $ WRITE(LNHOUT,*) 'Failed due to NCJET ',NCJET,' < ',NLJETS
0828 GOTO 999
0829 endif
0830
0831 NMATCH=0
0832 DO I=1,NCJET
0833 KPJ(I)=0
0834 ENDDO
0835 DO I=1,NLJETS
0836 DELRMIN=1D5
0837 DO 110 J=1,NCJET
0838 IF(KPJ(J).NE.0) GO TO 110
0839 ETAJET=PSERAP(PCJET(1,J))
0840 PHIJET=ATAN2(PCJET(2,J),PCJET(1,J))
0841 DPHI=ABS(PHI(KP(NLJETS-I+1))-PHIJET)
0842 IF(DPHI.GT.PI) DPHI=2.*PI-DPHI
0843 DELR=SQRT((ETA(KP(NLJETS-I+1))-ETAJET)**2+(DPHI)**2)
0844 IF(DELR.LT.DELRMIN) THEN
0845 DELRMIN=DELR
0846 JRMIN=J
0847 ENDIF
0848 110 CONTINUE
0849 IF(DELRMIN.LT.clfact*RCLMAX) THEN
0850 NMATCH=NMATCH+1
0851 KPJ(JRMIN)=I
0852 ENDIF
0853
0854
0855 ENDDO
0856 IF(NMATCH.LT.NLJETS) THEN
0857 if(idbg.eq.1)
0858 $ WRITE(LNHOUT,*) 'Failed due to NMATCH ',NMATCH,' < ',NLJETS
0859 GOTO 999
0860 endif
0861
0862 IF(NCJET.GT.NLJETS.AND.IEXC.EQ.1) THEN
0863 if(idbg.eq.1)
0864 $ WRITE(LNHOUT,*) 'Failed due to NCJET ',NCJET,' > ',NLJETS
0865 GOTO 999
0866 endif
0867
0868 IF(IEXC.NE.1) THEN
0869 J=NCJET
0870 DO I=1,NLJETS
0871 IF(KPJ(K(J)).EQ.0) GOTO 999
0872 J=J-1
0873 ENDDO
0874 ENDIF
0875
0876 else ! qcut.gt.0
0877 if(showerkt.eq.1.0) then
0878
0879
0880
0881
0882 IF(NLJETS.EQ.0)THEN
0883 VINT(358)=0
0884 ENDIF
0885
0886 IF(idbg.eq.1) THEN
0887
0888
0889
0890
0891
0892
0893
0894 ENDIF
0895 YCUT=qcut**2
0896
0897 IF(NLJETS.GT.0.AND.PTCLUS(1)**2.LT.YCUT) THEN
0898 if(idbg.eq.1)
0899 $ WRITE(LNHOUT,*) 'Failed due to KT ',
0900 $ PTCLUS(1),' < ',SQRT(YCUT)
0901 GOTO 999
0902 ENDIF
0903
0904
0905
0906 IF(IEXC.EQ.1.AND.
0907 $ ((mektsc.eq.1.and.MAX(VINT(357),VINT(358)).GT.SQRT(YCUT))
0908 $ .OR.
0909 $ (mektsc.eq.2.and.MAX(VINT(360),VINT(358)).GT.SQRT(YCUT))))
0910 $ THEN
0911
0912 if(idbg.eq.1)
0913 $ WRITE(LNHOUT,*)
0914 $ 'Failed due to ',max(VINT(357),VINT(358)),' > ',SQRT(YCUT)
0915 GOTO 999
0916 ENDIF
0917
0918
0919
0920
0921 IF(IEXC.EQ.0.AND.NLJETS.GT.0.AND.
0922 $ ((mektsc.eq.1.and.MAX(VINT(357),VINT(358)).GT.PTCLUS(1))
0923 $ .OR.
0924 $ (mektsc.eq.2.and.MAX(VINT(360),VINT(358)).GT.PTCLUS(1))))
0925 $ THEN
0926
0927 if(idbg.eq.1)
0928 $ WRITE(LNHOUT,*)
0929 $ 'Failed due to ',max(VINT(357),VINT(358)),' > ',PTCLUS(1)
0930 GOTO 999
0931 ENDIF
0932
0933 else ! not shower kt method
0934
0935 IF(clfact.EQ.0d0) clfact=1d0
0936
0937
0938 NN=0
0939 DO IHEP=1,NHEP
0940 IF (ISTHEP(IHEP).EQ.1
0941 $ .AND.(ABS(IDHEP(IHEP)).LE.5.OR.IDHEP(IHEP).EQ.21)) THEN
0942 PTJET=sqrt(PHEP(1,IHEP)**2+PHEP(2,IHEP)**2)
0943 ETAJET=ABS(LOG(MIN((SQRT(PTJET**2+PHEP(3,IHEP)**2)+
0944 $ ABS(PHEP(3,IHEP)))/PTJET,1d5)))
0945 IF(ETAJET.GT.etaclmax) cycle
0946 NN=NN+1
0947 IF (NN.GT.NMAX) then
0948 CALL PYLIST(2)
0949 PRINT *, 'Too many particles: ', NN
0950 NN=NN-1
0951 GOTO 120
0952 endif
0953 DO I=1,4
0954 PP(I,NN)=PHEP(I,IHEP)
0955 ENDDO
0956 ELSE if(idbg.eq.1)THEN
0957 PRINT *,'Skipping particle ',IHEP,ISTHEP(IHEP),IDHEP(IHEP)
0958 ENDIF
0959 ENDDO
0960
0961
0962
0963
0964 120 ECUT=1
0965 IF (NN.GT.1) then
0966 CALL KTCLUS(KTSCHE,PP,NN,ECUT,Y,*999)
0967 if(idbg.eq.1)
0968 $ WRITE(LNHOUT,*) 'Clustering values:',
0969 $ (SQRT(Y(i)),i=1,MIN(NN,3))
0970
0971
0972
0973 var2(1)=NLJETS
0974 var2(6)= Ifile
0975
0976 if(NLJETS.GT.MINJETS)then
0977 YCUT=Y(NLJETS)
0978 CALL KTRECO(MOD(KTSCHE,10),PP,NN,ECUT,YCUT,YCUT,PJET,JET,
0979 $ NCJET,NSUB,*999)
0980
0981
0982 DO I=1,NLJETS
0983 DO J=1,4
0984 PPM(J,I)=PJET(J,I)
0985 ENDDO
0986 ENDDO
0987
0988 NJETM=NLJETS
0989 DO IHARD=1,NLJETS
0990 NNM=NJETM+1
0991 DO J=1,4
0992 PPM(J,NNM)=p(J,IHARD)
0993 ENDDO
0994 CALL KTCLUS(KTSCHE,PPM,NNM,ECUT,YM,*999)
0995 IF(YM(NNM).GT.YCUT) THEN
0996
0997 GOTO 130
0998 ENDIF
0999
1000
1001
1002 IP1=HIST(NNM)/NMAXKT
1003 IP2=MOD(HIST(NNM),NMAXKT)
1004 IF(IP2.NE.NNM.OR.IP1.LE.0)THEN
1005 GOTO 130
1006 ENDIF
1007 DO I=IP1,NJETM-1
1008 DO J=1,4
1009 PPM(J,I)=PPM(J,I+1)
1010 ENDDO
1011 ENDDO
1012 NJETM=NJETM-1
1013 ENDDO ! IHARD=1,NLJETS
1014 endif ! NLJETS.GT.MINJETS
1015
1016 DO I=1,MIN(NN,4)
1017 var2(1+I)=SQRT(Y(I))
1018 ENDDO
1019 WRITE(15,4001) (var2(I),I=1,nvar2)
1020
1021 130 CONTINUE
1022
1023
1024 CALL KTCLUS(KTSCHE,PP,NN,ECUT,Y,*999)
1025
1026 YCUT=qcut**2
1027 NCJET=0
1028
1029
1030 CALL KTRECO(MOD(KTSCHE,10),PP,NN,ECUT,YCUT,YCUT,PJET,JET,
1031 $ NCJET,NSUB,*999)
1032
1033 ELSE IF (NN.EQ.1) THEN
1034
1035 Y(1)=PP(1,1)**2+PP(2,1)**2
1036 IF(Y(1).GT.YCUT)THEN
1037 NCJET=1
1038 DO I=1,4
1039 PJET(I,1)=PP(I,1)
1040 ENDDO
1041 ENDIF
1042 endif
1043
1044 if(idbg.eq.1) then
1045 write(LNHOUT,*) 'JETS'
1046 do i=1,ncjet
1047 PTJET =SQRT(PJET(1,i)**2+PJET(2,i)**2)
1048 ETAJET=PSERAP(PJET(1,i))
1049 PHIJET=ATAN2(PJET(2,i),PJET(1,i))
1050 write(LNHOUT,*) ptjet,etajet,phijet
1051 enddo
1052 endif
1053
1054 IF(NCJET.LT.NLJETS) THEN
1055 if(idbg.eq.1)
1056 $ WRITE(LNHOUT,*) 'Failed due to NCJET ',NCJET,' < ',NLJETS
1057 GOTO 999
1058 endif
1059
1060
1061
1062 IF(IEXC.EQ.0)THEN
1063 IF(NLJETS.GT.0)THEN
1064 YCUT=Y(NLJETS)
1065 CALL KTRECO(MOD(KTSCHE,10),PP,NN,ECUT,YCUT,YCUT,PJET,JET,
1066 $ NCJET,NSUB,*999)
1067 IF(clfact.GE.0d0) THEN
1068 CALL ALPSOR(PTCLUS,nljets,KPT,2)
1069 YCUT=MAX(qcut,PTCLUS(KPT(1)))**2
1070 ENDIF
1071 ENDIF
1072 ELSE IF(NCJET.GT.NLJETS) THEN
1073 if(idbg.eq.1)
1074 $ WRITE(LNHOUT,*) 'Failed due to NCJET ',NCJET,' > ',NLJETS
1075 GOTO 999
1076 ENDIF
1077
1078 DO I=1,NLJETS
1079 DO J=1,4
1080 PPM(J,I)=PJET(J,I)
1081 ENDDO
1082 ENDDO
1083
1084 NJETM=NLJETS
1085 IF(clfact.NE.0) YCUT=clfact**2*YCUT
1086
1087
1088
1089 DO 140 IHARD=1,NLJETS
1090 NN=NJETM+1
1091 DO J=1,4
1092 PPM(J,NN)=p(J,IHARD)
1093 ENDDO
1094 CALL KTCLUS(KTSCHE,PPM,NN,ECUT,Y,*999)
1095
1096 IF(Y(NN).GT.YCUT) THEN
1097
1098 if(idbg.eq.1)
1099 $ WRITE(LNHOUT,*) 'Failed due to parton ',IHARD,
1100 $ ' not clustered: ',Y(NN)
1101 GOTO 999
1102 ENDIF
1103
1104
1105
1106 IP1=HIST(NN)/NMAXKT
1107 IP2=MOD(HIST(NN),NMAXKT)
1108 IF(IP2.NE.NN.OR.IP1.LE.0)THEN
1109 if(idbg.eq.1)
1110 $ WRITE(LNHOUT,*) 'Failed due to parton ',IHARD,
1111 $ ' not clustered: ',IP1,IP2,NN,HIST(NN)
1112 GOTO 999
1113 ENDIF
1114
1115 DO I=IP1,NJETM-1
1116 DO J=1,4
1117 PPM(J,I)=PPM(J,I+1)
1118 ENDDO
1119 ENDDO
1120 NJETM=NJETM-1
1121 140 CONTINUE
1122
1123 endif ! pt-ordered showers
1124 endif ! qcut.gt.0
1125
1126 150 NN=0
1127 DO IHEP=1,NHEP
1128 IF (ISTHEP(IHEP).EQ.1
1129 $ .AND.(ABS(IDHEP(IHEP)).LE.5.OR.IDHEP(IHEP).EQ.21)) THEN
1130 PTJET=sqrt(PHEP(1,IHEP)**2+PHEP(2,IHEP)**2)
1131 ETAJET=ABS(LOG(MIN((SQRT(PTJET**2+PHEP(3,IHEP)**2)+
1132 $ ABS(PHEP(3,IHEP)))/PTJET,1d5)))
1133 IF(ETAJET.GT.etaclmax) cycle
1134 NN=NN+1
1135 IF (NN.GT.NMAX) then
1136 CALL PYLIST(2)
1137 PRINT *, 'Too many particles: ', NN
1138 NN=NN-1
1139 GOTO 160
1140 ENDIF
1141 DO I=1,4
1142 PP(I,NN)=PHEP(I,IHEP)
1143 ENDDO
1144 ELSE if(idbg.eq.1)THEN
1145 PRINT *,'Skipping particle ',IHEP,ISTHEP(IHEP),IDHEP(IHEP)
1146 ENDIF
1147 ENDDO
1148
1149 160 ECUT=1
1150 IF (NN.GT.1) THEN
1151 CALL KTCLUS(KTSCHE,PP,NN,ECUT,Y,*999)
1152 ELSE IF(NN.EQ.1) THEN
1153 Y(1)=PP(1,NN)**2+PP(2,NN)**2
1154 ENDIF
1155
1156 DO I=1,MIN(NN,4)
1157 varev(46+I)=SQRT(Y(I))
1158 ENDDO
1159
1160
1161 OPEN (10, FILE='events.tree')
1162
1163
1164
1165
1166 if (flag.eq.1) then
1167 varev(1)=NLJETS
1168 WRITE(10,4001) varev(1),(varev(I),I=47,50)
1169
1170 endif
1171
1172 RETURN
1173 4001 FORMAT(50E15.6)
1174
1175
1176
1177
1178 999 IPVETO=1
1179
1180 END
1181
1182
1183
1184
1185
1186 SUBROUTINE PYMASC(scale)
1187 IMPLICIT NONE
1188
1189
1190 REAL*8 scale
1191
1192
1193 REAL*8 SMDOT5
1194
1195
1196 INTEGER MAXPUP
1197 PARAMETER (MAXPUP=100)
1198 INTEGER IDBMUP,PDFGUP,PDFSUP,IDWTUP,NPRUP,LPRUP
1199 DOUBLE PRECISION EBMUP,XSECUP,XERRUP,XMAXUP
1200 COMMON/HEPRUP/IDBMUP(2),EBMUP(2),PDFGUP(2),PDFSUP(2),
1201 & IDWTUP,NPRUP,XSECUP(MAXPUP),XERRUP(MAXPUP),XMAXUP(MAXPUP),
1202 & LPRUP(MAXPUP)
1203
1204 INTEGER MAXNUP
1205 PARAMETER (MAXNUP=500)
1206 INTEGER NUP,IDPRUP,IDUP,ISTUP,MOTHUP,ICOLUP
1207 DOUBLE PRECISION XWGTUP,SCALUP,AQEDUP,AQCDUP,PUP,VTIMUP,SPINUP
1208 COMMON/HEPEUP/NUP,IDPRUP,XWGTUP,SCALUP,AQEDUP,AQCDUP,IDUP(MAXNUP),
1209 & ISTUP(MAXNUP),MOTHUP(2,MAXNUP),ICOLUP(2,MAXNUP),PUP(5,MAXNUP),
1210 & VTIMUP(MAXNUP),SPINUP(MAXNUP)
1211
1212
1213 INTEGER LNHIN,LNHOUT,MSCAL,IEVNT,ICKKW,ISCALE
1214 COMMON/UPPRIV/LNHIN,LNHOUT,MSCAL,IEVNT,ICKKW,ISCALE
1215
1216
1217 INTEGER ICC1,ICC2,IJ,IDC1,IDC2,IC,IC1,IC2
1218 REAL*8 QMIN,QTMP
1219
1220
1221 scale=SCALUP
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234 QMIN=SMDOT5(PUP(1,1),PUP(1,2))
1235 ICC1=1
1236 ICC2=2
1237
1238
1239
1240
1241
1242
1243
1244 DO 101 IJ=1,NUP
1245 IF(MOTHUP(2,IJ).GT.2) GOTO 101
1246 IDC1=ICOLUP(1,IJ)
1247 IDC2=ICOLUP(2,IJ)
1248 IF(IDC1.EQ.0) IDC1=-1
1249 IF(IDC2.EQ.0) IDC2=-2
1250
1251 DO 201 IC=IJ+1,NUP
1252 IF(MOTHUP(2,IC).GT.2) GOTO 201
1253 IC1=ICOLUP(1,IC)
1254 IC2=ICOLUP(2,IC)
1255 IF(ISTUP(IC)*ISTUP(IJ).GE.1) THEN
1256 IF(IDC1.EQ.IC2.OR.IDC2.EQ.IC1) THEN
1257 QTMP=SMDOT5(PUP(1,IJ),PUP(1,IC))
1258 IF(QTMP.LT.QMIN) THEN
1259 QMIN=QTMP
1260 ICC1=IJ
1261 ICC2=IC
1262 ENDIF
1263 ENDIF
1264 ELSEIF(ISTUP(IC)*ISTUP(IJ).LE.-1) THEN
1265 IF(IDC1.EQ.IC1.OR.IDC2.EQ.IC2) THEN
1266 QTMP=SMDOT5(PUP(1,IJ),PUP(1,IC))
1267 IF(QTMP.LT.QMIN) THEN
1268 QMIN=QTMP
1269 ICC1=IJ
1270 ICC2=IC
1271 ENDIF
1272 ENDIF
1273 ENDIF
1274 201 CONTINUE
1275 101 CONTINUE
1276
1277 scale=QMIN
1278
1279 RETURN
1280 END
1281
1282
1283
1284
1285 FUNCTION SMDOT5(V1,V2)
1286 IMPLICIT NONE
1287 REAL*8 SMDOT5,TEMP
1288 REAL*8 V1(5),V2(5)
1289 INTEGER I
1290
1291 SMDOT5=0D0
1292 TEMP=V1(4)*V2(4)
1293 DO I=1,3
1294 TEMP=TEMP-V1(I)*V2(I)
1295 ENDDO
1296
1297 SMDOT5=SQRT(ABS(TEMP))
1298
1299 RETURN
1300 END
1301
1302
1303
1304
1305
1306
1307 SUBROUTINE set_matching(npara,param,value)
1308 implicit none
1309
1310
1311
1312 integer npara
1313 character*20 param(*),value(*)
1314
1315
1316 INTEGER MSTP,MSTI
1317 DOUBLE PRECISION PARP,PARI
1318 COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200)
1319
1320
1321 INTEGER MAXPUP
1322 PARAMETER (MAXPUP=100)
1323 INTEGER IDBMUP,PDFGUP,PDFSUP,IDWTUP,NPRUP,LPRUP
1324 DOUBLE PRECISION EBMUP,XSECUP,XERRUP,XMAXUP
1325 COMMON/HEPRUP/IDBMUP(2),EBMUP(2),PDFGUP(2),PDFSUP(2),
1326 & IDWTUP,NPRUP,XSECUP(MAXPUP),XERRUP(MAXPUP),XMAXUP(MAXPUP),
1327 & LPRUP(MAXPUP)
1328
1329
1330 INTEGER MAXNUP
1331 PARAMETER (MAXNUP=500)
1332 INTEGER NUP,IDPRUP,IDUP,ISTUP,MOTHUP,ICOLUP
1333 DOUBLE PRECISION XWGTUP,SCALUP,AQEDUP,AQCDUP,PUP,VTIMUP,SPINUP
1334 COMMON/HEPEUP/NUP,IDPRUP,XWGTUP,SCALUP,AQEDUP,AQCDUP,IDUP(MAXNUP),
1335 & ISTUP(MAXNUP),MOTHUP(2,MAXNUP),ICOLUP(2,MAXNUP),PUP(5,MAXNUP),
1336 & VTIMUP(MAXNUP),SPINUP(MAXNUP)
1337
1338
1339 INTEGER LNHIN,LNHOUT,MSCAL,IEVNT,ICKKW,ISCALE
1340 COMMON/UPPRIV/LNHIN,LNHOUT,MSCAL,IEVNT,ICKKW,ISCALE
1341
1342
1343 double precision etcjet,rclmax,etaclmax,qcut,clfact,showerkt
1344 integer maxjets,minjets,iexcfile,ktsche,mektsc,nexcres,excres(30)
1345 integer nqmatch,nexcproc,iexcproc(MAXPUP),iexcval(MAXPUP)
1346 logical nosingrad,jetprocs
1347 common/MEMAIN/etcjet,rclmax,etaclmax,qcut,showerkt,clfact,
1348 $ maxjets,minjets,iexcfile,ktsche,mektsc,nexcres,excres,
1349 $ nqmatch,nexcproc,iexcproc,iexcval,nosingrad,jetprocs
1350
1351
1352
1353
1354
1355
1356 INTEGER NLJETS,IEXC,Ifile
1357 DOUBLE PRECISION PTCLUS
1358 COMMON/MEMAEV/PTCLUS(20),NLJETS,IEXC,Ifile
1359
1360
1361 INTEGER I,MAXNJ,NREAD,MINJ,MAXJ
1362 parameter(MAXNJ=6)
1363 DOUBLE PRECISION XSTOT(MAXNJ),XSECTOT
1364 DOUBLE PRECISION ptjmin,etajmax,drjmin,ptbmin,etabmax,xqcut
1365
1366 integer icount
1367
1368
1369 INTEGER iexclusive
1370 EXTERNAL iexclusive
1371
1372
1373 icount=0
1374
1375
1376 IF(IABS(IDBMUP(1)).EQ.11.AND.IABS(IDBMUP(2)).EQ.11) then
1377 CALL PYGIVE('PARP(71)=1')
1378 ENDIF
1379
1380
1381
1382
1383
1384
1385
1386 DO I=1,MAXNJ
1387 XSTOT(I)=0D0
1388 ENDDO
1389 MINJ=MAXNJ
1390 MAXJ=0
1391 NREAD=0
1392 NUP=0
1393 DO WHILE(.true.)
1394
1395 CALL MGEVNT()
1396 write(LNHOUT,*)'NLJETS=',NLJETS
1397
1398 icount = icount+1
1399 if (icount.gt.10) then
1400 write (LNHOUT,*)
1401 & 'GeneratorInterface/PartonShowerVeto ME2phythia:'
1402 & //' Aborting, loop in set_matching above ',icount,' cycles'
1403 write (LNHOUT,*) 'NUP = ',NUP,' IEXC = ',IEXC
1404 stop
1405 endif
1406
1407 IF(NUP.eq.0) goto 20
1408 IF(IEXC.EQ.-1) cycle
1409
1410 if(NLJETS.GT.MAXJ) MAXJ=NLJETS
1411 if(NLJETS.LT.MINJ) MINJ=NLJETS
1412
1413 XSTOT(NLJETS+1)=XSTOT(NLJETS+1)+1
1414 NREAD=NREAD+1
1415 ENDDO
1416
1417 20 continue
1418
1419
1420
1421 write(LNHOUT,*) 'Minimum number of jets in file: ',MINJ
1422 write(LNHOUT,*) 'Maximum number of jets in file: ',MAXJ
1423
1424 XSECTOT=0d0
1425 DO I=1,NPRUP
1426 XSECTOT=XSECTOT+XSECUP(I)
1427 ENDDO
1428 write(LNHOUT,*)'NPRUP=',NPRUP
1429 IF(NPRUP.eq.1.AND.MINJ.lt.MAXJ)THEN
1430
1431
1432 jetprocs=.true.
1433 IF(IEXCFILE.eq.0.AND.iexclusive(LPRUP(1)).ne.1) THEN
1434 nexcproc=1
1435 IEXCPROC(1)=MAXJ-MINJ
1436 IEXCVAL(1)=0
1437 ENDIF
1438 NPRUP=1+MAXJ-MINJ
1439 DO I=MINJ,MAXJ
1440 XSECUP(1+I-MINJ) = XSECTOT*XSTOT(I+1)/NREAD
1441 XMAXUP(1+I-MINJ) = XMAXUP(1)
1442 LPRUP(1+I-MINJ) = I-MINJ
1443 ENDDO
1444 ELSE IF(IEXCFILE.EQ.0) THEN
1445
1446 DO I=1,NPRUP
1447 IF(iexclusive(LPRUP(I)).EQ.0) IEXCFILE=1
1448 ENDDO
1449 ENDIF
1450
1451 WRITE(LNHOUT,*) ' Number of Events Read:: ',NREAD
1452 WRITE(LNHOUT,*) ' Total cross section (pb):: ',XSECTOT
1453 WRITE(LNHOUT,*) ' Process Cross Section (pb):: '
1454 DO I=1,NPRUP
1455 WRITE(LNHOUT,'(I5,E23.5)') I,XSECUP(I)
1456 ENDDO
1457
1458 IF(MINJETS.EQ.-1) MINJETS=MINJ
1459 IF(MAXJETS.EQ.-1) MAXJETS=MAXJ
1460 write(LNHOUT,*) 'Minimum number of jets allowed: ',MINJETS
1461 write(LNHOUT,*) 'Maximum number of jets allowed: ',MAXJETS
1462 write(LNHOUT,*) 'IEXCFILE = ',IEXCFILE
1463 write(LNHOUT,*) 'jetprocs = ',jetprocs
1464 DO I=1,NPRUP
1465 write(LNHOUT,*) 'IEXCPROC(',LPRUP(I),') = ',
1466 $ iexclusive(LPRUP(I))
1467 ENDDO
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478 call get_real (npara,param,value," ptj " ,ptjmin,7d3)
1479 call get_real (npara,param,value," etaj " ,etajmax,7d3)
1480 call get_real (npara,param,value," ptb " ,ptbmin,7d3)
1481 call get_real (npara,param,value," etab " ,etabmax,7d3)
1482 call get_real (npara,param,value," drjj " ,drjmin,7d3)
1483 call get_real (npara,param,value," xqcut " ,xqcut,0d0)
1484
1485 if(qcut.lt.xqcut) then
1486 if(showerkt.eq.1) then
1487 qcut=xqcut
1488 else
1489 qcut=max(xqcut*1.2,xqcut+5)
1490 endif
1491 endif
1492 if(xqcut.le.0)then
1493 write(*,*) 'Warning! ME generation QCUT = 0. QCUT set to 0!'
1494 qcut=0
1495 endif
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510 IF(ETCJET.LE.PTJMIN)THEN
1511 ETCJET=MAX(PTJMIN+5,1.2*PTJMIN)
1512 ENDIF
1513
1514 RCLMAX=DRJMIN
1515 ETACLMAX=ETAJMAX
1516 IF(qcut.le.0)THEN
1517 WRITE(*,*) 'JET CONE PARAMETERS FOR MATCHING:'
1518 WRITE(*,*) 'ET>',ETCJET,' R=',RCLMAX
1519 WRITE(*,*) 'DR(PARTON-JET)<',1.5*RCLMAX
1520 WRITE(*,*) 'ETA(JET)<',ETACLMAX
1521 ELSE IF(ickkw.eq.1) THEN
1522 WRITE(*,*) 'KT JET PARAMETERS FOR MATCHING:'
1523 WRITE(*,*) 'QCUT=',qcut
1524 WRITE(*,*) 'ETA(JET)<',ETACLMAX
1525 WRITE(*,*) 'Note that in ME generation, qcut = ',xqcut
1526 write(*,*)'the showerkt param is ',showerkt
1527 if(showerkt.eq.1.0)THEN
1528
1529 endif
1530 if(showerkt.eq.1.0.and.MSTP(81).LT.20)THEN
1531 WRITE(*,*)'WARNING: "shower kt" needs pT-ordered showers'
1532 WRITE(*,*)' Setting MSTP(81)=',20+MOD(MSTP(81),10)
1533 MSTP(81)=20+MOD(MSTP(81),10)
1534 endif
1535 else if(ickkw.eq.2)then
1536
1537 CALL PYGIVE('MSTP(62)=2')
1538 CALL PYGIVE('MSTP(67)=0')
1539 if(MSTP(81).LT.20)THEN
1540 WRITE(*,*)'WARNING: Must run CKKW with pt-ordered showers'
1541 WRITE(*,*)' Setting MSTP(81)=',20+MOD(MSTP(81),10)
1542 MSTP(81)=20+MOD(MSTP(81),10)
1543 endif
1544 endif
1545 return
1546 end
1547
1548 subroutine get_real(npara,param,value,name,var,def_value)
1549
1550
1551
1552 implicit none
1553
1554
1555
1556
1557 integer npara
1558 character*20 param(*),value(*)
1559 character*(*) name
1560 real*8 var,def_value
1561
1562
1563
1564 logical found
1565 integer i
1566
1567
1568
1569
1570
1571 i=1
1572 found=.false.
1573 do while(.not.found.and.i.le.npara)
1574
1575 found = (index(param(i),name).ne.0)
1576 if (found) read(value(i),*) var
1577
1578 i=i+1
1579 enddo
1580 if (.not.found) then
1581 write (*,*) "Warning: parameter ",name," not found"
1582 write (*,*) " setting it to default value ",def_value
1583 var=def_value
1584 else
1585 write(*,*) 'Found parameter ',name,var
1586 endif
1587 return
1588
1589 end
1590
1591
1592 subroutine get_integer(npara,param,value,name,var,def_value)
1593
1594
1595
1596 implicit none
1597
1598
1599
1600 integer npara
1601 character*20 param(*),value(*)
1602 character*(*) name
1603 integer var,def_value
1604
1605
1606
1607 logical found
1608 integer i
1609
1610
1611
1612 i=1
1613 found=.false.
1614 do while(.not.found.and.i.le.npara)
1615 found = (index(param(i),name).ne.0)
1616 if (found) read(value(i),*) var
1617
1618 i=i+1
1619 enddo
1620 if (.not.found) then
1621 write (*,*) "Warning: parameter ",name," not found"
1622 write (*,*) " setting it to default value ",def_value
1623 var=def_value
1624 else
1625 write(*,*)'Found parameter ',name,var
1626 endif
1627 return
1628
1629 end
1630
1631
1632 SUBROUTINE ALPSOR(A,N,K,IOPT)
1633
1634
1635
1636
1637
1638 DOUBLE PRECISION A(N),B(5000)
1639 INTEGER N,I,J,IOPT,K(N),IL(5000),IR(5000)
1640 IF (N.GT.5000) then
1641 write(*,*) 'Too many entries to sort in alpsrt, stop'
1642 stop
1643 endif
1644 if(n.le.0) return
1645 IL(1)=0
1646 IR(1)=0
1647 DO 10 I=2,N
1648 IL(I)=0
1649 IR(I)=0
1650 J=1
1651 2 IF(A(I).GT.A(J)) GOTO 5
1652 IF(IL(J).EQ.0) GOTO 4
1653 J=IL(J)
1654 GOTO 2
1655 4 IR(I)=-J
1656 IL(J)=I
1657 GOTO 10
1658 5 IF(IR(J).LE.0) GOTO 6
1659 J=IR(J)
1660 GOTO 2
1661 6 IR(I)=IR(J)
1662 IR(J)=I
1663 10 CONTINUE
1664 I=1
1665 J=1
1666 GOTO 8
1667 20 J=IL(J)
1668 8 IF(IL(J).GT.0) GOTO 20
1669 9 K(I)=J
1670 B(I)=A(J)
1671 I=I+1
1672 IF(IR(J)) 12,30,13
1673 13 J=IR(J)
1674 GOTO 8
1675 12 J=-IR(J)
1676 GOTO 9
1677 30 IF(IOPT.EQ.2) RETURN
1678 DO 31 I=1,N
1679 31 A(I)=B(I)
1680 END
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712 SUBROUTINE CALINIM
1713
1714
1715
1716
1717
1718 IMPLICIT NONE
1719
1720 INTEGER MNCY,MNCPHI,NCY,NCPHI,NJMAX,JETNO,NCJET
1721 DOUBLE PRECISION YCMIN,YCMAX,DELY,DELPHI,ET,STHCAL,CTHCAL,CPHCAL,
1722 & SPHCAL,PCJET,ETJET
1723 PARAMETER (MNCY=200)
1724 PARAMETER (MNCPHI=200)
1725 COMMON/CALORM/DELY,DELPHI,ET(MNCY,MNCPHI),
1726 $CTHCAL(MNCY),STHCAL(MNCY),CPHCAL(MNCPHI),SPHCAL(MNCPHI),
1727 $YCMIN,YCMAX,NCY,NCPHI
1728 PARAMETER (NJMAX=500)
1729 COMMON/GETCOMM/PCJET(4,NJMAX),ETJET(NJMAX),JETNO(MNCY,MNCPHI),
1730 $ NCJET
1731
1732 INTEGER IPHI,IY
1733 DOUBLE PRECISION PI,PHIX,YX,THX
1734 PARAMETER (PI=3.141593D0)
1735 LOGICAL FSTCAL
1736 DATA FSTCAL/.TRUE./
1737
1738
1739 DO 100 IPHI=1,NCPHI
1740 DO 100 IY=1,NCY
1741 100 ET(IY,IPHI)=0.
1742
1743 IF (FSTCAL) THEN
1744
1745 DELPHI=2.*PI/FLOAT(NCPHI)
1746 DO 200 IPHI=1,NCPHI
1747 PHIX=DELPHI*(IPHI-.5)
1748 CPHCAL(IPHI)=COS(PHIX)
1749 SPHCAL(IPHI)=SIN(PHIX)
1750 200 CONTINUE
1751 DELY=(YCMAX-YCMIN)/FLOAT(NCY)
1752 DO 300 IY=1,NCY
1753 YX=DELY*(IY-.5)+YCMIN
1754 THX=2.*ATAN(EXP(-YX))
1755 CTHCAL(IY)=COS(THX)
1756 STHCAL(IY)=SIN(THX)
1757 300 CONTINUE
1758 FSTCAL=.FALSE.
1759 ENDIF
1760 END
1761
1762 SUBROUTINE CALSIMM
1763
1764
1765
1766
1767 INTEGER NMXHEP,NEVHEP,NHEP,ISTHEP,IDHEP,JMOHEP,JDAHEP
1768 PARAMETER (NMXHEP=4000)
1769 COMMON/HEPEVT/NEVHEP,NHEP,ISTHEP(NMXHEP),IDHEP(NMXHEP),
1770 &JMOHEP(2,NMXHEP),JDAHEP(2,NMXHEP),PHEP(5,NMXHEP),VHEP(4,NMXHEP)
1771 DOUBLE PRECISION PHEP,VHEP
1772 SAVE /HEPEVT/
1773
1774
1775 INTEGER MNCY,MNCPHI,NCY,NCPHI,NJMAX,JETNO,NCJET
1776 DOUBLE PRECISION YCMIN,YCMAX,DELY,DELPHI,ET,STHCAL,CTHCAL,CPHCAL,
1777 & SPHCAL,PCJET,ETJET
1778 PARAMETER (MNCY=200)
1779 PARAMETER (MNCPHI=200)
1780 COMMON/CALORM/DELY,DELPHI,ET(MNCY,MNCPHI),
1781 $CTHCAL(MNCY),STHCAL(MNCY),CPHCAL(MNCPHI),SPHCAL(MNCPHI),
1782 $YCMIN,YCMAX,NCY,NCPHI
1783 PARAMETER (NJMAX=500)
1784 COMMON/GETCOMM/PCJET(4,NJMAX),ETJET(NJMAX),JETNO(MNCY,MNCPHI),
1785 $ NCJET
1786
1787 INTEGER IHEP,ID,IY,IPHI
1788 DOUBLE PRECISION PI,YIP,PSERAP,PHIIP,EIP
1789 PARAMETER (PI=3.141593D0)
1790
1791
1792
1793 DO 200 IHEP=1,NHEP
1794 IF (ISTHEP(IHEP).EQ.1) THEN
1795 YIP=PSERAP(PHEP(1,IHEP))
1796 IF(YIP.LT.YCMIN.OR.YIP.GT.YCMAX) GOTO 200
1797 ID=ABS(IDHEP(IHEP))
1798
1799 IF ((ID.GE.11.AND.ID.LE.16).OR.ID.EQ.6.OR.ID.EQ.22) GOTO 200
1800
1801 PHIIP=ATAN2(PHEP(2,IHEP),PHEP(1,IHEP))
1802 IF(PHIIP.LT.0.) PHIIP=PHIIP+2.*PI
1803 IY=INT((YIP-YCMIN)/DELY)+1
1804 IPHI=INT(PHIIP/DELPHI)+1
1805 EIP=PHEP(4,IHEP)
1806
1807 ET(IY,IPHI)=ET(IY,IPHI)+EIP*STHCAL(IY)
1808 ENDIF
1809 200 CONTINUE
1810 END
1811 SUBROUTINE GETJETM(RJET,EJCUT,ETAJCUT)
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822 IMPLICIT NONE
1823
1824 INTEGER MNCY,MNCPHI,NCY,NCPHI,NJMAX,JETNO,NCJET
1825 DOUBLE PRECISION YCMIN,YCMAX,DELY,DELPHI,ET,STHCAL,CTHCAL,CPHCAL,
1826 & SPHCAL,PCJET,ETJET
1827 PARAMETER (MNCY=200)
1828 PARAMETER (MNCPHI=200)
1829 COMMON/CALORM/DELY,DELPHI,ET(MNCY,MNCPHI),
1830 $CTHCAL(MNCY),STHCAL(MNCY),CPHCAL(MNCPHI),SPHCAL(MNCPHI),
1831 $YCMIN,YCMAX,NCY,NCPHI
1832 PARAMETER (NJMAX=500)
1833 COMMON/GETCOMM/PCJET(4,NJMAX),ETJET(NJMAX),JETNO(MNCY,MNCPHI),
1834 $ NCJET
1835
1836 INTEGER IPHI,IY,J,K,NPHI1,NPHI2,NY1,
1837 & NY2,IPASS,IYMX,IPHIMX,ITLIS,IPHI1,IPHIX,IY1,IYX
1838 DOUBLE PRECISION PI,RJET,
1839 & ETMAX,ETSTOP,RR,ECCUT,PX,EJCUT
1840 PARAMETER (PI=3.141593D0)
1841 DOUBLE PRECISION ETAJCUT,PSERAP
1842
1843
1844 DATA ECCUT/0.1D0/
1845 DATA ETSTOP/1.5D0/
1846 DATA ITLIS/6/
1847
1848
1849
1850 DO 100 IPHI=1,NCPHI
1851 DO 100 IY=1,NCY
1852 100 JETNO(IY,IPHI)=0
1853 DO 110 J=1,NJMAX
1854 ETJET(J)=0.
1855 DO 110 K=1,4
1856 110 PCJET(K,J)=0.
1857 NCJET=0
1858 NPHI1=RJET/DELPHI
1859 NPHI2=2*NPHI1+1
1860 NY1=RJET/DELY
1861 NY2=2*NY1+1
1862 IPASS=0
1863
1864 iymx = 0
1865 iphimx = 0
1866
1867
1868
1869
1870 1 ETMAX=0.
1871 DO 200 IPHI=1,NCPHI
1872 DO 210 IY=1,NCY
1873 IF(ET(IY,IPHI).LT.ETMAX) GOTO 210
1874 IF(JETNO(IY,IPHI).NE.0) GOTO 210
1875 ETMAX=ET(IY,IPHI)
1876 IYMX=IY
1877 IPHIMX=IPHI
1878 210 CONTINUE
1879 200 CONTINUE
1880 IF(ETMAX.LT.ETSTOP) RETURN
1881
1882
1883
1884 IPASS=IPASS+1
1885 IF(IPASS.GT.NCY*NCPHI) THEN
1886 WRITE(ITLIS,8888) IPASS
1887 8888 FORMAT(//' ERROR IN GETJETM...IPASS > ',I6)
1888 RETURN
1889 ENDIF
1890 NCJET=NCJET+1
1891 IF(NCJET.GT.NJMAX) THEN
1892 WRITE(ITLIS,9999) NCJET
1893 9999 FORMAT(//' ERROR IN GETJETM...NCJET > ',I5)
1894 RETURN
1895 ENDIF
1896 DO 300 IPHI1=1,NPHI2
1897 IPHIX=IPHIMX-NPHI1-1+IPHI1
1898 IF(IPHIX.LE.0) IPHIX=IPHIX+NCPHI
1899 IF(IPHIX.GT.NCPHI) IPHIX=IPHIX-NCPHI
1900 DO 310 IY1=1,NY2
1901 IYX=IYMX-NY1-1+IY1
1902 IF(IYX.LE.0) GOTO 310
1903 IF(IYX.GT.NCY) GOTO 310
1904 IF(JETNO(IYX,IPHIX).NE.0) GOTO 310
1905 RR=(DELY*(IY1-NY1-1))**2+(DELPHI*(IPHI1-NPHI1-1))**2
1906 IF(RR.GT.RJET**2) GOTO 310
1907 IF(ET(IYX,IPHIX).LT.ECCUT) GOTO 310
1908 PX=ET(IYX,IPHIX)/STHCAL(IYX)
1909
1910 PCJET(1,NCJET)=PCJET(1,NCJET)+PX*STHCAL(IYX)*CPHCAL(IPHIX)
1911 PCJET(2,NCJET)=PCJET(2,NCJET)+PX*STHCAL(IYX)*SPHCAL(IPHIX)
1912 PCJET(3,NCJET)=PCJET(3,NCJET)+PX*CTHCAL(IYX)
1913 PCJET(4,NCJET)=PCJET(4,NCJET)+PX
1914 ETJET(NCJET)=ETJET(NCJET)+ET(IYX,IPHIX)
1915 JETNO(IYX,IPHIX)=NCJET
1916 310 CONTINUE
1917 300 CONTINUE
1918
1919
1920
1921 IF(ETJET(NCJET).GT.EJCUT.AND.ABS(PSERAP(PCJET(1,NCJET))).LT
1922 $ .ETAJCUT) GOTO 1
1923 ETJET(NCJET)=0.
1924 DO 400 K=1,4
1925 400 PCJET(K,NCJET)=0.
1926 NCJET=NCJET-1
1927 GOTO 1
1928 END
1929
1930 SUBROUTINE CALDELM(ISTLO,ISTHI)
1931
1932
1933
1934
1935 IMPLICIT NONE
1936 INTEGER MAXNUP
1937 PARAMETER(MAXNUP=500)
1938
1939 INTEGER NMXHEP,NEVHEP,NHEP,ISTHEP,IDHEP,JMOHEP,JDAHEP
1940 PARAMETER (NMXHEP=4000)
1941 COMMON/HEPEVT/NEVHEP,NHEP,ISTHEP(NMXHEP),IDHEP(NMXHEP),
1942 &JMOHEP(2,NMXHEP),JDAHEP(2,NMXHEP),PHEP(5,NMXHEP),VHEP(4,NMXHEP)
1943 DOUBLE PRECISION PHEP,VHEP
1944 SAVE /HEPEVT/
1945 INTEGER ISTLO,ISTHI
1946
1947
1948 ISTLO=ISTLO
1949 ISTHI=ISTHI
1950 CALL CALSIMM
1951 END
1952
1953
1954
1955
1956
1957 integer function iexclusive(iproc)
1958 implicit none
1959
1960 integer iproc, i
1961 INTEGER MAXPUP
1962 PARAMETER (MAXPUP=100)
1963
1964
1965 double precision etcjet,rclmax,etaclmax,qcut,clfact,showerkt
1966 integer maxjets,minjets,iexcfile,ktsche,mektsc,nexcres,excres(30)
1967 integer nqmatch,nexcproc,iexcproc(MAXPUP),iexcval(MAXPUP)
1968 logical nosingrad,jetprocs
1969 common/MEMAIN/etcjet,rclmax,etaclmax,qcut,showerkt,clfact,
1970 $ maxjets,minjets,iexcfile,ktsche,mektsc,nexcres,excres,
1971 $ nqmatch,nexcproc,iexcproc,iexcval,nosingrad,jetprocs
1972
1973
1974 iexclusive=-2
1975 do i=1,nexcproc
1976 if(iproc.eq.iexcproc(i)) then
1977 iexclusive=iexcval(i)
1978 return
1979 endif
1980 enddo
1981
1982 return
1983 end
1984
1985
1986
1987 subroutine initpydata
1988
1989 INTEGER KCHG
1990 DOUBLE PRECISION PMAS,PARF,VCKM
1991 COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4)
1992 INTEGER MSTP,MSTI
1993 DOUBLE PRECISION PARP,PARI
1994 COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200)
1995
1996 if(PMAS(1,1).lt.0.1D0.or.PMAS(1,1).gt.1.) THEN
1997
1998 PMAS(1,1) = 0.33D0
1999 PMAS(2,1) = 0.33D0
2000 PMAS(3,1) = 0.5D0
2001 PMAS(4,1) = 1.5D0
2002 PMAS(5,1) = 4.8D0
2003 PMAS(6,1) = 175D0
2004 PMas(7,1) = 400D0
2005 PMas(8,1) = 400D0
2006 PMas(9,1) = 0D0
2007 PMas(10,1) = 0D0
2008 PMas(11,1) = 0.0005D0
2009 PMas(12,1) = 0D0
2010 PMas(13,1) = 0.10566D0
2011 PMas(14,1) = 0D0
2012 PMas(15,1) = 1.777D0
2013 PMas(16,1) = 0D0
2014 PMas(17,1) = 400D0
2015 PMas(18,1) = 0D0
2016 PMas(19,1) = 0D0
2017 PMas(20,1) = 0D0
2018 PMAS(21,1) = 0D0
2019
2020 MSTP(61) = 2
2021 MSTP(71) = 1
2022 MSTP(183)= 2013
2023
2024 endif
2025
2026 return
2027 end
2028
2029
2030
2031
2032
2033 BLOCK DATA MEPYDAT
2034
2035 INTEGER MAXPUP
2036 PARAMETER (MAXPUP=100)
2037
2038 double precision etcjet,rclmax,etaclmax,qcut,clfact,showerkt
2039 integer maxjets,minjets,iexcfile,ktsche,mektsc,nexcres,excres(30)
2040 integer nqmatch,nexcproc,iexcproc(MAXPUP),iexcval(MAXPUP)
2041 logical nosingrad,jetprocs
2042 common/MEMAIN/etcjet,rclmax,etaclmax,qcut,showerkt,clfact,
2043 $ maxjets,minjets,iexcfile,ktsche,mektsc,nexcres,excres,
2044 $ nqmatch,nexcproc,iexcproc,iexcval,nosingrad,jetprocs
2045
2046
2047 INTEGER MNCY,MNCPHI,NCY,NCPHI,NJMAX,JETNO,NCJET
2048 DOUBLE PRECISION YCMIN,YCMAX,DELY,DELPHI,ET,STHCAL,CTHCAL,CPHCAL,
2049 & SPHCAL,PCJET,ETJET
2050 PARAMETER (MNCY=200)
2051 PARAMETER (MNCPHI=200)
2052 COMMON/CALORM/DELY,DELPHI,ET(MNCY,MNCPHI),
2053 $CTHCAL(MNCY),STHCAL(MNCY),CPHCAL(MNCPHI),SPHCAL(MNCPHI),
2054 $YCMIN,YCMAX,NCY,NCPHI
2055
2056
2057 INTEGER LNHIN,LNHOUT,MSCAL,IEVNT,ICKKW,ISCALE
2058 COMMON/UPPRIV/LNHIN,LNHOUT,MSCAL,IEVNT,ICKKW,ISCALE
2059
2060
2061 DATA showerkt/0.0/
2062 DATA qcut,clfact,etcjet/0d0,0d0,0d0/
2063 DATA ktsche,mektsc,maxjets,minjets,nexcres/0,1,-1,-1,0/
2064 DATA nqmatch/5/
2065 DATA nexcproc/0/
2066 DATA iexcproc/MAXPUP*-1/
2067 DATA iexcval/MAXPUP*-2/
2068
2069
2070 DATA NCY,NCPHI/50,60/
2071
2072 DATA LNHIN,LNHOUT,MSCAL,IEVNT,ICKKW,ISCALE/77,6,0,0,0,1/
2073
2074
2075
2076
2077
2078 END
2079