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