Back to home page

sPhenix code displayed by LXR

 
 

    


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

0001  
0002 C*********************************************************************
0003  
0004 C...PYPDPI
0005 C...Gives pi+ parton distribution according to two different
0006 C...parametrizations.
0007  
0008       SUBROUTINE PYPDPI(X,Q2,XPPI)
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...Commonblocks.
0015       COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
0016       COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200)
0017       COMMON/PYINT1/MINT(400),VINT(400)
0018       SAVE /PYDAT1/,/PYPARS/,/PYINT1/
0019 C...Local arrays.
0020       DIMENSION XPPI(-6:6),COW(3,5,4,2),XQ(9),TS(6)
0021  
0022 C...The following data lines are coefficients needed in the
0023 C...Owens pion parton distribution parametrizations, see below.
0024 C...Expansion coefficients for up and down valence quark distributions.
0025       DATA ((COW(IP,IS,1,1),IS=1,5),IP=1,3)/
0026      &4.0000D-01,  7.0000D-01,  0.0000D+00,  0.0000D+00,  0.0000D+00,
0027      &-6.2120D-02,  6.4780D-01,  0.0000D+00,  0.0000D+00,  0.0000D+00,
0028      &-7.1090D-03,  1.3350D-02,  0.0000D+00,  0.0000D+00,  0.0000D+00/
0029       DATA ((COW(IP,IS,1,2),IS=1,5),IP=1,3)/
0030      &4.0000D-01,  6.2800D-01,  0.0000D+00,  0.0000D+00,  0.0000D+00,
0031      &-5.9090D-02,  6.4360D-01,  0.0000D+00,  0.0000D+00,  0.0000D+00,
0032      &-6.5240D-03,  1.4510D-02,  0.0000D+00,  0.0000D+00,  0.0000D+00/
0033 C...Expansion coefficients for gluon distribution.
0034       DATA ((COW(IP,IS,2,1),IS=1,5),IP=1,3)/
0035      &8.8800D-01,  0.0000D+00,  3.1100D+00,  6.0000D+00,  0.0000D+00,
0036      &-1.8020D+00, -1.5760D+00, -1.3170D-01,  2.8010D+00, -1.7280D+01,
0037      &1.8120D+00,  1.2000D+00,  5.0680D-01, -1.2160D+01,  2.0490D+01/
0038       DATA ((COW(IP,IS,2,2),IS=1,5),IP=1,3)/
0039      &7.9400D-01,  0.0000D+00,  2.8900D+00,  6.0000D+00,  0.0000D+00,
0040      &-9.1440D-01, -1.2370D+00,  5.9660D-01, -3.6710D+00, -8.1910D+00,
0041      &5.9660D-01,  6.5820D-01, -2.5500D-01, -2.3040D+00,  7.7580D+00/
0042 C...Expansion coefficients for (up+down+strange) quark sea distribution.
0043       DATA ((COW(IP,IS,3,1),IS=1,5),IP=1,3)/
0044      &9.0000D-01,  0.0000D+00,  5.0000D+00,  0.0000D+00,  0.0000D+00,
0045      &-2.4280D-01, -2.1200D-01,  8.6730D-01,  1.2660D+00,  2.3820D+00,
0046      &1.3860D-01,  3.6710D-03,  4.7470D-02, -2.2150D+00,  3.4820D-01/
0047       DATA ((COW(IP,IS,3,2),IS=1,5),IP=1,3)/
0048      &9.0000D-01,  0.0000D+00,  5.0000D+00,  0.0000D+00,  0.0000D+00,
0049      &-1.4170D-01, -1.6970D-01, -2.4740D+00, -2.5340D+00,  5.6210D-01,
0050      &-1.7400D-01, -9.6230D-02,  1.5750D+00,  1.3780D+00, -2.7010D-01/
0051 C...Expansion coefficients for charm quark sea distribution.
0052       DATA ((COW(IP,IS,4,1),IS=1,5),IP=1,3)/
0053      &0.0000D+00, -2.2120D-02,  2.8940D+00,  0.0000D+00,  0.0000D+00,
0054      &7.9280D-02, -3.7850D-01,  9.4330D+00,  5.2480D+00,  8.3880D+00,
0055      &-6.1340D-02, -1.0880D-01, -1.0852D+01, -7.1870D+00, -1.1610D+01/
0056       DATA ((COW(IP,IS,4,2),IS=1,5),IP=1,3)/
0057      &0.0000D+00, -8.8200D-02,  1.9240D+00,  0.0000D+00,  0.0000D+00,
0058      &6.2290D-02, -2.8920D-01,  2.4240D-01, -4.4630D+00, -8.3670D-01,
0059      &-4.0990D-02, -1.0820D-01,  2.0360D+00,  5.2090D+00, -4.8400D-02/
0060  
0061 C...Euler's beta function, requires ordinary Gamma function
0062       EULBET(X,Y)=PYGAMM(X)*PYGAMM(Y)/PYGAMM(X+Y)
0063  
0064 C...Reset output array.
0065       DO 100 KFL=-6,6
0066         XPPI(KFL)=0D0
0067   100 CONTINUE
0068  
0069       IF(MSTP(53).LE.2) THEN
0070 C...Pion parton distributions from Owens.
0071 C...Allowed variable range: 4 GeV^2 < Q^2 < approx 2000 GeV^2.
0072  
0073 C...Determine set, Lambda and s expansion variable.
0074         NSET=MSTP(53)
0075         IF(NSET.EQ.1) ALAM=0.2D0
0076         IF(NSET.EQ.2) ALAM=0.4D0
0077         VINT(231)=4D0
0078         IF(MSTP(57).LE.0) THEN
0079           SD=0D0
0080         ELSE
0081           Q2IN=MIN(2D3,MAX(4D0,Q2))
0082           SD=LOG(LOG(Q2IN/ALAM**2)/LOG(4D0/ALAM**2))
0083         ENDIF
0084  
0085 C...Calculate parton distributions.
0086         DO 120 KFL=1,4
0087           DO 110 IS=1,5
0088             TS(IS)=COW(1,IS,KFL,NSET)+COW(2,IS,KFL,NSET)*SD+
0089      &      COW(3,IS,KFL,NSET)*SD**2
0090   110     CONTINUE
0091           IF(KFL.EQ.1) THEN
0092             XQ(KFL)=X**TS(1)*(1D0-X)**TS(2)/EULBET(TS(1),TS(2)+1D0)
0093           ELSE
0094             XQ(KFL)=TS(1)*X**TS(2)*(1D0-X)**TS(3)*(1D0+TS(4)*X+
0095      &      TS(5)*X**2)
0096           ENDIF
0097   120   CONTINUE
0098  
0099 C...Put into output array.
0100         XPPI(0)=XQ(2)
0101         XPPI(1)=XQ(3)/6D0
0102         XPPI(2)=XQ(1)+XQ(3)/6D0
0103         XPPI(3)=XQ(3)/6D0
0104         XPPI(4)=XQ(4)
0105         XPPI(-1)=XQ(1)+XQ(3)/6D0
0106         XPPI(-2)=XQ(3)/6D0
0107         XPPI(-3)=XQ(3)/6D0
0108         XPPI(-4)=XQ(4)
0109  
0110 C...Leading order pion parton distributions from Glueck, Reya and Vogt.
0111 C...Allowed variable range: 0.25 GeV^2 < Q^2 < 10^8 GeV^2 and
0112 C...10^-5 < x < 1.
0113       ELSE
0114  
0115 C...Determine s expansion variable and some x expressions.
0116         VINT(231)=0.25D0
0117         IF(MSTP(57).LE.0) THEN
0118           SD=0D0
0119         ELSE
0120           Q2IN=MIN(1D8,MAX(0.25D0,Q2))
0121           SD=LOG(LOG(Q2IN/0.232D0**2)/LOG(0.25D0/0.232D0**2))
0122         ENDIF
0123         SD2=SD**2
0124         XL=-LOG(X)
0125         XS=SQRT(X)
0126  
0127 C...Evaluate valence, gluon and sea distributions.
0128         XFVAL=(0.519D0+0.180D0*SD-0.011D0*SD2)*X**(0.499D0-0.027D0*SD)*
0129      &  (1D0+(0.381D0-0.419D0*SD)*XS)*(1D0-X)**(0.367D0+0.563D0*SD)
0130         XFGLU=(X**(0.482D0+0.341D0*SQRT(SD))*((0.678D0+0.877D0*
0131      &  SD-0.175D0*SD2)+
0132      &  (0.338D0-1.597D0*SD)*XS+(-0.233D0*SD+0.406D0*SD2)*X)+
0133      &  SD**0.599D0*EXP(-(0.618D0+2.070D0*SD)+SQRT(3.676D0*SD**1.263D0*
0134      &  XL)))*
0135      &  (1D0-X)**(0.390D0+1.053D0*SD)
0136         XFSEA=SD**0.55D0*(1D0-0.748D0*XS+(0.313D0+0.935D0*SD)*X)*(1D0-
0137      &  X)**3.359D0*
0138      &  EXP(-(4.433D0+1.301D0*SD)+SQRT((9.30D0-0.887D0*SD)*SD**0.56D0*
0139      &  XL))/
0140      &  XL**(2.538D0-0.763D0*SD)
0141         IF(SD.LE.0.888D0) THEN
0142           XFCHM=0D0
0143         ELSE
0144           XFCHM=(SD-0.888D0)**1.02D0*(1D0+1.008D0*X)*(1D0-X)**(1.208D0+
0145      &    0.771D0*SD)*
0146      &    EXP(-(4.40D0+1.493D0*SD)+SQRT((2.032D0+1.901D0*SD)*SD**0.39D0*
0147      &    XL))
0148         ENDIF
0149         IF(SD.LE.1.351D0) THEN
0150           XFBOT=0D0
0151         ELSE
0152           XFBOT=(SD-1.351D0)**1.03D0*(1D0-X)**(0.697D0+0.855D0*SD)*
0153      &    EXP(-(4.51D0+1.490D0*SD)+SQRT((3.056D0+1.694D0*SD)*SD**0.39D0*
0154      &    XL))
0155         ENDIF
0156  
0157 C...Put into output array.
0158         XPPI(0)=XFGLU
0159         XPPI(1)=XFSEA
0160         XPPI(2)=XFSEA
0161         XPPI(3)=XFSEA
0162         XPPI(4)=XFCHM
0163         XPPI(5)=XFBOT
0164         DO 130 KFL=1,5
0165           XPPI(-KFL)=XPPI(KFL)
0166   130   CONTINUE
0167         XPPI(2)=XPPI(2)+XFVAL
0168         XPPI(-1)=XPPI(-1)+XFVAL
0169       ENDIF
0170  
0171       RETURN
0172       END