ssgt01()

subroutine ssgt01	(	integer	ITYPE,
		character	UPLO,
		integer	N,
		integer	M,
		real, dimension( lda, * )	A,
		integer	LDA,
		real, dimension( ldb, * )	B,
		integer	LDB,
		real, dimension( ldz, * )	Z,
		integer	LDZ,
		real, dimension( * )	D,
		real, dimension( * )	WORK,
		real, dimension( * )	RESULT
	)

SSGT01

Purpose:

 SSGT01 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 symmetric matrix, B is
 symmetric positive definite, Z is orthogonal, 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 symmetric 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 symmetric 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. 0 <= M <= N.
[in]	A	A is REAL array, dimension (LDA, N) The original symmetric matrix A.
[in]	LDA	LDA is INTEGER The leading dimension of the array A. LDA >= max(1,N).
[in]	B	B is REAL array, dimension (LDB, N) The original symmetric positive definite matrix B.
[in]	LDB	LDB is INTEGER The leading dimension of the array B. LDB >= max(1,N).
[in]	Z	Z is REAL 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 REAL array, dimension (N*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.

Date

December 2016

Definition at line 148 of file ssgt01.f.

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

Here is the call graph for this function:

Here is the caller graph for this function: