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