Return to dlapmr.f CVS log

Up to [local] / rpl / lapack / lapack

Annotation of rpl/lapack/lapack/dlapmr.f, revision 1.3

1.1       bertrand    1:       SUBROUTINE DLAPMR( FORWRD, M, N, X, LDX, K )
                      2:       IMPLICIT NONE
                      3: *
                      4: *     Originally DLAPMT
                      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 DLAPMR
                     11: *     July 2010
                     12: *
                     13: *     .. Scalar Arguments ..
                     14:       LOGICAL            FORWRD
                     15:       INTEGER            LDX, M, N
                     16: *     ..
                     17: *     .. Array Arguments ..
                     18:       INTEGER            K( * )
                     19:       DOUBLE PRECISION   X( LDX, * )
                     20: *     ..
                     21: *
                     22: *  Purpose
                     23: *  =======
                     24: *
                     25: *  DLAPMR 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) DOUBLE PRECISION 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:       DOUBLE PRECISION   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: