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