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