1*> \brief \b ZLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values.
2*
3*  =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6*            http://www.netlib.org/lapack/explore-html/
7*
8*> \htmlonly
9*> Download ZLASET + dependencies
10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zlaset.f">
11*> [TGZ]</a>
12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zlaset.f">
13*> [ZIP]</a>
14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zlaset.f">
15*> [TXT]</a>
16*> \endhtmlonly
17*
18*  Definition:
19*  ===========
20*
21*       SUBROUTINE ZLASET( UPLO, M, N, ALPHA, BETA, A, LDA )
22*
23*       .. Scalar Arguments ..
24*       CHARACTER          UPLO
25*       INTEGER            LDA, M, N
26*       COMPLEX*16         ALPHA, BETA
27*       ..
28*       .. Array Arguments ..
29*       COMPLEX*16         A( LDA, * )
30*       ..
31*
32*
33*> \par Purpose:
34*  =============
35*>
36*> \verbatim
37*>
38*> ZLASET initializes a 2-D array A to BETA on the diagonal and
39*> ALPHA on the offdiagonals.
40*> \endverbatim
41*
42*  Arguments:
43*  ==========
44*
45*> \param[in] UPLO
46*> \verbatim
47*>          UPLO is CHARACTER*1
48*>          Specifies the part of the matrix A to be set.
49*>          = 'U':      Upper triangular part is set. The lower triangle
50*>                      is unchanged.
51*>          = 'L':      Lower triangular part is set. The upper triangle
52*>                      is unchanged.
53*>          Otherwise:  All of the matrix A is set.
54*> \endverbatim
55*>
56*> \param[in] M
57*> \verbatim
58*>          M is INTEGER
59*>          On entry, M specifies the number of rows of A.
60*> \endverbatim
61*>
62*> \param[in] N
63*> \verbatim
64*>          N is INTEGER
65*>          On entry, N specifies the number of columns of A.
66*> \endverbatim
67*>
68*> \param[in] ALPHA
69*> \verbatim
70*>          ALPHA is COMPLEX*16
71*>          All the offdiagonal array elements are set to ALPHA.
72*> \endverbatim
73*>
74*> \param[in] BETA
75*> \verbatim
76*>          BETA is COMPLEX*16
77*>          All the diagonal array elements are set to BETA.
78*> \endverbatim
79*>
80*> \param[out] A
81*> \verbatim
82*>          A is COMPLEX*16 array, dimension (LDA,N)
83*>          On entry, the m by n matrix A.
84*>          On exit, A(i,j) = ALPHA, 1 <= i <= m, 1 <= j <= n, i.ne.j;
85*>                   A(i,i) = BETA , 1 <= i <= min(m,n)
86*> \endverbatim
87*>
88*> \param[in] LDA
89*> \verbatim
90*>          LDA is INTEGER
91*>          The leading dimension of the array A.  LDA >= max(1,M).
92*> \endverbatim
93*
94*  Authors:
95*  ========
96*
97*> \author Univ. of Tennessee
98*> \author Univ. of California Berkeley
99*> \author Univ. of Colorado Denver
100*> \author NAG Ltd.
101*
102*> \date December 2016
103*
104*> \ingroup complex16OTHERauxiliary
105*
106*  =====================================================================
107      SUBROUTINE ZLASET( UPLO, M, N, ALPHA, BETA, A, LDA )
108*
109*  -- LAPACK auxiliary routine (version 3.7.0) --
110*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
111*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
112*     December 2016
113*
114*     .. Scalar Arguments ..
115      CHARACTER          UPLO
116      INTEGER            LDA, M, N
117      COMPLEX*16         ALPHA, BETA
118*     ..
119*     .. Array Arguments ..
120      COMPLEX*16         A( LDA, * )
121*     ..
122*
123*  =====================================================================
124*
125*     .. Local Scalars ..
126      INTEGER            I, J
127*     ..
128*     .. External Functions ..
129      LOGICAL            LSAME
130      EXTERNAL           LSAME
131*     ..
132*     .. Intrinsic Functions ..
133      INTRINSIC          MIN
134*     ..
135*     .. Executable Statements ..
136*
137      IF( LSAME( UPLO, 'U' ) ) THEN
138*
139*        Set the diagonal to BETA and the strictly upper triangular
140*        part of the array to ALPHA.
141*
142         DO 20 J = 2, N
143            DO 10 I = 1, MIN( J-1, M )
144               A( I, J ) = ALPHA
145   10       CONTINUE
146   20    CONTINUE
147         DO 30 I = 1, MIN( N, M )
148            A( I, I ) = BETA
149   30    CONTINUE
150*
151      ELSE IF( LSAME( UPLO, 'L' ) ) THEN
152*
153*        Set the diagonal to BETA and the strictly lower triangular
154*        part of the array to ALPHA.
155*
156         DO 50 J = 1, MIN( M, N )
157            DO 40 I = J + 1, M
158               A( I, J ) = ALPHA
159   40       CONTINUE
160   50    CONTINUE
161         DO 60 I = 1, MIN( N, M )
162            A( I, I ) = BETA
163   60    CONTINUE
164*
165      ELSE
166*
167*        Set the array to BETA on the diagonal and ALPHA on the
168*        offdiagonal.
169*
170         DO 80 J = 1, N
171            DO 70 I = 1, M
172               A( I, J ) = ALPHA
173   70       CONTINUE
174   80    CONTINUE
175         DO 90 I = 1, MIN( M, N )
176            A( I, I ) = BETA
177   90    CONTINUE
178      END IF
179*
180      RETURN
181*
182*     End of ZLASET
183*
184      END
185