Return to dlapmr.f CVS log

Up to [local] / rpl / lapack / lapack

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

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: