Default shish-kebab geometry for EMCAL
[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)
7ef50f50 97#if defined(CERNLIB_DOUBLE)
98 DOUBLE PRECISION
99#endif
100#if defined(CERNLIB_SINGLE)
101 REAL
102#endif
82cedcfe 103 + VAL(NCHDIM)
104 DATA ZEROD/0.D0/,ONED/1.D0/,TWOD/2.D0/
105 SAVE /W50514/, /W50514W/, /W50516/
106C.
107#include "pdf/w50511c.inc"
108C.
109C User wants new version (4.0 or bigger) of PDFLIB format
110 IF (IFLSET.NE.1) THEN
111 IF(FIRST) THEN
112 WRITE(N6,*) ' Warning : NO initialisation via PDFSET made !!'
113 WRITE(N6,*)
114 + ' ALL Parameters set to default (Nucleon PDFs) !!'
115 ENDIF
116 NPTYPE = LPTYPE
117 NGROUP = LGROUP
118 NSET = LNSET
119C
120 PARM(1) = 'Nptype'
121 VAL(1) = NPTYPE
122 PARM(2) = 'Ngroup'
123 VAL(2) = NGROUP
124 PARM(3) = 'Nset'
125 VAL(3) = NSET
126C
127 NATYPE = LATYPE
128 NAGROUP = LAGROUP
129 NASET = LNASET
130C
131 PARM(4) = 'NAtype'
132 VAL(4) = NATYPE
133 PARM(5) = 'NAgroup'
134 VAL(5) = NAGROUP
135 PARM(6) = 'NAset'
136 VAL(6) = NASET
137C
138 CALL PDFSET(PARM,VAL)
139 ENDIF
140C.
141C... Define printer
142 IF(N6.LE.0) N6 = L6
143C
144 DUPV = ZEROD
145 DDNV = ZEROD
146 DUSEA = ZEROD
147 DDSEA = ZEROD
148 DSTR = ZEROD
149 DCHM = ZEROD
150 DBOT = ZEROD
151 DTOP = ZEROD
152 DGL = ZEROD
153C
154 DX = X
155 DQ = SCALE
156 DQ2 = SCALE*SCALE
157 DANO = ANO
158C.
159 IF (DX.LE.ZEROD .OR. DX.GE.ONED) THEN
160 WRITE(N6,*) ' PDFLIB : Nptype = ',NPTYPE,', Ngroup = ',
161 + NGROUP,', Nset = ',NSET
162 WRITE(N6,*)
163 + ' Error : X value outside physical range , X = ',DX
164 GOTO 100
165 ENDIF
166 WTXMIN = WTXMIN + PDFWGT
167 IF (DX.LT.XMIN) THEN
168 WXMIN = WXMIN + PDFWGT
169 IF(IFLPRT.GE.3) THEN
170 WRITE(N6,*) ' PDFLIB : Nptype = ',NPTYPE,', Ngroup = ',
171 + NGROUP,', Nset = ',NSET
172 WRITE(N6,*)
173 + ' Error : X value smaller allowed range , X = ',DX
174 ENDIF
175 ENDIF
176 WTXMAX = WTXMAX + PDFWGT
177 IF (DX.GT.XMAX) THEN
178 WXMAX = WXMAX + PDFWGT
179 IF(IFLPRT.GE.3) THEN
180 WRITE(N6,*) ' PDFLIB : Nptype = ',NPTYPE,', Ngroup = ',
181 + NGROUP,', Nset = ',NSET
182 WRITE(N6,*)
183 + ' Error : X value bigger allowed range , X = ',DX
184 ENDIF
185 GOTO 100
186 ENDIF
187 WTQ2MIN = WTQ2MIN + PDFWGT
188 IF (DQ2.LT.Q2MIN) THEN
189 WQ2MIN = WQ2MIN + PDFWGT
190 IF(IFLPRT.GE.3) THEN
191 WRITE(N6,*) ' PDFLIB : Nptype = ',NPTYPE,', Ngroup = ',
192 + NGROUP,', Nset = ',NSET
193 WRITE(N6,*)
194 + ' Error : SCALE value smaller allowed range , Q**2 = ',DQ2
195 ENDIF
196 ENDIF
197 WTQ2MAX = WTQ2MAX + PDFWGT
198 IF (DQ2.GT.Q2MAX) THEN
199 WQ2MAX = WQ2MAX + PDFWGT
200 IF(IFLPRT.GE.3) THEN
201 WRITE(N6,*) ' PDFLIB : Nptype = ',NPTYPE,', Ngroup = ',
202 + NGROUP,', Nset = ',NSET
203 WRITE(N6,*)
204 + ' Error : SCALE value bigger allowed range , Q**2 = ',DQ2
205 ENDIF
206 ENDIF
207C
208 IF (FIRST) WRITE(N6,*) ' '
209 IF (FIRST) WRITE(N6,*) ' '
210C Call default structure functions set
211C IF (NPTYPE.EQ.0 .OR. NGROUP.EQ.0 .OR. NSET.EQ.0) THEN
212C IF (FIRST) WRITE(N6,*)
213C + ' Nucleon PDFs : MRS central-g (L300-MSb) Structure Functions'
214C IF (FIRST) WRITE(N6,*)
215C + ' Ngroup = ',NGROUP,', Nset = ',NSET
216C CALL SFMRS_99A1
217C + (DX,DQ2,DUPV,DDNV,DUSEA,DDSEA,DSTR,DCHM,DBOT,DGL)
218C DTOP=ZEROD
219C GOTO 100
220C ENDIF
221C Start with NUCLEAR structure functions
222 IF(NATYPE.EQ.4) THEN
223 IF(NAGROUP.EQ.1) THEN
224 IF(NASET.EQ.1) THEN
225 IF (FIRST) WRITE(N6,*)
226 + ' Nuclear PDFs : EKS98 Structure Functions with Nuclear Correcti
227 +ons'
228 IF (FIRST) WRITE(N6,*)
229 + ' NAgroup = ',NAGROUP,', NAset = ',NASET
230 CALL SFEKS98(DX,DQ,DANO,
231 + DUPV,DDNV,DUSEA,DDSEA,DSTR,DCHM,DBOT,DTOP,DGL)
232 GOTO 100
233 ELSEIF(NASET.GE.2) THEN
234 WRITE(N6,*) ' Nuclear PDFs : NAgroup = ',NAGROUP,
235 + ', NAset = ',NASET,
236 + ', Structure Functions not yet exsistent'
237 STOP
238 ENDIF
239 ENDIF
240 ENDIF
241 100 IF(FIRST) WRITE(N6,*)
242 +' ----------------------------------------------------------------
243 +----------------------'
244 IF (FIRST) FIRST = .FALSE.
245C
246 UPV = MAX( ZEROD,DUPV)
247 DNV = MAX( ZEROD,DDNV)
248 USEA = MAX( ZEROD,DUSEA)
249 DSEA = MAX( ZEROD,DDSEA)
250 STR = MAX( ZEROD,DSTR)
251 CHM = MAX( ZEROD,DCHM)
252 BOT = MAX( ZEROD,DBOT)
253 TOP = MAX( ZEROD,DTOP)
254 GL = MAX( ZEROD,DGL)
255C
256 RETURN
257C
258 END