LAPACK 3.11.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
csgt01.f
Go to the documentation of this file.
1*> \brief \b CSGT01
2*
3* =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6* http://www.netlib.org/lapack/explore-html/
7*
8* Definition:
9* ===========
10*
11* SUBROUTINE CSGT01( ITYPE, UPLO, N, M, A, LDA, B, LDB, Z, LDZ, D,
12* WORK, RWORK, RESULT )
13*
14* .. Scalar Arguments ..
15* CHARACTER UPLO
16* INTEGER ITYPE, LDA, LDB, LDZ, M, N
17* ..
18* .. Array Arguments ..
19* REAL D( * ), RESULT( * ), RWORK( * )
20* COMPLEX A( LDA, * ), B( LDB, * ), WORK( * ),
21* $ Z( LDZ, * )
22* ..
23*
24*
25*> \par Purpose:
26* =============
27*>
28*> \verbatim
29*>
30*> CSGT01 checks a decomposition of the form
31*>
32*> A Z = B Z D or
33*> A B Z = Z D or
34*> B A Z = Z D
35*>
36*> where A is a Hermitian matrix, B is Hermitian positive definite,
37*> Z is unitary, and D is diagonal.
38*>
39*> One of the following test ratios is computed:
40*>
41*> ITYPE = 1: RESULT(1) = | A Z - B Z D | / ( |A| |Z| n ulp )
42*>
43*> ITYPE = 2: RESULT(1) = | A B Z - Z D | / ( |A| |Z| n ulp )
44*>
45*> ITYPE = 3: RESULT(1) = | B A Z - Z D | / ( |A| |Z| n ulp )
46*> \endverbatim
47*
48* Arguments:
49* ==========
50*
51*> \param[in] ITYPE
52*> \verbatim
53*> ITYPE is INTEGER
54*> The form of the Hermitian generalized eigenproblem.
55*> = 1: A*z = (lambda)*B*z
56*> = 2: A*B*z = (lambda)*z
57*> = 3: B*A*z = (lambda)*z
58*> \endverbatim
59*>
60*> \param[in] UPLO
61*> \verbatim
62*> UPLO is CHARACTER*1
63*> Specifies whether the upper or lower triangular part of the
64*> Hermitian matrices A and B is stored.
65*> = 'U': Upper triangular
66*> = 'L': Lower triangular
67*> \endverbatim
68*>
69*> \param[in] N
70*> \verbatim
71*> N is INTEGER
72*> The order of the matrix A. N >= 0.
73*> \endverbatim
74*>
75*> \param[in] M
76*> \verbatim
77*> M is INTEGER
78*> The number of eigenvalues found. M >= 0.
79*> \endverbatim
80*>
81*> \param[in] A
82*> \verbatim
83*> A is COMPLEX array, dimension (LDA, N)
84*> The original Hermitian matrix A.
85*> \endverbatim
86*>
87*> \param[in] LDA
88*> \verbatim
89*> LDA is INTEGER
90*> The leading dimension of the array A. LDA >= max(1,N).
91*> \endverbatim
92*>
93*> \param[in] B
94*> \verbatim
95*> B is COMPLEX array, dimension (LDB, N)
96*> The original Hermitian positive definite matrix B.
97*> \endverbatim
98*>
99*> \param[in] LDB
100*> \verbatim
101*> LDB is INTEGER
102*> The leading dimension of the array B. LDB >= max(1,N).
103*> \endverbatim
104*>
105*> \param[in] Z
106*> \verbatim
107*> Z is COMPLEX array, dimension (LDZ, M)
108*> The computed eigenvectors of the generalized eigenproblem.
109*> \endverbatim
110*>
111*> \param[in] LDZ
112*> \verbatim
113*> LDZ is INTEGER
114*> The leading dimension of the array Z. LDZ >= max(1,N).
115*> \endverbatim
116*>
117*> \param[in] D
118*> \verbatim
119*> D is REAL array, dimension (M)
120*> The computed eigenvalues of the generalized eigenproblem.
121*> \endverbatim
122*>
123*> \param[out] WORK
124*> \verbatim
125*> WORK is COMPLEX array, dimension (N*N)
126*> \endverbatim
127*>
128*> \param[out] RWORK
129*> \verbatim
130*> RWORK is REAL array, dimension (N)
131*> \endverbatim
132*>
133*> \param[out] RESULT
134*> \verbatim
135*> RESULT is REAL array, dimension (1)
136*> The test ratio as described above.
137*> \endverbatim
138*
139* Authors:
140* ========
141*
142*> \author Univ. of Tennessee
143*> \author Univ. of California Berkeley
144*> \author Univ. of Colorado Denver
145*> \author NAG Ltd.
146*
147*> \ingroup complex_eig
148*
149* =====================================================================
150 SUBROUTINE csgt01( ITYPE, UPLO, N, M, A, LDA, B, LDB, Z, LDZ, D,
151 $ WORK, RWORK, RESULT )
152*
153* -- LAPACK test routine --
154* -- LAPACK is a software package provided by Univ. of Tennessee, --
155* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
156*
157* .. Scalar Arguments ..
158 CHARACTER UPLO
159 INTEGER ITYPE, LDA, LDB, LDZ, M, N
160* ..
161* .. Array Arguments ..
162 REAL D( * ), RESULT( * ), RWORK( * )
163 COMPLEX A( LDA, * ), B( LDB, * ), WORK( * ),
164 $ z( ldz, * )
165* ..
166*
167* =====================================================================
168*
169* .. Parameters ..
170 REAL ZERO, ONE
171 parameter( zero = 0.0e+0, one = 1.0e+0 )
172 COMPLEX CZERO, CONE
173 parameter( czero = ( 0.0e+0, 0.0e+0 ),
174 $ cone = ( 1.0e+0, 0.0e+0 ) )
175* ..
176* .. Local Scalars ..
177 INTEGER I
178 REAL ANORM, ULP
179* ..
180* .. External Functions ..
181 REAL CLANGE, CLANHE, SLAMCH
182 EXTERNAL clange, clanhe, slamch
183* ..
184* .. External Subroutines ..
185 EXTERNAL chemm, csscal
186* ..
187* .. Executable Statements ..
188*
189 result( 1 ) = zero
190 IF( n.LE.0 )
191 $ RETURN
192*
193 ulp = slamch( 'Epsilon' )
194*
195* Compute product of 1-norms of A and Z.
196*
197 anorm = clanhe( '1', uplo, n, a, lda, rwork )*
198 $ clange( '1', n, m, z, ldz, rwork )
199 IF( anorm.EQ.zero )
200 $ anorm = one
201*
202 IF( itype.EQ.1 ) THEN
203*
204* Norm of AZ - BZD
205*
206 CALL chemm( 'Left', uplo, n, m, cone, a, lda, z, ldz, czero,
207 $ work, n )
208 DO 10 i = 1, m
209 CALL csscal( n, d( i ), z( 1, i ), 1 )
210 10 CONTINUE
211 CALL chemm( 'Left', uplo, n, m, cone, b, ldb, z, ldz, -cone,
212 $ work, n )
213*
214 result( 1 ) = ( clange( '1', n, m, work, n, rwork ) / anorm ) /
215 $ ( n*ulp )
216*
217 ELSE IF( itype.EQ.2 ) THEN
218*
219* Norm of ABZ - ZD
220*
221 CALL chemm( 'Left', uplo, n, m, cone, b, ldb, z, ldz, czero,
222 $ work, n )
223 DO 20 i = 1, m
224 CALL csscal( n, d( i ), z( 1, i ), 1 )
225 20 CONTINUE
226 CALL chemm( 'Left', uplo, n, m, cone, a, lda, work, n, -cone,
227 $ z, ldz )
228*
229 result( 1 ) = ( clange( '1', n, m, z, ldz, rwork ) / anorm ) /
230 $ ( n*ulp )
231*
232 ELSE IF( itype.EQ.3 ) THEN
233*
234* Norm of BAZ - ZD
235*
236 CALL chemm( 'Left', uplo, n, m, cone, a, lda, z, ldz, czero,
237 $ work, n )
238 DO 30 i = 1, m
239 CALL csscal( n, d( i ), z( 1, i ), 1 )
240 30 CONTINUE
241 CALL chemm( 'Left', uplo, n, m, cone, b, ldb, work, n, -cone,
242 $ z, ldz )
243*
244 result( 1 ) = ( clange( '1', n, m, z, ldz, rwork ) / anorm ) /
245 $ ( n*ulp )
246 END IF
247*
248 RETURN
249*
250* End of CSGT01
251*
252 END
subroutine csscal(N, SA, CX, INCX)
CSSCAL
Definition: csscal.f:78
subroutine chemm(SIDE, UPLO, M, N, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
CHEMM
Definition: chemm.f:191
subroutine csgt01(ITYPE, UPLO, N, M, A, LDA, B, LDB, Z, LDZ, D, WORK, RWORK, RESULT)
CSGT01
Definition: csgt01.f:152