      SUBROUTINE RITVEC(N,J,EV,KAPPA,RNM,RITZ,BND,ALF,BET,S,WRK1,WRK2,
     *                  IERR,MSGLVL,KPROC,LDOBSC)
C
C     .... subroutines:      TQL2,STORE
C     .... BLAS routines:    DAXPY,DCOPY,DSCAL
C
C     %bgn%
C     %end%
C
C     .. Parameters ..
      INTEGER           RETRQ
      PARAMETER         (RETRQ=2)
C     .. Scalar Arguments ..
      REAL KAPPA, RNM
      INTEGER           EV, IERR, J, MSGLVL, N
      LOGICAL           LDOBSC
C     .. Array Arguments ..
      REAL ALF(J), BET(J), BND(J), RITZ(J), S(J,J),
     *                  WRK1(N), WRK2(N)
      character*2 cev
      character*4 cproc
C     .. Scalars in Common ..
      REAL ANORM, DUMMY, EPS, EPS1, EPS34, EPSN, RCEPS1,
     *                  REPS, TOL
C     .. Local Scalars ..
      INTEGER           I, K
C     .. External Subroutines ..
      EXTERNAL          DAXPY, DCOPY, DSCAL, STORE, TQL2
C     .. Intrinsic Functions ..
      INTRINSIC         ABS
C     .. Common blocks ..
      COMMON            /RDATA/DUMMY, ANORM, TOL, EPS, EPS1, RCEPS1,
     *                  EPSN, REPS, EPS34
C     .. Executable Statements ..
C
      write(cev,'(i2.2)') ev
      write(cproc,'(i4.4)') kproc 
      CALL DSCAL(J*J,0.0E0,S,1)
      DO 20 I = 1, J
         S(I,I) = 1.0E0
   20 CONTINUE
      CALL DCOPY(J,ALF,1,WRK1,-1)
      IF (J.GT.1) CALL DCOPY(J-1,BET(2),1,WRK2(2),-1)
      CALL TQL2(J,J,WRK1,WRK2,S,IERR)
      IF (IERR.NE.0) RETURN
C
C     .... on return WRK1 contains eigenvalues in ascending order
C     ....       and S contains the corresponding eigenvectors
C
C     %bgn%
      IF (MSGLVL.GE.1) THEN
         DO 40 K = 1, J
            IF (ABS(WRK1(K)-RITZ(K)).GT.EPS1*ABS(RITZ(K))) THEN
               WRITE(6,99999) K, RITZ(K), WRK1(K),
     *           ABS(((WRK1(K)-RITZ(K))/(RITZ(K)*EPS1)))
            END IF
   40    CONTINUE
      END IF
      IF (MSGLVL.GE.5) THEN
         OPEN (9,FORM='unformatted')
         REWIND (9)
         WRITE (9) N, J, KAPPA
         DO 60 K = 1, J
            WRITE (9) ALF(K), BET(K), RITZ(K), BND(K),
     *        (S(J-I+1,K),I=1,J)
   60    CONTINUE
         CLOSE (9)
      END IF
C     %end%
      IF (LDOBSC) 
     * OPEN (EV,FORM='UNFORMATTED',file='fort.'//cev//cproc)
      REWIND (EV)
      WRITE (EV) N, J, KAPPA
      DO 100 K = 1, J
         IF (BND(K).LE.KAPPA*ABS(RITZ(K))) THEN
            CALL DSCAL(N,0.0E0,WRK1,1)
            DO 80 I = 1, J
               CALL STORE(N,RETRQ,I,WRK2)
               CALL DAXPY(N,S(J-I+1,K),WRK2,1,WRK1,1)
   80       CONTINUE
            WRITE (EV) RITZ(K), BND(K), (WRK1(I),I=1,N)
         END IF
  100 CONTINUE
      IF (LDOBSC) CLOSE (EV)
      RETURN
C
99999 FORMAT (/1X,'>>> I = ',I3,1P,D22.14,'(LANSO)',1X,1P,D22.14,'(TQL',
     *       '2)',1X,F6.1)
      END
