LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
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*> \ingroup syconvf_rook
187*
188*> \par Contributors:
189* ==================
190*>
191*> \verbatim
192*>
193*> November 2017, Igor Kozachenko,
194*> Computer Science Division,
195*> University of California, Berkeley
196*>
197*> \endverbatim
198* =====================================================================
199 SUBROUTINE csyconvf_rook( UPLO, WAY, N, A, LDA, E, IPIV, INFO )
200*
201* -- LAPACK computational routine --
202* -- LAPACK is a software package provided by Univ. of Tennessee, --
203* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
204*
205* .. Scalar Arguments ..
206 CHARACTER UPLO, WAY
207 INTEGER INFO, LDA, N
208* ..
209* .. Array Arguments ..
210 INTEGER IPIV( * )
211 COMPLEX A( LDA, * ), E( * )
212* ..
213*
214* =====================================================================
215*
216* .. Parameters ..
217 COMPLEX ZERO
218 parameter( zero = ( 0.0e+0, 0.0e+0 ) )
219* ..
220* .. External Functions ..
221 LOGICAL LSAME
222 EXTERNAL lsame
223*
224* .. External Subroutines ..
225 EXTERNAL cswap, xerbla
226* .. Local Scalars ..
227 LOGICAL UPPER, CONVERT
228 INTEGER I, IP, IP2
229* ..
230* .. Executable Statements ..
231*
232 info = 0
233 upper = lsame( uplo, 'U' )
234 convert = lsame( way, 'C' )
235 IF( .NOT.upper .AND. .NOT.lsame( uplo, 'L' ) ) THEN
236 info = -1
237 ELSE IF( .NOT.convert .AND. .NOT.lsame( way, 'R' ) ) THEN
238 info = -2
239 ELSE IF( n.LT.0 ) THEN
240 info = -3
241 ELSE IF( lda.LT.max( 1, n ) ) THEN
242 info = -5
243
244 END IF
245 IF( info.NE.0 ) THEN
246 CALL xerbla( 'CSYCONVF_ROOK', -info )
247 RETURN
248 END IF
249*
250* Quick return if possible
251*
252 IF( n.EQ.0 )
253 $ RETURN
254*
255 IF( upper ) THEN
256*
257* Begin A is UPPER
258*
259 IF ( convert ) THEN
260*
261* Convert A (A is upper)
262*
263*
264* Convert VALUE
265*
266* Assign superdiagonal entries of D to array E and zero out
267* corresponding entries in input storage A
268*
269 i = n
270 e( 1 ) = zero
271 DO WHILE ( i.GT.1 )
272 IF( ipiv( i ).LT.0 ) THEN
273 e( i ) = a( i-1, i )
274 e( i-1 ) = zero
275 a( i-1, i ) = zero
276 i = i - 1
277 ELSE
278 e( i ) = zero
279 END IF
280 i = i - 1
281 END DO
282*
283* Convert PERMUTATIONS
284*
285* Apply permutations to submatrices of upper part of A
286* in factorization order where i decreases from N to 1
287*
288 i = n
289 DO WHILE ( i.GE.1 )
290 IF( ipiv( i ).GT.0 ) THEN
291*
292* 1-by-1 pivot interchange
293*
294* Swap rows i and IPIV(i) in A(1:i,N-i:N)
295*
296 ip = ipiv( i )
297 IF( i.LT.n ) THEN
298 IF( ip.NE.i ) THEN
299 CALL cswap( n-i, a( i, i+1 ), lda,
300 $ a( ip, i+1 ), lda )
301 END IF
302 END IF
303*
304 ELSE
305*
306* 2-by-2 pivot interchange
307*
308* Swap rows i and IPIV(i) and i-1 and IPIV(i-1)
309* in A(1:i,N-i:N)
310*
311 ip = -ipiv( i )
312 ip2 = -ipiv( i-1 )
313 IF( i.LT.n ) THEN
314 IF( ip.NE.i ) THEN
315 CALL cswap( n-i, a( i, i+1 ), lda,
316 $ a( ip, i+1 ), lda )
317 END IF
318 IF( ip2.NE.(i-1) ) THEN
319 CALL cswap( n-i, a( i-1, i+1 ), lda,
320 $ a( ip2, i+1 ), lda )
321 END IF
322 END IF
323 i = i - 1
324*
325 END IF
326 i = i - 1
327 END DO
328*
329 ELSE
330*
331* Revert A (A is upper)
332*
333*
334* Revert PERMUTATIONS
335*
336* Apply permutations to submatrices of upper part of A
337* in reverse factorization order where i increases from 1 to N
338*
339 i = 1
340 DO WHILE ( i.LE.n )
341 IF( ipiv( i ).GT.0 ) THEN
342*
343* 1-by-1 pivot interchange
344*
345* Swap rows i and IPIV(i) in A(1:i,N-i:N)
346*
347 ip = ipiv( i )
348 IF( i.LT.n ) THEN
349 IF( ip.NE.i ) THEN
350 CALL cswap( n-i, a( ip, i+1 ), lda,
351 $ a( i, i+1 ), lda )
352 END IF
353 END IF
354*
355 ELSE
356*
357* 2-by-2 pivot interchange
358*
359* Swap rows i-1 and IPIV(i-1) and i and IPIV(i)
360* in A(1:i,N-i:N)
361*
362 i = i + 1
363 ip = -ipiv( i )
364 ip2 = -ipiv( i-1 )
365 IF( i.LT.n ) THEN
366 IF( ip2.NE.(i-1) ) THEN
367 CALL cswap( n-i, a( ip2, i+1 ), lda,
368 $ a( i-1, i+1 ), lda )
369 END IF
370 IF( ip.NE.i ) THEN
371 CALL cswap( n-i, a( ip, i+1 ), lda,
372 $ a( i, i+1 ), lda )
373 END IF
374 END IF
375*
376 END IF
377 i = i + 1
378 END DO
379*
380* Revert VALUE
381* Assign superdiagonal entries of D from array E to
382* superdiagonal entries of A.
383*
384 i = n
385 DO WHILE ( i.GT.1 )
386 IF( ipiv( i ).LT.0 ) THEN
387 a( i-1, i ) = e( i )
388 i = i - 1
389 END IF
390 i = i - 1
391 END DO
392*
393* End A is UPPER
394*
395 END IF
396*
397 ELSE
398*
399* Begin A is LOWER
400*
401 IF ( convert ) THEN
402*
403* Convert A (A is lower)
404*
405*
406* Convert VALUE
407* Assign subdiagonal entries of D to array E and zero out
408* corresponding entries in input storage A
409*
410 i = 1
411 e( n ) = zero
412 DO WHILE ( i.LE.n )
413 IF( i.LT.n .AND. ipiv(i).LT.0 ) THEN
414 e( i ) = a( i+1, i )
415 e( i+1 ) = zero
416 a( i+1, i ) = zero
417 i = i + 1
418 ELSE
419 e( i ) = zero
420 END IF
421 i = i + 1
422 END DO
423*
424* Convert PERMUTATIONS
425*
426* Apply permutations to submatrices of lower part of A
427* in factorization order where i increases from 1 to N
428*
429 i = 1
430 DO WHILE ( i.LE.n )
431 IF( ipiv( i ).GT.0 ) THEN
432*
433* 1-by-1 pivot interchange
434*
435* Swap rows i and IPIV(i) in A(i:N,1:i-1)
436*
437 ip = ipiv( i )
438 IF ( i.GT.1 ) THEN
439 IF( ip.NE.i ) THEN
440 CALL cswap( i-1, a( i, 1 ), lda,
441 $ a( ip, 1 ), lda )
442 END IF
443 END IF
444*
445 ELSE
446*
447* 2-by-2 pivot interchange
448*
449* Swap rows i and IPIV(i) and i+1 and IPIV(i+1)
450* in A(i:N,1:i-1)
451*
452 ip = -ipiv( i )
453 ip2 = -ipiv( i+1 )
454 IF ( i.GT.1 ) THEN
455 IF( ip.NE.i ) THEN
456 CALL cswap( i-1, a( i, 1 ), lda,
457 $ a( ip, 1 ), lda )
458 END IF
459 IF( ip2.NE.(i+1) ) THEN
460 CALL cswap( i-1, a( i+1, 1 ), lda,
461 $ a( ip2, 1 ), lda )
462 END IF
463 END IF
464 i = i + 1
465*
466 END IF
467 i = i + 1
468 END DO
469*
470 ELSE
471*
472* Revert A (A is lower)
473*
474*
475* Revert PERMUTATIONS
476*
477* Apply permutations to submatrices of lower part of A
478* in reverse factorization order where i decreases from N to 1
479*
480 i = n
481 DO WHILE ( i.GE.1 )
482 IF( ipiv( i ).GT.0 ) THEN
483*
484* 1-by-1 pivot interchange
485*
486* Swap rows i and IPIV(i) in A(i:N,1:i-1)
487*
488 ip = ipiv( i )
489 IF ( i.GT.1 ) THEN
490 IF( ip.NE.i ) THEN
491 CALL cswap( i-1, a( ip, 1 ), lda,
492 $ a( i, 1 ), lda )
493 END IF
494 END IF
495*
496 ELSE
497*
498* 2-by-2 pivot interchange
499*
500* Swap rows i+1 and IPIV(i+1) and i and IPIV(i)
501* in A(i:N,1:i-1)
502*
503 i = i - 1
504 ip = -ipiv( i )
505 ip2 = -ipiv( i+1 )
506 IF ( i.GT.1 ) THEN
507 IF( ip2.NE.(i+1) ) THEN
508 CALL cswap( i-1, a( ip2, 1 ), lda,
509 $ a( i+1, 1 ), lda )
510 END IF
511 IF( ip.NE.i ) THEN
512 CALL cswap( i-1, a( ip, 1 ), lda,
513 $ a( i, 1 ), lda )
514 END IF
515 END IF
516*
517 END IF
518 i = i - 1
519 END DO
520*
521* Revert VALUE
522* Assign subdiagonal entries of D from array E to
523* subdiagonal entries of A.
524*
525 i = 1
526 DO WHILE ( i.LE.n-1 )
527 IF( ipiv( i ).LT.0 ) THEN
528 a( i + 1, i ) = e( i )
529 i = i + 1
530 END IF
531 i = i + 1
532 END DO
533*
534 END IF
535*
536* End A is LOWER
537*
538 END IF
539
540 RETURN
541*
542* End of CSYCONVF_ROOK
543*
544 END
subroutine xerbla(srname, info)
Definition cblat2.f:3285
subroutine cswap(n, cx, incx, cy, incy)
CSWAP
Definition cswap.f:81
subroutine csyconvf_rook(uplo, way, n, a, lda, e, ipiv, info)
CSYCONVF_ROOK