00001 SUBROUTINE CHESWAPR( UPLO, N, A, I1, I2) 00002 * 00003 * -- LAPACK 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 * CHESWAPR swaps two rows of a lower or upper matrix 00019 * 00020 * Arguments 00021 * ========= 00022 * 00023 * UPLO (input) CHARACTER*1 00024 * Specifies whether the details of the factorization are stored 00025 * as an upper or lower triangular matrix. 00026 * = 'U': Upper triangular, form is A = U*D*U**T; 00027 * = 'L': Lower triangular, form is A = L*D*L**T. 00028 * 00029 * N (input) INTEGER 00030 * The order of the matrix A. N >= 0. 00031 * 00032 * A (input/output) COMPLEX array, dimension (LDA,N) 00033 * On entry, the NB diagonal matrix D and the multipliers 00034 * used to obtain the factor U or L as computed by CSYTRF. 00035 * 00036 * On exit, if INFO = 0, the (symmetric) inverse of the original 00037 * matrix. If UPLO = 'U', the upper triangular part of the 00038 * inverse is formed and the part of A below the diagonal is not 00039 * referenced; if UPLO = 'L' the lower triangular part of the 00040 * inverse is formed and the part of A above the diagonal is 00041 * not referenced. 00042 * 00043 * I1 (input) INTEGER 00044 * Index of the first row to swap 00045 * 00046 * I2 (input) INTEGER 00047 * Index of the second row to swap 00048 * 00049 * ===================================================================== 00050 * 00051 * .. 00052 * .. Local Scalars .. 00053 LOGICAL UPPER 00054 INTEGER I 00055 COMPLEX TMP 00056 * 00057 * .. External Functions .. 00058 LOGICAL LSAME 00059 EXTERNAL LSAME 00060 * .. 00061 * .. External Subroutines .. 00062 EXTERNAL CSWAP 00063 * .. 00064 * .. Executable Statements .. 00065 * 00066 UPPER = LSAME( UPLO, 'U' ) 00067 IF (UPPER) THEN 00068 * 00069 * UPPER 00070 * first swap 00071 * - swap column I1 and I2 from I1 to I1-1 00072 CALL CSWAP( I1-1, A(1,I1), 1, A(1,I2), 1 ) 00073 * 00074 * second swap : 00075 * - swap A(I1,I1) and A(I2,I2) 00076 * - swap row I1 from I1+1 to I2-1 with col I2 from I1+1 to I2-1 00077 TMP=CONJG( A(I1,I1) ) 00078 A(I1,I1)=CONJG( A(I2,I2) ) 00079 A(I2,I2)=TMP 00080 * 00081 DO I=1,I2-I1-1 00082 TMP=CONJG( A(I1,I1+I) ) 00083 A(I1,I1+I)=CONJG( A(I1+I,I2) ) 00084 A(I1+I,I2)=TMP 00085 END DO 00086 * 00087 * third swap 00088 * - swap row I1 and I2 from I2+1 to N 00089 DO I=I2+1,N 00090 TMP=CONJG( A(I1,I) ) 00091 A(I1,I)=CONJG( A(I2,I) ) 00092 A(I2,I)=TMP 00093 END DO 00094 * 00095 ELSE 00096 * 00097 * LOWER 00098 * first swap 00099 * - swap row I1 and I2 from I1 to I1-1 00100 CALL CSWAP ( I1-1, A(I1,1), N, A(I2,1), N ) 00101 * 00102 * second swap : 00103 * - swap A(I1,I1) and A(I2,I2) 00104 * - swap col I1 from I1+1 to I2-1 with row I2 from I1+1 to I2-1 00105 TMP=CONJG( A(I1,I1) ) 00106 A(I1,I1)=CONJG( A(I2,I2) ) 00107 A(I2,I2)=TMP 00108 * 00109 DO I=1,I2-I1-1 00110 TMP=CONJG( A(I1+I,I1) ) 00111 A(I1+I,I1)=CONJG( A(I2,I1+I) ) 00112 A(I2,I1+I)=TMP 00113 END DO 00114 * 00115 * third swap 00116 * - swap col I1 and I2 from I2+1 to N 00117 DO I=I2+1,N 00118 TMP=CONJG( A(I,I1) ) 00119 A(I,I1)=CONJG( A(I,I2) ) 00120 A(I,I2)=TMP 00121 END DO 00122 * 00123 ENDIF 00124 END SUBROUTINE CHESWAPR 00125
1.7.2