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: