zgerq2.c
Go to the documentation of this file.
00001 /* zgerq2.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 zgerq2_(integer *m, integer *n, doublecomplex *a, 
00017         integer *lda, doublecomplex *tau, doublecomplex *work, integer *info)
00018 {
00019     /* System generated locals */
00020     integer a_dim1, a_offset, i__1, i__2;
00021 
00022     /* Local variables */
00023     integer i__, k;
00024     doublecomplex alpha;
00025     extern /* Subroutine */ int zlarf_(char *, integer *, integer *, 
00026             doublecomplex *, integer *, doublecomplex *, doublecomplex *, 
00027             integer *, doublecomplex *), xerbla_(char *, integer *), zlacgv_(integer *, doublecomplex *, integer *), zlarfp_(
00028             integer *, doublecomplex *, doublecomplex *, integer *, 
00029             doublecomplex *);
00030 
00031 
00032 /*  -- LAPACK routine (version 3.2) -- */
00033 /*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
00034 /*     November 2006 */
00035 
00036 /*     .. Scalar Arguments .. */
00037 /*     .. */
00038 /*     .. Array Arguments .. */
00039 /*     .. */
00040 
00041 /*  Purpose */
00042 /*  ======= */
00043 
00044 /*  ZGERQ2 computes an RQ factorization of a complex m by n matrix A: */
00045 /*  A = R * Q. */
00046 
00047 /*  Arguments */
00048 /*  ========= */
00049 
00050 /*  M       (input) INTEGER */
00051 /*          The number of rows of the matrix A.  M >= 0. */
00052 
00053 /*  N       (input) INTEGER */
00054 /*          The number of columns of the matrix A.  N >= 0. */
00055 
00056 /*  A       (input/output) COMPLEX*16 array, dimension (LDA,N) */
00057 /*          On entry, the m by n matrix A. */
00058 /*          On exit, if m <= n, the upper triangle of the subarray */
00059 /*          A(1:m,n-m+1:n) contains the m by m upper triangular matrix R; */
00060 /*          if m >= n, the elements on and above the (m-n)-th subdiagonal */
00061 /*          contain the m by n upper trapezoidal matrix R; the remaining */
00062 /*          elements, with the array TAU, represent the unitary matrix */
00063 /*          Q as a product of elementary reflectors (see Further */
00064 /*          Details). */
00065 
00066 /*  LDA     (input) INTEGER */
00067 /*          The leading dimension of the array A.  LDA >= max(1,M). */
00068 
00069 /*  TAU     (output) COMPLEX*16 array, dimension (min(M,N)) */
00070 /*          The scalar factors of the elementary reflectors (see Further */
00071 /*          Details). */
00072 
00073 /*  WORK    (workspace) COMPLEX*16 array, dimension (M) */
00074 
00075 /*  INFO    (output) INTEGER */
00076 /*          = 0: successful exit */
00077 /*          < 0: if INFO = -i, the i-th argument had an illegal value */
00078 
00079 /*  Further Details */
00080 /*  =============== */
00081 
00082 /*  The matrix Q is represented as a product of elementary reflectors */
00083 
00084 /*     Q = H(1)' H(2)' . . . H(k)', where k = min(m,n). */
00085 
00086 /*  Each H(i) has the form */
00087 
00088 /*     H(i) = I - tau * v * v' */
00089 
00090 /*  where tau is a complex scalar, and v is a complex vector with */
00091 /*  v(n-k+i+1:n) = 0 and v(n-k+i) = 1; conjg(v(1:n-k+i-1)) is stored on */
00092 /*  exit in A(m-k+i,1:n-k+i-1), and tau in TAU(i). */
00093 
00094 /*  ===================================================================== */
00095 
00096 /*     .. Parameters .. */
00097 /*     .. */
00098 /*     .. Local Scalars .. */
00099 /*     .. */
00100 /*     .. External Subroutines .. */
00101 /*     .. */
00102 /*     .. Intrinsic Functions .. */
00103 /*     .. */
00104 /*     .. Executable Statements .. */
00105 
00106 /*     Test the input arguments */
00107 
00108     /* Parameter adjustments */
00109     a_dim1 = *lda;
00110     a_offset = 1 + a_dim1;
00111     a -= a_offset;
00112     --tau;
00113     --work;
00114 
00115     /* Function Body */
00116     *info = 0;
00117     if (*m < 0) {
00118         *info = -1;
00119     } else if (*n < 0) {
00120         *info = -2;
00121     } else if (*lda < max(1,*m)) {
00122         *info = -4;
00123     }
00124     if (*info != 0) {
00125         i__1 = -(*info);
00126         xerbla_("ZGERQ2", &i__1);
00127         return 0;
00128     }
00129 
00130     k = min(*m,*n);
00131 
00132     for (i__ = k; i__ >= 1; --i__) {
00133 
00134 /*        Generate elementary reflector H(i) to annihilate */
00135 /*        A(m-k+i,1:n-k+i-1) */
00136 
00137         i__1 = *n - k + i__;
00138         zlacgv_(&i__1, &a[*m - k + i__ + a_dim1], lda);
00139         i__1 = *m - k + i__ + (*n - k + i__) * a_dim1;
00140         alpha.r = a[i__1].r, alpha.i = a[i__1].i;
00141         i__1 = *n - k + i__;
00142         zlarfp_(&i__1, &alpha, &a[*m - k + i__ + a_dim1], lda, &tau[i__]);
00143 
00144 /*        Apply H(i) to A(1:m-k+i-1,1:n-k+i) from the right */
00145 
00146         i__1 = *m - k + i__ + (*n - k + i__) * a_dim1;
00147         a[i__1].r = 1., a[i__1].i = 0.;
00148         i__1 = *m - k + i__ - 1;
00149         i__2 = *n - k + i__;
00150         zlarf_("Right", &i__1, &i__2, &a[*m - k + i__ + a_dim1], lda, &tau[
00151                 i__], &a[a_offset], lda, &work[1]);
00152         i__1 = *m - k + i__ + (*n - k + i__) * a_dim1;
00153         a[i__1].r = alpha.r, a[i__1].i = alpha.i;
00154         i__1 = *n - k + i__ - 1;
00155         zlacgv_(&i__1, &a[*m - k + i__ + a_dim1], lda);
00156 /* L10: */
00157     }
00158     return 0;
00159 
00160 /*     End of ZGERQ2 */
00161 
00162 } /* zgerq2_ */


swiftnav
Author(s):
autogenerated on Sat Jun 8 2019 18:56:33