pythiaeRHIC/pythia/pyupre.f

0001
0002 C*********************************************************************
0003
0004 C...PYUPRE
0005 C...Rearranges contents of the HEPEUP commonblock so that
0006 C...mothers precede daughters and daughters of a decay are
0007 C...listed consecutively.
0008
0009       SUBROUTINE PYUPRE
0010
0011 C...Double precision and integer declarations.
0012       IMPLICIT DOUBLE PRECISION(A-H, O-Z)
0013       IMPLICIT INTEGER(I-N)
0014
0015 C...User process event common block.
0016       INTEGER MAXNUP
0017       PARAMETER (MAXNUP=500)
0018       INTEGER NUP,IDPRUP,IDUP,ISTUP,MOTHUP,ICOLUP
0019       DOUBLE PRECISION XWGTUP,SCALUP,AQEDUP,AQCDUP,PUP,VTIMUP,SPINUP
0020       COMMON/HEPEUP/NUP,IDPRUP,XWGTUP,SCALUP,AQEDUP,AQCDUP,IDUP(MAXNUP),
0021      &ISTUP(MAXNUP),MOTHUP(2,MAXNUP),ICOLUP(2,MAXNUP),PUP(5,MAXNUP),
0022      &VTIMUP(MAXNUP),SPINUP(MAXNUP)
0023       SAVE /HEPEUP/
0024
0025 C...Local arrays.
0026       DIMENSION NEWPOS(0:MAXNUP),IDUPT(MAXNUP),ISTUPT(MAXNUP),
0027      &MOTUPT(2,MAXNUP),ICOUPT(2,MAXNUP),PUPT(5,MAXNUP),
0028      &VTIUPT(MAXNUP),SPIUPT(MAXNUP)
0029
0030 C...Check whether a rearrangement is required.
0031       NEED=0
0032       DO 100 IUP=1,NUP
0033         IF(MOTHUP(1,IUP).GT.IUP) NEED=NEED+1
0034   100 CONTINUE
0035       DO 110 IUP=2,NUP
0036         IF(MOTHUP(1,IUP).LT.MOTHUP(1,IUP-1)) NEED=NEED+1
0037   110 CONTINUE
0038
0039       IF(NEED.NE.0) THEN
0040 C...Find the new order that particles should have.
0041         NEWPOS(0)=0
0042         NNEW=0
0043         INEW=-1
0044   120   INEW=INEW+1
0045         DO 130 IUP=1,NUP
0046           IF(MOTHUP(1,IUP).EQ.NEWPOS(INEW)) THEN
0047             NNEW=NNEW+1
0048             NEWPOS(NNEW)=IUP
0049           ENDIF
0050   130   CONTINUE
0051         IF(INEW.LT.NNEW.AND.INEW.LT.NUP) GOTO 120
0052         IF(NNEW.NE.NUP) THEN
0053           CALL PYERRM(2,
0054      &    '(PYUPRE:) failed to make sense of mother pointers in HEPEUP')
0055           RETURN
0056         ENDIF
0057
0058 C...Copy old info into temporary storage.
0059         DO 150 I=1,NUP
0060           IDUPT(I)=IDUP(I)
0061           ISTUPT(I)=ISTUP(I)
0062           MOTUPT(1,I)=MOTHUP(1,I)
0063           MOTUPT(2,I)=MOTHUP(2,I)
0064           ICOUPT(1,I)=ICOLUP(1,I)
0065           ICOUPT(2,I)=ICOLUP(2,I)
0066           DO 140 J=1,5
0067             PUPT(J,I)=PUP(J,I)
0068   140     CONTINUE
0069           VTIUPT(I)=VTIMUP(I)
0070           SPIUPT(I)=SPINUP(I)
0071   150   CONTINUE
0072
0073 C...Copy info back into HEPEUP in right order.
0074         DO 180 I=1,NUP
0075           IOLD=NEWPOS(I)
0076           IDUP(I)=IDUPT(IOLD)
0077           ISTUP(I)=ISTUPT(IOLD)
0078           MOTHUP(1,I)=0
0079           MOTHUP(2,I)=0
0080           DO 160 IMOT=1,I-1
0081             IF(MOTUPT(1,IOLD).EQ.NEWPOS(IMOT)) MOTHUP(1,I)=IMOT
0082             IF(MOTUPT(2,IOLD).EQ.NEWPOS(IMOT)) MOTHUP(2,I)=IMOT
0083   160     CONTINUE
0084           IF(MOTHUP(2,I).GT.0.AND.MOTHUP(2,I).LT.MOTHUP(1,I)) THEN
0085             MOTHSW=MOTHUP(1,I)
0086             MOTHUP(1,I)=MOTHUP(2,I)
0087             MOTHUP(2,I)=MOTHSW
0088           ENDIF
0089           ICOLUP(1,I)=ICOUPT(1,IOLD)
0090           ICOLUP(2,I)=ICOUPT(2,IOLD)
0091           DO 170 J=1,5
0092             PUP(J,I)=PUPT(J,IOLD)
0093   170     CONTINUE
0094           VTIMUP(I)=VTIUPT(IOLD)
0095           SPINUP(I)=SPIUPT(IOLD)
0096   180   CONTINUE
0097       ENDIF
0098
0099 c...If incoming particles are massive recalculate to put them massless.
0100       IF(PUP(5,1).NE.0D0.OR.PUP(5,2).NE.0D0) THEN
0101         PPLUS=(PUP(4,1)+PUP(3,1))+(PUP(4,2)+PUP(3,2))
0102         PMINUS=(PUP(4,1)-PUP(3,1))+(PUP(4,2)-PUP(3,2))
0103         PUP(4,1)=0.5D0*PPLUS
0104         PUP(3,1)=PUP(4,1)
0105         PUP(5,1)=0D0
0106         PUP(4,2)=0.5D0*PMINUS
0107         PUP(3,2)=-PUP(4,2)
0108         PUP(5,2)=0D0
0109       ENDIF
0110
0111       RETURN
0112       END