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_BLAS_GER_HEADER 00036 #define TEMPLATE_BLAS_GER_HEADER 00037 00038 00039 template<class Treal> 00040 int template_blas_ger(const integer *m, const integer *n, const Treal *alpha, 00041 const Treal *x, const integer *incx, const Treal *y, const integer *incy, 00042 Treal *a, const integer *lda) 00043 { 00044 /* System generated locals */ 00045 integer a_dim1, a_offset, i__1, i__2; 00046 /* Local variables */ 00047 integer info; 00048 Treal temp; 00049 integer i__, j, ix, jy, kx; 00050 #define a_ref(a_1,a_2) a[(a_2)*a_dim1 + a_1] 00051 /* Purpose 00052 ======= 00053 DGER performs the rank 1 operation 00054 A := alpha*x*y' + A, 00055 where alpha is a scalar, x is an m element vector, y is an n element 00056 vector and A is an m by n matrix. 00057 Parameters 00058 ========== 00059 M - INTEGER. 00060 On entry, M specifies the number of rows of the matrix A. 00061 M must be at least zero. 00062 Unchanged on exit. 00063 N - INTEGER. 00064 On entry, N specifies the number of columns of the matrix A. 00065 N must be at least zero. 00066 Unchanged on exit. 00067 ALPHA - DOUBLE PRECISION. 00068 On entry, ALPHA specifies the scalar alpha. 00069 Unchanged on exit. 00070 X - DOUBLE PRECISION array of dimension at least 00071 ( 1 + ( m - 1 )*abs( INCX ) ). 00072 Before entry, the incremented array X must contain the m 00073 element vector x. 00074 Unchanged on exit. 00075 INCX - INTEGER. 00076 On entry, INCX specifies the increment for the elements of 00077 X. INCX must not be zero. 00078 Unchanged on exit. 00079 Y - DOUBLE PRECISION array of dimension at least 00080 ( 1 + ( n - 1 )*abs( INCY ) ). 00081 Before entry, the incremented array Y must contain the n 00082 element vector y. 00083 Unchanged on exit. 00084 INCY - INTEGER. 00085 On entry, INCY specifies the increment for the elements of 00086 Y. INCY must not be zero. 00087 Unchanged on exit. 00088 A - DOUBLE PRECISION array of DIMENSION ( LDA, n ). 00089 Before entry, the leading m by n part of the array A must 00090 contain the matrix of coefficients. On exit, A is 00091 overwritten by the updated matrix. 00092 LDA - INTEGER. 00093 On entry, LDA specifies the first dimension of A as declared 00094 in the calling (sub) program. LDA must be at least 00095 max( 1, m ). 00096 Unchanged on exit. 00097 Level 2 Blas routine. 00098 -- Written on 22-October-1986. 00099 Jack Dongarra, Argonne National Lab. 00100 Jeremy Du Croz, Nag Central Office. 00101 Sven Hammarling, Nag Central Office. 00102 Richard Hanson, Sandia National Labs. 00103 Test the input parameters. 00104 Parameter adjustments */ 00105 --x; 00106 --y; 00107 a_dim1 = *lda; 00108 a_offset = 1 + a_dim1 * 1; 00109 a -= a_offset; 00110 /* Function Body */ 00111 info = 0; 00112 if (*m < 0) { 00113 info = 1; 00114 } else if (*n < 0) { 00115 info = 2; 00116 } else if (*incx == 0) { 00117 info = 5; 00118 } else if (*incy == 0) { 00119 info = 7; 00120 } else if (*lda < maxMACRO(1,*m)) { 00121 info = 9; 00122 } 00123 if (info != 0) { 00124 template_blas_erbla("GER ", &info); 00125 return 0; 00126 } 00127 /* Quick return if possible. */ 00128 if (*m == 0 || *n == 0 || *alpha == 0.) { 00129 return 0; 00130 } 00131 /* Start the operations. In this version the elements of A are 00132 accessed sequentially with one pass through A. */ 00133 if (*incy > 0) { 00134 jy = 1; 00135 } else { 00136 jy = 1 - (*n - 1) * *incy; 00137 } 00138 if (*incx == 1) { 00139 i__1 = *n; 00140 for (j = 1; j <= i__1; ++j) { 00141 if (y[jy] != 0.) { 00142 temp = *alpha * y[jy]; 00143 i__2 = *m; 00144 for (i__ = 1; i__ <= i__2; ++i__) { 00145 a_ref(i__, j) = a_ref(i__, j) + x[i__] * temp; 00146 /* L10: */ 00147 } 00148 } 00149 jy += *incy; 00150 /* L20: */ 00151 } 00152 } else { 00153 if (*incx > 0) { 00154 kx = 1; 00155 } else { 00156 kx = 1 - (*m - 1) * *incx; 00157 } 00158 i__1 = *n; 00159 for (j = 1; j <= i__1; ++j) { 00160 if (y[jy] != 0.) { 00161 temp = *alpha * y[jy]; 00162 ix = kx; 00163 i__2 = *m; 00164 for (i__ = 1; i__ <= i__2; ++i__) { 00165 a_ref(i__, j) = a_ref(i__, j) + x[ix] * temp; 00166 ix += *incx; 00167 /* L30: */ 00168 } 00169 } 00170 jy += *incy; 00171 /* L40: */ 00172 } 00173 } 00174 return 0; 00175 /* End of DGER . */ 00176 } /* dger_ */ 00177 #undef a_ref 00178 00179 #endif