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