LAPACK  3.9.0
LAPACK: Linear Algebra PACKage
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 *> \date November 2017
184 *
185 *> \ingroup doubleSYcomputational
186 *
187 *> \par Contributors:
188 * ==================
189 *>
190 *> \verbatim
191 *>
192 *> November 2017, Igor Kozachenko,
193 *> Computer Science Division,
194 *> University of California, Berkeley
195 *>
196 *> \endverbatim
197 * =====================================================================
198  SUBROUTINE dsyconvf_rook( UPLO, WAY, N, A, LDA, E, IPIV, INFO )
199 *
200 * -- LAPACK computational routine (version 3.8.0) --
201 * -- LAPACK is a software package provided by Univ. of Tennessee, --
202 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
203 * November 2017
204 *
205 * .. Scalar Arguments ..
206  CHARACTER UPLO, WAY
207  INTEGER INFO, LDA, N
208 * ..
209 * .. Array Arguments ..
210  INTEGER IPIV( * )
211  DOUBLE PRECISION A( LDA, * ), E( * )
212 * ..
213 *
214 * =====================================================================
215 *
216 * .. Parameters ..
217  DOUBLE PRECISION ZERO
218  parameter( zero = 0.0d+0 )
219 * ..
220 * .. External Functions ..
221  LOGICAL LSAME
222  EXTERNAL lsame
223 *
224 * .. External Subroutines ..
225  EXTERNAL dswap, 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( 'DSYCONVF_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 dswap( 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 dswap( 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 dswap( 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 dswap( 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 dswap( 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 dswap( 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 dswap( 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 dswap( i-1, a( i, 1 ), lda,
457  $ a( ip, 1 ), lda )
458  END IF
459  IF( ip2.NE.(i+1) ) THEN
460  CALL dswap( 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 dswap( 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 dswap( i-1, a( ip2, 1 ), lda,
509  $ a( i+1, 1 ), lda )
510  END IF
511  IF( ip.NE.i ) THEN
512  CALL dswap( 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 * subgiagonal 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 DSYCONVF_ROOK
543 *
544  END
dsyconvf_rook
subroutine dsyconvf_rook(UPLO, WAY, N, A, LDA, E, IPIV, INFO)
DSYCONVF_ROOK
Definition: dsyconvf_rook.f:199
xerbla
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
dswap
subroutine dswap(N, DX, INCX, DY, INCY)
DSWAP
Definition: dswap.f:84