! -*- F90 -*-


! $Log$                                                                 
! Revision 1.3  2005/12/02 14:50:54  whalley                            
! Changes for new CTEQ code/AB sets                                     
!                                                                       
! Revision 1.2  2005/10/18 10:34:52  whalley                            
! small changes from cdf/d0 comments - renamubg conflicting name        
! adding pftopdg, etc.                                                  
!                                                                       
! Revision 1.1.1.1  2005/05/06 14:54:44  whalley                        
! Initial CVS import of the LHAPDF code and data sets                   
!                                                                       
! Revision 1.1.1.1  1996/04/01 15:02:05  mclareni                       
! Mathlib gen                                                           
!                                                                       
!                                                                       
      FUNCTION DDILOG_LHA(X) 
      implicit real*8 (a-h,o-z) 
      DIMENSION C(0:19) 
      PARAMETER (Z1 = 1d0, HF = Z1/2d0) 
      PARAMETER (PI = 3.14159265358979324D0) 
      PARAMETER (PI3 = PI**2/3, PI6 = PI**2/6, PI12 = PI**2/12) 
                                                                        
      DATA C( 0) / 0.42996693560813697D0/ 
      DATA C( 1) / 0.40975987533077105D0/ 
      DATA C( 2) /-0.01858843665014592D0/ 
      DATA C( 3) / 0.00145751084062268D0/ 
      DATA C( 4) /-0.00014304184442340D0/ 
      DATA C( 5) / 0.00001588415541880D0/ 
      DATA C( 6) /-0.00000190784959387D0/ 
      DATA C( 7) / 0.00000024195180854D0/ 
      DATA C( 8) /-0.00000003193341274D0/ 
      DATA C( 9) / 0.00000000434545063D0/ 
      DATA C(10) /-0.00000000060578480D0/ 
      DATA C(11) / 0.00000000008612098D0/ 
      DATA C(12) /-0.00000000001244332D0/ 
      DATA C(13) / 0.00000000000182256D0/ 
      DATA C(14) /-0.00000000000027007D0/ 
      DATA C(15) / 0.00000000000004042D0/ 
      DATA C(16) /-0.00000000000000610D0/ 
      DATA C(17) / 0.00000000000000093D0/ 
      DATA C(18) /-0.00000000000000014D0/ 
      DATA C(19) /+0.00000000000000002D0/ 
                                                                        
      IF(X .EQ. 1d0) THEN 
       H=PI6 
      ELSEIF(X .EQ. -1d0) THEN 
       H=-PI12 
      ELSE 
       T=-X 
       IF(T .LE. -2d0) THEN 
        Y=-1/(1d0+T) 
        S=1d0 
        A=-PI3+HF*(LOG(-T)**2-LOG(1d0+1d0/T)**2) 
       ELSEIF(T .LT. -1d0) THEN 
        Y=-1d0-T 
        S=-1d0 
        A=LOG(-T) 
        A=-PI6+A*(A+LOG(1d0+1d0/T)) 
       ELSE IF(T .LE. -HF) THEN 
        Y=-(1d0+T)/T 
        S=1d0 
        A=LOG(-T) 
        A=-PI6+A*(-HF*A+LOG(1d0+T)) 
       ELSE IF(T .LT. 0) THEN 
        Y=-T/(1d0+T) 
        S=-1d0 
        A=HF*LOG(1d0+T)**2 
       ELSE IF(T .LE. 1d0) THEN 
        Y=T 
        S=1d0 
        A=0d0 
       ELSE 
        Y=1d0/T 
        S=-1d0 
        A=PI6+HF*LOG(T)**2 
       ENDIF 
       H=Y+Y-1 
       ALFA=H+H 
       B1=0 
       B2=0 
       DO 1 I = 19,0,-1 
       B0=C(I)+ALFA*B1-B2 
       B2=B1 
    1  B1=B0 
       H=-(S*(B0-H*B2)+A) 
      ENDIF 
      DDILOG_LHA=H 
      RETURN 
      END                                           
!                                                                       
! $Id: Sqcdnum.f 443 2009-02-10 15:39:06Z buckley $                     
!                                                                       
! $Log$                                                                 
! Revision 1.3  2005/12/02 14:50:54  whalley                            
! Changes for new CTEQ code/AB sets                                     
!                                                                       
! Revision 1.2  2005/10/18 10:34:52  whalley                            
! small changes from cdf/d0 comments - renamubg conflicting name        
! adding pftopdg, etc.                                                  
!                                                                       
! Revision 1.1.1.1  2005/05/06 14:54:44  whalley                        
! Initial CVS import of the LHAPDF code and data sets                   
!                                                                       
! Revision 1.1.1.1  1996/04/01 15:02:13  mclareni                       
! Mathlib gen                                                           
!                                                                       
!                                                                       
      FUNCTION DGAUSS_LHA(F,A,B,EPS) 
                                                                        
      implicit real*8 (a-h,o-z) 
      CHARACTER NAME*(*) 
      PARAMETER (NAME = 'DGAUSS_LHA') 
      DIMENSION W(12),X(12) 
      PARAMETER (Z1 = 1d0, HF = Z1/2d0, CST = 5d0*Z1/1000d0) 
      DATA X                                                            &
     &        /0.96028985649753623168356086856947D0,              &
     &         0.79666647741362673959155393647583D0,              &
     &         0.52553240991632898581773904918925D0,              &
     &         0.18343464249564980493947614236018D0,              &
     &         0.98940093499164993259615417345033D0,              &
     &         0.94457502307323257607798841553461D0,              &
     &         0.86563120238783174388046789771239D0,              &
     &         0.75540440835500303389510119484744D0,              &
     &         0.61787624440264374844667176404879D0,              &
     &         0.45801677765722738634241944298358D0,              &
     &         0.28160355077925891323046050146050D0,              &
     &         0.95012509837637440185319335424958D-1/             
                                                                  
      DATA W                                                      &
     &        /0.10122853629037625915253135430996D0,              &
     &         0.22238103445337447054435599442624D0,              &
     &         0.31370664587788728733796220198660D0,              &
     &         0.36268378337836198296515044927720D0,              &
     &         0.27152459411754094851780572456018D-1,             &
     &         0.62253523938647892862843836994378D-1,             &
     &         0.95158511682492784809925107602246D-1,             &
     &         0.12462897125553387205247628219202D0,              &
     &         0.14959598881657673208150173054748D0,              &
     &         0.16915651939500253818931207903036D0,              &
     &         0.18260341504492358886676366796922D0,              &
     &         0.18945061045506849628539672320828D0/              
                                                                        
      H=0 
      IF(B .EQ. A) GOTO 99 
      CONST=CST/ABS(B-A) 
      BB=A 
    1 AA=BB 
      BB=B 
    2 C1=HF*(BB+AA) 
      C2=HF*(BB-AA) 
      S8=0 
      DO 3 I = 1,4 
      U=C2*X(I) 
    3 S8=S8+W(I)*(F(C1+U)+F(C1-U)) 
      S16=0 
      DO 4 I = 5,12 
      U=C2*X(I) 
    4 S16=S16+W(I)*(F(C1+U)+F(C1-U)) 
      S16=C2*S16 
      IF(ABS(S16-C2*S8) .LE. EPS*(1+ABS(S16))) THEN 
       H=H+S16 
       IF(BB .NE. B) GOTO 1 
      ELSE 
       BB=C1 
       IF(1+CONST*ABS(C2) .NE. 1) GOTO 2 
       H=0 
       write(*,*) NAME,'D103.1','TOO HIGH ACCURACY REQUIRED' 
       GOTO 99 
      END IF 
   99 DGAUSS_LHA=H 
      RETURN 
      END                                           
                                                                        
      SUBROUTINE VZERO_LHA (A,N) 
!                                                                       
! CERN PROGLIB# F121    VZERO           .VERSION KERNFOR  4.40  940929  
! ORIG. 01/07/71, modif. 24/05/87 to set integer zero                   
!                 modif. 25/05/94 to depend on QINTZERO                 
!                                                                       
      DIMENSION A(*) 
      IF (N.LE.0)  RETURN 
      DO 9 I= 1,N 
    9 A(I)= 0d0 
      RETURN 
      END                                           
                                                                        
!                                                                       
! $Id: Sqcdnum.f 443 2009-02-10 15:39:06Z buckley $                     
!                                                                       
! $Log$                                                                 
! Revision 1.3  2005/12/02 14:50:54  whalley                            
! Changes for new CTEQ code/AB sets                                     
!                                                                       
! Revision 1.2  2005/10/18 10:34:52  whalley                            
! small changes from cdf/d0 comments - renamubg conflicting name        
! adding pftopdg, etc.                                                  
!                                                                       
! Revision 1.1.1.1  2005/05/06 14:54:44  whalley                        
! Initial CVS import of the LHAPDF code and data sets                   
!                                                                       
! Revision 1.1.1.1  1996/02/15 17:49:49  mclareni                       
! Kernlib                                                               
!                                                                       
!                                                                       
      FUNCTION LENOCC_LHA (CHV) 
!                                                                       
! CERN PROGLIB# M507    LENOCC          .VERSION KERNFOR  4.21  890323  
! ORIG. March 85, A.Petrilli, re-write 21/02/89, JZ                     
!                                                                       
!-    Find last non-blank character in CHV                              
                                                                        
      CHARACTER    CHV*(*) 
                                                                        
      N = LEN(CHV) 
                                                                        
      DO 17  JJ= N,1,-1 
      IF (CHV(JJ:JJ).NE.' ') GOTO 99 
   17 END DO 
      JJ = 0 
                                                                        
   99 LENOCC_LHA = JJ 
      RETURN 
      END                                           
!                                                                       
! $Id: Sqcdnum.f 443 2009-02-10 15:39:06Z buckley $                     
!                                                                       
! $Log$                                                                 
! Revision 1.3  2005/12/02 14:50:54  whalley                            
! Changes for new CTEQ code/AB sets                                     
!                                                                       
! Revision 1.2  2005/10/18 10:34:52  whalley                            
! small changes from cdf/d0 comments - renamubg conflicting name        
! adding pftopdg, etc.                                                  
!                                                                       
! Revision 1.1.1.1  2005/05/06 14:54:44  whalley                        
! Initial CVS import of the LHAPDF code and data sets                   
!                                                                       
! Revision 1.1.1.1  1996/02/15 17:49:43  mclareni                       
! Kernlib                                                               
!                                                                       
!                                                                       
      SUBROUTINE CLTOU_LHA (CHV) 
!                                                                       
! CERN PROGLIB# M432    CLTOU           .VERSION KERNFOR  4.21  890323  
! ORIG. 11/02/86 A. PETRILLI                                            
! NEW    9/02/89 JZ, for speed                                          
!                                                                       
!-    Convert character string CHV from lower to upper case.            
                                                                        
      CHARACTER    CHV*(*) 
      DO 19  JJ=1,LEN(CHV) 
          J = ICHAR(CHV(JJ:JJ)) 
          IF (J.LT.97) EXIT
          IF (J.GE.123) EXIT
          CHV(JJ:JJ) = CHAR(J-32) 
   19 END DO 
      END                                           
!                                                                       
      SUBROUTINE TIMEX_LHA (T) 
!                                                                       
! CERN PROGLIB# Z007    TIMEX   DUMMY   .VERSION KERNFOR  4.05  821202  
!                                                                       
!-    DUMMY FOR NON-ESSENTIAL ROUTINE STILL MISSING ON YOUR MACHINE     
                                                                        
      T = 9. 
      RETURN 
      END                                           
!                                                                       
! $Id: Sqcdnum.f 443 2009-02-10 15:39:06Z buckley $                     
!                                                                       
! $Log$                                                                 
! Revision 1.3  2005/12/02 14:50:54  whalley                            
! Changes for new CTEQ code/AB sets                                     
!                                                                       
! Revision 1.2  2005/10/18 10:34:52  whalley                            
! small changes from cdf/d0 comments - renamubg conflicting name        
! adding pftopdg, etc.                                                  
!                                                                       
! Revision 1.1.1.1  2005/05/06 14:54:44  whalley                        
! Initial CVS import of the LHAPDF code and data sets                   
!                                                                       
! Revision 1.1.1.1  1996/02/15 17:49:44  mclareni                       
! Kernlib                                                               
!                                                                       
!                                                                       
      SUBROUTINE FLPSOR_LHA(A,N) 
!                                                                       
! CERN PROGLIB# M103    FLPSOR          .VERSION KERNFOR  3.15  820113  
! ORIG. 29/04/78                                                        
!                                                                       
!   SORT THE ONE-DIMENSIONAL FLOATING POINT ARRAY A(1),...,A(N) BY      
!   INCREASING VALUES                                                   
!                                                                       
!-    PROGRAM  M103  TAKEN FROM CERN PROGRAM LIBRARY,  29-APR-78        
!                                                                       
      DIMENSION A(N) 
      COMMON /SLATE/ LT(20),RT(20) 
      INTEGER R,RT 
!                                                                       
      LEVEL=1 
      LT(1)=1 
      RT(1)=N 
   10 L=LT(LEVEL) 
      R=RT(LEVEL) 
      LEVEL=LEVEL-1 
   20 IF(R.GT.L) GOTO 200 
      IF(LEVEL.LE.0) THEN 
        GOTO 50 
      ELSE 
        GOTO 10 
      ENDIF 
!                                                                       
!   SUBDIVIDE THE INTERVAL L,R                                          
!     L : LOWER LIMIT OF THE INTERVAL (INPUT)                           
!     R : UPPER LIMIT OF THE INTERVAL (INPUT)                           
!     J : UPPER LIMIT OF LOWER SUB-INTERVAL (OUTPUT)                    
!     I : LOWER LIMIT OF UPPER SUB-INTERVAL (OUTPUT)                    
!                                                                       
  200 I=L 
      J=R 
      M=(L+R)/2 
      X=A(M) 
  220 IF(A(I).GE.X) GOTO 230 
      I=I+1 
      GOTO 220 
  230 IF(A(J).LE.X) GOTO 231 
      J=J-1 
      GOTO 230 
!                                                                       
  231 IF(I.GT.J) GOTO 232 
      W=A(I) 
      A(I)=A(J) 
      A(J)=W 
      I=I+1 
      J=J-1 
      IF(I.LE.J) GOTO 220 
!                                                                       
  232 LEVEL=LEVEL+1 
      IF((R-I).GE.(J-L)) GOTO 30 
      LT(LEVEL)=L 
      RT(LEVEL)=J 
      L=I 
      GOTO 20 
   30 LT(LEVEL)=I 
      RT(LEVEL)=R 
      R=J 
      GOTO 20 
   50 RETURN 
      END                                           
                                                                        
      SUBROUTINE DATIMH_LHA (ND,NT) 
!                                                                       
! CERN PROGLIB# Z007    DATIMH  DUMMY   .VERSION KERNFOR  4.03  821008  
!                                                                       
!-    DUMMY FOR NON-ESSENTIAL ROUTINE STILL MISSING ON YOUR MACHINE     
                                                                        
      DIMENSION ND(9), NT(9) 
!      DIMENSION M(8)                                                   
                                                                        
      do i=1,9 
         ND(i)=0 
         NT(i)=0 
      enddo 
!      CALL UBLOW (8H29/09/79,M,8)                                      
!      CALL UBUNCH           (M,ND,8)                                   
!      CALL UBLOW (8H12.00.00,M,8)                                      
!      CALL UBUNCH           (M,NT,8)                                   
      RETURN 
      END                                           
!***********************************************************************
! these next added from CERNLIB to allow some photon and pion sets to wo
! nothing to do with QCDNUM mrw 9/12/2004                               
!***********************************************************************
!*                                                                      
! $Id: Sqcdnum.f 443 2009-02-10 15:39:06Z buckley $                     
!                                                                       
! $Log$                                                                 
! Revision 1.3  2005/12/02 14:50:54  whalley                            
! Changes for new CTEQ code/AB sets                                     
!                                                                       
! Revision 1.2  2005/10/18 10:34:52  whalley                            
! small changes from cdf/d0 comments - renamubg conflicting name        
! adding pftopdg, etc.                                                  
!                                                                       
! Revision 1.1.1.1  2005/05/06 14:54:44  whalley                        
! Initial CVS import of the LHAPDF code and data sets                   
!                                                                       
! Revision 1.1.1.1  1996/02/15 17:48:17  mclareni                       
! Kernlib                                                               
!                                                                       
!                                                                       
      DOUBLE PRECISION FUNCTION DGAMMA_LHA(X) 
      LOGICAL MFLAG,RFLAG 
      REAL SX 
      DOUBLE PRECISION X,U,F,ZERO,ONE,THREE,FOUR,PI 
      DOUBLE PRECISION C(0:24),H,ALFA,B0,B1,B2 
      DATA ZERO /0.0D0/, ONE /1.0D0/, THREE /3.0D0/, FOUR /4.0D0/ 
!#if defined(CERNLIB_NUMHIPRE)                                          
!      DATA NC /24/                                                     
!      DATA PI    /3.14159 26535 89793 23846 26433 83D0/                
!      DATA C( 0) /3.65738 77250 83382 43849 88068 39D0/                
!      DATA C( 1) /1.95754 34566 61268 26928 33742 26D0/                
!      DATA C( 2) / .33829 71138 26160 38915 58510 73D0/                
!      DATA C( 3) / .04208 95127 65575 49198 51083 97D0/                
!      DATA C( 4) / .00428 76504 82129 08770 04289 08D0/                
!      DATA C( 5) / .00036 52121 69294 61767 02198 22D0/                
!      DATA C( 6) / .00002 74006 42226 42200 27170 66D0/                
!      DATA C( 7) / .00000 18124 02333 65124 44603 05D0/                
!      DATA C( 8) / .00000 01096 57758 65997 06993 06D0/                
!      DATA C( 9) / .00000 00059 87184 04552 00046 95D0/                
!      DATA C(10) / .00000 00003 07690 80535 24777 71D0/                
!      DATA C(11) / .00000 00000 14317 93029 61915 76D0/                
!      DATA C(12) / .00000 00000 00651 08773 34803 70D0/                
!      DATA C(13) / .00000 00000 00025 95849 89822 28D0/                
!      DATA C(14) / .00000 00000 00001 10789 38922 59D0/                
!      DATA C(15) / .00000 00000 00000 03547 43620 17D0/                
!      DATA C(16) / .00000 00000 00000 00168 86075 04D0/                
!      DATA C(17) / .00000 00000 00000 00002 73543 58D0/                
!      DATA C(18) / .00000 00000 00000 00000 30297 74D0/                
!      DATA C(19) /-.00000 00000 00000 00000 00571 22D0/                
!      DATA C(20) / .00000 00000 00000 00000 00090 77D0/                
!      DATA C(21) /-.00000 00000 00000 00000 00005 05D0/                
!      DATA C(22) / .00000 00000 00000 00000 00000 41D0/                
!      DATA C(23) /-.00000 00000 00000 00000 00000 03D0/                
!      DATA C(24) / .00000 00000 00000 00000 00000 01D0/                
!#endif                                                                 
!#if defined(CERNLIB_NUMLOPRE)                                          
      DATA NC /15/ 
      DATA PI    /3.14159265358979324D0/ 
      DATA C( 0) /3.65738772508338244D0/ 
      DATA C( 1) /1.95754345666126827D0/ 
      DATA C( 2) / .33829711382616039D0/ 
      DATA C( 3) / .04208951276557549D0/ 
      DATA C( 4) / .00428765048212909D0/ 
      DATA C( 5) / .00036521216929462D0/ 
      DATA C( 6) / .00002740064222642D0/ 
      DATA C( 7) / .00000181240233365D0/ 
      DATA C( 8) / .00000010965775866D0/ 
      DATA C( 9) / .00000000598718405D0/ 
      DATA C(10) / .00000000030769081D0/ 
      DATA C(11) / .00000000001431793D0/ 
      DATA C(12) / .00000000000065109D0/ 
      DATA C(13) / .00000000000002596D0/ 
      DATA C(14) / .00000000000000111D0/ 
      DATA C(15) / .00000000000000004D0/ 
!#endif                                                                 
      U=X 
      IF(X .LE. ZERO) THEN 
       IF(X .EQ. INT(X)) THEN 
        CALL KERMTR_LHA('C305.1',LGFILE,MFLAG,RFLAG) 
        IF(MFLAG) THEN 
         SX=X 
         IF(LGFILE .EQ. 0) THEN 
          WRITE(*,100) SX 
         ELSE 
          WRITE(LGFILE,100) SX 
         END IF 
        END IF 
        IF(.NOT.RFLAG) CALL ABEND_LHA 
        DGAMMA_LHA=ZERO 
        RETURN 
       ELSE 
        U=ONE-U 
       END IF 
      END IF 
      F=ONE 
      IF(U .LT. THREE) THEN 
       DO 1 I = 1,INT(FOUR-U) 
       F=F/U 
    1  U=U+ONE 
      ELSE 
       DO 2 I = 1,INT(U-THREE) 
       U=U-ONE 
    2  F=F*U 
      END IF 
      U=U-THREE 
      H=U+U-ONE 
      ALFA=H+H 
      B1=ZERO 
      B2=ZERO 
      DO 3 I = NC,0,-1 
      B0=C(I)+ALFA*B1-B2 
      B2=B1 
    3 B1=B0 
      U=F*(B0-H*B2) 
      IF(X .LT. ZERO) U=PI/(SIN(PI*X)*U) 
      DGAMMA_LHA=U 
      RETURN 
  100 FORMAT(1X,'DGAMMA ... ARGUMENT IS NON-POSITIVE INTEGER = ',E15.1) 
      END                                           
!=======================================================================
      SUBROUTINE KERSET_LHA(ERCODE,LGFILE,LIMITM,LIMITR) 
      PARAMETER(KOUNTE  =  28) 
      CHARACTER*6          ERCODE,    CODE(KOUNTE) 
      LOGICAL          MFLAG,    RFLAG 
      INTEGER          KNTM(KOUNTE),      KNTR(KOUNTE) 
      DATA      LOGF      /  0  / 
      DATA      CODE(1), KNTM(1), KNTR(1)  / 'C204.1', 100, 100 / 
      DATA      CODE(2), KNTM(2), KNTR(2)  / 'C204.2', 100, 100 / 
      DATA      CODE(3), KNTM(3), KNTR(3)  / 'C204.3', 100, 100 / 
      DATA      CODE(4), KNTM(4), KNTR(4)  / 'C205.1', 100, 100 / 
      DATA      CODE(5), KNTM(5), KNTR(5)  / 'C205.2', 100, 100 / 
      DATA      CODE(6), KNTM(6), KNTR(6)  / 'C205.3', 100, 100 / 
      DATA      CODE(7), KNTM(7), KNTR(7)  / 'C305.1', 100, 100 / 
      DATA      CODE(8), KNTM(8), KNTR(8)  / 'C308.1', 100, 100 / 
      DATA      CODE(9), KNTM(9), KNTR(9)  / 'C312.1', 100, 100 / 
      DATA      CODE(10),KNTM(10),KNTR(10) / 'C313.1', 100, 100 / 
      DATA      CODE(11),KNTM(11),KNTR(11) / 'C336.1', 100, 100 / 
      DATA      CODE(12),KNTM(12),KNTR(12) / 'C337.1', 100, 100 / 
      DATA      CODE(13),KNTM(13),KNTR(13) / 'C341.1', 100, 100 / 
      DATA      CODE(14),KNTM(14),KNTR(14) / 'D103.1', 100, 100 / 
      DATA      CODE(15),KNTM(15),KNTR(15) / 'D106.1', 100, 100 / 
      DATA      CODE(16),KNTM(16),KNTR(16) / 'D209.1', 100, 100 / 
      DATA      CODE(17),KNTM(17),KNTR(17) / 'D509.1', 100, 100 / 
      DATA      CODE(18),KNTM(18),KNTR(18) / 'E100.1', 100, 100 / 
      DATA      CODE(19),KNTM(19),KNTR(19) / 'E104.1', 100, 100 / 
      DATA      CODE(20),KNTM(20),KNTR(20) / 'E105.1', 100, 100 / 
      DATA      CODE(21),KNTM(21),KNTR(21) / 'E208.1', 100, 100 / 
      DATA      CODE(22),KNTM(22),KNTR(22) / 'E208.2', 100, 100 / 
      DATA      CODE(23),KNTM(23),KNTR(23) / 'F010.1', 100,   0 / 
      DATA      CODE(24),KNTM(24),KNTR(24) / 'F011.1', 100,   0 / 
      DATA      CODE(25),KNTM(25),KNTR(25) / 'F012.1', 100,   0 / 
      DATA      CODE(26),KNTM(26),KNTR(26) / 'F406.1', 100,   0 / 
      DATA      CODE(27),KNTM(27),KNTR(27) / 'G100.1', 100, 100 / 
      DATA      CODE(28),KNTM(28),KNTR(28) / 'G100.2', 100, 100 / 
      LOGF  =  LGFILE 
      IF(ERCODE .EQ. ' ')  THEN 
         L  =  0 
      ELSE 
         DO 10  L = 1, 6 
        IF(ERCODE(1:L) .EQ. ERCODE)  GOTO 12 
   10       CONTINUE 
   12        CONTINUE 
      ENDIF 
      DO 14     I  =  1, KOUNTE 
         IF(L .EQ. 0)  GOTO 13 
         IF(CODE(I)(1:L) .NE. ERCODE(1:L))  GOTO 14 
   13        KNTM(I)  =  LIMITM 
         KNTR(I)  =  LIMITR 
   14        CONTINUE 
      RETURN 
      ENTRY KERMTR_LHA(ERCODE,LOG,MFLAG,RFLAG) 
      LOG  =  LOGF 
      DO 20     I  =  1, KOUNTE 
         IF(ERCODE .EQ. CODE(I))  GOTO 21 
   20        CONTINUE 
      WRITE(*,1000)  ERCODE 
      CALL ABEND_LHA 
      RETURN 
   21     RFLAG  =  KNTR(I) .GE. 1 
      IF(RFLAG  .AND.  (KNTR(I) .LT. 100))  KNTR(I)  =  KNTR(I) - 1 
      MFLAG  =  KNTM(I) .GE. 1 
      IF(MFLAG  .AND.  (KNTM(I) .LT. 100))  KNTM(I)  =  KNTM(I) - 1 
      IF(.NOT. RFLAG)  THEN 
         IF(LOGF .LT. 1)  THEN 
        WRITE(*,1001)  CODE(I) 
         ELSE 
        WRITE(LOGF,1001)  CODE(I) 
         ENDIF 
      ENDIF 
      IF(MFLAG .AND. RFLAG)  THEN 
         IF(LOGF .LT. 1)  THEN 
        WRITE(*,1002)  CODE(I) 
         ELSE 
        WRITE(LOGF,1002)  CODE(I) 
         ENDIF 
      ENDIF 
      RETURN 
 1000     FORMAT(' KERNLIB LIBRARY ERROR. ' /                           &
     &       ' ERROR CODE ',A6,' NOT RECOGNIZED BY KERMTR',             &
     &       ' ERROR MONITOR. RUN ABORTED.')                            
 1001     FORMAT(/' ***** RUN TERMINATED BY CERN LIBRARY ERROR ',       &
     &       'CONDITION ',A6)                                           
 1002     FORMAT(/' ***** CERN LIBRARY ERROR CONDITION ',A6) 
      END                                           
!=======================================================================
      SUBROUTINE ABEND_LHA 
!                                                                       
! CERN PROGLIB# Z035    ABEND        .VERSION KERNVAX  1.10  811126     
                                                                        
      STOP '*** ABEND ***' 
      END                                           
