slaswp.c
Go to the documentation of this file.
00001 /* slaswp.f -- translated by f2c (version 20061008).
00002    You must link the resulting object file with libf2c:
00003         on Microsoft Windows system, link with libf2c.lib;
00004         on Linux or Unix systems, link with .../path/to/libf2c.a -lm
00005         or, if you install libf2c.a in a standard place, with -lf2c -lm
00006         -- in that order, at the end of the command line, as in
00007                 cc *.o -lf2c -lm
00008         Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
00009 
00010                 http://www.netlib.org/f2c/libf2c.zip
00011 */
00012 
00013 #include "f2c.h"
00014 #include "blaswrap.h"
00015 
00016 /* Subroutine */ int slaswp_(integer *n, real *a, integer *lda, integer *k1, 
00017         integer *k2, integer *ipiv, integer *incx)
00018 {
00019     /* System generated locals */
00020     integer a_dim1, a_offset, i__1, i__2, i__3, i__4;
00021 
00022     /* Local variables */
00023     integer i__, j, k, i1, i2, n32, ip, ix, ix0, inc;
00024     real temp;
00025 
00026 
00027 /*  -- LAPACK auxiliary routine (version 3.2) -- */
00028 /*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
00029 /*     November 2006 */
00030 
00031 /*     .. Scalar Arguments .. */
00032 /*     .. */
00033 /*     .. Array Arguments .. */
00034 /*     .. */
00035 
00036 /*  Purpose */
00037 /*  ======= */
00038 
00039 /*  SLASWP performs a series of row interchanges on the matrix A. */
00040 /*  One row interchange is initiated for each of rows K1 through K2 of A. */
00041 
00042 /*  Arguments */
00043 /*  ========= */
00044 
00045 /*  N       (input) INTEGER */
00046 /*          The number of columns of the matrix A. */
00047 
00048 /*  A       (input/output) REAL array, dimension (LDA,N) */
00049 /*          On entry, the matrix of column dimension N to which the row */
00050 /*          interchanges will be applied. */
00051 /*          On exit, the permuted matrix. */
00052 
00053 /*  LDA     (input) INTEGER */
00054 /*          The leading dimension of the array A. */
00055 
00056 /*  K1      (input) INTEGER */
00057 /*          The first element of IPIV for which a row interchange will */
00058 /*          be done. */
00059 
00060 /*  K2      (input) INTEGER */
00061 /*          The last element of IPIV for which a row interchange will */
00062 /*          be done. */
00063 
00064 /*  IPIV    (input) INTEGER array, dimension (K2*abs(INCX)) */
00065 /*          The vector of pivot indices.  Only the elements in positions */
00066 /*          K1 through K2 of IPIV are accessed. */
00067 /*          IPIV(K) = L implies rows K and L are to be interchanged. */
00068 
00069 /*  INCX    (input) INTEGER */
00070 /*          The increment between successive values of IPIV.  If IPIV */
00071 /*          is negative, the pivots are applied in reverse order. */
00072 
00073 /*  Further Details */
00074 /*  =============== */
00075 
00076 /*  Modified by */
00077 /*   R. C. Whaley, Computer Science Dept., Univ. of Tenn., Knoxville, USA */
00078 
00079 /* ===================================================================== */
00080 
00081 /*     .. Local Scalars .. */
00082 /*     .. */
00083 /*     .. Executable Statements .. */
00084 
00085 /*     Interchange row I with row IPIV(I) for each of rows K1 through K2. */
00086 
00087     /* Parameter adjustments */
00088     a_dim1 = *lda;
00089     a_offset = 1 + a_dim1;
00090     a -= a_offset;
00091     --ipiv;
00092 
00093     /* Function Body */
00094     if (*incx > 0) {
00095         ix0 = *k1;
00096         i1 = *k1;
00097         i2 = *k2;
00098         inc = 1;
00099     } else if (*incx < 0) {
00100         ix0 = (1 - *k2) * *incx + 1;
00101         i1 = *k2;
00102         i2 = *k1;
00103         inc = -1;
00104     } else {
00105         return 0;
00106     }
00107 
00108     n32 = *n / 32 << 5;
00109     if (n32 != 0) {
00110         i__1 = n32;
00111         for (j = 1; j <= i__1; j += 32) {
00112             ix = ix0;
00113             i__2 = i2;
00114             i__3 = inc;
00115             for (i__ = i1; i__3 < 0 ? i__ >= i__2 : i__ <= i__2; i__ += i__3) 
00116                     {
00117                 ip = ipiv[ix];
00118                 if (ip != i__) {
00119                     i__4 = j + 31;
00120                     for (k = j; k <= i__4; ++k) {
00121                         temp = a[i__ + k * a_dim1];
00122                         a[i__ + k * a_dim1] = a[ip + k * a_dim1];
00123                         a[ip + k * a_dim1] = temp;
00124 /* L10: */
00125                     }
00126                 }
00127                 ix += *incx;
00128 /* L20: */
00129             }
00130 /* L30: */
00131         }
00132     }
00133     if (n32 != *n) {
00134         ++n32;
00135         ix = ix0;
00136         i__1 = i2;
00137         i__3 = inc;
00138         for (i__ = i1; i__3 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__3) {
00139             ip = ipiv[ix];
00140             if (ip != i__) {
00141                 i__2 = *n;
00142                 for (k = n32; k <= i__2; ++k) {
00143                     temp = a[i__ + k * a_dim1];
00144                     a[i__ + k * a_dim1] = a[ip + k * a_dim1];
00145                     a[ip + k * a_dim1] = temp;
00146 /* L40: */
00147                 }
00148             }
00149             ix += *incx;
00150 /* L50: */
00151         }
00152     }
00153 
00154     return 0;
00155 
00156 /*     End of SLASWP */
00157 
00158 } /* slaswp_ */


swiftnav
Author(s):
autogenerated on Sat Jun 8 2019 18:56:11