00001 /* slapll.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 slapll_(integer *n, real *x, integer *incx, real *y, 00017 integer *incy, real *ssmin) 00018 { 00019 /* System generated locals */ 00020 integer i__1; 00021 00022 /* Local variables */ 00023 real c__, a11, a12, a22, tau; 00024 extern doublereal sdot_(integer *, real *, integer *, real *, integer *); 00025 extern /* Subroutine */ int slas2_(real *, real *, real *, real *, real *) 00026 ; 00027 real ssmax; 00028 extern /* Subroutine */ int saxpy_(integer *, real *, real *, integer *, 00029 real *, integer *), slarfg_(integer *, real *, real *, integer *, 00030 real *); 00031 00032 00033 /* -- LAPACK auxiliary routine (version 3.2) -- */ 00034 /* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */ 00035 /* November 2006 */ 00036 00037 /* .. Scalar Arguments .. */ 00038 /* .. */ 00039 /* .. Array Arguments .. */ 00040 /* .. */ 00041 00042 /* Purpose */ 00043 /* ======= */ 00044 00045 /* Given two column vectors X and Y, let */ 00046 00047 /* A = ( X Y ). */ 00048 00049 /* The subroutine first computes the QR factorization of A = Q*R, */ 00050 /* and then computes the SVD of the 2-by-2 upper triangular matrix R. */ 00051 /* The smaller singular value of R is returned in SSMIN, which is used */ 00052 /* as the measurement of the linear dependency of the vectors X and Y. */ 00053 00054 /* Arguments */ 00055 /* ========= */ 00056 00057 /* N (input) INTEGER */ 00058 /* The length of the vectors X and Y. */ 00059 00060 /* X (input/output) REAL array, */ 00061 /* dimension (1+(N-1)*INCX) */ 00062 /* On entry, X contains the N-vector X. */ 00063 /* On exit, X is overwritten. */ 00064 00065 /* INCX (input) INTEGER */ 00066 /* The increment between successive elements of X. INCX > 0. */ 00067 00068 /* Y (input/output) REAL array, */ 00069 /* dimension (1+(N-1)*INCY) */ 00070 /* On entry, Y contains the N-vector Y. */ 00071 /* On exit, Y is overwritten. */ 00072 00073 /* INCY (input) INTEGER */ 00074 /* The increment between successive elements of Y. INCY > 0. */ 00075 00076 /* SSMIN (output) REAL */ 00077 /* The smallest singular value of the N-by-2 matrix A = ( X Y ). */ 00078 00079 /* ===================================================================== */ 00080 00081 /* .. Parameters .. */ 00082 /* .. */ 00083 /* .. Local Scalars .. */ 00084 /* .. */ 00085 /* .. External Functions .. */ 00086 /* .. */ 00087 /* .. External Subroutines .. */ 00088 /* .. */ 00089 /* .. Executable Statements .. */ 00090 00091 /* Quick return if possible */ 00092 00093 /* Parameter adjustments */ 00094 --y; 00095 --x; 00096 00097 /* Function Body */ 00098 if (*n <= 1) { 00099 *ssmin = 0.f; 00100 return 0; 00101 } 00102 00103 /* Compute the QR factorization of the N-by-2 matrix ( X Y ) */ 00104 00105 slarfg_(n, &x[1], &x[*incx + 1], incx, &tau); 00106 a11 = x[1]; 00107 x[1] = 1.f; 00108 00109 c__ = -tau * sdot_(n, &x[1], incx, &y[1], incy); 00110 saxpy_(n, &c__, &x[1], incx, &y[1], incy); 00111 00112 i__1 = *n - 1; 00113 slarfg_(&i__1, &y[*incy + 1], &y[(*incy << 1) + 1], incy, &tau); 00114 00115 a12 = y[1]; 00116 a22 = y[*incy + 1]; 00117 00118 /* Compute the SVD of 2-by-2 Upper triangular matrix. */ 00119 00120 slas2_(&a11, &a12, &a22, ssmin, &ssmax); 00121 00122 return 0; 00123 00124 /* End of SLAPLL */ 00125 00126 } /* slapll_ */