LAPACK 3.12.1
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ slatm6()

subroutine slatm6 ( integer type,
integer n,
real, dimension( lda, * ) a,
integer lda,
real, dimension( lda, * ) b,
real, dimension( ldx, * ) x,
integer ldx,
real, dimension( ldy, * ) y,
integer ldy,
real alpha,
real beta,
real wx,
real wy,
real, dimension( * ) s,
real, dimension( * ) dif )

SLATM6

Purpose:
!>
!> SLATM6 generates test matrices for the generalized eigenvalue
!> problem, their corresponding right and left eigenvector matrices,
!> and also reciprocal condition numbers for all eigenvalues and
!> the reciprocal condition numbers of eigenvectors corresponding to
!> the 1th and 5th eigenvalues.
!>
!> Test Matrices
!> =============
!>
!> Two kinds of test matrix pairs
!>
!>       (A, B) = inverse(YH) * (Da, Db) * inverse(X)
!>
!> are used in the tests:
!>
!> Type 1:
!>    Da = 1+a   0    0    0    0    Db = 1   0   0   0   0
!>          0   2+a   0    0    0         0   1   0   0   0
!>          0    0   3+a   0    0         0   0   1   0   0
!>          0    0    0   4+a   0         0   0   0   1   0
!>          0    0    0    0   5+a ,      0   0   0   0   1 , and
!>
!> Type 2:
!>    Da =  1   -1    0    0    0    Db = 1   0   0   0   0
!>          1    1    0    0    0         0   1   0   0   0
!>          0    0    1    0    0         0   0   1   0   0
!>          0    0    0   1+a  1+b        0   0   0   1   0
!>          0    0    0  -1-b  1+a ,      0   0   0   0   1 .
!>
!> In both cases the same inverse(YH) and inverse(X) are used to compute
!> (A, B), giving the exact eigenvectors to (A,B) as (YH, X):
!>
!> YH:  =  1    0   -y    y   -y    X =  1   0  -x  -x   x
!>         0    1   -y    y   -y         0   1   x  -x  -x
!>         0    0    1    0    0         0   0   1   0   0
!>         0    0    0    1    0         0   0   0   1   0
!>         0    0    0    0    1,        0   0   0   0   1 ,
!>
!> where a, b, x and y will have all values independently of each other.
!>
Parameters
[in]TYPE
!>          TYPE is INTEGER
!>          Specifies the problem type (see further details).
!>
[in]N
!>          N is INTEGER
!>          Size of the matrices A and B.
!>
[out]A
!>          A is REAL array, dimension (LDA, N).
!>          On exit A N-by-N is initialized according to TYPE.
!>
[in]LDA
!>          LDA is INTEGER
!>          The leading dimension of A and of B.
!>
[out]B
!>          B is REAL array, dimension (LDA, N).
!>          On exit B N-by-N is initialized according to TYPE.
!>
[out]X
!>          X is REAL array, dimension (LDX, N).
!>          On exit X is the N-by-N matrix of right eigenvectors.
!>
[in]LDX
!>          LDX is INTEGER
!>          The leading dimension of X.
!>
[out]Y
!>          Y is REAL array, dimension (LDY, N).
!>          On exit Y is the N-by-N matrix of left eigenvectors.
!>
[in]LDY
!>          LDY is INTEGER
!>          The leading dimension of Y.
!>
[in]ALPHA
!>          ALPHA is REAL
!>
[in]BETA
!>          BETA is REAL
!>
!>          Weighting constants for matrix A.
!>
[in]WX
!>          WX is REAL
!>          Constant for right eigenvector matrix.
!>
[in]WY
!>          WY is REAL
!>          Constant for left eigenvector matrix.
!>
[out]S
!>          S is REAL array, dimension (N)
!>          S(i) is the reciprocal condition number for eigenvalue i.
!>
[out]DIF
!>          DIF is REAL array, dimension (N)
!>          DIF(i) is the reciprocal condition number for eigenvector i.
!>
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.

Definition at line 174 of file slatm6.f.

176*
177* -- LAPACK computational routine --
178* -- LAPACK is a software package provided by Univ. of Tennessee, --
179* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
180*
181* .. Scalar Arguments ..
182 INTEGER LDA, LDX, LDY, N, TYPE
183 REAL ALPHA, BETA, WX, WY
184* ..
185* .. Array Arguments ..
186 REAL A( LDA, * ), B( LDA, * ), DIF( * ), S( * ),
187 $ X( LDX, * ), Y( LDY, * )
188* ..
189*
190* =====================================================================
191*
192* .. Parameters ..
193 REAL ZERO, ONE, TWO, THREE
194 parameter( zero = 0.0e+0, one = 1.0e+0, two = 2.0e+0,
195 $ three = 3.0e+0 )
196* ..
197* .. Local Scalars ..
198 INTEGER I, INFO, J
199* ..
200* .. Local Arrays ..
201 REAL WORK( 100 ), Z( 12, 12 )
202* ..
203* .. Intrinsic Functions ..
204 INTRINSIC real, sqrt
205* ..
206* .. External Subroutines ..
207 EXTERNAL sgesvd, slacpy, slakf2
208* ..
209* .. Executable Statements ..
210*
211* Generate test problem ...
212* (Da, Db) ...
213*
214 DO 20 i = 1, n
215 DO 10 j = 1, n
216*
217 IF( i.EQ.j ) THEN
218 a( i, i ) = real( i ) + alpha
219 b( i, i ) = one
220 ELSE
221 a( i, j ) = zero
222 b( i, j ) = zero
223 END IF
224*
225 10 CONTINUE
226 20 CONTINUE
227*
228* Form X and Y
229*
230 CALL slacpy( 'F', n, n, b, lda, y, ldy )
231 y( 3, 1 ) = -wy
232 y( 4, 1 ) = wy
233 y( 5, 1 ) = -wy
234 y( 3, 2 ) = -wy
235 y( 4, 2 ) = wy
236 y( 5, 2 ) = -wy
237*
238 CALL slacpy( 'F', n, n, b, lda, x, ldx )
239 x( 1, 3 ) = -wx
240 x( 1, 4 ) = -wx
241 x( 1, 5 ) = wx
242 x( 2, 3 ) = wx
243 x( 2, 4 ) = -wx
244 x( 2, 5 ) = -wx
245*
246* Form (A, B)
247*
248 b( 1, 3 ) = wx + wy
249 b( 2, 3 ) = -wx + wy
250 b( 1, 4 ) = wx - wy
251 b( 2, 4 ) = wx - wy
252 b( 1, 5 ) = -wx + wy
253 b( 2, 5 ) = wx + wy
254 IF( type.EQ.1 ) THEN
255 a( 1, 3 ) = wx*a( 1, 1 ) + wy*a( 3, 3 )
256 a( 2, 3 ) = -wx*a( 2, 2 ) + wy*a( 3, 3 )
257 a( 1, 4 ) = wx*a( 1, 1 ) - wy*a( 4, 4 )
258 a( 2, 4 ) = wx*a( 2, 2 ) - wy*a( 4, 4 )
259 a( 1, 5 ) = -wx*a( 1, 1 ) + wy*a( 5, 5 )
260 a( 2, 5 ) = wx*a( 2, 2 ) + wy*a( 5, 5 )
261 ELSE IF( type.EQ.2 ) THEN
262 a( 1, 3 ) = two*wx + wy
263 a( 2, 3 ) = wy
264 a( 1, 4 ) = -wy*( two+alpha+beta )
265 a( 2, 4 ) = two*wx - wy*( two+alpha+beta )
266 a( 1, 5 ) = -two*wx + wy*( alpha-beta )
267 a( 2, 5 ) = wy*( alpha-beta )
268 a( 1, 1 ) = one
269 a( 1, 2 ) = -one
270 a( 2, 1 ) = one
271 a( 2, 2 ) = a( 1, 1 )
272 a( 3, 3 ) = one
273 a( 4, 4 ) = one + alpha
274 a( 4, 5 ) = one + beta
275 a( 5, 4 ) = -a( 4, 5 )
276 a( 5, 5 ) = a( 4, 4 )
277 END IF
278*
279* Compute condition numbers
280*
281 IF( type.EQ.1 ) THEN
282*
283 s( 1 ) = one / sqrt( ( one+three*wy*wy ) /
284 $ ( one+a( 1, 1 )*a( 1, 1 ) ) )
285 s( 2 ) = one / sqrt( ( one+three*wy*wy ) /
286 $ ( one+a( 2, 2 )*a( 2, 2 ) ) )
287 s( 3 ) = one / sqrt( ( one+two*wx*wx ) /
288 $ ( one+a( 3, 3 )*a( 3, 3 ) ) )
289 s( 4 ) = one / sqrt( ( one+two*wx*wx ) /
290 $ ( one+a( 4, 4 )*a( 4, 4 ) ) )
291 s( 5 ) = one / sqrt( ( one+two*wx*wx ) /
292 $ ( one+a( 5, 5 )*a( 5, 5 ) ) )
293*
294 CALL slakf2( 1, 4, a, lda, a( 2, 2 ), b, b( 2, 2 ), z, 12 )
295 CALL sgesvd( 'N', 'N', 8, 8, z, 12, work, work( 9 ), 1,
296 $ work( 10 ), 1, work( 11 ), 40, info )
297 dif( 1 ) = work( 8 )
298*
299 CALL slakf2( 4, 1, a, lda, a( 5, 5 ), b, b( 5, 5 ), z, 12 )
300 CALL sgesvd( 'N', 'N', 8, 8, z, 12, work, work( 9 ), 1,
301 $ work( 10 ), 1, work( 11 ), 40, info )
302 dif( 5 ) = work( 8 )
303*
304 ELSE IF( type.EQ.2 ) THEN
305*
306 s( 1 ) = one / sqrt( one / three+wy*wy )
307 s( 2 ) = s( 1 )
308 s( 3 ) = one / sqrt( one / two+wx*wx )
309 s( 4 ) = one / sqrt( ( one+two*wx*wx ) /
310 $ ( one+( one+alpha )*( one+alpha )+( one+beta )*( one+
311 $ beta ) ) )
312 s( 5 ) = s( 4 )
313*
314 CALL slakf2( 2, 3, a, lda, a( 3, 3 ), b, b( 3, 3 ), z, 12 )
315 CALL sgesvd( 'N', 'N', 12, 12, z, 12, work, work( 13 ), 1,
316 $ work( 14 ), 1, work( 15 ), 60, info )
317 dif( 1 ) = work( 12 )
318*
319 CALL slakf2( 3, 2, a, lda, a( 4, 4 ), b, b( 4, 4 ), z, 12 )
320 CALL sgesvd( 'N', 'N', 12, 12, z, 12, work, work( 13 ), 1,
321 $ work( 14 ), 1, work( 15 ), 60, info )
322 dif( 5 ) = work( 12 )
323*
324 END IF
325*
326 RETURN
327*
328* End of SLATM6
329*
sgesvd
subroutine sgesvd(jobu, jobvt, m, n, a, lda, s, u, ldu, vt, ldvt, work, lwork, info)
SGESVD computes the singular value decomposition (SVD) for GE matrices
Definition sgesvd.f:210
slacpy
subroutine slacpy(uplo, m, n, a, lda, b, ldb)
SLACPY copies all or part of one two-dimensional array to another.
Definition slacpy.f:101
slakf2
subroutine slakf2(m, n, a, lda, b, d, e, z, ldz)
SLAKF2
Definition slakf2.f:105
Here is the call graph for this function:
Here is the caller graph for this function: