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_DOT_HEADER 00036 #define TEMPLATE_BLAS_DOT_HEADER 00037 00038 #include "template_blas_common.h" 00039 00040 template<class Treal> 00041 Treal template_blas_dot(const integer *n, const Treal *dx, const integer *incx, const Treal *dy, 00042 const integer *incy) 00043 { 00044 /* System generated locals */ 00045 integer i__1; 00046 Treal ret_val; 00047 /* Local variables */ 00048 integer i__, m; 00049 Treal dtemp; 00050 integer ix, iy, mp1; 00051 /* forms the dot product of two vectors. 00052 uses unrolled loops for increments equal to one. 00053 jack dongarra, linpack, 3/11/78. 00054 modified 12/3/93, array(1) declarations changed to array(*) 00055 Parameter adjustments */ 00056 --dy; 00057 --dx; 00058 /* Function Body */ 00059 ret_val = 0.; 00060 dtemp = 0.; 00061 if (*n <= 0) { 00062 return ret_val; 00063 } 00064 if (*incx == 1 && *incy == 1) { 00065 goto L20; 00066 } 00067 /* code for unequal increments or equal increments 00068 not equal to 1 */ 00069 ix = 1; 00070 iy = 1; 00071 if (*incx < 0) { 00072 ix = (-(*n) + 1) * *incx + 1; 00073 } 00074 if (*incy < 0) { 00075 iy = (-(*n) + 1) * *incy + 1; 00076 } 00077 i__1 = *n; 00078 for (i__ = 1; i__ <= i__1; ++i__) { 00079 dtemp += dx[ix] * dy[iy]; 00080 ix += *incx; 00081 iy += *incy; 00082 /* L10: */ 00083 } 00084 ret_val = dtemp; 00085 return ret_val; 00086 /* code for both increments equal to 1 00087 clean-up loop */ 00088 L20: 00089 m = *n % 5; 00090 if (m == 0) { 00091 goto L40; 00092 } 00093 i__1 = m; 00094 for (i__ = 1; i__ <= i__1; ++i__) { 00095 dtemp += dx[i__] * dy[i__]; 00096 /* L30: */ 00097 } 00098 if (*n < 5) { 00099 goto L60; 00100 } 00101 L40: 00102 mp1 = m + 1; 00103 i__1 = *n; 00104 for (i__ = mp1; i__ <= i__1; i__ += 5) { 00105 dtemp = dtemp + dx[i__] * dy[i__] + dx[i__ + 1] * dy[i__ + 1] + dx[ 00106 i__ + 2] * dy[i__ + 2] + dx[i__ + 3] * dy[i__ + 3] + dx[i__ + 00107 4] * dy[i__ + 4]; 00108 /* L50: */ 00109 } 00110 L60: 00111 ret_val = dtemp; 00112 return ret_val; 00113 } /* ddot_ */ 00114 00115 #endif