Return to dlapmr.f CVS log

Up to [local] / rpl / lapack / lapack

Cohérence.

    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: *> \date December 2016
  101: *
  102: *> \ingroup doubleOTHERauxiliary
  103: *
  104: *  =====================================================================
  105:       SUBROUTINE DLAPMR( FORWRD, M, N, X, LDX, K )
  106: *
  107: *  -- LAPACK auxiliary routine (version 3.7.0) --
  108: *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
  109: *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  110: *     December 2016
  111: *
  112: *     .. Scalar Arguments ..
  113:       LOGICAL            FORWRD
  114:       INTEGER            LDX, M, N
  115: *     ..
  116: *     .. Array Arguments ..
  117:       INTEGER            K( * )
  118:       DOUBLE PRECISION   X( LDX, * )
  119: *     ..
  120: *
  121: *  =====================================================================
  122: *
  123: *     .. Local Scalars ..
  124:       INTEGER            I, IN, J, JJ
  125:       DOUBLE PRECISION   TEMP
  126: *     ..
  127: *     .. Executable Statements ..
  128: *
  129:       IF( M.LE.1 )
  130:      $   RETURN
  131: *
  132:       DO 10 I = 1, M
  133:          K( I ) = -K( I )
  134:    10 CONTINUE
  135: *
  136:       IF( FORWRD ) THEN
  137: *
  138: *        Forward permutation
  139: *
  140:          DO 50 I = 1, M
  141: *
  142:             IF( K( I ).GT.0 )
  143:      $         GO TO 40
  144: *
  145:             J = I
  146:             K( J ) = -K( J )
  147:             IN = K( J )
  148: *
  149:    20       CONTINUE
  150:             IF( K( IN ).GT.0 )
  151:      $         GO TO 40
  152: *
  153:             DO 30 JJ = 1, N
  154:                TEMP = X( J, JJ )
  155:                X( J, JJ ) = X( IN, JJ )
  156:                X( IN, JJ ) = TEMP
  157:    30       CONTINUE
  158: *
  159:             K( IN ) = -K( IN )
  160:             J = IN
  161:             IN = K( IN )
  162:             GO TO 20
  163: *
  164:    40       CONTINUE
  165: *
  166:    50    CONTINUE
  167: *
  168:       ELSE
  169: *
  170: *        Backward permutation
  171: *
  172:          DO 90 I = 1, M
  173: *
  174:             IF( K( I ).GT.0 )
  175:      $         GO TO 80
  176: *
  177:             K( I ) = -K( I )
  178:             J = K( I )
  179:    60       CONTINUE
  180:             IF( J.EQ.I )
  181:      $         GO TO 80
  182: *
  183:             DO 70 JJ = 1, N
  184:                TEMP = X( I, JJ )
  185:                X( I, JJ ) = X( J, JJ )
  186:                X( J, JJ ) = TEMP
  187:    70       CONTINUE
  188: *
  189:             K( J ) = -K( J )
  190:             J = K( J )
  191:             GO TO 60
  192: *
  193:    80       CONTINUE
  194: *
  195:    90    CONTINUE
  196: *
  197:       END IF
  198: *
  199:       RETURN
  200: *
  201: *     End of ZLAPMT
  202: *
  203:       END
  204: