![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b CSYSWAPR 00002 * 00003 * =========== DOCUMENTATION =========== 00004 * 00005 * Online html documentation available at 00006 * http://www.netlib.org/lapack/explore-html/ 00007 * 00008 *> \htmlonly 00009 *> Download CSYSWAPR + dependencies 00010 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/csyswapr.f"> 00011 *> [TGZ]</a> 00012 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/csyswapr.f"> 00013 *> [ZIP]</a> 00014 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/csyswapr.f"> 00015 *> [TXT]</a> 00016 *> \endhtmlonly 00017 * 00018 * Definition: 00019 * =========== 00020 * 00021 * SUBROUTINE CSYSWAPR( UPLO, N, A, LDA, I1, I2) 00022 * 00023 * .. Scalar Arguments .. 00024 * CHARACTER UPLO 00025 * INTEGER I1, I2, LDA, N 00026 * .. 00027 * .. Array Arguments .. 00028 * COMPLEX A( LDA, N ) 00029 * 00030 * 00031 *> \par Purpose: 00032 * ============= 00033 *> 00034 *> \verbatim 00035 *> 00036 *> CSYSWAPR applies an elementary permutation on the rows and the columns of 00037 *> a symmetric matrix. 00038 *> \endverbatim 00039 * 00040 * Arguments: 00041 * ========== 00042 * 00043 *> \param[in] UPLO 00044 *> \verbatim 00045 *> UPLO is CHARACTER*1 00046 *> Specifies whether the details of the factorization are stored 00047 *> as an upper or lower triangular matrix. 00048 *> = 'U': Upper triangular, form is A = U*D*U**T; 00049 *> = 'L': Lower triangular, form is A = L*D*L**T. 00050 *> \endverbatim 00051 *> 00052 *> \param[in] N 00053 *> \verbatim 00054 *> N is INTEGER 00055 *> The order of the matrix A. N >= 0. 00056 *> \endverbatim 00057 *> 00058 *> \param[in,out] A 00059 *> \verbatim 00060 *> A is COMPLEX array, dimension (LDA,N) 00061 *> On entry, the NB diagonal matrix D and the multipliers 00062 *> used to obtain the factor U or L as computed by CSYTRF. 00063 *> 00064 *> On exit, if INFO = 0, the (symmetric) inverse of the original 00065 *> matrix. If UPLO = 'U', the upper triangular part of the 00066 *> inverse is formed and the part of A below the diagonal is not 00067 *> referenced; if UPLO = 'L' the lower triangular part of the 00068 *> inverse is formed and the part of A above the diagonal is 00069 *> not referenced. 00070 *> \endverbatim 00071 *> 00072 *> \param[in] LDA 00073 *> \verbatim 00074 *> LDA is INTEGER 00075 *> The leading dimension of the array A. LDA >= max(1,N). 00076 *> \endverbatim 00077 *> 00078 *> \param[in] I1 00079 *> \verbatim 00080 *> I1 is INTEGER 00081 *> Index of the first row to swap 00082 *> \endverbatim 00083 *> 00084 *> \param[in] I2 00085 *> \verbatim 00086 *> I2 is INTEGER 00087 *> Index of the second row to swap 00088 *> \endverbatim 00089 * 00090 * Authors: 00091 * ======== 00092 * 00093 *> \author Univ. of Tennessee 00094 *> \author Univ. of California Berkeley 00095 *> \author Univ. of Colorado Denver 00096 *> \author NAG Ltd. 00097 * 00098 *> \date November 2011 00099 * 00100 *> \ingroup complexSYauxiliary 00101 * 00102 * ===================================================================== 00103 SUBROUTINE CSYSWAPR( UPLO, N, A, LDA, I1, I2) 00104 * 00105 * -- LAPACK auxiliary routine (version 3.4.0) -- 00106 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00107 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00108 * November 2011 00109 * 00110 * .. Scalar Arguments .. 00111 CHARACTER UPLO 00112 INTEGER I1, I2, LDA, N 00113 * .. 00114 * .. Array Arguments .. 00115 COMPLEX A( LDA, N ) 00116 * 00117 * ===================================================================== 00118 * 00119 * .. 00120 * .. Local Scalars .. 00121 LOGICAL UPPER 00122 INTEGER I 00123 COMPLEX TMP 00124 * 00125 * .. External Functions .. 00126 LOGICAL LSAME 00127 EXTERNAL LSAME 00128 * .. 00129 * .. External Subroutines .. 00130 EXTERNAL CSWAP 00131 * .. 00132 * .. Executable Statements .. 00133 * 00134 UPPER = LSAME( UPLO, 'U' ) 00135 IF (UPPER) THEN 00136 * 00137 * UPPER 00138 * first swap 00139 * - swap column I1 and I2 from I1 to I1-1 00140 CALL CSWAP( I1-1, A(1,I1), 1, A(1,I2), 1 ) 00141 * 00142 * second swap : 00143 * - swap A(I1,I1) and A(I2,I2) 00144 * - swap row I1 from I1+1 to I2-1 with col I2 from I1+1 to I2-1 00145 TMP=A(I1,I1) 00146 A(I1,I1)=A(I2,I2) 00147 A(I2,I2)=TMP 00148 * 00149 DO I=1,I2-I1-1 00150 TMP=A(I1,I1+I) 00151 A(I1,I1+I)=A(I1+I,I2) 00152 A(I1+I,I2)=TMP 00153 END DO 00154 * 00155 * third swap 00156 * - swap row I1 and I2 from I2+1 to N 00157 DO I=I2+1,N 00158 TMP=A(I1,I) 00159 A(I1,I)=A(I2,I) 00160 A(I2,I)=TMP 00161 END DO 00162 * 00163 ELSE 00164 * 00165 * LOWER 00166 * first swap 00167 * - swap row I1 and I2 from I1 to I1-1 00168 CALL CSWAP ( I1-1, A(I1,1), LDA, A(I2,1), LDA ) 00169 * 00170 * second swap : 00171 * - swap A(I1,I1) and A(I2,I2) 00172 * - swap col I1 from I1+1 to I2-1 with row I2 from I1+1 to I2-1 00173 TMP=A(I1,I1) 00174 A(I1,I1)=A(I2,I2) 00175 A(I2,I2)=TMP 00176 * 00177 DO I=1,I2-I1-1 00178 TMP=A(I1+I,I1) 00179 A(I1+I,I1)=A(I2,I1+I) 00180 A(I2,I1+I)=TMP 00181 END DO 00182 * 00183 * third swap 00184 * - swap col I1 and I2 from I2+1 to N 00185 DO I=I2+1,N 00186 TMP=A(I,I1) 00187 A(I,I1)=A(I,I2) 00188 A(I,I2)=TMP 00189 END DO 00190 * 00191 ENDIF 00192 END SUBROUTINE CSYSWAPR 00193