LAPACK 3.3.1
Linear Algebra PACKage
|
00001 SUBROUTINE CLAPMT( 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 COMPLEX X( LDX, * ) 00015 * .. 00016 * 00017 * Purpose 00018 * ======= 00019 * 00020 * CLAPMT 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) COMPLEX 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 COMPLEX 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 CLAPMT 00136 * 00137 END