Change needed for G4
[u/mrichter/AliRoot.git] / LHAPDF / lhapdf5.3.1 / Sqcdnum.f
CommitLineData
4e9e3152 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)
175C
176C CERN PROGLIB# F121 VZERO .VERSION KERNFOR 4.40 940929
177C ORIG. 01/07/71, modif. 24/05/87 to set integer zero
178C modif. 25/05/94 to depend on QINTZERO
179C
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)
206C
207C CERN PROGLIB# M507 LENOCC .VERSION KERNFOR 4.21 890323
208C ORIG. March 85, A.Petrilli, re-write 21/02/89, JZ
209C
210C- 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)
243C
244C CERN PROGLIB# M432 CLTOU .VERSION KERNFOR 4.21 890323
245C ORIG. 11/02/86 A. PETRILLI
246C NEW 9/02/89 JZ, for speed
247C
248C- 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)
260C
261C CERN PROGLIB# Z007 TIMEX DUMMY .VERSION KERNFOR 4.05 821202
262C
263C- 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)
287C
288C CERN PROGLIB# M103 FLPSOR .VERSION KERNFOR 3.15 820113
289C ORIG. 29/04/78
290C
291C SORT THE ONE-DIMENSIONAL FLOATING POINT ARRAY A(1),...,A(N) BY
292C INCREASING VALUES
293C
294C- PROGRAM M103 TAKEN FROM CERN PROGRAM LIBRARY, 29-APR-78
295C
296 DIMENSION A(N)
297 COMMON /SLATE/ LT(20),RT(20)
298 INTEGER R,RT
299C
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
308C
309C SUBDIVIDE THE INTERVAL L,R
310C L : LOWER LIMIT OF THE INTERVAL (INPUT)
311C R : UPPER LIMIT OF THE INTERVAL (INPUT)
312C J : UPPER LIMIT OF LOWER SUB-INTERVAL (OUTPUT)
313C I : LOWER LIMIT OF UPPER SUB-INTERVAL (OUTPUT)
314C
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
325C
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
333C
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)
348C
349C CERN PROGLIB# Z007 DATIMH DUMMY .VERSION KERNFOR 4.03 821008
350C
351C- 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
366c**************************************************************************
367c these next added from CERNLIB to allow some photon and pion sets to work
368c nothing to do with QCDNUM mrw 9/12/2004
369c*************************************************************************8
370c*
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/
394c#if defined(CERNLIB_NUMHIPRE)
395c DATA NC /24/
396c DATA PI /3.14159 26535 89793 23846 26433 83D0/
397c DATA C( 0) /3.65738 77250 83382 43849 88068 39D0/
398c DATA C( 1) /1.95754 34566 61268 26928 33742 26D0/
399c DATA C( 2) / .33829 71138 26160 38915 58510 73D0/
400c DATA C( 3) / .04208 95127 65575 49198 51083 97D0/
401c DATA C( 4) / .00428 76504 82129 08770 04289 08D0/
402c DATA C( 5) / .00036 52121 69294 61767 02198 22D0/
403c DATA C( 6) / .00002 74006 42226 42200 27170 66D0/
404c DATA C( 7) / .00000 18124 02333 65124 44603 05D0/
405c DATA C( 8) / .00000 01096 57758 65997 06993 06D0/
406c DATA C( 9) / .00000 00059 87184 04552 00046 95D0/
407c DATA C(10) / .00000 00003 07690 80535 24777 71D0/
408c DATA C(11) / .00000 00000 14317 93029 61915 76D0/
409c DATA C(12) / .00000 00000 00651 08773 34803 70D0/
410c DATA C(13) / .00000 00000 00025 95849 89822 28D0/
411c DATA C(14) / .00000 00000 00001 10789 38922 59D0/
412c DATA C(15) / .00000 00000 00000 03547 43620 17D0/
413c DATA C(16) / .00000 00000 00000 00168 86075 04D0/
414c DATA C(17) / .00000 00000 00000 00002 73543 58D0/
415c DATA C(18) / .00000 00000 00000 00000 30297 74D0/
416c DATA C(19) /-.00000 00000 00000 00000 00571 22D0/
417c DATA C(20) / .00000 00000 00000 00000 00090 77D0/
418c DATA C(21) /-.00000 00000 00000 00000 00005 05D0/
419c DATA C(22) / .00000 00000 00000 00000 00000 41D0/
420c DATA C(23) /-.00000 00000 00000 00000 00000 03D0/
421c DATA C(24) / .00000 00000 00000 00000 00000 01D0/
422c#endif
423c#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/
442c#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
487c========================================================================
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
5651000 FORMAT(' KERNLIB LIBRARY ERROR. ' /
566 + ' ERROR CODE ',A6,' NOT RECOGNIZED BY KERMTR',
567 + ' ERROR MONITOR. RUN ABORTED.')
5681001 FORMAT(/' ***** RUN TERMINATED BY CERN LIBRARY ERROR ',
569 + 'CONDITION ',A6)
5701002 FORMAT(/' ***** CERN LIBRARY ERROR CONDITION ',A6)
571 END
572c========================================================================
573 SUBROUTINE ABEND_LHA
574C
575C CERN PROGLIB# Z035 ABEND .VERSION KERNVAX 1.10 811126
576
577 STOP '*** ABEND ***'
578 END