001:       SUBROUTINE SLASWP( N, A, LDA, K1, K2, IPIV, INCX )
002: *
003: *  -- LAPACK auxiliary routine (version 3.2) --
004: *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
005: *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
006: *     November 2006
007: *
008: *     .. Scalar Arguments ..
009:       INTEGER            INCX, K1, K2, LDA, N
010: *     ..
011: *     .. Array Arguments ..
012:       INTEGER            IPIV( * )
013:       REAL               A( LDA, * )
014: *     ..
015: *
016: *  Purpose
017: *  =======
018: *
019: *  SLASWP performs a series of row interchanges on the matrix A.
020: *  One row interchange is initiated for each of rows K1 through K2 of A.
021: *
022: *  Arguments
023: *  =========
024: *
025: *  N       (input) INTEGER
026: *          The number of columns of the matrix A.
027: *
028: *  A       (input/output) REAL array, dimension (LDA,N)
029: *          On entry, the matrix of column dimension N to which the row
030: *          interchanges will be applied.
031: *          On exit, the permuted matrix.
032: *
033: *  LDA     (input) INTEGER
034: *          The leading dimension of the array A.
035: *
036: *  K1      (input) INTEGER
037: *          The first element of IPIV for which a row interchange will
038: *          be done.
039: *
040: *  K2      (input) INTEGER
041: *          The last element of IPIV for which a row interchange will
042: *          be done.
043: *
044: *  IPIV    (input) INTEGER array, dimension (K2*abs(INCX))
045: *          The vector of pivot indices.  Only the elements in positions
046: *          K1 through K2 of IPIV are accessed.
047: *          IPIV(K) = L implies rows K and L are to be interchanged.
048: *
049: *  INCX    (input) INTEGER
050: *          The increment between successive values of IPIV.  If IPIV
051: *          is negative, the pivots are applied in reverse order.
052: *
053: *  Further Details
054: *  ===============
055: *
056: *  Modified by
057: *   R. C. Whaley, Computer Science Dept., Univ. of Tenn., Knoxville, USA
058: *
059: * =====================================================================
060: *
061: *     .. Local Scalars ..
062:       INTEGER            I, I1, I2, INC, IP, IX, IX0, J, K, N32
063:       REAL               TEMP
064: *     ..
065: *     .. Executable Statements ..
066: *
067: *     Interchange row I with row IPIV(I) for each of rows K1 through K2.
068: *
069:       IF( INCX.GT.0 ) THEN
070:          IX0 = K1
071:          I1 = K1
072:          I2 = K2
073:          INC = 1
074:       ELSE IF( INCX.LT.0 ) THEN
075:          IX0 = 1 + ( 1-K2 )*INCX
076:          I1 = K2
077:          I2 = K1
078:          INC = -1
079:       ELSE
080:          RETURN
081:       END IF
082: *
083:       N32 = ( N / 32 )*32
084:       IF( N32.NE.0 ) THEN
085:          DO 30 J = 1, N32, 32
086:             IX = IX0
087:             DO 20 I = I1, I2, INC
088:                IP = IPIV( IX )
089:                IF( IP.NE.I ) THEN
090:                   DO 10 K = J, J + 31
091:                      TEMP = A( I, K )
092:                      A( I, K ) = A( IP, K )
093:                      A( IP, K ) = TEMP
094:    10             CONTINUE
095:                END IF
096:                IX = IX + INCX
097:    20       CONTINUE
098:    30    CONTINUE
099:       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 SLASWP
119: *
120:       END
121: