LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
dlaset.f
Go to the documentation of this file.
1*> \brief \b DLASET 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 DLASET + dependencies
10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlaset.f">
11*> [TGZ]</a>
12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlaset.f">
13*> [ZIP]</a>
14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlaset.f">
15*> [TXT]</a>
16*> \endhtmlonly
17*
18* Definition:
19* ===========
20*
21* SUBROUTINE DLASET( UPLO, M, N, ALPHA, BETA, A, LDA )
22*
23* .. Scalar Arguments ..
24* CHARACTER UPLO
25* INTEGER LDA, M, N
26* DOUBLE PRECISION ALPHA, BETA
27* ..
28* .. Array Arguments ..
29* DOUBLE PRECISION A( LDA, * )
30* ..
31*
32*
33*> \par Purpose:
34* =============
35*>
36*> \verbatim
37*>
38*> DLASET initializes an m-by-n matrix 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 strictly lower
50*> triangular part of A is not changed.
51*> = 'L': Lower triangular part is set; the strictly upper
52*> triangular part of A is not changed.
53*> Otherwise: All of the matrix A is set.
54*> \endverbatim
55*>
56*> \param[in] M
57*> \verbatim
58*> M is INTEGER
59*> The number of rows of the matrix A. M >= 0.
60*> \endverbatim
61*>
62*> \param[in] N
63*> \verbatim
64*> N is INTEGER
65*> The number of columns of the matrix A. N >= 0.
66*> \endverbatim
67*>
68*> \param[in] ALPHA
69*> \verbatim
70*> ALPHA is DOUBLE PRECISION
71*> The constant to which the offdiagonal elements are to be set.
72*> \endverbatim
73*>
74*> \param[in] BETA
75*> \verbatim
76*> BETA is DOUBLE PRECISION
77*> The constant to which the diagonal elements are to be set.
78*> \endverbatim
79*>
80*> \param[out] A
81*> \verbatim
82*> A is DOUBLE PRECISION array, dimension (LDA,N)
83*> On exit, the leading m-by-n submatrix of A is set as follows:
84*>
85*> if UPLO = 'U', A(i,j) = ALPHA, 1<=i<=j-1, 1<=j<=n,
86*> if UPLO = 'L', A(i,j) = ALPHA, j+1<=i<=m, 1<=j<=n,
87*> otherwise, A(i,j) = ALPHA, 1<=i<=m, 1<=j<=n, i.ne.j,
88*>
89*> and, for all UPLO, A(i,i) = BETA, 1<=i<=min(m,n).
90*> \endverbatim
91*>
92*> \param[in] LDA
93*> \verbatim
94*> LDA is INTEGER
95*> The leading dimension of the array A. LDA >= max(1,M).
96*> \endverbatim
97*
98* Authors:
99* ========
100*
101*> \author Univ. of Tennessee
102*> \author Univ. of California Berkeley
103*> \author Univ. of Colorado Denver
104*> \author NAG Ltd.
105*
106*> \ingroup laset
107*
108* =====================================================================
109 SUBROUTINE dlaset( UPLO, M, N, ALPHA, BETA, A, LDA )
110*
111* -- LAPACK auxiliary routine --
112* -- LAPACK is a software package provided by Univ. of Tennessee, --
113* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
114*
115* .. Scalar Arguments ..
116 CHARACTER UPLO
117 INTEGER LDA, M, N
118 DOUBLE PRECISION ALPHA, BETA
119* ..
120* .. Array Arguments ..
121 DOUBLE PRECISION A( LDA, * )
122* ..
123*
124* =====================================================================
125*
126* .. Local Scalars ..
127 INTEGER I, J
128* ..
129* .. External Functions ..
130 LOGICAL LSAME
131 EXTERNAL lsame
132* ..
133* .. Intrinsic Functions ..
134 INTRINSIC min
135* ..
136* .. Executable Statements ..
137*
138 IF( lsame( uplo, 'U' ) ) THEN
139*
140* Set the strictly upper triangular or trapezoidal part of the
141* array to ALPHA.
142*
143 DO 20 j = 2, n
144 DO 10 i = 1, min( j-1, m )
145 a( i, j ) = alpha
146 10 CONTINUE
147 20 CONTINUE
148*
149 ELSE IF( lsame( uplo, 'L' ) ) THEN
150*
151* Set the strictly lower triangular or trapezoidal part of the
152* array to ALPHA.
153*
154 DO 40 j = 1, min( m, n )
155 DO 30 i = j + 1, m
156 a( i, j ) = alpha
157 30 CONTINUE
158 40 CONTINUE
159*
160 ELSE
161*
162* Set the leading m-by-n submatrix to ALPHA.
163*
164 DO 60 j = 1, n
165 DO 50 i = 1, m
166 a( i, j ) = alpha
167 50 CONTINUE
168 60 CONTINUE
169 END IF
170*
171* Set the first min(M,N) diagonal elements to BETA.
172*
173 DO 70 i = 1, min( m, n )
174 a( i, i ) = beta
175 70 CONTINUE
176*
177 RETURN
178*
179* End of DLASET
180*
181 END
subroutine dlaset(uplo, m, n, alpha, beta, a, lda)
DLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values.
Definition dlaset.f:110