LAPACK  3.10.1 LAPACK: Linear Algebra PACKage
csyconv.f
Go to the documentation of this file.
1 *> \brief \b CSYCONV
2 *
3 * =========== DOCUMENTATION ===========
4 *
5 * Online html documentation available at
6 * http://www.netlib.org/lapack/explore-html/
7 *
8 *> \htmlonly
10 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/csyconv.f">
11 *> [TGZ]</a>
12 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/csyconv.f">
13 *> [ZIP]</a>
14 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/csyconv.f">
15 *> [TXT]</a>
16 *> \endhtmlonly
17 *
18 * Definition:
19 * ===========
20 *
21 * SUBROUTINE CSYCONV( UPLO, WAY, N, A, LDA, IPIV, E, INFO )
22 *
23 * .. Scalar Arguments ..
24 * CHARACTER UPLO, WAY
25 * INTEGER INFO, LDA, N
26 * ..
27 * .. Array Arguments ..
28 * INTEGER IPIV( * )
29 * COMPLEX A( LDA, * ), E( * )
30 * ..
31 *
32 *
33 *> \par Purpose:
34 * =============
35 *>
36 *> \verbatim
37 *>
38 *> CSYCONV convert A given by TRF into L and D and vice-versa.
39 *> Get Non-diag elements of D (returned in workspace) and
40 *> apply or reverse permutation done in TRF.
41 *> \endverbatim
42 *
43 * Arguments:
44 * ==========
45 *
46 *> \param[in] UPLO
47 *> \verbatim
48 *> UPLO is CHARACTER*1
49 *> Specifies whether the details of the factorization are stored
50 *> as an upper or lower triangular matrix.
51 *> = 'U': Upper triangular, form is A = U*D*U**T;
52 *> = 'L': Lower triangular, form is A = L*D*L**T.
53 *> \endverbatim
54 *>
55 *> \param[in] WAY
56 *> \verbatim
57 *> WAY is CHARACTER*1
58 *> = 'C': Convert
59 *> = 'R': Revert
60 *> \endverbatim
61 *>
62 *> \param[in] N
63 *> \verbatim
64 *> N is INTEGER
65 *> The order of the matrix A. N >= 0.
66 *> \endverbatim
67 *>
68 *> \param[in,out] A
69 *> \verbatim
70 *> A is COMPLEX array, dimension (LDA,N)
71 *> The block diagonal matrix D and the multipliers used to
72 *> obtain the factor U or L as computed by CSYTRF.
73 *> \endverbatim
74 *>
75 *> \param[in] LDA
76 *> \verbatim
77 *> LDA is INTEGER
78 *> The leading dimension of the array A. LDA >= max(1,N).
79 *> \endverbatim
80 *>
81 *> \param[in] IPIV
82 *> \verbatim
83 *> IPIV is INTEGER array, dimension (N)
84 *> Details of the interchanges and the block structure of D
85 *> as determined by CSYTRF.
86 *> \endverbatim
87 *>
88 *> \param[out] E
89 *> \verbatim
90 *> E is COMPLEX array, dimension (N)
91 *> E stores the supdiagonal/subdiagonal of the symmetric 1-by-1
92 *> or 2-by-2 block diagonal matrix D in LDLT.
93 *> \endverbatim
94 *>
95 *> \param[out] INFO
96 *> \verbatim
97 *> INFO is INTEGER
98 *> = 0: successful exit
99 *> < 0: if INFO = -i, the i-th argument had an illegal value
100 *> \endverbatim
101 *
102 * Authors:
103 * ========
104 *
105 *> \author Univ. of Tennessee
106 *> \author Univ. of California Berkeley
107 *> \author Univ. of Colorado Denver
108 *> \author NAG Ltd.
109 *
110 *> \ingroup complexSYcomputational
111 *
112 * =====================================================================
113  SUBROUTINE csyconv( UPLO, WAY, N, A, LDA, IPIV, E, INFO )
114 *
115 * -- LAPACK computational routine --
116 * -- LAPACK is a software package provided by Univ. of Tennessee, --
117 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
118 *
119 * .. Scalar Arguments ..
120  CHARACTER UPLO, WAY
121  INTEGER INFO, LDA, N
122 * ..
123 * .. Array Arguments ..
124  INTEGER IPIV( * )
125  COMPLEX A( LDA, * ), E( * )
126 * ..
127 *
128 * =====================================================================
129 *
130 * .. Parameters ..
131  COMPLEX ZERO
132  parameter( zero = (0.0e+0,0.0e+0) )
133 * ..
134 * .. External Functions ..
135  LOGICAL LSAME
136  EXTERNAL lsame
137 *
138 * .. External Subroutines ..
139  EXTERNAL xerbla
140 * .. Local Scalars ..
141  LOGICAL UPPER, CONVERT
142  INTEGER I, IP, J
143  COMPLEX TEMP
144 * ..
145 * .. Executable Statements ..
146 *
147  info = 0
148  upper = lsame( uplo, 'U' )
149  convert = lsame( way, 'C' )
150  IF( .NOT.upper .AND. .NOT.lsame( uplo, 'L' ) ) THEN
151  info = -1
152  ELSE IF( .NOT.convert .AND. .NOT.lsame( way, 'R' ) ) THEN
153  info = -2
154  ELSE IF( n.LT.0 ) THEN
155  info = -3
156  ELSE IF( lda.LT.max( 1, n ) ) THEN
157  info = -5
158
159  END IF
160  IF( info.NE.0 ) THEN
161  CALL xerbla( 'CSYCONV', -info )
162  RETURN
163  END IF
164 *
165 * Quick return if possible
166 *
167  IF( n.EQ.0 )
168  \$ RETURN
169 *
170  IF( upper ) THEN
171 *
172 * A is UPPER
173 *
174 * Convert A (A is upper)
175 *
176 * Convert VALUE
177 *
178  IF ( convert ) THEN
179  i=n
180  e(1)=zero
181  DO WHILE ( i .GT. 1 )
182  IF( ipiv(i) .LT. 0 ) THEN
183  e(i)=a(i-1,i)
184  e(i-1)=zero
185  a(i-1,i)=zero
186  i=i-1
187  ELSE
188  e(i)=zero
189  ENDIF
190  i=i-1
191  END DO
192 *
193 * Convert PERMUTATIONS
194 *
195  i=n
196  DO WHILE ( i .GE. 1 )
197  IF( ipiv(i) .GT. 0) THEN
198  ip=ipiv(i)
199  IF( i .LT. n) THEN
200  DO 12 j= i+1,n
201  temp=a(ip,j)
202  a(ip,j)=a(i,j)
203  a(i,j)=temp
204  12 CONTINUE
205  ENDIF
206  ELSE
207  ip=-ipiv(i)
208  IF( i .LT. n) THEN
209  DO 13 j= i+1,n
210  temp=a(ip,j)
211  a(ip,j)=a(i-1,j)
212  a(i-1,j)=temp
213  13 CONTINUE
214  ENDIF
215  i=i-1
216  ENDIF
217  i=i-1
218  END DO
219
220  ELSE
221 *
222 * Revert A (A is upper)
223 *
224 *
225 * Revert PERMUTATIONS
226 *
227  i=1
228  DO WHILE ( i .LE. n )
229  IF( ipiv(i) .GT. 0 ) THEN
230  ip=ipiv(i)
231  IF( i .LT. n) THEN
232  DO j= i+1,n
233  temp=a(ip,j)
234  a(ip,j)=a(i,j)
235  a(i,j)=temp
236  END DO
237  ENDIF
238  ELSE
239  ip=-ipiv(i)
240  i=i+1
241  IF( i .LT. n) THEN
242  DO j= i+1,n
243  temp=a(ip,j)
244  a(ip,j)=a(i-1,j)
245  a(i-1,j)=temp
246  END DO
247  ENDIF
248  ENDIF
249  i=i+1
250  END DO
251 *
252 * Revert VALUE
253 *
254  i=n
255  DO WHILE ( i .GT. 1 )
256  IF( ipiv(i) .LT. 0 ) THEN
257  a(i-1,i)=e(i)
258  i=i-1
259  ENDIF
260  i=i-1
261  END DO
262  END IF
263  ELSE
264 *
265 * A is LOWER
266 *
267  IF ( convert ) THEN
268 *
269 * Convert A (A is lower)
270 *
271 *
272 * Convert VALUE
273 *
274  i=1
275  e(n)=zero
276  DO WHILE ( i .LE. n )
277  IF( i.LT.n .AND. ipiv(i) .LT. 0 ) THEN
278  e(i)=a(i+1,i)
279  e(i+1)=zero
280  a(i+1,i)=zero
281  i=i+1
282  ELSE
283  e(i)=zero
284  ENDIF
285  i=i+1
286  END DO
287 *
288 * Convert PERMUTATIONS
289 *
290  i=1
291  DO WHILE ( i .LE. n )
292  IF( ipiv(i) .GT. 0 ) THEN
293  ip=ipiv(i)
294  IF (i .GT. 1) THEN
295  DO 22 j= 1,i-1
296  temp=a(ip,j)
297  a(ip,j)=a(i,j)
298  a(i,j)=temp
299  22 CONTINUE
300  ENDIF
301  ELSE
302  ip=-ipiv(i)
303  IF (i .GT. 1) THEN
304  DO 23 j= 1,i-1
305  temp=a(ip,j)
306  a(ip,j)=a(i+1,j)
307  a(i+1,j)=temp
308  23 CONTINUE
309  ENDIF
310  i=i+1
311  ENDIF
312  i=i+1
313  END DO
314  ELSE
315 *
316 * Revert A (A is lower)
317 *
318 *
319 * Revert PERMUTATIONS
320 *
321  i=n
322  DO WHILE ( i .GE. 1 )
323  IF( ipiv(i) .GT. 0 ) THEN
324  ip=ipiv(i)
325  IF (i .GT. 1) THEN
326  DO j= 1,i-1
327  temp=a(i,j)
328  a(i,j)=a(ip,j)
329  a(ip,j)=temp
330  END DO
331  ENDIF
332  ELSE
333  ip=-ipiv(i)
334  i=i-1
335  IF (i .GT. 1) THEN
336  DO j= 1,i-1
337  temp=a(i+1,j)
338  a(i+1,j)=a(ip,j)
339  a(ip,j)=temp
340  END DO
341  ENDIF
342  ENDIF
343  i=i-1
344  END DO
345 *
346 * Revert VALUE
347 *
348  i=1
349  DO WHILE ( i .LE. n-1 )
350  IF( ipiv(i) .LT. 0 ) THEN
351  a(i+1,i)=e(i)
352  i=i+1
353  ENDIF
354  i=i+1
355  END DO
356  END IF
357  END IF
358
359  RETURN
360 *
361 * End of CSYCONV
362 *
363  END
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:60
subroutine csyconv(UPLO, WAY, N, A, LDA, IPIV, E, INFO)
CSYCONV
Definition: csyconv.f:114