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