ergo
template_lapack_ggbak.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_GGBAK_HEADER
38#define TEMPLATE_LAPACK_GGBAK_HEADER
39
40
41template<class Treal>
42int template_lapack_ggbak(const char *job, const char *side, const integer *n, const integer *ilo,
43 const integer *ihi, const Treal *lscale, const Treal *rscale, const integer *m,
44 Treal *v, const integer *ldv, integer *info)
45{
46/* -- LAPACK routine (version 3.0) --
47 Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
48 Courant Institute, Argonne National Lab, and Rice University
49 September 30, 1994
50
51
52 Purpose
53 =======
54
55 DGGBAK forms the right or left eigenvectors of a real generalized
56 eigenvalue problem A*x = lambda*B*x, by backward transformation on
57 the computed eigenvectors of the balanced pair of matrices output by
58 DGGBAL.
59
60 Arguments
61 =========
62
63 JOB (input) CHARACTER*1
64 Specifies the type of backward transformation required:
65 = 'N': do nothing, return immediately;
66 = 'P': do backward transformation for permutation only;
67 = 'S': do backward transformation for scaling only;
68 = 'B': do backward transformations for both permutation and
69 scaling.
70 JOB must be the same as the argument JOB supplied to DGGBAL.
71
72 SIDE (input) CHARACTER*1
73 = 'R': V contains right eigenvectors;
74 = 'L': V contains left eigenvectors.
75
76 N (input) INTEGER
77 The number of rows of the matrix V. N >= 0.
78
79 ILO (input) INTEGER
80 IHI (input) INTEGER
81 The integers ILO and IHI determined by DGGBAL.
82 1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.
83
84 LSCALE (input) DOUBLE PRECISION array, dimension (N)
85 Details of the permutations and/or scaling factors applied
86 to the left side of A and B, as returned by DGGBAL.
87
88 RSCALE (input) DOUBLE PRECISION array, dimension (N)
89 Details of the permutations and/or scaling factors applied
90 to the right side of A and B, as returned by DGGBAL.
91
92 M (input) INTEGER
93 The number of columns of the matrix V. M >= 0.
94
95 V (input/output) DOUBLE PRECISION array, dimension (LDV,M)
96 On entry, the matrix of right or left eigenvectors to be
97 transformed, as returned by DTGEVC.
98 On exit, V is overwritten by the transformed eigenvectors.
99
100 LDV (input) INTEGER
101 The leading dimension of the matrix V. LDV >= max(1,N).
102
103 INFO (output) INTEGER
104 = 0: successful exit.
105 < 0: if INFO = -i, the i-th argument had an illegal value.
106
107 Further Details
108 ===============
109
110 See R.C. Ward, Balancing the generalized eigenvalue problem,
111 SIAM J. Sci. Stat. Comp. 2 (1981), 141-152.
112
113 =====================================================================
114
115
116 Test the input parameters
117
118 Parameter adjustments */
119 /* System generated locals */
120 integer v_dim1, v_offset, i__1;
121 /* Local variables */
122 integer i__, k;
123 logical leftv;
124 logical rightv;
125#define v_ref(a_1,a_2) v[(a_2)*v_dim1 + a_1]
126
127 --lscale;
128 --rscale;
129 v_dim1 = *ldv;
130 v_offset = 1 + v_dim1 * 1;
131 v -= v_offset;
132
133 /* Function Body */
134 rightv = template_blas_lsame(side, "R");
135 leftv = template_blas_lsame(side, "L");
136
137 *info = 0;
138 if (! template_blas_lsame(job, "N") && ! template_blas_lsame(job, "P") && ! template_blas_lsame(job, "S")
139 && ! template_blas_lsame(job, "B")) {
140 *info = -1;
141 } else if (! rightv && ! leftv) {
142 *info = -2;
143 } else if (*n < 0) {
144 *info = -3;
145 } else if (*ilo < 1) {
146 *info = -4;
147 } else if (*ihi < *ilo || *ihi > maxMACRO(1,*n)) {
148 *info = -5;
149 } else if (*m < 0) {
150 *info = -6;
151 } else if (*ldv < maxMACRO(1,*n)) {
152 *info = -10;
153 }
154 if (*info != 0) {
155 i__1 = -(*info);
156 template_blas_erbla("GGBAK ", &i__1);
157 return 0;
158 }
159
160/* Quick return if possible */
161
162 if (*n == 0) {
163 return 0;
164 }
165 if (*m == 0) {
166 return 0;
167 }
168 if (template_blas_lsame(job, "N")) {
169 return 0;
170 }
171
172 if (*ilo == *ihi) {
173 goto L30;
174 }
175
176/* Backward balance */
177
178 if (template_blas_lsame(job, "S") || template_blas_lsame(job, "B")) {
179
180/* Backward transformation on right eigenvectors */
181
182 if (rightv) {
183 i__1 = *ihi;
184 for (i__ = *ilo; i__ <= i__1; ++i__) {
185 template_blas_scal(m, &rscale[i__], &v_ref(i__, 1), ldv);
186/* L10: */
187 }
188 }
189
190/* Backward transformation on left eigenvectors */
191
192 if (leftv) {
193 i__1 = *ihi;
194 for (i__ = *ilo; i__ <= i__1; ++i__) {
195 template_blas_scal(m, &lscale[i__], &v_ref(i__, 1), ldv);
196/* L20: */
197 }
198 }
199 }
200
201/* Backward permutation */
202
203L30:
204 if (template_blas_lsame(job, "P") || template_blas_lsame(job, "B")) {
205
206/* Backward permutation on right eigenvectors */
207
208 if (rightv) {
209 if (*ilo == 1) {
210 goto L50;
211 }
212
213 for (i__ = *ilo - 1; i__ >= 1; --i__) {
214 k = (integer) rscale[i__];
215 if (k == i__) {
216 goto L40;
217 }
218 template_blas_swap(m, &v_ref(i__, 1), ldv, &v_ref(k, 1), ldv);
219L40:
220 ;
221 }
222
223L50:
224 if (*ihi == *n) {
225 goto L70;
226 }
227 i__1 = *n;
228 for (i__ = *ihi + 1; i__ <= i__1; ++i__) {
229 k = (integer) rscale[i__];
230 if (k == i__) {
231 goto L60;
232 }
233 template_blas_swap(m, &v_ref(i__, 1), ldv, &v_ref(k, 1), ldv);
234L60:
235 ;
236 }
237 }
238
239/* Backward permutation on left eigenvectors */
240
241L70:
242 if (leftv) {
243 if (*ilo == 1) {
244 goto L90;
245 }
246 for (i__ = *ilo - 1; i__ >= 1; --i__) {
247 k = (integer) lscale[i__];
248 if (k == i__) {
249 goto L80;
250 }
251 template_blas_swap(m, &v_ref(i__, 1), ldv, &v_ref(k, 1), ldv);
252L80:
253 ;
254 }
255
256L90:
257 if (*ihi == *n) {
258 goto L110;
259 }
260 i__1 = *n;
261 for (i__ = *ihi + 1; i__ <= i__1; ++i__) {
262 k = (integer) lscale[i__];
263 if (k == i__) {
264 goto L100;
265 }
266 template_blas_swap(m, &v_ref(i__, 1), ldv, &v_ref(k, 1), ldv);
267L100:
268 ;
269 }
270 }
271 }
272
273L110:
274
275 return 0;
276
277/* End of DGGBAK */
278
279} /* dggbak_ */
280
281#undef v_ref
282
283
284#endif
int template_blas_erbla(const char *srname, integer *info)
Definition: template_blas_common.cc:146
logical template_blas_lsame(const char *ca, const char *cb)
Definition: template_blas_common.cc:46
int integer
Definition: template_blas_common.h:40
#define maxMACRO(a, b)
Definition: template_blas_common.h:45
bool logical
Definition: template_blas_common.h:41
int template_blas_scal(const integer *n, const Treal *da, Treal *dx, const integer *incx)
Definition: template_blas_scal.h:43
int template_blas_swap(const integer *n, Treal *dx, const integer *incx, Treal *dy, const integer *incy)
Definition: template_blas_swap.h:42
int template_lapack_ggbak(const char *job, const char *side, const integer *n, const integer *ilo, const integer *ihi, const Treal *lscale, const Treal *rscale, const integer *m, Treal *v, const integer *ldv, integer *info)
Definition: template_lapack_ggbak.h:42
#define v_ref(a_1, a_2)