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*>          (K2-K1+1) is the number of elements of IPIV for which a row
75*>          interchange will be done.
76*> \endverbatim
77*>
78*> \param[in] IPIV
79*> \verbatim
80*>          IPIV is INTEGER array, dimension (K1+(K2-K1)*abs(INCX))
81*>          The vector of pivot indices. Only the elements in positions
82*>          K1 through K1+(K2-K1)*abs(INCX) of IPIV are accessed.
83*>          IPIV(K1+(K-K1)*abs(INCX)) = L implies rows K and L are to be
84*>          interchanged.
85*> \endverbatim
86*>
87*> \param[in] INCX
88*> \verbatim
89*>          INCX is INTEGER
90*>          The increment between successive values of IPIV. If INCX
91*>          is negative, the pivots are applied in reverse order.
92*> \endverbatim
93*
94*  Authors:
95*  ========
96*
97*> \author Univ. of Tennessee
98*> \author Univ. of California Berkeley
99*> \author Univ. of Colorado Denver
100*> \author NAG Ltd.
101*
102*> \ingroup realOTHERauxiliary
103*
104*> \par Further Details:
105*  =====================
106*>
107*> \verbatim
108*>
109*>  Modified by
110*>   R. C. Whaley, Computer Science Dept., Univ. of Tenn., Knoxville, USA
111*> \endverbatim
112*>
113*  =====================================================================
114      SUBROUTINE SLASWP( N, A, LDA, K1, K2, IPIV, INCX )
115*
116*  -- LAPACK auxiliary routine --
117*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
118*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
119*
120*     .. Scalar Arguments ..
121      INTEGER            INCX, K1, K2, LDA, N
122*     ..
123*     .. Array Arguments ..
124      INTEGER            IPIV( * )
125      REAL               A( LDA, * )
126*     ..
127*
128* =====================================================================
129*
130*     .. Local Scalars ..
131      INTEGER            I, I1, I2, INC, IP, IX, IX0, J, K, N32
132      REAL               TEMP
133*     ..
134*     .. Executable Statements ..
135*
136*     Interchange row I with row IPIV(K1+(I-K1)*abs(INCX)) for each of rows
137*     K1 through K2.
138*
139      IF( INCX.GT.0 ) THEN
140         IX0 = K1
141         I1 = K1
142         I2 = K2
143         INC = 1
144      ELSE IF( INCX.LT.0 ) THEN
145         IX0 = K1 + ( K1-K2 )*INCX
146         I1 = K2
147         I2 = K1
148         INC = -1
149      ELSE
150         RETURN
151      END IF
152*
153      N32 = ( N / 32 )*32
154      IF( N32.NE.0 ) THEN
155         DO 30 J = 1, N32, 32
156            IX = IX0
157            DO 20 I = I1, I2, INC
158               IP = IPIV( IX )
159               IF( IP.NE.I ) THEN
160                  DO 10 K = J, J + 31
161                     TEMP = A( I, K )
162                     A( I, K ) = A( IP, K )
163                     A( IP, K ) = TEMP
164   10             CONTINUE
165               END IF
166               IX = IX + INCX
167   20       CONTINUE
168   30    CONTINUE
169      END IF
170      IF( N32.NE.N ) THEN
171         N32 = N32 + 1
172         IX = IX0
173         DO 50 I = I1, I2, INC
174            IP = IPIV( IX )
175            IF( IP.NE.I ) THEN
176               DO 40 K = N32, N
177                  TEMP = A( I, K )
178                  A( I, K ) = A( IP, K )
179                  A( IP, K ) = TEMP
180   40          CONTINUE
181            END IF
182            IX = IX + INCX
183   50    CONTINUE
184      END IF
185*
186      RETURN
187*
188*     End of SLASWP
189*
190      END
191