← Back to branch summary

~maddevelopers/mg5amcnlo/2.9.4

« back to all changes in this revision

Viewing changes to Template/NLO/MCatNLO/srcCommon/mcatnlo_libofpdf.f

pass to v2.0.0

Show diffs side-by-side

added added

removed removed

Lines of Context:
Template/NLO/MCatNLO/srcCommon/mcatnlo_libofpdf.f
 
1
C From hvq package (FMNR). Proton, photon and electron PDFs are kept
 
2
C PDFs from 1999 onwards taken from P. Nason code
 
3
C-----------------------------------------------------------------------
 
4
C------- START STRUCTURE FUNCTION SECTION -------------------------------
 
5
C--------------------------------------------------------------------------
 
6
 
 
7
C-------------------------------------------------------------------------
 
8
      SUBROUTINE PRNTSF
 
9
C     prints details of the structure function sets
 
10
C-------------------------------------------------------------------------
 
11
      WRITE(*,100)
 
12
     #  ' Set     Authors     Lambda_4    Lambda_5_2loop   Scheme'
 
13
     # ,'   1     DO I    *    .200 *      .340              MS  '
 
14
     # ,'   2     DO II   *    .400 *      .680              MS  '
 
15
     # ,'   3     EHLQ  I *    .200 *      .340              MS  '
 
16
     # ,'   4     EHLQ II *    .290 *      .490              MS  '
 
17
     # ,'   5     DFLM         .160        .101              DI  '
 
18
     # ,'   6     DFLM         .260        .173              DI  '
 
19
     # ,'   7     DFLM         .360        .250              DI  '
 
20
      WRITE(*,100)
 
21
     #  '  10     MRSA mod.    .230        .151              MS  '
 
22
     # ,'  11     HMRS B       .190        .122              MS  '
 
23
     # ,'  12     KMRS B       .190        .122              MS  '
 
24
     # ,'  13      MRS B       .135        .083              MS  '
 
25
     # ,'  14      MRS B       .160        .101              MS  '
 
26
     # ,'  15      MRS B       .200        .130              MS  '
 
27
     # ,'  16      MRS B       .235        .155              MS  '
 
28
     # ,'  17     MRSS0        .215        .140              MS  '
 
29
     # ,'  18     MRSD0        .215        .140              MS  '
 
30
     # ,'  19     MRSD-        .215        .140              MS  '
 
31
     # ,'  20     MRSA         .230        .151              MS  '
 
32
      WRITE(*,100)
 
33
     #  '  21     MT S1        .212        .138              DI  '
 
34
     # ,'  22     MT B1        .194        .125              DI  '
 
35
     # ,'  23     MT B2        .191        .123              DI  '
 
36
     # ,'  24     MT E1        .155        .097              DI  '
 
37
     # ,'  25     MT S1M       .212        .138              MS  '
 
38
     # ,'  26     MT 6 (1/2s)  .237        .156              DI  '
 
39
     # ,'  27     MT 6 (1/2s)  .237        .156              MS  '
 
40
     # ,'  28     MT LO   *    .144 *      .245              MS  '
 
41
      WRITE(*,100)
 
42
     #  '  40     DGK PHOTON*  .400*       .680              MS  '
 
43
     # ,'  41     ACFGP-MC PH  .200        .130              MS  '
 
44
     # ,'  42     AFG-MC PH    .200        .130              MS  '
 
45
     # ,'  43     GRV-HO PH    .200        .130              DI_G'
 
46
     # ,'  44     LAC1 PH*     .200        .130              MS  '
 
47
     # ,'  45     GRS-HO PH    .268        .179              DI_G'
 
48
      WRITE(*,100)
 
49
     #  '  51     LAC1 EL*     .200        .130              MS  '
 
50
     # ,'  52     GRV-G HO EL  .200        .130              DI_G'
 
51
     # ,'  53     USER DEF EL                                    '
 
52
      WRITE(*,100)
 
53
     #  '  61     CTEQ1M       .231        .152              MS  '
 
54
     # ,'  62     CTEQ1MS      .231        .152              MS  '
 
55
     # ,'  63     CTEQ1ML      .322        .220              MS  '
 
56
     # ,'  64     CTEQ1D       .247        .164              DI  '
 
57
     # ,'  65     CTEQ1L  *    .168 *      .249              MS  '
 
58
     # ,'  66     CTEQ3M       .239        .158              MS  '
 
59
     # ,'  67     CTEQ3L  *    .177 *      .263              MS  '
 
60
     # ,'  68     CTEQ3D       .247        .164              DI  '
 
61
      WRITE(*,100)
 
62
     #  '  71     MRSA prime   .231        .152              MS  '
 
63
     # ,'  72     MRSG         .255        .170              MS  '
 
64
     # ,'  73     MRS105       .158        .0994             MS  '
 
65
     # ,'  74     MRS110       .214        .140              MS  '
 
66
     # ,'  75     MRS115       .282        .190              MS  '
 
67
     # ,'  76     MRS120       .364        .253              MS  '
 
68
     # ,'  77     MRS125       .458        .328              MS  '
 
69
     # ,'  78     MRS130       .566        .416              MS  '
 
70
      WRITE(*,100)
 
71
     #  '  81     CTEQ4M       .298        .202              MS  '
 
72
     # ,'  82     CTEQ4D       .298        .202              DI  '
 
73
     # ,'  83     CTEQ4L *     .298        .202              MS  '
 
74
     # ,'  84     CTEQ4A1      .214        .140              MS  '
 
75
     # ,'  85     CTEQ4A2      .254        .169              MS  '
 
76
     # ,'  86     CTEQ4A4      .346        .239              MS  '
 
77
     # ,'  87     CTEQ4A5      .400        .281              MS  '
 
78
     # ,'  88     CTEQ4HJ      .298        .202              MS  '
 
79
     # ,'  89     CTEQ4LQ      .268        .179              MS  '
 
80
      WRITE(*,100)
 
81
     #  '  91     MRSR1(1996)  .241        .159              MS  '
 
82
     # ,'  92     MRSR2  ..    .344        .237              MS  '
 
83
     # ,'  93     MRSR3  ..    .241        .159              MS  '
 
84
     # ,'  94     MRSR4  ..    .344        .237              MS  '
 
85
     # ,'  95     MRST1(1998)  .321        .220              MS  '
 
86
     # ,'  96     MRSTH  ..    .321        .220              MS  '
 
87
     # ,'  97     MRSTL  ..    .321        .220              MS  '
 
88
     # ,'  98     MRSTM  ..    .247        .164              MS  '
 
89
     # ,'  99     MRSTP  ..    .409        .288              MS  '
 
90
      WRITE(*,100)
 
91
     #  ' 101     CTEQ5M       .329        .226  (as=0.118)  MS  ' 
 
92
     # ,' 102     CTEQ5D       .329        .226  (as=0.118)  DI  ' 
 
93
     # ,' 103     CTEQ5L       .497        .359  (as=0.127)  MS  ' 
 
94
     # ,' 104     CTEQ5HJ      .329        .226  (as=0.118)  MS  ' 
 
95
     # ,' 105     CTEQ5HQ      .329        .226  (as=0.118)  MS  ' 
 
96
     # ,' 106     CTEQ5F3      Nf=3, L_3=.395    (as=0.106)  MS  ' 
 
97
     # ,' 107     CTEQ5F4      Nf=4, L_4=.309    (as=0.112)  MS  ' 
 
98
     # ,' 108     CTEQ5M1      .329        .226  (as=0.118)  MS  ' 
 
99
     # ,' 109     CTEQ5HQ1     .329        .226  (as=0.118)  MS  ' 
 
100
     # ,' 110     CTEQ5M1 (parametrized version)                  '
 
101
      WRITE(*,100)
 
102
     #  ' 111     MRST99 COR01 .321        .220              MS  '
 
103
     # ,' 112     MRSTH  COR02 .321        .220              MS  '
 
104
     # ,' 113     MRSTL  COR03 .321        .220              MS  '
 
105
     # ,' 114     MRSTM  COR04 .247        .164              MS  '
 
106
     # ,' 115     MRSTP  COR05 .409        .288              MS  '
 
107
     # ,' 116     MRST99 COR06 .327        .224              MS  '
 
108
     # ,' 117     MRST99 COR07 .315        .215              MS  '
 
109
     # ,' 118     MRST99 COR08 .321        .220              MS  '
 
110
     # ,' 119     MRST99 COR09 .321        .220              MS  '
 
111
     # ,' 120     MRST99 COR10 .321        .220              MS  '
 
112
     # ,' 121     MRST99 COR11 .321        .220              MS  '
 
113
     # ,' 122     MRST99 COR12 .321        .220              MS  '
 
114
      WRITE(*,100)
 
115
     #  ' 131     CTEQ6M       .326        .226  (as=0.118)  MS  ' 
 
116
     # ,' 132     CTEQ6D       .326        .226  (as=0.118)  DI  ' 
 
117
     # ,' 133     CTEQ6L       .326        .226  (as=0.118)  MS  ' 
 
118
     # ,' 134-173 CTEQ6M1xx    .326        .226  (as=0.118)  MS  ' 
 
119
      write(*,100)
 
120
     #  ' 181     MRST2001NNLO av.   .290  .196  (as=0.1155) MS  '
 
121
     # ,' 182     MRST2001NNLO fast  .290  .196  (as=0.1155) MS  '
 
122
     # ,' 183     MRST2001NNLO slow  .290  .196  (as=0.1155) MS  '
 
123
     # ,' 184     MRST2001NNLO jet   .326  .226  (as=0.118)  MS  '
 
124
     # ,' 185     MRST2001  best fit .347  .239  (as=0.119)  MS  '
 
125
     # ,' 186     MRST2001  low as   .313  .214  (as=0.117)  MS  '
 
126
     # ,' 187     MRST2001  high as  .382  .267  (as=0.121)  MS  '
 
127
     # ,' 188     MRST2001  jet fit  .382  .267  (as=0.121)  MS  '
 
128
     # ,' 189     MRST2001lo         .566  .416  (as=0.130)  LO  '
 
129
      write(*,100)
 
130
     #  ' 191     MRST2002     .359        .249  (as=0.1197) MS  '
 
131
     # ,' 192     MRST2002NNLO .289        .195  (as=0.1154) MS  '
 
132
     # ,' 200-230 MRS2001E     .347        .239  (as=0.119)  MS  '
 
133
      write(*,100) 
 
134
     #  '         Alekhin pdf sets'
 
135
     #, ' 231     LO  nominal ffn          .418  (as=0.1301) MS  '
 
136
     #, ' 232     LO  nominal vfn'
 
137
     #, ' 233     LO  mc=1.75 ffn'
 
138
     #, ' 234     LO  mc=1.75 vfn'   
 
139
     #, ' 235     LO  ss      ffn'   
 
140
     #, ' 236     LO  ss      vfn'   
 
141
     #, ' 237     NLO  nominal ffn         .215  (as=0.1171) MS  '
 
142
     #, ' 238     NLO  nominal vfn'
 
143
     #, ' 239     NLO  mc=1.75 ffn'
 
144
     #, ' 240     NLO  mc=1.75 vfn'   
 
145
     #, ' 241     NLO  ss      ffn'   
 
146
     #, ' 242     NLO  ss      vfn'   
 
147
     #, ' 243     NNLO  nominal ffn        .182  (as=0.1143) MS  '
 
148
     #, ' 244     NNLO  nominal vfn'
 
149
     #, ' 245     NNLO  mc=1.75 ffn'
 
150
     #, ' 246     NNLO  mc=1.75 vfn'   
 
151
     #, ' 247     NNLO  ss      ffn'   
 
152
     #, ' 248     NNLO  ss      vfn'   
 
153
     #, ' 249     NNLO  slow ev ffn'   
 
154
     #, ' 250     NNLO  slow ev vfn'   
 
155
     #, ' To get the sets with errorrs, do:'
 
156
     #, ' call errsk(i), con i=-15...15. After this, calls to'
 
157
     #, ' mlmpdf will return the pdf minus (plus) the variation'
 
158
     #, ' if the |ith| parameter'
 
159
C ---------------------------------------------------------------------------
 
160
      WRITE(*,100)                             
 
161
     #  '  PDF sets followed by * are obtained from a 1-loop analysis,'
 
162
     # ,'  and the relative values of Lambda_4 refer to 1-loop. '
 
163
     # ,'  Lambda is automatically converted to 2-loop for use with '
 
164
     # ,'  a 2-loop alpha in the program. The conversion is performed'
 
165
     # ,'  in such a way that at a scale of 10 GeV the value of alpha'
 
166
     # ,'  is the same. The MSbar subtr. scheme'
 
167
     # ,'  is used by default with 1-loop structure functions.'
 
168
     # ,'  MT set 26 has SU(3)-violating strange sea distributions'
 
169
     # ,'  Morfin and Tung sets labeled 25 and 27 are simply MSbar '
 
170
     # ,'  versions of sets 21 and 26, respectively.'
 
171
     # ,'  Sets 13-16 are MRS fits of BCDMS data using'
 
172
     # ,'  different values of Lambda PHYS REV D43 (91) 3648.'
 
173
     # ,'  Sets 17-19 are the new NMC/CCFR fits by MRS (RAL-92-021)'
 
174
      WRITE(*,100)                             
 
175
     #  '  Set 20: MRSA (Durham preprint, DTP/94/34)'
 
176
     # ,'  Set 71: MRSA prime (Durham preprint, DTP/95/14)'
 
177
     # ,'  Set 72: MRSG (Durham preprint, DTP/95/14)'
 
178
     # ,'  Sets 73-78 are the MRS structure functions '
 
179
     # ,'  with variable Lambda. The values of Lambda5 quoted '
 
180
     # ,'  here correspond to values of alpha(Mz) of 0.105,0.110,0.115'
 
181
     # ,'  0.120,0.125,0.130, which is slightly different from the'
 
182
     # ,'  values one would obtain with the usual matching procedure'
 
183
     # ,'  from the corresponding value of Lambda4 quoted by MRS'
 
184
      WRITE(*,100)
 
185
     #  '  Sets 61-65 are the CTEQ1 fits (61=default, 62=sing.gluon,'
 
186
     # ,'  63= LEP lambda, 64=DIS scheme, 65=LO fit).'
 
187
     # ,'  Sets 81-89 are the CTEQ4 fits, H.L. Lai et al.,'
 
188
     # ,'  CTEQ-604, hep-ph/9606399, (81=default, 82=DIS scheme,'
 
189
     # ,'  83=leading order, 84-87=variable Lambda, 88=High-et jet fit,'
 
190
     # ,'  89=low momentum evolution)'
 
191
      WRITE(*,100)                             
 
192
     #  '  Set 40 corresponds to photon PDF''s by Drees, Grassie, Kim'
 
193
     # ,'  Z.Phys. C28 (1985) 51 and DTP/91/16'
 
194
     # ,'  Set 41 corresponds to photon PDF''s Aurenche et al.'
 
195
     # ,'  Set 42 corresponds to photon PDF''s Aurenche et al. (1994)'
 
196
     # ,'  Set 43 corresponds to photon PDF''s Glueck et al.'
 
197
     # ,'  Set 44 corresponds to photon PDF''s Abramowicz et al.'
 
198
     # ,'  Set 45 corresponds to photon PDF''s GRS (99)'
 
199
     # ,'  Set 51 corresponds to electron with photon LAC1'
 
200
     # ,'  Set 52 corresponds to electron with photon GRV-G HO'
 
201
     # ,'  Set 53 corresponds to electron (user-defined)'
 
202
     # ,'  GRV-G HO photon uses the DIS_gamma scheme, defined'
 
203
     # ,'  in Gluck, Reya and Vogt, Phys. Rev. D45(1992)3986.'
 
204
 100  FORMAT(1X,A,100(/,1X,A))
 
205
      END
 
206
 
 
207
      SUBROUTINE PDFPAR(J,IH,XLAM,SCHE,IRET)
 
208
      PARAMETER (NPDF=250)
 
209
C LAMBDA VALUES (lAMBDA_5FLAVOUR_2LOOP) FOR DIFFERENT PARTON DENSITIES
 
210
      IMPLICIT REAL * 8 (A-H,O-Z)
 
211
      CHARACTER * 2 SCHE,SCH(NPDF)
 
212
      DIMENSION XLA(NPDF)
 
213
      DATA SCH/4*'MS',3*'DI',2*'  ',
 
214
     # 11*'MS',
 
215
     #  4*'DI','MS','DI',2*'MS',2*'  ',
 
216
     #  3*'MS',6*' ',
 
217
c photon densities
 
218
     #  3*'MS','DG','MS','DG',5*'  ',
 
219
c electron densities
 
220
     #  'MS','DG','**',7*'  ',
 
221
c CTEQ1
 
222
     #  3*'MS','DI','MS',
 
223
c CTEQ3
 
224
     #  2*'MS','DI',2*'  ',
 
225
c MRSAp, MRSG, MRSalpha
 
226
     #  8*'MS',2*'  ',
 
227
c CTEQ4
 
228
     #  'MS','DI',7*'MS','  ',
 
229
c MRSR and MRST
 
230
     #  9*'MS','  ',
 
231
c CTEQ5
 
232
     #  'MS','DI',6*'MS',2*'MS',
 
233
c MRST99
 
234
     #  12*'MS',8*'  ',
 
235
C CTEQ6
 
236
     #  'MS','DI','MS',40*'MS',7*'  ',
 
237
c MRS2001NNLO
 
238
     #  4*'MS',
 
239
c MRS2001
 
240
     #  4*'MS','LO',' ',
 
241
c MRST2002
 
242
     #  2*'MS',7*' ',
 
243
c MRST2002E
 
244
     # 31*'MS',
 
245
c Alekhin
 
246
     # 20*'MS'/
 
247
c
 
248
      DATA XLA/
 
249
c 1 DO
 
250
     # .34D0,.68D0,.34D0,.49D0,
 
251
     # .101D0,.173D0,.250D0,2*0.D0,
 
252
c 10 MRSA mod
 
253
     # .151d0,.122D0,.122D0,.083D0,.101D0,.130D0,.155D0,3*.140d0,.151d0,
 
254
c 21 MT S1
 
255
     # .138D0,.125D0,.123D0,.097D0,.138d0,2*.156d0,.245d0,2*0.D0,
 
256
     #  3*.122D0,6*0.D0,
 
257
c 40 photon densities
 
258
     #  0.68D0,4*.130D0,0.1793D0,5*0.D0,
 
259
c 51 electron densities
 
260
     #  2*0.130D0,0.001d0,7*0.D0,
 
261
c 61 CTEQ1M
 
262
     #  2*0.152D0,0.220D0,0.164D0,0.249D0,
 
263
c 66 CTEQ3M
 
264
     #  0.158d0,0.263d0,0.164d0,2*0.D0,
 
265
c 71 MRSA prime
 
266
     #  0.152D0,0.170D0,
 
267
c 73 MRSA-alpha dependent
 
268
     #  0.09936d0,0.1396d0,0.1903d0,0.2526d0,0.3276d0,0.4162d0,2*0.D0,
 
269
c The values given above for the MRSXXX sets are consistent with the 
 
270
c alfas(Mz) given by MRS. The values    
 
271
c     #  .094d0,0.130d0,0.178d0,0.237d0,0.309d0,0.396d0/
 
272
c are on the other hand consistent with the Lambda_4 given by MRS
 
273
c CTEQ4
 
274
     #  3*0.2018d0,0.1396d0,0.1687d0,
 
275
     #  0.2392d0,0.2811d0,0.2018d0,0.1793d0,0.d0,
 
276
c 91-94 MRSR
 
277
     #  0.159d0,0.237d0,0.159d0,0.237d0,
 
278
c 95-99 MRST                       
 
279
     #  3*0.220d0,0.164d0,0.288d0,0.d0,
 
280
C 101-110 CTEQ5                    
 
281
     #  2*0.226d0,0.359d0,2*0.226d0,2*1.d-8,0.226d0,2*0.226d0,
 
282
c 111-122 MRST99
 
283
     #  3*.220d0,.164d0,.288d0,.224d0,.215d0,5*.220d0,8*0d0,
 
284
C 131-173 CTEQ6
 
285
     # 43*0.226D0,7*0d0,
 
286
C 181-184, MRS2001NNLO
 
287
     # 3*0.196d0,0.226d0,
 
288
c 185-189, MRS2001
 
289
     # 0.239d0,0.214d0,2*0.267d0,0.416d0,0d0,
 
290
c 191-192, MRST2002
 
291
     # 0.249d0,0.195d0,7*0d0,
 
292
c 200-230
 
293
     # 31*0.239d0,
 
294
c 231-250, Alekhin 20 sets
 
295
     # 6*0.418d0,6*0.215d0,8*0.182d0/
 
296
      IRET=0       
 
297
      IF(ABS(IH).NE.1.AND.IH.NE.4.AND.IH.NE.5)THEN
 
298
        WRITE(*,*) ' HADRON TPYE ',IH,' NOT IMPLEMENTED'
 
299
        IRET=1
 
300
        RETURN
 
301
      ENDIF
 
302
      IF(J.LT.1.OR.J.GT.NPDF) THEN
 
303
        WRITE(*,*) ' PDF SET ',J,' NOT EXISTING'
 
304
        IRET=1
 
305
        RETURN
 
306
      ENDIF
 
307
C LAMBDA_QCD, MSbar, 5 FLAVOURS
 
308
      XLAM = XLA(J)
 
309
C SCHEME
 
310
      SCHE = SCH(J)
 
311
      IF(XLAM.EQ.0.OR.SCHE.EQ.'  ') THEN
 
312
        WRITE(*,*) ' PDF SET ',J,' NOT EXISTING'
 
313
        IRET=1
 
314
        RETURN
 
315
      ENDIF
 
316
C CHECK IF HADRON TYPE AND PDF SET ARE CONSISTENT
 
317
      IF(
 
318
     #  ABS(IH).EQ.1
 
319
C It is a proton/antiproton
 
320
     # .AND. J.NE.1
 
321
C It is not DO I
 
322
     # .AND. J.NE.2
 
323
C It is not DO II
 
324
     # .AND. J.NE.3
 
325
C It is not EHLQ I
 
326
     # .AND. J.NE.4
 
327
C It is not EHLQ II
 
328
     # .AND. J.NE.5
 
329
C It is not DFLM 160
 
330
     # .AND. J.NE.6
 
331
C It is not DFLM 260
 
332
     # .AND. J.NE.7
 
333
C It is not DFLM 360
 
334
     # .AND. J.NE.10
 
335
C It is not MRSA modified
 
336
     # .AND. J.NE.11
 
337
C It is not HMRS B
 
338
     # .AND. J.NE.12
 
339
C It is not KMRS B
 
340
     # .AND. J.NE.13
 
341
C It is not MRS B135
 
342
     # .AND. J.NE.14
 
343
C It is not MRS B160
 
344
     # .AND. J.NE.15
 
345
C It is not MRS B200
 
346
     # .AND. J.NE.16
 
347
C It is not MRS B235
 
348
     # .AND. J.NE.17
 
349
C It is not MRS S0
 
350
     # .AND. J.NE.18
 
351
C It is not MRS D0
 
352
     # .AND. J.NE.19
 
353
C It is not MRSD-
 
354
     # .AND. J.NE.20
 
355
C It is not MRSA
 
356
     # .AND. J.NE.21
 
357
C It is not MT S1
 
358
     # .AND. J.NE.22
 
359
C It is not MT B1
 
360
     # .AND. J.NE.23
 
361
C It is not MT B2
 
362
     # .AND. J.NE.24
 
363
C It is not MT E1
 
364
     # .AND. J.NE.25
 
365
C It is not MT S1M
 
366
     # .AND. J.NE.26
 
367
C It is not MT S2
 
368
     # .AND. J.NE.27
 
369
C It is not MT S2M
 
370
     # .AND. J.NE.28
 
371
C It is not MT SL
 
372
     # .AND. J.NE.61
 
373
C It is not CTEQ1M
 
374
     # .AND. J.NE.62
 
375
C It is not CTEQ1MS
 
376
     # .AND. J.NE.63
 
377
C It is not CTEQ1ML
 
378
     # .AND. J.NE.64
 
379
C It is not CTEQ1D
 
380
     # .AND. J.NE.65
 
381
C It is not CTEQ1L
 
382
     # .AND. J.NE.66
 
383
C It is not CTEQ3M
 
384
     # .AND. J.NE.67
 
385
C It is not CTEQ3L
 
386
     # .AND. J.NE.68
 
387
C It is not CTEQ3D
 
388
     # .AND. J.NE.71
 
389
C It is not MRSA prime
 
390
     # .AND. J.NE.72
 
391
C It is not MRSG
 
392
     # .AND. J.NE.73
 
393
C It is not MRS105
 
394
     # .AND. J.NE.74
 
395
C It is not MRS110
 
396
     # .AND. J.NE.75
 
397
C It is not MRS115
 
398
     # .AND. J.NE.76
 
399
C It is not MRS120
 
400
     # .AND. J.NE.77
 
401
C It is not MRS125
 
402
     # .AND. J.NE.78
 
403
C It is not MRS130
 
404
     # .AND. J.NE.81
 
405
C It is not CTEQ4M
 
406
     # .AND. J.NE.82
 
407
C It is not CTEQ4D
 
408
     # .AND. J.NE.83
 
409
C It is not CTEQ4L
 
410
     # .AND. J.NE.84
 
411
C It is not CTEQ4A1
 
412
     # .AND. J.NE.85
 
413
C It is not CTEQ4A2
 
414
     # .AND. J.NE.86
 
415
C It is not CTEQ4A4
 
416
     # .AND. J.NE.87
 
417
C It is not CTEQ4A5
 
418
     # .AND. J.NE.88
 
419
C It is not CTEQ4HJ
 
420
     # .AND. J.NE.89
 
421
C It is not CTEQ4LQ
 
422
     # .AND. J.NE.91
 
423
C It is not MRSR1
 
424
     # .AND. J.NE.92
 
425
C It is not MRSR2
 
426
     # .AND. J.NE.93
 
427
C It is not MRSR3
 
428
     # .AND. J.NE.94
 
429
C It is not MRSR4
 
430
     # .AND. J.NE.95
 
431
C It is not MRST1
 
432
     # .AND. J.NE.96
 
433
C It is not MRSTH
 
434
     # .AND. J.NE.97
 
435
C It is not MRSTL
 
436
     # .AND. J.NE.98
 
437
C It is not MRSTM
 
438
     # .AND. J.NE.99 
 
439
C It is not MRSTP
 
440
     # .AND. J.NE.101 
 
441
C It is not CTEQ5M
 
442
     # .AND. J.NE.102 
 
443
C It is not CTEQ5D
 
444
     # .AND. J.NE.103 
 
445
C It is not CTEQ5L
 
446
     # .AND. J.NE.104 
 
447
C It is not CTEQ5HJ
 
448
     # .AND. J.NE.105 
 
449
C It is not CTEQ5HQ
 
450
     # .AND. J.NE.106 
 
451
C It is not CTEQ5F3
 
452
     # .AND. J.NE.107 
 
453
C It is not CTEQ5F4
 
454
     # .AND. J.NE.108
 
455
C It is not CTEQ5M1
 
456
     # .AND. J.NE.109
 
457
C It is not CTEQ5HQ1
 
458
     # .AND. J.NE.110
 
459
C It is not CTEQ5M1 parametrized form
 
460
     # .AND. J.NE.111 
 
461
C It is not MRST991
 
462
     # .AND. J.NE.112 
 
463
C It is not MRST992
 
464
     # .AND. J.NE.113 
 
465
C It is not MRST993
 
466
     # .AND. J.NE.114 
 
467
C It is not MRST994
 
468
     # .AND. J.NE.115 
 
469
C It is not MRST995
 
470
     # .AND. J.NE.116 
 
471
C It is not MRST996
 
472
     # .AND. J.NE.117 
 
473
C It is not MRST997
 
474
     # .AND. J.NE.118 
 
475
C It is not MRST998
 
476
     # .AND. J.NE.119 
 
477
C It is not MRST999
 
478
     # .AND. J.NE.120 
 
479
C It is not MRST9910
 
480
     # .AND. J.NE.121 
 
481
C It is not MRST9911
 
482
     # .AND. J.NE.122 
 
483
C It is not MRST9912
 
484
     # .AND. J.NE.131
 
485
C It is not CTEQ6M
 
486
     # .AND. J.NE.132
 
487
C It is not CTEQ6D
 
488
     # .AND. J.NE.133
 
489
C It is not CTEQ6L
 
490
     # .AND. (.NOT.(J.GE.134.AND.J.LE.173))
 
491
C It is not CTEQ6M1xx
 
492
     # .AND. J.NE.181
 
493
C It is not MRST2001NNLO av
 
494
     # .AND. J.NE.182
 
495
C It is not MRST2001NNLO fast
 
496
     # .AND. J.NE.183
 
497
C It is not MRST2001NNLO slow
 
498
     # .AND. J.NE.184
 
499
C It is not MRST2001NNLO jet
 
500
     # .AND. J.NE.185
 
501
C It is not MRST2001 best fit
 
502
     # .AND. J.NE.186
 
503
C It is not MRST2001 low as
 
504
     # .AND. J.NE.187
 
505
C It is not MRST2001 high as
 
506
     # .AND. J.NE.188
 
507
C It is not MRST2001 jet fit
 
508
     # .AND. J.NE.189
 
509
C It is not MRST2001  lo
 
510
     # .AND. J.NE.191
 
511
C It is not MRST2002
 
512
     # .AND. J.NE.192
 
513
C It is not MRST2002NNLO
 
514
     # .AND. (.NOT.(J.GE.200.AND.J.LE.230))
 
515
C It is not MRST2001Exx
 
516
     # .AND. (.NOT.(J.GE.231.AND.J.LE.250)) )
 
517
C It is not Alekhinxx
 
518
C It is not a proton PDF
 
519
     # THEN
 
520
         WRITE(*,*) ' PDF SET ',J,' NOT AVAILABLE FOR PROTONS'
 
521
         SCHE='XX'
 
522
         XLAM=0.0
 
523
         IRET=1
 
524
         RETURN
 
525
      ENDIF
 
526
      IF(
 
527
     #  ABS(IH).EQ.4
 
528
C It is a photon
 
529
     # .AND. J.NE.40
 
530
C It is not Drees e Grassie
 
531
     # .AND. J.NE.41 
 
532
C It is not ACFGP
 
533
     # .AND. J.NE.42 
 
534
C It is not AFG
 
535
     # .AND. J.NE.43
 
536
C It is not GRV-HO
 
537
     # .AND. J.NE.44 
 
538
C It is not LAC1
 
539
     # .AND. J.NE.45 )
 
540
C It is not GRS-HO
 
541
C It is not a photon PDF
 
542
     # THEN
 
543
         WRITE(*,*) ' PDF SET ',J,' NOT AVAILABLE FOR PHOTONS'
 
544
         SCHE='XX'
 
545
         XLAM=0.0
 
546
         IRET=1
 
547
         RETURN
 
548
      ENDIF
 
549
      IF(
 
550
     #  ABS(IH).EQ.5
 
551
C It is an electron
 
552
     # .AND. J.NE.51 
 
553
C It is not LAC1
 
554
     # .AND. J.NE.52
 
555
C It is not GRV-G HO
 
556
     # .AND. J.NE.53 )
 
557
C It is not USER DEFINED
 
558
     # THEN
 
559
         WRITE(*,*) ' PDF SET ',J,' NOT AVAILABLE FOR ELECTRONS'
 
560
         SCHE='XX'
 
561
         XLAM=0.0
 
562
         IRET=1
 
563
         RETURN
 
564
      ENDIF
 
565
      END
 
566
 
 
567
C--------------------------------------------------
 
568
C- STRUCTURE FUNCTION MAIN PROGRAM
 
569
C--------------------------------------------------
 
570
      SUBROUTINE MLMPDF(NDNS,IH,Q2,X,FX,NF)
 
571
      REAL FX(-NF:NF),DISF(13)
 
572
      INTEGER IPAR(-6:6)
 
573
      DATA IPAR/12,11,10,9,7,8,13,2,1,3,4,5,6/
 
574
C Fix to prevent undefined math operations for x=1.
 
575
C Assumes that all structure functions vanish for x=1.
 
576
C Modified on 7/11/2008 to exclude also x<=0 and x>1
 
577
      IF(X.LE.0.OR.X.GE.1) THEN
 
578
         DO J=-NF,NF
 
579
            FX(J) = 0
 
580
         ENDDO
 
581
         RETURN
 
582
      ENDIF
 
583
C
 
584
      IH0=IH
 
585
      IF(IH.EQ.0) IH0=1
 
586
      IF(NDNS.LE.4) THEN
 
587
C--DO1,DO2,EHLQ1,EHLQ2
 
588
           Q=SQRT(Q2)
 
589
           CALL DOEHLQ(X,Q,IH0,NDNS,DISF,NF)
 
590
        DO I =-NF,NF
 
591
           FX(I) = DISF(IPAR(I)) / X
 
592
        ENDDO
 
593
      ELSEIF(NDNS.LE.9) THEN
 
594
C--DFLM
 
595
        ISET=NDNS-4
 
596
        CALL DFLM(ISET,IH0,Q2,X,FX,NF)
 
597
      ELSEIF(NDNS.LE.10) THEN
 
598
C--MRSA modified
 
599
        CALL XMRSA(Q2,X,FX,NF)
 
600
      ELSEIF(NDNS.LE.20) THEN
 
601
C--MRS,HMRS,KMRS SETS
 
602
        ISET=NDNS-10
 
603
        CALL HMRS(ISET,IH0,Q2,X,FX,NF)
 
604
      ELSEIF(NDNS.LE.30) THEN
 
605
C--MORFIN AND TUNG
 
606
        ISET=NDNS-20
 
607
        CALL TUNG(ISET,IH0,Q2,X,FX,NF)
 
608
      ELSEIF(NDNS.LE.45) THEN
 
609
C--PHOTON PDFS
 
610
        ISET=NDNS-40
 
611
        IF(ISET.EQ.0) THEN
 
612
C--DREES,GRASSIE, KIM 
 
613
           CALL PHOPDF(Q2,X,FX,NF)
 
614
        ELSEIF(ISET.EQ.1) THEN
 
615
C--AURENCHE ET AL
 
616
            CALL FONPDF(Q2,X,FX,NF)
 
617
        ELSEIF(ISET.EQ.2) THEN
 
618
C--AURENCHE 1994
 
619
            CALL AFGPDF(Q2,X,FX,NF)
 
620
        ELSEIF(ISET.EQ.3) THEN
 
621
C--GLUECK NLO
 
622
            CALL GRV_PH(Q2,X,FX,NF)
 
623
        ELSEIF(ISET.EQ.4) THEN
 
624
C--LAC
 
625
            CALL XLAC(1,Q2,X,FX,NF)
 
626
        ELSEIF(ISET.EQ.5) THEN
 
627
C--GRS NLO
 
628
            CALL GRS_PH(Q2,X,FX,NF)
 
629
        ENDIF
 
630
C--ELECTRON PDFS
 
631
      ELSEIF(NDNS.LE.53) THEN
 
632
        ISET=NDNS-50
 
633
        IF(ISET.EQ.1) THEN
 
634
            CALL ELPDF_LAC1(Q2,X,FX,NF)
 
635
        ELSEIF(ISET.EQ.2) THEN
 
636
            CALL ELPDF_GRV(Q2,X,FX,NF)
 
637
        ELSEIF(ISET.EQ.3) THEN
 
638
            CALL ELPDF_USER(Q2,X,FX,NF)
 
639
        ENDIF
 
640
      ELSEIF(NDNS.LE.65) THEN
 
641
C-- CTEQ1 FITS          
 
642
        ISET=NDNS-60
 
643
        CALL CTEQ(ISET,IH0,Q2,X,FX,NF)
 
644
      ELSEIF(NDNS.LE.70) THEN
 
645
C-- CTEQ3 FITS          
 
646
        ISET=NDNS-65
 
647
        CALL CTEQ3(ISET,IH0,Q2,X,FX,NF)
 
648
      ELSEIF(NDNS.LE.80) THEN
 
649
C-- MRSAP, MRSG AND MRS WITH VARIABLE LAMBDA
 
650
        ISET=NDNS-60
 
651
        CALL HMRS(ISET,IH0,Q2,X,FX,NF)
 
652
      ELSEIF(NDNS.LE.89) THEN
 
653
C-- CTEQ4 FITS          
 
654
        ISET=NDNS-80
 
655
        CALL CTEQ4(ISET,IH0,Q2,X,FX,NF)
 
656
      ELSEIF(NDNS.LE.99) THEN
 
657
C-- MRSR/T sets        
 
658
        ISET=NDNS-60
 
659
        CALL HMRS(ISET,IH0,Q2,X,FX,NF)
 
660
      ELSEIF(NDNS.LE.110) THEN
 
661
C-- CTEQ5 FITS          
 
662
        ISET=NDNS-100
 
663
        CALL CTEQ5(ISET,IH0,Q2,X,FX,NF)
 
664
      ELSEIF(NDNS.LE.122) THEN
 
665
C-- MRST99 sets        
 
666
        ISET=NDNS-70
 
667
        CALL HMRS(ISET,IH0,Q2,X,FX,NF)
 
668
      ELSEIF(NDNS.LE.173) THEN
 
669
C-- CTEQ6 FITS          
 
670
        ISET=NDNS-130
 
671
        IF(ISET.GE.4) ISET=ISET-3+100
 
672
        CALL CTEQ6(ISET,IH0,Q2,X,FX,NF)
 
673
C-- MRSTNNLO (200?)
 
674
      ELSEIF(NDNS.LE.184) THEN
 
675
        ISET=NDNS-(184-56)
 
676
        CALL HMRS(ISET,IH0,Q2,X,FX,NF)
 
677
C-- MRST2001
 
678
      ELSEIF(NDNS.LE.188) THEN
 
679
        ISET=NDNS-(188-60) 
 
680
        CALL HMRS(ISET,IH0,Q2,X,FX,NF)
 
681
C-- MRST2001 lo
 
682
      ELSEIF(NDNS.EQ.189) THEN
 
683
        ISET=NDNS-(189-61) 
 
684
        CALL HMRS(ISET,IH0,Q2,X,FX,NF)
 
685
C-- MRST2002, MRST2002NNLO
 
686
      ELSEIF(NDNS.LE.192) THEN
 
687
        ISET=NDNS-(192-63) 
 
688
        CALL HMRS(ISET,IH0,Q2,X,FX,NF)
 
689
C-- MRST2001E
 
690
      ELSEIF(NDNS.LE.230) THEN
 
691
         ISET=NDNS-(230-94) 
 
692
         CALL HMRS(ISET,IH0,Q2,X,FX,NF)
 
693
C-- ALEKHIN
 
694
      ELSEIF(NDNS.LE.250) THEN
 
695
         ISET=NDNS-230 
 
696
         CALL ALEKHIN(ISET,X,Q2,FX,NF)
 
697
         CALL HADCONV(FX,IH0,NF)
 
698
      ELSE
 
699
        WRITE(*,*) ' STRUCTURE FUNCTION SET NOT DEFINED , STOP'
 
700
        STOP
 
701
      ENDIF
 
702
      IF(IH.EQ.0) THEN
 
703
        FX(1)  = 0.5 * ( FX(1)+FX(2) )
 
704
        FX(-1) = 0.5 * ( FX(-1)+FX(-2) )
 
705
        FX(2)  = FX(1)
 
706
        FX(-2) = FX(-1)
 
707
      ENDIF
 
708
      END
 
709
 
 
710
 
 
711
      subroutine hadconv(fx,ih0,nf)
 
712
      implicit none
 
713
      integer nf,ih0,j
 
714
      real * 4 fx(-nf:nf),tmp
 
715
      if(ih0.eq.-1) then
 
716
c antiproton
 
717
         do j=1,nf
 
718
            tmp=fx(j)
 
719
            fx(j)=fx(-j)
 
720
            fx(-j)=tmp
 
721
         enddo
 
722
      elseif(ih0.eq.2) then
 
723
c neutron
 
724
         tmp=fx(1)
 
725
         fx(1)=fx(2)
 
726
         fx(2)=tmp
 
727
         tmp=fx(-1)
 
728
         fx(-1)=fx(-2)
 
729
         fx(-2)=tmp
 
730
      elseif(ih0.eq.0) then
 
731
c nucleon
 
732
         fx(1)=(fx(1)+fx(2))/2
 
733
         fx(2)=fx(1)
 
734
         fx(-1)=(fx(-1)+fx(-2))/2
 
735
         fx(-2)=fx(-1)
 
736
      elseif(ih0.ne.1) then
 
737
         write(*,*) ' hadron ',ih0, 'not implemented'
 
738
         stop
 
739
      endif
 
740
      end
 
741
 
 
742
 
 
743
C------------------------------------------------------------------------
 
744
      SUBROUTINE DOEHLQ(X,SCALE,IDHAD,NSET,DIST,NF)
 
745
C     NUCLEON AND PION STRUCTURE FUNCTIONS DIST=X*QRK(X,Q=SCALE)
 
746
C
 
747
C     IDHAD = TYPE OF HADRON:
 
748
C     1 = P   -1 = PBAR  2 = N   -2 = NBAR  38 = PI+  30 = PI-
 
749
C
 
750
C     NSET = STRUCTURE FUNCTION SET
 
751
C          = 1,2 FOR DUKE+OWENS SETS 1,2 (SOFT/HARD GLUE)
 
752
C          = 3,4 FOR EICHTEN ET AL SETS 1,2 (NUCLEON ONLY)
 
753
C
 
754
C   DUKE+OWENS = D.W.DUKE AND J.F.OWENS, PHYS. REV. D30 (1984) 49 (P/N)
 
755
C              + J.F.OWENS, PHYS. REV. D30 (1984) 943 (PI+/-)
 
756
C   WITH EXTRA SIGNIFICANT FIGURES VIA ED BERGER
 
757
C   WARNING....MOMENTUM SUM RULE BADLY VIOLATED ABOVE 1 TEV
 
758
C   PION NOT RELIABLE ABOVE SCALE = 50 GEV
 
759
C
 
760
C   EICHTEN ET AL = E.EICHTEN,I.HINCHLIFFE,K.LANE AND C.QUIGG,
 
761
C                   REV. MOD. PHYS. 56 (1984) 579
 
762
C   REVISED AS IN   REV. MOD. PHYS. 58 (1986) 1065
 
763
C   RELIABLE RANGE : SQRT(5)GEV < SCALE < 10TEV, 1E-4 < X < 1
 
764
C
 
765
C------------------------------------------------------------------------
 
766
      REAL DIST(13),G(2),Q0(4),QL(4),F(5),A(6,5),B(3,6,5,4)
 
767
      REAL XQ(6),TX(6),TT(6),TB(6),NEHLQ(8,2),CEHLQ(6,6,2,8,2)
 
768
      REAL TBMIN(2),TTMIN(2)
 
769
      DATA (((B(I,J,K,1),I=1,3),J=1,6),K=1,5)/
 
770
     &3.,0.,0.,.419,.004383,-.007412,
 
771
     &3.46,.72432,-.065998,4.4,-4.8644,1.3274,
 
772
     &6*0.,1.,
 
773
     &0.,0.,.763,-.23696,.025836,4.,.62664,-.019163,
 
774
     &0.,-.42068,.032809,6*0.,1.265,-1.1323,.29268,
 
775
     &0.,-.37162,-.028977,8.05,1.5877,-.15291,
 
776
     &0.,6.3059,-.27342,0.,-10.543,-3.1674,
 
777
     &0.,14.698,9.798,0.,.13479,-.074693,
 
778
     &-.0355,-.22237,-.057685,6.3494,3.2649,-.90945,
 
779
     &0.,-3.0331,1.5042,0.,17.431,-11.255,
 
780
     &0.,-17.861,15.571,1.564,-1.7112,.63751,
 
781
     &0.,-.94892,.32505,6.,1.4345,-1.0485,
 
782
     &9.,-7.1858,.25494,0.,-16.457,10.947,
 
783
     &0.,15.261,-10.085/
 
784
      DATA (((B(I,J,K,2),I=1,3),J=1,6),K=1,5)/
 
785
     &3.,0.,0.,.3743,.013946,-.00031695,
 
786
     &3.329,.75343,-.076125,6.032,-6.2153,1.5561,
 
787
     &6*0.,1.,0.,
 
788
     &0.,.7608,-.2317,.023232,3.83,.62746,-.019155,
 
789
     &0.,-.41843,.035972,6*0.,1.6714,-1.9168,.58175,
 
790
     &0.,-.27307,-.16392,9.145,.53045,-.76271,
 
791
     &0.,15.665,-2.8341,0.,-100.63,44.658,
 
792
     &0.,223.24,-116.76,0.,.067368,-.030574,
 
793
     &-.11989,-.23293,-.023273,3.5087,3.6554,-.45313,
 
794
     &0.,-.47369,.35793,0.,9.5041,-5.4303,
 
795
     &0.,-16.563,15.524,.8789,-.97093,.43388,
 
796
     &0.,-1.1612,.4759,4.,1.2271,-.25369,
 
797
     &9.,-5.6354,-.81747,0.,-7.5438,5.5034,
 
798
     &0.,-.59649,.12611/
 
799
      DATA (((B(I,J,K,3),I=1,3),J=1,6),K=1,5)/
 
800
     &1.,0.,0.,0.4,-0.06212,-0.007109,0.7,0.6478,0.01335,27*0.,
 
801
     &0.9,-0.2428,0.1386,0.,-0.2120,0.003671,5.0,0.8673,0.04747,
 
802
     &0.,1.266,-2.215,0.,2.382,0.3482,3*0.,
 
803
     &0.,0.07928,-0.06134,-0.02212,-0.3785,-0.1088,2.894,9.433,
 
804
     &-10.852,0.,5.248,-7.187,0.,8.388,-11.61,3*0.,
 
805
     &0.888,-1.802,1.812,0.,-1.576,1.20,3.11,-0.1317,0.5068,
 
806
     &6.0,2.801,-12.16,0.,-17.28,20.49,3*0./
 
807
      DATA (((B(I,J,K,4),I=1,3),J=1,6),K=1,5)/
 
808
     &1.,0.,0.,0.4,-0.05909,-0.006524,0.628,0.6436,0.01451,27*0.,
 
809
     &0.90,-0.1417,-0.1740,0.,-0.1697,-0.09623,5.0,-2.474,1.575,
 
810
     &0.,-2.534,1.378,0.,0.5621,-0.2701,3*0.,
 
811
     &0.,0.06229,-0.04099,-0.0882,-0.2892,-0.1082,1.924,0.2424,
 
812
     &2.036,0.,-4.463,5.209,0.,-0.8367,-0.04840,3*0.,
 
813
     &0.794,-0.9144,0.5966,0.,-1.237,0.6582,2.89,0.5966,-0.2550,
 
814
     &6.0,-3.671,-2.304,0.,-8.191,7.758,3*0./
 
815
C...THE FOLLOWING DATA LINES ARE COEFFICIENTS NEEDED IN THE
 
816
C...EICHTEN, HINCHLIFFE, LANE, QUIGG PROTON STRUCTURE FUNCTION
 
817
C...POWERS OF 1-X IN DIFFERENT CASES
 
818
      DATA NEHLQ/3,4,7,5,7,7,7,7,3,4,7,6,7,7,7,7/
 
819
C...EXPANSION COEFFICIENTS FOR UP VALENCE QUARK DISTRIBUTION
 
820
      DATA (((CEHLQ(IX,IT,NX,1,1),IX=1,6),IT=1,6),NX=1,2)/
 
821
     1 7.677E-01,-2.087E-01,-3.303E-01,-2.517E-02,-1.570E-02,-1.000E-04,
 
822
     2-5.326E-01,-2.661E-01, 3.201E-01, 1.192E-01, 2.434E-02, 7.620E-03,
 
823
     3 2.162E-01, 1.881E-01,-8.375E-02,-6.515E-02,-1.743E-02,-5.040E-03,
 
824
     4-9.211E-02,-9.952E-02, 1.373E-02, 2.506E-02, 8.770E-03, 2.550E-03,
 
825
     5 3.670E-02, 4.409E-02, 9.600E-04,-7.960E-03,-3.420E-03,-1.050E-03,
 
826
     6-1.549E-02,-2.026E-02,-3.060E-03, 2.220E-03, 1.240E-03, 4.100E-04,
 
827
     1 2.395E-01, 2.905E-01, 9.778E-02, 2.149E-02, 3.440E-03, 5.000E-04,
 
828
     2 1.751E-02,-6.090E-03,-2.687E-02,-1.916E-02,-7.970E-03,-2.750E-03,
 
829
     3-5.760E-03,-5.040E-03, 1.080E-03, 2.490E-03, 1.530E-03, 7.500E-04,
 
830
     4 1.740E-03, 1.960E-03, 3.000E-04,-3.400E-04,-2.900E-04,-1.800E-04,
 
831
     5-5.300E-04,-6.400E-04,-1.700E-04, 4.000E-05, 6.000E-05, 4.000E-05,
 
832
     6 1.700E-04, 2.200E-04, 8.000E-05, 1.000E-05,-1.000E-05,-1.000E-05/
 
833
      DATA (((CEHLQ(IX,IT,NX,1,2),IX=1,6),IT=1,6),NX=1,2)/
 
834
     1 7.237E-01,-2.189E-01,-2.995E-01,-1.909E-02,-1.477E-02, 2.500E-04,
 
835
     2-5.314E-01,-2.425E-01, 3.283E-01, 1.119E-01, 2.223E-02, 7.070E-03,
 
836
     3 2.289E-01, 1.890E-01,-9.859E-02,-6.900E-02,-1.747E-02,-5.080E-03,
 
837
     4-1.041E-01,-1.084E-01, 2.108E-02, 2.975E-02, 9.830E-03, 2.830E-03,
 
838
     5 4.394E-02, 5.116E-02,-1.410E-03,-1.055E-02,-4.230E-03,-1.270E-03,
 
839
     6-1.991E-02,-2.539E-02,-2.780E-03, 3.430E-03, 1.720E-03, 5.500E-04,
 
840
     1 2.410E-01, 2.884E-01, 9.369E-02, 1.900E-02, 2.530E-03, 2.400E-04,
 
841
     2 1.765E-02,-9.220E-03,-3.037E-02,-2.085E-02,-8.440E-03,-2.810E-03,
 
842
     3-6.450E-03,-5.260E-03, 1.720E-03, 3.110E-03, 1.830E-03, 8.700E-04,
 
843
     4 2.120E-03, 2.320E-03, 2.600E-04,-4.900E-04,-3.900E-04,-2.300E-04,
 
844
     5-6.900E-04,-8.200E-04,-2.000E-04, 7.000E-05, 9.000E-05, 6.000E-05,
 
845
     6 2.400E-04, 3.100E-04, 1.100E-04, 0.000E+00,-2.000E-05,-2.000E-05/
 
846
C...EXPANSION COEFFICIENTS FOR DOWN VALENCE QUARK DISTRIBUTION
 
847
      DATA (((CEHLQ(IX,IT,NX,2,1),IX=1,6),IT=1,6),NX=1,2)/
 
848
     1 3.813E-01,-8.090E-02,-1.634E-01,-2.185E-02,-8.430E-03,-6.200E-04,
 
849
     2-2.948E-01,-1.435E-01, 1.665E-01, 6.638E-02, 1.473E-02, 4.080E-03,
 
850
     3 1.252E-01, 1.042E-01,-4.722E-02,-3.683E-02,-1.038E-02,-2.860E-03,
 
851
     4-5.478E-02,-5.678E-02, 8.900E-03, 1.484E-02, 5.340E-03, 1.520E-03,
 
852
     5 2.220E-02, 2.567E-02,-3.000E-05,-4.970E-03,-2.160E-03,-6.500E-04,
 
853
     6-9.530E-03,-1.204E-02,-1.510E-03, 1.510E-03, 8.300E-04, 2.700E-04,
 
854
     1 1.261E-01, 1.354E-01, 3.958E-02, 8.240E-03, 1.660E-03, 4.500E-04,
 
855
     2 3.890E-03,-1.159E-02,-1.625E-02,-9.610E-03,-3.710E-03,-1.260E-03,
 
856
     3-1.910E-03,-5.600E-04, 1.590E-03, 1.590E-03, 8.400E-04, 3.900E-04,
 
857
     4 6.400E-04, 4.900E-04,-1.500E-04,-2.900E-04,-1.800E-04,-1.000E-04,
 
858
     5-2.000E-04,-1.900E-04, 0.000E+00, 6.000E-05, 4.000E-05, 3.000E-05,
 
859
     6 7.000E-05, 8.000E-05, 2.000E-05,-1.000E-05,-1.000E-05,-1.000E-05/
 
860
      DATA (((CEHLQ(IX,IT,NX,2,2),IX=1,6),IT=1,6),NX=1,2)/
 
861
     1 3.578E-01,-8.622E-02,-1.480E-01,-1.840E-02,-7.820E-03,-4.500E-04,
 
862
     2-2.925E-01,-1.304E-01, 1.696E-01, 6.243E-02, 1.353E-02, 3.750E-03,
 
863
     3 1.318E-01, 1.041E-01,-5.486E-02,-3.872E-02,-1.038E-02,-2.850E-03,
 
864
     4-6.162E-02,-6.143E-02, 1.303E-02, 1.740E-02, 5.940E-03, 1.670E-03,
 
865
     5 2.643E-02, 2.957E-02,-1.490E-03,-6.450E-03,-2.630E-03,-7.700E-04,
 
866
     6-1.218E-02,-1.497E-02,-1.260E-03, 2.240E-03, 1.120E-03, 3.500E-04,
 
867
     1 1.263E-01, 1.334E-01, 3.732E-02, 7.070E-03, 1.260E-03, 3.400E-04,
 
868
     2 3.660E-03,-1.357E-02,-1.795E-02,-1.031E-02,-3.880E-03,-1.280E-03,
 
869
     3-2.100E-03,-3.600E-04, 2.050E-03, 1.920E-03, 9.800E-04, 4.400E-04,
 
870
     4 7.700E-04, 5.400E-04,-2.400E-04,-3.900E-04,-2.400E-04,-1.300E-04,
 
871
     5-2.600E-04,-2.300E-04, 2.000E-05, 9.000E-05, 6.000E-05, 4.000E-05,
 
872
     6 9.000E-05, 1.000E-04, 2.000E-05,-2.000E-05,-2.000E-05,-1.000E-05/
 
873
C...EXPANSION COEFFICIENTS FOR UP AND DOWN SEA QUARK DISTRIBUTIONS
 
874
      DATA (((CEHLQ(IX,IT,NX,3,1),IX=1,6),IT=1,6),NX=1,2)/
 
875
     1 6.870E-02,-6.861E-02, 2.973E-02,-5.400E-03, 3.780E-03,-9.700E-04,
 
876
     2-1.802E-02, 1.400E-04, 6.490E-03,-8.540E-03, 1.220E-03,-1.750E-03,
 
877
     3-4.650E-03, 1.480E-03,-5.930E-03, 6.000E-04,-1.030E-03,-8.000E-05,
 
878
     4 6.440E-03, 2.570E-03, 2.830E-03, 1.150E-03, 7.100E-04, 3.300E-04,
 
879
     5-3.930E-03,-2.540E-03,-1.160E-03,-7.700E-04,-3.600E-04,-1.900E-04,
 
880
     6 2.340E-03, 1.930E-03, 5.300E-04, 3.700E-04, 1.600E-04, 9.000E-05,
 
881
     1 1.014E+00,-1.106E+00, 3.374E-01,-7.444E-02, 8.850E-03,-8.700E-04,
 
882
     2 9.233E-01,-1.285E+00, 4.475E-01,-9.786E-02, 1.419E-02,-1.120E-03,
 
883
     3 4.888E-02,-1.271E-01, 8.606E-02,-2.608E-02, 4.780E-03,-6.000E-04,
 
884
     4-2.691E-02, 4.887E-02,-1.771E-02, 1.620E-03, 2.500E-04,-6.000E-05,
 
885
     5 7.040E-03,-1.113E-02, 1.590E-03, 7.000E-04,-2.000E-04, 0.000E+00,
 
886
     6-1.710E-03, 2.290E-03, 3.800E-04,-3.500E-04, 4.000E-05, 1.000E-05/
 
887
      DATA (((CEHLQ(IX,IT,NX,3,2),IX=1,6),IT=1,6),NX=1,2)/
 
888
     1 1.008E-01,-7.100E-02, 1.973E-02,-5.710E-03, 2.930E-03,-9.900E-04,
 
889
     2-5.271E-02,-1.823E-02, 1.792E-02,-6.580E-03, 1.750E-03,-1.550E-03,
 
890
     3 1.220E-02, 1.763E-02,-8.690E-03,-8.800E-04,-1.160E-03,-2.100E-04,
 
891
     4-1.190E-03,-7.180E-03, 2.360E-03, 1.890E-03, 7.700E-04, 4.100E-04,
 
892
     5-9.100E-04, 2.040E-03,-3.100E-04,-1.050E-03,-4.000E-04,-2.400E-04,
 
893
     6 1.190E-03,-1.700E-04,-2.000E-04, 4.200E-04, 1.700E-04, 1.000E-04,
 
894
     1 1.081E+00,-1.189E+00, 3.868E-01,-8.617E-02, 1.115E-02,-1.180E-03,
 
895
     2 9.917E-01,-1.396E+00, 4.998E-01,-1.159E-01, 1.674E-02,-1.720E-03,
 
896
     3 5.099E-02,-1.338E-01, 9.173E-02,-2.885E-02, 5.890E-03,-6.500E-04,
 
897
     4-3.178E-02, 5.703E-02,-2.070E-02, 2.440E-03, 1.100E-04,-9.000E-05,
 
898
     5 8.970E-03,-1.392E-02, 2.050E-03, 6.500E-04,-2.300E-04, 2.000E-05,
 
899
     6-2.340E-03, 3.010E-03, 5.000E-04,-3.900E-04, 6.000E-05, 1.000E-05/
 
900
C...EXPANSION COEFFICIENTS FOR GLUON DISTRIBUTION
 
901
      DATA (((CEHLQ(IX,IT,NX,4,1),IX=1,6),IT=1,6),NX=1,2)/
 
902
     1 9.482E-01,-9.578E-01, 1.009E-01,-1.051E-01, 3.456E-02,-3.054E-02,
 
903
     2-9.627E-01, 5.379E-01, 3.368E-01,-9.525E-02, 1.488E-02,-2.051E-02,
 
904
     3 4.300E-01,-8.306E-02,-3.372E-01, 4.902E-02,-9.160E-03, 1.041E-02,
 
905
     4-1.925E-01,-1.790E-02, 2.183E-01, 7.490E-03, 4.140E-03,-1.860E-03,
 
906
     5 8.183E-02, 1.926E-02,-1.072E-01,-1.944E-02,-2.770E-03,-5.200E-04,
 
907
     6-3.884E-02,-1.234E-02, 5.410E-02, 1.879E-02, 3.350E-03, 1.040E-03,
 
908
     1 2.948E+01,-3.902E+01, 1.464E+01,-3.335E+00, 5.054E-01,-5.915E-02,
 
909
     2 2.559E+01,-3.955E+01, 1.661E+01,-4.299E+00, 6.904E-01,-8.243E-02,
 
910
     3-1.663E+00, 1.176E+00, 1.118E+00,-7.099E-01, 1.948E-01,-2.404E-02,
 
911
     4-2.168E-01, 8.170E-01,-7.169E-01, 1.851E-01,-1.924E-02,-3.250E-03,
 
912
     5 2.088E-01,-4.355E-01, 2.239E-01,-2.446E-02,-3.620E-03, 1.910E-03,
 
913
     6-9.097E-02, 1.601E-01,-5.681E-02,-2.500E-03, 2.580E-03,-4.700E-04/
 
914
      DATA (((CEHLQ(IX,IT,NX,4,2),IX=1,6),IT=1,6),NX=1,2)/
 
915
     1 2.367E+00, 4.453E-01, 3.660E-01, 9.467E-02, 1.341E-01, 1.661E-02,
 
916
     2-3.170E+00,-1.795E+00, 3.313E-02,-2.874E-01,-9.827E-02,-7.119E-02,
 
917
     3 1.823E+00, 1.457E+00,-2.465E-01, 3.739E-02, 6.090E-03, 1.814E-02,
 
918
     4-1.033E+00,-9.827E-01, 2.136E-01, 1.169E-01, 5.001E-02, 1.684E-02,
 
919
     5 5.133E-01, 5.259E-01,-1.173E-01,-1.139E-01,-4.988E-02,-2.021E-02,
 
920
     6-2.881E-01,-3.145E-01, 5.667E-02, 9.161E-02, 4.568E-02, 1.951E-02,
 
921
     1 3.036E+01,-4.062E+01, 1.578E+01,-3.699E+00, 6.020E-01,-7.031E-02,
 
922
     2 2.700E+01,-4.167E+01, 1.770E+01,-4.804E+00, 7.862E-01,-1.060E-01,
 
923
     3-1.909E+00, 1.357E+00, 1.127E+00,-7.181E-01, 2.232E-01,-2.481E-02,
 
924
     4-2.488E-01, 9.781E-01,-8.127E-01, 2.094E-01,-2.997E-02,-4.710E-03,
 
925
     5 2.506E-01,-5.427E-01, 2.672E-01,-3.103E-02,-1.800E-03, 2.870E-03,
 
926
     6-1.128E-01, 2.087E-01,-6.972E-02,-2.480E-03, 2.630E-03,-8.400E-04/
 
927
C...EXPANSION COEFFICIENTS FOR STRANGE SEA QUARK DISTRIBUTION
 
928
      DATA (((CEHLQ(IX,IT,NX,5,1),IX=1,6),IT=1,6),NX=1,2)/
 
929
     1 4.968E-02,-4.173E-02, 2.102E-02,-3.270E-03, 3.240E-03,-6.700E-04,
 
930
     2-6.150E-03,-1.294E-02, 6.740E-03,-6.890E-03, 9.000E-04,-1.510E-03,
 
931
     3-8.580E-03, 5.050E-03,-4.900E-03,-1.600E-04,-9.400E-04,-1.500E-04,
 
932
     4 7.840E-03, 1.510E-03, 2.220E-03, 1.400E-03, 7.000E-04, 3.500E-04,
 
933
     5-4.410E-03,-2.220E-03,-8.900E-04,-8.500E-04,-3.600E-04,-2.000E-04,
 
934
     6 2.520E-03, 1.840E-03, 4.100E-04, 3.900E-04, 1.600E-04, 9.000E-05,
 
935
     1 9.235E-01,-1.085E+00, 3.464E-01,-7.210E-02, 9.140E-03,-9.100E-04,
 
936
     2 9.315E-01,-1.274E+00, 4.512E-01,-9.775E-02, 1.380E-02,-1.310E-03,
 
937
     3 4.739E-02,-1.296E-01, 8.482E-02,-2.642E-02, 4.760E-03,-5.700E-04,
 
938
     4-2.653E-02, 4.953E-02,-1.735E-02, 1.750E-03, 2.800E-04,-6.000E-05,
 
939
     5 6.940E-03,-1.132E-02, 1.480E-03, 6.500E-04,-2.100E-04, 0.000E+00,
 
940
     6-1.680E-03, 2.340E-03, 4.200E-04,-3.400E-04, 5.000E-05, 1.000E-05/
 
941
      DATA (((CEHLQ(IX,IT,NX,5,2),IX=1,6),IT=1,6),NX=1,2)/
 
942
     1 6.478E-02,-4.537E-02, 1.643E-02,-3.490E-03, 2.710E-03,-6.700E-04,
 
943
     2-2.223E-02,-2.126E-02, 1.247E-02,-6.290E-03, 1.120E-03,-1.440E-03,
 
944
     3-1.340E-03, 1.362E-02,-6.130E-03,-7.900E-04,-9.000E-04,-2.000E-04,
 
945
     4 5.080E-03,-3.610E-03, 1.700E-03, 1.830E-03, 6.800E-04, 4.000E-04,
 
946
     5-3.580E-03, 6.000E-05,-2.600E-04,-1.050E-03,-3.800E-04,-2.300E-04,
 
947
     6 2.420E-03, 9.300E-04,-1.000E-04, 4.500E-04, 1.700E-04, 1.100E-04,
 
948
     1 9.868E-01,-1.171E+00, 3.940E-01,-8.459E-02, 1.124E-02,-1.250E-03,
 
949
     2 1.001E+00,-1.383E+00, 5.044E-01,-1.152E-01, 1.658E-02,-1.830E-03,
 
950
     3 4.928E-02,-1.368E-01, 9.021E-02,-2.935E-02, 5.800E-03,-6.600E-04,
 
951
     4-3.133E-02, 5.785E-02,-2.023E-02, 2.630E-03, 1.600E-04,-8.000E-05,
 
952
     5 8.840E-03,-1.416E-02, 1.900E-03, 5.800E-04,-2.500E-04, 1.000E-05,
 
953
     6-2.300E-03, 3.080E-03, 5.500E-04,-3.700E-04, 7.000E-05, 1.000E-05/
 
954
C...EXPANSION COEFFICIENTS FOR CHARM SEA QUARK DISTRIBUTION
 
955
      DATA (((CEHLQ(IX,IT,NX,6,1),IX=1,6),IT=1,6),NX=1,2)/
 
956
     1 9.270E-03,-1.817E-02, 9.590E-03,-6.390E-03, 1.690E-03,-1.540E-03,
 
957
     2 5.710E-03,-1.188E-02, 6.090E-03,-4.650E-03, 1.240E-03,-1.310E-03,
 
958
     3-3.960E-03, 7.100E-03,-3.590E-03, 1.840E-03,-3.900E-04, 3.400E-04,
 
959
     4 1.120E-03,-1.960E-03, 1.120E-03,-4.800E-04, 1.000E-04,-4.000E-05,
 
960
     5 4.000E-05,-3.000E-05,-1.800E-04, 9.000E-05,-5.000E-05,-2.000E-05,
 
961
     6-4.200E-04, 7.300E-04,-1.600E-04, 5.000E-05, 5.000E-05, 5.000E-05,
 
962
     1 8.098E-01,-1.042E+00, 3.398E-01,-6.824E-02, 8.760E-03,-9.000E-04,
 
963
     2 8.961E-01,-1.217E+00, 4.339E-01,-9.287E-02, 1.304E-02,-1.290E-03,
 
964
     3 3.058E-02,-1.040E-01, 7.604E-02,-2.415E-02, 4.600E-03,-5.000E-04,
 
965
     4-2.451E-02, 4.432E-02,-1.651E-02, 1.430E-03, 1.200E-04,-1.000E-04,
 
966
     5 1.122E-02,-1.457E-02, 2.680E-03, 5.800E-04,-1.200E-04, 3.000E-05,
 
967
     6-7.730E-03, 7.330E-03,-7.600E-04,-2.400E-04, 1.000E-05, 0.000E+00/
 
968
      DATA (((CEHLQ(IX,IT,NX,6,2),IX=1,6),IT=1,6),NX=1,2)/
 
969
     1 9.980E-03,-1.945E-02, 1.055E-02,-6.870E-03, 1.860E-03,-1.560E-03,
 
970
     2 5.700E-03,-1.203E-02, 6.250E-03,-4.860E-03, 1.310E-03,-1.370E-03,
 
971
     3-4.490E-03, 7.990E-03,-4.170E-03, 2.050E-03,-4.400E-04, 3.300E-04,
 
972
     4 1.470E-03,-2.480E-03, 1.460E-03,-5.700E-04, 1.200E-04,-1.000E-05,
 
973
     5-9.000E-05, 1.500E-04,-3.200E-04, 1.200E-04,-6.000E-05,-4.000E-05,
 
974
     6-4.200E-04, 7.600E-04,-1.400E-04, 4.000E-05, 7.000E-05, 5.000E-05,
 
975
     1 8.698E-01,-1.131E+00, 3.836E-01,-8.111E-02, 1.048E-02,-1.300E-03,
 
976
     2 9.626E-01,-1.321E+00, 4.854E-01,-1.091E-01, 1.583E-02,-1.700E-03,
 
977
     3 3.057E-02,-1.088E-01, 8.022E-02,-2.676E-02, 5.590E-03,-5.600E-04,
 
978
     4-2.845E-02, 5.164E-02,-1.918E-02, 2.210E-03,-4.000E-05,-1.500E-04,
 
979
     5 1.311E-02,-1.751E-02, 3.310E-03, 5.100E-04,-1.200E-04, 5.000E-05,
 
980
     6-8.590E-03, 8.380E-03,-9.200E-04,-2.600E-04, 1.000E-05,-1.000E-05/
 
981
C...EXPANSION COEFFICIENTS FOR BOTTOM SEA QUARK DISTRIBUTION
 
982
      DATA (((CEHLQ(IX,IT,NX,7,1),IX=1,6),IT=1,6),NX=1,2)/
 
983
     1 9.010E-03,-1.401E-02, 7.150E-03,-4.130E-03, 1.260E-03,-1.040E-03,
 
984
     2 6.280E-03,-9.320E-03, 4.780E-03,-2.890E-03, 9.100E-04,-8.200E-04,
 
985
     3-2.930E-03, 4.090E-03,-1.890E-03, 7.600E-04,-2.300E-04, 1.400E-04,
 
986
     4 3.900E-04,-1.200E-03, 4.400E-04,-2.500E-04, 2.000E-05,-2.000E-05,
 
987
     5 2.600E-04, 1.400E-04,-8.000E-05, 1.000E-04, 1.000E-05, 1.000E-05,
 
988
     6-2.600E-04, 3.200E-04, 1.000E-05,-1.000E-05, 1.000E-05,-1.000E-05,
 
989
     1 8.029E-01,-1.075E+00, 3.792E-01,-7.843E-02, 1.007E-02,-1.090E-03,
 
990
     2 7.903E-01,-1.099E+00, 4.153E-01,-9.301E-02, 1.317E-02,-1.410E-03,
 
991
     3-1.704E-02,-1.130E-02, 2.882E-02,-1.341E-02, 3.040E-03,-3.600E-04,
 
992
     4-7.200E-04, 7.230E-03,-5.160E-03, 1.080E-03,-5.000E-05,-4.000E-05,
 
993
     5 3.050E-03,-4.610E-03, 1.660E-03,-1.300E-04,-1.000E-05, 1.000E-05,
 
994
     6-4.360E-03, 5.230E-03,-1.610E-03, 2.000E-04,-2.000E-05, 0.000E+00/
 
995
      DATA (((CEHLQ(IX,IT,NX,7,2),IX=1,6),IT=1,6),NX=1,2)/
 
996
     1 8.980E-03,-1.459E-02, 7.510E-03,-4.410E-03, 1.310E-03,-1.070E-03,
 
997
     2 5.970E-03,-9.440E-03, 4.800E-03,-3.020E-03, 9.100E-04,-8.500E-04,
 
998
     3-3.050E-03, 4.440E-03,-2.100E-03, 8.500E-04,-2.400E-04, 1.400E-04,
 
999
     4 5.300E-04,-1.300E-03, 5.600E-04,-2.700E-04, 3.000E-05,-2.000E-05,
 
1000
     5 2.000E-04, 1.400E-04,-1.100E-04, 1.000E-04, 0.000E+00, 0.000E+00,
 
1001
     6-2.600E-04, 3.200E-04, 0.000E+00,-3.000E-05, 1.000E-05,-1.000E-05,
 
1002
     1 8.672E-01,-1.174E+00, 4.265E-01,-9.252E-02, 1.244E-02,-1.460E-03,
 
1003
     2 8.500E-01,-1.194E+00, 4.630E-01,-1.083E-01, 1.614E-02,-1.830E-03,
 
1004
     3-2.241E-02,-5.630E-03, 2.815E-02,-1.425E-02, 3.520E-03,-4.300E-04,
 
1005
     4-7.300E-04, 8.030E-03,-5.780E-03, 1.380E-03,-1.300E-04,-4.000E-05,
 
1006
     5 3.460E-03,-5.380E-03, 1.960E-03,-2.100E-04, 1.000E-05, 1.000E-05,
 
1007
     6-4.850E-03, 5.950E-03,-1.890E-03, 2.600E-04,-3.000E-05, 0.000E+00/
 
1008
C...EXPANSION COEFFICIENTS FOR TOP SEA QUARK DISTRIBUTION
 
1009
      DATA (((CEHLQ(IX,IT,NX,8,1),IX=1,6),IT=1,6),NX=1,2)/
 
1010
     1 4.410E-03,-7.480E-03, 3.770E-03,-2.580E-03, 7.300E-04,-7.100E-04,
 
1011
     2 3.840E-03,-6.050E-03, 3.030E-03,-2.030E-03, 5.800E-04,-5.900E-04,
 
1012
     3-8.800E-04, 1.660E-03,-7.500E-04, 4.700E-04,-1.000E-04, 1.000E-04,
 
1013
     4-8.000E-05,-1.500E-04, 1.200E-04,-9.000E-05, 3.000E-05, 0.000E+00,
 
1014
     5 1.300E-04,-2.200E-04,-2.000E-05,-2.000E-05,-2.000E-05,-2.000E-05,
 
1015
     6-7.000E-05, 1.900E-04,-4.000E-05, 2.000E-05, 0.000E+00, 0.000E+00,
 
1016
     1 6.623E-01,-9.248E-01, 3.519E-01,-7.930E-02, 1.110E-02,-1.180E-03,
 
1017
     2 6.380E-01,-9.062E-01, 3.582E-01,-8.479E-02, 1.265E-02,-1.390E-03,
 
1018
     3-2.581E-02, 2.125E-02, 4.190E-03,-4.980E-03, 1.490E-03,-2.100E-04,
 
1019
     4 7.100E-04, 5.300E-04,-1.270E-03, 3.900E-04,-5.000E-05,-1.000E-05,
 
1020
     5 3.850E-03,-5.060E-03, 1.860E-03,-3.500E-04, 4.000E-05, 0.000E+00,
 
1021
     6-3.530E-03, 4.460E-03,-1.500E-03, 2.700E-04,-3.000E-05, 0.000E+00/
 
1022
      DATA (((CEHLQ(IX,IT,NX,8,2),IX=1,6),IT=1,6),NX=1,2)/
 
1023
     1 4.260E-03,-7.530E-03, 3.830E-03,-2.680E-03, 7.600E-04,-7.300E-04,
 
1024
     2 3.640E-03,-6.050E-03, 3.030E-03,-2.090E-03, 5.900E-04,-6.000E-04,
 
1025
     3-9.200E-04, 1.710E-03,-8.200E-04, 5.000E-04,-1.200E-04, 1.000E-04,
 
1026
     4-5.000E-05,-1.600E-04, 1.300E-04,-9.000E-05, 3.000E-05, 0.000E+00,
 
1027
     5 1.300E-04,-2.100E-04,-1.000E-05,-2.000E-05,-2.000E-05,-1.000E-05,
 
1028
     6-8.000E-05, 1.800E-04,-5.000E-05, 2.000E-05, 0.000E+00, 0.000E+00,
 
1029
     1 7.146E-01,-1.007E+00, 3.932E-01,-9.246E-02, 1.366E-02,-1.540E-03,
 
1030
     2 6.856E-01,-9.828E-01, 3.977E-01,-9.795E-02, 1.540E-02,-1.790E-03,
 
1031
     3-3.053E-02, 2.758E-02, 2.150E-03,-4.880E-03, 1.640E-03,-2.500E-04,
 
1032
     4 9.200E-04, 4.200E-04,-1.340E-03, 4.600E-04,-8.000E-05,-1.000E-05,
 
1033
     5 4.230E-03,-5.660E-03, 2.140E-03,-4.300E-04, 6.000E-05, 0.000E+00,
 
1034
     6-3.890E-03, 5.000E-03,-1.740E-03, 3.300E-04,-4.000E-05, 0.000E+00/
 
1035
      DATA TBMIN,TTMIN/8.1905,7.4474,11.5528,10.8097/
 
1036
      DATA XOLD,QOLD,IOLD,NOLD/-1.,0.,0,0/
 
1037
      DATA DMIN,Q0,QL/1.E-15,2*2.,2*2.236,.2,.4,.2,.29/
 
1038
      DATA IXLOW,IQLOW,IQHIG/0,0,0/
 
1039
      XMWN=1.-X
 
1040
      QSCA=ABS(SCALE)
 
1041
      ISET=MOD(NSET,100)
 
1042
      IF (QSCA.LT.Q0(ISET)) THEN
 
1043
        QSCA=Q0(ISET)
 
1044
        IF(IQLOW.LE.100) THEN
 
1045
          IQLOW=IQLOW+1
 
1046
          CALL MWARN('DOEHLQ')
 
1047
          IF(IQLOW.EQ.100) WRITE(*,*) ' LAST WARNING'
 
1048
          WRITE(*,*) ' Q SCALE SMALLER THAN ALLOWED, SET TO MINIMUM'
 
1049
          WRITE(*,*) '*********************************************'
 
1050
        ENDIF
 
1051
      ELSEIF (QSCA.GT.1.E4) THEN
 
1052
        QSCA=Q0(ISET)
 
1053
        IF(IQHIG.LE.100) THEN
 
1054
          IQHIG=IQHIG+1
 
1055
          CALL MWARN('DOEHLQ')
 
1056
          IF(IQHIG.EQ.100) WRITE(*,*) ' LAST WARNING'
 
1057
          WRITE(*,*) ' Q SCALE LARGER THAN ALLOWED, SET TO MAXIMUM'
 
1058
          WRITE(*,*) '*********************************************'
 
1059
        ENDIF
 
1060
      ENDIF
 
1061
      IF(X.LT.1.E-4) THEN
 
1062
        IF(IXLOW.LE.100) THEN
 
1063
          IXLOW=IXLOW+1
 
1064
          CALL MWARN('DOEHLQ')
 
1065
          IF(IXLOW.EQ.100) WRITE(*,*) ' LAST WARNING'
 
1066
          WRITE(*,*) ' X VALUE SMALLER THAN ALLOWED (1.E-4)'
 
1067
          WRITE(*,*) '*********************************************'
 
1068
        ENDIF
 
1069
      ENDIF
 
1070
      IF (QSCA.NE.QOLD.OR.IDHAD.NE.IOLD.OR.NSET.NE.NOLD) THEN
 
1071
        QOLD=QSCA
 
1072
        IOLD=IDHAD
 
1073
        NOLD=NSET
 
1074
        SS=LOG(QSCA/QL(ISET))
 
1075
        SMIN=LOG(Q0(ISET)/QL(ISET))
 
1076
        IF (ISET.LT.3) THEN
 
1077
          S=LOG(SS/SMIN)
 
1078
        ELSEIF (ISET.LT.5) THEN
 
1079
          T=2.*SS
 
1080
          TMIN=2.*SMIN
 
1081
          TMAX=2.*LOG(1.E4/QL(ISET))
 
1082
        ENDIF
 
1083
        GG=1.
 
1084
C
 
1085
        IF (ABS(IDHAD).LT.3) THEN
 
1086
          IF (ISET.LT.3) THEN
 
1087
C...........DUKE AND OWENS NUCLEONS
 
1088
            IP=ISET
 
1089
            DO 10 I=1,5
 
1090
            DO 10 J=1,6
 
1091
   10       A(J,I)=B(1,J,I,IP)+S*(B(2,J,I,IP)+S*B(3,J,I,IP))
 
1092
            DO 20 K=1,2
 
1093
            AA=1.+A(2,K)+A(3,K)
 
1094
   20       G(K)=SPLGAM(AA)/((1.+A(2,K)*A(4,K)/AA)*SPLGAM(A(2,K))
 
1095
     &          *SPLGAM(1.+A(3,K)))
 
1096
          ELSE
 
1097
C...........EHLQ NUCLEONS
 
1098
            IP=ISET-2
 
1099
            VT=MAX(-1.,MIN(1.,(2.*T-TMAX-TMIN)/(TMAX-TMIN)))
 
1100
            WT=VT*VT
 
1101
C...CHEBYSHEV POLYNOMIALS FOR T EXPANSION
 
1102
            TT(1)=1.
 
1103
            TT(2)=VT
 
1104
            TT(3)=   2.*WT- 1.
 
1105
            TT(4)=  (4.*WT- 3.)*VT
 
1106
            TT(5)=  (8.*WT- 8.)*WT+1.
 
1107
            TT(6)=((16.*WT-20.)*WT+5.)*VT
 
1108
          ENDIF
 
1109
        ELSEIF (ISET.LT.3) THEN
 
1110
C...........DUKE AND OWENS PION
 
1111
            IP=ISET+2
 
1112
            DO 30 I=1,5
 
1113
            DO 30 J=1,6
 
1114
   30       A(J,I)=B(1,J,I,IP)+S*(B(2,J,I,IP)+S*B(3,J,I,IP))
 
1115
            AA=1.+A(2,1)+A(3,1)
 
1116
            G(1)=SPLGAM(AA)/(SPLGAM(A(2,1))*SPLGAM(1.+A(3,1)))
 
1117
            G(2)=0.
 
1118
        ENDIF
 
1119
      ENDIF
 
1120
C
 
1121
      IF (ISET.LT.3) THEN
 
1122
        DO 50 I=1,5
 
1123
   50   F(I)=A(1,I)*X**A(2,I)*XMWN**A(3,I)*(1.+X*
 
1124
     &      (A(4,I)+X*(A(5,I)  +  X*A(6,I))))
 
1125
        F(1)=F(1)*G(1)
 
1126
        F(2)=F(2)*G(2)
 
1127
        UPV=F(1)-F(2)
 
1128
        DNV=F(2)
 
1129
        SEA=DMIN+F(3)/6.
 
1130
        STR=SEA
 
1131
        CHM=DMIN+F(4)
 
1132
        BTM=DMIN
 
1133
        GLU=DMIN+F(5)*GG
 
1134
      ELSE
 
1135
        IF (X.NE.XOLD) THEN
 
1136
          XOLD=X
 
1137
          IF (X.GT.0.1) THEN
 
1138
            NX=1
 
1139
            VX=(2.*X-1.1)/0.9
 
1140
          ELSE
 
1141
            NX=2
 
1142
            VX=MAX(-1.,(2.*LOG(X)+11.51293)/6.90776)
 
1143
          ENDIF
 
1144
          WX=VX*VX
 
1145
          TX(1)=1.
 
1146
          TX(2)=VX
 
1147
          TX(3)=   2.*WX- 1.
 
1148
          TX(4)=  (4.*WX- 3.)*VX
 
1149
          TX(5)=  (8.*WX- 8.)*WX+1.
 
1150
          TX(6)=((16.*WX-20.)*WX+5.)*VX
 
1151
        ENDIF
 
1152
C...CALCULATE STRUCTURE FUNCTIONS
 
1153
        DO 120 IFL=1,6
 
1154
        XQSUM=0.
 
1155
        DO 110 IT=1,6
 
1156
        DO 110 IX=1,6
 
1157
  110   XQSUM=XQSUM+CEHLQ(IX,IT,NX,IFL,IP)*TX(IX)*TT(IT)
 
1158
  120   XQ(IFL)=XQSUM*XMWN**NEHLQ(IFL,IP)
 
1159
        UPV=XQ(1)
 
1160
        DNV=XQ(2)
 
1161
        STR=DMIN+XQ(5)
 
1162
        CHM=DMIN+XQ(6)
 
1163
        SEA=DMIN+XQ(3)
 
1164
        GLU=DMIN+XQ(4)*GG
 
1165
C...SPECIAL EXPANSION FOR BOTTOM (THRESHOLD EFFECTS)
 
1166
        IF (NF.LT.5.OR.T.LE.TBMIN(IP)) THEN
 
1167
          BTM=DMIN
 
1168
        ELSE
 
1169
          VT=MAX(-1.,MIN(1.,(2.*T-TMAX-TBMIN(IP))/(TMAX-TBMIN(IP))))
 
1170
          WT=VT*VT
 
1171
          TB(1)=1.
 
1172
          TB(2)=VT
 
1173
          TB(3)=   2.*WT- 1.
 
1174
          TB(4)=  (4.*WT- 3.)*VT
 
1175
          TB(5)=  (8.*WT- 8.)*WT+1.
 
1176
          TB(6)=((16.*WT-20.)*WT+5.)*VT
 
1177
          XQSUM=0.
 
1178
          DO 130 IT=1,6
 
1179
          DO 130 IX=1,6
 
1180
  130     XQSUM=XQSUM+CEHLQ(IX,IT,NX,7,IP)*TX(IX)*TB(IT)
 
1181
          BTM=DMIN+XQSUM*XMWN**NEHLQ(7,IP)
 
1182
        ENDIF
 
1183
C...SPECIAL EXPANSION FOR TOP (THRESHOLD EFFECTS)
 
1184
        TMTOP=2.*LOG(100./30.)
 
1185
        TPMIN=TTMIN(IP)+TMTOP
 
1186
C---TMTOP=2.*LOG(TOPMAS/30.)
 
1187
        TPMAX=TMAX+TMTOP
 
1188
        IF (NF.LT.6.OR.T.LE.TPMIN) THEN
 
1189
          TOP=DMIN
 
1190
        ELSE
 
1191
          VT=MAX(-1.,MIN(1.,(2.*T-TPMAX-TPMIN)/(TPMAX-TPMIN)))
 
1192
          WT=VT*VT
 
1193
          TB(1)=1.
 
1194
          TB(2)=VT
 
1195
          TB(3)=   2.*WT- 1.
 
1196
          TB(4)=  (4.*WT- 3.)*VT
 
1197
          TB(5)=  (8.*WT- 8.)*WT+1.
 
1198
          TB(6)=((16.*WT-20.)*WT+5.)*VT
 
1199
          XQSUM=0.
 
1200
          DO 150 IT=1,6
 
1201
          DO 150 IX=1,6
 
1202
  150     XQSUM=XQSUM+CEHLQ(IX,IT,NX,8,IP)*TX(IX)*TB(IT)
 
1203
          TOP=DMIN+XQSUM*XMWN**NEHLQ(8,IP)
 
1204
        ENDIF
 
1205
      ENDIF
 
1206
C
 
1207
      IF (IDHAD.EQ.1) THEN
 
1208
         DIST(1)=SEA+DNV
 
1209
         DIST(2)=SEA+UPV
 
1210
         DIST(7)=SEA
 
1211
         DIST(8)=SEA
 
1212
      ELSEIF (IDHAD.EQ.-1) THEN
 
1213
         DIST(1)=SEA
 
1214
         DIST(2)=SEA
 
1215
         DIST(7)=SEA+DNV
 
1216
         DIST(8)=SEA+UPV
 
1217
      ELSEIF (IDHAD.EQ.2) THEN
 
1218
         DIST(1)=SEA+UPV
 
1219
         DIST(2)=SEA+DNV
 
1220
         DIST(7)=SEA
 
1221
         DIST(8)=SEA
 
1222
      ELSEIF (IDHAD.EQ.-2) THEN
 
1223
         DIST(1)=SEA
 
1224
         DIST(2)=SEA
 
1225
         DIST(7)=SEA+UPV
 
1226
         DIST(8)=SEA+DNV
 
1227
      ELSEIF (IDHAD.EQ.3) THEN
 
1228
         DIST(1)=SEA
 
1229
         DIST(2)=SEA+UPV
 
1230
         DIST(7)=SEA+UPV
 
1231
         DIST(8)=SEA
 
1232
      ELSEIF (IDHAD.EQ.-3) THEN
 
1233
         DIST(1)=SEA+UPV
 
1234
         DIST(2)=SEA
 
1235
         DIST(7)=SEA
 
1236
         DIST(8)=SEA+UPV
 
1237
      ENDIF
 
1238
         DIST(3)=STR
 
1239
         DIST(4)=CHM
 
1240
         DIST(5)=BTM
 
1241
         DIST(6)=TOP
 
1242
         DIST(9)=STR
 
1243
         DIST(10)=CHM
 
1244
         DIST(11)=BTM
 
1245
         DIST(12)=TOP
 
1246
         DIST(13)=GLU
 
1247
  999 END
 
1248
C------------------------------------------------------------------------
 
1249
      FUNCTION SPLGAM(ZINPUT)
 
1250
      REAL Z,ZINPUT,G,T,RECZSQ
 
1251
C
 
1252
C   Gamma function computed by eq. 6.1.40, Abramowitz.
 
1253
C   B(M) = B2m/(2m *(2m-1)) where B2m is the 2m'th Bernoulli number.
 
1254
C   HLNTPI = .5*LOG(2.*PI)
 
1255
C
 
1256
      REAL B(10)
 
1257
      DATA B/
 
1258
     1       0.83333333333333333333E-01,   -0.27777777777777777778E-02,
 
1259
     1       0.79365079365079365079E-03,   -0.59523809523809523810E-03,
 
1260
     1       0.84175084175084175084E-03,   -0.19175269175269175269E-02,
 
1261
     1       0.64102564102564102564E-02,   -0.29550653594771241830E-01,
 
1262
     1       0.17964437236883057316E0  ,    -1.3924322169059011164E0  /
 
1263
      DATA HLNTPI/0.91893853320467274178E0/
 
1264
C
 
1265
C   Shift argument to large value ( > 20 )
 
1266
C
 
1267
      Z=ZINPUT
 
1268
      SHIFT=1.
 
1269
   10 IF (Z.LT.20.E0) THEN
 
1270
         SHIFT = SHIFT*Z
 
1271
         Z = Z + 1.E0
 
1272
         GO TO 10
 
1273
      ENDIF
 
1274
C
 
1275
C   Compute asymptotic formula
 
1276
C
 
1277
      G = (Z-.5E0)*LOG(Z) - Z + HLNTPI
 
1278
      T = 1.E0/Z
 
1279
      RECZSQ = T**2
 
1280
      DO 20 I = 1,10
 
1281
         G = G + B(I)*T
 
1282
         T = T*RECZSQ
 
1283
   20 CONTINUE
 
1284
      SPLGAM = EXP(G)/SHIFT
 
1285
      END
 
1286
C----- END DUKE-OWENS AND EHLQ -----------------
 
1287
C-------------------------------------------------------------
 
1288
C
 
1289
C-------------------------------------------------------------
 
1290
C----- START DFLM ------------------------------
 
1291
      SUBROUTINE  DFLM(IFLAG,IH,Q2,X,FX,NF)
 
1292
      DIMENSION FX(-NF:NF)
 
1293
      CHARACTER*2 PART
 
1294
      DIMENSION PART(-6:6)
 
1295
      DATA PART/'TB','BB','CB','SB','DB','UB','GL',
 
1296
     *       'UP','DO','SB','CB','BB','TB'/
 
1297
      IF(ABS(IH).GE.3) CALL NOSETP
 
1298
      IH0=IH
 
1299
      IF(ABS(IH).EQ.2) IH0=ISIGN(1,IH)
 
1300
      DO I=-1,NF
 
1301
        IF(IFLAG.EQ.1) CALL FXDFLM1(X,Q2,PART(I),FX(I*IH0))
 
1302
        IF(IFLAG.EQ.2) CALL FXDFLM2(X,Q2,PART(I),FX(I*IH0))
 
1303
        IF(IFLAG.EQ.3) CALL FXDFLM3(X,Q2,PART(I),FX(I*IH0))
 
1304
      ENDDO
 
1305
      SEA     =FX(-IH0)
 
1306
      FX(-2*IH0)=SEA
 
1307
      FX(IH0)  =FX(IH0)  +SEA
 
1308
      FX(2*IH0)=FX(2*IH0)+SEA
 
1309
      DO I=3,NF
 
1310
        FX(-I*IH0)=FX(I*IH0)
 
1311
      ENDDO
 
1312
      DO I=-NF,NF
 
1313
       FX(I)=FX(I)/X
 
1314
      ENDDO
 
1315
C...TRANSFORM PROTON INTO NEUTRON
 
1316
      IF(ABS(IH).EQ.2) THEN
 
1317
        T=FX(1)
 
1318
        FX(1)=FX(2)
 
1319
        FX(2)=T
 
1320
        T=FX(-1)
 
1321
        FX(-1)=FX(-2)
 
1322
        FX(-2)=T
 
1323
      ENDIF
 
1324
      END
 
1325
C----- END DFLM -----------------
 
1326
C------------------------------------------------------------
 
1327
C
 
1328
C------------------------------------------------------------
 
1329
C----- START HMRS ------------------------------
 
1330
      SUBROUTINE  HMRS(MODE,IH,Q2,X,FX,NF)
 
1331
      REAL FX(-NF:NF)
 
1332
      REAL*8 DX,DQ,UPV,DOV,SEA,USEA,DSEA,STR,CHR,BOT,GLU
 
1333
      REAL*8 XMIN,XMAX,QSQMIN,QSQMAX,QSQ
 
1334
      REAL*8 IXMIN,IXMAX,IQSQMIN,IQSQMAX
 
1335
      DATA XMIN,XMAX,QSQMIN,QSQMAX/1.D-5,1.D0,5.D0,1310720.D0/
 
1336
      DATA INI/0/
 
1337
      IF(INI.GT.0) GO TO 1
 
1338
        IF(MODE.EQ.10)QSQMIN=0.625D0
 
1339
        IF(MODE.GT.30.AND.MODE.LE.94) QSQMIN=1.25D0
 
1340
        IF(MODE.GT.30.AND.MODE.LE.94) QSQMAX=1.D7
 
1341
        ILXMIN=0                    
 
1342
        ILXMAX=0
 
1343
        ILQSQMIN=0
 
1344
        ILQSQMAX=0
 
1345
        INI=1
 
1346
1     CONTINUE
 
1347
      IF(ABS(IH).GE.3) CALL NOSETP       
 
1348
      IH0=IH
 
1349
      IF(ABS(IH).EQ.2) IH0=ISIGN(1,IH)
 
1350
      Q=SQRT(Q2)
 
1351
      DQ=DBLE(Q)
 
1352
      DX=DBLE(X)
 
1353
      IF(DX.LT.XMIN) THEN
 
1354
        IXMIN=IXMIN+1.
 
1355
        IF(LOG10(IXMIN).GT.ILXMIN) THEN
 
1356
          WRITE(*,*)' X < XMIN IN STR. FUNCTIONS MORE THAN 10**',
 
1357
     +  ILXMIN,' TIMES'                          
 
1358
          ILXMIN=ILXMIN+1
 
1359
        ENDIF
 
1360
      ENDIF
 
1361
      IF(DX.GT.XMAX) THEN
 
1362
        IXMAX=IXMAX+1.
 
1363
        IF(LOG10(IXMAX).GT.ILXMAX) THEN
 
1364
          WRITE(*,*)' X > XMAX IN STR. FUNCTIONS MORE THAN 10**',
 
1365
     +  ILXMAX,' TIMES'
 
1366
          ILXMAX=ILXMAX+1
 
1367
        ENDIF
 
1368
      ENDIF
 
1369
      QSQ=DQ**2
 
1370
      IF(QSQ.LT.QSQMIN) THEN
 
1371
        IQSQMIN=IQSQMIN+1.
 
1372
        IF(LOG10(IQSQMIN).GT.ILQSQMIN) THEN
 
1373
          WRITE(*,*)'Q**2 < MIN Q**2 IN STR. FUNCTIONS MORE THAN 10**',
 
1374
     +  ILQSQMIN,' TIMES'
 
1375
          ILQSQMIN=ILQSQMIN+1
 
1376
        ENDIF
 
1377
      ENDIF
 
1378
      IF(QSQ.GT.QSQMAX) THEN
 
1379
        IQSQMAX=IQSQMAX+1.
 
1380
        IF(LOG10(IQSQMAX).GT.ILQSQMAX) THEN
 
1381
          WRITE(*,*)'Q**2 > MAX Q**2 IN STR. FUNCTIONS MORE THAN 10**',
 
1382
     +  ILQSQMAX,' TIMES'
 
1383
          ILQSQMAX=ILQSQMAX+1
 
1384
        ENDIF
 
1385
      ENDIF
 
1386
      IF(MODE.LT.7) THEN
 
1387
        CALL MRSEB(DX,DQ,MODE,UPV,DOV,SEA,STR,CHR,BOT,GLU)
 
1388
        FX(0)=SNGL(GLU)
 
1389
        FX(-IH0)=SNGL(SEA)
 
1390
        FX(-2*IH0)=SNGL(SEA)
 
1391
        FX(IH0)  =SNGL(UPV+SEA)
 
1392
        FX(2*IH0)=SNGL(DOV+SEA)
 
1393
        IF(NF.GE.3) FX(3)=SNGL(STR)
 
1394
        IF(NF.GE.4) FX(4)=SNGL(CHR)
 
1395
        IF(NF.GE.5) FX(5)=SNGL(BOT)
 
1396
        IF(NF.eq.6) FX(6)=0
 
1397
      ELSEIF(MODE.LE.94) THEN
 
1398
        IF(MODE.GT.63) THEN
 
1399
           CALL MRST2001E
 
1400
     #          (DX,DQ,MODE-64,UPV,DOV,USEA,DSEA,STR,CHR,BOT,GLU)
 
1401
        ELSEIF(MODE.GT.61)THEN
 
1402
           CALL MRST2002
 
1403
     #          (DX,DQ,MODE-61,UPV,DOV,USEA,DSEA,STR,CHR,BOT,GLU)
 
1404
        ELSEIF(MODE.GT.60)THEN
 
1405
           CALL MRST2001lo
 
1406
     #          (DX,DQ,MODE-60,UPV,DOV,USEA,DSEA,STR,CHR,BOT,GLU)
 
1407
        ELSEIF(MODE.GT.56)THEN
 
1408
           CALL MRST2001
 
1409
     #          (DX,DQ,MODE-56,UPV,DOV,USEA,DSEA,STR,CHR,BOT,GLU)
 
1410
        ELSEIF(MODE.GT.52)THEN
 
1411
          CALL MRST0201127
 
1412
     #              (DX,DQ,MODE-52,UPV,DOV,USEA,DSEA,STR,CHR,BOT,GLU)
 
1413
        ELSEIF(MODE.GT.39)THEN
 
1414
          CALL MRS99(DX,DQ,MODE-40,UPV,DOV,USEA,DSEA,STR,CHR,BOT,GLU)
 
1415
        ELSEIF(MODE.GT.34)THEN
 
1416
          CALL MRS98(DX,DQ,MODE-30,UPV,DOV,USEA,DSEA,STR,CHR,BOT,GLU)
 
1417
        ELSEIF(MODE.GT.30)THEN
 
1418
          CALL MRS96(DX,DQ,MODE-30,UPV,DOV,USEA,DSEA,STR,CHR,BOT,GLU)
 
1419
        ELSEIF(MODE.GT.12)THEN
 
1420
          CALL MRSLAM(DX,DQ,MODE-12,UPV,DOV,USEA,DSEA,STR,CHR,BOT,GLU)
 
1421
        ELSEIF(MODE.EQ.12) THEN
 
1422
          CALL STRC31(DX,DQ,UPV,DOV,USEA,DSEA,STR,CHR,BOT,GLU)
 
1423
        ELSEIF(MODE.EQ.11) THEN
 
1424
          CALL MRSLAM(DX,DQ,MODE-11,UPV,DOV,USEA,DSEA,STR,CHR,BOT,GLU)
 
1425
        ELSEIF(MODE.EQ.10) THEN
 
1426
          IF(Q2.GT.5D0) THEN
 
1427
            CALL STRC33(DX,DQ,UPV,DOV,USEA,DSEA,STR,CHR,BOT,GLU)
 
1428
          ELSEIF(Q2.LE.5D0) THEN 
 
1429
            CALL STRC34(DX,DQ,UPV,DOV,USEA,DSEA,STR,CHR,BOT,GLU)
 
1430
          ENDIF
 
1431
        ELSE         
 
1432
          CALL MRS92(DX,DQ,MODE,UPV,DOV,USEA,DSEA,STR,CHR,BOT,GLU)
 
1433
        ENDIF
 
1434
        FX(0)=SNGL(GLU)
 
1435
        FX(-IH0)=SNGL(USEA)
 
1436
        FX(-2*IH0)=SNGL(DSEA)
 
1437
        FX(IH0)  =SNGL(UPV+USEA)
 
1438
        FX(2*IH0)=SNGL(DOV+DSEA)
 
1439
        IF(NF.GE.3) FX(3)=SNGL(STR)
 
1440
        IF(NF.GE.4) FX(4)=SNGL(CHR)
 
1441
        IF(NF.GE.5) FX(5)=SNGL(BOT)
 
1442
        IF(NF.eq.6) FX(6)=0
 
1443
      ENDIF
 
1444
      DO I=3,NF
 
1445
        FX(-I)=FX(I)
 
1446
      ENDDO
 
1447
      DO I=-NF,NF
 
1448
       FX(I)=FX(I)/X
 
1449
      ENDDO
 
1450
C...TRANSFORM PROTON INTO NEUTRON
 
1451
      IF(ABS(IH).EQ.2) THEN
 
1452
        T=FX(1)
 
1453
        FX(1)=FX(2)
 
1454
        FX(2)=T
 
1455
        T=FX(-1)
 
1456
        FX(-1)=FX(-2)
 
1457
        FX(-2)=T
 
1458
      ENDIF
 
1459
      END
 
1460
C
 
1461
C
 
1462
      SUBROUTINE XMRSA(Q2,X,FX,NF)
 
1463
      IMPLICIT REAL*4(A-H,O-Z)
 
1464
      REAL FX(-NF:NF)
 
1465
      IMODE=10
 
1466
      IIH=1
 
1467
      R2=1.+4.*0.88*X*X/Q2
 
1468
      R=SQRT(R2)
 
1469
      XXI=2.*X/(1.+R)
 
1470
      EMASS2=0.067*X**(-0.37)
 
1471
      EMASS2=EMASS2*EXP(-Q2/5.)
 
1472
      FACTOR=Q2/(Q2 + EMASS2)
 
1473
      IF(FACTOR.LT.0.D0) FACTOR=0.D0
 
1474
      IF(FACTOR.GT.1.D0) FACTOR=1.D0
 
1475
      IF(Q2.LT.0.625) THEN
 
1476
        Q2Z=SQRT(0.625D0)
 
1477
      ELSE
 
1478
        Q2Z=Q2
 
1479
      ENDIF
 
1480
      CALL HMRS(IMODE,IIH,Q2Z,XXI,FX,NF)
 
1481
      DO I=-NF,NF
 
1482
        FX(I)=FACTOR*FX(I)
 
1483
      ENDDO
 
1484
      RETURN
 
1485
      END 
 
1486
C
 
1487
C
 
1488
      SUBROUTINE MRSCHECK(VAL,MODE)
 
1489
      REAL * 8 VAL
 
1490
      CHARACTER * 10 NAME(47)
 
1491
      DATA NAME/'HMRSB','KMRSB','HMRSB135','HMRSB160',
 
1492
     #          'HMRSB200','HMRSB235','MRSS0','MRSD0','MRSD-',
 
1493
     #          'MRSA','MRSAP','MRSG','MRS105','MRS110','MRS115',
 
1494
     #          'MRS120','MRS125','MRS130',2*'EMPTY',
 
1495
     #          'MRSR1','MRSR2','MRSR3','MRSR4',
 
1496
     #          'MRST','MRSTH','MRSTL','MRSTM','MRSTP','EMPTY',
 
1497
     #          'MRST991','MRST992','MRST993','MRST994',
 
1498
     #          'MRST995','MRST996','MRST997','MRST998',
 
1499
     #          'MRST999','MRST9910','MRST9911','MRST9912','EMPTY',
 
1500
     #          'MRSTNNLO1','MRSTNNLO2','MRSTNNLO3','MRSTNNLO4'/
 
1501
      IF(ABS(VAL-0.00232D0).LT.0.000001) THEN                      
 
1502
         IMODE = 10
 
1503
      ELSEIF(ABS(VAL-0.03058D0).LT.0.000001) THEN                      
 
1504
         IMODE = 1
 
1505
      ELSEIF(ABS(VAL-0.01727D0).LT.0.000001) THEN
 
1506
         IMODE = 2
 
1507
      ELSEIF(ABS(VAL-0.01683D0).LT.0.000001) THEN
 
1508
         IMODE = 3
 
1509
      ELSEIF(ABS(VAL-0.01663D0).LT.0.000001) THEN
 
1510
         IMODE = 4
 
1511
      ELSEIF(ABS(VAL-0.01601D0).LT.0.000001) THEN
 
1512
         IMODE = 5
 
1513
      ELSEIF(ABS(VAL-0.01571D0).LT.0.000001) THEN
 
1514
         IMODE = 6
 
1515
      ELSEIF(ABS(VAL-0.01356D0).LT.0.000001) THEN
 
1516
         IMODE = 7
 
1517
      ELSEIF(ABS(VAL-0.00527D0).LT.0.000001) THEN
 
1518
         IMODE = 8
 
1519
      ELSEIF(ABS(VAL-0.00474D0).LT.0.000001) THEN
 
1520
         IMODE = 9
 
1521
      ELSEIF(ABS(VAL-0.00383D0).LT.0.000001) THEN
 
1522
         IMODE = 10         
 
1523
      ELSEIF(ABS(VAL-0.00341D0).LT.0.000001) THEN                      
 
1524
         IMODE = 11         
 
1525
      ELSEIF(ABS(VAL-0.00269D0).LT.0.000001) THEN                      
 
1526
         IMODE = 12         
 
1527
      ELSEIF(ABS(VAL-0.00429D0).LT.0.000001) THEN                      
 
1528
         IMODE = 13         
 
1529
      ELSEIF(ABS(VAL-0.00350D0).LT.0.000001) THEN                      
 
1530
         IMODE = 14         
 
1531
      ELSEIF(ABS(VAL-0.00294D0).LT.0.000001) THEN                      
 
1532
         IMODE = 15         
 
1533
      ELSEIF(ABS(VAL-0.00273D0).LT.0.000001) THEN                      
 
1534
         IMODE = 16         
 
1535
      ELSEIF(ABS(VAL-0.00195D0).LT.0.000001) THEN                      
 
1536
         IMODE = 17         
 
1537
      ELSEIF(ABS(VAL-0.00145D0).LT.0.000001) THEN                      
 
1538
         IMODE = 18         
 
1539
c
 
1540
      ELSEIF(ABS(VAL-0.00150D0).LT.0.000001) THEN                      
 
1541
         IMODE = 21
 
1542
      ELSEIF(ABS(VAL-0.00125D0).LT.0.000001) THEN                      
 
1543
         IMODE = 22
 
1544
      ELSEIF(ABS(VAL-0.00181D0).LT.0.000001) THEN                      
 
1545
         IMODE = 23
 
1546
      ELSEIF(ABS(VAL-0.00085D0).LT.0.000001) THEN                      
 
1547
         IMODE = 24         
 
1548
      ELSEIF(ABS(VAL-0.00561D0).LT.0.000001) THEN                      
 
1549
         IMODE = 25
 
1550
      ELSEIF(ABS(VAL-0.00510D0).LT.0.000001) THEN                      
 
1551
         IMODE = 26
 
1552
      ELSEIF(ABS(VAL-0.00408D0).LT.0.000001) THEN                      
 
1553
         IMODE = 27
 
1554
      ELSEIF(ABS(VAL-0.00586D0).LT.0.000001) THEN                      
 
1555
         IMODE = 28
 
1556
      ELSEIF(ABS(VAL-0.00410D0).LT.0.000001) THEN                      
 
1557
         IMODE = 29          
 
1558
c
 
1559
      ELSEIF(ABS(VAL-0.00524D0).LT.0.000001) THEN                      
 
1560
         IMODE = 31
 
1561
      ELSEIF(ABS(VAL-0.00497D0).LT.0.000001) THEN                      
 
1562
         IMODE = 32
 
1563
      ELSEIF(ABS(VAL-0.00398D0).LT.0.000001) THEN                      
 
1564
         IMODE = 33
 
1565
      ELSEIF(ABS(VAL-0.00585D0).LT.0.000001) THEN                      
 
1566
         IMODE = 34
 
1567
      ELSEIF(ABS(VAL-0.00384D0).LT.0.000001) THEN                      
 
1568
         IMODE = 35
 
1569
      ELSEIF(ABS(VAL-0.00177D0).LT.0.000001) THEN                      
 
1570
         IMODE = 36
 
1571
      ELSEIF(ABS(VAL-0.00593D0).LT.0.000001) THEN                      
 
1572
         IMODE = 37
 
1573
      ELSEIF(ABS(VAL-0.00541D0).LT.0.000001) THEN                      
 
1574
         IMODE = 38
 
1575
      ELSEIF(ABS(VAL-0.91673D0).LT.0.000001) THEN                      
 
1576
         IMODE = 39
 
1577
      ELSEIF(ABS(VAL-0.00525D0).LT.0.000001) THEN                      
 
1578
         IMODE = 40
 
1579
      ELSEIF(ABS(VAL-0.89447D0).LT.0.000001) THEN                      
 
1580
         IMODE = 41
 
1581
      ELSEIF(ABS(VAL-0.00515D0).LT.0.000001) THEN                      
 
1582
         IMODE = 42
 
1583
      ELSEIF(ABS(VAL-0.00725D0).LT.0.000001) THEN                      
 
1584
         IMODE = 44
 
1585
      ELSEIF(ABS(VAL-0.00734D0).LT.0.000001) THEN                      
 
1586
         IMODE = 45
 
1587
      ELSEIF(ABS(VAL-0.00739D0).LT.0.000001) THEN                      
 
1588
         IMODE = 46
 
1589
      ELSEIF(ABS(VAL-0.00865D0).LT.0.000001) THEN                      
 
1590
         IMODE = 47
 
1591
      ELSE
 
1592
         WRITE(*,*) ' MRSCHECK: ERROR,'
 
1593
         WRITE(*,*) ' NO TABLE MATCHING THE ENTRY HAS BEEN FOUND'
 
1594
         STOP
 
1595
      ENDIF        
 
1596
      IF(IMODE.NE.MODE) THEN
 
1597
         WRITE(*,*) ' MRSCHECK: ERROR,'
 
1598
         WRITE(*,*) ' MRSCHECK: MODE CORRESPONDS TO ',NAME(MODE)
 
1599
         WRITE(*,*) ' MRSCHECK: TABLES ARE ',NAME(IMODE)
 
1600
         STOP
 
1601
      ENDIF
 
1602
      WRITE(*,*)' MRSCHECK: MODE ',NAME(MODE)
 
1603
      END
 
1604
 
 
1605
       SUBROUTINE MRSEB(X,SCALE,MODE,UPV,DNV,SEA,STR,CHM,BOT,GLU)
 
1606
C***************************************************************C
 
1607
C                                                               C
 
1608
C                                                               C
 
1609
C     NEW VERSIONS !!!! JANUARY 1990  (AS DESCRIBED IN          C
 
1610
C     "PARTON DISTRIBUTIONS ... " P.N. HARRIMAN, A.D. MARTIN,   C
 
1611
C     R.G. ROBERTS AND W.J. STIRLING PREPRINT DTP-90-04 )       C
 
1612
C                                                               C
 
1613
C         ********* DEBUGGED APRIL 1990********                 C
 
1614
C                                                               C
 
1615
C         ****** NOW DOWN TO X=10^-5 **********                 C
 
1616
C                                                               C
 
1617
C  MODE 1  CORRESPONDS TO HARRIMAN,                             C
 
1618
C  MARTIN, ROBERTS, STIRLING (BCDMS FIT)  WITH LAMBDA4= 190 MEV  C
 
1619
C                                                               C
 
1620
C             >>>>>>>>  CROSS CHECK  <<<<<<<<                   C
 
1621
C                                                               C
 
1622
C    THE FIRST NUMBER IN THE "E" GRID IS  .01969                C
 
1623
C    THE FIRST NUMBER IN THE "B" GRID IS  .03058                C
 
1624
C                                                               C
 
1625
C                                                               C
 
1626
C                         -*-                                   C
 
1627
C                                                               C
 
1628
C    (NOTE THAT X TIMES THE PARTON DISTRIBUTION FUNCTION        C
 
1629
C    IS RETURNED I.E. G(X) = GLU/X ETC, AND THAT "SEA"          C
 
1630
C    IS THE LIGHT QUARK SEA I.E. UBAR(X)=DBAR(X)=               C
 
1631
C      SEA/X FOR A PROTON.  IF IN DOUBT, CHECK THE              C
 
1632
C    MOMENTUM SUM RULE! NOTE ALSO THAT SCALE=Q IN GEV)          C
 
1633
C                                                               C
 
1634
C                         -*-                                   C
 
1635
C                                                               C
 
1636
C     (THE RANGE OF APPLICABILITY IS CURRENTLY:                 C
 
1637
C     10**-5 < X < 1  AND  5 < Q**2 < 1.31 * 10**6              C
 
1638
C     HIGHER Q**2 VALUES CAN BE SUPPLIED ON REQUEST             C
 
1639
C     - PROBLEMS, COMMENTS ETC TO WJS@UK.AC.DUR.HEP             C
 
1640
C                                                               C
 
1641
C                                                               C
 
1642
C***************************************************************C
 
1643
C                                                               C
 
1644
C     -----  VARIABLE LAMBDA AND GLUONS  ----                   C
 
1645
C                                                               C
 
1646
C     NEW VERSIONS !!!! OCTOBER 1990                            C
 
1647
C     "........................ "  A.D. MARTIN,                 C
 
1648
C     R.G. ROBERTS AND W.J. STIRLING PREPRINT DTP/90/76 (1990)  C
 
1649
C        TO BE PUBLISHED IN PHYS  REV D 43 (1991)               C
 
1650
C                                                               C
 
1651
C  MODE 2 CORRESPONDS TO  KWIECINSKI,                           C
 
1652
C  MARTIN, ROBERTS, STIRLING (BCDMS FIT)                        C
 
1653
C  WITH LAMBDA(4) = 190 MEV, ETAG = 5.10                        C
 
1654
C  AND XG,XQ --> CONSTANT AS X--> 0 AT Q0**2   "B0 FIT"         C
 
1655
C                                                               C
 
1656
C  MODE 3 CORRESPONDS TO                                        C
 
1657
C  MARTIN, ROBERTS, STIRLING (BCDMS FIT)                        C
 
1658
C  WITH LAMBDA(4) = 135 MEV, ETAG = 4.65                        C
 
1659
C  AND XG,XQ --> CONSTANT AS X--> 0 AT Q0**2   "B135 FIT"       C
 
1660
C                                                               C
 
1661
C  MODE 4 CORRESPONDS TO                                        C
 
1662
C  MARTIN, ROBERTS, STIRLING (BCDMS FIT)                        C
 
1663
C  WITH LAMBDA(4) = 160 MEV, ETAG = 4.25                        C
 
1664
C  AND XG,XQ --> CONSTANT AS X--> 0 AT Q0**2   "B160 FIT"       C
 
1665
C                                                               C
 
1666
C  MODE 5 CORRESPONDS TO                                        C
 
1667
C  MARTIN, ROBERTS, STIRLING (BCDMS FIT)                        C
 
1668
C  WITH LAMBDA(4) = 200 MEV, ETAG = 5.65                        C
 
1669
C  AND XG,XQ --> CONSTANT AS X--> 0 AT Q0**2   "B200 FIT"       C
 
1670
C                                                               C
 
1671
C  MODE 6 CORRESPONDS TO                                        C
 
1672
C  MARTIN, ROBERTS, STIRLING (BCDMS FIT)                        C
 
1673
C  WITH LAMBDA(4) = 235 MEV, ETAG = 5.20                        C
 
1674
C  AND XG,XQ --> CONSTANT AS X--> 0 AT Q0**2   "B235 FIT"       C
 
1675
C                                                               C
 
1676
C                                                               C
 
1677
C             >>>>>>>>  CROSS CHECK  <<<<<<<<                   C
 
1678
C                                                               C
 
1679
C    THE FIRST NUMBER IN THE "B0"   GRID IS  .01727             C
 
1680
C    THE FIRST NUMBER IN THE "B135" GRID IS  .01683             C
 
1681
C    THE FIRST NUMBER IN THE "B160" GRID IS  .01663             C
 
1682
C    THE FIRST NUMBER IN THE "B200" GRID IS  .01601             C
 
1683
C    THE FIRST NUMBER IN THE "B235" GRID IS  .01571             C
 
1684
C                                                               C
 
1685
C                         -*-                                   C
 
1686
C                                                               C
 
1687
C    (NOTE THAT X TIMES THE PARTON DISTRIBUTION FUNCTION        C
 
1688
C    IS RETURNED I.E. G(X) = GLU/X ETC, AND THAT "SEA"          C
 
1689
C    IS THE LIGHT QUARK SEA I.E. UBAR(X)=DBAR(X)                C
 
1690
C    = SEA/X FOR A PROTON.  IF IN DOUBT, CHECK THE              C
 
1691
C    MOMENTUM SUM RULE! NOTE ALSO THAT SCALE=Q IN GEV)          C
 
1692
C                                                               C
 
1693
C                         -*-                                   C
 
1694
C                                                               C
 
1695
C     (THE RANGE OF APPLICABILITY IS CURRENTLY:                 C
 
1696
C     10**-5 < X < 1  AND  5 < Q**2 < 1.31 * 10**6              C
 
1697
C     HIGHER Q**2 VALUES CAN BE SUPPLIED ON REQUEST             C
 
1698
C     - PROBLEMS, COMMENTS ETC TO WJS@UK.AC.DUR.HEP             C
 
1699
C                                                               C
 
1700
C                                                               C
 
1701
C***************************************************************C
 
1702
      IMPLICIT REAL*8(A-H,O-Z)
 
1703
      parameter(nx=47)
 
1704
      parameter(ntenth=21)
 
1705
      DIMENSION F(7,nx,19),G(7),XX(nx),XL(NX),N0(7)
 
1706
      DATA XX/1.d-5,2.d-5,4.d-5,6.d-5,8.d-5,
 
1707
     .        1.D-4,2.D-4,4.D-4,6.D-4,8.D-4,
 
1708
     .        1.D-3,2.D-3,4.D-3,6.D-3,8.D-3,
 
1709
     .        1.D-2,2.D-2,4.D-2,6.D-2,8.D-2,
 
1710
     .     .1D0,.125D0,.15D0,.175D0,.2D0,.225D0,.25D0,.275D0,
 
1711
     .     .3D0,.325D0,.35D0,.375D0,.4D0,.425D0,.45D0,.475D0,
 
1712
     .     .5D0,.525D0,.55D0,.575D0,.6D0,.65D0,.7D0,.75D0,
 
1713
     .     .8D0,.9D0,1.D0/
 
1714
      DATA XMIN,XMAX,QSQMIN,QSQMAX/1.D-5,1.D0,5.D0,1310720.D0/
 
1715
      DATA N0/2,5,4,5,0,0,5/
 
1716
      DATA INIT/0/,IMODE/0/
 
1717
      DATA IQLOW,IXLOW/2*0/
 
1718
      xsave=x  ! don't let x be altered if it's out of range!!
 
1719
 
 
1720
      IF(INIT.NE.0.AND.MODE.EQ.IMODE) GOTO 10
 
1721
      INIT=1
 
1722
      IMODE=MODE
 
1723
      IF(MODE.EQ.1)
 
1724
     .  OPEN(UNIT=27,FILE='HMRSB',STATUS='OLD')
 
1725
      IF(MODE.EQ.2)
 
1726
     .  OPEN(UNIT=27,FILE='KMRSB',STATUS='OLD')
 
1727
      IF(MODE.EQ.3)        
 
1728
     .  OPEN(UNIT=27,FILE='HMRSB135',STATUS='OLD')
 
1729
      IF(MODE.EQ.4)
 
1730
     .  OPEN(UNIT=27,FILE='HMRSB160',STATUS='OLD')
 
1731
      IF(MODE.EQ.5)
 
1732
     .  OPEN(UNIT=27,FILE='HMRSB200',STATUS='OLD')
 
1733
      IF(MODE.EQ.6)
 
1734
     .  OPEN(UNIT=27,FILE='HMRSB235',STATUS='OLD')
 
1735
      DO 20 N=1,nx-1
 
1736
      DO 20 M=1,19
 
1737
      READ(27,50)F(1,N,M),F(2,N,M),F(3,N,M),F(4,N,M),F(5,N,M),F(7,N,M),
 
1738
     .          F(6,N,M)
 
1739
C 1=UV 2=DV 3=GLUE 4=(UBAR+DBAR)/2 5=CBAR 7=BBAR 6=SBAR
 
1740
         DO 25 I=1,7
 
1741
  25     F(I,N,M)=F(I,N,M)/(1.D0-XX(N))**N0(I)
 
1742
  20  CONTINUE
 
1743
      close(unit=27)
 
1744
      CALL MRSCHECK(F(1,1,1),MODE)
 
1745
      DO 26 J=NTENTH,NX
 
1746
  26  XL(J) = XX(J)
 
1747
      DO 30 J=1,ntenth-1
 
1748
      XL(J)=DLOG10(XX(J))+1.1D0
 
1749
      DO 30 I=1,6
 
1750
      DO 30 K=1,19
 
1751
  30  F(I,J,K)=DLOG(F(I,J,K))*F(I,ntenth,K)/DLOG(F(I,ntenth,K))
 
1752
  50  FORMAT(7F10.5)
 
1753
      DO 40 I=1,7
 
1754
      DO 40 M=1,19
 
1755
  40  F(I,nx,M)=0.D0
 
1756
  10  CONTINUE
 
1757
      IF(X.LT.XMIN) X=XMIN
 
1758
      IF(X.GT.XMAX) X=XMAX
 
1759
      QSQ=SCALE**2
 
1760
      IF(QSQ.LT.QSQMIN) QSQ=QSQMIN
 
1761
      IF(QSQ.GT.QSQMAX) QSQ=QSQMAX
 
1762
      XXX=X
 
1763
      IF(X.LT.1.D-1) XXX=DLOG10(X)+1.1D0
 
1764
      N=0
 
1765
  70  N=N+1
 
1766
      IF(XXX.GT.XL(N+1)) GOTO 70
 
1767
      A=(XXX-XL(N))/(XL(N+1)-XL(N))
 
1768
      RM=DLOG(QSQ/QSQMIN)/DLOG(2.D0)
 
1769
      B=RM-DINT(RM)
 
1770
      M=1+IDINT(RM)
 
1771
      DO 60 I=1,7
 
1772
      G(I)= (1.D0-A)*(1.D0-B)*F(I,N,M)+(1.D0-A)*B*F(I,N,M+1)
 
1773
     .    + A*(1.D0-B)*F(I,N+1,M)  + A*B*F(I,N+1,M+1)
 
1774
      IF(N.GE.ntenth) GOTO 65
 
1775
      IF(I.EQ.7) GOTO 65
 
1776
          FAC=(1.D0-B)*F(I,ntenth,M)+B*F(I,ntenth,M+1)
 
1777
          G(I)=FAC**(G(I)/FAC)
 
1778
  65  CONTINUE
 
1779
      G(I)=G(I)*(1.D0-X)**N0(I)
 
1780
  60  CONTINUE
 
1781
      UPV=G(1)
 
1782
      DNV=G(2)
 
1783
      SEA=G(4) ! THIS SEA IS (UBAR+DBAR)/2
 
1784
      STR=G(6)
 
1785
      CHM=G(5)
 
1786
      GLU=G(3)
 
1787
      BOT=G(7)
 
1788
      x=xsave  !restore x
 
1789
      RETURN
 
1790
      END
 
1791
 
 
1792
      SUBROUTINE MRS92(X,SCALE,MODE,UPV,DNV,USEA,DSEA,STR,CHM,BOT,GLU)
 
1793
C***************************************************************C
 
1794
C                                                               C
 
1795
C                                                               C
 
1796
C     NEW VERSIONS:  APRIL  1992, MODE 1 IS THE 1990 KMRS(B0)   C
 
1797
C     SET; MODES 2-4 ARE NEW SETS FITTED TO THE RECENT NMC      C
 
1798
C     AND CCFR PRELIMINARY STRUCTURE FUNCTION DATA.             C
 
1799
C     THE THREE NEW SETS HAVE LAMBDA(MSbar,NF=4) = 215 MeV      C
 
1800
C                                                               C
 
1801
C     THE REFERENCE IS: A.D. Martin, R.G. Roberts and           C
 
1802
C     W.J. Stirling, University of Durham preprint DTP/92/16    C
 
1803
C                                                               C
 
1804
C        MODE 7 : MRS(S0) (updated B0, Lambda(4) = 215 MeV)      C
 
1805
C        MODE 8 : MRS(D0) (... but with ubar not= dbar)          C
 
1806
C        MODE 9 : MRS(D-) (updated B-, ubar not= dbar)           C
 
1807
C                                                               C
 
1808
C             >>>>>>>>  CROSS CHECK  <<<<<<<<                   C
 
1809
C                                                               C
 
1810
C    THE FIRST NUMBER IN THE "7" GRID IS 0.01356                C
 
1811
C    THE FIRST NUMBER IN THE "8" GRID IS 0.00527                C
 
1812
C    THE FIRST NUMBER IN THE "9" GRID IS 0.00474                C
 
1813
C                                                               C
 
1814
C    NOTE THE EXTRA ARGUMENT IN THIS SUBROUTINE MRSEB,          C
 
1815
C    TO ALLOW FOR THE POSSIBILITY OF A *** DIFFERENT ***        C
 
1816
C    UBAR AND DBAR SEA!                                         C
 
1817
C                                                               C
 
1818
C                         -*-                                   C
 
1819
C                                                               C
 
1820
C    (NOTE THAT X TIMES THE PARTON DISTRIBUTION FUNCTION        C
 
1821
C    IS RETURNED I.E. G(X) = GLU/X ETC. IF IN DOUBT, CHECK THE  C
 
1822
C    MOMENTUM SUM RULE! NOTE ALSO THAT SCALE=Q IN GEV)          C
 
1823
C                                                               C
 
1824
C                         -*-                                   C
 
1825
C                                                               C
 
1826
C     (THE RANGE OF APPLICABILITY IS CURRENTLY:                 C
 
1827
C     10**-5 < X < 1  AND  5 < Q**2 < 1.31 * 10**6              C
 
1828
C     HIGHER Q**2 VALUES CAN BE SUPPLIED ON REQUEST             C
 
1829
C     - PROBLEMS, COMMENTS ETC TO WJS@UK.AC.DUR.HEP             C
 
1830
C                                                               C
 
1831
C                                                               C
 
1832
C***************************************************************C
 
1833
      IMPLICIT REAL*8(A-H,O-Z)
 
1834
      parameter(nx=47,ntenth=21,nq=20)
 
1835
      DIMENSION F(8,NX,nq),G(8),XX(NX),XL(NX),N0(8)
 
1836
      DATA XX/1.d-5,2.d-5,4.d-5,6.d-5,8.d-5,
 
1837
     .        1.D-4,2.D-4,4.D-4,6.D-4,8.D-4,
 
1838
     .        1.D-3,2.D-3,4.D-3,6.D-3,8.D-3,
 
1839
     .        1.D-2,2.D-2,4.D-2,6.D-2,8.D-2,
 
1840
     .     .1D0,.125D0,.15D0,.175D0,.2D0,.225D0,.25D0,.275D0,
 
1841
     .     .3D0,.325D0,.35D0,.375D0,.4D0,.425D0,.45D0,.475D0,
 
1842
     .     .5D0,.525D0,.55D0,.575D0,.6D0,.65D0,.7D0,.75D0,
 
1843
     .     .8D0,.9D0,1.D0/
 
1844
      DATA XMIN,XMAX,QSQMIN,QSQMAX/1.D-5,1.D0,5.D0,1310720.D0/
 
1845
      DATA N0/2,5,4,5,0,0,5,5/
 
1846
      DATA INIT/0/
 
1847
      save xx,n0,init
 
1848
      xsave=x  ! don't let x be altered if it's out of range!!
 
1849
      IF(INIT.NE.0.AND.MODE.EQ.IMODE) GOTO 10
 
1850
      INIT=1
 
1851
      IMODE=MODE
 
1852
      if(mode.eq.7)then
 
1853
        open(unit=1,file='MRSS0',status='old')
 
1854
      elseif(mode.eq.8)then
 
1855
        open(unit=1,file='MRSD0',status='old')
 
1856
      elseif(mode.eq.9)then
 
1857
        open(unit=1,file='MRSDS',status='old')
 
1858
      endif
 
1859
      DO 20 N=1,nx-1
 
1860
      DO 20 M=1,nq-1
 
1861
      READ(1,50)F(1,N,M),F(2,N,M),F(3,N,M),F(4,N,M),F(5,N,M),F(7,N,M),
 
1862
     .          F(6,N,M),F(8,N,M)
 
1863
C 1=UV 2=DV 3=GLUE 4=UBAR 5=CBAR 7=BBAR 6=SBAR 8=DBAR
 
1864
         DO 25 I=1,8
 
1865
  25     F(I,N,M)=F(I,N,M)/(1.D0-XX(N))**N0(I)
 
1866
  20  CONTINUE
 
1867
      close(1)
 
1868
      INIT=1
 
1869
      CALL MRSCHECK(F(1,1,1),MODE)
 
1870
      do j=ntenth,nx
 
1871
         xl(j)=xx(j)
 
1872
      enddo
 
1873
      DO 31 J=1,NTENTH-1
 
1874
      XL(J)=DLOG10(XX(J))+1.1D0
 
1875
      DO 31 I=1,8
 
1876
      IF(I.EQ.7) GO TO 31
 
1877
      DO 30 K=1,nq-1
 
1878
  30  F(I,J,K)=DLOG(F(I,J,K))*F(I,ntenth,K)/DLOG(F(I,ntenth,K))
 
1879
  31  continue
 
1880
  50  FORMAT(8F10.5)
 
1881
      DO 40 I=1,8
 
1882
      DO 40 M=1,nq-1
 
1883
  40  F(I,nx,M)=0.D0
 
1884
  10  CONTINUE
 
1885
      IF(X.LT.XMIN) X=XMIN
 
1886
      IF(X.GT.XMAX) X=XMAX
 
1887
      QSQ=SCALE**2
 
1888
      IF(QSQ.LT.QSQMIN) QSQ=QSQMIN
 
1889
      IF(QSQ.GT.QSQMAX) QSQ=QSQMAX
 
1890
      XXX=X
 
1891
      IF(X.LT.1.D-1) XXX=DLOG10(X)+1.1D0
 
1892
      N=0
 
1893
  70  N=N+1
 
1894
      IF(XXX.GT.XL(N+1)) GOTO 70
 
1895
      A=(XXX-XL(N))/(XL(N+1)-XL(N))
 
1896
      RM=DLOG(QSQ/QSQMIN)/DLOG(2.D0)
 
1897
      B=RM-DINT(RM)
 
1898
      M=1+IDINT(RM)
 
1899
      DO 60 I=1,8
 
1900
      g(i)= (1.d0-a)*(1.d0-b)*f(i,n,m)+(1.d0-a)*b*f(i,n,m+1)
 
1901
     .    + a*(1.d0-b)*f(i,n+1,m)  + a*b*f(i,n+1,m+1)
 
1902
      IF(N.GE.ntenth) GOTO 65
 
1903
      IF(I.EQ.7) GOTO 65
 
1904
          fac=(1.d0-b)*f(i,ntenth,m)+b*f(i,ntenth,m+1)
 
1905
          G(I)=FAC**(G(I)/FAC)
 
1906
  65  CONTINUE
 
1907
      G(I)=G(I)*(1.D0-X)**N0(I)
 
1908
  60  CONTINUE
 
1909
      UPV=G(1)
 
1910
      DNV=G(2)
 
1911
      USEA=G(4)
 
1912
      DSEA=G(8)
 
1913
      STR=G(6)
 
1914
      CHM=G(5)
 
1915
      GLU=G(3)
 
1916
      BOT=G(7)
 
1917
      x=xsave  !restore x
 
1918
      RETURN
 
1919
      END
 
1920
C
 
1921
      SUBROUTINE STRC31(X,SCALE,UPV,DNV,USEA,DSEA,STR,CHM,BOT,GLU)
 
1922
 
 
1923
C     THIS IS THE NEW  "G" FIT -- Feb 1995 -- standard Q^2 range
 
1924
 
 
1925
      IMPLICIT REAL*8(A-H,O-Z)
 
1926
      parameter(nx=47)
 
1927
      parameter(ntenth=21)
 
1928
      DIMENSION F(8,NX,20),G(8),XX(NX),N0(8)
 
1929
      DATA XX/1.d-5,2.d-5,4.d-5,6.d-5,8.d-5,
 
1930
     .        1.D-4,2.D-4,4.D-4,6.D-4,8.D-4,
 
1931
     .        1.D-3,2.D-3,4.D-3,6.D-3,8.D-3,
 
1932
     .        1.D-2,2.D-2,4.D-2,6.D-2,8.D-2,
 
1933
     .     .1D0,.125D0,.15D0,.175D0,.2D0,.225D0,.25D0,.275D0,
 
1934
     .     .3D0,.325D0,.35D0,.375D0,.4D0,.425D0,.45D0,.475D0,
 
1935
     .     .5D0,.525D0,.55D0,.575D0,.6D0,.65D0,.7D0,.75D0,
 
1936
     .     .8D0,.9D0,1.D0/
 
1937
      DATA XMIN,XMAX,QSQMIN,QSQMAX/1.D-5,1.D0,5.D0,1310720.D0/
 
1938
      DATA N0/2,5,5,9,0,0,9,9/
 
1939
      DATA INIT/0/
 
1940
 
 
1941
 
 
1942
      xsave=x
 
1943
 
 
1944
      IF(INIT.NE.0) GOTO 10
 
1945
      INIT=1
 
1946
      open(unit=31,file='MRSG',status='old')
 
1947
      DO 20 N=1,nx-1
 
1948
      DO 20 M=1,19
 
1949
      READ(31,50)F(1,N,M),F(2,N,M),F(3,N,M),F(4,N,M),F(5,N,M),F(7,N,M),
 
1950
     .          F(6,N,M),F(8,N,M)
 
1951
C 1=UV 2=DV 3=GLUE 4=UBAR 5=CBAR 7=BBAR 6=SBAR 8=DBAR
 
1952
         DO 25 I=1,8
 
1953
  25     F(I,N,M)=F(I,N,M)/(1.D0-XX(N))**N0(I)
 
1954
  20  CONTINUE
 
1955
      close(31)
 
1956
      CALL MRSCHECK(F(1,1,1),12)
 
1957
      DO 31 J=1,NTENTH-1
 
1958
      XX(J)=DLOG10(XX(J))+1.1D0
 
1959
      DO 31 I=1,8
 
1960
      IF(I.EQ.7) GO TO 31
 
1961
      DO 30 K=1,19
 
1962
  30  F(I,J,K)=DLOG(F(I,J,K))*F(I,ntenth,K)/DLOG(F(I,ntenth,K))
 
1963
  31  CONTINUE
 
1964
  50  FORMAT(8F10.5)
 
1965
      DO 40 I=1,8
 
1966
      DO 40 M=1,19
 
1967
  40  F(I,nx,M)=0.D0
 
1968
  10  CONTINUE
 
1969
      IF(X.LT.XMIN) X=XMIN
 
1970
      IF(X.GT.XMAX) X=XMAX
 
1971
      QSQ=SCALE**2
 
1972
      IF(QSQ.LT.QSQMIN) QSQ=QSQMIN
 
1973
      IF(QSQ.GT.QSQMAX) QSQ=QSQMAX
 
1974
      XXX=X
 
1975
      IF(X.LT.1.D-1) XXX=DLOG10(X)+1.1D0
 
1976
      N=0
 
1977
  70  N=N+1
 
1978
      IF(XXX.GT.XX(N+1)) GOTO 70
 
1979
      A=(XXX-XX(N))/(XX(N+1)-XX(N))
 
1980
      RM=DLOG(QSQ/QSQMIN)/DLOG(2.D0)
 
1981
      B=RM-DINT(RM)
 
1982
      M=1+IDINT(RM)
 
1983
      DO 60 I=1,8
 
1984
      G(I)= (1.D0-A)*(1.D0-B)*F(I,N,M)+(1.D0-A)*B*F(I,N,M+1)
 
1985
     .    + A*(1.D0-B)*F(I,N+1,M)  + A*B*F(I,N+1,M+1)
 
1986
      IF(N.GE.ntenth) GOTO 65
 
1987
      IF(I.EQ.7) GOTO 65
 
1988
          FAC=(1.D0-B)*F(I,ntenth,M)+B*F(I,ntenth,M+1)
 
1989
          G(I)=FAC**(G(I)/FAC)
 
1990
  65  CONTINUE
 
1991
      G(I)=G(I)*(1.D0-X)**N0(I)
 
1992
  60  CONTINUE
 
1993
      UPV=G(1)
 
1994
      DNV=G(2)
 
1995
      USEA=G(4)
 
1996
      DSEA=G(8)
 
1997
      STR=G(6)
 
1998
      CHM=G(5)
 
1999
      GLU=G(3)
 
2000
      BOT=G(7)
 
2001
 
 
2002
      x=xsave
 
2003
 
 
2004
      RETURN
 
2005
      END
 
2006
C
 
2007
      SUBROUTINE STRC33(X,SCALE,UPV,DNV,USEA,DSEA,STR,CHM,BOT,GLU)
 
2008
                 
 
2009
C     THIS IS THE NEW  "A" FIT -- May 1994 -- standard Q^2 range
 
2010
 
 
2011
      IMPLICIT REAL*8(A-H,O-Z)
 
2012
      parameter(nx=47)
 
2013
      parameter(ntenth=21)
 
2014
      DIMENSION F(8,NX,20),G(8),XX(NX),N0(8)
 
2015
      DATA XX/1.d-5,2.d-5,4.d-5,6.d-5,8.d-5,
 
2016
     .        1.D-4,2.D-4,4.D-4,6.D-4,8.D-4,
 
2017
     .        1.D-3,2.D-3,4.D-3,6.D-3,8.D-3,
 
2018
     .        1.D-2,2.D-2,4.D-2,6.D-2,8.D-2,
 
2019
     .     .1D0,.125D0,.15D0,.175D0,.2D0,.225D0,.25D0,.275D0,
 
2020
     .     .3D0,.325D0,.35D0,.375D0,.4D0,.425D0,.45D0,.475D0,
 
2021
     .     .5D0,.525D0,.55D0,.575D0,.6D0,.65D0,.7D0,.75D0,
 
2022
     .     .8D0,.9D0,1.D0/
 
2023
      DATA XMIN,XMAX,QSQMIN,QSQMAX/1.D-5,1.D0,5.D0,1310720.D0/
 
2024
      DATA N0/2,5,5,9,0,0,9,9/
 
2025
      DATA INIT/0/
 
2026
 
 
2027
 
 
2028
      xsave=x
 
2029
 
 
2030
      IF(INIT.NE.0) GOTO 10
 
2031
      INIT=1
 
2032
      open(unit=33,file='MRSA',status='old')
 
2033
      DO 20 N=1,nx-1         
 
2034
      DO 20 M=1,19
 
2035
      READ(33,50)F(1,N,M),F(2,N,M),F(3,N,M),F(4,N,M),F(5,N,M),F(7,N,M),
 
2036
     .          F(6,N,M),F(8,N,M)
 
2037
C 1=UV 2=DV 3=GLUE 4=UBAR 5=CBAR 7=BBAR 6=SBAR 8=DBAR
 
2038
         DO 25 I=1,8
 
2039
  25     F(I,N,M)=F(I,N,M)/(1.D0-XX(N))**N0(I)
 
2040
  20  CONTINUE
 
2041
      close(33)
 
2042
      CALL MRSCHECK(F(1,1,1),10)
 
2043
      DO 31 J=1,NTENTH-1
 
2044
      XX(J)=DLOG10(XX(J))+1.1D0
 
2045
      DO 31 I=1,8
 
2046
      IF(I.EQ.7) GO TO 31
 
2047
      DO 30 K=1,19
 
2048
  30  F(I,J,K)=DLOG(F(I,J,K))*F(I,ntenth,K)/DLOG(F(I,ntenth,K))
 
2049
  31  CONTINUE
 
2050
  50  FORMAT(8F10.5)
 
2051
      DO 40 I=1,8
 
2052
      DO 40 M=1,19
 
2053
  40  F(I,nx,M)=0.D0
 
2054
  10  CONTINUE
 
2055
      IF(X.LT.XMIN) X=XMIN
 
2056
      IF(X.GT.XMAX) X=XMAX
 
2057
      QSQ=SCALE**2
 
2058
      IF(QSQ.LT.QSQMIN) QSQ=QSQMIN
 
2059
      IF(QSQ.GT.QSQMAX) QSQ=QSQMAX
 
2060
      XXX=X
 
2061
      IF(X.LT.1.D-1) XXX=DLOG10(X)+1.1D0
 
2062
      N=0
 
2063
  70  N=N+1
 
2064
      IF(XXX.GT.XX(N+1)) GOTO 70
 
2065
      A=(XXX-XX(N))/(XX(N+1)-XX(N))
 
2066
      RM=DLOG(QSQ/QSQMIN)/DLOG(2.D0)
 
2067
      B=RM-DINT(RM)
 
2068
      M=1+IDINT(RM)
 
2069
      DO 60 I=1,8
 
2070
      G(I)= (1.D0-A)*(1.D0-B)*F(I,N,M)+(1.D0-A)*B*F(I,N,M+1)
 
2071
     .    + A*(1.D0-B)*F(I,N+1,M)  + A*B*F(I,N+1,M+1)
 
2072
      IF(N.GE.ntenth) GOTO 65
 
2073
      IF(I.EQ.7) GOTO 65
 
2074
          FAC=(1.D0-B)*F(I,ntenth,M)+B*F(I,ntenth,M+1)
 
2075
          G(I)=FAC**(G(I)/FAC)
 
2076
  65  CONTINUE
 
2077
      G(I)=G(I)*(1.D0-X)**N0(I)
 
2078
  60  CONTINUE
 
2079
      UPV=G(1)
 
2080
      DNV=G(2)
 
2081
      USEA=G(4)
 
2082
      DSEA=G(8)
 
2083
      STR=G(6)
 
2084
      CHM=G(5)
 
2085
      GLU=G(3)
 
2086
      BOT=G(7)
 
2087
 
 
2088
      x=xsave
 
2089
 
 
2090
      RETURN
 
2091
      END
 
2092
C
 
2093
      SUBROUTINE STRC34(X,SCALE,UPV,DNV,USEA,DSEA,STR,CHM,BOT,GLU)
 
2094
 
 
2095
C     THIS IS THE NEW  "A" FIT -- May 1994 -- low Q^2 range
 
2096
 
 
2097
      IMPLICIT REAL*8(A-H,O-Z)
 
2098
      parameter(nx=47)
 
2099
      parameter(ntenth=21)
 
2100
      DIMENSION F(8,NX,8),G(8),XX(NX),N0(8)
 
2101
      DATA XX/1.d-5,2.d-5,4.d-5,6.d-5,8.d-5,
 
2102
     .        1.D-4,2.D-4,4.D-4,6.D-4,8.D-4,
 
2103
     .        1.D-3,2.D-3,4.D-3,6.D-3,8.D-3,
 
2104
     .        1.D-2,2.D-2,4.D-2,6.D-2,8.D-2,
 
2105
     .     .1D0,.125D0,.15D0,.175D0,.2D0,.225D0,.25D0,.275D0,
 
2106
     .     .3D0,.325D0,.35D0,.375D0,.4D0,.425D0,.45D0,.475D0,
 
2107
     .     .5D0,.525D0,.55D0,.575D0,.6D0,.65D0,.7D0,.75D0,
 
2108
     .     .8D0,.9D0,1.D0/
 
2109
      DATA XMIN,XMAX,QSQMIN,QSQMAX/1.D-5,1.D0,0.625D0,5.D0/
 
2110
      DATA N0/2,5,5,9,0,0,9,9/
 
2111
      DATA INIT/0/
 
2112
 
 
2113
      xsave=x  ! don't let x be altered if it's out of range!!
 
2114
 
 
2115
      IF(INIT.NE.0) GOTO 10
 
2116
      INIT=1
 
2117
      open(unit=34,file='MRSA2',status='old')
 
2118
      DO 20 N=1,nx-1
 
2119
      DO 20 M=1,7
 
2120
      READ(34,50)F(1,N,M),F(2,N,M),F(3,N,M),F(4,N,M),F(5,N,M),F(7,N,M),
 
2121
     .          F(6,N,M),F(8,N,M)
 
2122
C 1=UV 2=DV 3=GLUE 4=UBAR 5=CBAR 7=BBAR 6=SBAR 8=DBAR
 
2123
         DO 25 I=1,8
 
2124
  25     F(I,N,M)=F(I,N,M)/(1.D0-XX(N))**N0(I)
 
2125
  20  CONTINUE
 
2126
      close(34)
 
2127
      CALL MRSCHECK(F(1,1,1),10)
 
2128
      DO 31 J=1,NTENTH-1
 
2129
      XX(J)=DLOG10(XX(J))+1.1D0
 
2130
      DO 31 I=1,8
 
2131
      IF(I.EQ.7.or.i.eq.5) GO TO 31
 
2132
      DO 30 K=1,7
 
2133
  30  F(I,J,K)=DLOG(F(I,J,K))*F(I,ntenth,K)/DLOG(F(I,ntenth,K))
 
2134
  31  CONTINUE
 
2135
  50  FORMAT(8F10.5)
 
2136
      DO 40 I=1,8
 
2137
      DO 40 M=1,7
 
2138
  40  F(I,nx,M)=0.D0
 
2139
  10  CONTINUE
 
2140
      IF(X.LT.XMIN) X=XMIN
 
2141
      IF(X.GT.XMAX) X=XMAX
 
2142
      QSQ=SCALE**2
 
2143
      IF(QSQ.LT.QSQMIN) QSQ=QSQMIN
 
2144
      IF(QSQ.GT.QSQMAX) QSQ=QSQMAX
 
2145
      XXX=X
 
2146
      IF(X.LT.1.D-1) XXX=DLOG10(X)+1.1D0
 
2147
      N=0
 
2148
  70  N=N+1
 
2149
      IF(XXX.GT.XX(N+1)) GOTO 70
 
2150
      A=(XXX-XX(N))/(XX(N+1)-XX(N))
 
2151
      RM=DLOG(QSQ/QSQMIN)/DLOG(2.D0)*2D0
 
2152
      B=RM-DINT(RM)
 
2153
      M=1+IDINT(RM)
 
2154
      DO 60 I=1,8
 
2155
      G(I)= (1.D0-A)*(1.D0-B)*F(I,N,M)+(1.D0-A)*B*F(I,N,M+1)
 
2156
     .    + A*(1.D0-B)*F(I,N+1,M)  + A*B*F(I,N+1,M+1)
 
2157
      IF(N.GE.ntenth) GOTO 65
 
2158
      IF(I.EQ.7.or.i.eq.5) GOTO 65
 
2159
          FAC=(1.D0-B)*F(I,ntenth,M)+B*F(I,ntenth,M+1)
 
2160
          G(I)=FAC**(G(I)/FAC)
 
2161
  65  CONTINUE
 
2162
      G(I)=G(I)*(1.D0-X)**N0(I)
 
2163
  60  CONTINUE
 
2164
      UPV=G(1)
 
2165
      DNV=G(2)
 
2166
      USEA=G(4)
 
2167
      DSEA=G(8)
 
2168
      STR=G(6)
 
2169
      CHM=G(5)
 
2170
      GLU=G(3)
 
2171
      BOT=G(7)
 
2172
 
 
2173
      x=xsave  !restore x
 
2174
 
 
2175
      RETURN
 
2176
      END
 
2177
C
 
2178
      SUBROUTINE MRSLAM(X,SCALE,MODE,UPV,DNV,USEA,DSEA,STR,CHM,BOT,GLU)
 
2179
C***************************************************************C
 
2180
C                                                               C
 
2181
C MSBAR MSBAR MSBAR MSBAR MSBAR MSBAR MSBAR MSBAR MSBAR MSBAR   C
 
2182
C                                                               C
 
2183
C     This is a package for the new MRS variable alpha_S parton C
 
2184
C     distributions. The minimum Q^2  value is 5 GeV^2          C
 
2185
C     and the x range is, as before,                            C
 
2186
C     10^-5 < x < 1. MSbar factorization is used.               C
 
2187
C     The package reads 7 grids, which are in  separate files.  C  
 
2188
C     Note that x times the parton                              C
 
2189
C     distribution is returned, Q is the scale in GeV.          C
 
2190
C                                                               C
 
2191
C       MODE=0 for MRS(A')    (Lambda(4) = 0.231)               C
 
2192
C       MODE=1 for MRS(105)   (Lambda(4) = 0.150)               C
 
2193
C       MODE=2 for MRS(110)   (Lambda(4) = 0.201)               C
 
2194
C       MODE=3 for MRS(115)   (Lambda(4) = 0.266)               C
 
2195
C       MODE=4 for MRS(120)   (Lambda(4) = 0.344)               C
 
2196
C       MODE=5 for MRS(125)   (Lambda(4) = 0.435)               C
 
2197
C       MODE=6 for MRS(130)   (Lambda(4) = 0.542)               C
 
2198
C                                                               C
 
2199
C         The reference is:                                     C
 
2200
C         A.D. Martin, R.G. Roberts and W.J. Stirling,          C
 
2201
C         Phys. Lett. B356 (1995) 89.                           C
 
2202
C                                                               C
 
2203
C         Comments to : W.J.Stirling@durham.ac.uk               C
 
2204
C                                                               C
 
2205
C             >>>>>>>>  CROSS CHECK  <<<<<<<<                   C
 
2206
C                                                               C
 
2207
C         THE FIRST NUMBER IN THE A'  GRID IS 0.00341           C
 
2208
C         THE FIRST NUMBER IN THE 105 GRID IS 0.00429           C
 
2209
C         THE FIRST NUMBER IN THE 110 GRID IS 0.00350           C
 
2210
C         THE FIRST NUMBER IN THE 115 GRID IS 0.00294           C
 
2211
C         THE FIRST NUMBER IN THE 120 GRID IS 0.00273           C
 
2212
C         THE FIRST NUMBER IN THE 125 GRID IS 0.00195           C
 
2213
C         THE FIRST NUMBER IN THE 130 GRID IS 0.00145           C
 
2214
C                                                               C
 
2215
C***************************************************************C
 
2216
      IMPLICIT REAL*8(A-H,O-Z)
 
2217
      data init/0/
 
2218
      IF(INIT.NE.0.AND.MODE.EQ.IMODE) GOTO 10
 
2219
      INIT=1                          
 
2220
      IMODE=MODE
 
2221
      IF(MODE.EQ.0) then
 
2222
        OPEN(UNIT=30,FILE='MRSAP',STATUS='OLD')
 
2223
      ELSEIF(MODE.EQ.1) then
 
2224
        OPEN(UNIT=55,FILE='MRS105',STATUS='OLD')
 
2225
      ELSEIF(MODE.EQ.2) then      
 
2226
        OPEN(UNIT=60,FILE='MRS110',STATUS='OLD')
 
2227
      ELSEIF(MODE.EQ.3) then
 
2228
        OPEN(UNIT=65,FILE='MRS115',STATUS='OLD')
 
2229
      ELSEIF(MODE.EQ.4) then
 
2230
        OPEN(UNIT=70,FILE='MRS120',STATUS='OLD')
 
2231
      ELSEIF(MODE.EQ.5) then
 
2232
        OPEN(UNIT=75,FILE='MRS125',STATUS='OLD')
 
2233
      ELSEIF(MODE.EQ.6) then
 
2234
        OPEN(UNIT=80,FILE='MRS130',STATUS='OLD')
 
2235
      ELSE
 
2236
         WRITE(*,*) ' MRSLAM: UNKNOWN MODE ',MODE
 
2237
         STOP
 
2238
      ENDIF
 
2239
10    Q2=SCALE**2
 
2240
      IF(MODE.EQ.0) 
 
2241
     .   CALL STRC30(X,SCALE,UPV,DNV,USEA,DSEA,STR,CHM,BOT,GLU)
 
2242
      IF(MODE.EQ.1) 
 
2243
     .   CALL STRC105(X,SCALE,UPV,DNV,USEA,DSEA,STR,CHM,BOT,GLU)
 
2244
      IF(MODE.EQ.2) 
 
2245
     .   CALL STRC110(X,SCALE,UPV,DNV,USEA,DSEA,STR,CHM,BOT,GLU)
 
2246
      IF(MODE.EQ.3) 
 
2247
     .   CALL STRC115(X,SCALE,UPV,DNV,USEA,DSEA,STR,CHM,BOT,GLU)
 
2248
      IF(MODE.EQ.4) 
 
2249
     .   CALL STRC120(X,SCALE,UPV,DNV,USEA,DSEA,STR,CHM,BOT,GLU)
 
2250
      IF(MODE.EQ.5) 
 
2251
     .   CALL STRC125(X,SCALE,UPV,DNV,USEA,DSEA,STR,CHM,BOT,GLU)
 
2252
      IF(MODE.EQ.6) 
 
2253
     .   CALL STRC130(X,SCALE,UPV,DNV,USEA,DSEA,STR,CHM,BOT,GLU)
 
2254
      RETURN
 
2255
      END
 
2256
C
 
2257
      SUBROUTINE STRC30(X,SCALE,UPV,DNV,USEA,DSEA,STR,CHM,BOT,GLU)
 
2258
 
 
2259
C     THIS IS THE NEW  "Aprime" FIT -- Feb 1995 -- standard Q^2 range
 
2260
 
 
2261
      IMPLICIT REAL*8(A-H,O-Z)
 
2262
      parameter(nx=47)
 
2263
      parameter(ntenth=21)
 
2264
      DIMENSION F(8,NX,20),G(8),XX(NX),N0(8)
 
2265
      DATA XX/1.d-5,2.d-5,4.d-5,6.d-5,8.d-5,
 
2266
     .        1.D-4,2.D-4,4.D-4,6.D-4,8.D-4,
 
2267
     .        1.D-3,2.D-3,4.D-3,6.D-3,8.D-3,
 
2268
     .        1.D-2,2.D-2,4.D-2,6.D-2,8.D-2,
 
2269
     .     .1D0,.125D0,.15D0,.175D0,.2D0,.225D0,.25D0,.275D0,
 
2270
     .     .3D0,.325D0,.35D0,.375D0,.4D0,.425D0,.45D0,.475D0,
 
2271
     .     .5D0,.525D0,.55D0,.575D0,.6D0,.65D0,.7D0,.75D0,
 
2272
     .     .8D0,.9D0,1.D0/
 
2273
      DATA XMIN,XMAX,QSQMIN,QSQMAX/1.D-5,1.D0,5.D0,1310720.D0/
 
2274
      DATA N0/2,5,5,9,0,0,9,9/
 
2275
      DATA INIT/0/
 
2276
 
 
2277
 
 
2278
      xsave=x
 
2279
 
 
2280
      IF(INIT.NE.0) GOTO 10
 
2281
      INIT=1
 
2282
      DO 20 N=1,nx-1
 
2283
      DO 20 M=1,19
 
2284
      READ(30,50)F(1,N,M),F(2,N,M),F(3,N,M),F(4,N,M),F(5,N,M),F(7,N,M),
 
2285
     .          F(6,N,M),F(8,N,M)
 
2286
C 1=UV 2=DV 3=GLUE 4=UBAR 5=CBAR 7=BBAR 6=SBAR 8=DBAR
 
2287
         DO 25 I=1,8
 
2288
  25     F(I,N,M)=F(I,N,M)/(1.D0-XX(N))**N0(I)
 
2289
  20  CONTINUE
 
2290
      CALL MRSCHECK(F(1,1,1),11)
 
2291
      DO 31 J=1,NTENTH-1
 
2292
      XX(J)=DLOG10(XX(J))+1.1D0
 
2293
      DO 31 I=1,8
 
2294
      IF(I.EQ.7) GO TO 31
 
2295
      DO 30 K=1,19
 
2296
  30  F(I,J,K)=DLOG(F(I,J,K))*F(I,ntenth,K)/DLOG(F(I,ntenth,K))
 
2297
  31  CONTINUE
 
2298
  50  FORMAT(8F10.5)
 
2299
      DO 40 I=1,8
 
2300
      DO 40 M=1,19
 
2301
  40  F(I,nx,M)=0.D0
 
2302
  10  CONTINUE
 
2303
      IF(X.LT.XMIN) X=XMIN
 
2304
      IF(X.GT.XMAX) X=XMAX
 
2305
      QSQ=SCALE**2
 
2306
      IF(QSQ.LT.QSQMIN) QSQ=QSQMIN
 
2307
      IF(QSQ.GT.QSQMAX) QSQ=QSQMAX
 
2308
      XXX=X
 
2309
      IF(X.LT.1.D-1) XXX=DLOG10(X)+1.1D0
 
2310
      N=0
 
2311
  70  N=N+1
 
2312
      IF(XXX.GT.XX(N+1)) GOTO 70
 
2313
      A=(XXX-XX(N))/(XX(N+1)-XX(N))
 
2314
      RM=DLOG(QSQ/QSQMIN)/DLOG(2.D0)
 
2315
      B=RM-DINT(RM)
 
2316
      M=1+IDINT(RM)
 
2317
      DO 60 I=1,8
 
2318
      G(I)= (1.D0-A)*(1.D0-B)*F(I,N,M)+(1.D0-A)*B*F(I,N,M+1)
 
2319
     .    + A*(1.D0-B)*F(I,N+1,M)  + A*B*F(I,N+1,M+1)
 
2320
      IF(N.GE.ntenth) GOTO 65
 
2321
      IF(I.EQ.7) GOTO 65
 
2322
          FAC=(1.D0-B)*F(I,ntenth,M)+B*F(I,ntenth,M+1)
 
2323
          G(I)=FAC**(G(I)/FAC)
 
2324
  65  CONTINUE
 
2325
      G(I)=G(I)*(1.D0-X)**N0(I)
 
2326
  60  CONTINUE
 
2327
      UPV=G(1)
 
2328
      DNV=G(2)
 
2329
      USEA=G(4)
 
2330
      DSEA=G(8)
 
2331
      STR=G(6)
 
2332
      CHM=G(5)
 
2333
      GLU=G(3)
 
2334
      BOT=G(7)
 
2335
 
 
2336
      x=xsave
 
2337
 
 
2338
      RETURN
 
2339
      END
 
2340
C
 
2341
      SUBROUTINE STRC105(X,SCALE,UPV,DNV,USEA,DSEA,STR,CHM,BOT,GLU)
 
2342
 
 
2343
C     THIS IS THE alphas=0.105 FIT -- May 1995 -- standard Q^2 range
 
2344
 
 
2345
      IMPLICIT REAL*8(A-H,O-Z)
 
2346
      parameter(nx=47)
 
2347
      parameter(ntenth=21)
 
2348
      DIMENSION F(8,NX,20),G(8),XX(NX),N0(8)
 
2349
      DATA XX/1.d-5,2.d-5,4.d-5,6.d-5,8.d-5,
 
2350
     .        1.D-4,2.D-4,4.D-4,6.D-4,8.D-4,
 
2351
     .        1.D-3,2.D-3,4.D-3,6.D-3,8.D-3,
 
2352
     .        1.D-2,2.D-2,4.D-2,6.D-2,8.D-2,
 
2353
     .     .1D0,.125D0,.15D0,.175D0,.2D0,.225D0,.25D0,.275D0,
 
2354
     .     .3D0,.325D0,.35D0,.375D0,.4D0,.425D0,.45D0,.475D0,
 
2355
     .     .5D0,.525D0,.55D0,.575D0,.6D0,.65D0,.7D0,.75D0,
 
2356
     .     .8D0,.9D0,1.D0/
 
2357
      DATA XMIN,XMAX,QSQMIN,QSQMAX/1.D-5,1.D0,5.D0,1310720.D0/
 
2358
      DATA N0/2,5,5,9,0,0,9,9/
 
2359
      DATA INIT/0/
 
2360
 
 
2361
 
 
2362
      xsave=x
 
2363
 
 
2364
      IF(INIT.NE.0) GOTO 10
 
2365
      INIT=1
 
2366
      DO 20 N=1,nx-1
 
2367
      DO 20 M=1,19
 
2368
      READ(55,50)F(1,N,M),F(2,N,M),F(3,N,M),F(4,N,M),F(5,N,M),F(7,N,M),
 
2369
     .          F(6,N,M),F(8,N,M)
 
2370
C 1=UV 2=DV 3=GLUE 4=UBAR 5=CBAR 7=BBAR 6=SBAR 8=DBAR
 
2371
         DO 25 I=1,8
 
2372
  25     F(I,N,M)=F(I,N,M)/(1.D0-XX(N))**N0(I)
 
2373
  20  CONTINUE
 
2374
      CALL MRSCHECK(F(1,1,1),13)
 
2375
      DO 31 J=1,NTENTH-1
 
2376
      XX(J)=DLOG10(XX(J))+1.1D0
 
2377
      DO 31 I=1,8
 
2378
      IF(I.EQ.7) GO TO 31
 
2379
      DO 30 K=1,19
 
2380
  30  F(I,J,K)=DLOG(F(I,J,K))*F(I,ntenth,K)/DLOG(F(I,ntenth,K))
 
2381
  31  CONTINUE
 
2382
  50  FORMAT(8F10.5)
 
2383
      DO 40 I=1,8
 
2384
      DO 40 M=1,19
 
2385
  40  F(I,nx,M)=0.D0
 
2386
  10  CONTINUE
 
2387
      IF(X.LT.XMIN) X=XMIN
 
2388
      IF(X.GT.XMAX) X=XMAX
 
2389
      QSQ=SCALE**2
 
2390
      IF(QSQ.LT.QSQMIN) QSQ=QSQMIN
 
2391
      IF(QSQ.GT.QSQMAX) QSQ=QSQMAX
 
2392
      XXX=X
 
2393
      IF(X.LT.1.D-1) XXX=DLOG10(X)+1.1D0
 
2394
      N=0
 
2395
  70  N=N+1
 
2396
      IF(XXX.GT.XX(N+1)) GOTO 70
 
2397
      A=(XXX-XX(N))/(XX(N+1)-XX(N))
 
2398
      RM=DLOG(QSQ/QSQMIN)/DLOG(2.D0)
 
2399
      B=RM-DINT(RM)
 
2400
      M=1+IDINT(RM)
 
2401
      DO 60 I=1,8
 
2402
      G(I)= (1.D0-A)*(1.D0-B)*F(I,N,M)+(1.D0-A)*B*F(I,N,M+1)
 
2403
     .    + A*(1.D0-B)*F(I,N+1,M)  + A*B*F(I,N+1,M+1)
 
2404
      IF(N.GE.ntenth) GOTO 65
 
2405
      IF(I.EQ.7) GOTO 65
 
2406
          FAC=(1.D0-B)*F(I,ntenth,M)+B*F(I,ntenth,M+1)
 
2407
          G(I)=FAC**(G(I)/FAC)
 
2408
  65  CONTINUE
 
2409
      G(I)=G(I)*(1.D0-X)**N0(I)
 
2410
  60  CONTINUE
 
2411
      UPV=G(1)
 
2412
      DNV=G(2)
 
2413
      USEA=G(4)
 
2414
      DSEA=G(8)
 
2415
      STR=G(6)
 
2416
      CHM=G(5)
 
2417
      GLU=G(3)
 
2418
      BOT=G(7)
 
2419
 
 
2420
      x=xsave
 
2421
 
 
2422
      RETURN
 
2423
      END
 
2424
C
 
2425
 
 
2426
      SUBROUTINE STRC110(X,SCALE,UPV,DNV,USEA,DSEA,STR,CHM,BOT,GLU)
 
2427
 
 
2428
C     THIS IS THE alphas=0.110 FIT -- May 1995 -- standard Q^2 range
 
2429
 
 
2430
      IMPLICIT REAL*8(A-H,O-Z)
 
2431
      parameter(nx=47)
 
2432
      parameter(ntenth=21)
 
2433
      DIMENSION F(8,NX,20),G(8),XX(NX),N0(8)
 
2434
      DATA XX/1.d-5,2.d-5,4.d-5,6.d-5,8.d-5,
 
2435
     .        1.D-4,2.D-4,4.D-4,6.D-4,8.D-4,
 
2436
     .        1.D-3,2.D-3,4.D-3,6.D-3,8.D-3,
 
2437
     .        1.D-2,2.D-2,4.D-2,6.D-2,8.D-2,
 
2438
     .     .1D0,.125D0,.15D0,.175D0,.2D0,.225D0,.25D0,.275D0,
 
2439
     .     .3D0,.325D0,.35D0,.375D0,.4D0,.425D0,.45D0,.475D0,
 
2440
     .     .5D0,.525D0,.55D0,.575D0,.6D0,.65D0,.7D0,.75D0,
 
2441
     .     .8D0,.9D0,1.D0/
 
2442
      DATA XMIN,XMAX,QSQMIN,QSQMAX/1.D-5,1.D0,5.D0,1310720.D0/
 
2443
      DATA N0/2,5,5,9,0,0,9,9/
 
2444
      DATA INIT/0/
 
2445
 
 
2446
 
 
2447
      xsave=x
 
2448
 
 
2449
      IF(INIT.NE.0) GOTO 10
 
2450
      INIT=1
 
2451
      DO 20 N=1,nx-1
 
2452
      DO 20 M=1,19
 
2453
      READ(60,50)F(1,N,M),F(2,N,M),F(3,N,M),F(4,N,M),F(5,N,M),F(7,N,M),
 
2454
     .          F(6,N,M),F(8,N,M)
 
2455
C 1=UV 2=DV 3=GLUE 4=UBAR 5=CBAR 7=BBAR 6=SBAR 8=DBAR
 
2456
         DO 25 I=1,8
 
2457
  25     F(I,N,M)=F(I,N,M)/(1.D0-XX(N))**N0(I)
 
2458
  20  CONTINUE
 
2459
      CALL MRSCHECK(F(1,1,1),14)
 
2460
      DO 31 J=1,NTENTH-1
 
2461
      XX(J)=DLOG10(XX(J))+1.1D0
 
2462
      DO 31 I=1,8
 
2463
      IF(I.EQ.7) GO TO 31
 
2464
      DO 30 K=1,19
 
2465
  30  F(I,J,K)=DLOG(F(I,J,K))*F(I,ntenth,K)/DLOG(F(I,ntenth,K))
 
2466
  31  CONTINUE
 
2467
  50  FORMAT(8F10.5)
 
2468
      DO 40 I=1,8
 
2469
      DO 40 M=1,19
 
2470
  40  F(I,nx,M)=0.D0
 
2471
  10  CONTINUE
 
2472
      IF(X.LT.XMIN) X=XMIN
 
2473
      IF(X.GT.XMAX) X=XMAX
 
2474
      QSQ=SCALE**2
 
2475
      IF(QSQ.LT.QSQMIN) QSQ=QSQMIN
 
2476
      IF(QSQ.GT.QSQMAX) QSQ=QSQMAX
 
2477
      XXX=X
 
2478
      IF(X.LT.1.D-1) XXX=DLOG10(X)+1.1D0
 
2479
      N=0
 
2480
  70  N=N+1
 
2481
      IF(XXX.GT.XX(N+1)) GOTO 70
 
2482
      A=(XXX-XX(N))/(XX(N+1)-XX(N))
 
2483
      RM=DLOG(QSQ/QSQMIN)/DLOG(2.D0)
 
2484
      B=RM-DINT(RM)
 
2485
      M=1+IDINT(RM)
 
2486
      DO 60 I=1,8
 
2487
      G(I)= (1.D0-A)*(1.D0-B)*F(I,N,M)+(1.D0-A)*B*F(I,N,M+1)
 
2488
     .    + A*(1.D0-B)*F(I,N+1,M)  + A*B*F(I,N+1,M+1)
 
2489
      IF(N.GE.ntenth) GOTO 65
 
2490
      IF(I.EQ.7) GOTO 65
 
2491
          FAC=(1.D0-B)*F(I,ntenth,M)+B*F(I,ntenth,M+1)
 
2492
          G(I)=FAC**(G(I)/FAC)
 
2493
  65  CONTINUE
 
2494
      G(I)=G(I)*(1.D0-X)**N0(I)
 
2495
  60  CONTINUE
 
2496
      UPV=G(1)
 
2497
      DNV=G(2)
 
2498
      USEA=G(4)
 
2499
      DSEA=G(8)
 
2500
      STR=G(6)
 
2501
      CHM=G(5)
 
2502
      GLU=G(3)
 
2503
      BOT=G(7)
 
2504
 
 
2505
      x=xsave
 
2506
 
 
2507
      RETURN
 
2508
      END
 
2509
C
 
2510
      SUBROUTINE STRC115(X,SCALE,UPV,DNV,USEA,DSEA,STR,CHM,BOT,GLU)
 
2511
 
 
2512
C     THIS IS THE alphas=0.115 FIT -- May 1995 -- standard Q^2 range
 
2513
 
 
2514
      IMPLICIT REAL*8(A-H,O-Z)
 
2515
      parameter(nx=47)
 
2516
      parameter(ntenth=21)
 
2517
      DIMENSION F(8,NX,20),G(8),XX(NX),N0(8)
 
2518
      DATA XX/1.d-5,2.d-5,4.d-5,6.d-5,8.d-5,
 
2519
     .        1.D-4,2.D-4,4.D-4,6.D-4,8.D-4,
 
2520
     .        1.D-3,2.D-3,4.D-3,6.D-3,8.D-3,
 
2521
     .        1.D-2,2.D-2,4.D-2,6.D-2,8.D-2,
 
2522
     .     .1D0,.125D0,.15D0,.175D0,.2D0,.225D0,.25D0,.275D0,
 
2523
     .     .3D0,.325D0,.35D0,.375D0,.4D0,.425D0,.45D0,.475D0,
 
2524
     .     .5D0,.525D0,.55D0,.575D0,.6D0,.65D0,.7D0,.75D0,
 
2525
     .     .8D0,.9D0,1.D0/
 
2526
      DATA XMIN,XMAX,QSQMIN,QSQMAX/1.D-5,1.D0,5.D0,1310720.D0/
 
2527
      DATA N0/2,5,5,9,0,0,9,9/
 
2528
      DATA INIT/0/
 
2529
 
 
2530
 
 
2531
      xsave=x
 
2532
 
 
2533
      IF(INIT.NE.0) GOTO 10
 
2534
      INIT=1
 
2535
      DO 20 N=1,nx-1
 
2536
      DO 20 M=1,19
 
2537
      READ(65,50)F(1,N,M),F(2,N,M),F(3,N,M),F(4,N,M),F(5,N,M),F(7,N,M),
 
2538
     .          F(6,N,M),F(8,N,M)
 
2539
C 1=UV 2=DV 3=GLUE 4=UBAR 5=CBAR 7=BBAR 6=SBAR 8=DBAR
 
2540
         DO 25 I=1,8
 
2541
  25     F(I,N,M)=F(I,N,M)/(1.D0-XX(N))**N0(I)
 
2542
  20  CONTINUE
 
2543
      CALL MRSCHECK(F(1,1,1),15)
 
2544
      DO 31 J=1,NTENTH-1
 
2545
      XX(J)=DLOG10(XX(J))+1.1D0
 
2546
      DO 31 I=1,8
 
2547
      IF(I.EQ.7) GO TO 31
 
2548
      DO 30 K=1,19
 
2549
  30  F(I,J,K)=DLOG(F(I,J,K))*F(I,ntenth,K)/DLOG(F(I,ntenth,K))
 
2550
  31  CONTINUE
 
2551
  50  FORMAT(8F10.5)
 
2552
      DO 40 I=1,8
 
2553
      DO 40 M=1,19
 
2554
  40  F(I,nx,M)=0.D0
 
2555
  10  CONTINUE
 
2556
      IF(X.LT.XMIN) X=XMIN
 
2557
      IF(X.GT.XMAX) X=XMAX
 
2558
      QSQ=SCALE**2
 
2559
      IF(QSQ.LT.QSQMIN) QSQ=QSQMIN
 
2560
      IF(QSQ.GT.QSQMAX) QSQ=QSQMAX
 
2561
      XXX=X
 
2562
      IF(X.LT.1.D-1) XXX=DLOG10(X)+1.1D0
 
2563
      N=0
 
2564
  70  N=N+1
 
2565
      IF(XXX.GT.XX(N+1)) GOTO 70
 
2566
      A=(XXX-XX(N))/(XX(N+1)-XX(N))
 
2567
      RM=DLOG(QSQ/QSQMIN)/DLOG(2.D0)
 
2568
      B=RM-DINT(RM)
 
2569
      M=1+IDINT(RM)
 
2570
      DO 60 I=1,8
 
2571
      G(I)= (1.D0-A)*(1.D0-B)*F(I,N,M)+(1.D0-A)*B*F(I,N,M+1)
 
2572
     .    + A*(1.D0-B)*F(I,N+1,M)  + A*B*F(I,N+1,M+1)
 
2573
      IF(N.GE.ntenth) GOTO 65
 
2574
      IF(I.EQ.7) GOTO 65
 
2575
          FAC=(1.D0-B)*F(I,ntenth,M)+B*F(I,ntenth,M+1)
 
2576
          G(I)=FAC**(G(I)/FAC)
 
2577
  65  CONTINUE
 
2578
      G(I)=G(I)*(1.D0-X)**N0(I)
 
2579
  60  CONTINUE
 
2580
      UPV=G(1)
 
2581
      DNV=G(2)
 
2582
      USEA=G(4)
 
2583
      DSEA=G(8)
 
2584
      STR=G(6)
 
2585
      CHM=G(5)
 
2586
      GLU=G(3)
 
2587
      BOT=G(7)
 
2588
 
 
2589
      x=xsave
 
2590
 
 
2591
      RETURN
 
2592
      END
 
2593
C
 
2594
      SUBROUTINE STRC120(X,SCALE,UPV,DNV,USEA,DSEA,STR,CHM,BOT,GLU)
 
2595
 
 
2596
C     THIS IS THE alphas=0.120 FIT -- May 1995 -- standard Q^2 range
 
2597
 
 
2598
      IMPLICIT REAL*8(A-H,O-Z)
 
2599
      parameter(nx=47)
 
2600
      parameter(ntenth=21)
 
2601
      DIMENSION F(8,NX,20),G(8),XX(NX),N0(8)
 
2602
      DATA XX/1.d-5,2.d-5,4.d-5,6.d-5,8.d-5,
 
2603
     .        1.D-4,2.D-4,4.D-4,6.D-4,8.D-4,
 
2604
     .        1.D-3,2.D-3,4.D-3,6.D-3,8.D-3,
 
2605
     .        1.D-2,2.D-2,4.D-2,6.D-2,8.D-2,
 
2606
     .     .1D0,.125D0,.15D0,.175D0,.2D0,.225D0,.25D0,.275D0,
 
2607
     .     .3D0,.325D0,.35D0,.375D0,.4D0,.425D0,.45D0,.475D0,
 
2608
     .     .5D0,.525D0,.55D0,.575D0,.6D0,.65D0,.7D0,.75D0,
 
2609
     .     .8D0,.9D0,1.D0/
 
2610
      DATA XMIN,XMAX,QSQMIN,QSQMAX/1.D-5,1.D0,5.D0,1310720.D0/
 
2611
      DATA N0/2,5,5,9,0,0,9,9/
 
2612
      DATA INIT/0/
 
2613
 
 
2614
 
 
2615
      xsave=x
 
2616
 
 
2617
      IF(INIT.NE.0) GOTO 10
 
2618
      INIT=1
 
2619
      DO 20 N=1,nx-1
 
2620
      DO 20 M=1,19
 
2621
      READ(70,50)F(1,N,M),F(2,N,M),F(3,N,M),F(4,N,M),F(5,N,M),F(7,N,M),
 
2622
     .          F(6,N,M),F(8,N,M)
 
2623
C 1=UV 2=DV 3=GLUE 4=UBAR 5=CBAR 7=BBAR 6=SBAR 8=DBAR
 
2624
         DO 25 I=1,8
 
2625
  25     F(I,N,M)=F(I,N,M)/(1.D0-XX(N))**N0(I)
 
2626
  20  CONTINUE
 
2627
      CALL MRSCHECK(F(1,1,1),16)
 
2628
      DO 31 J=1,NTENTH-1
 
2629
      XX(J)=DLOG10(XX(J))+1.1D0
 
2630
      DO 31 I=1,8
 
2631
      IF(I.EQ.7) GO TO 31
 
2632
      DO 30 K=1,19
 
2633
  30  F(I,J,K)=DLOG(F(I,J,K))*F(I,ntenth,K)/DLOG(F(I,ntenth,K))
 
2634
  31  CONTINUE
 
2635
  50  FORMAT(8F10.5)
 
2636
      DO 40 I=1,8
 
2637
      DO 40 M=1,19
 
2638
  40  F(I,nx,M)=0.D0
 
2639
  10  CONTINUE
 
2640
      IF(X.LT.XMIN) X=XMIN
 
2641
      IF(X.GT.XMAX) X=XMAX
 
2642
      QSQ=SCALE**2
 
2643
      IF(QSQ.LT.QSQMIN) QSQ=QSQMIN
 
2644
      IF(QSQ.GT.QSQMAX) QSQ=QSQMAX
 
2645
      XXX=X
 
2646
      IF(X.LT.1.D-1) XXX=DLOG10(X)+1.1D0
 
2647
      N=0
 
2648
  70  N=N+1
 
2649
      IF(XXX.GT.XX(N+1)) GOTO 70
 
2650
      A=(XXX-XX(N))/(XX(N+1)-XX(N))
 
2651
      RM=DLOG(QSQ/QSQMIN)/DLOG(2.D0)
 
2652
      B=RM-DINT(RM)
 
2653
      M=1+IDINT(RM)
 
2654
      DO 60 I=1,8
 
2655
      G(I)= (1.D0-A)*(1.D0-B)*F(I,N,M)+(1.D0-A)*B*F(I,N,M+1)
 
2656
     .    + A*(1.D0-B)*F(I,N+1,M)  + A*B*F(I,N+1,M+1)
 
2657
      IF(N.GE.ntenth) GOTO 65
 
2658
      IF(I.EQ.7) GOTO 65
 
2659
          FAC=(1.D0-B)*F(I,ntenth,M)+B*F(I,ntenth,M+1)
 
2660
          G(I)=FAC**(G(I)/FAC)
 
2661
  65  CONTINUE
 
2662
      G(I)=G(I)*(1.D0-X)**N0(I)
 
2663
  60  CONTINUE
 
2664
      UPV=G(1)
 
2665
      DNV=G(2)
 
2666
      USEA=G(4)
 
2667
      DSEA=G(8)
 
2668
      STR=G(6)
 
2669
      CHM=G(5)
 
2670
      GLU=G(3)
 
2671
      BOT=G(7)
 
2672
 
 
2673
      x=xsave
 
2674
 
 
2675
      RETURN
 
2676
      END
 
2677
C
 
2678
      SUBROUTINE STRC125(X,SCALE,UPV,DNV,USEA,DSEA,STR,CHM,BOT,GLU)
 
2679
 
 
2680
C     THIS IS THE alphas=0.125 FIT -- May 1995 -- standard Q^2 range
 
2681
 
 
2682
      IMPLICIT REAL*8(A-H,O-Z)
 
2683
      parameter(nx=47)
 
2684
      parameter(ntenth=21)
 
2685
      DIMENSION F(8,NX,20),G(8),XX(NX),N0(8)
 
2686
      DATA XX/1.d-5,2.d-5,4.d-5,6.d-5,8.d-5,
 
2687
     .        1.D-4,2.D-4,4.D-4,6.D-4,8.D-4,
 
2688
     .        1.D-3,2.D-3,4.D-3,6.D-3,8.D-3,
 
2689
     .        1.D-2,2.D-2,4.D-2,6.D-2,8.D-2,
 
2690
     .     .1D0,.125D0,.15D0,.175D0,.2D0,.225D0,.25D0,.275D0,
 
2691
     .     .3D0,.325D0,.35D0,.375D0,.4D0,.425D0,.45D0,.475D0,
 
2692
     .     .5D0,.525D0,.55D0,.575D0,.6D0,.65D0,.7D0,.75D0,
 
2693
     .     .8D0,.9D0,1.D0/
 
2694
      DATA XMIN,XMAX,QSQMIN,QSQMAX/1.D-5,1.D0,5.D0,1310720.D0/
 
2695
      DATA N0/2,5,5,9,0,0,9,9/
 
2696
      DATA INIT/0/
 
2697
 
 
2698
 
 
2699
      xsave=x
 
2700
 
 
2701
      IF(INIT.NE.0) GOTO 10
 
2702
      INIT=1
 
2703
      DO 20 N=1,nx-1
 
2704
      DO 20 M=1,19
 
2705
      READ(75,50)F(1,N,M),F(2,N,M),F(3,N,M),F(4,N,M),F(5,N,M),F(7,N,M),
 
2706
     .          F(6,N,M),F(8,N,M)
 
2707
C 1=UV 2=DV 3=GLUE 4=UBAR 5=CBAR 7=BBAR 6=SBAR 8=DBAR
 
2708
         DO 25 I=1,8
 
2709
  25     F(I,N,M)=F(I,N,M)/(1.D0-XX(N))**N0(I)
 
2710
  20  CONTINUE
 
2711
      CALL MRSCHECK(F(1,1,1),17)
 
2712
      DO 31 J=1,NTENTH-1
 
2713
      XX(J)=DLOG10(XX(J))+1.1D0
 
2714
      DO 31 I=1,8
 
2715
      IF(I.EQ.7) GO TO 31
 
2716
      DO 30 K=1,19
 
2717
  30  F(I,J,K)=DLOG(F(I,J,K))*F(I,ntenth,K)/DLOG(F(I,ntenth,K))
 
2718
  31  CONTINUE
 
2719
  50  FORMAT(8F10.5)
 
2720
      DO 40 I=1,8
 
2721
      DO 40 M=1,19
 
2722
  40  F(I,nx,M)=0.D0
 
2723
  10  CONTINUE
 
2724
      IF(X.LT.XMIN) X=XMIN
 
2725
      IF(X.GT.XMAX) X=XMAX
 
2726
      QSQ=SCALE**2
 
2727
      IF(QSQ.LT.QSQMIN) QSQ=QSQMIN
 
2728
      IF(QSQ.GT.QSQMAX) QSQ=QSQMAX
 
2729
      XXX=X
 
2730
      IF(X.LT.1.D-1) XXX=DLOG10(X)+1.1D0
 
2731
      N=0
 
2732
  70  N=N+1
 
2733
      IF(XXX.GT.XX(N+1)) GOTO 70
 
2734
      A=(XXX-XX(N))/(XX(N+1)-XX(N))
 
2735
      RM=DLOG(QSQ/QSQMIN)/DLOG(2.D0)
 
2736
      B=RM-DINT(RM)
 
2737
      M=1+IDINT(RM)
 
2738
      DO 60 I=1,8
 
2739
      G(I)= (1.D0-A)*(1.D0-B)*F(I,N,M)+(1.D0-A)*B*F(I,N,M+1)
 
2740
     .    + A*(1.D0-B)*F(I,N+1,M)  + A*B*F(I,N+1,M+1)
 
2741
      IF(N.GE.ntenth) GOTO 65
 
2742
      IF(I.EQ.7) GOTO 65
 
2743
          FAC=(1.D0-B)*F(I,ntenth,M)+B*F(I,ntenth,M+1)
 
2744
          G(I)=FAC**(G(I)/FAC)
 
2745
  65  CONTINUE
 
2746
      G(I)=G(I)*(1.D0-X)**N0(I)
 
2747
  60  CONTINUE
 
2748
      UPV=G(1)
 
2749
      DNV=G(2)
 
2750
      USEA=G(4)
 
2751
      DSEA=G(8)
 
2752
      STR=G(6)
 
2753
      CHM=G(5)
 
2754
      GLU=G(3)
 
2755
      BOT=G(7)
 
2756
 
 
2757
      x=xsave
 
2758
 
 
2759
      RETURN
 
2760
      END
 
2761
C
 
2762
      SUBROUTINE STRC130(X,SCALE,UPV,DNV,USEA,DSEA,STR,CHM,BOT,GLU)
 
2763
 
 
2764
C     THIS IS THE alphas=0.130 FIT -- May 1995 -- standard Q^2 range
 
2765
 
 
2766
      IMPLICIT REAL*8(A-H,O-Z)
 
2767
      parameter(nx=47)
 
2768
      parameter(ntenth=21)
 
2769
      DIMENSION F(8,NX,20),G(8),XX(NX),N0(8)
 
2770
      DATA XX/1.d-5,2.d-5,4.d-5,6.d-5,8.d-5,
 
2771
     .        1.D-4,2.D-4,4.D-4,6.D-4,8.D-4,
 
2772
     .        1.D-3,2.D-3,4.D-3,6.D-3,8.D-3,
 
2773
     .        1.D-2,2.D-2,4.D-2,6.D-2,8.D-2,
 
2774
     .     .1D0,.125D0,.15D0,.175D0,.2D0,.225D0,.25D0,.275D0,
 
2775
     .     .3D0,.325D0,.35D0,.375D0,.4D0,.425D0,.45D0,.475D0,
 
2776
     .     .5D0,.525D0,.55D0,.575D0,.6D0,.65D0,.7D0,.75D0,
 
2777
     .     .8D0,.9D0,1.D0/
 
2778
      DATA XMIN,XMAX,QSQMIN,QSQMAX/1.D-5,1.D0,5.D0,1310720.D0/
 
2779
      DATA N0/2,5,5,9,0,0,9,9/
 
2780
      DATA INIT/0/
 
2781
 
 
2782
 
 
2783
      xsave=x
 
2784
 
 
2785
      IF(INIT.NE.0) GOTO 10
 
2786
      INIT=1
 
2787
      DO 20 N=1,nx-1
 
2788
      DO 20 M=1,19
 
2789
      READ(80,50)F(1,N,M),F(2,N,M),F(3,N,M),F(4,N,M),F(5,N,M),F(7,N,M),
 
2790
     .          F(6,N,M),F(8,N,M)
 
2791
C 1=UV 2=DV 3=GLUE 4=UBAR 5=CBAR 7=BBAR 6=SBAR 8=DBAR
 
2792
         DO 25 I=1,8
 
2793
  25     F(I,N,M)=F(I,N,M)/(1.D0-XX(N))**N0(I)
 
2794
  20  CONTINUE
 
2795
      CALL MRSCHECK(F(1,1,1),18)
 
2796
      DO 31 J=1,NTENTH-1
 
2797
      XX(J)=DLOG10(XX(J))+1.1D0
 
2798
      DO 31 I=1,8
 
2799
      IF(I.EQ.7) GO TO 31
 
2800
      DO 30 K=1,19
 
2801
  30  F(I,J,K)=DLOG(F(I,J,K))*F(I,ntenth,K)/DLOG(F(I,ntenth,K))
 
2802
  31  CONTINUE
 
2803
  50  FORMAT(8F10.5)
 
2804
      DO 40 I=1,8
 
2805
      DO 40 M=1,19
 
2806
  40  F(I,nx,M)=0.D0
 
2807
  10  CONTINUE
 
2808
      IF(X.LT.XMIN) X=XMIN
 
2809
      IF(X.GT.XMAX) X=XMAX
 
2810
      QSQ=SCALE**2
 
2811
      IF(QSQ.LT.QSQMIN) QSQ=QSQMIN
 
2812
      IF(QSQ.GT.QSQMAX) QSQ=QSQMAX
 
2813
      XXX=X
 
2814
      IF(X.LT.1.D-1) XXX=DLOG10(X)+1.1D0
 
2815
      N=0
 
2816
  70  N=N+1
 
2817
      IF(XXX.GT.XX(N+1)) GOTO 70
 
2818
      A=(XXX-XX(N))/(XX(N+1)-XX(N))
 
2819
      RM=DLOG(QSQ/QSQMIN)/DLOG(2.D0)
 
2820
      B=RM-DINT(RM)
 
2821
      M=1+IDINT(RM)
 
2822
      DO 60 I=1,8
 
2823
      G(I)= (1.D0-A)*(1.D0-B)*F(I,N,M)+(1.D0-A)*B*F(I,N,M+1)
 
2824
     .    + A*(1.D0-B)*F(I,N+1,M)  + A*B*F(I,N+1,M+1)
 
2825
      IF(N.GE.ntenth) GOTO 65
 
2826
      IF(I.EQ.7) GOTO 65
 
2827
          FAC=(1.D0-B)*F(I,ntenth,M)+B*F(I,ntenth,M+1)
 
2828
          G(I)=FAC**(G(I)/FAC)
 
2829
  65  CONTINUE
 
2830
      G(I)=G(I)*(1.D0-X)**N0(I)
 
2831
  60  CONTINUE
 
2832
      UPV=G(1)
 
2833
      DNV=G(2)
 
2834
      USEA=G(4)
 
2835
      DSEA=G(8)
 
2836
      STR=G(6)
 
2837
      CHM=G(5)
 
2838
      GLU=G(3)
 
2839
      BOT=G(7)
 
2840
 
 
2841
      x=xsave
 
2842
 
 
2843
      RETURN
 
2844
      END
 
2845
C
 
2846
      subroutine mrs96(x,q,mode,upv,dnv,usea,dsea,str,chm,bot,glu)
 
2847
C***************************************************************C
 
2848
C                                                               C
 
2849
C     This is a package for the new MRS(R1,R2,R3,R4) parton     C
 
2850
C     distributions. There are several important changes from   C
 
2851
C     earlier MRS packages:                                     C
 
2852
C       -- the q**2 range is enlarged to 1.25d0 < q**2 < 1d7,   C
 
2853
C          the x range is still 1d-5 < x < 1d0                  C
 
2854
C       -- the interpolation routine has been slightly modified C
 
2855
C       -- the call is now to mrs96() rather than to MRSEB()    C 
 
2856
C     Note that the grid files which the program reads in       C
 
2857
C     (mrsr1.dat,...) are now larger and more obviously named.  C
 
2858
C                                                               C
 
2859
C     As before, x times the parton distribution is returned,   C
 
2860
C     q is the scale in GeV, MSbar factorization is assumed,    C
 
2861
C     and Lambda(MSbar,nf=4) = 241 MeV for R1 (mode=1)          C
 
2862
C                            = 344 MeV for R2 (mode=2)          C
 
2863
C                            = 241 MeV for R3 (mode=3)          C
 
2864
C                            = 344 MeV for R4 (mode=4)          C
 
2865
C                                                               C
 
2866
C         The reference is:                                     C
 
2867
C         A.D. Martin, R.G. Roberts and W.J. Stirling,          C
 
2868
C         University of Durham preprint DTP/96/44 (1996)        C
 
2869
C                                                               C
 
2870
C         Comments to : W.J.Stirling@durham.ac.uk               C
 
2871
C                                                               C
 
2872
C             >>>>>>>>  CROSS CHECK  <<<<<<<<                   C
 
2873
C                                                               C
 
2874
C         THE FIRST NUMBER IN THE R1 GRID IS 0.00150            C
 
2875
C         THE FIRST NUMBER IN THE R2 GRID IS 0.00125            C
 
2876
C         THE FIRST NUMBER IN THE R3 GRID IS 0.00181            C
 
2877
C         THE FIRST NUMBER IN THE R4 GRID IS 0.00085            C
 
2878
C                                                               C
 
2879
C***************************************************************C
 
2880
      implicit real*8(a-h,o-z)
 
2881
      data xmin,xmax,qsqmin,qsqmax/1d-5,1d0,1.25d0,1d7/
 
2882
      q2=q*q
 
2883
      if(mode.eq.1) then
 
2884
        call mrsr1(x,q2,upv,dnv,usea,dsea,str,chm,bot,glu) 
 
2885
      elseif(mode.eq.2) then
 
2886
        call mrsr2(x,q2,upv,dnv,usea,dsea,str,chm,bot,glu) 
 
2887
      elseif(mode.eq.3) then
 
2888
        call mrsr3(x,q2,upv,dnv,usea,dsea,str,chm,bot,glu) 
 
2889
      elseif(mode.eq.4) then
 
2890
        call mrsr4(x,q2,upv,dnv,usea,dsea,str,chm,bot,glu)
 
2891
      endif 
 
2892
      return
 
2893
      end
 
2894
 
 
2895
      subroutine mrsr1(x,qsq,upv,dnv,usea,dsea,str,chm,bot,glu)
 
2896
      implicit real*8(a-h,o-z)
 
2897
      parameter(nx=49,nq=37,ntenth=23,np=8)
 
2898
      real*8 f(np,nx,nq+1),qq(nq),xx(nx),g(np),n0(np)
 
2899
      data xx/1d-5,2d-5,4d-5,6d-5,8d-5,
 
2900
     .        1d-4,2d-4,4d-4,6d-4,8d-4,
 
2901
     .        1d-3,2d-3,4d-3,6d-3,8d-3,
 
2902
     .        1d-2,1.4d-2,2d-2,3d-2,4d-2,6d-2,8d-2,
 
2903
     .     .1d0,.125d0,.15d0,.175d0,.2d0,.225d0,.25d0,.275d0,
 
2904
     .     .3d0,.325d0,.35d0,.375d0,.4d0,.425d0,.45d0,.475d0,
 
2905
     .     .5d0,.525d0,.55d0,.575d0,.6d0,.65d0,.7d0,.75d0,
 
2906
     .     .8d0,.9d0,1d0/
 
2907
      data qq/1.25d0,1.5d0,2d0,2.5d0,3.2d0,4d0,5d0,6.4d0,8d0,1d1,
 
2908
     .        1.2d1,1.8d1,2.6d1,4d1,6.4d1,1d2,
 
2909
     .        1.6d2,2.4d2,4d2,6.4d2,1d3,1.8d3,3.2d3,5.6d3,1d4,
 
2910
     .        1.8d4,3.2d4,5.6d4,1d5,1.8d5,3.2d5,5.6d5,1d6,
 
2911
     .        1.8d6,3.2d6,5.6d6,1d7/
 
2912
      data xmin,xmax,qsqmin,qsqmax/1d-5,1d0,1.25d0,1d7/
 
2913
      data n0/3,4,5,9,9,9,9,9/
 
2914
      data init/0/
 
2915
      save 
 
2916
      xsave=x
 
2917
      q2save=qsq
 
2918
      if(init.ne.0) goto 10
 
2919
        open(unit=1,file='MRSR1',status='old')
 
2920
        do 20 n=1,nx-1
 
2921
        do 20 m=1,nq
 
2922
        read(1,50)f(1,n,m),f(2,n,m),f(3,n,m),f(4,n,m),
 
2923
     .            f(5,n,m),f(7,n,m),f(6,n,m),f(8,n,m)
 
2924
c notation: 1=uval 2=val 3=glue 4=usea 5=chm 6=str 7=btm 8=dsea
 
2925
        do 25 i=1,np
 
2926
  25     f(i,n,m)=f(i,n,m)/(1d0-xx(n))**n0(i)
 
2927
  20  continue
 
2928
      call mrscheck(f(1,1,1),21)
 
2929
      do 31 j=1,ntenth-1
 
2930
      xx(j)=dlog10(xx(j)/xx(ntenth))+xx(ntenth)
 
2931
      do 31 i=1,8
 
2932
      if(i.eq.5.or.i.eq.7) goto 31
 
2933
      do 30 k=1,nq
 
2934
  30  f(i,j,k)=dlog10(f(i,j,k)/f(i,ntenth,k))+f(i,ntenth,k)
 
2935
  31  continue
 
2936
  50  format(8f10.5)
 
2937
      do 40 i=1,np
 
2938
      do 40 m=1,nq
 
2939
  40  f(i,nx,m)=0d0
 
2940
      init=1
 
2941
      close(1)
 
2942
  10  continue                       
 
2943
      if(x.lt.xmin) x=xmin
 
2944
      if(x.gt.xmax) x=xmax
 
2945
      if(qsq.lt.qsqmin) qsq=qsqmin
 
2946
      if(qsq.gt.qsqmax) qsq=qsqmax
 
2947
      xxx=x
 
2948
      if(x.lt.xx(ntenth)) xxx=dlog10(x/xx(ntenth))+xx(ntenth)
 
2949
      n=0
 
2950
  70  n=n+1
 
2951
      if(xxx.gt.xx(n+1)) goto 70
 
2952
      a=(xxx-xx(n))/(xx(n+1)-xx(n))
 
2953
      m=0
 
2954
  80  m=m+1
 
2955
      if(qsq.gt.qq(m+1)) goto 80
 
2956
      b=(qsq-qq(m))/(qq(m+1)-qq(m))
 
2957
      do 60 i=1,np
 
2958
      g(i)= (1d0-a)*(1d0-b)*f(i,n,m)   + (1d0-a)*b*f(i,n,m+1)
 
2959
     .    +       a*(1d0-b)*f(i,n+1,m) +       a*b*f(i,n+1,m+1)
 
2960
      if(n.ge.ntenth) goto 65
 
2961
      if(i.eq.5.or.i.eq.7) goto 65
 
2962
          fac=(1d0-b)*f(i,ntenth,m)+b*f(i,ntenth,m+1)
 
2963
          g(i)=fac*10d0**(g(i)-fac)
 
2964
  65  continue
 
2965
      g(i)=g(i)*(1d0-x)**n0(i)
 
2966
  60  continue
 
2967
      upv=g(1)
 
2968
      dnv=g(2)
 
2969
      usea=g(4)
 
2970
      dsea=g(8)
 
2971
      str=g(6)
 
2972
      chm=g(5)
 
2973
      glu=g(3) 
 
2974
      bot=g(7)
 
2975
        x=xsave
 
2976
        qsq=q2save
 
2977
      return
 
2978
      end
 
2979
      
 
2980
      subroutine mrsr2(x,qsq,upv,dnv,usea,dsea,str,chm,bot,glu)
 
2981
      implicit real*8(a-h,o-z)
 
2982
      parameter(nx=49,nq=37,ntenth=23,np=8)
 
2983
      real*8 f(np,nx,nq+1),qq(nq),xx(nx),g(np),n0(np)
 
2984
      data xx/1d-5,2d-5,4d-5,6d-5,8d-5,
 
2985
     .        1d-4,2d-4,4d-4,6d-4,8d-4,
 
2986
     .        1d-3,2d-3,4d-3,6d-3,8d-3,
 
2987
     .        1d-2,1.4d-2,2d-2,3d-2,4d-2,6d-2,8d-2,
 
2988
     .     .1d0,.125d0,.15d0,.175d0,.2d0,.225d0,.25d0,.275d0,
 
2989
     .     .3d0,.325d0,.35d0,.375d0,.4d0,.425d0,.45d0,.475d0,
 
2990
     .     .5d0,.525d0,.55d0,.575d0,.6d0,.65d0,.7d0,.75d0,
 
2991
     .     .8d0,.9d0,1d0/
 
2992
      data qq/1.25d0,1.5d0,2d0,2.5d0,3.2d0,4d0,5d0,6.4d0,8d0,1d1,
 
2993
     .        1.2d1,1.8d1,2.6d1,4d1,6.4d1,1d2,
 
2994
     .        1.6d2,2.4d2,4d2,6.4d2,1d3,1.8d3,3.2d3,5.6d3,1d4,
 
2995
     .        1.8d4,3.2d4,5.6d4,1d5,1.8d5,3.2d5,5.6d5,1d6,
 
2996
     .        1.8d6,3.2d6,5.6d6,1d7/
 
2997
      data xmin,xmax,qsqmin,qsqmax/1d-5,1d0,1.25d0,1d7/
 
2998
      data n0/3,4,5,9,9,9,9,9/
 
2999
      data init/0/
 
3000
      save   
 
3001
      xsave=x
 
3002
      q2save=qsq
 
3003
      if(init.ne.0) goto 10
 
3004
        open(unit=1,file='MRSR2',status='old')
 
3005
        do 20 n=1,nx-1
 
3006
        do 20 m=1,nq
 
3007
        read(1,50)f(1,n,m),f(2,n,m),f(3,n,m),f(4,n,m),
 
3008
     .            f(5,n,m),f(7,n,m),f(6,n,m),f(8,n,m)
 
3009
c notation: 1=uval 2=val 3=glue 4=usea 5=chm 6=str 7=btm 8=dsea
 
3010
        do 25 i=1,np
 
3011
  25     f(i,n,m)=f(i,n,m)/(1d0-xx(n))**n0(i)
 
3012
  20  continue
 
3013
      call mrscheck(f(1,1,1),22)
 
3014
      do 31 j=1,ntenth-1
 
3015
      xx(j)=dlog10(xx(j)/xx(ntenth))+xx(ntenth)
 
3016
      do 31 i=1,8
 
3017
      if(i.eq.5.or.i.eq.7) goto 31
 
3018
      do 30 k=1,nq
 
3019
  30  f(i,j,k)=dlog10(f(i,j,k)/f(i,ntenth,k))+f(i,ntenth,k)
 
3020
  31  continue
 
3021
  50  format(8f10.5)
 
3022
      do 40 i=1,np
 
3023
      do 40 m=1,nq
 
3024
  40  f(i,nx,m)=0d0
 
3025
      init=1
 
3026
      close(1)
 
3027
  10  continue
 
3028
      if(x.lt.xmin) x=xmin
 
3029
      if(x.gt.xmax) x=xmax
 
3030
      if(qsq.lt.qsqmin) qsq=qsqmin
 
3031
      if(qsq.gt.qsqmax) qsq=qsqmax
 
3032
      xxx=x
 
3033
      if(x.lt.xx(ntenth)) xxx=dlog10(x/xx(ntenth))+xx(ntenth)
 
3034
      n=0
 
3035
  70  n=n+1
 
3036
      if(xxx.gt.xx(n+1)) goto 70
 
3037
      a=(xxx-xx(n))/(xx(n+1)-xx(n))
 
3038
      m=0
 
3039
  80  m=m+1
 
3040
      if(qsq.gt.qq(m+1)) goto 80
 
3041
      b=(qsq-qq(m))/(qq(m+1)-qq(m))
 
3042
      do 60 i=1,np
 
3043
      g(i)= (1d0-a)*(1d0-b)*f(i,n,m)   + (1d0-a)*b*f(i,n,m+1)
 
3044
     .    +       a*(1d0-b)*f(i,n+1,m) +       a*b*f(i,n+1,m+1)
 
3045
      if(n.ge.ntenth) goto 65
 
3046
      if(i.eq.5.or.i.eq.7) goto 65
 
3047
          fac=(1d0-b)*f(i,ntenth,m)+b*f(i,ntenth,m+1)
 
3048
          g(i)=fac*10d0**(g(i)-fac)
 
3049
  65  continue
 
3050
      g(i)=g(i)*(1d0-x)**n0(i)
 
3051
  60  continue
 
3052
      upv=g(1)
 
3053
      dnv=g(2)
 
3054
      usea=g(4)
 
3055
      dsea=g(8)
 
3056
      str=g(6)
 
3057
      chm=g(5)
 
3058
      glu=g(3) 
 
3059
      bot=g(7)
 
3060
        x=xsave
 
3061
        qsq=q2save
 
3062
      return
 
3063
      end
 
3064
      
 
3065
      subroutine mrsr3(x,qsq,upv,dnv,usea,dsea,str,chm,bot,glu)
 
3066
      implicit real*8(a-h,o-z)
 
3067
      parameter(nx=49,nq=37,ntenth=23,np=8)
 
3068
      real*8 f(np,nx,nq+1),qq(nq),xx(nx),g(np),n0(np)
 
3069
      data xx/1d-5,2d-5,4d-5,6d-5,8d-5,
 
3070
     .        1d-4,2d-4,4d-4,6d-4,8d-4,
 
3071
     .        1d-3,2d-3,4d-3,6d-3,8d-3,
 
3072
     .        1d-2,1.4d-2,2d-2,3d-2,4d-2,6d-2,8d-2,
 
3073
     .     .1d0,.125d0,.15d0,.175d0,.2d0,.225d0,.25d0,.275d0,
 
3074
     .     .3d0,.325d0,.35d0,.375d0,.4d0,.425d0,.45d0,.475d0,
 
3075
     .     .5d0,.525d0,.55d0,.575d0,.6d0,.65d0,.7d0,.75d0,
 
3076
     .     .8d0,.9d0,1d0/
 
3077
      data qq/1.25d0,1.5d0,2d0,2.5d0,3.2d0,4d0,5d0,6.4d0,8d0,1d1,
 
3078
     .        1.2d1,1.8d1,2.6d1,4d1,6.4d1,1d2,
 
3079
     .        1.6d2,2.4d2,4d2,6.4d2,1d3,1.8d3,3.2d3,5.6d3,1d4,
 
3080
     .        1.8d4,3.2d4,5.6d4,1d5,1.8d5,3.2d5,5.6d5,1d6,
 
3081
     .        1.8d6,3.2d6,5.6d6,1d7/
 
3082
      data xmin,xmax,qsqmin,qsqmax/1d-5,1d0,1.25d0,1d7/
 
3083
      data n0/3,4,5,9,9,9,9,9/
 
3084
      data init/0/
 
3085
      save   
 
3086
      xsave=x
 
3087
      q2save=qsq
 
3088
      if(init.ne.0) goto 10
 
3089
        open(unit=1,file='MRSR3',status='old')
 
3090
        do 20 n=1,nx-1
 
3091
        do 20 m=1,nq
 
3092
        read(1,50)f(1,n,m),f(2,n,m),f(3,n,m),f(4,n,m),
 
3093
     .            f(5,n,m),f(7,n,m),f(6,n,m),f(8,n,m)
 
3094
c notation: 1=uval 2=val 3=glue 4=usea 5=chm 6=str 7=btm 8=dsea
 
3095
        do 25 i=1,np
 
3096
  25     f(i,n,m)=f(i,n,m)/(1d0-xx(n))**n0(i)
 
3097
  20  continue
 
3098
      call mrscheck(f(1,1,1),23)
 
3099
      do 31 j=1,ntenth-1
 
3100
      xx(j)=dlog10(xx(j)/xx(ntenth))+xx(ntenth)
 
3101
      do 31 i=1,8
 
3102
      if(i.eq.5.or.i.eq.7) goto 31
 
3103
      do 30 k=1,nq
 
3104
  30  f(i,j,k)=dlog10(f(i,j,k)/f(i,ntenth,k))+f(i,ntenth,k)
 
3105
  31  continue
 
3106
  50  format(8f10.5)
 
3107
      do 40 i=1,np
 
3108
      do 40 m=1,nq
 
3109
  40  f(i,nx,m)=0d0
 
3110
      init=1
 
3111
      close(1)
 
3112
  10  continue
 
3113
      if(x.lt.xmin) x=xmin
 
3114
      if(x.gt.xmax) x=xmax
 
3115
      if(qsq.lt.qsqmin) qsq=qsqmin
 
3116
      if(qsq.gt.qsqmax) qsq=qsqmax
 
3117
      xxx=x
 
3118
      if(x.lt.xx(ntenth)) xxx=dlog10(x/xx(ntenth))+xx(ntenth)
 
3119
      n=0
 
3120
  70  n=n+1
 
3121
      if(xxx.gt.xx(n+1)) goto 70
 
3122
      a=(xxx-xx(n))/(xx(n+1)-xx(n))
 
3123
      m=0
 
3124
  80  m=m+1
 
3125
      if(qsq.gt.qq(m+1)) goto 80
 
3126
      b=(qsq-qq(m))/(qq(m+1)-qq(m))
 
3127
      do 60 i=1,np
 
3128
      g(i)= (1d0-a)*(1d0-b)*f(i,n,m)   + (1d0-a)*b*f(i,n,m+1)
 
3129
     .    +       a*(1d0-b)*f(i,n+1,m) +       a*b*f(i,n+1,m+1)
 
3130
      if(n.ge.ntenth) goto 65
 
3131
      if(i.eq.5.or.i.eq.7) goto 65
 
3132
          fac=(1d0-b)*f(i,ntenth,m)+b*f(i,ntenth,m+1)
 
3133
          g(i)=fac*10d0**(g(i)-fac)
 
3134
  65  continue
 
3135
      g(i)=g(i)*(1d0-x)**n0(i)
 
3136
  60  continue
 
3137
      upv=g(1)
 
3138
      dnv=g(2)
 
3139
      usea=g(4)
 
3140
      dsea=g(8)
 
3141
      str=g(6)
 
3142
      chm=g(5)
 
3143
      glu=g(3) 
 
3144
      bot=g(7)
 
3145
        x=xsave
 
3146
        qsq=q2save
 
3147
      return
 
3148
      end
 
3149
      
 
3150
      subroutine mrsr4(x,qsq,upv,dnv,usea,dsea,str,chm,bot,glu)
 
3151
      implicit real*8(a-h,o-z)
 
3152
      parameter(nx=49,nq=37,ntenth=23,np=8)
 
3153
      real*8 f(np,nx,nq+1),qq(nq),xx(nx),g(np),n0(np)
 
3154
      data xx/1d-5,2d-5,4d-5,6d-5,8d-5,
 
3155
     .        1d-4,2d-4,4d-4,6d-4,8d-4,
 
3156
     .        1d-3,2d-3,4d-3,6d-3,8d-3,
 
3157
     .        1d-2,1.4d-2,2d-2,3d-2,4d-2,6d-2,8d-2,
 
3158
     .     .1d0,.125d0,.15d0,.175d0,.2d0,.225d0,.25d0,.275d0,
 
3159
     .     .3d0,.325d0,.35d0,.375d0,.4d0,.425d0,.45d0,.475d0,
 
3160
     .     .5d0,.525d0,.55d0,.575d0,.6d0,.65d0,.7d0,.75d0,
 
3161
     .     .8d0,.9d0,1d0/
 
3162
      data qq/1.25d0,1.5d0,2d0,2.5d0,3.2d0,4d0,5d0,6.4d0,8d0,1d1,
 
3163
     .        1.2d1,1.8d1,2.6d1,4d1,6.4d1,1d2,
 
3164
     .        1.6d2,2.4d2,4d2,6.4d2,1d3,1.8d3,3.2d3,5.6d3,1d4,
 
3165
     .        1.8d4,3.2d4,5.6d4,1d5,1.8d5,3.2d5,5.6d5,1d6,
 
3166
     .        1.8d6,3.2d6,5.6d6,1d7/
 
3167
      data xmin,xmax,qsqmin,qsqmax/1d-5,1d0,1.25d0,1d7/
 
3168
      data n0/3,4,5,9,9,9,9,9/
 
3169
      data init/0/
 
3170
      save   
 
3171
      xsave=x
 
3172
      q2save=qsq
 
3173
      if(init.ne.0) goto 10
 
3174
        open(unit=1,file='MRSR4',status='old')
 
3175
        do 20 n=1,nx-1
 
3176
        do 20 m=1,nq
 
3177
        read(1,50)f(1,n,m),f(2,n,m),f(3,n,m),f(4,n,m),
 
3178
     .            f(5,n,m),f(7,n,m),f(6,n,m),f(8,n,m)
 
3179
c notation: 1=uval 2=val 3=glue 4=usea 5=chm 6=str 7=btm 8=dsea
 
3180
        do 25 i=1,np
 
3181
  25     f(i,n,m)=f(i,n,m)/(1d0-xx(n))**n0(i)
 
3182
  20  continue
 
3183
      call mrscheck(f(1,1,1),24)
 
3184
      do 31 j=1,ntenth-1
 
3185
      xx(j)=dlog10(xx(j)/xx(ntenth))+xx(ntenth)
 
3186
      do 31 i=1,8
 
3187
      if(i.eq.5.or.i.eq.7) goto 31
 
3188
      do 30 k=1,nq
 
3189
  30  f(i,j,k)=dlog10(f(i,j,k)/f(i,ntenth,k))+f(i,ntenth,k)
 
3190
  31  continue
 
3191
  50  format(8f10.5)
 
3192
      do 40 i=1,np
 
3193
      do 40 m=1,nq
 
3194
  40  f(i,nx,m)=0d0
 
3195
      init=1
 
3196
      close(1)
 
3197
  10  continue
 
3198
      if(x.lt.xmin) x=xmin
 
3199
      if(x.gt.xmax) x=xmax
 
3200
      if(qsq.lt.qsqmin) qsq=qsqmin
 
3201
      if(qsq.gt.qsqmax) qsq=qsqmax
 
3202
      xxx=x
 
3203
      if(x.lt.xx(ntenth)) xxx=dlog10(x/xx(ntenth))+xx(ntenth)
 
3204
      n=0
 
3205
  70  n=n+1
 
3206
      if(xxx.gt.xx(n+1)) goto 70
 
3207
      a=(xxx-xx(n))/(xx(n+1)-xx(n))
 
3208
      m=0
 
3209
  80  m=m+1
 
3210
      if(qsq.gt.qq(m+1)) goto 80
 
3211
      b=(qsq-qq(m))/(qq(m+1)-qq(m))
 
3212
      do 60 i=1,np
 
3213
      g(i)= (1d0-a)*(1d0-b)*f(i,n,m)   + (1d0-a)*b*f(i,n,m+1)
 
3214
     .    +       a*(1d0-b)*f(i,n+1,m) +       a*b*f(i,n+1,m+1)
 
3215
      if(n.ge.ntenth) goto 65
 
3216
      if(i.eq.5.or.i.eq.7) goto 65
 
3217
          fac=(1d0-b)*f(i,ntenth,m)+b*f(i,ntenth,m+1)
 
3218
          g(i)=fac*10d0**(g(i)-fac)
 
3219
  65  continue
 
3220
      g(i)=g(i)*(1d0-x)**n0(i)
 
3221
  60  continue
 
3222
      upv=g(1)
 
3223
      dnv=g(2)
 
3224
      usea=g(4)
 
3225
      dsea=g(8)
 
3226
      str=g(6)
 
3227
      chm=g(5)
 
3228
      glu=g(3) 
 
3229
      bot=g(7)
 
3230
        x=xsave
 
3231
        qsq=q2save
 
3232
      return
 
3233
      end
 
3234
 
 
3235
      subroutine mrs98(x,q,imode,upv,dnv,usea,dsea,str,chm,bot,glu)
 
3236
C****************************************************************C
 
3237
C                                                                C
 
3238
C     This is a package for the new MRS 1998 parton              C
 
3239
C     distributions. The format is similar to the previous       C
 
3240
C     (1996) MRS-R series.                                       C
 
3241
C                                                                C
 
3242
C     As before, x times the parton distribution is returned,    C
 
3243
C     q is the scale in GeV, MSbar factorization is assumed,     C
 
3244
C     and Lambda(MSbar,nf=4) is given below for each set.        C
 
3245
C                                                                C
 
3246
C     TEMPORARY NAMING SCHEME:                                   C
 
3247
C                                                                C
 
3248
C  mode  set    comment             L(4)/MeV  a_s(M_Z)  grid#1   C
 
3249
C  ----  ---    -------             --------  -------   ------   C
 
3250
C                                                                C
 
3251
C  1     FT08A  central gluon, a_s    300      0.1175   0.00561  C
 
3252
C  2     FT09A  higher gluon          300      0.1175   0.00510  C
 
3253
C  3     FT11A  lower gluon           300      0.1175   0.00408  C
 
3254
C  4     FT24A  lower a_s             229      0.1125   0.00586  C
 
3255
C  5     FT23A  higher a_s            383      0.1225   0.00410  C
 
3256
C                                                                C
 
3257
C                                                                C
 
3258
C      The corresponding grid files are called ft08a.dat etc.    C
 
3259
C                                                                C
 
3260
C      The reference is:                                         C
 
3261
C      A.D. Martin, R.G. Roberts, W.J. Stirling, R.S Thorne      C
 
3262
C      Univ. Durham preprint DTP/98/??, hep-ph/??????? (1998)    C
 
3263
C                                                                C
 
3264
C      Comments to : W.J.Stirling@durham.ac.uk                   C
 
3265
C                                                                C
 
3266
C                                                                C
 
3267
C****************************************************************C
 
3268
      implicit real*8(a-h,o-z)
 
3269
      data xmin,xmax,qsqmin,qsqmax/1d-5,1d0,1.25d0,1d7/
 
3270
      q2=q*q
 
3271
      mode=imode-4
 
3272
      if(mode.eq.1) then
 
3273
        call mrs981(x,q2,upv,dnv,usea,dsea,str,chm,bot,glu) 
 
3274
      elseif(mode.eq.2) then
 
3275
        call mrs982(x,q2,upv,dnv,usea,dsea,str,chm,bot,glu) 
 
3276
      elseif(mode.eq.3) then
 
3277
        call mrs983(x,q2,upv,dnv,usea,dsea,str,chm,bot,glu) 
 
3278
      elseif(mode.eq.4) then
 
3279
        call mrs984(x,q2,upv,dnv,usea,dsea,str,chm,bot,glu) 
 
3280
      elseif(mode.eq.5) then
 
3281
        call mrs985(x,q2,upv,dnv,usea,dsea,str,chm,bot,glu) 
 
3282
      endif 
 
3283
      return
 
3284
      end
 
3285
 
 
3286
      subroutine mrs981(x,qsq,upv,dnv,usea,dsea,str,chm,bot,glu)
 
3287
      implicit real*8(a-h,o-z)
 
3288
      parameter(nx=49,nq=37,ntenth=23,np=8)
 
3289
      real*8 f(np,nx,nq+1),qq(nq),xx(nx),g(np),n0(np)
 
3290
      data xx/1d-5,2d-5,4d-5,6d-5,8d-5,
 
3291
     .        1d-4,2d-4,4d-4,6d-4,8d-4,
 
3292
     .        1d-3,2d-3,4d-3,6d-3,8d-3,
 
3293
     .        1d-2,1.4d-2,2d-2,3d-2,4d-2,6d-2,8d-2,
 
3294
     .     .1d0,.125d0,.15d0,.175d0,.2d0,.225d0,.25d0,.275d0,
 
3295
     .     .3d0,.325d0,.35d0,.375d0,.4d0,.425d0,.45d0,.475d0,
 
3296
     .     .5d0,.525d0,.55d0,.575d0,.6d0,.65d0,.7d0,.75d0,
 
3297
     .     .8d0,.9d0,1d0/
 
3298
      data qq/1.25d0,1.5d0,2d0,2.5d0,3.2d0,4d0,5d0,6.4d0,8d0,1d1,
 
3299
     .        1.2d1,1.8d1,2.6d1,4d1,6.4d1,1d2,
 
3300
     .        1.6d2,2.4d2,4d2,6.4d2,1d3,1.8d3,3.2d3,5.6d3,1d4,
 
3301
     .        1.8d4,3.2d4,5.6d4,1d5,1.8d5,3.2d5,5.6d5,1d6,
 
3302
     .        1.8d6,3.2d6,5.6d6,1d7/
 
3303
      data xmin,xmax,qsqmin,qsqmax/1d-5,1d0,1.25d0,1d7/
 
3304
      data n0/3,4,5,9,9,9,9,9/
 
3305
      data init/0/
 
3306
      save
 
3307
      xsave=x
 
3308
      q2save=qsq
 
3309
      if(init.ne.0) goto 10
 
3310
        open(unit=1,file='ft08a',status='old')
 
3311
        do 20 n=1,nx-1
 
3312
        do 20 m=1,nq
 
3313
        read(1,50)f(1,n,m),f(2,n,m),f(3,n,m),f(4,n,m),
 
3314
     .            f(5,n,m),f(7,n,m),f(6,n,m),f(8,n,m)
 
3315
c notation: 1=uval 2=val 3=glue 4=usea 5=chm 6=str 7=btm 8=dsea
 
3316
        do 25 i=1,np
 
3317
  25     f(i,n,m)=f(i,n,m)/(1d0-xx(n))**n0(i)
 
3318
  20  continue
 
3319
      call mrscheck(f(1,1,1),25)
 
3320
      do 31 j=1,ntenth-1       
 
3321
      xx(j)=dlog10(xx(j)/xx(ntenth))+xx(ntenth)
 
3322
      do 31 i=1,8
 
3323
      if(i.eq.5.or.i.eq.7) goto 31
 
3324
      do 30 k=1,nq
 
3325
  30  f(i,j,k)=dlog10(f(i,j,k)/f(i,ntenth,k))+f(i,ntenth,k)
 
3326
  31  continue
 
3327
  50  format(8f10.5)
 
3328
      do 40 i=1,np
 
3329
      do 40 m=1,nq
 
3330
  40  f(i,nx,m)=0d0
 
3331
      init=1
 
3332
      close(1)
 
3333
  10  continue
 
3334
      if(x.lt.xmin) x=xmin
 
3335
      if(x.gt.xmax) x=xmax
 
3336
      if(qsq.lt.qsqmin) qsq=qsqmin
 
3337
      if(qsq.gt.qsqmax) qsq=qsqmax
 
3338
      xxx=x
 
3339
      if(x.lt.xx(ntenth)) xxx=dlog10(x/xx(ntenth))+xx(ntenth)
 
3340
      n=0
 
3341
  70  n=n+1
 
3342
      if(xxx.gt.xx(n+1)) goto 70
 
3343
      a=(xxx-xx(n))/(xx(n+1)-xx(n))
 
3344
      m=0
 
3345
  80  m=m+1
 
3346
      if(qsq.gt.qq(m+1)) goto 80
 
3347
      b=(qsq-qq(m))/(qq(m+1)-qq(m))
 
3348
      do 60 i=1,np
 
3349
      g(i)= (1d0-a)*(1d0-b)*f(i,n,m)   + (1d0-a)*b*f(i,n,m+1)
 
3350
     .    +       a*(1d0-b)*f(i,n+1,m) +       a*b*f(i,n+1,m+1)
 
3351
      if(n.ge.ntenth) goto 65
 
3352
      if(i.eq.5.or.i.eq.7) goto 65
 
3353
          fac=(1d0-b)*f(i,ntenth,m)+b*f(i,ntenth,m+1)
 
3354
          g(i)=fac*10d0**(g(i)-fac)
 
3355
  65  continue
 
3356
      g(i)=g(i)*(1d0-x)**n0(i)
 
3357
  60  continue
 
3358
      upv=g(1)
 
3359
      dnv=g(2)
 
3360
      usea=g(4)
 
3361
      dsea=g(8)
 
3362
      str=g(6)
 
3363
      chm=g(5)
 
3364
      glu=g(3) 
 
3365
      bot=g(7)
 
3366
        x=xsave
 
3367
        qsq=q2save
 
3368
      return
 
3369
      end
 
3370
      
 
3371
      subroutine mrs982(x,qsq,upv,dnv,usea,dsea,str,chm,bot,glu)
 
3372
      implicit real*8(a-h,o-z)
 
3373
      parameter(nx=49,nq=37,ntenth=23,np=8)
 
3374
      real*8 f(np,nx,nq+1),qq(nq),xx(nx),g(np),n0(np)
 
3375
      data xx/1d-5,2d-5,4d-5,6d-5,8d-5,
 
3376
     .        1d-4,2d-4,4d-4,6d-4,8d-4,
 
3377
     .        1d-3,2d-3,4d-3,6d-3,8d-3,
 
3378
     .        1d-2,1.4d-2,2d-2,3d-2,4d-2,6d-2,8d-2,
 
3379
     .     .1d0,.125d0,.15d0,.175d0,.2d0,.225d0,.25d0,.275d0,
 
3380
     .     .3d0,.325d0,.35d0,.375d0,.4d0,.425d0,.45d0,.475d0,
 
3381
     .     .5d0,.525d0,.55d0,.575d0,.6d0,.65d0,.7d0,.75d0,
 
3382
     .     .8d0,.9d0,1d0/
 
3383
      data qq/1.25d0,1.5d0,2d0,2.5d0,3.2d0,4d0,5d0,6.4d0,8d0,1d1,
 
3384
     .        1.2d1,1.8d1,2.6d1,4d1,6.4d1,1d2,
 
3385
     .        1.6d2,2.4d2,4d2,6.4d2,1d3,1.8d3,3.2d3,5.6d3,1d4,
 
3386
     .        1.8d4,3.2d4,5.6d4,1d5,1.8d5,3.2d5,5.6d5,1d6,
 
3387
     .        1.8d6,3.2d6,5.6d6,1d7/
 
3388
      data xmin,xmax,qsqmin,qsqmax/1d-5,1d0,1.25d0,1d7/
 
3389
      data n0/3,4,5,9,9,9,9,9/
 
3390
      data init/0/
 
3391
      save
 
3392
      xsave=x
 
3393
      q2save=qsq
 
3394
      if(init.ne.0) goto 10
 
3395
        open(unit=1,file='ft09a',status='old')
 
3396
        do 20 n=1,nx-1
 
3397
        do 20 m=1,nq
 
3398
        read(1,50)f(1,n,m),f(2,n,m),f(3,n,m),f(4,n,m),
 
3399
     .            f(5,n,m),f(7,n,m),f(6,n,m),f(8,n,m)
 
3400
c notation: 1=uval 2=val 3=glue 4=usea 5=chm 6=str 7=btm 8=dsea
 
3401
        do 25 i=1,np
 
3402
  25     f(i,n,m)=f(i,n,m)/(1d0-xx(n))**n0(i)
 
3403
  20  continue
 
3404
      call mrscheck(f(1,1,1),26)
 
3405
      do 31 j=1,ntenth-1       
 
3406
      xx(j)=dlog10(xx(j)/xx(ntenth))+xx(ntenth)
 
3407
      do 31 i=1,8
 
3408
      if(i.eq.5.or.i.eq.7) goto 31
 
3409
      do 30 k=1,nq
 
3410
  30  f(i,j,k)=dlog10(f(i,j,k)/f(i,ntenth,k))+f(i,ntenth,k)
 
3411
  31  continue
 
3412
  50  format(8f10.5)
 
3413
      do 40 i=1,np
 
3414
      do 40 m=1,nq
 
3415
  40  f(i,nx,m)=0d0
 
3416
      init=1
 
3417
      close(1)
 
3418
  10  continue
 
3419
      if(x.lt.xmin) x=xmin
 
3420
      if(x.gt.xmax) x=xmax
 
3421
      if(qsq.lt.qsqmin) qsq=qsqmin
 
3422
      if(qsq.gt.qsqmax) qsq=qsqmax
 
3423
      xxx=x
 
3424
      if(x.lt.xx(ntenth)) xxx=dlog10(x/xx(ntenth))+xx(ntenth)
 
3425
      n=0
 
3426
  70  n=n+1
 
3427
      if(xxx.gt.xx(n+1)) goto 70
 
3428
      a=(xxx-xx(n))/(xx(n+1)-xx(n))
 
3429
      m=0
 
3430
  80  m=m+1
 
3431
      if(qsq.gt.qq(m+1)) goto 80
 
3432
      b=(qsq-qq(m))/(qq(m+1)-qq(m))
 
3433
      do 60 i=1,np
 
3434
      g(i)= (1d0-a)*(1d0-b)*f(i,n,m)   + (1d0-a)*b*f(i,n,m+1)
 
3435
     .    +       a*(1d0-b)*f(i,n+1,m) +       a*b*f(i,n+1,m+1)
 
3436
      if(n.ge.ntenth) goto 65
 
3437
      if(i.eq.5.or.i.eq.7) goto 65
 
3438
          fac=(1d0-b)*f(i,ntenth,m)+b*f(i,ntenth,m+1)
 
3439
          g(i)=fac*10d0**(g(i)-fac)
 
3440
  65  continue
 
3441
      g(i)=g(i)*(1d0-x)**n0(i)
 
3442
  60  continue
 
3443
      upv=g(1)
 
3444
      dnv=g(2)
 
3445
      usea=g(4)
 
3446
      dsea=g(8)
 
3447
      str=g(6)
 
3448
      chm=g(5)
 
3449
      glu=g(3) 
 
3450
      bot=g(7)
 
3451
        x=xsave
 
3452
        qsq=q2save
 
3453
      return
 
3454
      end
 
3455
      
 
3456
      subroutine mrs983(x,qsq,upv,dnv,usea,dsea,str,chm,bot,glu)
 
3457
      implicit real*8(a-h,o-z)
 
3458
      parameter(nx=49,nq=37,ntenth=23,np=8)
 
3459
      real*8 f(np,nx,nq+1),qq(nq),xx(nx),g(np),n0(np)
 
3460
      data xx/1d-5,2d-5,4d-5,6d-5,8d-5,
 
3461
     .        1d-4,2d-4,4d-4,6d-4,8d-4,
 
3462
     .        1d-3,2d-3,4d-3,6d-3,8d-3,
 
3463
     .        1d-2,1.4d-2,2d-2,3d-2,4d-2,6d-2,8d-2,
 
3464
     .     .1d0,.125d0,.15d0,.175d0,.2d0,.225d0,.25d0,.275d0,
 
3465
     .     .3d0,.325d0,.35d0,.375d0,.4d0,.425d0,.45d0,.475d0,
 
3466
     .     .5d0,.525d0,.55d0,.575d0,.6d0,.65d0,.7d0,.75d0,
 
3467
     .     .8d0,.9d0,1d0/
 
3468
      data qq/1.25d0,1.5d0,2d0,2.5d0,3.2d0,4d0,5d0,6.4d0,8d0,1d1,
 
3469
     .        1.2d1,1.8d1,2.6d1,4d1,6.4d1,1d2,
 
3470
     .        1.6d2,2.4d2,4d2,6.4d2,1d3,1.8d3,3.2d3,5.6d3,1d4,
 
3471
     .        1.8d4,3.2d4,5.6d4,1d5,1.8d5,3.2d5,5.6d5,1d6,
 
3472
     .        1.8d6,3.2d6,5.6d6,1d7/
 
3473
      data xmin,xmax,qsqmin,qsqmax/1d-5,1d0,1.25d0,1d7/
 
3474
      data n0/3,4,5,9,9,9,9,9/
 
3475
      data init/0/
 
3476
      save
 
3477
      xsave=x
 
3478
      q2save=qsq
 
3479
      if(init.ne.0) goto 10
 
3480
        open(unit=1,file='ft11a',status='old')
 
3481
        do 20 n=1,nx-1
 
3482
        do 20 m=1,nq
 
3483
        read(1,50)f(1,n,m),f(2,n,m),f(3,n,m),f(4,n,m),
 
3484
     .            f(5,n,m),f(7,n,m),f(6,n,m),f(8,n,m)
 
3485
c notation: 1=uval 2=val 3=glue 4=usea 5=chm 6=str 7=btm 8=dsea
 
3486
        do 25 i=1,np
 
3487
  25     f(i,n,m)=f(i,n,m)/(1d0-xx(n))**n0(i)
 
3488
  20  continue
 
3489
      call mrscheck(f(1,1,1),27)
 
3490
      do 31 j=1,ntenth-1       
 
3491
      xx(j)=dlog10(xx(j)/xx(ntenth))+xx(ntenth)
 
3492
      do 31 i=1,8
 
3493
      if(i.eq.5.or.i.eq.7) goto 31
 
3494
      do 30 k=1,nq
 
3495
  30  f(i,j,k)=dlog10(f(i,j,k)/f(i,ntenth,k))+f(i,ntenth,k)
 
3496
  31  continue
 
3497
  50  format(8f10.5)
 
3498
      do 40 i=1,np
 
3499
      do 40 m=1,nq
 
3500
  40  f(i,nx,m)=0d0
 
3501
      init=1
 
3502
      close(1)
 
3503
  10  continue
 
3504
      if(x.lt.xmin) x=xmin
 
3505
      if(x.gt.xmax) x=xmax
 
3506
      if(qsq.lt.qsqmin) qsq=qsqmin
 
3507
      if(qsq.gt.qsqmax) qsq=qsqmax
 
3508
      xxx=x
 
3509
      if(x.lt.xx(ntenth)) xxx=dlog10(x/xx(ntenth))+xx(ntenth)
 
3510
      n=0
 
3511
  70  n=n+1
 
3512
      if(xxx.gt.xx(n+1)) goto 70
 
3513
      a=(xxx-xx(n))/(xx(n+1)-xx(n))
 
3514
      m=0
 
3515
  80  m=m+1
 
3516
      if(qsq.gt.qq(m+1)) goto 80
 
3517
      b=(qsq-qq(m))/(qq(m+1)-qq(m))
 
3518
      do 60 i=1,np
 
3519
      g(i)= (1d0-a)*(1d0-b)*f(i,n,m)   + (1d0-a)*b*f(i,n,m+1)
 
3520
     .    +       a*(1d0-b)*f(i,n+1,m) +       a*b*f(i,n+1,m+1)
 
3521
      if(n.ge.ntenth) goto 65
 
3522
      if(i.eq.5.or.i.eq.7) goto 65
 
3523
          fac=(1d0-b)*f(i,ntenth,m)+b*f(i,ntenth,m+1)
 
3524
          g(i)=fac*10d0**(g(i)-fac)
 
3525
  65  continue
 
3526
      g(i)=g(i)*(1d0-x)**n0(i)
 
3527
  60  continue
 
3528
      upv=g(1)
 
3529
      dnv=g(2)
 
3530
      usea=g(4)
 
3531
      dsea=g(8)
 
3532
      str=g(6)
 
3533
      chm=g(5)
 
3534
      glu=g(3) 
 
3535
      bot=g(7)
 
3536
        x=xsave
 
3537
        qsq=q2save
 
3538
      return
 
3539
      end
 
3540
      
 
3541
      
 
3542
      subroutine mrs984(x,qsq,upv,dnv,usea,dsea,str,chm,bot,glu)
 
3543
      implicit real*8(a-h,o-z)
 
3544
      parameter(nx=49,nq=37,ntenth=23,np=8)
 
3545
      real*8 f(np,nx,nq+1),qq(nq),xx(nx),g(np),n0(np)
 
3546
      data xx/1d-5,2d-5,4d-5,6d-5,8d-5,
 
3547
     .        1d-4,2d-4,4d-4,6d-4,8d-4,
 
3548
     .        1d-3,2d-3,4d-3,6d-3,8d-3,
 
3549
     .        1d-2,1.4d-2,2d-2,3d-2,4d-2,6d-2,8d-2,
 
3550
     .     .1d0,.125d0,.15d0,.175d0,.2d0,.225d0,.25d0,.275d0,
 
3551
     .     .3d0,.325d0,.35d0,.375d0,.4d0,.425d0,.45d0,.475d0,
 
3552
     .     .5d0,.525d0,.55d0,.575d0,.6d0,.65d0,.7d0,.75d0,
 
3553
     .     .8d0,.9d0,1d0/
 
3554
      data qq/1.25d0,1.5d0,2d0,2.5d0,3.2d0,4d0,5d0,6.4d0,8d0,1d1,
 
3555
     .        1.2d1,1.8d1,2.6d1,4d1,6.4d1,1d2,
 
3556
     .        1.6d2,2.4d2,4d2,6.4d2,1d3,1.8d3,3.2d3,5.6d3,1d4,
 
3557
     .        1.8d4,3.2d4,5.6d4,1d5,1.8d5,3.2d5,5.6d5,1d6,
 
3558
     .        1.8d6,3.2d6,5.6d6,1d7/
 
3559
      data xmin,xmax,qsqmin,qsqmax/1d-5,1d0,1.25d0,1d7/
 
3560
      data n0/3,4,5,9,9,9,9,9/
 
3561
      data init/0/
 
3562
      save
 
3563
      xsave=x
 
3564
      q2save=qsq
 
3565
      if(init.ne.0) goto 10
 
3566
        open(unit=1,file='ft24a',status='old')
 
3567
        do 20 n=1,nx-1
 
3568
        do 20 m=1,nq
 
3569
        read(1,50)f(1,n,m),f(2,n,m),f(3,n,m),f(4,n,m),
 
3570
     .            f(5,n,m),f(7,n,m),f(6,n,m),f(8,n,m)
 
3571
c notation: 1=uval 2=val 3=glue 4=usea 5=chm 6=str 7=btm 8=dsea
 
3572
        do 25 i=1,np
 
3573
  25     f(i,n,m)=f(i,n,m)/(1d0-xx(n))**n0(i)
 
3574
  20  continue
 
3575
      call mrscheck(f(1,1,1),28)
 
3576
      do 31 j=1,ntenth-1       
 
3577
      xx(j)=dlog10(xx(j)/xx(ntenth))+xx(ntenth)
 
3578
      do 31 i=1,8
 
3579
      if(i.eq.5.or.i.eq.7) goto 31
 
3580
      do 30 k=1,nq
 
3581
  30  f(i,j,k)=dlog10(f(i,j,k)/f(i,ntenth,k))+f(i,ntenth,k)
 
3582
  31  continue
 
3583
  50  format(8f10.5)
 
3584
      do 40 i=1,np
 
3585
      do 40 m=1,nq
 
3586
  40  f(i,nx,m)=0d0
 
3587
      init=1
 
3588
      close(1)
 
3589
  10  continue
 
3590
      if(x.lt.xmin) x=xmin
 
3591
      if(x.gt.xmax) x=xmax
 
3592
      if(qsq.lt.qsqmin) qsq=qsqmin
 
3593
      if(qsq.gt.qsqmax) qsq=qsqmax
 
3594
      xxx=x
 
3595
      if(x.lt.xx(ntenth)) xxx=dlog10(x/xx(ntenth))+xx(ntenth)
 
3596
      n=0
 
3597
  70  n=n+1
 
3598
      if(xxx.gt.xx(n+1)) goto 70
 
3599
      a=(xxx-xx(n))/(xx(n+1)-xx(n))
 
3600
      m=0
 
3601
  80  m=m+1
 
3602
      if(qsq.gt.qq(m+1)) goto 80
 
3603
      b=(qsq-qq(m))/(qq(m+1)-qq(m))
 
3604
      do 60 i=1,np
 
3605
      g(i)= (1d0-a)*(1d0-b)*f(i,n,m)   + (1d0-a)*b*f(i,n,m+1)
 
3606
     .    +       a*(1d0-b)*f(i,n+1,m) +       a*b*f(i,n+1,m+1)
 
3607
      if(n.ge.ntenth) goto 65
 
3608
      if(i.eq.5.or.i.eq.7) goto 65
 
3609
          fac=(1d0-b)*f(i,ntenth,m)+b*f(i,ntenth,m+1)
 
3610
          g(i)=fac*10d0**(g(i)-fac)
 
3611
  65  continue
 
3612
      g(i)=g(i)*(1d0-x)**n0(i)
 
3613
  60  continue
 
3614
      upv=g(1)
 
3615
      dnv=g(2)
 
3616
      usea=g(4)
 
3617
      dsea=g(8)
 
3618
      str=g(6)
 
3619
      chm=g(5)
 
3620
      glu=g(3) 
 
3621
      bot=g(7)
 
3622
        x=xsave
 
3623
        qsq=q2save
 
3624
      return
 
3625
      end
 
3626
      
 
3627
      subroutine mrs985(x,qsq,upv,dnv,usea,dsea,str,chm,bot,glu)
 
3628
      implicit real*8(a-h,o-z)
 
3629
      parameter(nx=49,nq=37,ntenth=23,np=8)
 
3630
      real*8 f(np,nx,nq+1),qq(nq),xx(nx),g(np),n0(np)
 
3631
      data xx/1d-5,2d-5,4d-5,6d-5,8d-5,
 
3632
     .        1d-4,2d-4,4d-4,6d-4,8d-4,
 
3633
     .        1d-3,2d-3,4d-3,6d-3,8d-3,
 
3634
     .        1d-2,1.4d-2,2d-2,3d-2,4d-2,6d-2,8d-2,
 
3635
     .     .1d0,.125d0,.15d0,.175d0,.2d0,.225d0,.25d0,.275d0,
 
3636
     .     .3d0,.325d0,.35d0,.375d0,.4d0,.425d0,.45d0,.475d0,
 
3637
     .     .5d0,.525d0,.55d0,.575d0,.6d0,.65d0,.7d0,.75d0,
 
3638
     .     .8d0,.9d0,1d0/
 
3639
      data qq/1.25d0,1.5d0,2d0,2.5d0,3.2d0,4d0,5d0,6.4d0,8d0,1d1,
 
3640
     .        1.2d1,1.8d1,2.6d1,4d1,6.4d1,1d2,
 
3641
     .        1.6d2,2.4d2,4d2,6.4d2,1d3,1.8d3,3.2d3,5.6d3,1d4,
 
3642
     .        1.8d4,3.2d4,5.6d4,1d5,1.8d5,3.2d5,5.6d5,1d6,
 
3643
     .        1.8d6,3.2d6,5.6d6,1d7/
 
3644
      data xmin,xmax,qsqmin,qsqmax/1d-5,1d0,1.25d0,1d7/
 
3645
      data n0/3,4,5,9,9,9,9,9/
 
3646
      data init/0/
 
3647
      save
 
3648
      xsave=x
 
3649
      q2save=qsq
 
3650
      if(init.ne.0) goto 10
 
3651
        open(unit=1,file='ft23a',status='old')
 
3652
        do 20 n=1,nx-1
 
3653
        do 20 m=1,nq
 
3654
        read(1,50)f(1,n,m),f(2,n,m),f(3,n,m),f(4,n,m),
 
3655
     .            f(5,n,m),f(7,n,m),f(6,n,m),f(8,n,m)
 
3656
c notation: 1=uval 2=val 3=glue 4=usea 5=chm 6=str 7=btm 8=dsea
 
3657
        do 25 i=1,np
 
3658
  25     f(i,n,m)=f(i,n,m)/(1d0-xx(n))**n0(i)
 
3659
  20  continue
 
3660
      call mrscheck(f(1,1,1),29)
 
3661
      do 31 j=1,ntenth-1       
 
3662
      xx(j)=dlog10(xx(j)/xx(ntenth))+xx(ntenth)
 
3663
      do 31 i=1,8
 
3664
      if(i.eq.5.or.i.eq.7) goto 31
 
3665
      do 30 k=1,nq
 
3666
  30  f(i,j,k)=dlog10(f(i,j,k)/f(i,ntenth,k))+f(i,ntenth,k)
 
3667
  31  continue
 
3668
  50  format(8f10.5)
 
3669
      do 40 i=1,np
 
3670
      do 40 m=1,nq
 
3671
  40  f(i,nx,m)=0d0
 
3672
      init=1
 
3673
      close(1)
 
3674
  10  continue
 
3675
      if(x.lt.xmin) x=xmin
 
3676
      if(x.gt.xmax) x=xmax
 
3677
      if(qsq.lt.qsqmin) qsq=qsqmin
 
3678
      if(qsq.gt.qsqmax) qsq=qsqmax
 
3679
      xxx=x
 
3680
      if(x.lt.xx(ntenth)) xxx=dlog10(x/xx(ntenth))+xx(ntenth)
 
3681
      n=0
 
3682
  70  n=n+1
 
3683
      if(xxx.gt.xx(n+1)) goto 70
 
3684
      a=(xxx-xx(n))/(xx(n+1)-xx(n))
 
3685
      m=0
 
3686
  80  m=m+1
 
3687
      if(qsq.gt.qq(m+1)) goto 80
 
3688
      b=(qsq-qq(m))/(qq(m+1)-qq(m))
 
3689
      do 60 i=1,np
 
3690
      g(i)= (1d0-a)*(1d0-b)*f(i,n,m)   + (1d0-a)*b*f(i,n,m+1)
 
3691
     .    +       a*(1d0-b)*f(i,n+1,m) +       a*b*f(i,n+1,m+1)
 
3692
      if(n.ge.ntenth) goto 65
 
3693
      if(i.eq.5.or.i.eq.7) goto 65
 
3694
          fac=(1d0-b)*f(i,ntenth,m)+b*f(i,ntenth,m+1)
 
3695
          g(i)=fac*10d0**(g(i)-fac)
 
3696
  65  continue
 
3697
      g(i)=g(i)*(1d0-x)**n0(i)
 
3698
  60  continue
 
3699
      upv=g(1)
 
3700
      dnv=g(2)
 
3701
      usea=g(4)
 
3702
      dsea=g(8)
 
3703
      str=g(6)
 
3704
      chm=g(5)
 
3705
      glu=g(3) 
 
3706
      bot=g(7)
 
3707
        x=xsave
 
3708
        qsq=q2save
 
3709
      return
 
3710
      end
 
3711
c end of MRS98
 
3712
c
 
3713
      subroutine mrs99(x,q,mode,upv,dnv,usea,dsea,str,chm,bot,glu)
 
3714
C****************************************************************C
 
3715
C                                                                C
 
3716
C     This is a package for the new **corrected** MRST parton    C
 
3717
C     distributions. The format is similar to the previous       C
 
3718
C     (1998) MRST series.                                        C
 
3719
C                                                                C
 
3720
C     NOTE: 7 new sets are added here, corresponding to shifting C
 
3721
C     the small x HERA data up and down by 2.5%, and by varying  C
 
3722
C     the charm and strange distributions, and by forcing a      C
 
3723
C     larger d/u ratio at large x.                               C
 
3724
C                                                                C
 
3725
C     As before, x times the parton distribution is returned,    C
 
3726
C     q is the scale in GeV, MSbar factorization is assumed,     C
 
3727
C     and Lambda(MSbar,nf=4) is given below for each set.        C
 
3728
C                                                                C
 
3729
C     NAMING SCHEME:                                             C
 
3730
C                                                                C
 
3731
C  mode  set    comment             L(4)/MeV  a_s(M_Z)  grid#1   C
 
3732
C  ----  ---    -------             --------  -------   ------   C
 
3733
C                                                                C
 
3734
C  1     COR01  central gluon, a_s    300      0.1175   0.00524  C
 
3735
C  2     COR02  higher gluon          300      0.1175   0.00497  C
 
3736
C  3     COR03  lower gluon           300      0.1175   0.00398  C
 
3737
C  4     COR04  lower a_s             229      0.1125   0.00585  C
 
3738
C  5     COR05  higher a_s            383      0.1225   0.00384  C
 
3739
C  6     COR06  quarks up             303.3    0.1178   0.00497  C
 
3740
C  7     COR07  quarks down           290.3    0.1171   0.00593  C
 
3741
C  8     COR08  strange up            300      0.1175   0.00524  C
 
3742
C  9     COR09  strange down          300      0.1175   0.00524  C
 
3743
C  10    C0R10  charm up              300      0.1175   0.00525  C
 
3744
C  11    COR11  charm down            300      0.1175   0.00524  C
 
3745
C  12    COR12  larger d/u            300      0.1175   0.00515  C
 
3746
C                                                                C
 
3747
C      The corresponding grid files are called cor01.dat etc.    C
 
3748
C                                                                C
 
3749
C      The reference is:                                         C
 
3750
C      A.D. Martin, R.G. Roberts, W.J. Stirling, R.S Thorne      C
 
3751
C      Univ. Durham preprint DTP/99/64, hep-ph/9907231 (1999)    C
 
3752
C                                                                C
 
3753
C      Comments to : W.J.Stirling@durham.ac.uk                   C
 
3754
C                                                                C
 
3755
C                                                                C
 
3756
C****************************************************************C
 
3757
      implicit real*8(a-h,o-z)
 
3758
      data xmin,xmax,qsqmin,qsqmax/1d-5,1d0,1.25d0,1d7/
 
3759
      q2=q*q
 
3760
c      if(q2.lt.qsqmin.or.q2.gt.qsqmax) print 99
 
3761
c      if(x.lt.xmin.or.x.gt.xmax)       print 98
 
3762
      if(mode.eq.1) then
 
3763
        call mrs991(x,q2,upv,dnv,usea,dsea,str,chm,bot,glu) 
 
3764
      elseif(mode.eq.2) then
 
3765
        call mrs992(x,q2,upv,dnv,usea,dsea,str,chm,bot,glu) 
 
3766
      elseif(mode.eq.3) then
 
3767
        call mrs993(x,q2,upv,dnv,usea,dsea,str,chm,bot,glu) 
 
3768
      elseif(mode.eq.4) then
 
3769
        call mrs994(x,q2,upv,dnv,usea,dsea,str,chm,bot,glu) 
 
3770
      elseif(mode.eq.5) then
 
3771
        call mrs995(x,q2,upv,dnv,usea,dsea,str,chm,bot,glu) 
 
3772
      elseif(mode.eq.6) then
 
3773
        call mrs996(x,q2,upv,dnv,usea,dsea,str,chm,bot,glu) 
 
3774
      elseif(mode.eq.7) then
 
3775
        call mrs997(x,q2,upv,dnv,usea,dsea,str,chm,bot,glu) 
 
3776
      elseif(mode.eq.8) then
 
3777
        call mrs998(x,q2,upv,dnv,usea,dsea,str,chm,bot,glu) 
 
3778
      elseif(mode.eq.9) then
 
3779
        call mrs999(x,q2,upv,dnv,usea,dsea,str,chm,bot,glu) 
 
3780
      elseif(mode.eq.10) then
 
3781
        call mrs9910(x,q2,upv,dnv,usea,dsea,str,chm,bot,glu) 
 
3782
      elseif(mode.eq.11) then
 
3783
        call mrs9911(x,q2,upv,dnv,usea,dsea,str,chm,bot,glu) 
 
3784
      elseif(mode.eq.12) then
 
3785
        call mrs9912(x,q2,upv,dnv,usea,dsea,str,chm,bot,glu) 
 
3786
      endif 
 
3787
  99  format('  WARNING:  Q^2 VALUE IS OUT OF RANGE   ')
 
3788
  98  format('  WARNING:   X  VALUE IS OUT OF RANGE   ')
 
3789
      return
 
3790
      end
 
3791
 
 
3792
      subroutine mrs991(x,qsq,upv,dnv,usea,dsea,str,chm,bot,glu)
 
3793
      implicit real*8(a-h,o-z)
 
3794
      parameter(nx=49,nq=37,ntenth=23,np=8)
 
3795
      real*8 f(np,nx,nq+1),qq(nq),xx(nx),g(np),n0(np)
 
3796
      data xx/1d-5,2d-5,4d-5,6d-5,8d-5,
 
3797
     .        1d-4,2d-4,4d-4,6d-4,8d-4,
 
3798
     .        1d-3,2d-3,4d-3,6d-3,8d-3,
 
3799
     .        1d-2,1.4d-2,2d-2,3d-2,4d-2,6d-2,8d-2,
 
3800
     .     .1d0,.125d0,.15d0,.175d0,.2d0,.225d0,.25d0,.275d0,
 
3801
     .     .3d0,.325d0,.35d0,.375d0,.4d0,.425d0,.45d0,.475d0,
 
3802
     .     .5d0,.525d0,.55d0,.575d0,.6d0,.65d0,.7d0,.75d0,
 
3803
     .     .8d0,.9d0,1d0/
 
3804
      data qq/1.25d0,1.5d0,2d0,2.5d0,3.2d0,4d0,5d0,6.4d0,8d0,1d1,
 
3805
     .        1.2d1,1.8d1,2.6d1,4d1,6.4d1,1d2,
 
3806
     .        1.6d2,2.4d2,4d2,6.4d2,1d3,1.8d3,3.2d3,5.6d3,1d4,
 
3807
     .        1.8d4,3.2d4,5.6d4,1d5,1.8d5,3.2d5,5.6d5,1d6,
 
3808
     .        1.8d6,3.2d6,5.6d6,1d7/
 
3809
      data xmin,xmax,qsqmin,qsqmax/1d-5,1d0,1.25d0,1d7/
 
3810
      data n0/3,4,5,9,9,9,9,9/
 
3811
      data init/0/
 
3812
      save
 
3813
      xsave=x
 
3814
      q2save=qsq
 
3815
      if(init.ne.0) goto 10
 
3816
        open(unit=1,file='cor01',status='old')
 
3817
        do 20 n=1,nx-1
 
3818
        do 20 m=1,nq
 
3819
        read(1,50)f(1,n,m),f(2,n,m),f(3,n,m),f(4,n,m),
 
3820
     .            f(5,n,m),f(7,n,m),f(6,n,m),f(8,n,m)
 
3821
c notation: 1=uval 2=val 3=glue 4=usea 5=chm 6=str 7=btm 8=dsea
 
3822
        do 25 i=1,np
 
3823
  25     f(i,n,m)=f(i,n,m)/(1d0-xx(n))**n0(i)
 
3824
  20  continue
 
3825
      call mrscheck(f(1,1,1),31)
 
3826
      do 31 j=1,ntenth-1
 
3827
      xx(j)=dlog10(xx(j)/xx(ntenth))+xx(ntenth)
 
3828
      do 31 i=1,8
 
3829
      if(i.eq.5.or.i.eq.7) goto 31
 
3830
      do 30 k=1,nq
 
3831
  30  f(i,j,k)=dlog10(f(i,j,k)/f(i,ntenth,k))+f(i,ntenth,k)
 
3832
  31  continue
 
3833
  50  format(8f10.5)
 
3834
      do 40 i=1,np
 
3835
      do 40 m=1,nq
 
3836
  40  f(i,nx,m)=0d0
 
3837
      init=1
 
3838
      close(1)
 
3839
  10  continue
 
3840
      if(x.lt.xmin) x=xmin
 
3841
      if(x.gt.xmax) x=xmax
 
3842
      if(qsq.lt.qsqmin) qsq=qsqmin
 
3843
      if(qsq.gt.qsqmax) qsq=qsqmax
 
3844
      xxx=x
 
3845
      if(x.lt.xx(ntenth)) xxx=dlog10(x/xx(ntenth))+xx(ntenth)
 
3846
      n=0
 
3847
  70  n=n+1
 
3848
      if(xxx.gt.xx(n+1)) goto 70
 
3849
      a=(xxx-xx(n))/(xx(n+1)-xx(n))
 
3850
      m=0
 
3851
  80  m=m+1
 
3852
      if(qsq.gt.qq(m+1)) goto 80
 
3853
      b=(qsq-qq(m))/(qq(m+1)-qq(m))
 
3854
      do 60 i=1,np
 
3855
      g(i)= (1d0-a)*(1d0-b)*f(i,n,m)   + (1d0-a)*b*f(i,n,m+1)
 
3856
     .    +       a*(1d0-b)*f(i,n+1,m) +       a*b*f(i,n+1,m+1)
 
3857
      if(n.ge.ntenth) goto 65
 
3858
      if(i.eq.5.or.i.eq.7) goto 65
 
3859
          fac=(1d0-b)*f(i,ntenth,m)+b*f(i,ntenth,m+1)
 
3860
          g(i)=fac*10d0**(g(i)-fac)
 
3861
  65  continue
 
3862
      g(i)=g(i)*(1d0-x)**n0(i)
 
3863
  60  continue
 
3864
      upv=g(1)
 
3865
      dnv=g(2)
 
3866
      usea=g(4)
 
3867
      dsea=g(8)
 
3868
      str=g(6)
 
3869
      chm=g(5)
 
3870
      glu=g(3) 
 
3871
      bot=g(7)
 
3872
        x=xsave
 
3873
        qsq=q2save
 
3874
      return
 
3875
      end
 
3876
      
 
3877
      subroutine mrs992(x,qsq,upv,dnv,usea,dsea,str,chm,bot,glu)
 
3878
      implicit real*8(a-h,o-z)
 
3879
      parameter(nx=49,nq=37,ntenth=23,np=8)
 
3880
      real*8 f(np,nx,nq+1),qq(nq),xx(nx),g(np),n0(np)
 
3881
      data xx/1d-5,2d-5,4d-5,6d-5,8d-5,
 
3882
     .        1d-4,2d-4,4d-4,6d-4,8d-4,
 
3883
     .        1d-3,2d-3,4d-3,6d-3,8d-3,
 
3884
     .        1d-2,1.4d-2,2d-2,3d-2,4d-2,6d-2,8d-2,
 
3885
     .     .1d0,.125d0,.15d0,.175d0,.2d0,.225d0,.25d0,.275d0,
 
3886
     .     .3d0,.325d0,.35d0,.375d0,.4d0,.425d0,.45d0,.475d0,
 
3887
     .     .5d0,.525d0,.55d0,.575d0,.6d0,.65d0,.7d0,.75d0,
 
3888
     .     .8d0,.9d0,1d0/
 
3889
      data qq/1.25d0,1.5d0,2d0,2.5d0,3.2d0,4d0,5d0,6.4d0,8d0,1d1,
 
3890
     .        1.2d1,1.8d1,2.6d1,4d1,6.4d1,1d2,
 
3891
     .        1.6d2,2.4d2,4d2,6.4d2,1d3,1.8d3,3.2d3,5.6d3,1d4,
 
3892
     .        1.8d4,3.2d4,5.6d4,1d5,1.8d5,3.2d5,5.6d5,1d6,
 
3893
     .        1.8d6,3.2d6,5.6d6,1d7/
 
3894
      data xmin,xmax,qsqmin,qsqmax/1d-5,1d0,1.25d0,1d7/
 
3895
      data n0/3,4,5,9,9,9,9,9/
 
3896
      data init/0/
 
3897
      save
 
3898
      xsave=x
 
3899
      q2save=qsq
 
3900
      if(init.ne.0) goto 10
 
3901
        open(unit=1,file='cor02',status='old')
 
3902
        do 20 n=1,nx-1
 
3903
        do 20 m=1,nq
 
3904
        read(1,50)f(1,n,m),f(2,n,m),f(3,n,m),f(4,n,m),
 
3905
     .            f(5,n,m),f(7,n,m),f(6,n,m),f(8,n,m)
 
3906
c notation: 1=uval 2=val 3=glue 4=usea 5=chm 6=str 7=btm 8=dsea
 
3907
        do 25 i=1,np
 
3908
  25     f(i,n,m)=f(i,n,m)/(1d0-xx(n))**n0(i)
 
3909
  20  continue
 
3910
      call mrscheck(f(1,1,1),32)
 
3911
      do 31 j=1,ntenth-1
 
3912
      xx(j)=dlog10(xx(j)/xx(ntenth))+xx(ntenth)
 
3913
      do 31 i=1,8
 
3914
      if(i.eq.5.or.i.eq.7) goto 31
 
3915
      do 30 k=1,nq
 
3916
  30  f(i,j,k)=dlog10(f(i,j,k)/f(i,ntenth,k))+f(i,ntenth,k)
 
3917
  31  continue
 
3918
  50  format(8f10.5)
 
3919
      do 40 i=1,np
 
3920
      do 40 m=1,nq
 
3921
  40  f(i,nx,m)=0d0
 
3922
      init=1
 
3923
      close(1)
 
3924
  10  continue
 
3925
      if(x.lt.xmin) x=xmin
 
3926
      if(x.gt.xmax) x=xmax
 
3927
      if(qsq.lt.qsqmin) qsq=qsqmin
 
3928
      if(qsq.gt.qsqmax) qsq=qsqmax
 
3929
      xxx=x
 
3930
      if(x.lt.xx(ntenth)) xxx=dlog10(x/xx(ntenth))+xx(ntenth)
 
3931
      n=0
 
3932
  70  n=n+1
 
3933
      if(xxx.gt.xx(n+1)) goto 70
 
3934
      a=(xxx-xx(n))/(xx(n+1)-xx(n))
 
3935
      m=0
 
3936
  80  m=m+1
 
3937
      if(qsq.gt.qq(m+1)) goto 80
 
3938
      b=(qsq-qq(m))/(qq(m+1)-qq(m))
 
3939
      do 60 i=1,np
 
3940
      g(i)= (1d0-a)*(1d0-b)*f(i,n,m)   + (1d0-a)*b*f(i,n,m+1)
 
3941
     .    +       a*(1d0-b)*f(i,n+1,m) +       a*b*f(i,n+1,m+1)
 
3942
      if(n.ge.ntenth) goto 65
 
3943
      if(i.eq.5.or.i.eq.7) goto 65
 
3944
          fac=(1d0-b)*f(i,ntenth,m)+b*f(i,ntenth,m+1)
 
3945
          g(i)=fac*10d0**(g(i)-fac)
 
3946
  65  continue
 
3947
      g(i)=g(i)*(1d0-x)**n0(i)
 
3948
  60  continue
 
3949
      upv=g(1)
 
3950
      dnv=g(2)
 
3951
      usea=g(4)
 
3952
      dsea=g(8)
 
3953
      str=g(6)
 
3954
      chm=g(5)
 
3955
      glu=g(3) 
 
3956
      bot=g(7)
 
3957
        x=xsave
 
3958
        qsq=q2save
 
3959
      return
 
3960
      end
 
3961
      
 
3962
      subroutine mrs993(x,qsq,upv,dnv,usea,dsea,str,chm,bot,glu)
 
3963
      implicit real*8(a-h,o-z)
 
3964
      parameter(nx=49,nq=37,ntenth=23,np=8)
 
3965
      real*8 f(np,nx,nq+1),qq(nq),xx(nx),g(np),n0(np)
 
3966
      data xx/1d-5,2d-5,4d-5,6d-5,8d-5,
 
3967
     .        1d-4,2d-4,4d-4,6d-4,8d-4,
 
3968
     .        1d-3,2d-3,4d-3,6d-3,8d-3,
 
3969
     .        1d-2,1.4d-2,2d-2,3d-2,4d-2,6d-2,8d-2,
 
3970
     .     .1d0,.125d0,.15d0,.175d0,.2d0,.225d0,.25d0,.275d0,
 
3971
     .     .3d0,.325d0,.35d0,.375d0,.4d0,.425d0,.45d0,.475d0,
 
3972
     .     .5d0,.525d0,.55d0,.575d0,.6d0,.65d0,.7d0,.75d0,
 
3973
     .     .8d0,.9d0,1d0/
 
3974
      data qq/1.25d0,1.5d0,2d0,2.5d0,3.2d0,4d0,5d0,6.4d0,8d0,1d1,
 
3975
     .        1.2d1,1.8d1,2.6d1,4d1,6.4d1,1d2,
 
3976
     .        1.6d2,2.4d2,4d2,6.4d2,1d3,1.8d3,3.2d3,5.6d3,1d4,
 
3977
     .        1.8d4,3.2d4,5.6d4,1d5,1.8d5,3.2d5,5.6d5,1d6,
 
3978
     .        1.8d6,3.2d6,5.6d6,1d7/
 
3979
      data xmin,xmax,qsqmin,qsqmax/1d-5,1d0,1.25d0,1d7/
 
3980
      data n0/3,4,5,9,9,9,9,9/
 
3981
      data init/0/
 
3982
      save
 
3983
      xsave=x
 
3984
      q2save=qsq
 
3985
      if(init.ne.0) goto 10
 
3986
        open(unit=1,file='cor03',status='old')
 
3987
        do 20 n=1,nx-1
 
3988
        do 20 m=1,nq
 
3989
        read(1,50)f(1,n,m),f(2,n,m),f(3,n,m),f(4,n,m),
 
3990
     .            f(5,n,m),f(7,n,m),f(6,n,m),f(8,n,m)
 
3991
c notation: 1=uval 2=val 3=glue 4=usea 5=chm 6=str 7=btm 8=dsea
 
3992
        do 25 i=1,np
 
3993
  25     f(i,n,m)=f(i,n,m)/(1d0-xx(n))**n0(i)
 
3994
  20  continue
 
3995
      call mrscheck(f(1,1,1),33)
 
3996
      do 31 j=1,ntenth-1
 
3997
      xx(j)=dlog10(xx(j)/xx(ntenth))+xx(ntenth)
 
3998
      do 31 i=1,8
 
3999
      if(i.eq.5.or.i.eq.7) goto 31
 
4000
      do 30 k=1,nq
 
4001
  30  f(i,j,k)=dlog10(f(i,j,k)/f(i,ntenth,k))+f(i,ntenth,k)
 
4002
  31  continue
 
4003
  50  format(8f10.5)
 
4004
      do 40 i=1,np
 
4005
      do 40 m=1,nq
 
4006
  40  f(i,nx,m)=0d0
 
4007
      init=1
 
4008
      close(1)
 
4009
  10  continue
 
4010
      if(x.lt.xmin) x=xmin
 
4011
      if(x.gt.xmax) x=xmax
 
4012
      if(qsq.lt.qsqmin) qsq=qsqmin
 
4013
      if(qsq.gt.qsqmax) qsq=qsqmax
 
4014
      xxx=x
 
4015
      if(x.lt.xx(ntenth)) xxx=dlog10(x/xx(ntenth))+xx(ntenth)
 
4016
      n=0
 
4017
  70  n=n+1
 
4018
      if(xxx.gt.xx(n+1)) goto 70
 
4019
      a=(xxx-xx(n))/(xx(n+1)-xx(n))
 
4020
      m=0
 
4021
  80  m=m+1
 
4022
      if(qsq.gt.qq(m+1)) goto 80
 
4023
      b=(qsq-qq(m))/(qq(m+1)-qq(m))
 
4024
      do 60 i=1,np
 
4025
      g(i)= (1d0-a)*(1d0-b)*f(i,n,m)   + (1d0-a)*b*f(i,n,m+1)
 
4026
     .    +       a*(1d0-b)*f(i,n+1,m) +       a*b*f(i,n+1,m+1)
 
4027
      if(n.ge.ntenth) goto 65
 
4028
      if(i.eq.5.or.i.eq.7) goto 65
 
4029
          fac=(1d0-b)*f(i,ntenth,m)+b*f(i,ntenth,m+1)
 
4030
          g(i)=fac*10d0**(g(i)-fac)
 
4031
  65  continue
 
4032
      g(i)=g(i)*(1d0-x)**n0(i)
 
4033
  60  continue
 
4034
      upv=g(1)
 
4035
      dnv=g(2)
 
4036
      usea=g(4)
 
4037
      dsea=g(8)
 
4038
      str=g(6)
 
4039
      chm=g(5)
 
4040
      glu=g(3) 
 
4041
      bot=g(7)
 
4042
        x=xsave
 
4043
        qsq=q2save
 
4044
      return
 
4045
      end
 
4046
      
 
4047
      subroutine mrs994(x,qsq,upv,dnv,usea,dsea,str,chm,bot,glu)
 
4048
      implicit real*8(a-h,o-z)
 
4049
      parameter(nx=49,nq=37,ntenth=23,np=8)
 
4050
      real*8 f(np,nx,nq+1),qq(nq),xx(nx),g(np),n0(np)
 
4051
      data xx/1d-5,2d-5,4d-5,6d-5,8d-5,
 
4052
     .        1d-4,2d-4,4d-4,6d-4,8d-4,
 
4053
     .        1d-3,2d-3,4d-3,6d-3,8d-3,
 
4054
     .        1d-2,1.4d-2,2d-2,3d-2,4d-2,6d-2,8d-2,
 
4055
     .     .1d0,.125d0,.15d0,.175d0,.2d0,.225d0,.25d0,.275d0,
 
4056
     .     .3d0,.325d0,.35d0,.375d0,.4d0,.425d0,.45d0,.475d0,
 
4057
     .     .5d0,.525d0,.55d0,.575d0,.6d0,.65d0,.7d0,.75d0,
 
4058
     .     .8d0,.9d0,1d0/
 
4059
      data qq/1.25d0,1.5d0,2d0,2.5d0,3.2d0,4d0,5d0,6.4d0,8d0,1d1,
 
4060
     .        1.2d1,1.8d1,2.6d1,4d1,6.4d1,1d2,
 
4061
     .        1.6d2,2.4d2,4d2,6.4d2,1d3,1.8d3,3.2d3,5.6d3,1d4,
 
4062
     .        1.8d4,3.2d4,5.6d4,1d5,1.8d5,3.2d5,5.6d5,1d6,
 
4063
     .        1.8d6,3.2d6,5.6d6,1d7/
 
4064
      data xmin,xmax,qsqmin,qsqmax/1d-5,1d0,1.25d0,1d7/
 
4065
      data n0/3,4,5,9,9,9,9,9/
 
4066
      data init/0/
 
4067
      save
 
4068
      xsave=x
 
4069
      q2save=qsq
 
4070
      if(init.ne.0) goto 10
 
4071
        open(unit=1,file='cor04',status='old')
 
4072
        do 20 n=1,nx-1
 
4073
        do 20 m=1,nq
 
4074
        read(1,50)f(1,n,m),f(2,n,m),f(3,n,m),f(4,n,m),
 
4075
     .            f(5,n,m),f(7,n,m),f(6,n,m),f(8,n,m)
 
4076
c notation: 1=uval 2=val 3=glue 4=usea 5=chm 6=str 7=btm 8=dsea
 
4077
        do 25 i=1,np
 
4078
  25     f(i,n,m)=f(i,n,m)/(1d0-xx(n))**n0(i)
 
4079
  20  continue
 
4080
      call mrscheck(f(1,1,1),34)
 
4081
      do 31 j=1,ntenth-1
 
4082
      xx(j)=dlog10(xx(j)/xx(ntenth))+xx(ntenth)
 
4083
      do 31 i=1,8
 
4084
      if(i.eq.5.or.i.eq.7) goto 31
 
4085
      do 30 k=1,nq
 
4086
  30  f(i,j,k)=dlog10(f(i,j,k)/f(i,ntenth,k))+f(i,ntenth,k)
 
4087
  31  continue
 
4088
  50  format(8f10.5)
 
4089
      do 40 i=1,np
 
4090
      do 40 m=1,nq
 
4091
  40  f(i,nx,m)=0d0
 
4092
      init=1
 
4093
      close(1)
 
4094
  10  continue
 
4095
      if(x.lt.xmin) x=xmin
 
4096
      if(x.gt.xmax) x=xmax
 
4097
      if(qsq.lt.qsqmin) qsq=qsqmin
 
4098
      if(qsq.gt.qsqmax) qsq=qsqmax
 
4099
      xxx=x
 
4100
      if(x.lt.xx(ntenth)) xxx=dlog10(x/xx(ntenth))+xx(ntenth)
 
4101
      n=0
 
4102
  70  n=n+1
 
4103
      if(xxx.gt.xx(n+1)) goto 70
 
4104
      a=(xxx-xx(n))/(xx(n+1)-xx(n))
 
4105
      m=0
 
4106
  80  m=m+1
 
4107
      if(qsq.gt.qq(m+1)) goto 80
 
4108
      b=(qsq-qq(m))/(qq(m+1)-qq(m))
 
4109
      do 60 i=1,np
 
4110
      g(i)= (1d0-a)*(1d0-b)*f(i,n,m)   + (1d0-a)*b*f(i,n,m+1)
 
4111
     .    +       a*(1d0-b)*f(i,n+1,m) +       a*b*f(i,n+1,m+1)
 
4112
      if(n.ge.ntenth) goto 65
 
4113
      if(i.eq.5.or.i.eq.7) goto 65
 
4114
          fac=(1d0-b)*f(i,ntenth,m)+b*f(i,ntenth,m+1)
 
4115
          g(i)=fac*10d0**(g(i)-fac)
 
4116
  65  continue
 
4117
      g(i)=g(i)*(1d0-x)**n0(i)
 
4118
  60  continue
 
4119
      upv=g(1)
 
4120
      dnv=g(2)
 
4121
      usea=g(4)
 
4122
      dsea=g(8)
 
4123
      str=g(6)
 
4124
      chm=g(5)
 
4125
      glu=g(3) 
 
4126
      bot=g(7)
 
4127
        x=xsave
 
4128
        qsq=q2save
 
4129
      return
 
4130
      end
 
4131
      
 
4132
      subroutine mrs995(x,qsq,upv,dnv,usea,dsea,str,chm,bot,glu)
 
4133
      implicit real*8(a-h,o-z)
 
4134
      parameter(nx=49,nq=37,ntenth=23,np=8)
 
4135
      real*8 f(np,nx,nq+1),qq(nq),xx(nx),g(np),n0(np)
 
4136
      data xx/1d-5,2d-5,4d-5,6d-5,8d-5,
 
4137
     .        1d-4,2d-4,4d-4,6d-4,8d-4,
 
4138
     .        1d-3,2d-3,4d-3,6d-3,8d-3,
 
4139
     .        1d-2,1.4d-2,2d-2,3d-2,4d-2,6d-2,8d-2,
 
4140
     .     .1d0,.125d0,.15d0,.175d0,.2d0,.225d0,.25d0,.275d0,
 
4141
     .     .3d0,.325d0,.35d0,.375d0,.4d0,.425d0,.45d0,.475d0,
 
4142
     .     .5d0,.525d0,.55d0,.575d0,.6d0,.65d0,.7d0,.75d0,
 
4143
     .     .8d0,.9d0,1d0/
 
4144
      data qq/1.25d0,1.5d0,2d0,2.5d0,3.2d0,4d0,5d0,6.4d0,8d0,1d1,
 
4145
     .        1.2d1,1.8d1,2.6d1,4d1,6.4d1,1d2,
 
4146
     .        1.6d2,2.4d2,4d2,6.4d2,1d3,1.8d3,3.2d3,5.6d3,1d4,
 
4147
     .        1.8d4,3.2d4,5.6d4,1d5,1.8d5,3.2d5,5.6d5,1d6,
 
4148
     .        1.8d6,3.2d6,5.6d6,1d7/
 
4149
      data xmin,xmax,qsqmin,qsqmax/1d-5,1d0,1.25d0,1d7/
 
4150
      data n0/3,4,5,9,9,9,9,9/
 
4151
      data init/0/
 
4152
      save
 
4153
      xsave=x
 
4154
      q2save=qsq
 
4155
      if(init.ne.0) goto 10
 
4156
        open(unit=1,file='cor05',status='old')
 
4157
        do 20 n=1,nx-1
 
4158
        do 20 m=1,nq
 
4159
        read(1,50)f(1,n,m),f(2,n,m),f(3,n,m),f(4,n,m),
 
4160
     .            f(5,n,m),f(7,n,m),f(6,n,m),f(8,n,m)
 
4161
c notation: 1=uval 2=val 3=glue 4=usea 5=chm 6=str 7=btm 8=dsea
 
4162
        do 25 i=1,np
 
4163
  25     f(i,n,m)=f(i,n,m)/(1d0-xx(n))**n0(i)
 
4164
  20  continue
 
4165
      call mrscheck(f(1,1,1),35)
 
4166
      do 31 j=1,ntenth-1
 
4167
      xx(j)=dlog10(xx(j)/xx(ntenth))+xx(ntenth)
 
4168
      do 31 i=1,8
 
4169
      if(i.eq.5.or.i.eq.7) goto 31
 
4170
      do 30 k=1,nq
 
4171
  30  f(i,j,k)=dlog10(f(i,j,k)/f(i,ntenth,k))+f(i,ntenth,k)
 
4172
  31  continue
 
4173
  50  format(8f10.5)
 
4174
      do 40 i=1,np
 
4175
      do 40 m=1,nq
 
4176
  40  f(i,nx,m)=0d0
 
4177
      init=1
 
4178
      close(1)
 
4179
  10  continue
 
4180
      if(x.lt.xmin) x=xmin
 
4181
      if(x.gt.xmax) x=xmax
 
4182
      if(qsq.lt.qsqmin) qsq=qsqmin
 
4183
      if(qsq.gt.qsqmax) qsq=qsqmax
 
4184
      xxx=x
 
4185
      if(x.lt.xx(ntenth)) xxx=dlog10(x/xx(ntenth))+xx(ntenth)
 
4186
      n=0
 
4187
  70  n=n+1
 
4188
      if(xxx.gt.xx(n+1)) goto 70
 
4189
      a=(xxx-xx(n))/(xx(n+1)-xx(n))
 
4190
      m=0
 
4191
  80  m=m+1
 
4192
      if(qsq.gt.qq(m+1)) goto 80
 
4193
      b=(qsq-qq(m))/(qq(m+1)-qq(m))
 
4194
      do 60 i=1,np
 
4195
      g(i)= (1d0-a)*(1d0-b)*f(i,n,m)   + (1d0-a)*b*f(i,n,m+1)
 
4196
     .    +       a*(1d0-b)*f(i,n+1,m) +       a*b*f(i,n+1,m+1)
 
4197
      if(n.ge.ntenth) goto 65
 
4198
      if(i.eq.5.or.i.eq.7) goto 65
 
4199
          fac=(1d0-b)*f(i,ntenth,m)+b*f(i,ntenth,m+1)
 
4200
          g(i)=fac*10d0**(g(i)-fac)
 
4201
  65  continue
 
4202
      g(i)=g(i)*(1d0-x)**n0(i)
 
4203
  60  continue
 
4204
      upv=g(1)
 
4205
      dnv=g(2)
 
4206
      usea=g(4)
 
4207
      dsea=g(8)
 
4208
      str=g(6)
 
4209
      chm=g(5)
 
4210
      glu=g(3) 
 
4211
      bot=g(7)
 
4212
        x=xsave
 
4213
        qsq=q2save
 
4214
      return
 
4215
      end
 
4216
      
 
4217
      subroutine mrs996(x,qsq,upv,dnv,usea,dsea,str,chm,bot,glu)
 
4218
      implicit real*8(a-h,o-z)
 
4219
      parameter(nx=49,nq=37,ntenth=23,np=8)
 
4220
      real*8 f(np,nx,nq+1),qq(nq),xx(nx),g(np),n0(np)
 
4221
      data xx/1d-5,2d-5,4d-5,6d-5,8d-5,
 
4222
     .        1d-4,2d-4,4d-4,6d-4,8d-4,
 
4223
     .        1d-3,2d-3,4d-3,6d-3,8d-3,
 
4224
     .        1d-2,1.4d-2,2d-2,3d-2,4d-2,6d-2,8d-2,
 
4225
     .     .1d0,.125d0,.15d0,.175d0,.2d0,.225d0,.25d0,.275d0,
 
4226
     .     .3d0,.325d0,.35d0,.375d0,.4d0,.425d0,.45d0,.475d0,
 
4227
     .     .5d0,.525d0,.55d0,.575d0,.6d0,.65d0,.7d0,.75d0,
 
4228
     .     .8d0,.9d0,1d0/
 
4229
      data qq/1.25d0,1.5d0,2d0,2.5d0,3.2d0,4d0,5d0,6.4d0,8d0,1d1,
 
4230
     .        1.2d1,1.8d1,2.6d1,4d1,6.4d1,1d2,
 
4231
     .        1.6d2,2.4d2,4d2,6.4d2,1d3,1.8d3,3.2d3,5.6d3,1d4,
 
4232
     .        1.8d4,3.2d4,5.6d4,1d5,1.8d5,3.2d5,5.6d5,1d6,
 
4233
     .        1.8d6,3.2d6,5.6d6,1d7/
 
4234
      data xmin,xmax,qsqmin,qsqmax/1d-5,1d0,1.25d0,1d7/
 
4235
      data n0/3,4,5,9,9,9,9,9/
 
4236
      data init/0/
 
4237
      save
 
4238
      xsave=x
 
4239
      q2save=qsq
 
4240
      if(init.ne.0) goto 10
 
4241
        open(unit=1,file='cor06',status='old')
 
4242
        do 20 n=1,nx-1
 
4243
        do 20 m=1,nq
 
4244
        read(1,50)f(1,n,m),f(2,n,m),f(3,n,m),f(4,n,m),
 
4245
     .            f(5,n,m),f(7,n,m),f(6,n,m),f(8,n,m)
 
4246
c notation: 1=uval 2=val 3=glue 4=usea 5=chm 6=str 7=btm 8=dsea
 
4247
        do 25 i=1,np
 
4248
  25     f(i,n,m)=f(i,n,m)/(1d0-xx(n))**n0(i)
 
4249
  20  continue
 
4250
      call mrscheck(f(2,1,1),36)
 
4251
      do 31 j=1,ntenth-1
 
4252
      xx(j)=dlog10(xx(j)/xx(ntenth))+xx(ntenth)
 
4253
      do 31 i=1,8
 
4254
      if(i.eq.5.or.i.eq.7) goto 31
 
4255
      do 30 k=1,nq
 
4256
  30  f(i,j,k)=dlog10(f(i,j,k)/f(i,ntenth,k))+f(i,ntenth,k)
 
4257
  31  continue
 
4258
  50  format(8f10.5)
 
4259
      do 40 i=1,np
 
4260
      do 40 m=1,nq
 
4261
  40  f(i,nx,m)=0d0
 
4262
      init=1
 
4263
      close(1)
 
4264
  10  continue
 
4265
      if(x.lt.xmin) x=xmin
 
4266
      if(x.gt.xmax) x=xmax
 
4267
      if(qsq.lt.qsqmin) qsq=qsqmin
 
4268
      if(qsq.gt.qsqmax) qsq=qsqmax
 
4269
      xxx=x
 
4270
      if(x.lt.xx(ntenth)) xxx=dlog10(x/xx(ntenth))+xx(ntenth)
 
4271
      n=0
 
4272
  70  n=n+1
 
4273
      if(xxx.gt.xx(n+1)) goto 70
 
4274
      a=(xxx-xx(n))/(xx(n+1)-xx(n))
 
4275
      m=0
 
4276
  80  m=m+1
 
4277
      if(qsq.gt.qq(m+1)) goto 80
 
4278
      b=(qsq-qq(m))/(qq(m+1)-qq(m))
 
4279
      do 60 i=1,np
 
4280
      g(i)= (1d0-a)*(1d0-b)*f(i,n,m)   + (1d0-a)*b*f(i,n,m+1)
 
4281
     .    +       a*(1d0-b)*f(i,n+1,m) +       a*b*f(i,n+1,m+1)
 
4282
      if(n.ge.ntenth) goto 65
 
4283
      if(i.eq.5.or.i.eq.7) goto 65
 
4284
          fac=(1d0-b)*f(i,ntenth,m)+b*f(i,ntenth,m+1)
 
4285
          g(i)=fac*10d0**(g(i)-fac)
 
4286
  65  continue
 
4287
      g(i)=g(i)*(1d0-x)**n0(i)
 
4288
  60  continue
 
4289
      upv=g(1)
 
4290
      dnv=g(2)
 
4291
      usea=g(4)
 
4292
      dsea=g(8)
 
4293
      str=g(6)
 
4294
      chm=g(5)
 
4295
      glu=g(3) 
 
4296
      bot=g(7)
 
4297
        x=xsave
 
4298
        qsq=q2save
 
4299
      return
 
4300
      end
 
4301
      
 
4302
      subroutine mrs997(x,qsq,upv,dnv,usea,dsea,str,chm,bot,glu)
 
4303
      implicit real*8(a-h,o-z)
 
4304
      parameter(nx=49,nq=37,ntenth=23,np=8)
 
4305
      real*8 f(np,nx,nq+1),qq(nq),xx(nx),g(np),n0(np)
 
4306
      data xx/1d-5,2d-5,4d-5,6d-5,8d-5,
 
4307
     .        1d-4,2d-4,4d-4,6d-4,8d-4,
 
4308
     .        1d-3,2d-3,4d-3,6d-3,8d-3,
 
4309
     .        1d-2,1.4d-2,2d-2,3d-2,4d-2,6d-2,8d-2,
 
4310
     .     .1d0,.125d0,.15d0,.175d0,.2d0,.225d0,.25d0,.275d0,
 
4311
     .     .3d0,.325d0,.35d0,.375d0,.4d0,.425d0,.45d0,.475d0,
 
4312
     .     .5d0,.525d0,.55d0,.575d0,.6d0,.65d0,.7d0,.75d0,
 
4313
     .     .8d0,.9d0,1d0/
 
4314
      data qq/1.25d0,1.5d0,2d0,2.5d0,3.2d0,4d0,5d0,6.4d0,8d0,1d1,
 
4315
     .        1.2d1,1.8d1,2.6d1,4d1,6.4d1,1d2,
 
4316
     .        1.6d2,2.4d2,4d2,6.4d2,1d3,1.8d3,3.2d3,5.6d3,1d4,
 
4317
     .        1.8d4,3.2d4,5.6d4,1d5,1.8d5,3.2d5,5.6d5,1d6,
 
4318
     .        1.8d6,3.2d6,5.6d6,1d7/
 
4319
      data xmin,xmax,qsqmin,qsqmax/1d-5,1d0,1.25d0,1d7/
 
4320
      data n0/3,4,5,9,9,9,9,9/
 
4321
      data init/0/
 
4322
      save
 
4323
      xsave=x
 
4324
      q2save=qsq
 
4325
      if(init.ne.0) goto 10
 
4326
        open(unit=1,file='cor07',status='old')
 
4327
        do 20 n=1,nx-1
 
4328
        do 20 m=1,nq
 
4329
        read(1,50)f(1,n,m),f(2,n,m),f(3,n,m),f(4,n,m),
 
4330
     .            f(5,n,m),f(7,n,m),f(6,n,m),f(8,n,m)
 
4331
c notation: 1=uval 2=val 3=glue 4=usea 5=chm 6=str 7=btm 8=dsea
 
4332
        do 25 i=1,np
 
4333
  25     f(i,n,m)=f(i,n,m)/(1d0-xx(n))**n0(i)
 
4334
  20  continue
 
4335
      call mrscheck(f(1,1,1),37)
 
4336
      do 31 j=1,ntenth-1
 
4337
      xx(j)=dlog10(xx(j)/xx(ntenth))+xx(ntenth)
 
4338
      do 31 i=1,8
 
4339
      if(i.eq.5.or.i.eq.7) goto 31
 
4340
      do 30 k=1,nq
 
4341
  30  f(i,j,k)=dlog10(f(i,j,k)/f(i,ntenth,k))+f(i,ntenth,k)
 
4342
  31  continue
 
4343
  50  format(8f10.5)
 
4344
      do 40 i=1,np
 
4345
      do 40 m=1,nq
 
4346
  40  f(i,nx,m)=0d0
 
4347
      init=1
 
4348
      close(1)
 
4349
  10  continue
 
4350
      if(x.lt.xmin) x=xmin
 
4351
      if(x.gt.xmax) x=xmax
 
4352
      if(qsq.lt.qsqmin) qsq=qsqmin
 
4353
      if(qsq.gt.qsqmax) qsq=qsqmax
 
4354
      xxx=x
 
4355
      if(x.lt.xx(ntenth)) xxx=dlog10(x/xx(ntenth))+xx(ntenth)
 
4356
      n=0
 
4357
  70  n=n+1
 
4358
      if(xxx.gt.xx(n+1)) goto 70
 
4359
      a=(xxx-xx(n))/(xx(n+1)-xx(n))
 
4360
      m=0
 
4361
  80  m=m+1
 
4362
      if(qsq.gt.qq(m+1)) goto 80
 
4363
      b=(qsq-qq(m))/(qq(m+1)-qq(m))
 
4364
      do 60 i=1,np
 
4365
      g(i)= (1d0-a)*(1d0-b)*f(i,n,m)   + (1d0-a)*b*f(i,n,m+1)
 
4366
     .    +       a*(1d0-b)*f(i,n+1,m) +       a*b*f(i,n+1,m+1)
 
4367
      if(n.ge.ntenth) goto 65
 
4368
      if(i.eq.5.or.i.eq.7) goto 65
 
4369
          fac=(1d0-b)*f(i,ntenth,m)+b*f(i,ntenth,m+1)
 
4370
          g(i)=fac*10d0**(g(i)-fac)
 
4371
  65  continue
 
4372
      g(i)=g(i)*(1d0-x)**n0(i)
 
4373
  60  continue
 
4374
      upv=g(1)
 
4375
      dnv=g(2)
 
4376
      usea=g(4)
 
4377
      dsea=g(8)
 
4378
      str=g(6)
 
4379
      chm=g(5)
 
4380
      glu=g(3) 
 
4381
      bot=g(7)
 
4382
        x=xsave
 
4383
        qsq=q2save
 
4384
      return
 
4385
      end
 
4386
      
 
4387
      subroutine mrs998(x,qsq,upv,dnv,usea,dsea,str,chm,bot,glu)
 
4388
      implicit real*8(a-h,o-z)
 
4389
      parameter(nx=49,nq=37,ntenth=23,np=8)
 
4390
      real*8 f(np,nx,nq+1),qq(nq),xx(nx),g(np),n0(np)
 
4391
      data xx/1d-5,2d-5,4d-5,6d-5,8d-5,
 
4392
     .        1d-4,2d-4,4d-4,6d-4,8d-4,
 
4393
     .        1d-3,2d-3,4d-3,6d-3,8d-3,
 
4394
     .        1d-2,1.4d-2,2d-2,3d-2,4d-2,6d-2,8d-2,
 
4395
     .     .1d0,.125d0,.15d0,.175d0,.2d0,.225d0,.25d0,.275d0,
 
4396
     .     .3d0,.325d0,.35d0,.375d0,.4d0,.425d0,.45d0,.475d0,
 
4397
     .     .5d0,.525d0,.55d0,.575d0,.6d0,.65d0,.7d0,.75d0,
 
4398
     .     .8d0,.9d0,1d0/
 
4399
      data qq/1.25d0,1.5d0,2d0,2.5d0,3.2d0,4d0,5d0,6.4d0,8d0,1d1,
 
4400
     .        1.2d1,1.8d1,2.6d1,4d1,6.4d1,1d2,
 
4401
     .        1.6d2,2.4d2,4d2,6.4d2,1d3,1.8d3,3.2d3,5.6d3,1d4,
 
4402
     .        1.8d4,3.2d4,5.6d4,1d5,1.8d5,3.2d5,5.6d5,1d6,
 
4403
     .        1.8d6,3.2d6,5.6d6,1d7/
 
4404
      data xmin,xmax,qsqmin,qsqmax/1d-5,1d0,1.25d0,1d7/
 
4405
      data n0/3,4,5,9,9,9,9,9/
 
4406
      data init/0/
 
4407
      save
 
4408
      xsave=x
 
4409
      q2save=qsq
 
4410
      if(init.ne.0) goto 10
 
4411
        open(unit=1,file='cor08',status='old')
 
4412
        do 20 n=1,nx-1
 
4413
        do 20 m=1,nq
 
4414
        read(1,50)f(1,n,m),f(2,n,m),f(3,n,m),f(4,n,m),
 
4415
     .            f(5,n,m),f(7,n,m),f(6,n,m),f(8,n,m)
 
4416
c notation: 1=uval 2=val 3=glue 4=usea 5=chm 6=str 7=btm 8=dsea
 
4417
        do 25 i=1,np
 
4418
  25     f(i,n,m)=f(i,n,m)/(1d0-xx(n))**n0(i)
 
4419
  20  continue
 
4420
      call mrscheck(f(1,1,2),38)
 
4421
      do 31 j=1,ntenth-1
 
4422
      xx(j)=dlog10(xx(j)/xx(ntenth))+xx(ntenth)
 
4423
      do 31 i=1,8
 
4424
      if(i.eq.5.or.i.eq.7) goto 31
 
4425
      do 30 k=1,nq
 
4426
  30  f(i,j,k)=dlog10(f(i,j,k)/f(i,ntenth,k))+f(i,ntenth,k)
 
4427
  31  continue
 
4428
  50  format(8f10.5)
 
4429
      do 40 i=1,np
 
4430
      do 40 m=1,nq
 
4431
  40  f(i,nx,m)=0d0
 
4432
      init=1
 
4433
      close(1)
 
4434
  10  continue
 
4435
      if(x.lt.xmin) x=xmin
 
4436
      if(x.gt.xmax) x=xmax
 
4437
      if(qsq.lt.qsqmin) qsq=qsqmin
 
4438
      if(qsq.gt.qsqmax) qsq=qsqmax
 
4439
      xxx=x
 
4440
      if(x.lt.xx(ntenth)) xxx=dlog10(x/xx(ntenth))+xx(ntenth)
 
4441
      n=0
 
4442
  70  n=n+1
 
4443
      if(xxx.gt.xx(n+1)) goto 70
 
4444
      a=(xxx-xx(n))/(xx(n+1)-xx(n))
 
4445
      m=0
 
4446
  80  m=m+1
 
4447
      if(qsq.gt.qq(m+1)) goto 80
 
4448
      b=(qsq-qq(m))/(qq(m+1)-qq(m))
 
4449
      do 60 i=1,np
 
4450
      g(i)= (1d0-a)*(1d0-b)*f(i,n,m)   + (1d0-a)*b*f(i,n,m+1)
 
4451
     .    +       a*(1d0-b)*f(i,n+1,m) +       a*b*f(i,n+1,m+1)
 
4452
      if(n.ge.ntenth) goto 65
 
4453
      if(i.eq.5.or.i.eq.7) goto 65
 
4454
          fac=(1d0-b)*f(i,ntenth,m)+b*f(i,ntenth,m+1)
 
4455
          g(i)=fac*10d0**(g(i)-fac)
 
4456
  65  continue
 
4457
      g(i)=g(i)*(1d0-x)**n0(i)
 
4458
  60  continue
 
4459
      upv=g(1)
 
4460
      dnv=g(2)
 
4461
      usea=g(4)
 
4462
      dsea=g(8)
 
4463
      str=g(6)
 
4464
      chm=g(5)
 
4465
      glu=g(3) 
 
4466
      bot=g(7)
 
4467
        x=xsave
 
4468
        qsq=q2save
 
4469
      return
 
4470
      end
 
4471
      
 
4472
      subroutine mrs999(x,qsq,upv,dnv,usea,dsea,str,chm,bot,glu)
 
4473
      implicit real*8(a-h,o-z)
 
4474
      parameter(nx=49,nq=37,ntenth=23,np=8)
 
4475
      real*8 f(np,nx,nq+1),qq(nq),xx(nx),g(np),n0(np)
 
4476
      data xx/1d-5,2d-5,4d-5,6d-5,8d-5,
 
4477
     .        1d-4,2d-4,4d-4,6d-4,8d-4,
 
4478
     .        1d-3,2d-3,4d-3,6d-3,8d-3,
 
4479
     .        1d-2,1.4d-2,2d-2,3d-2,4d-2,6d-2,8d-2,
 
4480
     .     .1d0,.125d0,.15d0,.175d0,.2d0,.225d0,.25d0,.275d0,
 
4481
     .     .3d0,.325d0,.35d0,.375d0,.4d0,.425d0,.45d0,.475d0,
 
4482
     .     .5d0,.525d0,.55d0,.575d0,.6d0,.65d0,.7d0,.75d0,
 
4483
     .     .8d0,.9d0,1d0/
 
4484
      data qq/1.25d0,1.5d0,2d0,2.5d0,3.2d0,4d0,5d0,6.4d0,8d0,1d1,
 
4485
     .        1.2d1,1.8d1,2.6d1,4d1,6.4d1,1d2,
 
4486
     .        1.6d2,2.4d2,4d2,6.4d2,1d3,1.8d3,3.2d3,5.6d3,1d4,
 
4487
     .        1.8d4,3.2d4,5.6d4,1d5,1.8d5,3.2d5,5.6d5,1d6,
 
4488
     .        1.8d6,3.2d6,5.6d6,1d7/
 
4489
      data xmin,xmax,qsqmin,qsqmax/1d-5,1d0,1.25d0,1d7/
 
4490
      data n0/3,4,5,9,9,9,9,9/
 
4491
      data init/0/
 
4492
      save
 
4493
      xsave=x
 
4494
      q2save=qsq
 
4495
      if(init.ne.0) goto 10
 
4496
        open(unit=1,file='cor09',status='old')
 
4497
        do 20 n=1,nx-1
 
4498
        do 20 m=1,nq
 
4499
        read(1,50)f(1,n,m),f(2,n,m),f(3,n,m),f(4,n,m),
 
4500
     .            f(5,n,m),f(7,n,m),f(6,n,m),f(8,n,m)
 
4501
c notation: 1=uval 2=val 3=glue 4=usea 5=chm 6=str 7=btm 8=dsea
 
4502
        do 25 i=1,np
 
4503
  25     f(i,n,m)=f(i,n,m)/(1d0-xx(n))**n0(i)
 
4504
  20  continue
 
4505
      call mrscheck(f(4,1,1)*(1d0-xx(1))**n0(4),39)
 
4506
      do 31 j=1,ntenth-1
 
4507
      xx(j)=dlog10(xx(j)/xx(ntenth))+xx(ntenth)
 
4508
      do 31 i=1,8
 
4509
      if(i.eq.5.or.i.eq.7) goto 31
 
4510
      do 30 k=1,nq
 
4511
  30  f(i,j,k)=dlog10(f(i,j,k)/f(i,ntenth,k))+f(i,ntenth,k)
 
4512
  31  continue
 
4513
  50  format(8f10.5)
 
4514
      do 40 i=1,np
 
4515
      do 40 m=1,nq
 
4516
  40  f(i,nx,m)=0d0
 
4517
      init=1
 
4518
      close(1)
 
4519
  10  continue
 
4520
      if(x.lt.xmin) x=xmin
 
4521
      if(x.gt.xmax) x=xmax
 
4522
      if(qsq.lt.qsqmin) qsq=qsqmin
 
4523
      if(qsq.gt.qsqmax) qsq=qsqmax
 
4524
      xxx=x
 
4525
      if(x.lt.xx(ntenth)) xxx=dlog10(x/xx(ntenth))+xx(ntenth)
 
4526
      n=0
 
4527
  70  n=n+1
 
4528
      if(xxx.gt.xx(n+1)) goto 70
 
4529
      a=(xxx-xx(n))/(xx(n+1)-xx(n))
 
4530
      m=0
 
4531
  80  m=m+1
 
4532
      if(qsq.gt.qq(m+1)) goto 80
 
4533
      b=(qsq-qq(m))/(qq(m+1)-qq(m))
 
4534
      do 60 i=1,np
 
4535
      g(i)= (1d0-a)*(1d0-b)*f(i,n,m)   + (1d0-a)*b*f(i,n,m+1)
 
4536
     .    +       a*(1d0-b)*f(i,n+1,m) +       a*b*f(i,n+1,m+1)
 
4537
      if(n.ge.ntenth) goto 65
 
4538
      if(i.eq.5.or.i.eq.7) goto 65
 
4539
          fac=(1d0-b)*f(i,ntenth,m)+b*f(i,ntenth,m+1)
 
4540
          g(i)=fac*10d0**(g(i)-fac)
 
4541
  65  continue
 
4542
      g(i)=g(i)*(1d0-x)**n0(i)
 
4543
  60  continue
 
4544
      upv=g(1)
 
4545
      dnv=g(2)
 
4546
      usea=g(4)
 
4547
      dsea=g(8)
 
4548
      str=g(6)
 
4549
      chm=g(5)
 
4550
      glu=g(3) 
 
4551
      bot=g(7)
 
4552
        x=xsave
 
4553
        qsq=q2save
 
4554
      return
 
4555
      end
 
4556
      
 
4557
      subroutine mrs9910(x,qsq,upv,dnv,usea,dsea,str,chm,bot,glu)
 
4558
      implicit real*8(a-h,o-z)
 
4559
      parameter(nx=49,nq=37,ntenth=23,np=8)
 
4560
      real*8 f(np,nx,nq+1),qq(nq),xx(nx),g(np),n0(np)
 
4561
      data xx/1d-5,2d-5,4d-5,6d-5,8d-5,
 
4562
     .        1d-4,2d-4,4d-4,6d-4,8d-4,
 
4563
     .        1d-3,2d-3,4d-3,6d-3,8d-3,
 
4564
     .        1d-2,1.4d-2,2d-2,3d-2,4d-2,6d-2,8d-2,
 
4565
     .     .1d0,.125d0,.15d0,.175d0,.2d0,.225d0,.25d0,.275d0,
 
4566
     .     .3d0,.325d0,.35d0,.375d0,.4d0,.425d0,.45d0,.475d0,
 
4567
     .     .5d0,.525d0,.55d0,.575d0,.6d0,.65d0,.7d0,.75d0,
 
4568
     .     .8d0,.9d0,1d0/
 
4569
      data qq/1.25d0,1.5d0,2d0,2.5d0,3.2d0,4d0,5d0,6.4d0,8d0,1d1,
 
4570
     .        1.2d1,1.8d1,2.6d1,4d1,6.4d1,1d2,
 
4571
     .        1.6d2,2.4d2,4d2,6.4d2,1d3,1.8d3,3.2d3,5.6d3,1d4,
 
4572
     .        1.8d4,3.2d4,5.6d4,1d5,1.8d5,3.2d5,5.6d5,1d6,
 
4573
     .        1.8d6,3.2d6,5.6d6,1d7/
 
4574
      data xmin,xmax,qsqmin,qsqmax/1d-5,1d0,1.25d0,1d7/
 
4575
      data n0/3,4,5,9,9,9,9,9/
 
4576
      data init/0/
 
4577
      save
 
4578
      xsave=x
 
4579
      q2save=qsq
 
4580
      if(init.ne.0) goto 10
 
4581
        open(unit=1,file='cor10',status='old')
 
4582
        do 20 n=1,nx-1
 
4583
        do 20 m=1,nq
 
4584
        read(1,50)f(1,n,m),f(2,n,m),f(3,n,m),f(4,n,m),
 
4585
     .            f(5,n,m),f(7,n,m),f(6,n,m),f(8,n,m)
 
4586
c notation: 1=uval 2=val 3=glue 4=usea 5=chm 6=str 7=btm 8=dsea
 
4587
        do 25 i=1,np
 
4588
  25     f(i,n,m)=f(i,n,m)/(1d0-xx(n))**n0(i)
 
4589
  20  continue
 
4590
      call mrscheck(f(1,1,1),40)
 
4591
      do 31 j=1,ntenth-1
 
4592
      xx(j)=dlog10(xx(j)/xx(ntenth))+xx(ntenth)
 
4593
      do 31 i=1,8
 
4594
      if(i.eq.5.or.i.eq.7) goto 31
 
4595
      do 30 k=1,nq
 
4596
  30  f(i,j,k)=dlog10(f(i,j,k)/f(i,ntenth,k))+f(i,ntenth,k)
 
4597
  31  continue
 
4598
  50  format(8f10.5)
 
4599
      do 40 i=1,np
 
4600
      do 40 m=1,nq
 
4601
  40  f(i,nx,m)=0d0
 
4602
      init=1
 
4603
      close(1)
 
4604
  10  continue
 
4605
      if(x.lt.xmin) x=xmin
 
4606
      if(x.gt.xmax) x=xmax
 
4607
      if(qsq.lt.qsqmin) qsq=qsqmin
 
4608
      if(qsq.gt.qsqmax) qsq=qsqmax
 
4609
      xxx=x
 
4610
      if(x.lt.xx(ntenth)) xxx=dlog10(x/xx(ntenth))+xx(ntenth)
 
4611
      n=0
 
4612
  70  n=n+1
 
4613
      if(xxx.gt.xx(n+1)) goto 70
 
4614
      a=(xxx-xx(n))/(xx(n+1)-xx(n))
 
4615
      m=0
 
4616
  80  m=m+1
 
4617
      if(qsq.gt.qq(m+1)) goto 80
 
4618
      b=(qsq-qq(m))/(qq(m+1)-qq(m))
 
4619
      do 60 i=1,np
 
4620
      g(i)= (1d0-a)*(1d0-b)*f(i,n,m)   + (1d0-a)*b*f(i,n,m+1)
 
4621
     .    +       a*(1d0-b)*f(i,n+1,m) +       a*b*f(i,n+1,m+1)
 
4622
      if(n.ge.ntenth) goto 65
 
4623
      if(i.eq.5.or.i.eq.7) goto 65
 
4624
          fac=(1d0-b)*f(i,ntenth,m)+b*f(i,ntenth,m+1)
 
4625
          g(i)=fac*10d0**(g(i)-fac)
 
4626
  65  continue
 
4627
      g(i)=g(i)*(1d0-x)**n0(i)
 
4628
  60  continue
 
4629
      upv=g(1)
 
4630
      dnv=g(2)
 
4631
      usea=g(4)
 
4632
      dsea=g(8)
 
4633
      str=g(6)
 
4634
      chm=g(5)
 
4635
      glu=g(3) 
 
4636
      bot=g(7)
 
4637
        x=xsave
 
4638
        qsq=q2save
 
4639
      return
 
4640
      end
 
4641
      
 
4642
      subroutine mrs9911(x,qsq,upv,dnv,usea,dsea,str,chm,bot,glu)
 
4643
      implicit real*8(a-h,o-z)
 
4644
      parameter(nx=49,nq=37,ntenth=23,np=8)
 
4645
      real*8 f(np,nx,nq+1),qq(nq),xx(nx),g(np),n0(np)
 
4646
      data xx/1d-5,2d-5,4d-5,6d-5,8d-5,
 
4647
     .        1d-4,2d-4,4d-4,6d-4,8d-4,
 
4648
     .        1d-3,2d-3,4d-3,6d-3,8d-3,
 
4649
     .        1d-2,1.4d-2,2d-2,3d-2,4d-2,6d-2,8d-2,
 
4650
     .     .1d0,.125d0,.15d0,.175d0,.2d0,.225d0,.25d0,.275d0,
 
4651
     .     .3d0,.325d0,.35d0,.375d0,.4d0,.425d0,.45d0,.475d0,
 
4652
     .     .5d0,.525d0,.55d0,.575d0,.6d0,.65d0,.7d0,.75d0,
 
4653
     .     .8d0,.9d0,1d0/
 
4654
      data qq/1.25d0,1.5d0,2d0,2.5d0,3.2d0,4d0,5d0,6.4d0,8d0,1d1,
 
4655
     .        1.2d1,1.8d1,2.6d1,4d1,6.4d1,1d2,
 
4656
     .        1.6d2,2.4d2,4d2,6.4d2,1d3,1.8d3,3.2d3,5.6d3,1d4,
 
4657
     .        1.8d4,3.2d4,5.6d4,1d5,1.8d5,3.2d5,5.6d5,1d6,
 
4658
     .        1.8d6,3.2d6,5.6d6,1d7/
 
4659
      data xmin,xmax,qsqmin,qsqmax/1d-5,1d0,1.25d0,1d7/
 
4660
      data n0/3,4,5,9,9,9,9,9/
 
4661
      data init/0/
 
4662
      save
 
4663
      xsave=x
 
4664
      q2save=qsq
 
4665
      if(init.ne.0) goto 10
 
4666
        open(unit=1,file='cor11',status='old')
 
4667
        do 20 n=1,nx-1
 
4668
        do 20 m=1,nq
 
4669
        read(1,50)f(1,n,m),f(2,n,m),f(3,n,m),f(4,n,m),
 
4670
     .            f(5,n,m),f(7,n,m),f(6,n,m),f(8,n,m)
 
4671
c notation: 1=uval 2=val 3=glue 4=usea 5=chm 6=str 7=btm 8=dsea
 
4672
        do 25 i=1,np
 
4673
  25     f(i,n,m)=f(i,n,m)/(1d0-xx(n))**n0(i)
 
4674
  20  continue
 
4675
      call mrscheck(f(4,1,1)*(1d0-xx(1))**n0(4),41)
 
4676
      do 31 j=1,ntenth-1
 
4677
      xx(j)=dlog10(xx(j)/xx(ntenth))+xx(ntenth)
 
4678
      do 31 i=1,8
 
4679
      if(i.eq.5.or.i.eq.7) goto 31
 
4680
      do 30 k=1,nq
 
4681
  30  f(i,j,k)=dlog10(f(i,j,k)/f(i,ntenth,k))+f(i,ntenth,k)
 
4682
  31  continue
 
4683
  50  format(8f10.5)
 
4684
      do 40 i=1,np
 
4685
      do 40 m=1,nq
 
4686
  40  f(i,nx,m)=0d0
 
4687
      init=1
 
4688
      close(1)
 
4689
  10  continue
 
4690
      if(x.lt.xmin) x=xmin
 
4691
      if(x.gt.xmax) x=xmax
 
4692
      if(qsq.lt.qsqmin) qsq=qsqmin
 
4693
      if(qsq.gt.qsqmax) qsq=qsqmax
 
4694
      xxx=x
 
4695
      if(x.lt.xx(ntenth)) xxx=dlog10(x/xx(ntenth))+xx(ntenth)
 
4696
      n=0
 
4697
  70  n=n+1
 
4698
      if(xxx.gt.xx(n+1)) goto 70
 
4699
      a=(xxx-xx(n))/(xx(n+1)-xx(n))
 
4700
      m=0
 
4701
  80  m=m+1
 
4702
      if(qsq.gt.qq(m+1)) goto 80
 
4703
      b=(qsq-qq(m))/(qq(m+1)-qq(m))
 
4704
      do 60 i=1,np
 
4705
      g(i)= (1d0-a)*(1d0-b)*f(i,n,m)   + (1d0-a)*b*f(i,n,m+1)
 
4706
     .    +       a*(1d0-b)*f(i,n+1,m) +       a*b*f(i,n+1,m+1)
 
4707
      if(n.ge.ntenth) goto 65
 
4708
      if(i.eq.5.or.i.eq.7) goto 65
 
4709
          fac=(1d0-b)*f(i,ntenth,m)+b*f(i,ntenth,m+1)
 
4710
          g(i)=fac*10d0**(g(i)-fac)
 
4711
  65  continue
 
4712
      g(i)=g(i)*(1d0-x)**n0(i)
 
4713
  60  continue
 
4714
      upv=g(1)
 
4715
      dnv=g(2)
 
4716
      usea=g(4)
 
4717
      dsea=g(8)
 
4718
      str=g(6)
 
4719
      chm=g(5)
 
4720
      glu=g(3) 
 
4721
      bot=g(7)
 
4722
        x=xsave
 
4723
        qsq=q2save
 
4724
      return
 
4725
      end
 
4726
      
 
4727
      subroutine mrs9912(x,qsq,upv,dnv,usea,dsea,str,chm,bot,glu)
 
4728
      implicit real*8(a-h,o-z)
 
4729
      parameter(nx=49,nq=37,ntenth=23,np=8)
 
4730
      real*8 f(np,nx,nq+1),qq(nq),xx(nx),g(np),n0(np)
 
4731
      data xx/1d-5,2d-5,4d-5,6d-5,8d-5,
 
4732
     .        1d-4,2d-4,4d-4,6d-4,8d-4,
 
4733
     .        1d-3,2d-3,4d-3,6d-3,8d-3,
 
4734
     .        1d-2,1.4d-2,2d-2,3d-2,4d-2,6d-2,8d-2,
 
4735
     .     .1d0,.125d0,.15d0,.175d0,.2d0,.225d0,.25d0,.275d0,
 
4736
     .     .3d0,.325d0,.35d0,.375d0,.4d0,.425d0,.45d0,.475d0,
 
4737
     .     .5d0,.525d0,.55d0,.575d0,.6d0,.65d0,.7d0,.75d0,
 
4738
     .     .8d0,.9d0,1d0/
 
4739
      data qq/1.25d0,1.5d0,2d0,2.5d0,3.2d0,4d0,5d0,6.4d0,8d0,1d1,
 
4740
     .        1.2d1,1.8d1,2.6d1,4d1,6.4d1,1d2,
 
4741
     .        1.6d2,2.4d2,4d2,6.4d2,1d3,1.8d3,3.2d3,5.6d3,1d4,
 
4742
     .        1.8d4,3.2d4,5.6d4,1d5,1.8d5,3.2d5,5.6d5,1d6,
 
4743
     .        1.8d6,3.2d6,5.6d6,1d7/
 
4744
      data xmin,xmax,qsqmin,qsqmax/1d-5,1d0,1.25d0,1d7/
 
4745
      data n0/3,4,5,9,9,9,9,9/
 
4746
      data init/0/
 
4747
      save
 
4748
      xsave=x
 
4749
      q2save=qsq
 
4750
      if(init.ne.0) goto 10
 
4751
        open(unit=1,file='cor12',status='old')
 
4752
        do 20 n=1,nx-1
 
4753
        do 20 m=1,nq
 
4754
        read(1,50)f(1,n,m),f(2,n,m),f(3,n,m),f(4,n,m),
 
4755
     .            f(5,n,m),f(7,n,m),f(6,n,m),f(8,n,m)
 
4756
c notation: 1=uval 2=val 3=glue 4=usea 5=chm 6=str 7=btm 8=dsea
 
4757
        do 25 i=1,np
 
4758
  25     f(i,n,m)=f(i,n,m)/(1d0-xx(n))**n0(i)
 
4759
  20  continue
 
4760
      call mrscheck(f(1,1,1),42)
 
4761
      do 31 j=1,ntenth-1
 
4762
      xx(j)=dlog10(xx(j)/xx(ntenth))+xx(ntenth)
 
4763
      do 31 i=1,8
 
4764
      if(i.eq.5.or.i.eq.7) goto 31
 
4765
      do 30 k=1,nq
 
4766
  30  f(i,j,k)=dlog10(f(i,j,k)/f(i,ntenth,k))+f(i,ntenth,k)
 
4767
  31  continue
 
4768
  50  format(8f10.5)
 
4769
      do 40 i=1,np
 
4770
      do 40 m=1,nq
 
4771
  40  f(i,nx,m)=0d0
 
4772
      init=1
 
4773
      close(1)
 
4774
  10  continue
 
4775
      if(x.lt.xmin) x=xmin
 
4776
      if(x.gt.xmax) x=xmax
 
4777
      if(qsq.lt.qsqmin) qsq=qsqmin
 
4778
      if(qsq.gt.qsqmax) qsq=qsqmax
 
4779
      xxx=x
 
4780
      if(x.lt.xx(ntenth)) xxx=dlog10(x/xx(ntenth))+xx(ntenth)
 
4781
      n=0
 
4782
  70  n=n+1
 
4783
      if(xxx.gt.xx(n+1)) goto 70
 
4784
      a=(xxx-xx(n))/(xx(n+1)-xx(n))
 
4785
      m=0
 
4786
  80  m=m+1
 
4787
      if(qsq.gt.qq(m+1)) goto 80
 
4788
      b=(qsq-qq(m))/(qq(m+1)-qq(m))
 
4789
      do 60 i=1,np
 
4790
      g(i)= (1d0-a)*(1d0-b)*f(i,n,m)   + (1d0-a)*b*f(i,n,m+1)
 
4791
     .    +       a*(1d0-b)*f(i,n+1,m) +       a*b*f(i,n+1,m+1)
 
4792
      if(n.ge.ntenth) goto 65
 
4793
      if(i.eq.5.or.i.eq.7) goto 65
 
4794
          fac=(1d0-b)*f(i,ntenth,m)+b*f(i,ntenth,m+1)
 
4795
          g(i)=fac*10d0**(g(i)-fac)
 
4796
  65  continue
 
4797
      g(i)=g(i)*(1d0-x)**n0(i)
 
4798
  60  continue
 
4799
      upv=g(1)
 
4800
      dnv=g(2)
 
4801
      usea=g(4)
 
4802
      dsea=g(8)
 
4803
      str=g(6)
 
4804
      chm=g(5)
 
4805
      glu=g(3) 
 
4806
      bot=g(7)
 
4807
        x=xsave
 
4808
        qsq=q2save
 
4809
      return
 
4810
      end
 
4811
c end of MRS99      
 
4812
C
 
4813
C----- END HMRS -------------------------------------------------
 
4814
C------------------------------------------------------------------
 
4815
C
 
4816
C--------------------------------------------------------------------
 
4817
C----- START TUNG AND MORFIN ------------------------------
 
4818
      SUBROUTINE  TUNG(ISET,IH,Q2,X,FX,NF)
 
4819
      REAL FX(-NF:NF)
 
4820
      REAL*8 DX,DQ,PDXMT
 
4821
      IF(ABS(IH).GE.3) CALL NOSETP
 
4822
      IH0=IH
 
4823
      IF(ABS(IH).EQ.2) IH0=ISIGN(1,IH)
 
4824
      Q=SQRT(Q2)
 
4825
      DQ=DBLE(Q)
 
4826
      DX=DBLE(X)
 
4827
      DO I=-2,NF
 
4828
        IF(I.GT.2) THEN
 
4829
                FX(I)   =SNGL(PDXMT(ISET,I,DX,DQ,IRT))
 
4830
                FX(-I)  =FX(I)
 
4831
        ELSE
 
4832
                FX(IH0*I)=SNGL(PDXMT(ISET,I,DX,DQ,IRT))
 
4833
        ENDIF
 
4834
      ENDDO
 
4835
C...TRANSFORM PROTON INTO NEUTRON
 
4836
      IF(ABS(IH).EQ.2) THEN
 
4837
        T=FX(1)
 
4838
        FX(1)=FX(2)
 
4839
        FX(2)=T
 
4840
        T=FX(-1)
 
4841
        FX(-1)=FX(-2)
 
4842
        FX(-2)=T
 
4843
      ENDIF
 
4844
      END
 
4845
 
 
4846
C-------------------------------------------------------------
 
4847
C                                                                 MAY 30 90
 
4848
      FUNCTION PDXMT (ISET, IPARTON, X, Q, IRT)
 
4849
 
 
4850
C             For ISET = 1, 2 .. , returns sets of Parton Distributions
 
4851
C             (in the proton) with parton label Iparton (6, 5, ...,0, ...-6)
 
4852
C             for (t, b, c, s, d, u, g, u-bar, ... t-bar), and kinematic
 
4853
C             variables (X, Q).   IRT is a return error code.
 
4854
C
 
4855
C     Iset =  1, 2, 3, 4 corresponds to the S1, B1, B2, and E1 fits of Morfin-
 
4856
C             Tung (Fermilab-Pub-90/24, IIT-90/11) to NLO in the DIS scheme.
 
4857
C
 
4858
C             5 (Set S1M) corresponds to the same set as 1 (S1) but expressed
 
4859
C             in the MS-bar scheme.
 
4860
C
 
4861
C             All the above sets assume a SU(3)-symmetric sea.
 
4862
 
 
4863
C             6 (Set S2) corresponds to a new set with input strange quark
 
4864
C             distribution being 1/2 of the non-strange sea quarks
 
4865
C             (as prefered by some expts).
 
4866
C
 
4867
C             7 (Set S2M) is the set S2 in the MS-bar scheme
 
4868
C
 
4869
C             8 is currently empty.
 
4870
 
 
4871
C             9 corresponds to a set of LO distributions suitable to be used
 
4872
C             with LO hard scattering matrix elements.
 
4873
C
 
4874
C  The "lambda" parameter (4-flavors) for each parton distribution set can be
 
4875
C  obtained by making the following FUNCTION call:
 
4876
C             Alam = Vlambd (Iset, Iorder)
 
4877
C  where Iset is the (input) set #, Iorder is the (output) order of the fit (1
 
4878
C  for set 9, 2 for all the others), and Alam is the value of the effective QCD
 
4879
C  lambda for 4 flavors.
 
4880
 
 
4881
C             Details about the 1 - 5 distributions are
 
4882
C             given in the above-mentioned preprint.
 
4883
C
 
4884
      IMPLICIT DOUBLE PRECISION (A-H, O-Z)
 
4885
 
 
4886
      DIMENSION  THRSLD(0:6)
 
4887
 
 
4888
      DATA (THRSLD(I), I=0,6) / 4*0.0, 1.5, 5.0, 90.0 /
 
4889
 
 
4890
      IFL = IPARTON
 
4891
      JFL = ABS(IFL)
 
4892
C                                                   Return 0 if below threshold
 
4893
      IF (Q .LE. THRSLD(JFL)) THEN
 
4894
        PDXMT = 0.0
 
4895
        RETURN
 
4896
      ENDIF
 
4897
C                                                                       Valence
 
4898
      IF (IFL .LE. 0) THEN
 
4899
        VL = 0
 
4900
      ELSEIF (IFL .LE. 2) THEN
 
4901
        VL = PDZXMT(ISET, IFL, X, Q, IRT)
 
4902
      ELSE
 
4903
        VL = 0
 
4904
      ENDIF
 
4905
C                                                                         Sea
 
4906
      SEA = PDZXMT (ISET, -JFL, X, Q, IRT)
 
4907
 
 
4908
      PDXMT = VL + SEA
 
4909
 
 
4910
      RETURN
 
4911
C                         *************************
 
4912
      END
 
4913
 
 
4914
      FUNCTION PDZXMT (IST, LP, XX, QQ, IRT)
 
4915
 
 
4916
      IMPLICIT DOUBLE PRECISION (A-H, O-Z)
 
4917
 
 
4918
      PARAMETER (D0=0D0, D1=1D0, D2=2D0, D3=3D0, D4=4D0, D10=1D1)
 
4919
      PARAMETER (NEX = 3, MXFL = 6, NPN = 2, NST = 10)
 
4920
 
 
4921
      DIMENSION
 
4922
     1 AC(0:NEX, 0:NPN, -MXFL:2, NST), A(0:NEX), T(0:NPN), FX(0:NEX),
 
4923
     1 ALM(NST), Q02(NST), MEX(NST), MPN(NST), MQRK(NST), Iord(NST)
 
4924
 
 
4925
      DATA MEX, MPN, MQRK / NST*3, NST*2, NST*6 /
 
4926
C                                          Set S-1:    PDF parameters from /L352
 
4927
      DATA IORD(1), ALM(1), Q02(1) / 2, 0.212d0, 4.00d0 /
 
4928
     > (((AC(IEX,IPN,IFL,1), IEX=0,3), IPN=0,2), IFL=2,-6,-1)
 
4929
     > /  1.34,  0.15,
 
4930
     >    5.30, -1.96, -0.57,  0.16,  0.43,  1.08, -0.08, -0.02,
 
4931
     >    0.06, -0.03,  1.62,  0.11,  3.68, -1.94, -0.33,  0.14,
 
4932
     >    0.53,  0.87, -0.10, -0.01,  0.03,  0.02,  1.88, -0.33,
 
4933
     >    7.52, -1.34, -2.78,  0.10, -1.13,  2.92,  0.13, -0.04,
 
4934
     >    0.04, -0.49, -0.99, -0.33,  8.53, -1.55, -1.54,  0.03,
 
4935
     >   -1.08,  2.02,  0.10, -0.03,  0.39, -0.39, -0.99, -0.33,
 
4936
     >    8.53, -1.55, -1.54,  0.03, -1.08,  2.02,  0.10, -0.03,
 
4937
     >    0.39, -0.39, -0.99, -0.33,  8.53, -1.55, -1.54,  0.03,
 
4938
     >   -1.08,  2.02,  0.10, -0.03,  0.39, -0.39, -3.98, -0.15,
 
4939
     >    7.46,  0.35,  0.72, -0.06,  0.96,  0.89, -0.63,  0.00,
 
4940
     >   -0.30, -0.04, -6.28, -0.18,  6.56,  0.65,  2.62,  0.02,
 
4941
     >    1.40,  1.13, -1.18, -0.03, -0.38, -0.16,-13.08, -0.40,
 
4942
     >   15.35, -0.43,  8.54,  0.31,-11.83,  3.18, -2.70, -0.12,
 
4943
     >    4.16, -0.82 /
 
4944
C                                           Set B1:    PDF parameters from /L212
 
4945
      DATA IORD(2), ALM(2), Q02(2) / 2, 0.194, 4.00 /
 
4946
     > (((AC(IEX,IPN,IFL,2), IEX=0,3), IPN=0,2), IFL=2,-6,-1)
 
4947
     > /  1.30,  0.19,
 
4948
     >    5.24, -1.81, -0.57,  0.15,  0.44,  1.06, -0.09, -0.02,
 
4949
     >    0.05, -0.02,  1.59,  0.14,  3.65, -1.81, -0.34,  0.13,
 
4950
     >    0.53,  0.86, -0.10, -0.01,  0.03,  0.02,  1.48, -0.14,
 
4951
     >    6.75, -0.50, -2.49, -0.11, -0.54,  2.13,  0.04,  0.03,
 
4952
     >   -0.15, -0.24, -1.08, -0.13,  8.40, -0.88, -1.33, -0.21,
 
4953
     >   -0.51,  1.18, -0.03,  0.06,  0.07, -0.05, -1.08, -0.13,
 
4954
     >    8.39, -0.88, -1.33, -0.21, -0.50,  1.18, -0.03,  0.06,
 
4955
     >    0.07, -0.05, -1.08, -0.13,  8.39, -0.88, -1.33, -0.21,
 
4956
     >   -0.50,  1.18, -0.03,  0.06,  0.07, -0.05, -4.22, -0.02,
 
4957
     >    7.29,  0.90,  0.88, -0.17,  1.08,  0.50, -0.69,  0.03,
 
4958
     >   -0.39,  0.08, -6.42, -0.09,  6.47,  1.03,  2.67, -0.03,
 
4959
     >    1.39,  1.00, -1.21, -0.02, -0.42, -0.14,-12.92, -0.36,
 
4960
     >   15.74, -0.30,  8.33,  0.32,-12.73,  3.35, -2.68, -0.13,
 
4961
     >    4.51, -0.91 /
 
4962
C                                             Set B2:  PDF parameters from /L261
 
4963
      DATA IORD(3), ALM(3), Q02(3) / 2, 0.191, 4.00 /
 
4964
     > (((AC(IEX,IPN,IFL,3), IEX=0,3), IPN=0,2), IFL=2,-6,-1)
 
4965
     > /  1.38,  0.18,
 
4966
     >    5.40, -1.91, -0.59,  0.16,  0.42,  1.11, -0.08, -0.02,
 
4967
     >    0.06, -0.03,  1.64,  0.09,  3.74, -2.02, -0.33,  0.14,
 
4968
     >    0.54,  0.88, -0.10, -0.01,  0.03,  0.02,  1.52, -0.72,
 
4969
     >    7.75, -2.18, -2.71,  0.45, -1.56,  3.75,  0.15, -0.15,
 
4970
     >    0.16, -0.76, -0.85, -0.82,  9.19, -2.76, -1.43,  0.35,
 
4971
     >   -0.92,  2.56, -0.03, -0.09,  0.12, -0.40, -0.85, -0.82,
 
4972
     >    9.19, -2.76, -1.43,  0.35, -0.92,  2.56, -0.03, -0.10,
 
4973
     >    0.12, -0.40, -0.85, -0.82,  9.19, -2.76, -1.43,  0.35,
 
4974
     >   -0.92,  2.56, -0.03, -0.10,  0.12, -0.40, -3.74, -0.58,
 
4975
     >    9.63, -1.09,  0.21,  0.24, -1.13,  2.10, -0.50, -0.07,
 
4976
     >    0.25, -0.33, -6.07, -0.52,  8.33, -0.52,  2.33,  0.22,
 
4977
     >    0.28,  1.91, -1.15, -0.07, -0.28, -0.31,-12.08, -0.73,
 
4978
     >   21.14, -1.92,  7.31,  0.54,-19.17,  4.59, -2.35, -0.18,
 
4979
     >    6.64, -1.25 /
 
4980
C                                             Set E1:  PDF parameters from /L152
 
4981
      DATA IORD(4), ALM(4), Q02(4) / 2, 0.155, 4.00 /
 
4982
     > (((AC(IEX,IPN,IFL,4), IEX=0,3), IPN=0,2), IFL=2,-6,-1)
 
4983
     > /  1.43,  0.16,
 
4984
     >    6.17, -1.94, -0.65,  0.16,  0.43,  1.12, -0.08, -0.02,
 
4985
     >    0.06, -0.02,  1.69,  0.11,  3.69, -1.99, -0.33,  0.14,
 
4986
     >    0.54,  0.90, -0.11, -0.01,  0.03,  0.02,  2.11, -0.33,
 
4987
     >    7.93, -1.51, -3.01,  0.10, -1.40,  3.14,  0.18, -0.04,
 
4988
     >    0.09, -0.55, -0.84, -0.32,  8.96, -1.70, -1.65,  0.02,
 
4989
     >   -1.24,  2.15,  0.12, -0.03,  0.45, -0.43, -0.84, -0.32,
 
4990
     >    8.96, -1.70, -1.65,  0.02, -1.24,  2.15,  0.12, -0.03,
 
4991
     >    0.45, -0.43, -0.84, -0.32,  8.96, -1.70, -1.65,  0.02,
 
4992
     >   -1.24,  2.15,  0.12, -0.03,  0.45, -0.43, -3.87, -0.15,
 
4993
     >    7.83,  0.21,  0.85, -0.07,  1.00,  0.93, -0.73,  0.00,
 
4994
     >   -0.36, -0.03, -6.09, -0.17,  6.75,  0.54,  2.81,  0.01,
 
4995
     >    1.74,  1.15, -1.34, -0.03, -0.56, -0.16,-12.56, -0.38,
 
4996
     >   14.62, -0.41,  8.69,  0.30,-11.27,  3.19, -2.93, -0.12,
 
4997
     >    4.29, -0.87 /
 
4998
C                               Set S1M:  PDF parameters from /L352 -- MS-Bar
 
4999
      DATA IORD(5), ALM(5), Q02(5) / 2, 0.212, 4.00 /
 
5000
     > (((AC(IEX,IPN,IFL,5), IEX=0,3), IPN=0,2), IFL=2,-6,-1)
 
5001
     > /  1.75,  0.11,
 
5002
     >    6.20, -2.35, -1.02,  0.26, -0.41,  1.68,  0.05, -0.06,
 
5003
     >    0.29, -0.24,  2.03,  0.06,  4.43, -2.35, -0.78,  0.24,
 
5004
     >   -0.18,  1.52,  0.03, -0.04,  0.22, -0.19,  1.09, -0.24,
 
5005
     >    5.97, -0.64, -2.41,  0.08, -0.90,  2.71, -0.12,  0.02,
 
5006
     >   -0.35, -0.20, -0.14, -0.49, 10.24, -2.57, -1.98,  0.02,
 
5007
     >   -1.43,  2.32,  0.23, -0.02,  0.44, -0.47, -0.14, -0.49,
 
5008
     >   10.24, -2.57, -1.98,  0.02, -1.44,  2.32,  0.23, -0.02,
 
5009
     >    0.45, -0.47, -0.15, -0.49, 10.23, -2.57, -1.98,  0.02,
 
5010
     >   -1.44,  2.32,  0.23, -0.02,  0.45, -0.47, -2.36, -0.49,
 
5011
     >    9.00, -1.74, -1.42,  0.44, -0.46,  3.93,  0.21, -0.22,
 
5012
     >    0.29, -1.34, -2.19, -1.07, 11.30, -4.85, -3.86,  1.56,
 
5013
     >   -7.20, 10.51,  1.57, -0.73,  3.85, -4.36,-24.77,  7.52,
 
5014
     >  -99.51, 36.02,-23.00,  0.48,-16.45, 16.51, 34.44, -6.26,
 
5015
     >   97.19,-40.40 /
 
5016
C                         Set S2 -- 1/2 strange sea;  PDF parameters from /L405
 
5017
 
 
5018
      DATA IORD(6), ALM(6), Q02(6) / 2, 0.237, 4.00 /
 
5019
     > (((AC(IEX,IPN,IFL,6), IEX=0,3), IPN=0,2), IFL=2,-6,-1)
 
5020
     > /  1.42,  0.16,
 
5021
     >    5.40, -1.99, -0.59,  0.17,  0.41,  1.12, -0.08, -0.02,
 
5022
     >    0.06, -0.03,  1.68,  0.08,  3.75, -2.09, -0.33,  0.15,
 
5023
     >    0.53,  0.89, -0.10, -0.01,  0.03,  0.02,  0.90, -0.17,
 
5024
     >    5.27, -0.20, -1.86, -0.10,  0.43,  1.67, -0.09,  0.02,
 
5025
     >   -0.26, -0.14, -1.48, -0.13,  7.83, -0.38, -0.89, -0.19,
 
5026
     >   -0.06,  0.68, -0.12,  0.04,  0.01,  0.05, -1.48, -0.13,
 
5027
     >    7.83, -0.38, -0.89, -0.19, -0.05,  0.68, -0.13,  0.04,
 
5028
     >    0.00,  0.05, -2.26, -0.15,  7.47, -0.23, -0.90, -0.10,
 
5029
     >   -0.61,  1.22, -0.06,  0.01,  0.28, -0.16, -4.68, -0.06,
 
5030
     >    5.55,  1.13,  0.92, -0.12,  1.16,  0.50, -0.62,  0.01,
 
5031
     >   -0.26,  0.03, -6.83, -0.12,  5.24,  1.19,  2.68, -0.01,
 
5032
     >    1.14,  0.93, -1.13, -0.03, -0.24, -0.13,-14.41, -0.28,
 
5033
     >   11.48,  0.65,  9.65,  0.15, -7.50,  1.99, -2.98, -0.06,
 
5034
     >    2.54, -0.43 /
 
5035
C                            Set-S2M: PDF parameters from /L405 FILE   -- MS-BAR
 
5036
      DATA IORD(7), ALM(7), Q02(7) / 2, 0.237, 4.00 /
 
5037
     > (((AC(IEX,IPN,IFL,7), IEX=0,3), IPN=0,2), IFL=2,-6,-1)
 
5038
     > /  1.84,  0.12,
 
5039
     >    6.34, -2.40, -0.97,  0.22, -0.34,  1.53,  0.03, -0.04,
 
5040
     >    0.25, -0.16,  2.08,  0.02,  4.53, -2.51, -0.66,  0.19,
 
5041
     >   -0.04,  1.24, -0.02, -0.01,  0.15, -0.05,  0.31, -0.10,
 
5042
     >    4.18,  0.34, -1.84, -0.10,  0.05,  1.64, -0.06,  0.01,
 
5043
     >   -0.12, -0.16, -1.13, -0.15,  8.43, -0.64, -1.26, -0.16,
 
5044
     >   -0.39,  1.01, -0.01,  0.03,  0.05, -0.06, -1.13, -0.15,
 
5045
     >    8.43, -0.64, -1.26, -0.16, -0.39,  1.01, -0.01,  0.03,
 
5046
     >    0.05, -0.06, -1.82, -0.18,  7.94, -0.56, -1.40, -0.06,
 
5047
     >   -0.82,  1.65,  0.09, -0.01,  0.30, -0.31, -3.69, -0.15,
 
5048
     >    5.72,  0.26, -0.47,  0.04,  0.93,  1.85, -0.10, -0.05,
 
5049
     >   -0.11, -0.50, -5.06, -0.25,  4.42, -0.14,  0.39,  0.16,
 
5050
     >    2.38,  2.72, -0.35, -0.08, -0.63, -0.75, -9.92, -0.38,
 
5051
     >   -1.27, -1.60,  4.60,  0.24,  9.17,  4.40, -1.53, -0.08,
 
5052
     >   -2.88, -1.08 /
 
5053
C                                             Set B0:  PDF parameters from /P154
 
5054
      DATA IORD(8), ALM(8), Q02(8) / 1, 0.144, 4.00 /
 
5055
     > (((AC(IEX,IPN,IFL,8), IEX=0,3), IPN=0,2), IFL=2,-6,-1)
 
5056
     > /  1.38,  0.16,
 
5057
     >    5.40, -1.97, -0.62,  0.19,  0.59,  1.24, -0.10, -0.02,
 
5058
     >    0.03, -0.05,  1.67,  0.08,  3.75, -2.09, -0.33,  0.17,
 
5059
     >    0.70,  0.98, -0.13, -0.01,  0.00,  0.02,  1.52, -0.25,
 
5060
     >    7.01, -0.79, -3.17, -0.01, -0.90,  2.90,  0.25,  0.00,
 
5061
     >   -0.08, -0.54, -0.81, -0.07,  9.19, -0.89, -1.13, -0.46,
 
5062
     >    0.35,  0.33, -0.26,  0.16, -0.49,  0.40, -0.81, -0.07,
 
5063
     >    9.19, -0.89, -1.13, -0.46,  0.35,  0.33, -0.26,  0.16,
 
5064
     >   -0.49,  0.40, -0.81, -0.07,  9.19, -0.89, -1.13, -0.46,
 
5065
     >    0.35,  0.33, -0.26,  0.16, -0.49,  0.40, -3.62, -0.06,
 
5066
     >    8.30,  0.16,  0.03, -0.21, -0.60,  1.26, -0.48,  0.05,
 
5067
     >    0.25, -0.15, -6.16, -0.11,  6.49,  0.71,  2.37, -0.05,
 
5068
     >    1.28,  1.37, -1.24, -0.02, -0.41, -0.26,-12.68, -0.35,
 
5069
     >   14.87, -0.17,  8.36,  0.28,-12.56,  3.39, -2.89, -0.12,
 
5070
     >    4.75, -0.96 /
 
5071
 
 
5072
      IRT = 0
 
5073
      IFL = LP
 
5074
 
 
5075
      X  = XX
 
5076
      Q0 = SQRT (Q02(IST))
 
5077
      ALAM = ALM(IST)
 
5078
      SQ = LOG ( LOG(QQ/ALAM) / LOG(Q0/ALAM) )
 
5079
 
 
5080
      FX(0) = EXP(D1)
 
5081
      FX(1) = X
 
5082
      FX(2) = 1.- X
 
5083
      FX(3) = LOG (1.+ 1./X)
 
5084
 
 
5085
      PDF = 1.
 
5086
      DO 20 IEX = 0, MEX(IST)
 
5087
        A(IEX) = AC(IEX, 0, IFL, IST)
 
5088
        DO 21 IPN = 1, MPN(IST)
 
5089
          A(IEX) = A(IEX) + AC(IEX, IPN, IFL, IST) * SQ **IPN
 
5090
21      CONTINUE
 
5091
        PDF = PDF * FX(IEX) **(A(IEX))
 
5092
   20 CONTINUE
 
5093
 
 
5094
      PDZXMT = PDF / X
 
5095
 
 
5096
      RETURN
 
5097
 
 
5098
      ENTRY VLAMBD (ISET, IORDER)
 
5099
 
 
5100
      IORDER = IORD (ISET)
 
5101
      VLAMBD = ALM  (ISET)
 
5102
 
 
5103
      RETURN
 
5104
C                         *************************
 
5105
      END
 
5106
 
 
5107
 
 
5108
C------- END TUNG AND MORFIN ---------------------------------------
 
5109
C----- START CTEQ1 FITS ------------------------------
 
5110
      SUBROUTINE  CTEQ(ISET,IH,Q2,X,FX,NF)
 
5111
      REAL FX(-NF:NF) 
 
5112
      REAL*8 DX,DQ,PDF(-6:2)
 
5113
C     Pdf(Iprtn), Iprtn = (2,    1,   0,   -1,  -2, ......,    -6)
 
5114
C                  for (d_val, u_val, g, u_bar, d_bar,  ..., t_bar)
 
5115
      IF(ABS(IH).GE.3) CALL NOSETP
 
5116
      IH0=IH
 
5117
      IF(ABS(IH).EQ.2) IH0=ISIGN(1,IH)
 
5118
      Q=SQRT(Q2)
 
5119
      DQ=DBLE(Q)
 
5120
      DX=DBLE(X)
 
5121
      CALL CTQPDS(ISET,PDF,DX,DQ,IRT)
 
5122
c 
 
5123
      FX(0)=SNGL(PDF(0))
 
5124
      FX(-IH0)=SNGL(PDF(-1))
 
5125
      FX(-2*IH0)=SNGL(PDF(-2))
 
5126
      FX(IH0)  =SNGL(PDF(1)+PDF(-1))
 
5127
      FX(2*IH0)=SNGL(PDF(2)+PDF(-2))
 
5128
      IF(NF.GE.3) FX(3)=SNGL(PDF(-3))
 
5129
      IF(NF.GE.4) FX(4)=SNGL(PDF(-4))
 
5130
      IF(NF.GE.5) FX(5)=SNGL(PDF(-5))
 
5131
      IF(NF.eq.6) FX(6)=0
 
5132
      DO I=3,NF
 
5133
        FX(-I)=FX(I)
 
5134
      ENDDO
 
5135
      DO I=-NF,NF
 
5136
       FX(I)=FX(I)/X
 
5137
      ENDDO
 
5138
C...TRANSFORM PROTON INTO NEUTRON
 
5139
      IF(ABS(IH).EQ.2) THEN
 
5140
        T=FX(1)
 
5141
        FX(1)=FX(2)
 
5142
        FX(2)=T
 
5143
        T=FX(-1)
 
5144
        FX(-1)=FX(-2)
 
5145
        FX(-2)=T
 
5146
      ENDIF
 
5147
      END
 
5148
C            
 
5149
      Subroutine CtqPds (Iset, Pdf, XX, QQ, Irt)
 
5150
 
 
5151
C   CTEQ distribution function in a parametrized form.  
 
5152
 
 
5153
C   (No data tables are needed.)
 
5154
 
 
5155
C   The returned function values (in the array Pdf) are the 
 
5156
C   MOMENTUM FRACTION densities: 
 
5157
 
 
5158
C    Pdf(Iprtn), Iprtn = (2,    1,   0,   -1,  -2, ......,    -6)
 
5159
C                 for (d_val, u_val, g, u_bar, d_bar,  ..., t_bar)
 
5160
 
 
5161
C  !!! Be aware of our numbering scheme when you declare the dimension
 
5162
C  !!! of this array in the calling program!!... In particular,
 
5163
C  !!! the ascending/descending order!! 
 
5164
 
 
5165
C  \\  A parallel (independent) program (not included in this file) in
 
5166
C  ||  Function form is also available.  There, the function CteqPd returns
 
5167
C  ||   d, u, g, u_bar, ... etc. INDIVIDUALLY by a parton label parameter;
 
5168
C  ||  and the function CtqPdf returns d_val, u_val, ... etc. as above.
 
5169
C  //  See details in that separate file if you are interested.
 
5170
 
 
5171
C Ref.: "CTEQ Parton Distributions and Flavor Dependence of the Sea Quarks"
 
5172
C     by: J. Botts, J.G. Morfin, J.F. Owens, J. Qiu, W.K. Tung & H. Weerts
 
5173
C     MSUHEP-92-27, Fermilab-Pub-92/371, FSU-HEP-92-1225, ISU-NP-92-17
 
5174
 
 
5175
C   Since this is an initial distribution, and there may be updates, it is 
 
5176
C   useful for the authors to maintain a record of the distribution list.
 
5177
C   Please do not freely distribute this program package; instead, refer any 
 
5178
C   interested colleague to direct their request for a copy to:
 
5179
C   Botts@msupa.pa.msu.edu  or  Botts@msupa (bitnet)  or  MSUHEP::Botts
 
5180
 
 
5181
C   If you have any questions concerning these distributions, direct inquires 
 
5182
C   to Jim Botts or Wu-Ki Tung (username Tung at same E-mail nodes as above).
 
5183
 
 
5184
C$Header: /users/wkt/1hep/0cteq/RCS/CtqPr1B.f,v 1.1 93/02/16 13:09:52 wkt Exp $ 
 
5185
C$Log:  CtqPr1B.f,v $
 
5186
c Revision 1.1  93/02/16  13:09:52  wkt
 
5187
c Initial revision
 
5188
c 
 
5189
c Revision 1.2  93/02/14  17:30:21  botts
 
5190
c The new Faster version.
 
5191
c Revision 1.1  93/02/08  18:35:25  wkt
 
5192
c Initial revision
 
5193
 
 
5194
C     Name convention for CTEQ distributions:  CTEQnSx  where
 
5195
C         n : version number                      (currently n = 1)
 
5196
C         S : factorization scheme label: = [M D L] for [MS-bar DIS LO]  
 
5197
C             resp.
 
5198
C         x : special characteristics, if any 
 
5199
C                  (e.g. S for singular gluon, L for "LEP lambda value")
 
5200
 
 
5201
C Xx, Qq are the usual x, Q; Irt is a return error code (not implemented).
 
5202
 
 
5203
C --> Iset = 1, 2, 3, 4, 5 correspond to the following CTEQ global fits:
 
5204
C     cteq1M, cteq1MS, cteq1ML, cteq1D, cteq1L  respectively.
 
5205
 
 
5206
C --> QCD parameters for parton distribution set Iset can be obtained inside
 
5207
C         the user's program by:
 
5208
C     Call Prctq2 
 
5209
C    >        (Iset, Iord, Ischeme, MxFlv,
 
5210
C    >         Alam4, Alam5, Alam6, Amas4, Amas5, Amas6,
 
5211
C    >         Xmin, Qini, Qmax, ExpNor)
 
5212
C     where all but the first argument are output parameters.
 
5213
C     They should be self-explanary -- see details in next module.
 
5214
 
 
5215
C     The range of (x, Q) used in this round of global analysis is, approxi-
 
5216
C     mately,  0.01 < x < 0.75 ; and 4 GeV^2 < Q^2 < 400 GeV^2.
 
5217
 
 
5218
C    The range of (x, Q) used in the reparametrization of the QCD evolved
 
5219
C    parton distributions is 10E-5 < x < 1 ; 2 GeV < Q < 1 TeV.  The  
 
5220
c    functional form of this parametrization is:
 
5221
 
 
5222
C      A0 * x^A1 * (1-x)^A2 * (1 + A3 * x^A4) * [log(1+1/x)]^A5
 
5223
 
 
5224
C     with the A'coefficients being smooth functions of Q.  
 
5225
 
 
5226
C    Since this function is positive definite and smooth, it provides sensible
 
5227
C     extrapolations of the parton distributions if they are called beyond
 
5228
C     the original range in an application. There is no artificial boundaries
 
5229
C     or sharp cutoff's.
 
5230
 
 
5231
      IMPLICIT DOUBLE PRECISION (A-H, O-Z)
 
5232
      
 
5233
      dimension pdf(-6:2)
 
5234
 
 
5235
      PARAMETER (D0=0D0, D1=1D0, D2=2D0, D3=3D0, D4=4D0, D10=1D1)
 
5236
      PARAMETER (Nex = 5, MxFl = 6, Npn = 3, Nst = 30, Nexpt=20)
 
5237
      Parameter (Nst4 = Nst*4)
 
5238
 
 
5239
      DIMENSION
 
5240
     >   Iord(Nst), Isch(Nst), Nqrk(Nst),Alm(Nst)
 
5241
     > , Vlm(4:6,Nst), Qms(4:6, Nst)
 
5242
     > , Xmn(Nst), Qmn(Nst), Qmx(Nst), Nexp(Nexpt)
 
5243
     > , Mex(Nst), Mpn(Nst), ExpN(Nexpt, Nst), ExpNor(Nexpt)
 
5244
 
 
5245
c                                                             CTEQ1M
 
5246
      DATA 
 
5247
     >  Isch(1), Iord(1), Nqrk(1), Alm(1) /  1,  2,  6,  .152 / 
 
5248
     >  (Vlm(I,1), I=4,6) / .231,    .152,    .059  /
 
5249
     >  (Qms(I,1), I=4,6) / 1.50,   5.00,  180.0 /
 
5250
     >  Xmn(1), Qmn(1), Qmx(1) /  1.E-5,  2.00,  1.E3  /
 
5251
     >  Mex(1), Mpn(1), Nexp(1) /  5, 3, 8  /
 
5252
     >  (ExpN(I, 1), I=1,8)
 
5253
     >  / 0.989, 1.00, 1.02, 0.978, 1.10, 0.972, 0.987, 0.846 /
 
5254
c                                                             CTEQ1MS
 
5255
      DATA 
 
5256
     >  Isch(2), Iord(2), Nqrk(2), Alm(2) /  1,  2,  6, .152  / 
 
5257
     >  (Vlm(I,2), I=4,6) / .231,    .152,    .059  /
 
5258
     >  (Qms(I,2), I=4,6) / 1.50,   5.00,  180.0 /
 
5259
     >  Xmn(2), Qmn(2), Qmx(2) /  1.E-5,  2.00,  1.E3  /
 
5260
     >  Mex(2), Mpn(2), Nexp(2) /  5, 3, 8  /
 
5261
     >  (ExpN(I, 2), I=1,8 )
 
5262
     >  / 0.989, 1.00, 1.02, 0.984, 1.05, 0.891, 0.923, 0.824 /
 
5263
c                                                             CTEQ1ML
 
5264
      DATA 
 
5265
     >  Isch(3), Iord(3), Nqrk(3), Alm(3) /  1,  2,  6, .220  / 
 
5266
     >  (Vlm(I,3), I=4,6) / .322,    .220,     .088  /
 
5267
     >  (Qms(I,3), I=4,6) / 1.50,   5.00,  180.0 /
 
5268
     >  Xmn(3), Qmn(3), Qmx(3) /  1.E-5,  2.00,  1.E3  /
 
5269
     >  Mex(3), Mpn(3), Nexp(3) /  5, 3, 8 /
 
5270
     >  (ExpN(I, 3), I=1,8 )
 
5271
     >  / 0.985, 1.00, 1.01, 0.977, 1.07, 1.31, 1.19, 1.09 /
 
5272
 
 
5273
c                                                             CTEQ1D
 
5274
      DATA 
 
5275
     >  Isch(4), Iord(4), Nqrk(4), Alm(4) /  2,  2,  6, .164  / 
 
5276
     >  (Vlm(I,4), I=4,6) / .247,    .164,    .064  /
 
5277
     >  (Qms(I,4), I=4,6) / 1.50,   5.00,  180.0 /
 
5278
     >  Xmn(4), Qmn(4), Qmx(4) /  1.E-5,  2.00,  1.E3  /
 
5279
     >  Mex(4), Mpn(4), Nexp(4) /  5, 3, 8 /
 
5280
     >  (ExpN(I, 4), I=1,8 )
 
5281
     >  / 0.983, 1.00, 1.01, 0.975, 0.964, 1.23, 1.00, 1.12 /
 
5282
c                                                             CTEQ1L
 
5283
      DATA 
 
5284
     >  Isch(5), Iord(5), Nqrk(5), Alm(5) /  1,  1,  6, .125  / 
 
5285
     >  (Vlm(I,5), I=4,6) / .168,    .125,     .063   /
 
5286
     >  (Qms(I,5), I=4,6) / 1.50,   5.00,  180.0 /
 
5287
     >  Xmn(5), Qmn(5), Qmx(5) /  1.E-5,  2.00,  1.E3  /
 
5288
     >  Mex(5), Mpn(5), Nexp(5) /  5, 3, 8  /
 
5289
     >  (ExpN(I, 5), I=1,8 )
 
5290
     >  / 0.982, 1.01, 1.00, 0.972, 0.840, 0.959, 0.930, 0.861 /
 
5291
 
 
5292
      Data ist, lp, qsto, Aln2 / 0, -10, 1.2345, 0.6931 /
 
5293
 
 
5294
      X  = XX
 
5295
      if(iset.eq.ist.and.xsto.eq.xx.and.qsto.eq.qq) goto 100
 
5296
 
 
5297
      Irt = 0
 
5298
 
 
5299
      Alam = Alm (Iset)
 
5300
 
 
5301
      sta = log(qq/alam)
 
5302
      stbqm = log(Qmn(iset)/alam)
 
5303
      sb = log(sta/stbqm)
 
5304
      SB2 = SB*SB
 
5305
      SB3 = SB2*SB
 
5306
 
 
5307
      Goto (1, 2, 3, 4, 5), Iset
 
5308
 
 
5309
 1    continue
 
5310
c   ifl =     2
 
5311
 11   A0=0.3636E+01*(1.0 + 0.3122E+00*SB+0.1396E+00*SB2+0.4251E+00*SB3)
 
5312
      A1=0.6930E+00-.2574E-01*SB+0.1047E+00*SB2-.2794E-01*SB3
 
5313
      A2=0.3195E+01+0.4045E+00*SB-.3737E+00*SB2-.1677E+00*SB3
 
5314
      A3=0.1009E+00*(1.0 -.1784E+01*SB+0.6263E+00*SB2+0.7337E-01*SB3)
 
5315
     $  -1.0
 
5316
      A4=0.2910E+00-.2793E+00*SB+0.6155E-01*SB2+0.5150E-02*SB3
 
5317
      A5=0.0000E+00+0.3185E+00*SB+0.1953E+00*SB2+0.4184E-01*SB3
 
5318
      Pdf(2) = A0*(x**A1)*((1.-x)**A2)*(1.+A3*(x**A4))
 
5319
     $     *(log(1.+1./x))**A5
 
5320
 
 
5321
c   ifl =     1
 
5322
 12   A0=0.2851E+00*(1.0 + 0.3617E+00*SB-.4526E+00*SB2+0.5787E-01*SB3)
 
5323
      A1=0.2690E+00+0.1104E-01*SB+0.1888E-01*SB2-.1031E-01*SB3
 
5324
      A2=0.3766E+01+0.7850E+00*SB-.3053E+00*SB2+0.1822E+00*SB3
 
5325
      A3=0.2865E+02*(1.0 -.9774E+00*SB+0.5958E+00*SB2-.1234E+00*SB3)
 
5326
     $  -1.0
 
5327
      A4=0.8230E+00-.3612E+00*SB+0.5520E-01*SB2+0.1571E-01*SB3
 
5328
      A5=0.0000E+00+0.2145E-01*SB+0.2289E+00*SB2-.4947E-01*SB3
 
5329
      Pdf(1) = A0*(x**A1)*((1.-x)**A2)*(1.+A3*(x**A4))
 
5330
     $     *(log(1.+1./x))**A5
 
5331
 
 
5332
c   ifl =     0
 
5333
 13   A0=0.2716E+01*(1.0 -.2092E+01*SB+0.1500E+01*SB2-.3703E+00*SB3)
 
5334
      A1=-.3100E-01-.7963E+00*SB+0.1129E+01*SB2-.4191E+00*SB3
 
5335
      A2=0.8015E+01+0.1168E+01*SB-.1625E+01*SB2-.1130E+01*SB3
 
5336
      A3=0.4813E+02*(1.0 -.4951E+00*SB-.8715E+00*SB2+0.5893E+00*SB3)
 
5337
     $  -1.0
 
5338
      A4=0.2773E+01-.6329E+00*SB-.1048E+01*SB2+0.1418E+00*SB3
 
5339
      A5=0.0000E+00+0.5048E+00*SB+0.2390E+01*SB2-.4159E+00*SB3
 
5340
      Pdf(0) = A0*(x**A1)*((1.-x)**A2)*(1.+A3*(x**A4))
 
5341
     $     *(log(1.+1./x))**A5
 
5342
 
 
5343
c   ifl =    -1
 
5344
 14   A0=0.3085E+00*(1.0 + 0.9422E+00*SB-.2606E+01*SB2+0.1364E+01*SB3)
 
5345
      A1=0.5000E-02-.6433E+00*SB+0.4980E+00*SB2-.1780E+00*SB3
 
5346
      A2=0.7490E+01+0.9112E+00*SB-.2047E+01*SB2+0.1456E+01*SB3
 
5347
      A3=0.1145E-01*(1.0 + 0.4610E+01*SB+0.1699E+01*SB2+0.1296E+00*SB3)
 
5348
     $  -1.0
 
5349
      A4=0.6030E+00-.8081E+00*SB+0.9410E+00*SB2-.4458E+00*SB3
 
5350
      A5=0.0000E+00-.1736E+01*SB+0.2863E+01*SB2-.1268E+01*SB3
 
5351
      Pdf(-1) = A0*(x**A1)*((1.-x)**A2)*(1.+A3*(x**A4))
 
5352
     $     *(log(1.+1./x))**A5
 
5353
      
 
5354
c   ifl =    -2
 
5355
 15   A0=0.1324E+00*(1.0 -.1050E+01*SB+0.4844E+00*SB2-.1043E+00*SB3)
 
5356
      A1=-.1580E+00+0.1672E+00*SB-.4100E+00*SB2+0.1793E+00*SB3
 
5357
      A2=0.8559E+01-.7351E-01*SB+0.5898E+00*SB2-.2655E+00*SB3
 
5358
      A3=0.2378E+02*(1.0 -.1108E+00*SB-.1646E-01*SB2+0.1129E-01*SB3)
 
5359
     $  -1.0
 
5360
      A4=0.1477E+01+0.3312E-01*SB-.2191E+00*SB2+0.9588E-01*SB3
 
5361
      A5=0.0000E+00+0.1850E+01*SB-.1481E+01*SB2+0.6222E+00*SB3
 
5362
      Pdf(-2) = A0*(x**A1)*((1.-x)**A2)*(1.+A3*(x**A4))
 
5363
     $     *(log(1.+1./x))**A5
 
5364
      
 
5365
c   ifl =    -3
 
5366
 16   A0=0.3208E+00*(1.0 -.4755E+00*SB-.4003E+00*SB2+0.2300E+00*SB3)
 
5367
      A1=-.3200E-01-.3357E+00*SB+0.3222E-01*SB2+0.5011E-01*SB3
 
5368
      A2=0.1164E+02+0.1048E+01*SB-.1097E+01*SB2-.4431E+00*SB3
 
5369
      A3=0.5065E+02*(1.0 + 0.2484E+00*SB-.9235E+00*SB2+0.1935E+00*SB3)
 
5370
     $  -1.0
 
5371
      A4=0.3300E+01-.6785E+00*SB+0.5337E+00*SB2-.4035E+00*SB3
 
5372
      A5=0.0000E+00-.2496E+00*SB+0.3903E+00*SB2+0.1392E+00*SB3
 
5373
      Pdf(-3) = A0*(x**A1)*((1.-x)**A2)*(1.+A3*(x**A4))
 
5374
     $     *(log(1.+1./x))**A5
 
5375
      
 
5376
c   ifl =    -4
 
5377
 17   A0=0.7967E-06*(1.0 + 0.1587E+01*SB+0.1812E+02*SB2-.1333E+02*SB3)
 
5378
     $ *sqrt(sta - stbqm)
 
5379
      A1=0.1096E+01-.1236E+01*SB+0.1014E+02*SB2+0.1940E+01*SB3
 
5380
      A2=0.4366E+00+0.1197E+02*SB-.5471E+00*SB2-.5427E+01*SB3
 
5381
      A3=0.4650E+03*(1.0 + 0.1310E+02*SB-.1918E+02*SB2+0.6791E+01*SB3)
 
5382
     $  -1.0
 
5383
      A4=-.8486E+00+0.7457E+00*SB-.1083E+02*SB2-.1210E+01*SB3
 
5384
      A5=0.3494E+01-.3511E+01*SB-.1766E+01*SB2+0.3442E+01*SB3
 
5385
      Pdf(-4) = A0*(x**A1)*((1.-x)**A2)*(1.+A3*(x**A4))
 
5386
     $     *(log(1.+1./x))**A5
 
5387
      
 
5388
c   ifl =    -5
 
5389
      if(qq.le.qms(5,iset)) then
 
5390
         pdf(-5) = 0.0
 
5391
         pdf(-6) = 0.0
 
5392
         goto 100
 
5393
      endif
 
5394
      stbq5 = log(Qms(5,iset)/alam)
 
5395
      s5 = log(sta/stbq5)
 
5396
      s52 = s5*s5
 
5397
      s53 = s52*s5
 
5398
 18   A0=0.1713E-03*(1.0 + 0.2562E+02*S5-.2988E+02*S52+0.4798E+01*S53)
 
5399
     $ *sqrt(sta - stbq5)
 
5400
      A1=-.5276E-01+0.4105E+00*S5-.1079E+01*S52+0.6278E+00*S53
 
5401
      A2=0.4515E+01+0.8369E+01*S5-.1192E+02*S52+0.3403E+01*S53
 
5402
      A3=0.1756E+01*(1.0 + 0.1325E+02*S5-.2997E+02*S52+0.1758E+02*S53)
 
5403
     $  -1.0
 
5404
      A4=0.3557E-01+0.4159E+01*S5-.6947E+01*S52+0.2982E+01*S53
 
5405
      A5=0.2551E+01+0.2168E+01*S5-.5119E+01*S52+0.3739E+01*S53
 
5406
      Pdf(-5) = A0*(x**A1)*((1.-x)**A2)*(1.+A3*(x**A4))
 
5407
     $     *(log(1.+1./x))**A5
 
5408
      
 
5409
c   ifl =    -6
 
5410
      if(qq.le.qms(6,iset)) then
 
5411
         pdf(-6) = 0.0
 
5412
         goto 100
 
5413
      endif
 
5414
      stbq6 = log(Qms(6,iset)/alam)
 
5415
      s6 = log(sta/stbq6)
 
5416
      s62 = s6*s6
 
5417
      s63 = s62*s6
 
5418
 19   A0=0.7510E-04*(1.0 + 0.2836E+02*S6-.3000E+02*S62-.2979E+02*S63)
 
5419
     $ *sqrt(sta - stbq6)
 
5420
      A1=-.1855E+00+0.4543E+00*S6-.1448E+01*S62+0.2009E-01*S63
 
5421
      A2=0.6775E+01-.4210E+01*S6-.1221E+01*S62+0.1199E+02*S63
 
5422
      A3=0.1070E+01*(1.0 + 0.8356E+01*S6-.2992E+02*S62+0.2433E+02*S63)
 
5423
     $  -1.0
 
5424
      A4=-.4601E-01+0.4248E+01*S6-.1736E+01*S62+0.1187E+02*S63
 
5425
      A5=0.2771E+01+0.1382E+01*S6-.4797E+01*S62+0.1273E+01*S63
 
5426
      Pdf(-6) = A0*(x**A1)*((1.-x)**A2)*(1.+A3*(x**A4))
 
5427
     $     *(log(1.+1./x))**A5
 
5428
      goto 100
 
5429
 
 
5430
 
 
5431
 2    continue
 
5432
c                                                             CTEQ1MS
 
5433
c   ifl =     2
 
5434
 21   A0=0.1828E+01*(1.0 -.8698E+00*SB+0.2906E+00*SB2-.2003E-01*SB3)
 
5435
      A1=0.6060E+00+0.8595E-01*SB-.4934E-01*SB2+0.2221E-01*SB3
 
5436
      A2=0.3454E+01-.3115E+00*SB+0.1321E+01*SB2-.3490E+00*SB3
 
5437
      A3=0.2616E+00*(1.0 -.1670E+01*SB+0.2333E+01*SB2+0.7730E-01*SB3)
 
5438
     $  -1.0
 
5439
      A4=0.8920E+00-.8500E-02*SB+0.4960E+00*SB2-.4045E-01*SB3
 
5440
      A5=0.0000E+00+0.1091E+01*SB-.1613E+00*SB2+0.3773E-01*SB3
 
5441
      Pdf(2) = A0*(x**A1)*((1.-x)**A2)*(1.+A3*(x**A4))
 
5442
     $     *(log(1.+1./x))**A5
 
5443
      
 
5444
c   ifl =     1
 
5445
 22   A0=0.2885E+00*(1.0 + 0.3388E+00*SB-.4550E+00*SB2+0.6005E-01*SB3)
 
5446
      A1=0.2730E+00+0.1198E-01*SB+0.1880E-01*SB2-.1077E-01*SB3
 
5447
      A2=0.3736E+01+0.7687E+00*SB-.2731E+00*SB2+0.1638E+00*SB3
 
5448
      A3=0.2741E+02*(1.0 -.9585E+00*SB+0.5925E+00*SB2-.1239E+00*SB3)
 
5449
     $  -1.0
 
5450
      A4=0.8040E+00-.3546E+00*SB+0.6123E-01*SB2+0.1086E-01*SB3
 
5451
      A5=0.0000E+00+0.4277E-01*SB+0.2187E+00*SB2-.4646E-01*SB3
 
5452
      Pdf(1) = A0*(x**A1)*((1.-x)**A2)*(1.+A3*(x**A4))
 
5453
     $     *(log(1.+1./x))**A5
 
5454
      
 
5455
c   ifl =     0
 
5456
 23   A0=0.8416E-01*(1.0 -.1996E+01*SB+0.1903E+01*SB2-.6722E+00*SB3)
 
5457
      A1=-.4790E+00-.5459E+00*SB+0.1638E+01*SB2-.4342E+00*SB3
 
5458
      A2=0.5071E+01+0.1470E+01*SB-.2401E+01*SB2+0.1273E+01*SB3
 
5459
      A3=0.2847E+02*(1.0 + 0.1124E+00*SB-.1338E+01*SB2+0.7115E+00*SB3)
 
5460
     $  -1.0
 
5461
      A4=0.4990E+00-.7208E+00*SB+0.3333E-03*SB2-.2354E+00*SB3
 
5462
      A5=0.0000E+00-.4480E+00*SB+0.3720E+01*SB2-.1838E+01*SB3
 
5463
      Pdf(0) = A0*(x**A1)*((1.-x)**A2)*(1.+A3*(x**A4))
 
5464
     $     *(log(1.+1./x))**A5
 
5465
      
 
5466
c   ifl =    -1
 
5467
 24   A0=0.4378E+00*(1.0 -.1244E+01*SB+0.3278E+01*SB2-.2098E+01*SB3)
 
5468
      A1=0.3500E-01-.1298E+01*SB+0.1229E+01*SB2-.3665E+00*SB3
 
5469
      A2=0.6781E+01+0.4078E+01*SB-.9711E+00*SB2-.1536E+01*SB3
 
5470
      A3=0.1527E-03*(1.0 + 0.1430E+02*SB+0.3000E+02*SB2+0.2771E+02*SB3)
 
5471
     $  -1.0
 
5472
      A4=0.3060E+00+0.1011E+01*SB-.2045E+01*SB2+0.9422E+00*SB3
 
5473
      A5=0.0000E+00-.3205E+01*SB+0.2683E+01*SB2-.1746E+00*SB3
 
5474
      Pdf(-1) = A0*(x**A1)*((1.-x)**A2)*(1.+A3*(x**A4))
 
5475
     $     *(log(1.+1./x))**A5
 
5476
      
 
5477
c   ifl =    -2
 
5478
 25   A0=0.7413E-01*(1.0 + 0.1291E+01*SB-.2667E+01*SB2+0.1076E+01*SB3)
 
5479
      A1=-.2730E+00-.1206E+00*SB+0.1828E+00*SB2-.1001E+00*SB3
 
5480
      A2=0.7719E+01+0.1537E+01*SB-.6410E+00*SB2-.3920E-01*SB3
 
5481
      A3=0.1799E+02*(1.0 -.1334E+01*SB+0.1916E+01*SB2-.8878E+00*SB3)
 
5482
     $  -1.0
 
5483
      A4=0.1167E+01-.9176E-01*SB+0.5132E+00*SB2-.3460E+00*SB3
 
5484
      A5=0.0000E+00-.5023E+00*SB+0.1951E+01*SB2-.8427E+00*SB3
 
5485
      Pdf(-2) = A0*(x**A1)*((1.-x)**A2)*(1.+A3*(x**A4))
 
5486
     $     *(log(1.+1./x))**A5
 
5487
      
 
5488
c   ifl =    -3
 
5489
 26   A0=0.6551E+00*(1.0 -.5968E-01*SB+0.5621E-02*SB2-.2074E+00*SB3)
 
5490
      A1=0.2800E-01-.1138E+01*SB+0.1178E+01*SB2-.4425E+00*SB3
 
5491
      A2=0.7553E+01+0.3996E+01*SB-.4448E+01*SB2+0.1673E+01*SB3
 
5492
      A3=0.9264E-01*(1.0 -.1760E+01*SB+0.1634E+01*SB2-.4067E+00*SB3)
 
5493
     $  -1.0
 
5494
      A4=0.1970E+00+0.5256E+00*SB-.9775E+00*SB2+0.4488E+00*SB3
 
5495
      A5=0.0000E+00-.3668E+01*SB+0.4757E+01*SB2-.1717E+01*SB3
 
5496
      Pdf(-3) = A0*(x**A1)*((1.-x)**A2)*(1.+A3*(x**A4))
 
5497
     $     *(log(1.+1./x))**A5
 
5498
      
 
5499
c   ifl =    -4
 
5500
 27   A0=0.1486E-03*(1.0 + 0.2107E+01*SB-.1056E+02*SB2+0.1403E+02*SB3)
 
5501
     $ * sqrt(sta - stbqm)
 
5502
      A1=0.2115E+00-.1702E+01*SB+0.2571E+01*SB2-.1177E+01*SB3
 
5503
      A2=0.3533E+01+0.1367E+01*SB-.3397E+01*SB2+0.6260E+01*SB3
 
5504
      A3=0.1096E+02*(1.0 + 0.9213E+01*SB-.2020E+02*SB2+0.1084E+02*SB3)
 
5505
     $  -1.0
 
5506
      A4=0.7041E+00-.7236E+00*SB+0.2766E-01*SB2+0.7352E+00*SB3
 
5507
      A5=0.3904E+01-.4398E+01*SB+0.7056E+01*SB2-.3722E+01*SB3
 
5508
      Pdf(-4) = A0*(x**A1)*((1.-x)**A2)*(1.+A3*(x**A4))
 
5509
     $     *(log(1.+1./x))**A5
 
5510
      
 
5511
c   ifl =    -5
 
5512
      if(qq.le.qms(5,iset)) then
 
5513
         pdf(-5) = 0.0
 
5514
         pdf(-6) = 0.0
 
5515
         goto 100
 
5516
      endif
 
5517
      stbq5 = log(Qms(5,iset)/alam)
 
5518
      s5 = log(sta/stbq5)
 
5519
      s52 = s5*s5
 
5520
      s53 = s52*s5
 
5521
 28   A0=0.1201E-03*(1.0 + 0.5408E+01*S5-.1489E+02*S52+0.1667E+02*S53)
 
5522
     $  * sqrt(sta - stbq5)
 
5523
      A1=0.1420E-01-.1525E+01*S5+0.2408E+01*S52-.1154E+01*S53
 
5524
      A2=0.4254E+01+0.2836E+01*S5-.6018E+00*S52+0.4133E+00*S53
 
5525
      A3=0.5696E+01*(1.0 + 0.9451E+01*S5-.2029E+02*S52+0.1033E+02*S53)
 
5526
     $  -1.0
 
5527
      A4=0.4775E+00-.6695E+00*S5+0.2747E+00*S52-.1051E+00*S53
 
5528
      A5=0.3330E+01-.5133E+01*S5+0.6921E+01*S52-.3283E+01*S53
 
5529
      Pdf(-5) = A0*(x**A1)*((1.-x)**A2)*(1.+A3*(x**A4))
 
5530
     $     *(log(1.+1./x))**A5
 
5531
      
 
5532
c   ifl =    -6
 
5533
      if(qq.le.qms(6,iset)) then
 
5534
         pdf(-6) = 0.0
 
5535
         goto 100
 
5536
      endif
 
5537
      stbq6 = log(Qms(6,iset)/alam)
 
5538
      s6 = log(sta/stbq6)
 
5539
      s62 = s6*s6
 
5540
      s63 = s62*s6
 
5541
 29   A0=0.7697E-04*(1.0 + 0.2801E+02*S6-.1901E+02*S62-.2880E+02*S63)
 
5542
     $ *sqrt(sta - stbq6)
 
5543
      A1=-.2249E+00+0.4432E+00*S6-.1454E+01*S62+0.3509E-01*S63
 
5544
      A2=0.6642E+01-.2702E+01*S6+0.8229E+01*S62+0.8243E+01*S63
 
5545
      A3=0.1146E+01*(1.0 + 0.8104E+01*S6-.2998E+02*S62+0.2812E+02*S63)
 
5546
     $  -1.0
 
5547
      A4=-.6421E-01+0.4246E+01*S6-.2908E+01*S62+0.9686E-02*S63
 
5548
      A5=0.2606E+01+0.1261E+01*S6-.4933E+01*S62+0.3476E+00*S63
 
5549
      Pdf(-6) = A0*(x**A1)*((1.-x)**A2)*(1.+A3*(x**A4))
 
5550
     $     *(log(1.+1./x))**A5
 
5551
      goto 100
 
5552
 
 
5553
 
 
5554
 3    continue
 
5555
c                                                             CTEQ1ML
 
5556
c   ifl =     2
 
5557
 31   A0=0.3777E+01*(1.0 + 0.6986E+00*SB-.20655E+01*SB2+.10334E+01*SB3)
 
5558
      A1=0.7100E+00+.2880E-01*SB-.7930E-01*SB2+0.5600E-01*SB3
 
5559
      A2=0.3259E+01+0.1508E+01*SB-.3932E+01*SB2+0.20613E+01*SB3
 
5560
      A3=0.1304E+00*(1.0 -.2016E+00*SB-.30015E+01*SB2+0.19118E+01*SB3)
 
5561
     $     -1.0
 
5562
      A4=0.2890E+00-0.4311E+00*SB+0.7387E+00*SB2-.3697E+00*SB3
 
5563
      A5=0.0000E+00+0.4320E+00*SB+0.2449E+00*SB2-0.6670E-01*SB3
 
5564
      Pdf(2) = A0*(x**A1)*((1.-x)**A2)*(1.+A3*(x**A4))
 
5565
     $     *(log(1.+1./x))**A5
 
5566
      
 
5567
c   ifl =     1
 
5568
 32   A0=0.2780E+00*(1.0 + 0.4355E+00*SB-0.4584E+00*SB2+0.4390E-01*SB3)
 
5569
      A1=0.2760E+00+0.1420E-01*SB+0.1480E-01*SB2-.9800E-02*SB3
 
5570
      A2=0.3710E+01+0.8250E+00*SB-.3581E+00*SB2+0.1978E+00*SB3
 
5571
      A3=0.2928E+02*(1.0 -.10154E+01*SB+0.6037E+00*SB2-.1175E+00*SB3)
 
5572
     $     -1.0
 
5573
      A4=0.8070E+00-.3575E+00*SB+0.4920E-01*SB2+0.1584E-01*SB3
 
5574
      A5=0.0000E+00+0.1860E-01*SB+0.2080E+00*SB2-.450E-01*SB3
 
5575
      Pdf(1) = A0*(x**A1)*((1.-x)**A2)*(1.+A3*(x**A4))
 
5576
     $     *(log(1.+1./x))**A5
 
5577
      
 
5578
c   ifl =     0
 
5579
 33   A0=0.2924E+01*(1.0 -.18916E+01*SB+0.1191E+01*SB2-.2492E+00*SB3)
 
5580
      A1=0.0000E+00-.9167E+00*SB+0.11147E+01*SB2-.3329E+00*SB3
 
5581
      A2=0.8529E+01+0.7080E+00*SB-.11345E+01*SB2-.10563E+01*SB3
 
5582
      A3=0.1420E+03*(1.0 -.15346E+01*SB+0.7261E+00*SB2-.5730E-01*SB3)
 
5583
     $     -1.0
 
5584
      A4=0.3396E+01-.11541E+01*SB-.8834E+00*SB2+0.2430E+00*SB3
 
5585
      A5=0.0000E+00+0.1645E+00*SB+0.19041E+01*SB2+0.1474E+00*SB3
 
5586
      Pdf(0) = A0*(x**A1)*((1.-x)**A2)*(1.+A3*(x**A4))
 
5587
     $     *(log(1.+1./x))**A5
 
5588
      
 
5589
c   ifl =    -1
 
5590
 34   A0=0.3471E+00*(1.0- 0.1753E+00*SB-.9189E+00*SB2+0.6211E+00*SB3)
 
5591
      A1=0.1900E-01-.4579E+00*SB+0.2112E+00*SB2-.6180E-01*SB3
 
5592
      A2=0.7301E+01-.17308E+01*SB+.13666E+01*SB2-.6400E-02*SB3
 
5593
      A3=0.1853E-04*(1.0 -.18260E+02*SB-.2872E+02*SB2-.23456E+02*SB3)
 
5594
     $     -1.0
 
5595
      A4=0.4400E+00-.4672E+00*SB+0.6532E+00*SB2-.3222E+00*SB3
 
5596
      A5=0.0000E+00-.4679E+00*SB+0.10741E+01*SB2-.5663E+00*SB3
 
5597
      Pdf(-1) = A0*(x**A1)*((1.-x)**A2)*(1.+A3*(x**A4))
 
5598
     $     *(log(1.+1./x))**A5
 
5599
      
 
5600
c   ifl =    -2
 
5601
 35   A0=0.1702E+00*(1.0 -.1041E+01*SB+0.4064E+00*SB2-.5888E-01*SB3)
 
5602
      A1=-.9300E-01-.4742E-01*SB-.1959E+00*SB2+0.1039E+00*SB3
 
5603
      A2=0.9119E+01-.7331E-01*SB+0.3506E+00*SB2-.2081E+00*SB3
 
5604
      A3=0.2981E+02*(1.0 -.1912E+00*SB-.8947E-02*SB2+0.8805E-02*SB3)
 
5605
     $     -1.0
 
5606
      A4=0.1668E+01-.6678E-02*SB-.2894E+00*SB2+0.1221E+00*SB3
 
5607
      A5=0.0000E+00+0.1245E+01*SB-.7843E+00*SB2+0.3724E+00*SB3
 
5608
      Pdf(-2) = A0*(x**A1)*((1.-x)**A2)*(1.+A3*(x**A4))
 
5609
     $     *(log(1.+1./x))**A5
 
5610
      
 
5611
c   ifl =    -3
 
5612
 36   A0=0.3910E+00*(1.0 -.1103E+01*SB+0.5383E+00*SB2-.1083E+00*SB3)
 
5613
      A1=-.1400E-01-.2471E+00*SB-.8042E-01*SB2+0.7193E-01*SB3
 
5614
      A2=0.9812E+01-.4860E+01*SB+0.5958E+01*SB2-.2342E+01*SB3
 
5615
      A3=0.3749E+00*(1.0 -.3569E+01*SB+0.5456E+01*SB2-.2344E+01*SB3)
 
5616
     $     -1.0
 
5617
      A4=0.4940E+00+0.2772E+00*SB-.2732E+00*SB2+0.6466E-01*SB3
 
5618
      A5=0.0000E+00+0.3927E+00*SB-.3216E+00*SB2+0.2164E+00*SB3
 
5619
      Pdf(-3) = A0*(x**A1)*((1.-x)**A2)*(1.+A3*(x**A4))
 
5620
     $     *(log(1.+1./x))**A5
 
5621
      
 
5622
c   ifl =    -4
 
5623
 37   A0=0.3815E-02*(1.0 + 0.2039E+02*SB-.2834E+02*SB2+0.1070E+02*SB3)
 
5624
     $ * sqrt(sta - stbqm)
 
5625
      A1=-.2789E-01-.7345E-03*SB-.3251E+00*SB2+0.1946E+00*SB3
 
5626
      A2=0.3223E+01-.4268E+00*SB+0.4387E+01*SB2-.2401E+01*SB3
 
5627
      A3=0.3338E-01*(1.0 -.1163E+02*SB+0.2995E+02*SB2-.1471E+02*SB3)
 
5628
     $     -1.0
 
5629
      A4=0.3646E+00-.5767E+00*SB+0.6088E+00*SB2-.2514E+00*SB3
 
5630
      A5=0.1200E+01+0.2178E+00*SB-.4230E+00*SB2+0.4739E+00*SB3
 
5631
      Pdf(-4) = A0*(x**A1)*((1.-x)**A2)*(1.+A3*(x**A4))
 
5632
     $     *(log(1.+1./x))**A5
 
5633
      
 
5634
c   ifl =    -5
 
5635
      if(qq.le.qms(5,iset)) then
 
5636
         pdf(-5) = 0.0
 
5637
         pdf(-6) = 0.0
 
5638
         goto 100
 
5639
      endif
 
5640
      stbq5 = log(Qms(5,iset)/alam)
 
5641
      s5 = log(sta/stbq5)
 
5642
      s52 = s5*s5
 
5643
      s53 = s52*s5
 
5644
 38   A0=0.1666E-02*(1.0 + 0.9518E+01*S5-.4715E+01*S52-.1060E+01*S53)
 
5645
     $ * sqrt(sta - stbq5)
 
5646
      A1=-.1231E+00+0.1656E+00*S5-.5219E+00*S52+0.2750E+00*S53
 
5647
      A2=0.3693E+01+0.4922E+01*S5-.1200E+02*S52+0.7929E+01*S53
 
5648
      A3=0.1778E+00*(1.0 + 0.3036E+01*S5-.1184E+02*S52+0.7940E+01*S53)
 
5649
     $     -1.0
 
5650
      A4=0.5353E+00-.1401E+01*S5+0.1970E+01*S52-.9405E+00*S53
 
5651
      A5=0.1590E+01+0.1025E+01*S5-.2318E+01*S52+0.1380E+01*S53
 
5652
      Pdf(-5) = A0*(x**A1)*((1.-x)**A2)*(1.+A3*(x**A4))
 
5653
     $     *(log(1.+1./x))**A5
 
5654
      
 
5655
c   ifl =    -6
 
5656
      if(qq.le.qms(6,iset)) then
 
5657
         pdf(-6) = 0.0
 
5658
         goto 100
 
5659
      endif
 
5660
      stbq6 = log(Qms(6,iset)/alam)
 
5661
      s6 = log(sta/stbq6)
 
5662
      s62 = s6*s6
 
5663
      s63 = s62*s6
 
5664
 39   A0=0.4319E-03*(1.0 + 0.1100E+02*S6-.9520E+00*S62+0.1434E+02*S63)
 
5665
     $ * sqrt(sta - stbq6)
 
5666
      A1=-.2512E+00+0.3554E+00*S6-.4120E+00*S62+0.1328E+00*S63
 
5667
      A2=0.4764E+01-.3513E+00*S6+0.1199E+02*S62-.8290E+01*S63
 
5668
      A3=0.8458E-01*(1.0 + 0.2618E+01*S6+0.4407E+01*S62+0.2991E+02*S63)
 
5669
     $    -1.0
 
5670
      A4=0.3991E+00-.1363E+01*S6+0.1526E+01*S62-.3179E+01*S63
 
5671
      A5=0.1981E+01+0.1496E+01*S6-.1501E+01*S62+0.3880E+01*S63
 
5672
      Pdf(-6) = A0*(x**A1)*((1.-x)**A2)*(1.+A3*(x**A4))
 
5673
     $     *(log(1.+1./x))**A5
 
5674
      goto 100
 
5675
 
 
5676
 4    continue
 
5677
c                                                             CTEQ1D
 
5678
c   ifl =     2
 
5679
 41   A0=0.1634E+01*(1.0 -.8336E+00*SB+0.1640E+00*SB2+0.1530E+00*SB3)
 
5680
      A1=0.5790E+00+0.8587E-01*SB-.6087E-01*SB2+0.1361E-01*SB3
 
5681
      A2=0.2839E+01+0.3720E+00*SB+0.5264E+00*SB2+0.3538E-01*SB3
 
5682
      A3=0.1095E+00*(1.0 -.4830E+00*SB+0.3708E+01*SB2-.6165E+00*SB3)
 
5683
     $  -1.0
 
5684
      A4=0.8010E+00-.1432E+00*SB+0.1442E+01*SB2-.1286E+01*SB3
 
5685
      A5=0.0000E+00+0.1035E+01*SB-.5910E-01*SB2-.1982E+00*SB3
 
5686
      Pdf(2) = A0*(x**A1)*((1.-x)**A2)*(1.+A3*(x**A4))
 
5687
     $     *(log(1.+1./x))**A5
 
5688
      
 
5689
c   ifl =     1
 
5690
 42   A0=0.3535E+00*(1.0 + 0.4352E+00*SB-.2095E+00*SB2-.8455E-02*SB3)
 
5691
      A1=0.2660E+00-.4096E-03*SB+0.1502E-01*SB2-.1163E-01*SB3
 
5692
      A2=0.3514E+01+0.8219E+00*SB-.2330E+00*SB2+0.1055E+00*SB3
 
5693
      A3=0.2200E+02*(1.0 -.9716E+00*SB+0.4552E+00*SB2-.8202E-01*SB3)
 
5694
     $  -1.0
 
5695
      A4=0.9000E+00-.3207E+00*SB-.4808E-01*SB2+0.3492E-01*SB3
 
5696
      A5=0.0000E+00-.6273E-01*SB+0.1497E+00*SB2-.5683E-01*SB3
 
5697
      Pdf(1) = A0*(x**A1)*((1.-x)**A2)*(1.+A3*(x**A4))
 
5698
     $     *(log(1.+1./x))**A5
 
5699
      
 
5700
c   ifl =     0
 
5701
 43   A0=0.2743E+01*(1.0 -.2027E+01*SB+0.1517E+01*SB2-.4145E+00*SB3)
 
5702
      A1=0.7000E-02-.9431E+00*SB+0.1231E+01*SB2-.4834E+00*SB3
 
5703
      A2=0.8200E+01+0.1827E+01*SB-.3453E+01*SB2+0.6763E+00*SB3
 
5704
      A3=0.4975E+02*(1.0 -.2329E+00*SB-.1245E+01*SB2+0.7194E+00*SB3)
 
5705
     $  -1.0
 
5706
      A4=0.2387E+01-.4077E+00*SB-.5542E+00*SB2-.9677E-02*SB3
 
5707
      A5=0.0000E+00+0.2702E+00*SB+0.2389E+01*SB2-.8274E+00*SB3
 
5708
      Pdf(0) = A0*(x**A1)*((1.-x)**A2)*(1.+A3*(x**A4))
 
5709
     $     *(log(1.+1./x))**A5
 
5710
      
 
5711
c   ifl =    -1
 
5712
 44   A0=0.2015E+00*(1.0 -.2133E+00*SB-.6770E+00*SB2+0.5011E+00*SB3)
 
5713
      A1=-.7700E-01-.7104E-01*SB-.3720E+00*SB2+0.2159E+00*SB3
 
5714
      A2=0.8008E+01-.2049E+01*SB+0.1800E+01*SB2-.4660E+00*SB3
 
5715
      A3=0.2923E-05*(1.0 + 0.2327E+02*SB+0.1500E+02*SB2+0.2633E+02*SB3)
 
5716
     $  -1.0
 
5717
      A4=0.9020E+00-.9191E+00*SB+0.1104E+01*SB2-.5863E+00*SB3
 
5718
      A5=0.0000E+00+0.5840E+00*SB-.8720E+00*SB2+0.4234E+00*SB3
 
5719
      Pdf(-1) = A0*(x**A1)*((1.-x)**A2)*(1.+A3*(x**A4))
 
5720
     $     *(log(1.+1./x))**A5
 
5721
 
 
5722
c   ifl =    -2
 
5723
 45   A0=0.9117E-01*(1.0 -.4089E+00*SB-.4361E+00*SB2+0.2512E+00*SB3)
 
5724
      A1=-.2370E+00+0.2492E+00*SB-.3267E+00*SB2+0.1055E+00*SB3
 
5725
      A2=0.8447E+01+0.6009E+00*SB+0.1003E+01*SB2-.1287E+01*SB3
 
5726
      A3=0.3106E+02*(1.0 -.3901E-01*SB+0.1443E+00*SB2-.3433E+00*SB3)
 
5727
     $  -1.0
 
5728
      A4=0.1629E+01+0.7855E-01*SB-.1573E+00*SB2-.8595E-01*SB3
 
5729
      A5=0.0000E+00+0.1558E+01*SB-.6295E+00*SB2+0.1847E+00*SB3
 
5730
      Pdf(-2) = A0*(x**A1)*((1.-x)**A2)*(1.+A3*(x**A4))
 
5731
     $     *(log(1.+1./x))**A5
 
5732
      
 
5733
c   ifl =    -3
 
5734
 46   A0=0.3997E+00*(1.0 -.1046E+01*SB+0.6194E+00*SB2-.1342E+00*SB3)
 
5735
      A1=0.2000E-02-.2544E+00*SB-.1958E+00*SB2+0.1458E+00*SB3
 
5736
      A2=0.9613E+01-.3919E+01*SB+0.9573E+01*SB2-.5623E+01*SB3
 
5737
      A3=0.3620E+00*(1.0 -.1858E+01*SB+0.8312E+01*SB2-.5900E+01*SB3)
 
5738
     $  -1.0
 
5739
      A4=0.3840E+00+0.3572E+00*SB-.1191E+01*SB2+0.7310E+00*SB3
 
5740
      A5=0.0000E+00+0.3351E+00*SB-.7709E+00*SB2+0.4296E+00*SB3
 
5741
      Pdf(-3) = A0*(x**A1)*((1.-x)**A2)*(1.+A3*(x**A4))
 
5742
     $     *(log(1.+1./x))**A5
 
5743
      
 
5744
c   ifl =    -4
 
5745
 47   A0=0.2156E-03*(1.0 + 0.2879E+02*SB-.2310E+02*SB2+0.9812E+01*SB3)
 
5746
     $ * sqrt(sta - stbqm)
 
5747
      A1=0.9086E-01-.1250E+00*SB-.7373E-01*SB2-.2201E-01*SB3
 
5748
      A2=0.3588E+01+0.4518E+01*SB-.8930E-01*SB2+0.9163E-02*SB3
 
5749
      A3=0.5216E+01*(1.0 + 0.5912E+00*SB-.4111E+00*SB2+0.7330E+00*SB3)
 
5750
     $  -1.0
 
5751
      A4=0.3145E+00+0.1233E+01*SB-.7478E+00*SB2+0.4657E+00*SB3
 
5752
      A5=0.2723E+01-.4110E+00*SB+0.4868E-01*SB2-.3075E+00*SB3
 
5753
      Pdf(-4) = A0*(x**A1)*((1.-x)**A2)*(1.+A3*(x**A4))
 
5754
     $     *(log(1.+1./x))**A5
 
5755
      
 
5756
c   ifl =    -5
 
5757
      if(qq.le.qms(5,iset)) then
 
5758
         pdf(-5) = 0.0
 
5759
         pdf(-6) = 0.0
 
5760
         goto 100
 
5761
      endif
 
5762
      stbq5 = log(Qms(5,iset)/alam)
 
5763
      s5 = log(sta/stbq5)
 
5764
      s52 = s5*s5
 
5765
      s53 = s52*s5
 
5766
 48   A0=0.7476E-03*(1.0 + 0.1454E+02*S5-.2509E+02*S52+0.1184E+02*S53)
 
5767
     $ * sqrt(sta - stbq5)
 
5768
      A1=-.1955E-01-.1712E+00*S5-.1686E+00*S52+0.2339E+00*S53
 
5769
      A2=0.4616E+01-.6859E+00*S5-.3959E+01*S52+0.5530E+01*S53
 
5770
      A3=0.9881E+01*(1.0 -.1239E+02*S5+0.2721E+02*S52-.1850E+02*S53)
 
5771
     $  -1.0
 
5772
      A4=0.1200E+02-.1133E+02*S5+0.8138E+01*S52+0.1199E+02*S53
 
5773
      A5=0.2226E+01-.5738E+00*S5+0.5239E+00*S52+0.3825E+00*S53
 
5774
      Pdf(-5) = A0*(x**A1)*((1.-x)**A2)*(1.+A3*(x**A4))
 
5775
     $     *(log(1.+1./x))**A5
 
5776
      
 
5777
c   ifl =    -6
 
5778
      if(qq.le.qms(6,iset)) then
 
5779
         pdf(-6) = 0.0
 
5780
         goto 100
 
5781
      endif
 
5782
      stbq6 = log(Qms(6,iset)/alam)
 
5783
      s6 = log(sta/stbq6)
 
5784
      s62 = s6*s6
 
5785
      s63 = s62*s6
 
5786
 49   A0=0.8392E-06*(1.0 + 0.1844E+02*S6-.1110E+02*S62-.2504E+02*S63)
 
5787
     $ * sqrt(sta - stbq6)
 
5788
      A1=0.2127E+00-.5602E+00*S6+0.4777E+01*S62-.1014E+02*S63
 
5789
      A2=0.1229E+01+0.7495E+01*S6-.5024E+01*S62-.1200E+02*S63
 
5790
      A3=0.2868E+02*(1.0 + 0.7634E+01*S6-.2916E+02*S62+0.2953E+02*S63)
 
5791
     $  -1.0
 
5792
      A4=0.5970E+00+0.1138E+01*S6-.1439E+01*S62-.1966E+01*S63
 
5793
      A5=0.6429E+01-.6673E+00*S6+0.7008E+01*S62-.1157E+02*S63
 
5794
      Pdf(-6) = A0*(x**A1)*((1.-x)**A2)*(1.+A3*(x**A4))
 
5795
     $     *(log(1.+1./x))**A5
 
5796
      goto 100
 
5797
 
 
5798
 5    continue
 
5799
c                                                             CTEQ1L
 
5800
c   ifl =     2
 
5801
 51   A0=  1.791*(1.0 -0.449*SB-0.445*SB2+  0.401*SB3)
 
5802
      A1=  0.608+  0.069*SB+  0.005*SB2-0.037*SB3
 
5803
      A2=  3.470-0.375*SB+  2.267*SB2-1.261*SB3
 
5804
      A3=  0.315*(1.0 -2.628*SB+  6.481*SB2-3.834*SB3)-1.0
 
5805
      A4=  1.007-0.732*SB+  1.490*SB2-0.966*SB3
 
5806
      A5=  0.000+  0.741*SB+  0.563*SB2-0.525*SB3
 
5807
      Pdf(2) = A0*(x**A1)*((1.-x)**A2)*(1.+A3*(x**A4))
 
5808
     $     *(log(1.+1./x))**A5
 
5809
      
 
5810
c   ifl =     1
 
5811
 52   A0=  0.513*(1.0 +   0.032*SB-0.120*SB2+  0.013*SB3)
 
5812
      A1=  0.276+  0.052*SB+  0.000*SB2-0.006*SB3
 
5813
      A2=  3.579+  0.763*SB-0.135*SB2+  0.083*SB3
 
5814
      A3= 17.993*(1.0 -0.725*SB+  0.241*SB2-0.020*SB3)-1.0
 
5815
      A4=  1.120-0.357*SB+  0.008*SB2+  0.028*SB3
 
5816
      A5=  0.000+  0.311*SB+  0.029*SB2-0.010*SB3
 
5817
      Pdf(1) = A0*(x**A1)*((1.-x)**A2)*(1.+A3*(x**A4))
 
5818
     $     *(log(1.+1./x))**A5
 
5819
      
 
5820
c   ifl =     0
 
5821
 53   A0=  2.710*(1.0 -1.773*SB+  0.970*SB2-0.149*SB3)
 
5822
      A1= -0.010-1.636*SB+  2.087*SB2-0.637*SB3
 
5823
      A2=  7.174+  2.102*SB-2.209*SB2-0.420*SB3
 
5824
      A3= 29.904*(1.0 -0.756*SB-0.506*SB2+  0.605*SB3)-1.0
 
5825
      A4=  2.572-0.437*SB-0.968*SB2+  0.243*SB3
 
5826
      A5=  0.000-1.776*SB+  4.266*SB2-0.335*SB3
 
5827
      Pdf(0) = A0*(x**A1)*((1.-x)**A2)*(1.+A3*(x**A4))
 
5828
     $     *(log(1.+1./x))**A5
 
5829
      
 
5830
c   ifl =    -1
 
5831
 54   A0=  0.278*(1.0 - 1.022*SB+  0.6457*SB2-0.1824*SB3)
 
5832
      A1=  0.0862*SB-0.8657*SB2+  0.4185*SB3
 
5833
      A2= 11.000-1.2809*SB+ 1.2516*SB2+0.061*SB3
 
5834
      A3= 37.338*(1.0 - 0.9404*SB+  0.2517*SB2+0.1364*SB3)-1.0
 
5835
      A4=  1.960-  0.3385*SB-0.3422*SB2+0.3653*SB3
 
5836
      A5=  0.000+1.424*SB-2.7503*SB2+  1.2226*SB3
 
5837
      Pdf(-1) = A0*(x**A1)*((1.-x)**A2)*(1.+A3*(x**A4))
 
5838
     $     *(log(1.+1./x))**A5
 
5839
      
 
5840
c   ifl =    -2
 
5841
 55   A0=  0.154*(1.0 -0.659*SB+  0.005*SB2+  0.061*SB3)
 
5842
      A1= -0.128+  0.279*SB-0.786*SB2+  0.363*SB3
 
5843
      A2=  8.649+  0.071*SB+  0.351*SB2-0.051*SB3
 
5844
      A3= 43.685*(1.0 -0.603*SB+  0.037*SB2+  0.134*SB3)-1.0
 
5845
      A4=  2.238-0.338*SB-0.199*SB2+  0.157*SB3
 
5846
      A5=  0.000+  1.681*SB-2.068*SB2+  0.975*SB3
 
5847
      Pdf(-2) = A0*(x**A1)*((1.-x)**A2)*(1.+A3*(x**A4))
 
5848
     $     *(log(1.+1./x))**A5
 
5849
      
 
5850
c   ifl =    -3
 
5851
 56   A0=  0.372*(1.0 -1.939*SB+  1.504*SB2-0.440*SB3)
 
5852
      A1=  0.009+  0.610*SB-1.387*SB2+  0.579*SB3
 
5853
      A2= 10.273-4.833*SB+  6.583*SB2-2.633*SB3
 
5854
      A3=  0.160*(1.0 +  10.325*SB-2.027*SB2+  1.571*SB3)-1.0
 
5855
      A4=  0.819-1.660*SB+  1.845*SB2-0.829*SB3
 
5856
      A5=  0.000+  3.558*SB-3.940*SB2+  1.302*SB3
 
5857
      Pdf(-3) = A0*(x**A1)*((1.-x)**A2)*(1.+A3*(x**A4))
 
5858
     $     *(log(1.+1./x))**A5
 
5859
      
 
5860
c   ifl =    -4
 
5861
 57   A0=  (7.5242E-5)*(1.0+22.0905*SB+7.1209*SB2-8.303*SB3)*
 
5862
     $     sqrt(sta - stbqm)
 
5863
      A1=  0.125-0.3027*SB+0.1564*SB2-0.091*SB3
 
5864
      A2=  2.0388+1.2161*SB+11.5296*SB2-8.0659*SB3
 
5865
      A3=  14.849*(1.0 -2.556*SB+3.5268*SB2-1.6353*SB3)-1.0
 
5866
      A4=  0.3061-0.0901*SB+0.953*SB2-0.4871*SB3
 
5867
      A5=  2.7352+0.1811*SB-0.5167*SB2+0.0543*SB3
 
5868
      Pdf(-4) = A0*(x**A1)*((1.-x)**A2)*(1.+A3*(x**A4))
 
5869
     $     *(log(1.+1./x))**A5
 
5870
      
 
5871
c   ifl =    -5
 
5872
      if(qq.le.qms(5,iset)) then
 
5873
         pdf(-5) = 0.0
 
5874
         pdf(-6) = 0.0
 
5875
         goto 100
 
5876
      endif
 
5877
      stbq5 = log(Qms(5,iset)/alam)
 
5878
      s5 = log(sta/stbq5)
 
5879
      s52 = s5*s5
 
5880
      s53 = s52*s5
 
5881
 58   A0=  (3.751E-4)*(1.0 + 21.5993*S5+3.1379*S52-18.8328*S53)*
 
5882
     $     sqrt(sta - stbq5)
 
5883
      A1= -0.0256-0.7717*S5+ 1.1499*S52-0.5037*S53
 
5884
      A2=  4.9241+4.0107*S5-4.7012*S52+0.1097*S53
 
5885
      A3=  2.842*(1.0 -2.2184*S5+  2.0293*S52-0.6907*S53)-1.0
 
5886
      A4=  -0.1352+ 0.8753*S5-1.2626*S52+  0.667*S53
 
5887
      A5=  1.5627-0.4917*S5+ 1.5927*S52-0.351*S53
 
5888
      Pdf(-5) = A0*(x**A1)*((1.-x)**A2)*(1.+A3*(x**A4))
 
5889
     $     *(log(1.+1./x))**A5
 
5890
      
 
5891
c   ifl =    -6
 
5892
      if(qq.le.qms(6,iset)) then
 
5893
         pdf(-6) = 0.0
 
5894
         goto 100
 
5895
      endif
 
5896
      stbq6 = log(Qms(6,iset)/alam)
 
5897
      s6 = log(sta/stbq6)
 
5898
      s62 = s6*s6
 
5899
      s63 = s62*s6
 
5900
 59   A0=(2.725E-4)*(1.0 +  18.8497*S6-26.5797*S62-29.0774*S63)*
 
5901
     $     sqrt(sta - stbq6)
 
5902
      A1= -0.2204-1.0048*S6+0.9415*S62-0.4274*S63
 
5903
      A2=  11.034-9.8362*S6-11.1034*S62-9.1977*S63
 
5904
      A3=  2.084*(1.0 -2.881*S6+1.2778*S62-2.9328*S63)-1.0
 
5905
      A4= -0.0872+  0.200*S6-1.6187*S62-1.6058*S63
 
5906
      A5=  0.8684+4.7047*S6-1.4614*S62-5.2309*S63
 
5907
      Pdf(-6) = A0*(x**A1)*((1.-x)**A2)*(1.+A3*(x**A4))
 
5908
     $     *(log(1.+1./x))**A5
 
5909
      goto 100
 
5910
 
 
5911
 100  continue
 
5912
 
 
5913
      do 110 iji = 2,-6,-1
 
5914
 110     if(pdf(iji).lt.0.0) pdf(iji)=0.0
 
5915
 
 
5916
 
 
5917
      Ist = Iset
 
5918
      Qsto = QQ
 
5919
      Xsto = xx
 
5920
 
 
5921
      Return
 
5922
C                                  -----------------------
 
5923
c      ENTRY WLAMBD (ISET, IORDER)
 
5924
 
 
5925
c      IORDER = IORD (ISET)
 
5926
c      WLAMBD = ALM  (ISET)
 
5927
                
 
5928
c      RETURN
 
5929
C                                  -----------------------
 
5930
      Entry PrCtq2 
 
5931
     >        (Iset, Iordr, Ischeme, MxFlv,
 
5932
     >         Alam4, Alam5, Alam6, Amas4, Amas5, Amas6,
 
5933
     >         Xmin, Qini, Qmax, ExpNor)
 
5934
 
 
5935
C                           Return QCD parameters and Fitting parameters
 
5936
C                           associated with parton distribution set Iset.
 
5937
C    Iord    : Order Of Fit
 
5938
C    Ischeme : (0, 1, 2)  for  (LO, MS-bar-NLO, DIS-NLO) resp.
 
5939
C    MxFlv   : Maximum number of flavors included
 
5940
C    Alam_i  : i = 4,5,6  Effective lambda for i-flavors 
 
5941
 
 
5942
C    Amas_i  : i = 4,5,6  Mass parameter for flavor i
 
5943
C    Xmin, Qini, Qmax : self explanary
 
5944
C    ExpNor(I) : Normalization factor for the experimental data set used in
 
5945
C                obtaining the best global fit for parton distributions Iset:
 
5946
C     I = 1,     2,      3,     4,     5,     6,     7,     8
 
5947
C      BCDMS   NMC90  NMC280  CCFR   E605    WA70   E706   UA6
 
5948
 
 
5949
      Iordr  = Iord (Iset)
 
5950
      Ischeme= Isch (Iset)
 
5951
      MxFlv  = Nqrk (Iset)
 
5952
 
 
5953
      Alam4  = Vlm(4,Iset)
 
5954
      Alam5  = Vlm(5,Iset)
 
5955
      Alam6  = Vlm(6,Iset)
 
5956
 
 
5957
      Amas4  = Qms(4,Iset)
 
5958
      Amas5  = Qms(5,Iset)
 
5959
      Amas6  = Qms(6,Iset)
 
5960
 
 
5961
      Xmin   = Xmn  (Iset)
 
5962
      Qini   = Qmn  (Iset)
 
5963
      Qmax   = Qmx  (Iset)
 
5964
 
 
5965
      Do 101 Iexp = 1, Nexp(Iset)
 
5966
         ExpNor(Iexp) = ExpN(Iexp, Iset)
 
5967
  101 Continue
 
5968
 
 
5969
      Return
 
5970
C                         *************************
 
5971
      END
 
5972
C--- END CTEQ1 FITS -----------------------------
 
5973
C--- START CTEQ3 FITS
 
5974
      SUBROUTINE  CTEQ3(ISET,IH,Q2,X,FX,NF)
 
5975
      REAL FX(-NF:NF) 
 
5976
      REAL*8 DX,DQ,PDF(-6:6)
 
5977
C     Pdf(Iprtn), Iprtn = (6, 5, 4, 3, 2, 1, 0, -1, -2, ......,   -6)
 
5978
C                  for (t, b, c, d, u, g, u_bar, d_bar,  ..., t_bar)
 
5979
      IF(ABS(IH).GE.3) CALL NOSETP
 
5980
      IH0=IH
 
5981
      IF(ABS(IH).EQ.2) IH0=ISIGN(1,IH)
 
5982
      Q=SQRT(Q2)
 
5983
      DQ=DBLE(Q)
 
5984
      DX=DBLE(X)
 
5985
      CALL CTQ3PDS(ISET,PDF,DX,DQ,IRT)
 
5986
c 
 
5987
      DO I=-NF,NF
 
5988
        FX(I*IH0)=PDF(I)/DX
 
5989
      ENDDO
 
5990
C...TRANSFORM PROTON INTO NEUTRON
 
5991
      IF(ABS(IH).EQ.2) THEN
 
5992
        T=FX(1)
 
5993
        FX(1)=FX(2)
 
5994
        FX(2)=T
 
5995
        T=FX(-1)
 
5996
        FX(-1)=FX(-2)
 
5997
        FX(-2)=T
 
5998
      ENDIF
 
5999
      END
 
6000
C     Version 3 CTEQ distribution function in a parametrized form.
 
6001
 
 
6002
C   By: H.L. Lai, J. Botts, J. Huston, J.G. Morfin, J.F. Owens, J. Qiu,
 
6003
C       W.K. Tung & H. Weerts;  Preprint MSU-HEP/41024, CTEQ 404 
 
6004
 
 
6005
C   This file contains three versions of the same CTEQ3 parton distributions: 
 
6006
C 
 
6007
C Two "front-end" subprograms:    
 
6008
C     FUNCTION Ctq3Pd (Iset, Iparton, X, Q, Irt) 
 
6009
C         returns the PROBABILITY density for a GIVEN flavor;
 
6010
C     SUBROUTINE Ctq3Pds(Iset, Pdf, XX, QQ, Irt)
 
6011
C         returns an array of MOMENTUM densities for ALL flavors;
 
6012
C One lower-level subprogram:
 
6013
C     FUNCTION Ctq3df (Iset, Iprtn, XX, QQ, Irt)
 
6014
C         returns the MOMENTUM density of a GIVEN valence or sea distribution.
 
6015
 
 
6016
C      One supplementary function to return the QCD lambda parameter 
 
6017
C      concerning these distributions is also included (see below). 
 
6018
 
 
6019
C     Although DOUBLE PRECISION is used, conversion to SINGLE PRECISION
 
6020
C     is straightforward by removing the 
 
6021
C     Implicit Double Precision statements. 
 
6022
 
 
6023
C     Since this is an initial distribution of version 3, it is
 
6024
C     useful for the authors to maintain a record of the distribution
 
6025
C     list in case there are revisions or corrections.
 
6026
C     In the interest of maintaining the integrity of this package,
 
6027
C     please do not freely distribute this program package; instead, refer
 
6028
C     any interested colleagues to direct their request for a copy to:
 
6029
C     Lai@cteq11.pa.msu.edu or Tung@msupa.pa.msu.edu.
 
6030
 
 
6031
C   If you have detailed questions concerning these CTEQ3 distributions, 
 
6032
C   or if you find problems/bugs using this initial distribution, direct 
 
6033
C   inquires to Hung-Liang Lai or Wu-Ki Tung.
 
6034
 
 
6035
C     -------------------------------------------
 
6036
C     Detailed instructions follow.
 
6037
 
 
6038
C     Name convention for CTEQ distributions:  CTEQnSx  where
 
6039
C        n : version number                      (currently n = 3)
 
6040
C        S : factorization scheme label: = [M L D] for [MS-bar LO DIS] 
 
6041
c               resp.
 
6042
C        x : special characteristics, if any
 
6043
C        (e.g. S(F) for singular (flat) small-x, L for "LEP lambda value")
 
6044
C        (not applicable to CTEQ3 since only three standard sets are given.)
 
6045
 
 
6046
C    Explanation of functional arguments:
 
6047
 
 
6048
C    Iset is the set label; in this version, Iset = 1, 2, 3 
 
6049
C                           correspond to the following CTEQ global fits:
 
6050
 
 
6051
C          cteq3M  : best fit in the MS-bar scheme 
 
6052
C          cteq3L  : best fit in Leading order QCD
 
6053
C          cteq3D  : best fit in the DIS scheme
 
6054
 
 
6055
C   Iprtn  is the parton label (6, 5, 4, 3, 2, 1, 0, -1, ......, -6)
 
6056
C                          for (t, b, c, s, d, u, g, u_bar, ..., t_bar)
 
6057
C  *** WARNING: We use the parton label 2 as D-quark, and 1 as U-quark which 
 
6058
C               might be different with your labels.
 
6059
 
 
6060
C   X, Q are the usual x, Q; 
 
6061
C   Irt is a return error code (see individual modules for explanation).
 
6062
C       
 
6063
C     ---------------------------------------------
 
6064
 
 
6065
C  Since the QCD Lambda value for the various sets are needed more often than
 
6066
C  the other parameters in most applications, a special function
 
6067
C     Wlamd3 (Iset, Iorder, Neff)                    is provided
 
6068
C  which returns the lambda value for Neff = 4,5,6 effective flavors as well as
 
6069
C  the order these values pertain to.
 
6070
 
 
6071
C     ----------------------------------------------
 
6072
C     The range of (x, Q) used in this round of global analysis is, approxi-
 
6073
C     mately,  0.01 < x < 0.75 ; and 4 GeV^2 < Q^2 < 400 GeV^2 for fixed target
 
6074
C     experiments and 0.0001 < x < 0.1 from HERA data.
 
6075
 
 
6076
C    The range of (x, Q) used in the reparametrization of the QCD evolved
 
6077
C    parton distributions is 10E-6 < x < 1 ; 1.6 GeV < Q < 10 TeV.  The 
 
6078
C    functional form of this parametrization is:
 
6079
 
 
6080
C      A0 * x^A1 * (1-x)^A2 * (1 + A3 * x^A4) * [log(1+1/x)]^A5
 
6081
 
 
6082
C   with the A'coefficients being smooth functions of Q.  For heavy quarks,
 
6083
C   a threshold factor is applied to A0 which simulates the proper Q-dependence
 
6084
C   of the QCD evolution in that region according to the renormalization
 
6085
C   scheme defined in Collins-Tung, Nucl. Phys. B278, 934 (1986).
 
6086
 
 
6087
C   Since this function is positive definite and smooth, it provides sensible
 
6088
C   extrapolations of the parton distributions if they are called beyond
 
6089
C   the original range in an application. There is no artificial boundaries
 
6090
C   or sharp cutoff's.
 
6091
C    ------------------------------------------------
 
6092
      SUBROUTINE Ctq3Pds(Iset, Pdf, X, Q, Irt)
 
6093
 
 
6094
C   This function returns the CTEQ parton distributions xf^Iset_Iprtn/proton
 
6095
C   --- the Momentum density in array form
 
6096
c
 
6097
C    (Iset, X, Q): explained in header comment lines;
 
6098
 
 
6099
C     Irt : return error code -- cumulated over flavors: 
 
6100
C           see module Ctq3df for explanation on individual flavors.
 
6101
C     Pdf (Iparton);  
 
6102
C         Iparton = -6, -5, ...0, 1, 2 ... 6
 
6103
C               has the same meaning as explained in the header comment lines.
 
6104
    
 
6105
      Implicit Double Precision (A-H, O-Z)
 
6106
      Dimension Pdf (-6:6)
 
6107
 
 
6108
      Irt=0
 
6109
      do 10 I=-6,2
 
6110
         if(I.le.0) then
 
6111
            Pdf(I) = Ctq3df(Iset,I,X,Q,Irt1)
 
6112
            Pdf(-I)= Pdf(I)
 
6113
         else
 
6114
            Pdf(I) = Ctq3df(Iset,I,X,Q,Irt1) + Pdf(-I)
 
6115
         endif
 
6116
         Irt=Irt+Irt1
 
6117
  10  Continue
 
6118
 
 
6119
      Return
 
6120
C                         *************************
 
6121
      End
 
6122
 
 
6123
      FUNCTION Ctq3df (Iset, Iprtn, XX, QQ, Irt)
 
6124
 
 
6125
C            Returns xf(x,Q) -- the momentum fraction distribution !!
 
6126
C            Returns valence and sea rather than combined flavor distr.
 
6127
 
 
6128
C            Iset : PDF set label
 
6129
 
 
6130
C            Iprtn  : Parton label:   2, 1 = d_ and u_ valence
 
6131
C                                     0 = gluon
 
6132
C                            -1, ... -6 = u, d, s, c, b, t sea quarks
 
6133
 
 
6134
C            XX  : Bjorken-x
 
6135
C            QQ  : scale parameter "Q"
 
6136
C      Irt : Return code
 
6137
C      0 : no error
 
6138
C      1 : parametrization is slightly negative; reset to 0.0.
 
6139
C          (This condition happens rarely -- only for large x where the 
 
6140
C          absolute value of the parton distribution is extremely small.) 
 
6141
 
 
6142
      IMPLICIT DOUBLE PRECISION (A-H, O-Z)
 
6143
 
 
6144
      PARAMETER (D0=0D0, D1=1D0, D2=2D0, D3=3D0, D4=4D0, D10=1D1)
 
6145
      Parameter (Nst = 3)
 
6146
 
 
6147
      DIMENSION
 
6148
     >   Iord(Nst), Isch(Nst), Nqrk(Nst),Alm(Nst)
 
6149
     > , Vlm(4:6,Nst), Qms(4:6, Nst)
 
6150
     > , Xmn(Nst), Qmn(Nst), Qmx(Nst)
 
6151
 
 
6152
c                                          --------- CTEQ3M
 
6153
c
 
6154
      DATA 
 
6155
     >  Isch(1), Iord(1), Nqrk(1), Alm(1) /  1,  2,  6, .239  / 
 
6156
     >  (Vlm(I,1), I=4,6) / .239,    .158,     .063   /
 
6157
     >  (Qms(I,1), I=4,6) / 1.60,   5.00,  180.0 /
 
6158
     >  Xmn(1), Qmn(1), Qmx(1) /  1.E-6,  1.60,  1.E4  /
 
6159
 
 
6160
c                                          --------- CTEQ3L
 
6161
c
 
6162
      DATA 
 
6163
     >  Isch(2), Iord(2), Nqrk(2), Alm(2) /  1,  1,  6, .177  / 
 
6164
     >  (Vlm(I,2), I=4,6) / .177,    .132,     .066   /
 
6165
     >  (Qms(I,2), I=4,6) / 1.60,   5.00,  180.0 /
 
6166
     >  Xmn(2), Qmn(2), Qmx(2) /  1.E-6,  1.60,  1.E4  /
 
6167
 
 
6168
c                                          --------- CTEQ3D
 
6169
c
 
6170
      DATA 
 
6171
     >  Isch(3), Iord(3), Nqrk(3), Alm(3) /  1,  2,  6, .247  / 
 
6172
     >  (Vlm(I,3), I=4,6) / .247,    .164,     .066   /
 
6173
     >  (Qms(I,3), I=4,6) / 1.60,   5.00,  180.0 /
 
6174
     >  Xmn(3), Qmn(3), Qmx(3) /  1.E-6,  1.60,  1.E4  /
 
6175
 
 
6176
 
 
6177
      Data Ist, Lp, Qsto / 0, -10, 1.2345 /
 
6178
 
 
6179
      save Ist, Lp, Qsto
 
6180
      save SB, SB2, SB3
 
6181
 
 
6182
      X  = XX
 
6183
      Irt = 0
 
6184
      if(Iset.eq.Ist .and. Qsto.eq.QQ) then
 
6185
C                                             if only change is in x:
 
6186
        if (Iprtn.eq.Lp) goto 100
 
6187
C                         if change in flv is within "light" partons:
 
6188
        if (Iprtn.ge.-3 .and. Lp.ge.-3) goto 501
 
6189
      endif
 
6190
 
 
6191
      Ip = abs(Iprtn)
 
6192
C                                                  Set up Qi for SB
 
6193
      If (Ip .GE. 4) then
 
6194
         If (QQ .LE. Qms(Ip, Iset)) Then
 
6195
           Ctq3df = 0.0
 
6196
           Return
 
6197
         Endif
 
6198
         Qi = Qms(ip, Iset)
 
6199
      Else
 
6200
         Qi = Qmn(Iset)
 
6201
      Endif
 
6202
C                   Use "standard lambda" of parametrization program
 
6203
      Alam = Alm (Iset)
 
6204
 
 
6205
      SBL = LOG(QQ/Alam) / LOG(Qi/Alam)
 
6206
      SB = LOG (SBL)
 
6207
      SB2 = SB*SB
 
6208
      SB3 = SB2*SB
 
6209
 
 
6210
 501  Iflv = 3 - Iprtn
 
6211
 
 
6212
      Goto (1,2,3, 311) Iset
 
6213
 
 
6214
 1    Goto(11,12,13,14,15,16,17,18,19)Iflv    
 
6215
c   Ifl =   2
 
6216
  11  A0=Exp(-0.7266E+00-0.1584E+01*SB +0.1259E+01*SB2-0.4305E-01*SB3)
 
6217
      A1= 0.5285E+00-0.3721E+00*SB +0.5150E+00*SB2-0.1697E+00*SB3 
 
6218
      A2= 0.4075E+01+0.8282E+00*SB -0.4496E+00*SB2+0.2107E+00*SB3 
 
6219
      A3= 0.3279E+01+0.5066E+01*SB -0.9134E+01*SB2+0.2897E+01*SB3 
 
6220
      A4= 0.4399E+00-0.5888E+00*SB +0.4802E+00*SB2-0.1664E+00*SB3 
 
6221
      A5= 0.3678E+00-0.8929E+00*SB +0.1592E+01*SB2-0.5713E+00*SB3 
 
6222
      goto 100
 
6223
c   Ifl =   1
 
6224
  12  A0=Exp( 0.2259E+00+0.1237E+00*SB +0.3035E+00*SB2-0.2935E+00*SB3)
 
6225
      A1= 0.5085E+00+0.1651E-01*SB -0.3592E-01*SB2+0.2782E-01*SB3 
 
6226
      A2= 0.3732E+01+0.4901E+00*SB +0.2218E+00*SB2-0.1116E+00*SB3 
 
6227
      A3= 0.7011E+01-0.6620E+01*SB +0.2557E+01*SB2-0.1360E+00*SB3 
 
6228
      A4= 0.8969E+00-0.2429E+00*SB +0.1811E+00*SB2-0.6888E-01*SB3 
 
6229
      A5= 0.8636E-01+0.2558E+00*SB -0.3082E+00*SB2+0.2535E+00*SB3 
 
6230
      goto 100
 
6231
c   Ifl =   0
 
6232
  13  A0=Exp(-0.2318E+00-0.9779E+00*SB -0.3783E+00*SB2+0.1037E-01*SB3)
 
6233
      A1=-0.2916E+00+0.1754E+00*SB -0.1884E+00*SB2+0.6116E-01*SB3 
 
6234
      A2= 0.5349E+01+0.7460E+00*SB +0.2319E+00*SB2-0.2622E+00*SB3 
 
6235
      A3= 0.6920E+01-0.3454E+01*SB +0.2027E+01*SB2-0.7626E+00*SB3 
 
6236
      A4= 0.1013E+01+0.1423E+00*SB -0.1798E+00*SB2+0.1872E-01*SB3 
 
6237
      A5=-0.5465E-01+0.2303E+01*SB -0.9584E+00*SB2+0.3098E+00*SB3 
 
6238
      goto 100
 
6239
c   Ifl =  -1
 
6240
  14  A0=Exp(-0.2906E+01-0.1069E+00*SB -0.1055E+01*SB2+0.2496E+00*SB3)
 
6241
      A1=-0.2875E+00+0.6571E-01*SB -0.1987E-01*SB2-0.1800E-02*SB3 
 
6242
      A2= 0.9854E+01-0.2715E+00*SB -0.7407E+00*SB2+0.2888E+00*SB3 
 
6243
      A3= 0.1583E+02-0.7687E+01*SB +0.3428E+01*SB2-0.3327E+00*SB3 
 
6244
      A4= 0.9763E+00+0.7599E-01*SB -0.2128E+00*SB2+0.6852E-01*SB3 
 
6245
      A5=-0.8444E-02+0.9434E+00*SB +0.4152E+00*SB2-0.1481E+00*SB3 
 
6246
      goto 100
 
6247
c   Ifl =  -2
 
6248
  15  A0=Exp(-0.2328E+01-0.3061E+01*SB +0.3620E+01*SB2-0.1602E+01*SB3)
 
6249
      A1=-0.3358E+00+0.3198E+00*SB -0.4210E+00*SB2+0.1571E+00*SB3 
 
6250
      A2= 0.8478E+01-0.3112E+01*SB +0.5243E+01*SB2-0.2255E+01*SB3 
 
6251
      A3= 0.1971E+02+0.3389E+00*SB -0.5268E+01*SB2+0.2099E+01*SB3 
 
6252
      A4= 0.1128E+01-0.4701E+00*SB +0.7779E+00*SB2-0.3506E+00*SB3 
 
6253
      A5=-0.4708E+00+0.3341E+01*SB -0.3375E+01*SB2+0.1353E+01*SB3 
 
6254
      goto 100
 
6255
c   Ifl =  -3
 
6256
  16  A0=Exp(-0.3780E+01+0.2499E+01*SB -0.4962E+01*SB2+0.1936E+01*SB3)
 
6257
      A1=-0.2639E+00-0.1575E+00*SB +0.3584E+00*SB2-0.1646E+00*SB3 
 
6258
      A2= 0.8082E+01+0.2794E+01*SB -0.5438E+01*SB2+0.2321E+01*SB3 
 
6259
      A3= 0.1811E+02-0.2000E+02*SB +0.1951E+02*SB2-0.6904E+01*SB3 
 
6260
      A4= 0.9822E+00+0.4972E+00*SB -0.8690E+00*SB2+0.3415E+00*SB3 
 
6261
      A5= 0.1772E+00-0.6078E+00*SB +0.3341E+01*SB2-0.1473E+01*SB3 
 
6262
      goto 100
 
6263
c   Ifl =  -4
 
6264
  17  A0=SB** 0.1122E+01*Exp(-0.4232E+01-0.1808E+01*SB +0.5348E+00*SB2)
 
6265
      A1=-0.2824E+00+0.5846E+00*SB -0.7230E+00*SB2+0.2419E+00*SB3 
 
6266
      A2= 0.5683E+01-0.2948E+01*SB +0.5916E+01*SB2-0.2560E+01*SB3 
 
6267
      A3= 0.2051E+01+0.4795E+01*SB -0.4271E+01*SB2+0.4174E+00*SB3 
 
6268
      A4= 0.1737E+00+0.1717E+01*SB -0.1978E+01*SB2+0.6643E+00*SB3 
 
6269
      A5= 0.8689E+00+0.3500E+01*SB -0.3283E+01*SB2+0.1026E+01*SB3 
 
6270
      goto 100
 
6271
c   Ifl =  -5
 
6272
  18  A0=SB** 0.9906E+00*Exp(-0.1496E+01-0.6576E+01*SB +0.1569E+01*SB2)
 
6273
      A1=-0.2140E+00-0.6419E-01*SB -0.2741E-02*SB2+0.3185E-02*SB3 
 
6274
      A2= 0.5781E+01+0.1049E+00*SB -0.3930E+00*SB2+0.5174E+00*SB3 
 
6275
      A3=-0.9420E+00+0.5511E+00*SB +0.8817E+00*SB2+0.1903E+01*SB3 
 
6276
      A4= 0.2418E-01+0.4232E-01*SB -0.1244E-01*SB2-0.2365E-01*SB3 
 
6277
      A5= 0.7664E+00+0.1794E+01*SB -0.4917E+00*SB2-0.1284E+00*SB3 
 
6278
      goto 100
 
6279
c   Ifl =  -6
 
6280
  19  A0=SB** 0.1000E+01*Exp(-0.8460E+01+0.1154E+01*SB +0.8838E+01*SB2)
 
6281
      A1=-0.4316E-01-0.2976E+00*SB +0.3174E+00*SB2-0.1429E+01*SB3 
 
6282
      A2= 0.4910E+01+0.2273E+01*SB +0.5631E+01*SB2-0.1994E+02*SB3 
 
6283
      A3= 0.1190E+02-0.2000E+02*SB -0.2000E+02*SB2+0.1292E+02*SB3 
 
6284
      A4= 0.5771E+00-0.2552E+00*SB +0.7510E+00*SB2+0.6923E+00*SB3 
 
6285
      A5= 0.4402E+01-0.1627E+01*SB -0.2085E+01*SB2-0.6737E+01*SB3 
 
6286
      goto 100
 
6287
 
 
6288
 2    Goto(21,22,23,24,25,26,27,28,29)Iflv    
 
6289
c   Ifl =   2
 
6290
  21  A0=Exp( 0.1141E+00+0.4764E+00*SB -0.1745E+01*SB2+0.7728E+00*SB3)
 
6291
      A1= 0.4275E+00-0.1290E+00*SB +0.3609E+00*SB2-0.1689E+00*SB3 
 
6292
      A2= 0.3000E+01+0.2946E+01*SB -0.4117E+01*SB2+0.1989E+01*SB3 
 
6293
      A3=-0.1302E+01+0.2322E+01*SB -0.4258E+01*SB2+0.2109E+01*SB3 
 
6294
      A4= 0.2586E+01-0.1920E+00*SB -0.3754E+00*SB2+0.2731E+00*SB3 
 
6295
      A5=-0.2251E+00-0.5374E+00*SB +0.2245E+01*SB2-0.1034E+01*SB3 
 
6296
      goto 100
 
6297
c   Ifl =   1
 
6298
  22  A0=Exp( 0.1907E+00+0.4205E-01*SB +0.2752E+00*SB2-0.3171E+00*SB3)
 
6299
      A1= 0.4611E+00+0.2331E-01*SB -0.3403E-01*SB2+0.3174E-01*SB3 
 
6300
      A2= 0.3504E+01+0.5739E+00*SB +0.2676E+00*SB2-0.1553E+00*SB3 
 
6301
      A3= 0.7452E+01-0.6742E+01*SB +0.2849E+01*SB2-0.1964E+00*SB3 
 
6302
      A4= 0.1116E+01-0.3435E+00*SB +0.2865E+00*SB2-0.1288E+00*SB3 
 
6303
      A5= 0.6659E-01+0.2714E+00*SB -0.2688E+00*SB2+0.2763E+00*SB3 
 
6304
      goto 100
 
6305
c   Ifl =   0
 
6306
  23  A0=Exp(-0.7631E+00-0.7241E+00*SB -0.1170E+01*SB2+0.5343E+00*SB3)
 
6307
      A1=-0.3573E+00+0.3469E+00*SB -0.3396E+00*SB2+0.9188E-01*SB3 
 
6308
      A2= 0.5604E+01+0.7458E+00*SB -0.5082E+00*SB2+0.1844E+00*SB3 
 
6309
      A3= 0.1549E+02-0.1809E+02*SB +0.1162E+02*SB2-0.3483E+01*SB3 
 
6310
      A4= 0.9881E+00+0.1364E+00*SB -0.4421E+00*SB2+0.2051E+00*SB3 
 
6311
      A5=-0.9505E-01+0.3259E+01*SB -0.1547E+01*SB2+0.2918E+00*SB3 
 
6312
      goto 100
 
6313
c   Ifl =  -1
 
6314
  24  A0=Exp(-0.2740E+01-0.7987E-01*SB -0.9015E+00*SB2-0.9872E-01*SB3)
 
6315
      A1=-0.3909E+00+0.1244E+00*SB -0.4487E-01*SB2+0.1277E-01*SB3 
 
6316
      A2= 0.9163E+01+0.2823E+00*SB -0.7720E+00*SB2-0.9360E-02*SB3 
 
6317
      A3= 0.1080E+02-0.3915E+01*SB -0.1153E+01*SB2+0.2649E+01*SB3 
 
6318
      A4= 0.9894E+00-0.1647E+00*SB -0.9426E-02*SB2+0.2945E-02*SB3 
 
6319
      A5=-0.3395E+00+0.6998E+00*SB +0.7000E+00*SB2-0.6730E-01*SB3 
 
6320
      goto 100
 
6321
c   Ifl =  -2
 
6322
  25  A0=Exp(-0.2449E+01-0.3513E+01*SB +0.4529E+01*SB2-0.2031E+01*SB3)
 
6323
      A1=-0.4050E+00+0.3411E+00*SB -0.3669E+00*SB2+0.1109E+00*SB3 
 
6324
      A2= 0.7470E+01-0.2982E+01*SB +0.5503E+01*SB2-0.2419E+01*SB3 
 
6325
      A3= 0.1503E+02+0.1638E+01*SB -0.8772E+01*SB2+0.3852E+01*SB3 
 
6326
      A4= 0.1137E+01-0.1006E+01*SB +0.1485E+01*SB2-0.6389E+00*SB3 
 
6327
      A5=-0.5299E+00+0.3160E+01*SB -0.3104E+01*SB2+0.1219E+01*SB3 
 
6328
      goto 100
 
6329
c   Ifl =  -3
 
6330
  26  A0=Exp(-0.3640E+01+0.1250E+01*SB -0.2914E+01*SB2+0.8390E+00*SB3)
 
6331
      A1=-0.3595E+00-0.5259E-01*SB +0.3122E+00*SB2-0.1642E+00*SB3 
 
6332
      A2= 0.7305E+01+0.9727E+00*SB -0.9788E+00*SB2-0.5193E-01*SB3 
 
6333
      A3= 0.1198E+02-0.1799E+02*SB +0.2614E+02*SB2-0.1091E+02*SB3 
 
6334
      A4= 0.9882E+00-0.6101E+00*SB +0.9737E+00*SB2-0.4935E+00*SB3 
 
6335
      A5=-0.1186E+00-0.3231E+00*SB +0.3074E+01*SB2-0.1274E+01*SB3 
 
6336
      goto 100
 
6337
c   Ifl =  -4
 
6338
  27  A0=SB** 0.1122E+01*Exp(-0.3718E+01-0.1335E+01*SB +0.1651E-01*SB2)
 
6339
      A1=-0.4719E+00+0.7509E+00*SB -0.8420E+00*SB2+0.2901E+00*SB3 
 
6340
      A2= 0.6194E+01-0.1641E+01*SB +0.4907E+01*SB2-0.2523E+01*SB3 
 
6341
      A3= 0.4426E+01-0.4270E+01*SB +0.6581E+01*SB2-0.3474E+01*SB3 
 
6342
      A4= 0.2683E+00+0.9876E+00*SB -0.7612E+00*SB2+0.1780E+00*SB3 
 
6343
      A5=-0.4547E+00+0.4410E+01*SB -0.3712E+01*SB2+0.1245E+01*SB3 
 
6344
      goto 100
 
6345
c   Ifl =  -5
 
6346
  28  A0=SB** 0.9838E+00*Exp(-0.2548E+01-0.7660E+01*SB +0.3702E+01*SB2)
 
6347
      A1=-0.3122E+00-0.2120E+00*SB +0.5716E+00*SB2-0.3773E+00*SB3 
 
6348
      A2= 0.6257E+01-0.8214E-01*SB -0.2537E+01*SB2+0.2981E+01*SB3 
 
6349
      A3=-0.6723E+00+0.2131E+01*SB +0.9599E+01*SB2-0.7910E+01*SB3 
 
6350
      A4= 0.9169E-01+0.4295E-01*SB -0.5017E+00*SB2+0.3811E+00*SB3 
 
6351
      A5= 0.2402E+00+0.2656E+01*SB -0.1586E+01*SB2+0.2880E+00*SB3 
 
6352
      goto 100
 
6353
c   Ifl =  -6
 
6354
  29  A0=SB** 0.1001E+01*Exp(-0.6934E+01+0.3050E+01*SB -0.6943E+00*SB2)
 
6355
      A1=-0.1713E+00-0.5167E+00*SB +0.1241E+01*SB2-0.1703E+01*SB3 
 
6356
      A2= 0.6169E+01+0.3023E+01*SB -0.1972E+02*SB2+0.1069E+02*SB3 
 
6357
      A3= 0.4439E+01-0.1746E+02*SB +0.1225E+02*SB2+0.8350E+00*SB3 
 
6358
      A4= 0.5458E+00-0.4586E+00*SB +0.9089E+00*SB2-0.4049E+00*SB3 
 
6359
      A5= 0.3207E+01-0.3362E+01*SB +0.5877E+01*SB2-0.7659E+01*SB3 
 
6360
      goto 100
 
6361
 
 
6362
 3    Goto(31,32,33,34,35,36,37,38,39)Iflv    
 
6363
c   Ifl =   2
 
6364
  31  A0=Exp( 0.3961E+00+0.4914E+00*SB -0.1728E+01*SB2+0.7257E+00*SB3)
 
6365
      A1= 0.4162E+00-0.1419E+00*SB +0.3680E+00*SB2-0.1618E+00*SB3 
 
6366
      A2= 0.3248E+01+0.3028E+01*SB -0.4307E+01*SB2+0.1920E+01*SB3 
 
6367
      A3=-0.1100E+01+0.2184E+01*SB -0.3820E+01*SB2+0.1717E+01*SB3 
 
6368
      A4= 0.2082E+01-0.2756E+00*SB +0.3043E+00*SB2-0.1260E+00*SB3 
 
6369
      A5=-0.4822E+00-0.5706E+00*SB +0.2243E+01*SB2-0.9760E+00*SB3 
 
6370
      goto 100
 
6371
c   Ifl =   1
 
6372
  32  A0=Exp( 0.2148E+00+0.5814E-01*SB +0.2734E+00*SB2-0.2902E+00*SB3)
 
6373
      A1= 0.4810E+00+0.1657E-01*SB -0.3800E-01*SB2+0.3125E-01*SB3 
 
6374
      A2= 0.3509E+01+0.3923E+00*SB +0.4010E+00*SB2-0.1932E+00*SB3 
 
6375
      A3= 0.7055E+01-0.6552E+01*SB +0.3466E+01*SB2-0.5657E+00*SB3 
 
6376
      A4= 0.1061E+01-0.3453E+00*SB +0.4089E+00*SB2-0.1817E+00*SB3 
 
6377
      A5= 0.8687E-01+0.2548E+00*SB -0.2967E+00*SB2+0.2647E+00*SB3 
 
6378
      goto 100
 
6379
c   Ifl =   0
 
6380
  33  A0=Exp(-0.4665E+00-0.7554E+00*SB -0.3323E+00*SB2-0.2734E-04*SB3)
 
6381
      A1=-0.3359E+00+0.2395E+00*SB -0.2377E+00*SB2+0.7059E-01*SB3 
 
6382
      A2= 0.5451E+01+0.6086E+00*SB +0.8606E-01*SB2-0.1425E+00*SB3 
 
6383
      A3= 0.1026E+02-0.9352E+01*SB +0.4879E+01*SB2-0.1150E+01*SB3 
 
6384
      A4= 0.9935E+00-0.5017E-01*SB -0.1707E-01*SB2-0.1464E-02*SB3 
 
6385
      A5=-0.4160E-01+0.2305E+01*SB -0.1063E+01*SB2+0.3211E+00*SB3 
 
6386
      goto 100
 
6387
c   Ifl =  -1
 
6388
  34  A0=Exp(-0.3323E+01+0.2296E+00*SB -0.1109E+01*SB2+0.2223E+00*SB3)
 
6389
      A1=-0.3410E+00+0.8847E-01*SB -0.1111E-01*SB2-0.5927E-02*SB3 
 
6390
      A2= 0.9753E+01-0.5182E+00*SB -0.4670E+00*SB2+0.1921E+00*SB3 
 
6391
      A3= 0.1977E+02-0.1600E+02*SB +0.9481E+01*SB2-0.1864E+01*SB3 
 
6392
      A4= 0.9818E+00+0.2839E-02*SB -0.1188E+00*SB2+0.3584E-01*SB3 
 
6393
      A5=-0.7934E-01+0.1004E+01*SB +0.3704E+00*SB2-0.1220E+00*SB3 
 
6394
      goto 100
 
6395
c   Ifl =  -2
 
6396
  35  A0=Exp(-0.2714E+01-0.2868E+01*SB +0.3700E+01*SB2-0.1671E+01*SB3)
 
6397
      A1=-0.3893E+00+0.3341E+00*SB -0.3897E+00*SB2+0.1420E+00*SB3 
 
6398
      A2= 0.8359E+01-0.3267E+01*SB +0.5327E+01*SB2-0.2245E+01*SB3 
 
6399
      A3= 0.2359E+02-0.5669E+01*SB -0.4602E+01*SB2+0.3153E+01*SB3 
 
6400
      A4= 0.1106E+01-0.4745E+00*SB +0.7739E+00*SB2-0.3417E+00*SB3 
 
6401
      A5=-0.5557E+00+0.3433E+01*SB -0.3390E+01*SB2+0.1354E+01*SB3 
 
6402
      goto 100
 
6403
c   Ifl =  -3
 
6404
  36  A0=Exp(-0.3985E+01+0.2855E+01*SB -0.5208E+01*SB2+0.1937E+01*SB3)
 
6405
      A1=-0.3337E+00-0.1150E+00*SB +0.3691E+00*SB2-0.1709E+00*SB3 
 
6406
      A2= 0.7968E+01+0.3641E+01*SB -0.6599E+01*SB2+0.2642E+01*SB3 
 
6407
      A3= 0.1873E+02-0.1999E+02*SB +0.1734E+02*SB2-0.5813E+01*SB3 
 
6408
      A4= 0.9731E+00+0.5082E+00*SB -0.8780E+00*SB2+0.3231E+00*SB3 
 
6409
      A5=-0.5542E-01-0.4189E+00*SB +0.3309E+01*SB2-0.1439E+01*SB3 
 
6410
      goto 100
 
6411
c   Ifl =  -4
 
6412
  37  A0=SB** 0.1105E+01*Exp(-0.3952E+01-0.1901E+01*SB +0.5137E+00*SB2)
 
6413
      A1=-0.3543E+00+0.6055E+00*SB -0.6941E+00*SB2+0.2278E+00*SB3 
 
6414
      A2= 0.5955E+01-0.2629E+01*SB +0.5337E+01*SB2-0.2300E+01*SB3 
 
6415
      A3= 0.1933E+01+0.4882E+01*SB -0.3810E+01*SB2+0.2290E+00*SB3 
 
6416
      A4= 0.1806E+00+0.1655E+01*SB -0.1893E+01*SB2+0.6395E+00*SB3 
 
6417
      A5= 0.4790E+00+0.3612E+01*SB -0.3152E+01*SB2+0.9684E+00*SB3 
 
6418
      goto 100
 
6419
c   Ifl =  -5
 
6420
  38  A0=SB** 0.9818E+00*Exp(-0.1825E+01-0.7464E+01*SB +0.2143E+01*SB2)
 
6421
      A1=-0.2604E+00-0.1400E+00*SB +0.1702E+00*SB2-0.8476E-01*SB3 
 
6422
      A2= 0.6005E+01+0.6275E+00*SB -0.2535E+01*SB2+0.2219E+01*SB3 
 
6423
      A3=-0.9067E+00+0.1149E+01*SB +0.1974E+01*SB2+0.4716E+01*SB3 
 
6424
      A4= 0.3915E-01+0.5945E-01*SB -0.9844E-01*SB2+0.2783E-01*SB3 
 
6425
      A5= 0.5500E+00+0.1994E+01*SB -0.6727E+00*SB2-0.1510E+00*SB3 
 
6426
      goto 100
 
6427
c   Ifl =  -6
 
6428
  39  A0=SB** 0.1002E+01*Exp(-0.8553E+01+0.3793E+00*SB +0.9998E+01*SB2)
 
6429
      A1=-0.5870E-01-0.2792E+00*SB +0.6526E+00*SB2-0.1984E+01*SB3 
 
6430
      A2= 0.4716E+01+0.4473E+00*SB +0.1128E+02*SB2-0.1937E+02*SB3 
 
6431
      A3= 0.1289E+02-0.1742E+02*SB -0.1983E+02*SB2-0.9274E+00*SB3 
 
6432
      A4= 0.5647E+00-0.2732E+00*SB +0.1074E+01*SB2+0.5981E+00*SB3 
 
6433
      A5= 0.4390E+01-0.1262E+01*SB -0.9026E+00*SB2-0.9394E+01*SB3 
 
6434
      goto 100
 
6435
 
 
6436
 311  stop 'This option is not currently supported.'
 
6437
 
 
6438
 100  Ctq3df = A0 *(x**A1) *((D1-x)**A2) *(D1+A3*(x**A4))
 
6439
     $            *(log(D1+D1/x))**A5
 
6440
 
 
6441
      if(Ctq3df.lt.D0) then
 
6442
        Ctq3df = D0
 
6443
        Irt=1
 
6444
      endif
 
6445
 
 
6446
      Ist = Iset
 
6447
 
 
6448
      Lp  = Iprtn
 
6449
      Qsto = QQ
 
6450
 
 
6451
      Return
 
6452
C                                  -----------------------
 
6453
      ENTRY Wlamd3 (Iset, Iorder, Neff)
 
6454
 
 
6455
C     Returns the EFFECTIVE QCD lambda values for order=Iorder and
 
6456
C     effective # of flavors = Neff for each of the PDF sets.
 
6457
 
 
6458
      Iorder = Iord (Iset)
 
6459
      Wlamd3 = VLM  (Neff, Iset)
 
6460
 
 
6461
      RETURN
 
6462
 
 
6463
C                         *************************
 
6464
      END
 
6465
C--- END CTEQ3 FITS
 
6466
C----- START CTEQ4 FITS ------------------------------
 
6467
      SUBROUTINE  CTEQ4(ISET,IH,Q2,X,FX,NF)
 
6468
      REAL FX(-NF:NF) 
 
6469
      REAL*8 DX,DQ,CTQ4FN
 
6470
C
 
6471
      IF(ABS(IH).GE.3) CALL NOSETP
 
6472
      IH0=IH
 
6473
      IF(ABS(IH).EQ.2) IH0=ISIGN(1,IH)
 
6474
      Q=SQRT(Q2)
 
6475
      DQ=DBLE(Q)
 
6476
      DX=DBLE(X)
 
6477
C The set CTEQ4A3 (iset=6 in the CTEQ convention) is identical to
 
6478
C the set CTEQ4M, and was not inserted in our package
 
6479
      IF(ISET.GE.6)ISET=ISET+1
 
6480
C The function CTQ4FN return the parton distribution inside the proton.
 
6481
C The division by the factor DX is NOT needed
 
6482
      FX(0)=SNGL(CTQ4FN(ISET,0,DX,DQ))
 
6483
      FX(IH0)=SNGL(CTQ4FN(ISET,1,DX,DQ))
 
6484
      FX(2*IH0)=SNGL(CTQ4FN(ISET,2,DX,DQ))
 
6485
      FX(-IH0)=SNGL(CTQ4FN(ISET,-1,DX,DQ))
 
6486
      FX(-2*IH0)=SNGL(CTQ4FN(ISET,-2,DX,DQ))
 
6487
      MF=NF
 
6488
      IF(NF.EQ.6) MF=5
 
6489
      DO I=3,MF
 
6490
        FX(I)=SNGL(CTQ4FN(ISET,I,DX,DQ))
 
6491
      ENDDO
 
6492
      DO I=-MF,-3
 
6493
        FX(I)=SNGL(CTQ4FN(ISET,I,DX,DQ))
 
6494
      ENDDO
 
6495
      IF(NF.EQ.6) THEN
 
6496
         FX(6)=0
 
6497
         FX(-6)=0
 
6498
      ENDIF
 
6499
C...TRANSFORM PROTON INTO NEUTRON
 
6500
      IF(ABS(IH).EQ.2) THEN
 
6501
        T=FX(1)
 
6502
        FX(1)=FX(2)
 
6503
        FX(2)=T
 
6504
        T=FX(-1)
 
6505
        FX(-1)=FX(-2)
 
6506
        FX(-2)=T
 
6507
      ENDIF
 
6508
      END
 
6509
 
 
6510
C============================================================================
 
6511
C                CTEQ Parton Distribution Functions: Version 4
 
6512
C                          June 21, 1996
 
6513
C
 
6514
C   By: H.L. Lai, J. Huston, S. Kuhlmann, F. Olness, J. Owens, D. Soper
 
6515
C       W.K. Tung, H. Weerts
 
6516
C   Ref: MSUHEP-60426, CTEQ-604, e-Print Archive: hep-ph/9606399
 
6517
C
 
6518
C   This package contains 9 sets of CTEQ4 PDF's. Details are:
 
6519
C ---------------------------------------------------------------------------
 
6520
C   Iset   PDF      Description             Alpha_s(Mz)  Q0(GeV)  Table_File
 
6521
C ---------------------------------------------------------------------------
 
6522
C   1      CTEQ4M   Standard MSbar scheme   0.116        1.6      cteq4m.tbl
 
6523
C   2      CTEQ4D   Standard DIS scheme     0.116        1.6      cteq4d.tbl
 
6524
C   3      CTEQ4L   Leading Order           0.116        1.6      cteq4l.tbl
 
6525
C   4      CTEQ4A1  Alpha_s series          0.110        1.6      cteq4a1.tbl
 
6526
C   5      CTEQ4A2  Alpha_s series          0.113        1.6      cteq4a2.tbl
 
6527
C   6      CTEQ4A3  same as CTEQ4M          0.116        1.6      cteq4m.tbl
 
6528
C   7      CTEQ4A4  Alpha_s series          0.119        1.6      cteq4a4.tbl
 
6529
C   8      CTEQ4A5  Alpha_s series          0.122        1.6      cteq4a5.tbl
 
6530
C   9      CTEQ4HJ  High Jet                0.116        1.6      cteq4hj.tbl
 
6531
C   10     CTEQ4LQ  Low Q0                  0.114        0.7      cteq4lq.tbl
 
6532
C ---------------------------------------------------------------------------
 
6533
C   
 
6534
C   The available applied range is 10^-5 < x < 1 and 1.6 < Q < 10,000 (GeV) 
 
6535
C   except CTEQ4LQ for which Q starts at a lower value of 0.7 GeV.  
 
6536
C   The Table_Files are assumed to be in the working directory.
 
6537
C   
 
6538
C   The function Ctq4Fn (Iset, Iparton, X, Q)
 
6539
C   returns the parton distribution inside the proton for parton [Iparton] 
 
6540
C   at [X] Bjorken_X and scale [Q] (GeV) in PDF set [Iset].
 
6541
C   Iparton  is the parton label (5, 4, 3, 2, 1, 0, -1, ......, -5)
 
6542
C                            for (b, c, s, d, u, g, u_bar, ..., b_bar)
 
6543
C   
 
6544
C   For detailed information on the parameters used, e.q. quark masses, 
 
6545
C   QCD Lambda, ... etc.,  see info lines at the beginning of the 
 
6546
C   Table_Files.
 
6547
 
 
6548
C   These programs, as provided, are in double precision.  By removing the
 
6549
C   "Implicit Double Precision" lines, they can also be run in single 
 
6550
C   precision.
 
6551
C   
 
6552
C   If you have detailed questions concerning these CTEQ4 distributions, 
 
6553
C   or if you find problems/bugs using this package, direct inquires to 
 
6554
C   Hung-Liang Lai(Lai_H@pa.msu.edu) or Wu-Ki Tung(Tung@pa.msu.edu).
 
6555
C   
 
6556
C===========================================================================
 
6557
 
 
6558
      Function Ctq4Fn (Iset, Iparton, X, Q)
 
6559
      Implicit Double Precision (A-H,O-Z)
 
6560
      Character Flnm(10)*11
 
6561
      Common
 
6562
     > / K719CtqPar2 / Nx, Nt, NfMx
 
6563
     > / K719QCDtable /  Alambda, Nfl, Iorder
 
6564
      Data (Flnm(I), I=1,10)
 
6565
     > / 'cteq4m', 'cteq4d', 'cteq4l'
 
6566
     > , 'cteq4a1', 'cteq4a2', 'cteq4m', 'cteq4a4'
 
6567
     > , 'cteq4a5', 'cteq4hj', 'cteq4lq' /
 
6568
      Data Isetold, Isetmin, Isetmax / -987, 1, 10 /
 
6569
      save
 
6570
 
 
6571
C             If data file not initialized, do so.
 
6572
      If(Iset.ne.Isetold) then
 
6573
         If (Iset.lt.Isetmin .or. Iset.gt.Isetmax) Then
 
6574
            Print *, 'Invalid Iset number in Ctq4Fn :', Iset
 
6575
            Stop
 
6576
         Endif
 
6577
         IU= NextUt()
 
6578
         Open(IU, File=Flnm(Iset), Status='OLD', Err=100)
 
6579
         Call ReadTbl (IU)
 
6580
         Close (IU)
 
6581
         Isetold=Iset
 
6582
      Endif
 
6583
 
 
6584
      If (X .lt. 0D0 .or. X .gt. 1D0) Then
 
6585
        Print *, 'X out of range in Ctq4Fn: ', X
 
6586
        Stop
 
6587
      Endif
 
6588
      If (Q .lt. Alambda) Then
 
6589
        Print *, 'Q out of range in Ctq4Fn: ', Q
 
6590
        Stop
 
6591
      Endif
 
6592
      If (Iparton .lt. -NfMx .or. Iparton .gt. NfMx) Then
 
6593
        Print *, 'Iparton out of range in Ctq4Fn: ', Iparton
 
6594
        Stop
 
6595
      Endif
 
6596
 
 
6597
      Ctq4Fn = PartonX (Iparton, X, Q)
 
6598
      if(Ctq4Fn.lt.0.D0)  Ctq4Fn = 0.D0
 
6599
 
 
6600
      Return
 
6601
 
 
6602
 100  Print *, ' Data file ', Flnm(Iset), ' cannot be opened '
 
6603
     >//'in Ctq4Fn!!'
 
6604
      Stop
 
6605
C                             ********************
 
6606
      End
 
6607
 
 
6608
      Function NextUt()
 
6609
C                                 Returns an unallocated FORTRAN i/o unit.
 
6610
      Logical EX
 
6611
C
 
6612
      Do 10 N = 50, 300
 
6613
         INQUIRE (UNIT=N, OPENED=EX)
 
6614
         If (.NOT. EX) then
 
6615
            NextUt = N
 
6616
            Return
 
6617
         Endif
 
6618
 10   Continue
 
6619
      Stop ' There is no available I/O unit. '
 
6620
C               *************************
 
6621
      End
 
6622
C
 
6623
 
 
6624
      Subroutine ReadTbl (Nu)
 
6625
      Implicit Double Precision (A-H,O-Z)
 
6626
      Character Line*80
 
6627
      PARAMETER (MXX = 105, MXQ = 25, MXF = 6)
 
6628
      PARAMETER (MXPQX = (MXF *2 +2) * MXQ * MXX)
 
6629
      Common 
 
6630
     > / K719CtqPar1 / Al, XV(0:MXX), QL(0:MXQ), UPD(MXPQX)
 
6631
     > / K719CtqPar2 / Nx, Nt, NfMx
 
6632
     > / K719XQrange / Qini, Qmax, Xmin
 
6633
     > / K719QCDtable /  Alambda, Nfl, Iorder
 
6634
     > / K719Masstbl / Amass(6)
 
6635
      
 
6636
      Read  (Nu, '(A)') Line     
 
6637
      Read  (Nu, '(A)') Line
 
6638
      Read  (Nu, *) Dr, Fl, Al, (Amass(I),I=1,6)
 
6639
      Iorder = Nint(Dr)
 
6640
      Nfl = Nint(Fl)
 
6641
      Alambda = Al
 
6642
 
 
6643
      Read  (Nu, '(A)') Line 
 
6644
      Read  (Nu, *) NX,  NT, NfMx
 
6645
 
 
6646
      Read  (Nu, '(A)') Line
 
6647
      Read  (Nu, *) QINI, QMAX, (QL(I), I =0, NT)
 
6648
 
 
6649
      Read  (Nu, '(A)') Line
 
6650
      Read  (Nu, *) XMIN, (XV(I), I =0, NX)
 
6651
 
 
6652
      Do 11 Iq = 0, NT
 
6653
         QL(Iq) = Log (QL(Iq) /Al)
 
6654
   11 Continue
 
6655
C
 
6656
C                  Since quark = anti-quark for nfl>2 at this stage, 
 
6657
C                  we Read  out only the non-redundent data points
 
6658
C     No of flavors = NfMx (sea) + 1 (gluon) + 2 (valence) 
 
6659
 
 
6660
      Nblk = (NX+1) * (NT+1)
 
6661
      Npts =  Nblk  * (NfMx+3)
 
6662
      Read  (Nu, '(A)') Line
 
6663
      Read  (Nu, *, IOSTAT=IRET) (UPD(I), I=1,Npts)
 
6664
 
 
6665
      Return
 
6666
C                        ****************************
 
6667
      End
 
6668
 
 
6669
      FUNCTION PartonX (IPRTN, X, Q)
 
6670
C
 
6671
C   Given the parton distribution function in the array Upd in
 
6672
C   COMMON / CtqPar1 / , this routine fetches u(fl, x, q) at any value of
 
6673
C   x and q using Mth-order polynomial interpolation for x and Ln(Q/Lambda).
 
6674
C
 
6675
      IMPLICIT DOUBLE PRECISION (A-H, O-Z)
 
6676
C
 
6677
      PARAMETER (MXX = 105, MXQ = 25, MXF = 6)
 
6678
      PARAMETER (MXPQX = (MXF *2 +2) * MXQ * MXX)
 
6679
      PARAMETER (M= 2, M1 = M + 1)
 
6680
C
 
6681
      Common 
 
6682
     > / K719CtqPar1 / Al, XV(0:MXX), QL(0:MXQ), UPD(MXPQX)
 
6683
     > / K719CtqPar2 / Nx, Nt, NfMx
 
6684
     > / K719XQrange / Qini, Qmax, Xmin
 
6685
      Dimension Fq(M1), Df(M1)
 
6686
      data ixrange/0/
 
6687
      data iqmnrng/0/
 
6688
      data iqmxrng/0/
 
6689
      save ixrange,iqmnrng,iqmxrng
 
6690
C
 
6691
C                                                 Work with Log (Q)
 
6692
      QG  = LOG (Q/AL)
 
6693
 
 
6694
C                           Find lower end of interval containing X
 
6695
      JL = -1
 
6696
      JU = Nx+1
 
6697
 11   If (JU-JL .GT. 1) Then
 
6698
         JM = (JU+JL) / 2
 
6699
         If (X .GT. XV(JM)) Then
 
6700
            JL = JM
 
6701
         Else
 
6702
            JU = JM
 
6703
         Endif
 
6704
         Goto 11
 
6705
      Endif
 
6706
 
 
6707
      Jx = JL - (M-1)/2
 
6708
      If (X .lt. Xmin) Then
 
6709
         ixrange=ixrange+1
 
6710
         if(ixrange.eq.1) Print '(A, 2(1pE12.4))', 
 
6711
     >     ' WARNING: X < Xmin, extrapolation used; X, Xmin =', X, Xmin
 
6712
         If (Jx .LT. 0) Jx = 0
 
6713
      Elseif (Jx .GT. Nx-M) Then
 
6714
         Jx = Nx - M
 
6715
      Endif
 
6716
C                                    Find the interval where Q lies
 
6717
      JL = -1
 
6718
      JU = NT+1
 
6719
 12   If (JU-JL .GT. 1) Then
 
6720
         JM = (JU+JL) / 2
 
6721
         If (QG .GT. QL(JM)) Then
 
6722
            JL = JM
 
6723
         Else
 
6724
            JU = JM
 
6725
         Endif
 
6726
         Goto 12
 
6727
      Endif
 
6728
 
 
6729
      Jq = JL - (M-1)/2
 
6730
      If (Jq .LT. 0) Then
 
6731
         Jq = 0
 
6732
         If (Q .lt. Qini)  then
 
6733
           iqmnrng=iqmnrng+1
 
6734
           if(iqmnrng.eq.1) Print '(A, 2(1pE12.4))', 
 
6735
     >     ' WARNING: Q < Qini, extrapolation used; Q, Qini =', Q, Qini
 
6736
         endif
 
6737
      Elseif (Jq .GT. Nt-M) Then
 
6738
         Jq = Nt - M
 
6739
         If (Q .gt. Qmax) then
 
6740
           iqmxrng=iqmxrng+1
 
6741
           if(iqmxrng.eq.1) Print '(A, 2(1pE12.4))', 
 
6742
     >     ' WARNING: Q > Qmax, extrapolation used; Q, Qmax =', Q, Qmax
 
6743
         endif
 
6744
      Endif
 
6745
 
 
6746
      If (Iprtn .GE. 3) Then
 
6747
         Ip = - Iprtn
 
6748
      Else
 
6749
         Ip = Iprtn
 
6750
      EndIf
 
6751
C                             Find the off-set in the linear array Upd
 
6752
      JFL = Ip + NfMx
 
6753
      J0  = (JFL * (NT+1) + Jq) * (NX+1) + Jx
 
6754
C
 
6755
C                                           Now interpolate in x for M1 Q's
 
6756
      Do 21 Iq = 1, M1
 
6757
         J1 = J0 + (Nx+1)*(Iq-1) + 1
 
6758
         Call Polint_dd (XV(Jx), Upd(J1), M1, X, Fq(Iq), Df(Iq))
 
6759
 21   Continue
 
6760
C                                          Finish off by interpolating in Q
 
6761
      Call Polint_dd (QL(Jq), Fq(1), M1, QG, Ftmp, Ddf)
 
6762
 
 
6763
      PartonX = Ftmp
 
6764
C
 
6765
      RETURN
 
6766
C                        ****************************
 
6767
      END
 
6768
 
 
6769
      SUBROUTINE POLINT_DD (XA,YA,N,X,Y,DY)
 
6770
 
 
6771
      IMPLICIT DOUBLE PRECISION (A-H, O-Z)
 
6772
C                                        Adapted from "Numerical Recipes" 
 
6773
      PARAMETER (NMAX=10)
 
6774
      DIMENSION XA(N),YA(N),C(NMAX),D(NMAX)
 
6775
      NS=1
 
6776
      DIF=ABS(X-XA(1))
 
6777
      DO 11 I=1,N
 
6778
        DIFT=ABS(X-XA(I))
 
6779
        IF (DIFT.LT.DIF) THEN
 
6780
          NS=I
 
6781
          DIF=DIFT
 
6782
        ENDIF
 
6783
        C(I)=YA(I)
 
6784
        D(I)=YA(I)
 
6785
11    CONTINUE
 
6786
      Y=YA(NS)
 
6787
      NS=NS-1
 
6788
      DO 13 M=1,N-1
 
6789
        DO 12 I=1,N-M
 
6790
          HO=XA(I)-X
 
6791
          HP=XA(I+M)-X
 
6792
          W=C(I+1)-D(I)
 
6793
          DEN=HO-HP
 
6794
          IF(DEN.EQ.0.)PAUSE
 
6795
          DEN=W/DEN
 
6796
          D(I)=HP*DEN
 
6797
          C(I)=HO*DEN
 
6798
12      CONTINUE
 
6799
        IF (2*NS.LT.N-M)THEN
 
6800
          DY=C(NS+1)
 
6801
        ELSE
 
6802
          DY=D(NS)
 
6803
          NS=NS-1
 
6804
        ENDIF
 
6805
        Y=Y+DY
 
6806
13    CONTINUE
 
6807
      RETURN
 
6808
      END
 
6809
C--- END CTEQ4 FITS -----------------------------
 
6810
C
 
6811
C----- START CTEQ5 FITS ------------------------------
 
6812
C Cteq5m1 (fitted form) added on mar-23-2001 by SF
 
6813
c This set seemingly supersedes Cteq5m, which was affected (?) by a bug
 
6814
c in the evolution code
 
6815
      SUBROUTINE  CTEQ5(ISET,IH,Q2,X,FX,NF)
 
6816
      REAL FX(-NF:NF)  
 
6817
      REAL*8 DX,DQ,CTQ5PDF,CTQ5PD,PDFS(-NF:NF)
 
6818
      DATA INIT/0/ 
 
6819
C                         
 
6820
      Q=SQRT(Q2)
 
6821
      DQ=DBLE(Q)
 
6822
      DX=DBLE(X)
 
6823
      IF(ISET.LE.9)THEN
 
6824
         CALL SETCTQ5(ISET)
 
6825
         DO I=-NF,NF
 
6826
            PDFS(I)=CTQ5PDF(I,DX,DQ)
 
6827
         ENDDO
 
6828
      ELSEIF(ISET.EQ.10) THEN
 
6829
         DO I=-NF,NF
 
6830
            PDFS(I)=CTQ5PD(1,I,DX,DQ,IRET) 
 
6831
         ENDDO
 
6832
      ELSE
 
6833
         CALL NOSETP
 
6834
      ENDIF
 
6835
C     
 
6836
      IF(ABS(IH).GE.3) CALL NOSETP
 
6837
      IH0=IH
 
6838
      IF(ABS(IH).EQ.2) IH0=ISIGN(1,IH)
 
6839
C The function CTQ5PDF return the parton distribution inside the proton.
 
6840
C The division by the factor DX is NOT needed
 
6841
      FX(0)=SNGL(PDFS(0))
 
6842
      FX(IH0)=SNGL(PDFS(1))
 
6843
      FX(2*IH0)=SNGL(PDFS(2))
 
6844
      FX(-IH0)=SNGL(PDFS(-1))
 
6845
      FX(-2*IH0)=SNGL(PDFS(-2))
 
6846
      DO I=3,NF              
 
6847
        FX(I)=SNGL(PDFS(I))
 
6848
      ENDDO          
 
6849
      DO I=-NF,-3
 
6850
        FX(I)=SNGL(PDFS(I))
 
6851
      ENDDO          
 
6852
C...TRANSFORM PROTON INTO NEUTRON
 
6853
      IF(ABS(IH).EQ.2) THEN
 
6854
        T=FX(1)
 
6855
        FX(1)=FX(2)
 
6856
        FX(2)=T
 
6857
        T=FX(-1)
 
6858
        FX(-1)=FX(-2)
 
6859
        FX(-2)=T
 
6860
      ENDIF
 
6861
      END
 
6862
 
 
6863
C============================================================================
 
6864
C                CTEQ Parton Distribution Functions: Version 5.0
 
6865
C                             Nov. 1, 1999
 
6866
C
 
6867
C   Ref: "GLOBAL QCD ANALYSIS OF PARTON STRUCTURE OF THE NUCLEON:
 
6868
C         CTEQ5 PPARTON DISTRIBUTIONS"
 
6869
C
 
6870
C  hep-ph/9903282; to be published in Eur. Phys. J. C 1999.
 
6871
C
 
6872
C  These PDF's use quadratic interpolation of attached tables. A parametrized 
 
6873
C  version of the same PDF's without external tables is under construction.  
 
6874
C  They will become available later.
 
6875
C
 
6876
C   This package contains 7 sets of CTEQ5 PDF's; plus two updated ones.
 
6877
C   The undated CTEQ5M1 and CTEQHQ1 use an improved evolution code.
 
6878
C   Both the original and the updated ones fit current data with comparable
 
6879
C   accuracy.  The CTEQHQ1 set also involve a different choice of scale,
 
6880
C   hence differs from CTEQHQ slightly more.  It is preferred over CTEQ5HQ.
 
6881
 
 
6882
C   Details are:
 
6883
C ---------------------------------------------------------------------------
 
6884
C  Iset   PDF        Description       Alpha_s(Mz)  Lam4  Lam5   Table_File
 
6885
C ---------------------------------------------------------------------------
 
6886
C   1    CTEQ5M   Standard MSbar scheme   0.118     326   226    cteq5m.tbl
 
6887
C   2    CTEQ5D   Standard DIS scheme     0.118     326   226    cteq5d.tbl
 
6888
C   3    CTEQ5L   Leading Order           0.127     192   146    cteq5l.tbl
 
6889
C   4    CTEQ5HJ  Large-x gluon enhanced  0.118     326   226    cteq5hj.tbl
 
6890
C   5    CTEQ5HQ  Heavy Quark             0.118     326   226    cteq5hq.tbl
 
6891
C   6    CTEQ5F3  Nf=3 FixedFlavorNumber  0.106     (Lam3=395)   cteq5f3.tbl
 
6892
C   7    CTEQ5F4  Nf=4 FixedFlavorNumber  0.112     309   XXX    cteq5f4.tbl
 
6893
C         --------------------------------------------------------
 
6894
C   8    CTEQ5M1  Improved CTEQ5M         0.118     326   226    cteq5m1.tbl
 
6895
C   9    CTEQ5HQ1 Improved CTEQ5HQ        0.118     326   226    ctq5hq1.tbl
 
6896
C ---------------------------------------------------------------------------
 
6897
C   
 
6898
C  The available applied range is 10^-5 << x << 1 and 1.0 << Q << 10,000 (GeV).
 
6899
C   Lam5 (Lam4, Lam3) represents Lambda value (in MeV) for 5 (4,3) flavors. 
 
6900
C   The matching alpha_s between 4 and 5 flavors takes place at Q=4.5 GeV,  
 
6901
C   which is defined as the bottom quark mass, whenever it can be applied.
 
6902
C
 
6903
C   The Table_Files are assumed to be in the working directory.
 
6904
C   
 
6905
C   Before using the PDF, it is necessary to do the initialization by
 
6906
C       Call SetCtq5(Iset) 
 
6907
C   where Iset is the desired PDF specified in the above table.
 
6908
C   
 
6909
C   The function Ctq5Pdf (Iparton, X, Q)
 
6910
C   returns the parton distribution inside the proton for parton [Iparton] 
 
6911
C   at [X] Bjorken_X and scale [Q] (GeV) in PDF set [Iset].
 
6912
C   Iparton  is the parton label (5, 4, 3, 2, 1, 0, -1, ......, -5)
 
6913
C                            for (b, c, s, d, u, g, u_bar, ..., b_bar),
 
6914
C      whereas CTEQ5F3 has, by definition, only 3 flavors and gluon;
 
6915
C              CTEQ5F4 has only 4 flavors and gluon.
 
6916
C   
 
6917
C   For detailed information on the parameters used, e.q. quark masses, 
 
6918
C   QCD Lambda, ... etc.,  see info lines at the beginning of the 
 
6919
C   Table_Files.
 
6920
C
 
6921
C   These programs, as provided, are in double precision.  By removing the
 
6922
C   "Implicit Double Precision" lines, they can also be run in single 
 
6923
C   precision.
 
6924
C   
 
6925
C   If you have detailed questions concerning these CTEQ5 distributions, 
 
6926
C   or if you find problems/bugs using this package, direct inquires to 
 
6927
C   Hung-Liang Lai(lai@phys.nthu.edu.tw) or Wu-Ki Tung(Tung@pa.msu.edu).
 
6928
C   
 
6929
C===========================================================================
 
6930
 
 
6931
      Function Ctq5Pdf (Iparton, X, Q)
 
6932
      Implicit Double Precision (A-H,O-Z)
 
6933
      Logical Warn
 
6934
      Common
 
6935
     > / K719CtqPar2 / Nx, Nt, NfMx
 
6936
     > / K719QCDtable /  Alambda, Nfl, Iorder
 
6937
 
 
6938
      Data Warn /.true./
 
6939
      save Warn
 
6940
 
 
6941
      If (X .lt. 0D0 .or. X .gt. 1D0) Then
 
6942
        Print *, 'X out of range in Ctq5Pdf: ', X
 
6943
        Stop
 
6944
      Endif
 
6945
      If (Q .lt. Alambda) Then
 
6946
        Print *, 'Q out of range in Ctq5Pdf: ', Q
 
6947
        Stop
 
6948
      Endif
 
6949
      If ((Iparton .lt. -NfMx .or. Iparton .gt. NfMx)) Then
 
6950
         If (Warn) Then
 
6951
C        put a warning for calling extra flavor.
 
6952
             Warn = .false.
 
6953
             Print *, 'Warning: Iparton out of range in Ctq5Pdf: '
 
6954
     >              , Iparton
 
6955
         Endif
 
6956
         Ctq5Pdf = 0D0
 
6957
         Return
 
6958
      Endif
 
6959
 
 
6960
      Ctq5Pdf = Ctq5partonx (Iparton, X, Q)
 
6961
      if(Ctq5Pdf.lt.0.D0)  Ctq5Pdf = 0.D0
 
6962
 
 
6963
      Return
 
6964
 
 
6965
C                             ********************
 
6966
      End
 
6967
 
 
6968
      FUNCTION Ctq5partonx (IPRTN, X, Q)
 
6969
C                     
 
6970
C   Given the parton distribution function in the array Upd in
 
6971
C   COMMON / K719CtqPar1 / , this routine fetches u(fl, x, q) at any value of
 
6972
C   x and q using Mth-order polynomial interpolation for x and Ln(Q/Lambda).
 
6973
C
 
6974
      IMPLICIT DOUBLE PRECISION (A-H, O-Z)
 
6975
C
 
6976
      PARAMETER (MXX = 105, MXQ = 25, MXF = 6)
 
6977
      PARAMETER (MXPQX = (MXF *2 +2) * MXQ * MXX)
 
6978
      PARAMETER (M= 2, M1 = M + 1)
 
6979
C
 
6980
      Logical First
 
6981
      Common 
 
6982
     > / K719CtqPar1 / Al, XV(0:MXX), QL(0:MXQ), UPD(MXPQX)
 
6983
     > / K719CtqPar2 / Nx, Nt, NfMx
 
6984
     > / K719XQrange / Qini, Qmax, Xmin
 
6985
      Dimension Fq(M1), Df(M1)
 
6986
      data ixrange/0/
 
6987
      data iqmnrng/0/
 
6988
      data iqmxrng/0/
 
6989
      save ixrange,iqmnrng,iqmxrng
 
6990
C
 
6991
 
 
6992
      Data First /.true./
 
6993
      save First
 
6994
C                                                 Work with Log (Q)
 
6995
      QG  = LOG (Q/AL)
 
6996
 
 
6997
C                           Find lower end of interval containing X
 
6998
      JL = -1
 
6999
      JU = Nx+1
 
7000
 11   If (JU-JL .GT. 1) Then
 
7001
         JM = (JU+JL) / 2
 
7002
         If (X .GT. XV(JM)) Then
 
7003
            JL = JM
 
7004
         Else
 
7005
            JU = JM
 
7006
         Endif
 
7007
         Goto 11
 
7008
      Endif
 
7009
 
 
7010
      Jx = JL - (M-1)/2
 
7011
      If (X .lt. Xmin .and. First ) Then
 
7012
         First = .false.
 
7013
         Print '(A, 2(1pE12.4))', 
 
7014
     >     ' WARNING: X << Xmin, extrapolation used; X, Xmin =', X, Xmin
 
7015
         If (Jx .LT. 0) Jx = 0
 
7016
      Elseif (Jx .GT. Nx-M) Then
 
7017
         Jx = Nx - M
 
7018
      Endif
 
7019
C                                    Find the interval where Q lies
 
7020
      JL = -1
 
7021
      JU = NT+1
 
7022
 12   If (JU-JL .GT. 1) Then
 
7023
         JM = (JU+JL) / 2
 
7024
         If (QG .GT. QL(JM)) Then
 
7025
            JL = JM
 
7026
         Else
 
7027
            JU = JM
 
7028
         Endif
 
7029
         Goto 12
 
7030
      Endif
 
7031
 
 
7032
      Jq = JL - (M-1)/2
 
7033
      If (Jq .LT. 0) Then
 
7034
         Jq = 0
 
7035
         If (Q .lt. Qini)  then
 
7036
           iqmnrng=iqmnrng+1
 
7037
           if(iqmnrng.eq.1) Print '(A, 2(1pE12.4))', 
 
7038
     >     ' WARNING: Q < Qini, extrapolation used; Q, Qini =', Q, Qini
 
7039
         endif
 
7040
      Elseif (Jq .GT. Nt-M) Then
 
7041
         Jq = Nt - M
 
7042
         If (Q .gt. Qmax) then
 
7043
           iqmxrng=iqmxrng+1
 
7044
           if(iqmxrng.eq.1) Print '(A, 2(1pE12.4))', 
 
7045
     >     ' WARNING: Q > Qmax, extrapolation used; Q, Qmax =', Q, Qmax
 
7046
         endif
 
7047
      Endif
 
7048
 
 
7049
      If (Iprtn .GE. 3) Then
 
7050
         Ip = - Iprtn
 
7051
      Else
 
7052
         Ip = Iprtn
 
7053
      EndIf
 
7054
C                             Find the off-set in the linear array Upd
 
7055
      JFL = Ip + NfMx
 
7056
      J0  = (JFL * (NT+1) + Jq) * (NX+1) + Jx
 
7057
C
 
7058
C                                           Now interpolate in x for M1 Q's
 
7059
      Do 21 Iq = 1, M1
 
7060
         J1 = J0 + (Nx+1)*(Iq-1) + 1
 
7061
         Call Ctq5polint (XV(Jx), Upd(J1), M1, X, Fq(Iq), Df(Iq))
 
7062
 21   Continue
 
7063
C                                          Finish off by interpolating in Q
 
7064
      Call Ctq5polint (QL(Jq), Fq(1), M1, QG, Ftmp, Ddf)
 
7065
 
 
7066
      Ctq5partonx = Ftmp
 
7067
C
 
7068
      RETURN
 
7069
C                        ****************************
 
7070
      END
 
7071
 
 
7072
 
 
7073
      Subroutine SetCtq5 (Iset)
 
7074
      Implicit Double Precision (A-H,O-Z)
 
7075
      Parameter (Isetmax=9)
 
7076
      Character Flnm(Isetmax)*12, Tablefile*40
 
7077
      Data (Flnm(I), I=1,Isetmax)
 
7078
     > / 'cteq5m', 'cteq5d', 'cteq5l', 'cteq5hj'
 
7079
     > , 'cteq5hq', 'cteq5f3', 'cteq5f4'
 
7080
     > , 'cteq5m1', 'ctq5hq1'  /
 
7081
      Data Tablefile / 'test.tbl' /
 
7082
      Data Isetold, Isetmin, Isettest / -987, 1, 911 /
 
7083
      save
 
7084
 
 
7085
C             If data file not initialized, do so.
 
7086
      If(Iset.ne.Isetold) then
 
7087
         IU= Nctq5nextun()
 
7088
         If (Iset .eq. Isettest) then
 
7089
            Print* ,'Opening ', Tablefile
 
7090
 21         Open(IU, File=Tablefile, Status='OLD', Err=101)
 
7091
            GoTo 22
 
7092
 101        Print*, Tablefile, ' cannot be opened '
 
7093
            Print*, 'Please input the .tbl file:'
 
7094
            Read (*,'(A)') Tablefile
 
7095
            Goto 21
 
7096
 22         Continue
 
7097
         ElseIf (Iset.lt.Isetmin .or. Iset.gt.Isetmax) Then
 
7098
            Print *, 'Invalid Iset number in SetCtq5 :', Iset
 
7099
            Stop
 
7100
         Else
 
7101
            Tablefile=Flnm(Iset)
 
7102
            Open(IU, File=Tablefile, Status='OLD', Err=100)
 
7103
         Endif
 
7104
         Call Ctq5readtbl (IU)
 
7105
         Close (IU)   
 
7106
         Isetold=Iset
 
7107
      Endif
 
7108
      Return
 
7109
 
 
7110
 100  Print *, ' Data file ', Tablefile, ' cannot be opened '
 
7111
     >//'in SetCtq5!!'
 
7112
      Stop
 
7113
C                             ********************
 
7114
      End
 
7115
 
 
7116
      Subroutine Ctq5readtbl (Nu)
 
7117
      Implicit Double Precision (A-H,O-Z)
 
7118
      Character Line*80
 
7119
      PARAMETER (MXX = 105, MXQ = 25, MXF = 6)
 
7120
      PARAMETER (MXPQX = (MXF *2 +2) * MXQ * MXX)
 
7121
      Common 
 
7122
     > / K719CtqPar1 / Al, XV(0:MXX), QL(0:MXQ), UPD(MXPQX)
 
7123
     > / K719CtqPar2 / Nx, Nt, NfMx
 
7124
     > / K719XQrange / Qini, Qmax, Xmin
 
7125
     > / K719QCDtable /  Alambda, Nfl, Iorder
 
7126
     > / K719Masstbl / Amass(6)
 
7127
      
 
7128
      Read  (Nu, '(A)') Line     
 
7129
      Read  (Nu, '(A)') Line
 
7130
      Read  (Nu, *) Dr, Fl, Al, (Amass(I),I=1,6)
 
7131
      Iorder = Nint(Dr)
 
7132
      Nfl = Nint(Fl)
 
7133
      Alambda = Al
 
7134
 
 
7135
      Read  (Nu, '(A)') Line 
 
7136
      Read  (Nu, *) NX,  NT, NfMx
 
7137
 
 
7138
      Read  (Nu, '(A)') Line
 
7139
      Read  (Nu, *) QINI, QMAX, (QL(I), I =0, NT)
 
7140
 
 
7141
      Read  (Nu, '(A)') Line
 
7142
      Read  (Nu, *) XMIN, (XV(I), I =0, NX)
 
7143
 
 
7144
      Do 11 Iq = 0, NT
 
7145
         QL(Iq) = Log (QL(Iq) /Al)
 
7146
   11 Continue
 
7147
C
 
7148
C                  Since quark = anti-quark for nfl>2 at this stage, 
 
7149
C                  we Read  out only the non-redundent data points
 
7150
C     No of flavors = NfMx (sea) + 1 (gluon) + 2 (valence) 
 
7151
 
 
7152
      Nblk = (NX+1) * (NT+1)
 
7153
      Npts =  Nblk  * (NfMx+3)
 
7154
      Read  (Nu, '(A)') Line
 
7155
      Read  (Nu, *, IOSTAT=IRET) (UPD(I), I=1,Npts)
 
7156
 
 
7157
      Return
 
7158
C                        ****************************
 
7159
      End
 
7160
 
 
7161
      Function Nctq5nextun()
 
7162
C                                 Returns an unallocated FORTRAN i/o unit.
 
7163
      Logical EX
 
7164
C
 
7165
      Do 10 N = 10, 300
 
7166
         INQUIRE (UNIT=N, OPENED=EX)
 
7167
         If (.NOT. EX) then
 
7168
            Nctq5nextun = N
 
7169
            Return
 
7170
         Endif
 
7171
 10   Continue
 
7172
      Stop ' There is no available I/O unit. '
 
7173
C               *************************
 
7174
      End
 
7175
C
 
7176
 
 
7177
      SUBROUTINE CTQ5POLINT (XA,YA,N,X,Y,DY)
 
7178
 
 
7179
      IMPLICIT DOUBLE PRECISION (A-H, O-Z)
 
7180
C                                        Adapted from "Numerical Recipes" 
 
7181
      PARAMETER (NMAX=10)
 
7182
      DIMENSION XA(N),YA(N),C(NMAX),D(NMAX)
 
7183
      NS=1
 
7184
      DIF=ABS(X-XA(1))
 
7185
      DO 11 I=1,N
 
7186
        DIFT=ABS(X-XA(I))
 
7187
        IF (DIFT.LT.DIF) THEN
 
7188
          NS=I
 
7189
          DIF=DIFT
 
7190
        ENDIF
 
7191
        C(I)=YA(I)
 
7192
        D(I)=YA(I)
 
7193
11    CONTINUE
 
7194
      Y=YA(NS)
 
7195
      NS=NS-1
 
7196
      DO 13 M=1,N-1
 
7197
        DO 12 I=1,N-M
 
7198
          HO=XA(I)-X
 
7199
          HP=XA(I+M)-X
 
7200
          W=C(I+1)-D(I)
 
7201
          DEN=HO-HP
 
7202
          IF(DEN.EQ.0.)PAUSE
 
7203
          DEN=W/DEN
 
7204
          D(I)=HP*DEN
 
7205
          C(I)=HO*DEN
 
7206
12      CONTINUE
 
7207
        IF (2*NS.LT.N-M)THEN
 
7208
          DY=C(NS+1)
 
7209
        ELSE
 
7210
          DY=D(NS)
 
7211
          NS=NS-1
 
7212
        ENDIF
 
7213
        Y=Y+DY
 
7214
13    CONTINUE
 
7215
      RETURN
 
7216
      END
 
7217
 
 
7218
C   CTEQ5M1 and CTEQ5L Parton Distribution Functions in Parametrized Form
 
7219
C                             
 
7220
C               September 15, 1999
 
7221
C
 
7222
C   Ref: "GLOBAL QCD ANALYSIS OF PARTON STRUCTURE OF THE NUCLEON:
 
7223
C         CTEQ5 PPARTON DISTRIBUTIONS"
 
7224
C   hep-ph/9903282
 
7225
C
 
7226
C   The CTEQ5M1 set given here is an updated version of the original CTEQ5M
 
7227
C     set posted, in the table version, on the Web page of CTEQ.
 
7228
C     The differences between CTEQ5M and CTEQ5M1 are insignificant for almost
 
7229
C     all applications. 
 
7230
C   The improvement is in the QCD evolution which is now more accurate, and
 
7231
C   which agrees completely with the benchmark work of the HERA 96/97 Workshop.
 
7232
 
 
7233
C   The differences between the parametrized and the corresponding table ver-
 
7234
C sions (on which it is based) are of similar order as between the two version.
 
7235
C    
 
7236
C!! Because accurate parametrizations over a wide range of (x,Q) is hard to
 
7237
C   obtain, only the most widely used sets CTEQ5M and CTEQ5L are available 
 
7238
C   in parametrized form for now. 
 
7239
 
 
7240
C   These parametrizations were obtained by Jon Pumplin.
 
7241
C
 
7242
C                    ******************************
 
7243
C  Iset   PDF        Description                 Alpha_s(Mz)  Lam4  Lam5
 
7244
C ---------------------------------------------------------------------------
 
7245
C   1    CTEQ5M1  Standard NLO MSbar scheme         0.118     326   226
 
7246
C   3    CTEQ5L   Leading Order                     0.127     192   146
 
7247
C ---------------------------------------------------------------------------
 
7248
C   Note the Qcd-lambda values given for CTEQ5L is for the leading order
 
7249
C     form of Alpha_s!!  Alpha_s(Mz) gives the absolute calibration.
 
7250
 
 
7251
C  The two Iset value are adopted to agree with the standard table versions.
 
7252
 
 
7253
C   The following user-callable routines are provided:
 
7254
C 
 
7255
C     FUNCTION Ctq5Pd (Iset, Iprtn, X, Q, Irt) 
 
7256
C         returns the PROBABILITY density for a GIVEN flavor;
 
7257
C
 
7258
C     FUNCTION Ctq5df (Iset, Iprtn, X, Q, Irt)
 
7259
C         returns the MOMENTUM density of a GIVEN valence or sea distribution.
 
7260
C
 
7261
C     SUBROUTINE Ctq5Pds(Iset, Pdf, X, Q, Irt)
 
7262
C         returns an array of MOMENTUM densities for ALL flavors;
 
7263
C
 
7264
C   The arguments of these routines are as follows: 
 
7265
C
 
7266
C   Iset is the set number:  1 for CTEQ5M1 or 3 for CTEQ5L  
 
7267
C
 
7268
C   Iprtn  is the parton label (6, 5, 4, 3, 2, 1, 0, -1, ......, -6)
 
7269
C                          for (t, b, c, s, d, u, g, u_bar, ..., t_bar)
 
7270
C  *** WARNING: We use the parton label 2 as D-quark and 1 as U-quark, 
 
7271
C               which might be different from your labels.
 
7272
C
 
7273
C   X, Q are the usual x, Q; 
 
7274
C
 
7275
C   Irt is an error code: 0 if there was no error; 1 or more if (x,q) was 
 
7276
C   outside the range of validity of the parametrization.
 
7277
C       
 
7278
C  Range of validity:
 
7279
C  
 
7280
C     The range of (x, Q) covered by this parametrization of the QCD evolved
 
7281
C     parton distributions is 1E-6 < x < 1 ; 1.1 GeV < Q < 10 TeV.  Of course,
 
7282
C     the PDF's are constrained by data only in a subset of that region; and 
 
7283
C     the assumed DGLAP evolution is unlikely to be valid for all of it either.
 
7284
C
 
7285
C     The range of (x, Q) used in the CTEQ5 round of global analysis is 
 
7286
C     approximately 0.01 < x < 0.75 ; and 4 GeV^2 < Q^2 < 400 GeV^2 for 
 
7287
C     fixed target experiments; 0.0001 < x < 0.3 from HERA data; and   
 
7288
C     Q^2 up to 40,000 GeV^2 from Tevatron inclusive Jet data.
 
7289
C
 
7290
C   DOUBLE PRECISION is used throughout in these routines, but conversion to 
 
7291
C   SINGLE PRECISION is possible by removing the Implicit Double Precision statements. 
 
7292
C
 
7293
C **************************************************************************
 
7294
 
 
7295
C ********************************************************
 
7296
      FUNCTION CTQ5PD(ISET, IPARTON, X, Q, IRT)
 
7297
C ********************************************************
 
7298
      IMPLICIT DOUBLE PRECISION (A-H, O-Z)
 
7299
 
 
7300
c if called at a point (x,q) that is outside the region that was 
 
7301
c actually parametrized, return a value of 0, and set the error code IRT=1.  
 
7302
c The user can remove the following IF statement to receive instead an 
 
7303
c extrapolated value, which may be wildly unphysical.
 
7304
      if((x .lt. 1.e-6). or. (x .gt. 1.) 
 
7305
     &   .or. (q .lt. .99) .or. (q .gt. 10000.)) then
 
7306
         ctq5pd = 0.d0
 
7307
         irt = 1
 
7308
         return
 
7309
      endif
 
7310
 
 
7311
      irt = 0
 
7312
      if(iset .eq. 3) then
 
7313
         ctq5pd = ctq5L(iparton,x,q)
 
7314
      elseif(iset .eq. 1) then
 
7315
         ctq5pd = ctq5Mi(iparton,x,q)
 
7316
      else
 
7317
         print *,'iset=',iset,' has not been parametrized.' 
 
7318
           print '(/A)', 'Use the interpolation-table version instead.'
 
7319
         stop
 
7320
      endif
 
7321
 
 
7322
      return
 
7323
      end
 
7324
 
 
7325
C ********************************************************
 
7326
      FUNCTION CTQ5DF(ISET, IFL, X, Q, IRT)
 
7327
C ********************************************************
 
7328
      IMPLICIT DOUBLE PRECISION (A-H, O-Z)
 
7329
 
 
7330
      CTQ5DF = X * CTQ5PD(ISET, IPARTON, X, Q, IRT)
 
7331
        
 
7332
      RETURN
 
7333
      END
 
7334
 
 
7335
C ********************************************************
 
7336
      SUBROUTINE CTQ5PDS(ISET, PDF, X, Q, IRT)
 
7337
C ********************************************************
 
7338
      IMPLICIT DOUBLE PRECISION (A-H, O-Z)
 
7339
      DIMENSION PDF (-6:6)
 
7340
 
 
7341
      IRT = 0
 
7342
 
 
7343
      DO IFL= -6,2
 
7344
         PDF(IFL) = CTQ5PD(ISET,IFL,X,Q,IRT1)
 
7345
         IRT = IRT + IRT1
 
7346
 
 
7347
         IF (IFL .LE. -3) THEN
 
7348
            PDF(-IFL) = PDF(IFL)
 
7349
         ENDIF
 
7350
 
 
7351
      ENDDO
 
7352
 
 
7353
      RETURN
 
7354
      END
 
7355
 
 
7356
c --------------------------------------------------------------------------
 
7357
        double precision function ctq5MI(ifl,x,q)
 
7358
c Parametrization of cteq5MI parton distribution functions (J. Pumplin 9/99).
 
7359
c ifl: 1=u,2=d,3=s,4=c,5=b;0=gluon;-1=ubar,-2=dbar,-3=sbar,-4=cbar,-5=bbar.
 
7360
c --------------------------------------------------------------------------
 
7361
        implicit double precision (a-h,o-z)
 
7362
        integer ifl
 
7363
 
 
7364
        ii = ifl
 
7365
        if(ii .gt. 2) then
 
7366
           ii = -ii
 
7367
        endif
 
7368
 
 
7369
        if(ii .eq. -1) then
 
7370
           sum = faux5MI(-1,x,q)
 
7371
           ratio = faux5MI(-2,x,q)
 
7372
           ctq5MI = sum/(1.d0 + ratio)
 
7373
 
 
7374
        elseif(ii .eq. -2) then
 
7375
           sum = faux5MI(-1,x,q)
 
7376
           ratio = faux5MI(-2,x,q)
 
7377
           ctq5MI = sum*ratio/(1.d0 + ratio)
 
7378
 
 
7379
        elseif(ii .ge. -5) then
 
7380
           ctq5MI = faux5MI(ii,x,q)
 
7381
 
 
7382
        else
 
7383
           ctq5MI = 0.d0 
 
7384
 
 
7385
        endif
 
7386
 
 
7387
        return
 
7388
        end
 
7389
 
 
7390
c ---------------------------------------------------------------------
 
7391
      double precision function faux5MI(ifl,x,q)
 
7392
c auxiliary function for parametrization of CTEQ5MI (J. Pumplin 9/99).
 
7393
c ---------------------------------------------------------------------
 
7394
      implicit double precision (a-h,o-z)
 
7395
      integer ifl
 
7396
 
 
7397
      parameter (nex=8, nlf=2)
 
7398
      dimension am(0:nex,0:nlf,-5:2)
 
7399
      dimension alfvec(-5:2), qmavec(-5:2)
 
7400
      dimension mexvec(-5:2), mlfvec(-5:2)
 
7401
      dimension ut1vec(-5:2), ut2vec(-5:2)
 
7402
      dimension af(0:nex)
 
7403
 
 
7404
      data mexvec( 2) / 8 /
 
7405
      data mlfvec( 2) / 2 /
 
7406
      data ut1vec( 2) /  0.5141718E+01 /
 
7407
      data ut2vec( 2) / -0.1346944E+01 /
 
7408
      data alfvec( 2) /  0.5260555E+00 /
 
7409
      data qmavec( 2) /  0.0000000E+00 /
 
7410
      data (am( 0,k, 2),k=0, 2)
 
7411
     & /  0.4289071E+01, -0.2536870E+01, -0.1259948E+01 /
 
7412
      data (am( 1,k, 2),k=0, 2)
 
7413
     & /  0.9839410E+00,  0.4168426E-01, -0.5018952E-01 /
 
7414
      data (am( 2,k, 2),k=0, 2)
 
7415
     & / -0.1651961E+02,  0.9246261E+01,  0.5996400E+01 /
 
7416
      data (am( 3,k, 2),k=0, 2)
 
7417
     & / -0.2077936E+02,  0.9786469E+01,  0.7656465E+01 /
 
7418
      data (am( 4,k, 2),k=0, 2)
 
7419
     & /  0.3054926E+02,  0.1889536E+01,  0.1380541E+01 /
 
7420
      data (am( 5,k, 2),k=0, 2)
 
7421
     & /  0.3084695E+02, -0.1212303E+02, -0.1053551E+02 /
 
7422
      data (am( 6,k, 2),k=0, 2)
 
7423
     & / -0.1426778E+02,  0.6239537E+01,  0.5254819E+01 /
 
7424
      data (am( 7,k, 2),k=0, 2)
 
7425
     & / -0.1909811E+02,  0.3695678E+01,  0.5495729E+01 /
 
7426
      data (am( 8,k, 2),k=0, 2)
 
7427
     & /  0.1889751E-01,  0.5027193E-02,  0.6624896E-03 /
 
7428
 
 
7429
      data mexvec( 1) / 8 /
 
7430
      data mlfvec( 1) / 2 /
 
7431
      data ut1vec( 1) /  0.4138426E+01 /
 
7432
      data ut2vec( 1) / -0.3221374E+01 /
 
7433
      data alfvec( 1) /  0.4960962E+00 /
 
7434
      data qmavec( 1) /  0.0000000E+00 /
 
7435
      data (am( 0,k, 1),k=0, 2)
 
7436
     & /  0.1332497E+01, -0.3703718E+00,  0.1288638E+00 /
 
7437
      data (am( 1,k, 1),k=0, 2)
 
7438
     & /  0.7544687E+00,  0.3255075E-01, -0.4706680E-01 /
 
7439
      data (am( 2,k, 1),k=0, 2)
 
7440
     & / -0.7638814E+00,  0.5008313E+00, -0.9237374E-01 /
 
7441
      data (am( 3,k, 1),k=0, 2)
 
7442
     & / -0.3689889E+00, -0.1055098E+01, -0.4645065E+00 /
 
7443
      data (am( 4,k, 1),k=0, 2)
 
7444
     & /  0.3991610E+02,  0.1979881E+01,  0.1775814E+01 /
 
7445
      data (am( 5,k, 1),k=0, 2)
 
7446
     & /  0.6201080E+01,  0.2046288E+01,  0.3804571E+00 /
 
7447
      data (am( 6,k, 1),k=0, 2)
 
7448
     & / -0.8027900E+00, -0.7011688E+00, -0.8049612E+00 /
 
7449
      data (am( 7,k, 1),k=0, 2)
 
7450
     & / -0.8631305E+01, -0.3981200E+01,  0.6970153E+00 /
 
7451
      data (am( 8,k, 1),k=0, 2)
 
7452
     & /  0.2371230E-01,  0.5372683E-02,  0.1118701E-02 /
 
7453
 
 
7454
      data mexvec( 0) / 8 /
 
7455
      data mlfvec( 0) / 2 /
 
7456
      data ut1vec( 0) / -0.1026789E+01 /
 
7457
      data ut2vec( 0) / -0.9051707E+01 /
 
7458
      data alfvec( 0) /  0.9462977E+00 /
 
7459
      data qmavec( 0) /  0.0000000E+00 /
 
7460
      data (am( 0,k, 0),k=0, 2)
 
7461
     & /  0.1191990E+03, -0.8548739E+00, -0.1963040E+01 /
 
7462
      data (am( 1,k, 0),k=0, 2)
 
7463
     & / -0.9449972E+02,  0.1074771E+01,  0.2056055E+01 /
 
7464
      data (am( 2,k, 0),k=0, 2)
 
7465
     & /  0.3701064E+01, -0.1167947E-02,  0.1933573E+00 /
 
7466
      data (am( 3,k, 0),k=0, 2)
 
7467
     & /  0.1171345E+03, -0.1064540E+01, -0.1875312E+01 /
 
7468
      data (am( 4,k, 0),k=0, 2)
 
7469
     & / -0.1014453E+03, -0.5707427E+00,  0.4511242E-01 /
 
7470
      data (am( 5,k, 0),k=0, 2)
 
7471
     & /  0.6365168E+01,  0.1275354E+01, -0.4964081E+00 /
 
7472
      data (am( 6,k, 0),k=0, 2)
 
7473
     & / -0.3370693E+01, -0.1122020E+01,  0.5947751E-01 /
 
7474
      data (am( 7,k, 0),k=0, 2)
 
7475
     & / -0.5327270E+01, -0.9293556E+00,  0.6629940E+00 /
 
7476
      data (am( 8,k, 0),k=0, 2)
 
7477
     & /  0.2437513E-01,  0.1600939E-02,  0.6855336E-03 /
 
7478
 
 
7479
      data mexvec(-1) / 8 /
 
7480
      data mlfvec(-1) / 2 /
 
7481
      data ut1vec(-1) /  0.5243571E+01 /
 
7482
      data ut2vec(-1) / -0.2870513E+01 /
 
7483
      data alfvec(-1) /  0.6701448E+00 /
 
7484
      data qmavec(-1) /  0.0000000E+00 /
 
7485
      data (am( 0,k,-1),k=0, 2)
 
7486
     & /  0.2428863E+02,  0.1907035E+01, -0.4606457E+00 /
 
7487
      data (am( 1,k,-1),k=0, 2)
 
7488
     & /  0.2006810E+01, -0.1265915E+00,  0.7153556E-02 /
 
7489
      data (am( 2,k,-1),k=0, 2)
 
7490
     & / -0.1884546E+02, -0.2339471E+01,  0.5740679E+01 /
 
7491
      data (am( 3,k,-1),k=0, 2)
 
7492
     & / -0.2527892E+02, -0.2044124E+01,  0.1280470E+02 /
 
7493
      data (am( 4,k,-1),k=0, 2)
 
7494
     & / -0.1013824E+03, -0.1594199E+01,  0.2216401E+00 /
 
7495
      data (am( 5,k,-1),k=0, 2)
 
7496
     & /  0.8070930E+02,  0.1792072E+01, -0.2164364E+02 /
 
7497
      data (am( 6,k,-1),k=0, 2)
 
7498
     & / -0.4641050E+02,  0.1977338E+00,  0.1273014E+02 /
 
7499
      data (am( 7,k,-1),k=0, 2)
 
7500
     & / -0.3910568E+02,  0.1719632E+01,  0.1086525E+02 /
 
7501
      data (am( 8,k,-1),k=0, 2)
 
7502
     & / -0.1185496E+01, -0.1905847E+00, -0.8744118E-03 /
 
7503
 
 
7504
      data mexvec(-2) / 7 /
 
7505
      data mlfvec(-2) / 2 /
 
7506
      data ut1vec(-2) /  0.4782210E+01 /
 
7507
      data ut2vec(-2) / -0.1976856E+02 /
 
7508
      data alfvec(-2) /  0.7558374E+00 /
 
7509
      data qmavec(-2) /  0.0000000E+00 /
 
7510
      data (am( 0,k,-2),k=0, 2)
 
7511
     & / -0.6216935E+00,  0.2369963E+00, -0.7909949E-02 /
 
7512
      data (am( 1,k,-2),k=0, 2)
 
7513
     & /  0.1245440E+01, -0.1031510E+00,  0.4916523E-02 /
 
7514
      data (am( 2,k,-2),k=0, 2)
 
7515
     & / -0.7060824E+01, -0.3875283E-01,  0.1784981E+00 /
 
7516
      data (am( 3,k,-2),k=0, 2)
 
7517
     & / -0.7430595E+01,  0.1964572E+00, -0.1284999E+00 /
 
7518
      data (am( 4,k,-2),k=0, 2)
 
7519
     & / -0.6897810E+01,  0.2620543E+01,  0.8012553E-02 /
 
7520
      data (am( 5,k,-2),k=0, 2)
 
7521
     & /  0.1507713E+02,  0.2340307E-01,  0.2482535E+01 /
 
7522
      data (am( 6,k,-2),k=0, 2)
 
7523
     & / -0.1815341E+01, -0.1538698E+01, -0.2014208E+01 /
 
7524
      data (am( 7,k,-2),k=0, 2)
 
7525
     & / -0.2571932E+02,  0.2903941E+00, -0.2848206E+01 /
 
7526
 
 
7527
      data mexvec(-3) / 7 /
 
7528
      data mlfvec(-3) / 2 /
 
7529
      data ut1vec(-3) /  0.4518239E+01 /
 
7530
      data ut2vec(-3) / -0.2690590E+01 /
 
7531
      data alfvec(-3) /  0.6124079E+00 /
 
7532
      data qmavec(-3) /  0.0000000E+00 /
 
7533
      data (am( 0,k,-3),k=0, 2)
 
7534
     & / -0.2734458E+01, -0.7245673E+00, -0.6351374E+00 /
 
7535
      data (am( 1,k,-3),k=0, 2)
 
7536
     & /  0.2927174E+01,  0.4822709E+00, -0.1088787E-01 /
 
7537
      data (am( 2,k,-3),k=0, 2)
 
7538
     & / -0.1771017E+02, -0.1416635E+01,  0.8467622E+01 /
 
7539
      data (am( 3,k,-3),k=0, 2)
 
7540
     & / -0.4972782E+02, -0.3348547E+01,  0.1767061E+02 /
 
7541
      data (am( 4,k,-3),k=0, 2)
 
7542
     & / -0.7102770E+01, -0.3205337E+01,  0.4101704E+00 /
 
7543
      data (am( 5,k,-3),k=0, 2)
 
7544
     & /  0.7169698E+02, -0.2205985E+01, -0.2463931E+02 /
 
7545
      data (am( 6,k,-3),k=0, 2)
 
7546
     & / -0.4090347E+02,  0.2103486E+01,  0.1416507E+02 /
 
7547
      data (am( 7,k,-3),k=0, 2)
 
7548
     & / -0.2952639E+02,  0.5376136E+01,  0.7825585E+01 /
 
7549
 
 
7550
      data mexvec(-4) / 7 /
 
7551
      data mlfvec(-4) / 2 /
 
7552
      data ut1vec(-4) /  0.2783230E+01 /
 
7553
      data ut2vec(-4) / -0.1746328E+01 /
 
7554
      data alfvec(-4) /  0.1115653E+01 /
 
7555
      data qmavec(-4) /  0.1300000E+01 /
 
7556
      data (am( 0,k,-4),k=0, 2)
 
7557
     & / -0.1743872E+01, -0.1128921E+01, -0.2841969E+00 /
 
7558
      data (am( 1,k,-4),k=0, 2)
 
7559
     & /  0.3345755E+01,  0.3187765E+00,  0.1378124E+00 /
 
7560
      data (am( 2,k,-4),k=0, 2)
 
7561
     & / -0.2037615E+02,  0.4121687E+01,  0.2236520E+00 /
 
7562
      data (am( 3,k,-4),k=0, 2)
 
7563
     & / -0.4703104E+02,  0.5353087E+01, -0.1455347E+01 /
 
7564
      data (am( 4,k,-4),k=0, 2)
 
7565
     & / -0.1060230E+02, -0.1551122E+01, -0.1078863E+01 /
 
7566
      data (am( 5,k,-4),k=0, 2)
 
7567
     & /  0.5088892E+02, -0.8197304E+01,  0.8083451E+01 /
 
7568
      data (am( 6,k,-4),k=0, 2)
 
7569
     & / -0.2819070E+02,  0.4554086E+01, -0.5890995E+01 /
 
7570
      data (am( 7,k,-4),k=0, 2)
 
7571
     & / -0.1098238E+02,  0.2590096E+01, -0.8062879E+01 /
 
7572
 
 
7573
      data mexvec(-5) / 6 /
 
7574
      data mlfvec(-5) / 2 /
 
7575
      data ut1vec(-5) /  0.1619654E+02 /
 
7576
      data ut2vec(-5) / -0.3367346E+01 /
 
7577
      data alfvec(-5) /  0.5109891E-02 /
 
7578
      data qmavec(-5) /  0.4500000E+01 /
 
7579
      data (am( 0,k,-5),k=0, 2)
 
7580
     & / -0.6800138E+01,  0.2493627E+01, -0.1075724E+01 /
 
7581
      data (am( 1,k,-5),k=0, 2)
 
7582
     & /  0.3036555E+01,  0.3324733E+00,  0.2008298E+00 /
 
7583
      data (am( 2,k,-5),k=0, 2)
 
7584
     & / -0.5203879E+01, -0.8493476E+01, -0.4523208E+01 /
 
7585
      data (am( 3,k,-5),k=0, 2)
 
7586
     & / -0.1524239E+01, -0.3411912E+01, -0.1771867E+02 /
 
7587
      data (am( 4,k,-5),k=0, 2)
 
7588
     & / -0.1099444E+02,  0.1320930E+01, -0.2353831E+01 /
 
7589
      data (am( 5,k,-5),k=0, 2)
 
7590
     & /  0.1699299E+02, -0.3565802E+02,  0.3566872E+02 /
 
7591
      data (am( 6,k,-5),k=0, 2)
 
7592
     & / -0.1465793E+02,  0.2703365E+02, -0.2176372E+02 /
 
7593
 
 
7594
      if(q .le. qmavec(ifl)) then
 
7595
         faux5MI = 0.d0
 
7596
         return
 
7597
      endif
 
7598
 
 
7599
      if(x .ge. 1.d0) then
 
7600
         faux5MI = 0.d0
 
7601
         return
 
7602
      endif
 
7603
 
 
7604
      tmp = log(q/alfvec(ifl))
 
7605
      if(tmp .le. 0.d0) then
 
7606
         faux5MI = 0.d0
 
7607
         return
 
7608
      endif
 
7609
 
 
7610
      sb = log(tmp)
 
7611
      sb1 = sb - 1.2d0
 
7612
      sb2 = sb1*sb1
 
7613
 
 
7614
      do i = 0, nex
 
7615
         af(i) = 0.d0
 
7616
         sbx = 1.d0
 
7617
         do k = 0, mlfvec(ifl)
 
7618
            af(i) = af(i) + sbx*am(i,k,ifl)
 
7619
            sbx = sb1*sbx
 
7620
         enddo
 
7621
      enddo
 
7622
 
 
7623
      y = -log(x)
 
7624
      u = log(x/0.00001d0)
 
7625
 
 
7626
      part1 = af(1)*y**(1.d0+0.01d0*af(4))*(1.d0+ af(8)*u)
 
7627
      part2 = af(0)*(1.d0 - x) + af(3)*x 
 
7628
      part3 = x*(1.d0-x)*(af(5)+af(6)*(1.d0-x)+af(7)*x*(1.d0-x))
 
7629
      part4 = ut1vec(ifl)*log(1.d0-x) + 
 
7630
     &        AF(2)*log(1.d0+exp(ut2vec(ifl))-x)
 
7631
 
 
7632
      faux5MI = exp(log(x) + part1 + part2 + part3 + part4)
 
7633
 
 
7634
c include threshold factor...
 
7635
      faux5MI = faux5MI * (1.d0 - qmavec(ifl)/q)
 
7636
 
 
7637
      return
 
7638
      end
 
7639
c --------------------------------------------------------------------------
 
7640
        double precision function ctq5L(ifl,x,q)
 
7641
c Parametrization of cteq5L parton distribution functions (J. Pumplin 9/99).
 
7642
c ifl: 1=u,2=d,3=s,4=c,5=b;0=gluon;-1=ubar,-2=dbar,-3=sbar,-4=cbar,-5=bbar.
 
7643
c --------------------------------------------------------------------------
 
7644
        implicit double precision (a-h,o-z)
 
7645
        integer ifl
 
7646
 
 
7647
        ii = ifl
 
7648
        if(ii .gt. 2) then
 
7649
           ii = -ii
 
7650
        endif
 
7651
 
 
7652
        if(ii .eq. -1) then
 
7653
           sum = faux5L(-1,x,q)
 
7654
           ratio = faux5L(-2,x,q)
 
7655
           ctq5L = sum/(1.d0 + ratio)
 
7656
 
 
7657
        elseif(ii .eq. -2) then
 
7658
           sum = faux5L(-1,x,q)
 
7659
           ratio = faux5L(-2,x,q)
 
7660
           ctq5L = sum*ratio/(1.d0 + ratio)
 
7661
 
 
7662
        elseif(ii .ge. -5) then
 
7663
           ctq5L = faux5L(ii,x,q)
 
7664
 
 
7665
        else
 
7666
           ctq5L = 0.d0 
 
7667
 
 
7668
        endif
 
7669
 
 
7670
        return
 
7671
        end
 
7672
 
 
7673
c ---------------------------------------------------------------------
 
7674
      double precision function faux5L(ifl,x,q)
 
7675
c auxiliary function for parametrization of CTEQ5L (J. Pumplin 9/99).
 
7676
c ---------------------------------------------------------------------
 
7677
      implicit double precision (a-h,o-z)
 
7678
      integer ifl
 
7679
 
 
7680
      parameter (nex=8, nlf=2)
 
7681
      dimension am(0:nex,0:nlf,-5:2)
 
7682
      dimension alfvec(-5:2), qmavec(-5:2)
 
7683
      dimension mexvec(-5:2), mlfvec(-5:2)
 
7684
      dimension ut1vec(-5:2), ut2vec(-5:2)
 
7685
      dimension af(0:nex)
 
7686
 
 
7687
      data mexvec( 2) / 8 /
 
7688
      data mlfvec( 2) / 2 /
 
7689
      data ut1vec( 2) /  0.4971265E+01 /
 
7690
      data ut2vec( 2) / -0.1105128E+01 /
 
7691
      data alfvec( 2) /  0.2987216E+00 /
 
7692
      data qmavec( 2) /  0.0000000E+00 /
 
7693
      data (am( 0,k, 2),k=0, 2)
 
7694
     & /  0.5292616E+01, -0.2751910E+01, -0.2488990E+01 /
 
7695
      data (am( 1,k, 2),k=0, 2)
 
7696
     & /  0.9714424E+00,  0.1011827E-01, -0.1023660E-01 /
 
7697
      data (am( 2,k, 2),k=0, 2)
 
7698
     & / -0.1651006E+02,  0.7959721E+01,  0.8810563E+01 /
 
7699
      data (am( 3,k, 2),k=0, 2)
 
7700
     & / -0.1643394E+02,  0.5892854E+01,  0.9348874E+01 /
 
7701
      data (am( 4,k, 2),k=0, 2)
 
7702
     & /  0.3067422E+02,  0.4235796E+01, -0.5112136E+00 /
 
7703
      data (am( 5,k, 2),k=0, 2)
 
7704
     & /  0.2352526E+02, -0.5305168E+01, -0.1169174E+02 /
 
7705
      data (am( 6,k, 2),k=0, 2)
 
7706
     & / -0.1095451E+02,  0.3006577E+01,  0.5638136E+01 /
 
7707
      data (am( 7,k, 2),k=0, 2)
 
7708
     & / -0.1172251E+02, -0.2183624E+01,  0.4955794E+01 /
 
7709
      data (am( 8,k, 2),k=0, 2)
 
7710
     & /  0.1662533E-01,  0.7622870E-02, -0.4895887E-03 /
 
7711
 
 
7712
      data mexvec( 1) / 8 /
 
7713
      data mlfvec( 1) / 2 /
 
7714
      data ut1vec( 1) /  0.2612618E+01 /
 
7715
      data ut2vec( 1) / -0.1258304E+06 /
 
7716
      data alfvec( 1) /  0.3407552E+00 /
 
7717
      data qmavec( 1) /  0.0000000E+00 /
 
7718
      data (am( 0,k, 1),k=0, 2)
 
7719
     & /  0.9905300E+00, -0.4502235E+00,  0.1624441E+00 /
 
7720
      data (am( 1,k, 1),k=0, 2)
 
7721
     & /  0.8867534E+00,  0.1630829E-01, -0.4049085E-01 /
 
7722
      data (am( 2,k, 1),k=0, 2)
 
7723
     & /  0.8547974E+00,  0.3336301E+00,  0.1371388E+00 /
 
7724
      data (am( 3,k, 1),k=0, 2)
 
7725
     & /  0.2941113E+00, -0.1527905E+01,  0.2331879E+00 /
 
7726
      data (am( 4,k, 1),k=0, 2)
 
7727
     & /  0.3384235E+02,  0.3715315E+01,  0.8276930E+00 /
 
7728
      data (am( 5,k, 1),k=0, 2)
 
7729
     & /  0.6230115E+01,  0.3134639E+01, -0.1729099E+01 /
 
7730
      data (am( 6,k, 1),k=0, 2)
 
7731
     & / -0.1186928E+01, -0.3282460E+00,  0.1052020E+00 /
 
7732
      data (am( 7,k, 1),k=0, 2)
 
7733
     & / -0.8545702E+01, -0.6247947E+01,  0.3692561E+01 /
 
7734
      data (am( 8,k, 1),k=0, 2)
 
7735
     & /  0.1724598E-01,  0.7120465E-02,  0.4003646E-04 /
 
7736
 
 
7737
      data mexvec( 0) / 8 /
 
7738
      data mlfvec( 0) / 2 /
 
7739
      data ut1vec( 0) / -0.4656819E+00 /
 
7740
      data ut2vec( 0) / -0.2742390E+03 /
 
7741
      data alfvec( 0) /  0.4491863E+00 /
 
7742
      data qmavec( 0) /  0.0000000E+00 /
 
7743
      data (am( 0,k, 0),k=0, 2)
 
7744
     & /  0.1193572E+03, -0.3886845E+01, -0.1133965E+01 /
 
7745
      data (am( 1,k, 0),k=0, 2)
 
7746
     & / -0.9421449E+02,  0.3995885E+01,  0.1607363E+01 /
 
7747
      data (am( 2,k, 0),k=0, 2)
 
7748
     & /  0.4206383E+01,  0.2485954E+00,  0.2497468E+00 /
 
7749
      data (am( 3,k, 0),k=0, 2)
 
7750
     & /  0.1210557E+03, -0.3015765E+01, -0.1423651E+01 /
 
7751
      data (am( 4,k, 0),k=0, 2)
 
7752
     & / -0.1013897E+03, -0.7113478E+00,  0.2621865E+00 /
 
7753
      data (am( 5,k, 0),k=0, 2)
 
7754
     & / -0.1312404E+01, -0.9297691E+00, -0.1562531E+00 /
 
7755
      data (am( 6,k, 0),k=0, 2)
 
7756
     & /  0.1627137E+01,  0.4954111E+00, -0.6387009E+00 /
 
7757
      data (am( 7,k, 0),k=0, 2)
 
7758
     & /  0.1537698E+00, -0.2487878E+00,  0.8305947E+00 /
 
7759
      data (am( 8,k, 0),k=0, 2)
 
7760
     & /  0.2496448E-01,  0.2457823E-02,  0.8234276E-03 /
 
7761
 
 
7762
      data mexvec(-1) / 8 /
 
7763
      data mlfvec(-1) / 2 /
 
7764
      data ut1vec(-1) /  0.3862583E+01 /
 
7765
      data ut2vec(-1) / -0.1265969E+01 /
 
7766
      data alfvec(-1) /  0.2457668E+00 /
 
7767
      data qmavec(-1) /  0.0000000E+00 /
 
7768
      data (am( 0,k,-1),k=0, 2)
 
7769
     & /  0.2647441E+02,  0.1059277E+02, -0.9176654E+00 /
 
7770
      data (am( 1,k,-1),k=0, 2)
 
7771
     & /  0.1990636E+01,  0.8558918E-01,  0.4248667E-01 /
 
7772
      data (am( 2,k,-1),k=0, 2)
 
7773
     & / -0.1476095E+02, -0.3276255E+02,  0.1558110E+01 /
 
7774
      data (am( 3,k,-1),k=0, 2)
 
7775
     & / -0.2966889E+01, -0.3649037E+02,  0.1195914E+01 /
 
7776
      data (am( 4,k,-1),k=0, 2)
 
7777
     & / -0.1000519E+03, -0.2464635E+01,  0.1964849E+00 /
 
7778
      data (am( 5,k,-1),k=0, 2)
 
7779
     & /  0.3718331E+02,  0.4700389E+02, -0.2772142E+01 /
 
7780
      data (am( 6,k,-1),k=0, 2)
 
7781
     & / -0.1872722E+02, -0.2291189E+02,  0.1089052E+01 /
 
7782
      data (am( 7,k,-1),k=0, 2)
 
7783
     & / -0.1628146E+02, -0.1823993E+02,  0.2537369E+01 /
 
7784
      data (am( 8,k,-1),k=0, 2)
 
7785
     & / -0.1156300E+01, -0.1280495E+00,  0.5153245E-01 /
 
7786
 
 
7787
      data mexvec(-2) / 7 /
 
7788
      data mlfvec(-2) / 2 /
 
7789
      data ut1vec(-2) /  0.1895615E+00 /
 
7790
      data ut2vec(-2) / -0.3069097E+01 /
 
7791
      data alfvec(-2) /  0.5293999E+00 /
 
7792
      data qmavec(-2) /  0.0000000E+00 /
 
7793
      data (am( 0,k,-2),k=0, 2)
 
7794
     & / -0.6556775E+00,  0.2490190E+00,  0.3966485E-01 /
 
7795
      data (am( 1,k,-2),k=0, 2)
 
7796
     & /  0.1305102E+01, -0.1188925E+00, -0.4600870E-02 /
 
7797
      data (am( 2,k,-2),k=0, 2)
 
7798
     & / -0.2371436E+01,  0.3566814E+00, -0.2834683E+00 /
 
7799
      data (am( 3,k,-2),k=0, 2)
 
7800
     & / -0.6152826E+01,  0.8339877E+00, -0.7233230E+00 /
 
7801
      data (am( 4,k,-2),k=0, 2)
 
7802
     & / -0.8346558E+01,  0.2892168E+01,  0.2137099E+00 /
 
7803
      data (am( 5,k,-2),k=0, 2)
 
7804
     & /  0.1279530E+02,  0.1021114E+00,  0.5787439E+00 /
 
7805
      data (am( 6,k,-2),k=0, 2)
 
7806
     & /  0.5858816E+00, -0.1940375E+01, -0.4029269E+00 /
 
7807
      data (am( 7,k,-2),k=0, 2)
 
7808
     & / -0.2795725E+02, -0.5263392E+00,  0.1290229E+01 /
 
7809
 
 
7810
      data mexvec(-3) / 7 /
 
7811
      data mlfvec(-3) / 2 /
 
7812
      data ut1vec(-3) /  0.3753257E+01 /
 
7813
      data ut2vec(-3) / -0.1113085E+01 /
 
7814
      data alfvec(-3) /  0.3713141E+00 /
 
7815
      data qmavec(-3) /  0.0000000E+00 /
 
7816
      data (am( 0,k,-3),k=0, 2)
 
7817
     & /  0.1580931E+01, -0.2273826E+01, -0.1822245E+01 /
 
7818
      data (am( 1,k,-3),k=0, 2)
 
7819
     & /  0.2702644E+01,  0.6763243E+00,  0.7231586E-02 /
 
7820
      data (am( 2,k,-3),k=0, 2)
 
7821
     & / -0.1857924E+02,  0.3907500E+01,  0.5850109E+01 /
 
7822
      data (am( 3,k,-3),k=0, 2)
 
7823
     & / -0.3044793E+02,  0.2639332E+01,  0.5566644E+01 /
 
7824
      data (am( 4,k,-3),k=0, 2)
 
7825
     & / -0.4258011E+01, -0.5429244E+01,  0.4418946E+00 /
 
7826
      data (am( 5,k,-3),k=0, 2)
 
7827
     & /  0.3465259E+02, -0.5532604E+01, -0.4904153E+01 /
 
7828
      data (am( 6,k,-3),k=0, 2)
 
7829
     & / -0.1658858E+02,  0.2923275E+01,  0.2266286E+01 /
 
7830
      data (am( 7,k,-3),k=0, 2)
 
7831
     & / -0.1149263E+02,  0.2877475E+01, -0.7999105E+00 /
 
7832
 
 
7833
      data mexvec(-4) / 7 /
 
7834
      data mlfvec(-4) / 2 /
 
7835
      data ut1vec(-4) /  0.4400772E+01 /
 
7836
      data ut2vec(-4) / -0.1356116E+01 /
 
7837
      data alfvec(-4) /  0.3712017E-01 /
 
7838
      data qmavec(-4) /  0.1300000E+01 /
 
7839
      data (am( 0,k,-4),k=0, 2)
 
7840
     & / -0.8293661E+00, -0.3982375E+01, -0.6494283E-01 /
 
7841
      data (am( 1,k,-4),k=0, 2)
 
7842
     & /  0.2754618E+01,  0.8338636E+00, -0.6885160E-01 /
 
7843
      data (am( 2,k,-4),k=0, 2)
 
7844
     & / -0.1657987E+02,  0.1439143E+02, -0.6887240E+00 /
 
7845
      data (am( 3,k,-4),k=0, 2)
 
7846
     & / -0.2800703E+02,  0.1535966E+02, -0.7377693E+00 /
 
7847
      data (am( 4,k,-4),k=0, 2)
 
7848
     & / -0.6460216E+01, -0.4783019E+01,  0.4913297E+00 /
 
7849
      data (am( 5,k,-4),k=0, 2)
 
7850
     & /  0.3141830E+02, -0.3178031E+02,  0.7136013E+01 /
 
7851
      data (am( 6,k,-4),k=0, 2)
 
7852
     & / -0.1802509E+02,  0.1862163E+02, -0.4632843E+01 /
 
7853
      data (am( 7,k,-4),k=0, 2)
 
7854
     & / -0.1240412E+02,  0.2565386E+02, -0.1066570E+02 /
 
7855
 
 
7856
      data mexvec(-5) / 6 /
 
7857
      data mlfvec(-5) / 2 /
 
7858
      data ut1vec(-5) /  0.5562568E+01 /
 
7859
      data ut2vec(-5) / -0.1801317E+01 /
 
7860
      data alfvec(-5) /  0.4952010E-02 /
 
7861
      data qmavec(-5) /  0.4500000E+01 /
 
7862
      data (am( 0,k,-5),k=0, 2)
 
7863
     & / -0.6031237E+01,  0.1992727E+01, -0.1076331E+01 /
 
7864
      data (am( 1,k,-5),k=0, 2)
 
7865
     & /  0.2933912E+01,  0.5839674E+00,  0.7509435E-01 /
 
7866
      data (am( 2,k,-5),k=0, 2)
 
7867
     & / -0.8284919E+01,  0.1488593E+01, -0.8251678E+00 /
 
7868
      data (am( 3,k,-5),k=0, 2)
 
7869
     & / -0.1925986E+02,  0.2805753E+01, -0.3015446E+01 /
 
7870
      data (am( 4,k,-5),k=0, 2)
 
7871
     & / -0.9480483E+01, -0.9767837E+00, -0.1165544E+01 /
 
7872
      data (am( 5,k,-5),k=0, 2)
 
7873
     & /  0.2193195E+02, -0.1788518E+02,  0.9460908E+01 /
 
7874
      data (am( 6,k,-5),k=0, 2)
 
7875
     & / -0.1327377E+02,  0.1201754E+02, -0.6277844E+01 /
 
7876
 
 
7877
      if(q .le. qmavec(ifl)) then
 
7878
         faux5L = 0.d0
 
7879
         return
 
7880
      endif
 
7881
 
 
7882
      if(x .ge. 1.d0) then
 
7883
         faux5L = 0.d0
 
7884
         return
 
7885
      endif
 
7886
 
 
7887
      tmp = log(q/alfvec(ifl))
 
7888
      if(tmp .le. 0.d0) then
 
7889
         faux5L = 0.d0
 
7890
         return
 
7891
      endif
 
7892
 
 
7893
      sb = log(tmp)
 
7894
      sb1 = sb - 1.2d0
 
7895
      sb2 = sb1*sb1
 
7896
 
 
7897
      do i = 0, nex
 
7898
         af(i) = 0.d0
 
7899
         sbx = 1.d0
 
7900
         do k = 0, mlfvec(ifl)
 
7901
            af(i) = af(i) + sbx*am(i,k,ifl)
 
7902
            sbx = sb1*sbx
 
7903
         enddo
 
7904
      enddo
 
7905
 
 
7906
      y = -log(x)
 
7907
      u = log(x/0.00001d0)
 
7908
 
 
7909
      part1 = af(1)*y**(1.d0+0.01d0*af(4))*(1.d0+ af(8)*u)
 
7910
      part2 = af(0)*(1.d0 - x) + af(3)*x 
 
7911
      part3 = x*(1.d0-x)*(af(5)+af(6)*(1.d0-x)+af(7)*x*(1.d0-x))
 
7912
      part4 = ut1vec(ifl)*log(1.d0-x) + 
 
7913
     &        AF(2)*log(1.d0+exp(ut2vec(ifl))-x)
 
7914
 
 
7915
      faux5L = exp(log(x) + part1 + part2 + part3 + part4)
 
7916
 
 
7917
c include threshold factor...
 
7918
      faux5L = faux5L * (1.d0 - qmavec(ifl)/q)
 
7919
 
 
7920
      return
 
7921
      end
 
7922
 
 
7923
 
 
7924
C--- END CTEQ5 FITS -----
 
7925
C    
 
7926
C-- WEIZSAKER AND WILLIAMS DISTRIBUTION
 
7927
C----------------------------------------------------------------------
 
7928
      subroutine wwpdf(xs,q2s,ys,wwwgts)
 
7929
c  this routine extracts a photon from an electron with momentum fraction
 
7930
c  y>x at a scale q2. The momentum fraction is distributed according to the 
 
7931
c  Weitzsaker-Williams shape. WWWGT is the probability that a photon with 
 
7932
c  momentum fraction > x is emitted at the scale q2. The outine needs a 
 
7933
c  minimum and maximum value for the range within which x is expected to vary
 
7934
c  in the desired process. We expect xmin=(min q2)/shad and xmax=1-xme2/max(q2)
 
7935
c  The program is protected against x=1, so xmax=1 is allowed.
 
7936
C----------------------------------------------------------------------        
 
7937
      implicit real * 8 (a-h,o-z)                                           
 
7938
      real*8 ln10,lgx
 
7939
      real*4 xs,q2s,ys,wwwgts
 
7940
      dimension z(0:100),f1int(0:100),f2int(0:100),ftot(0:100)
 
7941
      common/k719wwdata/xwwmin,xwwmax
 
7942
      parameter (alfaem=1.d0/137)
 
7943
      parameter (pi=3.14159265358979312D0)
 
7944
      parameter (aemo2pi=alfaem/(2*pi))
 
7945
      parameter (xme = 0.511d-3)
 
7946
      data e0/0/,jseed/1/,nbin/100/             
 
7947
      x=dble(xs)
 
7948
      q2=dble(q2s)
 
7949
c initialization: evaluates integral of the gamma<-e distribution function (WW)
 
7950
      if(ini.eq.0) then
 
7951
        ini=1                        
 
7952
        if(xwwmin.eq.0.d0) xwwmin=1.d-4
 
7953
        if(xwwmax.eq.0.d0) xwwmax=1.d0 
 
7954
        zmin=log10(xwwmin)             
 
7955
        zmax=log10(xwwmax)
 
7956
        zrange=zmax-zmin
 
7957
        dz=zrange/nbin
 
7958
        z(0)=zmin
 
7959
        f1int(0)=0
 
7960
        f2int(0)=0
 
7961
c perform the integral in the variable log10(x)
 
7962
c It requires the jacobian d(log10(x)) = 1/log(10) d(log(x)) = 1/log(10) dx/x 
 
7963
        ln10=log(10.d0)
 
7964
        do i=1,nbin
 
7965
          z(i)=z(i-1)+dz
 
7966
          f1int(i)=f1int(i-1)
 
7967
          f2int(i)=f2int(i-1)
 
7968
          do j=1,10  
 
7969
2           xx= random(jseed)*dz+z(i-1) 
 
7970
            xx=10.d0**(xx)
 
7971
            if(xx.eq.1.d0) go to 2
 
7972
            f2=aemo2pi*(1+(1-xx)**2)
 
7973
            f1=f2*log((1-xx)/xx**2)    
 
7974
            f1int(i)=f1int(i)+f1/ln10/10.
 
7975
            f2int(i)=f2int(i)+f2/ln10/10.
 
7976
c divide by 10 to take the average within the dz integration bin
 
7977
          enddo                     
 
7978
        enddo
 
7979
        xme2=xme**2
 
7980
      endif
 
7981
c inverts the integral function
 
7982
c first find location of x and relative integral of the WW from xmin to x
 
7983
      lgx=log10(x)
 
7984
      nmin=0
 
7985
      nmax=nbin
 
7986
10    n=(nmax+nmin)/2
 
7987
      if(nmin.eq.n) then
 
7988
        nmax=n+1
 
7989
        go to 20
 
7990
      endif
 
7991
      if(lgx.gt.z(n)) then
 
7992
        nmin=n                      
 
7993
        go to 10
 
7994
      elseif(lgx.lt.z(n)) then
 
7995
        nmax=n     
 
7996
        go to 10
 
7997
      elseif(lgx.eq.z(n)) then
 
7998
        nmin=n
 
7999
        nmax=n
 
8000
        go to 20
 
8001
      endif
 
8002
20    continue
 
8003
      xlogq2=log(q2/xme2)
 
8004
      do i=nmin,nbin
 
8005
        ftot(i)=f1int(i)+f2int(i)*xlogq2
 
8006
c protect against  q2/xm2<x2/(1-x) , by forcing ftot(x>xmax)=f(xmax)
 
8007
        if(ftot(i).lt.ftot(i-1)) ftot(i)=ftot(i-1)                  
 
8008
      enddo
 
8009
      ftot1=ftot(nbin)
 
8010
      ftotx=ftot(nmin)+(lgx-z(nmin))*(ftot(nmax)-ftot(nmin))/dz
 
8011
      do i=nmin,nbin      
 
8012
        ftot(i)=(ftot(i)-ftotx)/(ftot(nbin)-ftotx)
 
8013
      enddo                                       
 
8014
c now the WW distribution is normalized to 1 over the (x,xmax) range.
 
8015
c Generate a random number between 0 and 1 and find by linear interpolation the
 
8016
c value of y such that ftot(y)=rn
 
8017
      rn=random(jseed)                                           
 
8018
      nmax=nbin
 
8019
30    n=(nmax+nmin)/2
 
8020
      if(nmin.eq.n) then
 
8021
        rn=z(n)+dz*(rn-ftot(n))/(ftot(n+1)-ftot(n))
 
8022
        y=10.d0**(rn)
 
8023
        wwwgt=ftot1-ftotx
 
8024
        go to 40
 
8025
      endif              
 
8026
      if(rn.gt.ftot(n)) then
 
8027
        nmin=n
 
8028
        go to 30
 
8029
      elseif(rn.lt.ftot(n)) then
 
8030
        nmax=n   
 
8031
        go to 30
 
8032
      elseif(rn.eq.ftot(n)) then
 
8033
        rn=z(n)           
 
8034
        y=10.d0**(rn)
 
8035
        wwwgt=ftot1-ftotx
 
8036
        go to 40
 
8037
      endif
 
8038
40    ys=sngl(y)
 
8039
      wwwgts=sngl(wwwgt)
 
8040
      end
 
8041
C DREES AND GRASSIE PHOTON
 
8042
C--------------------------------------------------------
 
8043
      SUBROUTINE PHOPDF(Q2,X,FX,NLF)
 
8044
C PHOTON PDFS           
 
8045
C--------------------------------------------------------
 
8046
      REAL FX(-NLF:NLF)
 
8047
C--------------------------------------------------
 
8048
C         nf=3 for   1< Q2 <32  GeV2
 
8049
C         nf=4 for  32< Q2 <200 GeV2
 
8050
C         nf=5 for 200< Q2 <1D4 GeV2
 
8051
C--------------------------------------------------
 
8052
C Thresholds are chosen for consistency with PDFLIB 4.17
 
8053
      IF(Q2.LT.32.D0)THEN
 
8054
        NF=3
 
8055
      ELSEIF(Q2.LT.200.D0)THEN
 
8056
        NF=4
 
8057
      ELSE
 
8058
        NF=5
 
8059
      ENDIF
 
8060
      DQ=PHDGQ(X,Q2,NF,1)/X
 
8061
      UQ=PHDGQ(X,Q2,NF,2)/X
 
8062
      GL=PHDGG(X,Q2,NF)/X                        
 
8063
      IF(NLF.GE.1) FX(1)=UQ
 
8064
      IF(NLF.GE.2) FX(2)=DQ
 
8065
      IF(NLF.GE.3) FX(3)=DQ
 
8066
      IF(NLF.GE.4) FX(4)=UQ
 
8067
      IF(NLF.GE.5) FX(5)=DQ
 
8068
      FX(0)=GL
 
8069
      DO I=1,NLF
 
8070
        FX(-I)=FX(I)
 
8071
      ENDDO
 
8072
      END
 
8073
c*-- Author :    Drees, Grassie, Charchula, modified by Bryan Webber
 
8074
C ===============================================================
 
8075
C  DREES & GRASSIE PARAMETRIZATION OF PHOTON STRUCTURE FUNCTION
 
8076
C
 
8077
C    PHDGQ(X,Q2,NFL,NCH) - X*QUARK_IN_PHOTON           
 
8078
C    PHDGG(X,Q2,NFL)     - X*GLUON_IN_PHOTON
 
8079
C WHERE:                                    
 
8080
C        (INTEGER) NCH - QUARK CHARGE: 1 FOR 1/3
 
8081
C                                      2 FOR 2/3
 
8082
C        (INTEGER) NFL - NUMBER OF QUARK FLAVOURS /3 OR 4/
 
8083
C                   Q2 - SQUARE OF MOMENTUM Q /IN GEV2/
 
8084
C                   X  - LONGITUDINAL FRACTION
 
8085
C  LAMBDA=0.4 GEV
 
8086
C
 
8087
C       NFL=3:     1 < Q2 < 50   GEV^2
 
8088
C       NFL=4:    20 < Q2 < 500  GEV^2
 
8089
C       NFL=5:   200 < Q2 < 10^4 GEV^2
 
8090
C
 
8091
C
 
8092
C  KRZYSZTOF CHARCHULA  /14.02.1989/
 
8093
C================================================================
 
8094
C
 
8095
C PS. Note that for the case of three flavors, one has to add
 
8096
C the QPM charm contribution for getting F2.
 
8097
C
 
8098
C================================================================
 
8099
C MODIFIED FOR HERWIG BY BRW 19/4/91
 
8100
C--- -----------------------------------------------
 
8101
C        GLUON PART OF THE PHOTON SF
 
8102
C--- -----------------------------------------------
 
8103
      FUNCTION PHDGG(X,Q2,NFL)
 
8104
      IMPLICIT REAL (A-H,P-Z)
 
8105
      INTEGER NFL
 
8106
      DIMENSION A(3,4,3),AT(3)
 
8107
      ALAM2=0.160
 
8108
      T=LOG(Q2/ALAM2)
 
8109
C- ---  CHECK WHETHER NFL  HAVE RIGHT VALUES -----
 
8110
      IF (.NOT.((NFL.EQ.3).OR.(NFL.EQ.4).OR.(NFL.EQ.5))) THEN
 
8111
 130   WRITE(*,131)
 
8112
 131   FORMAT('NUMBER OF FLAVOURS(NFL) HAS NOT BEEN SET TO: 3,4 OR 5;'/
 
8113
     *'          NFL=3 IS ASSUMED')
 
8114
       NFL=3
 
8115
      ENDIF
 
8116
C ------ INITIALIZATION OF PARAMETERS ARRAY -----
 
8117
      DATA(((A(I,J,K),I=1,3),J=1,4),K=1,3)/
 
8118
     + -0.20700,-0.19870, 5.11900,
 
8119
     +  0.61580, 0.62570,-0.27520,
 
8120
     +  1.07400, 8.35200,-6.99300,
 
8121
     +  0.00000, 5.02400, 2.29800,
 
8122
     +    0.8926E-2, 0.05090,-0.23130,
 
8123
     +    0.659400, 0.27740, 0.13820,
 
8124
     +    0.476600,-0.39060, 6.54200,
 
8125
     +    0.019750,-0.32120, 0.51620,
 
8126
     +  0.031970, -0.618E-2, -0.1216,
 
8127
     +  1.0180,    0.94760,  0.90470,
 
8128
     +  0.24610,  -0.60940,  2.6530,
 
8129
     +  0.027070, -0.010670, 0.2003E-2/
 
8130
C ------ Q2 DEPENDENCE -----------
 
8131
      LF=NFL-2
 
8132
      DO 20 I=1,3
 
8133
        AT(I)=A(I,1,LF)*T**A(I,2,LF)+A(I,3,LF)*T**(-A(I,4,LF))
 
8134
 20   CONTINUE
 
8135
C ------ GLUON DISTRIBUTION -------------
 
8136
      PHDGG=AT(1)*X**AT(2)*(1.0-X)**AT(3)/137.
 
8137
      RETURN
 
8138
      END
 
8139
*CMZ :-        -26/04/91  13.04.45  by  Federico Carminati
 
8140
*-- Author :    Drees, Grassie, Charchula, modified by Bryan Webber
 
8141
C --------------------------------------
 
8142
C  QUARK PART OF THE PHOTON SF
 
8143
C --------------------------------------
 
8144
      FUNCTION PHDGQ(X,Q2,NFL,NCH)
 
8145
      IMPLICIT REAL (A-H,P-Z)
 
8146
      INTEGER NFL,NCH
 
8147
      DIMENSION A(5,4,2,3),AT(5,2),XQPOM(2),E(2)
 
8148
      COMMON/K719DG/F2
 
8149
C SQUARE OF LAMBDA=0.4 GEV
 
8150
      ALAM2=0.160
 
8151
      T=LOG(Q2/ALAM2)
 
8152
C
 
8153
C  CHECK WHETHER NFL AND NCH HAVE RIGHT VALUES
 
8154
C
 
8155
      IF(.NOT.((NFL.EQ.3).OR.(NFL.EQ.4).OR.(NFL.EQ.5))) THEN
 
8156
 110   WRITE(*,111)
 
8157
 111   FORMAT('NUMBER OF FLAVOURS (NFL) HAS NOT BEEN SET TO: 3,4 OR 5'/
 
8158
     *'          NFL=3 IS ASSUMED')
 
8159
       NFL=3
 
8160
      ENDIF
 
8161
      IF (.NOT.((NCH.EQ.1).OR.(NCH.EQ.2))) THEN
 
8162
 120     WRITE(*,121)
 
8163
 121     FORMAT(' QUARK CHARGE NUMBER (NCH) HAS NOT BEEN SET
 
8164
     * TO 1 OR 2;'/
 
8165
     *'           NCH=1 IS ASSUMED')
 
8166
         NCH=1
 
8167
      ENDIF
 
8168
C ------ INITIALIZATION ------
 
8169
      DATA(((A(I,J,K,1),I=1,5),J=1,4),K=1,2)/
 
8170
     + 2.28500,  6.07300, -0.42020,-0.08080, 0.05530,
 
8171
     +-0.01530, -0.81320,  0.01780, 0.63460, 1.13600,
 
8172
     + 1.3300E3,-41.3100,   0.92160, 1.20800, 0.95120,
 
8173
     + 4.21900,  3.16500,  0.18000, 0.20300, 0.01160,
 
8174
     +16.6900,   0.17600, -0.02080,-0.01680,-0.19860,
 
8175
     +-0.79160,  0.04790,  0.3386E-2,1.35300, 1.10000,
 
8176
     + 1.0990E3,  1.04700,  4.85300, 1.42600, 1.13600,
 
8177
     + 4.42800,  0.02500,  0.84040, 1.23900,-0.27790/
 
8178
        DATA(((A(I,J,K,2),I=1,5),J=1,4),K=1,2)/
 
8179
     +-0.37110,-0.17170, 0.087660,-0.89150,-0.18160,
 
8180
     + 1.06100, 0.78150, 0.021970, 0.28570, 0.58660,
 
8181
     + 4.75800, 1.53500, 0.109600, 2.97300, 2.42100,
 
8182
     +-0.01500, 0.7067E-2,0.204000, 0.11850, 0.40590,
 
8183
     +-0.12070,25.00000,-0.012300,-0.09190, 0.020150,
 
8184
     + 1.07100,-1.64800, 1.162000, 0.79120, 0.98690,
 
8185
     + 1.97700,-0.015630,0.482400, 0.63970,-0.070360,
 
8186
     +-0.8625E-2,6.43800,-0.011000, 2.32700, 0.016940/
 
8187
        DATA(((A(I,J,K,3),I=1,5),J=1,4),K=1,2)/
 
8188
     +15.80,     2.7420,  0.029170,-0.03420, -0.023020,
 
8189
     +-0.94640, -0.73320, 0.046570, 0.71960,  0.92290,
 
8190
     +-0.50,     0.71480, 0.17850,  0.73380,  0.58730,
 
8191
     +-0.21180,  3.2870,  0.048110, 0.081390,-0.79E-4,
 
8192
     + 6.7340,  59.880,  -0.3226E-2,-0.03321,   0.10590,
 
8193
     +-1.0080,  -2.9830,  0.84320,  0.94750,  0.69540,
 
8194
     +-0.085940, 4.480,   0.36160, -0.31980, -0.66630,
 
8195
     + 0.076250, 0.96860, 0.1383E-2, 0.021320, 0.36830/
 
8196
      CF=10.0
 
8197
C ------- EVALUATION OF PARAMETERS IN Q2 ---------
 
8198
      E(1)=1.0
 
8199
      IF (NFL.EQ.3) THEN
 
8200
        E(2)=9.0
 
8201
        LF=1
 
8202
      ELSEIF (NFL.EQ.4) THEN
 
8203
        E(2)=10.0
 
8204
        LF=2
 
8205
      ELSEIF (NFL.EQ.5) THEN
 
8206
        E(2)=55.0/6.0
 
8207
        LF=3
 
8208
      ENDIF
 
8209
      DO 10 J=1,2
 
8210
        DO 20 I=1,5
 
8211
           ATP=A(I,1,J,LF)*T**A(I,2,J,LF)
 
8212
           AT(I,J)=ATP+A(I,3,J,LF)*T**(-A(I,4,J,LF))
 
8213
 20     CONTINUE
 
8214
 10   CONTINUE
 
8215
      DO 30 J=1,2
 
8216
       POM1=X*(X*X+(1.0-X)**2)/(AT(1,J)-AT(2,J)*ALOG(1.0-X))
 
8217
       POM2=AT(3,J)*X**AT(4,J)*(1.0-X)**AT(5,J)
 
8218
       XQPOM(J)=E(J)*POM1+POM2
 
8219
 30   CONTINUE
 
8220
C -------  QUARK DISTRIBUTIONS ----------
 
8221
      IF (NFL.EQ.3) THEN
 
8222
         IF (NCH.EQ.2) THEN
 
8223
           PHDGQ=1.0/6.0*(XQPOM(2)+9.0*XQPOM(1))
 
8224
         ELSEIF(NCH.EQ.1) THEN
 
8225
           PHDGQ=1.0/6.0*(XQPOM(2)-9.0/2.0*XQPOM(1))
 
8226
         ENDIF
 
8227
        F2=2.0/9.0*XQPOM(2)+XQPOM(1)
 
8228
      ELSEIF (NFL.EQ.4) THEN
 
8229
         IF (NCH.EQ.2) THEN
 
8230
           PHDGQ=1.0/8.0*(XQPOM(2)+6.0*XQPOM(1))
 
8231
         ELSEIF(NCH.EQ.1) THEN
 
8232
           PHDGQ=1.0/8.0*(XQPOM(2)-6.0*XQPOM(1))
 
8233
         ENDIF
 
8234
        F2=5.0/18.0*XQPOM(2)+XQPOM(1)
 
8235
      ELSEIF (NFL.EQ.5) THEN
 
8236
         IF (NCH.EQ.2) THEN
 
8237
           PHDGQ=1.0/10.0*(XQPOM(2)+15.0/2.0*XQPOM(1))
 
8238
         ELSEIF(NCH.EQ.1) THEN
 
8239
           PHDGQ=1.0/10.0*(XQPOM(2)-5.0*XQPOM(1))
 
8240
         ENDIF
 
8241
        F2=11.0/45.0*XQPOM(2)+XQPOM(1)
 
8242
      ENDIF
 
8243
      PHDGQ=PHDGQ/137.
 
8244
      RETURN
 
8245
      END
 
8246
C  END DREES AND GRASSIE PHOTON
 
8247
C  FONTANNAZ ET AL PHOTON PDF'S
 
8248
      SUBROUTINE FONPDF(Q2IN,X,FX,NLF)
 
8249
C                           
 
8250
C     INTERPOLATION PROGRAM WHICH INTERPOLATES THE GRID "DATAN" AND GIVES THE
 
8251
C     QUARK AND GLUON DISTRIBUTIONS IN THE REAL PHOTON, AS FUNCTIONS OF X AND Q2
 
8252
C
 
8253
C     THE Q2-EVOLUTION IS PERFORMED WITH BLL AP-EQUATIONS AND NF=4. A MASSIVE
 
8254
C     CHARM DISTRIBUTION (BORROWED FROM GLUCK AND REYA) IS ALSO AVAILABLE.
 
8255
C
 
8256
C     THE BOUNDARY CONDITIONS ARE SUCH THAT THE DISTRIBUTION FUNCTIONS ARE GIVEN
 
8257
C     BY A VDM "ANSATZ" AT Q2=.25 GEV**2.
 
8258
C
 
8259
C     THE PROGRAM WORKS FOR  2. GEV**2 < Q2 <5.5E+5   AND .00137 < X < .9986
 
8260
C
 
8261
C     THE DISTRIBUTIONS ARE CALCULATED IN THE MSBAR FACTORIZATION SCHEME.
 
8262
C
 
8263
C     THE VALUE OF LAMBDA-MSB IS 200 MEV
 
8264
C
 
8265
C     THE OUTPUT IS WRITTEN IN THE FILE 'FILEOUT':
 
8266
C                                UPLUS=X*(U(X,Q2)+UBAR(X,Q2))
 
8267
C                                DPLUS= ...
 
8268
C                                SPLUS= ...
 
8269
C                                CPLUS= ...  (MASSLESS CHARM WITH CPLUS(X,2.)=0)
 
8270
C                                CPLUM= ...  (MASSIVE CHARM WITH MC=1.5 GEV )
 
8271
C                                GLU=GLUON(X,Q2)*X
 
8272
C                                SING=SINGLET(X,Q2)*X
 
8273
C
 
8274
C                    F2 = PHOTON STRUCTURE FUNCTION WITHOUT CHARM
 
8275
C                    F2C=  "        "         "     WITH MASSIVE CHARM
 
8276
C
 
8277
      REAL FX(-NLF:NLF)
 
8278
      DIMENSION Q(7),PAR(30),ZQ(5)
 
8279
      COMMON/K719FOANEW/DELTA,FLAVOR,GLUCK
 
8280
      COMMON/K719FOCONV/ IORD,ICONV,OWLAM,OWLAM2,RLAM,RLAM2
 
8281
      COMMON/K719FOQS/Q2
 
8282
      COMMON/K719FOQ000/Q02
 
8283
      COMMON/K719FOQ2DIST/IDQ2
 
8284
      COMMON/K719FOGFUNC/CALC(8,20,32)
 
8285
      COMMON/K719FOGAUS32/XI(32),WI(32),NTERMS,XX(33)
 
8286
      DATA INIT/0/
 
8287
      EXTERNAL CPLU
 
8288
      Q2=Q2IN
 
8289
C INITIALIZATION
 
8290
      IF(INIT.EQ.0) THEN
 
8291
        INIT=1
 
8292
        OPEN(UNIT=12,FILE='DATAN',STATUS='OLD')
 
8293
C          
 
8294
C  SET UP FLAGS, I/O FILES, ETC.
 
8295
C
 
8296
C  Q2 DEPENDENCE TURNED ON
 
8297
        IDQ2=2
 
8298
C
 
8299
C   STRUCTURE FUNCTIONS CONVENTIONS
 
8300
C   IORD=0                     LEADING ORDER
 
8301
C   IORD=1             NEXT TO LEADING ORDER
 
8302
C
 
8303
        READ(12,*) PAR
 
8304
        READ(12,2) CALC
 
8305
   2    FORMAT(8E15.4)
 
8306
        CLOSE(UNIT=12)
 
8307
        IORD=INT(PAR(28))
 
8308
        GLUCK=PAR(26)
 
8309
        FLAV=PAR(25)
 
8310
        NF=INT(FLAV+1.E-7)
 
8311
        DELTA=PAR(29)
 
8312
        OWLAM=PAR(1)
 
8313
        OWLAM2=OWLAM**2
 
8314
        Q02=PAR(30)
 
8315
        PI=4.*ATAN(1.)
 
8316
        PI2=PI**2
 
8317
        CF=4./3.
 
8318
        FLAVOR=FLAV
 
8319
        B0=11.-2.*NF/3.
 
8320
        B1=102.-38.*NF/3.
 
8321
        CCOEG=2./9.
 
8322
        IF(NF.EQ.4) CCOEG=5./18.
 
8323
        COEG=2.*FLAVOR*CCOEG
 
8324
        CALL WATE32
 
8325
        IF(IORD.EQ.0)B1=0.
 
8326
      ENDIF
 
8327
C  INITIALIZATION COMPLETED
 
8328
      XSAVE=X
 
8329
      IF(X.LT.0.00137)X=0.00137
 
8330
      IF(X.GT.0.9986)X=0.9986
 
8331
      ALQ2=ALOG(Q2/OWLAM2) 
 
8332
      ALFPI= 2. /(B0*ALQ2+B1*ALOG(ALQ2)/B0)
 
8333
      CALL DIST(X,Q)
 
8334
      ADD=Q(1)/FLAVOR
 
8335
      UPLUS=Q(5)+ADD
 
8336
      DPLUS=-Q(4)+ADD
 
8337
      SPLUS=-Q(6)+ADD
 
8338
      CPLUS=-Q(3)+ADD
 
8339
      SING=Q(1)
 
8340
      GLU=Q(7)
 
8341
      CPLUM=CPLU(X,Q2)
 
8342
      DQ=DPLUS/X
 
8343
      UQ=UPLUS/X
 
8344
      SQ=SPLUS/X
 
8345
      CQ=CPLUM/X
 
8346
      GL=GLU/X                        
 
8347
      IF(NLF.GE.1) FX(1)=UQ/2.
 
8348
      IF(NLF.GE.2) FX(2)=DQ/2.
 
8349
      IF(NLF.GE.3) FX(3)=SQ/2.
 
8350
      IF(NLF.GE.4) FX(4)=CQ/2.
 
8351
      IF(NLF.GE.5) FX(5)=0.
 
8352
      FX(0)=GL            
 
8353
      DO I=1,NLF
 
8354
        FX(-I)=FX(I)
 
8355
      ENDDO
 
8356
      X=XSAVE
 
8357
      END
 
8358
C
 
8359
      FUNCTION CPLU(X,Q2)
 
8360
      CMS=1.5**2
 
8361
      BETS=1-4.*CMS*X/(1.-X)/Q2
 
8362
      IF(BETS.LE..0) CPLU=.0
 
8363
      IF(BETS.LE..0) GO TO 1
 
8364
      BETA=SQRT(BETS)
 
8365
      CPLU=(8.*X*(1.-X)-1.-4.*CMS*X*(1.-X)/Q2)*BETA
 
8366
      CAU=X**2+(1.-X)**2+4.*CMS*X*(1.-3.*X)/Q2-8.*CMS**2*X**2/Q2**2
 
8367
      CPLU=CPLU+CAU*ALOG((1.+BETA)/(1.-BETA))
 
8368
      CPLU=3.*(4./9.)*CPLU*X/(3.1415*137.)
 
8369
  1   RETURN
 
8370
      END
 
8371
C
 
8372
      SUBROUTINE DIST(X,Q)
 
8373
      DIMENSION Q(7)
 
8374
      COMMON/K719FOQS/Q2
 
8375
      COMMON/K719FOQ000/Q02
 
8376
      COMMON/K719FOANEW/DELTA,FLAVOR,GLUCK
 
8377
      COMMON/K719FOCONV/ IORD,ICONV,OWLAM,OWLAM2,RLAM,RLAM2
 
8378
      COMMON/K719FOQ2DIST/IDQ2
 
8379
      COMMON/K719FOGFUNC/CALC(8,20,32)
 
8380
      SB=0.
 
8381
      IF(Q2-Q02) 1,1,2
 
8382
    2 IF(IDQ2-1) 1,1,3
 
8383
    3 SB=ALOG(ALOG(Q2/OWLAM2)/ALOG(Q02/OWLAM2))
 
8384
    1 CONTINUE
 
8385
      CALL GINTER(8,0,X,SB,Q(7))
 
8386
      CALL GINTER(7,0,X,SB,SING)
 
8387
      CALL GINTER(4,0,X,SB,DPLUSNS)
 
8388
      CALL GINTER(3,0,X,SB,CPLUSNS)
 
8389
      IF(GLUCK.GT..5) GO TO 7
 
8390
      CALL GINTER(5,0,X,SB,UPLUSNS)
 
8391
      CALL GINTER(6,0,X,SB,SPLUSNS)
 
8392
      Q(3)=CPLUSNS
 
8393
      Q(4)=DPLUSNS
 
8394
      Q(5)=UPLUSNS
 
8395
      Q(6)=SPLUSNS
 
8396
      GO TO 8
 
8397
   7  Q(2)=DPLUSNS
 
8398
C LORSQUE GLUCK=1, LA 4EME COLONNE DE GRILLE CONTIENT QNS
 
8399
      Q(5)=0.
 
8400
      Q(4)=0.
 
8401
      Q(6)=0.
 
8402
 8    Q(1)=SING
 
8403
      RETURN
 
8404
      END
 
8405
C
 
8406
      SUBROUTINE GINTER(I,NDRV,X,S,ANS)
 
8407
      DIMENSION F1(32),F2(32),F3(32)
 
8408
      COMMON/K719FOGFUNC/GF(8,20,32)
 
8409
      COMMON/K719FOANEW/DELTA,FLAVOR,GLUCK
 
8410
      DIMENSION AF(3),AS(3)
 
8411
      N=3
 
8412
      IS=S/DELTA+1
 
8413
      IF(IS.GE.19)PAUSE
 
8414
      IF(IS.GE.17) IS=17
 
8415
      IS1=IS+1
 
8416
      IS2=IS1+1
 
8417
      DO 1 L=1,32
 
8418
      KL=L+32*NDRV
 
8419
      F1(L)=GF(I,IS,KL)
 
8420
      F2(L)=GF(I,IS1,KL)
 
8421
      F3(L)=GF(I,IS2,KL)
 
8422
    1 CONTINUE
 
8423
      AF(1)=GETFV(X,F1)
 
8424
      AF(2)=GETFV(X,F2)
 
8425
      AF(3)=GETFV(X,F3)
 
8426
      AS(1)=(IS-1)*DELTA
 
8427
      AS(2)=AS(1)+DELTA
 
8428
      AS(3)=AS(2)+DELTA
 
8429
      CALL POLINT(AS,AF,N,S,AANS,DY)
 
8430
      ANS=AANS
 
8431
      RETURN
 
8432
      END
 
8433
 
 
8434
      SUBROUTINE WATE32
 
8435
C  32 POINT GAUSSIAN QUADRATURE ROUTINE
 
8436
      DIMENSION X(16),W(16)
 
8437
      COMMON/K719FOGAUS32/XI(32),WI(32),NTERMS,XX(33)
 
8438
      NTERMS=32                     
 
8439
      X(1)=0.048307665687738316235
 
8440
      X(2)=0.144471961582796493485
 
8441
      X(3)=0.239287362252137074545
 
8442
      X(4)=0.331868602282127649780
 
8443
      X(5)=0.421351276130635345364
 
8444
      X(6)=0.506899908932229390024
 
8445
      X(7)=0.587715757240762329041
 
8446
      X(8)=0.663044266930215200975
 
8447
      X(9)=0.732182118740289680387
 
8448
      X(10)=0.794483795967942406963
 
8449
      X(11)=0.849367613732569970134
 
8450
      X(12)=0.896321155766052123965
 
8451
      X(13)=0.934906075937739689171
 
8452
      X(14)=0.964762255587506430774
 
8453
      X(15)=0.985611511545268335400
 
8454
      X(16)=0.997263861849481563545
 
8455
      W(1)=0.096540088514727800567
 
8456
      W(2)=0.095638720079274859419
 
8457
      W(3)=0.093844399080804565639
 
8458
      W(4)=0.091173878695763884713
 
8459
      W(5)=0.087652093004403811143
 
8460
      W(6)=0.083311924226946755222
 
8461
      W(7)=0.078193895787070306472
 
8462
      W(8)=0.072345794108848506225
 
8463
      W(9)=0.065822222776361846838
 
8464
      W(10)=0.058684093478535547145
 
8465
      W(11)=0.050998059262376176196
 
8466
      W(12)=0.042835898022226680657
 
8467
      W(13)=0.034273862913021433103
 
8468
      W(14)=0.025392065309262059456
 
8469
      W(15)=0.016274394730905670605
 
8470
      W(16)=0.007018610009470096600
 
8471
      DO 1 I=1,16
 
8472
      XI(I)=-X(17-I)
 
8473
      WI(I)=W(17-I)
 
8474
      XI(I+16)=X(I)
 
8475
      WI(I+16)=W(I)
 
8476
    1 CONTINUE
 
8477
      DO 2 I=1,32
 
8478
    2 XX(I)=0.5*(XI(I)+1.)
 
8479
      XX(33)=1.0
 
8480
      RETURN
 
8481
      END
 
8482
C
 
8483
       FUNCTION GETFV(X,FVL)
 
8484
C  NOUVEAU PROGRAMME D'INTERPOLATION UTILISANT UNE ROUTINE DE MATH. RECIPES
 
8485
       DIMENSION FVL(32)
 
8486
       COMMON/K719FOGAUS32/XI(32),WI(32),NTERMS,XX(33)
 
8487
       DIMENSION A(4),B(4)
 
8488
       N=4
 
8489
       EPS=1.E-7
 
8490
       XAM=XX(1)-EPS
 
8491
       XAP=XX(1)+EPS
 
8492
C      IF(X.LT.XAM) PRINT*,' X = ',X
 
8493
       IF(X.GT.XAM.AND.X.LT.XAP) GO TO 50
 
8494
       GO TO 80
 
8495
   50  Y=FVL(1)
 
8496
       GO TO 77
 
8497
   80  IF(X.LT.XX(2)) GO TO 51
 
8498
       IF(X.GT.XX(30)) GO TO 61
 
8499
       DO 1 I=3,30
 
8500
       IF(X.GT.XX(I)) GO TO 1
 
8501
       A(1)=XX(I-2)
 
8502
       A(2)=XX(I-1)
 
8503
       A(3)=XX(I)
 
8504
       A(4)=XX(I+1)
 
8505
       B(1)=FVL(I-2)
 
8506
       B(2)=FVL(I-1)
 
8507
       B(3)=FVL(I)
 
8508
       B(4)=FVL(I+1)
 
8509
       GO TO 70
 
8510
   1   CONTINUE
 
8511
  61   A(1)=XX(29)
 
8512
       A(2)=XX(30)
 
8513
       A(3)=XX(31)
 
8514
       A(4)=XX(32)
 
8515
       B(1)=FVL(29)
 
8516
       B(2)=FVL(30)
 
8517
       B(3)=FVL(31)
 
8518
       B(4)=FVL(32)
 
8519
       GO  TO 70
 
8520
  51   A(1)=XX(1)
 
8521
       A(2)=XX(2)
 
8522
       A(3)=XX(3)
 
8523
       A(4)=XX(4)
 
8524
       B(1)=FVL(1)
 
8525
       B(2)=FVL(2)
 
8526
       B(3)=FVL(3)
 
8527
       B(4)=FVL(4)
 
8528
  70   CONTINUE
 
8529
C      IF(X.GT..2.AND.X.LT..8) THEN
 
8530
             CALL POLINT(A,B,N,X,Y,DY)
 
8531
C      ELSE
 
8532
C            CALL RATINT(A,B,N,X,Y,DY)
 
8533
C      ENDIF
 
8534
  77   GETFV=Y
 
8535
       RETURN
 
8536
       END
 
8537
 
 
8538
      SUBROUTINE RATINT(XA,YA,N,X,Y,DY)
 
8539
      PARAMETER (NMAX=10,TINY=1.E-25)
 
8540
      DIMENSION XA(N),YA(N),C(NMAX),D(NMAX)
 
8541
      NS=1
 
8542
      HH=ABS(X-XA(1))
 
8543
      DO 11 I=1,N
 
8544
        H=ABS(X-XA(I))
 
8545
        IF (H.EQ.0.)THEN
 
8546
          Y=YA(I)
 
8547
          DY=0.0
 
8548
          RETURN
 
8549
        ELSE IF (H.LT.HH) THEN
 
8550
          NS=I
 
8551
          HH=H
 
8552
        ENDIF
 
8553
        C(I)=YA(I)
 
8554
        D(I)=YA(I)+TINY
 
8555
11    CONTINUE
 
8556
      Y=YA(NS)
 
8557
      NS=NS-1
 
8558
      DO 13 M=1,N-1
 
8559
        DO 12 I=1,N-M
 
8560
          W=C(I+1)-D(I)
 
8561
          H=XA(I+M)-X
 
8562
          T=(XA(I)-X)*D(I)/H
 
8563
          DD=T-C(I+1)
 
8564
          IF(DD.EQ.0.)PAUSE
 
8565
          DD=W/DD
 
8566
          D(I)=C(I+1)*DD
 
8567
          C(I)=T*DD
 
8568
12      CONTINUE
 
8569
        IF (2*NS.LT.N-M)THEN
 
8570
          DY=C(NS+1)
 
8571
        ELSE
 
8572
          DY=D(NS)
 
8573
          NS=NS-1
 
8574
        ENDIF
 
8575
        Y=Y+DY
 
8576
13    CONTINUE
 
8577
      RETURN
 
8578
      END
 
8579
 
 
8580
      SUBROUTINE POLINT(XA,YA,N,X,Y,DY)
 
8581
      PARAMETER (NMAX=10)
 
8582
      DIMENSION XA(N),YA(N),C(NMAX),D(NMAX)
 
8583
      NS=1
 
8584
      DIF=ABS(X-XA(1))
 
8585
      DO 11 I=1,N
 
8586
        DIFT=ABS(X-XA(I))
 
8587
        IF (DIFT.LT.DIF) THEN
 
8588
          NS=I
 
8589
          DIF=DIFT
 
8590
        ENDIF
 
8591
        C(I)=YA(I)
 
8592
        D(I)=YA(I)
 
8593
11    CONTINUE
 
8594
      Y=YA(NS)
 
8595
      NS=NS-1
 
8596
      DO 13 M=1,N-1
 
8597
        DO 12 I=1,N-M
 
8598
          HO=XA(I)-X
 
8599
          HP=XA(I+M)-X
 
8600
          W=C(I+1)-D(I)
 
8601
          DEN=HO-HP
 
8602
          IF(DEN.EQ.0.)PAUSE
 
8603
          DEN=W/DEN
 
8604
          D(I)=HP*DEN
 
8605
          C(I)=HO*DEN
 
8606
12      CONTINUE
 
8607
        IF (2*NS.LT.N-M)THEN
 
8608
          DY=C(NS+1)
 
8609
        ELSE
 
8610
          DY=D(NS)
 
8611
          NS=NS-1
 
8612
        ENDIF
 
8613
        Y=Y+DY
 
8614
13    CONTINUE
 
8615
      RETURN
 
8616
      END
 
8617
C-- END FONTANNAZ ET AL PHOTON PDF'S
 
8618
C FONTANNAZ 1994
 
8619
      SUBROUTINE AFGPDF(Q2IN,X,FX,NLF)
 
8620
C**************************************************************************
 
8621
C                       ( 1st of February 1994)
 
8622
C     This is an interpolation program which reads the files GRPOL and 
 
8623
C     GRVDM and gives the quark and gluon distributions in real photon 
 
8624
C     as functions of x and Q**2.
 
8625
C
 
8626
C     The Q**2 evolution is a BLL evolution (MSbar scheme) with Nf=4
 
8627
C     and LAMBDA(MSbar)=.200 Gev.
 
8628
C
 
8629
C     A massless charm distribution is generated for Q**2 > 2 Gev**2.
 
8630
C
 
8631
C     The distributions are the sum of a pointlike part (PL) and of a
 
8632
C     Vdm part (VDM):
 
8633
C                     dist=PL + KA*VDM
 
8634
C     KA is a factor which can be adjusted ( the default value is KA=1.0).
 
8635
C     The file GRPOL contains the pointlike part of the distributions.
 
8636
C     The file GRVDM contains the vdm part (A precise definition of this
 
8637
C     latter is given in the paper "PARTON DISTRIBUTIONS IN THE PHOTON",
 
8638
C     Preprint LPTHE Orsay 93-37, by P.Aurenche,M.Fontannaz and J.Ph.Guillet).
 
8639
C
 
8640
C     The output of the program is written in the file GETOUT with the 
 
8641
C     following conventions
 
8642
C                              UPLUS=x(u+ubar)
 
8643
C                              DPLUS=x(d+dbar)
 
8644
C                              SPLUS=x(s+sbar)
 
8645
C                              CPLUS=x(c+cbar)
 
8646
C                              SING =UPLUS+DPLUS+SPLUS+CPLUS
 
8647
C                              GLU  =x*g
 
8648
C     
 
8649
C      The interpolation is valid for     2. < Q**2 < 5.5E+5 Gev**2,
 
8650
C                             and for   .0015<  x   < .99 
 
8651
C
 
8652
C      The program also gives the structure function F2:
 
8653
C                        F2 = q*Cq + g*Cg + Cgam
 
8654
C      Cq and Cg are the Wilson coeficients and Cgam is the direct term.
 
8655
C
 
8656
C      Although the charm quark evolution is massless, the direct term
 
8657
C      Cgam includes the effects due to the charm quark mass. The charm
 
8658
C      quark threshold is therefore correctly described at the lowest 
 
8659
C      ordre in alphastrong (Details are given in the preprint).
 
8660
C
 
8661
C      The charm contribution can be set equal to zero with the CHARME flag
 
8662
C      ( CHARME=0.  -> no charm) ( 27/09/94)
 
8663
C      
 
8664
C**************************************************************************
 
8665
      REAL FX(-NLF:NLF)
 
8666
      DIMENSION Q(7),PAR(30),PAR2(30),QQ(7)
 
8667
      COMMON/K719ANEW/DELTA
 
8668
      COMMON/K719CONV2342/ IORD,ICONV,OWLAM,OWLAM2,RLAM,RLAM2
 
8669
      COMMON/K719QS/Q2
 
8670
      COMMON/K719Q000/Q02
 
8671
      COMMON/K719GFUNC/CALC(8,20,32)
 
8672
      COMMON/K719GVDM/CELC(8,20,32)
 
8673
      COMMON/K719GAUS32/XI(32),WI(32),NTERMS,XX(33)
 
8674
      COMMON/K719CHARM/CM
 
8675
      DATA INIT/0/
 
8676
      REAL KA
 
8677
      Q2=Q2IN
 
8678
      IF(INIT.EQ.0) THEN
 
8679
        INIT=1
 
8680
        OPEN(UNIT=12,FILE='GRPOL',STATUS='OLD')
 
8681
        OPEN(UNIT=14,FILE='GRVDM',STATUS='OLD')
 
8682
C
 
8683
C   SET UP FLAGS, I/O FILES, ETC.
 
8684
C
 
8685
C   STRUCTURE FUNCTIONS CONVENTIONS
 
8686
C   IORD=0                     LEADING ORDER
 
8687
C   IORD=1             NEXT TO LEADING ORDER
 
8688
C
 
8689
        READ(12,*) PAR
 
8690
        READ(12,2) CALC
 
8691
        READ(14,*) PAR2
 
8692
        READ(14,2) CELC
 
8693
C*****adjustment of the VDM contribution*******************************
 
8694
        KA=1.
 
8695
C
 
8696
C*****mass of the charm quark******************************************
 
8697
        CM=1.41
 
8698
C*****CHARME=0. -> no charm contribution ******************************
 
8699
        CHARME=1.
 
8700
C
 
8701
C******The parameters are fixed in the file GRPOL**********************     
 
8702
C
 
8703
        IORD=INT(PAR(28)+1.E-7)
 
8704
        FLAV=PAR(25)
 
8705
2       FORMAT(8E15.4)
 
8706
        DELTA=PAR(29)
 
8707
        OWLAM=PAR(1)
 
8708
        OWLAM2=OWLAM**2
 
8709
        Q02=PAR(30)
 
8710
        PI=4.*ATAN(1.)
 
8711
        PI2=PI**2
 
8712
        CF=4./3.
 
8713
        NF=INT(FLAV+1.E-7)
 
8714
        IF(NF.EQ.0) NF=3
 
8715
        FLAVOR=FLOAT(NF)
 
8716
        B0=11.-2.*NF/3.
 
8717
        B1=102.-38.*NF/3.
 
8718
        CCOEG=2./9.
 
8719
C        IF(NF.EQ.4) CCOEG=5./18.
 
8720
C        COEG=2.*FLAVOR*CCOEG
 
8721
        COEG=6.*CCOEG
 
8722
        CALL WATE32_N
 
8723
        IF(IORD.EQ.0)B1=0.
 
8724
      ENDIF
 
8725
C  INITIALIZATION COMPLETED
 
8726
      XSAVE=X
 
8727
      IF(X.LT.0.0015)X=0.0015
 
8728
      IF(X.GT.0.99)X=0.99
 
8729
      XTH=1./(1.+4.*CM**2/Q2)
 
8730
      ALQ2=XLOG(Q2/OWLAM2)
 
8731
      ALFPI= 2. /(B0*ALQ2+B1*XLOG(ALQ2)/B0)
 
8732
      CUT=1.     
 
8733
      IF(CHARME.EQ.0.) CUT=0.
 
8734
      CUTG=1.
 
8735
      IF(X.GT.XTH) CUT=0.
 
8736
      CALL DIST_N(X,Q)
 
8737
      ADD=Q(1)/FLAVOR
 
8738
      UPLUS=Q(5)+ADD
 
8739
      DPLUS=-Q(4)+ADD
 
8740
      SPLUS=-Q(6)+ADD
 
8741
      CPLUS=-Q(3)+ADD
 
8742
      SING=Q(1)
 
8743
      GLU=Q(7)         
 
8744
      CALL DIST2_N(X,QQ)
 
8745
      ADD2=QQ(1)/FLAVOR
 
8746
      UPLU2=QQ(5)+ADD2
 
8747
      DPLU2=-QQ(4)+ADD2
 
8748
      SPLU2=-QQ(6)+ADD2
 
8749
      CPLU2=-QQ(3)+ADD2
 
8750
      SING2=QQ(1)
 
8751
      GLU2=QQ(7)
 
8752
      UPLUS=UPLUS+UPLU2*KA
 
8753
      DPLUS=DPLUS+DPLU2*KA
 
8754
      SPLUS=SPLUS+SPLU2*KA
 
8755
      CPLUS=CPLUS+CPLU2*KA
 
8756
      SING=SING+SING2*KA
 
8757
      GLU=GLU+GLU2*KA
 
8758
      DQ=DPLUS/X
 
8759
      UQ=UPLUS/X
 
8760
      SQ=SPLUS/X
 
8761
      CQ=CPLUS/X
 
8762
      GL=GLU/X                        
 
8763
      IF(NLF.GE.1) FX(1)=UQ/2.
 
8764
      IF(NLF.GE.2) FX(2)=DQ/2.
 
8765
      IF(NLF.GE.3) FX(3)=SQ/2.
 
8766
      IF(NLF.GE.4) FX(4)=CQ/2.
 
8767
      IF(NLF.GE.5) FX(5)=0.
 
8768
      FX(0)=GL
 
8769
      DO I=1,NLF
 
8770
        FX(-I)=FX(I)
 
8771
      ENDDO
 
8772
      X=XSAVE
 
8773
      RETURN
 
8774
      END
 
8775
C
 
8776
      FUNCTION WCM(X,Q2)
 
8777
      COMMON/K719CHARM/CM
 
8778
      CMS=CM**2
 
8779
      SC=Q2*(1.-X)/X
 
8780
      BE=4.*CMS/SC
 
8781
      IF(BE.GE.1.) WCM=0.
 
8782
      IF(BE.GE.1.) GO TO 1
 
8783
      SQ=SQRT(1.-BE)
 
8784
      A1=((1.+SQ)/2.)**2 
 
8785
      A2=(1.-X)/X
 
8786
      WCM=(8.*(1.-X)*X-1.)*SQ+(X**2+(1.-X)**2)*XLOG(A1*A2)
 
8787
      WCM=3.*(4./9.)/(3.1416*137.)*X*WCM
 
8788
 1    RETURN
 
8789
      END
 
8790
 
 
8791
      SUBROUTINE DIST_N(X,Q)
 
8792
      DIMENSION Q(7)
 
8793
      COMMON/K719QS/Q2
 
8794
      COMMON/K719Q000/Q02
 
8795
      COMMON/K719ANEW/DELTA
 
8796
      COMMON/K719CONV2342/ IORD,ICONV,OWLAM,OWLAM2,RLAM,RLAM2
 
8797
      SB=0.
 
8798
      IF(Q2-Q02) 1,1,3
 
8799
    3 SB=XLOG(XLOG(Q2/OWLAM2)/XLOG(Q02/OWLAM2))
 
8800
    1 CONTINUE
 
8801
C      PROGRAM DISTL0.FOR
 
8802
      CALL GINTER_N(8,0,X,SB,Q(7))
 
8803
      CALL GINTER_N(7,0,X,SB,SING1)
 
8804
      CALL GINTER_N(4,0,X,SB,DPLUSNS)
 
8805
      CALL GINTER_N(3,0,X,SB,CPLUSNS)
 
8806
      CALL GINTER_N(5,0,X,SB,UPLUSNS)
 
8807
      CALL GINTER_N(6,0,X,SB,SPLUSNS)
 
8808
      Q(3)=CPLUSNS
 
8809
      Q(4)=DPLUSNS
 
8810
      Q(5)=UPLUSNS
 
8811
      Q(6)=SPLUSNS
 
8812
 8    Q(1)=SING1
 
8813
      RETURN
 
8814
      END
 
8815
 
 
8816
      SUBROUTINE DIST2_N(X,QQ)
 
8817
      DIMENSION QQ(7)
 
8818
      COMMON/K719QS/Q2
 
8819
      COMMON/K719Q000/Q02
 
8820
      COMMON/K719ANEW/DELTA
 
8821
      COMMON/K719CONV2342/ IORD,ICONV,OWLAM,OWLAM2,RLAM,RLAM2
 
8822
      SB=0.
 
8823
      IF(Q2-Q02) 1,1,3
 
8824
    3 SB=XLOG(XLOG(Q2/OWLAM2)/XLOG(Q02/OWLAM2))
 
8825
    1 CONTINUE
 
8826
C      PROGRAM DISTL0.FOR
 
8827
      CALL GINTER2_N(8,0,X,SB,QQ(7))
 
8828
      CALL GINTER2_N(7,0,X,SB,SING2)
 
8829
      CALL GINTER2_N(4,0,X,SB,DPLUSNS)
 
8830
      CALL GINTER2_N(3,0,X,SB,CPLUSNS)
 
8831
      CALL GINTER2_N(5,0,X,SB,UPLUSNS)
 
8832
      CALL GINTER2_N(6,0,X,SB,SPLUSNS)
 
8833
      QQ(3)=CPLUSNS
 
8834
      QQ(4)=DPLUSNS
 
8835
      QQ(5)=UPLUSNS
 
8836
      QQ(6)=SPLUSNS
 
8837
 8    QQ(1)=SING2
 
8838
      RETURN
 
8839
      END
 
8840
                                                                      
 
8841
      SUBROUTINE GINTER_N(I,NDRV,X,S,ANS)
 
8842
      DIMENSION F1(32),F2(32),F3(32)
 
8843
      COMMON/K719GFUNC/GF(8,20,32)
 
8844
      COMMON/K719ANEW/DELTA
 
8845
      DIMENSION AF(3),AS(3)
 
8846
      N=3
 
8847
      IS=S/DELTA+1
 
8848
      IS1=IS+1
 
8849
      IS2=IS1+1
 
8850
      DO 1 L=1,32
 
8851
      KL=L+32*NDRV
 
8852
      F1(L)=GF(I,IS,KL)
 
8853
      F2(L)=GF(I,IS1,KL)
 
8854
      F3(L)=GF(I,IS2,KL)
 
8855
    1 CONTINUE
 
8856
      AF(1)=GETFV_N(X,F1)
 
8857
      AF(2)=GETFV_N(X,F2)
 
8858
      AF(3)=GETFV_N(X,F3)
 
8859
      AS(1)=(IS-1)*DELTA
 
8860
      AS(2)=AS(1)+DELTA
 
8861
      AS(3)=AS(2)+DELTA
 
8862
      CALL POLINT_N(AS,AF,N,S,AANS,DY)
 
8863
      ANS=AANS
 
8864
      RETURN
 
8865
      END
 
8866
 
 
8867
      SUBROUTINE GINTER2_N(I,NDRV,X,S,ANS)
 
8868
      DIMENSION F1(32),F2(32),F3(32)
 
8869
      COMMON/K719GVDM/GFV(8,20,32)
 
8870
      COMMON/K719ANEW/DELTA
 
8871
      DIMENSION AF(3),AS(3)
 
8872
      N=3
 
8873
      IS=S/DELTA+1
 
8874
      IS1=IS+1
 
8875
      IS2=IS1+1
 
8876
      DO 1 L=1,32
 
8877
      KL=L+32*NDRV
 
8878
      F1(L)=GFV(I,IS,KL)
 
8879
      F2(L)=GFV(I,IS1,KL)
 
8880
      F3(L)=GFV(I,IS2,KL)
 
8881
    1 CONTINUE
 
8882
      AF(1)=GETFV_N(X,F1)
 
8883
      AF(2)=GETFV_N(X,F2)
 
8884
      AF(3)=GETFV_N(X,F3)
 
8885
      AS(1)=(IS-1)*DELTA
 
8886
      AS(2)=AS(1)+DELTA
 
8887
      AS(3)=AS(2)+DELTA
 
8888
      CALL POLINT_N(AS,AF,N,S,AANS,DY)
 
8889
      ANS=AANS
 
8890
      RETURN
 
8891
      END
 
8892
 
 
8893
      SUBROUTINE WATE32_N
 
8894
C  32 POINT GAUSSIAN QUADRATURE ROUTINE
 
8895
      DIMENSION X(16),W(16)
 
8896
      COMMON/K719GAUS32/XI(32),WI(32),NTERMS,XX(33)
 
8897
      NTERMS=32
 
8898
      X(1)=0.048307665687738316235
 
8899
      X(2)=0.144471961582796493485
 
8900
      X(3)=0.239287362252137074545
 
8901
      X(4)=0.331868602282127649780
 
8902
      X(5)=0.421351276130635345364
 
8903
      X(6)=0.506899908932229390024
 
8904
      X(7)=0.587715757240762329041
 
8905
      X(8)=0.663044266930215200975
 
8906
      X(9)=0.732182118740289680387
 
8907
      X(10)=0.794483795967942406963
 
8908
      X(11)=0.849367613732569970134
 
8909
      X(12)=0.896321155766052123965
 
8910
      X(13)=0.934906075937739689171
 
8911
      X(14)=0.964762255587506430774
 
8912
      X(15)=0.985611511545268335400
 
8913
      X(16)=0.997263861849481563545
 
8914
      W(1)=0.096540088514727800567
 
8915
      W(2)=0.095638720079274859419
 
8916
      W(3)=0.093844399080804565639
 
8917
      W(4)=0.091173878695763884713
 
8918
      W(5)=0.087652093004403811143
 
8919
      W(6)=0.083311924226946755222
 
8920
      W(7)=0.078193895787070306472
 
8921
      W(8)=0.072345794108848506225
 
8922
      W(9)=0.065822222776361846838
 
8923
      W(10)=0.058684093478535547145
 
8924
      W(11)=0.050998059262376176196
 
8925
      W(12)=0.042835898022226680657
 
8926
      W(13)=0.034273862913021433103
 
8927
      W(14)=0.025392065309262059456
 
8928
      W(15)=0.016274394730905670605
 
8929
      W(16)=0.007018610009470096600
 
8930
      DO 1 I=1,16
 
8931
      XI(I)=-X(17-I)
 
8932
      WI(I)=W(17-I)
 
8933
      XI(I+16)=X(I)
 
8934
      WI(I+16)=W(I)
 
8935
    1 CONTINUE
 
8936
      DO 2 I=1,32
 
8937
    2 XX(I)=0.5*(XI(I)+1.)
 
8938
      XX(33)=1.0
 
8939
      RETURN
 
8940
      END
 
8941
       FUNCTION GETFV_N(X,FVL)
 
8942
C  NOUVEAU PROGRAMME D'INTERPOLATION UTILISANT UNE ROUTINE DE MATH. RECIPES
 
8943
       DIMENSION FVL(32)
 
8944
       COMMON/K719GAUS32/XI(32),WI(32),NTERMS,XX(33)
 
8945
       DIMENSION A(4),B(4)
 
8946
       N=4
 
8947
       EPS=1.E-7
 
8948
       XAM=XX(1)-EPS
 
8949
       XAP=XX(1)+EPS
 
8950
C       IF(X.LT.XAM) PRINT*,' X = ',X
 
8951
       IF(X.GT.XAM.AND.X.LT.XAP) GO TO 50
 
8952
       GO TO 80
 
8953
   50  Y=FVL(1)
 
8954
       GO TO 77
 
8955
   80  IF(X.LT.XX(2)) GO TO 51
 
8956
       IF(X.GT.XX(30)) GO TO 61
 
8957
       DO 1 I=3,30
 
8958
       IF(X.GT.XX(I)) GO TO 1
 
8959
       A(1)=XX(I-2)
 
8960
       A(2)=XX(I-1)
 
8961
       A(3)=XX(I)
 
8962
       A(4)=XX(I+1)
 
8963
       B(1)=FVL(I-2)
 
8964
       B(2)=FVL(I-1)
 
8965
       B(3)=FVL(I)
 
8966
       B(4)=FVL(I+1)
 
8967
       GO TO 70
 
8968
   1   CONTINUE
 
8969
  61   A(1)=XX(29)
 
8970
       A(2)=XX(30)
 
8971
       A(3)=XX(31)
 
8972
       A(4)=XX(32)
 
8973
       B(1)=FVL(29)
 
8974
       B(2)=FVL(30)
 
8975
       B(3)=FVL(31)
 
8976
       B(4)=FVL(32)
 
8977
       GO  TO 70
 
8978
  51   A(1)=XX(1)
 
8979
       A(2)=XX(2)
 
8980
       A(3)=XX(3)
 
8981
       A(4)=XX(4)
 
8982
       B(1)=FVL(1)
 
8983
       B(2)=FVL(2)
 
8984
       B(3)=FVL(3)
 
8985
       B(4)=FVL(4)
 
8986
  70   CONTINUE
 
8987
C 70   IF(X.GT..2.AND.X.LT..8) THEN
 
8988
             CALL POLINT_N(A,B,N,X,Y,DY)
 
8989
C      ELSE
 
8990
C            CALL RATINT_N(A,B,N,X,Y,DY)
 
8991
C      ENDIF
 
8992
  77   GETFV_N=Y
 
8993
       RETURN
 
8994
       END
 
8995
 
 
8996
      SUBROUTINE POLINT_N(XA,YA,N,X,Y,DY)
 
8997
      PARAMETER (NMAX=10)
 
8998
      DIMENSION XA(N),YA(N),C(NMAX),D(NMAX)
 
8999
      NS=1 
 
9000
      DIF=ABS(X-XA(1))
 
9001
      DO 11 I=1,N
 
9002
        DIFT=ABS(X-XA(I))
 
9003
        IF (DIFT.LT.DIF) THEN
 
9004
          NS=I
 
9005
          DIF=DIFT
 
9006
        ENDIF
 
9007
        C(I)=YA(I)
 
9008
        D(I)=YA(I)
 
9009
11    CONTINUE
 
9010
      Y=YA(NS)
 
9011
      NS=NS-1
 
9012
      DO 13 M=1,N-1
 
9013
        DO 12 I=1,N-M
 
9014
          HO=XA(I)-X
 
9015
          HP=XA(I+M)-X
 
9016
          W=C(I+1)-D(I)
 
9017
          DEN=HO-HP
 
9018
          IF(DEN.EQ.0.)PAUSE
 
9019
          DEN=W/DEN
 
9020
          D(I)=HP*DEN
 
9021
          C(I)=HO*DEN
 
9022
12      CONTINUE     
 
9023
        IF (2*NS.LT.N-M)THEN
 
9024
          DY=C(NS+1)
 
9025
        ELSE
 
9026
          DY=D(NS)
 
9027
          NS=NS-1
 
9028
        ENDIF
 
9029
        Y=Y+DY
 
9030
13    CONTINUE
 
9031
      RETURN
 
9032
      END
 
9033
c increase the precision of log calls
 
9034
      function xlog(x)
 
9035
      implicit none
 
9036
      real xlog,x
 
9037
      real * 8 xx
 
9038
      xx=x
 
9039
      xlog=log(xx)
 
9040
      end
 
9041
C END FONTANNAZ 1994
 
9042
C
 
9043
C GLUECK REYA VOGT PHOTON
 
9044
      SUBROUTINE GRV_PH(Q2,X,FX,NF)
 
9045
      REAL FX(-NF:NF)
 
9046
      REAL * 8 DX,DQ,UPQ,DOQ,STR,CHR,BOT,GLU,DUM
 
9047
      REAL*8 XMIN,XMAX,QSQMIN,QSQMAX,QSQ
 
9048
      REAL*8 IXMIN,IXMAX,IQSQMIN,IQSQMAX
 
9049
      DATA XMIN,XMAX,QSQMIN,QSQMAX/1.D-5,1.D0,0.3D0,1.D6/
 
9050
      DATA INI/0/
 
9051
      IF(INI.GT.0) GO TO 1
 
9052
      ilxmin=0
 
9053
      ilxmax=0
 
9054
      ilqsqmin=0
 
9055
      ilqsqmax=0
 
9056
      INI=1
 
9057
1     CONTINUE
 
9058
      DX=DBLE(X)
 
9059
      DQ=DBLE(SQRT(Q2))
 
9060
      if(Dx.lt.xmin) then
 
9061
        ixmin=ixmin+1.
 
9062
        if(log10(ixmin).gt.ilxmin) then
 
9063
          write(*,*)' x < xmin in str. functions more than 10**',
 
9064
     +  ilxmin,' times'                          
 
9065
          ilxmin=ilxmin+1
 
9066
        endif
 
9067
      endif
 
9068
      if(Dx.gt.xmax) then
 
9069
        ixmax=ixmax+1.
 
9070
        if(log10(ixmax).gt.ilxmax) then
 
9071
          write(*,*)' x > xmax in str. functions more than 10**',
 
9072
     +  ilxmax,' times'
 
9073
          ilxmax=ilxmax+1
 
9074
        endif
 
9075
      endif
 
9076
      qsq=DQ**2
 
9077
      if(qsq.lt.qsqmin) then
 
9078
        iqsqmin=iqsqmin+1.
 
9079
        if(log10(iqsqmin).gt.ilqsqmin) then
 
9080
          write(*,*)'q**2 < min q**2 in str. functions more than 10**',
 
9081
     +  ilqsqmin,' times'
 
9082
          ilqsqmin=ilqsqmin+1
 
9083
        endif
 
9084
      endif
 
9085
      if(qsq.gt.qsqmax) then
 
9086
        iqsqmax=iqsqmax+1.
 
9087
        if(log10(iqsqmax).gt.ilqsqmax) then
 
9088
          write(*,*)'q**2 > max q**2 in str. functions more than 10**',
 
9089
     +  ilqsqmax,' times'
 
9090
          ilqsqmax=ilqsqmax+1
 
9091
        endif
 
9092
      endif
 
9093
      CALL GRVGAHO (DX,DQ,UPQ,DOQ,DUM,DUM,STR,CHR,BOT,GLU)
 
9094
      FX(0)=SNGL(GLU)
 
9095
      FX(1)=SNGL(UPQ)
 
9096
      FX(2)=SNGL(DOQ)
 
9097
      IF(NF.GE.3) FX(3)=SNGL(STR)
 
9098
      IF(NF.GE.4) FX(4)=SNGL(CHR)
 
9099
      IF(NF.GE.5) FX(5)=SNGL(BOT)
 
9100
      IF(NF.eq.6) FX(6)=0
 
9101
      DO I=1,NF
 
9102
        FX(-I)=FX(I)
 
9103
      ENDDO
 
9104
      DO I=-NF,NF
 
9105
       FX(I)=FX(I)/X
 
9106
      ENDDO
 
9107
      RETURN
 
9108
      END
 
9109
 
 
9110
 
 
9111
       SUBROUTINE GRVGAHO (ZX,ZQ,ZUV,ZDV,ZUB,ZDB,ZSB,ZCB,ZBB,ZGL)
 
9112
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 
9113
*                                                                 *
 
9114
*      G R V - P H O T O N - P A R A M E T R I Z A T I O N S      *
 
9115
*                                                                 *
 
9116
*                 FOR A DETAILED EXPLANATION SEE :                *
 
9117
*              M. GLUECK, E.REYA, A.VOGT: DO-TH 91/31             *
 
9118
*                                                                 *
 
9119
*    THE OUTPUT IS ALWAYS   1./ ALPHA(EM) * X * PARTON DENSITY    *
 
9120
*    output modified by HPB to be always    X * PARTON DENSITY    *
 
9121
*                                                                 *
 
9122
*   THE PARAMETRIZATIONS ARE FITTED TO THE PARTON DISTRIBUTIONS   *
 
9123
*   FOR Q ** 2 BETWEEN MU ** 2 (=  0.25 / 0.30  GEV ** 2  IN LO   *
 
9124
*   / HO) AND  1.E6 GEV ** 2  AND FOR X BETWEEN  1.E-5  AND  1.   *
 
9125
*                                                                 *
 
9126
*              HEAVY QUARK THRESHOLDS  Q(H) = M(H) :              *
 
9127
*         M(C)  =  1.5,  M(B)  =  4.5,  M(T)  =  100  GEV         *
 
9128
*                                                                 *
 
9129
*      CORRESPONDING LAMBDA(F) VALUES FOR F ACTIVE FLAVOURS :     *
 
9130
*      LO :   LAMBDA(3)  =  0.232,   LAMBDA(4)  =  0.200,         *
 
9131
*             LAMBDA(5)  =  0.153,   LAMBDA(6)  =  0.082  GEV     *
 
9132
*      HO :   LAMBDA(3)  =  0.248,   LAMBDA(4)  =  0.200,         *
 
9133
*             LAMBDA(5)  =  0.131,   LAMBDA(6)  =  0.053  GEV     *
 
9134
*                                                                 *
 
9135
*      HO DISTRIBUTIONS REFER TO THE DIS(GAMMA) SCHEME, SEE :     *
 
9136
*              M. GLUECK, E.REYA, A.VOGT: DO-TH 91/26             *
 
9137
*                                                                 *
 
9138
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 
9139
C
 
9140
       IMPLICIT REAL (A - Y)
 
9141
      DOUBLE PRECISION
 
9142
     +        ZX,ZQ,ZUV,ZDV,ZUB,ZDB,ZSB,ZCB,ZBB,ZGL
 
9143
       DATA ALPHEM/7.29927D-3/
 
9144
       REAL  X, Q
 
9145
       X = ZX
 
9146
       Q = ZQ
 
9147
       MU2  = 0.3
 
9148
       LAM2 = 0.248 * 0.248
 
9149
       Q2 = Q*Q
 
9150
       S  = ALOG (ALOG(Q2/LAM2) / ALOG(MU2/LAM2))
 
9151
       SS = SQRT (S)
 
9152
       S2 = S * S
 
9153
C...X * U = X * UBAR :
 
9154
       AL =  0.583
 
9155
       BE =  0.688
 
9156
       AK =  0.449 - 0.025 * S  - 0.071 * S2
 
9157
       BK =  5.060 - 1.116 * SS
 
9158
       AG =  0.103
 
9159
       BG =  0.319 + 0.422 * S
 
9160
       C  =  1.508 + 4.792 * S  - 1.963 * S2
 
9161
       D  =  1.075 + 0.222 * SS - 0.193 * S2
 
9162
       E  =  4.147 + 1.131 * S
 
9163
       ES =  1.661 + 0.874 * S
 
9164
       UH =  GRVGF (X, S, AL, BE, AK, BK, AG, BG, C, D, E, ES)
 
9165
       ZUV = UH * ALPHEM
 
9166
       ZUB = ZUV
 
9167
C...X * D = X * DBAR :
 
9168
       AL =  0.591
 
9169
       BE =  0.698
 
9170
       AK =  0.442 - 0.132 * S  - 0.058 * S2
 
9171
       BK =  5.437 - 1.916 * SS
 
9172
       AG =  0.099
 
9173
       BG =  0.311 - 0.059 * S
 
9174
       C  =  0.800 + 0.078 * S  - 0.100 * S2
 
9175
       D  =  0.862 + 0.294 * SS - 0.184 * S2
 
9176
       E  =  4.202 + 1.352 * S
 
9177
       ES =  1.841 + 0.990 * S
 
9178
       DH  =  GRVGF (X, S, AL, BE, AK, BK, AG, BG, C, D, E, ES)
 
9179
       ZDV = DH * ALPHEM
 
9180
       ZDB = ZDV
 
9181
C...X * G :
 
9182
       AL =  1.161
 
9183
       BE =  1.591
 
9184
       AK =  0.530 - 0.742 * SS + 0.025 * S2
 
9185
       BK =  5.662
 
9186
       AG =  0.533 - 0.281 * SS + 0.218 * S2
 
9187
       BG =  0.025 - 0.518 * S  + 0.156 * S2
 
9188
       C  = -0.282              + 0.209 * S2
 
9189
       D  =  0.107 + 1.058 * S  - 0.218 * S2
 
9190
       E  =   0.0  + 2.704 * S
 
9191
       ES =  3.071 - 0.378 * S
 
9192
       GH =  GRVGF (X, S, AL, BE, AK, BK, AG, BG, C, D, E, ES)
 
9193
       ZGL = GH * ALPHEM
 
9194
C...X * S = X * SBAR :
 
9195
       SF =   0.0
 
9196
       AL =  0.635
 
9197
       BE =  0.456
 
9198
       AK =  1.770 - 0.735 * SS - 0.079 * S2
 
9199
       BK =  3.832
 
9200
       AG =  0.084 - 0.023 * S
 
9201
       BG =  0.136
 
9202
       C  =  2.119 - 0.942 * S  + 0.063 * S2
 
9203
       D  =  1.271 + 0.076 * S  - 0.190 * S2
 
9204
       E  =  4.604 + 0.737 * S
 
9205
       ES =  1.641 + 0.976 * S
 
9206
       SH =  GRVGFS (X, S, SF, AL, BE, AK, BK, AG, BG, C, D, E, ES)
 
9207
       ZSB = SH * ALPHEM
 
9208
C...X * C = X * CBAR :
 
9209
       SF =  0.820
 
9210
       AL =  0.926
 
9211
       BE =  0.152
 
9212
       AK =  1.142 - 0.175 * S
 
9213
       BK =  3.276
 
9214
       AG =  0.504 + 0.317 * S
 
9215
       BG = -0.433
 
9216
       C  =  3.334
 
9217
       D  =  0.398 + 0.326 * S  - 0.107 * S2
 
9218
       E  =  5.493 + 0.408 * S
 
9219
       ES =  2.426 + 1.277 * S
 
9220
       CH =  GRVGFS (X, S, SF, AL, BE, AK, BK, AG, BG, C, D, E, ES)
 
9221
       ZCB = CH * ALPHEM
 
9222
C...X * B = X * BBAR :
 
9223
       SF =  1.297
 
9224
       AL =  0.969
 
9225
       BE =  0.266
 
9226
       AK =  1.953 - 0.391 * S
 
9227
       BK =  1.657 - 0.161 * S
 
9228
       AG =  1.076 + 0.034 * S
 
9229
       BG = -2.015
 
9230
       C  =  1.662
 
9231
       D  =  0.353 + 0.016 * S
 
9232
       E  =  5.713 + 0.249 * S
 
9233
       ES =  3.456 + 0.673 * S
 
9234
       BH =  GRVGFS (X, S, SF, AL, BE, AK, BK, AG, BG, C, D, E, ES)
 
9235
       ZBB = BH * ALPHEM
 
9236
c
 
9237
       RETURN
 
9238
       END
 
9239
 
 
9240
 
 
9241
       FUNCTION GRVGF (X, S, AL, BE, AK, BK, AG, BG, C, D, E, ES)
 
9242
       IMPLICIT REAL (A - Z)
 
9243
       SX = SQRT (X)
 
9244
       LX = ALOG (1./X)
 
9245
       GRVGF  = (X**AK * (AG + BG * SX + C * X**BK)  +  S**AL
 
9246
     1       * EXP (-E + SQRT (ES * S**BE * LX))) * (1.- X)**D
 
9247
       RETURN
 
9248
       END
 
9249
 
 
9250
 
 
9251
       FUNCTION GRVGFS (X, S, SF, AL, BE, AK, BK, AG, BG, C, D, E, ES)
 
9252
       IMPLICIT REAL (A - Z)
 
9253
       IF (S .LE. SF) THEN
 
9254
          GRVGFS = 0.0
 
9255
       ELSE
 
9256
          SX = SQRT (X)
 
9257
          LX = ALOG (1./X)
 
9258
          DS = S - SF
 
9259
          GRVGFS = (DS * X**AK * (AG + BG * SX + C * X**BK) + DS**AL
 
9260
     1         * EXP (-E + SQRT (ES * S**BE * LX))) * (1.- X)**D
 
9261
       END IF
 
9262
       RETURN
 
9263
       END
 
9264
C END GLUECK REYA VOGT PHOTON
 
9265
C
 
9266
C GLUECK REYA SCHIENBEIN PHOTON
 
9267
      SUBROUTINE GRS_PH(Q2,X,FX,NF)
 
9268
      REAL FX(-NF:NF)
 
9269
      REAL * 8 DX,DQ2,UPH,DPH,SPH,GPH
 
9270
      REAL*8 XMIN,XMAX,QSQMIN,QSQMAX,QSQ
 
9271
      REAL*8 IXMIN,IXMAX,IQSQMIN,IQSQMAX
 
9272
      DATA XMIN,XMAX,QSQMIN,QSQMAX/1.D-5,0.95D0,0.5D0,1.D5/
 
9273
      DATA INI/0/
 
9274
      PARAMETER (ALPHAEM=1/137.D0)
 
9275
      IF(INI.GT.0) GO TO 1
 
9276
      ilxmin=0
 
9277
      ilxmax=0
 
9278
      ilqsqmin=0
 
9279
      ilqsqmax=0
 
9280
      INI=1
 
9281
1     CONTINUE
 
9282
      DX=DBLE(X)
 
9283
      DQ2=DBLE(Q2)
 
9284
      if(Dx.lt.xmin) then
 
9285
        ixmin=ixmin+1.
 
9286
        if(log10(ixmin).gt.ilxmin) then
 
9287
          write(*,*)' x < xmin in str. functions more than 10**',
 
9288
     +  ilxmin,' times'                          
 
9289
          ilxmin=ilxmin+1
 
9290
        endif
 
9291
      endif
 
9292
      if(Dx.gt.xmax) then
 
9293
        ixmax=ixmax+1.
 
9294
        if(log10(ixmax).gt.ilxmax) then
 
9295
          write(*,*)' x > xmax in str. functions more than 10**',
 
9296
     +  ilxmax,' times'
 
9297
          ilxmax=ilxmax+1
 
9298
        endif
 
9299
      endif
 
9300
      qsq=DQ2
 
9301
      if(qsq.lt.qsqmin) then
 
9302
        iqsqmin=iqsqmin+1.
 
9303
        if(log10(iqsqmin).gt.ilqsqmin) then
 
9304
          write(*,*)'q**2 < min q**2 in str. functions more than 10**',
 
9305
     +  ilqsqmin,' times'
 
9306
          ilqsqmin=ilqsqmin+1
 
9307
        endif
 
9308
      endif
 
9309
      if(qsq.gt.qsqmax) then
 
9310
        iqsqmax=iqsqmax+1.
 
9311
        if(log10(iqsqmax).gt.ilqsqmax) then
 
9312
          write(*,*)'q**2 > max q**2 in str. functions more than 10**',
 
9313
     +  ilqsqmax,' times'
 
9314
          ilqsqmax=ilqsqmax+1
 
9315
        endif
 
9316
      endif
 
9317
      CALL GRSGHO (DX,DQ2,UPH,DPH,SPH,GPH)
 
9318
      FX(0)=SNGL(GPH)
 
9319
      FX(1)=SNGL(UPH)
 
9320
      FX(2)=SNGL(DPH)
 
9321
      IF(NF.GE.3) FX(3)=SNGL(SPH)
 
9322
      IF(NF.GE.4) FX(4)=0
 
9323
      IF(NF.GE.5) FX(5)=0
 
9324
      IF(NF.eq.6) FX(6)=0
 
9325
      DO I=1,NF
 
9326
        FX(-I)=FX(I)
 
9327
      ENDDO
 
9328
      DO I=-NF,NF
 
9329
       FX(I)=ALPHAEM*FX(I)/X
 
9330
      ENDDO
 
9331
      RETURN
 
9332
      END
 
9333
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 
9334
*                                                                   *
 
9335
*     G R S  -  P H O T O N  - P A R A M E T R I Z A T I O N S      *
 
9336
*                                                                   *
 
9337
*                                1999                               *
 
9338
*                                                                   *
 
9339
*                  For a detailed explanation see                   *
 
9340
*                M. Glueck, E. Reya, I. Schienbein :                *
 
9341
*                   hep-ph/9903337  =  DO-TH 99/03                  *
 
9342
*                  (To appear in Phys. Rev. D)                      *
 
9343
*                                                                   *
 
9344
*   The parametrizations are fitted to the parton distributions     *
 
9345
*                               for                                 *
 
9346
*                0.5 GeV**2 =< Q**2 =< 1.E-5 GeV**2                 *
 
9347
*                               and                                 * 
 
9348
*                          1.E-5 =< x =< 0.95                       *                  
 
9349
*   Regions, where the distribution under consideration is neg-     *
 
9350
*   ligible, were excluded from the fit.                            *
 
9351
*                                                                   *
 
9352
*    Leading Order PDF's of the Real(P2=0) and Virtual Photon:      *
 
9353
*    call GRSGLO (X, Q2, P2, UPH, DPH, SPH, GPH)                    *
 
9354
*                                                                   *
 
9355
*    Next-To-Leading Order PDF's of the Real(P2=0) Photon:          *
 
9356
*    call GRSGHO (X, Q2, UPH, DPH, SPH, GPH)                        *
 
9357
*                                                                   *
 
9358
*   INPUT:   X  = Bjorken-x       (between  1.E-5 and 1   )         *
 
9359
*            Q2 = Scale in GeV**2 (between  0.5   and 1.E5)         *
 
9360
*            and  in Leading Order:                                 *
 
9361
*            P2 = Virtuality of the Photon (typically, P2 =< Q2/10) *
 
9362
*            P2 = 0 : Real Photon                                   *
 
9363
*                                                                   *
 
9364
*   OUTPUT:                                                         *
 
9365
*            Leading Order:                                         *
 
9366
*            UPH = x u(gamma(P2))(x,Q2)/ALPHA(em) etc               *
 
9367
*            Next-To-Leading Order (DIS_gamma Scheme):              *
 
9368
*            UPH = x u(gamma)(x,Q2)/ALPHA(em) etc                   *
 
9369
*                                                                   *
 
9370
*            !Always x times the distribution is returned!          *
 
9371
*                (divided by ALPHA(em) approx. = 1/137)             *
 
9372
*                                                                   *
 
9373
*   ALPHAS:                                                         *
 
9374
*   At Q^2 = MZ^2, alpha_s reads  0.114 (0.125) in NLO (LO); the    *
 
9375
*   heavy quark thresholds, Qh^2 = mh^2, in the beta function are   *
 
9376
*                   mc = 1.4 GeV,  mb = 4.5 GeV.                    *
 
9377
*   Note that the NLO alpha_s running is different from GRV(94).    * 
 
9378
*                                                                   *
 
9379
*   Questions, comments etc to: schien@hal1.physik.uni-dortmund.de  *
 
9380
*   19.03.1999                                                      *
 
9381
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 
9382
C
 
9383
C Leading Order Real and Virtual Photon (Point-Like + Hadronic)
 
9384
C
 
9385
C x f(gamma(P2)) / alpha = x f(gamma(P2))_PL / alpha 
 
9386
C                        + eta G_f^2 x f(Pi^0) + r_f 
 
9387
C                        = x f(gamma(P2))_PL / alpha 
 
9388
C                        + x f(gamma(P2))_HAD / alpha 
 
9389
       SUBROUTINE GRSGLO (X, Q2, P2, UPH, DPH, SPH, GPH)
 
9390
       IMPLICIT DOUBLE PRECISION (A - Z)
 
9391
c couplings and eta factor
 
9392
       Gu2 = 0.836
 
9393
       Gd2 = 0.250
 
9394
       Gs2 = 0.543
 
9395
       Gg2 = 0.543
 
9396
       eta = 1/(1.+ P2/0.59)**2
 
9397
c hadronic part:
 
9398
       call GRSPILO (X, Q2, VAP, GLP, QBP, SBP)
 
9399
C X U(Pi^0) = X UBAR(Pi^0) = (VAP + 2 QBP)/2 
 
9400
C X D(Pi^0) = X DBAR(Pi^0) = (VAP + 2 QBP)/2 
 
9401
C X S = X SBAR = SBP
 
9402
C X G = GLP
 
9403
       r = eta * (Gu2-Gd2)/2. * SBP
 
9404
       UHAD = eta * Gu2 * (VAP + 2. * QBP)/2. - r  
 
9405
       DHAD = eta * Gd2 * (VAP + 2. * QBP)/2. + r
 
9406
       SHAD = eta * Gs2 * SBP 
 
9407
       GHAD = eta * Gg2 * GLP
 
9408
c point-like part:
 
9409
       call GRSGLOPL (X, Q2, P2, UPL, DPL, SPL, GPL)
 
9410
c PL + HAD:
 
9411
       UPH = UPL + UHAD
 
9412
       DPH = DPL + DHAD
 
9413
       SPH = SPL + SHAD
 
9414
       GPH = GPL + GHAD
 
9415
       end
 
9416
C
 
9417
C Next-To-Leading Order Real(P2=0) Photon (Point-Like + Hadronic)
 
9418
C x f(gamma) / alpha = x f(gamma)_PL / alpha + G_f^2 x f(Pi^0) + r_f
 
9419
C                        = x f(gamma)_PL / alpha + x f(gamma)_HAD / alpha 
 
9420
       SUBROUTINE GRSGHO (X, Q2, UPH, DPH, SPH, GPH)
 
9421
       IMPLICIT DOUBLE PRECISION (A - Z)
 
9422
c couplings 
 
9423
       Gu2 = 0.836
 
9424
       Gd2 = 0.250
 
9425
       Gs2 = 0.543
 
9426
       Gg2 = 0.543
 
9427
c hadronic part:
 
9428
       call GRSPIHO (X, Q2, VAP, GLP, QBP, SBP)
 
9429
       r = (Gu2-Gd2)/2. * SBP
 
9430
       UHAD = Gu2 * (VAP + 2. * QBP)/2. - r  
 
9431
       DHAD = Gd2 * (VAP + 2. * QBP)/2. + r
 
9432
       SHAD = Gs2 * SBP 
 
9433
       GHAD = Gg2 * GLP
 
9434
c point-like part:
 
9435
       call GRSGHOPL (X, Q2, UPL, DPL, SPL, GPL)
 
9436
c PL + HAD:
 
9437
       UPH = UPL + UHAD
 
9438
       DPH = DPL + DHAD
 
9439
       SPH = SPL + SHAD
 
9440
       GPH = GPL + GHAD
 
9441
       end
 
9442
 
 
9443
C Leading Order, Point-Like
 
9444
       SUBROUTINE GRSGLOPL (X, Q2, P2, UL, DL, SL, GL)
 
9445
       IMPLICIT DOUBLE PRECISION (A - Z)
 
9446
       pi = dacos(-1.d0)
 
9447
       MU2  = 0.26
 
9448
       LAM2 = 0.204*0.204
 
9449
       if (P2 .lt. MU2) then
 
9450
           S = DLOG(DLOG(Q2/LAM2)/DLOG(MU2/LAM2))
 
9451
       else
 
9452
           S = DLOG(DLOG(Q2/LAM2)/DLOG(P2/LAM2))
 
9453
       end if    
 
9454
       alpq3= 4.*pi/(9.*DLOG(Q2/LAM2))
 
9455
       DS = SQRT (S)
 
9456
       S2 = S * S
 
9457
C...X * U = X * UBAR :
 
9458
            AL =  2.626 
 
9459
            BE =  0.413 
 
9460
            AK =  2.137 - 0.310 * DS
 
9461
            BK = -1.049 + 0.113 * S
 
9462
            AG = -0.785 + 0.270 * DS 
 
9463
            BG =  0.650 - 0.146 * S
 
9464
            C  =  0.252 - 0.065 * DS 
 
9465
            D  = -0.116 + 0.403 * S - 0.117 * S2
 
9466
            E  =  6.749 + 2.452 * S - 0.226 * S2
 
9467
            ES =          1.994 * S - 0.216 * S2
 
9468
            GA =  0.897
 
9469
            UL =  F (X, S, AL, BE, AK, BK, AG, BG, C, D, E, ES, GA)
 
9470
            UL =  UL/alpq3
 
9471
C...X * D = X * DBAR :
 
9472
            AL =  2.811
 
9473
            BE =  0.960 
 
9474
            AK =  0.914 
 
9475
            BK =  3.723 - 0.968 * S
 
9476
            AG =  0.081 - 0.028 * DS 
 
9477
            BG = -0.048 
 
9478
            C  =  0.094 - 0.043 * DS  
 
9479
            D  =  0.059 + 0.263 * S - 0.085 * S2
 
9480
            E  =  6.808 + 2.239 * S - 0.108 * S2
 
9481
            ES =  1.225 + 0.594 * S - 0.073 * S2
 
9482
            GA =  1.084
 
9483
            DL =  F (X, S, AL, BE, AK, BK, AG, BG, C, D, E, ES, GA)
 
9484
            DL =  DL/alpq3
 
9485
C...X * G :
 
9486
            AL =  2.024
 
9487
            BE =  0.770 
 
9488
            AK =  0.081 
 
9489
            BK =  0.848 
 
9490
            AG =  0.012 + 0.039 * DS
 
9491
            BG = -0.056 - 0.044 * S
 
9492
            C  =  0.043 + 0.031 * S  
 
9493
            D  =  0.925 + 0.316 * S 
 
9494
            E  =  3.129 + 2.434 * S - 0.115 * S2
 
9495
            ES =  1.364 + 1.227 * S - 0.128 * S2
 
9496
            GA =  1.262
 
9497
            GL =  F (X, S, AL, BE, AK, BK, AG, BG, C, D, E, ES, GA)
 
9498
            GL =  GL/alpq3
 
9499
C...X * S = X * SBAR :
 
9500
           SL = DL     
 
9501
       end
 
9502
C
 
9503
C Next-to-leading Order, Point-Like
 
9504
C P2=0 !
 
9505
       SUBROUTINE GRSGHOPL (X, Q2, UH, DH, SH, GH)
 
9506
       IMPLICIT DOUBLE PRECISION (A - Z)
 
9507
       MU2  = 0.4
 
9508
       LAM2 = 0.299*0.299
 
9509
       S = DLOG(DLOG(Q2/LAM2)/DLOG(MU2/LAM2))
 
9510
       DS = SQRT (S)
 
9511
       S2 = S * S
 
9512
C...X * U = X * UBAR :
 
9513
            AL =  2.107 
 
9514
            BE =  0.970 
 
9515
            AK =  0.412 - 0.115 * DS
 
9516
            BK =  4.544 - 0.563 * S
 
9517
            AG =        - 0.028 * DS  + 0.019 * S2
 
9518
            BG =  0.263 + 0.137 * S
 
9519
            C  =  6.726 - 3.264 * DS  - 0.166 * S2
 
9520
            D  =  1.145               - 0.131 * S2
 
9521
            E  =  4.122 + 3.170 * S   - 0.598 * S2
 
9522
            ES =          1.615 * S   - 0.321 * S2
 
9523
            GA =  1.051
 
9524
            UH =  F (X, S, AL, BE, AK, BK, AG, BG, C, D, E, ES, GA)
 
9525
C...X * D = X * DBAR :
 
9526
            AL =  1.812 
 
9527
            BE =  0.457 
 
9528
            AK =  0.416 - 0.173 * DS
 
9529
            BK =  4.489 - 0.827 * S
 
9530
            AG =        - 0.010 * DS  + 0.006 * S2
 
9531
            BG =  0.064 + 0.020 * S
 
9532
            C  =  1.577 - 0.916 * DS  
 
9533
            D  =  1.122 - 0.093 * S   - 0.100 * S2
 
9534
            E  =  5.240 + 1.666 * S   - 0.234 * S2
 
9535
            ES =          1.284 * S 
 
9536
            GA =  1.043
 
9537
            DH =  F (X, S, AL, BE, AK, BK, AG, BG, C, D, E, ES, GA)
 
9538
C...X * G :
 
9539
            AL =  1.773 
 
9540
            BE =  1.666
 
9541
            AK =  0.844 - 0.820 * DS
 
9542
            BK =  2.302 - 0.474 * S
 
9543
            AG =  0.194
 
9544
            BG = -0.324 + 0.143 * S
 
9545
            C  =  0.330 - 0.177 * S 
 
9546
            D  =  0.778 + 0.502 * S - 0.154 * S2
 
9547
            E  =  2.895 + 1.823 * S - 0.441 * S2
 
9548
            ES =  2.344 - 0.584 * S
 
9549
            GA =  0.901
 
9550
            GH =  F (X, S, AL, BE, AK, BK, AG, BG, C, D, E, ES, GA)
 
9551
C...X * S = X * SBAR :
 
9552
            SH = DH     
 
9553
       end
 
9554
C
 
9555
C Point-Like Photon 
 
9556
C
 
9557
C... GA = alpha; AL = alpha'; BE = beta
 
9558
C... AK = a; AG = A
 
9559
C... BK = b; BG = B
 
9560
C... C = C; D = D; E = E; E' = ES 
 
9561
       FUNCTION F (X, S, AL, BE, AK, BK, AG, BG, C, D, E, ES, GA)
 
9562
       IMPLICIT DOUBLE PRECISION (A - Z)
 
9563
       SX = SQRT (X)
 
9564
       LX = DLOG (1./X)
 
9565
       F  = (S**GA * X**AK * (AG + BG * SX + C * X**BK)  +  S**AL
 
9566
     1       * EXP (-E + SQRT (ES * S**BE * LX))) * (1.- X)**D
 
9567
       RETURN
 
9568
       END
 
9569
 
 
9570
C The pion is a vdm-like input for the photon
 
9571
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 
9572
*                                                                   *
 
9573
*       G R S  -  P I O N  - P A R A M E T R I Z A T I O N S        *
 
9574
*                                                                   *
 
9575
*                                1999                               *
 
9576
*                                                                   *
 
9577
*                  For a detailed explanation see                   *
 
9578
*                M. Glueck, E. Reya, I. Schienbein :                *
 
9579
*                   hep-ph/9903288  =  DO-TH 99/01                  *
 
9580
*                  (To appear in ................)                  *
 
9581
*                                                                   *
 
9582
*   The parametrizations are fitted to the parton distributions     *
 
9583
*                               for                                 *
 
9584
*                0.5 GeV**2 =< Q**2 =< 1.E-5 GeV**2                 *
 
9585
*                               and                                 * 
 
9586
*                          1.E-5 =< x =< 1.                         *                  
 
9587
*   Regions, where the distribution under consideration is neg-     *
 
9588
*   ligible, were excluded from the fit.                            *
 
9589
*                                                                   *
 
9590
*                                                                   *
 
9591
*   INPUT:   X  = Bjorken-x       (between  1.E-5 and 1   )         *
 
9592
*            Q2 = Scale in GeV**2 (between  0.5   and 1.E5)         *
 
9593
*                                                                   *
 
9594
*   OUTPUT:  VAP = VALENCE : VAP = U_VAL(PI+) = DBAR_VAL(PI+) = ... *
 
9595
*                  N O T THE SUM, I.E., TOTAL VALENCE DENSITY       *
 
9596
*            QBP = SU(2) SYMMETRIC LIGHT SEA :                      *
 
9597
*                  QBP = UBAR(PI+) = D(PI+) = ...                   *
 
9598
*            SBP = STRANGE SEA : SBP = S = SBAR                     *
 
9599
*            GLP = GLUON                                            *
 
9600
*                                                                   *
 
9601
*            Always x times the distribution is returned            *
 
9602
*                                                                   *
 
9603
*   ALPHAS:                                                         *
 
9604
*   At Q^2 = MZ^2, alpha_s reads  0.114 (0.125) in NLO (LO); the    *
 
9605
*   heavy quark thresholds, Qh^2 = mh^2, in the beta function are   *
 
9606
*                   mc = 1.4 GeV,  mb = 4.5 GeV.                    *
 
9607
*   Note that the NLO alpha_s running is different from GRV(94).    * 
 
9608
*                                                                   *
 
9609
*   Questions, comments etc to: schien@hal1.physik.uni-dortmund.de  *
 
9610
*                                                                   *
 
9611
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 
9612
C
 
9613
C X U(Pi^0) = X UBAR(Pi^0) = (VAP + 2 QBP)/2 
 
9614
C X D(Pi^0) = X DBAR(Pi^0) = (VAP + 2 QBP)/2 
 
9615
C X S = X SBAR = SBP
 
9616
C X G = GLP
 
9617
C
 
9618
       SUBROUTINE GRSPILO (X, Q2, VAP, GLP, QBP, SBP)
 
9619
       IMPLICIT DOUBLE PRECISION (A - Z)
 
9620
       MU2  = 0.26
 
9621
       LAM2 = 0.204 * 0.204
 
9622
       S  = LOG (LOG(Q2/LAM2) / LOG(MU2/LAM2))
 
9623
       DS = SQRT (S)
 
9624
       S2 = S * S
 
9625
C...X * VALENCE :
 
9626
       NV  =  0.606 + 0.249 * S + 0.005 * S2
 
9627
       AKV =  0.517 - 0.020 * S
 
9628
       AGV =  -0.037 - 0.578 * S
 
9629
       BGV =  0.241 + 0.251 * S
 
9630
       DV  =  0.383 + 0.624 * S
 
9631
       VAP =  FVP (X, NV, AKV, AGV, BGV, DV)
 
9632
C...X * GLUON :
 
9633
       ALG =  0.504
 
9634
       BEG =  0.226
 
9635
       AKG =  2.251 - 1.339 * DS
 
9636
       BKG =  0.0
 
9637
       AGG =  2.668 - 1.265 * S  + 0.156 * S2
 
9638
       BGG =  -1.839 + 0.386 * S
 
9639
       CG  =  -1.014 + 0.920 * S  - 0.101 * S2
 
9640
       DG  =  -0.077 + 1.466 * S
 
9641
       EG  =  1.245 + 1.833 * S
 
9642
       ESG =  0.510 + 3.844 * S
 
9643
       GLP =  FGP (X, S, ALG, BEG, AKG, BKG, AGG, BGG, CG, DG, EG, ESG)
 
9644
C...X * QBAR (LIGHT SEA) :
 
9645
       ALS =  1.147
 
9646
       BES =  1.241
 
9647
       AKS =  0.309 - 0.134 * DS
 
9648
       BKS =  0.893 - 0.264 * DS
 
9649
       AGS =  0.219 - 0.054 * S  
 
9650
       BGS =  -0.593 + 0.240 * S
 
9651
       CS  =  1.100 - 0.452 * S  
 
9652
       DS  =  3.526 + 0.491 * S
 
9653
       ES  =  4.521 + 1.583 * S
 
9654
       ESS =  3.102
 
9655
       QBP =  FGP (X, S, ALS, BES, AKS, BKS, AGS, BGS, CS, DS, ES, ESS)
 
9656
C...X * SBAR = X * S :
 
9657
       ALSTR =   0.823
 
9658
       BESTR =   0.650
 
9659
       AKSTR =   1.036 - 0.709 * S
 
9660
       AGSTR =   -1.245 + 0.713 * S 
 
9661
       BGSTR =   5.580 - 1.281 * S
 
9662
       DSTR  =   2.746 - 0.191 * S
 
9663
       ESTR  =   5.101 + 1.294 * S
 
9664
       ESSTR =   4.854 - 0.437 * S
 
9665
       SBP   =   FSP (X, S, ALSTR, BESTR, AKSTR, AGSTR, BGSTR
 
9666
     #                     , DSTR, ESTR, ESSTR)
 
9667
       RETURN
 
9668
       END
 
9669
C
 
9670
C
 
9671
       SUBROUTINE GRSPIHO (X, Q2, VAP, GLP, QBP, SBP)
 
9672
       IMPLICIT double precision (A - Z)
 
9673
       MU2  = 0.4
 
9674
       LAM2 = 0.299 * 0.299
 
9675
       S  = LOG (LOG(Q2/LAM2) / LOG(MU2/LAM2))
 
9676
       DS = SQRT (S)
 
9677
       S2 = S * S
 
9678
C...X * VALENCE :
 
9679
       NV  =  0.750 + 0.263 * S - 0.025 * S2
 
9680
       AKV =  0.560 - 0.034 * S
 
9681
       AGV =  -0.357 - 0.458 * S
 
9682
       BGV =  0.427 + 0.220 * S
 
9683
       DV  =  0.475 + 0.550 * S
 
9684
       VAP =  FVP (X, NV, AKV, AGV, BGV, DV)
 
9685
C...X * GLUON :
 
9686
       ALG =  0.793
 
9687
       BEG =  1.722
 
9688
       AKG =  1.418 - 0.215 * DS
 
9689
       BKG =  0.0
 
9690
       AGG =  5.392 + 0.553 * S  - 0.385 * S2
 
9691
       BGG =  -11.928 + 1.844 * S
 
9692
       CG  =  11.548 - 4.316 * S  + 0.382 * S2
 
9693
       DG  =  1.347 + 1.135 * S
 
9694
       EG  =  0.104 + 1.980 * S
 
9695
       ESG =  2.375 - 0.188 * S
 
9696
       GLP =  FGP (X, S, ALG, BEG, AKG, BKG, AGG, BGG, CG, DG, EG, ESG)
 
9697
C...X * QBAR (LIGHT SEA) :
 
9698
       ALS =  1.118
 
9699
       BES =  0.457
 
9700
       AKS =  0.111 - 0.326 * DS
 
9701
       BKS =  -0.978 - 0.488 * DS
 
9702
       AGS =  1.035 - 0.295 * S  
 
9703
       BGS =  -3.008 + 1.165 * S
 
9704
       CS  =  4.111 - 1.575 * S  
 
9705
       DS  =  6.192 + 0.705 * S
 
9706
       ES  =  5.035 + 0.997 * S
 
9707
       ESS =  1.486 + 1.288 * S
 
9708
       QBP =  FGP (X, S, ALS, BES, AKS, BKS, AGS, BGS, CS, DS, ES, ESS)
 
9709
C...X * SBAR = X * S :
 
9710
       ALSTR =   0.908
 
9711
       BESTR =   0.812
 
9712
       AKSTR =   -0.567 - 0.466 * S
 
9713
       AGSTR =   -2.348 + 1.433 * S 
 
9714
       BGSTR =   4.403 
 
9715
       DSTR  =   2.061
 
9716
       ESTR  =   3.796 + 1.618 * S
 
9717
       ESSTR =   0.309 + 0.355 * S
 
9718
       SBP   =   FSP (X, S, ALSTR, BESTR, AKSTR, AGSTR, BGSTR
 
9719
     #                     , DSTR, ESTR, ESSTR)
 
9720
       RETURN
 
9721
       END
 
9722
C
 
9723
C PION 
 
9724
C
 
9725
c... AK = a; AG = A
 
9726
c... BK = b; BG = B
 
9727
c... AL = alpha; BE = beta
 
9728
c... E' = ES; N = N; C = C; D = D; E = E
 
9729
c valence
 
9730
       FUNCTION FVP (X, N, AK, AG, BG, D)
 
9731
       IMPLICIT double precision (A - Z)
 
9732
       DX = SQRT (X)
 
9733
       FVP = N * X**AK * (1.+ AG*DX + BG*X) * (1.- X)**D
 
9734
       RETURN
 
9735
       END
 
9736
C gluon and light sea
 
9737
       FUNCTION FGP (X, S, AL, BE, AK, BK, AG, BG, C, D, E, ES)
 
9738
       IMPLICIT double precision (A - Z)
 
9739
       DX = SQRT (X)
 
9740
       LX = LOG (1./X)
 
9741
       FGP = (X**AK * (AG + BG*DX + C*X) * LX**BK + S**AL
 
9742
     1       * EXP (-E + SQRT (ES * S**BE * LX))) * (1.- X)**D
 
9743
       RETURN
 
9744
       END
 
9745
C strange sea
 
9746
       FUNCTION FSP (X, S, AL, BE, AK, AG, BG, D, E, ES)
 
9747
       IMPLICIT double precision (A - Z)
 
9748
       DX = SQRT (X)
 
9749
       LX = LOG (1./X)
 
9750
       FSP = (1. + AG*DX + BG*X) / LX**AK * S**AL
 
9751
     1       * EXP (-E + SQRT (ES * S**BE * LX)) * (1.- X)**D
 
9752
       RETURN
 
9753
       END
 
9754
 
 
9755
*********************************************************************
 
9756
C END GLUECK REYA SCHIENBEIN PHOTON
 
9757
C
 
9758
C LAC1 PHOTON
 
9759
      SUBROUTINE XLAC(MODE,Q2,X,FX,NF)
 
9760
      REAL FX(-NF:NF)
 
9761
      REAL*8 XPDF(-6:6)
 
9762
      REAL*8 XMIN,XMAX,QSQMIN,QSQMAX,QSQ,DX,DQ
 
9763
      real*8 ixmin,ixmax,iqsqmin,iqsqmax
 
9764
      DATA XMIN,XMAX,QSQMIN,QSQMAX/1.D-4,1.D0,4.D0,1.D5/
 
9765
      DATA INI/0/
 
9766
      IF(INI.GT.0) GO TO 1
 
9767
      ilxmin=0
 
9768
      ilxmax=0
 
9769
      ilqsqmin=0
 
9770
      ilqsqmax=0
 
9771
      INI=1
 
9772
1     CONTINUE
 
9773
      Q=SQRT(Q2)
 
9774
      DQ=DBLE(Q)
 
9775
      DX=DBLE(X)
 
9776
      if(Dx.lt.xmin) then
 
9777
        ixmin=ixmin+1.
 
9778
        if(log10(ixmin).gt.ilxmin) then
 
9779
          write(*,*)' x < xmin in str. functions more than 10**',
 
9780
     +  ilxmin,' times'                          
 
9781
          ilxmin=ilxmin+1
 
9782
        endif
 
9783
      endif
 
9784
      if(Dx.gt.xmax) then
 
9785
        ixmax=ixmax+1.
 
9786
        if(log10(ixmax).gt.ilxmax) then
 
9787
          write(*,*)' x > xmax in str. functions more than 10**',
 
9788
     +  ilxmax,' times'
 
9789
          ilxmax=ilxmax+1
 
9790
        endif
 
9791
      endif
 
9792
      qsq=DQ**2
 
9793
      if(qsq.lt.qsqmin) then
 
9794
        iqsqmin=iqsqmin+1.
 
9795
        if(log10(iqsqmin).gt.ilqsqmin) then
 
9796
          write(*,*)'q**2 < min q**2 in str. functions more than 10**',
 
9797
     +  ilqsqmin,' times'
 
9798
          ilqsqmin=ilqsqmin+1
 
9799
        endif
 
9800
      endif
 
9801
      if(qsq.gt.qsqmax) then
 
9802
        iqsqmax=iqsqmax+1.
 
9803
        if(log10(iqsqmax).gt.ilqsqmax) then
 
9804
          write(*,*)'q**2 > max q**2 in str. functions more than 10**',
 
9805
     +  ilqsqmax,' times'
 
9806
          ilqsqmax=ilqsqmax+1
 
9807
        endif
 
9808
      endif
 
9809
      IF(MODE.EQ.1)THEN
 
9810
        CALL LAC1_PH(DX,QSQ,XPDF)
 
9811
      ELSE
 
9812
        WRITE(*,*)'Set is not implemented'
 
9813
        STOP
 
9814
      ENDIF
 
9815
      DO I=-NF,NF
 
9816
       FX(I)=SNGL(XPDF(I))/X
 
9817
      ENDDO
 
9818
      RETURN
 
9819
      END
 
9820
 
 
9821
 
 
9822
      SUBROUTINE LAC1_PH(X,Q2,XPDF)
 
9823
      IMPLICIT DOUBLE PRECISION(A-H,O-Z)
 
9824
      PARAMETER(IX=100,IQ=7,NARG=2,NFUN=4)
 
9825
      DOUBLE PRECISION
 
9826
     +       DBFINT,
 
9827
     +       XT(IX),Q2T(IQ),ARG(NARG),ENT(IX+IQ),
 
9828
     +       XPV(IX,IQ,0:NFUN),XPDF(-6:6),XA(6)
 
9829
      DIMENSION NA(NARG)
 
9830
      DATA ZEROD/0.D0/
 
9831
      DATA INIT/0/
 
9832
C...100 x valuse; in (D-4,.77) log spaced (78 points)
 
9833
C...              in (.78,.995) lineary spaced (22 points)
 
9834
      DATA Q2T/4.D0,10.D0,50.D0,1.D2,1.D3,1.D4,1.D5/
 
9835
      DATA XT/
 
9836
     &0.1000D-03,0.1123D-03,0.1262D-03,0.1417D-03,0.1592D-03,0.1789D-03,
 
9837
     &0.2009D-03,0.2257D-03,0.2535D-03,0.2848D-03,0.3199D-03,0.3593D-03,
 
9838
     &0.4037D-03,0.4534D-03,0.5093D-03,0.5722D-03,0.6427D-03,0.7220D-03,
 
9839
     &0.8110D-03,0.9110D-03,0.1023D-02,0.1150D-02,0.1291D-02,0.1451D-02,
 
9840
     &0.1629D-02,0.1830D-02,0.2056D-02,0.2310D-02,0.2594D-02,0.2914D-02,
 
9841
     &0.3274D-02,0.3677D-02,0.4131D-02,0.4640D-02,0.5212D-02,0.5855D-02,
 
9842
     &0.6577D-02,0.7388D-02,0.8299D-02,0.9323D-02,0.1047D-01,0.1176D-01,
 
9843
     &0.1321D-01,0.1484D-01,0.1667D-01,0.1873D-01,0.2104D-01,0.2363D-01,
 
9844
     &0.2655D-01,0.2982D-01,0.3350D-01,0.3763D-01,0.4227D-01,0.4748D-01,
 
9845
     &0.5334D-01,0.5992D-01,0.6731D-01,0.7560D-01,0.8493D-01,0.9540D-01,
 
9846
     &0.1072D+00,0.1204D+00,0.1352D+00,0.1519D+00,0.1706D+00,0.1917D+00,
 
9847
     &0.2153D+00,0.2419D+00,0.2717D+00,0.3052D+00,0.3428D+00,0.3851D+00,
 
9848
     &0.4326D+00,0.4859D+00,0.5458D+00,0.6131D+00,0.6887D+00,0.7737D+00,
 
9849
     &0.7837D+00,0.7937D+00,0.8037D+00,0.8137D+00,0.8237D+00,0.8337D+00,
 
9850
     &0.8437D+00,0.8537D+00,0.8637D+00,0.8737D+00,0.8837D+00,0.8937D+00,
 
9851
     &0.9037D+00,0.9137D+00,0.9237D+00,0.9337D+00,0.9437D+00,0.9537D+00,
 
9852
     &0.9637D+00,0.9737D+00,0.9837D+00,0.9937D+00/
 
9853
      IF(INIT.NE.0) GOTO 10
 
9854
      INIT=1
 
9855
      open(unit=55,file='LAC1',status='old')
 
9856
200   format(6(1x,f10.2))
 
9857
300   format(4(1x,f10.2))
 
9858
      ir=1+(ix-1)/6
 
9859
      do jq=1,iq
 
9860
        do jp=0,nfun
 
9861
          do jx=1,ir-1
 
9862
             read(55,200)xa(1),xa(2),xa(3),xa(4),xa(5),xa(6)
 
9863
             do jj=(jx-1)*6+1,jx*6
 
9864
               xpv(jj,jq,jp)=xa(jj-(jx-1)*6)
 
9865
             enddo
 
9866
          enddo
 
9867
          read(55,200)xa(1),xa(2),xa(3),xa(4)
 
9868
          do jj=(ir-1)*6+1,ix
 
9869
            xpv(jj,jq,jp)=xa(jj-(ir-1)*6)
 
9870
          enddo
 
9871
        enddo
 
9872
      enddo
 
9873
      close(55)
 
9874
10    continue
 
9875
      DO  5 IP=-6,6
 
9876
        XPDF(IP)=ZEROD
 
9877
 5    CONTINUE
 
9878
      DO 2 I=1,IX
 
9879
        ENT(I)=LOG10(XT(I))
 
9880
  2   CONTINUE
 
9881
      NA(1)=IX
 
9882
      NA(2)=IQ
 
9883
      DO 3 I=1,IQ
 
9884
        ENT(IX+I)=LOG10(Q2T(I))
 
9885
   3  CONTINUE
 
9886
      ARG(1)=LOG10(X)
 
9887
      ARG(2)=LOG10(Q2)
 
9888
C
 
9889
      XPDF(0)=DBFINT(NARG,ARG,NA,ENT,XPV(1,1,0))
 
9890
      XPDF(1)=DBFINT(NARG,ARG,NA,ENT,XPV(1,1,1))
 
9891
      XPDF(2)=DBFINT(NARG,ARG,NA,ENT,XPV(1,1,2))
 
9892
      XPDF(3)=DBFINT(NARG,ARG,NA,ENT,XPV(1,1,3))
 
9893
      XPDF(4)=DBFINT(NARG,ARG,NA,ENT,XPV(1,1,4))
 
9894
      DO 21 JF=1,6
 
9895
        XPDF(-JF)=XPDF(JF)
 
9896
 21   CONTINUE
 
9897
      RETURN
 
9898
      END
 
9899
 
 
9900
 
 
9901
      DOUBLE PRECISION FUNCTION DBFINT(NARG,ARG,NA,ENT,TABLE)
 
9902
      IMPLICIT DOUBLE PRECISION(A-H,O-Z)
 
9903
             INTEGER NA(NARG), INDEX(32)
 
9904
      DOUBLE PRECISION
 
9905
     +       ARG(NARG),ENT(10),TABLE(10),WEIGHT(32)
 
9906
      DATA ZEROD/0.D0/ONED/1.D0/
 
9907
C
 
9908
           DBFINT =  ZEROD
 
9909
           IF(NARG .LT. 1  .OR.  NARG .GT. 5)  RETURN
 
9910
C
 
9911
           LMAX      =  0
 
9912
           ISTEP     =  1
 
9913
           KNOTS     =  1
 
9914
           INDEX(1)  =  1
 
9915
           WEIGHT(1) =  ONED
 
9916
           DO 100    N  =  1, NARG
 
9917
              X     =  ARG(N)
 
9918
              NDIM  =  NA(N)
 
9919
              LOCA  =  LMAX
 
9920
              LMIN  =  LMAX + 1
 
9921
              LMAX  =  LMAX + NDIM
 
9922
              IF(NDIM .GT. 2)  GOTO 10
 
9923
              IF(NDIM .EQ. 1)  GOTO 100
 
9924
              H  =  X - ENT(LMIN)
 
9925
              IF(H .EQ. ZEROD)  GOTO 90
 
9926
              ISHIFT  =  ISTEP
 
9927
              IF(X-ENT(LMIN+1) .EQ. ZEROD)  GOTO 21
 
9928
              ISHIFT  =  0
 
9929
              ETA     =  H / (ENT(LMIN+1) - ENT(LMIN))
 
9930
              GOTO 30
 
9931
   10         LOCB  =  LMAX + 1
 
9932
   11         LOCC  =  (LOCA+LOCB) / 2
 
9933
              IF(X-ENT(LOCC))  12, 20, 13
 
9934
   12         LOCB  =  LOCC
 
9935
              GOTO 14
 
9936
   13         LOCA  =  LOCC
 
9937
   14         IF(LOCB-LOCA .GT. 1)  GOTO 11
 
9938
              LOCA    =  MIN ( MAX (LOCA,LMIN), LMAX-1 )
 
9939
              ISHIFT  =  (LOCA - LMIN) * ISTEP
 
9940
              ETA     =  (X - ENT(LOCA)) / (ENT(LOCA+1) - ENT(LOCA))
 
9941
              GOTO 30
 
9942
   20         ISHIFT  =  (LOCC - LMIN) * ISTEP
 
9943
   21         DO 22  K  =  1, KNOTS
 
9944
                 INDEX(K)  =  INDEX(K) + ISHIFT
 
9945
   22            CONTINUE
 
9946
              GOTO 90
 
9947
   30         DO 31  K  =  1, KNOTS
 
9948
                 INDEX(K)         =  INDEX(K) + ISHIFT
 
9949
                 INDEX(K+KNOTS)   =  INDEX(K) + ISTEP
 
9950
                 WEIGHT(K+KNOTS)  =  WEIGHT(K) * ETA
 
9951
                 WEIGHT(K)        =  WEIGHT(K) - WEIGHT(K+KNOTS)
 
9952
   31            CONTINUE
 
9953
              KNOTS  =  2*KNOTS
 
9954
   90         ISTEP  =  ISTEP * NDIM
 
9955
  100         CONTINUE
 
9956
           DO 200    K  =  1, KNOTS
 
9957
              I  =  INDEX(K)
 
9958
              DBFINT =  DBFINT + WEIGHT(K) * TABLE(I)
 
9959
  200         CONTINUE
 
9960
           RETURN
 
9961
           END
 
9962
C END LAC1 PHOTON
 
9963
C-------------------------------------------------------------------
 
9964
      SUBROUTINE NOSETP
 
9965
      WRITE(*,*) ' SET OF STRUCTURE FUNCTIONS NOT IMPLEMENTED'
 
9966
      WRITE(*,*) ' OR'
 
9967
      WRITE(*,*) ' HADRON TYPE NOT DESCRIBED BY THE REQUESTED SET:'
 
9968
      WRITE(*,*) ' IH =    1    2    3    -1    -2    -3    4    5'
 
9969
      WRITE(*,*) ' HAD=    P    N    PI+  PBAR  NBAR  PI-  PH   EL'
 
9970
      STOP
 
9971
      END
 
9972
C
 
9973
C----------------------------------------------------------------------------
 
9974
C-------------------------------------------------------------------
 
9975
C------- ALPHA QCD -------------------------------------
 
9976
c Program to calculate alfa strong with nf flavours,
 
9977
c as a function of lambda with 5 flavors.
 
9978
c The value of alfa is matched at the thresholds q = mq.
 
9979
c When invoked with nf < 0 it chooses nf as the number of
 
9980
c flavors with mass less then q.
 
9981
c
 
9982
      function alfas(q2,xlam,inf)
 
9983
      implicit real * 8 (a-h,o-z)
 
9984
      data olam/0.d0/,pi/3.14159d0/
 
9985
      data xmb/5.d0/,xmc/1.5d0/
 
9986
      if(xlam.ne.olam) then
 
9987
        olam = xlam
 
9988
        b5  = (33-2*5)/pi/12
 
9989
        bp5 = (153 - 19*5) / pi / 2 / (33 - 2*5)
 
9990
        b4  = (33-2*4)/pi/12
 
9991
        bp4 = (153 - 19*4) / pi / 2 / (33 - 2*4)
 
9992
        b3  = (33-2*3)/pi/12
 
9993
        bp3 = (153 - 19*3) / pi / 2 / (33 - 2*3)
 
9994
        xlc = 2 * log(xmc/xlam)
 
9995
        xlb = 2 * log(xmb/xlam)
 
9996
        xllc = log(xlc)
 
9997
        xllb = log(xlb)
 
9998
        c45  =  1/( 1/(b5 * xlb) - xllb*bp5/(b5 * xlb)**2 )
 
9999
     #        - 1/( 1/(b4 * xlb) - xllb*bp4/(b4 * xlb)**2 )
 
10000
        c35  =  1/( 1/(b4 * xlc) - xllc*bp4/(b4 * xlc)**2 )
 
10001
     #        - 1/( 1/(b3 * xlc) - xllc*bp3/(b3 * xlc)**2 ) + c45
 
10002
      endif
 
10003
      q   = sqrt(q2)
 
10004
      xlq = 2 * log( q/xlam )
 
10005
      xllq = log( xlq )
 
10006
      nf = inf
 
10007
      if( nf .lt. 0) then
 
10008
        if( q .gt. xmb ) then
 
10009
          nf = 5
 
10010
        elseif( q .gt. xmc ) then
 
10011
          nf = 4
 
10012
        else
 
10013
          nf = 3
 
10014
        endif
 
10015
      endif
 
10016
      if    ( nf .eq. 5 ) then
 
10017
        alfas = 1/(b5 * xlq) -  bp5/(b5 * xlq)**2 * xllq
 
10018
      elseif( nf .eq. 4 ) then
 
10019
        alfas = 1/( 1/(1/(b4 * xlq) - bp4/(b4 * xlq)**2 * xllq) + c45 )
 
10020
      elseif( nf .eq. 3 ) then
 
10021
        alfas = 1/( 1/(1/(b3 * xlq) - bp3/(b3 * xlq)**2 * xllq) + c35 )
 
10022
      else
 
10023
        print *,'error in alfa: unimplemented # of light flavours',nf
 
10024
        stop
 
10025
      endif
 
10026
      return
 
10027
      end
 
10028
c-------------------------------------------
 
10029
c Program to calculate as with nf flavours
 
10030
c as a function of lambda with nf flavours
 
10031
c
 
10032
      function alfa(q,xlam,nloop,nf)
 
10033
      implicit real*8(a-h,o-z)
 
10034
      data pi/3.1415926536d0/
 
10035
      anf=dfloat(nf)
 
10036
      b0=11D0-2D0/3D0*anf
 
10037
      b1=51D0-19D0/3D0*anf
 
10038
      b2=2857D0-5033D0/9D0*nf+325D0/27D0*anf**2
 
10039
 
 
10040
      t = 2.d0 * log( q/xlam )
 
10041
      xlt = log( t )
 
10042
      if (nloop.eq.1) then
 
10043
      alfa = 4d0*Pi/(b0 * t)
 
10044
      elseif (nloop.eq.2) then
 
10045
      alfa = 4d0*Pi/(b0 * t)*(1D0-2D0*b1/b0**2 * xlt/t)
 
10046
      elseif (nloop.eq.3) then
 
10047
      alfa = 4d0*Pi/(b0 * t)*(1D0-2D0*b1/b0**2 * xlt/t
 
10048
     #+4D0*b1**2/b0**4/t**2*((xlt-0.5D0)**2+b2*b0/8D0/b1**2-5D0/4D0))
 
10049
      else
 
10050
         write(*,*) ' cannot do ',nloop,' loops in alfa'
 
10051
         stop
 
10052
      endif
 
10053
      return
 
10054
      end       
 
10055
 
 
10056
c----------------------------------------------------------
 
10057
c Program to get lambda_nf from as_nf at the scale q
 
10058
c
 
10059
      function xlambd(as,q,nloop,nf)
 
10060
      data pi/3.14159/
 
10061
      xlp = float(nloop-1)
 
10062
      b  = (33-2*nf)/pi/12
 
10063
      bp = (153 - 19*nf) / pi / 2 / (33 - 2*nf) * xlp
 
10064
      t  = 1/b/as
 
10065
c-----------------------------------------------------------
 
10066
c Solve the equation
 
10067
c
 
10068
    1 xlt = log(t)
 
10069
      ot = t
 
10070
c-----------------------------------------------------------
 
10071
c Solve the equation
 
10072
c Value and Derivative of alfa with respect to t
 
10073
c
 
10074
      as0  = 1/b/t - bp*xlt/(b*t)**2
 
10075
      as1  = - 1/b/t**2 -bp/b**2*(1-2*xlt)/t**3
 
10076
      t  = (as-as0)/as1 + t
 
10077
      if(abs(ot-t)/ot.gt..00001)goto 1
 
10078
      xlambd = q/exp(t/2)
 
10079
      return
 
10080
      end
 
10081
 
 
10082
 
 
10083
      SUBROUTINE MWARN(ROUT)
 
10084
      CHARACTER*(*) ROUT
 
10085
      WRITE(*,*) '***********************************************'
 
10086
      WRITE(*,*) '***** WARNING CALLED FROM ROUTINE ',ROUT,':'
 
10087
      END
 
10088
 
 
10089
 
 
10090
c CTEQ6 START
 
10091
 
 
10092
C----- START CTEQ6 FITS ------------------------------
 
10093
C Cteq6, added by P. Nason on 4-2-2002
 
10094
      SUBROUTINE  CTEQ6(ISET,IH,Q2,X,FX,NF)
 
10095
      REAL FX(-NF:NF)  
 
10096
      REAL*8 DX,DQ,CTQ6PDF,PDFS(-NF:NF)
 
10097
      DATA INIT/0/ 
 
10098
C
 
10099
      Q=SQRT(Q2)
 
10100
      DQ=DBLE(Q)
 
10101
      DX=DBLE(X)
 
10102
      CALL SETCTQ6(ISET)
 
10103
      DO I=-NF,NF
 
10104
         PDFS(I)=CTQ6PDF(I,DX,DQ)
 
10105
      ENDDO
 
10106
C                         
 
10107
      IF(ABS(IH).GE.3) CALL NOSETP
 
10108
      IH0=IH
 
10109
      IF(ABS(IH).EQ.2) IH0=ISIGN(1,IH)
 
10110
C The function CTQ6PDF return the parton distribution inside the proton.
 
10111
C The division by the factor DX is NOT needed
 
10112
      FX(0)=SNGL(PDFS(0))
 
10113
      FX(IH0)=SNGL(PDFS(1))
 
10114
      FX(2*IH0)=SNGL(PDFS(2))
 
10115
      FX(-IH0)=SNGL(PDFS(-1))
 
10116
      FX(-2*IH0)=SNGL(PDFS(-2))
 
10117
      DO I=3,NF              
 
10118
        FX(I)=SNGL(PDFS(I))
 
10119
      ENDDO          
 
10120
      DO I=-NF,-3
 
10121
        FX(I)=SNGL(PDFS(I))
 
10122
      ENDDO          
 
10123
C...TRANSFORM PROTON INTO NEUTRON
 
10124
      IF(ABS(IH).EQ.2) THEN
 
10125
        T=FX(1)
 
10126
        FX(1)=FX(2)
 
10127
        FX(2)=T
 
10128
        T=FX(-1)
 
10129
        FX(-1)=FX(-2)
 
10130
        FX(-2)=T
 
10131
      ENDIF
 
10132
      END
 
10133
 
 
10134
 
 
10135
C============================================================================
 
10136
C                CTEQ Parton Distribution Functions: Version 6.0
 
10137
C                             January 24, 2002
 
10138
C
 
10139
C   Ref: "New Generation of Parton Distributions with
 
10140
C         Uncertainties from Global QCD Analysis"
 
10141
C   By: J. Pumplin, D.R. Stump, J.Huston, H.L. Lai, P. Nadolsky, W.K. Tung
 
10142
C       hep-ph/0201195
 
10143
C
 
10144
C   This package contains 3 standard sets of CTEQ6 PDF's and 40 up/down sets
 
10145
C   with respect to CTEQ6M PDF's. Details are:
 
10146
C ---------------------------------------------------------------------------
 
10147
C  Iset   PDF        Description       Alpha_s(Mz)**Lam4  Lam5   Table_File
 
10148
C ---------------------------------------------------------------------------
 
10149
C   1    CTEQ6M   Standard MSbar scheme   0.118     326   226    cteq6m.tbl
 
10150
C   2    CTEQ6D   Standard DIS scheme     0.118     326   226    cteq6d.tbl
 
10151
C   3    CTEQ6L   Leading Order           0.118**   326** 226    cteq6l.tbl
 
10152
C     ------------------------------
 
10153
C   1xx  CTEQ6M1xx  +/- w.r.t. CTEQ6M     0.118     326   226    cteq6m1xx.tbl
 
10154
C    (where xx=01--40)
 
10155
C ---------------------------------------------------------------------------
 
10156
C   ** ALL fits are obtained by using the same coupling strength \alpha_s(Mz)=0.118;
 
10157
C   and the NLO running \alpha_s formula.  For the LO fit, the evolution of the PDF
 
10158
C   and the hard cross sections are calculated at LO.  More detailed discussions are
 
10159
C   given in hep-ph/0201195.
 
10160
C
 
10161
C   The table grids are generated for 10^-6 < x < 1 and 1.3 < Q < 10,000 (GeV).
 
10162
C   PDF values outside of the above range are returned using extrapolation.
 
10163
C   Lam5 (Lam4) represents Lambda value (in MeV) for 5 (4) flavors.
 
10164
C   The matching alpha_s between 4 and 5 flavors takes place at Q=4.5 GeV,
 
10165
C   which is defined as the bottom quark mass, whenever it can be applied.
 
10166
C
 
10167
C   The Table_Files are assumed to be in the working directory.
 
10168
C
 
10169
C   Before using the PDF, it is necessary to do the initialization by
 
10170
C       Call SetCtq6(Iset)
 
10171
C   where Iset is the desired PDF specified in the above table.
 
10172
C
 
10173
C   The function Ctq6Pdf (Iparton, X, Q)
 
10174
C   returns the parton distribution inside the proton for parton [Iparton]
 
10175
C   at [X] Bjorken_X and scale [Q] (GeV) in PDF set [Iset].
 
10176
C   Iparton  is the parton label (5, 4, 3, 2, 1, 0, -1, ......, -5)
 
10177
C                            for (b, c, s, d, u, g, u_bar, ..., b_bar),
 
10178
C
 
10179
C   For detailed information on the parameters used, e.q. quark masses,
 
10180
C   QCD Lambda, ... etc.,  see info lines at the beginning of the
 
10181
C   Table_Files.
 
10182
C
 
10183
C   These programs, as provided, are in double precision.  By removing the
 
10184
C   "Implicit Double Precision" lines, they can also be run in single
 
10185
C   precision.
 
10186
C
 
10187
C   If you have detailed questions concerning these CTEQ6 distributions,
 
10188
C   or if you find problems/bugs using this package, direct inquires to
 
10189
C   Pumplin@pa.msu.edu or Tung@pa.msu.edu.
 
10190
C
 
10191
C===========================================================================
 
10192
 
 
10193
      Function Ctq6Pdf (Iparton, X, Q)
 
10194
      Implicit Double Precision (A-H,O-Z)
 
10195
      Logical Warn
 
10196
      Common
 
10197
     > / K720CtqPar2 / Nx, Nt, NfMx
 
10198
     > / K720QCDtable /  Alambda, Nfl, Iorder
 
10199
 
 
10200
      Data Warn /.true./
 
10201
      save Warn
 
10202
 
 
10203
      If (X .lt. 0D0 .or. X .gt. 1D0) Then
 
10204
        Print *, 'X out of range in Ctq6Pdf: ', X
 
10205
        Stop
 
10206
      Endif
 
10207
      If (Q .lt. Alambda) Then
 
10208
        Print *, 'Q out of range in Ctq6Pdf: ', Q
 
10209
        Stop
 
10210
      Endif
 
10211
      If ((Iparton .lt. -NfMx .or. Iparton .gt. NfMx)) Then
 
10212
         If (Warn) Then
 
10213
C        put a warning for calling extra flavor.
 
10214
             Warn = .false.
 
10215
             Print *, 'Warning: Iparton out of range in Ctq6Pdf: '
 
10216
     >              , Iparton
 
10217
         Endif
 
10218
         Ctq6Pdf = 0D0
 
10219
         Return
 
10220
      Endif
 
10221
 
 
10222
      Ctq6Pdf = PartonX6 (Iparton, X, Q)
 
10223
      if(Ctq6Pdf.lt.0.D0)  Ctq6Pdf = 0.D0
 
10224
 
 
10225
      Return
 
10226
 
 
10227
C                             ********************
 
10228
      End
 
10229
 
 
10230
      Subroutine SetCtq6 (Iset)
 
10231
      Implicit Double Precision (A-H,O-Z)
 
10232
      Parameter (Isetmax0=3)
 
10233
      Character Flnm(Isetmax0)*6, nn*3, Tablefile*40
 
10234
      Data (Flnm(I), I=1,Isetmax0)
 
10235
     > / 'cteq6m', 'cteq6d', 'cteq6l' /
 
10236
      Data Isetold, Isetmin0, Isetmin1, Isetmax1 /-987,1,101,140/
 
10237
      save
 
10238
 
 
10239
C             If data file not initialized, do so.
 
10240
      If(Iset.ne.Isetold) then
 
10241
         IU= NextUn6()
 
10242
         If (Iset.ge.Isetmin0 .and. Iset.le.Isetmax0) Then
 
10243
            Tablefile=Flnm(Iset)
 
10244
         Elseif (Iset.ge.Isetmin1 .and. Iset.le.Isetmax1) Then
 
10245
            write(nn,'(I3)') Iset
 
10246
            Tablefile=Flnm(1)//nn
 
10247
         Else
 
10248
            Print *, 'Invalid Iset number in SetCtq6 :', Iset
 
10249
            Stop
 
10250
         Endif
 
10251
         write(*,*) 'Cteq6, set=',iset,'  file ',Tablefile
 
10252
         Open(IU, File=Tablefile, Status='OLD', Err=100)
 
10253
 21      Call ReadTbl6 (IU)
 
10254
         Close (IU)
 
10255
         Isetold=Iset
 
10256
      Endif
 
10257
      Return
 
10258
 
 
10259
 100  Print *, ' Data file ', Tablefile, ' cannot be opened '
 
10260
     >//'in SetCtq6!!'
 
10261
      Stop
 
10262
C                             ********************
 
10263
      End
 
10264
 
 
10265
      Subroutine ReadTbl6 (Nu)
 
10266
      Implicit Double Precision (A-H,O-Z)
 
10267
      Character Line*80
 
10268
      PARAMETER (MXX = 96, MXQ = 20, MXF = 5)
 
10269
      PARAMETER (MXPQX = (MXF + 3) * MXQ * MXX)
 
10270
      Common
 
10271
     > / K720CtqPar1 / Al, XV(0:MXX), TV(0:MXQ), UPD(MXPQX)
 
10272
     > / K720CtqPar2 / Nx, Nt, NfMx
 
10273
     > / K720XQrange / Qini, Qmax, Xmin
 
10274
     > / K720QCDtable /  Alambda, Nfl, Iorder
 
10275
     > / K720Masstbl / Amass(6)
 
10276
 
 
10277
      Read  (Nu, '(A)') Line
 
10278
      Read  (Nu, '(A)') Line
 
10279
      Read  (Nu, *) Dr, Fl, Al, (Amass(I),I=1,6)
 
10280
      Iorder = Nint(Dr)
 
10281
      Nfl = Nint(Fl)
 
10282
      Alambda = Al
 
10283
 
 
10284
      Read  (Nu, '(A)') Line
 
10285
      Read  (Nu, *) NX,  NT, NfMx
 
10286
 
 
10287
      Read  (Nu, '(A)') Line
 
10288
      Read  (Nu, *) QINI, QMAX, (TV(I), I =0, NT)
 
10289
 
 
10290
      Read  (Nu, '(A)') Line
 
10291
      Read  (Nu, *) XMIN, (XV(I), I =0, NX)
 
10292
 
 
10293
      Do 11 Iq = 0, NT
 
10294
         TV(Iq) = Log(Log (TV(Iq) /Al))
 
10295
   11 Continue
 
10296
C
 
10297
C                  Since quark = anti-quark for nfl>2 at this stage,
 
10298
C                  we Read  out only the non-redundent data points
 
10299
C     No of flavors = NfMx (sea) + 1 (gluon) + 2 (valence)
 
10300
 
 
10301
      Nblk = (NX+1) * (NT+1)
 
10302
      Npts =  Nblk  * (NfMx+3)
 
10303
      Read  (Nu, '(A)') Line
 
10304
      Read  (Nu, *, IOSTAT=IRET) (UPD(I), I=1,Npts)
 
10305
 
 
10306
      Return
 
10307
C                        ****************************
 
10308
      End
 
10309
 
 
10310
      Function NextUn6()
 
10311
C                                 Returns an unallocated FORTRAN i/o unit.
 
10312
      Logical EX
 
10313
C
 
10314
      Do 10 N = 10, 300
 
10315
         INQUIRE (UNIT=N, OPENED=EX)
 
10316
         If (.NOT. EX) then
 
10317
            NextUn6 = N
 
10318
            Return
 
10319
         Endif
 
10320
 10   Continue
 
10321
      Stop ' There is no available I/O unit. '
 
10322
C               *************************
 
10323
      End
 
10324
C
 
10325
 
 
10326
      SUBROUTINE POLINT6 (XA,YA,N,X,Y,DY)
 
10327
 
 
10328
      IMPLICIT DOUBLE PRECISION (A-H, O-Z)
 
10329
C                                        Adapted from "Numerical Recipes"
 
10330
      PARAMETER (NMAX=10)
 
10331
      DIMENSION XA(N),YA(N),C(NMAX),D(NMAX)
 
10332
      NS=1
 
10333
      DIF=ABS(X-XA(1))
 
10334
      DO 11 I=1,N
 
10335
        DIFT=ABS(X-XA(I))
 
10336
        IF (DIFT.LT.DIF) THEN
 
10337
          NS=I
 
10338
          DIF=DIFT
 
10339
        ENDIF
 
10340
        C(I)=YA(I)
 
10341
        D(I)=YA(I)
 
10342
11    CONTINUE
 
10343
      Y=YA(NS)
 
10344
      NS=NS-1
 
10345
      DO 13 M=1,N-1
 
10346
        DO 12 I=1,N-M
 
10347
          HO=XA(I)-X
 
10348
          HP=XA(I+M)-X
 
10349
          W=C(I+1)-D(I)
 
10350
          DEN=HO-HP
 
10351
          IF(DEN.EQ.0.)PAUSE
 
10352
          DEN=W/DEN
 
10353
          D(I)=HP*DEN
 
10354
          C(I)=HO*DEN
 
10355
12      CONTINUE
 
10356
        IF (2*NS.LT.N-M)THEN
 
10357
          DY=C(NS+1)
 
10358
        ELSE
 
10359
          DY=D(NS)
 
10360
          NS=NS-1
 
10361
        ENDIF
 
10362
        Y=Y+DY
 
10363
13    CONTINUE
 
10364
      RETURN
 
10365
      END
 
10366
 
 
10367
      Function PartonX6 (IPRTN, XX, QQ)
 
10368
 
 
10369
c  Given the parton distribution function in the array U in
 
10370
c  COMMON / PEVLDT / , this routine interpolates to find
 
10371
c  the parton distribution at an arbitray point in x and q.
 
10372
c
 
10373
      Implicit Double Precision (A-H,O-Z)
 
10374
 
 
10375
      Parameter (MXX = 96, MXQ = 20, MXF = 5)
 
10376
      Parameter (MXQX= MXQ * MXX,   MXPQX = MXQX * (MXF+3))
 
10377
 
 
10378
      Common
 
10379
     > / K720CtqPar1 / Al, XV(0:MXX), TV(0:MXQ), UPD(MXPQX)
 
10380
     > / K720CtqPar2 / Nx, Nt, NfMx
 
10381
     > / K720XQrange / Qini, Qmax, Xmin
 
10382
 
 
10383
      Dimension fvec(4), fij(4)
 
10384
      Dimension xvpow(0:mxx)
 
10385
      Data OneP / 1.00001 /
 
10386
      Data xpow / 0.3d0 /       !**** choice of interpolation variable
 
10387
      Data nqvec / 4 /
 
10388
      Data ientry / 0 /
 
10389
      Save ientry,xvpow
 
10390
 
 
10391
c store the powers used for interpolation on first call...
 
10392
      if(ientry .eq. 0) then
 
10393
         ientry = 1
 
10394
 
 
10395
         xvpow(0) = 0D0
 
10396
         do i = 1, nx
 
10397
            xvpow(i) = xv(i)**xpow
 
10398
         enddo
 
10399
      endif
 
10400
 
 
10401
      X = XX
 
10402
      Q = QQ
 
10403
      tt = log(log(Q/Al))
 
10404
 
 
10405
c      -------------    find lower end of interval containing x, i.e.,
 
10406
c                       get jx such that xv(jx) .le. x .le. xv(jx+1)...
 
10407
      JLx = -1
 
10408
      JU = Nx+1
 
10409
 11   If (JU-JLx .GT. 1) Then
 
10410
         JM = (JU+JLx) / 2
 
10411
         If (X .Ge. XV(JM)) Then
 
10412
            JLx = JM
 
10413
         Else
 
10414
            JU = JM
 
10415
         Endif
 
10416
         Goto 11
 
10417
      Endif
 
10418
C                     Ix    0   1   2      Jx  JLx         Nx-2     Nx
 
10419
C                           |---|---|---|...|---|-x-|---|...|---|---|
 
10420
C                     x     0  Xmin               x                 1
 
10421
C
 
10422
      If     (JLx .LE. -1) Then
 
10423
        Print '(A,1pE12.4)', 'Severe error: x <= 0 in PartonX6! x = ', x
 
10424
        Stop
 
10425
      ElseIf (JLx .Eq. 0) Then
 
10426
         Jx = 0
 
10427
      Elseif (JLx .LE. Nx-2) Then
 
10428
 
 
10429
C                For interrior points, keep x in the middle, as shown above
 
10430
         Jx = JLx - 1
 
10431
      Elseif (JLx.Eq.Nx-1 .or. x.LT.OneP) Then
 
10432
 
 
10433
C                  We tolerate a slight over-shoot of one (OneP=1.00001),
 
10434
C              perhaps due to roundoff or whatever, but not more than that.
 
10435
C                                      Keep at least 4 points >= Jx
 
10436
         Jx = JLx - 2
 
10437
      Else
 
10438
        Print '(A,1pE12.4)', 'Severe error: x > 1 in PartonX6! x = ', x
 
10439
        Stop
 
10440
      Endif
 
10441
C          ---------- Note: JLx uniquely identifies the x-bin; Jx does not.
 
10442
 
 
10443
C                       This is the variable to be interpolated in
 
10444
      ss = x**xpow
 
10445
 
 
10446
      If (JLx.Ge.2 .and. JLx.Le.Nx-2) Then
 
10447
 
 
10448
c     initiation work for "interior bins": store the lattice points in s...
 
10449
      svec1 = xvpow(jx)
 
10450
      svec2 = xvpow(jx+1)
 
10451
      svec3 = xvpow(jx+2)
 
10452
      svec4 = xvpow(jx+3)
 
10453
 
 
10454
      s12 = svec1 - svec2
 
10455
      s13 = svec1 - svec3
 
10456
      s23 = svec2 - svec3
 
10457
      s24 = svec2 - svec4
 
10458
      s34 = svec3 - svec4
 
10459
 
 
10460
      sy2 = ss - svec2
 
10461
      sy3 = ss - svec3
 
10462
 
 
10463
c constants needed for interpolating in s at fixed t lattice points...
 
10464
      const1 = s13/s23
 
10465
      const2 = s12/s23
 
10466
      const3 = s34/s23
 
10467
      const4 = s24/s23
 
10468
      s1213 = s12 + s13
 
10469
      s2434 = s24 + s34
 
10470
      sdet = s12*s34 - s1213*s2434
 
10471
      tmp = sy2*sy3/sdet
 
10472
      const5 = (s34*sy2-s2434*sy3)*tmp/s12
 
10473
      const6 = (s1213*sy2-s12*sy3)*tmp/s34
 
10474
 
 
10475
      EndIf
 
10476
 
 
10477
c         --------------Now find lower end of interval containing Q, i.e.,
 
10478
c                          get jq such that qv(jq) .le. q .le. qv(jq+1)...
 
10479
      JLq = -1
 
10480
      JU = NT+1
 
10481
 12   If (JU-JLq .GT. 1) Then
 
10482
         JM = (JU+JLq) / 2
 
10483
         If (tt .GE. TV(JM)) Then
 
10484
            JLq = JM
 
10485
         Else
 
10486
            JU = JM
 
10487
         Endif
 
10488
         Goto 12
 
10489
       Endif
 
10490
 
 
10491
      If     (JLq .LE. 0) Then
 
10492
         Jq = 0
 
10493
      Elseif (JLq .LE. Nt-2) Then
 
10494
C                                  keep q in the middle, as shown above
 
10495
         Jq = JLq - 1
 
10496
      Else
 
10497
C                         JLq .GE. Nt-1 case:  Keep at least 4 points >= Jq.
 
10498
        Jq = Nt - 3
 
10499
 
 
10500
      Endif
 
10501
C                                   This is the interpolation variable in Q
 
10502
 
 
10503
      If (JLq.GE.1 .and. JLq.LE.Nt-2) Then
 
10504
c                                        store the lattice points in t...
 
10505
      tvec1 = Tv(jq)
 
10506
      tvec2 = Tv(jq+1)
 
10507
      tvec3 = Tv(jq+2)
 
10508
      tvec4 = Tv(jq+3)
 
10509
 
 
10510
      t12 = tvec1 - tvec2
 
10511
      t13 = tvec1 - tvec3
 
10512
      t23 = tvec2 - tvec3
 
10513
      t24 = tvec2 - tvec4
 
10514
      t34 = tvec3 - tvec4
 
10515
 
 
10516
      ty2 = tt - tvec2
 
10517
      ty3 = tt - tvec3
 
10518
 
 
10519
      tmp1 = t12 + t13
 
10520
      tmp2 = t24 + t34
 
10521
 
 
10522
      tdet = t12*t34 - tmp1*tmp2
 
10523
 
 
10524
      EndIf
 
10525
 
 
10526
 
 
10527
c get the pdf function values at the lattice points...
 
10528
 
 
10529
      If (Iprtn .GE. 3) Then
 
10530
         Ip = - Iprtn
 
10531
      Else
 
10532
         Ip = Iprtn
 
10533
      EndIf
 
10534
      jtmp = ((Ip + NfMx)*(NT+1)+(jq-1))*(NX+1)+jx+1
 
10535
 
 
10536
      Do it = 1, nqvec
 
10537
 
 
10538
         J1  = jtmp + it*(NX+1)
 
10539
 
 
10540
       If (Jx .Eq. 0) Then
 
10541
C                          For the first 4 x points, interpolate x^2*f(x,Q)
 
10542
C                           This applies to the two lowest bins JLx = 0, 1
 
10543
C            We can not put the JLx.eq.1 bin into the "interrior" section
 
10544
C                           (as we do for q), since Upd(J1) is undefined.
 
10545
         fij(1) = 0
 
10546
         fij(2) = Upd(J1+1) * XV(1)**2
 
10547
         fij(3) = Upd(J1+2) * XV(2)**2
 
10548
         fij(4) = Upd(J1+3) * XV(3)**2
 
10549
C
 
10550
C                 Use Polint6 which allows x to be anywhere w.r.t. the grid
 
10551
 
 
10552
         Call Polint6 (XVpow(0), Fij(1), 4, ss, Fx, Dfx)
 
10553
 
 
10554
         If (x .GT. 0D0)  Fvec(it) =  Fx / x**2
 
10555
C                                              Pdf is undefined for x.eq.0
 
10556
       ElseIf  (JLx .Eq. Nx-1) Then
 
10557
C                                                This is the highest x bin:
 
10558
 
 
10559
        Call Polint6 (XVpow(Nx-3), Upd(J1), 4, ss, Fx, Dfx)
 
10560
 
 
10561
        Fvec(it) = Fx
 
10562
 
 
10563
       Else
 
10564
C                       for all interior points, use Jon's in-line function
 
10565
C                              This applied to (JLx.Ge.2 .and. JLx.Le.Nx-2)
 
10566
         sf2 = Upd(J1+1)
 
10567
         sf3 = Upd(J1+2)
 
10568
 
 
10569
         g1 =  sf2*const1 - sf3*const2
 
10570
         g4 = -sf2*const3 + sf3*const4
 
10571
 
 
10572
         Fvec(it) = (const5*(Upd(J1)-g1)
 
10573
     &               + const6*(Upd(J1+3)-g4)
 
10574
     &               + sf2*sy3 - sf3*sy2) / s23
 
10575
 
 
10576
       Endif
 
10577
 
 
10578
      enddo
 
10579
C                                   We now have the four values Fvec(1:4)
 
10580
c     interpolate in t...
 
10581
 
 
10582
      If (JLq .LE. 0) Then
 
10583
C                         1st Q-bin, as well as extrapolation to lower Q
 
10584
        Call Polint6 (TV(0), Fvec(1), 4, tt, ff, Dfq)
 
10585
 
 
10586
      ElseIf (JLq .GE. Nt-1) Then
 
10587
C                         Last Q-bin, as well as extrapolation to higher Q
 
10588
        Call Polint6 (TV(Nt-3), Fvec(1), 4, tt, ff, Dfq)
 
10589
      Else
 
10590
C                         Interrior bins : (JLq.GE.1 .and. JLq.LE.Nt-2)
 
10591
C       which include JLq.Eq.1 and JLq.Eq.Nt-2, since Upd is defined for
 
10592
C                         the full range QV(0:Nt)  (in contrast to XV)
 
10593
        tf2 = fvec(2)
 
10594
        tf3 = fvec(3)
 
10595
 
 
10596
        g1 = ( tf2*t13 - tf3*t12) / t23
 
10597
        g4 = (-tf2*t34 + tf3*t24) / t23
 
10598
 
 
10599
        h00 = ((t34*ty2-tmp2*ty3)*(fvec(1)-g1)/t12
 
10600
     &    +  (tmp1*ty2-t12*ty3)*(fvec(4)-g4)/t34)
 
10601
 
 
10602
        ff = (h00*ty2*ty3/tdet + tf2*ty3 - tf3*ty2) / t23
 
10603
      EndIf
 
10604
 
 
10605
      PartonX6 = ff
 
10606
 
 
10607
      Return
 
10608
C                                       ********************
 
10609
      End
 
10610
 
 
10611
c CTEQ6 END
 
10612
 
 
10613
 
 
10614
c BEGIN MRSTNNLO (2002) 
 
10615
      subroutine mrst0201127
 
10616
     #           (x,q,mode,upv,dnv,usea,dsea,str,chm,bot,glu)
 
10617
C***************************************************************C
 
10618
C                                                               C
 
10619
C  This is a package for the MRST 2002 NNLO parton distributionsC
 
10620
C  Reference: A.D. Martin, R.G. Roberts, W.J. Stirling and      C
 
10621
C  R.S. Thorne, hep-ph/0201127                                  C
 
10622
C                                                               C
 
10623
C  There are 4 pdf sets corresponding to mode = 1, 2, 3, 4      C
 
10624
C                                                               C
 
10625
C  Mode=1 gives the default set with Lambda(MSbar,nf=4) = 0.235 C
 
10626
C  corresponding to alpha_s(M_Z) of 0.1155                      C
 
10627
C  This set is the `average' of the slow and fast evolutions    C 
 
10628
C  This set reads a grid whose first number is 0.00725          C
 
10629
C                                                               C
 
10630
C  Mode=2 gives the set with Lambda(MSbar,nf=4) = 0.235         C
 
10631
C  corresponding to alpha_s(M_Z) of 0.1155                      C
 
10632
C  This set is the fast evolution                               C 
 
10633
C  This set reads a grid whose first number is 0.00734          C
 
10634
C                                                               C
 
10635
C  Mode=3 gives the set with Lambda(MSbar,nf=4) = 0.235         C
 
10636
C  corresponding to alpha_s(M_Z) of 0.1155                      C
 
10637
C  This set is the slow evolution                               C 
 
10638
C  This set reads a grid whose first number is 0.00739          C
 
10639
C                                                               C
 
10640
C  Mode=4 gives the set MRSTNNLOJ which gives better agreement  C
 
10641
C  with the Tevatron inclusive jet data but has unattractive    C
 
10642
C  gluon behaviour at large x (see discussion in paper)         C
 
10643
C  This set has Lambda(MSbar,nf=4) = 0.267(alpha_s(M_Z) =0.1180 C 
 
10644
C  This set reads a grid whose first number is 0.00865          C
 
10645
C                                                               C
 
10646
C   This subroutine uses an improved interpolation procedure    C 
 
10647
C   for extracting values of the pdf's from the grid            C
 
10648
C                                                               C
 
10649
C         Comments to : W.J.Stirling@durham.ac.uk               C
 
10650
C                                                               C
 
10651
C***************************************************************C
 
10652
      implicit real*8(a-h,o-z)
 
10653
      data xmin,xmax,qsqmin,qsqmax/1d-5,1d0,1.25d0,1d7/
 
10654
      q2=q*q
 
10655
c      if(q2.lt.qsqmin.or.q2.gt.qsqmax) print 99,q2
 
10656
c      if(x.lt.xmin.or.x.gt.xmax)       print 98,x
 
10657
      if(mode.eq.1) then
 
10658
        call mrst10201127(x,q2,upv,dnv,usea,dsea,str,chm,bot,glu) 
 
10659
      elseif(mode.eq.2) then
 
10660
        call mrst20201127(x,q2,upv,dnv,usea,dsea,str,chm,bot,glu) 
 
10661
      elseif(mode.eq.3) then
 
10662
        call mrst30201127(x,q2,upv,dnv,usea,dsea,str,chm,bot,glu) 
 
10663
      elseif(mode.eq.4) then
 
10664
        call mrst40201127(x,q2,upv,dnv,usea,dsea,str,chm,bot,glu)
 
10665
      endif 
 
10666
  99  format('  WARNING:  Q^2 VALUE IS OUT OF RANGE   ','q2= ',e10.5)
 
10667
  98  format('  WARNING:   X  VALUE IS OUT OF RANGE   ','x= ',e10.5)
 
10668
      return
 
10669
      end
 
10670
 
 
10671
      subroutine mrst10201127(x,qsq,upv,dnv,usea,dsea,str,chm,bot,glu)
 
10672
      implicit real*8(a-h,o-z)
 
10673
      parameter(nx=49,nq=37,np=8,nqc0=2,nqb0=11,nqc=35,nqb=26)
 
10674
      real*8 f1(nx,nq),f2(nx,nq),f3(nx,nq),f4(nx,nq),f5(nx,nq),
 
10675
     .f6(nx,nq),f7(nx,nq),f8(nx,nq),fc(nx,nqc),fb(nx,nqb)
 
10676
      real*8 qq(nq),xx(nx),cc1(nx,nq,4,4),cc2(nx,nq,4,4),
 
10677
     .cc3(nx,nq,4,4),cc4(nx,nq,4,4),cc6(nx,nq,4,4),cc8(nx,nq,4,4),
 
10678
     .ccc(nx,nqc,4,4),ccb(nx,nqb,4,4)
 
10679
      real*8 xxl(nx),qql(nq),qqlc(nqc),qqlb(nqb)
 
10680
      data xx/1d-5,2d-5,4d-5,6d-5,8d-5,
 
10681
     .        1d-4,2d-4,4d-4,6d-4,8d-4,
 
10682
     .        1d-3,2d-3,4d-3,6d-3,8d-3,
 
10683
     .        1d-2,1.4d-2,2d-2,3d-2,4d-2,6d-2,8d-2,
 
10684
     .     .1d0,.125d0,.15d0,.175d0,.2d0,.225d0,.25d0,.275d0,
 
10685
     .     .3d0,.325d0,.35d0,.375d0,.4d0,.425d0,.45d0,.475d0,
 
10686
     .     .5d0,.525d0,.55d0,.575d0,.6d0,.65d0,.7d0,.75d0,
 
10687
     .     .8d0,.9d0,1d0/
 
10688
      data qq/1.25d0,1.5d0,2d0,2.5d0,3.2d0,4d0,5d0,6.4d0,8d0,1d1,
 
10689
     .        1.2d1,1.8d1,2.6d1,4d1,6.4d1,1d2,
 
10690
     .        1.6d2,2.4d2,4d2,6.4d2,1d3,1.8d3,3.2d3,5.6d3,1d4,
 
10691
     .        1.8d4,3.2d4,5.6d4,1d5,1.8d5,3.2d5,5.6d5,1d6,
 
10692
     .        1.8d6,3.2d6,5.6d6,1d7/
 
10693
      data xmin,xmax,qsqmin,qsqmax/1d-5,1d0,1.25d0,1d7/
 
10694
      data init/0/
 
10695
      save
 
10696
      xsave=x
 
10697
      q2save=qsq
 
10698
      if(init.ne.0) goto 10
 
10699
c        write(*,*) ' mrstnnlo 1'
 
10700
        open(unit=33,file='vnvalf1155',status='old')
 
10701
        do 20 n=1,nx-1
 
10702
        do 20 m=1,nq
 
10703
        read(33,50)f1(n,m),f2(n,m),f3(n,m),f4(n,m),
 
10704
     .            f5(n,m),f7(n,m),f6(n,m),f8(n,m)
 
10705
c notation: 1=uval 2=val 3=glue 4=usea 5=chm 6=str 7=btm 8=dsea
 
10706
  20  continue
 
10707
      call mrscheck(f1(1,1),44)
 
10708
      do 40 m=1,nq
 
10709
      f1(nx,m)=0.d0
 
10710
      f2(nx,m)=0.d0
 
10711
      f3(nx,m)=0.d0
 
10712
      f4(nx,m)=0.d0
 
10713
      f5(nx,m)=0.d0
 
10714
      f6(nx,m)=0.d0
 
10715
      f7(nx,m)=0.d0
 
10716
      f8(nx,m)=0.d0
 
10717
  40  continue
 
10718
      do n=1,nx
 
10719
      xxl(n)=dlog(xx(n))
 
10720
      enddo
 
10721
      do m=1,nq
 
10722
      qql(m)=dlog(qq(m))
 
10723
      enddo
 
10724
 
 
10725
      call jeppe1(nx,nq,xxl,qql,f1,cc1)
 
10726
      call jeppe1(nx,nq,xxl,qql,f2,cc2)
 
10727
      call jeppe1(nx,nq,xxl,qql,f3,cc3)
 
10728
      call jeppe1(nx,nq,xxl,qql,f4,cc4)
 
10729
      call jeppe1(nx,nq,xxl,qql,f6,cc6)
 
10730
      call jeppe1(nx,nq,xxl,qql,f8,cc8)
 
10731
 
 
10732
      emc2=2.045
 
10733
      emb2=18.5
 
10734
 
 
10735
      do 44 m=1,nqc
 
10736
      qqlc(m)=qql(m+nqc0)
 
10737
      do 44 n=1,nx
 
10738
      fc(n,m)=f5(n,m+nqc0)
 
10739
   44 continue
 
10740
      qqlc(1)=dlog(emc2)
 
10741
      call jeppe1(nx,nqc,xxl,qqlc,fc,ccc)
 
10742
 
 
10743
      do 45 m=1,nqb
 
10744
      qqlb(m)=qql(m+nqb0)
 
10745
      do 45 n=1,nx
 
10746
      fb(n,m)=f7(n,m+nqb0)
 
10747
   45 continue
 
10748
      qqlb(1)=dlog(emb2)
 
10749
      call jeppe1(nx,nqb,xxl,qqlb,fb,ccb)
 
10750
 
 
10751
 
 
10752
      init=1
 
10753
   10 continue
 
10754
      
 
10755
      xlog=dlog(x)
 
10756
      qsqlog=dlog(qsq)
 
10757
 
 
10758
      call jeppe2(xlog,qsqlog,nx,nq,xxl,qql,cc1,upv)
 
10759
      call jeppe2(xlog,qsqlog,nx,nq,xxl,qql,cc2,dnv)
 
10760
      call jeppe2(xlog,qsqlog,nx,nq,xxl,qql,cc3,glu)
 
10761
      call jeppe2(xlog,qsqlog,nx,nq,xxl,qql,cc4,usea)
 
10762
      call jeppe2(xlog,qsqlog,nx,nq,xxl,qql,cc6,str)
 
10763
      call jeppe2(xlog,qsqlog,nx,nq,xxl,qql,cc8,dsea)
 
10764
 
 
10765
      chm=0.d0
 
10766
      if(qsq.gt.emc2) then 
 
10767
      call jeppe2(xlog,qsqlog,nx,nqc,xxl,qqlc,ccc,chm)
 
10768
      endif
 
10769
 
 
10770
      bot=0.d0
 
10771
      if(qsq.gt.emb2) then 
 
10772
      call jeppe2(xlog,qsqlog,nx,nqb,xxl,qqlb,ccb,bot)
 
10773
      endif
 
10774
 
 
10775
      x=xsave
 
10776
      qsq=q2save
 
10777
      return
 
10778
   50 format(8f10.5)
 
10779
      end
 
10780
 
 
10781
      subroutine mrst20201127(x,qsq,upv,dnv,usea,dsea,str,chm,bot,glu)
 
10782
      implicit real*8(a-h,o-z)
 
10783
      parameter(nx=49,nq=37,np=8,nqc0=2,nqb0=11,nqc=35,nqb=26)
 
10784
      real*8 f1(nx,nq),f2(nx,nq),f3(nx,nq),f4(nx,nq),f5(nx,nq),
 
10785
     .f6(nx,nq),f7(nx,nq),f8(nx,nq),fc(nx,nqc),fb(nx,nqb)
 
10786
      real*8 qq(nq),xx(nx),cc1(nx,nq,4,4),cc2(nx,nq,4,4),
 
10787
     .cc3(nx,nq,4,4),cc4(nx,nq,4,4),cc6(nx,nq,4,4),cc8(nx,nq,4,4),
 
10788
     .ccc(nx,nqc,4,4),ccb(nx,nqb,4,4)
 
10789
      real*8 xxl(nx),qql(nq),qqlc(nqc),qqlb(nqb)
 
10790
      data xx/1d-5,2d-5,4d-5,6d-5,8d-5,
 
10791
     .        1d-4,2d-4,4d-4,6d-4,8d-4,
 
10792
     .        1d-3,2d-3,4d-3,6d-3,8d-3,
 
10793
     .        1d-2,1.4d-2,2d-2,3d-2,4d-2,6d-2,8d-2,
 
10794
     .     .1d0,.125d0,.15d0,.175d0,.2d0,.225d0,.25d0,.275d0,
 
10795
     .     .3d0,.325d0,.35d0,.375d0,.4d0,.425d0,.45d0,.475d0,
 
10796
     .     .5d0,.525d0,.55d0,.575d0,.6d0,.65d0,.7d0,.75d0,
 
10797
     .     .8d0,.9d0,1d0/
 
10798
      data qq/1.25d0,1.5d0,2d0,2.5d0,3.2d0,4d0,5d0,6.4d0,8d0,1d1,
 
10799
     .        1.2d1,1.8d1,2.6d1,4d1,6.4d1,1d2,
 
10800
     .        1.6d2,2.4d2,4d2,6.4d2,1d3,1.8d3,3.2d3,5.6d3,1d4,
 
10801
     .        1.8d4,3.2d4,5.6d4,1d5,1.8d5,3.2d5,5.6d5,1d6,
 
10802
     .        1.8d6,3.2d6,5.6d6,1d7/
 
10803
      data xmin,xmax,qsqmin,qsqmax/1d-5,1d0,1.25d0,1d7/
 
10804
      data init/0/
 
10805
      save
 
10806
      xsave=x
 
10807
      q2save=qsq
 
10808
      if(init.ne.0) goto 10
 
10809
c        write(*,*) ' mrstnnlo 2'
 
10810
        open(unit=33,file='vnvalf1155a',status='old')
 
10811
        do 20 n=1,nx-1
 
10812
        do 20 m=1,nq
 
10813
        read(33,50)f1(n,m),f2(n,m),f3(n,m),f4(n,m),
 
10814
     .            f5(n,m),f7(n,m),f6(n,m),f8(n,m)
 
10815
c notation: 1=uval 2=val 3=glue 4=usea 5=chm 6=str 7=btm 8=dsea
 
10816
  20  continue
 
10817
      call mrscheck(f1(1,1),45)
 
10818
      do 40 m=1,nq
 
10819
      f1(nx,m)=0.d0
 
10820
      f2(nx,m)=0.d0
 
10821
      f3(nx,m)=0.d0
 
10822
      f4(nx,m)=0.d0
 
10823
      f5(nx,m)=0.d0
 
10824
      f6(nx,m)=0.d0
 
10825
      f7(nx,m)=0.d0
 
10826
      f8(nx,m)=0.d0
 
10827
  40  continue
 
10828
      do n=1,nx
 
10829
      xxl(n)=dlog(xx(n))
 
10830
      enddo
 
10831
      do m=1,nq
 
10832
      qql(m)=dlog(qq(m))
 
10833
      enddo
 
10834
 
 
10835
      call jeppe1(nx,nq,xxl,qql,f1,cc1)
 
10836
      call jeppe1(nx,nq,xxl,qql,f2,cc2)
 
10837
      call jeppe1(nx,nq,xxl,qql,f3,cc3)
 
10838
      call jeppe1(nx,nq,xxl,qql,f4,cc4)
 
10839
      call jeppe1(nx,nq,xxl,qql,f6,cc6)
 
10840
      call jeppe1(nx,nq,xxl,qql,f8,cc8)
 
10841
 
 
10842
      emc2=2.045
 
10843
      emb2=18.5
 
10844
 
 
10845
      do 44 m=1,nqc
 
10846
      qqlc(m)=qql(m+nqc0)
 
10847
      do 44 n=1,nx
 
10848
      fc(n,m)=f5(n,m+nqc0)
 
10849
   44 continue
 
10850
      qqlc(1)=dlog(emc2)
 
10851
      call jeppe1(nx,nqc,xxl,qqlc,fc,ccc)
 
10852
 
 
10853
      do 45 m=1,nqb
 
10854
      qqlb(m)=qql(m+nqb0)
 
10855
      do 45 n=1,nx
 
10856
      fb(n,m)=f7(n,m+nqb0)
 
10857
   45 continue
 
10858
      qqlb(1)=dlog(emb2)
 
10859
      call jeppe1(nx,nqb,xxl,qqlb,fb,ccb)
 
10860
 
 
10861
 
 
10862
      init=1
 
10863
   10 continue
 
10864
      
 
10865
      xlog=dlog(x)
 
10866
      qsqlog=dlog(qsq)
 
10867
 
 
10868
      call jeppe2(xlog,qsqlog,nx,nq,xxl,qql,cc1,upv)
 
10869
      call jeppe2(xlog,qsqlog,nx,nq,xxl,qql,cc2,dnv)
 
10870
      call jeppe2(xlog,qsqlog,nx,nq,xxl,qql,cc3,glu)
 
10871
      call jeppe2(xlog,qsqlog,nx,nq,xxl,qql,cc4,usea)
 
10872
      call jeppe2(xlog,qsqlog,nx,nq,xxl,qql,cc6,str)
 
10873
      call jeppe2(xlog,qsqlog,nx,nq,xxl,qql,cc8,dsea)
 
10874
 
 
10875
      chm=0.d0
 
10876
      if(qsq.gt.emc2) then 
 
10877
      call jeppe2(xlog,qsqlog,nx,nqc,xxl,qqlc,ccc,chm)
 
10878
      endif
 
10879
 
 
10880
      bot=0.d0
 
10881
      if(qsq.gt.emb2) then 
 
10882
      call jeppe2(xlog,qsqlog,nx,nqb,xxl,qqlb,ccb,bot)
 
10883
      endif
 
10884
 
 
10885
      x=xsave
 
10886
      qsq=q2save
 
10887
      return
 
10888
   50 format(8f10.5)
 
10889
      end
 
10890
 
 
10891
      subroutine mrst30201127(x,qsq,upv,dnv,usea,dsea,str,chm,bot,glu)
 
10892
      implicit real*8(a-h,o-z)
 
10893
      parameter(nx=49,nq=37,np=8,nqc0=2,nqb0=11,nqc=35,nqb=26)
 
10894
      real*8 f1(nx,nq),f2(nx,nq),f3(nx,nq),f4(nx,nq),f5(nx,nq),
 
10895
     .f6(nx,nq),f7(nx,nq),f8(nx,nq),fc(nx,nqc),fb(nx,nqb)
 
10896
      real*8 qq(nq),xx(nx),cc1(nx,nq,4,4),cc2(nx,nq,4,4),
 
10897
     .cc3(nx,nq,4,4),cc4(nx,nq,4,4),cc6(nx,nq,4,4),cc8(nx,nq,4,4),
 
10898
     .ccc(nx,nqc,4,4),ccb(nx,nqb,4,4)
 
10899
      real*8 xxl(nx),qql(nq),qqlc(nqc),qqlb(nqb)
 
10900
      data xx/1d-5,2d-5,4d-5,6d-5,8d-5,
 
10901
     .        1d-4,2d-4,4d-4,6d-4,8d-4,
 
10902
     .        1d-3,2d-3,4d-3,6d-3,8d-3,
 
10903
     .        1d-2,1.4d-2,2d-2,3d-2,4d-2,6d-2,8d-2,
 
10904
     .     .1d0,.125d0,.15d0,.175d0,.2d0,.225d0,.25d0,.275d0,
 
10905
     .     .3d0,.325d0,.35d0,.375d0,.4d0,.425d0,.45d0,.475d0,
 
10906
     .     .5d0,.525d0,.55d0,.575d0,.6d0,.65d0,.7d0,.75d0,
 
10907
     .     .8d0,.9d0,1d0/
 
10908
      data qq/1.25d0,1.5d0,2d0,2.5d0,3.2d0,4d0,5d0,6.4d0,8d0,1d1,
 
10909
     .        1.2d1,1.8d1,2.6d1,4d1,6.4d1,1d2,
 
10910
     .        1.6d2,2.4d2,4d2,6.4d2,1d3,1.8d3,3.2d3,5.6d3,1d4,
 
10911
     .        1.8d4,3.2d4,5.6d4,1d5,1.8d5,3.2d5,5.6d5,1d6,
 
10912
     .        1.8d6,3.2d6,5.6d6,1d7/
 
10913
      data xmin,xmax,qsqmin,qsqmax/1d-5,1d0,1.25d0,1d7/
 
10914
      data init/0/
 
10915
      save
 
10916
      xsave=x
 
10917
      q2save=qsq
 
10918
      if(init.ne.0) goto 10
 
10919
c        write(*,*) ' mrstnnlo 3'
 
10920
        open(unit=33,file='vnvalf1155b',status='old')
 
10921
        do 20 n=1,nx-1
 
10922
        do 20 m=1,nq
 
10923
        read(33,50)f1(n,m),f2(n,m),f3(n,m),f4(n,m),
 
10924
     .            f5(n,m),f7(n,m),f6(n,m),f8(n,m)
 
10925
c notation: 1=uval 2=val 3=glue 4=usea 5=chm 6=str 7=btm 8=dsea
 
10926
  20  continue
 
10927
      call mrscheck(f1(1,1),46)
 
10928
      do 40 m=1,nq
 
10929
      f1(nx,m)=0.d0
 
10930
      f2(nx,m)=0.d0
 
10931
      f3(nx,m)=0.d0
 
10932
      f4(nx,m)=0.d0
 
10933
      f5(nx,m)=0.d0
 
10934
      f6(nx,m)=0.d0
 
10935
      f7(nx,m)=0.d0
 
10936
      f8(nx,m)=0.d0
 
10937
  40  continue
 
10938
      do n=1,nx
 
10939
      xxl(n)=dlog(xx(n))
 
10940
      enddo
 
10941
      do m=1,nq
 
10942
      qql(m)=dlog(qq(m))
 
10943
      enddo
 
10944
 
 
10945
      call jeppe1(nx,nq,xxl,qql,f1,cc1)
 
10946
      call jeppe1(nx,nq,xxl,qql,f2,cc2)
 
10947
      call jeppe1(nx,nq,xxl,qql,f3,cc3)
 
10948
      call jeppe1(nx,nq,xxl,qql,f4,cc4)
 
10949
      call jeppe1(nx,nq,xxl,qql,f6,cc6)
 
10950
      call jeppe1(nx,nq,xxl,qql,f8,cc8)
 
10951
 
 
10952
      emc2=2.045
 
10953
      emb2=18.5
 
10954
 
 
10955
      do 44 m=1,nqc
 
10956
      qqlc(m)=qql(m+nqc0)
 
10957
      do 44 n=1,nx
 
10958
      fc(n,m)=f5(n,m+nqc0)
 
10959
   44 continue
 
10960
      qqlc(1)=dlog(emc2)
 
10961
      call jeppe1(nx,nqc,xxl,qqlc,fc,ccc)
 
10962
 
 
10963
      do 45 m=1,nqb
 
10964
      qqlb(m)=qql(m+nqb0)
 
10965
      do 45 n=1,nx
 
10966
      fb(n,m)=f7(n,m+nqb0)
 
10967
   45 continue
 
10968
      qqlb(1)=dlog(emb2)
 
10969
      call jeppe1(nx,nqb,xxl,qqlb,fb,ccb)
 
10970
 
 
10971
 
 
10972
      init=1
 
10973
   10 continue
 
10974
      
 
10975
      xlog=dlog(x)
 
10976
      qsqlog=dlog(qsq)
 
10977
 
 
10978
      call jeppe2(xlog,qsqlog,nx,nq,xxl,qql,cc1,upv)
 
10979
      call jeppe2(xlog,qsqlog,nx,nq,xxl,qql,cc2,dnv)
 
10980
      call jeppe2(xlog,qsqlog,nx,nq,xxl,qql,cc3,glu)
 
10981
      call jeppe2(xlog,qsqlog,nx,nq,xxl,qql,cc4,usea)
 
10982
      call jeppe2(xlog,qsqlog,nx,nq,xxl,qql,cc6,str)
 
10983
      call jeppe2(xlog,qsqlog,nx,nq,xxl,qql,cc8,dsea)
 
10984
 
 
10985
      chm=0.d0
 
10986
      if(qsq.gt.emc2) then 
 
10987
      call jeppe2(xlog,qsqlog,nx,nqc,xxl,qqlc,ccc,chm)
 
10988
      endif
 
10989
 
 
10990
      bot=0.d0
 
10991
      if(qsq.gt.emb2) then 
 
10992
      call jeppe2(xlog,qsqlog,nx,nqb,xxl,qqlb,ccb,bot)
 
10993
      endif
 
10994
 
 
10995
      x=xsave
 
10996
      qsq=q2save
 
10997
      return
 
10998
   50 format(8f10.5)
 
10999
      end
 
11000
 
 
11001
      subroutine mrst40201127(x,qsq,upv,dnv,usea,dsea,str,chm,bot,glu)
 
11002
      implicit real*8(a-h,o-z)
 
11003
      parameter(nx=49,nq=37,np=8,nqc0=2,nqb0=11,nqc=35,nqb=26)
 
11004
      real*8 f1(nx,nq),f2(nx,nq),f3(nx,nq),f4(nx,nq),f5(nx,nq),
 
11005
     .f6(nx,nq),f7(nx,nq),f8(nx,nq),fc(nx,nqc),fb(nx,nqb)
 
11006
      real*8 qq(nq),xx(nx),cc1(nx,nq,4,4),cc2(nx,nq,4,4),
 
11007
     .cc3(nx,nq,4,4),cc4(nx,nq,4,4),cc6(nx,nq,4,4),cc8(nx,nq,4,4),
 
11008
     .ccc(nx,nqc,4,4),ccb(nx,nqb,4,4)
 
11009
      real*8 xxl(nx),qql(nq),qqlc(nqc),qqlb(nqb)
 
11010
      data xx/1d-5,2d-5,4d-5,6d-5,8d-5,
 
11011
     .        1d-4,2d-4,4d-4,6d-4,8d-4,
 
11012
     .        1d-3,2d-3,4d-3,6d-3,8d-3,
 
11013
     .        1d-2,1.4d-2,2d-2,3d-2,4d-2,6d-2,8d-2,
 
11014
     .     .1d0,.125d0,.15d0,.175d0,.2d0,.225d0,.25d0,.275d0,
 
11015
     .     .3d0,.325d0,.35d0,.375d0,.4d0,.425d0,.45d0,.475d0,
 
11016
     .     .5d0,.525d0,.55d0,.575d0,.6d0,.65d0,.7d0,.75d0,
 
11017
     .     .8d0,.9d0,1d0/
 
11018
      data qq/1.25d0,1.5d0,2d0,2.5d0,3.2d0,4d0,5d0,6.4d0,8d0,1d1,
 
11019
     .        1.2d1,1.8d1,2.6d1,4d1,6.4d1,1d2,
 
11020
     .        1.6d2,2.4d2,4d2,6.4d2,1d3,1.8d3,3.2d3,5.6d3,1d4,
 
11021
     .        1.8d4,3.2d4,5.6d4,1d5,1.8d5,3.2d5,5.6d5,1d6,
 
11022
     .        1.8d6,3.2d6,5.6d6,1d7/
 
11023
      data xmin,xmax,qsqmin,qsqmax/1d-5,1d0,1.25d0,1d7/
 
11024
      data init/0/
 
11025
      save
 
11026
      xsave=x
 
11027
      q2save=qsq
 
11028
      if(init.ne.0) goto 10
 
11029
c        write(*,*) ' mrstnnlo 4'
 
11030
        open(unit=33,file='vnvalf1180j',status='old')
 
11031
        do 20 n=1,nx-1
 
11032
        do 20 m=1,nq
 
11033
        read(33,50)f1(n,m),f2(n,m),f3(n,m),f4(n,m),
 
11034
     .            f5(n,m),f7(n,m),f6(n,m),f8(n,m)
 
11035
c notation: 1=uval 2=val 3=glue 4=usea 5=chm 6=str 7=btm 8=dsea
 
11036
  20  continue
 
11037
      call mrscheck(f1(1,1),47)
 
11038
      do 40 m=1,nq
 
11039
      f1(nx,m)=0.d0
 
11040
      f2(nx,m)=0.d0
 
11041
      f3(nx,m)=0.d0
 
11042
      f4(nx,m)=0.d0
 
11043
      f5(nx,m)=0.d0
 
11044
      f6(nx,m)=0.d0
 
11045
      f7(nx,m)=0.d0
 
11046
      f8(nx,m)=0.d0
 
11047
  40  continue
 
11048
      do n=1,nx
 
11049
      xxl(n)=dlog(xx(n))
 
11050
      enddo
 
11051
      do m=1,nq
 
11052
      qql(m)=dlog(qq(m))
 
11053
      enddo
 
11054
 
 
11055
      call jeppe1(nx,nq,xxl,qql,f1,cc1)
 
11056
      call jeppe1(nx,nq,xxl,qql,f2,cc2)
 
11057
      call jeppe1(nx,nq,xxl,qql,f3,cc3)
 
11058
      call jeppe1(nx,nq,xxl,qql,f4,cc4)
 
11059
      call jeppe1(nx,nq,xxl,qql,f6,cc6)
 
11060
      call jeppe1(nx,nq,xxl,qql,f8,cc8)
 
11061
 
 
11062
      emc2=2.045
 
11063
      emb2=18.5
 
11064
 
 
11065
      do 44 m=1,nqc
 
11066
      qqlc(m)=qql(m+nqc0)
 
11067
      do 44 n=1,nx
 
11068
      fc(n,m)=f5(n,m+nqc0)
 
11069
   44 continue
 
11070
      qqlc(1)=dlog(emc2)
 
11071
      call jeppe1(nx,nqc,xxl,qqlc,fc,ccc)
 
11072
 
 
11073
      do 45 m=1,nqb
 
11074
      qqlb(m)=qql(m+nqb0)
 
11075
      do 45 n=1,nx
 
11076
      fb(n,m)=f7(n,m+nqb0)
 
11077
   45 continue
 
11078
      qqlb(1)=dlog(emb2)
 
11079
      call jeppe1(nx,nqb,xxl,qqlb,fb,ccb)
 
11080
 
 
11081
 
 
11082
      init=1
 
11083
   10 continue
 
11084
      
 
11085
      xlog=dlog(x)
 
11086
      qsqlog=dlog(qsq)
 
11087
 
 
11088
      call jeppe2(xlog,qsqlog,nx,nq,xxl,qql,cc1,upv)
 
11089
      call jeppe2(xlog,qsqlog,nx,nq,xxl,qql,cc2,dnv)
 
11090
      call jeppe2(xlog,qsqlog,nx,nq,xxl,qql,cc3,glu)
 
11091
      call jeppe2(xlog,qsqlog,nx,nq,xxl,qql,cc4,usea)
 
11092
      call jeppe2(xlog,qsqlog,nx,nq,xxl,qql,cc6,str)
 
11093
      call jeppe2(xlog,qsqlog,nx,nq,xxl,qql,cc8,dsea)
 
11094
 
 
11095
      chm=0.d0
 
11096
      if(qsq.gt.emc2) then 
 
11097
      call jeppe2(xlog,qsqlog,nx,nqc,xxl,qqlc,ccc,chm)
 
11098
      endif
 
11099
 
 
11100
      bot=0.d0
 
11101
      if(qsq.gt.emb2) then 
 
11102
      call jeppe2(xlog,qsqlog,nx,nqb,xxl,qqlb,ccb,bot)
 
11103
      endif
 
11104
 
 
11105
      x=xsave
 
11106
      qsq=q2save
 
11107
      return
 
11108
   50 format(8f10.5)
 
11109
      end
 
11110
 
 
11111
      subroutine jeppe1(nx,my,xx,yy,ff,cc)
 
11112
      implicit real*8(a-h,o-z)
 
11113
      PARAMETER(NNX=49,MMY=37)
 
11114
      dimension xx(nx),yy(my),ff(nx,my),ff1(NNX,MMY),ff2(NNX,MMY),
 
11115
     xff12(NNX,MMY),yy0(4),yy1(4),yy2(4),yy12(4),z(16),wt(16,16),
 
11116
     xcl(16),cc(nx,my,4,4),iwt(16,16)
 
11117
 
 
11118
      data iwt/1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
 
11119
     x            0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,
 
11120
     x            -3,0,0,3,0,0,0,0,-2,0,0,-1,0,0,0,0,
 
11121
     x            2,0,0,-2,0,0,0,0,1,0,0,1,0,0,0,0,
 
11122
     x            0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,
 
11123
     x            0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,
 
11124
     x            0,0,0,0,-3,0,0,3,0,0,0,0,-2,0,0,-1,
 
11125
     x            0,0,0,0,2,0,0,-2,0,0,0,0,1,0,0,1,
 
11126
     x            -3,3,0,0,-2,-1,0,0,0,0,0,0,0,0,0,0,
 
11127
     x            0,0,0,0,0,0,0,0,-3,3,0,0,-2,-1,0,0,
 
11128
     x            9,-9,9,-9,6,3,-3,-6,6,-6,-3,3,4,2,1,2,
 
11129
     x            -6,6,-6,6,-4,-2,2,4,-3,3,3,-3,-2,-1,-1,-2,
 
11130
     x            2,-2,0,0,1,1,0,0,0,0,0,0,0,0,0,0,
 
11131
     x            0,0,0,0,0,0,0,0,2,-2,0,0,1,1,0,0,
 
11132
     x            -6,6,-6,6,-3,-3,3,3,-4,4,2,-2,-2,-2,-1,-1,
 
11133
     x            4,-4,4,-4,2,2,-2,-2,2,-2,-2,2,1,1,1,1/
 
11134
 
 
11135
 
 
11136
      do 42 m=1,my
 
11137
      dx=xx(2)-xx(1)
 
11138
      ff1(1,m)=(ff(2,m)-ff(1,m))/dx
 
11139
      dx=xx(nx)-xx(nx-1)
 
11140
      ff1(nx,m)=(ff(nx,m)-ff(nx-1,m))/dx
 
11141
      do 41 n=2,nx-1
 
11142
      ff1(n,m)=polderiv(xx(n-1),xx(n),xx(n+1),ff(n-1,m),ff(n,m),
 
11143
     xff(n+1,m))
 
11144
   41 continue
 
11145
   42 continue
 
11146
 
 
11147
      do 44 n=1,nx
 
11148
      dy=yy(2)-yy(1)
 
11149
      ff2(n,1)=(ff(n,2)-ff(n,1))/dy
 
11150
      dy=yy(my)-yy(my-1)
 
11151
      ff2(n,my)=(ff(n,my)-ff(n,my-1))/dy
 
11152
      do 43 m=2,my-1
 
11153
      ff2(n,m)=polderiv(yy(m-1),yy(m),yy(m+1),ff(n,m-1),ff(n,m),
 
11154
     xff(n,m+1))
 
11155
   43 continue
 
11156
   44 continue
 
11157
 
 
11158
      do 46 m=1,my
 
11159
      dx=xx(2)-xx(1)
 
11160
      ff12(1,m)=(ff2(2,m)-ff2(1,m))/dx
 
11161
      dx=xx(nx)-xx(nx-1)
 
11162
      ff12(nx,m)=(ff2(nx,m)-ff2(nx-1,m))/dx
 
11163
      do 45 n=2,nx-1
 
11164
      ff12(n,m)=polderiv(xx(n-1),xx(n),xx(n+1),ff2(n-1,m),ff2(n,m),
 
11165
     xff2(n+1,m))
 
11166
   45 continue
 
11167
   46 continue
 
11168
 
 
11169
      do 53 n=1,nx-1
 
11170
      do 52 m=1,my-1
 
11171
      d1=xx(n+1)-xx(n)
 
11172
      d2=yy(m+1)-yy(m)
 
11173
      d1d2=d1*d2
 
11174
 
 
11175
      yy0(1)=ff(n,m)
 
11176
      yy0(2)=ff(n+1,m)
 
11177
      yy0(3)=ff(n+1,m+1)
 
11178
      yy0(4)=ff(n,m+1)
 
11179
 
 
11180
      yy1(1)=ff1(n,m)
 
11181
      yy1(2)=ff1(n+1,m)
 
11182
      yy1(3)=ff1(n+1,m+1)
 
11183
      yy1(4)=ff1(n,m+1)
 
11184
 
 
11185
      yy2(1)=ff2(n,m)
 
11186
      yy2(2)=ff2(n+1,m)
 
11187
      yy2(3)=ff2(n+1,m+1)
 
11188
      yy2(4)=ff2(n,m+1)
 
11189
 
 
11190
      yy12(1)=ff12(n,m)
 
11191
      yy12(2)=ff12(n+1,m)
 
11192
      yy12(3)=ff12(n+1,m+1)
 
11193
      yy12(4)=ff12(n,m+1)
 
11194
 
 
11195
      do 47 k=1,4
 
11196
      z(k)=yy0(k)
 
11197
      z(k+4)=yy1(k)*d1
 
11198
      z(k+8)=yy2(k)*d2
 
11199
      z(k+12)=yy12(k)*d1d2
 
11200
   47 continue
 
11201
 
 
11202
      do 49 l=1,16
 
11203
      xxd=0.
 
11204
      do 48 k=1,16
 
11205
      xxd=xxd+iwt(k,l)*z(k)
 
11206
   48 continue
 
11207
      cl(l)=xxd
 
11208
   49 continue
 
11209
      l=0
 
11210
      do 51 k=1,4
 
11211
      do 50 j=1,4
 
11212
      l=l+1
 
11213
      cc(n,m,k,j)=cl(l)
 
11214
   50 continue
 
11215
   51 continue
 
11216
   52 continue
 
11217
   53 continue
 
11218
      return
 
11219
      end
 
11220
 
 
11221
      subroutine jeppe2(x,y,nx,my,xx,yy,cc,z)
 
11222
      implicit real*8(a-h,o-z)
 
11223
      dimension xx(nx),yy(my),cc(nx,my,4,4)      
 
11224
 
 
11225
      n=locx(xx,nx,x)
 
11226
      m=locx(yy,my,y)
 
11227
 
 
11228
      t=(x-xx(n))/(xx(n+1)-xx(n))
 
11229
      u=(y-yy(m))/(yy(m+1)-yy(m))
 
11230
 
 
11231
      z=0.
 
11232
      do 1 l=4,1,-1
 
11233
      z=t*z+((cc(n,m,l,4)*u+cc(n,m,l,3))*u
 
11234
     .       +cc(n,m,l,2))*u+cc(n,m,l,1)
 
11235
    1 continue
 
11236
      return
 
11237
      end
 
11238
 
 
11239
      integer function locx(xx,nx,x)
 
11240
      implicit real*8(a-h,o-z)
 
11241
      dimension xx(nx)
 
11242
      if(x.le.xx(1)) then
 
11243
      locx=1
 
11244
      return
 
11245
      endif
 
11246
      if(x.ge.xx(nx)) then 
 
11247
      locx=nx-1  
 
11248
      return
 
11249
      endif
 
11250
      ju=nx+1
 
11251
      jl=0
 
11252
    1 if((ju-jl).le.1) go to 2
 
11253
      jm=(ju+jl)/2
 
11254
      if(x.ge.xx(jm)) then
 
11255
      jl=jm
 
11256
      else
 
11257
      ju=jm
 
11258
      endif
 
11259
      go to 1
 
11260
    2 locx=jl
 
11261
      return
 
11262
      end
 
11263
 
 
11264
 
 
11265
      real*8 function  polderiv(x1,x2,x3,y1,y2,y3)
 
11266
      implicit real*8(a-h,o-z)
 
11267
      polderiv=(x3*x3*(y1-y2)-2.0*x2*(x3*(y1-y2)+x1*
 
11268
     .(y2-y3))+x2*x2*(y1-y3)+x1*x1*(y2-y3))/((x1-x2)*(x1-x3)*(x2-x3))
 
11269
      return
 
11270
      end
 
11271
c END MRSTNNLO (2002) 
 
11272
 
 
11273
 
 
11274
      subroutine mrst2001E(x,q,n,upv,dnv,usea,dsea,str,chm,bot,glu)
 
11275
C***************************************************************C
 
11276
C                                                               C
 
11277
C  This is a package for the new MRST 2001 "NLO parton          C
 
11278
C  distributions with errors" package, which allows estimates   C
 
11279
C  of the uncertainties for given physical quantities according C
 
11280
C  to the Hessian approach                                      C     
 
11281
C  Reference: A.D. Martin, R.G. Roberts, W.J. Stirling and      C
 
11282
C  R.S. Thorne, hep-ph/0211080                                  C
 
11283
C                                                               C
 
11284
C  There are 30 pdf "extremum" sets ("+" and "-" sets for each  C
 
11285
C  of the 15 eigenvectors in parameter space) corresponding to  C
 
11286
C  n = 1, ..,30 and a central "best fit" set given by n = 0.    C
 
11287
C  The best fit set is very close to the previous MRST2001 set. C
 
11288
C                                                               C
 
11289
C  For a given physical quantity sigma(n) calculated with set n C
 
11290
C  the prediction with error is therefore                       C
 
11291
C                                                               C
 
11292
C sigma(0) +- 1/2 sqrt[sum_i=1,15 {sigma(2i-1) - sigma(2i)}^2 ] C
 
11293
C                                                               C
 
11294
C  All 31 sets have Lambda(MSbar,nf=4) = 323 MeV corresponding  C
 
11295
C  to alpha_s(M_Z) = 0.119                                      C
 
11296
C                                                               C
 
11297
C  The 31 grids are concatenated in mrst01E_hessian.dat - the   C
 
11298
C  first row of which is                                        C
 
11299
C                                                               C
 
11300
C   0.00959   0.00189 -10.10634   0.85204   0.00000  ...        C
 
11301
C                                                               C
 
11302
C   This subroutine uses an improved interpolation procedure    C 
 
11303
C   for extracting values of the pdf's from the grid            C
 
11304
C                                                               C
 
11305
C         Comments to : W.J.Stirling@durham.ac.uk               C
 
11306
C                                                               C
 
11307
C***************************************************************C
 
11308
      implicit real*8(a-h,o-z)
 
11309
      data xmin,xmax,qsqmin,qsqmax/1d-5,1d0,1.25d0,1d7/
 
11310
      q2=q*q
 
11311
c      if(q2.lt.qsqmin.or.q2.gt.qsqmax) print 99,q2
 
11312
c      if(x.lt.xmin.or.x.gt.xmax)       print 98,x
 
11313
      call mrst2001EE(n,x,q2,upv,dnv,usea,dsea,str,chm,bot,glu) 
 
11314
  99  format('  WARNING:  Q^2 VALUE IS OUT OF RANGE   ','q2= ',e10.5)
 
11315
  98  format('  WARNING:   X  VALUE IS OUT OF RANGE   ','x= ',e10.5)
 
11316
      return
 
11317
      end
 
11318
 
 
11319
      subroutine mrst2001EE(i,x,qsq,upv,dnv,usea,dsea,str,chm,bot,glu)
 
11320
      implicit real*8(a-h,o-z)
 
11321
      parameter(nhess=30,nx=49,nq=37,np=8,nqc0=2,nqb0=11,nqc=35,nqb=26)
 
11322
      real*8 f1(nx,nq),f2(nx,nq),f3(nx,nq),
 
11323
     .       f4(nx,nq),f5(nx,nq),f6(nx,nq),
 
11324
     .       f7(nx,nq),f8(nx,nq),
 
11325
     .       fc(nx,nqc),fb(nx,nqb)
 
11326
      real*8 qq(nq),xx(nx),
 
11327
     .cc1(0:nhess,nx,nq,4,4),cc2(0:nhess,nx,nq,4,4),
 
11328
     .cc3(0:nhess,nx,nq,4,4),cc4(0:nhess,nx,nq,4,4),
 
11329
     .cc6(0:nhess,nx,nq,4,4),cc8(0:nhess,nx,nq,4,4),
 
11330
     .ccc(0:nhess,nx,nqc,4,4),ccb(0:nhess,nx,nqb,4,4)
 
11331
      real*8 xxl(nx),qql(nq),qqlc(nqc),qqlb(nqb)
 
11332
      data xx/1d-5,2d-5,4d-5,6d-5,8d-5,
 
11333
     .        1d-4,2d-4,4d-4,6d-4,8d-4,
 
11334
     .        1d-3,2d-3,4d-3,6d-3,8d-3,
 
11335
     .        1d-2,1.4d-2,2d-2,3d-2,4d-2,6d-2,8d-2,
 
11336
     .     .1d0,.125d0,.15d0,.175d0,.2d0,.225d0,.25d0,.275d0,
 
11337
     .     .3d0,.325d0,.35d0,.375d0,.4d0,.425d0,.45d0,.475d0,
 
11338
     .     .5d0,.525d0,.55d0,.575d0,.6d0,.65d0,.7d0,.75d0,
 
11339
     .     .8d0,.9d0,1d0/
 
11340
      data qq/1.25d0,1.5d0,2d0,2.5d0,3.2d0,4d0,5d0,6.4d0,8d0,1d1,
 
11341
     .        1.2d1,1.8d1,2.6d1,4d1,6.4d1,1d2,
 
11342
     .        1.6d2,2.4d2,4d2,6.4d2,1d3,1.8d3,3.2d3,5.6d3,1d4,
 
11343
     .        1.8d4,3.2d4,5.6d4,1d5,1.8d5,3.2d5,5.6d5,1d6,
 
11344
     .        1.8d6,3.2d6,5.6d6,1d7/
 
11345
      data xmin,xmax,qsqmin,qsqmax/1d-5,1d0,1.25d0,1d7/
 
11346
      data init/0/
 
11347
      save
 
11348
      xsave=x
 
11349
      q2save=qsq
 
11350
      if(init.ne.0) goto 10
 
11351
 
 
11352
      do n=1,nx
 
11353
      xxl(n)=dlog(xx(n))
 
11354
      enddo
 
11355
      do m=1,nq
 
11356
      qql(m)=dlog(qq(m))
 
11357
      enddo
 
11358
 
 
11359
        open(unit=33,file='mrst2001E_hessian',status='old')
 
11360
        do j=0,nhess
 
11361
 
 
11362
        do n=1,nx-1
 
11363
        do m=1,nq
 
11364
        read(33,50)f1(n,m),f2(n,m),f3(n,m),f4(n,m),
 
11365
     .            f5(n,m),f7(n,m),f6(n,m),f8(n,m)
 
11366
c notation: 1=uval 2=val 3=glue 4=usea 5=chm 6=str 7=btm 8=dsea
 
11367
        enddo
 
11368
        enddo
 
11369
 
 
11370
      do m=1,nq
 
11371
      f1(nx,m)=0.d0
 
11372
      f2(nx,m)=0.d0
 
11373
      f3(nx,m)=0.d0
 
11374
      f4(nx,m)=0.d0
 
11375
      f5(nx,m)=0.d0
 
11376
      f6(nx,m)=0.d0
 
11377
      f7(nx,m)=0.d0
 
11378
      f8(nx,m)=0.d0
 
11379
      enddo
 
11380
 
 
11381
      call jeppe3001E1(j,nx,nq,xxl,qql,f1,cc1)
 
11382
      call jeppe3001E1(j,nx,nq,xxl,qql,f2,cc2)
 
11383
      call jeppe3001E1(j,nx,nq,xxl,qql,f3,cc3)
 
11384
      call jeppe3001E1(j,nx,nq,xxl,qql,f4,cc4)
 
11385
      call jeppe3001E1(j,nx,nq,xxl,qql,f6,cc6)
 
11386
      call jeppe3001E1(j,nx,nq,xxl,qql,f8,cc8)
 
11387
 
 
11388
      emc2=2.045
 
11389
      emb2=18.5
 
11390
 
 
11391
      do 44 m=1,nqc
 
11392
      qqlc(m)=qql(m+nqc0)
 
11393
      do 44 n=1,nx
 
11394
      fc(n,m)=f5(n,m+nqc0)
 
11395
   44 continue
 
11396
      qqlc(1)=dlog(emc2)
 
11397
      call jeppe3001E1(j,nx,nqc,xxl,qqlc,fc,ccc)
 
11398
 
 
11399
      do 45 m=1,nqb
 
11400
      qqlb(m)=qql(m+nqb0)
 
11401
      do 45 n=1,nx
 
11402
      fb(n,m)=f7(n,m+nqb0)
 
11403
   45 continue
 
11404
      qqlb(1)=dlog(emb2)
 
11405
      call jeppe3001E1(j,nx,nqb,xxl,qqlb,fb,ccb)
 
11406
 
 
11407
      enddo
 
11408
 
 
11409
      init=1
 
11410
   10 continue
 
11411
      
 
11412
      xlog=dlog(x)
 
11413
      qsqlog=dlog(qsq)
 
11414
 
 
11415
      call jeppe3001E2(i,xlog,qsqlog,nx,nq,xxl,qql,cc1,upv)
 
11416
      call jeppe3001E2(i,xlog,qsqlog,nx,nq,xxl,qql,cc2,dnv)
 
11417
      call jeppe3001E2(i,xlog,qsqlog,nx,nq,xxl,qql,cc3,glu)
 
11418
      call jeppe3001E2(i,xlog,qsqlog,nx,nq,xxl,qql,cc4,usea)
 
11419
      call jeppe3001E2(i,xlog,qsqlog,nx,nq,xxl,qql,cc6,str)
 
11420
      call jeppe3001E2(i,xlog,qsqlog,nx,nq,xxl,qql,cc8,dsea)
 
11421
 
 
11422
      chm=0.d0
 
11423
      if(qsq.gt.emc2) then 
 
11424
      call jeppe3001E2(i,xlog,qsqlog,nx,nqc,xxl,qqlc,ccc,chm)
 
11425
      endif
 
11426
 
 
11427
      bot=0.d0
 
11428
      if(qsq.gt.emb2) then 
 
11429
      call jeppe3001E2(i,xlog,qsqlog,nx,nqb,xxl,qqlb,ccb,bot)
 
11430
      endif
 
11431
 
 
11432
      x=xsave
 
11433
      qsq=q2save
 
11434
      return
 
11435
   50 format(8f10.5)
 
11436
      end
 
11437
 
 
11438
 
 
11439
 
 
11440
 
 
11441
      subroutine jeppe3001E1(i,nx,my,xx,yy,ff,cc)
 
11442
      implicit real*8(a-h,o-z)
 
11443
      parameter(nhess=30,nnx=49,mmy=37)
 
11444
      dimension xx(nx),yy(my),ff(nnx,mmy),ff1(nnx,mmy),ff2(nnx,mmy),
 
11445
     xff12(nnx,mmy),yy0(4),yy1(4),yy2(4),yy12(4),z(16),wt(16,16),
 
11446
     xcl(16),cc(0:nhess,nx,my,4,4),iwt(16,16)
 
11447
 
 
11448
      data iwt/1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
 
11449
     x            0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,
 
11450
     x            -3,0,0,3,0,0,0,0,-2,0,0,-1,0,0,0,0,
 
11451
     x            2,0,0,-2,0,0,0,0,1,0,0,1,0,0,0,0,
 
11452
     x            0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,
 
11453
     x            0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,
 
11454
     x            0,0,0,0,-3,0,0,3,0,0,0,0,-2,0,0,-1,
 
11455
     x            0,0,0,0,2,0,0,-2,0,0,0,0,1,0,0,1,
 
11456
     x            -3,3,0,0,-2,-1,0,0,0,0,0,0,0,0,0,0,
 
11457
     x            0,0,0,0,0,0,0,0,-3,3,0,0,-2,-1,0,0,
 
11458
     x            9,-9,9,-9,6,3,-3,-6,6,-6,-3,3,4,2,1,2,
 
11459
     x            -6,6,-6,6,-4,-2,2,4,-3,3,3,-3,-2,-1,-1,-2,
 
11460
     x            2,-2,0,0,1,1,0,0,0,0,0,0,0,0,0,0,
 
11461
     x            0,0,0,0,0,0,0,0,2,-2,0,0,1,1,0,0,
 
11462
     x            -6,6,-6,6,-3,-3,3,3,-4,4,2,-2,-2,-2,-1,-1,
 
11463
     x            4,-4,4,-4,2,2,-2,-2,2,-2,-2,2,1,1,1,1/
 
11464
 
 
11465
 
 
11466
      do 42 m=1,my
 
11467
      dx=xx(2)-xx(1)
 
11468
      ff1(1,m)=(ff(2,m)-ff(1,m))/dx
 
11469
      dx=xx(nx)-xx(nx-1)
 
11470
      ff1(nx,m)=(ff(nx,m)-ff(nx-1,m))/dx
 
11471
      do 41 n=2,nx-1
 
11472
      ff1(n,m)=polderiv2001E(xx(n-1),xx(n),xx(n+1),ff(n-1,m),ff(n,m),
 
11473
     xff(n+1,m))
 
11474
   41 continue
 
11475
   42 continue
 
11476
 
 
11477
      do 44 n=1,nx
 
11478
      dy=yy(2)-yy(1)
 
11479
      ff2(n,1)=(ff(n,2)-ff(n,1))/dy
 
11480
      dy=yy(my)-yy(my-1)
 
11481
      ff2(n,my)=(ff(n,my)-ff(n,my-1))/dy
 
11482
      do 43 m=2,my-1
 
11483
      ff2(n,m)=polderiv2001E(yy(m-1),yy(m),yy(m+1),ff(n,m-1),ff(n,m),
 
11484
     xff(n,m+1))
 
11485
   43 continue
 
11486
   44 continue
 
11487
 
 
11488
      do 46 m=1,my
 
11489
      dx=xx(2)-xx(1)
 
11490
      ff12(1,m)=(ff2(2,m)-ff2(1,m))/dx
 
11491
      dx=xx(nx)-xx(nx-1)
 
11492
      ff12(nx,m)=(ff2(nx,m)-ff2(nx-1,m))/dx
 
11493
      do 45 n=2,nx-1
 
11494
      ff12(n,m)=polderiv2001E(xx(n-1),xx(n),xx(n+1),ff2(n-1,m),ff2(n,m),
 
11495
     xff2(n+1,m))
 
11496
   45 continue
 
11497
   46 continue
 
11498
 
 
11499
      do 53 n=1,nx-1
 
11500
      do 52 m=1,my-1
 
11501
      d1=xx(n+1)-xx(n)
 
11502
      d2=yy(m+1)-yy(m)
 
11503
      d1d2=d1*d2
 
11504
 
 
11505
      yy0(1)=ff(n,m)
 
11506
      yy0(2)=ff(n+1,m)
 
11507
      yy0(3)=ff(n+1,m+1)
 
11508
      yy0(4)=ff(n,m+1)
 
11509
 
 
11510
      yy1(1)=ff1(n,m)
 
11511
      yy1(2)=ff1(n+1,m)
 
11512
      yy1(3)=ff1(n+1,m+1)
 
11513
      yy1(4)=ff1(n,m+1)
 
11514
 
 
11515
      yy2(1)=ff2(n,m)
 
11516
      yy2(2)=ff2(n+1,m)
 
11517
      yy2(3)=ff2(n+1,m+1)
 
11518
      yy2(4)=ff2(n,m+1)
 
11519
 
 
11520
      yy12(1)=ff12(n,m)
 
11521
      yy12(2)=ff12(n+1,m)
 
11522
      yy12(3)=ff12(n+1,m+1)
 
11523
      yy12(4)=ff12(n,m+1)
 
11524
 
 
11525
      do 47 k=1,4
 
11526
      z(k)=yy0(k)
 
11527
      z(k+4)=yy1(k)*d1
 
11528
      z(k+8)=yy2(k)*d2
 
11529
      z(k+12)=yy12(k)*d1d2
 
11530
   47 continue
 
11531
 
 
11532
      do 49 l=1,16
 
11533
      xxd=0.
 
11534
      do 48 k=1,16
 
11535
      xxd=xxd+iwt(k,l)*z(k)
 
11536
   48 continue
 
11537
      cl(l)=xxd
 
11538
   49 continue
 
11539
      l=0
 
11540
      do 51 k=1,4
 
11541
      do 50 j=1,4
 
11542
      l=l+1
 
11543
      cc(i,n,m,k,j)=cl(l)
 
11544
   50 continue
 
11545
   51 continue
 
11546
   52 continue
 
11547
   53 continue
 
11548
      return
 
11549
      end
 
11550
 
 
11551
      subroutine jeppe3001E2(i,x,y,nx,my,xx,yy,cc,z)
 
11552
      implicit real*8(a-h,o-z)
 
11553
      parameter(nhess=30)
 
11554
      dimension xx(nx),yy(my),cc(0:nhess,nx,my,4,4)      
 
11555
 
 
11556
      n=locx2001E(xx,nx,x)
 
11557
      m=locx2001E(yy,my,y)
 
11558
 
 
11559
      t=(x-xx(n))/(xx(n+1)-xx(n))
 
11560
      u=(y-yy(m))/(yy(m+1)-yy(m))
 
11561
 
 
11562
      z=0.
 
11563
      do 1 l=4,1,-1
 
11564
      z=t*z+((cc(i,n,m,l,4)*u+cc(i,n,m,l,3))*u
 
11565
     .       +cc(i,n,m,l,2))*u+cc(i,n,m,l,1)
 
11566
    1 continue
 
11567
      return
 
11568
      end
 
11569
 
 
11570
      integer function locx2001E(xx,nx,x)
 
11571
      implicit real*8(a-h,o-z)
 
11572
      dimension xx(nx)
 
11573
      if(x.le.xx(1)) then
 
11574
      locx2001E=1
 
11575
      return
 
11576
      endif
 
11577
      if(x.ge.xx(nx)) then 
 
11578
      locx2001E=nx-1  
 
11579
      return
 
11580
      endif
 
11581
      ju=nx+1
 
11582
      jl=0
 
11583
    1 if((ju-jl).le.1) go to 2
 
11584
      jm=(ju+jl)/2
 
11585
      if(x.ge.xx(jm)) then
 
11586
      jl=jm
 
11587
      else
 
11588
      ju=jm
 
11589
      endif
 
11590
      go to 1
 
11591
    2 locx2001E=jl
 
11592
      return
 
11593
      end
 
11594
 
 
11595
 
 
11596
      real*8 function  polderiv2001E(x1,x2,x3,y1,y2,y3)
 
11597
      implicit real*8(a-h,o-z)
 
11598
      polderiv2001E=(x3*x3*(y1-y2)-2.0*x2*(x3*(y1-y2)+x1*
 
11599
     .(y2-y3))+x2*x2*(y1-y3)+x1*x1*(y2-y3))/((x1-x2)*(x1-x3)*(x2-x3))
 
11600
      return
 
11601
      end
 
11602
 
 
11603
 
 
11604
 
 
11605
      subroutine mrst2002(x,q,mode,upv,dnv,usea,dsea,str,chm,bot,glu)
 
11606
C***************************************************************C
 
11607
C                                                               C
 
11608
C  This is a package for the new MRST 2002 updated NLO and      C
 
11609
C  NNLO parton distributions.                                   C 
 
11610
C  Reference: A.D. Martin, R.G. Roberts, W.J. Stirling and      C
 
11611
C  R.S. Thorne, hep-ph/0211080                                  C
 
11612
C                                                               C
 
11613
C  There are 2 pdf sets corresponding to mode = 1, 2            C
 
11614
C                                                               C
 
11615
C  Mode=1 gives the NLO set with alpha_s(M_Z,NLO) = 0.1197      C  
 
11616
C  This set reads a grid whose first number is 0.00949          C
 
11617
C                                                               C
 
11618
C  Mode=2 gives the NNLO set with alpha_s(M_Z,NNLO) = 0.1154    C
 
11619
C  This set reads a grid whose first number is 0.00685          C
 
11620
C                                                               C
 
11621
C         Comments to : W.J.Stirling@durham.ac.uk               C
 
11622
C                                                               C
 
11623
C***************************************************************C
 
11624
      implicit real*8(a-h,o-z)
 
11625
      data xmin,xmax,qsqmin,qsqmax/1d-5,1d0,1.25d0,1d7/
 
11626
      q2=q*q
 
11627
c      if(q2.lt.qsqmin.or.q2.gt.qsqmax) print 99,q2
 
11628
c      if(x.lt.xmin.or.x.gt.xmax)       print 98,x
 
11629
      if(mode.eq.1) then
 
11630
        call mrst2002_1(x,q2,upv,dnv,usea,dsea,str,chm,bot,glu) 
 
11631
      elseif(mode.eq.2) then
 
11632
        call mrst2002_2(x,q2,upv,dnv,usea,dsea,str,chm,bot,glu) 
 
11633
      endif 
 
11634
  99  format('  WARNING:  Q^2 VALUE IS OUT OF RANGE   ','q2= ',e10.5)
 
11635
  98  format('  WARNING:   X  VALUE IS OUT OF RANGE   ','x= ',e10.5)
 
11636
      return
 
11637
      end
 
11638
 
 
11639
      subroutine mrst2002_1(x,qsq,upv,dnv,usea,dsea,str,chm,bot,glu)
 
11640
      implicit real*8(a-h,o-z)
 
11641
      parameter(nx=49,nq=37,np=8,nqc0=2,nqb0=11,nqc=35,nqb=26)
 
11642
      real*8 f1(nx,nq),f2(nx,nq),f3(nx,nq),f4(nx,nq),f5(nx,nq),
 
11643
     .f6(nx,nq),f7(nx,nq),f8(nx,nq),fc(nx,nqc),fb(nx,nqb)
 
11644
      real*8 qq(nq),xx(nx),cc1(nx,nq,4,4),cc2(nx,nq,4,4),
 
11645
     .cc3(nx,nq,4,4),cc4(nx,nq,4,4),cc6(nx,nq,4,4),cc8(nx,nq,4,4),
 
11646
     .ccc(nx,nqc,4,4),ccb(nx,nqb,4,4)
 
11647
      real*8 xxl(nx),qql(nq),qqlc(nqc),qqlb(nqb)
 
11648
      data xx/1d-5,2d-5,4d-5,6d-5,8d-5,
 
11649
     .        1d-4,2d-4,4d-4,6d-4,8d-4,
 
11650
     .        1d-3,2d-3,4d-3,6d-3,8d-3,
 
11651
     .        1d-2,1.4d-2,2d-2,3d-2,4d-2,6d-2,8d-2,
 
11652
     .     .1d0,.125d0,.15d0,.175d0,.2d0,.225d0,.25d0,.275d0,
 
11653
     .     .3d0,.325d0,.35d0,.375d0,.4d0,.425d0,.45d0,.475d0,
 
11654
     .     .5d0,.525d0,.55d0,.575d0,.6d0,.65d0,.7d0,.75d0,
 
11655
     .     .8d0,.9d0,1d0/
 
11656
      data qq/1.25d0,1.5d0,2d0,2.5d0,3.2d0,4d0,5d0,6.4d0,8d0,1d1,
 
11657
     .        1.2d1,1.8d1,2.6d1,4d1,6.4d1,1d2,
 
11658
     .        1.6d2,2.4d2,4d2,6.4d2,1d3,1.8d3,3.2d3,5.6d3,1d4,
 
11659
     .        1.8d4,3.2d4,5.6d4,1d5,1.8d5,3.2d5,5.6d5,1d6,
 
11660
     .        1.8d6,3.2d6,5.6d6,1d7/
 
11661
      data xmin,xmax,qsqmin,qsqmax/1d-5,1d0,1.25d0,1d7/
 
11662
      data init/0/
 
11663
      save
 
11664
      xsave=x
 
11665
      q2save=qsq
 
11666
      if(init.ne.0) goto 10
 
11667
        open(unit=33,file='mrst2002nlo',status='old')
 
11668
        do 20 n=1,nx-1
 
11669
        do 20 m=1,nq
 
11670
        read(33,50)f1(n,m),f2(n,m),f3(n,m),f4(n,m),
 
11671
     .            f5(n,m),f7(n,m),f6(n,m),f8(n,m)
 
11672
c notation: 1=uval 2=val 3=glue 4=usea 5=chm 6=str 7=btm 8=dsea
 
11673
  20  continue
 
11674
      do 40 m=1,nq
 
11675
      f1(nx,m)=0.d0
 
11676
      f2(nx,m)=0.d0
 
11677
      f3(nx,m)=0.d0
 
11678
      f4(nx,m)=0.d0
 
11679
      f5(nx,m)=0.d0
 
11680
      f6(nx,m)=0.d0
 
11681
      f7(nx,m)=0.d0
 
11682
      f8(nx,m)=0.d0
 
11683
  40  continue
 
11684
      do n=1,nx
 
11685
      xxl(n)=dlog(xx(n))
 
11686
      enddo
 
11687
      do m=1,nq
 
11688
      qql(m)=dlog(qq(m))
 
11689
      enddo
 
11690
 
 
11691
      call jeppe2002_1(nx,nq,xxl,qql,f1,cc1)
 
11692
      call jeppe2002_1(nx,nq,xxl,qql,f2,cc2)
 
11693
      call jeppe2002_1(nx,nq,xxl,qql,f3,cc3)
 
11694
      call jeppe2002_1(nx,nq,xxl,qql,f4,cc4)
 
11695
      call jeppe2002_1(nx,nq,xxl,qql,f6,cc6)
 
11696
      call jeppe2002_1(nx,nq,xxl,qql,f8,cc8)
 
11697
 
 
11698
      emc2=2.045
 
11699
      emb2=18.5
 
11700
 
 
11701
      do 44 m=1,nqc
 
11702
      qqlc(m)=qql(m+nqc0)
 
11703
      do 44 n=1,nx
 
11704
      fc(n,m)=f5(n,m+nqc0)
 
11705
   44 continue
 
11706
      qqlc(1)=dlog(emc2)
 
11707
      call jeppe2002_1(nx,nqc,xxl,qqlc,fc,ccc)
 
11708
 
 
11709
      do 45 m=1,nqb
 
11710
      qqlb(m)=qql(m+nqb0)
 
11711
      do 45 n=1,nx
 
11712
      fb(n,m)=f7(n,m+nqb0)
 
11713
   45 continue
 
11714
      qqlb(1)=dlog(emb2)
 
11715
      call jeppe2002_1(nx,nqb,xxl,qqlb,fb,ccb)
 
11716
 
 
11717
 
 
11718
      init=1
 
11719
   10 continue
 
11720
      
 
11721
      xlog=dlog(x)
 
11722
      qsqlog=dlog(qsq)
 
11723
 
 
11724
      call jeppe2002_2(xlog,qsqlog,nx,nq,xxl,qql,cc1,upv)
 
11725
      call jeppe2002_2(xlog,qsqlog,nx,nq,xxl,qql,cc2,dnv)
 
11726
      call jeppe2002_2(xlog,qsqlog,nx,nq,xxl,qql,cc3,glu)
 
11727
      call jeppe2002_2(xlog,qsqlog,nx,nq,xxl,qql,cc4,usea)
 
11728
      call jeppe2002_2(xlog,qsqlog,nx,nq,xxl,qql,cc6,str)
 
11729
      call jeppe2002_2(xlog,qsqlog,nx,nq,xxl,qql,cc8,dsea)
 
11730
 
 
11731
      chm=0.d0
 
11732
      if(qsq.gt.emc2) then 
 
11733
      call jeppe2002_2(xlog,qsqlog,nx,nqc,xxl,qqlc,ccc,chm)
 
11734
      endif
 
11735
 
 
11736
      bot=0.d0
 
11737
      if(qsq.gt.emb2) then 
 
11738
      call jeppe2002_2(xlog,qsqlog,nx,nqb,xxl,qqlb,ccb,bot)
 
11739
      endif
 
11740
 
 
11741
      x=xsave
 
11742
      qsq=q2save
 
11743
      return
 
11744
   50 format(8f10.5)
 
11745
      end
 
11746
 
 
11747
      subroutine mrst2002_2(x,qsq,upv,dnv,usea,dsea,str,chm,bot,glu)
 
11748
      implicit real*8(a-h,o-z)
 
11749
      parameter(nx=49,nq=37,np=8,nqc0=2,nqb0=11,nqc=35,nqb=26)
 
11750
      real*8 f1(nx,nq),f2(nx,nq),f3(nx,nq),f4(nx,nq),f5(nx,nq),
 
11751
     .f6(nx,nq),f7(nx,nq),f8(nx,nq),fc(nx,nqc),fb(nx,nqb)
 
11752
      real*8 qq(nq),xx(nx),cc1(nx,nq,4,4),cc2(nx,nq,4,4),
 
11753
     .cc3(nx,nq,4,4),cc4(nx,nq,4,4),cc6(nx,nq,4,4),cc8(nx,nq,4,4),
 
11754
     .ccc(nx,nqc,4,4),ccb(nx,nqb,4,4)
 
11755
      real*8 xxl(nx),qql(nq),qqlc(nqc),qqlb(nqb)
 
11756
      data xx/1d-5,2d-5,4d-5,6d-5,8d-5,
 
11757
     .        1d-4,2d-4,4d-4,6d-4,8d-4,
 
11758
     .        1d-3,2d-3,4d-3,6d-3,8d-3,
 
11759
     .        1d-2,1.4d-2,2d-2,3d-2,4d-2,6d-2,8d-2,
 
11760
     .     .1d0,.125d0,.15d0,.175d0,.2d0,.225d0,.25d0,.275d0,
 
11761
     .     .3d0,.325d0,.35d0,.375d0,.4d0,.425d0,.45d0,.475d0,
 
11762
     .     .5d0,.525d0,.55d0,.575d0,.6d0,.65d0,.7d0,.75d0,
 
11763
     .     .8d0,.9d0,1d0/
 
11764
      data qq/1.25d0,1.5d0,2d0,2.5d0,3.2d0,4d0,5d0,6.4d0,8d0,1d1,
 
11765
     .        1.2d1,1.8d1,2.6d1,4d1,6.4d1,1d2,
 
11766
     .        1.6d2,2.4d2,4d2,6.4d2,1d3,1.8d3,3.2d3,5.6d3,1d4,
 
11767
     .        1.8d4,3.2d4,5.6d4,1d5,1.8d5,3.2d5,5.6d5,1d6,
 
11768
     .        1.8d6,3.2d6,5.6d6,1d7/
 
11769
      data xmin,xmax,qsqmin,qsqmax/1d-5,1d0,1.25d0,1d7/
 
11770
      data init/0/
 
11771
      save
 
11772
      xsave=x
 
11773
      q2save=qsq
 
11774
      if(init.ne.0) goto 10
 
11775
        open(unit=33,file='mrst2002nnlo',status='old')
 
11776
        do 20 n=1,nx-1
 
11777
        do 20 m=1,nq
 
11778
        read(33,50)f1(n,m),f2(n,m),f3(n,m),f4(n,m),
 
11779
     .            f5(n,m),f7(n,m),f6(n,m),f8(n,m)
 
11780
c notation: 1=uval 2=val 3=glue 4=usea 5=chm 6=str 7=btm 8=dsea
 
11781
  20  continue
 
11782
      do 40 m=1,nq
 
11783
      f1(nx,m)=0.d0
 
11784
      f2(nx,m)=0.d0
 
11785
      f3(nx,m)=0.d0
 
11786
      f4(nx,m)=0.d0
 
11787
      f5(nx,m)=0.d0
 
11788
      f6(nx,m)=0.d0
 
11789
      f7(nx,m)=0.d0
 
11790
      f8(nx,m)=0.d0
 
11791
  40  continue
 
11792
      do n=1,nx
 
11793
      xxl(n)=dlog(xx(n))
 
11794
      enddo
 
11795
      do m=1,nq
 
11796
      qql(m)=dlog(qq(m))
 
11797
      enddo
 
11798
 
 
11799
      call jeppe2002_1(nx,nq,xxl,qql,f1,cc1)
 
11800
      call jeppe2002_1(nx,nq,xxl,qql,f2,cc2)
 
11801
      call jeppe2002_1(nx,nq,xxl,qql,f3,cc3)
 
11802
      call jeppe2002_1(nx,nq,xxl,qql,f4,cc4)
 
11803
      call jeppe2002_1(nx,nq,xxl,qql,f6,cc6)
 
11804
      call jeppe2002_1(nx,nq,xxl,qql,f8,cc8)
 
11805
 
 
11806
      emc2=2.045
 
11807
      emb2=18.5
 
11808
 
 
11809
      do 44 m=1,nqc
 
11810
      qqlc(m)=qql(m+nqc0)
 
11811
      do 44 n=1,nx
 
11812
      fc(n,m)=f5(n,m+nqc0)
 
11813
   44 continue
 
11814
      qqlc(1)=dlog(emc2)
 
11815
      call jeppe2002_1(nx,nqc,xxl,qqlc,fc,ccc)
 
11816
 
 
11817
      do 45 m=1,nqb
 
11818
      qqlb(m)=qql(m+nqb0)
 
11819
      do 45 n=1,nx
 
11820
      fb(n,m)=f7(n,m+nqb0)
 
11821
   45 continue
 
11822
      qqlb(1)=dlog(emb2)
 
11823
      call jeppe2002_1(nx,nqb,xxl,qqlb,fb,ccb)
 
11824
 
 
11825
 
 
11826
      init=1
 
11827
   10 continue
 
11828
      
 
11829
      xlog=dlog(x)
 
11830
      qsqlog=dlog(qsq)
 
11831
 
 
11832
      call jeppe2002_2(xlog,qsqlog,nx,nq,xxl,qql,cc1,upv)
 
11833
      call jeppe2002_2(xlog,qsqlog,nx,nq,xxl,qql,cc2,dnv)
 
11834
      call jeppe2002_2(xlog,qsqlog,nx,nq,xxl,qql,cc3,glu)
 
11835
      call jeppe2002_2(xlog,qsqlog,nx,nq,xxl,qql,cc4,usea)
 
11836
      call jeppe2002_2(xlog,qsqlog,nx,nq,xxl,qql,cc6,str)
 
11837
      call jeppe2002_2(xlog,qsqlog,nx,nq,xxl,qql,cc8,dsea)
 
11838
 
 
11839
      chm=0.d0
 
11840
      if(qsq.gt.emc2) then 
 
11841
      call jeppe2002_2(xlog,qsqlog,nx,nqc,xxl,qqlc,ccc,chm)
 
11842
      endif
 
11843
 
 
11844
      bot=0.d0
 
11845
      if(qsq.gt.emb2) then 
 
11846
      call jeppe2002_2(xlog,qsqlog,nx,nqb,xxl,qqlb,ccb,bot)
 
11847
      endif
 
11848
 
 
11849
      x=xsave
 
11850
      qsq=q2save
 
11851
      return
 
11852
   50 format(8f10.5)
 
11853
      end
 
11854
      subroutine jeppe2002_1(nx,my,xx,yy,ff,cc)
 
11855
      implicit real*8(a-h,o-z)
 
11856
      parameter(nnx=49,mmy=37)
 
11857
      dimension xx(nx),yy(my),ff(nnx,mmy),ff1(nnx,mmy),ff2(nnx,mmy),
 
11858
     xff12(nnx,mmy),yy0(4),yy1(4),yy2(4),yy12(4),z(16),wt(16,16),
 
11859
     xcl(16),cc(nx,my,4,4),iwt(16,16)
 
11860
 
 
11861
      data iwt/1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
 
11862
     x            0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,
 
11863
     x            -3,0,0,3,0,0,0,0,-2,0,0,-1,0,0,0,0,
 
11864
     x            2,0,0,-2,0,0,0,0,1,0,0,1,0,0,0,0,
 
11865
     x            0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,
 
11866
     x            0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,
 
11867
     x            0,0,0,0,-3,0,0,3,0,0,0,0,-2,0,0,-1,
 
11868
     x            0,0,0,0,2,0,0,-2,0,0,0,0,1,0,0,1,
 
11869
     x            -3,3,0,0,-2,-1,0,0,0,0,0,0,0,0,0,0,
 
11870
     x            0,0,0,0,0,0,0,0,-3,3,0,0,-2,-1,0,0,
 
11871
     x            9,-9,9,-9,6,3,-3,-6,6,-6,-3,3,4,2,1,2,
 
11872
     x            -6,6,-6,6,-4,-2,2,4,-3,3,3,-3,-2,-1,-1,-2,
 
11873
     x            2,-2,0,0,1,1,0,0,0,0,0,0,0,0,0,0,
 
11874
     x            0,0,0,0,0,0,0,0,2,-2,0,0,1,1,0,0,
 
11875
     x            -6,6,-6,6,-3,-3,3,3,-4,4,2,-2,-2,-2,-1,-1,
 
11876
     x            4,-4,4,-4,2,2,-2,-2,2,-2,-2,2,1,1,1,1/
 
11877
 
 
11878
 
 
11879
      do 42 m=1,my
 
11880
      dx=xx(2)-xx(1)
 
11881
      ff1(1,m)=(ff(2,m)-ff(1,m))/dx
 
11882
      dx=xx(nx)-xx(nx-1)
 
11883
      ff1(nx,m)=(ff(nx,m)-ff(nx-1,m))/dx
 
11884
      do 41 n=2,nx-1
 
11885
      ff1(n,m)=pold2002(xx(n-1),xx(n),xx(n+1),ff(n-1,m),ff(n,m),
 
11886
     xff(n+1,m))
 
11887
   41 continue
 
11888
   42 continue
 
11889
 
 
11890
      do 44 n=1,nx
 
11891
      dy=yy(2)-yy(1)
 
11892
      ff2(n,1)=(ff(n,2)-ff(n,1))/dy
 
11893
      dy=yy(my)-yy(my-1)
 
11894
      ff2(n,my)=(ff(n,my)-ff(n,my-1))/dy
 
11895
      do 43 m=2,my-1
 
11896
      ff2(n,m)=pold2002(yy(m-1),yy(m),yy(m+1),ff(n,m-1),ff(n,m),
 
11897
     xff(n,m+1))
 
11898
   43 continue
 
11899
   44 continue
 
11900
 
 
11901
      do 46 m=1,my
 
11902
      dx=xx(2)-xx(1)
 
11903
      ff12(1,m)=(ff2(2,m)-ff2(1,m))/dx
 
11904
      dx=xx(nx)-xx(nx-1)
 
11905
      ff12(nx,m)=(ff2(nx,m)-ff2(nx-1,m))/dx
 
11906
      do 45 n=2,nx-1
 
11907
      ff12(n,m)=pold2002(xx(n-1),xx(n),xx(n+1),ff2(n-1,m),ff2(n,m),
 
11908
     xff2(n+1,m))
 
11909
   45 continue
 
11910
   46 continue
 
11911
 
 
11912
      do 53 n=1,nx-1
 
11913
      do 52 m=1,my-1
 
11914
      d1=xx(n+1)-xx(n)
 
11915
      d2=yy(m+1)-yy(m)
 
11916
      d1d2=d1*d2
 
11917
 
 
11918
      yy0(1)=ff(n,m)
 
11919
      yy0(2)=ff(n+1,m)
 
11920
      yy0(3)=ff(n+1,m+1)
 
11921
      yy0(4)=ff(n,m+1)
 
11922
 
 
11923
      yy1(1)=ff1(n,m)
 
11924
      yy1(2)=ff1(n+1,m)
 
11925
      yy1(3)=ff1(n+1,m+1)
 
11926
      yy1(4)=ff1(n,m+1)
 
11927
 
 
11928
      yy2(1)=ff2(n,m)
 
11929
      yy2(2)=ff2(n+1,m)
 
11930
      yy2(3)=ff2(n+1,m+1)
 
11931
      yy2(4)=ff2(n,m+1)
 
11932
 
 
11933
      yy12(1)=ff12(n,m)
 
11934
      yy12(2)=ff12(n+1,m)
 
11935
      yy12(3)=ff12(n+1,m+1)
 
11936
      yy12(4)=ff12(n,m+1)
 
11937
 
 
11938
      do 47 k=1,4
 
11939
      z(k)=yy0(k)
 
11940
      z(k+4)=yy1(k)*d1
 
11941
      z(k+8)=yy2(k)*d2
 
11942
      z(k+12)=yy12(k)*d1d2
 
11943
   47 continue
 
11944
 
 
11945
      do 49 l=1,16
 
11946
      xxd=0.
 
11947
      do 48 k=1,16
 
11948
      xxd=xxd+iwt(k,l)*z(k)
 
11949
   48 continue
 
11950
      cl(l)=xxd
 
11951
   49 continue
 
11952
      l=0
 
11953
      do 51 k=1,4
 
11954
      do 50 j=1,4
 
11955
      l=l+1
 
11956
      cc(n,m,k,j)=cl(l)
 
11957
   50 continue
 
11958
   51 continue
 
11959
   52 continue
 
11960
   53 continue
 
11961
      return
 
11962
      end
 
11963
 
 
11964
      subroutine jeppe2002_2(x,y,nx,my,xx,yy,cc,z)
 
11965
      implicit real*8(a-h,o-z)
 
11966
      dimension xx(nx),yy(my),cc(nx,my,4,4)      
 
11967
 
 
11968
      n=locx2002(xx,nx,x)
 
11969
      m=locx2002(yy,my,y)
 
11970
 
 
11971
      t=(x-xx(n))/(xx(n+1)-xx(n))
 
11972
      u=(y-yy(m))/(yy(m+1)-yy(m))
 
11973
 
 
11974
      z=0.
 
11975
      do 1 l=4,1,-1
 
11976
      z=t*z+((cc(n,m,l,4)*u+cc(n,m,l,3))*u
 
11977
     .       +cc(n,m,l,2))*u+cc(n,m,l,1)
 
11978
    1 continue
 
11979
      return
 
11980
      end
 
11981
 
 
11982
      integer function locx2002(xx,nx,x)
 
11983
      implicit real*8(a-h,o-z)
 
11984
      dimension xx(nx)
 
11985
      if(x.le.xx(1)) then
 
11986
      locx2002=1
 
11987
      return
 
11988
      endif
 
11989
      if(x.ge.xx(nx)) then 
 
11990
      locx2002=nx-1  
 
11991
      return
 
11992
      endif
 
11993
      ju=nx+1
 
11994
      jl=0
 
11995
    1 if((ju-jl).le.1) go to 2
 
11996
      jm=(ju+jl)/2
 
11997
      if(x.ge.xx(jm)) then
 
11998
      jl=jm
 
11999
      else
 
12000
      ju=jm
 
12001
      endif
 
12002
      go to 1
 
12003
    2 locx2002=jl
 
12004
      return
 
12005
      end
 
12006
 
 
12007
 
 
12008
      real*8 function  pold2002(x1,x2,x3,y1,y2,y3)
 
12009
      implicit real*8(a-h,o-z)
 
12010
      pold2002=(x3*x3*(y1-y2)-2.0*x2*(x3*(y1-y2)+x1*
 
12011
     .(y2-y3))+x2*x2*(y1-y3)+x1*x1*(y2-y3))/((x1-x2)*(x1-x3)*(x2-x3))
 
12012
      return
 
12013
      end
 
12014
 
 
12015
 
 
12016
      subroutine mrst2001lo(x,q,mode,upv,dnv,usea,dsea,str,chm,bot,glu)
 
12017
C***************************************************************C
 
12018
C                                                               C
 
12019
C  This is a package for the new MRST 2001 LO parton            C
 
12020
C  distributions.                                               C     
 
12021
C  Reference: A.D. Martin, R.G. Roberts, W.J. Stirling and      C
 
12022
C  R.S. Thorne, hep-ph/0201xxx                                  C
 
12023
C                                                               C
 
12024
C  There is 1 pdf set corresponding to mode = 1                 C
 
12025
C                                                               C
 
12026
C  Mode=1 gives the default set with Lambda(MSbar,nf=4) = 0.220 C
 
12027
C  corresponding to alpha_s(M_Z) of 0.130                       C
 
12028
C  This set reads a grid whose first number is 0.02868          C
 
12029
C                                                               C
 
12030
C   This subroutine uses an improved interpolation procedure    C 
 
12031
C   for extracting values of the pdf's from the grid            C
 
12032
C                                                               C
 
12033
C         Comments to : W.J.Stirling@durham.ac.uk               C
 
12034
C                                                               C
 
12035
C***************************************************************C
 
12036
      implicit real*8(a-h,o-z)
 
12037
      data xmin,xmax,qsqmin,qsqmax/1d-5,1d0,1.25d0,1d7/
 
12038
      q2=q*q
 
12039
c      if(q2.lt.qsqmin.or.q2.gt.qsqmax) print 99,q2
 
12040
c      if(x.lt.xmin.or.x.gt.xmax)       print 98,x
 
12041
      if(mode.eq.1) then
 
12042
        call mrst2001lo1(x,q2,upv,dnv,usea,dsea,str,chm,bot,glu) 
 
12043
      endif 
 
12044
  99  format('  WARNING:  Q^2 VALUE IS OUT OF RANGE   ','q2= ',e10.5)
 
12045
  98  format('  WARNING:   X  VALUE IS OUT OF RANGE   ','x= ',e10.5)
 
12046
      return
 
12047
      end
 
12048
 
 
12049
      subroutine mrst2001lo1(x,qsq,upv,dnv,usea,dsea,str,chm,bot,glu)
 
12050
      implicit real*8(a-h,o-z)
 
12051
      parameter(nx=49,nq=37,np=8,nqc0=2,nqb0=11,nqc=35,nqb=26)
 
12052
      real*8 f1(nx,nq),f2(nx,nq),f3(nx,nq),f4(nx,nq),f5(nx,nq),
 
12053
     .f6(nx,nq),f7(nx,nq),f8(nx,nq),fc(nx,nqc),fb(nx,nqb)
 
12054
      real*8 qq(nq),xx(nx),cc1(nx,nq,4,4),cc2(nx,nq,4,4),
 
12055
     .cc3(nx,nq,4,4),cc4(nx,nq,4,4),cc6(nx,nq,4,4),cc8(nx,nq,4,4),
 
12056
     .ccc(nx,nqc,4,4),ccb(nx,nqb,4,4)
 
12057
      real*8 xxl(nx),qql(nq),qqlc(nqc),qqlb(nqb)
 
12058
      data xx/1d-5,2d-5,4d-5,6d-5,8d-5,
 
12059
     .        1d-4,2d-4,4d-4,6d-4,8d-4,
 
12060
     .        1d-3,2d-3,4d-3,6d-3,8d-3,
 
12061
     .        1d-2,1.4d-2,2d-2,3d-2,4d-2,6d-2,8d-2,
 
12062
     .     .1d0,.125d0,.15d0,.175d0,.2d0,.225d0,.25d0,.275d0,
 
12063
     .     .3d0,.325d0,.35d0,.375d0,.4d0,.425d0,.45d0,.475d0,
 
12064
     .     .5d0,.525d0,.55d0,.575d0,.6d0,.65d0,.7d0,.75d0,
 
12065
     .     .8d0,.9d0,1d0/
 
12066
      data qq/1.25d0,1.5d0,2d0,2.5d0,3.2d0,4d0,5d0,6.4d0,8d0,1d1,
 
12067
     .        1.2d1,1.8d1,2.6d1,4d1,6.4d1,1d2,
 
12068
     .        1.6d2,2.4d2,4d2,6.4d2,1d3,1.8d3,3.2d3,5.6d3,1d4,
 
12069
     .        1.8d4,3.2d4,5.6d4,1d5,1.8d5,3.2d5,5.6d5,1d6,
 
12070
     .        1.8d6,3.2d6,5.6d6,1d7/
 
12071
      data xmin,xmax,qsqmin,qsqmax/1d-5,1d0,1.25d0,1d7/
 
12072
      data init/0/
 
12073
      save
 
12074
      xsave=x
 
12075
      q2save=qsq
 
12076
      if(init.ne.0) goto 10
 
12077
        open(unit=33,file='lo2002',status='old')
 
12078
        do 20 n=1,nx-1
 
12079
        do 20 m=1,nq
 
12080
        read(33,50)f1(n,m),f2(n,m),f3(n,m),f4(n,m),
 
12081
     .            f5(n,m),f7(n,m),f6(n,m),f8(n,m)
 
12082
c notation: 1=uval 2=val 3=glue 4=usea 5=chm 6=str 7=btm 8=dsea
 
12083
  20  continue
 
12084
      do 40 m=1,nq
 
12085
      f1(nx,m)=0.d0
 
12086
      f2(nx,m)=0.d0
 
12087
      f3(nx,m)=0.d0
 
12088
      f4(nx,m)=0.d0
 
12089
      f5(nx,m)=0.d0
 
12090
      f6(nx,m)=0.d0
 
12091
      f7(nx,m)=0.d0
 
12092
      f8(nx,m)=0.d0
 
12093
  40  continue
 
12094
      do n=1,nx
 
12095
      xxl(n)=dlog(xx(n))
 
12096
      enddo
 
12097
      do m=1,nq
 
12098
      qql(m)=dlog(qq(m))
 
12099
      enddo
 
12100
 
 
12101
      call jeppe2001lo1(nx,nq,xxl,qql,f1,cc1)
 
12102
      call jeppe2001lo1(nx,nq,xxl,qql,f2,cc2)
 
12103
      call jeppe2001lo1(nx,nq,xxl,qql,f3,cc3)
 
12104
      call jeppe2001lo1(nx,nq,xxl,qql,f4,cc4)
 
12105
      call jeppe2001lo1(nx,nq,xxl,qql,f6,cc6)
 
12106
      call jeppe2001lo1(nx,nq,xxl,qql,f8,cc8)
 
12107
 
 
12108
      emc2=2.045
 
12109
      emb2=18.5
 
12110
 
 
12111
      do 44 m=1,nqc
 
12112
      qqlc(m)=qql(m+nqc0)
 
12113
      do 44 n=1,nx
 
12114
      fc(n,m)=f5(n,m+nqc0)
 
12115
   44 continue
 
12116
      qqlc(1)=dlog(emc2)
 
12117
      call jeppe2001lo1(nx,nqc,xxl,qqlc,fc,ccc)
 
12118
 
 
12119
      do 45 m=1,nqb
 
12120
      qqlb(m)=qql(m+nqb0)
 
12121
      do 45 n=1,nx
 
12122
      fb(n,m)=f7(n,m+nqb0)
 
12123
   45 continue
 
12124
      qqlb(1)=dlog(emb2)
 
12125
      call jeppe2001lo1(nx,nqb,xxl,qqlb,fb,ccb)
 
12126
 
 
12127
 
 
12128
      init=1
 
12129
   10 continue
 
12130
      
 
12131
      xlog=dlog(x)
 
12132
      qsqlog=dlog(qsq)
 
12133
 
 
12134
      call jeppe2001lo2(xlog,qsqlog,nx,nq,xxl,qql,cc1,upv)
 
12135
      call jeppe2001lo2(xlog,qsqlog,nx,nq,xxl,qql,cc2,dnv)
 
12136
      call jeppe2001lo2(xlog,qsqlog,nx,nq,xxl,qql,cc3,glu)
 
12137
      call jeppe2001lo2(xlog,qsqlog,nx,nq,xxl,qql,cc4,usea)
 
12138
      call jeppe2001lo2(xlog,qsqlog,nx,nq,xxl,qql,cc6,str)
 
12139
      call jeppe2001lo2(xlog,qsqlog,nx,nq,xxl,qql,cc8,dsea)
 
12140
 
 
12141
      chm=0.d0
 
12142
      if(qsq.gt.emc2) then 
 
12143
      call jeppe2001lo2(xlog,qsqlog,nx,nqc,xxl,qqlc,ccc,chm)
 
12144
      endif
 
12145
 
 
12146
      bot=0.d0
 
12147
      if(qsq.gt.emb2) then 
 
12148
      call jeppe2001lo2(xlog,qsqlog,nx,nqb,xxl,qqlb,ccb,bot)
 
12149
      endif
 
12150
 
 
12151
      x=xsave
 
12152
      qsq=q2save
 
12153
      return
 
12154
   50 format(8f10.5)
 
12155
      end
 
12156
 
 
12157
c      subroutine jeppe1(nx,my,xx,yy,ff,cc)
 
12158
c      implicit real*8(a-h,o-z)
 
12159
c      dimension xx(nx),yy(my),ff(nx,my),ff1(nx,my),ff2(nx,my),
 
12160
c     xff12(nx,my),yy0(4),yy1(4),yy2(4),yy12(4),z(16),wt(16,16),
 
12161
c     xcl(16),cc(nx,my,4,4),iwt(16,16)
 
12162
 
 
12163
      subroutine jeppe2001lo1(nx,my,xx,yy,ff,cc)
 
12164
      implicit real*8(a-h,o-z)
 
12165
      PARAMETER(NNX=49,MMY=37)
 
12166
      dimension xx(nx),yy(my),ff(nx,my),ff1(NNX,MMY),ff2(NNX,MMY),
 
12167
     xff12(NNX,MMY),yy0(4),yy1(4),yy2(4),yy12(4),z(16),wt(16,16),
 
12168
     xcl(16),cc(nx,my,4,4),iwt(16,16)
 
12169
 
 
12170
      data iwt/1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
 
12171
     x            0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,
 
12172
     x            -3,0,0,3,0,0,0,0,-2,0,0,-1,0,0,0,0,
 
12173
     x            2,0,0,-2,0,0,0,0,1,0,0,1,0,0,0,0,
 
12174
     x            0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,
 
12175
     x            0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,
 
12176
     x            0,0,0,0,-3,0,0,3,0,0,0,0,-2,0,0,-1,
 
12177
     x            0,0,0,0,2,0,0,-2,0,0,0,0,1,0,0,1,
 
12178
     x            -3,3,0,0,-2,-1,0,0,0,0,0,0,0,0,0,0,
 
12179
     x            0,0,0,0,0,0,0,0,-3,3,0,0,-2,-1,0,0,
 
12180
     x            9,-9,9,-9,6,3,-3,-6,6,-6,-3,3,4,2,1,2,
 
12181
     x            -6,6,-6,6,-4,-2,2,4,-3,3,3,-3,-2,-1,-1,-2,
 
12182
     x            2,-2,0,0,1,1,0,0,0,0,0,0,0,0,0,0,
 
12183
     x            0,0,0,0,0,0,0,0,2,-2,0,0,1,1,0,0,
 
12184
     x            -6,6,-6,6,-3,-3,3,3,-4,4,2,-2,-2,-2,-1,-1,
 
12185
     x            4,-4,4,-4,2,2,-2,-2,2,-2,-2,2,1,1,1,1/
 
12186
 
 
12187
 
 
12188
      do 42 m=1,my
 
12189
      dx=xx(2)-xx(1)
 
12190
      ff1(1,m)=(ff(2,m)-ff(1,m))/dx
 
12191
      dx=xx(nx)-xx(nx-1)
 
12192
      ff1(nx,m)=(ff(nx,m)-ff(nx-1,m))/dx
 
12193
      do 41 n=2,nx-1
 
12194
      ff1(n,m)=polderiv2001lo(xx(n-1),xx(n),xx(n+1),ff(n-1,m),
 
12195
     xff(n,m),ff(n+1,m))
 
12196
   41 continue
 
12197
   42 continue
 
12198
 
 
12199
      do 44 n=1,nx
 
12200
      dy=yy(2)-yy(1)
 
12201
      ff2(n,1)=(ff(n,2)-ff(n,1))/dy
 
12202
      dy=yy(my)-yy(my-1)
 
12203
      ff2(n,my)=(ff(n,my)-ff(n,my-1))/dy
 
12204
      do 43 m=2,my-1
 
12205
      ff2(n,m)=polderiv2001lo(yy(m-1),yy(m),yy(m+1),ff(n,m-1),
 
12206
     xff(n,m),ff(n,m+1))
 
12207
   43 continue
 
12208
   44 continue
 
12209
 
 
12210
      do 46 m=1,my
 
12211
      dx=xx(2)-xx(1)
 
12212
      ff12(1,m)=(ff2(2,m)-ff2(1,m))/dx
 
12213
      dx=xx(nx)-xx(nx-1)
 
12214
      ff12(nx,m)=(ff2(nx,m)-ff2(nx-1,m))/dx
 
12215
      do 45 n=2,nx-1
 
12216
      ff12(n,m)=polderiv2001lo(xx(n-1),xx(n),xx(n+1),ff2(n-1,m),
 
12217
     xff2(n,m),ff2(n+1,m))
 
12218
   45 continue
 
12219
   46 continue
 
12220
 
 
12221
      do 53 n=1,nx-1
 
12222
      do 52 m=1,my-1
 
12223
      d1=xx(n+1)-xx(n)
 
12224
      d2=yy(m+1)-yy(m)
 
12225
      d1d2=d1*d2
 
12226
 
 
12227
      yy0(1)=ff(n,m)
 
12228
      yy0(2)=ff(n+1,m)
 
12229
      yy0(3)=ff(n+1,m+1)
 
12230
      yy0(4)=ff(n,m+1)
 
12231
 
 
12232
      yy1(1)=ff1(n,m)
 
12233
      yy1(2)=ff1(n+1,m)
 
12234
      yy1(3)=ff1(n+1,m+1)
 
12235
      yy1(4)=ff1(n,m+1)
 
12236
 
 
12237
      yy2(1)=ff2(n,m)
 
12238
      yy2(2)=ff2(n+1,m)
 
12239
      yy2(3)=ff2(n+1,m+1)
 
12240
      yy2(4)=ff2(n,m+1)
 
12241
 
 
12242
      yy12(1)=ff12(n,m)
 
12243
      yy12(2)=ff12(n+1,m)
 
12244
      yy12(3)=ff12(n+1,m+1)
 
12245
      yy12(4)=ff12(n,m+1)
 
12246
 
 
12247
      do 47 k=1,4
 
12248
      z(k)=yy0(k)
 
12249
      z(k+4)=yy1(k)*d1
 
12250
      z(k+8)=yy2(k)*d2
 
12251
      z(k+12)=yy12(k)*d1d2
 
12252
   47 continue
 
12253
 
 
12254
      do 49 l=1,16
 
12255
      xxd=0.
 
12256
      do 48 k=1,16
 
12257
      xxd=xxd+iwt(k,l)*z(k)
 
12258
   48 continue
 
12259
      cl(l)=xxd
 
12260
   49 continue
 
12261
      l=0
 
12262
      do 51 k=1,4
 
12263
      do 50 j=1,4
 
12264
      l=l+1
 
12265
      cc(n,m,k,j)=cl(l)
 
12266
   50 continue
 
12267
   51 continue
 
12268
   52 continue
 
12269
   53 continue
 
12270
      return
 
12271
      end
 
12272
 
 
12273
      subroutine jeppe2001lo2(x,y,nx,my,xx,yy,cc,z)
 
12274
      implicit real*8(a-h,o-z)
 
12275
      dimension xx(nx),yy(my),cc(nx,my,4,4)      
 
12276
 
 
12277
      n=locx2001lo(xx,nx,x)
 
12278
      m=locx2001lo(yy,my,y)
 
12279
 
 
12280
      t=(x-xx(n))/(xx(n+1)-xx(n))
 
12281
      u=(y-yy(m))/(yy(m+1)-yy(m))
 
12282
 
 
12283
      z=0.
 
12284
      do 1 l=4,1,-1
 
12285
      z=t*z+((cc(n,m,l,4)*u+cc(n,m,l,3))*u
 
12286
     .       +cc(n,m,l,2))*u+cc(n,m,l,1)
 
12287
    1 continue
 
12288
      return
 
12289
      end
 
12290
 
 
12291
      integer function locx2001lo(xx,nx,x)
 
12292
      implicit real*8(a-h,o-z)
 
12293
      dimension xx(nx)
 
12294
      if(x.le.xx(1)) then
 
12295
      locx2001lo=1
 
12296
      return
 
12297
      endif
 
12298
      if(x.ge.xx(nx)) then 
 
12299
      locx2001lo=nx-1  
 
12300
      return
 
12301
      endif
 
12302
      ju=nx+1
 
12303
      jl=0
 
12304
    1 if((ju-jl).le.1) go to 2
 
12305
      jm=(ju+jl)/2
 
12306
      if(x.ge.xx(jm)) then
 
12307
      jl=jm
 
12308
      else
 
12309
      ju=jm
 
12310
      endif
 
12311
      go to 1
 
12312
    2 locx2001lo=jl
 
12313
      return
 
12314
      end
 
12315
 
 
12316
 
 
12317
      real*8 function  polderiv2001lo(x1,x2,x3,y1,y2,y3)
 
12318
      implicit real*8(a-h,o-z)
 
12319
      polderiv2001lo=(x3*x3*(y1-y2)-2.0*x2*(x3*(y1-y2)+x1*
 
12320
     .(y2-y3))+x2*x2*(y1-y3)+x1*x1*(y2-y3))/((x1-x2)*(x1-x3)*(x2-x3))
 
12321
      return
 
12322
      end
 
12323
 
 
12324
 
 
12325
      subroutine mrst2001(x,q,mode,upv,dnv,usea,dsea,str,chm,bot,glu)
 
12326
C***************************************************************C
 
12327
C                                                               C
 
12328
C  This is a package for the new MRST 2001 NLO parton           C
 
12329
C  distributions.                                               C     
 
12330
C  Reference: A.D. Martin, R.G. Roberts, W.J. Stirling and      C
 
12331
C  R.S. Thorne, hep-ph/0110215                                  C
 
12332
C                                                               C
 
12333
C  There are 4 pdf sets corresponding to mode = 1, 2, 3, 4      C
 
12334
C                                                               C
 
12335
C  Mode=1 gives the default set with Lambda(MSbar,nf=4) = 0.323 C
 
12336
C  corresponding to alpha_s(M_Z) of 0.119                       C
 
12337
C  This set reads a grid whose first number is 0.00927          C
 
12338
C                                                               C
 
12339
C  Mode=2 gives the set with Lambda(MSbar,nf=4) = 0.290         C
 
12340
C  corresponding to alpha_s(M_Z) of 0.117                       C
 
12341
C  This set reads a grid whose first number is 0.00953          C
 
12342
C                                                               C
 
12343
C  Mode=3 gives the set with Lambda(MSbar,nf=4) = 0.362         C
 
12344
C  corresponding to alpha_s(M_Z) of 0.121                       C
 
12345
C  This set reads a grid whose first number is 0.00889          C
 
12346
C                                                               C
 
12347
C  Mode=4 gives the set MRST2001J which gives better agreement  C
 
12348
C  with the Tevatron inclusive jet data but has unattractive    C
 
12349
C  gluon behaviour at large x (see discussion in paper)         C
 
12350
C  This set has Lambda(MSbar,nf=4) = 0.353(alpha_s(M_Z) = 0.121 C 
 
12351
C  This set reads a grid whose first number is 0.00826          C
 
12352
C                                                               C
 
12353
C   This subroutine uses an improved interpolation procedure    C 
 
12354
C   for extracting values of the pdf's from the grid            C
 
12355
C                                                               C
 
12356
C         Comments to : W.J.Stirling@durham.ac.uk               C
 
12357
C                                                               C
 
12358
C***************************************************************C
 
12359
      implicit real*8(a-h,o-z)
 
12360
      data xmin,xmax,qsqmin,qsqmax/1d-5,1d0,1.25d0,1d7/
 
12361
      q2=q*q
 
12362
c      if(q2.lt.qsqmin.or.q2.gt.qsqmax) print 99,q2
 
12363
c      if(x.lt.xmin.or.x.gt.xmax)       print 98,x
 
12364
      if(mode.eq.1) then
 
12365
        call mrst2001_1(x,q2,upv,dnv,usea,dsea,str,chm,bot,glu) 
 
12366
      elseif(mode.eq.2) then
 
12367
        call mrst2001_2(x,q2,upv,dnv,usea,dsea,str,chm,bot,glu) 
 
12368
      elseif(mode.eq.3) then
 
12369
        call mrst2001_3(x,q2,upv,dnv,usea,dsea,str,chm,bot,glu) 
 
12370
      elseif(mode.eq.4) then
 
12371
        call mrst2001_4(x,q2,upv,dnv,usea,dsea,str,chm,bot,glu)
 
12372
      endif 
 
12373
  99  format('  WARNING:  Q^2 VALUE IS OUT OF RANGE   ','q2= ',e10.5)
 
12374
  98  format('  WARNING:   X  VALUE IS OUT OF RANGE   ','x= ',e10.5)
 
12375
      return
 
12376
      end
 
12377
 
 
12378
      subroutine mrst2001_1(x,qsq,upv,dnv,usea,dsea,str,chm,bot,glu)
 
12379
      implicit real*8(a-h,o-z)
 
12380
      parameter(nx=49,nq=37,np=8,nqc0=2,nqb0=11,nqc=35,nqb=26)
 
12381
      real*8 f1(nx,nq),f2(nx,nq),f3(nx,nq),f4(nx,nq),f5(nx,nq),
 
12382
     .f6(nx,nq),f7(nx,nq),f8(nx,nq),fc(nx,nqc),fb(nx,nqb)
 
12383
      real*8 qq(nq),xx(nx),cc1(nx,nq,4,4),cc2(nx,nq,4,4),
 
12384
     .cc3(nx,nq,4,4),cc4(nx,nq,4,4),cc6(nx,nq,4,4),cc8(nx,nq,4,4),
 
12385
     .ccc(nx,nqc,4,4),ccb(nx,nqb,4,4)
 
12386
      real*8 xxl(nx),qql(nq),qqlc(nqc),qqlb(nqb)
 
12387
      data xx/1d-5,2d-5,4d-5,6d-5,8d-5,
 
12388
     .        1d-4,2d-4,4d-4,6d-4,8d-4,
 
12389
     .        1d-3,2d-3,4d-3,6d-3,8d-3,
 
12390
     .        1d-2,1.4d-2,2d-2,3d-2,4d-2,6d-2,8d-2,
 
12391
     .     .1d0,.125d0,.15d0,.175d0,.2d0,.225d0,.25d0,.275d0,
 
12392
     .     .3d0,.325d0,.35d0,.375d0,.4d0,.425d0,.45d0,.475d0,
 
12393
     .     .5d0,.525d0,.55d0,.575d0,.6d0,.65d0,.7d0,.75d0,
 
12394
     .     .8d0,.9d0,1d0/
 
12395
      data qq/1.25d0,1.5d0,2d0,2.5d0,3.2d0,4d0,5d0,6.4d0,8d0,1d1,
 
12396
     .        1.2d1,1.8d1,2.6d1,4d1,6.4d1,1d2,
 
12397
     .        1.6d2,2.4d2,4d2,6.4d2,1d3,1.8d3,3.2d3,5.6d3,1d4,
 
12398
     .        1.8d4,3.2d4,5.6d4,1d5,1.8d5,3.2d5,5.6d5,1d6,
 
12399
     .        1.8d6,3.2d6,5.6d6,1d7/
 
12400
      data xmin,xmax,qsqmin,qsqmax/1d-5,1d0,1.25d0,1d7/
 
12401
      data init/0/
 
12402
      save
 
12403
      xsave=x
 
12404
      q2save=qsq
 
12405
      if(init.ne.0) goto 10
 
12406
        open(unit=33,file='alf119',status='old')
 
12407
        do 20 n=1,nx-1
 
12408
        do 20 m=1,nq
 
12409
        read(33,50)f1(n,m),f2(n,m),f3(n,m),f4(n,m),
 
12410
     .            f5(n,m),f7(n,m),f6(n,m),f8(n,m)
 
12411
c notation: 1=uval 2=val 3=glue 4=usea 5=chm 6=str 7=btm 8=dsea
 
12412
  20  continue
 
12413
      do 40 m=1,nq
 
12414
      f1(nx,m)=0.d0
 
12415
      f2(nx,m)=0.d0
 
12416
      f3(nx,m)=0.d0
 
12417
      f4(nx,m)=0.d0
 
12418
      f5(nx,m)=0.d0
 
12419
      f6(nx,m)=0.d0
 
12420
      f7(nx,m)=0.d0
 
12421
      f8(nx,m)=0.d0
 
12422
  40  continue
 
12423
      do n=1,nx
 
12424
      xxl(n)=dlog(xx(n))
 
12425
      enddo
 
12426
      do m=1,nq
 
12427
      qql(m)=dlog(qq(m))
 
12428
      enddo
 
12429
 
 
12430
      call jeppe2001_1(nx,nq,xxl,qql,f1,cc1)
 
12431
      call jeppe2001_1(nx,nq,xxl,qql,f2,cc2)
 
12432
      call jeppe2001_1(nx,nq,xxl,qql,f3,cc3)
 
12433
      call jeppe2001_1(nx,nq,xxl,qql,f4,cc4)
 
12434
      call jeppe2001_1(nx,nq,xxl,qql,f6,cc6)
 
12435
      call jeppe2001_1(nx,nq,xxl,qql,f8,cc8)
 
12436
 
 
12437
      emc2=2.045
 
12438
      emb2=18.5
 
12439
 
 
12440
      do 44 m=1,nqc
 
12441
      qqlc(m)=qql(m+nqc0)
 
12442
      do 44 n=1,nx
 
12443
      fc(n,m)=f5(n,m+nqc0)
 
12444
   44 continue
 
12445
      qqlc(1)=dlog(emc2)
 
12446
      call jeppe2001_1(nx,nqc,xxl,qqlc,fc,ccc)
 
12447
 
 
12448
      do 45 m=1,nqb
 
12449
      qqlb(m)=qql(m+nqb0)
 
12450
      do 45 n=1,nx
 
12451
      fb(n,m)=f7(n,m+nqb0)
 
12452
   45 continue
 
12453
      qqlb(1)=dlog(emb2)
 
12454
      call jeppe2001_1(nx,nqb,xxl,qqlb,fb,ccb)
 
12455
 
 
12456
 
 
12457
      init=1
 
12458
   10 continue
 
12459
      
 
12460
      xlog=dlog(x)
 
12461
      qsqlog=dlog(qsq)
 
12462
 
 
12463
      call jeppe2001_2(xlog,qsqlog,nx,nq,xxl,qql,cc1,upv)
 
12464
      call jeppe2001_2(xlog,qsqlog,nx,nq,xxl,qql,cc2,dnv)
 
12465
      call jeppe2001_2(xlog,qsqlog,nx,nq,xxl,qql,cc3,glu)
 
12466
      call jeppe2001_2(xlog,qsqlog,nx,nq,xxl,qql,cc4,usea)
 
12467
      call jeppe2001_2(xlog,qsqlog,nx,nq,xxl,qql,cc6,str)
 
12468
      call jeppe2001_2(xlog,qsqlog,nx,nq,xxl,qql,cc8,dsea)
 
12469
 
 
12470
      chm=0.d0
 
12471
      if(qsq.gt.emc2) then 
 
12472
      call jeppe2001_2(xlog,qsqlog,nx,nqc,xxl,qqlc,ccc,chm)
 
12473
      endif
 
12474
 
 
12475
      bot=0.d0
 
12476
      if(qsq.gt.emb2) then 
 
12477
      call jeppe2001_2(xlog,qsqlog,nx,nqb,xxl,qqlb,ccb,bot)
 
12478
      endif
 
12479
 
 
12480
      x=xsave
 
12481
      qsq=q2save
 
12482
      return
 
12483
   50 format(8f10.5)
 
12484
      end
 
12485
 
 
12486
      subroutine mrst2001_2(x,qsq,upv,dnv,usea,dsea,str,chm,bot,glu)
 
12487
      implicit real*8(a-h,o-z)
 
12488
      parameter(nx=49,nq=37,np=8,nqc0=2,nqb0=11,nqc=35,nqb=26)
 
12489
      real*8 f1(nx,nq),f2(nx,nq),f3(nx,nq),f4(nx,nq),f5(nx,nq),
 
12490
     .f6(nx,nq),f7(nx,nq),f8(nx,nq),fc(nx,nqc),fb(nx,nqb)
 
12491
      real*8 qq(nq),xx(nx),cc1(nx,nq,4,4),cc2(nx,nq,4,4),
 
12492
     .cc3(nx,nq,4,4),cc4(nx,nq,4,4),cc6(nx,nq,4,4),cc8(nx,nq,4,4),
 
12493
     .ccc(nx,nqc,4,4),ccb(nx,nqb,4,4)
 
12494
      real*8 xxl(nx),qql(nq),qqlc(nqc),qqlb(nqb)
 
12495
      data xx/1d-5,2d-5,4d-5,6d-5,8d-5,
 
12496
     .        1d-4,2d-4,4d-4,6d-4,8d-4,
 
12497
     .        1d-3,2d-3,4d-3,6d-3,8d-3,
 
12498
     .        1d-2,1.4d-2,2d-2,3d-2,4d-2,6d-2,8d-2,
 
12499
     .     .1d0,.125d0,.15d0,.175d0,.2d0,.225d0,.25d0,.275d0,
 
12500
     .     .3d0,.325d0,.35d0,.375d0,.4d0,.425d0,.45d0,.475d0,
 
12501
     .     .5d0,.525d0,.55d0,.575d0,.6d0,.65d0,.7d0,.75d0,
 
12502
     .     .8d0,.9d0,1d0/
 
12503
      data qq/1.25d0,1.5d0,2d0,2.5d0,3.2d0,4d0,5d0,6.4d0,8d0,1d1,
 
12504
     .        1.2d1,1.8d1,2.6d1,4d1,6.4d1,1d2,
 
12505
     .        1.6d2,2.4d2,4d2,6.4d2,1d3,1.8d3,3.2d3,5.6d3,1d4,
 
12506
     .        1.8d4,3.2d4,5.6d4,1d5,1.8d5,3.2d5,5.6d5,1d6,
 
12507
     .        1.8d6,3.2d6,5.6d6,1d7/
 
12508
      data xmin,xmax,qsqmin,qsqmax/1d-5,1d0,1.25d0,1d7/
 
12509
      data init/0/
 
12510
      save
 
12511
      xsave=x
 
12512
      q2save=qsq
 
12513
      if(init.ne.0) goto 10
 
12514
        open(unit=33,file='alf117',status='old')
 
12515
        do 20 n=1,nx-1
 
12516
        do 20 m=1,nq
 
12517
        read(33,50)f1(n,m),f2(n,m),f3(n,m),f4(n,m),
 
12518
     .            f5(n,m),f7(n,m),f6(n,m),f8(n,m)
 
12519
c notation: 1=uval 2=val 3=glue 4=usea 5=chm 6=str 7=btm 8=dsea
 
12520
  20  continue
 
12521
      do 40 m=1,nq
 
12522
      f1(nx,m)=0.d0
 
12523
      f2(nx,m)=0.d0
 
12524
      f3(nx,m)=0.d0
 
12525
      f4(nx,m)=0.d0
 
12526
      f5(nx,m)=0.d0
 
12527
      f6(nx,m)=0.d0
 
12528
      f7(nx,m)=0.d0
 
12529
      f8(nx,m)=0.d0
 
12530
  40  continue
 
12531
      do n=1,nx
 
12532
      xxl(n)=dlog(xx(n))
 
12533
      enddo
 
12534
      do m=1,nq
 
12535
      qql(m)=dlog(qq(m))
 
12536
      enddo
 
12537
 
 
12538
      call jeppe2001_1(nx,nq,xxl,qql,f1,cc1)
 
12539
      call jeppe2001_1(nx,nq,xxl,qql,f2,cc2)
 
12540
      call jeppe2001_1(nx,nq,xxl,qql,f3,cc3)
 
12541
      call jeppe2001_1(nx,nq,xxl,qql,f4,cc4)
 
12542
      call jeppe2001_1(nx,nq,xxl,qql,f6,cc6)
 
12543
      call jeppe2001_1(nx,nq,xxl,qql,f8,cc8)
 
12544
 
 
12545
      emc2=2.045
 
12546
      emb2=18.5
 
12547
 
 
12548
      do 44 m=1,nqc
 
12549
      qqlc(m)=qql(m+nqc0)
 
12550
      do 44 n=1,nx
 
12551
      fc(n,m)=f5(n,m+nqc0)
 
12552
   44 continue
 
12553
      qqlc(1)=dlog(emc2)
 
12554
      call jeppe2001_1(nx,nqc,xxl,qqlc,fc,ccc)
 
12555
 
 
12556
      do 45 m=1,nqb
 
12557
      qqlb(m)=qql(m+nqb0)
 
12558
      do 45 n=1,nx
 
12559
      fb(n,m)=f7(n,m+nqb0)
 
12560
   45 continue
 
12561
      qqlb(1)=dlog(emb2)
 
12562
      call jeppe2001_1(nx,nqb,xxl,qqlb,fb,ccb)
 
12563
 
 
12564
 
 
12565
      init=1
 
12566
   10 continue
 
12567
      
 
12568
      xlog=dlog(x)
 
12569
      qsqlog=dlog(qsq)
 
12570
 
 
12571
      call jeppe2001_2(xlog,qsqlog,nx,nq,xxl,qql,cc1,upv)
 
12572
      call jeppe2001_2(xlog,qsqlog,nx,nq,xxl,qql,cc2,dnv)
 
12573
      call jeppe2001_2(xlog,qsqlog,nx,nq,xxl,qql,cc3,glu)
 
12574
      call jeppe2001_2(xlog,qsqlog,nx,nq,xxl,qql,cc4,usea)
 
12575
      call jeppe2001_2(xlog,qsqlog,nx,nq,xxl,qql,cc6,str)
 
12576
      call jeppe2001_2(xlog,qsqlog,nx,nq,xxl,qql,cc8,dsea)
 
12577
 
 
12578
      chm=0.d0
 
12579
      if(qsq.gt.emc2) then 
 
12580
      call jeppe2001_2(xlog,qsqlog,nx,nqc,xxl,qqlc,ccc,chm)
 
12581
      endif
 
12582
 
 
12583
      bot=0.d0
 
12584
      if(qsq.gt.emb2) then 
 
12585
      call jeppe2001_2(xlog,qsqlog,nx,nqb,xxl,qqlb,ccb,bot)
 
12586
      endif
 
12587
 
 
12588
      x=xsave
 
12589
      qsq=q2save
 
12590
      return
 
12591
   50 format(8f10.5)
 
12592
      end
 
12593
 
 
12594
      subroutine mrst2001_3(x,qsq,upv,dnv,usea,dsea,str,chm,bot,glu)
 
12595
      implicit real*8(a-h,o-z)
 
12596
      parameter(nx=49,nq=37,np=8,nqc0=2,nqb0=11,nqc=35,nqb=26)
 
12597
      real*8 f1(nx,nq),f2(nx,nq),f3(nx,nq),f4(nx,nq),f5(nx,nq),
 
12598
     .f6(nx,nq),f7(nx,nq),f8(nx,nq),fc(nx,nqc),fb(nx,nqb)
 
12599
      real*8 qq(nq),xx(nx),cc1(nx,nq,4,4),cc2(nx,nq,4,4),
 
12600
     .cc3(nx,nq,4,4),cc4(nx,nq,4,4),cc6(nx,nq,4,4),cc8(nx,nq,4,4),
 
12601
     .ccc(nx,nqc,4,4),ccb(nx,nqb,4,4)
 
12602
      real*8 xxl(nx),qql(nq),qqlc(nqc),qqlb(nqb)
 
12603
      data xx/1d-5,2d-5,4d-5,6d-5,8d-5,
 
12604
     .        1d-4,2d-4,4d-4,6d-4,8d-4,
 
12605
     .        1d-3,2d-3,4d-3,6d-3,8d-3,
 
12606
     .        1d-2,1.4d-2,2d-2,3d-2,4d-2,6d-2,8d-2,
 
12607
     .     .1d0,.125d0,.15d0,.175d0,.2d0,.225d0,.25d0,.275d0,
 
12608
     .     .3d0,.325d0,.35d0,.375d0,.4d0,.425d0,.45d0,.475d0,
 
12609
     .     .5d0,.525d0,.55d0,.575d0,.6d0,.65d0,.7d0,.75d0,
 
12610
     .     .8d0,.9d0,1d0/
 
12611
      data qq/1.25d0,1.5d0,2d0,2.5d0,3.2d0,4d0,5d0,6.4d0,8d0,1d1,
 
12612
     .        1.2d1,1.8d1,2.6d1,4d1,6.4d1,1d2,
 
12613
     .        1.6d2,2.4d2,4d2,6.4d2,1d3,1.8d3,3.2d3,5.6d3,1d4,
 
12614
     .        1.8d4,3.2d4,5.6d4,1d5,1.8d5,3.2d5,5.6d5,1d6,
 
12615
     .        1.8d6,3.2d6,5.6d6,1d7/
 
12616
      data xmin,xmax,qsqmin,qsqmax/1d-5,1d0,1.25d0,1d7/
 
12617
      data init/0/
 
12618
      save
 
12619
      xsave=x
 
12620
      q2save=qsq
 
12621
      if(init.ne.0) goto 10
 
12622
        open(unit=33,file='alf121',status='old')
 
12623
        do 20 n=1,nx-1
 
12624
        do 20 m=1,nq
 
12625
        read(33,50)f1(n,m),f2(n,m),f3(n,m),f4(n,m),
 
12626
     .            f5(n,m),f7(n,m),f6(n,m),f8(n,m)
 
12627
c notation: 1=uval 2=val 3=glue 4=usea 5=chm 6=str 7=btm 8=dsea
 
12628
  20  continue
 
12629
      do 40 m=1,nq
 
12630
      f1(nx,m)=0.d0
 
12631
      f2(nx,m)=0.d0
 
12632
      f3(nx,m)=0.d0
 
12633
      f4(nx,m)=0.d0
 
12634
      f5(nx,m)=0.d0
 
12635
      f6(nx,m)=0.d0
 
12636
      f7(nx,m)=0.d0
 
12637
      f8(nx,m)=0.d0
 
12638
  40  continue
 
12639
      do n=1,nx
 
12640
      xxl(n)=dlog(xx(n))
 
12641
      enddo
 
12642
      do m=1,nq
 
12643
      qql(m)=dlog(qq(m))
 
12644
      enddo
 
12645
 
 
12646
      call jeppe2001_1(nx,nq,xxl,qql,f1,cc1)
 
12647
      call jeppe2001_1(nx,nq,xxl,qql,f2,cc2)
 
12648
      call jeppe2001_1(nx,nq,xxl,qql,f3,cc3)
 
12649
      call jeppe2001_1(nx,nq,xxl,qql,f4,cc4)
 
12650
      call jeppe2001_1(nx,nq,xxl,qql,f6,cc6)
 
12651
      call jeppe2001_1(nx,nq,xxl,qql,f8,cc8)
 
12652
 
 
12653
      emc2=2.045
 
12654
      emb2=18.5
 
12655
 
 
12656
      do 44 m=1,nqc
 
12657
      qqlc(m)=qql(m+nqc0)
 
12658
      do 44 n=1,nx
 
12659
      fc(n,m)=f5(n,m+nqc0)
 
12660
   44 continue
 
12661
      qqlc(1)=dlog(emc2)
 
12662
      call jeppe2001_1(nx,nqc,xxl,qqlc,fc,ccc)
 
12663
 
 
12664
      do 45 m=1,nqb
 
12665
      qqlb(m)=qql(m+nqb0)
 
12666
      do 45 n=1,nx
 
12667
      fb(n,m)=f7(n,m+nqb0)
 
12668
   45 continue
 
12669
      qqlb(1)=dlog(emb2)
 
12670
      call jeppe2001_1(nx,nqb,xxl,qqlb,fb,ccb)
 
12671
 
 
12672
 
 
12673
      init=1
 
12674
   10 continue
 
12675
      
 
12676
      xlog=dlog(x)
 
12677
      qsqlog=dlog(qsq)
 
12678
 
 
12679
      call jeppe2001_2(xlog,qsqlog,nx,nq,xxl,qql,cc1,upv)
 
12680
      call jeppe2001_2(xlog,qsqlog,nx,nq,xxl,qql,cc2,dnv)
 
12681
      call jeppe2001_2(xlog,qsqlog,nx,nq,xxl,qql,cc3,glu)
 
12682
      call jeppe2001_2(xlog,qsqlog,nx,nq,xxl,qql,cc4,usea)
 
12683
      call jeppe2001_2(xlog,qsqlog,nx,nq,xxl,qql,cc6,str)
 
12684
      call jeppe2001_2(xlog,qsqlog,nx,nq,xxl,qql,cc8,dsea)
 
12685
 
 
12686
      chm=0.d0
 
12687
      if(qsq.gt.emc2) then 
 
12688
      call jeppe2001_2(xlog,qsqlog,nx,nqc,xxl,qqlc,ccc,chm)
 
12689
      endif
 
12690
 
 
12691
      bot=0.d0
 
12692
      if(qsq.gt.emb2) then 
 
12693
      call jeppe2001_2(xlog,qsqlog,nx,nqb,xxl,qqlb,ccb,bot)
 
12694
      endif
 
12695
 
 
12696
      x=xsave
 
12697
      qsq=q2save
 
12698
      return
 
12699
   50 format(8f10.5)
 
12700
      end
 
12701
 
 
12702
      subroutine mrst2001_4(x,qsq,upv,dnv,usea,dsea,str,chm,bot,glu)
 
12703
      implicit real*8(a-h,o-z)
 
12704
      parameter(nx=49,nq=37,np=8,nqc0=2,nqb0=11,nqc=35,nqb=26)
 
12705
      real*8 f1(nx,nq),f2(nx,nq),f3(nx,nq),f4(nx,nq),f5(nx,nq),
 
12706
     .f6(nx,nq),f7(nx,nq),f8(nx,nq),fc(nx,nqc),fb(nx,nqb)
 
12707
      real*8 qq(nq),xx(nx),cc1(nx,nq,4,4),cc2(nx,nq,4,4),
 
12708
     .cc3(nx,nq,4,4),cc4(nx,nq,4,4),cc6(nx,nq,4,4),cc8(nx,nq,4,4),
 
12709
     .ccc(nx,nqc,4,4),ccb(nx,nqb,4,4)
 
12710
      real*8 xxl(nx),qql(nq),qqlc(nqc),qqlb(nqb)
 
12711
      data xx/1d-5,2d-5,4d-5,6d-5,8d-5,
 
12712
     .        1d-4,2d-4,4d-4,6d-4,8d-4,
 
12713
     .        1d-3,2d-3,4d-3,6d-3,8d-3,
 
12714
     .        1d-2,1.4d-2,2d-2,3d-2,4d-2,6d-2,8d-2,
 
12715
     .     .1d0,.125d0,.15d0,.175d0,.2d0,.225d0,.25d0,.275d0,
 
12716
     .     .3d0,.325d0,.35d0,.375d0,.4d0,.425d0,.45d0,.475d0,
 
12717
     .     .5d0,.525d0,.55d0,.575d0,.6d0,.65d0,.7d0,.75d0,
 
12718
     .     .8d0,.9d0,1d0/
 
12719
      data qq/1.25d0,1.5d0,2d0,2.5d0,3.2d0,4d0,5d0,6.4d0,8d0,1d1,
 
12720
     .        1.2d1,1.8d1,2.6d1,4d1,6.4d1,1d2,
 
12721
     .        1.6d2,2.4d2,4d2,6.4d2,1d3,1.8d3,3.2d3,5.6d3,1d4,
 
12722
     .        1.8d4,3.2d4,5.6d4,1d5,1.8d5,3.2d5,5.6d5,1d6,
 
12723
     .        1.8d6,3.2d6,5.6d6,1d7/
 
12724
      data xmin,xmax,qsqmin,qsqmax/1d-5,1d0,1.25d0,1d7/
 
12725
      data init/0/
 
12726
      save
 
12727
      xsave=x
 
12728
      q2save=qsq
 
12729
      if(init.ne.0) goto 10
 
12730
        open(unit=33,file='j121',status='old')
 
12731
        do 20 n=1,nx-1
 
12732
        do 20 m=1,nq
 
12733
        read(33,50)f1(n,m),f2(n,m),f3(n,m),f4(n,m),
 
12734
     .            f5(n,m),f7(n,m),f6(n,m),f8(n,m)
 
12735
c notation: 1=uval 2=val 3=glue 4=usea 5=chm 6=str 7=btm 8=dsea
 
12736
  20  continue
 
12737
      do 40 m=1,nq
 
12738
      f1(nx,m)=0.d0
 
12739
      f2(nx,m)=0.d0
 
12740
      f3(nx,m)=0.d0
 
12741
      f4(nx,m)=0.d0
 
12742
      f5(nx,m)=0.d0
 
12743
      f6(nx,m)=0.d0
 
12744
      f7(nx,m)=0.d0
 
12745
      f8(nx,m)=0.d0
 
12746
  40  continue
 
12747
      do n=1,nx
 
12748
      xxl(n)=dlog(xx(n))
 
12749
      enddo
 
12750
      do m=1,nq
 
12751
      qql(m)=dlog(qq(m))
 
12752
      enddo
 
12753
 
 
12754
      call jeppe2001_1(nx,nq,xxl,qql,f1,cc1)
 
12755
      call jeppe2001_1(nx,nq,xxl,qql,f2,cc2)
 
12756
      call jeppe2001_1(nx,nq,xxl,qql,f3,cc3)
 
12757
      call jeppe2001_1(nx,nq,xxl,qql,f4,cc4)
 
12758
      call jeppe2001_1(nx,nq,xxl,qql,f6,cc6)
 
12759
      call jeppe2001_1(nx,nq,xxl,qql,f8,cc8)
 
12760
 
 
12761
      emc2=2.045
 
12762
      emb2=18.5
 
12763
 
 
12764
      do 44 m=1,nqc
 
12765
      qqlc(m)=qql(m+nqc0)
 
12766
      do 44 n=1,nx
 
12767
      fc(n,m)=f5(n,m+nqc0)
 
12768
   44 continue
 
12769
      qqlc(1)=dlog(emc2)
 
12770
      call jeppe2001_1(nx,nqc,xxl,qqlc,fc,ccc)
 
12771
 
 
12772
      do 45 m=1,nqb
 
12773
      qqlb(m)=qql(m+nqb0)
 
12774
      do 45 n=1,nx
 
12775
      fb(n,m)=f7(n,m+nqb0)
 
12776
   45 continue
 
12777
      qqlb(1)=dlog(emb2)
 
12778
      call jeppe2001_1(nx,nqb,xxl,qqlb,fb,ccb)
 
12779
 
 
12780
 
 
12781
      init=1
 
12782
   10 continue
 
12783
      
 
12784
      xlog=dlog(x)
 
12785
      qsqlog=dlog(qsq)
 
12786
 
 
12787
      call jeppe2001_2(xlog,qsqlog,nx,nq,xxl,qql,cc1,upv)
 
12788
      call jeppe2001_2(xlog,qsqlog,nx,nq,xxl,qql,cc2,dnv)
 
12789
      call jeppe2001_2(xlog,qsqlog,nx,nq,xxl,qql,cc3,glu)
 
12790
      call jeppe2001_2(xlog,qsqlog,nx,nq,xxl,qql,cc4,usea)
 
12791
      call jeppe2001_2(xlog,qsqlog,nx,nq,xxl,qql,cc6,str)
 
12792
      call jeppe2001_2(xlog,qsqlog,nx,nq,xxl,qql,cc8,dsea)
 
12793
 
 
12794
      chm=0.d0
 
12795
      if(qsq.gt.emc2) then 
 
12796
      call jeppe2001_2(xlog,qsqlog,nx,nqc,xxl,qqlc,ccc,chm)
 
12797
      endif
 
12798
 
 
12799
      bot=0.d0
 
12800
      if(qsq.gt.emb2) then 
 
12801
      call jeppe2001_2(xlog,qsqlog,nx,nqb,xxl,qqlb,ccb,bot)
 
12802
      endif
 
12803
 
 
12804
      x=xsave
 
12805
      qsq=q2save
 
12806
      return
 
12807
   50 format(8f10.5)
 
12808
      end
 
12809
 
 
12810
      subroutine jeppe2001_1(nx,my,xx,yy,ff,cc)
 
12811
      implicit real*8(a-h,o-z)
 
12812
      parameter(nnx=49,mmy=37)
 
12813
      dimension xx(nx),yy(my),ff(nnx,mmy),ff1(nnx,mmy),ff2(nnx,mmy),
 
12814
     xff12(nnx,mmy),yy0(4),yy1(4),yy2(4),yy12(4),z(16),wt(16,16),
 
12815
     xcl(16),cc(nx,my,4,4),iwt(16,16)
 
12816
 
 
12817
      data iwt/1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
 
12818
     x            0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,
 
12819
     x            -3,0,0,3,0,0,0,0,-2,0,0,-1,0,0,0,0,
 
12820
     x            2,0,0,-2,0,0,0,0,1,0,0,1,0,0,0,0,
 
12821
     x            0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,
 
12822
     x            0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,
 
12823
     x            0,0,0,0,-3,0,0,3,0,0,0,0,-2,0,0,-1,
 
12824
     x            0,0,0,0,2,0,0,-2,0,0,0,0,1,0,0,1,
 
12825
     x            -3,3,0,0,-2,-1,0,0,0,0,0,0,0,0,0,0,
 
12826
     x            0,0,0,0,0,0,0,0,-3,3,0,0,-2,-1,0,0,
 
12827
     x            9,-9,9,-9,6,3,-3,-6,6,-6,-3,3,4,2,1,2,
 
12828
     x            -6,6,-6,6,-4,-2,2,4,-3,3,3,-3,-2,-1,-1,-2,
 
12829
     x            2,-2,0,0,1,1,0,0,0,0,0,0,0,0,0,0,
 
12830
     x            0,0,0,0,0,0,0,0,2,-2,0,0,1,1,0,0,
 
12831
     x            -6,6,-6,6,-3,-3,3,3,-4,4,2,-2,-2,-2,-1,-1,
 
12832
     x            4,-4,4,-4,2,2,-2,-2,2,-2,-2,2,1,1,1,1/
 
12833
 
 
12834
 
 
12835
      do 42 m=1,my
 
12836
      dx=xx(2)-xx(1)
 
12837
      ff1(1,m)=(ff(2,m)-ff(1,m))/dx
 
12838
      dx=xx(nx)-xx(nx-1)
 
12839
      ff1(nx,m)=(ff(nx,m)-ff(nx-1,m))/dx
 
12840
      do 41 n=2,nx-1
 
12841
      ff1(n,m)=polderiv2001(xx(n-1),xx(n),xx(n+1),ff(n-1,m),ff(n,m),
 
12842
     xff(n+1,m))
 
12843
   41 continue
 
12844
   42 continue
 
12845
 
 
12846
      do 44 n=1,nx
 
12847
      dy=yy(2)-yy(1)
 
12848
      ff2(n,1)=(ff(n,2)-ff(n,1))/dy
 
12849
      dy=yy(my)-yy(my-1)
 
12850
      ff2(n,my)=(ff(n,my)-ff(n,my-1))/dy
 
12851
      do 43 m=2,my-1
 
12852
      ff2(n,m)=polderiv2001(yy(m-1),yy(m),yy(m+1),ff(n,m-1),ff(n,m),
 
12853
     xff(n,m+1))
 
12854
   43 continue
 
12855
   44 continue
 
12856
 
 
12857
      do 46 m=1,my
 
12858
      dx=xx(2)-xx(1)
 
12859
      ff12(1,m)=(ff2(2,m)-ff2(1,m))/dx
 
12860
      dx=xx(nx)-xx(nx-1)
 
12861
      ff12(nx,m)=(ff2(nx,m)-ff2(nx-1,m))/dx
 
12862
      do 45 n=2,nx-1
 
12863
      ff12(n,m)=polderiv2001(xx(n-1),xx(n),xx(n+1),ff2(n-1,m),ff2(n,m),
 
12864
     xff2(n+1,m))
 
12865
   45 continue
 
12866
   46 continue
 
12867
 
 
12868
      do 53 n=1,nx-1
 
12869
      do 52 m=1,my-1
 
12870
      d1=xx(n+1)-xx(n)
 
12871
      d2=yy(m+1)-yy(m)
 
12872
      d1d2=d1*d2
 
12873
 
 
12874
      yy0(1)=ff(n,m)
 
12875
      yy0(2)=ff(n+1,m)
 
12876
      yy0(3)=ff(n+1,m+1)
 
12877
      yy0(4)=ff(n,m+1)
 
12878
 
 
12879
      yy1(1)=ff1(n,m)
 
12880
      yy1(2)=ff1(n+1,m)
 
12881
      yy1(3)=ff1(n+1,m+1)
 
12882
      yy1(4)=ff1(n,m+1)
 
12883
 
 
12884
      yy2(1)=ff2(n,m)
 
12885
      yy2(2)=ff2(n+1,m)
 
12886
      yy2(3)=ff2(n+1,m+1)
 
12887
      yy2(4)=ff2(n,m+1)
 
12888
 
 
12889
      yy12(1)=ff12(n,m)
 
12890
      yy12(2)=ff12(n+1,m)
 
12891
      yy12(3)=ff12(n+1,m+1)
 
12892
      yy12(4)=ff12(n,m+1)
 
12893
 
 
12894
      do 47 k=1,4
 
12895
      z(k)=yy0(k)
 
12896
      z(k+4)=yy1(k)*d1
 
12897
      z(k+8)=yy2(k)*d2
 
12898
      z(k+12)=yy12(k)*d1d2
 
12899
   47 continue
 
12900
 
 
12901
      do 49 l=1,16
 
12902
      xxd=0.
 
12903
      do 48 k=1,16
 
12904
      xxd=xxd+iwt(k,l)*z(k)
 
12905
   48 continue
 
12906
      cl(l)=xxd
 
12907
   49 continue
 
12908
      l=0
 
12909
      do 51 k=1,4
 
12910
      do 50 j=1,4
 
12911
      l=l+1
 
12912
      cc(n,m,k,j)=cl(l)
 
12913
   50 continue
 
12914
   51 continue
 
12915
   52 continue
 
12916
   53 continue
 
12917
      return
 
12918
      end
 
12919
 
 
12920
      subroutine jeppe2001_2(x,y,nx,my,xx,yy,cc,z)
 
12921
      implicit real*8(a-h,o-z)
 
12922
      dimension xx(nx),yy(my),cc(nx,my,4,4)      
 
12923
 
 
12924
      n=locx2001(xx,nx,x)
 
12925
      m=locx2001(yy,my,y)
 
12926
 
 
12927
      t=(x-xx(n))/(xx(n+1)-xx(n))
 
12928
      u=(y-yy(m))/(yy(m+1)-yy(m))
 
12929
 
 
12930
      z=0.
 
12931
      do 1 l=4,1,-1
 
12932
      z=t*z+((cc(n,m,l,4)*u+cc(n,m,l,3))*u
 
12933
     .       +cc(n,m,l,2))*u+cc(n,m,l,1)
 
12934
    1 continue
 
12935
      return
 
12936
      end
 
12937
 
 
12938
      integer function locx2001(xx,nx,x)
 
12939
      implicit real*8(a-h,o-z)
 
12940
      dimension xx(nx)
 
12941
      if(x.le.xx(1)) then
 
12942
      locx2001=1
 
12943
      return
 
12944
      endif
 
12945
      if(x.ge.xx(nx)) then 
 
12946
      locx2001=nx-1  
 
12947
      return
 
12948
      endif
 
12949
      ju=nx+1
 
12950
      jl=0
 
12951
    1 if((ju-jl).le.1) go to 2
 
12952
      jm=(ju+jl)/2
 
12953
      if(x.ge.xx(jm)) then
 
12954
      jl=jm
 
12955
      else
 
12956
      ju=jm
 
12957
      endif
 
12958
      go to 1
 
12959
    2 locx2001=jl
 
12960
      return
 
12961
      end
 
12962
 
 
12963
 
 
12964
      real*8 function  polderiv2001(x1,x2,x3,y1,y2,y3)
 
12965
      implicit real*8(a-h,o-z)
 
12966
      polderiv2001=(x3*x3*(y1-y2)-2.0*x2*(x3*(y1-y2)+x1*
 
12967
     .(y2-y3))+x2*x2*(y1-y3)+x1*x1*(y2-y3))/((x1-x2)*(x1-x3)*(x2-x3))
 
12968
      return
 
12969
      end
 
12970
 
 
12971
 
 
12972
      subroutine errsk(j)
 
12973
      integer jval,j
 
12974
      data jval/0/
 
12975
      jval=j
 
12976
      return
 
12977
      entry errgk(j)
 
12978
      j=jval
 
12979
      end
 
12980
 
 
12981
      subroutine alekhin(ndns,xs,qsqs,fxs,nf)
 
12982
      implicit none
 
12983
      integer ndns,nf,jpar,l,j
 
12984
      real * 4 xs,qsqs,fxs(-nf:nf)
 
12985
      real * 8 x,qsq
 
12986
      integer npdf,npar
 
12987
      integer np,nvar
 
12988
      parameter(np=9,nvar=15)
 
12989
      real*8 pdfs(np),dpdfs(np,nvar)
 
12990
      integer kord,iset,kset,kschem
 
12991
      if(ndns.le.6) then
 
12992
         kord=1
 
12993
      elseif(ndns.le.12) then
 
12994
         kord=2
 
12995
      else
 
12996
         kord=3
 
12997
      endif
 
12998
      iset=ndns-(kord-1)*6
 
12999
      if(iset.le.2) then
 
13000
         kset=0
 
13001
      elseif(iset.le.4) then
 
13002
         kset=1
 
13003
      elseif(iset.le.6) then
 
13004
         kset=2
 
13005
      elseif(iset.le.8) then
 
13006
         kset=3
 
13007
      endif
 
13008
      kschem=mod(ndns+1,2)
 
13009
      x=xs
 
13010
      qsq=qsqs
 
13011
      call a02(x,qsq,pdfs,dpdfs,NPDF,NPAR,KORD,KSCHEM,KSET)
 
13012
      call errgk(jpar)
 
13013
      if(abs(jpar).gt.npar) then
 
13014
         write(*,*) ' Alekhin PDF''s: max',npar,' parameters, got',jpar
 
13015
         stop
 
13016
      endif
 
13017
      if(jpar.gt.0) then
 
13018
         do l=1,npdf
 
13019
            pdfs(l)=pdfs(l)+dpdfs(l,jpar)
 
13020
         enddo
 
13021
      elseif(jpar.lt.0) then
 
13022
         jpar=abs(jpar)
 
13023
         do l=1,npdf
 
13024
            pdfs(l)=pdfs(l)-dpdfs(l,jpar)
 
13025
         enddo
 
13026
      endif
 
13027
      do j=-nf,nf
 
13028
         fxs(j)=0
 
13029
      enddo
 
13030
      fxs(0)=pdfs(3)/x
 
13031
      fxs(1)=( pdfs(1)+pdfs(4) )/x
 
13032
      fxs(-1)=pdfs(4)
 
13033
      fxs(2)=( pdfs(2)+pdfs(6) )/x
 
13034
      fxs(-2)=pdfs(6)/x
 
13035
      fxs(3)=pdfs(5)/x
 
13036
      fxs(-3)=fxs(3)
 
13037
      if(npdf.gt.6.and.nf.ge.4) then
 
13038
         fxs(4)=pdfs(7)/x
 
13039
         fxs(-4)=fxs(4)
 
13040
      endif
 
13041
      if(npdf.gt.7.and.nf.ge.5) then
 
13042
         fxs(5)=pdfs(8)/x
 
13043
         fxs(-5)=fxs(5)
 
13044
      endif
 
13045
      if(npdf.gt.8.and.nf.ge.6) then
 
13046
         fxs(6)=pdfs(9)/x
 
13047
         fxs(-6)=fxs(6)
 
13048
      endif
 
13049
      end
 
13050
 
 
13051
      subroutine a02(x,qsq,PDFS,DPDFS,NPDF,NPAR,KORD,KSCHEM,KSET)
 
13052
c--------------------
 
13053
c     This is a package for the parton distributions with account 
 
13054
c     of their experimental (stat+syst) and theoretical uncertainties. 
 
13055
c     The q**2 range is 2.5d0 < q**2 < 5.6d7, the x range is 1d-7 < x < 1d0. 
 
13056
c     The grid and interpolation routines are cloned from the MRS's ones.
 
13057
C
 
13058
c  Input parameters:
 
13059
c        KORD=1 -- the LO PDFs
 
13060
c        KORD=2 -- the NLO PDFs
 
13061
c        KORD=3 -- the NNLO PDFs
 
13062
C      
 
13063
c        KSCHEM=0 -- the fixed-flavor-number (FFN) scheme 
 
13064
c        KSCHEM=1 -- the variable-flavor-number (VFN) scheme
 
13065
C
 
13066
c        KSET=0 -- nominal PDFs
 
13067
c        KSET=1 -- PDFs with mass of c-quark increased from 1.5 to 1.75 GeV
 
13068
c        KSET=2 -- PDFs with the strange sea suppression factor increased from 
 
13069
c                  0.42 to 0.52
 
13070
c        KSET=3 -- PDFs with the choice B (slow evolution) for the NNLO kernel 
 
13071
c                  (used with KORD=2 only)
 
13072
c
 
13073
c  Output parameters:
 
13074
c     The array PDFS contains parton distributions times x:
 
13075
c        PDF(1) -- valence u-quarks 
 
13076
c        PDF(2) -- valence d-quarks
 
13077
c        PDF(3) -- gluons 
 
13078
c        PDF(4) -- sea u-quarks 
 
13079
c        PDF(5) -- s-quarks 
 
13080
c        PDF(6) -- sea d-quarks 
 
13081
c        PDF(7) -- c-quarks
 
13082
c        PDF(8) -- b-quarks
 
13083
c        PDF(9) -- t-quarks
 
13084
c     NPDF is the number of PDFs returned (NPDF=6 for the FFN PDFs and 9 for 
 
13085
c     the VFN ones).
 
13086
c     Output array DPDFS(ipdf,ipar) contains derivatives of the PDFs on the 
 
13087
c     fitted parameters with the number of the parameters returned in NPAR.
 
13088
c     These derivatives are transformed to the orthonormal basis of 
 
13089
c     eigenvectors of the parameters error matrix. For this reason the 
 
13090
c     variation of the PDFs in the derivatives directions can be performed 
 
13091
c     independently. For example the dispersion of the i-th PDF can be stored 
 
13092
c     in DELPDF using the code 
 
13093
c
 
13094
c-----------------
 
13095
c          DELPDF=0.
 
13096
c          do k=1,npar
 
13097
c            DELPDF=DELPDF+dpdfs(i,k)**2
 
13098
c          end do
 
13099
c-----------------
 
13100
c     and its random value is stored in RPDF using the code 
 
13101
c-----------------
 
13102
c          RPDF=pdfs(i)          
 
13103
c          do k=1,npar
 
13104
c            s=0.
 
13105
c            do k=1,96
 
13106
c              s=s+(2*rndm(xxx)-1)/sqrt(32.)
 
13107
c            end do
 
13108
c            RPDF=RPDF+s*dpdfs(i,k)
 
13109
c          end do
 
13110
c-----------------
 
13111
c          
 
13112
c         Reference: hep-ph/0211096
 
13113
c      
 
13114
c         Comments to: alekhin@sirius.ihep.su                      
 
13115
c                                                               
 
13116
      implicit real*8(a-h,o-z)
 
13117
      parameter(nxb=59,nq=37,ntenth=33,np=9,nvar=15)
 
13118
      real*4 f(np,nxb,nq+1),qq(nq),xx(nxb),xx0(nxb),n0(np)
 
13119
      real*8 pdfs(np),dpdfs(np,nvar)
 
13120
      real*4 df(nvar,np,nxb,nq+1)
 
13121
      data xx0/1d-7,2d-7,4d-7,6d-7,8d-7,
 
13122
     .        1d-6,2d-6,4d-6,6d-6,8d-6,
 
13123
     .        1d-5,2d-5,4d-5,6d-5,8d-5,
 
13124
     .        1d-4,2d-4,4d-4,6d-4,8d-4,
 
13125
     .        1d-3,2d-3,4d-3,6d-3,8d-3,
 
13126
     .        1d-2,1.4d-2,2d-2,3d-2,4d-2,6d-2,8d-2,
 
13127
     .     .1d0,.125d0,.15d0,.175d0,.2d0,.225d0,.25d0,.275d0,
 
13128
     .     .3d0,.325d0,.35d0,.375d0,.4d0,.425d0,.45d0,.475d0,
 
13129
     .     .5d0,.525d0,.55d0,.575d0,.6d0,.65d0,.7d0,.75d0,
 
13130
     .     .8d0,.9d0,1d0/
 
13131
      data qq/2.5d0,3.2d0,4d0,5d0,6.4d0,8d0,1d1,
 
13132
     .        1.2d1,1.8d1,2.6d1,4d1,6.4d1,1d2,
 
13133
     .        1.6d2,2.4d2,4d2,6.4d2,1d3,1.8d3,3.2d3,5.6d3,1d4,
 
13134
     .        1.8d4,3.2d4,5.6d4,1d5,1.8d5,3.2d5,5.6d5,1d6,
 
13135
     .        1.8d6,3.2d6,5.6d6,1d7,1.8d7,3.2d7,5.6d7/
 
13136
      data xmin,xmax,qsqmin,qsqmax/1d-7,1d0,2.5d0,5.6d7/
 
13137
      data n0/3,4,5,9,9,9,9,9,9/
 
13138
      data KORDS,KSCHEMS,KSETS /-1,-1,-1/
 
13139
      data init /0/
 
13140
 
 
13141
c I/O channel to read the data
 
13142
      data nport/1/
 
13143
c put in your local address of the PDFs files in LOCDIR
 
13144
      character locdir*41
 
13145
      data locdir /' '/
 
13146
      character *1 pdford(3)
 
13147
      data pdford/'1','2','3'/
 
13148
      character * 3 pdfschem(0:1)
 
13149
      data pdfschem /'ffn','vfn'/
 
13150
      character *3 pdfset(0:3)
 
13151
      data pdfset /'   ','_mc','_ss','_kr'/
 
13152
 
 
13153
      if (init.eq.0) then 
 
13154
        do n=1,ntenth-1
 
13155
          xx(n)=log10(xx0(n)/xx0(ntenth))+xx0(ntenth)
 
13156
        end do
 
13157
        do n=ntenth,nxb
 
13158
          xx(n)=xx0(n)
 
13159
        end do
 
13160
      init=1
 
13161
      end if
 
13162
 
 
13163
      if (kschem.eq.0) then 
 
13164
        npdf=6
 
13165
      else 
 
13166
        npdf=9
 
13167
      end if
 
13168
      npar=nvar
 
13169
 
 
13170
      if(kords.eq.kord.and.kschems.eq.kschem.and.ksets.eq.kset) goto 10
 
13171
 
 
13172
      kords=kord
 
13173
      kschems=kschem
 
13174
      ksets=kset      
 
13175
 
 
13176
      write(*,*) 'a02.pdfs_'//pdford(kord)//'_'
 
13177
     /     //pdfschem(kschem)//pdfset(kset)
 
13178
      open(unit=nport,status='old',err=199
 
13179
     ,    ,file='a02.pdfs_'//pdford(kord)//'_'
 
13180
     /     //pdfschem(kschem)//pdfset(kset))
 
13181
      do n=1,nxb-1
 
13182
        do m=1,nq
 
13183
          read(nport,100) (f(i,n,m),i=1,npdf)
 
13184
          do i=1,npdf
 
13185
            f(i,n,m)=f(i,n,m)/(1d0-xx0(n))**n0(i)
 
13186
          end do
 
13187
        end do
 
13188
      end do
 
13189
      close(unit=nport)
 
13190
  100 format (12f11.5)
 
13191
 
 
13192
      open(unit=nport,status='old'
 
13193
     ,    ,file='a02.dpdfs_'//pdford(kord)//'_'
 
13194
     /                              //pdfschem(kschem))
 
13195
      do n=1,nxb-1
 
13196
        do m=1,nq
 
13197
          do i=1,npdf 
 
13198
            read (nport,*) (df(k,i,n,m),k=1,npar)
 
13199
            do k=1,npar
 
13200
              df(k,i,n,m)=df(k,i,n,m)/(1d0-xx0(n))**n0(i)
 
13201
            end do
 
13202
          end do
 
13203
        end do
 
13204
      end do
 
13205
      close(unit=nport)
 
13206
 
 
13207
      do i=1,npdf
 
13208
        do m=1,nq
 
13209
          f(i,nxb,m)=0d0
 
13210
          do k=1,npar
 
13211
            df(k,i,nxb,m)=0d0
 
13212
          end do
 
13213
        end do
 
13214
      end do
 
13215
 
 
13216
  10  continue
 
13217
 
 
13218
c      if(qsq.lt.qsqmin.or.qsq.gt.qsqmax) print 99,qsq
 
13219
c      if(x.lt.xmin.or.x.gt.xmax)       print 98,x
 
13220
  99  format('  WARNING:  Q^2 VALUE IS OUT OF RANGE   ')
 
13221
  98  format('  WARNING:   X  VALUE IS OUT OF RANGE   ')
 
13222
 
 
13223
      x=max(x,xmin)
 
13224
      x=min(x,xmax)
 
13225
      qsq=max(qsq,qsqmin)
 
13226
      qsq=min(qsq,qsqmax)
 
13227
      xxx=x
 
13228
      if(x.lt.xx(ntenth)) xxx=log10(x/xx(ntenth))+xx(ntenth)
 
13229
      n=0
 
13230
  70  n=n+1
 
13231
      if(xxx.gt.xx(n+1)) goto 70
 
13232
      a=(xxx-xx(n))/(xx(n+1)-xx(n))
 
13233
      m=0
 
13234
  80  m=m+1
 
13235
      if(qsq.gt.qq(m+1)) goto 80
 
13236
      b=(qsq-qq(m))/(qq(m+1)-qq(m))
 
13237
 
 
13238
      do i=1,npdf
 
13239
        pdfs(i)= (1d0-a)*(1d0-b)*f(i,n,m) + (1d0-a)*b*f(i,n,m+1)
 
13240
     .    +       a*(1d0-b)*f(i,n+1,m) + a*b*f(i,n+1,m+1)
 
13241
        do k=1,npar
 
13242
          dpdfs(i,k)=(1d0-a)*(1d0-b)*df(k,i,n,m)+(1d0-a)*b*df(k,i,n,m+1)
 
13243
     .    +       a*(1d0-b)*df(k,i,n+1,m) + a*b*df(k,i,n+1,m+1)
 
13244
        end do
 
13245
        pdfs(i)=pdfs(i)*(1d0-x)**n0(i)
 
13246
        do k=1,npar
 
13247
          dpdfs(i,k)=dpdfs(i,k)*(1d0-x)**n0(i)
 
13248
        end do
 
13249
      end do
 
13250
 
 
13251
      return
 
13252
 
 
13253
 199  print *,'The PDF set is inavailable'
 
13254
      return
 
13255
 
 
13256
      end
 
13257