negative indexes allowed
[u/mrichter/AliRoot.git] / PDF / npdf / structa.F
CommitLineData
82cedcfe 1#include "pdf/pilot.h"
2C
3C-----------------------------------------------------------------------
4C
5 SUBROUTINE STRUCTA(X,SCALE,ANO,
6 + UPV,DNV,USEA,DSEA,STR,CHM,BOT,TOP,GL)
7C
8C *********************************************************************
9C * *
10C * Main steering routine for all sets of structure functions *
11C * *
12C * *
13C * Input: X = x value of parton *
14C * SCALE = QCD scale in GeV *
15C * ANO = atomic mass number of a nucleus *
16C * *
17C * Output: UPV = up valence quark * Ruv-Npdf *
18C * DNV = down valence quark * Rdv-Npdf *
19C * USEA = sea (up_bar) * Rub-Npdf *
20C * DSEA = sea (down_bar) * Rdb-Npdf *
21C * STR = strange quark * Rs-Npdf *
22C * CHM = charm quark * Rc-Npdf *
23C * BOT = bottom quark * Rb-Npdf *
24C * TOP = top quark * Rt-Npdf *
25C * GL = gluon * Rg-Npdf *
26C * *
27C * *
28C * The variables NPTYPE, NGROUP and NSET and *
29C * the variables NATYPE, NAGROUP and NASET should be, *
30C * could be provided by the user via a call to the *
31C * subroutine PDFSET at the initialization phase, where *
32C * *
33C * NPTYPE = Particle type for proton PDF's *
34C * (number or character string, *
35C * 1,2,3 or 'NU','PI','PH') *
36C * of desired structure functions set *
37C * (Default: NPTYPE = 1 or 'NU' *
38C * NGROUP = author group for proton PDF's *
39C * (number or character string, *
40C * 1 to 7 or i.e. 'DFLM','MRS','MT','GRV',etc) *
41C * of desired structure functions set *
42C * (Default: NGROUP = 5 or 'GRV') *
43C * NSET = number of desired structure functions set *
44C * for proton PDF's *
45C * (Default: NSET = 3) *
46C * NATYPE = 4 for Nuclear Corrections *
47C * (Default: NATYPE = 4) *
48C * NAGROUP= author group of Nuclear Corrections *
49C * (number or character string, 1 or i.e. 'EKS')*
50C * of desired uclear Corrections set *
51C * (Default: NAGROUP = 1) *
52C * NASET = number of desired Nuclear Corrections set *
53C * (Default: NASET = 1) *
54C * *
55C * for each set of structure function. *
56C * *
57C * The internal COMMON blocks *
58C * *
59C * COMMON/W50511/ NPTYPE,NGROUP,NSET *
60C * COMMON/W50511a/ NATYPE,NAGROUP,NASET *
61C * *
62C * are filled then by the subroutine PDFSET. *
63C * *
64C * *
65C * Note: STRUCTA returns *
66C * X * parton distribution function * Nuclear Correction ! *
67C * *
68C * *
69C * Author: H. Plothow-Besch *
70C * CERN-ETT/TT, CH - 1211 Geneva 23, Switzerland *
71C * *
72C * Please return any problems, questions, suggestions *
73C * to the author *
74C * *
75C *********************************************************************
76C
77C
78#include "pdf/impdp.inc"
79C
80#include "pdf/w5051p1.inc"
81#include "pdf/w5051p2.inc"
82#include "pdf/w5051p7.inc"
83#include "pdf/w50510.inc"
84#include "pdf/w50511.inc"
85#include "pdf/w50511a.inc"
86#include "pdf/w50512.inc"
87#include "pdf/w50513.inc"
88#include "pdf/w50514.inc"
89#include "pdf/w50514w.inc"
90#include "pdf/w50515.inc"
91#include "pdf/w50516.inc"
92#include "pdf/w50517.inc"
93#include "pdf/w50519.inc"
94#include "pdf/w505120.inc"
95#include "pdf/w505121.inc"
96 CHARACTER*20 PARM(NCHDIM)
97#include "pdf/expdp.inc"
98 + VAL(NCHDIM)
99 DATA ZEROD/0.D0/,ONED/1.D0/,TWOD/2.D0/
100 SAVE /W50514/, /W50514W/, /W50516/
101C.
102#include "pdf/w50511c.inc"
103C.
104C User wants new version (4.0 or bigger) of PDFLIB format
105 IF (IFLSET.NE.1) THEN
106 IF(FIRST) THEN
107 WRITE(N6,*) ' Warning : NO initialisation via PDFSET made !!'
108 WRITE(N6,*)
109 + ' ALL Parameters set to default (Nucleon PDFs) !!'
110 ENDIF
111 NPTYPE = LPTYPE
112 NGROUP = LGROUP
113 NSET = LNSET
114C
115 PARM(1) = 'Nptype'
116 VAL(1) = NPTYPE
117 PARM(2) = 'Ngroup'
118 VAL(2) = NGROUP
119 PARM(3) = 'Nset'
120 VAL(3) = NSET
121C
122 NATYPE = LATYPE
123 NAGROUP = LAGROUP
124 NASET = LNASET
125C
126 PARM(4) = 'NAtype'
127 VAL(4) = NATYPE
128 PARM(5) = 'NAgroup'
129 VAL(5) = NAGROUP
130 PARM(6) = 'NAset'
131 VAL(6) = NASET
132C
133 CALL PDFSET(PARM,VAL)
134 ENDIF
135C.
136C... Define printer
137 IF(N6.LE.0) N6 = L6
138C
139 DUPV = ZEROD
140 DDNV = ZEROD
141 DUSEA = ZEROD
142 DDSEA = ZEROD
143 DSTR = ZEROD
144 DCHM = ZEROD
145 DBOT = ZEROD
146 DTOP = ZEROD
147 DGL = ZEROD
148C
149 DX = X
150 DQ = SCALE
151 DQ2 = SCALE*SCALE
152 DANO = ANO
153C.
154 IF (DX.LE.ZEROD .OR. DX.GE.ONED) THEN
155 WRITE(N6,*) ' PDFLIB : Nptype = ',NPTYPE,', Ngroup = ',
156 + NGROUP,', Nset = ',NSET
157 WRITE(N6,*)
158 + ' Error : X value outside physical range , X = ',DX
159 GOTO 100
160 ENDIF
161 WTXMIN = WTXMIN + PDFWGT
162 IF (DX.LT.XMIN) THEN
163 WXMIN = WXMIN + PDFWGT
164 IF(IFLPRT.GE.3) THEN
165 WRITE(N6,*) ' PDFLIB : Nptype = ',NPTYPE,', Ngroup = ',
166 + NGROUP,', Nset = ',NSET
167 WRITE(N6,*)
168 + ' Error : X value smaller allowed range , X = ',DX
169 ENDIF
170 ENDIF
171 WTXMAX = WTXMAX + PDFWGT
172 IF (DX.GT.XMAX) THEN
173 WXMAX = WXMAX + PDFWGT
174 IF(IFLPRT.GE.3) THEN
175 WRITE(N6,*) ' PDFLIB : Nptype = ',NPTYPE,', Ngroup = ',
176 + NGROUP,', Nset = ',NSET
177 WRITE(N6,*)
178 + ' Error : X value bigger allowed range , X = ',DX
179 ENDIF
180 GOTO 100
181 ENDIF
182 WTQ2MIN = WTQ2MIN + PDFWGT
183 IF (DQ2.LT.Q2MIN) THEN
184 WQ2MIN = WQ2MIN + PDFWGT
185 IF(IFLPRT.GE.3) THEN
186 WRITE(N6,*) ' PDFLIB : Nptype = ',NPTYPE,', Ngroup = ',
187 + NGROUP,', Nset = ',NSET
188 WRITE(N6,*)
189 + ' Error : SCALE value smaller allowed range , Q**2 = ',DQ2
190 ENDIF
191 ENDIF
192 WTQ2MAX = WTQ2MAX + PDFWGT
193 IF (DQ2.GT.Q2MAX) THEN
194 WQ2MAX = WQ2MAX + PDFWGT
195 IF(IFLPRT.GE.3) THEN
196 WRITE(N6,*) ' PDFLIB : Nptype = ',NPTYPE,', Ngroup = ',
197 + NGROUP,', Nset = ',NSET
198 WRITE(N6,*)
199 + ' Error : SCALE value bigger allowed range , Q**2 = ',DQ2
200 ENDIF
201 ENDIF
202C
203 IF (FIRST) WRITE(N6,*) ' '
204 IF (FIRST) WRITE(N6,*) ' '
205C Call default structure functions set
206C IF (NPTYPE.EQ.0 .OR. NGROUP.EQ.0 .OR. NSET.EQ.0) THEN
207C IF (FIRST) WRITE(N6,*)
208C + ' Nucleon PDFs : MRS central-g (L300-MSb) Structure Functions'
209C IF (FIRST) WRITE(N6,*)
210C + ' Ngroup = ',NGROUP,', Nset = ',NSET
211C CALL SFMRS_99A1
212C + (DX,DQ2,DUPV,DDNV,DUSEA,DDSEA,DSTR,DCHM,DBOT,DGL)
213C DTOP=ZEROD
214C GOTO 100
215C ENDIF
216C Start with NUCLEAR structure functions
217 IF(NATYPE.EQ.4) THEN
218 IF(NAGROUP.EQ.1) THEN
219 IF(NASET.EQ.1) THEN
220 IF (FIRST) WRITE(N6,*)
221 + ' Nuclear PDFs : EKS98 Structure Functions with Nuclear Correcti
222 +ons'
223 IF (FIRST) WRITE(N6,*)
224 + ' NAgroup = ',NAGROUP,', NAset = ',NASET
225 CALL SFEKS98(DX,DQ,DANO,
226 + DUPV,DDNV,DUSEA,DDSEA,DSTR,DCHM,DBOT,DTOP,DGL)
227 GOTO 100
228 ELSEIF(NASET.GE.2) THEN
229 WRITE(N6,*) ' Nuclear PDFs : NAgroup = ',NAGROUP,
230 + ', NAset = ',NASET,
231 + ', Structure Functions not yet exsistent'
232 STOP
233 ENDIF
234 ENDIF
235 ENDIF
236 100 IF(FIRST) WRITE(N6,*)
237 +' ----------------------------------------------------------------
238 +----------------------'
239 IF (FIRST) FIRST = .FALSE.
240C
241 UPV = MAX( ZEROD,DUPV)
242 DNV = MAX( ZEROD,DDNV)
243 USEA = MAX( ZEROD,DUSEA)
244 DSEA = MAX( ZEROD,DDSEA)
245 STR = MAX( ZEROD,DSTR)
246 CHM = MAX( ZEROD,DCHM)
247 BOT = MAX( ZEROD,DBOT)
248 TOP = MAX( ZEROD,DTOP)
249 GL = MAX( ZEROD,DGL)
250C
251 RETURN
252C
253 END