Chris@202: /* dscal.f -- translated by f2c (version 20061008). Chris@202: You must link the resulting object file with libf2c: Chris@202: on Microsoft Windows system, link with libf2c.lib; Chris@202: on Linux or Unix systems, link with .../path/to/libf2c.a -lm Chris@202: or, if you install libf2c.a in a standard place, with -lf2c -lm Chris@202: -- in that order, at the end of the command line, as in Chris@202: cc *.o -lf2c -lm Chris@202: Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., Chris@202: Chris@202: http://www.netlib.org/f2c/libf2c.zip Chris@202: */ Chris@202: Chris@202: #include "f2c.h" Chris@202: #include "blaswrap.h" Chris@202: Chris@202: /* Subroutine */ int dscal_(integer *n, doublereal *da, doublereal *dx, Chris@202: integer *incx) Chris@202: { Chris@202: /* System generated locals */ Chris@202: integer i__1, i__2; Chris@202: Chris@202: /* Local variables */ Chris@202: integer i__, m, mp1, nincx; Chris@202: Chris@202: /* .. Scalar Arguments .. */ Chris@202: /* .. */ Chris@202: /* .. Array Arguments .. */ Chris@202: /* .. */ Chris@202: Chris@202: /* Purpose */ Chris@202: /* ======= */ Chris@202: /* * */ Chris@202: /* scales a vector by a constant. */ Chris@202: /* uses unrolled loops for increment equal to one. */ Chris@202: /* jack dongarra, linpack, 3/11/78. */ Chris@202: /* modified 3/93 to return if incx .le. 0. */ Chris@202: /* modified 12/3/93, array(1) declarations changed to array(*) */ Chris@202: Chris@202: Chris@202: /* .. Local Scalars .. */ Chris@202: /* .. */ Chris@202: /* .. Intrinsic Functions .. */ Chris@202: /* .. */ Chris@202: /* Parameter adjustments */ Chris@202: --dx; Chris@202: Chris@202: /* Function Body */ Chris@202: if (*n <= 0 || *incx <= 0) { Chris@202: return 0; Chris@202: } Chris@202: if (*incx == 1) { Chris@202: goto L20; Chris@202: } Chris@202: Chris@202: /* code for increment not equal to 1 */ Chris@202: Chris@202: nincx = *n * *incx; Chris@202: i__1 = nincx; Chris@202: i__2 = *incx; Chris@202: for (i__ = 1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) { Chris@202: dx[i__] = *da * dx[i__]; Chris@202: /* L10: */ Chris@202: } Chris@202: return 0; Chris@202: Chris@202: /* code for increment equal to 1 */ Chris@202: Chris@202: Chris@202: /* clean-up loop */ Chris@202: Chris@202: L20: Chris@202: m = *n % 5; Chris@202: if (m == 0) { Chris@202: goto L40; Chris@202: } Chris@202: i__2 = m; Chris@202: for (i__ = 1; i__ <= i__2; ++i__) { Chris@202: dx[i__] = *da * dx[i__]; Chris@202: /* L30: */ Chris@202: } Chris@202: if (*n < 5) { Chris@202: return 0; Chris@202: } Chris@202: L40: Chris@202: mp1 = m + 1; Chris@202: i__2 = *n; Chris@202: for (i__ = mp1; i__ <= i__2; i__ += 5) { Chris@202: dx[i__] = *da * dx[i__]; Chris@202: dx[i__ + 1] = *da * dx[i__ + 1]; Chris@202: dx[i__ + 2] = *da * dx[i__ + 2]; Chris@202: dx[i__ + 3] = *da * dx[i__ + 3]; Chris@202: dx[i__ + 4] = *da * dx[i__ + 4]; Chris@202: /* L50: */ Chris@202: } Chris@202: return 0; Chris@202: } /* dscal_ */