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