001:       SUBROUTINE DLAT2S( UPLO, N, A, LDA, SA, LDSA, INFO )
002: *
003: *  -- LAPACK PROTOTYPE auxiliary routine (version 3.1.2) --
004: *     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
005: *     May 2007
006: *
007: *     .. Scalar Arguments ..
008:       CHARACTER          UPLO
009:       INTEGER            INFO, LDA, LDSA, N
010: *     ..
011: *     .. Array Arguments ..
012:       REAL               SA( LDSA, * )
013:       DOUBLE PRECISION   A( LDA, * )
014: *     ..
015: *
016: *  Purpose
017: *  =======
018: *
019: *  DLAT2S converts a DOUBLE PRECISION triangular matrix, SA, to a SINGLE
020: *  PRECISION triangular matrix, A.
021: *
022: *  RMAX is the overflow for the SINGLE PRECISION arithmetic
023: *  DLAS2S checks that all the entries of A are between -RMAX and
024: *  RMAX. If not the convertion is aborted and a flag is raised.
025: *
026: *  This is an auxiliary routine so there is no argument checking.
027: *
028: *  Arguments
029: *  =========
030: *
031: *  UPLO    (input) CHARACTER*1
032: *          = 'U':  A is upper triangular;
033: *          = 'L':  A is lower triangular.
034: *
035: *  N       (input) INTEGER
036: *          The number of rows and columns of the matrix A.  N >= 0.
037: *
038: *  A       (input) DOUBLE PRECISION array, dimension (LDA,N)
039: *          On entry, the N-by-N triangular coefficient matrix A.
040: *
041: *  LDA     (input) INTEGER
042: *          The leading dimension of the array A.  LDA >= max(1,N).
043: *
044: *  SA      (output) REAL array, dimension (LDSA,N)
045: *          Only the UPLO part of SA is referenced.  On exit, if INFO=0,
046: *          the N-by-N coefficient matrix SA; if INFO>0, the content of
047: *          the UPLO part of SA is unspecified.
048: *
049: *  LDSA    (input) INTEGER
050: *          The leading dimension of the array SA.  LDSA >= max(1,M).
051: *
052: *  INFO    (output) INTEGER
053: *          = 0:  successful exit.
054: *          = 1:  an entry of the matrix A is greater than the SINGLE
055: *                PRECISION overflow threshold, in this case, the content
056: *                of the UPLO part of SA in exit is unspecified.
057: *
058: *  =========
059: *
060: *     .. Local Scalars ..
061:       INTEGER            I, J
062:       DOUBLE PRECISION   RMAX
063:       LOGICAL            UPPER
064: *     ..
065: *     .. External Functions ..
066:       REAL               SLAMCH
067:       LOGICAL            LSAME
068:       EXTERNAL           SLAMCH, LSAME
069: *     ..
070: *     .. Executable Statements ..
071: *
072:       RMAX = SLAMCH( 'O' )
073:       UPPER = LSAME( UPLO, 'U' )
074:       IF( UPPER ) THEN
075:          DO 20 J = 1, N
076:             DO 10 I = 1, J
077:                IF( ( A( I, J ).LT.-RMAX ) .OR. ( A( I, J ).GT.RMAX ) )
078:      +             THEN
079:                   INFO = 1
080:                   GO TO 50
081:                END IF
082:                SA( I, J ) = A( I, J )
083:    10       CONTINUE
084:    20    CONTINUE
085:       ELSE
086:          DO 40 J = 1, N
087:             DO 30 I = J, N
088:                IF( ( A( I, J ).LT.-RMAX ) .OR. ( A( I, J ).GT.RMAX ) )
089:      +             THEN
090:                   INFO = 1
091:                   GO TO 50
092:                END IF
093:                SA( I, J ) = A( I, J )
094:    30       CONTINUE
095:    40    CONTINUE
096:       END IF
097:    50 CONTINUE
098: *
099:       RETURN
100: *
101: *     End of DLAT2S
102: *
103:       END
104: