LAPACK  3.10.0
LAPACK: Linear Algebra PACKage
ssyconvf_rook.f
Go to the documentation of this file.
1 *> \brief \b SSYCONVF_ROOK
2 *
3 * =========== DOCUMENTATION ===========
4 *
5 * Online html documentation available at
6 * http://www.netlib.org/lapack/explore-html/
7 *
8 *> \htmlonly
9 *> Download SSYCONVF_ROOK + dependencies
10 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ssyconvf_rook.f">
11 *> [TGZ]</a>
12 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ssyconvf_rook.f">
13 *> [ZIP]</a>
14 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ssyconvf_rook.f">
15 *> [TXT]</a>
16 *> \endhtmlonly
17 *
18 * Definition:
19 * ===========
20 *
21 * SUBROUTINE SSYCONVF_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 * REAL A( LDA, * ), E( * )
30 * ..
31 *
32 *
33 *> \par Purpose:
34 * =============
35 *>
36 *> \verbatim
37 *> If parameter WAY = 'C':
38 *> SSYCONVF_ROOK converts the factorization output format used in
39 *> SSYTRF_ROOK provided on entry in parameter A into the factorization
40 *> output format used in SSYTRF_RK (or SSYTRF_BK) that is stored
41 *> on exit in parameters A and E. IPIV format for SSYTRF_ROOK and
42 *> SSYTRF_RK (or SSYTRF_BK) is the same and is not converted.
43 *>
44 *> If parameter WAY = 'R':
45 *> SSYCONVF_ROOK performs the conversion in reverse direction, i.e.
46 *> converts the factorization output format used in SSYTRF_RK
47 *> (or SSYTRF_BK) provided on entry in parameters A and E into
48 *> the factorization output format used in SSYTRF_ROOK that is stored
49 *> on exit in parameter A. IPIV format for SSYTRF_ROOK and
50 *> SSYTRF_RK (or SSYTRF_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 REAL array, dimension (LDA,N)
81 *>
82 *> 1) If WAY ='C':
83 *>
84 *> On entry, contains factorization details in format used in
85 *> SSYTRF_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 *> SSYTRF_RK or SSYTRF_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 *> SSYTRF_RK or SSYTRF_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 *> SSYTRF_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 REAL 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 SSYTRF_ROOK, if WAY ='C';
162 *> 2) by SSYTRF_RK (or SSYTRF_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 singleSYcomputational
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 ssyconvf_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  REAL A( LDA, * ), E( * )
209 * ..
210 *
211 * =====================================================================
212 *
213 * .. Parameters ..
214  REAL ZERO
215  parameter( zero = 0.0e+0 )
216 * ..
217 * .. External Functions ..
218  LOGICAL LSAME
219  EXTERNAL lsame
220 *
221 * .. External Subroutines ..
222  EXTERNAL sswap, 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( 'SSYCONVF_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 sswap( 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 sswap( 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 sswap( 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 sswap( 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 sswap( 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 sswap( 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 sswap( 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 sswap( i-1, a( i, 1 ), lda,
454  $ a( ip, 1 ), lda )
455  END IF
456  IF( ip2.NE.(i+1) ) THEN
457  CALL sswap( 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 sswap( 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 sswap( i-1, a( ip2, 1 ), lda,
506  $ a( i+1, 1 ), lda )
507  END IF
508  IF( ip.NE.i ) THEN
509  CALL sswap( 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 * subgiagonal 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 SSYCONVF_ROOK
540 *
541  END
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:60
subroutine sswap(N, SX, INCX, SY, INCY)
SSWAP
Definition: sswap.f:82
subroutine ssyconvf_rook(UPLO, WAY, N, A, LDA, E, IPIV, INFO)
SSYCONVF_ROOK