1*> \brief \b ZHESWAPR applies an elementary permutation on the rows and columns of a Hermitian matrix.
2*
3*  =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6*            http://www.netlib.org/lapack/explore-html/
7*
8*> \htmlonly
9*> Download ZHESWAPR + dependencies
10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zheswapr.f">
11*> [TGZ]</a>
12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zheswapr.f">
13*> [ZIP]</a>
14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zheswapr.f">
15*> [TXT]</a>
16*> \endhtmlonly
17*
18*  Definition:
19*  ===========
20*
21*       SUBROUTINE ZHESWAPR( UPLO, N, A, LDA, I1, I2)
22*
23*       .. Scalar Arguments ..
24*       CHARACTER        UPLO
25*       INTEGER          I1, I2, LDA, N
26*       ..
27*       .. Array Arguments ..
28*       COMPLEX*16          A( LDA, N )
29*
30*
31*> \par Purpose:
32*  =============
33*>
34*> \verbatim
35*>
36*> ZHESWAPR applies an elementary permutation on the rows and the columns of
37*> a hermitian matrix.
38*> \endverbatim
39*
40*  Arguments:
41*  ==========
42*
43*> \param[in] UPLO
44*> \verbatim
45*>          UPLO is CHARACTER*1
46*>          Specifies whether the details of the factorization are stored
47*>          as an upper or lower triangular matrix.
48*>          = 'U':  Upper triangular, form is A = U*D*U**T;
49*>          = 'L':  Lower triangular, form is A = L*D*L**T.
50*> \endverbatim
51*>
52*> \param[in] N
53*> \verbatim
54*>          N is INTEGER
55*>          The order of the matrix A.  N >= 0.
56*> \endverbatim
57*>
58*> \param[in,out] A
59*> \verbatim
60*>          A is COMPLEX*16 array, dimension (LDA,N)
61*>          On entry, the NB diagonal matrix D and the multipliers
62*>          used to obtain the factor U or L as computed by CSYTRF.
63*>
64*>          On exit, if INFO = 0, the (symmetric) inverse of the original
65*>          matrix.  If UPLO = 'U', the upper triangular part of the
66*>          inverse is formed and the part of A below the diagonal is not
67*>          referenced; if UPLO = 'L' the lower triangular part of the
68*>          inverse is formed and the part of A above the diagonal is
69*>          not referenced.
70*> \endverbatim
71*>
72*> \param[in] LDA
73*> \verbatim
74*>          LDA is INTEGER
75*>          The leading dimension of the array A.  LDA >= max(1,N).
76*> \endverbatim
77*>
78*> \param[in] I1
79*> \verbatim
80*>          I1 is INTEGER
81*>          Index of the first row to swap
82*> \endverbatim
83*>
84*> \param[in] I2
85*> \verbatim
86*>          I2 is INTEGER
87*>          Index of the second row to swap
88*> \endverbatim
89*
90*  Authors:
91*  ========
92*
93*> \author Univ. of Tennessee
94*> \author Univ. of California Berkeley
95*> \author Univ. of Colorado Denver
96*> \author NAG Ltd.
97*
98*> \ingroup complex16HEauxiliary
99*
100*  =====================================================================
101      SUBROUTINE ZHESWAPR( UPLO, N, A, LDA, I1, I2)
102*
103*  -- LAPACK auxiliary routine --
104*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
105*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
106*
107*     .. Scalar Arguments ..
108      CHARACTER        UPLO
109      INTEGER          I1, I2, LDA, N
110*     ..
111*     .. Array Arguments ..
112      COMPLEX*16          A( LDA, N )
113*
114*  =====================================================================
115*
116*     ..
117*     .. Local Scalars ..
118      LOGICAL            UPPER
119      INTEGER            I
120      COMPLEX*16            TMP
121*
122*     .. External Functions ..
123      LOGICAL            LSAME
124      EXTERNAL           LSAME
125*     ..
126*     .. External Subroutines ..
127      EXTERNAL           ZSWAP
128*     ..
129*     .. Executable Statements ..
130*
131      UPPER = LSAME( UPLO, 'U' )
132      IF (UPPER) THEN
133*
134*         UPPER
135*         first swap
136*          - swap column I1 and I2 from I1 to I1-1
137         CALL ZSWAP( I1-1, A(1,I1), 1, A(1,I2), 1 )
138*
139*          second swap :
140*          - swap A(I1,I1) and A(I2,I2)
141*          - swap row I1 from I1+1 to I2-1 with col I2 from I1+1 to I2-1
142*          - swap A(I2,I1) and A(I1,I2)
143
144         TMP=A(I1,I1)
145         A(I1,I1)=A(I2,I2)
146         A(I2,I2)=TMP
147*
148         DO I=1,I2-I1-1
149            TMP=A(I1,I1+I)
150            A(I1,I1+I)=DCONJG(A(I1+I,I2))
151            A(I1+I,I2)=DCONJG(TMP)
152         END DO
153*
154          A(I1,I2)=DCONJG(A(I1,I2))
155
156*
157*          third swap
158*          - swap row I1 and I2 from I2+1 to N
159         DO I=I2+1,N
160            TMP=A(I1,I)
161            A(I1,I)=A(I2,I)
162            A(I2,I)=TMP
163         END DO
164*
165        ELSE
166*
167*         LOWER
168*         first swap
169*          - swap row I1 and I2 from 1 to I1-1
170         CALL ZSWAP ( I1-1, A(I1,1), LDA, A(I2,1), LDA )
171*
172*         second swap :
173*          - swap A(I1,I1) and A(I2,I2)
174*          - swap col I1 from I1+1 to I2-1 with row I2 from I1+1 to I2-1
175*          - swap A(I2,I1) and A(I1,I2)
176
177          TMP=A(I1,I1)
178          A(I1,I1)=A(I2,I2)
179          A(I2,I2)=TMP
180*
181          DO I=1,I2-I1-1
182             TMP=A(I1+I,I1)
183             A(I1+I,I1)=DCONJG(A(I2,I1+I))
184             A(I2,I1+I)=DCONJG(TMP)
185          END DO
186*
187          A(I2,I1)=DCONJG(A(I2,I1))
188*
189*         third swap
190*          - swap col I1 and I2 from I2+1 to N
191          DO I=I2+1,N
192             TMP=A(I,I1)
193             A(I,I1)=A(I,I2)
194             A(I,I2)=TMP
195          END DO
196*
197      ENDIF
198
199      END SUBROUTINE ZHESWAPR
200
201