00001 /* zlapll.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 zlapll_(integer *n, doublecomplex *x, integer *incx, 00017 doublecomplex *y, integer *incy, doublereal *ssmin) 00018 { 00019 /* System generated locals */ 00020 integer i__1; 00021 doublereal d__1, d__2, d__3; 00022 doublecomplex z__1, z__2, z__3, z__4; 00023 00024 /* Builtin functions */ 00025 void d_cnjg(doublecomplex *, doublecomplex *); 00026 double z_abs(doublecomplex *); 00027 00028 /* Local variables */ 00029 doublecomplex c__, a11, a12, a22, tau; 00030 extern /* Subroutine */ int dlas2_(doublereal *, doublereal *, doublereal 00031 *, doublereal *, doublereal *); 00032 extern /* Double Complex */ VOID zdotc_(doublecomplex *, integer *, 00033 doublecomplex *, integer *, doublecomplex *, integer *); 00034 doublereal ssmax; 00035 extern /* Subroutine */ int zaxpy_(integer *, doublecomplex *, 00036 doublecomplex *, integer *, doublecomplex *, integer *), zlarfg_( 00037 integer *, doublecomplex *, doublecomplex *, integer *, 00038 doublecomplex *); 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*16 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*16 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) DOUBLE PRECISION */ 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.; 00108 return 0; 00109 } 00110 00111 /* Compute the QR factorization of the N-by-2 matrix ( X Y ) */ 00112 00113 zlarfg_(n, &x[1], &x[*incx + 1], incx, &tau); 00114 a11.r = x[1].r, a11.i = x[1].i; 00115 x[1].r = 1., x[1].i = 0.; 00116 00117 d_cnjg(&z__3, &tau); 00118 z__2.r = -z__3.r, z__2.i = -z__3.i; 00119 zdotc_(&z__4, n, &x[1], incx, &y[1], incy); 00120 z__1.r = z__2.r * z__4.r - z__2.i * z__4.i, z__1.i = z__2.r * z__4.i + 00121 z__2.i * z__4.r; 00122 c__.r = z__1.r, c__.i = z__1.i; 00123 zaxpy_(n, &c__, &x[1], incx, &y[1], incy); 00124 00125 i__1 = *n - 1; 00126 zlarfg_(&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 d__1 = z_abs(&a11); 00135 d__2 = z_abs(&a12); 00136 d__3 = z_abs(&a22); 00137 dlas2_(&d__1, &d__2, &d__3, ssmin, &ssmax); 00138 00139 return 0; 00140 00141 /* End of ZLAPLL */ 00142 00143 } /* zlapll_ */