EIC Software
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Macros Groups Pages
parpol.F
Go to the documentation of this file. Or view the newest version in sPHENIX GitHub for file parpol.F
1 
2 
3 c********************************************************************
4 *********************************************************************
5 * *
6 * POLARIZED RADIATIVELY GENERATED LO AND NLO PARTON DENSITIES *
7 * *
8 * M. GLUCK, E. REYA, M. STRATMANN AND W. VOGELSANG, *
9 * DO-TH 95/13, RAL-TR-95-042 *
10 * (TO APPEAR IN PHYS. REV. D) *
11 * PROBLEMS/QUESTIONS TO VOGELSANG@V2.RL.AC.UK *
12 * OR TO STRAT@HAL1.PHYSIK.UNI-DORTMUND.DE *
13 * *
14 * INPUT: ISET = number of the parton set : *
15 * ISET = 1 'STANDARD' SCENARIO, NEXT-TO-LEADING ORDER *
16 * (DATA FILE 'STDNLO.GRID' UNIT=11, TO BE *
17 * DEFINED BY THE USER ) *
18 * ISET = 2 'VALENCE' SCENARIO, NEXT-TO-LEADING ORDER *
19 * (DATA FILE 'VALNLO.GRID' UNIT=22, TO BE *
20 * DEFINED BY THE USER ) *
21 * ISET = 3 'STANDARD' SCENARIO, LEADING ORDER *
22 * (DATA FILE 'STDLO.GRID' UNIT=33, TO BE *
23 * DEFINED BY THE USER ) *
24 * ISET = 4 'VALENCE' SCENARIO, LEADING ORDER *
25 * (DATA FILE 'VALLO.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.4 and 1.E4) *
30 * (for values outside the allowed range the program *
31 * writes a warning and extrapolates to the x and *
32 * Q2 values requested) *
33 * *
34 * OUTPUT: UV = x * ( DELTA u - DELTA u(bar) ), *
35 * DV = x * ( DELTA d - DELTA d(bar) ), *
36 * QB = x * POLARIZED LIGHT SEA, *
37 * QB= x * ( (DELTA U(BAR) + DELTA D(BAR))/2 ) *
38 * ST = x * DELTA STRANGE = x * DELTA STRANGE(BAR) *
39 * GL = x * DELTA GLUON *
40 * *
41 * always x times the distribution is returned *
42 * *
43 * The sets are the result of a combined fit to *
44 * data for the spin asymmetries A_1 (p,n,d) *
45 * *
46 * COMMON: The main program or the calling routine has to have *
47 * a common block COMMON / INTINI / IINI , and IINI *
48 * has always to be zero when PARPOL is called for the *
49 * first time or when 'ISET' has been changed. *
50 * *
51 *********************************************************************
52 *
53  SUBROUTINE parpol (ISET, X, Q2, UV, DV, QB, ST, GL)
54 
55  IMPLICIT NONE
56 
57  INTEGER imxpdf
58  parameter(imxpdf=40)
59  COMMON /pepadm/cpdfnam(2,imxpdf),ipdfnam(2,imxpdf),
60  & iplst(10),cunpol,cpol
61  CHARACTER*256 cpdfnam,cunpol,cpol
62  INTEGER iplst,ipdfnam
63  SAVE /pepadm/
64 
65 **************************************************************
66 *
67 * IPLST(1) = 0 (default) : number of PDF warnings
68 * IPLST(2) = 11 (default) : unit -1- for pdf files
69 * IPLST(3) = 12 (default) : unit -2- for pdf files
70 *
71 **************************************************************
72 
73 
74  real*8 xb1,dfint,xb0,q2,uv,x,st,gl,dv,qb,xb,qs,
75  & parton,arrf,xt,xqbf,xuvf,xdvf,xgf,xsf
76  integer n,iq,m,ix,iini,iset,npart,nx,nq,narg
77  & ,na
78 cywu<<
79  parameter(npart=5, nx=42, nq=21, narg=2)
80  dimension xuvf(nx,nq), xdvf(nx,nq), xqbf(nx,nq),
81  1 xsf(nx,nq), xgf(nx,nq), parton(npart,nq,nx-1),
82  2 qs(nq), xb(nx), xt(narg), na(narg), arrf(nx+nq)
83  COMMON / intini / iini
84  SAVE xuvf, xdvf, xqbf, xsf, xgf, na, arrf
85 *...BJORKEN-X AND Q**2 VALUES OF THE GRID :
86  DATA qs / 0.4d0, 0.75d0, 1.0d0, 1.5d0, 2.5d0,
87  1 4.0d0, 6.4d0, 1.0d1, 1.5d1, 2.5d1, 4.0d1, 6.4d1,
88  2 1.0d2, 1.8d2, 3.2d2, 5.8d2, 1.0d3, 1.8d3,
89  3 3.2d3, 5.8d3, 1.0d4 /
90  DATA xb / 1.d-4, 1.5d-4, 2.2d-4, 3.2d-4, 4.8d-4, 7.d-4,
91  2 1.d-3, 1.5d-3, 2.2d-3, 3.2d-3, 4.8d-3, 7.d-3,
92  3 1.d-2, 1.5d-2, 2.2d-2, 3.2d-2, 5.0d-2, 7.5d-2,
93  4 0.1, 0.125, 0.15, 0.175, 0.2, 0.225, 0.25, 0.275,
94  5 0.3, 0.325, 0.35, 0.375, 0.4, 0.45, 0.5, 0.55,
95  6 0.6, 0.65, 0.7, 0.75, 0.8, 0.85, 0.9, 1.0 /
96 *...CHECK OF X AND Q2 VALUES :
97  IF ( (x.LT.1.0d-4) .OR. (x.GT.1.0d0) ) THEN
98  WRITE(6,91)
99  91 FORMAT (2x,'PARTON INTERPOLATION: X OUT OF RANGE')
100 C GOTO 60
101  ENDIF
102  IF ( (q2.LT.0.4d0) .OR. (q2.GT.1.d4) ) THEN
103 cerwin WRITE(6,92)
104  92 FORMAT (2x,'PARTON INTERPOLATION: Q2 OUT OF RANGE')
105 cerwin write(6,*)'q2=',q2
106 C GOTO 60
107  ENDIF
108 *...INITIALIZATION :
109 * SELECTION AND READING OF THE GRID :
110 * FILE - NO. = 11 FOR NLO 'STANDARD' SCENARIO ( FIRST NUMBER IN THE
111 * GRID: 1.040E-03 )
112 * FILE - NO. = 22 FOR NLO 'VALENCE' SCENARIO ( FIRST NUMBER IN THE
113 * GRID: 9.740E-04 )
114 * FILE - NO. = 33 FOR LO 'STANDARD' SCENARIO ( FIRST NUMBER IN THE
115 * GRID: 1.731E-03 )
116 * FILE - NO. = 44 FOR LO 'VALENCE' SCENARIO ( FIRST NUMBER IN THE
117 * GRID: 1.846E-03 )
118  IF (iini.NE.0) goto 16
119  OPEN(iplst(3),file=cpol,status='OLD')
120 C
121  DO 15 m = 1, nx-1
122  DO 15 n = 1, nq
123  READ(iplst(3),90) parton(1,n,m), parton(2,n,m), parton(3,n,m),
124  1 parton(4,n,m), parton(5,n,m)
125  15 CONTINUE
126  CLOSE(iplst(3))
127  90 FORMAT (5(1pe10.3))
128 C
129  iini = 1
130 *.... ARRAYS FOR THE INTERPOLATION SUBROUTINE :
131  DO 10 iq = 1, nq
132  DO 20 ix = 1, nx-1
133  xb0 = xb(ix)
134  xb1 = 1.d0-xb(ix)
135  xuvf(ix,iq) = parton(1,iq,ix) / (xb1**3 * xb0**0.7)
136  xdvf(ix,iq) = parton(2,iq,ix) / (xb1**4 * xb0**0.6)
137  xqbf(ix,iq) = parton(3,iq,ix) / (xb1**7 * xb0**0.3)
138  xsf(ix,iq) = parton(4,iq,ix) / (xb1**7 * xb0**0.3)
139  xgf(ix,iq) = parton(5,iq,ix) / (xb1**10 * xb0**0.3)
140  20 CONTINUE
141  xuvf(nx,iq) = 0.d0
142  xdvf(nx,iq) = 0.d0
143  xqbf(nx,iq) = 0.d0
144  xsf(nx,iq) = 0.d0
145  xgf(nx,iq) = 0.d0
146  10 CONTINUE
147  na(1) = nx
148  na(2) = nq
149  DO 30 ix = 1, nx
150  arrf(ix) = dlog(xb(ix))
151  30 CONTINUE
152  DO 40 iq = 1, nq
153  arrf(nx+iq) = dlog(qs(iq))
154  40 CONTINUE
155  16 CONTINUE
156 *...INTERPOLATION :
157  xt(1) = dlog(x)
158  xt(2) = dlog(q2)
159  uv = dfint(narg,xt,na,arrf,xuvf) * (1.d0-x)**3 * x**0.7
160  dv = dfint(narg,xt,na,arrf,xdvf) * (1.d0-x)**4 * x**0.6
161  qb = dfint(narg,xt,na,arrf,xqbf) * (1.d0-x)**7 * x**0.3
162  st = dfint(narg,xt,na,arrf,xsf) * (1.d0-x)**7 * x**0.3
163  gl = dfint(narg,xt,na,arrf,xgf) * (1.d0-x)**10 * x**0.3
164  60 RETURN
165  END