! -*- F90 -*-


      subroutine EVLCTEQevolve(x,Q,f) 
      implicit none 
      include 'parmsetup.inc' 
      character*16 name(nmxset) 
      integer nmem(nmxset),ndef(nmxset),mmem 
      common/NAME/name,nmem,ndef,mmem 
      real*8 f(-6:6) 
      real*8 x,Q,xx,qq,up,dn,ubar,dbar,gluon,sbar,cbar,bbar,tbar,Blam 
      real*8 xmin,qmax,anx,anq,Q2fit,qini,Ahdn,ordi,anf,mass,pi,alfas 
      real*8 Q0,alfas0 
      real*8 CtLhpardis,CtLhALPI,parmflavor,CtLhastolam 
      integer nflavor,Eorder,j,nx,nq 
      integer nset 
      data pi / 3.141592653589793d0 / 
      external parmflavor 
      save nflavor,xmin,qmax,anx,anq 
                                                                        
!                                                                       
        xx = x 
        qq = Q 
        up   = xx*CtLhpardis(1,xx,qq) 
        dn   = xx*CtLhpardis(2,xx,qq) 
        ubar = xx*CtLhpardis(-1,xx,qq) 
        dbar = xx*CtLhpardis(-2,xx,qq) 
        gluon= xx*CtLhpardis( 0,xx,qq) 
                                                                        
        if(nflavor .ge. 3) then 
           sbar = xx*CtLhpardis(-3,xx,qq) 
        else 
           sbar = 0.d0 
        endif 
                                                                        
        if(nflavor .ge. 4) then 
           cbar = xx*CtLhpardis(-4,xx,qq) 
        else 
           cbar = 0.d0 
        endif 
                                                                        
        if(nflavor .ge. 5) then 
           bbar = xx*CtLhpardis(-5,xx,qq) 
        else 
           bbar = 0.d0 
        endif 
                                                                        
        if(nflavor .eq. 6) then 
           tbar = xx*CtLhpardis(-6,xx,qq) 
        else 
           tbar = 0.d0 
        endif 
                                                                        
        f(6) = tbar 
        f(5) = bbar 
        f(4) = cbar 
        f(3) = sbar 
        f(2) = up 
        f(1) = dn 
        f(0) = gluon 
        f(-1) = dbar 
        f(-2) = ubar 
        f(-3) = sbar 
        f(-4) = cbar 
        f(-5) = bbar 
        f(-6) = tbar 
!                                                                       
        return 
!                                                                       
      entry EVLCTEQread(nset) 
      call CtLhbldat1 
      call CtLhbldat2 
      read(1,*) xmin,qmax,nx,nq 
      anx=nx 
      anq=nq-1 
      return 
!                                                                       
      entry EVLCTEQalfa(alfas,Q) 
      alfas = pi*CtLhALPI(Q) 
      return 
!                                                                       
      entry EVLCTEQinit(nset,Eorder,Q2fit) 
!                                                                       
      Ahdn=1d0 
      call CtLhParPdf(1,'IHDN',Ahdn,j) 
      call CtLhParPdf(1,'QMAX',qmax,j) 
      call CtLhParPdf(1,'XMIN',xmin,j) 
      call GetOrderAsM(nset,j) 
      ordi=j+1.0 
      call CtLhParQcd(1,'ORDR',ordi,j) 
      call GetThresholdM(nset,4,mass) 
      call CtLhParQcd(1,'M4',mass,j) 
      call GetThresholdM(nset,5,mass) 
      call CtLhParQcd(1,'M5',mass,j) 
      mass=180d0 
      call CtLhParQcd(1,'M6',mass,j) 
      call GetNfM(nset,j) 
      nflavor=j 
      Anf=nflavor 
      call CtLhParQcd(1,'NFL',Anf,j) 
      qini=sqrt(Q2fit) 
      call CtLhParPdf(1,'QINI',qini,j) 
      call CtLhEvlpar(1,'NFMX', Anf, j) 
      ordi=Eorder+1.0 
      call CtLhParPdf(1,'IKNL',ordi,j) 
      return 
!                                                                       
      entry EVLCTEQpdf(nset) 
      call GetOrderAsM(nset,j) 
      call GetAlfas(nset,alfas0,Q0) 
      Blam=CtLhastolam(alfas0,Q0,j+1,nflavor) 
      call CtLhSetLam (nflavor,Blam,j+1) 
      call CtLhParPdf(1,'NX',anx,j) 
      call CtLhParPdf(1,'NT',anq,j) 
      call CtLhEvolve (parmflavor,j) 
      if (j .ne. 0) then 
         write(*,*) 'EVLCTEQ Evolve Error code :',j 
         stop 
      endif 
      return 
!                                                                       
      END                                           
!                                                                       
      double precision function parmflavor(i,x) 
      implicit none 
      real*8 x,f(-6:6) 
      integer i,i0 
      integer iset 
!                                                                       
      call getnset(iset) 
      call parmPDF(iset,x,f) 
      i0=i 
      if (i.eq.-2) i0=-1 
      if (i.eq.-1) i0=-2 
      if (i.eq.1) i0=2 
      if (i.eq.2) i0=1 
      parmflavor=f(i0)/x 
      return 
!                                                                       
      END                                           
                                                                        
      function CtLhastolam(as,q,nloop,nf) 
      implicit double precision (a-h,o-z) 
      data pi / 3.141592653589793d0 / 
      xlp = nloop-1d0 
      b  = (33.0-2.0*nf)/pi/12.0 
      bp = (153.0 - 19.0*nf) / pi / 2.0 / (33.0 - 2.0*nf) * xlp 
      t  = 1.0/b/as 
!-----------------------------------------------------------            
! Solve the equation                                                    
!                                                                       
    1 xlt = log(t) 
      ot = t 
!-----------------------------------------------------------            
! Solve the equation                                                    
! Value and Derivative of alfa with respect to t                        
!                                                                       
      as0  = 1/b/t - bp*xlt/(b*t)**2 
      as1  = - 1/b/t**2 -bp/b**2*(1-2*xlt)/t**3 
      t  = (as-as0)/as1 + t 
      if(abs(ot-t)/ot.gt..00001)goto 1 
      CtLhastolam = q/exp(t/2.0) 
      return 
      END                                           
