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*> \ingroup realSYauxiliary
99*
100*  =====================================================================
101      SUBROUTINE SSYSWAPR( 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      REAL             A( LDA, N )
113*
114*  =====================================================================
115*
116*     ..
117*     .. Local Scalars ..
118      LOGICAL            UPPER
119      INTEGER            I
120      REAL               TMP
121*
122*     .. External Functions ..
123      LOGICAL            LSAME
124      EXTERNAL           LSAME
125*     ..
126*     .. External Subroutines ..
127      EXTERNAL           SSWAP
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 SSWAP( 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         TMP=A(I1,I1)
143         A(I1,I1)=A(I2,I2)
144         A(I2,I2)=TMP
145*
146         DO I=1,I2-I1-1
147            TMP=A(I1,I1+I)
148            A(I1,I1+I)=A(I1+I,I2)
149            A(I1+I,I2)=TMP
150         END DO
151*
152*          third swap
153*          - swap row I1 and I2 from I2+1 to N
154         DO I=I2+1,N
155            TMP=A(I1,I)
156            A(I1,I)=A(I2,I)
157            A(I2,I)=TMP
158         END DO
159*
160        ELSE
161*
162*         LOWER
163*         first swap
164*          - swap row I1 and I2 from I1 to I1-1
165         CALL SSWAP( I1-1, A(I1,1), LDA, A(I2,1), LDA )
166*
167*         second swap :
168*          - swap A(I1,I1) and A(I2,I2)
169*          - swap col I1 from I1+1 to I2-1 with row I2 from I1+1 to I2-1
170          TMP=A(I1,I1)
171          A(I1,I1)=A(I2,I2)
172          A(I2,I2)=TMP
173*
174          DO I=1,I2-I1-1
175             TMP=A(I1+I,I1)
176             A(I1+I,I1)=A(I2,I1+I)
177             A(I2,I1+I)=TMP
178          END DO
179*
180*         third swap
181*          - swap col I1 and I2 from I2+1 to N
182          DO I=I2+1,N
183             TMP=A(I,I1)
184             A(I,I1)=A(I,I2)
185             A(I,I2)=TMP
186          END DO
187*
188      ENDIF
189      END SUBROUTINE SSYSWAPR
190
191