001:       SUBROUTINE CLASET( 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:       COMPLEX            ALPHA, BETA
011: *     ..
012: *     .. Array Arguments ..
013:       COMPLEX            A( LDA, * )
014: *     ..
015: *
016: *  Purpose
017: *  =======
018: *
019: *  CLASET initializes a 2-D array 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 lower triangle
028: *                      is unchanged.
029: *          = 'L':      Lower triangular part is set. The upper triangle
030: *                      is unchanged.
031: *          Otherwise:  All of the matrix A is set.
032: *
033: *  M       (input) INTEGER
034: *          On entry, M specifies the number of rows of A.
035: *
036: *  N       (input) INTEGER
037: *          On entry, N specifies the number of columns of A.
038: *
039: *  ALPHA   (input) COMPLEX
040: *          All the offdiagonal array elements are set to ALPHA.
041: *
042: *  BETA    (input) COMPLEX
043: *          All the diagonal array elements are set to BETA.
044: *
045: *  A       (input/output) COMPLEX array, dimension (LDA,N)
046: *          On entry, the m by n matrix A.
047: *          On exit, A(i,j) = ALPHA, 1 <= i <= m, 1 <= j <= n, i.ne.j;
048: *                   A(i,i) = BETA , 1 <= i <= min(m,n)
049: *
050: *  LDA     (input) INTEGER
051: *          The leading dimension of the array A.  LDA >= max(1,M).
052: *
053: *  =====================================================================
054: *
055: *     .. Local Scalars ..
056:       INTEGER            I, J
057: *     ..
058: *     .. External Functions ..
059:       LOGICAL            LSAME
060:       EXTERNAL           LSAME
061: *     ..
062: *     .. Intrinsic Functions ..
063:       INTRINSIC          MIN
064: *     ..
065: *     .. Executable Statements ..
066: *
067:       IF( LSAME( UPLO, 'U' ) ) THEN
068: *
069: *        Set the diagonal to BETA and the strictly upper triangular
070: *        part of the array to ALPHA.
071: *
072:          DO 20 J = 2, N
073:             DO 10 I = 1, MIN( J-1, M )
074:                A( I, J ) = ALPHA
075:    10       CONTINUE
076:    20    CONTINUE
077:          DO 30 I = 1, MIN( N, M )
078:             A( I, I ) = BETA
079:    30    CONTINUE
080: *
081:       ELSE IF( LSAME( UPLO, 'L' ) ) THEN
082: *
083: *        Set the diagonal to BETA and the strictly lower triangular
084: *        part of the array to ALPHA.
085: *
086:          DO 50 J = 1, MIN( M, N )
087:             DO 40 I = J + 1, M
088:                A( I, J ) = ALPHA
089:    40       CONTINUE
090:    50    CONTINUE
091:          DO 60 I = 1, MIN( N, M )
092:             A( I, I ) = BETA
093:    60    CONTINUE
094: *
095:       ELSE
096: *
097: *        Set the array to BETA on the diagonal and ALPHA on the
098: *        offdiagonal.
099: *
100:          DO 80 J = 1, N
101:             DO 70 I = 1, M
102:                A( I, J ) = ALPHA
103:    70       CONTINUE
104:    80    CONTINUE
105:          DO 90 I = 1, MIN( M, N )
106:             A( I, I ) = BETA
107:    90    CONTINUE
108:       END IF
109: *
110:       RETURN
111: *
112: *     End of CLASET
113: *
114:       END
115: