00001 /* Ergo, version 3.7, a program for linear scaling electronic structure 00002 * calculations. 00003 * Copyright (C) 2018 Elias Rudberg, Emanuel H. Rubensson, Pawel Salek, 00004 * and Anastasia Kruchinina. 00005 * 00006 * This program is free software: you can redistribute it and/or modify 00007 * it under the terms of the GNU General Public License as published by 00008 * the Free Software Foundation, either version 3 of the License, or 00009 * (at your option) any later version. 00010 * 00011 * This program is distributed in the hope that it will be useful, 00012 * but WITHOUT ANY WARRANTY; without even the implied warranty of 00013 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 00014 * GNU General Public License for more details. 00015 * 00016 * You should have received a copy of the GNU General Public License 00017 * along with this program. If not, see <http://www.gnu.org/licenses/>. 00018 * 00019 * Primary academic reference: 00020 * Ergo: An open-source program for linear-scaling electronic structure 00021 * calculations, 00022 * Elias Rudberg, Emanuel H. Rubensson, Pawel Salek, and Anastasia 00023 * Kruchinina, 00024 * SoftwareX 7, 107 (2018), 00025 * <http://dx.doi.org/10.1016/j.softx.2018.03.005> 00026 * 00027 * For further information about Ergo, see <http://www.ergoscf.org>. 00028 */ 00029 00030 /* This file belongs to the template_lapack part of the Ergo source 00031 * code. The source files in the template_lapack directory are modified 00032 * versions of files originally distributed as CLAPACK, see the 00033 * Copyright/license notice in the file template_lapack/COPYING. 00034 */ 00035 00036 00037 #ifndef TEMPLATE_LAPACK_LASET_HEADER 00038 #define TEMPLATE_LAPACK_LASET_HEADER 00039 00040 00041 template<class Treal> 00042 int template_lapack_laset(const char *uplo, const integer *m, const integer *n, const Treal * 00043 alpha, const Treal *beta, Treal *a, const integer *lda) 00044 { 00045 /* -- LAPACK auxiliary routine (version 3.0) -- 00046 Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., 00047 Courant Institute, Argonne National Lab, and Rice University 00048 October 31, 1992 00049 00050 00051 Purpose 00052 ======= 00053 00054 DLASET initializes an m-by-n matrix A to BETA on the diagonal and 00055 ALPHA on the offdiagonals. 00056 00057 Arguments 00058 ========= 00059 00060 UPLO (input) CHARACTER*1 00061 Specifies the part of the matrix A to be set. 00062 = 'U': Upper triangular part is set; the strictly lower 00063 triangular part of A is not changed. 00064 = 'L': Lower triangular part is set; the strictly upper 00065 triangular part of A is not changed. 00066 Otherwise: All of the matrix A is set. 00067 00068 M (input) INTEGER 00069 The number of rows of the matrix A. M >= 0. 00070 00071 N (input) INTEGER 00072 The number of columns of the matrix A. N >= 0. 00073 00074 ALPHA (input) DOUBLE PRECISION 00075 The constant to which the offdiagonal elements are to be set. 00076 00077 BETA (input) DOUBLE PRECISION 00078 The constant to which the diagonal elements are to be set. 00079 00080 A (input/output) DOUBLE PRECISION array, dimension (LDA,N) 00081 On exit, the leading m-by-n submatrix of A is set as follows: 00082 00083 if UPLO = 'U', A(i,j) = ALPHA, 1<=i<=j-1, 1<=j<=n, 00084 if UPLO = 'L', A(i,j) = ALPHA, j+1<=i<=m, 1<=j<=n, 00085 otherwise, A(i,j) = ALPHA, 1<=i<=m, 1<=j<=n, i.ne.j, 00086 00087 and, for all UPLO, A(i,i) = BETA, 1<=i<=min(m,n). 00088 00089 LDA (input) INTEGER 00090 The leading dimension of the array A. LDA >= max(1,M). 00091 00092 ===================================================================== 00093 00094 00095 Parameter adjustments */ 00096 /* System generated locals */ 00097 integer a_dim1, a_offset, i__1, i__2, i__3; 00098 /* Local variables */ 00099 integer i__, j; 00100 #define a_ref(a_1,a_2) a[(a_2)*a_dim1 + a_1] 00101 00102 a_dim1 = *lda; 00103 a_offset = 1 + a_dim1 * 1; 00104 a -= a_offset; 00105 00106 /* Function Body */ 00107 if (template_blas_lsame(uplo, "U")) { 00108 00109 /* Set the strictly upper triangular or trapezoidal part of the 00110 array to ALPHA. */ 00111 00112 i__1 = *n; 00113 for (j = 2; j <= i__1; ++j) { 00114 /* Computing MIN */ 00115 i__3 = j - 1; 00116 i__2 = minMACRO(i__3,*m); 00117 for (i__ = 1; i__ <= i__2; ++i__) { 00118 a_ref(i__, j) = *alpha; 00119 /* L10: */ 00120 } 00121 /* L20: */ 00122 } 00123 00124 } else if (template_blas_lsame(uplo, "L")) { 00125 00126 /* Set the strictly lower triangular or trapezoidal part of the 00127 array to ALPHA. */ 00128 00129 i__1 = minMACRO(*m,*n); 00130 for (j = 1; j <= i__1; ++j) { 00131 i__2 = *m; 00132 for (i__ = j + 1; i__ <= i__2; ++i__) { 00133 a_ref(i__, j) = *alpha; 00134 /* L30: */ 00135 } 00136 /* L40: */ 00137 } 00138 00139 } else { 00140 00141 /* Set the leading m-by-n submatrix to ALPHA. */ 00142 00143 i__1 = *n; 00144 for (j = 1; j <= i__1; ++j) { 00145 i__2 = *m; 00146 for (i__ = 1; i__ <= i__2; ++i__) { 00147 a_ref(i__, j) = *alpha; 00148 /* L50: */ 00149 } 00150 /* L60: */ 00151 } 00152 } 00153 00154 /* Set the first min(M,N) diagonal elements to BETA. */ 00155 00156 i__1 = minMACRO(*m,*n); 00157 for (i__ = 1; i__ <= i__1; ++i__) { 00158 a_ref(i__, i__) = *beta; 00159 /* L70: */ 00160 } 00161 00162 return 0; 00163 00164 /* End of DLASET */ 00165 00166 } /* dlaset_ */ 00167 00168 #undef a_ref 00169 00170 00171 #endif