1 SUBROUTINE CSGT01( ITYPE, UPLO, N, M, A, LDA, B, LDB, Z, LDZ, D,
2 $ WORK, RWORK, RESULT )
3 *
4 * -- LAPACK test routine (version 3.1) --
5 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
6 * November 2006
7 *
8 * modified August 1997, a new parameter M is added to the calling
9 * sequence.
10 *
11 * .. Scalar Arguments ..
12 CHARACTER UPLO
13 INTEGER ITYPE, LDA, LDB, LDZ, M, N
14 * ..
15 * .. Array Arguments ..
16 REAL D( * ), RESULT( * ), RWORK( * )
17 COMPLEX A( LDA, * ), B( LDB, * ), WORK( * ),
18 $ Z( LDZ, * )
19 * ..
20 *
21 * Purpose
22 * =======
23 *
24 * CSGT01 checks a decomposition of the form
25 *
26 * A Z = B Z D or
27 * A B Z = Z D or
28 * B A Z = Z D
29 *
30 * where A is a Hermitian matrix, B is Hermitian positive definite,
31 * Z is unitary, and D is diagonal.
32 *
33 * One of the following test ratios is computed:
34 *
35 * ITYPE = 1: RESULT(1) = | A Z - B Z D | / ( |A| |Z| n ulp )
36 *
37 * ITYPE = 2: RESULT(1) = | A B Z - Z D | / ( |A| |Z| n ulp )
38 *
39 * ITYPE = 3: RESULT(1) = | B A Z - Z D | / ( |A| |Z| n ulp )
40 *
41 * Arguments
42 * =========
43 *
44 * ITYPE (input) INTEGER
45 * The form of the Hermitian generalized eigenproblem.
46 * = 1: A*z = (lambda)*B*z
47 * = 2: A*B*z = (lambda)*z
48 * = 3: B*A*z = (lambda)*z
49 *
50 * UPLO (input) CHARACTER*1
51 * Specifies whether the upper or lower triangular part of the
52 * Hermitian matrices A and B is stored.
53 * = 'U': Upper triangular
54 * = 'L': Lower triangular
55 *
56 * N (input) INTEGER
57 * The order of the matrix A. N >= 0.
58 *
59 * M (input) INTEGER
60 * The number of eigenvalues found. M >= 0.
61 *
62 * A (input) COMPLEX array, dimension (LDA, N)
63 * The original Hermitian matrix A.
64 *
65 * LDA (input) INTEGER
66 * The leading dimension of the array A. LDA >= max(1,N).
67 *
68 * B (input) COMPLEX array, dimension (LDB, N)
69 * The original Hermitian positive definite matrix B.
70 *
71 * LDB (input) INTEGER
72 * The leading dimension of the array B. LDB >= max(1,N).
73 *
74 * Z (input) COMPLEX array, dimension (LDZ, M)
75 * The computed eigenvectors of the generalized eigenproblem.
76 *
77 * LDZ (input) INTEGER
78 * The leading dimension of the array Z. LDZ >= max(1,N).
79 *
80 * D (input) REAL array, dimension (M)
81 * The computed eigenvalues of the generalized eigenproblem.
82 *
83 * WORK (workspace) COMPLEX array, dimension (N*N)
84 *
85 * RWORK (workspace) REAL array, dimension (N)
86 *
87 * RESULT (output) REAL array, dimension (1)
88 * The test ratio as described above.
89 *
90 * =====================================================================
91 *
92 * .. Parameters ..
93 REAL ZERO, ONE
94 PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 )
95 COMPLEX CZERO, CONE
96 PARAMETER ( CZERO = ( 0.0E+0, 0.0E+0 ),
97 $ CONE = ( 1.0E+0, 0.0E+0 ) )
98 * ..
99 * .. Local Scalars ..
100 INTEGER I
101 REAL ANORM, ULP
102 * ..
103 * .. External Functions ..
104 REAL CLANGE, CLANHE, SLAMCH
105 EXTERNAL CLANGE, CLANHE, SLAMCH
106 * ..
107 * .. External Subroutines ..
108 EXTERNAL CHEMM, CSSCAL
109 * ..
110 * .. Executable Statements ..
111 *
112 RESULT( 1 ) = ZERO
113 IF( N.LE.0 )
114 $ RETURN
115 *
116 ULP = SLAMCH( 'Epsilon' )
117 *
118 * Compute product of 1-norms of A and Z.
119 *
120 ANORM = CLANHE( '1', UPLO, N, A, LDA, RWORK )*
121 $ CLANGE( '1', N, M, Z, LDZ, RWORK )
122 IF( ANORM.EQ.ZERO )
123 $ ANORM = ONE
124 *
125 IF( ITYPE.EQ.1 ) THEN
126 *
127 * Norm of AZ - BZD
128 *
129 CALL CHEMM( 'Left', UPLO, N, M, CONE, A, LDA, Z, LDZ, CZERO,
130 $ WORK, N )
131 DO 10 I = 1, M
132 CALL CSSCAL( N, D( I ), Z( 1, I ), 1 )
133 10 CONTINUE
134 CALL CHEMM( 'Left', UPLO, N, M, CONE, B, LDB, Z, LDZ, -CONE,
135 $ WORK, N )
136 *
137 RESULT( 1 ) = ( CLANGE( '1', N, M, WORK, N, RWORK ) / ANORM ) /
138 $ ( N*ULP )
139 *
140 ELSE IF( ITYPE.EQ.2 ) THEN
141 *
142 * Norm of ABZ - ZD
143 *
144 CALL CHEMM( 'Left', UPLO, N, M, CONE, B, LDB, Z, LDZ, CZERO,
145 $ WORK, N )
146 DO 20 I = 1, M
147 CALL CSSCAL( N, D( I ), Z( 1, I ), 1 )
148 20 CONTINUE
149 CALL CHEMM( 'Left', UPLO, N, M, CONE, A, LDA, WORK, N, -CONE,
150 $ Z, LDZ )
151 *
152 RESULT( 1 ) = ( CLANGE( '1', N, M, Z, LDZ, RWORK ) / ANORM ) /
153 $ ( N*ULP )
154 *
155 ELSE IF( ITYPE.EQ.3 ) THEN
156 *
157 * Norm of BAZ - ZD
158 *
159 CALL CHEMM( 'Left', UPLO, N, M, CONE, A, LDA, Z, LDZ, CZERO,
160 $ WORK, N )
161 DO 30 I = 1, M
162 CALL CSSCAL( N, D( I ), Z( 1, I ), 1 )
163 30 CONTINUE
164 CALL CHEMM( 'Left', UPLO, N, M, CONE, B, LDB, WORK, N, -CONE,
165 $ Z, LDZ )
166 *
167 RESULT( 1 ) = ( CLANGE( '1', N, M, Z, LDZ, RWORK ) / ANORM ) /
168 $ ( N*ULP )
169 END IF
170 *
171 RETURN
172 *
173 * End of CSGT01
174 *
175 END
2 $ WORK, RWORK, RESULT )
3 *
4 * -- LAPACK test routine (version 3.1) --
5 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
6 * November 2006
7 *
8 * modified August 1997, a new parameter M is added to the calling
9 * sequence.
10 *
11 * .. Scalar Arguments ..
12 CHARACTER UPLO
13 INTEGER ITYPE, LDA, LDB, LDZ, M, N
14 * ..
15 * .. Array Arguments ..
16 REAL D( * ), RESULT( * ), RWORK( * )
17 COMPLEX A( LDA, * ), B( LDB, * ), WORK( * ),
18 $ Z( LDZ, * )
19 * ..
20 *
21 * Purpose
22 * =======
23 *
24 * CSGT01 checks a decomposition of the form
25 *
26 * A Z = B Z D or
27 * A B Z = Z D or
28 * B A Z = Z D
29 *
30 * where A is a Hermitian matrix, B is Hermitian positive definite,
31 * Z is unitary, and D is diagonal.
32 *
33 * One of the following test ratios is computed:
34 *
35 * ITYPE = 1: RESULT(1) = | A Z - B Z D | / ( |A| |Z| n ulp )
36 *
37 * ITYPE = 2: RESULT(1) = | A B Z - Z D | / ( |A| |Z| n ulp )
38 *
39 * ITYPE = 3: RESULT(1) = | B A Z - Z D | / ( |A| |Z| n ulp )
40 *
41 * Arguments
42 * =========
43 *
44 * ITYPE (input) INTEGER
45 * The form of the Hermitian generalized eigenproblem.
46 * = 1: A*z = (lambda)*B*z
47 * = 2: A*B*z = (lambda)*z
48 * = 3: B*A*z = (lambda)*z
49 *
50 * UPLO (input) CHARACTER*1
51 * Specifies whether the upper or lower triangular part of the
52 * Hermitian matrices A and B is stored.
53 * = 'U': Upper triangular
54 * = 'L': Lower triangular
55 *
56 * N (input) INTEGER
57 * The order of the matrix A. N >= 0.
58 *
59 * M (input) INTEGER
60 * The number of eigenvalues found. M >= 0.
61 *
62 * A (input) COMPLEX array, dimension (LDA, N)
63 * The original Hermitian matrix A.
64 *
65 * LDA (input) INTEGER
66 * The leading dimension of the array A. LDA >= max(1,N).
67 *
68 * B (input) COMPLEX array, dimension (LDB, N)
69 * The original Hermitian positive definite matrix B.
70 *
71 * LDB (input) INTEGER
72 * The leading dimension of the array B. LDB >= max(1,N).
73 *
74 * Z (input) COMPLEX array, dimension (LDZ, M)
75 * The computed eigenvectors of the generalized eigenproblem.
76 *
77 * LDZ (input) INTEGER
78 * The leading dimension of the array Z. LDZ >= max(1,N).
79 *
80 * D (input) REAL array, dimension (M)
81 * The computed eigenvalues of the generalized eigenproblem.
82 *
83 * WORK (workspace) COMPLEX array, dimension (N*N)
84 *
85 * RWORK (workspace) REAL array, dimension (N)
86 *
87 * RESULT (output) REAL array, dimension (1)
88 * The test ratio as described above.
89 *
90 * =====================================================================
91 *
92 * .. Parameters ..
93 REAL ZERO, ONE
94 PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 )
95 COMPLEX CZERO, CONE
96 PARAMETER ( CZERO = ( 0.0E+0, 0.0E+0 ),
97 $ CONE = ( 1.0E+0, 0.0E+0 ) )
98 * ..
99 * .. Local Scalars ..
100 INTEGER I
101 REAL ANORM, ULP
102 * ..
103 * .. External Functions ..
104 REAL CLANGE, CLANHE, SLAMCH
105 EXTERNAL CLANGE, CLANHE, SLAMCH
106 * ..
107 * .. External Subroutines ..
108 EXTERNAL CHEMM, CSSCAL
109 * ..
110 * .. Executable Statements ..
111 *
112 RESULT( 1 ) = ZERO
113 IF( N.LE.0 )
114 $ RETURN
115 *
116 ULP = SLAMCH( 'Epsilon' )
117 *
118 * Compute product of 1-norms of A and Z.
119 *
120 ANORM = CLANHE( '1', UPLO, N, A, LDA, RWORK )*
121 $ CLANGE( '1', N, M, Z, LDZ, RWORK )
122 IF( ANORM.EQ.ZERO )
123 $ ANORM = ONE
124 *
125 IF( ITYPE.EQ.1 ) THEN
126 *
127 * Norm of AZ - BZD
128 *
129 CALL CHEMM( 'Left', UPLO, N, M, CONE, A, LDA, Z, LDZ, CZERO,
130 $ WORK, N )
131 DO 10 I = 1, M
132 CALL CSSCAL( N, D( I ), Z( 1, I ), 1 )
133 10 CONTINUE
134 CALL CHEMM( 'Left', UPLO, N, M, CONE, B, LDB, Z, LDZ, -CONE,
135 $ WORK, N )
136 *
137 RESULT( 1 ) = ( CLANGE( '1', N, M, WORK, N, RWORK ) / ANORM ) /
138 $ ( N*ULP )
139 *
140 ELSE IF( ITYPE.EQ.2 ) THEN
141 *
142 * Norm of ABZ - ZD
143 *
144 CALL CHEMM( 'Left', UPLO, N, M, CONE, B, LDB, Z, LDZ, CZERO,
145 $ WORK, N )
146 DO 20 I = 1, M
147 CALL CSSCAL( N, D( I ), Z( 1, I ), 1 )
148 20 CONTINUE
149 CALL CHEMM( 'Left', UPLO, N, M, CONE, A, LDA, WORK, N, -CONE,
150 $ Z, LDZ )
151 *
152 RESULT( 1 ) = ( CLANGE( '1', N, M, Z, LDZ, RWORK ) / ANORM ) /
153 $ ( N*ULP )
154 *
155 ELSE IF( ITYPE.EQ.3 ) THEN
156 *
157 * Norm of BAZ - ZD
158 *
159 CALL CHEMM( 'Left', UPLO, N, M, CONE, A, LDA, Z, LDZ, CZERO,
160 $ WORK, N )
161 DO 30 I = 1, M
162 CALL CSSCAL( N, D( I ), Z( 1, I ), 1 )
163 30 CONTINUE
164 CALL CHEMM( 'Left', UPLO, N, M, CONE, B, LDB, WORK, N, -CONE,
165 $ Z, LDZ )
166 *
167 RESULT( 1 ) = ( CLANGE( '1', N, M, Z, LDZ, RWORK ) / ANORM ) /
168 $ ( N*ULP )
169 END IF
170 *
171 RETURN
172 *
173 * End of CSGT01
174 *
175 END