LHAPDF 5.2.2 source code.
authormorsch <morsch@f7af4fe6-9843-0410-8265-dc069ae4e863>
Mon, 7 Aug 2006 09:09:40 +0000 (09:09 +0000)
committermorsch <morsch@f7af4fe6-9843-0410-8265-dc069ae4e863>
Mon, 7 Aug 2006 09:09:40 +0000 (09:09 +0000)
40 files changed:
LHAPDF/lhapdf5.2.2/EVLCTEQ.f [new file with mode: 0644]
LHAPDF/lhapdf5.2.2/LHpdflib.f [new file with mode: 0644]
LHAPDF/lhapdf5.2.2/QCDNUM.f [new file with mode: 0644]
LHAPDF/lhapdf5.2.2/QCDparams.f [new file with mode: 0644]
LHAPDF/lhapdf5.2.2/Sqcdnum.f [new file with mode: 0644]
LHAPDF/lhapdf5.2.2/alphas.f [new file with mode: 0644]
LHAPDF/lhapdf5.2.2/description.f [new file with mode: 0644]
LHAPDF/lhapdf5.2.2/eks98.f [new file with mode: 0644]
LHAPDF/lhapdf5.2.2/eksarp.f [new file with mode: 0644]
LHAPDF/lhapdf5.2.2/evolution.f [new file with mode: 0644]
LHAPDF/lhapdf5.2.2/inputPDF.f [new file with mode: 0644]
LHAPDF/lhapdf5.2.2/lhaglue.f [new file with mode: 0644]
LHAPDF/lhapdf5.2.2/parameter.f [new file with mode: 0644]
LHAPDF/lhapdf5.2.2/wrapEVLCTEQ.f [new file with mode: 0644]
LHAPDF/lhapdf5.2.2/wrapQCDNUM.f [new file with mode: 0644]
LHAPDF/lhapdf5.2.2/wrapQCDNUM3.f [new file with mode: 0644]
LHAPDF/lhapdf5.2.2/wrapQCDNUM4.f [new file with mode: 0644]
LHAPDF/lhapdf5.2.2/wrapa02.f [new file with mode: 0644]
LHAPDF/lhapdf5.2.2/wrapa02m.f [new file with mode: 0644]
LHAPDF/lhapdf5.2.2/wrapabfkwpi.f [new file with mode: 0644]
LHAPDF/lhapdf5.2.2/wrapacfgpg.f [new file with mode: 0644]
LHAPDF/lhapdf5.2.2/wrapcteq5.f [new file with mode: 0644]
LHAPDF/lhapdf5.2.2/wrapcteq6.f [new file with mode: 0644]
LHAPDF/lhapdf5.2.2/wrapdgg.f [new file with mode: 0644]
LHAPDF/lhapdf5.2.2/wrapdog.f [new file with mode: 0644]
LHAPDF/lhapdf5.2.2/wrapevolve.f [new file with mode: 0644]
LHAPDF/lhapdf5.2.2/wrapgrv.f [new file with mode: 0644]
LHAPDF/lhapdf5.2.2/wrapgrvg.f [new file with mode: 0644]
LHAPDF/lhapdf5.2.2/wrapgrvpi.f [new file with mode: 0644]
LHAPDF/lhapdf5.2.2/wrapgsg.f [new file with mode: 0644]
LHAPDF/lhapdf5.2.2/wrapgsg96.f [new file with mode: 0644]
LHAPDF/lhapdf5.2.2/wraph1.f [new file with mode: 0644]
LHAPDF/lhapdf5.2.2/wraplacg.f [new file with mode: 0644]
LHAPDF/lhapdf5.2.2/wrapmrst.f [new file with mode: 0644]
LHAPDF/lhapdf5.2.2/wrapmrst98.f [new file with mode: 0644]
LHAPDF/lhapdf5.2.2/wrapowpi.f [new file with mode: 0644]
LHAPDF/lhapdf5.2.2/wrapsasg.f [new file with mode: 0644]
LHAPDF/lhapdf5.2.2/wrapsmrspi.f [new file with mode: 0644]
LHAPDF/lhapdf5.2.2/wrapwhitg.f [new file with mode: 0644]
LHAPDF/lhapdf5.2.2/wrapzeus.f [new file with mode: 0644]

diff --git a/LHAPDF/lhapdf5.2.2/EVLCTEQ.f b/LHAPDF/lhapdf5.2.2/EVLCTEQ.f
new file mode 100644 (file)
index 0000000..c9aed0a
--- /dev/null
@@ -0,0 +1,2622 @@
+      SUBROUTINE CtLhALFSET (QS, ALFS)
+      IMPLICIT DOUBLE PRECISION (A-H, O-Z)
+      EXTERNAL CtLhRTALF
+      COMMON / CtLhRTALFC / ALFST, JORD, NEFF
+      DATA ALAM, BLAM, ERR / 0.01, 10.0, 0.02 /
+      QST   = QS
+      ALFST = ALFS
+      CALL CtLhParQcd (2, 'ORDR', ORDR, IR1)
+      JORD  = ORDR
+      NEFF = LhCtNFL(QS)
+      EFLLN  = CtLhQZBRNT (CtLhRTALF, ALAM, BLAM, ERR, IR2)
+      EFFLAM = QS / EXP (EFLLN)
+      CALL CtLhSETL1 (NEFF, EFFLAM)
+      END
+      FUNCTION CtLhALPI (AMU)
+      IMPLICIT DOUBLE PRECISION (A-H, O-Z)
+      COMMON / LhCtCWZPRM / ALAM(0:9), AMHAT(0:9), AMN, NHQ
+      COMMON / LhCtQCDPAR_LHA / AL, NF, NORDER, SET
+      LOGICAL SET
+      PARAMETER (D0 = 0.D0, D1 = 1.D0, BIG = 1.0D15)
+      DATA IW1, IW2 / 2*0 /
+      IF(.NOT.SET) CALL CtLhLAMCWZ
+      NEFF = LhCtNFL(AMU)
+      ALM  = ALAM(NEFF)
+      CtLhALPI = CtLhALPQCD (NORDER, NEFF, AMU/ALM, IRT)
+      IF (IRT .EQ. 1) THEN
+         CALL CtLhWARNR (IW1, 'AMU < ALAM in CtLhALPI', 'AMU', AMU,
+     >              ALM, BIG, 1)
+      ELSEIF (IRT .EQ. 2) THEN
+         CALL CtLhWARNR (IW2, 'CtLhALPI > 3; Be aware!', 'CtLhALPI', 
+     >  CtLhALPI, D0, D1, 0)
+      ENDIF
+      RETURN
+      END
+      FUNCTION CtLhALPQCD (IRDR, NF, RML, IRT)
+      IMPLICIT DOUBLE PRECISION (A-H, O-Z)
+      PARAMETER (D0 = 0.D0, D1 = 1.D0, BIG = 1.0D15)
+      PARAMETER (CG = 3.0d0, TR = 0.5d0, CF = 4.0d0/3.0d0)
+      IRT = 0
+      IF (IRDR .LT. 1 .OR. IRDR .GT. 2) THEN
+        print *,
+     >  'Order out of range in CtLhALPQCD: IRDR = ', IRDR
+        STOP
+      ENDIF
+      B0 = (11.d0*CG  - 2.* NF) / 3.d0
+      B1 = (34.d0*CG**2 - 10.d0*CG*NF - 6.d0*CF*NF) / 3.d0
+      RM2 = RML**2
+      IF (RM2 .LE. 1.) THEN
+         IRT = 1
+         CtLhALPQCD = 99.
+         RETURN
+      ENDIF
+      ALN = LOG (RM2)
+      AL = 4.d0/ B0 / ALN
+      IF (IRDR .GE. 2) AL = AL * (1.d0-B1*LOG(ALN) / ALN / B0**2)
+      IF (AL .GE. 3.) THEN
+         IRT = 2
+      ENDIF
+      CtLhALPQCD = AL
+      RETURN
+      END
+      FUNCTION CtLhAMHATF(I)
+      IMPLICIT DOUBLE PRECISION (A-H, O-Z)
+      COMMON / LhCtCWZPRM / ALAM(0:9), AMHAT(0:9), AMN, NHQ
+      COMMON / LhCtQCDPAR_LHA / AL, NF, NORDER, SET
+      LOGICAL SET
+      IF (.NOT.SET) CALL CtLhLAMCWZ
+      IF ((I.LE.0).OR.(I.GT.9)) THEN
+         print *,'warning I OUT OF RANGE IN CtLhAMHATF'
+         CtLhAMHATF = 0
+      ELSE
+         CtLhAMHATF = AMHAT(I)
+      ENDIF
+      RETURN
+      END
+      FUNCTION CtLhDXDZ (Z)
+      IMPLICIT DOUBLE PRECISION (A-H, O-Z)
+      PARAMETER (D0=0D0, D1=1D0, D2=2D0, D3=3D0, D4=4D0, D10=1D1)
+      DATA HUGE, IWRN / 1.E20, 0 /
+      ZZ = Z
+      X = CtLhXFRMZ (ZZ)
+      TEM = CtLhDZDX (X)
+      IF     (TEM .NE. D0) THEN
+        TMP = D1 / TEM
+      Else
+      CALL CtLhWARNR(IWRN, 'CtLhDXDZ singular in CtLhDXDZ; set=HUGE',
+     >             'Z', Z, D0, D1, 0)
+        TMP = HUGE
+      EndIf
+      CtLhDXDZ = TMP
+      RETURN
+      END
+      SUBROUTINE CtLhEVLPAR (IACT, NAME, VALUE, IRET)
+      IMPLICIT DOUBLE PRECISION (A-H, O-Z)
+      CHARACTER*(*) NAME
+      IRET = 1
+      IF     (IACT .EQ. 0) THEN
+              WRITE ( NINT(VALUE) , 101)
+  101         FORMAT (/ ' Initiation parameters:   Qini, Ipd0, Ihdn ' /
+     >                  ' Maximum Q, Order of Alpha:     Qmax, IKNL ' /
+     >                  ' X- mesh parameters   :   Xmin, Xcr,   Nx  ' /
+     >                  ' LnQ-mesh parameters  :         Nt,   Jt   ' /
+     >                  ' # of parton flavors  :         NfMx       ' /)
+              IRET = 4
+      ElseIF (IACT .EQ. 1) THEN
+              CALL CtLhEVLSET (NAME, VALUE, IRET)
+      Else
+       print *,'fatal evlpar'
+       stop
+      EndIf
+      RETURN
+      END
+      SUBROUTINE CtLhEVLSET (NAME, VALUE, IRET)
+      IMPLICIT DOUBLE PRECISION (A-H, O-Z)
+      LOGICAL LSTX
+      CHARACTER*(*) NAME
+      PARAMETER (MXX = 105, MXQ = 25, MXF = 6)
+      PARAMETER (MXPN = MXF * 2 + 2)
+      PARAMETER (MXQX= MXQ * MXX,   MXPQX = MXQX * MXPN)
+      COMMON / LhCtXXARAY / XCR, XMIN, XV(0:MXX), LSTX, NX
+      COMMON / LhCtQARAY1 / QINI,QMAX, QV(0:MXQ),TV(0:MXQ), NT,JT,NG
+      COMMON / LhCtEVLPAC / AL, IKNL, IPD0, IHDN, NfMx
+     > / PdfSwh / Iset, IpdMod, Iptn0, NuIni
+      IRET = 1
+      IF     (NAME .EQ. 'QINI')  THEN
+          IF (VALUE .LE. 0) GOTO 12
+          QINI = VALUE
+      ElseIF (NAME .EQ. 'IPD0')  THEN
+          ITEM = NINT(VALUE)
+          IF (Item .Eq. 10 .or. Item .Eq. 11) GOTO 12
+          IPD0 = ITEM
+      ElseIF (NAME .EQ. 'IHDN') THEN
+          ITEM = NINT(VALUE)
+          IF (ITEM .LT. -1 .OR. ITEM .GT. 5) GOTO 12
+          IHDN = ITEM
+      ElseIF (NAME .EQ. 'QMAX')  THEN
+          IF (VALUE .LE. QINI) GOTO 12
+          QMAX = VALUE
+      ElseIF (NAME .EQ. 'IKNL') THEN
+          ITMP = NINT(VALUE)
+          ITEM = ABS(ITMP)
+          IF (ITEM.NE.1.AND.ITEM.NE.2) GOTO 12
+          IKNL = ITMP
+      ElseIF (NAME .EQ. 'XCR') THEN
+          IF (VALUE .LT. XMIN .OR. VALUE .GT. 10.) GOTO 12
+          XCR = VALUE
+          LSTX = .FALSE.
+      ElseIF (NAME .EQ. 'XMIN') THEN
+          IF (VALUE .LT. 1D-7 .OR. VALUE .GT. 1D0) GOTO 12
+          XMIN = VALUE
+          LSTX = .FALSE.
+      ElseIF (NAME .EQ. 'NX') THEN
+          ITEM = NINT(VALUE)
+          IF (ITEM .LT. 10 .OR. ITEM .GT. MXX-1) GOTO 12
+          NX = ITEM
+          LSTX = .FALSE.
+      ElseIF (NAME .EQ. 'NT') THEN
+          ITEM = NINT(VALUE)
+          IF (ITEM .LT. 2 .OR. ITEM .GT. MXQ) GOTO 12
+          NT = ITEM
+      ElseIF (NAME .EQ. 'JT') THEN
+          ITEM = NINT(VALUE)
+          IF (ITEM .LT. 1 .OR. ITEM .GT. 5) GOTO 12
+          JT = ITEM
+      ElseIF (NAME .EQ. 'NFMX') THEN
+          ITEM = NINT(VALUE)
+          IF (ITEM .LT. 1 .OR. ITEM .GT. MXPN) GOTO 12
+          NfMx = ITEM
+      ElseIF (NAME .EQ. 'IPDMOD') THEN
+          ITEM = NINT(VALUE)
+          IF (Abs(Item) .Gt. 1) GOTO 12
+          IpdMod = ITEM
+      ElseIF (NAME .EQ. 'IPTN0') THEN
+          ITEM = NINT(VALUE)
+          IF (ABS(ITEM) .GT. MXF) GOTO 12
+          IPTN0 = ITEM
+      ElseIF (NAME .EQ. 'NUINI') THEN
+          ITEM = NINT(VALUE)
+          IF (ITEM .LE. 0) GOTO 12
+          NuIni = ITEM
+      Else
+          IRET = 0
+      EndIf
+      RETURN
+   12 IRET = 2
+      RETURN
+      END
+      SUBROUTINE CtLhEVOLVE (FINI, IRET)
+      IMPLICIT DOUBLE PRECISION (A-H, O-Z)
+      include 'parmsetup.inc'
+      LOGICAL LSTX
+      PARAMETER (MXX = 105, MXQ = 25, MXF = 6)
+      PARAMETER (MXPN = MXF * 2 + 2)
+      PARAMETER (MXQX= MXQ * MXX,   MXPQX = MXQX * MXPN)
+      PARAMETER (M1=-3, M2=3, NDG=3, NDH=NDG+1, L1=M1-1, L2=M2+NDG-2)
+      COMMON / LhCtXXARAY / XCR, XMIN, XV(0:MXX), LSTX, NX
+      COMMON / LhCtQARAY1 / QINI,QMAX, QV(0:MXQ),TV(0:MXQ), NT,JT,NG
+      COMMON / LhCtQARAY2 / TLN(MXF), DTN(MXF), NTL(MXF), NTN(MXF)
+      COMMON / LhCtEVLPAC / AL, IKNL, IPD0, IHDN, NfMx
+      COMMON / LhCtPEVLDT / UPD(MXPQX,nmxset), KF, Nelmt
+      COMMON / LhCtVARIBX / XA(MXX, L1:L2), ELY(MXX), DXTZ(MXX)
+      COMMON / LhCtVARBAB / GB(NDG, NDH, MXX), H(NDH, MXX, M1:M2)
+      DIMENSION QRKP(MXF)
+      DIMENSION JI(-MXF : MXF+1)
+      EXTERNAL LhCtNSRHSP, LhCtNSRHSM, FINI
+      DATA DZER / 0.0 /
+       save nxsave, ntsave, jtsave, ngsave, 
+     &      xcrsave, xminsave, qinisave, qmaxsave, ientry, ishow
+       data ientry / 0 /
+       dimension xvsave(0:MXX), qvsave(0:MXQ), tvsave(0:MXQ)
+c
+       call getnset(iset)
+c      
+       ientry = ientry + 1
+       if(ientry .lt. 100) then
+666       format(1x,'enter evolve',i3)
+       elseif(ientry .eq. 100) then
+667       format(1x,'enter evolve',i3,' further suppressed')
+       endif
+       ishow = 0               !set to no display
+       if(ientry .eq. 1) then
+          ishow = 1            !turn display on
+       endif
+   11 IRET = 0
+      IF (IHDN .LE. 4) THEN
+        MXVAL = 2
+      ElseIF (IHDN .LE. 6) THEN
+        MXVAL = 3
+      EndIf
+      IF (.NOT. LSTX) CALL CtLhXARRAY
+      DLX = 1.D0 / NX
+      J10 = NX / 10
+      CALL CtLhPARPDF (2, 'ALAM', AL, IR)
+      CALL CtLhQARRAY (NINI)
+      NFSN = NFMX + 1
+      KF = 2 * NFMX + 2
+      Nelmt = KF * (Nt+1) * (Nx+1)
+      DO 101 IFLV = -NFMX, NFMX+1
+        JFL = NFMX + IFLV
+        JI(IFLV) = JFL * (NT+1) * (NX+1)
+  101 CONTINUE
+    3 DO 31 IZ = 1, NX
+        UPD(JI(0)+IZ+1,iset) = FINI (0, XV(IZ))
+        UPD(JI(NFSN)+IZ+1,iset) = 0
+        IF (NFMX .EQ. 0) GOTO 31
+        DO 331 IFLV = 1, NINI
+          A = FINI ( IFLV, XV(IZ))
+          B = FINI (-IFLV, XV(IZ))
+          QRKP (IFLV) = A + B
+          UPD(JI(NFSN)+IZ+1,iset) = 
+     >       UPD(JI(NFSN)+IZ+1,iset) + QRKP (IFLV)
+          UPD(JI(-IFLV)+IZ+1,iset) = A - B
+  331   CONTINUE
+        DO 332 IFLV = 1, NINI
+           UPD(JI( IFLV)+IZ+1,iset) = 
+     >        QRKP(IFLV) - UPD(JI(NFSN)+IZ+1,iset)/NINI
+  332   CONTINUE
+   31 CONTINUE
+      DO 21 NEFF = NINI, NFMX
+          IF (IKNL .EQ. 2) CALL CtLhSTUPKL (NEFF)
+          ICNT = NEFF - NINI + 1
+          IF (NTN(ICNT) .EQ. 0) GOTO 21
+          NITR = NTN (ICNT)
+          DT   = DTN (ICNT)
+          TIN  = TLN (ICNT)
+          CALL CtLhSNEVL (IKNL, NX, NITR, JT, DT, TIN, NEFF,
+     >    UPD(JI(NFSN)+2,iset), UPD(JI(0)+2,iset),
+     >    UPD(JI(NFSN)+1,iset), UPD(JI(0)+1,iset))
+          IF (NEFF .EQ. 0) GOTO 88
+    5     DO 333 IFLV = 1, NEFF
+           CALL CtLhNSEVL (LhCtNSRHSP, IKNL, NX, NITR, JT, DT, TIN, 
+     >     NEFF, UPD(JI( IFLV)+2,iset), UPD(JI( IFLV)+1,iset))
+           IF (IFLV .LE. MXVAL)
+     >     CALL CtLhNSEVL (LhCtNSRHSM, IKNL, NX, NITR, JT, DT, TIN, 
+     >     NEFF, UPD(JI(-IFLV)+2,iset), UPD(JI(-IFLV)+1,iset))
+           DO 55 IS = 0, NITR
+           DO 56 IX = 0, NX
+             TP = UPD (IS*(NX+1) + IX + 1 + JI( IFLV),iset)
+             TS = UPD (IS*(NX+1) + IX + 1 + JI( NFSN),iset) / NEFF
+             TP = TP + TS
+             IF (IKNL .GT. 0) TP = MAX (TP, DZER)
+             IF (IFLV .LE. MXVAL) THEN
+                TM = UPD (IS*(NX+1) + IX + 1 + JI(-IFLV),iset)
+                IF (IKNL .GT. 0) THEN
+                  TM = MAX (TM, DZER)
+                  TP = MAX (TP, TM)
+                EndIf
+             Else
+                TM = 0.
+             EndIf
+             UPD (JI( IFLV) + IS*(NX+1) + IX + 1,iset) = (TP + TM)/2.
+             UPD (JI(-IFLV) + IS*(NX+1) + IX + 1,iset) = (TP - TM)/2.
+   56      CONTINUE
+   55      CONTINUE
+333      CONTINUE
+        DO 334 IFLV = NEFF + 1, NFMX
+          DO 57 IS = 0, NITR
+          DO 58 IX = 0, NX
+            UPD(JI( IFLV) + IS*(NX+1) + IX + 1,iset) = 0
+            UPD(JI(-IFLV) + IS*(NX+1) + IX + 1,iset) = 0
+   58     CONTINUE
+   57     CONTINUE
+  334   CONTINUE
+   88   CONTINUE
+        IF (NFMX .EQ. NEFF) GOTO 21
+        DO 335 IFLV = -NFMX, NFMX+1
+           JI(IFLV) = JI(IFLV) + NITR * (NX+1)
+  335   CONTINUE
+        CALL CtLhHQRK (NX, TT, NEFF+1, UPD(JI(0)+2,iset),
+     >     UPD(JI(NEFF+1)+2,iset))
+        DO 32 IZ = 1, NX
+         QRKP (NEFF+1) = 2. * UPD(JI( NEFF+1) + IZ + 1,iset)
+         UPD (JI(NFSN)+IZ+1,iset) = UPD (JI(NFSN)+IZ+1,iset)
+     >        + QRKP (NEFF+1)
+         VS00 =  UPD (JI(NFSN)+IZ+1,iset) / (NEFF+1)
+         UPD(JI( NEFF+1) + IZ + 1,iset) = QRKP(NEFF+1) - VS00
+         DO 321 IFL = 1, NEFF
+           A = UPD(JI( IFL)+IZ+1,iset)
+           B = UPD(JI(-IFL)+IZ+1,iset)
+           QRKP(IFL) = A + B
+           UPD(JI( IFL)+IZ+1,iset) = QRKP(IFL) - VS00
+           IF (IFL .LE. MXVAL)  UPD(JI(-IFL)+IZ+1,iset) = A - B
+  321    CONTINUE
+   32   CONTINUE
+   21 CONTINUE
+       if(ientry .eq. 1) then
+          nxsave = nx
+          ntsave = nt
+          jtsave = jt
+          ngsave = ng
+          xcrsave = xcr
+          xminsave = xmin
+          qinisave = qini
+          qmaxsave = qmax
+       endif
+       if((nx .ne. nxsave) .or.
+     &    (nt .ne. ntsave) .or.
+     &    (jt .ne. jtsave) .or.
+     &    (ng .ne. ngsave) .or.
+     &    (xcr .ne. xcrsave) .or.
+     &    (xmin .ne. xminsave) .or.
+     &    (qini .ne. qinisave) .or.
+     &    (qmax .ne. qmaxsave)) then
+          write(6,669) nx, nt, jt, ng, xcr, xmin, 
+     &                 qini, qmax, ientry
+669       format(1x,'evolve.f:  nx,nt,jt,ng=',4i4,
+     &              ' xcr,xmin=',2f9.6,
+     &              ' qini, qmax',f7.4,1x,e12.5,' ientry=',i6)
+          nxsave = nx
+          ntsave = nt
+          jtsave = jt
+          ngsave = ng
+          qinisave = qini
+          qmaxsave = qmax
+          xcrsave = xcr
+          xminsave = xmin
+       endif
+       ixshow = 0
+       do i = 0, mxx
+          if(xvsave(i) .ne. xv(i)) then
+             ixshow = 1
+             xvsave(i) = xv(i)
+          endif
+       enddo
+       iqshow = 0
+       itshow = 0
+       do i = 0, mxq
+          if(qvsave(i) .ne. qv(i)) then
+             iqshow = 1
+             qvsave(i) = qv(i)
+          endif
+          if(tvsave(i) .ne. tv(i)) then
+             itshow = 1
+             tvsave(i) = tv(i)
+          endif
+       enddo
+      Return
+      End
+      FUNCTION CtLhFINTRP (FF,  X0, DX, NX,  XV,  ERR, IR)
+      IMPLICIT DOUBLE PRECISION (A-H, O-Z)
+      PARAMETER (D0=0D0, D1=1D0, D2=2D0, D3=3D0, D4=4D0, D10=1D1)
+      PARAMETER (MX = 3)
+      DIMENSION FF (0:NX), XX(MX)
+      DATA SML, XX / 1.D-5,  0., 1.0, 2.0 /
+      DATA  IW1, IW3, IW5 / 3 * 0 /
+      IR = 0
+      X = XV
+      ERR = 0.
+      ANX = NX
+      CtLhFINTRP = 0.
+      IF (NX .LT. 1) THEN
+         CALL CtLhWARNI(IW1, 'Nx < 1, error in CtLhFINTRP.',
+     >              'NX', NX, 1, 256, 1)
+         IR = 1
+         RETURN
+      ELSE
+         MNX = MIN(NX+1, MX)
+      ENDIF
+      IF (DX .LE. 0) THEN
+         CALL CtLhWARNR(IW3, 'DX < 0, error in CtLhFINTRP.',
+     >              'DX', DX, D0, D1, 1)
+         IR = 2
+         RETURN
+      ENDIF
+      XM = X0 + DX * NX
+      IF (X .LT. X0-SML .OR. X .GT. XM+SML) THEN
+        CALL CtLhWARNR(IW5,
+     >     'X out of range in CtLhFINTRP, Extrapolation used.',
+     >     'X',X,X0,XM,1)
+      IR = 3
+      ENDIF
+      TX = (X - X0) / DX
+      IF (TX .LE. 1.) THEN
+        IX = 0
+      ELSEIF (TX .GE. ANX-1.) THEN
+        IX = NX - 2
+      ELSE
+        IX = TX
+      ENDIF
+      DDX = TX - IX
+      CALL CtLhRATINT (XX, FF(IX), MNX, DDX, TEM, ERR)
+      CtLhFINTRP = TEM
+      RETURN
+      END
+      FUNCTION CtLhGausInt(F,XL,XR,AERR,RERR,ERR,IRT)
+      IMPLICIT DOUBLE PRECISION (A-H, O-Z)
+        DIMENSION XLIMS(100), R(93), W(93)
+        INTEGER PTR(4),NORD(4)
+        external f
+        DATA PTR,NORD/4,10,22,46,  6,12,24,48/
+        DATA R/.2386191860,.6612093865,.9324695142,
+     1 .1252334085,.3678314990,.5873179543,.7699026742,.9041172563,
+     1 .9815606342,.0640568929,.1911188675,.3150426797,.4337935076,
+     1 .5454214714,.6480936519,.7401241916,.8200019860,.8864155270,
+     1 .9382745520,.9747285560,.9951872200,.0323801710,.0970046992,
+     1 .1612223561,.2247637903,.2873624873,.3487558863,.4086864820,
+     1 .4669029048,.5231609747,.5772247261,.6288673968,.6778723796,
+     1 .7240341309,.7671590325,.8070662040,.8435882616,.8765720203,
+     1 .9058791367,.9313866907,.9529877032,.9705915925,.9841245837,
+     1 .9935301723,.9987710073,.0162767488,.0488129851,.0812974955,
+     1 .1136958501,.1459737146,.1780968824,.2100313105,.2417431561,
+     1 .2731988126,.3043649444,.3352085229,.3656968614,.3957976498,
+     1 .4254789884,.4547094222,.4834579739,.5116941772,.5393881083,
+     1 .5665104186,.5930323648,.6189258401,.6441634037,.6687183100,
+     1 .6925645366,.7156768123,.7380306437,.7596023411,.7803690438,
+     1 .8003087441,.8194003107,.8376235112,.8549590334,.8713885059,
+     1 .8868945174,.9014606353,.9150714231,.9277124567,.9393703398,
+     1 .9500327178,.9596882914,.9683268285,.9759391746,.9825172636,
+     1 .9880541263,.9925439003,.9959818430,.9983643759,.9996895039/
+        DATA W/.4679139346,.3607615730,.1713244924,
+     1 .2491470458,.2334925365,.2031674267,.1600783285,.1069393260,
+     1 .0471753364,.1279381953,.1258374563,.1216704729,.1155056681,
+     1 .1074442701,.0976186521,.0861901615,.0733464814,.0592985849,
+     1 .0442774388,.0285313886,.0123412298,.0647376968,.0644661644,
+     1 .0639242386,.0631141923,.0620394232,.0607044392,.0591148397,
+     1 .0572772921,.0551995037,.0528901894,.0503590356,.0476166585,
+     1 .0446745609,.0415450829,.0382413511,.0347772226,.0311672278,
+     1 .0274265097,.0235707608,.0196161605,.0155793157,.0114772346,
+     1 .0073275539,.0031533461,.0325506145,.0325161187,.0324471637,
+     1 .0323438226,.0322062048,.0320344562,.0318287589,.0315893308,
+     1 .0313164256,.0310103326,.0306713761,.0302999154,.0298963441,
+     1 .0294610900,.0289946142,.0284974111,.0279700076,.0274129627,
+     1 .0268268667,.0262123407,.0255700360,.0249006332,.0242048418,
+     1 .0234833991,.0227370697,.0219666444,.0211729399,.0203567972,
+     1 .0195190811,.0186606796,.0177825023,.0168854799,.0159705629,
+     1 .0150387210,.0140909418,.0131282296,.0121516047,.0111621020,
+     1 .0101607705,.0091486712,.0081268769,.0070964708,.0060585455,
+     1 .0050142027,.0039645543,.0029107318,.0018539608,.0007967921/
+        DATA TOLABS,TOLREL,NMAX/1.E-35,5.E-4,100/
+        TOLABS=AERR
+        TOLREL=RERR
+     
+        CtLhGausInt=0.
+        NLIMS=2
+        XLIMS(1)=XL
+        XLIMS(2)=XR
+10      AA=(XLIMS(NLIMS)-XLIMS(NLIMS-1))/2D0
+        BB=(XLIMS(NLIMS)+XLIMS(NLIMS-1))/2D0
+        TVAL=0.
+        DO 15 I=1,3
+15      TVAL=TVAL+W(I)*(F(BB+AA*R(I))+F(BB-AA*R(I)))
+        TVAL=TVAL*AA
+        DO 25 J=1,4
+        VAL=0.
+        DO 20 I=PTR(J),PTR(J)-1+NORD(J)
+20      VAL=VAL+W(I)*(F(BB+AA*R(I))+F(BB-AA*R(I)))
+        VAL=VAL*AA
+        TOL=MAX(TOLABS,TOLREL*ABS(VAL))
+        IF (ABS(TVAL-VAL).LT.TOL) THEN
+                CtLhGausInt=CtLhGausInt+VAL
+                NLIMS=NLIMS-2
+                IF (NLIMS.NE.0) GO TO 10
+                RETURN
+                END IF
+25      TVAL=VAL
+        IF (NMAX.EQ.2) THEN
+                CtLhGausInt=VAL
+                RETURN
+                END IF
+        IF (NLIMS.GT.(NMAX-2)) THEN
+                write(*,50) CtLhGausInt,NMAX,BB-AA,BB+AA
+                RETURN
+                END IF
+        XLIMS(NLIMS+1)=BB
+        XLIMS(NLIMS+2)=BB+AA
+        XLIMS(NLIMS)=BB
+        NLIMS=NLIMS+2
+        GO TO 10
+50      FORMAT (' CtLhGausInt FAILS, CtLhGausInt,NMAX,XL,XR=',
+     >            G15.7,I5,2G15.7)
+        END
+      SUBROUTINE CtLhHINTEG (NX, F, H)
+      IMPLICIT DOUBLE PRECISION (A-H, O-Z)
+      PARAMETER (MXX = 105, MXQ = 25, MXF = 6)
+      PARAMETER (MXPN = MXF * 2 + 2)
+      PARAMETER (MXQX= MXQ * MXX,   MXPQX = MXQX * MXPN)
+      PARAMETER (M1=-3, M2=3, NDG=3, NDH=NDG+1, L1=M1-1, L2=M2+NDG-2)
+      COMMON / LhCtHINTEC / GH(NDG, MXX)
+      COMMON / LhCtVARIBX / XA(MXX, L1:L2), ELY(MXX), DXTZ(MXX)
+      DIMENSION F(NX), H(NX), G(MXX)
+      DZ = 1D0 / (NX-1)
+      DO 20 I = 1, NX-2
+         NP = NX - I + 1
+         TEM = GH(1,I)*F(I) + GH(2,I)*F(I+1) + GH(3,I)*F(I+2)
+         DO 30 KZ = 3, NP
+            IY = I + KZ - 1
+            W = XA(I,1) / XA(IY,1)
+            G(KZ) = DXTZ(IY)*(F(IY)-W*F(I))/(1.-W)
+   30    CONTINUE
+         HTEM = CtLhSMPSNA (NP-2, DZ, G(3), ERR)
+         TEM1 = F(I) * ELY(I)
+         H(I) = TEM + HTEM + TEM1
+   20 CONTINUE
+      H(NX-1) = F(NX) - F(NX-1) + F(NX-1) * (ELY(NX-1) - XA(NX-1,0))
+      H(NX)   = 0
+      RETURN
+      END
+      SUBROUTINE CtLhHQRK (NX, TT, NQRK, Y, F)
+      IMPLICIT DOUBLE PRECISION (A-H, O-Z)
+      PARAMETER (MXX = 105, MXQ = 25, MXF = 6)
+      DIMENSION Y(NX), F(NX)
+      IF (NX .GT. 1) GOTO 11
+   11 CONTINUE
+      DO 230 IZ = 1, NX
+        IF (NX .GT. 1) THEN
+        F(IZ) = 0
+        GOTO 230
+        EndIf
+  230 CONTINUE
+      RETURN
+      END
+      SUBROUTINE CtLhINTEGR (NX, M, F,   G, IR)
+      IMPLICIT DOUBLE PRECISION (A-H, O-Z)
+      CHARACTER MSG*80
+      PARAMETER (MXX = 105, MXQ = 25, MXF = 6)
+      PARAMETER (MXPN = MXF * 2 + 2)
+      PARAMETER (MXQX= MXQ * MXX,   MXPQX = MXQX * MXPN)
+      PARAMETER (M1=-3, M2=3, NDG=3, NDH=NDG+1, L1=M1-1, L2=M2+NDG-2)
+      COMMON / LhCtVARIBX / XA(MXX, L1:L2), ELY(MXX), DXTZ(MXX)
+      COMMON / LhCtVARBAB / GB(NDG, NDH, MXX), H(NDH, MXX, M1:M2)
+      DIMENSION   F(NX), G(NX)
+      DATA IWRN1, IWRN2 / 0, 0 /
+      IRR = 0
+      IF (NX .LT. 1 .OR. XA(NX-1,1) .EQ. 0D0) THEN
+        MSG = 'NX out of range in CtLhINTEGR call'
+        CALL CtLhWARNI (IWRN1, MSG, 'NX', NX, 0, MXX, 0)
+        IRR = 1
+      EndIf
+      IF (M .LT. M1 .OR. M .GT. M2) THEN
+        MSG ='Exponent M out of range in CtLhINTEGR'
+        CALL CtLhWARNI (IWRN2, MSG, 'M', M, M1, M2, 1)
+        IRR = 2
+      EndIf
+      G(NX) = 0D0
+      TEM = H(1, NX-1, -M) * F(NX-2) + H(2, NX-1, -M) * F(NX-1)
+     >    + H(3, NX-1, -M) * F(NX)
+      IF (M .EQ. 0) THEN
+         G(NX-1) = TEM
+      Else
+         G(NX-1) = TEM * XA(NX-1, M)
+      EndIf
+      DO 10 I = NX-2, 2, -1
+         TEM = TEM + H(1,I,-M)*F(I-1) + H(2,I,-M)*F(I)
+     >             + H(3,I,-M)*F(I+1) + H(4,I,-M)*F(I+2)
+         IF (M .EQ. 0) THEN
+            G(I) = TEM
+         Else
+            G(I) = TEM * XA(I, M)
+         EndIf
+   10 CONTINUE
+      TEM = TEM + H(2,1,-M)*F(1) + H(3,1,-M)*F(2) + H(4,1,-M)*F(3)
+      IF (M .EQ. 0) THEN
+         G(1) = TEM
+      Else
+         G(1) = TEM * XA(1, M)
+      EndIf
+      IR = IRR
+      RETURN
+      END
+      SUBROUTINE CtLhKERNEL
+     >(XX, FF1, FG1, GF1, GG1, PNSP, PNSM, FF2, FG2, GF2, GG2, NFL, IRT)
+      IMPLICIT DOUBLE PRECISION (A-H, O-Z)
+      PARAMETER (PI = 3.141592653589793d0, PI2 = PI ** 2)
+      PARAMETER (D0 = 0.0, D1 = 1.0)
+      DATA CF, CG, TR, IWRN / 1.33333333333333d0, 3.0d0, 0.5d0, 0 /
+      IRT = 0
+      TRNF = TR * NFL
+      X = XX
+      IF (X .LE. 0. .OR. X .GE. 1.) THEN
+        CALL CtLhWARNR(IWRN, 'X out of range in CtLhKERNEL', 'X', X,
+     >             D0, D1, 1)
+        IRT = 1
+        RETURN
+      EndIf
+      XI = 1./ X
+      X2 = X ** 2
+      XM1I = 1./ (1.- X)
+      XP1I = 1./ (1.+ X)
+      XLN = LOG (X)
+      XLN2 = XLN ** 2
+      XLN1M = LOG (1.- X)
+      SPEN2 = CtLhSPENC2 (X)
+      FFP = (1.+ X2) * XM1I
+      FGP = (2.- 2.* X + X2) / X
+      GFP = 1. - 2.* X + 2.* X2
+      GGP = XM1I + XI - 2. + X - X2
+      FFM = (1.+ X2) * XP1I
+      FGM = - (2.+ 2.* X + X2) / X
+      GFM = 1. + 2.* X + 2.* X2
+      GGM = XP1I - XI - 2. - X - X2
+      FF1 = CF * FFP * (1.- X)
+      FG1 = CF * FGP * X
+      GF1 = 2.* TRNF * GFP
+      GG1 = 2.* CG * GGP * X * (1.-X)
+      PCF2 = -2.* FFP *XLN*XLN1M - (3.*XM1I + 2.*X)*XLN
+     >     - (1.+X)/2.*XLN2 - 5.*(1.-X)
+      PCFG = FFP * (XLN2 + 11.*XLN/3.+ 67./9.- PI**2 / 3.)
+     >     + 2.*(1.+X) * XLN + 40.* (1.-X) / 3.
+      PCFT = (FFP * (- XLN - 5./3.) - 2.*(1.-X)) * 2./ 3.
+      PQQB = 2.* FFM * SPEN2 + 2.*(1.+X)*XLN + 4.*(1.-X)
+      PQQB = (CF**2-CF*CG/2.) * PQQB
+      PQQ2 = CF**2 * PCF2 + CF*CG * PCFG / 2. + CF*TRNF * PCFT
+      PNSP = (PQQ2 + PQQB) * (1.-X)
+      PNSM = (PQQ2 - PQQB) * (1.-X)
+      FFCF2 = - 1. + X + (1.- 3.*X) * XLN / 2. - (1.+ X) * XLN2 / 2.
+     >      - FFP * (3.* XLN / 2. + 2.* XLN * XLN1M)
+     >      + FFM * 2.* SPEN2
+      FFCFG = 14./3.* (1.-X)
+     >      + FFP * (11./6.* XLN + XLN2 / 2. + 67./18. - PI2 / 6.)
+     >      - FFM * SPEN2
+      FFCFT = - 16./3. + 40./3.* X + (10.* X + 16./3.* X2 + 2.) * XLN
+     >                 - 112./9.* X2 + 40./9./X - 2.* (1.+ X) * XLN2
+     >      - FFP * (10./9. + 2./3. * XLN)
+      FGCF2 = - 5./2.- 7./2.* X + (2.+ 7./2.* X) * XLN + (X/2.-1.)*XLN2
+     >               - 2.* X * XLN1M
+     >      - FGP * (3.* XLN1M + XLN1M ** 2)
+      FGCFG = 28./9. + 65./18.* X + 44./9. * X2 - (12.+ 5.*X + 8./3.*X2)
+     >                      * XLN + (4.+ X) * XLN2 + 2.* X * XLN1M
+     >      + FGP * (-2.*XLN*XLN1M + XLN2/2. + 11./3.*XLN1M + XLN1M**2
+     >               - PI2/6. + 0.5)
+     >      + FGM * SPEN2
+      FGCFT = -4./3.* X - FGP * (20./9.+ 4./3.*XLN1M)
+      GFCFT = 4.- 9.*X + (-1.+ 4.*X)*XLN + (-1.+ 2.*X)*XLN2 + 4.*XLN1M
+     >      + GFP * (-4.*XLN*XLN1M + 4.*XLN + 2.*XLN2 - 4.*XLN1M
+     >               + 2.*XLN1M**2 - 2./3.* PI2 + 10.)
+      GFCGT = 182./9.+ 14./9.*X + 40./9./X + (136./3.*X - 38./3.)*XLN
+     >               - 4.*XLN1M - (2.+ 8.*X)*XLN2
+     >      + GFP * (-XLN2 + 44./3.*XLN - 2.*XLN1M**2 + 4.*XLN1M
+     >               + PI2/3. - 218./9.)
+     >      + GFM * 2. * SPEN2
+      GGCFT = -16.+ 8.*X + 20./3.*X2 + 4./3./X + (-6.-10.*X)*XLN
+     >        - 2.* (1.+ X) * XLN2
+      GGCGT = 2.- 2.*X + 26./9.*X2 - 26./9./X - 4./3.*(1.+X)*XLN
+     >      - GGP * 20./9.
+      GGCG2 = 27./2.*(1.-X) + 67./9.*(X2-XI) + 4.*(1.+X)*XLN2
+     >              + (-25.+ 11.*X - 44.*X2)/3.*XLN
+     >      + GGP * (67./9.- 4.*XLN*XLN1M + XLN2 - PI2/3.)
+     >      + GGM * 2.* SPEN2
+      FF2 = CF * TRNF * FFCFT + CF ** 2 * FFCF2 + CF * CG   * FFCFG
+      FG2 = CF * TRNF * FGCFT + CF ** 2 * FGCF2 + CF * CG   * FGCFG
+      GF2 = CF * TRNF * GFCFT                   + CG * TRNF * GFCGT
+      GG2 = CF * TRNF * GGCFT + CG ** 2 * GGCG2 + CG * TRNF * GGCGT
+      XLG = (LOG(1./(1.-X)) + 1.)
+      XG2 = XLG ** 2
+      FF2 = FF2 * X * (1.- X)
+      FG2 = FG2 * X / XG2
+      GF2 = GF2 * X / XG2
+      GG2 = GG2 * X * (1.- X)
+      RETURN
+      END
+      SUBROUTINE CtLhLAMCWZ
+      IMPLICIT DOUBLE PRECISION (A-H, O-Z)
+      COMMON / LhCtQCDPAR_LHA / AL, NF, NORDER, SET
+      LOGICAL SET
+      CALL CtLhSETL1 (NF, AL)
+      END
+      FUNCTION LhCtNAMQCD(NNAME)
+      IMPLICIT DOUBLE PRECISION (A-H, O-Z)
+      CHARACTER NNAME*(*), NAME*8
+      COMMON / LhCtQCDPAR_LHA / AL, NF, NORDER, SET
+      LOGICAL SET
+      CHARACTER ONECH*(1)
+      ONECH = '0'
+      IASC0 = ICHAR(ONECH)
+      NAME = NNAME
+      LhCtNAMQCD=0
+      IF ( (NAME .EQ. 'ALAM') .OR. (NAME .EQ. 'LAMB') .OR.
+     1        (NAME .EQ. 'LAM') .OR. (NAME .EQ. 'LAMBDA') )
+     2             LhCtNAMQCD=1
+      IF ( (NAME .EQ. 'NFL') .OR. (NAME(1:3) .EQ. '#FL') .OR.
+     1        (NAME .EQ. '# FL') )
+     2             LhCtNAMQCD=2
+      DO 10 I=1, 9
+         IF (NAME .EQ. 'M'//CHAR(I+IASC0))
+     1             LhCtNAMQCD=I+2
+10       CONTINUE
+      DO 20 I= 0, NF
+         IF (NAME .EQ. 'LAM'//CHAR(I+IASC0))
+     1             LhCtNAMQCD=I+13
+20       CONTINUE
+      IF (NAME(:3).EQ.'ORD' .OR. NAME(:3).EQ.'NRD') LhCtNAMQCD = 24
+      RETURN
+      END
+      FUNCTION LhCtNFL(AMU)
+      IMPLICIT DOUBLE PRECISION (A-H, O-Z)
+      COMMON / LhCtCWZPRM / ALAM(0:9), AMHAT(0:9), AMN, NHQ
+      COMMON / LhCtQCDPAR_LHA / AL, NF, NORDER, SET
+      LOGICAL SET
+      IF (.NOT. SET) CALL CtLhLAMCWZ
+      LhCtNFL = NF - NHQ
+      IF ((LhCtNFL .EQ. NF) .OR. (AMU .LE. AMN)) GOTO 20
+      DO 10 I = NF - NHQ + 1, NF
+         IF (AMU .GE. AMHAT(I)) THEN
+            LhCtNFL = I
+         ELSE
+            GOTO 20
+         ENDIF
+10       CONTINUE
+20    RETURN
+      END
+      SUBROUTINE CtLhNSEVL (RHS, IKNL,NX,NT,JT,DT,TIN,NEFF,U0,UN)
+      IMPLICIT DOUBLE PRECISION (A-H, O-Z)
+      PARAMETER (MXX = 105, MXQ = 25, MXF = 6)
+      PARAMETER (MXPN = MXF * 2 + 2)
+      PARAMETER (MXQX= MXQ * MXX,   MXPQX = MXQX * MXPN)
+      PARAMETER (M1=-3, M2=3, NDG=3, NDH=NDG+1, L1=M1-1, L2=M2+NDG-2)
+      COMMON / LhCtVARIBX / XA(MXX, L1:L2), ELY(MXX), DXTZ(MXX)
+      DIMENSION  U0(NX), UN(0:NX, 0:NT)
+      DIMENSION  Y0(MXX), Y1(MXX), YP(MXX), F0(MXX), F1(MXX), FP(MXX)
+      external rhs
+      DDT = DT / JT
+      IF (NX .GT. MXX) THEN
+      WRITE (*,*) 'Nx =', NX, ' greater than Max pts in CtLhNSEVL.'
+      STOP 'Program stopped in CtLhNSEVL'
+      EndIf
+      TMD = TIN + DT * NT / 2.
+      AMU = EXP(TMD)
+      TEM = 6./ (33.- 2.* NEFF) / CtLhALPI(AMU)
+      TLAM = TMD - TEM
+      DO 9 IX = 1, NX
+      UN(IX, 0)  = U0(IX)
+    9 CONTINUE
+      UN(0, 0) = 3D0*U0(1) - 3D0*U0(2) - U0(1)
+      TT = TIN
+      DO 10 IZ = 1, NX
+      Y0(IZ)   = U0(IZ)
+   10 CONTINUE
+      DO 20 IS = 1, NT
+         DO 202 JS = 1, JT
+            IRND = (IS-1) * JT + JS
+            IF (IRND .EQ. 1) THEN
+                CALL RHS (TT, Neff, Y0, F0)
+                DO 250 IZ = 1, NX
+                   Y0(IZ) = Y0(IZ) + DDT * F0(IZ)
+  250           CONTINUE
+                TT = TT + DDT
+                CALL RHS (TT, NEFF, Y0, F1)
+                DO 251 IZ = 1, NX
+                   Y1(IZ) = U0(IZ) + DDT * (F0(IZ) + F1(IZ)) / 2D0
+  251           CONTINUE
+            Else
+                CALL RHS (TT, NEFF, Y1, F1)
+                DO 252 IZ = 1, NX
+                   YP(IZ) = Y1(IZ) + DDT * (3D0 * F1(IZ) - F0(IZ)) / 2D0
+  252           CONTINUE
+                TT = TT + DDT
+                CALL RHS (TT, NEFF, YP, FP)
+                DO 253 IZ = 1, NX
+                   Y1(IZ) = Y1(IZ) + DDT * (FP(IZ) + F1(IZ)) / 2D0
+                   F0(IZ) = F1(IZ)
+  253           CONTINUE
+            EndIf
+  202    CONTINUE
+         DO 260 IZ = 1, NX
+            UN (IZ, IS) = Y1(IZ)
+  260    CONTINUE
+         UN(0, IS) = 3D0*Y1(1) - 3D0*Y1(2) + Y1(3)
+   20 CONTINUE
+      RETURN
+      END
+      SUBROUTINE LhCtNSRHSM (TT, NEFF, FI, FO)
+      IMPLICIT DOUBLE PRECISION (A-H, O-Z)
+      LOGICAL LSTX
+      PARAMETER (MXX = 105, MXQ = 25, MXF = 6)
+      PARAMETER (M1=-3, M2=3, NDG=3, NDH=NDG+1, L1=M1-1, L2=M2+NDG-2)
+      COMMON / LhCtVARIBX / XA(MXX, L1:L2), ELY(MXX), DXTZ(MXX)
+      COMMON / LhCtXXARAY / XCR, XMIN, XV(0:MXX), LSTX, NX
+      COMMON / LhCtXYARAY / ZZ(MXX, MXX), ZV(0:MXX)
+      COMMON / LhCtKRNL01 / AFF2(MXX),AFG2(MXX),AGF2(MXX),AGG2(MXX),
+     >                  ANSP (MXX), ANSM (MXX), ZFG2, ZGF2, ZQQB
+      COMMON / LhCtKRN2ND / FFG(MXX, MXX), GGF(MXX, MXX), PNS(MXX, MXX)
+      COMMON / LhCtEVLPAC / AL, IKNL, IPD0, IHDN, NfMx
+      DIMENSION G1(MXX), FI(NX), FO(NX)
+      DIMENSION W0(MXX), W1(MXX), WH(MXX)
+      S = EXP(TT)
+      Q = AL * EXP (S)
+      CPL = CtLhALPI(Q)
+      CPL2= CPL ** 2 / 2. * S
+      CPL = CPL * S
+      CALL CtLhINTEGR (NX, 0, FI, W0, IR1)
+      CALL CtLhINTEGR (NX, 1, FI, W1, IR2)
+      CALL CtLhHINTEG (NX,    FI, WH)
+      DO 230 IZ = 1, NX
+      FO(IZ) = 2.* FI(IZ) + 4./3.* ( 2.* WH(IZ) - W0(IZ) - W1(IZ))
+      FO(IZ) = CPL * FO(IZ)
+  230 CONTINUE
+      IF (IKNL .EQ. 2) THEN
+      DZ = 1./ (NX - 1)
+      DO 21 IX = 1, NX-1
+        X = XV(IX)
+        NP = NX - IX + 1
+        IS = NP
+        DO 31 KZ = 2, NP
+          IY = IX + KZ - 1
+          IT = NX - IY + 1
+          XY = ZZ (IS, IT)
+          G1(KZ) = PNS (IS,IT) * (FI(IY) - XY * FI(IX))
+   31   CONTINUE
+        TEM1 = CtLhSMPNOL (NP, DZ, G1, ERR)
+        TMP2 = (TEM1 - FI(IX) * ANSM(IX)) * CPL2
+        FO(IX) = FO(IX) + TMP2
+   21 CONTINUE
+      EndIf
+      RETURN
+      END
+      SUBROUTINE LhCtNSRHSP (TT, NEFF, FI, FO)
+      IMPLICIT DOUBLE PRECISION (A-H, O-Z)
+      LOGICAL LSTX
+      PARAMETER (MXX = 105, MXQ = 25, MXF = 6)
+      PARAMETER (M1=-3, M2=3, NDG=3, NDH=NDG+1, L1=M1-1, L2=M2+NDG-2)
+      COMMON / LhCtVARIBX / XA(MXX, L1:L2), ELY(MXX), DXTZ(MXX)
+      COMMON / LhCtXXARAY / XCR, XMIN, XV(0:MXX), LSTX, NX
+      COMMON / LhCtXYARAY / ZZ(MXX, MXX), ZV(0:MXX)
+      COMMON / LhCtKRNL01 / AFF2(MXX),AFG2(MXX),AGF2(MXX),AGG2(MXX),
+     >                  ANSP (MXX), ANSM (MXX), ZFG2, ZGF2, ZQQB
+      COMMON / LhCtKRN2ND / FFG(MXX, MXX), GGF(MXX, MXX), PNS(MXX, MXX)
+      COMMON / LhCtEVLPAC / AL, IKNL, IPD0, IHDN, NfMx
+      DIMENSION G1(MXX), FI(NX), FO(NX)
+      DIMENSION W0(MXX), W1(MXX), WH(MXX)
+      S = EXP(TT)
+      Q = AL * EXP (S)
+      CPL = CtLhALPI(Q)
+      CPL2= CPL ** 2 / 2. * S
+      CPL = CPL * S
+      CALL CtLhINTEGR (NX, 0, FI, W0, IR1)
+      CALL CtLhINTEGR (NX, 1, FI, W1, IR2)
+      CALL CtLhHINTEG (NX,    FI, WH)
+      DO 230 IZ = 1, NX
+      FO(IZ) = 2.* FI(IZ) + 4./3.* ( 2.* WH(IZ) - W0(IZ) - W1(IZ))
+      FO(IZ) = CPL * FO(IZ)
+  230 CONTINUE
+      IF (IKNL .EQ. 2) THEN
+      DZ = 1./ (NX - 1)
+      DO 21 IX = 1, NX-1
+        X = XV(IX)
+        NP = NX - IX + 1
+        DO 31 KZ = 2, NP
+          IY = IX + KZ - 1
+          XY = ZZ (NX-IX+1, NX-IY+1)
+          G1(KZ) = PNS (IX,IY) * (FI(IY) - XY * FI(IX))
+   31   CONTINUE
+        TEM1 = CtLhSMPNOL (NP, DZ, G1, ERR)
+        TMP2 = (TEM1 + FI(IX) * (-ANSP(IX) + ZQQB)) * CPL2
+        FO(IX) = FO(IX) + TMP2
+   21 CONTINUE
+      EndIf
+      RETURN
+      END
+      FUNCTION CtLhPARDIS (IPRTN, XX, QQ)
+      IMPLICIT DOUBLE PRECISION (A-H, O-Z)
+      include 'parmsetup.inc'
+      Character Msg*80
+      LOGICAL LSTX
+      PARAMETER (MXX = 105, MXQ = 25, MXF = 6)
+      PARAMETER (MXPN = MXF * 2 + 2)
+      PARAMETER (MXQX= MXQ * MXX,   MXPQX = MXQX * MXPN)
+      PARAMETER (M1=-3, M2=3, NDG=3, NDH=NDG+1, L1=M1-1, L2=M2+NDG-2)
+      PARAMETER (Smll = 1D-9)
+       parameter(nqvec = 4)
+      COMMON / LhCtXXARAY / XCR, XMIN, XV(0:MXX), LSTX, NX
+      COMMON / LhCtXYARAY / ZZ(MXX, MXX), ZV(0:MXX)
+      COMMON / LhCtVARIBX / XA(MXX, L1:L2), ELY(MXX), DXTZ(MXX)
+      COMMON / LhCtQARAY1 / QINI,QMAX, QV(0:MXQ),TV(0:MXQ), NT,JT,NG
+      COMMON / LhCtQARAY2 / TLN(MXF), DTN(MXF), NTL(MXF), NTN(MXF)
+      COMMON / LhCtEVLPAC / AL, IKNL, IPD0, IHDN, NfMx
+      COMMON / LhCtPEVLDT / UPD(MXPQX,nmxset), KF, Nelmt
+      COMMON / LhCtCOMQMS / VALQMS(9)
+      dimension fvec(4), fij(4)
+      dimension xvpow(0:mxx)
+      Data Iwrn1, Iwrn2, Iwrn3, OneP / 3*0, 1.00001 /
+      data xpow / 0.3d0 /      !**** choice of interpolation variable
+      data nxsave / 0 /
+       save xvpow, nxsave
+       save xlast, qlast
+       save jq, jx, JLx, JLq, ss, sy2, sy3, s23, ty2, ty3
+       save const1 , const2, const3, const4, const5, const6
+       save tt, t13, t12, t23, t34 , t24, tmp1, tmp2, tdet
+c
+      call getnset(iset)
+c
+      if(nx .ne. nxsave) then
+         xvpow(0) = 0D0
+         do i = 1, nx
+            xvpow(i) = xv(i)**xpow
+         enddo
+       nxsave = nx
+      endif
+
+      X = XX
+      Q = QQ
+
+c enforce threshold early to improve speed...
+       ii = iabs(IPRTN)
+       if(ii .ne. 0) then
+          if(QQ .lt. VALQMS(ii) ) then
+             ctlhpardis = 0.d0
+             return
+          endif
+       endif
+
+c force pardis = 0.0d0 at exactly =1.0d0 - added mrw 10/May/06
+        if(xx .eq. 1.0d0) then
+         ctlhpardis = 0.0d0
+         return
+       endif
+       
+c skip the initialization in x if same as in the previous call.
+       if(x .eq. xlast) goto 100
+       xlast = x
+
+      JLx = -1
+      JU = Nx+1
+ 11   If (JU-JLx .GT. 1) Then
+         JM = (JU+JLx) / 2
+         If (X .Ge. XV(JM)) Then
+            JLx = JM
+         Else
+            JU = JM
+         Endif
+         Goto 11
+      Endif
+      If     (JLx .LE. -1) Then
+        Print '(A,1pE12.4)','Severe error: x <= 0 in ParDis x=', x 
+        Stop 
+      ElseIf (JLx .Eq. 0) Then
+         Jx = 0
+         Msg = '0 < X < Xmin in ParDis; extrapolation used!'
+         CALL CtLhWARNR (IWRN1, Msg, 'X', X, Xmin, 1D0, 1)
+      Elseif (JLx .LE. Nx-2) Then
+         Jx = JLx - 1
+      Elseif (JLx.Eq.Nx-1 .or. x.LT.OneP) Then
+         Jx = JLx - 2
+      Else
+        Print '(A,1pE12.4)','Severe error: x > 1 in ParDis x=', x 
+        Stop 
+      Endif
+      ss = x**xpow
+      If (JLx.Ge.2 .and. JLx.Le.Nx-2) Then
+      svec1 = xvpow(jx)
+      svec2 = xvpow(jx+1)
+      svec3 = xvpow(jx+2)
+      svec4 = xvpow(jx+3)
+      s12 = svec1 - svec2
+      s13 = svec1 - svec3
+      s23 = svec2 - svec3
+      s24 = svec2 - svec4
+      s34 = svec3 - svec4
+      sy2 = ss - svec2 
+      sy3 = ss - svec3 
+      const1 = s13/s23
+      const2 = s12/s23
+      const3 = s34/s23
+      const4 = s24/s23
+      s1213 = s12 + s13
+      s2434 = s24 + s34
+      sdet = s12*s34 - s1213*s2434
+      tmp = sy2*sy3/sdet
+      const5 = (s34*sy2-s2434*sy3)*tmp/s12 
+      const6 = (s1213*sy2-s12*sy3)*tmp/s34
+      EndIf
+
+100    continue
+
+c skip the initialization in q if same as in the previous call.
+        if(q .eq. qlast) goto 110
+       qlast = q
+
+      tt = log(log(Q/Al))
+
+      JLq = -1
+      JU = NT+1
+ 12   If (JU-JLq .GT. 1) Then
+         JM = (JU+JLq) / 2
+         If (Q .GE. QV(JM)) Then
+            JLq = JM
+         Else
+            JU = JM
+         Endif
+         Goto 12
+       Endif
+      If     (JLq .LE. 0) Then
+         Jq = 0
+         If (JLq .LT. 0) Then
+          Msg = 'Q < Q0 in ParDis; extrapolation used!'
+          CALL CtLhWARNR (IWRN2, Msg, 'Q', Q, Qini, 1D0, 1)
+         EndIf
+      Elseif (JLq .LE. Nt-2) Then
+         Jq = JLq - 1
+      Else
+        Jq = Nt - 3
+        If (JLq .GE. Nt) Then
+         Msg = 'Q > Qmax in ParDis; extrapolation used!'
+         CALL CtLhWARNR (IWRN3, Msg, 'Q', Q, Qmax, 1D0, 1)
+        Endif
+      Endif
+
+      If (JLq.GE.1 .and. JLq.LE.Nt-2) Then
+      tvec1 = Tv(jq)
+      tvec2 = Tv(jq+1)
+      tvec3 = Tv(jq+2)
+      tvec4 = Tv(jq+3)
+      t12 = tvec1 - tvec2
+      t13 = tvec1 - tvec3
+      t23 = tvec2 - tvec3
+      t24 = tvec2 - tvec4
+      t34 = tvec3 - tvec4
+      ty2 = tt - tvec2
+      ty3 = tt - tvec3
+      tmp1 = t12 + t13
+      tmp2 = t24 + t34
+      tdet = t12*t34 - tmp1*tmp2
+      EndIf
+
+110    continue
+
+      jtmp = ((IPRTN + NfMx)*(NT+1)+(jq-1))*(NX+1)+jx+1
+      Do it = 1, nqvec
+         J1  = jtmp + it*(NX+1) 
+       If (Jx .Eq. 0) Then
+         fij(1) = 0
+         fij(2) = Upd(J1+1,iset) * Xa(1,2)
+         fij(3) = Upd(J1+2,iset) * Xa(2,2)
+         fij(4) = Upd(J1+3,iset) * Xa(3,2)
+         Call CtLhPolint4 (XVpow(0), Fij(1), 4, ss, Fx, Dfx) 
+         
+         If (x .GT. 0D0)  Fvec(it) =  Fx / x**2 
+       ElseIf  (JLx .Eq. Nx-1) Then
+        Call CtLhPolint4 (XVpow(Nx-3), Upd(J1,iset), 4, ss, Fx, Dfx)
+        Fvec(it) = Fx
+       Else 
+         sf2 = Upd(J1+1,iset)
+         sf3 = Upd(J1+2,iset)
+         Fvec(it) = (const5*(Upd(J1,iset) 
+     &                      - sf2*const1 + sf3*const2) 
+     &               + const6*(Upd(J1+3,iset) 
+     &                      + sf2*const3 - sf3*const4) 
+     &               + sf2*sy3 - sf3*sy2) / s23
+       Endif
+      enddo
+      If (JLq .LE. 0) Then
+        Call CtLhPolint4 (TV(0), Fvec(1), 4, tt, ff, Dfq)
+      ElseIf (JLq .GE. Nt-1) Then
+        Call CtLhPolint4 (TV(Nt-3), Fvec(1), 4, tt, ff, Dfq)
+      Else
+        tf2 = fvec(2)
+        tf3 = fvec(3)
+        g1 = ( tf2*t13 - tf3*t12) / t23
+        g4 = (-tf2*t34 + tf3*t24) / t23
+        h00 = ((t34*ty2-tmp2*ty3)*(fvec(1)-g1)/t12 
+     &   +  (tmp1*ty2-t12*ty3)*(fvec(4)-g4)/t34)
+        ff = (h00*ty2*ty3/tdet + tf2*ty3 - tf3*ty2) / t23
+      EndIf
+      CtLhPARDIS = ff
+      Return
+      End
+
+      SUBROUTINE CtLhPARPDF (IACT, NAME, VALUE, IRET)
+      IMPLICIT DOUBLE PRECISION (A-H, O-Z)
+      CHARACTER NAME*(*), Uname*10
+      LOGICAL START1
+      DATA ILEVEL, LRET / 1, 1 /
+      JRET = IRET
+      CALL CtLhUPC (NAME, Ln, Uname)
+      IF (IACT .EQ. 0 .OR. IACT .EQ. 4) then
+c     >    IVALUE = NINT (VALUE)   !tentatively remove this since it seems not to be used
+       print *,'Fatal error: iact=',iact
+       stop
+      ENDIF
+      START1 = (IACT .NE. 1) .AND. (IACT .NE. 2)
+c prepare to remove this stuff, since I think IACT=1 or 2 always
+      if(start1) then
+        print *,'Fatal error: start1=',start1
+        stop
+      endif
+      IF (START1)  ILEVEL = 1
+      GOTO (1, 2), ILEVEL
+    1 START1 = .TRUE.
+      ILEVEL = 0
+      CALL CtLhParQcd (IACT, Uname(1:Ln), VALUE, JRET)
+              IF (JRET .EQ. 1)  GOTO 11
+              IF (JRET .EQ. 2)  GOTO 12
+              IF (JRET .EQ. 3)  GOTO 13
+              IF (JRET .GT. 4)  GOTO 15
+              ILEVEL =  ILEVEL + 1
+    2 CALL CtLhEVLPAR (IACT, Uname(1:Ln), VALUE, JRET)
+              IF (JRET .EQ. 1)  GOTO 11
+              IF (JRET .EQ. 2)  GOTO 12
+              IF (JRET .EQ. 3)  GOTO 13
+              IF (JRET .GT. 4)  GOTO 15
+              ILEVEL =  ILEVEL + 1
+      IF (.NOT. START1) GOTO 1
+      IF (JRET .EQ. 0)  GOTO 10
+    9 CONTINUE
+      GOTO 14
+   10 CONTINUE
+   11 CONTINUE
+   12 CONTINUE
+   13 CONTINUE
+   14 CONTINUE
+   15 CONTINUE
+      IF (JRET .NE. 4) LRET = JRET
+      IF (LRET.EQ.0 .OR. LRET.EQ.2 .OR. LRET.EQ.3) THEN
+        PRINT *, 'Error in CtLhPARPDF: IRET, IACT, NAME, VALUE =',
+     >  LRET, IACT, NAME, VALUE
+       PRINT *, 'fatal error in CtLhparpdf'
+       stop
+      EndIf
+      IRET= JRET
+      RETURN
+  100 FORMAT (/)
+      END
+      SUBROUTINE CtLhParQcd(IACT,NAME,VALUE,IRET)
+      IMPLICIT DOUBLE PRECISION (A-H, O-Z)
+      INTEGER IACT,IRET
+      CHARACTER*(*) NAME
+      IRET=1
+      IF (IACT.EQ.0) THEN
+         WRITE (NINT(VALUE), *)  'LAM(BDA), NFL, ORD(ER), Mi, ',
+     >               '(i in 1 to 9), LAMi (i in 1 to NFL)'
+         IRET=4
+      ELSEIF (IACT.EQ.1) THEN
+         CALL CtLhQCDSET (NAME,VALUE,IRET)
+      ELSEIF (IACT.EQ.2) THEN
+         CALL CtLhQCDGET (NAME,VALUE,IRET)
+      ELSE
+         IRET=3
+      ENDIF
+      RETURN
+      END
+      FUNCTION CtLhPFF1 (XX)
+      IMPLICIT DOUBLE PRECISION (A-H, O-Z)
+      LOGICAL LA, LB, LSTX
+      PARAMETER (D0=0D0, D1=1D0, D2=2D0, D3=3D0, D4=4D0, D10=1D1)
+      PARAMETER (MXX = 105, MXQ = 25, MXF = 6)
+      PARAMETER (M1=-3, M2=3, NDG=3, NDH=NDG+1, L1=M1-1, L2=M2+NDG-2)
+      PARAMETER (MX = 3)
+      COMMON / LhCtXXARAY / XCR, XMIN, XV(0:MXX), LSTX, NX
+      COMMON / LhCtKRNL00 / DZ, XL(MX), NNX
+      COMMON / LhCtVARIBX / XA(MXX, L1:L2), ELY(MXX), DXTZ(MXX)
+      COMMON / LhCtKRN1ST / FF1(0:MXX),FG1(0:MXX),GF1(0:MXX),GG1(0:MXX),
+     >                  FF2(0:MXX), FG2(0:MXX), GF2(0:MXX), GG2(0:MXX),
+     >                  PNSP(0:MXX), PNSM(0:MXX)
+      SAVE
+      DATA LA, LB / 2 * .FALSE. /
+      LB = .TRUE.
+      ENTRY CtLhTFF1(ZZ)
+      LA = .TRUE.
+    2 IF (LA .AND. .NOT.LB) THEN
+        Z = ZZ
+        X = CtLhXFRMZ (Z)
+      Else
+        X = XX
+      EndIf
+      IF (X .GE. D1) THEN
+        CtLhPFF1 = 0
+        RETURN
+      ElseIF (X .GE. XMIN) THEN
+        Z = CtLhZFRMX (X)
+        TEM = CtLhFINTRP (FF1,  -DZ, DZ, NX,  Z,  ERR, IRT)
+      Else
+        CALL CtLhPOLIN1 (XL, FF1(1), MX, X, TEM, ERR)
+      EndIf
+      IF (LA) THEN
+         IF (LB) THEN
+            CtLhPFF1 = TEM / (1.-X)
+            LB   =.FALSE.
+         Else
+            CtLhTFF1 = TEM / (1.-X) * CtLhDXDZ(Z)
+         EndIf
+         LA   =.FALSE.
+      Else
+         IF (LB) THEN
+            QFF1 = TEM
+            LB   =.FALSE.
+         Else
+            RFF1 = TEM * X / (1.-X)
+         EndIf
+      EndIf
+      RETURN
+      ENTRY CtLhFNSP (XX)
+      X = XX
+      IF (X .GE. D1) THEN
+        CtLhFNSP = 0.
+        RETURN
+      ElseIF (X .GE. XMIN) THEN
+        Z = CtLhZFRMX (X)
+        TEM = CtLhFINTRP (PNSP,  -DZ, DZ, NX,  Z,  ERR, IRT)
+      Else
+        CALL CtLhPOLIN1 (XL, PNSP(1), MX, X, TEM, ERR)
+      EndIf
+      CtLhFNSP = TEM / (1.- X)
+      RETURN
+      ENTRY CtLhFNSM (XX)
+      X = XX
+      IF (X .GE. D1) THEN
+        CtLhFNSM = 0.
+        RETURN
+      ElseIF (X .GE. XMIN) THEN
+        Z = CtLhZFRMX (X)
+        TEM = CtLhFINTRP (PNSM,  -DZ, DZ, NX,  Z,  ERR, IRT)
+      Else
+        CALL CtLhPOLIN1 (XL, PNSM(1), MX, X, TEM, ERR)
+      EndIf
+      CtLhFNSM = TEM / (1.- X)
+      RETURN
+      ENTRY CtLhRGG1 (XX)
+      X = XX
+      IF (X .GE. D1) THEN
+        PGG1= 0
+        RETURN
+      ElseIF (X .GE. XMIN) THEN
+        Z = CtLhZFRMX (X)
+        TEM = CtLhFINTRP (GG1,  -DZ, DZ, NX,  Z,  ERR, IRT)
+      Else
+        CALL CtLhPOLIN1 (XL, GG1(1), MX, X, TEM, ERR)
+      EndIf
+      IF (LA) THEN
+         PGG1 = TEM / X / (1.-X)
+         LA   =.FALSE.
+      Else
+         IF (LB) THEN
+            QGG1 = TEM / X
+            LB   =.FALSE.
+         Else
+            CtLhRGG1 = TEM / (1.-X)
+         EndIf
+      EndIf
+      RETURN
+      ENTRY CtLhRFF2 (XX)
+      X = XX
+      IF (X .GE. D1) THEN
+        PFF2 = 0
+        RETURN
+      ElseIF (X .GE. XMIN) THEN
+        Z = CtLhZFRMX (X)
+        TEM = CtLhFINTRP (FF2,  -DZ, DZ, NX,  Z,  ERR, IRT)
+      Else
+        CALL CtLhPOLIN1 (XL, FF2(1), MX, X, TEM, ERR)
+      EndIf
+      IF (LA) THEN
+         PFF2 = TEM / X / (1.-X)
+         LA   =.FALSE.
+      Else
+         IF (LB) THEN
+            QFF2 = TEM / X
+            LB   =.FALSE.
+         Else
+            CtLhRFF2 = TEM / (1.-X)
+         EndIf
+      EndIf
+      RETURN
+      ENTRY CtLhRGG2 (XX)
+      X = XX
+      IF (X .GE. D1) THEN
+        PGG2 = 0
+        RETURN
+      ElseIF (X .GE. XMIN) THEN
+        Z = CtLhZFRMX (X)
+        TEM = CtLhFINTRP (GG2,  -DZ, DZ, NX,  Z,  ERR, IRT)
+      Else
+        CALL CtLhPOLIN1 (XL, GG2(1), MX, X, TEM, ERR)
+      EndIf
+      IF (LA) THEN
+         PGG2 = TEM / X / (1.-X)
+         LA   =.FALSE.
+      Else
+         IF (LB) THEN
+            QGG2 = TEM / X
+            LB   =.FALSE.
+         Else
+            CtLhRGG2 = TEM / (1.-X)
+         EndIf
+      EndIf
+      RETURN
+      END
+      SUBROUTINE CtLhPOLIN1 (XA,YA,N,X,Y,DY)
+      IMPLICIT DOUBLE PRECISION (A-H, O-Z)
+      PARAMETER (NMAX=10)
+      DIMENSION XA(N),YA(N),C(NMAX),D(NMAX)
+      NS=1
+      DIF=ABS(X-XA(1))
+      DO 11 I=1,N
+        DIFT=ABS(X-XA(I))
+        IF (DIFT.LT.DIF) THEN
+          NS=I
+          DIF=DIFT
+        ENDIF
+        C(I)=YA(I)
+        D(I)=YA(I)
+11    CONTINUE
+      Y=YA(NS)
+      NS=NS-1
+      DO 13 M=1,N-1
+        DO 12 I=1,N-M
+          HO=XA(I)-X
+          HP=XA(I+M)-X
+          W=C(I+1)-D(I)
+          DEN=HO-HP
+          DEN=W/DEN
+          D(I)=HP*DEN
+          C(I)=HO*DEN
+12      CONTINUE
+        IF (2*NS.LT.N-M)THEN
+          DY=C(NS+1)
+        ELSE
+          DY=D(NS)
+          NS=NS-1
+        ENDIF
+        Y=Y+DY
+13    CONTINUE
+      RETURN
+      END
+      SUBROUTINE CtLhQARRAY (NINI)
+      IMPLICIT DOUBLE PRECISION (A-H, O-Z)
+      PARAMETER (MXX = 105, MXQ = 25, MXF = 6)
+      PARAMETER (MXPN = MXF * 2 + 2)
+      PARAMETER (MXQX= MXQ * MXX,   MXPQX = MXQX * MXPN)
+      COMMON / LhCtQARAY1 / QINI,QMAX, QV(0:MXQ),TV(0:MXQ), NT,JT,NG
+      COMMON / LhCtQARAY2 / TLN(MXF), DTN(MXF), NTL(MXF), NTN(MXF)
+      COMMON / LhCtEVLPAC / AL, IKNL, IPD0, IHDN, NfMx
+      NCNT = 0
+      IF (NT .GE. mxq) NT = mxq - 1
+      S = LOG(QINI/AL)
+      TINI = LOG(S)
+      S = LOG(QMAX/AL)
+      TMAX = LOG(S)
+    1 DT0 = (TMAX - TINI) / float(NT)
+      NINI = LhCtNFL(QINI)
+      NFMX = LhCtNFL(QMAX)
+      Call CtLhParQcd (2, 'ORDER', Ord, Ir)
+      Call CtLhParQcd (2, 'ALAM', Al0, Ir)
+      Call CtLhParQcd (2, 'NFL', Afl0, Ir)
+      AFL = NfMx
+      Call CtLhParQcd (1, 'NFL', AFL, Ir)
+      Iordr = Nint (Ord)
+      Ifl0  = Nint (Afl0)
+      Call CtLhSetLam (Ifl0, Al0, Iordr)
+      NG = NFMX - NINI + 1
+      QIN  = QINI
+      QOUT = QINI
+      S = LOG(QIN/AL)
+      TIN  = LOG(S)
+      TLN(1) = TIN
+      NTL(1)  = 0
+      QV(0) = QINI
+      TV(0) = Tin
+      DO 20 NEFF = NINI, NFMX
+        ICNT = NEFF - NINI + 1
+        IF (NEFF .LT. NFMX) THEN
+          THRN = CtLhAMHATF (NEFF + 1)
+          QOUN = MIN (QMAX, THRN)
+        Else
+          QOUN = QMAX
+        EndIf
+        IF (QOUN-QOUT .LE. 0.0001) THEN
+          DT   = 0
+          NITR = 0
+        Else
+          QOUT = QOUN
+          S = LOG(QOUT/AL)
+          TOUT = LOG(S)
+          TEM = TOUT - TIN
+          NITR = INT (TEM / DT0) + 1
+          DT  = TEM / NITR
+        EndIf
+        DTN (ICNT) = DT
+        NTN (ICNT) = NITR
+        TLN (ICNT) = TIN
+        NTL (ICNT+1) = NTL(ICNT) + NITR
+        IF (NITR .NE. 0) THEN
+        DO 205 I = 1, NITR
+           TV (NTL(ICNT)+I) = TIN + DT * I
+           S = EXP (TV(NTL(ICNT)+I))
+           QV (NTL(ICNT)+I) = AL * EXP (S)
+  205   CONTINUE
+        EndIf
+        QIN = QOUT
+        TIN = TOUT
+   20 CONTINUE
+      NCNT = NCNT + 1
+      NTP = NTL (NG + 1)
+      ND  = NTP - NT
+      IF (NTP .GE. MXQ) THEN
+         NT = MXQ - ND - NCNT
+         GOTO 1
+      EndIf
+      NT = NTP
+      RETURN
+      END
+      SUBROUTINE CtLhQCDGET(NAME,VALUE,IRET)
+      IMPLICIT DOUBLE PRECISION (A-H, O-Z)
+      CHARACTER*(*) NAME
+      COMMON / LhCtCWZPRM / ALAM(0:9), AMHAT(0:9), AMN, NHQ
+      COMMON / LhCtQCDPAR_LHA / AL, NF, NORDER, SET
+      COMMON / LhCtCOMQMS / VALQMS(9)
+      LOGICAL SET
+      PARAMETER (PI=3.141592653589793d0, EULER=0.57721566)
+      ICODE = LhCtNAMQCD(NAME)
+      IRET = 1
+      IF (ICODE .EQ. 1) THEN
+         VALUE = AL
+      ELSEIF (ICODE .EQ. 2) THEN
+         VALUE = NF
+      ELSEIF ((ICODE .GE. 3) .AND. (ICODE .LE. 12))  THEN
+         VALUE = VALQMS(ICODE - 2)
+      ELSEIF ((ICODE .GE. 13) .AND. (ICODE .LE. 13+NF))  THEN
+         VALUE = ALAM(ICODE - 13)
+      ELSEIF (ICODE .EQ. 24) THEN
+         VALUE = NORDER
+      ELSE
+         IRET=0
+      ENDIF
+      END
+      SUBROUTINE CtLhQCDSET (NAME,VALUE,IRET)
+      IMPLICIT DOUBLE PRECISION (A-H, O-Z)
+      CHARACTER*(*) NAME
+      COMMON / LhCtCOMQMS / VALQMS(9)
+      COMMON / LhCtQCDPAR_LHA / AL, NF, NORDER, SET
+      LOGICAL SET
+      PARAMETER (PI=3.141592653589793d0, EULER=0.57721566)
+      IVALUE = NINT(VALUE)
+      ICODE  = LhCtNAMQCD(NAME)
+      IF (ICODE .EQ. 0) THEN
+         IRET=0
+c     print *,'warning empty CtLhQCDSET call: NAME=',
+c     &                 NAME,' VALUE=',VALUE
+      ELSE
+         IRET = 1
+         SET = .FALSE.
+         IF (ICODE .EQ. 1) THEN
+            IF (VALUE.LE.0) GOTO 12
+            AL=VALUE
+         ELSEIF (ICODE .EQ. 2) THEN
+            IF ( (IVALUE .LT. 0) .OR. (IVALUE .GT. 9)) GOTO 12
+            NF = IVALUE
+         ELSEIF ((ICODE .GE. 3) .AND. (ICODE .LE. 11))  THEN
+            IF (VALUE .LT. 0) GOTO 12
+            Scle = Min (Value , VALQMS(ICODE - 2))
+            AlfScle = CtLhALPI(Scle) * Pi
+            VALQMS(ICODE - 2) = VALUE
+            Call CtLhAlfSet (Scle, AlfScle)
+         ELSEIF ((ICODE .GE. 13) .AND. (ICODE .LE. 13+NF))  THEN
+            IF (VALUE .LE. 0) GOTO 12
+            CALL CtLhSETL1 (ICODE-13, VALUE)
+         ELSEIF (ICODE .EQ. 24)  THEN
+            IF ((IVALUE .LT. 1) .OR. (IVALUE .GT. 2)) GOTO 12
+            NORDER = IVALUE
+         ENDIF
+         IF (.NOT. SET) CALL CtLhLAMCWZ
+      ENDIF
+      RETURN
+ 12   IRET=2
+      RETURN
+      END
+      FUNCTION CtLhQZBRNT(FUNC, X1, X2, TOLIN, IRT)
+      IMPLICIT DOUBLE PRECISION (A-H, O-Z)
+      PARAMETER (ITMAX = 1000, EPS = 3.E-12)
+      external func
+      TOL = ABS(TOLIN)
+      A=X1
+      B=X2
+      FA=FUNC(A)
+      FB=FUNC(B)
+      IF(FB*FA.GT.0.)  THEN
+        WRITE (*, *) 'Root must be bracketed for CtLhQZBRNT.'
+        IRT = 1
+      ENDIF
+      FC=FB
+      DO 11 ITER=1,ITMAX
+        IF(FB*FC.GT.0.) THEN
+          C=A
+          FC=FA
+          D=B-A
+          E=D
+        ENDIF
+        IF(ABS(FC).LT.ABS(FB)) THEN
+          A=B
+          B=C
+          C=A
+          FA=FB
+          FB=FC
+          FC=FA
+        ENDIF
+        TOL1=2.*EPS*ABS(B)+0.5*TOL
+        XM=.5*(C-B)
+        IF(ABS(XM).LE.TOL1 .OR. FB.EQ.0.)THEN
+          CtLhQZBRNT=B
+          RETURN
+        ENDIF
+        IF(ABS(E).GE.TOL1 .AND. ABS(FA).GT.ABS(FB)) THEN
+          S=FB/FA
+          IF(A.EQ.C) THEN
+            P=2.*XM*S
+            Q=1.-S
+          ELSE
+            Q=FA/FC
+            R=FB/FC
+            P=S*(2.*XM*Q*(Q-R)-(B-A)*(R-1.))
+            Q=(Q-1.)*(R-1.)*(S-1.)
+          ENDIF
+          IF(P.GT.0.) Q=-Q
+          P=ABS(P)
+          IF(2.*P .LT. MIN(3.*XM*Q-ABS(TOL1*Q),ABS(E*Q))) THEN
+            E=D
+            D=P/Q
+          ELSE
+            D=XM
+            E=D
+          ENDIF
+        ELSE
+          D=XM
+          E=D
+        ENDIF
+        A=B
+        FA=FB
+        IF(ABS(D) .GT. TOL1) THEN
+          B=B+D
+        ELSE
+          B=B+SIGN(TOL1,XM)
+        ENDIF
+        FB=FUNC(B)
+11    CONTINUE
+      WRITE (*, *) 'CtLhQZBRNT exceeding maximum iterations.'
+      IRT = 2
+      CtLhQZBRNT=B
+      RETURN
+      END
+      SUBROUTINE CtLhRATINT(XA,YA,N,X,Y,DY)
+      IMPLICIT DOUBLE PRECISION (A-H, O-Z)
+      PARAMETER (NMAX=10,TINY=1.E-25)
+      DIMENSION XA(N),YA(N),C(NMAX),D(NMAX)
+      NS=1
+      HH=ABS(X-XA(1))
+      DO 11 I=1,N
+        H=ABS(X-XA(I))
+        IF (H.EQ.0.)THEN
+          Y=YA(I)
+          DY=0.0
+          RETURN
+        ELSE IF (H.LT.HH) THEN
+          NS=I
+          HH=H
+        ENDIF
+        C(I)=YA(I)
+        D(I)=YA(I)+TINY
+11    CONTINUE
+      Y=YA(NS)
+      NS=NS-1
+      DO 13 M=1,N-1
+        DO 12 I=1,N-M
+          W=C(I+1)-D(I)
+          H=XA(I+M)-X
+          T=(XA(I)-X)*D(I)/H
+          DD=T-C(I+1)
+          DD=W/DD
+          D(I)=C(I+1)*DD
+          C(I)=T*DD
+12      CONTINUE
+        IF (2*NS.LT.N-M)THEN
+          DY=C(NS+1)
+        ELSE
+          DY=D(NS)
+          NS=NS-1
+        ENDIF
+        Y=Y+DY
+13    CONTINUE
+      RETURN
+      END
+      FUNCTION CtLhRTALF (EFLLN)
+      IMPLICIT DOUBLE PRECISION (A-H, O-Z)
+      include 'parmsetup.inc'
+      PARAMETER (PI = 3.141592653589793d0)
+      COMMON / CtLhRTALFC / ALFST, JORD, NEFF
+      EFMULM = EXP (EFLLN)
+      TEM1 = PI / ALFST
+      TEM2 = 1. / CtLhALPQCD (JORD, NEFF, EFMULM, I)
+      CtLhRTALF = TEM1 - TEM2
+      END
+      Subroutine CtLhbldat1
+      IMPLICIT DOUBLE PRECISION (A-H, O-Z)
+      include 'parmsetup.inc'
+      LOGICAL LSTX
+      PARAMETER (MXX = 105, MXQ = 25, MxF = 6)
+      PARAMETER (MxPN = MxF * 2 + 2)
+      PARAMETER (MxQX= MXQ * MXX,   MxPQX = MxQX * MxPN)
+      COMMON / LhCtXXARAY / XCR, XMIN, XV(0:MXX), LSTX, NX
+      COMMON / LhCtQARAY1 / QINI,QMAX, QV(0:MXQ),TV(0:MXQ), NT,JT,NG
+      COMMON / LhCtEVLPAC / AL, IKNL, IPD0, IHDN, NfMx
+      COMMON / LhCtPEVLDT / UPD(MXPQX,nmxset), KF, Nelmt
+       PARAMETER (NF0 = 4, Nshp = 8,NEX = Nshp+2)
+      XMIN =  .999999D-4
+      XCR = 1.5 
+      JT = 1
+      Return
+      END
+      SUBROUTINE CtLhSETL1  (NEF, VLAM)
+      IMPLICIT DOUBLE PRECISION (A-H, O-Z)
+      LOGICAL SET
+      COMMON / LhCtCWZPRM / ALAM(0:9), AMHAT(0:9), AMN, NHQ
+      COMMON / LhCtQCDPAR_LHA / AL, NF, NORDER, SET
+      COMMON / LhCtCOMQMS / VALQMS(9)
+      IF (NEF .LT. 0 .OR. NEF .GT. NF) THEN
+        WRITE(*,*)'NEF out of range in CtLhSETL1: NEF NF =',NEF,NF
+        STOP
+      ENDIF
+      AMHAT(0) = 0.
+      DO 5 N = 1, NF
+         AMHAT(N) = VALQMS(N)
+    5    CONTINUE
+      ALAM(NEF) = VLAM
+      DO 10 N = NEF, 1, -1
+         CALL CtLhTRNLAM(NORDER, N, -1, IR1)
+   10    CONTINUE
+      DO 20 N = NEF, NF-1
+         CALL CtLhTRNLAM(NORDER, N, 1, IR1)
+   20    CONTINUE
+      DO 30, N = NF, 1, -1
+         IF ((ALAM(N) .GE. 0.7 * AMHAT(N))
+     >       .OR. (ALAM(N-1) .GE. 0.7 * AMHAT(N)))THEN
+            NHQ = NF - N
+            GOTO 40
+            ENDIF
+   30    CONTINUE
+      NHQ = NF
+   40 CONTINUE
+      DO 50, N = NF-NHQ, 1, -1
+         AMHAT(N) = 0
+         ALAM(N-1) = ALAM(N)
+   50    CONTINUE
+      AMN = ALAM(NF)
+      DO 60, N = 0, NF-1
+         IF (ALAM(N) .GT. AMN)  AMN = ALAM(N)
+   60    CONTINUE
+      AMN = AMN * 1.0001
+      AL = ALAM(NF)
+      SET = .TRUE.
+      RETURN
+      END
+      SUBROUTINE CtLhSETLAM (NEF, WLAM, IRDR)
+      IMPLICIT DOUBLE PRECISION (A-H, O-Z)
+      COMMON / LhCtQCDPAR_LHA / AL, NF, NORDER, SET
+      LOGICAL SET
+      IF ((NEF .LT. 0) .OR. (NEF .GT. NF)) THEN
+         WRITE(*,*)'NEF out of range in CtLhSETLAM: NEF NF=',NEF,NF
+         STOP
+      ENDIF
+      VLAM = WLAM
+      IF (IRDR .NE. NORDER) then
+       PRINT *,'fatal error: wanted cnvl1'
+       stop
+      ENDIF
+      CALL CtLhSETL1 (NEF, VLAM)
+      END
+      Subroutine CtLhbldat2
+      IMPLICIT DOUBLE PRECISION (A-H, O-Z)
+      COMMON / LhCtCOMQMS / VALQMS(9)
+      COMMON / LhCtQCDPAR_LHA / AL, NF, NORDER, SET
+      LOGICAL SET
+      AL = .226d0
+      NF = 5
+      NORDER = 2
+      SET = .FALSE.
+      VALQMS(1) =  0.
+      VALQMS(2) =  0.
+      VALQMS(3) =  0.2d0
+      VALQMS(4) =  1.3d0
+      VALQMS(5) =  4.5d0
+      VALQMS(6) =  174.d0
+      VALQMS(7) =  0.
+      VALQMS(8) =  0.
+      VALQMS(9) =  0.
+      Return
+      END
+      FUNCTION CtLhSMPNOL (NX, DX, FN, ERR)
+      IMPLICIT DOUBLE PRECISION (A-H, O-Z)
+      DIMENSION FN(NX)
+      MS = MOD(NX, 2)
+      IF (NX .LE. 1 .OR. NX .GT. 1000) THEN
+         PRINT *, 'NX =', NX, ' OUT OF RANGE IN CtLhSMPNOL!'
+         STOP
+      ELSEIF (NX .EQ. 2) THEN
+         TEM = DX * FN(2)
+      ELSEIF (NX .EQ. 3) THEN
+         TEM = DX * FN(2) * 2.
+      ELSE
+         IF (MS .EQ. 0) THEN
+            TEM = DX * (23.* FN(2) - 16.* FN(3) + 5.* FN(4)) / 12.
+            TMP = DX * (3.* FN(2) - FN(3)) / 2.
+            ERR = ABS(TEM - TMP)
+            TEM = TEM + CtLhSMPSNA (NX-1, DX, FN(2), ER1)
+            ERR = ABS(ER1) + ERR
+         ELSE
+            TEM = DX * (8.* FN(2) - 4.* FN(3) + 8.* FN(4)) / 3.
+            TMP = DX * (3.* FN(2) + 2.* FN(3) + 3.* FN(4)) / 2.
+            ERR = ABS(TEM - TMP)
+            TEM = TEM + CtLhSMPSNA (NX-4, DX, FN(5), ER1)
+            ERR = ABS(ER1) + ERR
+         ENDIF
+      ENDIF
+      CtLhSMPNOL = TEM
+      RETURN
+      END
+      FUNCTION CtLhSMPSNA (NX, DX, F, ERR)
+      IMPLICIT DOUBLE PRECISION (A-H, O-Z)
+      PARAMETER (D0=0D0, D1=1D0, D2=2D0, D3=3D0, D4=4D0, D10=1D1)
+      PARAMETER (MAXX = 1000)
+      DIMENSION F(NX)
+      DATA IW1, IW2, TINY / 2*0, 1.E-35 /
+      IF (DX .LE. 0.) THEN
+        CALL CtLhWARNR(IW2,'DX cannot be < 0. in CtLhSMPSNA', 'DX', 
+     >         DX, D0, D1, 0)
+        CtLhSMPSNA = 0.
+        RETURN
+      ENDIF
+      IF (NX .LE. 0 .OR. NX .GT. MAXX) THEN
+        CALL CtLhWARNI(IW1, 'NX out of range in CtLhSMPSNA', 'NX', NX,
+     >               1, MAXX, 1)
+        SIMP = 0.
+      ELSEIF (NX .EQ. 1) THEN
+        SIMP = 0.
+      ELSEIF (NX .EQ. 2) THEN
+        SIMP = (F(1) + F(2)) / 2.
+        ERRD = (F(1) - F(2)) / 2.
+      ELSE
+        MS = MOD(NX, 2)
+        IF (MS .EQ. 0) THEN
+          ADD = (9.*F(NX) + 19.*F(NX-1) - 5.*F(NX-2) + F(NX-3)) / 24.
+          NZ = NX - 1
+        ELSE
+          ADD = 0.
+          NZ = NX
+        ENDIF
+        IF (NZ .EQ. 3) THEN
+          SIMP = (F(1) + 4.* F(2) + F(3)) / 3.
+          TRPZ = (F(1) + 2.* F(2) + F(3)) / 2.
+        ELSE
+          SE = F(2)
+          SO = 0
+          NM1 = NZ - 1
+          DO 60 I = 4, NM1, 2
+            IM1 = I - 1
+            SE = SE + F(I)
+            SO = SO + F(IM1)
+   60     CONTINUE
+          SIMP = (F(1) + 4.* SE + 2.* SO + F(NZ)) / 3.
+          TRPZ = (F(1) + 2.* (SE + SO) + F(NZ)) / 2.
+        ENDIF
+        ERRD = TRPZ - SIMP 
+        SIMP = SIMP + ADD
+      ENDIF
+      CtLhSMPSNA = SIMP * DX
+      IF (ABS(SIMP) .GT. TINY) THEN
+        ERR = ERRD / SIMP
+      ELSE
+        ERR = 0.
+      ENDIF
+      RETURN
+      END
+      SUBROUTINE CtLhSNEVL(IKNL,NX,NT,JT,DT,TIN,NEFF,UI,GI,US,GS)
+      IMPLICIT DOUBLE PRECISION (A-H, O-Z)
+      PARAMETER (MXX = 105, MXQ = 25, MXF = 6)
+      PARAMETER (MXQX= MXQ * MXX)
+      PARAMETER (M1=-3, M2=3, NDG=3, NDH=NDG+1, L1=M1-1, L2=M2+NDG-2)
+      COMMON / LhCtVARIBX / XA(MXX, L1:L2), ELY(MXX), DXTZ(MXX)
+      DIMENSION UI(NX), US(0:NX, 0:NT)
+      DIMENSION GI(NX), GS(0:NX, 0:NT)
+      DIMENSION Y0(MXX), Y1(MXX), YP(MXX), F0(MXX), F1(MXX), FP(MXX)
+      DIMENSION Z0(MXX), Z1(MXX), ZP(MXX), G0(MXX), G1(MXX), GP(MXX)
+      DATA D0 / 0.0 /
+      JTT = 2 * JT
+      DDT = DT / JTT
+      IF (NX .GT. MXX) THEN
+      WRITE (*,*) 'Nx =', NX, ' too many pts in CtLhSNEVL'
+      STOP 'Program stopped in CtLhSNEVL'
+      EndIf
+      TMD = TIN + DT * NT / 2.
+      AMU = EXP(TMD)
+      TEM = 6./ (33.- 2.* NEFF) / CtLhALPI(AMU)
+      TLAM = TMD - TEM
+      DO 9 IX = 1, NX
+      US (IX, 0) = UI(IX)
+      GS (IX, 0) = GI(IX)
+    9 CONTINUE
+      US ( 0, 0) = (UI(1) - UI(2))* 3D0 + UI(3)
+      GS ( 0, 0) = (GI(1) - GI(2))* 3D0 + GI(3)
+      TT = TIN
+      DO 10 IZ = 1, NX
+      Y0(IZ) = UI(IZ)
+      Z0(IZ) = GI(IZ)
+   10 CONTINUE
+      DO 20 IS = 1, NT
+         DO 202 JS = 1, JTT
+            IRND = (IS-1) * JTT + JS
+            IF (IRND .EQ. 1) THEN
+                CALL CtLhSNRHS (TT, NEFF, Y0,Z0,  F0,G0)
+                DO 250 IZ = 1, NX
+                   Y0(IZ) = Y0(IZ) + DDT * F0(IZ)
+                   Z0(IZ) = Z0(IZ) + DDT * G0(IZ)
+  250           CONTINUE
+                TT = TT + DDT
+                CALL CtLhSNRHS (TT, NEFF, Y0, Z0,  F1, G1)
+                DO 251 IZ = 1, NX
+                   Y1(IZ) = UI(IZ) + DDT * (F0(IZ) + F1(IZ)) / 2D0
+                   Z1(IZ) = GI(IZ) + DDT * (G0(IZ) + G1(IZ)) / 2D0
+  251           CONTINUE
+            Else
+                CALL CtLhSNRHS (TT, NEFF, Y1, Z1,  F1, G1)
+                DO 252 IZ = 1, NX
+                   YP(IZ) = Y1(IZ) + DDT * (3D0 * F1(IZ) - F0(IZ)) / 2D0
+                   ZP(IZ) = Z1(IZ) + DDT * (3D0 * G1(IZ) - G0(IZ)) / 2D0
+  252           CONTINUE
+                TT = TT + DDT
+                CALL CtLhSNRHS (TT, NEFF, YP, ZP,  FP, GP)
+                DO 253 IZ = 1, NX
+                   Y1(IZ) = Y1(IZ) + DDT * (FP(IZ) + F1(IZ)) / 2D0
+                   Z1(IZ) = Z1(IZ) + DDT * (GP(IZ) + G1(IZ)) / 2D0
+                   F0(IZ) = F1(IZ)
+                   G0(IZ) = G1(IZ)
+  253           CONTINUE
+            EndIf
+  202    CONTINUE
+         DO 260 IX = 1, NX
+           IF (IKNL .GT. 0) THEN
+            US (IX, IS) = MAX(Y1(IX), D0)
+            GS (IX, IS) = MAX(Z1(IX), D0)
+           Else
+            US (IX, IS) = Y1(IX)
+            GS (IX, IS) = Z1(IX)
+           EndIf
+  260    CONTINUE
+         US(0, IS) = 3D0*Y1(1) - 3D0*Y1(2) + Y1(3)
+         GS(0, IS) = 3D0*Z1(1) - 3D0*Z1(2) + Z1(3)
+   20 CONTINUE
+      RETURN
+      END
+      SUBROUTINE CtLhSNRHS (TT, NEFF, FI, GI,  FO, GO)
+      IMPLICIT DOUBLE PRECISION (A-H, O-Z)
+      LOGICAL LSTX
+      PARAMETER (MXX = 105, MXQ = 25, MXF = 6)
+      PARAMETER (M1=-3, M2=3, NDG=3, NDH=NDG+1, L1=M1-1, L2=M2+NDG-2)
+      COMMON / LhCtVARIBX / XA(MXX, L1:L2), ELY(MXX), DXTZ(MXX)
+      COMMON / LhCtXXARAY / XCR, XMIN, XV(0:MXX), LSTX, NX
+      COMMON / LhCtXYARAY / ZZ(MXX, MXX), ZV(0:MXX)
+      COMMON / LhCtKRNL01 / AFF2(MXX),AFG2(MXX),AGF2(MXX),AGG2(MXX),
+     >                  ANSP (MXX), ANSM (MXX), ZFG2, ZGF2, ZQQB
+      COMMON / LhCtKRN2ND / FFG(MXX, MXX), GGF(MXX, MXX), PNS(MXX, MXX)
+      COMMON / LhCtEVLPAC / AL, IKNL, IPD0, IHDN, NfMx
+      DIMENSION GI(NX), GO(NX), G1(MXX), G2(MXX), G3(MXX), G4(MXX)
+      DIMENSION FI(NX), FO(NX), W0(MXX), W1(MXX), WH(MXX), WM(MXX)
+      DIMENSION R0(MXX), R1(MXX), R2(MXX), RH(MXX), RM(MXX)
+      S = EXP(TT)
+      Q = AL * EXP (S)
+      CPL = CtLhALPI(Q)
+      CPL2= CPL ** 2 / 2. * S
+      CPL = CPL * S
+      CALL CtLhINTEGR (NX,-1, FI, WM, IR1)
+      CALL CtLhINTEGR (NX, 0, FI, W0, IR2)
+      CALL CtLhINTEGR (NX, 1, FI, W1, IR3)
+      CALL CtLhINTEGR (NX,-1, GI, RM, IR4)
+      CALL CtLhINTEGR (NX, 0, GI, R0, IR5)
+      CALL CtLhINTEGR (NX, 1, GI, R1, IR6)
+      CALL CtLhINTEGR (NX, 2, GI, R2, IR7)
+      CALL CtLhHINTEG (NX,    FI, WH)
+      CALL CtLhHINTEG (NX,    GI, RH)
+      IF (IKNL .GT. 0) THEN
+      DO 230 IZ = 1, NX
+      FO(IZ) = ( 2D0 * FI(IZ)
+     >      + 4D0 / 3D0 * ( 2D0 * WH(IZ) - W0(IZ) - W1(IZ) ))
+     >      + NEFF * ( R0(IZ) - 2D0 * R1(IZ) + 2D0 * R2(IZ) )
+      FO(IZ) = FO(IZ) * CPL
+      GO(IZ) = 4D0 / 3D0 * ( 2D0 * WM(IZ) - 2D0 * W0(IZ)  + W1(IZ) )
+     >      + (33D0 - 2D0 * NEFF) / 6D0 * GI(IZ)
+     >      + 6D0 * (RH(IZ) + RM(IZ) - 2D0 * R0(IZ) + R1(IZ) - R2(IZ))
+      GO(IZ) = GO(IZ) * CPL
+  230 CONTINUE
+      Else
+      DO 240 IZ = 1, NX
+      FO(IZ) = NEFF * (-R0(IZ) + 2.* R1(IZ) )
+     > + 2.* FI(IZ) + 4./ 3.* ( 2.* WH(IZ) - W0(IZ) - W1(IZ) )
+      FO(IZ) = FO(IZ) * CPL
+      GO(IZ) = 4./ 3.* ( 2.* W0(IZ) - W1(IZ) )
+     >+ (33.- 2.* NEFF) / 6.* GI(IZ) + 6.*(RH(IZ) + R0(IZ) - 2.* R1(IZ))
+      GO(IZ) = GO(IZ) * CPL
+  240 CONTINUE
+      EndIf
+      IF (IKNL .EQ. 2) THEN
+      DZ = 1./(NX - 1)
+      DO 21 I = 1, NX-1
+        X = XV(I)
+        NP = NX - I + 1
+        IS = NP
+           g2(1)=0d0
+           g3(1)=0d0
+        DO 31 KZ = 2, NP
+          IY = I + KZ - 1
+          IT = NX - IY + 1
+          XY = ZZ (IS, IT)
+          G1(KZ) = FFG(I, IY) * (FI(IY) - XY**2 *FI(I))
+          G4(KZ) = GGF(I, IY) * (GI(IY) - XY**2 *GI(I))
+           G2(KZ) = FFG(IS,IT) * (GI(IY) - xy*GI(I))    !FG
+           G3(KZ) = GGF(IS,IT) * (FI(IY) - XY*FI(I))    !GF (usual notations)
+   31   CONTINUE
+        TEM1 = CtLhSMPNOL (NP, DZ, G1, ERR)
+        TEM2 = CtLhSMPSNA (NP, DZ, G2, ERR)
+        TEM3 = CtLhSMPSNA (NP, DZ, G3, ERR)
+        TEM4 = CtLhSMPNOL (NP, DZ, G4, ERR)
+        TEM1 = TEM1 - FI(I) * (AFF2(I) + ZGF2)
+        TEM4 = TEM4 - GI(I) * (AGG2(I) + ZFG2)
+         tem2 = tem2 + GI(I)*AFG2(I)
+         tem3=  tem3 + FI(I)*AGF2(I)
+        TMF = TEM1 + TEM2
+        TMG = TEM3 + TEM4
+        FO(I) = FO(I) + TMF * CPL2
+        GO(I) = GO(I) + TMG * CPL2
+   21 CONTINUE
+      EndIf
+      RETURN
+      END
+      FUNCTION CtLhSPENC2 (X)
+      IMPLICIT DOUBLE PRECISION (A-H, O-Z)
+      EXTERNAL CtLhSPN2IN
+      COMMON / LhCtSPENCC / XX
+      DATA U1, AERR, RERR / 1.D0, 1.E-7, 5.E-3 /
+      XX = X
+      TEM = CtLhGausInt(CtLhSPN2IN, XX, U1, AERR, RERR, ERR, IRT)
+      CtLhSPENC2 = TEM + LOG (XX) ** 2 / 2.
+      RETURN
+      END
+      FUNCTION CtLhSPN2IN (ZZ)
+      IMPLICIT DOUBLE PRECISION (A-H, O-Z)
+      COMMON / LhCtSPENCC / X
+      Z = ZZ
+      TEM = LOG (1.+ X - Z) / Z
+      CtLhSPN2IN = TEM
+      RETURN
+      END
+      SUBROUTINE CtLhSTUPKL (NFL)
+      IMPLICIT DOUBLE PRECISION (A-H, O-Z)
+      LOGICAL LSTX
+      PARAMETER (D0=0D0, D1=1D0, D2=2D0, D3=3D0, D4=4D0, D10=1D1)
+      PARAMETER (MXX = 105, MXQ = 25, MXF = 6)
+      PARAMETER (MX = 3)
+      PARAMETER (M1=-3, M2=3, NDG=3, NDH=NDG+1, L1=M1-1, L2=M2+NDG-2)
+      COMMON / LhCtXXARAY / XCR, XMIN, XV(0:MXX), LSTX, NX
+      COMMON / LhCtXYARAY / ZZ(MXX, MXX), ZV(0:MXX)
+      COMMON / LhCtVARIBX / XA(MXX, L1:L2), ELY(MXX), DXTZ(MXX)
+      COMMON / LhCtKRN1ST / FF1(0:MXX),FG1(0:MXX),GF1(0:MXX),GG1(0:MXX),
+     >                  FF2(0:MXX), FG2(0:MXX), GF2(0:MXX), GG2(0:MXX),
+     >                  PNSP(0:MXX), PNSM(0:MXX)
+      COMMON / LhCtKRN2ND / FFG(MXX, MXX), GGF(MXX, MXX), PNS(MXX, MXX)
+      COMMON / LhCtKRNL00 / DZ, XL(MX), NNX
+      COMMON / LhCtKRNL01 / AFF2(MXX),AFG2(MXX),AGF2(MXX),AGG2(MXX),
+     >                  ANSP (MXX), ANSM (MXX), ZFG2, ZGF2, ZQQB
+      EXTERNAL CtLhPFF1, CtLhRGG1, CtLhRFF2, CtLhRGG2
+      EXTERNAL CtLhFNSP, CtLhFNSM
+      dimension aff1(mxx),agg1(mxx)
+      PARAMETER (PI = 3.141592653589793d0, PI2 = PI**2)
+      DATA CF, CG, TR / 1.33333333333333d0, 3.0, 0.5 /
+      data zeta3/1.20205690315959d0/          ! zeta(3.0)
+      SAVE
+      DATA AERR, RERR / 0.0, 0.02 /
+      NNX = NX
+      DZ = 1./ (NX - 1)
+      DO 5 I0 = 1, MX
+        XL(I0) = XV(I0)
+    5 CONTINUE
+      DO 10 I = 1, NX-1
+        XZ = XV(I)
+      CALL CtLhKERNEL (XZ, FF1(I), GF1(I), FG1(I), GG1(I), PNSP(I),
+     >          PNSM(I), FF2(I), GF2(I), FG2(I), GG2(I), NFL, IRT)
+   10 CONTINUE
+      FF1(0) = FF1(1) * 3. - FF1(2) * 3. + FF1(3)
+      FG1(0) = FG1(1) * 3. - FG1(2) * 3. + FG1(3)
+      GF1(0) = GF1(1) * 3. - GF1(2) * 3. + GF1(3)
+      GG1(0) = GG1(1) * 3. - GG1(2) * 3. + GG1(3)
+      PNSP(0) = PNSP(1) * 3. - PNSP(2) * 3. + PNSP(3)
+      PNSM(0) = PNSM(1) * 3. - PNSM(2) * 3. + PNSM(3)
+      FF2(0) = FF2(1) * 3. - FF2(2) * 3. + FF2(3)
+      FG2(0) = FG2(1) * 3. - FG2(2) * 3. + FG2(3)
+      GF2(0) = GF2(1) * 3. - GF2(2) * 3. + GF2(3)
+      GG2(0) = GG2(1) * 3. - GG2(2) * 3. + GG2(3)
+      FF1(NX) = FF1(NX-1) * 3. - FF1(NX-2) * 3. + FF1(NX-3)
+      FG1(NX) = FG1(NX-1) * 3. - FG1(NX-2) * 3. + FG1(NX-3)
+      GF1(NX) = GF1(NX-1) * 3. - GF1(NX-2) * 3. + GF1(NX-3)
+      GG1(NX) = GG1(NX-1) * 3. - GG1(NX-2) * 3. + GG1(NX-3)
+      PNSM(NX) = PNSM(NX-1) * 3. - PNSM(NX-2) * 3. + PNSM(NX-3)
+      PNSP(NX) = PNSP(NX-1) * 3. - PNSP(NX-2) * 3. + PNSP(NX-3)
+      FF2(NX) = FF2(NX-1) * 3. - FF2(NX-2) * 3. + FF2(NX-3)
+      FG2(NX) = FG2(NX-1) * 3. - FG2(NX-2) * 3. + FG2(NX-3)
+      GF2(NX) = GF2(NX-1) * 3. - GF2(NX-2) * 3. + GF2(NX-3)
+      GG2(NX) = GG2(NX-1) * 3. - GG2(NX-2) * 3. + GG2(NX-3)
+         RER = RERR * 4.
+         AFF1(1) = CtLhGausInt(CtLhPFF1,D0,XV(1),AERR,RERR,ER1,IRT)
+         DGG1     = NFL / 3.
+         TMPG     = CtLhGausInt(CtLhRGG1,D0,XV(1),AERR,RERR,ER3,IRT)
+         AGG1(1) = TMPG + DGG1
+       ANSM(1) = CtLhGausInt(CtLhFNSM,D0,XV(1),AERR,RER,ER2,IRT)
+       ANSP(1) = CtLhGausInt(CtLhFNSP,D0,XV(1),AERR,RER,ER2,IRT)
+         AER = AFF1(1) * RER
+         AFF2(1) = CtLhGausInt(CtLhRFF2, D0, XV(1),  AER, RER, ER2, IRT)
+         AER = AGG1(1) * RER
+         AGG2(1) = CtLhGausInt(CtLhRGG2, D0, XV(1),  AER, RER, ER4, IRT)
+      DO 20 I2 = 2, NX-1
+      TEM =CtLhGausInt(CtLhPFF1,XV(I2-1),XV(I2),AERR,RERR,ER1,IRT)
+      AFF1(I2) = TEM + AFF1(I2-1)
+      AER = ABS(TEM * RER)
+      AFF2(I2)=CtLhGausInt(CtLhRFF2,XV(I2-1),XV(I2),AER,RER,ER2,IRT)
+     >        +AFF2(I2-1)
+      TEM      = CtLhGausInt(CtLhRGG1,XV(I2-1),XV(I2),AERR,RERR,ER3,IRT)
+      TMPG     = TMPG + TEM
+      AGG1(I2) = TMPG + DGG1
+      AER = ABS(TEM * RER)
+      AGG2(I2)=CtLhGausInt(CtLhRGG2,XV(I2-1),XV(I2),AER,RER,ER4,IRT)
+     >        +AGG2(I2-1)
+      ANSP(I2)=CtLhGausInt(CtLhFNSP,XV(I2-1),XV(I2),AERR,RER,ER4,IRT)
+     >        +ANSP(I2-1)
+      ANSM(I2)=CtLhGausInt(CtLhFNSM,XV(I2-1),XV(I2),AERR,RER,ER4,IRT)
+     >        +ANSM(I2-1)
+   20 CONTINUE
+      ANSP(NX)=CtLhGausInt(CtLhFNSP,XV(NX-1),D1,AERR,RER,ERR,
+     > IRT) + ANSP(NX-1)
+      ANSM(NX)=CtLhGausInt(CtLhFNSM,XV(NX-1),D1,AERR,RER,ERR,
+     > IRT) + ANSM(NX-1)
+           TRNF = TR * NFL
+      do i2=1,nx-1                                        !loop over x
+         x=xv(i2)
+         XI = 1./ X                                    !auxiliary definitions
+         X2 = X ** 2
+         X3=  x**3
+         XLN = DLOG (X)
+         XLN2 = XLN ** 2
+         XLN1M = DLOG (1.- X)
+         xLi2m=CtLhxLi(2,-x)
+         xLi2=CtLhxLi(2,x)
+         xLi3=CtLhxLi(3,x)
+         xLi31m=CtLhxLi(3,1d0-x)
+         xLi32=CtLhxLi(3,x2)
+         xln1m2=xln1m*xln1m
+         xln1p=dlog(1d0+x)
+         x1m=1d0-x
+         x1p=1d0+x
+         x3m=3d0-x
+         x3p=3d0+x
+         wgfcft=
+     > (9 + 4*Pi2 - 22*x + 13*x2 + 6*(3 - 4*x + x2)*xln1m +
+     > 40*xln - 24*xLi2)/9.
+       wgfcf2=
+     > (6*(2*(-9 + Pi2) + 3*x*(5 + x)) +4*(3 +2*Pi2+3*x*(-3 + 2*x))*
+     > xln1m + 6*x3m*x1m*xln1m2 - 6*(x*(8 + 3*x) + 4*xln1m2)*
+     > xln - 3*(-4 + x)*x*xln2)/12 - 2*(3 + 2*xln1m)*xLi2 - 4*xLi31m
+       wgfcfg=
+     > (3637-186*Pi2-x*(3198+72*Pi2+x*(231 + 208*x)))/108.- xln +
+     > (3*xln1m*(-33 - 4*Pi2 + (50 - 17*x)*x - 3*x3m*x1m*xln1m) +
+     > 2*(x*(198 + x*(27+8*x))+9*xln1m*(3 - 4*x + x2 + 2*xln1m))*
+     > xln - 9*x*(4 + x)*xln2)/18- x1p*x3p*xln*xln1p-
+     > (x1p*x3p - 4*xln)*xLi2m + (31d0/3d0 +4*xln1m- 4*xln)*xLi2 +
+     > 4*xLi31m + 12*xLi3 - 2*xLi32 - 10*zeta3
+       wfgcft=
+     > (18 - 81*x + 6*Pi2*x + 123*x2 - 6*Pi2*x2 - 60*x3 +
+     > 4*Pi2*x3 - 6*(-2 + 3*x - 3*x2 + 2*x3)*xln1m2 -33*x*xln +
+     > 15*x2*xln - 24*x3*xln - 9*x*xln2 + 9*x2*xln2 -
+     > 12*x3*xln2 - 12*x1m*xln1m*(-1 + 2*x2 + 2*xln - x*xln +
+     > 2*x2*xln) - 24*xLi2)/9.
+       wfgcgt=
+     > (2*(-67 + 2*Pi2 + x*(64 + x*(-91 + 3*Pi2 + 94*x)) +
+     > x1m*(7+x*(-5+16*x))*xln1m -3*x1m*(2+ x*(-1+2*x))*xln1m2 -
+     > 20*xln - 3*x*xln*(13 + 16*x*x1p - 3*x1p*xln) +
+     > 6*x1p*(2+x+2*x2)*xln*xln1p+6*x1p*(2+x+2*x2)*xLi2m))/9.
+       AGF2(I2) = CF*TRNF*WGFCFT+CF**2* WGFCF2+CF*CG*WGFCFG
+       AFG2(I2) = CF*TRNF*WFGCFT            +CG*TRNF*WFGCGT
+      enddo !i2
+       AGF2(nx)=0d0
+       AFG2(nx)=0d0
+       ZGF2=-28./27.*Cf**2+94./27.*Cf*Cg -52./27.*Cf*TrNf
+       ZFG2= 37./27.*Cf*TrNf + 35./54.*Cg*TrNf
+       ZQQB=1.43862321154902*(Cf**2-0.5*Cf*Cg)
+      DO 21 IX = 1, NX-1
+        X = XV(IX)
+        NP = NX - IX + 1
+        IS = NP
+        XG2 = (LOG(1./(1.-X)) + 1.) ** 2
+        FFG (IS, IS) = FG2(NX) * DXTZ(I) * XG2
+      GGF (IS, IS) = GF2(NX) * DXTZ(I) * XG2
+      PNS (IS, IS) =PNSM(NX) * DXTZ(I)
+        DO 31 KZ = 2, NP
+          IY = IX + KZ - 1
+          IT = NX - IY + 1
+          XY = X / XV(IY)
+          XM1 = 1.- XY
+          XG2 = (LOG(1./XM1) + 1.) ** 2
+          Z  = ZZ (IX, IY)
+          TZ = (Z + DZ) / DZ
+          IZ = TZ
+          IZ = MAX (IZ, 0)
+          IZ = MIN (IZ, NX-1)
+          DT = TZ - IZ
+          TEM = (FF2(IZ) * (1.- DT) + FF2(IZ+1) * DT) / XM1 / XY
+          FFG (IX, IY) = TEM * DXTZ(IY)
+          TEM = (FG2(IZ) * (1.- DT) + FG2(IZ+1) * DT) * XG2 / XY
+          FFG (IS, IT) = TEM * DXTZ(IY)
+          TEM = (GF2(IZ) * (1.- DT) + GF2(IZ+1) * DT) * XG2 / XY
+        GGF (IS, IT) = TEM * DXTZ(IY)
+          TEM = (GG2(IZ) * (1.- DT) + GG2(IZ+1) * DT) / XM1 / XY
+        GGF (IX, IY) = TEM * DXTZ(IY)
+        TEM = (PNSP(IZ) * (1.- DT) + PNSP(IZ+1) * DT) / XM1
+        PNS (IX, IY) = TEM * DXTZ(IY)
+        TEM = (PNSM(IZ) * (1.- DT) + PNSM(IZ+1) * DT) / XM1
+        PNS (IS, IT) = TEM * DXTZ(IY)
+   31   CONTINUE
+   21 CONTINUE
+      RETURN
+      END
+      SUBROUTINE CtLhTRNLAM (IRDR, NF, IACT, IRT)
+      IMPLICIT DOUBLE PRECISION (A-H, O-Z)
+      COMMON / LhCtCWZPRM / ALAM(0:9), AMHAT(0:9), AMN, NHQ
+      COMMON / LhCtTRNCOM / VMULM, JRDR, N, N1
+      EXTERNAL CtLhZBRLAM
+      DATA ALM0, BLM0, RERR / 0.01, 10.0, 0.0001 /
+      DATA IR1, SML / 0, 1.E-5 /
+      IRT = 0
+      N = NF
+      JRDR = IRDR
+      JACT = IACT
+      VLAM = ALAM(N)
+      IF (JACT .GT. 0) THEN
+         N1 = N + 1
+         THMS = AMHAT(N1)
+         ALM = LOG (THMS/VLAM)
+         BLM = BLM0
+      ELSE
+         N1 = N -1
+         THMS = AMHAT(N)
+         ALM = ALM0
+         THMS = MAX (THMS, SML)
+         BLM = LOG (THMS/VLAM)
+      ENDIF
+      IF (VLAM .GE. 0.7 * THMS) THEN
+         IF (JACT . EQ. 1) THEN
+            AMHAT(N1) = 0
+         ELSE
+            AMHAT(N) = 0
+         ENDIF
+         IRT = 4
+         ALAM(N1) = VLAM
+         RETURN
+      ENDIF
+      IF (ALM .GE. BLM) THEN
+         WRITE (*, *) 'CtLhTRNLAM has ALM >= BLM: ', ALM, BLM
+         WRITE (*, *) 'I do not know how to continue'
+         STOP
+         ENDIF
+      VMULM = THMS/VLAM
+      ERR = RERR * LOG (VMULM)
+      WLLN = CtLhQZBRNT (CtLhZBRLAM, ALM, BLM, ERR, IR1)
+      ALAM(N1) = THMS / EXP (WLLN)
+      IF (IR1 .NE. 0) THEN
+         WRITE (*, *) 'CtLhQZBRNT failed in CtLhTRNLAM; ',
+     >        'NF, VLAM =', NF, VLAM
+         WRITE (*, *) 'I do not know how to continue'
+        STOP
+      ENDIF
+      RETURN
+      END
+      SUBROUTINE CtLhUPC (A, La, UpA)
+      CHARACTER A*(*), UpA*(*), C*(1)
+      INTEGER I, La, Ld
+      La = Len(A)
+      Lb = Len(UpA)
+      If (Lb .Lt. La) Stop 'UpCase conversion length mismatch!'
+      Ld = ICHAR('A')-ICHAR('a')
+      DO 1 I = 1, Lb
+        If (I .Le. La) Then
+         c = A(I:I)
+         IF ( LGE(C, 'a') .AND. LLE(C, 'z') ) THEN
+           UpA (I:I) = CHAR(Ichar(c) + ld)
+         Else
+           UpA (I:I) = C
+         ENDIF
+        Else
+         UpA (I:I) = ' '
+        Endif
+ 1    CONTINUE
+      
+      RETURN
+      END
+      SUBROUTINE CtLhWARNI (IWRN, MSG, NMVAR, IVAB,
+     >                  IMIN, IMAX, IACT)
+      CHARACTER*(*) MSG, NMVAR
+      Save Iw
+      Data Nmax / 100 /
+      IW = IWRN
+      IV = IVAB
+      
+      IF  (IW .EQ. 0) THEN
+         PRINT '(1X,A/1X, 2A,I10 /A,I4)', MSG, NMVAR, ' = ', IV
+         IF (IACT .EQ. 1) THEN
+         PRINT       '(A/2I10)', ' The limits are: ', IMIN, IMAX
+         ENDIF
+      ENDIF
+      If (Iw .LT. Nmax) Then
+         PRINT '(1X,A/1X,I10,A, I10)', MSG, NMVAR, ' = ', IV
+      Elseif (Iw .Eq. Nmax) Then
+         Print '(/A/)', 'CtLhWARNI Severe Warning: Too many errors'
+      Endif
+      IWRN = IW + 1
+      RETURN
+      END
+      SUBROUTINE CtLhWARNR (IWRN, MSG, NMVAR, VARIAB,
+     >                  VMIN, VMAX, IACT)
+      IMPLICIT DOUBLE PRECISION (A-H, O-Z)
+      PARAMETER (D0=0D0, D1=1D0, D2=2D0, D3=3D0, D4=4D0, D10=1D1)
+      CHARACTER*(*) MSG, NMVAR
+      Save Iw
+      Data Nmax / 100 /
+      IW = IWRN
+      VR = VARIAB
+      IF  (IW .EQ. 0) THEN
+         PRINT '(1X, A/1X,2A,1PD16.7/A,I4)', MSG, NMVAR, ' = ', VR
+         IF (IACT .EQ. 1) THEN
+         PRINT       '(A/2(1PE15.4))', ' The limits are: ', VMIN, VMAX
+         ENDIF
+      ENDIF
+      If (Iw .LT. Nmax) Then
+         PRINT '(I5, 2A/1X,2A,I10,1PD16.7)', IW, '   ', MSG,
+     >                  NMVAR, ' = ', VR
+      Elseif (Iw .Eq. Nmax) Then
+         Print '(/A/)', 'CtLhWARNR Severe Warning: Too many errors'
+      Endif
+      IWRN = IW + 1
+      RETURN
+      END
+      SUBROUTINE CtLhXARRAY
+      IMPLICIT DOUBLE PRECISION (A-H, O-Z)
+      LOGICAL LSTX
+      PARAMETER (D0 = 0.0, D10=10.0)
+      PARAMETER (MXX = 105, MXQ = 25, MXF = 6)
+      PARAMETER (MXPN = MXF * 2 + 2)
+      PARAMETER (MXQX= MXQ * MXX,   MXPQX = MXQX * MXPN)
+      PARAMETER (M1=-3, M2=3, NDG=3, NDH=NDG+1, L1=M1-1, L2=M2+NDG-2)
+      Character Msg*80
+      COMMON / LhCtVARIBX / XA(MXX, L1:L2), ELY(MXX), DXTZ(MXX)
+      COMMON / LhCtVARBAB / GB(NDG, NDH, MXX), H(NDH, MXX, M1:M2)
+      COMMON / LhCtHINTEC / GH(NDG, MXX)
+      COMMON / LhCtXXARAY / XCR, XMIN, XV(0:MXX), LSTX, NX
+      COMMON / LhCtXYARAY / ZZ(MXX, MXX), ZV(0:MXX)
+      DIMENSION G1(NDG,NDH), G2(NDG,NDH), A(NDG)
+      DATA F12, F22, F32 / 1D0, 1D0, 1D0 /
+      DATA (G1(I,NDH), G2(I,1), I=1,NDG) / 0.0,0.0,0.0,0.0,0.0,0.0 /
+      DATA PUNY / 1D-30 /
+      XV(0) = 0D0
+      DZ = 1D0 / (NX-1)
+      DO 10 I = 1, NX - 1
+         Z = DZ * (I-1)
+         ZV(I) = Z
+         X = CtLhXFRMZ (Z)
+         DXTZ(I) = CtLhDXDZ(Z) / X
+         XV (I)  = X
+         XA(I, 1) = X
+         XA(I, 0) = LOG (X)
+         DO 20 L = L1, L2
+          IF (L .NE. 0 .AND. L .NE. 1)  XA(I, L) = X ** L
+   20    CONTINUE
+   10 CONTINUE
+         XV(1) = Xmin
+         XV(NX) = 1D0
+         ZV(Nx) = 1D0
+         DXTZ(NX) = CtLhDXDZ(1.D0)
+         DO 21 L = L1, L2
+            XA (NX, L) = 1D0
+   21    CONTINUE
+         XA (NX, 0) = 0D0
+      DO 11 I = 1, NX-1
+         ELY(I) = LOG(1D0 - XV(I))
+   11 CONTINUE
+       ELY(NX) = 3D0* ELY(NX-1) - 3D0* ELY(NX-2) + ELY(NX-3)
+      DO 17 IX = 1, NX
+      ZZ (IX, IX) = 1.
+      DO 17 IY = IX+1, NX
+         XY = XV(IX) / XV(IY)
+         ZZ (IX, IY) = CtLhZFRMX (XY)
+         ZZ (NX-IX+1, NX-IY+1) = XY
+   17 CONTINUE
+      DO 30 I = 1, NX-1
+      IF (I .NE. NX-1) THEN
+        F11 = 1D0/XV(I)
+        F21 = 1D0/XV(I+1)
+        F31 = 1D0/XV(I+2)
+        F13 = XV(I)
+        F23 = XV(I+1)
+        F33 = XV(I+2)
+        DET = F11*F22*F33 + F21*F32*F13 + F31*F12*F23
+     >      - F31*F22*F13 - F21*F12*F33 - F11*F32*F23
+        IF (ABS(DET) .LT. PUNY) THEN
+           Msg='Determinant close to zero; will be arbitrarily set to:'
+           CALL CtLhWARNR(IWRN, Msg, 'DET', PUNY, D0, D0, 0)
+           DET = PUNY
+        EndIf
+        G2(1,2) = (F22*F33 - F23*F32) / DET
+        G2(1,3) = (F32*F13 - F33*F12) / DET
+        G2(1,4) = (F12*F23 - F13*F22) / DET
+        G2(2,2) = (F23*F31 - F21*F33) / DET
+        G2(2,3) = (F33*F11 - F31*F13) / DET
+        G2(2,4) = (F13*F21 - F11*F23) / DET
+        G2(3,2) = (F21*F32 - F22*F31) / DET
+        G2(3,3) = (F31*F12 - F32*F11) / DET
+        G2(3,4) = (F11*F22 - F12*F21) / DET
+        B2 = LOG (XV(I+2)/XV(I))
+        B3 = XV(I) * (B2 - 1.) + XV(I+2)
+        GH (1,I) = B2 * G2 (2,2) + B3 * G2 (3,2)
+        GH (2,I) = B2 * G2 (2,3) + B3 * G2 (3,3)
+        GH (3,I) = B2 * G2 (2,4) + B3 * G2 (3,4)
+      EndIf
+        DO 51 J = 1, NDH
+           DO 52 L = 1, NDG
+              IF     (I .EQ. 1) THEN
+                 GB(L,J,I) = G2(L,J)
+              ElseIF (I .EQ. NX-1) THEN
+                 GB(L,J,I) = G1(L,J)
+              Else
+                 GB(L,J,I) = (G1(L,J) + G2(L,J)) / 2D0
+              EndIf
+   52      CONTINUE
+   51   CONTINUE
+        DO 35 MM = M1, M2
+           DO 40 K = 1, NDG
+             KK = K + MM - 2
+             IF (KK .EQ. 0) THEN
+               A(K) = XA(I+1, 0) - XA(I, 0)
+             Else
+               A(K) = (XA(I+1, KK) - XA(I, KK)) / DBLE(KK)
+             EndIf
+   40      CONTINUE
+           DO 41 J = 1, NDH
+             TEM = 0
+             DO 43 L = 1, NDG
+               TEM = TEM + A(L) * GB(L,J,I)
+   43        CONTINUE
+             H(J,I,MM) = TEM
+   41      CONTINUE
+   35   CONTINUE
+      DO 42 J = 1, NDG
+        DO 44 L = 1, NDG
+           G1(L,J) = G2(L,J+1)
+   44 CONTINUE
+   42 CONTINUE
+   30 CONTINUE
+      LSTX = .TRUE.
+      RETURN
+      END
+      FUNCTION CtLhXFRMZ (Z)
+      IMPLICIT DOUBLE PRECISION (A-H, O-Z)
+      LOGICAL LSTX
+      PARAMETER (D0=0D0, D1=1D0, D2=2D0, D3=3D0, D4=4D0, D10=1D1)
+      PARAMETER (MXX = 105)
+      COMMON / LhCtXXARAY / XCR, XMIN, XV(0:MXX), LSTX, NX
+      COMMON / LhCtINVERT / ZA
+      EXTERNAL CtLhZFXL
+      DATA TEM, RER / D1, 1E-3 /
+      DATA ZLOW, ZHIGH, IWRN2 / -10.0, 1.00002, 0 /
+    7 EPS = TEM * RER
+      ZA = Z
+      IF (Z .LE. ZHIGH .AND. Z .GT. ZLOW) THEN
+          XLA = LOG (XMIN) * 1.5
+          XLB = 0.00001
+          TEM = CtLhZBRNT (CtLhZFXL, XLA, XLB, EPS, IRT)
+      Else
+        CALL CtLhWARNR (IWRN2, 'Z out of range in CtLhXFRMZ, X set=0.',
+     >              'Z', Z, ZLOW, ZHIGH, 1)
+        TEM = 0
+      EndIf
+      CtLhXFRMZ = EXP(TEM)
+      RETURN
+      END
+      FUNCTION CtLhxLi(n,x)
+      implicit NONE
+      integer NCUT, i,n,m3
+      real*8 CtLhxLi,Out,x,pi2by6,zeta3,c1,c2
+      real*8 r,xt,L,xln1m
+      parameter (m3=8)
+      dimension c1(2:m3),c2(2:m3)
+      data NCUT/27/
+      data c1/0.75,-0.5833333333333333d0,0.454861111111111d0,
+     >        -0.3680555555555555d0,0.3073611111111111d0,
+     >        -0.2630555555555555d0,0.2294880243764172d0/
+      data c2/-0.5d0,0.5d0,-0.4583333333333333d0,0.416666666666666d0,
+     >        -0.3805555555555555d0,0.35d0,-0.3241071428571428d0/
+      data zeta3,pi2by6 /1.20205690315959d0,1.64493406684823d0/
+      L=0.0
+      i=0
+      r=1.0
+      if (abs(x).gt.r) then
+        PRINT *,'Li: x out of range (-1,1) , x=',x
+        STOP
+      endif
+      if (n.lt.0) then
+       PRINT *,'Polylogarithm Li undefined for n=',n
+       STOP
+      elseif (n.eq.0) then
+       Out=x/(1d0-x)
+      elseif (n.eq.1) then
+       Out=-dlog(1-x)
+      elseif (n.eq.2) then
+                                                !Calculate dilogarithm
+                                                !separately for x<0.5 and x>0.5
+      if (x.ge.(-0.5).and.x.le.0.5) then
+         do while(i.le.NCUT)
+                 i=i+1
+          r=r*x
+          L=L+r/i/i
+         enddo
+         Out=L
+       elseif (x.eq.0) then
+         Out=0d0
+       elseif(x.gt.0.5) then !n.eq.2,x>0.5
+         xt = 1.0-x
+         L = pi2by6 - dlog(x)*dlog(xt)
+         do while(i.le.NCUT)
+          i=i+1
+          r=r*xt
+          L=L-r/i/i
+         enddo
+         Out=L
+       elseif (x.lt.(-0.5)) then
+         xt=-x/(1d0-x)
+         L=-0.5*dlog(1-x)**2
+         do while (i.le.NCUT)
+          i=i+1
+          r=r*xt
+          L=L-r/i/i
+         enddo
+         Out=L
+       endif
+      elseif (n.eq.3.and.x.ge.0.8) then !use the expansion of Li3 near x=1
+       L=zeta3+pi2by6*dlog(x)
+       xt=(1d0-x)
+       xln1m=dlog(xt)
+       do i=2,m3
+        L=L+(c1(i)+c2(i)*xln1m)*xt**i
+       enddo
+       Out=L
+      else !n>3 or x=3,x<0.8
+         do while(i.le.NCUT)
+          i=i+1
+          r=r*x
+          L=L+r/dble(i)**dble(n)
+         enddo
+         Out=L
+      endif
+      CtLhxLi=Out
+      End ! CtLhxLi
+      FUNCTION CtLhZBRLAM (WLLN)
+      IMPLICIT DOUBLE PRECISION (A-H, O-Z)
+      COMMON / LhCtTRNCOM / VMULM, JRDR, N, N1
+      WMULM = EXP (WLLN)
+      TEM1 = 1./ CtLhALPQCD(JRDR, N1, WMULM, I)
+      TEM2 = 1./ CtLhALPQCD(JRDR, N,  VMULM, I)
+      CtLhZBRLAM = TEM1 - TEM2
+      END
+      FUNCTION CtLhZBRNT(FUNC, X1, X2, TOL, IRT)
+      IMPLICIT DOUBLE PRECISION (A-H, O-Z)
+      PARAMETER (ITMAX = 1000, EPS = 3.E-12)
+      external func
+      IRT = 0
+      TOL = ABS(TOL)
+      A=X1
+      B=X2
+      FA=FUNC(A)
+      FB=FUNC(B)
+      IF(FB*FA.GT.0.)  THEN
+        PRINT *, 'Root must be bracketed for CtLhZBRNT. Set = 0'
+        IRT = 1
+        CtLhZBRNT=0.
+        RETURN
+      ENDIF
+      FC=FB
+      DO 11 ITER=1,ITMAX
+        IF(FB*FC.GT.0.) THEN
+          C=A
+          FC=FA
+          D=B-A
+          E=D
+        ENDIF
+        IF(ABS(FC).LT.ABS(FB)) THEN
+          A=B
+          B=C
+          C=A
+          FA=FB
+          FB=FC
+          FC=FA
+        ENDIF
+        TOL1=2.*EPS*ABS(B)+0.5*TOL
+        XM=.5*(C-B)
+        IF(ABS(XM).LE.TOL1 .OR. FB.EQ.0.)THEN
+          CtLhZBRNT=B
+          RETURN
+        ENDIF
+        IF(ABS(E).GE.TOL1 .AND. ABS(FA).GT.ABS(FB)) THEN
+          S=FB/FA
+          IF(A.EQ.C) THEN
+            P=2.*XM*S
+            Q=1.-S
+          ELSE
+            Q=FA/FC
+            R=FB/FC
+            P=S*(2.*XM*Q*(Q-R)-(B-A)*(R-1.))
+            Q=(Q-1.)*(R-1.)*(S-1.)
+          ENDIF
+          IF(P.GT.0.) Q=-Q
+          P=ABS(P)
+          IF(2.*P .LT. MIN(3.*XM*Q-ABS(TOL1*Q),ABS(E*Q))) THEN
+            E=D
+            D=P/Q
+          ELSE
+            D=XM
+            E=D
+          ENDIF
+        ELSE
+          D=XM
+          E=D
+        ENDIF
+        A=B
+        FA=FB
+        IF(ABS(D) .GT. TOL1) THEN
+          B=B+D
+        ELSE
+          B=B+SIGN(TOL1,XM)
+        ENDIF
+        FB=FUNC(B)
+11    CONTINUE
+      PRINT *, 'CtLhZBRNT exceeding maximum iterations.'
+      IRT = 2
+      CtLhZBRNT=B
+      RETURN
+      END
+      FUNCTION CtLhZFRMX (XX)
+      IMPLICIT DOUBLE PRECISION (A-H, O-Z)
+      LOGICAL LSTX
+      PARAMETER (D0=0D0, D1=1D0, D2=2D0, D3=3D0, D4=4D0, D10=1D1)
+      PARAMETER (MXX = 105)
+      COMMON / LhCtXXARAY / XCR, XMIN, XV(0:MXX), LSTX, NX
+      DATA IWRN1, HUGE, TINY / 0, 1.E35, 1.E-35 /
+      F(X) = (XCR-XMIN) * LOG (X/XMIN) + LOG (XCR/XMIN) * (X-XMIN)
+      D(X) = (XCR-XMIN) / X          + LOG (XCR/XMIN)
+      X = XX
+      IF (X .GE. XMIN) THEN
+         TEM = F(X) / F(D1)
+      ElseIF (X .GE. D0) THEN
+         X = MAX (X, TINY)
+         TEM = F(X) / F(D1)
+      Else
+         CALL CtLhWARNR(IWRN1, 'X out of range in CtLhZFRMX'
+     >             , 'X', X, TINY, HUGE, 1)
+         TEM = 99.
+         STOP
+      EndIf
+      CtLhZFRMX = TEM
+      RETURN
+      ENTRY CtLhDZDX (XX)
+      X = XX
+      IF (X .GE. XMIN) THEN
+         TEM = D(X) / F(D1)
+      ElseIF (X .GE. D0) THEN
+         X = MAX (X, TINY)
+         TEM = D(X) / F(D1)
+      Else
+         CALL CtLhWARNR(IWRN1, 'X out of range in CtLhDZDX '
+     >             , 'X', X, TINY, HUGE, 1)
+         TEM = 99.
+         STOP
+      EndIf
+      CtLhDZDX = TEM
+      RETURN
+      END
+      FUNCTION CtLhZFXL (XL)
+      IMPLICIT DOUBLE PRECISION (A-H, O-Z)
+      COMMON / LhCtINVERT / ZA
+      X = EXP(XL)
+      TT = CtLhZFRMX (X) - ZA
+      CtLhZFXL = TT
+      RETURN
+      END
+
diff --git a/LHAPDF/lhapdf5.2.2/LHpdflib.f b/LHAPDF/lhapdf5.2.2/LHpdflib.f
new file mode 100644 (file)
index 0000000..33b6319
--- /dev/null
@@ -0,0 +1,191 @@
+c     Automatically determine the path to the system's PDF set
+c     collection using the lhapdf-config utility (which must be
+c     in the user's execution path
+c     ---------------------------------------------------------
+      subroutine InitPDFsetByCodes(code1, code2, code3)
+      write(*,*) "Not implemented yet: this will move the 'glue' interf
+     +ace to LHAPDF proper and use the InitPDFsetByName function to get
+     +the path automatically."
+      return
+      end
+c     ---------------------------------------------------------
+
+
+c     Automatically determine the path to the system's PDF set
+c     collection using the lhapdf-config utility (which must be
+c     in the user's execution path
+c     --------------------------------------------------------
+      subroutine InitPDFsetByName(setname)
+      implicit none
+      character setname*(*)
+      integer nset
+      nset = 1
+      call InitPDFsetByNameM(nset,setname)
+      return
+      end
+      
+      subroutine InitPDFsetByNameM(nset,setname)
+      implicit none
+      character setname*(*)
+      integer nset
+c      integer :: ierror
+      integer n, dirpathlength, setnamelength
+      character*512 dirpath, setpath
+c check enviromental variable LHAPATH
+      call getenv('LHAPATH',dirpath)
+      if (dirpath.eq.'') then
+c      Use the lhapdf-config script to get the path to the PDF sets
+       call system
+     + ("lhapdf-config --pdfsets-path > /tmp/lhapdf-pdfsets-path")
+       open(unit=8, file="/tmp/lhapdf-pdfsets-path", status="old")
+c      open(unit=8, file="/tmp/lhapdf-pdfsets-path", status="old", iostat
+c      $=ierror)
+       read (8,'(A)') dirpath
+       close(8)
+      endif
+
+c     Now do some mangling to get the right path length from the 
+c     (hopefully) over-long string read in from the file
+      n = 512
+      do while (dirpath(n:n) .eq. ' ' .and. n .gt. 0)
+         n = n-1
+      enddo
+      dirpathlength = n
+
+c     How long is 'name', really?
+      n = len(setname)
+      do while (setname(n:n) .eq. ' ' .and. n .gt. 0)
+         n = n-1
+      enddo
+      setnamelength = n
+
+c     Combine the set directory path and the set name
+      setpath(1:dirpathlength) = dirpath(1:dirpathlength)
+      setpath(dirpathlength+1:dirpathlength+1) = "/"
+      setpath(dirpathlength+2:dirpathlength+setnamelength+1) = setname(1
+     $:setnamelength)
+c      setpath(dirpathlength+setnamelength+2:dirpathlength+setnamelength+
+c     $2) = ":"
+c      write(*,*) setpath(1:dirpathlength+setnamelength+2)
+
+      call InitPDFsetM(nset,setpath(1:dirpathlength+setnamelength+1))
+      return
+      end
+c     ---------------------------------------------------------
+
+      subroutine InitPDFset(setpath)
+      implicit none
+      integer nset
+      character setpath*(*)
+      nset = 1
+      call InitPDFsetM(nset,setpath)
+      return
+      end      
+c
+      subroutine InitPDFsetM(nset,setpath)
+      implicit none
+      include 'parmsetup.inc'
+      character setpath*(*)
+      character*64 string
+      character*16 s1,s2
+      integer id,token,Ctoken
+      integer lhasilent
+      common/lhasilent/lhasilent
+      integer nset,imem
+c
+      call setnset(nset)
+c      
+      open(unit=1,file=setpath,status='old')
+      read(1,*) s1,s2
+      if ((index(s2,'1.0').ne.1)
+     +.and.(index(s2,'1.1').ne.1)
+     +.and.(index(s2,'2.0').ne.1)
+     +.and.(index(s2,'2.1').ne.1)
+     +.and.(index(s2,'3.0').ne.1) 
+     +.and.(index(s2,'3.1').ne.1)
+     +.and.(index(s2,'4.0').ne.1)
+     +.and.(index(s2,'5.0').ne.1))then
+         write(*,*) 
+     .        'Version ',s2,' not supported by this version of LHAPDF'
+         stop
+      else  
+       if(lhasilent.eq.0) then
+         write(*,*) '*************************************'
+         write(*,*) '*       LHAPDF Version 5.2.2          *'
+         write(*,*) '*************************************'
+         write(*,*)
+       endif
+      endif
+      id=Ctoken()
+ 1    read(1,*) string
+      id=token(string)
+c      print *,'id = ',id,string
+      if (id.eq.0) then
+         write(*,*) 'File description error:'
+         write(*,*) 'Command not understood: ',string
+         stop
+      endif
+      if (id.eq.1) call descriptionPDF(nset,id)
+c      print *,'1/2'
+      if (id.eq.2) call initEvolve(nset)
+c      print *,'2/3'
+      if (id.eq.3) call initAlphasPDF(nset)
+c      print *,'3/4'
+      if (id.eq.4) call initInputPDF(nset)
+c      print *,'4/5'
+      if (id.eq.5) call initListPDF(nset)
+c      print *,'5/6'
+      if (id.eq.6) call initQCDparams(nset)
+c      print *,'6/7'
+      if (id.ne.7) goto 1
+      close(1)
+c      print *,'calling InitEvolveCode',nset
+      call InitEvolveCode(nset)
+*
+      return
+      end
+*     
+      integer function token(s)
+      implicit none
+      character*16 s
+      integer not,i,Ctoken
+      parameter(not=7)
+      character*16 t(not)
+      data t/'Description:','Evolution:','Alphas:',
+     .                    'Parametrization:','Parameterlist:',
+     .                    'QCDparams:',
+     .                    'End:'/
+      integer count(not)
+      save count
+*
+      token=0
+      do i=1,not
+         if (s.eq.t(i)) token=i
+      enddo
+      if (token.ne.0) then
+         count(token)=count(token)+1
+         if (count(token).eq.2) then
+            write(*,*) 'File description error:'
+            write(*,*) 'Second definition of entry: ',s
+            stop
+         endif
+      endif
+      return
+*
+      entry Ctoken()
+      do i=1,not
+         count(i)=0
+      enddo
+      Ctoken=0
+      return
+*     
+      end
+c
+      subroutine LHAprint(iprint)
+      implicit none
+      integer lhasilent,iprint
+      common/lhasilent/lhasilent
+      lhasilent=iprint
+c      print *,'lhasilent',lhasilent
+      return
+      end
diff --git a/LHAPDF/lhapdf5.2.2/QCDNUM.f b/LHAPDF/lhapdf5.2.2/QCDNUM.f
new file mode 100644 (file)
index 0000000..5538c06
--- /dev/null
@@ -0,0 +1,26976 @@
+CDECK  ID>, QCDCOM.
+CDECK  ID>, QCDCOM.
+C------------------------QCDNUM COMMON BLOCKS---------------------
+CDECK  ID>, QCDNUM.
+
+CDECK  ID>, QNINIT.
+
+C     =================
+      SUBROUTINE QNINIT
+C     =================
+
+C---  QNINIT: initialisation.
+C---  Called by user.
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+      CHARACTER*8 CHVERS,CHDATE
+      COMMON/QCVERS/ CHVERS,CHDATE
+      COMMON/QCCONS/
+     +PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L,
+     +AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7),
+     +C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3,
+     +C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9,
+     +C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1,
+     +C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF
+      LOGICAL
+     +LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB,
+     +LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS,
+     +LALFOK,LDQ2OK,LWT1OK,LWT2OK,
+     +LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ,
+     +LFFCAL,LASOLD
+
+      COMMON/QCFLAG/ 
+     +IORD,IOLAST,
+     +LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB,
+     +LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS,
+     +LALFOK,LDQ2OK,LWT1OK,LWT2OK,
+     +LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ,
+     +LFFCAL(7,30),LASOLD
+      PARAMETER ( MXX = 410 )
+      PARAMETER ( MQ2 =  120 )
+
+C--   Do not set the following parameter to zero!
+      PARAMETER ( NDFMAX = 20)
+
+      COMMON/QCGRID/
+     +SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS,
+     +XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45,
+     +NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2),
+     +IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2)
+      REAL
+     +WGTFF1,WGTFG1,
+     +WGTGF1,WGTGG1,
+     +WGTPP2,WGTPM2,WGTNS2,
+     +WGTFF2,WGTFG2,
+     +WGTGF2,WGTGG2,
+     +WGTC2Q,WGTC2G,YNTC2Q,
+     +WGTCLQ,WGTCLG,WGTC3Q
+
+      COMMON/QCWEIT/
+     +WGTFF1(MXX*(MXX+1)/2)    ,WGTFG1(MXX*(MXX+1)/2,3:5),
+     +WGTGF1(MXX*(MXX+1)/2)    ,WGTGG1(MXX*(MXX+1)/2,3:5),
+     +WGTPP2(MXX*(MXX+1)/2,3:5),WGTPM2(MXX*(MXX+1)/2,3:5),
+     +WGTNS2(MXX*(MXX+1)/2,3:5),
+     +WGTFF2(MXX*(MXX+1)/2,3:5),WGTFG2(MXX*(MXX+1)/2,3:5),
+     +WGTGF2(MXX*(MXX+1)/2,3:5),WGTGG2(MXX*(MXX+1)/2,3:5),
+     +WGTC2Q(MXX*(MXX+1)/2)    ,WGTC2G(MXX*(MXX+1)/2,3:5),
+     +WGTCLQ(MXX*(MXX+1)/2)    ,WGTCLG(MXX*(MXX+1)/2,3:5),
+     +WGTC3Q(MXX*(MXX+1)/2)    ,YNTC2Q(MXX)
+
+      COMMON/QCWADR/ IWADR(MXX,MXX)
+
+      COMMON/QCPASS/
+     +ALPHA0, Q0ALFA, ASLAST, QALAST,
+     +ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2),
+     +DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10),
+     +FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2),
+     +FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2),
+     +FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2),
+     +FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST,
+     +MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2),
+     +ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2),
+     +IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10)
+
+      LOGICAL LEVDONE,LE_DONE
+      COMMON/QCLEVL/
+     +LEVDONE(MXX,10),LE_DONE(MXX)
+      CHARACTER*5 PNAM,STFNAM
+      LOGICAL     LNFP
+      COMMON /QCLNFP/ LNFP(0:30,3:5)
+      COMMON /QCPNAM/ PNAM(0:30)
+      COMMON /QCPWGT/ PWGT(0:10,0:30,3:5)
+      COMMON /QCFNAM/ STFNAM(7)
+      LOGICAL LTIME  
+      REAL T_START,T_END,T_SPENT
+      COMMON/QCTIME/T_START(10),T_END(10),T_SPENT(10),N_CALLS(10),
+     +E_CALLS(10),LTIME
+      COMMON/QCFCNT/IFCNT(-1:1,5)
+
+      CHARACTER*7 TSNAM
+      COMMON/QCTRCE/ TSNAM(0:19)
+      COMMON/QCTRCI/ NTCAL(0:19),ITADR
+c
+c common added by MRW 18/3/05 to make silent mode for LHAPDF
+c
+      common/lhasilent/lhasilent
+c 
+      CHVERS = '16.12   '
+      CHDATE = '12-08-98'
+      LDOUBL = .TRUE.
+      if(lhasilent.eq.0) then
+      WRITE(6,'(/////)')
+      WRITE(6,
+     &'(8X,''+-----------------------------------------------+'')')
+      WRITE(6,
+     &'(8X,''|                                               |'')')
+c      LDOUBL = .TRUE.
+      WRITE(6,
+     &'(8X,''| You are using the double precision version of |'')')
+      WRITE(6,
+     &'(8X,''|                                               |'')')
+      WRITE(6,
+     &'(8X,''|              Q C D N U M '',A8,
+     &     ''             |'')') CHVERS
+      WRITE(6,
+     &'(8X,''|                                               |'')')
+      WRITE(6,
+     &'(8X,''|         Author  : Michiel Botje               |'')')
+      WRITE(6,
+     &'(8X,''|         Email   : h24@nikhef.nl               |'')')
+      WRITE(6,
+     &'(8X,''|                                               |'')')
+      WRITE(6,
+     &'(8X,''|         Date    : '',A8,
+     &     ''                    |'')') CHDATE
+      WRITE(6,
+     &'(8X,''|         Max NX  : '',I3,
+     &     ''                         |'')') MXX-1
+      WRITE(6,
+     &'(8X,''|         Max NQ2 : '',I3,
+     &     ''                         |'')') MQ2-1
+      WRITE(6,
+     &'(8X,''|                                               |'')')
+      WRITE(6,
+     &'(8X,''+-----------------------------------------------+'')')
+      WRITE(6,'(/////)')
+      endif
+      IORD   = 2
+      IOLAST = -999
+      Q0ALFA = 50.
+      ALPHA0 = 0.180
+      QALAST = -999.
+      ASLAST = -999.
+      SCAX0  = 0.20
+      SCAQ0  = 1.D10
+      PI     = 3.14159265359
+      PROTON = 0.9382796
+      EUTRON = 0.9395731
+      UCLEON = (PROTON + EUTRON) / 2.
+      UDSCBT(1) = 0.005
+      UDSCBT(2) = 0.01
+      UDSCBT(3) = 0.3
+      UDSCBT(4) = 1.5
+      UDSCBT(5) = 5.0
+      UDSCBT(6) = 188.
+      CBMSTF(4) = UDSCBT(4)
+      CBMSTF(5) = UDSCBT(4)
+      CBMSTF(6) = UDSCBT(5)
+      CBMSTF(7) = UDSCBT(5)
+      CHARGE(4) = 4./9.
+      CHARGE(5) = 4./9.
+      CHARGE(6) = 1./9.
+      CHARGE(7) = 1./9.
+      AAM2H     = 1.
+      BBM2H     = 0.
+      AAM2L     = 1.
+      BBM2L     = 0.
+      AAAR2     = 1.
+      BBBR2     = 0.
+      FL_FAC    = 0.
+      C1S3   = 1./3.
+      C2S3   = 2./3.
+      C4S3   = 4./3.
+      C5S3   = 5./3.
+      C8S3   = 8./3.
+      C14S3  = 14./3.
+      C16S3  = 16./3.
+      C20S3  = 20./3.
+      C28S3  = 28./3.
+      C38S3  = 38./3.
+      C40S3  = 40./3.
+      C44S3  = 44./3.
+      C52S3  = 52./3.
+      C136S3 = 136./3.
+      C11S6  = 11./6.
+      C2S9   = 2./9.
+      C4S9   = 4./9.
+      C10S9  = 10./9.
+      C14S9  = 14./9.
+      C16S9  = 16./9.
+      C40S9  = 40./9.
+      C44S9  = 44./9.
+      C62S9  = 62./9.
+      C112S9 = 112./9.
+      C182S9 = 182./9.
+      C11S12 = 11./12.
+      C35S18 = 35./18.
+      C11S3  = 11./3.
+      C22S3  = 22./3.
+      C61S12 = 61./12.
+      C215S1 = 215./12.
+      C29S12 = 29./12.
+      CPI2S3 = PI**2/3.
+      CPIA   = 67./18. - CPI2S3/2.
+      CPIB   = 4.*CPI2S3
+      CPIC   = 17./18. + 3.5*CPI2S3
+      CPID   = 367./36. - CPI2S3
+      CPIE   = 5. - CPI2S3
+      CPIF   = CPI2S3 - 218./9.
+
+      CCA    = 3.
+      CCF    = (CCA*CCA-1.)/(2.*CCA)
+      CTF    = 0.5
+      CATF   = CCA*CTF
+      CFTF   = CCF*CTF
+      DO I = 1,10
+        T_SPENT(I) = 0.
+        E_CALLS(I) = 0.
+        N_CALLS(I) = 0
+      ENDDO
+      LTIME  = .FALSE.
+
+      LBMARK = .FALSE.
+      LW1ANA = .TRUE.
+      LW1NUM = .FALSE.
+      LW2NUM = .TRUE.
+      LW2STF = .TRUE.
+      LWF2C  = .FALSE.
+      LWF2B  = .FALSE.
+      LWFLC  = .FALSE.
+      LWFLB  = .FALSE.
+      LIMCK  = .TRUE.
+      LPLUS  = .TRUE.
+      LALFOK = .FALSE.
+      LDQ2OK = .FALSE.
+      LWT1OK = .FALSE.
+      LWT2OK = .FALSE.
+      LWTFOK = .FALSE.
+      LWFCOK = .FALSE.
+      LWLCOK = .FALSE.
+      LWFBOK = .FALSE.
+      LWLBOK = .FALSE.
+      LMARK  = .FALSE.
+      LCLOWQ = .TRUE.
+      LASOLD = .FALSE.
+      DO I = 1,30
+        DO J = 1,7
+          LFFCAL(J,I)  = .FALSE.
+        ENDDO
+      ENDDO
+C--   Invalidate all evolutions      
+      CALL QNFALS(LEVDONE,MXX*10)
+      CALL QNFALS(LE_DONE,MXX)
+      CALL QNINUL(IQL_LAST,10)
+      CALL QNINUL(IQ0_LAST,10)
+      CALL QNINUL(IQH_LAST,10)
+      ITADR = 0
+      DO I = 0,19
+        TSNAM(I) = '       '
+        NTCAL(I) = 0
+      ENDDO
+
+      NXX    = 0
+      NQ2    = 0
+      NGRVER = 0
+      NDFAST = 30
+      XMICUT = -1.
+      QMICUT = -1.
+      QMACUT = -1.
+      RS2CUT = -1.
+      QMINAS = 0.
+      THRS34 = -1.D10
+      THRS45 =  1.D10
+      CALL VZERO (WGTFF1,MXX*(MXX+1)/2)
+      CALL VZERO (WGTFG1,MXX*(MXX+1)*3/2)
+      CALL VZERO (WGTGF1,MXX*(MXX+1)/2)
+      CALL VZERO (WGTGG1,MXX*(MXX+1)*3/2)
+      CALL VZERO (WGTPP2,MXX*(MXX+1)*3/2)
+      CALL VZERO (WGTPM2,MXX*(MXX+1)*3/2)
+      CALL VZERO (WGTNS2,MXX*(MXX+1)*3/2)
+      CALL VZERO (WGTFF2,MXX*(MXX+1)*3/2)
+      CALL VZERO (WGTFG2,MXX*(MXX+1)*3/2)
+      CALL VZERO (WGTGF2,MXX*(MXX+1)*3/2)
+      CALL VZERO (WGTGG2,MXX*(MXX+1)*3/2)
+      CALL VZERO (WGTC2Q,MXX*(MXX+1)/2)
+      CALL VZERO (WGTC2G,MXX*(MXX+1)*3/2)
+      CALL VZERO (YNTC2Q,MXX)
+      CALL VZERO (WGTCLQ,MXX*(MXX+1)/2)
+      CALL VZERO (WGTCLG,MXX*(MXX+1)*3/2)
+      CALL VZERO (WGTC3Q,MXX*(MXX+1)/2)
+
+      CALL QNVNUL(PWGT,11*31*3)
+      CALL QNINUL(NFMAP,MQ2)
+      CALL QNINUL(MARKFF,MXX*MQ2)
+      CALL QNINUL(MARKFH,MXX*MQ2)
+      CALL QNINUL(MARKQQ,MQ2)
+      CALL QNINUL(IDFAST,7*30)
+      CALL QNINUL(IFCNT,3*5)  
+
+      CALL QNVNUL(PDFQCD,MXX*MQ2*11)
+      DO ID = 1,NDFMAX
+        DO IX = 1,MXX
+          DO IQ = 1,MQ2
+            FSTORE(IX,IQ,30+ID) = -501.
+          ENDDO
+        ENDDO
+      ENDDO
+
+      PNAM(0)   = 'GLUON'
+      PNAM(1)   = 'SINGL'
+      LNFP(0,3) = .TRUE.
+      LNFP(0,4) = .TRUE.
+      LNFP(0,5) = .TRUE.
+      LNFP(1,3) = .TRUE.
+      LNFP(1,4) = .TRUE.
+      LNFP(1,5) = .TRUE.
+      DO 10 I = 2,30
+        PNAM(I)   = 'FREE '
+        LNFP(I,3) = .FALSE.
+        LNFP(I,4) = .FALSE.
+        LNFP(I,5) = .FALSE.
+  10  CONTINUE
+      PWGT(0,0,3) = 1.
+      PWGT(0,0,4) = 1.
+      PWGT(0,0,5) = 1.
+      PWGT(1,1,3) = 1.
+      PWGT(1,1,4) = 1.
+      PWGT(1,1,5) = 1.
+      STFNAM(1)   = 'F2   '
+      STFNAM(2)   = 'FL   '
+      STFNAM(3)   = 'XF3  '
+      STFNAM(4)   = 'F2C  '
+      STFNAM(5)   = 'FLC  '
+      STFNAM(6)   = 'F2B  '
+      STFNAM(7)   = 'FLB  '
+
+      CALL QTRACE('QNINIT ',0)
+      RETURN
+      END
+CDECK  ID>, QTRACE.
+
+C     ===============================
+      SUBROUTINE QTRACE(SRNAM,IPRINT)
+C     ===============================
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+
+      CHARACTER*7 SRNAM
+
+      CHARACTER*7 TSNAM
+      COMMON/QCTRCE/ TSNAM(0:19)
+      COMMON/QCTRCI/ NTCAL(0:19),ITADR
+
+      IF(IPRINT.EQ.0) THEN
+
+        IF(SRNAM.EQ.TSNAM(ITADR)) THEN
+          NTCAL(ITADR) = NTCAL(ITADR) + 1
+        ELSE
+          ITADR = MOD(ITADR+1,20)
+          TSNAM(ITADR) = SRNAM
+          NTCAL(ITADR) = 1
+        ENDIF
+
+      ELSE
+
+        WRITE(6,'(/'' ----------------------------'')')
+
+        K = -20
+        DO I = ITADR+1,ITADR+19
+          J = MOD(I,20)
+          K = K+1
+          WRITE(6,'(I4,2X,A7,''  #calls = '',I5)')
+     +    K,TSNAM(J),NTCAL(J)
+        ENDDO
+        K = 0
+        WRITE(6,'(I4,2X,A7,''  #calls = '',I5,''  <--- error'')')
+     +  K,TSNAM(ITADR),NTCAL(ITADR)
+
+        WRITE(6,'( '' ----------------------------'')')
+
+      ENDIF
+
+      RETURN
+      END
+CDECK  ID>, QNDUMP.
+
+C     ======================
+      SUBROUTINE QNDUMP(LUN)
+C     ======================
+
+C---  QNDUMP: write weight tables to LUN.
+C---  Called by user.
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+      PARAMETER ( MXX = 410 )
+      PARAMETER ( MQ2 =  120 )
+
+C--   Do not set the following parameter to zero!
+      PARAMETER ( NDFMAX = 20)
+
+      CHARACTER*8 CHVERS,CHDATE
+      COMMON/QCVERS/ CHVERS,CHDATE
+      COMMON/QCCONS/
+     +PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L,
+     +AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7),
+     +C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3,
+     +C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9,
+     +C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1,
+     +C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF
+      LOGICAL
+     +LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB,
+     +LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS,
+     +LALFOK,LDQ2OK,LWT1OK,LWT2OK,
+     +LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ,
+     +LFFCAL,LASOLD
+
+      COMMON/QCFLAG/ 
+     +IORD,IOLAST,
+     +LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB,
+     +LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS,
+     +LALFOK,LDQ2OK,LWT1OK,LWT2OK,
+     +LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ,
+     +LFFCAL(7,30),LASOLD
+      COMMON/QCGRID/
+     +SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS,
+     +XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45,
+     +NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2),
+     +IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2)
+      REAL
+     +WGTFF1,WGTFG1,
+     +WGTGF1,WGTGG1,
+     +WGTPP2,WGTPM2,WGTNS2,
+     +WGTFF2,WGTFG2,
+     +WGTGF2,WGTGG2,
+     +WGTC2Q,WGTC2G,YNTC2Q,
+     +WGTCLQ,WGTCLG,WGTC3Q
+
+      COMMON/QCWEIT/
+     +WGTFF1(MXX*(MXX+1)/2)    ,WGTFG1(MXX*(MXX+1)/2,3:5),
+     +WGTGF1(MXX*(MXX+1)/2)    ,WGTGG1(MXX*(MXX+1)/2,3:5),
+     +WGTPP2(MXX*(MXX+1)/2,3:5),WGTPM2(MXX*(MXX+1)/2,3:5),
+     +WGTNS2(MXX*(MXX+1)/2,3:5),
+     +WGTFF2(MXX*(MXX+1)/2,3:5),WGTFG2(MXX*(MXX+1)/2,3:5),
+     +WGTGF2(MXX*(MXX+1)/2,3:5),WGTGG2(MXX*(MXX+1)/2,3:5),
+     +WGTC2Q(MXX*(MXX+1)/2)    ,WGTC2G(MXX*(MXX+1)/2,3:5),
+     +WGTCLQ(MXX*(MXX+1)/2)    ,WGTCLG(MXX*(MXX+1)/2,3:5),
+     +WGTC3Q(MXX*(MXX+1)/2)    ,YNTC2Q(MXX)
+
+      COMMON/QCWADR/ IWADR(MXX,MXX)
+
+
+      REAL
+     +WH_C0KG,WH_C1KG,WH_C1BKG,
+     +WH_C1KQ,WH_C1BKQ,WH_D1KQ,WH_D1BKQ
+
+      COMMON/QCHWGT/
+     +WH_C0KG(0:MXX,MQ2,4:7),
+     +WH_C1KG(0:MXX,MQ2,4:7),WH_C1BKG(0:MXX,MQ2,4:7),
+     +WH_C1KQ(0:MXX,MQ2,4:7),WH_C1BKQ(0:MXX,MQ2,4:7),
+     +WH_D1KQ(0:MXX,MQ2,4:7),WH_D1BKQ(0:MXX,MQ2,4:7)
+
+
+      DIMENSION STOREM(6)
+
+      CALL QTRACE('QNDUMP ',0)
+
+      STOREM(1) = CBMSTF(4)
+      STOREM(2) = CBMSTF(6)
+      STOREM(3) = 0.
+      STOREM(4) = 0.
+      STOREM(5) = 0.
+      STOREM(6) = 0.
+
+      WRITE(LUN) MXX,MQ2
+      WRITE(LUN) CHVERS,CHDATE
+      WRITE(LUN) STOREM
+      WRITE(LUN) LWT1OK,LWT2OK,LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,
+     +           LPLUS
+      WRITE(LUN) XXTAB,Q2TAB,
+     +           NXX,NQ2,IQF2C,IQF2B,IQFLC,IQFLB
+      IF(LWT1OK) THEN
+      WRITE(LUN) WGTFF1,WGTFG1,WGTGF1,WGTGG1
+      ENDIF
+      IF(LWT2OK) THEN
+      WRITE(LUN) WGTPP2,WGTPM2,WGTNS2,WGTFF2,WGTFG2,WGTGF2,WGTGG2
+      ENDIF
+      IF(LWTFOK) THEN
+      WRITE(LUN) WGTC2Q,WGTC2G,YNTC2Q,WGTCLQ,WGTCLG,WGTC3Q
+      ENDIF
+      IF(LWFCOK.OR.LWLCOK.OR.LWFBOK.OR.LWLBOK) THEN
+      WRITE(LUN) WH_C0KG,WH_C1KG,WH_C1BKG,
+     +           WH_C1KQ,WH_C1BKQ,WH_D1KQ,WH_D1BKQ
+      ENDIF
+      RETURN
+      END
+CDECK  ID>, QNREAD.
+
+C     =================================
+      SUBROUTINE QNREAD(LUN,ISTOP,IERR)
+C     =================================
+
+C---  QNDUMP: read weight tables from LUN.
+C---  Called by user.
+C---  Input  integer LUN
+C---         integer ISTOP = 0 read the file
+C---                 ISTOP = 1 read only when ierr = 0
+C---                 ISTOP = 2 stop the program when ierr .ne. 0
+C---  Output integer IERR  = 0 all ok
+C---                       = 1 xgrid on file .ne. that in QCDNUM
+C---                       = 2 file contains heavy quark weight tables and
+C---                           qgrid on file .ne. that in QCDNUM
+C---                       = 3 file contains charm weight tables and
+C---                           c mass on the file .ne. that in QCDNUM
+C---                       = 4 file contains bottom weight tables and
+C---                           b mass on the file .ne. that in QCDNUM
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+      PARAMETER ( MXX = 410 )
+      PARAMETER ( MQ2 =  120 )
+
+C--   Do not set the following parameter to zero!
+      PARAMETER ( NDFMAX = 20)
+
+      CHARACTER*8 CHVERS,CHDATE
+      COMMON/QCVERS/ CHVERS,CHDATE
+      COMMON/QCCONS/
+     +PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L,
+     +AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7),
+     +C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3,
+     +C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9,
+     +C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1,
+     +C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF
+      LOGICAL
+     +LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB,
+     +LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS,
+     +LALFOK,LDQ2OK,LWT1OK,LWT2OK,
+     +LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ,
+     +LFFCAL,LASOLD
+
+      COMMON/QCFLAG/ 
+     +IORD,IOLAST,
+     +LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB,
+     +LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS,
+     +LALFOK,LDQ2OK,LWT1OK,LWT2OK,
+     +LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ,
+     +LFFCAL(7,30),LASOLD
+      COMMON/QCGRID/
+     +SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS,
+     +XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45,
+     +NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2),
+     +IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2)
+      REAL
+     +WGTFF1,WGTFG1,
+     +WGTGF1,WGTGG1,
+     +WGTPP2,WGTPM2,WGTNS2,
+     +WGTFF2,WGTFG2,
+     +WGTGF2,WGTGG2,
+     +WGTC2Q,WGTC2G,YNTC2Q,
+     +WGTCLQ,WGTCLG,WGTC3Q
+
+      COMMON/QCWEIT/
+     +WGTFF1(MXX*(MXX+1)/2)    ,WGTFG1(MXX*(MXX+1)/2,3:5),
+     +WGTGF1(MXX*(MXX+1)/2)    ,WGTGG1(MXX*(MXX+1)/2,3:5),
+     +WGTPP2(MXX*(MXX+1)/2,3:5),WGTPM2(MXX*(MXX+1)/2,3:5),
+     +WGTNS2(MXX*(MXX+1)/2,3:5),
+     +WGTFF2(MXX*(MXX+1)/2,3:5),WGTFG2(MXX*(MXX+1)/2,3:5),
+     +WGTGF2(MXX*(MXX+1)/2,3:5),WGTGG2(MXX*(MXX+1)/2,3:5),
+     +WGTC2Q(MXX*(MXX+1)/2)    ,WGTC2G(MXX*(MXX+1)/2,3:5),
+     +WGTCLQ(MXX*(MXX+1)/2)    ,WGTCLG(MXX*(MXX+1)/2,3:5),
+     +WGTC3Q(MXX*(MXX+1)/2)    ,YNTC2Q(MXX)
+
+      COMMON/QCWADR/ IWADR(MXX,MXX)
+
+
+      REAL
+     +WH_C0KG,WH_C1KG,WH_C1BKG,
+     +WH_C1KQ,WH_C1BKQ,WH_D1KQ,WH_D1BKQ
+
+      COMMON/QCHWGT/
+     +WH_C0KG(0:MXX,MQ2,4:7),
+     +WH_C1KG(0:MXX,MQ2,4:7),WH_C1BKG(0:MXX,MQ2,4:7),
+     +WH_C1KQ(0:MXX,MQ2,4:7),WH_C1BKQ(0:MXX,MQ2,4:7),
+     +WH_D1KQ(0:MXX,MQ2,4:7),WH_D1BKQ(0:MXX,MQ2,4:7)
+
+      COMMON/QCPASS/
+     +ALPHA0, Q0ALFA, ASLAST, QALAST,
+     +ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2),
+     +DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10),
+     +FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2),
+     +FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2),
+     +FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2),
+     +FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST,
+     +MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2),
+     +ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2),
+     +IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10)
+
+      LOGICAL LEVDONE,LE_DONE
+      COMMON/QCLEVL/
+     +LEVDONE(MXX,10),LE_DONE(MXX)
+
+      CHARACTER*8 RHVERS,RHDATE
+      LOGICAL     RWT1OK,RWT2OK,RWTFOK,RWFCOK
+      LOGICAL     RWLCOK,RWFBOK,RWLBOK,RPLUS
+      LOGICAL     LREADX,LREADQ,LREADB,LREADC
+      DIMENSION   RMASS(6)
+      DIMENSION   RXTAB(MXX),RQTAB(MQ2)
+      DIMENSION   IRF2C(MQ2),IRF2B(MQ2),IRFLC(MQ2),IRFLB(MQ2)
+c
+c common added 18/3/05 by MRW
+      common/lhasilent/lhasilent
+
+      CALL QTRACE('QNREAD ',0)
+
+      REWIND LUN
+
+C--   Setup the weight adresses
+C--   (Usually done in QNFILW, but this routine might not be called)
+      DO IX0 = 1,MXX
+        DO IX = IX0,MXX
+          IWADR(IX,IX0) = IWTAD(IX,IX0)
+        ENDDO
+      ENDDO
+
+C--   Read header information
+      READ(LUN,ERR=500) KXX,KQ2
+      IF(KXX.NE.MXX.OR.KQ2.NE.MQ2) THEN
+        WRITE(6,'(/'' QNREAD: nxmax, nqmax on file  '',2I5,
+     +            /''         nxmax, nqmax in QCDNUM'',2I5,
+     +            /''         Incompatible ---> STOP'')') 
+     +                        KXX,KQ2,MXX,MQ2
+        STOP
+      ENDIF
+      READ(LUN,ERR=500) RHVERS,RHDATE
+      READ(RHVERS(1:2),'(I2)') IV
+
+C--   If ISTOP > 0 : stop when fileversion = QCDNUM15 or lower
+C--   If ISTOP = 0 : read up to the weight tables
+      IF(IV.LE.15.AND.ISTOP.NE.0) THEN
+        WRITE(6,'(/'' QNREAD: file was written with QCDNUM'',A8,
+     +             '' Incompatible ---> STOP'')')
+     +   RHVERS
+        STOP   
+      ENDIF
+      if(lhasilent.eq.0) 
+     + WRITE(6,'(/'' QNREAD: file was written with QCDNUM'',A8)')
+     + RHVERS
+
+      READ(LUN,ERR=500) RMASS  
+      READ(LUN,ERR=500) RWT1OK,RWT2OK,RWTFOK,RWFCOK,RWLCOK,RWFBOK,
+     +                  RWLBOK,RPLUS
+      READ(LUN,ERR=500) RXTAB,RQTAB,
+     +                  NRX,NRQ,IRF2C,IRF2B,IRFLC,IRFLB
+
+      IERR   = 0
+      LREADX = .FALSE.
+      LREADQ = .FALSE.
+      LREADC = .FALSE.
+      LREADB = .FALSE.
+
+C--   Check xgrid (if there is one already defined)  
+      IF(NXX.NE.0)     THEN
+        IF(NXX.NE.NRX) THEN
+          IERR = 1
+        ELSE
+          DO IX = 1,NXX
+            IF(RXTAB(IX).NE.XXTAB(IX)) IERR = 1
+          ENDDO
+        ENDIF
+      ENDIF
+
+C--   What to do when xgrid is different
+      IF(IERR.EQ.1) THEN
+        IF(ISTOP.EQ.1) THEN
+          WRITE(6,'(/
+     +    '' QNREAD: X grid in memory different from that on file'',
+     +    '' ---> abandon reading'')')
+          RETURN
+        ENDIF
+        IF(ISTOP.EQ.2) THEN
+          WRITE(6,'(/
+     +    '' QNREAD: X grid in memory different from that on file'',
+     +    '' ---> STOP'')')
+          STOP
+        ENDIF
+      ENDIF
+
+      IF(IERR.EQ.1.OR.NXX.LE.0) LREADX = .TRUE.
+
+C--   Check Q2 grid if there is one already defined and if there are
+C--   heavy quark weight tables on the file
+      IF(NQ2.NE.0.AND.(RWFCOK.OR.RWLCOK.OR.RWFBOK.OR.RWLBOK)) THEN
+        IF(NQ2.NE.NRQ) THEN
+          IERR = 2
+        ELSE
+          DO IQ = 1,NQ2
+            IF(RQTAB(IQ).NE.Q2TAB(IQ)) IERR = 2
+          ENDDO
+        ENDIF
+      ENDIF
+
+C--   What to do when qgrid is different
+      IF(IERR.EQ.2) THEN
+        IF(ISTOP.EQ.1) THEN
+          WRITE(6,'(/
+     +    '' QNREAD: Q2 grid in memory different from that on file'',
+     +    '' ---> abandon reading'')')
+          RETURN
+        ENDIF
+        IF(ISTOP.EQ.2) THEN
+          WRITE(6,'(/
+     +    '' QNREAD: Q2 grid in memory different from that on file'',
+     +    '' ---> STOP'')')
+          STOP
+        ENDIF
+      ENDIF
+
+      IF(IERR.EQ.2.OR.NQ2.LE.0) LREADQ = .TRUE.
+
+C--   Check charm mass if there are charm weight tables on the file
+      IF(RWFCOK.OR.RWLCOK) THEN
+        IF(IV.LE.15) THEN
+          IF(RMASS(4).NE.CBMSTF(4)) IERR = 3
+        ELSE
+          IF(RMASS(1).NE.CBMSTF(4)) IERR = 3
+        ENDIF
+      ENDIF
+
+C--   What to do when charm mass is different
+      IF(IERR.EQ.3) THEN
+        IF(ISTOP.EQ.1) THEN
+          WRITE(6,'(/
+     +    '' QNREAD: Charm mass in memory different from that on file'',
+     +    '' ---> abandon reading'')')
+          RETURN
+        ENDIF
+        IF(ISTOP.EQ.2) THEN
+          WRITE(6,'(/
+     +    '' QNREAD: Charm mass in memory different from that on'',
+     +    '' file ---> STOP'')')
+          STOP
+        ENDIF
+        LREADC = .TRUE.
+      ENDIF
+
+C--   Check bottom mass if there are bottom weight tables on the file
+      IF(RWFBOK.OR.RWLBOK) THEN
+        IF(IV.LE.15) THEN
+          IF(RMASS(5).NE.CBMSTF(6)) IERR = 4
+        ELSE
+          IF(RMASS(2).NE.CBMSTF(6)) IERR = 4
+        ENDIF
+      ENDIF
+
+C--   What to do when bottom mass is different
+      IF(IERR.EQ.4) THEN
+        IF(ISTOP.EQ.1) THEN
+          WRITE(6,'(/
+     +    '' QNREAD: Bottom mass in memory different from that on'',
+     +    '' file ---> abandon reading'')')
+          RETURN
+        ENDIF
+        IF(ISTOP.EQ.2) THEN
+          WRITE(6,'(/
+     +    '' QNREAD: Bottom mass in memory different from that on'',
+     +    '' file ---> STOP'')')
+          STOP
+        ENDIF
+        LREADB = .TRUE.
+      ENDIF
+
+C--   ok..... continue.......
+      LPLUS  = RPLUS
+C--   Invalidate all evolutions      
+      CALL QNFALS(LEVDONE,MXX*10)
+
+      IF(LREADX) THEN
+C--     Copy xgrid to qcdnum common block
+        NXX = NRX
+        DO IX = 1,NXX+1
+          XXTAB(IX) = RXTAB(IX)
+        ENDDO
+        WRITE(6,'(/
+     +    '' QNREAD: xgrid table read in (original overwritten)'')')
+C--     Invalidate all weight tables since the grid has changed 
+        LWT1OK = .FALSE.
+        LWT2OK = .FALSE.
+        LWTFOK = .FALSE.
+        LWFCOK = .FALSE.
+        LWLCOK = .FALSE.
+        LWFBOK = .FALSE.
+        LWLBOK = .FALSE.
+        LMARK  = .FALSE.
+        NGRVER = NGRVER+1
+C--     Invalidate all evolutions      
+        CALL QNFALS(LEVDONE,MXX*10)
+C---    Update IFAILC
+        CALL GRSETC
+C---    Update NFMAP
+        CALL QNSETT
+C---    Update heavy quark xgrid
+        CALL GXHDEF
+      ENDIF
+
+      IF(LREADQ) THEN
+C--     Copy q2 grid to common block
+        NQ2 = NRQ
+        DO IQ = 1,NQ2
+          Q2TAB(IQ) = RQTAB(IQ)
+        ENDDO
+        WRITE(6,'(/
+     +    '' QNREAD: qgrid table read in (original overwritten)'')')
+C--     Invalidate hq weight tables since the grid has changed
+        LALFOK = .FALSE.
+        LDQ2OK = .FALSE.
+        LWFCOK = .FALSE.
+        LWLCOK = .FALSE.
+        LWFBOK = .FALSE.
+        LWLBOK = .FALSE.
+        LMARK  = .FALSE.
+        NGRVER = NGRVER + 1
+C--     Invalidate all evolutions      
+        CALL QNFALS(LEVDONE,MXX*10)
+C---    Update IFAILC
+        CALL GRSETC
+C---    Update NFMAP
+        CALL QNSETT
+      ENDIF
+
+      IF(LREADC) THEN
+        IF(IV.LE.15) THEN
+          UDSCBT(4) = RMASS(4)
+          CBMSTF(4) = RMASS(4)
+          CBMSTF(5) = RMASS(4)
+        ELSE
+          CBMSTF(4) = RMASS(1)
+          CBMSTF(5) = RMASS(1)
+        ENDIF
+        WRITE(6,'(/
+     +    '' QNREAD: charm mass read in (original overwritten)'')')
+C--     Invalidate charm weight tables since charm mass has changed
+        LWFCOK = .FALSE.
+        LWLCOK = .FALSE.
+C--     Invalidate alpha_s table
+        LALFOK = .FALSE.
+      ENDIF
+
+      IF(LREADB) THEN
+        IF(IV.LE.15) THEN
+          UDSCBT(5) = RMASS(5)
+          CBMSTF(6) = RMASS(5)
+          CBMSTF(7) = RMASS(5)
+        ELSE
+          CBMSTF(6) = RMASS(2)
+          CBMSTF(7) = RMASS(2)
+        ENDIF
+        WRITE(6,'(/
+     +    '' QNREAD: bottom mass read in (original overwritten)'')')
+C--     Invalidate bottom weight tables since charm mass has changed
+        LWFBOK = .FALSE.
+        LWLBOK = .FALSE.
+C--     Invalidate alpha_s table
+        LALFOK = .FALSE.
+      ENDIF
+
+      IF(IV.LE.15) THEN
+        WRITE(6,'(/'' QNREAD: file was written with QCDNUM'',A8)')
+     +   RHVERS
+        WRITE(6,'( '' ------> Abandon reading the weight tables'')')
+        RETURN
+      ENDIF
+
+      IF(RWT1OK) THEN
+        READ(LUN,ERR=500) WGTFF1,WGTFG1,WGTGF1,WGTGG1
+        LWT1OK = .TRUE.
+        if(lhasilent.eq.0) 
+     +   WRITE(6,'(/'' QNREAD: LO weight tables read in'')')
+      ENDIF
+
+      IF(RWT2OK) THEN
+        READ(LUN,ERR=500) WGTPP2,WGTPM2,WGTNS2,WGTFF2,WGTFG2,WGTGF2,
+     +                    WGTGG2
+        LWT2OK = .TRUE.
+        if(lhasilent.eq.0) 
+     +   WRITE(6,'(/'' QNREAD: NLO weight tables read in'')')
+      ENDIF
+
+      IF(RWTFOK) THEN
+        READ(LUN,ERR=500) WGTC2Q,WGTC2G,YNTC2Q,WGTCLQ,WGTCLG,WGTC3Q
+        LWTFOK = .TRUE.
+        if(lhasilent.eq.0) 
+     +   WRITE(6,'(/'' QNREAD: F2, FL weight tables read in'')')
+      ENDIF
+
+      IF(RWFCOK.OR.RWLCOK.OR.RWFBOK.OR.RWLBOK) THEN
+        READ(LUN,ERR=500) WH_C0KG,WH_C1KG,WH_C1BKG,
+     +                    WH_C1KQ,WH_C1BKQ,WH_D1KQ,WH_D1BKQ
+        LWFCOK = RWFCOK
+        LWLCOK = RWLCOK
+        LWFBOK = RWFBOK
+        LWLBOK = RWLBOK
+        if(lhasilent.eq.0) then 
+        IF(RWFCOK)
+     +  WRITE(6,'(/'' QNREAD: F2C weight tables read in'')')
+        IF(RWLCOK)
+     +  WRITE(6,'(/'' QNREAD: FLC weight tables read in'')')
+        IF(RWFBOK)
+     +  WRITE(6,'(/'' QNREAD: F2B weight tables read in'')')
+        IF(RWLBOK)
+     +  WRITE(6,'(/'' QNREAD: FLB weight tables read in'')')
+        endif
+      ENDIF
+
+      RETURN
+
+ 500  CONTINUE
+      WRITE(6,'(/'' QNREAD: cannot read file on lun = '',I5,
+     +           '' ---> STOP'')') LUN
+
+      CALL QTRACE('QNREAD ',1)
+
+      STOP
+      END
+
+CDECK  ID>, QNPRIN.
+C
+C     ======================
+      SUBROUTINE QNPRIN(LUN)
+C     ======================
+C---  QNPRIN: print default + current setting of QCDNUM parameters.
+C---  Called by QPRINT
+C---  Input parameter: LUN. To be opened by user unless LUN = 6.
+
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+
+      LOGICAL
+     +LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB,
+     +LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS,
+     +LALFOK,LDQ2OK,LWT1OK,LWT2OK,
+     +LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ,
+     +LFFCAL,LASOLD
+
+      COMMON/QCFLAG/ 
+     +IORD,IOLAST,
+     +LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB,
+     +LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS,
+     +LALFOK,LDQ2OK,LWT1OK,LWT2OK,
+     +LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ,
+     +LFFCAL(7,30),LASOLD
+      COMMON/QCCONS/
+     +PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L,
+     +AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7),
+     +C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3,
+     +C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9,
+     +C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1,
+     +C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF
+      PARAMETER ( MXX = 410 )
+      PARAMETER ( MQ2 =  120 )
+
+C--   Do not set the following parameter to zero!
+      PARAMETER ( NDFMAX = 20)
+
+      COMMON/QCGRID/
+     +SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS,
+     +XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45,
+     +NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2),
+     +IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2)
+      COMMON/QCPASS/
+     +ALPHA0, Q0ALFA, ASLAST, QALAST,
+     +ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2),
+     +DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10),
+     +FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2),
+     +FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2),
+     +FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2),
+     +FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST,
+     +MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2),
+     +ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2),
+     +IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10)
+
+      LOGICAL LEVDONE,LE_DONE
+      COMMON/QCLEVL/
+     +LEVDONE(MXX,10),LE_DONE(MXX)
+
+      IF(RS2CUT.GE.0.) THEN
+        RS2C = SQRT(RS2CUT)
+      ELSE
+        RS2C = RS2CUT
+      ENDIF
+
+      WRITE(LUN,'(//'' +-------+---+-------+--------------+'',
+     + ''------------------------------------+'')')
+      WRITE(LUN,'(  '' | var   |typ| deflt |     value    |'',
+     + '' description                        |'')')
+      WRITE(LUN,'(  '' +-------+---+-------+--------------+'',
+     + ''------------------------------------+'')')
+      WRITE(LUN,'('' | W1ANA | L |   T   | '',6X,L1,5X,
+     + '' | Analytical LO weight calculation   |'')') LW1ANA
+      WRITE(LUN,'('' | W1NUM | L |   F   | '',6X,L1,5X,
+     + '' | Numerical  LO weight calculation   |'')') LW1NUM
+      WRITE(LUN,'('' | W2NUM | L |   T   | '',6X,L1,5X,
+     + '' | Numerical NLO weight calculation   |'')') LW2NUM
+      WRITE(LUN,'('' | W2STF | L |   T   | '',6X,L1,5X,
+     + '' | Structure function NLO weights     |'')') LW2STF
+      WRITE(LUN,'('' | WTF2C | L |   F   | '',6X,L1,5X,
+     + '' | F2_charm  weight calculation       |'')') LWF2C 
+      WRITE(LUN,'('' | WTF2B | L |   F   | '',6X,L1,5X,
+     + '' | F2_bottom weight calculation       |'')') LWF2B 
+      WRITE(LUN,'('' | WTFLC | L |   F   | '',6X,L1,5X,
+     + '' | FL_charm  weight calculation       |'')') LWFLC 
+      WRITE(LUN,'('' | WTFLB | L |   F   | '',6X,L1,5X,
+     + '' | FL_bottom weight calculation       |'')') LWFLB 
+      WRITE(LUN,'('' | LIMCK | L |   T   | '',6X,L1,5X,
+     + '' | Check x, Q2 limits and cuts        |'')') LIMCK 
+      WRITE(LUN,'('' | CLOWQ | L |   T   | '',6X,L1,5X,
+     + '' | Heavy F2,FL only for Q2 > 1.5 GeV2 |'')') LCLOWQ
+      WRITE(LUN,'('' | ORDER | I |   2   | '',6X,I1,5X,
+     + '' | LO (1) or NLO (2) calculations     |'')') IORD  
+      WRITE(LUN,'('' | SCAX0 | R |  0.20 | '',E12.5,
+     + '' | x-grid  scale from log --> linear  |'')') SCAX0
+      WRITE(LUN,'('' | SCAQ0 | R | +inf  | '',E12.5,
+     + '' | Q2-grid scale from log --> linear  |'')') SCAQ0
+      WRITE(LUN,'('' | MCSTF | R |  1.5  | '',E12.5,
+     + '' | C mass for F2c, FLc (GeV)          |'')') CBMSTF(4)
+      WRITE(LUN,'('' | MBSTF | R |  5.0  | '',E12.5,
+     + '' | B mass for F2b, FLb (GeV)          |'')') CBMSTF(6)
+      WRITE(LUN,'('' | MCALF | R |  1.5  | '',E12.5,
+     + '' | C mass for alpha_s evolution (GeV) |'')') UDSCBT(4)
+      WRITE(LUN,'('' | MBALF | R |  5.0  | '',E12.5,
+     + '' | B mass for alpha_s evolution (GeV) |'')') UDSCBT(5)
+      WRITE(LUN,'('' | MTALF | R | 188.  | '',E12.5,
+     + '' | T mass for alpha_s evolution (GeV) |'')') UDSCBT(6)
+      WRITE(LUN,'('' | ALFAS | R | 0.180 | '',E12.5,
+     + '' | Value of alpha_s                   |'')') ALPHA0   
+      WRITE(LUN,'('' | ALFQ0 | R |  50.  | '',E12.5,
+     + '' | Q2 where alpha_s is given (GeV2)   |'')') Q0ALFA   
+      WRITE(LUN,'('' | AAAR2 | R |  1.0  | '',E12.5,
+     + '' | R2 = A*M2 + B (ren. scale)         |'')') AAAR2
+      WRITE(LUN,'('' | BBBR2 | R |  0.0  | '',E12.5,
+     + '' | R2 = A*M2 + B (ren. scale)         |'')') BBBR2
+      WRITE(LUN,'('' | AAM2L | R |  1.0  | '',E12.5,
+     + '' | M2 = A*Q2 + B (light fact. scale)  |'')') AAM2L
+      WRITE(LUN,'('' | BBM2L | R |  0.0  | '',E12.5,
+     + '' | M2 = A*Q2 + B (light fact. scale)  |'')') BBM2L
+      WRITE(LUN,'('' | AAM2H | R |  1.0  | '',E12.5,
+     + '' | M2 = A*Q2 + B (heavy fact. scale)  |'')') AAM2H
+      WRITE(LUN,'('' | BBM2H | R |  0.0  | '',E12.5,
+     + '' | M2 = A*Q2 + B (heavy fact. scale)  |'')') BBM2H
+      WRITE(LUN,'(  '' +-------+---+-------+--------------+'',
+     + ''------------------------------------+'')')
+      WRITE(LUN,'('' | TCHRM | R | -inf  | '',E12.5,
+     + '' | Charm threshold  (GeV2)            |'')') THRS34
+      WRITE(LUN,'('' | TBOTT | R | +inf  | '',E12.5,
+     + '' | Bottom threshold (GeV2)            |'')') THRS45
+      WRITE(LUN,'('' | XMINC | R |  0.0  | '',E12.5,
+     + '' | Xmin cut  (.le.0 = no cut)         |'')') XMICUT
+      WRITE(LUN,'('' | QMINC | R |  0.0  | '',E12.5,
+     + '' | Qmin cut  (.le.0 = no cut)         |'')') QMICUT
+      WRITE(LUN,'('' | QMAXC | R |  0.0  | '',E12.5,
+     + '' | Qmax cut  (.le.0 = no cut)         |'')') QMACUT
+      WRITE(LUN,'('' | ROOTS | R |  0.0  | '',E12.5,
+     + '' | Roots cut (.le.0 = no cut)         |'')') RS2C
+      WRITE(LUN,'('' | QMINA | R |  0.0  | '',E12.5,
+     + '' | Lowest Q2 gridpoint above Lambda2  |'')') QMINAS
+      WRITE(LUN,'(  '' +-------+---+-------+--------------+'',
+     + ''------------------------------------+'')')
+      WRITE(LUN,'('' | ASOLD | L |   F   | '',6X,L1,5X,
+     + '' | Use old (incorrect) a_s evolution  |'')') LASOLD
+      WRITE(LUN,'('' | BMARK | L |   F   | '',6X,L1,5X,
+     + '' | Do not use: for tests only         |'')') LBMARK
+      WRITE(LUN,'('' | FLFAC | R |  0.0  | '',E12.5,
+     + '' | Hands off : for experts only       |'')') BBM2H
+      WRITE(LUN,'(  '' +-------+---+-------+--------------+'',
+     + ''------------------------------------+'')')
+
+      RETURN
+      END
+
+CDECK  ID>, QNVERS.
+C
+C     ==============================================
+      SUBROUTINE QNVERS(VERSION,LDOUBLE,NXMAX,NQMAX)
+C     ==============================================
+
+C---  QNVERS: return version number, dp flag and max # of gridpoints.
+C---  Called by user.
+C---  Output variables: VERSION (character*8)
+C---                    LDOUBLE (logical)
+C---                    NXMAX, NQMAX (integer); set by parameter
+C---                    statement in common block QCNXQM.
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+
+      CHARACTER*8 VERSION
+      LOGICAL     LDOUBLE
+      CHARACTER*8 CHVERS,CHDATE
+      COMMON/QCVERS/ CHVERS,CHDATE
+      LOGICAL
+     +LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB,
+     +LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS,
+     +LALFOK,LDQ2OK,LWT1OK,LWT2OK,
+     +LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ,
+     +LFFCAL,LASOLD
+
+      COMMON/QCFLAG/ 
+     +IORD,IOLAST,
+     +LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB,
+     +LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS,
+     +LALFOK,LDQ2OK,LWT1OK,LWT2OK,
+     +LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ,
+     +LFFCAL(7,30),LASOLD
+      PARAMETER ( MXX = 410 )
+      PARAMETER ( MQ2 =  120 )
+
+C--   Do not set the following parameter to zero!
+      PARAMETER ( NDFMAX = 20)
+
+
+      CALL QTRACE('QNVERS ',0)
+      VERSION = CHVERS
+      LDOUBLE = LDOUBL
+      NXMAX   = MXX-1
+      NQMAX   = MQ2-1
+      RETURN
+      END
+CDECK  ID>, QPRINT.
+C     ==========================
+      SUBROUTINE QPRINT(LUN,OPT)
+C     ==========================
+
+C---  QPRINT: steering routine to print various QCDNUM info on
+C--           logical unit number LUN (to be opened by the user).
+C---  Called by user.
+C---  Input integer LUN  :  locical unit number.
+C---        character OPT: 'A' (All)        print all info.
+C---                       'B' (Booklist)   print pdf definitions.
+C---                       'P' (Parameters) Parameter/option list.
+C---                       'S' (Statistics) # STF function calls.
+C---                       'T' (Timelog)    timelog.
+C---                       'X' (Xq2grid)    grid,thresholds,cuts.
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+      CHARACTER*(*) OPT
+      CHARACTER*1   OPT1
+      LOGICAL LTIME  
+      REAL T_START,T_END,T_SPENT
+      COMMON/QCTIME/T_START(10),T_END(10),T_SPENT(10),N_CALLS(10),
+     +E_CALLS(10),LTIME
+      COMMON/QCFCNT/IFCNT(-1:1,5)
+
+      PARAMETER ( MXX = 410 )
+      PARAMETER ( MQ2 =  120 )
+
+C--   Do not set the following parameter to zero!
+      PARAMETER ( NDFMAX = 20)
+
+      COMMON/QCGRID/
+     +SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS,
+     +XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45,
+     +NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2),
+     +IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2)
+      REAL
+     +WGTFF1,WGTFG1,
+     +WGTGF1,WGTGG1,
+     +WGTPP2,WGTPM2,WGTNS2,
+     +WGTFF2,WGTFG2,
+     +WGTGF2,WGTGG2,
+     +WGTC2Q,WGTC2G,YNTC2Q,
+     +WGTCLQ,WGTCLG,WGTC3Q
+
+      COMMON/QCWEIT/
+     +WGTFF1(MXX*(MXX+1)/2)    ,WGTFG1(MXX*(MXX+1)/2,3:5),
+     +WGTGF1(MXX*(MXX+1)/2)    ,WGTGG1(MXX*(MXX+1)/2,3:5),
+     +WGTPP2(MXX*(MXX+1)/2,3:5),WGTPM2(MXX*(MXX+1)/2,3:5),
+     +WGTNS2(MXX*(MXX+1)/2,3:5),
+     +WGTFF2(MXX*(MXX+1)/2,3:5),WGTFG2(MXX*(MXX+1)/2,3:5),
+     +WGTGF2(MXX*(MXX+1)/2,3:5),WGTGG2(MXX*(MXX+1)/2,3:5),
+     +WGTC2Q(MXX*(MXX+1)/2)    ,WGTC2G(MXX*(MXX+1)/2,3:5),
+     +WGTCLQ(MXX*(MXX+1)/2)    ,WGTCLG(MXX*(MXX+1)/2,3:5),
+     +WGTC3Q(MXX*(MXX+1)/2)    ,YNTC2Q(MXX)
+
+      COMMON/QCWADR/ IWADR(MXX,MXX)
+
+
+      CALL QTRACE('QPRINT ',0)
+      IF(LENOCC_LHA(OPT).LT.1) GOTO 500
+      OPT1 = OPT(1:1)
+      CALL CLTOU_LHA(OPT1)
+      IF(OPT1.EQ.'T') THEN !
+        CALL QPTIME(LUN)
+      ELSEIF(OPT1.EQ.'P') THEN
+        CALL QNPRIN(LUN)
+      ELSEIF(OPT1.EQ.'B') THEN
+        CALL QNLIST(LUN)
+      ELSEIF(OPT1.EQ.'S') THEN
+        CALL QNSTAT(LUN)
+      ELSEIF(OPT1.EQ.'X') THEN
+        CALL QPGRID(LUN)
+      ELSEIF(OPT1.EQ.'A') THEN
+        CALL QNPRIN(LUN)
+        CALL QNLIST(LUN)
+        CALL QPGRID(LUN)
+        CALL QNSTAT(LUN)
+        CALL QPTIME(LUN)
+      ELSE
+        GOTO 500
+      ENDIF
+
+      RETURN
+
+ 500  CONTINUE
+
+      WRITE(6,'(/'' ------------------------------------'')')
+      WRITE(6,'( '' QCDNUM error in s/r QPRINT ---> STOP'')')
+      WRITE(6,'( '' ------------------------------------'')')
+      WRITE(6,'( '' Input LUN :'',I5   )') LUN
+      WRITE(6,'( ''       OPT :'',A    )') OPT
+      WRITE(6,'(/'' Option should be A, B, P, S, T or X'')')
+
+      STOP
+
+      END
+CDECK  ID>, QNTIME.
+C     ======================
+      SUBROUTINE QNTIME(OPT)
+C     ======================
+
+C---  QNTIME: start/halt/continue the timelog.
+C---  Called by user and by QPTIME.
+C---  Input variable: 'Start'    initialise and start the timelog.
+C---                  'Hold'     stop logging.     
+C---                  'Cont'     continue logging.
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+      CHARACTER*(*) OPT
+      CHARACTER*1   OPT1
+      LOGICAL LTIME  
+      REAL T_START,T_END,T_SPENT
+      COMMON/QCTIME/T_START(10),T_END(10),T_SPENT(10),N_CALLS(10),
+     +E_CALLS(10),LTIME
+      COMMON/QCFCNT/IFCNT(-1:1,5)
+
+
+      CALL QTRACE('QNTIME ',0)
+      IF(LENOCC_LHA(OPT).LT.1) GOTO 500
+      OPT1 = OPT(1:1)
+      CALL CLTOU_LHA(OPT1)
+      IF(OPT1.EQ.'S') THEN
+        DO I = 1,10
+          T_SPENT(I) = 0.
+          E_CALLS(I) = 0.
+          N_CALLS(I) = 0
+        ENDDO
+        LTIME = .TRUE.
+        N_CALLS(1) = N_CALLS(1)+1
+        CALL TIMEX_LHA(T_START(1))
+      ELSEIF(OPT1.EQ.'H') THEN
+
+        LTIME = .FALSE.
+        CALL TIMEX_LHA(T_END(1))
+        T_SPENT(1) = T_SPENT(1)+T_END(1)-T_START(1)
+        T_START(1) = T_END(1)
+
+      ELSEIF(OPT1.EQ.'C') THEN
+
+        IF(.NOT.LTIME) THEN
+          LTIME = .TRUE.
+          N_CALLS(1) = N_CALLS(1)+1
+          CALL TIMEX_LHA(T_START(1))
+        ENDIF
+
+      ELSE
+        GOTO 500
+      ENDIF
+      RETURN
+
+ 500  CONTINUE
+
+      WRITE(6,'(/'' ------------------------------------'')')
+      WRITE(6,'( '' QCDNUM error in s/r QNTIME ---> STOP'')')
+      WRITE(6,'( '' ------------------------------------'')')
+      WRITE(6,'( '' Input OPT :'',A    )') OPT
+      WRITE(6,'(/'' Option should be S, H or C         '')')
+
+      CALL QTRACE('QNTIME ',1)
+
+      STOP
+      END
+CDECK  ID>, QPTIME.
+C     ======================
+      SUBROUTINE QPTIME(LUN)
+C     ======================
+
+C---  QPTIME: start/print the timelog.
+C---  Called by QPRINT.
+C---  Input variable: LUN logical unit number 
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+      LOGICAL LTIME  
+      REAL T_START,T_END,T_SPENT
+      COMMON/QCTIME/T_START(10),T_END(10),T_SPENT(10),N_CALLS(10),
+     +E_CALLS(10),LTIME
+      COMMON/QCFCNT/IFCNT(-1:1,5)
+
+      PARAMETER ( MXX = 410 )
+      PARAMETER ( MQ2 =  120 )
+
+C--   Do not set the following parameter to zero!
+      PARAMETER ( NDFMAX = 20)
+
+      COMMON/QCGRID/
+     +SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS,
+     +XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45,
+     +NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2),
+     +IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2)
+      REAL
+     +WGTFF1,WGTFG1,
+     +WGTGF1,WGTGG1,
+     +WGTPP2,WGTPM2,WGTNS2,
+     +WGTFF2,WGTFG2,
+     +WGTGF2,WGTGG2,
+     +WGTC2Q,WGTC2G,YNTC2Q,
+     +WGTCLQ,WGTCLG,WGTC3Q
+
+      COMMON/QCWEIT/
+     +WGTFF1(MXX*(MXX+1)/2)    ,WGTFG1(MXX*(MXX+1)/2,3:5),
+     +WGTGF1(MXX*(MXX+1)/2)    ,WGTGG1(MXX*(MXX+1)/2,3:5),
+     +WGTPP2(MXX*(MXX+1)/2,3:5),WGTPM2(MXX*(MXX+1)/2,3:5),
+     +WGTNS2(MXX*(MXX+1)/2,3:5),
+     +WGTFF2(MXX*(MXX+1)/2,3:5),WGTFG2(MXX*(MXX+1)/2,3:5),
+     +WGTGF2(MXX*(MXX+1)/2,3:5),WGTGG2(MXX*(MXX+1)/2,3:5),
+     +WGTC2Q(MXX*(MXX+1)/2)    ,WGTC2G(MXX*(MXX+1)/2,3:5),
+     +WGTCLQ(MXX*(MXX+1)/2)    ,WGTCLG(MXX*(MXX+1)/2,3:5),
+     +WGTC3Q(MXX*(MXX+1)/2)    ,YNTC2Q(MXX)
+
+      COMMON/QCWADR/ IWADR(MXX,MXX)
+
+      CALL QNTIME('H')    
+
+      N_TOT      = N_CALLS(3)+N_CALLS(4)+N_CALLS(5)
+      E_TOT      = E_CALLS(3)+E_CALLS(4)+E_CALLS(5)
+      T_TOT      = T_SPENT(3)+T_SPENT(4)+T_SPENT(5)
+      T_REST     = T_SPENT(1)-T_TOT-T_SPENT(2)-T_SPENT(6)
+      DUMMY      = 1.
+      F_FAST     = 0.
+      DO J = 1,5
+        F_FAST   = F_FAST+IFCNT(1,J)
+      ENDDO
+      WRITE(LUN,
+     +  '(//'' -------------------------------------------------'')')
+      WRITE(LUN,
+     +  '(  '' Routine     # calls   # evols   CPU sec  CPU/evol'')')
+      WRITE(LUN,
+     +  '(  '' -------------------------------------------------'')')
+      WRITE(LUN,
+     + '('' EVOLNM   '',I10,2F10.1,F10.2)') N_CALLS(3),
+     +      E_CALLS(3),T_SPENT(3),T_SPENT(3)/MAX(E_CALLS(3),DUMMY)
+      WRITE(LUN,
+     + '('' EVOLNP   '',I10,2F10.1,F10.2)') N_CALLS(4),
+     +      E_CALLS(4),T_SPENT(4),T_SPENT(4)/MAX(E_CALLS(4),DUMMY)
+      WRITE(LUN,
+     + '('' EVOLSG   '',I10,2F10.1,F10.2)') N_CALLS(5),
+     +      E_CALLS(5),T_SPENT(5),T_SPENT(5)/MAX(E_CALLS(5),DUMMY)
+      WRITE(LUN,
+     +  '(  '' -------------------------------------------------'')')
+      WRITE(LUN,
+     + '('' AP total '',I10,2F10.1,F10.2)') N_TOT,
+     +      E_TOT,T_TOT,T_TOT/MAX(E_TOT,DUMMY)
+      WRITE(LUN,'('' '')')
+      WRITE(LUN,
+     + '('' STFAST   '',I10,   2F10.1)') N_CALLS(6),F_FAST,T_SPENT(6)
+      WRITE(LUN,
+     + '('' QNFILW   '',I10,10X,F10.1)') N_CALLS(2),T_SPENT(2)
+      WRITE(LUN,
+     + '('' Other    '',10X,10X,F10.1)') T_REST
+      WRITE(LUN,
+     +  '(  '' -------------------------------------------------'')')
+      WRITE(LUN,
+     + '('' Total    '',10X,10X,F10.1)') T_SPENT(1)
+      WRITE(LUN,
+     +  '(  '' -------------------------------------------------'')')
+
+
+      RETURN
+      END
+CDECK  ID>, QNSTAT.
+C     ======================
+      SUBROUTINE QNSTAT(LUN)
+C     ======================
+
+C---  QNSTAT: print number of structure function calculations.
+C---  Called by user.
+C---  Input parameter: LUN to be opened by user unless LUN = 6.
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+      LOGICAL LTIME  
+      REAL T_START,T_END,T_SPENT
+      COMMON/QCTIME/T_START(10),T_END(10),T_SPENT(10),N_CALLS(10),
+     +E_CALLS(10),LTIME
+      COMMON/QCFCNT/IFCNT(-1:1,5)
+
+
+      DIMENSION ITOT(5)
+       
+       DO J = 1,5
+        ITOT(J) = 0
+        DO I = -1,1
+          ITOT(J) = ITOT(J)+IFCNT(I,J)
+        ENDDO
+      ENDDO
+      WRITE(LUN,'(//'' ------------------------------'',
+     +   ''--------------------------------------------'')')
+      WRITE(LUN,'(  '' Structure function calls '',
+     +   ''           F2       FL      xF3'',
+     +                ''      F2h      FLh'')')
+      WRITE(LUN,'(  '' ------------------------------'',
+     +   ''--------------------------------------------'')')
+      WRITE(LUN,
+     + '('' Slow calculation             '',5I9)') (IFCNT( 0,J),J=1,5)
+      WRITE(LUN,
+     + '('' Fast calculation             '',5I9)') (IFCNT( 1,J),J=1,5)
+      WRITE(LUN,
+     + '('' Outside grid or cuts         '',5I9)') (IFCNT(-1,J),J=1,5)
+      WRITE(LUN,'(  '' ------------------------------'',
+     +   ''--------------------------------------------'')')
+      WRITE(LUN,
+     + '('' Total                        '',5I9)') (   ITOT(J),J=1,5)
+      WRITE(LUN,'(  '' ------------------------------'',
+     +   ''--------------------------------------------'')')
+
+      RETURN
+      END
+CDECK  ID>, QNIVAL.
+C     ================================
+      SUBROUTINE QNIVAL(OPT,FLAG,IVAL)
+C     ================================
+
+C---  QNIVAL: set/get integer variable.
+C---  Called by user or internally by s/r QNISET and QNIGET.
+C---  Input parameters: 'OPT'   = 'Set' or 'Get'.
+C---                    'FLAG'  = variable name to set or get.
+C---                    'IVAL' (integer) input or output variable.
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+      CHARACTER*(*) OPT
+      CHARACTER*1   OPT1
+      CHARACTER*(*) FLAG
+      CHARACTER*5   FLAG5
+      COMMON/QCCONS/
+     +PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L,
+     +AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7),
+     +C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3,
+     +C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9,
+     +C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1,
+     +C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF
+      LOGICAL
+     +LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB,
+     +LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS,
+     +LALFOK,LDQ2OK,LWT1OK,LWT2OK,
+     +LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ,
+     +LFFCAL,LASOLD
+
+      COMMON/QCFLAG/ 
+     +IORD,IOLAST,
+     +LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB,
+     +LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS,
+     +LALFOK,LDQ2OK,LWT1OK,LWT2OK,
+     +LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ,
+     +LFFCAL(7,30),LASOLD
+      PARAMETER ( MXX = 410 )
+      PARAMETER ( MQ2 =  120 )
+
+C--   Do not set the following parameter to zero!
+      PARAMETER ( NDFMAX = 20)
+
+      COMMON/QCGRID/
+     +SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS,
+     +XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45,
+     +NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2),
+     +IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2)
+      COMMON/QCPASS/
+     +ALPHA0, Q0ALFA, ASLAST, QALAST,
+     +ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2),
+     +DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10),
+     +FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2),
+     +FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2),
+     +FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2),
+     +FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST,
+     +MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2),
+     +ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2),
+     +IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10)
+
+      LOGICAL LEVDONE,LE_DONE
+      COMMON/QCLEVL/
+     +LEVDONE(MXX,10),LE_DONE(MXX)
+      IF(LENOCC_LHA(OPT).LT.1)  THEN
+        IERR = 1
+        GOTO 500
+      ENDIF
+      IF(LENOCC_LHA(FLAG).LT.5) THEN
+        IERR = 2
+        GOTO 500
+      ENDIF
+      OPT1   = OPT(1:1)
+      FLAG5  = FLAG(1:5)
+      CALL CLTOU_LHA(OPT1)
+      CALL CLTOU_LHA(FLAG5)
+C     ----------------------
+      IF(OPT1.EQ.'S') THEN !
+C     ----------------------
+        IF    (FLAG5.EQ.'ORDER') THEN
+          IF(IVAL.LE.0.OR.IVAL.GE.3) THEN
+            IERR = 3
+            GOTO 500
+          ENDIF
+          IORD   = IVAL
+C--       Invalidate all evolutions      
+          CALL QNFALS(LEVDONE,MXX*10)
+          LALFOK = .FALSE.
+        ELSE
+          IERR = 2
+          GOTO 500
+        ENDIF
+C     --------------------------
+      ELSEIF(OPT1.EQ.'G') THEN !
+C     --------------------------
+        IF    (FLAG5.EQ.'ORDER') THEN
+          IVAL = IORD
+        ELSE
+          IERR = 2
+          GOTO 500
+        ENDIF
+C     ------
+      ELSE !
+C     ------
+        IERR = 1
+        GOTO 500
+C     -------
+      ENDIF !
+C     -------
+      RETURN
+
+ 500  CONTINUE
+
+      WRITE(6,'(/'' ------------------------------------'')')
+      WRITE(6,'( '' QCDNUM error in s/r QNIVAL ---> STOP'')')
+      WRITE(6,'( '' ------------------------------------'')')
+      WRITE(6,'( '' Input OPT : '',A    )') OPT
+      WRITE(6,'( ''       VAR : '',A    )') FLAG
+      WRITE(6,'( ''       VAL : '',I10  )') IVAL
+      IF(IERR.EQ.1) THEN
+        WRITE(6,'(/'' OPT should be either SET or GET '')')
+      ELSEIF(IERR.EQ.2) THEN
+        WRITE(6,'(/'' Variable VAR not found'')')
+      ELSEIF(IERR.EQ.3) THEN
+        WRITE(6,'(/'' IVAL out of allowed range'')')
+      ENDIF
+
+      CALL QTRACE('QNIVAL ',1)
+
+      STOP
+
+      END
+
+CDECK  ID>, QNISET.
+C     ============================
+      SUBROUTINE QNISET(FLAG,IVAL)
+C     ============================
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+      CHARACTER*(*) FLAG
+
+      CALL QTRACE('QNISET ',0)
+
+      CALL QNIVAL('SET',FLAG,IVAL)
+
+      RETURN
+      END
+
+CDECK  ID>, QNIGET.
+C     ============================
+      SUBROUTINE QNIGET(FLAG,IVAL)
+C     ============================
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+      CHARACTER*(*) FLAG
+
+      CALL QTRACE('QNIGET ',0)
+
+      CALL QNIVAL('GET',FLAG,IVAL)
+
+      RETURN
+      END
+CDECK  ID>, QNRVAL.
+C     ===============================
+      SUBROUTINE QNRVAL(OPT,FLAG,VAL)
+C     ===============================
+
+C---  QNRVAL: set/get floating point variable.
+C---  Called by user or internally by s/r QNRSET and QNRGET.
+C---  Input parameters: 'OPT'   = 'Set' or 'Get'.
+C---                    'FLAG'  = variable name to set or get.
+C---                    'VAL' (real or d.p.) input or output variable.
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+      CHARACTER*(*) OPT
+      CHARACTER*1   OPT1
+      CHARACTER*(*) FLAG
+      CHARACTER*5   FLAG5
+      COMMON/QCCONS/
+     +PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L,
+     +AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7),
+     +C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3,
+     +C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9,
+     +C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1,
+     +C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF
+      LOGICAL
+     +LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB,
+     +LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS,
+     +LALFOK,LDQ2OK,LWT1OK,LWT2OK,
+     +LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ,
+     +LFFCAL,LASOLD
+
+      COMMON/QCFLAG/ 
+     +IORD,IOLAST,
+     +LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB,
+     +LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS,
+     +LALFOK,LDQ2OK,LWT1OK,LWT2OK,
+     +LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ,
+     +LFFCAL(7,30),LASOLD
+      PARAMETER ( MXX = 410 )
+      PARAMETER ( MQ2 =  120 )
+
+C--   Do not set the following parameter to zero!
+      PARAMETER ( NDFMAX = 20)
+
+      COMMON/QCGRID/
+     +SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS,
+     +XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45,
+     +NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2),
+     +IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2)
+      COMMON/QCPASS/
+     +ALPHA0, Q0ALFA, ASLAST, QALAST,
+     +ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2),
+     +DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10),
+     +FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2),
+     +FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2),
+     +FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2),
+     +FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST,
+     +MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2),
+     +ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2),
+     +IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10)
+
+      LOGICAL LEVDONE,LE_DONE
+      COMMON/QCLEVL/
+     +LEVDONE(MXX,10),LE_DONE(MXX)
+      IF(LENOCC_LHA(OPT).LT.1)  THEN
+        IERR = 1
+        GOTO 500
+      ENDIF
+      IF(LENOCC_LHA(FLAG).LT.5) THEN
+        IERR = 2
+        GOTO 500
+      ENDIF
+      OPT1   = OPT(1:1)
+      FLAG5  = FLAG(1:5)
+      CALL CLTOU_LHA(OPT1)
+      CALL CLTOU_LHA(FLAG5)
+C     ----------------------
+      IF(OPT1.EQ.'S') THEN !
+C     ----------------------
+        IF    (FLAG5.EQ.'AAM2H'.OR.FLAG5.EQ.'AATQ2') THEN
+          IF(VAL.LE.0.) THEN
+            IERR = 3
+            GOTO 500
+          ENDIF
+          AAM2H  = VAL
+          DO I = 1,30
+            LFFCAL(4,I) = .FALSE.
+            LFFCAL(5,I) = .FALSE.
+            LFFCAL(6,I) = .FALSE.
+            LFFCAL(7,I) = .FALSE.
+          ENDDO
+        ELSEIF(FLAG5.EQ.'BBM2H'.OR.FLAG5.EQ.'PLUSB') THEN
+          BBM2H  = VAL
+          DO I = 1,30
+            LFFCAL(4,I) = .FALSE.
+            LFFCAL(5,I) = .FALSE.
+            LFFCAL(6,I) = .FALSE.
+            LFFCAL(7,I) = .FALSE.
+          ENDDO
+        ELSEIF(FLAG5.EQ.'AAM2L') THEN
+          IF(VAL.LE.0.) THEN
+            IERR = 3
+            GOTO 500
+          ENDIF
+          AAM2L  = VAL
+          DO I = 1,30
+            LFFCAL(1,I) = .FALSE.
+            LFFCAL(2,I) = .FALSE.
+            LFFCAL(3,I) = .FALSE.
+          ENDDO
+        ELSEIF(FLAG5.EQ.'BBM2L') THEN
+          BBM2L  = VAL
+          DO I = 1,30
+            LFFCAL(1,I) = .FALSE.
+            LFFCAL(2,I) = .FALSE.
+            LFFCAL(3,I) = .FALSE.
+          ENDDO
+        ELSEIF(FLAG5.EQ.'AAAR2') THEN
+          AAAR2  = VAL
+C--       Invalidate all evolutions      
+          CALL QNFALS(LEVDONE,MXX*10)
+          LALFOK = .FALSE.
+          DO I = 1,30
+            DO J = 1,7
+              LFFCAL(J,I)  = .FALSE.
+            ENDDO
+          ENDDO
+        ELSEIF(FLAG5.EQ.'BBBR2') THEN
+          BBBR2  = VAL
+C--       Invalidate all evolutions      
+          CALL QNFALS(LEVDONE,MXX*10)
+          LALFOK = .FALSE.
+          DO I = 1,30
+            DO J = 1,7
+              LFFCAL(J,I)  = .FALSE.
+            ENDDO
+          ENDDO
+        ELSEIF(FLAG5.EQ.'FLFAC') THEN
+          FL_FAC = VAL
+          DO I = 1,30
+            LFFCAL(2,I)  = .FALSE.
+          ENDDO
+        ELSEIF(FLAG5.EQ.'SCAX0') THEN
+          IF(VAL.LE.0.) THEN
+            IERR = 3
+            GOTO 500
+          ENDIF
+          SCAX0     = VAL
+        ELSEIF(FLAG5.EQ.'SCAQ0') THEN
+          IF(VAL.LE.0.) THEN
+            IERR = 3
+            GOTO 500
+          ENDIF
+          SCAQ0     = VAL
+        ELSE
+          IF(VAL.LE.0.) THEN
+            IERR = 3
+            GOTO 500
+          ENDIF
+C--       Invalidate all evolutions      
+          CALL QNFALS(LEVDONE,MXX*10)
+          LALFOK = .FALSE.   !force alpha_s to be recalculated
+          IF    (FLAG5.EQ.'UMASS') THEN
+            UDSCBT(1) = VAL
+          ELSEIF(FLAG5.EQ.'DMASS') THEN
+            UDSCBT(2) = VAL
+          ELSEIF(FLAG5.EQ.'SMASS') THEN
+            UDSCBT(3) = VAL
+          ELSEIF(FLAG5.EQ.'CMASS') THEN
+            UDSCBT(4) = VAL
+            CBMSTF(4) = VAL
+            CBMSTF(5) = VAL
+            LWFCOK = .FALSE.  !invalidate F2C weight tables
+            LWLCOK = .FALSE.  !invalidate FLC weight tables
+          ELSEIF(FLAG5.EQ.'MCSTF') THEN
+            CBMSTF(4) = VAL
+            CBMSTF(5) = VAL
+            LWFCOK = .FALSE.
+            LWLCOK = .FALSE.
+          ELSEIF(FLAG5.EQ.'MCALF') THEN
+            UDSCBT(4) = VAL
+          ELSEIF(FLAG5.EQ.'BMASS') THEN
+            UDSCBT(5) = VAL
+            CBMSTF(6) = VAL
+            CBMSTF(7) = VAL
+            LWFBOK = .FALSE.  !invalidate F2B weight tables
+            LWLBOK = .FALSE.  !invalidate FLB weight tables
+          ELSEIF(FLAG5.EQ.'MBSTF') THEN
+            CBMSTF(6) = VAL
+            CBMSTF(7) = VAL
+            LWFBOK = .FALSE.
+            LWLBOK = .FALSE.
+          ELSEIF(FLAG5.EQ.'MBALF') THEN
+            UDSCBT(5) = VAL
+          ELSEIF(FLAG5.EQ.'MTALF') THEN
+            UDSCBT(6) = VAL
+          ELSEIF(FLAG5.EQ.'TMASS') THEN
+            UDSCBT(6) = VAL
+          ELSEIF(FLAG5.EQ.'ALFAS') THEN
+            ALPHA0    = VAL
+          ELSEIF(FLAG5.EQ.'ALFQ0') THEN
+            Q0ALFA    = VAL
+          ELSE
+            IERR = 2
+            GOTO 500
+          ENDIF
+        ENDIF
+C     --------------------------
+      ELSEIF(OPT1.EQ.'G') THEN !
+C     --------------------------
+        IF    (FLAG5.EQ.'SCAX0') THEN
+          VAL = SCAX0
+        ELSEIF(FLAG5.EQ.'SCAQ0') THEN
+          VAL = SCAQ0
+        ELSEIF(FLAG5.EQ.'AAM2H'.OR.FLAG5.EQ.'AATQ2') THEN
+          VAL = AAM2H
+        ELSEIF(FLAG5.EQ.'BBM2H'.OR.FLAG5.EQ.'PLUSB') THEN
+          VAL = BBM2H
+        ELSEIF(FLAG5.EQ.'AAM2L') THEN
+          VAL = AAM2L
+        ELSEIF(FLAG5.EQ.'BBM2L') THEN
+          VAL = BBM2L
+        ELSEIF(FLAG5.EQ.'AAAR2') THEN
+          VAL = AAAR2
+        ELSEIF(FLAG5.EQ.'BBBR2') THEN
+          VAL = BBBR2
+        ELSEIF(FLAG5.EQ.'FLFAC') THEN
+          VAL = FL_FAC
+        ELSEIF(FLAG5.EQ.'UMASS') THEN
+          VAL = UDSCBT(1)
+        ELSEIF(FLAG5.EQ.'DMASS') THEN
+          VAL = UDSCBT(2)
+        ELSEIF(FLAG5.EQ.'SMASS') THEN
+          VAL = UDSCBT(3)
+        ELSEIF(FLAG5.EQ.'CMASS') THEN
+          VAL = UDSCBT(4)
+        ELSEIF(FLAG5.EQ.'BMASS') THEN
+          VAL = UDSCBT(5)
+        ELSEIF(FLAG5.EQ.'TMASS') THEN
+          VAL = UDSCBT(6)
+        ELSEIF(FLAG5.EQ.'MCSTF') THEN
+          VAL = CBMSTF(4)
+        ELSEIF(FLAG5.EQ.'MBSTF') THEN
+          VAL = CBMSTF(6)
+        ELSEIF(FLAG5.EQ.'MCALF') THEN
+          VAL = UDSCBT(4)
+        ELSEIF(FLAG5.EQ.'MBALF') THEN
+          VAL = UDSCBT(5)
+        ELSEIF(FLAG5.EQ.'MTALF') THEN
+          VAL = UDSCBT(6)
+        ELSEIF(FLAG5.EQ.'ALFAS') THEN
+          VAL = ALPHA0
+        ELSEIF(FLAG5.EQ.'ALFQ0') THEN
+          VAL = Q0ALFA
+        ELSEIF(FLAG5.EQ.'TCHRM') THEN
+          VAL = THRS34
+        ELSEIF(FLAG5.EQ.'TBOTT') THEN
+          VAL = THRS45
+        ELSEIF(FLAG5.EQ.'XMINC') THEN
+          VAL = XMICUT
+        ELSEIF(FLAG5.EQ.'QMINC') THEN
+          VAL = QMICUT
+        ELSEIF(FLAG5.EQ.'QMAXC') THEN
+          VAL = QMACUT
+        ELSEIF(FLAG5.EQ.'ROOTS') THEN
+          IF(RS2CUT.GE.0.) THEN
+            VAL = SQRT(RS2CUT)
+          ELSE
+            VAL = RS2CUT
+          ENDIF
+        ELSEIF(FLAG5.EQ.'QMINA') THEN
+          VAL = QMINAS
+        ELSE
+          IERR = 2
+          GOTO 500
+        ENDIF
+C     ------
+      ELSE !
+C     ------
+        IERR = 1
+        GOTO 500
+C     -------  
+      ENDIF !
+C     -------  
+      RETURN
+
+ 500  CONTINUE
+
+      WRITE(6,'(/'' ------------------------------------'')')
+      WRITE(6,'( '' QCDNUM error in s/r QNRVAL ---> STOP'')')
+      WRITE(6,'( '' ------------------------------------'')')
+      WRITE(6,'( '' Input OPT : '',A    )') OPT
+      WRITE(6,'( ''       VAR : '',A    )') FLAG
+      WRITE(6,'( ''       VAL : '',E12.5)') RVAL
+      IF(IERR.EQ.1) THEN
+        WRITE(6,'(/'' OPT should be either SET or GET '')')
+      ELSEIF(IERR.EQ.2) THEN
+        WRITE(6,'(/'' Variable VAR not found'')')
+      ELSEIF(IERR.EQ.3) THEN
+        WRITE(6,'(/'' VAL should be .gt. 0  '')')
+      ENDIF
+
+      CALL QTRACE('QNRVAL ',1)
+
+      STOP
+
+      END
+
+CDECK  ID>, QNRSET.
+C     ============================
+      SUBROUTINE QNRSET(FLAG,RVAL)
+C     ============================
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+      CHARACTER*(*) FLAG
+
+      CALL QTRACE('QNRSET ',0)
+
+      CALL QNRVAL('SET',FLAG,RVAL)
+
+      RETURN
+      END
+
+CDECK  ID>, QNRGET.
+C     ============================
+      SUBROUTINE QNRGET(FLAG,RVAL)
+C     ============================
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+      CHARACTER*(*) FLAG
+
+      CALL QTRACE('QNRGET ',0)
+
+      CALL QNRVAL('GET',FLAG,RVAL)
+
+      RETURN
+      END
+CDECK  ID>, QNLVAL.
+C     ================================
+      SUBROUTINE QNLVAL(OPT,FLAG,LVAL)
+C     ================================
+
+C---  QNLVAL: set/get logical variable.
+C---  Called by user or internally by s/r QNLSET and QNLGET.
+C---  Input parameters: 'OPT'   = 'Set' or 'Get'.
+C---                    'FLAG'  = variable name to set or get.
+C---                    'VAL' (logical) input or output variable.
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+      CHARACTER*(*) OPT
+      CHARACTER*1   OPT1
+      CHARACTER*(*) FLAG
+      CHARACTER*5   FLAG5
+      LOGICAL       LVAL
+      COMMON/QCCONS/
+     +PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L,
+     +AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7),
+     +C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3,
+     +C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9,
+     +C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1,
+     +C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF
+      LOGICAL
+     +LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB,
+     +LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS,
+     +LALFOK,LDQ2OK,LWT1OK,LWT2OK,
+     +LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ,
+     +LFFCAL,LASOLD
+
+      COMMON/QCFLAG/ 
+     +IORD,IOLAST,
+     +LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB,
+     +LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS,
+     +LALFOK,LDQ2OK,LWT1OK,LWT2OK,
+     +LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ,
+     +LFFCAL(7,30),LASOLD
+      IF(LENOCC_LHA(OPT).LT.1)  THEN
+        IERR = 1
+        GOTO 500
+      ENDIF
+      IF(LENOCC_LHA(FLAG).LT.5) THEN
+        IERR = 2
+        GOTO 500
+      ENDIF
+      OPT1   = OPT(1:1)
+      FLAG5  = FLAG(1:5)
+      CALL CLTOU_LHA(OPT1)
+      CALL CLTOU_LHA(FLAG5)
+C     ----------------------
+      IF(OPT1.EQ.'S') THEN !
+C     ----------------------
+        IF    (FLAG5.EQ.'W1ANA' ) THEN
+          LW1ANA = LVAL
+          IF(LW1ANA) LW1NUM = .FALSE.
+        ELSEIF(FLAG5.EQ.'W1NUM' ) THEN
+          LW1NUM = LVAL
+          IF(LW1NUM) LW1ANA = .FALSE.
+        ELSEIF(FLAG5.EQ.'W2NUM' ) THEN
+          LW2NUM = LVAL
+        ELSEIF(FLAG5.EQ.'W2STF' ) THEN
+          LW2STF = LVAL
+        ELSEIF(FLAG5.EQ.'WTF2C' ) THEN
+          LWF2C  = LVAL
+        ELSEIF(FLAG5.EQ.'WTFLC' ) THEN
+          LWFLC  = LVAL
+        ELSEIF(FLAG5.EQ.'WTF2B' ) THEN
+          LWF2B  = LVAL
+        ELSEIF(FLAG5.EQ.'WTFLB' ) THEN
+          LWFLB  = LVAL
+        ELSEIF(FLAG5.EQ.'BMARK' ) THEN
+          LBMARK = LVAL
+          LALFOK = .FALSE.
+        ELSEIF(FLAG5.EQ.'LIMCK' ) THEN
+          LIMCK  = LVAL
+        ELSEIF(FLAG5.EQ.'CLOWQ' ) THEN
+          LCLOWQ = LVAL
+        ELSEIF(FLAG5.EQ.'ASOLD' ) THEN
+          LASOLD = LVAL
+          LALFOK = .FALSE.
+        ELSE
+          IERR = 2
+          GOTO 500
+        ENDIF
+C     --------------------------
+      ELSEIF(OPT1.EQ.'G') THEN !
+C     --------------------------
+        IF    (FLAG5.EQ.'W1ANA' ) THEN
+          LVAL = LW1ANA
+        ELSEIF(FLAG5.EQ.'W1NUM' ) THEN
+          LVAL = LW1NUM
+        ELSEIF(FLAG5.EQ.'W2NUM' ) THEN
+          LVAL = LW2NUM
+        ELSEIF(FLAG5.EQ.'W2STF' ) THEN
+          LVAL = LW2STF
+        ELSEIF(FLAG5.EQ.'WTF2C' ) THEN
+          LVAL = LWF2C
+        ELSEIF(FLAG5.EQ.'WTFLC' ) THEN
+          LVAL = LWFLC
+        ELSEIF(FLAG5.EQ.'WTF2B' ) THEN
+          LVAL = LWF2B
+        ELSEIF(FLAG5.EQ.'WTFLB' ) THEN
+          LVAL = LWFLB
+        ELSEIF(FLAG5.EQ.'BMARK' ) THEN
+          LVAL = LBMARK
+        ELSEIF(FLAG5.EQ.'LIMCK' ) THEN
+          LVAL = LIMCK 
+        ELSEIF(FLAG5.EQ.'CLOWQ' ) THEN
+          LVAL = LCLOWQ 
+        ELSEIF(FLAG5.EQ.'ASOLD' ) THEN
+          LVAL = LASOLD 
+        ELSE
+          IERR = 2
+          GOTO 500
+        ENDIF
+C     ------
+      ELSE !
+C     ------
+        IERR = 1
+        GOTO 500
+C     -------  
+      ENDIF !
+C     -------  
+      RETURN
+
+ 500  CONTINUE
+
+      WRITE(6,'(/'' ------------------------------------'')')
+      WRITE(6,'( '' QCDNUM error in s/r QNLVAL ---> STOP'')')
+      WRITE(6,'( '' ------------------------------------'')')
+      WRITE(6,'( '' Input OPT : '',A    )') OPT
+      WRITE(6,'( ''       VAR : '',A    )') FLAG
+      WRITE(6,'( ''       VAL : '',L2   )') LVAL
+      IF(IERR.EQ.1) THEN
+        WRITE(6,'(/'' OPT should be either SET or GET '')')
+      ELSEIF(IERR.EQ.2) THEN
+        WRITE(6,'(/'' Variable VAR not found'')')
+      ENDIF
+
+      CALL QTRACE('QNLVAL ',1)
+
+      STOP
+
+      END
+
+CDECK  ID>, QNLSET.
+C     ============================
+      SUBROUTINE QNLSET(FLAG,LVAL)
+C     ============================
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+      CHARACTER*(*) FLAG
+      LOGICAL       LVAL
+
+      CALL QTRACE('QNLSET ',0)
+
+      CALL QNLVAL('SET',FLAG,LVAL)
+
+      RETURN
+      END
+
+CDECK  ID>, QNLGET.
+C     ============================
+      SUBROUTINE QNLGET(FLAG,LVAL)
+C     ============================
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+      CHARACTER*(*) FLAG
+      LOGICAL       LVAL
+
+      CALL QTRACE('QNLGET ',0)
+
+      CALL QNLVAL('GET',FLAG,LVAL)
+
+      RETURN
+      END
+CDECK  ID>, GRMXMQ.
+C     ============================
+      SUBROUTINE GRMXMQ(NXMA,NQMA)
+C     ============================
+
+C---  GRMXMQ: return max allowed number of x, Q2 gridpoints.
+C---  Called by user.
+C---  MXX and MQ2 are set by parameter statement in common QCNXQM.
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+      PARAMETER ( MXX = 410 )
+      PARAMETER ( MQ2 =  120 )
+
+C--   Do not set the following parameter to zero!
+      PARAMETER ( NDFMAX = 20)
+
+      COMMON/QCGRID/
+     +SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS,
+     +XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45,
+     +NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2),
+     +IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2)
+
+      CALL QTRACE('GRMXMQ ',0)
+      NXMA = MXX-1
+      NQMA = MQ2-1
+      RETURN
+      END
+CDECK  ID>, GRGIVE.
+C     ========================================
+      SUBROUTINE GRGIVE(NX,XMI,XMA,NQ,QMI,QMA)
+C     ========================================
+
+C---  GRGIVE: return current grid definition.
+C---  Called by user.
+C---  Output variables: NX  (integer) number of x gridpoints.
+C---                    XMI (real or d.p.) lowest x value.
+C---                    XMA (real or d.p.) highest x value = 1.
+C---                    NQ  (integer) number of Q2 gridpoints.
+C---                    QMI (real or d.p.) lowest Q2 value.
+C---                    QMA (real or d.p.) highest Q2 value.
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+      PARAMETER ( MXX = 410 )
+      PARAMETER ( MQ2 =  120 )
+
+C--   Do not set the following parameter to zero!
+      PARAMETER ( NDFMAX = 20)
+
+      COMMON/QCGRID/
+     +SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS,
+     +XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45,
+     +NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2),
+     +IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2)
+
+      CALL QTRACE('GRGIVE ',0)
+      NX  = NXX
+      XMI = XXTAB(1)
+      XMA = XXTAB(NXX+1)
+      NQ  = NQ2
+      QMI = Q2TAB(1)
+      QMA = Q2TAB(NQ2)
+      RETURN
+      END
+CDECK  ID>, GRXNUL.
+C     =================
+      SUBROUTINE GRXNUL
+C     =================
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+      LOGICAL
+     +LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB,
+     +LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS,
+     +LALFOK,LDQ2OK,LWT1OK,LWT2OK,
+     +LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ,
+     +LFFCAL,LASOLD
+
+      COMMON/QCFLAG/ 
+     +IORD,IOLAST,
+     +LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB,
+     +LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS,
+     +LALFOK,LDQ2OK,LWT1OK,LWT2OK,
+     +LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ,
+     +LFFCAL(7,30),LASOLD
+      PARAMETER ( MXX = 410 )
+      PARAMETER ( MQ2 =  120 )
+
+C--   Do not set the following parameter to zero!
+      PARAMETER ( NDFMAX = 20)
+
+      COMMON/QCGRID/
+     +SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS,
+     +XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45,
+     +NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2),
+     +IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2)
+      COMMON/QCPASS/
+     +ALPHA0, Q0ALFA, ASLAST, QALAST,
+     +ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2),
+     +DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10),
+     +FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2),
+     +FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2),
+     +FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2),
+     +FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST,
+     +MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2),
+     +ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2),
+     +IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10)
+
+      LOGICAL LEVDONE,LE_DONE
+      COMMON/QCLEVL/
+     +LEVDONE(MXX,10),LE_DONE(MXX)
+
+      CALL QTRACE('GRXNUL ',0)
+C---  Invalidate weight tables (validated by call to QNFILW)
+      LWT1OK = .FALSE.
+      LWT2OK = .FALSE.
+      LWTFOK = .FALSE.
+      LWFCOK = .FALSE.
+      LWLCOK = .FALSE.
+      LWFBOK = .FALSE.
+      LWLBOK = .FALSE.
+      LMARK  = .FALSE.
+C--   Invalidate all evolutions      
+      CALL QNFALS(LEVDONE,MXX*10)
+C---  Set grid to zero
+      CALL QNVNUL(XXTAB,MXX)
+      CALL QNVNUL(XHTAB,MXX)
+      CALL QNINUL(IHTAB,MXX)
+      NXX    = 0
+      NGRVER = 0
+
+C---  Update IFAILC
+      CALL GRSETC
+
+C---  Update NFMAP
+      CALL QNSETT
+
+      RETURN
+      END
+CDECK  ID>, GRXINP.
+C     ============================
+      SUBROUTINE GRXINP(XARRAY,NX)
+C     ============================
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+      LOGICAL
+     +LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB,
+     +LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS,
+     +LALFOK,LDQ2OK,LWT1OK,LWT2OK,
+     +LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ,
+     +LFFCAL,LASOLD
+
+      COMMON/QCFLAG/ 
+     +IORD,IOLAST,
+     +LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB,
+     +LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS,
+     +LALFOK,LDQ2OK,LWT1OK,LWT2OK,
+     +LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ,
+     +LFFCAL(7,30),LASOLD
+      PARAMETER ( MXX = 410 )
+      PARAMETER ( MQ2 =  120 )
+
+C--   Do not set the following parameter to zero!
+      PARAMETER ( NDFMAX = 20)
+
+      COMMON/QCGRID/
+     +SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS,
+     +XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45,
+     +NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2),
+     +IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2)
+      COMMON/QCPASS/
+     +ALPHA0, Q0ALFA, ASLAST, QALAST,
+     +ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2),
+     +DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10),
+     +FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2),
+     +FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2),
+     +FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2),
+     +FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST,
+     +MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2),
+     +ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2),
+     +IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10)
+
+      LOGICAL LEVDONE,LE_DONE
+      COMMON/QCLEVL/
+     +LEVDONE(MXX,10),LE_DONE(MXX)
+      DIMENSION XARRAY(*)
+      DATA EPSI /1.E-6/
+
+      CALL QTRACE('GRXINP ',0)
+      IF(NX.LE.0) THEN
+        IERR = 1
+        GOTO 500
+      ENDIF
+      IF((NX+NXX).GT.MXX-1) THEN
+        IERR = 2
+        GOTO 500
+      ENDIF
+
+C---  Invalidate weight tables (validated by call to QNFILW)
+      LWT1OK = .FALSE.
+      LWT2OK = .FALSE.
+      LWTFOK = .FALSE.
+      LWFCOK = .FALSE.
+      LWLCOK = .FALSE.
+      LWFBOK = .FALSE.
+      LWLBOK = .FALSE.
+      LMARK  = .FALSE.
+C--   Invalidate all evolutions      
+      CALL QNFALS(LEVDONE,MXX*10)
+
+C---  if this number changes, QCDNUM knows that the grid has changed
+      NGRVER = NGRVER + 1
+      IF(NXX.EQ.0) THEN
+        DO 10 IX = 1,NX
+          X = XARRAY(IX)
+          IF(X.LE.0..OR.X.GT.1.) THEN
+            IERR = 3
+            GOTO 500
+          ENDIF
+          NXX    = NXX+1
+          XXTAB(IX) = X
+  10    CONTINUE
+        IF(XXTAB(NXX).EQ.1.) THEN
+          NXX = NXX-1
+        ELSE
+          XXTAB(NXX+1) = 1.
+        ENDIF
+        RETURN
+      ENDIF
+      IF(XXTAB(NXX).EQ.1.) THEN
+        NXX = NXX-1
+      ELSE
+        XXTAB(NXX+1) = 1.
+      ENDIF
+      NXP = NXX+1
+      DO 100 IX = 1,NX
+        X = XARRAY(IX)
+        IF(X.LE.0..OR.X.GT.1.) THEN
+          IERR = 3
+          GOTO 500
+        ENDIF
+*mb     IF(X.LT.XXTAB(1)-EPSI) THEN
+        IF(X/XXTAB(1).LT.1.-EPSI) THEN
+          DO 20 JX = NXP,1,-1
+            XXTAB(JX+1) = XXTAB(JX)
+  20      CONTINUE
+          NXP    = NXP+1
+          XXTAB(1)  = X
+*mb     ELSEIF(X.GT.XXTAB(NXP)+EPSI) THEN
+        ELSEIF(X/XXTAB(NXP).GT.1.+EPSI) THEN
+          NXP    = NXP+1
+          XXTAB(NXP) = X
+        ELSE
+          DO 30 I = 1,NXP
+*mb         IF(XXTAB(I).LE.X+EPSI) IX0 = I
+            IF(XXTAB(I)/X.LE.1.+EPSI) IX0 = I
+  30      CONTINUE
+*mb       IF(ABS(XXTAB(IX0)-X).LE.EPSI) THEN
+          IF(ABS(XXTAB(IX0)/X-1.).LE.EPSI) THEN
+            XXTAB(IX0) = X
+          ELSE
+            DO 40 JX = NXP,IX0+1,-1
+              XXTAB(JX+1) = XXTAB(JX)
+  40        CONTINUE
+            NXP = NXP+1
+            XXTAB(IX0+1) = X
+          ENDIF
+        ENDIF
+ 100  CONTINUE
+      IF(XXTAB(NXP).EQ.1.) THEN
+        NXX = NXP-1
+      ELSE
+        NXX = NXP
+        XXTAB(NXX+1) = 1.
+      ENDIF
+
+C---  Update IFAILC
+      CALL GRSETC
+
+C---  Update NFMAP
+      CALL QNSETT
+
+C---  Update heavy quark xgrid
+      CALL GXHDEF
+      RETURN
+
+ 500  CONTINUE
+
+      WRITE(6,'(/'' ------------------------------------'')')
+      WRITE(6,'( '' QCDNUM error in s/r GRXINP ---> STOP'')')
+      WRITE(6,'( '' ------------------------------------'')')
+      WRITE(6,'( '' Input X  :'',E12.5)') X
+      WRITE(6,'( ''       NX :'',I5   )') NX
+      IF(IERR.EQ.1) THEN
+        WRITE(6,'(/'' NX must be .ge. 1'')')
+      ELSEIF(IERR.EQ.2) THEN
+        WRITE(6,'(/'' Maximum number of gridpoints exceeded '')')
+        WRITE(6,'(/'' # existing x  gridpoints ='',I5/
+     +             '' # points to be added     ='',I5/
+     +             '' maximum # points allowed ='',I5)')
+     +                NXX, NX, MXX-1
+      ELSEIF(IERR.EQ.3) THEN
+        WRITE(6,'(/'' Value of X outside allowed range (0,1]'')')
+      ENDIF
+
+      CALL QTRACE('GRXINP ',1)
+
+      STOP
+
+      END
+CDECK  ID>, GRXDEF.
+C     ==========================
+      SUBROUTINE GRXDEF(NX,XMIN)
+C     ==========================
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+      LOGICAL
+     +LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB,
+     +LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS,
+     +LALFOK,LDQ2OK,LWT1OK,LWT2OK,
+     +LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ,
+     +LFFCAL,LASOLD
+
+      COMMON/QCFLAG/ 
+     +IORD,IOLAST,
+     +LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB,
+     +LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS,
+     +LALFOK,LDQ2OK,LWT1OK,LWT2OK,
+     +LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ,
+     +LFFCAL(7,30),LASOLD
+      PARAMETER ( MXX = 410 )
+      PARAMETER ( MQ2 =  120 )
+
+C--   Do not set the following parameter to zero!
+      PARAMETER ( NDFMAX = 20)
+
+      COMMON/QCGRID/
+     +SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS,
+     +XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45,
+     +NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2),
+     +IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2)
+      COMMON/QCPASS/
+     +ALPHA0, Q0ALFA, ASLAST, QALAST,
+     +ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2),
+     +DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10),
+     +FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2),
+     +FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2),
+     +FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2),
+     +FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST,
+     +MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2),
+     +ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2),
+     +IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10)
+
+      LOGICAL LEVDONE,LE_DONE
+      COMMON/QCLEVL/
+     +LEVDONE(MXX,10),LE_DONE(MXX)
+
+      CALL QTRACE('GRXDEF ',0)
+      IF(NX.LE.0) THEN
+        IERR = 1
+        GOTO 500
+      ENDIF
+      IF(NX.GT.MXX-1) THEN
+        IERR = 2
+        GOTO 500
+      ENDIF
+      IF(XMIN.LE.0.OR.XMIN.GE.1.) THEN
+        IERR = 3
+        GOTO 500
+      ENDIF
+
+C---  Invalidate weight tables (validated by call to QNFILW)
+      LWT1OK = .FALSE.
+      LWT2OK = .FALSE.
+      LWTFOK = .FALSE.
+      LWFCOK = .FALSE.
+      LWLCOK = .FALSE.
+      LWFBOK = .FALSE.
+      LWLBOK = .FALSE.
+      LMARK  = .FALSE.
+C--   Invalidate all evolutions      
+      CALL QNFALS(LEVDONE,MXX*10)
+
+C---  if this number changes, QCDNUM knows that the grid has changed
+      NGRVER = NGRVER + 1
+      XMAX = 1.
+      YMIN = SYFROMX(XMIN)
+      YMAX = SYFROMX(XMAX)
+      BW   = (YMAX-YMIN)/NX
+      DO I = 1,NX
+        YI = YMIN+(I-1)*BW
+        XXTAB(I) = SXFROMY(YI)
+      ENDDO
+      XXTAB(1)    = XMIN
+      XXTAB(NX+1) = 1.
+      NXX         = NX
+
+C---  Update IFAILC
+      CALL GRSETC
+
+C---  Update NFMAP
+      CALL QNSETT
+
+C---  Update heavy quark xgrid
+      CALL GXHDEF
+      RETURN
+
+ 500  CONTINUE
+
+      WRITE(6,'(/'' ------------------------------------'')')
+      WRITE(6,'( '' QCDNUM error in s/r GRXDEF ---> STOP'')')
+      WRITE(6,'( '' ------------------------------------'')')
+      WRITE(6,'( '' Input NX    :'',I5   )') NX
+      WRITE(6,'( ''       Xmin  :'',E12.5)') XMIN
+      IF(IERR.EQ.1) THEN
+        WRITE(6,'(/'' NX must be .ge. 1'')')
+      ELSEIF(IERR.EQ.2) THEN
+        WRITE(6,'(/'' NX > max number of gridpoints'',
+     +             '' allowed:'',I5)') MXX-1
+      ELSEIF(IERR.EQ.3) THEN
+        WRITE(6,'(/'' Xmin outside allowed range (0,1]'')')
+      ENDIF
+
+      CALL QTRACE('GRXDEF ',1)
+
+      STOP
+
+      END
+CDECK  ID>, GRXLIM.
+C     ==========================
+      SUBROUTINE GRXLIM(NX,XMIN)
+C     ==========================
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+      LOGICAL
+     +LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB,
+     +LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS,
+     +LALFOK,LDQ2OK,LWT1OK,LWT2OK,
+     +LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ,
+     +LFFCAL,LASOLD
+
+      COMMON/QCFLAG/ 
+     +IORD,IOLAST,
+     +LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB,
+     +LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS,
+     +LALFOK,LDQ2OK,LWT1OK,LWT2OK,
+     +LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ,
+     +LFFCAL(7,30),LASOLD
+      PARAMETER ( MXX = 410 )
+      PARAMETER ( MQ2 =  120 )
+
+C--   Do not set the following parameter to zero!
+      PARAMETER ( NDFMAX = 20)
+
+      COMMON/QCGRID/
+     +SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS,
+     +XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45,
+     +NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2),
+     +IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2)
+      COMMON/QCPASS/
+     +ALPHA0, Q0ALFA, ASLAST, QALAST,
+     +ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2),
+     +DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10),
+     +FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2),
+     +FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2),
+     +FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2),
+     +FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST,
+     +MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2),
+     +ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2),
+     +IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10)
+
+      LOGICAL LEVDONE,LE_DONE
+      COMMON/QCLEVL/
+     +LEVDONE(MXX,10),LE_DONE(MXX)
+      DATA EPSI / 1.E-6 /
+
+      CALL QTRACE('GRXLIM ',0)
+      IF(NX.LE.0) THEN
+        IERR = 1
+        GOTO 500
+      ENDIF
+      IF(NX.GT.MXX-1) THEN
+        IERR = 2
+        GOTO 500
+      ENDIF
+
+C---  Invalidate weight tables (validated by call to QNFILW)
+      LWT1OK = .FALSE.
+      LWT2OK = .FALSE.
+      LWTFOK = .FALSE.
+      LWFCOK = .FALSE.
+      LWLCOK = .FALSE.
+      LWFBOK = .FALSE.
+      LWLBOK = .FALSE.
+      LMARK  = .FALSE.
+C--   Invalidate all evolutions      
+      CALL QNFALS(LEVDONE,MXX*10)
+      IF(XMIN.LE.0.OR.XMIN.GE.1.) THEN
+        IERR = 3
+        GOTO 500
+      ENDIF
+
+C---  if this number changes, QCDNUM knows that the grid has changed
+      NGRVER = NGRVER + 1
+      IF(NXX.EQ.0) THEN
+        XXTAB(1) = 1.
+      ELSEIF(XXTAB(NXX).EQ.1.) THEN
+        NXX = NXX-1
+      ELSE
+        XXTAB(NXX+1) = 1.
+      ENDIF
+      NXP = NXX+1
+*mb   IF(XMIN.LT.XXTAB(1)-EPSI) THEN
+      IF(XMIN/XXTAB(1).LT.1.-EPSI) THEN
+        DO 20 IX = NXP,1,-1
+          XXTAB(IX+1) = XXTAB(IX)
+  20    CONTINUE
+        NXP   = NXP+1
+        XXTAB(1) = XMIN
+      ENDIF
+      IF(NX.GT.NXP-1) THEN
+  30    CONTINUE
+        GAPMAX = 0.
+        DO 35 IX = 1,NXP-1
+          GAP = SYFROMX(XXTAB(IX+1))-SYFROMX(XXTAB(IX))
+          IF(GAP.GT.GAPMAX) THEN
+            GAPMAX = GAP
+            IX0    = IX
+          ENDIF
+  35    CONTINUE
+        DO 40 IX = NXP,IX0+1,-1
+          XXTAB(IX+1) = XXTAB(IX)
+  40    CONTINUE
+        NXP = NXP+1
+        XXTAB(IX0+1) = 0.5*(XXTAB(IX0)+XXTAB(IX0+2))
+        IF(NXP-1.LT.NX) GOTO 30
+      ELSEIF(NX.LT.NXP-1) THEN
+  50    CONTINUE
+        GAPMIN = 999999.
+        DO 55 IX = 2,NXP-1
+          GAP = SYFROMX(XXTAB(IX+1))-SYFROMX(XXTAB(IX-1))
+          IF(GAP.LE.GAPMIN) THEN
+            GAPMIN = GAP
+            IX0    = IX
+          ENDIF
+  55    CONTINUE
+        DO 60 IX = IX0,NXP-1
+          XXTAB(IX) = XXTAB(IX+1)
+  60    CONTINUE
+        XXTAB(NXP) = 0.
+        NXP = NXP-1
+        IF(NXP-1.GT.NX) GOTO 50
+      ENDIF
+      IF(XXTAB(NXP).EQ.1.) THEN
+        NXX = NXP-1
+      ELSE
+        NXX = NXP
+        XXTAB(NXX+1) = 1.
+      ENDIF
+
+C---  Update IFAILC
+      CALL GRSETC
+
+C---  Update NFMAP
+      CALL QNSETT
+
+C---  Update heavy quark xgrid
+      CALL GXHDEF
+      RETURN
+
+ 500  CONTINUE
+
+      WRITE(6,'(/'' ------------------------------------'')')
+      WRITE(6,'( '' QCDNUM error in s/r GRXLIM ---> STOP'')')
+      WRITE(6,'( '' ------------------------------------'')')
+      WRITE(6,'( '' Input NX    :'',I5   )') NX
+      WRITE(6,'( ''       Xmin  :'',E12.5)') XMIN
+      IF(IERR.EQ.1) THEN
+        WRITE(6,'(/'' NX must be .ge. 1'')')
+      ELSEIF(IERR.EQ.2) THEN
+        WRITE(6,'(/'' NX > max number of gridpoints'',
+     +             '' allowed:'',I5)') MXX-1
+      ELSEIF(IERR.EQ.3) THEN
+        WRITE(6,'(/'' Xmin outside allowed range (0,1]'')')
+      ENDIF
+
+      CALL QTRACE('GRXLIM ',1)
+
+      STOP
+
+      END
+CDECK  ID>, GXHDEF.
+C     =================
+      SUBROUTINE GXHDEF
+C     =================
+
+C--   Create a purely logarithmic grid in x (XHTAB) for use 
+C--   in the heavy quark structure function calculations.
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+      PARAMETER ( MXX = 410 )
+      PARAMETER ( MQ2 =  120 )
+
+C--   Do not set the following parameter to zero!
+      PARAMETER ( NDFMAX = 20)
+
+      COMMON/QCGRID/
+     +SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS,
+     +XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45,
+     +NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2),
+     +IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2)
+
+      IF(NXX.EQ.0.OR.NXX.GE.MXX)           RETURN
+      IF(XXTAB(1).LE.0..OR.XXTAB(1).GE.1.) RETURN
+
+      XL1 = LOG(XXTAB(1))
+      XL2 = 0.
+      BW  = (XL2-XL1)/NXX
+
+      DO IX = 1,NXX
+        XL = XL1 + (IX-1)*BW
+        XHTAB(IX) = EXP(XL)
+        IHTAB(IX) = ABS(IXFROMX(XHTAB(IX)))
+      ENDDO
+      XHTAB(NXX+1) = 1.
+      IHTAB(NXX+1) = NXX+1
+
+      RETURN
+      END
+
+CDECK  ID>, SYFROMX.
+C     ====================================
+      DOUBLE PRECISION FUNCTION SYFROMX(X)
+C     ====================================
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+      PARAMETER ( MXX = 410 )
+      PARAMETER ( MQ2 =  120 )
+
+C--   Do not set the following parameter to zero!
+      PARAMETER ( NDFMAX = 20)
+
+      COMMON/QCGRID/
+     +SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS,
+     +XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45,
+     +NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2),
+     +IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2)
+      IF(X.LE.SCAX0) THEN
+        SYFROMX = LOG(X)
+      ELSE
+        SYFROMX = LOG(SCAX0) + (X-SCAX0)/SCAX0
+      ENDIF
+      RETURN
+      END
+
+CDECK  ID>, SXFROMY.
+C     ====================================
+      DOUBLE PRECISION FUNCTION SXFROMY(Y)
+C     ====================================
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+      PARAMETER ( MXX = 410 )
+      PARAMETER ( MQ2 =  120 )
+
+C--   Do not set the following parameter to zero!
+      PARAMETER ( NDFMAX = 20)
+
+      COMMON/QCGRID/
+     +SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS,
+     +XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45,
+     +NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2),
+     +IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2)
+      IF(Y.LE.LOG(SCAX0)) THEN
+        SXFROMY = EXP(Y)
+      ELSE
+        SXFROMY = (Y-LOG(SCAX0)+1.) * SCAX0
+      ENDIF
+      RETURN
+      END
+CDECK  ID>, GRXOUT.
+C     =========================
+      SUBROUTINE GRXOUT(XARRAY)
+C     =========================
+
+C---  Copy XXTAB to XARRAY which should have been dimensioned
+C---  to at least NXX+1 by the user.
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+      LOGICAL
+     +LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB,
+     +LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS,
+     +LALFOK,LDQ2OK,LWT1OK,LWT2OK,
+     +LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ,
+     +LFFCAL,LASOLD
+
+      COMMON/QCFLAG/ 
+     +IORD,IOLAST,
+     +LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB,
+     +LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS,
+     +LALFOK,LDQ2OK,LWT1OK,LWT2OK,
+     +LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ,
+     +LFFCAL(7,30),LASOLD
+      PARAMETER ( MXX = 410 )
+      PARAMETER ( MQ2 =  120 )
+
+C--   Do not set the following parameter to zero!
+      PARAMETER ( NDFMAX = 20)
+
+      COMMON/QCGRID/
+     +SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS,
+     +XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45,
+     +NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2),
+     +IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2)
+      DIMENSION XARRAY(*)
+
+      CALL QTRACE('GRXOUT ',0)
+      DO 10 IX = 1,NXX+1
+        XARRAY(IX) = XXTAB(IX)
+  10  CONTINUE
+      RETURN
+      END
+CDECK  ID>, LOGXGR.
+C     ===============================
+      LOGICAL FUNCTION LOGXGR(IDUMMY)
+C     ===============================
+
+C---  Figure out if xgrid is purely logarithmic
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+
+      REAL    RAT1,RAT
+      PARAMETER ( MXX = 410 )
+      PARAMETER ( MQ2 =  120 )
+
+C--   Do not set the following parameter to zero!
+      PARAMETER ( NDFMAX = 20)
+
+      COMMON/QCGRID/
+     +SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS,
+     +XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45,
+     +NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2),
+     +IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2)
+
+      LOGXGR = .FALSE.
+
+      IF(NXX.LE.0) RETURN
+
+      RAT1   = XXTAB(2)/XXTAB(1)
+      LOGXGR = .TRUE.
+      DO IX = 1,NXX
+        RAT = XXTAB(IX+1)/XXTAB(IX)
+        IF(RAT.NE.RAT1) LOGXGR = .FALSE.
+      ENDDO
+
+      RETURN
+      END
+CDECK  ID>, GRQNUL.
+C     =================
+      SUBROUTINE GRQNUL
+C     =================
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+      LOGICAL
+     +LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB,
+     +LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS,
+     +LALFOK,LDQ2OK,LWT1OK,LWT2OK,
+     +LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ,
+     +LFFCAL,LASOLD
+
+      COMMON/QCFLAG/ 
+     +IORD,IOLAST,
+     +LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB,
+     +LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS,
+     +LALFOK,LDQ2OK,LWT1OK,LWT2OK,
+     +LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ,
+     +LFFCAL(7,30),LASOLD
+      PARAMETER ( MXX = 410 )
+      PARAMETER ( MQ2 =  120 )
+
+C--   Do not set the following parameter to zero!
+      PARAMETER ( NDFMAX = 20)
+
+      COMMON/QCGRID/
+     +SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS,
+     +XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45,
+     +NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2),
+     +IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2)
+      COMMON/QCPASS/
+     +ALPHA0, Q0ALFA, ASLAST, QALAST,
+     +ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2),
+     +DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10),
+     +FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2),
+     +FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2),
+     +FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2),
+     +FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST,
+     +MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2),
+     +ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2),
+     +IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10)
+
+      LOGICAL LEVDONE,LE_DONE
+      COMMON/QCLEVL/
+     +LEVDONE(MXX,10),LE_DONE(MXX)
+
+      CALL QTRACE('GRQNUL ',0)
+C---  Invalidate weight tables (validated by call to QNFILW)
+      LALFOK = .FALSE.
+      LDQ2OK = .FALSE.
+      LWFCOK = .FALSE.
+      LWLCOK = .FALSE.
+      LWFBOK = .FALSE.
+      LWLBOK = .FALSE.
+      LMARK  = .FALSE.
+C--   Invalidate all evolutions      
+      CALL QNFALS(LEVDONE,MXX*10)
+C---  Set grid to zero
+      CALL QNVNUL(Q2TAB,MQ2)
+      NQ2    = 0
+      NGRVER = 0
+
+C---  Update IFAILC
+      CALL GRSETC
+
+C---  Update NFMAP
+      CALL QNSETT
+
+      RETURN
+      END
+CDECK  ID>, GRQINP.
+C
+C     ============================
+      SUBROUTINE GRQINP(QARRAY,NQ)
+C     ============================
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+      LOGICAL
+     +LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB,
+     +LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS,
+     +LALFOK,LDQ2OK,LWT1OK,LWT2OK,
+     +LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ,
+     +LFFCAL,LASOLD
+
+      COMMON/QCFLAG/ 
+     +IORD,IOLAST,
+     +LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB,
+     +LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS,
+     +LALFOK,LDQ2OK,LWT1OK,LWT2OK,
+     +LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ,
+     +LFFCAL(7,30),LASOLD
+      PARAMETER ( MXX = 410 )
+      PARAMETER ( MQ2 =  120 )
+
+C--   Do not set the following parameter to zero!
+      PARAMETER ( NDFMAX = 20)
+
+      COMMON/QCGRID/
+     +SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS,
+     +XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45,
+     +NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2),
+     +IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2)
+      COMMON/QCPASS/
+     +ALPHA0, Q0ALFA, ASLAST, QALAST,
+     +ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2),
+     +DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10),
+     +FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2),
+     +FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2),
+     +FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2),
+     +FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST,
+     +MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2),
+     +ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2),
+     +IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10)
+
+      LOGICAL LEVDONE,LE_DONE
+      COMMON/QCLEVL/
+     +LEVDONE(MXX,10),LE_DONE(MXX)
+      DIMENSION QARRAY(*)
+      DATA EPSI /1.E-6/
+
+      CALL QTRACE('GRQINP ',0)
+      IF(NQ.LE.0) THEN
+        IERR = 1
+        GOTO 500
+      ENDIF
+      IF((NQ+NQ2).GT.MQ2-1) THEN
+        IERR = 2
+        GOTO 500
+      ENDIF
+
+C---  Invalidate weight tables (validated by call to QNFILW)
+      LALFOK = .FALSE.
+      LDQ2OK = .FALSE.
+      LWFCOK = .FALSE.
+      LWLCOK = .FALSE.
+      LWFBOK = .FALSE.
+      LWLBOK = .FALSE.
+      LMARK  = .FALSE.
+C--   Invalidate all evolutions      
+      CALL QNFALS(LEVDONE,MXX*10)
+
+C---  if this number changes, QCDNUM knows that the grid has changed
+      NGRVER = NGRVER + 1
+      IF(NQ2.EQ.0) THEN
+        DO 10 IQ = 1,NQ
+          Q = QARRAY(IQ)
+          IF(Q.LE.0.) THEN
+            IERR = 3
+            GOTO 500
+          ENDIF
+          NQ2    = NQ2+1
+          Q2TAB(IQ) = Q
+  10    CONTINUE
+        RETURN
+      ENDIF
+      DO 100 IQ = 1,NQ
+        Q = QARRAY(IQ)
+        IF(Q.LE.0.) THEN
+          IERR = 3
+          GOTO 500
+        ENDIF
+*mb     IF(Q.LT.Q2TAB(1)-EPSI) THEN
+        IF(Q/Q2TAB(1).LT.1.-EPSI) THEN
+          DO 20 JQ = NQ2,1,-1
+            Q2TAB(JQ+1) = Q2TAB(JQ)
+  20      CONTINUE
+          NQ2    = NQ2+1
+          Q2TAB(1)  = Q
+*mb     ELSEIF(Q.GT.Q2TAB(NQ2)+EPSI) THEN
+        ELSEIF(Q/Q2TAB(NQ2).GT.1.+EPSI) THEN
+          NQ2    = NQ2+1
+          Q2TAB(NQ2) = Q
+        ELSE
+          DO 30 I = 1,NQ2
+*mb         IF(Q2TAB(I).LE.Q+EPSI) IQ0 = I
+            IF(Q2TAB(I)/Q.LE.1.+EPSI) IQ0 = I
+  30      CONTINUE
+*mb       IF(ABS(Q2TAB(IQ0)-Q).LE.EPSI) THEN
+          IF(ABS(Q2TAB(IQ0)/Q-1.).LE.EPSI) THEN
+            Q2TAB(IQ0) = Q
+          ELSE
+            DO 40 JQ = NQ2,IQ0+1,-1
+              Q2TAB(JQ+1) = Q2TAB(JQ)
+  40        CONTINUE
+            NQ2 = NQ2+1
+            Q2TAB(IQ0+1) = Q
+          ENDIF
+        ENDIF
+ 100  CONTINUE
+
+C---  Update IFAILC
+      CALL GRSETC
+
+C---  Update NFMAP
+      CALL QNSETT
+      RETURN
+
+ 500  CONTINUE
+
+      WRITE(6,'(/'' ------------------------------------'')')
+      WRITE(6,'( '' QCDNUM error in s/r GRQINP ---> STOP'')')
+      WRITE(6,'( '' ------------------------------------'')')
+      WRITE(6,'( '' Input Q2 :'',E12.5)') Q
+      WRITE(6,'( ''       NQ :'',I5   )') NQ
+      IF(IERR.EQ.1) THEN
+        WRITE(6,'(/'' NQ must be .ge. 1'')')
+      ELSEIF(IERR.EQ.2) THEN
+        WRITE(6,'(/'' Maximum number of gridpoints exceeded '')')
+        WRITE(6,'(/'' # existing Q2 gridpoints ='',I5/
+     +             '' # points to be added     ='',I5/
+     +             '' maximum # points allowed ='',I5)')
+     +                NQ2, NQ, MQ2-1
+      ELSEIF(IERR.EQ.3) THEN
+        WRITE(6,'(/'' Value of Q2 outside allowed range > 0'')')
+      ENDIF
+
+      CALL QTRACE('GRQINP ',1)
+
+      STOP
+
+      END
+CDECK  ID>, GRQDEF.
+C     ===============================
+      SUBROUTINE GRQDEF(NQ,QMIN,QMAX)
+C     ===============================
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+      LOGICAL
+     +LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB,
+     +LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS,
+     +LALFOK,LDQ2OK,LWT1OK,LWT2OK,
+     +LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ,
+     +LFFCAL,LASOLD
+
+      COMMON/QCFLAG/ 
+     +IORD,IOLAST,
+     +LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB,
+     +LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS,
+     +LALFOK,LDQ2OK,LWT1OK,LWT2OK,
+     +LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ,
+     +LFFCAL(7,30),LASOLD
+      PARAMETER ( MXX = 410 )
+      PARAMETER ( MQ2 =  120 )
+
+C--   Do not set the following parameter to zero!
+      PARAMETER ( NDFMAX = 20)
+
+      COMMON/QCGRID/
+     +SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS,
+     +XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45,
+     +NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2),
+     +IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2)
+      COMMON/QCPASS/
+     +ALPHA0, Q0ALFA, ASLAST, QALAST,
+     +ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2),
+     +DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10),
+     +FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2),
+     +FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2),
+     +FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2),
+     +FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST,
+     +MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2),
+     +ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2),
+     +IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10)
+
+      LOGICAL LEVDONE,LE_DONE
+      COMMON/QCLEVL/
+     +LEVDONE(MXX,10),LE_DONE(MXX)
+      CALL QTRACE('GRQDEF ',0)
+      IF(NQ.LE.1) THEN
+        IERR = 1
+        GOTO 500
+      ENDIF
+      IF(NQ.GT.MQ2-1) THEN
+        IERR = 2
+        GOTO 500
+      ENDIF
+      IF(QMIN.LE.0.OR.QMAX.LE.0.OR.QMIN.GE.QMAX) THEN
+        IERR = 3
+        GOTO 500
+      ENDIF
+
+C---  Invalidate weight tables (validated by call to QNFILW)
+      LALFOK = .FALSE.
+      LDQ2OK = .FALSE.
+      LWFCOK = .FALSE.
+      LWLCOK = .FALSE.
+      LWFBOK = .FALSE.
+      LWLBOK = .FALSE.
+      LMARK  = .FALSE.
+C--   Invalidate all evolutions      
+      CALL QNFALS(LEVDONE,MXX*10)
+C---  if this number changes, QCDNUM knows that the grid has changed
+      NGRVER = NGRVER + 1
+      YMIN = SYFROMQ(QMIN)
+      YMAX = SYFROMQ(QMAX)
+      BW   = (YMAX-YMIN)/(NQ-1)
+      DO I = 1,NQ
+        YI = YMIN+(I-1)*BW
+        Q2TAB(I) = SQFROMY(YI)
+      ENDDO   
+      Q2TAB(1)  = QMIN
+      Q2TAB(NQ) = QMAX
+      NQ2       = NQ
+
+C---  Update IFAILC
+      CALL GRSETC
+
+C---  Update NFMAP
+      CALL QNSETT
+      RETURN
+
+ 500  CONTINUE
+
+      WRITE(6,'(/'' ------------------------------------'')')
+      WRITE(6,'( '' QCDNUM error in s/r GRQDEF ---> STOP'')')
+      WRITE(6,'( '' ------------------------------------'')')
+      WRITE(6,'( '' Input NQ    :'',I5   )') NQ
+      WRITE(6,'( ''       Q2min :'',E12.5)') QMIN
+      WRITE(6,'( ''       Q2max :'',E12.5)') QMAX
+      IF(IERR.EQ.1) THEN
+        WRITE(6,'(/'' NQ must be .ge. 2'')')
+      ELSEIF(IERR.EQ.2) THEN
+        WRITE(6,'(/'' NQ > max number of gridpoints'',
+     +             '' allowed:'',I5)') MQ2-1
+      ELSEIF(IERR.EQ.3) THEN
+        WRITE(6,'(/'' Qmin and/or Qmax .le. 0 or Qmin .ge. Qmax'')')
+      ENDIF
+
+      CALL QTRACE('GRQDEF ',1)
+
+      STOP
+
+      END
+CDECK  ID>, GRQLIM.
+C     ===============================
+      SUBROUTINE GRQLIM(NQ,QMIN,QMAX)
+C     ===============================
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+      LOGICAL
+     +LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB,
+     +LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS,
+     +LALFOK,LDQ2OK,LWT1OK,LWT2OK,
+     +LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ,
+     +LFFCAL,LASOLD
+
+      COMMON/QCFLAG/ 
+     +IORD,IOLAST,
+     +LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB,
+     +LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS,
+     +LALFOK,LDQ2OK,LWT1OK,LWT2OK,
+     +LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ,
+     +LFFCAL(7,30),LASOLD
+      PARAMETER ( MXX = 410 )
+      PARAMETER ( MQ2 =  120 )
+
+C--   Do not set the following parameter to zero!
+      PARAMETER ( NDFMAX = 20)
+
+      COMMON/QCGRID/
+     +SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS,
+     +XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45,
+     +NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2),
+     +IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2)
+      COMMON/QCPASS/
+     +ALPHA0, Q0ALFA, ASLAST, QALAST,
+     +ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2),
+     +DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10),
+     +FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2),
+     +FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2),
+     +FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2),
+     +FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST,
+     +MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2),
+     +ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2),
+     +IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10)
+
+      LOGICAL LEVDONE,LE_DONE
+      COMMON/QCLEVL/
+     +LEVDONE(MXX,10),LE_DONE(MXX)
+      DATA EPSI /1.E-6/
+
+      CALL QTRACE('GRQLIM ',0)
+      IF(NQ.LE.0) THEN
+        IERR = 1
+        GOTO 500
+      ENDIF
+      IF(NQ.GT.MQ2-1) THEN
+        IERR = 2
+        GOTO 500
+      ENDIF
+
+C---  Invalidate weight tables (validated by call to QNFILW)
+      LALFOK = .FALSE.
+      LDQ2OK = .FALSE.
+      LWFCOK = .FALSE.
+      LWLCOK = .FALSE.
+      LWFBOK = .FALSE.
+      LWLBOK = .FALSE.
+      LMARK  = .FALSE.
+C--   Invalidate all evolutions      
+      CALL QNFALS(LEVDONE,MXX*10)
+C---  if this number changes, QCDNUM knows that the grid has changed
+      NGRVER = NGRVER + 1
+      IF(NQ2.EQ.0) THEN
+        IF(QMIN.LE.0..OR.QMAX.LE.0..OR.QMIN.GE.QMAX) THEN
+          IERR = 3
+          GOTO 500
+        ENDIF
+        CALL GRQDEF(NQ,QMI,QMA)
+      ELSE
+        IF(QMIN.LE.0..OR.QMAX.LE.0..OR.QMIN.GE.QMAX) THEN
+          IERR = 3
+          GOTO 500
+        ENDIF
+*mb     IF(QMIN.LT.Q2TAB(1)-EPSI) THEN
+        IF(QMIN/Q2TAB(1).LT.1.-EPSI) THEN
+          DO 20 IQ = NQ2,1,-1
+            Q2TAB(IQ+1) = Q2TAB(IQ)
+  20      CONTINUE
+          NQ2      = NQ2+1
+          Q2TAB(1) = QMIN
+        ENDIF
+*mb     IF(QMAX.GT.Q2TAB(NQ2)+EPSI) THEN
+        IF(QMAX/Q2TAB(NQ2).GT.1.+EPSI) THEN
+          NQ2        = NQ2+1
+          Q2TAB(NQ2) = QMAX
+        ENDIF
+        IF(NQ.GT.NQ2) THEN
+  30      CONTINUE
+          GAPMAX = 0.
+          DO 35 IQ = 1,NQ2-1
+            GAP = SYFROMQ(Q2TAB(IQ+1))-SYFROMQ(Q2TAB(IQ))
+            IF(GAP.GT.GAPMAX) THEN
+              GAPMAX = GAP
+              IQ0    = IQ
+            ENDIF
+  35      CONTINUE
+          DO 40 IQ = NQ2,IQ0+1,-1
+            Q2TAB(IQ+1) = Q2TAB(IQ)
+  40      CONTINUE
+          NQ2 = NQ2+1
+          Q2TAB(IQ0+1) = SQRT(Q2TAB(IQ0)*Q2TAB(IQ0+2))
+          IF(NQ2.LT.NQ) GOTO 30
+        ELSEIF(NQ.LT.NQ2) THEN
+  50      CONTINUE
+          GAPMIN = 999999.
+          DO 55 IQ = 2,NQ2-1
+            GAP = SYFROMQ(Q2TAB(IQ+1))-SYFROMQ(Q2TAB(IQ-1))
+            IF(GAP.LE.GAPMIN) THEN
+              GAPMIN = GAP
+              IQ0    = IQ
+            ENDIF
+  55      CONTINUE
+          DO 60 IQ = IQ0,NQ2-1
+            Q2TAB(IQ) = Q2TAB(IQ+1)
+  60      CONTINUE
+          Q2TAB(NQ2) = 0.
+          NQ2 = NQ2-1
+          IF(NQ2.GT.NQ) GOTO 50
+        ENDIF
+      ENDIF
+
+C---  Update IFAILC
+      CALL GRSETC
+
+C---  Update NFMAP
+      CALL QNSETT
+      RETURN
+
+ 500  CONTINUE
+
+      WRITE(6,'(/'' ------------------------------------'')')
+      WRITE(6,'( '' QCDNUM error in s/r GRQLIM ---> STOP'')')
+      WRITE(6,'( '' ------------------------------------'')')
+      WRITE(6,'( '' Input NQ    :'',I5   )') NQ
+      WRITE(6,'( ''       Q2min :'',E12.5)') QMIN
+      WRITE(6,'( ''       Q2max :'',E12.5)') QMAX
+      IF(IERR.EQ.1) THEN
+        WRITE(6,'(/'' NQ must be .ge. 1'')')
+      ELSEIF(IERR.EQ.2) THEN
+        WRITE(6,'(/'' NQ > max number of gridpoints'',
+     +             '' allowed:'',I5)') MQ2-1
+      ELSEIF(IERR.EQ.3) THEN
+        WRITE(6,'(/'' Qmin and/or Qmax .le. 0 or Qmin .ge. Qmax'')')
+      ENDIF
+
+      CALL QTRACE('GRQLIM ',1)
+
+      STOP
+
+      END
+
+CDECK  ID>, SYFROMQ.
+C     ====================================
+      DOUBLE PRECISION FUNCTION SYFROMQ(Q)
+C     ====================================
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+      PARAMETER ( MXX = 410 )
+      PARAMETER ( MQ2 =  120 )
+
+C--   Do not set the following parameter to zero!
+      PARAMETER ( NDFMAX = 20)
+
+      COMMON/QCGRID/
+     +SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS,
+     +XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45,
+     +NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2),
+     +IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2)
+      IF(Q.LE.SCAQ0) THEN
+        SYFROMQ = LOG(Q)
+      ELSE
+        SYFROMQ = LOG(SCAQ0) + (Q-SCAQ0)/SCAQ0
+      ENDIF
+      RETURN
+      END
+
+CDECK  ID>, SQFROMY.
+C     ====================================
+      DOUBLE PRECISION FUNCTION SQFROMY(Y)
+C     ====================================
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+      PARAMETER ( MXX = 410 )
+      PARAMETER ( MQ2 =  120 )
+
+C--   Do not set the following parameter to zero!
+      PARAMETER ( NDFMAX = 20)
+
+      COMMON/QCGRID/
+     +SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS,
+     +XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45,
+     +NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2),
+     +IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2)
+      IF(Y.LE.LOG(SCAQ0)) THEN
+        SQFROMY = EXP(Y)
+      ELSE
+        SQFROMY = (Y-LOG(SCAQ0)+1.) * SCAQ0
+      ENDIF
+      RETURN
+      END
+CDECK  ID>, GRQOUT.
+C     =========================
+      SUBROUTINE GRQOUT(QARRAY)
+C     =========================
+
+C---  Copy Q2TAB to QARRAY which should have been dimensioned
+C---  to at least NQ2 by the user.
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+      PARAMETER ( MXX = 410 )
+      PARAMETER ( MQ2 =  120 )
+
+C--   Do not set the following parameter to zero!
+      PARAMETER ( NDFMAX = 20)
+
+      COMMON/QCGRID/
+     +SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS,
+     +XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45,
+     +NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2),
+     +IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2)
+      DIMENSION QARRAY(*)
+
+      CALL QTRACE('GRQOUT ',0)
+      DO 10 IQ = 1,NQ2
+        QARRAY(IQ) = Q2TAB(IQ)
+  10  CONTINUE
+      RETURN
+      END
+
+CDECK  ID>, IXFROMX.
+C     ===========================
+      INTEGER FUNCTION IXFROMX(X)
+C     ===========================
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+
+C---  Returns gridindex IX given a value for X.
+C---  If X is outside the current gridboundary then IXFROMX = 0.
+C---  If X corresponds to gridindex IX  then IXFROMX = IX.
+C---  If X lies above IX and below IX+1 then IXFROMX = -IX.
+
+C---  NB: X and XXTAB are different only if |X-XXTAB| < epsi.
+C---  NB: If since the previous call the grid did not change
+C---      (i.e. NGRVER is the same) and if X did not change, then
+C---      IXFROMX just returns the result of the previous call.
+      PARAMETER ( MXX = 410 )
+      PARAMETER ( MQ2 =  120 )
+
+C--   Do not set the following parameter to zero!
+      PARAMETER ( NDFMAX = 20)
+
+      COMMON/QCGRID/
+     +SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS,
+     +XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45,
+     +NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2),
+     +IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2)
+      SAVE XLAST,IXLAST,NGLAST
+      DATA XLAST  / 0. /
+      DATA IXLAST / 0 /
+      DATA NGLAST / 0 /
+      DATA EPSI   /1.E-6/
+
+*     CALL QTRACE('IXFROMX',0)
+      IF(X.EQ.XLAST.AND.NGRVER.EQ.NGLAST) THEN
+        IXFROMX = IXLAST
+        RETURN
+      ENDIF
+      IX      = 0
+      IXLAST  = 0
+      NGLAST  = NGRVER
+      XLAST   = X
+      IXFROMX = 0
+
+      IF(X.GT.1..OR.NXX.LE.0)   RETURN
+      IF(X/XXTAB(1).LT.1.-EPSI) RETURN
+
+      DO 10 I = 1,NXX
+*mb     IF(XXTAB(I).LE.X+EPSI) IX = I
+        IF(XXTAB(I)/X.LE.1.+EPSI) IX = I
+  10  CONTINUE
+*mb   IF(ABS(XXTAB(IX)-X).LE.EPSI) THEN
+      IF(ABS(XXTAB(IX)/X-1.).LE.EPSI) THEN
+        IXFROMX = IX
+        IXLAST  = IX
+      ELSE
+        IXFROMX = -IX
+        IXLAST  = -IX
+      ENDIF
+      RETURN
+      END
+
+C------------------------------------------------
+
+*-      REAL XR,X1,X2,XLAST
+*- 
+*-+SEQ,QCNXQM.
+*-+SEQ,QCGRID.
+*- 
+*-      SAVE XLAST,IXLAST,NGLAST
+*- 
+*-      DATA XLAST  / 0. /
+*-      DATA IXLAST / 0 /
+*-      DATA NGLAST / 0 /
+*-
+*-*     CALL QTRACE('IXFROMX',0)
+*- 
+*-      XR = X
+*-      IF(XR.EQ.XLAST.AND.NGRVER.EQ.NGLAST) THEN
+*-        IXFROMX = IXLAST
+*-        RETURN
+*-      ENDIF
+*- 
+*-      IX      = 0
+*-      IXLAST  = 0
+*-      NGLAST  = NGRVER
+*-      XLAST   = X
+*-      IXFROMX = 0
+*-
+*-      IF(XR.GT.1..OR.NXX.LE.0)   RETURN
+*-      X1 = XXTAB(1)
+*-      IF(XR.LT.X1)               RETURN
+*-
+*-      DO IX = 1,NXX
+*-        X2 = XXTAB(IX+1)
+*-        IF(X1.LE.XR.AND.XR.LT.X2) THEN
+*-          IXFROMX = -IX
+*-          IF(X1.EQ.XR) IXFROMX = IX
+*-          IXLAST = IX
+*-          RETURN
+*-        ENDIF
+*-        X1 = X2
+*-      ENDDO
+*- 
+*-      RETURN
+*-      END
+
+CDECK  ID>, IHFROMH.
+C     ===========================
+      INTEGER FUNCTION IHFROMH(X)
+C     ===========================
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+
+C---  Returns gridindex IX of heavy quark grid given a value for X.
+C---  If X is outside the current gridboundary then IHFROMH = 0.
+C---  If X corresponds to gridindex IX  then IHFROMH = IX.
+C---  If X lies above IX and below IX+1 then IHFROMH = -IX.
+
+C---  NB: X and XHTAB are different only if |X-XHTAB| < epsi.
+C---  NB: If since the previous call the grid did not change
+C---      (i.e. NGRVER is the same) and if X did not change, then
+C---      IHFROMH just returns the result of the previous call.
+      PARAMETER ( MXX = 410 )
+      PARAMETER ( MQ2 =  120 )
+
+C--   Do not set the following parameter to zero!
+      PARAMETER ( NDFMAX = 20)
+
+      COMMON/QCGRID/
+     +SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS,
+     +XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45,
+     +NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2),
+     +IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2)
+      SAVE XLAST,IXLAST,NGLAST
+      DATA XLAST  / 0. /
+      DATA IXLAST / 0 /
+      DATA NGLAST / 0 /
+      DATA EPSI   /1.E-6/
+
+*     CALL QTRACE('IHFROMH',0)
+      IF(X.EQ.XLAST.AND.NGRVER.EQ.NGLAST) THEN
+        IHFROMH = IXLAST
+        RETURN
+      ENDIF
+      IX      = 0
+      IXLAST  = 0
+      NGLAST  = NGRVER
+      XLAST   = X
+      IHFROMH = 0
+
+      IF(X.GT.1..OR.NXX.LE.0)   RETURN
+      IF(X/XHTAB(1).LT.1.-EPSI) RETURN
+
+      DO 10 I = 1,NXX
+*mb     IF(XHTAB(I).LE.X+EPSI) IX = I
+        IF(XHTAB(I)/X.LE.1.+EPSI) IX = I
+  10  CONTINUE
+*mb   IF(ABS(XHTAB(IX)-X).LE.EPSI) THEN
+      IF(ABS(XHTAB(IX)/X-1.).LE.EPSI) THEN
+        IHFROMH = IX
+        IXLAST  = IX
+      ELSE
+        IHFROMH = -IX
+        IXLAST  = -IX
+      ENDIF
+      RETURN
+      END
+
+C------------------------------------------------
+
+*-      REAL XR,X1,X2,XLAST
+*- 
+*-+SEQ,QCNXQM.
+*-+SEQ,QCGRID.
+*- 
+*-      SAVE XLAST,IXLAST,NGLAST
+*- 
+*-      DATA XLAST  / 0. /
+*-      DATA IXLAST / 0 /
+*-      DATA NGLAST / 0 /
+*-
+*-*     CALL QTRACE('IXFROMX',0)
+*- 
+*-      XR = X
+*-      IF(XR.EQ.XLAST.AND.NGRVER.EQ.NGLAST) THEN
+*-        IXFROMX = IXLAST
+*-        RETURN
+*-      ENDIF
+*- 
+*-      IX      = 0
+*-      IXLAST  = 0
+*-      NGLAST  = NGRVER
+*-      XLAST   = X
+*-      IXFROMX = 0
+*-
+*-      IF(XR.GT.1..OR.NXX.LE.0)   RETURN
+*-      X1 = XHTAB(1)
+*-      IF(XR.LT.X1)               RETURN
+*-
+*-      DO IX = 1,NXX
+*-        X2 = XHTAB(IX+1)
+*-        IF(X1.LE.XR.AND.XR.LT.X2) THEN
+*-          IXFROMX = -IX
+*-          IF(X1.EQ.XR) IXFROMX = IX
+*-          IXLAST = IX
+*-          RETURN
+*-        ENDIF
+*-        X1 = X2
+*-      ENDDO
+*- 
+*-      RETURN
+*-      END
+
+CDECK  ID>, IXNEARX.
+C     ===========================
+      INTEGER FUNCTION IXNEARX(X)
+C     ===========================
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+
+C---  Returns closest gridindex IX given a value for X.
+C---  If X is outside the current gridboundary then IXNEARX = 0.
+C---  If X corresponds to gridindex IX  then IXNEARX = IX.
+C---  If X lies above IX and below IX+1 then IXNEARX = -IX or -IX-1.
+
+C---  NB: X and XXTAB are different only if |X-XXTAB| < epsi.
+C---  NB: If since the previous call the grid did not change
+C---      (i.e. NGRVER is the same) and if X did not change, then
+C---      IXNEARX just returns the result of the previous call.
+      PARAMETER ( MXX = 410 )
+      PARAMETER ( MQ2 =  120 )
+
+C--   Do not set the following parameter to zero!
+      PARAMETER ( NDFMAX = 20)
+
+      COMMON/QCGRID/
+     +SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS,
+     +XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45,
+     +NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2),
+     +IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2)
+      SAVE XLAST,IXLAST,NGLAST
+      DATA XLAST  / 0. /
+      DATA IXLAST / 0 /
+      DATA NGLAST / 0 /
+      DATA EPSI   /1.E-6/
+
+*     CALL QTRACE('IXNEARX',0)
+      IF(X.EQ.XLAST.AND.NGRVER.EQ.NGLAST) THEN
+        IXNEARX = IXLAST
+        RETURN
+      ENDIF
+      IX      = 0
+      IXLAST  = 0
+      NGLAST  = NGRVER
+      XLAST   = X
+      IXNEARX = 0
+
+      IF(X.GT.1..OR.NXX.LE.0)   RETURN
+      IF(X/XXTAB(1).LT.1.-EPSI) RETURN
+
+      DO 10 I = 1,NXX
+*mb     IF(XXTAB(I).LE.X+EPSI) IX = I
+        IF(XXTAB(I)/X.LE.1.+EPSI) IX = I
+  10  CONTINUE
+*mb   IF(ABS(XXTAB(IX)-X).LE.EPSI) THEN
+      IF(ABS(XXTAB(IX)/X-1.).LE.EPSI) THEN
+        IXNEARX = IX
+        IXLAST  = IX
+      ELSE
+        GAP     = SYFROMX(XXTAB(IX+1))-SYFROMX(XXTAB(IX))
+        DEL     = SYFROMX(X)-SYFROMX(XXTAB(IX))
+        IF(DEL/GAP.LE.0.5) THEN
+          IXNEARX = -IX
+        ELSE
+          IXNEARX = -MIN(IX+1,NXX)
+        ENDIF
+        IXLAST  = IXNEARX
+      ENDIF
+      RETURN
+      END
+
+CDECK  ID>, IQFROMQ.
+C     ===========================
+      INTEGER FUNCTION IQFROMQ(Q)
+C     ===========================
+
+C---  Returns gridindex IQ given a value for Q.
+C---  If Q is outside the current gridboundary then IQFROMQ = 0.
+C---  If Q corresponds to gridindex IQ  then IQFROMQ = IQ.
+C---  If Q lies above IQ and below IQ+1 then IQFROMQ = -IQ.
+
+C---  NB: Q and Q2TAB are different only if |Q-Q2TAB| < epsi.
+C---  NB: If since the previous call the grid did not change
+C---      (i.e. NGRVER is the same) and if Q did not change, then
+C---      IQFROMQ just returns the result of the previous call.
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+      PARAMETER ( MXX = 410 )
+      PARAMETER ( MQ2 =  120 )
+
+C--   Do not set the following parameter to zero!
+      PARAMETER ( NDFMAX = 20)
+
+      COMMON/QCGRID/
+     +SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS,
+     +XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45,
+     +NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2),
+     +IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2)
+      SAVE QLAST,IQLAST,NGLAST
+      DATA QLAST  / 0. /
+      DATA IQLAST / 0 /
+      DATA NGLAST / 0 /
+      DATA EPSI   /1.E-6/
+
+*     CALL QTRACE('IQFROMQ',0)
+      IF(Q.EQ.QLAST.AND.NGRVER.EQ.NGLAST) THEN
+        IQFROMQ = IQLAST
+        RETURN
+      ENDIF
+      IQ      = 0
+      IQLAST  = 0
+      NGLAST  = NGRVER
+      QLAST   = Q
+      IQFROMQ = 0
+
+      IF(NQ2.EQ.0)                RETURN
+      IF(Q/Q2TAB(1).LT.1.-EPSI)   RETURN
+      IF(Q/Q2TAB(NQ2).GT.1.+EPSI) RETURN
+
+      DO 10 I = 1,NQ2
+*mb   IF(Q2TAB(I).LE.Q+EPSI) IQ = I
+      IF(Q2TAB(I)/Q.LE.1.+EPSI) IQ = I
+  10  CONTINUE
+*mb   IF(ABS(Q2TAB(IQ)-Q).LE.EPSI) THEN
+      IF(ABS(Q2TAB(IQ)/Q-1.).LE.EPSI) THEN
+        IQFROMQ = IQ
+        IQLAST  = IQ
+      ELSE
+        IQFROMQ = -IQ
+        IQLAST  = -IQ
+      ENDIF
+      RETURN
+      END
+
+C------------------------------------------------
+
+*-      REAL QR,Q1,Q2,QLAST
+*- 
+*-+SEQ,QCNXQM.
+*-+SEQ,QCGRID.
+*- 
+*-      SAVE QLAST,IQLAST,NGLAST
+*- 
+*-      DATA QLAST  / 0. /
+*-      DATA IQLAST / 0 /
+*-      DATA NGLAST / 0 /
+*-
+*-*     CALL QTRACE('IQFROMQ',0)
+*- 
+*-      QR = Q
+*-      IF(QR.EQ.QLAST.AND.NGRVER.EQ.NGLAST) THEN
+*-        IQFROMQ = IQLAST
+*-        RETURN
+*-      ENDIF
+*- 
+*-      IQ      = 0
+*-      IQLAST  = 0
+*-      NGLAST  = NGRVER
+*-      QLAST   = Q
+*-      IQFROMQ = 0
+*-
+*-
+*-      IF(NQ2.LE.0)   RETURN
+*-      Q1 = Q2TAB(1)
+*-      IF(QR.LT.Q1)   RETURN
+*-      Q2 = Q2TAB(NQ2)
+*-      IF(QR.GT.Q2)   RETURN
+*-      IF(QR.EQ.Q2)   THEN
+*-        IQFROMQ = NQ2
+*-        IQLAST  = NQ2
+*-        RETURN
+*-      ENDIF
+*-
+*-      DO IQ = 1,NQ2-1
+*-        Q2 = Q2TAB(IQ+1)
+*-        IF(Q1.LE.QR.AND.QR.LT.Q2) THEN
+*-          IQFROMQ = -IQ
+*-          IF(Q1.EQ.QR) IQFROMQ = IQ
+*-          IQLAST = IQ
+*-          RETURN
+*-        ENDIF
+*-        Q1 = Q2
+*-      ENDDO
+*- 
+*-      RETURN
+*-      END
+
+CDECK  ID>, IQNEARQ.
+C     ===========================
+      INTEGER FUNCTION IQNEARQ(Q)
+C     ===========================
+
+C---  Returns closest gridindex IQ given a value for Q.
+C---  If Q is outside the current gridboundary then IQNEARQ = 0.
+C---  If Q corresponds to gridindex IQ  then IQNEARQ = IQ.
+C---  If Q lies above IQ and below IQ+1 then IQNEARQ = -IQ or -IQ-1.
+
+C---  NB: Q and Q2TAB are different only if |Q-Q2TAB| < epsi.
+C---  NB: If since the previous call the grid did not change
+C---      (i.e. NGRVER is the same) and if Q did not change, then
+C---      IQNEARQ just returns the result of the previous call.
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+      PARAMETER ( MXX = 410 )
+      PARAMETER ( MQ2 =  120 )
+
+C--   Do not set the following parameter to zero!
+      PARAMETER ( NDFMAX = 20)
+
+      COMMON/QCGRID/
+     +SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS,
+     +XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45,
+     +NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2),
+     +IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2)
+      SAVE QLAST,IQLAST,NGLAST
+      DATA QLAST  / 0. /
+      DATA IQLAST / 0 /
+      DATA NGLAST / 0 /
+      DATA EPSI   /1.E-6/
+
+*     CALL QTRACE('IQNEARQ',0)
+      IF(Q.EQ.QLAST.AND.NGRVER.EQ.NGLAST) THEN
+        IQNEARQ = IQLAST
+        RETURN
+      ENDIF
+      IQ      = 0
+      IQLAST  = 0
+      NGLAST  = NGRVER
+      QLAST   = Q
+      IQNEARQ = 0
+
+      IF(NQ2.EQ.0)                RETURN
+      IF(Q/Q2TAB(1).LT.1.-EPSI)   RETURN
+      IF(Q/Q2TAB(NQ2).GT.1.+EPSI) RETURN
+
+      DO 10 I = 1,NQ2
+*mb   IF(Q2TAB(I).LE.Q+EPSI) IQ = I
+      IF(Q2TAB(I)/Q.LE.1.+EPSI) IQ = I
+  10  CONTINUE
+*mb   IF(ABS(Q2TAB(IQ)-Q).LE.EPSI) THEN
+      IF(ABS(Q2TAB(IQ)/Q-1.).LE.EPSI) THEN
+        IQNEARQ = IQ
+        IQLAST  = IQ
+      ELSE
+        GAP     = LOG(Q2TAB(IQ+1)/Q2TAB(IQ))
+        DEL     = LOG(Q/Q2TAB(IQ))
+        IF(DEL/GAP.LE.0.5) THEN
+          IQNEARQ = -IQ
+        ELSE
+          IQNEARQ = -MIN(IQ+1,NQ2)
+        ENDIF
+        IQLAST  = IQNEARQ
+      ENDIF
+      RETURN
+      END
+
+CDECK  ID>, XFROMIX.
+C     =====================================
+      DOUBLE PRECISION FUNCTION XFROMIX(IX)
+C     =====================================
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+
+C---  Returns x given the gridindex IX.
+C---  If IX is out of range [1,NXX] then XFROMIX = 0.
+
+      PARAMETER ( MXX = 410 )
+      PARAMETER ( MQ2 =  120 )
+
+C--   Do not set the following parameter to zero!
+      PARAMETER ( NDFMAX = 20)
+
+      COMMON/QCGRID/
+     +SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS,
+     +XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45,
+     +NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2),
+     +IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2)
+
+*     CALL QTRACE('XFROMIX',0)
+      IF(IX.LE.0) THEN
+        XFROMIX = 0.
+      ELSEIF(IX.GT.NXX) THEN
+        XFROMIX = 0.
+      ELSE
+        XFROMIX = XXTAB(IX)
+      ENDIF
+      RETURN
+      END
+
+CDECK  ID>, QFROMIQ.
+C
+C     =====================================
+      DOUBLE PRECISION FUNCTION QFROMIQ(IQ)
+C     =====================================
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+
+C---  Returns Q2 given the gridindex IQ.
+C---  If IQ is out of range [1,NQ2] then QFROMIQ = 0.
+      PARAMETER ( MXX = 410 )
+      PARAMETER ( MQ2 =  120 )
+
+C--   Do not set the following parameter to zero!
+      PARAMETER ( NDFMAX = 20)
+
+      COMMON/QCGRID/
+     +SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS,
+     +XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45,
+     +NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2),
+     +IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2)
+
+*     CALL QTRACE('QFROMIQ',0)
+      IF(IQ.LE.0) THEN
+        QFROMIQ = 0.
+      ELSEIF(IQ.GT.NQ2) THEN
+        QFROMIQ = 0.
+      ELSE
+        QFROMIQ = Q2TAB(IQ)
+      ENDIF
+      RETURN
+      END
+
+CDECK  ID>, GRCUTS.
+C     ====================================
+      SUBROUTINE GRCUTS(XMI,QMI,QMA,ROOTS)
+C     ====================================
+
+C---  GRCUTS:  user input of cuts.
+C---  Input :  Double precision XMI:  reject x  .lt. XMI
+C---                            QMI:  reject Q2 .lt. QMI
+C---                            QMA:  reject Q2 .gt. QMA
+C---                          ROOTS:  reject Q2 .gt. x * roots**2
+C---  Output:  XMICUT, QMICUT, QMACUT, RS2CUT in +seq,QCGRID.
+C---  NB    :  No cut is applied when XMI etc .le. 0 (XMICUT etc = -1.)
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+      PARAMETER ( MXX = 410 )
+      PARAMETER ( MQ2 =  120 )
+
+C--   Do not set the following parameter to zero!
+      PARAMETER ( NDFMAX = 20)
+
+      COMMON/QCGRID/
+     +SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS,
+     +XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45,
+     +NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2),
+     +IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2)
+
+      CALL QTRACE('GRCUTS ',0)
+
+      IF(XMI.LE.0..OR.XMI.GE.1.) THEN
+        XMICUT = -1.
+      ELSE
+        XMICUT = XMI
+      ENDIF
+
+      IF(QMI.LE.0.) THEN
+        QMICUT = -1.
+      ELSE
+        QMICUT = QMI
+      ENDIF
+
+      IF(QMA.LE.0.) THEN
+        QMACUT = -0.5
+      ELSE
+        QMACUT = QMA
+      ENDIF
+
+      IF(ROOTS.LE.0.) THEN
+        RS2CUT = -1.
+      ELSE
+        RS2CUT = ROOTS*ROOTS
+      ENDIF
+
+      IF(QMICUT.GE.QMACUT.AND.QMACUT.GT.0.) THEN
+
+        WRITE(6,'(/'' ------------------------------------'')')
+        WRITE(6,'( '' QCDNUM error in s/r GRCUTS ---> STOP'')')
+        WRITE(6,'( '' ------------------------------------'')')
+        WRITE(6,'( '' Input Xmin  :'',E12.5)') XMI
+        WRITE(6,'( ''       Q2min :'',E12.5)') QMI
+        WRITE(6,'( ''       Q2max :'',E12.5)') QMA
+        WRITE(6,'( ''       rootS :'',E12.5)') ROOTS
+        WRITE(6,'(/'' Value of Q2min .ge. Q2max'')')
+
+        CALL QTRACE('GRCUTS ',1)
+
+        STOP
+
+      ENDIF
+
+      CALL GRSETC
+
+      RETURN
+      END
+
+CDECK  ID>, GRSETC.
+C     =================
+      SUBROUTINE GRSETC
+C     =================
+
+C---  Input:  XMIN, QMIN, QMAX, RS2CUT + grid-definitions, all this
+C---          as stored in QCGRID.
+C---  Output: integer array IFAILC(IX,IQ) (see below).
+C---  Called  by GRCUTS (user input of cuts) and
+C---          by all grid definition routines (update of IFAILC).
+
+C---  Fill the array IFAILC(IX,IQ) such that
+C---  IFAILC = 0    : gridpoint passes all cuts
+C---  IFAILC = ijkl : i = 0/1 no/yes fail roots cut
+C---                  j = 0/1 no/yes fail qmax cut
+C---                  k = 0/1 no/yes fail qmin cut
+C---                  l = 0/1 no/yes fail xmin cut
+
+C---  For any  x,Q2 passing the cuts the four surrounding gridpoints
+C---  will also be flagged as passing the cut. This then guarantees
+C---  that parton distributions are available on the surrounding
+C---  gridpoints for interpolation purposes.
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+      LOGICAL
+     +LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB,
+     +LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS,
+     +LALFOK,LDQ2OK,LWT1OK,LWT2OK,
+     +LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ,
+     +LFFCAL,LASOLD
+
+      COMMON/QCFLAG/ 
+     +IORD,IOLAST,
+     +LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB,
+     +LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS,
+     +LALFOK,LDQ2OK,LWT1OK,LWT2OK,
+     +LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ,
+     +LFFCAL(7,30),LASOLD
+      PARAMETER ( MXX = 410 )
+      PARAMETER ( MQ2 =  120 )
+
+C--   Do not set the following parameter to zero!
+      PARAMETER ( NDFMAX = 20)
+
+      COMMON/QCGRID/
+     +SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS,
+     +XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45,
+     +NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2),
+     +IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2)
+      COMMON/QCPASS/
+     +ALPHA0, Q0ALFA, ASLAST, QALAST,
+     +ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2),
+     +DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10),
+     +FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2),
+     +FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2),
+     +FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2),
+     +FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST,
+     +MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2),
+     +ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2),
+     +IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10)
+
+      LOGICAL LEVDONE,LE_DONE
+      COMMON/QCLEVL/
+     +LEVDONE(MXX,10),LE_DONE(MXX)
+
+      DO IX = 1,MXX
+        DO IQ = 1,MQ2
+          IFAILC(IX,IQ) = 11111
+        ENDDO
+      ENDDO
+      IF(NXX.LE.0)  RETURN
+      IF(NQ2.LE.0)  RETURN
+
+      DO IQ = 1,NQ2
+        DO IX = 1,NXX
+          IXP1          = MIN(IX+1,NXX)
+          IQP1          = MIN(IQ+1,NQ2)
+          IQM1          = MAX(IQ-1,1)
+          IFAILC(IX,IQ) = 0
+          IF(XXTAB(IXP1).LE.XMICUT.AND.XMICUT.GT.0.)
+     +       IFAILC(IX,IQ) = IFAILC(IX,IQ)+1
+          IF(Q2TAB(IQP1).LE.QMICUT.AND.QMICUT.GT.0.)
+     +       IFAILC(IX,IQ) = IFAILC(IX,IQ)+10
+          IF(Q2TAB(IQM1).GE.QMACUT.AND.QMACUT.GT.0.)
+     +       IFAILC(IX,IQ) = IFAILC(IX,IQ)+100
+          IF(Q2TAB(IQM1).GE.XXTAB(IXP1)*RS2CUT.AND.RS2CUT.GT.0.)
+     +       IFAILC(IX,IQ) = IFAILC(IX,IQ)+1000
+          IF(Q2TAB(IQP1).LE.QMINAS.AND.QMINAS.GT.0.)
+     +       IFAILC(IX,IQ) = IFAILC(IX,IQ)+10000
+
+        ENDDO
+      ENDDO
+
+C--   Invalidate all evolutions      
+      CALL QNFALS(LEVDONE,MXX*10)
+
+      RETURN
+      END
+
+CDECK  ID>, IFAILXQ.
+C     =============================
+      INTEGER FUNCTION IFAILXQ(X,Q)
+C     =============================
+
+C---  User interface to ICUTXQ
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+
+      CALL QTRACE('IFAILXQ',0)
+
+      IFAILXQ = ICUTXQ(X,Q,0)
+
+      RETURN
+      END
+
+CDECK  ID>, ICUTXQ.
+C     ==================================
+      INTEGER FUNCTION ICUTXQ(X,Q,IPRIN)
+C     ==================================
+
+C---  ICUTXQ = ijkl : i = 0/1  no/yes fail ROOTS cut
+C---                  j = 0/1  no/yes fail QMAX cut
+C---                  k = 0/1  no/yes fail QMIN cut
+C---                  l = 0/1  no/yes fail XMIN cut
+
+C---  Input integer IPRIN = 0/1 no/yes printout.
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+      PARAMETER ( MXX = 410 )
+      PARAMETER ( MQ2 =  120 )
+
+C--   Do not set the following parameter to zero!
+      PARAMETER ( NDFMAX = 20)
+
+      COMMON/QCGRID/
+     +SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS,
+     +XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45,
+     +NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2),
+     +IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2)
+
+      CHARACTER*4 PASS(0:1)
+
+      DATA PASS /'pass','fail'/
+
+C--   No x-grid available
+      IF(NXX.LE.0) THEN
+        ICUTXQ = 11111
+        RETURN
+      ENDIF
+C--   No Q2 grid available
+      IF(NQ2.LE.0) THEN
+        ICUTXQ = 11111
+        RETURN
+      ENDIF
+C--   x > 1
+      IF(X.GT.1.0) THEN
+        ICUTXQ = 11111
+        RETURN
+      ENDIF
+
+      I1 = 0
+      I2 = 0
+      I3 = 0
+      I4 = 0
+      I5 = 0
+
+      IF((X.LT.XXTAB(1)).OR.(X.LT.XMICUT.AND.XMICUT.GT.0.))
+     +    I1 = 1
+      IF((Q.LT.Q2TAB(1)).OR.(Q.LT.QMICUT.AND.QMICUT.GT.0.))
+     +    I2 = 1
+      IF((Q.GT.Q2TAB(NQ2)).OR.(Q.GT.QMACUT.AND.QMACUT.GT.0.))
+     +    I3 = 1
+      IF(Q.GT.X*RS2CUT.AND.RS2CUT.GT.0.) 
+     +    I4 = 1
+      IF((Q.LT.Q2TAB(1)).OR.(Q.LT.QMINAS.AND.QMINAS.GT.0.))
+     +    I5 = 1
+
+      ICUTXQ = 10000*I5 + 1000*I4 + 100*I3 + 10*I2 + I1
+
+      IF(IPRIN.EQ.1) THEN
+
+        XMIPR = XMICUT
+        IF(XMICUT.LE.0.) XMIPR = XXTAB(1)
+        QMIPR = QMICUT
+        IF(QMICUT.LE.0.) QMIPR = Q2TAB(1)
+        QMAPR = QMACUT
+        IF(QMACUT.LE.0.) QMAPR = Q2TAB(NQ2)
+        WRITE(6,'('' '')')
+        WRITE(6,'('' x  ='',E12.5,'' xmin        = '',E12.5,
+     +            '' pass/fail = '',A4)') X, XMIPR, PASS(I1)
+        WRITE(6,'('' Q2 ='',E12.5,'' Qmin        = '',E12.5,
+     +            '' pass/fail = '',A4)') Q, QMIPR, PASS(I2)
+        WRITE(6,'('' Q2 ='',E12.5,'' Qmax        = '',E12.5,
+     +            '' pass/fail = '',A4)') Q, QMAPR, PASS(I3)
+        WRITE(6,'('' s  ='',E12.5,'' Smax        = '',E12.5,
+     +            '' pass/fail = '',A4)') Q/X, RS2CUT, PASS(I4)
+        WRITE(6,'('' Q2 ='',E12.5,'' Qmin_alphas = '',E12.5,
+     +            '' pass/fail = '',A4)') Q, QMINAS, PASS(I5)
+        WRITE(6,'('' '')')
+
+      ENDIF
+
+      RETURN
+      END
+
+CDECK  ID>, IFAILIJ.
+C     ===============================
+      INTEGER FUNCTION IFAILIJ(IX,IQ)
+C     ===============================
+
+C---  User interface to ICUTIJ
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+
+      CALL QTRACE('IFAILIJ',0)
+
+      IFAILIJ = ICUTIJ(IX,IQ,0)
+
+      RETURN
+      END
+
+CDECK  ID>, ICUTIJ.
+C     ====================================
+      INTEGER FUNCTION ICUTIJ(JX,JQ,IPRIN)
+C     ====================================
+
+C---  ICUTIJ = ijklm : i = 0/1  no/yes fail QMINA cut
+C---                   j = 0/1  no/yes fail ROOTS cut
+C---                   k = 0/1  no/yes fail QMAX  cut
+C---                   l = 0/1  no/yes fail QMIN  cut
+C---                   m = 0/1  no/yes fail XMIN  cut
+
+C---  ijklm is taken from array IFAILC.
+C---  IFAILC is set by s/r GRSETC
+
+C---  Input integer IPRIN = 0/1 no/yes printout.
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+      PARAMETER ( MXX = 410 )
+      PARAMETER ( MQ2 =  120 )
+
+C--   Do not set the following parameter to zero!
+      PARAMETER ( NDFMAX = 20)
+
+      COMMON/QCGRID/
+     +SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS,
+     +XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45,
+     +NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2),
+     +IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2)
+
+      CHARACTER*4 PASS(0:1)
+
+      DATA PASS /'pass','fail'/
+
+      ICUTIJ = 11111
+
+C--   No x-grid available
+      IF(NXX.LE.0) RETURN
+C--   No Q2 grid available
+      IF(NQ2.LE.0) RETURN
+
+      IX     = ABS(JX)
+      IQ     = ABS(JQ)
+      IF(IX.GE.1.AND.IX.LE.NXX.AND.IQ.GE.1.AND.IQ.LE.NQ2)
+     +  ICUTIJ = IFAILC(IX,IQ)
+
+      IF(IPRIN.EQ.1) THEN
+
+        IF(IX.GE.1.AND.IX.LE.NXX.AND.IQ.GE.1.AND.IQ.LE.NQ2) THEN
+          X  =  XXTAB(IX)
+          Q  =  Q2TAB(IQ)
+        ELSE
+          X  =  0.
+          Q  =  0.
+        ENDIF
+        I5 =  ICUTIJ/10000.
+        I4 = (ICUTIJ-10000*I5)/1000.
+        I3 = (ICUTIJ-10000*I5-1000*I4)/100.
+        I2 = (ICUTIJ-10000*I5-1000*I4-100*I3)/10.
+        I1 =  ICUTIJ-10000*I5-1000*I4-100*I3-10*I2
+
+        XMIPR = XMICUT
+        IF(XMICUT.LE.0.) XMIPR = XXTAB(1)
+        QMIPR = QMICUT
+        IF(QMICUT.LE.0.) QMIPR = Q2TAB(1)
+        QMAPR = QMACUT
+        IF(QMACUT.LE.0.) QMAPR = Q2TAB(NQ2)
+        WRITE(6,'('' '')')
+        WRITE(6,'('' IX = '',I5,'' x  ='',E12.5,'' xmin        = '',
+     +  E12.5,'' pass/fail = '',A4)') IX, X, XMIPR, PASS(I1)
+        WRITE(6,'('' IQ = '',I5,'' Q2 ='',E12.5,'' Qmin        = '',
+     +  E12.5,'' pass/fail = '',A4)') IQ, Q, QMIPR, PASS(I2)
+        WRITE(6,'('' IQ = '',I5,'' Q2 ='',E12.5,'' Qmax        = '',
+     +  E12.5,'' pass/fail = '',A4)') IQ, Q, QMAPR, PASS(I3)
+        WRITE(6,'(''      '',5X,'' s  ='',E12.5,'' Smax        = '',
+     +  E12.5,'' pass/fail = '',A4)') Q/X, RS2CUT, PASS(I4)
+        WRITE(6,'('' IQ = '',I5,'' Q2 ='',E12.5,'' Qmin_alphas = '',
+     +  E12.5,'' pass/fail = '',A4)') IQ, Q, QMINAS, PASS(I5)
+        WRITE(6,'('' '')')
+
+      ENDIF
+
+      RETURN
+      END
+
+CDECK  ID>, QTHRES.
+C     ==========================
+      SUBROUTINE QTHRES(T34,T45)
+C     ==========================
+
+C---  QTHRES:  user input of flavour thresholds.
+C---  Input :  Double precision T34:  Q2 .lt. T34 --> f = 3
+C---                                  Q2 .ge. T34 --> f = 4
+C---                            T45:  Q2 .lt. T45 --> f = 4
+C---                                  Q2 .ge. T45 --> f = 5
+C---  Output:  THRS34 and THRS45 in +seq,QCGRID.
+C---  NB1   :  Default THRS34 = -huge, THRS45 = +huge --> f = 4.
+C---  NB2   :  The array NFMAP(Q2) = 3,4,5 is setup here through a
+C---           call to QNSETT and maintained further in the grid
+C---           defining routines.
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+      PARAMETER ( MXX = 410 )
+      PARAMETER ( MQ2 =  120 )
+
+C--   Do not set the following parameter to zero!
+      PARAMETER ( NDFMAX = 20)
+
+      COMMON/QCGRID/
+     +SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS,
+     +XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45,
+     +NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2),
+     +IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2)
+
+      CALL QTRACE('QTHRES ',0)
+
+      IF(T34.GE.T45) THEN
+        IERR = 1
+        GOTO 500
+      ENDIF
+
+      THRS34 = T34
+      THRS45 = T45
+
+C---  Fill the flavour map
+      CALL QNSETT
+
+      RETURN
+
+ 500  CONTINUE
+
+      WRITE(6,'(/'' ------------------------------------'')')
+      WRITE(6,'( '' QCDNUM error in s/r QTHRES ---> STOP'')')
+      WRITE(6,'( '' ------------------------------------'')')
+      WRITE(6,'( '' Input Threshold34 :'',E12.5)') T34
+      WRITE(6,'( ''       Threshold45 :'',E12.5)') T45
+      WRITE(6,'(/'' Value of T34 .ge. T45'')')
+
+      CALL QTRACE('QTHRES ',1)
+
+      STOP
+
+      END
+
+CDECK  ID>, QNSETT.
+C     =================
+      SUBROUTINE QNSETT
+C     =================
+
+C---  Input:  THRS34 and THRS45 + grid-definitions, all this
+C---          as stored in QCGRID.
+C---  Output: integer array NFMAP(IQ) = 3,4,5
+C---  Called  by QTHRES (user input of thresholds) and
+C---          by all grid definition routines (update of NFMAP).
+
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+      LOGICAL
+     +LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB,
+     +LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS,
+     +LALFOK,LDQ2OK,LWT1OK,LWT2OK,
+     +LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ,
+     +LFFCAL,LASOLD
+
+      COMMON/QCFLAG/ 
+     +IORD,IOLAST,
+     +LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB,
+     +LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS,
+     +LALFOK,LDQ2OK,LWT1OK,LWT2OK,
+     +LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ,
+     +LFFCAL(7,30),LASOLD
+      PARAMETER ( MXX = 410 )
+      PARAMETER ( MQ2 =  120 )
+
+C--   Do not set the following parameter to zero!
+      PARAMETER ( NDFMAX = 20)
+
+      COMMON/QCGRID/
+     +SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS,
+     +XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45,
+     +NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2),
+     +IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2)
+      COMMON/QCPASS/
+     +ALPHA0, Q0ALFA, ASLAST, QALAST,
+     +ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2),
+     +DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10),
+     +FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2),
+     +FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2),
+     +FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2),
+     +FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST,
+     +MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2),
+     +ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2),
+     +IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10)
+
+      LOGICAL LEVDONE,LE_DONE
+      COMMON/QCLEVL/
+     +LEVDONE(MXX,10),LE_DONE(MXX)
+
+      IF(NQ2.LE.0) THEN
+        DO IQ = 1,MQ2
+          NFMAP(IQ) = 4
+        ENDDO
+        RETURN
+      ENDIF
+
+      DO IQ = 1,NQ2
+                                NFMAP(IQ) = 4
+        IF(Q2TAB(IQ).LT.THRS34) NFMAP(IQ) = 3
+        IF(Q2TAB(IQ).GE.THRS45) NFMAP(IQ) = 5
+      ENDDO
+
+C--   Invalidate all evolutions      
+      CALL QNFALS(LEVDONE,MXX*10)
+
+      RETURN
+      END
+CDECK  ID>, QNFMAP.
+C     ==============================
+      SUBROUTINE QNFMAP(OPT,T34,T45)
+C     ==============================
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+      CHARACTER*(*) OPT
+C---  Obsolete 17/07/96: use QTHRES instead
+
+      CALL QTHRES(T34,T45)
+
+      RETURN
+      END
+CDECK  ID>, QNFSET.
+C     ===========================
+      SUBROUTINE QNFSET(IX,IQ,NF)   
+C     ===========================
+      WRITE(6,'(/'' QNFSET: this routine is not available'',
+     +           '' ---> STOP'')')
+      STOP
+      END
+CDECK  ID>, QNFNUL.
+C     =================
+      SUBROUTINE QNFNUL
+C     =================
+      WRITE(6,'(/'' QNFNUL: this routine is not available'',
+     +           '' ---> STOP'')')
+      STOP
+      END
+
+CDECK  ID>, NFLGET.
+C     ===========================
+      INTEGER FUNCTION NFLGET(IQ)
+C     ===========================
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+      PARAMETER ( MXX = 410 )
+      PARAMETER ( MQ2 =  120 )
+
+C--   Do not set the following parameter to zero!
+      PARAMETER ( NDFMAX = 20)
+
+      COMMON/QCGRID/
+     +SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS,
+     +XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45,
+     +NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2),
+     +IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2)
+
+      CALL QTRACE('NFLGET ',0)
+      NFLGET = 0
+      IF(IQ.GE.1.AND.IQ.LE.NQ2) THEN
+        NFLGET = NFMAP(IQ)
+      ELSE
+        WRITE(6,'(/'' ------------------------------------'')')
+        WRITE(6,'( '' QCDNUM error in s/r NFLGET ---> STOP'')')
+        WRITE(6,'( '' ------------------------------------'')')
+        WRITE(6,'( '' Input IQ :'',I10)') IQ
+        WRITE(6,'(/'' IQ outside grid boundary'')')
+        CALL QTRACE('NFLGET ',1)
+        STOP
+      ENDIF
+      RETURN
+      END
+
+CDECK  ID>, QPGRID.
+C     ======================
+      SUBROUTINE QPGRID(LUN)
+C     ======================
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+      PARAMETER ( MXX = 410 )
+      PARAMETER ( MQ2 =  120 )
+
+C--   Do not set the following parameter to zero!
+      PARAMETER ( NDFMAX = 20)
+
+      COMMON/QCGRID/
+     +SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS,
+     +XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45,
+     +NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2),
+     +IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2)
+C--   Write x-Q2 evolution grid
+C--   -------------------------
+
+      WRITE(LUN,'(/'' QCDNUM x-Q2 evolution grid'')')
+      WRITE(LUN,'( '' --------------------------'')')
+
+      CALL GRGIVE(N_X,X_MI,X_MA,N_Q,Q_MI,Q_MA)
+     
+      WRITE(LUN,'(/''   nx      xmin      xmax'',
+     +             ''   nq      qmin      qmax'')')
+      WRITE(LUN,'(I5,2F10.7,I5,2F10.2)') 
+     +            N_X,X_MI,X_MA,N_Q,Q_MI,Q_MA
+      WRITE(LUN,'(/'' Xgrid (heavy quarks)'')')
+      WRITE(LUN,'(5(I4,E12.5))') (I,XHTAB(I),I=1,NXX)
+      WRITE(LUN,'(/'' Xgrid'')')
+      WRITE(LUN,'(5(I4,E12.5))') (I,XXTAB(I),I=1,NXX)
+      WRITE(LUN,'(/'' Qgrid'')')
+      WRITE(LUN,'(5(I4,E12.5))') (I,Q2TAB(I),I=1,NQ2)
+      IF(RS2CUT.GE.0.) THEN
+        RS2C = SQRT(RS2CUT)
+      ELSE
+        RS2C = RS2CUT
+      ENDIF
+      WRITE(LUN,'(/'' Thresholds and cuts''/
+     +             '' Q2  charm .......: '',E12.5/
+     +             '' Q2 bottom .......: '',E12.5/
+     +             '' Xmin  cut .......: '',E12.5/
+     +             '' Qmin  cut .......: '',E12.5/
+     +             '' Qmax  cut .......: '',E12.5/
+     +             '' Roots cut .......: '',E12.5/
+     +             '' Qmin  alpha_s ...: '',E12.5/)')
+     +             THRS34,THRS45,XMICUT,QMICUT,QMACUT,RS2C,QMINAS
+
+      RETURN
+      END
+CDECK  ID>, QDELQ2.
+C     =================
+      SUBROUTINE QDELQ2
+C     =================
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+      LOGICAL
+     +LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB,
+     +LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS,
+     +LALFOK,LDQ2OK,LWT1OK,LWT2OK,
+     +LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ,
+     +LFFCAL,LASOLD
+
+      COMMON/QCFLAG/ 
+     +IORD,IOLAST,
+     +LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB,
+     +LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS,
+     +LALFOK,LDQ2OK,LWT1OK,LWT2OK,
+     +LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ,
+     +LFFCAL(7,30),LASOLD
+      PARAMETER ( MXX = 410 )
+      PARAMETER ( MQ2 =  120 )
+
+C--   Do not set the following parameter to zero!
+      PARAMETER ( NDFMAX = 20)
+
+      COMMON/QCGRID/
+     +SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS,
+     +XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45,
+     +NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2),
+     +IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2)
+      COMMON/QCPASS/
+     +ALPHA0, Q0ALFA, ASLAST, QALAST,
+     +ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2),
+     +DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10),
+     +FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2),
+     +FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2),
+     +FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2),
+     +FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST,
+     +MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2),
+     +ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2),
+     +IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10)
+
+      LOGICAL LEVDONE,LE_DONE
+      COMMON/QCLEVL/
+     +LEVDONE(MXX,10),LE_DONE(MXX)
+
+C--   Pre-calculate log distance in Q2 for up and down evolution
+
+      DO 10 IQ = 2,NQ2
+        DELUP(IQ) = LOG(Q2TAB(IQ)/Q2TAB(IQ-1))
+  10  CONTINUE
+      DO 20 IQ = NQ2-1,1,-1
+        DELDN(IQ) = LOG(Q2TAB(IQ)/Q2TAB(IQ+1))
+  20  CONTINUE
+
+      LDQ2OK = .TRUE. 
+
+      RETURN
+      END
+CDECK  ID>, QFMARK.
+C     ======================
+      SUBROUTINE QFMARK(X,Q)
+C     ======================
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+
+      LOGICAL
+     +LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB,
+     +LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS,
+     +LALFOK,LDQ2OK,LWT1OK,LWT2OK,
+     +LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ,
+     +LFFCAL,LASOLD
+
+      COMMON/QCFLAG/ 
+     +IORD,IOLAST,
+     +LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB,
+     +LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS,
+     +LALFOK,LDQ2OK,LWT1OK,LWT2OK,
+     +LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ,
+     +LFFCAL(7,30),LASOLD
+      PARAMETER ( MXX = 410 )
+      PARAMETER ( MQ2 =  120 )
+
+C--   Do not set the following parameter to zero!
+      PARAMETER ( NDFMAX = 20)
+
+      COMMON/QCGRID/
+     +SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS,
+     +XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45,
+     +NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2),
+     +IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2)
+      COMMON/QCPASS/
+     +ALPHA0, Q0ALFA, ASLAST, QALAST,
+     +ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2),
+     +DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10),
+     +FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2),
+     +FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2),
+     +FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2),
+     +FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST,
+     +MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2),
+     +ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2),
+     +IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10)
+
+      LOGICAL LEVDONE,LE_DONE
+      COMMON/QCLEVL/
+     +LEVDONE(MXX,10),LE_DONE(MXX)
+
+      CALL QTRACE('QFMARK ',0)
+
+C--   Mark gridpoints for fast structure function calculation
+
+      IERR = 0
+      IF(X.LE.0. .OR. X.GT.1.) THEN
+        IERR = 1
+        GOTO 500
+      ENDIF
+      IF(Q.LE.0.) THEN
+        IERR = 2
+        GOTO 500
+      ENDIF
+
+C--   Mark the evolution grid
+
+      IX = IXFROMX(X)
+      IQ = IQFROMQ(Q)
+      IF(IX.EQ.0.OR.IQ.EQ.0) THEN
+        IERR = 3
+        GOTO 500
+      ELSEIF(IX.GT.0.AND.IQ.GT.0) THEN
+        MARKFF(IX,IQ)    = 1
+        MARKQQ(IQ)       = 1
+        LMARK            = .TRUE.
+      ELSEIF(IX.LT.0.AND.IQ.GT.0) THEN
+        MARKFF(-IX,IQ)   = 1
+        MARKFF(-IX+1,IQ) = 1
+        MARKQQ(IQ)       = 1
+        LMARK            = .TRUE.
+      ELSEIF(IX.GT.0.AND.IQ.LT.0) THEN
+        MARKFF(IX,-IQ)   = 1
+        MARKFF(IX,-IQ+1) = 1
+        MARKQQ(-IQ)      = 1
+        MARKQQ(-IQ+1)    = 1
+        LMARK            = .TRUE.
+      ELSEIF(IX.LT.0.AND.IQ.LT.0) THEN
+        MARKFF(-IX,-IQ)     = 1
+        MARKFF(-IX+1,-IQ)   = 1
+        MARKFF(-IX,-IQ+1)   = 1
+        MARKFF(-IX+1,-IQ+1) = 1
+        MARKQQ(-IQ)         = 1
+        MARKQQ(-IQ+1)       = 1
+        LMARK               = .TRUE.
+      ENDIF
+
+C--   Mark the heavy quark grid
+
+      IX = IHFROMH(X)
+      IQ = IQFROMQ(Q)
+      IF(IX.EQ.0.OR.IQ.EQ.0) THEN
+        IERR = 3
+        GOTO 500
+      ELSEIF(IX.GT.0.AND.IQ.GT.0) THEN
+        MARKFH(IX,IQ)    = 1
+      ELSEIF(IX.LT.0.AND.IQ.GT.0) THEN
+        MARKFH(-IX,IQ)   = 1
+        MARKFH(-IX+1,IQ) = 1
+      ELSEIF(IX.GT.0.AND.IQ.LT.0) THEN
+        MARKFH(IX,-IQ)   = 1
+        MARKFH(IX,-IQ+1) = 1
+      ELSEIF(IX.LT.0.AND.IQ.LT.0) THEN
+        MARKFH(-IX,-IQ)     = 1
+        MARKFH(-IX+1,-IQ)   = 1
+        MARKFH(-IX,-IQ+1)   = 1
+        MARKFH(-IX+1,-IQ+1) = 1
+      ENDIF
+
+      RETURN
+
+ 500  CONTINUE
+
+      DO I = 1,30
+        DO J = 1,7
+          LFFCAL(J,I)  = .FALSE.
+        ENDDO
+      ENDDO
+
+      WRITE(6,'(/'' ------------------------------------'')')
+      WRITE(6,'( '' QCDNUM error in s/r QFMARK ---> STOP'')')
+      WRITE(6,'( '' ------------------------------------'')')
+      WRITE(6,'( '' Input x  :'',E12.5)') X
+      WRITE(6,'( '' Input Q2 :'',E12.5)') Q
+      IF(IERR.EQ.1) THEN
+        WRITE(6,'(/'' Value of x outside allowed range [0,1]'')')
+      ELSEIF(IERR.EQ.2) THEN
+        WRITE(6,'(/'' Value of Q2 outside allowed range > 0'')')
+      ELSEIF(IERR.EQ.3) THEN
+        WRITE(6,'(/'' Value of x and/or Q2 outside grid'')')
+        IDUM = ICUTXQ(X,Q,1)
+      ENDIF
+
+      CALL QTRACE('QFMARK ',1)
+
+      STOP
+
+      END
+CDECK  ID>, QFMNUL.
+C     =================
+      SUBROUTINE QFMNUL
+C     =================
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+
+      LOGICAL
+     +LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB,
+     +LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS,
+     +LALFOK,LDQ2OK,LWT1OK,LWT2OK,
+     +LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ,
+     +LFFCAL,LASOLD
+
+      COMMON/QCFLAG/ 
+     +IORD,IOLAST,
+     +LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB,
+     +LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS,
+     +LALFOK,LDQ2OK,LWT1OK,LWT2OK,
+     +LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ,
+     +LFFCAL(7,30),LASOLD
+      PARAMETER ( MXX = 410 )
+      PARAMETER ( MQ2 =  120 )
+
+C--   Do not set the following parameter to zero!
+      PARAMETER ( NDFMAX = 20)
+
+      COMMON/QCGRID/
+     +SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS,
+     +XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45,
+     +NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2),
+     +IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2)
+      COMMON/QCPASS/
+     +ALPHA0, Q0ALFA, ASLAST, QALAST,
+     +ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2),
+     +DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10),
+     +FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2),
+     +FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2),
+     +FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2),
+     +FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST,
+     +MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2),
+     +ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2),
+     +IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10)
+
+      LOGICAL LEVDONE,LE_DONE
+      COMMON/QCLEVL/
+     +LEVDONE(MXX,10),LE_DONE(MXX)
+
+      CALL QTRACE('QFMNUL ',0)
+
+C--   Clear gridpoints for fast structure function calculation
+
+      CALL QNINUL(MARKFF,MXX*MQ2)
+      CALL QNINUL(MARKQQ,MQ2)
+      CALL QNINUL(IDFAST,7*30)
+      NDFAST = 30
+      LMARK  = .FALSE.
+
+      DO I = 1,30
+        DO J = 1,7
+          LFFCAL(J,I)  = .FALSE.
+        ENDDO
+      ENDDO
+
+      RETURN
+      END
+CDECK  ID>, STFCLR.
+C     =================
+      SUBROUTINE STFCLR
+C     =================
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+
+      LOGICAL
+     +LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB,
+     +LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS,
+     +LALFOK,LDQ2OK,LWT1OK,LWT2OK,
+     +LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ,
+     +LFFCAL,LASOLD
+
+      COMMON/QCFLAG/ 
+     +IORD,IOLAST,
+     +LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB,
+     +LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS,
+     +LALFOK,LDQ2OK,LWT1OK,LWT2OK,
+     +LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ,
+     +LFFCAL(7,30),LASOLD
+      PARAMETER ( MXX = 410 )
+      PARAMETER ( MQ2 =  120 )
+
+C--   Do not set the following parameter to zero!
+      PARAMETER ( NDFMAX = 20)
+
+      COMMON/QCGRID/
+     +SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS,
+     +XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45,
+     +NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2),
+     +IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2)
+      COMMON/QCPASS/
+     +ALPHA0, Q0ALFA, ASLAST, QALAST,
+     +ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2),
+     +DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10),
+     +FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2),
+     +FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2),
+     +FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2),
+     +FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST,
+     +MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2),
+     +ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2),
+     +IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10)
+
+      LOGICAL LEVDONE,LE_DONE
+      COMMON/QCLEVL/
+     +LEVDONE(MXX,10),LE_DONE(MXX)
+
+C--   Clear memory allocation for STFAST
+
+      CALL QTRACE('STFCLR ',0)
+
+      CALL QNINUL(IDFAST,7*30)
+      NDFAST = 30
+
+      DO I = 1,30
+        DO J = 1,7
+          LFFCAL(J,I)  = .FALSE.
+        ENDDO
+      ENDDO
+
+      RETURN
+      END
+CDECK  ID>, QNFILW.
+C     ================================
+      SUBROUTINE QNFILW(IQLIST,NQLIST)
+C     ================================
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+      LOGICAL LTIME  
+      REAL T_START,T_END,T_SPENT
+      COMMON/QCTIME/T_START(10),T_END(10),T_SPENT(10),N_CALLS(10),
+     +E_CALLS(10),LTIME
+      COMMON/QCFCNT/IFCNT(-1:1,5)
+
+      COMMON/QCCONS/
+     +PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L,
+     +AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7),
+     +C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3,
+     +C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9,
+     +C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1,
+     +C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF
+      LOGICAL
+     +LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB,
+     +LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS,
+     +LALFOK,LDQ2OK,LWT1OK,LWT2OK,
+     +LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ,
+     +LFFCAL,LASOLD
+
+      COMMON/QCFLAG/ 
+     +IORD,IOLAST,
+     +LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB,
+     +LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS,
+     +LALFOK,LDQ2OK,LWT1OK,LWT2OK,
+     +LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ,
+     +LFFCAL(7,30),LASOLD
+      PARAMETER ( MXX = 410 )
+      PARAMETER ( MQ2 =  120 )
+
+C--   Do not set the following parameter to zero!
+      PARAMETER ( NDFMAX = 20)
+
+      COMMON/QCGRID/
+     +SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS,
+     +XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45,
+     +NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2),
+     +IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2)
+      COMMON/QCPASS/
+     +ALPHA0, Q0ALFA, ASLAST, QALAST,
+     +ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2),
+     +DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10),
+     +FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2),
+     +FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2),
+     +FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2),
+     +FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST,
+     +MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2),
+     +ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2),
+     +IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10)
+
+      LOGICAL LEVDONE,LE_DONE
+      COMMON/QCLEVL/
+     +LEVDONE(MXX,10),LE_DONE(MXX)
+      REAL
+     +WGTFF1,WGTFG1,
+     +WGTGF1,WGTGG1,
+     +WGTPP2,WGTPM2,WGTNS2,
+     +WGTFF2,WGTFG2,
+     +WGTGF2,WGTGG2,
+     +WGTC2Q,WGTC2G,YNTC2Q,
+     +WGTCLQ,WGTCLG,WGTC3Q
+
+      COMMON/QCWEIT/
+     +WGTFF1(MXX*(MXX+1)/2)    ,WGTFG1(MXX*(MXX+1)/2,3:5),
+     +WGTGF1(MXX*(MXX+1)/2)    ,WGTGG1(MXX*(MXX+1)/2,3:5),
+     +WGTPP2(MXX*(MXX+1)/2,3:5),WGTPM2(MXX*(MXX+1)/2,3:5),
+     +WGTNS2(MXX*(MXX+1)/2,3:5),
+     +WGTFF2(MXX*(MXX+1)/2,3:5),WGTFG2(MXX*(MXX+1)/2,3:5),
+     +WGTGF2(MXX*(MXX+1)/2,3:5),WGTGG2(MXX*(MXX+1)/2,3:5),
+     +WGTC2Q(MXX*(MXX+1)/2)    ,WGTC2G(MXX*(MXX+1)/2,3:5),
+     +WGTCLQ(MXX*(MXX+1)/2)    ,WGTCLG(MXX*(MXX+1)/2,3:5),
+     +WGTC3Q(MXX*(MXX+1)/2)    ,YNTC2Q(MXX)
+
+      COMMON/QCWADR/ IWADR(MXX,MXX)
+
+
+      DIMENSION IQLIST(*)
+      IF(LTIME) CALL TIMEX_LHA(T_START(2))
+
+      CALL QTRACE('QNFILW ',0)
+
+      IF(NXX.EQ.0.OR.NQ2.EQ.0) THEN
+        IERR = 1
+        GOTO 500
+      ENDIF
+
+C--   Invalidate all evolutions      
+      CALL QNFALS(LEVDONE,MXX*10)
+
+C--   Setup the adresses
+      DO IX0 = 1,MXX
+        DO IX = IX0,MXX
+          IWADR(IX,IX0) = IWTAD(IX,IX0)
+        ENDDO
+      ENDDO
+C--   Now calculate weights
+      IF(LW1ANA) THEN
+        DO 30 NF = 3,5
+        CALL FILLO1(NF)
+  30    CONTINUE
+        LW1NUM = .FALSE.
+        LWT1OK = .TRUE. 
+        WRITE(6,'(/'' QNFILW: Calculate LO weights analytically'')')
+      ENDIF
+      I1 = 0
+      I2 = 0
+      I3 = 0
+      IF(LW1NUM) THEN
+        I1     = 1
+        LWT1OK = .TRUE. 
+        WRITE(6,'(/'' QNFILW: Calculate LO weights numerically'')')
+      ENDIF
+      IF(LW2NUM) THEN
+        I2     = 1
+        LWT2OK = .TRUE. 
+        WRITE(6,'(/'' QNFILW: Calculate NLO weights'')')
+      ENDIF
+      IF(LW2STF) THEN
+        I3     = 1
+        LWTFOK = .TRUE. 
+        WRITE(6,'(/'' QNFILW: Calculate F2 weights'')')
+      ENDIF
+      DO 40 NF = 3,5
+      CALL FILLWF(I1,I2,I3,NF)
+  40  CONTINUE
+      IF(LWF2C.OR.LWF2B.OR.LWFLC.OR.LWFLB) THEN
+
+C---    Check charm, bottom mass
+        IF(.NOT.(0..LT.CBMSTF(4) .AND. CBMSTF(4).EQ.CBMSTF(5) .AND.
+     +    CBMSTF(4).LT.CBMSTF(6) .AND. CBMSTF(6).EQ.CBMSTF(7))) THEN
+          IERR = 2
+          GOTO 500
+        ENDIF
+
+        IF(LWF2C) THEN
+          LWFCOK = .TRUE. 
+          CALL FIL_F2H(4)
+          WRITE(6,'(/'' QNFILW: Calculate F2c weights'')')   
+        ENDIF
+        IF(LWF2B) THEN
+          LWFBOK = .TRUE. 
+          CALL FIL_F2H(6)
+          WRITE(6,'(/'' QNFILW: Calculate F2b weights'')')   
+        ENDIF
+        IF(LWFLC) THEN
+          LWLCOK = .TRUE. 
+          CALL FIL_FLH(5)
+          WRITE(6,'(/'' QNFILW: Calculate FLc weights'')')   
+        ENDIF
+        IF(LWFLB) THEN
+          LWLBOK = .TRUE. 
+          CALL FIL_FLH(7)
+          WRITE(6,'(/'' QNFILW: Calculate FLb weights'')')   
+        ENDIF
+
+      ENDIF
+      WRITE(6,'(/)') 
+
+      IF(LTIME) THEN
+        CALL TIMEX_LHA(T_END(2))
+        T_SPENT(2) = T_SPENT(2)+T_END(2)-T_START(2)
+        N_CALLS(2) = N_CALLS(2)+1
+      ENDIF
+
+      RETURN
+
+ 500  CONTINUE
+      WRITE(6,'(/'' ------------------------------------'')')
+      WRITE(6,'( '' QCDNUM error in s/r QNFILW ---> STOP'')')
+      WRITE(6,'( '' ------------------------------------'')')
+      IF(IERR.EQ.1) THEN
+        WRITE(6,'(/'' No x-Q2 grid available'')')
+      ENDIF
+      IF(IERR.EQ.2) THEN
+        WRITE(6,'( '' Cmass (F2c,FLc) ='',2E12.5)') CBMSTF(4),CBMSTF(5)
+        WRITE(6,'( '' Bmass (F2b,FLb) ='',2E12.5)') CBMSTF(6),CBMSTF(7)
+        WRITE(6,'(/'' Masses not in ascending order or not equal'',
+     +             '' for F2 and FL'')')
+      ENDIF
+
+      CALL QTRACE('QNFILW ',1)
+
+      STOP
+
+      END
+      
+CDECK  ID>, QNGETW.
+C     ===============================================
+      DOUBLE PRECISION FUNCTION QNGETW(OPT,IX0,IX,IQ)
+C     ===============================================
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+
+      PARAMETER ( MXX = 410 )
+      PARAMETER ( MQ2 =  120 )
+
+C--   Do not set the following parameter to zero!
+      PARAMETER ( NDFMAX = 20)
+
+      COMMON/QCGRID/
+     +SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS,
+     +XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45,
+     +NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2),
+     +IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2)
+      REAL
+     +WGTFF1,WGTFG1,
+     +WGTGF1,WGTGG1,
+     +WGTPP2,WGTPM2,WGTNS2,
+     +WGTFF2,WGTFG2,
+     +WGTGF2,WGTGG2,
+     +WGTC2Q,WGTC2G,YNTC2Q,
+     +WGTCLQ,WGTCLG,WGTC3Q
+
+      COMMON/QCWEIT/
+     +WGTFF1(MXX*(MXX+1)/2)    ,WGTFG1(MXX*(MXX+1)/2,3:5),
+     +WGTGF1(MXX*(MXX+1)/2)    ,WGTGG1(MXX*(MXX+1)/2,3:5),
+     +WGTPP2(MXX*(MXX+1)/2,3:5),WGTPM2(MXX*(MXX+1)/2,3:5),
+     +WGTNS2(MXX*(MXX+1)/2,3:5),
+     +WGTFF2(MXX*(MXX+1)/2,3:5),WGTFG2(MXX*(MXX+1)/2,3:5),
+     +WGTGF2(MXX*(MXX+1)/2,3:5),WGTGG2(MXX*(MXX+1)/2,3:5),
+     +WGTC2Q(MXX*(MXX+1)/2)    ,WGTC2G(MXX*(MXX+1)/2,3:5),
+     +WGTCLQ(MXX*(MXX+1)/2)    ,WGTCLG(MXX*(MXX+1)/2,3:5),
+     +WGTC3Q(MXX*(MXX+1)/2)    ,YNTC2Q(MXX)
+
+      COMMON/QCWADR/ IWADR(MXX,MXX)
+
+
+      REAL
+     +WH_C0KG,WH_C1KG,WH_C1BKG,
+     +WH_C1KQ,WH_C1BKQ,WH_D1KQ,WH_D1BKQ
+
+      COMMON/QCHWGT/
+     +WH_C0KG(0:MXX,MQ2,4:7),
+     +WH_C1KG(0:MXX,MQ2,4:7),WH_C1BKG(0:MXX,MQ2,4:7),
+     +WH_C1KQ(0:MXX,MQ2,4:7),WH_C1BKQ(0:MXX,MQ2,4:7),
+     +WH_D1KQ(0:MXX,MQ2,4:7),WH_D1BKQ(0:MXX,MQ2,4:7)
+
+
+      CHARACTER*(*) OPT
+      CHARACTER*8   OPT8
+
+      CALL QTRACE('QNGETW ',0)
+
+      IERR = 0
+      IF(IX0.LE.0.OR.IX0.GT.MXX-1) THEN
+        IERR = 1
+        GOTO 500
+      ENDIF
+      IF(IX.LE.0.OR.IX.GT.MXX-1) THEN
+        IERR = 1
+        GOTO 500
+      ENDIF
+      IF(IQ.LE.0.OR.IQ.GT.MQ2-1) THEN
+        IERR = 1
+        GOTO 500
+      ENDIF
+      NF  = NFMAP(IQ)
+      IF(NF.LT.3.OR.NF.GT.5) THEN
+        IERR = 2
+        GOTO 500
+      ENDIF
+
+      IF(IX.LT.IX0) THEN
+        QNGETW = 0.
+        RETURN
+      ENDIF
+
+      LEN = MIN(LENOCC_LHA(OPT),8)
+      OPT8(1:LEN) = OPT(1:LEN)
+      CALL CLTOU_LHA(OPT8)
+     
+      IF(OPT8(1:6).EQ.'WGTFF1') THEN                
+        QNGETW = WGTFF1(IWTAD(IX,IX0))       
+      ELSEIF(OPT8(1:6).EQ.'WGTFG1') THEN                
+        QNGETW = WGTFG1(IWTAD(IX,IX0),NF)   
+      ELSEIF(OPT8(1:6).EQ.'WGTGF1') THEN                
+        QNGETW = WGTGF1(IWTAD(IX,IX0))        
+      ELSEIF(OPT8(1:6).EQ.'WGTGG1') THEN                
+        QNGETW = WGTGG1(IWTAD(IX,IX0),NF)   
+      ELSEIF(OPT8(1:6).EQ.'WGTPP2') THEN                
+        QNGETW = WGTPP2(IWTAD(IX,IX0),NF)   
+      ELSEIF(OPT8(1:6).EQ.'WGTPM2') THEN                
+        QNGETW = WGTPM2(IWTAD(IX,IX0),NF)   
+      ELSEIF(OPT8(1:6).EQ.'WGTNS2') THEN                
+        QNGETW = WGTNS2(IWTAD(IX,IX0),NF)   
+      ELSEIF(OPT8(1:6).EQ.'WGTFF2') THEN                
+        QNGETW = WGTFF2(IWTAD(IX,IX0),NF)   
+      ELSEIF(OPT8(1:6).EQ.'WGTFG2') THEN                
+        QNGETW = WGTFG2(IWTAD(IX,IX0),NF)   
+      ELSEIF(OPT8(1:6).EQ.'WGTGF2') THEN                
+        QNGETW = WGTGF2(IWTAD(IX,IX0),NF)   
+      ELSEIF(OPT8(1:6).EQ.'WGTGG2') THEN                
+        QNGETW = WGTGG2(IWTAD(IX,IX0),NF)   
+      ELSEIF(OPT8(1:6).EQ.'WGTC2Q') THEN                
+        QNGETW = WGTC2Q(IWTAD(IX,IX0))        
+      ELSEIF(OPT8(1:6).EQ.'WGTC2G') THEN                
+        QNGETW = WGTC2G(IWTAD(IX,IX0),NF)   
+      ELSEIF(OPT8(1:6).EQ.'WGTCLQ') THEN                
+        QNGETW = WGTCLQ(IWTAD(IX,IX0))        
+      ELSEIF(OPT8(1:6).EQ.'WGTCLG') THEN                
+        QNGETW = WGTCLG(IWTAD(IX,IX0),NF)   
+      ELSEIF(OPT8(1:6).EQ.'WGTC3Q') THEN                
+        QNGETW = WGTC3Q(IWTAD(IX,IX0))        
+      ELSEIF(OPT8(1:7).EQ.'WH_C02G') THEN                
+        QNGETW = WH_C0KG(IX-IX0,IQ,4)
+      ELSEIF(OPT8(1:7).EQ.'WH_C12G') THEN                
+        QNGETW = WH_C1KG(IX-IX0,IQ,4)
+      ELSEIF(OPT8(1:8).EQ.'WH_C1B2G') THEN                
+        QNGETW = WH_C1BKG(IX-IX0,IQ,4)
+      ELSEIF(OPT8(1:7).EQ.'WH_C12Q') THEN                
+        QNGETW = WH_C1KQ(IX-IX0,IQ,4)
+      ELSEIF(OPT8(1:8).EQ.'WH_C1B2Q') THEN                
+        QNGETW = WH_C1BKQ(IX-IX0,IQ,4)
+      ELSEIF(OPT8(1:7).EQ.'WH_D12Q') THEN                
+        QNGETW = WH_D1KQ(IX-IX0,IQ,4)
+      ELSEIF(OPT8(1:8).EQ.'WH_D1B2Q') THEN                
+        QNGETW = WH_D1BKQ(IX-IX0,IQ,4)
+      ELSEIF(OPT8(1:7).EQ.'WH_C0LG') THEN                
+        QNGETW = WH_C0KG(IX-IX0,IQ,5)
+      ELSEIF(OPT8(1:7).EQ.'WH_C1LG') THEN                
+        QNGETW = WH_C1KG(IX-IX0,IQ,5)
+      ELSEIF(OPT8(1:8).EQ.'WH_C1BLG') THEN                
+        QNGETW = WH_C1BKG(IX-IX0,IQ,5)
+      ELSEIF(OPT8(1:7).EQ.'WH_C1LQ') THEN                
+        QNGETW = WH_C1KQ(IX-IX0,IQ,5)
+      ELSEIF(OPT8(1:8).EQ.'WH_C1BLQ') THEN                
+        QNGETW = WH_C1BKQ(IX-IX0,IQ,5)
+      ELSEIF(OPT8(1:7).EQ.'WH_D1LQ') THEN                
+        QNGETW = WH_D1KQ(IX-IX0,IQ,5)
+      ELSEIF(OPT8(1:8).EQ.'WH_D1BLQ') THEN                
+        QNGETW = WH_D1BKQ(IX-IX0,IQ,5)
+      ELSE
+        IERR = 3
+        GOTO 500
+      ENDIF
+
+      RETURN
+
+ 500  CONTINUE
+      WRITE(6,'(/'' ------------------------------------'')')
+      WRITE(6,'( '' QCDNUM error in s/r QNGETW ---> STOP'')')
+      WRITE(6,'( '' ------------------------------------'')')
+      WRITE(6,'( '' Input OPT      :'',A)') OPT       
+      WRITE(6,'( ''       IX0      :'',I10)') IX0       
+      WRITE(6,'( ''       IX       :'',I10)') IX     
+      WRITE(6,'( ''       IQ       :'',I10)') IQ     
+      IF(IERR.EQ.1) THEN
+        WRITE(6,'(/'' IX0, IX and/or IQ outside allowed range'')')
+      ELSEIF(IERR.EQ.2) THEN
+        WRITE(6,'(/'' NF(IX,IQ) ='',I3,'' outside allowed range'')') NF
+      ELSEIF(IERR.EQ.3) THEN
+        WRITE(6,'(/'' Unknown option'')')
+      ENDIF
+
+      CALL QTRACE('QNGETW ',1)
+
+      STOP
+
+      END
+      
+CDECK  ID>, QSTRIP.
+C     =================================
+      SUBROUTINE QSTRIP(NAMEIN,NAMEOUT)
+C     =================================
+C---  Truncate NAMEIN to 5 characters and convert to upper case
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+      CHARACTER*(*) NAMEIN
+      CHARACTER*5   NAMEOUT
+
+      LEN            = MIN(LENOCC_LHA(NAMEIN),5)
+      NAMEOUT        = '     '
+      NAMEOUT(1:LEN) = NAMEIN(1:LEN)
+      CALL CLTOU_LHA(NAMEOUT)
+
+      RETURN
+      END
+      
+CDECK  ID>, CHKNAM.
+C     ====================================
+      SUBROUTINE CHKNAM(ID,NAME,SNAME,NAM)
+C     ====================================
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+      CHARACTER*5 PNAM,STFNAM
+      LOGICAL     LNFP
+      COMMON /QCLNFP/ LNFP(0:30,3:5)
+      COMMON /QCPNAM/ PNAM(0:30)
+      COMMON /QCPWGT/ PWGT(0:10,0:30,3:5)
+      COMMON /QCFNAM/ STFNAM(7)
+      CHARACTER*(*) NAME, SNAME
+      CHARACTER*5 NAM
+
+      LEN = MIN(LENOCC_LHA(NAME),5)
+      NAM = '     '
+      NAM(1:LEN) = NAME(1:LEN)
+      CALL CLTOU_LHA(NAM)
+
+      IF(NAM.EQ.'     ') THEN
+        IERR = 1
+        GOTO 500
+      ENDIF
+      IF(NAM.EQ.'FREE ') THEN
+        PNAM(ID)      =  NAM
+        LNFP(ID,3)    = .FALSE.
+        LNFP(ID,4)    = .FALSE.
+        LNFP(ID,5)    = .FALSE.
+        IF(ID.LE.10) THEN
+          DO JD = 0,30
+            PWGT(ID,JD,3) = 0.
+            PWGT(ID,JD,4) = 0.
+            PWGT(ID,JD,5) = 0.
+          ENDDO
+        ELSE
+          DO JD = 0,10
+            PWGT(JD,ID,3) = 0.
+            PWGT(JD,ID,4) = 0.
+            PWGT(JD,ID,5) = 0.
+          ENDDO
+        ENDIF
+        RETURN
+      ENDIF
+      IF(PNAM(ID).NE.'FREE '.AND.PNAM(ID).NE.NAM) THEN
+        IERR = 2
+        GOTO 500
+      ENDIF
+      DO 10 JD = 0,30
+        IF(JD.EQ.ID) GOTO 10
+        IF(PNAM(JD).EQ.NAM) THEN
+          IERR = 3
+          GOTO 500
+        ENDIF
+  10  CONTINUE
+
+      RETURN
+
+ 500  CONTINUE
+      WRITE(6,'(/'' ------------------------------------'')')
+      WRITE(6,'( '' QCDNUM error in s/r '',A,'' ---> STOP'')')
+     +              SNAME
+      WRITE(6,'( '' ------------------------------------'')')
+      WRITE(6,'( '' Input ID   :'',I10)') ID
+      WRITE(6,'( '' Input NAME :'',A)') NAM
+      IF(IERR.EQ.1) THEN
+        WRITE(6,'(/'' Blank name not allowed'')') 
+      ELSEIF(IERR.EQ.2) THEN
+        WRITE(6,'(/'' ID already booked'')')
+      ELSEIF(IERR.EQ.3) THEN
+        WRITE(6,'(/'' NAME already used'')')
+      ENDIF
+
+      CALL QTRACE('CHKNAM ',1)
+
+      STOP
+      END
+      
+CDECK  ID>, QNBOOK.
+C     ==========================
+      SUBROUTINE QNBOOK(ID,NAME)
+C     ==========================
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+      CHARACTER*5 PNAM,STFNAM
+      LOGICAL     LNFP
+      COMMON /QCLNFP/ LNFP(0:30,3:5)
+      COMMON /QCPNAM/ PNAM(0:30)
+      COMMON /QCPWGT/ PWGT(0:10,0:30,3:5)
+      COMMON /QCFNAM/ STFNAM(7)
+      CHARACTER*(*) NAME
+      CHARACTER*5    NAM
+
+      CALL QTRACE('QNBOOK ',0)
+      CALL CHKNAM(ID,NAME,'QNBOOK',NAM)
+      PNAM(ID)      =  NAM
+      LNFP(ID,3)    = .TRUE.
+      LNFP(ID,4)    = .TRUE.
+      LNFP(ID,5)    = .TRUE.
+      PWGT(ID,ID,3) = 1.
+      PWGT(ID,ID,4) = 1.
+      PWGT(ID,ID,5) = 1.
+      RETURN
+      END
+CDECK  ID>, QNLINC.
+C     ===================================
+      SUBROUTINE QNLINC(ID,NAME,NF,WEITS)
+C     ===================================
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+      CHARACTER*5 PNAM,STFNAM
+      LOGICAL     LNFP
+      COMMON /QCLNFP/ LNFP(0:30,3:5)
+      COMMON /QCPNAM/ PNAM(0:30)
+      COMMON /QCPWGT/ PWGT(0:10,0:30,3:5)
+      COMMON /QCFNAM/ STFNAM(7)
+      CHARACTER*(*) NAME
+      CHARACTER*5   NAM
+      DIMENSION     WEITS(10)
+
+      CALL QTRACE('QNLINC ',0)
+      IF(ID.LE.10.OR.ID.GE.31) THEN
+        IERR = 1
+        GOTO 500
+      ENDIF
+      IF(NF.LT.3 .OR.NF.GT.5 ) THEN
+        IERR = 2
+        GOTO 500
+      ENDIF
+
+      CALL CHKNAM(ID,NAME,'QNLINC',NAM)
+      PNAM(ID)    = NAM
+      LNFP(ID,NF) = .TRUE.
+      DO 20 I=1,10
+        PWGT(I,ID,NF) = WEITS(I)
+  20  CONTINUE
+      RETURN
+
+ 500  CONTINUE
+      WRITE(6,'(/'' ------------------------------------'')')
+      WRITE(6,'( '' QCDNUM error in s/r QNLINC ---> STOP'')')
+      WRITE(6,'( '' ------------------------------------'')')
+      WRITE(6,'( '' Input ID        :'',I0)') ID
+      WRITE(6,'( ''       NAME      :'',A)') NAME
+      WRITE(6,'( ''       NF        :'',I0)') NF
+      WRITE(6,'( ''       FACTORS(1):'',E12.5)') WEITS(1)
+      IF(IERR.EQ.1) THEN
+        WRITE(6,'(/'' ID outside allowed range [11,30]'')')
+      ELSEIF(IERR.EQ.2) THEN
+        WRITE(6,'(/'' NF outside allowed range [3,5]'')')
+      ENDIF
+
+      CALL QTRACE('QNLINC ',1)
+
+      STOP
+
+      END
+CDECK  ID>, QNGIVE.
+C     ===================================
+      SUBROUTINE QNGIVE(ID,NF,NAME,WEITS)
+C     ===================================
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+      CHARACTER*5 PNAM,STFNAM
+      LOGICAL     LNFP
+      COMMON /QCLNFP/ LNFP(0:30,3:5)
+      COMMON /QCPNAM/ PNAM(0:30)
+      COMMON /QCPWGT/ PWGT(0:10,0:30,3:5)
+      COMMON /QCFNAM/ STFNAM(7)
+      CHARACTER*5 NAME
+      DIMENSION   WEITS(10)
+
+      CALL QTRACE('QNGIVE ',1)
+      IF(ID.LT.0.OR.ID.GT.30.OR.NF.LT.3.OR.NF.GT.5) THEN
+        NAME = 'NULL '
+        DO 10 I=1,10
+          WEITS(I) = 0.
+  10    CONTINUE
+      ELSE
+        NAME = PNAM(ID)
+        DO 15 I=1,10
+          WEITS(I) = PWGT(I,ID,NF)
+  15    CONTINUE
+      ENDIF
+      RETURN
+      END
+
+CDECK  ID>, IDCHEK.
+C     =============================
+      INTEGER FUNCTION IPDFID(UNAM)
+C     =============================
+
+C---  IPDFID = identifier of memory resident quark distn
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+      CHARACTER*(*) UNAM
+      CHARACTER*5   NAM
+      CHARACTER*5 PNAM,STFNAM
+      LOGICAL     LNFP
+      COMMON /QCLNFP/ LNFP(0:30,3:5)
+      COMMON /QCPNAM/ PNAM(0:30)
+      COMMON /QCPWGT/ PWGT(0:10,0:30,3:5)
+      COMMON /QCFNAM/ STFNAM(7)
+
+      CALL QTRACE('IPDFID ',0)
+      CALL QSTRIP(UNAM,NAM)
+
+      IF(NAM.EQ.'     '.OR.NAM.EQ.'FREE ') THEN
+        GOTO 500
+      ENDIF
+      ID = -1
+      DO I = 1,10
+        IF(NAM.EQ.PNAM(I)) ID = I
+      ENDDO   
+      IPDFID = ID
+      IF(ID.EQ.-1) THEN  
+        GOTO 500
+      ENDIF
+      RETURN
+
+ 500  CONTINUE
+      WRITE(6,'(/'' ------------------------------------'')')
+      WRITE(6,'( '' QCDNUM error in s/r IPDFID ---> STOP'')')
+      WRITE(6,'( '' ------------------------------------'')')
+      WRITE(6,'( '' Input NAME      :'',A)') UNAM
+      WRITE(6,'(/'' NAME not booked at all or NAME does not refer''/
+     +           '' to a memory resident quark distribution'')')
+      IF(NAM(1:1).EQ.' ')
+     +WRITE(6,'(/'' WARNING: NAME has one or more leading blanks'')')
+
+      CALL QTRACE('IPDFID ',1)
+
+      STOP
+      END
+
+CDECK  ID>, IDCHEK.
+C     ============================================
+      INTEGER FUNCTION IDCHEK(NAM,NF,SRNAME,ISTOP)
+C     ============================================
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+      CHARACTER*6   SRNAME
+      CHARACTER*5   NAMLAST,NAM
+      CHARACTER*5 PNAM,STFNAM
+      LOGICAL     LNFP
+      COMMON /QCLNFP/ LNFP(0:30,3:5)
+      COMMON /QCPNAM/ PNAM(0:30)
+      COMMON /QCPWGT/ PWGT(0:10,0:30,3:5)
+      COMMON /QCFNAM/ STFNAM(7)
+      SAVE IDLAST,NAMLAST
+      DATA IDLAST      /   0    /
+      DATA NAMLAST     / '    ' /
+      IDCHEK = -1
+      IF(NAM.EQ.'     '.OR.NAM.EQ.'FREE '.OR.
+     +   NF.LT.3.OR.NF.GT.5)                       THEN
+        IF(ISTOP.EQ.1) THEN
+          IERR = 1
+          GOTO 500
+        ENDIF
+        RETURN
+      ENDIF
+      ID = -1
+      IF(NAM.EQ.NAMLAST.AND.LNFP(IDLAST,NF)) THEN
+        ID     = IDLAST
+      ELSE
+        DO 10 I = 0,30
+          IF(NAM.EQ.PNAM(I).AND.LNFP(I,NF)) ID = I
+  10    CONTINUE
+        IDLAST  = ID
+        NAMLAST = NAM
+      ENDIF
+      IDCHEK = ID
+      IF(ID.EQ.-1.AND.ISTOP.EQ.1) THEN  
+        IERR = 2
+        GOTO 500
+      ENDIF
+      RETURN
+
+ 500  CONTINUE
+      WRITE(6,'(/'' ------------------------------------'')')
+      WRITE(6,'( '' QCDNUM error in s/r '',A,'' ---> STOP'')')
+     +              SRNAME
+      WRITE(6,'( '' ------------------------------------'')')
+      WRITE(6,'( '' Input NAME      :'',A)') NAM
+      WRITE(6,'( ''       NF        :'',I10)') NF
+      IF(IERR.EQ.1) THEN
+        WRITE(6,'(/'' Input name not allowed and/or NF outside'',
+     +             '' the allowed range [3,5]'')')
+      ELSEIF(IERR.EQ.2) THEN
+        WRITE(6,'(/'' NAME not booked at all or, if NAME refers to''/
+     +             '' a linear combination, it might not have been''/
+     +             '' booked for NF flavours'')')
+        IF(NAM(1:1).EQ.' ')
+     +  WRITE(6,'(/'' WARNING: NAME has one or more leading blanks'')')
+      ENDIF
+
+      CALL QTRACE('IDCHEK ',1)
+
+      STOP
+      END
+CDECK  ID>, QNLIST.
+C     ======================
+      SUBROUTINE QNLIST(LUN)
+C     ======================
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+      CHARACTER*5 NAM
+      CHARACTER*3 II
+      CHARACTER*5 PNAM,STFNAM
+      LOGICAL     LNFP
+      COMMON /QCLNFP/ LNFP(0:30,3:5)
+      COMMON /QCPNAM/ PNAM(0:30)
+      COMMON /QCPWGT/ PWGT(0:10,0:30,3:5)
+      COMMON /QCFNAM/ STFNAM(7)
+      WRITE(LUN,'(////)')
+      WRITE(LUN,'(1X,''+'',13(''-''),''+'',60(''-''),''+'')')
+      WRITE(LUN,'('' |             | W_'',I2,
+     +           9(''  W_'',I2),'' |'')') (J, J=1,10)
+      WRITE(LUN,'('' | ID NAME  nf | '',A4,
+     +           9(2X,A4),'' |'')') (PNAM(J),J=1,10)
+      WRITE(LUN,'(1X,''+'',13(''-''),''+'',60(''-''),''+'')')
+      DO 10 I = 0,10
+        IF(IDCHEK(PNAM(I),3,'      ',0).EQ.-1) GOTO 10
+        WRITE(LUN,'('' |'',I3,1X,A5,''    |'',F5.2,
+     +             9(F6.2),'' |'')') I, PNAM(I),(PWGT(J,I,3),J=1,10)
+  10  CONTINUE
+      WRITE(LUN,'(1X,''+'',13(''-''),''+'',60(''-''),''+'')')
+      DO 20 I = 11,30
+        NAM = PNAM(I)
+        WRITE(II,'(I3)') I
+        IF(IDCHEK(PNAM(I),3,'      ',0).NE.-1) THEN
+        WRITE(LUN,'('' |'',A3,1X,A5,''  3 |'',F5.2,
+     +             9(F6.2),'' |'')') II, NAM,(PWGT(J,I,3),J=1,10)
+        NAM = '     '
+        II  = '   '
+        ENDIF
+        IF(IDCHEK(PNAM(I),4,'      ',0).NE.-1) THEN
+        WRITE(LUN,'('' |'',A3,1X,A5,''  4 |'',F5.2,
+     +             9(F6.2),'' |'')') II, NAM,(PWGT(J,I,4),J=1,10)
+        NAM = '     '
+        II  = '   '
+        ENDIF
+        IF(IDCHEK(PNAM(I),5,'      ',0).NE.-1) THEN
+        WRITE(LUN,'('' |'',A3,1X,A5,''  5 |'',F5.2,
+     +             9(F6.2),'' |'')') II, NAM, (PWGT(J,I,5),J=1,10)
+        NAM = '     '
+        II  = '   '
+        ENDIF
+  20  CONTINUE
+      WRITE(LUN,'(1X,''+'',13(''-''),''+'',60(''-''),''+'')')
+      WRITE(LUN,'(////)')
+      RETURN
+      END
+CDECK  ID>, QNPSET.
+C     ================================= 
+      SUBROUTINE QNPSET(UNAM,IX,IQ,VAL) 
+C     ================================= 
+
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+      CHARACTER*(*) UNAM
+      CHARACTER*5   NAME
+      LOGICAL
+     +LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB,
+     +LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS,
+     +LALFOK,LDQ2OK,LWT1OK,LWT2OK,
+     +LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ,
+     +LFFCAL,LASOLD
+
+      COMMON/QCFLAG/ 
+     +IORD,IOLAST,
+     +LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB,
+     +LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS,
+     +LALFOK,LDQ2OK,LWT1OK,LWT2OK,
+     +LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ,
+     +LFFCAL(7,30),LASOLD
+      CHARACTER*5 PNAM,STFNAM
+      LOGICAL     LNFP
+      COMMON /QCLNFP/ LNFP(0:30,3:5)
+      COMMON /QCPNAM/ PNAM(0:30)
+      COMMON /QCPWGT/ PWGT(0:10,0:30,3:5)
+      COMMON /QCFNAM/ STFNAM(7)
+      PARAMETER ( MXX = 410 )
+      PARAMETER ( MQ2 =  120 )
+
+C--   Do not set the following parameter to zero!
+      PARAMETER ( NDFMAX = 20)
+
+      COMMON/QCGRID/
+     +SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS,
+     +XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45,
+     +NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2),
+     +IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2)
+      COMMON/QCPASS/
+     +ALPHA0, Q0ALFA, ASLAST, QALAST,
+     +ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2),
+     +DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10),
+     +FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2),
+     +FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2),
+     +FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2),
+     +FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST,
+     +MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2),
+     +ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2),
+     +IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10)
+
+      LOGICAL LEVDONE,LE_DONE
+      COMMON/QCLEVL/
+     +LEVDONE(MXX,10),LE_DONE(MXX)
+
+      CALL QTRACE('QNPSET ',0)
+      IF(NXX.EQ.0.OR.NQ2.EQ.0) THEN
+        IERR = 1
+        GOTO 500
+      ENDIF
+      CALL QSTRIP(UNAM,NAME)
+      ID = IDCHEK(NAME,4,'QNPSET',1)
+      IF(ID.EQ.-1) RETURN
+      IF(IX.LT.1.OR.IX.GT.NXX) THEN
+        IERR = 2
+        GOTO 500
+      ENDIF
+      IF(IQ.LT.1.OR.IQ.GT.NQ2) THEN
+        IERR = 2
+        GOTO 500
+      ENDIF
+      IF(ID.LT.0.OR.ID.GT.10) THEN
+        IERR = 3
+        GOTO 500
+      ENDIF
+
+C--   If a different input value, invalidate evolution for this
+C--   and all lower x-grid points
+      IF(VAL.NE.PDFQCD(IX,IQ,ID)) THEN
+        DO JX = 1,IX
+          LEVDONE(JX,MAX(ID,1)) = .FALSE.
+        ENDDO
+      ENDIF
+      PDFQCD(IX,IQ,ID) = VAL
+
+      DO I = 1,30
+        DO J = 1,7
+          LFFCAL(J,I)  = .FALSE.
+        ENDDO
+      ENDDO
+      RETURN
+
+ 500  CONTINUE
+      WRITE(6,'(/'' ------------------------------------'')')
+      WRITE(6,'( '' QCDNUM error in s/r QNPSET ---> STOP'')')
+      WRITE(6,'( '' ------------------------------------'')')
+      WRITE(6,'( '' Input NAME :'',A)') UNAM
+      WRITE(6,'( ''         IX :'',I10)') IX
+      WRITE(6,'( ''         IQ :'',I10)') IQ
+      WRITE(6,'( ''      Value :'',E12.5)') VAL
+      IF(IERR.EQ.1) THEN
+        WRITE(6,'(/'' No x-Q2 grid available'')')
+      ELSEIF(IERR.EQ.2) THEN
+        WRITE(6,'(/'' IX and/or IQ outside grid boundary'')')
+      ELSEIF(IERR.EQ.3) THEN
+        WRITE(6,'(/'' Apparently you try to assign a value'',
+     +             '' to a linear combination: no thank you'')')
+      ENDIF
+
+      CALL QTRACE('QNPSET ',1)
+
+      STOP
+
+      END
+CDECK  ID>, QADDSI.
+C     =================================
+      SUBROUTINE QADDSI(UNAM,IQ,FACTOR)
+C     =================================
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+      CHARACTER*(*) UNAM
+      CHARACTER*5   NAME
+      LOGICAL
+     +LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB,
+     +LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS,
+     +LALFOK,LDQ2OK,LWT1OK,LWT2OK,
+     +LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ,
+     +LFFCAL,LASOLD
+
+      COMMON/QCFLAG/ 
+     +IORD,IOLAST,
+     +LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB,
+     +LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS,
+     +LALFOK,LDQ2OK,LWT1OK,LWT2OK,
+     +LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ,
+     +LFFCAL(7,30),LASOLD
+      CHARACTER*5 PNAM,STFNAM
+      LOGICAL     LNFP
+      COMMON /QCLNFP/ LNFP(0:30,3:5)
+      COMMON /QCPNAM/ PNAM(0:30)
+      COMMON /QCPWGT/ PWGT(0:10,0:30,3:5)
+      COMMON /QCFNAM/ STFNAM(7)
+      PARAMETER ( MXX = 410 )
+      PARAMETER ( MQ2 =  120 )
+
+C--   Do not set the following parameter to zero!
+      PARAMETER ( NDFMAX = 20)
+
+      COMMON/QCGRID/
+     +SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS,
+     +XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45,
+     +NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2),
+     +IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2)
+      COMMON/QCPASS/
+     +ALPHA0, Q0ALFA, ASLAST, QALAST,
+     +ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2),
+     +DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10),
+     +FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2),
+     +FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2),
+     +FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2),
+     +FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST,
+     +MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2),
+     +ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2),
+     +IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10)
+
+      LOGICAL LEVDONE,LE_DONE
+      COMMON/QCLEVL/
+     +LEVDONE(MXX,10),LE_DONE(MXX)
+
+      CALL QTRACE('QADDSI ',0)
+      IF(NXX.EQ.0.OR.NQ2.EQ.0) THEN
+        IERR = 1
+        GOTO 500
+      ENDIF
+      CALL QSTRIP(UNAM,NAME)
+      ID = IDCHEK(NAME,4,'QADDSI',1)
+      IF(ID.EQ.-1) RETURN
+
+      IF(ID.EQ.0.OR.ID.EQ.1) THEN
+        IERR = 2
+        GOTO 500
+      ENDIF
+      IF(IQ.LT.1.OR.IQ.GT.NQ2) THEN
+        IERR = 3
+        GOTO 500
+      ENDIF
+      IF(ID.LT.0.OR.ID.GT.10) THEN
+        IERR = 4
+        GOTO 500
+      ENDIF
+      DO IX = 1,NXX
+C--     Invalidate evolution of this pdf
+        LEVDONE(IX,MAX(ID,1)) = .FALSE.
+        PDFQCD(IX,IQ,ID) = PDFQCD(IX,IQ,ID)+
+     +                     FACTOR*PDFQCD(IX,IQ,1)
+      ENDDO
+
+      DO I = 1,30
+        DO J = 1,7
+          LFFCAL(J,I)  = .FALSE.
+        ENDDO
+      ENDDO
+      RETURN
+
+ 500  CONTINUE
+      WRITE(6,'(/'' ------------------------------------'')')
+      WRITE(6,'( '' QCDNUM error in s/r QADDSI ---> STOP'')')
+      WRITE(6,'( '' ------------------------------------'')')
+      WRITE(6,'( '' Input NAME :'',A)') UNAM
+      WRITE(6,'( ''         IQ :'',I10)') IQ
+      WRITE(6,'( ''     Factor :'',E12.5)') FACTOR
+      IF(IERR.EQ.1) THEN
+        WRITE(6,'(/'' No x-Q2 grid available'')')
+      ELSEIF(IERR.EQ.2) THEN
+        WRITE(6,'(/'' This routine cannot be used'',
+     +             '' for singlet or gluon'')')
+      ELSEIF(IERR.EQ.3) THEN
+        WRITE(6,'(/'' IX and/or IQ outside grid boundary'')')
+      ELSEIF(IERR.EQ.4) THEN
+        WRITE(6,'(/'' Apparently you try to assign a value'',
+     +             '' to a linear combination: no thank you'')')
+      ENDIF
+
+      CALL QTRACE('QADDSI ',1)
+
+      STOP
+
+      END
+CDECK  ID>, QNPNUL.
+C     =======================
+      SUBROUTINE QNPNUL(UNAM)
+C     =======================
+
+C---  Set parton distribution 'NAME' to zero.
+C---  Called by user.
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+      CHARACTER*(*) UNAM
+      CHARACTER*5   NAME
+      LOGICAL
+     +LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB,
+     +LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS,
+     +LALFOK,LDQ2OK,LWT1OK,LWT2OK,
+     +LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ,
+     +LFFCAL,LASOLD
+
+      COMMON/QCFLAG/ 
+     +IORD,IOLAST,
+     +LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB,
+     +LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS,
+     +LALFOK,LDQ2OK,LWT1OK,LWT2OK,
+     +LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ,
+     +LFFCAL(7,30),LASOLD
+      CHARACTER*5 PNAM,STFNAM
+      LOGICAL     LNFP
+      COMMON /QCLNFP/ LNFP(0:30,3:5)
+      COMMON /QCPNAM/ PNAM(0:30)
+      COMMON /QCPWGT/ PWGT(0:10,0:30,3:5)
+      COMMON /QCFNAM/ STFNAM(7)
+      PARAMETER ( MXX = 410 )
+      PARAMETER ( MQ2 =  120 )
+
+C--   Do not set the following parameter to zero!
+      PARAMETER ( NDFMAX = 20)
+
+      COMMON/QCGRID/
+     +SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS,
+     +XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45,
+     +NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2),
+     +IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2)
+      COMMON/QCPASS/
+     +ALPHA0, Q0ALFA, ASLAST, QALAST,
+     +ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2),
+     +DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10),
+     +FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2),
+     +FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2),
+     +FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2),
+     +FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST,
+     +MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2),
+     +ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2),
+     +IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10)
+
+      LOGICAL LEVDONE,LE_DONE
+      COMMON/QCLEVL/
+     +LEVDONE(MXX,10),LE_DONE(MXX)
+
+      CALL QTRACE('QNPNUL ',0)
+      CALL QSTRIP(UNAM,NAME)
+      ID = IDCHEK(NAME,4,'QNPNUL',1)
+      IF(ID.EQ.-1) RETURN
+      IF(ID.LT.0.OR.ID.GT.10) THEN
+        GOTO 500
+      ENDIF
+      DO IX = 1,MXX
+        DO IQ = 1,MQ2
+          PDFQCD(IX,IQ,ID) = 0.
+        ENDDO
+      ENDDO
+
+C--   Invalidate all evolutions      
+      CALL QNFALS(LEVDONE,MXX*10)
+
+      DO I = 1,30
+        DO J = 1,7
+          LFFCAL(J,I)  = .FALSE.
+        ENDDO
+      ENDDO
+      RETURN
+
+ 500  CONTINUE
+      WRITE(6,'(/'' ------------------------------------'')')
+      WRITE(6,'( '' QCDNUM error in s/r QNPNUL ---> STOP'')')
+      WRITE(6,'( '' ------------------------------------'')')
+      WRITE(6,'( '' Input NAME :'',A)') UNAM
+      WRITE(6,'(/'' Apparently you try to clear'',
+     +           '' a linear combination: no thank you'')')
+
+      CALL QTRACE('QNPNUL ',1)
+
+      STOP
+
+      END
+CDECK  ID>, IX1CHK.
+C     ==============================
+      INTEGER FUNCTION IX1CHK(ISTOP)
+C     ==============================
+
+C---  Check all pdfs are zero at NXX+1 (x = 1).
+C---  IX1CHK = 0    : All ok.
+C---         = 1    : Nonzero entry in gluon or singlet.
+C---         = 2-10 : Nonzero entry in PDF 2-10.
+C---  Called by user.
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+      LOGICAL
+     +LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB,
+     +LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS,
+     +LALFOK,LDQ2OK,LWT1OK,LWT2OK,
+     +LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ,
+     +LFFCAL,LASOLD
+
+      COMMON/QCFLAG/ 
+     +IORD,IOLAST,
+     +LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB,
+     +LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS,
+     +LALFOK,LDQ2OK,LWT1OK,LWT2OK,
+     +LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ,
+     +LFFCAL(7,30),LASOLD
+      CHARACTER*5 PNAM,STFNAM
+      LOGICAL     LNFP
+      COMMON /QCLNFP/ LNFP(0:30,3:5)
+      COMMON /QCPNAM/ PNAM(0:30)
+      COMMON /QCPWGT/ PWGT(0:10,0:30,3:5)
+      COMMON /QCFNAM/ STFNAM(7)
+      PARAMETER ( MXX = 410 )
+      PARAMETER ( MQ2 =  120 )
+
+C--   Do not set the following parameter to zero!
+      PARAMETER ( NDFMAX = 20)
+
+      COMMON/QCGRID/
+     +SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS,
+     +XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45,
+     +NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2),
+     +IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2)
+      COMMON/QCPASS/
+     +ALPHA0, Q0ALFA, ASLAST, QALAST,
+     +ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2),
+     +DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10),
+     +FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2),
+     +FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2),
+     +FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2),
+     +FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST,
+     +MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2),
+     +ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2),
+     +IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10)
+
+      LOGICAL LEVDONE,LE_DONE
+      COMMON/QCLEVL/
+     +LEVDONE(MXX,10),LE_DONE(MXX)
+
+      CALL QTRACE('IX1CHK ',0)
+
+      IERR = -1
+      JQ   =  0
+
+      DO ID = 0,10 
+        DO IQ = 1,NQ2
+          IF(ABS(PDFQCD(NXX+1,IQ,ID)).GT.1.E-11) THEN
+            IERR = ID
+            JQ   = IQ
+          ENDIF
+        ENDDO
+      ENDDO
+
+      IF(IERR.EQ.-1) THEN
+        IX1CHK = 0
+        RETURN
+      ENDIF
+
+      IX1CHK = MAX(IERR,1)
+      IF(ISTOP.EQ.0) RETURN
+      WRITE(6,'(/'' ------------------------------------'')')
+      WRITE(6,'( '' QCDNUM error in s/r IX1CHK ---> STOP'')')
+      WRITE(6,'( '' ------------------------------------'')')
+      WRITE(6,'( '' Pdf identifier  ID :'',I5)') IERR
+      WRITE(6,'( '' X = 1 gridpoint IX :'',I5)') NXX+1
+      WRITE(6,'( '' Q2    gridpoint IQ :'',I5)') JQ
+      WRITE(6,'(/'' Pdf nonzero at x = 1;''/        
+     +           '' this should never happen....'')')
+
+      CALL QTRACE('IX1CHK ',1)
+
+      STOP
+
+      END
+CDECK  ID>, EVOLSG.
+
+C     ================================ 
+      SUBROUTINE EVOLSG(IQ0,IUQL,IUQH) 
+C     ================================
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+      LOGICAL
+     +LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB,
+     +LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS,
+     +LALFOK,LDQ2OK,LWT1OK,LWT2OK,
+     +LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ,
+     +LFFCAL,LASOLD
+
+      COMMON/QCFLAG/ 
+     +IORD,IOLAST,
+     +LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB,
+     +LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS,
+     +LALFOK,LDQ2OK,LWT1OK,LWT2OK,
+     +LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ,
+     +LFFCAL(7,30),LASOLD
+      PARAMETER ( MXX = 410 )
+      PARAMETER ( MQ2 =  120 )
+
+C--   Do not set the following parameter to zero!
+      PARAMETER ( NDFMAX = 20)
+
+      COMMON/QCGRID/
+     +SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS,
+     +XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45,
+     +NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2),
+     +IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2)
+      COMMON/QCPASS/
+     +ALPHA0, Q0ALFA, ASLAST, QALAST,
+     +ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2),
+     +DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10),
+     +FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2),
+     +FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2),
+     +FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2),
+     +FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST,
+     +MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2),
+     +ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2),
+     +IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10)
+
+      LOGICAL LEVDONE,LE_DONE
+      COMMON/QCLEVL/
+     +LEVDONE(MXX,10),LE_DONE(MXX)
+      LOGICAL LTIME  
+      REAL T_START,T_END,T_SPENT
+      COMMON/QCTIME/T_START(10),T_END(10),T_SPENT(10),N_CALLS(10),
+     +E_CALLS(10),LTIME
+      COMMON/QCFCNT/IFCNT(-1:1,5)
+
+      IF(LTIME) CALL TIMEX_LHA(T_START(5))
+
+      CALL QTRACE('EVOLSG ',0)
+      IF(NXX.EQ.0.OR.NQ2.EQ.0) THEN
+        IERR = 1
+        GOTO 500
+      ENDIF
+
+      IQL = IUQL
+      IQH = IUQH
+
+      IXL = MAX(ABS(IXFROMX(XMICUT)),1)
+      IQD = ABS(IQFROMQ(QMICUT))
+      IQD = MAX(IQD,ABS(IQFROMQ(QMINAS)))
+      IQU = ABS(IQFROMQ(QMACUT))
+      IF(IQD.NE.0) IQL = MAX(IQD,IQL)
+      IF(IQU.NE.0) IQH = MIN(IQU+1,IQH)
+      IF(IQL.LE.0) IQL = 1
+      IF(IQH.LE.0.OR.IQH.GT.NQ2) IQH = NQ2
+      IF(IQL.EQ.IQ0.AND.IQH.EQ.IQ0) RETURN
+      IF(IQL.GE.IQH) THEN
+        IERR = 2
+        GOTO 500
+      ENDIF
+      IF(IQL.LT.1.OR.IQL.GE.NQ2) THEN
+        IERR = 3
+        GOTO 500
+      ENDIF
+      IF(IQH.LE.1.OR.IQH.GT.NQ2) THEN
+        IERR = 3
+        GOTO 500
+      ENDIF
+      IF(IQ0.LT.IQL.OR.IQ0.GT.IQH) THEN
+        IERR = 4
+        GOTO 500
+      ENDIF
+      IF(.NOT.LWT1OK) THEN
+        IERR = 5
+        GOTO 500
+      ENDIF
+      IF(IORD.EQ.2.AND..NOT.LWT2OK) THEN
+        IERR = 6
+        GOTO 500
+      ENDIF
+
+      IRUN = 0
+      IF(.NOT.LALFOK) THEN
+        CALL QFILAS('EVOLSG')
+        IRUN = 1
+      ENDIF
+      IF(.NOT.LDQ2OK) THEN
+        CALL QDELQ2
+        IRUN = 1
+      ENDIF
+      DO IX = 1,NXX
+      LE_DONE(IX) = LEVDONE(IX,1)
+      DO IQ = 1,NQ2
+        FGLQCD(IX,IQ) = PDFQCD(IX,IQ,0)
+        FSIQCD(IX,IQ) = PDFQCD(IX,IQ,1)
+      ENDDO   
+      ENDDO   
+      IF(IQ0.NE.IQ0_LAST(1) .OR.
+     +   IQL.NE.IQL_LAST(1) .OR.
+     +   IQH.NE.IQH_LAST(1)     ) IRUN = 1
+
+      CALL APSI(IXL,IQ0,IQL,IQH,IRUN,EVL)
+
+      IQ0_LAST(1) = IQ0
+      IQL_LAST(1) = IQL
+      IQH_LAST(1) = IQH
+      DO IX = 1,NXX
+      LEVDONE(IX,1) = LE_DONE(IX) 
+      DO IQ = 1,NQ2
+        PDFQCD(IX,IQ,0) = FGLQCD(IX,IQ)
+        PDFQCD(IX,IQ,1) = FSIQCD(IX,IQ)
+      ENDDO   
+      ENDDO   
+      DO I = 1,30
+        DO J = 1,7
+          LFFCAL(J,I)  = .FALSE.
+        ENDDO
+      ENDDO
+      IF(LTIME) THEN
+        CALL TIMEX_LHA(T_END(5))
+        T_SPENT(5) = T_SPENT(5)+T_END(5)-T_START(5)
+        N_CALLS(5) = N_CALLS(5)+1
+        E_CALLS(5) = E_CALLS(5)+EVL
+      ENDIF
+      RETURN
+
+ 500  CONTINUE
+      WRITE(6,'(/'' ------------------------------------'')')
+      WRITE(6,'( '' QCDNUM error in s/r EVOLSG ---> STOP'')')
+      WRITE(6,'( '' ------------------------------------'')')
+      WRITE(6,'( '' Input      IQ0      :'',I5)') IQ0
+      WRITE(6,'( ''            IQLow    :'',I5)') IUQL
+      WRITE(6,'( ''            IQHigh   :'',I5)') IUQH
+      IF(IERR.NE.1) THEN
+        WRITE(6,'(/'' After cuts IQ0, Q20 :'',I5,E12.5)') IQ0,Q2TAB(IQ0)
+        WRITE(6,'( ''            IQL, Q2L :'',I5,E12.5)') IQL,Q2TAB(IQL)
+        WRITE(6,'( ''            IQH, Q2H :'',I5,E12.5)') IQH,Q2TAB(IQH)
+      ENDIF
+      IF(IERR.EQ.1) THEN
+        WRITE(6,'(/'' No x-Q2 grid available'')')
+      ELSEIF(IERR.EQ.2) THEN
+        WRITE(6,'(/'' Value of IQL .ge. IQH'',
+     +             '' (after applying Q2 cuts, if any)'')')
+      ELSEIF(IERR.EQ.3) THEN
+        WRITE(6,'(/'' IQL and/or IQH outside grid boundary'')')
+      ELSEIF(IERR.EQ.4) THEN
+        WRITE(6,'(/'' IQ0 outside the range [IQL,IQH]'',
+     +             '' (after applying Q2 cuts, if any)'')')
+      ELSEIF(IERR.EQ.5) THEN
+        WRITE(6,'(/'' No LO weight tables available'',
+     +             '' (please call s/r QNFILW)'')')
+      ELSEIF(IERR.EQ.6) THEN
+        WRITE(6,'(/'' No NLO weight tables available'',
+     +             '' (please call s/r QNFILW)'')')
+      ENDIF
+
+      CALL QTRACE('EVOLSG ',1)
+
+      STOP
+
+      END
+CDECK  ID>, APSI.
+C     ========================================= 
+      SUBROUTINE APSI(IXL,IQ0,IQL,IQH,IRUN,EVL) 
+C     ========================================= 
+
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z) 
+      COMMON/QCCONS/
+     +PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L,
+     +AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7),
+     +C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3,
+     +C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9,
+     +C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1,
+     +C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF
+      LOGICAL
+     +LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB,
+     +LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS,
+     +LALFOK,LDQ2OK,LWT1OK,LWT2OK,
+     +LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ,
+     +LFFCAL,LASOLD
+
+      COMMON/QCFLAG/ 
+     +IORD,IOLAST,
+     +LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB,
+     +LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS,
+     +LALFOK,LDQ2OK,LWT1OK,LWT2OK,
+     +LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ,
+     +LFFCAL(7,30),LASOLD
+      PARAMETER ( MXX = 410 )
+      PARAMETER ( MQ2 =  120 )
+
+C--   Do not set the following parameter to zero!
+      PARAMETER ( NDFMAX = 20)
+
+      COMMON/QCGRID/
+     +SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS,
+     +XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45,
+     +NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2),
+     +IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2)
+      REAL
+     +WGTFF1,WGTFG1,
+     +WGTGF1,WGTGG1,
+     +WGTPP2,WGTPM2,WGTNS2,
+     +WGTFF2,WGTFG2,
+     +WGTGF2,WGTGG2,
+     +WGTC2Q,WGTC2G,YNTC2Q,
+     +WGTCLQ,WGTCLG,WGTC3Q
+
+      COMMON/QCWEIT/
+     +WGTFF1(MXX*(MXX+1)/2)    ,WGTFG1(MXX*(MXX+1)/2,3:5),
+     +WGTGF1(MXX*(MXX+1)/2)    ,WGTGG1(MXX*(MXX+1)/2,3:5),
+     +WGTPP2(MXX*(MXX+1)/2,3:5),WGTPM2(MXX*(MXX+1)/2,3:5),
+     +WGTNS2(MXX*(MXX+1)/2,3:5),
+     +WGTFF2(MXX*(MXX+1)/2,3:5),WGTFG2(MXX*(MXX+1)/2,3:5),
+     +WGTGF2(MXX*(MXX+1)/2,3:5),WGTGG2(MXX*(MXX+1)/2,3:5),
+     +WGTC2Q(MXX*(MXX+1)/2)    ,WGTC2G(MXX*(MXX+1)/2,3:5),
+     +WGTCLQ(MXX*(MXX+1)/2)    ,WGTCLG(MXX*(MXX+1)/2,3:5),
+     +WGTC3Q(MXX*(MXX+1)/2)    ,YNTC2Q(MXX)
+
+      COMMON/QCWADR/ IWADR(MXX,MXX)
+
+      COMMON/QCPASS/
+     +ALPHA0, Q0ALFA, ASLAST, QALAST,
+     +ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2),
+     +DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10),
+     +FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2),
+     +FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2),
+     +FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2),
+     +FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST,
+     +MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2),
+     +ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2),
+     +IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10)
+
+      LOGICAL LEVDONE,LE_DONE
+      COMMON/QCLEVL/
+     +LEVDONE(MXX,10),LE_DONE(MXX)
+      LOGICAL LTIME  
+      REAL T_START,T_END,T_SPENT
+      COMMON/QCTIME/T_START(10),T_END(10),T_SPENT(10),N_CALLS(10),
+     +E_CALLS(10),LTIME
+      COMMON/QCFCNT/IFCNT(-1:1,5)
+
+
+      EVL = 0.
+
+      FSI = FSIQCD(NXX,IQ0)
+      FGL = FGLQCD(NXX,IQ0)
+C     -------------------------------------------
+      IF(.NOT.LE_DONE(NXX) .OR. IRUN.EQ.1) THEN !
+C     -------------------------------------------
+        NF  = NFMAP(IQ0)
+
+        WQQ = ALFAPQ(IQ0) * WGTFF1(IWADR(NXX,NXX))    +
+     +        ALFA2Q(IQ0) * WGTFF2(IWADR(NXX,NXX),NF)
+        WQG = ALFAPQ(IQ0) * WGTFG1(IWADR(NXX,NXX),NF) +
+     +        ALFA2Q(IQ0) * WGTFG2(IWADR(NXX,NXX),NF)
+        WGQ = ALFAPQ(IQ0) * WGTGF1(IWADR(NXX,NXX))    +
+     +        ALFA2Q(IQ0) * WGTGF2(IWADR(NXX,NXX),NF)
+        WGG = ALFAPQ(IQ0) * WGTGG1(IWADR(NXX,NXX),NF) +
+     +        ALFA2Q(IQ0) * WGTGG2(IWADR(NXX,NXX),NF)
+        DSI = WQQ*FSI+WQG*FGL
+        DGL = WGQ*FSI+WGG*FGL
+        FSI0 = FSI
+        DSI0 = DSI
+        FGL0 = FGL
+        DGL0 = DGL
+        FSIQCD(NXX,IQ0) = FSI
+        DSIQCD(NXX,IQ0) = DSI
+        FGLQCD(NXX,IQ0) = FGL
+        DGGQCD(NXX,IQ0) = DGL
+        EVL             = EVL+1.
+        DO 100 IQ = IQ0+1,IQH
+          DEL = DELUP(IQ)
+          NF  = NFMAP(IQ)
+          WQQ = ALFAPQ(IQ) * WGTFF1(IWADR(NXX,NXX))    +
+     +          ALFA2Q(IQ) * WGTFF2(IWADR(NXX,NXX),NF)
+          WQG = ALFAPQ(IQ) * WGTFG1(IWADR(NXX,NXX),NF) +
+     +          ALFA2Q(IQ) * WGTFG2(IWADR(NXX,NXX),NF)
+          WGQ = ALFAPQ(IQ) * WGTGF1(IWADR(NXX,NXX))    +
+     +          ALFA2Q(IQ) * WGTGF2(IWADR(NXX,NXX),NF)
+          WGG = ALFAPQ(IQ) * WGTGG1(IWADR(NXX,NXX),NF) +
+     +          ALFA2Q(IQ) * WGTGG2(IWADR(NXX,NXX),NF)
+          AAS = 2.*FSI + DSI*DEL
+          BBS = 2. - WQQ*DEL
+          AAG = 2.*FGL + DGL*DEL
+          BBG = 2. - WGG*DEL
+          FSI = (AAS*BBG+WQG*AAG*DEL) / (BBS*BBG-WQG*WGQ*DEL*DEL)
+          FGL = (AAG*BBS+WGQ*AAS*DEL) / (BBG*BBS-WGQ*WQG*DEL*DEL)
+          DSI = WQQ*FSI+WQG*FGL
+          DGL = WGQ*FSI+WGG*FGL
+          FSIQCD(NXX,IQ) = FSI
+          DSIQCD(NXX,IQ) = DSI
+          FGLQCD(NXX,IQ) = FGL
+          DGGQCD(NXX,IQ) = DGL
+ 100    CONTINUE
+        EVL = EVL+IQH-IQ0
+        FSI = FSI0
+        DSI = DSI0
+        FGL = FGL0
+        DGL = DGL0
+        DO 200 IQ = IQ0-1,IQL,-1
+          DEL = DELDN(IQ)
+          NF  = NFMAP(IQ)
+          WQQ = ALFAPQ(IQ) * WGTFF1(IWADR(NXX,NXX))    +
+     +          ALFA2Q(IQ) * WGTFF2(IWADR(NXX,NXX),NF)
+          WQG = ALFAPQ(IQ) * WGTFG1(IWADR(NXX,NXX),NF) +
+     +          ALFA2Q(IQ) * WGTFG2(IWADR(NXX,NXX),NF)
+          WGQ = ALFAPQ(IQ) * WGTGF1(IWADR(NXX,NXX))    +
+     +          ALFA2Q(IQ) * WGTGF2(IWADR(NXX,NXX),NF)
+          WGG = ALFAPQ(IQ) * WGTGG1(IWADR(NXX,NXX),NF) +
+     +          ALFA2Q(IQ) * WGTGG2(IWADR(NXX,NXX),NF)
+          AAS = 2.*FSI + DSI*DEL
+          BBS = 2. - WQQ*DEL
+          AAG = 2.*FGL + DGL*DEL
+          BBG = 2. - WGG*DEL
+          FSI = (AAS*BBG+WQG*AAG*DEL) / (BBS*BBG-WQG*WGQ*DEL*DEL)
+          FGL = (AAG*BBS+WGQ*AAS*DEL) / (BBG*BBS-WGQ*WQG*DEL*DEL)
+          DSI = WQQ*FSI+WQG*FGL
+          DGL = WGQ*FSI+WGG*FGL
+          FSIQCD(NXX,IQ) = FSI
+          DSIQCD(NXX,IQ) = DSI
+          FGLQCD(NXX,IQ) = FGL
+          DGGQCD(NXX,IQ) = DGL
+ 200    CONTINUE
+        EVL = EVL+IQ0-IQL
+C     -------
+      ENDIF !
+C     -------
+C     ---------------------------
+      DO 300 IX0 = NXX-1,IXL,-1 !
+C     ---------------------------
+        FSI = FSIQCD(IX0,IQ0)
+        FGL = FGLQCD(IX0,IQ0)
+        IF(LE_DONE(IX0) .AND. IRUN.EQ.0) GOTO 300
+        ALF = ALFAPQ(IQ0)
+        AL2 = ALFA2Q(IQ0)
+        SQQ1 = 0.
+        SQG1 = 0.
+        SGQ1 = 0.
+        SGG1 = 0.
+        SQQ2 = 0.
+        SQG2 = 0.
+        SGQ2 = 0.
+        SGG2 = 0.
+        NF  = NFMAP(IQ0)
+        DO 220 IX = NXX,IX0+1,-1
+          IADR = IWADR(IX,IX0)
+          SQQ1 = SQQ1 + WGTFF1(IADR)      * FSIQCD(IX,IQ0)
+          SQQ2 = SQQ2 + WGTFF2(IADR,NF)   * FSIQCD(IX,IQ0)
+          SQG1 = SQG1 + WGTFG1(IADR,NF)   * FGLQCD(IX,IQ0)
+          SQG2 = SQG2 + WGTFG2(IADR,NF)   * FGLQCD(IX,IQ0)
+          SGQ1 = SGQ1 + WGTGF1(IADR)      * FSIQCD(IX,IQ0)
+          SGQ2 = SGQ2 + WGTGF2(IADR,NF)   * FSIQCD(IX,IQ0)
+          SGG1 = SGG1 + WGTGG1(IADR,NF)   * FGLQCD(IX,IQ0)
+          SGG2 = SGG2 + WGTGG2(IADR,NF)   * FGLQCD(IX,IQ0)
+ 220    CONTINUE
+        IAD = IWADR(IX0,IX0)
+        SQQ = ALF*SQQ1 + AL2*SQQ2
+        SQG = ALF*SQG1 + AL2*SQG2
+        SGQ = ALF*SGQ1 + AL2*SGQ2
+        SGG = ALF*SGG1 + AL2*SGG2
+        WQQ = ALF* WGTFF1(IAD)        + AL2*WGTFF2(IAD,NF)    
+        WQG = ALF* WGTFG1(IAD,NF)     + AL2*WGTFG2(IAD,NF)    
+        WGQ = ALF* WGTGF1(IAD)        + AL2*WGTGF2(IAD,NF)    
+        WGG = ALF* WGTGG1(IAD,NF)     + AL2*WGTGG2(IAD,NF)    
+        DSI = WQQ*FSI+SQQ+WQG*FGL+SQG
+        DGL = WGQ*FSI+SGQ+WGG*FGL+SGG
+        FSI0 = FSI
+        DSI0 = DSI
+        FGL0 = FGL
+        DGL0 = DGL
+        FSIQCD(IX0,IQ0) = FSI
+        DSIQCD(IX0,IQ0) = DSI
+        FGLQCD(IX0,IQ0) = FGL
+        DGGQCD(IX0,IQ0) = DGL
+        EVL             = EVL+NXX-IX0+1
+        DO 250 IQ = IQ0+1,IQH
+          IF(IFAILC(IX0,IQ).NE.0) GOTO 250
+          ALF = ALFAPQ(IQ)
+          AL2 = ALFA2Q(IQ)
+          DEL = DELUP(IQ)
+          SQQ1 = 0.
+          SQG1 = 0.
+          SGQ1 = 0.
+          SGG1 = 0.
+          SQQ2 = 0.
+          SQG2 = 0.
+          SGQ2 = 0.
+          SGG2 = 0.
+          NF  = NFMAP(IQ)
+          DO 230 IX = NXX,IX0+1,-1
+            IADR = IWADR(IX,IX0)
+            SQQ1 = SQQ1 + WGTFF1(IADR)      * FSIQCD(IX,IQ)
+            SQQ2 = SQQ2 + WGTFF2(IADR,NF)   * FSIQCD(IX,IQ)
+            SQG1 = SQG1 + WGTFG1(IADR,NF)   * FGLQCD(IX,IQ)
+            SQG2 = SQG2 + WGTFG2(IADR,NF)   * FGLQCD(IX,IQ)
+            SGQ1 = SGQ1 + WGTGF1(IADR)      * FSIQCD(IX,IQ)
+            SGQ2 = SGQ2 + WGTGF2(IADR,NF)   * FSIQCD(IX,IQ)
+            SGG1 = SGG1 + WGTGG1(IADR,NF)   * FGLQCD(IX,IQ)
+            SGG2 = SGG2 + WGTGG2(IADR,NF)   * FGLQCD(IX,IQ)
+ 230      CONTINUE
+          IAD = IWADR(IX0,IX0)
+          SQQ = ALF*SQQ1 + AL2*SQQ2
+          SQG = ALF*SQG1 + AL2*SQG2
+          SGQ = ALF*SGQ1 + AL2*SGQ2
+          SGG = ALF*SGG1 + AL2*SGG2
+          WQQ = ALF* WGTFF1(IAD)        + AL2*WGTFF2(IAD,NF)    
+          WQG = ALF* WGTFG1(IAD,NF)     + AL2*WGTFG2(IAD,NF)    
+          WGQ = ALF* WGTGF1(IAD)        + AL2*WGTGF2(IAD,NF)    
+          WGG = ALF* WGTGG1(IAD,NF)     + AL2*WGTGG2(IAD,NF)    
+          AAS = 2.*FSI + (DSI+SQQ+SQG)*DEL
+          BBS = 2. - WQQ*DEL
+          AAG = 2.*FGL + (DGL+SGQ+SGG)*DEL
+          BBG = 2. - WGG*DEL
+          FSI = (AAS*BBG+WQG*AAG*DEL) / (BBS*BBG-WQG*WGQ*DEL*DEL)
+          FGL = (AAG*BBS+WGQ*AAS*DEL) / (BBG*BBS-WGQ*WQG*DEL*DEL)
+          DSI = WQQ*FSI+SQQ+WQG*FGL+SQG
+          DGL = WGQ*FSI+SGQ+WGG*FGL+SGG
+          FSIQCD(IX0,IQ) = FSI
+          DSIQCD(IX0,IQ) = DSI
+          FGLQCD(IX0,IQ) = FGL
+          DGGQCD(IX0,IQ) = DGL
+          EVL            = EVL+NXX-IX0+1
+ 250    CONTINUE
+        FSI = FSI0
+        DSI = DSI0
+        FGL = FGL0
+        DGL = DGL0
+        DO 270 IQ = IQ0-1,IQL,-1
+          ALF = ALFAPQ(IQ)
+          AL2 = ALFA2Q(IQ)
+          DEL = DELDN(IQ)
+          SQQ1 = 0.
+          SQG1 = 0.
+          SGQ1 = 0.
+          SGG1 = 0.
+          SQQ2 = 0.
+          SQG2 = 0.
+          SGQ2 = 0.
+          SGG2 = 0.
+          NF  = NFMAP(IQ)
+          DO 260 IX = NXX,IX0+1,-1
+            IADR = IWADR(IX,IX0)
+            SQQ1 = SQQ1 + WGTFF1(IADR)      * FSIQCD(IX,IQ)
+            SQQ2 = SQQ2 + WGTFF2(IADR,NF)   * FSIQCD(IX,IQ)
+            SQG1 = SQG1 + WGTFG1(IADR,NF)   * FGLQCD(IX,IQ)
+            SQG2 = SQG2 + WGTFG2(IADR,NF)   * FGLQCD(IX,IQ)
+            SGQ1 = SGQ1 + WGTGF1(IADR)      * FSIQCD(IX,IQ)
+            SGQ2 = SGQ2 + WGTGF2(IADR,NF)   * FSIQCD(IX,IQ)
+            SGG1 = SGG1 + WGTGG1(IADR,NF)   * FGLQCD(IX,IQ)
+            SGG2 = SGG2 + WGTGG2(IADR,NF)   * FGLQCD(IX,IQ)
+ 260      CONTINUE
+          IAD = IWADR(IX0,IX0)
+          SQQ = ALF*SQQ1 + AL2*SQQ2
+          SQG = ALF*SQG1 + AL2*SQG2
+          SGQ = ALF*SGQ1 + AL2*SGQ2
+          SGG = ALF*SGG1 + AL2*SGG2
+          WQQ = ALF* WGTFF1(IAD)        + AL2*WGTFF2(IAD,NF)    
+          WQG = ALF* WGTFG1(IAD,NF)     + AL2*WGTFG2(IAD,NF)    
+          WGQ = ALF* WGTGF1(IAD)        + AL2*WGTGF2(IAD,NF)    
+          WGG = ALF* WGTGG1(IAD,NF)     + AL2*WGTGG2(IAD,NF)    
+          AAS = 2.*FSI + (DSI+SQQ+SQG)*DEL
+          BBS = 2. - WQQ*DEL
+          AAG = 2.*FGL + (DGL+SGQ+SGG)*DEL
+          BBG = 2. - WGG*DEL
+          FSI = (AAS*BBG+WQG*AAG*DEL) / (BBS*BBG-WQG*WGQ*DEL*DEL)
+          FGL = (AAG*BBS+WGQ*AAS*DEL) / (BBG*BBS-WGQ*WQG*DEL*DEL)
+          DSI = WQQ*FSI+SQQ+WQG*FGL+SQG
+          DGL = WGQ*FSI+SGQ+WGG*FGL+SGG
+          FSIQCD(IX0,IQ) = FSI
+          DSIQCD(IX0,IQ) = DSI
+          FGLQCD(IX0,IQ) = FGL
+          DGGQCD(IX0,IQ) = DGL
+          EVL            = EVL+NXX-IX0+1
+ 270    CONTINUE
+C     ----------
+ 300  CONTINUE !
+C     ----------
+
+      EVL = EVL*2./(NXX*(NXX+1)*NQ2)
+
+      CALL QNTRUE(LE_DONE,NXX)
+      RETURN
+      END
+CDECK  ID>, EVOLNM.
+C     =====================================
+      SUBROUTINE EVOLNM(UNAM,IQ0,IUQL,IUQH)
+C     =====================================
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+      CHARACTER*(*) UNAM
+      CHARACTER*5   NAME
+      CHARACTER*5 PNAM,STFNAM
+      LOGICAL     LNFP
+      COMMON /QCLNFP/ LNFP(0:30,3:5)
+      COMMON /QCPNAM/ PNAM(0:30)
+      COMMON /QCPWGT/ PWGT(0:10,0:30,3:5)
+      COMMON /QCFNAM/ STFNAM(7)
+      PARAMETER ( MXX = 410 )
+      PARAMETER ( MQ2 =  120 )
+
+C--   Do not set the following parameter to zero!
+      PARAMETER ( NDFMAX = 20)
+
+      COMMON/QCGRID/
+     +SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS,
+     +XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45,
+     +NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2),
+     +IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2)
+      LOGICAL
+     +LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB,
+     +LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS,
+     +LALFOK,LDQ2OK,LWT1OK,LWT2OK,
+     +LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ,
+     +LFFCAL,LASOLD
+
+      COMMON/QCFLAG/ 
+     +IORD,IOLAST,
+     +LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB,
+     +LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS,
+     +LALFOK,LDQ2OK,LWT1OK,LWT2OK,
+     +LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ,
+     +LFFCAL(7,30),LASOLD
+      COMMON/QCPASS/
+     +ALPHA0, Q0ALFA, ASLAST, QALAST,
+     +ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2),
+     +DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10),
+     +FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2),
+     +FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2),
+     +FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2),
+     +FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST,
+     +MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2),
+     +ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2),
+     +IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10)
+
+      LOGICAL LEVDONE,LE_DONE
+      COMMON/QCLEVL/
+     +LEVDONE(MXX,10),LE_DONE(MXX)
+      REAL
+     +WGTFF1,WGTFG1,
+     +WGTGF1,WGTGG1,
+     +WGTPP2,WGTPM2,WGTNS2,
+     +WGTFF2,WGTFG2,
+     +WGTGF2,WGTGG2,
+     +WGTC2Q,WGTC2G,YNTC2Q,
+     +WGTCLQ,WGTCLG,WGTC3Q
+
+      COMMON/QCWEIT/
+     +WGTFF1(MXX*(MXX+1)/2)    ,WGTFG1(MXX*(MXX+1)/2,3:5),
+     +WGTGF1(MXX*(MXX+1)/2)    ,WGTGG1(MXX*(MXX+1)/2,3:5),
+     +WGTPP2(MXX*(MXX+1)/2,3:5),WGTPM2(MXX*(MXX+1)/2,3:5),
+     +WGTNS2(MXX*(MXX+1)/2,3:5),
+     +WGTFF2(MXX*(MXX+1)/2,3:5),WGTFG2(MXX*(MXX+1)/2,3:5),
+     +WGTGF2(MXX*(MXX+1)/2,3:5),WGTGG2(MXX*(MXX+1)/2,3:5),
+     +WGTC2Q(MXX*(MXX+1)/2)    ,WGTC2G(MXX*(MXX+1)/2,3:5),
+     +WGTCLQ(MXX*(MXX+1)/2)    ,WGTCLG(MXX*(MXX+1)/2,3:5),
+     +WGTC3Q(MXX*(MXX+1)/2)    ,YNTC2Q(MXX)
+
+      COMMON/QCWADR/ IWADR(MXX,MXX)
+
+      LOGICAL LTIME  
+      REAL T_START,T_END,T_SPENT
+      COMMON/QCTIME/T_START(10),T_END(10),T_SPENT(10),N_CALLS(10),
+     +E_CALLS(10),LTIME
+      COMMON/QCFCNT/IFCNT(-1:1,5)
+
+      IF(LTIME) CALL TIMEX_LHA(T_START(3))