ergo
template_lapack_laswp.h
Go to the documentation of this file.
1 /* Ergo, version 3.4, a program for linear scaling electronic structure
2  * calculations.
3  * Copyright (C) 2014 Elias Rudberg, Emanuel H. Rubensson, and Pawel Salek.
4  *
5  * This program is free software: you can redistribute it and/or modify
6  * it under the terms of the GNU General Public License as published by
7  * the Free Software Foundation, either version 3 of the License, or
8  * (at your option) any later version.
9  *
10  * This program is distributed in the hope that it will be useful,
11  * but WITHOUT ANY WARRANTY; without even the implied warranty of
12  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13  * GNU General Public License for more details.
14  *
15  * You should have received a copy of the GNU General Public License
16  * along with this program. If not, see <http://www.gnu.org/licenses/>.
17  *
18  * Primary academic reference:
19  * Kohn−Sham Density Functional Theory Electronic Structure Calculations
20  * with Linearly Scaling Computational Time and Memory Usage,
21  * Elias Rudberg, Emanuel H. Rubensson, and Pawel Salek,
22  * J. Chem. Theory Comput. 7, 340 (2011),
23  * <http://dx.doi.org/10.1021/ct100611z>
24  *
25  * For further information about Ergo, see <http://www.ergoscf.org>.
26  */
27 
28  /* This file belongs to the template_lapack part of the Ergo source
29  * code. The source files in the template_lapack directory are modified
30  * versions of files originally distributed as CLAPACK, see the
31  * Copyright/license notice in the file template_lapack/COPYING.
32  */
33 
34 
35 #ifndef TEMPLATE_LAPACK_LASWP_HEADER
36 #define TEMPLATE_LAPACK_LASWP_HEADER
37 
38 
39 template<class Treal>
40 int template_lapack_laswp(const integer *n, Treal *a, const integer *lda, const integer
41  *k1, const integer *k2, const integer *ipiv, const integer *incx)
42 {
43 /* -- LAPACK auxiliary routine (version 3.0) --
44  Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
45  Courant Institute, Argonne National Lab, and Rice University
46  June 30, 1999
47 
48 
49  Purpose
50  =======
51 
52  DLASWP performs a series of row interchanges on the matrix A.
53  One row interchange is initiated for each of rows K1 through K2 of A.
54 
55  Arguments
56  =========
57 
58  N (input) INTEGER
59  The number of columns of the matrix A.
60 
61  A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
62  On entry, the matrix of column dimension N to which the row
63  interchanges will be applied.
64  On exit, the permuted matrix.
65 
66  LDA (input) INTEGER
67  The leading dimension of the array A.
68 
69  K1 (input) INTEGER
70  The first element of IPIV for which a row interchange will
71  be done.
72 
73  K2 (input) INTEGER
74  The last element of IPIV for which a row interchange will
75  be done.
76 
77  IPIV (input) INTEGER array, dimension (M*abs(INCX))
78  The vector of pivot indices. Only the elements in positions
79  K1 through K2 of IPIV are accessed.
80  IPIV(K) = L implies rows K and L are to be interchanged.
81 
82  INCX (input) INTEGER
83  The increment between successive values of IPIV. If IPIV
84  is negative, the pivots are applied in reverse order.
85 
86  Further Details
87  ===============
88 
89  Modified by
90  R. C. Whaley, Computer Science Dept., Univ. of Tenn., Knoxville, USA
91 
92  =====================================================================
93 
94 
95  Interchange row I with row IPIV(I) for each of rows K1 through K2.
96 
97  Parameter adjustments */
98  /* System generated locals */
99  integer a_dim1, a_offset, i__1, i__2, i__3, i__4;
100  /* Local variables */
101  Treal temp;
102  integer i__, j, k, i1, i2, n32, ip, ix, ix0, inc;
103 #define a_ref(a_1,a_2) a[(a_2)*a_dim1 + a_1]
104 
105  a_dim1 = *lda;
106  a_offset = 1 + a_dim1 * 1;
107  a -= a_offset;
108  --ipiv;
109 
110  /* Function Body */
111  if (*incx > 0) {
112  ix0 = *k1;
113  i1 = *k1;
114  i2 = *k2;
115  inc = 1;
116  } else if (*incx < 0) {
117  ix0 = (1 - *k2) * *incx + 1;
118  i1 = *k2;
119  i2 = *k1;
120  inc = -1;
121  } else {
122  return 0;
123  }
124 
125  n32 = *n / 32 << 5;
126  if (n32 != 0) {
127  i__1 = n32;
128  for (j = 1; j <= i__1; j += 32) {
129  ix = ix0;
130  i__2 = i2;
131  i__3 = inc;
132  for (i__ = i1; i__3 < 0 ? i__ >= i__2 : i__ <= i__2; i__ += i__3)
133  {
134  ip = ipiv[ix];
135  if (ip != i__) {
136  i__4 = j + 31;
137  for (k = j; k <= i__4; ++k) {
138  temp = a_ref(i__, k);
139  a_ref(i__, k) = a_ref(ip, k);
140  a_ref(ip, k) = temp;
141 /* L10: */
142  }
143  }
144  ix += *incx;
145 /* L20: */
146  }
147 /* L30: */
148  }
149  }
150  if (n32 != *n) {
151  ++n32;
152  ix = ix0;
153  i__1 = i2;
154  i__3 = inc;
155  for (i__ = i1; i__3 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__3) {
156  ip = ipiv[ix];
157  if (ip != i__) {
158  i__2 = *n;
159  for (k = n32; k <= i__2; ++k) {
160  temp = a_ref(i__, k);
161  a_ref(i__, k) = a_ref(ip, k);
162  a_ref(ip, k) = temp;
163 /* L40: */
164  }
165  }
166  ix += *incx;
167 /* L50: */
168  }
169  }
170 
171  return 0;
172 
173 /* End of DLASWP */
174 
175 } /* dlaswp_ */
176 
177 #undef a_ref
178 
179 
180 #endif
int integer
Definition: template_blas_common.h:38
int template_lapack_laswp(const integer *n, Treal *a, const integer *lda, const integer *k1, const integer *k2, const integer *ipiv, const integer *incx)
Definition: template_lapack_laswp.h:40
#define a_ref(a_1, a_2)