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