LAPACK 3.3.0

slapmt.f

Go to the documentation of this file.
00001       SUBROUTINE SLAPMT( FORWRD, M, N, X, LDX, K )
00002 *
00003 *  -- LAPACK auxiliary routine (version 3.2) --
00004 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00005 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00006 *     November 2006
00007 *
00008 *     .. Scalar Arguments ..
00009       LOGICAL            FORWRD
00010       INTEGER            LDX, M, N
00011 *     ..
00012 *     .. Array Arguments ..
00013       INTEGER            K( * )
00014       REAL               X( LDX, * )
00015 *     ..
00016 *
00017 *  Purpose
00018 *  =======
00019 *
00020 *  SLAPMT rearranges the columns of the M by N matrix X as specified
00021 *  by the permutation K(1),K(2),...,K(N) of the integers 1,...,N.
00022 *  If FORWRD = .TRUE.,  forward permutation:
00023 *
00024 *       X(*,K(J)) is moved X(*,J) for J = 1,2,...,N.
00025 *
00026 *  If FORWRD = .FALSE., backward permutation:
00027 *
00028 *       X(*,J) is moved to X(*,K(J)) for J = 1,2,...,N.
00029 *
00030 *  Arguments
00031 *  =========
00032 *
00033 *  FORWRD  (input) LOGICAL
00034 *          = .TRUE., forward permutation
00035 *          = .FALSE., backward permutation
00036 *
00037 *  M       (input) INTEGER
00038 *          The number of rows of the matrix X. M >= 0.
00039 *
00040 *  N       (input) INTEGER
00041 *          The number of columns of the matrix X. N >= 0.
00042 *
00043 *  X       (input/output) REAL array, dimension (LDX,N)
00044 *          On entry, the M by N matrix X.
00045 *          On exit, X contains the permuted matrix X.
00046 *
00047 *  LDX     (input) INTEGER
00048 *          The leading dimension of the array X, LDX >= MAX(1,M).
00049 *
00050 *  K       (input/output) INTEGER array, dimension (N)
00051 *          On entry, K contains the permutation vector. K is used as
00052 *          internal workspace, but reset to its original value on
00053 *          output.
00054 *
00055 *  =====================================================================
00056 *
00057 *     .. Local Scalars ..
00058       INTEGER            I, II, J, IN
00059       REAL               TEMP
00060 *     ..
00061 *     .. Executable Statements ..
00062 *
00063       IF( N.LE.1 )
00064      $   RETURN
00065 *
00066       DO 10 I = 1, N
00067          K( I ) = -K( I )
00068    10 CONTINUE
00069 *
00070       IF( FORWRD ) THEN
00071 *
00072 *        Forward permutation
00073 *
00074          DO 60 I = 1, N
00075 *
00076             IF( K( I ).GT.0 )
00077      $         GO TO 40
00078 *
00079             J = I
00080             K( J ) = -K( J )
00081             IN = K( J )
00082 *
00083    20       CONTINUE
00084             IF( K( IN ).GT.0 )
00085      $         GO TO 40
00086 *
00087             DO 30 II = 1, M
00088                TEMP = X( II, J )
00089                X( II, J ) = X( II, IN )
00090                X( II, IN ) = TEMP
00091    30       CONTINUE
00092 *
00093             K( IN ) = -K( IN )
00094             J = IN
00095             IN = K( IN )
00096             GO TO 20
00097 *
00098    40       CONTINUE
00099 *
00100    60    CONTINUE
00101 *
00102       ELSE
00103 *
00104 *        Backward permutation
00105 *
00106          DO 110 I = 1, N
00107 *
00108             IF( K( I ).GT.0 )
00109      $         GO TO 100
00110 *
00111             K( I ) = -K( I )
00112             J = K( I )
00113    80       CONTINUE
00114             IF( J.EQ.I )
00115      $         GO TO 100
00116 *
00117             DO 90 II = 1, M
00118                TEMP = X( II, I )
00119                X( II, I ) = X( II, J )
00120                X( II, J ) = TEMP
00121    90       CONTINUE
00122 *
00123             K( J ) = -K( J )
00124             J = K( J )
00125             GO TO 80
00126 *
00127   100       CONTINUE
00128 
00129   110    CONTINUE
00130 *
00131       END IF
00132 *
00133       RETURN
00134 *
00135 *     End of SLAPMT
00136 *
00137       END
 All Files Functions