df/d11/slapll_8f_source.html

00001       SUBROUTINE SLAPLL( N, X, INCX, Y, INCY, SSMIN )
00002 *
00003 *  -- LAPACK auxiliary routine (version 3.2) --
00004 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00005 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00006 *     November 2006
00007 *
00008 *     .. Scalar Arguments ..
00009       INTEGER            INCX, INCY, N
00010       REAL               SSMIN
00011 *     ..
00012 *     .. Array Arguments ..
00013       REAL               X( * ), Y( * )
00014 *     ..
00015 *
00016 *  Purpose
00017 *  =======
00018 *
00019 *  Given two column vectors X and Y, let
00020 *
00021 *                       A = ( X Y ).
00022 *
00023 *  The subroutine first computes the QR factorization of A = Q*R,
00024 *  and then computes the SVD of the 2-by-2 upper triangular matrix R.
00025 *  The smaller singular value of R is returned in SSMIN, which is used
00026 *  as the measurement of the linear dependency of the vectors X and Y.
00027 *
00028 *  Arguments
00029 *  =========
00030 *
00031 *  N       (input) INTEGER
00032 *          The length of the vectors X and Y.
00033 *
00034 *  X       (input/output) REAL array,
00035 *                         dimension (1+(N-1)*INCX)
00036 *          On entry, X contains the N-vector X.
00037 *          On exit, X is overwritten.
00038 *
00039 *  INCX    (input) INTEGER
00040 *          The increment between successive elements of X. INCX > 0.
00041 *
00042 *  Y       (input/output) REAL array,
00043 *                         dimension (1+(N-1)*INCY)
00044 *          On entry, Y contains the N-vector Y.
00045 *          On exit, Y is overwritten.
00046 *
00047 *  INCY    (input) INTEGER
00048 *          The increment between successive elements of Y. INCY > 0.
00049 *
00050 *  SSMIN   (output) REAL
00051 *          The smallest singular value of the N-by-2 matrix A = ( X Y ).
00052 *
00053 *  =====================================================================
00054 *
00055 *     .. Parameters ..
00056       REAL               ZERO, ONE
00057       PARAMETER          ( ZERO = 0.0E+0, ONE = 1.0E+0 )
00058 *     ..
00059 *     .. Local Scalars ..
00060       REAL               A11, A12, A22, C, SSMAX, TAU
00061 *     ..
00062 *     .. External Functions ..
00063       REAL               SDOT
00064       EXTERNAL           SDOT
00065 *     ..
00066 *     .. External Subroutines ..
00067       EXTERNAL           SAXPY, SLARFG, SLAS2
00068 *     ..
00069 *     .. Executable Statements ..
00070 *
00071 *     Quick return if possible
00072 *
00073       IF( N.LE.1 ) THEN
00074          SSMIN = ZERO
00075          RETURN
00076       END IF
00077 *
00078 *     Compute the QR factorization of the N-by-2 matrix ( X Y )
00079 *
00080       CALL SLARFG( N, X( 1 ), X( 1+INCX ), INCX, TAU )
00081       A11 = X( 1 )
00082       X( 1 ) = ONE
00083 *
00084       C = -TAU*SDOT( N, X, INCX, Y, INCY )
00085       CALL SAXPY( N, C, X, INCX, Y, INCY )
00086 *
00087       CALL SLARFG( N-1, Y( 1+INCY ), Y( 1+2*INCY ), INCY, TAU )
00088 *
00089       A12 = Y( 1 )
00090       A22 = Y( 1+INCY )
00091 *
00092 *     Compute the SVD of 2-by-2 Upper triangular matrix.
00093 *
00094       CALL SLAS2( A11, A12, A22, SSMIN, SSMAX )
00095 *
00096       RETURN
00097 *
00098 *     End of SLAPLL
00099 *
00100       END