Adding MUON HLT code to the repository.
[u/mrichter/AliRoot.git] / PDF / npdf / structa.F
1 #include "pdf/pilot.h"
2 C
3 C-----------------------------------------------------------------------
4 C
5       SUBROUTINE STRUCTA(X,SCALE,ANO,
6      +                             UPV,DNV,USEA,DSEA,STR,CHM,BOT,TOP,GL)
7 C
8 C  *********************************************************************
9 C  *                                                                   *
10 C  *   Main steering routine for all sets of structure functions       *
11 C  *                                                                   *
12 C  *                                                                   *
13 C  *   Input:    X     = x value of parton                             *
14 C  *             SCALE = QCD scale in GeV                              *
15 C  *             ANO   = atomic mass number of a nucleus               *
16 C  *                                                                   *
17 C  *   Output:   UPV   = up valence quark * Ruv-Npdf                   *
18 C  *             DNV   = down valence quark * Rdv-Npdf                 *
19 C  *             USEA  = sea (up_bar) * Rub-Npdf                       *
20 C  *             DSEA  = sea (down_bar) * Rdb-Npdf                     *
21 C  *             STR   = strange quark * Rs-Npdf                       *
22 C  *             CHM   = charm quark * Rc-Npdf                         *
23 C  *             BOT   = bottom quark * Rb-Npdf                        *
24 C  *             TOP   = top quark * Rt-Npdf                           *
25 C  *             GL    = gluon * Rg-Npdf                               *
26 C  *                                                                   *
27 C  *                                                                   *
28 C  *   The variables  NPTYPE, NGROUP and NSET  and                     *
29 C  *   the variables  NATYPE, NAGROUP and NASET  should be,            *
30 C  *   could be provided by the user via a call to the                 *
31 C  *   subroutine PDFSET at the initialization phase, where            *
32 C  *                                                                   *
33 C  *             NPTYPE = Particle type for proton PDF's               *
34 C  *                      (number or character string,                 *
35 C  *                       1,2,3 or 'NU','PI','PH')                    *
36 C  *                      of desired structure functions set           *
37 C  *                      (Default: NPTYPE = 1  or  'NU'               *
38 C  *             NGROUP = author group for proton PDF's                *
39 C  *                      (number or character string,                 *
40 C  *                       1 to 7 or i.e. 'DFLM','MRS','MT','GRV',etc) *
41 C  *                      of desired structure functions set           *
42 C  *                      (Default: NGROUP = 5  or  'GRV')             *
43 C  *             NSET   = number of desired structure functions set    *
44 C  *                      for proton PDF's                             *
45 C  *                      (Default: NSET = 3)                          *
46 C  *             NATYPE = 4  for Nuclear Corrections                   *
47 C  *                      (Default: NATYPE = 4)                        *
48 C  *             NAGROUP= author group of Nuclear Corrections          *
49 C  *                      (number or character string, 1 or i.e. 'EKS')*
50 C  *                      of desired uclear Corrections set            *
51 C  *                      (Default: NAGROUP = 1)                       *
52 C  *             NASET  = number of desired Nuclear Corrections set    *
53 C  *                      (Default: NASET = 1)                         *
54 C  *                                                                   *
55 C  *   for each set of structure function.                             *
56 C  *                                                                   *
57 C  *   The internal COMMON blocks                                      *
58 C  *                                                                   *
59 C  *   COMMON/W50511/  NPTYPE,NGROUP,NSET                              *
60 C  *   COMMON/W50511a/ NATYPE,NAGROUP,NASET                            *
61 C  *                                                                   *
62 C  *   are filled then by the subroutine PDFSET.                       *
63 C  *                                                                   *
64 C  *                                                                   *
65 C  *     Note: STRUCTA returns                                         *
66 C  *           X * parton distribution function * Nuclear Correction ! *
67 C  *                                                                   *
68 C  *                                                                   *
69 C  *     Author:   H. Plothow-Besch                                    *
70 C  *               CERN-ETT/TT, CH - 1211 Geneva 23, Switzerland       *
71 C  *                                                                   *
72 C  *     Please return any problems, questions, suggestions            *
73 C  *     to the author                                                 *
74 C  *                                                                   *
75 C  *********************************************************************
76 C
77 C
78 #include "pdf/impdp.inc"
79 C
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/
101 C.
102 #include "pdf/w50511c.inc"
103 C.
104 C 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
114 C
115          PARM(1) = 'Nptype'
116          VAL(1)  = NPTYPE
117          PARM(2) = 'Ngroup'
118          VAL(2)  = NGROUP
119          PARM(3) = 'Nset'
120          VAL(3)  = NSET
121 C
122          NATYPE  = LATYPE
123          NAGROUP = LAGROUP
124          NASET   = LNASET
125 C
126          PARM(4) = 'NAtype'
127          VAL(4)  = NATYPE
128          PARM(5) = 'NAgroup'
129          VAL(5)  = NAGROUP
130          PARM(6) = 'NAset'
131          VAL(6)  = NASET
132 C
133          CALL PDFSET(PARM,VAL)
134       ENDIF
135 C.
136 C... Define printer
137            IF(N6.LE.0) N6 = L6
138 C
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
148 C
149         DX  = X
150         DQ  = SCALE
151         DQ2 = SCALE*SCALE
152         DANO = ANO
153 C.
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
202 C
203       IF (FIRST) WRITE(N6,*) ' '
204       IF (FIRST) WRITE(N6,*) ' '
205 C Call default structure functions set
206 C      IF    (NPTYPE.EQ.0 .OR. NGROUP.EQ.0 .OR. NSET.EQ.0) THEN
207 C          IF (FIRST) WRITE(N6,*)
208 C     + ' Nucleon PDFs :  MRS central-g (L300-MSb) Structure Functions'
209 C          IF (FIRST) WRITE(N6,*) 
210 C     + '                 Ngroup = ',NGROUP,',   Nset = ',NSET
211 C       CALL SFMRS_99A1
212 C     +               (DX,DQ2,DUPV,DDNV,DUSEA,DDSEA,DSTR,DCHM,DBOT,DGL)
213 C          DTOP=ZEROD
214 C          GOTO 100
215 C      ENDIF
216 C 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.
240 C
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)
250 C
251       RETURN
252 C
253       END