191 lines
		
	
	
		
			5.0 KiB
		
	
	
	
		
			Fortran
		
	
	
	
			
		
		
	
	
			191 lines
		
	
	
		
			5.0 KiB
		
	
	
	
		
			Fortran
		
	
	
	
| *> \brief \b DLASWP performs a series of row interchanges on a general rectangular matrix.
 | |
| *
 | |
| *  =========== DOCUMENTATION ===========
 | |
| *
 | |
| * Online html documentation available at
 | |
| *            http://www.netlib.org/lapack/explore-html/
 | |
| *
 | |
| *> \htmlonly
 | |
| *> Download DLASWP + dependencies
 | |
| *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlaswp.f">
 | |
| *> [TGZ]</a>
 | |
| *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlaswp.f">
 | |
| *> [ZIP]</a>
 | |
| *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlaswp.f">
 | |
| *> [TXT]</a>
 | |
| *> \endhtmlonly
 | |
| *
 | |
| *  Definition:
 | |
| *  ===========
 | |
| *
 | |
| *       SUBROUTINE DLASWP( N, A, LDA, K1, K2, IPIV, INCX )
 | |
| *
 | |
| *       .. Scalar Arguments ..
 | |
| *       INTEGER            INCX, K1, K2, LDA, N
 | |
| *       ..
 | |
| *       .. Array Arguments ..
 | |
| *       INTEGER            IPIV( * )
 | |
| *       DOUBLE PRECISION   A( LDA, * )
 | |
| *       ..
 | |
| *
 | |
| *
 | |
| *> \par Purpose:
 | |
| *  =============
 | |
| *>
 | |
| *> \verbatim
 | |
| *>
 | |
| *> DLASWP performs a series of row interchanges on the matrix A.
 | |
| *> One row interchange is initiated for each of rows K1 through K2 of A.
 | |
| *> \endverbatim
 | |
| *
 | |
| *  Arguments:
 | |
| *  ==========
 | |
| *
 | |
| *> \param[in] N
 | |
| *> \verbatim
 | |
| *>          N is INTEGER
 | |
| *>          The number of columns of the matrix A.
 | |
| *> \endverbatim
 | |
| *>
 | |
| *> \param[in,out] A
 | |
| *> \verbatim
 | |
| *>          A is DOUBLE PRECISION array, dimension (LDA,N)
 | |
| *>          On entry, the matrix of column dimension N to which the row
 | |
| *>          interchanges will be applied.
 | |
| *>          On exit, the permuted matrix.
 | |
| *> \endverbatim
 | |
| *>
 | |
| *> \param[in] LDA
 | |
| *> \verbatim
 | |
| *>          LDA is INTEGER
 | |
| *>          The leading dimension of the array A.
 | |
| *> \endverbatim
 | |
| *>
 | |
| *> \param[in] K1
 | |
| *> \verbatim
 | |
| *>          K1 is INTEGER
 | |
| *>          The first element of IPIV for which a row interchange will
 | |
| *>          be done.
 | |
| *> \endverbatim
 | |
| *>
 | |
| *> \param[in] K2
 | |
| *> \verbatim
 | |
| *>          K2 is INTEGER
 | |
| *>          (K2-K1+1) is the number of elements of IPIV for which a row
 | |
| *>          interchange will be done.
 | |
| *> \endverbatim
 | |
| *>
 | |
| *> \param[in] IPIV
 | |
| *> \verbatim
 | |
| *>          IPIV is INTEGER array, dimension (K1+(K2-K1)*abs(INCX))
 | |
| *>          The vector of pivot indices. Only the elements in positions
 | |
| *>          K1 through K1+(K2-K1)*abs(INCX) of IPIV are accessed.
 | |
| *>          IPIV(K1+(K-K1)*abs(INCX)) = L implies rows K and L are to be
 | |
| *>          interchanged.
 | |
| *> \endverbatim
 | |
| *>
 | |
| *> \param[in] INCX
 | |
| *> \verbatim
 | |
| *>          INCX is INTEGER
 | |
| *>          The increment between successive values of IPIV. If INCX
 | |
| *>          is negative, the pivots are applied in reverse order.
 | |
| *> \endverbatim
 | |
| *
 | |
| *  Authors:
 | |
| *  ========
 | |
| *
 | |
| *> \author Univ. of Tennessee
 | |
| *> \author Univ. of California Berkeley
 | |
| *> \author Univ. of Colorado Denver
 | |
| *> \author NAG Ltd.
 | |
| *
 | |
| *> \ingroup doubleOTHERauxiliary
 | |
| *
 | |
| *> \par Further Details:
 | |
| *  =====================
 | |
| *>
 | |
| *> \verbatim
 | |
| *>
 | |
| *>  Modified by
 | |
| *>   R. C. Whaley, Computer Science Dept., Univ. of Tenn., Knoxville, USA
 | |
| *> \endverbatim
 | |
| *>
 | |
| *  =====================================================================
 | |
|       SUBROUTINE DLASWP( N, A, LDA, K1, K2, IPIV, INCX )
 | |
| *
 | |
| *  -- LAPACK auxiliary routine --
 | |
| *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 | |
| *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
 | |
| *
 | |
| *     .. Scalar Arguments ..
 | |
|       INTEGER            INCX, K1, K2, LDA, N
 | |
| *     ..
 | |
| *     .. Array Arguments ..
 | |
|       INTEGER            IPIV( * )
 | |
|       DOUBLE PRECISION   A( LDA, * )
 | |
| *     ..
 | |
| *
 | |
| * =====================================================================
 | |
| *
 | |
| *     .. Local Scalars ..
 | |
|       INTEGER            I, I1, I2, INC, IP, IX, IX0, J, K, N32
 | |
|       DOUBLE PRECISION   TEMP
 | |
| *     ..
 | |
| *     .. Executable Statements ..
 | |
| *
 | |
| *     Interchange row I with row IPIV(K1+(I-K1)*abs(INCX)) for each of rows
 | |
| *     K1 through K2.
 | |
| *
 | |
|       IF( INCX.GT.0 ) THEN
 | |
|          IX0 = K1
 | |
|          I1 = K1
 | |
|          I2 = K2
 | |
|          INC = 1
 | |
|       ELSE IF( INCX.LT.0 ) THEN
 | |
|          IX0 = K1 + ( K1-K2 )*INCX
 | |
|          I1 = K2
 | |
|          I2 = K1
 | |
|          INC = -1
 | |
|       ELSE
 | |
|          RETURN
 | |
|       END IF
 | |
| *
 | |
|       N32 = ( N / 32 )*32
 | |
|       IF( N32.NE.0 ) THEN
 | |
|          DO 30 J = 1, N32, 32
 | |
|             IX = IX0
 | |
|             DO 20 I = I1, I2, INC
 | |
|                IP = IPIV( IX )
 | |
|                IF( IP.NE.I ) THEN
 | |
|                   DO 10 K = J, J + 31
 | |
|                      TEMP = A( I, K )
 | |
|                      A( I, K ) = A( IP, K )
 | |
|                      A( IP, K ) = TEMP
 | |
|    10             CONTINUE
 | |
|                END IF
 | |
|                IX = IX + INCX
 | |
|    20       CONTINUE
 | |
|    30    CONTINUE
 | |
|       END IF
 | |
|       IF( N32.NE.N ) THEN
 | |
|          N32 = N32 + 1
 | |
|          IX = IX0
 | |
|          DO 50 I = I1, I2, INC
 | |
|             IP = IPIV( IX )
 | |
|             IF( IP.NE.I ) THEN
 | |
|                DO 40 K = N32, N
 | |
|                   TEMP = A( I, K )
 | |
|                   A( I, K ) = A( IP, K )
 | |
|                   A( IP, K ) = TEMP
 | |
|    40          CONTINUE
 | |
|             END IF
 | |
|             IX = IX + INCX
 | |
|    50    CONTINUE
 | |
|       END IF
 | |
| *
 | |
|       RETURN
 | |
| *
 | |
| *     End of DLASWP
 | |
| *
 | |
|       END
 |