3rdparty/lapack/dscal.c

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