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