OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
ssyconvf.f File Reference

Go to the source code of this file.

Functions/Subroutines

subroutine ssyconvf (uplo, way, n, a, lda, e, ipiv, info)
 SSYCONVF

Function/Subroutine Documentation

◆ ssyconvf()

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

SSYCONVF

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

Purpose:
!> If parameter WAY = 'C':
!> SSYCONVF converts the factorization output format used in
!> SSYTRF 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. It also converts in place details of
!> the intechanges stored in IPIV from the format used in SSYTRF into
!> the format used in SSYTRF_RK (or SSYTRF_BK).
!>
!> If parameter WAY = 'R':
!> SSYCONVF 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 that is stored
!> on exit in parameter A. It also converts in place details of
!> the intechanges stored in IPIV from the format used in SSYTRF_RK
!> (or SSYTRF_BK) into the format used in SSYTRF.
!>
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:
!>            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:
!>            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,out]IPIV
!>          IPIV is INTEGER array, dimension (N)
!>
!>          1) If WAY ='C':
!>          On entry, details of the interchanges and the block
!>          structure of D in the format used in SSYTRF.
!>          On exit, details of the interchanges and the block
!>          structure of D in the format used in SSYTRF_RK
!>          ( or SSYTRF_BK).
!>
!>          1) If WAY ='R':
!>          On entry, details of the interchanges and the block
!>          structure of D in the format used in SSYTRF_RK
!>          ( or SSYTRF_BK).
!>          On exit, details of the interchanges and the block
!>          structure of D in the format used in SSYTRF.
!>
[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 205 of file ssyconvf.f.

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 interchnge 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 interchnge 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* subgiagonal 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*
xerbla
subroutine xerbla(srname, info)
XERBLA
Definition xerbla.f:60
lsame
logical function lsame(ca, cb)
LSAME
Definition lsame.f:53
sswap
subroutine sswap(n, sx, incx, sy, incy)
SSWAP
Definition sswap.f:82
max
#define max(a, b)
Definition macros.h:21