1 SUBROUTINE DLAPLL( N, X, INCX, Y, INCY, SSMIN )
2 *
3 * -- LAPACK auxiliary routine (version 3.2) --
4 * -- LAPACK is a software package provided by Univ. of Tennessee, --
5 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
6 * November 2006
7 *
8 * .. Scalar Arguments ..
9 INTEGER INCX, INCY, N
10 DOUBLE PRECISION SSMIN
11 * ..
12 * .. Array Arguments ..
13 DOUBLE PRECISION X( * ), Y( * )
14 * ..
15 *
16 * Purpose
17 * =======
18 *
19 * Given two column vectors X and Y, let
20 *
21 * A = ( X Y ).
22 *
23 * The subroutine first computes the QR factorization of A = Q*R,
24 * and then computes the SVD of the 2-by-2 upper triangular matrix R.
25 * The smaller singular value of R is returned in SSMIN, which is used
26 * as the measurement of the linear dependency of the vectors X and Y.
27 *
28 * Arguments
29 * =========
30 *
31 * N (input) INTEGER
32 * The length of the vectors X and Y.
33 *
34 * X (input/output) DOUBLE PRECISION array,
35 * dimension (1+(N-1)*INCX)
36 * On entry, X contains the N-vector X.
37 * On exit, X is overwritten.
38 *
39 * INCX (input) INTEGER
40 * The increment between successive elements of X. INCX > 0.
41 *
42 * Y (input/output) DOUBLE PRECISION array,
43 * dimension (1+(N-1)*INCY)
44 * On entry, Y contains the N-vector Y.
45 * On exit, Y is overwritten.
46 *
47 * INCY (input) INTEGER
48 * The increment between successive elements of Y. INCY > 0.
49 *
50 * SSMIN (output) DOUBLE PRECISION
51 * The smallest singular value of the N-by-2 matrix A = ( X Y ).
52 *
53 * =====================================================================
54 *
55 * .. Parameters ..
56 DOUBLE PRECISION ZERO, ONE
57 PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
58 * ..
59 * .. Local Scalars ..
60 DOUBLE PRECISION A11, A12, A22, C, SSMAX, TAU
61 * ..
62 * .. External Functions ..
63 DOUBLE PRECISION DDOT
64 EXTERNAL DDOT
65 * ..
66 * .. External Subroutines ..
67 EXTERNAL DAXPY, DLARFG, DLAS2
68 * ..
69 * .. Executable Statements ..
70 *
71 * Quick return if possible
72 *
73 IF( N.LE.1 ) THEN
74 SSMIN = ZERO
75 RETURN
76 END IF
77 *
78 * Compute the QR factorization of the N-by-2 matrix ( X Y )
79 *
80 CALL DLARFG( N, X( 1 ), X( 1+INCX ), INCX, TAU )
81 A11 = X( 1 )
82 X( 1 ) = ONE
83 *
84 C = -TAU*DDOT( N, X, INCX, Y, INCY )
85 CALL DAXPY( N, C, X, INCX, Y, INCY )
86 *
87 CALL DLARFG( N-1, Y( 1+INCY ), Y( 1+2*INCY ), INCY, TAU )
88 *
89 A12 = Y( 1 )
90 A22 = Y( 1+INCY )
91 *
92 * Compute the SVD of 2-by-2 Upper triangular matrix.
93 *
94 CALL DLAS2( A11, A12, A22, SSMIN, SSMAX )
95 *
96 RETURN
97 *
98 * End of DLAPLL
99 *
100 END
2 *
3 * -- LAPACK auxiliary routine (version 3.2) --
4 * -- LAPACK is a software package provided by Univ. of Tennessee, --
5 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
6 * November 2006
7 *
8 * .. Scalar Arguments ..
9 INTEGER INCX, INCY, N
10 DOUBLE PRECISION SSMIN
11 * ..
12 * .. Array Arguments ..
13 DOUBLE PRECISION X( * ), Y( * )
14 * ..
15 *
16 * Purpose
17 * =======
18 *
19 * Given two column vectors X and Y, let
20 *
21 * A = ( X Y ).
22 *
23 * The subroutine first computes the QR factorization of A = Q*R,
24 * and then computes the SVD of the 2-by-2 upper triangular matrix R.
25 * The smaller singular value of R is returned in SSMIN, which is used
26 * as the measurement of the linear dependency of the vectors X and Y.
27 *
28 * Arguments
29 * =========
30 *
31 * N (input) INTEGER
32 * The length of the vectors X and Y.
33 *
34 * X (input/output) DOUBLE PRECISION array,
35 * dimension (1+(N-1)*INCX)
36 * On entry, X contains the N-vector X.
37 * On exit, X is overwritten.
38 *
39 * INCX (input) INTEGER
40 * The increment between successive elements of X. INCX > 0.
41 *
42 * Y (input/output) DOUBLE PRECISION array,
43 * dimension (1+(N-1)*INCY)
44 * On entry, Y contains the N-vector Y.
45 * On exit, Y is overwritten.
46 *
47 * INCY (input) INTEGER
48 * The increment between successive elements of Y. INCY > 0.
49 *
50 * SSMIN (output) DOUBLE PRECISION
51 * The smallest singular value of the N-by-2 matrix A = ( X Y ).
52 *
53 * =====================================================================
54 *
55 * .. Parameters ..
56 DOUBLE PRECISION ZERO, ONE
57 PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
58 * ..
59 * .. Local Scalars ..
60 DOUBLE PRECISION A11, A12, A22, C, SSMAX, TAU
61 * ..
62 * .. External Functions ..
63 DOUBLE PRECISION DDOT
64 EXTERNAL DDOT
65 * ..
66 * .. External Subroutines ..
67 EXTERNAL DAXPY, DLARFG, DLAS2
68 * ..
69 * .. Executable Statements ..
70 *
71 * Quick return if possible
72 *
73 IF( N.LE.1 ) THEN
74 SSMIN = ZERO
75 RETURN
76 END IF
77 *
78 * Compute the QR factorization of the N-by-2 matrix ( X Y )
79 *
80 CALL DLARFG( N, X( 1 ), X( 1+INCX ), INCX, TAU )
81 A11 = X( 1 )
82 X( 1 ) = ONE
83 *
84 C = -TAU*DDOT( N, X, INCX, Y, INCY )
85 CALL DAXPY( N, C, X, INCX, Y, INCY )
86 *
87 CALL DLARFG( N-1, Y( 1+INCY ), Y( 1+2*INCY ), INCY, TAU )
88 *
89 A12 = Y( 1 )
90 A22 = Y( 1+INCY )
91 *
92 * Compute the SVD of 2-by-2 Upper triangular matrix.
93 *
94 CALL DLAS2( A11, A12, A22, SSMIN, SSMAX )
95 *
96 RETURN
97 *
98 * End of DLAPLL
99 *
100 END