5 * Revision 1.9 2000/07/25 14:53:05 mclareni
6 * Version 7.51 from author
9 *#include "sys/CERNLIB_machine.h"
10 #include "isajet/pilot.h"
11 #if defined(CERNLIB_NOCERN)
12 SUBROUTINE TQL2(NM,N,D,E,Z,IERR)
13 C FROM CERN PROGRAM LIBRARY
14 #if defined(CERNLIB_IMPNONE)
17 INTEGER I,J,K,L,M,N,II,NM,MML,IERR
18 REAL D(N),E(N),Z(NM,N)
19 REAL B,C,F,G,H,P,R,S,MACHEP
21 #if defined(CERNLIB_CDC)
25 IF (N .EQ. 1) GO TO 1001
33 H = MACHEP * (ABS(D(L)) + ABS(E(L)))
36 IF (ABS(E(M)) .LE. B) GO TO 120
38 120 IF (M .EQ. L) GO TO 220
39 130 IF (J .EQ. 30) GO TO 1000
41 P = (D(L+1) - D(L)) / (2.0 * E(L))
43 H = D(L) - E(L) / (P + SIGN(R,P))
55 IF (ABS(P) .LT. ABS(E(I))) GO TO 150
67 160 P = C * D(I) - S * G
68 D(I+1) = H + S * (C * G + S * D(I))
71 Z(K,I+1) = S * Z(K,I) + C * H
72 Z(K,I) = C * Z(K,I) - S * H
77 IF (ABS(E(L)) .GT. B) GO TO 130
85 IF (D(J) .GE. P) GO TO 260
89 IF (K .EQ. I) GO TO 300