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