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