annotate ext/clapack/src/dlaswp.c @ 427:905e45637745

Add the CLAPACK and CBLAS/F2C-BLAS files we use
author Chris Cannam <c.cannam@qmul.ac.uk>
date Fri, 30 Sep 2016 15:51:22 +0100
parents
children
rev   line source
c@427 1 /* dlaswp.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 dlaswp_(integer *n, doublereal *a, integer *lda, integer
c@427 17 *k1, integer *k2, integer *ipiv, integer *incx)
c@427 18 {
c@427 19 /* System generated locals */
c@427 20 integer a_dim1, a_offset, i__1, i__2, i__3, i__4;
c@427 21
c@427 22 /* Local variables */
c@427 23 integer i__, j, k, i1, i2, n32, ip, ix, ix0, inc;
c@427 24 doublereal temp;
c@427 25
c@427 26
c@427 27 /* -- LAPACK auxiliary routine (version 3.2) -- */
c@427 28 /* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
c@427 29 /* November 2006 */
c@427 30
c@427 31 /* .. Scalar Arguments .. */
c@427 32 /* .. */
c@427 33 /* .. Array Arguments .. */
c@427 34 /* .. */
c@427 35
c@427 36 /* Purpose */
c@427 37 /* ======= */
c@427 38
c@427 39 /* DLASWP performs a series of row interchanges on the matrix A. */
c@427 40 /* One row interchange is initiated for each of rows K1 through K2 of A. */
c@427 41
c@427 42 /* Arguments */
c@427 43 /* ========= */
c@427 44
c@427 45 /* N (input) INTEGER */
c@427 46 /* The number of columns of the matrix A. */
c@427 47
c@427 48 /* A (input/output) DOUBLE PRECISION array, dimension (LDA,N) */
c@427 49 /* On entry, the matrix of column dimension N to which the row */
c@427 50 /* interchanges will be applied. */
c@427 51 /* On exit, the permuted matrix. */
c@427 52
c@427 53 /* LDA (input) INTEGER */
c@427 54 /* The leading dimension of the array A. */
c@427 55
c@427 56 /* K1 (input) INTEGER */
c@427 57 /* The first element of IPIV for which a row interchange will */
c@427 58 /* be done. */
c@427 59
c@427 60 /* K2 (input) INTEGER */
c@427 61 /* The last element of IPIV for which a row interchange will */
c@427 62 /* be done. */
c@427 63
c@427 64 /* IPIV (input) INTEGER array, dimension (K2*abs(INCX)) */
c@427 65 /* The vector of pivot indices. Only the elements in positions */
c@427 66 /* K1 through K2 of IPIV are accessed. */
c@427 67 /* IPIV(K) = L implies rows K and L are to be interchanged. */
c@427 68
c@427 69 /* INCX (input) INTEGER */
c@427 70 /* The increment between successive values of IPIV. If IPIV */
c@427 71 /* is negative, the pivots are applied in reverse order. */
c@427 72
c@427 73 /* Further Details */
c@427 74 /* =============== */
c@427 75
c@427 76 /* Modified by */
c@427 77 /* R. C. Whaley, Computer Science Dept., Univ. of Tenn., Knoxville, USA */
c@427 78
c@427 79 /* ===================================================================== */
c@427 80
c@427 81 /* .. Local Scalars .. */
c@427 82 /* .. */
c@427 83 /* .. Executable Statements .. */
c@427 84
c@427 85 /* Interchange row I with row IPIV(I) for each of rows K1 through K2. */
c@427 86
c@427 87 /* Parameter adjustments */
c@427 88 a_dim1 = *lda;
c@427 89 a_offset = 1 + a_dim1;
c@427 90 a -= a_offset;
c@427 91 --ipiv;
c@427 92
c@427 93 /* Function Body */
c@427 94 if (*incx > 0) {
c@427 95 ix0 = *k1;
c@427 96 i1 = *k1;
c@427 97 i2 = *k2;
c@427 98 inc = 1;
c@427 99 } else if (*incx < 0) {
c@427 100 ix0 = (1 - *k2) * *incx + 1;
c@427 101 i1 = *k2;
c@427 102 i2 = *k1;
c@427 103 inc = -1;
c@427 104 } else {
c@427 105 return 0;
c@427 106 }
c@427 107
c@427 108 n32 = *n / 32 << 5;
c@427 109 if (n32 != 0) {
c@427 110 i__1 = n32;
c@427 111 for (j = 1; j <= i__1; j += 32) {
c@427 112 ix = ix0;
c@427 113 i__2 = i2;
c@427 114 i__3 = inc;
c@427 115 for (i__ = i1; i__3 < 0 ? i__ >= i__2 : i__ <= i__2; i__ += i__3)
c@427 116 {
c@427 117 ip = ipiv[ix];
c@427 118 if (ip != i__) {
c@427 119 i__4 = j + 31;
c@427 120 for (k = j; k <= i__4; ++k) {
c@427 121 temp = a[i__ + k * a_dim1];
c@427 122 a[i__ + k * a_dim1] = a[ip + k * a_dim1];
c@427 123 a[ip + k * a_dim1] = temp;
c@427 124 /* L10: */
c@427 125 }
c@427 126 }
c@427 127 ix += *incx;
c@427 128 /* L20: */
c@427 129 }
c@427 130 /* L30: */
c@427 131 }
c@427 132 }
c@427 133 if (n32 != *n) {
c@427 134 ++n32;
c@427 135 ix = ix0;
c@427 136 i__1 = i2;
c@427 137 i__3 = inc;
c@427 138 for (i__ = i1; i__3 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__3) {
c@427 139 ip = ipiv[ix];
c@427 140 if (ip != i__) {
c@427 141 i__2 = *n;
c@427 142 for (k = n32; k <= i__2; ++k) {
c@427 143 temp = a[i__ + k * a_dim1];
c@427 144 a[i__ + k * a_dim1] = a[ip + k * a_dim1];
c@427 145 a[ip + k * a_dim1] = temp;
c@427 146 /* L40: */
c@427 147 }
c@427 148 }
c@427 149 ix += *incx;
c@427 150 /* L50: */
c@427 151 }
c@427 152 }
c@427 153
c@427 154 return 0;
c@427 155
c@427 156 /* End of DLASWP */
c@427 157
c@427 158 } /* dlaswp_ */