Return to dlapmr.f CVS log

Up to [local] / rpl / lapack / lapack

Première mise à jour de lapack et blas.

    1: *> \brief \b DLAPMR rearranges rows of a matrix as specified by a permutation vector.
    2: *
    3: *  =========== DOCUMENTATION ===========
    4: *
    5: * Online html documentation available at
    6: *            http://www.netlib.org/lapack/explore-html/
    7: *
    8: *> \htmlonly
    9: *> Download DLAPMR + dependencies
   10: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlapmr.f">
   11: *> [TGZ]</a>
   12: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlapmr.f">
   13: *> [ZIP]</a>
   14: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlapmr.f">
   15: *> [TXT]</a>
   16: *> \endhtmlonly
   17: *
   18: *  Definition:
   19: *  ===========
   20: *
   21: *       SUBROUTINE DLAPMR( FORWRD, M, N, X, LDX, K )
   22: *
   23: *       .. Scalar Arguments ..
   24: *       LOGICAL            FORWRD
   25: *       INTEGER            LDX, M, N
   26: *       ..
   27: *       .. Array Arguments ..
   28: *       INTEGER            K( * )
   29: *       DOUBLE PRECISION   X( LDX, * )
   30: *       ..
   31: *
   32: *
   33: *> \par Purpose:
   34: *  =============
   35: *>
   36: *> \verbatim
   37: *>
   38: *> DLAPMR rearranges the rows of the M by N matrix X as specified
   39: *> by the permutation K(1),K(2),...,K(M) of the integers 1,...,M.
   40: *> If FORWRD = .TRUE.,  forward permutation:
   41: *>
   42: *>      X(K(I),*) is moved X(I,*) for I = 1,2,...,M.
   43: *>
   44: *> If FORWRD = .FALSE., backward permutation:
   45: *>
   46: *>      X(I,*) is moved to X(K(I),*) for I = 1,2,...,M.
   47: *> \endverbatim
   48: *
   49: *  Arguments:
   50: *  ==========
   51: *
   52: *> \param[in] FORWRD
   53: *> \verbatim
   54: *>          FORWRD is LOGICAL
   55: *>          = .TRUE., forward permutation
   56: *>          = .FALSE., backward permutation
   57: *> \endverbatim
   58: *>
   59: *> \param[in] M
   60: *> \verbatim
   61: *>          M is INTEGER
   62: *>          The number of rows of the matrix X. M >= 0.
   63: *> \endverbatim
   64: *>
   65: *> \param[in] N
   66: *> \verbatim
   67: *>          N is INTEGER
   68: *>          The number of columns of the matrix X. N >= 0.
   69: *> \endverbatim
   70: *>
   71: *> \param[in,out] X
   72: *> \verbatim
   73: *>          X is DOUBLE PRECISION array, dimension (LDX,N)
   74: *>          On entry, the M by N matrix X.
   75: *>          On exit, X contains the permuted matrix X.
   76: *> \endverbatim
   77: *>
   78: *> \param[in] LDX
   79: *> \verbatim
   80: *>          LDX is INTEGER
   81: *>          The leading dimension of the array X, LDX >= MAX(1,M).
   82: *> \endverbatim
   83: *>
   84: *> \param[in,out] K
   85: *> \verbatim
   86: *>          K is INTEGER array, dimension (M)
   87: *>          On entry, K contains the permutation vector. K is used as
   88: *>          internal workspace, but reset to its original value on
   89: *>          output.
   90: *> \endverbatim
   91: *
   92: *  Authors:
   93: *  ========
   94: *
   95: *> \author Univ. of Tennessee
   96: *> \author Univ. of California Berkeley
   97: *> \author Univ. of Colorado Denver
   98: *> \author NAG Ltd.
   99: *
  100: *> \ingroup doubleOTHERauxiliary
  101: *
  102: *  =====================================================================
  103:       SUBROUTINE DLAPMR( FORWRD, M, N, X, LDX, K )
  104: *
  105: *  -- LAPACK auxiliary routine --
  106: *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
  107: *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  108: *
  109: *     .. Scalar Arguments ..
  110:       LOGICAL            FORWRD
  111:       INTEGER            LDX, M, N
  112: *     ..
  113: *     .. Array Arguments ..
  114:       INTEGER            K( * )
  115:       DOUBLE PRECISION   X( LDX, * )
  116: *     ..
  117: *
  118: *  =====================================================================
  119: *
  120: *     .. Local Scalars ..
  121:       INTEGER            I, IN, J, JJ
  122:       DOUBLE PRECISION   TEMP
  123: *     ..
  124: *     .. Executable Statements ..
  125: *
  126:       IF( M.LE.1 )
  127:      $   RETURN
  128: *
  129:       DO 10 I = 1, M
  130:          K( I ) = -K( I )
  131:    10 CONTINUE
  132: *
  133:       IF( FORWRD ) THEN
  134: *
  135: *        Forward permutation
  136: *
  137:          DO 50 I = 1, M
  138: *
  139:             IF( K( I ).GT.0 )
  140:      $         GO TO 40
  141: *
  142:             J = I
  143:             K( J ) = -K( J )
  144:             IN = K( J )
  145: *
  146:    20       CONTINUE
  147:             IF( K( IN ).GT.0 )
  148:      $         GO TO 40
  149: *
  150:             DO 30 JJ = 1, N
  151:                TEMP = X( J, JJ )
  152:                X( J, JJ ) = X( IN, JJ )
  153:                X( IN, JJ ) = TEMP
  154:    30       CONTINUE
  155: *
  156:             K( IN ) = -K( IN )
  157:             J = IN
  158:             IN = K( IN )
  159:             GO TO 20
  160: *
  161:    40       CONTINUE
  162: *
  163:    50    CONTINUE
  164: *
  165:       ELSE
  166: *
  167: *        Backward permutation
  168: *
  169:          DO 90 I = 1, M
  170: *
  171:             IF( K( I ).GT.0 )
  172:      $         GO TO 80
  173: *
  174:             K( I ) = -K( I )
  175:             J = K( I )
  176:    60       CONTINUE
  177:             IF( J.EQ.I )
  178:      $         GO TO 80
  179: *
  180:             DO 70 JJ = 1, N
  181:                TEMP = X( I, JJ )
  182:                X( I, JJ ) = X( J, JJ )
  183:                X( J, JJ ) = TEMP
  184:    70       CONTINUE
  185: *
  186:             K( J ) = -K( J )
  187:             J = K( J )
  188:             GO TO 60
  189: *
  190:    80       CONTINUE
  191: *
  192:    90    CONTINUE
  193: *
  194:       END IF
  195: *
  196:       RETURN
  197: *
  198: *     End of DLAPMR
  199: *
  200:       END
  201: