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

   1 #include "clapack.h"
   2
   3 /* Subroutine */ int dger_(integer *m, integer *n, doublereal *alpha,
   4         doublereal *x, integer *incx, doublereal *y, integer *incy,
   5         doublereal *a, integer *lda)
   6 {
   7     /* System generated locals */
   8     integer a_dim1, a_offset, i__1, i__2;
   9
  10     /* Local variables */
  11     integer i__, j, ix, jy, kx, info;
  12     doublereal temp;
  13     extern /* Subroutine */ int xerbla_(char *, integer *);
  14
  15 /*     .. Scalar Arguments .. */
  16 /*     .. */
  17 /*     .. Array Arguments .. */
  18 /*     .. */
  19
  20 /*  Purpose */
  21 /*  ======= */
  22
  23 /*  DGER   performs the rank 1 operation */
  24
  25 /*     A := alpha*x*y' + A, */
  26
  27 /*  where alpha is a scalar, x is an m element vector, y is an n element */
  28 /*  vector and A is an m by n matrix. */
  29
  30 /*  Arguments */
  31 /*  ========== */
  32
  33 /*  M      - INTEGER. */
  34 /*           On entry, M specifies the number of rows of the matrix A. */
  35 /*           M must be at least zero. */
  36 /*           Unchanged on exit. */
  37
  38 /*  N      - INTEGER. */
  39 /*           On entry, N specifies the number of columns of the matrix A. */
  40 /*           N must be at least zero. */
  41 /*           Unchanged on exit. */
  42
  43 /*  ALPHA  - DOUBLE PRECISION. */
  44 /*           On entry, ALPHA specifies the scalar alpha. */
  45 /*           Unchanged on exit. */
  46
  47 /*  X      - DOUBLE PRECISION array of dimension at least */
  48 /*           ( 1 + ( m - 1 )*abs( INCX ) ). */
  49 /*           Before entry, the incremented array X must contain the m */
  50 /*           element vector x. */
  51 /*           Unchanged on exit. */
  52
  53 /*  INCX   - INTEGER. */
  54 /*           On entry, INCX specifies the increment for the elements of */
  55 /*           X. INCX must not be zero. */
  56 /*           Unchanged on exit. */
  57
  58 /*  Y      - DOUBLE PRECISION array of dimension at least */
  59 /*           ( 1 + ( n - 1 )*abs( INCY ) ). */
  60 /*           Before entry, the incremented array Y must contain the n */
  61 /*           element vector y. */
  62 /*           Unchanged on exit. */
  63
  64 /*  INCY   - INTEGER. */
  65 /*           On entry, INCY specifies the increment for the elements of */
  66 /*           Y. INCY must not be zero. */
  67 /*           Unchanged on exit. */
  68
  69 /*  A      - DOUBLE PRECISION array of DIMENSION ( LDA, n ). */
  70 /*           Before entry, the leading m by n part of the array A must */
  71 /*           contain the matrix of coefficients. On exit, A is */
  72 /*           overwritten by the updated matrix. */
  73
  74 /*  LDA    - INTEGER. */
  75 /*           On entry, LDA specifies the first dimension of A as declared */
  76 /*           in the calling (sub) program. LDA must be at least */
  77 /*           max( 1, m ). */
  78 /*           Unchanged on exit. */
  79
  80
  81 /*  Level 2 Blas routine. */
  82
  83 /*  -- Written on 22-October-1986. */
  84 /*     Jack Dongarra, Argonne National Lab. */
  85 /*     Jeremy Du Croz, Nag Central Office. */
  86 /*     Sven Hammarling, Nag Central Office. */
  87 /*     Richard Hanson, Sandia National Labs. */
  88
  89
  90 /*     .. Parameters .. */
  91 /*     .. */
  92 /*     .. Local Scalars .. */
  93 /*     .. */
  94 /*     .. External Subroutines .. */
  95 /*     .. */
  96 /*     .. Intrinsic Functions .. */
  97 /*     .. */
  98
  99 /*     Test the input parameters. */
 100
 101     /* Parameter adjustments */
 102     --x;
 103     --y;
 104     a_dim1 = *lda;
 105     a_offset = 1 + a_dim1;
 106     a -= a_offset;
 107
 108     /* Function Body */
 109     info = 0;
 110     if (*m < 0) {
 111         info = 1;
 112     } else if (*n < 0) {
 113         info = 2;
 114     } else if (*incx == 0) {
 115         info = 5;
 116     } else if (*incy == 0) {
 117         info = 7;
 118     } else if (*lda < max(1,*m)) {
 119         info = 9;
 120     }
 121     if (info != 0) {
 122         xerbla_("DGER  ", &info);
 123         return 0;
 124     }
 125
 126 /*     Quick return if possible. */
 127
 128     if (*m == 0 || *n == 0 || *alpha == 0.) {
 129         return 0;
 130     }
 131
 132 /*     Start the operations. In this version the elements of A are */
 133 /*     accessed sequentially with one pass through A. */
 134
 135     if (*incy > 0) {
 136         jy = 1;
 137     } else {
 138         jy = 1 - (*n - 1) * *incy;
 139     }
 140     if (*incx == 1) {
 141         i__1 = *n;
 142         for (j = 1; j <= i__1; ++j) {
 143             if (y[jy] != 0.) {
 144                 temp = *alpha * y[jy];
 145                 i__2 = *m;
 146                 for (i__ = 1; i__ <= i__2; ++i__) {
 147                     a[i__ + j * a_dim1] += x[i__] * temp;
 148 /* L10: */
 149                 }
 150             }
 151             jy += *incy;
 152 /* L20: */
 153         }
 154     } else {
 155         if (*incx > 0) {
 156             kx = 1;
 157         } else {
 158             kx = 1 - (*m - 1) * *incx;
 159         }
 160         i__1 = *n;
 161         for (j = 1; j <= i__1; ++j) {
 162             if (y[jy] != 0.) {
 163                 temp = *alpha * y[jy];
 164                 ix = kx;
 165                 i__2 = *m;
 166                 for (i__ = 1; i__ <= i__2; ++i__) {
 167                     a[i__ + j * a_dim1] += x[ix] * temp;
 168                     ix += *incx;
 169 /* L30: */
 170                 }
 171             }
 172             jy += *incy;
 173 /* L40: */
 174         }
 175     }
 176
 177     return 0;
 178
 179 /*     End of DGER  . */
 180
 181 } /* dger_ */