Code for One Version of LA_SYEV

The following code implements one of the Fortran 95 interface driver subroutines. The routine shown is the real single precision version of LA_SYEV.

SUBROUTINE SSYEV_F95( A, W, JOBZ, UPLO, INFO ) 

!		- LAPACK95 interface driver routine (version 2.0) - 

!		   UNI-C, Denmark; Univ. of Tennessee, USA; NAG Ltd., UK 

!		   August, 2000 

!		.. Use statements .. 


USE LA_PRECISION, ONLY: WP $=>$ SP 


USE LA_AUXMOD, ONLY: ERINFO, LSAME 


USE F77_LAPACK, ONLY: SYEV_F77 $=>$ LA_SYEV, & 


ILAENV_F77 $=>$ ILAENV 

!		.. Implicit statement .. 


IMPLICIT NONE 

!		.. Character arguments .. 


CHARACTER( LEN = 1 ), INTENT(IN), OPTIONAL :: JOBZ, UPLO 

!		.. Scalar arguments .. 


INTEGER, INTENT(OUT), OPTIONAL :: INFO 

!		.. Array arguments .. 


REAL( WP ), INTENT(INOUT) :: A( :, : ) 


REAL( WP ), INTENT(OUT) :: W( : ) 

!--------------------------------- 

! LA_SYEV computes all eigenvalues and, optionally,  

! eigenvectors of a real symmetric matrix A. 

!--------------------------------- 

!		.. Local parameters .. 


CHARACTER( LEN = 7 ), PARAMETER :: SRNAME = 'LA_SYEV' 


CHARACTER( LEN = 6 ), PARAMETER :: BSNAME = 'SSYTRD' 

!		.. Local scalars .. 


CHARACTER( LEN = 1 ) :: LJOBZ, LUPLO 


INTEGER :: N, LINFO, LD, ISTAT, ISTAT1, LWORK, NB 

!		.. Local arrays .. 


REAL( WP ), POINTER :: WORK( : ) 

!		.. Intrinsic functions .. 


INTRINSIC MAX, PRESENT 

!		.. Executable statements .. 


N = SIZE( A, 1 ); LINFO = 0; ISTAT = 0; LD = MAX( 1, N ) 


IF( PRESENT( JOBZ ) ) THEN 


LJOBZ = JOBZ 


ELSE 


LJOBZ = 'N' 


END IF 


IF( PRESENT( UPLO ) ) THEN 


LUPLO = UPLO 


ELSE 


LUPLO = 'U' 


END IF 

! 		.. Test the arguments 


IF( SIZE( A, 2 ) /= N .OR. N $<$ 0 )THEN 


LINFO = -1 


ELSE IF( SIZE( W ) /= N )THEN 


LINFO = -2 


ELSE IF( .NOT. LSAME( LJOBZ, 'N' ) .AND. & 

  .NOT. LSAME( LJOBZ, 'V' ) )THEN 


LINFO = -3 


ELSE IF( .NOT. LSAME( LUPLO, 'U' ) .AND. & 

  .NOT. LSAME( LUPLO, 'L' ) )THEN 


LINFO = -4 


ELSE IF( N $>$ 0 )THEN 

! 		.. Determine the workspace 


NB = ILAENV_F77( 1, BSNAME, LUPLO, N, -1, -1, -1 ) 


IF( NB $<=$ 1 .OR. NB $>=$ N )THEN 


NB = 1 


END IF 


LWORK = ( 2 + NB ) * N 


ALLOCATE( WORK( LWORK ), STAT = ISTAT ) 


IF( ISTAT /= 0 )THEN 


LWORK = 3 * N - 1 


DEALLOCATE( WORK, STAT = ISTAT1 ) 


ALLOCATE( WORK( LWORK), STAT = ISTAT ) 


IF( ISTAT /= 0 ) THEN 


LINFO = -100 


ELSE 


CALL ERINFO( -200, SRNAME, ISTAT1 ) 


END IF 


END IF 


IF( LINFO == 0 )THEN 


CALL SYEV_F77( LJOBZ, LUPLO, N, A, LD, W, & 


WORK, LWORK, LINFO ) 


END IF 


DEALLOCATE( WORK, STAT = ISTAT1 ) 


END IF 


CALL ERINFO( LINFO, SRNAME, INFO, ISTAT ) 


END SUBROUTINE SSYEV_F95