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

◆ dlatm6()

subroutine dlatm6 ( integer  TYPE,
integer  N,
double precision, dimension( lda, * )  A,
integer  LDA,
double precision, dimension( lda, * )  B,
double precision, dimension( ldx, * )  X,
integer  LDX,
double precision, dimension( ldy, * )  Y,
integer  LDY,
double precision  ALPHA,
double precision  BETA,
double precision  WX,
double precision  WY,
double precision, dimension( * )  S,
double precision, dimension( * )  DIF 
)

DLATM6

Purpose:
 DLATM6 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 DOUBLE PRECISION 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 DOUBLE PRECISION array, dimension (LDA, N).
          On exit B N-by-N is initialized according to TYPE.
[out]X
          X is DOUBLE PRECISION 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 DOUBLE PRECISION 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 DOUBLE PRECISION
[in]BETA
          BETA is DOUBLE PRECISION

          Weighting constants for matrix A.
[in]WX
          WX is DOUBLE PRECISION
          Constant for right eigenvector matrix.
[in]WY
          WY is DOUBLE PRECISION
          Constant for left eigenvector matrix.
[out]S
          S is DOUBLE PRECISION array, dimension (N)
          S(i) is the reciprocal condition number for eigenvalue i.
[out]DIF
          DIF is DOUBLE PRECISION 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 dlatm6.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 DOUBLE PRECISION ALPHA, BETA, WX, WY
184* ..
185* .. Array Arguments ..
186 DOUBLE PRECISION A( LDA, * ), B( LDA, * ), DIF( * ), S( * ),
187 $ X( LDX, * ), Y( LDY, * )
188* ..
189*
190* =====================================================================
191*
192* .. Parameters ..
193 DOUBLE PRECISION ZERO, ONE, TWO, THREE
194 parameter( zero = 0.0d+0, one = 1.0d+0, two = 2.0d+0,
195 $ three = 3.0d+0 )
196* ..
197* .. Local Scalars ..
198 INTEGER I, INFO, J
199* ..
200* .. Local Arrays ..
201 DOUBLE PRECISION WORK( 100 ), Z( 12, 12 )
202* ..
203* .. Intrinsic Functions ..
204 INTRINSIC dble, sqrt
205* ..
206* .. External Subroutines ..
207 EXTERNAL dgesvd, dlacpy, dlakf2
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 ) = dble( 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 dlacpy( '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 dlacpy( '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 dlakf2( 1, 4, a, lda, a( 2, 2 ), b, b( 2, 2 ), z, 12 )
295 CALL dgesvd( '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 dlakf2( 4, 1, a, lda, a( 5, 5 ), b, b( 5, 5 ), z, 12 )
300 CALL dgesvd( '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 dlakf2( 2, 3, a, lda, a( 3, 3 ), b, b( 3, 3 ), z, 12 )
315 CALL dgesvd( '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 dlakf2( 3, 2, a, lda, a( 4, 4 ), b, b( 4, 4 ), z, 12 )
320 CALL dgesvd( '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 DLATM6
329*
subroutine dlacpy(UPLO, M, N, A, LDA, B, LDB)
DLACPY copies all or part of one two-dimensional array to another.
Definition: dlacpy.f:103
subroutine dlakf2(M, N, A, LDA, B, D, E, Z, LDZ)
DLAKF2
Definition: dlakf2.f:105
subroutine dgesvd(JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, WORK, LWORK, INFO)
DGESVD computes the singular value decomposition (SVD) for GE matrices
Definition: dgesvd.f:211
Here is the call graph for this function:
Here is the caller graph for this function: