LAPACK  3.10.0
LAPACK: Linear Algebra PACKage
zsyconvf.f
Go to the documentation of this file.
1 *> \brief \b ZSYCONVF
2 *
3 * =========== DOCUMENTATION ===========
4 *
5 * Online html documentation available at
6 * http://www.netlib.org/lapack/explore-html/
7 *
8 *> \htmlonly
9 *> Download ZSYCONVF + dependencies
10 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zsyconvf.f">
11 *> [TGZ]</a>
12 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zsyconvf.f">
13 *> [ZIP]</a>
14 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zsyconvf.f">
15 *> [TXT]</a>
16 *> \endhtmlonly
17 *
18 * Definition:
19 * ===========
20 *
21 * SUBROUTINE ZSYCONVF( UPLO, WAY, N, A, LDA, E, IPIV, INFO )
22 *
23 * .. Scalar Arguments ..
24 * CHARACTER UPLO, WAY
25 * INTEGER INFO, LDA, N
26 * ..
27 * .. Array Arguments ..
28 * INTEGER IPIV( * )
29 * COMPLEX*16 A( LDA, * ), E( * )
30 * ..
31 *
32 *
33 *> \par Purpose:
34 * =============
35 *>
36 *> \verbatim
37 *> If parameter WAY = 'C':
38 *> ZSYCONVF converts the factorization output format used in
39 *> ZSYTRF provided on entry in parameter A into the factorization
40 *> output format used in ZSYTRF_RK (or ZSYTRF_BK) that is stored
41 *> on exit in parameters A and E. It also converts in place details of
42 *> the intechanges stored in IPIV from the format used in ZSYTRF into
43 *> the format used in ZSYTRF_RK (or ZSYTRF_BK).
44 *>
45 *> If parameter WAY = 'R':
46 *> ZSYCONVF performs the conversion in reverse direction, i.e.
47 *> converts the factorization output format used in ZSYTRF_RK
48 *> (or ZSYTRF_BK) provided on entry in parameters A and E into
49 *> the factorization output format used in ZSYTRF that is stored
50 *> on exit in parameter A. It also converts in place details of
51 *> the intechanges stored in IPIV from the format used in ZSYTRF_RK
52 *> (or ZSYTRF_BK) into the format used in ZSYTRF.
53 *>
54 *> ZSYCONVF can also convert in Hermitian matrix case, i.e. between
55 *> formats used in ZHETRF and ZHETRF_RK (or ZHETRF_BK).
56 *> \endverbatim
57 *
58 * Arguments:
59 * ==========
60 *
61 *> \param[in] UPLO
62 *> \verbatim
63 *> UPLO is CHARACTER*1
64 *> Specifies whether the details of the factorization are
65 *> stored as an upper or lower triangular matrix A.
66 *> = 'U': Upper triangular
67 *> = 'L': Lower triangular
68 *> \endverbatim
69 *>
70 *> \param[in] WAY
71 *> \verbatim
72 *> WAY is CHARACTER*1
73 *> = 'C': Convert
74 *> = 'R': Revert
75 *> \endverbatim
76 *>
77 *> \param[in] N
78 *> \verbatim
79 *> N is INTEGER
80 *> The order of the matrix A. N >= 0.
81 *> \endverbatim
82 *>
83 *> \param[in,out] A
84 *> \verbatim
85 *> A is COMPLEX*16 array, dimension (LDA,N)
86 *>
87 *> 1) If WAY ='C':
88 *>
89 *> On entry, contains factorization details in format used in
90 *> ZSYTRF:
91 *> a) all elements of the symmetric block diagonal
92 *> matrix D on the diagonal of A and on superdiagonal
93 *> (or subdiagonal) of A, and
94 *> b) If UPLO = 'U': multipliers used to obtain factor U
95 *> in the superdiagonal part of A.
96 *> If UPLO = 'L': multipliers used to obtain factor L
97 *> in the superdiagonal part of A.
98 *>
99 *> On exit, contains factorization details in format used in
100 *> ZSYTRF_RK or ZSYTRF_BK:
101 *> a) ONLY diagonal elements of the symmetric block diagonal
102 *> matrix D on the diagonal of A, i.e. D(k,k) = A(k,k);
103 *> (superdiagonal (or subdiagonal) elements of D
104 *> are stored on exit in array E), and
105 *> b) If UPLO = 'U': factor U in the superdiagonal part of A.
106 *> If UPLO = 'L': factor L in the subdiagonal part of A.
107 *>
108 *> 2) If WAY = 'R':
109 *>
110 *> On entry, contains factorization details in format used in
111 *> ZSYTRF_RK or ZSYTRF_BK:
112 *> a) ONLY diagonal elements of the symmetric block diagonal
113 *> matrix D on the diagonal of A, i.e. D(k,k) = A(k,k);
114 *> (superdiagonal (or subdiagonal) elements of D
115 *> are stored on exit in array E), and
116 *> b) If UPLO = 'U': factor U in the superdiagonal part of A.
117 *> If UPLO = 'L': factor L in the subdiagonal part of A.
118 *>
119 *> On exit, contains factorization details in format used in
120 *> ZSYTRF:
121 *> a) all elements of the symmetric block diagonal
122 *> matrix D on the diagonal of A and on superdiagonal
123 *> (or subdiagonal) of A, and
124 *> b) If UPLO = 'U': multipliers used to obtain factor U
125 *> in the superdiagonal part of A.
126 *> If UPLO = 'L': multipliers used to obtain factor L
127 *> in the superdiagonal part of A.
128 *> \endverbatim
129 *>
130 *> \param[in] LDA
131 *> \verbatim
132 *> LDA is INTEGER
133 *> The leading dimension of the array A. LDA >= max(1,N).
134 *> \endverbatim
135 *>
136 *> \param[in,out] E
137 *> \verbatim
138 *> E is COMPLEX*16 array, dimension (N)
139 *>
140 *> 1) If WAY ='C':
141 *>
142 *> On entry, just a workspace.
143 *>
144 *> On exit, contains the superdiagonal (or subdiagonal)
145 *> elements of the symmetric block diagonal matrix D
146 *> with 1-by-1 or 2-by-2 diagonal blocks, where
147 *> If UPLO = 'U': E(i) = D(i-1,i), i=2:N, E(1) is set to 0;
148 *> If UPLO = 'L': E(i) = D(i+1,i), i=1:N-1, E(N) is set to 0.
149 *>
150 *> 2) If WAY = 'R':
151 *>
152 *> On entry, contains the superdiagonal (or subdiagonal)
153 *> elements of the symmetric block diagonal matrix D
154 *> with 1-by-1 or 2-by-2 diagonal blocks, where
155 *> If UPLO = 'U': E(i) = D(i-1,i),i=2:N, E(1) not referenced;
156 *> If UPLO = 'L': E(i) = D(i+1,i),i=1:N-1, E(N) not referenced.
157 *>
158 *> On exit, is not changed
159 *> \endverbatim
160 *.
161 *> \param[in,out] IPIV
162 *> \verbatim
163 *> IPIV is INTEGER array, dimension (N)
164 *>
165 *> 1) If WAY ='C':
166 *> On entry, details of the interchanges and the block
167 *> structure of D in the format used in ZSYTRF.
168 *> On exit, details of the interchanges and the block
169 *> structure of D in the format used in ZSYTRF_RK
170 *> ( or ZSYTRF_BK).
171 *>
172 *> 1) If WAY ='R':
173 *> On entry, details of the interchanges and the block
174 *> structure of D in the format used in ZSYTRF_RK
175 *> ( or ZSYTRF_BK).
176 *> On exit, details of the interchanges and the block
177 *> structure of D in the format used in ZSYTRF.
178 *> \endverbatim
179 *>
180 *> \param[out] INFO
181 *> \verbatim
182 *> INFO is INTEGER
183 *> = 0: successful exit
184 *> < 0: if INFO = -i, the i-th argument had an illegal value
185 *> \endverbatim
186 *
187 * Authors:
188 * ========
189 *
190 *> \author Univ. of Tennessee
191 *> \author Univ. of California Berkeley
192 *> \author Univ. of Colorado Denver
193 *> \author NAG Ltd.
194 *
195 *> \ingroup complex16SYcomputational
196 *
197 *> \par Contributors:
198 * ==================
199 *>
200 *> \verbatim
201 *>
202 *> November 2017, Igor Kozachenko,
203 *> Computer Science Division,
204 *> University of California, Berkeley
205 *>
206 *> \endverbatim
207 * =====================================================================
208  SUBROUTINE zsyconvf( UPLO, WAY, N, A, LDA, E, IPIV, INFO )
209 *
210 * -- LAPACK computational routine --
211 * -- LAPACK is a software package provided by Univ. of Tennessee, --
212 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
213 *
214 * .. Scalar Arguments ..
215  CHARACTER UPLO, WAY
216  INTEGER INFO, LDA, N
217 * ..
218 * .. Array Arguments ..
219  INTEGER IPIV( * )
220  COMPLEX*16 A( LDA, * ), E( * )
221 * ..
222 *
223 * =====================================================================
224 *
225 * .. Parameters ..
226  COMPLEX*16 ZERO
227  parameter( zero = ( 0.0d+0, 0.0d+0 ) )
228 * ..
229 * .. External Functions ..
230  LOGICAL LSAME
231  EXTERNAL lsame
232 *
233 * .. External Subroutines ..
234  EXTERNAL zswap, xerbla
235 * .. Local Scalars ..
236  LOGICAL UPPER, CONVERT
237  INTEGER I, IP
238 * ..
239 * .. Executable Statements ..
240 *
241  info = 0
242  upper = lsame( uplo, 'U' )
243  convert = lsame( way, 'C' )
244  IF( .NOT.upper .AND. .NOT.lsame( uplo, 'L' ) ) THEN
245  info = -1
246  ELSE IF( .NOT.convert .AND. .NOT.lsame( way, 'R' ) ) THEN
247  info = -2
248  ELSE IF( n.LT.0 ) THEN
249  info = -3
250  ELSE IF( lda.LT.max( 1, n ) ) THEN
251  info = -5
252 
253  END IF
254  IF( info.NE.0 ) THEN
255  CALL xerbla( 'ZSYCONVF', -info )
256  RETURN
257  END IF
258 *
259 * Quick return if possible
260 *
261  IF( n.EQ.0 )
262  $ RETURN
263 *
264  IF( upper ) THEN
265 *
266 * Begin A is UPPER
267 *
268  IF ( convert ) THEN
269 *
270 * Convert A (A is upper)
271 *
272 *
273 * Convert VALUE
274 *
275 * Assign superdiagonal entries of D to array E and zero out
276 * corresponding entries in input storage A
277 *
278  i = n
279  e( 1 ) = zero
280  DO WHILE ( i.GT.1 )
281  IF( ipiv( i ).LT.0 ) THEN
282  e( i ) = a( i-1, i )
283  e( i-1 ) = zero
284  a( i-1, i ) = zero
285  i = i - 1
286  ELSE
287  e( i ) = zero
288  END IF
289  i = i - 1
290  END DO
291 *
292 * Convert PERMUTATIONS and IPIV
293 *
294 * Apply permutations to submatrices of upper part of A
295 * in factorization order where i decreases from N to 1
296 *
297  i = n
298  DO WHILE ( i.GE.1 )
299  IF( ipiv( i ).GT.0 ) THEN
300 *
301 * 1-by-1 pivot interchange
302 *
303 * Swap rows i and IPIV(i) in A(1:i,N-i:N)
304 *
305  ip = ipiv( i )
306  IF( i.LT.n ) THEN
307  IF( ip.NE.i ) THEN
308  CALL zswap( n-i, a( i, i+1 ), lda,
309  $ a( ip, i+1 ), lda )
310  END IF
311  END IF
312 *
313  ELSE
314 *
315 * 2-by-2 pivot interchange
316 *
317 * Swap rows i-1 and IPIV(i) in A(1:i,N-i:N)
318 *
319  ip = -ipiv( i )
320  IF( i.LT.n ) THEN
321  IF( ip.NE.(i-1) ) THEN
322  CALL zswap( n-i, a( i-1, i+1 ), lda,
323  $ a( ip, i+1 ), lda )
324  END IF
325  END IF
326 *
327 * Convert IPIV
328 * There is no interchnge of rows i and and IPIV(i),
329 * so this should be reflected in IPIV format for
330 * *SYTRF_RK ( or *SYTRF_BK)
331 *
332  ipiv( i ) = i
333 *
334  i = i - 1
335 *
336  END IF
337  i = i - 1
338  END DO
339 *
340  ELSE
341 *
342 * Revert A (A is upper)
343 *
344 *
345 * Revert PERMUTATIONS and IPIV
346 *
347 * Apply permutations to submatrices of upper part of A
348 * in reverse factorization order where i increases from 1 to N
349 *
350  i = 1
351  DO WHILE ( i.LE.n )
352  IF( ipiv( i ).GT.0 ) THEN
353 *
354 * 1-by-1 pivot interchange
355 *
356 * Swap rows i and IPIV(i) in A(1:i,N-i:N)
357 *
358  ip = ipiv( i )
359  IF( i.LT.n ) THEN
360  IF( ip.NE.i ) THEN
361  CALL zswap( n-i, a( ip, i+1 ), lda,
362  $ a( i, i+1 ), lda )
363  END IF
364  END IF
365 *
366  ELSE
367 *
368 * 2-by-2 pivot interchange
369 *
370 * Swap rows i-1 and IPIV(i) in A(1:i,N-i:N)
371 *
372  i = i + 1
373  ip = -ipiv( i )
374  IF( i.LT.n ) THEN
375  IF( ip.NE.(i-1) ) THEN
376  CALL zswap( n-i, a( ip, i+1 ), lda,
377  $ a( i-1, i+1 ), lda )
378  END IF
379  END IF
380 *
381 * Convert IPIV
382 * There is one interchange of rows i-1 and IPIV(i-1),
383 * so this should be recorded in two consecutive entries
384 * in IPIV format for *SYTRF
385 *
386  ipiv( i ) = ipiv( i-1 )
387 *
388  END IF
389  i = i + 1
390  END DO
391 *
392 * Revert VALUE
393 * Assign superdiagonal entries of D from array E to
394 * superdiagonal entries of A.
395 *
396  i = n
397  DO WHILE ( i.GT.1 )
398  IF( ipiv( i ).LT.0 ) THEN
399  a( i-1, i ) = e( i )
400  i = i - 1
401  END IF
402  i = i - 1
403  END DO
404 *
405 * End A is UPPER
406 *
407  END IF
408 *
409  ELSE
410 *
411 * Begin A is LOWER
412 *
413  IF ( convert ) THEN
414 *
415 * Convert A (A is lower)
416 *
417 *
418 * Convert VALUE
419 * Assign subdiagonal entries of D to array E and zero out
420 * corresponding entries in input storage A
421 *
422  i = 1
423  e( n ) = zero
424  DO WHILE ( i.LE.n )
425  IF( i.LT.n .AND. ipiv(i).LT.0 ) THEN
426  e( i ) = a( i+1, i )
427  e( i+1 ) = zero
428  a( i+1, i ) = zero
429  i = i + 1
430  ELSE
431  e( i ) = zero
432  END IF
433  i = i + 1
434  END DO
435 *
436 * Convert PERMUTATIONS and IPIV
437 *
438 * Apply permutations to submatrices of lower part of A
439 * in factorization order where k increases from 1 to N
440 *
441  i = 1
442  DO WHILE ( i.LE.n )
443  IF( ipiv( i ).GT.0 ) THEN
444 *
445 * 1-by-1 pivot interchange
446 *
447 * Swap rows i and IPIV(i) in A(i:N,1:i-1)
448 *
449  ip = ipiv( i )
450  IF ( i.GT.1 ) THEN
451  IF( ip.NE.i ) THEN
452  CALL zswap( i-1, a( i, 1 ), lda,
453  $ a( ip, 1 ), lda )
454  END IF
455  END IF
456 *
457  ELSE
458 *
459 * 2-by-2 pivot interchange
460 *
461 * Swap rows i+1 and IPIV(i) in A(i:N,1:i-1)
462 *
463  ip = -ipiv( i )
464  IF ( i.GT.1 ) THEN
465  IF( ip.NE.(i+1) ) THEN
466  CALL zswap( i-1, a( i+1, 1 ), lda,
467  $ a( ip, 1 ), lda )
468  END IF
469  END IF
470 *
471 * Convert IPIV
472 * There is no interchnge of rows i and and IPIV(i),
473 * so this should be reflected in IPIV format for
474 * *SYTRF_RK ( or *SYTRF_BK)
475 *
476  ipiv( i ) = i
477 *
478  i = i + 1
479 *
480  END IF
481  i = i + 1
482  END DO
483 *
484  ELSE
485 *
486 * Revert A (A is lower)
487 *
488 *
489 * Revert PERMUTATIONS and IPIV
490 *
491 * Apply permutations to submatrices of lower part of A
492 * in reverse factorization order where i decreases from N to 1
493 *
494  i = n
495  DO WHILE ( i.GE.1 )
496  IF( ipiv( i ).GT.0 ) THEN
497 *
498 * 1-by-1 pivot interchange
499 *
500 * Swap rows i and IPIV(i) in A(i:N,1:i-1)
501 *
502  ip = ipiv( i )
503  IF ( i.GT.1 ) THEN
504  IF( ip.NE.i ) THEN
505  CALL zswap( i-1, a( ip, 1 ), lda,
506  $ a( i, 1 ), lda )
507  END IF
508  END IF
509 *
510  ELSE
511 *
512 * 2-by-2 pivot interchange
513 *
514 * Swap rows i+1 and IPIV(i) in A(i:N,1:i-1)
515 *
516  i = i - 1
517  ip = -ipiv( i )
518  IF ( i.GT.1 ) THEN
519  IF( ip.NE.(i+1) ) THEN
520  CALL zswap( i-1, a( ip, 1 ), lda,
521  $ a( i+1, 1 ), lda )
522  END IF
523  END IF
524 *
525 * Convert IPIV
526 * There is one interchange of rows i+1 and IPIV(i+1),
527 * so this should be recorded in consecutive entries
528 * in IPIV format for *SYTRF
529 *
530  ipiv( i ) = ipiv( i+1 )
531 *
532  END IF
533  i = i - 1
534  END DO
535 *
536 * Revert VALUE
537 * Assign subdiagonal entries of D from array E to
538 * subgiagonal entries of A.
539 *
540  i = 1
541  DO WHILE ( i.LE.n-1 )
542  IF( ipiv( i ).LT.0 ) THEN
543  a( i + 1, i ) = e( i )
544  i = i + 1
545  END IF
546  i = i + 1
547  END DO
548 *
549  END IF
550 *
551 * End A is LOWER
552 *
553  END IF
554 
555  RETURN
556 *
557 * End of ZSYCONVF
558 *
559  END
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:60
subroutine zswap(N, ZX, INCX, ZY, INCY)
ZSWAP
Definition: zswap.f:81
subroutine zsyconvf(UPLO, WAY, N, A, LDA, E, IPIV, INFO)
ZSYCONVF
Definition: zsyconvf.f:209