LAPACK 3.3.0

slaswp.f

Go to the documentation of this file.
00001       SUBROUTINE SLASWP( N, A, LDA, K1, K2, IPIV, INCX )
00002 *
00003 *  -- LAPACK auxiliary routine (version 3.2) --
00004 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00005 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00006 *     November 2006
00007 *
00008 *     .. Scalar Arguments ..
00009       INTEGER            INCX, K1, K2, LDA, N
00010 *     ..
00011 *     .. Array Arguments ..
00012       INTEGER            IPIV( * )
00013       REAL               A( LDA, * )
00014 *     ..
00015 *
00016 *  Purpose
00017 *  =======
00018 *
00019 *  SLASWP performs a series of row interchanges on the matrix A.
00020 *  One row interchange is initiated for each of rows K1 through K2 of A.
00021 *
00022 *  Arguments
00023 *  =========
00024 *
00025 *  N       (input) INTEGER
00026 *          The number of columns of the matrix A.
00027 *
00028 *  A       (input/output) REAL array, dimension (LDA,N)
00029 *          On entry, the matrix of column dimension N to which the row
00030 *          interchanges will be applied.
00031 *          On exit, the permuted matrix.
00032 *
00033 *  LDA     (input) INTEGER
00034 *          The leading dimension of the array A.
00035 *
00036 *  K1      (input) INTEGER
00037 *          The first element of IPIV for which a row interchange will
00038 *          be done.
00039 *
00040 *  K2      (input) INTEGER
00041 *          The last element of IPIV for which a row interchange will
00042 *          be done.
00043 *
00044 *  IPIV    (input) INTEGER array, dimension (K2*abs(INCX))
00045 *          The vector of pivot indices.  Only the elements in positions
00046 *          K1 through K2 of IPIV are accessed.
00047 *          IPIV(K) = L implies rows K and L are to be interchanged.
00048 *
00049 *  INCX    (input) INTEGER
00050 *          The increment between successive values of IPIV.  If IPIV
00051 *          is negative, the pivots are applied in reverse order.
00052 *
00053 *  Further Details
00054 *  ===============
00055 *
00056 *  Modified by
00057 *   R. C. Whaley, Computer Science Dept., Univ. of Tenn., Knoxville, USA
00058 *
00059 * =====================================================================
00060 *
00061 *     .. Local Scalars ..
00062       INTEGER            I, I1, I2, INC, IP, IX, IX0, J, K, N32
00063       REAL               TEMP
00064 *     ..
00065 *     .. Executable Statements ..
00066 *
00067 *     Interchange row I with row IPIV(I) for each of rows K1 through K2.
00068 *
00069       IF( INCX.GT.0 ) THEN
00070          IX0 = K1
00071          I1 = K1
00072          I2 = K2
00073          INC = 1
00074       ELSE IF( INCX.LT.0 ) THEN
00075          IX0 = 1 + ( 1-K2 )*INCX
00076          I1 = K2
00077          I2 = K1
00078          INC = -1
00079       ELSE
00080          RETURN
00081       END IF
00082 *
00083       N32 = ( N / 32 )*32
00084       IF( N32.NE.0 ) THEN
00085          DO 30 J = 1, N32, 32
00086             IX = IX0
00087             DO 20 I = I1, I2, INC
00088                IP = IPIV( IX )
00089                IF( IP.NE.I ) THEN
00090                   DO 10 K = J, J + 31
00091                      TEMP = A( I, K )
00092                      A( I, K ) = A( IP, K )
00093                      A( IP, K ) = TEMP
00094    10             CONTINUE
00095                END IF
00096                IX = IX + INCX
00097    20       CONTINUE
00098    30    CONTINUE
00099       END IF
00100       IF( N32.NE.N ) THEN
00101          N32 = N32 + 1
00102          IX = IX0
00103          DO 50 I = I1, I2, INC
00104             IP = IPIV( IX )
00105             IF( IP.NE.I ) THEN
00106                DO 40 K = N32, N
00107                   TEMP = A( I, K )
00108                   A( I, K ) = A( IP, K )
00109                   A( IP, K ) = TEMP
00110    40          CONTINUE
00111             END IF
00112             IX = IX + INCX
00113    50    CONTINUE
00114       END IF
00115 *
00116       RETURN
00117 *
00118 *     End of SLASWP
00119 *
00120       END
 All Files Functions