001:       SUBROUTINE CLAPLL( N, X, INCX, Y, INCY, SSMIN )
002: *
003: *  -- LAPACK auxiliary routine (version 3.2) --
004: *     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
005: *     November 2006
006: *
007: *     .. Scalar Arguments ..
008:       INTEGER            INCX, INCY, N
009:       REAL               SSMIN
010: *     ..
011: *     .. Array Arguments ..
012:       COMPLEX            X( * ), Y( * )
013: *     ..
014: *
015: *  Purpose
016: *  =======
017: *
018: *  Given two column vectors X and Y, let
019: *
020: *                       A = ( X Y ).
021: *
022: *  The subroutine first computes the QR factorization of A = Q*R,
023: *  and then computes the SVD of the 2-by-2 upper triangular matrix R.
024: *  The smaller singular value of R is returned in SSMIN, which is used
025: *  as the measurement of the linear dependency of the vectors X and Y.
026: *
027: *  Arguments
028: *  =========
029: *
030: *  N       (input) INTEGER
031: *          The length of the vectors X and Y.
032: *
033: *  X       (input/output) COMPLEX array, dimension (1+(N-1)*INCX)
034: *          On entry, X contains the N-vector X.
035: *          On exit, X is overwritten.
036: *
037: *  INCX    (input) INTEGER
038: *          The increment between successive elements of X. INCX > 0.
039: *
040: *  Y       (input/output) COMPLEX array, dimension (1+(N-1)*INCY)
041: *          On entry, Y contains the N-vector Y.
042: *          On exit, Y is overwritten.
043: *
044: *  INCY    (input) INTEGER
045: *          The increment between successive elements of Y. INCY > 0.
046: *
047: *  SSMIN   (output) REAL
048: *          The smallest singular value of the N-by-2 matrix A = ( X Y ).
049: *
050: *  =====================================================================
051: *
052: *     .. Parameters ..
053:       REAL               ZERO
054:       PARAMETER          ( ZERO = 0.0E+0 )
055:       COMPLEX            CONE
056:       PARAMETER          ( CONE = ( 1.0E+0, 0.0E+0 ) )
057: *     ..
058: *     .. Local Scalars ..
059:       REAL               SSMAX
060:       COMPLEX            A11, A12, A22, C, TAU
061: *     ..
062: *     .. Intrinsic Functions ..
063:       INTRINSIC          ABS, CONJG
064: *     ..
065: *     .. External Functions ..
066:       COMPLEX            CDOTC
067:       EXTERNAL           CDOTC
068: *     ..
069: *     .. External Subroutines ..
070:       EXTERNAL           CAXPY, CLARFG, SLAS2
071: *     ..
072: *     .. Executable Statements ..
073: *
074: *     Quick return if possible
075: *
076:       IF( N.LE.1 ) THEN
077:          SSMIN = ZERO
078:          RETURN
079:       END IF
080: *
081: *     Compute the QR factorization of the N-by-2 matrix ( X Y )
082: *
083:       CALL CLARFG( N, X( 1 ), X( 1+INCX ), INCX, TAU )
084:       A11 = X( 1 )
085:       X( 1 ) = CONE
086: *
087:       C = -CONJG( TAU )*CDOTC( N, X, INCX, Y, INCY )
088:       CALL CAXPY( N, C, X, INCX, Y, INCY )
089: *
090:       CALL CLARFG( N-1, Y( 1+INCY ), Y( 1+2*INCY ), INCY, TAU )
091: *
092:       A12 = Y( 1 )
093:       A22 = Y( 1+INCY )
094: *
095: *     Compute the SVD of 2-by-2 Upper triangular matrix.
096: *
097:       CALL SLAS2( ABS( A11 ), ABS( A12 ), ABS( A22 ), SSMIN, SSMAX )
098: *
099:       RETURN
100: *
101: *     End of CLAPLL
102: *
103:       END
104: