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