ergo
template_lapack_laset.h
Go to the documentation of this file.
1/* Ergo, version 3.8.2, a program for linear scaling electronic structure
2 * calculations.
3 * Copyright (C) 2023 Elias Rudberg, Emanuel H. Rubensson, Pawel Salek,
4 * and Anastasia Kruchinina.
5 *
6 * This program is free software: you can redistribute it and/or modify
7 * it under the terms of the GNU General Public License as published by
8 * the Free Software Foundation, either version 3 of the License, or
9 * (at your option) any later version.
10 *
11 * This program is distributed in the hope that it will be useful,
12 * but WITHOUT ANY WARRANTY; without even the implied warranty of
13 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 * GNU General Public License for more details.
15 *
16 * You should have received a copy of the GNU General Public License
17 * along with this program. If not, see <http://www.gnu.org/licenses/>.
18 *
19 * Primary academic reference:
20 * Ergo: An open-source program for linear-scaling electronic structure
21 * calculations,
22 * Elias Rudberg, Emanuel H. Rubensson, Pawel Salek, and Anastasia
23 * Kruchinina,
24 * SoftwareX 7, 107 (2018),
25 * <http://dx.doi.org/10.1016/j.softx.2018.03.005>
26 *
27 * For further information about Ergo, see <http://www.ergoscf.org>.
28 */
29
30 /* This file belongs to the template_lapack part of the Ergo source
31 * code. The source files in the template_lapack directory are modified
32 * versions of files originally distributed as CLAPACK, see the
33 * Copyright/license notice in the file template_lapack/COPYING.
34 */
35
36
37#ifndef TEMPLATE_LAPACK_LASET_HEADER
38#define TEMPLATE_LAPACK_LASET_HEADER
39
40
41template<class Treal>
42int template_lapack_laset(const char *uplo, const integer *m, const integer *n, const Treal *
43 alpha, const Treal *beta, Treal *a, const integer *lda)
44{
45/* -- LAPACK auxiliary routine (version 3.0) --
46 Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
47 Courant Institute, Argonne National Lab, and Rice University
48 October 31, 1992
49
50
51 Purpose
52 =======
53
54 DLASET initializes an m-by-n matrix A to BETA on the diagonal and
55 ALPHA on the offdiagonals.
56
57 Arguments
58 =========
59
60 UPLO (input) CHARACTER*1
61 Specifies the part of the matrix A to be set.
62 = 'U': Upper triangular part is set; the strictly lower
63 triangular part of A is not changed.
64 = 'L': Lower triangular part is set; the strictly upper
65 triangular part of A is not changed.
66 Otherwise: All of the matrix A is set.
67
68 M (input) INTEGER
69 The number of rows of the matrix A. M >= 0.
70
71 N (input) INTEGER
72 The number of columns of the matrix A. N >= 0.
73
74 ALPHA (input) DOUBLE PRECISION
75 The constant to which the offdiagonal elements are to be set.
76
77 BETA (input) DOUBLE PRECISION
78 The constant to which the diagonal elements are to be set.
79
80 A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
81 On exit, the leading m-by-n submatrix of A is set as follows:
82
83 if UPLO = 'U', A(i,j) = ALPHA, 1<=i<=j-1, 1<=j<=n,
84 if UPLO = 'L', A(i,j) = ALPHA, j+1<=i<=m, 1<=j<=n,
85 otherwise, A(i,j) = ALPHA, 1<=i<=m, 1<=j<=n, i.ne.j,
86
87 and, for all UPLO, A(i,i) = BETA, 1<=i<=min(m,n).
88
89 LDA (input) INTEGER
90 The leading dimension of the array A. LDA >= max(1,M).
91
92 =====================================================================
93
94
95 Parameter adjustments */
96 /* System generated locals */
97 integer a_dim1, a_offset, i__1, i__2, i__3;
98 /* Local variables */
99 integer i__, j;
100#define a_ref(a_1,a_2) a[(a_2)*a_dim1 + a_1]
101
102 a_dim1 = *lda;
103 a_offset = 1 + a_dim1 * 1;
104 a -= a_offset;
105
106 /* Function Body */
107 if (template_blas_lsame(uplo, "U")) {
108
109/* Set the strictly upper triangular or trapezoidal part of the
110 array to ALPHA. */
111
112 i__1 = *n;
113 for (j = 2; j <= i__1; ++j) {
114/* Computing MIN */
115 i__3 = j - 1;
116 i__2 = minMACRO(i__3,*m);
117 for (i__ = 1; i__ <= i__2; ++i__) {
118 a_ref(i__, j) = *alpha;
119/* L10: */
120 }
121/* L20: */
122 }
123
124 } else if (template_blas_lsame(uplo, "L")) {
125
126/* Set the strictly lower triangular or trapezoidal part of the
127 array to ALPHA. */
128
129 i__1 = minMACRO(*m,*n);
130 for (j = 1; j <= i__1; ++j) {
131 i__2 = *m;
132 for (i__ = j + 1; i__ <= i__2; ++i__) {
133 a_ref(i__, j) = *alpha;
134/* L30: */
135 }
136/* L40: */
137 }
138
139 } else {
140
141/* Set the leading m-by-n submatrix to ALPHA. */
142
143 i__1 = *n;
144 for (j = 1; j <= i__1; ++j) {
145 i__2 = *m;
146 for (i__ = 1; i__ <= i__2; ++i__) {
147 a_ref(i__, j) = *alpha;
148/* L50: */
149 }
150/* L60: */
151 }
152 }
153
154/* Set the first min(M,N) diagonal elements to BETA. */
155
156 i__1 = minMACRO(*m,*n);
157 for (i__ = 1; i__ <= i__1; ++i__) {
158 a_ref(i__, i__) = *beta;
159/* L70: */
160 }
161
162 return 0;
163
164/* End of DLASET */
165
166} /* dlaset_ */
167
168#undef a_ref
169
170
171#endif
logical template_blas_lsame(const char *ca, const char *cb)
Definition template_blas_common.cc:46
int integer
Definition template_blas_common.h:40
#define minMACRO(a, b)
Definition template_blas_common.h:46
#define a_ref(a_1, a_2)
int template_lapack_laset(const char *uplo, const integer *m, const integer *n, const Treal *alpha, const Treal *beta, Treal *a, const integer *lda)
Definition template_lapack_laset.h:42