001:       SUBROUTINE SLASET( UPLO, M, N, ALPHA, BETA, A, LDA )
002: *
003: *  -- LAPACK auxiliary routine (version 3.2) --
004: *     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
005: *     November 2006
006: *
007: *     .. Scalar Arguments ..
008:       CHARACTER          UPLO
009:       INTEGER            LDA, M, N
010:       REAL               ALPHA, BETA
011: *     ..
012: *     .. Array Arguments ..
013:       REAL               A( LDA, * )
014: *     ..
015: *
016: *  Purpose
017: *  =======
018: *
019: *  SLASET initializes an m-by-n matrix A to BETA on the diagonal and
020: *  ALPHA on the offdiagonals.
021: *
022: *  Arguments
023: *  =========
024: *
025: *  UPLO    (input) CHARACTER*1
026: *          Specifies the part of the matrix A to be set.
027: *          = 'U':      Upper triangular part is set; the strictly lower
028: *                      triangular part of A is not changed.
029: *          = 'L':      Lower triangular part is set; the strictly upper
030: *                      triangular part of A is not changed.
031: *          Otherwise:  All of the matrix A is set.
032: *
033: *  M       (input) INTEGER
034: *          The number of rows of the matrix A.  M >= 0.
035: *
036: *  N       (input) INTEGER
037: *          The number of columns of the matrix A.  N >= 0.
038: *
039: *  ALPHA   (input) REAL
040: *          The constant to which the offdiagonal elements are to be set.
041: *
042: *  BETA    (input) REAL
043: *          The constant to which the diagonal elements are to be set.
044: *
045: *  A       (input/output) REAL array, dimension (LDA,N)
046: *          On exit, the leading m-by-n submatrix of A is set as follows:
047: *
048: *          if UPLO = 'U', A(i,j) = ALPHA, 1<=i<=j-1, 1<=j<=n,
049: *          if UPLO = 'L', A(i,j) = ALPHA, j+1<=i<=m, 1<=j<=n,
050: *          otherwise,     A(i,j) = ALPHA, 1<=i<=m, 1<=j<=n, i.ne.j,
051: *
052: *          and, for all UPLO, A(i,i) = BETA, 1<=i<=min(m,n).
053: *
054: *  LDA     (input) INTEGER
055: *          The leading dimension of the array A.  LDA >= max(1,M).
056: *
057: * =====================================================================
058: *
059: *     .. Local Scalars ..
060:       INTEGER            I, J
061: *     ..
062: *     .. External Functions ..
063:       LOGICAL            LSAME
064:       EXTERNAL           LSAME
065: *     ..
066: *     .. Intrinsic Functions ..
067:       INTRINSIC          MIN
068: *     ..
069: *     .. Executable Statements ..
070: *
071:       IF( LSAME( UPLO, 'U' ) ) THEN
072: *
073: *        Set the strictly upper triangular or trapezoidal part of the
074: *        array to ALPHA.
075: *
076:          DO 20 J = 2, N
077:             DO 10 I = 1, MIN( J-1, M )
078:                A( I, J ) = ALPHA
079:    10       CONTINUE
080:    20    CONTINUE
081: *
082:       ELSE IF( LSAME( UPLO, 'L' ) ) THEN
083: *
084: *        Set the strictly lower triangular or trapezoidal part of the
085: *        array to ALPHA.
086: *
087:          DO 40 J = 1, MIN( M, N )
088:             DO 30 I = J + 1, M
089:                A( I, J ) = ALPHA
090:    30       CONTINUE
091:    40    CONTINUE
092: *
093:       ELSE
094: *
095: *        Set the leading m-by-n submatrix to ALPHA.
096: *
097:          DO 60 J = 1, N
098:             DO 50 I = 1, M
099:                A( I, J ) = ALPHA
100:    50       CONTINUE
101:    60    CONTINUE
102:       END IF
103: *
104: *     Set the first min(M,N) diagonal elements to BETA.
105: *
106:       DO 70 I = 1, MIN( M, N )
107:          A( I, I ) = BETA
108:    70 CONTINUE
109: *
110:       RETURN
111: *
112: *     End of SLASET
113: *
114:       END
115: