LAPACK  3.4.2
LAPACK: Linear Algebra PACKage
 All Files Functions Groups
zsgt01.f
Go to the documentation of this file.
1 *> \brief \b ZSGT01
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 ZSGT01( 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 * DOUBLE PRECISION D( * ), RESULT( * ), RWORK( * )
20 * COMPLEX*16 A( LDA, * ), B( LDB, * ), WORK( * ),
21 * $ Z( LDZ, * )
22 * ..
23 *
24 *
25 *> \par Purpose:
26 * =============
27 *>
28 *> \verbatim
29 *>
30 *> CDGT01 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*16 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*16 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*16 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 DOUBLE PRECISION array, dimension (M)
120 *> The computed eigenvalues of the generalized eigenproblem.
121 *> \endverbatim
122 *>
123 *> \param[out] WORK
124 *> \verbatim
125 *> WORK is COMPLEX*16 array, dimension (N*N)
126 *> \endverbatim
127 *>
128 *> \param[out] RWORK
129 *> \verbatim
130 *> RWORK is DOUBLE PRECISION array, dimension (N)
131 *> \endverbatim
132 *>
133 *> \param[out] RESULT
134 *> \verbatim
135 *> RESULT is DOUBLE PRECISION 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 *> \date November 2011
148 *
149 *> \ingroup complex16_eig
150 *
151 * =====================================================================
152  SUBROUTINE zsgt01( ITYPE, UPLO, N, M, A, LDA, B, LDB, Z, LDZ, D,
153  $ work, rwork, result )
154 *
155 * -- LAPACK test routine (version 3.4.0) --
156 * -- LAPACK is a software package provided by Univ. of Tennessee, --
157 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
158 * November 2011
159 *
160 * .. Scalar Arguments ..
161  CHARACTER uplo
162  INTEGER itype, lda, ldb, ldz, m, n
163 * ..
164 * .. Array Arguments ..
165  DOUBLE PRECISION d( * ), result( * ), rwork( * )
166  COMPLEX*16 a( lda, * ), b( ldb, * ), work( * ),
167  $ z( ldz, * )
168 * ..
169 *
170 * =====================================================================
171 *
172 * .. Parameters ..
173  DOUBLE PRECISION zero, one
174  parameter( zero = 0.0d+0, one = 1.0d+0 )
175  COMPLEX*16 czero, cone
176  parameter( czero = ( 0.0d+0, 0.0d+0 ),
177  $ cone = ( 1.0d+0, 0.0d+0 ) )
178 * ..
179 * .. Local Scalars ..
180  INTEGER i
181  DOUBLE PRECISION anorm, ulp
182 * ..
183 * .. External Functions ..
184  DOUBLE PRECISION dlamch, zlange, zlanhe
185  EXTERNAL dlamch, zlange, zlanhe
186 * ..
187 * .. External Subroutines ..
188  EXTERNAL zdscal, zhemm
189 * ..
190 * .. Executable Statements ..
191 *
192  result( 1 ) = zero
193  IF( n.LE.0 )
194  $ return
195 *
196  ulp = dlamch( 'Epsilon' )
197 *
198 * Compute product of 1-norms of A and Z.
199 *
200  anorm = zlanhe( '1', uplo, n, a, lda, rwork )*
201  $ zlange( '1', n, m, z, ldz, rwork )
202  IF( anorm.EQ.zero )
203  $ anorm = one
204 *
205  IF( itype.EQ.1 ) THEN
206 *
207 * Norm of AZ - BZD
208 *
209  CALL zhemm( 'Left', uplo, n, m, cone, a, lda, z, ldz, czero,
210  $ work, n )
211  DO 10 i = 1, m
212  CALL zdscal( n, d( i ), z( 1, i ), 1 )
213  10 continue
214  CALL zhemm( 'Left', uplo, n, m, cone, b, ldb, z, ldz, -cone,
215  $ work, n )
216 *
217  result( 1 ) = ( zlange( '1', n, m, work, n, rwork ) / anorm ) /
218  $ ( n*ulp )
219 *
220  ELSE IF( itype.EQ.2 ) THEN
221 *
222 * Norm of ABZ - ZD
223 *
224  CALL zhemm( 'Left', uplo, n, m, cone, b, ldb, z, ldz, czero,
225  $ work, n )
226  DO 20 i = 1, m
227  CALL zdscal( n, d( i ), z( 1, i ), 1 )
228  20 continue
229  CALL zhemm( 'Left', uplo, n, m, cone, a, lda, work, n, -cone,
230  $ z, ldz )
231 *
232  result( 1 ) = ( zlange( '1', n, m, z, ldz, rwork ) / anorm ) /
233  $ ( n*ulp )
234 *
235  ELSE IF( itype.EQ.3 ) THEN
236 *
237 * Norm of BAZ - ZD
238 *
239  CALL zhemm( 'Left', uplo, n, m, cone, a, lda, z, ldz, czero,
240  $ work, n )
241  DO 30 i = 1, m
242  CALL zdscal( n, d( i ), z( 1, i ), 1 )
243  30 continue
244  CALL zhemm( 'Left', uplo, n, m, cone, b, ldb, work, n, -cone,
245  $ z, ldz )
246 *
247  result( 1 ) = ( zlange( '1', n, m, z, ldz, rwork ) / anorm ) /
248  $ ( n*ulp )
249  END IF
250 *
251  return
252 *
253 * End of CDGT01
254 *
255  END