1 SUBROUTINE DLASWP( N, A, LDA, K1, K2, IPIV, INCX )
2 *
3 * -- LAPACK auxiliary routine (version 3.2) --
4 * -- LAPACK is a software package provided by Univ. of Tennessee, --
5 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
6 * November 2006
7 *
8 * .. Scalar Arguments ..
9 INTEGER INCX, K1, K2, LDA, N
10 * ..
11 * .. Array Arguments ..
12 INTEGER IPIV( * )
13 DOUBLE PRECISION A( LDA, * )
14 * ..
15 *
16 * Purpose
17 * =======
18 *
19 * DLASWP performs a series of row interchanges on the matrix A.
20 * One row interchange is initiated for each of rows K1 through K2 of A.
21 *
22 * Arguments
23 * =========
24 *
25 * N (input) INTEGER
26 * The number of columns of the matrix A.
27 *
28 * A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
29 * On entry, the matrix of column dimension N to which the row
30 * interchanges will be applied.
31 * On exit, the permuted matrix.
32 *
33 * LDA (input) INTEGER
34 * The leading dimension of the array A.
35 *
36 * K1 (input) INTEGER
37 * The first element of IPIV for which a row interchange will
38 * be done.
39 *
40 * K2 (input) INTEGER
41 * The last element of IPIV for which a row interchange will
42 * be done.
43 *
44 * IPIV (input) INTEGER array, dimension (K2*abs(INCX))
45 * The vector of pivot indices. Only the elements in positions
46 * K1 through K2 of IPIV are accessed.
47 * IPIV(K) = L implies rows K and L are to be interchanged.
48 *
49 * INCX (input) INTEGER
50 * The increment between successive values of IPIV. If IPIV
51 * is negative, the pivots are applied in reverse order.
52 *
53 * Further Details
54 * ===============
55 *
56 * Modified by
57 * R. C. Whaley, Computer Science Dept., Univ. of Tenn., Knoxville, USA
58 *
59 * =====================================================================
60 *
61 * .. Local Scalars ..
62 INTEGER I, I1, I2, INC, IP, IX, IX0, J, K, N32
63 DOUBLE PRECISION TEMP
64 * ..
65 * .. Executable Statements ..
66 *
67 * Interchange row I with row IPIV(I) for each of rows K1 through K2.
68 *
69 IF( INCX.GT.0 ) THEN
70 IX0 = K1
71 I1 = K1
72 I2 = K2
73 INC = 1
74 ELSE IF( INCX.LT.0 ) THEN
75 IX0 = 1 + ( 1-K2 )*INCX
76 I1 = K2
77 I2 = K1
78 INC = -1
79 ELSE
80 RETURN
81 END IF
82 *
83 N32 = ( N / 32 )*32
84 IF( N32.NE.0 ) THEN
85 DO 30 J = 1, N32, 32
86 IX = IX0
87 DO 20 I = I1, I2, INC
88 IP = IPIV( IX )
89 IF( IP.NE.I ) THEN
90 DO 10 K = J, J + 31
91 TEMP = A( I, K )
92 A( I, K ) = A( IP, K )
93 A( IP, K ) = TEMP
94 10 CONTINUE
95 END IF
96 IX = IX + INCX
97 20 CONTINUE
98 30 CONTINUE
99 END IF
100 IF( N32.NE.N ) THEN
101 N32 = N32 + 1
102 IX = IX0
103 DO 50 I = I1, I2, INC
104 IP = IPIV( IX )
105 IF( IP.NE.I ) THEN
106 DO 40 K = N32, N
107 TEMP = A( I, K )
108 A( I, K ) = A( IP, K )
109 A( IP, K ) = TEMP
110 40 CONTINUE
111 END IF
112 IX = IX + INCX
113 50 CONTINUE
114 END IF
115 *
116 RETURN
117 *
118 * End of DLASWP
119 *
120 END
2 *
3 * -- LAPACK auxiliary routine (version 3.2) --
4 * -- LAPACK is a software package provided by Univ. of Tennessee, --
5 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
6 * November 2006
7 *
8 * .. Scalar Arguments ..
9 INTEGER INCX, K1, K2, LDA, N
10 * ..
11 * .. Array Arguments ..
12 INTEGER IPIV( * )
13 DOUBLE PRECISION A( LDA, * )
14 * ..
15 *
16 * Purpose
17 * =======
18 *
19 * DLASWP performs a series of row interchanges on the matrix A.
20 * One row interchange is initiated for each of rows K1 through K2 of A.
21 *
22 * Arguments
23 * =========
24 *
25 * N (input) INTEGER
26 * The number of columns of the matrix A.
27 *
28 * A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
29 * On entry, the matrix of column dimension N to which the row
30 * interchanges will be applied.
31 * On exit, the permuted matrix.
32 *
33 * LDA (input) INTEGER
34 * The leading dimension of the array A.
35 *
36 * K1 (input) INTEGER
37 * The first element of IPIV for which a row interchange will
38 * be done.
39 *
40 * K2 (input) INTEGER
41 * The last element of IPIV for which a row interchange will
42 * be done.
43 *
44 * IPIV (input) INTEGER array, dimension (K2*abs(INCX))
45 * The vector of pivot indices. Only the elements in positions
46 * K1 through K2 of IPIV are accessed.
47 * IPIV(K) = L implies rows K and L are to be interchanged.
48 *
49 * INCX (input) INTEGER
50 * The increment between successive values of IPIV. If IPIV
51 * is negative, the pivots are applied in reverse order.
52 *
53 * Further Details
54 * ===============
55 *
56 * Modified by
57 * R. C. Whaley, Computer Science Dept., Univ. of Tenn., Knoxville, USA
58 *
59 * =====================================================================
60 *
61 * .. Local Scalars ..
62 INTEGER I, I1, I2, INC, IP, IX, IX0, J, K, N32
63 DOUBLE PRECISION TEMP
64 * ..
65 * .. Executable Statements ..
66 *
67 * Interchange row I with row IPIV(I) for each of rows K1 through K2.
68 *
69 IF( INCX.GT.0 ) THEN
70 IX0 = K1
71 I1 = K1
72 I2 = K2
73 INC = 1
74 ELSE IF( INCX.LT.0 ) THEN
75 IX0 = 1 + ( 1-K2 )*INCX
76 I1 = K2
77 I2 = K1
78 INC = -1
79 ELSE
80 RETURN
81 END IF
82 *
83 N32 = ( N / 32 )*32
84 IF( N32.NE.0 ) THEN
85 DO 30 J = 1, N32, 32
86 IX = IX0
87 DO 20 I = I1, I2, INC
88 IP = IPIV( IX )
89 IF( IP.NE.I ) THEN
90 DO 10 K = J, J + 31
91 TEMP = A( I, K )
92 A( I, K ) = A( IP, K )
93 A( IP, K ) = TEMP
94 10 CONTINUE
95 END IF
96 IX = IX + INCX
97 20 CONTINUE
98 30 CONTINUE
99 END IF
100 IF( N32.NE.N ) THEN
101 N32 = N32 + 1
102 IX = IX0
103 DO 50 I = I1, I2, INC
104 IP = IPIV( IX )
105 IF( IP.NE.I ) THEN
106 DO 40 K = N32, N
107 TEMP = A( I, K )
108 A( I, K ) = A( IP, K )
109 A( IP, K ) = TEMP
110 40 CONTINUE
111 END IF
112 IX = IX + INCX
113 50 CONTINUE
114 END IF
115 *
116 RETURN
117 *
118 * End of DLASWP
119 *
120 END