LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
claset.f
Go to the documentation of this file.
1*> \brief \b CLASET 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 CLASET + dependencies
10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/claset.f">
11*> [TGZ]</a>
12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/claset.f">
13*> [ZIP]</a>
14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/claset.f">
15*> [TXT]</a>
16*> \endhtmlonly
17*
18* Definition:
19* ===========
20*
21* SUBROUTINE CLASET( UPLO, M, N, ALPHA, BETA, A, LDA )
22*
23* .. Scalar Arguments ..
24* CHARACTER UPLO
25* INTEGER LDA, M, N
26* COMPLEX ALPHA, BETA
27* ..
28* .. Array Arguments ..
29* COMPLEX A( LDA, * )
30* ..
31*
32*
33*> \par Purpose:
34* =============
35*>
36*> \verbatim
37*>
38*> CLASET 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
71*> All the offdiagonal array elements are set to ALPHA.
72*> \endverbatim
73*>
74*> \param[in] BETA
75*> \verbatim
76*> BETA is COMPLEX
77*> All the diagonal array elements are set to BETA.
78*> \endverbatim
79*>
80*> \param[out] A
81*> \verbatim
82*> A is COMPLEX 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*> \ingroup laset
103*
104* =====================================================================
105 SUBROUTINE claset( UPLO, M, N, ALPHA, BETA, A, LDA )
106*
107* -- LAPACK auxiliary routine --
108* -- LAPACK is a software package provided by Univ. of Tennessee, --
109* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
110*
111* .. Scalar Arguments ..
112 CHARACTER UPLO
113 INTEGER LDA, M, N
114 COMPLEX ALPHA, BETA
115* ..
116* .. Array Arguments ..
117 COMPLEX A( LDA, * )
118* ..
119*
120* =====================================================================
121*
122* .. Local Scalars ..
123 INTEGER I, J
124* ..
125* .. External Functions ..
126 LOGICAL LSAME
127 EXTERNAL lsame
128* ..
129* .. Intrinsic Functions ..
130 INTRINSIC min
131* ..
132* .. Executable Statements ..
133*
134 IF( lsame( uplo, 'U' ) ) THEN
135*
136* Set the diagonal to BETA and the strictly upper triangular
137* part of the array to ALPHA.
138*
139 DO 20 j = 2, n
140 DO 10 i = 1, min( j-1, m )
141 a( i, j ) = alpha
142 10 CONTINUE
143 20 CONTINUE
144 DO 30 i = 1, min( n, m )
145 a( i, i ) = beta
146 30 CONTINUE
147*
148 ELSE IF( lsame( uplo, 'L' ) ) THEN
149*
150* Set the diagonal to BETA and the strictly lower triangular
151* part of the array to ALPHA.
152*
153 DO 50 j = 1, min( m, n )
154 DO 40 i = j + 1, m
155 a( i, j ) = alpha
156 40 CONTINUE
157 50 CONTINUE
158 DO 60 i = 1, min( n, m )
159 a( i, i ) = beta
160 60 CONTINUE
161*
162 ELSE
163*
164* Set the array to BETA on the diagonal and ALPHA on the
165* offdiagonal.
166*
167 DO 80 j = 1, n
168 DO 70 i = 1, m
169 a( i, j ) = alpha
170 70 CONTINUE
171 80 CONTINUE
172 DO 90 i = 1, min( m, n )
173 a( i, i ) = beta
174 90 CONTINUE
175 END IF
176*
177 RETURN
178*
179* End of CLASET
180*
181 END
subroutine claset(uplo, m, n, alpha, beta, a, lda)
CLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values.
Definition claset.f:106