1 /* ../netlib/slapll.f -- translated by f2c (version 20100827). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib;
2 on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */
3 #include "FLA_f2c.h" /* > \brief \b SLAPLL measures the linear dependence of two vectors. */
4 /* =========== DOCUMENTATION =========== */
5 /* Online html documentation available at */
6 /* http://www.netlib.org/lapack/explore-html/ */
7 /* > \htmlonly */
8 /* > Download SLAPLL + dependencies */
9 /* > <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slapll. f"> */
10 /* > [TGZ]</a> */
11 /* > <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slapll. f"> */
12 /* > [ZIP]</a> */
13 /* > <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slapll. f"> */
14 /* > [TXT]</a> */
15 /* > \endhtmlonly */
16 /* Definition: */
17 /* =========== */
18 /* SUBROUTINE SLAPLL( N, X, INCX, Y, INCY, SSMIN ) */
19 /* .. Scalar Arguments .. */
20 /* INTEGER INCX, INCY, N */
21 /* REAL SSMIN */
22 /* .. */
23 /* .. Array Arguments .. */
24 /* REAL X( * ), Y( * ) */
25 /* .. */
26 /* > \par Purpose: */
27 /* ============= */
28 /* > */
29 /* > \verbatim */
30 /* > */
31 /* > Given two column vectors X and Y, let */
32 /* > */
33 /* > A = ( X Y ). */
34 /* > */
35 /* > The subroutine first computes the QR factorization of A = Q*R, */
36 /* > and then computes the SVD of the 2-by-2 upper triangular matrix R. */
37 /* > The smaller singular value of R is returned in SSMIN, which is used */
38 /* > as the measurement of the linear dependency of the vectors X and Y. */
39 /* > \endverbatim */
40 /* Arguments: */
41 /* ========== */
42 /* > \param[in] N */
43 /* > \verbatim */
44 /* > N is INTEGER */
45 /* > The length of the vectors X and Y. */
46 /* > \endverbatim */
47 /* > */
48 /* > \param[in,out] X */
49 /* > \verbatim */
50 /* > X is REAL array, */
51 /* > dimension (1+(N-1)*INCX) */
52 /* > On entry, X contains the N-vector X. */
53 /* > On exit, X is overwritten. */
54 /* > \endverbatim */
55 /* > */
56 /* > \param[in] INCX */
57 /* > \verbatim */
58 /* > INCX is INTEGER */
59 /* > The increment between successive elements of X. INCX > 0. */
60 /* > \endverbatim */
61 /* > */
62 /* > \param[in,out] Y */
63 /* > \verbatim */
64 /* > Y is REAL array, */
65 /* > dimension (1+(N-1)*INCY) */
66 /* > On entry, Y contains the N-vector Y. */
67 /* > On exit, Y is overwritten. */
68 /* > \endverbatim */
69 /* > */
70 /* > \param[in] INCY */
71 /* > \verbatim */
72 /* > INCY is INTEGER */
73 /* > The increment between successive elements of Y. INCY > 0. */
74 /* > \endverbatim */
75 /* > */
76 /* > \param[out] SSMIN */
77 /* > \verbatim */
78 /* > SSMIN is REAL */
79 /* > The smallest singular value of the N-by-2 matrix A = ( X Y ). */
80 /* > \endverbatim */
81 /* Authors: */
82 /* ======== */
83 /* > \author Univ. of Tennessee */
84 /* > \author Univ. of California Berkeley */
85 /* > \author Univ. of Colorado Denver */
86 /* > \author NAG Ltd. */
87 /* > \date September 2012 */
88 /* > \ingroup realOTHERauxiliary */
89 /* ===================================================================== */
90 /* Subroutine */
slapll_(integer * n,real * x,integer * incx,real * y,integer * incy,real * ssmin)91 int slapll_(integer *n, real *x, integer *incx, real *y, integer *incy, real *ssmin)
92 {
93 /* System generated locals */
94 integer i__1;
95 /* Local variables */
96 real c__, a11, a12, a22, tau;
97 extern real sdot_(integer *, real *, integer *, real *, integer *);
98 extern /* Subroutine */
99 int slas2_(real *, real *, real *, real *, real *) ;
100 real ssmax;
101 extern /* Subroutine */
102 int saxpy_(integer *, real *, real *, integer *, real *, integer *), slarfg_(integer *, real *, real *, integer *, real *);
103 /* -- LAPACK auxiliary routine (version 3.4.2) -- */
104 /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */
105 /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */
106 /* September 2012 */
107 /* .. Scalar Arguments .. */
108 /* .. */
109 /* .. Array Arguments .. */
110 /* .. */
111 /* ===================================================================== */
112 /* .. Parameters .. */
113 /* .. */
114 /* .. Local Scalars .. */
115 /* .. */
116 /* .. External Functions .. */
117 /* .. */
118 /* .. External Subroutines .. */
119 /* .. */
120 /* .. Executable Statements .. */
121 /* Quick return if possible */
122 /* Parameter adjustments */
123 --y;
124 --x;
125 /* Function Body */
126 if (*n <= 1)
127 {
128 *ssmin = 0.f;
129 return 0;
130 }
131 /* Compute the QR factorization of the N-by-2 matrix ( X Y ) */
132 slarfg_(n, &x[1], &x[*incx + 1], incx, &tau);
133 a11 = x[1];
134 x[1] = 1.f;
135 c__ = -tau * sdot_(n, &x[1], incx, &y[1], incy);
136 saxpy_(n, &c__, &x[1], incx, &y[1], incy);
137 i__1 = *n - 1;
138 slarfg_(&i__1, &y[*incy + 1], &y[(*incy << 1) + 1], incy, &tau);
139 a12 = y[1];
140 a22 = y[*incy + 1];
141 /* Compute the SVD of 2-by-2 Upper triangular matrix. */
142 slas2_(&a11, &a12, &a22, ssmin, &ssmax);
143 return 0;
144 /* End of SLAPLL */
145 }
146 /* slapll_ */
147