1*> \brief \b DLASWP 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 DLASWP + dependencies
10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlaswp.f">
11*> [TGZ]</a>
12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlaswp.f">
13*> [ZIP]</a>
14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlaswp.f">
15*> [TXT]</a>
16*> \endhtmlonly
17*
18*  Definition:
19*  ===========
20*
21*       SUBROUTINE DLASWP( 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*       DOUBLE PRECISION   A( LDA, * )
29*       ..
30*
31*
32*> \par Purpose:
33*  =============
34*>
35*> \verbatim
36*>
37*> DLASWP 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 DOUBLE PRECISION 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*> \date June 2017
103*
104*> \ingroup doubleOTHERauxiliary
105*
106*> \par Further Details:
107*  =====================
108*>
109*> \verbatim
110*>
111*>  Modified by
112*>   R. C. Whaley, Computer Science Dept., Univ. of Tenn., Knoxville, USA
113*> \endverbatim
114*>
115*  =====================================================================
116      SUBROUTINE DLASWP( N, A, LDA, K1, K2, IPIV, INCX )
117*
118*  -- LAPACK auxiliary routine (version 3.7.1) --
119*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
120*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
121*     June 2017
122*
123*     .. Scalar Arguments ..
124      INTEGER            INCX, K1, K2, LDA, N
125*     ..
126*     .. Array Arguments ..
127      INTEGER            IPIV( * )
128      DOUBLE PRECISION   A( LDA, * )
129*     ..
130*
131* =====================================================================
132*
133*     .. Local Scalars ..
134      INTEGER            I, I1, I2, INC, IP, IX, IX0, J, K, N32
135      DOUBLE PRECISION   TEMP
136*     ..
137*     .. Executable Statements ..
138*
139*     Interchange row I with row IPIV(K1+(I-K1)*abs(INCX)) for each of rows
140*     K1 through K2.
141*
142      IF( INCX.GT.0 ) THEN
143         IX0 = K1
144         I1 = K1
145         I2 = K2
146         INC = 1
147      ELSE IF( INCX.LT.0 ) THEN
148         IX0 = K1 + ( K1-K2 )*INCX
149         I1 = K2
150         I2 = K1
151         INC = -1
152      ELSE
153         RETURN
154      END IF
155*
156      N32 = ( N / 32 )*32
157      IF( N32.NE.0 ) THEN
158         DO 30 J = 1, N32, 32
159            IX = IX0
160            DO 20 I = I1, I2, INC
161               IP = IPIV( IX )
162               IF( IP.NE.I ) THEN
163                  DO 10 K = J, J + 31
164                     TEMP = A( I, K )
165                     A( I, K ) = A( IP, K )
166                     A( IP, K ) = TEMP
167   10             CONTINUE
168               END IF
169               IX = IX + INCX
170   20       CONTINUE
171   30    CONTINUE
172      END IF
173      IF( N32.NE.N ) THEN
174         N32 = N32 + 1
175         IX = IX0
176         DO 50 I = I1, I2, INC
177            IP = IPIV( IX )
178            IF( IP.NE.I ) THEN
179               DO 40 K = N32, N
180                  TEMP = A( I, K )
181                  A( I, K ) = A( IP, K )
182                  A( IP, K ) = TEMP
183   40          CONTINUE
184            END IF
185            IX = IX + INCX
186   50    CONTINUE
187      END IF
188*
189      RETURN
190*
191*     End of DLASWP
192*
193      END
194