00001 /* dtzrqf.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 /* Table of constant values */ 00017 00018 static integer c__1 = 1; 00019 static doublereal c_b8 = 1.; 00020 00021 /* Subroutine */ int dtzrqf_(integer *m, integer *n, doublereal *a, integer * 00022 lda, doublereal *tau, integer *info) 00023 { 00024 /* System generated locals */ 00025 integer a_dim1, a_offset, i__1, i__2; 00026 doublereal d__1; 00027 00028 /* Local variables */ 00029 integer i__, k, m1; 00030 extern /* Subroutine */ int dger_(integer *, integer *, doublereal *, 00031 doublereal *, integer *, doublereal *, integer *, doublereal *, 00032 integer *), dgemv_(char *, integer *, integer *, doublereal *, 00033 doublereal *, integer *, doublereal *, integer *, doublereal *, 00034 doublereal *, integer *), dcopy_(integer *, doublereal *, 00035 integer *, doublereal *, integer *), daxpy_(integer *, doublereal 00036 *, doublereal *, integer *, doublereal *, integer *), dlarfp_( 00037 integer *, doublereal *, doublereal *, integer *, doublereal *), 00038 xerbla_(char *, integer *); 00039 00040 00041 /* -- LAPACK 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 /* This routine is deprecated and has been replaced by routine DTZRZF. */ 00054 00055 /* DTZRQF reduces the M-by-N ( M<=N ) real upper trapezoidal matrix A */ 00056 /* to upper triangular form by means of orthogonal transformations. */ 00057 00058 /* The upper trapezoidal matrix A is factored as */ 00059 00060 /* A = ( R 0 ) * Z, */ 00061 00062 /* where Z is an N-by-N orthogonal matrix and R is an M-by-M upper */ 00063 /* triangular matrix. */ 00064 00065 /* Arguments */ 00066 /* ========= */ 00067 00068 /* M (input) INTEGER */ 00069 /* The number of rows of the matrix A. M >= 0. */ 00070 00071 /* N (input) INTEGER */ 00072 /* The number of columns of the matrix A. N >= M. */ 00073 00074 /* A (input/output) DOUBLE PRECISION array, dimension (LDA,N) */ 00075 /* On entry, the leading M-by-N upper trapezoidal part of the */ 00076 /* array A must contain the matrix to be factorized. */ 00077 /* On exit, the leading M-by-M upper triangular part of A */ 00078 /* contains the upper triangular matrix R, and elements M+1 to */ 00079 /* N of the first M rows of A, with the array TAU, represent the */ 00080 /* orthogonal matrix Z as a product of M elementary reflectors. */ 00081 00082 /* LDA (input) INTEGER */ 00083 /* The leading dimension of the array A. LDA >= max(1,M). */ 00084 00085 /* TAU (output) DOUBLE PRECISION array, dimension (M) */ 00086 /* The scalar factors of the elementary reflectors. */ 00087 00088 /* INFO (output) INTEGER */ 00089 /* = 0: successful exit */ 00090 /* < 0: if INFO = -i, the i-th argument had an illegal value */ 00091 00092 /* Further Details */ 00093 /* =============== */ 00094 00095 /* The factorization is obtained by Householder's method. The kth */ 00096 /* transformation matrix, Z( k ), which is used to introduce zeros into */ 00097 /* the ( m - k + 1 )th row of A, is given in the form */ 00098 00099 /* Z( k ) = ( I 0 ), */ 00100 /* ( 0 T( k ) ) */ 00101 00102 /* where */ 00103 00104 /* T( k ) = I - tau*u( k )*u( k )', u( k ) = ( 1 ), */ 00105 /* ( 0 ) */ 00106 /* ( z( k ) ) */ 00107 00108 /* tau is a scalar and z( k ) is an ( n - m ) element vector. */ 00109 /* tau and z( k ) are chosen to annihilate the elements of the kth row */ 00110 /* of X. */ 00111 00112 /* The scalar tau is returned in the kth element of TAU and the vector */ 00113 /* u( k ) in the kth row of A, such that the elements of z( k ) are */ 00114 /* in a( k, m + 1 ), ..., a( k, n ). The elements of R are returned in */ 00115 /* the upper triangular part of A. */ 00116 00117 /* Z is given by */ 00118 00119 /* Z = Z( 1 ) * Z( 2 ) * ... * Z( m ). */ 00120 00121 /* ===================================================================== */ 00122 00123 /* .. Parameters .. */ 00124 /* .. */ 00125 /* .. Local Scalars .. */ 00126 /* .. */ 00127 /* .. Intrinsic Functions .. */ 00128 /* .. */ 00129 /* .. External Subroutines .. */ 00130 /* .. */ 00131 /* .. Executable Statements .. */ 00132 00133 /* Test the input parameters. */ 00134 00135 /* Parameter adjustments */ 00136 a_dim1 = *lda; 00137 a_offset = 1 + a_dim1; 00138 a -= a_offset; 00139 --tau; 00140 00141 /* Function Body */ 00142 *info = 0; 00143 if (*m < 0) { 00144 *info = -1; 00145 } else if (*n < *m) { 00146 *info = -2; 00147 } else if (*lda < max(1,*m)) { 00148 *info = -4; 00149 } 00150 if (*info != 0) { 00151 i__1 = -(*info); 00152 xerbla_("DTZRQF", &i__1); 00153 return 0; 00154 } 00155 00156 /* Perform the factorization. */ 00157 00158 if (*m == 0) { 00159 return 0; 00160 } 00161 if (*m == *n) { 00162 i__1 = *n; 00163 for (i__ = 1; i__ <= i__1; ++i__) { 00164 tau[i__] = 0.; 00165 /* L10: */ 00166 } 00167 } else { 00168 /* Computing MIN */ 00169 i__1 = *m + 1; 00170 m1 = min(i__1,*n); 00171 for (k = *m; k >= 1; --k) { 00172 00173 /* Use a Householder reflection to zero the kth row of A. */ 00174 /* First set up the reflection. */ 00175 00176 i__1 = *n - *m + 1; 00177 dlarfp_(&i__1, &a[k + k * a_dim1], &a[k + m1 * a_dim1], lda, &tau[ 00178 k]); 00179 00180 if (tau[k] != 0. && k > 1) { 00181 00182 /* We now perform the operation A := A*P( k ). */ 00183 00184 /* Use the first ( k - 1 ) elements of TAU to store a( k ), */ 00185 /* where a( k ) consists of the first ( k - 1 ) elements of */ 00186 /* the kth column of A. Also let B denote the first */ 00187 /* ( k - 1 ) rows of the last ( n - m ) columns of A. */ 00188 00189 i__1 = k - 1; 00190 dcopy_(&i__1, &a[k * a_dim1 + 1], &c__1, &tau[1], &c__1); 00191 00192 /* Form w = a( k ) + B*z( k ) in TAU. */ 00193 00194 i__1 = k - 1; 00195 i__2 = *n - *m; 00196 dgemv_("No transpose", &i__1, &i__2, &c_b8, &a[m1 * a_dim1 + 00197 1], lda, &a[k + m1 * a_dim1], lda, &c_b8, &tau[1], & 00198 c__1); 00199 00200 /* Now form a( k ) := a( k ) - tau*w */ 00201 /* and B := B - tau*w*z( k )'. */ 00202 00203 i__1 = k - 1; 00204 d__1 = -tau[k]; 00205 daxpy_(&i__1, &d__1, &tau[1], &c__1, &a[k * a_dim1 + 1], & 00206 c__1); 00207 i__1 = k - 1; 00208 i__2 = *n - *m; 00209 d__1 = -tau[k]; 00210 dger_(&i__1, &i__2, &d__1, &tau[1], &c__1, &a[k + m1 * a_dim1] 00211 , lda, &a[m1 * a_dim1 + 1], lda); 00212 } 00213 /* L20: */ 00214 } 00215 } 00216 00217 return 0; 00218 00219 /* End of DTZRQF */ 00220 00221 } /* dtzrqf_ */