LAPACK 3.3.1
Linear Algebra PACKage
|
00001 SUBROUTINE CSYSWAPR( UPLO, N, A, LDA, I1, I2) 00002 * 00003 * -- LAPACK auxiliary routine (version 3.3.1) -- 00004 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00005 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00006 * -- April 2011 -- 00007 * 00008 * .. Scalar Arguments .. 00009 CHARACTER UPLO 00010 INTEGER I1, I2, LDA, N 00011 * .. 00012 * .. Array Arguments .. 00013 COMPLEX A( LDA, N ) 00014 * 00015 * Purpose 00016 * ======= 00017 * 00018 * CSYSWAPR applies an elementary permutation on the rows and the columns of 00019 * a symmetric matrix. 00020 * 00021 * Arguments 00022 * ========= 00023 * 00024 * UPLO (input) CHARACTER*1 00025 * Specifies whether the details of the factorization are stored 00026 * as an upper or lower triangular matrix. 00027 * = 'U': Upper triangular, form is A = U*D*U**T; 00028 * = 'L': Lower triangular, form is A = L*D*L**T. 00029 * 00030 * N (input) INTEGER 00031 * The order of the matrix A. N >= 0. 00032 * 00033 * A (input/output) COMPLEX array, dimension (LDA,N) 00034 * On entry, the NB diagonal matrix D and the multipliers 00035 * used to obtain the factor U or L as computed by CSYTRF. 00036 * 00037 * On exit, if INFO = 0, the (symmetric) inverse of the original 00038 * matrix. If UPLO = 'U', the upper triangular part of the 00039 * inverse is formed and the part of A below the diagonal is not 00040 * referenced; if UPLO = 'L' the lower triangular part of the 00041 * inverse is formed and the part of A above the diagonal is 00042 * not referenced. 00043 * 00044 * LDA (input) INTEGER 00045 * The leading dimension of the array A. LDA >= max(1,N). 00046 * 00047 * I1 (input) INTEGER 00048 * Index of the first row to swap 00049 * 00050 * I2 (input) INTEGER 00051 * Index of the second row to swap 00052 * 00053 * ===================================================================== 00054 * 00055 * .. 00056 * .. Local Scalars .. 00057 LOGICAL UPPER 00058 INTEGER I 00059 COMPLEX TMP 00060 * 00061 * .. External Functions .. 00062 LOGICAL LSAME 00063 EXTERNAL LSAME 00064 * .. 00065 * .. External Subroutines .. 00066 EXTERNAL CSWAP 00067 * .. 00068 * .. Executable Statements .. 00069 * 00070 UPPER = LSAME( UPLO, 'U' ) 00071 IF (UPPER) THEN 00072 * 00073 * UPPER 00074 * first swap 00075 * - swap column I1 and I2 from I1 to I1-1 00076 CALL CSWAP( I1-1, A(1,I1), 1, A(1,I2), 1 ) 00077 * 00078 * second swap : 00079 * - swap A(I1,I1) and A(I2,I2) 00080 * - swap row I1 from I1+1 to I2-1 with col I2 from I1+1 to I2-1 00081 TMP=A(I1,I1) 00082 A(I1,I1)=A(I2,I2) 00083 A(I2,I2)=TMP 00084 * 00085 DO I=1,I2-I1-1 00086 TMP=A(I1,I1+I) 00087 A(I1,I1+I)=A(I1+I,I2) 00088 A(I1+I,I2)=TMP 00089 END DO 00090 * 00091 * third swap 00092 * - swap row I1 and I2 from I2+1 to N 00093 DO I=I2+1,N 00094 TMP=A(I1,I) 00095 A(I1,I)=A(I2,I) 00096 A(I2,I)=TMP 00097 END DO 00098 * 00099 ELSE 00100 * 00101 * LOWER 00102 * first swap 00103 * - swap row I1 and I2 from I1 to I1-1 00104 CALL CSWAP ( I1-1, A(I1,1), LDA, A(I2,1), LDA ) 00105 * 00106 * second swap : 00107 * - swap A(I1,I1) and A(I2,I2) 00108 * - swap col I1 from I1+1 to I2-1 with row I2 from I1+1 to I2-1 00109 TMP=A(I1,I1) 00110 A(I1,I1)=A(I2,I2) 00111 A(I2,I2)=TMP 00112 * 00113 DO I=1,I2-I1-1 00114 TMP=A(I1+I,I1) 00115 A(I1+I,I1)=A(I2,I1+I) 00116 A(I2,I1+I)=TMP 00117 END DO 00118 * 00119 * third swap 00120 * - swap col I1 and I2 from I2+1 to N 00121 DO I=I2+1,N 00122 TMP=A(I,I1) 00123 A(I,I1)=A(I,I2) 00124 A(I,I2)=TMP 00125 END DO 00126 * 00127 ENDIF 00128 END SUBROUTINE CSYSWAPR 00129