SUBROUTINE SSTEVR_F95( D, E, W, Z, VL, VU, IL, IU, M, ISUPPZ, &
     &    ABSTOL, INFO )
!
!  -- LAPACK95 interface driver routine (version 3.0) --
!     UNI-C, Denmark; Univ. of Tennessee, USA; NAG Ltd., UK
!     September, 2000
!
!  .. USE STATEMENTS ..
      USE LA_PRECISION, ONLY: WP => SP
      USE LA_AUXMOD, ONLY: ERINFO
      USE F77_LAPACK, ONLY: STEVR_F77 => LA_STEVR, LAMCH_F77 => SLAMCH
!  .. IMPLICIT STATEMENT ..
      IMPLICIT NONE
!  .. SCALAR ARGUMENTS ..
      INTEGER, INTENT(IN), OPTIONAL :: IL, IU
      INTEGER, INTENT(OUT), OPTIONAL :: INFO, M
      REAL(WP), INTENT(IN), OPTIONAL :: ABSTOL, VL, VU
!  .. ARRAY ARGUMENTS ..
      INTEGER, INTENT(OUT), OPTIONAL, TARGET :: ISUPPZ(:)
      REAL(WP), INTENT(OUT), OPTIONAL, TARGET :: Z(:,:)
      REAL(WP), INTENT(INOUT) :: D(:), E(:)
      REAL(WP), INTENT(OUT) :: W(:)
!----------------------------------------------------------------------
! 
! Purpose
! =======
!       LA_STEVR computes selected eigenvalues and, optionally, the 
! corresponding eigenvectors of a real symmetric tridiagonal matrix A.
! Eigenvalues and eigenvectors can be selected by specifying either a 
! range of values or a range of indices for the desired eigenvalues.
!       LA_STEVR uses a relatively robust representation (RRR) algorithm.
! It is usually the fastest algorithm of all and uses the least
! workspace.
! 
! =========
! 
!         SUBROUTINE LA_STEVR ( D, E, W, Z=z, VL=vl, VU=vu, &
!                         IL=il, IU=iu, M=m, ISUPPZ=isuppz, &
!                         ABSTOL=abstol, INFO=info )
!                 REAL(<wp>), INTENT(INOUT) :: D(:), E(:)
!                 REAL(<wp>), INTENT(OUT) :: W(:)
!                 REAL(<wp>), INTENT(OUT), OPTIONAL :: Z(:,:)
!                 INTEGER, INTENT(OUT), OPTIONAL :: ISUPPZ(:)
!                 REAL(<wp>), INTENT(IN), OPTIONAL :: VL, VU
!                 INTEGER, INTENT(IN), OPTIONAL :: IL, IU
!                 INTEGER, INTENT(OUT), OPTIONAL :: M
!                 REAL(<wp>), INTENT(IN), OPTIONAL :: ABSTOL
!                 INTEGER, INTENT(OUT), OPTIONAL :: INFO
!         where
!                 <wp> ::= KIND(1.0) | KIND(1.0D0)
! 
! Arguments
! =========
! 
! D      (input/output) REAL array, shape (:) with size(D) = n, where n 
!        is the order of A.
!        On entry, the diagonal elements of the matrix A.
!        On exit, the original contents of D possibly multiplied by a 
!        constant factor to avoid over/underflow in computing the 
!        eigenvalues.
! E      (input/output) REAL array, shape (:) with size(E) = n.
!        On entry, the n-1 subdiagonal elements of A in E(1) to E(n-1) .
!        E(n) need not be set.
!        On exit, the original contents of E possibly multiplied by a 
!        constant factor to avoid over/underflow in computing the 
!        eigenvalues.
! W      (output) REAL array with size(W) = n.
!        The first M elements contain the selected eigenvalues in 
!        ascending order.
! Z      Optional (output) REAL or COMPLEX array, shape (:,:) with 
!        size(Z,1) = n and size(Z,2) = M.
!        The first M columns of Z contain the orthonormal eigenvectors of
!        A corresponding to the selected eigenvalues, with the i-th column 
!        of Z containing the eigenvector associated with the eigenvalue in
!        W(i).
!        Note: The user must ensure that at least M columns are supplied 
!        in the array Z. When the exact value of M is not known in advance,
!        an upper bound must be used. In all cases M <= n.
! VL,VU  Optional (input) REAL.
!        The lower and upper bounds of the interval to be searched for 
!        eigenvalues. VL < VU.
!        Default values: VL = -HUGE(<wp>) and VU = HUGE(<wp>), where 
!        <wp> ::= KIND(1.0) | KIND(1.0D0).
!        Note: Neither VL nor VU may be present if IL and/or IU is 
!        present.
! IL,IU  Optional (input) INTEGER.
!        The indices of the smallest and largest eigenvalues to be 
!        returned. The IL-th through IU-th eigenvalues will be found. 
!        1 <= IL <= IU <= n.
!        Default values: IL = 1 and IU = n.
!        Note: Neither IL nor IU may be present if VL and/or VU is 
!        present.
!        Note: All eigenvalues are calculated if none of the arguments 
!        VL, VU, IL and IU are present.
! M      Optional (output) INTEGER.
!        The total number of eigenvalues found. 0 <= M <=  n.
!        Note: If IL and IU are present then M = IU - IL + 1.
! ISUPPZ Optional (output) INTEGER array, shape (:) with 
!        size(ISUPPZ) = 2*max(1,M).
!        The support of the eigenvectors in A, i.e., the indices 
!        indicating the nonzero elements. The i-th eigenvector is nonzero
!        only in elements ISUPPZ(2*i-1) through ISUPPZ(2*i).
! ABSTOL Optional (input) REAL.
!        The absolute error tolerance for the eigenvalues. An approximate
!        eigenvalue is accepted as converged when it is determined to lie
!        in an interval [a, b] of width less than or equal to 
!        ABSTOL + EPSILON(1.0_<wp>) * max(| a |, | b |),
!        where <wp> is the working precision. If ABSTOL <= 0, then 
!        EPSILON(1.0_<wp>)*||A||1 will be used in its place. Eigenvalues
!        will be computed most accurately if ABSTOL is set to 
!        LA_LAMCH( 1.0_<wp>, 'Safe minimum'), not zero.
!        Default value: 0.0_<wp>.
! INFO   Optional (output) INTEGER
!        = 0: successful exit.
!        < 0: if INFO = -i, the i-th argument had an illegal value.
!        > 0: an internal error occurred.
!        If INFO is not present and an error occurs, then the program is
!        terminated with an error message.
!-----------------------------------------------------------------------
!  .. LOCAL PARAMETERS ..
      CHARACTER(LEN=8), PARAMETER :: SRNAME = 'LA_STEVR'
!  .. LOCAL SCALARS ..
      CHARACTER(LEN=1) :: LJOBZ, LRANGE
      INTEGER :: N, LD, LIL, LIU, LM, SISUPPZ, S1Z, S2Z, NN
      INTEGER :: LINFO, ISTAT, LWORK, LIWORK
      REAL(WP), TARGET :: LLZ(1,1)
      REAL(WP) :: LABSTOL, LVL, LVU
!  .. LOCAL ARRAYS ..
      INTEGER:: IWORKMIN(1), DUMMY(1)
      REAL(WP), TARGET :: WORKMIN(1)
      INTEGER, POINTER :: IWORK(:), LISUPPZ(:)
      REAL(WP), POINTER :: WORK(:)
!  .. INTRINSIC FUNCTIONS ..
      INTRINSIC HUGE, PRESENT, SIZE
!  .. EXECUTABLE STATEMENTS ..
   LINFO = 0; ISTAT = 0; N = SIZE(D); LD = MAX(1,N)
   NN=2*MAX(1,N)
   IF( PRESENT(ISUPPZ) )THEN; SISUPPZ = SIZE(ISUPPZ); ELSE; SISUPPZ = NN; END IF
   IF( PRESENT(VL) )THEN; LVL = VL; ELSE; LVL = -HUGE(LVL); ENDIF
   IF( PRESENT(VU) )THEN; LVU = VU; ELSE; LVU = HUGE(LVU); ENDIF
   IF( PRESENT(IL) )THEN; LIL = IL; ELSE; LIL = 1; ENDIF
   IF( PRESENT(IU) )THEN; LIU = IU; ELSE; LIU = N; ENDIF
   IF( PRESENT(Z) )THEN; S1Z = SIZE(Z,1); S2Z = SIZE(Z,2)
   ELSE; S1Z = 1; S2Z = 1; ENDIF
!  .. TEST THE ARGUMENTS
   IF( N < 0 ) THEN; LINFO = -1
   ELSE IF( SIZE( E ) /= N .AND. N/=0)THEN; LINFO = -2
   ELSE IF( SIZE( W ) /= N )THEN; LINFO = -3
   ELSE IF( PRESENT(Z) .AND. ( S1Z /= LD .OR. S2Z /= MAX(1,N) ) )THEN; LINFO = -4
   ELSE IF( SISUPPZ /= NN .OR. PRESENT(ISUPPZ).AND..NOT.PRESENT(Z) )THEN; LINFO = -5
   ELSE IF( LVU < LVL .AND. N>0)THEN; LINFO = -6
   ELSE IF( (PRESENT(VL) .OR. PRESENT(VU)) .AND. &
            (PRESENT(IL) .OR. PRESENT(IU)) )THEN; LINFO = -7
   ELSE IF (((LIU<LIL) .OR. (LIL<1)) .AND. (N>0))THEN; LINFO = -7
   ELSE IF( N < LIU )THEN; LINFO = -8
   ELSE IF( N > 0 )THEN
     IF( PRESENT(VL) .OR. PRESENT(VU) )THEN; LRANGE = 'V'; LM = N
     ELSE IF( PRESENT(IL) .OR. PRESENT(IU) )THEN; LRANGE = 'I'; LM = LIU-LIL+1
     ELSE; LRANGE = 'A'; LM = N; END IF
       IF( PRESENT(Z) ) THEN; LJOBZ = 'V'
       ELSE; LJOBZ = 'N'
       ENDIF
! .. DETERMINE THE WORKSPACE ..
! .. QUERING THE SIZE OF WORKSPACE ..
       LWORK = -1
       LIWORK = -1
       IF (PRESENT(Z)) THEN
         CALL STEVR_F77( LJOBZ, LRANGE, N, D, E,  LVL, LVU, &
     &       LIL, LIU, LABSTOL, LM, W, Z, S1Z, DUMMY, &
     &       WORKMIN, LWORK, IWORKMIN, LIWORK, LINFO )
       ELSE
         CALL STEVR_F77( LJOBZ, LRANGE, N, D, E,  LVL, LVU, &
     &       LIL, LIU, LABSTOL, LM, W, LLZ, S1Z, DUMMY, &
     &       WORKMIN, LWORK, IWORKMIN, LIWORK, LINFO )
       ENDIF
       LWORK = WORKMIN(1)
       LIWORK = IWORKMIN(1)
       
       ALLOCATE(IWORK(LIWORK), STAT=ISTAT)
       IF (ISTAT /= 0) THEN ; LINFO = -100; GOTO 100; ENDIF

       ALLOCATE(LISUPPZ(NN), STAT=ISTAT)
       IF (ISTAT /= 0) THEN ; LINFO = -100; GOTO 200; ENDIF

       ALLOCATE(WORK(LWORK), STAT=ISTAT)
       IF (ISTAT /= 0) THEN ; LINFO = -100; GOTO 300; ENDIF

       IF( PRESENT(ABSTOL) )THEN; LABSTOL = ABSTOL
       ELSE; LABSTOL = 2*LAMCH_F77('Safe minimum'); ENDIF

       IF (PRESENT (Z)) THEN
         CALL STEVR_F77( LJOBZ, LRANGE, N, D, E, LVL, LVU, LIL, LIU, &
     &     LABSTOL, LM, W, Z, S1Z, LISUPPZ, WORK, LWORK, &
     &     IWORK, LIWORK, LINFO )
       ELSE
         CALL STEVR_F77( LJOBZ, LRANGE, N, D, E, LVL, LVU, LIL, LIU, &
     &     LABSTOL, LM, W, LLZ, S1Z, LISUPPZ, WORK, LWORK, &
     &     IWORK, LIWORK, LINFO )
       ENDIF

       IF( PRESENT(M) ) M = LM

       DEALLOCATE(WORK)
300    DEALLOCATE(LISUPPZ)
200    DEALLOCATE(IWORK)
     ENDIF
100  CALL ERINFO(LINFO,SRNAME,INFO,ISTAT)
END SUBROUTINE SSTEVR_F95