ergo
template_lapack_laset.h
Go to the documentation of this file.
1 /* Ergo, version 3.8, a program for linear scaling electronic structure
2  * calculations.
3  * Copyright (C) 2019 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 
41 template<class Treal>
42 int 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
minMACRO
#define minMACRO(a, b)
Definition: template_blas_common.h:46
template_lapack_laset
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
template_blas_lsame
logical template_blas_lsame(const char *ca, const char *cb)
Definition: template_blas_common.cc:46
integer
int integer
Definition: template_blas_common.h:40
a_ref
#define a_ref(a_1, a_2)