git.maemo.org Git - opencv/blob - 3rdparty/lapack/dlarf.c

   1 #include "clapack.h"
   2
   3 /* Table of constant values */
   4
   5 static doublereal c_b4 = 1.;
   6 static doublereal c_b5 = 0.;
   7 static integer c__1 = 1;
   8
   9 /* Subroutine */ int dlarf_(char *side, integer *m, integer *n, doublereal *v,
  10          integer *incv, doublereal *tau, doublereal *c__, integer *ldc,
  11         doublereal *work)
  12 {
  13     /* System generated locals */
  14     integer c_dim1, c_offset;
  15     doublereal d__1;
  16
  17     /* Local variables */
  18     extern /* Subroutine */ int dger_(integer *, integer *, doublereal *,
  19             doublereal *, integer *, doublereal *, integer *, doublereal *,
  20             integer *);
  21     extern logical lsame_(char *, char *);
  22     extern /* Subroutine */ int dgemv_(char *, integer *, integer *,
  23             doublereal *, doublereal *, integer *, doublereal *, integer *,
  24             doublereal *, doublereal *, integer *);
  25
  26
  27 /*  -- LAPACK auxiliary routine (version 3.1) -- */
  28 /*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
  29 /*     November 2006 */
  30
  31 /*     .. Scalar Arguments .. */
  32 /*     .. */
  33 /*     .. Array Arguments .. */
  34 /*     .. */
  35
  36 /*  Purpose */
  37 /*  ======= */
  38
  39 /*  DLARF applies a real elementary reflector H to a real m by n matrix */
  40 /*  C, from either the left or the right. H is represented in the form */
  41
  42 /*        H = I - tau * v * v' */
  43
  44 /*  where tau is a real scalar and v is a real vector. */
  45
  46 /*  If tau = 0, then H is taken to be the unit matrix. */
  47
  48 /*  Arguments */
  49 /*  ========= */
  50
  51 /*  SIDE    (input) CHARACTER*1 */
  52 /*          = 'L': form  H * C */
  53 /*          = 'R': form  C * H */
  54
  55 /*  M       (input) INTEGER */
  56 /*          The number of rows of the matrix C. */
  57
  58 /*  N       (input) INTEGER */
  59 /*          The number of columns of the matrix C. */
  60
  61 /*  V       (input) DOUBLE PRECISION array, dimension */
  62 /*                     (1 + (M-1)*abs(INCV)) if SIDE = 'L' */
  63 /*                  or (1 + (N-1)*abs(INCV)) if SIDE = 'R' */
  64 /*          The vector v in the representation of H. V is not used if */
  65 /*          TAU = 0. */
  66
  67 /*  INCV    (input) INTEGER */
  68 /*          The increment between elements of v. INCV <> 0. */
  69
  70 /*  TAU     (input) DOUBLE PRECISION */
  71 /*          The value tau in the representation of H. */
  72
  73 /*  C       (input/output) DOUBLE PRECISION array, dimension (LDC,N) */
  74 /*          On entry, the m by n matrix C. */
  75 /*          On exit, C is overwritten by the matrix H * C if SIDE = 'L', */
  76 /*          or C * H if SIDE = 'R'. */
  77
  78 /*  LDC     (input) INTEGER */
  79 /*          The leading dimension of the array C. LDC >= max(1,M). */
  80
  81 /*  WORK    (workspace) DOUBLE PRECISION array, dimension */
  82 /*                         (N) if SIDE = 'L' */
  83 /*                      or (M) if SIDE = 'R' */
  84
  85 /*  ===================================================================== */
  86
  87 /*     .. Parameters .. */
  88 /*     .. */
  89 /*     .. External Subroutines .. */
  90 /*     .. */
  91 /*     .. External Functions .. */
  92 /*     .. */
  93 /*     .. Executable Statements .. */
  94
  95     /* Parameter adjustments */
  96     --v;
  97     c_dim1 = *ldc;
  98     c_offset = 1 + c_dim1;
  99     c__ -= c_offset;
 100     --work;
 101
 102     /* Function Body */
 103     if (lsame_(side, "L")) {
 104
 105 /*        Form  H * C */
 106
 107         if (*tau != 0.) {
 108
 109 /*           w := C' * v */
 110
 111             dgemv_("Transpose", m, n, &c_b4, &c__[c_offset], ldc, &v[1], incv,
 112                      &c_b5, &work[1], &c__1);
 113
 114 /*           C := C - v * w' */
 115
 116             d__1 = -(*tau);
 117             dger_(m, n, &d__1, &v[1], incv, &work[1], &c__1, &c__[c_offset],
 118                     ldc);
 119         }
 120     } else {
 121
 122 /*        Form  C * H */
 123
 124         if (*tau != 0.) {
 125
 126 /*           w := C * v */
 127
 128             dgemv_("No transpose", m, n, &c_b4, &c__[c_offset], ldc, &v[1],
 129                     incv, &c_b5, &work[1], &c__1);
 130
 131 /*           C := C - w * v' */
 132
 133             d__1 = -(*tau);
 134             dger_(m, n, &d__1, &work[1], &c__1, &v[1], incv, &c__[c_offset],
 135                     ldc);
 136         }
 137     }
 138     return 0;
 139
 140 /*     End of DLARF */
 141
 142 } /* dlarf_ */