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