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