EIC Software
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Macros Groups Pages
parpolnew.F
Go to the documentation of this file. Or view the newest version in sPHENIX GitHub for file parpolnew.F
1 *
2 *********************************************************************
3 * *
4 * POLARIZED RADIATIVELY GENERATED LO AND NLO PARTON DENSITIES *
5 * *
6 * M. GLUCK, E. REYA, M. STRATMANN AND W. VOGELSANG, *
7 * hep-ph/0011215 *
8 * *
9 * PROBLEMS/QUESTIONS TO wvogelsang@bnl.gov *
10 * OR TO marco.stratmann@physik.uni-regensburg.de *
11 * *
12 * INPUT: ISET = number of the parton set : *
13 * ISET = 1 'STANDARD' SCENARIO, NEXT-TO-LEADING ORDER *
14 * (MS-bar) *
15 * (DATA FILE 'std2000_nlo.grid' UNIT=11, TO BE *
16 * DEFINED BY THE USER ) *
17 * ISET = 2 'VALENCE' SCENARIO, NEXT-TO-LEADING ORDER *
18 * (MS-bar) *
19 * (DATA FILE 'val2000_nlo.grid' UNIT=22, TO BE *
20 * DEFINED BY THE USER ) *
21 * ISET = 3 'STANDARD' SCENARIO, LEADING ORDER *
22 * (DATA FILE 'std2000_lo.grid' UNIT=33, TO BE *
23 * DEFINED BY THE USER ) *
24 * ISET = 4 'VALENCE' SCENARIO, LEADING ORDER *
25 * (DATA FILE 'val2000_lo.grid' UNIT=44, TO BE *
26 * DEFINED BY THE USER ) *
27 * *
28 * X = Bjorken-x (between 1.E-4 and 1) *
29 * Q2 = scale in GeV**2 (between 0.8 and 1.E6) *
30 * *
31 * OUTPUT: U = x * DELTA u *
32 * D = x * DELTA d *
33 * UB = x * DELTA ubar *
34 * DB = x * DELTA dbar *
35 * ST = x * DELTA STRANGE *
36 * GL = x * DELTA GLUON *
37 * G1P = g_1^proton *
38 * G1N = g_1^neutron *
39 * *
40 * ( For the parton distributions always x times *
41 * the distribution is returned . *
42 * This is NOT the case for g1(p,n) ) *
43 * *
44 * The sets are the result of a combined fit to *
45 * data for the spin asymmetries A_1 (p,n,d) *
46 * *
47 * Note: No charm is included *
48 * *
49 * COMMON: The main program or the calling routine has to have *
50 * a common block COMMON / INTINI / IINI , and IINI *
51 * has always to be zero when PARPOL is called for the *
52 * first time or when 'ISET' has been changed. *
53 * *
54 *********************************************************************
55 *
56  SUBROUTINE parpolnew (ISET, X, Q2, U, D, UB, DB, ST,GL,G1P,G1N)
57  IMPLICIT DOUBLE PRECISION (a-h,o-z)
58  parameter(npart=8, nx=42, nq=30, narg=2)
59  dimension xuf(nx,nq), xdf(nx,nq), xubf(nx,nq), xdbf(nx,nq),
60  1 xsf(nx,nq), xgf(nx,nq), xg1p(nx,nq), xg1n(nx,nq),
61  2 parton(npart,nq,nx-1), qs(nq), xb(nx), xt(narg),
62  3 na(narg), arrf(nx+nq)
63  COMMON / intini / iini
64  SAVE xuf, xdf, xubf, xdbf, xsf, xgf, xg1p, xg1n, na, arrf
65 *...BJORKEN-X AND Q**2 VALUES OF THE GRID :
66  DATA qs / 0.8d0, 1.0d0, 1.25d0, 1.5d0, 2.d0, 2.5d0,
67  1 4.0d0, 6.4d0, 1.0d1, 1.5d1, 2.5d1, 4.0d1, 6.4d1,
68  2 1.0d2, 1.8d2, 3.2d2, 5.8d2, 1.0d3, 1.8d3,
69  3 3.2d3, 5.8d3, 1.0d4, 1.8d4, 3.2d4, 5.8d4,
70  4 1.0d5, 1.8d5, 3.2d5, 5.8d5, 1.0d6 /
71  DATA xb /
72  1 1.d-4, 1.5d-4, 2.2d-4, 3.2d-4, 4.8d-4, 7.d-4,
73  2 1.d-3, 1.5d-3, 2.2d-3, 3.2d-3, 4.8d-3, 7.d-3,
74  3 1.d-2, 1.5d-2, 2.2d-2, 3.2d-2, 5.0d-2, 7.5d-2,
75  4 0.1, 0.125, 0.15, 0.175, 0.2, 0.225, 0.25, 0.275,
76  5 0.3, 0.325, 0.35, 0.375, 0.4, 0.45, 0.5, 0.55,
77  6 0.6, 0.65, 0.7, 0.75, 0.8, 0.85, 0.9, 1.0 /
78 
79  include "pepadm.inc"
80 
81 *...CHECK OF X AND Q2 VALUES :
82  IF ( (x.LT.1.0d-6) .OR. (x.GT.1.0d0) ) THEN
83  WRITE(6,91)
84  91 FORMAT (2x,'PARTON INTERPOLATION: X OUT OF RANGE')
85  stop
86 c GOTO 60
87  ENDIF
88  IF ( (q2.LT.0.8d0) .OR. (q2.GT.1.d6) ) THEN
89  WRITE(6,92)
90  92 FORMAT (2x,'PARTON INTERPOLATION: Q2 OUT OF RANGE')
91  stop
92 C GOTO 60
93  ENDIF
94 *...INITIALIZATION :
95 * SELECTION AND READING OF THE GRID :
96 * FILE - NO. = 11 FOR NLO 'STANDARD' SCENARIO ( FIRST NUMBER IN THE
97 * GRID: 1.3478E-03 )
98 * FILE - NO. = 22 FOR NLO 'VALENCE' SCENARIO ( FIRST NUMBER IN THE
99 * GRID: 1.5146E-05 )
100 * FILE - NO. = 33 FOR LO 'STANDARD' SCENARIO ( FIRST NUMBER IN THE
101 * GRID: 3.4686E-03 )
102 * FILE - NO. = 44 FOR LO 'VALENCE' SCENARIO ( FIRST NUMBER IN THE
103 * GRID: 2.4395E-04 )
104  IF (iini.NE.0) goto 16
105  IF (iset.EQ.1) THEN
106  iiread=iplst(3)
107  OPEN(unit=iplst(3),file=cpol,status='OLD')
108  ELSE IF (iset.EQ.2) THEN
109  iiread=iplst(3)
110  OPEN(unit=iplst(3),file=cpol,status='OLD')
111  ELSE IF (iset.EQ.3) THEN
112  iiread=iplst(3)
113  OPEN(unit=iplst(3),file=cpol,status='OLD')
114  ELSE IF (iset.EQ.4) THEN
115  iiread=iplst(3)
116  OPEN(unit=iplst(3),file=cpol,status='OLD')
117  ELSE
118  WRITE(6,93)
119  93 FORMAT (2x,'PARTON INTERPOLATION: ISET OUT OF RANGE')
120  goto 60
121  END IF
122 C
123  DO 15 m = 1, nx-1
124  DO 15 n = 1, nq
125  READ(iiread,90) parton(1,n,m), parton(2,n,m), parton(3,n,m),
126  1 parton(4,n,m), parton(5,n,m), parton(6,n,m),
127  2 parton(7,n,m), parton(8,n,m)
128  90 FORMAT (8(1pe12.4))
129  15 CONTINUE
130  close(iiread)
131 C
132  iini = 1
133 *....ARRAYS FOR THE INTERPOLATION SUBROUTINE :
134  DO 10 iq = 1, nq
135  DO 20 ix = 1, nx-1
136  xb0 = xb(ix)
137  xb1 = 1.d0-xb(ix)
138  xuf(ix,iq) = parton(1,iq,ix) / (xb1**3 * xb0)
139  xdf(ix,iq) = parton(2,iq,ix) / (xb1**4 * xb0)
140  xubf(ix,iq) = parton(3,iq,ix) / (xb1**8 * xb0**0.5)
141  xdbf(ix,iq) = parton(4,iq,ix) / (xb1**8 * xb0**0.5)
142  xsf(ix,iq) = parton(5,iq,ix) / (xb1**8 * xb0**0.5)
143  xgf(ix,iq) = parton(6,iq,ix) / (xb1**5 * xb0**2.)
144  xg1p(ix,iq) = parton(7,iq,ix) / xb1**3
145  xg1n(ix,iq) = parton(8,iq,ix) / xb1**3
146  20 CONTINUE
147  xuf(nx,iq) = 0.d0
148  xdf(nx,iq) = 0.d0
149  xubf(nx,iq) = 0.d0
150  xdbf(nx,iq) = 0.d0
151  xsf(nx,iq) = 0.d0
152  xgf(nx,iq) = 0.d0
153  xg1p(nx,iq) = 0.d0
154  xg1n(nx,iq) = 0.d0
155  10 CONTINUE
156  na(1) = nx
157  na(2) = nq
158  DO 30 ix = 1, nx
159  arrf(ix) = dlog(xb(ix))
160  30 CONTINUE
161  DO 40 iq = 1, nq
162  arrf(nx+iq) = dlog(qs(iq))
163  40 CONTINUE
164  16 CONTINUE
165 *...INTERPOLATION :
166  xt(1) = dlog(x)
167  xt(2) = dlog(q2)
168  u = dfintnew(narg,xt,na,arrf,xuf) * (1.d0-x)**3 * x
169  d = dfintnew(narg,xt,na,arrf,xdf) * (1.d0-x)**4 * x
170  ub = dfintnew(narg,xt,na,arrf,xubf) * (1.d0-x)**8 * x**0.5
171  db = dfintnew(narg,xt,na,arrf,xdbf) * (1.d0-x)**8 * x**0.5
172  st = dfintnew(narg,xt,na,arrf,xsf) * (1.d0-x)**8 * x**0.5
173  gl = dfintnew(narg,xt,na,arrf,xgf) * (1.d0-x)**5 * x**2.
174  g1p = dfintnew(narg,xt,na,arrf,xg1p) * (1.d0-x)**3
175  g1n = dfintnew(narg,xt,na,arrf,xg1n) * (1.d0-x)**3
176  60 RETURN
177  END