ergo
template_lapack_laswp.h
Go to the documentation of this file.
1/* Ergo, version 3.8.2, a program for linear scaling electronic structure
2 * calculations.
3 * Copyright (C) 2023 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
41template<class Treal>
42int 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)