00001 /* dlapll.f -- translated by f2c (version 20061008). 00002 You must link the resulting object file with libf2c: 00003 on Microsoft Windows system, link with libf2c.lib; 00004 on Linux or Unix systems, link with .../path/to/libf2c.a -lm 00005 or, if you install libf2c.a in a standard place, with -lf2c -lm 00006 -- in that order, at the end of the command line, as in 00007 cc *.o -lf2c -lm 00008 Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., 00009 00010 http://www.netlib.org/f2c/libf2c.zip 00011 */ 00012 00013 #include "f2c.h" 00014 #include "blaswrap.h" 00015 00016 /* Subroutine */ int dlapll_(integer *n, doublereal *x, integer *incx, 00017 doublereal *y, integer *incy, doublereal *ssmin) 00018 { 00019 /* System generated locals */ 00020 integer i__1; 00021 00022 /* Local variables */ 00023 doublereal c__, a11, a12, a22, tau; 00024 extern doublereal ddot_(integer *, doublereal *, integer *, doublereal *, 00025 integer *); 00026 extern /* Subroutine */ int dlas2_(doublereal *, doublereal *, doublereal 00027 *, doublereal *, doublereal *), daxpy_(integer *, doublereal *, 00028 doublereal *, integer *, doublereal *, integer *); 00029 doublereal ssmax; 00030 extern /* Subroutine */ int dlarfg_(integer *, doublereal *, doublereal *, 00031 integer *, doublereal *); 00032 00033 00034 /* -- LAPACK auxiliary routine (version 3.2) -- */ 00035 /* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */ 00036 /* November 2006 */ 00037 00038 /* .. Scalar Arguments .. */ 00039 /* .. */ 00040 /* .. Array Arguments .. */ 00041 /* .. */ 00042 00043 /* Purpose */ 00044 /* ======= */ 00045 00046 /* Given two column vectors X and Y, let */ 00047 00048 /* A = ( X Y ). */ 00049 00050 /* The subroutine first computes the QR factorization of A = Q*R, */ 00051 /* and then computes the SVD of the 2-by-2 upper triangular matrix R. */ 00052 /* The smaller singular value of R is returned in SSMIN, which is used */ 00053 /* as the measurement of the linear dependency of the vectors X and Y. */ 00054 00055 /* Arguments */ 00056 /* ========= */ 00057 00058 /* N (input) INTEGER */ 00059 /* The length of the vectors X and Y. */ 00060 00061 /* X (input/output) DOUBLE PRECISION array, */ 00062 /* dimension (1+(N-1)*INCX) */ 00063 /* On entry, X contains the N-vector X. */ 00064 /* On exit, X is overwritten. */ 00065 00066 /* INCX (input) INTEGER */ 00067 /* The increment between successive elements of X. INCX > 0. */ 00068 00069 /* Y (input/output) DOUBLE PRECISION array, */ 00070 /* dimension (1+(N-1)*INCY) */ 00071 /* On entry, Y contains the N-vector Y. */ 00072 /* On exit, Y is overwritten. */ 00073 00074 /* INCY (input) INTEGER */ 00075 /* The increment between successive elements of Y. INCY > 0. */ 00076 00077 /* SSMIN (output) DOUBLE PRECISION */ 00078 /* The smallest singular value of the N-by-2 matrix A = ( X Y ). */ 00079 00080 /* ===================================================================== */ 00081 00082 /* .. Parameters .. */ 00083 /* .. */ 00084 /* .. Local Scalars .. */ 00085 /* .. */ 00086 /* .. External Functions .. */ 00087 /* .. */ 00088 /* .. External Subroutines .. */ 00089 /* .. */ 00090 /* .. Executable Statements .. */ 00091 00092 /* Quick return if possible */ 00093 00094 /* Parameter adjustments */ 00095 --y; 00096 --x; 00097 00098 /* Function Body */ 00099 if (*n <= 1) { 00100 *ssmin = 0.; 00101 return 0; 00102 } 00103 00104 /* Compute the QR factorization of the N-by-2 matrix ( X Y ) */ 00105 00106 dlarfg_(n, &x[1], &x[*incx + 1], incx, &tau); 00107 a11 = x[1]; 00108 x[1] = 1.; 00109 00110 c__ = -tau * ddot_(n, &x[1], incx, &y[1], incy); 00111 daxpy_(n, &c__, &x[1], incx, &y[1], incy); 00112 00113 i__1 = *n - 1; 00114 dlarfg_(&i__1, &y[*incy + 1], &y[(*incy << 1) + 1], incy, &tau); 00115 00116 a12 = y[1]; 00117 a22 = y[*incy + 1]; 00118 00119 /* Compute the SVD of 2-by-2 Upper triangular matrix. */ 00120 00121 dlas2_(&a11, &a12, &a22, ssmin, &ssmax); 00122 00123 return 0; 00124 00125 /* End of DLAPLL */ 00126 00127 } /* dlapll_ */