|
LAPACK 3.3.0
|
|
LAPACK 3.3.0
|
00001 SUBROUTINE ZSGT01( ITYPE, UPLO, N, M, A, LDA, B, LDB, Z, LDZ, D, 00002 $ WORK, RWORK, RESULT ) 00003 * 00004 * -- LAPACK test routine (version 3.1) -- 00005 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. 00006 * November 2006 00007 * 00008 * modified August 1997, a new parameter M is added to the calling 00009 * sequence. 00010 * 00011 * .. Scalar Arguments .. 00012 CHARACTER UPLO 00013 INTEGER ITYPE, LDA, LDB, LDZ, M, N 00014 * .. 00015 * .. Array Arguments .. 00016 DOUBLE PRECISION D( * ), RESULT( * ), RWORK( * ) 00017 COMPLEX*16 A( LDA, * ), B( LDB, * ), WORK( * ), 00018 $ Z( LDZ, * ) 00019 * .. 00020 * 00021 * Purpose 00022 * ======= 00023 * 00024 * CDGT01 checks a decomposition of the form 00025 * 00026 * A Z = B Z D or 00027 * A B Z = Z D or 00028 * B A Z = Z D 00029 * 00030 * where A is a Hermitian matrix, B is Hermitian positive definite, 00031 * Z is unitary, and D is diagonal. 00032 * 00033 * One of the following test ratios is computed: 00034 * 00035 * ITYPE = 1: RESULT(1) = | A Z - B Z D | / ( |A| |Z| n ulp ) 00036 * 00037 * ITYPE = 2: RESULT(1) = | A B Z - Z D | / ( |A| |Z| n ulp ) 00038 * 00039 * ITYPE = 3: RESULT(1) = | B A Z - Z D | / ( |A| |Z| n ulp ) 00040 * 00041 * Arguments 00042 * ========= 00043 * 00044 * ITYPE (input) INTEGER 00045 * The form of the Hermitian generalized eigenproblem. 00046 * = 1: A*z = (lambda)*B*z 00047 * = 2: A*B*z = (lambda)*z 00048 * = 3: B*A*z = (lambda)*z 00049 * 00050 * UPLO (input) CHARACTER*1 00051 * Specifies whether the upper or lower triangular part of the 00052 * Hermitian matrices A and B is stored. 00053 * = 'U': Upper triangular 00054 * = 'L': Lower triangular 00055 * 00056 * N (input) INTEGER 00057 * The order of the matrix A. N >= 0. 00058 * 00059 * M (input) INTEGER 00060 * The number of eigenvalues found. M >= 0. 00061 * 00062 * A (input) COMPLEX*16 array, dimension (LDA, N) 00063 * The original Hermitian matrix A. 00064 * 00065 * LDA (input) INTEGER 00066 * The leading dimension of the array A. LDA >= max(1,N). 00067 * 00068 * B (input) COMPLEX*16 array, dimension (LDB, N) 00069 * The original Hermitian positive definite matrix B. 00070 * 00071 * LDB (input) INTEGER 00072 * The leading dimension of the array B. LDB >= max(1,N). 00073 * 00074 * Z (input) COMPLEX*16 array, dimension (LDZ, M) 00075 * The computed eigenvectors of the generalized eigenproblem. 00076 * 00077 * LDZ (input) INTEGER 00078 * The leading dimension of the array Z. LDZ >= max(1,N). 00079 * 00080 * D (input) DOUBLE PRECISION array, dimension (M) 00081 * The computed eigenvalues of the generalized eigenproblem. 00082 * 00083 * WORK (workspace) COMPLEX*16 array, dimension (N*N) 00084 * 00085 * RWORK (workspace) DOUBLE PRECISION array, dimension (N) 00086 * 00087 * RESULT (output) DOUBLE PRECISION array, dimension (1) 00088 * The test ratio as described above. 00089 * 00090 * ===================================================================== 00091 * 00092 * .. Parameters .. 00093 DOUBLE PRECISION ZERO, ONE 00094 PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 ) 00095 COMPLEX*16 CZERO, CONE 00096 PARAMETER ( CZERO = ( 0.0D+0, 0.0D+0 ), 00097 $ CONE = ( 1.0D+0, 0.0D+0 ) ) 00098 * .. 00099 * .. Local Scalars .. 00100 INTEGER I 00101 DOUBLE PRECISION ANORM, ULP 00102 * .. 00103 * .. External Functions .. 00104 DOUBLE PRECISION DLAMCH, ZLANGE, ZLANHE 00105 EXTERNAL DLAMCH, ZLANGE, ZLANHE 00106 * .. 00107 * .. External Subroutines .. 00108 EXTERNAL ZDSCAL, ZHEMM 00109 * .. 00110 * .. Executable Statements .. 00111 * 00112 RESULT( 1 ) = ZERO 00113 IF( N.LE.0 ) 00114 $ RETURN 00115 * 00116 ULP = DLAMCH( 'Epsilon' ) 00117 * 00118 * Compute product of 1-norms of A and Z. 00119 * 00120 ANORM = ZLANHE( '1', UPLO, N, A, LDA, RWORK )* 00121 $ ZLANGE( '1', N, M, Z, LDZ, RWORK ) 00122 IF( ANORM.EQ.ZERO ) 00123 $ ANORM = ONE 00124 * 00125 IF( ITYPE.EQ.1 ) THEN 00126 * 00127 * Norm of AZ - BZD 00128 * 00129 CALL ZHEMM( 'Left', UPLO, N, M, CONE, A, LDA, Z, LDZ, CZERO, 00130 $ WORK, N ) 00131 DO 10 I = 1, M 00132 CALL ZDSCAL( N, D( I ), Z( 1, I ), 1 ) 00133 10 CONTINUE 00134 CALL ZHEMM( 'Left', UPLO, N, M, CONE, B, LDB, Z, LDZ, -CONE, 00135 $ WORK, N ) 00136 * 00137 RESULT( 1 ) = ( ZLANGE( '1', N, M, WORK, N, RWORK ) / ANORM ) / 00138 $ ( N*ULP ) 00139 * 00140 ELSE IF( ITYPE.EQ.2 ) THEN 00141 * 00142 * Norm of ABZ - ZD 00143 * 00144 CALL ZHEMM( 'Left', UPLO, N, M, CONE, B, LDB, Z, LDZ, CZERO, 00145 $ WORK, N ) 00146 DO 20 I = 1, M 00147 CALL ZDSCAL( N, D( I ), Z( 1, I ), 1 ) 00148 20 CONTINUE 00149 CALL ZHEMM( 'Left', UPLO, N, M, CONE, A, LDA, WORK, N, -CONE, 00150 $ Z, LDZ ) 00151 * 00152 RESULT( 1 ) = ( ZLANGE( '1', N, M, Z, LDZ, RWORK ) / ANORM ) / 00153 $ ( N*ULP ) 00154 * 00155 ELSE IF( ITYPE.EQ.3 ) THEN 00156 * 00157 * Norm of BAZ - ZD 00158 * 00159 CALL ZHEMM( 'Left', UPLO, N, M, CONE, A, LDA, Z, LDZ, CZERO, 00160 $ WORK, N ) 00161 DO 30 I = 1, M 00162 CALL ZDSCAL( N, D( I ), Z( 1, I ), 1 ) 00163 30 CONTINUE 00164 CALL ZHEMM( 'Left', UPLO, N, M, CONE, B, LDB, WORK, N, -CONE, 00165 $ Z, LDZ ) 00166 * 00167 RESULT( 1 ) = ( ZLANGE( '1', N, M, Z, LDZ, RWORK ) / ANORM ) / 00168 $ ( N*ULP ) 00169 END IF 00170 * 00171 RETURN 00172 * 00173 * End of CDGT01 00174 * 00175 END
1.7.3 
