csgt01()

subroutine csgt01	(	integer	itype,
		character	uplo,
		integer	n,
		integer	m,
		complex, dimension( lda, * )	a,
		integer	lda,
		complex, dimension( ldb, * )	b,
		integer	ldb,
		complex, dimension( ldz, * )	z,
		integer	ldz,
		real, dimension( * )	d,
		complex, dimension( * )	work,
		real, dimension( * )	rwork,
		real, dimension( * )	result )

CSGT01

Purpose:

!>
!> CSGT01 checks a decomposition of the form
!>
!>    A Z   =  B Z D or
!>    A B Z =  Z D or
!>    B A Z =  Z D
!>
!> where A is a Hermitian matrix, B is Hermitian positive definite,
!> Z is unitary, and D is diagonal.
!>
!> One of the following test ratios is computed:
!>
!> ITYPE = 1:  RESULT(1) = | A Z - B Z D | / ( |A| |Z| n ulp )
!>
!> ITYPE = 2:  RESULT(1) = | A B Z - Z D | / ( |A| |Z| n ulp )
!>
!> ITYPE = 3:  RESULT(1) = | B A Z - Z D | / ( |A| |Z| n ulp )
!> 

Parameters

[in]	ITYPE	!> ITYPE is INTEGER !> The form of the Hermitian generalized eigenproblem. !> = 1: A*z = (lambda)*B*z !> = 2: A*B*z = (lambda)*z !> = 3: B*A*z = (lambda)*z !>
[in]	UPLO	!> UPLO is CHARACTER*1 !> Specifies whether the upper or lower triangular part of the !> Hermitian matrices A and B is stored. !> = 'U': Upper triangular !> = 'L': Lower triangular !>
[in]	N	!> N is INTEGER !> The order of the matrix A. N >= 0. !>
[in]	M	!> M is INTEGER !> The number of eigenvalues found. M >= 0. !>
[in]	A	!> A is COMPLEX array, dimension (LDA, N) !> The original Hermitian matrix A. !>
[in]	LDA	!> LDA is INTEGER !> The leading dimension of the array A. LDA >= max(1,N). !>
[in]	B	!> B is COMPLEX array, dimension (LDB, N) !> The original Hermitian positive definite matrix B. !>
[in]	LDB	!> LDB is INTEGER !> The leading dimension of the array B. LDB >= max(1,N). !>
[in]	Z	!> Z is COMPLEX array, dimension (LDZ, M) !> The computed eigenvectors of the generalized eigenproblem. !>
[in]	LDZ	!> LDZ is INTEGER !> The leading dimension of the array Z. LDZ >= max(1,N). !>
[in]	D	!> D is REAL array, dimension (M) !> The computed eigenvalues of the generalized eigenproblem. !>
[out]	WORK	!> WORK is COMPLEX array, dimension (N*N) !>
[out]	RWORK	!> RWORK is REAL array, dimension (N) !>
[out]	RESULT	!> RESULT is REAL array, dimension (1) !> The test ratio as described above. !>

Author

Univ. of Tennessee

Univ. of California Berkeley

Univ. of Colorado Denver

NAG Ltd.

Definition at line 150 of file csgt01.f.

*
*  -- LAPACK test routine --
*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
*
*     .. Scalar Arguments ..
      CHARACTER          UPLO
      INTEGER            ITYPE, LDA, LDB, LDZ, M, N
*     ..
*     .. Array Arguments ..
      REAL               D( * ), RESULT( * ), RWORK( * )
      COMPLEX            A( LDA, * ), B( LDB, * ), WORK( * ),
     $                   Z( LDZ, * )
*     ..
*
*  =====================================================================
*
*     .. Parameters ..
      REAL               ZERO, ONE
      parameter( zero = 0.0e+0, one = 1.0e+0 )
      COMPLEX            CZERO, CONE
      parameter( czero = ( 0.0e+0, 0.0e+0 ),
     $                   cone = ( 1.0e+0, 0.0e+0 ) )
*     ..
*     .. Local Scalars ..
      INTEGER            I
      REAL               ANORM, ULP
*     ..
*     .. External Functions ..
      REAL               CLANGE, CLANHE, SLAMCH
      EXTERNAL           clange, clanhe, slamch
*     ..
*     .. External Subroutines ..
      EXTERNAL           chemm, csscal
*     ..
*     .. Executable Statements ..
*
      result( 1 ) = zero
      IF( n.LE.0 )
     $   RETURN
*
      ulp = slamch( 'Epsilon' )
*
*     Compute product of 1-norms of A and Z.
*
      anorm = clanhe( '1', uplo, n, a, lda, rwork )*
     $        clange( '1', n, m, z, ldz, rwork )
      IF( anorm.EQ.zero )
     $   anorm = one
*
      IF( itype.EQ.1 ) THEN
*
*        Norm of AZ - BZD
*
         CALL chemm( 'Left', uplo, n, m, cone, a, lda, z, ldz, czero,
     $               work, n )
         DO 10 i = 1, m
            CALL csscal( n, d( i ), z( 1, i ), 1 )
   10    CONTINUE
         CALL chemm( 'Left', uplo, n, m, cone, b, ldb, z, ldz, -cone,
     $               work, n )
*
         result( 1 ) = ( clange( '1', n, m, work, n, rwork ) / anorm ) /
     $                 ( n*ulp )
*
      ELSE IF( itype.EQ.2 ) THEN
*
*        Norm of ABZ - ZD
*
         CALL chemm( 'Left', uplo, n, m, cone, b, ldb, z, ldz, czero,
     $               work, n )
         DO 20 i = 1, m
            CALL csscal( n, d( i ), z( 1, i ), 1 )
   20    CONTINUE
         CALL chemm( 'Left', uplo, n, m, cone, a, lda, work, n, -cone,
     $               z, ldz )
*
         result( 1 ) = ( clange( '1', n, m, z, ldz, rwork ) / anorm ) /
     $                 ( n*ulp )
*
      ELSE IF( itype.EQ.3 ) THEN
*
*        Norm of BAZ - ZD
*
         CALL chemm( 'Left', uplo, n, m, cone, a, lda, z, ldz, czero,
     $               work, n )
         DO 30 i = 1, m
            CALL csscal( n, d( i ), z( 1, i ), 1 )
   30    CONTINUE
         CALL chemm( 'Left', uplo, n, m, cone, b, ldb, work, n, -cone,
     $               z, ldz )
*
         result( 1 ) = ( clange( '1', n, m, z, ldz, rwork ) / anorm ) /
     $                 ( n*ulp )
      END IF
*
      RETURN
*
*     End of CSGT01
*

Here is the call graph for this function:

Here is the caller graph for this function: