LAPACK  3.9.1
LAPACK: Linear Algebra PACKage

◆ 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 *
subroutine slacpy(UPLO, M, N, A, LDA, B, LDB)
SLACPY copies all or part of one two-dimensional array to another.
Definition: slacpy.f:103
subroutine slakf2(M, N, A, LDA, B, D, E, Z, LDZ)
SLAKF2
Definition: slakf2.f:105
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:211
Here is the call graph for this function:
Here is the caller graph for this function: