pythiaeRHIC/pythia/pyadsh.f

0001
0002 C*********************************************************************
0003
0004 C...PYADSH
0005 C...Administers the generation of successive final-state showers
0006 C...in external processes.
0007
0008       SUBROUTINE PYADSH(NFIN)
0009
0010 C...Double precision and integer declarations.
0011       IMPLICIT DOUBLE PRECISION(A-H, O-Z)
0012       IMPLICIT INTEGER(I-N)
0013       INTEGER PYK,PYCHGE,PYCOMP
0014 C...Parameter statement for maximum size of showers.
0015       PARAMETER (MAXNUR=1000)
0016 C...Commonblocks.
0017       COMMON/PYPART/NPART,NPARTD,IPART(MAXNUR),PTPART(MAXNUR)
0018       COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5)
0019       COMMON/PYCTAG/NCT,MCT(4000,2)
0020       COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
0021       COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200)
0022       COMMON/PYINT1/MINT(400),VINT(400)
0023       SAVE /PYPART/,/PYJETS/,/PYCTAG/,/PYDAT1/,/PYPARS/,/PYINT1/
0024 C...Local array.
0025       DIMENSION IBEG(100),KSAV(100,5),PSUM(4),BETA(3)
0026
0027 C...Set primary vertex.
0028       DO 100 J=1,5
0029         V(MINT(83)+5,J)=0D0
0030         V(MINT(83)+6,J)=0D0
0031         V(MINT(84)+1,J)=0D0
0032         V(MINT(84)+2,J)=0D0
0033   100 CONTINUE
0034
0035 C...Isolate systems of particles with the same mother.
0036       NSYS=0
0037       IMS=-1
0038       DO 140 I=MINT(84)+3,NFIN
0039         IM=K(I,3)
0040         IF(IM.GT.0.AND.IM.LE.MINT(84)) IM=K(IM,3)
0041         IF(IM.NE.IMS) THEN
0042           NSYS=NSYS+1
0043           IBEG(NSYS)=I
0044           IMS=IM
0045         ENDIF
0046
0047 C...Set production vertices.
0048         IF(IM.LE.MINT(83)+6.OR.(IM.GT.MINT(84).AND.IM.LE.MINT(84)+2))
0049      &  THEN
0050           DO 110 J=1,4
0051             V(I,J)=0D0
0052   110     CONTINUE
0053         ELSE
0054           DO 120 J=1,4
0055             V(I,J)=V(IM,J)+V(IM,5)*P(IM,J)/P(IM,5)
0056   120     CONTINUE
0057         ENDIF
0058         IF(MSTP(125).GE.1) THEN
0059           IDOC=I-MSTP(126)+4
0060           DO 130 J=1,5
0061             V(IDOC,J)=V(I,J)
0062   130     CONTINUE
0063         ENDIF
0064   140 CONTINUE
0065
0066 C...End loop over systems. Return if no showers to be performed.
0067       IBEG(NSYS+1)=NFIN+1
0068       IF(MSTP(71).LE.0) RETURN
0069
0070 C...Loop through systems of particles; check that sensible size.
0071       DO 270 ISYS=1,NSYS
0072         NSIZ=IBEG(ISYS+1)-IBEG(ISYS)
0073         IF(MINT(35).LE.1) THEN
0074           IF(NSIZ.EQ.1.AND.ISYS.EQ.1) THEN
0075             GOTO 270
0076           ELSEIF(NSIZ.LE.1) THEN
0077             CALL PYERRM(2,'(PYADSH:) only one particle in system')
0078             GOTO 270
0079           ELSEIF(NSIZ.GT.80) THEN
0080             CALL PYERRM(2,'(PYADSH:) more than 80 particles in system')
0081             GOTO 270
0082           ENDIF
0083         ENDIF
0084
0085 C...Save status codes and daughters of showering particles; reset them.
0086         DO 150 J=1,4
0087           PSUM(J)=0D0
0088   150   CONTINUE
0089         DO 170 II=1,NSIZ
0090           I=IBEG(ISYS)-1+II
0091           KSAV(II,1)=K(I,1)
0092           IF(K(I,1).GT.10) THEN
0093             K(I,1)=1
0094             IF(KSAV(II,1).EQ.14) K(I,1)=3
0095           ENDIF
0096           IF(KSAV(II,1).LE.10) THEN
0097           ELSEIF(K(I,1).EQ.1) THEN
0098             KSAV(II,4)=K(I,4)
0099             KSAV(II,5)=K(I,5)
0100             K(I,4)=0
0101             K(I,5)=0
0102           ELSE
0103             KSAV(II,4)=MOD(K(I,4),MSTU(5))
0104             KSAV(II,5)=MOD(K(I,5),MSTU(5))
0105             K(I,4)=K(I,4)-KSAV(II,4)
0106             K(I,5)=K(I,5)-KSAV(II,5)
0107           ENDIF
0108           DO 160 J=1,4
0109             PSUM(J)=PSUM(J)+P(I,J)
0110   160     CONTINUE
0111   170   CONTINUE
0112
0113 C...Perform shower.
0114         QMAX=SQRT(MAX(0D0,PSUM(4)**2-PSUM(1)**2-PSUM(2)**2-
0115      &  PSUM(3)**2))
0116         IF(ISYS.EQ.1) QMAX=MIN(QMAX,SQRT(PARP(71))*VINT(55))
0117         NSAV=N
0118         IF(MINT(35).LE.1) THEN
0119           IF(NSIZ.EQ.2) THEN
0120             CALL PYSHOW(IBEG(ISYS),IBEG(ISYS)+1,QMAX)
0121           ELSE
0122             CALL PYSHOW(IBEG(ISYS),-NSIZ,QMAX)
0123           ENDIF
0124
0125 C...For external processes, first call, also ISR partons radiate.
0126 C...Can use existing PYPART list, removing partons that radiate later.
0127         ELSEIF(ISYS.EQ.1) THEN
0128           NPARTN=0
0129           DO 175 II=1,NPART
0130             IF(IPART(II).LT.IBEG(2).OR.IPART(II).GE.IBEG(NSYS+1)) THEN
0131               NPARTN=NPARTN+1
0132               IPART(NPARTN)=IPART(II)
0133               PTPART(NPARTN)=PTPART(II)
0134             ENDIF
0135  175      CONTINUE
0136           NPART=NPARTN
0137           CALL PYPTFS(1,0.5D0*QMAX,0D0,PTGEN)
0138         ELSE
0139 C...For subsequent calls use the systems excluded above.
0140           NPART=NSIZ
0141           NPARTD=0
0142           DO 180 II=1,NSIZ
0143             I=IBEG(ISYS)-1+II
0144             IPART(II)=I
0145             PTPART(II)=0.5D0*QMAX
0146   180     CONTINUE
0147           CALL PYPTFS(2,0.5D0*QMAX,0D0,PTGEN)
0148         ENDIF
0149
0150 C...Look up showered copies of original showering particles.
0151         DO 260 II=1,NSIZ
0152           I=IBEG(ISYS)-1+II
0153           IMV=I
0154 C...Particles without daughters need not be studied.
0155           IF(KSAV(II,1).LE.10) GOTO 260
0156           IF(N.EQ.NSAV.OR.K(I,1).LE.10) THEN
0157           ELSEIF(K(I,1).EQ.11) THEN
0158   190       IMV=MOD(K(IMV,4),MSTU(5))
0159             IF(K(IMV,1).EQ.11) GOTO 190
0160           ELSE
0161             KDA1=MOD(K(I,4),MSTU(5))
0162             IF(KDA1.GT.0) THEN
0163               IF(K(KDA1,2).EQ.21) KDA1=K(KDA1,5)/MSTU(5)
0164             ENDIF
0165             KDA2=MOD(K(I,5),MSTU(5))
0166             IF(KDA2.GT.0) THEN
0167               IF(K(KDA2,2).EQ.21) KDA2=K(KDA2,4)/MSTU(5)
0168             ENDIF
0169             DO 200 I3=I+1,N
0170               IF(K(I3,2).EQ.K(I,2).AND.(I3.EQ.KDA1.OR.I3.EQ.KDA2))
0171      &        THEN
0172                 IMV=I3
0173                 KDA1=MOD(K(I3,4),MSTU(5))
0174                 IF(KDA1.GT.0) THEN
0175                   IF(K(KDA1,2).EQ.21) KDA1=K(KDA1,5)/MSTU(5)
0176                 ENDIF
0177                 KDA2=MOD(K(I3,5),MSTU(5))
0178                 IF(KDA2.GT.0) THEN
0179                   IF(K(KDA2,2).EQ.21) KDA2=K(KDA2,4)/MSTU(5)
0180                 ENDIF
0181               ENDIF
0182   200       CONTINUE
0183           ENDIF
0184
0185 C...Restore daughter info of original partons to showered copies.
0186           IF(KSAV(II,1).GT.10) K(IMV,1)=KSAV(II,1)
0187           IF(KSAV(II,1).LE.10) THEN
0188           ELSEIF(K(I,1).EQ.1) THEN
0189             K(IMV,4)=KSAV(II,4)
0190             K(IMV,5)=KSAV(II,5)
0191           ELSE
0192             K(IMV,4)=K(IMV,4)+KSAV(II,4)
0193             K(IMV,5)=K(IMV,5)+KSAV(II,5)
0194           ENDIF
0195
0196 C...Reset mother info of existing daughters to showered copies.
0197           DO 210 I3=IBEG(ISYS+1),NFIN
0198             IF(K(I3,3).EQ.I) K(I3,3)=IMV
0199             IF(K(I3,1).EQ.3.OR.K(I3,1).EQ.14) THEN
0200               IF(K(I3,4)/MSTU(5).EQ.I) K(I3,4)=K(I3,4)+MSTU(5)*(IMV-I)
0201               IF(K(I3,5)/MSTU(5).EQ.I) K(I3,5)=K(I3,5)+MSTU(5)*(IMV-I)
0202             ENDIF
0203   210     CONTINUE
0204
0205 C...Boost all original daughters to new frame of showered copy.
0206 C...Also update their colour tags.
0207           IF(IMV.NE.I) THEN
0208             DO 220 J=1,3
0209               BETA(J)=(P(IMV,J)-P(I,J))/(P(IMV,4)+P(I,4))
0210   220       CONTINUE
0211             FAC=2D0/(1D0+BETA(1)**2+BETA(2)**2+BETA(3)**2)
0212             DO 230 J=1,3
0213               BETA(J)=FAC*BETA(J)
0214   230       CONTINUE
0215             DO 250 I3=IBEG(ISYS+1),NFIN
0216               IMO=I3
0217   240         IMO=K(IMO,3)
0218               IF(MSTP(128).LE.0) THEN
0219                 IF(IMO.GT.0.AND.IMO.NE.I.AND.IMO.NE.K(I,3)) GOTO 240
0220                 IF(IMO.EQ.I.OR.(K(I,3).LE.MINT(84).AND.IMO.EQ.K(I,3)))
0221      &          THEN
0222                   CALL PYROBO(I3,I3,0D0,0D0,BETA(1),BETA(2),BETA(3))
0223                   IF(MCT(I3,1).EQ.MCT(I,1)) MCT(I3,1)=MCT(IMV,1)
0224                   IF(MCT(I3,2).EQ.MCT(I,2)) MCT(I3,2)=MCT(IMV,2)
0225                 ENDIF
0226               ELSE
0227                 IF(IMO.EQ.IMV) THEN
0228                   CALL PYROBO(I3,I3,0D0,0D0,BETA(1),BETA(2),BETA(3))
0229                   IF(MCT(I3,1).EQ.MCT(I,1)) MCT(I3,1)=MCT(IMV,1)
0230                   IF(MCT(I3,2).EQ.MCT(I,2)) MCT(I3,2)=MCT(IMV,2)
0231                 ELSEIF(IMO.GT.0.AND.IMO.NE.I.AND.IMO.NE.K(I,3)) THEN
0232                   GOTO 240
0233                 ENDIF
0234               ENDIF
0235   250       CONTINUE
0236           ENDIF
0237   260   CONTINUE
0238
0239 C...End of loop over showering systems
0240   270 CONTINUE
0241
0242       RETURN
0243       END