Return to zlapmt.f CVS log

Up to [local] / rpl / lapack / lapack

Patches pour OS/2

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