Analysis Software
Documentation for sPHENIX simulation software
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Macros Groups Pages
pypdpr.f
Go to the documentation of this file. Or view the newest version in sPHENIX GitHub for file pypdpr.f
1 
2 C*********************************************************************
3 
4 C...PYPDPR
5 C...Gives proton parton distributions according to a few different
6 C...parametrizations.
7 
8  SUBROUTINE pypdpr(X,Q2,XPPR)
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/pydat2/kchg(500,4),pmas(500,4),parf(2000),vckm(4,4)
17  common/pypars/mstp(200),parp(200),msti(200),pari(200)
18  common/pyint1/mint(400),vint(400)
19  SAVE /pydat1/,/pydat2/,/pypars/,/pyint1/
20 C...Arrays and data.
21  dimension xppr(-6:6),q2min(16)
22  DATA q2min/ 2.56d0, 2.56d0, 2.56d0, 0.4d0, 0.4d0, 0.4d0,
23  &1.0d0, 1.0d0, 2*0d0, 0.25d0, 5d0, 5d0, 4d0, 4d0, 0d0/
24 
25 C...Reset output array.
26  DO 100 kfl=-6,6
27  xppr(kfl)=0d0
28  100 CONTINUE
29 
30 C...Common preliminaries.
31  nset=max(1,min(16,mstp(51)))
32  IF(nset.EQ.9.OR.nset.EQ.10) nset=6
33  vint(231)=q2min(nset)
34  IF(mstp(57).EQ.0) THEN
35  q2l=q2min(nset)
36  ELSE
37  q2l=max(q2min(nset),q2)
38  ENDIF
39 
40  IF(nset.GE.1.AND.nset.LE.3) THEN
41 C...Interface to the CTEQ 3 parton distributions.
42  qrt=sqrt(max(1d0,q2l))
43 
44 C...Loop over flavours.
45  DO 110 i=-6,6
46  IF(i.LE.0) THEN
47  xppr(i)=pycteq(nset,i,x,qrt)
48  ELSEIF(i.LE.2) THEN
49  xppr(i)=pycteq(nset,i,x,qrt)+xppr(-i)
50  ELSE
51  xppr(i)=xppr(-i)
52  ENDIF
53  110 CONTINUE
54 
55  ELSEIF(nset.GE.4.AND.nset.LE.6) THEN
56 C...Interface to the GRV 94 distributions.
57  IF(nset.EQ.4) THEN
58  CALL pygrvl(x, q2l, uv, dv, del, udb, sb, chm, bot, gl)
59  ELSEIF(nset.EQ.5) THEN
60  CALL pygrvm(x, q2l, uv, dv, del, udb, sb, chm, bot, gl)
61  ELSE
62  CALL pygrvd(x, q2l, uv, dv, del, udb, sb, chm, bot, gl)
63  ENDIF
64 
65 C...Put into output array.
66  xppr(0)=gl
67  xppr(-1)=0.5d0*(udb+del)
68  xppr(-2)=0.5d0*(udb-del)
69  xppr(-3)=sb
70  xppr(-4)=chm
71  xppr(-5)=bot
72  xppr(1)=dv+xppr(-1)
73  xppr(2)=uv+xppr(-2)
74  xppr(3)=sb
75  xppr(4)=chm
76  xppr(5)=bot
77 
78  ELSEIF(nset.EQ.7) THEN
79 C...Interface to the CTEQ 5L parton distributions.
80 C...Range of validity 10^-6 < x < 1, 1 < Q < 10^4 extended by
81 C...freezing x*f(x,Q2) at borders.
82  qrt=sqrt(max(1d0,min(1d8,q2l)))
83  xin=max(1d-6,min(1d0,x))
84 
85 C...Loop over flavours (with u <-> d notation mismatch).
86  sumudb=pyct5l(-1,xin,qrt)
87  ratudb=pyct5l(-2,xin,qrt)
88  DO 120 i=-5,2
89  IF(i.EQ.1) THEN
90  xppr(i)=xin*pyct5l(2,xin,qrt)
91  ELSEIF(i.EQ.2) THEN
92  xppr(i)=xin*pyct5l(1,xin,qrt)
93  ELSEIF(i.EQ.-1) THEN
94  xppr(i)=xin*sumudb*ratudb/(1d0+ratudb)
95  ELSEIF(i.EQ.-2) THEN
96  xppr(i)=xin*sumudb/(1d0+ratudb)
97  ELSE
98  xppr(i)=xin*pyct5l(i,xin,qrt)
99  IF(i.LT.0) xppr(-i)=xppr(i)
100  ENDIF
101  120 CONTINUE
102 
103  ELSEIF(nset.EQ.8) THEN
104 C...Interface to the CTEQ 5M1 parton distributions.
105  qrt=sqrt(max(1d0,min(1d8,q2l)))
106  xin=max(1d-6,min(1d0,x))
107 
108 C...Loop over flavours (with u <-> d notation mismatch).
109  sumudb=pyct5m(-1,xin,qrt)
110  ratudb=pyct5m(-2,xin,qrt)
111  DO 130 i=-5,2
112  IF(i.EQ.1) THEN
113  xppr(i)=xin*pyct5m(2,xin,qrt)
114  ELSEIF(i.EQ.2) THEN
115  xppr(i)=xin*pyct5m(1,xin,qrt)
116  ELSEIF(i.EQ.-1) THEN
117  xppr(i)=xin*sumudb*ratudb/(1d0+ratudb)
118  ELSEIF(i.EQ.-2) THEN
119  xppr(i)=xin*sumudb/(1d0+ratudb)
120  ELSE
121  xppr(i)=xin*pyct5m(i,xin,qrt)
122  IF(i.LT.0) xppr(-i)=xppr(i)
123  ENDIF
124  130 CONTINUE
125 
126  ELSEIF(nset.GE.11.AND.nset.LE.15) THEN
127 C...GRV92LO, EHLQ1, EHLQ2, DO1 AND DO2 distributions:
128 C...obsolete but offers backwards compatibility.
129  CALL pypdpo(x,q2l,xppr)
130 
131 C...Symmetric choice for debugging only
132  ELSEIF(nset.EQ.16) THEN
133  xppr(0)=.5d0/x
134  xppr(1)=.05d0/x
135  xppr(2)=.05d0/x
136  xppr(3)=.05d0/x
137  xppr(4)=.05d0/x
138  xppr(5)=.05d0/x
139  xppr(-1)=.05d0/x
140  xppr(-2)=.05d0/x
141  xppr(-3)=.05d0/x
142  xppr(-4)=.05d0/x
143  xppr(-5)=.05d0/x
144 
145  ENDIF
146 
147  RETURN
148  END