LHAPDF/lhapdf5.3.1/Sqcdnum.f

   1 * $Log$
   2 * Revision 1.3  2005/12/02 14:50:54  whalley
   3 * Changes for new CTEQ code/AB sets
   4 *
   5 * Revision 1.2  2005/10/18 10:34:52  whalley
   6 * small changes from cdf/d0 comments - renamubg conflicting name
   7 * adding pftopdg, etc.
   8 *
   9 * Revision 1.1.1.1  2005/05/06 14:54:44  whalley
  10 * Initial CVS import of the LHAPDF code and data sets
  11 *
  12 * Revision 1.1.1.1  1996/04/01 15:02:05  mclareni
  13 * Mathlib gen
  14 *
  15 *
  16       FUNCTION DDILOG_LHA(X)
  17       implicit real*8 (a-h,o-z)
  18       DIMENSION C(0:19)
  19       PARAMETER (Z1 = 1d0, HF = Z1/2d0)
  20       PARAMETER (PI = 3.14159 26535 89793 24D0)
  21       PARAMETER (PI3 = PI**2/3, PI6 = PI**2/6, PI12 = PI**2/12)
  22
  23       DATA C( 0) / 0.42996 69356 08136 97D0/
  24       DATA C( 1) / 0.40975 98753 30771 05D0/
  25       DATA C( 2) /-0.01858 84366 50145 92D0/
  26       DATA C( 3) / 0.00145 75108 40622 68D0/
  27       DATA C( 4) /-0.00014 30418 44423 40D0/
  28       DATA C( 5) / 0.00001 58841 55418 80D0/
  29       DATA C( 6) /-0.00000 19078 49593 87D0/
  30       DATA C( 7) / 0.00000 02419 51808 54D0/
  31       DATA C( 8) /-0.00000 00319 33412 74D0/
  32       DATA C( 9) / 0.00000 00043 45450 63D0/
  33       DATA C(10) /-0.00000 00006 05784 80D0/
  34       DATA C(11) / 0.00000 00000 86120 98D0/
  35       DATA C(12) /-0.00000 00000 12443 32D0/
  36       DATA C(13) / 0.00000 00000 01822 56D0/
  37       DATA C(14) /-0.00000 00000 00270 07D0/
  38       DATA C(15) / 0.00000 00000 00040 42D0/
  39       DATA C(16) /-0.00000 00000 00006 10D0/
  40       DATA C(17) / 0.00000 00000 00000 93D0/
  41       DATA C(18) /-0.00000 00000 00000 14D0/
  42       DATA C(19) /+0.00000 00000 00000 02D0/
  43
  44       IF(X .EQ. 1d0) THEN
  45        H=PI6
  46       ELSEIF(X .EQ. -1d0) THEN
  47        H=-PI12
  48       ELSE
  49        T=-X
  50        IF(T .LE. -2d0) THEN
  51         Y=-1/(1d0+T)
  52         S=1d0
  53         A=-PI3+HF*(LOG(-T)**2-LOG(1d0+1d0/T)**2)
  54        ELSEIF(T .LT. -1d0) THEN
  55         Y=-1d0-T
  56         S=-1d0
  57         A=LOG(-T)
  58         A=-PI6+A*(A+LOG(1d0+1d0/T))
  59        ELSE IF(T .LE. -HF) THEN
  60         Y=-(1d0+T)/T
  61         S=1d0
  62         A=LOG(-T)
  63         A=-PI6+A*(-HF*A+LOG(1d0+T))
  64        ELSE IF(T .LT. 0) THEN
  65         Y=-T/(1d0+T)
  66         S=-1d0
  67         A=HF*LOG(1d0+T)**2
  68        ELSE IF(T .LE. 1d0) THEN
  69         Y=T
  70         S=1d0
  71         A=0d0
  72        ELSE
  73         Y=1d0/T
  74         S=-1d0
  75         A=PI6+HF*LOG(T)**2
  76        ENDIF
  77        H=Y+Y-1
  78        ALFA=H+H
  79        B1=0
  80        B2=0
  81        DO 1 I = 19,0,-1
  82        B0=C(I)+ALFA*B1-B2
  83        B2=B1
  84     1  B1=B0
  85        H=-(S*(B0-H*B2)+A)
  86       ENDIF
  87       DDILOG_LHA=H
  88       RETURN
  89       END
  90 *
  91 * $Id: Sqcdnum.f 209 2007-11-16 15:14:45Z whalley $
  92 *
  93 * $Log$
  94 * Revision 1.3  2005/12/02 14:50:54  whalley
  95 * Changes for new CTEQ code/AB sets
  96 *
  97 * Revision 1.2  2005/10/18 10:34:52  whalley
  98 * small changes from cdf/d0 comments - renamubg conflicting name
  99 * adding pftopdg, etc.
 100 *
 101 * Revision 1.1.1.1  2005/05/06 14:54:44  whalley
 102 * Initial CVS import of the LHAPDF code and data sets
 103 *
 104 * Revision 1.1.1.1  1996/04/01 15:02:13  mclareni
 105 * Mathlib gen
 106 *
 107 *
 108       FUNCTION DGAUSS_LHA(F,A,B,EPS)
 109
 110       implicit real*8 (a-h,o-z)
 111       CHARACTER NAME*(*)
 112       PARAMETER (NAME = 'DGAUSS_LHA')
 113       DIMENSION W(12),X(12)
 114       PARAMETER (Z1 = 1d0, HF = Z1/2d0, CST = 5d0*Z1/1000d0)
 115       DATA X
 116      1        /0.96028 98564 97536 23168 35608 68569 47D0,
 117      2         0.79666 64774 13626 73959 15539 36475 83D0,
 118      3         0.52553 24099 16328 98581 77390 49189 25D0,
 119      4         0.18343 46424 95649 80493 94761 42360 18D0,
 120      5         0.98940 09349 91649 93259 61541 73450 33D0,
 121      6         0.94457 50230 73232 57607 79884 15534 61D0,
 122      7         0.86563 12023 87831 74388 04678 97712 39D0,
 123      8         0.75540 44083 55003 03389 51011 94847 44D0,
 124      9         0.61787 62444 02643 74844 66717 64048 79D0,
 125      A         0.45801 67776 57227 38634 24194 42983 58D0,
 126      B         0.28160 35507 79258 91323 04605 01460 50D0,
 127      C         0.95012 50983 76374 40185 31933 54249 58D-1/
 128
 129       DATA W
 130      1        /0.10122 85362 90376 25915 25313 54309 96D0,
 131      2         0.22238 10344 53374 47054 43559 94426 24D0,
 132      3         0.31370 66458 77887 28733 79622 01986 60D0,
 133      4         0.36268 37833 78361 98296 51504 49277 20D0,
 134      5         0.27152 45941 17540 94851 78057 24560 18D-1,
 135      6         0.62253 52393 86478 92862 84383 69943 78D-1,
 136      7         0.95158 51168 24927 84809 92510 76022 46D-1,
 137      8         0.12462 89712 55533 87205 24762 82192 02D0,
 138      9         0.14959 59888 16576 73208 15017 30547 48D0,
 139      A         0.16915 65193 95002 53818 93120 79030 36D0,
 140      B         0.18260 34150 44923 58886 67636 67969 22D0,
 141      C         0.18945 06104 55068 49628 53967 23208 28D0/
 142
 143       H=0
 144       IF(B .EQ. A) GO TO 99
 145       CONST=CST/ABS(B-A)
 146       BB=A
 147     1 AA=BB
 148       BB=B
 149     2 C1=HF*(BB+AA)
 150       C2=HF*(BB-AA)
 151       S8=0
 152       DO 3 I = 1,4
 153       U=C2*X(I)
 154     3 S8=S8+W(I)*(F(C1+U)+F(C1-U))
 155       S16=0
 156       DO 4 I = 5,12
 157       U=C2*X(I)
 158     4 S16=S16+W(I)*(F(C1+U)+F(C1-U))
 159       S16=C2*S16
 160       IF(ABS(S16-C2*S8) .LE. EPS*(1+ABS(S16))) THEN
 161        H=H+S16
 162        IF(BB .NE. B) GO TO 1
 163       ELSE
 164        BB=C1
 165        IF(1+CONST*ABS(C2) .NE. 1) GO TO 2
 166        H=0
 167        write(*,*) NAME,'D103.1','TOO HIGH ACCURACY REQUIRED'
 168        GO TO 99
 169       END IF
 170    99 DGAUSS_LHA=H
 171       RETURN
 172       END
 173
 174       SUBROUTINE VZERO_LHA (A,N)
 175 C
 176 C CERN PROGLIB# F121    VZERO           .VERSION KERNFOR  4.40  940929
 177 C ORIG. 01/07/71, modif. 24/05/87 to set integer zero
 178 C                 modif. 25/05/94 to depend on QINTZERO
 179 C
 180       DIMENSION A(*)
 181       IF (N.LE.0)  RETURN
 182       DO 9 I= 1,N
 183     9 A(I)= 0d0
 184       RETURN
 185       END
 186
 187 *
 188 * $Id: Sqcdnum.f 209 2007-11-16 15:14:45Z whalley $
 189 *
 190 * $Log$
 191 * Revision 1.3  2005/12/02 14:50:54  whalley
 192 * Changes for new CTEQ code/AB sets
 193 *
 194 * Revision 1.2  2005/10/18 10:34:52  whalley
 195 * small changes from cdf/d0 comments - renamubg conflicting name
 196 * adding pftopdg, etc.
 197 *
 198 * Revision 1.1.1.1  2005/05/06 14:54:44  whalley
 199 * Initial CVS import of the LHAPDF code and data sets
 200 *
 201 * Revision 1.1.1.1  1996/02/15 17:49:49  mclareni
 202 * Kernlib
 203 *
 204 *
 205       FUNCTION LENOCC_LHA (CHV)
 206 C
 207 C CERN PROGLIB# M507    LENOCC          .VERSION KERNFOR  4.21  890323
 208 C ORIG. March 85, A.Petrilli, re-write 21/02/89, JZ
 209 C
 210 C-    Find last non-blank character in CHV
 211
 212       CHARACTER    CHV*(*)
 213
 214       N = LEN(CHV)
 215
 216       DO 17  JJ= N,1,-1
 217       IF (CHV(JJ:JJ).NE.' ') GO TO 99
 218    17 CONTINUE
 219       JJ = 0
 220
 221    99 LENOCC_LHA = JJ
 222       RETURN
 223       END
 224 *
 225 * $Id: Sqcdnum.f 209 2007-11-16 15:14:45Z whalley $
 226 *
 227 * $Log$
 228 * Revision 1.3  2005/12/02 14:50:54  whalley
 229 * Changes for new CTEQ code/AB sets
 230 *
 231 * Revision 1.2  2005/10/18 10:34:52  whalley
 232 * small changes from cdf/d0 comments - renamubg conflicting name
 233 * adding pftopdg, etc.
 234 *
 235 * Revision 1.1.1.1  2005/05/06 14:54:44  whalley
 236 * Initial CVS import of the LHAPDF code and data sets
 237 *
 238 * Revision 1.1.1.1  1996/02/15 17:49:43  mclareni
 239 * Kernlib
 240 *
 241 *
 242       SUBROUTINE CLTOU_LHA (CHV)
 243 C
 244 C CERN PROGLIB# M432    CLTOU           .VERSION KERNFOR  4.21  890323
 245 C ORIG. 11/02/86 A. PETRILLI
 246 C NEW    9/02/89 JZ, for speed
 247 C
 248 C-    Convert character string CHV from lower to upper case.
 249
 250       CHARACTER    CHV*(*)
 251       DO 19  JJ=1,LEN(CHV)
 252           J = ICHAR(CHV(JJ:JJ))
 253           IF (J.LT.97)       GO TO 19
 254           IF (J.GE.123)      GO TO 19
 255           CHV(JJ:JJ) = CHAR(J-32)
 256    19 CONTINUE
 257       END
 258 *
 259       SUBROUTINE TIMEX_LHA (T)
 260 C
 261 C CERN PROGLIB# Z007    TIMEX   DUMMY   .VERSION KERNFOR  4.05  821202
 262 C
 263 C-    DUMMY FOR NON-ESSENTIAL ROUTINE STILL MISSING ON YOUR MACHINE
 264
 265       T = 9.
 266       RETURN
 267       END
 268 *
 269 * $Id: Sqcdnum.f 209 2007-11-16 15:14:45Z whalley $
 270 *
 271 * $Log$
 272 * Revision 1.3  2005/12/02 14:50:54  whalley
 273 * Changes for new CTEQ code/AB sets
 274 *
 275 * Revision 1.2  2005/10/18 10:34:52  whalley
 276 * small changes from cdf/d0 comments - renamubg conflicting name
 277 * adding pftopdg, etc.
 278 *
 279 * Revision 1.1.1.1  2005/05/06 14:54:44  whalley
 280 * Initial CVS import of the LHAPDF code and data sets
 281 *
 282 * Revision 1.1.1.1  1996/02/15 17:49:44  mclareni
 283 * Kernlib
 284 *
 285 *
 286       SUBROUTINE FLPSOR_LHA(A,N)
 287 C
 288 C CERN PROGLIB# M103    FLPSOR          .VERSION KERNFOR  3.15  820113
 289 C ORIG. 29/04/78
 290 C
 291 C   SORT THE ONE-DIMENSIONAL FLOATING POINT ARRAY A(1),...,A(N) BY
 292 C   INCREASING VALUES
 293 C
 294 C-    PROGRAM  M103  TAKEN FROM CERN PROGRAM LIBRARY,  29-APR-78
 295 C
 296       DIMENSION A(N)
 297       COMMON /SLATE/ LT(20),RT(20)
 298       INTEGER R,RT
 299 C
 300       LEVEL=1
 301       LT(1)=1
 302       RT(1)=N
 303    10 L=LT(LEVEL)
 304       R=RT(LEVEL)
 305       LEVEL=LEVEL-1
 306    20 IF(R.GT.L) GO TO 200
 307       IF(LEVEL) 50,50,10
 308 C
 309 C   SUBDIVIDE THE INTERVAL L,R
 310 C     L : LOWER LIMIT OF THE INTERVAL (INPUT)
 311 C     R : UPPER LIMIT OF THE INTERVAL (INPUT)
 312 C     J : UPPER LIMIT OF LOWER SUB-INTERVAL (OUTPUT)
 313 C     I : LOWER LIMIT OF UPPER SUB-INTERVAL (OUTPUT)
 314 C
 315   200 I=L
 316       J=R
 317       M=(L+R)/2
 318       X=A(M)
 319   220 IF(A(I).GE.X) GO TO 230
 320       I=I+1
 321       GO TO 220
 322   230 IF(A(J).LE.X) GO TO 231
 323       J=J-1
 324       GO TO 230
 325 C
 326   231 IF(I.GT.J) GO TO 232
 327       W=A(I)
 328       A(I)=A(J)
 329       A(J)=W
 330       I=I+1
 331       J=J-1
 332       IF(I.LE.J) GO TO 220
 333 C
 334   232 LEVEL=LEVEL+1
 335       IF((R-I).GE.(J-L)) GO TO 30
 336       LT(LEVEL)=L
 337       RT(LEVEL)=J
 338       L=I
 339       GO TO 20
 340    30 LT(LEVEL)=I
 341       RT(LEVEL)=R
 342       R=J
 343       GO TO 20
 344    50 RETURN
 345       END
 346
 347       SUBROUTINE DATIMH_LHA (ND,NT)
 348 C
 349 C CERN PROGLIB# Z007    DATIMH  DUMMY   .VERSION KERNFOR  4.03  821008
 350 C
 351 C-    DUMMY FOR NON-ESSENTIAL ROUTINE STILL MISSING ON YOUR MACHINE
 352
 353       DIMENSION ND(9), NT(9)
 354 *      DIMENSION M(8)
 355
 356       do i=1,9
 357          ND(i)=0
 358          NT(i)=0
 359       enddo
 360 *      CALL UBLOW (8H29/09/79,M,8)
 361 *      CALL UBUNCH           (M,ND,8)
 362 *      CALL UBLOW (8H12.00.00,M,8)
 363 *      CALL UBUNCH           (M,NT,8)
 364       RETURN
 365       END
 366 c**************************************************************************
 367 c these next added from CERNLIB to allow some photon and pion sets to work
 368 c nothing to do with QCDNUM mrw 9/12/2004
 369 c*************************************************************************8
 370 c*
 371 * $Id: Sqcdnum.f 209 2007-11-16 15:14:45Z whalley $
 372 *
 373 * $Log$
 374 * Revision 1.3  2005/12/02 14:50:54  whalley
 375 * Changes for new CTEQ code/AB sets
 376 *
 377 * Revision 1.2  2005/10/18 10:34:52  whalley
 378 * small changes from cdf/d0 comments - renamubg conflicting name
 379 * adding pftopdg, etc.
 380 *
 381 * Revision 1.1.1.1  2005/05/06 14:54:44  whalley
 382 * Initial CVS import of the LHAPDF code and data sets
 383 *
 384 * Revision 1.1.1.1  1996/02/15 17:48:17  mclareni
 385 * Kernlib
 386 *
 387 *
 388       DOUBLE PRECISION FUNCTION DGAMMA_LHA(X)
 389       LOGICAL MFLAG,RFLAG
 390       REAL SX
 391       DOUBLE PRECISION X,U,F,ZERO,ONE,THREE,FOUR,PI
 392       DOUBLE PRECISION C(0:24),H,ALFA,B0,B1,B2
 393       DATA ZERO /0.0D0/, ONE /1.0D0/, THREE /3.0D0/, FOUR /4.0D0/
 394 c#if defined(CERNLIB_NUMHIPRE)
 395 c      DATA NC /24/
 396 c      DATA PI    /3.14159 26535 89793 23846 26433 83D0/
 397 c      DATA C( 0) /3.65738 77250 83382 43849 88068 39D0/
 398 c      DATA C( 1) /1.95754 34566 61268 26928 33742 26D0/
 399 c      DATA C( 2) / .33829 71138 26160 38915 58510 73D0/
 400 c      DATA C( 3) / .04208 95127 65575 49198 51083 97D0/
 401 c      DATA C( 4) / .00428 76504 82129 08770 04289 08D0/
 402 c      DATA C( 5) / .00036 52121 69294 61767 02198 22D0/
 403 c      DATA C( 6) / .00002 74006 42226 42200 27170 66D0/
 404 c      DATA C( 7) / .00000 18124 02333 65124 44603 05D0/
 405 c      DATA C( 8) / .00000 01096 57758 65997 06993 06D0/
 406 c      DATA C( 9) / .00000 00059 87184 04552 00046 95D0/
 407 c      DATA C(10) / .00000 00003 07690 80535 24777 71D0/
 408 c      DATA C(11) / .00000 00000 14317 93029 61915 76D0/
 409 c      DATA C(12) / .00000 00000 00651 08773 34803 70D0/
 410 c      DATA C(13) / .00000 00000 00025 95849 89822 28D0/
 411 c      DATA C(14) / .00000 00000 00001 10789 38922 59D0/
 412 c      DATA C(15) / .00000 00000 00000 03547 43620 17D0/
 413 c      DATA C(16) / .00000 00000 00000 00168 86075 04D0/
 414 c      DATA C(17) / .00000 00000 00000 00002 73543 58D0/
 415 c      DATA C(18) / .00000 00000 00000 00000 30297 74D0/
 416 c      DATA C(19) /-.00000 00000 00000 00000 00571 22D0/
 417 c      DATA C(20) / .00000 00000 00000 00000 00090 77D0/
 418 c      DATA C(21) /-.00000 00000 00000 00000 00005 05D0/
 419 c      DATA C(22) / .00000 00000 00000 00000 00000 41D0/
 420 c      DATA C(23) /-.00000 00000 00000 00000 00000 03D0/
 421 c      DATA C(24) / .00000 00000 00000 00000 00000 01D0/
 422 c#endif
 423 c#if defined(CERNLIB_NUMLOPRE)
 424       DATA NC /15/
 425       DATA PI    /3.14159 26535 89793 24D0/
 426       DATA C( 0) /3.65738 77250 83382 44D0/
 427       DATA C( 1) /1.95754 34566 61268 27D0/
 428       DATA C( 2) / .33829 71138 26160 39D0/
 429       DATA C( 3) / .04208 95127 65575 49D0/
 430       DATA C( 4) / .00428 76504 82129 09D0/
 431       DATA C( 5) / .00036 52121 69294 62D0/
 432       DATA C( 6) / .00002 74006 42226 42D0/
 433       DATA C( 7) / .00000 18124 02333 65D0/
 434       DATA C( 8) / .00000 01096 57758 66D0/
 435       DATA C( 9) / .00000 00059 87184 05D0/
 436       DATA C(10) / .00000 00003 07690 81D0/
 437       DATA C(11) / .00000 00000 14317 93D0/
 438       DATA C(12) / .00000 00000 00651 09D0/
 439       DATA C(13) / .00000 00000 00025 96D0/
 440       DATA C(14) / .00000 00000 00001 11D0/
 441       DATA C(15) / .00000 00000 00000 04D0/
 442 c#endif
 443       U=X
 444       IF(X .LE. ZERO) THEN
 445        IF(X .EQ. INT(X)) THEN
 446         CALL KERMTR_LHA('C305.1',LGFILE,MFLAG,RFLAG)
 447         IF(MFLAG) THEN
 448          SX=X
 449          IF(LGFILE .EQ. 0) THEN
 450           WRITE(*,100) SX
 451          ELSE
 452           WRITE(LGFILE,100) SX
 453          END IF
 454         END IF
 455         IF(.NOT.RFLAG) CALL ABEND_LHA
 456         DGAMMA_LHA=ZERO
 457         RETURN
 458        ELSE
 459         U=ONE-U
 460        END IF
 461       END IF
 462       F=ONE
 463       IF(U .LT. THREE) THEN
 464        DO 1 I = 1,INT(FOUR-U)
 465        F=F/U
 466     1  U=U+ONE
 467       ELSE
 468        DO 2 I = 1,INT(U-THREE)
 469        U=U-ONE
 470     2  F=F*U
 471       END IF
 472       U=U-THREE
 473       H=U+U-ONE
 474       ALFA=H+H
 475       B1=ZERO
 476       B2=ZERO
 477       DO 3 I = NC,0,-1
 478       B0=C(I)+ALFA*B1-B2
 479       B2=B1
 480     3 B1=B0
 481       U=F*(B0-H*B2)
 482       IF(X .LT. ZERO) U=PI/(SIN(PI*X)*U)
 483       DGAMMA_LHA=U
 484       RETURN
 485   100 FORMAT(1X,'DGAMMA ... ARGUMENT IS NON-POSITIVE INTEGER = ',E15.1)
 486       END
 487 c========================================================================
 488           SUBROUTINE KERSET_LHA(ERCODE,LGFILE,LIMITM,LIMITR)
 489           PARAMETER(KOUNTE  =  28)
 490           CHARACTER*6         ERCODE,   CODE(KOUNTE)
 491           LOGICAL             MFLAG,    RFLAG
 492           INTEGER             KNTM(KOUNTE),       KNTR(KOUNTE)
 493           DATA      LOGF      /  0  /
 494           DATA      CODE(1), KNTM(1), KNTR(1)  / 'C204.1', 100, 100 /
 495           DATA      CODE(2), KNTM(2), KNTR(2)  / 'C204.2', 100, 100 /
 496           DATA      CODE(3), KNTM(3), KNTR(3)  / 'C204.3', 100, 100 /
 497           DATA      CODE(4), KNTM(4), KNTR(4)  / 'C205.1', 100, 100 /
 498           DATA      CODE(5), KNTM(5), KNTR(5)  / 'C205.2', 100, 100 /
 499           DATA      CODE(6), KNTM(6), KNTR(6)  / 'C205.3', 100, 100 /
 500           DATA      CODE(7), KNTM(7), KNTR(7)  / 'C305.1', 100, 100 /
 501           DATA      CODE(8), KNTM(8), KNTR(8)  / 'C308.1', 100, 100 /
 502           DATA      CODE(9), KNTM(9), KNTR(9)  / 'C312.1', 100, 100 /
 503           DATA      CODE(10),KNTM(10),KNTR(10) / 'C313.1', 100, 100 /
 504           DATA      CODE(11),KNTM(11),KNTR(11) / 'C336.1', 100, 100 /
 505           DATA      CODE(12),KNTM(12),KNTR(12) / 'C337.1', 100, 100 /
 506           DATA      CODE(13),KNTM(13),KNTR(13) / 'C341.1', 100, 100 /
 507           DATA      CODE(14),KNTM(14),KNTR(14) / 'D103.1', 100, 100 /
 508           DATA      CODE(15),KNTM(15),KNTR(15) / 'D106.1', 100, 100 /
 509           DATA      CODE(16),KNTM(16),KNTR(16) / 'D209.1', 100, 100 /
 510           DATA      CODE(17),KNTM(17),KNTR(17) / 'D509.1', 100, 100 /
 511           DATA      CODE(18),KNTM(18),KNTR(18) / 'E100.1', 100, 100 /
 512           DATA      CODE(19),KNTM(19),KNTR(19) / 'E104.1', 100, 100 /
 513           DATA      CODE(20),KNTM(20),KNTR(20) / 'E105.1', 100, 100 /
 514           DATA      CODE(21),KNTM(21),KNTR(21) / 'E208.1', 100, 100 /
 515           DATA      CODE(22),KNTM(22),KNTR(22) / 'E208.2', 100, 100 /
 516           DATA      CODE(23),KNTM(23),KNTR(23) / 'F010.1', 100,   0 /
 517           DATA      CODE(24),KNTM(24),KNTR(24) / 'F011.1', 100,   0 /
 518           DATA      CODE(25),KNTM(25),KNTR(25) / 'F012.1', 100,   0 /
 519           DATA      CODE(26),KNTM(26),KNTR(26) / 'F406.1', 100,   0 /
 520           DATA      CODE(27),KNTM(27),KNTR(27) / 'G100.1', 100, 100 /
 521           DATA      CODE(28),KNTM(28),KNTR(28) / 'G100.2', 100, 100 /
 522           LOGF  =  LGFILE
 523           IF(ERCODE .EQ. ' ')  THEN
 524              L  =  0
 525           ELSE
 526              DO 10  L = 1, 6
 527                 IF(ERCODE(1:L) .EQ. ERCODE)  GOTO 12
 528   10            CONTINUE
 529   12         CONTINUE
 530           ENDIF
 531           DO 14     I  =  1, KOUNTE
 532              IF(L .EQ. 0)  GOTO 13
 533              IF(CODE(I)(1:L) .NE. ERCODE(1:L))  GOTO 14
 534   13         KNTM(I)  =  LIMITM
 535              KNTR(I)  =  LIMITR
 536   14         CONTINUE
 537           RETURN
 538           ENTRY KERMTR_LHA(ERCODE,LOG,MFLAG,RFLAG)
 539           LOG  =  LOGF
 540           DO 20     I  =  1, KOUNTE
 541              IF(ERCODE .EQ. CODE(I))  GOTO 21
 542   20         CONTINUE
 543           WRITE(*,1000)  ERCODE
 544           CALL ABEND_LHA
 545           RETURN
 546   21      RFLAG  =  KNTR(I) .GE. 1
 547           IF(RFLAG  .AND.  (KNTR(I) .LT. 100))  KNTR(I)  =  KNTR(I) - 1
 548           MFLAG  =  KNTM(I) .GE. 1
 549           IF(MFLAG  .AND.  (KNTM(I) .LT. 100))  KNTM(I)  =  KNTM(I) - 1
 550           IF(.NOT. RFLAG)  THEN
 551              IF(LOGF .LT. 1)  THEN
 552                 WRITE(*,1001)  CODE(I)
 553              ELSE
 554                 WRITE(LOGF,1001)  CODE(I)
 555              ENDIF
 556           ENDIF
 557           IF(MFLAG .AND. RFLAG)  THEN
 558              IF(LOGF .LT. 1)  THEN
 559                 WRITE(*,1002)  CODE(I)
 560              ELSE
 561                 WRITE(LOGF,1002)  CODE(I)
 562              ENDIF
 563           ENDIF
 564           RETURN
 565 1000      FORMAT(' KERNLIB LIBRARY ERROR. ' /
 566      +           ' ERROR CODE ',A6,' NOT RECOGNIZED BY KERMTR',
 567      +           ' ERROR MONITOR. RUN ABORTED.')
 568 1001      FORMAT(/' ***** RUN TERMINATED BY CERN LIBRARY ERROR ',
 569      +           'CONDITION ',A6)
 570 1002      FORMAT(/' ***** CERN LIBRARY ERROR CONDITION ',A6)
 571           END
 572 c========================================================================
 573       SUBROUTINE ABEND_LHA
 574 C
 575 C CERN PROGLIB# Z035    ABEND           .VERSION KERNVAX  1.10  811126
 576
 577       STOP '*** ABEND ***'
 578       END