Annotation of rpl/lapack/lapack/dlat2s.f, revision 1.1
1.1 ! bertrand 1: SUBROUTINE DLAT2S( UPLO, N, A, LDA, SA, LDSA, INFO )
! 2: *
! 3: * -- LAPACK PROTOTYPE auxiliary routine (version 3.1.2) --
! 4: * -- LAPACK is a software package provided by Univ. of Tennessee, --
! 5: * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
! 6: * May 2007
! 7: *
! 8: * .. Scalar Arguments ..
! 9: CHARACTER UPLO
! 10: INTEGER INFO, LDA, LDSA, N
! 11: * ..
! 12: * .. Array Arguments ..
! 13: REAL SA( LDSA, * )
! 14: DOUBLE PRECISION A( LDA, * )
! 15: * ..
! 16: *
! 17: * Purpose
! 18: * =======
! 19: *
! 20: * DLAT2S converts a DOUBLE PRECISION triangular matrix, SA, to a SINGLE
! 21: * PRECISION triangular matrix, A.
! 22: *
! 23: * RMAX is the overflow for the SINGLE PRECISION arithmetic
! 24: * DLAS2S checks that all the entries of A are between -RMAX and
! 25: * RMAX. If not the convertion is aborted and a flag is raised.
! 26: *
! 27: * This is an auxiliary routine so there is no argument checking.
! 28: *
! 29: * Arguments
! 30: * =========
! 31: *
! 32: * UPLO (input) CHARACTER*1
! 33: * = 'U': A is upper triangular;
! 34: * = 'L': A is lower triangular.
! 35: *
! 36: * N (input) INTEGER
! 37: * The number of rows and columns of the matrix A. N >= 0.
! 38: *
! 39: * A (input) DOUBLE PRECISION array, dimension (LDA,N)
! 40: * On entry, the N-by-N triangular coefficient matrix A.
! 41: *
! 42: * LDA (input) INTEGER
! 43: * The leading dimension of the array A. LDA >= max(1,N).
! 44: *
! 45: * SA (output) REAL array, dimension (LDSA,N)
! 46: * Only the UPLO part of SA is referenced. On exit, if INFO=0,
! 47: * the N-by-N coefficient matrix SA; if INFO>0, the content of
! 48: * the UPLO part of SA is unspecified.
! 49: *
! 50: * LDSA (input) INTEGER
! 51: * The leading dimension of the array SA. LDSA >= max(1,M).
! 52: *
! 53: * INFO (output) INTEGER
! 54: * = 0: successful exit.
! 55: * = 1: an entry of the matrix A is greater than the SINGLE
! 56: * PRECISION overflow threshold, in this case, the content
! 57: * of the UPLO part of SA in exit is unspecified.
! 58: *
! 59: * =========
! 60: *
! 61: * .. Local Scalars ..
! 62: INTEGER I, J
! 63: DOUBLE PRECISION RMAX
! 64: LOGICAL UPPER
! 65: * ..
! 66: * .. External Functions ..
! 67: REAL SLAMCH
! 68: LOGICAL LSAME
! 69: EXTERNAL SLAMCH, LSAME
! 70: * ..
! 71: * .. Executable Statements ..
! 72: *
! 73: RMAX = SLAMCH( 'O' )
! 74: UPPER = LSAME( UPLO, 'U' )
! 75: IF( UPPER ) THEN
! 76: DO 20 J = 1, N
! 77: DO 10 I = 1, J
! 78: IF( ( A( I, J ).LT.-RMAX ) .OR. ( A( I, J ).GT.RMAX ) )
! 79: + THEN
! 80: INFO = 1
! 81: GO TO 50
! 82: END IF
! 83: SA( I, J ) = A( I, J )
! 84: 10 CONTINUE
! 85: 20 CONTINUE
! 86: ELSE
! 87: DO 40 J = 1, N
! 88: DO 30 I = J, N
! 89: IF( ( A( I, J ).LT.-RMAX ) .OR. ( A( I, J ).GT.RMAX ) )
! 90: + THEN
! 91: INFO = 1
! 92: GO TO 50
! 93: END IF
! 94: SA( I, J ) = A( I, J )
! 95: 30 CONTINUE
! 96: 40 CONTINUE
! 97: END IF
! 98: 50 CONTINUE
! 99: *
! 100: RETURN
! 101: *
! 102: * End of DLAT2S
! 103: *
! 104: END
CVSweb interface <joel.bertrand@systella.fr>