LAPACK 3.12.1
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ ssyconvf_rook()

subroutine ssyconvf_rook ( character uplo,
character way,
integer n,
real, dimension( lda, * ) a,
integer lda,
real, dimension( * ) e,
integer, dimension( * ) ipiv,
integer info )

SSYCONVF_ROOK

Download SSYCONVF_ROOK + dependencies [TGZ] [ZIP] [TXT]

Purpose:
!> If parameter WAY = 'C':
!> SSYCONVF_ROOK converts the factorization output format used in
!> SSYTRF_ROOK provided on entry in parameter A into the factorization
!> output format used in SSYTRF_RK (or SSYTRF_BK) that is stored
!> on exit in parameters A and E. IPIV format for SSYTRF_ROOK and
!> SSYTRF_RK (or SSYTRF_BK) is the same and is not converted.
!>
!> If parameter WAY = 'R':
!> SSYCONVF_ROOK performs the conversion in reverse direction, i.e.
!> converts the factorization output format used in SSYTRF_RK
!> (or SSYTRF_BK) provided on entry in parameters A and E into
!> the factorization output format used in SSYTRF_ROOK that is stored
!> on exit in parameter A. IPIV format for SSYTRF_ROOK and
!> SSYTRF_RK (or SSYTRF_BK) is the same and is not converted.
!>
Parameters
[in]UPLO
!>          UPLO is CHARACTER*1
!>          Specifies whether the details of the factorization are
!>          stored as an upper or lower triangular matrix A.
!>          = 'U':  Upper triangular
!>          = 'L':  Lower triangular
!>
[in]WAY
!>          WAY is CHARACTER*1
!>          = 'C': Convert
!>          = 'R': Revert
!>
[in]N
!>          N is INTEGER
!>          The order of the matrix A.  N >= 0.
!>
[in,out]A
!>          A is REAL array, dimension (LDA,N)
!>
!>          1) If WAY ='C':
!>
!>          On entry, contains factorization details in format used in
!>          SSYTRF_ROOK:
!>            a) all elements of the symmetric block diagonal
!>               matrix D on the diagonal of A and on superdiagonal
!>               (or subdiagonal) of A, and
!>            b) If UPLO = 'U': multipliers used to obtain factor U
!>               in the superdiagonal part of A.
!>               If UPLO = 'L': multipliers used to obtain factor L
!>               in the superdiagonal part of A.
!>
!>          On exit, contains factorization details in format used in
!>          SSYTRF_RK or SSYTRF_BK:
!>            a) ONLY diagonal elements of the symmetric block diagonal
!>               matrix D on the diagonal of A, i.e. D(k,k) = A(k,k);
!>               (superdiagonal (or subdiagonal) elements of D
!>                are stored on exit in array E), and
!>            b) If UPLO = 'U': factor U in the superdiagonal part of A.
!>               If UPLO = 'L': factor L in the subdiagonal part of A.
!>
!>          2) If WAY = 'R':
!>
!>          On entry, contains factorization details in format used in
!>          SSYTRF_RK or SSYTRF_BK:
!>            a) ONLY diagonal elements of the symmetric block diagonal
!>               matrix D on the diagonal of A, i.e. D(k,k) = A(k,k);
!>               (superdiagonal (or subdiagonal) elements of D
!>                are stored on exit in array E), and
!>            b) If UPLO = 'U': factor U in the superdiagonal part of A.
!>               If UPLO = 'L': factor L in the subdiagonal part of A.
!>
!>          On exit, contains factorization details in format used in
!>          SSYTRF_ROOK:
!>            a) all elements of the symmetric block diagonal
!>               matrix D on the diagonal of A and on superdiagonal
!>               (or subdiagonal) of A, and
!>            b) If UPLO = 'U': multipliers used to obtain factor U
!>               in the superdiagonal part of A.
!>               If UPLO = 'L': multipliers used to obtain factor L
!>               in the superdiagonal part of A.
!>
[in]LDA
!>          LDA is INTEGER
!>          The leading dimension of the array A.  LDA >= max(1,N).
!>
[in,out]E
!>          E is REAL array, dimension (N)
!>
!>          1) If WAY ='C':
!>
!>          On entry, just a workspace.
!>
!>          On exit, contains the superdiagonal (or subdiagonal)
!>          elements of the symmetric block diagonal matrix D
!>          with 1-by-1 or 2-by-2 diagonal blocks, where
!>          If UPLO = 'U': E(i) = D(i-1,i), i=2:N, E(1) is set to 0;
!>          If UPLO = 'L': E(i) = D(i+1,i), i=1:N-1, E(N) is set to 0.
!>
!>          2) If WAY = 'R':
!>
!>          On entry, contains the superdiagonal (or subdiagonal)
!>          elements of the symmetric block diagonal matrix D
!>          with 1-by-1 or 2-by-2 diagonal blocks, where
!>          If UPLO = 'U': E(i) = D(i-1,i),i=2:N, E(1) not referenced;
!>          If UPLO = 'L': E(i) = D(i+1,i),i=1:N-1, E(N) not referenced.
!>
!>          On exit, is not changed
!>
[in]IPIV
!>          IPIV is INTEGER array, dimension (N)
!>          On entry, details of the interchanges and the block
!>          structure of D as determined:
!>          1) by SSYTRF_ROOK, if WAY ='C';
!>          2) by SSYTRF_RK (or SSYTRF_BK), if WAY ='R'.
!>          The IPIV format is the same for all these routines.
!>
!>          On exit, is not changed.
!>
[out]INFO
!>          INFO is INTEGER
!>          = 0:  successful exit
!>          < 0:  if INFO = -i, the i-th argument had an illegal value
!>
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Contributors:
!>
!>  November 2017,  Igor Kozachenko,
!>                  Computer Science Division,
!>                  University of California, Berkeley
!>
!>

Definition at line 194 of file ssyconvf_rook.f.

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