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

   1 #include "clapack.h"
   2
   3 /* Subroutine */ int sscal_(integer *n, real *sa, real *sx, integer *incx)
   4 {
   5     /* System generated locals */
   6     integer i__1, i__2;
   7
   8     /* Local variables */
   9     integer i__, m, mp1, nincx;
  10
  11 /*     .. Scalar Arguments .. */
  12 /*     .. */
  13 /*     .. Array Arguments .. */
  14 /*     .. */
  15
  16 /*  Purpose */
  17 /*  ======= */
  18
  19 /*     scales a vector by a constant. */
  20 /*     uses unrolled loops for increment equal to 1. */
  21 /*     jack dongarra, linpack, 3/11/78. */
  22 /*     modified 3/93 to return if incx .le. 0. */
  23 /*     modified 12/3/93, array(1) declarations changed to array(*) */
  24
  25
  26 /*     .. Local Scalars .. */
  27 /*     .. */
  28 /*     .. Intrinsic Functions .. */
  29 /*     .. */
  30     /* Parameter adjustments */
  31     --sx;
  32
  33     /* Function Body */
  34     if (*n <= 0 || *incx <= 0) {
  35         return 0;
  36     }
  37     if (*incx == 1) {
  38         goto L20;
  39     }
  40
  41 /*        code for increment not equal to 1 */
  42
  43     nincx = *n * *incx;
  44     i__1 = nincx;
  45     i__2 = *incx;
  46     for (i__ = 1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) {
  47         sx[i__] = *sa * sx[i__];
  48 /* L10: */
  49     }
  50     return 0;
  51
  52 /*        code for increment equal to 1 */
  53
  54
  55 /*        clean-up loop */
  56
  57 L20:
  58     m = *n % 5;
  59     if (m == 0) {
  60         goto L40;
  61     }
  62     i__2 = m;
  63     for (i__ = 1; i__ <= i__2; ++i__) {
  64         sx[i__] = *sa * sx[i__];
  65 /* L30: */
  66     }
  67     if (*n < 5) {
  68         return 0;
  69     }
  70 L40:
  71     mp1 = m + 1;
  72     i__2 = *n;
  73     for (i__ = mp1; i__ <= i__2; i__ += 5) {
  74         sx[i__] = *sa * sx[i__];
  75         sx[i__ + 1] = *sa * sx[i__ + 1];
  76         sx[i__ + 2] = *sa * sx[i__ + 2];
  77         sx[i__ + 3] = *sa * sx[i__ + 3];
  78         sx[i__ + 4] = *sa * sx[i__ + 4];
  79 /* L50: */
  80     }
  81     return 0;
  82 } /* sscal_ */