hijing/src/pyhitest.f

0001
0002 ***********************************************************************
0003
0004       SUBROUTINE PYHITEST(MTEST)
0005
0006 C...Purpose: to provide a simple program (disguised as a subroutine) to
0007 C...run at installation as a check that the program works as intended.
0008       COMMON/LUJETS/N,K(9000,5),P(9000,5),V(9000,5)
0009       SAVE /LUJETS/
0010       COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
0011       SAVE /LUDAT1/
0012       COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
0013       SAVE /LUDAT2/
0014       COMMON/LUDAT3/MDCY(500,3),MDME(2000,2),BRAT(2000),KFDP(2000,5)
0015       SAVE /LUDAT3/
0016       COMMON/PYHISUBS/MSEL,MSUB(200),KFIN(2,-40:40),CKIN(200)
0017       SAVE /PYHISUBS/
0018       COMMON/PYHIPARS/MSTP(200),PARP(200),MSTI(200),PARI(200)
0019       SAVE /PYHIPARS/
0020
0021 C...Common initial values. Loop over initiating conditions.
0022       MSTP(122)=1
0023       IF(MTEST.LE.0) MSTP(122)=0
0024       MDCY(LUCOMP(111),1)=0
0025       NERR=0
0026       DO 130 IPROC=1,7
0027
0028 C...Reset process type, kinematics cuts, and the flags used.
0029       MSEL=0
0030       DO 100 ISUB=1,200
0031   100 MSUB(ISUB)=0
0032       CKIN(1)=2.
0033       CKIN(3)=0.
0034       MSTP(2)=1
0035       MSTP(33)=0
0036       MSTP(81)=1
0037       MSTP(82)=1
0038       MSTP(111)=1
0039       MSTP(131)=0
0040       MSTP(133)=0
0041       PARP(131)=0.01
0042
0043 C...Prompt photon production at fixed target.
0044       IF(IPROC.EQ.1) THEN
0045         PZSUM=300.
0046         PESUM=SQRT(PZSUM**2+ULMASS(211)**2)+ULMASS(2212)
0047         PQSUM=2.
0048         MSEL=10
0049         CKIN(3)=5.
0050         CALL PYHIINIT('FIXT','pi+','p',PZSUM)
0051
0052 C...QCD processes at ISR energies.
0053       ELSEIF(IPROC.EQ.2) THEN
0054         PESUM=63.
0055         PZSUM=0.
0056         PQSUM=2.
0057         MSEL=1
0058         CKIN(3)=5.
0059         CALL PYHIINIT('CMS','p','p',PESUM)
0060
0061 C...W production + multiple interactions at CERN Collider.
0062       ELSEIF(IPROC.EQ.3) THEN
0063         PESUM=630.
0064         PZSUM=0.
0065         PQSUM=0.
0066         MSEL=12
0067         CKIN(1)=20.
0068         MSTP(82)=4
0069         MSTP(2)=2
0070         MSTP(33)=3
0071         CALL PYHIINIT('CMS','p','pbar',PESUM)
0072
0073 C...W/Z gauge boson pairs + overlayed events at the Tevatron.
0074       ELSEIF(IPROC.EQ.4) THEN
0075         PESUM=1800.
0076         PZSUM=0.
0077         PQSUM=0.
0078         MSUB(22)=1
0079         MSUB(23)=1
0080         MSUB(25)=1
0081         CKIN(1)=200.
0082         MSTP(111)=0
0083         MSTP(131)=1
0084         MSTP(133)=2
0085         PARP(131)=0.04
0086         CALL PYHIINIT('CMS','p','pbar',PESUM)
0087
0088 C...Higgs production at LHC.
0089       ELSEIF(IPROC.EQ.5) THEN
0090         PESUM=17000.
0091         PZSUM=0.
0092         PQSUM=0.
0093         MSEL=16
0094         PMAS(25,1)=300.
0095         CKIN(1)=200.
0096         MSTP(81)=0
0097         MSTP(111)=0
0098         CALL PYHIINIT('CMS','p','pbar',PESUM)
0099
0100 C...Z' production at SSC.
0101       ELSEIF(IPROC.EQ.6) THEN
0102         PESUM=40000.
0103         PZSUM=0.
0104         PQSUM=0.
0105         MSEL=21
0106         PMAS(32,1)=600.
0107         CKIN(1)=400.
0108         MSTP(81)=0
0109         MSTP(111)=0
0110         CALL PYHIINIT('CMS','p','pbar',PESUM)
0111
0112 C...W pair production at 1 TeV e+e- collider.
0113       ELSEIF(IPROC.EQ.7) THEN
0114         PESUM=1000.
0115         PZSUM=0.
0116         PQSUM=0.
0117         MSUB(25)=1
0118         CALL PYHIINIT('CMS','e+','e-',PESUM)
0119       ENDIF
0120
0121 C...Generate 20 events of each required type.
0122       DO 120 IEV=1,20
0123       CALL PYHITHIA
0124       PESUMM=PESUM
0125       IF(IPROC.EQ.4) PESUMM=MSTI(41)*PESUM
0126
0127 C...Check conservation of energy/momentum/flavour.
0128       MERR=0
0129       DEVE=ABS(PLU(0,4)-PESUMM)+ABS(PLU(0,3)-PZSUM)
0130       DEVT=ABS(PLU(0,1))+ABS(PLU(0,2))
0131       DEVQ=ABS(PLU(0,6)-PQSUM)
0132       IF(DEVE.GT.1E-3*PESUM.OR.DEVT.GT.MAX(0.01,1E-5*PESUM).OR.
0133      &DEVQ.GT.0.1) MERR=1
0134       IF(MERR.NE.0) WRITE(MSTU(11),1000) IPROC,IEV
0135
0136 C...Check that all KF codes are known ones, and that partons/particles
0137 C...satisfy energy-momentum-mass relation.
0138       DO 110 I=1,N
0139       IF(K(I,1).GT.20) GOTO 110
0140       IF(LUCOMP(K(I,2)).EQ.0) THEN
0141         WRITE(MSTU(11),1100) I
0142         MERR=MERR+1
0143       ENDIF
0144       PD=P(I,4)**2-P(I,1)**2-P(I,2)**2-P(I,3)**2-P(I,5)**2*
0145      &SIGN(1.,P(I,5))
0146       IF(ABS(PD).GT.MAX(0.1,0.002*P(I,4)**2,0.002*P(I,5)**2).OR.
0147      &(P(I,5).GE.0..AND.P(I,4).LT.0.)) THEN
0148         WRITE(MSTU(11),1200) I
0149         MERR=MERR+1
0150       ENDIF
0151   110 CONTINUE
0152
0153 C...Listing of erronoeus events, and first event of each type.
0154       IF(MERR.GE.1) NERR=NERR+1
0155       IF(NERR.GE.10) THEN
0156         WRITE(MSTU(11),1300)
0157         CALL LULIST(1)
0158         STOP
0159       ENDIF
0160       IF(MTEST.GE.1.AND.(MERR.GE.1.OR.IEV.EQ.1)) THEN
0161         IF(MERR.GE.1) WRITE(MSTU(11),1400)
0162         CALL LULIST(1)
0163       ENDIF
0164   120 CONTINUE
0165
0166 C...List statistics for each process type.
0167       IF(MTEST.GE.1) CALL PYHISTAT(1)
0168   130 CONTINUE
0169
0170 C...Summarize result of run.
0171       IF(NERR.EQ.0) WRITE(MSTU(11),1500)
0172       IF(NERR.GT.0) WRITE(MSTU(11),1600) NERR
0173       RETURN
0174
0175 C...Formats for information.
0176  1000 FORMAT(/5X,'Energy/momentum/flavour nonconservation for process',
0177      &I2,', event',I4)
0178  1100 FORMAT(/5X,'Entry no.',I4,' in following event not known code')
0179  1200 FORMAT(/5X,'Entry no.',I4,' in following event has faulty ',
0180      &'kinematics')
0181  1300 FORMAT(/5X,'This is the tenth error experienced! Something is ',
0182      &'wrong.'/5X,'Execution will be stopped after listing of event.')
0183  1400 FORMAT(5X,'Faulty event follows:')
0184  1500 FORMAT(//5X,'End result of run: no errors detected.')
0185  1600 FORMAT(//5X,'End result of run:',I2,' errors detected.'/
0186      &5X,'This should not have happened!')
0187       END