Return to zlapmr.f CVS log

Up to [local] / rpl / lapack / lapack

Mise à jour de Lapack vers la version 3.3.0.

    1:       SUBROUTINE ZLAPMR( FORWRD, M, N, X, LDX, K )
    2:       IMPLICIT NONE
    3: *
    4: *     Originally ZLAPMT
    5: *  -- LAPACK auxiliary routine (version 3.2) --
    6: *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
    7: *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
    8: *     November 2006
    9: *
   10: *     Adapted to ZLAPMR
   11: *     July 2010
   12: *
   13: *     .. Scalar Arguments ..
   14:       LOGICAL            FORWRD
   15:       INTEGER            LDX, M, N
   16: *     ..
   17: *     .. Array Arguments ..
   18:       INTEGER            K( * )
   19:       COMPLEX*16         X( LDX, * )
   20: *     ..
   21: *
   22: *  Purpose
   23: *  =======
   24: *
   25: *  ZLAPMR rearranges the rows of the M by N matrix X as specified
   26: *  by the permutation K(1),K(2),...,K(M) of the integers 1,...,M.
   27: *  If FORWRD = .TRUE.,  forward permutation:
   28: *
   29: *       X(K(I),*) is moved X(I,*) for I = 1,2,...,M.
   30: *
   31: *  If FORWRD = .FALSE., backward permutation:
   32: *
   33: *       X(I,*) is moved to X(K(I),*) for I = 1,2,...,M.
   34: *
   35: *  Arguments
   36: *  =========
   37: *
   38: *  FORWRD  (input) LOGICAL
   39: *          = .TRUE., forward permutation
   40: *          = .FALSE., backward permutation
   41: *
   42: *  M       (input) INTEGER
   43: *          The number of rows of the matrix X. M >= 0.
   44: *
   45: *  N       (input) INTEGER
   46: *          The number of columns of the matrix X. N >= 0.
   47: *
   48: *  X       (input/output) COMPLEX*16 array, dimension (LDX,N)
   49: *          On entry, the M by N matrix X.
   50: *          On exit, X contains the permuted matrix X.
   51: *
   52: *  LDX     (input) INTEGER
   53: *          The leading dimension of the array X, LDX >= MAX(1,M).
   54: *
   55: *  K       (input/output) INTEGER array, dimension (M)
   56: *          On entry, K contains the permutation vector. K is used as
   57: *          internal workspace, but reset to its original value on
   58: *          output.
   59: *
   60: *  =====================================================================
   61: *
   62: *     .. Local Scalars ..
   63:       INTEGER            I, IN, J, JJ
   64:       COMPLEX*16         TEMP
   65: *     ..
   66: *     .. Executable Statements ..
   67: *
   68:       IF( M.LE.1 )
   69:      $   RETURN
   70: *
   71:       DO 10 I = 1, M
   72:          K( I ) = -K( I )
   73:    10 CONTINUE
   74: *
   75:       IF( FORWRD ) THEN
   76: *
   77: *        Forward permutation
   78: *
   79:          DO 50 I = 1, M
   80: *
   81:             IF( K( I ).GT.0 )
   82:      $         GO TO 40
   83: *
   84:             J = I
   85:             K( J ) = -K( J )
   86:             IN = K( J )
   87: *
   88:    20       CONTINUE
   89:             IF( K( IN ).GT.0 )
   90:      $         GO TO 40
   91: *
   92:             DO 30 JJ = 1, N
   93:                TEMP = X( J, JJ )
   94:                X( J, JJ ) = X( IN, JJ )
   95:                X( IN, JJ ) = TEMP
   96:    30       CONTINUE
   97: *
   98:             K( IN ) = -K( IN )
   99:             J = IN
  100:             IN = K( IN )
  101:             GO TO 20
  102: *
  103:    40       CONTINUE
  104: *
  105:    50    CONTINUE
  106: *
  107:       ELSE
  108: *
  109: *        Backward permutation
  110: *
  111:          DO 90 I = 1, M
  112: *
  113:             IF( K( I ).GT.0 )
  114:      $         GO TO 80
  115: *
  116:             K( I ) = -K( I )
  117:             J = K( I )
  118:    60       CONTINUE
  119:             IF( J.EQ.I )
  120:      $         GO TO 80
  121: *
  122:             DO 70 JJ = 1, N
  123:                TEMP = X( I, JJ )
  124:                X( I, JJ ) = X( J, JJ )
  125:                X( J, JJ ) = TEMP
  126:    70       CONTINUE
  127: *
  128:             K( J ) = -K( J )
  129:             J = K( J )
  130:             GO TO 60
  131: *
  132:    80       CONTINUE
  133: *
  134:    90    CONTINUE
  135: *
  136:       END IF
  137: *
  138:       RETURN
  139: *
  140: *     End of ZLAPMT
  141: *
  142:       END
  143: