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_LARF_HEADER 00036 #define TEMPLATE_LAPACK_LARF_HEADER 00037 00038 00039 template<class Treal> 00040 int template_lapack_larf(const char *side, const integer *m, const integer *n, const Treal *v, 00041 const integer *incv, const Treal *tau, Treal *c__, const integer *ldc, 00042 Treal *work) 00043 { 00044 /* -- LAPACK auxiliary routine (version 3.0) -- 00045 Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., 00046 Courant Institute, Argonne National Lab, and Rice University 00047 February 29, 1992 00048 00049 00050 Purpose 00051 ======= 00052 00053 DLARF applies a real elementary reflector H to a real m by n matrix 00054 C, from either the left or the right. H is represented in the form 00055 00056 H = I - tau * v * v' 00057 00058 where tau is a real scalar and v is a real vector. 00059 00060 If tau = 0, then H is taken to be the unit matrix. 00061 00062 Arguments 00063 ========= 00064 00065 SIDE (input) CHARACTER*1 00066 = 'L': form H * C 00067 = 'R': form C * H 00068 00069 M (input) INTEGER 00070 The number of rows of the matrix C. 00071 00072 N (input) INTEGER 00073 The number of columns of the matrix C. 00074 00075 V (input) DOUBLE PRECISION array, dimension 00076 (1 + (M-1)*abs(INCV)) if SIDE = 'L' 00077 or (1 + (N-1)*abs(INCV)) if SIDE = 'R' 00078 The vector v in the representation of H. V is not used if 00079 TAU = 0. 00080 00081 INCV (input) INTEGER 00082 The increment between elements of v. INCV <> 0. 00083 00084 TAU (input) DOUBLE PRECISION 00085 The value tau in the representation of H. 00086 00087 C (input/output) DOUBLE PRECISION array, dimension (LDC,N) 00088 On entry, the m by n matrix C. 00089 On exit, C is overwritten by the matrix H * C if SIDE = 'L', 00090 or C * H if SIDE = 'R'. 00091 00092 LDC (input) INTEGER 00093 The leading dimension of the array C. LDC >= max(1,M). 00094 00095 WORK (workspace) DOUBLE PRECISION array, dimension 00096 (N) if SIDE = 'L' 00097 or (M) if SIDE = 'R' 00098 00099 ===================================================================== 00100 00101 00102 Parameter adjustments */ 00103 /* Table of constant values */ 00104 Treal c_b4 = 1.; 00105 Treal c_b5 = 0.; 00106 integer c__1 = 1; 00107 00108 /* System generated locals */ 00109 integer c_dim1, c_offset; 00110 Treal d__1; 00111 00112 00113 --v; 00114 c_dim1 = *ldc; 00115 c_offset = 1 + c_dim1 * 1; 00116 c__ -= c_offset; 00117 --work; 00118 00119 /* Function Body */ 00120 if (template_blas_lsame(side, "L")) { 00121 00122 /* Form H * C */ 00123 00124 if (*tau != 0.) { 00125 00126 /* w := C' * v */ 00127 00128 template_blas_gemv("Transpose", m, n, &c_b4, &c__[c_offset], ldc, &v[1], incv, 00129 &c_b5, &work[1], &c__1); 00130 00131 /* C := C - v * w' */ 00132 00133 d__1 = -(*tau); 00134 template_blas_ger(m, n, &d__1, &v[1], incv, &work[1], &c__1, &c__[c_offset], 00135 ldc); 00136 } 00137 } else { 00138 00139 /* Form C * H */ 00140 00141 if (*tau != 0.) { 00142 00143 /* w := C * v */ 00144 00145 template_blas_gemv("No transpose", m, n, &c_b4, &c__[c_offset], ldc, &v[1], 00146 incv, &c_b5, &work[1], &c__1); 00147 00148 /* C := C - w * v' */ 00149 00150 d__1 = -(*tau); 00151 template_blas_ger(m, n, &d__1, &work[1], &c__1, &v[1], incv, &c__[c_offset], 00152 ldc); 00153 } 00154 } 00155 return 0; 00156 00157 /* End of DLARF */ 00158 00159 } /* dlarf_ */ 00160 00161 #endif