LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
ssgt01.f
Go to the documentation of this file.
00001 *> \brief \b SSGT01
00002 *
00003 *  =========== DOCUMENTATION ===========
00004 *
00005 * Online html documentation available at 
00006 *            http://www.netlib.org/lapack/explore-html/ 
00007 *
00008 *  Definition:
00009 *  ===========
00010 *
00011 *       SUBROUTINE SSGT01( ITYPE, UPLO, N, M, A, LDA, B, LDB, Z, LDZ, D,
00012 *                          WORK, RESULT )
00013 * 
00014 *       .. Scalar Arguments ..
00015 *       CHARACTER          UPLO
00016 *       INTEGER            ITYPE, LDA, LDB, LDZ, M, N
00017 *       ..
00018 *       .. Array Arguments ..
00019 *       REAL               A( LDA, * ), B( LDB, * ), D( * ), RESULT( * ),
00020 *      $                   WORK( * ), Z( LDZ, * )
00021 *       ..
00022 *  
00023 *
00024 *> \par Purpose:
00025 *  =============
00026 *>
00027 *> \verbatim
00028 *>
00029 *> SSGT01 checks a decomposition of the form
00030 *>
00031 *>    A Z   =  B Z D or
00032 *>    A B Z =  Z D or
00033 *>    B A Z =  Z D
00034 *>
00035 *> where A is a symmetric matrix, B is
00036 *> symmetric positive definite, Z is orthogonal, and D is diagonal.
00037 *>
00038 *> One of the following test ratios is computed:
00039 *>
00040 *> ITYPE = 1:  RESULT(1) = | A Z - B Z D | / ( |A| |Z| n ulp )
00041 *>
00042 *> ITYPE = 2:  RESULT(1) = | A B Z - Z D | / ( |A| |Z| n ulp )
00043 *>
00044 *> ITYPE = 3:  RESULT(1) = | B A Z - Z D | / ( |A| |Z| n ulp )
00045 *> \endverbatim
00046 *
00047 *  Arguments:
00048 *  ==========
00049 *
00050 *> \param[in] ITYPE
00051 *> \verbatim
00052 *>          ITYPE is INTEGER
00053 *>          The form of the symmetric generalized eigenproblem.
00054 *>          = 1:  A*z = (lambda)*B*z
00055 *>          = 2:  A*B*z = (lambda)*z
00056 *>          = 3:  B*A*z = (lambda)*z
00057 *> \endverbatim
00058 *>
00059 *> \param[in] UPLO
00060 *> \verbatim
00061 *>          UPLO is CHARACTER*1
00062 *>          Specifies whether the upper or lower triangular part of the
00063 *>          symmetric matrices A and B is stored.
00064 *>          = 'U':  Upper triangular
00065 *>          = 'L':  Lower triangular
00066 *> \endverbatim
00067 *>
00068 *> \param[in] N
00069 *> \verbatim
00070 *>          N is INTEGER
00071 *>          The order of the matrix A.  N >= 0.
00072 *> \endverbatim
00073 *>
00074 *> \param[in] M
00075 *> \verbatim
00076 *>          M is INTEGER
00077 *>          The number of eigenvalues found.  0 <= M <= N.
00078 *> \endverbatim
00079 *>
00080 *> \param[in] A
00081 *> \verbatim
00082 *>          A is REAL array, dimension (LDA, N)
00083 *>          The original symmetric matrix A.
00084 *> \endverbatim
00085 *>
00086 *> \param[in] LDA
00087 *> \verbatim
00088 *>          LDA is INTEGER
00089 *>          The leading dimension of the array A.  LDA >= max(1,N).
00090 *> \endverbatim
00091 *>
00092 *> \param[in] B
00093 *> \verbatim
00094 *>          B is REAL array, dimension (LDB, N)
00095 *>          The original symmetric positive definite matrix B.
00096 *> \endverbatim
00097 *>
00098 *> \param[in] LDB
00099 *> \verbatim
00100 *>          LDB is INTEGER
00101 *>          The leading dimension of the array B.  LDB >= max(1,N).
00102 *> \endverbatim
00103 *>
00104 *> \param[in] Z
00105 *> \verbatim
00106 *>          Z is REAL array, dimension (LDZ, M)
00107 *>          The computed eigenvectors of the generalized eigenproblem.
00108 *> \endverbatim
00109 *>
00110 *> \param[in] LDZ
00111 *> \verbatim
00112 *>          LDZ is INTEGER
00113 *>          The leading dimension of the array Z.  LDZ >= max(1,N).
00114 *> \endverbatim
00115 *>
00116 *> \param[in] D
00117 *> \verbatim
00118 *>          D is REAL array, dimension (M)
00119 *>          The computed eigenvalues of the generalized eigenproblem.
00120 *> \endverbatim
00121 *>
00122 *> \param[out] WORK
00123 *> \verbatim
00124 *>          WORK is REAL array, dimension (N*N)
00125 *> \endverbatim
00126 *>
00127 *> \param[out] RESULT
00128 *> \verbatim
00129 *>          RESULT is REAL array, dimension (1)
00130 *>          The test ratio as described above.
00131 *> \endverbatim
00132 *
00133 *  Authors:
00134 *  ========
00135 *
00136 *> \author Univ. of Tennessee 
00137 *> \author Univ. of California Berkeley 
00138 *> \author Univ. of Colorado Denver 
00139 *> \author NAG Ltd. 
00140 *
00141 *> \date November 2011
00142 *
00143 *> \ingroup single_eig
00144 *
00145 *  =====================================================================
00146       SUBROUTINE SSGT01( ITYPE, UPLO, N, M, A, LDA, B, LDB, Z, LDZ, D,
00147      $                   WORK, RESULT )
00148 *
00149 *  -- LAPACK test routine (version 3.4.0) --
00150 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00151 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00152 *     November 2011
00153 *
00154 *     .. Scalar Arguments ..
00155       CHARACTER          UPLO
00156       INTEGER            ITYPE, LDA, LDB, LDZ, M, N
00157 *     ..
00158 *     .. Array Arguments ..
00159       REAL               A( LDA, * ), B( LDB, * ), D( * ), RESULT( * ),
00160      $                   WORK( * ), Z( LDZ, * )
00161 *     ..
00162 *
00163 *  =====================================================================
00164 *
00165 *     .. Parameters ..
00166       REAL               ZERO, ONE
00167       PARAMETER          ( ZERO = 0.0E0, ONE = 1.0E0 )
00168 *     ..
00169 *     .. Local Scalars ..
00170       INTEGER            I
00171       REAL               ANORM, ULP
00172 *     ..
00173 *     .. External Functions ..
00174       REAL               SLAMCH, SLANGE, SLANSY
00175       EXTERNAL           SLAMCH, SLANGE, SLANSY
00176 *     ..
00177 *     .. External Subroutines ..
00178       EXTERNAL           SSCAL, SSYMM
00179 *     ..
00180 *     .. Executable Statements ..
00181 *
00182       RESULT( 1 ) = ZERO
00183       IF( N.LE.0 )
00184      $   RETURN
00185 *
00186       ULP = SLAMCH( 'Epsilon' )
00187 *
00188 *     Compute product of 1-norms of A and Z.
00189 *
00190       ANORM = SLANSY( '1', UPLO, N, A, LDA, WORK )*
00191      $        SLANGE( '1', N, M, Z, LDZ, WORK )
00192       IF( ANORM.EQ.ZERO )
00193      $   ANORM = ONE
00194 *
00195       IF( ITYPE.EQ.1 ) THEN
00196 *
00197 *        Norm of AZ - BZD
00198 *
00199          CALL SSYMM( 'Left', UPLO, N, M, ONE, A, LDA, Z, LDZ, ZERO,
00200      $               WORK, N )
00201          DO 10 I = 1, M
00202             CALL SSCAL( N, D( I ), Z( 1, I ), 1 )
00203    10    CONTINUE
00204          CALL SSYMM( 'Left', UPLO, N, M, ONE, B, LDB, Z, LDZ, -ONE,
00205      $               WORK, N )
00206 *
00207          RESULT( 1 ) = ( SLANGE( '1', N, M, WORK, N, WORK ) / ANORM ) /
00208      $                 ( N*ULP )
00209 *
00210       ELSE IF( ITYPE.EQ.2 ) THEN
00211 *
00212 *        Norm of ABZ - ZD
00213 *
00214          CALL SSYMM( 'Left', UPLO, N, M, ONE, B, LDB, Z, LDZ, ZERO,
00215      $               WORK, N )
00216          DO 20 I = 1, M
00217             CALL SSCAL( N, D( I ), Z( 1, I ), 1 )
00218    20    CONTINUE
00219          CALL SSYMM( 'Left', UPLO, N, M, ONE, A, LDA, WORK, N, -ONE, Z,
00220      $               LDZ )
00221 *
00222          RESULT( 1 ) = ( SLANGE( '1', N, M, Z, LDZ, WORK ) / ANORM ) /
00223      $                 ( N*ULP )
00224 *
00225       ELSE IF( ITYPE.EQ.3 ) THEN
00226 *
00227 *        Norm of BAZ - ZD
00228 *
00229          CALL SSYMM( 'Left', UPLO, N, M, ONE, A, LDA, Z, LDZ, ZERO,
00230      $               WORK, N )
00231          DO 30 I = 1, M
00232             CALL SSCAL( N, D( I ), Z( 1, I ), 1 )
00233    30    CONTINUE
00234          CALL SSYMM( 'Left', UPLO, N, M, ONE, B, LDB, WORK, N, -ONE, Z,
00235      $               LDZ )
00236 *
00237          RESULT( 1 ) = ( SLANGE( '1', N, M, Z, LDZ, WORK ) / ANORM ) /
00238      $                 ( N*ULP )
00239       END IF
00240 *
00241       RETURN
00242 *
00243 *     End of SSGT01
00244 *
00245       END
 All Files Functions