git.maemo.org Git - opencv/blob - 3rdparty/lapack/dlaswp.c

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