1*> \brief \b SLASWP performs a series of row interchanges on a general rectangular matrix.
2*
3*  =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6*            http://www.netlib.org/lapack/explore-html/
7*
8*> \htmlonly
9*> Download SLASWP + dependencies
10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slaswp.f">
11*> [TGZ]</a>
12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slaswp.f">
13*> [ZIP]</a>
14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slaswp.f">
15*> [TXT]</a>
16*> \endhtmlonly
17*
18*  Definition:
19*  ===========
20*
21*       SUBROUTINE SLASWP( N, A, LDA, K1, K2, IPIV, INCX )
22*
23*       .. Scalar Arguments ..
24*       INTEGER            INCX, K1, K2, LDA, N
25*       ..
26*       .. Array Arguments ..
27*       INTEGER            IPIV( * )
28*       REAL               A( LDA, * )
29*       ..
30*
31*
32*> \par Purpose:
33*  =============
34*>
35*> \verbatim
36*>
37*> SLASWP performs a series of row interchanges on the matrix A.
38*> One row interchange is initiated for each of rows K1 through K2 of A.
39*> \endverbatim
40*
41*  Arguments:
42*  ==========
43*
44*> \param[in] N
45*> \verbatim
46*>          N is INTEGER
47*>          The number of columns of the matrix A.
48*> \endverbatim
49*>
50*> \param[in,out] A
51*> \verbatim
52*>          A is REAL array, dimension (LDA,N)
53*>          On entry, the matrix of column dimension N to which the row
54*>          interchanges will be applied.
55*>          On exit, the permuted matrix.
56*> \endverbatim
57*>
58*> \param[in] LDA
59*> \verbatim
60*>          LDA is INTEGER
61*>          The leading dimension of the array A.
62*> \endverbatim
63*>
64*> \param[in] K1
65*> \verbatim
66*>          K1 is INTEGER
67*>          The first element of IPIV for which a row interchange will
68*>          be done.
69*> \endverbatim
70*>
71*> \param[in] K2
72*> \verbatim
73*>          K2 is INTEGER
74*>          The last element of IPIV for which a row interchange will
75*>          be done.
76*> \endverbatim
77*>
78*> \param[in] IPIV
79*> \verbatim
80*>          IPIV is INTEGER array, dimension (K2*abs(INCX))
81*>          The vector of pivot indices.  Only the elements in positions
82*>          K1 through K2 of IPIV are accessed.
83*>          IPIV(K) = L implies rows K and L are to be interchanged.
84*> \endverbatim
85*>
86*> \param[in] INCX
87*> \verbatim
88*>          INCX is INTEGER
89*>          The increment between successive values of IPIV.  If IPIV
90*>          is negative, the pivots are applied in reverse order.
91*> \endverbatim
92*
93*  Authors:
94*  ========
95*
96*> \author Univ. of Tennessee
97*> \author Univ. of California Berkeley
98*> \author Univ. of Colorado Denver
99*> \author NAG Ltd.
100*
101*> \date September 2012
102*
103*> \ingroup realOTHERauxiliary
104*
105*> \par Further Details:
106*  =====================
107*>
108*> \verbatim
109*>
110*>  Modified by
111*>   R. C. Whaley, Computer Science Dept., Univ. of Tenn., Knoxville, USA
112*> \endverbatim
113*>
114*  =====================================================================
115      SUBROUTINE SLASWP( N, A, LDA, K1, K2, IPIV, INCX )
116*
117*  -- LAPACK auxiliary routine (version 3.4.2) --
118*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
119*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
120*     September 2012
121*
122*     .. Scalar Arguments ..
123      INTEGER            INCX, K1, K2, LDA, N
124*     ..
125*     .. Array Arguments ..
126      INTEGER            IPIV( * )
127      REAL               A( LDA, * )
128*     ..
129*
130* =====================================================================
131*
132*     .. Local Scalars ..
133      INTEGER            I, I1, I2, INC, IP, IX, IX0, J, K, N32
134      REAL               TEMP
135*     ..
136*     .. Executable Statements ..
137*
138*     Interchange row I with row IPIV(I) for each of rows K1 through K2.
139*
140      IF( INCX.GT.0 ) THEN
141         IX0 = K1
142         I1 = K1
143         I2 = K2
144         INC = 1
145      ELSE IF( INCX.LT.0 ) THEN
146         IX0 = 1 + ( 1-K2 )*INCX
147         I1 = K2
148         I2 = K1
149         INC = -1
150      ELSE
151         RETURN
152      END IF
153*
154      N32 = ( N / 32 )*32
155      IF( N32.NE.0 ) THEN
156         DO 30 J = 1, N32, 32
157            IX = IX0
158            DO 20 I = I1, I2, INC
159               IP = IPIV( IX )
160               IF( IP.NE.I ) THEN
161                  DO 10 K = J, J + 31
162                     TEMP = A( I, K )
163                     A( I, K ) = A( IP, K )
164                     A( IP, K ) = TEMP
165   10             CONTINUE
166               END IF
167               IX = IX + INCX
168   20       CONTINUE
169   30    CONTINUE
170      END IF
171      IF( N32.NE.N ) THEN
172         N32 = N32 + 1
173         IX = IX0
174         DO 50 I = I1, I2, INC
175            IP = IPIV( IX )
176            IF( IP.NE.I ) THEN
177               DO 40 K = N32, N
178                  TEMP = A( I, K )
179                  A( I, K ) = A( IP, K )
180                  A( IP, K ) = TEMP
181   40          CONTINUE
182            END IF
183            IX = IX + INCX
184   50    CONTINUE
185      END IF
186*
187      RETURN
188*
189*     End of SLASWP
190*
191      END
192