![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b DSGT01 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 DSGT01( 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 * DOUBLE PRECISION A( LDA, * ), B( LDB, * ), D( * ), RESULT( * ), 00020 * $ WORK( * ), Z( LDZ, * ) 00021 * .. 00022 * 00023 * 00024 *> \par Purpose: 00025 * ============= 00026 *> 00027 *> \verbatim 00028 *> 00029 *> DDGT01 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 DOUBLE PRECISION 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 DOUBLE PRECISION 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 DOUBLE PRECISION 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 DOUBLE PRECISION array, dimension (M) 00119 *> The computed eigenvalues of the generalized eigenproblem. 00120 *> \endverbatim 00121 *> 00122 *> \param[out] WORK 00123 *> \verbatim 00124 *> WORK is DOUBLE PRECISION array, dimension (N*N) 00125 *> \endverbatim 00126 *> 00127 *> \param[out] RESULT 00128 *> \verbatim 00129 *> RESULT is DOUBLE PRECISION 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 double_eig 00144 * 00145 * ===================================================================== 00146 SUBROUTINE DSGT01( 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 DOUBLE PRECISION A( LDA, * ), B( LDB, * ), D( * ), RESULT( * ), 00160 $ WORK( * ), Z( LDZ, * ) 00161 * .. 00162 * 00163 * ===================================================================== 00164 * 00165 * .. Parameters .. 00166 DOUBLE PRECISION ZERO, ONE 00167 PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 ) 00168 * .. 00169 * .. Local Scalars .. 00170 INTEGER I 00171 DOUBLE PRECISION ANORM, ULP 00172 * .. 00173 * .. External Functions .. 00174 DOUBLE PRECISION DLAMCH, DLANGE, DLANSY 00175 EXTERNAL DLAMCH, DLANGE, DLANSY 00176 * .. 00177 * .. External Subroutines .. 00178 EXTERNAL DSCAL, DSYMM 00179 * .. 00180 * .. Executable Statements .. 00181 * 00182 RESULT( 1 ) = ZERO 00183 IF( N.LE.0 ) 00184 $ RETURN 00185 * 00186 ULP = DLAMCH( 'Epsilon' ) 00187 * 00188 * Compute product of 1-norms of A and Z. 00189 * 00190 ANORM = DLANSY( '1', UPLO, N, A, LDA, WORK )* 00191 $ DLANGE( '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 DSYMM( 'Left', UPLO, N, M, ONE, A, LDA, Z, LDZ, ZERO, 00200 $ WORK, N ) 00201 DO 10 I = 1, M 00202 CALL DSCAL( N, D( I ), Z( 1, I ), 1 ) 00203 10 CONTINUE 00204 CALL DSYMM( 'Left', UPLO, N, M, ONE, B, LDB, Z, LDZ, -ONE, 00205 $ WORK, N ) 00206 * 00207 RESULT( 1 ) = ( DLANGE( '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 DSYMM( 'Left', UPLO, N, M, ONE, B, LDB, Z, LDZ, ZERO, 00215 $ WORK, N ) 00216 DO 20 I = 1, M 00217 CALL DSCAL( N, D( I ), Z( 1, I ), 1 ) 00218 20 CONTINUE 00219 CALL DSYMM( 'Left', UPLO, N, M, ONE, A, LDA, WORK, N, -ONE, Z, 00220 $ LDZ ) 00221 * 00222 RESULT( 1 ) = ( DLANGE( '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 DSYMM( 'Left', UPLO, N, M, ONE, A, LDA, Z, LDZ, ZERO, 00230 $ WORK, N ) 00231 DO 30 I = 1, M 00232 CALL DSCAL( N, D( I ), Z( 1, I ), 1 ) 00233 30 CONTINUE 00234 CALL DSYMM( 'Left', UPLO, N, M, ONE, B, LDB, WORK, N, -ONE, Z, 00235 $ LDZ ) 00236 * 00237 RESULT( 1 ) = ( DLANGE( '1', N, M, Z, LDZ, WORK ) / ANORM ) / 00238 $ ( N*ULP ) 00239 END IF 00240 * 00241 RETURN 00242 * 00243 * End of DDGT01 00244 * 00245 END