C
C ------------------------------------------------------------------
C
      SUBROUTINE SNWLA(OP, IOVECT, N, NBAND, NVAL, NFIG, NPERM, VAL,
     *   NMVEC, VEC, NBLOCK, MAXOP, MAXJ, NOP, P1, P0,
     *   RES, TAU, OTAU, T, ALP, BET, S, P2, BOUND, ATEMP, VTEMP, D,
     *   IND, SMALL, RARITZ, DELTA, EPS, IERR)
C
      INTEGER N, NBAND, NVAL, NFIG, NPERM, NMVEC, NBLOCK, MAXOP, MAXJ,
     *   NOP, IND(1), IERR
      LOGICAL RARITZ, SMALL
      REAL VAL(1), VEC(NMVEC,1), P0(N,1), P1(N,1),
     *   P2(N,1), RES(1), TAU(1), OTAU(1), T(NBAND,1),
     *   ALP(NBLOCK,1), BET(NBLOCK,1), BOUND(1), ATEMP(1),
     *   VTEMP(1), D(1), S(MAXJ,1), DELTA, EPS
      EXTERNAL OP, IOVECT
C
C SNWLA IMPLEMENTS THE LANCZOS ALGORITHM WITH SELECTIVE
C ORTHOGONALIZATION.
C
C   NBAND  NBLOCK + 1  THE BAND WIDTH OF T.
C
C   NVAL   THE NUMBER OF DESIRED EIGENVALUES.
C
C   NPERM   THE NUMBER OF PERMANENT VECTORS (THOSE EIGENVECTORS
C     INPUT BY THE USER OR THOSE EIGENVECTORS SAVED WHEN THE
C     ALGORITHM IS ITERATED).  PERMANENT VECTORS ARE ORTHOGONAL
C     TO THE CURRENT KRYLOV SUBSPACE.
C
C   NOP   THE NUMBER OF CALLS TO OP.
C
C   P0, P1, AND P2   THE CURRENT BLOCKS OF LANCZOS VECTORS.
C
C   RES   THE (APPROXIMATE) RESIDUAL NORMS OF THE PERMANENT VECTORS.
C
C   TAU AND OTAU   USED TO MONITOR THE NEED FOR ORTHOGONALIZATION.
C
C   T   THE BAND MATRIX.
C
C   ALP   THE CURRENT DIAGONAL BLOCK.
C
C   BET   THE CURRENT OFF DIAGONAL BLOCK.
C
C   BOUND, ATEMP, VTEMP, D  TEMPORARY STORAGE USED BY THE BAND
C      EIGENVALUE SOLVER SLAEIG.
C
C   S   EIGENVECTORS OF T.
C
C   SMALL   .TRUE.  IF THE SMALL EIGENVALUES ARE DESIRED.
C
C   RARITZ  RETURNED AS  .TRUE.  IF A FINAL RAYLEIGH-RITZ PROCEDURE
C     IS TO BE DONE.
C
C   DELTA   RETURNED AS THE VALUE OF THE (NVAL+1)TH EIGENVALUE
C     OF THE MATRIX.  USED IN ESTIMATING THE ACCURACY OF THE
C     COMPUTED EIGENVALUES.
C
C
C INTERNAL VARIABLES USED  
C
      INTEGER I, I1, II, J, K, L, M, NG, NGOOD,
     *   NLEFT, NSTART, NTHETA, NUMBER, MIN0, MTEMP
      LOGICAL ENOUGH, TEST
      REAL ALPMAX, ALPMIN, ANORM, BETMAX, BETMIN,
     *   EPSRT, PNORM, RNORM, TEMP,
     *   TMAX, TMIN, TOLA, TOLG, UTOL, ABS,
     *   AMAX1, AMIN1, SQRT, SDOT, SNRM2, TARR(1), ZERO(1)
      EXTERNAL SMVPC, SORTQR, SAXPY, SCOPY, SDOT,
     *   SNRM2, SSCAL, SSWAP, SLAEIG, SLAGER, SLARAN, SVSORT
C
C J   THE CURRENT DIMENSION OF T.  (THE DIMENSION OF THE CURRENT
C    KRYLOV SUBSPACE. 
C
C NGOOD   THE NUMBER OF GOOD RITZ VECTORS (GOOD VECTORS
C    LIE IN THE CURRENT KRYLOV SUBSPACE).
C
C NLEFT   THE NUMBER OF VALUES WHICH REMAIN TO BE DETERMINED,
C    I.E.  NLEFT = NVAL - NPERM.
C
C NUMBER = NPERM + NGOOD.
C
C ANORM   AN ESTIMATE OF THE NORM OF THE MATRIX.
C
C EPS   THE RELATIVE MACHINE PRECISION.
C
C UTOL   THE USER TOLERANCE.
C
C TARR  AN ARRAY OF LENGTH ONE USED TO INSURE TYPE CONSISTENCY IN CALLS TO
C       SLAEIG
C
C ZERO  AN ARRAY OF LENGTH ONE CONTAINING ZERO, USED TO INSURE TYPE CONSISTENCY
C       IN CALLS TO SCOPY
C
      ZERO(1) = 0.0 
      RNORM = 0.0 
      IF (NPERM.NE.0) RNORM = AMAX1(-VAL(1),VAL(NPERM))
      PNORM = RNORM
      DELTA = 10.D30
      EPSRT = SQRT(EPS)
      NLEFT = NVAL - NPERM
      NOP = 0
      NUMBER = NPERM
      RARITZ = .FALSE.
      UTOL = AMAX1(FLOAT(N)*EPS,10.0 **-FLOAT(NFIG))
      J = MAXJ
C
C ------------------------------------------------------------------
C
C ANY ITERATION OF THE ALGORITHM BEGINS HERE.
C
   30 DO 50 I=1,NBLOCK
         TEMP = SNRM2(N,P1(1,I),1)
         IF (TEMP.EQ.0 ) CALL SLARAN(N, P1(1,I))
   50 CONTINUE
      IF (NPERM.EQ.0) GO TO 70
      DO 60 I=1,NPERM
         TAU(I) = 1.0 
         OTAU(I) = 0.0 
   60 CONTINUE
   70 CALL SCOPY(N*NBLOCK, ZERO, 0, P0, 1)
      CALL SCOPY(NBLOCK*NBLOCK, ZERO, 0, BET, 1)
      CALL SCOPY(J*NBAND, ZERO, 0, T, 1)
      MTEMP = NVAL + 1
      DO 75 I = 1, MTEMP
         CALL SCOPY(J, ZERO, 0, S(1,I), 1)
   75 CONTINUE
      NGOOD = 0
      TMIN = 1.0D30
      TMAX = -1.0D30
      TEST = .TRUE.
      ENOUGH = .FALSE.
      BETMAX = 0.0 
      J = 0
C
C ------------------------------------------------------------------
C
C THIS SECTION TAKES A SINGLE BLOCK LANCZOS STEP.
C
   80 J = J + NBLOCK
C
C THIS IS THE SELECTIVE ORTHOGONALIZATION.
C
      IF (NUMBER.EQ.0) GO TO 110
      DO 100 I=1,NUMBER
         IF (TAU(I).LT.EPSRT) GO TO 100
         TEST = .TRUE.
         TAU(I) = 0.0 
         IF (OTAU(I).NE.0.0 ) OTAU(I) = 1.0 
         DO 90 K=1,NBLOCK
            TEMP = -SDOT(N,VEC(1,I),1,P1(1,K),1)
            CALL SAXPY(N, TEMP, VEC(1,I), 1, P1(1,K), 1)
C
C THIS CHECKS FOR TOO GREAT A LOSS OF ORTHOGONALITY BETWEEN A
C NEW LANCZOS VECTOR AND A GOOD RITZ VECTOR.  THE ALGORITHM IS
C TERMINATED IF TOO MUCH ORTHOGONALITY IS LOST.
C
            IF (ABS(TEMP*BET(K,K)).GT.FLOAT(N)*EPSRT*
     *        ANORM .AND. I.GT.NPERM) GO TO 380
   90    CONTINUE
  100 CONTINUE
C
C IF NECESSARY, THIS REORTHONORMALIZES P1 AND UPDATES BET.
C
  110 IF(.NOT. TEST) GO TO 160
      CALL SORTQR(N, N, NBLOCK, P1, ALP)
      TEST = .FALSE.
      IF(J .EQ. NBLOCK) GO TO 160
      DO 130 I = 1,NBLOCK
         IF(ALP(I,I) .GT. 0.0 ) GO TO 130
         M = J - 2*NBLOCK + I
         L = NBLOCK + 1
         DO 120 K = I,NBLOCK
            BET(I,K) = -BET(I,K)
            T(L,M) = -T(L,M)
            L = L - 1
            M = M + 1
  120    CONTINUE
  130 CONTINUE
C
C THIS IS THE LANCZOS STEP.
C
  160 CALL OP(N, NBLOCK, P1, P2)
      NOP = NOP + 1
      CALL IOVECT(N, NBLOCK, P1, J, 0)
C
C THIS COMPUTES P2=P2-P0*BET(TRANSPOSE)
C
      DO 180 I=1,NBLOCK
         DO 170 K=I,NBLOCK
            CALL SAXPY(N, -BET(I,K), P0(1,K), 1, P2(1,I), 1)
  170    CONTINUE
  180 CONTINUE
C
C THIS COMPUTES ALP AND P2=P2-P1*ALP.
C
      DO 200 I=1,NBLOCK
         DO 190 K=1,I
            II = I - K + 1
            ALP(II,K) = SDOT(N,P1(1,I),1,P2(1,K),1)
            CALL SAXPY(N, -ALP(II,K), P1(1,I), 1, P2(1,K), 1)
            IF (K.NE.I) CALL SAXPY(N, -ALP(II,K), P1(1,K),
     *        1, P2(1,I), 1)
  190   CONTINUE
  200 CONTINUE
C
C  REORTHOGONALIZATION OF THE SECOND BLOCK
C
      IF(J .NE. NBLOCK) GO TO 220
      DO 215 I=1,NBLOCK
         DO 210 K=1,I
            TEMP = SDOT(N,P1(1,I),1,P2(1,K),1)
            CALL SAXPY(N, -TEMP, P1(1,I), 1, P2(1,K), 1)
            IF (K.NE.I) CALL SAXPY(N, -TEMP, P1(1,K),
     *        1, P2(1,I), 1)
            II = I - K + 1
            ALP(II,K) = ALP(II,K) + TEMP            
  210   CONTINUE
  215 CONTINUE
C
C THIS ORTHONORMALIZES THE NEXT BLOCK
C
  220 CALL SORTQR(N, N, NBLOCK, P2, BET)
C
C THIS STORES ALP AND BET IN T.
C
      DO 250 I=1,NBLOCK
         M = J - NBLOCK + I
         DO 230 K=I,NBLOCK
            L = K - I + 1
            T(L,M) = ALP(L,I)
  230    CONTINUE
         DO 240 K=1,I
            L = NBLOCK - I + K + 1
            T(L,M) = BET(K,I)
  240    CONTINUE
  250 CONTINUE
C
C THIS NEGATES T IF SMALL IS FALSE.
C
      IF (SMALL) GO TO 280
      M = J - NBLOCK + 1
      DO 270 I=M,J
         DO 260 K=1,L
            T(K,I) = -T(K,I)
  260    CONTINUE
  270 CONTINUE
C
C THIS SHIFTS THE LANCZOS VECTORS
C
  280 CALL SCOPY(NBLOCK*N, P1, 1, P0, 1)
      CALL SCOPY(NBLOCK*N, P2, 1, P1, 1)
      CALL SLAGER(J, NBAND, J-NBLOCK+1, T, TMIN, TMAX)
      ANORM = AMAX1(RNORM, TMAX, -TMIN)
      IF (NUMBER.EQ.0) GO TO 305
C
C THIS COMPUTES THE EXTREME EIGENVALUES OF ALP.
C
      CALL SCOPY(NBLOCK, ZERO, 0, P2, 1)
      CALL SLAEIG(NBLOCK, NBLOCK, 1, 1, ALP, TARR, NBLOCK,
     1   P2, BOUND, ATEMP, D, VTEMP, EPS, TMIN, TMAX)
      ALPMIN = TARR(1)
      CALL SCOPY(NBLOCK, ZERO, 0, P2, 1)
      CALL SLAEIG(NBLOCK, NBLOCK, NBLOCK, NBLOCK, ALP, TARR,
     1  NBLOCK, P2, BOUND, ATEMP, D, VTEMP, EPS, TMIN, TMAX)
      ALPMAX = TARR(1)
C
C THIS COMPUTES ALP = BET(TRANSPOSE)*BET.
C
  305 DO 310 I = 1, NBLOCK
         DO 300 K = 1, I
            L = I - K + 1
            ALP(L,K) = SDOT(NBLOCK-I+1, BET(I,I), NBLOCK, BET(K,I),
     1        NBLOCK)
  300    CONTINUE
  310 CONTINUE
      IF(NUMBER .EQ. 0) GO TO 330
C
C THIS COMPUTES THE SMALLEST SINGULAR VALUE OF BET.
C
      CALL SCOPY(NBLOCK, ZERO, 0, P2, 1)
      CALL SLAEIG(NBLOCK, NBLOCK, 1, 1, ALP, TARR, NBLOCK,
     1  P2, BOUND, ATEMP, D, VTEMP, EPS, 0.0, ANORM*ANORM)
      BETMIN = SQRT(TARR(1))
C
C THIS UPDATES TAU AND OTAU.
C
      DO 320 I=1,NUMBER
         TEMP = (TAU(I)*AMAX1(ALPMAX-VAL(I),VAL(I)-ALPMIN)
     *     +OTAU(I)*BETMAX+EPS*ANORM)/BETMIN
         IF (I.LE.NPERM) TEMP = TEMP + RES(I)/BETMIN
         OTAU(I) = TAU(I)
         TAU(I) = TEMP
  320 CONTINUE
C
C THIS COMPUTES THE LARGEST SINGULAR VALUE OF BET.
C
  330 CALL SCOPY(NBLOCK, ZERO, 0, P2, 1)
      CALL SLAEIG(NBLOCK, NBLOCK, NBLOCK, NBLOCK, ALP, TARR,
     1  NBLOCK, P2, BOUND, ATEMP, D, VTEMP, EPS, 0.0,
     2  ANORM*ANORM)
      BETMAX = SQRT(TARR(1))
      IF (J.LE.2*NBLOCK) GO TO 80
C
C ------------------------------------------------------------------
C
C THIS SECTION COMPUTES AND EXAMINES THE SMALLEST NONGOOD AND
C LARGEST DESIRED EIGENVALUES OF T TO SEE IF A CLOSER LOOK
C IS JUSTIFIED.
C
      TOLG = EPSRT*ANORM
      TOLA = UTOL*RNORM
      IF(MAXJ-J .LT. NBLOCK .OR. (NOP .GE. MAXOP .AND.
     1  NLEFT .NE. 0)) GO TO 390
      GO TO 400

C
C ------------------------------------------------------------------
C
C THIS SECTION COMPUTES SOME EIGENVALUES AND EIGENVECTORS OF T TO
C SEE IF FURTHER ACTION IS INDICATED, ENTRY IS AT 380 OR 390 IF AN
C ITERATION (OR TERMINATION) IS KNOWN TO BE NEEDED, OTHERWISE ENTRY
C IS AT 400.
C
  380 J = J - NBLOCK
      IERR = -8
  390 IF (NLEFT.EQ.0) RETURN
      TEST = .TRUE.
  400 NTHETA = MIN0(J/2,NLEFT+1)
      CALL SLAEIG(J, NBAND, 1, NTHETA, T, VAL(NUMBER+1),
     1  MAXJ, S, BOUND, ATEMP, D, VTEMP, EPS, TMIN, TMAX)
      CALL SMVPC(NBLOCK, BET, MAXJ, J, S, NTHETA, ATEMP, VTEMP, D)
C
C THIS CHECKS FOR TERMINATION OF A CHECK RUN
C
      IF(NLEFT .NE. 0 .OR. J .LT. 6*NBLOCK) GO TO 410
      IF(VAL(NUMBER+1)-ATEMP(1) .GT. VAL(NPERM) - TOLA) GO TO 790 
C
C THIS UPDATES NLEFT BY EXAMINING THE COMPUTED EIGENVALUES OF T
C TO DETERMINE IF SOME PERMANENT VALUES ARE NO LONGER DESIRED.
C
  410 IF (NTHETA.LE.NLEFT) GO TO 470
      IF (NPERM.EQ.0) GO TO 430
      M = NUMBER + NLEFT + 1
      IF (VAL(M).GE.VAL(NPERM)) GO TO 430
      NPERM = NPERM - 1
      NGOOD = 0
      NUMBER = NPERM
      NLEFT = NLEFT + 1
      GO TO 400
C
C THIS UPDATES DELTA.
C
  430 M = NUMBER + NLEFT + 1
      DELTA = AMIN1(DELTA,VAL(M))
      ENOUGH = .TRUE.
      IF(NLEFT .EQ. 0) GO TO 80
      NTHETA = NLEFT
      VTEMP(NTHETA+1) = 1
C
C ------------------------------------------------------------------
C
C THIS SECTION EXAMINES THE COMPUTED EIGENPAIRS IN DETAIL.
C
C THIS CHECKS FOR ENOUGH ACCEPTABLE VALUES.
C
      IF (.NOT.(TEST .OR. ENOUGH)) GO TO 470
      DELTA = AMIN1(DELTA,ANORM)
      PNORM = AMAX1(RNORM,AMAX1(-VAL(NUMBER+1),DELTA))
      TOLA = UTOL*PNORM
      NSTART = 0
      DO 460 I=1,NTHETA
         M = NUMBER + I
         IF (AMIN1(ATEMP(I)*ATEMP(I)/(DELTA-VAL(M)),ATEMP(I))
     *     .GT.TOLA) GO TO 450
         IND(I) = -1
         GO TO 460
C
  450    ENOUGH = .FALSE.
         IF (.NOT.TEST) GO TO 470
         IND(I) = 1
         NSTART = NSTART + 1
  460 CONTINUE
C
C  COPY VALUES OF IND INTO VTEMP
C
      DO 465 I = 1,NTHETA
         VTEMP(I) = FLOAT(IND(I))
  465 CONTINUE
      GO TO 500
C
C THIS CHECKS FOR NEW GOOD VECTORS.
C
  470 NG = 0
      DO 490 I=1,NTHETA
         IF (VTEMP(I).GT.TOLG) GO TO 480
         NG = NG + 1
         VTEMP(I) = -1
         GO TO 490
C
  480    VTEMP(I) = 1
  490 CONTINUE
C
      IF (NG.LE.NGOOD) GO TO 80
      NSTART = NTHETA - NG
C
C ------------------------------------------------------------------
C
C THIS SECTION COMPUTES AND NORMALIZES THE INDICATED RITZ VECTORS.
C IF NEEDED (TEST = .TRUE.), NEW STARTING VECTORS ARE COMPUTED.
C
  500 TEST = TEST .AND. .NOT.ENOUGH
      NGOOD = NTHETA - NSTART
      NSTART = NSTART + 1
      NTHETA = NTHETA + 1
C
C THIS ALIGNS THE DESIRED (ACCEPTABLE OR GOOD) EIGENVALUES AND
C EIGENVECTORS OF T.  THE OTHER EIGENVECTORS ARE SAVED FOR
C FORMING STARTING VECTORS, IF NECESSARY.  IT ALSO SHIFTS THE
C EIGENVALUES TO OVERWRITE THE GOOD VALUES FROM THE PREVIOUS
C PAUSE.
C
      CALL SCOPY(NTHETA, VAL(NUMBER+1), 1, VAL(NPERM+1), 1)
      IF (NSTART.EQ.0) GO TO 580
      IF (NSTART.EQ.NTHETA) GO TO 530
      CALL SVSORT(NTHETA, VTEMP, ATEMP, 1, VAL(NPERM+1), MAXJ,
     *  J, S)
C
C THES ACCUMULATES THE J-VECTORS USED TO FORM THE STARTING
C VECTORS.
C
  530 IF (.NOT.TEST) NSTART = 0
      IF (.NOT.TEST) GO TO 580
C
C  FIND MINIMUM ATEMP VALUE TO AVOID POSSIBLE OVERFLOW
C
      TEMP = ATEMP(1)
      DO 535 I = 1, NSTART
         TEMP = AMIN1(TEMP, ATEMP(I))
  535 CONTINUE
      M = NGOOD + 1
      L = NGOOD + MIN0(NSTART,NBLOCK)
      DO 540 I=M,L
         CALL SSCAL(J, TEMP/ATEMP(I), S(1,I), 1)
  540 CONTINUE
      M = (NSTART-1)/NBLOCK
      IF (M.EQ.0) GO TO 570
      L = NGOOD + NBLOCK
      DO 560 I=1,M
         DO 550 K=1,NBLOCK
            L = L + 1
            IF (L.GT.NTHETA) GO TO 570
            I1 = NGOOD + K
            CALL SAXPY(J, TEMP/ATEMP(L), S(1,L), 1, S(1,I1), 1)
  550    CONTINUE
  560 CONTINUE
  570 NSTART = MIN0(NSTART,NBLOCK)
C
C THIS STORES THE RESIDUAL NORMS OF THE NEW PERMANENT VECTORS.
C
  580 IF (NGOOD.EQ.0 .OR. .NOT.(TEST .OR. ENOUGH)) GO TO 600
      DO 590 I=1,NGOOD
         M = NPERM + I
         RES(M) = ATEMP(I)
  590 CONTINUE
C
C THIS COMPUTES THE RITZ VECTORS BY SEQUENTIALLY RECALLING THE
C LANCZOS VECTORS.
C
  600 NUMBER = NPERM + NGOOD
      IF (TEST .OR. ENOUGH) CALL SCOPY(N*NBLOCK, ZERO, 0, P1, 1)
      IF (NGOOD.EQ.0) GO TO 620
      M = NPERM + 1
      DO 610 I=M,NUMBER
         CALL SCOPY(N, ZERO, 0, VEC(1,I), 1)
  610 CONTINUE
  620 DO 670 I=NBLOCK,J,NBLOCK
         CALL IOVECT(N, NBLOCK, P2, I, 1)
         DO 660 K=1,NBLOCK
            M = I - NBLOCK + K
            IF (NSTART.EQ.0) GO TO 640
            DO 630 L=1,NSTART
               I1 = NGOOD + L
               CALL SAXPY(N, S(M,I1), P2(1,K), 1, P1(1,L), 1)
  630       CONTINUE
  640       IF (NGOOD.EQ.0) GO TO 660
            DO 650 L=1,NGOOD
               I1 = L + NPERM
               CALL SAXPY(N, S(M,L), P2(1,K), 1, VEC(1,I1), 1)
  650       CONTINUE
  660    CONTINUE
  670 CONTINUE
      IF (TEST .OR. ENOUGH) GO TO 690
C
C THIS NORMALIZES THE RITZ VECTORS AND INITIALIZES THE
C TAU RECURRENCE.
C
      M = NPERM + 1
      DO 680 I=M,NUMBER
         TEMP = 1.0 /SNRM2(N,VEC(1,I),1)
         CALL SSCAL(N, TEMP, VEC(1,I), 1)
         TAU(I) = 1.0 
         OTAU(I) = 1.0 
  680 CONTINUE
C
C  SHIFT S VECTORS TO ALIGN FOR LATER CALL TO SLAEIG
C
      CALL SCOPY(NTHETA, VAL(NPERM+1), 1, VTEMP, 1)
      CALL SVSORT(NTHETA, VTEMP, ATEMP, 0, TARR, MAXJ, J, S)
      GO TO 80
C
C ------------------------------------------------------------------
C
C THIS SECTION PREPARES TO ITERATE THE ALGORITHM BY SORTING THE
C PERMANENT VALUES, RESETTING SOME PARAMETERS, AND ORTHONORMALIZING
C THE PERMANENT VECTORS.
C
  690 IF (NGOOD.EQ.0 .AND. NOP.GE.MAXOP) GO TO 810
      IF (NGOOD.EQ.0) GO TO 30
C
C THIS ORTHONORMALIZES THE VECTORS
C
      CALL SORTQR(NMVEC, N, NPERM+NGOOD, VEC, S)
C
C THIS SORTS THE VALUES AND VECTORS.
C
      IF(NPERM .NE. 0) CALL SVSORT(NPERM+NGOOD, VAL, RES, 0, TEMP,
     *   NMVEC, N, VEC)
      NPERM = NPERM + NGOOD
      NLEFT = NLEFT - NGOOD
      RNORM = AMAX1(-VAL(1),VAL(NPERM))
C
C THIS DECIDES WHERE TO GO NEXT.
C
      IF (NOP.GE.MAXOP .AND. NLEFT.NE.0) GO TO 810
      IF (NLEFT.NE.0) GO TO 30
      IF (VAL(NVAL)-VAL(1).LT.TOLA) GO TO 790
C
C THIS DOES A CLUSTER TEST TO SEE IF A CHECK RUN IS NEEDED
C TO LOOK FOR UNDISCLOSED MULTIPLICITIES.
C
      M = NPERM - NBLOCK + 1
      IF (M.LE.0) RETURN
      DO 780 I=1,M
         L = I + NBLOCK - 1
         IF (VAL(L)-VAL(I).LT.TOLA) GO TO 30
  780 CONTINUE
C
C THIS DOES A CLUSTER TEST TO SEE IF A FINAL RAYLEIGH-RITZ
C PROCEDURE IS NEEDED.
C
  790 M = NPERM - NBLOCK
      IF (M.LE.0) RETURN
      DO 800 I=1,M
         L = I + NBLOCK
         IF (VAL(L)-VAL(I).GE.TOLA) GO TO 800
         RARITZ = .TRUE.
         RETURN
  800 CONTINUE
C
      RETURN
C
C ------------------------------------------------------------------
C
C THIS REPORTS THAT MAXOP WAS EXCEEDED.
C
  810 IERR = -2
      GO TO 790
C
      END

.