pythiaeRHIC/pythia/pysave.f

0001
0002 C*********************************************************************
0003
0004 C...PYSAVE
0005 C...Saves and restores parameter and cross section values for the
0006 C...3 gamma-p and 6 (or 4, or 9, or 13) gamma-gamma alternatives.
0007 C...Also makes random choice between alternatives.
0008
0009       SUBROUTINE PYSAVE(ISAVE,IGA)
0010
0011 C...Double precision and integer declarations.
0012       IMPLICIT DOUBLE PRECISION(A-H, O-Z)
0013       IMPLICIT INTEGER(I-N)
0014       INTEGER PYK,PYCHGE,PYCOMP
0015 C...Commonblocks.
0016       COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200)
0017       COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200)
0018       COMMON/PYINT1/MINT(400),VINT(400)
0019       COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2)
0020       COMMON/PYINT5/NGENPD,NGEN(0:500,3),XSEC(0:500,3)
0021       COMMON/PYINT7/SIGT(0:6,0:6,0:5)
0022       SAVE /PYSUBS/,/PYPARS/,/PYINT1/,/PYINT2/,/PYINT5/,/PYINT7/
0023 C...Local arrays and saved variables.
0024       DIMENSION NCP(15),NSUBCP(15,20),MSUBCP(15,20),COEFCP(15,20,20),
0025      &NGENCP(15,0:20,3),XSECCP(15,0:20,3),SIGTCP(15,0:6,0:6,0:5),
0026      &INTCP(15,20),RECP(15,20)
0027       SAVE NCP,NSUBCP,MSUBCP,COEFCP,NGENCP,XSECCP,SIGTCP,INTCP,RECP
0028
0029 C...Save list of subprocesses and cross-section information.
0030       IF(ISAVE.EQ.1) THEN
0031         ICP=0
0032         DO 120 I=1,500
0033           IF(MSUB(I).EQ.0.AND.I.NE.96.AND.I.NE.97) GOTO 120
0034           ICP=ICP+1
0035           NSUBCP(IGA,ICP)=I
0036           MSUBCP(IGA,ICP)=MSUB(I)
0037           DO 100 J=1,20
0038             COEFCP(IGA,ICP,J)=COEF(I,J)
0039   100     CONTINUE
0040           DO 110 J=1,3
0041             NGENCP(IGA,ICP,J)=NGEN(I,J)
0042             XSECCP(IGA,ICP,J)=XSEC(I,J)
0043   110     CONTINUE
0044   120   CONTINUE
0045         NCP(IGA)=ICP
0046         DO 130 J=1,3
0047           NGENCP(IGA,0,J)=NGEN(0,J)
0048           XSECCP(IGA,0,J)=XSEC(0,J)
0049   130   CONTINUE
0050         DO 160 I1=0,6
0051           DO 150 I2=0,6
0052             DO 140 J=0,5
0053               SIGTCP(IGA,I1,I2,J)=SIGT(I1,I2,J)
0054   140       CONTINUE
0055   150     CONTINUE
0056   160   CONTINUE
0057
0058 C...Save various common process variables.
0059         DO 170 J=1,10
0060           INTCP(IGA,J)=MINT(40+J)
0061   170   CONTINUE
0062         INTCP(IGA,11)=MINT(101)
0063         INTCP(IGA,12)=MINT(102)
0064         INTCP(IGA,13)=MINT(107)
0065         INTCP(IGA,14)=MINT(108)
0066         INTCP(IGA,15)=MINT(123)
0067         RECP(IGA,1)=CKIN(3)
0068         RECP(IGA,2)=VINT(318)
0069
0070 C...Save cross-section information only.
0071       ELSEIF(ISAVE.EQ.2) THEN
0072         DO 190 ICP=1,NCP(IGA)
0073           I=NSUBCP(IGA,ICP)
0074           DO 180 J=1,3
0075             NGENCP(IGA,ICP,J)=NGEN(I,J)
0076             XSECCP(IGA,ICP,J)=XSEC(I,J)
0077   180     CONTINUE
0078   190   CONTINUE
0079         DO 200 J=1,3
0080           NGENCP(IGA,0,J)=NGEN(0,J)
0081           XSECCP(IGA,0,J)=XSEC(0,J)
0082   200   CONTINUE
0083
0084 C...Choose between allowed alternatives.
0085       ELSEIF(ISAVE.EQ.3.OR.ISAVE.EQ.4) THEN
0086         IF(ISAVE.EQ.4) THEN
0087           XSUMCP=0D0
0088           DO 210 IG=1,MINT(121)
0089             XSUMCP=XSUMCP+XSECCP(IG,0,1)
0090   210     CONTINUE
0091           XSUMCP=XSUMCP*PYR(0)
0092           DO 220 IG=1,MINT(121)
0093             IGA=IG
0094             XSUMCP=XSUMCP-XSECCP(IG,0,1)
0095             IF(XSUMCP.LE.0D0) GOTO 230
0096   220     CONTINUE
0097   230     CONTINUE
0098         ENDIF
0099
0100 C...Restore cross-section information.
0101         DO 240 I=1,500
0102           MSUB(I)=0
0103   240   CONTINUE
0104         DO 270 ICP=1,NCP(IGA)
0105           I=NSUBCP(IGA,ICP)
0106           MSUB(I)=MSUBCP(IGA,ICP)
0107           DO 250 J=1,20
0108             COEF(I,J)=COEFCP(IGA,ICP,J)
0109   250     CONTINUE
0110           DO 260 J=1,3
0111             NGEN(I,J)=NGENCP(IGA,ICP,J)
0112             XSEC(I,J)=XSECCP(IGA,ICP,J)
0113   260     CONTINUE
0114   270   CONTINUE
0115         DO 280 J=1,3
0116           NGEN(0,J)=NGENCP(IGA,0,J)
0117           XSEC(0,J)=XSECCP(IGA,0,J)
0118   280   CONTINUE
0119         DO 310 I1=0,6
0120           DO 300 I2=0,6
0121             DO 290 J=0,5
0122               SIGT(I1,I2,J)=SIGTCP(IGA,I1,I2,J)
0123   290       CONTINUE
0124   300     CONTINUE
0125   310   CONTINUE
0126
0127 C...Restore various common process variables.
0128         DO 320 J=1,10
0129           MINT(40+J)=INTCP(IGA,J)
0130   320   CONTINUE
0131         MINT(101)=INTCP(IGA,11)
0132         MINT(102)=INTCP(IGA,12)
0133         MINT(107)=INTCP(IGA,13)
0134         MINT(108)=INTCP(IGA,14)
0135         MINT(123)=INTCP(IGA,15)
0136         CKIN(3)=RECP(IGA,1)
0137         CKIN(1)=2D0*CKIN(3)
0138         VINT(318)=RECP(IGA,2)
0139
0140 C...Sum up cross-section info (for PYSTAT).
0141       ELSEIF(ISAVE.EQ.5) THEN
0142         DO 330 I=1,500
0143           MSUB(I)=0
0144           NGEN(I,1)=0
0145           NGEN(I,3)=0
0146           XSEC(I,3)=0D0
0147   330   CONTINUE
0148         NGEN(0,1)=0
0149         NGEN(0,2)=0
0150         NGEN(0,3)=0
0151         XSEC(0,3)=0
0152         DO 350 IG=1,MINT(121)
0153           DO 340 ICP=1,NCP(IG)
0154             I=NSUBCP(IG,ICP)
0155             IF(MSUBCP(IG,ICP).EQ.1) MSUB(I)=1
0156             NGEN(I,1)=NGEN(I,1)+NGENCP(IG,ICP,1)
0157             NGEN(I,3)=NGEN(I,3)+NGENCP(IG,ICP,3)
0158             XSEC(I,3)=XSEC(I,3)+XSECCP(IG,ICP,3)
0159   340     CONTINUE
0160           NGEN(0,1)=NGEN(0,1)+NGENCP(IG,0,1)
0161           NGEN(0,2)=NGEN(0,2)+NGENCP(IG,0,2)
0162           NGEN(0,3)=NGEN(0,3)+NGENCP(IG,0,3)
0163           XSEC(0,3)=XSEC(0,3)+XSECCP(IG,0,3)
0164   350   CONTINUE
0165       ENDIF
0166
0167       RETURN
0168       END