Back to home page

sPhenix code displayed by LXR

 
 

    


File indexing completed on 2025-08-05 08:21:20

0001  
0002 C*********************************************************************
0003  
0004 C...PYUPIN
0005 C...Fills the HEPRUP commonblock with info on incoming beams and allowed
0006 C...processes, and optionally stores that information on file.
0007  
0008       SUBROUTINE PYUPIN
0009  
0010 C...Double precision and integer declarations.
0011       IMPLICIT DOUBLE PRECISION(A-H, O-Z)
0012       IMPLICIT INTEGER(I-N)
0013  
0014 C...Commonblocks.
0015       COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5)
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/PYINT5/NGENPD,NGEN(0:500,3),XSEC(0:500,3)
0019       SAVE /PYJETS/,/PYSUBS/,/PYPARS/,/PYINT5/
0020  
0021 C...User process initialization commonblock.
0022       INTEGER MAXPUP
0023       PARAMETER (MAXPUP=100)
0024       INTEGER IDBMUP,PDFGUP,PDFSUP,IDWTUP,NPRUP,LPRUP
0025       DOUBLE PRECISION EBMUP,XSECUP,XERRUP,XMAXUP
0026       COMMON/HEPRUP/IDBMUP(2),EBMUP(2),PDFGUP(2),PDFSUP(2),
0027      &IDWTUP,NPRUP,XSECUP(MAXPUP),XERRUP(MAXPUP),XMAXUP(MAXPUP),
0028      &LPRUP(MAXPUP)
0029       SAVE /HEPRUP/
0030  
0031 C...Store info on incoming beams.
0032       IDBMUP(1)=K(1,2)
0033       IDBMUP(2)=K(2,2)
0034       EBMUP(1)=P(1,4)
0035       EBMUP(2)=P(2,4)
0036       PDFGUP(1)=0
0037       PDFGUP(2)=0
0038       PDFSUP(1)=MSTP(51)
0039       PDFSUP(2)=MSTP(51)
0040  
0041 C...Event weighting strategy.
0042       IDWTUP=3
0043  
0044 C...Info on individual processes.
0045       NPRUP=0
0046       DO 100 ISUB=1,500
0047         IF(MSUB(ISUB).EQ.1) THEN
0048           NPRUP=NPRUP+1
0049           XSECUP(NPRUP)=1D9*XSEC(ISUB,3)
0050           XERRUP(NPRUP)=XSECUP(NPRUP)/SQRT(MAX(1D0,DBLE(NGEN(ISUB,3))))
0051           XMAXUP(NPRUP)=1D0
0052           LPRUP(NPRUP)=ISUB
0053         ENDIF
0054   100 CONTINUE
0055  
0056 C...Write info to file.
0057       IF(MSTP(161).GT.0) THEN
0058         WRITE(MSTP(161),5100) IDBMUP(1),IDBMUP(2),EBMUP(1),EBMUP(2),
0059      &  PDFGUP(1),PDFGUP(2),PDFSUP(1),PDFSUP(2),IDWTUP,NPRUP
0060         DO 110 IPR=1,NPRUP
0061           WRITE(MSTP(161),5200) XSECUP(IPR),XERRUP(IPR),XMAXUP(IPR),
0062      &    LPRUP(IPR)
0063   110   CONTINUE
0064       ENDIF
0065  
0066 C...Formats for printout.
0067  5100 FORMAT(1P,2I8,2E14.6,6I6)
0068  5200 FORMAT(1P,3E14.6,I6)
0069  
0070       RETURN
0071       END