annotate ext/cblas/src/dscal.c @ 464:0076c66d2932

Credit daschuer
author Chris Cannam <cannam@all-day-breakfast.com>
date Wed, 29 May 2019 13:55:07 +0100
parents 905e45637745
children
rev   line source
c@427 1 /* dscal.f -- translated by f2c (version 20061008).
c@427 2 You must link the resulting object file with libf2c:
c@427 3 on Microsoft Windows system, link with libf2c.lib;
c@427 4 on Linux or Unix systems, link with .../path/to/libf2c.a -lm
c@427 5 or, if you install libf2c.a in a standard place, with -lf2c -lm
c@427 6 -- in that order, at the end of the command line, as in
c@427 7 cc *.o -lf2c -lm
c@427 8 Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
c@427 9
c@427 10 http://www.netlib.org/f2c/libf2c.zip
c@427 11 */
c@427 12
c@427 13 #include "f2c.h"
c@427 14 #include "blaswrap.h"
c@427 15
c@427 16 /* Subroutine */ int dscal_(integer *n, doublereal *da, doublereal *dx,
c@427 17 integer *incx)
c@427 18 {
c@427 19 /* System generated locals */
c@427 20 integer i__1, i__2;
c@427 21
c@427 22 /* Local variables */
c@427 23 integer i__, m, mp1, nincx;
c@427 24
c@427 25 /* .. Scalar Arguments .. */
c@427 26 /* .. */
c@427 27 /* .. Array Arguments .. */
c@427 28 /* .. */
c@427 29
c@427 30 /* Purpose */
c@427 31 /* ======= */
c@427 32 /* * */
c@427 33 /* scales a vector by a constant. */
c@427 34 /* uses unrolled loops for increment equal to one. */
c@427 35 /* jack dongarra, linpack, 3/11/78. */
c@427 36 /* modified 3/93 to return if incx .le. 0. */
c@427 37 /* modified 12/3/93, array(1) declarations changed to array(*) */
c@427 38
c@427 39
c@427 40 /* .. Local Scalars .. */
c@427 41 /* .. */
c@427 42 /* .. Intrinsic Functions .. */
c@427 43 /* .. */
c@427 44 /* Parameter adjustments */
c@427 45 --dx;
c@427 46
c@427 47 /* Function Body */
c@427 48 if (*n <= 0 || *incx <= 0) {
c@427 49 return 0;
c@427 50 }
c@427 51 if (*incx == 1) {
c@427 52 goto L20;
c@427 53 }
c@427 54
c@427 55 /* code for increment not equal to 1 */
c@427 56
c@427 57 nincx = *n * *incx;
c@427 58 i__1 = nincx;
c@427 59 i__2 = *incx;
c@427 60 for (i__ = 1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) {
c@427 61 dx[i__] = *da * dx[i__];
c@427 62 /* L10: */
c@427 63 }
c@427 64 return 0;
c@427 65
c@427 66 /* code for increment equal to 1 */
c@427 67
c@427 68
c@427 69 /* clean-up loop */
c@427 70
c@427 71 L20:
c@427 72 m = *n % 5;
c@427 73 if (m == 0) {
c@427 74 goto L40;
c@427 75 }
c@427 76 i__2 = m;
c@427 77 for (i__ = 1; i__ <= i__2; ++i__) {
c@427 78 dx[i__] = *da * dx[i__];
c@427 79 /* L30: */
c@427 80 }
c@427 81 if (*n < 5) {
c@427 82 return 0;
c@427 83 }
c@427 84 L40:
c@427 85 mp1 = m + 1;
c@427 86 i__2 = *n;
c@427 87 for (i__ = mp1; i__ <= i__2; i__ += 5) {
c@427 88 dx[i__] = *da * dx[i__];
c@427 89 dx[i__ + 1] = *da * dx[i__ + 1];
c@427 90 dx[i__ + 2] = *da * dx[i__ + 2];
c@427 91 dx[i__ + 3] = *da * dx[i__ + 3];
c@427 92 dx[i__ + 4] = *da * dx[i__ + 4];
c@427 93 /* L50: */
c@427 94 }
c@427 95 return 0;
c@427 96 } /* dscal_ */