Update to 2.0.0 tree from current Fremantle build
[opencv] / 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_ */