SRC/slapmr.f

   1 *> \brief \b SLAPMR 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 SLAPMR + dependencies
  10 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slapmr.f">
  11 *> [TGZ]</a>
  12 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slapmr.f">
  13 *> [ZIP]</a>
  14 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slapmr.f">
  15 *> [TXT]</a>
  16 *> \endhtmlonly
  17 *
  18 *  Definition:
  19 *  ===========
  20 *
  21 *       SUBROUTINE SLAPMR( 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 *       REAL               X( LDX, * )
  30 *       ..
  31 *
  32 *
  33 *> \par Purpose:
  34 *  =============
  35 *>
  36 *> \verbatim
  37 *>
  38 *> SLAPMR 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 REAL 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 September 2012
 101 *
 102 *> \ingroup realOTHERauxiliary
 103 *
 104 *  =====================================================================
 105       SUBROUTINE SLAPMR( FORWRD, M, N, X, LDX, K )
 106 *
 107 *  -- LAPACK auxiliary routine (version 3.4.2) --
 108 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 109 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
 110 *     September 2012
 111 *
 112 *     .. Scalar Arguments ..
 113       LOGICAL            FORWRD
 114       INTEGER            LDX, M, N
 115 *     ..
 116 *     .. Array Arguments ..
 117       INTEGER            K( * )
 118       REAL               X( LDX, * )
 119 *     ..
 120 *
 121 *  =====================================================================
 122 *
 123 *     .. Local Scalars ..
 124       INTEGER            I, IN, J, JJ
 125       REAL               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