annotate ext/clapack/src/dlaswp.c @ 209:ccd2019190bf msvc

Some MSVC fixes, including (temporarily, probably) renaming the FFT source file to avoid getting it mixed up with the Vamp SDK one in our object dir
author Chris Cannam
date Thu, 01 Feb 2018 16:34:08 +0000
parents 45330e0d2819
children
rev   line source
Chris@202 1 /* dlaswp.f -- translated by f2c (version 20061008).
Chris@202 2 You must link the resulting object file with libf2c:
Chris@202 3 on Microsoft Windows system, link with libf2c.lib;
Chris@202 4 on Linux or Unix systems, link with .../path/to/libf2c.a -lm
Chris@202 5 or, if you install libf2c.a in a standard place, with -lf2c -lm
Chris@202 6 -- in that order, at the end of the command line, as in
Chris@202 7 cc *.o -lf2c -lm
Chris@202 8 Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
Chris@202 9
Chris@202 10 http://www.netlib.org/f2c/libf2c.zip
Chris@202 11 */
Chris@202 12
Chris@202 13 #include "f2c.h"
Chris@202 14 #include "blaswrap.h"
Chris@202 15
Chris@202 16 /* Subroutine */ int dlaswp_(integer *n, doublereal *a, integer *lda, integer
Chris@202 17 *k1, integer *k2, integer *ipiv, integer *incx)
Chris@202 18 {
Chris@202 19 /* System generated locals */
Chris@202 20 integer a_dim1, a_offset, i__1, i__2, i__3, i__4;
Chris@202 21
Chris@202 22 /* Local variables */
Chris@202 23 integer i__, j, k, i1, i2, n32, ip, ix, ix0, inc;
Chris@202 24 doublereal temp;
Chris@202 25
Chris@202 26
Chris@202 27 /* -- LAPACK auxiliary routine (version 3.2) -- */
Chris@202 28 /* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
Chris@202 29 /* November 2006 */
Chris@202 30
Chris@202 31 /* .. Scalar Arguments .. */
Chris@202 32 /* .. */
Chris@202 33 /* .. Array Arguments .. */
Chris@202 34 /* .. */
Chris@202 35
Chris@202 36 /* Purpose */
Chris@202 37 /* ======= */
Chris@202 38
Chris@202 39 /* DLASWP performs a series of row interchanges on the matrix A. */
Chris@202 40 /* One row interchange is initiated for each of rows K1 through K2 of A. */
Chris@202 41
Chris@202 42 /* Arguments */
Chris@202 43 /* ========= */
Chris@202 44
Chris@202 45 /* N (input) INTEGER */
Chris@202 46 /* The number of columns of the matrix A. */
Chris@202 47
Chris@202 48 /* A (input/output) DOUBLE PRECISION array, dimension (LDA,N) */
Chris@202 49 /* On entry, the matrix of column dimension N to which the row */
Chris@202 50 /* interchanges will be applied. */
Chris@202 51 /* On exit, the permuted matrix. */
Chris@202 52
Chris@202 53 /* LDA (input) INTEGER */
Chris@202 54 /* The leading dimension of the array A. */
Chris@202 55
Chris@202 56 /* K1 (input) INTEGER */
Chris@202 57 /* The first element of IPIV for which a row interchange will */
Chris@202 58 /* be done. */
Chris@202 59
Chris@202 60 /* K2 (input) INTEGER */
Chris@202 61 /* The last element of IPIV for which a row interchange will */
Chris@202 62 /* be done. */
Chris@202 63
Chris@202 64 /* IPIV (input) INTEGER array, dimension (K2*abs(INCX)) */
Chris@202 65 /* The vector of pivot indices. Only the elements in positions */
Chris@202 66 /* K1 through K2 of IPIV are accessed. */
Chris@202 67 /* IPIV(K) = L implies rows K and L are to be interchanged. */
Chris@202 68
Chris@202 69 /* INCX (input) INTEGER */
Chris@202 70 /* The increment between successive values of IPIV. If IPIV */
Chris@202 71 /* is negative, the pivots are applied in reverse order. */
Chris@202 72
Chris@202 73 /* Further Details */
Chris@202 74 /* =============== */
Chris@202 75
Chris@202 76 /* Modified by */
Chris@202 77 /* R. C. Whaley, Computer Science Dept., Univ. of Tenn., Knoxville, USA */
Chris@202 78
Chris@202 79 /* ===================================================================== */
Chris@202 80
Chris@202 81 /* .. Local Scalars .. */
Chris@202 82 /* .. */
Chris@202 83 /* .. Executable Statements .. */
Chris@202 84
Chris@202 85 /* Interchange row I with row IPIV(I) for each of rows K1 through K2. */
Chris@202 86
Chris@202 87 /* Parameter adjustments */
Chris@202 88 a_dim1 = *lda;
Chris@202 89 a_offset = 1 + a_dim1;
Chris@202 90 a -= a_offset;
Chris@202 91 --ipiv;
Chris@202 92
Chris@202 93 /* Function Body */
Chris@202 94 if (*incx > 0) {
Chris@202 95 ix0 = *k1;
Chris@202 96 i1 = *k1;
Chris@202 97 i2 = *k2;
Chris@202 98 inc = 1;
Chris@202 99 } else if (*incx < 0) {
Chris@202 100 ix0 = (1 - *k2) * *incx + 1;
Chris@202 101 i1 = *k2;
Chris@202 102 i2 = *k1;
Chris@202 103 inc = -1;
Chris@202 104 } else {
Chris@202 105 return 0;
Chris@202 106 }
Chris@202 107
Chris@202 108 n32 = *n / 32 << 5;
Chris@202 109 if (n32 != 0) {
Chris@202 110 i__1 = n32;
Chris@202 111 for (j = 1; j <= i__1; j += 32) {
Chris@202 112 ix = ix0;
Chris@202 113 i__2 = i2;
Chris@202 114 i__3 = inc;
Chris@202 115 for (i__ = i1; i__3 < 0 ? i__ >= i__2 : i__ <= i__2; i__ += i__3)
Chris@202 116 {
Chris@202 117 ip = ipiv[ix];
Chris@202 118 if (ip != i__) {
Chris@202 119 i__4 = j + 31;
Chris@202 120 for (k = j; k <= i__4; ++k) {
Chris@202 121 temp = a[i__ + k * a_dim1];
Chris@202 122 a[i__ + k * a_dim1] = a[ip + k * a_dim1];
Chris@202 123 a[ip + k * a_dim1] = temp;
Chris@202 124 /* L10: */
Chris@202 125 }
Chris@202 126 }
Chris@202 127 ix += *incx;
Chris@202 128 /* L20: */
Chris@202 129 }
Chris@202 130 /* L30: */
Chris@202 131 }
Chris@202 132 }
Chris@202 133 if (n32 != *n) {
Chris@202 134 ++n32;
Chris@202 135 ix = ix0;
Chris@202 136 i__1 = i2;
Chris@202 137 i__3 = inc;
Chris@202 138 for (i__ = i1; i__3 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__3) {
Chris@202 139 ip = ipiv[ix];
Chris@202 140 if (ip != i__) {
Chris@202 141 i__2 = *n;
Chris@202 142 for (k = n32; k <= i__2; ++k) {
Chris@202 143 temp = a[i__ + k * a_dim1];
Chris@202 144 a[i__ + k * a_dim1] = a[ip + k * a_dim1];
Chris@202 145 a[ip + k * a_dim1] = temp;
Chris@202 146 /* L40: */
Chris@202 147 }
Chris@202 148 }
Chris@202 149 ix += *incx;
Chris@202 150 /* L50: */
Chris@202 151 }
Chris@202 152 }
Chris@202 153
Chris@202 154 return 0;
Chris@202 155
Chris@202 156 /* End of DLASWP */
Chris@202 157
Chris@202 158 } /* dlaswp_ */