![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b SLAPMR 00002 * 00003 * =========== DOCUMENTATION =========== 00004 * 00005 * Online html documentation available at 00006 * http://www.netlib.org/lapack/explore-html/ 00007 * 00008 *> \htmlonly 00009 *> Download SLAPMR + dependencies 00010 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slapmr.f"> 00011 *> [TGZ]</a> 00012 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slapmr.f"> 00013 *> [ZIP]</a> 00014 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slapmr.f"> 00015 *> [TXT]</a> 00016 *> \endhtmlonly 00017 * 00018 * Definition: 00019 * =========== 00020 * 00021 * SUBROUTINE SLAPMR( 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 * REAL X( LDX, * ) 00030 * .. 00031 * 00032 * 00033 *> \par Purpose: 00034 * ============= 00035 *> 00036 *> \verbatim 00037 *> 00038 *> SLAPMR rearranges the rows of the M by N matrix X as specified 00039 *> by the permutation K(1),K(2),...,K(M) of the integers 1,...,M. 00040 *> If FORWRD = .TRUE., forward permutation: 00041 *> 00042 *> X(K(I),*) is moved X(I,*) for I = 1,2,...,M. 00043 *> 00044 *> If FORWRD = .FALSE., backward permutation: 00045 *> 00046 *> X(I,*) is moved to X(K(I),*) for I = 1,2,...,M. 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 REAL 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 (M) 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 realOTHERauxiliary 00103 * 00104 * ===================================================================== 00105 SUBROUTINE SLAPMR( 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 REAL X( LDX, * ) 00119 * .. 00120 * 00121 * ===================================================================== 00122 * 00123 * .. Local Scalars .. 00124 INTEGER I, IN, J, JJ 00125 REAL TEMP 00126 * .. 00127 * .. Executable Statements .. 00128 * 00129 IF( M.LE.1 ) 00130 $ RETURN 00131 * 00132 DO 10 I = 1, M 00133 K( I ) = -K( I ) 00134 10 CONTINUE 00135 * 00136 IF( FORWRD ) THEN 00137 * 00138 * Forward permutation 00139 * 00140 DO 50 I = 1, M 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 JJ = 1, N 00154 TEMP = X( J, JJ ) 00155 X( J, JJ ) = X( IN, JJ ) 00156 X( IN, JJ ) = 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, M 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 JJ = 1, N 00184 TEMP = X( I, JJ ) 00185 X( I, JJ ) = X( J, JJ ) 00186 X( J, JJ ) = 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 ZLAPMT 00202 * 00203 END 00204