Analysis Software
Documentation for sPHENIX simulation software
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Macros Groups Pages
pypdpi.f
Go to the documentation of this file. Or view the newest version in sPHENIX GitHub for file pypdpi.f
1 
2 C*********************************************************************
3 
4 C...PYPDPI
5 C...Gives pi+ parton distribution according to two different
6 C...parametrizations.
7 
8  SUBROUTINE pypdpi(X,Q2,XPPI)
9 
10 C...Double precision and integer declarations.
11  IMPLICIT DOUBLE PRECISION(a-h, o-z)
12  IMPLICIT INTEGER(i-n)
13  INTEGER pyk,pychge,pycomp
14 C...Commonblocks.
15  common/pydat1/mstu(200),paru(200),mstj(200),parj(200)
16  common/pypars/mstp(200),parp(200),msti(200),pari(200)
17  common/pyint1/mint(400),vint(400)
18  SAVE /pydat1/,/pypars/,/pyint1/
19 C...Local arrays.
20  dimension xppi(-6:6),cow(3,5,4,2),xq(9),ts(6)
21 
22 C...The following data lines are coefficients needed in the
23 C...Owens pion parton distribution parametrizations, see below.
24 C...Expansion coefficients for up and down valence quark distributions.
25  DATA ((cow(ip,is,1,1),is=1,5),ip=1,3)/
26  &4.0000d-01, 7.0000d-01, 0.0000d+00, 0.0000d+00, 0.0000d+00,
27  &-6.2120d-02, 6.4780d-01, 0.0000d+00, 0.0000d+00, 0.0000d+00,
28  &-7.1090d-03, 1.3350d-02, 0.0000d+00, 0.0000d+00, 0.0000d+00/
29  DATA ((cow(ip,is,1,2),is=1,5),ip=1,3)/
30  &4.0000d-01, 6.2800d-01, 0.0000d+00, 0.0000d+00, 0.0000d+00,
31  &-5.9090d-02, 6.4360d-01, 0.0000d+00, 0.0000d+00, 0.0000d+00,
32  &-6.5240d-03, 1.4510d-02, 0.0000d+00, 0.0000d+00, 0.0000d+00/
33 C...Expansion coefficients for gluon distribution.
34  DATA ((cow(ip,is,2,1),is=1,5),ip=1,3)/
35  &8.8800d-01, 0.0000d+00, 3.1100d+00, 6.0000d+00, 0.0000d+00,
36  &-1.8020d+00, -1.5760d+00, -1.3170d-01, 2.8010d+00, -1.7280d+01,
37  &1.8120d+00, 1.2000d+00, 5.0680d-01, -1.2160d+01, 2.0490d+01/
38  DATA ((cow(ip,is,2,2),is=1,5),ip=1,3)/
39  &7.9400d-01, 0.0000d+00, 2.8900d+00, 6.0000d+00, 0.0000d+00,
40  &-9.1440d-01, -1.2370d+00, 5.9660d-01, -3.6710d+00, -8.1910d+00,
41  &5.9660d-01, 6.5820d-01, -2.5500d-01, -2.3040d+00, 7.7580d+00/
42 C...Expansion coefficients for (up+down+strange) quark sea distribution.
43  DATA ((cow(ip,is,3,1),is=1,5),ip=1,3)/
44  &9.0000d-01, 0.0000d+00, 5.0000d+00, 0.0000d+00, 0.0000d+00,
45  &-2.4280d-01, -2.1200d-01, 8.6730d-01, 1.2660d+00, 2.3820d+00,
46  &1.3860d-01, 3.6710d-03, 4.7470d-02, -2.2150d+00, 3.4820d-01/
47  DATA ((cow(ip,is,3,2),is=1,5),ip=1,3)/
48  &9.0000d-01, 0.0000d+00, 5.0000d+00, 0.0000d+00, 0.0000d+00,
49  &-1.4170d-01, -1.6970d-01, -2.4740d+00, -2.5340d+00, 5.6210d-01,
50  &-1.7400d-01, -9.6230d-02, 1.5750d+00, 1.3780d+00, -2.7010d-01/
51 C...Expansion coefficients for charm quark sea distribution.
52  DATA ((cow(ip,is,4,1),is=1,5),ip=1,3)/
53  &0.0000d+00, -2.2120d-02, 2.8940d+00, 0.0000d+00, 0.0000d+00,
54  &7.9280d-02, -3.7850d-01, 9.4330d+00, 5.2480d+00, 8.3880d+00,
55  &-6.1340d-02, -1.0880d-01, -1.0852d+01, -7.1870d+00, -1.1610d+01/
56  DATA ((cow(ip,is,4,2),is=1,5),ip=1,3)/
57  &0.0000d+00, -8.8200d-02, 1.9240d+00, 0.0000d+00, 0.0000d+00,
58  &6.2290d-02, -2.8920d-01, 2.4240d-01, -4.4630d+00, -8.3670d-01,
59  &-4.0990d-02, -1.0820d-01, 2.0360d+00, 5.2090d+00, -4.8400d-02/
60 
61 C...Euler's beta function, requires ordinary Gamma function
62  eulbet(x,y)=pygamm(x)*pygamm(y)/pygamm(x+y)
63 
64 C...Reset output array.
65  DO 100 kfl=-6,6
66  xppi(kfl)=0d0
67  100 CONTINUE
68 
69  IF(mstp(53).LE.2) THEN
70 C...Pion parton distributions from Owens.
71 C...Allowed variable range: 4 GeV^2 < Q^2 < approx 2000 GeV^2.
72 
73 C...Determine set, Lambda and s expansion variable.
74  nset=mstp(53)
75  IF(nset.EQ.1) alam=0.2d0
76  IF(nset.EQ.2) alam=0.4d0
77  vint(231)=4d0
78  IF(mstp(57).LE.0) THEN
79  sd=0d0
80  ELSE
81  q2in=min(2d3,max(4d0,q2))
82  sd=log(log(q2in/alam**2)/log(4d0/alam**2))
83  ENDIF
84 
85 C...Calculate parton distributions.
86  DO 120 kfl=1,4
87  DO 110 is=1,5
88  ts(is)=cow(1,is,kfl,nset)+cow(2,is,kfl,nset)*sd+
89  & cow(3,is,kfl,nset)*sd**2
90  110 CONTINUE
91  IF(kfl.EQ.1) THEN
92  xq(kfl)=x**ts(1)*(1d0-x)**ts(2)/eulbet(ts(1),ts(2)+1d0)
93  ELSE
94  xq(kfl)=ts(1)*x**ts(2)*(1d0-x)**ts(3)*(1d0+ts(4)*x+
95  & ts(5)*x**2)
96  ENDIF
97  120 CONTINUE
98 
99 C...Put into output array.
100  xppi(0)=xq(2)
101  xppi(1)=xq(3)/6d0
102  xppi(2)=xq(1)+xq(3)/6d0
103  xppi(3)=xq(3)/6d0
104  xppi(4)=xq(4)
105  xppi(-1)=xq(1)+xq(3)/6d0
106  xppi(-2)=xq(3)/6d0
107  xppi(-3)=xq(3)/6d0
108  xppi(-4)=xq(4)
109 
110 C...Leading order pion parton distributions from Glueck, Reya and Vogt.
111 C...Allowed variable range: 0.25 GeV^2 < Q^2 < 10^8 GeV^2 and
112 C...10^-5 < x < 1.
113  ELSE
114 
115 C...Determine s expansion variable and some x expressions.
116  vint(231)=0.25d0
117  IF(mstp(57).LE.0) THEN
118  sd=0d0
119  ELSE
120  q2in=min(1d8,max(0.25d0,q2))
121  sd=log(log(q2in/0.232d0**2)/log(0.25d0/0.232d0**2))
122  ENDIF
123  sd2=sd**2
124  xl=-log(x)
125  xs=sqrt(x)
126 
127 C...Evaluate valence, gluon and sea distributions.
128  xfval=(0.519d0+0.180d0*sd-0.011d0*sd2)*x**(0.499d0-0.027d0*sd)*
129  & (1d0+(0.381d0-0.419d0*sd)*xs)*(1d0-x)**(0.367d0+0.563d0*sd)
130  xfglu=(x**(0.482d0+0.341d0*sqrt(sd))*((0.678d0+0.877d0*
131  & sd-0.175d0*sd2)+
132  & (0.338d0-1.597d0*sd)*xs+(-0.233d0*sd+0.406d0*sd2)*x)+
133  & sd**0.599d0*exp(-(0.618d0+2.070d0*sd)+sqrt(3.676d0*sd**1.263d0*
134  & xl)))*
135  & (1d0-x)**(0.390d0+1.053d0*sd)
136  xfsea=sd**0.55d0*(1d0-0.748d0*xs+(0.313d0+0.935d0*sd)*x)*(1d0-
137  & x)**3.359d0*
138  & exp(-(4.433d0+1.301d0*sd)+sqrt((9.30d0-0.887d0*sd)*sd**0.56d0*
139  & xl))/
140  & xl**(2.538d0-0.763d0*sd)
141  IF(sd.LE.0.888d0) THEN
142  xfchm=0d0
143  ELSE
144  xfchm=(sd-0.888d0)**1.02d0*(1d0+1.008d0*x)*(1d0-x)**(1.208d0+
145  & 0.771d0*sd)*
146  & exp(-(4.40d0+1.493d0*sd)+sqrt((2.032d0+1.901d0*sd)*sd**0.39d0*
147  & xl))
148  ENDIF
149  IF(sd.LE.1.351d0) THEN
150  xfbot=0d0
151  ELSE
152  xfbot=(sd-1.351d0)**1.03d0*(1d0-x)**(0.697d0+0.855d0*sd)*
153  & exp(-(4.51d0+1.490d0*sd)+sqrt((3.056d0+1.694d0*sd)*sd**0.39d0*
154  & xl))
155  ENDIF
156 
157 C...Put into output array.
158  xppi(0)=xfglu
159  xppi(1)=xfsea
160  xppi(2)=xfsea
161  xppi(3)=xfsea
162  xppi(4)=xfchm
163  xppi(5)=xfbot
164  DO 130 kfl=1,5
165  xppi(-kfl)=xppi(kfl)
166  130 CONTINUE
167  xppi(2)=xppi(2)+xfval
168  xppi(-1)=xppi(-1)+xfval
169  ENDIF
170 
171  RETURN
172  END