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