LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
dlapmt.f
Go to the documentation of this file.
00001 *> \brief \b DLAPMT
00002 *
00003 *  =========== DOCUMENTATION ===========
00004 *
00005 * Online html documentation available at 
00006 *            http://www.netlib.org/lapack/explore-html/ 
00007 *
00008 *> \htmlonly
00009 *> Download DLAPMT + dependencies 
00010 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlapmt.f"> 
00011 *> [TGZ]</a> 
00012 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlapmt.f"> 
00013 *> [ZIP]</a> 
00014 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlapmt.f"> 
00015 *> [TXT]</a>
00016 *> \endhtmlonly 
00017 *
00018 *  Definition:
00019 *  ===========
00020 *
00021 *       SUBROUTINE DLAPMT( FORWRD, M, N, X, LDX, K )
00022 * 
00023 *       .. Scalar Arguments ..
00024 *       LOGICAL            FORWRD
00025 *       INTEGER            LDX, M, N
00026 *       ..
00027 *       .. Array Arguments ..
00028 *       INTEGER            K( * )
00029 *       DOUBLE PRECISION   X( LDX, * )
00030 *       ..
00031 *  
00032 *
00033 *> \par Purpose:
00034 *  =============
00035 *>
00036 *> \verbatim
00037 *>
00038 *> DLAPMT rearranges the columns of the M by N matrix X as specified
00039 *> by the permutation K(1),K(2),...,K(N) of the integers 1,...,N.
00040 *> If FORWRD = .TRUE.,  forward permutation:
00041 *>
00042 *>      X(*,K(J)) is moved X(*,J) for J = 1,2,...,N.
00043 *>
00044 *> If FORWRD = .FALSE., backward permutation:
00045 *>
00046 *>      X(*,J) is moved to X(*,K(J)) for J = 1,2,...,N.
00047 *> \endverbatim
00048 *
00049 *  Arguments:
00050 *  ==========
00051 *
00052 *> \param[in] FORWRD
00053 *> \verbatim
00054 *>          FORWRD is LOGICAL
00055 *>          = .TRUE., forward permutation
00056 *>          = .FALSE., backward permutation
00057 *> \endverbatim
00058 *>
00059 *> \param[in] M
00060 *> \verbatim
00061 *>          M is INTEGER
00062 *>          The number of rows of the matrix X. M >= 0.
00063 *> \endverbatim
00064 *>
00065 *> \param[in] N
00066 *> \verbatim
00067 *>          N is INTEGER
00068 *>          The number of columns of the matrix X. N >= 0.
00069 *> \endverbatim
00070 *>
00071 *> \param[in,out] X
00072 *> \verbatim
00073 *>          X is DOUBLE PRECISION array, dimension (LDX,N)
00074 *>          On entry, the M by N matrix X.
00075 *>          On exit, X contains the permuted matrix X.
00076 *> \endverbatim
00077 *>
00078 *> \param[in] LDX
00079 *> \verbatim
00080 *>          LDX is INTEGER
00081 *>          The leading dimension of the array X, LDX >= MAX(1,M).
00082 *> \endverbatim
00083 *>
00084 *> \param[in,out] K
00085 *> \verbatim
00086 *>          K is INTEGER array, dimension (N)
00087 *>          On entry, K contains the permutation vector. K is used as
00088 *>          internal workspace, but reset to its original value on
00089 *>          output.
00090 *> \endverbatim
00091 *
00092 *  Authors:
00093 *  ========
00094 *
00095 *> \author Univ. of Tennessee 
00096 *> \author Univ. of California Berkeley 
00097 *> \author Univ. of Colorado Denver 
00098 *> \author NAG Ltd. 
00099 *
00100 *> \date November 2011
00101 *
00102 *> \ingroup doubleOTHERauxiliary
00103 *
00104 *  =====================================================================
00105       SUBROUTINE DLAPMT( FORWRD, M, N, X, LDX, K )
00106 *
00107 *  -- LAPACK auxiliary routine (version 3.4.0) --
00108 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00109 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00110 *     November 2011
00111 *
00112 *     .. Scalar Arguments ..
00113       LOGICAL            FORWRD
00114       INTEGER            LDX, M, N
00115 *     ..
00116 *     .. Array Arguments ..
00117       INTEGER            K( * )
00118       DOUBLE PRECISION   X( LDX, * )
00119 *     ..
00120 *
00121 *  =====================================================================
00122 *
00123 *     .. Local Scalars ..
00124       INTEGER            I, II, IN, J
00125       DOUBLE PRECISION   TEMP
00126 *     ..
00127 *     .. Executable Statements ..
00128 *
00129       IF( N.LE.1 )
00130      $   RETURN
00131 *
00132       DO 10 I = 1, N
00133          K( I ) = -K( I )
00134    10 CONTINUE
00135 *
00136       IF( FORWRD ) THEN
00137 *
00138 *        Forward permutation
00139 *
00140          DO 50 I = 1, N
00141 *
00142             IF( K( I ).GT.0 )
00143      $         GO TO 40
00144 *
00145             J = I
00146             K( J ) = -K( J )
00147             IN = K( J )
00148 *
00149    20       CONTINUE
00150             IF( K( IN ).GT.0 )
00151      $         GO TO 40
00152 *
00153             DO 30 II = 1, M
00154                TEMP = X( II, J )
00155                X( II, J ) = X( II, IN )
00156                X( II, IN ) = TEMP
00157    30       CONTINUE
00158 *
00159             K( IN ) = -K( IN )
00160             J = IN
00161             IN = K( IN )
00162             GO TO 20
00163 *
00164    40       CONTINUE
00165 *
00166    50    CONTINUE
00167 *
00168       ELSE
00169 *
00170 *        Backward permutation
00171 *
00172          DO 90 I = 1, N
00173 *
00174             IF( K( I ).GT.0 )
00175      $         GO TO 80
00176 *
00177             K( I ) = -K( I )
00178             J = K( I )
00179    60       CONTINUE
00180             IF( J.EQ.I )
00181      $         GO TO 80
00182 *
00183             DO 70 II = 1, M
00184                TEMP = X( II, I )
00185                X( II, I ) = X( II, J )
00186                X( II, J ) = TEMP
00187    70       CONTINUE
00188 *
00189             K( J ) = -K( J )
00190             J = K( J )
00191             GO TO 60
00192 *
00193    80       CONTINUE
00194 *
00195    90    CONTINUE
00196 *
00197       END IF
00198 *
00199       RETURN
00200 *
00201 *     End of DLAPMT
00202 *
00203       END
 All Files Functions