00001 SUBROUTINE CSYSWAPR( UPLO, N, A, I1, I2) 00002 * 00003 * -- LAPACK auxiliary routine (version 3.3.0) -- 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 2010 00007 * 00008 * .. Scalar Arguments .. 00009 CHARACTER UPLO 00010 INTEGER I1, I2, N 00011 * .. 00012 * .. Array Arguments .. 00013 COMPLEX A(N,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 * I1 (input) INTEGER 00045 * Index of the first row to swap 00046 * 00047 * I2 (input) INTEGER 00048 * Index of the second row to swap 00049 * 00050 * ===================================================================== 00051 * 00052 * .. 00053 * .. Local Scalars .. 00054 LOGICAL UPPER 00055 INTEGER I 00056 COMPLEX TMP 00057 * 00058 * .. External Functions .. 00059 LOGICAL LSAME 00060 EXTERNAL LSAME 00061 * .. 00062 * .. External Subroutines .. 00063 EXTERNAL CSWAP 00064 * .. 00065 * .. Executable Statements .. 00066 * 00067 UPPER = LSAME( UPLO, 'U' ) 00068 IF (UPPER) THEN 00069 * 00070 * UPPER 00071 * first swap 00072 * - swap column I1 and I2 from I1 to I1-1 00073 CALL CSWAP( I1-1, A(1,I1), 1, A(1,I2), 1 ) 00074 * 00075 * second swap : 00076 * - swap A(I1,I1) and A(I2,I2) 00077 * - swap row I1 from I1+1 to I2-1 with col I2 from I1+1 to I2-1 00078 TMP=A(I1,I1) 00079 A(I1,I1)=A(I2,I2) 00080 A(I2,I2)=TMP 00081 * 00082 DO I=1,I2-I1-1 00083 TMP=A(I1,I1+I) 00084 A(I1,I1+I)=A(I1+I,I2) 00085 A(I1+I,I2)=TMP 00086 END DO 00087 * 00088 * third swap 00089 * - swap row I1 and I2 from I2+1 to N 00090 DO I=I2+1,N 00091 TMP=A(I1,I) 00092 A(I1,I)=A(I2,I) 00093 A(I2,I)=TMP 00094 END DO 00095 * 00096 ELSE 00097 * 00098 * LOWER 00099 * first swap 00100 * - swap row I1 and I2 from I1 to I1-1 00101 CALL CSWAP ( I1-1, A(I1,1), N, A(I2,1), N ) 00102 * 00103 * second swap : 00104 * - swap A(I1,I1) and A(I2,I2) 00105 * - swap col I1 from I1+1 to I2-1 with row I2 from I1+1 to I2-1 00106 TMP=A(I1,I1) 00107 A(I1,I1)=A(I2,I2) 00108 A(I2,I2)=TMP 00109 * 00110 DO I=1,I2-I1-1 00111 TMP=A(I1+I,I1) 00112 A(I1+I,I1)=A(I2,I1+I) 00113 A(I2,I1+I)=TMP 00114 END DO 00115 * 00116 * third swap 00117 * - swap col I1 and I2 from I2+1 to N 00118 DO I=I2+1,N 00119 TMP=A(I,I1) 00120 A(I,I1)=A(I,I2) 00121 A(I,I2)=TMP 00122 END DO 00123 * 00124 ENDIF 00125 END SUBROUTINE CSYSWAPR 00126
1.7.2