Lots of trailing whitespaces in the files of Syd. Cleaning this. No big deal.
[platform/upstream/lapack.git] / SRC / zsyswapr.f
1 *> \brief \b ZSYSWAPR
2 *
3 *  =========== DOCUMENTATION ===========
4 *
5 * Online html documentation available at
6 *            http://www.netlib.org/lapack/explore-html/
7 *
8 *> \htmlonly
9 *> Download ZSYSWAPR + dependencies
10 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zsyswapr.f">
11 *> [TGZ]</a>
12 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zsyswapr.f">
13 *> [ZIP]</a>
14 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zsyswapr.f">
15 *> [TXT]</a>
16 *> \endhtmlonly
17 *
18 *  Definition:
19 *  ===========
20 *
21 *       SUBROUTINE ZSYSWAPR( 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 *> ZSYSWAPR 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 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 ZSYTRF.
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 November 2011
99 *
100 *> \ingroup complex16SYauxiliary
101 *
102 *  =====================================================================
103       SUBROUTINE ZSYSWAPR( UPLO, N, A, LDA, I1, I2)
104 *
105 *  -- LAPACK auxiliary routine (version 3.4.0) --
106 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
107 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
108 *     November 2011
109 *
110 *     .. Scalar Arguments ..
111       CHARACTER        UPLO
112       INTEGER          I1, I2, LDA, N
113 *     ..
114 *     .. Array Arguments ..
115       COMPLEX*16       A( LDA, N )
116 *
117 *  =====================================================================
118 *
119 *     ..
120 *     .. Local Scalars ..
121       LOGICAL            UPPER
122       INTEGER            I
123       COMPLEX*16         TMP
124 *
125 *     .. External Functions ..
126       LOGICAL            LSAME
127       EXTERNAL           LSAME
128 *     ..
129 *     .. External Subroutines ..
130       EXTERNAL           ZSWAP
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 ZSWAP( 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 ZSWAP( 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 ZSYSWAPR
193