Change needed for G4
[u/mrichter/AliRoot.git] / LHAPDF / lhapdf5.3.1 / QCDNUM.f
1 CDECK  ID>, QCDCOM.
2  
3 CDECK  ID>, QCDCOM.
4  
5 C------------------------QCDNUM COMMON BLOCKS---------------------
6  
7 CDECK  ID>, QCDNUM.
8
9 CDECK  ID>, QNINIT.
10
11 C     =================
12       SUBROUTINE QNINIT
13 C     =================
14
15 C---  QNINIT: initialisation.
16 C---  Called by user.
17  
18       IMPLICIT DOUBLE PRECISION (A-H,O-Z)
19  
20       CHARACTER*8 CHVERS,CHDATE
21       COMMON/QCVERS/ CHVERS,CHDATE
22  
23  
24       COMMON/QCCONS/
25      +PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L,
26      +AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7),
27      +C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3,
28      +C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9,
29      +C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1,
30      +C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF
31  
32  
33  
34       LOGICAL
35      +LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB,
36      +LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS,
37      +LALFOK,LDQ2OK,LWT1OK,LWT2OK,
38      +LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ,
39      +LFFCAL,LASOLD
40
41       COMMON/QCFLAG/ 
42      +IORD,IOLAST,
43      +LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB,
44      +LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS,
45      +LALFOK,LDQ2OK,LWT1OK,LWT2OK,
46      +LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ,
47      +LFFCAL(7,30),LASOLD
48  
49  
50       PARAMETER ( MXX = 410 )
51       PARAMETER ( MQ2 =  120 )
52
53 C--   Do not set the following parameter to zero!
54       PARAMETER ( NDFMAX = 20)
55
56  
57       COMMON/QCGRID/
58      +SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS,
59      +XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45,
60      +NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2),
61      +IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2)
62  
63  
64       REAL
65      +WGTFF1,WGTFG1,
66      +WGTGF1,WGTGG1,
67      +WGTPP2,WGTPM2,WGTNS2,
68      +WGTFF2,WGTFG2,
69      +WGTGF2,WGTGG2,
70      +WGTC2Q,WGTC2G,YNTC2Q,
71      +WGTCLQ,WGTCLG,WGTC3Q
72
73       COMMON/QCWEIT/
74      +WGTFF1(MXX*(MXX+1)/2)    ,WGTFG1(MXX*(MXX+1)/2,3:5),
75      +WGTGF1(MXX*(MXX+1)/2)    ,WGTGG1(MXX*(MXX+1)/2,3:5),
76      +WGTPP2(MXX*(MXX+1)/2,3:5),WGTPM2(MXX*(MXX+1)/2,3:5),
77      +WGTNS2(MXX*(MXX+1)/2,3:5),
78      +WGTFF2(MXX*(MXX+1)/2,3:5),WGTFG2(MXX*(MXX+1)/2,3:5),
79      +WGTGF2(MXX*(MXX+1)/2,3:5),WGTGG2(MXX*(MXX+1)/2,3:5),
80      +WGTC2Q(MXX*(MXX+1)/2)    ,WGTC2G(MXX*(MXX+1)/2,3:5),
81      +WGTCLQ(MXX*(MXX+1)/2)    ,WGTCLG(MXX*(MXX+1)/2,3:5),
82      +WGTC3Q(MXX*(MXX+1)/2)    ,YNTC2Q(MXX)
83
84       COMMON/QCWADR/ IWADR(MXX,MXX)
85
86  
87       COMMON/QCPASS/
88      +ALPHA0, Q0ALFA, ASLAST, QALAST,
89      +ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2),
90      +DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10),
91      +FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2),
92      +FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2),
93      +FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2),
94      +FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST,
95      +MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2),
96      +ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2),
97      +IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10)
98
99       LOGICAL LEVDONE,LE_DONE
100       COMMON/QCLEVL/
101      +LEVDONE(MXX,10),LE_DONE(MXX)
102  
103  
104       CHARACTER*5 PNAM,STFNAM
105       LOGICAL     LNFP
106       COMMON /QCLNFP/ LNFP(0:30,3:5)
107       COMMON /QCPNAM/ PNAM(0:30)
108       COMMON /QCPWGT/ PWGT(0:10,0:30,3:5)
109       COMMON /QCFNAM/ STFNAM(7)
110  
111  
112       LOGICAL LTIME  
113       REAL T_START,T_END,T_SPENT
114       COMMON/QCTIME/T_START(10),T_END(10),T_SPENT(10),N_CALLS(10),
115      +E_CALLS(10),LTIME
116       COMMON/QCFCNT/IFCNT(-1:1,5)
117
118       CHARACTER*7 TSNAM
119       COMMON/QCTRCE/ TSNAM(0:19)
120       COMMON/QCTRCI/ NTCAL(0:19),ITADR
121 c
122 c common added by MRW 18/3/05 to make silent mode for LHAPDF
123 c
124       common/lhasilent/lhasilent
125
126  
127       CHVERS = '16.12   '
128       CHDATE = '12-08-98'
129  
130       LDOUBL = .TRUE.
131       if(lhasilent.eq.0) then
132       WRITE(6,'(/////)')
133       WRITE(6,
134      &'(8X,''+-----------------------------------------------+'')')
135       WRITE(6,
136      &'(8X,''|                                               |'')')
137 c      LDOUBL = .TRUE.
138       WRITE(6,
139      &'(8X,''| You are using the double precision version of |'')')
140       WRITE(6,
141      &'(8X,''|                                               |'')')
142       WRITE(6,
143      &'(8X,''|              Q C D N U M '',A8,
144      &     ''             |'')') CHVERS
145       WRITE(6,
146      &'(8X,''|                                               |'')')
147       WRITE(6,
148      &'(8X,''|         Author  : Michiel Botje               |'')')
149       WRITE(6,
150      &'(8X,''|         Email   : h24@nikhef.nl               |'')')
151       WRITE(6,
152      &'(8X,''|                                               |'')')
153       WRITE(6,
154      &'(8X,''|         Date    : '',A8,
155      &     ''                    |'')') CHDATE
156       WRITE(6,
157      &'(8X,''|         Max NX  : '',I3,
158      &     ''                         |'')') MXX-1
159       WRITE(6,
160      &'(8X,''|         Max NQ2 : '',I3,
161      &     ''                         |'')') MQ2-1
162       WRITE(6,
163      &'(8X,''|                                               |'')')
164       WRITE(6,
165      &'(8X,''+-----------------------------------------------+'')')
166       WRITE(6,'(/////)')
167       endif
168  
169       IORD   = 2
170       IOLAST = -999
171       Q0ALFA = 50.
172       ALPHA0 = 0.180
173       QALAST = -999.
174       ASLAST = -999.
175       SCAX0  = 0.20
176       SCAQ0  = 1.D10
177  
178       PI     = 3.14159265359
179       PROTON = 0.9382796
180       EUTRON = 0.9395731
181       UCLEON = (PROTON + EUTRON) / 2.
182       UDSCBT(1) = 0.005
183       UDSCBT(2) = 0.01
184       UDSCBT(3) = 0.3
185       UDSCBT(4) = 1.5
186       UDSCBT(5) = 5.0
187       UDSCBT(6) = 188.
188       CBMSTF(4) = UDSCBT(4)
189       CBMSTF(5) = UDSCBT(4)
190       CBMSTF(6) = UDSCBT(5)
191       CBMSTF(7) = UDSCBT(5)
192       CHARGE(4) = 4./9.
193       CHARGE(5) = 4./9.
194       CHARGE(6) = 1./9.
195       CHARGE(7) = 1./9.
196       AAM2H     = 1.
197       BBM2H     = 0.
198       AAM2L     = 1.
199       BBM2L     = 0.
200       AAAR2     = 1.
201       BBBR2     = 0.
202       FL_FAC    = 0.
203       C1S3   = 1./3.
204       C2S3   = 2./3.
205       C4S3   = 4./3.
206       C5S3   = 5./3.
207       C8S3   = 8./3.
208       C14S3  = 14./3.
209       C16S3  = 16./3.
210       C20S3  = 20./3.
211       C28S3  = 28./3.
212       C38S3  = 38./3.
213       C40S3  = 40./3.
214       C44S3  = 44./3.
215       C52S3  = 52./3.
216       C136S3 = 136./3.
217       C11S6  = 11./6.
218       C2S9   = 2./9.
219       C4S9   = 4./9.
220       C10S9  = 10./9.
221       C14S9  = 14./9.
222       C16S9  = 16./9.
223       C40S9  = 40./9.
224       C44S9  = 44./9.
225       C62S9  = 62./9.
226       C112S9 = 112./9.
227       C182S9 = 182./9.
228       C11S12 = 11./12.
229       C35S18 = 35./18.
230       C11S3  = 11./3.
231       C22S3  = 22./3.
232       C61S12 = 61./12.
233       C215S1 = 215./12.
234       C29S12 = 29./12.
235       CPI2S3 = PI**2/3.
236       CPIA   = 67./18. - CPI2S3/2.
237       CPIB   = 4.*CPI2S3
238       CPIC   = 17./18. + 3.5*CPI2S3
239       CPID   = 367./36. - CPI2S3
240       CPIE   = 5. - CPI2S3
241       CPIF   = CPI2S3 - 218./9.
242
243       CCA    = 3.
244       CCF    = (CCA*CCA-1.)/(2.*CCA)
245       CTF    = 0.5
246       CATF   = CCA*CTF
247       CFTF   = CCF*CTF
248  
249       DO I = 1,10
250         T_SPENT(I) = 0.
251         E_CALLS(I) = 0.
252         N_CALLS(I) = 0
253       ENDDO
254       LTIME  = .FALSE.
255
256       LBMARK = .FALSE.
257       LW1ANA = .TRUE.
258       LW1NUM = .FALSE.
259       LW2NUM = .TRUE.
260       LW2STF = .TRUE.
261       LWF2C  = .FALSE.
262       LWF2B  = .FALSE.
263       LWFLC  = .FALSE.
264       LWFLB  = .FALSE.
265       LIMCK  = .TRUE.
266       LPLUS  = .TRUE.
267       LALFOK = .FALSE.
268       LDQ2OK = .FALSE.
269       LWT1OK = .FALSE.
270       LWT2OK = .FALSE.
271       LWTFOK = .FALSE.
272       LWFCOK = .FALSE.
273       LWLCOK = .FALSE.
274       LWFBOK = .FALSE.
275       LWLBOK = .FALSE.
276       LMARK  = .FALSE.
277       LCLOWQ = .TRUE.
278       LASOLD = .FALSE.
279       DO I = 1,30
280         DO J = 1,7
281           LFFCAL(J,I)  = .FALSE.
282         ENDDO
283       ENDDO
284 C--   Invalidate all evolutions      
285       CALL QNFALS(LEVDONE,MXX*10)
286       CALL QNFALS(LE_DONE,MXX)
287       CALL QNINUL(IQL_LAST,10)
288       CALL QNINUL(IQ0_LAST,10)
289       CALL QNINUL(IQH_LAST,10)
290  
291       ITADR = 0
292       DO I = 0,19
293         TSNAM(I) = '       '
294         NTCAL(I) = 0
295       ENDDO
296
297       NXX    = 0
298       NQ2    = 0
299       NGRVER = 0
300       NDFAST = 30
301       XMICUT = -1.
302       QMICUT = -1.
303       QMACUT = -1.
304       RS2CUT = -1.
305       QMINAS = 0.
306       THRS34 = -1.D10
307       THRS45 =  1.D10
308  
309       CALL VZERO_LHA (WGTFF1,MXX*(MXX+1)/2)
310       CALL VZERO_LHA (WGTFG1,MXX*(MXX+1)*3/2)
311       CALL VZERO_LHA (WGTGF1,MXX*(MXX+1)/2)
312       CALL VZERO_LHA (WGTGG1,MXX*(MXX+1)*3/2)
313       CALL VZERO_LHA (WGTPP2,MXX*(MXX+1)*3/2)
314       CALL VZERO_LHA (WGTPM2,MXX*(MXX+1)*3/2)
315       CALL VZERO_LHA (WGTNS2,MXX*(MXX+1)*3/2)
316       CALL VZERO_LHA (WGTFF2,MXX*(MXX+1)*3/2)
317       CALL VZERO_LHA (WGTFG2,MXX*(MXX+1)*3/2)
318       CALL VZERO_LHA (WGTGF2,MXX*(MXX+1)*3/2)
319       CALL VZERO_LHA (WGTGG2,MXX*(MXX+1)*3/2)
320       CALL VZERO_LHA (WGTC2Q,MXX*(MXX+1)/2)
321       CALL VZERO_LHA (WGTC2G,MXX*(MXX+1)*3/2)
322       CALL VZERO_LHA (YNTC2Q,MXX)
323       CALL VZERO_LHA (WGTCLQ,MXX*(MXX+1)/2)
324       CALL VZERO_LHA (WGTCLG,MXX*(MXX+1)*3/2)
325       CALL VZERO_LHA (WGTC3Q,MXX*(MXX+1)/2)
326
327       CALL QNVNUL(PWGT,11*31*3)
328       CALL QNINUL(NFMAP,MQ2)
329       CALL QNINUL(MARKFF,MXX*MQ2)
330       CALL QNINUL(MARKFH,MXX*MQ2)
331       CALL QNINUL(MARKQQ,MQ2)
332       CALL QNINUL(IDFAST,7*30)
333       CALL QNINUL(IFCNT,3*5)  
334
335       CALL QNVNUL(PDFQCD,MXX*MQ2*11)
336       DO ID = 1,NDFMAX
337         DO IX = 1,MXX
338           DO IQ = 1,MQ2
339             FSTORE(IX,IQ,30+ID) = -501.
340           ENDDO
341         ENDDO
342       ENDDO
343
344       PNAM(0)   = 'GLUON'
345       PNAM(1)   = 'SINGL'
346       LNFP(0,3) = .TRUE.
347       LNFP(0,4) = .TRUE.
348       LNFP(0,5) = .TRUE.
349       LNFP(1,3) = .TRUE.
350       LNFP(1,4) = .TRUE.
351       LNFP(1,5) = .TRUE.
352       DO 10 I = 2,30
353         PNAM(I)   = 'FREE '
354         LNFP(I,3) = .FALSE.
355         LNFP(I,4) = .FALSE.
356         LNFP(I,5) = .FALSE.
357   10  CONTINUE
358       PWGT(0,0,3) = 1.
359       PWGT(0,0,4) = 1.
360       PWGT(0,0,5) = 1.
361       PWGT(1,1,3) = 1.
362       PWGT(1,1,4) = 1.
363       PWGT(1,1,5) = 1.
364       STFNAM(1)   = 'F2   '
365       STFNAM(2)   = 'FL   '
366       STFNAM(3)   = 'XF3  '
367       STFNAM(4)   = 'F2C  '
368       STFNAM(5)   = 'FLC  '
369       STFNAM(6)   = 'F2B  '
370       STFNAM(7)   = 'FLB  '
371
372       CALL QTRACE('QNINIT ',0)
373  
374       RETURN
375       END
376  
377 CDECK  ID>, QTRACE.
378
379 C     ===============================
380       SUBROUTINE QTRACE(SRNAM,IPRINT)
381 C     ===============================
382  
383       IMPLICIT DOUBLE PRECISION (A-H,O-Z)
384
385       CHARACTER*7 SRNAM
386
387       CHARACTER*7 TSNAM
388       COMMON/QCTRCE/ TSNAM(0:19)
389       COMMON/QCTRCI/ NTCAL(0:19),ITADR
390  
391
392       IF(IPRINT.EQ.0) THEN
393
394         IF(SRNAM.EQ.TSNAM(ITADR)) THEN
395           NTCAL(ITADR) = NTCAL(ITADR) + 1
396         ELSE
397           ITADR = MOD(ITADR+1,20)
398           TSNAM(ITADR) = SRNAM
399           NTCAL(ITADR) = 1
400         ENDIF
401
402       ELSE
403
404         WRITE(6,'(/'' ----------------------------'')')
405
406         K = -20
407         DO I = ITADR+1,ITADR+19
408           J = MOD(I,20)
409           K = K+1
410           WRITE(6,'(I4,2X,A7,''  #calls = '',I5)')
411      +    K,TSNAM(J),NTCAL(J)
412         ENDDO
413         K = 0
414         WRITE(6,'(I4,2X,A7,''  #calls = '',I5,''  <--- error'')')
415      +  K,TSNAM(ITADR),NTCAL(ITADR)
416
417         WRITE(6,'( '' ----------------------------'')')
418
419       ENDIF
420
421       RETURN
422       END
423  
424 CDECK  ID>, QNDUMP.
425
426 C     ======================
427       SUBROUTINE QNDUMP(LUN)
428 C     ======================
429
430 C---  QNDUMP: write weight tables to LUN.
431 C---  Called by user.
432  
433       IMPLICIT DOUBLE PRECISION (A-H,O-Z)
434  
435  
436       PARAMETER ( MXX = 410 )
437       PARAMETER ( MQ2 =  120 )
438
439 C--   Do not set the following parameter to zero!
440       PARAMETER ( NDFMAX = 20)
441
442       CHARACTER*8 CHVERS,CHDATE
443       COMMON/QCVERS/ CHVERS,CHDATE
444  
445  
446       COMMON/QCCONS/
447      +PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L,
448      +AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7),
449      +C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3,
450      +C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9,
451      +C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1,
452      +C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF
453  
454  
455  
456       LOGICAL
457      +LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB,
458      +LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS,
459      +LALFOK,LDQ2OK,LWT1OK,LWT2OK,
460      +LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ,
461      +LFFCAL,LASOLD
462
463       COMMON/QCFLAG/ 
464      +IORD,IOLAST,
465      +LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB,
466      +LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS,
467      +LALFOK,LDQ2OK,LWT1OK,LWT2OK,
468      +LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ,
469      +LFFCAL(7,30),LASOLD
470  
471  
472       COMMON/QCGRID/
473      +SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS,
474      +XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45,
475      +NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2),
476      +IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2)
477  
478  
479       REAL
480      +WGTFF1,WGTFG1,
481      +WGTGF1,WGTGG1,
482      +WGTPP2,WGTPM2,WGTNS2,
483      +WGTFF2,WGTFG2,
484      +WGTGF2,WGTGG2,
485      +WGTC2Q,WGTC2G,YNTC2Q,
486      +WGTCLQ,WGTCLG,WGTC3Q
487
488       COMMON/QCWEIT/
489      +WGTFF1(MXX*(MXX+1)/2)    ,WGTFG1(MXX*(MXX+1)/2,3:5),
490      +WGTGF1(MXX*(MXX+1)/2)    ,WGTGG1(MXX*(MXX+1)/2,3:5),
491      +WGTPP2(MXX*(MXX+1)/2,3:5),WGTPM2(MXX*(MXX+1)/2,3:5),
492      +WGTNS2(MXX*(MXX+1)/2,3:5),
493      +WGTFF2(MXX*(MXX+1)/2,3:5),WGTFG2(MXX*(MXX+1)/2,3:5),
494      +WGTGF2(MXX*(MXX+1)/2,3:5),WGTGG2(MXX*(MXX+1)/2,3:5),
495      +WGTC2Q(MXX*(MXX+1)/2)    ,WGTC2G(MXX*(MXX+1)/2,3:5),
496      +WGTCLQ(MXX*(MXX+1)/2)    ,WGTCLG(MXX*(MXX+1)/2,3:5),
497      +WGTC3Q(MXX*(MXX+1)/2)    ,YNTC2Q(MXX)
498
499       COMMON/QCWADR/ IWADR(MXX,MXX)
500
501
502       REAL
503      +WH_C0KG,WH_C1KG,WH_C1BKG,
504      +WH_C1KQ,WH_C1BKQ,WH_D1KQ,WH_D1BKQ
505
506       COMMON/QCHWGT/
507      +WH_C0KG(0:MXX,MQ2,4:7),
508      +WH_C1KG(0:MXX,MQ2,4:7),WH_C1BKG(0:MXX,MQ2,4:7),
509      +WH_C1KQ(0:MXX,MQ2,4:7),WH_C1BKQ(0:MXX,MQ2,4:7),
510      +WH_D1KQ(0:MXX,MQ2,4:7),WH_D1BKQ(0:MXX,MQ2,4:7)
511
512
513       DIMENSION STOREM(6)
514
515       CALL QTRACE('QNDUMP ',0)
516
517       STOREM(1) = CBMSTF(4)
518       STOREM(2) = CBMSTF(6)
519       STOREM(3) = 0.
520       STOREM(4) = 0.
521       STOREM(5) = 0.
522       STOREM(6) = 0.
523
524       WRITE(LUN) MXX,MQ2
525       WRITE(LUN) CHVERS,CHDATE
526       WRITE(LUN) STOREM
527       WRITE(LUN) LWT1OK,LWT2OK,LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,
528      +           LPLUS
529       WRITE(LUN) XXTAB,Q2TAB,
530      +           NXX,NQ2,IQF2C,IQF2B,IQFLC,IQFLB
531       IF(LWT1OK) THEN
532       WRITE(LUN) WGTFF1,WGTFG1,WGTGF1,WGTGG1
533       ENDIF
534       IF(LWT2OK) THEN
535       WRITE(LUN) WGTPP2,WGTPM2,WGTNS2,WGTFF2,WGTFG2,WGTGF2,WGTGG2
536       ENDIF
537       IF(LWTFOK) THEN
538       WRITE(LUN) WGTC2Q,WGTC2G,YNTC2Q,WGTCLQ,WGTCLG,WGTC3Q
539       ENDIF
540       IF(LWFCOK.OR.LWLCOK.OR.LWFBOK.OR.LWLBOK) THEN
541       WRITE(LUN) WH_C0KG,WH_C1KG,WH_C1BKG,
542      +           WH_C1KQ,WH_C1BKQ,WH_D1KQ,WH_D1BKQ
543       ENDIF
544  
545       RETURN
546       END
547  
548 CDECK  ID>, QNREAD.
549
550 C     =================================
551       SUBROUTINE QNREAD(LUN,ISTOP,IERR)
552 C     =================================
553
554 C---  QNDUMP: read weight tables from LUN.
555 C---  Called by user.
556 C---  Input  integer LUN
557 C---         integer ISTOP = 0 read the file
558 C---                 ISTOP = 1 read only when ierr = 0
559 C---                 ISTOP = 2 stop the program when ierr .ne. 0
560 C---  Output integer IERR  = 0 all ok
561 C---                       = 1 xgrid on file .ne. that in QCDNUM
562 C---                       = 2 file contains heavy quark weight tables and
563 C---                           qgrid on file .ne. that in QCDNUM
564 C---                       = 3 file contains charm weight tables and
565 C---                           c mass on the file .ne. that in QCDNUM
566 C---                       = 4 file contains bottom weight tables and
567 C---                           b mass on the file .ne. that in QCDNUM
568  
569       IMPLICIT DOUBLE PRECISION (A-H,O-Z)
570  
571  
572       PARAMETER ( MXX = 410 )
573       PARAMETER ( MQ2 =  120 )
574
575 C--   Do not set the following parameter to zero!
576       PARAMETER ( NDFMAX = 20)
577
578       CHARACTER*8 CHVERS,CHDATE
579       COMMON/QCVERS/ CHVERS,CHDATE
580  
581  
582       COMMON/QCCONS/
583      +PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L,
584      +AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7),
585      +C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3,
586      +C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9,
587      +C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1,
588      +C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF
589  
590  
591  
592       LOGICAL
593      +LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB,
594      +LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS,
595      +LALFOK,LDQ2OK,LWT1OK,LWT2OK,
596      +LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ,
597      +LFFCAL,LASOLD
598
599       COMMON/QCFLAG/ 
600      +IORD,IOLAST,
601      +LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB,
602      +LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS,
603      +LALFOK,LDQ2OK,LWT1OK,LWT2OK,
604      +LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ,
605      +LFFCAL(7,30),LASOLD
606  
607  
608       COMMON/QCGRID/
609      +SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS,
610      +XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45,
611      +NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2),
612      +IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2)
613  
614  
615       REAL
616      +WGTFF1,WGTFG1,
617      +WGTGF1,WGTGG1,
618      +WGTPP2,WGTPM2,WGTNS2,
619      +WGTFF2,WGTFG2,
620      +WGTGF2,WGTGG2,
621      +WGTC2Q,WGTC2G,YNTC2Q,
622      +WGTCLQ,WGTCLG,WGTC3Q
623
624       COMMON/QCWEIT/
625      +WGTFF1(MXX*(MXX+1)/2)    ,WGTFG1(MXX*(MXX+1)/2,3:5),
626      +WGTGF1(MXX*(MXX+1)/2)    ,WGTGG1(MXX*(MXX+1)/2,3:5),
627      +WGTPP2(MXX*(MXX+1)/2,3:5),WGTPM2(MXX*(MXX+1)/2,3:5),
628      +WGTNS2(MXX*(MXX+1)/2,3:5),
629      +WGTFF2(MXX*(MXX+1)/2,3:5),WGTFG2(MXX*(MXX+1)/2,3:5),
630      +WGTGF2(MXX*(MXX+1)/2,3:5),WGTGG2(MXX*(MXX+1)/2,3:5),
631      +WGTC2Q(MXX*(MXX+1)/2)    ,WGTC2G(MXX*(MXX+1)/2,3:5),
632      +WGTCLQ(MXX*(MXX+1)/2)    ,WGTCLG(MXX*(MXX+1)/2,3:5),
633      +WGTC3Q(MXX*(MXX+1)/2)    ,YNTC2Q(MXX)
634
635       COMMON/QCWADR/ IWADR(MXX,MXX)
636
637
638       REAL
639      +WH_C0KG,WH_C1KG,WH_C1BKG,
640      +WH_C1KQ,WH_C1BKQ,WH_D1KQ,WH_D1BKQ
641
642       COMMON/QCHWGT/
643      +WH_C0KG(0:MXX,MQ2,4:7),
644      +WH_C1KG(0:MXX,MQ2,4:7),WH_C1BKG(0:MXX,MQ2,4:7),
645      +WH_C1KQ(0:MXX,MQ2,4:7),WH_C1BKQ(0:MXX,MQ2,4:7),
646      +WH_D1KQ(0:MXX,MQ2,4:7),WH_D1BKQ(0:MXX,MQ2,4:7)
647
648  
649       COMMON/QCPASS/
650      +ALPHA0, Q0ALFA, ASLAST, QALAST,
651      +ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2),
652      +DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10),
653      +FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2),
654      +FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2),
655      +FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2),
656      +FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST,
657      +MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2),
658      +ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2),
659      +IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10)
660
661       LOGICAL LEVDONE,LE_DONE
662       COMMON/QCLEVL/
663      +LEVDONE(MXX,10),LE_DONE(MXX)
664  
665
666       CHARACTER*8 RHVERS,RHDATE
667       LOGICAL     RWT1OK,RWT2OK,RWTFOK,RWFCOK
668       LOGICAL     RWLCOK,RWFBOK,RWLBOK,RPLUS
669       LOGICAL     LREADX,LREADQ,LREADB,LREADC
670       DIMENSION   RMASS(6)
671       DIMENSION   RXTAB(MXX),RQTAB(MQ2)
672       DIMENSION   IRF2C(MQ2),IRF2B(MQ2),IRFLC(MQ2),IRFLB(MQ2)
673 c
674 c common added 18/3/05 by MRW
675       common/lhasilent/lhasilent
676
677       CALL QTRACE('QNREAD ',0)
678
679       REWIND LUN
680
681 C--   Setup the weight adresses
682 C--   (Usually done in QNFILW, but this routine might not be called)
683       DO IX0 = 1,MXX
684         DO IX = IX0,MXX
685           IWADR(IX,IX0) = IWTAD(IX,IX0)
686         ENDDO
687       ENDDO
688
689 C--   Read header information
690       READ(LUN,ERR=500) KXX,KQ2
691       IF(KXX.NE.MXX.OR.KQ2.NE.MQ2) THEN
692         WRITE(6,'(/'' QNREAD: nxmax, nqmax on file  '',2I5,
693      +            /''         nxmax, nqmax in QCDNUM'',2I5,
694      +            /''         Incompatible ---> STOP'')') 
695      +                        KXX,KQ2,MXX,MQ2
696         STOP
697       ENDIF
698       READ(LUN,ERR=500) RHVERS,RHDATE
699       READ(RHVERS(1:2),'(I2)') IV
700
701 C--   If ISTOP > 0 : stop when fileversion = QCDNUM15 or lower
702 C--   If ISTOP = 0 : read up to the weight tables
703       IF(IV.LE.15.AND.ISTOP.NE.0) THEN
704         WRITE(6,'(/'' QNREAD: file was written with QCDNUM'',A8,
705      +             '' Incompatible ---> STOP'')')
706      +   RHVERS
707         STOP   
708       ENDIF
709       if(lhasilent.eq.0) 
710      + WRITE(6,'(/'' QNREAD: file was written with QCDNUM'',A8)')
711      + RHVERS
712
713       READ(LUN,ERR=500) RMASS  
714       READ(LUN,ERR=500) RWT1OK,RWT2OK,RWTFOK,RWFCOK,RWLCOK,RWFBOK,
715      +                  RWLBOK,RPLUS
716       READ(LUN,ERR=500) RXTAB,RQTAB,
717      +                  NRX,NRQ,IRF2C,IRF2B,IRFLC,IRFLB
718
719       IERR   = 0
720       LREADX = .FALSE.
721       LREADQ = .FALSE.
722       LREADC = .FALSE.
723       LREADB = .FALSE.
724
725 C--   Check xgrid (if there is one already defined)  
726       IF(NXX.NE.0)     THEN
727         IF(NXX.NE.NRX) THEN
728           IERR = 1
729         ELSE
730           DO IX = 1,NXX
731             IF(RXTAB(IX).NE.XXTAB(IX)) IERR = 1
732           ENDDO
733         ENDIF
734       ENDIF
735
736 C--   What to do when xgrid is different
737       IF(IERR.EQ.1) THEN
738         IF(ISTOP.EQ.1) THEN
739           WRITE(6,'(/
740      +    '' QNREAD: X grid in memory different from that on file'',
741      +    '' ---> abandon reading'')')
742           RETURN
743         ENDIF
744         IF(ISTOP.EQ.2) THEN
745           WRITE(6,'(/
746      +    '' QNREAD: X grid in memory different from that on file'',
747      +    '' ---> STOP'')')
748           STOP
749         ENDIF
750       ENDIF
751
752       IF(IERR.EQ.1.OR.NXX.LE.0) LREADX = .TRUE.
753
754 C--   Check Q2 grid if there is one already defined and if there are
755 C--   heavy quark weight tables on the file
756       IF(NQ2.NE.0.AND.(RWFCOK.OR.RWLCOK.OR.RWFBOK.OR.RWLBOK)) THEN
757         IF(NQ2.NE.NRQ) THEN
758           IERR = 2
759         ELSE
760           DO IQ = 1,NQ2
761             IF(RQTAB(IQ).NE.Q2TAB(IQ)) IERR = 2
762           ENDDO
763         ENDIF
764       ENDIF
765
766 C--   What to do when qgrid is different
767       IF(IERR.EQ.2) THEN
768         IF(ISTOP.EQ.1) THEN
769           WRITE(6,'(/
770      +    '' QNREAD: Q2 grid in memory different from that on file'',
771      +    '' ---> abandon reading'')')
772           RETURN
773         ENDIF
774         IF(ISTOP.EQ.2) THEN
775           WRITE(6,'(/
776      +    '' QNREAD: Q2 grid in memory different from that on file'',
777      +    '' ---> STOP'')')
778           STOP
779         ENDIF
780       ENDIF
781
782       IF(IERR.EQ.2.OR.NQ2.LE.0) LREADQ = .TRUE.
783
784 C--   Check charm mass if there are charm weight tables on the file
785       IF(RWFCOK.OR.RWLCOK) THEN
786         IF(IV.LE.15) THEN
787           IF(RMASS(4).NE.CBMSTF(4)) IERR = 3
788         ELSE
789           IF(RMASS(1).NE.CBMSTF(4)) IERR = 3
790         ENDIF
791       ENDIF
792
793 C--   What to do when charm mass is different
794       IF(IERR.EQ.3) THEN
795         IF(ISTOP.EQ.1) THEN
796           WRITE(6,'(/
797      +    '' QNREAD: Charm mass in memory different from that on file'',
798      +    '' ---> abandon reading'')')
799           RETURN
800         ENDIF
801         IF(ISTOP.EQ.2) THEN
802           WRITE(6,'(/
803      +    '' QNREAD: Charm mass in memory different from that on'',
804      +    '' file ---> STOP'')')
805           STOP
806         ENDIF
807         LREADC = .TRUE.
808       ENDIF
809
810 C--   Check bottom mass if there are bottom weight tables on the file
811       IF(RWFBOK.OR.RWLBOK) THEN
812         IF(IV.LE.15) THEN
813           IF(RMASS(5).NE.CBMSTF(6)) IERR = 4
814         ELSE
815           IF(RMASS(2).NE.CBMSTF(6)) IERR = 4
816         ENDIF
817       ENDIF
818
819 C--   What to do when bottom mass is different
820       IF(IERR.EQ.4) THEN
821         IF(ISTOP.EQ.1) THEN
822           WRITE(6,'(/
823      +    '' QNREAD: Bottom mass in memory different from that on'',
824      +    '' file ---> abandon reading'')')
825           RETURN
826         ENDIF
827         IF(ISTOP.EQ.2) THEN
828           WRITE(6,'(/
829      +    '' QNREAD: Bottom mass in memory different from that on'',
830      +    '' file ---> STOP'')')
831           STOP
832         ENDIF
833         LREADB = .TRUE.
834       ENDIF
835
836 C--   ok..... continue.......
837       LPLUS  = RPLUS
838 C--   Invalidate all evolutions      
839       CALL QNFALS(LEVDONE,MXX*10)
840
841       IF(LREADX) THEN
842 C--     Copy xgrid to qcdnum common block
843         NXX = NRX
844         DO IX = 1,NXX+1
845           XXTAB(IX) = RXTAB(IX)
846         ENDDO
847         WRITE(6,'(/
848      +    '' QNREAD: xgrid table read in (original overwritten)'')')
849 C--     Invalidate all weight tables since the grid has changed 
850         LWT1OK = .FALSE.
851         LWT2OK = .FALSE.
852         LWTFOK = .FALSE.
853         LWFCOK = .FALSE.
854         LWLCOK = .FALSE.
855         LWFBOK = .FALSE.
856         LWLBOK = .FALSE.
857         LMARK  = .FALSE.
858         NGRVER = NGRVER+1
859 C--     Invalidate all evolutions      
860         CALL QNFALS(LEVDONE,MXX*10)
861 C---    Update IFAILC
862         CALL GRSETC
863 C---    Update NFMAP
864         CALL QNSETT
865 C---    Update heavy quark xgrid
866         CALL GXHDEF
867       ENDIF
868
869       IF(LREADQ) THEN
870 C--     Copy q2 grid to common block
871         NQ2 = NRQ
872         DO IQ = 1,NQ2
873           Q2TAB(IQ) = RQTAB(IQ)
874         ENDDO
875         WRITE(6,'(/
876      +    '' QNREAD: qgrid table read in (original overwritten)'')')
877 C--     Invalidate hq weight tables since the grid has changed
878         LALFOK = .FALSE.
879         LDQ2OK = .FALSE.
880         LWFCOK = .FALSE.
881         LWLCOK = .FALSE.
882         LWFBOK = .FALSE.
883         LWLBOK = .FALSE.
884         LMARK  = .FALSE.
885         NGRVER = NGRVER + 1
886 C--     Invalidate all evolutions      
887         CALL QNFALS(LEVDONE,MXX*10)
888 C---    Update IFAILC
889         CALL GRSETC
890 C---    Update NFMAP
891         CALL QNSETT
892       ENDIF
893
894       IF(LREADC) THEN
895         IF(IV.LE.15) THEN
896           UDSCBT(4) = RMASS(4)
897           CBMSTF(4) = RMASS(4)
898           CBMSTF(5) = RMASS(4)
899         ELSE
900           CBMSTF(4) = RMASS(1)
901           CBMSTF(5) = RMASS(1)
902         ENDIF
903         WRITE(6,'(/
904      +    '' QNREAD: charm mass read in (original overwritten)'')')
905 C--     Invalidate charm weight tables since charm mass has changed
906         LWFCOK = .FALSE.
907         LWLCOK = .FALSE.
908 C--     Invalidate alpha_s table
909         LALFOK = .FALSE.
910       ENDIF
911
912       IF(LREADB) THEN
913         IF(IV.LE.15) THEN
914           UDSCBT(5) = RMASS(5)
915           CBMSTF(6) = RMASS(5)
916           CBMSTF(7) = RMASS(5)
917         ELSE
918           CBMSTF(6) = RMASS(2)
919           CBMSTF(7) = RMASS(2)
920         ENDIF
921         WRITE(6,'(/
922      +    '' QNREAD: bottom mass read in (original overwritten)'')')
923 C--     Invalidate bottom weight tables since charm mass has changed
924         LWFBOK = .FALSE.
925         LWLBOK = .FALSE.
926 C--     Invalidate alpha_s table
927         LALFOK = .FALSE.
928       ENDIF
929
930       IF(IV.LE.15) THEN
931         WRITE(6,'(/'' QNREAD: file was written with QCDNUM'',A8)')
932      +   RHVERS
933         WRITE(6,'( '' ------> Abandon reading the weight tables'')')
934         RETURN
935       ENDIF
936
937       IF(RWT1OK) THEN
938         READ(LUN,ERR=500) WGTFF1,WGTFG1,WGTGF1,WGTGG1
939         LWT1OK = .TRUE.
940         if(lhasilent.eq.0) 
941      +   WRITE(6,'(/'' QNREAD: LO weight tables read in'')')
942       ENDIF
943
944       IF(RWT2OK) THEN
945         READ(LUN,ERR=500) WGTPP2,WGTPM2,WGTNS2,WGTFF2,WGTFG2,WGTGF2,
946      +                    WGTGG2
947         LWT2OK = .TRUE.
948         if(lhasilent.eq.0) 
949      +   WRITE(6,'(/'' QNREAD: NLO weight tables read in'')')
950       ENDIF
951
952       IF(RWTFOK) THEN
953         READ(LUN,ERR=500) WGTC2Q,WGTC2G,YNTC2Q,WGTCLQ,WGTCLG,WGTC3Q
954         LWTFOK = .TRUE.
955         if(lhasilent.eq.0) 
956      +   WRITE(6,'(/'' QNREAD: F2, FL weight tables read in'')')
957       ENDIF
958
959       IF(RWFCOK.OR.RWLCOK.OR.RWFBOK.OR.RWLBOK) THEN
960         READ(LUN,ERR=500) WH_C0KG,WH_C1KG,WH_C1BKG,
961      +                    WH_C1KQ,WH_C1BKQ,WH_D1KQ,WH_D1BKQ
962         LWFCOK = RWFCOK
963         LWLCOK = RWLCOK
964         LWFBOK = RWFBOK
965         LWLBOK = RWLBOK
966         if(lhasilent.eq.0) then 
967         IF(RWFCOK)
968      +  WRITE(6,'(/'' QNREAD: F2C weight tables read in'')')
969         IF(RWLCOK)
970      +  WRITE(6,'(/'' QNREAD: FLC weight tables read in'')')
971         IF(RWFBOK)
972      +  WRITE(6,'(/'' QNREAD: F2B weight tables read in'')')
973         IF(RWLBOK)
974      +  WRITE(6,'(/'' QNREAD: FLB weight tables read in'')')
975         endif
976       ENDIF
977
978       RETURN
979
980  500  CONTINUE
981       WRITE(6,'(/'' QNREAD: cannot read file on lun = '',I5,
982      +           '' ---> STOP'')') LUN
983
984       CALL QTRACE('QNREAD ',1)
985
986       STOP
987  
988       END
989
990 CDECK  ID>, QNPRIN.
991 C
992 C     ======================
993       SUBROUTINE QNPRIN(LUN)
994 C     ======================
995  
996 C---  QNPRIN: print default + current setting of QCDNUM parameters.
997 C---  Called by QPRINT
998 C---  Input parameter: LUN. To be opened by user unless LUN = 6.
999
1000       IMPLICIT DOUBLE PRECISION (A-H,O-Z)
1001
1002  
1003       LOGICAL
1004      +LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB,
1005      +LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS,
1006      +LALFOK,LDQ2OK,LWT1OK,LWT2OK,
1007      +LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ,
1008      +LFFCAL,LASOLD
1009
1010       COMMON/QCFLAG/ 
1011      +IORD,IOLAST,
1012      +LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB,
1013      +LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS,
1014      +LALFOK,LDQ2OK,LWT1OK,LWT2OK,
1015      +LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ,
1016      +LFFCAL(7,30),LASOLD
1017  
1018  
1019       COMMON/QCCONS/
1020      +PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L,
1021      +AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7),
1022      +C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3,
1023      +C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9,
1024      +C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1,
1025      +C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF
1026  
1027  
1028  
1029       PARAMETER ( MXX = 410 )
1030       PARAMETER ( MQ2 =  120 )
1031
1032 C--   Do not set the following parameter to zero!
1033       PARAMETER ( NDFMAX = 20)
1034
1035  
1036       COMMON/QCGRID/
1037      +SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS,
1038      +XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45,
1039      +NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2),
1040      +IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2)
1041  
1042  
1043       COMMON/QCPASS/
1044      +ALPHA0, Q0ALFA, ASLAST, QALAST,
1045      +ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2),
1046      +DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10),
1047      +FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2),
1048      +FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2),
1049      +FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2),
1050      +FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST,
1051      +MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2),
1052      +ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2),
1053      +IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10)
1054
1055       LOGICAL LEVDONE,LE_DONE
1056       COMMON/QCLEVL/
1057      +LEVDONE(MXX,10),LE_DONE(MXX)
1058  
1059
1060       IF(RS2CUT.GE.0.) THEN
1061         RS2C = SQRT(RS2CUT)
1062       ELSE
1063         RS2C = RS2CUT
1064       ENDIF
1065
1066       WRITE(LUN,'(//'' +-------+---+-------+--------------+'',
1067      + ''------------------------------------+'')')
1068       WRITE(LUN,'(  '' | var   |typ| deflt |     value    |'',
1069      + '' description                        |'')')
1070       WRITE(LUN,'(  '' +-------+---+-------+--------------+'',
1071      + ''------------------------------------+'')')
1072       WRITE(LUN,'('' | W1ANA | L |   T   | '',6X,L1,5X,
1073      + '' | Analytical LO weight calculation   |'')') LW1ANA
1074       WRITE(LUN,'('' | W1NUM | L |   F   | '',6X,L1,5X,
1075      + '' | Numerical  LO weight calculation   |'')') LW1NUM
1076       WRITE(LUN,'('' | W2NUM | L |   T   | '',6X,L1,5X,
1077      + '' | Numerical NLO weight calculation   |'')') LW2NUM
1078       WRITE(LUN,'('' | W2STF | L |   T   | '',6X,L1,5X,
1079      + '' | Structure function NLO weights     |'')') LW2STF
1080       WRITE(LUN,'('' | WTF2C | L |   F   | '',6X,L1,5X,
1081      + '' | F2_charm  weight calculation       |'')') LWF2C 
1082       WRITE(LUN,'('' | WTF2B | L |   F   | '',6X,L1,5X,
1083      + '' | F2_bottom weight calculation       |'')') LWF2B 
1084       WRITE(LUN,'('' | WTFLC | L |   F   | '',6X,L1,5X,
1085      + '' | FL_charm  weight calculation       |'')') LWFLC 
1086       WRITE(LUN,'('' | WTFLB | L |   F   | '',6X,L1,5X,
1087      + '' | FL_bottom weight calculation       |'')') LWFLB 
1088       WRITE(LUN,'('' | LIMCK | L |   T   | '',6X,L1,5X,
1089      + '' | Check x, Q2 limits and cuts        |'')') LIMCK 
1090       WRITE(LUN,'('' | CLOWQ | L |   T   | '',6X,L1,5X,
1091      + '' | Heavy F2,FL only for Q2 > 1.5 GeV2 |'')') LCLOWQ
1092       WRITE(LUN,'('' | ORDER | I |   2   | '',6X,I1,5X,
1093      + '' | LO (1) or NLO (2) calculations     |'')') IORD  
1094       WRITE(LUN,'('' | SCAX0 | R |  0.20 | '',E12.5,
1095      + '' | x-grid  scale from log --> linear  |'')') SCAX0
1096       WRITE(LUN,'('' | SCAQ0 | R | +inf  | '',E12.5,
1097      + '' | Q2-grid scale from log --> linear  |'')') SCAQ0
1098       WRITE(LUN,'('' | MCSTF | R |  1.5  | '',E12.5,
1099      + '' | C mass for F2c, FLc (GeV)          |'')') CBMSTF(4)
1100       WRITE(LUN,'('' | MBSTF | R |  5.0  | '',E12.5,
1101      + '' | B mass for F2b, FLb (GeV)          |'')') CBMSTF(6)
1102       WRITE(LUN,'('' | MCALF | R |  1.5  | '',E12.5,
1103      + '' | C mass for alpha_s evolution (GeV) |'')') UDSCBT(4)
1104       WRITE(LUN,'('' | MBALF | R |  5.0  | '',E12.5,
1105      + '' | B mass for alpha_s evolution (GeV) |'')') UDSCBT(5)
1106       WRITE(LUN,'('' | MTALF | R | 188.  | '',E12.5,
1107      + '' | T mass for alpha_s evolution (GeV) |'')') UDSCBT(6)
1108       WRITE(LUN,'('' | ALFAS | R | 0.180 | '',E12.5,
1109      + '' | Value of alpha_s                   |'')') ALPHA0   
1110       WRITE(LUN,'('' | ALFQ0 | R |  50.  | '',E12.5,
1111      + '' | Q2 where alpha_s is given (GeV2)   |'')') Q0ALFA   
1112       WRITE(LUN,'('' | AAAR2 | R |  1.0  | '',E12.5,
1113      + '' | R2 = A*M2 + B (ren. scale)         |'')') AAAR2
1114       WRITE(LUN,'('' | BBBR2 | R |  0.0  | '',E12.5,
1115      + '' | R2 = A*M2 + B (ren. scale)         |'')') BBBR2
1116       WRITE(LUN,'('' | AAM2L | R |  1.0  | '',E12.5,
1117      + '' | M2 = A*Q2 + B (light fact. scale)  |'')') AAM2L
1118       WRITE(LUN,'('' | BBM2L | R |  0.0  | '',E12.5,
1119      + '' | M2 = A*Q2 + B (light fact. scale)  |'')') BBM2L
1120       WRITE(LUN,'('' | AAM2H | R |  1.0  | '',E12.5,
1121      + '' | M2 = A*Q2 + B (heavy fact. scale)  |'')') AAM2H
1122       WRITE(LUN,'('' | BBM2H | R |  0.0  | '',E12.5,
1123      + '' | M2 = A*Q2 + B (heavy fact. scale)  |'')') BBM2H
1124       WRITE(LUN,'(  '' +-------+---+-------+--------------+'',
1125      + ''------------------------------------+'')')
1126       WRITE(LUN,'('' | TCHRM | R | -inf  | '',E12.5,
1127      + '' | Charm threshold  (GeV2)            |'')') THRS34
1128       WRITE(LUN,'('' | TBOTT | R | +inf  | '',E12.5,
1129      + '' | Bottom threshold (GeV2)            |'')') THRS45
1130       WRITE(LUN,'('' | XMINC | R |  0.0  | '',E12.5,
1131      + '' | Xmin cut  (.le.0 = no cut)         |'')') XMICUT
1132       WRITE(LUN,'('' | QMINC | R |  0.0  | '',E12.5,
1133      + '' | Qmin cut  (.le.0 = no cut)         |'')') QMICUT
1134       WRITE(LUN,'('' | QMAXC | R |  0.0  | '',E12.5,
1135      + '' | Qmax cut  (.le.0 = no cut)         |'')') QMACUT
1136       WRITE(LUN,'('' | ROOTS | R |  0.0  | '',E12.5,
1137      + '' | Roots cut (.le.0 = no cut)         |'')') RS2C
1138       WRITE(LUN,'('' | QMINA | R |  0.0  | '',E12.5,
1139      + '' | Lowest Q2 gridpoint above Lambda2  |'')') QMINAS
1140       WRITE(LUN,'(  '' +-------+---+-------+--------------+'',
1141      + ''------------------------------------+'')')
1142       WRITE(LUN,'('' | ASOLD | L |   F   | '',6X,L1,5X,
1143      + '' | Use old (incorrect) a_s evolution  |'')') LASOLD
1144       WRITE(LUN,'('' | BMARK | L |   F   | '',6X,L1,5X,
1145      + '' | Do not use: for tests only         |'')') LBMARK
1146       WRITE(LUN,'('' | FLFAC | R |  0.0  | '',E12.5,
1147      + '' | Hands off : for experts only       |'')') BBM2H
1148       WRITE(LUN,'(  '' +-------+---+-------+--------------+'',
1149      + ''------------------------------------+'')')
1150
1151       RETURN
1152       END
1153
1154 CDECK  ID>, QNVERS.
1155 C
1156 C     ==============================================
1157       SUBROUTINE QNVERS(VERSION,LDOUBLE,NXMAX,NQMAX)
1158 C     ==============================================
1159
1160 C---  QNVERS: return version number, dp flag and max # of gridpoints.
1161 C---  Called by user.
1162 C---  Output variables: VERSION (character*8)
1163 C---                    LDOUBLE (logical)
1164 C---                    NXMAX, NQMAX (integer); set by parameter
1165 C---                    statement in common block QCNXQM.
1166  
1167       IMPLICIT DOUBLE PRECISION (A-H,O-Z)
1168
1169       CHARACTER*8 VERSION
1170       LOGICAL     LDOUBLE
1171  
1172       CHARACTER*8 CHVERS,CHDATE
1173       COMMON/QCVERS/ CHVERS,CHDATE
1174  
1175  
1176       LOGICAL
1177      +LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB,
1178      +LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS,
1179      +LALFOK,LDQ2OK,LWT1OK,LWT2OK,
1180      +LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ,
1181      +LFFCAL,LASOLD
1182
1183       COMMON/QCFLAG/ 
1184      +IORD,IOLAST,
1185      +LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB,
1186      +LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS,
1187      +LALFOK,LDQ2OK,LWT1OK,LWT2OK,
1188      +LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ,
1189      +LFFCAL(7,30),LASOLD
1190  
1191  
1192       PARAMETER ( MXX = 410 )
1193       PARAMETER ( MQ2 =  120 )
1194
1195 C--   Do not set the following parameter to zero!
1196       PARAMETER ( NDFMAX = 20)
1197
1198
1199       CALL QTRACE('QNVERS ',0)
1200  
1201       VERSION = CHVERS
1202       LDOUBLE = LDOUBL
1203       NXMAX   = MXX-1
1204       NQMAX   = MQ2-1
1205  
1206       RETURN
1207       END
1208  
1209 CDECK  ID>, QPRINT.
1210  
1211 C     ==========================
1212       SUBROUTINE QPRINT(LUN,OPT)
1213 C     ==========================
1214
1215 C---  QPRINT: steering routine to print various QCDNUM info on
1216 C--           logical unit number LUN (to be opened by the user).
1217 C---  Called by user.
1218 C---  Input integer LUN  :  locical unit number.
1219 C---        character OPT: 'A' (All)        print all info.
1220 C---                       'B' (Booklist)   print pdf definitions.
1221 C---                       'P' (Parameters) Parameter/option list.
1222 C---                       'S' (Statistics) # STF function calls.
1223 C---                       'T' (Timelog)    timelog.
1224 C---                       'X' (Xq2grid)    grid,thresholds,cuts.
1225  
1226       IMPLICIT DOUBLE PRECISION (A-H,O-Z)
1227  
1228       CHARACTER*(*) OPT
1229       CHARACTER*1   OPT1
1230  
1231  
1232       LOGICAL LTIME  
1233       REAL T_START,T_END,T_SPENT
1234       COMMON/QCTIME/T_START(10),T_END(10),T_SPENT(10),N_CALLS(10),
1235      +E_CALLS(10),LTIME
1236       COMMON/QCFCNT/IFCNT(-1:1,5)
1237
1238  
1239       PARAMETER ( MXX = 410 )
1240       PARAMETER ( MQ2 =  120 )
1241
1242 C--   Do not set the following parameter to zero!
1243       PARAMETER ( NDFMAX = 20)
1244
1245  
1246       COMMON/QCGRID/
1247      +SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS,
1248      +XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45,
1249      +NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2),
1250      +IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2)
1251  
1252  
1253       REAL
1254      +WGTFF1,WGTFG1,
1255      +WGTGF1,WGTGG1,
1256      +WGTPP2,WGTPM2,WGTNS2,
1257      +WGTFF2,WGTFG2,
1258      +WGTGF2,WGTGG2,
1259      +WGTC2Q,WGTC2G,YNTC2Q,
1260      +WGTCLQ,WGTCLG,WGTC3Q
1261
1262       COMMON/QCWEIT/
1263      +WGTFF1(MXX*(MXX+1)/2)    ,WGTFG1(MXX*(MXX+1)/2,3:5),
1264      +WGTGF1(MXX*(MXX+1)/2)    ,WGTGG1(MXX*(MXX+1)/2,3:5),
1265      +WGTPP2(MXX*(MXX+1)/2,3:5),WGTPM2(MXX*(MXX+1)/2,3:5),
1266      +WGTNS2(MXX*(MXX+1)/2,3:5),
1267      +WGTFF2(MXX*(MXX+1)/2,3:5),WGTFG2(MXX*(MXX+1)/2,3:5),
1268      +WGTGF2(MXX*(MXX+1)/2,3:5),WGTGG2(MXX*(MXX+1)/2,3:5),
1269      +WGTC2Q(MXX*(MXX+1)/2)    ,WGTC2G(MXX*(MXX+1)/2,3:5),
1270      +WGTCLQ(MXX*(MXX+1)/2)    ,WGTCLG(MXX*(MXX+1)/2,3:5),
1271      +WGTC3Q(MXX*(MXX+1)/2)    ,YNTC2Q(MXX)
1272
1273       COMMON/QCWADR/ IWADR(MXX,MXX)
1274
1275
1276       CALL QTRACE('QPRINT ',0)
1277  
1278       IF(LENOCC_LHA(OPT).LT.1) GOTO 500
1279       OPT1 = OPT(1:1)
1280       CALL CLTOU_LHA(OPT1)
1281  
1282       IF(OPT1.EQ.'T') THEN !
1283         CALL QPTIME(LUN)
1284       ELSEIF(OPT1.EQ.'P') THEN
1285         CALL QNPRIN(LUN)
1286       ELSEIF(OPT1.EQ.'B') THEN
1287         CALL QNLIST(LUN)
1288       ELSEIF(OPT1.EQ.'S') THEN
1289         CALL QNSTAT(LUN)
1290       ELSEIF(OPT1.EQ.'X') THEN
1291         CALL QPGRID(LUN)
1292       ELSEIF(OPT1.EQ.'A') THEN
1293         CALL QNPRIN(LUN)
1294         CALL QNLIST(LUN)
1295         CALL QPGRID(LUN)
1296         CALL QNSTAT(LUN)
1297         CALL QPTIME(LUN)
1298       ELSE
1299         GOTO 500
1300       ENDIF
1301
1302       RETURN
1303
1304  500  CONTINUE
1305
1306       WRITE(6,'(/'' ------------------------------------'')')
1307       WRITE(6,'( '' QCDNUM error in s/r QPRINT ---> STOP'')')
1308       WRITE(6,'( '' ------------------------------------'')')
1309       WRITE(6,'( '' Input LUN :'',I5   )') LUN
1310       WRITE(6,'( ''       OPT :'',A    )') OPT
1311       WRITE(6,'(/'' Option should be A, B, P, S, T or X'')')
1312
1313       STOP
1314
1315       END
1316  
1317 CDECK  ID>, QNTIME.
1318  
1319 C     ======================
1320       SUBROUTINE QNTIME(OPT)
1321 C     ======================
1322
1323 C---  QNTIME: start/halt/continue the timelog.
1324 C---  Called by user and by QPTIME.
1325 C---  Input variable: 'Start'    initialise and start the timelog.
1326 C---                  'Hold'     stop logging.     
1327 C---                  'Cont'     continue logging.
1328  
1329       IMPLICIT DOUBLE PRECISION (A-H,O-Z)
1330  
1331       CHARACTER*(*) OPT
1332       CHARACTER*1   OPT1
1333  
1334  
1335       LOGICAL LTIME  
1336       REAL T_START,T_END,T_SPENT
1337       COMMON/QCTIME/T_START(10),T_END(10),T_SPENT(10),N_CALLS(10),
1338      +E_CALLS(10),LTIME
1339       COMMON/QCFCNT/IFCNT(-1:1,5)
1340
1341
1342       CALL QTRACE('QNTIME ',0)
1343  
1344       IF(LENOCC_LHA(OPT).LT.1) GOTO 500
1345       OPT1 = OPT(1:1)
1346       CALL CLTOU_LHA(OPT1)
1347  
1348       IF(OPT1.EQ.'S') THEN
1349  
1350         DO I = 1,10
1351           T_SPENT(I) = 0.
1352           E_CALLS(I) = 0.
1353           N_CALLS(I) = 0
1354         ENDDO
1355         LTIME = .TRUE.
1356  
1357         N_CALLS(1) = N_CALLS(1)+1
1358         CALL TIMEX_LHA(T_START(1))
1359  
1360       ELSEIF(OPT1.EQ.'H') THEN
1361
1362         LTIME = .FALSE.
1363         CALL TIMEX_LHA(T_END(1))
1364         T_SPENT(1) = T_SPENT(1)+T_END(1)-T_START(1)
1365         T_START(1) = T_END(1)
1366
1367       ELSEIF(OPT1.EQ.'C') THEN
1368
1369         IF(.NOT.LTIME) THEN
1370           LTIME = .TRUE.
1371           N_CALLS(1) = N_CALLS(1)+1
1372           CALL TIMEX_LHA(T_START(1))
1373         ENDIF
1374
1375       ELSE
1376  
1377         GOTO 500
1378  
1379       ENDIF
1380  
1381       RETURN
1382
1383  500  CONTINUE
1384
1385       WRITE(6,'(/'' ------------------------------------'')')
1386       WRITE(6,'( '' QCDNUM error in s/r QNTIME ---> STOP'')')
1387       WRITE(6,'( '' ------------------------------------'')')
1388       WRITE(6,'( '' Input OPT :'',A    )') OPT
1389       WRITE(6,'(/'' Option should be S, H or C         '')')
1390
1391       CALL QTRACE('QNTIME ',1)
1392
1393       STOP
1394  
1395       END
1396  
1397 CDECK  ID>, QPTIME.
1398  
1399 C     ======================
1400       SUBROUTINE QPTIME(LUN)
1401 C     ======================
1402
1403 C---  QPTIME: start/print the timelog.
1404 C---  Called by QPRINT.
1405 C---  Input variable: LUN logical unit number 
1406  
1407       IMPLICIT DOUBLE PRECISION (A-H,O-Z)
1408  
1409  
1410       LOGICAL LTIME  
1411       REAL T_START,T_END,T_SPENT
1412       COMMON/QCTIME/T_START(10),T_END(10),T_SPENT(10),N_CALLS(10),
1413      +E_CALLS(10),LTIME
1414       COMMON/QCFCNT/IFCNT(-1:1,5)
1415
1416  
1417       PARAMETER ( MXX = 410 )
1418       PARAMETER ( MQ2 =  120 )
1419
1420 C--   Do not set the following parameter to zero!
1421       PARAMETER ( NDFMAX = 20)
1422
1423  
1424       COMMON/QCGRID/
1425      +SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS,
1426      +XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45,
1427      +NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2),
1428      +IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2)
1429  
1430  
1431       REAL
1432      +WGTFF1,WGTFG1,
1433      +WGTGF1,WGTGG1,
1434      +WGTPP2,WGTPM2,WGTNS2,
1435      +WGTFF2,WGTFG2,
1436      +WGTGF2,WGTGG2,
1437      +WGTC2Q,WGTC2G,YNTC2Q,
1438      +WGTCLQ,WGTCLG,WGTC3Q
1439
1440       COMMON/QCWEIT/
1441      +WGTFF1(MXX*(MXX+1)/2)    ,WGTFG1(MXX*(MXX+1)/2,3:5),
1442      +WGTGF1(MXX*(MXX+1)/2)    ,WGTGG1(MXX*(MXX+1)/2,3:5),
1443      +WGTPP2(MXX*(MXX+1)/2,3:5),WGTPM2(MXX*(MXX+1)/2,3:5),
1444      +WGTNS2(MXX*(MXX+1)/2,3:5),
1445      +WGTFF2(MXX*(MXX+1)/2,3:5),WGTFG2(MXX*(MXX+1)/2,3:5),
1446      +WGTGF2(MXX*(MXX+1)/2,3:5),WGTGG2(MXX*(MXX+1)/2,3:5),
1447      +WGTC2Q(MXX*(MXX+1)/2)    ,WGTC2G(MXX*(MXX+1)/2,3:5),
1448      +WGTCLQ(MXX*(MXX+1)/2)    ,WGTCLG(MXX*(MXX+1)/2,3:5),
1449      +WGTC3Q(MXX*(MXX+1)/2)    ,YNTC2Q(MXX)
1450
1451       COMMON/QCWADR/ IWADR(MXX,MXX)
1452
1453  
1454       CALL QNTIME('H')    
1455
1456       N_TOT      = N_CALLS(3)+N_CALLS(4)+N_CALLS(5)
1457       E_TOT      = E_CALLS(3)+E_CALLS(4)+E_CALLS(5)
1458       T_TOT      = T_SPENT(3)+T_SPENT(4)+T_SPENT(5)
1459       T_REST     = T_SPENT(1)-T_TOT-T_SPENT(2)-T_SPENT(6)
1460       DUMMY      = 1.
1461       F_FAST     = 0.
1462       DO J = 1,5
1463         F_FAST   = F_FAST+IFCNT(1,J)
1464       ENDDO
1465       WRITE(LUN,
1466      +  '(//'' -------------------------------------------------'')')
1467       WRITE(LUN,
1468      +  '(  '' Routine     # calls   # evols   CPU sec  CPU/evol'')')
1469       WRITE(LUN,
1470      +  '(  '' -------------------------------------------------'')')
1471       WRITE(LUN,
1472      + '('' EVOLNM   '',I10,2F10.1,F10.2)') N_CALLS(3),
1473      +      E_CALLS(3),T_SPENT(3),T_SPENT(3)/MAX(E_CALLS(3),DUMMY)
1474       WRITE(LUN,
1475      + '('' EVOLNP   '',I10,2F10.1,F10.2)') N_CALLS(4),
1476      +      E_CALLS(4),T_SPENT(4),T_SPENT(4)/MAX(E_CALLS(4),DUMMY)
1477       WRITE(LUN,
1478      + '('' EVOLSG   '',I10,2F10.1,F10.2)') N_CALLS(5),
1479      +      E_CALLS(5),T_SPENT(5),T_SPENT(5)/MAX(E_CALLS(5),DUMMY)
1480       WRITE(LUN,
1481      +  '(  '' -------------------------------------------------'')')
1482       WRITE(LUN,
1483      + '('' AP total '',I10,2F10.1,F10.2)') N_TOT,
1484      +      E_TOT,T_TOT,T_TOT/MAX(E_TOT,DUMMY)
1485       WRITE(LUN,'('' '')')
1486       WRITE(LUN,
1487      + '('' STFAST   '',I10,   2F10.1)') N_CALLS(6),F_FAST,T_SPENT(6)
1488       WRITE(LUN,
1489      + '('' QNFILW   '',I10,10X,F10.1)') N_CALLS(2),T_SPENT(2)
1490       WRITE(LUN,
1491      + '('' Other    '',10X,10X,F10.1)') T_REST
1492       WRITE(LUN,
1493      +  '(  '' -------------------------------------------------'')')
1494       WRITE(LUN,
1495      + '('' Total    '',10X,10X,F10.1)') T_SPENT(1)
1496       WRITE(LUN,
1497      +  '(  '' -------------------------------------------------'')')
1498
1499
1500       RETURN
1501       END
1502  
1503 CDECK  ID>, QNSTAT.
1504  
1505 C     ======================
1506       SUBROUTINE QNSTAT(LUN)
1507 C     ======================
1508
1509 C---  QNSTAT: print number of structure function calculations.
1510 C---  Called by user.
1511 C---  Input parameter: LUN to be opened by user unless LUN = 6.
1512  
1513       IMPLICIT DOUBLE PRECISION (A-H,O-Z)
1514  
1515  
1516       LOGICAL LTIME  
1517       REAL T_START,T_END,T_SPENT
1518       COMMON/QCTIME/T_START(10),T_END(10),T_SPENT(10),N_CALLS(10),
1519      +E_CALLS(10),LTIME
1520       COMMON/QCFCNT/IFCNT(-1:1,5)
1521
1522
1523       DIMENSION ITOT(5)
1524        
1525        DO J = 1,5
1526         ITOT(J) = 0
1527         DO I = -1,1
1528           ITOT(J) = ITOT(J)+IFCNT(I,J)
1529         ENDDO
1530       ENDDO
1531  
1532       WRITE(LUN,'(//'' ------------------------------'',
1533      +   ''--------------------------------------------'')')
1534       WRITE(LUN,'(  '' Structure function calls '',
1535      +   ''           F2       FL      xF3'',
1536      +                ''      F2h      FLh'')')
1537       WRITE(LUN,'(  '' ------------------------------'',
1538      +   ''--------------------------------------------'')')
1539       WRITE(LUN,
1540      + '('' Slow calculation             '',5I9)') (IFCNT( 0,J),J=1,5)
1541       WRITE(LUN,
1542      + '('' Fast calculation             '',5I9)') (IFCNT( 1,J),J=1,5)
1543       WRITE(LUN,
1544      + '('' Outside grid or cuts         '',5I9)') (IFCNT(-1,J),J=1,5)
1545       WRITE(LUN,'(  '' ------------------------------'',
1546      +   ''--------------------------------------------'')')
1547       WRITE(LUN,
1548      + '('' Total                        '',5I9)') (   ITOT(J),J=1,5)
1549       WRITE(LUN,'(  '' ------------------------------'',
1550      +   ''--------------------------------------------'')')
1551
1552       RETURN
1553       END
1554  
1555 CDECK  ID>, QNIVAL.
1556  
1557 C     ================================
1558       SUBROUTINE QNIVAL(OPT,FLAG,IVAL)
1559 C     ================================
1560
1561 C---  QNIVAL: set/get integer variable.
1562 C---  Called by user or internally by s/r QNISET and QNIGET.
1563 C---  Input parameters: 'OPT'   = 'Set' or 'Get'.
1564 C---                    'FLAG'  = variable name to set or get.
1565 C---                    'IVAL' (integer) input or output variable.
1566  
1567       IMPLICIT DOUBLE PRECISION (A-H,O-Z)
1568  
1569       CHARACTER*(*) OPT
1570       CHARACTER*1   OPT1
1571       CHARACTER*(*) FLAG
1572       CHARACTER*5   FLAG5
1573  
1574  
1575       COMMON/QCCONS/
1576      +PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L,
1577      +AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7),
1578      +C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3,
1579      +C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9,
1580      +C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1,
1581      +C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF
1582  
1583  
1584  
1585       LOGICAL
1586      +LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB,
1587      +LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS,
1588      +LALFOK,LDQ2OK,LWT1OK,LWT2OK,
1589      +LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ,
1590      +LFFCAL,LASOLD
1591
1592       COMMON/QCFLAG/ 
1593      +IORD,IOLAST,
1594      +LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB,
1595      +LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS,
1596      +LALFOK,LDQ2OK,LWT1OK,LWT2OK,
1597      +LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ,
1598      +LFFCAL(7,30),LASOLD
1599  
1600  
1601       PARAMETER ( MXX = 410 )
1602       PARAMETER ( MQ2 =  120 )
1603
1604 C--   Do not set the following parameter to zero!
1605       PARAMETER ( NDFMAX = 20)
1606
1607  
1608       COMMON/QCGRID/
1609      +SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS,
1610      +XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45,
1611      +NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2),
1612      +IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2)
1613  
1614  
1615       COMMON/QCPASS/
1616      +ALPHA0, Q0ALFA, ASLAST, QALAST,
1617      +ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2),
1618      +DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10),
1619      +FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2),
1620      +FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2),
1621      +FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2),
1622      +FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST,
1623      +MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2),
1624      +ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2),
1625      +IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10)
1626
1627       LOGICAL LEVDONE,LE_DONE
1628       COMMON/QCLEVL/
1629      +LEVDONE(MXX,10),LE_DONE(MXX)
1630  
1631  
1632       IF(LENOCC_LHA(OPT).LT.1)  THEN
1633         IERR = 1
1634         GOTO 500
1635       ENDIF
1636       IF(LENOCC_LHA(FLAG).LT.5) THEN
1637         IERR = 2
1638         GOTO 500
1639       ENDIF
1640       OPT1   = OPT(1:1)
1641       FLAG5  = FLAG(1:5)
1642       CALL CLTOU_LHA(OPT1)
1643       CALL CLTOU_LHA(FLAG5)
1644  
1645 C     ----------------------
1646       IF(OPT1.EQ.'S') THEN !
1647 C     ----------------------
1648  
1649         IF    (FLAG5.EQ.'ORDER') THEN
1650           IF(IVAL.LE.0.OR.IVAL.GE.3) THEN
1651             IERR = 3
1652             GOTO 500
1653           ENDIF
1654           IORD   = IVAL
1655 C--       Invalidate all evolutions      
1656           CALL QNFALS(LEVDONE,MXX*10)
1657           LALFOK = .FALSE.
1658         ELSE
1659           IERR = 2
1660           GOTO 500
1661         ENDIF
1662  
1663 C     --------------------------
1664       ELSEIF(OPT1.EQ.'G') THEN !
1665 C     --------------------------
1666  
1667         IF    (FLAG5.EQ.'ORDER') THEN
1668           IVAL = IORD
1669         ELSE
1670           IERR = 2
1671           GOTO 500
1672         ENDIF
1673  
1674 C     ------
1675       ELSE !
1676 C     ------
1677  
1678         IERR = 1
1679         GOTO 500
1680  
1681 C     -------
1682       ENDIF !
1683 C     -------
1684  
1685       RETURN
1686
1687  500  CONTINUE
1688
1689       WRITE(6,'(/'' ------------------------------------'')')
1690       WRITE(6,'( '' QCDNUM error in s/r QNIVAL ---> STOP'')')
1691       WRITE(6,'( '' ------------------------------------'')')
1692       WRITE(6,'( '' Input OPT : '',A    )') OPT
1693       WRITE(6,'( ''       VAR : '',A    )') FLAG
1694       WRITE(6,'( ''       VAL : '',I10  )') IVAL
1695       IF(IERR.EQ.1) THEN
1696         WRITE(6,'(/'' OPT should be either SET or GET '')')
1697       ELSEIF(IERR.EQ.2) THEN
1698         WRITE(6,'(/'' Variable VAR not found'')')
1699       ELSEIF(IERR.EQ.3) THEN
1700         WRITE(6,'(/'' IVAL out of allowed range'')')
1701       ENDIF
1702
1703       CALL QTRACE('QNIVAL ',1)
1704
1705       STOP
1706
1707       END
1708
1709 CDECK  ID>, QNISET.
1710  
1711 C     ============================
1712       SUBROUTINE QNISET(FLAG,IVAL)
1713 C     ============================
1714  
1715       IMPLICIT DOUBLE PRECISION (A-H,O-Z)
1716  
1717       CHARACTER*(*) FLAG
1718
1719       CALL QTRACE('QNISET ',0)
1720
1721       CALL QNIVAL('SET',FLAG,IVAL)
1722
1723       RETURN
1724       END
1725
1726 CDECK  ID>, QNIGET.
1727  
1728 C     ============================
1729       SUBROUTINE QNIGET(FLAG,IVAL)
1730 C     ============================
1731  
1732       IMPLICIT DOUBLE PRECISION (A-H,O-Z)
1733  
1734       CHARACTER*(*) FLAG
1735
1736       CALL QTRACE('QNIGET ',0)
1737
1738       CALL QNIVAL('GET',FLAG,IVAL)
1739
1740       RETURN
1741       END
1742  
1743 CDECK  ID>, QNRVAL.
1744  
1745 C     ===============================
1746       SUBROUTINE QNRVAL(OPT,FLAG,VAL)
1747 C     ===============================
1748
1749 C---  QNRVAL: set/get floating point variable.
1750 C---  Called by user or internally by s/r QNRSET and QNRGET.
1751 C---  Input parameters: 'OPT'   = 'Set' or 'Get'.
1752 C---                    'FLAG'  = variable name to set or get.
1753 C---                    'VAL' (real or d.p.) input or output variable.
1754  
1755       IMPLICIT DOUBLE PRECISION (A-H,O-Z)
1756  
1757       CHARACTER*(*) OPT
1758       CHARACTER*1   OPT1
1759       CHARACTER*(*) FLAG
1760       CHARACTER*5   FLAG5
1761  
1762  
1763       COMMON/QCCONS/
1764      +PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L,
1765      +AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7),
1766      +C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3,
1767      +C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9,
1768      +C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1,
1769      +C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF
1770  
1771  
1772  
1773       LOGICAL
1774      +LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB,
1775      +LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS,
1776      +LALFOK,LDQ2OK,LWT1OK,LWT2OK,
1777      +LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ,
1778      +LFFCAL,LASOLD
1779
1780       COMMON/QCFLAG/ 
1781      +IORD,IOLAST,
1782      +LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB,
1783      +LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS,
1784      +LALFOK,LDQ2OK,LWT1OK,LWT2OK,
1785      +LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ,
1786      +LFFCAL(7,30),LASOLD
1787  
1788  
1789       PARAMETER ( MXX = 410 )
1790       PARAMETER ( MQ2 =  120 )
1791
1792 C--   Do not set the following parameter to zero!
1793       PARAMETER ( NDFMAX = 20)
1794
1795  
1796       COMMON/QCGRID/
1797      +SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS,
1798      +XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45,
1799      +NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2),
1800      +IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2)
1801  
1802  
1803       COMMON/QCPASS/
1804      +ALPHA0, Q0ALFA, ASLAST, QALAST,
1805      +ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2),
1806      +DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10),
1807      +FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2),
1808      +FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2),
1809      +FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2),
1810      +FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST,
1811      +MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2),
1812      +ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2),
1813      +IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10)
1814
1815       LOGICAL LEVDONE,LE_DONE
1816       COMMON/QCLEVL/
1817      +LEVDONE(MXX,10),LE_DONE(MXX)
1818  
1819  
1820       IF(LENOCC_LHA(OPT).LT.1)  THEN
1821         IERR = 1
1822         GOTO 500
1823       ENDIF
1824       IF(LENOCC_LHA(FLAG).LT.5) THEN
1825         IERR = 2
1826         GOTO 500
1827       ENDIF
1828       OPT1   = OPT(1:1)
1829       FLAG5  = FLAG(1:5)
1830       CALL CLTOU_LHA(OPT1)
1831       CALL CLTOU_LHA(FLAG5)
1832  
1833 C     ----------------------
1834       IF(OPT1.EQ.'S') THEN !
1835 C     ----------------------
1836  
1837         IF    (FLAG5.EQ.'AAM2H'.OR.FLAG5.EQ.'AATQ2') THEN
1838           IF(VAL.LE.0.) THEN
1839             IERR = 3
1840             GOTO 500
1841           ENDIF
1842           AAM2H  = VAL
1843           DO I = 1,30
1844             LFFCAL(4,I) = .FALSE.
1845             LFFCAL(5,I) = .FALSE.
1846             LFFCAL(6,I) = .FALSE.
1847             LFFCAL(7,I) = .FALSE.
1848           ENDDO
1849         ELSEIF(FLAG5.EQ.'BBM2H'.OR.FLAG5.EQ.'PLUSB') THEN
1850           BBM2H  = VAL
1851           DO I = 1,30
1852             LFFCAL(4,I) = .FALSE.
1853             LFFCAL(5,I) = .FALSE.
1854             LFFCAL(6,I) = .FALSE.
1855             LFFCAL(7,I) = .FALSE.
1856           ENDDO
1857         ELSEIF(FLAG5.EQ.'AAM2L') THEN
1858           IF(VAL.LE.0.) THEN
1859             IERR = 3
1860             GOTO 500
1861           ENDIF
1862           AAM2L  = VAL
1863           DO I = 1,30
1864             LFFCAL(1,I) = .FALSE.
1865             LFFCAL(2,I) = .FALSE.
1866             LFFCAL(3,I) = .FALSE.
1867           ENDDO
1868         ELSEIF(FLAG5.EQ.'BBM2L') THEN
1869           BBM2L  = VAL
1870           DO I = 1,30
1871             LFFCAL(1,I) = .FALSE.
1872             LFFCAL(2,I) = .FALSE.
1873             LFFCAL(3,I) = .FALSE.
1874           ENDDO
1875         ELSEIF(FLAG5.EQ.'AAAR2') THEN
1876           AAAR2  = VAL
1877 C--       Invalidate all evolutions      
1878           CALL QNFALS(LEVDONE,MXX*10)
1879           LALFOK = .FALSE.
1880           DO I = 1,30
1881             DO J = 1,7
1882               LFFCAL(J,I)  = .FALSE.
1883             ENDDO
1884           ENDDO
1885         ELSEIF(FLAG5.EQ.'BBBR2') THEN
1886           BBBR2  = VAL
1887 C--       Invalidate all evolutions      
1888           CALL QNFALS(LEVDONE,MXX*10)
1889           LALFOK = .FALSE.
1890           DO I = 1,30
1891             DO J = 1,7
1892               LFFCAL(J,I)  = .FALSE.
1893             ENDDO
1894           ENDDO
1895         ELSEIF(FLAG5.EQ.'FLFAC') THEN
1896           FL_FAC = VAL
1897           DO I = 1,30
1898             LFFCAL(2,I)  = .FALSE.
1899           ENDDO
1900         ELSEIF(FLAG5.EQ.'SCAX0') THEN
1901           IF(VAL.LE.0.) THEN
1902             IERR = 3
1903             GOTO 500
1904           ENDIF
1905           SCAX0     = VAL
1906         ELSEIF(FLAG5.EQ.'SCAQ0') THEN
1907           IF(VAL.LE.0.) THEN
1908             IERR = 3
1909             GOTO 500
1910           ENDIF
1911           SCAQ0     = VAL
1912         ELSE
1913           IF(VAL.LE.0.) THEN
1914             IERR = 3
1915             GOTO 500
1916           ENDIF
1917 C--       Invalidate all evolutions      
1918           CALL QNFALS(LEVDONE,MXX*10)
1919           LALFOK = .FALSE.   !force alpha_s to be recalculated
1920           IF    (FLAG5.EQ.'UMASS') THEN
1921             UDSCBT(1) = VAL
1922           ELSEIF(FLAG5.EQ.'DMASS') THEN
1923             UDSCBT(2) = VAL
1924           ELSEIF(FLAG5.EQ.'SMASS') THEN
1925             UDSCBT(3) = VAL
1926           ELSEIF(FLAG5.EQ.'CMASS') THEN
1927             UDSCBT(4) = VAL
1928             CBMSTF(4) = VAL
1929             CBMSTF(5) = VAL
1930             LWFCOK = .FALSE.  !invalidate F2C weight tables
1931             LWLCOK = .FALSE.  !invalidate FLC weight tables
1932           ELSEIF(FLAG5.EQ.'MCSTF') THEN
1933             CBMSTF(4) = VAL
1934             CBMSTF(5) = VAL
1935             LWFCOK = .FALSE.
1936             LWLCOK = .FALSE.
1937           ELSEIF(FLAG5.EQ.'MCALF') THEN
1938             UDSCBT(4) = VAL
1939           ELSEIF(FLAG5.EQ.'BMASS') THEN
1940             UDSCBT(5) = VAL
1941             CBMSTF(6) = VAL
1942             CBMSTF(7) = VAL
1943             LWFBOK = .FALSE.  !invalidate F2B weight tables
1944             LWLBOK = .FALSE.  !invalidate FLB weight tables
1945           ELSEIF(FLAG5.EQ.'MBSTF') THEN
1946             CBMSTF(6) = VAL
1947             CBMSTF(7) = VAL
1948             LWFBOK = .FALSE.
1949             LWLBOK = .FALSE.
1950           ELSEIF(FLAG5.EQ.'MBALF') THEN
1951             UDSCBT(5) = VAL
1952           ELSEIF(FLAG5.EQ.'MTALF') THEN
1953             UDSCBT(6) = VAL
1954           ELSEIF(FLAG5.EQ.'TMASS') THEN
1955             UDSCBT(6) = VAL
1956           ELSEIF(FLAG5.EQ.'ALFAS') THEN
1957             ALPHA0    = VAL
1958           ELSEIF(FLAG5.EQ.'ALFQ0') THEN
1959             Q0ALFA    = VAL
1960           ELSE
1961             IERR = 2
1962             GOTO 500
1963           ENDIF
1964         ENDIF
1965  
1966 C     --------------------------
1967       ELSEIF(OPT1.EQ.'G') THEN !
1968 C     --------------------------
1969  
1970         IF    (FLAG5.EQ.'SCAX0') THEN
1971           VAL = SCAX0
1972         ELSEIF(FLAG5.EQ.'SCAQ0') THEN
1973           VAL = SCAQ0
1974         ELSEIF(FLAG5.EQ.'AAM2H'.OR.FLAG5.EQ.'AATQ2') THEN
1975           VAL = AAM2H
1976         ELSEIF(FLAG5.EQ.'BBM2H'.OR.FLAG5.EQ.'PLUSB') THEN
1977           VAL = BBM2H
1978         ELSEIF(FLAG5.EQ.'AAM2L') THEN
1979           VAL = AAM2L
1980         ELSEIF(FLAG5.EQ.'BBM2L') THEN
1981           VAL = BBM2L
1982         ELSEIF(FLAG5.EQ.'AAAR2') THEN
1983           VAL = AAAR2
1984         ELSEIF(FLAG5.EQ.'BBBR2') THEN
1985           VAL = BBBR2
1986         ELSEIF(FLAG5.EQ.'FLFAC') THEN
1987           VAL = FL_FAC
1988         ELSEIF(FLAG5.EQ.'UMASS') THEN
1989           VAL = UDSCBT(1)
1990         ELSEIF(FLAG5.EQ.'DMASS') THEN
1991           VAL = UDSCBT(2)
1992         ELSEIF(FLAG5.EQ.'SMASS') THEN
1993           VAL = UDSCBT(3)
1994         ELSEIF(FLAG5.EQ.'CMASS') THEN
1995           VAL = UDSCBT(4)
1996         ELSEIF(FLAG5.EQ.'BMASS') THEN
1997           VAL = UDSCBT(5)
1998         ELSEIF(FLAG5.EQ.'TMASS') THEN
1999           VAL = UDSCBT(6)
2000         ELSEIF(FLAG5.EQ.'MCSTF') THEN
2001           VAL = CBMSTF(4)
2002         ELSEIF(FLAG5.EQ.'MBSTF') THEN
2003           VAL = CBMSTF(6)
2004         ELSEIF(FLAG5.EQ.'MCALF') THEN
2005           VAL = UDSCBT(4)
2006         ELSEIF(FLAG5.EQ.'MBALF') THEN
2007           VAL = UDSCBT(5)
2008         ELSEIF(FLAG5.EQ.'MTALF') THEN
2009           VAL = UDSCBT(6)
2010         ELSEIF(FLAG5.EQ.'ALFAS') THEN
2011           VAL = ALPHA0
2012         ELSEIF(FLAG5.EQ.'ALFQ0') THEN
2013           VAL = Q0ALFA
2014         ELSEIF(FLAG5.EQ.'TCHRM') THEN
2015           VAL = THRS34
2016         ELSEIF(FLAG5.EQ.'TBOTT') THEN
2017           VAL = THRS45
2018         ELSEIF(FLAG5.EQ.'XMINC') THEN
2019           VAL = XMICUT
2020         ELSEIF(FLAG5.EQ.'QMINC') THEN
2021           VAL = QMICUT
2022         ELSEIF(FLAG5.EQ.'QMAXC') THEN
2023           VAL = QMACUT
2024         ELSEIF(FLAG5.EQ.'ROOTS') THEN
2025           IF(RS2CUT.GE.0.) THEN
2026             VAL = SQRT(RS2CUT)
2027           ELSE
2028             VAL = RS2CUT
2029           ENDIF
2030         ELSEIF(FLAG5.EQ.'QMINA') THEN
2031           VAL = QMINAS
2032         ELSE
2033           IERR = 2
2034           GOTO 500
2035         ENDIF
2036  
2037 C     ------
2038       ELSE !
2039 C     ------
2040  
2041         IERR = 1
2042         GOTO 500
2043  
2044 C     -------   
2045       ENDIF !
2046 C     -------   
2047  
2048       RETURN
2049
2050  500  CONTINUE
2051
2052       WRITE(6,'(/'' ------------------------------------'')')
2053       WRITE(6,'( '' QCDNUM error in s/r QNRVAL ---> STOP'')')
2054       WRITE(6,'( '' ------------------------------------'')')
2055       WRITE(6,'( '' Input OPT : '',A    )') OPT
2056       WRITE(6,'( ''       VAR : '',A    )') FLAG
2057       WRITE(6,'( ''       VAL : '',E12.5)') RVAL
2058       IF(IERR.EQ.1) THEN
2059         WRITE(6,'(/'' OPT should be either SET or GET '')')
2060       ELSEIF(IERR.EQ.2) THEN
2061         WRITE(6,'(/'' Variable VAR not found'')')
2062       ELSEIF(IERR.EQ.3) THEN
2063         WRITE(6,'(/'' VAL should be .gt. 0  '')')
2064       ENDIF
2065
2066       CALL QTRACE('QNRVAL ',1)
2067
2068       STOP
2069
2070       END
2071
2072 CDECK  ID>, QNRSET.
2073  
2074 C     ============================
2075       SUBROUTINE QNRSET(FLAG,RVAL)
2076 C     ============================
2077  
2078       IMPLICIT DOUBLE PRECISION (A-H,O-Z)
2079  
2080       CHARACTER*(*) FLAG
2081
2082       CALL QTRACE('QNRSET ',0)
2083
2084       CALL QNRVAL('SET',FLAG,RVAL)
2085
2086       RETURN
2087       END
2088
2089 CDECK  ID>, QNRGET.
2090  
2091 C     ============================
2092       SUBROUTINE QNRGET(FLAG,RVAL)
2093 C     ============================
2094  
2095       IMPLICIT DOUBLE PRECISION (A-H,O-Z)
2096  
2097       CHARACTER*(*) FLAG
2098
2099       CALL QTRACE('QNRGET ',0)
2100
2101       CALL QNRVAL('GET',FLAG,RVAL)
2102
2103       RETURN
2104       END
2105  
2106 CDECK  ID>, QNLVAL.
2107  
2108 C     ================================
2109       SUBROUTINE QNLVAL(OPT,FLAG,LVAL)
2110 C     ================================
2111
2112 C---  QNLVAL: set/get logical variable.
2113 C---  Called by user or internally by s/r QNLSET and QNLGET.
2114 C---  Input parameters: 'OPT'   = 'Set' or 'Get'.
2115 C---                    'FLAG'  = variable name to set or get.
2116 C---                    'VAL' (logical) input or output variable.
2117  
2118       IMPLICIT DOUBLE PRECISION (A-H,O-Z)
2119  
2120       CHARACTER*(*) OPT
2121       CHARACTER*1   OPT1
2122       CHARACTER*(*) FLAG
2123       CHARACTER*5   FLAG5
2124       LOGICAL       LVAL
2125  
2126  
2127       COMMON/QCCONS/
2128      +PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L,
2129      +AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7),
2130      +C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3,
2131      +C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9,
2132      +C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1,
2133      +C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF
2134  
2135  
2136  
2137       LOGICAL
2138      +LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB,
2139      +LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS,
2140      +LALFOK,LDQ2OK,LWT1OK,LWT2OK,
2141      +LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ,
2142      +LFFCAL,LASOLD
2143
2144       COMMON/QCFLAG/ 
2145      +IORD,IOLAST,
2146      +LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB,
2147      +LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS,
2148      +LALFOK,LDQ2OK,LWT1OK,LWT2OK,
2149      +LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ,
2150      +LFFCAL(7,30),LASOLD
2151  
2152  
2153       IF(LENOCC_LHA(OPT).LT.1)  THEN
2154         IERR = 1
2155         GOTO 500
2156       ENDIF
2157       IF(LENOCC_LHA(FLAG).LT.5) THEN
2158         IERR = 2
2159         GOTO 500
2160       ENDIF
2161       OPT1   = OPT(1:1)
2162       FLAG5  = FLAG(1:5)
2163       CALL CLTOU_LHA(OPT1)
2164       CALL CLTOU_LHA(FLAG5)
2165  
2166 C     ----------------------
2167       IF(OPT1.EQ.'S') THEN !
2168 C     ----------------------
2169  
2170         IF    (FLAG5.EQ.'W1ANA' ) THEN
2171           LW1ANA = LVAL
2172           IF(LW1ANA) LW1NUM = .FALSE.
2173         ELSEIF(FLAG5.EQ.'W1NUM' ) THEN
2174           LW1NUM = LVAL
2175           IF(LW1NUM) LW1ANA = .FALSE.
2176         ELSEIF(FLAG5.EQ.'W2NUM' ) THEN
2177           LW2NUM = LVAL
2178         ELSEIF(FLAG5.EQ.'W2STF' ) THEN
2179           LW2STF = LVAL
2180         ELSEIF(FLAG5.EQ.'WTF2C' ) THEN
2181           LWF2C  = LVAL
2182         ELSEIF(FLAG5.EQ.'WTFLC' ) THEN
2183           LWFLC  = LVAL
2184         ELSEIF(FLAG5.EQ.'WTF2B' ) THEN
2185           LWF2B  = LVAL
2186         ELSEIF(FLAG5.EQ.'WTFLB' ) THEN
2187           LWFLB  = LVAL
2188         ELSEIF(FLAG5.EQ.'BMARK' ) THEN
2189           LBMARK = LVAL
2190           LALFOK = .FALSE.
2191         ELSEIF(FLAG5.EQ.'LIMCK' ) THEN
2192           LIMCK  = LVAL
2193         ELSEIF(FLAG5.EQ.'CLOWQ' ) THEN
2194           LCLOWQ = LVAL
2195         ELSEIF(FLAG5.EQ.'ASOLD' ) THEN
2196           LASOLD = LVAL
2197           LALFOK = .FALSE.
2198         ELSE
2199           IERR = 2
2200           GOTO 500
2201         ENDIF
2202  
2203 C     --------------------------
2204       ELSEIF(OPT1.EQ.'G') THEN !
2205 C     --------------------------
2206  
2207         IF    (FLAG5.EQ.'W1ANA' ) THEN
2208           LVAL = LW1ANA
2209         ELSEIF(FLAG5.EQ.'W1NUM' ) THEN
2210           LVAL = LW1NUM
2211         ELSEIF(FLAG5.EQ.'W2NUM' ) THEN
2212           LVAL = LW2NUM
2213         ELSEIF(FLAG5.EQ.'W2STF' ) THEN
2214           LVAL = LW2STF
2215         ELSEIF(FLAG5.EQ.'WTF2C' ) THEN
2216           LVAL = LWF2C
2217         ELSEIF(FLAG5.EQ.'WTFLC' ) THEN
2218           LVAL = LWFLC
2219         ELSEIF(FLAG5.EQ.'WTF2B' ) THEN
2220           LVAL = LWF2B
2221         ELSEIF(FLAG5.EQ.'WTFLB' ) THEN
2222           LVAL = LWFLB
2223         ELSEIF(FLAG5.EQ.'BMARK' ) THEN
2224           LVAL = LBMARK
2225         ELSEIF(FLAG5.EQ.'LIMCK' ) THEN
2226           LVAL = LIMCK 
2227         ELSEIF(FLAG5.EQ.'CLOWQ' ) THEN
2228           LVAL = LCLOWQ 
2229         ELSEIF(FLAG5.EQ.'ASOLD' ) THEN
2230           LVAL = LASOLD 
2231         ELSE
2232           IERR = 2
2233           GOTO 500
2234         ENDIF
2235  
2236 C     ------
2237       ELSE !
2238 C     ------
2239  
2240         IERR = 1
2241         GOTO 500
2242  
2243 C     -------   
2244       ENDIF !
2245 C     -------   
2246  
2247       RETURN
2248
2249  500  CONTINUE
2250
2251       WRITE(6,'(/'' ------------------------------------'')')
2252       WRITE(6,'( '' QCDNUM error in s/r QNLVAL ---> STOP'')')
2253       WRITE(6,'( '' ------------------------------------'')')
2254       WRITE(6,'( '' Input OPT : '',A    )') OPT
2255       WRITE(6,'( ''       VAR : '',A    )') FLAG
2256       WRITE(6,'( ''       VAL : '',L2   )') LVAL
2257       IF(IERR.EQ.1) THEN
2258         WRITE(6,'(/'' OPT should be either SET or GET '')')
2259       ELSEIF(IERR.EQ.2) THEN
2260         WRITE(6,'(/'' Variable VAR not found'')')
2261       ENDIF
2262
2263       CALL QTRACE('QNLVAL ',1)
2264
2265       STOP
2266
2267       END
2268
2269 CDECK  ID>, QNLSET.
2270  
2271 C     ============================
2272       SUBROUTINE QNLSET(FLAG,LVAL)
2273 C     ============================
2274  
2275       IMPLICIT DOUBLE PRECISION (A-H,O-Z)
2276  
2277       CHARACTER*(*) FLAG
2278       LOGICAL       LVAL
2279
2280       CALL QTRACE('QNLSET ',0)
2281
2282       CALL QNLVAL('SET',FLAG,LVAL)
2283
2284       RETURN
2285       END
2286
2287 CDECK  ID>, QNLGET.
2288  
2289 C     ============================
2290       SUBROUTINE QNLGET(FLAG,LVAL)
2291 C     ============================
2292  
2293       IMPLICIT DOUBLE PRECISION (A-H,O-Z)
2294  
2295       CHARACTER*(*) FLAG
2296       LOGICAL       LVAL
2297
2298       CALL QTRACE('QNLGET ',0)
2299
2300       CALL QNLVAL('GET',FLAG,LVAL)
2301
2302       RETURN
2303       END
2304  
2305 CDECK  ID>, GRMXMQ.
2306  
2307 C     ============================
2308       SUBROUTINE GRMXMQ(NXMA,NQMA)
2309 C     ============================
2310
2311 C---  GRMXMQ: return max allowed number of x, Q2 gridpoints.
2312 C---  Called by user.
2313 C---  MXX and MQ2 are set by parameter statement in common QCNXQM.
2314  
2315       IMPLICIT DOUBLE PRECISION (A-H,O-Z)
2316  
2317  
2318       PARAMETER ( MXX = 410 )
2319       PARAMETER ( MQ2 =  120 )
2320
2321 C--   Do not set the following parameter to zero!
2322       PARAMETER ( NDFMAX = 20)
2323
2324  
2325       COMMON/QCGRID/
2326      +SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS,
2327      +XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45,
2328      +NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2),
2329      +IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2)
2330  
2331
2332       CALL QTRACE('GRMXMQ ',0)
2333  
2334       NXMA = MXX-1
2335       NQMA = MQ2-1
2336  
2337       RETURN
2338       END
2339  
2340 CDECK  ID>, GRGIVE.
2341  
2342 C     ========================================
2343       SUBROUTINE GRGIVE(NX,XMI,XMA,NQ,QMI,QMA)
2344 C     ========================================
2345
2346 C---  GRGIVE: return current grid definition.
2347 C---  Called by user.
2348 C---  Output variables: NX  (integer) number of x gridpoints.
2349 C---                    XMI (real or d.p.) lowest x value.
2350 C---                    XMA (real or d.p.) highest x value = 1.
2351 C---                    NQ  (integer) number of Q2 gridpoints.
2352 C---                    QMI (real or d.p.) lowest Q2 value.
2353 C---                    QMA (real or d.p.) highest Q2 value.
2354  
2355       IMPLICIT DOUBLE PRECISION (A-H,O-Z)
2356  
2357  
2358       PARAMETER ( MXX = 410 )
2359       PARAMETER ( MQ2 =  120 )
2360
2361 C--   Do not set the following parameter to zero!
2362       PARAMETER ( NDFMAX = 20)
2363
2364  
2365       COMMON/QCGRID/
2366      +SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS,
2367      +XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45,
2368      +NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2),
2369      +IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2)
2370  
2371
2372       CALL QTRACE('GRGIVE ',0)
2373  
2374       NX  = NXX
2375       XMI = XXTAB(1)
2376       XMA = XXTAB(NXX+1)
2377       NQ  = NQ2
2378       QMI = Q2TAB(1)
2379       QMA = Q2TAB(NQ2)
2380  
2381       RETURN
2382       END
2383  
2384 CDECK  ID>, GRXNUL.
2385  
2386 C     =================
2387       SUBROUTINE GRXNUL
2388 C     =================
2389  
2390       IMPLICIT DOUBLE PRECISION (A-H,O-Z)
2391  
2392  
2393       LOGICAL
2394      +LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB,
2395      +LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS,
2396      +LALFOK,LDQ2OK,LWT1OK,LWT2OK,
2397      +LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ,
2398      +LFFCAL,LASOLD
2399
2400       COMMON/QCFLAG/ 
2401      +IORD,IOLAST,
2402      +LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB,
2403      +LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS,
2404      +LALFOK,LDQ2OK,LWT1OK,LWT2OK,
2405      +LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ,
2406      +LFFCAL(7,30),LASOLD
2407  
2408  
2409       PARAMETER ( MXX = 410 )
2410       PARAMETER ( MQ2 =  120 )
2411
2412 C--   Do not set the following parameter to zero!
2413       PARAMETER ( NDFMAX = 20)
2414
2415  
2416       COMMON/QCGRID/
2417      +SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS,
2418      +XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45,
2419      +NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2),
2420      +IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2)
2421  
2422  
2423       COMMON/QCPASS/
2424      +ALPHA0, Q0ALFA, ASLAST, QALAST,
2425      +ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2),
2426      +DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10),
2427      +FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2),
2428      +FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2),
2429      +FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2),
2430      +FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST,
2431      +MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2),
2432      +ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2),
2433      +IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10)
2434
2435       LOGICAL LEVDONE,LE_DONE
2436       COMMON/QCLEVL/
2437      +LEVDONE(MXX,10),LE_DONE(MXX)
2438  
2439
2440       CALL QTRACE('GRXNUL ',0)
2441  
2442 C---  Invalidate weight tables (validated by call to QNFILW)
2443       LWT1OK = .FALSE.
2444       LWT2OK = .FALSE.
2445       LWTFOK = .FALSE.
2446       LWFCOK = .FALSE.
2447       LWLCOK = .FALSE.
2448       LWFBOK = .FALSE.
2449       LWLBOK = .FALSE.
2450       LMARK  = .FALSE.
2451 C--   Invalidate all evolutions      
2452       CALL QNFALS(LEVDONE,MXX*10)
2453  
2454 C---  Set grid to zero
2455       CALL QNVNUL(XXTAB,MXX)
2456       CALL QNVNUL(XHTAB,MXX)
2457       CALL QNINUL(IHTAB,MXX)
2458       NXX    = 0
2459       NGRVER = 0
2460
2461 C---  Update IFAILC
2462       CALL GRSETC
2463
2464 C---  Update NFMAP
2465       CALL QNSETT
2466  
2467
2468       RETURN
2469       END
2470  
2471 CDECK  ID>, GRXINP.
2472  
2473 C     ============================
2474       SUBROUTINE GRXINP(XARRAY,NX)
2475 C     ============================
2476  
2477       IMPLICIT DOUBLE PRECISION (A-H,O-Z)
2478  
2479  
2480       LOGICAL
2481      +LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB,
2482      +LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS,
2483      +LALFOK,LDQ2OK,LWT1OK,LWT2OK,
2484      +LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ,
2485      +LFFCAL,LASOLD
2486
2487       COMMON/QCFLAG/ 
2488      +IORD,IOLAST,
2489      +LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB,
2490      +LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS,
2491      +LALFOK,LDQ2OK,LWT1OK,LWT2OK,
2492      +LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ,
2493      +LFFCAL(7,30),LASOLD
2494  
2495  
2496       PARAMETER ( MXX = 410 )
2497       PARAMETER ( MQ2 =  120 )
2498
2499 C--   Do not set the following parameter to zero!
2500       PARAMETER ( NDFMAX = 20)
2501
2502  
2503       COMMON/QCGRID/
2504      +SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS,
2505      +XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45,
2506      +NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2),
2507      +IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2)
2508  
2509  
2510       COMMON/QCPASS/
2511      +ALPHA0, Q0ALFA, ASLAST, QALAST,
2512      +ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2),
2513      +DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10),
2514      +FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2),
2515      +FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2),
2516      +FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2),
2517      +FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST,
2518      +MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2),
2519      +ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2),
2520      +IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10)
2521
2522       LOGICAL LEVDONE,LE_DONE
2523       COMMON/QCLEVL/
2524      +LEVDONE(MXX,10),LE_DONE(MXX)
2525  
2526  
2527       DIMENSION XARRAY(*)
2528  
2529       DATA EPSI /1.E-6/
2530
2531       CALL QTRACE('GRXINP ',0)
2532  
2533       IF(NX.LE.0) THEN
2534         IERR = 1
2535         GOTO 500
2536       ENDIF
2537  
2538       IF((NX+NXX).GT.MXX-1) THEN
2539         IERR = 2
2540         GOTO 500
2541       ENDIF
2542
2543 C---  Invalidate weight tables (validated by call to QNFILW)
2544       LWT1OK = .FALSE.
2545       LWT2OK = .FALSE.
2546       LWTFOK = .FALSE.
2547       LWFCOK = .FALSE.
2548       LWLCOK = .FALSE.
2549       LWFBOK = .FALSE.
2550       LWLBOK = .FALSE.
2551       LMARK  = .FALSE.
2552 C--   Invalidate all evolutions      
2553       CALL QNFALS(LEVDONE,MXX*10)
2554
2555 C---  if this number changes, QCDNUM knows that the grid has changed
2556       NGRVER = NGRVER + 1
2557  
2558       IF(NXX.EQ.0) THEN
2559         DO 10 IX = 1,NX
2560           X = XARRAY(IX)
2561           IF(X.LE.0..OR.X.GT.1.) THEN
2562             IERR = 3
2563             GOTO 500
2564           ENDIF
2565           NXX    = NXX+1
2566           XXTAB(IX) = X
2567   10    CONTINUE
2568         IF(XXTAB(NXX).EQ.1.) THEN
2569           NXX = NXX-1
2570         ELSE
2571           XXTAB(NXX+1) = 1.
2572         ENDIF
2573         RETURN
2574       ENDIF
2575  
2576       IF(XXTAB(NXX).EQ.1.) THEN
2577         NXX = NXX-1
2578       ELSE
2579         XXTAB(NXX+1) = 1.
2580       ENDIF
2581  
2582       NXP = NXX+1
2583  
2584       DO 100 IX = 1,NX
2585  
2586         X = XARRAY(IX)
2587  
2588         IF(X.LE.0..OR.X.GT.1.) THEN
2589           IERR = 3
2590           GOTO 500
2591         ENDIF
2592  
2593 *mb     IF(X.LT.XXTAB(1)-EPSI) THEN
2594         IF(X/XXTAB(1).LT.1.-EPSI) THEN
2595  
2596           DO 20 JX = NXP,1,-1
2597             XXTAB(JX+1) = XXTAB(JX)
2598   20      CONTINUE
2599           NXP    = NXP+1
2600           XXTAB(1)  = X
2601  
2602 *mb     ELSEIF(X.GT.XXTAB(NXP)+EPSI) THEN
2603         ELSEIF(X/XXTAB(NXP).GT.1.+EPSI) THEN
2604  
2605           NXP    = NXP+1
2606           XXTAB(NXP) = X
2607  
2608         ELSE
2609  
2610           DO 30 I = 1,NXP
2611 *mb         IF(XXTAB(I).LE.X+EPSI) IX0 = I
2612             IF(XXTAB(I)/X.LE.1.+EPSI) IX0 = I
2613   30      CONTINUE
2614  
2615 *mb       IF(ABS(XXTAB(IX0)-X).LE.EPSI) THEN
2616           IF(ABS(XXTAB(IX0)/X-1.).LE.EPSI) THEN
2617             XXTAB(IX0) = X
2618           ELSE
2619             DO 40 JX = NXP,IX0+1,-1
2620               XXTAB(JX+1) = XXTAB(JX)
2621   40        CONTINUE
2622             NXP = NXP+1
2623             XXTAB(IX0+1) = X
2624           ENDIF
2625  
2626         ENDIF
2627  
2628  100  CONTINUE
2629  
2630       IF(XXTAB(NXP).EQ.1.) THEN
2631         NXX = NXP-1
2632       ELSE
2633         NXX = NXP
2634         XXTAB(NXX+1) = 1.
2635       ENDIF
2636
2637 C---  Update IFAILC
2638       CALL GRSETC
2639
2640 C---  Update NFMAP
2641       CALL QNSETT
2642
2643 C---  Update heavy quark xgrid
2644       CALL GXHDEF
2645  
2646       RETURN
2647
2648  500  CONTINUE
2649
2650       WRITE(6,'(/'' ------------------------------------'')')
2651       WRITE(6,'( '' QCDNUM error in s/r GRXINP ---> STOP'')')
2652       WRITE(6,'( '' ------------------------------------'')')
2653       WRITE(6,'( '' Input X  :'',E12.5)') X
2654       WRITE(6,'( ''       NX :'',I5   )') NX
2655       IF(IERR.EQ.1) THEN
2656         WRITE(6,'(/'' NX must be .ge. 1'')')
2657       ELSEIF(IERR.EQ.2) THEN
2658         WRITE(6,'(/'' Maximum number of gridpoints exceeded '')')
2659         WRITE(6,'(/'' # existing x  gridpoints ='',I5/
2660      +             '' # points to be added     ='',I5/
2661      +             '' maximum # points allowed ='',I5)')
2662      +                NXX, NX, MXX-1
2663       ELSEIF(IERR.EQ.3) THEN
2664         WRITE(6,'(/'' Value of X outside allowed range (0,1]'')')
2665       ENDIF
2666
2667       CALL QTRACE('GRXINP ',1)
2668
2669       STOP
2670
2671       END
2672  
2673 CDECK  ID>, GRXDEF.
2674  
2675 C     ==========================
2676       SUBROUTINE GRXDEF(NX,XMIN)
2677 C     ==========================
2678  
2679       IMPLICIT DOUBLE PRECISION (A-H,O-Z)
2680  
2681  
2682       LOGICAL
2683      +LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB,
2684      +LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS,
2685      +LALFOK,LDQ2OK,LWT1OK,LWT2OK,
2686      +LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ,
2687      +LFFCAL,LASOLD
2688
2689       COMMON/QCFLAG/ 
2690      +IORD,IOLAST,
2691      +LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB,
2692      +LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS,
2693      +LALFOK,LDQ2OK,LWT1OK,LWT2OK,
2694      +LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ,
2695      +LFFCAL(7,30),LASOLD
2696  
2697  
2698       PARAMETER ( MXX = 410 )
2699       PARAMETER ( MQ2 =  120 )
2700
2701 C--   Do not set the following parameter to zero!
2702       PARAMETER ( NDFMAX = 20)
2703
2704  
2705       COMMON/QCGRID/
2706      +SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS,
2707      +XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45,
2708      +NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2),
2709      +IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2)
2710  
2711  
2712       COMMON/QCPASS/
2713      +ALPHA0, Q0ALFA, ASLAST, QALAST,
2714      +ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2),
2715      +DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10),
2716      +FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2),
2717      +FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2),
2718      +FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2),
2719      +FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST,
2720      +MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2),
2721      +ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2),
2722      +IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10)
2723
2724       LOGICAL LEVDONE,LE_DONE
2725       COMMON/QCLEVL/
2726      +LEVDONE(MXX,10),LE_DONE(MXX)
2727  
2728
2729       CALL QTRACE('GRXDEF ',0)
2730  
2731       IF(NX.LE.0) THEN
2732         IERR = 1
2733         GOTO 500
2734       ENDIF
2735  
2736       IF(NX.GT.MXX-1) THEN
2737         IERR = 2
2738         GOTO 500
2739       ENDIF
2740  
2741       IF(XMIN.LE.0.OR.XMIN.GE.1.) THEN
2742         IERR = 3
2743         GOTO 500
2744       ENDIF
2745
2746 C---  Invalidate weight tables (validated by call to QNFILW)
2747       LWT1OK = .FALSE.
2748       LWT2OK = .FALSE.
2749       LWTFOK = .FALSE.
2750       LWFCOK = .FALSE.
2751       LWLCOK = .FALSE.
2752       LWFBOK = .FALSE.
2753       LWLBOK = .FALSE.
2754       LMARK  = .FALSE.
2755 C--   Invalidate all evolutions      
2756       CALL QNFALS(LEVDONE,MXX*10)
2757
2758 C---  if this number changes, QCDNUM knows that the grid has changed
2759       NGRVER = NGRVER + 1
2760  
2761       XMAX = 1.
2762       YMIN = SYFROMX(XMIN)
2763       YMAX = SYFROMX(XMAX)
2764       BW   = (YMAX-YMIN)/NX
2765       DO I = 1,NX
2766         YI = YMIN+(I-1)*BW
2767         XXTAB(I) = SXFROMY(YI)
2768       ENDDO
2769       XXTAB(1)    = XMIN
2770       XXTAB(NX+1) = 1.
2771       NXX         = NX
2772
2773 C---  Update IFAILC
2774       CALL GRSETC
2775
2776 C---  Update NFMAP
2777       CALL QNSETT
2778
2779 C---  Update heavy quark xgrid
2780       CALL GXHDEF
2781  
2782       RETURN
2783
2784  500  CONTINUE
2785
2786       WRITE(6,'(/'' ------------------------------------'')')
2787       WRITE(6,'( '' QCDNUM error in s/r GRXDEF ---> STOP'')')
2788       WRITE(6,'( '' ------------------------------------'')')
2789       WRITE(6,'( '' Input NX    :'',I5   )') NX
2790       WRITE(6,'( ''       Xmin  :'',E12.5)') XMIN
2791       IF(IERR.EQ.1) THEN
2792         WRITE(6,'(/'' NX must be .ge. 1'')')
2793       ELSEIF(IERR.EQ.2) THEN
2794         WRITE(6,'(/'' NX > max number of gridpoints'',
2795      +             '' allowed:'',I5)') MXX-1
2796       ELSEIF(IERR.EQ.3) THEN
2797         WRITE(6,'(/'' Xmin outside allowed range (0,1]'')')
2798       ENDIF
2799
2800       CALL QTRACE('GRXDEF ',1)
2801
2802       STOP
2803
2804       END
2805  
2806 CDECK  ID>, GRXLIM.
2807  
2808 C     ==========================
2809       SUBROUTINE GRXLIM(NX,XMIN)
2810 C     ==========================
2811  
2812       IMPLICIT DOUBLE PRECISION (A-H,O-Z)
2813  
2814  
2815       LOGICAL
2816      +LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB,
2817      +LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS,
2818      +LALFOK,LDQ2OK,LWT1OK,LWT2OK,
2819      +LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ,
2820      +LFFCAL,LASOLD
2821
2822       COMMON/QCFLAG/ 
2823      +IORD,IOLAST,
2824      +LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB,
2825      +LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS,
2826      +LALFOK,LDQ2OK,LWT1OK,LWT2OK,
2827      +LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ,
2828      +LFFCAL(7,30),LASOLD
2829  
2830  
2831       PARAMETER ( MXX = 410 )
2832       PARAMETER ( MQ2 =  120 )
2833
2834 C--   Do not set the following parameter to zero!
2835       PARAMETER ( NDFMAX = 20)
2836
2837  
2838       COMMON/QCGRID/
2839      +SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS,
2840      +XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45,
2841      +NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2),
2842      +IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2)
2843  
2844  
2845       COMMON/QCPASS/
2846      +ALPHA0, Q0ALFA, ASLAST, QALAST,
2847      +ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2),
2848      +DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10),
2849      +FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2),
2850      +FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2),
2851      +FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2),
2852      +FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST,
2853      +MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2),
2854      +ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2),
2855      +IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10)
2856
2857       LOGICAL LEVDONE,LE_DONE
2858       COMMON/QCLEVL/
2859      +LEVDONE(MXX,10),LE_DONE(MXX)
2860  
2861  
2862       DATA EPSI / 1.E-6 /
2863
2864       CALL QTRACE('GRXLIM ',0)
2865  
2866       IF(NX.LE.0) THEN
2867         IERR = 1
2868         GOTO 500
2869       ENDIF
2870  
2871       IF(NX.GT.MXX-1) THEN
2872         IERR = 2
2873         GOTO 500
2874       ENDIF
2875
2876 C---  Invalidate weight tables (validated by call to QNFILW)
2877       LWT1OK = .FALSE.
2878       LWT2OK = .FALSE.
2879       LWTFOK = .FALSE.
2880       LWFCOK = .FALSE.
2881       LWLCOK = .FALSE.
2882       LWFBOK = .FALSE.
2883       LWLBOK = .FALSE.
2884       LMARK  = .FALSE.
2885 C--   Invalidate all evolutions      
2886       CALL QNFALS(LEVDONE,MXX*10)
2887  
2888       IF(XMIN.LE.0.OR.XMIN.GE.1.) THEN
2889         IERR = 3
2890         GOTO 500
2891       ENDIF
2892
2893 C---  if this number changes, QCDNUM knows that the grid has changed
2894       NGRVER = NGRVER + 1
2895  
2896       IF(NXX.EQ.0) THEN
2897         XXTAB(1) = 1.
2898       ELSEIF(XXTAB(NXX).EQ.1.) THEN
2899         NXX = NXX-1
2900       ELSE
2901         XXTAB(NXX+1) = 1.
2902       ENDIF
2903  
2904       NXP = NXX+1
2905  
2906 *mb   IF(XMIN.LT.XXTAB(1)-EPSI) THEN
2907       IF(XMIN/XXTAB(1).LT.1.-EPSI) THEN
2908         DO 20 IX = NXP,1,-1
2909           XXTAB(IX+1) = XXTAB(IX)
2910   20    CONTINUE
2911         NXP   = NXP+1
2912         XXTAB(1) = XMIN
2913       ENDIF
2914  
2915       IF(NX.GT.NXP-1) THEN
2916   30    CONTINUE
2917         GAPMAX = 0.
2918         DO 35 IX = 1,NXP-1
2919           GAP = SYFROMX(XXTAB(IX+1))-SYFROMX(XXTAB(IX))
2920           IF(GAP.GT.GAPMAX) THEN
2921             GAPMAX = GAP
2922             IX0    = IX
2923           ENDIF
2924   35    CONTINUE
2925         DO 40 IX = NXP,IX0+1,-1
2926           XXTAB(IX+1) = XXTAB(IX)
2927   40    CONTINUE
2928         NXP = NXP+1
2929         XXTAB(IX0+1) = 0.5*(XXTAB(IX0)+XXTAB(IX0+2))
2930         IF(NXP-1.LT.NX) GOTO 30
2931  
2932       ELSEIF(NX.LT.NXP-1) THEN
2933   50    CONTINUE
2934         GAPMIN = 999999.
2935         DO 55 IX = 2,NXP-1
2936           GAP = SYFROMX(XXTAB(IX+1))-SYFROMX(XXTAB(IX-1))
2937           IF(GAP.LE.GAPMIN) THEN
2938             GAPMIN = GAP
2939             IX0    = IX
2940           ENDIF
2941   55    CONTINUE
2942         DO 60 IX = IX0,NXP-1
2943           XXTAB(IX) = XXTAB(IX+1)
2944   60    CONTINUE
2945         XXTAB(NXP) = 0.
2946         NXP = NXP-1
2947         IF(NXP-1.GT.NX) GOTO 50
2948       ENDIF
2949  
2950       IF(XXTAB(NXP).EQ.1.) THEN
2951         NXX = NXP-1
2952       ELSE
2953         NXX = NXP
2954         XXTAB(NXX+1) = 1.
2955       ENDIF
2956
2957 C---  Update IFAILC
2958       CALL GRSETC
2959
2960 C---  Update NFMAP
2961       CALL QNSETT
2962
2963 C---  Update heavy quark xgrid
2964       CALL GXHDEF
2965  
2966       RETURN
2967
2968  500  CONTINUE
2969
2970       WRITE(6,'(/'' ------------------------------------'')')
2971       WRITE(6,'( '' QCDNUM error in s/r GRXLIM ---> STOP'')')
2972       WRITE(6,'( '' ------------------------------------'')')
2973       WRITE(6,'( '' Input NX    :'',I5   )') NX
2974       WRITE(6,'( ''       Xmin  :'',E12.5)') XMIN
2975       IF(IERR.EQ.1) THEN
2976         WRITE(6,'(/'' NX must be .ge. 1'')')
2977       ELSEIF(IERR.EQ.2) THEN
2978         WRITE(6,'(/'' NX > max number of gridpoints'',
2979      +             '' allowed:'',I5)') MXX-1
2980       ELSEIF(IERR.EQ.3) THEN
2981         WRITE(6,'(/'' Xmin outside allowed range (0,1]'')')
2982       ENDIF
2983
2984       CALL QTRACE('GRXLIM ',1)
2985
2986       STOP
2987
2988       END
2989  
2990 CDECK  ID>, GXHDEF.
2991  
2992 C     =================
2993       SUBROUTINE GXHDEF
2994 C     =================
2995
2996 C--   Create a purely logarithmic grid in x (XHTAB) for use 
2997 C--   in the heavy quark structure function calculations.
2998  
2999       IMPLICIT DOUBLE PRECISION (A-H,O-Z)
3000  
3001  
3002       PARAMETER ( MXX = 410 )
3003       PARAMETER ( MQ2 =  120 )
3004
3005 C--   Do not set the following parameter to zero!
3006       PARAMETER ( NDFMAX = 20)
3007
3008  
3009       COMMON/QCGRID/
3010      +SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS,
3011      +XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45,
3012      +NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2),
3013      +IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2)
3014  
3015
3016       IF(NXX.EQ.0.OR.NXX.GE.MXX)           RETURN
3017       IF(XXTAB(1).LE.0..OR.XXTAB(1).GE.1.) RETURN
3018
3019       XL1 = LOG(XXTAB(1))
3020       XL2 = 0.
3021       BW  = (XL2-XL1)/NXX
3022
3023       DO IX = 1,NXX
3024         XL = XL1 + (IX-1)*BW
3025         XHTAB(IX) = EXP(XL)
3026         IHTAB(IX) = ABS(IXFROMX(XHTAB(IX)))
3027       ENDDO
3028       XHTAB(NXX+1) = 1.
3029       IHTAB(NXX+1) = NXX+1
3030
3031       RETURN
3032       END
3033  
3034
3035 CDECK  ID>, SYFROMX.
3036  
3037 C     ====================================
3038       DOUBLE PRECISION FUNCTION SYFROMX(X)
3039 C     ====================================
3040       IMPLICIT DOUBLE PRECISION (A-H,O-Z)
3041  
3042  
3043       PARAMETER ( MXX = 410 )
3044       PARAMETER ( MQ2 =  120 )
3045
3046 C--   Do not set the following parameter to zero!
3047       PARAMETER ( NDFMAX = 20)
3048
3049  
3050       COMMON/QCGRID/
3051      +SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS,
3052      +XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45,
3053      +NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2),
3054      +IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2)
3055  
3056  
3057       IF(X.LE.SCAX0) THEN
3058         SYFROMX = LOG(X)
3059       ELSE
3060         SYFROMX = LOG(SCAX0) + (X-SCAX0)/SCAX0
3061       ENDIF
3062  
3063       RETURN
3064       END
3065
3066 CDECK  ID>, SXFROMY.
3067  
3068 C     ====================================
3069       DOUBLE PRECISION FUNCTION SXFROMY(Y)
3070 C     ====================================
3071       IMPLICIT DOUBLE PRECISION (A-H,O-Z)
3072  
3073  
3074       PARAMETER ( MXX = 410 )
3075       PARAMETER ( MQ2 =  120 )
3076
3077 C--   Do not set the following parameter to zero!
3078       PARAMETER ( NDFMAX = 20)
3079
3080  
3081       COMMON/QCGRID/
3082      +SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS,
3083      +XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45,
3084      +NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2),
3085      +IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2)
3086  
3087  
3088       IF(Y.LE.LOG(SCAX0)) THEN
3089         SXFROMY = EXP(Y)
3090       ELSE
3091         SXFROMY = (Y-LOG(SCAX0)+1.) * SCAX0
3092       ENDIF
3093  
3094       RETURN
3095       END
3096  
3097 CDECK  ID>, GRXOUT.
3098  
3099 C     =========================
3100       SUBROUTINE GRXOUT(XARRAY)
3101 C     =========================
3102
3103 C---  Copy XXTAB to XARRAY which should have been dimensioned
3104 C---  to at least NXX+1 by the user.
3105  
3106       IMPLICIT DOUBLE PRECISION (A-H,O-Z)
3107  
3108  
3109       LOGICAL
3110      +LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB,
3111      +LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS,
3112      +LALFOK,LDQ2OK,LWT1OK,LWT2OK,
3113      +LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ,
3114      +LFFCAL,LASOLD
3115
3116       COMMON/QCFLAG/ 
3117      +IORD,IOLAST,
3118      +LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB,
3119      +LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS,
3120      +LALFOK,LDQ2OK,LWT1OK,LWT2OK,
3121      +LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ,
3122      +LFFCAL(7,30),LASOLD
3123  
3124  
3125       PARAMETER ( MXX = 410 )
3126       PARAMETER ( MQ2 =  120 )
3127
3128 C--   Do not set the following parameter to zero!
3129       PARAMETER ( NDFMAX = 20)
3130
3131  
3132       COMMON/QCGRID/
3133      +SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS,
3134      +XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45,
3135      +NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2),
3136      +IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2)
3137  
3138  
3139       DIMENSION XARRAY(*)
3140
3141       CALL QTRACE('GRXOUT ',0)
3142  
3143       DO 10 IX = 1,NXX+1
3144         XARRAY(IX) = XXTAB(IX)
3145   10  CONTINUE
3146  
3147       RETURN
3148       END
3149  
3150 CDECK  ID>, LOGXGR.
3151  
3152 C     ===============================
3153       LOGICAL FUNCTION LOGXGR(IDUMMY)
3154 C     ===============================
3155
3156 C---  Figure out if xgrid is purely logarithmic
3157  
3158       IMPLICIT DOUBLE PRECISION (A-H,O-Z)
3159
3160       REAL    RAT1,RAT
3161  
3162  
3163       PARAMETER ( MXX = 410 )
3164       PARAMETER ( MQ2 =  120 )
3165
3166 C--   Do not set the following parameter to zero!
3167       PARAMETER ( NDFMAX = 20)
3168
3169  
3170       COMMON/QCGRID/
3171      +SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS,
3172      +XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45,
3173      +NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2),
3174      +IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2)
3175  
3176
3177       LOGXGR = .FALSE.
3178
3179       IF(NXX.LE.0) RETURN
3180
3181       RAT1   = XXTAB(2)/XXTAB(1)
3182       LOGXGR = .TRUE.
3183       DO IX = 1,NXX
3184         RAT = XXTAB(IX+1)/XXTAB(IX)
3185         IF(RAT.NE.RAT1) LOGXGR = .FALSE.
3186       ENDDO
3187
3188       RETURN
3189       END
3190  
3191 CDECK  ID>, GRQNUL.
3192  
3193 C     =================
3194       SUBROUTINE GRQNUL
3195 C     =================
3196  
3197       IMPLICIT DOUBLE PRECISION (A-H,O-Z)
3198  
3199  
3200       LOGICAL
3201      +LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB,
3202      +LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS,
3203      +LALFOK,LDQ2OK,LWT1OK,LWT2OK,
3204      +LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ,
3205      +LFFCAL,LASOLD
3206
3207       COMMON/QCFLAG/ 
3208      +IORD,IOLAST,
3209      +LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB,
3210      +LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS,
3211      +LALFOK,LDQ2OK,LWT1OK,LWT2OK,
3212      +LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ,
3213      +LFFCAL(7,30),LASOLD
3214  
3215  
3216       PARAMETER ( MXX = 410 )
3217       PARAMETER ( MQ2 =  120 )
3218
3219 C--   Do not set the following parameter to zero!
3220       PARAMETER ( NDFMAX = 20)
3221
3222  
3223       COMMON/QCGRID/
3224      +SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS,
3225      +XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45,
3226      +NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2),
3227      +IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2)
3228  
3229  
3230       COMMON/QCPASS/
3231      +ALPHA0, Q0ALFA, ASLAST, QALAST,
3232      +ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2),
3233      +DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10),
3234      +FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2),
3235      +FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2),
3236      +FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2),
3237      +FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST,
3238      +MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2),
3239      +ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2),
3240      +IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10)
3241
3242       LOGICAL LEVDONE,LE_DONE
3243       COMMON/QCLEVL/
3244      +LEVDONE(MXX,10),LE_DONE(MXX)
3245  
3246
3247       CALL QTRACE('GRQNUL ',0)
3248  
3249 C---  Invalidate weight tables (validated by call to QNFILW)
3250       LALFOK = .FALSE.
3251       LDQ2OK = .FALSE.
3252       LWFCOK = .FALSE.
3253       LWLCOK = .FALSE.
3254       LWFBOK = .FALSE.
3255       LWLBOK = .FALSE.
3256       LMARK  = .FALSE.
3257 C--   Invalidate all evolutions      
3258       CALL QNFALS(LEVDONE,MXX*10)
3259  
3260 C---  Set grid to zero
3261       CALL QNVNUL(Q2TAB,MQ2)
3262       NQ2    = 0
3263       NGRVER = 0
3264
3265 C---  Update IFAILC
3266       CALL GRSETC
3267
3268 C---  Update NFMAP
3269       CALL QNSETT
3270  
3271
3272       RETURN
3273       END
3274  
3275 CDECK  ID>, GRQINP.
3276 C
3277 C     ============================
3278       SUBROUTINE GRQINP(QARRAY,NQ)
3279 C     ============================
3280  
3281       IMPLICIT DOUBLE PRECISION (A-H,O-Z)
3282  
3283  
3284       LOGICAL
3285      +LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB,
3286      +LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS,
3287      +LALFOK,LDQ2OK,LWT1OK,LWT2OK,
3288      +LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ,
3289      +LFFCAL,LASOLD
3290
3291       COMMON/QCFLAG/ 
3292      +IORD,IOLAST,
3293      +LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB,
3294      +LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS,
3295      +LALFOK,LDQ2OK,LWT1OK,LWT2OK,
3296      +LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ,
3297      +LFFCAL(7,30),LASOLD
3298  
3299  
3300       PARAMETER ( MXX = 410 )
3301       PARAMETER ( MQ2 =  120 )
3302
3303 C--   Do not set the following parameter to zero!
3304       PARAMETER ( NDFMAX = 20)
3305
3306  
3307       COMMON/QCGRID/
3308      +SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS,
3309      +XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45,
3310      +NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2),
3311      +IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2)
3312  
3313  
3314       COMMON/QCPASS/
3315      +ALPHA0, Q0ALFA, ASLAST, QALAST,
3316      +ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2),
3317      +DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10),
3318      +FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2),
3319      +FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2),
3320      +FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2),
3321      +FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST,
3322      +MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2),
3323      +ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2),
3324      +IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10)
3325
3326       LOGICAL LEVDONE,LE_DONE
3327       COMMON/QCLEVL/
3328      +LEVDONE(MXX,10),LE_DONE(MXX)
3329  
3330  
3331       DIMENSION QARRAY(*)
3332  
3333       DATA EPSI /1.E-6/
3334
3335       CALL QTRACE('GRQINP ',0)
3336  
3337       IF(NQ.LE.0) THEN
3338         IERR = 1
3339         GOTO 500
3340       ENDIF
3341  
3342       IF((NQ+NQ2).GT.MQ2-1) THEN
3343         IERR = 2
3344         GOTO 500
3345       ENDIF
3346
3347 C---  Invalidate weight tables (validated by call to QNFILW)
3348       LALFOK = .FALSE.
3349       LDQ2OK = .FALSE.
3350       LWFCOK = .FALSE.
3351       LWLCOK = .FALSE.
3352       LWFBOK = .FALSE.
3353       LWLBOK = .FALSE.
3354       LMARK  = .FALSE.
3355 C--   Invalidate all evolutions      
3356       CALL QNFALS(LEVDONE,MXX*10)
3357
3358 C---  if this number changes, QCDNUM knows that the grid has changed
3359       NGRVER = NGRVER + 1
3360  
3361       IF(NQ2.EQ.0) THEN
3362         DO 10 IQ = 1,NQ
3363           Q = QARRAY(IQ)
3364           IF(Q.LE.0.) THEN
3365             IERR = 3
3366             GOTO 500
3367           ENDIF
3368           NQ2    = NQ2+1
3369           Q2TAB(IQ) = Q
3370   10    CONTINUE
3371         RETURN
3372       ENDIF
3373  
3374       DO 100 IQ = 1,NQ
3375  
3376         Q = QARRAY(IQ)
3377  
3378         IF(Q.LE.0.) THEN
3379           IERR = 3
3380           GOTO 500
3381         ENDIF
3382  
3383 *mb     IF(Q.LT.Q2TAB(1)-EPSI) THEN
3384         IF(Q/Q2TAB(1).LT.1.-EPSI) THEN
3385  
3386           DO 20 JQ = NQ2,1,-1
3387             Q2TAB(JQ+1) = Q2TAB(JQ)
3388   20      CONTINUE
3389           NQ2    = NQ2+1
3390           Q2TAB(1)  = Q
3391  
3392 *mb     ELSEIF(Q.GT.Q2TAB(NQ2)+EPSI) THEN
3393         ELSEIF(Q/Q2TAB(NQ2).GT.1.+EPSI) THEN
3394  
3395           NQ2    = NQ2+1
3396           Q2TAB(NQ2) = Q
3397  
3398         ELSE
3399  
3400           DO 30 I = 1,NQ2
3401 *mb         IF(Q2TAB(I).LE.Q+EPSI) IQ0 = I
3402             IF(Q2TAB(I)/Q.LE.1.+EPSI) IQ0 = I
3403   30      CONTINUE
3404  
3405 *mb       IF(ABS(Q2TAB(IQ0)-Q).LE.EPSI) THEN
3406           IF(ABS(Q2TAB(IQ0)/Q-1.).LE.EPSI) THEN
3407             Q2TAB(IQ0) = Q
3408           ELSE
3409             DO 40 JQ = NQ2,IQ0+1,-1
3410               Q2TAB(JQ+1) = Q2TAB(JQ)
3411   40        CONTINUE
3412             NQ2 = NQ2+1
3413             Q2TAB(IQ0+1) = Q
3414           ENDIF
3415  
3416         ENDIF
3417  
3418  100  CONTINUE
3419
3420 C---  Update IFAILC
3421       CALL GRSETC
3422
3423 C---  Update NFMAP
3424       CALL QNSETT
3425  
3426       RETURN
3427
3428  500  CONTINUE
3429
3430       WRITE(6,'(/'' ------------------------------------'')')
3431       WRITE(6,'( '' QCDNUM error in s/r GRQINP ---> STOP'')')
3432       WRITE(6,'( '' ------------------------------------'')')
3433       WRITE(6,'( '' Input Q2 :'',E12.5)') Q
3434       WRITE(6,'( ''       NQ :'',I5   )') NQ
3435       IF(IERR.EQ.1) THEN
3436         WRITE(6,'(/'' NQ must be .ge. 1'')')
3437       ELSEIF(IERR.EQ.2) THEN
3438         WRITE(6,'(/'' Maximum number of gridpoints exceeded '')')
3439         WRITE(6,'(/'' # existing Q2 gridpoints ='',I5/
3440      +             '' # points to be added     ='',I5/
3441      +             '' maximum # points allowed ='',I5)')
3442      +                NQ2, NQ, MQ2-1
3443       ELSEIF(IERR.EQ.3) THEN
3444         WRITE(6,'(/'' Value of Q2 outside allowed range > 0'')')
3445       ENDIF
3446
3447       CALL QTRACE('GRQINP ',1)
3448
3449       STOP
3450
3451       END
3452  
3453 CDECK  ID>, GRQDEF.
3454  
3455 C     ===============================
3456       SUBROUTINE GRQDEF(NQ,QMIN,QMAX)
3457 C     ===============================
3458  
3459       IMPLICIT DOUBLE PRECISION (A-H,O-Z)
3460  
3461  
3462       LOGICAL
3463      +LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB,
3464      +LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS,
3465      +LALFOK,LDQ2OK,LWT1OK,LWT2OK,
3466      +LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ,
3467      +LFFCAL,LASOLD
3468
3469       COMMON/QCFLAG/ 
3470      +IORD,IOLAST,
3471      +LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB,
3472      +LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS,
3473      +LALFOK,LDQ2OK,LWT1OK,LWT2OK,
3474      +LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ,
3475      +LFFCAL(7,30),LASOLD
3476  
3477  
3478       PARAMETER ( MXX = 410 )
3479       PARAMETER ( MQ2 =  120 )
3480
3481 C--   Do not set the following parameter to zero!
3482       PARAMETER ( NDFMAX = 20)
3483
3484  
3485       COMMON/QCGRID/
3486      +SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS,
3487      +XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45,
3488      +NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2),
3489      +IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2)
3490  
3491  
3492       COMMON/QCPASS/
3493      +ALPHA0, Q0ALFA, ASLAST, QALAST,
3494      +ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2),
3495      +DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10),
3496      +FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2),
3497      +FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2),
3498      +FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2),
3499      +FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST,
3500      +MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2),
3501      +ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2),
3502      +IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10)
3503
3504       LOGICAL LEVDONE,LE_DONE
3505       COMMON/QCLEVL/
3506      +LEVDONE(MXX,10),LE_DONE(MXX)
3507  
3508  
3509       CALL QTRACE('GRQDEF ',0)
3510  
3511       IF(NQ.LE.1) THEN
3512         IERR = 1
3513         GOTO 500
3514       ENDIF
3515  
3516       IF(NQ.GT.MQ2-1) THEN
3517         IERR = 2
3518         GOTO 500
3519       ENDIF
3520  
3521       IF(QMIN.LE.0.OR.QMAX.LE.0.OR.QMIN.GE.QMAX) THEN
3522         IERR = 3
3523         GOTO 500
3524       ENDIF
3525
3526 C---  Invalidate weight tables (validated by call to QNFILW)
3527       LALFOK = .FALSE.
3528       LDQ2OK = .FALSE.
3529       LWFCOK = .FALSE.
3530       LWLCOK = .FALSE.
3531       LWFBOK = .FALSE.
3532       LWLBOK = .FALSE.
3533       LMARK  = .FALSE.
3534 C--   Invalidate all evolutions      
3535       CALL QNFALS(LEVDONE,MXX*10)
3536  
3537 C---  if this number changes, QCDNUM knows that the grid has changed
3538       NGRVER = NGRVER + 1
3539  
3540       YMIN = SYFROMQ(QMIN)
3541       YMAX = SYFROMQ(QMAX)
3542       BW   = (YMAX-YMIN)/(NQ-1)
3543       DO I = 1,NQ
3544         YI = YMIN+(I-1)*BW
3545         Q2TAB(I) = SQFROMY(YI)
3546       ENDDO   
3547       Q2TAB(1)  = QMIN
3548       Q2TAB(NQ) = QMAX
3549       NQ2       = NQ
3550
3551 C---  Update IFAILC
3552       CALL GRSETC
3553
3554 C---  Update NFMAP
3555       CALL QNSETT
3556  
3557       RETURN
3558
3559  500  CONTINUE
3560
3561       WRITE(6,'(/'' ------------------------------------'')')
3562       WRITE(6,'( '' QCDNUM error in s/r GRQDEF ---> STOP'')')
3563       WRITE(6,'( '' ------------------------------------'')')
3564       WRITE(6,'( '' Input NQ    :'',I5   )') NQ
3565       WRITE(6,'( ''       Q2min :'',E12.5)') QMIN
3566       WRITE(6,'( ''       Q2max :'',E12.5)') QMAX
3567       IF(IERR.EQ.1) THEN
3568         WRITE(6,'(/'' NQ must be .ge. 2'')')
3569       ELSEIF(IERR.EQ.2) THEN
3570         WRITE(6,'(/'' NQ > max number of gridpoints'',
3571      +             '' allowed:'',I5)') MQ2-1
3572       ELSEIF(IERR.EQ.3) THEN
3573         WRITE(6,'(/'' Qmin and/or Qmax .le. 0 or Qmin .ge. Qmax'')')
3574       ENDIF
3575