1*> \brief \b SSYSWAPR applies an elementary permutation on the rows and columns of a symmetric matrix.
2*
3*  =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6*            http://www.netlib.org/lapack/explore-html/
7*
8*> \htmlonly
9*> Download SSYSWAPR + dependencies
10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ssyswapr.f">
11*> [TGZ]</a>
12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ssyswapr.f">
13*> [ZIP]</a>
14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ssyswapr.f">
15*> [TXT]</a>
16*> \endhtmlonly
17*
18*  Definition:
19*  ===========
20*
21*       SUBROUTINE SSYSWAPR( UPLO, N, A, LDA, I1, I2)
22*
23*       .. Scalar Arguments ..
24*       CHARACTER        UPLO
25*       INTEGER          I1, I2, LDA, N
26*       ..
27*       .. Array Arguments ..
28*       REAL             A( LDA, N )
29*
30*
31*> \par Purpose:
32*  =============
33*>
34*> \verbatim
35*>
36*> SSYSWAPR applies an elementary permutation on the rows and the columns of
37*> a symmetric 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 REAL 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 SSYTRF.
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*> \date September 2012
99*
100*> \ingroup realSYauxiliary
101*
102*  =====================================================================
103      SUBROUTINE SSYSWAPR( UPLO, N, A, LDA, I1, I2)
104*
105*  -- LAPACK auxiliary routine (version 3.4.2) --
106*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
107*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
108*     September 2012
109*
110*     .. Scalar Arguments ..
111      CHARACTER        UPLO
112      INTEGER          I1, I2, LDA, N
113*     ..
114*     .. Array Arguments ..
115      REAL             A( LDA, N )
116*
117*  =====================================================================
118*
119*     ..
120*     .. Local Scalars ..
121      LOGICAL            UPPER
122      INTEGER            I
123      REAL               TMP
124*
125*     .. External Functions ..
126      LOGICAL            LSAME
127      EXTERNAL           LSAME
128*     ..
129*     .. External Subroutines ..
130      EXTERNAL           SSWAP
131*     ..
132*     .. Executable Statements ..
133*
134      UPPER = LSAME( UPLO, 'U' )
135      IF (UPPER) THEN
136*
137*         UPPER
138*         first swap
139*          - swap column I1 and I2 from I1 to I1-1
140         CALL SSWAP( I1-1, A(1,I1), 1, A(1,I2), 1 )
141*
142*          second swap :
143*          - swap A(I1,I1) and A(I2,I2)
144*          - swap row I1 from I1+1 to I2-1 with col I2 from I1+1 to I2-1
145         TMP=A(I1,I1)
146         A(I1,I1)=A(I2,I2)
147         A(I2,I2)=TMP
148*
149         DO I=1,I2-I1-1
150            TMP=A(I1,I1+I)
151            A(I1,I1+I)=A(I1+I,I2)
152            A(I1+I,I2)=TMP
153         END DO
154*
155*          third swap
156*          - swap row I1 and I2 from I2+1 to N
157         DO I=I2+1,N
158            TMP=A(I1,I)
159            A(I1,I)=A(I2,I)
160            A(I2,I)=TMP
161         END DO
162*
163        ELSE
164*
165*         LOWER
166*         first swap
167*          - swap row I1 and I2 from I1 to I1-1
168         CALL SSWAP( I1-1, A(I1,1), LDA, A(I2,1), LDA )
169*
170*         second swap :
171*          - swap A(I1,I1) and A(I2,I2)
172*          - swap col I1 from I1+1 to I2-1 with row I2 from I1+1 to I2-1
173          TMP=A(I1,I1)
174          A(I1,I1)=A(I2,I2)
175          A(I2,I2)=TMP
176*
177          DO I=1,I2-I1-1
178             TMP=A(I1+I,I1)
179             A(I1+I,I1)=A(I2,I1+I)
180             A(I2,I1+I)=TMP
181          END DO
182*
183*         third swap
184*          - swap col I1 and I2 from I2+1 to N
185          DO I=I2+1,N
186             TMP=A(I,I1)
187             A(I,I1)=A(I,I2)
188             A(I,I2)=TMP
189          END DO
190*
191      ENDIF
192      END SUBROUTINE SSYSWAPR
193
194