! -*- F90 -*-


      subroutine ABFKWPevolve(xin,qin,pdf) 
      include 'parmsetup.inc' 
      PARAMETER(NX=50) 
      PARAMETER(NQ=19) 
      real*8 xin,qin,pdf(-6:6),xval(45),qcdl4,qcdl5 
      real*8 upv,dnv,usea,dsea,str,chm,bot,top,glu 
      real*8 calcpi(8,20,25,3),calcpio(8,20,25),parpi(40,3) 
      common /ABFKWP/ CALCPI,CALCPIO,PARPI,lastmem 
      character*16 name(nmxset) 
      integer nmem(nmxset),ndef(nmxset),mmem 
      common/NAME/name,nmem,ndef,mmem 
      integer nset 
      save 
                                                                        
      iimem = imem 
      if(iimem.eq.0) iimem = 1 
      if(iimem.le.3) then 
       call ABFKWxx(iimem,xin,qin,upv,dnv,usea,dsea, str,chm,glu) 
      endif 
                                                                        
                                                                        
      pdf(-6)= 0.0d0 
      pdf(6)= 0.0d0 
      pdf(-5)= 0.0d0 
      pdf(5 )= 0.0d0 
      pdf(-4)= chm 
      pdf(4 )= chm 
      pdf(-3)= str 
      pdf(3 )= str 
      pdf(-2)= usea 
      pdf(2 )= upv+usea 
      pdf(-1)= dsea 
      pdf(1 )= dnv+dsea 
      pdf(0 )= glu 
                                                                        
      return 
!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc 
      entry ABFKWPread(nset) 
      read(1,*)nmem(nset),ndef(nset) 
!      print *,nmem,ndef                                                
      lastmem = -999 
      do j=1,3 
        read(1,*)(parpi(k,j),k=1,4) 
        read(1,*)(parpi(k,j),k=5,8) 
        read(1,*)(parpi(k,j),k=9,12) 
        read(1,*)(parpi(k,j),k=13,16) 
        read(1,*)(parpi(k,j),k=17,20) 
        read(1,*)(parpi(k,j),k=21,24) 
        read(1,*)(parpi(k,j),k=25,28) 
        read(1,*)(parpi(k,j),k=29,32) 
        read(1,*)(parpi(k,j),k=33,36) 
        read(1,*)(parpi(k,j),k=37,40) 
        do l=1,25 
          do k=1,20 
            read(1,*)(CALCPI(m,k,l,j),m=1,4) 
            read(1,*)(CALCPI(m,k,l,j),m=5,8) 
          enddo 
        enddo 
      enddo 
      return 
!                                                                       
!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc 
      entry ABFKWPalfa(alfas,qalfa) 
        call getnset(iset) 
        call GetOrderAsM(iset,iord) 
        call Getlam4M(iset,imem,qcdl4) 
        call Getlam5M(iset,imem,qcdl5) 
        call aspdflib(alfas,Qalfa,iord,qcdl5) 
      return 
!                                                                       
!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc 
      entry ABFKWPinit(Eorder,Q2fit) 
      return 
!                                                                       
!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc 
      entry ABFKWPpdf(mem) 
      imem = mem 
      return 
!                                                                       
 1000 format(5e13.5) 
      END                                           
!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc 
!                                                                       
! $Id: wrapabfkwpi.f 443 2009-02-10 15:39:06Z buckley $                 
!                                                                       
! $Log$                                                                 
! Revision 1.2  2005/10/07 15:15:05  whalley                            
! Changes to most files for V5 - multiset initializations               
!                                                                       
! Revision 1.1.1.1  2005/05/06 14:54:43  whalley                        
! Initial CVS import of the LHAPDF code and data sets                   
!                                                                       
! Revision 1.1.1.2  1996/10/30 08:27:26  cernlib                        
! Version 7.04                                                          
!                                                                       
! Revision 1.1.1.1  1996/04/12 15:28:53  plothow                        
! Version 7.01                                                          
!                                                                       
!                                                                       
      SUBROUTINE ABFKWxx(imem,DX,DQ,DUPV,DDNV,DUSEA,DDSEA,DSTR,DCHM,DGL) 
      double precision                                                  &
     &       PARPI(40,3),CALCPI(8,20,25,3),CALCPIO(8,20,25),ZEROD,      &
     &       DX,DQ,DUPV,DDNV,DUSEA,DDSEA,DSTR,DCHM,DGL                  
      REAL    X, Q, UPV, DNV, USEA, DSEA, STR, CHM, GL 
                                                                        
      common /ABFKWP/CALCPI,CALCPIO,PARPI,lastmem 
                                                                        
!      COMMON/W5051Ixx/CALCPIO                                          
      REAL   XPDF(7) 
      DATA ZEROD/0.D0/ 
!---------------------------------------------------------------------- 
       DATA ISTART/0/ 
       SAVE ISTART,OWLAM2,Q02PI 
!                                                                       
      if(imem.ne.lastmem) then 
         istart = 0 
         lastmem = imem 
      endif 
      IF (ISTART.EQ.0) THEN 
        ISTART=1 
        DO 11 K=1,25 
        DO 11 I=1,20 
        DO 11 M=1,8 
   11   CALCPIO(M,I,K) = CALCPI(M,I,K,imem) 
           OWLAM=PARPI(1,imem) 
           OWLAM2=OWLAM**2 
           Q02PI=PARPI(39,imem) 
           Q2MAX=PARPI(40,imem) 
         ENDIF 
!                                                                       
! the conventions are : q(1)=x*u, q(2)=x*d, q(3)=x*str, q(4)=x*usea,    
!                       q(5)=x*dsea, q(6)=x*charm, q(7)=x*gluon         
!                                                                       
      X = DX 
      Q = DQ 
      Q2 = Q*Q 
      IDQ2=2 
      SB=0. 
      IF((Q2-Q02PI).LE.0) THEN 
        GOTO 1 
      ELSE 
        GOTO 2 
      ENDIF 
    2 IF((IDQ2-1).LE.0) THEN 
        GOTO 1 
      ELSE 
        GOTO 3 
      ENDIF 
    3 SB= LOG( LOG( MAX(Q02PI,Q2)/OWLAM2)/ LOG(Q02PI/OWLAM2)) 
    1 CALL AURPIx(1,0,X,SB,XPDF(1)) 
      CALL AURPIx(2,0,X,SB,XPDF(2)) 
      CALL AURPIx(3,0,X,SB,XPDF(3)) 
      CALL AURPIx(4,0,X,SB,XPDF(4)) 
      CALL AURPIx(5,0,X,SB,XPDF(5)) 
      CALL AURPIx(8,0,X,SB,XPDF(6)) 
      CALL AURPIx(7,0,X,SB,XPDF(7)) 
!                                                                       
      DUPV=XPDF(1) - XPDF(4) 
      DDNV=XPDF(2) - XPDF(5) 
      DUSEA=XPDF(4) 
      DDSEA=XPDF(5) 
      DSTR=XPDF(3) 
      DCHM=XPDF(6) 
      DGL =XPDF(7) 
!                                                                       
      RETURN 
      END                                           
!==============================================================         
!                                                                       
! $Id: wrapabfkwpi.f 443 2009-02-10 15:39:06Z buckley $                 
!                                                                       
! $Log$                                                                 
! Revision 1.2  2005/10/07 15:15:05  whalley                            
! Changes to most files for V5 - multiset initializations               
!                                                                       
! Revision 1.1.1.1  2005/05/06 14:54:43  whalley                        
! Initial CVS import of the LHAPDF code and data sets                   
!                                                                       
! Revision 1.1.1.2  1996/10/30 08:27:36  cernlib                        
! Version 7.04                                                          
!                                                                       
! Revision 1.1.1.1  1996/04/12 15:29:03  plothow                        
! Version 7.01                                                          
!                                                                       
!                                                                       
!                                                                       
      SUBROUTINE AURPIx(I,NDRV,X,S,ANS) 
      double precision                                                  &
     &       CALCPI(8,20,25,3),CALCPIO(8,20,25),parpi(40,3)             
      common /ABFKWP/CALCPI,CALCPIO,parpi,lastmem 
!      COMMON/W5051I4/CALCPIO                                           
      REAL   F1(25),F2(25) 
      DATA DELTA/.10/ 
      ANS=0. 
      IF(X.GT.0.9985) RETURN 
      IF(I.EQ.3.AND.X.GT.0.95) RETURN 
      IF(I.EQ.8.AND.X.GT.0.95) RETURN 
      IS=S/DELTA+1 
      IS1=IS+1 
      DO 1 L=1,25 
      KL=L+NDRV*25 
      F1(L)=CALCPIO(I,IS,KL) 
      F2(L)=CALCPIO(I,IS1,KL) 
    1 END DO 
      A1=AUGETFV(X,F1) 
      A2=AUGETFV(X,F2) 
      S1=(IS-1)*DELTA 
      S2=S1+DELTA 
      ANS=A1*(S-S2)/(S1-S2)+A2*(S-S1)/(S2-S1) 
      RETURN 
      END                                           
!===============================================================        
!                                                                       
! $Id: wrapabfkwpi.f 443 2009-02-10 15:39:06Z buckley $                 
!                                                                       
! $Log$                                                                 
! Revision 1.2  2005/10/07 15:15:05  whalley                            
! Changes to most files for V5 - multiset initializations               
!                                                                       
! Revision 1.1.1.1  2005/05/06 14:54:43  whalley                        
! Initial CVS import of the LHAPDF code and data sets                   
!                                                                       
! Revision 1.1.1.2  1996/10/30 08:27:34  cernlib                        
! Version 7.04                                                          
!                                                                       
! Revision 1.1.1.1  1996/04/12 15:29:02  plothow                        
! Version 7.01                                                          
!                                                                       
!                                                                       
!                                                                       
      FUNCTION AUGETFV(X,FVL) 
!  LOGARITHMIC INTERPOLATOR - WATCH OUT FOR NEGATIVE                    
!  FUNCTIONS AND/OR X VALUES OUTSIDE THE RANGE 0 TO 1.                  
!  NOTE: DIMENSION OF FVL IS OVERWRITTEN BY VALUE USED                  
!  IN MAIN ROUTINE.                                                     
      DIMENSION FVL(25),XGRID(25) 
      DATA NX,XGRID/25,.001,.002,.004,.008,.016,.032,.064,.1,.15,       &
     &.2,.25,.3,.35,.4,.45,.5,.55,.6,.65,.7,.75,.8,.85,.9,.95/          
      AUGETFV=0. 
      DO 1 I=1,NX 
      IF(X.LT.XGRID(I)) GOTO 2 
    1 END DO 
    2 I=I-1 
      IF(I.EQ.0) THEN 
         I=I+1 
      ELSE IF(I.GT.23) THEN 
         I=23 
      ENDIF 
      J=I+1 
      K=J+1 
      AXI= LOG(XGRID(I)) 
      BXI= LOG(1.-XGRID(I)) 
      AXJ= LOG(XGRID(J)) 
      BXJ= LOG(1.-XGRID(J)) 
      AXK= LOG(XGRID(K)) 
      BXK= LOG(1.-XGRID(K)) 
      FI= LOG(ABS(FVL(I)) +1.E-15) 
      FJ= LOG(ABS(FVL(J)) +1.E-16) 
      FK= LOG(ABS(FVL(K)) +1.E-17) 
      DET=AXI*(BXJ-BXK)+AXJ*(BXK-BXI)+AXK*(BXI-BXJ) 
      ALOGA=(FI*(AXJ*BXK-AXK*BXJ)+FJ*(AXK*BXI-AXI*BXK)+FK*(AXI*BXJ-AXJ* &
     & BXI))/DET                                                        
      ALPHA=(FI*(BXJ-BXK)+FJ*(BXK-BXI)+FK*(BXI-BXJ))/DET 
      BETA=(FI*(AXK-AXJ)+FJ*(AXI-AXK)+FK*(AXJ-AXI))/DET 
      IF(ABS(ALPHA).GT.99..OR.ABS(BETA).GT.99..OR.ABS(ALOGA).GT.99.)    &
     &RETURN                                                            
!      IF(ALPHA.GT.50..OR.BETA.GT.50.) THEN                             
!         WRITE(6,2001) X,FVL                                           
! 2001    FORMAT(8E12.4)                                                
!         WRITE(6,2001) ALPHA,BETA,ALOGA,DET                            
!      ENDIF                                                            
      AUGETFV=EXP(ALOGA)*X**ALPHA*(1.-X)**BETA 
      RETURN 
      END                                           
