Changes to compile on Solaris 10 with f90 (Intel x86 platform). It does't like contin...
[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 #if defined(CERNLIB_DOUBLE)
98       DOUBLE PRECISION
99 #endif
100 #if defined(CERNLIB_SINGLE)
101       REAL
102 #endif
103      +       VAL(NCHDIM)
104       DATA ZEROD/0.D0/,ONED/1.D0/,TWOD/2.D0/
105       SAVE /W50514/, /W50514W/, /W50516/
106 C.
107 #include "pdf/w50511c.inc"
108 C.
109 C 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
119 C
120          PARM(1) = 'Nptype'
121          VAL(1)  = NPTYPE
122          PARM(2) = 'Ngroup'
123          VAL(2)  = NGROUP
124          PARM(3) = 'Nset'
125          VAL(3)  = NSET
126 C
127          NATYPE  = LATYPE
128          NAGROUP = LAGROUP
129          NASET   = LNASET
130 C
131          PARM(4) = 'NAtype'
132          VAL(4)  = NATYPE
133          PARM(5) = 'NAgroup'
134          VAL(5)  = NAGROUP
135          PARM(6) = 'NAset'
136          VAL(6)  = NASET
137 C
138          CALL PDFSET(PARM,VAL)
139       ENDIF
140 C.
141 C... Define printer
142            IF(N6.LE.0) N6 = L6
143 C
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
153 C
154         DX  = X
155         DQ  = SCALE
156         DQ2 = SCALE*SCALE
157         DANO = ANO
158 C.
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
207 C
208       IF (FIRST) WRITE(N6,*) ' '
209       IF (FIRST) WRITE(N6,*) ' '
210 C Call default structure functions set
211 C      IF    (NPTYPE.EQ.0 .OR. NGROUP.EQ.0 .OR. NSET.EQ.0) THEN
212 C          IF (FIRST) WRITE(N6,*)
213 C     + ' Nucleon PDFs :  MRS central-g (L300-MSb) Structure Functions'
214 C          IF (FIRST) WRITE(N6,*) 
215 C     + '                 Ngroup = ',NGROUP,',   Nset = ',NSET
216 C       CALL SFMRS_99A1
217 C     +               (DX,DQ2,DUPV,DDNV,DUSEA,DDSEA,DSTR,DCHM,DBOT,DGL)
218 C          DTOP=ZEROD
219 C          GOTO 100
220 C      ENDIF
221 C 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.
245 C
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)
255 C
256       RETURN
257 C
258       END