CDECK ID>, HWHPPE. *CMZ :- -12/01/93 10.12.43 by Bryan Webber *-- Author : Ian Knowles C----------------------------------------------------------------------- SUBROUTINE HWHPPE C----------------------------------------------------------------------- C point-like photon/QCD heavy flavour single excitation, using exact C massive lightcone kinematics, mean EVWGT = sigma in nb. C----------------------------------------------------------------------- INCLUDE 'HERWIG61.INC' DOUBLE PRECISION HWR,HWRUNI,HWUALF,EPS,PP1,PP2,QM2,FACTR, & PT,PJ,PT2,PTM,EXY,T,CC,EXY2,S,U,C,SIGE,HCS,RCS INTEGER IQ1,IQ2,ID1,ID2,IHAD1,IHAD2 EXTERNAL HWR,HWRUNI,HWUALF SAVE PP1,PP2,IQ1,IQ2,QM2,FACTR,SIGE,HCS PARAMETER (EPS=1.E-9) IHAD1=1 IF (JDAHEP(1,IHAD1).NE.0) IHAD1=JDAHEP(1,IHAD1) IHAD2=2 IF (JDAHEP(1,IHAD2).NE.0) IHAD2=JDAHEP(1,IHAD2) IF (FSTWGT.OR.IHAD1.NE.1.OR.IHAD2.NE.2) THEN PP1=PHEP(4,IHAD1)+ABS(PHEP(3,IHAD1)) PP2=PHEP(4,IHAD2)+ABS(PHEP(3,IHAD2)) XX(1)=1. IQ1=MOD(IPROC,100) IQ2=IQ1+6 QM2=RMASS(IQ1)**2 FACTR=GEV2NB*(YJMAX-YJMIN)*4.*PIFAC*CFFAC*PP1 & *ALPHEM*QFCH(IQ1)**2 ENDIF IF (GENEV) THEN RCS=HCS*HWR() ELSE EVWGT=0. CALL HWRPOW(PT,PJ) PT2=PT**2 PTM=SQRT(PT2+QM2) EXY=EXP(HWRUNI(1,YJMIN,YJMAX)) T=-PP1*PT/EXY CC=T**2-4.*QM2*(PT2+T) IF (CC.LT.ZERO) RETURN EXY2=(2.*PT2+T-SQRT(CC))*PP1/(2.*T*PTM) IF (EXY2.LT.EXP(YJMIN).OR.EXY2.GT.EXP(YJMAX)) RETURN XX(2)=(PT/EXY+PTM/EXY2)/PP2 IF (XX(2).GT.ONE) RETURN C define: S=Shat-M**2, T=That ,U=Uhat-M**2 (2p.Q, -2p.g, -2p.Q') S=XX(2)*PP1*PP2 U=-S-T COSTH=(1.+QM2/S)*(T-U)/S-QM2/S C Set hard process scale (Approx ET-jet) EMSCA=SQRT(2.*S*T*U/(S*S+T*T+U*U)) C=QM2*T/(U*S) SIGE=-FACTR*PT*PJ*HWUALF(1,EMSCA)*(S/U+U/S+4.*C*(1.-C)) & /(S**2*EXY2*PTM*(1-QM2/(XX(2)*PP2*EXY2)**2)) CALL HWSFUN(XX(2),EMSCA,IDHW(IHAD2),NSTRU,DISF(1,2),2) ENDIF HCS=0. ID1=59 C photon+Q ---> g+Q ID2=IQ1 IF (DISF(ID2,2).LT.EPS) GOTO 10 HCS=HCS+SIGE*DISF(ID2,2) IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(13,ID2,1423,51,*99) C photon+Qbar ---> g+Qbar 10 ID2=IQ2 IF (DISF(ID2,2).LT.EPS) GOTO 20 HCS=HCS+SIGE*DISF(ID2,2) IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(13,ID2,1342,52,*99) 20 EVWGT=HCS RETURN C Generate event 99 IDN(1)=ID1 IDN(2)=ID2 IDCMF=15 CALL HWETWO 999 END CDECK ID>, HWHPPH. *CMZ :- -12/01/93 10.12.43 by Bryan Webber *-- Author : Ian Knowles C----------------------------------------------------------------------- SUBROUTINE HWHPPH C----------------------------------------------------------------------- C Point-like photon/gluon heavy flavour pair production, with C exact lightcone massive kinematics, mean EVWGT = sigma in nb. C----------------------------------------------------------------------- INCLUDE 'HERWIG61.INC' DOUBLE PRECISION HWRUNI,HWUALF,EPS,PP1,PP2,QM2,FACTR,ET,EJ,ET2, & EXY,EXY2,S,T,U,C INTEGER IQ1,IHAD1,IHAD2 EXTERNAL HWRUNI,HWUALF SAVE PP1,PP2,IQ1,QM2,FACTR PARAMETER (EPS=1.E-9) IHAD1=1 IF (JDAHEP(1,IHAD1).NE.0) IHAD1=JDAHEP(1,IHAD1) IHAD2=2 IF (JDAHEP(1,IHAD2).NE.0) IHAD2=JDAHEP(1,IHAD2) IF (FSTWGT.OR.IHAD1.NE.1.OR.IHAD2.NE.2) THEN PP1=PHEP(4,IHAD1)+ABS(PHEP(3,IHAD1)) PP2=PHEP(4,IHAD2)+ABS(PHEP(3,IHAD2)) XX(1)=1. IQ1=MOD(IPROC,100) QM2=RMASS(IQ1)**2 IHPRO=53 FACTR=-GEV2NB*(YJMAX-YJMIN)*.5*PIFAC*ALPHEM*QFCH(IQ1)**2 ENDIF IF (GENEV) THEN C Generate event IDN(1)=59 IDN(2)=13 IDN(3)=IQ1 IDN(4)=IQ1+6 ICO(1)=1 ICO(2)=4 ICO(3)=2 ICO(4)=3 IDCMF=15 CALL HWETWO ELSE C Select kinematics EVWGT=0. CALL HWRPOW(ET,EJ) ET2=ET**2 EXY=EXP(HWRUNI(1,YJMIN,YJMAX)) EXY2=2.*PP1/ET-EXY IF (EXY2.LT.EXP(YJMIN).OR.EXY2.GT.EXP(YJMAX)) RETURN XX(2)=.5*ET*(1./EXY+1./EXY2)/PP2 IF (XX(2).LT.ZERO.OR.XX(2).GT.ONE) RETURN S=XX(2)*PP1*PP2 IF (S.LT.ET2) RETURN C define: S=Shat, T=That-M**2, U=Uhat-M**2 (2p.g, -2p.Q, -2p.QBar) T=-.5*PP1*ET/EXY U=-S-T COSTH=(T-U)/(S*SQRT(1.-4.*QM2/S)) EMSCA=SQRT(2.*S*T*U/(S*S+T*T+U*U)) CALL HWSFUN(XX(2),EMSCA,IDHW(IHAD2),NSTRU,DISF(1,2),2) C photon+g ---> Q+Qbar IF (DISF(13,2).LT.EPS) THEN EVWGT=0. ELSE C=QM2*S/(U*T) EVWGT=FACTR*EJ*ET*HWUALF(1,EMSCA) & *DISF(13,2)*(T/U+U/T+4.*C*(1.-C))/(S*T) ENDIF ENDIF 999 END CDECK ID>, HWHPPM. *CMZ :- -09/12/93 15.50.26 by Mike Seymour *-- Author : Ian Knowles & Mike Seymour C----------------------------------------------------------------------- SUBROUTINE HWHPPM C----------------------------------------------------------------------- C Point-like photon/QCD direct meson production C See M. Benayoun, et al., Nucl. Phys. B282 (1987) 653 for details. C mean EVWGT = sigma in nb C----------------------------------------------------------------------- INCLUDE 'HERWIG61.INC' DOUBLE PRECISION HWR,HWRUNI,HWUALF,EPS,PP1,PP2,ET,EJ,EXY,EXY2, & FACT,FACTR,S,T,U,REDS,DELT(3,3),C1STU,C3STU,HCS,RCS,CMIX,SMIX, & C1WVFN,FPI,FETA8,FETA1,FRHO,FPHI8,FPHI1,FPI2,FETA2(3),FETAP2(3), 7 FRHO2,FPHI2(3),FOMEG2(3) INTEGER MNAME(3,3,2),N4(3),I,J,ID2,ID4,I2,I4,M1,M2,IHAD1,IHAD2 LOGICAL SPIN0,SPIN1 EXTERNAL HWR,HWRUNI,HWUALF SAVE FPI2,FETA2,FETAP2,FRHO2,FPHI2,FOMEG2,HCS,REDS,FACT,DELT, & C1STU,C3STU PARAMETER (EPS=1.D-20) DATA MNAME/21,38,42,30,21,34,50,46,0,23,39,43,31,23,35,51,47,0/ DATA N4,SPIN0,SPIN1/3,3,2,.TRUE.,.TRUE./ DATA C1WVFN,FPI,FETA8,FETA1,FRHO,FPHI8,FPHI1/1.,3*0.093,3*0.107/ IF (FSTWGT) THEN FPI2=FPI**2 CMIX=COS(ETAMIX*PIFAC/180.D0) SMIX=SIN(ETAMIX*PIFAC/180.D0) FETA2(1) =(+CMIX*FETA8/SQRT(TWO)-SMIX*FETA1)**2/THREE FETA2(2) =FETA2(1) FETA2(3) =(-CMIX*FETA8*SQRT(TWO)-SMIX*FETA1)**2/THREE FETAP2(1)=(+SMIX*FETA8/SQRT(TWO)+CMIX*FETA1)**2/THREE FETAP2(2)=FETAP2(1) FETAP2(3)=(-SMIX*FETA8*SQRT(TWO)+CMIX*FETA1)**2/THREE FRHO2=FRHO**2 CMIX=COS(PHIMIX*PIFAC/180.D0) SMIX=SIN(PHIMIX*PIFAC/180.D0) FPHI2(1) =(+CMIX*FPHI8/SQRT(TWO)-SMIX*FPHI1)**2/THREE FPHI2(2) =FPHI2(1) FPHI2(3) =(-CMIX*FPHI8*SQRT(TWO)-SMIX*FPHI1)**2/THREE FOMEG2(1)=(+SMIX*FPHI8/SQRT(TWO)+CMIX*FPHI1)**2/THREE FOMEG2(2)=FOMEG2(1) FOMEG2(3)=(-SMIX*FPHI8*SQRT(TWO)+CMIX*FPHI1)**2/THREE ENDIF SPIN0=.NOT.(MOD(IPROC/10,10).EQ.2) SPIN1=.NOT.(MOD(IPROC/10,10).EQ.1) IF (GENEV) THEN RCS=HCS*HWR() ELSE EVWGT=ZERO IHAD1=1 IF (JDAHEP(1,IHAD1).NE.0) IHAD1=JDAHEP(1,IHAD1) IHAD2=2 IF (JDAHEP(1,IHAD2).NE.0) IHAD2=JDAHEP(1,IHAD2) PP1=PHEP(4,IHAD1)+ABS(PHEP(3,IHAD1)) PP2=PHEP(4,IHAD2)+ABS(PHEP(3,IHAD2)) XX(1)=ONE CALL HWRPOW(ET,EJ) EXY=EXP(HWRUNI(1,YJMIN,YJMAX)) EXY2=TWO*PP1/ET-EXY IF (EXY2.LE.EXP(YJMIN).OR.EXY2.GE.EXP(YJMAX)) RETURN XX(2)=PP1/(PP2*EXY*EXY2) IF (XX(2).LE.ZERO.OR.XX(2).GE.ONE) RETURN S=XX(2)*PP1*PP2 REDS=SQRT(S-ET*SQRT(S)) T=-HALF*PP1*ET/EXY U=-S-T COSTH=(T-U)/S C Set EMSCA to hard process scale (Approx ET-jet) EMSCA=SQRT(TWO*S*T*U/(S*S+T*T+U*U)) FACT=-GEV2NB*ET*EJ*(YJMAX-YJMIN)*ALPHEM*CFFAC & *(HWUALF(1,EMSCA)*PIFAC*C1WVFN)**2*32.D0/(THREE*S*T) CALL HWSFUN(XX(2),EMSCA,IDHW(IHAD2),NSTRU,DISF(1,2),2) DO 10 I=1,3 DO 10 J=1,3 10 DELT(I,J)=(QFCH(I)*U+QFCH(J)*S)**2 C1STU=-(S**2+U**2)/(T*S**2*U**2) C3STU=-8.D0*T/(S**2*U**2) ENDIF HCS=ZERO DO 50 I2=1,3 C Quark initiated processes ID2=I2 IF (DISF(ID2,2).LT.EPS) GOTO 30 DO 20 ID4=1,N4(I2) M1=MNAME(ID2,ID4,1) FACTR=FACT*DELT(ID2,ID4)*DISF(ID2,2) IF (ID2.EQ.ID4) FACTR=HALF*FACTR IF (SPIN0.AND.REDS.GT.RMASS(M1)) THEN C photon+q --> meson_0+q' HCS=HCS+HALF*FACTR*C1STU*FPI2 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(M1,ID4,1432,71,*99) ENDIF M2=MNAME(ID2,ID4,2) IF (SPIN1.AND.REDS.GT.RMASS(M2)) THEN C photon+q --> meson_L+q' HCS=HCS+FACTR*C1STU*FRHO2 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(M2,ID4,1432,72,*99) C photon+q --> meson_T+q' HCS=HCS+FACTR*C3STU*FRHO2 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(M2,ID4,1432,73,*99) ENDIF 20 CONTINUE FACTR=FACT*DELT(I2,I2)*DISF(ID2,2) IF (SPIN0.AND.REDS.GT.RMASS(22)) THEN C photon+q -->eta+q HCS=HCS+HALF*FACTR*C1STU*FETA2(I2) IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(22,ID2,1432,71,*99) ENDIF IF (SPIN0.AND.REDS.GT.RMASS(25)) THEN C photon+q -->eta'+q HCS=HCS+HALF*FACTR*C1STU*FETAP2(I2) IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(25,ID2,1432,71,*99) ENDIF IF (SPIN1.AND.REDS.GT.RMASS(56)) THEN C photon+q -->phi_L+q HCS=HCS+FACTR*C1STU*FPHI2(I2) IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(56,ID2,1432,72,*99) C photon+q -->phi_T+q HCS=HCS+FACTR*C3STU*FPHI2(I2) IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(56,ID2,1432,73,*99) ENDIF IF (SPIN1.AND.REDS.GT.RMASS(24)) THEN C photon+q -->omega_L+q HCS=HCS+FACTR*C1STU*FOMEG2(I2) IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(24,ID2,1432,72,*99) C photon+q -->omega_T+q HCS=HCS+FACTR*C3STU*FOMEG2(I2) IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(24,ID2,1432,73,*99) ENDIF C Anti-quark initiated processes 30 ID2=I2+6 IF (DISF(ID2,2).LT.EPS) GOTO 50 DO 40 I4=1,N4(I2) ID4=I4+6 FACTR=FACT*DELT(I2,I4)*DISF(ID2,2) IF (ID2.EQ.ID4) FACTR=HALF*FACTR M1=MNAME(I4,I2,1) IF (SPIN0.AND.REDS.GT.RMASS(M1)) THEN C photon+qbar --> meson_0+qbar' HCS=HCS+HALF*FACTR*C1STU*FPI2 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(M1,ID4,1432,74,*99) ENDIF M2=MNAME(I4,I2,2) IF (SPIN1.AND.REDS.GT.RMASS(M2)) THEN C photon+qbar --> meson_L+qbar' HCS=HCS+FACTR*C1STU*FRHO2 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(M2,ID4,1432,75,*99) C photon+qbar --> meson_T+qbar' HCS=HCS+FACTR*C3STU*FRHO2 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(M2,ID4,1432,76,*99) ENDIF 40 CONTINUE FACTR=FACT*DELT(I2,I2)*DISF(ID2,2) IF (SPIN0.AND.REDS.GT.RMASS(22)) THEN C photon+qbar -->eta+qbar HCS=HCS+HALF*FACTR*C1STU*FETA2(I2) IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(22,ID2,1432,74,*99) ENDIF IF (SPIN0.AND.REDS.GT.RMASS(25)) THEN C photon+qbar -->eta'+qbar HCS=HCS+HALF*FACTR*C1STU*FETAP2(I2) IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(25,ID2,1432,74,*99) ENDIF IF (SPIN1.AND.REDS.GT.RMASS(56)) THEN C photon+qbar -->phi_L+qbar HCS=HCS+FACTR*C1STU*FPHI2(I2) IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(56,ID2,1432,75,*99) C photon+qbar -->phi_T+qbar HCS=HCS+FACTR*C3STU*FPHI2(I2) IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(56,ID2,1432,76,*99) ENDIF IF (SPIN1.AND.REDS.GT.RMASS(24)) THEN C photon+qbar -->omega_L+qbar HCS=HCS+FACTR*C1STU*FOMEG2(I2) IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(24,ID2,1432,75,*99) C photon+qbar -->omega_T+qbar HCS=HCS+FACTR*C3STU*FOMEG2(I2) IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(24,ID2,1432,76,*99) ENDIF 50 CONTINUE EVWGT=HCS RETURN C Generate event 99 IDN(1)=59 IDN(2)=ID2 IDCMF=15 CALL HWETWO C Set polarization vector IF (IHPRO.EQ.72.OR.IHPRO.EQ.75) THEN RHOHEP(2,NHEP-1)=ONE ELSEIF (IHPRO.EQ.73.OR.IHPRO.EQ.76) THEN RHOHEP(1,NHEP-1)=HALF RHOHEP(3,NHEP-1)=HALF ENDIF 999 END CDECK ID>, HWHPPT. *CMZ :- -12/01/93 10.12.43 by Bryan Webber *-- Author : Ian Knowles C----------------------------------------------------------------------- SUBROUTINE HWHPPT C----------------------------------------------------------------------- C point-like photon/QCD di-jet production: mean EVWGT = sigma in nb C----------------------------------------------------------------------- INCLUDE 'HERWIG61.INC' DOUBLE PRECISION HWR,HWRUNI,HWUALF,EPS,RCS,PP1,PP2,ET,EJ, & EXY,EXY2,FACTR,RS,S,T,U,CSTU,CTSU,HCS INTEGER ID1,ID2,ID3,ID4,IHAD1,IHAD2 EXTERNAL HWR,HWRUNI,HWUALF SAVE CSTU,CTSU,HCS,FACTR,RS PARAMETER (EPS=1.E-9) IHAD1=1 IF (JDAHEP(1,IHAD1).NE.0) IHAD1=JDAHEP(1,IHAD1) IHAD2=2 IF (JDAHEP(1,IHAD2).NE.0) IHAD2=JDAHEP(1,IHAD2) IF (GENEV) THEN RCS=HCS*HWR() ELSE EVWGT=0. PP1=PHEP(4,IHAD1)+ABS(PHEP(3,IHAD1)) PP2=PHEP(4,IHAD2)+ABS(PHEP(3,IHAD2)) XX(1)=1. CALL HWRPOW(ET,EJ) EXY=EXP(HWRUNI(1,YJMIN,YJMAX)) EXY2=2.*PP1/ET-EXY IF (EXY2.LE.EXP(YJMIN).OR.EXY2.GE.EXP(YJMAX)) RETURN XX(2)=PP1/(PP2*EXY*EXY2) IF (XX(2).LE.ZERO.OR.XX(2).GE.ONE) RETURN S=XX(2)*PP1*PP2 RS=.5*SQRT(S) T=-PP1*0.5*ET/EXY U=-S-T COSTH=(T-U)/S C Set EMSCA to hard process scale (Approx ET-jet) EMSCA=SQRT(2.*S*T*U/(S*S+T*T+U*U)) FACTR=-GEV2NB*0.5*EJ*(YJMAX-YJMIN)*ET*PIFAC*ALPHEM & *HWUALF(1,EMSCA)/(S*T) CALL HWSFUN(XX(2),EMSCA,IDHW(IHAD2),NSTRU,DISF(1,2),2) CSTU=U/T+T/U CTSU=-2.*CFFAC*(U/S+S/U) ENDIF HCS=0. ID1=59 DO 20 ID2=1,13 IF (DISF(ID2,2).LT.EPS) GOTO 20 IF (ID2.LT.7) THEN C photon+q ---> g+q HCS=HCS+CTSU*DISF(ID2,2)*QFCH(ID2)**2 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP( 13,ID2,1423,51,*99) ELSEIF (ID2.LT.13) THEN C photon+qbar ---> g+qbar HCS=HCS+CTSU*DISF(ID2,2)*QFCH(ID2-6)**2 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP( 13,ID2,1342,52,*99) ELSE C photon+g ---> q+qbar DO 10 ID3=1,6 IF (RS.GT.RMASS(ID3)) THEN ID4=ID3+6 HCS=HCS+CSTU*DISF(ID2,2)*QFCH(ID3)**2 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID3,ID4,1423,53,*99) ENDIF 10 CONTINUE ENDIF 20 CONTINUE EVWGT=FACTR*HCS RETURN C Generate event 99 IDN(1)=ID1 IDN(2)=ID2 IDCMF=15 CALL HWETWO 999 END CDECK ID>, HWHPQS. *CMZ :- -27/03/95 13.27.22 by Mike Seymour *-- Author : Ian Knowles C----------------------------------------------------------------------- SUBROUTINE HWHPQS C----------------------------------------------------------------------- C Compton scattering of point-like photon and (anti)quark C mean EVWGT = sigma in nb C----------------------------------------------------------------------- INCLUDE 'HERWIG61.INC' DOUBLE PRECISION HWR,HWRUNI,EPS,RCS,PP1,PP2,ET,EJ,EXY,EXY2, & FACTR,S,T,U,CTSU,HCS INTEGER ID1,ID2,IHAD1,IHAD2 EXTERNAL HWR,HWRUNI SAVE CTSU,HCS,FACTR PARAMETER (EPS=1.E-9) IHAD1=1 IF (JDAHEP(1,IHAD1).NE.0) IHAD1=JDAHEP(1,IHAD1) IHAD2=2 IF (JDAHEP(1,IHAD2).NE.0) IHAD2=JDAHEP(1,IHAD2) IF (GENEV) THEN RCS=HCS*HWR() ELSE EVWGT=0. PP1=PHEP(4,IHAD1)+ABS(PHEP(3,IHAD1)) PP2=PHEP(4,IHAD2)+ABS(PHEP(3,IHAD2)) XX(1)=1. CALL HWRPOW(ET,EJ) EXY=EXP(HWRUNI(1,YJMIN,YJMAX)) EXY2=2.*PP1/ET-EXY IF (EXY2.LE.EXP(YJMIN).OR.EXY2.GE.EXP(YJMAX)) RETURN XX(2)=PP1/(PP2*EXY*EXY2) IF (XX(2).LE.ZERO.OR.XX(2).GE.ONE) RETURN S=XX(2)*PP1*PP2 T=-PP1*0.5*ET/EXY U=-S-T COSTH=(T-U)/S C Set EMSCA to hard process scale (Approx ET-jet) EMSCA=SQRT(2.*S*T*U/(S*S+T*T+U*U)) FACTR=-GEV2NB*0.5*EJ*(YJMAX-YJMIN)*ET*PIFAC*ALPHEM**2/(S*T) CALL HWSFUN(XX(2),EMSCA,IDHW(IHAD2),NSTRU,DISF(1,2),2) CTSU=-2.*(U/S+S/U) ENDIF HCS=0. ID1=59 DO 20 ID2=1,12 IF (DISF(ID2,2).LT.EPS) GOTO 20 IF (ID2.LT.7) THEN C photon+q ---> photon+q HCS=HCS+CTSU*DISF(ID2,2)*QFCH(ID2)**4 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP( 59,ID2,1432,66,*99) ELSE C photon+qbar ---> photon+qbar HCS=HCS+CTSU*DISF(ID2,2)*QFCH(ID2-6)**4 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP( 59,ID2,1432,67,*99) ENDIF 20 CONTINUE EVWGT=FACTR*HCS RETURN C Generate event 99 IDN(1)=ID1 IDN(2)=ID2 IDCMF=15 CALL HWETWO 999 END CDECK ID>, HWHQCD. *CMZ :- -20/05/99 12.39.45 by Kosuke Odagiri *-- Author : Bryan Webber C----------------------------------------------------------------------- SUBROUTINE HWHQCD C----------------------------------------------------------------------- C QCD HARD 2->2 PROCESSES: MEAN EVWGT = SIGMA IN NB C----------------------------------------------------------------------- INCLUDE 'HERWIG61.INC' DOUBLE PRECISION HWR,HWRUNI,HWUALF,RS,EPS,HF,RCS,Z1,Z2,ET,EJ, & FACTR,S,T,U,ST,TU,US,STU,TUS,UST,EN,RN,GFLA,AF,ASTU,ASUT,AUST, & BF,BSTU,BSUT,BUST,BUTS,CF,CSTU,CSUT,CTSU,CTUS,DF,DSTU,DTSU,DUTS, & DIST,HCS,UT,SU,GT,KK,KK2,YJ1INF,YJ1SUP,YJ2INF,YJ2SUP INTEGER ID1,ID2,I EXTERNAL HWR,HWRUNI,HWUALF SAVE HCS,ASTU,AUST,BSTU,BSUT,BUST,BUTS,CSTU,CSUT,CTSU,CTUS, & DSTU,DTSU,DUTS,GFLA,RCS,S,T,TU,U,US PARAMETER (EPS=1.E-9,HF=0.5) IF (GENEV) THEN RCS=HCS*HWR() ELSE EVWGT=0. CALL HWRPOW(ET,EJ) KK = ET/PHEP(5,3) KK2=KK**2 IF (KK.GE.ONE) RETURN YJ1INF = MAX( YJMIN, LOG((ONE-SQRT(ONE-KK2))/KK) ) YJ1SUP = MIN( YJMAX, LOG((ONE+SQRT(ONE-KK2))/KK) ) IF (YJ1INF.GE.YJ1SUP) RETURN Z1=EXP(HWRUNI(1,YJ1INF,YJ1SUP)) YJ2INF = MAX( YJMIN, -LOG(TWO/KK-ONE/Z1) ) YJ2SUP = MIN( YJMAX, LOG(TWO/KK-Z1) ) IF (YJ2INF.GE.YJ2SUP) RETURN Z2=EXP(HWRUNI(2,YJ2INF,YJ2SUP)) XX(1)=.5*(Z1+Z2)*KK IF (XX(1).GE.ONE) RETURN XX(2)=XX(1)/(Z1*Z2) IF (XX(2).GE.ONE) RETURN COSTH=(Z1-Z2)/(Z1+Z2) S=XX(1)*XX(2)*PHEP(5,3)**2 RS=HF*SQRT(S) DO 3 I=1,NFLAV IF (RS.LT.RMASS(I)) GOTO 4 3 CONTINUE I=NFLAV+1 4 MAXFL=I-1 IF (MAXFL.EQ.0) CALL HWWARN('HWHQCD',100,*999) C T=-HF*S*(1.-COSTH) U=-S-T C---SET EMSCA TO HARD PROCESS SCALE (APPROX ET-JET) EMSCA=SQRT(2.*S*T*U/(S*S+T*T+U*U)) FACTR = GEV2NB*.5*PIFAC*EJ*ET*(HWUALF(1,EMSCA)/S)**2 & * (YJ1SUP-YJ1INF)*(YJ2SUP-YJ2INF) CALL HWSGEN(.FALSE.) C ST=S/T TU=T/U US=U/S STU=TU/US TUS=US/ST UST=ST/TU C EN=CAFAC RN=CFFAC/EN GFLA=HF*FLOAT(MAXFL)/(EN*RN)**2 AF=FACTR*RN ASTU=AF*(1.-2.*UST) ASUT=AF*(1.-2.*STU) AUST=AF*(1.-2.*TUS) C----------------------------------------------------------------------- C---Colour decomposition modifications below (KO) C----------------------------------------------------------------------- BF=HF-AF/EN/TUS/(ASTU+ASUT) BSTU=BF*ASTU BSUT=BF*ASUT BF=ONE-TWO*AF/EN/STU/(AUST+ASTU) BUST=BF*AUST BUTS=BF*ASTU C----------------------------------------------------------------------- C BF=2.*AF/EN C BSTU=HF*(ASTU+BF*ST) C BSUT=HF*(ASUT+BF/US) C BUST=AUST+BF*US C BUTS=ASTU+BF/TU C----------------------------------------------------------------------- CF=AF*EN CSTU=(CF*(RN-TUS))/TU CSUT=(CF*(RN-TUS))*TU CTSU=(FACTR*(UST-RN))*US CTUS=(FACTR*(UST-RN))/US DF=HF*FACTR/RN DSTU=DF*(1.+1./TUS-STU-UST) DTSU=DF*(1.+1./UST-STU-TUS) DUTS=DF*(1.+1./STU-UST-TUS) ENDIF C HCS=0. DO 6 ID1=1,13 IF (DISF(ID1,1).LT.EPS) GOTO 6 DO 5 ID2=1,13 IF (DISF(ID2,2).LT.EPS) GOTO 5 DIST=DISF(ID1,1)*DISF(ID2,2) IF (ID1.LT.7) THEN C---QUARK FIRST IF (ID2.LT.7) THEN IF (ID1.NE.ID2) THEN HCS=HCS+ASTU*DIST IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID1,ID2,3421, 3,*9) ELSE HCS=HCS+BSTU*DIST IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID1,ID2,3421, 1,*9) HCS=HCS+BSUT*DIST IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID1,ID2,4312, 2,*9) ENDIF ELSEIF (ID2.NE.13) THEN IF (ID2.NE.ID1+6) THEN HCS=HCS+ASTU*DIST IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID1,ID2,3142, 9,*9) ELSE HCS=HCS+FLOAT(MAXFL-1)*AUST*DIST IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(-ID1, 0,2413, 4,*9) HCS=HCS+BUTS*DIST IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID1,ID2,3142, 5,*9) HCS=HCS+BUST*DIST IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID1,ID2,2413, 6,*9) HCS=HCS+CSTU*DIST IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP( 13, 13,2413, 7,*9) HCS=HCS+CSUT*DIST IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP( 13, 13,2341, 8,*9) ENDIF ELSE HCS=HCS+CTSU*DIST IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID1,ID2,3142,10,*9) HCS=HCS+CTUS*DIST IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID1,ID2,3421,11,*9) ENDIF ELSEIF (ID1.NE.13) THEN C---QBAR FIRST IF (ID2.LT.7) THEN IF (ID1.NE.ID2+6) THEN HCS=HCS+ASTU*DIST IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID1,ID2,2413,17,*9) ELSE HCS=HCS+FLOAT(MAXFL-1)*AUST*DIST IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(-ID1, 0,3142,12,*9) HCS=HCS+BUTS*DIST IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID1,ID2,2413,13,*9) HCS=HCS+BUST*DIST IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID1,ID2,3142,14,*9) HCS=HCS+CSTU*DIST IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP( 13, 13,3142,15,*9) HCS=HCS+CSUT*DIST IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP( 13, 13,4123,16,*9) ENDIF ELSEIF (ID2.NE.13) THEN IF (ID1.NE.ID2) THEN HCS=HCS+ASTU*DIST IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID1,ID2,4312,20,*9) ELSE HCS=HCS+BSTU*DIST IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID1,ID2,4312,18,*9) HCS=HCS+BSUT*DIST IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID1,ID2,3421,19,*9) ENDIF ELSE HCS=HCS+CTSU*DIST IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID1,ID2,2413,21,*9) HCS=HCS+CTUS*DIST IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID1,ID2,4312,22,*9) ENDIF ELSE C---GLUON FIRST IF (ID2.LT.7) THEN HCS=HCS+CTSU*DIST IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID1,ID2,2413,23,*9) HCS=HCS+CTUS*DIST IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID1,ID2,3421,24,*9) ELSEIF (ID2.LT.13) THEN HCS=HCS+CTSU*DIST IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID1,ID2,3142,25,*9) HCS=HCS+CTUS*DIST IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID1,ID2,4312,26,*9) ELSE HCS=HCS+GFLA*CSTU*DIST IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP( 0, 0,2413,27,*9) HCS=HCS+GFLA*CSUT*DIST IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP( 0, 0,4123,28,*9) HCS=HCS+DTSU*DIST IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID1,ID2,2341,29,*9) HCS=HCS+DSTU*DIST IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID1,ID2,3421,30,*9) HCS=HCS+DUTS*DIST IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID1,ID2,2413,31,*9) ENDIF ENDIF 5 CONTINUE 6 CONTINUE EVWGT=HCS RETURN C---GENERATE EVENT 9 IDN(1)=ID1 IDN(2)=ID2 IDCMF=15 CALL HWETWO IF (AZSPIN) THEN C Calculate coefficients for constructing spin density matrices IF (IHPRO.EQ.7 .OR.IHPRO.EQ.8 .OR. & IHPRO.EQ.15.OR.IHPRO.EQ.16) THEN C qqbar-->gg or qbarq-->gg UT=1./TU GCOEF(1)=UT+TU GCOEF(2)=-2. GCOEF(3)=0. GCOEF(4)=0. GCOEF(5)=GCOEF(1) GCOEF(6)=UT-TU GCOEF(7)=-GCOEF(6) ELSEIF (IHPRO.EQ.10.OR.IHPRO.EQ.11.OR. & IHPRO.EQ.21.OR.IHPRO.EQ.22.OR. & IHPRO.EQ.23.OR.IHPRO.EQ.24.OR. & IHPRO.EQ.25.OR.IHPRO.EQ.26) THEN C qg-->qg or qbarg-->qbarg or gq-->gq or gqbar-->gqbar SU=1./US GCOEF(1)=-(SU+US) GCOEF(2)=0. GCOEF(3)=2. GCOEF(4)=0. GCOEF(5)=SU-US GCOEF(6)=GCOEF(1) GCOEF(7)=-GCOEF(5) ELSEIF (IHPRO.EQ.27.OR.IHPRO.EQ.28) THEN C gg-->qqbar UT=1./TU GCOEF(1)=TU+UT GCOEF(2)=-2. GCOEF(3)=0. GCOEF(4)=0. GCOEF(5)=GCOEF(1) GCOEF(6)=TU-UT GCOEF(7)=-GCOEF(6) ELSEIF (IHPRO.EQ.29.OR.IHPRO.EQ.30.OR. & IHPRO.EQ.31) THEN C gg-->gg GT=S*S+T*T+U*U GCOEF(2)=2.*U*U*T*T GCOEF(3)=2.*S*S*U*U GCOEF(4)=2.*S*S*T*T GCOEF(1)=GT*GT-GCOEF(2)-GCOEF(3)-GCOEF(4) GCOEF(5)=GT*(GT-2.*S*S)-GCOEF(2) GCOEF(6)=GT*(GT-2.*T*T)-GCOEF(3) GCOEF(7)=GT*(GT-2.*U*U)-GCOEF(4) ELSE CALL HWVZRO(7,GCOEF) ENDIF ENDIF 999 END CDECK ID>, HWHQCP. *CMZ :- -26/04/91 10.18.57 by Bryan Webber *-- Author : Bryan Webber C----------------------------------------------------------------------- SUBROUTINE HWHQCP(ID3,ID4,IPERM,IHPR,*) C----------------------------------------------------------------------- C IDENTIFIES HARD SUBPROCESS C----------------------------------------------------------------------- INCLUDE 'HERWIG61.INC' INTEGER HWRINT,ID3,ID4,IPERM,IHPR,ND3 EXTERNAL HWRINT IHPRO=IHPR IF (ID3.GT.0) THEN IDN(3)=ID3 IDN(4)=ID4 ELSE ND3=-ID3 IF (ID3.GT.-7) THEN 1 IDN(3)=HWRINT(1,MAXFL) IF (IDN(3).EQ.ND3) GOTO 1 IDN(4)=IDN(3)+6 ELSE 2 IDN(3)=HWRINT(1,MAXFL)+6 IF (IDN(3).EQ.ND3) GOTO 2 IDN(4)=IDN(3)-6 ENDIF ENDIF ICO(1)=IPERM/1000 ICO(2)=IPERM/100-10*ICO(1) ICO(3)=IPERM/10 -10*(IPERM/100) ICO(4)=IPERM -10*(IPERM/10) RETURN 1 END