+++ /dev/null
-
-CDECK ID>, HWSSPC.
-
-*CMZ :- -26/04/91 11.11.56 by Bryan Webber
-
-*-- Author : Bryan Webber
-
-C-----------------------------------------------------------------------
-
- SUBROUTINE HWSSPC
-
-C-----------------------------------------------------------------------
-
-C REPLACES SPACELIKE PARTONS BY SPECTATORS
-
-C-----------------------------------------------------------------------
-
- INCLUDE 'HERWIG61.INC'
-
- DOUBLE PRECISION HWUSQR,EMSQ,EMTR,EPAR,XPAR,QSQ,PCL(5)
-
- INTEGER KHEP,IP,JP,IDH,IDP,ISP,IDSPC,JHEP
-
- EXTERNAL HWUSQR
-
- IF (IERROR.NE.0) RETURN
-
- DO 50 KHEP=1,NHEP
-
- IF (ISTHEP(KHEP).EQ.145.OR.ISTHEP(KHEP).EQ.146) THEN
-
- IP=ISTHEP(KHEP)-144
-
- JP=IP
-
- IF (JDAHEP(1,IP).NE.0) JP=JDAHEP(1,IP)
-
- IDH=IDHW(JP)
-
- IDP=IDHW(KHEP)
-
- IF (IDH.NE.IDP) THEN
-
- IF (IDH.EQ.59) THEN
-
-C---PHOTON CASE
-
- IF (IDP.LT.7) THEN
-
- IDSPC=IDP+6
-
- ELSEIF (IDP.LT.13) THEN
-
- IDSPC=IDP-6
-
- ELSE
-
- CALL HWWARN('HWSSPC',100,*999)
-
- ENDIF
-
-C---IDENTIFY SPECTATOR
-
-C (1) QUARK CASE
-
- ELSEIF (IDP.LE.3) THEN
-
- DO 10 ISP=1,12
-
- 10 IF (IDH.EQ.NCLDK(LOCN(IDP,ISP))) GOTO 20
-
- CALL HWWARN('HWSSPC',101,*999)
-
- 20 IF (ISP.LE.3) THEN
-
- IDSPC=ISP+6
-
- ELSEIF (ISP.LE.9) THEN
-
- IDSPC=ISP+105
-
- ELSE
-
- IDSPC=ISP
-
- ENDIF
-
-C---(2) ANTIQUARK CASE
-
- ELSEIF (IDP.GT.6.AND.IDP.LE.9) THEN
-
- IDP=IDP-6
-
- DO 30 ISP=1,12
-
- 30 IF (IDH.EQ.NCLDK(LOCN(ISP,IDP))) GOTO 40
-
- CALL HWWARN('HWSSPC',103,*999)
-
- RETURN
-
- 40 IF (ISP.LE.3) THEN
-
- IDSPC=ISP
-
- ELSEIF (ISP.LE.9) THEN
-
- IDSPC=ISP+111
-
- ELSE
-
- IDSPC=ISP-6
-
- ENDIF
-
-C---SPECIAL CASE FOR REMNANT HADRON
-
- ELSEIF (IDH.EQ.71.OR.IDH.EQ.72) THEN
-
- IF (IDP.EQ.13) THEN
-
- IDSPC=IDP
-
- ELSE
-
- CALL HWWARN('HWSSPC',106,*999)
-
- ENDIF
-
- ELSE
-
- CALL HWWARN('HWSSPC',105,*999)
-
- ENDIF
-
-C---REPLACE PARTON BY SPECTATOR
-
- IDHW(KHEP)=IDSPC
-
- IDHEP(KHEP)=IDPDG(IDSPC)
-
- ISTHEP(KHEP)=146+IP
-
- EMSQ=SIGN(PHEP(5,KHEP)**2,PHEP(5,KHEP))
-
- EMTR=EMSQ+PHEP(1,KHEP)**2+PHEP(2,KHEP)**2
-
- EPAR=PHEP(4,KHEP)
-
- CALL HWVDIF(4,PHEP(1,JP),PHEP(1,KHEP),PHEP(1,KHEP))
-
- IF (EPAR**2.LT.10000.*ABS(EMTR)) THEN
-
- CALL HWUMAS(PHEP(1,KHEP))
-
- ELSE
-
-C---COMPUTE SPECTATOR MASS ELIMINATING ROUNDING ERRORS
-
- XPAR=EPAR/PHEP(4,JP)
-
- QSQ=SIGN(PHEP(5,JP)**2,PHEP(5,JP))
-
- PHEP(5,KHEP)=HWUSQR((1.-XPAR)*QSQ+EMSQ-EMTR/XPAR
-
- & -((QSQ*XPAR**2-EMTR)/(2*EPAR*XPAR**2))**2*XPAR)
-
- ENDIF
-
-C---CHECK FOR UNPHYSICAL SPECTATOR
-
- IF (PHEP(4,KHEP).LT.ZERO) FROST=.TRUE.
-
-C---FIND MASS OF CORRESPONDING CLUSTER, IF PARTNER IS IN THE SAME JET
-
- IF (QORQQB(IDHW(KHEP))) THEN
-
- JHEP=JMOHEP(2,KHEP)
-
- ELSEIF (QBORQQ(IDHW(KHEP))) THEN
-
- JHEP=JDAHEP(2,KHEP)
-
- ELSE
-
- JHEP=0
-
- ENDIF
-
- IF (JHEP.GT.0) THEN
-
- CALL HWVSUM(4,PHEP(1,KHEP),PHEP(1,JHEP),PCL)
-
- CALL HWUMAS(PCL)
-
-C---IF IT IS NEGATIVE, REJECT
-
- IF (PCL(5).LT.ZERO) FROST=.TRUE.
-
- ENDIF
-
- ENDIF
-
- ENDIF
-
- 50 CONTINUE
-
- 999 END
-
-CDECK ID>, HWSSUD.
-
-*CMZ :- -26/04/91 11.11.56 by Bryan Webber
-
-*-- Author : Bryan Webber
-
-C-----------------------------------------------------------------------
-
- FUNCTION HWSSUD(I)
-
-C-----------------------------------------------------------------------
-
- INCLUDE 'HERWIG61.INC'
-
- DOUBLE PRECISION HWSSUD,HWSGQQ,DMIN,QSCA,XLAST,DIST(13)
-
- INTEGER I,N0,IS,ID
-
- EXTERNAL HWSGQQ
-
- COMMON/HWTABC/XLAST,N0,IS,ID
-
- DATA DMIN/1.D-15/
-
- QSCA=QEV(N0+I,IS)
-
- CALL HWSFUN(XLAST,QSCA,IDHW(INHAD),NSTRU,DIST,JNHAD)
-
- IF (ID.EQ.13) DIST(ID)=DIST(ID)*HWSGQQ(QSCA)
-
- IF (DIST(ID).LT.DMIN) DIST(ID)=DMIN
-
- HWSSUD=SUD(N0+I,IS)/DIST(ID)
-
- END
git://git.uio.no / u / mrichter / AliRoot.git / blobdiff