1 C--------------------------------------------------------------------------
4 C This software is part of the EvtGen package developed jointly
5 C for the BaBar and CLEO collaborations. If you use all or part
6 C of it, please give an appropriate acknowledgement.
8 C Copyright Information: See BelEvtGen/COPYRIGHT
9 C Copyright (C) 1998 Caltech, UCSB
11 C Module: EvtJetSetInit.F
15 C Modification history:
17 C DJL/RYD August 11, 1998 Module created
18 C RS October 28, 2002 copied and modified from Jetset
20 C------------------------------------------------------------------------
21 SUBROUTINE EVTPYTHIAINIT(FNAME)
27 PRINT *,'PYUPDA : : ',FNAME
28 OPEN(54,STATUS='OLD',FILE=FNAME)
31 WRITE (*,*) 'PYUPDA DONE'
34 SUBROUTINE INITPYTHIA(GAGA)
37 EXTERNAL PYDATA,PYCOMP
41 DOUBLE PRECISION MAXIMUM
44 C...Decay information.
45 INTEGER MDCY,MDME,KFDP
47 COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5)
49 CHARACTER CH1*16,CH2*16
52 C order of DC is d u s c b t b' t' ...
53 C ... e nu_e mu nu_mu tau nu_tau tau' nu_tau'
58 WRITE (*,*) "Decay of Z0/gamma to"
59 C... Only allow Z0 decay to quarks (i.e. no leptonic final states).
60 C RS veto also b quarks
61 DO IDC=MDCY(23,2),MDCY(23,2)+MDCY(23,3)-1
62 C first switch channel off
63 MDME(IDC,1)=MIN(0,MDME(IDC,1))
65 C then switch on again if requested
70 WRITE (*,*) " ",ch1,"+ ",ch2," ALLOWED"
72 WRITE (*,*) " ",ch1,"+ ",ch2," DISABLED"
78 CALL PYINIT('CMS','E+','E-',MAXIMUM)
80 CALL PYINIT('CMS','GAMMA/E+','GAMMA/E-',MAXIMUM)
83 C WRITE (*,*) 'done PYTHIA initialization'//
84 C > ' with varying beam energy'
85 C WRITE (*,*) 'maximum allowed energy is ',MAXIMUM,' GeV'
91 C--------------------------------------------------------------------------
94 C This software is part of the EvtGen package developed jointly
95 C for the BaBar and CLEO collaborations. If you use all or part
96 C of it, please give an appropriate acknowledgement.
98 C Copyright Information: See BelEvtGen/COPYRIGHT
99 C Copyright (C) 1998 Caltech, UCSB
101 C Module: continuum.F
105 C Modification history:
107 C DJL/RYD August 11, 1998 Module created
108 C 26-Sep-2002 - RS : changed to PYTHIA
110 C------------------------------------------------------------------------
111 SUBROUTINE PYCONTINUUM(ENERGY,NDAUG,KF,PX,PY,PZ,E)
113 DOUBLE PRECISION MAXIMUM
114 COMMON/CBBEAM/MAXIMUM
117 COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5)
120 DOUBLE PRECISION PARU,PARJ
121 COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
124 DOUBLE PRECISION PARP,PARI
125 COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200)
126 C...Decay information.
127 INTEGER MDCY,MDME,KFDP
128 DOUBLE PRECISION BRAT
129 COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5)
131 INTEGER N,NPAD,K,IMSTJ
133 REAL*8 PXSUM,PYSUM,PZSUM
140 INTEGER KF(100),I,NDAUG
141 REAL*8 PX(100),PY(100),PZ(100),E(100)
143 C RS Particles should not decay at this stage
144 C but remember the previous setting
148 C IF(FLAVOR.NE.LastProdFLav) THEN
149 C... Only allow Z0 decay to decay to certain flavour
150 C DO IDC=MDCY(23,2),MDCY(23,2)+MDCY(23,3)-1
151 C IF(IABS(KFDP(IDC,1)).NE.Flavor)
152 C > MDME(IDC,1)=MIN(0,MDME(IDC,1))
156 4 PARP(171)=Energy/Maximum
159 C--- only primary quarks and stable particles remain in the event record
162 C RS and allow decays
166 C sum to check that we preserve momentum
179 PXSUM=PXSUM+PX(NDAUG)
180 PYSUM=PYSUM+PY(NDAUG)
181 PZSUM=PZSUM+PZ(NDAUG)
185 IF (ABS(PXSUM).GT.0.001.OR.
186 + ABS(PYSUM).GT.0.001.OR.
187 + ABS(PZSUM).GT.0.001) THEN
190 PRINT *, 'Momentum not conserved in jetset fragmentation:'
191 PRINT *,'dPx:',pxsum,' dPy:',pysum,' dPz:',pzsum
200 C--------------------------------------------------------------------------
203 C This software is part of the EvtGen package developed jointly
204 C for the BaBar and CLEO collaborations. If you use all or part
205 C of it, please give an appropriate acknowledgement.
207 C Copyright Information: See BelEvtGen/COPYRIGHT
208 C Copyright (C) 1998 Caltech, UCSB
214 C Modification history:
216 C DJL/RYD August 11, 1998 Module created
217 C 26-Sep-2002 - RS : changed to PYTHIA
219 C------------------------------------------------------------------------
220 SUBROUTINE PYTHIADEC(IP,M,NDAUG,KF,KM,PX,PY,PZ,E)
223 C interface to JETSET 7.4 to have one particle decayed
224 C including possibly fragmentation, if the decay products include
230 DOUBLE PRECISION PARU,PARJ
231 COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
234 COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5)
239 PARAMETER (NDMAX=100)
244 INTEGER IP,KF(NDMAX),I,NDAUG,KM(NDMAX)
245 INTEGER KP,KID,IPART1,IPART
246 REAL*8 M,PX(NDMAX),PY(NDMAX),PZ(NDMAX),E(NDMAX)
249 DOUBLE PRECISION QMAX
251 C CALL PY1ENT(1,IP,M,0D0,0D0)
262 C RS Particles should not decay at this stage
263 C but remember the previous setting
269 C RS and allow decays
275 C code copied from LUEXEC to avoid error with shower
277 C...Decay products may develop a shower.
278 IF(MSTJ(92).GT.0) THEN
280 QMAX=SQRT(MAX(0.,(P(IP1,4)+P(IP1+1,4))**2-(P(IP1,1)+P(IP1+1,
281 & 1))**2-(P(IP1,2)+P(IP1+1,2))**2-(P(IP1,3)+P(IP1+1,3))**2))
282 CALL PYSHOW(IP1,IP1+1,QMAX)
285 ELSEIF(MSTJ(92).LT.0) THEN
287 CALL PYSHOW(IP1,-3,P(IP,5))
300 c find partons, delete secondary partons, set mother pointers
309 if (abs(kid) .ge. 1 .and. abs(kid) .le. 8
311 2 .or. kid .ge. 91 .and. kid .le. 94) then
312 if (ipart1 .eq. 1) ipart1 = i
314 if (kp .ne. 1) goto 10
317 if (kp .gt. ipart) then
319 elseif (kp .ge. ipart1) then
333 C print '( 2I5,I12,4F12.4 )',ndaug,km(ndaug),kf(ndaug),
334 C 1 px(ndaug),py(ndaug),pz(ndaug),e(ndaug)