![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b CHESWAPR 00002 * 00003 * =========== DOCUMENTATION =========== 00004 * 00005 * Online html documentation available at 00006 * http://www.netlib.org/lapack/explore-html/ 00007 * 00008 *> \htmlonly 00009 *> Download CHESWAPR + dependencies 00010 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/cheswapr.f"> 00011 *> [TGZ]</a> 00012 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/cheswapr.f"> 00013 *> [ZIP]</a> 00014 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/cheswapr.f"> 00015 *> [TXT]</a> 00016 *> \endhtmlonly 00017 * 00018 * Definition: 00019 * =========== 00020 * 00021 * SUBROUTINE CHESWAPR( 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 *> CHESWAPR applies an elementary permutation on the rows and the columns of 00037 *> a hermitian 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 complexHEauxiliary 00101 * 00102 * ===================================================================== 00103 SUBROUTINE CHESWAPR( 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 * - swap A(I2,I1) and A(I1,I2) 00146 00147 TMP=A(I1,I1) 00148 A(I1,I1)=A(I2,I2) 00149 A(I2,I2)=TMP 00150 * 00151 DO I=1,I2-I1-1 00152 TMP=A(I1,I1+I) 00153 A(I1,I1+I)=CONJG(A(I1+I,I2)) 00154 A(I1+I,I2)=CONJG(TMP) 00155 END DO 00156 * 00157 A(I1,I2)=CONJG(A(I1,I2)) 00158 00159 * 00160 * third swap 00161 * - swap row I1 and I2 from I2+1 to N 00162 DO I=I2+1,N 00163 TMP=A(I1,I) 00164 A(I1,I)=A(I2,I) 00165 A(I2,I)=TMP 00166 END DO 00167 * 00168 ELSE 00169 * 00170 * LOWER 00171 * first swap 00172 * - swap row I1 and I2 from 1 to I1-1 00173 CALL CSWAP ( I1-1, A(I1,1), LDA, A(I2,1), LDA ) 00174 * 00175 * second swap : 00176 * - swap A(I1,I1) and A(I2,I2) 00177 * - swap col I1 from I1+1 to I2-1 with row I2 from I1+1 to I2-1 00178 * - swap A(I2,I1) and A(I1,I2) 00179 00180 TMP=A(I1,I1) 00181 A(I1,I1)=A(I2,I2) 00182 A(I2,I2)=TMP 00183 * 00184 DO I=1,I2-I1-1 00185 TMP=A(I1+I,I1) 00186 A(I1+I,I1)=CONJG(A(I2,I1+I)) 00187 A(I2,I1+I)=CONJG(TMP) 00188 END DO 00189 * 00190 A(I2,I1)=CONJG(A(I2,I1)) 00191 * 00192 * third swap 00193 * - swap col I1 and I2 from I2+1 to N 00194 DO I=I2+1,N 00195 TMP=A(I,I1) 00196 A(I,I1)=A(I,I2) 00197 A(I,I2)=TMP 00198 END DO 00199 * 00200 ENDIF 00201 00202 END SUBROUTINE CHESWAPR 00203