File:  [local] / rpl / lapack / lapack / dlaswp.f
Revision 1.19: download - view: text, annotated - select for diffs - revision graph
Mon Aug 7 08:39:00 2023 UTC (8 months, 3 weeks ago) by bertrand
Branches: MAIN
CVS tags: rpl-4_1_35, rpl-4_1_34, HEAD
Première mise à jour de lapack et blas.

    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: *> \ingroup doubleOTHERauxiliary
  103: *
  104: *> \par Further Details:
  105: *  =====================
  106: *>
  107: *> \verbatim
  108: *>
  109: *>  Modified by
  110: *>   R. C. Whaley, Computer Science Dept., Univ. of Tenn., Knoxville, USA
  111: *> \endverbatim
  112: *>
  113: *  =====================================================================
  114:       SUBROUTINE DLASWP( N, A, LDA, K1, K2, IPIV, INCX )
  115: *
  116: *  -- LAPACK auxiliary routine --
  117: *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
  118: *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  119: *
  120: *     .. Scalar Arguments ..
  121:       INTEGER            INCX, K1, K2, LDA, N
  122: *     ..
  123: *     .. Array Arguments ..
  124:       INTEGER            IPIV( * )
  125:       DOUBLE PRECISION   A( LDA, * )
  126: *     ..
  127: *
  128: * =====================================================================
  129: *
  130: *     .. Local Scalars ..
  131:       INTEGER            I, I1, I2, INC, IP, IX, IX0, J, K, N32
  132:       DOUBLE PRECISION   TEMP
  133: *     ..
  134: *     .. Executable Statements ..
  135: *
  136: *     Interchange row I with row IPIV(K1+(I-K1)*abs(INCX)) for each of rows
  137: *     K1 through K2.
  138: *
  139:       IF( INCX.GT.0 ) THEN
  140:          IX0 = K1
  141:          I1 = K1
  142:          I2 = K2
  143:          INC = 1
  144:       ELSE IF( INCX.LT.0 ) THEN
  145:          IX0 = K1 + ( K1-K2 )*INCX
  146:          I1 = K2
  147:          I2 = K1
  148:          INC = -1
  149:       ELSE
  150:          RETURN
  151:       END IF
  152: *
  153:       N32 = ( N / 32 )*32
  154:       IF( N32.NE.0 ) THEN
  155:          DO 30 J = 1, N32, 32
  156:             IX = IX0
  157:             DO 20 I = I1, I2, INC
  158:                IP = IPIV( IX )
  159:                IF( IP.NE.I ) THEN
  160:                   DO 10 K = J, J + 31
  161:                      TEMP = A( I, K )
  162:                      A( I, K ) = A( IP, K )
  163:                      A( IP, K ) = TEMP
  164:    10             CONTINUE
  165:                END IF
  166:                IX = IX + INCX
  167:    20       CONTINUE
  168:    30    CONTINUE
  169:       END IF
  170:       IF( N32.NE.N ) THEN
  171:          N32 = N32 + 1
  172:          IX = IX0
  173:          DO 50 I = I1, I2, INC
  174:             IP = IPIV( IX )
  175:             IF( IP.NE.I ) THEN
  176:                DO 40 K = N32, N
  177:                   TEMP = A( I, K )
  178:                   A( I, K ) = A( IP, K )
  179:                   A( IP, K ) = TEMP
  180:    40          CONTINUE
  181:             END IF
  182:             IX = IX + INCX
  183:    50    CONTINUE
  184:       END IF
  185: *
  186:       RETURN
  187: *
  188: *     End of DLASWP
  189: *
  190:       END

CVSweb interface <joel.bertrand@systella.fr>