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_LASWP_HEADER 00036 #define TEMPLATE_LAPACK_LASWP_HEADER 00037 00038 00039 template<class Treal> 00040 int template_lapack_laswp(const integer *n, Treal *a, const integer *lda, const integer 00041 *k1, const integer *k2, const integer *ipiv, const integer *incx) 00042 { 00043 /* -- LAPACK auxiliary routine (version 3.0) -- 00044 Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., 00045 Courant Institute, Argonne National Lab, and Rice University 00046 June 30, 1999 00047 00048 00049 Purpose 00050 ======= 00051 00052 DLASWP performs a series of row interchanges on the matrix A. 00053 One row interchange is initiated for each of rows K1 through K2 of A. 00054 00055 Arguments 00056 ========= 00057 00058 N (input) INTEGER 00059 The number of columns of the matrix A. 00060 00061 A (input/output) DOUBLE PRECISION array, dimension (LDA,N) 00062 On entry, the matrix of column dimension N to which the row 00063 interchanges will be applied. 00064 On exit, the permuted matrix. 00065 00066 LDA (input) INTEGER 00067 The leading dimension of the array A. 00068 00069 K1 (input) INTEGER 00070 The first element of IPIV for which a row interchange will 00071 be done. 00072 00073 K2 (input) INTEGER 00074 The last element of IPIV for which a row interchange will 00075 be done. 00076 00077 IPIV (input) INTEGER array, dimension (M*abs(INCX)) 00078 The vector of pivot indices. Only the elements in positions 00079 K1 through K2 of IPIV are accessed. 00080 IPIV(K) = L implies rows K and L are to be interchanged. 00081 00082 INCX (input) INTEGER 00083 The increment between successive values of IPIV. If IPIV 00084 is negative, the pivots are applied in reverse order. 00085 00086 Further Details 00087 =============== 00088 00089 Modified by 00090 R. C. Whaley, Computer Science Dept., Univ. of Tenn., Knoxville, USA 00091 00092 ===================================================================== 00093 00094 00095 Interchange row I with row IPIV(I) for each of rows K1 through K2. 00096 00097 Parameter adjustments */ 00098 /* System generated locals */ 00099 integer a_dim1, a_offset, i__1, i__2, i__3, i__4; 00100 /* Local variables */ 00101 Treal temp; 00102 integer i__, j, k, i1, i2, n32, ip, ix, ix0, inc; 00103 #define a_ref(a_1,a_2) a[(a_2)*a_dim1 + a_1] 00104 00105 a_dim1 = *lda; 00106 a_offset = 1 + a_dim1 * 1; 00107 a -= a_offset; 00108 --ipiv; 00109 00110 /* Function Body */ 00111 if (*incx > 0) { 00112 ix0 = *k1; 00113 i1 = *k1; 00114 i2 = *k2; 00115 inc = 1; 00116 } else if (*incx < 0) { 00117 ix0 = (1 - *k2) * *incx + 1; 00118 i1 = *k2; 00119 i2 = *k1; 00120 inc = -1; 00121 } else { 00122 return 0; 00123 } 00124 00125 n32 = *n / 32 << 5; 00126 if (n32 != 0) { 00127 i__1 = n32; 00128 for (j = 1; j <= i__1; j += 32) { 00129 ix = ix0; 00130 i__2 = i2; 00131 i__3 = inc; 00132 for (i__ = i1; i__3 < 0 ? i__ >= i__2 : i__ <= i__2; i__ += i__3) 00133 { 00134 ip = ipiv[ix]; 00135 if (ip != i__) { 00136 i__4 = j + 31; 00137 for (k = j; k <= i__4; ++k) { 00138 temp = a_ref(i__, k); 00139 a_ref(i__, k) = a_ref(ip, k); 00140 a_ref(ip, k) = temp; 00141 /* L10: */ 00142 } 00143 } 00144 ix += *incx; 00145 /* L20: */ 00146 } 00147 /* L30: */ 00148 } 00149 } 00150 if (n32 != *n) { 00151 ++n32; 00152 ix = ix0; 00153 i__1 = i2; 00154 i__3 = inc; 00155 for (i__ = i1; i__3 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__3) { 00156 ip = ipiv[ix]; 00157 if (ip != i__) { 00158 i__2 = *n; 00159 for (k = n32; k <= i__2; ++k) { 00160 temp = a_ref(i__, k); 00161 a_ref(i__, k) = a_ref(ip, k); 00162 a_ref(ip, k) = temp; 00163 /* L40: */ 00164 } 00165 } 00166 ix += *incx; 00167 /* L50: */ 00168 } 00169 } 00170 00171 return 0; 00172 00173 /* End of DLASWP */ 00174 00175 } /* dlaswp_ */ 00176 00177 #undef a_ref 00178 00179 00180 #endif