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