Line data Source code
1 : /* +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
2 : These files are semi-automatic translations by f2c from the original netlib LAPACK library.
3 : The source has been modified to (mostly) use modern C formatting, and to get rid of
4 : compiler warnings. Any errors in doing this should be blamed on the GROMACS developers, and
5 : not the reference LAPACK implementation.
6 :
7 : The reference LAPACK implementation is available from http://www.netlib.org/lapack
8 :
9 : LAPACK does not come with a formal named "license", but a general statement saying:
10 :
11 : "The reference LAPACK is a freely-available software package. It is available from netlib
12 : via anonymous ftp and the World Wide Web. Thus, it can be included in commercial software
13 : packages (and has been). We only ask that proper credit be given to the authors."
14 :
15 : While the rest of GROMACS is LGPL, we think it's only fair to give you the same rights to
16 : our modified LAPACK files as the original netlib versions, so do what you want with them.
17 :
18 : However, be warned that we have only tested that they to the right thing in the cases used
19 : in GROMACS (primarily full & sparse matrix diagonalization), so in most cases it is a much
20 : better idea to use the full reference implementation.
21 :
22 : Erik Lindahl, 2008-10-07.
23 : +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
24 : #if ! defined(__PLUMED_HAS_EXTERNAL_LAPACK)
25 : #include <cctype>
26 : #include <cmath>
27 : #include "blas/blas.h"
28 : #include "lapack.h"
29 : #include "lapack_limits.h"
30 :
31 : #include "real.h"
32 :
33 : #include "blas/blas.h"
34 : namespace PLMD{
35 : namespace lapack{
36 : using namespace blas;
37 : void
38 96 : PLUMED_BLAS_F77_FUNC(dbdsdc,DBDSDC)(const char *uplo,
39 : const char *compq,
40 : int *n,
41 : double *d__,
42 : double *e,
43 : double *u,
44 : int *ldu,
45 : double *vt,
46 : int *ldvt,
47 : double *q,
48 : int *iq,
49 : double *work,
50 : int *iwork,
51 : int *info)
52 : {
53 : int u_dim1, u_offset, vt_dim1, vt_offset, i__1, i__2;
54 : int i__, j, k;
55 : double p, r__;
56 : int z__, ic, ii, kk;
57 : double cs;
58 : int is, iu;
59 : double sn;
60 : int nm1;
61 : double eps;
62 : int ivt, difl, difr, ierr, perm, mlvl, sqre;
63 : int poles, iuplo, nsize, start;
64 : int givcol;
65 : int icompq;
66 : double orgnrm;
67 : int givnum, givptr, qstart, smlsiz, wstart, smlszp;
68 96 : double zero = 0.0;
69 96 : double one = 1.0;
70 96 : int c_0 = 0;
71 96 : int c_1 = 1;
72 :
73 96 : --d__;
74 96 : --e;
75 96 : u_dim1 = *ldu;
76 96 : u_offset = 1 + u_dim1;
77 96 : u -= u_offset;
78 96 : vt_dim1 = *ldvt;
79 96 : vt_offset = 1 + vt_dim1;
80 96 : vt -= vt_offset;
81 96 : --q;
82 96 : --iq;
83 96 : --work;
84 : --iwork;
85 :
86 : k = iu = z__ = ic = is = ivt = difl = difr = perm = 0;
87 : poles = givnum = givptr = givcol = 0;
88 :
89 96 : smlsiz = DBDSDC_SMALLSIZE;
90 96 : *info = 0;
91 :
92 96 : iuplo = (*uplo=='U' || *uplo=='u') ? 1 : 2;
93 :
94 96 : switch(*compq) {
95 0 : case 'n':
96 : case 'N':
97 0 : icompq = 0;
98 0 : break;
99 0 : case 'p':
100 : case 'P':
101 0 : icompq = 1;
102 0 : break;
103 96 : case 'i':
104 : case 'I':
105 96 : icompq = 2;
106 96 : break;
107 : default:
108 : return;
109 : }
110 :
111 96 : if (*n <= 0)
112 : return;
113 :
114 96 : if (*n == 1) {
115 0 : if (icompq == 1) {
116 0 : q[1] = (d__[1]>0) ? 1.0 : -1.0;
117 0 : q[smlsiz * *n + 1] = 1.;
118 0 : } else if (icompq == 2) {
119 0 : u[u_dim1 + 1] = (d__[1]>0) ? 1.0 : -1.0;
120 0 : vt[vt_dim1 + 1] = 1.;
121 : }
122 0 : d__[1] = std::abs(d__[1]);
123 0 : return;
124 : }
125 96 : nm1 = *n - 1;
126 : wstart = 1;
127 : qstart = 3;
128 96 : if (icompq == 1) {
129 0 : PLUMED_BLAS_F77_FUNC(dcopy,DCOPY)(n, &d__[1], &c_1, &q[1], &c_1);
130 0 : i__1 = *n - 1;
131 0 : PLUMED_BLAS_F77_FUNC(dcopy,DCOPY)(&i__1, &e[1], &c_1, &q[*n + 1], &c_1);
132 : }
133 96 : if (iuplo == 2) {
134 : qstart = 5;
135 0 : wstart = (*n << 1) - 1;
136 0 : i__1 = *n - 1;
137 0 : for (i__ = 1; i__ <= i__1; ++i__) {
138 0 : PLUMED_BLAS_F77_FUNC(dlartg,DLARTG)(&d__[i__], &e[i__], &cs, &sn, &r__);
139 0 : d__[i__] = r__;
140 0 : e[i__] = sn * d__[i__ + 1];
141 0 : d__[i__ + 1] = cs * d__[i__ + 1];
142 0 : if (icompq == 1) {
143 0 : q[i__ + (*n << 1)] = cs;
144 0 : q[i__ + *n * 3] = sn;
145 0 : } else if (icompq == 2) {
146 0 : work[i__] = cs;
147 0 : work[nm1 + i__] = -sn;
148 : }
149 : }
150 : }
151 96 : if (icompq == 0) {
152 0 : PLUMED_BLAS_F77_FUNC(dlasdq,DLASDQ)("U",&c_0,n,&c_0,&c_0,&c_0,&d__[1],&e[1],&vt[vt_offset],ldvt,
153 0 : &u[u_offset], ldu, &u[u_offset], ldu, &work[wstart], info);
154 0 : goto L40;
155 : }
156 96 : if (*n <= smlsiz) {
157 67 : if (icompq == 2) {
158 67 : PLUMED_BLAS_F77_FUNC(dlaset,DLASET)("A", n, n, &zero, &one, &u[u_offset], ldu);
159 67 : PLUMED_BLAS_F77_FUNC(dlaset,DLASET)("A", n, n, &zero, &one, &vt[vt_offset], ldvt);
160 67 : PLUMED_BLAS_F77_FUNC(dlasdq,DLASDQ)("U",&c_0,n,n,n,&c_0,&d__[1],&e[1],&vt[vt_offset],ldvt,
161 67 : &u[u_offset],ldu,&u[u_offset],ldu,&work[wstart],info);
162 0 : } else if (icompq == 1) {
163 : iu = 1;
164 0 : ivt = iu + *n;
165 0 : PLUMED_BLAS_F77_FUNC(dlaset,DLASET)("A", n, n, &zero, &one, &q[iu + (qstart - 1) * *n], n);
166 0 : PLUMED_BLAS_F77_FUNC(dlaset,DLASET)("A", n, n, &zero, &one, &q[ivt + (qstart - 1) * *n], n);
167 0 : PLUMED_BLAS_F77_FUNC(dlasdq,DLASDQ)("U", &c_0, n, n, n, &c_0, &d__[1], &e[1],
168 0 : &q[ivt + (qstart - 1) * *n], n, &q[iu + (qstart - 1) * *n],
169 0 : n, &q[iu + (qstart - 1) * *n], n, &work[wstart], info);
170 : }
171 67 : goto L40;
172 : }
173 :
174 29 : if (icompq == 2) {
175 29 : PLUMED_BLAS_F77_FUNC(dlaset,DLASET)("A", n, n, &zero, &one, &u[u_offset], ldu);
176 29 : PLUMED_BLAS_F77_FUNC(dlaset,DLASET)("A", n, n, &zero, &one, &vt[vt_offset], ldvt);
177 : }
178 :
179 29 : orgnrm = PLUMED_BLAS_F77_FUNC(dlanst,DLANST)("M", n, &d__[1], &e[1]);
180 29 : if ( std::abs(orgnrm)<PLUMED_GMX_DOUBLE_MIN) {
181 : return;
182 : }
183 29 : PLUMED_BLAS_F77_FUNC(dlascl,DLASCL)("G", &c_0, &c_0, &orgnrm, &one, n, &c_1, &d__[1], n, &ierr);
184 29 : PLUMED_BLAS_F77_FUNC(dlascl,DLASCL)("G", &c_0, &c_0, &orgnrm, &one, &nm1, &c_1, &e[1], &nm1, &ierr);
185 :
186 : eps = PLUMED_GMX_DOUBLE_EPS;
187 :
188 29 : mlvl = (int) (std::log((double) (*n) / (double) (smlsiz + 1)) /
189 : std::log(2.)) + 1;
190 : smlszp = smlsiz + 1;
191 :
192 29 : if (icompq == 1) {
193 : iu = 1;
194 : ivt = smlsiz + 1;
195 0 : difl = ivt + smlszp;
196 0 : difr = difl + mlvl;
197 0 : z__ = difr + (mlvl << 1);
198 0 : ic = z__ + mlvl;
199 0 : is = ic + 1;
200 0 : poles = is + 1;
201 0 : givnum = poles + (mlvl << 1);
202 :
203 : k = 1;
204 : givptr = 2;
205 : perm = 3;
206 0 : givcol = perm + mlvl;
207 : }
208 :
209 29 : i__1 = *n;
210 1453 : for (i__ = 1; i__ <= i__1; ++i__) {
211 1424 : if (std::abs(d__[i__]) < eps)
212 40 : d__[i__] = (d__[i__]>0) ? eps : -eps;
213 : }
214 :
215 : start = 1;
216 29 : sqre = 0;
217 :
218 29 : i__1 = nm1;
219 1424 : for (i__ = 1; i__ <= i__1; ++i__) {
220 1395 : if (std::abs(e[i__]) < eps || i__ == nm1) {
221 29 : if (i__ < nm1) {
222 0 : nsize = i__ - start + 1;
223 29 : } else if (std::abs(e[i__]) >= eps) {
224 24 : nsize = *n - start + 1;
225 : } else {
226 5 : nsize = i__ - start + 1;
227 5 : if (icompq == 2) {
228 5 : u[*n + *n * u_dim1] = (d__[*n]>0) ? 1.0 : -1.0;
229 5 : vt[*n + *n * vt_dim1] = 1.;
230 0 : } else if (icompq == 1) {
231 0 : q[*n + (qstart - 1) * *n] = (d__[*n]>0) ? 1.0 : -1.0;
232 0 : q[*n + (smlsiz + qstart - 1) * *n] = 1.;
233 : }
234 5 : d__[*n] = std::abs(d__[*n]);
235 : }
236 29 : if (icompq == 2) {
237 29 : PLUMED_BLAS_F77_FUNC(dlasd0,DLASD0)(&nsize, &sqre, &d__[start], &e[start],
238 29 : &u[start + start * u_dim1], ldu,
239 29 : &vt[start + start * vt_dim1],
240 29 : ldvt, &smlsiz, &iwork[1], &work[wstart], info);
241 : } else {
242 0 : PLUMED_BLAS_F77_FUNC(dlasda,DLASDA)(&icompq, &smlsiz, &nsize, &sqre, &d__[start],
243 0 : &e[start], &q[start + (iu + qstart - 2) * *n], n,
244 0 : &q[start + (ivt + qstart - 2) * *n], &iq[start + k * *n],
245 0 : &q[start + (difl + qstart - 2) * *n],
246 0 : &q[start + (difr + qstart - 2) * *n],
247 0 : &q[start + (z__ + qstart - 2) * *n],
248 0 : &q[start + (poles + qstart - 2) * *n],
249 0 : &iq[start + givptr * *n], &iq[start + givcol * *n], n,
250 0 : &iq[start + perm * *n],
251 0 : &q[start + (givnum + qstart - 2) * *n],
252 0 : &q[start + (ic + qstart - 2) * *n],
253 0 : &q[start + (is + qstart - 2) * *n], &work[wstart],
254 : &iwork[1], info);
255 0 : if (*info != 0) {
256 : return;
257 : }
258 : }
259 29 : start = i__ + 1;
260 : }
261 : }
262 29 : PLUMED_BLAS_F77_FUNC(dlascl,DLASCL)("G", &c_0, &c_0, &one, &orgnrm, n, &c_1, &d__[1], n, &ierr);
263 96 : L40:
264 96 : i__1 = *n;
265 2544 : for (ii = 2; ii <= i__1; ++ii) {
266 2448 : i__ = ii - 1;
267 : kk = i__;
268 2448 : p = d__[i__];
269 2448 : i__2 = *n;
270 152041 : for (j = ii; j <= i__2; ++j) {
271 149593 : if (d__[j] > p) {
272 : kk = j;
273 : p = d__[j];
274 : }
275 : }
276 2448 : if (kk != i__) {
277 1263 : d__[kk] = d__[i__];
278 1263 : d__[i__] = p;
279 1263 : if (icompq == 1) {
280 0 : iq[i__] = kk;
281 1263 : } else if (icompq == 2) {
282 1263 : PLUMED_BLAS_F77_FUNC(dswap,DSWAP)(n, &u[i__ * u_dim1 + 1],&c_1,&u[kk*u_dim1+1],&c_1);
283 1263 : PLUMED_BLAS_F77_FUNC(dswap,DSWAP)(n, &vt[i__ + vt_dim1], ldvt, &vt[kk + vt_dim1], ldvt);
284 : }
285 1185 : } else if (icompq == 1) {
286 0 : iq[i__] = i__;
287 : }
288 : }
289 96 : if (icompq == 1) {
290 0 : if (iuplo == 1) {
291 0 : iq[*n] = 1;
292 : } else {
293 0 : iq[*n] = 0;
294 : }
295 : }
296 96 : if (iuplo == 2 && icompq == 2) {
297 0 : PLUMED_BLAS_F77_FUNC(dlasr,DLASR)("L", "V", "B", n, n, &work[1], &work[*n], &u[u_offset], ldu);
298 : }
299 :
300 : return;
301 : }
302 : }
303 : }
304 : #include <cctype>
305 : #include <cmath>
306 :
307 : #include "blas/blas.h"
308 : #include "lapack.h"
309 :
310 : #include "real.h"
311 :
312 : #include "blas/blas.h"
313 : namespace PLMD{
314 : namespace lapack{
315 : using namespace blas;
316 : void
317 155 : PLUMED_BLAS_F77_FUNC(dbdsqr,DBDSQR)(const char *uplo,
318 : int *n,
319 : int *ncvt,
320 : int *nru,
321 : int *ncc,
322 : double *d__,
323 : double *e,
324 : double *vt,
325 : int *ldvt,
326 : double *u,
327 : int *ldu,
328 : double *c__,
329 : int *ldc,
330 : double *work,
331 : int *info)
332 : {
333 155 : const char xuplo = std::toupper(*uplo);
334 : int c_dim1, c_offset, u_dim1, u_offset, vt_dim1, vt_offset, i__1,
335 : i__2;
336 : double r__1, r__2, r__3, r__4;
337 : double c_b15 = -.125;
338 :
339 155 : int c__1 = 1;
340 : double c_b49 = 1.f;
341 155 : double c_b72 = -1.f;
342 :
343 : double f, g, h__;
344 : int i__, j, m;
345 : double r__, cs;
346 : int ll;
347 : double sn, mu;
348 : int nm1, nm12, nm13, lll;
349 : double eps, sll, tol, abse;
350 : int idir;
351 : double abss;
352 : int oldm;
353 : double cosl;
354 : int isub, iter;
355 : double unfl, sinl, cosr, smin, smax, sinr;
356 : double oldcs;
357 : int oldll;
358 155 : double shift, sigmn, oldsn = 0.;
359 : int maxit;
360 : double sminl;
361 : double sigmx;
362 : int lower;
363 : double sminoa;
364 : double thresh;
365 : int rotate;
366 : double tolmul;
367 : int itmp1,itmp2;
368 :
369 155 : --d__;
370 155 : --e;
371 155 : vt_dim1 = *ldvt;
372 155 : vt_offset = 1 + vt_dim1;
373 155 : vt -= vt_offset;
374 155 : u_dim1 = *ldu;
375 155 : u_offset = 1 + u_dim1;
376 155 : u -= u_offset;
377 155 : c_dim1 = *ldc;
378 155 : c_offset = 1 + c_dim1;
379 155 : c__ -= c_offset;
380 155 : --work;
381 :
382 155 : *info = 0;
383 :
384 155 : itmp1 = (*n > 1) ? *n : 1;
385 155 : itmp2 = (*nru > 1) ? *nru : 1;
386 :
387 : lower = (xuplo == 'L');
388 155 : if ( (xuplo!='U') && !lower) {
389 0 : *info = -1;
390 155 : } else if (*n < 0) {
391 0 : *info = -2;
392 155 : } else if (*ncvt < 0) {
393 0 : *info = -3;
394 155 : } else if (*nru < 0) {
395 0 : *info = -4;
396 155 : } else if (*ncc < 0) {
397 0 : *info = -5;
398 155 : } else if ( ((*ncvt == 0) && (*ldvt < 1)) || ((*ncvt > 0) && (*ldvt < itmp1)) ) {
399 0 : *info = -9;
400 155 : } else if (*ldu < itmp2) {
401 0 : *info = -11;
402 155 : } else if ( ((*ncc == 0) && (*ldc < 1)) || ((*ncc > 0) && (*ldc < itmp1))) {
403 0 : *info = -13;
404 : }
405 155 : if (*info != 0) {
406 : return;
407 : }
408 155 : if (*n == 0) {
409 : return;
410 : }
411 155 : if (*n == 1) {
412 0 : goto L160;
413 : }
414 :
415 155 : rotate = *ncvt > 0 || *nru > 0 || *ncc > 0;
416 :
417 : if (! rotate) {
418 0 : PLUMED_BLAS_F77_FUNC(dlasq1,DLASQ1)(n, &d__[1], &e[1], &work[1], info);
419 0 : return;
420 : }
421 :
422 155 : nm1 = *n - 1;
423 155 : nm12 = nm1 + nm1;
424 155 : nm13 = nm12 + nm1;
425 : idir = 0;
426 :
427 : eps = PLUMED_GMX_DOUBLE_EPS;
428 : unfl = PLUMED_GMX_DOUBLE_MIN/PLUMED_GMX_DOUBLE_EPS;
429 :
430 155 : if (lower) {
431 0 : i__1 = *n - 1;
432 0 : for (i__ = 1; i__ <= i__1; ++i__) {
433 0 : PLUMED_BLAS_F77_FUNC(dlartg,DLARTG)(&d__[i__], &e[i__], &cs, &sn, &r__);
434 0 : d__[i__] = r__;
435 0 : e[i__] = sn * d__[i__ + 1];
436 0 : d__[i__ + 1] = cs * d__[i__ + 1];
437 0 : work[i__] = cs;
438 0 : work[nm1 + i__] = sn;
439 : }
440 :
441 0 : if (*nru > 0) {
442 0 : PLUMED_BLAS_F77_FUNC(dlasr,DLASR)("R", "V", "F", nru, n, &work[1], &work[*n], &u[u_offset],
443 : ldu);
444 : }
445 0 : if (*ncc > 0) {
446 0 : PLUMED_BLAS_F77_FUNC(dlasr,DLASR)("L", "V", "F", n, ncc, &work[1], &work[*n], &c__[c_offset],
447 : ldc);
448 : }
449 : }
450 :
451 : r__3 = 100.f, r__4 = std::pow(PLUMED_GMX_DOUBLE_EPS,c_b15);
452 155 : r__1 = 10.f, r__2 = (r__3<r__4) ? r__3 : r__4;
453 : tolmul = (r__1>r__2) ? r__1 : r__2;
454 : tol = tolmul * eps;
455 : smax = 0.f;
456 155 : i__1 = *n;
457 2635 : for (i__ = 1; i__ <= i__1; ++i__) {
458 2480 : r__2 = smax, r__3 = (r__1 = d__[i__], std::abs(r__1));
459 2480 : smax = (r__2>r__3) ? r__2 : r__3;
460 : }
461 155 : i__1 = *n - 1;
462 2480 : for (i__ = 1; i__ <= i__1; ++i__) {
463 2325 : r__2 = smax, r__3 = (r__1 = e[i__], std::abs(r__1));
464 2325 : smax = (r__2>r__3) ? r__2 : r__3;
465 : }
466 : sminl = 0.f;
467 : if (tol >= 0.f) {
468 155 : sminoa = std::abs(d__[1]);
469 155 : if (sminoa == 0.f) {
470 0 : goto L50;
471 : }
472 : mu = sminoa;
473 155 : i__1 = *n;
474 2480 : for (i__ = 2; i__ <= i__1; ++i__) {
475 2325 : mu = (r__2 = d__[i__], std::abs(r__2)) * (mu / (mu + (r__1 = e[i__ -
476 2325 : 1], std::abs(r__1))));
477 2325 : sminoa = (sminoa<mu) ? sminoa : mu;
478 2325 : if (sminoa == 0.f) {
479 0 : goto L50;
480 : }
481 : }
482 155 : L50:
483 155 : sminoa /= std::sqrt((double) (*n));
484 155 : r__1 = tol * sminoa, r__2 = *n * 6 * *n * unfl;
485 155 : thresh = (r__1>r__2) ? r__1 : r__2;
486 : } else {
487 : r__1 = std::abs(tol) * smax, r__2 = *n * 6 * *n * unfl;
488 : thresh = (r__1>r__2) ? r__1 : r__2;
489 : }
490 : maxit = *n * 6 * *n;
491 : iter = 0;
492 : oldll = -1;
493 : oldm = -1;
494 : m = *n;
495 :
496 8153 : L60:
497 :
498 8308 : if (m <= 1) {
499 155 : goto L160;
500 : }
501 8153 : if (iter > maxit) {
502 0 : goto L200;
503 : }
504 :
505 : if (tol < 0.f && (r__1 = d__[m], std::abs(r__1)) <= thresh) {
506 : d__[m] = 0.f;
507 : }
508 8153 : smax = (r__1 = d__[m], std::abs(r__1));
509 : smin = smax;
510 8153 : i__1 = m - 1;
511 64129 : for (lll = 1; lll <= i__1; ++lll) {
512 58204 : ll = m - lll;
513 58204 : abss = (r__1 = d__[ll], std::abs(r__1));
514 58204 : abse = (r__1 = e[ll], std::abs(r__1));
515 : if (tol < 0.f && abss <= thresh) {
516 : d__[ll] = 0.f;
517 : }
518 58204 : if (abse <= thresh) {
519 2228 : goto L80;
520 : }
521 55976 : smin = (smin<abss) ? smin : abss;
522 55976 : r__1 = (smax>abss) ? smax : abss;
523 55976 : smax = (r__1>abse) ? r__1 : abse;
524 : }
525 : ll = 0;
526 5925 : goto L90;
527 : L80:
528 2228 : e[ll] = 0.f;
529 2228 : if (ll == m - 1) {
530 : --m;
531 2119 : goto L60;
532 : }
533 109 : L90:
534 6034 : ++ll;
535 6034 : if (ll == m - 1) {
536 180 : PLUMED_BLAS_F77_FUNC(dlasv2,DLASV2)(&d__[m - 1], &e[m - 1], &d__[m], &sigmn, &sigmx, &sinr, &cosr,
537 : &sinl, &cosl);
538 180 : d__[m - 1] = sigmx;
539 180 : e[m - 1] = 0.f;
540 180 : d__[m] = sigmn;
541 180 : if (*ncvt > 0) {
542 180 : PLUMED_BLAS_F77_FUNC(drot,DROT)(ncvt, &vt[m - 1 + vt_dim1], ldvt, &vt[m + vt_dim1], ldvt, &
543 : cosr, &sinr);
544 : }
545 180 : if (*nru > 0) {
546 180 : PLUMED_BLAS_F77_FUNC(drot,DROT)(nru, &u[(m - 1) * u_dim1 + 1], &c__1, &u[m * u_dim1 + 1], &
547 : c__1, &cosl, &sinl);
548 : }
549 180 : if (*ncc > 0) {
550 0 : PLUMED_BLAS_F77_FUNC(drot,DROT)(ncc, &c__[m - 1 + c_dim1], ldc, &c__[m + c_dim1], ldc, &
551 : cosl, &sinl);
552 : }
553 180 : m += -2;
554 180 : goto L60;
555 : }
556 5854 : if (ll > oldm || m < oldll) {
557 182 : if ((r__1 = d__[ll], std::abs(r__1)) >= (r__2 = d__[m], std::abs(r__2))) {
558 : idir = 1;
559 : } else {
560 : idir = 2;
561 : }
562 : }
563 5672 : if (idir == 1) {
564 :
565 5821 : if( (std::abs(e[m-1]) <= std::abs(tol) * std::abs(d__[m])) ||
566 : (tol<0.0 && std::abs(e[m-1])<=thresh)) {
567 1172 : e[m - 1] = 0.f;
568 1172 : goto L60;
569 : }
570 : if (tol >= 0.f) {
571 4649 : mu = (r__1 = d__[ll], std::abs(r__1));
572 : sminl = mu;
573 : i__1 = m - 1;
574 49166 : for (lll = ll; lll <= i__1; ++lll) {
575 44567 : if ((r__1 = e[lll], std::abs(r__1)) <= tol * mu) {
576 50 : e[lll] = 0.f;
577 50 : goto L60;
578 : }
579 44517 : mu = (r__2 = d__[lll + 1], std::abs(r__2)) * (mu / (mu + (r__1 =
580 : e[lll], std::abs(r__1))));
581 44517 : sminl = (sminl<mu) ? sminl : mu;
582 : }
583 : }
584 : } else {
585 33 : if( (std::abs(e[ll]) <= std::abs(tol)*std::abs(d__[ll])) ||
586 : (tol<0.0 && std::abs(e[ll])<=thresh)) {
587 0 : e[ll] = 0.f;
588 0 : goto L60;
589 : }
590 : if (tol >= 0.f) {
591 33 : mu = (r__1 = d__[m], std::abs(r__1));
592 : sminl = mu;
593 33 : i__1 = ll;
594 305 : for (lll = m - 1; lll >= i__1; --lll) {
595 272 : if ((r__1 = e[lll], std::abs(r__1)) <= tol * mu) {
596 0 : e[lll] = 0.f;
597 0 : goto L60;
598 : }
599 272 : mu = (r__2 = d__[lll], std::abs(r__2)) * (mu / (mu + (r__1 = e[
600 : lll], std::abs(r__1))));
601 272 : sminl = (sminl<mu) ? sminl : mu;
602 : }
603 : }
604 : }
605 : oldll = ll;
606 : oldm = m;
607 :
608 4632 : r__1 = eps, r__2 = tol * .01f;
609 4632 : if (tol >= 0.f && *n * tol * (sminl / smax) <= ((r__1>r__2) ? r__1 : r__2)) {
610 80 : shift = 0.f;
611 : } else {
612 4552 : if (idir == 1) {
613 4519 : sll = (r__1 = d__[ll], std::abs(r__1));
614 4519 : PLUMED_BLAS_F77_FUNC(dlas2,DLAS2)(&d__[m - 1], &e[m - 1], &d__[m], &shift, &r__);
615 : } else {
616 33 : sll = (r__1 = d__[m], std::abs(r__1));
617 33 : PLUMED_BLAS_F77_FUNC(dlas2,DLAS2)(&d__[ll], &e[ll], &d__[ll + 1], &shift, &r__);
618 : }
619 4552 : if (sll > 0.f) {
620 4552 : r__1 = shift / sll;
621 4552 : if (r__1 * r__1 < eps) {
622 0 : shift = 0.f;
623 : }
624 : }
625 : }
626 4632 : iter = iter + m - ll;
627 4632 : if (shift == 0.f) {
628 80 : if (idir == 1) {
629 80 : cs = 1.f;
630 80 : oldcs = 1.f;
631 80 : i__1 = m - 1;
632 1346 : for (i__ = ll; i__ <= i__1; ++i__) {
633 1266 : r__1 = d__[i__] * cs;
634 1266 : PLUMED_BLAS_F77_FUNC(dlartg,DLARTG)(&r__1, &e[i__], &cs, &sn, &r__);
635 1266 : if (i__ > ll) {
636 1186 : e[i__ - 1] = oldsn * r__;
637 : }
638 1266 : r__1 = oldcs * r__;
639 1266 : r__2 = d__[i__ + 1] * sn;
640 1266 : PLUMED_BLAS_F77_FUNC(dlartg,DLARTG)(&r__1, &r__2, &oldcs, &oldsn, &d__[i__]);
641 1266 : work[i__ - ll + 1] = cs;
642 1266 : work[i__ - ll + 1 + nm1] = sn;
643 1266 : work[i__ - ll + 1 + nm12] = oldcs;
644 1266 : work[i__ - ll + 1 + nm13] = oldsn;
645 : }
646 80 : h__ = d__[m] * cs;
647 80 : d__[m] = h__ * oldcs;
648 80 : e[m - 1] = h__ * oldsn;
649 80 : if (*ncvt > 0) {
650 80 : i__1 = m - ll + 1;
651 80 : PLUMED_BLAS_F77_FUNC(dlasr,DLASR)("L", "V", "F", &i__1, ncvt, &work[1], &work[*n], &vt[
652 80 : ll + vt_dim1], ldvt);
653 : }
654 80 : if (*nru > 0) {
655 80 : i__1 = m - ll + 1;
656 80 : PLUMED_BLAS_F77_FUNC(dlasr,DLASR)("R", "V", "F", nru, &i__1, &work[nm12 + 1], &work[nm13
657 80 : + 1], &u[ll * u_dim1 + 1], ldu);
658 : }
659 80 : if (*ncc > 0) {
660 0 : i__1 = m - ll + 1;
661 0 : PLUMED_BLAS_F77_FUNC(dlasr,DLASR)("L", "V", "F", &i__1, ncc, &work[nm12 + 1], &work[nm13
662 0 : + 1], &c__[ll + c_dim1], ldc);
663 : }
664 80 : if ((r__1 = e[m - 1], std::abs(r__1)) <= thresh) {
665 75 : e[m - 1] = 0.f;
666 : }
667 : } else {
668 0 : cs = 1.f;
669 0 : oldcs = 1.f;
670 0 : i__1 = ll + 1;
671 0 : for (i__ = m; i__ >= i__1; --i__) {
672 0 : r__1 = d__[i__] * cs;
673 0 : PLUMED_BLAS_F77_FUNC(dlartg,DLARTG)(&r__1, &e[i__ - 1], &cs, &sn, &r__);
674 0 : if (i__ < m) {
675 0 : e[i__] = oldsn * r__;
676 : }
677 0 : r__1 = oldcs * r__;
678 0 : r__2 = d__[i__ - 1] * sn;
679 0 : PLUMED_BLAS_F77_FUNC(dlartg,DLARTG)(&r__1, &r__2, &oldcs, &oldsn, &d__[i__]);
680 0 : work[i__ - ll] = cs;
681 0 : work[i__ - ll + nm1] = -sn;
682 0 : work[i__ - ll + nm12] = oldcs;
683 0 : work[i__ - ll + nm13] = -oldsn;
684 : }
685 0 : h__ = d__[ll] * cs;
686 0 : d__[ll] = h__ * oldcs;
687 0 : e[ll] = h__ * oldsn;
688 0 : if (*ncvt > 0) {
689 0 : i__1 = m - ll + 1;
690 0 : PLUMED_BLAS_F77_FUNC(dlasr,DLASR)("L", "V", "B", &i__1, ncvt, &work[nm12 + 1], &work[
691 0 : nm13 + 1], &vt[ll + vt_dim1], ldvt);
692 : }
693 0 : if (*nru > 0) {
694 0 : i__1 = m - ll + 1;
695 0 : PLUMED_BLAS_F77_FUNC(dlasr,DLASR)("R", "V", "B", nru, &i__1, &work[1], &work[*n], &u[ll *
696 0 : u_dim1 + 1], ldu);
697 : }
698 0 : if (*ncc > 0) {
699 0 : i__1 = m - ll + 1;
700 0 : PLUMED_BLAS_F77_FUNC(dlasr,DLASR)("L", "V", "B", &i__1, ncc, &work[1], &work[*n], &c__[
701 0 : ll + c_dim1], ldc);
702 : }
703 0 : if ((r__1 = e[ll], std::abs(r__1)) <= thresh) {
704 0 : e[ll] = 0.f;
705 : }
706 : }
707 : } else {
708 :
709 4552 : if (idir == 1) {
710 4519 : f = ((r__1 = d__[ll], std::abs(r__1)) - shift) * ( ((d__[ll] > 0) ? c_b49 : -c_b49) + shift / d__[ll]);
711 4519 : g = e[ll];
712 4519 : i__1 = m - 1;
713 47367 : for (i__ = ll; i__ <= i__1; ++i__) {
714 42848 : PLUMED_BLAS_F77_FUNC(dlartg,DLARTG)(&f, &g, &cosr, &sinr, &r__);
715 42848 : if (i__ > ll) {
716 38329 : e[i__ - 1] = r__;
717 : }
718 42848 : f = cosr * d__[i__] + sinr * e[i__];
719 42848 : e[i__] = cosr * e[i__] - sinr * d__[i__];
720 42848 : g = sinr * d__[i__ + 1];
721 42848 : d__[i__ + 1] = cosr * d__[i__ + 1];
722 42848 : PLUMED_BLAS_F77_FUNC(dlartg,DLARTG)(&f, &g, &cosl, &sinl, &r__);
723 42848 : d__[i__] = r__;
724 42848 : f = cosl * e[i__] + sinl * d__[i__ + 1];
725 42848 : d__[i__ + 1] = cosl * d__[i__ + 1] - sinl * e[i__];
726 42848 : if (i__ < m - 1) {
727 38329 : g = sinl * e[i__ + 1];
728 38329 : e[i__ + 1] = cosl * e[i__ + 1];
729 : }
730 42848 : work[i__ - ll + 1] = cosr;
731 42848 : work[i__ - ll + 1 + nm1] = sinr;
732 42848 : work[i__ - ll + 1 + nm12] = cosl;
733 42848 : work[i__ - ll + 1 + nm13] = sinl;
734 : }
735 4519 : e[m - 1] = f;
736 :
737 4519 : if (*ncvt > 0) {
738 4519 : i__1 = m - ll + 1;
739 4519 : PLUMED_BLAS_F77_FUNC(dlasr,DLASR)("L", "V", "F", &i__1, ncvt, &work[1], &work[*n], &vt[
740 4519 : ll + vt_dim1], ldvt);
741 : }
742 4519 : if (*nru > 0) {
743 4519 : i__1 = m - ll + 1;
744 4519 : PLUMED_BLAS_F77_FUNC(dlasr,DLASR)("R", "V", "F", nru, &i__1, &work[nm12 + 1], &work[nm13
745 4519 : + 1], &u[ll * u_dim1 + 1], ldu);
746 : }
747 4519 : if (*ncc > 0) {
748 0 : i__1 = m - ll + 1;
749 0 : PLUMED_BLAS_F77_FUNC(dlasr,DLASR)("L", "V", "F", &i__1, ncc, &work[nm12 + 1], &work[nm13
750 0 : + 1], &c__[ll + c_dim1], ldc);
751 : }
752 4519 : if ((r__1 = e[m - 1], std::abs(r__1)) <= thresh) {
753 834 : e[m - 1] = 0.f;
754 : }
755 : } else {
756 :
757 33 : f = ((r__1 = d__[m], std::abs(r__1)) - shift) * ( ((d__[m] > 0) ? c_b49 : -c_b49) + shift / d__[m]);
758 33 : g = e[m - 1];
759 33 : i__1 = ll + 1;
760 305 : for (i__ = m; i__ >= i__1; --i__) {
761 272 : PLUMED_BLAS_F77_FUNC(dlartg,DLARTG)(&f, &g, &cosr, &sinr, &r__);
762 272 : if (i__ < m) {
763 239 : e[i__] = r__;
764 : }
765 272 : f = cosr * d__[i__] + sinr * e[i__ - 1];
766 272 : e[i__ - 1] = cosr * e[i__ - 1] - sinr * d__[i__];
767 272 : g = sinr * d__[i__ - 1];
768 272 : d__[i__ - 1] = cosr * d__[i__ - 1];
769 272 : PLUMED_BLAS_F77_FUNC(dlartg,DLARTG)(&f, &g, &cosl, &sinl, &r__);
770 272 : d__[i__] = r__;
771 272 : f = cosl * e[i__ - 1] + sinl * d__[i__ - 1];
772 272 : d__[i__ - 1] = cosl * d__[i__ - 1] - sinl * e[i__ - 1];
773 272 : if (i__ > ll + 1) {
774 239 : g = sinl * e[i__ - 2];
775 239 : e[i__ - 2] = cosl * e[i__ - 2];
776 : }
777 272 : work[i__ - ll] = cosr;
778 272 : work[i__ - ll + nm1] = -sinr;
779 272 : work[i__ - ll + nm12] = cosl;
780 272 : work[i__ - ll + nm13] = -sinl;
781 : }
782 33 : e[ll] = f;
783 :
784 33 : if ((r__1 = e[ll], std::abs(r__1)) <= thresh) {
785 12 : e[ll] = 0.f;
786 : }
787 33 : if (*ncvt > 0) {
788 33 : i__1 = m - ll + 1;
789 33 : PLUMED_BLAS_F77_FUNC(dlasr,DLASR)("L", "V", "B", &i__1, ncvt, &work[nm12 + 1], &work[
790 33 : nm13 + 1], &vt[ll + vt_dim1], ldvt);
791 : }
792 33 : if (*nru > 0) {
793 33 : i__1 = m - ll + 1;
794 33 : PLUMED_BLAS_F77_FUNC(dlasr,DLASR)("R", "V", "B", nru, &i__1, &work[1], &work[*n], &u[ll *
795 33 : u_dim1 + 1], ldu);
796 : }
797 33 : if (*ncc > 0) {
798 0 : i__1 = m - ll + 1;
799 0 : PLUMED_BLAS_F77_FUNC(dlasr,DLASR)("L", "V", "B", &i__1, ncc, &work[1], &work[*n], &c__[
800 0 : ll + c_dim1], ldc);
801 : }
802 : }
803 : }
804 :
805 4632 : goto L60;
806 :
807 155 : L160:
808 155 : i__1 = *n;
809 2635 : for (i__ = 1; i__ <= i__1; ++i__) {
810 2480 : if (d__[i__] < 0.f) {
811 531 : d__[i__] = -d__[i__];
812 :
813 531 : if (*ncvt > 0) {
814 531 : PLUMED_BLAS_F77_FUNC(dscal,DSCAL)(ncvt, &c_b72, &vt[i__ + vt_dim1], ldvt);
815 : }
816 : }
817 : }
818 :
819 155 : i__1 = *n - 1;
820 2480 : for (i__ = 1; i__ <= i__1; ++i__) {
821 :
822 : isub = 1;
823 2325 : smin = d__[1];
824 2325 : i__2 = *n + 1 - i__;
825 22122 : for (j = 2; j <= i__2; ++j) {
826 19797 : if (d__[j] <= smin) {
827 : isub = j;
828 : smin = d__[j];
829 : }
830 : }
831 2325 : if (isub != *n + 1 - i__) {
832 179 : d__[isub] = d__[*n + 1 - i__];
833 179 : d__[*n + 1 - i__] = smin;
834 179 : if (*ncvt > 0) {
835 179 : PLUMED_BLAS_F77_FUNC(dswap,DSWAP)(ncvt, &vt[isub + vt_dim1], ldvt, &vt[*n + 1 - i__ +
836 179 : vt_dim1], ldvt);
837 : }
838 179 : if (*nru > 0) {
839 179 : PLUMED_BLAS_F77_FUNC(dswap,DSWAP)(nru, &u[isub * u_dim1 + 1], &c__1, &u[(*n + 1 - i__) *
840 179 : u_dim1 + 1], &c__1);
841 : }
842 179 : if (*ncc > 0) {
843 0 : PLUMED_BLAS_F77_FUNC(dswap,DSWAP)(ncc, &c__[isub + c_dim1], ldc, &c__[*n + 1 - i__ +
844 0 : c_dim1], ldc);
845 : }
846 : }
847 : }
848 155 : goto L220;
849 :
850 : L200:
851 0 : *info = 0;
852 0 : i__1 = *n - 1;
853 0 : for (i__ = 1; i__ <= i__1; ++i__) {
854 0 : if (e[i__] != 0.f) {
855 0 : ++(*info);
856 : }
857 : }
858 0 : L220:
859 : return;
860 :
861 : }
862 :
863 :
864 : }
865 : }
866 : #include "lapack.h"
867 :
868 : #include "blas/blas.h"
869 : namespace PLMD{
870 : namespace lapack{
871 : using namespace blas;
872 : void
873 96 : PLUMED_BLAS_F77_FUNC(dgebd2,DGEBD2)(int *m,
874 : int *n,
875 : double *a,
876 : int *lda,
877 : double *d,
878 : double *e,
879 : double *tauq,
880 : double *taup,
881 : double *work,
882 : int *info)
883 : {
884 : int i,i1,i2,i3;
885 :
886 96 : *info = 0;
887 :
888 96 : if(*m>=*n) {
889 : /* reduce to upper bidiag. form */
890 2256 : for(i=0;i<*n;i++) {
891 2160 : i1 = *m - i;
892 2160 : i2 = ( (i+1) < (*m-1)) ? (i+1) : (*m-1);
893 2160 : i3 = 1;
894 2160 : PLUMED_BLAS_F77_FUNC(dlarfg,DLARFG)(&i1,&(a[i*(*lda)+i]),&(a[i*(*lda)+i2]),&i3,&(tauq[i]));
895 2160 : d[i] = a[i*(*lda)+i];
896 2160 : a[i*(*lda)+i] = 1.0;
897 2160 : i2 = *n - i - 1;
898 2160 : PLUMED_BLAS_F77_FUNC(dlarf,DLARF)("L",&i1,&i2,&(a[i*(*lda)+i]),&i3,&(tauq[i]),&(a[(i+1)*(*lda)+i]),lda,work);
899 2160 : a[i*(*lda)+i] = d[i];
900 :
901 2160 : if(i<(*n-1)) {
902 :
903 2064 : i1 = *n - i -1;
904 2064 : i2 = ( (i+2) < (*n-1)) ? (i+2) : (*n-1);
905 2064 : PLUMED_BLAS_F77_FUNC(dlarfg,DLARFG)(&i1,&(a[(i+1)*(*lda)+i]),&(a[i2*(*lda)+i]),lda,&(taup[i]));
906 :
907 2064 : e[i] = a[(i+1)*(*lda)+i];
908 2064 : a[(i+1)*(*lda)+i] = 1.0;
909 :
910 2064 : i1 = *m - i - 1;
911 2064 : i2 = *n - i - 1;
912 2064 : PLUMED_BLAS_F77_FUNC(dlarf,DLARF)("R",&i1,&i2,&(a[(i+1)*(*lda)+i]),lda,&(taup[i]),&(a[(i+1)*(*lda)+i+1]),lda,work);
913 2064 : a[(i+1)*(*lda)+i] = e[i];
914 : } else
915 96 : taup[i] = 0.0;
916 : }
917 : } else {
918 : /* reduce to lower bidiag. form */
919 0 : for(i=0;i<*m;i++) {
920 0 : i1 = *n - i;
921 0 : i2 = ( (i+1) < (*n-1)) ? (i+1) : (*n-1);
922 0 : PLUMED_BLAS_F77_FUNC(dlarfg,DLARFG)(&i1,&(a[i*(*lda)+i]),&(a[i2*(*lda)+i]),lda,&(taup[i]));
923 0 : d[i] = a[i*(*lda)+i];
924 0 : a[i*(*lda)+i] = 1.0;
925 :
926 0 : i2 = *m - i - 1;
927 0 : i3 = ( (i+1) < (*m-1)) ? (i+1) : (*m-1);
928 0 : PLUMED_BLAS_F77_FUNC(dlarf,DLARF)("R",&i2,&i1,&(a[i*(*lda)+i]),lda,&(taup[i]),&(a[(i)*(*lda)+i3]),lda,work);
929 0 : a[i*(*lda)+i] = d[i];
930 :
931 0 : if(i<(*m-1)) {
932 :
933 0 : i1 = *m - i - 1;
934 0 : i2 = ( (i+2) < (*m-1)) ? (i+2) : (*m-1);
935 0 : i3 = 1;
936 0 : PLUMED_BLAS_F77_FUNC(dlarfg,DLARFG)(&i1,&(a[(i)*(*lda)+i+1]),&(a[i*(*lda)+i2]),&i3,&(tauq[i]));
937 :
938 0 : e[i] = a[(i)*(*lda)+i+1];
939 0 : a[(i)*(*lda)+i+1] = 1.0;
940 :
941 0 : i1 = *m - i - 1;
942 0 : i2 = *n - i - 1;
943 0 : i3 = 1;
944 0 : PLUMED_BLAS_F77_FUNC(dlarf,DLARF)("L",&i1,&i2,&(a[(i)*(*lda)+i+1]),&i3,&(tauq[i]),&(a[(i+1)*(*lda)+i+1]),lda,work);
945 0 : a[(i)*(*lda)+i+1] = e[i];
946 : } else
947 0 : tauq[i] = 0.0;
948 : }
949 : }
950 96 : return;
951 : }
952 : }
953 : }
954 : #include "lapack.h"
955 : #include "blas/blas.h"
956 : #include "lapack_limits.h"
957 :
958 :
959 : #include "blas/blas.h"
960 : namespace PLMD{
961 : namespace lapack{
962 : using namespace blas;
963 : void
964 96 : PLUMED_BLAS_F77_FUNC(dgebrd,DGEBRD)(int *m,
965 : int *n,
966 : double *a,
967 : int *lda,
968 : double *d__,
969 : double *e,
970 : double *tauq,
971 : double *taup,
972 : double *work,
973 : int *lwork,
974 : int *info)
975 : {
976 : /* System generated locals */
977 : int a_dim1, a_offset, i_1, i_2, i_3, i_4;
978 :
979 : /* Local variables */
980 : int i_, j, nx,nb;
981 : double ws;
982 : int nbmin, iinfo, minmn;
983 : int ldwrkx, ldwrky;
984 96 : double one = 1.0;
985 96 : double minusone = -1.0;
986 :
987 96 : a_dim1 = *lda;
988 96 : a_offset = 1 + a_dim1;
989 96 : a -= a_offset;
990 96 : --d__;
991 96 : --e;
992 96 : --tauq;
993 96 : --taup;
994 96 : --work;
995 :
996 96 : nb = DGEBRD_BLOCKSIZE;
997 96 : *info = 0;
998 96 : if (*lwork==-1) {
999 0 : work[1] = (double) ( (*m + *n) * nb);
1000 0 : return;
1001 : }
1002 96 : minmn = (*m < *n) ? *m : *n;
1003 96 : if (minmn == 0) {
1004 0 : work[1] = 1.;
1005 0 : return;
1006 : }
1007 :
1008 96 : ws = (*m > *n) ? *m : *n;
1009 96 : ldwrkx = *m;
1010 96 : ldwrky = *n;
1011 :
1012 96 : if (nb > 1 && nb < minmn) {
1013 : nx = DGEBRD_CROSSOVER;
1014 17 : if (nx < minmn) {
1015 1 : ws = (double) ((*m + *n) * nb);
1016 1 : if ((double) (*lwork) < ws) {
1017 : nbmin = DGEBRD_MINBLOCKSIZE;
1018 0 : if (*lwork >= (*m + *n) * nbmin) {
1019 0 : nb = *lwork / (*m + *n);
1020 : } else {
1021 0 : nb = 1;
1022 : nx = minmn;
1023 : }
1024 : }
1025 : }
1026 : } else {
1027 : nx = minmn;
1028 : }
1029 :
1030 96 : i_1 = minmn - nx;
1031 96 : i_2 = nb;
1032 108 : for (i_ = 1; i_2 < 0 ? i_ >= i_1 : i_ <= i_1; i_ += i_2) {
1033 :
1034 12 : i_3 = *m - i_ + 1;
1035 12 : i_4 = *n - i_ + 1;
1036 12 : PLUMED_BLAS_F77_FUNC(dlabrd,DLABRD)(&i_3, &i_4, &nb, &a[i_ + i_ * a_dim1], lda, &d__[i_],
1037 12 : &e[i_], &tauq[i_], &taup[i_], &work[1], &ldwrkx,
1038 12 : &work[ldwrkx * nb + 1], &ldwrky);
1039 :
1040 12 : i_3 = *m - i_ - nb + 1;
1041 12 : i_4 = *n - i_ - nb + 1;
1042 12 : PLUMED_BLAS_F77_FUNC(dgemm,DGEMM)("N", "T", &i_3, &i_4, &nb, &minusone,
1043 12 : &a[i_ + nb + i_ * a_dim1], lda, &work[ldwrkx * nb + nb + 1],
1044 12 : &ldwrky, &one, &a[i_ + nb + (i_ + nb) * a_dim1], lda);
1045 12 : i_3 = *m - i_ - nb + 1;
1046 12 : i_4 = *n - i_ - nb + 1;
1047 12 : PLUMED_BLAS_F77_FUNC(dgemm,DGEMM)("N", "N", &i_3, &i_4, &nb, &minusone, &work[nb + 1], &ldwrkx,
1048 12 : &a[i_ + (i_ + nb) * a_dim1], lda, &one,
1049 12 : &a[i_ + nb + (i_ + nb) * a_dim1], lda);
1050 :
1051 12 : if (*m >= *n) {
1052 12 : i_3 = i_ + nb - 1;
1053 396 : for (j = i_; j <= i_3; ++j) {
1054 384 : a[j + j * a_dim1] = d__[j];
1055 384 : a[j + (j + 1) * a_dim1] = e[j];
1056 : }
1057 : } else {
1058 0 : i_3 = i_ + nb - 1;
1059 0 : for (j = i_; j <= i_3; ++j) {
1060 0 : a[j + j * a_dim1] = d__[j];
1061 0 : a[j + 1 + j * a_dim1] = e[j];
1062 : }
1063 : }
1064 : }
1065 :
1066 96 : i_2 = *m - i_ + 1;
1067 96 : i_1 = *n - i_ + 1;
1068 96 : PLUMED_BLAS_F77_FUNC(dgebd2,DGEBD2)(&i_2, &i_1, &a[i_ + i_ * a_dim1], lda, &d__[i_], &e[i_], &
1069 96 : tauq[i_], &taup[i_], &work[1], &iinfo);
1070 96 : work[1] = ws;
1071 96 : return;
1072 :
1073 : }
1074 : }
1075 : }
1076 : #include "lapack.h"
1077 :
1078 : #include "blas/blas.h"
1079 : namespace PLMD{
1080 : namespace lapack{
1081 : using namespace blas;
1082 : void
1083 0 : PLUMED_BLAS_F77_FUNC(dgelq2,DGELQ2)(int *m,
1084 : int *n,
1085 : double *a,
1086 : int *lda,
1087 : double *tau,
1088 : double *work,
1089 : int *info)
1090 : {
1091 : /* System generated locals */
1092 : int a_dim1, a_offset, i__1, i__2, i__3, i__4;
1093 :
1094 : /* Local variables */
1095 : int i__, k;
1096 : double aii;
1097 :
1098 0 : a_dim1 = *lda;
1099 0 : a_offset = 1 + a_dim1;
1100 0 : a -= a_offset;
1101 0 : --tau;
1102 : --work;
1103 :
1104 0 : *info = 0;
1105 :
1106 0 : i__4 = (*m > 1) ? *m : 1;
1107 :
1108 0 : if (*m < 0) {
1109 0 : *info = -1;
1110 0 : } else if (*n < 0) {
1111 0 : *info = -2;
1112 0 : } else if (*lda < i__4) {
1113 0 : *info = -4;
1114 : }
1115 0 : if (*info != 0) {
1116 : return;
1117 : }
1118 :
1119 :
1120 0 : k = (*m < *n ) ? *m : *n;
1121 : i__1 = k;
1122 0 : for (i__ = 1; i__ <= i__1; ++i__) {
1123 0 : i__2 = *n - i__ + 1;
1124 0 : i__3 = i__ + 1;
1125 : i__4 = (i__3 < *n) ? i__3 : *n;
1126 0 : PLUMED_BLAS_F77_FUNC(dlarfg,DLARFG)(&i__2, &a[i__ + i__ * a_dim1], &a[i__ + i__4 * a_dim1],
1127 0 : lda, &tau[i__]);
1128 0 : if (i__ < *m) {
1129 0 : aii = a[i__ + i__ * a_dim1];
1130 0 : a[i__ + i__ * a_dim1] = 1.f;
1131 0 : i__2 = *m - i__;
1132 0 : i__3 = *n - i__ + 1;
1133 0 : PLUMED_BLAS_F77_FUNC(dlarf,DLARF)("R", &i__2, &i__3, &a[i__ + i__ * a_dim1], lda,
1134 0 : &tau[i__], &a[i__ + 1 + i__ * a_dim1], lda, &work[1]);
1135 0 : a[i__ + i__ * a_dim1] = aii;
1136 : }
1137 : }
1138 : return;
1139 : }
1140 :
1141 :
1142 : }
1143 : }
1144 : #include <cmath>
1145 : #include "lapack.h"
1146 : #include "lapack_limits.h"
1147 :
1148 :
1149 :
1150 : #include "blas/blas.h"
1151 : namespace PLMD{
1152 : namespace lapack{
1153 : using namespace blas;
1154 : void
1155 0 : PLUMED_BLAS_F77_FUNC(dgelqf,DGELQF)(int *m,
1156 : int *n,
1157 : double *a,
1158 : int *lda,
1159 : double *tau,
1160 : double *work,
1161 : int *lwork,
1162 : int *info)
1163 : {
1164 : int a_dim1, a_offset, i__1, i__2, i__3, i__4;
1165 :
1166 : int i__, k, ib, nb, nx, iws, nbmin, iinfo;
1167 : int ldwork, lwkopt;
1168 :
1169 0 : a_dim1 = *lda;
1170 0 : a_offset = 1 + a_dim1;
1171 0 : a -= a_offset;
1172 0 : --tau;
1173 : --work;
1174 :
1175 0 : *info = 0;
1176 : nb = DGELQF_BLOCKSIZE;
1177 0 : lwkopt = *m * nb;
1178 0 : work[1] = (double) lwkopt;
1179 :
1180 0 : if (*lwork==-1) {
1181 : return;
1182 : }
1183 :
1184 0 : k =(*m < *n) ? *m : *n;
1185 0 : if (k == 0) {
1186 0 : work[1] = 1.;
1187 0 : return;
1188 : }
1189 :
1190 : nbmin = 2;
1191 : nx = 0;
1192 : iws = *m;
1193 0 : if (nb > 1 && nb < k) {
1194 : nx = DGELQF_CROSSOVER;
1195 0 : if (nx < k) {
1196 0 : ldwork = *m;
1197 0 : iws = ldwork * nb;
1198 0 : if (*lwork < iws) {
1199 :
1200 0 : nb = *lwork / ldwork;
1201 : nbmin = DGELQF_MINBLOCKSIZE;
1202 : }
1203 : }
1204 : }
1205 :
1206 0 : if (nb >= nbmin && nb < k && nx < k) {
1207 :
1208 0 : i__1 = k - nx;
1209 0 : i__2 = nb;
1210 0 : for (i__ = 1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) {
1211 0 : i__3 = k - i__ + 1;
1212 0 : ib = (i__3 < nb) ? i__3 : nb;
1213 :
1214 0 : i__3 = *n - i__ + 1;
1215 0 : PLUMED_BLAS_F77_FUNC(dgelq2,DGELQ2)(&ib, &i__3, &a[i__ + i__ * a_dim1], lda, &tau[i__], &work[
1216 : 1], &iinfo);
1217 0 : if (i__ + ib <= *m) {
1218 :
1219 0 : i__3 = *n - i__ + 1;
1220 0 : PLUMED_BLAS_F77_FUNC(dlarft,DLARFT)("Forward", "Rowwise", &i__3, &ib, &a[i__ + i__ *
1221 : a_dim1], lda, &tau[i__], &work[1], &ldwork);
1222 :
1223 0 : i__3 = *m - i__ - ib + 1;
1224 0 : i__4 = *n - i__ + 1;
1225 0 : PLUMED_BLAS_F77_FUNC(dlarfb,DLARFB)("Right", "No transpose", "Forward", "Rowwise", &i__3,
1226 : &i__4, &ib, &a[i__ + i__ * a_dim1], lda, &work[1], &
1227 0 : ldwork, &a[i__ + ib + i__ * a_dim1], lda, &work[ib +
1228 0 : 1], &ldwork);
1229 : }
1230 : }
1231 : } else {
1232 : i__ = 1;
1233 : }
1234 :
1235 0 : if (i__ <= k) {
1236 0 : i__2 = *m - i__ + 1;
1237 0 : i__1 = *n - i__ + 1;
1238 0 : PLUMED_BLAS_F77_FUNC(dgelq2,DGELQ2)(&i__2, &i__1, &a[i__ + i__ * a_dim1], lda, &tau[i__], &work[1]
1239 : , &iinfo);
1240 : }
1241 :
1242 0 : work[1] = (double) iws;
1243 0 : return;
1244 :
1245 : }
1246 : }
1247 : }
1248 : #include "lapack.h"
1249 :
1250 :
1251 : #include "blas/blas.h"
1252 : namespace PLMD{
1253 : namespace lapack{
1254 : using namespace blas;
1255 : void
1256 1 : PLUMED_BLAS_F77_FUNC(dgeqr2,DGEQR2)(int *m,
1257 : int *n,
1258 : double *a,
1259 : int *lda,
1260 : double *tau,
1261 : double *work,
1262 : int *info)
1263 : {
1264 1 : int k = (*m < *n) ? *m : *n;
1265 : int i,i1,i2,i3;
1266 : double aii;
1267 :
1268 1 : *info = 0;
1269 :
1270 3 : for(i=0;i<k;i++) {
1271 2 : i1 = *m - i;
1272 2 : i2 = ( (i+1) < (*m-1) ) ? (i+1) : (*m-1);
1273 2 : i3 = 1;
1274 2 : PLUMED_BLAS_F77_FUNC(dlarfg,DLARFG)(&i1,&(a[i*(*lda)+i]),&(a[i*(*lda)+i2]),&i3,&(tau[i]));
1275 2 : if(i<(*n-1)) {
1276 1 : aii = a[i*(*lda)+i];
1277 1 : a[i*(*lda)+i] = 1.0;
1278 1 : i2 = *n - i - 1;
1279 1 : PLUMED_BLAS_F77_FUNC(dlarf,DLARF)("L",&i1,&i2,&(a[i*(*lda)+i]),&i3,&(tau[i]),
1280 1 : &(a[(i+1)*(*lda)+i]),lda,work);
1281 1 : a[i*(*lda)+i] = aii;
1282 : }
1283 : }
1284 1 : return;
1285 : }
1286 : }
1287 : }
1288 : #include "lapack.h"
1289 : #include "lapack_limits.h"
1290 :
1291 : #include "blas/blas.h"
1292 : namespace PLMD{
1293 : namespace lapack{
1294 : using namespace blas;
1295 : void
1296 1 : PLUMED_BLAS_F77_FUNC(dgeqrf,DGEQRF)(int *m,
1297 : int *n,
1298 : double *a,
1299 : int *lda,
1300 : double *tau,
1301 : double *work,
1302 : int *lwork,
1303 : int *info)
1304 : {
1305 : int a_dim1, a_offset, i__1, i__2, i__3, i__4;
1306 :
1307 : int i__, k, ib, nb, nx, iws, nbmin, iinfo;
1308 : int ldwork, lwkopt;
1309 :
1310 1 : a_dim1 = *lda;
1311 1 : a_offset = 1 + a_dim1;
1312 1 : a -= a_offset;
1313 1 : --tau;
1314 : --work;
1315 :
1316 1 : *info = 0;
1317 : nb = DGEQRF_BLOCKSIZE;
1318 1 : lwkopt = *n * nb;
1319 1 : work[1] = (double) lwkopt;
1320 1 : if (*lwork==-1)
1321 : return;
1322 :
1323 :
1324 1 : k = (*m < *n) ? *m : *n;
1325 1 : if (k == 0) {
1326 0 : work[1] = 1.;
1327 0 : return;
1328 : }
1329 :
1330 : nbmin = 2;
1331 : nx = 0;
1332 : iws = *n;
1333 1 : if (nb > 1 && nb < k) {
1334 :
1335 : nx = DGEQRF_CROSSOVER;
1336 0 : if (nx < k) {
1337 :
1338 0 : ldwork = *n;
1339 0 : iws = ldwork * nb;
1340 0 : if (*lwork < iws) {
1341 :
1342 0 : nb = *lwork / ldwork;
1343 : nbmin = DGEQRF_MINBLOCKSIZE;
1344 : }
1345 : }
1346 : }
1347 :
1348 1 : if (nb >= nbmin && nb < k && nx < k) {
1349 0 : i__1 = k - nx;
1350 0 : i__2 = nb;
1351 0 : for (i__ = 1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) {
1352 :
1353 0 : i__3 = k - i__ + 1;
1354 0 : ib = (i__3 < nb) ? i__3 : nb;
1355 :
1356 0 : i__3 = *m - i__ + 1;
1357 0 : PLUMED_BLAS_F77_FUNC(dgeqr2,DGEQR2)(&i__3, &ib, &a[i__ + i__ * a_dim1], lda, &tau[i__], &work[
1358 : 1], &iinfo);
1359 0 : if (i__ + ib <= *n) {
1360 :
1361 0 : i__3 = *m - i__ + 1;
1362 0 : PLUMED_BLAS_F77_FUNC(dlarft,DLARFT)("Forward", "Columnwise", &i__3, &ib, &a[i__ + i__ *
1363 : a_dim1], lda, &tau[i__], &work[1], &ldwork);
1364 :
1365 0 : i__3 = *m - i__ + 1;
1366 0 : i__4 = *n - i__ - ib + 1;
1367 0 : PLUMED_BLAS_F77_FUNC(dlarfb,DLARFB)("Left", "Transpose", "Forward", "Columnwise", &i__3, &
1368 : i__4, &ib, &a[i__ + i__ * a_dim1], lda, &work[1], &
1369 0 : ldwork, &a[i__ + (i__ + ib) * a_dim1], lda, &work[ib
1370 0 : + 1], &ldwork);
1371 : }
1372 : }
1373 : } else {
1374 : i__ = 1;
1375 : }
1376 :
1377 1 : if (i__ <= k) {
1378 1 : i__2 = *m - i__ + 1;
1379 1 : i__1 = *n - i__ + 1;
1380 1 : PLUMED_BLAS_F77_FUNC(dgeqr2,DGEQR2)(&i__2, &i__1, &a[i__ + i__ * a_dim1], lda, &tau[i__], &work[1]
1381 : , &iinfo);
1382 : }
1383 :
1384 1 : work[1] = (double) iws;
1385 1 : return;
1386 :
1387 : }
1388 :
1389 : }
1390 : }
1391 : #include <cmath>
1392 : #include "real.h"
1393 :
1394 : #include "blas/blas.h"
1395 : #include "lapack.h"
1396 : #include "lapack_limits.h"
1397 :
1398 :
1399 : #include "blas/blas.h"
1400 : namespace PLMD{
1401 : namespace lapack{
1402 : using namespace blas;
1403 : void
1404 192 : PLUMED_BLAS_F77_FUNC(dgesdd,DGESDD)(const char *jobz,
1405 : int *m,
1406 : int *n,
1407 : double *a,
1408 : int *lda,
1409 : double *s,
1410 : double *u,
1411 : int *ldu,
1412 : double *vt,
1413 : int *ldvt,
1414 : double *work,
1415 : int *lwork,
1416 : int *iwork,
1417 : int *info)
1418 : {
1419 : int a_dim1, a_offset, u_dim1, u_offset, vt_dim1, vt_offset, i__1, i__2;
1420 :
1421 : int ie, iu;
1422 : double dum[1], eps;
1423 : int ivt, iscl;
1424 : double anrm;
1425 : int idum[1], ierr, itau;
1426 : int minmn, wrkbl, itaup, itauq, mnthr;
1427 : int nwork;
1428 : int wntqn;
1429 : int bdspac;
1430 : double bignum;
1431 : int ldwrku, maxwrk, ldwkvt;
1432 : double smlnum,minval, safemin;
1433 : int lquery;
1434 192 : int c__0 = 0;
1435 192 : int c__1 = 1;
1436 192 : double zero = 0.0;
1437 192 : double one = 1.0;
1438 :
1439 :
1440 192 : a_dim1 = *lda;
1441 192 : a_offset = 1 + a_dim1;
1442 192 : a -= a_offset;
1443 : --s;
1444 192 : u_dim1 = *ldu;
1445 192 : u_offset = 1 + u_dim1;
1446 192 : u -= u_offset;
1447 192 : vt_dim1 = *ldvt;
1448 192 : vt_offset = 1 + vt_dim1;
1449 192 : vt -= vt_offset;
1450 192 : --work;
1451 : --iwork;
1452 :
1453 192 : *info = 0;
1454 192 : minmn = (*m < *n) ? *m : *n;
1455 192 : mnthr = (int) (minmn * 11. / 6.);
1456 192 : wntqn = (*jobz=='o' || *jobz=='O');
1457 :
1458 : maxwrk = 1;
1459 192 : lquery = *lwork == -1;
1460 :
1461 192 : if (*info == 0 && *m > 0 && *n > 0) {
1462 192 : if (*m >= *n) {
1463 :
1464 192 : if (wntqn) {
1465 0 : bdspac = *n * 7;
1466 : } else {
1467 192 : bdspac = *n * 3 * *n + (*n << 2);
1468 : }
1469 192 : if (*m >= mnthr) {
1470 2 : if (wntqn) {
1471 :
1472 0 : wrkbl = *n * 67;
1473 0 : i__1 = wrkbl, i__2 = bdspac + *n;
1474 : maxwrk = (i__1 > i__2) ? i__1 : i__2;
1475 : } else {
1476 :
1477 2 : wrkbl = *n * 67;
1478 2 : i__1 = wrkbl, i__2 = *n + (*m << 5);
1479 : wrkbl = (i__1 > i__2) ? i__1 : i__2;
1480 2 : i__1 = wrkbl, i__2 = bdspac + *n * 3;
1481 : wrkbl = (i__1 > i__2) ? i__1 : i__2;
1482 2 : maxwrk = wrkbl + *n * *n;
1483 : }
1484 : } else {
1485 :
1486 190 : wrkbl = *n * 3 + (*m + *n*32);
1487 190 : if (wntqn) {
1488 0 : i__1 = wrkbl, i__2 = bdspac + *n * 3;
1489 : maxwrk = (i__1 > i__2) ? i__1 : i__2;
1490 : } else {
1491 190 : i__1 = maxwrk, i__2 = bdspac + *n * 3;
1492 : maxwrk = (i__1 > i__2) ? i__1 : i__2;
1493 : }
1494 : }
1495 : } else {
1496 :
1497 0 : if (wntqn) {
1498 0 : bdspac = *m * 7;
1499 : } else {
1500 0 : bdspac = *m * 3 * *m + (*m*4);
1501 : }
1502 0 : if (*n >= mnthr) {
1503 0 : if (wntqn) {
1504 :
1505 0 : wrkbl = *m * 67;
1506 0 : i__1 = wrkbl, i__2 = bdspac + *m;
1507 : maxwrk = (i__1 > i__2) ? i__1 : i__2;
1508 : } else {
1509 :
1510 0 : wrkbl = *m * 67;
1511 0 : i__1 = wrkbl, i__2 = *m + (*n*32);
1512 : wrkbl = (i__1 > i__2) ? i__1 : i__2;
1513 :
1514 0 : i__1 = wrkbl, i__2 = bdspac + *m * 3;
1515 : wrkbl = (i__1 > i__2) ? i__1 : i__2;
1516 0 : maxwrk = wrkbl + *m * *m;
1517 : }
1518 : } else {
1519 0 : wrkbl = *m * 3 + (*m + *n*32);
1520 0 : if (wntqn) {
1521 0 : i__1 = wrkbl, i__2 = bdspac + *m * 3;
1522 : maxwrk = (i__1 > i__2) ? i__1 : i__2;
1523 : } else {
1524 0 : i__1 = wrkbl, i__2 = bdspac + *m * 3;
1525 : maxwrk = (i__1 > i__2) ? i__1 : i__2;
1526 : }
1527 : }
1528 : }
1529 192 : work[1] = (double) maxwrk;
1530 : }
1531 :
1532 :
1533 192 : if( lquery != 0)
1534 : {
1535 : return;
1536 : }
1537 :
1538 :
1539 96 : if (*m == 0 || *n == 0) {
1540 0 : if (*lwork >= 1) {
1541 0 : work[1] = 1.;
1542 : }
1543 0 : return;
1544 : }
1545 : eps = PLUMED_GMX_DOUBLE_EPS;
1546 : minval = PLUMED_GMX_DOUBLE_MIN;
1547 : safemin = minval / eps;
1548 96 : smlnum = std::sqrt(safemin) / eps;
1549 :
1550 :
1551 96 : bignum = 1. / smlnum;
1552 :
1553 :
1554 96 : anrm = PLUMED_BLAS_F77_FUNC(dlange,DLANGE)("M", m, n, &a[a_offset], lda, dum);
1555 : iscl = 0;
1556 96 : if (anrm > 0. && anrm < smlnum) {
1557 : iscl = 1;
1558 0 : PLUMED_BLAS_F77_FUNC(dlascl,DLASCL)("G",&c__0,&c__0,&anrm,&smlnum,m,n,&a[a_offset],lda,&ierr);
1559 96 : } else if (anrm > bignum) {
1560 : iscl = 1;
1561 0 : PLUMED_BLAS_F77_FUNC(dlascl,DLASCL)("G",&c__0,&c__0,&anrm,&bignum,m,n,&a[a_offset],lda,&ierr);
1562 : }
1563 :
1564 96 : if (*m >= *n) {
1565 96 : if (*m >= mnthr) {
1566 :
1567 1 : if (wntqn) {
1568 :
1569 : itau = 1;
1570 0 : nwork = itau + *n;
1571 :
1572 0 : i__1 = *lwork - nwork + 1;
1573 0 : PLUMED_BLAS_F77_FUNC(dgeqrf,DGEQRF)(m, n, &a[a_offset], lda, &work[itau], &work[nwork], &
1574 : i__1, &ierr);
1575 :
1576 0 : i__1 = *n - 1;
1577 0 : i__2 = *n - 1;
1578 0 : PLUMED_BLAS_F77_FUNC(dlaset,DLASET)("L", &i__1, &i__2, &zero, &zero, &a[a_dim1 + 2],
1579 : lda);
1580 : ie = 1;
1581 0 : itauq = ie + *n;
1582 0 : itaup = itauq + *n;
1583 0 : nwork = itaup + *n;
1584 :
1585 0 : i__1 = *lwork - nwork + 1;
1586 0 : PLUMED_BLAS_F77_FUNC(dgebrd,DGEBRD)(n, n, &a[a_offset], lda, &s[1], &work[ie], &work[
1587 0 : itauq], &work[itaup], &work[nwork], &i__1, &ierr);
1588 0 : nwork = ie + *n;
1589 :
1590 0 : PLUMED_BLAS_F77_FUNC(dbdsdc,DBDSDC)("U", "N", n, &s[1], &work[ie], dum, &c__1, dum, &c__1,
1591 0 : dum, idum, &work[nwork], &iwork[1], info);
1592 :
1593 : } else {
1594 : iu = 1;
1595 :
1596 1 : ldwrku = *n;
1597 1 : itau = iu + ldwrku * *n;
1598 1 : nwork = itau + *n;
1599 :
1600 1 : i__1 = *lwork - nwork + 1;
1601 1 : PLUMED_BLAS_F77_FUNC(dgeqrf,DGEQRF)(m, n, &a[a_offset], lda, &work[itau], &work[nwork], &
1602 : i__1, &ierr);
1603 1 : PLUMED_BLAS_F77_FUNC(dlacpy,DLACPY)("L", m, n, &a[a_offset], lda, &u[u_offset], ldu);
1604 :
1605 1 : i__1 = *lwork - nwork + 1;
1606 1 : PLUMED_BLAS_F77_FUNC(dorgqr,DORGQR)(m, m, n, &u[u_offset], ldu, &work[itau], &work[nwork],
1607 : &i__1, &ierr);
1608 :
1609 1 : i__1 = *n - 1;
1610 1 : i__2 = *n - 1;
1611 1 : PLUMED_BLAS_F77_FUNC(dlaset,DLASET)("L", &i__1, &i__2, &zero, &zero, &a[a_dim1 + 2],
1612 : lda);
1613 : ie = itau;
1614 1 : itauq = ie + *n;
1615 1 : itaup = itauq + *n;
1616 1 : nwork = itaup + *n;
1617 :
1618 1 : i__1 = *lwork - nwork + 1;
1619 1 : PLUMED_BLAS_F77_FUNC(dgebrd,DGEBRD)(n, n, &a[a_offset], lda, &s[1], &work[ie], &work[
1620 1 : itauq], &work[itaup], &work[nwork], &i__1, &ierr);
1621 :
1622 1 : PLUMED_BLAS_F77_FUNC(dbdsdc,DBDSDC)("U", "I", n, &s[1], &work[ie], &work[iu], n, &vt[
1623 : vt_offset], ldvt, dum, idum, &work[nwork], &iwork[1],
1624 : info);
1625 :
1626 1 : i__1 = *lwork - nwork + 1;
1627 1 : PLUMED_BLAS_F77_FUNC(dormbr,DORMBR)("Q", "L", "N", n, n, n, &a[a_offset], lda, &work[
1628 : itauq], &work[iu], &ldwrku, &work[nwork], &i__1, &
1629 : ierr);
1630 1 : i__1 = *lwork - nwork + 1;
1631 1 : PLUMED_BLAS_F77_FUNC(dormbr,DORMBR)("P", "R", "T", n, n, n, &a[a_offset], lda, &work[
1632 : itaup], &vt[vt_offset], ldvt, &work[nwork], &i__1, &
1633 : ierr);
1634 :
1635 1 : PLUMED_BLAS_F77_FUNC(dgemm,DGEMM)("N", "N", m, n, n, &one, &u[u_offset], ldu, &work[iu]
1636 : , &ldwrku, &zero, &a[a_offset], lda);
1637 :
1638 1 : PLUMED_BLAS_F77_FUNC(dlacpy,DLACPY)("F", m, n, &a[a_offset], lda, &u[u_offset], ldu);
1639 :
1640 : }
1641 :
1642 : } else {
1643 : ie = 1;
1644 95 : itauq = ie + *n;
1645 95 : itaup = itauq + *n;
1646 95 : nwork = itaup + *n;
1647 :
1648 95 : i__1 = *lwork - nwork + 1;
1649 95 : PLUMED_BLAS_F77_FUNC(dgebrd,DGEBRD)(m, n, &a[a_offset], lda, &s[1], &work[ie], &work[itauq], &
1650 95 : work[itaup], &work[nwork], &i__1, &ierr);
1651 95 : if (wntqn) {
1652 :
1653 0 : PLUMED_BLAS_F77_FUNC(dbdsdc,DBDSDC)("U", "N", n, &s[1], &work[ie], dum, &c__1, dum, &c__1,
1654 : dum, idum, &work[nwork], &iwork[1], info);
1655 : } else {
1656 :
1657 95 : PLUMED_BLAS_F77_FUNC(dlaset,DLASET)("F", m, m, &zero, &zero, &u[u_offset], ldu);
1658 95 : PLUMED_BLAS_F77_FUNC(dbdsdc,DBDSDC)("U", "I", n, &s[1], &work[ie], &u[u_offset], ldu, &vt[
1659 : vt_offset], ldvt, dum, idum, &work[nwork], &iwork[1],
1660 : info);
1661 :
1662 95 : i__1 = *m - *n;
1663 95 : i__2 = *m - *n;
1664 95 : PLUMED_BLAS_F77_FUNC(dlaset,DLASET)("F", &i__1, &i__2, &zero, &one, &u[*n + 1 + (*n +
1665 95 : 1) * u_dim1], ldu);
1666 :
1667 95 : i__1 = *lwork - nwork + 1;
1668 95 : PLUMED_BLAS_F77_FUNC(dormbr,DORMBR)("Q", "L", "N", m, m, n, &a[a_offset], lda, &work[
1669 : itauq], &u[u_offset], ldu, &work[nwork], &i__1, &ierr);
1670 95 : i__1 = *lwork - nwork + 1;
1671 95 : PLUMED_BLAS_F77_FUNC(dormbr,DORMBR)("P", "R", "T", n, n, m, &a[a_offset], lda, &work[
1672 : itaup], &vt[vt_offset],ldvt,&work[nwork],&i__1,&ierr);
1673 : }
1674 :
1675 : }
1676 :
1677 : } else {
1678 :
1679 0 : if (*n >= mnthr) {
1680 :
1681 0 : if (wntqn) {
1682 :
1683 : itau = 1;
1684 0 : nwork = itau + *m;
1685 :
1686 0 : i__1 = *lwork - nwork + 1;
1687 0 : PLUMED_BLAS_F77_FUNC(dgelqf,DGELQF)(m, n, &a[a_offset], lda, &work[itau], &work[nwork], &
1688 : i__1, &ierr);
1689 :
1690 0 : i__1 = *m - 1;
1691 0 : i__2 = *m - 1;
1692 0 : PLUMED_BLAS_F77_FUNC(dlaset,DLASET)("U", &i__1, &i__2, &zero, &zero, &a[(a_dim1*2) +
1693 0 : 1], lda);
1694 : ie = 1;
1695 0 : itauq = ie + *m;
1696 0 : itaup = itauq + *m;
1697 0 : nwork = itaup + *m;
1698 :
1699 0 : i__1 = *lwork - nwork + 1;
1700 0 : PLUMED_BLAS_F77_FUNC(dgebrd,DGEBRD)(m, m, &a[a_offset], lda, &s[1], &work[ie], &work[
1701 0 : itauq], &work[itaup], &work[nwork], &i__1, &ierr);
1702 0 : nwork = ie + *m;
1703 :
1704 0 : PLUMED_BLAS_F77_FUNC(dbdsdc,DBDSDC)("U", "N", m, &s[1], &work[ie], dum, &c__1, dum, &c__1,
1705 0 : dum, idum, &work[nwork], &iwork[1], info);
1706 :
1707 : } else {
1708 :
1709 : ivt = 1;
1710 :
1711 0 : ldwkvt = *m;
1712 0 : itau = ivt + ldwkvt * *m;
1713 0 : nwork = itau + *m;
1714 :
1715 0 : i__1 = *lwork - nwork + 1;
1716 0 : PLUMED_BLAS_F77_FUNC(dgelqf,DGELQF)(m, n, &a[a_offset], lda, &work[itau], &work[nwork], &
1717 : i__1, &ierr);
1718 0 : PLUMED_BLAS_F77_FUNC(dlacpy,DLACPY)("U", m, n, &a[a_offset], lda, &vt[vt_offset], ldvt);
1719 :
1720 0 : i__1 = *lwork - nwork + 1;
1721 0 : PLUMED_BLAS_F77_FUNC(dorglq,DORGLQ)(n, n, m, &vt[vt_offset], ldvt, &work[itau], &work[
1722 : nwork], &i__1, &ierr);
1723 :
1724 0 : i__1 = *m - 1;
1725 0 : i__2 = *m - 1;
1726 0 : PLUMED_BLAS_F77_FUNC(dlaset,DLASET)("U", &i__1, &i__2, &zero, &zero, &a[(a_dim1*2) +
1727 0 : 1], lda);
1728 : ie = itau;
1729 0 : itauq = ie + *m;
1730 0 : itaup = itauq + *m;
1731 0 : nwork = itaup + *m;
1732 :
1733 0 : i__1 = *lwork - nwork + 1;
1734 0 : PLUMED_BLAS_F77_FUNC(dgebrd,DGEBRD)(m, m, &a[a_offset], lda, &s[1], &work[ie], &work[
1735 0 : itauq], &work[itaup], &work[nwork], &i__1, &ierr);
1736 :
1737 0 : PLUMED_BLAS_F77_FUNC(dbdsdc,DBDSDC)("U", "I", m, &s[1], &work[ie], &u[u_offset], ldu, &
1738 : work[ivt], &ldwkvt, dum, idum, &work[nwork], &iwork[1]
1739 : , info);
1740 :
1741 0 : i__1 = *lwork - nwork + 1;
1742 0 : PLUMED_BLAS_F77_FUNC(dormbr,DORMBR)("Q", "L", "N", m, m, m, &a[a_offset], lda, &work[
1743 : itauq], &u[u_offset], ldu, &work[nwork], &i__1, &ierr);
1744 0 : i__1 = *lwork - nwork + 1;
1745 0 : PLUMED_BLAS_F77_FUNC(dormbr,DORMBR)("P", "R", "T", m, m, m, &a[a_offset], lda, &work[
1746 : itaup], &work[ivt], &ldwkvt, &work[nwork], &i__1, &
1747 : ierr);
1748 :
1749 0 : PLUMED_BLAS_F77_FUNC(dgemm,DGEMM)("N", "N", m, n, m, &one, &work[ivt], &ldwkvt, &vt[
1750 : vt_offset], ldvt, &zero, &a[a_offset], lda);
1751 :
1752 0 : PLUMED_BLAS_F77_FUNC(dlacpy,DLACPY)("F", m, n, &a[a_offset], lda, &vt[vt_offset], ldvt);
1753 :
1754 : }
1755 :
1756 : } else {
1757 :
1758 : ie = 1;
1759 0 : itauq = ie + *m;
1760 0 : itaup = itauq + *m;
1761 0 : nwork = itaup + *m;
1762 :
1763 0 : i__1 = *lwork - nwork + 1;
1764 0 : PLUMED_BLAS_F77_FUNC(dgebrd,DGEBRD)(m, n, &a[a_offset], lda, &s[1], &work[ie], &work[itauq], &
1765 0 : work[itaup], &work[nwork], &i__1, &ierr);
1766 0 : if (wntqn) {
1767 :
1768 0 : PLUMED_BLAS_F77_FUNC(dbdsdc,DBDSDC)("L", "N", m, &s[1], &work[ie], dum, &c__1, dum, &c__1,
1769 : dum, idum, &work[nwork], &iwork[1], info);
1770 : } else {
1771 0 : PLUMED_BLAS_F77_FUNC(dlaset,DLASET)("F", n, n, &zero, &zero, &vt[vt_offset], ldvt);
1772 0 : PLUMED_BLAS_F77_FUNC(dbdsdc,DBDSDC)("L", "I", m, &s[1], &work[ie], &u[u_offset], ldu, &vt[
1773 : vt_offset], ldvt, dum, idum, &work[nwork], &iwork[1],
1774 : info);
1775 :
1776 0 : i__1 = *n - *m;
1777 0 : i__2 = *n - *m;
1778 0 : PLUMED_BLAS_F77_FUNC(dlaset,DLASET)("F", &i__1, &i__2, &zero, &one, &vt[*m + 1 + (*m +
1779 0 : 1) * vt_dim1], ldvt);
1780 :
1781 0 : i__1 = *lwork - nwork + 1;
1782 0 : PLUMED_BLAS_F77_FUNC(dormbr,DORMBR)("Q", "L", "N", m, m, n, &a[a_offset], lda, &work[
1783 : itauq], &u[u_offset], ldu, &work[nwork], &i__1, &ierr);
1784 0 : i__1 = *lwork - nwork + 1;
1785 0 : PLUMED_BLAS_F77_FUNC(dormbr,DORMBR)("P", "R", "T", n, n, m, &a[a_offset], lda, &work[
1786 : itaup], &vt[vt_offset], ldvt, &work[nwork], &i__1, &
1787 : ierr);
1788 : }
1789 :
1790 : }
1791 :
1792 : }
1793 :
1794 96 : if (iscl == 1) {
1795 0 : if (anrm > bignum) {
1796 0 : PLUMED_BLAS_F77_FUNC(dlascl,DLASCL)("G", &c__0, &c__0, &bignum, &anrm, &minmn, &c__1, &s[1], &
1797 : minmn, &ierr);
1798 : }
1799 0 : if (anrm < smlnum) {
1800 0 : PLUMED_BLAS_F77_FUNC(dlascl,DLASCL)("G", &c__0, &c__0, &smlnum, &anrm, &minmn, &c__1, &s[1], &
1801 : minmn, &ierr);
1802 : }
1803 : }
1804 :
1805 96 : work[1] = (double) maxwrk;
1806 :
1807 96 : return;
1808 :
1809 : }
1810 :
1811 :
1812 : }
1813 : }
1814 : #include <cmath>
1815 : #include "real.h"
1816 :
1817 : #include "blas/blas.h"
1818 : #include "lapack.h"
1819 :
1820 :
1821 : #include "blas/blas.h"
1822 : namespace PLMD{
1823 : namespace lapack{
1824 : using namespace blas;
1825 : void
1826 57 : PLUMED_BLAS_F77_FUNC(dgetf2,DGETF2)(int *m,
1827 : int *n,
1828 : double *a,
1829 : int *lda,
1830 : int *ipiv,
1831 : int *info)
1832 : {
1833 : int j,jp,k,t1,t2,t3;
1834 : double minusone;
1835 : double tmp;
1836 :
1837 57 : minusone = -1.0;
1838 :
1839 57 : if(*m<=0 || *n<=0)
1840 : return;
1841 :
1842 : k = (*m < *n) ? *m : *n;
1843 171 : for(j=1;j<=k;j++) {
1844 114 : t1 = *m-j+1;
1845 114 : t2 = 1;
1846 114 : jp = j - 1 + PLUMED_BLAS_F77_FUNC(idamax,IDAMAX)(&t1,&(a[(j-1)*(*lda)+(j-1)]),&t2);
1847 114 : ipiv[j-1] = jp;
1848 114 : if( std::abs(a[(j-1)*(*lda)+(jp-1)])>PLUMED_GMX_DOUBLE_MIN ) {
1849 114 : if(jp != j)
1850 0 : PLUMED_BLAS_F77_FUNC(dswap,DSWAP)(n,&(a[ j-1 ]),lda,&(a[ jp-1 ]),lda);
1851 :
1852 114 : if(j<*m) {
1853 57 : t1 = *m-j;
1854 57 : t2 = 1;
1855 57 : tmp = 1.0/a[(j-1)*(*lda)+(j-1)];
1856 57 : PLUMED_BLAS_F77_FUNC(dscal,DSCAL)(&t1,&tmp,&(a[(j-1)*(*lda)+(j)]),&t2);
1857 : }
1858 : } else {
1859 0 : *info = j;
1860 : }
1861 :
1862 114 : if(j<k) {
1863 57 : t1 = *m-j;
1864 57 : t2 = *n-j;
1865 57 : t3 = 1;
1866 57 : PLUMED_BLAS_F77_FUNC(dger,DGER)(&t1,&t2,&minusone,&(a[(j-1)*(*lda)+(j)]),&t3,
1867 57 : &(a[(j)*(*lda)+(j-1)]),lda, &(a[(j)*(*lda)+(j)]),lda);
1868 : }
1869 : }
1870 : return;
1871 : }
1872 : }
1873 : }
1874 : #include "blas/blas.h"
1875 : #include "lapack.h"
1876 : #include "lapack_limits.h"
1877 :
1878 : #include "blas/blas.h"
1879 : namespace PLMD{
1880 : namespace lapack{
1881 : using namespace blas;
1882 : void
1883 57 : PLUMED_BLAS_F77_FUNC(dgetrf,DGETRF)(int *m,
1884 : int *n,
1885 : double *a,
1886 : int *lda,
1887 : int *ipiv,
1888 : int *info)
1889 : {
1890 : int mindim,jb;
1891 : int i,j,k,l;
1892 : int iinfo;
1893 57 : double minusone = -1.0;
1894 57 : double one = 1.0;
1895 :
1896 57 : if(*m<=0 || *n<=0)
1897 0 : return;
1898 :
1899 57 : *info = 0;
1900 :
1901 57 : mindim = (*m < *n) ? *m : *n;
1902 :
1903 57 : if(DGETRF_BLOCKSIZE>=mindim) {
1904 :
1905 : /* unblocked code */
1906 57 : PLUMED_BLAS_F77_FUNC(dgetf2,DGETF2)(m,n,a,lda,ipiv,info);
1907 :
1908 : } else {
1909 :
1910 : /* blocked case */
1911 :
1912 0 : for(j=1;j<=mindim;j+=DGETRF_BLOCKSIZE) {
1913 0 : jb = ( DGETRF_BLOCKSIZE < (mindim-j+1)) ? DGETRF_BLOCKSIZE : (mindim-j+1);
1914 : /* factor diag. and subdiag blocks and test for singularity */
1915 0 : k = *m-j+1;
1916 0 : PLUMED_BLAS_F77_FUNC(dgetf2,DGETF2)(&k,&jb,&(a[(j-1)*(*lda)+(j-1)]),lda,&(ipiv[j-1]),&iinfo);
1917 :
1918 0 : if(*info==0 && iinfo>0)
1919 0 : *info = iinfo + j - 1;
1920 :
1921 : /* adjust pivot indices */
1922 0 : k = (*m < (j+jb-1)) ? *m : (j+jb-1);
1923 0 : for(i=j;i<=k;i++)
1924 0 : ipiv[i-1] += j - 1;
1925 :
1926 : /* Apply to columns 1 throughj j-1 */
1927 0 : k = j - 1;
1928 0 : i = j + jb - 1;
1929 0 : l = 1;
1930 0 : PLUMED_BLAS_F77_FUNC(dlaswp,DLASWP)(&k,a,lda,&j,&i,ipiv,&l);
1931 0 : if((j+jb)<=*n) {
1932 : /* Apply to cols. j+jb through n */
1933 0 : k = *n-j-jb+1;
1934 0 : i = j+jb-1;
1935 0 : l = 1;
1936 0 : PLUMED_BLAS_F77_FUNC(dlaswp,DLASWP)(&k,&(a[(j+jb-1)*(*lda)+0]),lda,&j,&i,ipiv,&l);
1937 : /* Compute block row of U */
1938 0 : k = *n-j-jb+1;
1939 0 : PLUMED_BLAS_F77_FUNC(dtrsm,DTRSM)("Left","Lower","No transpose","Unit",&jb,&k,&one,
1940 0 : &(a[(j-1)*(*lda)+(j-1)]),lda,&(a[(j+jb-1)*(*lda)+(j-1)]),lda);
1941 :
1942 0 : if((j+jb)<=*m) {
1943 : /* Update trailing submatrix */
1944 0 : k = *m-j-jb+1;
1945 0 : i = *n-j-jb+1;
1946 0 : PLUMED_BLAS_F77_FUNC(dgemm,DGEMM)("No transpose","No transpose",&k,&i,&jb,&minusone,
1947 0 : &(a[(j-1)*(*lda)+(j+jb-1)]),lda,
1948 0 : &(a[(j+jb-1)*(*lda)+(j-1)]),lda,&one,
1949 0 : &(a[(j+jb-1)*(*lda)+(j+jb-1)]),lda);
1950 : }
1951 :
1952 : }
1953 : }
1954 : }
1955 : }
1956 : }
1957 : }
1958 : #include "blas/blas.h"
1959 : #include "lapack.h"
1960 : #include "lapack_limits.h"
1961 :
1962 : #include "blas/blas.h"
1963 : namespace PLMD{
1964 : namespace lapack{
1965 : using namespace blas;
1966 : void
1967 114 : PLUMED_BLAS_F77_FUNC(dgetri,DGETRI)(int *n,
1968 : double *a,
1969 : int *lda,
1970 : int *ipiv,
1971 : double *work,
1972 : int *lwork,
1973 : int *info)
1974 : {
1975 : int a_dim1, a_offset, i__1, i__2, i__3;
1976 :
1977 : int i__, j, jb, nb, jj, jp, nn, iws;
1978 : int nbmin;
1979 : int ldwork;
1980 : int lwkopt;
1981 114 : int c__1 = 1;
1982 114 : double c_b20 = -1.;
1983 114 : double c_b22 = 1.;
1984 :
1985 114 : a_dim1 = *lda;
1986 114 : a_offset = 1 + a_dim1;
1987 114 : a -= a_offset;
1988 : --ipiv;
1989 114 : --work;
1990 :
1991 114 : *info = 0;
1992 : nb = DGETRI_BLOCKSIZE;
1993 114 : lwkopt = *n * nb;
1994 114 : work[1] = (double) lwkopt;
1995 :
1996 114 : if (*n < 0) {
1997 0 : *info = -1;
1998 114 : } else if (*lda < (*n)) {
1999 0 : *info = -3;
2000 114 : } else if (*lwork < (*n) && *lwork!=-1) {
2001 0 : *info = -6;
2002 : }
2003 114 : if (*info != 0) {
2004 : i__1 = -(*info);
2005 : return;
2006 114 : } else if (*lwork == -1) {
2007 : return;
2008 : }
2009 :
2010 57 : if (*n == 0) {
2011 : return;
2012 : }
2013 :
2014 57 : PLUMED_BLAS_F77_FUNC(dtrtri,DTRTRI)("Upper", "Non-unit", n, &a[a_offset], lda, info);
2015 57 : if (*info > 0) {
2016 : return;
2017 : }
2018 :
2019 : nbmin = 2;
2020 57 : ldwork = *n;
2021 57 : if (nb > 1 && nb < *n) {
2022 0 : i__1 = ldwork * nb;
2023 0 : iws = (i__1>1) ? i__1 : 1;
2024 0 : if (*lwork < iws) {
2025 0 : nb = *lwork / ldwork;
2026 : nbmin = DGETRI_MINBLOCKSIZE;
2027 : }
2028 : } else {
2029 : iws = *n;
2030 : }
2031 :
2032 57 : if (nb < nbmin || nb >= *n) {
2033 :
2034 171 : for (j = *n; j >= 1; --j) {
2035 :
2036 114 : i__1 = *n;
2037 171 : for (i__ = j + 1; i__ <= i__1; ++i__) {
2038 57 : work[i__] = a[i__ + j * a_dim1];
2039 57 : a[i__ + j * a_dim1] = 0.;
2040 : }
2041 :
2042 114 : if (j < *n) {
2043 57 : i__1 = *n - j;
2044 57 : PLUMED_BLAS_F77_FUNC(dgemv,DGEMV)("No transpose", n, &i__1, &c_b20, &a[(j + 1) * a_dim1
2045 57 : + 1], lda, &work[j + 1], &c__1, &c_b22, &a[j * a_dim1
2046 57 : + 1], &c__1);
2047 : }
2048 : }
2049 : } else {
2050 :
2051 0 : nn = (*n - 1) / nb * nb + 1;
2052 0 : i__1 = -nb;
2053 0 : for (j = nn; i__1 < 0 ? j >= 1 : j <= 1; j += i__1) {
2054 0 : i__2 = nb, i__3 = *n - j + 1;
2055 0 : jb = (i__2<i__3) ? i__2 : i__3;
2056 :
2057 0 : i__2 = j + jb - 1;
2058 0 : for (jj = j; jj <= i__2; ++jj) {
2059 0 : i__3 = *n;
2060 0 : for (i__ = jj + 1; i__ <= i__3; ++i__) {
2061 0 : work[i__ + (jj - j) * ldwork] = a[i__ + jj * a_dim1];
2062 0 : a[i__ + jj * a_dim1] = 0.;
2063 : }
2064 : }
2065 :
2066 0 : if (j + jb <= *n) {
2067 0 : i__2 = *n - j - jb + 1;
2068 0 : PLUMED_BLAS_F77_FUNC(dgemm,DGEMM)("No transpose", "No transpose", n, &jb, &i__2, &c_b20,
2069 0 : &a[(j + jb) * a_dim1 + 1], lda, &work[j + jb], &
2070 0 : ldwork, &c_b22, &a[j * a_dim1 + 1], lda);
2071 : }
2072 0 : PLUMED_BLAS_F77_FUNC(dtrsm,DTRSM)("Right", "Lower", "No transpose", "Unit", n, &jb, &c_b22, &
2073 0 : work[j], &ldwork, &a[j * a_dim1 + 1], lda);
2074 : }
2075 : }
2076 :
2077 114 : for (j = *n - 1; j >= 1; --j) {
2078 57 : jp = ipiv[j];
2079 57 : if (jp != j) {
2080 0 : PLUMED_BLAS_F77_FUNC(dswap,DSWAP)(n, &a[j * a_dim1 + 1], &c__1, &a[jp * a_dim1 + 1], &c__1);
2081 : }
2082 : }
2083 :
2084 57 : work[1] = (double) iws;
2085 57 : return;
2086 :
2087 : }
2088 :
2089 :
2090 : }
2091 : }
2092 : #include "blas/blas.h"
2093 : #include "lapack.h"
2094 :
2095 : #include "blas/blas.h"
2096 : namespace PLMD{
2097 : namespace lapack{
2098 : using namespace blas;
2099 : void
2100 0 : PLUMED_BLAS_F77_FUNC(dgetrs,DGETRS)(const char *trans,
2101 : int *n,
2102 : int *nrhs,
2103 : double *a,
2104 : int *lda,
2105 : int *ipiv,
2106 : double *b,
2107 : int *ldb,
2108 : int *info)
2109 : {
2110 : int a_dim1, a_offset, b_dim1, b_offset;
2111 : int notran;
2112 0 : int c__1 = 1;
2113 0 : int c_n1 = -1;
2114 0 : double one = 1.0;
2115 :
2116 : a_dim1 = *lda;
2117 : a_offset = 1 + a_dim1;
2118 : a -= a_offset;
2119 : --ipiv;
2120 : b_dim1 = *ldb;
2121 : b_offset = 1 + b_dim1;
2122 : b -= b_offset;
2123 :
2124 0 : *info = 0;
2125 0 : notran = (*trans=='N' || *trans=='n');
2126 :
2127 0 : if (*n <= 0 || *nrhs <= 0)
2128 : return;
2129 :
2130 0 : if (notran) {
2131 0 : PLUMED_BLAS_F77_FUNC(dlaswp,DLASWP)(nrhs, &b[b_offset], ldb, &c__1, n, &ipiv[1], &c__1);
2132 0 : PLUMED_BLAS_F77_FUNC(dtrsm,DTRSM)("Left", "Lower", "No transpose", "Unit", n, nrhs, &one,
2133 : &a[a_offset], lda, &b[b_offset], ldb);
2134 :
2135 0 : PLUMED_BLAS_F77_FUNC(dtrsm,DTRSM)("Left", "Upper", "No transpose", "Non-unit", n, nrhs, &one,
2136 : &a[a_offset], lda, &b[b_offset], ldb);
2137 : } else {
2138 0 : PLUMED_BLAS_F77_FUNC(dtrsm,DTRSM)("Left", "Upper", "Transpose", "Non-unit", n, nrhs, &one,
2139 : &a[a_offset], lda, &b[b_offset], ldb);
2140 0 : PLUMED_BLAS_F77_FUNC(dtrsm,DTRSM)("Left", "Lower", "Transpose", "Unit", n, nrhs, &one,
2141 : &a[a_offset], lda, &b[b_offset], ldb);
2142 :
2143 0 : PLUMED_BLAS_F77_FUNC(dlaswp,DLASWP)(nrhs, &b[b_offset], ldb, &c__1, n, &ipiv[1], &c_n1);
2144 : }
2145 :
2146 : return;
2147 :
2148 : }
2149 : }
2150 : }
2151 : #include <cmath>
2152 : #include "blas/blas.h"
2153 : #include "lapack.h"
2154 :
2155 :
2156 : #include "blas/blas.h"
2157 : namespace PLMD{
2158 : namespace lapack{
2159 : using namespace blas;
2160 : void
2161 12 : PLUMED_BLAS_F77_FUNC(dlabrd,DLABRD)(int *m,
2162 : int *n,
2163 : int *nb,
2164 : double *a,
2165 : int *lda,
2166 : double *d__,
2167 : double *e,
2168 : double *tauq,
2169 : double *taup,
2170 : double *x,
2171 : int *ldx,
2172 : double *y,
2173 : int *ldy)
2174 : {
2175 : int a_dim1, a_offset, x_dim1, x_offset, y_dim1, y_offset;
2176 : int i__1, i__2, i__3;
2177 12 : double one = 1.0;
2178 12 : double minusone = -1.0;
2179 12 : double zero = 0.0;
2180 12 : int c__1 = 1;
2181 : int i__;
2182 :
2183 12 : a_dim1 = *lda;
2184 12 : a_offset = 1 + a_dim1;
2185 12 : a -= a_offset;
2186 12 : --d__;
2187 12 : --e;
2188 12 : --tauq;
2189 12 : --taup;
2190 12 : x_dim1 = *ldx;
2191 12 : x_offset = 1 + x_dim1;
2192 12 : x -= x_offset;
2193 12 : y_dim1 = *ldy;
2194 12 : y_offset = 1 + y_dim1;
2195 12 : y -= y_offset;
2196 :
2197 12 : if (*m <= 0 || *n <= 0) {
2198 : return;
2199 : }
2200 :
2201 12 : if (*m >= *n) {
2202 :
2203 12 : i__1 = *nb;
2204 396 : for (i__ = 1; i__ <= i__1; ++i__) {
2205 :
2206 384 : i__2 = *m - i__ + 1;
2207 384 : i__3 = i__ - 1;
2208 384 : PLUMED_BLAS_F77_FUNC(dgemv,DGEMV)("No transpose", &i__2, &i__3, &minusone, &a[i__ + a_dim1], lda,
2209 384 : &y[i__ + y_dim1], ldy, &one, &a[i__ + i__ * a_dim1], &c__1);
2210 384 : i__2 = *m - i__ + 1;
2211 384 : i__3 = i__ - 1;
2212 384 : PLUMED_BLAS_F77_FUNC(dgemv,DGEMV)("No transpose", &i__2, &i__3, &minusone, &x[i__ + x_dim1], ldx,
2213 384 : &a[i__*a_dim1+1],&c__1,&one,&a[i__+i__*a_dim1],&c__1);
2214 :
2215 384 : i__2 = *m - i__ + 1;
2216 384 : i__3 = i__ + 1;
2217 384 : if(*m<i__3)
2218 0 : i__3 = *m;
2219 384 : PLUMED_BLAS_F77_FUNC(dlarfg,DLARFG)(&i__2, &a[i__ + i__ * a_dim1], &a[i__3 + i__ * a_dim1],
2220 384 : &c__1, &tauq[i__]);
2221 384 : d__[i__] = a[i__ + i__ * a_dim1];
2222 384 : if (i__ < *n) {
2223 384 : a[i__ + i__ * a_dim1] = 1.;
2224 :
2225 384 : i__2 = *m - i__ + 1;
2226 384 : i__3 = *n - i__;
2227 384 : PLUMED_BLAS_F77_FUNC(dgemv,DGEMV)("Transpose", &i__2, &i__3, &one, &a[i__ + (i__ + 1) *
2228 384 : a_dim1], lda, &a[i__ + i__ * a_dim1], &c__1, &zero, &
2229 384 : y[i__ + 1 + i__ * y_dim1], &c__1);
2230 384 : i__2 = *m - i__ + 1;
2231 384 : i__3 = i__ - 1;
2232 384 : PLUMED_BLAS_F77_FUNC(dgemv,DGEMV)("Transpose", &i__2, &i__3, &one, &a[i__ + a_dim1],
2233 384 : lda, &a[i__ + i__ * a_dim1], &c__1, &zero, &y[i__ *
2234 384 : y_dim1 + 1], &c__1);
2235 384 : i__2 = *n - i__;
2236 384 : i__3 = i__ - 1;
2237 384 : PLUMED_BLAS_F77_FUNC(dgemv,DGEMV)("No transpose", &i__2, &i__3, &minusone, &y[i__ + 1 +
2238 384 : y_dim1], ldy, &y[i__ * y_dim1 + 1], &c__1, &one, &y[
2239 384 : i__ + 1 + i__ * y_dim1], &c__1);
2240 384 : i__2 = *m - i__ + 1;
2241 384 : i__3 = i__ - 1;
2242 384 : PLUMED_BLAS_F77_FUNC(dgemv,DGEMV)("Transpose", &i__2, &i__3, &one, &x[i__ + x_dim1],
2243 384 : ldx, &a[i__ + i__ * a_dim1], &c__1, &zero, &y[i__ *
2244 384 : y_dim1 + 1], &c__1);
2245 384 : i__2 = i__ - 1;
2246 384 : i__3 = *n - i__;
2247 384 : PLUMED_BLAS_F77_FUNC(dgemv,DGEMV)("Transpose", &i__2, &i__3, &minusone, &a[(i__ + 1) *
2248 384 : a_dim1 + 1], lda, &y[i__ * y_dim1 + 1], &c__1, &one,
2249 384 : &y[i__ + 1 + i__ * y_dim1], &c__1);
2250 384 : i__2 = *n - i__;
2251 384 : PLUMED_BLAS_F77_FUNC(dscal,DSCAL)(&i__2, &tauq[i__], &y[i__ + 1 + i__ * y_dim1], &c__1);
2252 :
2253 384 : i__2 = *n - i__;
2254 384 : PLUMED_BLAS_F77_FUNC(dgemv,DGEMV)("No transpose", &i__2, &i__, &minusone, &y[i__ + 1 +
2255 384 : y_dim1], ldy, &a[i__ + a_dim1], lda, &one, &a[i__ + (
2256 384 : i__ + 1) * a_dim1], lda);
2257 384 : i__2 = i__ - 1;
2258 384 : i__3 = *n - i__;
2259 384 : PLUMED_BLAS_F77_FUNC(dgemv,DGEMV)("Transpose", &i__2, &i__3, &minusone, &a[(i__ + 1) *
2260 384 : a_dim1 + 1], lda, &x[i__ + x_dim1], ldx, &one, &a[
2261 384 : i__ + (i__ + 1) * a_dim1], lda);
2262 :
2263 384 : i__2 = *n - i__;
2264 384 : i__3 = i__ + 2;
2265 384 : if(*n<i__3)
2266 0 : i__3 = *n;
2267 384 : PLUMED_BLAS_F77_FUNC(dlarfg,DLARFG)(&i__2, &a[i__ + (i__ + 1) * a_dim1],
2268 384 : &a[i__ + i__3 * a_dim1], lda, &taup[i__]);
2269 384 : e[i__] = a[i__ + (i__ + 1) * a_dim1];
2270 384 : a[i__ + (i__ + 1) * a_dim1] = 1.;
2271 :
2272 384 : i__2 = *m - i__;
2273 384 : i__3 = *n - i__;
2274 384 : PLUMED_BLAS_F77_FUNC(dgemv,DGEMV)("No transpose", &i__2, &i__3, &one, &a[i__ + 1 + (i__
2275 384 : + 1) * a_dim1], lda, &a[i__ + (i__ + 1) * a_dim1],
2276 384 : lda, &zero, &x[i__ + 1 + i__ * x_dim1], &c__1);
2277 384 : i__2 = *n - i__;
2278 384 : PLUMED_BLAS_F77_FUNC(dgemv,DGEMV)("Transpose", &i__2, &i__, &one, &y[i__ + 1 + y_dim1],
2279 384 : ldy, &a[i__ + (i__ + 1) * a_dim1], lda, &zero, &x[
2280 384 : i__ * x_dim1 + 1], &c__1);
2281 384 : i__2 = *m - i__;
2282 384 : PLUMED_BLAS_F77_FUNC(dgemv,DGEMV)("No transpose", &i__2, &i__, &minusone, &a[i__ + 1 +
2283 384 : a_dim1], lda, &x[i__ * x_dim1 + 1], &c__1, &one, &x[
2284 384 : i__ + 1 + i__ * x_dim1], &c__1);
2285 384 : i__2 = i__ - 1;
2286 384 : i__3 = *n - i__;
2287 384 : PLUMED_BLAS_F77_FUNC(dgemv,DGEMV)("No transpose", &i__2, &i__3, &one, &a[(i__ + 1) *
2288 384 : a_dim1 + 1], lda, &a[i__ + (i__ + 1) * a_dim1], lda, &
2289 384 : zero, &x[i__ * x_dim1 + 1], &c__1);
2290 384 : i__2 = *m - i__;
2291 384 : i__3 = i__ - 1;
2292 384 : PLUMED_BLAS_F77_FUNC(dgemv,DGEMV)("No transpose", &i__2, &i__3, &minusone, &x[i__ + 1 +
2293 384 : x_dim1], ldx, &x[i__ * x_dim1 + 1], &c__1, &one, &x[
2294 384 : i__ + 1 + i__ * x_dim1], &c__1);
2295 384 : i__2 = *m - i__;
2296 384 : PLUMED_BLAS_F77_FUNC(dscal,DSCAL)(&i__2, &taup[i__], &x[i__ + 1 + i__ * x_dim1], &c__1);
2297 : }
2298 : }
2299 : } else {
2300 :
2301 0 : i__1 = *nb;
2302 0 : for (i__ = 1; i__ <= i__1; ++i__) {
2303 :
2304 0 : i__2 = *n - i__ + 1;
2305 0 : i__3 = i__ - 1;
2306 0 : PLUMED_BLAS_F77_FUNC(dgemv,DGEMV)("No transpose", &i__2, &i__3, &minusone, &y[i__ + y_dim1], ldy,
2307 0 : &a[i__ + a_dim1], lda, &one, &a[i__ + i__ * a_dim1],lda);
2308 0 : i__2 = i__ - 1;
2309 0 : i__3 = *n - i__ + 1;
2310 0 : PLUMED_BLAS_F77_FUNC(dgemv,DGEMV)("Transpose", &i__2, &i__3, &minusone, &a[i__ * a_dim1 + 1],
2311 0 : lda, &x[i__ + x_dim1], ldx, &one,&a[i__+i__*a_dim1],lda);
2312 :
2313 0 : i__2 = *n - i__ + 1;
2314 0 : i__3 = i__ + 1;
2315 0 : if(*n<i__3)
2316 0 : i__3 = *n;
2317 0 : PLUMED_BLAS_F77_FUNC(dlarfg,DLARFG)(&i__2, &a[i__ + i__ * a_dim1],
2318 0 : &a[i__ + i__3 * a_dim1], lda, &taup[i__]);
2319 0 : d__[i__] = a[i__ + i__ * a_dim1];
2320 0 : if (i__ < *m) {
2321 0 : a[i__ + i__ * a_dim1] = 1.;
2322 :
2323 0 : i__2 = *m - i__;
2324 0 : i__3 = *n - i__ + 1;
2325 0 : PLUMED_BLAS_F77_FUNC(dgemv,DGEMV)("No transpose",&i__2,&i__3,&one,&a[i__+1+i__*a_dim1],
2326 : lda, &a[i__ + i__ * a_dim1], lda, &zero,
2327 0 : &x[i__ + 1 + i__ * x_dim1], &c__1);
2328 0 : i__2 = *n - i__ + 1;
2329 0 : i__3 = i__ - 1;
2330 0 : PLUMED_BLAS_F77_FUNC(dgemv,DGEMV)("Transpose", &i__2, &i__3, &one, &y[i__ + y_dim1],
2331 0 : ldy, &a[i__ + i__ * a_dim1], lda, &zero, &x[i__ *
2332 0 : x_dim1 + 1], &c__1);
2333 0 : i__2 = *m - i__;
2334 0 : i__3 = i__ - 1;
2335 0 : PLUMED_BLAS_F77_FUNC(dgemv,DGEMV)("No transpose", &i__2, &i__3, &minusone, &a[i__ + 1 +
2336 0 : a_dim1], lda, &x[i__ * x_dim1 + 1], &c__1, &one, &x[
2337 0 : i__ + 1 + i__ * x_dim1], &c__1);
2338 0 : i__2 = i__ - 1;
2339 0 : i__3 = *n - i__ + 1;
2340 0 : PLUMED_BLAS_F77_FUNC(dgemv,DGEMV)("No transpose", &i__2, &i__3, &one, &a[i__ * a_dim1 +
2341 0 : 1], lda, &a[i__ + i__ * a_dim1], lda, &zero, &x[i__ *
2342 0 : x_dim1 + 1], &c__1);
2343 0 : i__2 = *m - i__;
2344 0 : i__3 = i__ - 1;
2345 0 : PLUMED_BLAS_F77_FUNC(dgemv,DGEMV)("No transpose", &i__2, &i__3, &minusone, &x[i__ + 1 +
2346 0 : x_dim1], ldx, &x[i__ * x_dim1 + 1], &c__1, &one, &x[
2347 0 : i__ + 1 + i__ * x_dim1], &c__1);
2348 0 : i__2 = *m - i__;
2349 0 : PLUMED_BLAS_F77_FUNC(dscal,DSCAL)(&i__2, &taup[i__], &x[i__ + 1 + i__ * x_dim1], &c__1);
2350 :
2351 0 : i__2 = *m - i__;
2352 0 : i__3 = i__ - 1;
2353 0 : PLUMED_BLAS_F77_FUNC(dgemv,DGEMV)("No transpose", &i__2, &i__3, &minusone, &a[i__ + 1 +
2354 0 : a_dim1], lda, &y[i__ + y_dim1], ldy, &one, &a[i__ +
2355 0 : 1 + i__ * a_dim1], &c__1);
2356 0 : i__2 = *m - i__;
2357 0 : PLUMED_BLAS_F77_FUNC(dgemv,DGEMV)("No transpose", &i__2, &i__, &minusone, &x[i__ + 1 +
2358 0 : x_dim1], ldx, &a[i__ * a_dim1 + 1], &c__1, &one, &a[
2359 0 : i__ + 1 + i__ * a_dim1], &c__1);
2360 :
2361 0 : i__2 = *m - i__;
2362 0 : i__3 = i__ + 2;
2363 0 : if(*m<i__3)
2364 0 : i__3 = *m;
2365 0 : PLUMED_BLAS_F77_FUNC(dlarfg,DLARFG)(&i__2, &a[i__ + 1 + i__ * a_dim1],
2366 0 : &a[i__3 + i__ * a_dim1], &c__1, &tauq[i__]);
2367 0 : e[i__] = a[i__ + 1 + i__ * a_dim1];
2368 0 : a[i__ + 1 + i__ * a_dim1] = 1.;
2369 :
2370 0 : i__2 = *m - i__;
2371 0 : i__3 = *n - i__;
2372 0 : PLUMED_BLAS_F77_FUNC(dgemv,DGEMV)("Transpose", &i__2, &i__3, &one, &a[i__ + 1 + (i__ +
2373 0 : 1) * a_dim1], lda, &a[i__ + 1 + i__ * a_dim1], &c__1,
2374 0 : &zero, &y[i__ + 1 + i__ * y_dim1], &c__1);
2375 0 : i__2 = *m - i__;
2376 0 : i__3 = i__ - 1;
2377 0 : PLUMED_BLAS_F77_FUNC(dgemv,DGEMV)("Transpose", &i__2, &i__3, &one, &a[i__ + 1 + a_dim1],
2378 0 : lda, &a[i__ + 1 + i__ * a_dim1], &c__1, &zero, &y[
2379 0 : i__ * y_dim1 + 1], &c__1);
2380 0 : i__2 = *n - i__;
2381 0 : i__3 = i__ - 1;
2382 0 : PLUMED_BLAS_F77_FUNC(dgemv,DGEMV)("No transpose", &i__2, &i__3, &minusone, &y[i__ + 1 +
2383 0 : y_dim1], ldy, &y[i__ * y_dim1 + 1], &c__1, &one, &y[
2384 0 : i__ + 1 + i__ * y_dim1], &c__1);
2385 0 : i__2 = *m - i__;
2386 0 : PLUMED_BLAS_F77_FUNC(dgemv,DGEMV)("Transpose", &i__2, &i__, &one, &x[i__ + 1 + x_dim1],
2387 0 : ldx, &a[i__ + 1 + i__ * a_dim1], &c__1, &zero, &y[
2388 0 : i__ * y_dim1 + 1], &c__1);
2389 0 : i__2 = *n - i__;
2390 0 : PLUMED_BLAS_F77_FUNC(dgemv,DGEMV)("Transpose", &i__, &i__2, &minusone, &a[(i__ + 1) * a_dim1
2391 0 : + 1], lda, &y[i__ * y_dim1 + 1], &c__1, &one, &y[i__
2392 0 : + 1 + i__ * y_dim1], &c__1);
2393 0 : i__2 = *n - i__;
2394 0 : PLUMED_BLAS_F77_FUNC(dscal,DSCAL)(&i__2, &tauq[i__], &y[i__ + 1 + i__ * y_dim1], &c__1);
2395 : }
2396 : }
2397 : }
2398 : return;
2399 : }
2400 :
2401 : }
2402 : }
2403 : #include <cctype>
2404 : #include "lapack.h"
2405 :
2406 : /* LAPACK */
2407 : #include "blas/blas.h"
2408 : namespace PLMD{
2409 : namespace lapack{
2410 : using namespace blas;
2411 : void
2412 54 : PLUMED_BLAS_F77_FUNC(dlacpy,DLACPY)(const char *uplo,
2413 : int *m,
2414 : int *n,
2415 : double *a,
2416 : int *lda,
2417 : double *b,
2418 : int *ldb)
2419 : {
2420 : int i,j,minjm;
2421 54 : const char ch=std::toupper(*uplo);
2422 :
2423 54 : if(ch=='U') {
2424 0 : for(j=0;j<*n;j++) {
2425 0 : minjm = (j < (*m-1)) ? j : (*m-1);
2426 0 : for(i=0;i<=minjm;i++)
2427 0 : b[j*(*ldb)+i] = a[j*(*lda)+i];
2428 : }
2429 54 : } else if(ch=='L') {
2430 3 : for(j=0;j<*n;j++) {
2431 7 : for(i=j;i<*m;i++)
2432 5 : b[j*(*ldb)+i] = a[j*(*lda)+i];
2433 : }
2434 : } else {
2435 2222 : for(j=0;j<*n;j++) {
2436 99977 : for(i=0;i<*m;i++)
2437 97808 : b[j*(*ldb)+i] = a[j*(*lda)+i];
2438 : }
2439 : }
2440 54 : }
2441 : }
2442 : }
2443 : #include <cmath>
2444 : #include "lapack.h"
2445 :
2446 :
2447 : #include "blas/blas.h"
2448 : namespace PLMD{
2449 : namespace lapack{
2450 : using namespace blas;
2451 : void
2452 0 : PLUMED_BLAS_F77_FUNC(dlae2,DLAE2)(double *a,
2453 : double *b,
2454 : double *c__,
2455 : double *rt1,
2456 : double *rt2)
2457 : {
2458 : double d__1;
2459 : double ab, df, tb, sm, rt, adf, acmn, acmx;
2460 :
2461 :
2462 0 : sm = *a + *c__;
2463 0 : df = *a - *c__;
2464 : adf = std::abs(df);
2465 0 : tb = *b + *b;
2466 : ab = std::abs(tb);
2467 0 : if (std::abs(*a) > std::abs(*c__)) {
2468 : acmx = *a;
2469 : acmn = *c__;
2470 : } else {
2471 : acmx = *c__;
2472 : acmn = *a;
2473 : }
2474 0 : if (adf > ab) {
2475 0 : d__1 = ab / adf;
2476 0 : rt = adf * std::sqrt(d__1 * d__1 + 1.);
2477 0 : } else if (adf < ab) {
2478 0 : d__1 = adf / ab;
2479 0 : rt = ab * std::sqrt(d__1 * d__1 + 1.);
2480 : } else {
2481 :
2482 0 : rt = ab * std::sqrt(2.);
2483 : }
2484 0 : if (sm < 0.) {
2485 0 : *rt1 = (sm - rt) * .5;
2486 0 : *rt2 = acmx / *rt1 * acmn - *b / *rt1 * *b;
2487 0 : } else if (sm > 0.) {
2488 0 : *rt1 = (sm + rt) * .5;
2489 0 : *rt2 = acmx / *rt1 * acmn - *b / *rt1 * *b;
2490 : } else {
2491 0 : *rt1 = rt * .5;
2492 0 : *rt2 = rt * -.5;
2493 : }
2494 0 : return;
2495 :
2496 : }
2497 :
2498 :
2499 : }
2500 : }
2501 : #include <cmath>
2502 : #include "lapack.h"
2503 :
2504 : #include "blas/blas.h"
2505 : namespace PLMD{
2506 : namespace lapack{
2507 : using namespace blas;
2508 : void
2509 0 : PLUMED_BLAS_F77_FUNC(dlaebz,DLAEBZ)(int *ijob,
2510 : int *nitmax,
2511 : int *n,
2512 : int *mmax,
2513 : int *minp,
2514 : int *nbmin,
2515 : double *abstol,
2516 : double *reltol,
2517 : double *pivmin,
2518 : double *d__,
2519 : double *e,
2520 : double *e2,
2521 : int *nval,
2522 : double *ab,
2523 : double *c__,
2524 : int *mout,
2525 : int *nab,
2526 : double *work,
2527 : int *iwork,
2528 : int *info)
2529 : {
2530 : int nab_dim1, nab_offset, ab_dim1, ab_offset, i__1, i__2, i__3, i__4,
2531 : i__5, i__6;
2532 : double d__1, d__2, d__3, d__4;
2533 :
2534 : int j, kf, ji, kl, jp, jit;
2535 : double tmp1, tmp2;
2536 : int itmp1, itmp2, kfnew, klnew;
2537 :
2538 0 : nab_dim1 = *mmax;
2539 0 : nab_offset = 1 + nab_dim1;
2540 0 : nab -= nab_offset;
2541 : ab_dim1 = *mmax;
2542 : ab_offset = 1 + ab_dim1;
2543 0 : ab -= ab_offset;
2544 0 : --d__;
2545 : --e;
2546 0 : --e2;
2547 0 : --nval;
2548 0 : --c__;
2549 0 : --work;
2550 0 : --iwork;
2551 :
2552 0 : *info = 0;
2553 0 : if (*ijob < 1 || *ijob > 3) {
2554 0 : *info = -1;
2555 0 : return;
2556 : }
2557 :
2558 0 : if (*ijob == 1) {
2559 :
2560 0 : *mout = 0;
2561 :
2562 0 : i__1 = *minp;
2563 0 : for (ji = 1; ji <= i__1; ++ji) {
2564 0 : for (jp = 1; jp <= 2; ++jp) {
2565 0 : tmp1 = d__[1] - ab[ji + jp * ab_dim1];
2566 0 : if (std::abs(tmp1) < *pivmin) {
2567 0 : tmp1 = -(*pivmin);
2568 : }
2569 0 : nab[ji + jp * nab_dim1] = 0;
2570 0 : if (tmp1 <= 0.) {
2571 0 : nab[ji + jp * nab_dim1] = 1;
2572 : }
2573 :
2574 0 : i__2 = *n;
2575 0 : for (j = 2; j <= i__2; ++j) {
2576 0 : tmp1 = d__[j] - e2[j - 1] / tmp1 - ab[ji + jp * ab_dim1];
2577 0 : if (std::abs(tmp1) < *pivmin) {
2578 0 : tmp1 = -(*pivmin);
2579 : }
2580 0 : if (tmp1 <= 0.) {
2581 0 : ++nab[ji + jp * nab_dim1];
2582 : }
2583 : }
2584 : }
2585 0 : *mout = *mout + nab[ji + (nab_dim1 << 1)] - nab[ji + nab_dim1];
2586 : }
2587 : return;
2588 : }
2589 :
2590 : kf = 1;
2591 0 : kl = *minp;
2592 :
2593 0 : if (*ijob == 2) {
2594 : i__1 = *minp;
2595 0 : for (ji = 1; ji <= i__1; ++ji) {
2596 0 : c__[ji] = (ab[ji + ab_dim1] + ab[ji + (ab_dim1 << 1)]) * .5;
2597 : }
2598 : }
2599 :
2600 0 : i__1 = *nitmax;
2601 0 : for (jit = 1; jit <= i__1; ++jit) {
2602 :
2603 0 : if (kl - kf + 1 >= *nbmin && *nbmin > 0) {
2604 :
2605 : i__2 = kl;
2606 0 : for (ji = kf; ji <= i__2; ++ji) {
2607 :
2608 0 : work[ji] = d__[1] - c__[ji];
2609 0 : iwork[ji] = 0;
2610 0 : if (work[ji] <= *pivmin) {
2611 0 : iwork[ji] = 1;
2612 0 : d__1 = work[ji], d__2 = -(*pivmin);
2613 0 : work[ji] = (d__1<d__2) ? d__1 : d__2;
2614 : }
2615 :
2616 0 : i__3 = *n;
2617 0 : for (j = 2; j <= i__3; ++j) {
2618 0 : work[ji] = d__[j] - e2[j - 1] / work[ji] - c__[ji];
2619 0 : if (work[ji] <= *pivmin) {
2620 0 : ++iwork[ji];
2621 0 : d__1 = work[ji], d__2 = -(*pivmin);
2622 0 : work[ji] = (d__1<d__2) ? d__1 : d__2;
2623 : }
2624 : }
2625 : }
2626 :
2627 0 : if (*ijob <= 2) {
2628 :
2629 : klnew = kl;
2630 : i__2 = kl;
2631 0 : for (ji = kf; ji <= i__2; ++ji) {
2632 :
2633 0 : i__5 = nab[ji + nab_dim1];
2634 0 : i__6 = iwork[ji];
2635 0 : i__3 = nab[ji + (nab_dim1 << 1)];
2636 : i__4 = (i__5>i__6) ? i__5 : i__6;
2637 0 : iwork[ji] = (i__3<i__4) ? i__3 : i__4;
2638 :
2639 0 : if (iwork[ji] == nab[ji + (nab_dim1 << 1)]) {
2640 :
2641 0 : ab[ji + (ab_dim1 << 1)] = c__[ji];
2642 :
2643 0 : } else if (iwork[ji] == nab[ji + nab_dim1]) {
2644 :
2645 0 : ab[ji + ab_dim1] = c__[ji];
2646 : } else {
2647 0 : ++klnew;
2648 0 : if (klnew <= *mmax) {
2649 :
2650 0 : ab[klnew + (ab_dim1 << 1)] = ab[ji + (ab_dim1 <<
2651 0 : 1)];
2652 0 : nab[klnew + (nab_dim1 << 1)] = nab[ji + (nab_dim1
2653 0 : << 1)];
2654 0 : ab[klnew + ab_dim1] = c__[ji];
2655 0 : nab[klnew + nab_dim1] = iwork[ji];
2656 0 : ab[ji + (ab_dim1 << 1)] = c__[ji];
2657 0 : nab[ji + (nab_dim1 << 1)] = iwork[ji];
2658 : } else {
2659 0 : *info = *mmax + 1;
2660 : }
2661 : }
2662 : }
2663 0 : if (*info != 0) {
2664 : return;
2665 : }
2666 : kl = klnew;
2667 : } else {
2668 :
2669 : i__2 = kl;
2670 0 : for (ji = kf; ji <= i__2; ++ji) {
2671 0 : if (iwork[ji] <= nval[ji]) {
2672 0 : ab[ji + ab_dim1] = c__[ji];
2673 0 : nab[ji + nab_dim1] = iwork[ji];
2674 : }
2675 0 : if (iwork[ji] >= nval[ji]) {
2676 0 : ab[ji + (ab_dim1 << 1)] = c__[ji];
2677 0 : nab[ji + (nab_dim1 << 1)] = iwork[ji];
2678 : }
2679 : }
2680 : }
2681 :
2682 : } else {
2683 :
2684 : klnew = kl;
2685 : i__2 = kl;
2686 0 : for (ji = kf; ji <= i__2; ++ji) {
2687 :
2688 0 : tmp1 = c__[ji];
2689 0 : tmp2 = d__[1] - tmp1;
2690 : itmp1 = 0;
2691 0 : if (tmp2 <= *pivmin) {
2692 : itmp1 = 1;
2693 0 : d__1 = tmp2, d__2 = -(*pivmin);
2694 0 : tmp2 = (d__1<d__2) ? d__1 : d__2;
2695 : }
2696 :
2697 0 : i__3 = *n;
2698 0 : for (j = 2; j <= i__3; ++j) {
2699 0 : tmp2 = d__[j] - e2[j - 1] / tmp2 - tmp1;
2700 0 : if (tmp2 <= *pivmin) {
2701 0 : ++itmp1;
2702 0 : d__1 = tmp2, d__2 = -(*pivmin);
2703 0 : tmp2 = (d__1<d__2) ? d__1 : d__2;
2704 : }
2705 : }
2706 :
2707 0 : if (*ijob <= 2) {
2708 :
2709 0 : i__5 = nab[ji + nab_dim1];
2710 0 : i__3 = nab[ji + (nab_dim1 << 1)];
2711 : i__4 = (i__5>itmp1) ? i__5 : itmp1;
2712 : itmp1 = (i__3<i__4) ? i__3 : i__4;
2713 :
2714 0 : if (itmp1 == nab[ji + (nab_dim1 << 1)]) {
2715 :
2716 0 : ab[ji + (ab_dim1 << 1)] = tmp1;
2717 :
2718 0 : } else if (itmp1 == nab[ji + nab_dim1]) {
2719 :
2720 0 : ab[ji + ab_dim1] = tmp1;
2721 0 : } else if (klnew < *mmax) {
2722 :
2723 0 : ++klnew;
2724 0 : ab[klnew + (ab_dim1 << 1)] = ab[ji + (ab_dim1 << 1)];
2725 0 : nab[klnew + (nab_dim1 << 1)] = nab[ji + (nab_dim1 <<
2726 0 : 1)];
2727 0 : ab[klnew + ab_dim1] = tmp1;
2728 0 : nab[klnew + nab_dim1] = itmp1;
2729 0 : ab[ji + (ab_dim1 << 1)] = tmp1;
2730 0 : nab[ji + (nab_dim1 << 1)] = itmp1;
2731 : } else {
2732 0 : *info = *mmax + 1;
2733 0 : return;
2734 : }
2735 : } else {
2736 :
2737 0 : if (itmp1 <= nval[ji]) {
2738 0 : ab[ji + ab_dim1] = tmp1;
2739 0 : nab[ji + nab_dim1] = itmp1;
2740 : }
2741 0 : if (itmp1 >= nval[ji]) {
2742 0 : ab[ji + (ab_dim1 << 1)] = tmp1;
2743 0 : nab[ji + (nab_dim1 << 1)] = itmp1;
2744 : }
2745 : }
2746 : }
2747 : kl = klnew;
2748 :
2749 : }
2750 :
2751 : kfnew = kf;
2752 : i__2 = kl;
2753 0 : for (ji = kf; ji <= i__2; ++ji) {
2754 0 : tmp1 = std::abs(ab[ji + (ab_dim1 << 1)] - ab[ji + ab_dim1]);
2755 : d__3 = std::abs(ab[ji + (ab_dim1 << 1)]);
2756 : d__4 = std::abs(ab[ji + ab_dim1]);
2757 0 : tmp2 = (d__3>d__4) ? d__3 : d__4;
2758 0 : d__1 = (*abstol>*pivmin) ? *abstol : *pivmin;
2759 0 : d__2 = *reltol * tmp2;
2760 0 : if (tmp1 < ((d__1>d__2) ? d__1 : d__2) || nab[ji + nab_dim1] >= nab[ji + (
2761 0 : nab_dim1 << 1)]) {
2762 :
2763 0 : if (ji > kfnew) {
2764 : tmp1 = ab[ji + ab_dim1];
2765 : tmp2 = ab[ji + (ab_dim1 << 1)];
2766 0 : itmp1 = nab[ji + nab_dim1];
2767 0 : itmp2 = nab[ji + (nab_dim1 << 1)];
2768 0 : ab[ji + ab_dim1] = ab[kfnew + ab_dim1];
2769 0 : ab[ji + (ab_dim1 << 1)] = ab[kfnew + (ab_dim1 << 1)];
2770 0 : nab[ji + nab_dim1] = nab[kfnew + nab_dim1];
2771 0 : nab[ji + (nab_dim1 << 1)] = nab[kfnew + (nab_dim1 << 1)];
2772 0 : ab[kfnew + ab_dim1] = tmp1;
2773 0 : ab[kfnew + (ab_dim1 << 1)] = tmp2;
2774 0 : nab[kfnew + nab_dim1] = itmp1;
2775 0 : nab[kfnew + (nab_dim1 << 1)] = itmp2;
2776 0 : if (*ijob == 3) {
2777 0 : itmp1 = nval[ji];
2778 0 : nval[ji] = nval[kfnew];
2779 0 : nval[kfnew] = itmp1;
2780 : }
2781 : }
2782 0 : ++kfnew;
2783 : }
2784 : }
2785 : kf = kfnew;
2786 :
2787 : i__2 = kl;
2788 0 : for (ji = kf; ji <= i__2; ++ji) {
2789 0 : c__[ji] = (ab[ji + ab_dim1] + ab[ji + (ab_dim1 << 1)]) * .5;
2790 : }
2791 :
2792 0 : if (kf > kl) {
2793 : break;
2794 : }
2795 : }
2796 :
2797 0 : i__1 = kl + 1 - kf;
2798 0 : if(i__1>0)
2799 0 : *info = i__1;
2800 :
2801 0 : *mout = kl;
2802 :
2803 0 : return;
2804 :
2805 : }
2806 :
2807 :
2808 : }
2809 : }
2810 : #include <cmath>
2811 :
2812 : #include "lapack.h"
2813 :
2814 : #include "real.h"
2815 :
2816 : #include "blas/blas.h"
2817 : namespace PLMD{
2818 : namespace lapack{
2819 : using namespace blas;
2820 : void
2821 1387 : PLUMED_BLAS_F77_FUNC(dlaed6,DLAED6)(int *kniter,
2822 : int *orgati,
2823 : double *rho,
2824 : double *d__,
2825 : double *z__,
2826 : double *finit,
2827 : double *tau,
2828 : int *info)
2829 : {
2830 : int i__1;
2831 : double r__1, r__2, r__3, r__4;
2832 :
2833 : double a, b, c__, f;
2834 : int i__;
2835 : double fc, df, ddf, eta, eps, base;
2836 : int iter;
2837 : double temp, temp1, temp2, temp3, temp4;
2838 : int scale;
2839 : int niter;
2840 : double small1, small2, sminv1, sminv2, dscale[3], sclfac;
2841 : double zscale[3], erretm;
2842 : double safemin;
2843 : double sclinv = 0;
2844 :
2845 1387 : --z__;
2846 1387 : --d__;
2847 :
2848 1387 : *info = 0;
2849 :
2850 : niter = 1;
2851 1387 : *tau = 0.f;
2852 1387 : if (*kniter == 2) {
2853 342 : if (*orgati) {
2854 173 : temp = (d__[3] - d__[2]) / 2.f;
2855 173 : c__ = *rho + z__[1] / (d__[1] - d__[2] - temp);
2856 173 : a = c__ * (d__[2] + d__[3]) + z__[2] + z__[3];
2857 173 : b = c__ * d__[2] * d__[3] + z__[2] * d__[3] + z__[3] * d__[2];
2858 : } else {
2859 169 : temp = (d__[1] - d__[2]) / 2.f;
2860 169 : c__ = *rho + z__[3] / (d__[3] - d__[2] - temp);
2861 169 : a = c__ * (d__[1] + d__[2]) + z__[1] + z__[2];
2862 169 : b = c__ * d__[1] * d__[2] + z__[1] * d__[2] + z__[2] * d__[1];
2863 : }
2864 342 : r__1 = std::abs(a), r__2 = std::abs(b), r__1 = ((r__1>r__2)? r__1:r__2), r__2 = std::abs(c__);
2865 342 : temp = (r__1>r__2) ? r__1 : r__2;
2866 342 : a /= temp;
2867 342 : b /= temp;
2868 342 : c__ /= temp;
2869 342 : if (c__ == 0.f) {
2870 0 : *tau = b / a;
2871 342 : } else if (a <= 0.f) {
2872 113 : *tau = (a - std::sqrt((r__1 = a * a - b * 4.f * c__, std::abs(r__1)))) / (
2873 113 : c__ * 2.f);
2874 : } else {
2875 229 : *tau = b * 2.f / (a + std::sqrt((r__1 = a * a - b * 4.f * c__, std::abs(r__1))));
2876 : }
2877 :
2878 342 : temp = *rho + z__[1] / (d__[1] - *tau) + z__[2] / (d__[2] - *tau) +
2879 342 : z__[3] / (d__[3] - *tau);
2880 342 : if (std::abs(*finit) <= std::abs(temp)) {
2881 0 : *tau = 0.f;
2882 : }
2883 : }
2884 :
2885 : eps = PLUMED_GMX_DOUBLE_EPS;
2886 : base = 2;
2887 : safemin = PLUMED_GMX_DOUBLE_MIN*(1.0+PLUMED_GMX_DOUBLE_EPS);
2888 : i__1 = static_cast<int>(std::log(safemin) / std::log(base) / 3.f);
2889 : small1 = std::pow(base, static_cast<double>(i__1));
2890 : sminv1 = 1.f / small1;
2891 : small2 = small1 * small1;
2892 : sminv2 = sminv1 * sminv1;
2893 :
2894 1387 : if (*orgati) {
2895 706 : r__3 = (r__1 = d__[2] - *tau, std::abs(r__1)), r__4 = (r__2 = d__[3] - *
2896 : tau, std::abs(r__2));
2897 706 : temp = (r__3<r__4) ? r__3 : r__4;
2898 : } else {
2899 681 : r__3 = (r__1 = d__[1] - *tau, std::abs(r__1)), r__4 = (r__2 = d__[2] - *
2900 : tau, std::abs(r__2));
2901 681 : temp = (r__3<r__4) ? r__3 : r__4;
2902 : }
2903 : scale = 0;
2904 1387 : if (temp <= small1) {
2905 : scale = 1;
2906 0 : if (temp <= small2) {
2907 :
2908 : sclfac = sminv2;
2909 : sclinv = small2;
2910 : } else {
2911 :
2912 : sclfac = sminv1;
2913 : sclinv = small1;
2914 :
2915 : }
2916 :
2917 0 : for (i__ = 1; i__ <= 3; ++i__) {
2918 0 : dscale[i__ - 1] = d__[i__] * sclfac;
2919 0 : zscale[i__ - 1] = z__[i__] * sclfac;
2920 : }
2921 0 : *tau *= sclfac;
2922 : } else {
2923 :
2924 5548 : for (i__ = 1; i__ <= 3; ++i__) {
2925 4161 : dscale[i__ - 1] = d__[i__];
2926 4161 : zscale[i__ - 1] = z__[i__];
2927 : }
2928 : }
2929 : fc = 0.f;
2930 : df = 0.f;
2931 : ddf = 0.f;
2932 5548 : for (i__ = 1; i__ <= 3; ++i__) {
2933 4161 : temp = 1.f / (dscale[i__ - 1] - *tau);
2934 4161 : temp1 = zscale[i__ - 1] * temp;
2935 4161 : temp2 = temp1 * temp;
2936 4161 : temp3 = temp2 * temp;
2937 4161 : fc += temp1 / dscale[i__ - 1];
2938 4161 : df += temp2;
2939 4161 : ddf += temp3;
2940 : }
2941 1387 : f = *finit + *tau * fc;
2942 :
2943 1387 : if (std::abs(f) <= 0.f) {
2944 0 : goto L60;
2945 : }
2946 : iter = niter + 1;
2947 2782 : for (niter = iter; niter <= 20; ++niter) {
2948 2782 : if (*orgati) {
2949 1436 : temp1 = dscale[1] - *tau;
2950 1436 : temp2 = dscale[2] - *tau;
2951 : } else {
2952 1346 : temp1 = dscale[0] - *tau;
2953 1346 : temp2 = dscale[1] - *tau;
2954 : }
2955 2782 : a = (temp1 + temp2) * f - temp1 * temp2 * df;
2956 2782 : b = temp1 * temp2 * f;
2957 2782 : c__ = f - (temp1 + temp2) * df + temp1 * temp2 * ddf;
2958 2782 : r__1 = std::abs(a), r__2 = std::abs(b), r__1 = ((r__1>r__2)? r__1:r__2), r__2 = std::abs(c__);
2959 2782 : temp = (r__1>r__2) ? r__1 : r__2;
2960 2782 : a /= temp;
2961 2782 : b /= temp;
2962 2782 : c__ /= temp;
2963 2782 : if (c__ == 0.f) {
2964 0 : eta = b / a;
2965 2782 : } else if (a <= 0.f) {
2966 46 : eta = (a - std::sqrt((r__1 = a * a - b * 4.f * c__, std::abs(r__1)))) / ( c__ * 2.f);
2967 : } else {
2968 2736 : eta = b * 2.f / (a + std::sqrt((r__1 = a * a - b * 4.f * c__, std::abs( r__1))));
2969 : }
2970 2782 : if (f * eta >= 0.f) {
2971 0 : eta = -f / df;
2972 : }
2973 2782 : temp = eta + *tau;
2974 2782 : if (*orgati) {
2975 1436 : if (eta > 0.f && temp >= dscale[2]) {
2976 0 : eta = (dscale[2] - *tau) / 2.f;
2977 : }
2978 :
2979 1436 : if (eta < 0.f && temp <= dscale[1]) {
2980 0 : eta = (dscale[1] - *tau) / 2.f;
2981 : }
2982 : } else {
2983 1346 : if (eta > 0.f && temp >= dscale[1]) {
2984 0 : eta = (dscale[1] - *tau) / 2.f;
2985 : }
2986 1346 : if (eta < 0.f && temp <= dscale[0]) {
2987 0 : eta = (dscale[0] - *tau) / 2.f;
2988 : }
2989 : }
2990 2782 : *tau += eta;
2991 : fc = 0.f;
2992 : erretm = 0.f;
2993 : df = 0.f;
2994 : ddf = 0.f;
2995 11128 : for (i__ = 1; i__ <= 3; ++i__) {
2996 8346 : temp = 1.f / (dscale[i__ - 1] - *tau);
2997 8346 : temp1 = zscale[i__ - 1] * temp;
2998 8346 : temp2 = temp1 * temp;
2999 8346 : temp3 = temp2 * temp;
3000 8346 : temp4 = temp1 / dscale[i__ - 1];
3001 8346 : fc += temp4;
3002 8346 : erretm += std::abs(temp4);
3003 8346 : df += temp2;
3004 8346 : ddf += temp3;
3005 : }
3006 2782 : f = *finit + *tau * fc;
3007 2782 : erretm = (std::abs(*finit) + std::abs(*tau) * erretm) * 8.f + std::abs(*tau) * df;
3008 2782 : if (std::abs(f) <= eps * erretm) {
3009 1387 : goto L60;
3010 : }
3011 : }
3012 0 : *info = 1;
3013 1387 : L60:
3014 1387 : if (scale) {
3015 0 : *tau *= sclinv;
3016 : }
3017 1387 : return;
3018 : }
3019 :
3020 :
3021 : }
3022 : }
3023 : #include <cmath>
3024 : #include "real.h"
3025 :
3026 : #include "lapack.h"
3027 :
3028 :
3029 : #include "blas/blas.h"
3030 : namespace PLMD{
3031 : namespace lapack{
3032 : using namespace blas;
3033 : void
3034 0 : PLUMED_BLAS_F77_FUNC(dlaev2,DLAEV2)(double * a,
3035 : double * b,
3036 : double * c__,
3037 : double * rt1,
3038 : double * rt2,
3039 : double * cs1,
3040 : double * sn1)
3041 : {
3042 : double d__1;
3043 :
3044 : double ab, df, cs, ct, tb, sm, tn, rt, adf, acs;
3045 : int sgn1, sgn2;
3046 : double acmn, acmx;
3047 :
3048 0 : sm = *a + *c__;
3049 0 : df = *a - *c__;
3050 : adf = std::abs(df);
3051 0 : tb = *b + *b;
3052 : ab = std::abs(tb);
3053 0 : if (std::abs(*a) > std::abs(*c__)) {
3054 : acmx = *a;
3055 : acmn = *c__;
3056 : } else {
3057 : acmx = *c__;
3058 : acmn = *a;
3059 : }
3060 0 : if (adf > ab) {
3061 0 : d__1 = ab / adf;
3062 0 : rt = adf * std::sqrt(d__1 * d__1 + 1.);
3063 0 : } else if (adf < ab) {
3064 0 : d__1 = adf / ab;
3065 0 : rt = ab * std::sqrt(d__1 * d__1 + 1.);
3066 : } else {
3067 :
3068 0 : rt = ab * std::sqrt(2.);
3069 : }
3070 0 : if (sm < 0.) {
3071 0 : *rt1 = (sm - rt) * .5;
3072 : sgn1 = -1;
3073 :
3074 0 : *rt2 = acmx / *rt1 * acmn - *b / *rt1 * *b;
3075 0 : } else if (sm > 0.) {
3076 0 : *rt1 = (sm + rt) * .5;
3077 : sgn1 = 1;
3078 0 : *rt2 = acmx / *rt1 * acmn - *b / *rt1 * *b;
3079 : } else {
3080 0 : *rt1 = rt * .5;
3081 0 : *rt2 = rt * -.5;
3082 : sgn1 = 1;
3083 : }
3084 0 : if (df >= 0.) {
3085 0 : cs = df + rt;
3086 : sgn2 = 1;
3087 : } else {
3088 0 : cs = df - rt;
3089 : sgn2 = -1;
3090 : }
3091 : acs = std::abs(cs);
3092 0 : if (acs > ab) {
3093 0 : ct = -tb / cs;
3094 0 : *sn1 = 1. / std::sqrt(ct * ct + 1.);
3095 0 : *cs1 = ct * *sn1;
3096 : } else {
3097 0 : if (std::abs(ab)<PLUMED_GMX_DOUBLE_MIN) {
3098 0 : *cs1 = 1.;
3099 0 : *sn1 = 0.;
3100 : } else {
3101 0 : tn = -cs / tb;
3102 0 : *cs1 = 1. / std::sqrt(tn * tn + 1.);
3103 0 : *sn1 = tn * *cs1;
3104 : }
3105 : }
3106 0 : if (sgn1 == sgn2) {
3107 0 : tn = *cs1;
3108 0 : *cs1 = -(*sn1);
3109 0 : *sn1 = tn;
3110 : }
3111 0 : return;
3112 :
3113 : }
3114 :
3115 :
3116 : }
3117 : }
3118 : #include <cmath>
3119 : #include "real.h"
3120 :
3121 : #include "lapack.h"
3122 : #include "lapack_limits.h"
3123 :
3124 :
3125 :
3126 : #include "blas/blas.h"
3127 : namespace PLMD{
3128 : namespace lapack{
3129 : using namespace blas;
3130 : void
3131 0 : PLUMED_BLAS_F77_FUNC(dlagtf,DLAGTF)(int *n,
3132 : double *a,
3133 : double *lambda,
3134 : double *b,
3135 : double *c__,
3136 : double *tol,
3137 : double *d__,
3138 : int *in,
3139 : int *info)
3140 : {
3141 : int i__1;
3142 :
3143 : int k;
3144 : double tl, eps, piv1, piv2, temp, mult, scale1, scale2;
3145 :
3146 0 : --in;
3147 0 : --d__;
3148 0 : --c__;
3149 0 : --b;
3150 0 : --a;
3151 :
3152 0 : *info = 0;
3153 0 : if (*n < 0) {
3154 0 : *info = -1;
3155 0 : return;
3156 : }
3157 :
3158 0 : if (*n == 0)
3159 : return;
3160 :
3161 0 : a[1] -= *lambda;
3162 0 : in[*n] = 0;
3163 0 : if (*n == 1) {
3164 0 : if (std::abs(a[1])<PLUMED_GMX_DOUBLE_MIN) {
3165 0 : in[1] = 1;
3166 : }
3167 0 : return;
3168 : }
3169 :
3170 : eps = PLUMED_GMX_DOUBLE_EPS;
3171 :
3172 0 : tl = (*tol>eps) ? *tol : eps;
3173 0 : scale1 = std::abs(a[1]) + std::abs(b[1]);
3174 : i__1 = *n - 1;
3175 0 : for (k = 1; k <= i__1; ++k) {
3176 0 : a[k + 1] -= *lambda;
3177 0 : scale2 = std::abs(c__[k]) + std::abs(a[k + 1]);
3178 0 : if (k < *n - 1) {
3179 0 : scale2 += std::abs(b[k + 1]);
3180 : }
3181 0 : if (std::abs(a[k])<PLUMED_GMX_DOUBLE_MIN) {
3182 : piv1 = 0.;
3183 : } else {
3184 0 : piv1 = std::abs(a[k]) / scale1;
3185 : }
3186 0 : if (std::abs(c__[k])<PLUMED_GMX_DOUBLE_MIN) {
3187 0 : in[k] = 0;
3188 : piv2 = 0.;
3189 : scale1 = scale2;
3190 0 : if (k < *n - 1) {
3191 0 : d__[k] = 0.;
3192 : }
3193 : } else {
3194 0 : piv2 = std::abs(c__[k]) / scale2;
3195 0 : if (piv2 <= piv1) {
3196 0 : in[k] = 0;
3197 : scale1 = scale2;
3198 0 : c__[k] /= a[k];
3199 0 : a[k + 1] -= c__[k] * b[k];
3200 0 : if (k < *n - 1) {
3201 0 : d__[k] = 0.;
3202 : }
3203 : } else {
3204 0 : in[k] = 1;
3205 0 : mult = a[k] / c__[k];
3206 0 : a[k] = c__[k];
3207 0 : temp = a[k + 1];
3208 0 : a[k + 1] = b[k] - mult * temp;
3209 0 : if (k < *n - 1) {
3210 0 : d__[k] = b[k + 1];
3211 0 : b[k + 1] = -mult * d__[k];
3212 : }
3213 0 : b[k] = temp;
3214 0 : c__[k] = mult;
3215 : }
3216 : }
3217 0 : if (((piv1>piv2) ? piv1 : piv2) <= tl && in[*n] == 0) {
3218 0 : in[*n] = k;
3219 : }
3220 : }
3221 0 : if (std::abs(a[*n]) <= scale1 * tl && in[*n] == 0) {
3222 0 : in[*n] = *n;
3223 : }
3224 :
3225 : return;
3226 :
3227 : }
3228 :
3229 :
3230 : }
3231 : }
3232 : #include <stdlib.h>
3233 : #include <cmath>
3234 : #include "real.h"
3235 :
3236 : #include "lapack.h"
3237 : #include "lapack_limits.h"
3238 :
3239 :
3240 : #include "blas/blas.h"
3241 : namespace PLMD{
3242 : namespace lapack{
3243 : using namespace blas;
3244 : void
3245 0 : PLUMED_BLAS_F77_FUNC(dlagts,DLAGTS)(int *job,
3246 : int *n,
3247 : double *a,
3248 : double *b,
3249 : double *c__,
3250 : double *d__,
3251 : int *in,
3252 : double *y,
3253 : double *tol,
3254 : int *info)
3255 : {
3256 : int i__1;
3257 : double d__1, d__2, d__4, d__5;
3258 :
3259 : int k;
3260 : double ak, eps, temp, pert, absak, sfmin;
3261 : double bignum,minval;
3262 0 : --y;
3263 0 : --in;
3264 0 : --d__;
3265 0 : --c__;
3266 0 : --b;
3267 0 : --a;
3268 :
3269 0 : *info = 0;
3270 0 : if (abs(*job) > 2 || *job == 0) {
3271 0 : *info = -1;
3272 0 : } else if (*n < 0) {
3273 0 : *info = -2;
3274 : }
3275 0 : if (*info != 0) {
3276 : return;
3277 : }
3278 :
3279 0 : if (*n == 0) {
3280 : return;
3281 : }
3282 : eps = PLUMED_GMX_DOUBLE_EPS;
3283 : minval = PLUMED_GMX_DOUBLE_MIN;
3284 : sfmin = minval / eps;
3285 :
3286 : bignum = 1. / sfmin;
3287 :
3288 0 : if (*job < 0) {
3289 0 : if (*tol <= 0.) {
3290 0 : *tol = std::abs(a[1]);
3291 0 : if (*n > 1) {
3292 : d__1 = *tol;
3293 0 : d__2 = std::abs(a[2]);
3294 0 : d__1 = (d__1>d__2) ? d__1 : d__2;
3295 0 : d__2 = std::abs(b[1]);
3296 0 : *tol = (d__1>d__2) ? d__1 : d__2;
3297 : }
3298 0 : i__1 = *n;
3299 0 : for (k = 3; k <= i__1; ++k) {
3300 0 : d__4 = *tol;
3301 0 : d__5 = std::abs(a[k]);
3302 0 : d__4 = (d__4>d__5) ? d__4 : d__5;
3303 0 : d__5 = std::abs(b[k - 1]);
3304 0 : d__4 = (d__4>d__5) ? d__4 : d__5;
3305 0 : d__5 = std::abs(d__[k - 2]);
3306 0 : *tol = (d__4>d__5) ? d__4 : d__5;
3307 : }
3308 0 : *tol *= eps;
3309 0 : if (std::abs(*tol)<PLUMED_GMX_DOUBLE_MIN) {
3310 0 : *tol = eps;
3311 : }
3312 : }
3313 : }
3314 :
3315 0 : if (1 == abs(*job)) {
3316 0 : i__1 = *n;
3317 0 : for (k = 2; k <= i__1; ++k) {
3318 0 : if (in[k - 1] == 0) {
3319 0 : y[k] -= c__[k - 1] * y[k - 1];
3320 : } else {
3321 0 : temp = y[k - 1];
3322 0 : y[k - 1] = y[k];
3323 0 : y[k] = temp - c__[k - 1] * y[k];
3324 : }
3325 : }
3326 0 : if (*job == 1) {
3327 0 : for (k = *n; k >= 1; --k) {
3328 0 : if (k <= *n - 2) {
3329 0 : temp = y[k] - b[k] * y[k + 1] - d__[k] * y[k + 2];
3330 0 : } else if (k == *n - 1) {
3331 0 : temp = y[k] - b[k] * y[k + 1];
3332 : } else {
3333 0 : temp = y[k];
3334 : }
3335 0 : ak = a[k];
3336 : absak = std::abs(ak);
3337 0 : if (absak < 1.) {
3338 0 : if (absak < sfmin) {
3339 0 : if (std::abs(absak)<PLUMED_GMX_DOUBLE_MIN || std::abs(temp) * sfmin > absak) {
3340 0 : *info = k;
3341 0 : return;
3342 : } else {
3343 0 : temp *= bignum;
3344 0 : ak *= bignum;
3345 : }
3346 0 : } else if (std::abs(temp) > absak * bignum) {
3347 0 : *info = k;
3348 0 : return;
3349 : }
3350 : }
3351 0 : y[k] = temp / ak;
3352 : }
3353 : } else {
3354 0 : for (k = *n; k >= 1; --k) {
3355 0 : if (k + 2 <= *n) {
3356 0 : temp = y[k] - b[k] * y[k + 1] - d__[k] * y[k + 2];
3357 0 : } else if (k + 1 == *n) {
3358 0 : temp = y[k] - b[k] * y[k + 1];
3359 : } else {
3360 0 : temp = y[k];
3361 : }
3362 0 : ak = a[k];
3363 :
3364 0 : pert = *tol;
3365 0 : if(ak<0)
3366 0 : pert *= -1.0;
3367 0 : L40:
3368 : absak = std::abs(ak);
3369 0 : if (absak < 1.) {
3370 0 : if (absak < sfmin) {
3371 0 : if (std::abs(absak)<PLUMED_GMX_DOUBLE_MIN || std::abs(temp) * sfmin > absak) {
3372 0 : ak += pert;
3373 0 : pert *= 2;
3374 0 : goto L40;
3375 : } else {
3376 0 : temp *= bignum;
3377 0 : ak *= bignum;
3378 : }
3379 0 : } else if (std::abs(temp) > absak * bignum) {
3380 0 : ak += pert;
3381 0 : pert *= 2;
3382 0 : goto L40;
3383 : }
3384 : }
3385 0 : y[k] = temp / ak;
3386 : }
3387 : }
3388 : } else {
3389 :
3390 0 : if (*job == 2) {
3391 0 : i__1 = *n;
3392 0 : for (k = 1; k <= i__1; ++k) {
3393 0 : if (k >= 3) {
3394 0 : temp = y[k] - b[k - 1] * y[k - 1] - d__[k - 2] * y[k - 2];
3395 0 : } else if (k == 2) {
3396 0 : temp = y[k] - b[k - 1] * y[k - 1];
3397 : } else {
3398 0 : temp = y[k];
3399 : }
3400 0 : ak = a[k];
3401 : absak = std::abs(ak);
3402 0 : if (absak < 1.) {
3403 0 : if (absak < sfmin) {
3404 0 : if (std::abs(absak)<PLUMED_GMX_DOUBLE_MIN || std::abs(temp) * sfmin > absak) {
3405 0 : *info = k;
3406 0 : return;
3407 : } else {
3408 0 : temp *= bignum;
3409 0 : ak *= bignum;
3410 : }
3411 0 : } else if (std::abs(temp) > absak * bignum) {
3412 0 : *info = k;
3413 0 : return;
3414 : }
3415 : }
3416 0 : y[k] = temp / ak;
3417 : }
3418 : } else {
3419 0 : i__1 = *n;
3420 0 : for (k = 1; k <= i__1; ++k) {
3421 0 : if (k >= 3) {
3422 0 : temp = y[k] - b[k - 1] * y[k - 1] - d__[k - 2] * y[k - 2];
3423 0 : } else if (k == 2) {
3424 0 : temp = y[k] - b[k - 1] * y[k - 1];
3425 : } else {
3426 0 : temp = y[k];
3427 : }
3428 0 : ak = a[k];
3429 :
3430 0 : pert = *tol;
3431 0 : if(ak<0)
3432 0 : pert *= -1.0;
3433 :
3434 0 : L70:
3435 : absak = std::abs(ak);
3436 0 : if (absak < 1.) {
3437 0 : if (absak < sfmin) {
3438 0 : if (std::abs(absak)<PLUMED_GMX_DOUBLE_MIN || std::abs(temp) * sfmin > absak) {
3439 0 : ak += pert;
3440 0 : pert *= 2;
3441 0 : goto L70;
3442 : } else {
3443 0 : temp *= bignum;
3444 0 : ak *= bignum;
3445 : }
3446 0 : } else if (std::abs(temp) > absak * bignum) {
3447 0 : ak += pert;
3448 0 : pert *= 2;
3449 0 : goto L70;
3450 : }
3451 : }
3452 0 : y[k] = temp / ak;
3453 : }
3454 : }
3455 :
3456 0 : for (k = *n; k >= 2; --k) {
3457 0 : if (in[k - 1] == 0) {
3458 0 : y[k - 1] -= c__[k - 1] * y[k];
3459 : } else {
3460 0 : temp = y[k - 1];
3461 0 : y[k - 1] = y[k];
3462 0 : y[k] = temp - c__[k - 1] * y[k];
3463 : }
3464 : }
3465 : }
3466 :
3467 : return;
3468 : }
3469 :
3470 :
3471 : }
3472 : }
3473 : #include "lapack.h"
3474 :
3475 :
3476 : /* LAPACK */
3477 :
3478 :
3479 : #include "blas/blas.h"
3480 : namespace PLMD{
3481 : namespace lapack{
3482 : using namespace blas;
3483 : void
3484 118 : PLUMED_BLAS_F77_FUNC(dlamrg,DLAMRG)(int *n1,
3485 : int *n2,
3486 : double *a,
3487 : int *dtrd1,
3488 : int *dtrd2,
3489 : int *index)
3490 : {
3491 118 : int n1sv = *n1;
3492 118 : int n2sv = *n2;
3493 : int i,ind1,ind2;
3494 :
3495 118 : if(*dtrd1>0)
3496 : ind1 = 0;
3497 : else
3498 0 : ind1 = *n1-1;
3499 :
3500 118 : if(*dtrd2>0)
3501 : ind2 = *n1;
3502 : else
3503 59 : ind2 = *n1+*n2-1;
3504 :
3505 : i = 0;
3506 :
3507 4270 : while(n1sv>0 && n2sv>0) {
3508 4152 : if(a[ind1]<=a[ind2]) {
3509 2476 : index[i] = ind1 + 1;
3510 2476 : i++;
3511 2476 : ind1 += *dtrd1;
3512 2476 : n1sv--;
3513 : } else {
3514 1676 : index[i] = ind2 + 1;
3515 1676 : i++;
3516 1676 : ind2 += *dtrd2;
3517 1676 : n2sv--;
3518 : }
3519 : }
3520 :
3521 118 : if(n1sv==0) {
3522 126 : for(n1sv=1;n1sv<=n2sv;n1sv++) {
3523 120 : index[i] = ind2 + 1;
3524 120 : i++;
3525 120 : ind2 += *dtrd2;
3526 : }
3527 : } else {
3528 2567 : for(n2sv=1;n2sv<=n1sv;n2sv++) {
3529 2455 : index[i] = ind1 + 1;
3530 2455 : i++;
3531 2455 : ind1 += *dtrd1;
3532 : }
3533 : }
3534 118 : return;
3535 : }
3536 : }
3537 : }
3538 : #include <cctype>
3539 : #include <cmath>
3540 : #include "lapack.h"
3541 :
3542 :
3543 : #include "blas/blas.h"
3544 : namespace PLMD{
3545 : namespace lapack{
3546 : using namespace blas;
3547 : double
3548 96 : PLUMED_BLAS_F77_FUNC(dlange,DLANGE)(const char *norm,
3549 : int *m,
3550 : int *n,
3551 : double *a,
3552 : int *lda,
3553 : double *work)
3554 : {
3555 96 : const char ch=std::toupper(*norm);
3556 : double dtemp,sum,max,val,scale;
3557 : int i,j;
3558 :
3559 96 : switch(ch) {
3560 : case 'M':
3561 : max = 0.0;
3562 2640 : for(j=0;j<*n;j++)
3563 304276 : for(i=0;i<*m;i++) {
3564 301732 : dtemp = std::abs(a[j*(*lda)+i]);
3565 301732 : if(dtemp>max)
3566 : max = dtemp;
3567 : }
3568 : val = max;
3569 : break;
3570 :
3571 : case 'O':
3572 : case '1':
3573 : max = 0.0;
3574 0 : for(j=0;j<*n;j++) {
3575 0 : sum = 0.0;
3576 0 : for(i=0;i<*m;i++)
3577 0 : sum += std::abs(a[j*(*lda)+i]);
3578 0 : if(sum>max)
3579 : max = sum;
3580 : }
3581 : val = max;
3582 : break;
3583 :
3584 0 : case 'I':
3585 0 : for(i=0;i<*m;i++)
3586 0 : work[i] = 0.0;
3587 0 : for(j=0;j<*n;j++)
3588 0 : for(i=0;i<*m;i++)
3589 0 : work[i] += std::abs(a[j*(*lda)+i]);
3590 : max = 0;
3591 0 : for(i=0;i<*m;i++)
3592 0 : if(work[i]>max)
3593 : max=work[i];
3594 : val = max;
3595 : break;
3596 :
3597 0 : case 'F':
3598 : case 'E':
3599 0 : scale = 0.0;
3600 0 : sum = 1.0;
3601 0 : i = 1;
3602 0 : for(j=0;j<*n;j++)
3603 0 : PLUMED_BLAS_F77_FUNC(dlassq,DLASSQ)(m,&(a[j*(*lda)+0]),&i,&scale,&sum);
3604 0 : val = scale* std::sqrt(sum);
3605 0 : break;
3606 :
3607 : default:
3608 : val = 0.0;
3609 : break;
3610 : }
3611 96 : return val;
3612 : }
3613 : }
3614 : }
3615 : #include <cctype>
3616 : #include <cmath>
3617 : #include "lapack.h"
3618 :
3619 :
3620 : #include "blas/blas.h"
3621 : namespace PLMD{
3622 : namespace lapack{
3623 : using namespace blas;
3624 : double
3625 570037 : PLUMED_BLAS_F77_FUNC(dlanst,DLANST)(const char *norm,
3626 : int *n,
3627 : double *d,
3628 : double *e)
3629 : {
3630 570037 : const char ch=std::toupper(*norm);
3631 : double dtemp,max,val,scale,sum;
3632 : int i,j;
3633 :
3634 :
3635 570037 : if(*n<=0)
3636 : return 0.0;
3637 :
3638 570037 : switch(ch) {
3639 570037 : case 'M':
3640 570037 : max = std::abs(d[*n-1]);
3641 2255853 : for(i=0;i<(*n-1);i++) {
3642 1685816 : dtemp = std::abs(d[i]);
3643 1685816 : if(dtemp>max)
3644 : max = dtemp;
3645 1685816 : dtemp = std::abs(e[i]);
3646 1685816 : if(dtemp>max)
3647 : max = dtemp;
3648 : }
3649 : val = max;
3650 : break;
3651 :
3652 0 : case 'O':
3653 : case '1':
3654 : case 'I':
3655 :
3656 0 : if(*n==1)
3657 0 : val = std::abs(d[0]);
3658 : else {
3659 0 : max = std::abs(d[0]) + std::abs(e[0]);
3660 0 : dtemp = std::abs(e[*n-2]) + std::abs(d[*n-1]);
3661 0 : if(dtemp>max)
3662 : max = dtemp;
3663 0 : for(i=1;i<(*n-1);i++) {
3664 0 : dtemp = std::abs(d[i]) + std::abs(e[i]) + std::abs(e[i-1]);
3665 0 : if(dtemp>max)
3666 : max = dtemp;
3667 : }
3668 : val = max;
3669 : }
3670 : break;
3671 :
3672 0 : case 'F':
3673 : case 'E':
3674 0 : scale = 0.0;
3675 0 : sum = 1.0;
3676 0 : i = *n-1;
3677 0 : j = 1;
3678 0 : if(*n>1) {
3679 0 : PLUMED_BLAS_F77_FUNC(dlassq,DLASSQ)(&i,e,&j,&scale,&sum);
3680 0 : sum *= 2;
3681 : }
3682 0 : PLUMED_BLAS_F77_FUNC(dlassq,DLASSQ)(n,d,&j,&scale,&sum);
3683 0 : val = scale * std::sqrt(sum);
3684 0 : break;
3685 :
3686 : default:
3687 : val = 0.0;
3688 : break;
3689 : }
3690 : return val;
3691 : }
3692 : }
3693 : }
3694 : #include <cmath>
3695 :
3696 :
3697 : #include "lapack.h"
3698 :
3699 : #include "blas/blas.h"
3700 : namespace PLMD{
3701 : namespace lapack{
3702 : using namespace blas;
3703 : double
3704 570008 : PLUMED_BLAS_F77_FUNC(dlansy,DLANSY)(const char *norm, const char *uplo, int *n, double *a, int
3705 : *lda, double *work)
3706 : {
3707 : /* System generated locals */
3708 : int a_dim1, a_offset, i__1, i__2;
3709 : double ret_val, d__1, d__2, d__3;
3710 570008 : int c__1 = 1;
3711 :
3712 : /* Local variables */
3713 : int i__, j;
3714 : double sum, absa, scale;
3715 : double value =0.0;
3716 :
3717 570008 : a_dim1 = *lda;
3718 570008 : a_offset = 1 + a_dim1;
3719 570008 : a -= a_offset;
3720 570008 : --work;
3721 :
3722 570008 : if (*n == 0) {
3723 : value = 0.;
3724 570008 : } else if (*norm=='M' || *norm=='m') {
3725 :
3726 : value = 0.;
3727 570008 : if (*uplo=='U' || *uplo=='u') {
3728 570008 : i__1 = *n;
3729 2824437 : for (j = 1; j <= i__1; ++j) {
3730 : i__2 = j;
3731 8056735 : for (i__ = 1; i__ <= i__2; ++i__) {
3732 : d__2 = value;
3733 5802306 : d__3 = std::abs(a[i__ + j * a_dim1]);
3734 5802306 : value = (d__2>d__3) ? d__2 : d__3;
3735 : }
3736 : }
3737 : } else {
3738 0 : i__1 = *n;
3739 0 : for (j = 1; j <= i__1; ++j) {
3740 : i__2 = *n;
3741 0 : for (i__ = j; i__ <= i__2; ++i__) {
3742 : d__2 = value;
3743 0 : d__3 = std::abs(a[i__ + j * a_dim1]);
3744 0 : value = (d__2>d__3) ? d__2 : d__3;
3745 : }
3746 : }
3747 : }
3748 0 : } else if (*norm=='I' || *norm=='i' || *norm=='O' || *norm=='o' || *norm=='1') {
3749 :
3750 : value = 0.;
3751 0 : if (*uplo=='U' || *uplo=='u') {
3752 0 : i__1 = *n;
3753 0 : for (j = 1; j <= i__1; ++j) {
3754 0 : sum = 0.;
3755 0 : i__2 = j - 1;
3756 0 : for (i__ = 1; i__ <= i__2; ++i__) {
3757 0 : absa = std::abs(a[i__ + j * a_dim1]);
3758 0 : sum += absa;
3759 0 : work[i__] += absa;
3760 : }
3761 0 : work[j] = sum + std::abs(a[j + j * a_dim1]);
3762 : }
3763 0 : i__1 = *n;
3764 0 : for (i__ = 1; i__ <= i__1; ++i__) {
3765 0 : d__1 = value, d__2 = work[i__];
3766 0 : value = (d__1>d__2) ? d__1 : d__2;
3767 : }
3768 : } else {
3769 : i__1 = *n;
3770 0 : for (i__ = 1; i__ <= i__1; ++i__) {
3771 0 : work[i__] = 0.;
3772 : }
3773 0 : i__1 = *n;
3774 0 : for (j = 1; j <= i__1; ++j) {
3775 0 : sum = work[j] + std::abs(a[j + j * a_dim1]);
3776 0 : i__2 = *n;
3777 0 : for (i__ = j + 1; i__ <= i__2; ++i__) {
3778 0 : absa = std::abs(a[i__ + j * a_dim1]);
3779 0 : sum += absa;
3780 0 : work[i__] += absa;
3781 : }
3782 0 : if(sum>value)
3783 : value = sum;
3784 : }
3785 : }
3786 : } else if (*norm=='F' || *norm=='f' || *norm=='E' || *norm=='e') {
3787 :
3788 0 : scale = 0.;
3789 0 : sum = 1.;
3790 0 : if (*uplo=='U' || *uplo=='u') {
3791 0 : i__1 = *n;
3792 0 : for (j = 2; j <= i__1; ++j) {
3793 0 : i__2 = j - 1;
3794 0 : PLUMED_BLAS_F77_FUNC(dlassq,DLASSQ)(&i__2, &a[j * a_dim1 + 1], &c__1, &scale, &sum);
3795 : }
3796 : } else {
3797 0 : i__1 = *n - 1;
3798 0 : for (j = 1; j <= i__1; ++j) {
3799 0 : i__2 = *n - j;
3800 0 : PLUMED_BLAS_F77_FUNC(dlassq,DLASSQ)(&i__2, &a[j + 1 + j * a_dim1], &c__1, &scale, &sum);
3801 : }
3802 : }
3803 0 : sum *= 2;
3804 0 : i__1 = *lda + 1;
3805 0 : PLUMED_BLAS_F77_FUNC(dlassq,DLASSQ)(n, &a[a_offset], &i__1, &scale, &sum);
3806 0 : value = scale * std::sqrt(sum);
3807 : }
3808 :
3809 : ret_val = value;
3810 570008 : return ret_val;
3811 : }
3812 :
3813 :
3814 : }
3815 : }
3816 : #include <cmath>
3817 : #include "lapack.h"
3818 :
3819 : #include "real.h"
3820 :
3821 : #include "blas/blas.h"
3822 : namespace PLMD{
3823 : namespace lapack{
3824 : using namespace blas;
3825 : double
3826 1119236 : PLUMED_BLAS_F77_FUNC(dlapy2,DLAPY2)(double * x, double * y)
3827 : {
3828 : double xabs,yabs;
3829 : double w,z;
3830 :
3831 1119236 : xabs = std::abs(*x);
3832 1119236 : yabs = std::abs(*y);
3833 :
3834 1119236 : if(xabs>yabs) {
3835 : w = xabs;
3836 : z = yabs;
3837 : } else {
3838 : w = yabs;
3839 : z = xabs;
3840 : }
3841 :
3842 1119236 : if( std::abs(z)<PLUMED_GMX_DOUBLE_MIN)
3843 : return w;
3844 : else {
3845 1119236 : z = z/w;
3846 1119236 : return w* std::sqrt(1.0+z*z);
3847 : }
3848 : }
3849 :
3850 : }
3851 : }
3852 : #include <cmath>
3853 :
3854 : #include "real.h"
3855 :
3856 : #include "lapack.h"
3857 : #include "lapack_limits.h"
3858 : #include "blas/blas.h"
3859 : namespace PLMD{
3860 : namespace lapack{
3861 : using namespace blas;
3862 :
3863 608131 : void PLUMED_BLAS_F77_FUNC(dlar1vx,DLAR1VX)(int *n,
3864 : int *b1,
3865 : int *bn,
3866 : double *sigma,
3867 : double *d__,
3868 : double *l,
3869 : double *ld,
3870 : double *lld,
3871 : double *eval,
3872 : double *gersch,
3873 : double *z__,
3874 : double *ztz,
3875 : double *mingma,
3876 : int *r__,
3877 : int *isuppz,
3878 : double *work)
3879 : {
3880 : int i__1;
3881 :
3882 : int i__, j;
3883 : double s;
3884 : int r1, r2;
3885 : int to;
3886 : double eps, tmp;
3887 : int indp, inds, from;
3888 : double dplus;
3889 : int sawnan;
3890 : int indumn;
3891 : double dminus;
3892 :
3893 608131 : --work;
3894 : --isuppz;
3895 608131 : --z__;
3896 608131 : --gersch;
3897 608131 : --lld;
3898 608131 : --ld;
3899 608131 : --l;
3900 608131 : --d__;
3901 :
3902 : /* Function Body */
3903 : eps = PLUMED_GMX_DOUBLE_EPS;
3904 608131 : if (*r__ == 0) {
3905 :
3906 606858 : r1 = *b1;
3907 606858 : r2 = *bn;
3908 : i__1 = *bn;
3909 1399077 : for (i__ = *b1; i__ <= i__1; ++i__) {
3910 1399077 : if (*eval >= gersch[(i__ << 1) - 1] && *eval <= gersch[i__ * 2]) {
3911 : r1 = i__;
3912 606858 : goto L20;
3913 : }
3914 : }
3915 0 : goto L40;
3916 : L20:
3917 : i__1 = *b1;
3918 1557129 : for (i__ = *bn; i__ >= i__1; --i__) {
3919 1557129 : if (*eval >= gersch[(i__ << 1) - 1] && *eval <= gersch[i__ * 2]) {
3920 : r2 = i__;
3921 606858 : goto L40;
3922 : }
3923 : }
3924 : } else {
3925 : r1 = *r__;
3926 : r2 = *r__;
3927 : }
3928 :
3929 608131 : L40:
3930 608131 : indumn = *n;
3931 608131 : inds = (*n << 1) + 1;
3932 608131 : indp = *n * 3 + 1;
3933 : sawnan = 0;
3934 :
3935 608131 : if (*b1 == 1) {
3936 608131 : work[inds] = 0.;
3937 : } else {
3938 0 : work[inds] = lld[*b1 - 1];
3939 : }
3940 608131 : s = work[inds] - *sigma;
3941 : i__1 = r2 - 1;
3942 1842425 : for (i__ = *b1; i__ <= i__1; ++i__) {
3943 1234294 : dplus = d__[i__] + s;
3944 1234294 : work[i__] = ld[i__] / dplus;
3945 1234294 : work[inds + i__] = s * work[i__] * l[i__];
3946 1234294 : s = work[inds + i__] - *sigma;
3947 : }
3948 :
3949 608131 : if (std::isnan(s)) {
3950 :
3951 : sawnan = 1;
3952 0 : j = *b1 + 1;
3953 0 : L60:
3954 0 : if (!std::isnan(work[inds + j])) {
3955 0 : ++j;
3956 0 : goto L60;
3957 : }
3958 0 : work[inds + j] = lld[j];
3959 0 : s = work[inds + j] - *sigma;
3960 : i__1 = r2 - 1;
3961 0 : for (i__ = j + 1; i__ <= i__1; ++i__) {
3962 0 : dplus = d__[i__] + s;
3963 0 : work[i__] = ld[i__] / dplus;
3964 0 : if (std::abs(work[i__])<PLUMED_GMX_DOUBLE_MIN) {
3965 0 : work[inds + i__] = lld[i__];
3966 : } else {
3967 0 : work[inds + i__] = s * work[i__] * l[i__];
3968 : }
3969 0 : s = work[inds + i__] - *sigma;
3970 : }
3971 : }
3972 :
3973 608131 : work[indp + *bn - 1] = d__[*bn] - *sigma;
3974 : i__1 = r1;
3975 2110704 : for (i__ = *bn - 1; i__ >= i__1; --i__) {
3976 1502573 : dminus = lld[i__] + work[indp + i__];
3977 1502573 : tmp = d__[i__] / dminus;
3978 1502573 : work[indumn + i__] = l[i__] * tmp;
3979 1502573 : work[indp + i__ - 1] = work[indp + i__] * tmp - *sigma;
3980 : }
3981 608131 : tmp = work[indp + r1 - 1];
3982 608131 : if (std::isnan(tmp)) {
3983 :
3984 : sawnan = 1;
3985 0 : j = *bn - 3;
3986 0 : L90:
3987 0 : if (!std::isnan(work[indp + j])) {
3988 0 : --j;
3989 0 : goto L90;
3990 : }
3991 0 : work[indp + j] = d__[j + 1] - *sigma;
3992 : i__1 = r1;
3993 0 : for (i__ = j; i__ >= i__1; --i__) {
3994 0 : dminus = lld[i__] + work[indp + i__];
3995 0 : tmp = d__[i__] / dminus;
3996 0 : work[indumn + i__] = l[i__] * tmp;
3997 0 : if (std::abs(tmp)<PLUMED_GMX_DOUBLE_MIN) {
3998 0 : work[indp + i__ - 1] = d__[i__] - *sigma;
3999 : } else {
4000 0 : work[indp + i__ - 1] = work[indp + i__] * tmp - *sigma;
4001 : }
4002 : }
4003 : }
4004 :
4005 608131 : *mingma = work[inds + r1 - 1] + work[indp + r1 - 1];
4006 608131 : if (std::abs(*mingma)<PLUMED_GMX_DOUBLE_MIN) {
4007 45757 : *mingma = eps * work[inds + r1 - 1];
4008 : }
4009 608131 : *r__ = r1;
4010 : i__1 = r2 - 1;
4011 956138 : for (i__ = r1; i__ <= i__1; ++i__) {
4012 348007 : tmp = work[inds + i__] + work[indp + i__];
4013 348007 : if (std::abs(tmp)<PLUMED_GMX_DOUBLE_MIN) {
4014 23351 : tmp = eps * work[inds + i__];
4015 : }
4016 348007 : if (std::abs(tmp) < std::abs(*mingma)) {
4017 50692 : *mingma = tmp;
4018 50692 : *r__ = i__ + 1;
4019 : }
4020 : }
4021 :
4022 608131 : isuppz[1] = *b1;
4023 608131 : isuppz[2] = *bn;
4024 608131 : z__[*r__] = 1.;
4025 608131 : *ztz = 1.;
4026 608131 : if (! sawnan) {
4027 608131 : from = *r__ - 1;
4028 608131 : i__1 = *r__ - 32;
4029 608131 : to = (i__1>(*b1)) ? i__1 : (*b1);
4030 : L120:
4031 1148720 : if (from >= *b1) {
4032 : i__1 = to;
4033 1355224 : for (i__ = from; i__ >= i__1; --i__) {
4034 813427 : z__[i__] = -(work[i__] * z__[i__ + 1]);
4035 813427 : *ztz += z__[i__] * z__[i__];
4036 : }
4037 541797 : if (std::abs(z__[to]) <= eps && std::abs(z__[to + 1]) <= eps) {
4038 1208 : isuppz[1] = to + 2;
4039 : } else {
4040 540589 : from = to - 1;
4041 540589 : i__1 = to - 32;
4042 540589 : to = (i__1>*b1) ? i__1 : *b1;
4043 540589 : goto L120;
4044 : }
4045 : }
4046 608131 : from = *r__ + 1;
4047 608131 : i__1 = *r__ + 32;
4048 608131 : to = (i__1<*bn) ? i__1 : *bn;
4049 : L140:
4050 1192340 : if (from <= *bn) {
4051 : i__1 = to;
4052 2016487 : for (i__ = from; i__ <= i__1; ++i__) {
4053 1432272 : z__[i__] = -(work[indumn + i__ - 1] * z__[i__ - 1]);
4054 1432272 : *ztz += z__[i__] * z__[i__];
4055 : }
4056 584215 : if (std::abs(z__[to]) <= eps && std::abs(z__[to - 1]) <= eps) {
4057 6 : isuppz[2] = to - 2;
4058 : } else {
4059 584209 : from = to + 1;
4060 584209 : i__1 = to + 32;
4061 584209 : to = (i__1<*bn) ? i__1 : *bn;
4062 584209 : goto L140;
4063 : }
4064 : }
4065 : } else {
4066 0 : i__1 = *b1;
4067 0 : for (i__ = *r__ - 1; i__ >= i__1; --i__) {
4068 0 : if (std::abs(z__[i__ + 1])<PLUMED_GMX_DOUBLE_MIN) {
4069 0 : z__[i__] = -(ld[i__ + 1] / ld[i__]) * z__[i__ + 2];
4070 : } else {
4071 0 : z__[i__] = -(work[i__] * z__[i__ + 1]);
4072 : }
4073 0 : if (std::abs(z__[i__]) <= eps && std::abs(z__[i__ + 1]) <= eps) {
4074 0 : isuppz[1] = i__ + 2;
4075 0 : goto L170;
4076 : }
4077 0 : *ztz += z__[i__] * z__[i__];
4078 : }
4079 0 : L170:
4080 0 : i__1 = *bn - 1;
4081 0 : for (i__ = *r__; i__ <= i__1; ++i__) {
4082 0 : if (std::abs(z__[i__])<PLUMED_GMX_DOUBLE_MIN) {
4083 0 : z__[i__ + 1] = -(ld[i__ - 1] / ld[i__]) * z__[i__ - 1];
4084 : } else {
4085 0 : z__[i__ + 1] = -(work[indumn + i__] * z__[i__]);
4086 : }
4087 0 : if (std::abs(z__[i__]) <= eps && std::abs(z__[i__ + 1]) <= eps) {
4088 0 : isuppz[2] = i__ - 1;
4089 0 : break;
4090 : }
4091 0 : *ztz += z__[i__ + 1] * z__[i__ + 1];
4092 : }
4093 : }
4094 :
4095 608131 : return;
4096 :
4097 : }
4098 :
4099 :
4100 : }
4101 : }
4102 : #include <cctype>
4103 : #include <cmath>
4104 :
4105 : #include "blas/blas.h"
4106 : #include "lapack.h"
4107 :
4108 : #include "real.h"
4109 :
4110 : #include "blas/blas.h"
4111 : namespace PLMD{
4112 : namespace lapack{
4113 : using namespace blas;
4114 : void
4115 1689941 : PLUMED_BLAS_F77_FUNC(dlarf,DLARF)(const char *side,
4116 : int *m,
4117 : int *n,
4118 : double *v,
4119 : int *incv,
4120 : double *tau,
4121 : double *c,
4122 : int *ldc,
4123 : double *work)
4124 : {
4125 1689941 : const char ch=std::toupper(*side);
4126 1689941 : double one = 1.0;
4127 1689941 : double zero = 0.0;
4128 1689941 : double minustau = -(*tau);
4129 1689941 : int i1 = 1;
4130 :
4131 :
4132 1689941 : if(ch=='L') {
4133 1686360 : if(std::abs(*tau)>PLUMED_GMX_DOUBLE_MIN) {
4134 1116226 : PLUMED_BLAS_F77_FUNC(dgemv,DGEMV)("T",m,n,&one,c,ldc,v,incv,&zero,work,&i1);
4135 1116226 : PLUMED_BLAS_F77_FUNC(dger,DGER)(m,n,&minustau,v,incv,work,&i1,c,ldc);
4136 : }
4137 : } else {
4138 3581 : if(std::abs(*tau)>PLUMED_GMX_DOUBLE_MIN) {
4139 3402 : PLUMED_BLAS_F77_FUNC(dgemv,DGEMV)("N",m,n,&one,c,ldc,v,incv,&zero,work,&i1);
4140 3402 : PLUMED_BLAS_F77_FUNC(dger,DGER)(m,n,&minustau,work,&i1,v,incv,c,ldc);
4141 : }
4142 : }
4143 1689941 : return;
4144 : }
4145 : }
4146 : }
4147 : #include "blas/blas.h"
4148 : #include "lapack.h"
4149 :
4150 :
4151 : #include "blas/blas.h"
4152 : namespace PLMD{
4153 : namespace lapack{
4154 : using namespace blas;
4155 : void
4156 147 : PLUMED_BLAS_F77_FUNC(dlarfb,DLARFB)(const char *side,
4157 : const char *trans,
4158 : const char *direct,
4159 : const char *storev,
4160 : int *m,
4161 : int *n,
4162 : int *k,
4163 : double *v,
4164 : int *ldv,
4165 : double *t,
4166 : int *ldt,
4167 : double *c__,
4168 : int *ldc,
4169 : double *work,
4170 : int *ldwork)
4171 : {
4172 : int c_dim1, c_offset, t_dim1, t_offset, v_dim1, v_offset, work_dim1,
4173 : work_offset, i__1, i__2;
4174 :
4175 : int i__, j;
4176 : char transt[1];
4177 147 : int c__1 = 1;
4178 147 : double one = 1.0;
4179 147 : double minusone = -1.0;
4180 :
4181 147 : v_dim1 = *ldv;
4182 147 : v_offset = 1 + v_dim1;
4183 147 : v -= v_offset;
4184 : t_dim1 = *ldt;
4185 : t_offset = 1 + t_dim1;
4186 : t -= t_offset;
4187 147 : c_dim1 = *ldc;
4188 147 : c_offset = 1 + c_dim1;
4189 147 : c__ -= c_offset;
4190 147 : work_dim1 = *ldwork;
4191 147 : work_offset = 1 + work_dim1;
4192 147 : work -= work_offset;
4193 :
4194 147 : if (*m <= 0 || *n <= 0) {
4195 : return;
4196 : }
4197 147 : if (*trans=='N' || *trans=='n') {
4198 107 : *(unsigned char *)transt = 'T';
4199 : } else {
4200 40 : *(unsigned char *)transt = 'N';
4201 : }
4202 :
4203 147 : if (*storev=='C' || *storev=='c') {
4204 :
4205 107 : if (*direct=='F' || *direct=='f') {
4206 48 : if (*side=='l' || *side=='L') {
4207 :
4208 48 : i__1 = *k;
4209 1124 : for (j = 1; j <= i__1; ++j) {
4210 1076 : PLUMED_BLAS_F77_FUNC(dcopy,DCOPY)(n, &c__[j + c_dim1], ldc, &work[j * work_dim1 + 1],
4211 : &c__1);
4212 : }
4213 :
4214 48 : PLUMED_BLAS_F77_FUNC(dtrmm,DTRMM)("Right", "Lower", "No transpose", "Unit", n, k, &one,
4215 : &v[v_offset], ldv, &work[work_offset], ldwork);
4216 48 : if (*m > *k) {
4217 :
4218 31 : i__1 = *m - *k;
4219 31 : PLUMED_BLAS_F77_FUNC(dgemm,DGEMM)("Transpose", "No transpose", n, k, &i__1, &one, &
4220 31 : c__[*k + 1 + c_dim1], ldc, &v[*k + 1 + v_dim1],
4221 : ldv, &one, &work[work_offset], ldwork);
4222 : }
4223 :
4224 48 : PLUMED_BLAS_F77_FUNC(dtrmm,DTRMM)("Right", "Upper", transt, "Non-unit", n, k, &one, &t[
4225 : t_offset], ldt, &work[work_offset], ldwork);
4226 :
4227 48 : if (*m > *k) {
4228 31 : i__1 = *m - *k;
4229 31 : PLUMED_BLAS_F77_FUNC(dgemm,DGEMM)("No transpose", "Transpose", &i__1, n, k, &minusone, &
4230 31 : v[*k + 1 + v_dim1], ldv, &work[work_offset],
4231 31 : ldwork, &one, &c__[*k + 1 + c_dim1], ldc);
4232 : }
4233 :
4234 48 : PLUMED_BLAS_F77_FUNC(dtrmm,DTRMM)("Right", "Lower", "Transpose", "Unit", n, k, &one, &
4235 : v[v_offset], ldv, &work[work_offset], ldwork);
4236 :
4237 48 : i__1 = *k;
4238 1124 : for (j = 1; j <= i__1; ++j) {
4239 1076 : i__2 = *n;
4240 271892 : for (i__ = 1; i__ <= i__2; ++i__) {
4241 270816 : c__[j + i__ * c_dim1] -= work[i__ + j * work_dim1];
4242 : }
4243 : }
4244 :
4245 0 : } else if (*side=='r' || *side=='R') {
4246 :
4247 0 : i__1 = *k;
4248 0 : for (j = 1; j <= i__1; ++j) {
4249 0 : PLUMED_BLAS_F77_FUNC(dcopy,DCOPY)(m, &c__[j * c_dim1 + 1], &c__1, &work[j *
4250 0 : work_dim1 + 1], &c__1);
4251 : }
4252 :
4253 0 : PLUMED_BLAS_F77_FUNC(dtrmm,DTRMM)("Right", "Lower", "No transpose", "Unit", m, k, &one,
4254 : &v[v_offset], ldv, &work[work_offset], ldwork);
4255 0 : if (*n > *k) {
4256 :
4257 0 : i__1 = *n - *k;
4258 0 : PLUMED_BLAS_F77_FUNC(dgemm,DGEMM)("No transpose", "No transpose", m, k, &i__1, &
4259 0 : one, &c__[(*k + 1) * c_dim1 + 1], ldc, &v[*k +
4260 0 : 1 + v_dim1], ldv, &one, &work[work_offset],
4261 : ldwork);
4262 : }
4263 :
4264 0 : PLUMED_BLAS_F77_FUNC(dtrmm,DTRMM)("Right", "Upper", trans, "Non-unit", m, k, &one, &t[
4265 : t_offset], ldt, &work[work_offset], ldwork);
4266 :
4267 0 : if (*n > *k) {
4268 0 : i__1 = *n - *k;
4269 0 : PLUMED_BLAS_F77_FUNC(dgemm,DGEMM)("No transpose", "Transpose", m, &i__1, k, &minusone, &
4270 0 : work[work_offset], ldwork, &v[*k + 1 + v_dim1],
4271 0 : ldv, &one, &c__[(*k + 1) * c_dim1 + 1], ldc);
4272 : }
4273 :
4274 0 : PLUMED_BLAS_F77_FUNC(dtrmm,DTRMM)("Right", "Lower", "Transpose", "Unit", m, k, &one, &
4275 : v[v_offset], ldv, &work[work_offset], ldwork);
4276 :
4277 0 : i__1 = *k;
4278 0 : for (j = 1; j <= i__1; ++j) {
4279 0 : i__2 = *m;
4280 0 : for (i__ = 1; i__ <= i__2; ++i__) {
4281 0 : c__[i__ + j * c_dim1] -= work[i__ + j * work_dim1];
4282 : }
4283 : }
4284 : }
4285 :
4286 : } else {
4287 :
4288 59 : if (*side=='l' || *side=='L') {
4289 59 : i__1 = *k;
4290 1663 : for (j = 1; j <= i__1; ++j) {
4291 1604 : PLUMED_BLAS_F77_FUNC(dcopy,DCOPY)(n, &c__[*m - *k + j + c_dim1], ldc, &work[j *
4292 1604 : work_dim1 + 1], &c__1);
4293 : }
4294 :
4295 59 : PLUMED_BLAS_F77_FUNC(dtrmm,DTRMM)("Right", "Upper", "No transpose", "Unit", n, k, &one,
4296 59 : &v[*m - *k + 1 + v_dim1], ldv, &work[work_offset],
4297 : ldwork);
4298 59 : if (*m > *k) {
4299 47 : i__1 = *m - *k;
4300 47 : PLUMED_BLAS_F77_FUNC(dgemm,DGEMM)("Transpose", "No transpose", n, k, &i__1, &one, &
4301 : c__[c_offset], ldc, &v[v_offset], ldv, &one, &
4302 : work[work_offset], ldwork);
4303 : }
4304 :
4305 59 : PLUMED_BLAS_F77_FUNC(dtrmm,DTRMM)("Right", "Lower", transt, "Non-unit", n, k, &one, &t[
4306 : t_offset], ldt, &work[work_offset], ldwork);
4307 :
4308 59 : if (*m > *k) {
4309 :
4310 47 : i__1 = *m - *k;
4311 47 : PLUMED_BLAS_F77_FUNC(dgemm,DGEMM)("No transpose", "Transpose", &i__1, n, k, &minusone, &
4312 : v[v_offset], ldv, &work[work_offset], ldwork, &
4313 : one, &c__[c_offset], ldc)
4314 : ;
4315 : }
4316 :
4317 59 : PLUMED_BLAS_F77_FUNC(dtrmm,DTRMM)("Right", "Upper", "Transpose", "Unit", n, k, &one, &
4318 59 : v[*m - *k + 1 + v_dim1], ldv, &work[work_offset],
4319 : ldwork);
4320 :
4321 59 : i__1 = *k;
4322 1663 : for (j = 1; j <= i__1; ++j) {
4323 1604 : i__2 = *n;
4324 391844 : for (i__ = 1; i__ <= i__2; ++i__) {
4325 390240 : c__[*m - *k + j + i__ * c_dim1] -= work[i__ + j *
4326 390240 : work_dim1];
4327 : }
4328 : }
4329 :
4330 0 : } else if (*side=='r' || *side=='R') {
4331 0 : i__1 = *k;
4332 0 : for (j = 1; j <= i__1; ++j) {
4333 0 : PLUMED_BLAS_F77_FUNC(dcopy,DCOPY)(m, &c__[(*n - *k + j) * c_dim1 + 1], &c__1, &work[
4334 0 : j * work_dim1 + 1], &c__1);
4335 : }
4336 :
4337 0 : PLUMED_BLAS_F77_FUNC(dtrmm,DTRMM)("Right", "Upper", "No transpose", "Unit", m, k, &one,
4338 0 : &v[*n - *k + 1 + v_dim1], ldv, &work[work_offset],
4339 : ldwork);
4340 0 : if (*n > *k) {
4341 0 : i__1 = *n - *k;
4342 0 : PLUMED_BLAS_F77_FUNC(dgemm,DGEMM)("No transpose", "No transpose", m, k, &i__1, &
4343 : one, &c__[c_offset], ldc, &v[v_offset], ldv, &
4344 : one, &work[work_offset], ldwork);
4345 : }
4346 0 : PLUMED_BLAS_F77_FUNC(dtrmm,DTRMM)("Right", "Lower", trans, "Non-unit", m, k, &one, &t[
4347 : t_offset], ldt, &work[work_offset], ldwork);
4348 0 : if (*n > *k) {
4349 0 : i__1 = *n - *k;
4350 0 : PLUMED_BLAS_F77_FUNC(dgemm,DGEMM)("No transpose", "Transpose", m, &i__1, k, &minusone, &
4351 : work[work_offset], ldwork, &v[v_offset], ldv, &
4352 : one, &c__[c_offset], ldc)
4353 : ;
4354 : }
4355 0 : PLUMED_BLAS_F77_FUNC(dtrmm,DTRMM)("Right", "Upper", "Transpose", "Unit", m, k, &one, &
4356 0 : v[*n - *k + 1 + v_dim1], ldv, &work[work_offset],
4357 : ldwork);
4358 0 : i__1 = *k;
4359 0 : for (j = 1; j <= i__1; ++j) {
4360 0 : i__2 = *m;
4361 0 : for (i__ = 1; i__ <= i__2; ++i__) {
4362 0 : c__[i__ + (*n - *k + j) * c_dim1] -= work[i__ + j *
4363 0 : work_dim1];
4364 : }
4365 : }
4366 : }
4367 : }
4368 :
4369 40 : } else if (*storev=='r' || *storev=='R') {
4370 40 : if (*direct=='F' || *direct=='f') {
4371 40 : if (*side=='l' || *side=='L') {
4372 0 : i__1 = *k;
4373 0 : for (j = 1; j <= i__1; ++j) {
4374 0 : PLUMED_BLAS_F77_FUNC(dcopy,DCOPY)(n, &c__[j + c_dim1], ldc, &work[j * work_dim1 + 1],
4375 : &c__1);
4376 : }
4377 0 : PLUMED_BLAS_F77_FUNC(dtrmm,DTRMM)("Right", "Upper", "Transpose", "Unit", n, k, &one, &
4378 : v[v_offset], ldv, &work[work_offset], ldwork);
4379 0 : if (*m > *k) {
4380 0 : i__1 = *m - *k;
4381 0 : PLUMED_BLAS_F77_FUNC(dgemm,DGEMM)("Transpose", "Transpose", n, k, &i__1, &one, &
4382 0 : c__[*k + 1 + c_dim1], ldc, &v[(*k + 1) * v_dim1 +
4383 0 : 1], ldv, &one, &work[work_offset], ldwork);
4384 : }
4385 :
4386 0 : PLUMED_BLAS_F77_FUNC(dtrmm,DTRMM)("Right", "Upper", transt, "Non-unit", n, k, &one, &t[
4387 : t_offset], ldt, &work[work_offset], ldwork);
4388 0 : if (*m > *k) {
4389 :
4390 0 : i__1 = *m - *k;
4391 0 : PLUMED_BLAS_F77_FUNC(dgemm,DGEMM)("Transpose", "Transpose", &i__1, n, k, &minusone, &v[(
4392 0 : *k + 1) * v_dim1 + 1], ldv, &work[work_offset],
4393 0 : ldwork, &one, &c__[*k + 1 + c_dim1], ldc);
4394 : }
4395 :
4396 0 : PLUMED_BLAS_F77_FUNC(dtrmm,DTRMM)("Right", "Upper", "No transpose", "Unit", n, k, &one,
4397 : &v[v_offset], ldv, &work[work_offset], ldwork);
4398 :
4399 0 : i__1 = *k;
4400 0 : for (j = 1; j <= i__1; ++j) {
4401 0 : i__2 = *n;
4402 0 : for (i__ = 1; i__ <= i__2; ++i__) {
4403 0 : c__[j + i__ * c_dim1] -= work[i__ + j * work_dim1];
4404 : }
4405 : }
4406 :
4407 40 : } else if (*side=='r' || *side=='R') {
4408 :
4409 40 : i__1 = *k;
4410 971 : for (j = 1; j <= i__1; ++j) {
4411 931 : PLUMED_BLAS_F77_FUNC(dcopy,DCOPY)(m, &c__[j * c_dim1 + 1], &c__1, &work[j *
4412 931 : work_dim1 + 1], &c__1);
4413 : }
4414 :
4415 40 : PLUMED_BLAS_F77_FUNC(dtrmm,DTRMM)("Right", "Upper", "Transpose", "Unit", m, k, &one, &
4416 : v[v_offset], ldv, &work[work_offset], ldwork);
4417 40 : if (*n > *k) {
4418 :
4419 27 : i__1 = *n - *k;
4420 27 : PLUMED_BLAS_F77_FUNC(dgemm,DGEMM)("No transpose", "Transpose", m, k, &i__1, &one, &
4421 27 : c__[(*k + 1) * c_dim1 + 1], ldc, &v[(*k + 1) *
4422 27 : v_dim1 + 1], ldv, &one, &work[work_offset],
4423 : ldwork);
4424 : }
4425 :
4426 40 : PLUMED_BLAS_F77_FUNC(dtrmm,DTRMM)("Right", "Upper", trans, "Non-unit", m, k, &one, &t[
4427 : t_offset], ldt, &work[work_offset], ldwork);
4428 :
4429 40 : if (*n > *k) {
4430 :
4431 27 : i__1 = *n - *k;
4432 27 : PLUMED_BLAS_F77_FUNC(dgemm,DGEMM)("No transpose", "No transpose", m, &i__1, k, &
4433 27 : minusone, &work[work_offset], ldwork, &v[(*k + 1) *
4434 27 : v_dim1 + 1], ldv, &one, &c__[(*k + 1) * c_dim1
4435 27 : + 1], ldc);
4436 : }
4437 40 : PLUMED_BLAS_F77_FUNC(dtrmm,DTRMM)("Right", "Upper", "No transpose", "Unit", m, k, &one,
4438 : &v[v_offset], ldv, &work[work_offset], ldwork);
4439 40 : i__1 = *k;
4440 971 : for (j = 1; j <= i__1; ++j) {
4441 931 : i__2 = *m;
4442 266447 : for (i__ = 1; i__ <= i__2; ++i__) {
4443 265516 : c__[i__ + j * c_dim1] -= work[i__ + j * work_dim1];
4444 : }
4445 : }
4446 :
4447 : }
4448 :
4449 : } else {
4450 :
4451 0 : if (*side=='l' || *side=='L') {
4452 :
4453 0 : i__1 = *k;
4454 0 : for (j = 1; j <= i__1; ++j) {
4455 0 : PLUMED_BLAS_F77_FUNC(dcopy,DCOPY)(n, &c__[*m - *k + j + c_dim1], ldc, &work[j *
4456 0 : work_dim1 + 1], &c__1);
4457 : }
4458 :
4459 0 : PLUMED_BLAS_F77_FUNC(dtrmm,DTRMM)("Right", "Lower", "Transpose", "Unit", n, k, &one, &
4460 0 : v[(*m - *k + 1) * v_dim1 + 1], ldv, &work[work_offset]
4461 : , ldwork);
4462 0 : if (*m > *k) {
4463 :
4464 0 : i__1 = *m - *k;
4465 0 : PLUMED_BLAS_F77_FUNC(dgemm,DGEMM)("Transpose", "Transpose", n, k, &i__1, &one, &
4466 : c__[c_offset], ldc, &v[v_offset], ldv, &one, &
4467 : work[work_offset], ldwork);
4468 : }
4469 :
4470 0 : PLUMED_BLAS_F77_FUNC(dtrmm,DTRMM)("Right", "Lower", transt, "Non-unit", n, k, &one, &t[
4471 : t_offset], ldt, &work[work_offset], ldwork);
4472 :
4473 0 : if (*m > *k) {
4474 :
4475 0 : i__1 = *m - *k;
4476 0 : PLUMED_BLAS_F77_FUNC(dgemm,DGEMM)("Transpose", "Transpose", &i__1, n, k, &minusone, &v[
4477 : v_offset], ldv, &work[work_offset], ldwork, &
4478 : one, &c__[c_offset], ldc);
4479 : }
4480 :
4481 0 : PLUMED_BLAS_F77_FUNC(dtrmm,DTRMM)("Right", "Lower", "No transpose", "Unit", n, k, &one,
4482 0 : &v[(*m - *k + 1) * v_dim1 + 1], ldv, &work[
4483 : work_offset], ldwork);
4484 :
4485 0 : i__1 = *k;
4486 0 : for (j = 1; j <= i__1; ++j) {
4487 0 : i__2 = *n;
4488 0 : for (i__ = 1; i__ <= i__2; ++i__) {
4489 0 : c__[*m - *k + j + i__ * c_dim1] -= work[i__ + j *
4490 0 : work_dim1];
4491 : }
4492 : }
4493 :
4494 0 : } else if (*side=='r' || *side=='R') {
4495 :
4496 0 : i__1 = *k;
4497 0 : for (j = 1; j <= i__1; ++j) {
4498 0 : PLUMED_BLAS_F77_FUNC(dcopy,DCOPY)(m, &c__[(*n - *k + j) * c_dim1 + 1], &c__1, &work[
4499 0 : j * work_dim1 + 1], &c__1);
4500 : }
4501 :
4502 0 : PLUMED_BLAS_F77_FUNC(dtrmm,DTRMM)("Right", "Lower", "Transpose", "Unit", m, k, &one, &
4503 0 : v[(*n - *k + 1) * v_dim1 + 1], ldv, &work[work_offset]
4504 : , ldwork);
4505 0 : if (*n > *k) {
4506 :
4507 0 : i__1 = *n - *k;
4508 0 : PLUMED_BLAS_F77_FUNC(dgemm,DGEMM)("No transpose", "Transpose", m, k, &i__1, &one, &
4509 : c__[c_offset], ldc, &v[v_offset], ldv, &one, &
4510 : work[work_offset], ldwork);
4511 : }
4512 :
4513 0 : PLUMED_BLAS_F77_FUNC(dtrmm,DTRMM)("Right", "Lower", trans, "Non-unit", m, k, &one, &t[
4514 : t_offset], ldt, &work[work_offset], ldwork);
4515 :
4516 0 : if (*n > *k) {
4517 :
4518 0 : i__1 = *n - *k;
4519 0 : PLUMED_BLAS_F77_FUNC(dgemm,DGEMM)("No transpose", "No transpose", m, &i__1, k, &
4520 : minusone, &work[work_offset], ldwork, &v[v_offset],
4521 : ldv, &one, &c__[c_offset], ldc);
4522 : }
4523 :
4524 0 : PLUMED_BLAS_F77_FUNC(dtrmm,DTRMM)("Right", "Lower", "No transpose", "Unit", m, k, &one,
4525 0 : &v[(*n - *k + 1) * v_dim1 + 1], ldv, &work[
4526 : work_offset], ldwork);
4527 :
4528 0 : i__1 = *k;
4529 0 : for (j = 1; j <= i__1; ++j) {
4530 0 : i__2 = *m;
4531 0 : for (i__ = 1; i__ <= i__2; ++i__) {
4532 0 : c__[i__ + (*n - *k + j) * c_dim1] -= work[i__ + j *
4533 0 : work_dim1];
4534 : }
4535 : }
4536 :
4537 : }
4538 :
4539 : }
4540 : }
4541 :
4542 : return;
4543 :
4544 :
4545 : }
4546 :
4547 : }
4548 : }
4549 : #include <cmath>
4550 : #include "real.h"
4551 :
4552 : #include "blas/blas.h"
4553 : #include "lapack.h"
4554 : #include "lapack_limits.h"
4555 :
4556 :
4557 : #include "blas/blas.h"
4558 : namespace PLMD{
4559 : namespace lapack{
4560 : using namespace blas;
4561 : void
4562 1689415 : PLUMED_BLAS_F77_FUNC(dlarfg,DLARFG)(int *n,
4563 : double *alpha,
4564 : double *x,
4565 : int *incx,
4566 : double *tau)
4567 : {
4568 : double xnorm,t;
4569 : int ti1,knt,j;
4570 : double minval,safmin,rsafmn,beta;
4571 :
4572 1689415 : if(*n<=1) {
4573 570200 : *tau = 0;
4574 570200 : return;
4575 : }
4576 :
4577 1119215 : ti1 = *n-1;
4578 :
4579 1119215 : xnorm = PLUMED_BLAS_F77_FUNC(dnrm2,DNRM2)(&ti1,x,incx);
4580 :
4581 1119215 : if(std::abs(xnorm)<PLUMED_GMX_DOUBLE_MIN) {
4582 6 : *tau = 0.0;
4583 : } else {
4584 :
4585 1119209 : t = PLUMED_BLAS_F77_FUNC(dlapy2,DLAPY2)(alpha,&xnorm);
4586 :
4587 1119209 : if(*alpha<0)
4588 : beta = t;
4589 : else
4590 453446 : beta = -t;
4591 :
4592 : minval = PLUMED_GMX_DOUBLE_MIN;
4593 :
4594 : safmin = minval*(1.0+PLUMED_GMX_DOUBLE_EPS) / PLUMED_GMX_DOUBLE_EPS;
4595 :
4596 :
4597 1119209 : if(std::abs(beta)<safmin) {
4598 :
4599 : knt = 0;
4600 0 : rsafmn = 1.0 / safmin;
4601 :
4602 0 : while(std::abs(beta)<safmin) {
4603 0 : knt++;
4604 0 : ti1 = *n-1;
4605 0 : PLUMED_BLAS_F77_FUNC(dscal,DSCAL)(&ti1,&rsafmn,x,incx);
4606 0 : beta *= rsafmn;
4607 0 : *alpha *= rsafmn;
4608 : }
4609 :
4610 : /* safmin <= beta <= 1 now */
4611 0 : ti1 = *n-1;
4612 0 : xnorm = PLUMED_BLAS_F77_FUNC(dnrm2,DNRM2)(&ti1,x,incx);
4613 0 : t = PLUMED_BLAS_F77_FUNC(dlapy2,DLAPY2)(alpha,&xnorm);
4614 :
4615 0 : if(*alpha<0)
4616 : beta = t;
4617 : else
4618 0 : beta = -t;
4619 :
4620 0 : *tau = (beta-*alpha)/beta;
4621 :
4622 0 : ti1= *n-1;
4623 0 : t = 1.0/(*alpha-beta);
4624 0 : PLUMED_BLAS_F77_FUNC(dscal,DSCAL)(&ti1,&t,x,incx);
4625 :
4626 0 : *alpha = beta;
4627 0 : for(j=0;j<knt;j++)
4628 0 : *alpha *= safmin;
4629 : } else {
4630 1119209 : *tau = (beta-*alpha)/beta;
4631 1119209 : ti1= *n-1;
4632 1119209 : t = 1.0/(*alpha-beta);
4633 1119209 : PLUMED_BLAS_F77_FUNC(dscal,DSCAL)(&ti1,&t,x,incx);
4634 1119209 : *alpha = beta;
4635 : }
4636 : }
4637 :
4638 : return;
4639 : }
4640 : }
4641 : }
4642 : #include <cmath>
4643 : #include "real.h"
4644 :
4645 : #include "blas/blas.h"
4646 : #include "lapack.h"
4647 :
4648 : #include "blas/blas.h"
4649 : namespace PLMD{
4650 : namespace lapack{
4651 : using namespace blas;
4652 : void
4653 147 : PLUMED_BLAS_F77_FUNC(dlarft,DLARFT)(const char *direct,
4654 : const char *storev,
4655 : int *n,
4656 : int *k,
4657 : double *v,
4658 : int *ldv,
4659 : double *tau,
4660 : double *t,
4661 : int *ldt)
4662 : {
4663 : /* System generated locals */
4664 : int t_dim1, t_offset, v_dim1, v_offset, i__1, i__2, i__3;
4665 : double d__1;
4666 :
4667 : /* Local variables */
4668 : int i__, j;
4669 : double vii;
4670 147 : int c__1 = 1;
4671 147 : double zero = 0.0;
4672 :
4673 147 : v_dim1 = *ldv;
4674 147 : v_offset = 1 + v_dim1;
4675 147 : v -= v_offset;
4676 147 : --tau;
4677 147 : t_dim1 = *ldt;
4678 147 : t_offset = 1 + t_dim1;
4679 147 : t -= t_offset;
4680 :
4681 147 : if (*n == 0) {
4682 : return;
4683 : }
4684 :
4685 147 : if (*direct=='F' || *direct=='f') {
4686 88 : i__1 = *k;
4687 2095 : for (i__ = 1; i__ <= i__1; ++i__) {
4688 2007 : if (std::abs(tau[i__])<PLUMED_GMX_DOUBLE_MIN) {
4689 :
4690 30 : i__2 = i__;
4691 181 : for (j = 1; j <= i__2; ++j) {
4692 151 : t[j + i__ * t_dim1] = 0.;
4693 : }
4694 : } else {
4695 :
4696 1977 : vii = v[i__ + i__ * v_dim1];
4697 1977 : v[i__ + i__ * v_dim1] = 1.;
4698 1977 : if (*storev=='C' || *storev=='c') {
4699 :
4700 1059 : i__2 = *n - i__ + 1;
4701 1059 : i__3 = i__ - 1;
4702 1059 : d__1 = -tau[i__];
4703 1059 : PLUMED_BLAS_F77_FUNC(dgemv,DGEMV)("Transpose", &i__2, &i__3, &d__1, &v[i__ + v_dim1],
4704 : ldv, &v[i__ + i__ * v_dim1], &c__1, &zero, &t[
4705 1059 : i__ * t_dim1 + 1], &c__1);
4706 : } else {
4707 :
4708 918 : i__2 = i__ - 1;
4709 918 : i__3 = *n - i__ + 1;
4710 918 : d__1 = -tau[i__];
4711 918 : PLUMED_BLAS_F77_FUNC(dgemv,DGEMV)("No transpose", &i__2, &i__3, &d__1, &v[i__ *
4712 918 : v_dim1 + 1], ldv, &v[i__ + i__ * v_dim1], ldv, &
4713 918 : zero, &t[i__ * t_dim1 + 1], &c__1);
4714 : }
4715 1977 : v[i__ + i__ * v_dim1] = vii;
4716 :
4717 :
4718 1977 : i__2 = i__ - 1;
4719 1977 : PLUMED_BLAS_F77_FUNC(dtrmv,DTRMV)("Upper", "No transpose", "Non-unit", &i__2, &t[
4720 1977 : t_offset], ldt, &t[i__ * t_dim1 + 1], &c__1);
4721 1977 : t[i__ + i__ * t_dim1] = tau[i__];
4722 : }
4723 : }
4724 : } else {
4725 1663 : for (i__ = *k; i__ >= 1; --i__) {
4726 1604 : if (std::abs(tau[i__])<PLUMED_GMX_DOUBLE_MIN) {
4727 :
4728 12 : i__1 = *k;
4729 396 : for (j = i__; j <= i__1; ++j) {
4730 384 : t[j + i__ * t_dim1] = 0.;
4731 : }
4732 : } else {
4733 :
4734 1592 : if (i__ < *k) {
4735 1533 : if (*storev=='C' || *storev=='c') {
4736 1533 : vii = v[*n - *k + i__ + i__ * v_dim1];
4737 1533 : v[*n - *k + i__ + i__ * v_dim1] = 1.;
4738 :
4739 1533 : i__1 = *n - *k + i__;
4740 1533 : i__2 = *k - i__;
4741 1533 : d__1 = -tau[i__];
4742 1533 : PLUMED_BLAS_F77_FUNC(dgemv,DGEMV)("Transpose", &i__1, &i__2, &d__1, &v[(i__ + 1)
4743 1533 : * v_dim1 + 1], ldv, &v[i__ * v_dim1 + 1], &
4744 1533 : c__1, &zero, &t[i__ + 1 + i__ * t_dim1], &
4745 : c__1);
4746 1533 : v[*n - *k + i__ + i__ * v_dim1] = vii;
4747 : } else {
4748 0 : vii = v[i__ + (*n - *k + i__) * v_dim1];
4749 0 : v[i__ + (*n - *k + i__) * v_dim1] = 1.;
4750 :
4751 0 : i__1 = *k - i__;
4752 0 : i__2 = *n - *k + i__;
4753 0 : d__1 = -tau[i__];
4754 0 : PLUMED_BLAS_F77_FUNC(dgemv,DGEMV)("No transpose", &i__1, &i__2, &d__1, &v[i__ +
4755 0 : 1 + v_dim1], ldv, &v[i__ + v_dim1], ldv, &
4756 0 : zero, &t[i__ + 1 + i__ * t_dim1], &c__1);
4757 0 : v[i__ + (*n - *k + i__) * v_dim1] = vii;
4758 : }
4759 :
4760 1533 : i__1 = *k - i__;
4761 1533 : PLUMED_BLAS_F77_FUNC(dtrmv,DTRMV)("Lower", "No transpose", "Non-unit", &i__1, &t[i__
4762 1533 : + 1 + (i__ + 1) * t_dim1], ldt, &t[i__ + 1 + i__ *
4763 1533 : t_dim1], &c__1)
4764 : ;
4765 : }
4766 1592 : t[i__ + i__ * t_dim1] = tau[i__];
4767 : }
4768 : }
4769 : }
4770 : return;
4771 :
4772 :
4773 : }
4774 : }
4775 : }
4776 : #include <cmath>
4777 : #include "lapack.h"
4778 :
4779 : #include "blas/blas.h"
4780 : namespace PLMD{
4781 : namespace lapack{
4782 : using namespace blas;
4783 : void
4784 0 : PLUMED_BLAS_F77_FUNC(dlarnv,DLARNV)(int *idist,
4785 : int *iseed,
4786 : int *n,
4787 : double *x)
4788 : {
4789 : int i__1, i__2, i__3;
4790 :
4791 : int i__;
4792 : double u[128];
4793 : int il, iv, il2;
4794 :
4795 0 : --x;
4796 : --iseed;
4797 :
4798 0 : i__1 = *n;
4799 0 : for (iv = 1; iv <= i__1; iv += 64) {
4800 0 : i__2 = 64, i__3 = *n - iv + 1;
4801 : il = (i__2<i__3) ? i__2 : i__3;
4802 0 : if (*idist == 3) {
4803 0 : il2 = il << 1;
4804 : } else {
4805 0 : il2 = il;
4806 : }
4807 :
4808 0 : PLUMED_BLAS_F77_FUNC(dlaruv,DLARUV)(&iseed[1], &il2, u);
4809 :
4810 0 : if (*idist == 1) {
4811 :
4812 : i__2 = il;
4813 0 : for (i__ = 1; i__ <= i__2; ++i__) {
4814 0 : x[iv + i__ - 1] = u[i__ - 1];
4815 : }
4816 0 : } else if (*idist == 2) {
4817 :
4818 : i__2 = il;
4819 0 : for (i__ = 1; i__ <= i__2; ++i__) {
4820 0 : x[iv + i__ - 1] = u[i__ - 1] * 2. - 1.;
4821 : }
4822 0 : } else if (*idist == 3) {
4823 :
4824 : i__2 = il;
4825 0 : for (i__ = 1; i__ <= i__2; ++i__) {
4826 0 : x[iv + i__ - 1] = std::sqrt(std::log(u[(i__ << 1) - 2]) * -2.) *
4827 0 : std::cos(u[(i__ << 1) - 1] * (double)6.2831853071795864769252867663);
4828 : }
4829 : }
4830 : }
4831 0 : return;
4832 :
4833 : }
4834 : }
4835 : }
4836 : #include <cmath>
4837 :
4838 : #include "real.h"
4839 :
4840 : #include "lapack.h"
4841 : #include "lapack_limits.h"
4842 :
4843 : #include "blas/blas.h"
4844 : namespace PLMD{
4845 : namespace lapack{
4846 : using namespace blas;
4847 : void
4848 570080 : PLUMED_BLAS_F77_FUNC(dlarrbx,DLARRBX)(int *n,
4849 : double *d__,
4850 : double *l,
4851 : double *ld,
4852 : double *lld,
4853 : int *ifirst,
4854 : int *ilast,
4855 : double *rtol1,
4856 : double *rtol2,
4857 : int *offset,
4858 : double *w,
4859 : double *wgap,
4860 : double *werr,
4861 : double *work,
4862 : int *iwork,
4863 : int *info)
4864 : {
4865 : int i__1, i__2, i__3;
4866 : double d__1, d__2;
4867 :
4868 : int i__, j, k, p;
4869 : double s;
4870 : int i1, i2, ii, kk;
4871 : double fac, gap, mid;
4872 : int cnt;
4873 : double tmp, left;
4874 : int nint, prev, next, nleft;
4875 : double right, width, dplus;
4876 : int nright, olnint;
4877 : k = 0;
4878 : right = 0.0;
4879 :
4880 570080 : --iwork;
4881 570080 : --work;
4882 570080 : --werr;
4883 570080 : --wgap;
4884 570080 : --w;
4885 570080 : --lld;
4886 : --ld;
4887 : --l;
4888 570080 : --d__;
4889 :
4890 570080 : *info = 0;
4891 570080 : i__1 = *n << 1;
4892 5134148 : for (i__ = 1; i__ <= i__1; ++i__) {
4893 4564068 : iwork[i__] = 0;
4894 : }
4895 570080 : i1 = *ifirst;
4896 : i2 = *ifirst;
4897 : prev = 0;
4898 570080 : i__1 = *ilast;
4899 1141026 : for (i__ = *ifirst; i__ <= i__1; ++i__) {
4900 570946 : k = i__ << 1;
4901 570946 : iwork[k - 1] = 1;
4902 : i2 = i__;
4903 : }
4904 :
4905 : i__ = i1;
4906 : nint = 0;
4907 1141026 : L30:
4908 1141026 : if (i__ <= i2) {
4909 570946 : ii = i__ - *offset;
4910 570946 : if (iwork[(i__ << 1) - 1] == 1) {
4911 : fac = 1.;
4912 570946 : left = w[ii] - werr[ii];
4913 :
4914 :
4915 571036 : L40:
4916 571036 : if (i__ > i1 && left <= right) {
4917 : left = right;
4918 0 : cnt = i__ - 1;
4919 : } else {
4920 571036 : s = -left;
4921 : cnt = 0;
4922 571036 : i__1 = *n - 1;
4923 2677326 : for (j = 1; j <= i__1; ++j) {
4924 2106290 : dplus = d__[j] + s;
4925 2106290 : s = s * lld[j] / dplus - left;
4926 2106290 : if (dplus < 0.) {
4927 209478 : ++cnt;
4928 : }
4929 : }
4930 571036 : dplus = d__[*n] + s;
4931 571036 : if (dplus < 0.) {
4932 90 : ++cnt;
4933 : }
4934 571036 : if (std::isnan(s)) {
4935 :
4936 : cnt = 0;
4937 : s = -left;
4938 : i__1 = *n - 1;
4939 0 : for (j = 1; j <= i__1; ++j) {
4940 0 : dplus = d__[j] + s;
4941 0 : if (dplus < 0.) {
4942 0 : ++cnt;
4943 : }
4944 0 : tmp = lld[j] / dplus;
4945 0 : if (std::abs(tmp)<PLUMED_GMX_DOUBLE_MIN) {
4946 0 : s = lld[j] - left;
4947 : } else {
4948 0 : s = s * tmp - left;
4949 : }
4950 : }
4951 0 : dplus = d__[*n] + s;
4952 0 : if (dplus < 0.) {
4953 0 : ++cnt;
4954 : }
4955 : }
4956 571036 : if (cnt > i__ - 1) {
4957 90 : left -= werr[ii] * fac;
4958 90 : fac *= 2.;
4959 90 : goto L40;
4960 : }
4961 : }
4962 570946 : nleft = cnt + 1;
4963 : i1 = (i1<nleft) ? i1 : nleft;
4964 : fac = 1.;
4965 570946 : right = w[ii] + werr[ii];
4966 570962 : L60:
4967 570962 : s = -right;
4968 : cnt = 0;
4969 570962 : i__1 = *n - 1;
4970 2654326 : for (j = 1; j <= i__1; ++j) {
4971 2083364 : dplus = d__[j] + s;
4972 2083364 : s = s * lld[j] / dplus - right;
4973 2083364 : if (dplus < 0.) {
4974 1882759 : ++cnt;
4975 : }
4976 : }
4977 570962 : dplus = d__[*n] + s;
4978 570962 : if (dplus < 0.) {
4979 570942 : ++cnt;
4980 : }
4981 570962 : if (std::isnan(s)) {
4982 :
4983 : cnt = 0;
4984 : s = -right;
4985 : i__1 = *n - 1;
4986 0 : for (j = 1; j <= i__1; ++j) {
4987 0 : dplus = d__[j] + s;
4988 0 : if (dplus < 0.) {
4989 0 : ++cnt;
4990 : }
4991 0 : tmp = lld[j] / dplus;
4992 0 : if (std::abs(tmp)<PLUMED_GMX_DOUBLE_MIN) {
4993 0 : s = lld[j] - right;
4994 : } else {
4995 0 : s = s * tmp - right;
4996 : }
4997 : }
4998 0 : dplus = d__[*n] + s;
4999 0 : if (dplus < 0.) {
5000 0 : ++cnt;
5001 : }
5002 : }
5003 570962 : if (cnt < i__) {
5004 16 : right += werr[ii] * fac;
5005 16 : fac *= 2.;
5006 16 : goto L60;
5007 : }
5008 : cnt = (cnt<i2) ? cnt : i2;
5009 570946 : ++nint;
5010 570946 : k = nleft << 1;
5011 570946 : work[k - 1] = left;
5012 570946 : work[k] = right;
5013 570946 : i__ = cnt + 1;
5014 570946 : iwork[k - 1] = i__;
5015 570946 : iwork[k] = cnt;
5016 570946 : if (prev != nleft - 1) {
5017 70 : work[k - 2] = left;
5018 : }
5019 : prev = nleft;
5020 : } else {
5021 0 : right = work[i__ * 2];
5022 :
5023 0 : ++iwork[k - 1];
5024 : prev = i__;
5025 0 : ++i__;
5026 : }
5027 570946 : goto L30;
5028 : }
5029 570080 : if (i__ <= *n && iwork[(i__ << 1) - 1] != -1) {
5030 490521 : work[(i__ << 1) - 1] = work[prev * 2];
5031 : }
5032 :
5033 79559 : L80:
5034 29310201 : prev = i1 - 1;
5035 : olnint = nint;
5036 : i__ = i1;
5037 : i__1 = olnint;
5038 58621950 : for (p = 1; p <= i__1; ++p) {
5039 29311749 : k = i__ << 1;
5040 29311749 : left = work[k - 1];
5041 29311749 : right = work[k];
5042 29311749 : next = iwork[k - 1];
5043 29311749 : nright = iwork[k];
5044 29311749 : mid = (left + right) * .5;
5045 29311749 : width = right - mid;
5046 : d__1 = std::abs(left);
5047 : d__2 = std::abs(right);
5048 29311749 : tmp = (d__1>d__2) ? d__1 : d__2;
5049 :
5050 : gap = 0.;
5051 29311749 : if (i__ == nright) {
5052 29071087 : if (prev > 0 && next <= *n) {
5053 2391 : d__1 = left - work[k - 2], d__2 = work[k + 1] - right;
5054 2391 : gap = (d__1<d__2) ? d__1 : d__2;
5055 29068696 : } else if (prev > 0) {
5056 4055695 : gap = left - work[k - 2];
5057 25013001 : } else if (next <= *n) {
5058 25013001 : gap = work[k + 1] - right;
5059 : }
5060 : }
5061 29311749 : d__1 = *rtol1 * gap, d__2 = *rtol2 * tmp;
5062 32850455 : if (width < ((d__1>d__2) ? d__1 : d__2)) {
5063 570946 : --nint;
5064 570946 : iwork[k - 1] = 0;
5065 : kk = k;
5066 : i__2 = nright;
5067 570946 : for (j = i__ + 1; j <= i__2; ++j) {
5068 0 : kk += 2;
5069 0 : iwork[kk - 1] = 0;
5070 0 : work[kk - 1] = left;
5071 0 : work[kk] = right;
5072 0 : wgap[j - 1 - *offset] = 0.;
5073 : }
5074 570946 : if (i1 == i__) {
5075 : i1 = next;
5076 : } else {
5077 831 : iwork[(prev << 1) - 1] = next;
5078 : }
5079 : i__ = next;
5080 570946 : continue;
5081 : }
5082 : prev = i__;
5083 :
5084 28740803 : s = -mid;
5085 : cnt = 0;
5086 28740803 : i__2 = *n - 1;
5087 114232646 : for (j = 1; j <= i__2; ++j) {
5088 85491843 : dplus = d__[j] + s;
5089 85491843 : s = s * lld[j] / dplus - mid;
5090 85491843 : if (dplus < 0.) {
5091 15244804 : ++cnt;
5092 : }
5093 : }
5094 28740803 : dplus = d__[*n] + s;
5095 28740803 : if (dplus < 0.) {
5096 12605336 : ++cnt;
5097 : }
5098 28740803 : if (std::isnan(s)) {
5099 : cnt = 0;
5100 : s = -mid;
5101 : i__2 = *n - 1;
5102 0 : for (j = 1; j <= i__2; ++j) {
5103 0 : dplus = d__[j] + s;
5104 0 : if (dplus < 0.) {
5105 0 : ++cnt;
5106 : }
5107 0 : tmp = lld[j] / dplus;
5108 0 : if (std::abs(tmp)<PLUMED_GMX_DOUBLE_MIN) {
5109 0 : s = lld[j] - mid;
5110 : } else {
5111 0 : s = s * tmp - mid;
5112 : }
5113 : }
5114 0 : dplus = d__[*n] + s;
5115 0 : if (dplus < 0.) {
5116 0 : ++cnt;
5117 : }
5118 : }
5119 28740803 : i__2 = i__ - 1, i__3 = (nright<cnt) ? nright : cnt;
5120 : cnt = (i__2>i__3) ? i__2 : i__3;
5121 28740803 : if (cnt == i__ - 1) {
5122 13873731 : work[k - 1] = mid;
5123 14867072 : } else if (cnt == nright) {
5124 14658933 : work[k] = mid;
5125 : } else {
5126 208139 : iwork[k] = cnt;
5127 208139 : ++cnt;
5128 208139 : iwork[k - 1] = cnt;
5129 208139 : kk = cnt << 1;
5130 208139 : iwork[kk - 1] = next;
5131 208139 : iwork[kk] = nright;
5132 208139 : work[k] = mid;
5133 208139 : work[kk - 1] = mid;
5134 208139 : work[kk] = right;
5135 : prev = cnt;
5136 208139 : if (cnt - 1 > i__) {
5137 30298 : work[kk - 2] = mid;
5138 : }
5139 208139 : if (cnt > *ifirst && cnt <= *ilast) {
5140 0 : ++nint;
5141 208139 : } else if (cnt <= *ifirst) {
5142 : i1 = cnt;
5143 : }
5144 : }
5145 : i__ = next;
5146 : }
5147 29310201 : if (nint > 0) {
5148 28740121 : goto L80;
5149 : }
5150 570080 : i__1 = *ilast;
5151 1141026 : for (i__ = *ifirst; i__ <= i__1; ++i__) {
5152 570946 : k = i__ << 1;
5153 570946 : ii = i__ - *offset;
5154 570946 : if (iwork[k - 1] != -1) {
5155 570946 : w[ii] = (work[k - 1] + work[k]) * .5;
5156 570946 : werr[ii] = work[k] - w[ii];
5157 570946 : if (i__ != *ilast) {
5158 866 : wgap[ii] = work[k + 1] - work[k];
5159 : }
5160 : }
5161 : }
5162 :
5163 570080 : return;
5164 :
5165 : }
5166 : }
5167 : }
5168 : #include <cctype>
5169 : #include <cmath>
5170 :
5171 : #include "real.h"
5172 :
5173 : #include "blas/blas.h"
5174 : #include "lapack.h"
5175 : #include "lapack_limits.h"
5176 :
5177 :
5178 :
5179 : #include "blas/blas.h"
5180 : namespace PLMD{
5181 : namespace lapack{
5182 : using namespace blas;
5183 : void
5184 570008 : PLUMED_BLAS_F77_FUNC(dlarrex,DLARREX)(const char *range,
5185 : int *n,
5186 : double *vl,
5187 : double *vu,
5188 : int *il,
5189 : int *iu,
5190 : double *d__,
5191 : double *e,
5192 : double *tol,
5193 : int *nsplit,
5194 : int *isplit,
5195 : int *m,
5196 : double *w,
5197 : int *iblock,
5198 : int *indexw,
5199 : double *gersch,
5200 : double *work,
5201 : int *iwork,
5202 : int *info)
5203 : {
5204 : int i__1, i__2, i__3;
5205 : double d__1, d__2;
5206 570008 : int c__1 = 1;
5207 570008 : int c__0 = 0;
5208 :
5209 : int i__, j, k;
5210 : double s, gl;
5211 : int in;
5212 : double gu;
5213 : int cnt;
5214 : double eps, tau, nrm, tmp, vvl, vvu, offd;
5215 : int iend, jblk, till, itmp;
5216 : double rtol, delta, sigma;
5217 : int iinfo;
5218 : double width;
5219 : int ibegin;
5220 : int irange;
5221 : double sgndef;
5222 : int maxcnt;
5223 570008 : --iwork;
5224 570008 : --work;
5225 570008 : --gersch;
5226 570008 : --indexw;
5227 570008 : --iblock;
5228 570008 : --w;
5229 570008 : --isplit;
5230 570008 : --e;
5231 570008 : --d__;
5232 :
5233 : sigma = 0;
5234 : irange = 0;
5235 : sgndef = 0;
5236 : maxcnt = 0;
5237 :
5238 570008 : *info = 0;
5239 :
5240 570008 : if (*range=='A' || *range=='a')
5241 : irange = 1;
5242 562533 : else if (*range=='V' || *range=='v')
5243 : irange = 2;
5244 562533 : else if (*range=='I' || *range=='i')
5245 : irange = 3;
5246 :
5247 :
5248 570008 : *m = 0;
5249 : eps = PLUMED_GMX_DOUBLE_EPS;
5250 :
5251 570008 : *nsplit = 1;
5252 570008 : i__1 = *n - 1;
5253 2254429 : for (i__ = 1; i__ <= i__1; ++i__) {
5254 1684421 : if (std::abs(e[i__]) <= *tol) {
5255 675 : isplit[*nsplit] = i__;
5256 675 : ++(*nsplit);
5257 : }
5258 : }
5259 570008 : isplit[*nsplit] = *n;
5260 :
5261 : ibegin = 1;
5262 570008 : i__1 = *nsplit;
5263 1140691 : for (jblk = 1; jblk <= i__1; ++jblk) {
5264 570683 : iend = isplit[jblk];
5265 570683 : if (ibegin == iend) {
5266 673 : ++(*m);
5267 673 : w[*m] = d__[ibegin];
5268 673 : iblock[*m] = jblk;
5269 673 : indexw[*m] = 1;
5270 673 : e[iend] = 0.;
5271 673 : ibegin = iend + 1;
5272 673 : goto L170;
5273 : }
5274 570010 : in = iend - ibegin + 1;
5275 :
5276 570010 : gl = d__[ibegin] - std::abs(e[ibegin]);
5277 570010 : gu = d__[ibegin] + std::abs(e[ibegin]);
5278 570010 : gersch[(ibegin << 1) - 1] = gl;
5279 570010 : gersch[ibegin * 2] = gu;
5280 570010 : gersch[(iend << 1) - 1] = d__[iend] - std::abs(e[iend - 1]);
5281 570010 : gersch[iend * 2] = d__[iend] + std::abs(e[iend - 1]);
5282 570010 : d__1 = gersch[(iend << 1) - 1];
5283 570010 : gl = (d__1<gl) ? d__1 : gl;
5284 : d__1 = gersch[iend * 2];
5285 570010 : gu = (d__1>gu) ? d__1 : gu;
5286 570010 : i__2 = iend - 1;
5287 1683746 : for (i__ = ibegin + 1; i__ <= i__2; ++i__) {
5288 1113736 : offd = std::abs(e[i__ - 1]) + std::abs(e[i__]);
5289 1113736 : gersch[(i__ << 1) - 1] = d__[i__] - offd;
5290 : d__1 = gersch[(i__ << 1) - 1];
5291 1113736 : gl = (d__1<gl) ? d__1 : gl;
5292 1113736 : gersch[i__ * 2] = d__[i__] + offd;
5293 : d__1 = gersch[i__ * 2];
5294 1113736 : gu = (d__1>gu) ? d__1 : gu;
5295 : }
5296 : d__1 = std::abs(gl), d__2 = std::abs(gu);
5297 570010 : nrm = (d__1>d__2) ? d__1 : d__2;
5298 :
5299 570010 : width = gu - gl;
5300 : i__2 = iend - 1;
5301 2253756 : for (i__ = ibegin; i__ <= i__2; ++i__) {
5302 1683746 : work[i__] = e[i__] * e[i__];
5303 : }
5304 1710030 : for (j = 1; j <= 2; ++j) {
5305 1140020 : if (j == 1) {
5306 570010 : tau = gl + width * .25;
5307 : } else {
5308 570010 : tau = gu - width * .25;
5309 : }
5310 1140020 : tmp = d__[ibegin] - tau;
5311 1140020 : if (tmp < 0.) {
5312 596324 : cnt = 1;
5313 : } else {
5314 543696 : cnt = 0;
5315 : }
5316 1140020 : i__2 = iend;
5317 4507512 : for (i__ = ibegin + 1; i__ <= i__2; ++i__) {
5318 3367492 : tmp = d__[i__] - tau - work[i__ - 1] / tmp;
5319 3367492 : if (tmp < 0.) {
5320 1585152 : ++cnt;
5321 : }
5322 : }
5323 1140020 : if (cnt == 0) {
5324 : gl = tau;
5325 1140020 : } else if (cnt == in) {
5326 : gu = tau;
5327 : }
5328 1140020 : if (j == 1) {
5329 : maxcnt = cnt;
5330 : sigma = gl;
5331 : sgndef = 1.;
5332 : } else {
5333 570010 : if (in - cnt > maxcnt) {
5334 : sigma = gu;
5335 : sgndef = -1.;
5336 : }
5337 : }
5338 : }
5339 :
5340 570010 : work[in * 3] = 1.;
5341 : delta = eps;
5342 570010 : tau = sgndef * nrm;
5343 570010 : L60:
5344 570010 : sigma -= delta * tau;
5345 570010 : work[1] = d__[ibegin] - sigma;
5346 : j = ibegin;
5347 570010 : i__2 = in - 1;
5348 2253756 : for (i__ = 1; i__ <= i__2; ++i__) {
5349 1683746 : work[(in << 1) + i__] = 1. / work[i__];
5350 1683746 : tmp = e[j] * work[(in << 1) + i__];
5351 1683746 : work[i__ + 1] = d__[j + 1] - sigma - tmp * e[j];
5352 1683746 : work[in + i__] = tmp;
5353 1683746 : ++j;
5354 : }
5355 2823766 : for (i__ = in; i__ >= 1; --i__) {
5356 2253756 : tmp = sgndef * work[i__];
5357 2253756 : if (tmp < 0. || std::abs(work[(in << 1) + i__])<PLUMED_GMX_DOUBLE_MIN || std::isnan(tmp)) {
5358 0 : delta *= 2.;
5359 0 : goto L60;
5360 : }
5361 : }
5362 :
5363 570010 : PLUMED_BLAS_F77_FUNC(dcopy,DCOPY)(&in, &work[1], &c__1, &d__[ibegin], &c__1);
5364 570010 : i__2 = in - 1;
5365 570010 : PLUMED_BLAS_F77_FUNC(dcopy,DCOPY)(&i__2, &work[in + 1], &c__1, &e[ibegin], &c__1);
5366 570010 : i__2 = in - 1;
5367 2253756 : for (i__ = 1; i__ <= i__2; ++i__) {
5368 1683746 : work[in * 3 + i__] = work[i__] * work[in + i__];
5369 1683746 : work[(in << 2) + i__] = work[in * 3 + i__] * work[in + i__];
5370 : }
5371 570010 : if (sgndef > 0.) {
5372 490451 : cnt = 1;
5373 490451 : work[1] = (gl + gu) / 2. - sigma;
5374 490451 : work[in + 1] = 0.;
5375 490451 : work[(in << 1) + 1] = (gu - gl) / 2.;
5376 : } else {
5377 79559 : cnt = in;
5378 79559 : work[in] = (gl + gu) / 2. - sigma;
5379 79559 : work[in * 2] = 0.;
5380 79559 : work[in * 3] = (gu - gl) / 2.;
5381 : }
5382 570010 : rtol = eps * 4.;
5383 570010 : PLUMED_BLAS_F77_FUNC(dlarrbx,DLARRBX)(&in, &d__[ibegin], &e[ibegin], &work[in * 3 + 1], &work[(in <<
5384 570010 : 2) + 1], &cnt, &cnt, &rtol, &rtol, &c__0, &work[1], &work[in
5385 570010 : + 1], &work[(in << 1) + 1], &work[in * 5 + 1], &iwork[1], &
5386 : iinfo);
5387 570010 : if (sgndef > 0.) {
5388 490451 : tau = work[1] - work[(in << 1) + 1];
5389 : } else {
5390 79559 : tau = work[in] + work[in * 3];
5391 : }
5392 :
5393 570010 : work[in * 3] = 1.;
5394 : delta = eps * 2.;
5395 570010 : L100:
5396 570010 : tau *= 1. - delta;
5397 :
5398 570010 : s = -tau;
5399 : j = ibegin;
5400 570010 : i__2 = in - 1;
5401 2253756 : for (i__ = 1; i__ <= i__2; ++i__) {
5402 1683746 : work[i__] = d__[j] + s;
5403 1683746 : work[(in << 1) + i__] = 1. / work[i__];
5404 1683746 : work[in + i__] = e[j] * d__[j] * work[(in << 1) + i__];
5405 1683746 : s = s * work[in + i__] * e[j] - tau;
5406 1683746 : ++j;
5407 : }
5408 570010 : work[in] = d__[iend] + s;
5409 :
5410 2823766 : for (i__ = in; i__ >= 1; --i__) {
5411 2253756 : tmp = sgndef * work[i__];
5412 2253756 : if (tmp < 0. || std::abs(work[(in << 1) + i__])<PLUMED_GMX_DOUBLE_MIN || std::isnan(tmp)) {
5413 0 : delta *= 2.;
5414 0 : goto L100;
5415 : }
5416 : }
5417 :
5418 570010 : sigma += tau;
5419 570010 : PLUMED_BLAS_F77_FUNC(dcopy,DCOPY)(&in, &work[1], &c__1, &d__[ibegin], &c__1);
5420 570010 : i__2 = in - 1;
5421 570010 : PLUMED_BLAS_F77_FUNC(dcopy,DCOPY)(&i__2, &work[in + 1], &c__1, &e[ibegin], &c__1);
5422 570010 : e[iend] = sigma;
5423 570010 : tmp = (double) in * 4. * eps * (std::abs(sigma) + std::abs(tau));
5424 : i__2 = iend;
5425 2823766 : for (i__ = ibegin; i__ <= i__2; ++i__) {
5426 2253756 : gersch[(i__ << 1) - 1] = gersch[(i__ << 1) - 1] - sigma - tmp;
5427 2253756 : gersch[i__ * 2] = gersch[i__ * 2] - sigma + tmp;
5428 : }
5429 :
5430 : j = ibegin;
5431 570010 : i__2 = in - 1;
5432 2253756 : for (i__ = 1; i__ <= i__2; ++i__) {
5433 1683746 : work[(i__ << 1) - 1] = std::abs(d__[j]);
5434 1683746 : work[i__ * 2] = e[j] * e[j] * work[(i__ << 1) - 1];
5435 1683746 : ++j;
5436 : }
5437 570010 : work[(in << 1) - 1] = std::abs(d__[iend]);
5438 :
5439 570010 : PLUMED_BLAS_F77_FUNC(dlasq2,DLASQ2)(&in, &work[1], info);
5440 570010 : if (*info != 0) {
5441 : return;
5442 : }
5443 :
5444 570010 : if (sgndef > 0.) {
5445 490451 : i__2 = in;
5446 2426211 : for (i__ = 1; i__ <= i__2; ++i__) {
5447 1935760 : ++(*m);
5448 1935760 : w[*m] = work[in - i__ + 1];
5449 1935760 : iblock[*m] = jblk;
5450 1935760 : indexw[*m] = i__;
5451 : }
5452 : } else {
5453 79559 : i__2 = in;
5454 397555 : for (i__ = 1; i__ <= i__2; ++i__) {
5455 317996 : ++(*m);
5456 317996 : w[*m] = -work[i__];
5457 317996 : iblock[*m] = jblk;
5458 317996 : indexw[*m] = i__;
5459 : }
5460 : }
5461 570010 : ibegin = iend + 1;
5462 570683 : L170:
5463 : ;
5464 : }
5465 570008 : if (irange == 2) {
5466 0 : *m = 0;
5467 : ibegin = 1;
5468 0 : i__1 = *nsplit;
5469 0 : for (i__ = 1; i__ <= i__1; ++i__) {
5470 0 : iend = isplit[i__];
5471 0 : vvl = *vl - e[iend];
5472 0 : vvu = *vu - e[iend];
5473 0 : i__2 = iend;
5474 0 : for (j = ibegin; j <= i__2; ++j) {
5475 0 : if (vvl <= w[j] && w[j] <= vvu) {
5476 0 : ++(*m);
5477 0 : w[*m] = w[j];
5478 0 : iblock[*m] = i__;
5479 0 : indexw[*m] = j - ibegin + 1;
5480 : }
5481 : }
5482 0 : ibegin = iend + 1;
5483 : }
5484 570008 : } else if (irange == 3) {
5485 562533 : *m = *iu - *il + 1;
5486 562533 : if (*nsplit == 1) {
5487 : i__1 = *m;
5488 1139915 : for (i__ = 1; i__ <= i__1; ++i__) {
5489 577394 : w[i__] = w[*il + i__ - 1];
5490 577394 : indexw[i__] = *il + i__ - 1;
5491 : }
5492 : } else {
5493 : ibegin = 1;
5494 : i__1 = *nsplit;
5495 693 : for (i__ = 1; i__ <= i__1; ++i__) {
5496 681 : iend = isplit[i__];
5497 681 : i__2 = iend;
5498 1459 : for (j = ibegin; j <= i__2; ++j) {
5499 778 : work[j] = w[j] + e[iend];
5500 : }
5501 681 : ibegin = iend + 1;
5502 : }
5503 12 : i__1 = *n;
5504 790 : for (i__ = 1; i__ <= i__1; ++i__) {
5505 778 : iwork[i__] = i__;
5506 778 : iwork[*n + i__] = iblock[i__];
5507 : }
5508 12 : PLUMED_BLAS_F77_FUNC(dlasrt2,DLASRT2)("I", n, &work[1], &iwork[1], &iinfo);
5509 12 : i__1 = *m;
5510 781 : for (i__ = 1; i__ <= i__1; ++i__) {
5511 769 : itmp = iwork[*il + i__ - 1];
5512 769 : work[i__] = w[itmp];
5513 769 : iblock[i__] = iwork[*n + itmp];
5514 : }
5515 12 : i__1 = *m;
5516 781 : for (i__ = 1; i__ <= i__1; ++i__) {
5517 769 : iwork[*n + i__] = iwork[*il + i__ - 1];
5518 769 : iwork[i__] = i__;
5519 : }
5520 12 : PLUMED_BLAS_F77_FUNC(ilasrt2,ILASRT2)("I", m, &iblock[1], &iwork[1], &iinfo);
5521 : j = 1;
5522 12 : itmp = iblock[j];
5523 12 : cnt = iwork[*n + iwork[j]];
5524 12 : if (itmp == 1) {
5525 : ibegin = 1;
5526 : } else {
5527 0 : ibegin = isplit[itmp - 1] + 1;
5528 : }
5529 12 : i__1 = *m;
5530 781 : for (i__ = 1; i__ <= i__1; ++i__) {
5531 769 : w[i__] = work[iwork[i__]];
5532 769 : if (iblock[i__] != itmp || i__ == *m) {
5533 678 : if (iblock[i__] == itmp) {
5534 12 : till = *m;
5535 : } else {
5536 666 : till = i__ - 1;
5537 : }
5538 678 : i__2 = till - j + 1;
5539 678 : PLUMED_BLAS_F77_FUNC(dlasrt,DLASRT)("I", &i__2, &w[j], &iinfo);
5540 678 : cnt = cnt - ibegin + 1;
5541 678 : i__2 = till;
5542 1447 : for (k = j; k <= i__2; ++k) {
5543 769 : indexw[k] = cnt + k - j;
5544 : }
5545 : j = i__;
5546 678 : itmp = iblock[j];
5547 678 : cnt = iwork[*n + iwork[j]];
5548 678 : ibegin = isplit[itmp - 1] + 1;
5549 678 : if (i__ == *m && till < *m) {
5550 0 : indexw[*m] = cnt - ibegin + 1;
5551 : }
5552 : } else {
5553 91 : i__2 = cnt, i__3 = iwork[*n + iwork[i__]];
5554 91 : cnt = (i__2<i__3) ? i__2 : i__3;
5555 : }
5556 : }
5557 : }
5558 : }
5559 :
5560 : return;
5561 :
5562 : }
5563 :
5564 :
5565 : }
5566 : }
5567 : #include <cmath>
5568 :
5569 : #include "real.h"
5570 :
5571 : #include "blas/blas.h"
5572 : #include "lapack.h"
5573 : #include "lapack_limits.h"
5574 :
5575 :
5576 : #include "blas/blas.h"
5577 : namespace PLMD{
5578 : namespace lapack{
5579 : using namespace blas;
5580 : void
5581 70 : PLUMED_BLAS_F77_FUNC(dlarrfx,DLARRFX)(int *n,
5582 : double *d__,
5583 : double *l,
5584 : double *ld,
5585 : double *lld,
5586 : int *ifirst,
5587 : int *ilast,
5588 : double *w,
5589 : double *sigma,
5590 : double *dplus,
5591 : double *lplus,
5592 : double *work,
5593 : int *info)
5594 : {
5595 70 : int i1 = 1;
5596 : int i__1;
5597 : double d__2, d__3;
5598 :
5599 : int i__;
5600 : double s, eps, tmp, dmax1, dmax2, delta;
5601 70 : --work;
5602 70 : --lplus;
5603 70 : --dplus;
5604 70 : --w;
5605 : --lld;
5606 70 : --ld;
5607 70 : --l;
5608 70 : --d__;
5609 70 : *info = 0;
5610 : eps = PLUMED_GMX_DOUBLE_EPS;
5611 70 : *sigma = w[*ifirst];
5612 : delta = eps * 2.;
5613 :
5614 70 : L10:
5615 70 : s = -(*sigma);
5616 70 : dplus[1] = d__[1] + s;
5617 : dmax1 = std::abs(dplus[1]);
5618 70 : i__1 = *n - 1;
5619 28278 : for (i__ = 1; i__ <= i__1; ++i__) {
5620 28208 : lplus[i__] = ld[i__] / dplus[i__];
5621 28208 : s = s * lplus[i__] * l[i__] - *sigma;
5622 28208 : dplus[i__ + 1] = d__[i__ + 1] + s;
5623 : d__2 = dmax1, d__3 = std::abs(dplus[i__ + 1]);
5624 28208 : dmax1 = (d__2>d__3) ? d__2 : d__3;
5625 : }
5626 70 : if (std::isnan(dmax1)) {
5627 0 : *sigma -= std::abs(*sigma) * delta;
5628 0 : delta *= 2.;
5629 0 : goto L10;
5630 : }
5631 :
5632 70 : tmp = w[*ilast];
5633 : delta = eps * 2.;
5634 70 : L30:
5635 70 : s = -tmp;
5636 70 : work[1] = d__[1] + s;
5637 : dmax2 = std::abs(work[1]);
5638 70 : i__1 = *n - 1;
5639 28278 : for (i__ = 1; i__ <= i__1; ++i__) {
5640 28208 : work[*n + i__] = ld[i__] / work[i__];
5641 28208 : s = s * work[*n + i__] * l[i__] - tmp;
5642 28208 : work[i__ + 1] = d__[i__ + 1] + s;
5643 : d__2 = dmax2, d__3 = std::abs(work[i__ + 1]);
5644 28208 : dmax2 = (d__2>d__3) ? d__2 : d__3;
5645 : }
5646 70 : if (std::isnan(dmax2)) {
5647 0 : tmp += std::abs(tmp) * delta;
5648 0 : delta *= 2.;
5649 0 : goto L30;
5650 : }
5651 70 : if (dmax2 < dmax1) {
5652 36 : *sigma = tmp;
5653 36 : PLUMED_BLAS_F77_FUNC(dcopy,DCOPY)(n, &work[1], &i1, &dplus[1], &i1);
5654 36 : i__1 = *n - 1;
5655 36 : PLUMED_BLAS_F77_FUNC(dcopy,DCOPY)(&i__1, &work[*n + 1], &i1, &lplus[1], &i1);
5656 : }
5657 :
5658 70 : return;
5659 : }
5660 : }
5661 : }
5662 : #include <cmath>
5663 :
5664 : #include "real.h"
5665 :
5666 : #include "blas/blas.h"
5667 : #include "lapack.h"
5668 : #include "lapack_limits.h"
5669 :
5670 :
5671 : #include "blas/blas.h"
5672 : namespace PLMD{
5673 : namespace lapack{
5674 : using namespace blas;
5675 : void
5676 569964 : PLUMED_BLAS_F77_FUNC(dlarrvx,DLARRVX)(int *n,
5677 : double *d__,
5678 : double *l,
5679 : int *isplit,
5680 : int *m,
5681 : double *w,
5682 : int *iblock,
5683 : int *indexw,
5684 : double *gersch,
5685 : double *tol,
5686 : double *z__,
5687 : int *ldz,
5688 : int *isuppz,
5689 : double *work,
5690 : int *iwork,
5691 : int *info)
5692 : {
5693 : int z_dim1, z_offset, i__1, i__2, i__3, i__4, i__5, i__6;
5694 : double d__1, d__2;
5695 569964 : double c_b5 = 0.;
5696 569964 : int c__1 = 1;
5697 569964 : int c__2 = 2;
5698 :
5699 : int i__, j, k, p, q;
5700 : int im, in;
5701 : double gap, eps, tmp;
5702 : int zto;
5703 : double ztz;
5704 : int iend, jblk;
5705 : int wend, iter, temp[1], ktot;
5706 : int itmp1, itmp2;
5707 : int indld;
5708 : double sigma;
5709 : int ndone, iinfo, iindr;
5710 : double resid;
5711 : int nomgs;
5712 : int nclus;
5713 : int zfrom, iindc1, iindc2;
5714 : double lambda;
5715 : int ibegin;
5716 : int indgap, indlld;
5717 : double mingma;
5718 : int oldien, oldncl, wbegin;
5719 : double relgap;
5720 : int oldcls;
5721 : int ndepth, inderr, iindwk;
5722 : int newcls, oldfst;
5723 : double minrgp=0.0;
5724 : int indwrk, oldlst;
5725 : double reltol;
5726 : int newfrs, newftt, parity;
5727 : double mgstol, nrminv, rqcorr;
5728 : int newlst, newsiz;
5729 :
5730 :
5731 569964 : --d__;
5732 569964 : --l;
5733 : --isplit;
5734 569964 : --w;
5735 569964 : --iblock;
5736 569964 : --indexw;
5737 : --gersch;
5738 569964 : z_dim1 = *ldz;
5739 569964 : z_offset = 1 + z_dim1;
5740 569964 : z__ -= z_offset;
5741 569964 : --isuppz;
5742 569964 : --work;
5743 569964 : --iwork;
5744 :
5745 569964 : inderr = *n;
5746 569964 : indld = *n << 1;
5747 569964 : indlld = *n * 3;
5748 569964 : indgap = *n << 2;
5749 569964 : indwrk = *n * 5 + 1;
5750 :
5751 : iindr = *n;
5752 : iindc1 = *n << 1;
5753 : iindc2 = *n * 3;
5754 569964 : iindwk = (*n << 2) + 1;
5755 :
5756 : eps = PLUMED_GMX_DOUBLE_EPS;
5757 :
5758 : i__1 = *n << 1;
5759 5078558 : for (i__ = 1; i__ <= i__1; ++i__) {
5760 4508594 : iwork[i__] = 0;
5761 : }
5762 569964 : PLUMED_BLAS_F77_FUNC(dlaset,DLASET)("Full", n, m, &c_b5, &c_b5, &z__[z_offset], ldz);
5763 : mgstol = eps * 100.;
5764 :
5765 : ibegin = 1;
5766 : wbegin = 1;
5767 569964 : i__1 = iblock[*m];
5768 1140600 : for (jblk = 1; jblk <= i__1; ++jblk) {
5769 570636 : iend = isplit[jblk];
5770 :
5771 570636 : wend = wbegin - 1;
5772 1178167 : L171:
5773 1178167 : if (wend < *m) {
5774 608203 : if (iblock[wend + 1] == jblk) {
5775 607531 : ++wend;
5776 607531 : goto L171;
5777 : }
5778 : }
5779 570636 : if (wend < wbegin) {
5780 0 : ibegin = iend + 1;
5781 0 : continue;
5782 : }
5783 :
5784 570636 : if (ibegin == iend) {
5785 673 : z__[ibegin + wbegin * z_dim1] = 1.;
5786 673 : isuppz[(wbegin << 1) - 1] = ibegin;
5787 673 : isuppz[wbegin * 2] = ibegin;
5788 673 : ibegin = iend + 1;
5789 673 : wbegin = wend + 1;
5790 673 : continue;
5791 : }
5792 569963 : oldien = ibegin - 1;
5793 569963 : in = iend - oldien;
5794 569963 : d__1 = .001, d__2 = 1. / (double) in;
5795 569963 : reltol = (d__1<d__2) ? d__1 : d__2;
5796 569963 : im = wend - wbegin + 1;
5797 569963 : PLUMED_BLAS_F77_FUNC(dcopy,DCOPY)(&im, &w[wbegin], &c__1, &work[1], &c__1);
5798 569963 : i__2 = im - 1;
5799 606858 : for (i__ = 1; i__ <= i__2; ++i__) {
5800 36895 : work[inderr + i__] = eps * std::abs(work[i__]);
5801 36895 : work[indgap + i__] = work[i__ + 1] - work[i__];
5802 : }
5803 569963 : work[inderr + im] = eps * std::abs(work[im]);
5804 569963 : d__2 = std::abs(work[im]);
5805 569963 : work[indgap + im] = (d__2>eps) ? d__2 : eps;
5806 : ndone = 0;
5807 :
5808 : ndepth = 0;
5809 : parity = 1;
5810 : nclus = 1;
5811 569963 : iwork[iindc1 + 1] = 1;
5812 569963 : iwork[iindc1 + 2] = im;
5813 :
5814 1139933 : L40:
5815 1139933 : if (ndone < im) {
5816 : oldncl = nclus;
5817 : nclus = 0;
5818 569970 : parity = 1 - parity;
5819 569970 : if (parity == 0) {
5820 : oldcls = iindc1;
5821 : newcls = iindc2;
5822 : } else {
5823 : oldcls = iindc2;
5824 : newcls = iindc1;
5825 : }
5826 : i__2 = oldncl;
5827 1140003 : for (i__ = 1; i__ <= i__2; ++i__) {
5828 :
5829 570033 : j = oldcls + (i__ << 1);
5830 570033 : oldfst = iwork[j - 1];
5831 570033 : oldlst = iwork[j];
5832 570033 : if (ndepth > 0) {
5833 70 : j = wbegin + oldfst - 1;
5834 70 : PLUMED_BLAS_F77_FUNC(dcopy,DCOPY)(&in, &z__[ibegin + j * z_dim1], &c__1, &d__[ibegin]
5835 : , &c__1);
5836 70 : i__3 = in - 1;
5837 70 : PLUMED_BLAS_F77_FUNC(dcopy,DCOPY)(&i__3, &z__[ibegin + (j + 1) * z_dim1], &c__1, &l[
5838 : ibegin], &c__1);
5839 70 : PLUMED_BLAS_F77_FUNC(dlaset,DLASET)("Full", &in, &c__2, &c_b5, &c_b5, &z__[ibegin + j
5840 : * z_dim1], ldz);
5841 : }
5842 : k = ibegin;
5843 570033 : i__3 = in - 1;
5844 2281895 : for (j = 1; j <= i__3; ++j) {
5845 1711862 : tmp = d__[k] * l[k];
5846 1711862 : work[indld + j] = tmp;
5847 1711862 : work[indlld + j] = tmp * l[k];
5848 1711862 : ++k;
5849 : }
5850 570033 : if (ndepth > 0) {
5851 :
5852 70 : p = indexw[wbegin - 1 + oldfst];
5853 70 : q = indexw[wbegin - 1 + oldlst];
5854 70 : d__1 = eps * 4.;
5855 70 : i__3 = p - oldfst;
5856 70 : PLUMED_BLAS_F77_FUNC(dlarrbx,DLARRBX)(&in, &d__[ibegin], &l[ibegin], &work[indld + 1], &
5857 70 : work[indlld + 1], &p, &q, &reltol, &d__1, &i__3, &
5858 70 : work[1], &work[indgap + 1], &work[inderr + 1], &
5859 70 : work[indwrk + in], &iwork[iindwk], &iinfo);
5860 : }
5861 570033 : newfrs = oldfst;
5862 570033 : i__3 = oldlst;
5863 1177827 : for (j = oldfst; j <= i__3; ++j) {
5864 607794 : if (j == oldlst || work[indgap + j] >=
5865 37761 : reltol * std::abs(work[j])) {
5866 606928 : newlst = j;
5867 : } else {
5868 :
5869 866 : relgap = work[indgap + j] / std::abs(work[j]);
5870 866 : if (j == newfrs) {
5871 : minrgp = relgap;
5872 : } else {
5873 796 : minrgp = (minrgp<relgap) ? minrgp : relgap;
5874 : }
5875 866 : continue;
5876 : }
5877 606928 : newsiz = newlst - newfrs + 1;
5878 606928 : newftt = wbegin + newfrs - 1;
5879 606928 : nomgs = newsiz == 1 || newsiz > 1 || minrgp < mgstol;
5880 606928 : if (newsiz > 1 && nomgs) {
5881 :
5882 70 : PLUMED_BLAS_F77_FUNC(dlarrfx,DLARRFX)(&in, &d__[ibegin], &l[ibegin], &work[indld +
5883 70 : 1], &work[indlld + 1], &newfrs, &newlst, &
5884 70 : work[1], &sigma, &z__[ibegin + newftt *
5885 70 : z_dim1], &z__[ibegin + (newftt + 1) * z_dim1],
5886 70 : &work[indwrk], info);
5887 70 : if (*info == 0) {
5888 70 : tmp = eps * std::abs(sigma);
5889 70 : i__4 = newlst;
5890 1006 : for (k = newfrs; k <= i__4; ++k) {
5891 936 : work[k] -= sigma;
5892 936 : d__1 = work[indgap + k];
5893 936 : work[indgap + k] = (d__1>tmp) ? d__1 : tmp;
5894 936 : work[inderr + k] += tmp;
5895 : }
5896 70 : ++nclus;
5897 70 : k = newcls + (nclus << 1);
5898 70 : iwork[k - 1] = newfrs;
5899 70 : iwork[k] = newlst;
5900 : } else {
5901 0 : *info = 0;
5902 0 : if (minrgp < mgstol) {
5903 0 : work[indwrk] = d__[ibegin];
5904 0 : i__4 = in - 1;
5905 0 : for (k = 1; k <= i__4; ++k) {
5906 0 : work[indwrk + k] = d__[ibegin + k] + work[
5907 0 : indlld + k];
5908 : }
5909 0 : i__4 = newsiz;
5910 0 : for (k = 1; k <= i__4; ++k) {
5911 0 : iwork[iindwk + k - 1] = 1;
5912 : }
5913 0 : i__4 = newlst;
5914 0 : for (k = newfrs; k <= i__4; ++k) {
5915 0 : isuppz[2*(oldien + k) - 1] = 1;
5916 0 : isuppz[(oldien + k) * 2] = in;
5917 : }
5918 0 : temp[0] = in;
5919 0 : PLUMED_BLAS_F77_FUNC(dstein,DSTEIN)(&in, &work[indwrk], &work[indld + 1],
5920 0 : &newsiz, &work[newfrs], &iwork[iindwk]
5921 : , temp, &z__[ibegin + newftt * z_dim1]
5922 0 : , ldz, &work[indwrk + in], &iwork[
5923 0 : iindwk + in], &iwork[iindwk + (in*2)], &iinfo);
5924 0 : if (iinfo != 0) {
5925 0 : *info = 2;
5926 0 : return;
5927 : }
5928 0 : ndone += newsiz;
5929 : }
5930 : }
5931 : } else {
5932 : ktot = newftt;
5933 : i__4 = newlst;
5934 1213716 : for (k = newfrs; k <= i__4; ++k) {
5935 : iter = 0;
5936 608131 : L90:
5937 608131 : lambda = work[k];
5938 :
5939 608131 : PLUMED_BLAS_F77_FUNC(dlar1vx,DLAR1VX)(&in, &c__1, &in, &lambda, &d__[ibegin], &
5940 608131 : l[ibegin], &work[indld + 1], &work[indlld
5941 608131 : + 1], &w[wbegin + k - 1], &gersch[(oldien
5942 608131 : << 1) + 1], &z__[ibegin + ktot * z_dim1],
5943 608131 : &ztz, &mingma, &iwork[iindr + ktot], &
5944 608131 : isuppz[(ktot << 1) - 1], &work[indwrk]);
5945 608131 : tmp = 1. / ztz;
5946 608131 : nrminv = std::sqrt(tmp);
5947 608131 : resid = std::abs(mingma) * nrminv;
5948 608131 : rqcorr = mingma * tmp;
5949 608131 : if (k == in) {
5950 21047 : gap = work[indgap + k - 1];
5951 587084 : } else if (k == 1) {
5952 570469 : gap = work[indgap + k];
5953 : } else {
5954 16615 : d__1 = work[indgap + k - 1], d__2 = work[
5955 16615 : indgap + k];
5956 16615 : gap = (d__1<d__2) ? d__1 : d__2;
5957 : }
5958 608131 : ++iter;
5959 608131 : if (resid > *tol * gap && std::abs(rqcorr) > eps * 4. *
5960 8164 : std::abs(lambda)) {
5961 1285 : work[k] = lambda + rqcorr;
5962 1285 : if (iter < 8) {
5963 1273 : goto L90;
5964 : }
5965 : }
5966 606858 : iwork[ktot] = 1;
5967 606858 : if (newsiz == 1) {
5968 606858 : ++ndone;
5969 : }
5970 606858 : zfrom = isuppz[(ktot << 1) - 1];
5971 606858 : zto = isuppz[ktot * 2];
5972 606858 : i__5 = zto - zfrom + 1;
5973 606858 : PLUMED_BLAS_F77_FUNC(dscal,DSCAL)(&i__5, &nrminv, &z__[ibegin + zfrom - 1 +
5974 606858 : ktot * z_dim1], &c__1);
5975 606858 : ++ktot;
5976 : }
5977 606858 : if (newsiz > 1) {
5978 0 : itmp1 = isuppz[(newftt << 1) - 1];
5979 0 : itmp2 = isuppz[newftt * 2];
5980 0 : ktot = oldien + newlst;
5981 : i__4 = ktot;
5982 0 : for (p = newftt + 1; p <= i__4; ++p) {
5983 0 : i__5 = p - 1;
5984 0 : for (q = newftt; q <= i__5; ++q) {
5985 0 : tmp = -PLUMED_BLAS_F77_FUNC(ddot,DDOT)(&in, &z__[ibegin + p *
5986 0 : z_dim1], &c__1, &z__[ibegin + q *
5987 0 : z_dim1], &c__1);
5988 0 : PLUMED_BLAS_F77_FUNC(daxpy,DAXPY)(&in, &tmp, &z__[ibegin + q *
5989 0 : z_dim1], &c__1, &z__[ibegin + p *
5990 0 : z_dim1], &c__1);
5991 : }
5992 0 : tmp = 1. / PLUMED_BLAS_F77_FUNC(dnrm2,DNRM2)(&in, &z__[ibegin + p *
5993 0 : z_dim1], &c__1);
5994 0 : PLUMED_BLAS_F77_FUNC(dscal,DSCAL)(&in, &tmp, &z__[ibegin + p * z_dim1], &
5995 : c__1);
5996 0 : i__5 = itmp1, i__6 = isuppz[(p << 1) - 1];
5997 : itmp1 = (i__5<i__6) ? i__5 : i__6;
5998 0 : i__5 = itmp2, i__6 = isuppz[p * 2];
5999 : itmp2 = (i__5>i__6) ? i__5 : i__6;
6000 : }
6001 : i__4 = ktot;
6002 0 : for (p = newftt; p <= i__4; ++p) {
6003 0 : isuppz[(p << 1) - 1] = itmp1;
6004 0 : isuppz[p * 2] = itmp2;
6005 : }
6006 0 : ndone += newsiz;
6007 : }
6008 : }
6009 606928 : newfrs = j + 1;
6010 : }
6011 : }
6012 569970 : ++ndepth;
6013 569970 : goto L40;
6014 : }
6015 569963 : j = wbegin << 1;
6016 : i__2 = wend;
6017 1176821 : for (i__ = wbegin; i__ <= i__2; ++i__) {
6018 606858 : isuppz[j - 1] += oldien;
6019 606858 : isuppz[j] += oldien;
6020 606858 : j += 2;
6021 :
6022 : }
6023 569963 : ibegin = iend + 1;
6024 569963 : wbegin = wend + 1;
6025 : }
6026 :
6027 : return;
6028 :
6029 : }
6030 : }
6031 : }
6032 : #include <cmath>
6033 : #include "lapack.h"
6034 : #include "lapack_limits.h"
6035 :
6036 : #include "real.h"
6037 :
6038 : #include "blas/blas.h"
6039 : namespace PLMD{
6040 : namespace lapack{
6041 : using namespace blas;
6042 : void
6043 90519 : PLUMED_BLAS_F77_FUNC(dlartg,DLARTG)(double *f,
6044 : double *g,
6045 : double *cs,
6046 : double *sn,
6047 : double *r)
6048 : {
6049 : double minval,safemin, safemin2, safemx2, eps;
6050 : double f1,g1,f1a,g1a,scale;
6051 : int i,n,count;
6052 :
6053 : eps = PLUMED_GMX_DOUBLE_EPS;
6054 : minval = PLUMED_GMX_DOUBLE_MIN;
6055 : safemin = minval*(1.0+eps);
6056 : n = static_cast<int>(0.5*std::log( safemin/eps ) / std::log(2.0));
6057 : safemin2 = std::pow(2.0,static_cast<double>(n));
6058 :
6059 : safemx2 = 1.0 / safemin2;
6060 :
6061 90519 : if(std::abs(*g)<PLUMED_GMX_DOUBLE_MIN) {
6062 0 : *cs = 1.0;
6063 0 : *sn = 0.0;
6064 0 : *r = *f;
6065 90519 : } else if (std::abs(*f)<PLUMED_GMX_DOUBLE_MIN) {
6066 1 : *cs = 0.0;
6067 1 : *sn = 1.0;
6068 1 : *r = *g;
6069 : } else {
6070 : f1 = *f;
6071 : g1 = *g;
6072 : f1a = std::abs(f1);
6073 : g1a = std::abs(g1);
6074 90518 : scale = (f1a > g1a) ? f1a : g1a;
6075 90518 : if(scale >= safemx2) {
6076 : count = 0;
6077 0 : while(scale >= safemx2) {
6078 0 : count++;
6079 0 : f1 *= safemin2;
6080 0 : g1 *= safemin2;
6081 : f1a = std::abs(f1);
6082 : g1a = std::abs(g1);
6083 0 : scale = (f1a > g1a) ? f1a : g1a;
6084 : }
6085 0 : *r = std::sqrt(f1*f1 + g1*g1);
6086 0 : *cs = f1 / *r;
6087 0 : *sn = g1 / *r;
6088 0 : for(i=0;i<count;i++)
6089 0 : *r *= safemx2;
6090 90518 : } else if (scale<=safemin2) {
6091 : count = 0;
6092 0 : while(scale <= safemin2) {
6093 0 : count++;
6094 0 : f1 *= safemx2;
6095 0 : g1 *= safemx2;
6096 : f1a = std::abs(f1);
6097 : g1a = std::abs(g1);
6098 0 : scale = (f1a > g1a) ? f1a : g1a;
6099 : }
6100 0 : *r = std::sqrt(f1*f1 + g1*g1);
6101 0 : *cs = f1 / *r;
6102 0 : *sn = g1 / *r;
6103 0 : for(i=0;i<count;i++)
6104 0 : *r *= safemin2;
6105 : } else {
6106 90518 : *r = std::sqrt(f1*f1 + g1*g1);
6107 90518 : *cs = f1 / *r;
6108 90518 : *sn = g1 / *r;
6109 : }
6110 90518 : if(std::abs(*f)>std::abs(*g) && *cs<0.0) {
6111 18497 : *cs *= -1.0;
6112 18497 : *sn *= -1.0;
6113 18497 : *r *= -1.0;
6114 : }
6115 : }
6116 90519 : return;
6117 : }
6118 :
6119 : }
6120 : }
6121 : #include <cmath>
6122 : #include "lapack.h"
6123 :
6124 : #include "blas/blas.h"
6125 : namespace PLMD{
6126 : namespace lapack{
6127 : using namespace blas;
6128 : void
6129 0 : PLUMED_BLAS_F77_FUNC(dlaruv,DLARUV)(int *iseed, int *n, double *x)
6130 : {
6131 : const int
6132 0 : mm[512] = {
6133 : 494,2637,255,2008,1253,
6134 : 3344,4084,1739,3143,3468,688,1657,1238,3166,1292,3422,1270,2016,
6135 : 154,2862,697,1706,491,931,1444,444,3577,3944,2184,1661,3482,657,
6136 : 3023,3618,1267,1828,164,3798,3087,2400,2870,3876,1905,1593,1797,
6137 : 1234,3460,328,2861,1950,617,2070,3331,769,1558,2412,2800,189,287,
6138 : 2045,1227,2838,209,2770,3654,3993,192,2253,3491,2889,2857,2094,
6139 : 1818,688,1407,634,3231,815,3524,1914,516,164,303,2144,3480,119,
6140 : 3357,837,2826,2332,2089,3780,1700,3712,150,2000,3375,1621,3090,
6141 : 3765,1149,3146,33,3082,2741,359,3316,1749,185,2784,2202,2199,1364,
6142 : 1244,2020,3160,2785,2772,1217,1822,1245,2252,3904,2774,997,2573,
6143 : 1148,545,322,789,1440,752,2859,123,1848,643,2405,2638,2344,46,
6144 : 3814,913,3649,339,3808,822,2832,3078,3633,2970,637,2249,2081,4019,
6145 : 1478,242,481,2075,4058,622,3376,812,234,641,4005,1122,3135,2640,
6146 : 2302,40,1832,2247,2034,2637,1287,1691,496,1597,2394,2584,1843,336,
6147 : 1472,2407,433,2096,1761,2810,566,442,41,1238,1086,603,840,3168,
6148 : 1499,1084,3438,2408,1589,2391,288,26,512,1456,171,1677,2657,2270,
6149 : 2587,2961,1970,1817,676,1410,3723,2803,3185,184,663,499,3784,1631,
6150 : 1925,3912,1398,1349,1441,2224,2411,1907,3192,2786,382,37,759,2948,
6151 : 1862,3802,2423,2051,2295,1332,1832,2405,3638,3661,327,3660,716,
6152 : 1842,3987,1368,1848,2366,2508,3754,1766,3572,2893,307,1297,3966,
6153 : 758,2598,3406,2922,1038,2934,2091,2451,1580,1958,2055,1507,1078,
6154 : 3273,17,854,2916,3971,2889,3831,2621,1541,893,736,3992,787,2125,
6155 : 2364,2460,257,1574,3912,1216,3248,3401,2124,2762,149,2245,166,466,
6156 : 4018,1399,190,2879,153,2320,18,712,2159,2318,2091,3443,1510,449,
6157 : 1956,2201,3137,3399,1321,2271,3667,2703,629,2365,2431,1113,3922,
6158 : 2554,184,2099,3228,4012,1921,3452,3901,572,3309,3171,817,3039,
6159 : 1696,1256,3715,2077,3019,1497,1101,717,51,981,1978,1813,3881,76,
6160 : 3846,3694,1682,124,1660,3997,479,1141,886,3514,1301,3604,1888,
6161 : 1836,1990,2058,692,1194,20,3285,2046,2107,3508,3525,3801,2549,
6162 : 1145,2253,305,3301,1065,3133,2913,3285,1241,1197,3729,2501,1673,
6163 : 541,2753,949,2361,1165,4081,2725,3305,3069,3617,3733,409,2157,
6164 : 1361,3973,1865,2525,1409,3445,3577,77,3761,2149,1449,3005,225,85,
6165 : 3673,3117,3089,1349,2057,413,65,1845,697,3085,3441,1573,3689,2941,
6166 : 929,533,2841,4077,721,2821,2249,2397,2817,245,1913,1997,3121,997,
6167 : 1833,2877,1633,981,2009,941,2449,197,2441,285,1473,2741,3129,909,
6168 : 2801,421,4073,2813,2337,1429,1177,1901,81,1669,2633,2269,129,1141,
6169 : 249,3917,2481,3941,2217,2749,3041,1877,345,2861,1809,3141,2825,
6170 : 157,2881,3637,1465,2829,2161,3365,361,2685,3745,2325,3609,3821,
6171 : 3537,517,3017,2141,1537
6172 : };
6173 :
6174 : int i__1;
6175 :
6176 : int i__, i1, i2, i3, i4, it1, it2, it3, it4;
6177 :
6178 :
6179 : --iseed;
6180 : --x;
6181 :
6182 : it1 = it2 = it3 = it4 = 0;
6183 :
6184 0 : i1 = iseed[1];
6185 0 : i2 = iseed[2];
6186 0 : i3 = iseed[3];
6187 0 : i4 = iseed[4];
6188 :
6189 0 : i__1 = (*n<128) ? *n : 128;
6190 0 : for (i__ = 1; i__ <= i__1; ++i__) {
6191 :
6192 0 : it4 = i4 * mm[i__ + 383];
6193 0 : it3 = it4 / 4096;
6194 0 : it4 -= it3 << 12;
6195 0 : it3 = it3 + i3 * mm[i__ + 383] + i4 * mm[i__ + 255];
6196 0 : it2 = it3 / 4096;
6197 0 : it3 -= it2 << 12;
6198 0 : it2 = it2 + i2 * mm[i__ + 383] + i3 * mm[i__ + 255] +
6199 0 : i4 * mm[i__ + 127];
6200 0 : it1 = it2 / 4096;
6201 0 : it2 -= it1 << 12;
6202 0 : it1 = it1 + i1 * mm[i__ + 383] + i2 * mm[i__ + 255] +
6203 0 : i3 * mm[i__ + 127] + i4 * mm[i__ - 1];
6204 0 : it1 %= 4096;
6205 :
6206 0 : x[i__] = ((double) it1 + ((double) it2 + ((double) it3 + (
6207 0 : double) it4 * 2.44140625e-4) * 2.44140625e-4) *
6208 0 : 2.44140625e-4) * 2.44140625e-4;
6209 : }
6210 :
6211 0 : iseed[1] = it1;
6212 0 : iseed[2] = it2;
6213 0 : iseed[3] = it3;
6214 0 : iseed[4] = it4;
6215 0 : return;
6216 :
6217 : }
6218 : }
6219 : }
6220 : #include <cmath>
6221 : #include "real.h"
6222 :
6223 : #include "lapack.h"
6224 :
6225 : #include "blas/blas.h"
6226 : namespace PLMD{
6227 : namespace lapack{
6228 : using namespace blas;
6229 : void
6230 4552 : PLUMED_BLAS_F77_FUNC(dlas2,DLAS2)(double *f,
6231 : double *g,
6232 : double *h,
6233 : double *ssmin,
6234 : double *ssmax)
6235 : {
6236 4552 : double fa = std::abs(*f);
6237 4552 : double ga = std::abs(*g);
6238 4552 : double ha = std::abs(*h);
6239 : double fhmin,fhmax,tmax,tmin,tmp1,tmp2;
6240 : double as,at,au,c;
6241 :
6242 4552 : fhmin = (fa<ha) ? fa : ha;
6243 4552 : fhmax = (fa>ha) ? fa : ha;
6244 :
6245 4552 : if(std::abs(fhmin)<PLUMED_GMX_DOUBLE_MIN) {
6246 0 : *ssmin = 0.0;
6247 0 : if(std::abs(fhmax)<PLUMED_GMX_DOUBLE_MIN)
6248 0 : *ssmax = ga;
6249 : else {
6250 0 : tmax = (fhmax>ga) ? fhmax : ga;
6251 0 : tmin = (fhmax<ga) ? fhmax : ga;
6252 0 : tmp1 = tmin / tmax;
6253 0 : tmp1 = tmp1 * tmp1;
6254 0 : *ssmax = tmax* std::sqrt(1.0 + tmp1);
6255 : }
6256 : } else {
6257 4552 : if(ga<fhmax) {
6258 4526 : as = 1.0 + fhmin / fhmax;
6259 4526 : at = (fhmax-fhmin) / fhmax;
6260 4526 : au = (ga/fhmax);
6261 4526 : au = au * au;
6262 4526 : c = 2.0 / ( std::sqrt(as*as+au) + std::sqrt(at*at+au) );
6263 4526 : *ssmin = fhmin * c;
6264 4526 : *ssmax = fhmax / c;
6265 : } else {
6266 26 : au = fhmax / ga;
6267 26 : if(std::abs(au)<PLUMED_GMX_DOUBLE_MIN) {
6268 0 : *ssmin = (fhmin*fhmax)/ga;
6269 0 : *ssmax = ga;
6270 : } else {
6271 26 : as = 1.0 + fhmin / fhmax;
6272 26 : at = (fhmax-fhmin)/fhmax;
6273 26 : tmp1 = as*au;
6274 26 : tmp2 = at*au;
6275 26 : c = 1.0 / ( std::sqrt(1.0+tmp1*tmp1) + std::sqrt(1.0+tmp2*tmp2));
6276 26 : *ssmin = (fhmin*c)*au;
6277 26 : *ssmin = *ssmin + *ssmin;
6278 26 : *ssmax = ga / (c+c);
6279 : }
6280 : }
6281 : }
6282 4552 : return;
6283 : }
6284 : }
6285 : }
6286 : #include <cctype>
6287 : #include <cmath>
6288 : #include "real.h"
6289 :
6290 : #include "lapack.h"
6291 : #include "lapack_limits.h"
6292 :
6293 :
6294 : #include "blas/blas.h"
6295 : namespace PLMD{
6296 : namespace lapack{
6297 : using namespace blas;
6298 : void
6299 264 : PLUMED_BLAS_F77_FUNC(dlascl,DLASCL)(const char *type,
6300 : int *kl,
6301 : int *ku,
6302 : double *cfrom,
6303 : double *cto,
6304 : int *m,
6305 : int *n,
6306 : double *a,
6307 : int *lda,
6308 : int *info)
6309 : {
6310 264 : const char ch=std::toupper(*type);
6311 : int i,j,k,l,k1,k2,k3,k4;
6312 : int done=0;
6313 : double minval,smlnum,bignum;
6314 : double cfromc, ctoc, cfrom1, cto1, mul;
6315 :
6316 264 : if(*n<=0 || *m<=0)
6317 : return;
6318 :
6319 : minval = PLUMED_GMX_DOUBLE_MIN;
6320 : smlnum = minval / PLUMED_GMX_DOUBLE_EPS;
6321 : bignum = 1.0 / smlnum;
6322 :
6323 264 : cfromc = *cfrom;
6324 264 : ctoc = *cto;
6325 :
6326 528 : while(!done) {
6327 :
6328 264 : cfrom1 = cfromc * smlnum;
6329 264 : cto1 = ctoc / bignum;
6330 :
6331 264 : if(std::abs(cfrom1)>std::abs(ctoc) && std::abs(ctoc)>PLUMED_GMX_DOUBLE_MIN) {
6332 : mul = smlnum;
6333 : done = 0;
6334 : cfromc = cfrom1;
6335 264 : } else if(std::abs(cto1)>std::abs(cfromc)) {
6336 : mul = bignum;
6337 : done = 0;
6338 : ctoc = cto1;
6339 : } else {
6340 264 : mul = ctoc / cfromc;
6341 : done = 1;
6342 : }
6343 :
6344 264 : switch(ch) {
6345 : case 'G':
6346 : /* Full matrix */
6347 528 : for(j=0;j<*n;j++)
6348 14544 : for(i=0;i<*m;i++)
6349 14280 : a[j*(*lda)+i] *= mul;
6350 : break;
6351 :
6352 : case 'L':
6353 : /* Lower triangular matrix */
6354 0 : for(j=0;j<*n;j++)
6355 0 : for(i=j;i<*m;i++)
6356 0 : a[j*(*lda)+i] *= mul;
6357 : break;
6358 :
6359 : case 'U':
6360 : /* Upper triangular matrix */
6361 0 : for(j=0;j<*n;j++) {
6362 0 : k = (j < (*m-1)) ? j : (*m-1);
6363 0 : for(i=0;i<=k;i++)
6364 0 : a[j*(*lda)+i] *= mul;
6365 : }
6366 : break;
6367 :
6368 : case 'H':
6369 : /* Upper Hessenberg matrix */
6370 0 : for(j=0;j<*n;j++) {
6371 0 : k = ((j+1) < (*m-1)) ? (j+1) : (*m-1);
6372 0 : for(i=0;i<=k;i++)
6373 0 : a[j*(*lda)+i] *= mul;
6374 : }
6375 : break;
6376 :
6377 0 : case 'B':
6378 : /* Symmetric band matrix, lower bandwidth KL, upper KU,
6379 : * only the lower half stored.
6380 : */
6381 0 : k3 = *kl;
6382 0 : k4 = *n - 1;
6383 0 : for(j=0;j<*n;j++) {
6384 0 : k = (k3 < (k4-j)) ? k3 : (k4-j);
6385 0 : for(i=0;i<=k;i++)
6386 0 : a[j*(*lda)+i] *= mul;
6387 : }
6388 : break;
6389 :
6390 0 : case 'Q':
6391 : /* Symmetric band matrix, lower bandwidth KL, upper KU,
6392 : * only the upper half stored.
6393 : */
6394 0 : k1 = *ku;
6395 : k3 = *ku;
6396 0 : for(j=0;j<*n;j++) {
6397 0 : k = ((k1-j) > 0) ? (k1-j) : 0;
6398 0 : for(i=k;i<=k3;i++)
6399 0 : a[j*(*lda)+i] *= mul;
6400 : }
6401 : break;
6402 :
6403 0 : case 'Z':
6404 : /* Band matrix, lower bandwidth KL, upper KU. */
6405 :
6406 0 : k1 = *kl + *ku;
6407 : k2 = *kl;
6408 0 : k3 = 2*(*kl) + *ku;
6409 0 : k4 = *kl + *ku - 1 + *m;
6410 0 : for(j=0;j<*n;j++) {
6411 0 : k = ((k1-j) > k2) ? (k1-j) : k2;
6412 0 : l = (k3 < (k4-j)) ? k3 : (k4-j);
6413 0 : for(i=k;i<=l;i++)
6414 0 : a[j*(*lda)+i] *= mul;
6415 : }
6416 : break;
6417 :
6418 0 : default:
6419 0 : *info = -1;
6420 0 : return;
6421 : }
6422 : } /* finished */
6423 :
6424 264 : *info = 0;
6425 264 : return;
6426 : }
6427 : }
6428 : }
6429 : #include "lapack.h"
6430 :
6431 : #include "blas/blas.h"
6432 : namespace PLMD{
6433 : namespace lapack{
6434 : using namespace blas;
6435 : void
6436 29 : PLUMED_BLAS_F77_FUNC(dlasd0,DLASD0)(int *n,
6437 : int *sqre,
6438 : double *d__,
6439 : double *e,
6440 : double *u,
6441 : int *ldu,
6442 : double *vt,
6443 : int *ldvt,
6444 : int *smlsiz,
6445 : int *iwork,
6446 : double *work,
6447 : int *info)
6448 : {
6449 : int u_dim1, u_offset, vt_dim1, vt_offset, i__1, i__2;
6450 :
6451 : int i__, j, m, i1, ic, lf, nd, ll, nl, nr, im1, ncc, nlf, nrf,
6452 : iwk, lvl, ndb1, nlp1, nrp1;
6453 : double beta;
6454 : int idxq, nlvl;
6455 : double alpha;
6456 : int inode, ndiml, idxqc, ndimr, itemp, sqrei;
6457 29 : int c__0 = 0;
6458 :
6459 :
6460 29 : --d__;
6461 29 : --e;
6462 29 : u_dim1 = *ldu;
6463 29 : u_offset = 1 + u_dim1;
6464 29 : u -= u_offset;
6465 29 : vt_dim1 = *ldvt;
6466 29 : vt_offset = 1 + vt_dim1;
6467 29 : vt -= vt_offset;
6468 29 : --iwork;
6469 : --work;
6470 :
6471 29 : *info = 0;
6472 :
6473 29 : if (*n < 0) {
6474 0 : *info = -1;
6475 29 : } else if (*sqre < 0 || *sqre > 1) {
6476 0 : *info = -2;
6477 : }
6478 :
6479 29 : m = *n + *sqre;
6480 :
6481 29 : if (*ldu < *n) {
6482 0 : *info = -6;
6483 29 : } else if (*ldvt < m) {
6484 0 : *info = -8;
6485 29 : } else if (*smlsiz < 3) {
6486 0 : *info = -9;
6487 : }
6488 29 : if (*info != 0) {
6489 : return;
6490 : }
6491 :
6492 29 : if (*n <= *smlsiz) {
6493 0 : PLUMED_BLAS_F77_FUNC(dlasdq,DLASDQ)("U", sqre, n, &m, n, &c__0, &d__[1], &e[1], &vt[vt_offset],
6494 : ldvt, &u[u_offset], ldu, &u[u_offset], ldu, &work[1], info);
6495 0 : return;
6496 : }
6497 :
6498 : inode = 1;
6499 29 : ndiml = inode + *n;
6500 29 : ndimr = ndiml + *n;
6501 29 : idxq = ndimr + *n;
6502 29 : iwk = idxq + *n;
6503 29 : PLUMED_BLAS_F77_FUNC(dlasdt,DLASDT)(n, &nlvl, &nd, &iwork[inode], &iwork[ndiml], &iwork[ndimr],
6504 : smlsiz);
6505 :
6506 29 : ndb1 = (nd + 1) / 2;
6507 29 : ncc = 0;
6508 : i__1 = nd;
6509 73 : for (i__ = ndb1; i__ <= i__1; ++i__) {
6510 :
6511 44 : i1 = i__ - 1;
6512 44 : ic = iwork[inode + i1];
6513 44 : nl = iwork[ndiml + i1];
6514 44 : nlp1 = nl + 1;
6515 44 : nr = iwork[ndimr + i1];
6516 44 : nrp1 = nr + 1;
6517 44 : nlf = ic - nl;
6518 44 : nrf = ic + 1;
6519 44 : sqrei = 1;
6520 44 : PLUMED_BLAS_F77_FUNC(dlasdq,DLASDQ)("U", &sqrei, &nl, &nlp1, &nl, &ncc, &d__[nlf], &e[nlf], &vt[
6521 44 : nlf + nlf * vt_dim1], ldvt, &u[nlf + nlf * u_dim1], ldu, &u[
6522 44 : nlf + nlf * u_dim1], ldu, &work[1], info);
6523 44 : if (*info != 0) {
6524 : return;
6525 : }
6526 44 : itemp = idxq + nlf - 2;
6527 44 : i__2 = nl;
6528 732 : for (j = 1; j <= i__2; ++j) {
6529 688 : iwork[itemp + j] = j;
6530 : }
6531 44 : if (i__ == nd) {
6532 29 : sqrei = *sqre;
6533 : } else {
6534 15 : sqrei = 1;
6535 : }
6536 44 : nrp1 = nr + sqrei;
6537 44 : PLUMED_BLAS_F77_FUNC(dlasdq,DLASDQ)("U", &sqrei, &nr, &nrp1, &nr, &ncc, &d__[nrf], &e[nrf], &vt[
6538 44 : nrf + nrf * vt_dim1], ldvt, &u[nrf + nrf * u_dim1], ldu, &u[
6539 44 : nrf + nrf * u_dim1], ldu, &work[1], info);
6540 44 : if (*info != 0) {
6541 : return;
6542 : }
6543 44 : itemp = idxq + ic;
6544 44 : i__2 = nr;
6545 716 : for (j = 1; j <= i__2; ++j) {
6546 672 : iwork[itemp + j - 1] = j;
6547 : }
6548 : }
6549 :
6550 62 : for (lvl = nlvl; lvl >= 1; --lvl) {
6551 :
6552 33 : if (lvl == 1) {
6553 : lf = 1;
6554 : ll = 1;
6555 : } else {
6556 4 : i__1 = lvl - 1;
6557 4 : lf = (1 << i__1);
6558 4 : ll = (lf << 1) - 1;
6559 : }
6560 : i__1 = ll;
6561 92 : for (i__ = lf; i__ <= i__1; ++i__) {
6562 59 : im1 = i__ - 1;
6563 59 : ic = iwork[inode + im1];
6564 59 : nl = iwork[ndiml + im1];
6565 59 : nr = iwork[ndimr + im1];
6566 59 : nlf = ic - nl;
6567 59 : if (*sqre == 0 && i__ == ll) {
6568 33 : sqrei = *sqre;
6569 : } else {
6570 26 : sqrei = 1;
6571 : }
6572 59 : idxqc = idxq + nlf - 1;
6573 59 : alpha = d__[ic];
6574 59 : beta = e[ic];
6575 59 : PLUMED_BLAS_F77_FUNC(dlasd1,DLASD1)(&nl, &nr, &sqrei, &d__[nlf], &alpha, &beta, &u[nlf + nlf *
6576 59 : u_dim1], ldu, &vt[nlf + nlf * vt_dim1], ldvt, &iwork[
6577 59 : idxqc], &iwork[iwk], &work[1], info);
6578 59 : if (*info != 0) {
6579 : return;
6580 : }
6581 : }
6582 : }
6583 :
6584 : return;
6585 :
6586 : }
6587 : }
6588 : }
6589 : #include <cmath>
6590 : #include "lapack.h"
6591 :
6592 : #include "blas/blas.h"
6593 : namespace PLMD{
6594 : namespace lapack{
6595 : using namespace blas;
6596 : void
6597 59 : PLUMED_BLAS_F77_FUNC(dlasd1,DLASD1)(int *nl,
6598 : int *nr,
6599 : int *sqre,
6600 : double *d__,
6601 : double *alpha,
6602 : double *beta,
6603 : double *u,
6604 : int *ldu,
6605 : double *vt,
6606 : int *ldvt,
6607 : int *idxq,
6608 : int *iwork,
6609 : double *work,
6610 : int *info)
6611 : {
6612 : int u_dim1, u_offset, vt_dim1, vt_offset, i__1;
6613 : double d__1, d__2;
6614 :
6615 : int i__, k, m, n, n1, n2, iq, iz, iu2, ldq, idx, ldu2, ivt2,
6616 : idxc, idxp, ldvt2;
6617 : int isigma;
6618 : double orgnrm;
6619 : int coltyp;
6620 59 : int c__0 = 0;
6621 59 : double one = 1.0;
6622 59 : int c__1 = 1;
6623 59 : int c_n1 = -1;
6624 :
6625 59 : --d__;
6626 : u_dim1 = *ldu;
6627 : u_offset = 1 + u_dim1;
6628 : u -= u_offset;
6629 : vt_dim1 = *ldvt;
6630 : vt_offset = 1 + vt_dim1;
6631 : vt -= vt_offset;
6632 : --idxq;
6633 59 : --iwork;
6634 59 : --work;
6635 :
6636 59 : *info = 0;
6637 :
6638 59 : if (*nl < 1) {
6639 0 : *info = -1;
6640 59 : } else if (*nr < 1) {
6641 0 : *info = -2;
6642 59 : } else if (*sqre < 0 || *sqre > 1) {
6643 0 : *info = -3;
6644 : }
6645 59 : if (*info != 0) {
6646 : return;
6647 : }
6648 :
6649 59 : n = *nl + *nr + 1;
6650 59 : m = n + *sqre;
6651 :
6652 :
6653 59 : ldu2 = n;
6654 59 : ldvt2 = m;
6655 :
6656 : iz = 1;
6657 59 : isigma = iz + m;
6658 59 : iu2 = isigma + n;
6659 59 : ivt2 = iu2 + ldu2 * n;
6660 59 : iq = ivt2 + ldvt2 * m;
6661 :
6662 : idx = 1;
6663 59 : idxc = idx + n;
6664 59 : coltyp = idxc + n;
6665 59 : idxp = coltyp + n;
6666 :
6667 59 : d__1 = std::abs(*alpha);
6668 59 : d__2 = std::abs(*beta);
6669 59 : orgnrm = (d__1>d__2) ? d__1 : d__2;
6670 59 : d__[*nl + 1] = 0.;
6671 : i__1 = n;
6672 3452 : for (i__ = 1; i__ <= i__1; ++i__) {
6673 3393 : if (std::abs(d__[i__]) > orgnrm) {
6674 1098 : orgnrm = std::abs(d__[i__]);
6675 : }
6676 : }
6677 59 : PLUMED_BLAS_F77_FUNC(dlascl,DLASCL)("G", &c__0, &c__0, &orgnrm, &one, &n, &c__1, &d__[1], &n, info);
6678 59 : *alpha /= orgnrm;
6679 59 : *beta /= orgnrm;
6680 :
6681 59 : PLUMED_BLAS_F77_FUNC(dlasd2,DLASD2)(nl, nr, sqre, &k, &d__[1], &work[iz], alpha, beta, &u[u_offset],
6682 59 : ldu, &vt[vt_offset], ldvt, &work[isigma], &work[iu2], &ldu2, &
6683 59 : work[ivt2], &ldvt2, &iwork[idxp], &iwork[idx], &iwork[idxc], &
6684 59 : idxq[1], &iwork[coltyp], info);
6685 :
6686 59 : ldq = k;
6687 59 : PLUMED_BLAS_F77_FUNC(dlasd3,DLASD3)(nl, nr, sqre, &k, &d__[1], &work[iq], &ldq, &work[isigma], &u[
6688 : u_offset], ldu, &work[iu2], &ldu2, &vt[vt_offset], ldvt, &work[
6689 : ivt2], &ldvt2, &iwork[idxc], &iwork[coltyp], &work[iz], info);
6690 59 : if (*info != 0) {
6691 : return;
6692 : }
6693 59 : PLUMED_BLAS_F77_FUNC(dlascl,DLASCL)("G", &c__0, &c__0, &one, &orgnrm, &n, &c__1, &d__[1], &n, info);
6694 :
6695 59 : n1 = k;
6696 59 : n2 = n - k;
6697 59 : PLUMED_BLAS_F77_FUNC(dlamrg,DLAMRG)(&n1, &n2, &d__[1], &c__1, &c_n1, &idxq[1]);
6698 :
6699 : return;
6700 :
6701 : }
6702 : }
6703 : }
6704 : #include <cmath>
6705 : #include "blas/blas.h"
6706 : #include "lapack.h"
6707 : #include "lapack_limits.h"
6708 :
6709 : #include "real.h"
6710 :
6711 : #include "blas/blas.h"
6712 : namespace PLMD{
6713 : namespace lapack{
6714 : using namespace blas;
6715 : void
6716 59 : PLUMED_BLAS_F77_FUNC(dlasd2,DLASD2)(int *nl,
6717 : int *nr,
6718 : int *sqre,
6719 : int *k,
6720 : double *d__,
6721 : double *z__,
6722 : double *alpha,
6723 : double *beta,
6724 : double *u,
6725 : int *ldu,
6726 : double *vt,
6727 : int *ldvt,
6728 : double *dsigma,
6729 : double *u2,
6730 : int *ldu2,
6731 : double *vt2,
6732 : int *ldvt2,
6733 : int *idxp,
6734 : int *idx,
6735 : int *idxc,
6736 : int *idxq,
6737 : int *coltyp,
6738 : int *info)
6739 : {
6740 : int u_dim1, u_offset, u2_dim1, u2_offset, vt_dim1, vt_offset;
6741 : int vt2_dim1, vt2_offset, i__1;
6742 : double d__1, d__2;
6743 :
6744 : double c__;
6745 : int i__, j, m, n;
6746 : double s;
6747 : int k2;
6748 : double z1;
6749 : int ct, jp;
6750 : double eps, tau, tol;
6751 : int psm[4], nlp1, nlp2, idxi, idxj;
6752 : int ctot[4], idxjp;
6753 : int jprev = 0;
6754 : double hlftol;
6755 59 : double zero = 0.0;
6756 59 : int c__1 = 1;
6757 :
6758 :
6759 59 : --d__;
6760 59 : --z__;
6761 59 : u_dim1 = *ldu;
6762 59 : u_offset = 1 + u_dim1;
6763 59 : u -= u_offset;
6764 59 : vt_dim1 = *ldvt;
6765 59 : vt_offset = 1 + vt_dim1;
6766 59 : vt -= vt_offset;
6767 59 : --dsigma;
6768 59 : u2_dim1 = *ldu2;
6769 59 : u2_offset = 1 + u2_dim1;
6770 59 : u2 -= u2_offset;
6771 59 : vt2_dim1 = *ldvt2;
6772 59 : vt2_offset = 1 + vt2_dim1;
6773 59 : vt2 -= vt2_offset;
6774 59 : --idxp;
6775 59 : --idx;
6776 59 : --idxc;
6777 59 : --idxq;
6778 59 : --coltyp;
6779 :
6780 59 : *info = 0;
6781 :
6782 59 : n = *nl + *nr + 1;
6783 59 : m = n + *sqre;
6784 :
6785 59 : nlp1 = *nl + 1;
6786 59 : nlp2 = *nl + 2;
6787 :
6788 59 : z1 = *alpha * vt[nlp1 + nlp1 * vt_dim1];
6789 59 : z__[1] = z1;
6790 1739 : for (i__ = *nl; i__ >= 1; --i__) {
6791 1680 : z__[i__ + 1] = *alpha * vt[i__ + nlp1 * vt_dim1];
6792 1680 : d__[i__ + 1] = d__[i__];
6793 1680 : idxq[i__ + 1] = idxq[i__] + 1;
6794 : }
6795 :
6796 : i__1 = m;
6797 1739 : for (i__ = nlp2; i__ <= i__1; ++i__) {
6798 1680 : z__[i__] = *beta * vt[i__ + nlp2 * vt_dim1];
6799 : }
6800 :
6801 : i__1 = nlp1;
6802 1739 : for (i__ = 2; i__ <= i__1; ++i__) {
6803 1680 : coltyp[i__] = 1;
6804 : }
6805 59 : i__1 = n;
6806 1713 : for (i__ = nlp2; i__ <= i__1; ++i__) {
6807 1654 : coltyp[i__] = 2;
6808 : }
6809 :
6810 : i__1 = n;
6811 1713 : for (i__ = nlp2; i__ <= i__1; ++i__) {
6812 1654 : idxq[i__] += nlp1;
6813 : }
6814 :
6815 : i__1 = n;
6816 3393 : for (i__ = 2; i__ <= i__1; ++i__) {
6817 3334 : dsigma[i__] = d__[idxq[i__]];
6818 3334 : u2[i__ + u2_dim1] = z__[idxq[i__]];
6819 3334 : idxc[i__] = coltyp[idxq[i__]];
6820 : }
6821 :
6822 59 : PLUMED_BLAS_F77_FUNC(dlamrg,DLAMRG)(nl, nr, &dsigma[2], &c__1, &c__1, &idx[2]);
6823 :
6824 59 : i__1 = n;
6825 3393 : for (i__ = 2; i__ <= i__1; ++i__) {
6826 3334 : idxi = idx[i__] + 1;
6827 3334 : d__[i__] = dsigma[idxi];
6828 3334 : z__[i__] = u2[idxi + u2_dim1];
6829 3334 : coltyp[i__] = idxc[idxi];
6830 : }
6831 :
6832 : eps = PLUMED_GMX_DOUBLE_EPS;
6833 59 : d__1 = std::abs(*alpha), d__2 = std::abs(*beta);
6834 59 : tol = (d__1 > d__2) ? d__1 : d__2;
6835 59 : d__2 = std::abs(d__[n]);
6836 59 : tol = eps * 8. * ((d__2 > tol) ? d__2 : tol);
6837 :
6838 59 : *k = 1;
6839 59 : k2 = n + 1;
6840 : i__1 = n;
6841 79 : for (j = 2; j <= i__1; ++j) {
6842 79 : if (std::abs(z__[j]) <= tol) {
6843 :
6844 20 : --k2;
6845 20 : idxp[k2] = j;
6846 20 : coltyp[j] = 4;
6847 20 : if (j == n) {
6848 0 : goto L120;
6849 : }
6850 : } else {
6851 : jprev = j;
6852 59 : goto L90;
6853 : }
6854 : }
6855 59 : L90:
6856 : j = jprev;
6857 3314 : L100:
6858 3314 : ++j;
6859 3314 : if (j > n) {
6860 59 : goto L110;
6861 : }
6862 3255 : if (std::abs(z__[j]) <= tol) {
6863 :
6864 122 : --k2;
6865 122 : idxp[k2] = j;
6866 122 : coltyp[j] = 4;
6867 : } else {
6868 :
6869 3133 : if (std::abs(d__[j] - d__[jprev]) <= tol) {
6870 :
6871 0 : s = z__[jprev];
6872 0 : c__ = z__[j];
6873 :
6874 0 : tau = PLUMED_BLAS_F77_FUNC(dlapy2,DLAPY2)(&c__, &s);
6875 0 : c__ /= tau;
6876 0 : s = -s / tau;
6877 0 : z__[j] = tau;
6878 0 : z__[jprev] = 0.;
6879 :
6880 0 : idxjp = idxq[idx[jprev] + 1];
6881 0 : idxj = idxq[idx[j] + 1];
6882 0 : if (idxjp <= nlp1) {
6883 0 : --idxjp;
6884 : }
6885 0 : if (idxj <= nlp1) {
6886 0 : --idxj;
6887 : }
6888 0 : PLUMED_BLAS_F77_FUNC(drot,DROT)(&n, &u[idxjp * u_dim1 + 1], &c__1, &u[idxj * u_dim1 + 1], &
6889 : c__1, &c__, &s);
6890 0 : PLUMED_BLAS_F77_FUNC(drot,DROT)(&m, &vt[idxjp + vt_dim1], ldvt, &vt[idxj + vt_dim1], ldvt, &
6891 : c__, &s);
6892 0 : if (coltyp[j] != coltyp[jprev]) {
6893 0 : coltyp[j] = 3;
6894 : }
6895 0 : coltyp[jprev] = 4;
6896 0 : --k2;
6897 0 : idxp[k2] = jprev;
6898 : jprev = j;
6899 : } else {
6900 3133 : ++(*k);
6901 3133 : u2[*k + u2_dim1] = z__[jprev];
6902 3133 : dsigma[*k] = d__[jprev];
6903 3133 : idxp[*k] = jprev;
6904 : jprev = j;
6905 : }
6906 : }
6907 3255 : goto L100;
6908 : L110:
6909 :
6910 59 : ++(*k);
6911 59 : u2[*k + u2_dim1] = z__[jprev];
6912 59 : dsigma[*k] = d__[jprev];
6913 59 : idxp[*k] = jprev;
6914 :
6915 : L120:
6916 :
6917 295 : for (j = 1; j <= 4; ++j) {
6918 236 : ctot[j - 1] = 0;
6919 : }
6920 59 : i__1 = n;
6921 3393 : for (j = 2; j <= i__1; ++j) {
6922 3334 : ct = coltyp[j];
6923 3334 : ++ctot[ct - 1];
6924 : }
6925 :
6926 59 : psm[0] = 2;
6927 59 : psm[1] = ctot[0] + 2;
6928 59 : psm[2] = psm[1] + ctot[1];
6929 59 : psm[3] = psm[2] + ctot[2];
6930 :
6931 : i__1 = n;
6932 3393 : for (j = 2; j <= i__1; ++j) {
6933 3334 : jp = idxp[j];
6934 3334 : ct = coltyp[jp];
6935 3334 : idxc[psm[ct - 1]] = j;
6936 3334 : ++psm[ct - 1];
6937 : }
6938 :
6939 : i__1 = n;
6940 3393 : for (j = 2; j <= i__1; ++j) {
6941 3334 : jp = idxp[j];
6942 3334 : dsigma[j] = d__[jp];
6943 3334 : idxj = idxq[idx[idxp[idxc[j]]] + 1];
6944 3334 : if (idxj <= nlp1) {
6945 1680 : --idxj;
6946 : }
6947 3334 : PLUMED_BLAS_F77_FUNC(dcopy,DCOPY)(&n, &u[idxj * u_dim1 + 1], &c__1, &u2[j * u2_dim1 + 1], &c__1);
6948 3334 : PLUMED_BLAS_F77_FUNC(dcopy,DCOPY)(&m, &vt[idxj + vt_dim1], ldvt, &vt2[j + vt2_dim1], ldvt2);
6949 : }
6950 :
6951 59 : dsigma[1] = 0.;
6952 59 : hlftol = tol / 2.;
6953 59 : if (std::abs(dsigma[2]) <= hlftol) {
6954 5 : dsigma[2] = hlftol;
6955 : }
6956 59 : if (m > n) {
6957 26 : z__[1] = PLUMED_BLAS_F77_FUNC(dlapy2,DLAPY2)(&z1, &z__[m]);
6958 26 : if (z__[1] <= tol) {
6959 0 : c__ = 1.;
6960 0 : s = 0.;
6961 0 : z__[1] = tol;
6962 : } else {
6963 26 : c__ = z1 / z__[1];
6964 26 : s = z__[m] / z__[1];
6965 : }
6966 : } else {
6967 33 : if (std::abs(z1) <= tol) {
6968 0 : z__[1] = tol;
6969 : } else {
6970 33 : z__[1] = z1;
6971 : }
6972 : }
6973 :
6974 59 : i__1 = *k - 1;
6975 59 : PLUMED_BLAS_F77_FUNC(dcopy,DCOPY)(&i__1, &u2[u2_dim1 + 2], &c__1, &z__[2], &c__1);
6976 :
6977 59 : PLUMED_BLAS_F77_FUNC(dlaset,DLASET)("A", &n, &c__1, &zero, &zero, &u2[u2_offset], ldu2);
6978 59 : u2[nlp1 + u2_dim1] = 1.;
6979 59 : if (m > n) {
6980 : i__1 = nlp1;
6981 803 : for (i__ = 1; i__ <= i__1; ++i__) {
6982 777 : vt[m + i__ * vt_dim1] = -s * vt[nlp1 + i__ * vt_dim1];
6983 777 : vt2[i__ * vt2_dim1 + 1] = c__ * vt[nlp1 + i__ * vt_dim1];
6984 : }
6985 26 : i__1 = m;
6986 785 : for (i__ = nlp2; i__ <= i__1; ++i__) {
6987 759 : vt2[i__ * vt2_dim1 + 1] = s * vt[m + i__ * vt_dim1];
6988 759 : vt[m + i__ * vt_dim1] = c__ * vt[m + i__ * vt_dim1];
6989 : }
6990 : } else {
6991 33 : PLUMED_BLAS_F77_FUNC(dcopy,DCOPY)(&m, &vt[nlp1 + vt_dim1], ldvt, &vt2[vt2_dim1 + 1], ldvt2);
6992 : }
6993 59 : if (m > n) {
6994 26 : PLUMED_BLAS_F77_FUNC(dcopy,DCOPY)(&m, &vt[m + vt_dim1], ldvt, &vt2[m + vt2_dim1], ldvt2);
6995 : }
6996 :
6997 59 : if (n > *k) {
6998 26 : i__1 = n - *k;
6999 26 : PLUMED_BLAS_F77_FUNC(dcopy,DCOPY)(&i__1, &dsigma[*k + 1], &c__1, &d__[*k + 1], &c__1);
7000 26 : i__1 = n - *k;
7001 26 : PLUMED_BLAS_F77_FUNC(dlacpy,DLACPY)("A", &n, &i__1, &u2[(*k + 1) * u2_dim1 + 1], ldu2, &u[(*k + 1)
7002 26 : * u_dim1 + 1], ldu);
7003 26 : i__1 = n - *k;
7004 26 : PLUMED_BLAS_F77_FUNC(dlacpy,DLACPY)("A", &i__1, &m, &vt2[*k + 1 + vt2_dim1], ldvt2, &vt[*k + 1 +
7005 26 : vt_dim1], ldvt);
7006 : }
7007 295 : for (j = 1; j <= 4; ++j) {
7008 236 : coltyp[j] = ctot[j - 1];
7009 : }
7010 :
7011 59 : return;
7012 :
7013 : }
7014 :
7015 :
7016 : }
7017 : }
7018 : #include <cmath>
7019 : #include "blas/blas.h"
7020 : #include "lapack.h"
7021 :
7022 : #include "blas/blas.h"
7023 : namespace PLMD{
7024 : namespace lapack{
7025 : using namespace blas;
7026 : void
7027 59 : PLUMED_BLAS_F77_FUNC(dlasd3,DLASD3)(int *nl,
7028 : int *nr,
7029 : int *sqre,
7030 : int *k,
7031 : double *d__,
7032 : double *q,
7033 : int *ldq,
7034 : double *dsigma,
7035 : double *u,
7036 : int *ldu,
7037 : double *u2,
7038 : int *ldu2,
7039 : double *vt,
7040 : int *ldvt,
7041 : double *vt2,
7042 : int *ldvt2,
7043 : int *idxc,
7044 : int *ctot,
7045 : double *z__,
7046 : int *info)
7047 : {
7048 : int q_dim1, q_offset, u_dim1, u_offset, u2_dim1, u2_offset, vt_dim1,
7049 : vt_offset, vt2_dim1, vt2_offset, i__1, i__2;
7050 : double d__2;
7051 :
7052 : int i__, j, m, n, jc;
7053 : double rho;
7054 : int nlp1, nlp2, nrp1;
7055 : double temp;
7056 : int ctemp;
7057 : int ktemp;
7058 59 : int c__1 = 1;
7059 59 : int c__0 = 0;
7060 59 : double zero = 0.0;
7061 59 : double one = 1.0;
7062 :
7063 : --d__;
7064 59 : q_dim1 = *ldq;
7065 59 : q_offset = 1 + q_dim1;
7066 59 : q -= q_offset;
7067 59 : --dsigma;
7068 59 : u_dim1 = *ldu;
7069 59 : u_offset = 1 + u_dim1;
7070 59 : u -= u_offset;
7071 59 : u2_dim1 = *ldu2;
7072 59 : u2_offset = 1 + u2_dim1;
7073 59 : u2 -= u2_offset;
7074 59 : vt_dim1 = *ldvt;
7075 59 : vt_offset = 1 + vt_dim1;
7076 59 : vt -= vt_offset;
7077 59 : vt2_dim1 = *ldvt2;
7078 59 : vt2_offset = 1 + vt2_dim1;
7079 59 : vt2 -= vt2_offset;
7080 59 : --idxc;
7081 : --ctot;
7082 59 : --z__;
7083 :
7084 : /* Function Body */
7085 59 : *info = 0;
7086 :
7087 59 : if (*nl < 1) {
7088 0 : *info = -1;
7089 59 : } else if (*nr < 1) {
7090 0 : *info = -2;
7091 59 : } else if (*sqre != 1 && *sqre != 0) {
7092 0 : *info = -3;
7093 : }
7094 :
7095 59 : n = *nl + *nr + 1;
7096 59 : m = n + *sqre;
7097 59 : nlp1 = *nl + 1;
7098 59 : nlp2 = *nl + 2;
7099 :
7100 59 : if (*k == 1) {
7101 0 : d__[1] = std::abs(z__[1]);
7102 0 : PLUMED_BLAS_F77_FUNC(dcopy,DCOPY)(&m, &vt2[vt2_dim1 + 1], ldvt2, &vt[vt_dim1 + 1], ldvt);
7103 0 : if (z__[1] > 0.) {
7104 0 : PLUMED_BLAS_F77_FUNC(dcopy,DCOPY)(&n, &u2[u2_dim1 + 1], &c__1, &u[u_dim1 + 1], &c__1);
7105 : } else {
7106 0 : i__1 = n;
7107 0 : for (i__ = 1; i__ <= i__1; ++i__) {
7108 0 : u[i__ + u_dim1] = -u2[i__ + u2_dim1];
7109 : }
7110 : }
7111 0 : return;
7112 : }
7113 :
7114 59 : PLUMED_BLAS_F77_FUNC(dcopy,DCOPY)(k, &z__[1], &c__1, &q[q_offset], &c__1);
7115 :
7116 59 : rho = PLUMED_BLAS_F77_FUNC(dnrm2,DNRM2)(k, &z__[1], &c__1);
7117 59 : PLUMED_BLAS_F77_FUNC(dlascl,DLASCL)("G", &c__0, &c__0, &rho, &one, k, &c__1, &z__[1], k, info);
7118 59 : rho *= rho;
7119 :
7120 :
7121 59 : i__1 = *k;
7122 3310 : for (j = 1; j <= i__1; ++j) {
7123 3251 : PLUMED_BLAS_F77_FUNC(dlasd4,DLASD4)(k, &j, &dsigma[1], &z__[1], &u[j * u_dim1 + 1], &rho, &d__[j],
7124 3251 : &vt[j * vt_dim1 + 1], info);
7125 :
7126 3251 : if (*info != 0) {
7127 : return;
7128 : }
7129 : }
7130 :
7131 59 : i__1 = *k;
7132 3310 : for (i__ = 1; i__ <= i__1; ++i__) {
7133 3251 : z__[i__] = u[i__ + *k * u_dim1] * vt[i__ + *k * vt_dim1];
7134 : i__2 = i__ - 1;
7135 212011 : for (j = 1; j <= i__2; ++j) {
7136 208760 : z__[i__] *= u[i__ + j * u_dim1] * vt[i__ + j * vt_dim1] / (dsigma[
7137 208760 : i__] - dsigma[j]) / (dsigma[i__] + dsigma[j]);
7138 : }
7139 3251 : i__2 = *k - 1;
7140 212011 : for (j = i__; j <= i__2; ++j) {
7141 208760 : z__[i__] *= u[i__ + j * u_dim1] * vt[i__ + j * vt_dim1] / (dsigma[
7142 208760 : i__] - dsigma[j + 1]) / (dsigma[i__] + dsigma[j + 1]);
7143 : }
7144 3251 : d__2 = std::sqrt(std::abs(z__[i__]));
7145 3251 : z__[i__] = (q[i__ + q_dim1] > 0) ? d__2 : -d__2;
7146 : }
7147 :
7148 59 : i__1 = *k;
7149 3310 : for (i__ = 1; i__ <= i__1; ++i__) {
7150 3251 : vt[i__ * vt_dim1 + 1] = z__[1] / u[i__ * u_dim1 + 1] / vt[i__ *
7151 3251 : vt_dim1 + 1];
7152 3251 : u[i__ * u_dim1 + 1] = -1.;
7153 3251 : i__2 = *k;
7154 420771 : for (j = 2; j <= i__2; ++j) {
7155 417520 : vt[j + i__ * vt_dim1] = z__[j] / u[j + i__ * u_dim1] / vt[j + i__
7156 417520 : * vt_dim1];
7157 417520 : u[j + i__ * u_dim1] = dsigma[j] * vt[j + i__ * vt_dim1];
7158 : }
7159 3251 : temp = PLUMED_BLAS_F77_FUNC(dnrm2,DNRM2)(k, &u[i__ * u_dim1 + 1], &c__1);
7160 3251 : q[i__ * q_dim1 + 1] = u[i__ * u_dim1 + 1] / temp;
7161 3251 : i__2 = *k;
7162 420771 : for (j = 2; j <= i__2; ++j) {
7163 417520 : jc = idxc[j];
7164 417520 : q[j + i__ * q_dim1] = u[jc + i__ * u_dim1] / temp;
7165 : }
7166 : }
7167 :
7168 59 : if (*k == 2) {
7169 0 : PLUMED_BLAS_F77_FUNC(dgemm,DGEMM)("N", "N", &n, k, k, &one, &u2[u2_offset], ldu2, &q[q_offset],
7170 : ldq, &zero, &u[u_offset], ldu);
7171 0 : goto L100;
7172 : }
7173 59 : if (ctot[1] > 0) {
7174 59 : PLUMED_BLAS_F77_FUNC(dgemm,DGEMM)("N", "N", nl, k, &ctot[1], &one, &u2[(u2_dim1 << 1) + 1],
7175 59 : ldu2, &q[q_dim1 + 2], ldq, &zero, &u[u_dim1 + 1], ldu);
7176 59 : if (ctot[3] > 0) {
7177 0 : ktemp = ctot[1] + 2 + ctot[2];
7178 0 : PLUMED_BLAS_F77_FUNC(dgemm,DGEMM)("N", "N", nl, k, &ctot[3], &one, &u2[ktemp * u2_dim1 + 1]
7179 0 : , ldu2, &q[ktemp + q_dim1], ldq, &one, &u[u_dim1 + 1],
7180 : ldu);
7181 : }
7182 0 : } else if (ctot[3] > 0) {
7183 0 : ktemp = ctot[1] + 2 + ctot[2];
7184 0 : PLUMED_BLAS_F77_FUNC(dgemm,DGEMM)("N", "N", nl, k, &ctot[3], &one, &u2[ktemp * u2_dim1 + 1],
7185 0 : ldu2, &q[ktemp + q_dim1], ldq, &zero, &u[u_dim1 + 1], ldu);
7186 : } else {
7187 0 : PLUMED_BLAS_F77_FUNC(dlacpy,DLACPY)("F", nl, k, &u2[u2_offset], ldu2, &u[u_offset], ldu);
7188 : }
7189 59 : PLUMED_BLAS_F77_FUNC(dcopy,DCOPY)(k, &q[q_dim1 + 1], ldq, &u[nlp1 + u_dim1], ldu);
7190 59 : ktemp = ctot[1] + 2;
7191 59 : ctemp = ctot[2] + ctot[3];
7192 59 : PLUMED_BLAS_F77_FUNC(dgemm,DGEMM)("N", "N", nr, k, &ctemp, &one, &u2[nlp2 + ktemp * u2_dim1], ldu2,
7193 59 : &q[ktemp + q_dim1], ldq, &zero, &u[nlp2 + u_dim1], ldu);
7194 :
7195 59 : L100:
7196 59 : i__1 = *k;
7197 3310 : for (i__ = 1; i__ <= i__1; ++i__) {
7198 3251 : temp = PLUMED_BLAS_F77_FUNC(dnrm2,DNRM2)(k, &vt[i__ * vt_dim1 + 1], &c__1);
7199 3251 : q[i__ + q_dim1] = vt[i__ * vt_dim1 + 1] / temp;
7200 3251 : i__2 = *k;
7201 420771 : for (j = 2; j <= i__2; ++j) {
7202 417520 : jc = idxc[j];
7203 417520 : q[i__ + j * q_dim1] = vt[jc + i__ * vt_dim1] / temp;
7204 : }
7205 : }
7206 :
7207 59 : if (*k == 2) {
7208 0 : PLUMED_BLAS_F77_FUNC(dgemm,DGEMM)("N", "N", k, &m, k, &one, &q[q_offset], ldq, &vt2[vt2_offset]
7209 : , ldvt2, &zero, &vt[vt_offset], ldvt);
7210 0 : return;
7211 : }
7212 59 : ktemp = ctot[1] + 1;
7213 59 : PLUMED_BLAS_F77_FUNC(dgemm,DGEMM)("N", "N", k, &nlp1, &ktemp, &one, &q[q_dim1 + 1], ldq, &vt2[
7214 59 : vt2_dim1 + 1], ldvt2, &zero, &vt[vt_dim1 + 1], ldvt);
7215 59 : ktemp = ctot[1] + 2 + ctot[2];
7216 59 : if (ktemp <= *ldvt2) {
7217 49 : PLUMED_BLAS_F77_FUNC(dgemm,DGEMM)("N", "N", k, &nlp1, &ctot[3], &one, &q[ktemp * q_dim1 + 1],
7218 49 : ldq, &vt2[ktemp + vt2_dim1], ldvt2, &one, &vt[vt_dim1 + 1],
7219 : ldvt);
7220 : }
7221 :
7222 59 : ktemp = ctot[1] + 1;
7223 59 : nrp1 = *nr + *sqre;
7224 59 : if (ktemp > 1) {
7225 59 : i__1 = *k;
7226 3310 : for (i__ = 1; i__ <= i__1; ++i__) {
7227 3251 : q[i__ + ktemp * q_dim1] = q[i__ + q_dim1];
7228 : }
7229 59 : i__1 = m;
7230 1739 : for (i__ = nlp2; i__ <= i__1; ++i__) {
7231 1680 : vt2[ktemp + i__ * vt2_dim1] = vt2[i__ * vt2_dim1 + 1];
7232 : }
7233 : }
7234 59 : ctemp = ctot[2] + 1 + ctot[3];
7235 59 : PLUMED_BLAS_F77_FUNC(dgemm,DGEMM)("N", "N", k, &nrp1, &ctemp, &one, &q[ktemp * q_dim1 + 1], ldq, &
7236 59 : vt2[ktemp + nlp2 * vt2_dim1], ldvt2, &zero, &vt[nlp2 * vt_dim1 +
7237 59 : 1], ldvt);
7238 :
7239 : return;
7240 :
7241 :
7242 : }
7243 :
7244 :
7245 : }
7246 : }
7247 : #include <cmath>
7248 : #include "lapack.h"
7249 : #include "lapack_limits.h"
7250 :
7251 : #include "real.h"
7252 :
7253 : #include "blas/blas.h"
7254 : namespace PLMD{
7255 : namespace lapack{
7256 : using namespace blas;
7257 : void
7258 3251 : PLUMED_BLAS_F77_FUNC(dlasd4,DLASD4)(int *n,
7259 : int *i__,
7260 : double *d__,
7261 : double *z__,
7262 : double *delta,
7263 : double *rho,
7264 : double *sigma,
7265 : double *work,
7266 : int *info)
7267 : {
7268 : int i__1;
7269 : double d__1;
7270 :
7271 : double a, b, c__;
7272 : int j;
7273 : double w, dd[3];
7274 : int ii;
7275 : double dw, zz[3];
7276 : int ip1;
7277 : double eta, phi, eps, tau, psi;
7278 : int iim1, iip1;
7279 : double dphi, dpsi;
7280 : int iter;
7281 : double temp, prew, sg2lb, sg2ub, temp1, temp2, dtiim, delsq,
7282 : dtiip;
7283 : int niter;
7284 : double dtisq;
7285 : int swtch;
7286 : double dtnsq;
7287 : double delsq2, dtnsq1;
7288 : int swtch3;
7289 : int orgati;
7290 : double erretm, dtipsq, rhoinv;
7291 :
7292 3251 : --work;
7293 3251 : --delta;
7294 3251 : --z__;
7295 3251 : --d__;
7296 :
7297 3251 : *info = 0;
7298 3251 : if (*n == 1) {
7299 :
7300 0 : *sigma = std::sqrt(d__[1] * d__[1] + *rho * z__[1] * z__[1]);
7301 0 : delta[1] = 1.;
7302 0 : work[1] = 1.;
7303 0 : return;
7304 : }
7305 3251 : if (*n == 2) {
7306 0 : PLUMED_BLAS_F77_FUNC(dlasd5,DLASD5)(i__, &d__[1], &z__[1], &delta[1], rho, sigma, &work[1]);
7307 0 : return;
7308 : }
7309 :
7310 : eps = PLUMED_GMX_DOUBLE_EPS;
7311 3251 : rhoinv = 1. / *rho;
7312 :
7313 3251 : if (*i__ == *n) {
7314 :
7315 59 : ii = *n - 1;
7316 59 : niter = 1;
7317 :
7318 59 : temp = *rho / 2.;
7319 :
7320 59 : temp1 = temp / (d__[*n] + std::sqrt(d__[*n] * d__[*n] + temp));
7321 59 : i__1 = *n;
7322 3310 : for (j = 1; j <= i__1; ++j) {
7323 3251 : work[j] = d__[j] + d__[*n] + temp1;
7324 3251 : delta[j] = d__[j] - d__[*n] - temp1;
7325 : }
7326 :
7327 : psi = 0.;
7328 59 : i__1 = *n - 2;
7329 3192 : for (j = 1; j <= i__1; ++j) {
7330 3133 : psi += z__[j] * z__[j] / (delta[j] * work[j]);
7331 : }
7332 :
7333 59 : c__ = rhoinv + psi;
7334 59 : w = c__ + z__[ii] * z__[ii] / (delta[ii] * work[ii]) + z__[*n] * z__[*
7335 59 : n] / (delta[*n] * work[*n]);
7336 :
7337 59 : if (w <= 0.) {
7338 0 : temp1 = std::sqrt(d__[*n] * d__[*n] + *rho);
7339 0 : temp = z__[*n - 1] * z__[*n - 1] / ((d__[*n - 1] + temp1) * (d__[*
7340 0 : n] - d__[*n - 1] + *rho / (d__[*n] + temp1))) + z__[*n] *
7341 0 : z__[*n] / *rho;
7342 :
7343 0 : if (c__ <= temp) {
7344 : tau = *rho;
7345 : } else {
7346 0 : delsq = (d__[*n] - d__[*n - 1]) * (d__[*n] + d__[*n - 1]);
7347 0 : a = -c__ * delsq + z__[*n - 1] * z__[*n - 1] + z__[*n] * z__[*
7348 : n];
7349 0 : b = z__[*n] * z__[*n] * delsq;
7350 0 : if (a < 0.) {
7351 0 : tau = b * 2. / ( std::sqrt(a * a + b * 4. * c__) - a);
7352 : } else {
7353 0 : tau = (a + std::sqrt(a * a + b * 4. * c__)) / (c__ * 2.);
7354 : }
7355 : }
7356 :
7357 : } else {
7358 59 : delsq = (d__[*n] - d__[*n - 1]) * (d__[*n] + d__[*n - 1]);
7359 59 : a = -c__ * delsq + z__[*n - 1] * z__[*n - 1] + z__[*n] * z__[*n];
7360 59 : b = z__[*n] * z__[*n] * delsq;
7361 :
7362 59 : if (a < 0.) {
7363 59 : tau = b * 2. / ( std::sqrt(a * a + b * 4. * c__) - a);
7364 : } else {
7365 0 : tau = (a + std::sqrt(a * a + b * 4. * c__)) / (c__ * 2.);
7366 : }
7367 :
7368 : }
7369 :
7370 59 : eta = tau / (d__[*n] + std::sqrt(d__[*n] * d__[*n] + tau));
7371 :
7372 59 : *sigma = d__[*n] + eta;
7373 59 : i__1 = *n;
7374 3310 : for (j = 1; j <= i__1; ++j) {
7375 3251 : delta[j] = d__[j] - d__[*i__] - eta;
7376 3251 : work[j] = d__[j] + d__[*i__] + eta;
7377 : }
7378 :
7379 : dpsi = 0.;
7380 : psi = 0.;
7381 : erretm = 0.;
7382 : i__1 = ii;
7383 3251 : for (j = 1; j <= i__1; ++j) {
7384 3192 : temp = z__[j] / (delta[j] * work[j]);
7385 3192 : psi += z__[j] * temp;
7386 3192 : dpsi += temp * temp;
7387 3192 : erretm += psi;
7388 : }
7389 : erretm = std::abs(erretm);
7390 :
7391 59 : temp = z__[*n] / (delta[*n] * work[*n]);
7392 59 : phi = z__[*n] * temp;
7393 59 : dphi = temp * temp;
7394 59 : erretm = (-phi - psi) * 8. + erretm - phi + rhoinv + std::abs(tau) * (dpsi
7395 59 : + dphi);
7396 :
7397 59 : w = rhoinv + phi + psi;
7398 :
7399 59 : if (std::abs(w) <= eps * erretm) {
7400 0 : goto L240;
7401 : }
7402 :
7403 59 : ++niter;
7404 59 : dtnsq1 = work[*n - 1] * delta[*n - 1];
7405 : dtnsq = work[*n] * delta[*n];
7406 59 : c__ = w - dtnsq1 * dpsi - dtnsq * dphi;
7407 59 : a = (dtnsq + dtnsq1) * w - dtnsq * dtnsq1 * (dpsi + dphi);
7408 59 : b = dtnsq * dtnsq1 * w;
7409 59 : if (c__ < 0.) {
7410 0 : c__ = std::abs(c__);
7411 : }
7412 59 : if ( std::abs(c__)<PLUMED_GMX_DOUBLE_MIN) {
7413 0 : eta = *rho - *sigma * *sigma;
7414 59 : } else if (a >= 0.) {
7415 1 : eta = (a + std::sqrt(std::abs(a * a - b * 4. * c__))) / (c__ * 2.);
7416 : } else {
7417 58 : eta = b * 2. / (a - std::sqrt(std::abs(a * a - b * 4. * c__)));
7418 : }
7419 :
7420 59 : if (w * eta > 0.) {
7421 0 : eta = -w / (dpsi + dphi);
7422 : }
7423 59 : temp = eta - dtnsq;
7424 59 : if (temp > *rho) {
7425 0 : eta = *rho + dtnsq;
7426 : }
7427 :
7428 59 : tau += eta;
7429 59 : eta /= *sigma + std::sqrt(eta + *sigma * *sigma);
7430 59 : i__1 = *n;
7431 3310 : for (j = 1; j <= i__1; ++j) {
7432 3251 : delta[j] -= eta;
7433 3251 : work[j] += eta;
7434 : }
7435 :
7436 59 : *sigma += eta;
7437 :
7438 : dpsi = 0.;
7439 : psi = 0.;
7440 : erretm = 0.;
7441 : i__1 = ii;
7442 3251 : for (j = 1; j <= i__1; ++j) {
7443 3192 : temp = z__[j] / (work[j] * delta[j]);
7444 3192 : psi += z__[j] * temp;
7445 3192 : dpsi += temp * temp;
7446 3192 : erretm += psi;
7447 : }
7448 : erretm = std::abs(erretm);
7449 :
7450 59 : temp = z__[*n] / (work[*n] * delta[*n]);
7451 59 : phi = z__[*n] * temp;
7452 59 : dphi = temp * temp;
7453 59 : erretm = (-phi - psi) * 8. + erretm - phi + rhoinv + std::abs(tau) * (dpsi
7454 59 : + dphi);
7455 :
7456 59 : w = rhoinv + phi + psi;
7457 :
7458 : iter = niter + 1;
7459 :
7460 113 : for (niter = iter; niter <= 20; ++niter) {
7461 :
7462 113 : if (std::abs(w) <= eps * erretm) {
7463 59 : goto L240;
7464 : }
7465 54 : dtnsq1 = work[*n - 1] * delta[*n - 1];
7466 54 : dtnsq = work[*n] * delta[*n];
7467 54 : c__ = w - dtnsq1 * dpsi - dtnsq * dphi;
7468 54 : a = (dtnsq + dtnsq1) * w - dtnsq1 * dtnsq * (dpsi + dphi);
7469 54 : b = dtnsq1 * dtnsq * w;
7470 54 : if (a >= 0.) {
7471 0 : eta = (a + std::sqrt(std::abs(a * a - b * 4. * c__))) / (c__ * 2.);
7472 : } else {
7473 54 : eta = b * 2. / (a - std::sqrt(std::abs(a * a - b * 4. * c__)));
7474 : }
7475 :
7476 54 : if (w * eta > 0.) {
7477 0 : eta = -w / (dpsi + dphi);
7478 : }
7479 54 : temp = eta - dtnsq;
7480 54 : if (temp <= 0.) {
7481 0 : eta /= 2.;
7482 : }
7483 :
7484 54 : tau += eta;
7485 54 : eta /= *sigma + std::sqrt(eta + *sigma * *sigma);
7486 54 : i__1 = *n;
7487 1745 : for (j = 1; j <= i__1; ++j) {
7488 1691 : delta[j] -= eta;
7489 1691 : work[j] += eta;
7490 : }
7491 :
7492 54 : *sigma += eta;
7493 :
7494 : dpsi = 0.;
7495 : psi = 0.;
7496 : erretm = 0.;
7497 : i__1 = ii;
7498 1691 : for (j = 1; j <= i__1; ++j) {
7499 1637 : temp = z__[j] / (work[j] * delta[j]);
7500 1637 : psi += z__[j] * temp;
7501 1637 : dpsi += temp * temp;
7502 1637 : erretm += psi;
7503 : }
7504 : erretm = std::abs(erretm);
7505 :
7506 54 : temp = z__[*n] / (work[*n] * delta[*n]);
7507 54 : phi = z__[*n] * temp;
7508 54 : dphi = temp * temp;
7509 54 : erretm = (-phi - psi) * 8. + erretm - phi + rhoinv + std::abs(tau) * (
7510 54 : dpsi + dphi);
7511 :
7512 54 : w = rhoinv + phi + psi;
7513 : }
7514 :
7515 0 : *info = 1;
7516 0 : goto L240;
7517 :
7518 : } else {
7519 :
7520 3192 : niter = 1;
7521 3192 : ip1 = *i__ + 1;
7522 :
7523 3192 : delsq = (d__[ip1] - d__[*i__]) * (d__[ip1] + d__[*i__]);
7524 3192 : delsq2 = delsq / 2.;
7525 3192 : temp = delsq2 / (d__[*i__] + std::sqrt(d__[*i__] * d__[*i__] + delsq2));
7526 3192 : i__1 = *n;
7527 420712 : for (j = 1; j <= i__1; ++j) {
7528 417520 : work[j] = d__[j] + d__[*i__] + temp;
7529 417520 : delta[j] = d__[j] - d__[*i__] - temp;
7530 : }
7531 :
7532 : psi = 0.;
7533 3192 : i__1 = *i__ - 1;
7534 208760 : for (j = 1; j <= i__1; ++j) {
7535 205568 : psi += z__[j] * z__[j] / (work[j] * delta[j]);
7536 : }
7537 :
7538 : phi = 0.;
7539 3192 : i__1 = *i__ + 2;
7540 208760 : for (j = *n; j >= i__1; --j) {
7541 205568 : phi += z__[j] * z__[j] / (work[j] * delta[j]);
7542 : }
7543 3192 : c__ = rhoinv + psi + phi;
7544 3192 : w = c__ + z__[*i__] * z__[*i__] / (work[*i__] * delta[*i__]) + z__[
7545 3192 : ip1] * z__[ip1] / (work[ip1] * delta[ip1]);
7546 :
7547 3192 : if (w > 0.) {
7548 :
7549 1684 : orgati = 1;
7550 : sg2lb = 0.;
7551 : sg2ub = delsq2;
7552 1684 : a = c__ * delsq + z__[*i__] * z__[*i__] + z__[ip1] * z__[ip1];
7553 1684 : b = z__[*i__] * z__[*i__] * delsq;
7554 1684 : if (a > 0.) {
7555 1655 : tau = b * 2. / (a + std::sqrt(std::abs(a * a - b * 4. * c__)));
7556 : } else {
7557 29 : tau = (a - std::sqrt(std::abs(a * a - b * 4. * c__))) / (c__ * 2.);
7558 : }
7559 1684 : eta = tau / (d__[*i__] + std::sqrt(d__[*i__] * d__[*i__] + tau));
7560 : } else {
7561 :
7562 1508 : orgati = 0;
7563 1508 : sg2lb = -delsq2;
7564 : sg2ub = 0.;
7565 1508 : a = c__ * delsq - z__[*i__] * z__[*i__] - z__[ip1] * z__[ip1];
7566 1508 : b = z__[ip1] * z__[ip1] * delsq;
7567 1508 : if (a < 0.) {
7568 1480 : tau = b * 2. / (a - std::sqrt(std::abs(a * a + b * 4. * c__)));
7569 : } else {
7570 28 : tau = -(a + std::sqrt(std::abs(a * a + b * 4. * c__))) / (c__ * 2.);
7571 : }
7572 1508 : eta = tau / (d__[ip1] + std::sqrt(std::abs(d__[ip1] * d__[ip1] + tau)));
7573 : }
7574 :
7575 3192 : if (orgati) {
7576 1684 : ii = *i__;
7577 1684 : *sigma = d__[*i__] + eta;
7578 1684 : i__1 = *n;
7579 220971 : for (j = 1; j <= i__1; ++j) {
7580 219287 : work[j] = d__[j] + d__[*i__] + eta;
7581 219287 : delta[j] = d__[j] - d__[*i__] - eta;
7582 : }
7583 : } else {
7584 1508 : ii = *i__ + 1;
7585 1508 : *sigma = d__[ip1] + eta;
7586 1508 : i__1 = *n;
7587 199741 : for (j = 1; j <= i__1; ++j) {
7588 198233 : work[j] = d__[j] + d__[ip1] + eta;
7589 198233 : delta[j] = d__[j] - d__[ip1] - eta;
7590 : }
7591 : }
7592 3192 : iim1 = ii - 1;
7593 3192 : iip1 = ii + 1;
7594 :
7595 : dpsi = 0.;
7596 : psi = 0.;
7597 : erretm = 0.;
7598 : i__1 = iim1;
7599 210268 : for (j = 1; j <= i__1; ++j) {
7600 207076 : temp = z__[j] / (work[j] * delta[j]);
7601 207076 : psi += z__[j] * temp;
7602 207076 : dpsi += temp * temp;
7603 207076 : erretm += psi;
7604 : }
7605 : erretm = std::abs(erretm);
7606 :
7607 : dphi = 0.;
7608 : phi = 0.;
7609 : i__1 = iip1;
7610 210444 : for (j = *n; j >= i__1; --j) {
7611 207252 : temp = z__[j] / (work[j] * delta[j]);
7612 207252 : phi += z__[j] * temp;
7613 207252 : dphi += temp * temp;
7614 207252 : erretm += phi;
7615 : }
7616 :
7617 3192 : w = rhoinv + phi + psi;
7618 :
7619 : swtch3 = 0;
7620 3192 : if (orgati) {
7621 1684 : if (w < 0.) {
7622 : swtch3 = 1;
7623 : }
7624 : } else {
7625 1508 : if (w > 0.) {
7626 : swtch3 = 1;
7627 : }
7628 : }
7629 3192 : if (ii == 1 || ii == *n) {
7630 : swtch3 = 0;
7631 : }
7632 :
7633 3192 : temp = z__[ii] / (work[ii] * delta[ii]);
7634 3192 : dw = dpsi + dphi + temp * temp;
7635 3192 : temp = z__[ii] * temp;
7636 3192 : w += temp;
7637 3192 : erretm = (phi - psi) * 8. + erretm + rhoinv * 2. + std::abs(temp) * 3. +
7638 3192 : std::abs(tau) * dw;
7639 :
7640 3192 : if (std::abs(w) <= eps * erretm) {
7641 7 : goto L240;
7642 : }
7643 :
7644 3185 : if (w <= 0.) {
7645 1683 : sg2lb = (sg2lb > tau) ? sg2lb : tau;
7646 : } else {
7647 1502 : sg2ub = (sg2ub < tau) ? sg2ub : tau;
7648 : }
7649 :
7650 3185 : ++niter;
7651 3185 : if (! swtch3) {
7652 2843 : dtipsq = work[ip1] * delta[ip1];
7653 2843 : dtisq = work[*i__] * delta[*i__];
7654 2843 : if (orgati) {
7655 1510 : d__1 = z__[*i__] / dtisq;
7656 1510 : c__ = w - dtipsq * dw + delsq * (d__1 * d__1);
7657 : } else {
7658 1333 : d__1 = z__[ip1] / dtipsq;
7659 1333 : c__ = w - dtisq * dw - delsq * (d__1 * d__1);
7660 : }
7661 2843 : a = (dtipsq + dtisq) * w - dtipsq * dtisq * dw;
7662 2843 : b = dtipsq * dtisq * w;
7663 2843 : if ( std::abs(c__)<PLUMED_GMX_DOUBLE_MIN) {
7664 23 : if ( std::abs(a)<PLUMED_GMX_DOUBLE_MIN) {
7665 0 : if (orgati) {
7666 0 : a = z__[*i__] * z__[*i__] + dtipsq * dtipsq * (dpsi +
7667 : dphi);
7668 : } else {
7669 0 : a = z__[ip1] * z__[ip1] + dtisq * dtisq * (dpsi +
7670 : dphi);
7671 : }
7672 : }
7673 23 : eta = b / a;
7674 2820 : } else if (a <= 0.) {
7675 0 : eta = (a - std::sqrt(std::abs(a * a - b * 4. * c__))) / (c__ * 2.);
7676 : } else {
7677 2820 : eta = b * 2. / (a + std::sqrt(std::abs(a * a - b * 4. * c__)));
7678 : }
7679 : } else {
7680 :
7681 342 : dtiim = work[iim1] * delta[iim1];
7682 342 : dtiip = work[iip1] * delta[iip1];
7683 342 : temp = rhoinv + psi + phi;
7684 342 : if (orgati) {
7685 173 : temp1 = z__[iim1] / dtiim;
7686 173 : temp1 *= temp1;
7687 173 : c__ = temp - dtiip * (dpsi + dphi) - (d__[iim1] - d__[iip1]) *
7688 173 : (d__[iim1] + d__[iip1]) * temp1;
7689 173 : zz[0] = z__[iim1] * z__[iim1];
7690 173 : if (dpsi < temp1) {
7691 0 : zz[2] = dtiip * dtiip * dphi;
7692 : } else {
7693 173 : zz[2] = dtiip * dtiip * (dpsi - temp1 + dphi);
7694 : }
7695 : } else {
7696 169 : temp1 = z__[iip1] / dtiip;
7697 169 : temp1 *= temp1;
7698 169 : c__ = temp - dtiim * (dpsi + dphi) - (d__[iip1] - d__[iim1]) *
7699 169 : (d__[iim1] + d__[iip1]) * temp1;
7700 169 : if (dphi < temp1) {
7701 0 : zz[0] = dtiim * dtiim * dpsi;
7702 : } else {
7703 169 : zz[0] = dtiim * dtiim * (dpsi + (dphi - temp1));
7704 : }
7705 169 : zz[2] = z__[iip1] * z__[iip1];
7706 : }
7707 342 : zz[1] = z__[ii] * z__[ii];
7708 342 : dd[0] = dtiim;
7709 342 : dd[1] = delta[ii] * work[ii];
7710 342 : dd[2] = dtiip;
7711 342 : PLUMED_BLAS_F77_FUNC(dlaed6,DLAED6)(&niter, &orgati, &c__, dd, zz, &w, &eta, info);
7712 342 : if (*info != 0) {
7713 0 : goto L240;
7714 : }
7715 : }
7716 :
7717 3185 : if (w * eta >= 0.) {
7718 0 : eta = -w / dw;
7719 : }
7720 3185 : if (orgati) {
7721 1683 : temp1 = work[*i__] * delta[*i__];
7722 1683 : temp = eta - temp1;
7723 : } else {
7724 1502 : temp1 = work[ip1] * delta[ip1];
7725 1502 : temp = eta - temp1;
7726 : }
7727 3185 : if (temp > sg2ub || temp < sg2lb) {
7728 0 : if (w < 0.) {
7729 0 : eta = (sg2ub - tau) / 2.;
7730 : } else {
7731 0 : eta = (sg2lb - tau) / 2.;
7732 : }
7733 : }
7734 :
7735 3185 : tau += eta;
7736 3185 : eta /= *sigma + std::sqrt(*sigma * *sigma + eta);
7737 :
7738 : prew = w;
7739 :
7740 3185 : *sigma += eta;
7741 3185 : i__1 = *n;
7742 419753 : for (j = 1; j <= i__1; ++j) {
7743 416568 : work[j] += eta;
7744 416568 : delta[j] -= eta;
7745 : }
7746 :
7747 : dpsi = 0.;
7748 : psi = 0.;
7749 : erretm = 0.;
7750 : i__1 = iim1;
7751 210255 : for (j = 1; j <= i__1; ++j) {
7752 207070 : temp = z__[j] / (work[j] * delta[j]);
7753 207070 : psi += z__[j] * temp;
7754 207070 : dpsi += temp * temp;
7755 207070 : erretm += psi;
7756 : }
7757 : erretm = std::abs(erretm);
7758 :
7759 : dphi = 0.;
7760 : phi = 0.;
7761 : i__1 = iip1;
7762 209498 : for (j = *n; j >= i__1; --j) {
7763 206313 : temp = z__[j] / (work[j] * delta[j]);
7764 206313 : phi += z__[j] * temp;
7765 206313 : dphi += temp * temp;
7766 206313 : erretm += phi;
7767 : }
7768 :
7769 3185 : temp = z__[ii] / (work[ii] * delta[ii]);
7770 3185 : dw = dpsi + dphi + temp * temp;
7771 3185 : temp = z__[ii] * temp;
7772 3185 : w = rhoinv + phi + psi + temp;
7773 3185 : erretm = (phi - psi) * 8. + erretm + rhoinv * 2. + std::abs(temp) * 3. +
7774 3185 : std::abs(tau) * dw;
7775 :
7776 3185 : if (w <= 0.) {
7777 1672 : sg2lb = (sg2lb > tau) ? sg2lb : tau;
7778 : } else {
7779 1513 : sg2ub = (sg2ub < tau) ? sg2ub : tau;
7780 : }
7781 :
7782 : swtch = 0;
7783 3185 : if (orgati) {
7784 1683 : if (-w > std::abs(prew) / 10.) {
7785 : swtch = 1;
7786 : }
7787 : } else {
7788 1502 : if (w > std::abs(prew) / 10.) {
7789 : swtch = 1;
7790 : }
7791 : }
7792 :
7793 3185 : iter = niter + 1;
7794 :
7795 9406 : for (niter = iter; niter <= 20; ++niter) {
7796 :
7797 9406 : if (std::abs(w) <= eps * erretm) {
7798 3185 : goto L240;
7799 : }
7800 :
7801 6221 : if (! swtch3) {
7802 5176 : dtipsq = work[ip1] * delta[ip1];
7803 5176 : dtisq = work[*i__] * delta[*i__];
7804 5176 : if (! swtch) {
7805 5069 : if (orgati) {
7806 2626 : d__1 = z__[*i__] / dtisq;
7807 2626 : c__ = w - dtipsq * dw + delsq * (d__1 * d__1);
7808 : } else {
7809 2443 : d__1 = z__[ip1] / dtipsq;
7810 2443 : c__ = w - dtisq * dw - delsq * (d__1 * d__1);
7811 : }
7812 : } else {
7813 107 : temp = z__[ii] / (work[ii] * delta[ii]);
7814 107 : if (orgati) {
7815 69 : dpsi += temp * temp;
7816 : } else {
7817 38 : dphi += temp * temp;
7818 : }
7819 107 : c__ = w - dtisq * dpsi - dtipsq * dphi;
7820 : }
7821 5176 : a = (dtipsq + dtisq) * w - dtipsq * dtisq * dw;
7822 5176 : b = dtipsq * dtisq * w;
7823 5176 : if (std::abs(c__)<PLUMED_GMX_DOUBLE_MIN) {
7824 0 : if (std::abs(a)<PLUMED_GMX_DOUBLE_MIN) {
7825 0 : if (! swtch) {
7826 0 : if (orgati) {
7827 0 : a = z__[*i__] * z__[*i__] + dtipsq * dtipsq *
7828 0 : (dpsi + dphi);
7829 : } else {
7830 0 : a = z__[ip1] * z__[ip1] + dtisq * dtisq * (
7831 0 : dpsi + dphi);
7832 : }
7833 : } else {
7834 0 : a = dtisq * dtisq * dpsi + dtipsq * dtipsq * dphi;
7835 : }
7836 : }
7837 0 : eta = b / a;
7838 5176 : } else if (a <= 0.) {
7839 0 : eta = (a - std::sqrt(std::abs(a * a - b * 4. * c__))) / (c__ * 2.);
7840 : } else {
7841 5176 : eta = b * 2. / (a + std::sqrt(std::abs(a * a - b * 4. * c__)));
7842 : }
7843 : } else {
7844 :
7845 1045 : dtiim = work[iim1] * delta[iim1];
7846 1045 : dtiip = work[iip1] * delta[iip1];
7847 1045 : temp = rhoinv + psi + phi;
7848 1045 : if (swtch) {
7849 250 : c__ = temp - dtiim * dpsi - dtiip * dphi;
7850 250 : zz[0] = dtiim * dtiim * dpsi;
7851 250 : zz[2] = dtiip * dtiip * dphi;
7852 : } else {
7853 795 : if (orgati) {
7854 399 : temp1 = z__[iim1] / dtiim;
7855 399 : temp1 *= temp1;
7856 399 : temp2 = (d__[iim1] - d__[iip1]) * (d__[iim1] + d__[
7857 : iip1]) * temp1;
7858 399 : c__ = temp - dtiip * (dpsi + dphi) - temp2;
7859 399 : zz[0] = z__[iim1] * z__[iim1];
7860 399 : if (dpsi < temp1) {
7861 0 : zz[2] = dtiip * dtiip * dphi;
7862 : } else {
7863 399 : zz[2] = dtiip * dtiip * (dpsi - temp1 + dphi);
7864 : }
7865 : } else {
7866 396 : temp1 = z__[iip1] / dtiip;
7867 396 : temp1 *= temp1;
7868 396 : temp2 = (d__[iip1] - d__[iim1]) * (d__[iim1] + d__[
7869 : iip1]) * temp1;
7870 396 : c__ = temp - dtiim * (dpsi + dphi) - temp2;
7871 396 : if (dphi < temp1) {
7872 0 : zz[0] = dtiim * dtiim * dpsi;
7873 : } else {
7874 396 : zz[0] = dtiim * dtiim * (dpsi + (dphi - temp1));
7875 : }
7876 396 : zz[2] = z__[iip1] * z__[iip1];
7877 : }
7878 : }
7879 1045 : dd[0] = dtiim;
7880 1045 : dd[1] = delta[ii] * work[ii];
7881 1045 : dd[2] = dtiip;
7882 1045 : PLUMED_BLAS_F77_FUNC(dlaed6,DLAED6)(&niter, &orgati, &c__, dd, zz, &w, &eta, info);
7883 1045 : if (*info != 0) {
7884 0 : goto L240;
7885 : }
7886 : }
7887 :
7888 6221 : if (w * eta >= 0.) {
7889 0 : eta = -w / dw;
7890 : }
7891 6221 : if (orgati) {
7892 3228 : temp1 = work[*i__] * delta[*i__];
7893 3228 : temp = eta - temp1;
7894 : } else {
7895 2993 : temp1 = work[ip1] * delta[ip1];
7896 2993 : temp = eta - temp1;
7897 : }
7898 6221 : if (temp > sg2ub || temp < sg2lb) {
7899 1 : if (w < 0.) {
7900 1 : eta = (sg2ub - tau) / 2.;
7901 : } else {
7902 0 : eta = (sg2lb - tau) / 2.;
7903 : }
7904 : }
7905 :
7906 6221 : tau += eta;
7907 6221 : eta /= *sigma + std::sqrt(*sigma * *sigma + eta);
7908 :
7909 6221 : *sigma += eta;
7910 6221 : i__1 = *n;
7911 819441 : for (j = 1; j <= i__1; ++j) {
7912 813220 : work[j] += eta;
7913 813220 : delta[j] -= eta;
7914 : }
7915 :
7916 : prew = w;
7917 :
7918 : dpsi = 0.;
7919 : psi = 0.;
7920 : erretm = 0.;
7921 : i__1 = iim1;
7922 391937 : for (j = 1; j <= i__1; ++j) {
7923 385716 : temp = z__[j] / (work[j] * delta[j]);
7924 385716 : psi += z__[j] * temp;
7925 385716 : dpsi += temp * temp;
7926 385716 : erretm += psi;
7927 : }
7928 : erretm = std::abs(erretm);
7929 :
7930 : dphi = 0.;
7931 : phi = 0.;
7932 : i__1 = iip1;
7933 427504 : for (j = *n; j >= i__1; --j) {
7934 421283 : temp = z__[j] / (work[j] * delta[j]);
7935 421283 : phi += z__[j] * temp;
7936 421283 : dphi += temp * temp;
7937 421283 : erretm += phi;
7938 : }
7939 :
7940 6221 : temp = z__[ii] / (work[ii] * delta[ii]);
7941 6221 : dw = dpsi + dphi + temp * temp;
7942 6221 : temp = z__[ii] * temp;
7943 6221 : w = rhoinv + phi + psi + temp;
7944 6221 : erretm = (phi - psi) * 8. + erretm + rhoinv * 2. + std::abs(temp) * 3.
7945 6221 : + std::abs(tau) * dw;
7946 6221 : if (w * prew > 0. && std::abs(w) > std::abs(prew) / 10.) {
7947 2 : swtch = ! swtch;
7948 : }
7949 :
7950 6221 : if (w <= 0.) {
7951 3250 : sg2lb = (sg2lb > tau) ? sg2lb : tau;
7952 : } else {
7953 2971 : sg2ub = (sg2ub < tau) ? sg2ub : tau;
7954 : }
7955 : }
7956 :
7957 0 : *info = 1;
7958 :
7959 : }
7960 :
7961 3251 : L240:
7962 : return;
7963 :
7964 : }
7965 : }
7966 : }
7967 : #include <cmath>
7968 : #include "lapack.h"
7969 :
7970 : #include "blas/blas.h"
7971 : namespace PLMD{
7972 : namespace lapack{
7973 : using namespace blas;
7974 : void
7975 0 : PLUMED_BLAS_F77_FUNC(dlasd5,DLASD5)(int *i__,
7976 : double *d__,
7977 : double *z__,
7978 : double *delta,
7979 : double *rho,
7980 : double *dsigma,
7981 : double *work)
7982 : {
7983 : double b, c__, w, del, tau, delsq;
7984 :
7985 : --work;
7986 : --delta;
7987 : --z__;
7988 : --d__;
7989 :
7990 0 : del = d__[2] - d__[1];
7991 0 : delsq = del * (d__[2] + d__[1]);
7992 0 : if (*i__ == 1) {
7993 0 : w = *rho * 4. * (z__[2] * z__[2] / (d__[1] + d__[2] * 3.) - z__[1] *
7994 0 : z__[1] / (d__[1] * 3. + d__[2])) / del + 1.;
7995 0 : if (w > 0.) {
7996 0 : b = delsq + *rho * (z__[1] * z__[1] + z__[2] * z__[2]);
7997 0 : c__ = *rho * z__[1] * z__[1] * delsq;
7998 :
7999 0 : tau = c__ * 2. / (b + std::sqrt(std::abs(b * b - c__ * 4.)));
8000 :
8001 0 : tau /= d__[1] + std::sqrt(d__[1] * d__[1] + tau);
8002 0 : *dsigma = d__[1] + tau;
8003 0 : delta[1] = -tau;
8004 0 : delta[2] = del - tau;
8005 0 : work[1] = d__[1] * 2. + tau;
8006 0 : work[2] = d__[1] + tau + d__[2];
8007 : } else {
8008 0 : b = -delsq + *rho * (z__[1] * z__[1] + z__[2] * z__[2]);
8009 0 : c__ = *rho * z__[2] * z__[2] * delsq;
8010 :
8011 0 : if (b > 0.) {
8012 0 : tau = c__ * -2. / (b + std::sqrt(b * b + c__ * 4.));
8013 : } else {
8014 0 : tau = (b - std::sqrt(b * b + c__ * 4.)) / 2.;
8015 : }
8016 :
8017 0 : tau /= d__[2] + std::sqrt(std::abs(d__[2] * d__[2] + tau));
8018 0 : *dsigma = d__[2] + tau;
8019 0 : delta[1] = -(del + tau);
8020 0 : delta[2] = -tau;
8021 0 : work[1] = d__[1] + tau + d__[2];
8022 0 : work[2] = d__[2] * 2. + tau;
8023 : }
8024 : } else {
8025 :
8026 0 : b = -delsq + *rho * (z__[1] * z__[1] + z__[2] * z__[2]);
8027 0 : c__ = *rho * z__[2] * z__[2] * delsq;
8028 :
8029 0 : if (b > 0.) {
8030 0 : tau = (b + std::sqrt(b * b + c__ * 4.)) / 2.;
8031 : } else {
8032 0 : tau = c__ * 2. / (-b + std::sqrt(b * b + c__ * 4.));
8033 : }
8034 0 : tau /= d__[2] + std::sqrt(d__[2] * d__[2] + tau);
8035 0 : *dsigma = d__[2] + tau;
8036 0 : delta[1] = -(del + tau);
8037 0 : delta[2] = -tau;
8038 0 : work[1] = d__[1] + tau + d__[2];
8039 0 : work[2] = d__[2] * 2. + tau;
8040 : }
8041 0 : return;
8042 :
8043 : }
8044 : }
8045 : }
8046 : #include <cmath>
8047 : #include "blas/blas.h"
8048 : #include "lapack.h"
8049 :
8050 : #include "blas/blas.h"
8051 : namespace PLMD{
8052 : namespace lapack{
8053 : using namespace blas;
8054 : void
8055 0 : PLUMED_BLAS_F77_FUNC(dlasd6,DLASD6)(int *icompq,
8056 : int *nl,
8057 : int *nr,
8058 : int *sqre,
8059 : double *d__,
8060 : double *vf,
8061 : double *vl,
8062 : double *alpha,
8063 : double *beta,
8064 : int *idxq,
8065 : int *perm,
8066 : int *givptr,
8067 : int *givcol,
8068 : int *ldgcol,
8069 : double *givnum,
8070 : int *ldgnum,
8071 : double *poles,
8072 : double *difl,
8073 : double *difr,
8074 : double *z__,
8075 : int *k,
8076 : double *c__,
8077 : double *s,
8078 : double *work,
8079 : int *iwork,
8080 : int *info)
8081 : {
8082 : int givcol_dim1, givcol_offset, givnum_dim1, givnum_offset,
8083 : poles_dim1, poles_offset, i__1;
8084 : double d__1, d__2;
8085 :
8086 : int i__, m, n, n1, n2, iw, idx, idxc, idxp, ivfw, ivlw;
8087 : int isigma;
8088 : double orgnrm;
8089 0 : int c__0 = 0;
8090 0 : double one = 1.0;
8091 0 : int c__1 = 1;
8092 0 : int c_n1 = -1;
8093 :
8094 0 : --d__;
8095 : --vf;
8096 : --vl;
8097 : --idxq;
8098 : --perm;
8099 : givcol_dim1 = *ldgcol;
8100 : givcol_offset = 1 + givcol_dim1;
8101 : givcol -= givcol_offset;
8102 0 : poles_dim1 = *ldgnum;
8103 0 : poles_offset = 1 + poles_dim1;
8104 0 : poles -= poles_offset;
8105 : givnum_dim1 = *ldgnum;
8106 : givnum_offset = 1 + givnum_dim1;
8107 : givnum -= givnum_offset;
8108 : --difl;
8109 : --difr;
8110 : --z__;
8111 0 : --work;
8112 : --iwork;
8113 :
8114 0 : *info = 0;
8115 0 : n = *nl + *nr + 1;
8116 0 : m = n + *sqre;
8117 :
8118 : isigma = 1;
8119 0 : iw = isigma + n;
8120 0 : ivfw = iw + m;
8121 0 : ivlw = ivfw + m;
8122 :
8123 : idx = 1;
8124 : idxc = idx + n;
8125 0 : idxp = idxc + n;
8126 :
8127 0 : d__1 = std::abs(*alpha);
8128 0 : d__2 = std::abs(*beta);
8129 0 : orgnrm = (d__1 > d__2) ? d__1 : d__2;
8130 0 : d__[*nl + 1] = 0.;
8131 : i__1 = n;
8132 0 : for (i__ = 1; i__ <= i__1; ++i__) {
8133 0 : d__1 = std::abs(d__[i__]);
8134 0 : if (d__1 > orgnrm)
8135 0 : orgnrm = d__1;
8136 : }
8137 0 : PLUMED_BLAS_F77_FUNC(dlascl,DLASCL)("G", &c__0, &c__0, &orgnrm, &one, &n, &c__1, &d__[1], &n, info);
8138 0 : *alpha /= orgnrm;
8139 0 : *beta /= orgnrm;
8140 :
8141 0 : PLUMED_BLAS_F77_FUNC(dlasd7,DLASD7)(icompq, nl, nr, sqre, k, &d__[1], &z__[1], &work[iw], &vf[1], &
8142 0 : work[ivfw], &vl[1], &work[ivlw], alpha, beta, &work[isigma], &
8143 0 : iwork[idx], &iwork[idxp], &idxq[1], &perm[1], givptr, &givcol[
8144 : givcol_offset], ldgcol, &givnum[givnum_offset], ldgnum, c__, s,
8145 : info);
8146 :
8147 0 : PLUMED_BLAS_F77_FUNC(dlasd8,DLASD8)(icompq, k, &d__[1], &z__[1], &vf[1], &vl[1], &difl[1], &difr[1],
8148 : ldgnum, &work[isigma], &work[iw], info);
8149 :
8150 0 : if (*icompq == 1) {
8151 0 : PLUMED_BLAS_F77_FUNC(dcopy,DCOPY)(k, &d__[1], &c__1, &poles[poles_dim1 + 1], &c__1);
8152 0 : PLUMED_BLAS_F77_FUNC(dcopy,DCOPY)(k, &work[isigma], &c__1, &poles[(poles_dim1 << 1) + 1], &c__1);
8153 : }
8154 :
8155 0 : PLUMED_BLAS_F77_FUNC(dlascl,DLASCL)("G", &c__0, &c__0, &one, &orgnrm, &n, &c__1, &d__[1], &n, info);
8156 :
8157 0 : n1 = *k;
8158 0 : n2 = n - *k;
8159 0 : PLUMED_BLAS_F77_FUNC(dlamrg,DLAMRG)(&n1, &n2, &d__[1], &c__1, &c_n1, &idxq[1]);
8160 :
8161 0 : return;
8162 :
8163 : }
8164 :
8165 :
8166 : }
8167 : }
8168 : #include <cmath>
8169 : #include "real.h"
8170 :
8171 : #include "blas/blas.h"
8172 : #include "lapack.h"
8173 : #include "lapack_limits.h"
8174 :
8175 : #include "blas/blas.h"
8176 : namespace PLMD{
8177 : namespace lapack{
8178 : using namespace blas;
8179 : void
8180 0 : PLUMED_BLAS_F77_FUNC(dlasd7,DLASD7)(int *icompq,
8181 : int *nl,
8182 : int *nr,
8183 : int *sqre,
8184 : int *k,
8185 : double *d__,
8186 : double *z__,
8187 : double *zw,
8188 : double *vf,
8189 : double *vfw,
8190 : double *vl,
8191 : double *vlw,
8192 : double *alpha,
8193 : double *beta,
8194 : double *dsigma,
8195 : int *idx,
8196 : int *idxp,
8197 : int *idxq,
8198 : int *perm,
8199 : int *givptr,
8200 : int *givcol,
8201 : int *ldgcol,
8202 : double *givnum,
8203 : int *ldgnum,
8204 : double *c__,
8205 : double *s,
8206 : int *info)
8207 : {
8208 : int givcol_dim1, givcol_offset, givnum_dim1, givnum_offset, i__1;
8209 : double d__1, d__2;
8210 :
8211 : int i__, j, m, n, k2;
8212 : double z1;
8213 : int jp;
8214 : double eps, tau, tol;
8215 : int nlp1, nlp2, idxi, idxj;
8216 : int idxjp;
8217 : int jprev = 0;
8218 : double hlftol;
8219 0 : int c__1 = 1;
8220 :
8221 0 : --d__;
8222 0 : --z__;
8223 0 : --zw;
8224 0 : --vf;
8225 0 : --vfw;
8226 0 : --vl;
8227 0 : --vlw;
8228 0 : --dsigma;
8229 0 : --idx;
8230 0 : --idxp;
8231 0 : --idxq;
8232 0 : --perm;
8233 0 : givcol_dim1 = *ldgcol;
8234 0 : givcol_offset = 1 + givcol_dim1;
8235 0 : givcol -= givcol_offset;
8236 0 : givnum_dim1 = *ldgnum;
8237 0 : givnum_offset = 1 + givnum_dim1;
8238 0 : givnum -= givnum_offset;
8239 :
8240 0 : *info = 0;
8241 0 : n = *nl + *nr + 1;
8242 0 : m = n + *sqre;
8243 :
8244 0 : nlp1 = *nl + 1;
8245 0 : nlp2 = *nl + 2;
8246 0 : if (*icompq == 1) {
8247 0 : *givptr = 0;
8248 : }
8249 :
8250 0 : z1 = *alpha * vl[nlp1];
8251 0 : vl[nlp1] = 0.;
8252 0 : tau = vf[nlp1];
8253 0 : for (i__ = *nl; i__ >= 1; --i__) {
8254 0 : z__[i__ + 1] = *alpha * vl[i__];
8255 0 : vl[i__] = 0.;
8256 0 : vf[i__ + 1] = vf[i__];
8257 0 : d__[i__ + 1] = d__[i__];
8258 0 : idxq[i__ + 1] = idxq[i__] + 1;
8259 : }
8260 0 : vf[1] = tau;
8261 :
8262 : i__1 = m;
8263 0 : for (i__ = nlp2; i__ <= i__1; ++i__) {
8264 0 : z__[i__] = *beta * vf[i__];
8265 0 : vf[i__] = 0.;
8266 : }
8267 0 : i__1 = n;
8268 0 : for (i__ = nlp2; i__ <= i__1; ++i__) {
8269 0 : idxq[i__] += nlp1;
8270 : }
8271 :
8272 : i__1 = n;
8273 0 : for (i__ = 2; i__ <= i__1; ++i__) {
8274 0 : dsigma[i__] = d__[idxq[i__]];
8275 0 : zw[i__] = z__[idxq[i__]];
8276 0 : vfw[i__] = vf[idxq[i__]];
8277 0 : vlw[i__] = vl[idxq[i__]];
8278 : }
8279 :
8280 0 : PLUMED_BLAS_F77_FUNC(dlamrg,DLAMRG)(nl, nr, &dsigma[2], &c__1, &c__1, &idx[2]);
8281 :
8282 0 : i__1 = n;
8283 0 : for (i__ = 2; i__ <= i__1; ++i__) {
8284 0 : idxi = idx[i__] + 1;
8285 0 : d__[i__] = dsigma[idxi];
8286 0 : z__[i__] = zw[idxi];
8287 0 : vf[i__] = vfw[idxi];
8288 0 : vl[i__] = vlw[idxi];
8289 : }
8290 :
8291 : eps = PLUMED_GMX_DOUBLE_EPS;
8292 :
8293 0 : d__1 = std::abs(*alpha);
8294 0 : d__2 = std::abs(*beta);
8295 0 : tol = (d__1>d__2) ? d__1 : d__2;
8296 0 : d__2 = std::abs(d__[n]);
8297 0 : tol = eps * 64. * ((d__2>tol) ? d__2 : tol);
8298 :
8299 0 : *k = 1;
8300 0 : k2 = n + 1;
8301 : i__1 = n;
8302 0 : for (j = 2; j <= i__1; ++j) {
8303 0 : if (std::abs(z__[j]) <= tol) {
8304 :
8305 0 : --k2;
8306 0 : idxp[k2] = j;
8307 0 : if (j == n) {
8308 0 : goto L100;
8309 : }
8310 : } else {
8311 : jprev = j;
8312 0 : goto L70;
8313 : }
8314 : }
8315 0 : L70:
8316 : j = jprev;
8317 0 : L80:
8318 0 : ++j;
8319 0 : if (j > n) {
8320 0 : goto L90;
8321 : }
8322 0 : if (std::abs(z__[j]) <= tol) {
8323 :
8324 0 : --k2;
8325 0 : idxp[k2] = j;
8326 : } else {
8327 :
8328 0 : if (std::abs(d__[j] - d__[jprev]) <= tol) {
8329 :
8330 0 : *s = z__[jprev];
8331 0 : *c__ = z__[j];
8332 :
8333 0 : tau = PLUMED_BLAS_F77_FUNC(dlapy2,DLAPY2)(c__, s);
8334 0 : z__[j] = tau;
8335 0 : z__[jprev] = 0.;
8336 0 : *c__ /= tau;
8337 0 : *s = -(*s) / tau;
8338 :
8339 :
8340 0 : if (*icompq == 1) {
8341 0 : ++(*givptr);
8342 0 : idxjp = idxq[idx[jprev] + 1];
8343 0 : idxj = idxq[idx[j] + 1];
8344 0 : if (idxjp <= nlp1) {
8345 0 : --idxjp;
8346 : }
8347 0 : if (idxj <= nlp1) {
8348 0 : --idxj;
8349 : }
8350 0 : givcol[*givptr + (givcol_dim1 << 1)] = idxjp;
8351 0 : givcol[*givptr + givcol_dim1] = idxj;
8352 0 : givnum[*givptr + (givnum_dim1 << 1)] = *c__;
8353 0 : givnum[*givptr + givnum_dim1] = *s;
8354 : }
8355 0 : PLUMED_BLAS_F77_FUNC(drot,DROT)(&c__1, &vf[jprev], &c__1, &vf[j], &c__1, c__, s);
8356 0 : PLUMED_BLAS_F77_FUNC(drot,DROT)(&c__1, &vl[jprev], &c__1, &vl[j], &c__1, c__, s);
8357 0 : --k2;
8358 0 : idxp[k2] = jprev;
8359 : jprev = j;
8360 : } else {
8361 0 : ++(*k);
8362 0 : zw[*k] = z__[jprev];
8363 0 : dsigma[*k] = d__[jprev];
8364 0 : idxp[*k] = jprev;
8365 : jprev = j;
8366 : }
8367 : }
8368 0 : goto L80;
8369 : L90:
8370 :
8371 0 : ++(*k);
8372 0 : zw[*k] = z__[jprev];
8373 0 : dsigma[*k] = d__[jprev];
8374 0 : idxp[*k] = jprev;
8375 :
8376 0 : L100:
8377 :
8378 0 : i__1 = n;
8379 0 : for (j = 2; j <= i__1; ++j) {
8380 0 : jp = idxp[j];
8381 0 : dsigma[j] = d__[jp];
8382 0 : vfw[j] = vf[jp];
8383 0 : vlw[j] = vl[jp];
8384 : }
8385 0 : if (*icompq == 1) {
8386 : i__1 = n;
8387 0 : for (j = 2; j <= i__1; ++j) {
8388 0 : jp = idxp[j];
8389 0 : perm[j] = idxq[idx[jp] + 1];
8390 0 : if (perm[j] <= nlp1) {
8391 0 : --perm[j];
8392 : }
8393 : }
8394 : }
8395 0 : i__1 = n - *k;
8396 0 : PLUMED_BLAS_F77_FUNC(dcopy,DCOPY)(&i__1, &dsigma[*k + 1], &c__1, &d__[*k + 1], &c__1);
8397 :
8398 0 : dsigma[1] = 0.;
8399 0 : hlftol = tol / 2.;
8400 0 : if (std::abs(dsigma[2]) <= hlftol) {
8401 0 : dsigma[2] = hlftol;
8402 : }
8403 0 : if (m > n) {
8404 0 : z__[1] = PLUMED_BLAS_F77_FUNC(dlapy2,DLAPY2)(&z1, &z__[m]);
8405 0 : if (z__[1] <= tol) {
8406 0 : *c__ = 1.;
8407 0 : *s = 0.;
8408 0 : z__[1] = tol;
8409 : } else {
8410 0 : *c__ = z1 / z__[1];
8411 0 : *s = -z__[m] / z__[1];
8412 : }
8413 0 : PLUMED_BLAS_F77_FUNC(drot,DROT)(&c__1, &vf[m], &c__1, &vf[1], &c__1, c__, s);
8414 0 : PLUMED_BLAS_F77_FUNC(drot,DROT)(&c__1, &vl[m], &c__1, &vl[1], &c__1, c__, s);
8415 : } else {
8416 0 : if (std::abs(z1) <= tol) {
8417 0 : z__[1] = tol;
8418 : } else {
8419 0 : z__[1] = z1;
8420 : }
8421 : }
8422 :
8423 0 : i__1 = *k - 1;
8424 0 : PLUMED_BLAS_F77_FUNC(dcopy,DCOPY)(&i__1, &zw[2], &c__1, &z__[2], &c__1);
8425 0 : i__1 = n - 1;
8426 0 : PLUMED_BLAS_F77_FUNC(dcopy,DCOPY)(&i__1, &vfw[2], &c__1, &vf[2], &c__1);
8427 0 : i__1 = n - 1;
8428 0 : PLUMED_BLAS_F77_FUNC(dcopy,DCOPY)(&i__1, &vlw[2], &c__1, &vl[2], &c__1);
8429 :
8430 0 : return;
8431 :
8432 : }
8433 :
8434 :
8435 : }
8436 : }
8437 : #include <cmath>
8438 : #include "blas/blas.h"
8439 : #include "lapack.h"
8440 :
8441 : #include "blas/blas.h"
8442 : namespace PLMD{
8443 : namespace lapack{
8444 : using namespace blas;
8445 : void
8446 0 : PLUMED_BLAS_F77_FUNC(dlasd8,DLASD8)(int *icompq,
8447 : int *k,
8448 : double *d__,
8449 : double *z__,
8450 : double *vf,
8451 : double *vl,
8452 : double *difl,
8453 : double *difr,
8454 : int *lddifr,
8455 : double *dsigma,
8456 : double *work,
8457 : int *info)
8458 : {
8459 : int difr_dim1, difr_offset, i__1, i__2;
8460 : double d__2;
8461 :
8462 : int i__, j;
8463 : double dj, rho;
8464 : int iwk1, iwk2, iwk3;
8465 : double temp;
8466 : int iwk2i, iwk3i;
8467 : double diflj, difrj, dsigj;
8468 : double dsigjp;
8469 0 : int c__1 = 1;
8470 0 : int c__0 = 0;
8471 0 : double one = 1.;
8472 :
8473 : /* avoid warnings on high gcc optimization levels */
8474 : difrj = dsigjp = 0;
8475 :
8476 0 : --d__;
8477 0 : --z__;
8478 : --vf;
8479 : --vl;
8480 0 : --difl;
8481 0 : difr_dim1 = *lddifr;
8482 0 : difr_offset = 1 + difr_dim1;
8483 0 : difr -= difr_offset;
8484 0 : --dsigma;
8485 0 : --work;
8486 :
8487 0 : *info = 0;
8488 :
8489 0 : if (*k == 1) {
8490 0 : d__[1] = std::abs(z__[1]);
8491 0 : difl[1] = d__[1];
8492 0 : if (*icompq == 1) {
8493 0 : difl[2] = 1.;
8494 0 : difr[(difr_dim1 << 1) + 1] = 1.;
8495 : }
8496 0 : return;
8497 : }
8498 :
8499 : iwk1 = 1;
8500 0 : iwk2 = iwk1 + *k;
8501 0 : iwk3 = iwk2 + *k;
8502 : iwk2i = iwk2 - 1;
8503 0 : iwk3i = iwk3 - 1;
8504 :
8505 0 : rho = PLUMED_BLAS_F77_FUNC(dnrm2,DNRM2)(k, &z__[1], &c__1);
8506 0 : PLUMED_BLAS_F77_FUNC(dlascl,DLASCL)("G", &c__0, &c__0, &rho, &one, k, &c__1, &z__[1], k, info);
8507 0 : rho *= rho;
8508 :
8509 0 : PLUMED_BLAS_F77_FUNC(dlaset,DLASET)("A", k, &c__1, &one, &one, &work[iwk3], k);
8510 :
8511 0 : i__1 = *k;
8512 0 : for (j = 1; j <= i__1; ++j) {
8513 0 : PLUMED_BLAS_F77_FUNC(dlasd4,DLASD4)(k, &j, &dsigma[1], &z__[1], &work[iwk1], &rho, &d__[j], &work[
8514 0 : iwk2], info);
8515 :
8516 0 : if (*info != 0) {
8517 : return;
8518 : }
8519 0 : work[iwk3i + j] = work[iwk3i + j] * work[j] * work[iwk2i + j];
8520 0 : difl[j] = -work[j];
8521 0 : difr[j + difr_dim1] = -work[j + 1];
8522 : i__2 = j - 1;
8523 0 : for (i__ = 1; i__ <= i__2; ++i__) {
8524 0 : work[iwk3i + i__] = work[iwk3i + i__] * work[i__] * work[iwk2i +
8525 0 : i__] / (dsigma[i__] - dsigma[j]) / (dsigma[i__] + dsigma[
8526 : j]);
8527 : }
8528 0 : i__2 = *k;
8529 0 : for (i__ = j + 1; i__ <= i__2; ++i__) {
8530 0 : work[iwk3i + i__] = work[iwk3i + i__] * work[i__] * work[iwk2i +
8531 0 : i__] / (dsigma[i__] - dsigma[j]) / (dsigma[i__] + dsigma[
8532 : j]);
8533 : }
8534 : }
8535 :
8536 0 : i__1 = *k;
8537 0 : for (i__ = 1; i__ <= i__1; ++i__) {
8538 0 : d__2 = std::sqrt(std::abs(work[iwk3i + i__]));
8539 0 : z__[i__] = (z__[i__] > 0) ? d__2 : -d__2;
8540 : }
8541 :
8542 0 : i__1 = *k;
8543 0 : for (j = 1; j <= i__1; ++j) {
8544 0 : diflj = difl[j];
8545 0 : dj = d__[j];
8546 0 : dsigj = -dsigma[j];
8547 0 : if (j < *k) {
8548 0 : difrj = -difr[j + difr_dim1];
8549 0 : dsigjp = -dsigma[j + 1];
8550 : }
8551 0 : work[j] = -z__[j] / diflj / (dsigma[j] + dj);
8552 : i__2 = j - 1;
8553 0 : for (i__ = 1; i__ <= i__2; ++i__) {
8554 0 : work[i__] = z__[i__] / (dsigma[i__] + dsigj - diflj) / ( dsigma[i__] + dj);
8555 : }
8556 0 : i__2 = *k;
8557 0 : for (i__ = j + 1; i__ <= i__2; ++i__) {
8558 0 : work[i__] = z__[i__] / (dsigma[i__] + dsigjp - difrj) / (dsigma[i__] + dj);
8559 : }
8560 0 : temp = PLUMED_BLAS_F77_FUNC(dnrm2,DNRM2)(k, &work[1], &c__1);
8561 0 : work[iwk2i + j] = PLUMED_BLAS_F77_FUNC(ddot,DDOT)(k, &work[1], &c__1, &vf[1], &c__1) / temp;
8562 0 : work[iwk3i + j] = PLUMED_BLAS_F77_FUNC(ddot,DDOT)(k, &work[1], &c__1, &vl[1], &c__1) / temp;
8563 0 : if (*icompq == 1) {
8564 0 : difr[j + (difr_dim1 << 1)] = temp;
8565 : }
8566 : }
8567 :
8568 0 : PLUMED_BLAS_F77_FUNC(dcopy,DCOPY)(k, &work[iwk2], &c__1, &vf[1], &c__1);
8569 0 : PLUMED_BLAS_F77_FUNC(dcopy,DCOPY)(k, &work[iwk3], &c__1, &vl[1], &c__1);
8570 :
8571 : return;
8572 :
8573 : }
8574 : }
8575 : }
8576 : #include "blas/blas.h"
8577 : #include "lapack.h"
8578 :
8579 : #include "blas/blas.h"
8580 : namespace PLMD{
8581 : namespace lapack{
8582 : using namespace blas;
8583 : void
8584 0 : PLUMED_BLAS_F77_FUNC(dlasda,DLASDA)(int *icompq,
8585 : int *smlsiz,
8586 : int *n,
8587 : int *sqre,
8588 : double *d__,
8589 : double *e,
8590 : double *u,
8591 : int *ldu,
8592 : double *vt,
8593 : int *k,
8594 : double *difl,
8595 : double *difr,
8596 : double *z__,
8597 : double *poles,
8598 : int *givptr,
8599 : int *givcol,
8600 : int *ldgcol,
8601 : int *perm,
8602 : double *givnum,
8603 : double *c__,
8604 : double *s,
8605 : double *work,
8606 : int *iwork,
8607 : int *info)
8608 : {
8609 : int givcol_dim1, givcol_offset, perm_dim1, perm_offset, difl_dim1,
8610 : difl_offset, difr_dim1, difr_offset, givnum_dim1, givnum_offset,
8611 : poles_dim1, poles_offset, u_dim1, u_offset, vt_dim1, vt_offset,
8612 : z_dim1, z_offset, i__1, i__2;
8613 :
8614 : int i__, j, m, i1, ic, lf, nd, ll, nl, vf, nr, vl, im1, ncc,
8615 : nlf, nrf, vfi, iwk, vli, lvl, nru, ndb1, nlp1, lvl2, nrp1;
8616 : double beta;
8617 : int idxq, nlvl;
8618 : double alpha;
8619 : int inode, ndiml, ndimr, idxqi, itemp;
8620 : int sqrei;
8621 : int nwork1, nwork2;
8622 : int smlszp;
8623 0 : int c__0 = 0;
8624 0 : double zero = 0.0;
8625 0 : double one = 1.;
8626 0 : int c__1 = 1;
8627 0 : --d__;
8628 0 : --e;
8629 0 : givnum_dim1 = *ldu;
8630 0 : givnum_offset = 1 + givnum_dim1;
8631 0 : givnum -= givnum_offset;
8632 : poles_dim1 = *ldu;
8633 : poles_offset = 1 + poles_dim1;
8634 : poles -= poles_offset;
8635 : z_dim1 = *ldu;
8636 : z_offset = 1 + z_dim1;
8637 : z__ -= z_offset;
8638 : difr_dim1 = *ldu;
8639 : difr_offset = 1 + difr_dim1;
8640 : difr -= difr_offset;
8641 : difl_dim1 = *ldu;
8642 : difl_offset = 1 + difl_dim1;
8643 : difl -= difl_offset;
8644 : vt_dim1 = *ldu;
8645 : vt_offset = 1 + vt_dim1;
8646 0 : vt -= vt_offset;
8647 : u_dim1 = *ldu;
8648 : u_offset = 1 + u_dim1;
8649 0 : u -= u_offset;
8650 : --k;
8651 : --givptr;
8652 0 : perm_dim1 = *ldgcol;
8653 0 : perm_offset = 1 + perm_dim1;
8654 0 : perm -= perm_offset;
8655 : givcol_dim1 = *ldgcol;
8656 : givcol_offset = 1 + givcol_dim1;
8657 : givcol -= givcol_offset;
8658 : --c__;
8659 : --s;
8660 0 : --work;
8661 0 : --iwork;
8662 0 : *info = 0;
8663 :
8664 0 : m = *n + *sqre;
8665 :
8666 0 : if (*n <= *smlsiz) {
8667 0 : if (*icompq == 0) {
8668 0 : PLUMED_BLAS_F77_FUNC(dlasdq,DLASDQ)("U", sqre, n, &c__0, &c__0, &c__0, &d__[1], &e[1], &vt[
8669 : vt_offset], ldu, &u[u_offset], ldu, &u[u_offset], ldu, &
8670 : work[1], info);
8671 : } else {
8672 0 : PLUMED_BLAS_F77_FUNC(dlasdq,DLASDQ)("U", sqre, n, &m, n, &c__0, &d__[1], &e[1], &vt[vt_offset]
8673 : , ldu, &u[u_offset], ldu, &u[u_offset], ldu, &work[1],
8674 : info);
8675 : }
8676 0 : return;
8677 : }
8678 :
8679 : inode = 1;
8680 0 : ndiml = inode + *n;
8681 0 : ndimr = ndiml + *n;
8682 0 : idxq = ndimr + *n;
8683 0 : iwk = idxq + *n;
8684 :
8685 0 : ncc = 0;
8686 0 : nru = 0;
8687 :
8688 0 : smlszp = *smlsiz + 1;
8689 : vf = 1;
8690 0 : vl = vf + m;
8691 0 : nwork1 = vl + m;
8692 0 : nwork2 = nwork1 + smlszp * smlszp;
8693 :
8694 0 : PLUMED_BLAS_F77_FUNC(dlasdt,DLASDT)(n, &nlvl, &nd, &iwork[inode], &iwork[ndiml], &iwork[ndimr],
8695 : smlsiz);
8696 :
8697 0 : ndb1 = (nd + 1) / 2;
8698 : i__1 = nd;
8699 0 : for (i__ = ndb1; i__ <= i__1; ++i__) {
8700 0 : i1 = i__ - 1;
8701 0 : ic = iwork[inode + i1];
8702 0 : nl = iwork[ndiml + i1];
8703 0 : nlp1 = nl + 1;
8704 0 : nr = iwork[ndimr + i1];
8705 0 : nlf = ic - nl;
8706 0 : nrf = ic + 1;
8707 0 : idxqi = idxq + nlf - 2;
8708 : vfi = vf + nlf - 1;
8709 0 : vli = vl + nlf - 1;
8710 0 : sqrei = 1;
8711 0 : if (*icompq == 0) {
8712 0 : PLUMED_BLAS_F77_FUNC(dlaset,DLASET)("A", &nlp1, &nlp1, &zero, &one, &work[nwork1], &smlszp);
8713 0 : PLUMED_BLAS_F77_FUNC(dlasdq,DLASDQ)("U", &sqrei, &nl, &nlp1, &nru, &ncc, &d__[nlf], &e[nlf], &
8714 : work[nwork1], &smlszp, &work[nwork2], &nl, &work[nwork2],
8715 0 : &nl, &work[nwork2], info);
8716 0 : itemp = nwork1 + nl * smlszp;
8717 0 : PLUMED_BLAS_F77_FUNC(dcopy,DCOPY)(&nlp1, &work[nwork1], &c__1, &work[vfi], &c__1);
8718 0 : PLUMED_BLAS_F77_FUNC(dcopy,DCOPY)(&nlp1, &work[itemp], &c__1, &work[vli], &c__1);
8719 : } else {
8720 0 : PLUMED_BLAS_F77_FUNC(dlaset,DLASET)("A", &nl, &nl, &zero, &one, &u[nlf + u_dim1], ldu);
8721 0 : PLUMED_BLAS_F77_FUNC(dlaset,DLASET)("A", &nlp1, &nlp1, &zero, &one, &vt[nlf + vt_dim1],
8722 : ldu);
8723 0 : PLUMED_BLAS_F77_FUNC(dlasdq,DLASDQ)("U", &sqrei, &nl, &nlp1, &nl, &ncc, &d__[nlf], &e[nlf], &
8724 : vt[nlf + vt_dim1], ldu, &u[nlf + u_dim1], ldu, &u[nlf +
8725 0 : u_dim1], ldu, &work[nwork1], info);
8726 0 : PLUMED_BLAS_F77_FUNC(dcopy,DCOPY)(&nlp1, &vt[nlf + vt_dim1], &c__1, &work[vfi], &c__1);
8727 0 : PLUMED_BLAS_F77_FUNC(dcopy,DCOPY)(&nlp1, &vt[nlf + nlp1 * vt_dim1], &c__1, &work[vli], &c__1)
8728 : ;
8729 : }
8730 0 : if (*info != 0) {
8731 : return;
8732 : }
8733 0 : i__2 = nl;
8734 0 : for (j = 1; j <= i__2; ++j) {
8735 0 : iwork[idxqi + j] = j;
8736 : }
8737 0 : if (i__ == nd && *sqre == 0) {
8738 0 : sqrei = 0;
8739 : } else {
8740 0 : sqrei = 1;
8741 : }
8742 0 : idxqi += nlp1;
8743 0 : vfi += nlp1;
8744 0 : vli += nlp1;
8745 0 : nrp1 = nr + sqrei;
8746 0 : if (*icompq == 0) {
8747 0 : PLUMED_BLAS_F77_FUNC(dlaset,DLASET)("A", &nrp1, &nrp1, &zero, &one, &work[nwork1], &smlszp);
8748 0 : PLUMED_BLAS_F77_FUNC(dlasdq,DLASDQ)("U", &sqrei, &nr, &nrp1, &nru, &ncc, &d__[nrf], &e[nrf], &
8749 : work[nwork1], &smlszp, &work[nwork2], &nr, &work[nwork2],
8750 0 : &nr, &work[nwork2], info);
8751 0 : itemp = nwork1 + (nrp1 - 1) * smlszp;
8752 0 : PLUMED_BLAS_F77_FUNC(dcopy,DCOPY)(&nrp1, &work[nwork1], &c__1, &work[vfi], &c__1);
8753 0 : PLUMED_BLAS_F77_FUNC(dcopy,DCOPY)(&nrp1, &work[itemp], &c__1, &work[vli], &c__1);
8754 : } else {
8755 0 : PLUMED_BLAS_F77_FUNC(dlaset,DLASET)("A", &nr, &nr, &zero, &one, &u[nrf + u_dim1], ldu);
8756 0 : PLUMED_BLAS_F77_FUNC(dlaset,DLASET)("A", &nrp1, &nrp1, &zero, &one, &vt[nrf + vt_dim1],
8757 : ldu);
8758 0 : PLUMED_BLAS_F77_FUNC(dlasdq,DLASDQ)("U", &sqrei, &nr, &nrp1, &nr, &ncc, &d__[nrf], &e[nrf], &
8759 : vt[nrf + vt_dim1], ldu, &u[nrf + u_dim1], ldu, &u[nrf +
8760 0 : u_dim1], ldu, &work[nwork1], info);
8761 0 : PLUMED_BLAS_F77_FUNC(dcopy,DCOPY)(&nrp1, &vt[nrf + vt_dim1], &c__1, &work[vfi], &c__1);
8762 0 : PLUMED_BLAS_F77_FUNC(dcopy,DCOPY)(&nrp1, &vt[nrf + nrp1 * vt_dim1], &c__1, &work[vli], &c__1)
8763 : ;
8764 : }
8765 0 : if (*info != 0) {
8766 : return;
8767 : }
8768 0 : i__2 = nr;
8769 0 : for (j = 1; j <= i__2; ++j) {
8770 0 : iwork[idxqi + j] = j;
8771 : }
8772 : }
8773 :
8774 0 : j = (1 << nlvl);
8775 :
8776 0 : for (lvl = nlvl; lvl >= 1; --lvl) {
8777 0 : lvl2 = (lvl << 1) - 1;
8778 :
8779 0 : if (lvl == 1) {
8780 : lf = 1;
8781 : ll = 1;
8782 : } else {
8783 0 : lf = (1 << (lvl-1));
8784 0 : ll = (lf << 1) - 1;
8785 : }
8786 : i__1 = ll;
8787 0 : for (i__ = lf; i__ <= i__1; ++i__) {
8788 0 : im1 = i__ - 1;
8789 0 : ic = iwork[inode + im1];
8790 0 : nl = iwork[ndiml + im1];
8791 0 : nr = iwork[ndimr + im1];
8792 0 : nlf = ic - nl;
8793 0 : if (i__ == ll) {
8794 0 : sqrei = *sqre;
8795 : } else {
8796 0 : sqrei = 1;
8797 : }
8798 : vfi = vf + nlf - 1;
8799 0 : vli = vl + nlf - 1;
8800 0 : idxqi = idxq + nlf - 1;
8801 0 : alpha = d__[ic];
8802 0 : beta = e[ic];
8803 0 : if (*icompq == 0) {
8804 0 : PLUMED_BLAS_F77_FUNC(dlasd6,DLASD6)(icompq, &nl, &nr, &sqrei, &d__[nlf], &work[vfi], &
8805 0 : work[vli], &alpha, &beta, &iwork[idxqi], &perm[
8806 : perm_offset], &givptr[1], &givcol[givcol_offset],
8807 : ldgcol, &givnum[givnum_offset], ldu, &poles[
8808 : poles_offset], &difl[difl_offset], &difr[difr_offset],
8809 0 : &z__[z_offset], &k[1], &c__[1], &s[1], &work[nwork1],
8810 0 : &iwork[iwk], info);
8811 : } else {
8812 0 : --j;
8813 0 : PLUMED_BLAS_F77_FUNC(dlasd6,DLASD6)(icompq, &nl, &nr, &sqrei, &d__[nlf], &work[vfi], &
8814 0 : work[vli], &alpha, &beta, &iwork[idxqi], &perm[nlf +
8815 0 : lvl * perm_dim1], &givptr[j], &givcol[nlf + lvl2 *
8816 : givcol_dim1], ldgcol, &givnum[nlf + lvl2 *
8817 : givnum_dim1], ldu, &poles[nlf + lvl2 * poles_dim1], &
8818 0 : difl[nlf + lvl * difl_dim1], &difr[nlf + lvl2 *
8819 0 : difr_dim1], &z__[nlf + lvl * z_dim1], &k[j], &c__[j],
8820 0 : &s[j], &work[nwork1], &iwork[iwk], info);
8821 : }
8822 0 : if (*info != 0) {
8823 : return;
8824 : }
8825 : }
8826 : }
8827 :
8828 : return;
8829 :
8830 : }
8831 :
8832 :
8833 : }
8834 : }
8835 : #include <cctype>
8836 :
8837 : #include "blas/blas.h"
8838 : #include "lapack.h"
8839 :
8840 :
8841 : #include "blas/blas.h"
8842 : namespace PLMD{
8843 : namespace lapack{
8844 : using namespace blas;
8845 : void
8846 155 : PLUMED_BLAS_F77_FUNC(dlasdq,DLASDQ)(const char *uplo,
8847 : int *sqre,
8848 : int *n,
8849 : int *ncvt,
8850 : int *nru,
8851 : int *ncc,
8852 : double *d__,
8853 : double *e,
8854 : double *vt,
8855 : int *ldvt,
8856 : double *u,
8857 : int *ldu,
8858 : double *c__,
8859 : int *ldc,
8860 : double *work,
8861 : int *info)
8862 : {
8863 155 : const char xuplo=std::toupper(*uplo);
8864 : int c_dim1, c_offset, u_dim1, u_offset, vt_dim1, vt_offset, i__1,
8865 : i__2;
8866 155 : int c__1 = 1;
8867 : int itmp1,itmp2;
8868 : int i__, j;
8869 : double r__, cs, sn;
8870 : int np1, isub;
8871 : double smin;
8872 : int sqre1;
8873 : int iuplo;
8874 : int rotate;
8875 :
8876 155 : --d__;
8877 155 : --e;
8878 155 : vt_dim1 = *ldvt;
8879 155 : vt_offset = 1 + vt_dim1;
8880 155 : vt -= vt_offset;
8881 155 : u_dim1 = *ldu;
8882 155 : u_offset = 1 + u_dim1;
8883 155 : u -= u_offset;
8884 155 : c_dim1 = *ldc;
8885 155 : c_offset = 1 + c_dim1;
8886 155 : c__ -= c_offset;
8887 155 : --work;
8888 :
8889 155 : *info = 0;
8890 : iuplo = 0;
8891 155 : if (xuplo == 'U') {
8892 : iuplo = 1;
8893 : }
8894 155 : if (xuplo == 'L') {
8895 : iuplo = 2;
8896 : }
8897 :
8898 155 : itmp1 = (*n > 1) ? *n : 1;
8899 155 : itmp2 = (*nru > 1) ? *nru : 1;
8900 155 : if (iuplo == 0) {
8901 0 : *info = -1;
8902 155 : } else if (*sqre < 0 || *sqre > 1) {
8903 0 : *info = -2;
8904 155 : } else if (*n < 0) {
8905 0 : *info = -3;
8906 155 : } else if (*ncvt < 0) {
8907 0 : *info = -4;
8908 155 : } else if (*nru < 0) {
8909 0 : *info = -5;
8910 155 : } else if (*ncc < 0) {
8911 0 : *info = -6;
8912 155 : } else if ((*ncvt == 0 && *ldvt < 1) || (*ncvt > 0 && *ldvt < itmp1)) {
8913 0 : *info = -10;
8914 155 : } else if (*ldu < itmp2) {
8915 0 : *info = -12;
8916 155 : } else if ((*ncc == 0 && *ldc < 1) || (*ncc > 0 && *ldc < itmp1)) {
8917 0 : *info = -14;
8918 : }
8919 155 : if (*info != 0) {
8920 : return;
8921 : }
8922 155 : if (*n == 0) {
8923 : return;
8924 : }
8925 :
8926 155 : rotate = *ncvt > 0 || *nru > 0 || *ncc > 0;
8927 155 : np1 = *n + 1;
8928 155 : sqre1 = *sqre;
8929 :
8930 155 : if (iuplo == 1 && sqre1 == 1) {
8931 : i__1 = *n - 1;
8932 903 : for (i__ = 1; i__ <= i__1; ++i__) {
8933 844 : PLUMED_BLAS_F77_FUNC(dlartg,DLARTG)(&d__[i__], &e[i__], &cs, &sn, &r__);
8934 844 : d__[i__] = r__;
8935 844 : e[i__] = sn * d__[i__ + 1];
8936 844 : d__[i__ + 1] = cs * d__[i__ + 1];
8937 844 : if (rotate) {
8938 844 : work[i__] = cs;
8939 844 : work[*n + i__] = sn;
8940 : }
8941 : }
8942 59 : PLUMED_BLAS_F77_FUNC(dlartg,DLARTG)(&d__[*n], &e[*n], &cs, &sn, &r__);
8943 59 : d__[*n] = r__;
8944 59 : e[*n] = 0.f;
8945 59 : if (rotate) {
8946 59 : work[*n] = cs;
8947 59 : work[*n + *n] = sn;
8948 : }
8949 : iuplo = 2;
8950 : sqre1 = 0;
8951 :
8952 59 : if (*ncvt > 0) {
8953 59 : PLUMED_BLAS_F77_FUNC(dlasr,DLASR)("L", "V", "F", &np1, ncvt, &work[1], &work[np1], &vt[
8954 : vt_offset], ldvt);
8955 : }
8956 : }
8957 96 : if (iuplo == 2) {
8958 59 : i__1 = *n - 1;
8959 903 : for (i__ = 1; i__ <= i__1; ++i__) {
8960 844 : PLUMED_BLAS_F77_FUNC(dlartg,DLARTG)(&d__[i__], &e[i__], &cs, &sn, &r__);
8961 844 : d__[i__] = r__;
8962 844 : e[i__] = sn * d__[i__ + 1];
8963 844 : d__[i__ + 1] = cs * d__[i__ + 1];
8964 844 : if (rotate) {
8965 844 : work[i__] = cs;
8966 844 : work[*n + i__] = sn;
8967 : }
8968 : }
8969 :
8970 59 : if (sqre1 == 1) {
8971 0 : PLUMED_BLAS_F77_FUNC(dlartg,DLARTG)(&d__[*n], &e[*n], &cs, &sn, &r__);
8972 0 : d__[*n] = r__;
8973 0 : if (rotate) {
8974 0 : work[*n] = cs;
8975 0 : work[*n + *n] = sn;
8976 : }
8977 : }
8978 59 : if (*nru > 0) {
8979 59 : if (sqre1 == 0) {
8980 59 : PLUMED_BLAS_F77_FUNC(dlasr,DLASR)("R", "V", "F", nru, n, &work[1], &work[np1], &u[
8981 : u_offset], ldu);
8982 : } else {
8983 0 : PLUMED_BLAS_F77_FUNC(dlasr,DLASR)("R", "V", "F", nru, &np1, &work[1], &work[np1], &u[
8984 : u_offset], ldu);
8985 : }
8986 : }
8987 59 : if (*ncc > 0) {
8988 0 : if (sqre1 == 0) {
8989 0 : PLUMED_BLAS_F77_FUNC(dlasr,DLASR)("L", "V", "F", n, ncc, &work[1], &work[np1], &c__[
8990 : c_offset], ldc);
8991 : } else {
8992 0 : PLUMED_BLAS_F77_FUNC(dlasr,DLASR)("L", "V", "F", &np1, ncc, &work[1], &work[np1], &c__[
8993 : c_offset], ldc);
8994 : }
8995 : }
8996 : }
8997 :
8998 155 : PLUMED_BLAS_F77_FUNC(dbdsqr,DBDSQR)("U", n, ncvt, nru, ncc, &d__[1], &e[1], &vt[vt_offset], ldvt, &u[
8999 : u_offset], ldu, &c__[c_offset], ldc, &work[1], info);
9000 :
9001 155 : i__1 = *n;
9002 2635 : for (i__ = 1; i__ <= i__1; ++i__) {
9003 :
9004 : isub = i__;
9005 2480 : smin = d__[i__];
9006 2480 : i__2 = *n;
9007 22277 : for (j = i__ + 1; j <= i__2; ++j) {
9008 19797 : if (d__[j] < smin) {
9009 : isub = j;
9010 : smin = d__[j];
9011 : }
9012 : }
9013 2480 : if (isub != i__) {
9014 1181 : d__[isub] = d__[i__];
9015 1181 : d__[i__] = smin;
9016 1181 : if (*ncvt > 0) {
9017 1181 : PLUMED_BLAS_F77_FUNC(dswap,DSWAP)(ncvt, &vt[isub + vt_dim1], ldvt, &vt[i__ + vt_dim1],
9018 : ldvt);
9019 : }
9020 1181 : if (*nru > 0) {
9021 1181 : PLUMED_BLAS_F77_FUNC(dswap,DSWAP)(nru, &u[isub * u_dim1 + 1], &c__1, &u[i__ * u_dim1 + 1]
9022 : , &c__1);
9023 : }
9024 1181 : if (*ncc > 0) {
9025 0 : PLUMED_BLAS_F77_FUNC(dswap,DSWAP)(ncc, &c__[isub + c_dim1], ldc, &c__[i__ + c_dim1], ldc)
9026 : ;
9027 : }
9028 : }
9029 : }
9030 :
9031 : return;
9032 : }
9033 :
9034 :
9035 : }
9036 : }
9037 : #include <cmath>
9038 : #include "lapack.h"
9039 :
9040 : #include "blas/blas.h"
9041 : namespace PLMD{
9042 : namespace lapack{
9043 : using namespace blas;
9044 : void
9045 29 : PLUMED_BLAS_F77_FUNC(dlasdt,DLASDT)(int *n,
9046 : int *lvl,
9047 : int *nd,
9048 : int *inode,
9049 : int *ndiml,
9050 : int *ndimr,
9051 : int *msub)
9052 : {
9053 29 : int maxn = (*n > 1) ? *n : 1;
9054 : double temp;
9055 : int i,il,ir,llst,nlvl,ncrnt;
9056 :
9057 29 : temp = std::log( ((double) maxn) / ((double)(*msub+1))) / std::log(2.0);
9058 :
9059 29 : *lvl = 1 + (int) temp;
9060 :
9061 29 : i = *n / 2;
9062 29 : inode[0] = i + 1;
9063 29 : ndiml[0] = i;
9064 29 : ndimr[0] = *n - i - 1;
9065 : il = -1;
9066 : ir = 0;
9067 : llst = 1;
9068 :
9069 33 : for(nlvl=1;nlvl<*lvl;nlvl++) {
9070 19 : for(i=0;i<llst;i++) {
9071 15 : il += 2;
9072 15 : ir += 2;
9073 15 : ncrnt = llst + i - 1;
9074 15 : ndiml[il] = ndiml[ncrnt] / 2;
9075 15 : ndimr[il] = ndiml[ncrnt] - ndiml[il] - 1;
9076 15 : inode[il] = inode[ncrnt] - ndimr[il] - 1;
9077 15 : ndiml[ir] = ndimr[ncrnt] / 2;
9078 15 : ndimr[ir] = ndimr[ncrnt] - ndiml[ir] - 1;
9079 15 : inode[ir] = inode[ncrnt] + ndiml[ir] + 1;
9080 : }
9081 4 : llst *= 2;
9082 : }
9083 29 : *nd = llst*2 - 1;
9084 29 : return;
9085 : }
9086 : }
9087 : }
9088 : #include <cctype>
9089 : #include "lapack.h"
9090 :
9091 :
9092 : #include "blas/blas.h"
9093 : namespace PLMD{
9094 : namespace lapack{
9095 : using namespace blas;
9096 : void
9097 570476 : PLUMED_BLAS_F77_FUNC(dlaset,DLASET)(const char *uplo,
9098 : int *m,
9099 : int *n,
9100 : double *alpha,
9101 : double *beta,
9102 : double *a,
9103 : int *lda)
9104 : {
9105 : int i,j,k;
9106 570476 : const char ch=std::toupper(*uplo);
9107 :
9108 570476 : if(ch=='U') {
9109 0 : for(j=1;j<*n;j++) {
9110 0 : k = (j < *m) ? j : *m;
9111 0 : for(i=0;i<k;i++)
9112 0 : a[j*(*lda)+i] = *alpha;
9113 : }
9114 570476 : } else if(ch=='L') {
9115 1 : k = (*m < *n) ? *m : *n;
9116 2 : for(j=0;j<k;j++) {
9117 1 : for(i=j+1;i<*m;i++)
9118 0 : a[j*(*lda)+i] = *alpha;
9119 : }
9120 : } else {
9121 1185835 : for(j=0;j<*n;j++) {
9122 4343218 : for(i=0;i<*m;i++)
9123 3727858 : a[j*(*lda)+i] = *alpha;
9124 : }
9125 : }
9126 :
9127 570476 : k = (*m < *n) ? *m : *n;
9128 1185837 : for(i=0;i<k;i++)
9129 615361 : a[i*(*lda)+i] = *beta;
9130 570476 : }
9131 : }
9132 : }
9133 : #include <cmath>
9134 : #include "blas/blas.h"
9135 : #include "lapack.h"
9136 : #include "lapack_limits.h"
9137 :
9138 : #include "real.h"
9139 :
9140 : #include "blas/blas.h"
9141 : namespace PLMD{
9142 : namespace lapack{
9143 : using namespace blas;
9144 : void
9145 0 : PLUMED_BLAS_F77_FUNC(dlasq1,DLASQ1)(int *n,
9146 : double *d,
9147 : double *e,
9148 : double *work,
9149 : int *info)
9150 : {
9151 0 : double sigmx = 0.0;
9152 : int i,j,k,iinfo;
9153 : double minval,safemin;
9154 : double dtemp,scale;
9155 : double eps;
9156 :
9157 : eps = PLUMED_GMX_DOUBLE_EPS;
9158 : minval = PLUMED_GMX_DOUBLE_MIN;
9159 : safemin = minval*(1.0+PLUMED_GMX_DOUBLE_EPS);
9160 0 : *info = 0;
9161 :
9162 0 : if(*n<0) {
9163 0 : *info = -2;
9164 0 : return;
9165 : }
9166 :
9167 0 : for(i=0;i<*n-1;i++) {
9168 0 : d[i] = std::abs(d[i]);
9169 0 : dtemp = std::abs(e[i]);
9170 0 : if(dtemp>sigmx)
9171 0 : sigmx=dtemp;
9172 : }
9173 0 : d[*n-1] = std::abs(d[*n-1]);
9174 :
9175 0 : if(std::abs(sigmx)<PLUMED_GMX_DOUBLE_MIN) {
9176 0 : PLUMED_BLAS_F77_FUNC(dlasrt,DLASRT)("D",n,d,&iinfo);
9177 0 : return;
9178 : }
9179 :
9180 0 : for(i=0;i<*n;i++) {
9181 0 : if(d[i]>sigmx)
9182 0 : sigmx=d[i];
9183 : }
9184 :
9185 : /* Copy d and e into work (z format) and scale.
9186 : * Squaring input data makes scaling by a power of the
9187 : * radix pointless.
9188 : */
9189 0 : scale = std::sqrt(eps/safemin);
9190 0 : i = 1;
9191 0 : j = 2;
9192 0 : PLUMED_BLAS_F77_FUNC(dcopy,DCOPY)(n,d,&i,work,&j);
9193 0 : k = *n-1;
9194 0 : PLUMED_BLAS_F77_FUNC(dcopy,DCOPY)(&k,e,&i,work+1,&j);
9195 0 : i = 0;
9196 0 : j = 2*(*n)-1;
9197 0 : k = 1;
9198 0 : PLUMED_BLAS_F77_FUNC(dlascl,DLASCL)("G",&i,&i,&sigmx,&scale,&j,&k,work,&j,&iinfo);
9199 :
9200 :
9201 : /* Compute q and e elements */
9202 0 : for(i=0;i<2*(*n)-1;i++)
9203 0 : work[i] = work[i]*work[i];
9204 :
9205 0 : work[2*(*n)-1] = 0.0;
9206 :
9207 0 : PLUMED_BLAS_F77_FUNC(dlasq2,DLASQ2)(n,work,info);
9208 :
9209 0 : j = 0;
9210 0 : k = 1;
9211 0 : if(*info==0) {
9212 0 : for(i=0;i<*n;i++)
9213 0 : d[i]= std::sqrt(work[i]);
9214 0 : PLUMED_BLAS_F77_FUNC(dlascl,DLASCL)("G",&j,&j,&scale,&sigmx,n,&k,d,n,&iinfo);
9215 : }
9216 : return;
9217 : }
9218 : }
9219 : }
9220 : #include <cmath>
9221 : #include "lapack.h"
9222 : #include "lapack_limits.h"
9223 :
9224 : #include "real.h"
9225 :
9226 : #ifdef _MSC_VER
9227 : #pragma warning(disable: 4723) /*division by zero - is used on purpose here*/
9228 : #endif
9229 :
9230 : #include "blas/blas.h"
9231 : namespace PLMD{
9232 : namespace lapack{
9233 : using namespace blas;
9234 : void
9235 570010 : PLUMED_BLAS_F77_FUNC(dlasq2,DLASQ2)(int *n,
9236 : double *z__,
9237 : int *info)
9238 : {
9239 : int i__1, i__2, i__3;
9240 : double d__1, d__2;
9241 :
9242 : double d__, e;
9243 : int k;
9244 : double s, t;
9245 : int i0, i4, n0, pp;
9246 : double dee, eps, tol;
9247 : int ipn4;
9248 : double tol2;
9249 : int ieee;
9250 : int nbig;
9251 : double dmin__, emin, emax;
9252 : int kmin, ndiv, iter;
9253 : double qmin, temp, qmax, zmax;
9254 : int splt, nfail;
9255 : double desig, trace, sigma;
9256 : int iinfo;
9257 : double deemin;
9258 : int iwhila, iwhilb;
9259 : double oldemn, safmin, minval;
9260 : double posinf,neginf,negzro,newzro;
9261 : double zero = 0.0;
9262 : double one = 1.0;
9263 :
9264 570010 : --z__;
9265 :
9266 570010 : *info = 0;
9267 : eps = PLUMED_GMX_DOUBLE_EPS;
9268 : minval = PLUMED_GMX_DOUBLE_MIN;
9269 : safmin = minval*(1.0+eps);
9270 :
9271 : tol = eps * 100.;
9272 :
9273 : d__1 = tol;
9274 : tol2 = d__1 * d__1;
9275 :
9276 570010 : if (*n < 0) {
9277 0 : *info = -1;
9278 0 : return;
9279 570010 : } else if (*n == 0) {
9280 : return;
9281 570010 : } else if (*n == 1) {
9282 :
9283 0 : if (z__[1] < 0.) {
9284 0 : *info = -201;
9285 : }
9286 0 : return;
9287 570010 : } else if (*n == 2) {
9288 :
9289 13363 : if (z__[2] < 0. || z__[3] < 0.) {
9290 0 : *info = -2;
9291 0 : return;
9292 13363 : } else if (z__[3] > z__[1]) {
9293 : d__ = z__[3];
9294 0 : z__[3] = z__[1];
9295 0 : z__[1] = d__;
9296 : }
9297 13363 : z__[5] = z__[1] + z__[2] + z__[3];
9298 13363 : if (z__[2] > z__[3] * tol2) {
9299 13363 : t = (z__[1] - z__[3] + z__[2]) * .5;
9300 13363 : s = z__[3] * (z__[2] / t);
9301 13363 : if (s <= t) {
9302 13363 : s = z__[3] * (z__[2] / (t * ( std::sqrt(s / t + 1.) + 1.)));
9303 : } else {
9304 0 : s = z__[3] * (z__[2] / (t + std::sqrt(t) * std::sqrt(t + s)));
9305 : }
9306 13363 : t = z__[1] + (s + z__[2]);
9307 13363 : z__[3] *= z__[1] / t;
9308 13363 : z__[1] = t;
9309 : }
9310 13363 : z__[2] = z__[3];
9311 13363 : z__[6] = z__[2] + z__[1];
9312 13363 : return;
9313 : }
9314 556647 : z__[*n * 2] = 0.;
9315 556647 : emin = z__[2];
9316 556647 : qmax = 0.;
9317 : zmax = 0.;
9318 : d__ = 0.;
9319 : e = 0.;
9320 :
9321 556647 : i__1 = 2*(*n - 1);
9322 2227030 : for (k = 1; k <= i__1; k += 2) {
9323 1670383 : if (z__[k] < 0.) {
9324 0 : *info = -(k + 200);
9325 0 : return;
9326 1670383 : } else if (z__[k + 1] < 0.) {
9327 0 : *info = -(k + 201);
9328 0 : return;
9329 : }
9330 1670383 : d__ += z__[k];
9331 1670383 : e += z__[k + 1];
9332 1670383 : d__1 = qmax, d__2 = z__[k];
9333 1670383 : qmax = (d__1>d__2) ? d__1 : d__2;
9334 : d__1 = emin, d__2 = z__[k + 1];
9335 1670383 : emin = (d__1<d__2) ? d__1 : d__2;
9336 1670383 : d__1 = (qmax>zmax) ? qmax : zmax;
9337 : d__2 = z__[k + 1];
9338 1670383 : zmax = (d__1>d__2) ? d__1 : d__2;
9339 : }
9340 556647 : if (z__[(*n << 1) - 1] < 0.) {
9341 0 : *info = -((*n << 1) + 199);
9342 0 : return;
9343 : }
9344 556647 : d__ += z__[(*n << 1) - 1];
9345 556647 : d__1 = qmax, d__2 = z__[(*n << 1) - 1];
9346 556658 : qmax = (d__1>d__2) ? d__1 : d__2;
9347 :
9348 556647 : if (std::abs(e)<PLUMED_GMX_DOUBLE_MIN) {
9349 : i__1 = *n;
9350 0 : for (k = 2; k <= i__1; ++k) {
9351 0 : z__[k] = z__[(k << 1) - 1];
9352 : }
9353 0 : PLUMED_BLAS_F77_FUNC(dlasrt,DLASRT)("D", n, &z__[1], &iinfo);
9354 0 : z__[(*n << 1) - 1] = d__;
9355 0 : return;
9356 : }
9357 :
9358 556647 : trace = d__ + e;
9359 :
9360 556647 : if (std::abs(trace)<PLUMED_GMX_DOUBLE_MIN) {
9361 0 : z__[(*n << 1) - 1] = 0.;
9362 0 : return;
9363 : }
9364 :
9365 556647 : ieee = 1;
9366 556647 : posinf = one/zero;
9367 556647 : if(posinf<=1.0)
9368 0 : ieee = 0;
9369 : neginf = -one/zero;
9370 556647 : if(neginf>=0.0)
9371 0 : ieee = 0;
9372 556647 : negzro = one/(neginf+one);
9373 556647 : if(std::abs(negzro)>PLUMED_GMX_DOUBLE_MIN)
9374 0 : ieee = 0;
9375 556647 : neginf = one/negzro;
9376 556647 : if(neginf>=0)
9377 0 : ieee = 0;
9378 556647 : newzro = negzro + zero;
9379 556647 : if(std::abs(newzro-zero)>PLUMED_GMX_DOUBLE_MIN)
9380 0 : ieee = 0;
9381 556647 : posinf = one /newzro;
9382 556647 : if(posinf<=one)
9383 0 : ieee = 0;
9384 556647 : neginf = neginf*posinf;
9385 556647 : if(neginf>=zero)
9386 0 : ieee = 0;
9387 556647 : posinf = posinf*posinf;
9388 556647 : if(posinf<=1.0)
9389 0 : ieee = 0;
9390 :
9391 2783677 : for (k = *n << 1; k >= 2; k += -2) {
9392 2227030 : z__[k * 2] = 0.;
9393 2227030 : z__[(k << 1) - 1] = z__[k];
9394 2227030 : z__[(k << 1) - 2] = 0.;
9395 2227030 : z__[(k << 1) - 3] = z__[k - 1];
9396 : }
9397 :
9398 556647 : i0 = 1;
9399 556647 : n0 = *n;
9400 :
9401 556647 : if (z__[(i0 << 2) - 3] * 1.5 < z__[(n0 << 2) - 3]) {
9402 121 : ipn4 = 4*(i0 + n0);
9403 121 : i__1 = 2*(i0 + n0 - 1);
9404 362 : for (i4 = i0 << 2; i4 <= i__1; i4 += 4) {
9405 241 : temp = z__[i4 - 3];
9406 241 : z__[i4 - 3] = z__[ipn4 - i4 - 3];
9407 241 : z__[ipn4 - i4 - 3] = temp;
9408 241 : temp = z__[i4 - 1];
9409 241 : z__[i4 - 1] = z__[ipn4 - i4 - 5];
9410 241 : z__[ipn4 - i4 - 5] = temp;
9411 : }
9412 : }
9413 :
9414 556647 : pp = 0;
9415 :
9416 1669941 : for (k = 1; k <= 2; ++k) {
9417 :
9418 1113294 : d__ = z__[(n0 << 2) + pp - 3];
9419 1113294 : i__1 = (i0 << 2) + pp;
9420 4454060 : for (i4 = 4*(n0 - 1) + pp; i4 >= i__1; i4 += -4) {
9421 3340766 : if (z__[i4 - 1] <= tol2 * d__) {
9422 4 : z__[i4 - 1] = -0.;
9423 4 : d__ = z__[i4 - 3];
9424 : } else {
9425 3340762 : d__ = z__[i4 - 3] * (d__ / (d__ + z__[i4 - 1]));
9426 : }
9427 : }
9428 :
9429 1113294 : emin = z__[(i0 << 2) + pp + 1];
9430 1113294 : d__ = z__[(i0 << 2) + pp - 3];
9431 : i__1 = 4*(n0 - 1) + pp;
9432 4454060 : for (i4 = (i0 << 2) + pp; i4 <= i__1; i4 += 4) {
9433 3340766 : z__[i4 - (pp << 1) - 2] = d__ + z__[i4 - 1];
9434 3340766 : if (z__[i4 - 1] <= tol2 * d__) {
9435 23 : z__[i4 - 1] = -0.;
9436 23 : z__[i4 - (pp << 1) - 2] = d__;
9437 23 : z__[i4 - (pp << 1)] = 0.;
9438 23 : d__ = z__[i4 + 1];
9439 3340743 : } else if (safmin * z__[i4 + 1] < z__[i4 - (pp << 1) - 2] &&
9440 3340743 : safmin * z__[i4 - (pp << 1) - 2] < z__[i4 + 1]) {
9441 3340739 : temp = z__[i4 + 1] / z__[i4 - (pp << 1) - 2];
9442 3340739 : z__[i4 - (pp << 1)] = z__[i4 - 1] * temp;
9443 3340739 : d__ *= temp;
9444 : } else {
9445 4 : z__[i4 - (pp << 1)] = z__[i4 + 1] * (z__[i4 - 1] / z__[i4 - (
9446 : pp << 1) - 2]);
9447 4 : d__ = z__[i4 + 1] * (d__ / z__[i4 - (pp << 1) - 2]);
9448 : }
9449 3340766 : d__1 = emin, d__2 = z__[i4 - (pp << 1)];
9450 3340766 : emin = (d__1<d__2) ? d__1 : d__2;
9451 : }
9452 1113294 : z__[(n0 << 2) - pp - 2] = d__;
9453 :
9454 :
9455 1113294 : qmax = z__[(i0 << 2) - pp - 2];
9456 1113294 : i__1 = (n0 << 2) - pp - 2;
9457 4454060 : for (i4 = (i0 << 2) - pp + 2; i4 <= i__1; i4 += 4) {
9458 3340766 : d__1 = qmax, d__2 = z__[i4];
9459 4475339 : qmax = (d__1>d__2) ? d__1 : d__2;
9460 : }
9461 :
9462 1113294 : pp = 1 - pp;
9463 : }
9464 :
9465 556647 : iter = 2;
9466 556647 : nfail = 0;
9467 556647 : ndiv = 2*(n0 - i0);
9468 :
9469 556647 : i__1 = *n + 1;
9470 1113431 : for (iwhila = 1; iwhila <= i__1; ++iwhila) {
9471 1113431 : if (n0 < 1) {
9472 556647 : goto L170;
9473 : }
9474 :
9475 556784 : desig = 0.;
9476 556784 : if (n0 == *n) {
9477 556647 : sigma = 0.;
9478 : } else {
9479 137 : sigma = -z__[(n0 << 2) - 1];
9480 : }
9481 556784 : if (sigma < 0.) {
9482 0 : *info = 1;
9483 0 : return;
9484 : }
9485 :
9486 : emax = 0.;
9487 556784 : if (n0 > i0) {
9488 556647 : emin = std::abs(z__[(n0 << 2) - 5]);
9489 : } else {
9490 : emin = 0.;
9491 : }
9492 556784 : qmin = z__[(n0 << 2) - 3];
9493 556784 : qmax = qmin;
9494 2232245 : for (i4 = n0 << 2; i4 >= 8; i4 += -4) {
9495 1675574 : if (z__[i4 - 5] <= 0.) {
9496 113 : goto L100;
9497 : }
9498 1675461 : if (qmin >= emax * 4.) {
9499 1116325 : d__1 = qmin, d__2 = z__[i4 - 3];
9500 1116325 : qmin = (d__1<d__2) ? d__1 : d__2;
9501 : d__1 = emax, d__2 = z__[i4 - 5];
9502 1116325 : emax = (d__1>d__2) ? d__1 : d__2;
9503 : }
9504 1675461 : d__1 = qmax, d__2 = z__[i4 - 7] + z__[i4 - 5];
9505 1675461 : qmax = (d__1>d__2) ? d__1 : d__2;
9506 : d__1 = emin, d__2 = z__[i4 - 5];
9507 1675461 : emin = (d__1<d__2) ? d__1 : d__2;
9508 : }
9509 : i4 = 4;
9510 :
9511 556784 : L100:
9512 556784 : i0 = i4 / 4;
9513 556784 : pp = 0;
9514 :
9515 556784 : if (n0 - i0 > 1) {
9516 556742 : dee = z__[(i0 << 2) - 3];
9517 : deemin = dee;
9518 : kmin = i0;
9519 556742 : i__2 = (n0 << 2) - 3;
9520 2788941 : for (i4 = (i0 << 2) - 3; i4 <= i__2; i4 += 4) {
9521 2232199 : dee = z__[i4] * (dee / (dee + z__[i4 - 2]));
9522 2232199 : if (dee <= deemin) {
9523 : deemin = dee;
9524 1206047 : kmin = (i4 + 3) / 4;
9525 : }
9526 : }
9527 556742 : if (2*(kmin - i0) < n0 - kmin && deemin <= z__[(n0 << 2) - 3] *
9528 : .5) {
9529 7987 : ipn4 = 4*(i0 + n0);
9530 7987 : pp = 2;
9531 7987 : i__2 = 2*(i0 + n0 - 1);
9532 25756 : for (i4 = i0 << 2; i4 <= i__2; i4 += 4) {
9533 17769 : temp = z__[i4 - 3];
9534 17769 : z__[i4 - 3] = z__[ipn4 - i4 - 3];
9535 17769 : z__[ipn4 - i4 - 3] = temp;
9536 17769 : temp = z__[i4 - 2];
9537 17769 : z__[i4 - 2] = z__[ipn4 - i4 - 2];
9538 17769 : z__[ipn4 - i4 - 2] = temp;
9539 17769 : temp = z__[i4 - 1];
9540 17769 : z__[i4 - 1] = z__[ipn4 - i4 - 5];
9541 17769 : z__[ipn4 - i4 - 5] = temp;
9542 17769 : temp = z__[i4];
9543 17769 : z__[i4] = z__[ipn4 - i4 - 4];
9544 17769 : z__[ipn4 - i4 - 4] = temp;
9545 : }
9546 : }
9547 : }
9548 :
9549 :
9550 556784 : d__1 = 0., d__2 = qmin - std::sqrt(qmin) * 2. * std::sqrt(emax);
9551 556784 : dmin__ = -((d__1>d__2) ? d__1 : d__2);
9552 :
9553 556784 : nbig = (n0 - i0 + 1) * 30;
9554 : i__2 = nbig;
9555 13682186 : for (iwhilb = 1; iwhilb <= i__2; ++iwhilb) {
9556 13682186 : if (i0 > n0) {
9557 556784 : goto L150;
9558 : }
9559 :
9560 13125402 : PLUMED_BLAS_F77_FUNC(dlasq3,DLASQ3)(&i0, &n0, &z__[1], &pp, &dmin__, &sigma, &desig, &qmax, &
9561 : nfail, &iter, &ndiv, &ieee);
9562 :
9563 13125402 : pp = 1 - pp;
9564 :
9565 13125402 : if (pp == 0 && n0 - i0 >= 3) {
9566 162442 : if (z__[n0 * 4] <= tol2 * qmax || z__[(n0 << 2) - 1] <= tol2 *
9567 : sigma) {
9568 295 : splt = i0 - 1;
9569 295 : qmax = z__[(i0 << 2) - 3];
9570 295 : emin = z__[(i0 << 2) - 1];
9571 295 : oldemn = z__[i0 * 4];
9572 295 : i__3 = 4*(n0 - 3);
9573 41884 : for (i4 = i0 << 2; i4 <= i__3; i4 += 4) {
9574 41589 : if (z__[i4] <= tol2 * z__[i4 - 3] || z__[i4 - 1] <=
9575 41562 : tol2 * sigma) {
9576 114 : z__[i4 - 1] = -sigma;
9577 114 : splt = i4 / 4;
9578 114 : qmax = 0.;
9579 114 : emin = z__[i4 + 3];
9580 114 : oldemn = z__[i4 + 4];
9581 : } else {
9582 41475 : d__1 = qmax, d__2 = z__[i4 + 1];
9583 41475 : qmax = (d__1>d__2) ? d__1 : d__2;
9584 : d__1 = emin, d__2 = z__[i4 - 1];
9585 41475 : emin = (d__1<d__2) ? d__1 : d__2;
9586 : d__1 = oldemn, d__2 = z__[i4];
9587 41475 : oldemn = (d__1<d__2) ? d__1 : d__2;
9588 : }
9589 : }
9590 295 : z__[(n0 << 2) - 1] = emin;
9591 295 : z__[n0 * 4] = oldemn;
9592 295 : i0 = splt + 1;
9593 : }
9594 : }
9595 : }
9596 :
9597 0 : *info = 2;
9598 0 : return;
9599 :
9600 : L150:
9601 : ;
9602 : }
9603 :
9604 0 : *info = 3;
9605 0 : return;
9606 :
9607 :
9608 : L170:
9609 :
9610 556647 : i__1 = *n;
9611 2227030 : for (k = 2; k <= i__1; ++k) {
9612 1670383 : z__[k] = z__[(k << 2) - 3];
9613 : }
9614 :
9615 556647 : PLUMED_BLAS_F77_FUNC(dlasrt,DLASRT)("D", n, &z__[1], &iinfo);
9616 :
9617 : e = 0.;
9618 2783677 : for (k = *n; k >= 1; --k) {
9619 2227030 : e += z__[k];
9620 : }
9621 :
9622 :
9623 556647 : z__[(*n << 1) + 1] = trace;
9624 556647 : z__[(*n << 1) + 2] = e;
9625 556647 : z__[(*n << 1) + 3] = (double) iter;
9626 556647 : i__1 = *n;
9627 556647 : z__[(*n << 1) + 4] = (double) ndiv / (double) (i__1 * i__1);
9628 556647 : z__[(*n << 1) + 5] = nfail * 100. / (double) iter;
9629 :
9630 556647 : return;
9631 :
9632 : }
9633 :
9634 :
9635 :
9636 : }
9637 : }
9638 : #include <cmath>
9639 : #include "real.h"
9640 :
9641 : #include "lapack.h"
9642 : #include "lapack_limits.h"
9643 :
9644 : #include "blas/blas.h"
9645 : namespace PLMD{
9646 : namespace lapack{
9647 : using namespace blas;
9648 : void
9649 13125402 : PLUMED_BLAS_F77_FUNC(dlasq3,DLASQ3)(int *i0,
9650 : int *n0,
9651 : double *z__,
9652 : int *pp,
9653 : double *dmin__,
9654 : double *sigma,
9655 : double *desig,
9656 : double *qmax,
9657 : int *nfail,
9658 : int *iter,
9659 : int *ndiv,
9660 : int *ieee)
9661 : {
9662 :
9663 13125402 : int ttype = 0;
9664 13125402 : double dmin1 = 0.;
9665 13125402 : double dmin2 = 0.;
9666 13125402 : double dn = 0.;
9667 13125402 : double dn1 = 0.;
9668 13125402 : double dn2 = 0.;
9669 13125402 : double tau = 0.;
9670 :
9671 : int i__1;
9672 : double d__1, d__2;
9673 : double s, t;
9674 : int j4, nn;
9675 : double eps, tol;
9676 : int n0in, ipn4;
9677 : double tol2, temp;
9678 13125402 : --z__;
9679 :
9680 13125402 : n0in = *n0;
9681 : eps = PLUMED_GMX_DOUBLE_EPS;
9682 : tol = eps * 100.;
9683 : d__1 = tol;
9684 : tol2 = d__1 * d__1;
9685 :
9686 :
9687 1670169 : L10:
9688 :
9689 14795571 : if (*n0 < *i0) {
9690 : return;
9691 : }
9692 14238787 : if (*n0 == *i0) {
9693 82 : goto L20;
9694 : }
9695 14238705 : nn = (*n0 << 2) + *pp;
9696 14238705 : if (*n0 == *i0 + 1) {
9697 556702 : goto L40;
9698 : }
9699 :
9700 13682003 : if (z__[nn - 5] > tol2 * (*sigma + z__[nn - 3]) && z__[nn - (*pp << 1) -
9701 12568777 : 4] > tol2 * z__[nn - 7]) {
9702 12568777 : goto L30;
9703 : }
9704 :
9705 1113226 : L20:
9706 :
9707 1113308 : z__[(*n0 << 2) - 3] = z__[(*n0 << 2) + *pp - 3] + *sigma;
9708 1113308 : --(*n0);
9709 1113308 : goto L10;
9710 :
9711 : L30:
9712 :
9713 12568777 : if (z__[nn - 9] > tol2 * *sigma && z__[nn - (*pp << 1) - 8] > tol2 * z__[
9714 12568618 : nn - 11]) {
9715 12568618 : goto L50;
9716 : }
9717 :
9718 159 : L40:
9719 :
9720 556861 : if (z__[nn - 3] > z__[nn - 7]) {
9721 : s = z__[nn - 3];
9722 21586 : z__[nn - 3] = z__[nn - 7];
9723 21586 : z__[nn - 7] = s;
9724 : }
9725 556861 : if (z__[nn - 5] > z__[nn - 3] * tol2) {
9726 556861 : t = (z__[nn - 7] - z__[nn - 3] + z__[nn - 5]) * .5;
9727 556861 : s = z__[nn - 3] * (z__[nn - 5] / t);
9728 556861 : if (s <= t) {
9729 539400 : s = z__[nn - 3] * (z__[nn - 5] / (t * ( std::sqrt(s / t + 1.) + 1.)));
9730 : } else {
9731 17461 : s = z__[nn - 3] * (z__[nn - 5] / (t + std::sqrt(t) * std::sqrt(t + s)));
9732 : }
9733 556861 : t = z__[nn - 7] + (s + z__[nn - 5]);
9734 556861 : z__[nn - 3] *= z__[nn - 7] / t;
9735 556861 : z__[nn - 7] = t;
9736 : }
9737 556861 : z__[(*n0 << 2) - 7] = z__[nn - 7] + *sigma;
9738 556861 : z__[(*n0 << 2) - 3] = z__[nn - 3] + *sigma;
9739 556861 : *n0 += -2;
9740 556861 : goto L10;
9741 :
9742 : L50:
9743 12568618 : if (*pp == 2) {
9744 7987 : *pp = 0;
9745 : }
9746 :
9747 12568618 : if (*dmin__ <= 0. || *n0 < n0in) {
9748 1113374 : if (z__[(*i0 << 2) + *pp - 3] * 1.5 < z__[(*n0 << 2) + *pp - 3]) {
9749 299487 : ipn4 = 4*(*i0 + *n0);
9750 299487 : i__1 = 2*(*i0 + *n0 - 1);
9751 608758 : for (j4 = *i0 << 2; j4 <= i__1; j4 += 4) {
9752 309271 : temp = z__[j4 - 3];
9753 309271 : z__[j4 - 3] = z__[ipn4 - j4 - 3];
9754 309271 : z__[ipn4 - j4 - 3] = temp;
9755 309271 : temp = z__[j4 - 2];
9756 309271 : z__[j4 - 2] = z__[ipn4 - j4 - 2];
9757 309271 : z__[ipn4 - j4 - 2] = temp;
9758 309271 : temp = z__[j4 - 1];
9759 309271 : z__[j4 - 1] = z__[ipn4 - j4 - 5];
9760 309271 : z__[ipn4 - j4 - 5] = temp;
9761 309271 : temp = z__[j4];
9762 309271 : z__[j4] = z__[ipn4 - j4 - 4];
9763 309271 : z__[ipn4 - j4 - 4] = temp;
9764 : }
9765 299487 : if (*n0 - *i0 <= 4) {
9766 299438 : z__[(*n0 << 2) + *pp - 1] = z__[(*i0 << 2) + *pp - 1];
9767 299438 : z__[(*n0 << 2) - *pp] = z__[(*i0 << 2) - *pp];
9768 : }
9769 299487 : d__1 = dmin2, d__2 = z__[(*n0 << 2) + *pp - 1];
9770 299487 : dmin2 = ((d__1<d__2) ? d__1 : d__2);
9771 299487 : d__1 = z__[(*n0 << 2) + *pp - 1], d__2 = z__[(*i0 << 2) + *pp - 1]
9772 299487 : , d__1 = ((d__1<d__2) ? d__1 : d__2), d__2 = z__[(*i0 << 2) + *pp + 3];
9773 299487 : z__[(*n0 << 2) + *pp - 1] = ((d__1<d__2) ? d__1 : d__2);
9774 299487 : d__1 = z__[(*n0 << 2) - *pp], d__2 = z__[(*i0 << 2) - *pp], d__1 =
9775 299487 : ((d__1<d__2) ? d__1 : d__2), d__2 = z__[(*i0 << 2) - *pp + 4];
9776 299487 : z__[(*n0 << 2) - *pp] = ((d__1<d__2) ? d__1 : d__2);
9777 299487 : d__1 = *qmax;
9778 299487 : d__2 = z__[(*i0 << 2) + *pp - 3];
9779 299487 : d__1 = (d__1>d__2) ? d__1 : d__2;
9780 299487 : d__2 = z__[(*i0 << 2) + *pp + 1];
9781 299487 : *qmax = ((d__1>d__2) ? d__1 : d__2);
9782 299487 : *dmin__ = -0.;
9783 : }
9784 : }
9785 :
9786 :
9787 12568618 : PLUMED_BLAS_F77_FUNC(dlasq4,DLASQ4)(i0, n0, &z__[1], pp, &n0in, dmin__, &dmin1, &dmin2, &dn, &dn1, &
9788 : dn2, &tau, &ttype);
9789 :
9790 12568622 : L70:
9791 :
9792 12568622 : PLUMED_BLAS_F77_FUNC(dlasq5,DLASQ5)(i0, n0, &z__[1], pp, &tau, dmin__, &dmin1, &dmin2, &dn, &dn1, &
9793 : dn2, ieee);
9794 :
9795 12568622 : *ndiv += *n0 - *i0 + 2;
9796 12568622 : ++(*iter);
9797 :
9798 12568622 : if (*dmin__ >= 0. && dmin1 > 0.) {
9799 :
9800 12568618 : goto L90;
9801 :
9802 4 : } else if (*dmin__ < 0. && dmin1 > 0. && z__[4*(*n0 - 1) - *pp] < tol *
9803 6 : (*sigma + dn1) && std::abs(dn) < tol * *sigma) {
9804 :
9805 0 : z__[4*(*n0 - 1) - *pp + 2] = 0.;
9806 0 : *dmin__ = 0.;
9807 0 : goto L90;
9808 4 : } else if (*dmin__ < 0.) {
9809 :
9810 4 : ++(*nfail);
9811 4 : if (ttype < -22) {
9812 :
9813 0 : tau = 0.;
9814 4 : } else if (dmin1 > 0.) {
9815 :
9816 2 : tau = (tau + *dmin__) * (1. - eps * 2.);
9817 2 : ttype += -11;
9818 : } else {
9819 :
9820 2 : tau *= .25;
9821 2 : ttype += -12;
9822 : }
9823 4 : goto L70;
9824 : }
9825 : else {
9826 :
9827 0 : goto L80;
9828 : }
9829 :
9830 : L80:
9831 0 : PLUMED_BLAS_F77_FUNC(dlasq6,DLASQ6)(i0, n0, &z__[1], pp, dmin__, &dmin1, &dmin2, &dn, &dn1, &dn2);
9832 0 : *ndiv += *n0 - *i0 + 2;
9833 0 : ++(*iter);
9834 0 : tau = 0.;
9835 :
9836 12568618 : L90:
9837 12568618 : if (tau < *sigma) {
9838 10899679 : *desig += tau;
9839 10899679 : t = *sigma + *desig;
9840 10899679 : *desig -= t - *sigma;
9841 : } else {
9842 1668939 : t = *sigma + tau;
9843 1668939 : *desig = *sigma - (t - tau) + *desig;
9844 : }
9845 12568618 : *sigma = t;
9846 :
9847 12568618 : return;
9848 : }
9849 : }
9850 : }
9851 : #include <cmath>
9852 : #include "real.h"
9853 :
9854 : #include "lapack.h"
9855 :
9856 : #include "blas/blas.h"
9857 : namespace PLMD{
9858 : namespace lapack{
9859 : using namespace blas;
9860 : void
9861 12568618 : PLUMED_BLAS_F77_FUNC(dlasq4,DLASQ4)(int *i0,
9862 : int *n0,
9863 : double *z__,
9864 : int *pp,
9865 : int *n0in,
9866 : double *dmin__,
9867 : double *dmin1,
9868 : double *dmin2,
9869 : double *dn,
9870 : double *dn1,
9871 : double *dn2,
9872 : double *tau,
9873 : int *ttype)
9874 : {
9875 : double g = 0.;
9876 : int i__1;
9877 : double d__1, d__2;
9878 :
9879 : double s, a2, b1, b2;
9880 : int i4, nn, np;
9881 : double gam, gap1, gap2;
9882 :
9883 :
9884 12568618 : if (*dmin__ <= 0.) {
9885 848266 : *tau = -(*dmin__);
9886 848266 : *ttype = -1;
9887 848266 : return;
9888 : }
9889 :
9890 : s = 0.0;
9891 :
9892 11720352 : nn = (*n0 << 2) + *pp;
9893 11720352 : if (*n0in == *n0) {
9894 :
9895 11455244 : if ( std::abs(*dmin__ - *dn)<PLUMED_GMX_DOUBLE_EPS*std::abs(*dmin__ + *dn) ||
9896 11455244 : std::abs(*dmin__ - *dn1)<PLUMED_GMX_DOUBLE_EPS*std::abs(*dmin__ + *dn1)) {
9897 :
9898 0 : b1 = std::sqrt(z__[nn - 3]) * std::sqrt(z__[nn - 5]);
9899 0 : b2 = std::sqrt(z__[nn - 7]) * std::sqrt(z__[nn - 9]);
9900 0 : a2 = z__[nn - 7] + z__[nn - 5];
9901 :
9902 0 : if ( std::abs(*dmin__ - *dn)<PLUMED_GMX_DOUBLE_EPS*std::abs(*dmin__ + *dn) &&
9903 0 : std::abs(*dmin1 - *dn1)<PLUMED_GMX_DOUBLE_EPS*std::abs(*dmin1 + *dn1)) {
9904 :
9905 0 : gap2 = *dmin2 - a2 - *dmin2 * .25;
9906 0 : if (gap2 > 0. && gap2 > b2) {
9907 0 : gap1 = a2 - *dn - b2 / gap2 * b2;
9908 : } else {
9909 0 : gap1 = a2 - *dn - (b1 + b2);
9910 : }
9911 0 : if (gap1 > 0. && gap1 > b1) {
9912 0 : d__1 = *dn - b1 / gap1 * b1, d__2 = *dmin__ * .5;
9913 0 : s = (d__1>d__2) ? d__1 : d__2;
9914 0 : *ttype = -2;
9915 : } else {
9916 : s = 0.;
9917 0 : if (*dn > b1) {
9918 0 : s = *dn - b1;
9919 : }
9920 0 : if (a2 > b1 + b2) {
9921 0 : d__1 = s, d__2 = a2 - (b1 + b2);
9922 0 : s = (d__1<d__2) ? d__1 : d__2;
9923 : }
9924 0 : d__1 = s, d__2 = *dmin__ * .333;
9925 0 : s = (d__1>d__2) ? d__1 : d__2;
9926 0 : *ttype = -3;
9927 : }
9928 : } else {
9929 :
9930 :
9931 0 : *ttype = -4;
9932 0 : s = *dmin__ * .25;
9933 0 : if (std::abs(*dmin__ - *dn)<PLUMED_GMX_DOUBLE_EPS*std::abs(*dmin__ + *dn)) {
9934 : gam = *dn;
9935 : a2 = 0.;
9936 0 : if (z__[nn - 5] > z__[nn - 7]) {
9937 : return;
9938 : }
9939 0 : b2 = z__[nn - 5] / z__[nn - 7];
9940 0 : np = nn - 9;
9941 : } else {
9942 0 : np = nn - (*pp << 1);
9943 0 : gam = *dn1;
9944 0 : if (z__[np - 4] > z__[np - 2]) {
9945 : return;
9946 : }
9947 0 : a2 = z__[np - 4] / z__[np - 2];
9948 0 : if (z__[nn - 9] > z__[nn - 11]) {
9949 : return;
9950 : }
9951 0 : b2 = z__[nn - 9] / z__[nn - 11];
9952 0 : np = nn - 13;
9953 : }
9954 :
9955 :
9956 0 : a2 += b2;
9957 0 : i__1 = (*i0 << 2) - 1 + *pp;
9958 0 : for (i4 = np; i4 >= i__1; i4 += -4) {
9959 0 : if (std::abs(b2)<PLUMED_GMX_DOUBLE_MIN) {
9960 0 : goto L20;
9961 : }
9962 : b1 = b2;
9963 0 : if (z__[i4] > z__[i4 - 2]) {
9964 : return;
9965 : }
9966 0 : b2 *= z__[i4] / z__[i4 - 2];
9967 0 : a2 += b2;
9968 0 : if (((b2>b1) ? b2 : b1) * 100. < a2 || .563 < a2) {
9969 0 : goto L20;
9970 : }
9971 : }
9972 0 : L20:
9973 0 : a2 *= 1.05;
9974 :
9975 :
9976 0 : if (a2 < .563) {
9977 0 : s = gam * (1. - std::sqrt(a2)) / (a2 + 1.);
9978 : }
9979 : }
9980 11455244 : } else if (std::abs(*dmin__ - *dn2)<PLUMED_GMX_DOUBLE_EPS*std::abs(*dmin__ + *dn2)) {
9981 :
9982 0 : *ttype = -5;
9983 0 : s = *dmin__ * .25;
9984 :
9985 0 : np = nn - (*pp << 1);
9986 0 : b1 = z__[np - 2];
9987 0 : b2 = z__[np - 6];
9988 0 : gam = *dn2;
9989 0 : if (z__[np - 8] > b2 || z__[np - 4] > b1) {
9990 : return;
9991 : }
9992 0 : a2 = z__[np - 8] / b2 * (z__[np - 4] / b1 + 1.);
9993 :
9994 :
9995 0 : if (*n0 - *i0 > 2) {
9996 0 : b2 = z__[nn - 13] / z__[nn - 15];
9997 0 : a2 += b2;
9998 0 : i__1 = (*i0 << 2) - 1 + *pp;
9999 0 : for (i4 = nn - 17; i4 >= i__1; i4 += -4) {
10000 0 : if (std::abs(b2)<PLUMED_GMX_DOUBLE_MIN) {
10001 0 : goto L40;
10002 : }
10003 : b1 = b2;
10004 0 : if (z__[i4] > z__[i4 - 2]) {
10005 : return;
10006 : }
10007 0 : b2 *= z__[i4] / z__[i4 - 2];
10008 0 : a2 += b2;
10009 0 : if (((b2>b1) ? b2 : b1) * 100. < a2 || .563 < a2) {
10010 0 : goto L40;
10011 : }
10012 : }
10013 0 : L40:
10014 0 : a2 *= 1.05;
10015 : }
10016 :
10017 0 : if (a2 < .563) {
10018 0 : s = gam * (1. - std::sqrt(a2)) / (a2 + 1.);
10019 : }
10020 : } else {
10021 :
10022 11455244 : if (*ttype == -6) {
10023 : g += (1. - g) * .333;
10024 11455244 : } else if (*ttype == -18) {
10025 : g = .083250000000000005;
10026 : } else {
10027 : g = .25;
10028 : }
10029 11455244 : s = g * *dmin__;
10030 11455244 : *ttype = -6;
10031 : }
10032 :
10033 265108 : } else if (*n0in == *n0 + 1) {
10034 :
10035 264999 : if ( std::abs(*dmin1 - *dn1)<PLUMED_GMX_DOUBLE_EPS*std::abs(*dmin1 + *dn1) &&
10036 0 : std::abs(*dmin2 - *dn2)<PLUMED_GMX_DOUBLE_EPS*std::abs(*dmin2 + *dn2)) {
10037 :
10038 0 : *ttype = -7;
10039 0 : s = *dmin1 * .333;
10040 0 : if (z__[nn - 5] > z__[nn - 7]) {
10041 : return;
10042 : }
10043 0 : b1 = z__[nn - 5] / z__[nn - 7];
10044 : b2 = b1;
10045 0 : if (std::abs(b2)<PLUMED_GMX_DOUBLE_MIN) {
10046 0 : goto L60;
10047 : }
10048 0 : i__1 = (*i0 << 2) - 1 + *pp;
10049 0 : for (i4 = (*n0 << 2) - 9 + *pp; i4 >= i__1; i4 += -4) {
10050 : a2 = b1;
10051 0 : if (z__[i4] > z__[i4 - 2]) {
10052 : return;
10053 : }
10054 0 : b1 *= z__[i4] / z__[i4 - 2];
10055 0 : b2 += b1;
10056 0 : if (((a2>b1) ? a2 : b1) * 100. < b2) {
10057 0 : goto L60;
10058 : }
10059 : }
10060 0 : L60:
10061 0 : b2 = std::sqrt(b2 * 1.05);
10062 : d__1 = b2;
10063 0 : a2 = *dmin1 / (d__1 * d__1 + 1.);
10064 0 : gap2 = *dmin2 * .5 - a2;
10065 0 : if (gap2 > 0. && gap2 > b2 * a2) {
10066 0 : d__1 = s, d__2 = a2 * (1. - a2 * 1.01 * (b2 / gap2) * b2);
10067 0 : s = (d__1>d__2) ? d__1 : d__2;
10068 : } else {
10069 0 : d__1 = s, d__2 = a2 * (1. - b2 * 1.01);
10070 0 : s = (d__1>d__2) ? d__1 : d__2;
10071 0 : *ttype = -8;
10072 : }
10073 : } else {
10074 :
10075 264999 : s = *dmin1 * .25;
10076 264999 : if (std::abs(*dmin1 - *dn1)<PLUMED_GMX_DOUBLE_EPS*std::abs(*dmin1 + *dn1)) {
10077 0 : s = *dmin1 * .5;
10078 : }
10079 264999 : *ttype = -9;
10080 : }
10081 :
10082 109 : } else if (*n0in == *n0 + 2) {
10083 :
10084 108 : if (std::abs(*dmin2 - *dn2)<PLUMED_GMX_DOUBLE_EPS*std::abs(*dmin2 + *dn2) &&
10085 0 : z__[nn - 5] * 2. < z__[nn - 7]) {
10086 0 : *ttype = -10;
10087 0 : s = *dmin2 * .333;
10088 0 : if (z__[nn - 5] > z__[nn - 7]) {
10089 : return;
10090 : }
10091 0 : b1 = z__[nn - 5] / z__[nn - 7];
10092 : b2 = b1;
10093 0 : if (std::abs(b2)<PLUMED_GMX_DOUBLE_MIN) {
10094 0 : goto L80;
10095 : }
10096 0 : i__1 = (*i0 << 2) - 1 + *pp;
10097 0 : for (i4 = (*n0 << 2) - 9 + *pp; i4 >= i__1; i4 += -4) {
10098 0 : if (z__[i4] > z__[i4 - 2]) {
10099 : return;
10100 : }
10101 0 : b1 *= z__[i4] / z__[i4 - 2];
10102 0 : b2 += b1;
10103 0 : if (b1 * 100. < b2) {
10104 0 : goto L80;
10105 : }
10106 : }
10107 0 : L80:
10108 0 : b2 = std::sqrt(b2 * 1.05);
10109 : d__1 = b2;
10110 0 : a2 = *dmin2 / (d__1 * d__1 + 1.);
10111 0 : gap2 = z__[nn - 7] + z__[nn - 9] - std::sqrt(z__[nn - 11]) * std::sqrt(z__[
10112 : nn - 9]) - a2;
10113 0 : if (gap2 > 0. && gap2 > b2 * a2) {
10114 0 : d__1 = s, d__2 = a2 * (1. - a2 * 1.01 * (b2 / gap2) * b2);
10115 0 : s = (d__1>d__2) ? d__1 : d__2;
10116 : } else {
10117 0 : d__1 = s, d__2 = a2 * (1. - b2 * 1.01);
10118 0 : s = (d__1>d__2) ? d__1 : d__2;
10119 : }
10120 : } else {
10121 108 : s = *dmin2 * .25;
10122 108 : *ttype = -11;
10123 : }
10124 1 : } else if (*n0in > *n0 + 2) {
10125 :
10126 : s = 0.;
10127 1 : *ttype = -12;
10128 : }
10129 :
10130 11720352 : *tau = s;
10131 11720352 : return;
10132 :
10133 : }
10134 :
10135 :
10136 : }
10137 : }
10138 : #include <cmath>
10139 : #include "lapack.h"
10140 :
10141 : #include "blas/blas.h"
10142 : namespace PLMD{
10143 : namespace lapack{
10144 : using namespace blas;
10145 : void
10146 12568622 : PLUMED_BLAS_F77_FUNC(dlasq5,DLASQ5)(int *i0,
10147 : int *n0,
10148 : double *z__,
10149 : int *pp,
10150 : double *tau,
10151 : double *dmin__,
10152 : double *dmin1,
10153 : double *dmin2,
10154 : double *dn,
10155 : double *dnm1,
10156 : double *dnm2,
10157 : int *ieee)
10158 : {
10159 : int i__1;
10160 : double d__1, d__2;
10161 :
10162 : double d__;
10163 : int j4, j4p2;
10164 : double emin, temp;
10165 :
10166 12568622 : --z__;
10167 :
10168 12568622 : if (*n0 - *i0 - 1 <= 0) {
10169 : return;
10170 : }
10171 :
10172 12568622 : j4 = (*i0 << 2) + *pp - 3;
10173 12568622 : emin = z__[j4 + 4];
10174 12568622 : d__ = z__[j4] - *tau;
10175 12568622 : *dmin__ = d__;
10176 12568622 : *dmin1 = -z__[j4];
10177 :
10178 12568622 : if (*ieee) {
10179 :
10180 12568622 : if (*pp == 0) {
10181 6430722 : i__1 = 4*(*n0 - 3);
10182 7707448 : for (j4 = *i0 << 2; j4 <= i__1; j4 += 4) {
10183 1276726 : z__[j4 - 2] = d__ + z__[j4 - 1];
10184 1276726 : temp = z__[j4 + 1] / z__[j4 - 2];
10185 1276726 : d__ = d__ * temp - *tau;
10186 1276726 : if(d__<*dmin__)
10187 328355 : *dmin__ = d__;
10188 1276726 : z__[j4] = z__[j4 - 1] * temp;
10189 : d__1 = z__[j4];
10190 1276726 : if(d__1<emin)
10191 : emin = d__1;
10192 : }
10193 : } else {
10194 6137900 : i__1 = 4*(*n0 - 3);
10195 7015624 : for (j4 = *i0 << 2; j4 <= i__1; j4 += 4) {
10196 877724 : z__[j4 - 3] = d__ + z__[j4];
10197 877724 : temp = z__[j4 + 2] / z__[j4 - 3];
10198 877724 : d__ = d__ * temp - *tau;
10199 877724 : if(d__<*dmin__)
10200 239825 : *dmin__ = d__;
10201 877724 : z__[j4 - 1] = z__[j4] * temp;
10202 : d__1 = z__[j4 - 1];
10203 877724 : if(d__1<emin)
10204 : emin = d__1;
10205 : }
10206 : }
10207 :
10208 12568622 : *dnm2 = d__;
10209 12568622 : *dmin2 = *dmin__;
10210 12568622 : j4 = 4*(*n0 - 2) - *pp;
10211 12568622 : j4p2 = j4 + (*pp << 1) - 1;
10212 12568622 : z__[j4 - 2] = *dnm2 + z__[j4p2];
10213 12568622 : z__[j4] = z__[j4p2 + 2] * (z__[j4p2] / z__[j4 - 2]);
10214 12568622 : *dnm1 = z__[j4p2 + 2] * (*dnm2 / z__[j4 - 2]) - *tau;
10215 12568622 : if(*dnm1<*dmin__)
10216 9958506 : *dmin__ = *dnm1;
10217 :
10218 12568622 : *dmin1 = *dmin__;
10219 12568622 : j4 += 4;
10220 12568622 : j4p2 = j4 + (*pp << 1) - 1;
10221 12568622 : z__[j4 - 2] = *dnm1 + z__[j4p2];
10222 12568622 : z__[j4] = z__[j4p2 + 2] * (z__[j4p2] / z__[j4 - 2]);
10223 12568622 : *dn = z__[j4p2 + 2] * (*dnm1 / z__[j4 - 2]) - *tau;
10224 12568622 : if(*dn<*dmin__)
10225 12019692 : *dmin__ = *dn;
10226 :
10227 : } else {
10228 :
10229 0 : if (*pp == 0) {
10230 0 : i__1 = 4*(*n0 - 3);
10231 0 : for (j4 = *i0 << 2; j4 <= i__1; j4 += 4) {
10232 0 : z__[j4 - 2] = d__ + z__[j4 - 1];
10233 0 : if (d__ < 0.) {
10234 : return;
10235 : } else {
10236 0 : z__[j4] = z__[j4 + 1] * (z__[j4 - 1] / z__[j4 - 2]);
10237 0 : d__ = z__[j4 + 1] * (d__ / z__[j4 - 2]) - *tau;
10238 : }
10239 0 : if(d__<*dmin__)
10240 0 : *dmin__ = d__;
10241 0 : d__1 = emin, d__2 = z__[j4];
10242 0 : emin = (d__1<d__2) ? d__1 : d__2;
10243 : }
10244 : } else {
10245 0 : i__1 = 4*(*n0 - 3);
10246 0 : for (j4 = *i0 << 2; j4 <= i__1; j4 += 4) {
10247 0 : z__[j4 - 3] = d__ + z__[j4];
10248 0 : if (d__ < 0.) {
10249 : return;
10250 : } else {
10251 0 : z__[j4 - 1] = z__[j4 + 2] * (z__[j4] / z__[j4 - 3]);
10252 0 : d__ = z__[j4 + 2] * (d__ / z__[j4 - 3]) - *tau;
10253 : }
10254 0 : if(d__<*dmin__)
10255 0 : *dmin__ = d__;
10256 0 : d__1 = emin, d__2 = z__[j4 - 1];
10257 0 : emin = (d__1<d__2) ? d__1 : d__2;
10258 : }
10259 : }
10260 :
10261 0 : *dnm2 = d__;
10262 0 : *dmin2 = *dmin__;
10263 0 : j4 = 4*(*n0 - 2) - *pp;
10264 0 : j4p2 = j4 + (*pp << 1) - 1;
10265 0 : z__[j4 - 2] = *dnm2 + z__[j4p2];
10266 0 : if (*dnm2 < 0.) {
10267 : return;
10268 : } else {
10269 0 : z__[j4] = z__[j4p2 + 2] * (z__[j4p2] / z__[j4 - 2]);
10270 0 : *dnm1 = z__[j4p2 + 2] * (*dnm2 / z__[j4 - 2]) - *tau;
10271 : }
10272 0 : if(*dnm1<*dmin__)
10273 0 : *dmin__ = *dnm1;
10274 :
10275 0 : *dmin1 = *dmin__;
10276 0 : j4 += 4;
10277 0 : j4p2 = j4 + (*pp << 1) - 1;
10278 0 : z__[j4 - 2] = *dnm1 + z__[j4p2];
10279 0 : if (*dnm1 < 0.) {
10280 : return;
10281 : } else {
10282 0 : z__[j4] = z__[j4p2 + 2] * (z__[j4p2] / z__[j4 - 2]);
10283 0 : *dn = z__[j4p2 + 2] * (*dnm1 / z__[j4 - 2]) - *tau;
10284 : }
10285 0 : if(*dn<*dmin__)
10286 0 : *dmin__ = *dn;
10287 :
10288 : }
10289 :
10290 12568622 : z__[j4 + 2] = *dn;
10291 12568622 : z__[(*n0 << 2) - *pp] = emin;
10292 12568622 : return;
10293 :
10294 : }
10295 :
10296 : }
10297 : }
10298 : #include <cmath>
10299 : #include "lapack.h"
10300 : #include "lapack_limits.h"
10301 :
10302 : #include "real.h"
10303 :
10304 : #include "blas/blas.h"
10305 : namespace PLMD{
10306 : namespace lapack{
10307 : using namespace blas;
10308 : void
10309 0 : PLUMED_BLAS_F77_FUNC(dlasq6,DLASQ6)(int *i0,
10310 : int *n0,
10311 : double *z__,
10312 : int *pp,
10313 : double *dmin__,
10314 : double *dmin1,
10315 : double *dmin2,
10316 : double *dn,
10317 : double *dnm1,
10318 : double *dnm2)
10319 : {
10320 : int i__1;
10321 : double d__1, d__2;
10322 :
10323 : /* Local variables */
10324 : double d__;
10325 : int j4, j4p2;
10326 : double emin, temp;
10327 : const double safemin = PLUMED_GMX_DOUBLE_MIN*(1.0+PLUMED_GMX_DOUBLE_EPS);
10328 :
10329 0 : --z__;
10330 :
10331 0 : if (*n0 - *i0 - 1 <= 0) {
10332 : return;
10333 : }
10334 :
10335 0 : j4 = (*i0 << 2) + *pp - 3;
10336 0 : emin = z__[j4 + 4];
10337 0 : d__ = z__[j4];
10338 0 : *dmin__ = d__;
10339 :
10340 0 : if (*pp == 0) {
10341 0 : i__1 = 4*(*n0 - 3);
10342 0 : for (j4 = *i0*4; j4 <= i__1; j4 += 4) {
10343 0 : z__[j4 - 2] = d__ + z__[j4 - 1];
10344 0 : if (std::abs(z__[j4 - 2])<PLUMED_GMX_DOUBLE_MIN) {
10345 0 : z__[j4] = 0.;
10346 0 : d__ = z__[j4 + 1];
10347 0 : *dmin__ = d__;
10348 : emin = 0.;
10349 0 : } else if (safemin * z__[j4 + 1] < z__[j4 - 2] && safemin * z__[j4
10350 : - 2] < z__[j4 + 1]) {
10351 0 : temp = z__[j4 + 1] / z__[j4 - 2];
10352 0 : z__[j4] = z__[j4 - 1] * temp;
10353 0 : d__ *= temp;
10354 : } else {
10355 0 : z__[j4] = z__[j4 + 1] * (z__[j4 - 1] / z__[j4 - 2]);
10356 0 : d__ = z__[j4 + 1] * (d__ / z__[j4 - 2]);
10357 : }
10358 0 : if(d__<*dmin__)
10359 0 : *dmin__ = d__;
10360 :
10361 0 : d__1 = emin, d__2 = z__[j4];
10362 0 : emin = (d__1<d__2) ? d__1 : d__2;
10363 : }
10364 : } else {
10365 0 : i__1 = 4*(*n0 - 3);
10366 0 : for (j4 = *i0 << 2; j4 <= i__1; j4 += 4) {
10367 0 : z__[j4 - 3] = d__ + z__[j4];
10368 0 : if (std::abs(z__[j4 - 3])<PLUMED_GMX_DOUBLE_MIN) {
10369 0 : z__[j4 - 1] = 0.;
10370 0 : d__ = z__[j4 + 2];
10371 0 : *dmin__ = d__;
10372 : emin = 0.;
10373 0 : } else if (safemin * z__[j4 + 2] < z__[j4 - 3] && safemin * z__[j4
10374 : - 3] < z__[j4 + 2]) {
10375 0 : temp = z__[j4 + 2] / z__[j4 - 3];
10376 0 : z__[j4 - 1] = z__[j4] * temp;
10377 0 : d__ *= temp;
10378 : } else {
10379 0 : z__[j4 - 1] = z__[j4 + 2] * (z__[j4] / z__[j4 - 3]);
10380 0 : d__ = z__[j4 + 2] * (d__ / z__[j4 - 3]);
10381 : }
10382 0 : if(d__<*dmin__)
10383 0 : *dmin__ = d__;
10384 0 : d__1 = emin, d__2 = z__[j4 - 1];
10385 0 : emin = (d__1<d__2) ? d__1 : d__2;
10386 : }
10387 : }
10388 :
10389 0 : *dnm2 = d__;
10390 0 : *dmin2 = *dmin__;
10391 0 : j4 = 4*(*n0 - 2) - *pp;
10392 0 : j4p2 = j4 + (*pp << 1) - 1;
10393 0 : z__[j4 - 2] = *dnm2 + z__[j4p2];
10394 0 : if (std::abs(z__[j4 - 2])<PLUMED_GMX_DOUBLE_MIN) {
10395 0 : z__[j4] = 0.;
10396 0 : *dnm1 = z__[j4p2 + 2];
10397 0 : *dmin__ = *dnm1;
10398 : emin = 0.;
10399 0 : } else if (safemin * z__[j4p2 + 2] < z__[j4 - 2] && safemin * z__[j4 - 2] <
10400 : z__[j4p2 + 2]) {
10401 0 : temp = z__[j4p2 + 2] / z__[j4 - 2];
10402 0 : z__[j4] = z__[j4p2] * temp;
10403 0 : *dnm1 = *dnm2 * temp;
10404 : } else {
10405 0 : z__[j4] = z__[j4p2 + 2] * (z__[j4p2] / z__[j4 - 2]);
10406 0 : *dnm1 = z__[j4p2 + 2] * (*dnm2 / z__[j4 - 2]);
10407 : }
10408 0 : if(*dnm1<*dmin__)
10409 0 : *dmin__ = *dnm1;
10410 :
10411 0 : *dmin1 = *dmin__;
10412 0 : j4 += 4;
10413 0 : j4p2 = j4 + (*pp << 1) - 1;
10414 0 : z__[j4 - 2] = *dnm1 + z__[j4p2];
10415 0 : if (std::abs(z__[j4 - 2])<PLUMED_GMX_DOUBLE_MIN) {
10416 0 : z__[j4] = 0.;
10417 0 : *dn = z__[j4p2 + 2];
10418 0 : *dmin__ = *dn;
10419 : emin = 0.;
10420 0 : } else if (safemin * z__[j4p2 + 2] < z__[j4 - 2] && safemin * z__[j4 - 2] <
10421 : z__[j4p2 + 2]) {
10422 0 : temp = z__[j4p2 + 2] / z__[j4 - 2];
10423 0 : z__[j4] = z__[j4p2] * temp;
10424 0 : *dn = *dnm1 * temp;
10425 : } else {
10426 0 : z__[j4] = z__[j4p2 + 2] * (z__[j4p2] / z__[j4 - 2]);
10427 0 : *dn = z__[j4p2 + 2] * (*dnm1 / z__[j4 - 2]);
10428 : }
10429 0 : if(*dn<*dmin__)
10430 0 : *dmin__ = *dn;
10431 :
10432 0 : z__[j4 + 2] = *dn;
10433 0 : z__[(*n0 << 2) - *pp] = emin;
10434 0 : return;
10435 :
10436 :
10437 : }
10438 : }
10439 : }
10440 : #include <cmath>
10441 :
10442 : #include "real.h"
10443 : #include "lapack.h"
10444 :
10445 : #include "blas/blas.h"
10446 : namespace PLMD{
10447 : namespace lapack{
10448 : using namespace blas;
10449 : void
10450 9382 : PLUMED_BLAS_F77_FUNC(dlasr,DLASR)(const char *side,
10451 : const char *pivot,
10452 : const char *direct,
10453 : int *m,
10454 : int *n,
10455 : double *c__,
10456 : double *s,
10457 : double *a,
10458 : int *lda)
10459 : {
10460 : /* System generated locals */
10461 : int a_dim1, a_offset, i__1, i__2;
10462 :
10463 : /* Local variables */
10464 : int i__, j;
10465 : double temp;
10466 : double ctemp, stemp;
10467 :
10468 9382 : --c__;
10469 9382 : --s;
10470 9382 : a_dim1 = *lda;
10471 9382 : a_offset = 1 + a_dim1;
10472 9382 : a -= a_offset;
10473 :
10474 : /* Function Body */
10475 :
10476 9382 : if (*m == 0 || *n == 0) {
10477 : return;
10478 : }
10479 9382 : if (*side=='L' || *side=='l') {
10480 :
10481 4691 : if (*pivot=='V' || *pivot=='v') {
10482 4691 : if (*direct=='F' || *direct=='f') {
10483 : i__1 = *m - 1;
10484 49675 : for (j = 1; j <= i__1; ++j) {
10485 45017 : ctemp = c__[j];
10486 45017 : stemp = s[j];
10487 45017 : if (std::abs(ctemp-1.0)>PLUMED_GMX_DOUBLE_EPS || std::abs(stemp)>PLUMED_GMX_DOUBLE_MIN) {
10488 45017 : i__2 = *n;
10489 861025 : for (i__ = 1; i__ <= i__2; ++i__) {
10490 816008 : temp = a[j + 1 + i__ * a_dim1];
10491 816008 : a[j + 1 + i__ * a_dim1] = ctemp * temp - stemp *
10492 816008 : a[j + i__ * a_dim1];
10493 816008 : a[j + i__ * a_dim1] = stemp * temp + ctemp * a[j
10494 816008 : + i__ * a_dim1];
10495 : }
10496 : }
10497 : }
10498 33 : } else if (*direct=='B' || *direct=='b') {
10499 305 : for (j = *m - 1; j >= 1; --j) {
10500 272 : ctemp = c__[j];
10501 272 : stemp = s[j];
10502 272 : if (std::abs(ctemp-1.0)>PLUMED_GMX_DOUBLE_EPS || std::abs(stemp)>PLUMED_GMX_DOUBLE_MIN) {
10503 272 : i__1 = *n;
10504 4080 : for (i__ = 1; i__ <= i__1; ++i__) {
10505 3808 : temp = a[j + 1 + i__ * a_dim1];
10506 3808 : a[j + 1 + i__ * a_dim1] = ctemp * temp - stemp *
10507 3808 : a[j + i__ * a_dim1];
10508 3808 : a[j + i__ * a_dim1] = stemp * temp + ctemp * a[j
10509 3808 : + i__ * a_dim1];
10510 : }
10511 : }
10512 : }
10513 : }
10514 0 : } else if (*pivot=='T' || *pivot=='t') {
10515 0 : if (*direct=='F' || *direct=='f') {
10516 : i__1 = *m;
10517 0 : for (j = 2; j <= i__1; ++j) {
10518 0 : ctemp = c__[j - 1];
10519 0 : stemp = s[j - 1];
10520 0 : if (std::abs(ctemp-1.0)>PLUMED_GMX_DOUBLE_EPS || std::abs(stemp)>PLUMED_GMX_DOUBLE_MIN) {
10521 0 : i__2 = *n;
10522 0 : for (i__ = 1; i__ <= i__2; ++i__) {
10523 0 : temp = a[j + i__ * a_dim1];
10524 0 : a[j + i__ * a_dim1] = ctemp * temp - stemp * a[
10525 0 : i__ * a_dim1 + 1];
10526 0 : a[i__ * a_dim1 + 1] = stemp * temp + ctemp * a[
10527 0 : i__ * a_dim1 + 1];
10528 : }
10529 : }
10530 : }
10531 0 : } else if (*direct=='B' || *direct=='b') {
10532 0 : for (j = *m; j >= 2; --j) {
10533 0 : ctemp = c__[j - 1];
10534 0 : stemp = s[j - 1];
10535 0 : if (std::abs(ctemp-1.0)>PLUMED_GMX_DOUBLE_EPS || std::abs(stemp)>PLUMED_GMX_DOUBLE_MIN) {
10536 0 : i__1 = *n;
10537 0 : for (i__ = 1; i__ <= i__1; ++i__) {
10538 0 : temp = a[j + i__ * a_dim1];
10539 0 : a[j + i__ * a_dim1] = ctemp * temp - stemp * a[
10540 0 : i__ * a_dim1 + 1];
10541 0 : a[i__ * a_dim1 + 1] = stemp * temp + ctemp * a[
10542 0 : i__ * a_dim1 + 1];
10543 : }
10544 : }
10545 : }
10546 : }
10547 0 : } else if (*pivot=='B' || *pivot=='b') {
10548 0 : if (*direct=='F' || *direct=='f') {
10549 : i__1 = *m - 1;
10550 0 : for (j = 1; j <= i__1; ++j) {
10551 0 : ctemp = c__[j];
10552 0 : stemp = s[j];
10553 0 : if (std::abs(ctemp-1.0)>PLUMED_GMX_DOUBLE_EPS || std::abs(stemp)>PLUMED_GMX_DOUBLE_MIN) {
10554 0 : i__2 = *n;
10555 0 : for (i__ = 1; i__ <= i__2; ++i__) {
10556 0 : temp = a[j + i__ * a_dim1];
10557 0 : a[j + i__ * a_dim1] = stemp * a[*m + i__ * a_dim1]
10558 0 : + ctemp * temp;
10559 0 : a[*m + i__ * a_dim1] = ctemp * a[*m + i__ *
10560 0 : a_dim1] - stemp * temp;
10561 : }
10562 : }
10563 : }
10564 0 : } else if (*direct=='B' || *direct=='b') {
10565 0 : for (j = *m - 1; j >= 1; --j) {
10566 0 : ctemp = c__[j];
10567 0 : stemp = s[j];
10568 0 : if (std::abs(ctemp-1.0)>PLUMED_GMX_DOUBLE_EPS || std::abs(stemp)>PLUMED_GMX_DOUBLE_MIN) {
10569 0 : i__1 = *n;
10570 0 : for (i__ = 1; i__ <= i__1; ++i__) {
10571 0 : temp = a[j + i__ * a_dim1];
10572 0 : a[j + i__ * a_dim1] = stemp * a[*m + i__ * a_dim1]
10573 0 : + ctemp * temp;
10574 0 : a[*m + i__ * a_dim1] = ctemp * a[*m + i__ *
10575 0 : a_dim1] - stemp * temp;
10576 : }
10577 : }
10578 : }
10579 : }
10580 : }
10581 4691 : } else if (*side=='R' || *side=='r') {
10582 :
10583 4691 : if (*pivot=='V' || *pivot=='v') {
10584 4691 : if (*direct=='F' || *direct=='f') {
10585 : i__1 = *n - 1;
10586 49616 : for (j = 1; j <= i__1; ++j) {
10587 44958 : ctemp = c__[j];
10588 44958 : stemp = s[j];
10589 44958 : if (std::abs(ctemp-1.0)>PLUMED_GMX_DOUBLE_EPS || std::abs(stemp)>PLUMED_GMX_DOUBLE_MIN) {
10590 44958 : i__2 = *m;
10591 843208 : for (i__ = 1; i__ <= i__2; ++i__) {
10592 798250 : temp = a[i__ + (j + 1) * a_dim1];
10593 798250 : a[i__ + (j + 1) * a_dim1] = ctemp * temp - stemp *
10594 798250 : a[i__ + j * a_dim1];
10595 798250 : a[i__ + j * a_dim1] = stemp * temp + ctemp * a[
10596 798250 : i__ + j * a_dim1];
10597 : }
10598 : }
10599 : }
10600 33 : } else if (*direct=='B' || *direct=='b') {
10601 305 : for (j = *n - 1; j >= 1; --j) {
10602 272 : ctemp = c__[j];
10603 272 : stemp = s[j];
10604 272 : if (std::abs(ctemp-1.0)>PLUMED_GMX_DOUBLE_EPS || std::abs(stemp)>PLUMED_GMX_DOUBLE_MIN) {
10605 272 : i__1 = *m;
10606 4080 : for (i__ = 1; i__ <= i__1; ++i__) {
10607 3808 : temp = a[i__ + (j + 1) * a_dim1];
10608 3808 : a[i__ + (j + 1) * a_dim1] = ctemp * temp - stemp *
10609 3808 : a[i__ + j * a_dim1];
10610 3808 : a[i__ + j * a_dim1] = stemp * temp + ctemp * a[
10611 3808 : i__ + j * a_dim1];
10612 : }
10613 : }
10614 : }
10615 : }
10616 0 : } else if (*pivot=='T' || *pivot=='t') {
10617 0 : if (*direct=='F' || *direct=='f') {
10618 : i__1 = *n;
10619 0 : for (j = 2; j <= i__1; ++j) {
10620 0 : ctemp = c__[j - 1];
10621 0 : stemp = s[j - 1];
10622 0 : if (std::abs(ctemp-1.0)>PLUMED_GMX_DOUBLE_EPS || std::abs(stemp)>PLUMED_GMX_DOUBLE_MIN) {
10623 0 : i__2 = *m;
10624 0 : for (i__ = 1; i__ <= i__2; ++i__) {
10625 0 : temp = a[i__ + j * a_dim1];
10626 0 : a[i__ + j * a_dim1] = ctemp * temp - stemp * a[
10627 0 : i__ + a_dim1];
10628 0 : a[i__ + a_dim1] = stemp * temp + ctemp * a[i__ +
10629 0 : a_dim1];
10630 : }
10631 : }
10632 : }
10633 0 : } else if (*direct=='B' || *direct=='b') {
10634 0 : for (j = *n; j >= 2; --j) {
10635 0 : ctemp = c__[j - 1];
10636 0 : stemp = s[j - 1];
10637 0 : if (std::abs(ctemp-1.0)>PLUMED_GMX_DOUBLE_EPS || std::abs(stemp)>PLUMED_GMX_DOUBLE_MIN) {
10638 0 : i__1 = *m;
10639 0 : for (i__ = 1; i__ <= i__1; ++i__) {
10640 0 : temp = a[i__ + j * a_dim1];
10641 0 : a[i__ + j * a_dim1] = ctemp * temp - stemp * a[
10642 0 : i__ + a_dim1];
10643 0 : a[i__ + a_dim1] = stemp * temp + ctemp * a[i__ +
10644 0 : a_dim1];
10645 : }
10646 : }
10647 : }
10648 : }
10649 0 : } else if (*pivot=='B' || *pivot=='b') {
10650 0 : if (*direct=='F' || *direct=='f') {
10651 : i__1 = *n - 1;
10652 0 : for (j = 1; j <= i__1; ++j) {
10653 0 : ctemp = c__[j];
10654 0 : stemp = s[j];
10655 0 : if (std::abs(ctemp-1.0)>PLUMED_GMX_DOUBLE_EPS || std::abs(stemp)>PLUMED_GMX_DOUBLE_MIN) {
10656 0 : i__2 = *m;
10657 0 : for (i__ = 1; i__ <= i__2; ++i__) {
10658 0 : temp = a[i__ + j * a_dim1];
10659 0 : a[i__ + j * a_dim1] = stemp * a[i__ + *n * a_dim1]
10660 0 : + ctemp * temp;
10661 0 : a[i__ + *n * a_dim1] = ctemp * a[i__ + *n *
10662 0 : a_dim1] - stemp * temp;
10663 : }
10664 : }
10665 : }
10666 0 : } else if (*direct=='B' || *direct=='b') {
10667 0 : for (j = *n - 1; j >= 1; --j) {
10668 0 : ctemp = c__[j];
10669 0 : stemp = s[j];
10670 0 : if (std::abs(ctemp-1.0)>PLUMED_GMX_DOUBLE_EPS || std::abs(stemp)>PLUMED_GMX_DOUBLE_MIN) {
10671 0 : i__1 = *m;
10672 0 : for (i__ = 1; i__ <= i__1; ++i__) {
10673 0 : temp = a[i__ + j * a_dim1];
10674 0 : a[i__ + j * a_dim1] = stemp * a[i__ + *n * a_dim1]
10675 0 : + ctemp * temp;
10676 0 : a[i__ + *n * a_dim1] = ctemp * a[i__ + *n *
10677 0 : a_dim1] - stemp * temp;
10678 : }
10679 : }
10680 : }
10681 : }
10682 : }
10683 : }
10684 :
10685 : return;
10686 :
10687 : }
10688 :
10689 :
10690 : }
10691 : }
10692 : #include "lapack.h"
10693 :
10694 : #include "blas/blas.h"
10695 : namespace PLMD{
10696 : namespace lapack{
10697 : using namespace blas;
10698 : void
10699 557325 : PLUMED_BLAS_F77_FUNC(dlasrt,DLASRT)(const char *id,
10700 : int *n,
10701 : double *d__,
10702 : int *info)
10703 : {
10704 : int i__1, i__2;
10705 :
10706 : int i__, j;
10707 : double d1, d2, d3;
10708 : int dir;
10709 : double tmp;
10710 : int endd;
10711 : int stack[64];
10712 : double dmnmx;
10713 : int start;
10714 : int stkpnt;
10715 :
10716 557325 : --d__;
10717 :
10718 557325 : *info = 0;
10719 : dir = -1;
10720 557325 : if (*id=='D' || *id=='d')
10721 : dir = 0;
10722 678 : else if (*id=='I' || *id=='i')
10723 : dir = 1;
10724 :
10725 : if (dir == -1) {
10726 0 : *info = -1;
10727 557325 : } else if (*n < 0) {
10728 0 : *info = -2;
10729 : }
10730 557325 : if (*info != 0) {
10731 : return;
10732 : }
10733 557325 : if (*n <= 1) {
10734 : return;
10735 : }
10736 :
10737 : stkpnt = 1;
10738 556656 : stack[0] = 1;
10739 556656 : stack[1] = *n;
10740 556774 : L10:
10741 556774 : start = stack[(stkpnt << 1) - 2];
10742 556774 : endd = stack[(stkpnt << 1) - 1];
10743 556774 : --stkpnt;
10744 556774 : if (endd - start <= 20 && endd - start > 0) {
10745 :
10746 :
10747 556715 : if (dir == 0) {
10748 :
10749 : i__1 = endd;
10750 2227030 : for (i__ = start + 1; i__ <= i__1; ++i__) {
10751 : i__2 = start + 1;
10752 1670327 : for (j = i__; j >= i__2; --j) {
10753 1670327 : if (d__[j] > d__[j - 1]) {
10754 : dmnmx = d__[j];
10755 0 : d__[j] = d__[j - 1];
10756 0 : d__[j - 1] = dmnmx;
10757 : } else {
10758 1670327 : goto L30;
10759 : }
10760 : }
10761 1670327 : L30:
10762 : ;
10763 : }
10764 :
10765 : } else {
10766 :
10767 : i__1 = endd;
10768 100 : for (i__ = start + 1; i__ <= i__1; ++i__) {
10769 : i__2 = start + 1;
10770 88 : for (j = i__; j >= i__2; --j) {
10771 88 : if (d__[j] < d__[j - 1]) {
10772 : dmnmx = d__[j];
10773 0 : d__[j] = d__[j - 1];
10774 0 : d__[j - 1] = dmnmx;
10775 : } else {
10776 88 : goto L50;
10777 : }
10778 : }
10779 88 : L50:
10780 : ;
10781 : }
10782 :
10783 : }
10784 :
10785 59 : } else if (endd - start > 20) {
10786 :
10787 59 : d1 = d__[start];
10788 59 : d2 = d__[endd];
10789 59 : i__ = (start + endd) / 2;
10790 59 : d3 = d__[i__];
10791 59 : if (d1 < d2) {
10792 3 : if (d3 < d1) {
10793 : dmnmx = d1;
10794 3 : } else if (d3 < d2) {
10795 : dmnmx = d3;
10796 : } else {
10797 : dmnmx = d2;
10798 : }
10799 : } else {
10800 56 : if (d3 < d2) {
10801 : dmnmx = d2;
10802 56 : } else if (d3 < d1) {
10803 : dmnmx = d3;
10804 : } else {
10805 : dmnmx = d1;
10806 : }
10807 : }
10808 :
10809 59 : if (dir == 0) {
10810 :
10811 56 : i__ = start - 1;
10812 56 : j = endd + 1;
10813 1944 : L60:
10814 1944 : L70:
10815 2000 : --j;
10816 2000 : if (d__[j] < dmnmx) {
10817 1944 : goto L70;
10818 : }
10819 56 : L80:
10820 1980 : ++i__;
10821 1980 : if (d__[i__] > dmnmx) {
10822 1924 : goto L80;
10823 : }
10824 56 : if (i__ < j) {
10825 : tmp = d__[i__];
10826 0 : d__[i__] = d__[j];
10827 0 : d__[j] = tmp;
10828 0 : goto L60;
10829 : }
10830 56 : if (j - start > endd - j - 1) {
10831 : ++stkpnt;
10832 : stack[(stkpnt << 1) - 2] = start;
10833 36 : stack[(stkpnt << 1) - 1] = j;
10834 36 : ++stkpnt;
10835 36 : stack[(stkpnt << 1) - 2] = j + 1;
10836 36 : stack[(stkpnt << 1) - 1] = endd;
10837 : } else {
10838 : ++stkpnt;
10839 20 : stack[(stkpnt << 1) - 2] = j + 1;
10840 20 : stack[(stkpnt << 1) - 1] = endd;
10841 20 : ++stkpnt;
10842 20 : stack[(stkpnt << 1) - 2] = start;
10843 20 : stack[(stkpnt << 1) - 1] = j;
10844 : }
10845 : } else {
10846 :
10847 3 : i__ = start - 1;
10848 3 : j = endd + 1;
10849 61 : L90:
10850 61 : L100:
10851 64 : --j;
10852 64 : if (d__[j] > dmnmx) {
10853 61 : goto L100;
10854 : }
10855 3 : L110:
10856 63 : ++i__;
10857 63 : if (d__[i__] < dmnmx) {
10858 60 : goto L110;
10859 : }
10860 3 : if (i__ < j) {
10861 : tmp = d__[i__];
10862 0 : d__[i__] = d__[j];
10863 0 : d__[j] = tmp;
10864 0 : goto L90;
10865 : }
10866 3 : if (j - start > endd - j - 1) {
10867 : ++stkpnt;
10868 : stack[(stkpnt << 1) - 2] = start;
10869 2 : stack[(stkpnt << 1) - 1] = j;
10870 2 : ++stkpnt;
10871 2 : stack[(stkpnt << 1) - 2] = j + 1;
10872 2 : stack[(stkpnt << 1) - 1] = endd;
10873 : } else {
10874 : ++stkpnt;
10875 1 : stack[(stkpnt << 1) - 2] = j + 1;
10876 1 : stack[(stkpnt << 1) - 1] = endd;
10877 1 : ++stkpnt;
10878 1 : stack[(stkpnt << 1) - 2] = start;
10879 1 : stack[(stkpnt << 1) - 1] = j;
10880 : }
10881 : }
10882 : }
10883 556774 : if (stkpnt > 0) {
10884 118 : goto L10;
10885 : }
10886 : return;
10887 :
10888 : }
10889 : }
10890 : }
10891 : #include "lapack.h"
10892 : #include "blas/blas.h"
10893 : namespace PLMD{
10894 : namespace lapack{
10895 : using namespace blas;
10896 :
10897 12 : void PLUMED_BLAS_F77_FUNC(dlasrt2,DLASRT2)(const char *id,
10898 : int *n,
10899 : double *d__,
10900 : int * key,
10901 : int *info)
10902 : {
10903 : int i__1, i__2;
10904 :
10905 : int i__, j;
10906 : double d1, d2, d3;
10907 : int dir;
10908 : double tmp;
10909 : int endd;
10910 : int stack[64];
10911 : double dmnmx;
10912 : int start;
10913 : int tmpkey, stkpnt;
10914 :
10915 12 : --key;
10916 12 : --d__;
10917 :
10918 12 : *info = 0;
10919 : dir = -1;
10920 12 : if (*id=='D' || *id=='d')
10921 : dir = 0;
10922 12 : else if (*id=='I' || *id=='i')
10923 : dir = 1;
10924 :
10925 : if (dir == -1) {
10926 0 : *info = -1;
10927 12 : } else if (*n < 0) {
10928 0 : *info = -2;
10929 : }
10930 12 : if (*info != 0) {
10931 : return;
10932 : }
10933 :
10934 12 : if (*n <= 1) {
10935 : return;
10936 : }
10937 :
10938 : stkpnt = 1;
10939 12 : stack[0] = 1;
10940 12 : stack[1] = *n;
10941 12 : L10:
10942 12 : start = stack[(stkpnt << 1) - 2];
10943 12 : endd = stack[(stkpnt << 1) - 1];
10944 12 : --stkpnt;
10945 12 : if (endd - start > 0) {
10946 :
10947 12 : if (dir == 0) {
10948 :
10949 : i__1 = endd;
10950 0 : for (i__ = start + 1; i__ <= i__1; ++i__) {
10951 : i__2 = start + 1;
10952 0 : for (j = i__; j >= i__2; --j) {
10953 0 : if (d__[j] > d__[j - 1]) {
10954 : dmnmx = d__[j];
10955 0 : d__[j] = d__[j - 1];
10956 0 : d__[j - 1] = dmnmx;
10957 0 : tmpkey = key[j];
10958 0 : key[j] = key[j - 1];
10959 0 : key[j - 1] = tmpkey;
10960 : } else {
10961 : break;
10962 : }
10963 : }
10964 : }
10965 :
10966 : } else {
10967 :
10968 : i__1 = endd;
10969 778 : for (i__ = start + 1; i__ <= i__1; ++i__) {
10970 : i__2 = start + 1;
10971 17390 : for (j = i__; j >= i__2; --j) {
10972 17302 : if (d__[j] < d__[j - 1]) {
10973 : dmnmx = d__[j];
10974 16624 : d__[j] = d__[j - 1];
10975 16624 : d__[j - 1] = dmnmx;
10976 16624 : tmpkey = key[j];
10977 16624 : key[j] = key[j - 1];
10978 16624 : key[j - 1] = tmpkey;
10979 : } else {
10980 : break;
10981 : }
10982 : }
10983 : }
10984 :
10985 : }
10986 :
10987 0 : } else if (endd - start > 20) {
10988 :
10989 0 : d1 = d__[start];
10990 0 : d2 = d__[endd];
10991 0 : i__ = (start + endd) / 2;
10992 0 : d3 = d__[i__];
10993 0 : if (d1 < d2) {
10994 0 : if (d3 < d1) {
10995 : dmnmx = d1;
10996 0 : } else if (d3 < d2) {
10997 : dmnmx = d3;
10998 : } else {
10999 : dmnmx = d2;
11000 : }
11001 : } else {
11002 0 : if (d3 < d2) {
11003 : dmnmx = d2;
11004 0 : } else if (d3 < d1) {
11005 : dmnmx = d3;
11006 : } else {
11007 : dmnmx = d1;
11008 : }
11009 : }
11010 :
11011 0 : if (dir == 0) {
11012 :
11013 0 : i__ = start - 1;
11014 0 : j = endd + 1;
11015 0 : L60:
11016 0 : L70:
11017 0 : --j;
11018 0 : if (d__[j] < dmnmx) {
11019 0 : goto L70;
11020 : }
11021 0 : L80:
11022 0 : ++i__;
11023 0 : if (d__[i__] > dmnmx) {
11024 0 : goto L80;
11025 : }
11026 0 : if (i__ < j) {
11027 : tmp = d__[i__];
11028 0 : d__[i__] = d__[j];
11029 0 : d__[j] = tmp;
11030 0 : tmpkey = key[j];
11031 0 : key[j] = key[i__];
11032 0 : key[i__] = tmpkey;
11033 0 : goto L60;
11034 : }
11035 0 : if (j - start > endd - j - 1) {
11036 : ++stkpnt;
11037 : stack[(stkpnt << 1) - 2] = start;
11038 0 : stack[(stkpnt << 1) - 1] = j;
11039 0 : ++stkpnt;
11040 0 : stack[(stkpnt << 1) - 2] = j + 1;
11041 0 : stack[(stkpnt << 1) - 1] = endd;
11042 : } else {
11043 : ++stkpnt;
11044 0 : stack[(stkpnt << 1) - 2] = j + 1;
11045 0 : stack[(stkpnt << 1) - 1] = endd;
11046 0 : ++stkpnt;
11047 0 : stack[(stkpnt << 1) - 2] = start;
11048 0 : stack[(stkpnt << 1) - 1] = j;
11049 : }
11050 : } else {
11051 :
11052 0 : i__ = start - 1;
11053 0 : j = endd + 1;
11054 0 : L90:
11055 0 : L100:
11056 0 : --j;
11057 0 : if (d__[j] > dmnmx) {
11058 0 : goto L100;
11059 : }
11060 0 : L110:
11061 0 : ++i__;
11062 0 : if (d__[i__] < dmnmx) {
11063 0 : goto L110;
11064 : }
11065 0 : if (i__ < j) {
11066 : tmp = d__[i__];
11067 0 : d__[i__] = d__[j];
11068 0 : d__[j] = tmp;
11069 0 : tmpkey = key[j];
11070 0 : key[j] = key[i__];
11071 0 : key[i__] = tmpkey;
11072 0 : goto L90;
11073 : }
11074 0 : if (j - start > endd - j - 1) {
11075 : ++stkpnt;
11076 : stack[(stkpnt << 1) - 2] = start;
11077 0 : stack[(stkpnt << 1) - 1] = j;
11078 0 : ++stkpnt;
11079 0 : stack[(stkpnt << 1) - 2] = j + 1;
11080 0 : stack[(stkpnt << 1) - 1] = endd;
11081 : } else {
11082 : ++stkpnt;
11083 0 : stack[(stkpnt << 1) - 2] = j + 1;
11084 0 : stack[(stkpnt << 1) - 1] = endd;
11085 0 : ++stkpnt;
11086 0 : stack[(stkpnt << 1) - 2] = start;
11087 0 : stack[(stkpnt << 1) - 1] = j;
11088 : }
11089 : }
11090 : }
11091 12 : if (stkpnt > 0) {
11092 0 : goto L10;
11093 : }
11094 :
11095 : return;
11096 : }
11097 : }
11098 : }
11099 : #include <cmath>
11100 : #include "real.h"
11101 : #include "lapack.h"
11102 :
11103 : #include "blas/blas.h"
11104 : namespace PLMD{
11105 : namespace lapack{
11106 : using namespace blas;
11107 : void
11108 0 : PLUMED_BLAS_F77_FUNC(dlassq,DLASSQ)(int *n,
11109 : double *x,
11110 : int *incx,
11111 : double *scale,
11112 : double *sumsq)
11113 : {
11114 : int ix;
11115 : double absxi,t;
11116 :
11117 0 : if(*n>0) {
11118 0 : for(ix=0;ix<=(*n-1)*(*incx);ix+=*incx) {
11119 0 : if(std::abs(x[ix])>PLUMED_GMX_DOUBLE_MIN) {
11120 : absxi = std::abs(x[ix]);
11121 0 : if(*scale<absxi) {
11122 0 : t = *scale/absxi;
11123 0 : t = t*t;
11124 0 : *sumsq = 1.0 + (*sumsq)*t;
11125 0 : *scale = absxi;
11126 : } else {
11127 0 : t = absxi/(*scale);
11128 0 : *sumsq += t*t;
11129 : }
11130 : }
11131 : }
11132 : }
11133 0 : return;
11134 : }
11135 : }
11136 : }
11137 : #include <cmath>
11138 : #include "lapack.h"
11139 : #include "lapack_limits.h"
11140 :
11141 : #include "real.h"
11142 :
11143 : #include "blas/blas.h"
11144 : namespace PLMD{
11145 : namespace lapack{
11146 : using namespace blas;
11147 : void
11148 180 : PLUMED_BLAS_F77_FUNC(dlasv2,DLASV2)(double *f,
11149 : double *g,
11150 : double *h__,
11151 : double *ssmin,
11152 : double *ssmax,
11153 : double *snr,
11154 : double *csr,
11155 : double *snl,
11156 : double *csl)
11157 : {
11158 : double d__1;
11159 :
11160 : double a, d__, l, m, r__, s, t, fa, ga, ha, ft, gt, ht, mm, tt,
11161 : clt, crt, slt, srt;
11162 : int pmax;
11163 : double temp;
11164 : int swap;
11165 : double tsign=1.0;
11166 : int gasmal;
11167 :
11168 180 : ft = *f;
11169 : fa = std::abs(ft);
11170 180 : ht = *h__;
11171 : ha = std::abs(*h__);
11172 :
11173 : pmax = 1;
11174 : swap = ha > fa;
11175 180 : if (swap) {
11176 : pmax = 3;
11177 : temp = ft;
11178 : ft = ht;
11179 : ht = temp;
11180 : temp = fa;
11181 : fa = ha;
11182 : ha = temp;
11183 :
11184 : }
11185 180 : gt = *g;
11186 : ga = std::abs(gt);
11187 180 : if (std::abs(ga)<PLUMED_GMX_DOUBLE_MIN) {
11188 :
11189 0 : *ssmin = ha;
11190 0 : *ssmax = fa;
11191 : clt = 1.;
11192 : crt = 1.;
11193 : slt = 0.;
11194 : srt = 0.;
11195 : } else {
11196 : gasmal = 1;
11197 180 : if (ga > fa) {
11198 : pmax = 2;
11199 1 : if (fa / ga < PLUMED_GMX_DOUBLE_EPS) {
11200 :
11201 : gasmal = 0;
11202 0 : *ssmax = ga;
11203 0 : if (ha > 1.) {
11204 0 : *ssmin = fa / (ga / ha);
11205 : } else {
11206 0 : *ssmin = fa / ga * ha;
11207 : }
11208 : clt = 1.;
11209 0 : slt = ht / gt;
11210 : srt = 1.;
11211 0 : crt = ft / gt;
11212 : }
11213 : }
11214 180 : if (gasmal) {
11215 :
11216 180 : d__ = fa - ha;
11217 180 : if ( std::abs( fa - d__ )<PLUMED_GMX_DOUBLE_EPS*std::abs( fa + d__ )) {
11218 : l = 1.;
11219 : } else {
11220 180 : l = d__ / fa;
11221 : }
11222 :
11223 180 : m = gt / ft;
11224 180 : t = 2. - l;
11225 :
11226 180 : mm = m * m;
11227 180 : tt = t * t;
11228 180 : s = std::sqrt(tt + mm);
11229 :
11230 180 : if ( std::abs(l)<PLUMED_GMX_DOUBLE_MIN) {
11231 : r__ = std::abs(m);
11232 : } else {
11233 180 : r__ = std::sqrt(l * l + mm);
11234 : }
11235 180 : a = (s + r__) * .5;
11236 :
11237 180 : *ssmin = ha / a;
11238 180 : *ssmax = fa * a;
11239 180 : if ( std::abs(mm)<PLUMED_GMX_DOUBLE_MIN) {
11240 :
11241 0 : if (std::abs(l)<PLUMED_GMX_DOUBLE_MIN) {
11242 0 : t = ( (ft>0) ? 2.0 : -2.0) * ( (gt>0) ? 1.0 : -1.0);
11243 : } else {
11244 0 : t = gt / ( (ft>0) ? d__ : -d__) + m / t;
11245 : }
11246 : } else {
11247 180 : t = (m / (s + t) + m / (r__ + l)) * (a + 1.);
11248 : }
11249 180 : l = std::sqrt(t * t + 4.);
11250 180 : crt = 2. / l;
11251 180 : srt = t / l;
11252 180 : clt = (crt + srt * m) / a;
11253 180 : slt = ht / ft * srt / a;
11254 : }
11255 : }
11256 180 : if (swap) {
11257 12 : *csl = srt;
11258 12 : *snl = crt;
11259 12 : *csr = slt;
11260 12 : *snr = clt;
11261 : } else {
11262 168 : *csl = clt;
11263 168 : *snl = slt;
11264 168 : *csr = crt;
11265 168 : *snr = srt;
11266 : }
11267 :
11268 180 : if (pmax == 1) {
11269 187 : tsign = ( (*csr>0) ? 1.0 : -1.0) * ( (*csl>0) ? 1.0 : -1.0) * ( (*f>0) ? 1.0 : -1.0);
11270 : }
11271 180 : if (pmax == 2) {
11272 2 : tsign = ( (*snr>0) ? 1.0 : -1.0) * ( (*csl>0) ? 1.0 : -1.0) * ( (*g>0) ? 1.0 : -1.0);
11273 : }
11274 180 : if (pmax == 3) {
11275 16 : tsign = ( (*snr>0) ? 1.0 : -1.0) * ( (*snl>0) ? 1.0 : -1.0) * ( (*h__>0) ? 1.0 : -1.0);
11276 : }
11277 180 : if(tsign<0)
11278 25 : *ssmax *= -1.0;
11279 205 : d__1 = tsign * ( (*f>0) ? 1.0 : -1.0) * ( (*h__>0) ? 1.0 : -1.0);
11280 180 : if(d__1<0)
11281 65 : *ssmin *= -1.0;
11282 180 : return;
11283 :
11284 : }
11285 : }
11286 : }
11287 : #include "lapack.h"
11288 :
11289 : /* LAPACK */
11290 : #include "blas/blas.h"
11291 : namespace PLMD{
11292 : namespace lapack{
11293 : using namespace blas;
11294 : void
11295 0 : PLUMED_BLAS_F77_FUNC(dlaswp,DLASWP)(int *n,
11296 : double *a,
11297 : int *lda,
11298 : int *k1,
11299 : int *k2,
11300 : int *ipiv,
11301 : int *incx)
11302 : {
11303 : int ix0,i1,i2,inc,n32;
11304 : int ix,i,j,ip,k;
11305 : double temp;
11306 :
11307 0 : if(*incx>0) {
11308 0 : ix0 = *k1 - 1;
11309 : i1 = *k1 - 1;
11310 0 : i2 = *k2;
11311 : inc = 1;
11312 0 : } else if(*incx<0) {
11313 0 : ix0 = *incx * (1- *k2);
11314 0 : i1 = *k2 - 1;
11315 0 : i2 = *k1;
11316 : inc = -1;
11317 : } else
11318 : return;
11319 :
11320 0 : n32 = *n / 32;
11321 :
11322 0 : n32 *= 32;
11323 :
11324 :
11325 0 : if(n32!=0) {
11326 0 : for(j=0;j<n32;j+=32) {
11327 : ix = ix0;
11328 0 : for(i=i1;i<i2;i+=inc,ix+=*incx) {
11329 0 : ip = ipiv[ix] - 1;
11330 0 : if(ip != i) {
11331 0 : for(k=j;k<j+32;k++) {
11332 0 : temp = a[(k)*(*lda)+i];
11333 0 : a[(k)*(*lda)+i] = a[(k)*(*lda)+ip];
11334 0 : a[(k)*(*lda)+ip] = temp;
11335 : }
11336 : }
11337 : }
11338 : }
11339 : }
11340 0 : if(n32!=*n) {
11341 : ix = ix0;
11342 0 : for(i=i1;i<i2;i+=inc,ix+=*incx) {
11343 0 : ip = ipiv[ix] - 1;
11344 0 : if(ip != i) {
11345 0 : for(k=n32;k<*n;k++) {
11346 0 : temp = a[(k)*(*lda)+i];
11347 0 : a[(k)*(*lda)+i] = a[(k)*(*lda)+ip];
11348 0 : a[(k)*(*lda)+ip] = temp;
11349 : }
11350 : }
11351 : }
11352 : }
11353 : return;
11354 : }
11355 : }
11356 : }
11357 : #include <cctype>
11358 : #include "blas/blas.h"
11359 : #include "lapack.h"
11360 : #include "lapack_limits.h"
11361 :
11362 :
11363 : #include "blas/blas.h"
11364 : namespace PLMD{
11365 : namespace lapack{
11366 : using namespace blas;
11367 : void
11368 19 : PLUMED_BLAS_F77_FUNC(dlatrd,DLATRD)(const char * uplo,
11369 : int * n,
11370 : int * nb,
11371 : double * a,
11372 : int * lda,
11373 : double * e,
11374 : double * tau,
11375 : double * w,
11376 : int * ldw)
11377 : {
11378 : int i,iw;
11379 : int ti1,ti2,ti3;
11380 : double one,zero,minusone,alpha;
11381 19 : const char ch=std::toupper(*uplo);
11382 :
11383 19 : one=1.0;
11384 19 : minusone=-1.0;
11385 19 : zero=0.0;
11386 :
11387 19 : if(*n<=0)
11388 : return;
11389 :
11390 19 : if(ch=='U') {
11391 532 : for(i=*n;i>=(*n-*nb+1);i--) {
11392 513 : iw = i -*n + *nb;
11393 :
11394 513 : if(i<*n) {
11395 494 : ti1 = *n-i;
11396 494 : ti2 = 1;
11397 : /* BLAS */
11398 494 : PLUMED_BLAS_F77_FUNC(dgemv,DGEMV)("N",&i,&ti1,&minusone, &(a[ i*(*lda) + 0]),lda,&(w[iw*(*ldw)+(i-1)]),
11399 494 : ldw,&one, &(a[ (i-1)*(*lda) + 0]), &ti2);
11400 : /* BLAS */
11401 494 : PLUMED_BLAS_F77_FUNC(dgemv,DGEMV)("N",&i,&ti1,&minusone, &(w[ iw*(*ldw) + 0]),ldw,&(a[i*(*lda)+(i-1)]),
11402 494 : lda,&one, &(a[ (i-1)*(*lda) + 0]), &ti2);
11403 : }
11404 :
11405 513 : if(i>1) {
11406 : /* Generate elementary reflector H(i) to annihilate
11407 : * A(1:i-2,i)
11408 : */
11409 513 : ti1 = i-1;
11410 513 : ti2 = 1;
11411 :
11412 : /* LAPACK */
11413 513 : PLUMED_BLAS_F77_FUNC(dlarfg,DLARFG)(&ti1,&(a[(i-1)*(*lda)+(i-2)]),&(a[(i-1)*(*lda)+0]),&ti2,&(tau[i-2]));
11414 :
11415 513 : e[i-2] = a[(i-1)*(*lda)+(i-2)];
11416 513 : a[(i-1)*(*lda)+(i-2)] = 1.0;
11417 :
11418 : /* Compute W(1:i-1,i) */
11419 513 : ti1 = i-1;
11420 513 : ti2 = 1;
11421 :
11422 : /* BLAS */
11423 513 : PLUMED_BLAS_F77_FUNC(dsymv,DSYMV)("U",&ti1,&one,a,lda,&(a[(i-1)*(*lda)+0]),&ti2,&zero,
11424 513 : &(w[(iw-1)*(*ldw)+0]),&ti2);
11425 513 : if(i<*n) {
11426 494 : ti1 = i-1;
11427 494 : ti2 = *n-i;
11428 494 : ti3 = 1;
11429 : /* BLAS */
11430 494 : PLUMED_BLAS_F77_FUNC(dgemv,DGEMV)("T",&ti1,&ti2,&one,&(w[iw*(*ldw)+0]),ldw,&(a[(i-1)*(*lda)+0]),&ti3,
11431 494 : &zero,&(w[(iw-1)*(*ldw)+i]),&ti3);
11432 :
11433 : /* BLAS */
11434 494 : PLUMED_BLAS_F77_FUNC(dgemv,DGEMV)("N",&ti1,&ti2,&minusone,&(a[i*(*lda)+0]),lda,&(w[(iw-1)*(*ldw)+i]),&ti3,
11435 494 : &one,&(w[(iw-1)*(*ldw)+0]),&ti3);
11436 :
11437 : /* BLAS */
11438 494 : PLUMED_BLAS_F77_FUNC(dgemv,DGEMV)("T",&ti1,&ti2,&one,&(a[i*(*lda)+0]),lda,&(a[(i-1)*(*lda)+0]),&ti3,
11439 494 : &zero,&(w[(iw-1)*(*ldw)+i]),&ti3);
11440 :
11441 : /* BLAS */
11442 494 : PLUMED_BLAS_F77_FUNC(dgemv,DGEMV)("N",&ti1,&ti2,&minusone,&(w[iw*(*ldw)+0]),ldw,&(w[(iw-1)*(*ldw)+i]),&ti3,
11443 494 : &one,&(w[(iw-1)*(*ldw)+0]),&ti3);
11444 : }
11445 :
11446 513 : ti1 = i-1;
11447 513 : ti2 = 1;
11448 : /* BLAS */
11449 513 : PLUMED_BLAS_F77_FUNC(dscal,DSCAL)(&ti1,&(tau[i-2]),&(w[(iw-1)*(*ldw)+0]),&ti2);
11450 :
11451 1026 : alpha = -0.5*tau[i-2]*PLUMED_BLAS_F77_FUNC(ddot,DDOT)(&ti1,&(w[(iw-1)*(*ldw)+0]),&ti2,
11452 513 : &(a[(i-1)*(*lda)+0]),&ti2);
11453 :
11454 : /* BLAS */
11455 513 : PLUMED_BLAS_F77_FUNC(daxpy,DAXPY)(&ti1,&alpha,&(a[(i-1)*(*lda)+0]),&ti2,&(w[(iw-1)*(*ldw)+0]),&ti2);
11456 :
11457 : }
11458 : }
11459 : } else {
11460 : /* lower */
11461 0 : for(i=1;i<=*nb;i++) {
11462 :
11463 0 : ti1 = *n-i+1;
11464 0 : ti2 = i-1;
11465 0 : ti3 = 1;
11466 : /* BLAS */
11467 0 : PLUMED_BLAS_F77_FUNC(dgemv,DGEMV)("N",&ti1,&ti2,&minusone, &(a[ i-1 ]),lda,&(w[ i-1 ]),
11468 0 : ldw,&one, &(a[ (i-1)*(*lda) + (i-1)]), &ti3);
11469 : /* BLAS */
11470 0 : PLUMED_BLAS_F77_FUNC(dgemv,DGEMV)("N",&ti1,&ti2,&minusone, &(w[ i-1 ]),ldw,&(a[ i-1 ]),
11471 0 : lda,&one, &(a[ (i-1)*(*lda) + (i-1)]), &ti3);
11472 :
11473 0 : if(i<*n) {
11474 0 : ti1 = *n - i;
11475 0 : ti2 = (*n < i+2 ) ? *n : (i+2);
11476 0 : ti3 = 1;
11477 : /* LAPACK */
11478 0 : PLUMED_BLAS_F77_FUNC(dlarfg,DLARFG)(&ti1,&(a[(i-1)*(*lda)+(i)]),&(a[(i-1)*(*lda)+(ti2-1)]),&ti3,&(tau[i-1]));
11479 0 : e[i-1] = a[(i-1)*(*lda)+(i)];
11480 0 : a[(i-1)*(*lda)+(i)] = 1.0;
11481 :
11482 0 : ti1 = *n - i;
11483 0 : ti2 = 1;
11484 0 : PLUMED_BLAS_F77_FUNC(dsymv,DSYMV)("L",&ti1,&one,&(a[i*(*lda)+i]),lda,&(a[(i-1)*(*lda)+i]),&ti2,
11485 0 : &zero,&(w[(i-1)*(*ldw)+i]),&ti2);
11486 0 : ti1 = *n - i;
11487 0 : ti2 = i-1;
11488 0 : ti3 = 1;
11489 : /* BLAS */
11490 0 : PLUMED_BLAS_F77_FUNC(dgemv,DGEMV)("T",&ti1,&ti2,&one,&(w[ i ]),ldw,&(a[(i-1)*(*lda)+i]),&ti3,
11491 0 : &zero,&(w[(i-1)*(*ldw)+0]),&ti3);
11492 :
11493 : /* BLAS */
11494 0 : PLUMED_BLAS_F77_FUNC(dgemv,DGEMV)("N",&ti1,&ti2,&minusone,&(a[ i ]),lda,&(w[(i-1)*(*ldw)+0]),&ti3,
11495 0 : &one,&(w[(i-1)*(*ldw)+i]),&ti3);
11496 :
11497 : /* BLAS */
11498 0 : PLUMED_BLAS_F77_FUNC(dgemv,DGEMV)("T",&ti1,&ti2,&one,&(a[ i ]),lda,&(a[(i-1)*(*lda)+i]),&ti3,
11499 0 : &zero,&(w[(i-1)*(*ldw)+0]),&ti3);
11500 :
11501 : /* BLAS */
11502 0 : PLUMED_BLAS_F77_FUNC(dgemv,DGEMV)("N",&ti1,&ti2,&minusone,&(w[ i ]),ldw,&(w[(i-1)*(*ldw)+0]),&ti3,
11503 0 : &one,&(w[(i-1)*(*ldw)+i]),&ti3);
11504 :
11505 0 : PLUMED_BLAS_F77_FUNC(dscal,DSCAL)(&ti1,&(tau[i-1]),&(w[(i-1)*(*ldw)+i]),&ti3);
11506 0 : alpha = -0.5*tau[i-1]*PLUMED_BLAS_F77_FUNC(ddot,DDOT)(&ti1,&(w[(i-1)*(*ldw)+i]),&ti3,
11507 0 : &(a[(i-1)*(*lda)+i]),&ti3);
11508 :
11509 0 : PLUMED_BLAS_F77_FUNC(daxpy,DAXPY)(&ti1,&alpha,&(a[(i-1)*(*lda)+i]),&ti3,&(w[(i-1)*(*ldw)+i]),&ti3);
11510 : }
11511 : }
11512 : }
11513 : return;
11514 : }
11515 :
11516 :
11517 :
11518 :
11519 : }
11520 : }
11521 : #include <cmath>
11522 :
11523 : #include "blas/blas.h"
11524 : #include "lapack.h"
11525 :
11526 : #include "blas/blas.h"
11527 : namespace PLMD{
11528 : namespace lapack{
11529 : using namespace blas;
11530 : void
11531 1 : PLUMED_BLAS_F77_FUNC(dorg2r,DORG2R)(int *m,
11532 : int *n,
11533 : int *k,
11534 : double *a,
11535 : int *lda,
11536 : double *tau,
11537 : double *work,
11538 : int *info)
11539 : {
11540 : int a_dim1, a_offset, i__1, i__2;
11541 : double r__1;
11542 1 : int c__1 = 1;
11543 :
11544 : int i__, j, l;
11545 :
11546 1 : a_dim1 = *lda;
11547 1 : a_offset = 1 + a_dim1;
11548 1 : a -= a_offset;
11549 1 : --tau;
11550 : --work;
11551 :
11552 1 : *info = 0;
11553 :
11554 1 : if (*n <= 0) {
11555 : return;
11556 : }
11557 :
11558 1 : i__1 = *n;
11559 2 : for (j = *k + 1; j <= i__1; ++j) {
11560 1 : i__2 = *m;
11561 4 : for (l = 1; l <= i__2; ++l) {
11562 3 : a[l + j * a_dim1] = 0.0;
11563 : }
11564 1 : a[j + j * a_dim1] = 1.0;
11565 : }
11566 3 : for (i__ = *k; i__ >= 1; --i__) {
11567 2 : if (i__ < *n) {
11568 2 : a[i__ + i__ * a_dim1] = 1.0;
11569 2 : i__1 = *m - i__ + 1;
11570 2 : i__2 = *n - i__;
11571 2 : PLUMED_BLAS_F77_FUNC(dlarf,DLARF)("L", &i__1, &i__2, &a[i__ + i__ * a_dim1], &c__1,
11572 2 : &tau[i__], &a[i__ + (i__ + 1) * a_dim1], lda, &work[1]);
11573 : }
11574 2 : if (i__ < *m) {
11575 2 : i__1 = *m - i__;
11576 2 : r__1 = -tau[i__];
11577 2 : PLUMED_BLAS_F77_FUNC(dscal,DSCAL)(&i__1, &r__1, &a[i__ + 1 + i__ * a_dim1], &c__1);
11578 : }
11579 2 : a[i__ + i__ * a_dim1] = 1.0 - tau[i__];
11580 2 : i__1 = i__ - 1;
11581 3 : for (l = 1; l <= i__1; ++l) {
11582 1 : a[l + i__ * a_dim1] = 0.0;
11583 : }
11584 : }
11585 : return;
11586 :
11587 : }
11588 :
11589 :
11590 : }
11591 : }
11592 : #include "lapack.h"
11593 : #include "lapack_limits.h"
11594 :
11595 : #include "blas/blas.h"
11596 : namespace PLMD{
11597 : namespace lapack{
11598 : using namespace blas;
11599 : void
11600 0 : PLUMED_BLAS_F77_FUNC(dorgbr,DORGBR)(const char *vect,
11601 : int *m,
11602 : int *n,
11603 : int *k,
11604 : double *a,
11605 : int *lda,
11606 : double *tau,
11607 : double *work,
11608 : int *lwork,
11609 : int *info)
11610 : {
11611 : int wantq,iinfo,j,i,i1,wrksz;
11612 0 : int mn = (*m < *n) ? *m : *n;
11613 :
11614 0 : wantq = (*vect=='Q' || *vect=='q');
11615 :
11616 0 : *info = 0;
11617 0 : wrksz = mn*DORGBR_BLOCKSIZE;
11618 0 : if(*lwork==-1) {
11619 0 : work[0] = wrksz;
11620 0 : return;
11621 : }
11622 :
11623 0 : if(*m==0 || *n==0)
11624 : return;
11625 :
11626 0 : if(wantq) {
11627 0 : if(*m>=*k)
11628 0 : PLUMED_BLAS_F77_FUNC(dorgqr,DORGQR)(m,n,k,a,lda,tau,work,lwork,&iinfo);
11629 : else {
11630 0 : for(j=*m;j>=2;j--) {
11631 0 : a[(j-1)*(*lda)+0] = 0.0;
11632 0 : for(i=j+1;i<=*m;i++)
11633 0 : a[(j-1)*(*lda)+(i-1)] = a[(j-2)*(*lda)+(i-1)];
11634 : }
11635 0 : a[0] = 1.0;
11636 0 : for(i=2;i<=*m;i++)
11637 0 : a[i-1] = 0.0;
11638 0 : if(*m>1) {
11639 0 : i1 = *m-1;
11640 0 : PLUMED_BLAS_F77_FUNC(dorgqr,DORGQR)(&i1,&i1,&i1,&(a[*lda+1]),lda,tau,work,lwork,&iinfo);
11641 : }
11642 : }
11643 : } else {
11644 0 : if(*k<*n)
11645 0 : PLUMED_BLAS_F77_FUNC(dorglq,DORGLQ)(m,n,k,a,lda,tau,work,lwork,&iinfo);
11646 : else {
11647 0 : a[0] = 1.0;
11648 0 : for(i=2;i<=*m;i++)
11649 0 : a[i-1] = 0.0;
11650 0 : for(j=2;j<=*n;j++) {
11651 0 : for(i=j-1;i>=2;i--)
11652 0 : a[(j-1)*(*lda)+(i-1)] = a[(j-1)*(*lda)+(i-2)];
11653 0 : a[(j-1)*(*lda)+0] = 0.0;
11654 : }
11655 0 : if(*n>1) {
11656 0 : i1 = *n-1;
11657 0 : PLUMED_BLAS_F77_FUNC(dorglq,DORGLQ)(&i1,&i1,&i1,&(a[*lda+1]),lda,tau,work,lwork,&iinfo);
11658 : }
11659 : }
11660 : }
11661 0 : work[0] = wrksz;
11662 0 : return;
11663 : }
11664 :
11665 : }
11666 : }
11667 : #include "blas/blas.h"
11668 : #include "lapack.h"
11669 :
11670 : #include "blas/blas.h"
11671 : namespace PLMD{
11672 : namespace lapack{
11673 : using namespace blas;
11674 : void
11675 0 : PLUMED_BLAS_F77_FUNC(dorgl2,DORGL2)(int *m,
11676 : int *n,
11677 : int *k,
11678 : double *a,
11679 : int *lda,
11680 : double *tau,
11681 : double *work,
11682 : int *info)
11683 : {
11684 : int a_dim1, a_offset, i__1, i__2;
11685 : double r__1;
11686 :
11687 : int i__, j, l;
11688 :
11689 0 : a_dim1 = *lda;
11690 0 : a_offset = 1 + a_dim1;
11691 0 : a -= a_offset;
11692 0 : --tau;
11693 : --work;
11694 :
11695 0 : i__ = (*m > 1) ? *m : 1;
11696 :
11697 0 : *info = 0;
11698 0 : if (*m < 0) {
11699 0 : *info = -1;
11700 0 : } else if (*n < *m) {
11701 0 : *info = -2;
11702 0 : } else if (*k < 0 || *k > *m) {
11703 0 : *info = -3;
11704 0 : } else if (*lda < i__) {
11705 0 : *info = -5;
11706 : }
11707 0 : if (*info != 0) {
11708 : return;
11709 : }
11710 0 : if (*m <= 0) {
11711 : return;
11712 : }
11713 :
11714 0 : if (*k < *m) {
11715 0 : i__1 = *n;
11716 0 : for (j = 1; j <= i__1; ++j) {
11717 0 : i__2 = *m;
11718 0 : for (l = *k + 1; l <= i__2; ++l) {
11719 0 : a[l + j * a_dim1] = 0.0;
11720 : }
11721 0 : if (j > *k && j <= *m) {
11722 0 : a[j + j * a_dim1] = 1.0;
11723 : }
11724 : }
11725 : }
11726 :
11727 0 : for (i__ = *k; i__ >= 1; --i__) {
11728 0 : if (i__ < *n) {
11729 0 : if (i__ < *m) {
11730 0 : a[i__ + i__ * a_dim1] = 1.0;
11731 0 : i__1 = *m - i__;
11732 0 : i__2 = *n - i__ + 1;
11733 0 : PLUMED_BLAS_F77_FUNC(dlarf,DLARF)("R", &i__1, &i__2, &a[i__ + i__ * a_dim1], lda,
11734 0 : &tau[i__], &a[i__ + 1 + i__ * a_dim1], lda, &work[1]);
11735 : }
11736 0 : i__1 = *n - i__;
11737 0 : r__1 = -tau[i__];
11738 0 : PLUMED_BLAS_F77_FUNC(dscal,DSCAL)(&i__1, &r__1, &a[i__ + (i__ + 1) * a_dim1], lda);
11739 : }
11740 0 : a[i__ + i__ * a_dim1] = 1.0 - tau[i__];
11741 0 : i__1 = i__ - 1;
11742 0 : for (l = 1; l <= i__1; ++l) {
11743 0 : a[i__ + l * a_dim1] = 0.0;
11744 : }
11745 : }
11746 : return;
11747 :
11748 : }
11749 :
11750 :
11751 :
11752 : }
11753 : }
11754 : #include "lapack.h"
11755 :
11756 : #define DORGLQ_BLOCKSIZE 32
11757 : #define DORGLQ_MINBLOCKSIZE 2
11758 : #define DORGLQ_CROSSOVER 128
11759 :
11760 :
11761 : #include "blas/blas.h"
11762 : namespace PLMD{
11763 : namespace lapack{
11764 : using namespace blas;
11765 : void
11766 0 : PLUMED_BLAS_F77_FUNC(dorglq,DORGLQ)(int *m,
11767 : int *n,
11768 : int *k,
11769 : double *a,
11770 : int *lda,
11771 : double *tau,
11772 : double *work,
11773 : int *lwork,
11774 : int *info)
11775 : {
11776 : int a_dim1, a_offset, i__1, i__2, i__3;
11777 :
11778 : int i__, j, l, ib, nb, ki, kk, nx, iws, nbmin, iinfo;
11779 :
11780 : int ldwork, lwkopt;
11781 : int lquery;
11782 :
11783 0 : a_dim1 = *lda;
11784 0 : a_offset = 1 + a_dim1;
11785 0 : a -= a_offset;
11786 0 : --tau;
11787 : --work;
11788 :
11789 0 : *info = 0;
11790 : ki = 0;
11791 : nb = DORGLQ_BLOCKSIZE;
11792 0 : lwkopt = (*m) * nb;
11793 0 : work[1] = (double) lwkopt;
11794 0 : lquery = *lwork == -1;
11795 0 : if (*m < 0) {
11796 0 : *info = -1;
11797 0 : } else if (*n < *m) {
11798 0 : *info = -2;
11799 0 : } else if (*k < 0 || *k > *m) {
11800 0 : *info = -3;
11801 0 : } else if (*lda < (*m)) {
11802 0 : *info = -5;
11803 0 : } else if (*lwork < (*m) && ! lquery) {
11804 0 : *info = -8;
11805 : }
11806 0 : if (*info != 0) {
11807 : i__1 = -(*info);
11808 : return;
11809 0 : } else if (lquery) {
11810 : return;
11811 : }
11812 :
11813 0 : if (*m <= 0) {
11814 0 : work[1] = 1.;
11815 0 : return;
11816 : }
11817 :
11818 : nbmin = 2;
11819 : nx = 0;
11820 : iws = *m;
11821 0 : if (nb > 1 && nb < *k) {
11822 :
11823 : nx = DORGLQ_CROSSOVER;
11824 0 : if (nx < *k) {
11825 :
11826 0 : ldwork = *m;
11827 0 : iws = ldwork * nb;
11828 0 : if (*lwork < iws) {
11829 :
11830 0 : nb = *lwork / ldwork;
11831 : nbmin = DORGLQ_MINBLOCKSIZE;
11832 : }
11833 : }
11834 : }
11835 :
11836 0 : if (nb >= nbmin && nb < *k && nx < *k) {
11837 :
11838 0 : ki = (*k - nx - 1) / nb * nb;
11839 0 : i__1 = *k, i__2 = ki + nb;
11840 : kk = (i__1<i__2) ? i__1 : i__2;
11841 :
11842 0 : i__1 = kk;
11843 0 : for (j = 1; j <= i__1; ++j) {
11844 0 : i__2 = *m;
11845 0 : for (i__ = kk + 1; i__ <= i__2; ++i__) {
11846 0 : a[i__ + j * a_dim1] = 0.;
11847 : }
11848 : }
11849 : } else {
11850 : kk = 0;
11851 : }
11852 0 : if (kk < *m) {
11853 0 : i__1 = *m - kk;
11854 0 : i__2 = *n - kk;
11855 0 : i__3 = *k - kk;
11856 0 : PLUMED_BLAS_F77_FUNC(dorgl2,DORGL2)(&i__1, &i__2, &i__3, &a[kk + 1 + (kk + 1) * a_dim1], lda, &
11857 0 : tau[kk + 1], &work[1], &iinfo);
11858 : }
11859 :
11860 0 : if (kk > 0) {
11861 :
11862 0 : i__1 = -nb;
11863 0 : for (i__ = ki + 1; i__1 < 0 ? i__ >= 1 : i__ <= 1; i__ += i__1) {
11864 0 : i__2 = nb, i__3 = *k - i__ + 1;
11865 0 : ib = (i__2<i__3) ? i__2 : i__3;
11866 0 : if (i__ + ib <= *m) {
11867 :
11868 0 : i__2 = *n - i__ + 1;
11869 0 : PLUMED_BLAS_F77_FUNC(dlarft,DLARFT)("Forward", "Rowwise", &i__2, &ib, &a[i__ + i__ *
11870 0 : a_dim1], lda, &tau[i__], &work[1], &ldwork);
11871 :
11872 0 : i__2 = *m - i__ - ib + 1;
11873 0 : i__3 = *n - i__ + 1;
11874 0 : PLUMED_BLAS_F77_FUNC(dlarfb,DLARFB)("Right", "Transpose", "Forward", "Rowwise", &i__2, &
11875 : i__3, &ib, &a[i__ + i__ * a_dim1], lda, &work[1], &
11876 0 : ldwork, &a[i__ + ib + i__ * a_dim1], lda, &work[ib +
11877 0 : 1], &ldwork);
11878 : }
11879 :
11880 0 : i__2 = *n - i__ + 1;
11881 0 : PLUMED_BLAS_F77_FUNC(dorgl2,DORGL2)(&ib, &i__2, &ib, &a[i__ + i__ * a_dim1], lda, &tau[i__], &
11882 : work[1], &iinfo);
11883 :
11884 0 : i__2 = i__ - 1;
11885 0 : for (j = 1; j <= i__2; ++j) {
11886 0 : i__3 = i__ + ib - 1;
11887 0 : for (l = i__; l <= i__3; ++l) {
11888 0 : a[l + j * a_dim1] = 0.;
11889 : }
11890 : }
11891 : }
11892 : }
11893 :
11894 0 : work[1] = (double) iws;
11895 0 : return;
11896 :
11897 : }
11898 :
11899 :
11900 : }
11901 : }
11902 : #include "lapack.h"
11903 : #include "lapack_limits.h"
11904 :
11905 :
11906 : #include "blas/blas.h"
11907 : namespace PLMD{
11908 : namespace lapack{
11909 : using namespace blas;
11910 : void
11911 1 : PLUMED_BLAS_F77_FUNC(dorgqr,DORGQR)(int *m,
11912 : int *n,
11913 : int *k,
11914 : double *a,
11915 : int *lda,
11916 : double *tau,
11917 : double *work,
11918 : int *lwork,
11919 : int *info)
11920 : {
11921 : int a_dim1, a_offset, i__1, i__2, i__3;
11922 :
11923 : int i__, j, l, ib, nb, ki, kk, nx, iws, nbmin, iinfo;
11924 : int ldwork, lwkopt;
11925 : int lquery;
11926 :
11927 1 : a_dim1 = *lda;
11928 1 : a_offset = 1 + a_dim1;
11929 1 : a -= a_offset;
11930 1 : --tau;
11931 : --work;
11932 :
11933 : ki = 0;
11934 1 : *info = 0;
11935 : nb = DORGQR_BLOCKSIZE;
11936 1 : lwkopt = (*n) * nb;
11937 1 : work[1] = (double) lwkopt;
11938 1 : lquery = *lwork == -1;
11939 1 : if (*m < 0) {
11940 0 : *info = -1;
11941 1 : } else if (*n < 0 || *n > *m) {
11942 0 : *info = -2;
11943 1 : } else if (*k < 0 || *k > *n) {
11944 0 : *info = -3;
11945 1 : } else if (*lda < (*m)) {
11946 0 : *info = -5;
11947 1 : } else if (*lwork < (*n) && ! lquery) {
11948 0 : *info = -8;
11949 : }
11950 1 : if (*info != 0) {
11951 : i__1 = -(*info);
11952 : return;
11953 1 : } else if (lquery) {
11954 : return;
11955 : }
11956 :
11957 1 : if (*n <= 0) {
11958 0 : work[1] = 1.;
11959 0 : return;
11960 : }
11961 :
11962 : nbmin = 2;
11963 : nx = 0;
11964 : iws = *n;
11965 1 : if (nb > 1 && nb < *k) {
11966 :
11967 : nx = DORGQR_CROSSOVER;
11968 0 : if (nx < *k) {
11969 :
11970 0 : ldwork = *n;
11971 0 : iws = ldwork * nb;
11972 0 : if (*lwork < iws) {
11973 :
11974 0 : nb = *lwork / ldwork;
11975 : nbmin = DORGQR_MINBLOCKSIZE;
11976 : }
11977 : }
11978 : }
11979 :
11980 1 : if (nb >= nbmin && nb < *k && nx < *k) {
11981 :
11982 0 : ki = (*k - nx - 1) / nb * nb;
11983 0 : i__1 = *k, i__2 = ki + nb;
11984 : kk = (i__1<i__2) ? i__1 : i__2;
11985 :
11986 0 : i__1 = *n;
11987 0 : for (j = kk + 1; j <= i__1; ++j) {
11988 0 : i__2 = kk;
11989 0 : for (i__ = 1; i__ <= i__2; ++i__) {
11990 0 : a[i__ + j * a_dim1] = 0.;
11991 : }
11992 : }
11993 : } else {
11994 : kk = 0;
11995 : }
11996 :
11997 1 : if (kk < *n) {
11998 1 : i__1 = *m - kk;
11999 1 : i__2 = *n - kk;
12000 1 : i__3 = *k - kk;
12001 1 : PLUMED_BLAS_F77_FUNC(dorg2r,DORG2R)(&i__1, &i__2, &i__3, &a[kk + 1 + (kk + 1) * a_dim1], lda, &
12002 1 : tau[kk + 1], &work[1], &iinfo);
12003 : }
12004 :
12005 1 : if (kk > 0) {
12006 :
12007 0 : i__1 = -nb;
12008 0 : for (i__ = ki + 1; i__1 < 0 ? i__ >= 1 : i__ <= 1; i__ += i__1) {
12009 0 : i__2 = nb, i__3 = *k - i__ + 1;
12010 0 : ib = (i__2<i__3) ? i__2 : i__3;
12011 0 : if (i__ + ib <= *n) {
12012 :
12013 0 : i__2 = *m - i__ + 1;
12014 0 : PLUMED_BLAS_F77_FUNC(dlarft,DLARFT)("Forward", "Columnwise", &i__2, &ib, &a[i__ + i__ *
12015 0 : a_dim1], lda, &tau[i__], &work[1], &ldwork);
12016 :
12017 0 : i__2 = *m - i__ + 1;
12018 0 : i__3 = *n - i__ - ib + 1;
12019 0 : PLUMED_BLAS_F77_FUNC(dlarfb,DLARFB)("Left", "No transpose", "Forward", "Columnwise", &
12020 : i__2, &i__3, &ib, &a[i__ + i__ * a_dim1], lda, &work[
12021 0 : 1], &ldwork, &a[i__ + (i__ + ib) * a_dim1], lda, &
12022 0 : work[ib + 1], &ldwork);
12023 : }
12024 :
12025 0 : i__2 = *m - i__ + 1;
12026 0 : PLUMED_BLAS_F77_FUNC(dorg2r,DORG2R)(&i__2, &ib, &ib, &a[i__ + i__ * a_dim1], lda, &tau[i__], &
12027 : work[1], &iinfo);
12028 :
12029 0 : i__2 = i__ + ib - 1;
12030 0 : for (j = i__; j <= i__2; ++j) {
12031 0 : i__3 = i__ - 1;
12032 0 : for (l = 1; l <= i__3; ++l) {
12033 0 : a[l + j * a_dim1] = 0.;
12034 : }
12035 : }
12036 : }
12037 : }
12038 :
12039 1 : work[1] = (double) iws;
12040 1 : return;
12041 :
12042 : }
12043 : }
12044 : }
12045 : #include "lapack.h"
12046 :
12047 : #include "blas/blas.h"
12048 : namespace PLMD{
12049 : namespace lapack{
12050 : using namespace blas;
12051 : void
12052 569952 : PLUMED_BLAS_F77_FUNC(dorm2l,DORM2L)(const char *side,
12053 : const char *trans,
12054 : int *m,
12055 : int *n,
12056 : int *k,
12057 : double *a,
12058 : int *lda,
12059 : double *tau,
12060 : double *c__,
12061 : int *ldc,
12062 : double *work,
12063 : int *info)
12064 : {
12065 : int a_dim1, a_offset, c_dim1, c_offset, i__1, i__2;
12066 569952 : int c__1 = 1;
12067 :
12068 : int i__, i1, i2, i3, mi, ni, nq;
12069 : double aii;
12070 : int left;
12071 : int notran;
12072 :
12073 569952 : a_dim1 = *lda;
12074 569952 : a_offset = 1 + a_dim1;
12075 569952 : a -= a_offset;
12076 : --tau;
12077 : c_dim1 = *ldc;
12078 : c_offset = 1 + c_dim1;
12079 : c__ -= c_offset;
12080 : --work;
12081 :
12082 : /* Function Body */
12083 569952 : *info = 0;
12084 569952 : left = (*side=='L' || *side=='l');
12085 569952 : notran = (*trans=='N' || *trans=='n');
12086 :
12087 569952 : if (left) {
12088 569952 : nq = *m;
12089 : } else {
12090 0 : nq = *n;
12091 : }
12092 : if (*info != 0) {
12093 : return;
12094 : }
12095 :
12096 569952 : if (*m == 0 || *n == 0 || *k == 0) {
12097 : return;
12098 : }
12099 :
12100 569952 : if ((left && notran) || (! left && ! notran)) {
12101 : i1 = 1;
12102 : i2 = *k;
12103 : i3 = 1;
12104 : } else {
12105 : i1 = *k;
12106 : i2 = 1;
12107 : i3 = -1;
12108 : }
12109 :
12110 569952 : if (left) {
12111 569952 : ni = *n;
12112 : } else {
12113 0 : mi = *m;
12114 : }
12115 :
12116 : i__1 = i2;
12117 : i__2 = i3;
12118 2252681 : for (i__ = i1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) {
12119 1682729 : if (left) {
12120 :
12121 1682729 : mi = *m - *k + i__;
12122 : } else {
12123 :
12124 0 : ni = *n - *k + i__;
12125 : }
12126 :
12127 1682729 : aii = a[nq - *k + i__ + i__ * a_dim1];
12128 1682729 : a[nq - *k + i__ + i__ * a_dim1] = 1.;
12129 1682729 : PLUMED_BLAS_F77_FUNC(dlarf,DLARF)(side, &mi, &ni, &a[i__ * a_dim1 + 1], &c__1, &tau[i__], &c__[
12130 : c_offset], ldc, &work[1]);
12131 1682729 : a[nq - *k + i__ + i__ * a_dim1] = aii;
12132 : }
12133 : return;
12134 : }
12135 : }
12136 : }
12137 : #include "lapack.h"
12138 :
12139 : #include "blas/blas.h"
12140 : namespace PLMD{
12141 : namespace lapack{
12142 : using namespace blas;
12143 : void
12144 79 : PLUMED_BLAS_F77_FUNC(dorm2r,DORM2R)(const char *side,
12145 : const char *trans,
12146 : int *m,
12147 : int *n,
12148 : int *k,
12149 : double *a,
12150 : int *lda,
12151 : double *tau,
12152 : double *c__,
12153 : int *ldc,
12154 : double *work,
12155 : int *info)
12156 : {
12157 : int a_dim1, a_offset, c_dim1, c_offset, i__1, i__2;
12158 :
12159 : int i__, i1, i2, i3, ic, jc, mi, ni;
12160 : double aii;
12161 : int left;
12162 : int notran;
12163 79 : int c__1 = 1;
12164 :
12165 79 : a_dim1 = *lda;
12166 79 : a_offset = 1 + a_dim1;
12167 79 : a -= a_offset;
12168 : --tau;
12169 79 : c_dim1 = *ldc;
12170 79 : c_offset = 1 + c_dim1;
12171 79 : c__ -= c_offset;
12172 : --work;
12173 79 : *info = 0;
12174 79 : left = (*side=='L' || *side=='l');
12175 79 : notran = (*trans=='N' || *trans=='n');
12176 :
12177 : ic = jc = 0;
12178 :
12179 79 : if (*m <= 0 || *n <= 0 || *k <= 0) {
12180 : return;
12181 : }
12182 :
12183 79 : if ((left && !notran) || (!left && notran)) {
12184 : i1 = 1;
12185 : i2 = *k;
12186 : i3 = 1;
12187 : } else {
12188 : i1 = *k;
12189 : i2 = 1;
12190 : i3 = -1;
12191 : }
12192 :
12193 79 : if (left) {
12194 79 : ni = *n;
12195 : jc = 1;
12196 : } else {
12197 0 : mi = *m;
12198 : ic = 1;
12199 : }
12200 :
12201 : i__1 = i2;
12202 : i__2 = i3;
12203 1547 : for (i__ = i1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) {
12204 1468 : if (left) {
12205 :
12206 1468 : mi = *m - i__ + 1;
12207 : ic = i__;
12208 : } else {
12209 :
12210 0 : ni = *n - i__ + 1;
12211 : jc = i__;
12212 : }
12213 :
12214 :
12215 1468 : aii = a[i__ + i__ * a_dim1];
12216 1468 : a[i__ + i__ * a_dim1] = 1.;
12217 1468 : PLUMED_BLAS_F77_FUNC(dlarf,DLARF)(side, &mi, &ni, &a[i__ + i__ * a_dim1], &c__1, &tau[i__], &c__[
12218 1468 : ic + jc * c_dim1], ldc, &work[1]);
12219 1468 : a[i__ + i__ * a_dim1] = aii;
12220 : }
12221 : return;
12222 :
12223 : }
12224 : }
12225 : }
12226 : #include "lapack.h"
12227 : #include "lapack_limits.h"
12228 :
12229 : #include "blas/blas.h"
12230 : namespace PLMD{
12231 : namespace lapack{
12232 : using namespace blas;
12233 : void
12234 192 : PLUMED_BLAS_F77_FUNC(dormbr,DORMBR)(const char *vect,
12235 : const char *side,
12236 : const char *trans,
12237 : int *m,
12238 : int *n,
12239 : int *k,
12240 : double *a,
12241 : int *lda,
12242 : double *tau,
12243 : double *c__,
12244 : int *ldc,
12245 : double *work,
12246 : int *lwork,
12247 : int *info)
12248 : {
12249 : int a_dim1, a_offset, c_dim1, c_offset, i__1;
12250 :
12251 :
12252 : int i1, i2, nb, mi, ni, nq, nw;
12253 : int left;
12254 : int iinfo;
12255 : int notran;
12256 : int applyq;
12257 : char transt[1];
12258 : int lwkopt;
12259 : int lquery;
12260 :
12261 192 : a_dim1 = *lda;
12262 192 : a_offset = 1 + a_dim1;
12263 192 : a -= a_offset;
12264 : --tau;
12265 192 : c_dim1 = *ldc;
12266 192 : c_offset = 1 + c_dim1;
12267 192 : c__ -= c_offset;
12268 : --work;
12269 192 : *info = 0;
12270 192 : applyq = (*vect=='Q' || *vect=='q');
12271 192 : left = (*side=='L' || *side=='l');
12272 192 : notran = (*trans=='N' || *trans=='n');
12273 192 : lquery = *lwork == -1;
12274 :
12275 192 : if (left) {
12276 96 : nq = *m;
12277 96 : nw = *n;
12278 : } else {
12279 96 : nq = *n;
12280 96 : nw = *m;
12281 : }
12282 :
12283 : nb = DORMQR_BLOCKSIZE;
12284 192 : lwkopt = nw * nb;
12285 192 : work[1] = (double) lwkopt;
12286 :
12287 192 : if (*info != 0) {
12288 : i__1 = -(*info);
12289 : return;
12290 192 : } else if (lquery) {
12291 : return;
12292 : }
12293 :
12294 192 : work[1] = 1.;
12295 192 : if (*m == 0 || *n == 0) {
12296 : return;
12297 : }
12298 :
12299 192 : if (applyq) {
12300 :
12301 96 : if (nq >= *k) {
12302 :
12303 96 : PLUMED_BLAS_F77_FUNC(dormqr,DORMQR)(side, trans, m, n, k, &a[a_offset], lda, &tau[1], &c__[
12304 : c_offset], ldc, &work[1], lwork, &iinfo);
12305 0 : } else if (nq > 1) {
12306 :
12307 0 : if (left) {
12308 0 : mi = *m - 1;
12309 0 : ni = *n;
12310 : i1 = 2;
12311 : i2 = 1;
12312 : } else {
12313 0 : mi = *m;
12314 0 : ni = *n - 1;
12315 : i1 = 1;
12316 : i2 = 2;
12317 : }
12318 0 : i__1 = nq - 1;
12319 0 : PLUMED_BLAS_F77_FUNC(dormqr,DORMQR)(side, trans, &mi, &ni, &i__1, &a[a_dim1 + 2], lda, &tau[1]
12320 0 : , &c__[i1 + i2 * c_dim1], ldc, &work[1], lwork, &iinfo);
12321 : }
12322 : } else {
12323 :
12324 96 : if (notran) {
12325 0 : *(unsigned char *)transt = 'T';
12326 : } else {
12327 96 : *(unsigned char *)transt = 'N';
12328 : }
12329 96 : if (nq > *k) {
12330 :
12331 0 : PLUMED_BLAS_F77_FUNC(dormlq,DORMLQ)(side, transt, m, n, k, &a[a_offset], lda, &tau[1], &c__[
12332 : c_offset], ldc, &work[1], lwork, &iinfo);
12333 96 : } else if (nq > 1) {
12334 :
12335 96 : if (left) {
12336 0 : mi = *m - 1;
12337 0 : ni = *n;
12338 : i1 = 2;
12339 : i2 = 1;
12340 : } else {
12341 96 : mi = *m;
12342 96 : ni = *n - 1;
12343 : i1 = 1;
12344 : i2 = 2;
12345 : }
12346 96 : i__1 = nq - 1;
12347 96 : PLUMED_BLAS_F77_FUNC(dormlq,DORMLQ)(side, transt, &mi, &ni, &i__1, &a[(a_dim1 << 1) + 1], lda,
12348 96 : &tau[1], &c__[i1 + i2 * c_dim1], ldc, &work[1], lwork, &
12349 : iinfo);
12350 : }
12351 : }
12352 192 : work[1] = (double) lwkopt;
12353 192 : return;
12354 :
12355 :
12356 : }
12357 :
12358 :
12359 : }
12360 : }
12361 : #include <cctype>
12362 : #include "lapack.h"
12363 : #include "real.h"
12364 :
12365 : #include "blas/blas.h"
12366 : namespace PLMD{
12367 : namespace lapack{
12368 : using namespace blas;
12369 : void
12370 83 : PLUMED_BLAS_F77_FUNC(dorml2,DORML2)(const char *side,
12371 : const char *trans,
12372 : int *m,
12373 : int *n,
12374 : int *k,
12375 : double *a,
12376 : int *lda,
12377 : double *tau,
12378 : double *c,
12379 : int *ldc,
12380 : double *work,
12381 : int *info)
12382 : {
12383 83 : const char xside=std::toupper(*side);
12384 83 : const char xtrans=std::toupper(*trans);
12385 : int i,i1,i2,i3,ni,mi,ic,jc;
12386 : double aii;
12387 :
12388 83 : if(*m<=0 || *n<=0 || *k<=0)
12389 : return;
12390 :
12391 : ic = jc = 0;
12392 :
12393 83 : if((xside=='L' && xtrans=='N') || (xside!='L' && xtrans!='N')) {
12394 : i1 = 0;
12395 : i2 = *k;
12396 : i3 = 1;
12397 : } else {
12398 83 : i1 = *k-1;
12399 : i2 = -1;
12400 : i3 = -1;
12401 : }
12402 :
12403 83 : if(xside=='L') {
12404 0 : ni = *n;
12405 : jc = 0;
12406 : } else {
12407 83 : mi = *m;
12408 : ic = 0;
12409 : }
12410 :
12411 1600 : for(i=i1;i!=i2;i+=i3) {
12412 1517 : if(xside=='L') {
12413 0 : mi = *m - i;
12414 : ic = i;
12415 : } else {
12416 1517 : ni = *n - i;
12417 : jc = i;
12418 : }
12419 1517 : aii = a[i*(*lda)+i];
12420 1517 : a[i*(*lda)+i] = 1.0;
12421 1517 : PLUMED_BLAS_F77_FUNC(dlarf,DLARF)(side,&mi,&ni,&(a[i*(*lda)+i]),lda,tau+i,
12422 1517 : &(c[jc*(*ldc)+ic]),ldc,work);
12423 1517 : a[i*(*lda)+i] = aii;
12424 : }
12425 : return;
12426 : }
12427 :
12428 : }
12429 : }
12430 : #include "lapack.h"
12431 : #include "lapack_limits.h"
12432 :
12433 :
12434 : #include "blas/blas.h"
12435 : namespace PLMD{
12436 : namespace lapack{
12437 : using namespace blas;
12438 : void
12439 96 : PLUMED_BLAS_F77_FUNC(dormlq,DORMLQ)(const char *side,
12440 : const char *trans,
12441 : int *m,
12442 : int *n,
12443 : int *k,
12444 : double *a,
12445 : int *lda,
12446 : double *tau,
12447 : double *c__,
12448 : int *ldc,
12449 : double *work,
12450 : int *lwork,
12451 : int *info)
12452 : {
12453 : int a_dim1, a_offset, c_dim1, c_offset, i__1, i__2, i__4,
12454 : i__5;
12455 :
12456 :
12457 : int i__;
12458 : double t[4160] /* was [65][64] */;
12459 : int i1, i2, i3, ib, ic, jc, nb, mi, ni, nq, nw, iws;
12460 : int left;
12461 : int nbmin, iinfo;
12462 : int notran;
12463 : int ldwork;
12464 : char transt[1];
12465 : int lwkopt;
12466 : int lquery;
12467 96 : int ldt = 65;
12468 :
12469 96 : a_dim1 = *lda;
12470 96 : a_offset = 1 + a_dim1;
12471 96 : a -= a_offset;
12472 : --tau;
12473 96 : c_dim1 = *ldc;
12474 96 : c_offset = 1 + c_dim1;
12475 96 : c__ -= c_offset;
12476 : --work;
12477 :
12478 : ic = jc = 0;
12479 :
12480 96 : *info = 0;
12481 96 : left = (*side=='L' || *side=='l');
12482 96 : notran = (*trans=='N' || *trans=='n');
12483 96 : lquery = *lwork == -1;
12484 :
12485 96 : if (left) {
12486 0 : nq = *m;
12487 0 : nw = *n;
12488 : } else {
12489 96 : nq = *n;
12490 96 : nw = *m;
12491 : }
12492 :
12493 : nb = DORMLQ_BLOCKSIZE;
12494 96 : lwkopt = nw * nb;
12495 96 : work[1] = (double) lwkopt;
12496 :
12497 96 : if (*info != 0) {
12498 : return;
12499 96 : } else if (lquery) {
12500 : return;
12501 : }
12502 :
12503 96 : if (*m == 0 || *n == 0 || *k == 0) {
12504 0 : work[1] = 1.;
12505 0 : return;
12506 : }
12507 :
12508 : nbmin = 2;
12509 96 : ldwork = nw;
12510 96 : if (nb > 1 && nb < *k) {
12511 : iws = nw * nb;
12512 13 : if (*lwork < iws) {
12513 0 : nb = *lwork / ldwork;
12514 : nbmin = DORMLQ_MINBLOCKSIZE;
12515 : }
12516 : }
12517 :
12518 96 : if (nb < nbmin || nb >= *k) {
12519 :
12520 :
12521 83 : PLUMED_BLAS_F77_FUNC(dorml2,DORML2)(side, trans, m, n, k, &a[a_offset], lda, &tau[1], &c__[
12522 : c_offset], ldc, &work[1], &iinfo);
12523 : } else {
12524 :
12525 13 : if ((left && notran) || (!left && !notran)) {
12526 : i1 = 1;
12527 : i2 = *k;
12528 : i3 = nb;
12529 : } else {
12530 13 : i1 = (*k - 1) / nb * nb + 1;
12531 : i2 = 1;
12532 13 : i3 = -nb;
12533 : }
12534 :
12535 13 : if (left) {
12536 0 : ni = *n;
12537 : jc = 1;
12538 : } else {
12539 13 : mi = *m;
12540 : ic = 1;
12541 : }
12542 :
12543 13 : if (notran) {
12544 13 : *(unsigned char *)transt = 'T';
12545 : } else {
12546 0 : *(unsigned char *)transt = 'N';
12547 : }
12548 :
12549 : i__1 = i2;
12550 : i__2 = i3;
12551 53 : for (i__ = i1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) {
12552 40 : i__4 = nb, i__5 = *k - i__ + 1;
12553 40 : ib = (i__4<i__5) ? i__4 : i__5;
12554 :
12555 40 : i__4 = nq - i__ + 1;
12556 40 : PLUMED_BLAS_F77_FUNC(dlarft,DLARFT)("Forward", "Rowwise", &i__4, &ib, &a[i__ + i__ * a_dim1],
12557 40 : lda, &tau[i__], t, &ldt);
12558 40 : if (left) {
12559 :
12560 0 : mi = *m - i__ + 1;
12561 : ic = i__;
12562 : } else {
12563 :
12564 40 : ni = *n - i__ + 1;
12565 : jc = i__;
12566 : }
12567 :
12568 40 : PLUMED_BLAS_F77_FUNC(dlarfb,DLARFB)(side, transt, "Forward", "Rowwise", &mi, &ni, &ib, &a[i__
12569 40 : + i__ * a_dim1], lda, t, &ldt, &c__[ic + jc * c_dim1],
12570 : ldc, &work[1], &ldwork);
12571 : }
12572 : }
12573 96 : work[1] = (double) lwkopt;
12574 96 : return;
12575 :
12576 : }
12577 :
12578 :
12579 : }
12580 : }
12581 : #include "lapack.h"
12582 : #include "lapack_limits.h"
12583 :
12584 : #include "blas/blas.h"
12585 : namespace PLMD{
12586 : namespace lapack{
12587 : using namespace blas;
12588 : void
12589 569964 : PLUMED_BLAS_F77_FUNC(dormql,DORMQL)(const char *side, const char *trans, int *m, int *n,
12590 : int *k, double *a, int *lda, double *tau, double *
12591 : c__, int *ldc, double *work, int *lwork, int *info)
12592 : {
12593 : int a_dim1, a_offset, c_dim1, c_offset, i__1, i__2, i__4, i__5;
12594 569964 : int c__65 = 65;
12595 :
12596 : int i__;
12597 : double t[4160];
12598 : int i1, i2, i3, ib, nb, mi, ni, nq, nw, iws;
12599 : int left;
12600 : int nbmin, iinfo;
12601 : int notran;
12602 : int ldwork, lwkopt;
12603 : int lquery;
12604 :
12605 :
12606 569964 : a_dim1 = *lda;
12607 569964 : a_offset = 1 + a_dim1;
12608 569964 : a -= a_offset;
12609 : --tau;
12610 : c_dim1 = *ldc;
12611 : c_offset = 1 + c_dim1;
12612 : c__ -= c_offset;
12613 : --work;
12614 :
12615 569964 : *info = 0;
12616 569964 : left = (*side=='L' || *side=='l');
12617 569964 : notran = (*trans=='N' || *trans=='n');
12618 569964 : lquery = *lwork == -1;
12619 :
12620 569964 : if (left) {
12621 569964 : nq = *m;
12622 569964 : nw = *n;
12623 : } else {
12624 0 : nq = *n;
12625 0 : nw = *m;
12626 : }
12627 :
12628 : nb = DORMQL_BLOCKSIZE;
12629 569964 : lwkopt = nw * nb;
12630 569964 : work[1] = (double) lwkopt;
12631 :
12632 569964 : if (*info != 0) {
12633 : return;
12634 569964 : } else if (lquery) {
12635 : return;
12636 : }
12637 :
12638 569964 : if (*m == 0 || *n == 0 || *k == 0) {
12639 0 : work[1] = 1.;
12640 0 : return;
12641 : }
12642 :
12643 : nbmin = 2;
12644 569964 : ldwork = nw;
12645 569964 : if (nb > 1 && nb < *k) {
12646 : iws = nw * nb;
12647 12 : if (*lwork < iws) {
12648 0 : nb = *lwork / ldwork;
12649 : nbmin = DORMQL_MINBLOCKSIZE;
12650 : }
12651 : }
12652 :
12653 569964 : if (nb < nbmin || nb >= *k) {
12654 :
12655 569952 : PLUMED_BLAS_F77_FUNC(dorm2l,DORM2L)(side, trans, m, n, k, &a[a_offset], lda, &tau[1], &c__[
12656 : c_offset], ldc, &work[1], &iinfo);
12657 : } else {
12658 :
12659 12 : if ((left && notran) || (! left && ! notran)) {
12660 : i1 = 1;
12661 : i2 = *k;
12662 : i3 = nb;
12663 : } else {
12664 0 : i1 = (*k - 1) / nb * nb + 1;
12665 : i2 = 1;
12666 0 : i3 = -nb;
12667 : }
12668 :
12669 12 : if (left) {
12670 12 : ni = *n;
12671 : } else {
12672 0 : mi = *m;
12673 : }
12674 :
12675 : i__1 = i2;
12676 : i__2 = i3;
12677 71 : for (i__ = i1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) {
12678 59 : i__4 = nb, i__5 = *k - i__ + 1;
12679 59 : ib = (i__4<i__5) ? i__4 : i__5;
12680 :
12681 59 : i__4 = nq - *k + i__ + ib - 1;
12682 59 : PLUMED_BLAS_F77_FUNC(dlarft,DLARFT)("Backward", "Columnwise", &i__4, &ib, &a[i__ * a_dim1 + 1]
12683 59 : , lda, &tau[i__], t, &c__65);
12684 59 : if (left) {
12685 :
12686 59 : mi = *m - *k + i__ + ib - 1;
12687 : } else {
12688 :
12689 0 : ni = *n - *k + i__ + ib - 1;
12690 : }
12691 :
12692 59 : PLUMED_BLAS_F77_FUNC(dlarfb,DLARFB)(side, trans, "Backward", "Columnwise", &mi, &ni, &ib, &a[
12693 : i__ * a_dim1 + 1], lda, t, &c__65, &c__[c_offset], ldc, &
12694 : work[1], &ldwork);
12695 : }
12696 : }
12697 569964 : work[1] = (double) lwkopt;
12698 569964 : return;
12699 :
12700 : }
12701 :
12702 :
12703 : }
12704 : }
12705 : #include "lapack.h"
12706 : #include "lapack_limits.h"
12707 :
12708 : #include "blas/blas.h"
12709 : namespace PLMD{
12710 : namespace lapack{
12711 : using namespace blas;
12712 : void
12713 96 : PLUMED_BLAS_F77_FUNC(dormqr,DORMQR)(const char *side,
12714 : const char *trans,
12715 : int *m,
12716 : int *n,
12717 : int *k,
12718 : double *a,
12719 : int *lda,
12720 : double *tau,
12721 : double *c__,
12722 : int *ldc,
12723 : double *work,
12724 : int *lwork,
12725 : int *info)
12726 : {
12727 : int a_dim1, a_offset, c_dim1, c_offset, i__1, i__2, i__4, i__5;
12728 :
12729 : int i__;
12730 : double t[4160];
12731 : int i1, i2, i3, ib, ic, jc, nb, mi, ni, nq, nw, iws;
12732 : int left;
12733 : int nbmin, iinfo;
12734 : int notran;
12735 : int ldwork, lwkopt;
12736 : int lquery;
12737 96 : int ldt = 65;
12738 :
12739 96 : a_dim1 = *lda;
12740 96 : a_offset = 1 + a_dim1;
12741 96 : a -= a_offset;
12742 : --tau;
12743 96 : c_dim1 = *ldc;
12744 96 : c_offset = 1 + c_dim1;
12745 96 : c__ -= c_offset;
12746 : --work;
12747 :
12748 96 : *info = 0;
12749 96 : left = (*side=='L' || *side=='l');
12750 96 : notran = (*trans=='N' || *trans=='n');
12751 96 : lquery = *lwork == -1;
12752 :
12753 96 : if (left) {
12754 96 : nq = *m;
12755 96 : nw = *n;
12756 : } else {
12757 0 : nq = *n;
12758 0 : nw = *m;
12759 : }
12760 :
12761 : ic = jc = 0;
12762 : nb = DORMQR_BLOCKSIZE;
12763 96 : lwkopt = nw * nb;
12764 96 : work[1] = (double) lwkopt;
12765 :
12766 96 : if (*info != 0) {
12767 : return;
12768 96 : } else if (lquery) {
12769 : return;
12770 : }
12771 :
12772 96 : if (*m == 0 || *n == 0 || *k == 0) {
12773 0 : work[1] = 1.;
12774 0 : return;
12775 : }
12776 :
12777 : nbmin = 2;
12778 96 : ldwork = nw;
12779 96 : if (nb > 1 && nb < *k) {
12780 : iws = nw * nb;
12781 17 : if (*lwork < iws) {
12782 0 : nb = *lwork / ldwork;
12783 : nbmin = DORMQR_MINBLOCKSIZE;
12784 : }
12785 : }
12786 :
12787 96 : if (nb < nbmin || nb >= *k) {
12788 :
12789 79 : PLUMED_BLAS_F77_FUNC(dorm2r,DORM2R)(side, trans, m, n, k, &a[a_offset], lda, &tau[1], &c__[
12790 : c_offset], ldc, &work[1], &iinfo);
12791 : } else {
12792 :
12793 17 : if ((left && !notran) || (!left && notran)) {
12794 : i1 = 1;
12795 : i2 = *k;
12796 : i3 = nb;
12797 : } else {
12798 17 : i1 = (*k - 1) / nb * nb + 1;
12799 : i2 = 1;
12800 17 : i3 = -nb;
12801 : }
12802 :
12803 17 : if (left) {
12804 17 : ni = *n;
12805 : jc = 1;
12806 : } else {
12807 0 : mi = *m;
12808 : ic = 1;
12809 : }
12810 :
12811 : i__1 = i2;
12812 : i__2 = i3;
12813 65 : for (i__ = i1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) {
12814 48 : i__4 = nb, i__5 = *k - i__ + 1;
12815 48 : ib = (i__4<i__5) ? i__4 : i__5;
12816 :
12817 48 : i__4 = nq - i__ + 1;
12818 48 : PLUMED_BLAS_F77_FUNC(dlarft,DLARFT)("Forward", "Columnwise", &i__4, &ib, &a[i__ + i__ *
12819 48 : a_dim1], lda, &tau[i__], t, &ldt);
12820 48 : if (left) {
12821 :
12822 48 : mi = *m - i__ + 1;
12823 : ic = i__;
12824 : } else {
12825 0 : ni = *n - i__ + 1;
12826 : jc = i__;
12827 : }
12828 :
12829 48 : PLUMED_BLAS_F77_FUNC(dlarfb,DLARFB)(side, trans, "Forward", "Columnwise", &mi, &ni, &ib, &a[
12830 48 : i__ + i__ * a_dim1], lda, t, &ldt, &c__[ic + jc *
12831 : c_dim1], ldc, &work[1], &ldwork);
12832 : }
12833 : }
12834 96 : work[1] = (double) lwkopt;
12835 96 : return;
12836 :
12837 :
12838 : }
12839 :
12840 :
12841 : }
12842 : }
12843 : #include "lapack.h"
12844 : #include "lapack_limits.h"
12845 :
12846 :
12847 : #include "blas/blas.h"
12848 : namespace PLMD{
12849 : namespace lapack{
12850 : using namespace blas;
12851 : void
12852 569964 : PLUMED_BLAS_F77_FUNC(dormtr,DORMTR)(const char *side,
12853 : const char *uplo,
12854 : const char *trans,
12855 : int *m,
12856 : int *n,
12857 : double *a,
12858 : int *lda,
12859 : double *tau,
12860 : double *c__,
12861 : int *ldc,
12862 : double *work,
12863 : int *lwork,
12864 : int *info)
12865 : {
12866 : int a_dim1, a_offset, c_dim1, c_offset, i__2;
12867 :
12868 : int i1, i2, nb, mi, ni, nq, nw;
12869 : int left;
12870 : int iinfo;
12871 : int upper;
12872 : int lwkopt;
12873 : int lquery;
12874 :
12875 :
12876 569964 : a_dim1 = *lda;
12877 569964 : a_offset = 1 + a_dim1;
12878 569964 : a -= a_offset;
12879 : --tau;
12880 569964 : c_dim1 = *ldc;
12881 569964 : c_offset = 1 + c_dim1;
12882 569964 : c__ -= c_offset;
12883 : --work;
12884 :
12885 569964 : *info = 0;
12886 569964 : left = (*side=='L' || *side=='l');
12887 569964 : upper = (*uplo=='U' || *uplo=='u');
12888 569964 : lquery = *lwork == -1;
12889 :
12890 569964 : if (left) {
12891 569964 : nq = *m;
12892 569964 : nw = *n;
12893 : } else {
12894 0 : nq = *n;
12895 0 : nw = *m;
12896 : }
12897 :
12898 :
12899 : nb = DORMQL_BLOCKSIZE;
12900 569964 : lwkopt = nw * nb;
12901 569964 : work[1] = (double) lwkopt;
12902 :
12903 569964 : if (*info != 0) {
12904 : i__2 = -(*info);
12905 : return;
12906 569964 : } else if (lquery) {
12907 : return;
12908 : }
12909 :
12910 569964 : if (*m == 0 || *n == 0 || nq == 1) {
12911 0 : work[1] = 1.;
12912 0 : return;
12913 : }
12914 :
12915 569964 : if (left) {
12916 569964 : mi = *m - 1;
12917 569964 : ni = *n;
12918 : } else {
12919 0 : mi = *m;
12920 0 : ni = *n - 1;
12921 : }
12922 :
12923 569964 : if (upper) {
12924 569964 : i__2 = nq - 1;
12925 569964 : PLUMED_BLAS_F77_FUNC(dormql,DORMQL)(side, trans, &mi, &ni, &i__2, &a[(a_dim1 << 1) + 1], lda, &
12926 : tau[1], &c__[c_offset], ldc, &work[1], lwork, &iinfo);
12927 : } else {
12928 0 : if (left) {
12929 : i1 = 2;
12930 : i2 = 1;
12931 : } else {
12932 : i1 = 1;
12933 : i2 = 2;
12934 : }
12935 0 : i__2 = nq - 1;
12936 0 : PLUMED_BLAS_F77_FUNC(dormqr,DORMQR)(side, trans, &mi, &ni, &i__2, &a[a_dim1 + 2], lda, &tau[1], &
12937 0 : c__[i1 + i2 * c_dim1], ldc, &work[1], lwork, &iinfo);
12938 : }
12939 569964 : work[1] = (double) lwkopt;
12940 569964 : return;
12941 :
12942 : }
12943 :
12944 :
12945 : }
12946 : }
12947 : #include <cmath>
12948 : #include "lapack.h"
12949 : #include "lapack_limits.h"
12950 :
12951 : #include "real.h"
12952 :
12953 : #include "blas/blas.h"
12954 : namespace PLMD{
12955 : namespace lapack{
12956 : using namespace blas;
12957 : void
12958 0 : PLUMED_BLAS_F77_FUNC(dstebz,DSTEBZ)(const char *range,
12959 : const char *order,
12960 : int *n,
12961 : double *vl,
12962 : double *vu,
12963 : int *il,
12964 : int *iu,
12965 : double *abstol,
12966 : double *d__,
12967 : double *e,
12968 : int *m,
12969 : int *nsplit,
12970 : double *w,
12971 : int *iblock,
12972 : int *isplit,
12973 : double *work,
12974 : int *iwork,
12975 : int *info)
12976 : {
12977 : int i__1, i__2, i__3;
12978 : double d__1, d__2, d__3, d__4, d__5;
12979 0 : int c__1 = 1;
12980 0 : int c__3 = 3;
12981 0 : int c__2 = 2;
12982 0 : int c__0 = 0;
12983 :
12984 : int j, ib, jb, ie, je, nb;
12985 : double gl;
12986 : int im, in;
12987 : double gu;
12988 : int iw;
12989 : double wl, wu;
12990 : int nwl;
12991 : double ulp, wlu, wul;
12992 : int nwu;
12993 : double tmp1, tmp2;
12994 : int iend, ioff, iout, itmp1, jdisc;
12995 : int iinfo;
12996 : double atoli;
12997 : int iwoff;
12998 : double bnorm;
12999 : int itmax;
13000 : double wkill, rtoli, tnorm;
13001 : int ibegin;
13002 : int irange, idiscl;
13003 : int idumma[1];
13004 : int idiscu, iorder;
13005 : int ncnvrg;
13006 : double pivmin;
13007 : int toofew;
13008 : const double safemn = PLUMED_GMX_DOUBLE_MIN*(1.0+PLUMED_GMX_DOUBLE_EPS);
13009 :
13010 0 : --iwork;
13011 0 : --work;
13012 0 : --isplit;
13013 0 : --iblock;
13014 0 : --w;
13015 0 : --e;
13016 0 : --d__;
13017 :
13018 0 : *info = 0;
13019 :
13020 0 : if (*range=='A' || *range=='a') {
13021 : irange = 1;
13022 0 : } else if (*range=='V' || *range=='v') {
13023 : irange = 2;
13024 : } else if (*range=='I' || *range=='i') {
13025 : irange = 3;
13026 : } else {
13027 : irange = 0;
13028 : }
13029 :
13030 0 : if (*order=='B' || *order=='b') {
13031 : iorder = 2;
13032 0 : } else if (*order=='E' || *order=='e') {
13033 : iorder = 1;
13034 : } else {
13035 : iorder = 0;
13036 : }
13037 :
13038 0 : if (irange <= 0) {
13039 0 : *info = -1;
13040 0 : } else if (iorder <= 0) {
13041 0 : *info = -2;
13042 0 : } else if (*n < 0) {
13043 0 : *info = -3;
13044 0 : } else if (irange == 2) {
13045 0 : if (*vl >= *vu) {
13046 0 : *info = -5;
13047 : }
13048 0 : } else if (irange == 3 && (*il < 1 || *il > (*n))) {
13049 0 : *info = -6;
13050 0 : } else if (irange == 3 && (*iu < ((*n<*il) ? *n : *il) || *iu > *n)) {
13051 0 : *info = -7;
13052 : }
13053 :
13054 0 : if (*info != 0) {
13055 : return;
13056 : }
13057 :
13058 0 : *info = 0;
13059 : ncnvrg = 0;
13060 : toofew = 0;
13061 :
13062 0 : *m = 0;
13063 0 : if (*n == 0) {
13064 : return;
13065 : }
13066 :
13067 0 : if (irange == 3 && *il == 1 && *iu == *n) {
13068 : irange = 1;
13069 : }
13070 :
13071 : ulp = 2*PLUMED_GMX_DOUBLE_EPS;
13072 0 : rtoli = ulp * 2.;
13073 : nb = DSTEBZ_BLOCKSIZE;
13074 : // cppcheck-suppress knownConditionTrueFalse
13075 : if (nb <= 1) {
13076 0 : nb = 0;
13077 : }
13078 :
13079 0 : if (*n == 1) {
13080 0 : *nsplit = 1;
13081 0 : isplit[1] = 1;
13082 0 : if (irange == 2 && (*vl >= d__[1] || *vu < d__[1])) {
13083 0 : *m = 0;
13084 : } else {
13085 0 : w[1] = d__[1];
13086 0 : iblock[1] = 1;
13087 0 : *m = 1;
13088 : }
13089 0 : return;
13090 : }
13091 :
13092 0 : *nsplit = 1;
13093 0 : work[*n] = 0.;
13094 0 : pivmin = 1.;
13095 0 : i__1 = *n;
13096 0 : for (j = 2; j <= i__1; ++j) {
13097 0 : d__1 = e[j - 1];
13098 0 : tmp1 = d__1 * d__1;
13099 : d__2 = ulp;
13100 0 : if (std::abs(d__[j] * d__[j - 1]) * (d__2 * d__2) + safemn
13101 : > tmp1) {
13102 0 : isplit[*nsplit] = j - 1;
13103 0 : ++(*nsplit);
13104 0 : work[j - 1] = 0.;
13105 : } else {
13106 0 : work[j - 1] = tmp1;
13107 0 : pivmin = (pivmin>tmp1) ? pivmin : tmp1;
13108 : }
13109 : }
13110 0 : isplit[*nsplit] = *n;
13111 0 : pivmin *= safemn;
13112 :
13113 0 : if (irange == 3) {
13114 :
13115 0 : gu = d__[1];
13116 : gl = d__[1];
13117 : tmp1 = 0.;
13118 :
13119 : i__1 = *n - 1;
13120 0 : for (j = 1; j <= i__1; ++j) {
13121 0 : tmp2 = std::sqrt(work[j]);
13122 0 : d__1 = gu, d__2 = d__[j] + tmp1 + tmp2;
13123 0 : gu = (d__1>d__2) ? d__1 : d__2;
13124 0 : d__1 = gl, d__2 = d__[j] - tmp1 - tmp2;
13125 0 : gl = (d__1<d__2) ? d__1 : d__2;
13126 : tmp1 = tmp2;
13127 : }
13128 :
13129 0 : d__1 = gu, d__2 = d__[*n] + tmp1;
13130 0 : gu = (d__1>d__2) ? d__1 : d__2;
13131 0 : d__1 = gl, d__2 = d__[*n] - tmp1;
13132 0 : gl = (d__1<d__2) ? d__1 : d__2;
13133 : d__1 = std::abs(gl);
13134 : d__2 = std::abs(gu);
13135 0 : tnorm = (d__1>d__2) ? d__1 : d__2;
13136 0 : gl = gl - tnorm * 2. * ulp * *n - pivmin * 4.;
13137 0 : gu = gu + tnorm * 2. * ulp * *n + pivmin * 2.;
13138 :
13139 0 : itmax = (int) ((std::log(tnorm + pivmin) - std::log(pivmin)) / std::log(2.)) + 2;
13140 0 : if (*abstol <= 0.) {
13141 0 : atoli = ulp * tnorm;
13142 : } else {
13143 0 : atoli = *abstol;
13144 : }
13145 :
13146 0 : work[*n + 1] = gl;
13147 0 : work[*n + 2] = gl;
13148 0 : work[*n + 3] = gu;
13149 0 : work[*n + 4] = gu;
13150 0 : work[*n + 5] = gl;
13151 0 : work[*n + 6] = gu;
13152 0 : iwork[1] = -1;
13153 0 : iwork[2] = -1;
13154 0 : iwork[3] = *n + 1;
13155 0 : iwork[4] = *n + 1;
13156 0 : iwork[5] = *il - 1;
13157 0 : iwork[6] = *iu;
13158 :
13159 0 : PLUMED_BLAS_F77_FUNC(dlaebz,DLAEBZ)(&c__3, &itmax, n, &c__2, &c__2, &nb, &atoli, &rtoli, &pivmin,
13160 0 : &d__[1], &e[1], &work[1], &iwork[5], &work[*n + 1], &work[*n
13161 0 : + 5], &iout, &iwork[1], &w[1], &iblock[1], &iinfo);
13162 :
13163 0 : if (iwork[6] == *iu) {
13164 0 : wl = work[*n + 1];
13165 0 : wlu = work[*n + 3];
13166 0 : nwl = iwork[1];
13167 0 : wu = work[*n + 4];
13168 0 : wul = work[*n + 2];
13169 0 : nwu = iwork[4];
13170 : } else {
13171 0 : wl = work[*n + 2];
13172 0 : wlu = work[*n + 4];
13173 0 : nwl = iwork[2];
13174 0 : wu = work[*n + 3];
13175 0 : wul = work[*n + 1];
13176 0 : nwu = iwork[3];
13177 : }
13178 :
13179 0 : if (nwl < 0 || nwl >= *n || nwu < 1 || nwu > *n) {
13180 0 : *info = 4;
13181 0 : return;
13182 : }
13183 : } else {
13184 :
13185 :
13186 : /* avoid warnings for high gcc optimization */
13187 : wlu = wul = 1.0;
13188 :
13189 0 : d__3 = std::abs(d__[1]) + std::abs(e[1]);
13190 0 : d__4 = std::abs(d__[*n]) + std::abs(e[*n - 1]);
13191 0 : tnorm = (d__3>d__4) ? d__3 : d__4;
13192 :
13193 : i__1 = *n - 1;
13194 0 : for (j = 2; j <= i__1; ++j) {
13195 : d__4 = tnorm;
13196 0 : d__5 = std::abs(d__[j]) + std::abs(e[j - 1]) + std::abs(e[j]);
13197 0 : tnorm = (d__4>d__5) ? d__4 : d__5;
13198 : }
13199 :
13200 0 : if (*abstol <= 0.) {
13201 0 : atoli = ulp * tnorm;
13202 : } else {
13203 0 : atoli = *abstol;
13204 : }
13205 :
13206 0 : if (irange == 2) {
13207 0 : wl = *vl;
13208 0 : wu = *vu;
13209 : } else {
13210 : wl = 0.;
13211 : wu = 0.;
13212 : }
13213 : }
13214 :
13215 0 : *m = 0;
13216 : iend = 0;
13217 0 : *info = 0;
13218 : nwl = 0;
13219 : nwu = 0;
13220 :
13221 0 : i__1 = *nsplit;
13222 0 : for (jb = 1; jb <= i__1; ++jb) {
13223 : ioff = iend;
13224 0 : ibegin = ioff + 1;
13225 0 : iend = isplit[jb];
13226 0 : in = iend - ioff;
13227 :
13228 0 : if (in == 1) {
13229 :
13230 0 : if (irange == 1 || wl >= d__[ibegin] - pivmin) {
13231 0 : ++nwl;
13232 : }
13233 0 : if (irange == 1 || wu >= d__[ibegin] - pivmin) {
13234 0 : ++nwu;
13235 : }
13236 0 : if (irange == 1 || ((wl < d__[ibegin] - pivmin) && (wu >= d__[ibegin] - pivmin))) {
13237 0 : ++(*m);
13238 0 : w[*m] = d__[ibegin];
13239 0 : iblock[*m] = jb;
13240 : }
13241 : } else {
13242 :
13243 0 : gu = d__[ibegin];
13244 : gl = d__[ibegin];
13245 : tmp1 = 0.;
13246 :
13247 : i__2 = iend - 1;
13248 0 : for (j = ibegin; j <= i__2; ++j) {
13249 0 : tmp2 = std::abs(e[j]);
13250 0 : d__1 = gu, d__2 = d__[j] + tmp1 + tmp2;
13251 0 : gu = (d__1>d__2) ? d__1 : d__2;
13252 0 : d__1 = gl, d__2 = d__[j] - tmp1 - tmp2;
13253 0 : gl = (d__1<d__2) ? d__1 : d__2;
13254 : tmp1 = tmp2;
13255 : }
13256 :
13257 0 : d__1 = gu, d__2 = d__[iend] + tmp1;
13258 0 : gu = (d__1>d__2) ? d__1 : d__2;
13259 0 : d__1 = gl, d__2 = d__[iend] - tmp1;
13260 0 : gl = (d__1<d__2) ? d__1 : d__2;
13261 : d__1 = std::abs(gl);
13262 : d__2 = std::abs(gu);
13263 0 : bnorm = (d__1>d__2) ? d__1 : d__2;
13264 0 : gl = gl - bnorm * 2. * ulp * in - pivmin * 2.;
13265 0 : gu = gu + bnorm * 2. * ulp * in + pivmin * 2.;
13266 :
13267 0 : if (*abstol <= 0.) {
13268 : d__1 = std::abs(gl);
13269 : d__2 = std::abs(gu);
13270 0 : atoli = ulp * ((d__1>d__2) ? d__1 : d__2);
13271 : } else {
13272 0 : atoli = *abstol;
13273 : }
13274 :
13275 0 : if (irange > 1) {
13276 0 : if (gu < wl) {
13277 0 : nwl += in;
13278 0 : nwu += in;
13279 : }
13280 : gl = (gl>wl) ? gl : wl;
13281 : gu = (gu<wu) ? gu : wu;
13282 : if (gl >= gu) {
13283 : }
13284 0 : continue;
13285 : }
13286 :
13287 0 : work[*n + 1] = gl;
13288 0 : work[*n + in + 1] = gu;
13289 0 : PLUMED_BLAS_F77_FUNC(dlaebz,DLAEBZ)(&c__1, &c__0, &in, &in, &c__1, &nb, &atoli, &rtoli, &
13290 : pivmin, &d__[ibegin], &e[ibegin], &work[ibegin], idumma, &
13291 0 : work[*n + 1], &work[*n + (in << 1) + 1], &im, &iwork[1], &
13292 0 : w[*m + 1], &iblock[*m + 1], &iinfo);
13293 :
13294 0 : nwl += iwork[1];
13295 0 : nwu += iwork[in + 1];
13296 0 : iwoff = *m - iwork[1];
13297 :
13298 0 : itmax = (int) ((std::log(gu - gl + pivmin) - std::log(pivmin)) / std::log(2.)
13299 0 : ) + 2;
13300 0 : PLUMED_BLAS_F77_FUNC(dlaebz,DLAEBZ)(&c__2, &itmax, &in, &in, &c__1, &nb, &atoli, &rtoli, &
13301 : pivmin, &d__[ibegin], &e[ibegin], &work[ibegin], idumma, &
13302 0 : work[*n + 1], &work[*n + (in << 1) + 1], &iout, &iwork[1],
13303 0 : &w[*m + 1], &iblock[*m + 1], &iinfo);
13304 :
13305 0 : i__2 = iout;
13306 0 : for (j = 1; j <= i__2; ++j) {
13307 0 : tmp1 = (work[j + *n] + work[j + in + *n]) * .5;
13308 :
13309 0 : if (j > iout - iinfo) {
13310 : ncnvrg = 1;
13311 0 : ib = -jb;
13312 : } else {
13313 : ib = jb;
13314 : }
13315 0 : i__3 = iwork[j + in] + iwoff;
13316 0 : for (je = iwork[j] + 1 + iwoff; je <= i__3; ++je) {
13317 0 : w[je] = tmp1;
13318 0 : iblock[je] = ib;
13319 : }
13320 : }
13321 :
13322 0 : *m += im;
13323 : }
13324 : }
13325 :
13326 0 : if (irange == 3) {
13327 0 : im = 0;
13328 0 : idiscl = *il - 1 - nwl;
13329 0 : idiscu = nwu - *iu;
13330 :
13331 0 : if (idiscl > 0 || idiscu > 0) {
13332 0 : i__1 = *m;
13333 0 : for (je = 1; je <= i__1; ++je) {
13334 0 : if (w[je] <= wlu && idiscl > 0) {
13335 0 : --idiscl;
13336 0 : } else if (w[je] >= wul && idiscu > 0) {
13337 0 : --idiscu;
13338 : } else {
13339 0 : ++im;
13340 0 : w[im] = w[je];
13341 0 : iblock[im] = iblock[je];
13342 : }
13343 : }
13344 0 : *m = im;
13345 : }
13346 0 : if (idiscl > 0 || idiscu > 0) {
13347 :
13348 0 : if (idiscl > 0) {
13349 : wkill = wu;
13350 : i__1 = idiscl;
13351 0 : for (jdisc = 1; jdisc <= i__1; ++jdisc) {
13352 : iw = 0;
13353 0 : i__2 = *m;
13354 0 : for (je = 1; je <= i__2; ++je) {
13355 0 : if (iblock[je] != 0 && (w[je] < wkill || iw == 0)) {
13356 : iw = je;
13357 : wkill = w[je];
13358 : }
13359 : }
13360 0 : iblock[iw] = 0;
13361 : }
13362 : }
13363 0 : if (idiscu > 0) {
13364 :
13365 : wkill = wl;
13366 : i__1 = idiscu;
13367 0 : for (jdisc = 1; jdisc <= i__1; ++jdisc) {
13368 : iw = 0;
13369 0 : i__2 = *m;
13370 0 : for (je = 1; je <= i__2; ++je) {
13371 0 : if (iblock[je] != 0 && (w[je] > wkill || iw == 0)) {
13372 : iw = je;
13373 : wkill = w[je];
13374 : }
13375 : }
13376 0 : iblock[iw] = 0;
13377 : }
13378 : }
13379 0 : im = 0;
13380 0 : i__1 = *m;
13381 0 : for (je = 1; je <= i__1; ++je) {
13382 0 : if (iblock[je] != 0) {
13383 0 : ++im;
13384 0 : w[im] = w[je];
13385 0 : iblock[im] = iblock[je];
13386 : }
13387 : }
13388 0 : *m = im;
13389 : }
13390 0 : if (idiscl < 0 || idiscu < 0) {
13391 : toofew = 1;
13392 : }
13393 : }
13394 :
13395 0 : if (iorder == 1 && *nsplit > 1) {
13396 0 : i__1 = *m - 1;
13397 0 : for (je = 1; je <= i__1; ++je) {
13398 : ie = 0;
13399 0 : tmp1 = w[je];
13400 0 : i__2 = *m;
13401 0 : for (j = je + 1; j <= i__2; ++j) {
13402 0 : if (w[j] < tmp1) {
13403 : ie = j;
13404 : tmp1 = w[j];
13405 : }
13406 : }
13407 :
13408 0 : if (ie != 0) {
13409 0 : itmp1 = iblock[ie];
13410 0 : w[ie] = w[je];
13411 0 : iblock[ie] = iblock[je];
13412 0 : w[je] = tmp1;
13413 0 : iblock[je] = itmp1;
13414 : }
13415 : }
13416 : }
13417 :
13418 0 : *info = 0;
13419 0 : if (ncnvrg) {
13420 0 : ++(*info);
13421 : }
13422 0 : if (toofew) {
13423 0 : *info += 2;
13424 : }
13425 : return;
13426 :
13427 : }
13428 :
13429 :
13430 : }
13431 : }
13432 : #include <cmath>
13433 : #include "blas/blas.h"
13434 : #include "lapack.h"
13435 : #include "lapack_limits.h"
13436 :
13437 : #include "real.h"
13438 :
13439 : #include "blas/blas.h"
13440 : namespace PLMD{
13441 : namespace lapack{
13442 : using namespace blas;
13443 : void
13444 570008 : PLUMED_BLAS_F77_FUNC(dstegr,DSTEGR)(const char *jobz,
13445 : const char *range,
13446 : int *n,
13447 : double *d__,
13448 : double *e,
13449 : double *vl,
13450 : double *vu,
13451 : int *il,
13452 : int *iu,
13453 : double *abstol,
13454 : int *m,
13455 : double *w,
13456 : double *z__,
13457 : int *ldz,
13458 : int *isuppz,
13459 : double *work,
13460 : int *lwork,
13461 : int *iwork,
13462 : int *liwork,
13463 : int *info)
13464 : {
13465 : int z_dim1, z_offset, i__1, i__2;
13466 : double d__1, d__2;
13467 570008 : int c__1 = 1;
13468 :
13469 : int i__, j;
13470 : int jj;
13471 : double eps, tol, tmp, rmin, rmax;
13472 : int itmp;
13473 : double tnrm;
13474 : double scale;
13475 : int iinfo, iindw;
13476 : int lwmin;
13477 : int wantz;
13478 : int iindbl;
13479 : int valeig,alleig,indeig;
13480 : double safmin,minval;
13481 : double bignum;
13482 : int iindwk, indgrs;
13483 : double thresh;
13484 : int iinspl, indwrk, liwmin, nsplit;
13485 : double smlnum;
13486 : int lquery;
13487 :
13488 :
13489 : --d__;
13490 : --e;
13491 570008 : --w;
13492 570008 : z_dim1 = *ldz;
13493 570008 : z_offset = 1 + z_dim1;
13494 570008 : z__ -= z_offset;
13495 570008 : --isuppz;
13496 570008 : --work;
13497 570008 : --iwork;
13498 :
13499 570008 : wantz = (*jobz=='V' || *jobz=='v');
13500 570008 : alleig = (*range=='A' || *range=='a');
13501 570008 : valeig = (*range=='V' || *range=='v');
13502 570008 : indeig = (*range=='I' || *range=='i');
13503 :
13504 570008 : lquery = *lwork == -1 || *liwork == -1;
13505 570008 : lwmin = *n * 17;
13506 570008 : liwmin = *n * 10;
13507 :
13508 570008 : *info = 0;
13509 570008 : if (! (wantz || (*jobz=='N' || *jobz=='n'))) {
13510 0 : *info = -1;
13511 570008 : } else if (! (alleig || valeig || indeig)) {
13512 0 : *info = -2;
13513 570008 : } else if (*n < 0) {
13514 0 : *info = -3;
13515 570008 : } else if (valeig && *n > 0 && *vu <= *vl) {
13516 0 : *info = -7;
13517 570008 : } else if (indeig && (*il < 1 || *il > *n)) {
13518 0 : *info = -8;
13519 570008 : } else if (indeig && (*iu < *il || *iu > *n)) {
13520 0 : *info = -9;
13521 570008 : } else if (*ldz < 1 || (wantz && *ldz < *n)) {
13522 0 : *info = -14;
13523 570008 : } else if (*lwork < lwmin && ! lquery) {
13524 0 : *info = -17;
13525 570008 : } else if (*liwork < liwmin && ! lquery) {
13526 0 : *info = -19;
13527 : }
13528 570008 : if (*info == 0) {
13529 570008 : work[1] = (double) lwmin;
13530 570008 : iwork[1] = liwmin;
13531 : }
13532 :
13533 570008 : if (*info != 0) {
13534 : i__1 = -(*info);
13535 : return;
13536 570008 : } else if (lquery) {
13537 : return;
13538 : }
13539 :
13540 570008 : *m = 0;
13541 570008 : if (*n == 0) {
13542 : return;
13543 : }
13544 :
13545 570008 : if (*n == 1) {
13546 0 : if (alleig || indeig) {
13547 0 : *m = 1;
13548 0 : w[1] = d__[1];
13549 : } else {
13550 0 : if (*vl < d__[1] && *vu >= d__[1]) {
13551 0 : *m = 1;
13552 0 : w[1] = d__[1];
13553 : }
13554 : }
13555 0 : if (wantz) {
13556 0 : z__[z_dim1 + 1] = 1.;
13557 : }
13558 0 : return;
13559 : }
13560 :
13561 : minval = PLUMED_GMX_DOUBLE_MIN;
13562 : safmin = minval*(1.0+PLUMED_GMX_DOUBLE_EPS);
13563 : eps = PLUMED_GMX_DOUBLE_EPS;
13564 : smlnum = safmin / eps;
13565 : bignum = 1. / smlnum;
13566 : rmin = std::sqrt(smlnum);
13567 570008 : d__1 = std::sqrt(bignum), d__2 = 1. / std::sqrt(sqrt(safmin));
13568 : rmax = (d__1<d__2) ? d__1 : d__2;
13569 570008 : scale = 1.;
13570 570008 : tnrm = PLUMED_BLAS_F77_FUNC(dlanst,DLANST)("M", n, &d__[1], &e[1]);
13571 570008 : if (tnrm > 0. && tnrm < rmin) {
13572 0 : scale = rmin / tnrm;
13573 570008 : } else if (tnrm > rmax) {
13574 0 : scale = rmax / tnrm;
13575 : }
13576 570008 : if ( std::abs(scale-1.0)>PLUMED_GMX_DOUBLE_EPS) {
13577 0 : PLUMED_BLAS_F77_FUNC(dscal,DSCAL)(n, &scale, &d__[1], &c__1);
13578 0 : i__1 = *n - 1;
13579 0 : PLUMED_BLAS_F77_FUNC(dscal,DSCAL)(&i__1, &scale, &e[1], &c__1);
13580 0 : tnrm *= scale;
13581 : }
13582 : indgrs = 1;
13583 570008 : indwrk = (*n << 1) + 1;
13584 :
13585 : iinspl = 1;
13586 570008 : iindbl = *n + 1;
13587 : iindw = (*n << 1) + 1;
13588 570008 : iindwk = *n * 3 + 1;
13589 :
13590 570008 : thresh = eps * tnrm;
13591 570008 : PLUMED_BLAS_F77_FUNC(dlarrex,DLARREX)(range, n, vl, vu, il, iu, &d__[1], &e[1], &thresh, &nsplit, &
13592 570008 : iwork[iinspl], m, &w[1], &iwork[iindbl], &iwork[iindw], &work[
13593 570008 : indgrs], &work[indwrk], &iwork[iindwk], &iinfo);
13594 :
13595 570008 : if (iinfo != 0) {
13596 0 : *info = 1;
13597 0 : return;
13598 : }
13599 :
13600 570008 : if (wantz) {
13601 569964 : d__1 = *abstol, d__2 = (double) (*n) * eps;
13602 569964 : tol = (d__1>d__2) ? d__1 : d__2;
13603 569964 : PLUMED_BLAS_F77_FUNC(dlarrvx,DLARRVX)(n, &d__[1], &e[1], &iwork[iinspl], m, &w[1], &iwork[iindbl], &
13604 : iwork[iindw], &work[indgrs], &tol, &z__[z_offset], ldz, &
13605 : isuppz[1], &work[indwrk], &iwork[iindwk], &iinfo);
13606 569964 : if (iinfo != 0) {
13607 0 : *info = 2;
13608 0 : return;
13609 : }
13610 : }
13611 :
13612 570008 : i__1 = *m;
13613 1177671 : for (j = 1; j <= i__1; ++j) {
13614 607663 : itmp = iwork[iindbl + j - 1];
13615 607663 : w[j] += e[iwork[iinspl + itmp - 1]];
13616 : }
13617 :
13618 570008 : if (std::abs(scale-1.0)>PLUMED_GMX_DOUBLE_EPS) {
13619 0 : d__1 = 1. / scale;
13620 0 : PLUMED_BLAS_F77_FUNC(dscal,DSCAL)(m, &d__1, &w[1], &c__1);
13621 : }
13622 570008 : if (nsplit > 1) {
13623 18 : i__1 = *m - 1;
13624 793 : for (j = 1; j <= i__1; ++j) {
13625 : i__ = 0;
13626 775 : tmp = w[j];
13627 775 : i__2 = *m;
13628 35106 : for (jj = j + 1; jj <= i__2; ++jj) {
13629 34331 : if (w[jj] < tmp) {
13630 : i__ = jj;
13631 : tmp = w[jj];
13632 : }
13633 : }
13634 775 : if (i__ != 0) {
13635 638 : w[i__] = w[j];
13636 638 : w[j] = tmp;
13637 638 : if (wantz) {
13638 638 : PLUMED_BLAS_F77_FUNC(dswap,DSWAP)(n, &z__[i__ * z_dim1 + 1], &c__1, &z__[j * z_dim1
13639 638 : + 1], &c__1);
13640 638 : itmp = isuppz[(i__ << 1) - 1];
13641 638 : isuppz[(i__ << 1) - 1] = isuppz[(j << 1) - 1];
13642 638 : isuppz[(j << 1) - 1] = itmp;
13643 638 : itmp = isuppz[i__ * 2];
13644 638 : isuppz[i__ * 2] = isuppz[j * 2];
13645 638 : isuppz[j * 2] = itmp;
13646 : }
13647 : }
13648 : }
13649 : }
13650 :
13651 570008 : work[1] = (double) lwmin;
13652 570008 : iwork[1] = liwmin;
13653 570008 : return;
13654 :
13655 : }
13656 : }
13657 : }
13658 : #include <cmath>
13659 : #include "blas/blas.h"
13660 : #include "lapack.h"
13661 : #include "lapack_limits.h"
13662 :
13663 : #include "real.h"
13664 :
13665 : #include "blas/blas.h"
13666 : namespace PLMD{
13667 : namespace lapack{
13668 : using namespace blas;
13669 : void
13670 0 : PLUMED_BLAS_F77_FUNC(dstein,DSTEIN)(int *n,
13671 : double *d__,
13672 : double *e,
13673 : int *m,
13674 : double *w,
13675 : int *iblock,
13676 : int *isplit,
13677 : double *z__,
13678 : int *ldz,
13679 : double *work,
13680 : int *iwork,
13681 : int *ifail,
13682 : int *info)
13683 : {
13684 : int z_dim1, z_offset, i__1, i__2, i__3;
13685 : double d__2, d__3, d__4, d__5;
13686 :
13687 : int i__, j, b1, j1, bn;
13688 : double xj, scl, eps, sep, nrm, tol;
13689 : int its;
13690 : double xjm, ztr, eps1;
13691 : int jblk, nblk;
13692 : int jmax;
13693 :
13694 : int iseed[4], gpind, iinfo;
13695 : double ortol;
13696 : int indrv1, indrv2, indrv3, indrv4, indrv5;
13697 : int nrmchk;
13698 : int blksiz;
13699 : double onenrm, dtpcrt, pertol;
13700 0 : int c__2 = 2;
13701 0 : int c__1 = 1;
13702 0 : int c_n1 = -1;
13703 :
13704 0 : --d__;
13705 0 : --e;
13706 0 : --w;
13707 0 : --iblock;
13708 0 : --isplit;
13709 0 : z_dim1 = *ldz;
13710 0 : z_offset = 1 + z_dim1;
13711 0 : z__ -= z_offset;
13712 0 : --work;
13713 : --iwork;
13714 0 : --ifail;
13715 :
13716 0 : *info = 0;
13717 :
13718 : xjm = 0.0;
13719 0 : i__1 = *m;
13720 0 : for (i__ = 1; i__ <= i__1; ++i__) {
13721 0 : ifail[i__] = 0;
13722 : }
13723 :
13724 0 : if (*n < 0) {
13725 0 : *info = -1;
13726 0 : } else if (*m < 0 || *m > *n) {
13727 0 : *info = -4;
13728 0 : } else if (*ldz < (*n)) {
13729 0 : *info = -9;
13730 : } else {
13731 : i__1 = *m;
13732 0 : for (j = 2; j <= i__1; ++j) {
13733 0 : if (iblock[j] < iblock[j - 1]) {
13734 0 : *info = -6;
13735 0 : break;
13736 : }
13737 0 : if (iblock[j] == iblock[j - 1] && w[j] < w[j - 1]) {
13738 0 : *info = -5;
13739 0 : break;
13740 : }
13741 : }
13742 : }
13743 :
13744 0 : if (*info != 0) {
13745 : return;
13746 : }
13747 :
13748 0 : if (*n == 0 || *m == 0) {
13749 : return;
13750 0 : } else if (*n == 1) {
13751 0 : z__[z_dim1 + 1] = 1.;
13752 0 : return;
13753 : }
13754 :
13755 : eps = PLUMED_GMX_DOUBLE_EPS;
13756 :
13757 0 : for (i__ = 1; i__ <= 4; ++i__) {
13758 0 : iseed[i__ - 1] = 1;
13759 : }
13760 :
13761 : indrv1 = 0;
13762 : indrv2 = indrv1 + *n;
13763 0 : indrv3 = indrv2 + *n;
13764 0 : indrv4 = indrv3 + *n;
13765 0 : indrv5 = indrv4 + *n;
13766 :
13767 : j1 = 1;
13768 0 : i__1 = iblock[*m];
13769 0 : for (nblk = 1; nblk <= i__1; ++nblk) {
13770 :
13771 0 : if (nblk == 1) {
13772 : b1 = 1;
13773 : } else {
13774 0 : b1 = isplit[nblk - 1] + 1;
13775 : }
13776 0 : bn = isplit[nblk];
13777 0 : blksiz = bn - b1 + 1;
13778 0 : if (blksiz == 1) {
13779 0 : continue;
13780 : }
13781 : gpind = b1;
13782 :
13783 0 : onenrm = std::abs(d__[b1]) + std::abs(e[b1]);
13784 : d__3 = onenrm;
13785 0 : d__4 = std::abs(d__[bn]) + std::abs(e[bn - 1]);
13786 0 : onenrm = (d__3>d__4) ? d__3 : d__4;
13787 : i__2 = bn - 1;
13788 0 : for (i__ = b1 + 1; i__ <= i__2; ++i__) {
13789 : d__4 = onenrm;
13790 0 : d__5 = std::abs(d__[i__]) + std::abs(e[i__ - 1]) + std::abs(e[i__]);
13791 0 : onenrm = (d__4>d__5) ? d__4 : d__5;
13792 : }
13793 0 : ortol = onenrm * .001;
13794 :
13795 0 : dtpcrt = std::sqrt(.1 / blksiz);
13796 :
13797 : jblk = 0;
13798 0 : i__2 = *m;
13799 0 : for (j = j1; j <= i__2; ++j) {
13800 0 : if (iblock[j] != nblk) {
13801 : j1 = j;
13802 : break;
13803 : }
13804 0 : ++jblk;
13805 0 : xj = w[j];
13806 :
13807 0 : if (blksiz == 1) {
13808 0 : work[indrv1 + 1] = 1.;
13809 0 : goto L120;
13810 : }
13811 :
13812 0 : if (jblk > 1) {
13813 0 : eps1 = std::abs(eps * xj);
13814 0 : pertol = eps1 * 10.;
13815 0 : sep = xj - xjm;
13816 0 : if (sep < pertol) {
13817 0 : xj = xjm + pertol;
13818 : }
13819 : }
13820 :
13821 : its = 0;
13822 : nrmchk = 0;
13823 :
13824 0 : PLUMED_BLAS_F77_FUNC(dlarnv,DLARNV)(&c__2, iseed, &blksiz, &work[indrv1 + 1]);
13825 :
13826 0 : PLUMED_BLAS_F77_FUNC(dcopy,DCOPY)(&blksiz, &d__[b1], &c__1, &work[indrv4 + 1], &c__1);
13827 0 : i__3 = blksiz - 1;
13828 0 : PLUMED_BLAS_F77_FUNC(dcopy,DCOPY)(&i__3, &e[b1], &c__1, &work[indrv2 + 2], &c__1);
13829 0 : i__3 = blksiz - 1;
13830 0 : PLUMED_BLAS_F77_FUNC(dcopy,DCOPY)(&i__3, &e[b1], &c__1, &work[indrv3 + 1], &c__1);
13831 :
13832 0 : tol = 0.;
13833 0 : PLUMED_BLAS_F77_FUNC(dlagtf,DLAGTF)(&blksiz, &work[indrv4 + 1], &xj, &work[indrv2 + 2], &work[
13834 0 : indrv3 + 1], &tol, &work[indrv5 + 1], &iwork[1], &iinfo);
13835 :
13836 0 : L70:
13837 0 : ++its;
13838 0 : if (its > 5) {
13839 0 : goto L100;
13840 : }
13841 :
13842 : d__2 = eps;
13843 0 : d__3 = std::abs(work[indrv4 + blksiz]);
13844 0 : scl = blksiz * onenrm * ((d__2>d__3) ? d__2 : d__3) / PLUMED_BLAS_F77_FUNC(dasum,DASUM)(&blksiz, &work[
13845 : indrv1 + 1], &c__1);
13846 0 : PLUMED_BLAS_F77_FUNC(dscal,DSCAL)(&blksiz, &scl, &work[indrv1 + 1], &c__1);
13847 :
13848 0 : PLUMED_BLAS_F77_FUNC(dlagts,DLAGTS)(&c_n1, &blksiz, &work[indrv4 + 1], &work[indrv2 + 2], &
13849 : work[indrv3 + 1], &work[indrv5 + 1], &iwork[1], &work[
13850 : indrv1 + 1], &tol, &iinfo);
13851 :
13852 0 : if (jblk == 1) {
13853 0 : goto L90;
13854 : }
13855 0 : if (std::abs(xj - xjm) > ortol) {
13856 : gpind = j;
13857 : }
13858 0 : if (gpind != j) {
13859 0 : i__3 = j - 1;
13860 0 : for (i__ = gpind; i__ <= i__3; ++i__) {
13861 0 : ztr = -PLUMED_BLAS_F77_FUNC(ddot,DDOT)(&blksiz, &work[indrv1 + 1], &c__1, &z__[b1 +
13862 0 : i__ * z_dim1], &c__1);
13863 0 : PLUMED_BLAS_F77_FUNC(daxpy,DAXPY)(&blksiz, &ztr, &z__[b1 + i__ * z_dim1], &c__1, &
13864 : work[indrv1 + 1], &c__1);
13865 : }
13866 : }
13867 :
13868 0 : L90:
13869 0 : jmax = PLUMED_BLAS_F77_FUNC(idamax,IDAMAX)(&blksiz, &work[indrv1 + 1], &c__1);
13870 0 : nrm = std::abs(work[indrv1 + jmax]);
13871 :
13872 0 : if (nrm < dtpcrt) {
13873 0 : goto L70;
13874 : }
13875 0 : ++nrmchk;
13876 0 : if (nrmchk < 3) {
13877 0 : goto L70;
13878 : }
13879 :
13880 0 : goto L110;
13881 :
13882 : L100:
13883 0 : ++(*info);
13884 0 : ifail[*info] = j;
13885 :
13886 0 : L110:
13887 0 : scl = 1. / PLUMED_BLAS_F77_FUNC(dnrm2,DNRM2)(&blksiz, &work[indrv1 + 1], &c__1);
13888 0 : jmax = PLUMED_BLAS_F77_FUNC(idamax,IDAMAX)(&blksiz, &work[indrv1 + 1], &c__1);
13889 0 : if (work[indrv1 + jmax] < 0.) {
13890 0 : scl = -scl;
13891 : }
13892 0 : PLUMED_BLAS_F77_FUNC(dscal,DSCAL)(&blksiz, &scl, &work[indrv1 + 1], &c__1);
13893 0 : L120:
13894 0 : i__3 = *n;
13895 0 : for (i__ = 1; i__ <= i__3; ++i__) {
13896 0 : z__[i__ + j * z_dim1] = 0.;
13897 : }
13898 0 : i__3 = blksiz;
13899 0 : for (i__ = 1; i__ <= i__3; ++i__) {
13900 0 : z__[b1 + i__ - 1 + j * z_dim1] = work[indrv1 + i__];
13901 : }
13902 :
13903 0 : xjm = xj;
13904 : }
13905 : }
13906 :
13907 : return;
13908 :
13909 : }
13910 :
13911 :
13912 : }
13913 : }
13914 : #include <cmath>
13915 : #include "real.h"
13916 :
13917 : #include "blas/blas.h"
13918 : #include "lapack.h"
13919 : #include "lapack_limits.h"
13920 :
13921 : #include "blas/blas.h"
13922 : namespace PLMD{
13923 : namespace lapack{
13924 : using namespace blas;
13925 : void
13926 0 : PLUMED_BLAS_F77_FUNC(dsteqr,DSTEQR)(const char * compz,
13927 : int * n,
13928 : double * d__,
13929 : double * e,
13930 : double * z__,
13931 : int * ldz,
13932 : double * work,
13933 : int * info)
13934 : {
13935 0 : double c_b9 = 0.;
13936 0 : double c_b10 = 1.;
13937 0 : int c__0 = 0;
13938 0 : int c__1 = 1;
13939 0 : int c__2 = 2;
13940 : int z_dim1, z_offset, i__1, i__2;
13941 : double d__1, d__2;
13942 :
13943 : double b, c__, f, g;
13944 : int i__, j, k, l, m;
13945 : double p, r__, s;
13946 : int l1, ii, mm, lm1, mm1, nm1;
13947 : double rt1, rt2, eps;
13948 : int lsv;
13949 : double tst, eps2;
13950 : int lend, jtot;
13951 : double anorm;
13952 : int lendm1, lendp1;
13953 : int iscale;
13954 : double safmin,minval;
13955 : double safmax;
13956 : int lendsv;
13957 : double ssfmin;
13958 : int nmaxit, icompz;
13959 : double ssfmax;
13960 :
13961 :
13962 0 : --d__;
13963 0 : --e;
13964 0 : z_dim1 = *ldz;
13965 0 : z_offset = 1 + z_dim1;
13966 0 : z__ -= z_offset;
13967 0 : --work;
13968 :
13969 0 : *info = 0;
13970 :
13971 0 : if (*compz=='N' || *compz=='n') {
13972 : icompz = 0;
13973 0 : } else if (*compz=='V' || *compz=='v') {
13974 : icompz = 1;
13975 : } else if (*compz=='I' || *compz=='i') {
13976 : icompz = 2;
13977 : } else {
13978 : icompz = -1;
13979 : }
13980 : if (icompz < 0) {
13981 0 : *info = -1;
13982 0 : } else if (*n < 0) {
13983 0 : *info = -2;
13984 0 : } else if (*ldz < 1 || (icompz > 0 && *ldz < ((*n>1) ? *n : 1))) {
13985 0 : *info = -6;
13986 : }
13987 0 : if (*info != 0) {
13988 : return;
13989 : }
13990 :
13991 :
13992 0 : if (*n == 0) {
13993 : return;
13994 : }
13995 :
13996 0 : if (*n == 1) {
13997 0 : if (icompz == 2) {
13998 0 : z__[z_dim1 + 1] = 1.;
13999 : }
14000 0 : return;
14001 : }
14002 :
14003 : eps = PLUMED_GMX_DOUBLE_EPS;
14004 : d__1 = eps;
14005 : eps2 = d__1 * d__1;
14006 : minval = PLUMED_GMX_DOUBLE_MIN;
14007 : safmin = minval*(1.0+PLUMED_GMX_DOUBLE_EPS);
14008 :
14009 : safmax = 1. / safmin;
14010 0 : ssfmax = std::sqrt(safmax) / 3.;
14011 0 : ssfmin = std::sqrt(safmin) / eps2;
14012 :
14013 0 : if (icompz == 2) {
14014 0 : PLUMED_BLAS_F77_FUNC(dlaset,DLASET)("Full", n, n, &c_b9, &c_b10, &z__[z_offset], ldz);
14015 : }
14016 :
14017 0 : nmaxit = *n * 30;
14018 : jtot = 0;
14019 :
14020 : l1 = 1;
14021 0 : nm1 = *n - 1;
14022 :
14023 0 : L10:
14024 0 : if (l1 > *n) {
14025 0 : goto L160;
14026 : }
14027 0 : if (l1 > 1) {
14028 0 : e[l1 - 1] = 0.;
14029 : }
14030 0 : if (l1 <= nm1) {
14031 0 : i__1 = nm1;
14032 0 : for (m = l1; m <= i__1; ++m) {
14033 0 : tst = std::abs(e[m]);
14034 0 : if (std::abs(tst)<PLUMED_GMX_DOUBLE_MIN) {
14035 0 : goto L30;
14036 : }
14037 0 : if (tst <= std::sqrt(std::abs(d__[m])) * std::sqrt(std::abs(d__[m + 1])) * eps) {
14038 0 : e[m] = 0.;
14039 0 : goto L30;
14040 : }
14041 : }
14042 : }
14043 0 : m = *n;
14044 :
14045 0 : L30:
14046 : l = l1;
14047 : lsv = l;
14048 : lend = m;
14049 : lendsv = lend;
14050 0 : l1 = m + 1;
14051 0 : if (lend == l) {
14052 0 : goto L10;
14053 : }
14054 :
14055 0 : i__1 = lend - l + 1;
14056 0 : anorm = PLUMED_BLAS_F77_FUNC(dlanst,DLANST)("I", &i__1, &d__[l], &e[l]);
14057 : iscale = 0;
14058 0 : if (std::abs(anorm)<PLUMED_GMX_DOUBLE_MIN) {
14059 0 : goto L10;
14060 : }
14061 0 : if (anorm > ssfmax) {
14062 : iscale = 1;
14063 0 : i__1 = lend - l + 1;
14064 0 : PLUMED_BLAS_F77_FUNC(dlascl,DLASCL)("G", &c__0, &c__0, &anorm, &ssfmax, &i__1, &c__1, &d__[l], n,
14065 : info);
14066 0 : i__1 = lend - l;
14067 0 : PLUMED_BLAS_F77_FUNC(dlascl,DLASCL)("G", &c__0, &c__0, &anorm, &ssfmax, &i__1, &c__1, &e[l], n,
14068 : info);
14069 0 : } else if (anorm < ssfmin) {
14070 : iscale = 2;
14071 0 : i__1 = lend - l + 1;
14072 0 : PLUMED_BLAS_F77_FUNC(dlascl,DLASCL)("G", &c__0, &c__0, &anorm, &ssfmin, &i__1, &c__1, &d__[l], n,
14073 : info);
14074 0 : i__1 = lend - l;
14075 0 : PLUMED_BLAS_F77_FUNC(dlascl,DLASCL)("G", &c__0, &c__0, &anorm, &ssfmin, &i__1, &c__1, &e[l], n,
14076 : info);
14077 : }
14078 :
14079 0 : if (std::abs(d__[lend]) < std::abs(d__[l])) {
14080 : lend = lsv;
14081 : l = lendsv;
14082 : }
14083 :
14084 0 : if (lend > l) {
14085 :
14086 0 : L40:
14087 0 : if (l != lend) {
14088 0 : lendm1 = lend - 1;
14089 0 : i__1 = lendm1;
14090 0 : for (m = l; m <= i__1; ++m) {
14091 0 : d__2 = std::abs(e[m]);
14092 0 : tst = d__2 * d__2;
14093 0 : if (tst <= eps2 * std::abs(d__[m]) * std::abs(d__[m+ 1]) + safmin) {
14094 0 : goto L60;
14095 : }
14096 : }
14097 : }
14098 :
14099 : m = lend;
14100 :
14101 0 : L60:
14102 0 : if (m < lend) {
14103 0 : e[m] = 0.;
14104 : }
14105 0 : p = d__[l];
14106 0 : if (m == l) {
14107 0 : goto L80;
14108 : }
14109 :
14110 0 : if (m == l + 1) {
14111 0 : if (icompz > 0) {
14112 0 : PLUMED_BLAS_F77_FUNC(dlaev2,DLAEV2)(&d__[l], &e[l], &d__[l + 1], &rt1, &rt2, &c__, &s);
14113 0 : work[l] = c__;
14114 0 : work[*n - 1 + l] = s;
14115 0 : PLUMED_BLAS_F77_FUNC(dlasr,DLASR)("R", "V", "B", n, &c__2, &work[l], &work[*n - 1 + l], &
14116 0 : z__[l * z_dim1 + 1], ldz);
14117 : } else {
14118 0 : PLUMED_BLAS_F77_FUNC(dlae2,DLAE2)(&d__[l], &e[l], &d__[l + 1], &rt1, &rt2);
14119 : }
14120 0 : d__[l] = rt1;
14121 0 : d__[l + 1] = rt2;
14122 0 : e[l] = 0.;
14123 0 : l += 2;
14124 0 : if (l <= lend) {
14125 0 : goto L40;
14126 : }
14127 0 : goto L140;
14128 : }
14129 :
14130 0 : if (jtot == nmaxit) {
14131 0 : goto L140;
14132 : }
14133 0 : ++jtot;
14134 :
14135 0 : g = (d__[l + 1] - p) / (e[l] * 2.);
14136 0 : r__ = PLUMED_BLAS_F77_FUNC(dlapy2,DLAPY2)(&g, &c_b10);
14137 0 : g = d__[m] - p + e[l] / (g + ( (g>0) ? r__ : -r__ ) );
14138 :
14139 0 : s = 1.;
14140 0 : c__ = 1.;
14141 : p = 0.;
14142 :
14143 0 : mm1 = m - 1;
14144 0 : i__1 = l;
14145 0 : for (i__ = mm1; i__ >= i__1; --i__) {
14146 0 : f = s * e[i__];
14147 0 : b = c__ * e[i__];
14148 0 : PLUMED_BLAS_F77_FUNC(dlartg,DLARTG)(&g, &f, &c__, &s, &r__);
14149 0 : if (i__ != m - 1) {
14150 0 : e[i__ + 1] = r__;
14151 : }
14152 0 : g = d__[i__ + 1] - p;
14153 0 : r__ = (d__[i__] - g) * s + c__ * 2. * b;
14154 0 : p = s * r__;
14155 0 : d__[i__ + 1] = g + p;
14156 0 : g = c__ * r__ - b;
14157 :
14158 0 : if (icompz > 0) {
14159 0 : work[i__] = c__;
14160 0 : work[*n - 1 + i__] = -s;
14161 : }
14162 : }
14163 :
14164 0 : if (icompz > 0) {
14165 0 : mm = m - l + 1;
14166 0 : PLUMED_BLAS_F77_FUNC(dlasr,DLASR)("R", "V", "B", n, &mm, &work[l], &work[*n - 1 + l], &z__[l
14167 0 : * z_dim1 + 1], ldz);
14168 : }
14169 :
14170 0 : d__[l] -= p;
14171 0 : e[l] = g;
14172 0 : goto L40;
14173 :
14174 : L80:
14175 : d__[l] = p;
14176 :
14177 0 : ++l;
14178 0 : if (l <= lend) {
14179 0 : goto L40;
14180 : }
14181 0 : goto L140;
14182 :
14183 : } else {
14184 :
14185 0 : L90:
14186 0 : if (l != lend) {
14187 0 : lendp1 = lend + 1;
14188 0 : i__1 = lendp1;
14189 0 : for (m = l; m >= i__1; --m) {
14190 0 : d__2 = std::abs(e[m - 1]);
14191 0 : tst = d__2 * d__2;
14192 0 : if (tst <= eps2 * std::abs(d__[m]) * std::abs(d__[m- 1]) + safmin) {
14193 0 : goto L110;
14194 : }
14195 : }
14196 : }
14197 :
14198 : m = lend;
14199 :
14200 0 : L110:
14201 0 : if (m > lend) {
14202 0 : e[m - 1] = 0.;
14203 : }
14204 0 : p = d__[l];
14205 0 : if (m == l) {
14206 0 : goto L130;
14207 : }
14208 0 : if (m == l - 1) {
14209 0 : if (icompz > 0) {
14210 0 : PLUMED_BLAS_F77_FUNC(dlaev2,DLAEV2)(&d__[l - 1], &e[l - 1], &d__[l], &rt1, &rt2, &c__, &s)
14211 : ;
14212 0 : work[m] = c__;
14213 0 : work[*n - 1 + m] = s;
14214 0 : PLUMED_BLAS_F77_FUNC(dlasr,DLASR)("R", "V", "F", n, &c__2, &work[m], &work[*n - 1 + m], &
14215 0 : z__[(l - 1) * z_dim1 + 1], ldz);
14216 : } else {
14217 0 : PLUMED_BLAS_F77_FUNC(dlae2,DLAE2)(&d__[l - 1], &e[l - 1], &d__[l], &rt1, &rt2);
14218 : }
14219 0 : d__[l - 1] = rt1;
14220 0 : d__[l] = rt2;
14221 0 : e[l - 1] = 0.;
14222 0 : l += -2;
14223 0 : if (l >= lend) {
14224 0 : goto L90;
14225 : }
14226 0 : goto L140;
14227 : }
14228 :
14229 0 : if (jtot == nmaxit) {
14230 0 : goto L140;
14231 : }
14232 0 : ++jtot;
14233 :
14234 0 : g = (d__[l - 1] - p) / (e[l - 1] * 2.);
14235 0 : r__ = PLUMED_BLAS_F77_FUNC(dlapy2,DLAPY2)(&g, &c_b10);
14236 0 : g = d__[m] - p + e[l - 1] / (g + ( (g>0) ? r__ : -r__ ));
14237 :
14238 0 : s = 1.;
14239 0 : c__ = 1.;
14240 : p = 0.;
14241 :
14242 : lm1 = l - 1;
14243 0 : i__1 = lm1;
14244 0 : for (i__ = m; i__ <= i__1; ++i__) {
14245 0 : f = s * e[i__];
14246 0 : b = c__ * e[i__];
14247 0 : PLUMED_BLAS_F77_FUNC(dlartg,DLARTG)(&g, &f, &c__, &s, &r__);
14248 0 : if (i__ != m) {
14249 0 : e[i__ - 1] = r__;
14250 : }
14251 0 : g = d__[i__] - p;
14252 0 : r__ = (d__[i__ + 1] - g) * s + c__ * 2. * b;
14253 0 : p = s * r__;
14254 0 : d__[i__] = g + p;
14255 0 : g = c__ * r__ - b;
14256 :
14257 0 : if (icompz > 0) {
14258 0 : work[i__] = c__;
14259 0 : work[*n - 1 + i__] = s;
14260 : }
14261 : }
14262 :
14263 0 : if (icompz > 0) {
14264 0 : mm = l - m + 1;
14265 0 : PLUMED_BLAS_F77_FUNC(dlasr,DLASR)("R", "V", "F", n, &mm, &work[m], &work[*n - 1 + m], &z__[m
14266 0 : * z_dim1 + 1], ldz);
14267 : }
14268 :
14269 0 : d__[l] -= p;
14270 0 : e[lm1] = g;
14271 0 : goto L90;
14272 :
14273 : L130:
14274 : d__[l] = p;
14275 :
14276 0 : --l;
14277 0 : if (l >= lend) {
14278 0 : goto L90;
14279 : }
14280 0 : goto L140;
14281 :
14282 : }
14283 :
14284 0 : L140:
14285 0 : if (iscale == 1) {
14286 0 : i__1 = lendsv - lsv + 1;
14287 0 : PLUMED_BLAS_F77_FUNC(dlascl,DLASCL)("G", &c__0, &c__0, &ssfmax, &anorm, &i__1, &c__1, &d__[lsv],
14288 : n, info);
14289 0 : i__1 = lendsv - lsv;
14290 0 : PLUMED_BLAS_F77_FUNC(dlascl,DLASCL)("G", &c__0, &c__0, &ssfmax, &anorm, &i__1, &c__1, &e[lsv], n,
14291 : info);
14292 0 : } else if (iscale == 2) {
14293 0 : i__1 = lendsv - lsv + 1;
14294 0 : PLUMED_BLAS_F77_FUNC(dlascl,DLASCL)("G", &c__0, &c__0, &ssfmin, &anorm, &i__1, &c__1, &d__[lsv],
14295 : n, info);
14296 0 : i__1 = lendsv - lsv;
14297 0 : PLUMED_BLAS_F77_FUNC(dlascl,DLASCL)("G", &c__0, &c__0, &ssfmin, &anorm, &i__1, &c__1, &e[lsv], n,
14298 : info);
14299 : }
14300 :
14301 0 : if (jtot < nmaxit) {
14302 0 : goto L10;
14303 : }
14304 0 : i__1 = *n - 1;
14305 0 : for (i__ = 1; i__ <= i__1; ++i__) {
14306 0 : if (std::abs(e[i__])>PLUMED_GMX_DOUBLE_MIN) {
14307 0 : ++(*info);
14308 : }
14309 : }
14310 0 : goto L190;
14311 :
14312 : L160:
14313 0 : if (icompz == 0) {
14314 :
14315 0 : PLUMED_BLAS_F77_FUNC(dlasrt,DLASRT)("I", n, &d__[1], info);
14316 :
14317 : } else {
14318 :
14319 0 : i__1 = *n;
14320 0 : for (ii = 2; ii <= i__1; ++ii) {
14321 0 : i__ = ii - 1;
14322 : k = i__;
14323 0 : p = d__[i__];
14324 0 : i__2 = *n;
14325 0 : for (j = ii; j <= i__2; ++j) {
14326 0 : if (d__[j] < p) {
14327 : k = j;
14328 : p = d__[j];
14329 : }
14330 : }
14331 0 : if (k != i__) {
14332 0 : d__[k] = d__[i__];
14333 0 : d__[i__] = p;
14334 0 : PLUMED_BLAS_F77_FUNC(dswap,DSWAP)(n, &z__[i__ * z_dim1 + 1], &c__1, &z__[k * z_dim1 + 1],
14335 : &c__1);
14336 : }
14337 : }
14338 : }
14339 :
14340 0 : L190:
14341 : return;
14342 : }
14343 :
14344 :
14345 : }
14346 : }
14347 : #include <cmath>
14348 : #include "lapack.h"
14349 : #include "lapack_limits.h"
14350 :
14351 : #include "real.h"
14352 :
14353 : #include "blas/blas.h"
14354 : namespace PLMD{
14355 : namespace lapack{
14356 : using namespace blas;
14357 : void
14358 0 : PLUMED_BLAS_F77_FUNC(dsterf,DSTERF)(int *n,
14359 : double *d__,
14360 : double *e,
14361 : int *info)
14362 : {
14363 : int i__1;
14364 : double d__1;
14365 :
14366 : double c__;
14367 : int i__, l, m;
14368 : double p, r__, s;
14369 : int l1;
14370 : double bb, rt1, rt2, eps, rte;
14371 : int lsv;
14372 : double eps2, oldc;
14373 : int lend, jtot;
14374 : double gamma, alpha, sigma, anorm;
14375 : int iscale;
14376 : double oldgam;
14377 : double safmax;
14378 : int lendsv;
14379 : double ssfmin;
14380 : int nmaxit;
14381 : double ssfmax;
14382 0 : int c__0 = 0;
14383 0 : int c__1 = 1;
14384 0 : double c_b32 = 1.;
14385 : const double safmin = PLUMED_GMX_DOUBLE_MIN*(1.0+PLUMED_GMX_DOUBLE_EPS);
14386 :
14387 0 : --e;
14388 0 : --d__;
14389 :
14390 0 : *info = 0;
14391 :
14392 0 : if (*n < 0) {
14393 0 : *info = -1;
14394 : i__1 = -(*info);
14395 0 : return;
14396 : }
14397 0 : if (*n <= 1) {
14398 : return;
14399 : }
14400 :
14401 : eps = PLUMED_GMX_DOUBLE_EPS;
14402 : d__1 = eps;
14403 : eps2 = d__1 * d__1;
14404 : safmax = 1. / safmin;
14405 0 : ssfmax = std::sqrt(safmax) / 3.;
14406 0 : ssfmin = std::sqrt(safmin) / eps2;
14407 :
14408 0 : nmaxit = *n * 30;
14409 0 : sigma = 0.;
14410 : jtot = 0;
14411 :
14412 : l1 = 1;
14413 :
14414 0 : L10:
14415 0 : if (l1 > *n) {
14416 0 : PLUMED_BLAS_F77_FUNC(dlasrt,DLASRT)("I", n, &d__[1], info);
14417 0 : return;
14418 : }
14419 0 : if (l1 > 1) {
14420 0 : e[l1 - 1] = 0.;
14421 : }
14422 0 : i__1 = *n - 1;
14423 0 : for (m = l1; m <= i__1; ++m) {
14424 0 : if (std::abs(e[m]) <= std::sqrt(std::abs(d__[m])) *
14425 0 : std::sqrt(std::abs(d__[m + 1])) * eps) {
14426 0 : e[m] = 0.;
14427 0 : goto L30;
14428 : }
14429 : }
14430 0 : m = *n;
14431 :
14432 0 : L30:
14433 : l = l1;
14434 : lsv = l;
14435 : lend = m;
14436 : lendsv = lend;
14437 0 : l1 = m + 1;
14438 0 : if (lend == l) {
14439 0 : goto L10;
14440 : }
14441 :
14442 0 : i__1 = lend - l + 1;
14443 0 : anorm = PLUMED_BLAS_F77_FUNC(dlanst,DLANST)("I", &i__1, &d__[l], &e[l]);
14444 : iscale = 0;
14445 0 : if (anorm > ssfmax) {
14446 : iscale = 1;
14447 0 : i__1 = lend - l + 1;
14448 0 : PLUMED_BLAS_F77_FUNC(dlascl,DLASCL)("G", &c__0, &c__0, &anorm, &ssfmax, &i__1, &c__1, &d__[l], n,
14449 : info);
14450 0 : i__1 = lend - l;
14451 0 : PLUMED_BLAS_F77_FUNC(dlascl,DLASCL)("G", &c__0, &c__0, &anorm, &ssfmax, &i__1, &c__1, &e[l], n,
14452 : info);
14453 0 : } else if (anorm < ssfmin) {
14454 : iscale = 2;
14455 0 : i__1 = lend - l + 1;
14456 0 : PLUMED_BLAS_F77_FUNC(dlascl,DLASCL)("G", &c__0, &c__0, &anorm, &ssfmin, &i__1, &c__1, &d__[l], n,
14457 : info);
14458 0 : i__1 = lend - l;
14459 0 : PLUMED_BLAS_F77_FUNC(dlascl,DLASCL)("G", &c__0, &c__0, &anorm, &ssfmin, &i__1, &c__1, &e[l], n,
14460 : info);
14461 : }
14462 :
14463 0 : i__1 = lend - 1;
14464 0 : for (i__ = l; i__ <= i__1; ++i__) {
14465 0 : d__1 = e[i__];
14466 0 : e[i__] = d__1 * d__1;
14467 : }
14468 :
14469 0 : if (std::abs(d__[lend]) < std::abs(d__[l])) {
14470 : lend = lsv;
14471 : l = lendsv;
14472 : }
14473 :
14474 0 : if (lend >= l) {
14475 :
14476 0 : L50:
14477 0 : if (l != lend) {
14478 0 : i__1 = lend - 1;
14479 0 : for (m = l; m <= i__1; ++m) {
14480 0 : if (std::abs(e[m]) <= eps2 * std::abs(d__[m] * d__[m + 1])) {
14481 0 : goto L70;
14482 : }
14483 : }
14484 : }
14485 : m = lend;
14486 :
14487 0 : L70:
14488 0 : if (m < lend) {
14489 0 : e[m] = 0.;
14490 : }
14491 0 : p = d__[l];
14492 0 : if (m == l) {
14493 0 : goto L90;
14494 : }
14495 0 : if (m == l + 1) {
14496 0 : rte = std::sqrt(e[l]);
14497 0 : PLUMED_BLAS_F77_FUNC(dlae2,DLAE2)(&d__[l], &rte, &d__[l + 1], &rt1, &rt2);
14498 0 : d__[l] = rt1;
14499 0 : d__[l + 1] = rt2;
14500 0 : e[l] = 0.;
14501 0 : l += 2;
14502 0 : if (l <= lend) {
14503 0 : goto L50;
14504 : }
14505 0 : goto L150;
14506 : }
14507 :
14508 0 : if (jtot == nmaxit) {
14509 0 : goto L150;
14510 : }
14511 0 : ++jtot;
14512 :
14513 0 : rte = std::sqrt(e[l]);
14514 0 : sigma = (d__[l + 1] - p) / (rte * 2.);
14515 0 : r__ = PLUMED_BLAS_F77_FUNC(dlapy2,DLAPY2)(&sigma, &c_b32);
14516 0 : sigma = p - rte / (sigma + ( (sigma>0) ? r__ : -r__));
14517 :
14518 : c__ = 1.;
14519 : s = 0.;
14520 0 : gamma = d__[m] - sigma;
14521 0 : p = gamma * gamma;
14522 :
14523 0 : i__1 = l;
14524 0 : for (i__ = m - 1; i__ >= i__1; --i__) {
14525 0 : bb = e[i__];
14526 0 : r__ = p + bb;
14527 0 : if (i__ != m - 1) {
14528 0 : e[i__ + 1] = s * r__;
14529 : }
14530 : oldc = c__;
14531 0 : c__ = p / r__;
14532 0 : s = bb / r__;
14533 : oldgam = gamma;
14534 0 : alpha = d__[i__];
14535 0 : gamma = c__ * (alpha - sigma) - s * oldgam;
14536 0 : d__[i__ + 1] = oldgam + (alpha - gamma);
14537 0 : if (std::abs(c__)>PLUMED_GMX_DOUBLE_MIN) {
14538 0 : p = gamma * gamma / c__;
14539 : } else {
14540 0 : p = oldc * bb;
14541 : }
14542 : }
14543 :
14544 0 : e[l] = s * p;
14545 0 : d__[l] = sigma + gamma;
14546 0 : goto L50;
14547 :
14548 : L90:
14549 : d__[l] = p;
14550 :
14551 0 : ++l;
14552 0 : if (l <= lend) {
14553 0 : goto L50;
14554 : }
14555 0 : goto L150;
14556 :
14557 : } else {
14558 :
14559 0 : L100:
14560 0 : i__1 = lend + 1;
14561 0 : for (m = l; m >= i__1; --m) {
14562 0 : if (std::abs(e[m - 1]) <= eps2 * std::abs(d__[m] * d__[m - 1])) {
14563 0 : goto L120;
14564 : }
14565 : }
14566 : m = lend;
14567 :
14568 0 : L120:
14569 0 : if (m > lend) {
14570 0 : e[m - 1] = 0.;
14571 : }
14572 0 : p = d__[l];
14573 0 : if (m == l) {
14574 0 : goto L140;
14575 : }
14576 :
14577 0 : if (m == l - 1) {
14578 0 : rte = std::sqrt(e[l - 1]);
14579 0 : PLUMED_BLAS_F77_FUNC(dlae2,DLAE2)(&d__[l], &rte, &d__[l - 1], &rt1, &rt2);
14580 0 : d__[l] = rt1;
14581 0 : d__[l - 1] = rt2;
14582 0 : e[l - 1] = 0.;
14583 0 : l += -2;
14584 0 : if (l >= lend) {
14585 0 : goto L100;
14586 : }
14587 0 : goto L150;
14588 : }
14589 :
14590 0 : if (jtot == nmaxit) {
14591 0 : goto L150;
14592 : }
14593 0 : ++jtot;
14594 :
14595 0 : rte = std::sqrt(e[l - 1]);
14596 0 : sigma = (d__[l - 1] - p) / (rte * 2.);
14597 0 : r__ = PLUMED_BLAS_F77_FUNC(dlapy2,DLAPY2)(&sigma, &c_b32);
14598 0 : sigma = p - rte / (sigma + ( (sigma>0) ? r__ : -r__));
14599 :
14600 : c__ = 1.;
14601 : s = 0.;
14602 0 : gamma = d__[m] - sigma;
14603 0 : p = gamma * gamma;
14604 :
14605 0 : i__1 = l - 1;
14606 0 : for (i__ = m; i__ <= i__1; ++i__) {
14607 0 : bb = e[i__];
14608 0 : r__ = p + bb;
14609 0 : if (i__ != m) {
14610 0 : e[i__ - 1] = s * r__;
14611 : }
14612 : oldc = c__;
14613 0 : c__ = p / r__;
14614 0 : s = bb / r__;
14615 : oldgam = gamma;
14616 0 : alpha = d__[i__ + 1];
14617 0 : gamma = c__ * (alpha - sigma) - s * oldgam;
14618 0 : d__[i__] = oldgam + (alpha - gamma);
14619 0 : if (std::abs(c__)>PLUMED_GMX_DOUBLE_MIN) {
14620 0 : p = gamma * gamma / c__;
14621 : } else {
14622 0 : p = oldc * bb;
14623 : }
14624 : }
14625 :
14626 0 : e[l - 1] = s * p;
14627 0 : d__[l] = sigma + gamma;
14628 0 : goto L100;
14629 :
14630 : L140:
14631 : d__[l] = p;
14632 :
14633 0 : --l;
14634 0 : if (l >= lend) {
14635 0 : goto L100;
14636 : }
14637 0 : goto L150;
14638 :
14639 : }
14640 :
14641 0 : L150:
14642 0 : if (iscale == 1) {
14643 0 : i__1 = lendsv - lsv + 1;
14644 0 : PLUMED_BLAS_F77_FUNC(dlascl,DLASCL)("G", &c__0, &c__0, &ssfmax, &anorm, &i__1, &c__1, &d__[lsv],
14645 : n, info);
14646 : }
14647 0 : if (iscale == 2) {
14648 0 : i__1 = lendsv - lsv + 1;
14649 0 : PLUMED_BLAS_F77_FUNC(dlascl,DLASCL)("G", &c__0, &c__0, &ssfmin, &anorm, &i__1, &c__1, &d__[lsv],
14650 : n, info);
14651 : }
14652 :
14653 0 : if (jtot < nmaxit) {
14654 0 : goto L10;
14655 : }
14656 0 : i__1 = *n - 1;
14657 0 : for (i__ = 1; i__ <= i__1; ++i__) {
14658 0 : if (std::abs(e[i__])>PLUMED_GMX_DOUBLE_MIN) {
14659 0 : ++(*info);
14660 : }
14661 : }
14662 : return;
14663 : }
14664 :
14665 :
14666 : }
14667 : }
14668 : #include "lapack.h"
14669 :
14670 :
14671 : /* Normally, DSTEVR is the LAPACK wrapper which calls one
14672 : * of the eigenvalue methods. However, our code includes a
14673 : * version of DSTEGR which is never than LAPACK 3.0 and can
14674 : * handle requests for a subset of eigenvalues/vectors too,
14675 : * and it should not need to call DSTEIN.
14676 : * Just in case somebody has a faster version in their lapack
14677 : * library we still call the driver routine, but in our own
14678 : * case this is just a wrapper to dstegr.
14679 : */
14680 : #include "blas/blas.h"
14681 : namespace PLMD{
14682 : namespace lapack{
14683 : using namespace blas;
14684 : void
14685 0 : PLUMED_BLAS_F77_FUNC(dstevr,DSTEVR)(const char *jobz,
14686 : const char *range,
14687 : int *n,
14688 : double *d,
14689 : double *e,
14690 : double *vl,
14691 : double *vu,
14692 : int *il,
14693 : int *iu,
14694 : double *abstol,
14695 : int *m,
14696 : double *w,
14697 : double *z,
14698 : int *ldz,
14699 : int *isuppz,
14700 : double *work,
14701 : int *lwork,
14702 : int *iwork,
14703 : int *liwork,
14704 : int *info)
14705 : {
14706 0 : PLUMED_BLAS_F77_FUNC(dstegr,DSTEGR)(jobz, range, n, d, e, vl, vu, il, iu, abstol, m, w,
14707 : z, ldz, isuppz, work, lwork, iwork, liwork, info);
14708 :
14709 :
14710 0 : return;
14711 :
14712 : }
14713 :
14714 :
14715 : }
14716 : }
14717 : #include <cmath>
14718 :
14719 : #include "real.h"
14720 :
14721 : #include "blas/blas.h"
14722 : #include "lapack.h"
14723 : #include "lapack_limits.h"
14724 :
14725 : #include "blas/blas.h"
14726 : namespace PLMD{
14727 : namespace lapack{
14728 : using namespace blas;
14729 : void
14730 584795 : PLUMED_BLAS_F77_FUNC(dsyevr,DSYEVR)(const char *jobz, const char *range, const char *uplo, int *n,
14731 : double *a, int *lda, double *vl, double *vu, int *
14732 : il, int *iu, double *abstol, int *m, double *w,
14733 : double *z__, int *ldz, int *isuppz, double *work,
14734 : int *lwork, int *iwork, int *liwork, int *info)
14735 : {
14736 : /* System generated locals */
14737 : int a_dim1, a_offset, z_dim1, z_offset, i__1, i__2;
14738 : double d__1, d__2;
14739 :
14740 : /* Local variables */
14741 584795 : int c__1 = 1;
14742 : int i__, j, nb, jj;
14743 : double eps, tmp1;
14744 : int indd, inde;
14745 : double anrm;
14746 : int imax;
14747 : double rmin, rmax;
14748 : int itmp1, inddd, indee;
14749 : double sigma;
14750 : int iinfo;
14751 : int indwk;
14752 : int lwmin;
14753 : int lower, wantz;
14754 : int alleig, indeig;
14755 : int iscale, indibl, indifl;
14756 : int valeig;
14757 : double safmin,minval;
14758 : double bignum;
14759 : int indtau;
14760 : int indwkn;
14761 : int liwmin;
14762 : int llwrkn, llwork;
14763 : double smlnum;
14764 : int lwkopt;
14765 : int lquery;
14766 :
14767 : /* Parameter adjustments */
14768 584795 : a_dim1 = *lda;
14769 584795 : a_offset = 1 + a_dim1;
14770 584795 : a -= a_offset;
14771 584795 : --w;
14772 584795 : z_dim1 = *ldz;
14773 584795 : z_offset = 1 + z_dim1;
14774 584795 : z__ -= z_offset;
14775 : --isuppz;
14776 584795 : --work;
14777 584795 : --iwork;
14778 :
14779 584795 : lower = (*uplo=='L' || *uplo=='l');
14780 584795 : wantz = (*jobz=='V' || *jobz=='v');
14781 584795 : alleig = (*range=='A' || *range=='a');
14782 584795 : valeig = (*range=='V' || *range=='v');
14783 584795 : indeig = (*range=='I' || *range=='i');
14784 :
14785 : indibl = 0;
14786 584795 : lquery = *lwork == -1 || *liwork == -1;
14787 :
14788 : i__1 = 1;
14789 584795 : i__2 = *n * 26;
14790 :
14791 584795 : if(*n>0)
14792 : lwmin = *n * 26;
14793 : else
14794 : lwmin = 1;
14795 :
14796 584795 : if(*n>0)
14797 584795 : liwmin = *n * 10;
14798 : else
14799 : liwmin = 1;
14800 :
14801 584795 : *info = 0;
14802 584795 : if (! (wantz || (*jobz=='N' || *jobz=='n'))) {
14803 0 : *info = -1;
14804 584795 : } else if (! (alleig || valeig || indeig)) {
14805 0 : *info = -2;
14806 584795 : } else if (! (lower || (*uplo=='U' || *uplo=='u'))) {
14807 0 : *info = -3;
14808 584795 : } else if (*n < 0) {
14809 0 : *info = -4;
14810 584795 : } else if (*lda < ((*n>1) ? *n : 1) ) {
14811 0 : *info = -6;
14812 : } else {
14813 584795 : if (valeig) {
14814 0 : if (*n > 0 && *vu <= *vl) {
14815 0 : *info = -8;
14816 : }
14817 584795 : } else if (indeig) {
14818 577320 : if (*il < 1 || *il > ((*n>1) ? *n : 1)) {
14819 0 : *info = -9;
14820 577320 : } else if (*iu < ((*n<*il) ? *n : *il) || *iu > *n) {
14821 0 : *info = -10;
14822 : }
14823 : }
14824 : }
14825 584795 : if (*info == 0) {
14826 584795 : if (*ldz < 1 || (wantz && *ldz < *n)) {
14827 0 : *info = -15;
14828 584795 : } else if (*lwork < lwmin && ! lquery) {
14829 0 : *info = -18;
14830 584795 : } else if (*liwork < liwmin && ! lquery) {
14831 0 : *info = -20;
14832 : }
14833 : }
14834 :
14835 584795 : if (*info == 0) {
14836 : nb = 32;
14837 : /* Computing MAX */
14838 584795 : i__1 = (nb + 1) * *n;
14839 : lwkopt = (i__1>lwmin) ? i__1 : lwmin;
14840 584795 : work[1] = (double) lwkopt;
14841 584795 : iwork[1] = liwmin;
14842 : } else
14843 : return;
14844 :
14845 584795 : if (lquery)
14846 : return;
14847 :
14848 570596 : *m = 0;
14849 570596 : if (*n == 0) {
14850 0 : work[1] = 1.;
14851 0 : return;
14852 : }
14853 :
14854 570596 : if (*n == 1) {
14855 588 : work[1] = 7.;
14856 588 : if (alleig || indeig) {
14857 588 : *m = 1;
14858 588 : w[1] = a[a_dim1 + 1];
14859 : } else {
14860 0 : if (*vl < a[a_dim1 + 1] && *vu >= a[a_dim1 + 1]) {
14861 0 : *m = 1;
14862 0 : w[1] = a[a_dim1 + 1];
14863 : }
14864 : }
14865 588 : if (wantz) {
14866 586 : z__[z_dim1 + 1] = 1.;
14867 : }
14868 588 : return;
14869 : }
14870 : minval = PLUMED_GMX_DOUBLE_MIN;
14871 : safmin = minval*(1.0+PLUMED_GMX_DOUBLE_EPS);
14872 : eps = PLUMED_GMX_DOUBLE_EPS;
14873 :
14874 : smlnum = safmin / eps;
14875 : bignum = 1. / smlnum;
14876 : rmin = std::sqrt(smlnum);
14877 :
14878 570008 : d__1 = std::sqrt(bignum), d__2 = 1. / std::sqrt(sqrt(safmin));
14879 : rmax = (d__1<d__2) ? d__1 : d__2;
14880 :
14881 : iscale = 0;
14882 570008 : anrm = PLUMED_BLAS_F77_FUNC(dlansy,DLANSY)("M", uplo, n, &a[a_offset], lda, &work[1]);
14883 570008 : if (anrm > 0. && anrm < rmin) {
14884 : iscale = 1;
14885 0 : sigma = rmin / anrm;
14886 570008 : } else if (anrm > rmax) {
14887 : iscale = 1;
14888 0 : sigma = rmax / anrm;
14889 : }
14890 : if (iscale == 1) {
14891 0 : if (lower) {
14892 0 : i__1 = *n;
14893 0 : for (j = 1; j <= i__1; ++j) {
14894 0 : i__2 = *n - j + 1;
14895 0 : PLUMED_BLAS_F77_FUNC(dscal,DSCAL)(&i__2, &sigma, &a[j + j * a_dim1], &c__1);
14896 : }
14897 : } else {
14898 0 : i__1 = *n;
14899 0 : for (j = 1; j <= i__1; ++j) {
14900 0 : PLUMED_BLAS_F77_FUNC(dscal,DSCAL)(&j, &sigma, &a[j * a_dim1 + 1], &c__1);
14901 :
14902 : }
14903 : }
14904 : }
14905 :
14906 : indtau = 1;
14907 570008 : inde = indtau + *n;
14908 570008 : indd = inde + *n;
14909 570008 : indee = indd + *n;
14910 570008 : inddd = indee + *n;
14911 570008 : indifl = inddd + *n;
14912 570008 : indwk = indifl + *n;
14913 570008 : llwork = *lwork - indwk + 1;
14914 570008 : PLUMED_BLAS_F77_FUNC(dsytrd,DSYTRD)(uplo, n, &a[a_offset], lda, &work[indd], &work[inde], &work[
14915 570008 : indtau], &work[indwk], &llwork, &iinfo);
14916 :
14917 570008 : i__1 = *n - 1;
14918 570008 : PLUMED_BLAS_F77_FUNC(dcopy,DCOPY)(&i__1, &work[inde], &c__1, &work[indee], &c__1);
14919 570008 : PLUMED_BLAS_F77_FUNC(dcopy,DCOPY)(n, &work[indd], &c__1, &work[inddd], &c__1);
14920 :
14921 570008 : PLUMED_BLAS_F77_FUNC(dstegr,DSTEGR)(jobz, range, n, &work[inddd], &work[indee], vl, vu, il, iu,
14922 : abstol, m, &w[1], &z__[z_offset], ldz, &isuppz[1],
14923 : &work[indwk], lwork, &iwork[1], liwork, info);
14924 570008 : if (wantz && *info == 0) {
14925 : indwkn = inde;
14926 569964 : llwrkn = *lwork - indwkn + 1;
14927 569964 : PLUMED_BLAS_F77_FUNC(dormtr,DORMTR)("L", uplo, "N", n, m, &a[a_offset], lda, &work[indtau]
14928 : , &z__[z_offset], ldz, &work[indwkn], &llwrkn, &iinfo);
14929 : }
14930 :
14931 570008 : if (*info != 0)
14932 : return;
14933 :
14934 570008 : if (iscale == 1) {
14935 : if (*info == 0) {
14936 0 : imax = *m;
14937 : } else {
14938 : imax = *info - 1;
14939 : }
14940 0 : d__1 = 1. / sigma;
14941 0 : PLUMED_BLAS_F77_FUNC(dscal,DSCAL)(&imax, &d__1, &w[1], &c__1);
14942 : }
14943 :
14944 570008 : if (wantz) {
14945 569964 : i__1 = *m - 1;
14946 :
14947 607531 : for (j = 1; j <= i__1; ++j) {
14948 : i__ = 0;
14949 37567 : tmp1 = w[j];
14950 37567 : i__2 = *m;
14951 291780 : for (jj = j + 1; jj <= i__2; ++jj) {
14952 254213 : if (w[jj] < tmp1) {
14953 : i__ = jj;
14954 : tmp1 = w[jj];
14955 : }
14956 : }
14957 :
14958 37567 : if (i__ != 0) {
14959 0 : itmp1 = iwork[indibl + i__ - 1];
14960 0 : w[i__] = w[j];
14961 0 : iwork[indibl + i__ - 1] = iwork[indibl + j - 1];
14962 0 : w[j] = tmp1;
14963 0 : iwork[indibl + j - 1] = itmp1;
14964 0 : PLUMED_BLAS_F77_FUNC(dswap,DSWAP)(n, &z__[i__ * z_dim1 + 1], &c__1, &z__[j * z_dim1 + 1],
14965 : &c__1);
14966 : }
14967 : }
14968 : }
14969 :
14970 570008 : work[1] = (double) lwkopt;
14971 570008 : iwork[1] = liwmin;
14972 570008 : return;
14973 :
14974 : }
14975 : }
14976 : }
14977 : #include <cctype>
14978 : #include <cmath>
14979 :
14980 : #include "real.h"
14981 :
14982 : #include "blas/blas.h"
14983 : #include "lapack.h"
14984 :
14985 : #include "blas/blas.h"
14986 : namespace PLMD{
14987 : namespace lapack{
14988 : using namespace blas;
14989 : void
14990 570008 : PLUMED_BLAS_F77_FUNC(dsytd2,DSYTD2)(const char * uplo,
14991 : int * n,
14992 : double * a,
14993 : int * lda,
14994 : double * d,
14995 : double * e,
14996 : double * tau,
14997 : int * info)
14998 : {
14999 : double minusone,zero;
15000 : double taui,alpha,tmp;
15001 : int ti1,ti2,ti3,i;
15002 570008 : const char ch=std::toupper(*uplo);
15003 :
15004 570008 : zero = 0.0;
15005 570008 : minusone = -1.0;
15006 :
15007 570008 : if(*n<=0)
15008 : return;
15009 :
15010 570008 : if(ch=='U') {
15011 2253916 : for(i=*n-1;i>=1;i--) {
15012 :
15013 1683908 : ti1 = 1;
15014 1683908 : PLUMED_BLAS_F77_FUNC(dlarfg,DLARFG)(&i,&(a[i*(*lda)+(i-1)]),&(a[i*(*lda)+0]),&ti1,&taui);
15015 1683908 : e[i-1] = a[i*(*lda) + (i-1)];
15016 1683908 : if(std::abs(taui)>PLUMED_GMX_DOUBLE_MIN) {
15017 1113895 : a[i*(*lda)+(i-1)] = 1.0;
15018 :
15019 1113895 : ti1 = 1;
15020 1113895 : PLUMED_BLAS_F77_FUNC(dsymv,DSYMV)("U",&i,&taui,a,lda,&(a[i*(*lda)+0]),&ti1,&zero,tau,&ti1);
15021 :
15022 1113895 : tmp = PLUMED_BLAS_F77_FUNC(ddot,DDOT)(&i,tau,&ti1,&(a[i*(*lda)+0]),&ti1);
15023 :
15024 1113895 : alpha = -0.5*taui*tmp;
15025 :
15026 1113895 : PLUMED_BLAS_F77_FUNC(daxpy,DAXPY)(&i,&alpha,&(a[i*(*lda)+0]),&ti1,tau,&ti1);
15027 :
15028 1113895 : PLUMED_BLAS_F77_FUNC(dsyr2,DSYR2)("U",&i,&minusone,&(a[i*(*lda)+0]),&ti1,tau,&ti1,a,lda);
15029 :
15030 1113895 : a[i*(*lda)+(i-1)] = e[i-1];
15031 :
15032 : }
15033 1683908 : d[i] = a[i*(*lda)+i];
15034 1683908 : tau[i-1] = taui;
15035 : }
15036 570008 : d[0] = a[0];
15037 :
15038 : } else {
15039 : /* lower */
15040 :
15041 0 : for(i=1;i<*n;i++) {
15042 :
15043 0 : ti1 = *n - i;
15044 0 : ti2 = ( *n < i+2) ? *n : i+2;
15045 0 : ti3 = 1;
15046 0 : PLUMED_BLAS_F77_FUNC(dlarfg,DLARFG)(&ti1,&(a[(i-1)*(*lda)+(i)]),&(a[(i-1)*(*lda)+ti2-1]),&ti3,&taui);
15047 :
15048 0 : e[i-1] = a[(i-1)*(*lda) + (i)];
15049 :
15050 0 : if(std::abs(taui)>PLUMED_GMX_DOUBLE_MIN) {
15051 0 : a[(i-1)*(*lda)+(i)] = 1.0;
15052 :
15053 0 : ti1 = *n - i;
15054 0 : ti2 = 1;
15055 0 : PLUMED_BLAS_F77_FUNC(dsymv,DSYMV)(uplo,&ti1,&taui,&(a[i*(*lda)+i]),lda,&(a[(i-1)*(*lda)+i]),
15056 : &ti2,&zero,&(tau[i-1]),&ti2);
15057 :
15058 0 : tmp = PLUMED_BLAS_F77_FUNC(ddot,DDOT)(&ti1,&(tau[i-1]),&ti2,&(a[(i-1)*(*lda)+i]),&ti2);
15059 :
15060 0 : alpha = -0.5*taui*tmp;
15061 :
15062 0 : PLUMED_BLAS_F77_FUNC(daxpy,DAXPY)(&ti1,&alpha,&(a[(i-1)*(*lda)+i]),&ti2,&(tau[i-1]),&ti2);
15063 :
15064 0 : PLUMED_BLAS_F77_FUNC(dsyr2,DSYR2)(uplo,&ti1,&minusone,&(a[(i-1)*(*lda)+i]),&ti2,&(tau[i-1]),&ti2,
15065 0 : &(a[(i)*(*lda)+i]),lda);
15066 :
15067 0 : a[(i-1)*(*lda)+(i)] = e[i-1];
15068 :
15069 : }
15070 0 : d[i-1] = a[(i-1)*(*lda)+i-1];
15071 0 : tau[i-1] = taui;
15072 : }
15073 0 : d[*n-1] = a[(*n-1)*(*lda)+(*n-1)];
15074 :
15075 : }
15076 : return;
15077 : }
15078 : }
15079 : }
15080 : #include "blas/blas.h"
15081 : #include "lapack.h"
15082 : #include "lapack_limits.h"
15083 :
15084 : #include "blas/blas.h"
15085 : namespace PLMD{
15086 : namespace lapack{
15087 : using namespace blas;
15088 : void
15089 570008 : PLUMED_BLAS_F77_FUNC(dsytrd,DSYTRD)(const char *uplo, int *n, double *a, int *
15090 : lda, double *d__, double *e, double *tau, double *
15091 : work, int *lwork, int *info)
15092 : {
15093 : /* System generated locals */
15094 : int a_dim1, a_offset, i__1, i__2, i__3;
15095 :
15096 : /* Local variables */
15097 : int i__, j, nb, kk, nx, iws;
15098 : int nbmin, iinfo;
15099 : int upper;
15100 : int ldwork, lwkopt;
15101 : int lquery;
15102 570008 : double c_b22 = -1.;
15103 570008 : double c_b23 = 1.;
15104 :
15105 :
15106 : /* Parameter adjustments */
15107 570008 : a_dim1 = *lda;
15108 570008 : a_offset = 1 + a_dim1;
15109 570008 : a -= a_offset;
15110 570008 : --d__;
15111 570008 : --e;
15112 570008 : --tau;
15113 : --work;
15114 :
15115 : /* Function Body */
15116 570008 : *info = 0;
15117 570008 : upper = (*uplo=='U' || *uplo=='u');
15118 570008 : lquery = (*lwork == -1);
15119 :
15120 570008 : if (! upper && ! (*uplo=='L' || *uplo=='l')) {
15121 0 : *info = -1;
15122 570008 : } else if (*n < 0) {
15123 0 : *info = -2;
15124 570008 : } else if (*lda < ((1>*n) ? 1 : *n)) {
15125 0 : *info = -4;
15126 570008 : } else if (*lwork < 1 && ! lquery) {
15127 0 : *info = -9;
15128 : }
15129 :
15130 570008 : if (*info == 0) {
15131 :
15132 570008 : nb = DSYTRD_BLOCKSIZE;
15133 570008 : lwkopt = *n * nb;
15134 570008 : work[1] = (double) lwkopt;
15135 : } else
15136 : return;
15137 :
15138 570008 : if (lquery)
15139 : return;
15140 :
15141 570008 : if (*n == 0) {
15142 0 : work[1] = 1.;
15143 0 : return;
15144 : }
15145 :
15146 : nx = *n;
15147 570008 : if (nb > 1 && nb < *n) {
15148 :
15149 : nx = DSYTRD_CROSSOVER;
15150 12 : if (nx < *n) {
15151 :
15152 2 : ldwork = *n;
15153 2 : iws = ldwork * nb;
15154 2 : if (*lwork < iws) {
15155 :
15156 2 : i__1 = *lwork / ldwork;
15157 2 : nb = (i__1>1) ? i__1 : 1;
15158 : nbmin = DSYTRD_MINBLOCKSIZE;
15159 2 : if (nb < nbmin) {
15160 : nx = *n;
15161 : }
15162 : }
15163 : } else {
15164 : nx = *n;
15165 : }
15166 : } else {
15167 569996 : nb = 1;
15168 : }
15169 :
15170 570008 : if (upper) {
15171 :
15172 570008 : kk = *n - (*n - nx + nb - 1) / nb * nb;
15173 570008 : i__1 = kk + 1;
15174 : i__2 = -nb;
15175 570027 : for (i__ = *n - nb + 1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ +=
15176 : i__2) {
15177 :
15178 19 : i__3 = i__ + nb - 1;
15179 19 : PLUMED_BLAS_F77_FUNC(dlatrd,DLATRD)(uplo, &i__3, &nb, &a[a_offset], lda, &e[1], &tau[1], &
15180 : work[1], &ldwork);
15181 :
15182 19 : i__3 = i__ - 1;
15183 19 : PLUMED_BLAS_F77_FUNC(dsyr2k,DSYR2K)(uplo, "No transpose", &i__3, &nb, &c_b22, &a[i__ * a_dim1
15184 19 : + 1], lda, &work[1], &ldwork, &c_b23, &a[a_offset], lda);
15185 :
15186 19 : i__3 = i__ + nb - 1;
15187 532 : for (j = i__; j <= i__3; ++j) {
15188 513 : a[j - 1 + j * a_dim1] = e[j - 1];
15189 513 : d__[j] = a[j + j * a_dim1];
15190 :
15191 : }
15192 :
15193 : }
15194 :
15195 570008 : PLUMED_BLAS_F77_FUNC(dsytd2,DSYTD2)(uplo, &kk, &a[a_offset], lda, &d__[1], &e[1], &tau[1], &iinfo);
15196 : } else {
15197 :
15198 0 : i__2 = *n - nx;
15199 0 : i__1 = nb;
15200 0 : for (i__ = 1; i__1 < 0 ? i__ >= i__2 : i__ <= i__2; i__ += i__1) {
15201 :
15202 :
15203 0 : i__3 = *n - i__ + 1;
15204 0 : PLUMED_BLAS_F77_FUNC(dlatrd,DLATRD)(uplo, &i__3, &nb, &a[i__ + i__ * a_dim1], lda, &e[i__], &
15205 0 : tau[i__], &work[1], &ldwork);
15206 :
15207 0 : i__3 = *n - i__ - nb + 1;
15208 0 : PLUMED_BLAS_F77_FUNC(dsyr2k,DSYR2K)(uplo, "No transpose", &i__3, &nb, &c_b22, &a[i__ + nb +
15209 0 : i__ * a_dim1], lda, &work[nb + 1], &ldwork, &c_b23, &a[
15210 0 : i__ + nb + (i__ + nb) * a_dim1], lda);
15211 :
15212 :
15213 0 : i__3 = i__ + nb - 1;
15214 0 : for (j = i__; j <= i__3; ++j) {
15215 0 : a[j + 1 + j * a_dim1] = e[j];
15216 0 : d__[j] = a[j + j * a_dim1];
15217 :
15218 : }
15219 :
15220 : }
15221 :
15222 :
15223 0 : i__1 = *n - i__ + 1;
15224 0 : PLUMED_BLAS_F77_FUNC(dsytd2,DSYTD2)(uplo, &i__1, &a[i__ + i__ * a_dim1], lda, &d__[i__], &e[i__],
15225 0 : &tau[i__], &iinfo);
15226 : }
15227 :
15228 570008 : work[1] = (double) lwkopt;
15229 570008 : return;
15230 :
15231 : }
15232 :
15233 :
15234 : }
15235 : }
15236 : #include "blas/blas.h"
15237 : #include "lapack.h"
15238 : #include "lapack_limits.h"
15239 :
15240 : #include "blas/blas.h"
15241 : namespace PLMD{
15242 : namespace lapack{
15243 : using namespace blas;
15244 : void
15245 57 : PLUMED_BLAS_F77_FUNC(dtrti2,DTRTI2)(const char *uplo,
15246 : const char *diag,
15247 : int *n,
15248 : double *a,
15249 : int *lda,
15250 : int *info)
15251 : {
15252 : int a_dim1, a_offset, i__1, i__2;
15253 :
15254 : int j;
15255 : double ajj;
15256 : int upper, nounit;
15257 57 : int c__1 = 1;
15258 :
15259 :
15260 57 : a_dim1 = *lda;
15261 57 : a_offset = 1 + a_dim1;
15262 57 : a -= a_offset;
15263 :
15264 57 : *info = 0;
15265 57 : upper = (*uplo=='U' || *uplo=='u');
15266 57 : nounit = (*diag=='N' || *diag=='n');
15267 :
15268 : if (*info != 0) {
15269 : i__1 = -(*info);
15270 : return;
15271 : }
15272 :
15273 57 : if (upper) {
15274 :
15275 57 : i__1 = *n;
15276 171 : for (j = 1; j <= i__1; ++j) {
15277 114 : if (nounit) {
15278 114 : a[j + j * a_dim1] = 1. / a[j + j * a_dim1];
15279 114 : ajj = -a[j + j * a_dim1];
15280 : } else {
15281 0 : ajj = -1.;
15282 : }
15283 :
15284 114 : i__2 = j - 1;
15285 114 : PLUMED_BLAS_F77_FUNC(dtrmv,DTRMV)("Upper", "No transpose", diag, &i__2, &a[a_offset], lda, &
15286 114 : a[j * a_dim1 + 1], &c__1);
15287 114 : i__2 = j - 1;
15288 114 : PLUMED_BLAS_F77_FUNC(dscal,DSCAL)(&i__2, &ajj, &a[j * a_dim1 + 1], &c__1);
15289 : }
15290 : } else {
15291 :
15292 0 : for (j = *n; j >= 1; --j) {
15293 0 : if (nounit) {
15294 0 : a[j + j * a_dim1] = 1. / a[j + j * a_dim1];
15295 0 : ajj = -a[j + j * a_dim1];
15296 : } else {
15297 0 : ajj = -1.;
15298 : }
15299 0 : if (j < *n) {
15300 :
15301 0 : i__1 = *n - j;
15302 0 : PLUMED_BLAS_F77_FUNC(dtrmv,DTRMV)("Lower", "No transpose", diag, &i__1, &a[j + 1 + (j +
15303 0 : 1) * a_dim1], lda, &a[j + 1 + j * a_dim1], &c__1);
15304 0 : i__1 = *n - j;
15305 0 : PLUMED_BLAS_F77_FUNC(dscal,DSCAL)(&i__1, &ajj, &a[j + 1 + j * a_dim1], &c__1);
15306 : }
15307 : }
15308 : }
15309 : return;
15310 : }
15311 : }
15312 : }
15313 : #include <cmath>
15314 : #include "blas/blas.h"
15315 : #include "lapack.h"
15316 : #include "lapack_limits.h"
15317 :
15318 : #include "real.h"
15319 :
15320 : #include "blas/blas.h"
15321 : namespace PLMD{
15322 : namespace lapack{
15323 : using namespace blas;
15324 : void
15325 57 : PLUMED_BLAS_F77_FUNC(dtrtri,DTRTRI)(const char *uplo,
15326 : const char *diag,
15327 : int *n,
15328 : double *a,
15329 : int *lda,
15330 : int *info)
15331 : {
15332 : int a_dim1, a_offset, i__1, i__3, i__4, i__5;
15333 : int j, jb, nb, nn;
15334 57 : double c_b18 = 1.;
15335 57 : double c_b22 = -1.;
15336 :
15337 : int upper;
15338 : int nounit;
15339 :
15340 57 : a_dim1 = *lda;
15341 57 : a_offset = 1 + a_dim1;
15342 57 : a -= a_offset;
15343 :
15344 57 : *info = 0;
15345 57 : upper = (*uplo=='U' || *uplo=='u');
15346 57 : nounit = (*diag=='N' || *diag=='n');
15347 :
15348 : if (*info != 0) {
15349 : i__1 = -(*info);
15350 : return;
15351 : }
15352 :
15353 57 : if (*n == 0) {
15354 : return;
15355 : }
15356 :
15357 57 : if (nounit) {
15358 57 : i__1 = *n;
15359 171 : for (*info = 1; *info <= i__1; ++(*info)) {
15360 114 : if (std::abs(a[*info + *info * a_dim1])<PLUMED_GMX_DOUBLE_MIN) {
15361 : return;
15362 : }
15363 : }
15364 57 : *info = 0;
15365 : }
15366 :
15367 : nb = DTRTRI_BLOCKSIZE;
15368 57 : if (nb <= 1 || nb >= *n) {
15369 :
15370 57 : PLUMED_BLAS_F77_FUNC(dtrti2,DTRTI2)(uplo, diag, n, &a[a_offset], lda, info);
15371 : } else {
15372 :
15373 0 : if (upper) {
15374 :
15375 0 : i__1 = *n;
15376 : i__3 = nb;
15377 0 : for (j = 1; i__3 < 0 ? j >= i__1 : j <= i__1; j += i__3) {
15378 0 : i__4 = nb, i__5 = *n - j + 1;
15379 0 : jb = (i__4<i__5) ? i__4 : i__5;
15380 :
15381 0 : i__4 = j - 1;
15382 0 : PLUMED_BLAS_F77_FUNC(dtrmm,DTRMM)("Left", "Upper", "No transpose", diag, &i__4, &jb, &
15383 0 : c_b18, &a[a_offset], lda, &a[j * a_dim1 + 1], lda);
15384 0 : i__4 = j - 1;
15385 0 : PLUMED_BLAS_F77_FUNC(dtrsm,DTRSM)("Right", "Upper", "No transpose", diag, &i__4, &jb, &
15386 0 : c_b22, &a[j + j * a_dim1], lda, &a[j * a_dim1 + 1],
15387 : lda);
15388 :
15389 0 : PLUMED_BLAS_F77_FUNC(dtrti2,DTRTI2)("Upper", diag, &jb, &a[j + j * a_dim1], lda, info);
15390 : }
15391 : } else {
15392 :
15393 0 : nn = (*n - 1) / nb * nb + 1;
15394 : i__3 = -nb;
15395 0 : for (j = nn; i__3 < 0 ? j >= 1 : j <= 1; j += i__3) {
15396 0 : i__1 = nb, i__4 = *n - j + 1;
15397 0 : jb = (i__1<i__4) ? i__1 : i__4;
15398 0 : if (j + jb <= *n) {
15399 :
15400 0 : i__1 = *n - j - jb + 1;
15401 0 : PLUMED_BLAS_F77_FUNC(dtrmm,DTRMM)("Left", "Lower", "No transpose", diag, &i__1, &jb,
15402 0 : &c_b18, &a[j + jb + (j + jb) * a_dim1], lda, &a[j
15403 0 : + jb + j * a_dim1], lda);
15404 0 : i__1 = *n - j - jb + 1;
15405 0 : PLUMED_BLAS_F77_FUNC(dtrsm,DTRSM)("Right", "Lower", "No transpose", diag, &i__1, &jb,
15406 0 : &c_b22, &a[j + j * a_dim1], lda, &a[j + jb + j *
15407 0 : a_dim1], lda);
15408 : }
15409 :
15410 0 : PLUMED_BLAS_F77_FUNC(dtrti2,DTRTI2)("Lower", diag, &jb, &a[j + j * a_dim1], lda, info);
15411 : }
15412 : }
15413 : }
15414 : return;
15415 : }
15416 :
15417 :
15418 : }
15419 : }
15420 : #include "lapack.h"
15421 :
15422 : #include "blas/blas.h"
15423 : namespace PLMD{
15424 : namespace lapack{
15425 : using namespace blas;
15426 : void
15427 12 : PLUMED_BLAS_F77_FUNC(ilasrt2,ILASRT2)(const char *id,
15428 : int *n,
15429 : int *d__,
15430 : int *key,
15431 : int *info)
15432 : {
15433 : int i__1, i__2;
15434 : int i__, j, d1, d2, d3, dir, tmp, endd;
15435 : int stack[64], dmnmx, start;
15436 : int tmpkey, stkpnt;
15437 :
15438 12 : --key;
15439 12 : --d__;
15440 :
15441 12 : *info = 0;
15442 : dir = -1;
15443 12 : if (*id=='D' || *id=='d')
15444 : dir = 0;
15445 12 : else if (*id=='I' || *id=='i')
15446 : dir = 1;
15447 :
15448 : if (dir == -1) {
15449 0 : *info = -1;
15450 12 : } else if (*n < 0) {
15451 0 : *info = -2;
15452 : }
15453 12 : if (*info != 0) {
15454 : return;
15455 : }
15456 :
15457 12 : if (*n <= 1) {
15458 : return;
15459 : }
15460 :
15461 : stkpnt = 1;
15462 9 : stack[0] = 1;
15463 9 : stack[1] = *n;
15464 9 : L10:
15465 9 : start = stack[(stkpnt << 1) - 2];
15466 9 : endd = stack[(stkpnt << 1) - 1];
15467 9 : --stkpnt;
15468 9 : if (endd - start > 0) {
15469 :
15470 9 : if (dir == 0) {
15471 :
15472 : i__1 = endd;
15473 0 : for (i__ = start + 1; i__ <= i__1; ++i__) {
15474 : i__2 = start + 1;
15475 0 : for (j = i__; j >= i__2; --j) {
15476 0 : if (d__[j] > d__[j - 1]) {
15477 : dmnmx = d__[j];
15478 0 : d__[j] = d__[j - 1];
15479 0 : d__[j - 1] = dmnmx;
15480 0 : tmpkey = key[j];
15481 0 : key[j] = key[j - 1];
15482 0 : key[j - 1] = tmpkey;
15483 : } else {
15484 0 : goto L30;
15485 : }
15486 : }
15487 0 : L30:
15488 : ;
15489 : }
15490 :
15491 : } else {
15492 :
15493 : i__1 = endd;
15494 766 : for (i__ = start + 1; i__ <= i__1; ++i__) {
15495 : i__2 = start + 1;
15496 17379 : for (j = i__; j >= i__2; --j) {
15497 17291 : if (d__[j] < d__[j - 1]) {
15498 : dmnmx = d__[j];
15499 16622 : d__[j] = d__[j - 1];
15500 16622 : d__[j - 1] = dmnmx;
15501 16622 : tmpkey = key[j];
15502 16622 : key[j] = key[j - 1];
15503 16622 : key[j - 1] = tmpkey;
15504 : } else {
15505 669 : goto L50;
15506 : }
15507 : }
15508 757 : L50:
15509 : ;
15510 : }
15511 :
15512 : }
15513 :
15514 0 : } else if (endd - start > 20) {
15515 :
15516 0 : d1 = d__[start];
15517 0 : d2 = d__[endd];
15518 0 : i__ = (start + endd) / 2;
15519 0 : d3 = d__[i__];
15520 0 : if (d1 < d2) {
15521 0 : if (d3 < d1) {
15522 : dmnmx = d1;
15523 : } else if (d3 < d2) {
15524 : dmnmx = d3;
15525 : } else {
15526 : dmnmx = d2;
15527 : }
15528 : } else {
15529 0 : if (d3 < d2) {
15530 : dmnmx = d2;
15531 : } else if (d3 < d1) {
15532 : dmnmx = d3;
15533 : } else {
15534 : dmnmx = d1;
15535 : }
15536 : }
15537 :
15538 0 : if (dir == 0) {
15539 :
15540 0 : i__ = start - 1;
15541 0 : j = endd + 1;
15542 0 : L60:
15543 0 : L70:
15544 0 : --j;
15545 0 : if (d__[j] < dmnmx) {
15546 0 : goto L70;
15547 : }
15548 0 : L80:
15549 0 : ++i__;
15550 0 : if (d__[i__] > dmnmx) {
15551 0 : goto L80;
15552 : }
15553 0 : if (i__ < j) {
15554 : tmp = d__[i__];
15555 0 : d__[i__] = d__[j];
15556 0 : d__[j] = tmp;
15557 0 : tmpkey = key[j];
15558 0 : key[j] = key[i__];
15559 0 : key[i__] = tmpkey;
15560 0 : goto L60;
15561 : }
15562 0 : if (j - start > endd - j - 1) {
15563 : ++stkpnt;
15564 : stack[(stkpnt << 1) - 2] = start;
15565 0 : stack[(stkpnt << 1) - 1] = j;
15566 0 : ++stkpnt;
15567 0 : stack[(stkpnt << 1) - 2] = j + 1;
15568 0 : stack[(stkpnt << 1) - 1] = endd;
15569 : } else {
15570 : ++stkpnt;
15571 0 : stack[(stkpnt << 1) - 2] = j + 1;
15572 0 : stack[(stkpnt << 1) - 1] = endd;
15573 0 : ++stkpnt;
15574 0 : stack[(stkpnt << 1) - 2] = start;
15575 0 : stack[(stkpnt << 1) - 1] = j;
15576 : }
15577 : } else {
15578 :
15579 0 : i__ = start - 1;
15580 0 : j = endd + 1;
15581 0 : L90:
15582 0 : L100:
15583 0 : --j;
15584 0 : if (d__[j] > dmnmx) {
15585 0 : goto L100;
15586 : }
15587 0 : L110:
15588 0 : ++i__;
15589 0 : if (d__[i__] < dmnmx) {
15590 0 : goto L110;
15591 : }
15592 0 : if (i__ < j) {
15593 : tmp = d__[i__];
15594 0 : d__[i__] = d__[j];
15595 0 : d__[j] = tmp;
15596 0 : tmpkey = key[j];
15597 0 : key[j] = key[i__];
15598 0 : key[i__] = tmpkey;
15599 0 : goto L90;
15600 : }
15601 0 : if (j - start > endd - j - 1) {
15602 : ++stkpnt;
15603 : stack[(stkpnt << 1) - 2] = start;
15604 0 : stack[(stkpnt << 1) - 1] = j;
15605 0 : ++stkpnt;
15606 0 : stack[(stkpnt << 1) - 2] = j + 1;
15607 0 : stack[(stkpnt << 1) - 1] = endd;
15608 : } else {
15609 : ++stkpnt;
15610 0 : stack[(stkpnt << 1) - 2] = j + 1;
15611 0 : stack[(stkpnt << 1) - 1] = endd;
15612 0 : ++stkpnt;
15613 0 : stack[(stkpnt << 1) - 2] = start;
15614 0 : stack[(stkpnt << 1) - 1] = j;
15615 : }
15616 : }
15617 : }
15618 9 : if (stkpnt > 0) {
15619 0 : goto L10;
15620 : }
15621 :
15622 :
15623 : return;
15624 : }
15625 : }
15626 : }
15627 : #include <cctype>
15628 : #include <cmath>
15629 : #include "blas/blas.h"
15630 : #include "lapack.h"
15631 : #include "lapack_limits.h"
15632 :
15633 : #include "real.h"
15634 :
15635 : #include "blas/blas.h"
15636 : namespace PLMD{
15637 : namespace lapack{
15638 : using namespace blas;
15639 : void
15640 0 : PLUMED_BLAS_F77_FUNC(sbdsdc,SBDSDC)(const char *uplo,
15641 : const char *compq,
15642 : int *n,
15643 : float *d__,
15644 : float *e,
15645 : float *u,
15646 : int *ldu,
15647 : float *vt,
15648 : int *ldvt,
15649 : float *q,
15650 : int *iq,
15651 : float *work,
15652 : int *iwork,
15653 : int *info)
15654 : {
15655 : int u_dim1, u_offset, vt_dim1, vt_offset, i__1, i__2;
15656 : int i__, j, k;
15657 : float p, r__;
15658 : int z__, ic, ii, kk;
15659 : float cs;
15660 : int is, iu;
15661 : float sn;
15662 : int nm1;
15663 : float eps;
15664 : int ivt, difl, difr, ierr, perm, mlvl, sqre;
15665 : int poles, iuplo, nsize, start;
15666 : int givcol;
15667 : int icompq;
15668 : float orgnrm;
15669 : int givnum, givptr, qstart, smlsiz, wstart, smlszp;
15670 0 : float zero = 0.0;
15671 0 : float one = 1.0;
15672 0 : int c_0 = 0;
15673 0 : int c_1 = 1;
15674 :
15675 0 : --d__;
15676 0 : --e;
15677 0 : u_dim1 = *ldu;
15678 0 : u_offset = 1 + u_dim1;
15679 0 : u -= u_offset;
15680 0 : vt_dim1 = *ldvt;
15681 0 : vt_offset = 1 + vt_dim1;
15682 0 : vt -= vt_offset;
15683 0 : --q;
15684 0 : --iq;
15685 0 : --work;
15686 : --iwork;
15687 :
15688 : k = iu = z__ = ic = is = ivt = difl = difr = perm = 0;
15689 : poles = givnum = givptr = givcol = 0;
15690 :
15691 0 : smlsiz = DBDSDC_SMALLSIZE;
15692 0 : *info = 0;
15693 :
15694 0 : iuplo = (*uplo=='U' || *uplo=='u') ? 1 : 2;
15695 :
15696 0 : switch(*compq) {
15697 0 : case 'n':
15698 : case 'N':
15699 0 : icompq = 0;
15700 0 : break;
15701 0 : case 'p':
15702 : case 'P':
15703 0 : icompq = 1;
15704 0 : break;
15705 0 : case 'i':
15706 : case 'I':
15707 0 : icompq = 2;
15708 0 : break;
15709 : default:
15710 : return;
15711 : }
15712 :
15713 0 : if (*n <= 0)
15714 : return;
15715 :
15716 0 : if (*n == 1) {
15717 0 : if (icompq == 1) {
15718 0 : q[1] = (d__[1]>0) ? 1.0 : -1.0;
15719 0 : q[smlsiz * *n + 1] = 1.;
15720 0 : } else if (icompq == 2) {
15721 0 : u[u_dim1 + 1] = (d__[1]>0) ? 1.0 : -1.0;
15722 0 : vt[vt_dim1 + 1] = 1.;
15723 : }
15724 0 : d__[1] = std::abs(d__[1]);
15725 0 : return;
15726 : }
15727 0 : nm1 = *n - 1;
15728 : wstart = 1;
15729 : qstart = 3;
15730 0 : if (icompq == 1) {
15731 0 : PLUMED_BLAS_F77_FUNC(scopy,SCOPY)(n, &d__[1], &c_1, &q[1], &c_1);
15732 0 : i__1 = *n - 1;
15733 0 : PLUMED_BLAS_F77_FUNC(scopy,SCOPY)(&i__1, &e[1], &c_1, &q[*n + 1], &c_1);
15734 : }
15735 0 : if (iuplo == 2) {
15736 : qstart = 5;
15737 0 : wstart = (*n << 1) - 1;
15738 0 : i__1 = *n - 1;
15739 0 : for (i__ = 1; i__ <= i__1; ++i__) {
15740 0 : PLUMED_BLAS_F77_FUNC(slartg,SLARTG)(&d__[i__], &e[i__], &cs, &sn, &r__);
15741 0 : d__[i__] = r__;
15742 0 : e[i__] = sn * d__[i__ + 1];
15743 0 : d__[i__ + 1] = cs * d__[i__ + 1];
15744 0 : if (icompq == 1) {
15745 0 : q[i__ + (*n << 1)] = cs;
15746 0 : q[i__ + *n * 3] = sn;
15747 0 : } else if (icompq == 2) {
15748 0 : work[i__] = cs;
15749 0 : work[nm1 + i__] = -sn;
15750 : }
15751 : }
15752 : }
15753 0 : if (icompq == 0) {
15754 0 : PLUMED_BLAS_F77_FUNC(slasdq,SLASDQ)("U",&c_0,n,&c_0,&c_0,&c_0,&d__[1],&e[1],&vt[vt_offset],ldvt,
15755 0 : &u[u_offset], ldu, &u[u_offset], ldu, &work[wstart], info);
15756 0 : goto L40;
15757 : }
15758 0 : if (*n <= smlsiz) {
15759 0 : if (icompq == 2) {
15760 0 : PLUMED_BLAS_F77_FUNC(slaset,SLASET)("A", n, n, &zero, &one, &u[u_offset], ldu);
15761 0 : PLUMED_BLAS_F77_FUNC(slaset,SLASET)("A", n, n, &zero, &one, &vt[vt_offset], ldvt);
15762 0 : PLUMED_BLAS_F77_FUNC(slasdq,SLASDQ)("U",&c_0,n,n,n,&c_0,&d__[1],&e[1],&vt[vt_offset],ldvt,
15763 0 : &u[u_offset],ldu,&u[u_offset],ldu,&work[wstart],info);
15764 0 : } else if (icompq == 1) {
15765 : iu = 1;
15766 0 : ivt = iu + *n;
15767 0 : PLUMED_BLAS_F77_FUNC(slaset,SLASET)("A", n, n, &zero, &one, &q[iu + (qstart - 1) * *n], n);
15768 0 : PLUMED_BLAS_F77_FUNC(slaset,SLASET)("A", n, n, &zero, &one, &q[ivt + (qstart - 1) * *n], n);
15769 0 : PLUMED_BLAS_F77_FUNC(slasdq,SLASDQ)("U", &c_0, n, n, n, &c_0, &d__[1], &e[1],
15770 0 : &q[ivt + (qstart - 1) * *n], n, &q[iu + (qstart - 1) * *n],
15771 0 : n, &q[iu + (qstart - 1) * *n], n, &work[wstart], info);
15772 : }
15773 0 : goto L40;
15774 : }
15775 :
15776 0 : if (icompq == 2) {
15777 0 : PLUMED_BLAS_F77_FUNC(slaset,SLASET)("A", n, n, &zero, &one, &u[u_offset], ldu);
15778 0 : PLUMED_BLAS_F77_FUNC(slaset,SLASET)("A", n, n, &zero, &one, &vt[vt_offset], ldvt);
15779 : }
15780 :
15781 0 : orgnrm = PLUMED_BLAS_F77_FUNC(slanst,SLANST)("M", n, &d__[1], &e[1]);
15782 0 : if ( std::abs(orgnrm)<PLUMED_GMX_FLOAT_MIN) {
15783 : return;
15784 : }
15785 0 : PLUMED_BLAS_F77_FUNC(slascl,SLASCL)("G", &c_0, &c_0, &orgnrm, &one, n, &c_1, &d__[1], n, &ierr);
15786 0 : PLUMED_BLAS_F77_FUNC(slascl,SLASCL)("G", &c_0, &c_0, &orgnrm, &one, &nm1, &c_1, &e[1], &nm1, &ierr);
15787 :
15788 : eps = PLUMED_GMX_FLOAT_EPS;
15789 :
15790 0 : mlvl = (int) (std::log((float) (*n) / (float) (smlsiz + 1)) / std::log(2.)) + 1;
15791 : smlszp = smlsiz + 1;
15792 :
15793 0 : if (icompq == 1) {
15794 : iu = 1;
15795 : ivt = smlsiz + 1;
15796 0 : difl = ivt + smlszp;
15797 0 : difr = difl + mlvl;
15798 0 : z__ = difr + (mlvl << 1);
15799 0 : ic = z__ + mlvl;
15800 0 : is = ic + 1;
15801 0 : poles = is + 1;
15802 0 : givnum = poles + (mlvl << 1);
15803 :
15804 : k = 1;
15805 : givptr = 2;
15806 : perm = 3;
15807 0 : givcol = perm + mlvl;
15808 : }
15809 :
15810 0 : i__1 = *n;
15811 0 : for (i__ = 1; i__ <= i__1; ++i__) {
15812 0 : if (std::abs(d__[i__]) < eps)
15813 0 : d__[i__] = (d__[i__]>0) ? eps : -eps;
15814 : }
15815 :
15816 : start = 1;
15817 0 : sqre = 0;
15818 :
15819 0 : i__1 = nm1;
15820 0 : for (i__ = 1; i__ <= i__1; ++i__) {
15821 0 : if (std::abs(e[i__]) < eps || i__ == nm1) {
15822 0 : if (i__ < nm1) {
15823 0 : nsize = i__ - start + 1;
15824 0 : } else if (std::abs(e[i__]) >= eps) {
15825 0 : nsize = *n - start + 1;
15826 : } else {
15827 0 : nsize = i__ - start + 1;
15828 0 : if (icompq == 2) {
15829 0 : u[*n + *n * u_dim1] = (d__[*n]>0) ? 1.0 : -1.0;
15830 0 : vt[*n + *n * vt_dim1] = 1.;
15831 0 : } else if (icompq == 1) {
15832 0 : q[*n + (qstart - 1) * *n] = (d__[*n]>0) ? 1.0 : -1.0;
15833 0 : q[*n + (smlsiz + qstart - 1) * *n] = 1.;
15834 : }
15835 0 : d__[*n] = std::abs(d__[*n]);
15836 : }
15837 0 : if (icompq == 2) {
15838 0 : PLUMED_BLAS_F77_FUNC(slasd0,SLASD0)(&nsize, &sqre, &d__[start], &e[start],
15839 0 : &u[start + start * u_dim1], ldu,
15840 0 : &vt[start + start * vt_dim1],
15841 0 : ldvt, &smlsiz, &iwork[1], &work[wstart], info);
15842 : } else {
15843 0 : PLUMED_BLAS_F77_FUNC(slasda,SLASDA)(&icompq, &smlsiz, &nsize, &sqre, &d__[start],
15844 0 : &e[start], &q[start + (iu + qstart - 2) * *n], n,
15845 0 : &q[start + (ivt + qstart - 2) * *n], &iq[start + k * *n],
15846 0 : &q[start + (difl + qstart - 2) * *n],
15847 0 : &q[start + (difr + qstart - 2) * *n],
15848 0 : &q[start + (z__ + qstart - 2) * *n],
15849 0 : &q[start + (poles + qstart - 2) * *n],
15850 0 : &iq[start + givptr * *n], &iq[start + givcol * *n], n,
15851 0 : &iq[start + perm * *n],
15852 0 : &q[start + (givnum + qstart - 2) * *n],
15853 0 : &q[start + (ic + qstart - 2) * *n],
15854 0 : &q[start + (is + qstart - 2) * *n], &work[wstart],
15855 : &iwork[1], info);
15856 0 : if (*info != 0) {
15857 : return;
15858 : }
15859 : }
15860 0 : start = i__ + 1;
15861 : }
15862 : }
15863 0 : PLUMED_BLAS_F77_FUNC(slascl,SLASCL)("G", &c_0, &c_0, &one, &orgnrm, n, &c_1, &d__[1], n, &ierr);
15864 0 : L40:
15865 0 : i__1 = *n;
15866 0 : for (ii = 2; ii <= i__1; ++ii) {
15867 0 : i__ = ii - 1;
15868 : kk = i__;
15869 0 : p = d__[i__];
15870 0 : i__2 = *n;
15871 0 : for (j = ii; j <= i__2; ++j) {
15872 0 : if (d__[j] > p) {
15873 : kk = j;
15874 : p = d__[j];
15875 : }
15876 : }
15877 0 : if (kk != i__) {
15878 0 : d__[kk] = d__[i__];
15879 0 : d__[i__] = p;
15880 0 : if (icompq == 1) {
15881 0 : iq[i__] = kk;
15882 0 : } else if (icompq == 2) {
15883 0 : PLUMED_BLAS_F77_FUNC(sswap,SSWAP)(n, &u[i__ * u_dim1 + 1],&c_1,&u[kk*u_dim1+1],&c_1);
15884 0 : PLUMED_BLAS_F77_FUNC(sswap,SSWAP)(n, &vt[i__ + vt_dim1], ldvt, &vt[kk + vt_dim1], ldvt);
15885 : }
15886 0 : } else if (icompq == 1) {
15887 0 : iq[i__] = i__;
15888 : }
15889 : }
15890 0 : if (icompq == 1) {
15891 0 : if (iuplo == 1) {
15892 0 : iq[*n] = 1;
15893 : } else {
15894 0 : iq[*n] = 0;
15895 : }
15896 : }
15897 0 : if (iuplo == 2 && icompq == 2) {
15898 0 : PLUMED_BLAS_F77_FUNC(slasr,SLASR)("L", "V", "B", n, n, &work[1], &work[*n], &u[u_offset], ldu);
15899 : }
15900 :
15901 : return;
15902 : }
15903 : }
15904 : }
15905 : #include <cctype>
15906 : #include <cmath>
15907 :
15908 : #include "blas/blas.h"
15909 : #include "lapack.h"
15910 :
15911 : #include "real.h"
15912 :
15913 : #include "blas/blas.h"
15914 : namespace PLMD{
15915 : namespace lapack{
15916 : using namespace blas;
15917 : void
15918 0 : PLUMED_BLAS_F77_FUNC(sbdsqr,SBDSQR)(const char *uplo,
15919 : int *n,
15920 : int *ncvt,
15921 : int *nru,
15922 : int *ncc,
15923 : float *d__,
15924 : float *e,
15925 : float *vt,
15926 : int *ldvt,
15927 : float *u,
15928 : int *ldu,
15929 : float *c__,
15930 : int *ldc,
15931 : float *work,
15932 : int *info)
15933 : {
15934 0 : const char xuplo = std::toupper(*uplo);
15935 : int c_dim1, c_offset, u_dim1, u_offset, vt_dim1, vt_offset, i__1,
15936 : i__2;
15937 : float r__1, r__2, r__3, r__4;
15938 : float c_b15 = -.125;
15939 :
15940 0 : int c__1 = 1;
15941 : float c_b49 = 1.f;
15942 0 : float c_b72 = -1.f;
15943 :
15944 : float f, g, h__;
15945 : int i__, j, m;
15946 : float r__, cs;
15947 : int ll;
15948 : float sn, mu;
15949 : int nm1, nm12, nm13, lll;
15950 : float eps, sll, tol, abse;
15951 : int idir;
15952 : float abss;
15953 : int oldm;
15954 : float cosl;
15955 : int isub, iter;
15956 : float unfl, sinl, cosr, smin, smax, sinr;
15957 : float oldcs;
15958 : int oldll;
15959 0 : float shift, sigmn, oldsn = 0.;
15960 : int maxit;
15961 : float sminl;
15962 : float sigmx;
15963 : int lower;
15964 : float sminoa;
15965 : float thresh;
15966 : int rotate;
15967 : float tolmul;
15968 : int itmp1,itmp2;
15969 :
15970 0 : --d__;
15971 0 : --e;
15972 0 : vt_dim1 = *ldvt;
15973 0 : vt_offset = 1 + vt_dim1;
15974 0 : vt -= vt_offset;
15975 0 : u_dim1 = *ldu;
15976 0 : u_offset = 1 + u_dim1;
15977 0 : u -= u_offset;
15978 0 : c_dim1 = *ldc;
15979 0 : c_offset = 1 + c_dim1;
15980 0 : c__ -= c_offset;
15981 0 : --work;
15982 :
15983 0 : *info = 0;
15984 :
15985 0 : itmp1 = (*n > 1) ? *n : 1;
15986 0 : itmp2 = (*nru > 1) ? *nru : 1;
15987 :
15988 : lower = (xuplo == 'L');
15989 0 : if ( (xuplo!='U') && !lower) {
15990 0 : *info = -1;
15991 0 : } else if (*n < 0) {
15992 0 : *info = -2;
15993 0 : } else if (*ncvt < 0) {
15994 0 : *info = -3;
15995 0 : } else if (*nru < 0) {
15996 0 : *info = -4;
15997 0 : } else if (*ncc < 0) {
15998 0 : *info = -5;
15999 0 : } else if ( ((*ncvt == 0) && (*ldvt < 1)) || ((*ncvt > 0) && (*ldvt < itmp1)) ) {
16000 0 : *info = -9;
16001 0 : } else if (*ldu < itmp2) {
16002 0 : *info = -11;
16003 0 : } else if ( ((*ncc == 0) && (*ldc < 1)) || ((*ncc > 0) && (*ldc < itmp1))) {
16004 0 : *info = -13;
16005 : }
16006 0 : if (*info != 0) {
16007 : return;
16008 : }
16009 0 : if (*n == 0) {
16010 : return;
16011 : }
16012 0 : if (*n == 1) {
16013 0 : goto L160;
16014 : }
16015 :
16016 0 : rotate = *ncvt > 0 || *nru > 0 || *ncc > 0;
16017 :
16018 : if (! rotate) {
16019 0 : PLUMED_BLAS_F77_FUNC(slasq1,SLASQ1)(n, &d__[1], &e[1], &work[1], info);
16020 0 : return;
16021 : }
16022 :
16023 0 : nm1 = *n - 1;
16024 0 : nm12 = nm1 + nm1;
16025 0 : nm13 = nm12 + nm1;
16026 : idir = 0;
16027 :
16028 : eps = PLUMED_GMX_FLOAT_EPS;
16029 : unfl = PLUMED_GMX_FLOAT_MIN/PLUMED_GMX_FLOAT_EPS;
16030 :
16031 0 : if (lower) {
16032 0 : i__1 = *n - 1;
16033 0 : for (i__ = 1; i__ <= i__1; ++i__) {
16034 0 : PLUMED_BLAS_F77_FUNC(slartg,SLARTG)(&d__[i__], &e[i__], &cs, &sn, &r__);
16035 0 : d__[i__] = r__;
16036 0 : e[i__] = sn * d__[i__ + 1];
16037 0 : d__[i__ + 1] = cs * d__[i__ + 1];
16038 0 : work[i__] = cs;
16039 0 : work[nm1 + i__] = sn;
16040 : }
16041 :
16042 0 : if (*nru > 0) {
16043 0 : PLUMED_BLAS_F77_FUNC(slasr,SLASR)("R", "V", "F", nru, n, &work[1], &work[*n], &u[u_offset],
16044 : ldu);
16045 : }
16046 0 : if (*ncc > 0) {
16047 0 : PLUMED_BLAS_F77_FUNC(slasr,SLASR)("L", "V", "F", n, ncc, &work[1], &work[*n], &c__[c_offset],
16048 : ldc);
16049 : }
16050 : }
16051 :
16052 : r__3 = 100.f, r__4 = std::pow(static_cast<float>(PLUMED_GMX_FLOAT_EPS),c_b15);
16053 0 : r__1 = 10.f, r__2 = (r__3<r__4) ? r__3 : r__4;
16054 : tolmul = (r__1>r__2) ? r__1 : r__2;
16055 : tol = tolmul * eps;
16056 : smax = 0.f;
16057 0 : i__1 = *n;
16058 0 : for (i__ = 1; i__ <= i__1; ++i__) {
16059 0 : r__2 = smax, r__3 = (r__1 = d__[i__], std::abs(r__1));
16060 0 : smax = (r__2>r__3) ? r__2 : r__3;
16061 : }
16062 0 : i__1 = *n - 1;
16063 0 : for (i__ = 1; i__ <= i__1; ++i__) {
16064 0 : r__2 = smax, r__3 = (r__1 = e[i__], std::abs(r__1));
16065 0 : smax = (r__2>r__3) ? r__2 : r__3;
16066 : }
16067 : sminl = 0.f;
16068 : if (tol >= 0.f) {
16069 0 : sminoa = std::abs(d__[1]);
16070 0 : if (sminoa == 0.f) {
16071 0 : goto L50;
16072 : }
16073 : mu = sminoa;
16074 0 : i__1 = *n;
16075 0 : for (i__ = 2; i__ <= i__1; ++i__) {
16076 0 : mu = (r__2 = d__[i__], std::abs(r__2)) * (mu / (mu + (r__1 = e[i__ -
16077 0 : 1], std::abs(r__1))));
16078 0 : sminoa = (sminoa<mu) ? sminoa : mu;
16079 0 : if (sminoa == 0.f) {
16080 0 : goto L50;
16081 : }
16082 : }
16083 0 : L50:
16084 0 : sminoa /= std::sqrt((float) (*n));
16085 0 : r__1 = tol * sminoa, r__2 = *n * 6 * *n * unfl;
16086 0 : thresh = (r__1>r__2) ? r__1 : r__2;
16087 : } else {
16088 : r__1 = std::abs(tol) * smax, r__2 = *n * 6 * *n * unfl;
16089 : thresh = (r__1>r__2) ? r__1 : r__2;
16090 : }
16091 : maxit = *n * 6 * *n;
16092 : iter = 0;
16093 : oldll = -1;
16094 : oldm = -1;
16095 : m = *n;
16096 :
16097 0 : L60:
16098 :
16099 0 : if (m <= 1) {
16100 0 : goto L160;
16101 : }
16102 0 : if (iter > maxit) {
16103 0 : goto L200;
16104 : }
16105 :
16106 : if (tol < 0.f && (r__1 = d__[m], std::abs(r__1)) <= thresh) {
16107 : d__[m] = 0.f;
16108 : }
16109 0 : smax = (r__1 = d__[m], std::abs(r__1));
16110 : smin = smax;
16111 0 : i__1 = m - 1;
16112 0 : for (lll = 1; lll <= i__1; ++lll) {
16113 0 : ll = m - lll;
16114 0 : abss = (r__1 = d__[ll], std::abs(r__1));
16115 0 : abse = (r__1 = e[ll], std::abs(r__1));
16116 : if (tol < 0.f && abss <= thresh) {
16117 : d__[ll] = 0.f;
16118 : }
16119 0 : if (abse <= thresh) {
16120 0 : goto L80;
16121 : }
16122 0 : smin = (smin<abss) ? smin : abss;
16123 0 : r__1 = (smax>abss) ? smax : abss;
16124 0 : smax = (r__1>abse) ? r__1 : abse;
16125 : }
16126 : ll = 0;
16127 0 : goto L90;
16128 : L80:
16129 0 : e[ll] = 0.f;
16130 0 : if (ll == m - 1) {
16131 : --m;
16132 0 : goto L60;
16133 : }
16134 0 : L90:
16135 0 : ++ll;
16136 0 : if (ll == m - 1) {
16137 0 : PLUMED_BLAS_F77_FUNC(slasv2,SLASV2)(&d__[m - 1], &e[m - 1], &d__[m], &sigmn, &sigmx, &sinr, &cosr,
16138 : &sinl, &cosl);
16139 0 : d__[m - 1] = sigmx;
16140 0 : e[m - 1] = 0.f;
16141 0 : d__[m] = sigmn;
16142 0 : if (*ncvt > 0) {
16143 0 : PLUMED_BLAS_F77_FUNC(srot,SROT)(ncvt, &vt[m - 1 + vt_dim1], ldvt, &vt[m + vt_dim1], ldvt, &
16144 : cosr, &sinr);
16145 : }
16146 0 : if (*nru > 0) {
16147 0 : PLUMED_BLAS_F77_FUNC(srot,SROT)(nru, &u[(m - 1) * u_dim1 + 1], &c__1, &u[m * u_dim1 + 1], &
16148 : c__1, &cosl, &sinl);
16149 : }
16150 0 : if (*ncc > 0) {
16151 0 : PLUMED_BLAS_F77_FUNC(srot,SROT)(ncc, &c__[m - 1 + c_dim1], ldc, &c__[m + c_dim1], ldc, &
16152 : cosl, &sinl);
16153 : }
16154 0 : m += -2;
16155 0 : goto L60;
16156 : }
16157 0 : if (ll > oldm || m < oldll) {
16158 0 : if ((r__1 = d__[ll], std::abs(r__1)) >= (r__2 = d__[m], std::abs(r__2))) {
16159 : idir = 1;
16160 : } else {
16161 : idir = 2;
16162 : }
16163 : }
16164 0 : if (idir == 1) {
16165 :
16166 0 : if( (std::abs(e[m-1]) <= std::abs(tol) * std::abs(d__[m])) ||
16167 : (tol<0.0 && std::abs(e[m-1])<=thresh)) {
16168 0 : e[m - 1] = 0.f;
16169 0 : goto L60;
16170 : }
16171 : if (tol >= 0.f) {
16172 0 : mu = (r__1 = d__[ll], std::abs(r__1));
16173 : sminl = mu;
16174 : i__1 = m - 1;
16175 0 : for (lll = ll; lll <= i__1; ++lll) {
16176 0 : if ((r__1 = e[lll], std::abs(r__1)) <= tol * mu) {
16177 0 : e[lll] = 0.f;
16178 0 : goto L60;
16179 : }
16180 0 : mu = (r__2 = d__[lll + 1], std::abs(r__2)) * (mu / (mu + (r__1 =
16181 : e[lll], std::abs(r__1))));
16182 0 : sminl = (sminl<mu) ? sminl : mu;
16183 : }
16184 : }
16185 : } else {
16186 0 : if( (std::abs(e[ll]) <= std::abs(tol)*std::abs(d__[ll])) ||
16187 : (tol<0.0 && std::abs(e[ll])<=thresh)) {
16188 0 : e[ll] = 0.f;
16189 0 : goto L60;
16190 : }
16191 : if (tol >= 0.f) {
16192 0 : mu = (r__1 = d__[m], std::abs(r__1));
16193 : sminl = mu;
16194 0 : i__1 = ll;
16195 0 : for (lll = m - 1; lll >= i__1; --lll) {
16196 0 : if ((r__1 = e[lll], std::abs(r__1)) <= tol * mu) {
16197 0 : e[lll] = 0.f;
16198 0 : goto L60;
16199 : }
16200 0 : mu = (r__2 = d__[lll], std::abs(r__2)) * (mu / (mu + (r__1 = e[
16201 : lll], std::abs(r__1))));
16202 0 : sminl = (sminl<mu) ? sminl : mu;
16203 : }
16204 : }
16205 : }
16206 : oldll = ll;
16207 : oldm = m;
16208 :
16209 0 : r__1 = eps, r__2 = tol * .01f;
16210 0 : if (tol >= 0.f && *n * tol * (sminl / smax) <= ((r__1>r__2) ? r__1 : r__2)) {
16211 0 : shift = 0.f;
16212 : } else {
16213 0 : if (idir == 1) {
16214 0 : sll = (r__1 = d__[ll], std::abs(r__1));
16215 0 : PLUMED_BLAS_F77_FUNC(slas2,SLAS2)(&d__[m - 1], &e[m - 1], &d__[m], &shift, &r__);
16216 : } else {
16217 0 : sll = (r__1 = d__[m], std::abs(r__1));
16218 0 : PLUMED_BLAS_F77_FUNC(slas2,SLAS2)(&d__[ll], &e[ll], &d__[ll + 1], &shift, &r__);
16219 : }
16220 0 : if (sll > 0.f) {
16221 0 : r__1 = shift / sll;
16222 0 : if (r__1 * r__1 < eps) {
16223 0 : shift = 0.f;
16224 : }
16225 : }
16226 : }
16227 0 : iter = iter + m - ll;
16228 0 : if (shift == 0.f) {
16229 0 : if (idir == 1) {
16230 0 : cs = 1.f;
16231 0 : oldcs = 1.f;
16232 0 : i__1 = m - 1;
16233 0 : for (i__ = ll; i__ <= i__1; ++i__) {
16234 0 : r__1 = d__[i__] * cs;
16235 0 : PLUMED_BLAS_F77_FUNC(slartg,SLARTG)(&r__1, &e[i__], &cs, &sn, &r__);
16236 0 : if (i__ > ll) {
16237 0 : e[i__ - 1] = oldsn * r__;
16238 : }
16239 0 : r__1 = oldcs * r__;
16240 0 : r__2 = d__[i__ + 1] * sn;
16241 0 : PLUMED_BLAS_F77_FUNC(slartg,SLARTG)(&r__1, &r__2, &oldcs, &oldsn, &d__[i__]);
16242 0 : work[i__ - ll + 1] = cs;
16243 0 : work[i__ - ll + 1 + nm1] = sn;
16244 0 : work[i__ - ll + 1 + nm12] = oldcs;
16245 0 : work[i__ - ll + 1 + nm13] = oldsn;
16246 : }
16247 0 : h__ = d__[m] * cs;
16248 0 : d__[m] = h__ * oldcs;
16249 0 : e[m - 1] = h__ * oldsn;
16250 0 : if (*ncvt > 0) {
16251 0 : i__1 = m - ll + 1;
16252 0 : PLUMED_BLAS_F77_FUNC(slasr,SLASR)("L", "V", "F", &i__1, ncvt, &work[1], &work[*n], &vt[
16253 0 : ll + vt_dim1], ldvt);
16254 : }
16255 0 : if (*nru > 0) {
16256 0 : i__1 = m - ll + 1;
16257 0 : PLUMED_BLAS_F77_FUNC(slasr,SLASR)("R", "V", "F", nru, &i__1, &work[nm12 + 1], &work[nm13
16258 0 : + 1], &u[ll * u_dim1 + 1], ldu);
16259 : }
16260 0 : if (*ncc > 0) {
16261 0 : i__1 = m - ll + 1;
16262 0 : PLUMED_BLAS_F77_FUNC(slasr,SLASR)("L", "V", "F", &i__1, ncc, &work[nm12 + 1], &work[nm13
16263 0 : + 1], &c__[ll + c_dim1], ldc);
16264 : }
16265 0 : if ((r__1 = e[m - 1], std::abs(r__1)) <= thresh) {
16266 0 : e[m - 1] = 0.f;
16267 : }
16268 : } else {
16269 0 : cs = 1.f;
16270 0 : oldcs = 1.f;
16271 0 : i__1 = ll + 1;
16272 0 : for (i__ = m; i__ >= i__1; --i__) {
16273 0 : r__1 = d__[i__] * cs;
16274 0 : PLUMED_BLAS_F77_FUNC(slartg,SLARTG)(&r__1, &e[i__ - 1], &cs, &sn, &r__);
16275 0 : if (i__ < m) {
16276 0 : e[i__] = oldsn * r__;
16277 : }
16278 0 : r__1 = oldcs * r__;
16279 0 : r__2 = d__[i__ - 1] * sn;
16280 0 : PLUMED_BLAS_F77_FUNC(slartg,SLARTG)(&r__1, &r__2, &oldcs, &oldsn, &d__[i__]);
16281 0 : work[i__ - ll] = cs;
16282 0 : work[i__ - ll + nm1] = -sn;
16283 0 : work[i__ - ll + nm12] = oldcs;
16284 0 : work[i__ - ll + nm13] = -oldsn;
16285 : }
16286 0 : h__ = d__[ll] * cs;
16287 0 : d__[ll] = h__ * oldcs;
16288 0 : e[ll] = h__ * oldsn;
16289 0 : if (*ncvt > 0) {
16290 0 : i__1 = m - ll + 1;
16291 0 : PLUMED_BLAS_F77_FUNC(slasr,SLASR)("L", "V", "B", &i__1, ncvt, &work[nm12 + 1], &work[
16292 0 : nm13 + 1], &vt[ll + vt_dim1], ldvt);
16293 : }
16294 0 : if (*nru > 0) {
16295 0 : i__1 = m - ll + 1;
16296 0 : PLUMED_BLAS_F77_FUNC(slasr,SLASR)("R", "V", "B", nru, &i__1, &work[1], &work[*n], &u[ll *
16297 0 : u_dim1 + 1], ldu);
16298 : }
16299 0 : if (*ncc > 0) {
16300 0 : i__1 = m - ll + 1;
16301 0 : PLUMED_BLAS_F77_FUNC(slasr,SLASR)("L", "V", "B", &i__1, ncc, &work[1], &work[*n], &c__[
16302 0 : ll + c_dim1], ldc);
16303 : }
16304 0 : if ((r__1 = e[ll], std::abs(r__1)) <= thresh) {
16305 0 : e[ll] = 0.f;
16306 : }
16307 : }
16308 : } else {
16309 :
16310 0 : if (idir == 1) {
16311 0 : f = ((r__1 = d__[ll], std::abs(r__1)) - shift) * ( ((d__[ll] > 0) ? c_b49 : -c_b49) + shift / d__[ll]);
16312 0 : g = e[ll];
16313 0 : i__1 = m - 1;
16314 0 : for (i__ = ll; i__ <= i__1; ++i__) {
16315 0 : PLUMED_BLAS_F77_FUNC(slartg,SLARTG)(&f, &g, &cosr, &sinr, &r__);
16316 0 : if (i__ > ll) {
16317 0 : e[i__ - 1] = r__;
16318 : }
16319 0 : f = cosr * d__[i__] + sinr * e[i__];
16320 0 : e[i__] = cosr * e[i__] - sinr * d__[i__];
16321 0 : g = sinr * d__[i__ + 1];
16322 0 : d__[i__ + 1] = cosr * d__[i__ + 1];
16323 0 : PLUMED_BLAS_F77_FUNC(slartg,SLARTG)(&f, &g, &cosl, &sinl, &r__);
16324 0 : d__[i__] = r__;
16325 0 : f = cosl * e[i__] + sinl * d__[i__ + 1];
16326 0 : d__[i__ + 1] = cosl * d__[i__ + 1] - sinl * e[i__];
16327 0 : if (i__ < m - 1) {
16328 0 : g = sinl * e[i__ + 1];
16329 0 : e[i__ + 1] = cosl * e[i__ + 1];
16330 : }
16331 0 : work[i__ - ll + 1] = cosr;
16332 0 : work[i__ - ll + 1 + nm1] = sinr;
16333 0 : work[i__ - ll + 1 + nm12] = cosl;
16334 0 : work[i__ - ll + 1 + nm13] = sinl;
16335 : }
16336 0 : e[m - 1] = f;
16337 :
16338 0 : if (*ncvt > 0) {
16339 0 : i__1 = m - ll + 1;
16340 0 : PLUMED_BLAS_F77_FUNC(slasr,SLASR)("L", "V", "F", &i__1, ncvt, &work[1], &work[*n], &vt[
16341 0 : ll + vt_dim1], ldvt);
16342 : }
16343 0 : if (*nru > 0) {
16344 0 : i__1 = m - ll + 1;
16345 0 : PLUMED_BLAS_F77_FUNC(slasr,SLASR)("R", "V", "F", nru, &i__1, &work[nm12 + 1], &work[nm13
16346 0 : + 1], &u[ll * u_dim1 + 1], ldu);
16347 : }
16348 0 : if (*ncc > 0) {
16349 0 : i__1 = m - ll + 1;
16350 0 : PLUMED_BLAS_F77_FUNC(slasr,SLASR)("L", "V", "F", &i__1, ncc, &work[nm12 + 1], &work[nm13
16351 0 : + 1], &c__[ll + c_dim1], ldc);
16352 : }
16353 0 : if ((r__1 = e[m - 1], std::abs(r__1)) <= thresh) {
16354 0 : e[m - 1] = 0.f;
16355 : }
16356 : } else {
16357 :
16358 0 : f = ((r__1 = d__[m], std::abs(r__1)) - shift) * ( ((d__[m] > 0) ? c_b49 : -c_b49) + shift / d__[m]);
16359 0 : g = e[m - 1];
16360 0 : i__1 = ll + 1;
16361 0 : for (i__ = m; i__ >= i__1; --i__) {
16362 0 : PLUMED_BLAS_F77_FUNC(slartg,SLARTG)(&f, &g, &cosr, &sinr, &r__);
16363 0 : if (i__ < m) {
16364 0 : e[i__] = r__;
16365 : }
16366 0 : f = cosr * d__[i__] + sinr * e[i__ - 1];
16367 0 : e[i__ - 1] = cosr * e[i__ - 1] - sinr * d__[i__];
16368 0 : g = sinr * d__[i__ - 1];
16369 0 : d__[i__ - 1] = cosr * d__[i__ - 1];
16370 0 : PLUMED_BLAS_F77_FUNC(slartg,SLARTG)(&f, &g, &cosl, &sinl, &r__);
16371 0 : d__[i__] = r__;
16372 0 : f = cosl * e[i__ - 1] + sinl * d__[i__ - 1];
16373 0 : d__[i__ - 1] = cosl * d__[i__ - 1] - sinl * e[i__ - 1];
16374 0 : if (i__ > ll + 1) {
16375 0 : g = sinl * e[i__ - 2];
16376 0 : e[i__ - 2] = cosl * e[i__ - 2];
16377 : }
16378 0 : work[i__ - ll] = cosr;
16379 0 : work[i__ - ll + nm1] = -sinr;
16380 0 : work[i__ - ll + nm12] = cosl;
16381 0 : work[i__ - ll + nm13] = -sinl;
16382 : }
16383 0 : e[ll] = f;
16384 :
16385 0 : if ((r__1 = e[ll], std::abs(r__1)) <= thresh) {
16386 0 : e[ll] = 0.f;
16387 : }
16388 0 : if (*ncvt > 0) {
16389 0 : i__1 = m - ll + 1;
16390 0 : PLUMED_BLAS_F77_FUNC(slasr,SLASR)("L", "V", "B", &i__1, ncvt, &work[nm12 + 1], &work[
16391 0 : nm13 + 1], &vt[ll + vt_dim1], ldvt);
16392 : }
16393 0 : if (*nru > 0) {
16394 0 : i__1 = m - ll + 1;
16395 0 : PLUMED_BLAS_F77_FUNC(slasr,SLASR)("R", "V", "B", nru, &i__1, &work[1], &work[*n], &u[ll *
16396 0 : u_dim1 + 1], ldu);
16397 : }
16398 0 : if (*ncc > 0) {
16399 0 : i__1 = m - ll + 1;
16400 0 : PLUMED_BLAS_F77_FUNC(slasr,SLASR)("L", "V", "B", &i__1, ncc, &work[1], &work[*n], &c__[
16401 0 : ll + c_dim1], ldc);
16402 : }
16403 : }
16404 : }
16405 :
16406 0 : goto L60;
16407 :
16408 0 : L160:
16409 0 : i__1 = *n;
16410 0 : for (i__ = 1; i__ <= i__1; ++i__) {
16411 0 : if (d__[i__] < 0.f) {
16412 0 : d__[i__] = -d__[i__];
16413 :
16414 0 : if (*ncvt > 0) {
16415 0 : PLUMED_BLAS_F77_FUNC(sscal,SSCAL)(ncvt, &c_b72, &vt[i__ + vt_dim1], ldvt);
16416 : }
16417 : }
16418 : }
16419 :
16420 0 : i__1 = *n - 1;
16421 0 : for (i__ = 1; i__ <= i__1; ++i__) {
16422 :
16423 : isub = 1;
16424 0 : smin = d__[1];
16425 0 : i__2 = *n + 1 - i__;
16426 0 : for (j = 2; j <= i__2; ++j) {
16427 0 : if (d__[j] <= smin) {
16428 : isub = j;
16429 : smin = d__[j];
16430 : }
16431 : }
16432 0 : if (isub != *n + 1 - i__) {
16433 0 : d__[isub] = d__[*n + 1 - i__];
16434 0 : d__[*n + 1 - i__] = smin;
16435 0 : if (*ncvt > 0) {
16436 0 : PLUMED_BLAS_F77_FUNC(sswap,SSWAP)(ncvt, &vt[isub + vt_dim1], ldvt, &vt[*n + 1 - i__ +
16437 0 : vt_dim1], ldvt);
16438 : }
16439 0 : if (*nru > 0) {
16440 0 : PLUMED_BLAS_F77_FUNC(sswap,SSWAP)(nru, &u[isub * u_dim1 + 1], &c__1, &u[(*n + 1 - i__) *
16441 0 : u_dim1 + 1], &c__1);
16442 : }
16443 0 : if (*ncc > 0) {
16444 0 : PLUMED_BLAS_F77_FUNC(sswap,SSWAP)(ncc, &c__[isub + c_dim1], ldc, &c__[*n + 1 - i__ +
16445 0 : c_dim1], ldc);
16446 : }
16447 : }
16448 : }
16449 0 : goto L220;
16450 :
16451 : L200:
16452 0 : *info = 0;
16453 0 : i__1 = *n - 1;
16454 0 : for (i__ = 1; i__ <= i__1; ++i__) {
16455 0 : if (e[i__] != 0.f) {
16456 0 : ++(*info);
16457 : }
16458 : }
16459 0 : L220:
16460 : return;
16461 :
16462 : }
16463 :
16464 :
16465 : }
16466 : }
16467 : #include "lapack.h"
16468 :
16469 : #include "blas/blas.h"
16470 : namespace PLMD{
16471 : namespace lapack{
16472 : using namespace blas;
16473 : void
16474 0 : PLUMED_BLAS_F77_FUNC(sgebd2,SGEBD2)(int *m,
16475 : int *n,
16476 : float *a,
16477 : int *lda,
16478 : float *d,
16479 : float *e,
16480 : float *tauq,
16481 : float *taup,
16482 : float *work,
16483 : int *info)
16484 : {
16485 :
16486 : int i,i1,i2,i3;
16487 :
16488 0 : *info = 0;
16489 :
16490 0 : if(*m>=*n) {
16491 : /* reduce to upper bidiag. form */
16492 0 : for(i=0;i<*n;i++) {
16493 0 : i1 = *m - i;
16494 0 : i2 = ( (i+1) < (*m-1)) ? (i+1) : (*m-1);
16495 0 : i3 = 1;
16496 0 : PLUMED_BLAS_F77_FUNC(slarfg,SLARFG)(&i1,&(a[i*(*lda)+i]),&(a[i*(*lda)+i2]),&i3,&(tauq[i]));
16497 0 : d[i] = a[i*(*lda)+i];
16498 0 : a[i*(*lda)+i] = 1.0;
16499 0 : i2 = *n - i - 1;
16500 0 : PLUMED_BLAS_F77_FUNC(slarf,SLARF)("L",&i1,&i2,&(a[i*(*lda)+i]),&i3,&(tauq[i]),&(a[(i+1)*(*lda)+i]),lda,work);
16501 0 : a[i*(*lda)+i] = d[i];
16502 :
16503 0 : if(i<(*n-1)) {
16504 :
16505 0 : i1 = *n - i -1;
16506 0 : i2 = ( (i+2) < (*n-1)) ? (i+2) : (*n-1);
16507 0 : PLUMED_BLAS_F77_FUNC(slarfg,SLARFG)(&i1,&(a[(i+1)*(*lda)+i]),&(a[i2*(*lda)+i]),lda,&(taup[i]));
16508 :
16509 0 : e[i] = a[(i+1)*(*lda)+i];
16510 0 : a[(i+1)*(*lda)+i] = 1.0;
16511 :
16512 0 : i1 = *m - i - 1;
16513 0 : i2 = *n - i - 1;
16514 0 : PLUMED_BLAS_F77_FUNC(slarf,SLARF)("R",&i1,&i2,&(a[(i+1)*(*lda)+i]),lda,&(taup[i]),&(a[(i+1)*(*lda)+i+1]),lda,work);
16515 0 : a[(i+1)*(*lda)+i] = e[i];
16516 : } else
16517 0 : taup[i] = 0.0;
16518 : }
16519 : } else {
16520 : /* reduce to lower bidiag. form */
16521 0 : for(i=0;i<*m;i++) {
16522 0 : i1 = *n - i;
16523 0 : i2 = ( (i+1) < (*n-1)) ? (i+1) : (*n-1);
16524 0 : PLUMED_BLAS_F77_FUNC(slarfg,SLARFG)(&i1,&(a[i*(*lda)+i]),&(a[i2*(*lda)+i]),lda,&(taup[i]));
16525 0 : d[i] = a[i*(*lda)+i];
16526 0 : a[i*(*lda)+i] = 1.0;
16527 :
16528 0 : i2 = *m - i - 1;
16529 0 : i3 = ( (i+1) < (*m-1)) ? (i+1) : (*m-1);
16530 0 : PLUMED_BLAS_F77_FUNC(slarf,SLARF)("R",&i2,&i1,&(a[i*(*lda)+i]),lda,&(taup[i]),&(a[(i)*(*lda)+i3]),lda,work);
16531 0 : a[i*(*lda)+i] = d[i];
16532 :
16533 0 : if(i<(*m-1)) {
16534 :
16535 0 : i1 = *m - i - 1;
16536 0 : i2 = ( (i+2) < (*m-1)) ? (i+2) : (*m-1);
16537 0 : i3 = 1;
16538 0 : PLUMED_BLAS_F77_FUNC(slarfg,SLARFG)(&i1,&(a[(i)*(*lda)+i+1]),&(a[i*(*lda)+i2]),&i3,&(tauq[i]));
16539 :
16540 0 : e[i] = a[(i)*(*lda)+i+1];
16541 0 : a[(i)*(*lda)+i+1] = 1.0;
16542 :
16543 0 : i1 = *m - i - 1;
16544 0 : i2 = *n - i - 1;
16545 0 : i3 = 1;
16546 0 : PLUMED_BLAS_F77_FUNC(slarf,SLARF)("L",&i1,&i2,&(a[(i)*(*lda)+i+1]),&i3,&(tauq[i]),&(a[(i+1)*(*lda)+i+1]),lda,work);
16547 0 : a[(i)*(*lda)+i+1] = e[i];
16548 : } else
16549 0 : tauq[i] = 0.0;
16550 : }
16551 : }
16552 0 : return;
16553 : }
16554 : }
16555 : }
16556 : #include "lapack.h"
16557 : #include "blas/blas.h"
16558 : #include "lapack_limits.h"
16559 :
16560 :
16561 : #include "blas/blas.h"
16562 : namespace PLMD{
16563 : namespace lapack{
16564 : using namespace blas;
16565 : void
16566 0 : PLUMED_BLAS_F77_FUNC(sgebrd,SGEBRD)(int *m,
16567 : int *n,
16568 : float *a,
16569 : int *lda,
16570 : float *d__,
16571 : float *e,
16572 : float *tauq,
16573 : float *taup,
16574 : float *work,
16575 : int *lwork,
16576 : int *info)
16577 : {
16578 : /* System generated locals */
16579 : int a_dim1, a_offset, i_1, i_2, i_3, i_4;
16580 :
16581 : /* Local variables */
16582 : int i_, j, nx,nb;
16583 : float ws;
16584 : int nbmin, iinfo, minmn;
16585 : int ldwrkx, ldwrky;
16586 0 : float one = 1.0;
16587 0 : float minusone = -1.0;
16588 :
16589 0 : a_dim1 = *lda;
16590 0 : a_offset = 1 + a_dim1;
16591 0 : a -= a_offset;
16592 0 : --d__;
16593 0 : --e;
16594 0 : --tauq;
16595 0 : --taup;
16596 0 : --work;
16597 :
16598 0 : nb = DGEBRD_BLOCKSIZE;
16599 0 : *info = 0;
16600 0 : if (*lwork==-1) {
16601 0 : work[1] = (float) ( (*m + *n) * nb);
16602 0 : return;
16603 : }
16604 0 : minmn = (*m < *n) ? *m : *n;
16605 0 : if (minmn == 0) {
16606 0 : work[1] = 1.;
16607 0 : return;
16608 : }
16609 :
16610 0 : ws = (*m > *n) ? *m : *n;
16611 0 : ldwrkx = *m;
16612 0 : ldwrky = *n;
16613 :
16614 0 : if (nb > 1 && nb < minmn) {
16615 : nx = DGEBRD_CROSSOVER;
16616 0 : if (nx < minmn) {
16617 0 : ws = (float) ((*m + *n) * nb);
16618 0 : if ((float) (*lwork) < ws) {
16619 : nbmin = DGEBRD_MINBLOCKSIZE;
16620 0 : if (*lwork >= (*m + *n) * nbmin) {
16621 0 : nb = *lwork / (*m + *n);
16622 : } else {
16623 0 : nb = 1;
16624 : nx = minmn;
16625 : }
16626 : }
16627 : }
16628 : } else {
16629 : nx = minmn;
16630 : }
16631 :
16632 0 : i_1 = minmn - nx;
16633 0 : i_2 = nb;
16634 0 : for (i_ = 1; i_2 < 0 ? i_ >= i_1 : i_ <= i_1; i_ += i_2) {
16635 :
16636 0 : i_3 = *m - i_ + 1;
16637 0 : i_4 = *n - i_ + 1;
16638 0 : PLUMED_BLAS_F77_FUNC(slabrd,SLABRD)(&i_3, &i_4, &nb, &a[i_ + i_ * a_dim1], lda, &d__[i_],
16639 0 : &e[i_], &tauq[i_], &taup[i_], &work[1], &ldwrkx,
16640 0 : &work[ldwrkx * nb + 1], &ldwrky);
16641 :
16642 0 : i_3 = *m - i_ - nb + 1;
16643 0 : i_4 = *n - i_ - nb + 1;
16644 0 : PLUMED_BLAS_F77_FUNC(sgemm,SGEMM)("N", "T", &i_3, &i_4, &nb, &minusone,
16645 0 : &a[i_ + nb + i_ * a_dim1], lda, &work[ldwrkx * nb + nb + 1],
16646 0 : &ldwrky, &one, &a[i_ + nb + (i_ + nb) * a_dim1], lda);
16647 0 : i_3 = *m - i_ - nb + 1;
16648 0 : i_4 = *n - i_ - nb + 1;
16649 0 : PLUMED_BLAS_F77_FUNC(sgemm,SGEMM)("N", "N", &i_3, &i_4, &nb, &minusone, &work[nb + 1], &ldwrkx,
16650 0 : &a[i_ + (i_ + nb) * a_dim1], lda, &one,
16651 0 : &a[i_ + nb + (i_ + nb) * a_dim1], lda);
16652 :
16653 0 : if (*m >= *n) {
16654 0 : i_3 = i_ + nb - 1;
16655 0 : for (j = i_; j <= i_3; ++j) {
16656 0 : a[j + j * a_dim1] = d__[j];
16657 0 : a[j + (j + 1) * a_dim1] = e[j];
16658 : }
16659 : } else {
16660 0 : i_3 = i_ + nb - 1;
16661 0 : for (j = i_; j <= i_3; ++j) {
16662 0 : a[j + j * a_dim1] = d__[j];
16663 0 : a[j + 1 + j * a_dim1] = e[j];
16664 : }
16665 : }
16666 : }
16667 :
16668 0 : i_2 = *m - i_ + 1;
16669 0 : i_1 = *n - i_ + 1;
16670 0 : PLUMED_BLAS_F77_FUNC(sgebd2,SGEBD2)(&i_2, &i_1, &a[i_ + i_ * a_dim1], lda, &d__[i_], &e[i_], &
16671 0 : tauq[i_], &taup[i_], &work[1], &iinfo);
16672 0 : work[1] = ws;
16673 0 : return;
16674 :
16675 : }
16676 : }
16677 : }
16678 : #include "lapack.h"
16679 :
16680 : #include "blas/blas.h"
16681 : namespace PLMD{
16682 : namespace lapack{
16683 : using namespace blas;
16684 : void
16685 0 : PLUMED_BLAS_F77_FUNC(sgelq2,SGELQ2)(int *m,
16686 : int *n,
16687 : float *a,
16688 : int *lda,
16689 : float *tau,
16690 : float *work,
16691 : int *info)
16692 : {
16693 : /* System generated locals */
16694 : int a_dim1, a_offset, i__1, i__2, i__3, i__4;
16695 :
16696 : /* Local variables */
16697 : int i__, k;
16698 : float aii;
16699 :
16700 0 : a_dim1 = *lda;
16701 0 : a_offset = 1 + a_dim1;
16702 0 : a -= a_offset;
16703 0 : --tau;
16704 : --work;
16705 :
16706 0 : *info = 0;
16707 :
16708 0 : i__4 = (*m > 1) ? *m : 1;
16709 :
16710 0 : if (*m < 0) {
16711 0 : *info = -1;
16712 0 : } else if (*n < 0) {
16713 0 : *info = -2;
16714 0 : } else if (*lda < i__4) {
16715 0 : *info = -4;
16716 : }
16717 0 : if (*info != 0) {
16718 : return;
16719 : }
16720 :
16721 :
16722 0 : k = (*m < *n ) ? *m : *n;
16723 : i__1 = k;
16724 0 : for (i__ = 1; i__ <= i__1; ++i__) {
16725 0 : i__2 = *n - i__ + 1;
16726 0 : i__3 = i__ + 1;
16727 : i__4 = (i__3 < *n) ? i__3 : *n;
16728 0 : PLUMED_BLAS_F77_FUNC(slarfg,SLARFG)(&i__2, &a[i__ + i__ * a_dim1], &a[i__ + i__4 * a_dim1],
16729 0 : lda, &tau[i__]);
16730 0 : if (i__ < *m) {
16731 0 : aii = a[i__ + i__ * a_dim1];
16732 0 : a[i__ + i__ * a_dim1] = 1.f;
16733 0 : i__2 = *m - i__;
16734 0 : i__3 = *n - i__ + 1;
16735 0 : PLUMED_BLAS_F77_FUNC(slarf,SLARF)("R", &i__2, &i__3, &a[i__ + i__ * a_dim1], lda,
16736 0 : &tau[i__], &a[i__ + 1 + i__ * a_dim1], lda, &work[1]);
16737 0 : a[i__ + i__ * a_dim1] = aii;
16738 : }
16739 : }
16740 : return;
16741 : }
16742 :
16743 :
16744 : }
16745 : }
16746 : #include <cmath>
16747 : #include "lapack.h"
16748 : #include "lapack_limits.h"
16749 :
16750 :
16751 :
16752 : #include "blas/blas.h"
16753 : namespace PLMD{
16754 : namespace lapack{
16755 : using namespace blas;
16756 : void
16757 0 : PLUMED_BLAS_F77_FUNC(sgelqf,SGELQF)(int *m,
16758 : int *n,
16759 : float *a,
16760 : int *lda,
16761 : float *tau,
16762 : float *work,
16763 : int *lwork,
16764 : int *info)
16765 : {
16766 : int a_dim1, a_offset, i__1, i__2, i__3, i__4;
16767 :
16768 : int i__, k, ib, nb, nx, iws, nbmin, iinfo;
16769 : int ldwork, lwkopt;
16770 :
16771 0 : a_dim1 = *lda;
16772 0 : a_offset = 1 + a_dim1;
16773 0 : a -= a_offset;
16774 0 : --tau;
16775 : --work;
16776 :
16777 0 : *info = 0;
16778 : nb = DGELQF_BLOCKSIZE;
16779 0 : lwkopt = *m * nb;
16780 0 : work[1] = (float) lwkopt;
16781 :
16782 0 : if (*lwork==-1) {
16783 : return;
16784 : }
16785 :
16786 0 : k =(*m < *n) ? *m : *n;
16787 0 : if (k == 0) {
16788 0 : work[1] = 1.;
16789 0 : return;
16790 : }
16791 :
16792 : nbmin = 2;
16793 : nx = 0;
16794 : iws = *m;
16795 0 : if (nb > 1 && nb < k) {
16796 : nx = DGELQF_CROSSOVER;
16797 0 : if (nx < k) {
16798 0 : ldwork = *m;
16799 0 : iws = ldwork * nb;
16800 0 : if (*lwork < iws) {
16801 :
16802 0 : nb = *lwork / ldwork;
16803 : nbmin = DGELQF_MINBLOCKSIZE;
16804 : }
16805 : }
16806 : }
16807 :
16808 0 : if (nb >= nbmin && nb < k && nx < k) {
16809 :
16810 0 : i__1 = k - nx;
16811 0 : i__2 = nb;
16812 0 : for (i__ = 1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) {
16813 0 : i__3 = k - i__ + 1;
16814 0 : ib = (i__3 < nb) ? i__3 : nb;
16815 :
16816 0 : i__3 = *n - i__ + 1;
16817 0 : PLUMED_BLAS_F77_FUNC(sgelq2,SGELQ2)(&ib, &i__3, &a[i__ + i__ * a_dim1], lda, &tau[i__], &work[
16818 : 1], &iinfo);
16819 0 : if (i__ + ib <= *m) {
16820 :
16821 0 : i__3 = *n - i__ + 1;
16822 0 : PLUMED_BLAS_F77_FUNC(slarft,SLARFT)("Forward", "Rowwise", &i__3, &ib, &a[i__ + i__ *
16823 : a_dim1], lda, &tau[i__], &work[1], &ldwork);
16824 :
16825 0 : i__3 = *m - i__ - ib + 1;
16826 0 : i__4 = *n - i__ + 1;
16827 0 : PLUMED_BLAS_F77_FUNC(slarfb,SLARFB)("Right", "No transpose", "Forward", "Rowwise", &i__3,
16828 : &i__4, &ib, &a[i__ + i__ * a_dim1], lda, &work[1], &
16829 0 : ldwork, &a[i__ + ib + i__ * a_dim1], lda, &work[ib +
16830 0 : 1], &ldwork);
16831 : }
16832 : }
16833 : } else {
16834 : i__ = 1;
16835 : }
16836 :
16837 0 : if (i__ <= k) {
16838 0 : i__2 = *m - i__ + 1;
16839 0 : i__1 = *n - i__ + 1;
16840 0 : PLUMED_BLAS_F77_FUNC(sgelq2,SGELQ2)(&i__2, &i__1, &a[i__ + i__ * a_dim1], lda, &tau[i__], &work[1]
16841 : , &iinfo);
16842 : }
16843 :
16844 0 : work[1] = (float) iws;
16845 0 : return;
16846 :
16847 : }
16848 : }
16849 : }
16850 : #include "lapack.h"
16851 :
16852 :
16853 : #include "blas/blas.h"
16854 : namespace PLMD{
16855 : namespace lapack{
16856 : using namespace blas;
16857 : void
16858 0 : PLUMED_BLAS_F77_FUNC(sgeqr2,SGEQR2)(int *m,
16859 : int *n,
16860 : float *a,
16861 : int *lda,
16862 : float *tau,
16863 : float *work,
16864 : int *info)
16865 : {
16866 0 : int k = (*m < *n) ? *m : *n;
16867 : int i,i1,i2,i3;
16868 : float aii;
16869 :
16870 0 : *info = 0;
16871 :
16872 0 : for(i=0;i<k;i++) {
16873 0 : i1 = *m - i;
16874 0 : i2 = ( (i+1) < (*m-1) ) ? (i+1) : (*m-1);
16875 0 : i3 = 1;
16876 0 : PLUMED_BLAS_F77_FUNC(slarfg,SLARFG)(&i1,&(a[i*(*lda)+i]),&(a[i*(*lda)+i2]),&i3,&(tau[i]));
16877 0 : if(i<(*n-1)) {
16878 0 : aii = a[i*(*lda)+i];
16879 0 : a[i*(*lda)+i] = 1.0;
16880 0 : i2 = *n - i - 1;
16881 0 : PLUMED_BLAS_F77_FUNC(slarf,SLARF)("L",&i1,&i2,&(a[i*(*lda)+i]),&i3,&(tau[i]),
16882 0 : &(a[(i+1)*(*lda)+i]),lda,work);
16883 0 : a[i*(*lda)+i] = aii;
16884 : }
16885 : }
16886 0 : return;
16887 : }
16888 : }
16889 : }
16890 : #include "lapack.h"
16891 : #include "lapack_limits.h"
16892 :
16893 : #include "blas/blas.h"
16894 : namespace PLMD{
16895 : namespace lapack{
16896 : using namespace blas;
16897 : void
16898 0 : PLUMED_BLAS_F77_FUNC(sgeqrf,SGEQRF)(int *m,
16899 : int *n,
16900 : float *a,
16901 : int *lda,
16902 : float *tau,
16903 : float *work,
16904 : int *lwork,
16905 : int *info)
16906 : {
16907 : int a_dim1, a_offset, i__1, i__2, i__3, i__4;
16908 :
16909 : int i__, k, ib, nb, nx, iws, nbmin, iinfo;
16910 : int ldwork, lwkopt;
16911 :
16912 0 : a_dim1 = *lda;
16913 0 : a_offset = 1 + a_dim1;
16914 0 : a -= a_offset;
16915 0 : --tau;
16916 : --work;
16917 :
16918 0 : *info = 0;
16919 : nb = DGEQRF_BLOCKSIZE;
16920 0 : lwkopt = *n * nb;
16921 0 : work[1] = (float) lwkopt;
16922 0 : if (*lwork==-1)
16923 : return;
16924 :
16925 :
16926 0 : k = (*m < *n) ? *m : *n;
16927 0 : if (k == 0) {
16928 0 : work[1] = 1.;
16929 0 : return;
16930 : }
16931 :
16932 : nbmin = 2;
16933 : nx = 0;
16934 : iws = *n;
16935 0 : if (nb > 1 && nb < k) {
16936 :
16937 : nx = DGEQRF_CROSSOVER;
16938 0 : if (nx < k) {
16939 :
16940 0 : ldwork = *n;
16941 0 : iws = ldwork * nb;
16942 0 : if (*lwork < iws) {
16943 :
16944 0 : nb = *lwork / ldwork;
16945 : nbmin = DGEQRF_MINBLOCKSIZE;
16946 : }
16947 : }
16948 : }
16949 :
16950 0 : if (nb >= nbmin && nb < k && nx < k) {
16951 0 : i__1 = k - nx;
16952 0 : i__2 = nb;
16953 0 : for (i__ = 1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) {
16954 :
16955 0 : i__3 = k - i__ + 1;
16956 0 : ib = (i__3 < nb) ? i__3 : nb;
16957 :
16958 0 : i__3 = *m - i__ + 1;
16959 0 : PLUMED_BLAS_F77_FUNC(sgeqr2,SGEQR2)(&i__3, &ib, &a[i__ + i__ * a_dim1], lda, &tau[i__], &work[
16960 : 1], &iinfo);
16961 0 : if (i__ + ib <= *n) {
16962 :
16963 0 : i__3 = *m - i__ + 1;
16964 0 : PLUMED_BLAS_F77_FUNC(slarft,SLARFT)("Forward", "Columnwise", &i__3, &ib, &a[i__ + i__ *
16965 : a_dim1], lda, &tau[i__], &work[1], &ldwork);
16966 :
16967 0 : i__3 = *m - i__ + 1;
16968 0 : i__4 = *n - i__ - ib + 1;
16969 0 : PLUMED_BLAS_F77_FUNC(slarfb,SLARFB)("Left", "Transpose", "Forward", "Columnwise", &i__3, &
16970 : i__4, &ib, &a[i__ + i__ * a_dim1], lda, &work[1], &
16971 0 : ldwork, &a[i__ + (i__ + ib) * a_dim1], lda, &work[ib
16972 0 : + 1], &ldwork);
16973 : }
16974 : }
16975 : } else {
16976 : i__ = 1;
16977 : }
16978 :
16979 0 : if (i__ <= k) {
16980 0 : i__2 = *m - i__ + 1;
16981 0 : i__1 = *n - i__ + 1;
16982 0 : PLUMED_BLAS_F77_FUNC(sgeqr2,SGEQR2)(&i__2, &i__1, &a[i__ + i__ * a_dim1], lda, &tau[i__], &work[1]
16983 : , &iinfo);
16984 : }
16985 :
16986 0 : work[1] = (float) iws;
16987 0 : return;
16988 :
16989 : }
16990 :
16991 : }
16992 : }
16993 : #include <cmath>
16994 : #include "real.h"
16995 :
16996 :
16997 : #include "blas/blas.h"
16998 : #include "lapack.h"
16999 : #include "lapack_limits.h"
17000 :
17001 : #include "blas/blas.h"
17002 : namespace PLMD{
17003 : namespace lapack{
17004 : using namespace blas;
17005 : void
17006 0 : PLUMED_BLAS_F77_FUNC(sgesdd,SGESDD)(const char *jobz,
17007 : int *m,
17008 : int *n,
17009 : float *a,
17010 : int *lda,
17011 : float *s,
17012 : float *u,
17013 : int *ldu,
17014 : float *vt,
17015 : int *ldvt,
17016 : float *work,
17017 : int *lwork,
17018 : int *iwork,
17019 : int *info)
17020 : {
17021 : int a_dim1, a_offset, u_dim1, u_offset, vt_dim1, vt_offset, i__1, i__2;
17022 :
17023 : int ie, iu;
17024 : float dum[1], eps;
17025 : int ivt, iscl;
17026 : float anrm;
17027 : int idum[1], ierr, itau;
17028 : int minmn, wrkbl, itaup, itauq, mnthr;
17029 : int nwork;
17030 : int wntqn;
17031 : int bdspac;
17032 : float bignum;
17033 : int ldwrku, maxwrk, ldwkvt;
17034 : float smlnum,minval, safemin;
17035 : int lquery;
17036 0 : int c__0 = 0;
17037 0 : int c__1 = 1;
17038 0 : float zero = 0.0;
17039 0 : float one = 1.0;
17040 :
17041 :
17042 0 : a_dim1 = *lda;
17043 0 : a_offset = 1 + a_dim1;
17044 0 : a -= a_offset;
17045 : --s;
17046 0 : u_dim1 = *ldu;
17047 0 : u_offset = 1 + u_dim1;
17048 0 : u -= u_offset;
17049 0 : vt_dim1 = *ldvt;
17050 0 : vt_offset = 1 + vt_dim1;
17051 0 : vt -= vt_offset;
17052 0 : --work;
17053 : --iwork;
17054 :
17055 0 : *info = 0;
17056 0 : minmn = (*m < *n) ? *m : *n;
17057 0 : mnthr = (int) (minmn * 11. / 6.);
17058 0 : wntqn = (*jobz=='o' || *jobz=='O');
17059 :
17060 : maxwrk = 1;
17061 0 : lquery = *lwork == -1;
17062 :
17063 0 : if (*info == 0 && *m > 0 && *n > 0) {
17064 0 : if (*m >= *n) {
17065 :
17066 0 : if (wntqn) {
17067 0 : bdspac = *n * 7;
17068 : } else {
17069 0 : bdspac = *n * 3 * *n + (*n << 2);
17070 : }
17071 0 : if (*m >= mnthr) {
17072 0 : if (wntqn) {
17073 :
17074 0 : wrkbl = *n * 67;
17075 0 : i__1 = wrkbl, i__2 = bdspac + *n;
17076 : maxwrk = (i__1 > i__2) ? i__1 : i__2;
17077 : } else {
17078 :
17079 0 : wrkbl = *n * 67;
17080 0 : i__1 = wrkbl, i__2 = *n + (*m << 5);
17081 : wrkbl = (i__1 > i__2) ? i__1 : i__2;
17082 0 : i__1 = wrkbl, i__2 = bdspac + *n * 3;
17083 : wrkbl = (i__1 > i__2) ? i__1 : i__2;
17084 0 : maxwrk = wrkbl + *n * *n;
17085 : }
17086 : } else {
17087 :
17088 0 : wrkbl = *n * 3 + (*m + *n*32);
17089 0 : if (wntqn) {
17090 0 : i__1 = wrkbl, i__2 = bdspac + *n * 3;
17091 : maxwrk = (i__1 > i__2) ? i__1 : i__2;
17092 : } else {
17093 0 : i__1 = maxwrk, i__2 = bdspac + *n * 3;
17094 : maxwrk = (i__1 > i__2) ? i__1 : i__2;
17095 : }
17096 : }
17097 : } else {
17098 :
17099 0 : if (wntqn) {
17100 0 : bdspac = *m * 7;
17101 : } else {
17102 0 : bdspac = *m * 3 * *m + (*m*4);
17103 : }
17104 0 : if (*n >= mnthr) {
17105 0 : if (wntqn) {
17106 :
17107 0 : wrkbl = *m * 67;
17108 0 : i__1 = wrkbl, i__2 = bdspac + *m;
17109 : maxwrk = (i__1 > i__2) ? i__1 : i__2;
17110 : } else {
17111 :
17112 0 : wrkbl = *m * 67;
17113 0 : i__1 = wrkbl, i__2 = *m + (*n*32);
17114 : wrkbl = (i__1 > i__2) ? i__1 : i__2;
17115 :
17116 0 : i__1 = wrkbl, i__2 = bdspac + *m * 3;
17117 : wrkbl = (i__1 > i__2) ? i__1 : i__2;
17118 0 : maxwrk = wrkbl + *m * *m;
17119 : }
17120 : } else {
17121 0 : wrkbl = *m * 3 + (*m + *n*32);
17122 0 : if (wntqn) {
17123 0 : i__1 = wrkbl, i__2 = bdspac + *m * 3;
17124 : maxwrk = (i__1 > i__2) ? i__1 : i__2;
17125 : } else {
17126 0 : i__1 = wrkbl, i__2 = bdspac + *m * 3;
17127 : maxwrk = (i__1 > i__2) ? i__1 : i__2;
17128 : }
17129 : }
17130 : }
17131 0 : work[1] = (float) maxwrk;
17132 : }
17133 :
17134 0 : if( lquery != 0)
17135 : {
17136 : return;
17137 : }
17138 :
17139 0 : if (*m == 0 || *n == 0) {
17140 0 : if (*lwork >= 1) {
17141 0 : work[1] = 1.;
17142 : }
17143 0 : return;
17144 : }
17145 : eps = PLUMED_GMX_FLOAT_EPS;
17146 : minval = PLUMED_GMX_FLOAT_MIN;
17147 : safemin = minval / eps;
17148 0 : smlnum = std::sqrt(safemin) / eps;
17149 :
17150 :
17151 0 : bignum = 1. / smlnum;
17152 :
17153 :
17154 0 : anrm = PLUMED_BLAS_F77_FUNC(slange,SLANGE)("M", m, n, &a[a_offset], lda, dum);
17155 : iscl = 0;
17156 0 : if (anrm > 0. && anrm < smlnum) {
17157 : iscl = 1;
17158 0 : PLUMED_BLAS_F77_FUNC(slascl,SLASCL)("G",&c__0,&c__0,&anrm,&smlnum,m,n,&a[a_offset],lda,&ierr);
17159 0 : } else if (anrm > bignum) {
17160 : iscl = 1;
17161 0 : PLUMED_BLAS_F77_FUNC(slascl,SLASCL)("G",&c__0,&c__0,&anrm,&bignum,m,n,&a[a_offset],lda,&ierr);
17162 : }
17163 :
17164 0 : if (*m >= *n) {
17165 0 : if (*m >= mnthr) {
17166 :
17167 0 : if (wntqn) {
17168 :
17169 : itau = 1;
17170 0 : nwork = itau + *n;
17171 :
17172 0 : i__1 = *lwork - nwork + 1;
17173 0 : PLUMED_BLAS_F77_FUNC(sgeqrf,SGEQRF)(m, n, &a[a_offset], lda, &work[itau], &work[nwork], &
17174 : i__1, &ierr);
17175 :
17176 0 : i__1 = *n - 1;
17177 0 : i__2 = *n - 1;
17178 0 : PLUMED_BLAS_F77_FUNC(slaset,SLASET)("L", &i__1, &i__2, &zero, &zero, &a[a_dim1 + 2],
17179 : lda);
17180 : ie = 1;
17181 0 : itauq = ie + *n;
17182 0 : itaup = itauq + *n;
17183 0 : nwork = itaup + *n;
17184 :
17185 0 : i__1 = *lwork - nwork + 1;
17186 0 : PLUMED_BLAS_F77_FUNC(sgebrd,SGEBRD)(n, n, &a[a_offset], lda, &s[1], &work[ie], &work[
17187 0 : itauq], &work[itaup], &work[nwork], &i__1, &ierr);
17188 0 : nwork = ie + *n;
17189 :
17190 0 : PLUMED_BLAS_F77_FUNC(sbdsdc,SBDSDC)("U", "N", n, &s[1], &work[ie], dum, &c__1, dum, &c__1,
17191 0 : dum, idum, &work[nwork], &iwork[1], info);
17192 :
17193 : } else {
17194 : iu = 1;
17195 :
17196 0 : ldwrku = *n;
17197 0 : itau = iu + ldwrku * *n;
17198 0 : nwork = itau + *n;
17199 :
17200 0 : i__1 = *lwork - nwork + 1;
17201 0 : PLUMED_BLAS_F77_FUNC(sgeqrf,SGEQRF)(m, n, &a[a_offset], lda, &work[itau], &work[nwork], &
17202 : i__1, &ierr);
17203 0 : PLUMED_BLAS_F77_FUNC(slacpy,SLACPY)("L", m, n, &a[a_offset], lda, &u[u_offset], ldu);
17204 :
17205 0 : i__1 = *lwork - nwork + 1;
17206 0 : PLUMED_BLAS_F77_FUNC(sorgqr,SORGQR)(m, m, n, &u[u_offset], ldu, &work[itau], &work[nwork],
17207 : &i__1, &ierr);
17208 :
17209 0 : i__1 = *n - 1;
17210 0 : i__2 = *n - 1;
17211 0 : PLUMED_BLAS_F77_FUNC(slaset,SLASET)("L", &i__1, &i__2, &zero, &zero, &a[a_dim1 + 2],
17212 : lda);
17213 : ie = itau;
17214 0 : itauq = ie + *n;
17215 0 : itaup = itauq + *n;
17216 0 : nwork = itaup + *n;
17217 :
17218 0 : i__1 = *lwork - nwork + 1;
17219 0 : PLUMED_BLAS_F77_FUNC(sgebrd,SGEBRD)(n, n, &a[a_offset], lda, &s[1], &work[ie], &work[
17220 0 : itauq], &work[itaup], &work[nwork], &i__1, &ierr);
17221 :
17222 0 : PLUMED_BLAS_F77_FUNC(sbdsdc,SBDSDC)("U", "I", n, &s[1], &work[ie], &work[iu], n, &vt[
17223 : vt_offset], ldvt, dum, idum, &work[nwork], &iwork[1],
17224 : info);
17225 :
17226 0 : i__1 = *lwork - nwork + 1;
17227 0 : PLUMED_BLAS_F77_FUNC(sormbr,SORMBR)("Q", "L", "N", n, n, n, &a[a_offset], lda, &work[
17228 : itauq], &work[iu], &ldwrku, &work[nwork], &i__1, &
17229 : ierr);
17230 0 : i__1 = *lwork - nwork + 1;
17231 0 : PLUMED_BLAS_F77_FUNC(sormbr,SORMBR)("P", "R", "T", n, n, n, &a[a_offset], lda, &work[
17232 : itaup], &vt[vt_offset], ldvt, &work[nwork], &i__1, &
17233 : ierr);
17234 :
17235 0 : PLUMED_BLAS_F77_FUNC(sgemm,SGEMM)("N", "N", m, n, n, &one, &u[u_offset], ldu, &work[iu]
17236 : , &ldwrku, &zero, &a[a_offset], lda);
17237 :
17238 0 : PLUMED_BLAS_F77_FUNC(slacpy,SLACPY)("F", m, n, &a[a_offset], lda, &u[u_offset], ldu);
17239 :
17240 : }
17241 :
17242 : } else {
17243 : ie = 1;
17244 0 : itauq = ie + *n;
17245 0 : itaup = itauq + *n;
17246 0 : nwork = itaup + *n;
17247 :
17248 0 : i__1 = *lwork - nwork + 1;
17249 0 : PLUMED_BLAS_F77_FUNC(sgebrd,SGEBRD)(m, n, &a[a_offset], lda, &s[1], &work[ie], &work[itauq], &
17250 0 : work[itaup], &work[nwork], &i__1, &ierr);
17251 0 : if (wntqn) {
17252 :
17253 0 : PLUMED_BLAS_F77_FUNC(sbdsdc,SBDSDC)("U", "N", n, &s[1], &work[ie], dum, &c__1, dum, &c__1,
17254 : dum, idum, &work[nwork], &iwork[1], info);
17255 : } else {
17256 :
17257 0 : PLUMED_BLAS_F77_FUNC(slaset,SLASET)("F", m, m, &zero, &zero, &u[u_offset], ldu);
17258 0 : PLUMED_BLAS_F77_FUNC(sbdsdc,SBDSDC)("U", "I", n, &s[1], &work[ie], &u[u_offset], ldu, &vt[
17259 : vt_offset], ldvt, dum, idum, &work[nwork], &iwork[1],
17260 : info);
17261 :
17262 0 : i__1 = *m - *n;
17263 0 : i__2 = *m - *n;
17264 0 : PLUMED_BLAS_F77_FUNC(slaset,SLASET)("F", &i__1, &i__2, &zero, &one, &u[*n + 1 + (*n +
17265 0 : 1) * u_dim1], ldu);
17266 :
17267 0 : i__1 = *lwork - nwork + 1;
17268 0 : PLUMED_BLAS_F77_FUNC(sormbr,SORMBR)("Q", "L", "N", m, m, n, &a[a_offset], lda, &work[
17269 : itauq], &u[u_offset], ldu, &work[nwork], &i__1, &ierr);
17270 0 : i__1 = *lwork - nwork + 1;
17271 0 : PLUMED_BLAS_F77_FUNC(sormbr,SORMBR)("P", "R", "T", n, n, m, &a[a_offset], lda, &work[
17272 : itaup], &vt[vt_offset],ldvt,&work[nwork],&i__1,&ierr);
17273 : }
17274 :
17275 : }
17276 :
17277 : } else {
17278 :
17279 0 : if (*n >= mnthr) {
17280 :
17281 0 : if (wntqn) {
17282 :
17283 : itau = 1;
17284 0 : nwork = itau + *m;
17285 :
17286 0 : i__1 = *lwork - nwork + 1;
17287 0 : PLUMED_BLAS_F77_FUNC(sgelqf,SGELQF)(m, n, &a[a_offset], lda, &work[itau], &work[nwork], &
17288 : i__1, &ierr);
17289 :
17290 0 : i__1 = *m - 1;
17291 0 : i__2 = *m - 1;
17292 0 : PLUMED_BLAS_F77_FUNC(slaset,SLASET)("U", &i__1, &i__2, &zero, &zero, &a[(a_dim1*2) +
17293 0 : 1], lda);
17294 : ie = 1;
17295 0 : itauq = ie + *m;
17296 0 : itaup = itauq + *m;
17297 0 : nwork = itaup + *m;
17298 :
17299 0 : i__1 = *lwork - nwork + 1;
17300 0 : PLUMED_BLAS_F77_FUNC(sgebrd,SGEBRD)(m, m, &a[a_offset], lda, &s[1], &work[ie], &work[
17301 0 : itauq], &work[itaup], &work[nwork], &i__1, &ierr);
17302 0 : nwork = ie + *m;
17303 :
17304 0 : PLUMED_BLAS_F77_FUNC(sbdsdc,SBDSDC)("U", "N", m, &s[1], &work[ie], dum, &c__1, dum, &c__1,
17305 0 : dum, idum, &work[nwork], &iwork[1], info);
17306 :
17307 : } else {
17308 :
17309 : ivt = 1;
17310 :
17311 0 : ldwkvt = *m;
17312 0 : itau = ivt + ldwkvt * *m;
17313 0 : nwork = itau + *m;
17314 :
17315 0 : i__1 = *lwork - nwork + 1;
17316 0 : PLUMED_BLAS_F77_FUNC(sgelqf,SGELQF)(m, n, &a[a_offset], lda, &work[itau], &work[nwork], &
17317 : i__1, &ierr);
17318 0 : PLUMED_BLAS_F77_FUNC(slacpy,SLACPY)("U", m, n, &a[a_offset], lda, &vt[vt_offset], ldvt);
17319 :
17320 0 : i__1 = *lwork - nwork + 1;
17321 0 : PLUMED_BLAS_F77_FUNC(sorglq,SORGLQ)(n, n, m, &vt[vt_offset], ldvt, &work[itau], &work[
17322 : nwork], &i__1, &ierr);
17323 :
17324 0 : i__1 = *m - 1;
17325 0 : i__2 = *m - 1;
17326 0 : PLUMED_BLAS_F77_FUNC(slaset,SLASET)("U", &i__1, &i__2, &zero, &zero, &a[(a_dim1*2) +
17327 0 : 1], lda);
17328 : ie = itau;
17329 0 : itauq = ie + *m;
17330 0 : itaup = itauq + *m;
17331 0 : nwork = itaup + *m;
17332 :
17333 0 : i__1 = *lwork - nwork + 1;
17334 0 : PLUMED_BLAS_F77_FUNC(sgebrd,SGEBRD)(m, m, &a[a_offset], lda, &s[1], &work[ie], &work[
17335 0 : itauq], &work[itaup], &work[nwork], &i__1, &ierr);
17336 :
17337 0 : PLUMED_BLAS_F77_FUNC(sbdsdc,SBDSDC)("U", "I", m, &s[1], &work[ie], &u[u_offset], ldu, &
17338 : work[ivt], &ldwkvt, dum, idum, &work[nwork], &iwork[1]
17339 : , info);
17340 :
17341 0 : i__1 = *lwork - nwork + 1;
17342 0 : PLUMED_BLAS_F77_FUNC(sormbr,SORMBR)("Q", "L", "N", m, m, m, &a[a_offset], lda, &work[
17343 : itauq], &u[u_offset], ldu, &work[nwork], &i__1, &ierr);
17344 0 : i__1 = *lwork - nwork + 1;
17345 0 : PLUMED_BLAS_F77_FUNC(sormbr,SORMBR)("P", "R", "T", m, m, m, &a[a_offset], lda, &work[
17346 : itaup], &work[ivt], &ldwkvt, &work[nwork], &i__1, &
17347 : ierr);
17348 :
17349 0 : PLUMED_BLAS_F77_FUNC(sgemm,SGEMM)("N", "N", m, n, m, &one, &work[ivt], &ldwkvt, &vt[
17350 : vt_offset], ldvt, &zero, &a[a_offset], lda);
17351 :
17352 0 : PLUMED_BLAS_F77_FUNC(slacpy,SLACPY)("F", m, n, &a[a_offset], lda, &vt[vt_offset], ldvt);
17353 :
17354 : }
17355 :
17356 : } else {
17357 :
17358 : ie = 1;
17359 0 : itauq = ie + *m;
17360 0 : itaup = itauq + *m;
17361 0 : nwork = itaup + *m;
17362 :
17363 0 : i__1 = *lwork - nwork + 1;
17364 0 : PLUMED_BLAS_F77_FUNC(sgebrd,SGEBRD)(m, n, &a[a_offset], lda, &s[1], &work[ie], &work[itauq], &
17365 0 : work[itaup], &work[nwork], &i__1, &ierr);
17366 0 : if (wntqn) {
17367 :
17368 0 : PLUMED_BLAS_F77_FUNC(sbdsdc,SBDSDC)("L", "N", m, &s[1], &work[ie], dum, &c__1, dum, &c__1,
17369 : dum, idum, &work[nwork], &iwork[1], info);
17370 : } else {
17371 0 : PLUMED_BLAS_F77_FUNC(slaset,SLASET)("F", n, n, &zero, &zero, &vt[vt_offset], ldvt);
17372 0 : PLUMED_BLAS_F77_FUNC(sbdsdc,SBDSDC)("L", "I", m, &s[1], &work[ie], &u[u_offset], ldu, &vt[
17373 : vt_offset], ldvt, dum, idum, &work[nwork], &iwork[1],
17374 : info);
17375 :
17376 0 : i__1 = *n - *m;
17377 0 : i__2 = *n - *m;
17378 0 : PLUMED_BLAS_F77_FUNC(slaset,SLASET)("F", &i__1, &i__2, &zero, &one, &vt[*m + 1 + (*m +
17379 0 : 1) * vt_dim1], ldvt);
17380 :
17381 0 : i__1 = *lwork - nwork + 1;
17382 0 : PLUMED_BLAS_F77_FUNC(sormbr,SORMBR)("Q", "L", "N", m, m, n, &a[a_offset], lda, &work[
17383 : itauq], &u[u_offset], ldu, &work[nwork], &i__1, &ierr);
17384 0 : i__1 = *lwork - nwork + 1;
17385 0 : PLUMED_BLAS_F77_FUNC(sormbr,SORMBR)("P", "R", "T", n, n, m, &a[a_offset], lda, &work[
17386 : itaup], &vt[vt_offset], ldvt, &work[nwork], &i__1, &
17387 : ierr);
17388 : }
17389 :
17390 : }
17391 :
17392 : }
17393 :
17394 0 : if (iscl == 1) {
17395 0 : if (anrm > bignum) {
17396 0 : PLUMED_BLAS_F77_FUNC(slascl,SLASCL)("G", &c__0, &c__0, &bignum, &anrm, &minmn, &c__1, &s[1], &
17397 : minmn, &ierr);
17398 : }
17399 0 : if (anrm < smlnum) {
17400 0 : PLUMED_BLAS_F77_FUNC(slascl,SLASCL)("G", &c__0, &c__0, &smlnum, &anrm, &minmn, &c__1, &s[1], &
17401 : minmn, &ierr);
17402 : }
17403 : }
17404 :
17405 0 : work[1] = (float) maxwrk;
17406 :
17407 0 : return;
17408 :
17409 : }
17410 :
17411 :
17412 : }
17413 : }
17414 : #include <cmath>
17415 : #include "real.h"
17416 :
17417 : #include "blas/blas.h"
17418 : #include "lapack.h"
17419 :
17420 :
17421 : #include "blas/blas.h"
17422 : namespace PLMD{
17423 : namespace lapack{
17424 : using namespace blas;
17425 : void
17426 0 : PLUMED_BLAS_F77_FUNC(sgetf2,SGETF2)(int *m,
17427 : int *n,
17428 : float *a,
17429 : int *lda,
17430 : int *ipiv,
17431 : int *info)
17432 : {
17433 : int j,jp,k,t1,t2,t3;
17434 : float minusone;
17435 : float tmp;
17436 :
17437 0 : minusone = -1.0;
17438 :
17439 0 : if(*m<=0 || *n<=0)
17440 : return;
17441 :
17442 : k = (*m < *n) ? *m : *n;
17443 0 : for(j=1;j<=k;j++) {
17444 0 : t1 = *m-j+1;
17445 0 : t2 = 1;
17446 0 : jp = j - 1 + PLUMED_BLAS_F77_FUNC(isamax,ISAMAX)(&t1,&(a[(j-1)*(*lda)+(j-1)]),&t2);
17447 0 : ipiv[j-1] = jp;
17448 0 : if( std::abs(a[(j-1)*(*lda)+(jp-1)])>PLUMED_GMX_FLOAT_MIN ) {
17449 0 : if(jp != j)
17450 0 : PLUMED_BLAS_F77_FUNC(sswap,SSWAP)(n,&(a[ j-1 ]),lda,&(a[ jp-1 ]),lda);
17451 :
17452 0 : if(j<*m) {
17453 0 : t1 = *m-j;
17454 0 : t2 = 1;
17455 0 : tmp = 1.0/a[(j-1)*(*lda)+(j-1)];
17456 0 : PLUMED_BLAS_F77_FUNC(sscal,SSCAL)(&t1,&tmp,&(a[(j-1)*(*lda)+(j)]),&t2);
17457 : }
17458 : } else {
17459 0 : *info = j;
17460 : }
17461 :
17462 0 : if(j<k) {
17463 0 : t1 = *m-j;
17464 0 : t2 = *n-j;
17465 0 : t3 = 1;
17466 0 : PLUMED_BLAS_F77_FUNC(sger,SGER)(&t1,&t2,&minusone,&(a[(j-1)*(*lda)+(j)]),&t3,
17467 0 : &(a[(j)*(*lda)+(j-1)]),lda, &(a[(j)*(*lda)+(j)]),lda);
17468 : }
17469 : }
17470 : return;
17471 : }
17472 : }
17473 : }
17474 : #include "blas/blas.h"
17475 : #include "lapack.h"
17476 : #include "lapack_limits.h"
17477 :
17478 : #include "blas/blas.h"
17479 : namespace PLMD{
17480 : namespace lapack{
17481 : using namespace blas;
17482 : void
17483 0 : PLUMED_BLAS_F77_FUNC(sgetrf,SGETRF)(int *m,
17484 : int *n,
17485 : float *a,
17486 : int *lda,
17487 : int *ipiv,
17488 : int *info)
17489 : {
17490 : int mindim,jb;
17491 : int i,j,k,l;
17492 : int iinfo;
17493 0 : float minusone = -1.0;
17494 0 : float one = 1.0;
17495 :
17496 0 : if(*m<=0 || *n<=0)
17497 0 : return;
17498 :
17499 0 : *info = 0;
17500 :
17501 0 : mindim = (*m < *n) ? *m : *n;
17502 :
17503 0 : if(DGETRF_BLOCKSIZE>=mindim) {
17504 :
17505 : /* unblocked code */
17506 0 : PLUMED_BLAS_F77_FUNC(sgetf2,SGETF2)(m,n,a,lda,ipiv,info);
17507 :
17508 : } else {
17509 :
17510 : /* blocked case */
17511 :
17512 0 : for(j=1;j<=mindim;j+=DGETRF_BLOCKSIZE) {
17513 0 : jb = ( DGETRF_BLOCKSIZE < (mindim-j+1)) ? DGETRF_BLOCKSIZE : (mindim-j+1);
17514 : /* factor diag. and subdiag blocks and test for singularity */
17515 0 : k = *m-j+1;
17516 0 : PLUMED_BLAS_F77_FUNC(sgetf2,SGETF2)(&k,&jb,&(a[(j-1)*(*lda)+(j-1)]),lda,&(ipiv[j-1]),&iinfo);
17517 :
17518 0 : if(*info==0 && iinfo>0)
17519 0 : *info = iinfo + j - 1;
17520 :
17521 : /* adjust pivot indices */
17522 0 : k = (*m < (j+jb-1)) ? *m : (j+jb-1);
17523 0 : for(i=j;i<=k;i++)
17524 0 : ipiv[i-1] += j - 1;
17525 :
17526 : /* Apply to columns 1 throughj j-1 */
17527 0 : k = j - 1;
17528 0 : i = j + jb - 1;
17529 0 : l = 1;
17530 0 : PLUMED_BLAS_F77_FUNC(slaswp,SLASWP)(&k,a,lda,&j,&i,ipiv,&l);
17531 0 : if((j+jb)<=*n) {
17532 : /* Apply to cols. j+jb through n */
17533 0 : k = *n-j-jb+1;
17534 0 : i = j+jb-1;
17535 0 : l = 1;
17536 0 : PLUMED_BLAS_F77_FUNC(slaswp,SLASWP)(&k,&(a[(j+jb-1)*(*lda)+0]),lda,&j,&i,ipiv,&l);
17537 : /* Compute block row of U */
17538 0 : k = *n-j-jb+1;
17539 0 : PLUMED_BLAS_F77_FUNC(strsm,STRSM)("Left","Lower","No transpose","Unit",&jb,&k,&one,
17540 0 : &(a[(j-1)*(*lda)+(j-1)]),lda,&(a[(j+jb-1)*(*lda)+(j-1)]),lda);
17541 :
17542 0 : if((j+jb)<=*m) {
17543 : /* Update trailing submatrix */
17544 0 : k = *m-j-jb+1;
17545 0 : i = *n-j-jb+1;
17546 0 : PLUMED_BLAS_F77_FUNC(sgemm,SGEMM)("No transpose","No transpose",&k,&i,&jb,&minusone,
17547 0 : &(a[(j-1)*(*lda)+(j+jb-1)]),lda,
17548 0 : &(a[(j+jb-1)*(*lda)+(j-1)]),lda,&one,
17549 0 : &(a[(j+jb-1)*(*lda)+(j+jb-1)]),lda);
17550 : }
17551 :
17552 : }
17553 : }
17554 : }
17555 : }
17556 : }
17557 : }
17558 : #include "blas/blas.h"
17559 : #include "lapack.h"
17560 : #include "lapack_limits.h"
17561 :
17562 : #include "blas/blas.h"
17563 : namespace PLMD{
17564 : namespace lapack{
17565 : using namespace blas;
17566 : void
17567 0 : PLUMED_BLAS_F77_FUNC(sgetri,SGETRI)(int *n,
17568 : float *a,
17569 : int *lda,
17570 : int *ipiv,
17571 : float *work,
17572 : int *lwork,
17573 : int *info)
17574 : {
17575 : int a_dim1, a_offset, i__1, i__2, i__3;
17576 :
17577 : int i__, j, jb, nb, jj, jp, nn, iws;
17578 : int nbmin;
17579 : int ldwork;
17580 : int lwkopt;
17581 0 : int c__1 = 1;
17582 0 : float c_b20 = -1.;
17583 0 : float c_b22 = 1.;
17584 :
17585 0 : a_dim1 = *lda;
17586 0 : a_offset = 1 + a_dim1;
17587 0 : a -= a_offset;
17588 : --ipiv;
17589 0 : --work;
17590 :
17591 0 : *info = 0;
17592 : nb = DGETRI_BLOCKSIZE;
17593 0 : lwkopt = *n * nb;
17594 0 : work[1] = (float) lwkopt;
17595 :
17596 0 : if (*n < 0) {
17597 0 : *info = -1;
17598 0 : } else if (*lda < (*n)) {
17599 0 : *info = -3;
17600 0 : } else if (*lwork < (*n) && *lwork!=-1) {
17601 0 : *info = -6;
17602 : }
17603 0 : if (*info != 0) {
17604 : i__1 = -(*info);
17605 : return;
17606 0 : } else if (*lwork == -1) {
17607 : return;
17608 : }
17609 :
17610 0 : if (*n == 0) {
17611 : return;
17612 : }
17613 :
17614 0 : PLUMED_BLAS_F77_FUNC(strtri,STRTRI)("Upper", "Non-unit", n, &a[a_offset], lda, info);
17615 0 : if (*info > 0) {
17616 : return;
17617 : }
17618 :
17619 : nbmin = 2;
17620 0 : ldwork = *n;
17621 0 : if (nb > 1 && nb < *n) {
17622 0 : i__1 = ldwork * nb;
17623 0 : iws = (i__1>1) ? i__1 : 1;
17624 0 : if (*lwork < iws) {
17625 0 : nb = *lwork / ldwork;
17626 : nbmin = DGETRI_MINBLOCKSIZE;
17627 : }
17628 : } else {
17629 : iws = *n;
17630 : }
17631 :
17632 0 : if (nb < nbmin || nb >= *n) {
17633 :
17634 0 : for (j = *n; j >= 1; --j) {
17635 :
17636 0 : i__1 = *n;
17637 0 : for (i__ = j + 1; i__ <= i__1; ++i__) {
17638 0 : work[i__] = a[i__ + j * a_dim1];
17639 0 : a[i__ + j * a_dim1] = 0.;
17640 : }
17641 :
17642 0 : if (j < *n) {
17643 0 : i__1 = *n - j;
17644 0 : PLUMED_BLAS_F77_FUNC(sgemv,SGEMV)("No transpose", n, &i__1, &c_b20, &a[(j + 1) * a_dim1
17645 0 : + 1], lda, &work[j + 1], &c__1, &c_b22, &a[j * a_dim1
17646 0 : + 1], &c__1);
17647 : }
17648 : }
17649 : } else {
17650 :
17651 0 : nn = (*n - 1) / nb * nb + 1;
17652 0 : i__1 = -nb;
17653 0 : for (j = nn; i__1 < 0 ? j >= 1 : j <= 1; j += i__1) {
17654 0 : i__2 = nb, i__3 = *n - j + 1;
17655 0 : jb = (i__2<i__3) ? i__2 : i__3;
17656 :
17657 0 : i__2 = j + jb - 1;
17658 0 : for (jj = j; jj <= i__2; ++jj) {
17659 0 : i__3 = *n;
17660 0 : for (i__ = jj + 1; i__ <= i__3; ++i__) {
17661 0 : work[i__ + (jj - j) * ldwork] = a[i__ + jj * a_dim1];
17662 0 : a[i__ + jj * a_dim1] = 0.;
17663 : }
17664 : }
17665 :
17666 0 : if (j + jb <= *n) {
17667 0 : i__2 = *n - j - jb + 1;
17668 0 : PLUMED_BLAS_F77_FUNC(sgemm,SGEMM)("No transpose", "No transpose", n, &jb, &i__2, &c_b20,
17669 0 : &a[(j + jb) * a_dim1 + 1], lda, &work[j + jb], &
17670 0 : ldwork, &c_b22, &a[j * a_dim1 + 1], lda);
17671 : }
17672 0 : PLUMED_BLAS_F77_FUNC(strsm,STRSM)("Right", "Lower", "No transpose", "Unit", n, &jb, &c_b22, &
17673 0 : work[j], &ldwork, &a[j * a_dim1 + 1], lda);
17674 : }
17675 : }
17676 :
17677 0 : for (j = *n - 1; j >= 1; --j) {
17678 0 : jp = ipiv[j];
17679 0 : if (jp != j) {
17680 0 : PLUMED_BLAS_F77_FUNC(sswap,SSWAP)(n, &a[j * a_dim1 + 1], &c__1, &a[jp * a_dim1 + 1], &c__1);
17681 : }
17682 : }
17683 :
17684 0 : work[1] = (float) iws;
17685 0 : return;
17686 :
17687 : }
17688 :
17689 :
17690 : }
17691 : }
17692 : #include "blas/blas.h"
17693 : #include "lapack.h"
17694 :
17695 : #include "blas/blas.h"
17696 : namespace PLMD{
17697 : namespace lapack{
17698 : using namespace blas;
17699 : void
17700 0 : PLUMED_BLAS_F77_FUNC(sgetrs,SGETRS)(const char *trans,
17701 : int *n,
17702 : int *nrhs,
17703 : float *a,
17704 : int *lda,
17705 : int *ipiv,
17706 : float *b,
17707 : int *ldb,
17708 : int *info)
17709 : {
17710 : int a_dim1, a_offset, b_dim1, b_offset;
17711 : int notran;
17712 0 : int c__1 = 1;
17713 0 : int c_n1 = -1;
17714 0 : float one = 1.0;
17715 :
17716 : a_dim1 = *lda;
17717 : a_offset = 1 + a_dim1;
17718 : a -= a_offset;
17719 : --ipiv;
17720 : b_dim1 = *ldb;
17721 : b_offset = 1 + b_dim1;
17722 : b -= b_offset;
17723 :
17724 0 : *info = 0;
17725 0 : notran = (*trans=='N' || *trans=='n');
17726 :
17727 0 : if (*n <= 0 || *nrhs <= 0)
17728 : return;
17729 :
17730 0 : if (notran) {
17731 0 : PLUMED_BLAS_F77_FUNC(slaswp,SLASWP)(nrhs, &b[b_offset], ldb, &c__1, n, &ipiv[1], &c__1);
17732 0 : PLUMED_BLAS_F77_FUNC(strsm,STRSM)("Left", "Lower", "No transpose", "Unit", n, nrhs, &one,
17733 : &a[a_offset], lda, &b[b_offset], ldb);
17734 :
17735 0 : PLUMED_BLAS_F77_FUNC(strsm,STRSM)("Left", "Upper", "No transpose", "Non-unit", n, nrhs, &one,
17736 : &a[a_offset], lda, &b[b_offset], ldb);
17737 : } else {
17738 0 : PLUMED_BLAS_F77_FUNC(strsm,STRSM)("Left", "Upper", "Transpose", "Non-unit", n, nrhs, &one,
17739 : &a[a_offset], lda, &b[b_offset], ldb);
17740 0 : PLUMED_BLAS_F77_FUNC(strsm,STRSM)("Left", "Lower", "Transpose", "Unit", n, nrhs, &one,
17741 : &a[a_offset], lda, &b[b_offset], ldb);
17742 :
17743 0 : PLUMED_BLAS_F77_FUNC(slaswp,SLASWP)(nrhs, &b[b_offset], ldb, &c__1, n, &ipiv[1], &c_n1);
17744 : }
17745 :
17746 : return;
17747 :
17748 : }
17749 : }
17750 : }
17751 : #include <cmath>
17752 : #include "blas/blas.h"
17753 : #include "lapack.h"
17754 :
17755 :
17756 : #include "blas/blas.h"
17757 : namespace PLMD{
17758 : namespace lapack{
17759 : using namespace blas;
17760 : void
17761 0 : PLUMED_BLAS_F77_FUNC(slabrd,SLABRD)(int *m,
17762 : int *n,
17763 : int *nb,
17764 : float *a,
17765 : int *lda,
17766 : float *d__,
17767 : float *e,
17768 : float *tauq,
17769 : float *taup,
17770 : float *x,
17771 : int *ldx,
17772 : float *y,
17773 : int *ldy)
17774 : {
17775 : int a_dim1, a_offset, x_dim1, x_offset, y_dim1, y_offset;
17776 : int i__1, i__2, i__3;
17777 0 : float one = 1.0;
17778 0 : float minusone = -1.0;
17779 0 : float zero = 0.0;
17780 0 : int c__1 = 1;
17781 : int i__;
17782 :
17783 0 : a_dim1 = *lda;
17784 0 : a_offset = 1 + a_dim1;
17785 0 : a -= a_offset;
17786 0 : --d__;
17787 0 : --e;
17788 0 : --tauq;
17789 0 : --taup;
17790 0 : x_dim1 = *ldx;
17791 0 : x_offset = 1 + x_dim1;
17792 0 : x -= x_offset;
17793 0 : y_dim1 = *ldy;
17794 0 : y_offset = 1 + y_dim1;
17795 0 : y -= y_offset;
17796 :
17797 0 : if (*m <= 0 || *n <= 0) {
17798 : return;
17799 : }
17800 :
17801 0 : if (*m >= *n) {
17802 :
17803 0 : i__1 = *nb;
17804 0 : for (i__ = 1; i__ <= i__1; ++i__) {
17805 :
17806 0 : i__2 = *m - i__ + 1;
17807 0 : i__3 = i__ - 1;
17808 0 : PLUMED_BLAS_F77_FUNC(sgemv,SGEMV)("No transpose", &i__2, &i__3, &minusone, &a[i__ + a_dim1], lda,
17809 0 : &y[i__ + y_dim1], ldy, &one, &a[i__ + i__ * a_dim1], &c__1);
17810 0 : i__2 = *m - i__ + 1;
17811 0 : i__3 = i__ - 1;
17812 0 : PLUMED_BLAS_F77_FUNC(sgemv,SGEMV)("No transpose", &i__2, &i__3, &minusone, &x[i__ + x_dim1], ldx,
17813 0 : &a[i__*a_dim1+1],&c__1,&one,&a[i__+i__*a_dim1],&c__1);
17814 :
17815 0 : i__2 = *m - i__ + 1;
17816 0 : i__3 = i__ + 1;
17817 0 : if(*m<i__3)
17818 0 : i__3 = *m;
17819 0 : PLUMED_BLAS_F77_FUNC(slarfg,SLARFG)(&i__2, &a[i__ + i__ * a_dim1], &a[i__3 + i__ * a_dim1],
17820 0 : &c__1, &tauq[i__]);
17821 0 : d__[i__] = a[i__ + i__ * a_dim1];
17822 0 : if (i__ < *n) {
17823 0 : a[i__ + i__ * a_dim1] = 1.;
17824 :
17825 0 : i__2 = *m - i__ + 1;
17826 0 : i__3 = *n - i__;
17827 0 : PLUMED_BLAS_F77_FUNC(sgemv,SGEMV)("Transpose", &i__2, &i__3, &one, &a[i__ + (i__ + 1) *
17828 0 : a_dim1], lda, &a[i__ + i__ * a_dim1], &c__1, &zero, &
17829 0 : y[i__ + 1 + i__ * y_dim1], &c__1);
17830 0 : i__2 = *m - i__ + 1;
17831 0 : i__3 = i__ - 1;
17832 0 : PLUMED_BLAS_F77_FUNC(sgemv,SGEMV)("Transpose", &i__2, &i__3, &one, &a[i__ + a_dim1],
17833 0 : lda, &a[i__ + i__ * a_dim1], &c__1, &zero, &y[i__ *
17834 0 : y_dim1 + 1], &c__1);
17835 0 : i__2 = *n - i__;
17836 0 : i__3 = i__ - 1;
17837 0 : PLUMED_BLAS_F77_FUNC(sgemv,SGEMV)("No transpose", &i__2, &i__3, &minusone, &y[i__ + 1 +
17838 0 : y_dim1], ldy, &y[i__ * y_dim1 + 1], &c__1, &one, &y[
17839 0 : i__ + 1 + i__ * y_dim1], &c__1);
17840 0 : i__2 = *m - i__ + 1;
17841 0 : i__3 = i__ - 1;
17842 0 : PLUMED_BLAS_F77_FUNC(sgemv,SGEMV)("Transpose", &i__2, &i__3, &one, &x[i__ + x_dim1],
17843 0 : ldx, &a[i__ + i__ * a_dim1], &c__1, &zero, &y[i__ *
17844 0 : y_dim1 + 1], &c__1);
17845 0 : i__2 = i__ - 1;
17846 0 : i__3 = *n - i__;
17847 0 : PLUMED_BLAS_F77_FUNC(sgemv,SGEMV)("Transpose", &i__2, &i__3, &minusone, &a[(i__ + 1) *
17848 0 : a_dim1 + 1], lda, &y[i__ * y_dim1 + 1], &c__1, &one,
17849 0 : &y[i__ + 1 + i__ * y_dim1], &c__1);
17850 0 : i__2 = *n - i__;
17851 0 : PLUMED_BLAS_F77_FUNC(sscal,SSCAL)(&i__2, &tauq[i__], &y[i__ + 1 + i__ * y_dim1], &c__1);
17852 :
17853 0 : i__2 = *n - i__;
17854 0 : PLUMED_BLAS_F77_FUNC(sgemv,SGEMV)("No transpose", &i__2, &i__, &minusone, &y[i__ + 1 +
17855 0 : y_dim1], ldy, &a[i__ + a_dim1], lda, &one, &a[i__ + (
17856 0 : i__ + 1) * a_dim1], lda);
17857 0 : i__2 = i__ - 1;
17858 0 : i__3 = *n - i__;
17859 0 : PLUMED_BLAS_F77_FUNC(sgemv,SGEMV)("Transpose", &i__2, &i__3, &minusone, &a[(i__ + 1) *
17860 0 : a_dim1 + 1], lda, &x[i__ + x_dim1], ldx, &one, &a[
17861 0 : i__ + (i__ + 1) * a_dim1], lda);
17862 :
17863 0 : i__2 = *n - i__;
17864 0 : i__3 = i__ + 2;
17865 0 : if(*n<i__3)
17866 0 : i__3 = *n;
17867 0 : PLUMED_BLAS_F77_FUNC(slarfg,SLARFG)(&i__2, &a[i__ + (i__ + 1) * a_dim1],
17868 0 : &a[i__ + i__3 * a_dim1], lda, &taup[i__]);
17869 0 : e[i__] = a[i__ + (i__ + 1) * a_dim1];
17870 0 : a[i__ + (i__ + 1) * a_dim1] = 1.;
17871 :
17872 0 : i__2 = *m - i__;
17873 0 : i__3 = *n - i__;
17874 0 : PLUMED_BLAS_F77_FUNC(sgemv,SGEMV)("No transpose", &i__2, &i__3, &one, &a[i__ + 1 + (i__
17875 0 : + 1) * a_dim1], lda, &a[i__ + (i__ + 1) * a_dim1],
17876 0 : lda, &zero, &x[i__ + 1 + i__ * x_dim1], &c__1);
17877 0 : i__2 = *n - i__;
17878 0 : PLUMED_BLAS_F77_FUNC(sgemv,SGEMV)("Transpose", &i__2, &i__, &one, &y[i__ + 1 + y_dim1],
17879 0 : ldy, &a[i__ + (i__ + 1) * a_dim1], lda, &zero, &x[
17880 0 : i__ * x_dim1 + 1], &c__1);
17881 0 : i__2 = *m - i__;
17882 0 : PLUMED_BLAS_F77_FUNC(sgemv,SGEMV)("No transpose", &i__2, &i__, &minusone, &a[i__ + 1 +
17883 0 : a_dim1], lda, &x[i__ * x_dim1 + 1], &c__1, &one, &x[
17884 0 : i__ + 1 + i__ * x_dim1], &c__1);
17885 0 : i__2 = i__ - 1;
17886 0 : i__3 = *n - i__;
17887 0 : PLUMED_BLAS_F77_FUNC(sgemv,SGEMV)("No transpose", &i__2, &i__3, &one, &a[(i__ + 1) *
17888 0 : a_dim1 + 1], lda, &a[i__ + (i__ + 1) * a_dim1], lda, &
17889 0 : zero, &x[i__ * x_dim1 + 1], &c__1);
17890 0 : i__2 = *m - i__;
17891 0 : i__3 = i__ - 1;
17892 0 : PLUMED_BLAS_F77_FUNC(sgemv,SGEMV)("No transpose", &i__2, &i__3, &minusone, &x[i__ + 1 +
17893 0 : x_dim1], ldx, &x[i__ * x_dim1 + 1], &c__1, &one, &x[
17894 0 : i__ + 1 + i__ * x_dim1], &c__1);
17895 0 : i__2 = *m - i__;
17896 0 : PLUMED_BLAS_F77_FUNC(sscal,SSCAL)(&i__2, &taup[i__], &x[i__ + 1 + i__ * x_dim1], &c__1);
17897 : }
17898 : }
17899 : } else {
17900 :
17901 0 : i__1 = *nb;
17902 0 : for (i__ = 1; i__ <= i__1; ++i__) {
17903 :
17904 0 : i__2 = *n - i__ + 1;
17905 0 : i__3 = i__ - 1;
17906 0 : PLUMED_BLAS_F77_FUNC(sgemv,SGEMV)("No transpose", &i__2, &i__3, &minusone, &y[i__ + y_dim1], ldy,
17907 0 : &a[i__ + a_dim1], lda, &one, &a[i__ + i__ * a_dim1],lda);
17908 0 : i__2 = i__ - 1;
17909 0 : i__3 = *n - i__ + 1;
17910 0 : PLUMED_BLAS_F77_FUNC(sgemv,SGEMV)("Transpose", &i__2, &i__3, &minusone, &a[i__ * a_dim1 + 1],
17911 0 : lda, &x[i__ + x_dim1], ldx, &one,&a[i__+i__*a_dim1],lda);
17912 :
17913 0 : i__2 = *n - i__ + 1;
17914 0 : i__3 = i__ + 1;
17915 0 : if(*n<i__3)
17916 0 : i__3 = *n;
17917 0 : PLUMED_BLAS_F77_FUNC(slarfg,SLARFG)(&i__2, &a[i__ + i__ * a_dim1],
17918 0 : &a[i__ + i__3 * a_dim1], lda, &taup[i__]);
17919 0 : d__[i__] = a[i__ + i__ * a_dim1];
17920 0 : if (i__ < *m) {
17921 0 : a[i__ + i__ * a_dim1] = 1.;
17922 :
17923 0 : i__2 = *m - i__;
17924 0 : i__3 = *n - i__ + 1;
17925 0 : PLUMED_BLAS_F77_FUNC(sgemv,SGEMV)("No transpose",&i__2,&i__3,&one,&a[i__+1+i__*a_dim1],
17926 : lda, &a[i__ + i__ * a_dim1], lda, &zero,
17927 0 : &x[i__ + 1 + i__ * x_dim1], &c__1);
17928 0 : i__2 = *n - i__ + 1;
17929 0 : i__3 = i__ - 1;
17930 0 : PLUMED_BLAS_F77_FUNC(sgemv,SGEMV)("Transpose", &i__2, &i__3, &one, &y[i__ + y_dim1],
17931 0 : ldy, &a[i__ + i__ * a_dim1], lda, &zero, &x[i__ *
17932 0 : x_dim1 + 1], &c__1);
17933 0 : i__2 = *m - i__;
17934 0 : i__3 = i__ - 1;
17935 0 : PLUMED_BLAS_F77_FUNC(sgemv,SGEMV)("No transpose", &i__2, &i__3, &minusone, &a[i__ + 1 +
17936 0 : a_dim1], lda, &x[i__ * x_dim1 + 1], &c__1, &one, &x[
17937 0 : i__ + 1 + i__ * x_dim1], &c__1);
17938 0 : i__2 = i__ - 1;
17939 0 : i__3 = *n - i__ + 1;
17940 0 : PLUMED_BLAS_F77_FUNC(sgemv,SGEMV)("No transpose", &i__2, &i__3, &one, &a[i__ * a_dim1 +
17941 0 : 1], lda, &a[i__ + i__ * a_dim1], lda, &zero, &x[i__ *
17942 0 : x_dim1 + 1], &c__1);
17943 0 : i__2 = *m - i__;
17944 0 : i__3 = i__ - 1;
17945 0 : PLUMED_BLAS_F77_FUNC(sgemv,SGEMV)("No transpose", &i__2, &i__3, &minusone, &x[i__ + 1 +
17946 0 : x_dim1], ldx, &x[i__ * x_dim1 + 1], &c__1, &one, &x[
17947 0 : i__ + 1 + i__ * x_dim1], &c__1);
17948 0 : i__2 = *m - i__;
17949 0 : PLUMED_BLAS_F77_FUNC(sscal,SSCAL)(&i__2, &taup[i__], &x[i__ + 1 + i__ * x_dim1], &c__1);
17950 :
17951 0 : i__2 = *m - i__;
17952 0 : i__3 = i__ - 1;
17953 0 : PLUMED_BLAS_F77_FUNC(sgemv,SGEMV)("No transpose", &i__2, &i__3, &minusone, &a[i__ + 1 +
17954 0 : a_dim1], lda, &y[i__ + y_dim1], ldy, &one, &a[i__ +
17955 0 : 1 + i__ * a_dim1], &c__1);
17956 0 : i__2 = *m - i__;
17957 0 : PLUMED_BLAS_F77_FUNC(sgemv,SGEMV)("No transpose", &i__2, &i__, &minusone, &x[i__ + 1 +
17958 0 : x_dim1], ldx, &a[i__ * a_dim1 + 1], &c__1, &one, &a[
17959 0 : i__ + 1 + i__ * a_dim1], &c__1);
17960 :
17961 0 : i__2 = *m - i__;
17962 0 : i__3 = i__ + 2;
17963 0 : if(*m<i__3)
17964 0 : i__3 = *m;
17965 0 : PLUMED_BLAS_F77_FUNC(slarfg,SLARFG)(&i__2, &a[i__ + 1 + i__ * a_dim1],
17966 0 : &a[i__3 + i__ * a_dim1], &c__1, &tauq[i__]);
17967 0 : e[i__] = a[i__ + 1 + i__ * a_dim1];
17968 0 : a[i__ + 1 + i__ * a_dim1] = 1.;
17969 :
17970 0 : i__2 = *m - i__;
17971 0 : i__3 = *n - i__;
17972 0 : PLUMED_BLAS_F77_FUNC(sgemv,SGEMV)("Transpose", &i__2, &i__3, &one, &a[i__ + 1 + (i__ +
17973 0 : 1) * a_dim1], lda, &a[i__ + 1 + i__ * a_dim1], &c__1,
17974 0 : &zero, &y[i__ + 1 + i__ * y_dim1], &c__1);
17975 0 : i__2 = *m - i__;
17976 0 : i__3 = i__ - 1;
17977 0 : PLUMED_BLAS_F77_FUNC(sgemv,SGEMV)("Transpose", &i__2, &i__3, &one, &a[i__ + 1 + a_dim1],
17978 0 : lda, &a[i__ + 1 + i__ * a_dim1], &c__1, &zero, &y[
17979 0 : i__ * y_dim1 + 1], &c__1);
17980 0 : i__2 = *n - i__;
17981 0 : i__3 = i__ - 1;
17982 0 : PLUMED_BLAS_F77_FUNC(sgemv,SGEMV)("No transpose", &i__2, &i__3, &minusone, &y[i__ + 1 +
17983 0 : y_dim1], ldy, &y[i__ * y_dim1 + 1], &c__1, &one, &y[
17984 0 : i__ + 1 + i__ * y_dim1], &c__1);
17985 0 : i__2 = *m - i__;
17986 0 : PLUMED_BLAS_F77_FUNC(sgemv,SGEMV)("Transpose", &i__2, &i__, &one, &x[i__ + 1 + x_dim1],
17987 0 : ldx, &a[i__ + 1 + i__ * a_dim1], &c__1, &zero, &y[
17988 0 : i__ * y_dim1 + 1], &c__1);
17989 0 : i__2 = *n - i__;
17990 0 : PLUMED_BLAS_F77_FUNC(sgemv,SGEMV)("Transpose", &i__, &i__2, &minusone, &a[(i__ + 1) * a_dim1
17991 0 : + 1], lda, &y[i__ * y_dim1 + 1], &c__1, &one, &y[i__
17992 0 : + 1 + i__ * y_dim1], &c__1);
17993 0 : i__2 = *n - i__;
17994 0 : PLUMED_BLAS_F77_FUNC(sscal,SSCAL)(&i__2, &tauq[i__], &y[i__ + 1 + i__ * y_dim1], &c__1);
17995 : }
17996 : }
17997 : }
17998 : return;
17999 : }
18000 :
18001 : }
18002 : }
18003 : #include <cctype>
18004 : #include "lapack.h"
18005 :
18006 : /* LAPACK */
18007 : #include "blas/blas.h"
18008 : namespace PLMD{
18009 : namespace lapack{
18010 : using namespace blas;
18011 : void
18012 0 : PLUMED_BLAS_F77_FUNC(slacpy,SLACPY)(const char *uplo,
18013 : int *m,
18014 : int *n,
18015 : float *a,
18016 : int *lda,
18017 : float *b,
18018 : int *ldb)
18019 : {
18020 : int i,j,minjm;
18021 0 : const char ch=std::toupper(*uplo);
18022 :
18023 0 : if(ch=='U') {
18024 0 : for(j=0;j<*n;j++) {
18025 0 : minjm = (j < (*m-1)) ? j : (*m-1);
18026 0 : for(i=0;i<=minjm;i++)
18027 0 : b[j*(*ldb)+i] = a[j*(*lda)+i];
18028 : }
18029 0 : } else if(ch=='L') {
18030 0 : for(j=0;j<*n;j++) {
18031 0 : for(i=j;i<*m;i++)
18032 0 : b[j*(*ldb)+i] = a[j*(*lda)+i];
18033 : }
18034 : } else {
18035 0 : for(j=0;j<*n;j++) {
18036 0 : for(i=0;i<*m;i++)
18037 0 : b[j*(*ldb)+i] = a[j*(*lda)+i];
18038 : }
18039 : }
18040 0 : }
18041 : }
18042 : }
18043 : #include <cmath>
18044 : #include "lapack.h"
18045 :
18046 :
18047 : #include "blas/blas.h"
18048 : namespace PLMD{
18049 : namespace lapack{
18050 : using namespace blas;
18051 : void
18052 0 : PLUMED_BLAS_F77_FUNC(slae2,SLAE2)(float *a,
18053 : float *b,
18054 : float *c__,
18055 : float *rt1,
18056 : float *rt2)
18057 : {
18058 : float d__1;
18059 : float ab, df, tb, sm, rt, adf, acmn, acmx;
18060 :
18061 :
18062 0 : sm = *a + *c__;
18063 0 : df = *a - *c__;
18064 : adf = std::abs(df);
18065 0 : tb = *b + *b;
18066 : ab = std::abs(tb);
18067 0 : if (std::abs(*a) > std::abs(*c__)) {
18068 : acmx = *a;
18069 : acmn = *c__;
18070 : } else {
18071 : acmx = *c__;
18072 : acmn = *a;
18073 : }
18074 0 : if (adf > ab) {
18075 0 : d__1 = ab / adf;
18076 0 : rt = adf * std::sqrt(d__1 * d__1 + 1.);
18077 0 : } else if (adf < ab) {
18078 0 : d__1 = adf / ab;
18079 0 : rt = ab * std::sqrt(d__1 * d__1 + 1.);
18080 : } else {
18081 :
18082 0 : rt = ab * std::sqrt(2.);
18083 : }
18084 0 : if (sm < 0.) {
18085 0 : *rt1 = (sm - rt) * .5;
18086 0 : *rt2 = acmx / *rt1 * acmn - *b / *rt1 * *b;
18087 0 : } else if (sm > 0.) {
18088 0 : *rt1 = (sm + rt) * .5;
18089 0 : *rt2 = acmx / *rt1 * acmn - *b / *rt1 * *b;
18090 : } else {
18091 0 : *rt1 = rt * .5;
18092 0 : *rt2 = rt * -.5;
18093 : }
18094 0 : return;
18095 :
18096 : }
18097 :
18098 :
18099 : }
18100 : }
18101 : #include <cmath>
18102 : #include "lapack.h"
18103 :
18104 : #include "blas/blas.h"
18105 : namespace PLMD{
18106 : namespace lapack{
18107 : using namespace blas;
18108 : void
18109 0 : PLUMED_BLAS_F77_FUNC(slaebz,SLAEBZ)(int *ijob,
18110 : int *nitmax,
18111 : int *n,
18112 : int *mmax,
18113 : int *minp,
18114 : int *nbmin,
18115 : float *abstol,
18116 : float *reltol,
18117 : float *pivmin,
18118 : float *d__,
18119 : float *e,
18120 : float *e2,
18121 : int *nval,
18122 : float *ab,
18123 : float *c__,
18124 : int *mout,
18125 : int *nab,
18126 : float *work,
18127 : int *iwork,
18128 : int *info)
18129 : {
18130 : int nab_dim1, nab_offset, ab_dim1, ab_offset, i__1, i__2, i__3, i__4,
18131 : i__5, i__6;
18132 : float d__1, d__2, d__3, d__4;
18133 :
18134 : int j, kf, ji, kl, jp, jit;
18135 : float tmp1, tmp2;
18136 : int itmp1, itmp2, kfnew, klnew;
18137 :
18138 0 : nab_dim1 = *mmax;
18139 0 : nab_offset = 1 + nab_dim1;
18140 0 : nab -= nab_offset;
18141 : ab_dim1 = *mmax;
18142 : ab_offset = 1 + ab_dim1;
18143 0 : ab -= ab_offset;
18144 0 : --d__;
18145 : --e;
18146 0 : --e2;
18147 0 : --nval;
18148 0 : --c__;
18149 0 : --work;
18150 0 : --iwork;
18151 :
18152 0 : *info = 0;
18153 0 : if (*ijob < 1 || *ijob > 3) {
18154 0 : *info = -1;
18155 0 : return;
18156 : }
18157 :
18158 0 : if (*ijob == 1) {
18159 :
18160 0 : *mout = 0;
18161 :
18162 0 : i__1 = *minp;
18163 0 : for (ji = 1; ji <= i__1; ++ji) {
18164 0 : for (jp = 1; jp <= 2; ++jp) {
18165 0 : tmp1 = d__[1] - ab[ji + jp * ab_dim1];
18166 0 : if (std::abs(tmp1) < *pivmin) {
18167 0 : tmp1 = -(*pivmin);
18168 : }
18169 0 : nab[ji + jp * nab_dim1] = 0;
18170 0 : if (tmp1 <= 0.) {
18171 0 : nab[ji + jp * nab_dim1] = 1;
18172 : }
18173 :
18174 0 : i__2 = *n;
18175 0 : for (j = 2; j <= i__2; ++j) {
18176 0 : tmp1 = d__[j] - e2[j - 1] / tmp1 - ab[ji + jp * ab_dim1];
18177 0 : if (std::abs(tmp1) < *pivmin) {
18178 0 : tmp1 = -(*pivmin);
18179 : }
18180 0 : if (tmp1 <= 0.) {
18181 0 : ++nab[ji + jp * nab_dim1];
18182 : }
18183 : }
18184 : }
18185 0 : *mout = *mout + nab[ji + (nab_dim1 << 1)] - nab[ji + nab_dim1];
18186 : }
18187 : return;
18188 : }
18189 :
18190 : kf = 1;
18191 0 : kl = *minp;
18192 :
18193 0 : if (*ijob == 2) {
18194 : i__1 = *minp;
18195 0 : for (ji = 1; ji <= i__1; ++ji) {
18196 0 : c__[ji] = (ab[ji + ab_dim1] + ab[ji + (ab_dim1 << 1)]) * .5;
18197 : }
18198 : }
18199 :
18200 0 : i__1 = *nitmax;
18201 0 : for (jit = 1; jit <= i__1; ++jit) {
18202 :
18203 0 : if (kl - kf + 1 >= *nbmin && *nbmin > 0) {
18204 :
18205 : i__2 = kl;
18206 0 : for (ji = kf; ji <= i__2; ++ji) {
18207 :
18208 0 : work[ji] = d__[1] - c__[ji];
18209 0 : iwork[ji] = 0;
18210 0 : if (work[ji] <= *pivmin) {
18211 0 : iwork[ji] = 1;
18212 0 : d__1 = work[ji], d__2 = -(*pivmin);
18213 0 : work[ji] = (d__1<d__2) ? d__1 : d__2;
18214 : }
18215 :
18216 0 : i__3 = *n;
18217 0 : for (j = 2; j <= i__3; ++j) {
18218 0 : work[ji] = d__[j] - e2[j - 1] / work[ji] - c__[ji];
18219 0 : if (work[ji] <= *pivmin) {
18220 0 : ++iwork[ji];
18221 0 : d__1 = work[ji], d__2 = -(*pivmin);
18222 0 : work[ji] = (d__1<d__2) ? d__1 : d__2;
18223 : }
18224 : }
18225 : }
18226 :
18227 0 : if (*ijob <= 2) {
18228 :
18229 : klnew = kl;
18230 : i__2 = kl;
18231 0 : for (ji = kf; ji <= i__2; ++ji) {
18232 :
18233 0 : i__5 = nab[ji + nab_dim1];
18234 0 : i__6 = iwork[ji];
18235 0 : i__3 = nab[ji + (nab_dim1 << 1)];
18236 : i__4 = (i__5>i__6) ? i__5 : i__6;
18237 0 : iwork[ji] = (i__3<i__4) ? i__3 : i__4;
18238 :
18239 0 : if (iwork[ji] == nab[ji + (nab_dim1 << 1)]) {
18240 :
18241 0 : ab[ji + (ab_dim1 << 1)] = c__[ji];
18242 :
18243 0 : } else if (iwork[ji] == nab[ji + nab_dim1]) {
18244 :
18245 0 : ab[ji + ab_dim1] = c__[ji];
18246 : } else {
18247 0 : ++klnew;
18248 0 : if (klnew <= *mmax) {
18249 :
18250 0 : ab[klnew + (ab_dim1 << 1)] = ab[ji + (ab_dim1 <<
18251 0 : 1)];
18252 0 : nab[klnew + (nab_dim1 << 1)] = nab[ji + (nab_dim1
18253 0 : << 1)];
18254 0 : ab[klnew + ab_dim1] = c__[ji];
18255 0 : nab[klnew + nab_dim1] = iwork[ji];
18256 0 : ab[ji + (ab_dim1 << 1)] = c__[ji];
18257 0 : nab[ji + (nab_dim1 << 1)] = iwork[ji];
18258 : } else {
18259 0 : *info = *mmax + 1;
18260 : }
18261 : }
18262 : }
18263 0 : if (*info != 0) {
18264 : return;
18265 : }
18266 : kl = klnew;
18267 : } else {
18268 :
18269 : i__2 = kl;
18270 0 : for (ji = kf; ji <= i__2; ++ji) {
18271 0 : if (iwork[ji] <= nval[ji]) {
18272 0 : ab[ji + ab_dim1] = c__[ji];
18273 0 : nab[ji + nab_dim1] = iwork[ji];
18274 : }
18275 0 : if (iwork[ji] >= nval[ji]) {
18276 0 : ab[ji + (ab_dim1 << 1)] = c__[ji];
18277 0 : nab[ji + (nab_dim1 << 1)] = iwork[ji];
18278 : }
18279 : }
18280 : }
18281 :
18282 : } else {
18283 :
18284 : klnew = kl;
18285 : i__2 = kl;
18286 0 : for (ji = kf; ji <= i__2; ++ji) {
18287 :
18288 0 : tmp1 = c__[ji];
18289 0 : tmp2 = d__[1] - tmp1;
18290 : itmp1 = 0;
18291 0 : if (tmp2 <= *pivmin) {
18292 : itmp1 = 1;
18293 0 : d__1 = tmp2, d__2 = -(*pivmin);
18294 0 : tmp2 = (d__1<d__2) ? d__1 : d__2;
18295 : }
18296 :
18297 0 : i__3 = *n;
18298 0 : for (j = 2; j <= i__3; ++j) {
18299 0 : tmp2 = d__[j] - e2[j - 1] / tmp2 - tmp1;
18300 0 : if (tmp2 <= *pivmin) {
18301 0 : ++itmp1;
18302 0 : d__1 = tmp2, d__2 = -(*pivmin);
18303 0 : tmp2 = (d__1<d__2) ? d__1 : d__2;
18304 : }
18305 : }
18306 :
18307 0 : if (*ijob <= 2) {
18308 :
18309 0 : i__5 = nab[ji + nab_dim1];
18310 0 : i__3 = nab[ji + (nab_dim1 << 1)];
18311 : i__4 = (i__5>itmp1) ? i__5 : itmp1;
18312 : itmp1 = (i__3<i__4) ? i__3 : i__4;
18313 :
18314 0 : if (itmp1 == nab[ji + (nab_dim1 << 1)]) {
18315 :
18316 0 : ab[ji + (ab_dim1 << 1)] = tmp1;
18317 :
18318 0 : } else if (itmp1 == nab[ji + nab_dim1]) {
18319 :
18320 0 : ab[ji + ab_dim1] = tmp1;
18321 0 : } else if (klnew < *mmax) {
18322 :
18323 0 : ++klnew;
18324 0 : ab[klnew + (ab_dim1 << 1)] = ab[ji + (ab_dim1 << 1)];
18325 0 : nab[klnew + (nab_dim1 << 1)] = nab[ji + (nab_dim1 <<
18326 0 : 1)];
18327 0 : ab[klnew + ab_dim1] = tmp1;
18328 0 : nab[klnew + nab_dim1] = itmp1;
18329 0 : ab[ji + (ab_dim1 << 1)] = tmp1;
18330 0 : nab[ji + (nab_dim1 << 1)] = itmp1;
18331 : } else {
18332 0 : *info = *mmax + 1;
18333 0 : return;
18334 : }
18335 : } else {
18336 :
18337 0 : if (itmp1 <= nval[ji]) {
18338 0 : ab[ji + ab_dim1] = tmp1;
18339 0 : nab[ji + nab_dim1] = itmp1;
18340 : }
18341 0 : if (itmp1 >= nval[ji]) {
18342 0 : ab[ji + (ab_dim1 << 1)] = tmp1;
18343 0 : nab[ji + (nab_dim1 << 1)] = itmp1;
18344 : }
18345 : }
18346 : }
18347 : kl = klnew;
18348 :
18349 : }
18350 :
18351 : kfnew = kf;
18352 : i__2 = kl;
18353 0 : for (ji = kf; ji <= i__2; ++ji) {
18354 0 : tmp1 = std::abs(ab[ji + (ab_dim1 << 1)] - ab[ji + ab_dim1]);
18355 : d__3 = std::abs(ab[ji + (ab_dim1 << 1)]);
18356 : d__4 = std::abs(ab[ji + ab_dim1]);
18357 0 : tmp2 = (d__3>d__4) ? d__3 : d__4;
18358 0 : d__1 = (*abstol>*pivmin) ? *abstol : *pivmin;
18359 0 : d__2 = *reltol * tmp2;
18360 0 : if (tmp1 < ((d__1>d__2) ? d__1 : d__2) || nab[ji + nab_dim1] >= nab[ji + (
18361 0 : nab_dim1 << 1)]) {
18362 :
18363 0 : if (ji > kfnew) {
18364 : tmp1 = ab[ji + ab_dim1];
18365 : tmp2 = ab[ji + (ab_dim1 << 1)];
18366 0 : itmp1 = nab[ji + nab_dim1];
18367 0 : itmp2 = nab[ji + (nab_dim1 << 1)];
18368 0 : ab[ji + ab_dim1] = ab[kfnew + ab_dim1];
18369 0 : ab[ji + (ab_dim1 << 1)] = ab[kfnew + (ab_dim1 << 1)];
18370 0 : nab[ji + nab_dim1] = nab[kfnew + nab_dim1];
18371 0 : nab[ji + (nab_dim1 << 1)] = nab[kfnew + (nab_dim1 << 1)];
18372 0 : ab[kfnew + ab_dim1] = tmp1;
18373 0 : ab[kfnew + (ab_dim1 << 1)] = tmp2;
18374 0 : nab[kfnew + nab_dim1] = itmp1;
18375 0 : nab[kfnew + (nab_dim1 << 1)] = itmp2;
18376 0 : if (*ijob == 3) {
18377 0 : itmp1 = nval[ji];
18378 0 : nval[ji] = nval[kfnew];
18379 0 : nval[kfnew] = itmp1;
18380 : }
18381 : }
18382 0 : ++kfnew;
18383 : }
18384 : }
18385 : kf = kfnew;
18386 :
18387 : i__2 = kl;
18388 0 : for (ji = kf; ji <= i__2; ++ji) {
18389 0 : c__[ji] = (ab[ji + ab_dim1] + ab[ji + (ab_dim1 << 1)]) * .5;
18390 : }
18391 :
18392 0 : if (kf > kl) {
18393 : break;
18394 : }
18395 : }
18396 :
18397 0 : i__1 = kl + 1 - kf;
18398 0 : if(i__1>0)
18399 0 : *info = i__1;
18400 :
18401 0 : *mout = kl;
18402 :
18403 0 : return;
18404 :
18405 : }
18406 :
18407 :
18408 : }
18409 : }
18410 : #include <cmath>
18411 :
18412 : #include "lapack.h"
18413 :
18414 : #include "real.h"
18415 :
18416 : #include "blas/blas.h"
18417 : namespace PLMD{
18418 : namespace lapack{
18419 : using namespace blas;
18420 : void
18421 0 : PLUMED_BLAS_F77_FUNC(slaed6,SLAED6)(int *kniter,
18422 : int *orgati,
18423 : float *rho,
18424 : float *d__,
18425 : float *z__,
18426 : float *finit,
18427 : float *tau,
18428 : int *info)
18429 : {
18430 : int i__1;
18431 : float r__1, r__2, r__3, r__4;
18432 :
18433 : float a, b, c__, f;
18434 : int i__;
18435 : float fc, df, ddf, eta, eps, base;
18436 : int iter;
18437 : float temp, temp1, temp2, temp3, temp4;
18438 : int scale;
18439 : int niter;
18440 : float small1, small2, sminv1, sminv2, dscale[3], sclfac;
18441 : float zscale[3], erretm;
18442 : float safemin;
18443 : float sclinv = 0;
18444 :
18445 0 : --z__;
18446 0 : --d__;
18447 :
18448 0 : *info = 0;
18449 :
18450 : niter = 1;
18451 0 : *tau = 0.f;
18452 0 : if (*kniter == 2) {
18453 0 : if (*orgati) {
18454 0 : temp = (d__[3] - d__[2]) / 2.f;
18455 0 : c__ = *rho + z__[1] / (d__[1] - d__[2] - temp);
18456 0 : a = c__ * (d__[2] + d__[3]) + z__[2] + z__[3];
18457 0 : b = c__ * d__[2] * d__[3] + z__[2] * d__[3] + z__[3] * d__[2];
18458 : } else {
18459 0 : temp = (d__[1] - d__[2]) / 2.f;
18460 0 : c__ = *rho + z__[3] / (d__[3] - d__[2] - temp);
18461 0 : a = c__ * (d__[1] + d__[2]) + z__[1] + z__[2];
18462 0 : b = c__ * d__[1] * d__[2] + z__[1] * d__[2] + z__[2] * d__[1];
18463 : }
18464 0 : r__1 = std::abs(a), r__2 = std::abs(b), r__1 = ((r__1>r__2)? r__1:r__2), r__2 = std::abs(c__);
18465 0 : temp = (r__1>r__2) ? r__1 : r__2;
18466 0 : a /= temp;
18467 0 : b /= temp;
18468 0 : c__ /= temp;
18469 0 : if (c__ == 0.f) {
18470 0 : *tau = b / a;
18471 0 : } else if (a <= 0.f) {
18472 0 : *tau = (a - std::sqrt((r__1 = a * a - b * 4.f * c__, std::abs(r__1)))) / (
18473 0 : c__ * 2.f);
18474 : } else {
18475 0 : *tau = b * 2.f / (a + std::sqrt((r__1 = a * a - b * 4.f * c__, std::abs(r__1))));
18476 : }
18477 :
18478 0 : temp = *rho + z__[1] / (d__[1] - *tau) + z__[2] / (d__[2] - *tau) +
18479 0 : z__[3] / (d__[3] - *tau);
18480 0 : if (std::abs(*finit) <= std::abs(temp)) {
18481 0 : *tau = 0.f;
18482 : }
18483 : }
18484 :
18485 : eps = PLUMED_GMX_FLOAT_EPS;
18486 : base = 2;
18487 : safemin = PLUMED_GMX_FLOAT_MIN*(1.0+PLUMED_GMX_FLOAT_EPS);
18488 : i__1 = static_cast<int>(std::log(safemin) / std::log(base) / 3.f);
18489 : small1 = std::pow(base, static_cast<float>(i__1));
18490 : sminv1 = 1.f / small1;
18491 : small2 = small1 * small1;
18492 : sminv2 = sminv1 * sminv1;
18493 :
18494 0 : if (*orgati) {
18495 0 : r__3 = (r__1 = d__[2] - *tau, std::abs(r__1)), r__4 = (r__2 = d__[3] - *
18496 : tau, std::abs(r__2));
18497 0 : temp = (r__3<r__4) ? r__3 : r__4;
18498 : } else {
18499 0 : r__3 = (r__1 = d__[1] - *tau, std::abs(r__1)), r__4 = (r__2 = d__[2] - *
18500 : tau, std::abs(r__2));
18501 0 : temp = (r__3<r__4) ? r__3 : r__4;
18502 : }
18503 : scale = 0;
18504 0 : if (temp <= small1) {
18505 : scale = 1;
18506 0 : if (temp <= small2) {
18507 :
18508 : sclfac = sminv2;
18509 : sclinv = small2;
18510 : } else {
18511 :
18512 : sclfac = sminv1;
18513 : sclinv = small1;
18514 :
18515 : }
18516 :
18517 0 : for (i__ = 1; i__ <= 3; ++i__) {
18518 0 : dscale[i__ - 1] = d__[i__] * sclfac;
18519 0 : zscale[i__ - 1] = z__[i__] * sclfac;
18520 : }
18521 0 : *tau *= sclfac;
18522 : } else {
18523 :
18524 0 : for (i__ = 1; i__ <= 3; ++i__) {
18525 0 : dscale[i__ - 1] = d__[i__];
18526 0 : zscale[i__ - 1] = z__[i__];
18527 : }
18528 : }
18529 : fc = 0.f;
18530 : df = 0.f;
18531 : ddf = 0.f;
18532 0 : for (i__ = 1; i__ <= 3; ++i__) {
18533 0 : temp = 1.f / (dscale[i__ - 1] - *tau);
18534 0 : temp1 = zscale[i__ - 1] * temp;
18535 0 : temp2 = temp1 * temp;
18536 0 : temp3 = temp2 * temp;
18537 0 : fc += temp1 / dscale[i__ - 1];
18538 0 : df += temp2;
18539 0 : ddf += temp3;
18540 : }
18541 0 : f = *finit + *tau * fc;
18542 :
18543 0 : if (std::abs(f) <= 0.f) {
18544 0 : goto L60;
18545 : }
18546 : iter = niter + 1;
18547 0 : for (niter = iter; niter <= 20; ++niter) {
18548 0 : if (*orgati) {
18549 0 : temp1 = dscale[1] - *tau;
18550 0 : temp2 = dscale[2] - *tau;
18551 : } else {
18552 0 : temp1 = dscale[0] - *tau;
18553 0 : temp2 = dscale[1] - *tau;
18554 : }
18555 0 : a = (temp1 + temp2) * f - temp1 * temp2 * df;
18556 0 : b = temp1 * temp2 * f;
18557 0 : c__ = f - (temp1 + temp2) * df + temp1 * temp2 * ddf;
18558 0 : r__1 = std::abs(a), r__2 = std::abs(b), r__1 = ((r__1>r__2)? r__1:r__2), r__2 = std::abs(c__);
18559 0 : temp = (r__1>r__2) ? r__1 : r__2;
18560 0 : a /= temp;
18561 0 : b /= temp;
18562 0 : c__ /= temp;
18563 0 : if (c__ == 0.f) {
18564 0 : eta = b / a;
18565 0 : } else if (a <= 0.f) {
18566 0 : eta = (a - std::sqrt((r__1 = a * a - b * 4.f * c__, std::abs(r__1)))) / ( c__ * 2.f);
18567 : } else {
18568 0 : eta = b * 2.f / (a + std::sqrt((r__1 = a * a - b * 4.f * c__, std::abs( r__1))));
18569 : }
18570 0 : if (f * eta >= 0.f) {
18571 0 : eta = -f / df;
18572 : }
18573 0 : temp = eta + *tau;
18574 0 : if (*orgati) {
18575 0 : if (eta > 0.f && temp >= dscale[2]) {
18576 0 : eta = (dscale[2] - *tau) / 2.f;
18577 : }
18578 :
18579 0 : if (eta < 0.f && temp <= dscale[1]) {
18580 0 : eta = (dscale[1] - *tau) / 2.f;
18581 : }
18582 : } else {
18583 0 : if (eta > 0.f && temp >= dscale[1]) {
18584 0 : eta = (dscale[1] - *tau) / 2.f;
18585 : }
18586 0 : if (eta < 0.f && temp <= dscale[0]) {
18587 0 : eta = (dscale[0] - *tau) / 2.f;
18588 : }
18589 : }
18590 0 : *tau += eta;
18591 : fc = 0.f;
18592 : erretm = 0.f;
18593 : df = 0.f;
18594 : ddf = 0.f;
18595 0 : for (i__ = 1; i__ <= 3; ++i__) {
18596 0 : temp = 1.f / (dscale[i__ - 1] - *tau);
18597 0 : temp1 = zscale[i__ - 1] * temp;
18598 0 : temp2 = temp1 * temp;
18599 0 : temp3 = temp2 * temp;
18600 0 : temp4 = temp1 / dscale[i__ - 1];
18601 0 : fc += temp4;
18602 0 : erretm += std::abs(temp4);
18603 0 : df += temp2;
18604 0 : ddf += temp3;
18605 : }
18606 0 : f = *finit + *tau * fc;
18607 0 : erretm = (std::abs(*finit) + std::abs(*tau) * erretm) * 8.f + std::abs(*tau) * df;
18608 0 : if (std::abs(f) <= eps * erretm) {
18609 0 : goto L60;
18610 : }
18611 : }
18612 0 : *info = 1;
18613 0 : L60:
18614 0 : if (scale) {
18615 0 : *tau *= sclinv;
18616 : }
18617 0 : return;
18618 : }
18619 :
18620 :
18621 : }
18622 : }
18623 : #include <cmath>
18624 : #include "real.h"
18625 :
18626 : #include "lapack.h"
18627 :
18628 :
18629 : #include "blas/blas.h"
18630 : namespace PLMD{
18631 : namespace lapack{
18632 : using namespace blas;
18633 : void
18634 0 : PLUMED_BLAS_F77_FUNC(slaev2,SLAEV2)(float * a,
18635 : float * b,
18636 : float * c__,
18637 : float * rt1,
18638 : float * rt2,
18639 : float * cs1,
18640 : float * sn1)
18641 : {
18642 : float d__1;
18643 :
18644 : float ab, df, cs, ct, tb, sm, tn, rt, adf, acs;
18645 : int sgn1, sgn2;
18646 : float acmn, acmx;
18647 :
18648 0 : sm = *a + *c__;
18649 0 : df = *a - *c__;
18650 : adf = std::abs(df);
18651 0 : tb = *b + *b;
18652 : ab = std::abs(tb);
18653 0 : if (std::abs(*a) > std::abs(*c__)) {
18654 : acmx = *a;
18655 : acmn = *c__;
18656 : } else {
18657 : acmx = *c__;
18658 : acmn = *a;
18659 : }
18660 0 : if (adf > ab) {
18661 0 : d__1 = ab / adf;
18662 0 : rt = adf * std::sqrt(d__1 * d__1 + 1.);
18663 0 : } else if (adf < ab) {
18664 0 : d__1 = adf / ab;
18665 0 : rt = ab * std::sqrt(d__1 * d__1 + 1.);
18666 : } else {
18667 :
18668 0 : rt = ab * std::sqrt(2.);
18669 : }
18670 0 : if (sm < 0.) {
18671 0 : *rt1 = (sm - rt) * .5;
18672 : sgn1 = -1;
18673 :
18674 0 : *rt2 = acmx / *rt1 * acmn - *b / *rt1 * *b;
18675 0 : } else if (sm > 0.) {
18676 0 : *rt1 = (sm + rt) * .5;
18677 : sgn1 = 1;
18678 0 : *rt2 = acmx / *rt1 * acmn - *b / *rt1 * *b;
18679 : } else {
18680 0 : *rt1 = rt * .5;
18681 0 : *rt2 = rt * -.5;
18682 : sgn1 = 1;
18683 : }
18684 0 : if (df >= 0.) {
18685 0 : cs = df + rt;
18686 : sgn2 = 1;
18687 : } else {
18688 0 : cs = df - rt;
18689 : sgn2 = -1;
18690 : }
18691 : acs = std::abs(cs);
18692 0 : if (acs > ab) {
18693 0 : ct = -tb / cs;
18694 0 : *sn1 = 1. / std::sqrt(ct * ct + 1.);
18695 0 : *cs1 = ct * *sn1;
18696 : } else {
18697 0 : if (std::abs(ab)<PLUMED_GMX_FLOAT_MIN) {
18698 0 : *cs1 = 1.;
18699 0 : *sn1 = 0.;
18700 : } else {
18701 0 : tn = -cs / tb;
18702 0 : *cs1 = 1. / std::sqrt(tn * tn + 1.);
18703 0 : *sn1 = tn * *cs1;
18704 : }
18705 : }
18706 0 : if (sgn1 == sgn2) {
18707 0 : tn = *cs1;
18708 0 : *cs1 = -(*sn1);
18709 0 : *sn1 = tn;
18710 : }
18711 0 : return;
18712 :
18713 : }
18714 :
18715 :
18716 : }
18717 : }
18718 : #include <cmath>
18719 : #include "real.h"
18720 :
18721 : #include "lapack.h"
18722 : #include "lapack_limits.h"
18723 :
18724 :
18725 :
18726 : #include "blas/blas.h"
18727 : namespace PLMD{
18728 : namespace lapack{
18729 : using namespace blas;
18730 : void
18731 0 : PLUMED_BLAS_F77_FUNC(slagtf,SLAGTF)(int *n,
18732 : float *a,
18733 : float *lambda,
18734 : float *b,
18735 : float *c__,
18736 : float *tol,
18737 : float *d__,
18738 : int *in,
18739 : int *info)
18740 : {
18741 : int i__1;
18742 :
18743 : int k;
18744 : float tl, eps, piv1, piv2, temp, mult, scale1, scale2;
18745 :
18746 0 : --in;
18747 0 : --d__;
18748 0 : --c__;
18749 0 : --b;
18750 0 : --a;
18751 :
18752 0 : *info = 0;
18753 0 : if (*n < 0) {
18754 0 : *info = -1;
18755 0 : return;
18756 : }
18757 :
18758 0 : if (*n == 0)
18759 : return;
18760 :
18761 0 : a[1] -= *lambda;
18762 0 : in[*n] = 0;
18763 0 : if (*n == 1) {
18764 0 : if (std::abs(a[1])<PLUMED_GMX_FLOAT_MIN) {
18765 0 : in[1] = 1;
18766 : }
18767 0 : return;
18768 : }
18769 :
18770 : eps = PLUMED_GMX_FLOAT_EPS;
18771 :
18772 0 : tl = (*tol>eps) ? *tol : eps;
18773 0 : scale1 = std::abs(a[1]) + std::abs(b[1]);
18774 : i__1 = *n - 1;
18775 0 : for (k = 1; k <= i__1; ++k) {
18776 0 : a[k + 1] -= *lambda;
18777 0 : scale2 = std::abs(c__[k]) + std::abs(a[k + 1]);
18778 0 : if (k < *n - 1) {
18779 0 : scale2 += std::abs(b[k + 1]);
18780 : }
18781 0 : if (std::abs(a[k])<PLUMED_GMX_FLOAT_MIN) {
18782 : piv1 = 0.;
18783 : } else {
18784 0 : piv1 = std::abs(a[k]) / scale1;
18785 : }
18786 0 : if (std::abs(c__[k])<PLUMED_GMX_FLOAT_MIN) {
18787 0 : in[k] = 0;
18788 : piv2 = 0.;
18789 : scale1 = scale2;
18790 0 : if (k < *n - 1) {
18791 0 : d__[k] = 0.;
18792 : }
18793 : } else {
18794 0 : piv2 = std::abs(c__[k]) / scale2;
18795 0 : if (piv2 <= piv1) {
18796 0 : in[k] = 0;
18797 : scale1 = scale2;
18798 0 : c__[k] /= a[k];
18799 0 : a[k + 1] -= c__[k] * b[k];
18800 0 : if (k < *n - 1) {
18801 0 : d__[k] = 0.;
18802 : }
18803 : } else {
18804 0 : in[k] = 1;
18805 0 : mult = a[k] / c__[k];
18806 0 : a[k] = c__[k];
18807 0 : temp = a[k + 1];
18808 0 : a[k + 1] = b[k] - mult * temp;
18809 0 : if (k < *n - 1) {
18810 0 : d__[k] = b[k + 1];
18811 0 : b[k + 1] = -mult * d__[k];
18812 : }
18813 0 : b[k] = temp;
18814 0 : c__[k] = mult;
18815 : }
18816 : }
18817 0 : if (((piv1>piv2) ? piv1 : piv2) <= tl && in[*n] == 0) {
18818 0 : in[*n] = k;
18819 : }
18820 : }
18821 0 : if (std::abs(a[*n]) <= scale1 * tl && in[*n] == 0) {
18822 0 : in[*n] = *n;
18823 : }
18824 :
18825 : return;
18826 :
18827 : }
18828 :
18829 :
18830 : }
18831 : }
18832 : #include <stdlib.h>
18833 : #include <cmath>
18834 : #include "real.h"
18835 :
18836 : #include "lapack.h"
18837 : #include "lapack_limits.h"
18838 :
18839 :
18840 : #include "blas/blas.h"
18841 : namespace PLMD{
18842 : namespace lapack{
18843 : using namespace blas;
18844 : void
18845 0 : PLUMED_BLAS_F77_FUNC(slagts,SLAGTS)(int *job,
18846 : int *n,
18847 : float *a,
18848 : float *b,
18849 : float *c__,
18850 : float *d__,
18851 : int *in,
18852 : float *y,
18853 : float *tol,
18854 : int *info)
18855 : {
18856 : int i__1;
18857 : float d__1, d__2, d__4, d__5;
18858 :
18859 : int k;
18860 : float ak, eps, temp, pert, absak, sfmin;
18861 : float bignum,minval;
18862 0 : --y;
18863 0 : --in;
18864 0 : --d__;
18865 0 : --c__;
18866 0 : --b;
18867 0 : --a;
18868 :
18869 0 : *info = 0;
18870 0 : if (abs(*job) > 2 || *job == 0) {
18871 0 : *info = -1;
18872 0 : } else if (*n < 0) {
18873 0 : *info = -2;
18874 : }
18875 0 : if (*info != 0) {
18876 : return;
18877 : }
18878 :
18879 0 : if (*n == 0) {
18880 : return;
18881 : }
18882 : eps = PLUMED_GMX_FLOAT_EPS;
18883 : minval = PLUMED_GMX_FLOAT_MIN;
18884 : sfmin = minval / eps;
18885 :
18886 : bignum = 1. / sfmin;
18887 :
18888 0 : if (*job < 0) {
18889 0 : if (*tol <= 0.) {
18890 0 : *tol = std::abs(a[1]);
18891 0 : if (*n > 1) {
18892 : d__1 = *tol;
18893 0 : d__2 = std::abs(a[2]);
18894 0 : d__1 = (d__1>d__2) ? d__1 : d__2;
18895 0 : d__2 = std::abs(b[1]);
18896 0 : *tol = (d__1>d__2) ? d__1 : d__2;
18897 : }
18898 0 : i__1 = *n;
18899 0 : for (k = 3; k <= i__1; ++k) {
18900 0 : d__4 = *tol;
18901 0 : d__5 = std::abs(a[k]);
18902 0 : d__4 = (d__4>d__5) ? d__4 : d__5;
18903 0 : d__5 = std::abs(b[k - 1]);
18904 0 : d__4 = (d__4>d__5) ? d__4 : d__5;
18905 0 : d__5 = std::abs(d__[k - 2]);
18906 0 : *tol = (d__4>d__5) ? d__4 : d__5;
18907 : }
18908 0 : *tol *= eps;
18909 0 : if (std::abs(*tol)<PLUMED_GMX_FLOAT_MIN) {
18910 0 : *tol = eps;
18911 : }
18912 : }
18913 : }
18914 :
18915 0 : if (1 == abs(*job)) {
18916 0 : i__1 = *n;
18917 0 : for (k = 2; k <= i__1; ++k) {
18918 0 : if (in[k - 1] == 0) {
18919 0 : y[k] -= c__[k - 1] * y[k - 1];
18920 : } else {
18921 0 : temp = y[k - 1];
18922 0 : y[k - 1] = y[k];
18923 0 : y[k] = temp - c__[k - 1] * y[k];
18924 : }
18925 : }
18926 0 : if (*job == 1) {
18927 0 : for (k = *n; k >= 1; --k) {
18928 0 : if (k <= *n - 2) {
18929 0 : temp = y[k] - b[k] * y[k + 1] - d__[k] * y[k + 2];
18930 0 : } else if (k == *n - 1) {
18931 0 : temp = y[k] - b[k] * y[k + 1];
18932 : } else {
18933 0 : temp = y[k];
18934 : }
18935 0 : ak = a[k];
18936 : absak = std::abs(ak);
18937 0 : if (absak < 1.) {
18938 0 : if (absak < sfmin) {
18939 0 : if (std::abs(absak)<PLUMED_GMX_FLOAT_MIN || std::abs(temp) * sfmin > absak) {
18940 0 : *info = k;
18941 0 : return;
18942 : } else {
18943 0 : temp *= bignum;
18944 0 : ak *= bignum;
18945 : }
18946 0 : } else if (std::abs(temp) > absak * bignum) {
18947 0 : *info = k;
18948 0 : return;
18949 : }
18950 : }
18951 0 : y[k] = temp / ak;
18952 : }
18953 : } else {
18954 0 : for (k = *n; k >= 1; --k) {
18955 0 : if (k + 2 <= *n) {
18956 0 : temp = y[k] - b[k] * y[k + 1] - d__[k] * y[k + 2];
18957 0 : } else if (k + 1 == *n) {
18958 0 : temp = y[k] - b[k] * y[k + 1];
18959 : } else {
18960 0 : temp = y[k];
18961 : }
18962 0 : ak = a[k];
18963 :
18964 0 : pert = *tol;
18965 0 : if(ak<0)
18966 0 : pert *= -1.0;
18967 0 : L40:
18968 : absak = std::abs(ak);
18969 0 : if (absak < 1.) {
18970 0 : if (absak < sfmin) {
18971 0 : if (std::abs(absak)<PLUMED_GMX_FLOAT_MIN || std::abs(temp) * sfmin > absak) {
18972 0 : ak += pert;
18973 0 : pert *= 2;
18974 0 : goto L40;
18975 : } else {
18976 0 : temp *= bignum;
18977 0 : ak *= bignum;
18978 : }
18979 0 : } else if (std::abs(temp) > absak * bignum) {
18980 0 : ak += pert;
18981 0 : pert *= 2;
18982 0 : goto L40;
18983 : }
18984 : }
18985 0 : y[k] = temp / ak;
18986 : }
18987 : }
18988 : } else {
18989 :
18990 0 : if (*job == 2) {
18991 0 : i__1 = *n;
18992 0 : for (k = 1; k <= i__1; ++k) {
18993 0 : if (k >= 3) {
18994 0 : temp = y[k] - b[k - 1] * y[k - 1] - d__[k - 2] * y[k - 2];
18995 0 : } else if (k == 2) {
18996 0 : temp = y[k] - b[k - 1] * y[k - 1];
18997 : } else {
18998 0 : temp = y[k];
18999 : }
19000 0 : ak = a[k];
19001 : absak = std::abs(ak);
19002 0 : if (absak < 1.) {
19003 0 : if (absak < sfmin) {
19004 0 : if (std::abs(absak)<PLUMED_GMX_FLOAT_MIN || std::abs(temp) * sfmin > absak) {
19005 0 : *info = k;
19006 0 : return;
19007 : } else {
19008 0 : temp *= bignum;
19009 0 : ak *= bignum;
19010 : }
19011 0 : } else if (std::abs(temp) > absak * bignum) {
19012 0 : *info = k;
19013 0 : return;
19014 : }
19015 : }
19016 0 : y[k] = temp / ak;
19017 : }
19018 : } else {
19019 0 : i__1 = *n;
19020 0 : for (k = 1; k <= i__1; ++k) {
19021 0 : if (k >= 3) {
19022 0 : temp = y[k] - b[k - 1] * y[k - 1] - d__[k - 2] * y[k - 2];
19023 0 : } else if (k == 2) {
19024 0 : temp = y[k] - b[k - 1] * y[k - 1];
19025 : } else {
19026 0 : temp = y[k];
19027 : }
19028 0 : ak = a[k];
19029 :
19030 0 : pert = *tol;
19031 0 : if(ak<0)
19032 0 : pert *= -1.0;
19033 :
19034 0 : L70:
19035 : absak = std::abs(ak);
19036 0 : if (absak < 1.) {
19037 0 : if (absak < sfmin) {
19038 0 : if (std::abs(absak)<PLUMED_GMX_FLOAT_MIN || std::abs(temp) * sfmin > absak) {
19039 0 : ak += pert;
19040 0 : pert *= 2;
19041 0 : goto L70;
19042 : } else {
19043 0 : temp *= bignum;
19044 0 : ak *= bignum;
19045 : }
19046 0 : } else if (std::abs(temp) > absak * bignum) {
19047 0 : ak += pert;
19048 0 : pert *= 2;
19049 0 : goto L70;
19050 : }
19051 : }
19052 0 : y[k] = temp / ak;
19053 : }
19054 : }
19055 :
19056 0 : for (k = *n; k >= 2; --k) {
19057 0 : if (in[k - 1] == 0) {
19058 0 : y[k - 1] -= c__[k - 1] * y[k];
19059 : } else {
19060 0 : temp = y[k - 1];
19061 0 : y[k - 1] = y[k];
19062 0 : y[k] = temp - c__[k - 1] * y[k];
19063 : }
19064 : }
19065 : }
19066 :
19067 : return;
19068 : }
19069 :
19070 :
19071 : }
19072 : }
19073 : #include "lapack.h"
19074 :
19075 :
19076 : /* LAPACK */
19077 :
19078 :
19079 : #include "blas/blas.h"
19080 : namespace PLMD{
19081 : namespace lapack{
19082 : using namespace blas;
19083 : void
19084 0 : PLUMED_BLAS_F77_FUNC(slamrg,SLAMRG)(int *n1,
19085 : int *n2,
19086 : float *a,
19087 : int *dtrd1,
19088 : int *dtrd2,
19089 : int *index)
19090 : {
19091 0 : int n1sv = *n1;
19092 0 : int n2sv = *n2;
19093 : int i,ind1,ind2;
19094 :
19095 0 : if(*dtrd1>0)
19096 : ind1 = 0;
19097 : else
19098 0 : ind1 = *n1-1;
19099 :
19100 0 : if(*dtrd2>0)
19101 : ind2 = *n1;
19102 : else
19103 0 : ind2 = *n1+*n2-1;
19104 :
19105 : i = 0;
19106 :
19107 0 : while(n1sv>0 && n2sv>0) {
19108 0 : if(a[ind1]<=a[ind2]) {
19109 0 : index[i] = ind1 + 1;
19110 0 : i++;
19111 0 : ind1 += *dtrd1;
19112 0 : n1sv--;
19113 : } else {
19114 0 : index[i] = ind2 + 1;
19115 0 : i++;
19116 0 : ind2 += *dtrd2;
19117 0 : n2sv--;
19118 : }
19119 : }
19120 :
19121 0 : if(n1sv==0) {
19122 0 : for(n1sv=1;n1sv<=n2sv;n1sv++) {
19123 0 : index[i] = ind2 + 1;
19124 0 : i++;
19125 0 : ind2 += *dtrd2;
19126 : }
19127 : } else {
19128 0 : for(n2sv=1;n2sv<=n1sv;n2sv++) {
19129 0 : index[i] = ind1 + 1;
19130 0 : i++;
19131 0 : ind1 += *dtrd1;
19132 : }
19133 : }
19134 0 : return;
19135 : }
19136 : }
19137 : }
19138 : #include <cctype>
19139 : #include <cmath>
19140 :
19141 : #include "lapack.h"
19142 :
19143 :
19144 : #include "blas/blas.h"
19145 : namespace PLMD{
19146 : namespace lapack{
19147 : using namespace blas;
19148 : float
19149 0 : PLUMED_BLAS_F77_FUNC(slange,SLANGE)(const char *norm,
19150 : int *m,
19151 : int *n,
19152 : float *a,
19153 : int *lda,
19154 : float *work)
19155 : {
19156 0 : const char ch=std::toupper(*norm);
19157 : float dtemp,sum,max,val,scale;
19158 : int i,j;
19159 :
19160 0 : switch(ch) {
19161 : case 'M':
19162 : max = 0.0;
19163 0 : for(j=0;j<*n;j++)
19164 0 : for(i=0;i<*m;i++) {
19165 0 : dtemp = std::abs(a[j*(*lda)+i]);
19166 0 : if(dtemp>max)
19167 : max = dtemp;
19168 : }
19169 : val = max;
19170 : break;
19171 :
19172 : case 'O':
19173 : case '1':
19174 : max = 0.0;
19175 0 : for(j=0;j<*n;j++) {
19176 0 : sum = 0.0;
19177 0 : for(i=0;i<*m;i++)
19178 0 : sum += std::abs(a[j*(*lda)+i]);
19179 0 : if(sum>max)
19180 : max = sum;
19181 : }
19182 : val = max;
19183 : break;
19184 :
19185 0 : case 'I':
19186 0 : for(i=0;i<*m;i++)
19187 0 : work[i] = 0.0;
19188 0 : for(j=0;j<*n;j++)
19189 0 : for(i=0;i<*m;i++)
19190 0 : work[i] += std::abs(a[j*(*lda)+i]);
19191 : max = 0;
19192 0 : for(i=0;i<*m;i++)
19193 0 : if(work[i]>max)
19194 : max=work[i];
19195 : val = max;
19196 : break;
19197 :
19198 0 : case 'F':
19199 : case 'E':
19200 0 : scale = 0.0;
19201 0 : sum = 1.0;
19202 0 : i = 1;
19203 0 : for(j=0;j<*n;j++)
19204 0 : PLUMED_BLAS_F77_FUNC(slassq,SLASSQ)(m,&(a[j*(*lda)+0]),&i,&scale,&sum);
19205 0 : val = scale* std::sqrt(sum);
19206 0 : break;
19207 :
19208 : default:
19209 : val = 0.0;
19210 : break;
19211 : }
19212 0 : return val;
19213 : }
19214 : }
19215 : }
19216 : #include <cctype>
19217 : #include <cmath>
19218 :
19219 : #include "lapack.h"
19220 :
19221 :
19222 : #include "blas/blas.h"
19223 : namespace PLMD{
19224 : namespace lapack{
19225 : using namespace blas;
19226 : float
19227 0 : PLUMED_BLAS_F77_FUNC(slanst,SLANST)(const char *norm,
19228 : int *n,
19229 : float *d,
19230 : float *e)
19231 : {
19232 0 : const char ch=std::toupper(*norm);
19233 : float dtemp,max,val,scale,sum;
19234 : int i,j;
19235 :
19236 :
19237 0 : if(*n<=0)
19238 : return 0.0;
19239 :
19240 0 : switch(ch) {
19241 0 : case 'M':
19242 0 : max = std::abs(d[*n-1]);
19243 0 : for(i=0;i<(*n-1);i++) {
19244 0 : dtemp = std::abs(d[i]);
19245 0 : if(dtemp>max)
19246 : max = dtemp;
19247 0 : dtemp = std::abs(e[i]);
19248 0 : if(dtemp>max)
19249 : max = dtemp;
19250 : }
19251 : val = max;
19252 : break;
19253 :
19254 0 : case 'O':
19255 : case '1':
19256 : case 'I':
19257 :
19258 0 : if(*n==1)
19259 0 : val = std::abs(d[0]);
19260 : else {
19261 0 : max = std::abs(d[0]) + std::abs(e[0]);
19262 0 : dtemp = std::abs(e[*n-2]) + std::abs(d[*n-1]);
19263 0 : if(dtemp>max)
19264 : max = dtemp;
19265 0 : for(i=1;i<(*n-1);i++) {
19266 0 : dtemp = std::abs(d[i]) + std::abs(e[i]) + std::abs(e[i-1]);
19267 0 : if(dtemp>max)
19268 : max = dtemp;
19269 : }
19270 : val = max;
19271 : }
19272 : break;
19273 :
19274 0 : case 'F':
19275 : case 'E':
19276 0 : scale = 0.0;
19277 0 : sum = 1.0;
19278 0 : i = *n-1;
19279 0 : j = 1;
19280 0 : if(*n>1) {
19281 0 : PLUMED_BLAS_F77_FUNC(slassq,SLASSQ)(&i,e,&j,&scale,&sum);
19282 0 : sum *= 2;
19283 : }
19284 0 : PLUMED_BLAS_F77_FUNC(slassq,SLASSQ)(n,d,&j,&scale,&sum);
19285 0 : val = scale * std::sqrt(sum);
19286 0 : break;
19287 :
19288 : default:
19289 : val = 0.0;
19290 : break;
19291 : }
19292 : return val;
19293 : }
19294 : }
19295 : }
19296 : #include <cmath>
19297 :
19298 :
19299 : #include "lapack.h"
19300 :
19301 : #include "blas/blas.h"
19302 : namespace PLMD{
19303 : namespace lapack{
19304 : using namespace blas;
19305 : float
19306 0 : PLUMED_BLAS_F77_FUNC(slansy,SLANSY)(const char *norm, const char *uplo, int *n, float *a, int
19307 : *lda, float *work)
19308 : {
19309 : /* System generated locals */
19310 : int a_dim1, a_offset, i__1, i__2;
19311 : float ret_val, d__1, d__2, d__3;
19312 0 : int c__1 = 1;
19313 :
19314 : /* Local variables */
19315 : int i__, j;
19316 : float sum, absa, scale;
19317 : float value =0.0;
19318 :
19319 0 : a_dim1 = *lda;
19320 0 : a_offset = 1 + a_dim1;
19321 0 : a -= a_offset;
19322 0 : --work;
19323 :
19324 0 : if (*n == 0) {
19325 : value = 0.;
19326 0 : } else if (*norm=='M' || *norm=='m') {
19327 :
19328 : value = 0.;
19329 0 : if (*uplo=='U' || *uplo=='u') {
19330 0 : i__1 = *n;
19331 0 : for (j = 1; j <= i__1; ++j) {
19332 : i__2 = j;
19333 0 : for (i__ = 1; i__ <= i__2; ++i__) {
19334 : d__2 = value;
19335 0 : d__3 = std::abs(a[i__ + j * a_dim1]);
19336 0 : value = (d__2>d__3) ? d__2 : d__3;
19337 : }
19338 : }
19339 : } else {
19340 0 : i__1 = *n;
19341 0 : for (j = 1; j <= i__1; ++j) {
19342 : i__2 = *n;
19343 0 : for (i__ = j; i__ <= i__2; ++i__) {
19344 : d__2 = value;
19345 0 : d__3 = std::abs(a[i__ + j * a_dim1]);
19346 0 : value = (d__2>d__3) ? d__2 : d__3;
19347 : }
19348 : }
19349 : }
19350 0 : } else if (*norm=='I' || *norm=='i' || *norm=='O' || *norm=='o' || *norm=='1') {
19351 :
19352 : value = 0.;
19353 0 : if (*uplo=='U' || *uplo=='u') {
19354 0 : i__1 = *n;
19355 0 : for (j = 1; j <= i__1; ++j) {
19356 0 : sum = 0.;
19357 0 : i__2 = j - 1;
19358 0 : for (i__ = 1; i__ <= i__2; ++i__) {
19359 0 : absa = std::abs(a[i__ + j * a_dim1]);
19360 0 : sum += absa;
19361 0 : work[i__] += absa;
19362 : }
19363 0 : work[j] = sum + std::abs(a[j + j * a_dim1]);
19364 : }
19365 0 : i__1 = *n;
19366 0 : for (i__ = 1; i__ <= i__1; ++i__) {
19367 0 : d__1 = value, d__2 = work[i__];
19368 0 : value = (d__1>d__2) ? d__1 : d__2;
19369 : }
19370 : } else {
19371 : i__1 = *n;
19372 0 : for (i__ = 1; i__ <= i__1; ++i__) {
19373 0 : work[i__] = 0.;
19374 : }
19375 0 : i__1 = *n;
19376 0 : for (j = 1; j <= i__1; ++j) {
19377 0 : sum = work[j] + std::abs(a[j + j * a_dim1]);
19378 0 : i__2 = *n;
19379 0 : for (i__ = j + 1; i__ <= i__2; ++i__) {
19380 0 : absa = std::abs(a[i__ + j * a_dim1]);
19381 0 : sum += absa;
19382 0 : work[i__] += absa;
19383 : }
19384 0 : if(sum>value)
19385 : value = sum;
19386 : }
19387 : }
19388 : } else if (*norm=='F' || *norm=='f' || *norm=='E' || *norm=='e') {
19389 :
19390 0 : scale = 0.;
19391 0 : sum = 1.;
19392 0 : if (*uplo=='U' || *uplo=='u') {
19393 0 : i__1 = *n;
19394 0 : for (j = 2; j <= i__1; ++j) {
19395 0 : i__2 = j - 1;
19396 0 : PLUMED_BLAS_F77_FUNC(slassq,SLASSQ)(&i__2, &a[j * a_dim1 + 1], &c__1, &scale, &sum);
19397 : }
19398 : } else {
19399 0 : i__1 = *n - 1;
19400 0 : for (j = 1; j <= i__1; ++j) {
19401 0 : i__2 = *n - j;
19402 0 : PLUMED_BLAS_F77_FUNC(slassq,SLASSQ)(&i__2, &a[j + 1 + j * a_dim1], &c__1, &scale, &sum);
19403 : }
19404 : }
19405 0 : sum *= 2;
19406 0 : i__1 = *lda + 1;
19407 0 : PLUMED_BLAS_F77_FUNC(slassq,SLASSQ)(n, &a[a_offset], &i__1, &scale, &sum);
19408 0 : value = scale * std::sqrt(sum);
19409 : }
19410 :
19411 : ret_val = value;
19412 0 : return ret_val;
19413 : }
19414 :
19415 :
19416 : }
19417 : }
19418 : #include <cmath>
19419 : #include "lapack.h"
19420 :
19421 : #include "real.h"
19422 :
19423 : #include "blas/blas.h"
19424 : namespace PLMD{
19425 : namespace lapack{
19426 : using namespace blas;
19427 : float
19428 1 : PLUMED_BLAS_F77_FUNC(slapy2,SLAPY2)(float * x, float * y)
19429 : {
19430 : float xabs,yabs;
19431 : float w,z;
19432 :
19433 1 : xabs = std::abs(*x);
19434 1 : yabs = std::abs(*y);
19435 :
19436 1 : if(xabs>yabs) {
19437 : w = xabs;
19438 : z = yabs;
19439 : } else {
19440 : w = yabs;
19441 : z = xabs;
19442 : }
19443 :
19444 1 : if( std::abs(z)<PLUMED_GMX_FLOAT_MIN)
19445 : return w;
19446 : else {
19447 1 : z = z/w;
19448 1 : return w* std::sqrt(1.0+z*z);
19449 : }
19450 : }
19451 :
19452 : }
19453 : }
19454 : #include <cmath>
19455 :
19456 : #include "real.h"
19457 :
19458 : #include "lapack.h"
19459 : #include "lapack_limits.h"
19460 : #include "blas/blas.h"
19461 : namespace PLMD{
19462 : namespace lapack{
19463 : using namespace blas;
19464 :
19465 0 : void PLUMED_BLAS_F77_FUNC(slar1vx,SLAR1VX)(int *n,
19466 : int *b1,
19467 : int *bn,
19468 : float *sigma,
19469 : float *d__,
19470 : float *l,
19471 : float *ld,
19472 : float *lld,
19473 : float *eval,
19474 : float *gersch,
19475 : float *z__,
19476 : float *ztz,
19477 : float *mingma,
19478 : int *r__,
19479 : int *isuppz,
19480 : float *work)
19481 : {
19482 : int i__1;
19483 :
19484 : int i__, j;
19485 : float s;
19486 : int r1, r2;
19487 : int to;
19488 : float eps, tmp;
19489 : int indp, inds, from;
19490 : float dplus;
19491 : int sawnan;
19492 : int indumn;
19493 : float dminus;
19494 :
19495 0 : --work;
19496 : --isuppz;
19497 0 : --z__;
19498 0 : --gersch;
19499 0 : --lld;
19500 0 : --ld;
19501 0 : --l;
19502 0 : --d__;
19503 :
19504 : /* Function Body */
19505 : eps = PLUMED_GMX_FLOAT_EPS;
19506 0 : if (*r__ == 0) {
19507 :
19508 0 : r1 = *b1;
19509 0 : r2 = *bn;
19510 : i__1 = *bn;
19511 0 : for (i__ = *b1; i__ <= i__1; ++i__) {
19512 0 : if (*eval >= gersch[(i__ << 1) - 1] && *eval <= gersch[i__ * 2]) {
19513 : r1 = i__;
19514 0 : goto L20;
19515 : }
19516 : }
19517 0 : goto L40;
19518 : L20:
19519 : i__1 = *b1;
19520 0 : for (i__ = *bn; i__ >= i__1; --i__) {
19521 0 : if (*eval >= gersch[(i__ << 1) - 1] && *eval <= gersch[i__ * 2]) {
19522 : r2 = i__;
19523 0 : goto L40;
19524 : }
19525 : }
19526 : } else {
19527 : r1 = *r__;
19528 : r2 = *r__;
19529 : }
19530 :
19531 0 : L40:
19532 0 : indumn = *n;
19533 0 : inds = (*n << 1) + 1;
19534 0 : indp = *n * 3 + 1;
19535 : sawnan = 0;
19536 :
19537 0 : if (*b1 == 1) {
19538 0 : work[inds] = 0.;
19539 : } else {
19540 0 : work[inds] = lld[*b1 - 1];
19541 : }
19542 0 : s = work[inds] - *sigma;
19543 : i__1 = r2 - 1;
19544 0 : for (i__ = *b1; i__ <= i__1; ++i__) {
19545 0 : dplus = d__[i__] + s;
19546 0 : work[i__] = ld[i__] / dplus;
19547 0 : work[inds + i__] = s * work[i__] * l[i__];
19548 0 : s = work[inds + i__] - *sigma;
19549 : }
19550 :
19551 0 : if (std::isnan(s)) {
19552 :
19553 : sawnan = 1;
19554 0 : j = *b1 + 1;
19555 0 : L60:
19556 0 : if (!std::isnan(work[inds + j])) {
19557 0 : ++j;
19558 0 : goto L60;
19559 : }
19560 0 : work[inds + j] = lld[j];
19561 0 : s = work[inds + j] - *sigma;
19562 : i__1 = r2 - 1;
19563 0 : for (i__ = j + 1; i__ <= i__1; ++i__) {
19564 0 : dplus = d__[i__] + s;
19565 0 : work[i__] = ld[i__] / dplus;
19566 0 : if (std::abs(work[i__])<PLUMED_GMX_FLOAT_MIN) {
19567 0 : work[inds + i__] = lld[i__];
19568 : } else {
19569 0 : work[inds + i__] = s * work[i__] * l[i__];
19570 : }
19571 0 : s = work[inds + i__] - *sigma;
19572 : }
19573 : }
19574 :
19575 0 : work[indp + *bn - 1] = d__[*bn] - *sigma;
19576 : i__1 = r1;
19577 0 : for (i__ = *bn - 1; i__ >= i__1; --i__) {
19578 0 : dminus = lld[i__] + work[indp + i__];
19579 0 : tmp = d__[i__] / dminus;
19580 0 : work[indumn + i__] = l[i__] * tmp;
19581 0 : work[indp + i__ - 1] = work[indp + i__] * tmp - *sigma;
19582 : }
19583 0 : tmp = work[indp + r1 - 1];
19584 0 : if (std::isnan(tmp)) {
19585 :
19586 : sawnan = 1;
19587 0 : j = *bn - 3;
19588 0 : L90:
19589 0 : if (!std::isnan(work[indp + j])) {
19590 0 : --j;
19591 0 : goto L90;
19592 : }
19593 0 : work[indp + j] = d__[j + 1] - *sigma;
19594 : i__1 = r1;
19595 0 : for (i__ = j; i__ >= i__1; --i__) {
19596 0 : dminus = lld[i__] + work[indp + i__];
19597 0 : tmp = d__[i__] / dminus;
19598 0 : work[indumn + i__] = l[i__] * tmp;
19599 0 : if (std::abs(tmp)<PLUMED_GMX_FLOAT_MIN) {
19600 0 : work[indp + i__ - 1] = d__[i__] - *sigma;
19601 : } else {
19602 0 : work[indp + i__ - 1] = work[indp + i__] * tmp - *sigma;
19603 : }
19604 : }
19605 : }
19606 :
19607 0 : *mingma = work[inds + r1 - 1] + work[indp + r1 - 1];
19608 0 : if (std::abs(*mingma)<PLUMED_GMX_FLOAT_MIN) {
19609 0 : *mingma = eps * work[inds + r1 - 1];
19610 : }
19611 0 : *r__ = r1;
19612 : i__1 = r2 - 1;
19613 0 : for (i__ = r1; i__ <= i__1; ++i__) {
19614 0 : tmp = work[inds + i__] + work[indp + i__];
19615 0 : if (std::abs(tmp)<PLUMED_GMX_FLOAT_MIN) {
19616 0 : tmp = eps * work[inds + i__];
19617 : }
19618 0 : if (std::abs(tmp) < std::abs(*mingma)) {
19619 0 : *mingma = tmp;
19620 0 : *r__ = i__ + 1;
19621 : }
19622 : }
19623 :
19624 0 : isuppz[1] = *b1;
19625 0 : isuppz[2] = *bn;
19626 0 : z__[*r__] = 1.;
19627 0 : *ztz = 1.;
19628 0 : if (! sawnan) {
19629 0 : from = *r__ - 1;
19630 0 : i__1 = *r__ - 32;
19631 0 : to = (i__1>(*b1)) ? i__1 : (*b1);
19632 : L120:
19633 0 : if (from >= *b1) {
19634 : i__1 = to;
19635 0 : for (i__ = from; i__ >= i__1; --i__) {
19636 0 : z__[i__] = -(work[i__] * z__[i__ + 1]);
19637 0 : *ztz += z__[i__] * z__[i__];
19638 : }
19639 0 : if (std::abs(z__[to]) <= eps && std::abs(z__[to + 1]) <= eps) {
19640 0 : isuppz[1] = to + 2;
19641 : } else {
19642 0 : from = to - 1;
19643 0 : i__1 = to - 32;
19644 0 : to = (i__1>*b1) ? i__1 : *b1;
19645 0 : goto L120;
19646 : }
19647 : }
19648 0 : from = *r__ + 1;
19649 0 : i__1 = *r__ + 32;
19650 0 : to = (i__1<*bn) ? i__1 : *bn;
19651 : L140:
19652 0 : if (from <= *bn) {
19653 : i__1 = to;
19654 0 : for (i__ = from; i__ <= i__1; ++i__) {
19655 0 : z__[i__] = -(work[indumn + i__ - 1] * z__[i__ - 1]);
19656 0 : *ztz += z__[i__] * z__[i__];
19657 : }
19658 0 : if (std::abs(z__[to]) <= eps && std::abs(z__[to - 1]) <= eps) {
19659 0 : isuppz[2] = to - 2;
19660 : } else {
19661 0 : from = to + 1;
19662 0 : i__1 = to + 32;
19663 0 : to = (i__1<*bn) ? i__1 : *bn;
19664 0 : goto L140;
19665 : }
19666 : }
19667 : } else {
19668 0 : i__1 = *b1;
19669 0 : for (i__ = *r__ - 1; i__ >= i__1; --i__) {
19670 0 : if (std::abs(z__[i__ + 1])<PLUMED_GMX_FLOAT_MIN) {
19671 0 : z__[i__] = -(ld[i__ + 1] / ld[i__]) * z__[i__ + 2];
19672 : } else {
19673 0 : z__[i__] = -(work[i__] * z__[i__ + 1]);
19674 : }
19675 0 : if (std::abs(z__[i__]) <= eps && std::abs(z__[i__ + 1]) <= eps) {
19676 0 : isuppz[1] = i__ + 2;
19677 0 : goto L170;
19678 : }
19679 0 : *ztz += z__[i__] * z__[i__];
19680 : }
19681 0 : L170:
19682 0 : i__1 = *bn - 1;
19683 0 : for (i__ = *r__; i__ <= i__1; ++i__) {
19684 0 : if (std::abs(z__[i__])<PLUMED_GMX_FLOAT_MIN) {
19685 0 : z__[i__ + 1] = -(ld[i__ - 1] / ld[i__]) * z__[i__ - 1];
19686 : } else {
19687 0 : z__[i__ + 1] = -(work[indumn + i__] * z__[i__]);
19688 : }
19689 0 : if (std::abs(z__[i__]) <= eps && std::abs(z__[i__ + 1]) <= eps) {
19690 0 : isuppz[2] = i__ - 1;
19691 0 : break;
19692 : }
19693 0 : *ztz += z__[i__ + 1] * z__[i__ + 1];
19694 : }
19695 : }
19696 :
19697 0 : return;
19698 :
19699 : }
19700 :
19701 :
19702 : }
19703 : }
19704 : #include <cctype>
19705 : #include <cmath>
19706 :
19707 : #include "blas/blas.h"
19708 : #include "lapack.h"
19709 :
19710 : #include "real.h"
19711 :
19712 : #include "blas/blas.h"
19713 : namespace PLMD{
19714 : namespace lapack{
19715 : using namespace blas;
19716 : void
19717 0 : PLUMED_BLAS_F77_FUNC(slarf,SLARF)(const char *side,
19718 : int *m,
19719 : int *n,
19720 : float *v,
19721 : int *incv,
19722 : float *tau,
19723 : float *c,
19724 : int *ldc,
19725 : float *work)
19726 : {
19727 0 : const char ch=std::toupper(*side);
19728 0 : float one = 1.0;
19729 0 : float zero = 0.0;
19730 0 : float minustau = -(*tau);
19731 0 : int i1 = 1;
19732 :
19733 :
19734 0 : if(ch=='L') {
19735 0 : if(std::abs(*tau)>PLUMED_GMX_FLOAT_MIN) {
19736 0 : PLUMED_BLAS_F77_FUNC(sgemv,SGEMV)("T",m,n,&one,c,ldc,v,incv,&zero,work,&i1);
19737 0 : PLUMED_BLAS_F77_FUNC(sger,SGER)(m,n,&minustau,v,incv,work,&i1,c,ldc);
19738 : }
19739 : } else {
19740 0 : if(std::abs(*tau)>PLUMED_GMX_FLOAT_MIN) {
19741 0 : PLUMED_BLAS_F77_FUNC(sgemv,SGEMV)("N",m,n,&one,c,ldc,v,incv,&zero,work,&i1);
19742 0 : PLUMED_BLAS_F77_FUNC(sger,SGER)(m,n,&minustau,work,&i1,v,incv,c,ldc);
19743 : }
19744 : }
19745 0 : return;
19746 : }
19747 : }
19748 : }
19749 : #include "blas/blas.h"
19750 : #include "lapack.h"
19751 :
19752 :
19753 : #include "blas/blas.h"
19754 : namespace PLMD{
19755 : namespace lapack{
19756 : using namespace blas;
19757 : void
19758 0 : PLUMED_BLAS_F77_FUNC(slarfb,SLARFB)(const char *side,
19759 : const char *trans,
19760 : const char *direct,
19761 : const char *storev,
19762 : int *m,
19763 : int *n,
19764 : int *k,
19765 : float *v,
19766 : int *ldv,
19767 : float *t,
19768 : int *ldt,
19769 : float *c__,
19770 : int *ldc,
19771 : float *work,
19772 : int *ldwork)
19773 : {
19774 : int c_dim1, c_offset, t_dim1, t_offset, v_dim1, v_offset, work_dim1,
19775 : work_offset, i__1, i__2;
19776 :
19777 : int i__, j;
19778 : char transt[1];
19779 0 : int c__1 = 1;
19780 0 : float one = 1.0;
19781 0 : float minusone = -1.0;
19782 :
19783 0 : v_dim1 = *ldv;
19784 0 : v_offset = 1 + v_dim1;
19785 0 : v -= v_offset;
19786 : t_dim1 = *ldt;
19787 : t_offset = 1 + t_dim1;
19788 : t -= t_offset;
19789 0 : c_dim1 = *ldc;
19790 0 : c_offset = 1 + c_dim1;
19791 0 : c__ -= c_offset;
19792 0 : work_dim1 = *ldwork;
19793 0 : work_offset = 1 + work_dim1;
19794 0 : work -= work_offset;
19795 :
19796 0 : if (*m <= 0 || *n <= 0) {
19797 : return;
19798 : }
19799 0 : if (*trans=='N' || *trans=='n') {
19800 0 : *(unsigned char *)transt = 'T';
19801 : } else {
19802 0 : *(unsigned char *)transt = 'N';
19803 : }
19804 :
19805 0 : if (*storev=='C' || *storev=='c') {
19806 :
19807 0 : if (*direct=='F' || *direct=='f') {
19808 0 : if (*side=='l' || *side=='L') {
19809 :
19810 0 : i__1 = *k;
19811 0 : for (j = 1; j <= i__1; ++j) {
19812 0 : PLUMED_BLAS_F77_FUNC(scopy,SCOPY)(n, &c__[j + c_dim1], ldc, &work[j * work_dim1 + 1],
19813 : &c__1);
19814 : }
19815 :
19816 0 : PLUMED_BLAS_F77_FUNC(strmm,STRMM)("Right", "Lower", "No transpose", "Unit", n, k, &one,
19817 : &v[v_offset], ldv, &work[work_offset], ldwork);
19818 0 : if (*m > *k) {
19819 :
19820 0 : i__1 = *m - *k;
19821 0 : PLUMED_BLAS_F77_FUNC(sgemm,SGEMM)("Transpose", "No transpose", n, k, &i__1, &one, &
19822 0 : c__[*k + 1 + c_dim1], ldc, &v[*k + 1 + v_dim1],
19823 : ldv, &one, &work[work_offset], ldwork);
19824 : }
19825 :
19826 0 : PLUMED_BLAS_F77_FUNC(strmm,STRMM)("Right", "Upper", transt, "Non-unit", n, k, &one, &t[
19827 : t_offset], ldt, &work[work_offset], ldwork);
19828 :
19829 0 : if (*m > *k) {
19830 0 : i__1 = *m - *k;
19831 0 : PLUMED_BLAS_F77_FUNC(sgemm,SGEMM)("No transpose", "Transpose", &i__1, n, k, &minusone, &
19832 0 : v[*k + 1 + v_dim1], ldv, &work[work_offset],
19833 0 : ldwork, &one, &c__[*k + 1 + c_dim1], ldc);
19834 : }
19835 :
19836 0 : PLUMED_BLAS_F77_FUNC(strmm,STRMM)("Right", "Lower", "Transpose", "Unit", n, k, &one, &
19837 : v[v_offset], ldv, &work[work_offset], ldwork);
19838 :
19839 0 : i__1 = *k;
19840 0 : for (j = 1; j <= i__1; ++j) {
19841 0 : i__2 = *n;
19842 0 : for (i__ = 1; i__ <= i__2; ++i__) {
19843 0 : c__[j + i__ * c_dim1] -= work[i__ + j * work_dim1];
19844 : }
19845 : }
19846 :
19847 0 : } else if (*side=='r' || *side=='R') {
19848 :
19849 0 : i__1 = *k;
19850 0 : for (j = 1; j <= i__1; ++j) {
19851 0 : PLUMED_BLAS_F77_FUNC(scopy,SCOPY)(m, &c__[j * c_dim1 + 1], &c__1, &work[j *
19852 0 : work_dim1 + 1], &c__1);
19853 : }
19854 :
19855 0 : PLUMED_BLAS_F77_FUNC(strmm,STRMM)("Right", "Lower", "No transpose", "Unit", m, k, &one,
19856 : &v[v_offset], ldv, &work[work_offset], ldwork);
19857 0 : if (*n > *k) {
19858 :
19859 0 : i__1 = *n - *k;
19860 0 : PLUMED_BLAS_F77_FUNC(sgemm,SGEMM)("No transpose", "No transpose", m, k, &i__1, &
19861 0 : one, &c__[(*k + 1) * c_dim1 + 1], ldc, &v[*k +
19862 0 : 1 + v_dim1], ldv, &one, &work[work_offset],
19863 : ldwork);
19864 : }
19865 :
19866 0 : PLUMED_BLAS_F77_FUNC(strmm,STRMM)("Right", "Upper", trans, "Non-unit", m, k, &one, &t[
19867 : t_offset], ldt, &work[work_offset], ldwork);
19868 :
19869 0 : if (*n > *k) {
19870 0 : i__1 = *n - *k;
19871 0 : PLUMED_BLAS_F77_FUNC(sgemm,SGEMM)("No transpose", "Transpose", m, &i__1, k, &minusone, &
19872 0 : work[work_offset], ldwork, &v[*k + 1 + v_dim1],
19873 0 : ldv, &one, &c__[(*k + 1) * c_dim1 + 1], ldc);
19874 : }
19875 :
19876 0 : PLUMED_BLAS_F77_FUNC(strmm,STRMM)("Right", "Lower", "Transpose", "Unit", m, k, &one, &
19877 : v[v_offset], ldv, &work[work_offset], ldwork);
19878 :
19879 0 : i__1 = *k;
19880 0 : for (j = 1; j <= i__1; ++j) {
19881 0 : i__2 = *m;
19882 0 : for (i__ = 1; i__ <= i__2; ++i__) {
19883 0 : c__[i__ + j * c_dim1] -= work[i__ + j * work_dim1];
19884 : }
19885 : }
19886 : }
19887 :
19888 : } else {
19889 :
19890 0 : if (*side=='l' || *side=='L') {
19891 0 : i__1 = *k;
19892 0 : for (j = 1; j <= i__1; ++j) {
19893 0 : PLUMED_BLAS_F77_FUNC(scopy,SCOPY)(n, &c__[*m - *k + j + c_dim1], ldc, &work[j *
19894 0 : work_dim1 + 1], &c__1);
19895 : }
19896 :
19897 0 : PLUMED_BLAS_F77_FUNC(strmm,STRMM)("Right", "Upper", "No transpose", "Unit", n, k, &one,
19898 0 : &v[*m - *k + 1 + v_dim1], ldv, &work[work_offset],
19899 : ldwork);
19900 0 : if (*m > *k) {
19901 0 : i__1 = *m - *k;
19902 0 : PLUMED_BLAS_F77_FUNC(sgemm,SGEMM)("Transpose", "No transpose", n, k, &i__1, &one, &
19903 : c__[c_offset], ldc, &v[v_offset], ldv, &one, &
19904 : work[work_offset], ldwork);
19905 : }
19906 :
19907 0 : PLUMED_BLAS_F77_FUNC(strmm,STRMM)("Right", "Lower", transt, "Non-unit", n, k, &one, &t[
19908 : t_offset], ldt, &work[work_offset], ldwork);
19909 :
19910 0 : if (*m > *k) {
19911 :
19912 0 : i__1 = *m - *k;
19913 0 : PLUMED_BLAS_F77_FUNC(sgemm,SGEMM)("No transpose", "Transpose", &i__1, n, k, &minusone, &
19914 : v[v_offset], ldv, &work[work_offset], ldwork, &
19915 : one, &c__[c_offset], ldc)
19916 : ;
19917 : }
19918 :
19919 0 : PLUMED_BLAS_F77_FUNC(strmm,STRMM)("Right", "Upper", "Transpose", "Unit", n, k, &one, &
19920 0 : v[*m - *k + 1 + v_dim1], ldv, &work[work_offset],
19921 : ldwork);
19922 :
19923 0 : i__1 = *k;
19924 0 : for (j = 1; j <= i__1; ++j) {
19925 0 : i__2 = *n;
19926 0 : for (i__ = 1; i__ <= i__2; ++i__) {
19927 0 : c__[*m - *k + j + i__ * c_dim1] -= work[i__ + j *
19928 0 : work_dim1];
19929 : }
19930 : }
19931 :
19932 0 : } else if (*side=='r' || *side=='R') {
19933 0 : i__1 = *k;
19934 0 : for (j = 1; j <= i__1; ++j) {
19935 0 : PLUMED_BLAS_F77_FUNC(scopy,SCOPY)(m, &c__[(*n - *k + j) * c_dim1 + 1], &c__1, &work[
19936 0 : j * work_dim1 + 1], &c__1);
19937 : }
19938 :
19939 0 : PLUMED_BLAS_F77_FUNC(strmm,STRMM)("Right", "Upper", "No transpose", "Unit", m, k, &one,
19940 0 : &v[*n - *k + 1 + v_dim1], ldv, &work[work_offset],
19941 : ldwork);
19942 0 : if (*n > *k) {
19943 0 : i__1 = *n - *k;
19944 0 : PLUMED_BLAS_F77_FUNC(sgemm,SGEMM)("No transpose", "No transpose", m, k, &i__1, &
19945 : one, &c__[c_offset], ldc, &v[v_offset], ldv, &
19946 : one, &work[work_offset], ldwork);
19947 : }
19948 0 : PLUMED_BLAS_F77_FUNC(strmm,STRMM)("Right", "Lower", trans, "Non-unit", m, k, &one, &t[
19949 : t_offset], ldt, &work[work_offset], ldwork);
19950 0 : if (*n > *k) {
19951 0 : i__1 = *n - *k;
19952 0 : PLUMED_BLAS_F77_FUNC(sgemm,SGEMM)("No transpose", "Transpose", m, &i__1, k, &minusone, &
19953 : work[work_offset], ldwork, &v[v_offset], ldv, &
19954 : one, &c__[c_offset], ldc)
19955 : ;
19956 : }
19957 0 : PLUMED_BLAS_F77_FUNC(strmm,STRMM)("Right", "Upper", "Transpose", "Unit", m, k, &one, &
19958 0 : v[*n - *k + 1 + v_dim1], ldv, &work[work_offset],
19959 : ldwork);
19960 0 : i__1 = *k;
19961 0 : for (j = 1; j <= i__1; ++j) {
19962 0 : i__2 = *m;
19963 0 : for (i__ = 1; i__ <= i__2; ++i__) {
19964 0 : c__[i__ + (*n - *k + j) * c_dim1] -= work[i__ + j *
19965 0 : work_dim1];
19966 : }
19967 : }
19968 : }
19969 : }
19970 :
19971 0 : } else if (*storev=='r' || *storev=='R') {
19972 0 : if (*direct=='F' || *direct=='f') {
19973 0 : if (*side=='l' || *side=='L') {
19974 0 : i__1 = *k;
19975 0 : for (j = 1; j <= i__1; ++j) {
19976 0 : PLUMED_BLAS_F77_FUNC(scopy,SCOPY)(n, &c__[j + c_dim1], ldc, &work[j * work_dim1 + 1],
19977 : &c__1);
19978 : }
19979 0 : PLUMED_BLAS_F77_FUNC(strmm,STRMM)("Right", "Upper", "Transpose", "Unit", n, k, &one, &
19980 : v[v_offset], ldv, &work[work_offset], ldwork);
19981 0 : if (*m > *k) {
19982 0 : i__1 = *m - *k;
19983 0 : PLUMED_BLAS_F77_FUNC(sgemm,SGEMM)("Transpose", "Transpose", n, k, &i__1, &one, &
19984 0 : c__[*k + 1 + c_dim1], ldc, &v[(*k + 1) * v_dim1 +
19985 0 : 1], ldv, &one, &work[work_offset], ldwork);
19986 : }
19987 :
19988 0 : PLUMED_BLAS_F77_FUNC(strmm,STRMM)("Right", "Upper", transt, "Non-unit", n, k, &one, &t[
19989 : t_offset], ldt, &work[work_offset], ldwork);
19990 0 : if (*m > *k) {
19991 :
19992 0 : i__1 = *m - *k;
19993 0 : PLUMED_BLAS_F77_FUNC(sgemm,SGEMM)("Transpose", "Transpose", &i__1, n, k, &minusone, &v[(
19994 0 : *k + 1) * v_dim1 + 1], ldv, &work[work_offset],
19995 0 : ldwork, &one, &c__[*k + 1 + c_dim1], ldc);
19996 : }
19997 :
19998 0 : PLUMED_BLAS_F77_FUNC(strmm,STRMM)("Right", "Upper", "No transpose", "Unit", n, k, &one,
19999 : &v[v_offset], ldv, &work[work_offset], ldwork);
20000 :
20001 0 : i__1 = *k;
20002 0 : for (j = 1; j <= i__1; ++j) {
20003 0 : i__2 = *n;
20004 0 : for (i__ = 1; i__ <= i__2; ++i__) {
20005 0 : c__[j + i__ * c_dim1] -= work[i__ + j * work_dim1];
20006 : }
20007 : }
20008 :
20009 0 : } else if (*side=='r' || *side=='R') {
20010 :
20011 0 : i__1 = *k;
20012 0 : for (j = 1; j <= i__1; ++j) {
20013 0 : PLUMED_BLAS_F77_FUNC(scopy,SCOPY)(m, &c__[j * c_dim1 + 1], &c__1, &work[j *
20014 0 : work_dim1 + 1], &c__1);
20015 : }
20016 :
20017 0 : PLUMED_BLAS_F77_FUNC(strmm,STRMM)("Right", "Upper", "Transpose", "Unit", m, k, &one, &
20018 : v[v_offset], ldv, &work[work_offset], ldwork);
20019 0 : if (*n > *k) {
20020 :
20021 0 : i__1 = *n - *k;
20022 0 : PLUMED_BLAS_F77_FUNC(sgemm,SGEMM)("No transpose", "Transpose", m, k, &i__1, &one, &
20023 0 : c__[(*k + 1) * c_dim1 + 1], ldc, &v[(*k + 1) *
20024 0 : v_dim1 + 1], ldv, &one, &work[work_offset],
20025 : ldwork);
20026 : }
20027 :
20028 0 : PLUMED_BLAS_F77_FUNC(strmm,STRMM)("Right", "Upper", trans, "Non-unit", m, k, &one, &t[
20029 : t_offset], ldt, &work[work_offset], ldwork);
20030 :
20031 0 : if (*n > *k) {
20032 :
20033 0 : i__1 = *n - *k;
20034 0 : PLUMED_BLAS_F77_FUNC(sgemm,SGEMM)("No transpose", "No transpose", m, &i__1, k, &
20035 0 : minusone, &work[work_offset], ldwork, &v[(*k + 1) *
20036 0 : v_dim1 + 1], ldv, &one, &c__[(*k + 1) * c_dim1
20037 0 : + 1], ldc);
20038 : }
20039 0 : PLUMED_BLAS_F77_FUNC(strmm,STRMM)("Right", "Upper", "No transpose", "Unit", m, k, &one,
20040 : &v[v_offset], ldv, &work[work_offset], ldwork);
20041 0 : i__1 = *k;
20042 0 : for (j = 1; j <= i__1; ++j) {
20043 0 : i__2 = *m;
20044 0 : for (i__ = 1; i__ <= i__2; ++i__) {
20045 0 : c__[i__ + j * c_dim1] -= work[i__ + j * work_dim1];
20046 : }
20047 : }
20048 :
20049 : }
20050 :
20051 : } else {
20052 :
20053 0 : if (*side=='l' || *side=='L') {
20054 :
20055 0 : i__1 = *k;
20056 0 : for (j = 1; j <= i__1; ++j) {
20057 0 : PLUMED_BLAS_F77_FUNC(scopy,SCOPY)(n, &c__[*m - *k + j + c_dim1], ldc, &work[j *
20058 0 : work_dim1 + 1], &c__1);
20059 : }
20060 :
20061 0 : PLUMED_BLAS_F77_FUNC(strmm,STRMM)("Right", "Lower", "Transpose", "Unit", n, k, &one, &
20062 0 : v[(*m - *k + 1) * v_dim1 + 1], ldv, &work[work_offset]
20063 : , ldwork);
20064 0 : if (*m > *k) {
20065 :
20066 0 : i__1 = *m - *k;
20067 0 : PLUMED_BLAS_F77_FUNC(sgemm,SGEMM)("Transpose", "Transpose", n, k, &i__1, &one, &
20068 : c__[c_offset], ldc, &v[v_offset], ldv, &one, &
20069 : work[work_offset], ldwork);
20070 : }
20071 :
20072 0 : PLUMED_BLAS_F77_FUNC(strmm,STRMM)("Right", "Lower", transt, "Non-unit", n, k, &one, &t[
20073 : t_offset], ldt, &work[work_offset], ldwork);
20074 :
20075 0 : if (*m > *k) {
20076 :
20077 0 : i__1 = *m - *k;
20078 0 : PLUMED_BLAS_F77_FUNC(sgemm,SGEMM)("Transpose", "Transpose", &i__1, n, k, &minusone, &v[
20079 : v_offset], ldv, &work[work_offset], ldwork, &
20080 : one, &c__[c_offset], ldc);
20081 : }
20082 :
20083 0 : PLUMED_BLAS_F77_FUNC(strmm,STRMM)("Right", "Lower", "No transpose", "Unit", n, k, &one,
20084 0 : &v[(*m - *k + 1) * v_dim1 + 1], ldv, &work[
20085 : work_offset], ldwork);
20086 :
20087 0 : i__1 = *k;
20088 0 : for (j = 1; j <= i__1; ++j) {
20089 0 : i__2 = *n;
20090 0 : for (i__ = 1; i__ <= i__2; ++i__) {
20091 0 : c__[*m - *k + j + i__ * c_dim1] -= work[i__ + j *
20092 0 : work_dim1];
20093 : }
20094 : }
20095 :
20096 0 : } else if (*side=='r' || *side=='R') {
20097 :
20098 0 : i__1 = *k;
20099 0 : for (j = 1; j <= i__1; ++j) {
20100 0 : PLUMED_BLAS_F77_FUNC(scopy,SCOPY)(m, &c__[(*n - *k + j) * c_dim1 + 1], &c__1, &work[
20101 0 : j * work_dim1 + 1], &c__1);
20102 : }
20103 :
20104 0 : PLUMED_BLAS_F77_FUNC(strmm,STRMM)("Right", "Lower", "Transpose", "Unit", m, k, &one, &
20105 0 : v[(*n - *k + 1) * v_dim1 + 1], ldv, &work[work_offset]
20106 : , ldwork);
20107 0 : if (*n > *k) {
20108 :
20109 0 : i__1 = *n - *k;
20110 0 : PLUMED_BLAS_F77_FUNC(sgemm,SGEMM)("No transpose", "Transpose", m, k, &i__1, &one, &
20111 : c__[c_offset], ldc, &v[v_offset], ldv, &one, &
20112 : work[work_offset], ldwork);
20113 : }
20114 :
20115 0 : PLUMED_BLAS_F77_FUNC(strmm,STRMM)("Right", "Lower", trans, "Non-unit", m, k, &one, &t[
20116 : t_offset], ldt, &work[work_offset], ldwork);
20117 :
20118 0 : if (*n > *k) {
20119 :
20120 0 : i__1 = *n - *k;
20121 0 : PLUMED_BLAS_F77_FUNC(sgemm,SGEMM)("No transpose", "No transpose", m, &i__1, k, &
20122 : minusone, &work[work_offset], ldwork, &v[v_offset],
20123 : ldv, &one, &c__[c_offset], ldc);
20124 : }
20125 :
20126 0 : PLUMED_BLAS_F77_FUNC(strmm,STRMM)("Right", "Lower", "No transpose", "Unit", m, k, &one,
20127 0 : &v[(*n - *k + 1) * v_dim1 + 1], ldv, &work[
20128 : work_offset], ldwork);
20129 :
20130 0 : i__1 = *k;
20131 0 : for (j = 1; j <= i__1; ++j) {
20132 0 : i__2 = *m;
20133 0 : for (i__ = 1; i__ <= i__2; ++i__) {
20134 0 : c__[i__ + (*n - *k + j) * c_dim1] -= work[i__ + j *
20135 0 : work_dim1];
20136 : }
20137 : }
20138 :
20139 : }
20140 :
20141 : }
20142 : }
20143 :
20144 : return;
20145 :
20146 :
20147 : }
20148 :
20149 : }
20150 : }
20151 : #include <cmath>
20152 : #include "real.h"
20153 :
20154 : #include "blas/blas.h"
20155 : #include "lapack.h"
20156 : #include "lapack_limits.h"
20157 :
20158 :
20159 : #include "blas/blas.h"
20160 : namespace PLMD{
20161 : namespace lapack{
20162 : using namespace blas;
20163 : void
20164 0 : PLUMED_BLAS_F77_FUNC(slarfg,SLARFG)(int *n,
20165 : float *alpha,
20166 : float *x,
20167 : int *incx,
20168 : float *tau)
20169 : {
20170 : float xnorm,t;
20171 : int ti1,knt,j;
20172 : float minval,safmin,rsafmn,beta;
20173 :
20174 0 : if(*n<=1) {
20175 0 : *tau = 0;
20176 0 : return;
20177 : }
20178 :
20179 0 : ti1 = *n-1;
20180 :
20181 0 : xnorm = PLUMED_BLAS_F77_FUNC(snrm2,SNRM2)(&ti1,x,incx);
20182 :
20183 0 : if(std::abs(xnorm)<PLUMED_GMX_FLOAT_MIN) {
20184 0 : *tau = 0.0;
20185 : } else {
20186 :
20187 0 : t = PLUMED_BLAS_F77_FUNC(slapy2,SLAPY2)(alpha,&xnorm);
20188 :
20189 0 : if(*alpha<0)
20190 : beta = t;
20191 : else
20192 0 : beta = -t;
20193 :
20194 : minval = PLUMED_GMX_FLOAT_MIN;
20195 :
20196 : safmin = minval*(1.0+PLUMED_GMX_FLOAT_EPS) / PLUMED_GMX_FLOAT_EPS;
20197 :
20198 :
20199 0 : if(std::abs(beta)<safmin) {
20200 :
20201 : knt = 0;
20202 0 : rsafmn = 1.0 / safmin;
20203 :
20204 0 : while(std::abs(beta)<safmin) {
20205 0 : knt++;
20206 0 : ti1 = *n-1;
20207 0 : PLUMED_BLAS_F77_FUNC(sscal,SSCAL)(&ti1,&rsafmn,x,incx);
20208 0 : beta *= rsafmn;
20209 0 : *alpha *= rsafmn;
20210 : }
20211 :
20212 : /* safmin <= beta <= 1 now */
20213 0 : ti1 = *n-1;
20214 0 : xnorm = PLUMED_BLAS_F77_FUNC(snrm2,SNRM2)(&ti1,x,incx);
20215 0 : t = PLUMED_BLAS_F77_FUNC(slapy2,SLAPY2)(alpha,&xnorm);
20216 :
20217 0 : if(*alpha<0)
20218 : beta = t;
20219 : else
20220 0 : beta = -t;
20221 :
20222 0 : *tau = (beta-*alpha)/beta;
20223 :
20224 0 : ti1= *n-1;
20225 0 : t = 1.0/(*alpha-beta);
20226 0 : PLUMED_BLAS_F77_FUNC(sscal,SSCAL)(&ti1,&t,x,incx);
20227 :
20228 0 : *alpha = beta;
20229 0 : for(j=0;j<knt;j++)
20230 0 : *alpha *= safmin;
20231 : } else {
20232 0 : *tau = (beta-*alpha)/beta;
20233 0 : ti1= *n-1;
20234 0 : t = 1.0/(*alpha-beta);
20235 0 : PLUMED_BLAS_F77_FUNC(sscal,SSCAL)(&ti1,&t,x,incx);
20236 0 : *alpha = beta;
20237 : }
20238 : }
20239 :
20240 : return;
20241 : }
20242 : }
20243 : }
20244 : #include <cmath>
20245 : #include "real.h"
20246 :
20247 : #include "blas/blas.h"
20248 : #include "lapack.h"
20249 :
20250 : #include "blas/blas.h"
20251 : namespace PLMD{
20252 : namespace lapack{
20253 : using namespace blas;
20254 : void
20255 0 : PLUMED_BLAS_F77_FUNC(slarft,SLARFT)(const char *direct,
20256 : const char *storev,
20257 : int *n,
20258 : int *k,
20259 : float *v,
20260 : int *ldv,
20261 : float *tau,
20262 : float *t,
20263 : int *ldt)
20264 : {
20265 : /* System generated locals */
20266 : int t_dim1, t_offset, v_dim1, v_offset, i__1, i__2, i__3;
20267 : float d__1;
20268 :
20269 : /* Local variables */
20270 : int i__, j;
20271 : float vii;
20272 0 : int c__1 = 1;
20273 0 : float zero = 0.0;
20274 :
20275 0 : v_dim1 = *ldv;
20276 0 : v_offset = 1 + v_dim1;
20277 0 : v -= v_offset;
20278 0 : --tau;
20279 0 : t_dim1 = *ldt;
20280 0 : t_offset = 1 + t_dim1;
20281 0 : t -= t_offset;
20282 :
20283 0 : if (*n == 0) {
20284 : return;
20285 : }
20286 :
20287 0 : if (*direct=='F' || *direct=='f') {
20288 0 : i__1 = *k;
20289 0 : for (i__ = 1; i__ <= i__1; ++i__) {
20290 0 : if (std::abs(tau[i__])<PLUMED_GMX_FLOAT_MIN) {
20291 :
20292 0 : i__2 = i__;
20293 0 : for (j = 1; j <= i__2; ++j) {
20294 0 : t[j + i__ * t_dim1] = 0.;
20295 : }
20296 : } else {
20297 :
20298 0 : vii = v[i__ + i__ * v_dim1];
20299 0 : v[i__ + i__ * v_dim1] = 1.;
20300 0 : if (*storev=='C' || *storev=='c') {
20301 :
20302 0 : i__2 = *n - i__ + 1;
20303 0 : i__3 = i__ - 1;
20304 0 : d__1 = -tau[i__];
20305 0 : PLUMED_BLAS_F77_FUNC(sgemv,SGEMV)("Transpose", &i__2, &i__3, &d__1, &v[i__ + v_dim1],
20306 : ldv, &v[i__ + i__ * v_dim1], &c__1, &zero, &t[
20307 0 : i__ * t_dim1 + 1], &c__1);
20308 : } else {
20309 :
20310 0 : i__2 = i__ - 1;
20311 0 : i__3 = *n - i__ + 1;
20312 0 : d__1 = -tau[i__];
20313 0 : PLUMED_BLAS_F77_FUNC(sgemv,SGEMV)("No transpose", &i__2, &i__3, &d__1, &v[i__ *
20314 0 : v_dim1 + 1], ldv, &v[i__ + i__ * v_dim1], ldv, &
20315 0 : zero, &t[i__ * t_dim1 + 1], &c__1);
20316 : }
20317 0 : v[i__ + i__ * v_dim1] = vii;
20318 :
20319 :
20320 0 : i__2 = i__ - 1;
20321 0 : PLUMED_BLAS_F77_FUNC(strmv,STRMV)("Upper", "No transpose", "Non-unit", &i__2, &t[
20322 0 : t_offset], ldt, &t[i__ * t_dim1 + 1], &c__1);
20323 0 : t[i__ + i__ * t_dim1] = tau[i__];
20324 : }
20325 : }
20326 : } else {
20327 0 : for (i__ = *k; i__ >= 1; --i__) {
20328 0 : if (std::abs(tau[i__])<PLUMED_GMX_FLOAT_MIN) {
20329 :
20330 0 : i__1 = *k;
20331 0 : for (j = i__; j <= i__1; ++j) {
20332 0 : t[j + i__ * t_dim1] = 0.;
20333 : }
20334 : } else {
20335 :
20336 0 : if (i__ < *k) {
20337 0 : if (*storev=='C' || *storev=='c') {
20338 0 : vii = v[*n - *k + i__ + i__ * v_dim1];
20339 0 : v[*n - *k + i__ + i__ * v_dim1] = 1.;
20340 :
20341 0 : i__1 = *n - *k + i__;
20342 0 : i__2 = *k - i__;
20343 0 : d__1 = -tau[i__];
20344 0 : PLUMED_BLAS_F77_FUNC(sgemv,SGEMV)("Transpose", &i__1, &i__2, &d__1, &v[(i__ + 1)
20345 0 : * v_dim1 + 1], ldv, &v[i__ * v_dim1 + 1], &
20346 0 : c__1, &zero, &t[i__ + 1 + i__ * t_dim1], &
20347 : c__1);
20348 0 : v[*n - *k + i__ + i__ * v_dim1] = vii;
20349 : } else {
20350 0 : vii = v[i__ + (*n - *k + i__) * v_dim1];
20351 0 : v[i__ + (*n - *k + i__) * v_dim1] = 1.;
20352 :
20353 0 : i__1 = *k - i__;
20354 0 : i__2 = *n - *k + i__;
20355 0 : d__1 = -tau[i__];
20356 0 : PLUMED_BLAS_F77_FUNC(sgemv,SGEMV)("No transpose", &i__1, &i__2, &d__1, &v[i__ +
20357 0 : 1 + v_dim1], ldv, &v[i__ + v_dim1], ldv, &
20358 0 : zero, &t[i__ + 1 + i__ * t_dim1], &c__1);
20359 0 : v[i__ + (*n - *k + i__) * v_dim1] = vii;
20360 : }
20361 :
20362 0 : i__1 = *k - i__;
20363 0 : PLUMED_BLAS_F77_FUNC(strmv,STRMV)("Lower", "No transpose", "Non-unit", &i__1, &t[i__
20364 0 : + 1 + (i__ + 1) * t_dim1], ldt, &t[i__ + 1 + i__ *
20365 0 : t_dim1], &c__1)
20366 : ;
20367 : }
20368 0 : t[i__ + i__ * t_dim1] = tau[i__];
20369 : }
20370 : }
20371 : }
20372 : return;
20373 :
20374 :
20375 : }
20376 : }
20377 : }
20378 : #include <cmath>
20379 : #include "lapack.h"
20380 :
20381 : #include "blas/blas.h"
20382 : namespace PLMD{
20383 : namespace lapack{
20384 : using namespace blas;
20385 : void
20386 0 : PLUMED_BLAS_F77_FUNC(slarnv,SLARNV)(int *idist,
20387 : int *iseed,
20388 : int *n,
20389 : float *x)
20390 : {
20391 : int i__1, i__2, i__3;
20392 :
20393 : int i__;
20394 : float u[128];
20395 : int il, iv, il2;
20396 :
20397 0 : --x;
20398 : --iseed;
20399 :
20400 0 : i__1 = *n;
20401 0 : for (iv = 1; iv <= i__1; iv += 64) {
20402 0 : i__2 = 64, i__3 = *n - iv + 1;
20403 : il = (i__2<i__3) ? i__2 : i__3;
20404 0 : if (*idist == 3) {
20405 0 : il2 = il << 1;
20406 : } else {
20407 0 : il2 = il;
20408 : }
20409 :
20410 0 : PLUMED_BLAS_F77_FUNC(slaruv,SLARUV)(&iseed[1], &il2, u);
20411 :
20412 0 : if (*idist == 1) {
20413 :
20414 : i__2 = il;
20415 0 : for (i__ = 1; i__ <= i__2; ++i__) {
20416 0 : x[iv + i__ - 1] = u[i__ - 1];
20417 : }
20418 0 : } else if (*idist == 2) {
20419 :
20420 : i__2 = il;
20421 0 : for (i__ = 1; i__ <= i__2; ++i__) {
20422 0 : x[iv + i__ - 1] = u[i__ - 1] * 2. - 1.;
20423 : }
20424 0 : } else if (*idist == 3) {
20425 :
20426 : i__2 = il;
20427 0 : for (i__ = 1; i__ <= i__2; ++i__) {
20428 0 : x[iv + i__ - 1] = std::sqrt(std::log(u[(i__ << 1) - 2]) * -2.) *
20429 0 : std::cos(u[(i__ << 1) - 1] * (float)6.2831853071795864769252867663);
20430 : }
20431 : }
20432 : }
20433 0 : return;
20434 :
20435 : }
20436 : }
20437 : }
20438 : #include <cmath>
20439 :
20440 : #include "real.h"
20441 :
20442 : #include "lapack.h"
20443 : #include "lapack_limits.h"
20444 :
20445 : #include "blas/blas.h"
20446 : namespace PLMD{
20447 : namespace lapack{
20448 : using namespace blas;
20449 : void
20450 0 : PLUMED_BLAS_F77_FUNC(slarrbx,SLARRBX)(int *n,
20451 : float *d__,
20452 : float *l,
20453 : float *ld,
20454 : float *lld,
20455 : int *ifirst,
20456 : int *ilast,
20457 : float *rtol1,
20458 : float *rtol2,
20459 : int *offset,
20460 : float *w,
20461 : float *wgap,
20462 : float *werr,
20463 : float *work,
20464 : int *iwork,
20465 : int *info)
20466 : {
20467 : int i__1, i__2, i__3;
20468 : float d__1, d__2;
20469 :
20470 : int i__, j, k, p;
20471 : float s;
20472 : int i1, i2, ii, kk;
20473 : float fac, gap, mid;
20474 : int cnt;
20475 : float tmp, left;
20476 : int nint, prev, next, nleft;
20477 : float right, width, dplus;
20478 : int nright, olnint;
20479 : k = 0;
20480 : right = 0.0;
20481 :
20482 0 : --iwork;
20483 0 : --work;
20484 0 : --werr;
20485 0 : --wgap;
20486 0 : --w;
20487 0 : --lld;
20488 : --ld;
20489 : --l;
20490 0 : --d__;
20491 :
20492 0 : *info = 0;
20493 0 : i__1 = *n << 1;
20494 0 : for (i__ = 1; i__ <= i__1; ++i__) {
20495 0 : iwork[i__] = 0;
20496 : }
20497 0 : i1 = *ifirst;
20498 : i2 = *ifirst;
20499 : prev = 0;
20500 0 : i__1 = *ilast;
20501 0 : for (i__ = *ifirst; i__ <= i__1; ++i__) {
20502 0 : k = i__ << 1;
20503 0 : iwork[k - 1] = 1;
20504 : i2 = i__;
20505 : }
20506 :
20507 : i__ = i1;
20508 : nint = 0;
20509 0 : L30:
20510 0 : if (i__ <= i2) {
20511 0 : ii = i__ - *offset;
20512 0 : if (iwork[(i__ << 1) - 1] == 1) {
20513 : fac = 1.;
20514 0 : left = w[ii] - werr[ii];
20515 :
20516 :
20517 0 : L40:
20518 0 : if (i__ > i1 && left <= right) {
20519 : left = right;
20520 0 : cnt = i__ - 1;
20521 : } else {
20522 0 : s = -left;
20523 : cnt = 0;
20524 0 : i__1 = *n - 1;
20525 0 : for (j = 1; j <= i__1; ++j) {
20526 0 : dplus = d__[j] + s;
20527 0 : s = s * lld[j] / dplus - left;
20528 0 : if (dplus < 0.) {
20529 0 : ++cnt;
20530 : }
20531 : }
20532 0 : dplus = d__[*n] + s;
20533 0 : if (dplus < 0.) {
20534 0 : ++cnt;
20535 : }
20536 0 : if (std::isnan(s)) {
20537 :
20538 : cnt = 0;
20539 : s = -left;
20540 : i__1 = *n - 1;
20541 0 : for (j = 1; j <= i__1; ++j) {
20542 0 : dplus = d__[j] + s;
20543 0 : if (dplus < 0.) {
20544 0 : ++cnt;
20545 : }
20546 0 : tmp = lld[j] / dplus;
20547 0 : if (std::abs(tmp)<PLUMED_GMX_FLOAT_MIN) {
20548 0 : s = lld[j] - left;
20549 : } else {
20550 0 : s = s * tmp - left;
20551 : }
20552 : }
20553 0 : dplus = d__[*n] + s;
20554 0 : if (dplus < 0.) {
20555 0 : ++cnt;
20556 : }
20557 : }
20558 0 : if (cnt > i__ - 1) {
20559 0 : left -= werr[ii] * fac;
20560 0 : fac *= 2.;
20561 0 : goto L40;
20562 : }
20563 : }
20564 0 : nleft = cnt + 1;
20565 : i1 = (i1<nleft) ? i1 : nleft;
20566 : fac = 1.;
20567 0 : right = w[ii] + werr[ii];
20568 0 : L60:
20569 0 : s = -right;
20570 : cnt = 0;
20571 0 : i__1 = *n - 1;
20572 0 : for (j = 1; j <= i__1; ++j) {
20573 0 : dplus = d__[j] + s;
20574 0 : s = s * lld[j] / dplus - right;
20575 0 : if (dplus < 0.) {
20576 0 : ++cnt;
20577 : }
20578 : }
20579 0 : dplus = d__[*n] + s;
20580 0 : if (dplus < 0.) {
20581 0 : ++cnt;
20582 : }
20583 0 : if (std::isnan(s)) {
20584 :
20585 : cnt = 0;
20586 : s = -right;
20587 : i__1 = *n - 1;
20588 0 : for (j = 1; j <= i__1; ++j) {
20589 0 : dplus = d__[j] + s;
20590 0 : if (dplus < 0.) {
20591 0 : ++cnt;
20592 : }
20593 0 : tmp = lld[j] / dplus;
20594 0 : if (std::abs(tmp)<PLUMED_GMX_FLOAT_MIN) {
20595 0 : s = lld[j] - right;
20596 : } else {
20597 0 : s = s * tmp - right;
20598 : }
20599 : }
20600 0 : dplus = d__[*n] + s;
20601 0 : if (dplus < 0.) {
20602 0 : ++cnt;
20603 : }
20604 : }
20605 0 : if (cnt < i__) {
20606 0 : right += werr[ii] * fac;
20607 0 : fac *= 2.;
20608 0 : goto L60;
20609 : }
20610 : cnt = (cnt<i2) ? cnt : i2;
20611 0 : ++nint;
20612 0 : k = nleft << 1;
20613 0 : work[k - 1] = left;
20614 0 : work[k] = right;
20615 0 : i__ = cnt + 1;
20616 0 : iwork[k - 1] = i__;
20617 0 : iwork[k] = cnt;
20618 0 : if (prev != nleft - 1) {
20619 0 : work[k - 2] = left;
20620 : }
20621 : prev = nleft;
20622 : } else {
20623 0 : right = work[i__ * 2];
20624 :
20625 0 : ++iwork[k - 1];
20626 : prev = i__;
20627 0 : ++i__;
20628 : }
20629 0 : goto L30;
20630 : }
20631 0 : if (i__ <= *n && iwork[(i__ << 1) - 1] != -1) {
20632 0 : work[(i__ << 1) - 1] = work[prev * 2];
20633 : }
20634 :
20635 0 : L80:
20636 0 : prev = i1 - 1;
20637 : olnint = nint;
20638 : i__ = i1;
20639 : i__1 = olnint;
20640 0 : for (p = 1; p <= i__1; ++p) {
20641 0 : k = i__ << 1;
20642 0 : left = work[k - 1];
20643 0 : right = work[k];
20644 0 : next = iwork[k - 1];
20645 0 : nright = iwork[k];
20646 0 : mid = (left + right) * .5;
20647 0 : width = right - mid;
20648 : d__1 = std::abs(left);
20649 : d__2 = std::abs(right);
20650 0 : tmp = (d__1>d__2) ? d__1 : d__2;
20651 :
20652 : gap = 0.;
20653 0 : if (i__ == nright) {
20654 0 : if (prev > 0 && next <= *n) {
20655 0 : d__1 = left - work[k - 2], d__2 = work[k + 1] - right;
20656 0 : gap = (d__1<d__2) ? d__1 : d__2;
20657 0 : } else if (prev > 0) {
20658 0 : gap = left - work[k - 2];
20659 0 : } else if (next <= *n) {
20660 0 : gap = work[k + 1] - right;
20661 : }
20662 : }
20663 0 : d__1 = *rtol1 * gap, d__2 = *rtol2 * tmp;
20664 0 : if (width < ((d__1>d__2) ? d__1 : d__2)) {
20665 0 : --nint;
20666 0 : iwork[k - 1] = 0;
20667 : kk = k;
20668 : i__2 = nright;
20669 0 : for (j = i__ + 1; j <= i__2; ++j) {
20670 0 : kk += 2;
20671 0 : iwork[kk - 1] = 0;
20672 0 : work[kk - 1] = left;
20673 0 : work[kk] = right;
20674 0 : wgap[j - 1 - *offset] = 0.;
20675 : }
20676 0 : if (i1 == i__) {
20677 : i1 = next;
20678 : } else {
20679 0 : iwork[(prev << 1) - 1] = next;
20680 : }
20681 : i__ = next;
20682 0 : continue;
20683 : }
20684 : prev = i__;
20685 :
20686 0 : s = -mid;
20687 : cnt = 0;
20688 0 : i__2 = *n - 1;
20689 0 : for (j = 1; j <= i__2; ++j) {
20690 0 : dplus = d__[j] + s;
20691 0 : s = s * lld[j] / dplus - mid;
20692 0 : if (dplus < 0.) {
20693 0 : ++cnt;
20694 : }
20695 : }
20696 0 : dplus = d__[*n] + s;
20697 0 : if (dplus < 0.) {
20698 0 : ++cnt;
20699 : }
20700 0 : if (std::isnan(s)) {
20701 : cnt = 0;
20702 : s = -mid;
20703 : i__2 = *n - 1;
20704 0 : for (j = 1; j <= i__2; ++j) {
20705 0 : dplus = d__[j] + s;
20706 0 : if (dplus < 0.) {
20707 0 : ++cnt;
20708 : }
20709 0 : tmp = lld[j] / dplus;
20710 0 : if (std::abs(tmp)<PLUMED_GMX_FLOAT_MIN) {
20711 0 : s = lld[j] - mid;
20712 : } else {
20713 0 : s = s * tmp - mid;
20714 : }
20715 : }
20716 0 : dplus = d__[*n] + s;
20717 0 : if (dplus < 0.) {
20718 0 : ++cnt;
20719 : }
20720 : }
20721 0 : i__2 = i__ - 1, i__3 = (nright<cnt) ? nright : cnt;
20722 : cnt = (i__2>i__3) ? i__2 : i__3;
20723 0 : if (cnt == i__ - 1) {
20724 0 : work[k - 1] = mid;
20725 0 : } else if (cnt == nright) {
20726 0 : work[k] = mid;
20727 : } else {
20728 0 : iwork[k] = cnt;
20729 0 : ++cnt;
20730 0 : iwork[k - 1] = cnt;
20731 0 : kk = cnt << 1;
20732 0 : iwork[kk - 1] = next;
20733 0 : iwork[kk] = nright;
20734 0 : work[k] = mid;
20735 0 : work[kk - 1] = mid;
20736 0 : work[kk] = right;
20737 : prev = cnt;
20738 0 : if (cnt - 1 > i__) {
20739 0 : work[kk - 2] = mid;
20740 : }
20741 0 : if (cnt > *ifirst && cnt <= *ilast) {
20742 0 : ++nint;
20743 0 : } else if (cnt <= *ifirst) {
20744 : i1 = cnt;
20745 : }
20746 : }
20747 : i__ = next;
20748 : }
20749 0 : if (nint > 0) {
20750 0 : goto L80;
20751 : }
20752 0 : i__1 = *ilast;
20753 0 : for (i__ = *ifirst; i__ <= i__1; ++i__) {
20754 0 : k = i__ << 1;
20755 0 : ii = i__ - *offset;
20756 0 : if (iwork[k - 1] != -1) {
20757 0 : w[ii] = (work[k - 1] + work[k]) * .5;
20758 0 : werr[ii] = work[k] - w[ii];
20759 0 : if (i__ != *ilast) {
20760 0 : wgap[ii] = work[k + 1] - work[k];
20761 : }
20762 : }
20763 : }
20764 :
20765 0 : return;
20766 :
20767 : }
20768 : }
20769 : }
20770 : #include <cctype>
20771 : #include <cmath>
20772 :
20773 : #include "real.h"
20774 :
20775 : #include "blas/blas.h"
20776 : #include "lapack.h"
20777 : #include "lapack_limits.h"
20778 :
20779 :
20780 :
20781 : #include "blas/blas.h"
20782 : namespace PLMD{
20783 : namespace lapack{
20784 : using namespace blas;
20785 : void
20786 0 : PLUMED_BLAS_F77_FUNC(slarrex,SLARREX)(const char *range,
20787 : int *n,
20788 : float *vl,
20789 : float *vu,
20790 : int *il,
20791 : int *iu,
20792 : float *d__,
20793 : float *e,
20794 : float *tol,
20795 : int *nsplit,
20796 : int *isplit,
20797 : int *m,
20798 : float *w,
20799 : int *iblock,
20800 : int *indexw,
20801 : float *gersch,
20802 : float *work,
20803 : int *iwork,
20804 : int *info)
20805 : {
20806 : int i__1, i__2, i__3;
20807 : float d__1, d__2;
20808 0 : int c__1 = 1;
20809 0 : int c__0 = 0;
20810 :
20811 : int i__, j, k;
20812 : float s, gl;
20813 : int in;
20814 : float gu;
20815 : int cnt;
20816 : float eps, tau, nrm, tmp, vvl, vvu, offd;
20817 : int iend, jblk, till, itmp;
20818 : float rtol, delta, sigma;
20819 : int iinfo;
20820 : float width;
20821 : int ibegin;
20822 : int irange;
20823 : float sgndef;
20824 : int maxcnt;
20825 0 : --iwork;
20826 0 : --work;
20827 0 : --gersch;
20828 0 : --indexw;
20829 0 : --iblock;
20830 0 : --w;
20831 0 : --isplit;
20832 0 : --e;
20833 0 : --d__;
20834 :
20835 : sigma = 0;
20836 : irange = 0;
20837 : sgndef = 0;
20838 : maxcnt = 0;
20839 :
20840 0 : *info = 0;
20841 :
20842 0 : if (*range=='A' || *range=='a')
20843 : irange = 1;
20844 0 : else if (*range=='V' || *range=='v')
20845 : irange = 2;
20846 0 : else if (*range=='I' || *range=='i')
20847 : irange = 3;
20848 :
20849 :
20850 0 : *m = 0;
20851 : eps = PLUMED_GMX_FLOAT_EPS;
20852 :
20853 0 : *nsplit = 1;
20854 0 : i__1 = *n - 1;
20855 0 : for (i__ = 1; i__ <= i__1; ++i__) {
20856 0 : if (std::abs(e[i__]) <= *tol) {
20857 0 : isplit[*nsplit] = i__;
20858 0 : ++(*nsplit);
20859 : }
20860 : }
20861 0 : isplit[*nsplit] = *n;
20862 :
20863 : ibegin = 1;
20864 0 : i__1 = *nsplit;
20865 0 : for (jblk = 1; jblk <= i__1; ++jblk) {
20866 0 : iend = isplit[jblk];
20867 0 : if (ibegin == iend) {
20868 0 : ++(*m);
20869 0 : w[*m] = d__[ibegin];
20870 0 : iblock[*m] = jblk;
20871 0 : indexw[*m] = 1;
20872 0 : e[iend] = 0.;
20873 0 : ibegin = iend + 1;
20874 0 : goto L170;
20875 : }
20876 0 : in = iend - ibegin + 1;
20877 :
20878 0 : gl = d__[ibegin] - std::abs(e[ibegin]);
20879 0 : gu = d__[ibegin] + std::abs(e[ibegin]);
20880 0 : gersch[(ibegin << 1) - 1] = gl;
20881 0 : gersch[ibegin * 2] = gu;
20882 0 : gersch[(iend << 1) - 1] = d__[iend] - std::abs(e[iend - 1]);
20883 0 : gersch[iend * 2] = d__[iend] + std::abs(e[iend - 1]);
20884 0 : d__1 = gersch[(iend << 1) - 1];
20885 0 : gl = (d__1<gl) ? d__1 : gl;
20886 : d__1 = gersch[iend * 2];
20887 0 : gu = (d__1>gu) ? d__1 : gu;
20888 0 : i__2 = iend - 1;
20889 0 : for (i__ = ibegin + 1; i__ <= i__2; ++i__) {
20890 0 : offd = std::abs(e[i__ - 1]) + std::abs(e[i__]);
20891 0 : gersch[(i__ << 1) - 1] = d__[i__] - offd;
20892 : d__1 = gersch[(i__ << 1) - 1];
20893 0 : gl = (d__1<gl) ? d__1 : gl;
20894 0 : gersch[i__ * 2] = d__[i__] + offd;
20895 : d__1 = gersch[i__ * 2];
20896 0 : gu = (d__1>gu) ? d__1 : gu;
20897 : }
20898 : d__1 = std::abs(gl), d__2 = std::abs(gu);
20899 0 : nrm = (d__1>d__2) ? d__1 : d__2;
20900 :
20901 0 : width = gu - gl;
20902 : i__2 = iend - 1;
20903 0 : for (i__ = ibegin; i__ <= i__2; ++i__) {
20904 0 : work[i__] = e[i__] * e[i__];
20905 : }
20906 0 : for (j = 1; j <= 2; ++j) {
20907 0 : if (j == 1) {
20908 0 : tau = gl + width * .25;
20909 : } else {
20910 0 : tau = gu - width * .25;
20911 : }
20912 0 : tmp = d__[ibegin] - tau;
20913 0 : if (tmp < 0.) {
20914 0 : cnt = 1;
20915 : } else {
20916 0 : cnt = 0;
20917 : }
20918 0 : i__2 = iend;
20919 0 : for (i__ = ibegin + 1; i__ <= i__2; ++i__) {
20920 0 : tmp = d__[i__] - tau - work[i__ - 1] / tmp;
20921 0 : if (tmp < 0.) {
20922 0 : ++cnt;
20923 : }
20924 : }
20925 0 : if (cnt == 0) {
20926 : gl = tau;
20927 0 : } else if (cnt == in) {
20928 : gu = tau;
20929 : }
20930 0 : if (j == 1) {
20931 : maxcnt = cnt;
20932 : sigma = gl;
20933 : sgndef = 1.;
20934 : } else {
20935 0 : if (in - cnt > maxcnt) {
20936 : sigma = gu;
20937 : sgndef = -1.;
20938 : }
20939 : }
20940 : }
20941 :
20942 0 : work[in * 3] = 1.;
20943 : delta = eps;
20944 0 : tau = sgndef * nrm;
20945 0 : L60:
20946 0 : sigma -= delta * tau;
20947 0 : work[1] = d__[ibegin] - sigma;
20948 : j = ibegin;
20949 0 : i__2 = in - 1;
20950 0 : for (i__ = 1; i__ <= i__2; ++i__) {
20951 0 : work[(in << 1) + i__] = 1. / work[i__];
20952 0 : tmp = e[j] * work[(in << 1) + i__];
20953 0 : work[i__ + 1] = d__[j + 1] - sigma - tmp * e[j];
20954 0 : work[in + i__] = tmp;
20955 0 : ++j;
20956 : }
20957 0 : for (i__ = in; i__ >= 1; --i__) {
20958 0 : tmp = sgndef * work[i__];
20959 0 : if (tmp < 0. || std::abs(work[(in << 1) + i__])<PLUMED_GMX_FLOAT_MIN || std::isnan(tmp)) {
20960 0 : delta *= 2.;
20961 0 : goto L60;
20962 : }
20963 : }
20964 :
20965 0 : PLUMED_BLAS_F77_FUNC(scopy,SCOPY)(&in, &work[1], &c__1, &d__[ibegin], &c__1);
20966 0 : i__2 = in - 1;
20967 0 : PLUMED_BLAS_F77_FUNC(scopy,SCOPY)(&i__2, &work[in + 1], &c__1, &e[ibegin], &c__1);
20968 0 : i__2 = in - 1;
20969 0 : for (i__ = 1; i__ <= i__2; ++i__) {
20970 0 : work[in * 3 + i__] = work[i__] * work[in + i__];
20971 0 : work[(in << 2) + i__] = work[in * 3 + i__] * work[in + i__];
20972 : }
20973 0 : if (sgndef > 0.) {
20974 0 : cnt = 1;
20975 0 : work[1] = (gl + gu) / 2. - sigma;
20976 0 : work[in + 1] = 0.;
20977 0 : work[(in << 1) + 1] = (gu - gl) / 2.;
20978 : } else {
20979 0 : cnt = in;
20980 0 : work[in] = (gl + gu) / 2. - sigma;
20981 0 : work[in * 2] = 0.;
20982 0 : work[in * 3] = (gu - gl) / 2.;
20983 : }
20984 0 : rtol = eps * 4.;
20985 0 : PLUMED_BLAS_F77_FUNC(slarrbx,SLARRBX)(&in, &d__[ibegin], &e[ibegin], &work[in * 3 + 1], &work[(in <<
20986 0 : 2) + 1], &cnt, &cnt, &rtol, &rtol, &c__0, &work[1], &work[in
20987 0 : + 1], &work[(in << 1) + 1], &work[in * 5 + 1], &iwork[1], &
20988 : iinfo);
20989 0 : if (sgndef > 0.) {
20990 0 : tau = work[1] - work[(in << 1) + 1];
20991 : } else {
20992 0 : tau = work[in] + work[in * 3];
20993 : }
20994 :
20995 0 : work[in * 3] = 1.;
20996 : delta = eps * 2.;
20997 0 : L100:
20998 0 : tau *= 1. - delta;
20999 :
21000 0 : s = -tau;
21001 : j = ibegin;
21002 0 : i__2 = in - 1;
21003 0 : for (i__ = 1; i__ <= i__2; ++i__) {
21004 0 : work[i__] = d__[j] + s;
21005 0 : work[(in << 1) + i__] = 1. / work[i__];
21006 0 : work[in + i__] = e[j] * d__[j] * work[(in << 1) + i__];
21007 0 : s = s * work[in + i__] * e[j] - tau;
21008 0 : ++j;
21009 : }
21010 0 : work[in] = d__[iend] + s;
21011 :
21012 0 : for (i__ = in; i__ >= 1; --i__) {
21013 0 : tmp = sgndef * work[i__];
21014 0 : if (tmp < 0. || std::abs(work[(in << 1) + i__])<PLUMED_GMX_FLOAT_MIN || std::isnan(tmp)) {
21015 0 : delta *= 2.;
21016 0 : goto L100;
21017 : }
21018 : }
21019 :
21020 0 : sigma += tau;
21021 0 : PLUMED_BLAS_F77_FUNC(scopy,SCOPY)(&in, &work[1], &c__1, &d__[ibegin], &c__1);
21022 0 : i__2 = in - 1;
21023 0 : PLUMED_BLAS_F77_FUNC(scopy,SCOPY)(&i__2, &work[in + 1], &c__1, &e[ibegin], &c__1);
21024 0 : e[iend] = sigma;
21025 0 : tmp = (float) in * 4. * eps * (std::abs(sigma) + std::abs(tau));
21026 : i__2 = iend;
21027 0 : for (i__ = ibegin; i__ <= i__2; ++i__) {
21028 0 : gersch[(i__ << 1) - 1] = gersch[(i__ << 1) - 1] - sigma - tmp;
21029 0 : gersch[i__ * 2] = gersch[i__ * 2] - sigma + tmp;
21030 : }
21031 :
21032 : j = ibegin;
21033 0 : i__2 = in - 1;
21034 0 : for (i__ = 1; i__ <= i__2; ++i__) {
21035 0 : work[(i__ << 1) - 1] = std::abs(d__[j]);
21036 0 : work[i__ * 2] = e[j] * e[j] * work[(i__ << 1) - 1];
21037 0 : ++j;
21038 : }
21039 0 : work[(in << 1) - 1] = std::abs(d__[iend]);
21040 :
21041 0 : PLUMED_BLAS_F77_FUNC(slasq2,SLASQ2)(&in, &work[1], info);
21042 0 : if (*info != 0) {
21043 : return;
21044 : }
21045 :
21046 0 : if (sgndef > 0.) {
21047 0 : i__2 = in;
21048 0 : for (i__ = 1; i__ <= i__2; ++i__) {
21049 0 : ++(*m);
21050 0 : w[*m] = work[in - i__ + 1];
21051 0 : iblock[*m] = jblk;
21052 0 : indexw[*m] = i__;
21053 : }
21054 : } else {
21055 0 : i__2 = in;
21056 0 : for (i__ = 1; i__ <= i__2; ++i__) {
21057 0 : ++(*m);
21058 0 : w[*m] = -work[i__];
21059 0 : iblock[*m] = jblk;
21060 0 : indexw[*m] = i__;
21061 : }
21062 : }
21063 0 : ibegin = iend + 1;
21064 0 : L170:
21065 : ;
21066 : }
21067 0 : if (irange == 2) {
21068 0 : *m = 0;
21069 : ibegin = 1;
21070 0 : i__1 = *nsplit;
21071 0 : for (i__ = 1; i__ <= i__1; ++i__) {
21072 0 : iend = isplit[i__];
21073 0 : vvl = *vl - e[iend];
21074 0 : vvu = *vu - e[iend];
21075 0 : i__2 = iend;
21076 0 : for (j = ibegin; j <= i__2; ++j) {
21077 0 : if (vvl <= w[j] && w[j] <= vvu) {
21078 0 : ++(*m);
21079 0 : w[*m] = w[j];
21080 0 : iblock[*m] = i__;
21081 0 : indexw[*m] = j - ibegin + 1;
21082 : }
21083 : }
21084 0 : ibegin = iend + 1;
21085 : }
21086 0 : } else if (irange == 3) {
21087 0 : *m = *iu - *il + 1;
21088 0 : if (*nsplit == 1) {
21089 : i__1 = *m;
21090 0 : for (i__ = 1; i__ <= i__1; ++i__) {
21091 0 : w[i__] = w[*il + i__ - 1];
21092 0 : indexw[i__] = *il + i__ - 1;
21093 : }
21094 : } else {
21095 : ibegin = 1;
21096 : i__1 = *nsplit;
21097 0 : for (i__ = 1; i__ <= i__1; ++i__) {
21098 0 : iend = isplit[i__];
21099 0 : i__2 = iend;
21100 0 : for (j = ibegin; j <= i__2; ++j) {
21101 0 : work[j] = w[j] + e[iend];
21102 : }
21103 0 : ibegin = iend + 1;
21104 : }
21105 0 : i__1 = *n;
21106 0 : for (i__ = 1; i__ <= i__1; ++i__) {
21107 0 : iwork[i__] = i__;
21108 0 : iwork[*n + i__] = iblock[i__];
21109 : }
21110 0 : PLUMED_BLAS_F77_FUNC(slasrt2,SLASRT2)("I", n, &work[1], &iwork[1], &iinfo);
21111 0 : i__1 = *m;
21112 0 : for (i__ = 1; i__ <= i__1; ++i__) {
21113 0 : itmp = iwork[*il + i__ - 1];
21114 0 : work[i__] = w[itmp];
21115 0 : iblock[i__] = iwork[*n + itmp];
21116 : }
21117 0 : i__1 = *m;
21118 0 : for (i__ = 1; i__ <= i__1; ++i__) {
21119 0 : iwork[*n + i__] = iwork[*il + i__ - 1];
21120 0 : iwork[i__] = i__;
21121 : }
21122 0 : PLUMED_BLAS_F77_FUNC(ilasrt2,ILASRT2)("I", m, &iblock[1], &iwork[1], &iinfo);
21123 : j = 1;
21124 0 : itmp = iblock[j];
21125 0 : cnt = iwork[*n + iwork[j]];
21126 0 : if (itmp == 1) {
21127 : ibegin = 1;
21128 : } else {
21129 0 : ibegin = isplit[itmp - 1] + 1;
21130 : }
21131 0 : i__1 = *m;
21132 0 : for (i__ = 1; i__ <= i__1; ++i__) {
21133 0 : w[i__] = work[iwork[i__]];
21134 0 : if (iblock[i__] != itmp || i__ == *m) {
21135 0 : if (iblock[i__] == itmp) {
21136 0 : till = *m;
21137 : } else {
21138 0 : till = i__ - 1;
21139 : }
21140 0 : i__2 = till - j + 1;
21141 0 : PLUMED_BLAS_F77_FUNC(slasrt,SLASRT)("I", &i__2, &w[j], &iinfo);
21142 0 : cnt = cnt - ibegin + 1;
21143 0 : i__2 = till;
21144 0 : for (k = j; k <= i__2; ++k) {
21145 0 : indexw[k] = cnt + k - j;
21146 : }
21147 : j = i__;
21148 0 : itmp = iblock[j];
21149 0 : cnt = iwork[*n + iwork[j]];
21150 0 : ibegin = isplit[itmp - 1] + 1;
21151 0 : if (i__ == *m && till < *m) {
21152 0 : indexw[*m] = cnt - ibegin + 1;
21153 : }
21154 : } else {
21155 0 : i__2 = cnt, i__3 = iwork[*n + iwork[i__]];
21156 0 : cnt = (i__2<i__3) ? i__2 : i__3;
21157 : }
21158 : }
21159 : }
21160 : }
21161 :
21162 : return;
21163 :
21164 : }
21165 :
21166 :
21167 : }
21168 : }
21169 : #include <cmath>
21170 :
21171 : #include "real.h"
21172 :
21173 : #include "blas/blas.h"
21174 : #include "lapack.h"
21175 : #include "lapack_limits.h"
21176 :
21177 :
21178 : #include "blas/blas.h"
21179 : namespace PLMD{
21180 : namespace lapack{
21181 : using namespace blas;
21182 : void
21183 0 : PLUMED_BLAS_F77_FUNC(slarrfx,SLARRFX)(int *n,
21184 : float *d__,
21185 : float *l,
21186 : float *ld,
21187 : float *lld,
21188 : int *ifirst,
21189 : int *ilast,
21190 : float *w,
21191 : float *sigma,
21192 : float *dplus,
21193 : float *lplus,
21194 : float *work,
21195 : int *info)
21196 : {
21197 0 : int i1 = 1;
21198 : int i__1;
21199 : float d__2, d__3;
21200 :
21201 : int i__;
21202 : float s, eps, tmp, dmax1, dmax2, delta;
21203 0 : --work;
21204 0 : --lplus;
21205 0 : --dplus;
21206 0 : --w;
21207 : --lld;
21208 0 : --ld;
21209 0 : --l;
21210 0 : --d__;
21211 0 : *info = 0;
21212 : eps = PLUMED_GMX_FLOAT_EPS;
21213 0 : *sigma = w[*ifirst];
21214 : delta = eps * 2.;
21215 :
21216 0 : L10:
21217 0 : s = -(*sigma);
21218 0 : dplus[1] = d__[1] + s;
21219 : dmax1 = std::abs(dplus[1]);
21220 0 : i__1 = *n - 1;
21221 0 : for (i__ = 1; i__ <= i__1; ++i__) {
21222 0 : lplus[i__] = ld[i__] / dplus[i__];
21223 0 : s = s * lplus[i__] * l[i__] - *sigma;
21224 0 : dplus[i__ + 1] = d__[i__ + 1] + s;
21225 : d__2 = dmax1, d__3 = std::abs(dplus[i__ + 1]);
21226 0 : dmax1 = (d__2>d__3) ? d__2 : d__3;
21227 : }
21228 0 : if (std::isnan(dmax1)) {
21229 0 : *sigma -= std::abs(*sigma) * delta;
21230 0 : delta *= 2.;
21231 0 : goto L10;
21232 : }
21233 :
21234 0 : tmp = w[*ilast];
21235 : delta = eps * 2.;
21236 0 : L30:
21237 0 : s = -tmp;
21238 0 : work[1] = d__[1] + s;
21239 : dmax2 = std::abs(work[1]);
21240 0 : i__1 = *n - 1;
21241 0 : for (i__ = 1; i__ <= i__1; ++i__) {
21242 0 : work[*n + i__] = ld[i__] / work[i__];
21243 0 : s = s * work[*n + i__] * l[i__] - tmp;
21244 0 : work[i__ + 1] = d__[i__ + 1] + s;
21245 : d__2 = dmax2, d__3 = std::abs(work[i__ + 1]);
21246 0 : dmax2 = (d__2>d__3) ? d__2 : d__3;
21247 : }
21248 0 : if (std::isnan(dmax2)) {
21249 0 : tmp += std::abs(tmp) * delta;
21250 0 : delta *= 2.;
21251 0 : goto L30;
21252 : }
21253 0 : if (dmax2 < dmax1) {
21254 0 : *sigma = tmp;
21255 0 : PLUMED_BLAS_F77_FUNC(scopy,SCOPY)(n, &work[1], &i1, &dplus[1], &i1);
21256 0 : i__1 = *n - 1;
21257 0 : PLUMED_BLAS_F77_FUNC(scopy,SCOPY)(&i__1, &work[*n + 1], &i1, &lplus[1], &i1);
21258 : }
21259 :
21260 0 : return;
21261 : }
21262 : }
21263 : }
21264 : #include <cmath>
21265 :
21266 : #include "real.h"
21267 :
21268 : #include "blas/blas.h"
21269 : #include "lapack.h"
21270 : #include "lapack_limits.h"
21271 :
21272 :
21273 : #include "blas/blas.h"
21274 : namespace PLMD{
21275 : namespace lapack{
21276 : using namespace blas;
21277 : void
21278 0 : PLUMED_BLAS_F77_FUNC(slarrvx,SLARRVX)(int *n,
21279 : float *d__,
21280 : float *l,
21281 : int *isplit,
21282 : int *m,
21283 : float *w,
21284 : int *iblock,
21285 : int *indexw,
21286 : float *gersch,
21287 : float *tol,
21288 : float *z__,
21289 : int *ldz,
21290 : int *isuppz,
21291 : float *work,
21292 : int *iwork,
21293 : int *info)
21294 : {
21295 : int z_dim1, z_offset, i__1, i__2, i__3, i__4, i__5, i__6;
21296 : float d__1, d__2;
21297 0 : float c_b5 = 0.;
21298 0 : int c__1 = 1;
21299 0 : int c__2 = 2;
21300 :
21301 : int i__, j, k, p, q;
21302 : int im, in;
21303 : float gap, eps, tmp;
21304 : int zto;
21305 : float ztz;
21306 : int iend, jblk;
21307 : int wend, iter, temp[1], ktot;
21308 : int itmp1, itmp2;
21309 : int indld;
21310 : float sigma;
21311 : int ndone, iinfo, iindr;
21312 : float resid;
21313 : int nomgs;
21314 : int nclus;
21315 : int zfrom, iindc1, iindc2;
21316 : float lambda;
21317 : int ibegin;
21318 : int indgap, indlld;
21319 : float mingma;
21320 : int oldien, oldncl, wbegin;
21321 : float relgap;
21322 : int oldcls;
21323 : int ndepth, inderr, iindwk;
21324 : int newcls, oldfst;
21325 : float minrgp=0.0;
21326 : int indwrk, oldlst;
21327 : float reltol;
21328 : int newfrs, newftt, parity;
21329 : float mgstol, nrminv, rqcorr;
21330 : int newlst, newsiz;
21331 :
21332 :
21333 0 : --d__;
21334 0 : --l;
21335 : --isplit;
21336 0 : --w;
21337 0 : --iblock;
21338 0 : --indexw;
21339 : --gersch;
21340 0 : z_dim1 = *ldz;
21341 0 : z_offset = 1 + z_dim1;
21342 0 : z__ -= z_offset;
21343 0 : --isuppz;
21344 0 : --work;
21345 0 : --iwork;
21346 :
21347 0 : inderr = *n;
21348 0 : indld = *n << 1;
21349 0 : indlld = *n * 3;
21350 0 : indgap = *n << 2;
21351 0 : indwrk = *n * 5 + 1;
21352 :
21353 : iindr = *n;
21354 : iindc1 = *n << 1;
21355 : iindc2 = *n * 3;
21356 0 : iindwk = (*n << 2) + 1;
21357 :
21358 : eps = PLUMED_GMX_FLOAT_EPS;
21359 :
21360 : i__1 = *n << 1;
21361 0 : for (i__ = 1; i__ <= i__1; ++i__) {
21362 0 : iwork[i__] = 0;
21363 : }
21364 0 : PLUMED_BLAS_F77_FUNC(slaset,SLASET)("Full", n, m, &c_b5, &c_b5, &z__[z_offset], ldz);
21365 : mgstol = eps * 100.;
21366 :
21367 : ibegin = 1;
21368 : wbegin = 1;
21369 0 : i__1 = iblock[*m];
21370 0 : for (jblk = 1; jblk <= i__1; ++jblk) {
21371 0 : iend = isplit[jblk];
21372 :
21373 0 : wend = wbegin - 1;
21374 0 : L171:
21375 0 : if (wend < *m) {
21376 0 : if (iblock[wend + 1] == jblk) {
21377 0 : ++wend;
21378 0 : goto L171;
21379 : }
21380 : }
21381 0 : if (wend < wbegin) {
21382 0 : ibegin = iend + 1;
21383 0 : continue;
21384 : }
21385 :
21386 0 : if (ibegin == iend) {
21387 0 : z__[ibegin + wbegin * z_dim1] = 1.;
21388 0 : isuppz[(wbegin << 1) - 1] = ibegin;
21389 0 : isuppz[wbegin * 2] = ibegin;
21390 0 : ibegin = iend + 1;
21391 0 : wbegin = wend + 1;
21392 0 : continue;
21393 : }
21394 0 : oldien = ibegin - 1;
21395 0 : in = iend - oldien;
21396 0 : d__1 = .001, d__2 = 1. / (float) in;
21397 0 : reltol = (d__1<d__2) ? d__1 : d__2;
21398 0 : im = wend - wbegin + 1;
21399 0 : PLUMED_BLAS_F77_FUNC(scopy,SCOPY)(&im, &w[wbegin], &c__1, &work[1], &c__1);
21400 0 : i__2 = im - 1;
21401 0 : for (i__ = 1; i__ <= i__2; ++i__) {
21402 0 : work[inderr + i__] = eps * std::abs(work[i__]);
21403 0 : work[indgap + i__] = work[i__ + 1] - work[i__];
21404 : }
21405 0 : work[inderr + im] = eps * std::abs(work[im]);
21406 0 : d__2 = std::abs(work[im]);
21407 0 : work[indgap + im] = (d__2>eps) ? d__2 : eps;
21408 : ndone = 0;
21409 :
21410 : ndepth = 0;
21411 : parity = 1;
21412 : nclus = 1;
21413 0 : iwork[iindc1 + 1] = 1;
21414 0 : iwork[iindc1 + 2] = im;
21415 :
21416 0 : L40:
21417 0 : if (ndone < im) {
21418 : oldncl = nclus;
21419 : nclus = 0;
21420 0 : parity = 1 - parity;
21421 0 : if (parity == 0) {
21422 : oldcls = iindc1;
21423 : newcls = iindc2;
21424 : } else {
21425 : oldcls = iindc2;
21426 : newcls = iindc1;
21427 : }
21428 : i__2 = oldncl;
21429 0 : for (i__ = 1; i__ <= i__2; ++i__) {
21430 :
21431 0 : j = oldcls + (i__ << 1);
21432 0 : oldfst = iwork[j - 1];
21433 0 : oldlst = iwork[j];
21434 0 : if (ndepth > 0) {
21435 0 : j = wbegin + oldfst - 1;
21436 0 : PLUMED_BLAS_F77_FUNC(scopy,SCOPY)(&in, &z__[ibegin + j * z_dim1], &c__1, &d__[ibegin]
21437 : , &c__1);
21438 0 : i__3 = in - 1;
21439 0 : PLUMED_BLAS_F77_FUNC(scopy,SCOPY)(&i__3, &z__[ibegin + (j + 1) * z_dim1], &c__1, &l[
21440 : ibegin], &c__1);
21441 0 : PLUMED_BLAS_F77_FUNC(slaset,SLASET)("Full", &in, &c__2, &c_b5, &c_b5, &z__[ibegin + j
21442 : * z_dim1], ldz);
21443 : }
21444 : k = ibegin;
21445 0 : i__3 = in - 1;
21446 0 : for (j = 1; j <= i__3; ++j) {
21447 0 : tmp = d__[k] * l[k];
21448 0 : work[indld + j] = tmp;
21449 0 : work[indlld + j] = tmp * l[k];
21450 0 : ++k;
21451 : }
21452 0 : if (ndepth > 0) {
21453 :
21454 0 : p = indexw[wbegin - 1 + oldfst];
21455 0 : q = indexw[wbegin - 1 + oldlst];
21456 0 : d__1 = eps * 4.;
21457 0 : i__3 = p - oldfst;
21458 0 : PLUMED_BLAS_F77_FUNC(slarrbx,SLARRBX)(&in, &d__[ibegin], &l[ibegin], &work[indld + 1], &
21459 0 : work[indlld + 1], &p, &q, &reltol, &d__1, &i__3, &
21460 0 : work[1], &work[indgap + 1], &work[inderr + 1], &
21461 0 : work[indwrk + in], &iwork[iindwk], &iinfo);
21462 : }
21463 0 : newfrs = oldfst;
21464 0 : i__3 = oldlst;
21465 0 : for (j = oldfst; j <= i__3; ++j) {
21466 0 : if (j == oldlst || work[indgap + j] >=
21467 0 : reltol * std::abs(work[j])) {
21468 0 : newlst = j;
21469 : } else {
21470 :
21471 0 : relgap = work[indgap + j] / std::abs(work[j]);
21472 0 : if (j == newfrs) {
21473 : minrgp = relgap;
21474 : } else {
21475 0 : minrgp = (minrgp<relgap) ? minrgp : relgap;
21476 : }
21477 0 : continue;
21478 : }
21479 0 : newsiz = newlst - newfrs + 1;
21480 0 : newftt = wbegin + newfrs - 1;
21481 0 : nomgs = newsiz == 1 || newsiz > 1 || minrgp < mgstol;
21482 0 : if (newsiz > 1 && nomgs) {
21483 :
21484 0 : PLUMED_BLAS_F77_FUNC(slarrfx,SLARRFX)(&in, &d__[ibegin], &l[ibegin], &work[indld +
21485 0 : 1], &work[indlld + 1], &newfrs, &newlst, &
21486 0 : work[1], &sigma, &z__[ibegin + newftt *
21487 0 : z_dim1], &z__[ibegin + (newftt + 1) * z_dim1],
21488 0 : &work[indwrk], info);
21489 0 : if (*info == 0) {
21490 0 : tmp = eps * std::abs(sigma);
21491 0 : i__4 = newlst;
21492 0 : for (k = newfrs; k <= i__4; ++k) {
21493 0 : work[k] -= sigma;
21494 0 : d__1 = work[indgap + k];
21495 0 : work[indgap + k] = (d__1>tmp) ? d__1 : tmp;
21496 0 : work[inderr + k] += tmp;
21497 : }
21498 0 : ++nclus;
21499 0 : k = newcls + (nclus << 1);
21500 0 : iwork[k - 1] = newfrs;
21501 0 : iwork[k] = newlst;
21502 : } else {
21503 0 : *info = 0;
21504 0 : if (minrgp < mgstol) {
21505 :
21506 0 : work[indwrk] = d__[ibegin];
21507 0 : i__4 = in - 1;
21508 0 : for (k = 1; k <= i__4; ++k) {
21509 0 : work[indwrk + k] = d__[ibegin + k] + work[
21510 0 : indlld + k];
21511 : }
21512 0 : i__4 = newsiz;
21513 0 : for (k = 1; k <= i__4; ++k) {
21514 0 : iwork[iindwk + k - 1] = 1;
21515 : }
21516 0 : i__4 = newlst;
21517 0 : for (k = newfrs; k <= i__4; ++k) {
21518 0 : isuppz[2*(oldien + k) - 1] = 1;
21519 0 : isuppz[(oldien + k) * 2] = in;
21520 : }
21521 0 : temp[0] = in;
21522 0 : PLUMED_BLAS_F77_FUNC(sstein,SSTEIN)(&in, &work[indwrk], &work[indld + 1],
21523 0 : &newsiz, &work[newfrs], &iwork[iindwk]
21524 : , temp, &z__[ibegin + newftt * z_dim1]
21525 0 : , ldz, &work[indwrk + in], &iwork[
21526 0 : iindwk + in], &iwork[iindwk + (in*2)], &iinfo);
21527 0 : if (iinfo != 0) {
21528 0 : *info = 2;
21529 0 : return;
21530 : }
21531 0 : ndone += newsiz;
21532 : }
21533 : }
21534 : } else {
21535 : ktot = newftt;
21536 : i__4 = newlst;
21537 0 : for (k = newfrs; k <= i__4; ++k) {
21538 : iter = 0;
21539 0 : L90:
21540 0 : lambda = work[k];
21541 :
21542 0 : PLUMED_BLAS_F77_FUNC(slar1vx,SLAR1VX)(&in, &c__1, &in, &lambda, &d__[ibegin], &
21543 0 : l[ibegin], &work[indld + 1], &work[indlld
21544 0 : + 1], &w[wbegin + k - 1], &gersch[(oldien
21545 0 : << 1) + 1], &z__[ibegin + ktot * z_dim1],
21546 0 : &ztz, &mingma, &iwork[iindr + ktot], &
21547 0 : isuppz[(ktot << 1) - 1], &work[indwrk]);
21548 0 : tmp = 1. / ztz;
21549 0 : nrminv = std::sqrt(tmp);
21550 0 : resid = std::abs(mingma) * nrminv;
21551 0 : rqcorr = mingma * tmp;
21552 0 : if (k == in) {
21553 0 : gap = work[indgap + k - 1];
21554 0 : } else if (k == 1) {
21555 0 : gap = work[indgap + k];
21556 : } else {
21557 0 : d__1 = work[indgap + k - 1], d__2 = work[
21558 0 : indgap + k];
21559 0 : gap = (d__1<d__2) ? d__1 : d__2;
21560 : }
21561 0 : ++iter;
21562 0 : if (resid > *tol * gap && std::abs(rqcorr) > eps * 4. *
21563 0 : std::abs(lambda)) {
21564 0 : work[k] = lambda + rqcorr;
21565 0 : if (iter < 8) {
21566 0 : goto L90;
21567 : }
21568 : }
21569 0 : iwork[ktot] = 1;
21570 0 : if (newsiz == 1) {
21571 0 : ++ndone;
21572 : }
21573 0 : zfrom = isuppz[(ktot << 1) - 1];
21574 0 : zto = isuppz[ktot * 2];
21575 0 : i__5 = zto - zfrom + 1;
21576 0 : PLUMED_BLAS_F77_FUNC(sscal,SSCAL)(&i__5, &nrminv, &z__[ibegin + zfrom - 1 +
21577 0 : ktot * z_dim1], &c__1);
21578 0 : ++ktot;
21579 : }
21580 0 : if (newsiz > 1) {
21581 0 : itmp1 = isuppz[(newftt << 1) - 1];
21582 0 : itmp2 = isuppz[newftt * 2];
21583 0 : ktot = oldien + newlst;
21584 : i__4 = ktot;
21585 0 : for (p = newftt + 1; p <= i__4; ++p) {
21586 0 : i__5 = p - 1;
21587 0 : for (q = newftt; q <= i__5; ++q) {
21588 0 : tmp = -PLUMED_BLAS_F77_FUNC(sdot,SDOT)(&in, &z__[ibegin + p *
21589 0 : z_dim1], &c__1, &z__[ibegin + q *
21590 0 : z_dim1], &c__1);
21591 0 : PLUMED_BLAS_F77_FUNC(saxpy,SAXPY)(&in, &tmp, &z__[ibegin + q *
21592 0 : z_dim1], &c__1, &z__[ibegin + p *
21593 0 : z_dim1], &c__1);
21594 : }
21595 0 : tmp = 1. / PLUMED_BLAS_F77_FUNC(snrm2,SNRM2)(&in, &z__[ibegin + p *
21596 0 : z_dim1], &c__1);
21597 0 : PLUMED_BLAS_F77_FUNC(sscal,SSCAL)(&in, &tmp, &z__[ibegin + p * z_dim1], &
21598 : c__1);
21599 0 : i__5 = itmp1, i__6 = isuppz[(p << 1) - 1];
21600 : itmp1 = (i__5<i__6) ? i__5 : i__6;
21601 0 : i__5 = itmp2, i__6 = isuppz[p * 2];
21602 : itmp2 = (i__5>i__6) ? i__5 : i__6;
21603 : }
21604 : i__4 = ktot;
21605 0 : for (p = newftt; p <= i__4; ++p) {
21606 0 : isuppz[(p << 1) - 1] = itmp1;
21607 0 : isuppz[p * 2] = itmp2;
21608 : }
21609 0 : ndone += newsiz;
21610 : }
21611 : }
21612 0 : newfrs = j + 1;
21613 : }
21614 : }
21615 0 : ++ndepth;
21616 0 : goto L40;
21617 : }
21618 0 : j = wbegin << 1;
21619 : i__2 = wend;
21620 0 : for (i__ = wbegin; i__ <= i__2; ++i__) {
21621 0 : isuppz[j - 1] += oldien;
21622 0 : isuppz[j] += oldien;
21623 0 : j += 2;
21624 :
21625 : }
21626 0 : ibegin = iend + 1;
21627 0 : wbegin = wend + 1;
21628 : }
21629 :
21630 : return;
21631 :
21632 : }
21633 : }
21634 : }
21635 : #include <cmath>
21636 : #include "lapack.h"
21637 : #include "lapack_limits.h"
21638 :
21639 : #include "real.h"
21640 :
21641 : #include "blas/blas.h"
21642 : namespace PLMD{
21643 : namespace lapack{
21644 : using namespace blas;
21645 : void
21646 0 : PLUMED_BLAS_F77_FUNC(slartg,SLARTG)(float *f,
21647 : float *g,
21648 : float *cs,
21649 : float *sn,
21650 : float *r)
21651 : {
21652 : float minval,safemin, safemin2, safemx2, eps;
21653 : float f1,g1,f1a,g1a,scale;
21654 : int i,n,count;
21655 :
21656 : eps = PLUMED_GMX_FLOAT_EPS;
21657 : minval = PLUMED_GMX_FLOAT_MIN;
21658 : safemin = minval*(1.0+eps);
21659 : n = static_cast<int>(0.5*std::log( safemin/eps ) / std::log(2.0));
21660 : safemin2 = std::pow(static_cast<float>(2.0),static_cast<float>(n));
21661 :
21662 : safemx2 = 1.0 / safemin2;
21663 :
21664 0 : if(std::abs(*g)<PLUMED_GMX_FLOAT_MIN) {
21665 0 : *cs = 1.0;
21666 0 : *sn = 0.0;
21667 0 : *r = *f;
21668 0 : } else if (std::abs(*f)<PLUMED_GMX_FLOAT_MIN) {
21669 0 : *cs = 0.0;
21670 0 : *sn = 1.0;
21671 0 : *r = *g;
21672 : } else {
21673 : f1 = *f;
21674 : g1 = *g;
21675 : f1a = std::abs(f1);
21676 : g1a = std::abs(g1);
21677 0 : scale = (f1a > g1a) ? f1a : g1a;
21678 0 : if(scale >= safemx2) {
21679 : count = 0;
21680 0 : while(scale >= safemx2) {
21681 0 : count++;
21682 0 : f1 *= safemin2;
21683 0 : g1 *= safemin2;
21684 : f1a = std::abs(f1);
21685 : g1a = std::abs(g1);
21686 0 : scale = (f1a > g1a) ? f1a : g1a;
21687 : }
21688 0 : *r = std::sqrt(f1*f1 + g1*g1);
21689 0 : *cs = f1 / *r;
21690 0 : *sn = g1 / *r;
21691 0 : for(i=0;i<count;i++)
21692 0 : *r *= safemx2;
21693 0 : } else if (scale<=safemin2) {
21694 : count = 0;
21695 0 : while(scale <= safemin2) {
21696 0 : count++;
21697 0 : f1 *= safemx2;
21698 0 : g1 *= safemx2;
21699 : f1a = std::abs(f1);
21700 : g1a = std::abs(g1);
21701 0 : scale = (f1a > g1a) ? f1a : g1a;
21702 : }
21703 0 : *r = std::sqrt(f1*f1 + g1*g1);
21704 0 : *cs = f1 / *r;
21705 0 : *sn = g1 / *r;
21706 0 : for(i=0;i<count;i++)
21707 0 : *r *= safemin2;
21708 : } else {
21709 0 : *r = std::sqrt(f1*f1 + g1*g1);
21710 0 : *cs = f1 / *r;
21711 0 : *sn = g1 / *r;
21712 : }
21713 0 : if(std::abs(*f)>std::abs(*g) && *cs<0.0) {
21714 0 : *cs *= -1.0;
21715 0 : *sn *= -1.0;
21716 0 : *r *= -1.0;
21717 : }
21718 : }
21719 0 : return;
21720 : }
21721 :
21722 : }
21723 : }
21724 : #include <cmath>
21725 : #include "lapack.h"
21726 :
21727 : #include "blas/blas.h"
21728 : namespace PLMD{
21729 : namespace lapack{
21730 : using namespace blas;
21731 : void
21732 0 : PLUMED_BLAS_F77_FUNC(slaruv,SLARUV)(int *iseed, int *n, float *x)
21733 : {
21734 : const int
21735 0 : mm[512] = {
21736 : 494,2637,255,2008,1253,
21737 : 3344,4084,1739,3143,3468,688,1657,1238,3166,1292,3422,1270,2016,
21738 : 154,2862,697,1706,491,931,1444,444,3577,3944,2184,1661,3482,657,
21739 : 3023,3618,1267,1828,164,3798,3087,2400,2870,3876,1905,1593,1797,
21740 : 1234,3460,328,2861,1950,617,2070,3331,769,1558,2412,2800,189,287,
21741 : 2045,1227,2838,209,2770,3654,3993,192,2253,3491,2889,2857,2094,
21742 : 1818,688,1407,634,3231,815,3524,1914,516,164,303,2144,3480,119,
21743 : 3357,837,2826,2332,2089,3780,1700,3712,150,2000,3375,1621,3090,
21744 : 3765,1149,3146,33,3082,2741,359,3316,1749,185,2784,2202,2199,1364,
21745 : 1244,2020,3160,2785,2772,1217,1822,1245,2252,3904,2774,997,2573,
21746 : 1148,545,322,789,1440,752,2859,123,1848,643,2405,2638,2344,46,
21747 : 3814,913,3649,339,3808,822,2832,3078,3633,2970,637,2249,2081,4019,
21748 : 1478,242,481,2075,4058,622,3376,812,234,641,4005,1122,3135,2640,
21749 : 2302,40,1832,2247,2034,2637,1287,1691,496,1597,2394,2584,1843,336,
21750 : 1472,2407,433,2096,1761,2810,566,442,41,1238,1086,603,840,3168,
21751 : 1499,1084,3438,2408,1589,2391,288,26,512,1456,171,1677,2657,2270,
21752 : 2587,2961,1970,1817,676,1410,3723,2803,3185,184,663,499,3784,1631,
21753 : 1925,3912,1398,1349,1441,2224,2411,1907,3192,2786,382,37,759,2948,
21754 : 1862,3802,2423,2051,2295,1332,1832,2405,3638,3661,327,3660,716,
21755 : 1842,3987,1368,1848,2366,2508,3754,1766,3572,2893,307,1297,3966,
21756 : 758,2598,3406,2922,1038,2934,2091,2451,1580,1958,2055,1507,1078,
21757 : 3273,17,854,2916,3971,2889,3831,2621,1541,893,736,3992,787,2125,
21758 : 2364,2460,257,1574,3912,1216,3248,3401,2124,2762,149,2245,166,466,
21759 : 4018,1399,190,2879,153,2320,18,712,2159,2318,2091,3443,1510,449,
21760 : 1956,2201,3137,3399,1321,2271,3667,2703,629,2365,2431,1113,3922,
21761 : 2554,184,2099,3228,4012,1921,3452,3901,572,3309,3171,817,3039,
21762 : 1696,1256,3715,2077,3019,1497,1101,717,51,981,1978,1813,3881,76,
21763 : 3846,3694,1682,124,1660,3997,479,1141,886,3514,1301,3604,1888,
21764 : 1836,1990,2058,692,1194,20,3285,2046,2107,3508,3525,3801,2549,
21765 : 1145,2253,305,3301,1065,3133,2913,3285,1241,1197,3729,2501,1673,
21766 : 541,2753,949,2361,1165,4081,2725,3305,3069,3617,3733,409,2157,
21767 : 1361,3973,1865,2525,1409,3445,3577,77,3761,2149,1449,3005,225,85,
21768 : 3673,3117,3089,1349,2057,413,65,1845,697,3085,3441,1573,3689,2941,
21769 : 929,533,2841,4077,721,2821,2249,2397,2817,245,1913,1997,3121,997,
21770 : 1833,2877,1633,981,2009,941,2449,197,2441,285,1473,2741,3129,909,
21771 : 2801,421,4073,2813,2337,1429,1177,1901,81,1669,2633,2269,129,1141,
21772 : 249,3917,2481,3941,2217,2749,3041,1877,345,2861,1809,3141,2825,
21773 : 157,2881,3637,1465,2829,2161,3365,361,2685,3745,2325,3609,3821,
21774 : 3537,517,3017,2141,1537
21775 : };
21776 :
21777 : int i__1;
21778 :
21779 : int i__, i1, i2, i3, i4, it1, it2, it3, it4;
21780 :
21781 :
21782 : --iseed;
21783 : --x;
21784 :
21785 : it1 = it2 = it3 = it4 = 0;
21786 :
21787 0 : i1 = iseed[1];
21788 0 : i2 = iseed[2];
21789 0 : i3 = iseed[3];
21790 0 : i4 = iseed[4];
21791 :
21792 0 : i__1 = (*n<128) ? *n : 128;
21793 0 : for (i__ = 1; i__ <= i__1; ++i__) {
21794 :
21795 0 : it4 = i4 * mm[i__ + 383];
21796 0 : it3 = it4 / 4096;
21797 0 : it4 -= it3 << 12;
21798 0 : it3 = it3 + i3 * mm[i__ + 383] + i4 * mm[i__ + 255];
21799 0 : it2 = it3 / 4096;
21800 0 : it3 -= it2 << 12;
21801 0 : it2 = it2 + i2 * mm[i__ + 383] + i3 * mm[i__ + 255] +
21802 0 : i4 * mm[i__ + 127];
21803 0 : it1 = it2 / 4096;
21804 0 : it2 -= it1 << 12;
21805 0 : it1 = it1 + i1 * mm[i__ + 383] + i2 * mm[i__ + 255] +
21806 0 : i3 * mm[i__ + 127] + i4 * mm[i__ - 1];
21807 0 : it1 %= 4096;
21808 :
21809 0 : x[i__] = ((float) it1 + ((float) it2 + ((float) it3 + (
21810 0 : float) it4 * 2.44140625e-4) * 2.44140625e-4) *
21811 0 : 2.44140625e-4) * 2.44140625e-4;
21812 : }
21813 :
21814 0 : iseed[1] = it1;
21815 0 : iseed[2] = it2;
21816 0 : iseed[3] = it3;
21817 0 : iseed[4] = it4;
21818 0 : return;
21819 :
21820 : }
21821 : }
21822 : }
21823 : #include <cmath>
21824 : #include "real.h"
21825 :
21826 : #include "lapack.h"
21827 :
21828 : #include "blas/blas.h"
21829 : namespace PLMD{
21830 : namespace lapack{
21831 : using namespace blas;
21832 : void
21833 0 : PLUMED_BLAS_F77_FUNC(slas2,SLAS2)(float *f,
21834 : float *g,
21835 : float *h,
21836 : float *ssmin,
21837 : float *ssmax)
21838 : {
21839 0 : float fa = std::abs(*f);
21840 0 : float ga = std::abs(*g);
21841 0 : float ha = std::abs(*h);
21842 : float fhmin,fhmax,tmax,tmin,tmp1,tmp2;
21843 : float as,at,au,c;
21844 :
21845 0 : fhmin = (fa<ha) ? fa : ha;
21846 0 : fhmax = (fa>ha) ? fa : ha;
21847 :
21848 0 : if(std::abs(fhmin)<PLUMED_GMX_FLOAT_MIN) {
21849 0 : *ssmin = 0.0;
21850 0 : if(std::abs(fhmax)<PLUMED_GMX_FLOAT_MIN)
21851 0 : *ssmax = ga;
21852 : else {
21853 0 : tmax = (fhmax>ga) ? fhmax : ga;
21854 0 : tmin = (fhmax<ga) ? fhmax : ga;
21855 0 : tmp1 = tmin / tmax;
21856 0 : tmp1 = tmp1 * tmp1;
21857 0 : *ssmax = tmax* std::sqrt(1.0 + tmp1);
21858 : }
21859 : } else {
21860 0 : if(ga<fhmax) {
21861 0 : as = 1.0 + fhmin / fhmax;
21862 0 : at = (fhmax-fhmin) / fhmax;
21863 0 : au = (ga/fhmax);
21864 0 : au = au * au;
21865 0 : c = 2.0 / ( std::sqrt(as*as+au) + std::sqrt(at*at+au) );
21866 0 : *ssmin = fhmin * c;
21867 0 : *ssmax = fhmax / c;
21868 : } else {
21869 0 : au = fhmax / ga;
21870 0 : if(std::abs(au)<PLUMED_GMX_FLOAT_MIN) {
21871 0 : *ssmin = (fhmin*fhmax)/ga;
21872 0 : *ssmax = ga;
21873 : } else {
21874 0 : as = 1.0 + fhmin / fhmax;
21875 0 : at = (fhmax-fhmin)/fhmax;
21876 0 : tmp1 = as*au;
21877 0 : tmp2 = at*au;
21878 0 : c = 1.0 / ( std::sqrt(1.0+tmp1*tmp1) + std::sqrt(1.0+tmp2*tmp2));
21879 0 : *ssmin = (fhmin*c)*au;
21880 0 : *ssmin = *ssmin + *ssmin;
21881 0 : *ssmax = ga / (c+c);
21882 : }
21883 : }
21884 : }
21885 0 : return;
21886 : }
21887 : }
21888 : }
21889 : #include <cctype>
21890 : #include <cmath>
21891 : #include "real.h"
21892 :
21893 : #include "lapack.h"
21894 : #include "lapack_limits.h"
21895 :
21896 :
21897 : #include "blas/blas.h"
21898 : namespace PLMD{
21899 : namespace lapack{
21900 : using namespace blas;
21901 : void
21902 0 : PLUMED_BLAS_F77_FUNC(slascl,SLASCL)(const char *type,
21903 : int *kl,
21904 : int *ku,
21905 : float *cfrom,
21906 : float *cto,
21907 : int *m,
21908 : int *n,
21909 : float *a,
21910 : int *lda,
21911 : int *info)
21912 : {
21913 0 : const char ch=std::toupper(*type);
21914 : int i,j,k,l,k1,k2,k3,k4;
21915 : int done=0;
21916 : float minval,smlnum,bignum;
21917 : float cfromc, ctoc, cfrom1, cto1, mul;
21918 :
21919 0 : if(*n<=0 || *m<=0)
21920 : return;
21921 :
21922 : minval = PLUMED_GMX_FLOAT_MIN;
21923 : smlnum = minval / PLUMED_GMX_FLOAT_EPS;
21924 : bignum = 1.0 / smlnum;
21925 :
21926 0 : cfromc = *cfrom;
21927 0 : ctoc = *cto;
21928 :
21929 0 : while(!done) {
21930 :
21931 0 : cfrom1 = cfromc * smlnum;
21932 0 : cto1 = ctoc / bignum;
21933 :
21934 0 : if(std::abs(cfrom1)>std::abs(ctoc) && std::abs(ctoc)>PLUMED_GMX_FLOAT_MIN) {
21935 : mul = smlnum;
21936 : done = 0;
21937 : cfromc = cfrom1;
21938 0 : } else if(std::abs(cto1)>std::abs(cfromc)) {
21939 : mul = bignum;
21940 : done = 0;
21941 : ctoc = cto1;
21942 : } else {
21943 0 : mul = ctoc / cfromc;
21944 : done = 1;
21945 : }
21946 :
21947 0 : switch(ch) {
21948 : case 'G':
21949 : /* Full matrix */
21950 0 : for(j=0;j<*n;j++)
21951 0 : for(i=0;i<*m;i++)
21952 0 : a[j*(*lda)+i] *= mul;
21953 : break;
21954 :
21955 : case 'L':
21956 : /* Lower triangular matrix */
21957 0 : for(j=0;j<*n;j++)
21958 0 : for(i=j;i<*m;i++)
21959 0 : a[j*(*lda)+i] *= mul;
21960 : break;
21961 :
21962 : case 'U':
21963 : /* Upper triangular matrix */
21964 0 : for(j=0;j<*n;j++) {
21965 0 : k = (j < (*m-1)) ? j : (*m-1);
21966 0 : for(i=0;i<=k;i++)
21967 0 : a[j*(*lda)+i] *= mul;
21968 : }
21969 : break;
21970 :
21971 : case 'H':
21972 : /* Upper Hessenberg matrix */
21973 0 : for(j=0;j<*n;j++) {
21974 0 : k = ((j+1) < (*m-1)) ? (j+1) : (*m-1);
21975 0 : for(i=0;i<=k;i++)
21976 0 : a[j*(*lda)+i] *= mul;
21977 : }
21978 : break;
21979 :
21980 0 : case 'B':
21981 : /* Symmetric band matrix, lower bandwidth KL, upper KU,
21982 : * only the lower half stored.
21983 : */
21984 0 : k3 = *kl;
21985 0 : k4 = *n - 1;
21986 0 : for(j=0;j<*n;j++) {
21987 0 : k = (k3 < (k4-j)) ? k3 : (k4-j);
21988 0 : for(i=0;i<=k;i++)
21989 0 : a[j*(*lda)+i] *= mul;
21990 : }
21991 : break;
21992 :
21993 0 : case 'Q':
21994 : /* Symmetric band matrix, lower bandwidth KL, upper KU,
21995 : * only the upper half stored.
21996 : */
21997 0 : k1 = *ku;
21998 : k3 = *ku;
21999 0 : for(j=0;j<*n;j++) {
22000 0 : k = ((k1-j) > 0) ? (k1-j) : 0;
22001 0 : for(i=k;i<=k3;i++)
22002 0 : a[j*(*lda)+i] *= mul;
22003 : }
22004 : break;
22005 :
22006 0 : case 'Z':
22007 : /* Band matrix, lower bandwidth KL, upper KU. */
22008 :
22009 0 : k1 = *kl + *ku;
22010 : k2 = *kl;
22011 0 : k3 = 2*(*kl) + *ku;
22012 0 : k4 = *kl + *ku - 1 + *m;
22013 0 : for(j=0;j<*n;j++) {
22014 0 : k = ((k1-j) > k2) ? (k1-j) : k2;
22015 0 : l = (k3 < (k4-j)) ? k3 : (k4-j);
22016 0 : for(i=k;i<=l;i++)
22017 0 : a[j*(*lda)+i] *= mul;
22018 : }
22019 : break;
22020 :
22021 0 : default:
22022 0 : *info = -1;
22023 0 : return;
22024 : }
22025 : } /* finished */
22026 :
22027 0 : *info = 0;
22028 0 : return;
22029 : }
22030 : }
22031 : }
22032 : #include "lapack.h"
22033 :
22034 : #include "blas/blas.h"
22035 : namespace PLMD{
22036 : namespace lapack{
22037 : using namespace blas;
22038 : void
22039 0 : PLUMED_BLAS_F77_FUNC(slasd0,SLASD0)(int *n,
22040 : int *sqre,
22041 : float *d__,
22042 : float *e,
22043 : float *u,
22044 : int *ldu,
22045 : float *vt,
22046 : int *ldvt,
22047 : int *smlsiz,
22048 : int *iwork,
22049 : float *work,
22050 : int *info)
22051 : {
22052 : int u_dim1, u_offset, vt_dim1, vt_offset, i__1, i__2;
22053 :
22054 : int i__, j, m, i1, ic, lf, nd, ll, nl, nr, im1, ncc, nlf, nrf,
22055 : iwk, lvl, ndb1, nlp1, nrp1;
22056 : float beta;
22057 : int idxq, nlvl;
22058 : float alpha;
22059 : int inode, ndiml, idxqc, ndimr, itemp, sqrei;
22060 0 : int c__0 = 0;
22061 :
22062 :
22063 0 : --d__;
22064 0 : --e;
22065 0 : u_dim1 = *ldu;
22066 0 : u_offset = 1 + u_dim1;
22067 0 : u -= u_offset;
22068 0 : vt_dim1 = *ldvt;
22069 0 : vt_offset = 1 + vt_dim1;
22070 0 : vt -= vt_offset;
22071 0 : --iwork;
22072 : --work;
22073 :
22074 0 : *info = 0;
22075 :
22076 0 : if (*n < 0) {
22077 0 : *info = -1;
22078 0 : } else if (*sqre < 0 || *sqre > 1) {
22079 0 : *info = -2;
22080 : }
22081 :
22082 0 : m = *n + *sqre;
22083 :
22084 0 : if (*ldu < *n) {
22085 0 : *info = -6;
22086 0 : } else if (*ldvt < m) {
22087 0 : *info = -8;
22088 0 : } else if (*smlsiz < 3) {
22089 0 : *info = -9;
22090 : }
22091 0 : if (*info != 0) {
22092 : return;
22093 : }
22094 :
22095 0 : if (*n <= *smlsiz) {
22096 0 : PLUMED_BLAS_F77_FUNC(slasdq,SLASDQ)("U", sqre, n, &m, n, &c__0, &d__[1], &e[1], &vt[vt_offset],
22097 : ldvt, &u[u_offset], ldu, &u[u_offset], ldu, &work[1], info);
22098 0 : return;
22099 : }
22100 :
22101 : inode = 1;
22102 0 : ndiml = inode + *n;
22103 0 : ndimr = ndiml + *n;
22104 0 : idxq = ndimr + *n;
22105 0 : iwk = idxq + *n;
22106 0 : PLUMED_BLAS_F77_FUNC(slasdt,SLASDT)(n, &nlvl, &nd, &iwork[inode], &iwork[ndiml], &iwork[ndimr],
22107 : smlsiz);
22108 :
22109 0 : ndb1 = (nd + 1) / 2;
22110 0 : ncc = 0;
22111 : i__1 = nd;
22112 0 : for (i__ = ndb1; i__ <= i__1; ++i__) {
22113 :
22114 0 : i1 = i__ - 1;
22115 0 : ic = iwork[inode + i1];
22116 0 : nl = iwork[ndiml + i1];
22117 0 : nlp1 = nl + 1;
22118 0 : nr = iwork[ndimr + i1];
22119 0 : nrp1 = nr + 1;
22120 0 : nlf = ic - nl;
22121 0 : nrf = ic + 1;
22122 0 : sqrei = 1;
22123 0 : PLUMED_BLAS_F77_FUNC(slasdq,SLASDQ)("U", &sqrei, &nl, &nlp1, &nl, &ncc, &d__[nlf], &e[nlf], &vt[
22124 0 : nlf + nlf * vt_dim1], ldvt, &u[nlf + nlf * u_dim1], ldu, &u[
22125 0 : nlf + nlf * u_dim1], ldu, &work[1], info);
22126 0 : if (*info != 0) {
22127 : return;
22128 : }
22129 0 : itemp = idxq + nlf - 2;
22130 0 : i__2 = nl;
22131 0 : for (j = 1; j <= i__2; ++j) {
22132 0 : iwork[itemp + j] = j;
22133 : }
22134 0 : if (i__ == nd) {
22135 0 : sqrei = *sqre;
22136 : } else {
22137 0 : sqrei = 1;
22138 : }
22139 0 : nrp1 = nr + sqrei;
22140 0 : PLUMED_BLAS_F77_FUNC(slasdq,SLASDQ)("U", &sqrei, &nr, &nrp1, &nr, &ncc, &d__[nrf], &e[nrf], &vt[
22141 0 : nrf + nrf * vt_dim1], ldvt, &u[nrf + nrf * u_dim1], ldu, &u[
22142 0 : nrf + nrf * u_dim1], ldu, &work[1], info);
22143 0 : if (*info != 0) {
22144 : return;
22145 : }
22146 0 : itemp = idxq + ic;
22147 0 : i__2 = nr;
22148 0 : for (j = 1; j <= i__2; ++j) {
22149 0 : iwork[itemp + j - 1] = j;
22150 : }
22151 : }
22152 :
22153 0 : for (lvl = nlvl; lvl >= 1; --lvl) {
22154 :
22155 0 : if (lvl == 1) {
22156 : lf = 1;
22157 : ll = 1;
22158 : } else {
22159 0 : i__1 = lvl - 1;
22160 0 : lf = (1 << i__1);
22161 0 : ll = (lf << 1) - 1;
22162 : }
22163 : i__1 = ll;
22164 0 : for (i__ = lf; i__ <= i__1; ++i__) {
22165 0 : im1 = i__ - 1;
22166 0 : ic = iwork[inode + im1];
22167 0 : nl = iwork[ndiml + im1];
22168 0 : nr = iwork[ndimr + im1];
22169 0 : nlf = ic - nl;
22170 0 : if (*sqre == 0 && i__ == ll) {
22171 0 : sqrei = *sqre;
22172 : } else {
22173 0 : sqrei = 1;
22174 : }
22175 0 : idxqc = idxq + nlf - 1;
22176 0 : alpha = d__[ic];
22177 0 : beta = e[ic];
22178 0 : PLUMED_BLAS_F77_FUNC(slasd1,SLASD1)(&nl, &nr, &sqrei, &d__[nlf], &alpha, &beta, &u[nlf + nlf *
22179 0 : u_dim1], ldu, &vt[nlf + nlf * vt_dim1], ldvt, &iwork[
22180 0 : idxqc], &iwork[iwk], &work[1], info);
22181 0 : if (*info != 0) {
22182 : return;
22183 : }
22184 : }
22185 : }
22186 :
22187 : return;
22188 :
22189 : }
22190 : }
22191 : }
22192 : #include <cmath>
22193 : #include "lapack.h"
22194 :
22195 : #include "blas/blas.h"
22196 : namespace PLMD{
22197 : namespace lapack{
22198 : using namespace blas;
22199 : void
22200 0 : PLUMED_BLAS_F77_FUNC(slasd1,SLASD1)(int *nl,
22201 : int *nr,
22202 : int *sqre,
22203 : float *d__,
22204 : float *alpha,
22205 : float *beta,
22206 : float *u,
22207 : int *ldu,
22208 : float *vt,
22209 : int *ldvt,
22210 : int *idxq,
22211 : int *iwork,
22212 : float *work,
22213 : int *info)
22214 : {
22215 : int u_dim1, u_offset, vt_dim1, vt_offset, i__1;
22216 : float d__1, d__2;
22217 :
22218 : int i__, k, m, n, n1, n2, iq, iz, iu2, ldq, idx, ldu2, ivt2,
22219 : idxc, idxp, ldvt2;
22220 : int isigma;
22221 : float orgnrm;
22222 : int coltyp;
22223 0 : int c__0 = 0;
22224 0 : float one = 1.0;
22225 0 : int c__1 = 1;
22226 0 : int c_n1 = -1;
22227 :
22228 0 : --d__;
22229 : u_dim1 = *ldu;
22230 : u_offset = 1 + u_dim1;
22231 : u -= u_offset;
22232 : vt_dim1 = *ldvt;
22233 : vt_offset = 1 + vt_dim1;
22234 : vt -= vt_offset;
22235 : --idxq;
22236 0 : --iwork;
22237 0 : --work;
22238 :
22239 0 : *info = 0;
22240 :
22241 0 : if (*nl < 1) {
22242 0 : *info = -1;
22243 0 : } else if (*nr < 1) {
22244 0 : *info = -2;
22245 0 : } else if (*sqre < 0 || *sqre > 1) {
22246 0 : *info = -3;
22247 : }
22248 0 : if (*info != 0) {
22249 : return;
22250 : }
22251 :
22252 0 : n = *nl + *nr + 1;
22253 0 : m = n + *sqre;
22254 :
22255 :
22256 0 : ldu2 = n;
22257 0 : ldvt2 = m;
22258 :
22259 : iz = 1;
22260 0 : isigma = iz + m;
22261 0 : iu2 = isigma + n;
22262 0 : ivt2 = iu2 + ldu2 * n;
22263 0 : iq = ivt2 + ldvt2 * m;
22264 :
22265 : idx = 1;
22266 0 : idxc = idx + n;
22267 0 : coltyp = idxc + n;
22268 0 : idxp = coltyp + n;
22269 :
22270 0 : d__1 = std::abs(*alpha);
22271 0 : d__2 = std::abs(*beta);
22272 0 : orgnrm = (d__1>d__2) ? d__1 : d__2;
22273 0 : d__[*nl + 1] = 0.;
22274 : i__1 = n;
22275 0 : for (i__ = 1; i__ <= i__1; ++i__) {
22276 0 : if (std::abs(d__[i__]) > orgnrm) {
22277 0 : orgnrm = std::abs(d__[i__]);
22278 : }
22279 : }
22280 0 : PLUMED_BLAS_F77_FUNC(slascl,SLASCL)("G", &c__0, &c__0, &orgnrm, &one, &n, &c__1, &d__[1], &n, info);
22281 0 : *alpha /= orgnrm;
22282 0 : *beta /= orgnrm;
22283 :
22284 0 : PLUMED_BLAS_F77_FUNC(slasd2,SLASD2)(nl, nr, sqre, &k, &d__[1], &work[iz], alpha, beta, &u[u_offset],
22285 0 : ldu, &vt[vt_offset], ldvt, &work[isigma], &work[iu2], &ldu2, &
22286 0 : work[ivt2], &ldvt2, &iwork[idxp], &iwork[idx], &iwork[idxc], &
22287 0 : idxq[1], &iwork[coltyp], info);
22288 :
22289 0 : ldq = k;
22290 0 : PLUMED_BLAS_F77_FUNC(slasd3,SLASD3)(nl, nr, sqre, &k, &d__[1], &work[iq], &ldq, &work[isigma], &u[
22291 : u_offset], ldu, &work[iu2], &ldu2, &vt[vt_offset], ldvt, &work[
22292 : ivt2], &ldvt2, &iwork[idxc], &iwork[coltyp], &work[iz], info);
22293 0 : if (*info != 0) {
22294 : return;
22295 : }
22296 0 : PLUMED_BLAS_F77_FUNC(slascl,SLASCL)("G", &c__0, &c__0, &one, &orgnrm, &n, &c__1, &d__[1], &n, info);
22297 :
22298 0 : n1 = k;
22299 0 : n2 = n - k;
22300 0 : PLUMED_BLAS_F77_FUNC(slamrg,SLAMRG)(&n1, &n2, &d__[1], &c__1, &c_n1, &idxq[1]);
22301 :
22302 : return;
22303 :
22304 : }
22305 : }
22306 : }
22307 : #include <cmath>
22308 : #include "blas/blas.h"
22309 : #include "lapack.h"
22310 : #include "lapack_limits.h"
22311 :
22312 : #include "real.h"
22313 :
22314 : #include "blas/blas.h"
22315 : namespace PLMD{
22316 : namespace lapack{
22317 : using namespace blas;
22318 : void
22319 0 : PLUMED_BLAS_F77_FUNC(slasd2,SLASD2)(int *nl,
22320 : int *nr,
22321 : int *sqre,
22322 : int *k,
22323 : float *d__,
22324 : float *z__,
22325 : float *alpha,
22326 : float *beta,
22327 : float *u,
22328 : int *ldu,
22329 : float *vt,
22330 : int *ldvt,
22331 : float *dsigma,
22332 : float *u2,
22333 : int *ldu2,
22334 : float *vt2,
22335 : int *ldvt2,
22336 : int *idxp,
22337 : int *idx,
22338 : int *idxc,
22339 : int *idxq,
22340 : int *coltyp,
22341 : int *info)
22342 : {
22343 : int u_dim1, u_offset, u2_dim1, u2_offset, vt_dim1, vt_offset;
22344 : int vt2_dim1, vt2_offset, i__1;
22345 : float d__1, d__2;
22346 :
22347 : float c__;
22348 : int i__, j, m, n;
22349 : float s;
22350 : int k2;
22351 : float z1;
22352 : int ct, jp;
22353 : float eps, tau, tol;
22354 : int psm[4], nlp1, nlp2, idxi, idxj;
22355 : int ctot[4], idxjp;
22356 : int jprev = 0;
22357 : float hlftol;
22358 0 : float zero = 0.0;
22359 0 : int c__1 = 1;
22360 :
22361 :
22362 0 : --d__;
22363 0 : --z__;
22364 0 : u_dim1 = *ldu;
22365 0 : u_offset = 1 + u_dim1;
22366 0 : u -= u_offset;
22367 0 : vt_dim1 = *ldvt;
22368 0 : vt_offset = 1 + vt_dim1;
22369 0 : vt -= vt_offset;
22370 0 : --dsigma;
22371 0 : u2_dim1 = *ldu2;
22372 0 : u2_offset = 1 + u2_dim1;
22373 0 : u2 -= u2_offset;
22374 0 : vt2_dim1 = *ldvt2;
22375 0 : vt2_offset = 1 + vt2_dim1;
22376 0 : vt2 -= vt2_offset;
22377 0 : --idxp;
22378 0 : --idx;
22379 0 : --idxc;
22380 0 : --idxq;
22381 0 : --coltyp;
22382 :
22383 0 : *info = 0;
22384 :
22385 0 : n = *nl + *nr + 1;
22386 0 : m = n + *sqre;
22387 :
22388 0 : nlp1 = *nl + 1;
22389 0 : nlp2 = *nl + 2;
22390 :
22391 0 : z1 = *alpha * vt[nlp1 + nlp1 * vt_dim1];
22392 0 : z__[1] = z1;
22393 0 : for (i__ = *nl; i__ >= 1; --i__) {
22394 0 : z__[i__ + 1] = *alpha * vt[i__ + nlp1 * vt_dim1];
22395 0 : d__[i__ + 1] = d__[i__];
22396 0 : idxq[i__ + 1] = idxq[i__] + 1;
22397 : }
22398 :
22399 : i__1 = m;
22400 0 : for (i__ = nlp2; i__ <= i__1; ++i__) {
22401 0 : z__[i__] = *beta * vt[i__ + nlp2 * vt_dim1];
22402 : }
22403 :
22404 : i__1 = nlp1;
22405 0 : for (i__ = 2; i__ <= i__1; ++i__) {
22406 0 : coltyp[i__] = 1;
22407 : }
22408 0 : i__1 = n;
22409 0 : for (i__ = nlp2; i__ <= i__1; ++i__) {
22410 0 : coltyp[i__] = 2;
22411 : }
22412 :
22413 : i__1 = n;
22414 0 : for (i__ = nlp2; i__ <= i__1; ++i__) {
22415 0 : idxq[i__] += nlp1;
22416 : }
22417 :
22418 : i__1 = n;
22419 0 : for (i__ = 2; i__ <= i__1; ++i__) {
22420 0 : dsigma[i__] = d__[idxq[i__]];
22421 0 : u2[i__ + u2_dim1] = z__[idxq[i__]];
22422 0 : idxc[i__] = coltyp[idxq[i__]];
22423 : }
22424 :
22425 0 : PLUMED_BLAS_F77_FUNC(slamrg,SLAMRG)(nl, nr, &dsigma[2], &c__1, &c__1, &idx[2]);
22426 :
22427 0 : i__1 = n;
22428 0 : for (i__ = 2; i__ <= i__1; ++i__) {
22429 0 : idxi = idx[i__] + 1;
22430 0 : d__[i__] = dsigma[idxi];
22431 0 : z__[i__] = u2[idxi + u2_dim1];
22432 0 : coltyp[i__] = idxc[idxi];
22433 : }
22434 :
22435 : eps = PLUMED_GMX_FLOAT_EPS;
22436 0 : d__1 = std::abs(*alpha), d__2 = std::abs(*beta);
22437 0 : tol = (d__1 > d__2) ? d__1 : d__2;
22438 0 : d__2 = std::abs(d__[n]);
22439 0 : tol = eps * 8. * ((d__2 > tol) ? d__2 : tol);
22440 :
22441 0 : *k = 1;
22442 0 : k2 = n + 1;
22443 : i__1 = n;
22444 0 : for (j = 2; j <= i__1; ++j) {
22445 0 : if (std::abs(z__[j]) <= tol) {
22446 :
22447 0 : --k2;
22448 0 : idxp[k2] = j;
22449 0 : coltyp[j] = 4;
22450 0 : if (j == n) {
22451 0 : goto L120;
22452 : }
22453 : } else {
22454 : jprev = j;
22455 0 : goto L90;
22456 : }
22457 : }
22458 0 : L90:
22459 : j = jprev;
22460 0 : L100:
22461 0 : ++j;
22462 0 : if (j > n) {
22463 0 : goto L110;
22464 : }
22465 0 : if (std::abs(z__[j]) <= tol) {
22466 :
22467 0 : --k2;
22468 0 : idxp[k2] = j;
22469 0 : coltyp[j] = 4;
22470 : } else {
22471 :
22472 0 : if (std::abs(d__[j] - d__[jprev]) <= tol) {
22473 :
22474 0 : s = z__[jprev];
22475 0 : c__ = z__[j];
22476 :
22477 0 : tau = PLUMED_BLAS_F77_FUNC(slapy2,SLAPY2)(&c__, &s);
22478 0 : c__ /= tau;
22479 0 : s = -s / tau;
22480 0 : z__[j] = tau;
22481 0 : z__[jprev] = 0.;
22482 :
22483 0 : idxjp = idxq[idx[jprev] + 1];
22484 0 : idxj = idxq[idx[j] + 1];
22485 0 : if (idxjp <= nlp1) {
22486 0 : --idxjp;
22487 : }
22488 0 : if (idxj <= nlp1) {
22489 0 : --idxj;
22490 : }
22491 0 : PLUMED_BLAS_F77_FUNC(srot,SROT)(&n, &u[idxjp * u_dim1 + 1], &c__1, &u[idxj * u_dim1 + 1], &
22492 : c__1, &c__, &s);
22493 0 : PLUMED_BLAS_F77_FUNC(srot,SROT)(&m, &vt[idxjp + vt_dim1], ldvt, &vt[idxj + vt_dim1], ldvt, &
22494 : c__, &s);
22495 0 : if (coltyp[j] != coltyp[jprev]) {
22496 0 : coltyp[j] = 3;
22497 : }
22498 0 : coltyp[jprev] = 4;
22499 0 : --k2;
22500 0 : idxp[k2] = jprev;
22501 : jprev = j;
22502 : } else {
22503 0 : ++(*k);
22504 0 : u2[*k + u2_dim1] = z__[jprev];
22505 0 : dsigma[*k] = d__[jprev];
22506 0 : idxp[*k] = jprev;
22507 : jprev = j;
22508 : }
22509 : }
22510 0 : goto L100;
22511 : L110:
22512 :
22513 0 : ++(*k);
22514 0 : u2[*k + u2_dim1] = z__[jprev];
22515 0 : dsigma[*k] = d__[jprev];
22516 0 : idxp[*k] = jprev;
22517 :
22518 : L120:
22519 :
22520 0 : for (j = 1; j <= 4; ++j) {
22521 0 : ctot[j - 1] = 0;
22522 : }
22523 0 : i__1 = n;
22524 0 : for (j = 2; j <= i__1; ++j) {
22525 0 : ct = coltyp[j];
22526 0 : ++ctot[ct - 1];
22527 : }
22528 :
22529 0 : psm[0] = 2;
22530 0 : psm[1] = ctot[0] + 2;
22531 0 : psm[2] = psm[1] + ctot[1];
22532 0 : psm[3] = psm[2] + ctot[2];
22533 :
22534 : i__1 = n;
22535 0 : for (j = 2; j <= i__1; ++j) {
22536 0 : jp = idxp[j];
22537 0 : ct = coltyp[jp];
22538 0 : idxc[psm[ct - 1]] = j;
22539 0 : ++psm[ct - 1];
22540 : }
22541 :
22542 : i__1 = n;
22543 0 : for (j = 2; j <= i__1; ++j) {
22544 0 : jp = idxp[j];
22545 0 : dsigma[j] = d__[jp];
22546 0 : idxj = idxq[idx[idxp[idxc[j]]] + 1];
22547 0 : if (idxj <= nlp1) {
22548 0 : --idxj;
22549 : }
22550 0 : PLUMED_BLAS_F77_FUNC(scopy,SCOPY)(&n, &u[idxj * u_dim1 + 1], &c__1, &u2[j * u2_dim1 + 1], &c__1);
22551 0 : PLUMED_BLAS_F77_FUNC(scopy,SCOPY)(&m, &vt[idxj + vt_dim1], ldvt, &vt2[j + vt2_dim1], ldvt2);
22552 : }
22553 :
22554 0 : dsigma[1] = 0.;
22555 0 : hlftol = tol / 2.;
22556 0 : if (std::abs(dsigma[2]) <= hlftol) {
22557 0 : dsigma[2] = hlftol;
22558 : }
22559 0 : if (m > n) {
22560 0 : z__[1] = PLUMED_BLAS_F77_FUNC(slapy2,SLAPY2)(&z1, &z__[m]);
22561 0 : if (z__[1] <= tol) {
22562 0 : c__ = 1.;
22563 0 : s = 0.;
22564 0 : z__[1] = tol;
22565 : } else {
22566 0 : c__ = z1 / z__[1];
22567 0 : s = z__[m] / z__[1];
22568 : }
22569 : } else {
22570 0 : if (std::abs(z1) <= tol) {
22571 0 : z__[1] = tol;
22572 : } else {
22573 0 : z__[1] = z1;
22574 : }
22575 : }
22576 :
22577 0 : i__1 = *k - 1;
22578 0 : PLUMED_BLAS_F77_FUNC(scopy,SCOPY)(&i__1, &u2[u2_dim1 + 2], &c__1, &z__[2], &c__1);
22579 :
22580 0 : PLUMED_BLAS_F77_FUNC(slaset,SLASET)("A", &n, &c__1, &zero, &zero, &u2[u2_offset], ldu2);
22581 0 : u2[nlp1 + u2_dim1] = 1.;
22582 0 : if (m > n) {
22583 : i__1 = nlp1;
22584 0 : for (i__ = 1; i__ <= i__1; ++i__) {
22585 0 : vt[m + i__ * vt_dim1] = -s * vt[nlp1 + i__ * vt_dim1];
22586 0 : vt2[i__ * vt2_dim1 + 1] = c__ * vt[nlp1 + i__ * vt_dim1];
22587 : }
22588 0 : i__1 = m;
22589 0 : for (i__ = nlp2; i__ <= i__1; ++i__) {
22590 0 : vt2[i__ * vt2_dim1 + 1] = s * vt[m + i__ * vt_dim1];
22591 0 : vt[m + i__ * vt_dim1] = c__ * vt[m + i__ * vt_dim1];
22592 : }
22593 : } else {
22594 0 : PLUMED_BLAS_F77_FUNC(scopy,SCOPY)(&m, &vt[nlp1 + vt_dim1], ldvt, &vt2[vt2_dim1 + 1], ldvt2);
22595 : }
22596 0 : if (m > n) {
22597 0 : PLUMED_BLAS_F77_FUNC(scopy,SCOPY)(&m, &vt[m + vt_dim1], ldvt, &vt2[m + vt2_dim1], ldvt2);
22598 : }
22599 :
22600 0 : if (n > *k) {
22601 0 : i__1 = n - *k;
22602 0 : PLUMED_BLAS_F77_FUNC(scopy,SCOPY)(&i__1, &dsigma[*k + 1], &c__1, &d__[*k + 1], &c__1);
22603 0 : i__1 = n - *k;
22604 0 : PLUMED_BLAS_F77_FUNC(slacpy,SLACPY)("A", &n, &i__1, &u2[(*k + 1) * u2_dim1 + 1], ldu2, &u[(*k + 1)
22605 0 : * u_dim1 + 1], ldu);
22606 0 : i__1 = n - *k;
22607 0 : PLUMED_BLAS_F77_FUNC(slacpy,SLACPY)("A", &i__1, &m, &vt2[*k + 1 + vt2_dim1], ldvt2, &vt[*k + 1 +
22608 0 : vt_dim1], ldvt);
22609 : }
22610 0 : for (j = 1; j <= 4; ++j) {
22611 0 : coltyp[j] = ctot[j - 1];
22612 : }
22613 :
22614 0 : return;
22615 :
22616 : }
22617 :
22618 :
22619 : }
22620 : }
22621 : #include <cmath>
22622 : #include "blas/blas.h"
22623 : #include "lapack.h"
22624 :
22625 : #include "blas/blas.h"
22626 : namespace PLMD{
22627 : namespace lapack{
22628 : using namespace blas;
22629 : void
22630 0 : PLUMED_BLAS_F77_FUNC(slasd3,SLASD3)(int *nl,
22631 : int *nr,
22632 : int *sqre,
22633 : int *k,
22634 : float *d__,
22635 : float *q,
22636 : int *ldq,
22637 : float *dsigma,
22638 : float *u,
22639 : int *ldu,
22640 : float *u2,
22641 : int *ldu2,
22642 : float *vt,
22643 : int *ldvt,
22644 : float *vt2,
22645 : int *ldvt2,
22646 : int *idxc,
22647 : int *ctot,
22648 : float *z__,
22649 : int *info)
22650 : {
22651 : int q_dim1, q_offset, u_dim1, u_offset, u2_dim1, u2_offset, vt_dim1,
22652 : vt_offset, vt2_dim1, vt2_offset, i__1, i__2;
22653 : float d__2;
22654 :
22655 : int i__, j, m, n, jc;
22656 : float rho;
22657 : int nlp1, nlp2, nrp1;
22658 : float temp;
22659 : int ctemp;
22660 : int ktemp;
22661 0 : int c__1 = 1;
22662 0 : int c__0 = 0;
22663 0 : float zero = 0.0;
22664 0 : float one = 1.0;
22665 :
22666 : --d__;
22667 0 : q_dim1 = *ldq;
22668 0 : q_offset = 1 + q_dim1;
22669 0 : q -= q_offset;
22670 0 : --dsigma;
22671 0 : u_dim1 = *ldu;
22672 0 : u_offset = 1 + u_dim1;
22673 0 : u -= u_offset;
22674 0 : u2_dim1 = *ldu2;
22675 0 : u2_offset = 1 + u2_dim1;
22676 0 : u2 -= u2_offset;
22677 0 : vt_dim1 = *ldvt;
22678 0 : vt_offset = 1 + vt_dim1;
22679 0 : vt -= vt_offset;
22680 0 : vt2_dim1 = *ldvt2;
22681 0 : vt2_offset = 1 + vt2_dim1;
22682 0 : vt2 -= vt2_offset;
22683 0 : --idxc;
22684 : --ctot;
22685 0 : --z__;
22686 :
22687 : /* Function Body */
22688 0 : *info = 0;
22689 :
22690 0 : if (*nl < 1) {
22691 0 : *info = -1;
22692 0 : } else if (*nr < 1) {
22693 0 : *info = -2;
22694 0 : } else if (*sqre != 1 && *sqre != 0) {
22695 0 : *info = -3;
22696 : }
22697 :
22698 0 : n = *nl + *nr + 1;
22699 0 : m = n + *sqre;
22700 0 : nlp1 = *nl + 1;
22701 0 : nlp2 = *nl + 2;
22702 :
22703 0 : if (*k == 1) {
22704 0 : d__[1] = std::abs(z__[1]);
22705 0 : PLUMED_BLAS_F77_FUNC(scopy,SCOPY)(&m, &vt2[vt2_dim1 + 1], ldvt2, &vt[vt_dim1 + 1], ldvt);
22706 0 : if (z__[1] > 0.) {
22707 0 : PLUMED_BLAS_F77_FUNC(scopy,SCOPY)(&n, &u2[u2_dim1 + 1], &c__1, &u[u_dim1 + 1], &c__1);
22708 : } else {
22709 0 : i__1 = n;
22710 0 : for (i__ = 1; i__ <= i__1; ++i__) {
22711 0 : u[i__ + u_dim1] = -u2[i__ + u2_dim1];
22712 : }
22713 : }
22714 0 : return;
22715 : }
22716 :
22717 0 : PLUMED_BLAS_F77_FUNC(scopy,SCOPY)(k, &z__[1], &c__1, &q[q_offset], &c__1);
22718 :
22719 0 : rho = PLUMED_BLAS_F77_FUNC(snrm2,SNRM2)(k, &z__[1], &c__1);
22720 0 : PLUMED_BLAS_F77_FUNC(slascl,SLASCL)("G", &c__0, &c__0, &rho, &one, k, &c__1, &z__[1], k, info);
22721 0 : rho *= rho;
22722 :
22723 :
22724 0 : i__1 = *k;
22725 0 : for (j = 1; j <= i__1; ++j) {
22726 0 : PLUMED_BLAS_F77_FUNC(slasd4,SLASD4)(k, &j, &dsigma[1], &z__[1], &u[j * u_dim1 + 1], &rho, &d__[j],
22727 0 : &vt[j * vt_dim1 + 1], info);
22728 :
22729 0 : if (*info != 0) {
22730 : return;
22731 : }
22732 : }
22733 :
22734 0 : i__1 = *k;
22735 0 : for (i__ = 1; i__ <= i__1; ++i__) {
22736 0 : z__[i__] = u[i__ + *k * u_dim1] * vt[i__ + *k * vt_dim1];
22737 : i__2 = i__ - 1;
22738 0 : for (j = 1; j <= i__2; ++j) {
22739 0 : z__[i__] *= u[i__ + j * u_dim1] * vt[i__ + j * vt_dim1] / (dsigma[
22740 0 : i__] - dsigma[j]) / (dsigma[i__] + dsigma[j]);
22741 : }
22742 0 : i__2 = *k - 1;
22743 0 : for (j = i__; j <= i__2; ++j) {
22744 0 : z__[i__] *= u[i__ + j * u_dim1] * vt[i__ + j * vt_dim1] / (dsigma[
22745 0 : i__] - dsigma[j + 1]) / (dsigma[i__] + dsigma[j + 1]);
22746 : }
22747 0 : d__2 = std::sqrt(std::abs(z__[i__]));
22748 0 : z__[i__] = (q[i__ + q_dim1] > 0) ? d__2 : -d__2;
22749 : }
22750 :
22751 0 : i__1 = *k;
22752 0 : for (i__ = 1; i__ <= i__1; ++i__) {
22753 0 : vt[i__ * vt_dim1 + 1] = z__[1] / u[i__ * u_dim1 + 1] / vt[i__ *
22754 0 : vt_dim1 + 1];
22755 0 : u[i__ * u_dim1 + 1] = -1.;
22756 0 : i__2 = *k;
22757 0 : for (j = 2; j <= i__2; ++j) {
22758 0 : vt[j + i__ * vt_dim1] = z__[j] / u[j + i__ * u_dim1] / vt[j + i__
22759 0 : * vt_dim1];
22760 0 : u[j + i__ * u_dim1] = dsigma[j] * vt[j + i__ * vt_dim1];
22761 : }
22762 0 : temp = PLUMED_BLAS_F77_FUNC(snrm2,SNRM2)(k, &u[i__ * u_dim1 + 1], &c__1);
22763 0 : q[i__ * q_dim1 + 1] = u[i__ * u_dim1 + 1] / temp;
22764 0 : i__2 = *k;
22765 0 : for (j = 2; j <= i__2; ++j) {
22766 0 : jc = idxc[j];
22767 0 : q[j + i__ * q_dim1] = u[jc + i__ * u_dim1] / temp;
22768 : }
22769 : }
22770 :
22771 0 : if (*k == 2) {
22772 0 : PLUMED_BLAS_F77_FUNC(sgemm,SGEMM)("N", "N", &n, k, k, &one, &u2[u2_offset], ldu2, &q[q_offset],
22773 : ldq, &zero, &u[u_offset], ldu);
22774 0 : goto L100;
22775 : }
22776 0 : if (ctot[1] > 0) {
22777 0 : PLUMED_BLAS_F77_FUNC(sgemm,SGEMM)("N", "N", nl, k, &ctot[1], &one, &u2[(u2_dim1 << 1) + 1],
22778 0 : ldu2, &q[q_dim1 + 2], ldq, &zero, &u[u_dim1 + 1], ldu);
22779 0 : if (ctot[3] > 0) {
22780 0 : ktemp = ctot[1] + 2 + ctot[2];
22781 0 : PLUMED_BLAS_F77_FUNC(sgemm,SGEMM)("N", "N", nl, k, &ctot[3], &one, &u2[ktemp * u2_dim1 + 1]
22782 0 : , ldu2, &q[ktemp + q_dim1], ldq, &one, &u[u_dim1 + 1],
22783 : ldu);
22784 : }
22785 0 : } else if (ctot[3] > 0) {
22786 0 : ktemp = ctot[1] + 2 + ctot[2];
22787 0 : PLUMED_BLAS_F77_FUNC(sgemm,SGEMM)("N", "N", nl, k, &ctot[3], &one, &u2[ktemp * u2_dim1 + 1],
22788 0 : ldu2, &q[ktemp + q_dim1], ldq, &zero, &u[u_dim1 + 1], ldu);
22789 : } else {
22790 0 : PLUMED_BLAS_F77_FUNC(slacpy,SLACPY)("F", nl, k, &u2[u2_offset], ldu2, &u[u_offset], ldu);
22791 : }
22792 0 : PLUMED_BLAS_F77_FUNC(scopy,SCOPY)(k, &q[q_dim1 + 1], ldq, &u[nlp1 + u_dim1], ldu);
22793 0 : ktemp = ctot[1] + 2;
22794 0 : ctemp = ctot[2] + ctot[3];
22795 0 : PLUMED_BLAS_F77_FUNC(sgemm,SGEMM)("N", "N", nr, k, &ctemp, &one, &u2[nlp2 + ktemp * u2_dim1], ldu2,
22796 0 : &q[ktemp + q_dim1], ldq, &zero, &u[nlp2 + u_dim1], ldu);
22797 :
22798 0 : L100:
22799 0 : i__1 = *k;
22800 0 : for (i__ = 1; i__ <= i__1; ++i__) {
22801 0 : temp = PLUMED_BLAS_F77_FUNC(snrm2,SNRM2)(k, &vt[i__ * vt_dim1 + 1], &c__1);
22802 0 : q[i__ + q_dim1] = vt[i__ * vt_dim1 + 1] / temp;
22803 0 : i__2 = *k;
22804 0 : for (j = 2; j <= i__2; ++j) {
22805 0 : jc = idxc[j];
22806 0 : q[i__ + j * q_dim1] = vt[jc + i__ * vt_dim1] / temp;
22807 : }
22808 : }
22809 :
22810 0 : if (*k == 2) {
22811 0 : PLUMED_BLAS_F77_FUNC(sgemm,SGEMM)("N", "N", k, &m, k, &one, &q[q_offset], ldq, &vt2[vt2_offset]
22812 : , ldvt2, &zero, &vt[vt_offset], ldvt);
22813 0 : return;
22814 : }
22815 0 : ktemp = ctot[1] + 1;
22816 0 : PLUMED_BLAS_F77_FUNC(sgemm,SGEMM)("N", "N", k, &nlp1, &ktemp, &one, &q[q_dim1 + 1], ldq, &vt2[
22817 0 : vt2_dim1 + 1], ldvt2, &zero, &vt[vt_dim1 + 1], ldvt);
22818 0 : ktemp = ctot[1] + 2 + ctot[2];
22819 0 : if (ktemp <= *ldvt2) {
22820 0 : PLUMED_BLAS_F77_FUNC(sgemm,SGEMM)("N", "N", k, &nlp1, &ctot[3], &one, &q[ktemp * q_dim1 + 1],
22821 0 : ldq, &vt2[ktemp + vt2_dim1], ldvt2, &one, &vt[vt_dim1 + 1],
22822 : ldvt);
22823 : }
22824 :
22825 0 : ktemp = ctot[1] + 1;
22826 0 : nrp1 = *nr + *sqre;
22827 0 : if (ktemp > 1) {
22828 0 : i__1 = *k;
22829 0 : for (i__ = 1; i__ <= i__1; ++i__) {
22830 0 : q[i__ + ktemp * q_dim1] = q[i__ + q_dim1];
22831 : }
22832 0 : i__1 = m;
22833 0 : for (i__ = nlp2; i__ <= i__1; ++i__) {
22834 0 : vt2[ktemp + i__ * vt2_dim1] = vt2[i__ * vt2_dim1 + 1];
22835 : }
22836 : }
22837 0 : ctemp = ctot[2] + 1 + ctot[3];
22838 0 : PLUMED_BLAS_F77_FUNC(sgemm,SGEMM)("N", "N", k, &nrp1, &ctemp, &one, &q[ktemp * q_dim1 + 1], ldq, &
22839 0 : vt2[ktemp + nlp2 * vt2_dim1], ldvt2, &zero, &vt[nlp2 * vt_dim1 +
22840 0 : 1], ldvt);
22841 :
22842 : return;
22843 :
22844 :
22845 : }
22846 :
22847 :
22848 : }
22849 : }
22850 : #include <cmath>
22851 : #include "lapack.h"
22852 : #include "lapack_limits.h"
22853 :
22854 : #include "real.h"
22855 :
22856 : #include "blas/blas.h"
22857 : namespace PLMD{
22858 : namespace lapack{
22859 : using namespace blas;
22860 : void
22861 0 : PLUMED_BLAS_F77_FUNC(slasd4,SLASD4)(int *n,
22862 : int *i__,
22863 : float *d__,
22864 : float *z__,
22865 : float *delta,
22866 : float *rho,
22867 : float *sigma,
22868 : float *work,
22869 : int *info)
22870 : {
22871 : int i__1;
22872 : float d__1;
22873 :
22874 : float a, b, c__;
22875 : int j;
22876 : float w, dd[3];
22877 : int ii;
22878 : float dw, zz[3];
22879 : int ip1;
22880 : float eta, phi, eps, tau, psi;
22881 : int iim1, iip1;
22882 : float dphi, dpsi;
22883 : int iter;
22884 : float temp, prew, sg2lb, sg2ub, temp1, temp2, dtiim, delsq,
22885 : dtiip;
22886 : int niter;
22887 : float dtisq;
22888 : int swtch;
22889 : float dtnsq;
22890 : float delsq2, dtnsq1;
22891 : int swtch3;
22892 : int orgati;
22893 : float erretm, dtipsq, rhoinv;
22894 :
22895 0 : --work;
22896 0 : --delta;
22897 0 : --z__;
22898 0 : --d__;
22899 :
22900 0 : *info = 0;
22901 0 : if (*n == 1) {
22902 :
22903 0 : *sigma = std::sqrt(d__[1] * d__[1] + *rho * z__[1] * z__[1]);
22904 0 : delta[1] = 1.;
22905 0 : work[1] = 1.;
22906 0 : return;
22907 : }
22908 0 : if (*n == 2) {
22909 0 : PLUMED_BLAS_F77_FUNC(slasd5,SLASD5)(i__, &d__[1], &z__[1], &delta[1], rho, sigma, &work[1]);
22910 0 : return;
22911 : }
22912 :
22913 : eps = PLUMED_GMX_FLOAT_EPS;
22914 0 : rhoinv = 1. / *rho;
22915 :
22916 0 : if (*i__ == *n) {
22917 :
22918 0 : ii = *n - 1;
22919 0 : niter = 1;
22920 :
22921 0 : temp = *rho / 2.;
22922 :
22923 0 : temp1 = temp / (d__[*n] + std::sqrt(d__[*n] * d__[*n] + temp));
22924 0 : i__1 = *n;
22925 0 : for (j = 1; j <= i__1; ++j) {
22926 0 : work[j] = d__[j] + d__[*n] + temp1;
22927 0 : delta[j] = d__[j] - d__[*n] - temp1;
22928 : }
22929 :
22930 : psi = 0.;
22931 0 : i__1 = *n - 2;
22932 0 : for (j = 1; j <= i__1; ++j) {
22933 0 : psi += z__[j] * z__[j] / (delta[j] * work[j]);
22934 : }
22935 :
22936 0 : c__ = rhoinv + psi;
22937 0 : w = c__ + z__[ii] * z__[ii] / (delta[ii] * work[ii]) + z__[*n] * z__[*
22938 0 : n] / (delta[*n] * work[*n]);
22939 :
22940 0 : if (w <= 0.) {
22941 0 : temp1 = std::sqrt(d__[*n] * d__[*n] + *rho);
22942 0 : temp = z__[*n - 1] * z__[*n - 1] / ((d__[*n - 1] + temp1) * (d__[*
22943 0 : n] - d__[*n - 1] + *rho / (d__[*n] + temp1))) + z__[*n] *
22944 0 : z__[*n] / *rho;
22945 :
22946 0 : if (c__ <= temp) {
22947 : tau = *rho;
22948 : } else {
22949 0 : delsq = (d__[*n] - d__[*n - 1]) * (d__[*n] + d__[*n - 1]);
22950 0 : a = -c__ * delsq + z__[*n - 1] * z__[*n - 1] + z__[*n] * z__[*
22951 : n];
22952 0 : b = z__[*n] * z__[*n] * delsq;
22953 0 : if (a < 0.) {
22954 0 : tau = b * 2. / ( std::sqrt(a * a + b * 4. * c__) - a);
22955 : } else {
22956 0 : tau = (a + std::sqrt(a * a + b * 4. * c__)) / (c__ * 2.);
22957 : }
22958 : }
22959 :
22960 : } else {
22961 0 : delsq = (d__[*n] - d__[*n - 1]) * (d__[*n] + d__[*n - 1]);
22962 0 : a = -c__ * delsq + z__[*n - 1] * z__[*n - 1] + z__[*n] * z__[*n];
22963 0 : b = z__[*n] * z__[*n] * delsq;
22964 :
22965 0 : if (a < 0.) {
22966 0 : tau = b * 2. / ( std::sqrt(a * a + b * 4. * c__) - a);
22967 : } else {
22968 0 : tau = (a + std::sqrt(a * a + b * 4. * c__)) / (c__ * 2.);
22969 : }
22970 :
22971 : }
22972 :
22973 0 : eta = tau / (d__[*n] + std::sqrt(d__[*n] * d__[*n] + tau));
22974 :
22975 0 : *sigma = d__[*n] + eta;
22976 0 : i__1 = *n;
22977 0 : for (j = 1; j <= i__1; ++j) {
22978 0 : delta[j] = d__[j] - d__[*i__] - eta;
22979 0 : work[j] = d__[j] + d__[*i__] + eta;
22980 : }
22981 :
22982 : dpsi = 0.;
22983 : psi = 0.;
22984 : erretm = 0.;
22985 : i__1 = ii;
22986 0 : for (j = 1; j <= i__1; ++j) {
22987 0 : temp = z__[j] / (delta[j] * work[j]);
22988 0 : psi += z__[j] * temp;
22989 0 : dpsi += temp * temp;
22990 0 : erretm += psi;
22991 : }
22992 : erretm = std::abs(erretm);
22993 :
22994 0 : temp = z__[*n] / (delta[*n] * work[*n]);
22995 0 : phi = z__[*n] * temp;
22996 0 : dphi = temp * temp;
22997 0 : erretm = (-phi - psi) * 8. + erretm - phi + rhoinv + std::abs(tau) * (dpsi
22998 0 : + dphi);
22999 :
23000 0 : w = rhoinv + phi + psi;
23001 :
23002 0 : if (std::abs(w) <= eps * erretm) {
23003 0 : goto L240;
23004 : }
23005 :
23006 0 : ++niter;
23007 0 : dtnsq1 = work[*n - 1] * delta[*n - 1];
23008 : dtnsq = work[*n] * delta[*n];
23009 0 : c__ = w - dtnsq1 * dpsi - dtnsq * dphi;
23010 0 : a = (dtnsq + dtnsq1) * w - dtnsq * dtnsq1 * (dpsi + dphi);
23011 0 : b = dtnsq * dtnsq1 * w;
23012 0 : if (c__ < 0.) {
23013 0 : c__ = std::abs(c__);
23014 : }
23015 0 : if ( std::abs(c__)<PLUMED_GMX_FLOAT_MIN) {
23016 0 : eta = *rho - *sigma * *sigma;
23017 0 : } else if (a >= 0.) {
23018 0 : eta = (a + std::sqrt(std::abs(a * a - b * 4. * c__))) / (c__ * 2.);
23019 : } else {
23020 0 : eta = b * 2. / (a - std::sqrt(std::abs(a * a - b * 4. * c__)));
23021 : }
23022 :
23023 0 : if (w * eta > 0.) {
23024 0 : eta = -w / (dpsi + dphi);
23025 : }
23026 0 : temp = eta - dtnsq;
23027 0 : if (temp > *rho) {
23028 0 : eta = *rho + dtnsq;
23029 : }
23030 :
23031 0 : tau += eta;
23032 0 : eta /= *sigma + std::sqrt(eta + *sigma * *sigma);
23033 0 : i__1 = *n;
23034 0 : for (j = 1; j <= i__1; ++j) {
23035 0 : delta[j] -= eta;
23036 0 : work[j] += eta;
23037 : }
23038 :
23039 0 : *sigma += eta;
23040 :
23041 : dpsi = 0.;
23042 : psi = 0.;
23043 : erretm = 0.;
23044 : i__1 = ii;
23045 0 : for (j = 1; j <= i__1; ++j) {
23046 0 : temp = z__[j] / (work[j] * delta[j]);
23047 0 : psi += z__[j] * temp;
23048 0 : dpsi += temp * temp;
23049 0 : erretm += psi;
23050 : }
23051 : erretm = std::abs(erretm);
23052 :
23053 0 : temp = z__[*n] / (work[*n] * delta[*n]);
23054 0 : phi = z__[*n] * temp;
23055 0 : dphi = temp * temp;
23056 0 : erretm = (-phi - psi) * 8. + erretm - phi + rhoinv + std::abs(tau) * (dpsi
23057 0 : + dphi);
23058 :
23059 0 : w = rhoinv + phi + psi;
23060 :
23061 : iter = niter + 1;
23062 :
23063 0 : for (niter = iter; niter <= 20; ++niter) {
23064 :
23065 0 : if (std::abs(w) <= eps * erretm) {
23066 0 : goto L240;
23067 : }
23068 0 : dtnsq1 = work[*n - 1] * delta[*n - 1];
23069 0 : dtnsq = work[*n] * delta[*n];
23070 0 : c__ = w - dtnsq1 * dpsi - dtnsq * dphi;
23071 0 : a = (dtnsq + dtnsq1) * w - dtnsq1 * dtnsq * (dpsi + dphi);
23072 0 : b = dtnsq1 * dtnsq * w;
23073 0 : if (a >= 0.) {
23074 0 : eta = (a + std::sqrt(std::abs(a * a - b * 4. * c__))) / (c__ * 2.);
23075 : } else {
23076 0 : eta = b * 2. / (a - std::sqrt(std::abs(a * a - b * 4. * c__)));
23077 : }
23078 :
23079 0 : if (w * eta > 0.) {
23080 0 : eta = -w / (dpsi + dphi);
23081 : }
23082 0 : temp = eta - dtnsq;
23083 0 : if (temp <= 0.) {
23084 0 : eta /= 2.;
23085 : }
23086 :
23087 0 : tau += eta;
23088 0 : eta /= *sigma + std::sqrt(eta + *sigma * *sigma);
23089 0 : i__1 = *n;
23090 0 : for (j = 1; j <= i__1; ++j) {
23091 0 : delta[j] -= eta;
23092 0 : work[j] += eta;
23093 : }
23094 :
23095 0 : *sigma += eta;
23096 :
23097 : dpsi = 0.;
23098 : psi = 0.;
23099 : erretm = 0.;
23100 : i__1 = ii;
23101 0 : for (j = 1; j <= i__1; ++j) {
23102 0 : temp = z__[j] / (work[j] * delta[j]);
23103 0 : psi += z__[j] * temp;
23104 0 : dpsi += temp * temp;
23105 0 : erretm += psi;
23106 : }
23107 : erretm = std::abs(erretm);
23108 :
23109 0 : temp = z__[*n] / (work[*n] * delta[*n]);
23110 0 : phi = z__[*n] * temp;
23111 0 : dphi = temp * temp;
23112 0 : erretm = (-phi - psi) * 8. + erretm - phi + rhoinv + std::abs(tau) * (
23113 0 : dpsi + dphi);
23114 :
23115 0 : w = rhoinv + phi + psi;
23116 : }
23117 :
23118 0 : *info = 1;
23119 0 : goto L240;
23120 :
23121 : } else {
23122 :
23123 0 : niter = 1;
23124 0 : ip1 = *i__ + 1;
23125 :
23126 0 : delsq = (d__[ip1] - d__[*i__]) * (d__[ip1] + d__[*i__]);
23127 0 : delsq2 = delsq / 2.;
23128 0 : temp = delsq2 / (d__[*i__] + std::sqrt(d__[*i__] * d__[*i__] + delsq2));
23129 0 : i__1 = *n;
23130 0 : for (j = 1; j <= i__1; ++j) {
23131 0 : work[j] = d__[j] + d__[*i__] + temp;
23132 0 : delta[j] = d__[j] - d__[*i__] - temp;
23133 : }
23134 :
23135 : psi = 0.;
23136 0 : i__1 = *i__ - 1;
23137 0 : for (j = 1; j <= i__1; ++j) {
23138 0 : psi += z__[j] * z__[j] / (work[j] * delta[j]);
23139 : }
23140 :
23141 : phi = 0.;
23142 0 : i__1 = *i__ + 2;
23143 0 : for (j = *n; j >= i__1; --j) {
23144 0 : phi += z__[j] * z__[j] / (work[j] * delta[j]);
23145 : }
23146 0 : c__ = rhoinv + psi + phi;
23147 0 : w = c__ + z__[*i__] * z__[*i__] / (work[*i__] * delta[*i__]) + z__[
23148 0 : ip1] * z__[ip1] / (work[ip1] * delta[ip1]);
23149 :
23150 0 : if (w > 0.) {
23151 :
23152 0 : orgati = 1;
23153 : sg2lb = 0.;
23154 : sg2ub = delsq2;
23155 0 : a = c__ * delsq + z__[*i__] * z__[*i__] + z__[ip1] * z__[ip1];
23156 0 : b = z__[*i__] * z__[*i__] * delsq;
23157 0 : if (a > 0.) {
23158 0 : tau = b * 2. / (a + std::sqrt(std::abs(a * a - b * 4. * c__)));
23159 : } else {
23160 0 : tau = (a - std::sqrt(std::abs(a * a - b * 4. * c__))) / (c__ * 2.);
23161 : }
23162 0 : eta = tau / (d__[*i__] + std::sqrt(d__[*i__] * d__[*i__] + tau));
23163 : } else {
23164 :
23165 0 : orgati = 0;
23166 0 : sg2lb = -delsq2;
23167 : sg2ub = 0.;
23168 0 : a = c__ * delsq - z__[*i__] * z__[*i__] - z__[ip1] * z__[ip1];
23169 0 : b = z__[ip1] * z__[ip1] * delsq;
23170 0 : if (a < 0.) {
23171 0 : tau = b * 2. / (a - std::sqrt(std::abs(a * a + b * 4. * c__)));
23172 : } else {
23173 0 : tau = -(a + std::sqrt(std::abs(a * a + b * 4. * c__))) / (c__ * 2.);
23174 : }
23175 0 : eta = tau / (d__[ip1] + std::sqrt(std::abs(d__[ip1] * d__[ip1] + tau)));
23176 : }
23177 :
23178 0 : if (orgati) {
23179 0 : ii = *i__;
23180 0 : *sigma = d__[*i__] + eta;
23181 0 : i__1 = *n;
23182 0 : for (j = 1; j <= i__1; ++j) {
23183 0 : work[j] = d__[j] + d__[*i__] + eta;
23184 0 : delta[j] = d__[j] - d__[*i__] - eta;
23185 : }
23186 : } else {
23187 0 : ii = *i__ + 1;
23188 0 : *sigma = d__[ip1] + eta;
23189 0 : i__1 = *n;
23190 0 : for (j = 1; j <= i__1; ++j) {
23191 0 : work[j] = d__[j] + d__[ip1] + eta;
23192 0 : delta[j] = d__[j] - d__[ip1] - eta;
23193 : }
23194 : }
23195 0 : iim1 = ii - 1;
23196 0 : iip1 = ii + 1;
23197 :
23198 : dpsi = 0.;
23199 : psi = 0.;
23200 : erretm = 0.;
23201 : i__1 = iim1;
23202 0 : for (j = 1; j <= i__1; ++j) {
23203 0 : temp = z__[j] / (work[j] * delta[j]);
23204 0 : psi += z__[j] * temp;
23205 0 : dpsi += temp * temp;
23206 0 : erretm += psi;
23207 : }
23208 : erretm = std::abs(erretm);
23209 :
23210 : dphi = 0.;
23211 : phi = 0.;
23212 : i__1 = iip1;
23213 0 : for (j = *n; j >= i__1; --j) {
23214 0 : temp = z__[j] / (work[j] * delta[j]);
23215 0 : phi += z__[j] * temp;
23216 0 : dphi += temp * temp;
23217 0 : erretm += phi;
23218 : }
23219 :
23220 0 : w = rhoinv + phi + psi;
23221 :
23222 : swtch3 = 0;
23223 0 : if (orgati) {
23224 0 : if (w < 0.) {
23225 : swtch3 = 1;
23226 : }
23227 : } else {
23228 0 : if (w > 0.) {
23229 : swtch3 = 1;
23230 : }
23231 : }
23232 0 : if (ii == 1 || ii == *n) {
23233 : swtch3 = 0;
23234 : }
23235 :
23236 0 : temp = z__[ii] / (work[ii] * delta[ii]);
23237 0 : dw = dpsi + dphi + temp * temp;
23238 0 : temp = z__[ii] * temp;
23239 0 : w += temp;
23240 0 : erretm = (phi - psi) * 8. + erretm + rhoinv * 2. + std::abs(temp) * 3. +
23241 0 : std::abs(tau) * dw;
23242 :
23243 0 : if (std::abs(w) <= eps * erretm) {
23244 0 : goto L240;
23245 : }
23246 :
23247 0 : if (w <= 0.) {
23248 0 : sg2lb = (sg2lb > tau) ? sg2lb : tau;
23249 : } else {
23250 0 : sg2ub = (sg2ub < tau) ? sg2ub : tau;
23251 : }
23252 :
23253 0 : ++niter;
23254 0 : if (! swtch3) {
23255 0 : dtipsq = work[ip1] * delta[ip1];
23256 0 : dtisq = work[*i__] * delta[*i__];
23257 0 : if (orgati) {
23258 0 : d__1 = z__[*i__] / dtisq;
23259 0 : c__ = w - dtipsq * dw + delsq * (d__1 * d__1);
23260 : } else {
23261 0 : d__1 = z__[ip1] / dtipsq;
23262 0 : c__ = w - dtisq * dw - delsq * (d__1 * d__1);
23263 : }
23264 0 : a = (dtipsq + dtisq) * w - dtipsq * dtisq * dw;
23265 0 : b = dtipsq * dtisq * w;
23266 0 : if ( std::abs(c__)<PLUMED_GMX_FLOAT_MIN) {
23267 0 : if ( std::abs(a)<PLUMED_GMX_FLOAT_MIN) {
23268 0 : if (orgati) {
23269 0 : a = z__[*i__] * z__[*i__] + dtipsq * dtipsq * (dpsi +
23270 : dphi);
23271 : } else {
23272 0 : a = z__[ip1] * z__[ip1] + dtisq * dtisq * (dpsi +
23273 : dphi);
23274 : }
23275 : }
23276 0 : eta = b / a;
23277 0 : } else if (a <= 0.) {
23278 0 : eta = (a - std::sqrt(std::abs(a * a - b * 4. * c__))) / (c__ * 2.);
23279 : } else {
23280 0 : eta = b * 2. / (a + std::sqrt(std::abs(a * a - b * 4. * c__)));
23281 : }
23282 : } else {
23283 :
23284 0 : dtiim = work[iim1] * delta[iim1];
23285 0 : dtiip = work[iip1] * delta[iip1];
23286 0 : temp = rhoinv + psi + phi;
23287 0 : if (orgati) {
23288 0 : temp1 = z__[iim1] / dtiim;
23289 0 : temp1 *= temp1;
23290 0 : c__ = temp - dtiip * (dpsi + dphi) - (d__[iim1] - d__[iip1]) *
23291 0 : (d__[iim1] + d__[iip1]) * temp1;
23292 0 : zz[0] = z__[iim1] * z__[iim1];
23293 0 : if (dpsi < temp1) {
23294 0 : zz[2] = dtiip * dtiip * dphi;
23295 : } else {
23296 0 : zz[2] = dtiip * dtiip * (dpsi - temp1 + dphi);
23297 : }
23298 : } else {
23299 0 : temp1 = z__[iip1] / dtiip;
23300 0 : temp1 *= temp1;
23301 0 : c__ = temp - dtiim * (dpsi + dphi) - (d__[iip1] - d__[iim1]) *
23302 0 : (d__[iim1] + d__[iip1]) * temp1;
23303 0 : if (dphi < temp1) {
23304 0 : zz[0] = dtiim * dtiim * dpsi;
23305 : } else {
23306 0 : zz[0] = dtiim * dtiim * (dpsi + (dphi - temp1));
23307 : }
23308 0 : zz[2] = z__[iip1] * z__[iip1];
23309 : }
23310 0 : zz[1] = z__[ii] * z__[ii];
23311 0 : dd[0] = dtiim;
23312 0 : dd[1] = delta[ii] * work[ii];
23313 0 : dd[2] = dtiip;
23314 0 : PLUMED_BLAS_F77_FUNC(slaed6,SLAED6)(&niter, &orgati, &c__, dd, zz, &w, &eta, info);
23315 0 : if (*info != 0) {
23316 0 : goto L240;
23317 : }
23318 : }
23319 :
23320 0 : if (w * eta >= 0.) {
23321 0 : eta = -w / dw;
23322 : }
23323 0 : if (orgati) {
23324 0 : temp1 = work[*i__] * delta[*i__];
23325 0 : temp = eta - temp1;
23326 : } else {
23327 0 : temp1 = work[ip1] * delta[ip1];
23328 0 : temp = eta - temp1;
23329 : }
23330 0 : if (temp > sg2ub || temp < sg2lb) {
23331 0 : if (w < 0.) {
23332 0 : eta = (sg2ub - tau) / 2.;
23333 : } else {
23334 0 : eta = (sg2lb - tau) / 2.;
23335 : }
23336 : }
23337 :
23338 0 : tau += eta;
23339 0 : eta /= *sigma + std::sqrt(*sigma * *sigma + eta);
23340 :
23341 : prew = w;
23342 :
23343 0 : *sigma += eta;
23344 0 : i__1 = *n;
23345 0 : for (j = 1; j <= i__1; ++j) {
23346 0 : work[j] += eta;
23347 0 : delta[j] -= eta;
23348 : }
23349 :
23350 : dpsi = 0.;
23351 : psi = 0.;
23352 : erretm = 0.;
23353 : i__1 = iim1;
23354 0 : for (j = 1; j <= i__1; ++j) {
23355 0 : temp = z__[j] / (work[j] * delta[j]);
23356 0 : psi += z__[j] * temp;
23357 0 : dpsi += temp * temp;
23358 0 : erretm += psi;
23359 : }
23360 : erretm = std::abs(erretm);
23361 :
23362 : dphi = 0.;
23363 : phi = 0.;
23364 : i__1 = iip1;
23365 0 : for (j = *n; j >= i__1; --j) {
23366 0 : temp = z__[j] / (work[j] * delta[j]);
23367 0 : phi += z__[j] * temp;
23368 0 : dphi += temp * temp;
23369 0 : erretm += phi;
23370 : }
23371 :
23372 0 : temp = z__[ii] / (work[ii] * delta[ii]);
23373 0 : dw = dpsi + dphi + temp * temp;
23374 0 : temp = z__[ii] * temp;
23375 0 : w = rhoinv + phi + psi + temp;
23376 0 : erretm = (phi - psi) * 8. + erretm + rhoinv * 2. + std::abs(temp) * 3. +
23377 0 : std::abs(tau) * dw;
23378 :
23379 0 : if (w <= 0.) {
23380 0 : sg2lb = (sg2lb > tau) ? sg2lb : tau;
23381 : } else {
23382 0 : sg2ub = (sg2ub < tau) ? sg2ub : tau;
23383 : }
23384 :
23385 : swtch = 0;
23386 0 : if (orgati) {
23387 0 : if (-w > std::abs(prew) / 10.) {
23388 : swtch = 1;
23389 : }
23390 : } else {
23391 0 : if (w > std::abs(prew) / 10.) {
23392 : swtch = 1;
23393 : }
23394 : }
23395 :
23396 0 : iter = niter + 1;
23397 :
23398 0 : for (niter = iter; niter <= 20; ++niter) {
23399 :
23400 0 : if (std::abs(w) <= eps * erretm) {
23401 0 : goto L240;
23402 : }
23403 :
23404 0 : if (! swtch3) {
23405 0 : dtipsq = work[ip1] * delta[ip1];
23406 0 : dtisq = work[*i__] * delta[*i__];
23407 0 : if (! swtch) {
23408 0 : if (orgati) {
23409 0 : d__1 = z__[*i__] / dtisq;
23410 0 : c__ = w - dtipsq * dw + delsq * (d__1 * d__1);
23411 : } else {
23412 0 : d__1 = z__[ip1] / dtipsq;
23413 0 : c__ = w - dtisq * dw - delsq * (d__1 * d__1);
23414 : }
23415 : } else {
23416 0 : temp = z__[ii] / (work[ii] * delta[ii]);
23417 0 : if (orgati) {
23418 0 : dpsi += temp * temp;
23419 : } else {
23420 0 : dphi += temp * temp;
23421 : }
23422 0 : c__ = w - dtisq * dpsi - dtipsq * dphi;
23423 : }
23424 0 : a = (dtipsq + dtisq) * w - dtipsq * dtisq * dw;
23425 0 : b = dtipsq * dtisq * w;
23426 0 : if (std::abs(c__)<PLUMED_GMX_FLOAT_MIN) {
23427 0 : if (std::abs(a)<PLUMED_GMX_FLOAT_MIN) {
23428 0 : if (! swtch) {
23429 0 : if (orgati) {
23430 0 : a = z__[*i__] * z__[*i__] + dtipsq * dtipsq *
23431 0 : (dpsi + dphi);
23432 : } else {
23433 0 : a = z__[ip1] * z__[ip1] + dtisq * dtisq * (
23434 0 : dpsi + dphi);
23435 : }
23436 : } else {
23437 0 : a = dtisq * dtisq * dpsi + dtipsq * dtipsq * dphi;
23438 : }
23439 : }
23440 0 : eta = b / a;
23441 0 : } else if (a <= 0.) {
23442 0 : eta = (a - std::sqrt(std::abs(a * a - b * 4. * c__))) / (c__ * 2.);
23443 : } else {
23444 0 : eta = b * 2. / (a + std::sqrt(std::abs(a * a - b * 4. * c__)));
23445 : }
23446 : } else {
23447 :
23448 0 : dtiim = work[iim1] * delta[iim1];
23449 0 : dtiip = work[iip1] * delta[iip1];
23450 0 : temp = rhoinv + psi + phi;
23451 0 : if (swtch) {
23452 0 : c__ = temp - dtiim * dpsi - dtiip * dphi;
23453 0 : zz[0] = dtiim * dtiim * dpsi;
23454 0 : zz[2] = dtiip * dtiip * dphi;
23455 : } else {
23456 0 : if (orgati) {
23457 0 : temp1 = z__[iim1] / dtiim;
23458 0 : temp1 *= temp1;
23459 0 : temp2 = (d__[iim1] - d__[iip1]) * (d__[iim1] + d__[
23460 : iip1]) * temp1;
23461 0 : c__ = temp - dtiip * (dpsi + dphi) - temp2;
23462 0 : zz[0] = z__[iim1] * z__[iim1];
23463 0 : if (dpsi < temp1) {
23464 0 : zz[2] = dtiip * dtiip * dphi;
23465 : } else {
23466 0 : zz[2] = dtiip * dtiip * (dpsi - temp1 + dphi);
23467 : }
23468 : } else {
23469 0 : temp1 = z__[iip1] / dtiip;
23470 0 : temp1 *= temp1;
23471 0 : temp2 = (d__[iip1] - d__[iim1]) * (d__[iim1] + d__[
23472 : iip1]) * temp1;
23473 0 : c__ = temp - dtiim * (dpsi + dphi) - temp2;
23474 0 : if (dphi < temp1) {
23475 0 : zz[0] = dtiim * dtiim * dpsi;
23476 : } else {
23477 0 : zz[0] = dtiim * dtiim * (dpsi + (dphi - temp1));
23478 : }
23479 0 : zz[2] = z__[iip1] * z__[iip1];
23480 : }
23481 : }
23482 0 : dd[0] = dtiim;
23483 0 : dd[1] = delta[ii] * work[ii];
23484 0 : dd[2] = dtiip;
23485 0 : PLUMED_BLAS_F77_FUNC(slaed6,SLAED6)(&niter, &orgati, &c__, dd, zz, &w, &eta, info);
23486 0 : if (*info != 0) {
23487 0 : goto L240;
23488 : }
23489 : }
23490 :
23491 0 : if (w * eta >= 0.) {
23492 0 : eta = -w / dw;
23493 : }
23494 0 : if (orgati) {
23495 0 : temp1 = work[*i__] * delta[*i__];
23496 0 : temp = eta - temp1;
23497 : } else {
23498 0 : temp1 = work[ip1] * delta[ip1];
23499 0 : temp = eta - temp1;
23500 : }
23501 0 : if (temp > sg2ub || temp < sg2lb) {
23502 0 : if (w < 0.) {
23503 0 : eta = (sg2ub - tau) / 2.;
23504 : } else {
23505 0 : eta = (sg2lb - tau) / 2.;
23506 : }
23507 : }
23508 :
23509 0 : tau += eta;
23510 0 : eta /= *sigma + std::sqrt(*sigma * *sigma + eta);
23511 :
23512 0 : *sigma += eta;
23513 0 : i__1 = *n;
23514 0 : for (j = 1; j <= i__1; ++j) {
23515 0 : work[j] += eta;
23516 0 : delta[j] -= eta;
23517 : }
23518 :
23519 : prew = w;
23520 :
23521 : dpsi = 0.;
23522 : psi = 0.;
23523 : erretm = 0.;
23524 : i__1 = iim1;
23525 0 : for (j = 1; j <= i__1; ++j) {
23526 0 : temp = z__[j] / (work[j] * delta[j]);
23527 0 : psi += z__[j] * temp;
23528 0 : dpsi += temp * temp;
23529 0 : erretm += psi;
23530 : }
23531 : erretm = std::abs(erretm);
23532 :
23533 : dphi = 0.;
23534 : phi = 0.;
23535 : i__1 = iip1;
23536 0 : for (j = *n; j >= i__1; --j) {
23537 0 : temp = z__[j] / (work[j] * delta[j]);
23538 0 : phi += z__[j] * temp;
23539 0 : dphi += temp * temp;
23540 0 : erretm += phi;
23541 : }
23542 :
23543 0 : temp = z__[ii] / (work[ii] * delta[ii]);
23544 0 : dw = dpsi + dphi + temp * temp;
23545 0 : temp = z__[ii] * temp;
23546 0 : w = rhoinv + phi + psi + temp;
23547 0 : erretm = (phi - psi) * 8. + erretm + rhoinv * 2. + std::abs(temp) * 3.
23548 0 : + std::abs(tau) * dw;
23549 0 : if (w * prew > 0. && std::abs(w) > std::abs(prew) / 10.) {
23550 0 : swtch = ! swtch;
23551 : }
23552 :
23553 0 : if (w <= 0.) {
23554 0 : sg2lb = (sg2lb > tau) ? sg2lb : tau;
23555 : } else {
23556 0 : sg2ub = (sg2ub < tau) ? sg2ub : tau;
23557 : }
23558 : }
23559 :
23560 0 : *info = 1;
23561 :
23562 : }
23563 :
23564 0 : L240:
23565 : return;
23566 :
23567 : }
23568 : }
23569 : }
23570 : #include <cmath>
23571 : #include "lapack.h"
23572 :
23573 : #include "blas/blas.h"
23574 : namespace PLMD{
23575 : namespace lapack{
23576 : using namespace blas;
23577 : void
23578 0 : PLUMED_BLAS_F77_FUNC(slasd5,SLASD5)(int *i__,
23579 : float *d__,
23580 : float *z__,
23581 : float *delta,
23582 : float *rho,
23583 : float *dsigma,
23584 : float *work)
23585 : {
23586 : float b, c__, w, del, tau, delsq;
23587 :
23588 : --work;
23589 : --delta;
23590 : --z__;
23591 : --d__;
23592 :
23593 0 : del = d__[2] - d__[1];
23594 0 : delsq = del * (d__[2] + d__[1]);
23595 0 : if (*i__ == 1) {
23596 0 : w = *rho * 4. * (z__[2] * z__[2] / (d__[1] + d__[2] * 3.) - z__[1] *
23597 0 : z__[1] / (d__[1] * 3. + d__[2])) / del + 1.;
23598 0 : if (w > 0.) {
23599 0 : b = delsq + *rho * (z__[1] * z__[1] + z__[2] * z__[2]);
23600 0 : c__ = *rho * z__[1] * z__[1] * delsq;
23601 :
23602 0 : tau = c__ * 2. / (b + std::sqrt(std::abs(b * b - c__ * 4.)));
23603 :
23604 0 : tau /= d__[1] + std::sqrt(d__[1] * d__[1] + tau);
23605 0 : *dsigma = d__[1] + tau;
23606 0 : delta[1] = -tau;
23607 0 : delta[2] = del - tau;
23608 0 : work[1] = d__[1] * 2. + tau;
23609 0 : work[2] = d__[1] + tau + d__[2];
23610 : } else {
23611 0 : b = -delsq + *rho * (z__[1] * z__[1] + z__[2] * z__[2]);
23612 0 : c__ = *rho * z__[2] * z__[2] * delsq;
23613 :
23614 0 : if (b > 0.) {
23615 0 : tau = c__ * -2. / (b + std::sqrt(b * b + c__ * 4.));
23616 : } else {
23617 0 : tau = (b - std::sqrt(b * b + c__ * 4.)) / 2.;
23618 : }
23619 :
23620 0 : tau /= d__[2] + std::sqrt(std::abs(d__[2] * d__[2] + tau));
23621 0 : *dsigma = d__[2] + tau;
23622 0 : delta[1] = -(del + tau);
23623 0 : delta[2] = -tau;
23624 0 : work[1] = d__[1] + tau + d__[2];
23625 0 : work[2] = d__[2] * 2. + tau;
23626 : }
23627 : } else {
23628 :
23629 0 : b = -delsq + *rho * (z__[1] * z__[1] + z__[2] * z__[2]);
23630 0 : c__ = *rho * z__[2] * z__[2] * delsq;
23631 :
23632 0 : if (b > 0.) {
23633 0 : tau = (b + std::sqrt(b * b + c__ * 4.)) / 2.;
23634 : } else {
23635 0 : tau = c__ * 2. / (-b + std::sqrt(b * b + c__ * 4.));
23636 : }
23637 0 : tau /= d__[2] + std::sqrt(d__[2] * d__[2] + tau);
23638 0 : *dsigma = d__[2] + tau;
23639 0 : delta[1] = -(del + tau);
23640 0 : delta[2] = -tau;
23641 0 : work[1] = d__[1] + tau + d__[2];
23642 0 : work[2] = d__[2] * 2. + tau;
23643 : }
23644 0 : return;
23645 :
23646 : }
23647 : }
23648 : }
23649 : #include <cmath>
23650 : #include "blas/blas.h"
23651 : #include "lapack.h"
23652 :
23653 : #include "blas/blas.h"
23654 : namespace PLMD{
23655 : namespace lapack{
23656 : using namespace blas;
23657 : void
23658 0 : PLUMED_BLAS_F77_FUNC(slasd6,SLASD6)(int *icompq,
23659 : int *nl,
23660 : int *nr,
23661 : int *sqre,
23662 : float *d__,
23663 : float *vf,
23664 : float *vl,
23665 : float *alpha,
23666 : float *beta,
23667 : int *idxq,
23668 : int *perm,
23669 : int *givptr,
23670 : int *givcol,
23671 : int *ldgcol,
23672 : float *givnum,
23673 : int *ldgnum,
23674 : float *poles,
23675 : float *difl,
23676 : float *difr,
23677 : float *z__,
23678 : int *k,
23679 : float *c__,
23680 : float *s,
23681 : float *work,
23682 : int *iwork,
23683 : int *info)
23684 : {
23685 : int givcol_dim1, givcol_offset, givnum_dim1, givnum_offset,
23686 : poles_dim1, poles_offset, i__1;
23687 : float d__1, d__2;
23688 :
23689 : int i__, m, n, n1, n2, iw, idx, idxc, idxp, ivfw, ivlw;
23690 : int isigma;
23691 : float orgnrm;
23692 0 : int c__0 = 0;
23693 0 : float one = 1.0;
23694 0 : int c__1 = 1;
23695 0 : int c_n1 = -1;
23696 :
23697 0 : --d__;
23698 : --vf;
23699 : --vl;
23700 : --idxq;
23701 : --perm;
23702 : givcol_dim1 = *ldgcol;
23703 : givcol_offset = 1 + givcol_dim1;
23704 : givcol -= givcol_offset;
23705 0 : poles_dim1 = *ldgnum;
23706 0 : poles_offset = 1 + poles_dim1;
23707 0 : poles -= poles_offset;
23708 : givnum_dim1 = *ldgnum;
23709 : givnum_offset = 1 + givnum_dim1;
23710 : givnum -= givnum_offset;
23711 : --difl;
23712 : --difr;
23713 : --z__;
23714 0 : --work;
23715 : --iwork;
23716 :
23717 0 : *info = 0;
23718 0 : n = *nl + *nr + 1;
23719 0 : m = n + *sqre;
23720 :
23721 : isigma = 1;
23722 0 : iw = isigma + n;
23723 0 : ivfw = iw + m;
23724 0 : ivlw = ivfw + m;
23725 :
23726 : idx = 1;
23727 : idxc = idx + n;
23728 0 : idxp = idxc + n;
23729 :
23730 0 : d__1 = std::abs(*alpha);
23731 0 : d__2 = std::abs(*beta);
23732 0 : orgnrm = (d__1 > d__2) ? d__1 : d__2;
23733 0 : d__[*nl + 1] = 0.;
23734 : i__1 = n;
23735 0 : for (i__ = 1; i__ <= i__1; ++i__) {
23736 0 : d__1 = std::abs(d__[i__]);
23737 0 : if (d__1 > orgnrm)
23738 0 : orgnrm = d__1;
23739 : }
23740 0 : PLUMED_BLAS_F77_FUNC(slascl,SLASCL)("G", &c__0, &c__0, &orgnrm, &one, &n, &c__1, &d__[1], &n, info);
23741 0 : *alpha /= orgnrm;
23742 0 : *beta /= orgnrm;
23743 :
23744 0 : PLUMED_BLAS_F77_FUNC(slasd7,SLASD7)(icompq, nl, nr, sqre, k, &d__[1], &z__[1], &work[iw], &vf[1], &
23745 0 : work[ivfw], &vl[1], &work[ivlw], alpha, beta, &work[isigma], &
23746 0 : iwork[idx], &iwork[idxp], &idxq[1], &perm[1], givptr, &givcol[
23747 : givcol_offset], ldgcol, &givnum[givnum_offset], ldgnum, c__, s,
23748 : info);
23749 :
23750 0 : PLUMED_BLAS_F77_FUNC(slasd8,SLASD8)(icompq, k, &d__[1], &z__[1], &vf[1], &vl[1], &difl[1], &difr[1],
23751 : ldgnum, &work[isigma], &work[iw], info);
23752 :
23753 0 : if (*icompq == 1) {
23754 0 : PLUMED_BLAS_F77_FUNC(scopy,SCOPY)(k, &d__[1], &c__1, &poles[poles_dim1 + 1], &c__1);
23755 0 : PLUMED_BLAS_F77_FUNC(scopy,SCOPY)(k, &work[isigma], &c__1, &poles[(poles_dim1 << 1) + 1], &c__1);
23756 : }
23757 :
23758 0 : PLUMED_BLAS_F77_FUNC(slascl,SLASCL)("G", &c__0, &c__0, &one, &orgnrm, &n, &c__1, &d__[1], &n, info);
23759 :
23760 0 : n1 = *k;
23761 0 : n2 = n - *k;
23762 0 : PLUMED_BLAS_F77_FUNC(slamrg,SLAMRG)(&n1, &n2, &d__[1], &c__1, &c_n1, &idxq[1]);
23763 :
23764 0 : return;
23765 :
23766 : }
23767 :
23768 :
23769 : }
23770 : }
23771 : #include <cmath>
23772 : #include "real.h"
23773 :
23774 : #include "blas/blas.h"
23775 : #include "lapack.h"
23776 : #include "lapack_limits.h"
23777 :
23778 : #include "blas/blas.h"
23779 : namespace PLMD{
23780 : namespace lapack{
23781 : using namespace blas;
23782 : void
23783 0 : PLUMED_BLAS_F77_FUNC(slasd7,SLASD7)(int *icompq,
23784 : int *nl,
23785 : int *nr,
23786 : int *sqre,
23787 : int *k,
23788 : float *d__,
23789 : float *z__,
23790 : float *zw,
23791 : float *vf,
23792 : float *vfw,
23793 : float *vl,
23794 : float *vlw,
23795 : float *alpha,
23796 : float *beta,
23797 : float *dsigma,
23798 : int *idx,
23799 : int *idxp,
23800 : int *idxq,
23801 : int *perm,
23802 : int *givptr,
23803 : int *givcol,
23804 : int *ldgcol,
23805 : float *givnum,
23806 : int *ldgnum,
23807 : float *c__,
23808 : float *s,
23809 : int *info)
23810 : {
23811 : int givcol_dim1, givcol_offset, givnum_dim1, givnum_offset, i__1;
23812 : float d__1, d__2;
23813 :
23814 : int i__, j, m, n, k2;
23815 : float z1;
23816 : int jp;
23817 : float eps, tau, tol;
23818 : int nlp1, nlp2, idxi, idxj;
23819 : int idxjp;
23820 : int jprev = 0;
23821 : float hlftol;
23822 0 : int c__1 = 1;
23823 :
23824 0 : --d__;
23825 0 : --z__;
23826 0 : --zw;
23827 0 : --vf;
23828 0 : --vfw;
23829 0 : --vl;
23830 0 : --vlw;
23831 0 : --dsigma;
23832 0 : --idx;
23833 0 : --idxp;
23834 0 : --idxq;
23835 0 : --perm;
23836 0 : givcol_dim1 = *ldgcol;
23837 0 : givcol_offset = 1 + givcol_dim1;
23838 0 : givcol -= givcol_offset;
23839 0 : givnum_dim1 = *ldgnum;
23840 0 : givnum_offset = 1 + givnum_dim1;
23841 0 : givnum -= givnum_offset;
23842 :
23843 0 : *info = 0;
23844 0 : n = *nl + *nr + 1;
23845 0 : m = n + *sqre;
23846 :
23847 0 : nlp1 = *nl + 1;
23848 0 : nlp2 = *nl + 2;
23849 0 : if (*icompq == 1) {
23850 0 : *givptr = 0;
23851 : }
23852 :
23853 0 : z1 = *alpha * vl[nlp1];
23854 0 : vl[nlp1] = 0.;
23855 0 : tau = vf[nlp1];
23856 0 : for (i__ = *nl; i__ >= 1; --i__) {
23857 0 : z__[i__ + 1] = *alpha * vl[i__];
23858 0 : vl[i__] = 0.;
23859 0 : vf[i__ + 1] = vf[i__];
23860 0 : d__[i__ + 1] = d__[i__];
23861 0 : idxq[i__ + 1] = idxq[i__] + 1;
23862 : }
23863 0 : vf[1] = tau;
23864 :
23865 : i__1 = m;
23866 0 : for (i__ = nlp2; i__ <= i__1; ++i__) {
23867 0 : z__[i__] = *beta * vf[i__];
23868 0 : vf[i__] = 0.;
23869 : }
23870 0 : i__1 = n;
23871 0 : for (i__ = nlp2; i__ <= i__1; ++i__) {
23872 0 : idxq[i__] += nlp1;
23873 : }
23874 :
23875 : i__1 = n;
23876 0 : for (i__ = 2; i__ <= i__1; ++i__) {
23877 0 : dsigma[i__] = d__[idxq[i__]];
23878 0 : zw[i__] = z__[idxq[i__]];
23879 0 : vfw[i__] = vf[idxq[i__]];
23880 0 : vlw[i__] = vl[idxq[i__]];
23881 : }
23882 :
23883 0 : PLUMED_BLAS_F77_FUNC(slamrg,SLAMRG)(nl, nr, &dsigma[2], &c__1, &c__1, &idx[2]);
23884 :
23885 0 : i__1 = n;
23886 0 : for (i__ = 2; i__ <= i__1; ++i__) {
23887 0 : idxi = idx[i__] + 1;
23888 0 : d__[i__] = dsigma[idxi];
23889 0 : z__[i__] = zw[idxi];
23890 0 : vf[i__] = vfw[idxi];
23891 0 : vl[i__] = vlw[idxi];
23892 : }
23893 :
23894 : eps = PLUMED_GMX_FLOAT_EPS;
23895 :
23896 0 : d__1 = std::abs(*alpha);
23897 0 : d__2 = std::abs(*beta);
23898 0 : tol = (d__1>d__2) ? d__1 : d__2;
23899 0 : d__2 = std::abs(d__[n]);
23900 0 : tol = eps * 64. * ((d__2>tol) ? d__2 : tol);
23901 :
23902 0 : *k = 1;
23903 0 : k2 = n + 1;
23904 : i__1 = n;
23905 0 : for (j = 2; j <= i__1; ++j) {
23906 0 : if (std::abs(z__[j]) <= tol) {
23907 :
23908 0 : --k2;
23909 0 : idxp[k2] = j;
23910 0 : if (j == n) {
23911 0 : goto L100;
23912 : }
23913 : } else {
23914 : jprev = j;
23915 0 : goto L70;
23916 : }
23917 : }
23918 0 : L70:
23919 : j = jprev;
23920 0 : L80:
23921 0 : ++j;
23922 0 : if (j > n) {
23923 0 : goto L90;
23924 : }
23925 0 : if (std::abs(z__[j]) <= tol) {
23926 :
23927 0 : --k2;
23928 0 : idxp[k2] = j;
23929 : } else {
23930 :
23931 0 : if (std::abs(d__[j] - d__[jprev]) <= tol) {
23932 :
23933 0 : *s = z__[jprev];
23934 0 : *c__ = z__[j];
23935 :
23936 0 : tau = PLUMED_BLAS_F77_FUNC(slapy2,SLAPY2)(c__, s);
23937 0 : z__[j] = tau;
23938 0 : z__[jprev] = 0.;
23939 0 : *c__ /= tau;
23940 0 : *s = -(*s) / tau;
23941 :
23942 :
23943 0 : if (*icompq == 1) {
23944 0 : ++(*givptr);
23945 0 : idxjp = idxq[idx[jprev] + 1];
23946 0 : idxj = idxq[idx[j] + 1];
23947 0 : if (idxjp <= nlp1) {
23948 0 : --idxjp;
23949 : }
23950 0 : if (idxj <= nlp1) {
23951 0 : --idxj;
23952 : }
23953 0 : givcol[*givptr + (givcol_dim1 << 1)] = idxjp;
23954 0 : givcol[*givptr + givcol_dim1] = idxj;
23955 0 : givnum[*givptr + (givnum_dim1 << 1)] = *c__;
23956 0 : givnum[*givptr + givnum_dim1] = *s;
23957 : }
23958 0 : PLUMED_BLAS_F77_FUNC(srot,SROT)(&c__1, &vf[jprev], &c__1, &vf[j], &c__1, c__, s);
23959 0 : PLUMED_BLAS_F77_FUNC(srot,SROT)(&c__1, &vl[jprev], &c__1, &vl[j], &c__1, c__, s);
23960 0 : --k2;
23961 0 : idxp[k2] = jprev;
23962 : jprev = j;
23963 : } else {
23964 0 : ++(*k);
23965 0 : zw[*k] = z__[jprev];
23966 0 : dsigma[*k] = d__[jprev];
23967 0 : idxp[*k] = jprev;
23968 : jprev = j;
23969 : }
23970 : }
23971 0 : goto L80;
23972 : L90:
23973 :
23974 0 : ++(*k);
23975 0 : zw[*k] = z__[jprev];
23976 0 : dsigma[*k] = d__[jprev];
23977 0 : idxp[*k] = jprev;
23978 :
23979 0 : L100:
23980 :
23981 0 : i__1 = n;
23982 0 : for (j = 2; j <= i__1; ++j) {
23983 0 : jp = idxp[j];
23984 0 : dsigma[j] = d__[jp];
23985 0 : vfw[j] = vf[jp];
23986 0 : vlw[j] = vl[jp];
23987 : }
23988 0 : if (*icompq == 1) {
23989 : i__1 = n;
23990 0 : for (j = 2; j <= i__1; ++j) {
23991 0 : jp = idxp[j];
23992 0 : perm[j] = idxq[idx[jp] + 1];
23993 0 : if (perm[j] <= nlp1) {
23994 0 : --perm[j];
23995 : }
23996 : }
23997 : }
23998 0 : i__1 = n - *k;
23999 0 : PLUMED_BLAS_F77_FUNC(scopy,SCOPY)(&i__1, &dsigma[*k + 1], &c__1, &d__[*k + 1], &c__1);
24000 :
24001 0 : dsigma[1] = 0.;
24002 0 : hlftol = tol / 2.;
24003 0 : if (std::abs(dsigma[2]) <= hlftol) {
24004 0 : dsigma[2] = hlftol;
24005 : }
24006 0 : if (m > n) {
24007 0 : z__[1] = PLUMED_BLAS_F77_FUNC(slapy2,SLAPY2)(&z1, &z__[m]);
24008 0 : if (z__[1] <= tol) {
24009 0 : *c__ = 1.;
24010 0 : *s = 0.;
24011 0 : z__[1] = tol;
24012 : } else {
24013 0 : *c__ = z1 / z__[1];
24014 0 : *s = -z__[m] / z__[1];
24015 : }
24016 0 : PLUMED_BLAS_F77_FUNC(srot,SROT)(&c__1, &vf[m], &c__1, &vf[1], &c__1, c__, s);
24017 0 : PLUMED_BLAS_F77_FUNC(srot,SROT)(&c__1, &vl[m], &c__1, &vl[1], &c__1, c__, s);
24018 : } else {
24019 0 : if (std::abs(z1) <= tol) {
24020 0 : z__[1] = tol;
24021 : } else {
24022 0 : z__[1] = z1;
24023 : }
24024 : }
24025 :
24026 0 : i__1 = *k - 1;
24027 0 : PLUMED_BLAS_F77_FUNC(scopy,SCOPY)(&i__1, &zw[2], &c__1, &z__[2], &c__1);
24028 0 : i__1 = n - 1;
24029 0 : PLUMED_BLAS_F77_FUNC(scopy,SCOPY)(&i__1, &vfw[2], &c__1, &vf[2], &c__1);
24030 0 : i__1 = n - 1;
24031 0 : PLUMED_BLAS_F77_FUNC(scopy,SCOPY)(&i__1, &vlw[2], &c__1, &vl[2], &c__1);
24032 :
24033 0 : return;
24034 :
24035 : }
24036 :
24037 :
24038 : }
24039 : }
24040 : #include <cmath>
24041 : #include "blas/blas.h"
24042 : #include "lapack.h"
24043 :
24044 : #include "blas/blas.h"
24045 : namespace PLMD{
24046 : namespace lapack{
24047 : using namespace blas;
24048 : void
24049 0 : PLUMED_BLAS_F77_FUNC(slasd8,SLASD8)(int *icompq,
24050 : int *k,
24051 : float *d__,
24052 : float *z__,
24053 : float *vf,
24054 : float *vl,
24055 : float *difl,
24056 : float *difr,
24057 : int *lddifr,
24058 : float *dsigma,
24059 : float *work,
24060 : int *info)
24061 : {
24062 : int difr_dim1, difr_offset, i__1, i__2;
24063 : float d__2;
24064 :
24065 : int i__, j;
24066 : float dj, rho;
24067 : int iwk1, iwk2, iwk3;
24068 : float temp;
24069 : int iwk2i, iwk3i;
24070 : float diflj, difrj, dsigj;
24071 : float dsigjp;
24072 0 : int c__1 = 1;
24073 0 : int c__0 = 0;
24074 0 : float one = 1.;
24075 :
24076 : /* avoid warnings on high gcc optimization levels */
24077 : difrj = dsigjp = 0;
24078 :
24079 0 : --d__;
24080 0 : --z__;
24081 : --vf;
24082 : --vl;
24083 0 : --difl;
24084 0 : difr_dim1 = *lddifr;
24085 0 : difr_offset = 1 + difr_dim1;
24086 0 : difr -= difr_offset;
24087 0 : --dsigma;
24088 0 : --work;
24089 :
24090 0 : *info = 0;
24091 :
24092 0 : if (*k == 1) {
24093 0 : d__[1] = std::abs(z__[1]);
24094 0 : difl[1] = d__[1];
24095 0 : if (*icompq == 1) {
24096 0 : difl[2] = 1.;
24097 0 : difr[(difr_dim1 << 1) + 1] = 1.;
24098 : }
24099 0 : return;
24100 : }
24101 :
24102 : iwk1 = 1;
24103 0 : iwk2 = iwk1 + *k;
24104 0 : iwk3 = iwk2 + *k;
24105 : iwk2i = iwk2 - 1;
24106 0 : iwk3i = iwk3 - 1;
24107 :
24108 0 : rho = PLUMED_BLAS_F77_FUNC(snrm2,SNRM2)(k, &z__[1], &c__1);
24109 0 : PLUMED_BLAS_F77_FUNC(slascl,SLASCL)("G", &c__0, &c__0, &rho, &one, k, &c__1, &z__[1], k, info);
24110 0 : rho *= rho;
24111 :
24112 0 : PLUMED_BLAS_F77_FUNC(slaset,SLASET)("A", k, &c__1, &one, &one, &work[iwk3], k);
24113 :
24114 0 : i__1 = *k;
24115 0 : for (j = 1; j <= i__1; ++j) {
24116 0 : PLUMED_BLAS_F77_FUNC(slasd4,SLASD4)(k, &j, &dsigma[1], &z__[1], &work[iwk1], &rho, &d__[j], &work[
24117 0 : iwk2], info);
24118 :
24119 0 : if (*info != 0) {
24120 : return;
24121 : }
24122 0 : work[iwk3i + j] = work[iwk3i + j] * work[j] * work[iwk2i + j];
24123 0 : difl[j] = -work[j];
24124 0 : difr[j + difr_dim1] = -work[j + 1];
24125 : i__2 = j - 1;
24126 0 : for (i__ = 1; i__ <= i__2; ++i__) {
24127 0 : work[iwk3i + i__] = work[iwk3i + i__] * work[i__] * work[iwk2i +
24128 0 : i__] / (dsigma[i__] - dsigma[j]) / (dsigma[i__] + dsigma[
24129 : j]);
24130 : }
24131 0 : i__2 = *k;
24132 0 : for (i__ = j + 1; i__ <= i__2; ++i__) {
24133 0 : work[iwk3i + i__] = work[iwk3i + i__] * work[i__] * work[iwk2i +
24134 0 : i__] / (dsigma[i__] - dsigma[j]) / (dsigma[i__] + dsigma[
24135 : j]);
24136 : }
24137 : }
24138 :
24139 0 : i__1 = *k;
24140 0 : for (i__ = 1; i__ <= i__1; ++i__) {
24141 0 : d__2 = std::sqrt(std::abs(work[iwk3i + i__]));
24142 0 : z__[i__] = (z__[i__] > 0) ? d__2 : -d__2;
24143 : }
24144 :
24145 0 : i__1 = *k;
24146 0 : for (j = 1; j <= i__1; ++j) {
24147 0 : diflj = difl[j];
24148 0 : dj = d__[j];
24149 0 : dsigj = -dsigma[j];
24150 0 : if (j < *k) {
24151 0 : difrj = -difr[j + difr_dim1];
24152 0 : dsigjp = -dsigma[j + 1];
24153 : }
24154 0 : work[j] = -z__[j] / diflj / (dsigma[j] + dj);
24155 : i__2 = j - 1;
24156 0 : for (i__ = 1; i__ <= i__2; ++i__) {
24157 0 : work[i__] = z__[i__] / (dsigma[i__] + dsigj - diflj) / ( dsigma[i__] + dj);
24158 : }
24159 0 : i__2 = *k;
24160 0 : for (i__ = j + 1; i__ <= i__2; ++i__) {
24161 0 : work[i__] = z__[i__] / (dsigma[i__] + dsigjp - difrj) / (dsigma[i__] + dj);
24162 : }
24163 0 : temp = PLUMED_BLAS_F77_FUNC(snrm2,SNRM2)(k, &work[1], &c__1);
24164 0 : work[iwk2i + j] = PLUMED_BLAS_F77_FUNC(sdot,SDOT)(k, &work[1], &c__1, &vf[1], &c__1) / temp;
24165 0 : work[iwk3i + j] = PLUMED_BLAS_F77_FUNC(sdot,SDOT)(k, &work[1], &c__1, &vl[1], &c__1) / temp;
24166 0 : if (*icompq == 1) {
24167 0 : difr[j + (difr_dim1 << 1)] = temp;
24168 : }
24169 : }
24170 :
24171 0 : PLUMED_BLAS_F77_FUNC(scopy,SCOPY)(k, &work[iwk2], &c__1, &vf[1], &c__1);
24172 0 : PLUMED_BLAS_F77_FUNC(scopy,SCOPY)(k, &work[iwk3], &c__1, &vl[1], &c__1);
24173 :
24174 : return;
24175 :
24176 : }
24177 : }
24178 : }
24179 : #include "blas/blas.h"
24180 : #include "lapack.h"
24181 :
24182 : #include "blas/blas.h"
24183 : namespace PLMD{
24184 : namespace lapack{
24185 : using namespace blas;
24186 : void
24187 0 : PLUMED_BLAS_F77_FUNC(slasda,SLASDA)(int *icompq,
24188 : int *smlsiz,
24189 : int *n,
24190 : int *sqre,
24191 : float *d__,
24192 : float *e,
24193 : float *u,
24194 : int *ldu,
24195 : float *vt,
24196 : int *k,
24197 : float *difl,
24198 : float *difr,
24199 : float *z__,
24200 : float *poles,
24201 : int *givptr,
24202 : int *givcol,
24203 : int *ldgcol,
24204 : int *perm,
24205 : float *givnum,
24206 : float *c__,
24207 : float *s,
24208 : float *work,
24209 : int *iwork,
24210 : int *info)
24211 : {
24212 : int givcol_dim1, givcol_offset, perm_dim1, perm_offset, difl_dim1,
24213 : difl_offset, difr_dim1, difr_offset, givnum_dim1, givnum_offset,
24214 : poles_dim1, poles_offset, u_dim1, u_offset, vt_dim1, vt_offset,
24215 : z_dim1, z_offset, i__1, i__2;
24216 :
24217 : int i__, j, m, i1, ic, lf, nd, ll, nl, vf, nr, vl, im1, ncc,
24218 : nlf, nrf, vfi, iwk, vli, lvl, nru, ndb1, nlp1, lvl2, nrp1;
24219 : float beta;
24220 : int idxq, nlvl;
24221 : float alpha;
24222 : int inode, ndiml, ndimr, idxqi, itemp;
24223 : int sqrei;
24224 : int nwork1, nwork2;
24225 : int smlszp;
24226 0 : int c__0 = 0;
24227 0 : float zero = 0.0;
24228 0 : float one = 1.;
24229 0 : int c__1 = 1;
24230 0 : --d__;
24231 0 : --e;
24232 0 : givnum_dim1 = *ldu;
24233 0 : givnum_offset = 1 + givnum_dim1;
24234 0 : givnum -= givnum_offset;
24235 : poles_dim1 = *ldu;
24236 : poles_offset = 1 + poles_dim1;
24237 : poles -= poles_offset;
24238 : z_dim1 = *ldu;
24239 : z_offset = 1 + z_dim1;
24240 : z__ -= z_offset;
24241 : difr_dim1 = *ldu;
24242 : difr_offset = 1 + difr_dim1;
24243 : difr -= difr_offset;
24244 : difl_dim1 = *ldu;
24245 : difl_offset = 1 + difl_dim1;
24246 : difl -= difl_offset;
24247 : vt_dim1 = *ldu;
24248 : vt_offset = 1 + vt_dim1;
24249 0 : vt -= vt_offset;
24250 : u_dim1 = *ldu;
24251 : u_offset = 1 + u_dim1;
24252 0 : u -= u_offset;
24253 : --k;
24254 : --givptr;
24255 0 : perm_dim1 = *ldgcol;
24256 0 : perm_offset = 1 + perm_dim1;
24257 0 : perm -= perm_offset;
24258 : givcol_dim1 = *ldgcol;
24259 : givcol_offset = 1 + givcol_dim1;
24260 : givcol -= givcol_offset;
24261 : --c__;
24262 : --s;
24263 0 : --work;
24264 0 : --iwork;
24265 0 : *info = 0;
24266 :
24267 0 : m = *n + *sqre;
24268 :
24269 0 : if (*n <= *smlsiz) {
24270 0 : if (*icompq == 0) {
24271 0 : PLUMED_BLAS_F77_FUNC(slasdq,SLASDQ)("U", sqre, n, &c__0, &c__0, &c__0, &d__[1], &e[1], &vt[
24272 : vt_offset], ldu, &u[u_offset], ldu, &u[u_offset], ldu, &
24273 : work[1], info);
24274 : } else {
24275 0 : PLUMED_BLAS_F77_FUNC(slasdq,SLASDQ)("U", sqre, n, &m, n, &c__0, &d__[1], &e[1], &vt[vt_offset]
24276 : , ldu, &u[u_offset], ldu, &u[u_offset], ldu, &work[1],
24277 : info);
24278 : }
24279 0 : return;
24280 : }
24281 :
24282 : inode = 1;
24283 0 : ndiml = inode + *n;
24284 0 : ndimr = ndiml + *n;
24285 0 : idxq = ndimr + *n;
24286 0 : iwk = idxq + *n;
24287 :
24288 0 : ncc = 0;
24289 0 : nru = 0;
24290 :
24291 0 : smlszp = *smlsiz + 1;
24292 : vf = 1;
24293 0 : vl = vf + m;
24294 0 : nwork1 = vl + m;
24295 0 : nwork2 = nwork1 + smlszp * smlszp;
24296 :
24297 0 : PLUMED_BLAS_F77_FUNC(slasdt,SLASDT)(n, &nlvl, &nd, &iwork[inode], &iwork[ndiml], &iwork[ndimr],
24298 : smlsiz);
24299 :
24300 0 : ndb1 = (nd + 1) / 2;
24301 : i__1 = nd;
24302 0 : for (i__ = ndb1; i__ <= i__1; ++i__) {
24303 0 : i1 = i__ - 1;
24304 0 : ic = iwork[inode + i1];
24305 0 : nl = iwork[ndiml + i1];
24306 0 : nlp1 = nl + 1;
24307 0 : nr = iwork[ndimr + i1];
24308 0 : nlf = ic - nl;
24309 0 : nrf = ic + 1;
24310 0 : idxqi = idxq + nlf - 2;
24311 : vfi = vf + nlf - 1;
24312 0 : vli = vl + nlf - 1;
24313 0 : sqrei = 1;
24314 0 : if (*icompq == 0) {
24315 0 : PLUMED_BLAS_F77_FUNC(slaset,SLASET)("A", &nlp1, &nlp1, &zero, &one, &work[nwork1], &smlszp);
24316 0 : PLUMED_BLAS_F77_FUNC(slasdq,SLASDQ)("U", &sqrei, &nl, &nlp1, &nru, &ncc, &d__[nlf], &e[nlf], &
24317 : work[nwork1], &smlszp, &work[nwork2], &nl, &work[nwork2],
24318 0 : &nl, &work[nwork2], info);
24319 0 : itemp = nwork1 + nl * smlszp;
24320 0 : PLUMED_BLAS_F77_FUNC(scopy,SCOPY)(&nlp1, &work[nwork1], &c__1, &work[vfi], &c__1);
24321 0 : PLUMED_BLAS_F77_FUNC(scopy,SCOPY)(&nlp1, &work[itemp], &c__1, &work[vli], &c__1);
24322 : } else {
24323 0 : PLUMED_BLAS_F77_FUNC(slaset,SLASET)("A", &nl, &nl, &zero, &one, &u[nlf + u_dim1], ldu);
24324 0 : PLUMED_BLAS_F77_FUNC(slaset,SLASET)("A", &nlp1, &nlp1, &zero, &one, &vt[nlf + vt_dim1],
24325 : ldu);
24326 0 : PLUMED_BLAS_F77_FUNC(slasdq,SLASDQ)("U", &sqrei, &nl, &nlp1, &nl, &ncc, &d__[nlf], &e[nlf], &
24327 : vt[nlf + vt_dim1], ldu, &u[nlf + u_dim1], ldu, &u[nlf +
24328 0 : u_dim1], ldu, &work[nwork1], info);
24329 0 : PLUMED_BLAS_F77_FUNC(scopy,SCOPY)(&nlp1, &vt[nlf + vt_dim1], &c__1, &work[vfi], &c__1);
24330 0 : PLUMED_BLAS_F77_FUNC(scopy,SCOPY)(&nlp1, &vt[nlf + nlp1 * vt_dim1], &c__1, &work[vli], &c__1)
24331 : ;
24332 : }
24333 0 : if (*info != 0) {
24334 : return;
24335 : }
24336 0 : i__2 = nl;
24337 0 : for (j = 1; j <= i__2; ++j) {
24338 0 : iwork[idxqi + j] = j;
24339 : }
24340 0 : if (i__ == nd && *sqre == 0) {
24341 0 : sqrei = 0;
24342 : } else {
24343 0 : sqrei = 1;
24344 : }
24345 0 : idxqi += nlp1;
24346 0 : vfi += nlp1;
24347 0 : vli += nlp1;
24348 0 : nrp1 = nr + sqrei;
24349 0 : if (*icompq == 0) {
24350 0 : PLUMED_BLAS_F77_FUNC(slaset,SLASET)("A", &nrp1, &nrp1, &zero, &one, &work[nwork1], &smlszp);
24351 0 : PLUMED_BLAS_F77_FUNC(slasdq,SLASDQ)("U", &sqrei, &nr, &nrp1, &nru, &ncc, &d__[nrf], &e[nrf], &
24352 : work[nwork1], &smlszp, &work[nwork2], &nr, &work[nwork2],
24353 0 : &nr, &work[nwork2], info);
24354 0 : itemp = nwork1 + (nrp1 - 1) * smlszp;
24355 0 : PLUMED_BLAS_F77_FUNC(scopy,SCOPY)(&nrp1, &work[nwork1], &c__1, &work[vfi], &c__1);
24356 0 : PLUMED_BLAS_F77_FUNC(scopy,SCOPY)(&nrp1, &work[itemp], &c__1, &work[vli], &c__1);
24357 : } else {
24358 0 : PLUMED_BLAS_F77_FUNC(slaset,SLASET)("A", &nr, &nr, &zero, &one, &u[nrf + u_dim1], ldu);
24359 0 : PLUMED_BLAS_F77_FUNC(slaset,SLASET)("A", &nrp1, &nrp1, &zero, &one, &vt[nrf + vt_dim1],
24360 : ldu);
24361 0 : PLUMED_BLAS_F77_FUNC(slasdq,SLASDQ)("U", &sqrei, &nr, &nrp1, &nr, &ncc, &d__[nrf], &e[nrf], &
24362 : vt[nrf + vt_dim1], ldu, &u[nrf + u_dim1], ldu, &u[nrf +
24363 0 : u_dim1], ldu, &work[nwork1], info);
24364 0 : PLUMED_BLAS_F77_FUNC(scopy,SCOPY)(&nrp1, &vt[nrf + vt_dim1], &c__1, &work[vfi], &c__1);
24365 0 : PLUMED_BLAS_F77_FUNC(scopy,SCOPY)(&nrp1, &vt[nrf + nrp1 * vt_dim1], &c__1, &work[vli], &c__1)
24366 : ;
24367 : }
24368 0 : if (*info != 0) {
24369 : return;
24370 : }
24371 0 : i__2 = nr;
24372 0 : for (j = 1; j <= i__2; ++j) {
24373 0 : iwork[idxqi + j] = j;
24374 : }
24375 : }
24376 :
24377 0 : j = (1 << nlvl);
24378 :
24379 0 : for (lvl = nlvl; lvl >= 1; --lvl) {
24380 0 : lvl2 = (lvl << 1) - 1;
24381 :
24382 0 : if (lvl == 1) {
24383 : lf = 1;
24384 : ll = 1;
24385 : } else {
24386 0 : lf = (1 << (lvl-1));
24387 0 : ll = (lf << 1) - 1;
24388 : }
24389 : i__1 = ll;
24390 0 : for (i__ = lf; i__ <= i__1; ++i__) {
24391 0 : im1 = i__ - 1;
24392 0 : ic = iwork[inode + im1];
24393 0 : nl = iwork[ndiml + im1];
24394 0 : nr = iwork[ndimr + im1];
24395 0 : nlf = ic - nl;
24396 0 : if (i__ == ll) {
24397 0 : sqrei = *sqre;
24398 : } else {
24399 0 : sqrei = 1;
24400 : }
24401 : vfi = vf + nlf - 1;
24402 0 : vli = vl + nlf - 1;
24403 0 : idxqi = idxq + nlf - 1;
24404 0 : alpha = d__[ic];
24405 0 : beta = e[ic];
24406 0 : if (*icompq == 0) {
24407 0 : PLUMED_BLAS_F77_FUNC(slasd6,SLASD6)(icompq, &nl, &nr, &sqrei, &d__[nlf], &work[vfi], &
24408 0 : work[vli], &alpha, &beta, &iwork[idxqi], &perm[
24409 : perm_offset], &givptr[1], &givcol[givcol_offset],
24410 : ldgcol, &givnum[givnum_offset], ldu, &poles[
24411 : poles_offset], &difl[difl_offset], &difr[difr_offset],
24412 0 : &z__[z_offset], &k[1], &c__[1], &s[1], &work[nwork1],
24413 0 : &iwork[iwk], info);
24414 : } else {
24415 0 : --j;
24416 0 : PLUMED_BLAS_F77_FUNC(slasd6,SLASD6)(icompq, &nl, &nr, &sqrei, &d__[nlf], &work[vfi], &
24417 0 : work[vli], &alpha, &beta, &iwork[idxqi], &perm[nlf +
24418 0 : lvl * perm_dim1], &givptr[j], &givcol[nlf + lvl2 *
24419 : givcol_dim1], ldgcol, &givnum[nlf + lvl2 *
24420 : givnum_dim1], ldu, &poles[nlf + lvl2 * poles_dim1], &
24421 0 : difl[nlf + lvl * difl_dim1], &difr[nlf + lvl2 *
24422 0 : difr_dim1], &z__[nlf + lvl * z_dim1], &k[j], &c__[j],
24423 0 : &s[j], &work[nwork1], &iwork[iwk], info);
24424 : }
24425 0 : if (*info != 0) {
24426 : return;
24427 : }
24428 : }
24429 : }
24430 :
24431 : return;
24432 :
24433 : }
24434 :
24435 :
24436 : }
24437 : }
24438 : #include <cctype>
24439 :
24440 : #include "blas/blas.h"
24441 : #include "lapack.h"
24442 :
24443 :
24444 : #include "blas/blas.h"
24445 : namespace PLMD{
24446 : namespace lapack{
24447 : using namespace blas;
24448 : void
24449 0 : PLUMED_BLAS_F77_FUNC(slasdq,SLASDQ)(const char *uplo,
24450 : int *sqre,
24451 : int *n,
24452 : int *ncvt,
24453 : int *nru,
24454 : int *ncc,
24455 : float *d__,
24456 : float *e,
24457 : float *vt,
24458 : int *ldvt,
24459 : float *u,
24460 : int *ldu,
24461 : float *c__,
24462 : int *ldc,
24463 : float *work,
24464 : int *info)
24465 : {
24466 0 : const char xuplo=std::toupper(*uplo);
24467 : int c_dim1, c_offset, u_dim1, u_offset, vt_dim1, vt_offset, i__1,
24468 : i__2;
24469 0 : int c__1 = 1;
24470 : int itmp1,itmp2;
24471 : int i__, j;
24472 : float r__, cs, sn;
24473 : int np1, isub;
24474 : float smin;
24475 : int sqre1;
24476 : int iuplo;
24477 : int rotate;
24478 :
24479 0 : --d__;
24480 0 : --e;
24481 0 : vt_dim1 = *ldvt;
24482 0 : vt_offset = 1 + vt_dim1;
24483 0 : vt -= vt_offset;
24484 0 : u_dim1 = *ldu;
24485 0 : u_offset = 1 + u_dim1;
24486 0 : u -= u_offset;
24487 0 : c_dim1 = *ldc;
24488 0 : c_offset = 1 + c_dim1;
24489 0 : c__ -= c_offset;
24490 0 : --work;
24491 :
24492 0 : *info = 0;
24493 : iuplo = 0;
24494 0 : if (xuplo == 'U') {
24495 : iuplo = 1;
24496 : }
24497 0 : if (xuplo == 'L') {
24498 : iuplo = 2;
24499 : }
24500 :
24501 0 : itmp1 = (*n > 1) ? *n : 1;
24502 0 : itmp2 = (*nru > 1) ? *nru : 1;
24503 0 : if (iuplo == 0) {
24504 0 : *info = -1;
24505 0 : } else if (*sqre < 0 || *sqre > 1) {
24506 0 : *info = -2;
24507 0 : } else if (*n < 0) {
24508 0 : *info = -3;
24509 0 : } else if (*ncvt < 0) {
24510 0 : *info = -4;
24511 0 : } else if (*nru < 0) {
24512 0 : *info = -5;
24513 0 : } else if (*ncc < 0) {
24514 0 : *info = -6;
24515 0 : } else if ( (*ncvt == 0 && *ldvt < 1) || (*ncvt > 0 && *ldvt < itmp1)) {
24516 0 : *info = -10;
24517 0 : } else if (*ldu < itmp2) {
24518 0 : *info = -12;
24519 0 : } else if ((*ncc == 0 && *ldc < 1) || (*ncc > 0 && *ldc < itmp1)) {
24520 0 : *info = -14;
24521 : }
24522 0 : if (*info != 0) {
24523 : return;
24524 : }
24525 0 : if (*n == 0) {
24526 : return;
24527 : }
24528 :
24529 0 : rotate = *ncvt > 0 || *nru > 0 || *ncc > 0;
24530 0 : np1 = *n + 1;
24531 0 : sqre1 = *sqre;
24532 :
24533 0 : if (iuplo == 1 && sqre1 == 1) {
24534 : i__1 = *n - 1;
24535 0 : for (i__ = 1; i__ <= i__1; ++i__) {
24536 0 : PLUMED_BLAS_F77_FUNC(slartg,SLARTG)(&d__[i__], &e[i__], &cs, &sn, &r__);
24537 0 : d__[i__] = r__;
24538 0 : e[i__] = sn * d__[i__ + 1];
24539 0 : d__[i__ + 1] = cs * d__[i__ + 1];
24540 0 : if (rotate) {
24541 0 : work[i__] = cs;
24542 0 : work[*n + i__] = sn;
24543 : }
24544 : }
24545 0 : PLUMED_BLAS_F77_FUNC(slartg,SLARTG)(&d__[*n], &e[*n], &cs, &sn, &r__);
24546 0 : d__[*n] = r__;
24547 0 : e[*n] = 0.f;
24548 0 : if (rotate) {
24549 0 : work[*n] = cs;
24550 0 : work[*n + *n] = sn;
24551 : }
24552 : iuplo = 2;
24553 : sqre1 = 0;
24554 :
24555 0 : if (*ncvt > 0) {
24556 0 : PLUMED_BLAS_F77_FUNC(slasr,SLASR)("L", "V", "F", &np1, ncvt, &work[1], &work[np1], &vt[
24557 : vt_offset], ldvt);
24558 : }
24559 : }
24560 0 : if (iuplo == 2) {
24561 0 : i__1 = *n - 1;
24562 0 : for (i__ = 1; i__ <= i__1; ++i__) {
24563 0 : PLUMED_BLAS_F77_FUNC(slartg,SLARTG)(&d__[i__], &e[i__], &cs, &sn, &r__);
24564 0 : d__[i__] = r__;
24565 0 : e[i__] = sn * d__[i__ + 1];
24566 0 : d__[i__ + 1] = cs * d__[i__ + 1];
24567 0 : if (rotate) {
24568 0 : work[i__] = cs;
24569 0 : work[*n + i__] = sn;
24570 : }
24571 : }
24572 :
24573 0 : if (sqre1 == 1) {
24574 0 : PLUMED_BLAS_F77_FUNC(slartg,SLARTG)(&d__[*n], &e[*n], &cs, &sn, &r__);
24575 0 : d__[*n] = r__;
24576 0 : if (rotate) {
24577 0 : work[*n] = cs;
24578 0 : work[*n + *n] = sn;
24579 : }
24580 : }
24581 0 : if (*nru > 0) {
24582 0 : if (sqre1 == 0) {
24583 0 : PLUMED_BLAS_F77_FUNC(slasr,SLASR)("R", "V", "F", nru, n, &work[1], &work[np1], &u[
24584 : u_offset], ldu);
24585 : } else {
24586 0 : PLUMED_BLAS_F77_FUNC(slasr,SLASR)("R", "V", "F", nru, &np1, &work[1], &work[np1], &u[
24587 : u_offset], ldu);
24588 : }
24589 : }
24590 0 : if (*ncc > 0) {
24591 0 : if (sqre1 == 0) {
24592 0 : PLUMED_BLAS_F77_FUNC(slasr,SLASR)("L", "V", "F", n, ncc, &work[1], &work[np1], &c__[
24593 : c_offset], ldc);
24594 : } else {
24595 0 : PLUMED_BLAS_F77_FUNC(slasr,SLASR)("L", "V", "F", &np1, ncc, &work[1], &work[np1], &c__[
24596 : c_offset], ldc);
24597 : }
24598 : }
24599 : }
24600 :
24601 0 : PLUMED_BLAS_F77_FUNC(sbdsqr,SBDSQR)("U", n, ncvt, nru, ncc, &d__[1], &e[1], &vt[vt_offset], ldvt, &u[
24602 : u_offset], ldu, &c__[c_offset], ldc, &work[1], info);
24603 :
24604 0 : i__1 = *n;
24605 0 : for (i__ = 1; i__ <= i__1; ++i__) {
24606 :
24607 : isub = i__;
24608 0 : smin = d__[i__];
24609 0 : i__2 = *n;
24610 0 : for (j = i__ + 1; j <= i__2; ++j) {
24611 0 : if (d__[j] < smin) {
24612 : isub = j;
24613 : smin = d__[j];
24614 : }
24615 : }
24616 0 : if (isub != i__) {
24617 0 : d__[isub] = d__[i__];
24618 0 : d__[i__] = smin;
24619 0 : if (*ncvt > 0) {
24620 0 : PLUMED_BLAS_F77_FUNC(sswap,SSWAP)(ncvt, &vt[isub + vt_dim1], ldvt, &vt[i__ + vt_dim1],
24621 : ldvt);
24622 : }
24623 0 : if (*nru > 0) {
24624 0 : PLUMED_BLAS_F77_FUNC(sswap,SSWAP)(nru, &u[isub * u_dim1 + 1], &c__1, &u[i__ * u_dim1 + 1]
24625 : , &c__1);
24626 : }
24627 0 : if (*ncc > 0) {
24628 0 : PLUMED_BLAS_F77_FUNC(sswap,SSWAP)(ncc, &c__[isub + c_dim1], ldc, &c__[i__ + c_dim1], ldc)
24629 : ;
24630 : }
24631 : }
24632 : }
24633 :
24634 : return;
24635 : }
24636 :
24637 :
24638 : }
24639 : }
24640 : #include <cmath>
24641 : #include "lapack.h"
24642 :
24643 : #include "blas/blas.h"
24644 : namespace PLMD{
24645 : namespace lapack{
24646 : using namespace blas;
24647 : void
24648 0 : PLUMED_BLAS_F77_FUNC(slasdt,SLASDT)(int *n,
24649 : int *lvl,
24650 : int *nd,
24651 : int *inode,
24652 : int *ndiml,
24653 : int *ndimr,
24654 : int *msub)
24655 : {
24656 0 : int maxn = (*n > 1) ? *n : 1;
24657 : float temp;
24658 : int i,il,ir,llst,nlvl,ncrnt;
24659 :
24660 0 : temp = std::log( ((float) maxn) / ((float)(*msub+1))) / std::log(2.0);
24661 :
24662 0 : *lvl = 1 + (int) temp;
24663 :
24664 0 : i = *n / 2;
24665 0 : inode[0] = i + 1;
24666 0 : ndiml[0] = i;
24667 0 : ndimr[0] = *n - i - 1;
24668 : il = -1;
24669 : ir = 0;
24670 : llst = 1;
24671 :
24672 0 : for(nlvl=1;nlvl<*lvl;nlvl++) {
24673 0 : for(i=0;i<llst;i++) {
24674 0 : il += 2;
24675 0 : ir += 2;
24676 0 : ncrnt = llst + i - 1;
24677 0 : ndiml[il] = ndiml[ncrnt] / 2;
24678 0 : ndimr[il] = ndiml[ncrnt] - ndiml[il] - 1;
24679 0 : inode[il] = inode[ncrnt] - ndimr[il] - 1;
24680 0 : ndiml[ir] = ndimr[ncrnt] / 2;
24681 0 : ndimr[ir] = ndimr[ncrnt] - ndiml[ir] - 1;
24682 0 : inode[ir] = inode[ncrnt] + ndiml[ir] + 1;
24683 : }
24684 0 : llst *= 2;
24685 : }
24686 0 : *nd = llst*2 - 1;
24687 0 : return;
24688 : }
24689 : }
24690 : }
24691 : #include <cctype>
24692 : #include "lapack.h"
24693 :
24694 :
24695 : #include "blas/blas.h"
24696 : namespace PLMD{
24697 : namespace lapack{
24698 : using namespace blas;
24699 : void
24700 0 : PLUMED_BLAS_F77_FUNC(slaset,SLASET)(const char *uplo,
24701 : int *m,
24702 : int *n,
24703 : float *alpha,
24704 : float *beta,
24705 : float *a,
24706 : int *lda)
24707 : {
24708 : int i,j,k;
24709 0 : const char ch=std::toupper(*uplo);
24710 :
24711 0 : if(ch=='U') {
24712 0 : for(j=1;j<*n;j++) {
24713 0 : k = (j < *m) ? j : *m;
24714 0 : for(i=0;i<k;i++)
24715 0 : a[j*(*lda)+i] = *alpha;
24716 : }
24717 0 : } else if(ch=='L') {
24718 0 : k = (*m < *n) ? *m : *n;
24719 0 : for(j=0;j<k;j++) {
24720 0 : for(i=j+1;i<*m;i++)
24721 0 : a[j*(*lda)+i] = *alpha;
24722 : }
24723 : } else {
24724 0 : for(j=0;j<*n;j++) {
24725 0 : for(i=0;i<*m;i++)
24726 0 : a[j*(*lda)+i] = *alpha;
24727 : }
24728 : }
24729 :
24730 0 : k = (*m < *n) ? *m : *n;
24731 0 : for(i=0;i<k;i++)
24732 0 : a[i*(*lda)+i] = *beta;
24733 0 : }
24734 : }
24735 : }
24736 : #include <cmath>
24737 : #include "blas/blas.h"
24738 : #include "lapack.h"
24739 : #include "lapack_limits.h"
24740 :
24741 : #include "real.h"
24742 :
24743 : #include "blas/blas.h"
24744 : namespace PLMD{
24745 : namespace lapack{
24746 : using namespace blas;
24747 : void
24748 0 : PLUMED_BLAS_F77_FUNC(slasq1,SLASQ1)(int *n,
24749 : float *d,
24750 : float *e,
24751 : float *work,
24752 : int *info)
24753 : {
24754 0 : float sigmx = 0.0;
24755 : int i,j,k,iinfo;
24756 : float minval,safemin;
24757 : float dtemp,scale;
24758 : float eps;
24759 :
24760 : eps = PLUMED_GMX_FLOAT_EPS;
24761 : minval = PLUMED_GMX_FLOAT_MIN;
24762 : safemin = minval*(1.0+PLUMED_GMX_FLOAT_EPS);
24763 0 : *info = 0;
24764 :
24765 0 : if(*n<0) {
24766 0 : *info = -2;
24767 0 : return;
24768 : }
24769 :
24770 0 : for(i=0;i<*n-1;i++) {
24771 0 : d[i] = std::abs(d[i]);
24772 0 : dtemp = std::abs(e[i]);
24773 0 : if(dtemp>sigmx)
24774 0 : sigmx=dtemp;
24775 : }
24776 0 : d[*n-1] = std::abs(d[*n-1]);
24777 :
24778 0 : if(std::abs(sigmx)<PLUMED_GMX_FLOAT_MIN) {
24779 0 : PLUMED_BLAS_F77_FUNC(slasrt,SLASRT)("D",n,d,&iinfo);
24780 0 : return;
24781 : }
24782 :
24783 0 : for(i=0;i<*n;i++) {
24784 0 : if(d[i]>sigmx)
24785 0 : sigmx=d[i];
24786 : }
24787 :
24788 : /* Copy d and e into work (z format) and scale.
24789 : * Squaring input data makes scaling by a power of the
24790 : * radix pointless.
24791 : */
24792 0 : scale = std::sqrt(eps/safemin);
24793 0 : i = 1;
24794 0 : j = 2;
24795 0 : PLUMED_BLAS_F77_FUNC(scopy,SCOPY)(n,d,&i,work,&j);
24796 0 : k = *n-1;
24797 0 : PLUMED_BLAS_F77_FUNC(scopy,SCOPY)(&k,e,&i,work+1,&j);
24798 0 : i = 0;
24799 0 : j = 2*(*n)-1;
24800 0 : k = 1;
24801 0 : PLUMED_BLAS_F77_FUNC(slascl,SLASCL)("G",&i,&i,&sigmx,&scale,&j,&k,work,&j,&iinfo);
24802 :
24803 :
24804 : /* Compute q and e elements */
24805 0 : for(i=0;i<2*(*n)-1;i++)
24806 0 : work[i] = work[i]*work[i];
24807 :
24808 0 : work[2*(*n)-1] = 0.0;
24809 :
24810 0 : PLUMED_BLAS_F77_FUNC(slasq2,SLASQ2)(n,work,info);
24811 :
24812 0 : j = 0;
24813 0 : k = 1;
24814 0 : if(*info==0) {
24815 0 : for(i=0;i<*n;i++)
24816 0 : d[i]= std::sqrt(work[i]);
24817 0 : PLUMED_BLAS_F77_FUNC(slascl,SLASCL)("G",&j,&j,&scale,&sigmx,n,&k,d,n,&iinfo);
24818 : }
24819 : return;
24820 : }
24821 : }
24822 : }
24823 : #include <cmath>
24824 : #include "lapack.h"
24825 : #include "lapack_limits.h"
24826 :
24827 : #include "real.h"
24828 :
24829 : #ifdef _MSC_VER
24830 : #pragma warning(disable: 4723) /*division by zero - is used on purpose here*/
24831 : #endif
24832 :
24833 : #include "blas/blas.h"
24834 : namespace PLMD{
24835 : namespace lapack{
24836 : using namespace blas;
24837 : void
24838 0 : PLUMED_BLAS_F77_FUNC(slasq2,SLASQ2)(int *n,
24839 : float *z__,
24840 : int *info)
24841 : {
24842 : int i__1, i__2, i__3;
24843 : float d__1, d__2;
24844 :
24845 : float d__, e;
24846 : int k;
24847 : float s, t;
24848 : int i0, i4, n0, pp;
24849 : float dee, eps, tol;
24850 : int ipn4;
24851 : float tol2;
24852 : int ieee;
24853 : int nbig;
24854 : float dmin__, emin, emax;
24855 : int kmin, ndiv, iter;
24856 : float qmin, temp, qmax, zmax;
24857 : int splt, nfail;
24858 : float desig, trace, sigma;
24859 : int iinfo;
24860 : float deemin;
24861 : int iwhila, iwhilb;
24862 : float oldemn, safmin, minval;
24863 : float posinf,neginf,negzro,newzro;
24864 : float zero = 0.0;
24865 : float one = 1.0;
24866 :
24867 0 : --z__;
24868 :
24869 0 : *info = 0;
24870 : eps = PLUMED_GMX_FLOAT_EPS;
24871 : minval = PLUMED_GMX_FLOAT_MIN;
24872 : safmin = minval*(1.0+eps);
24873 :
24874 : tol = eps * 100.;
24875 :
24876 : d__1 = tol;
24877 : tol2 = d__1 * d__1;
24878 :
24879 0 : if (*n < 0) {
24880 0 : *info = -1;
24881 0 : return;
24882 0 : } else if (*n == 0) {
24883 : return;
24884 0 : } else if (*n == 1) {
24885 :
24886 0 : if (z__[1] < 0.) {
24887 0 : *info = -201;
24888 : }
24889 0 : return;
24890 0 : } else if (*n == 2) {
24891 :
24892 0 : if (z__[2] < 0. || z__[3] < 0.) {
24893 0 : *info = -2;
24894 0 : return;
24895 0 : } else if (z__[3] > z__[1]) {
24896 : d__ = z__[3];
24897 0 : z__[3] = z__[1];
24898 0 : z__[1] = d__;
24899 : }
24900 0 : z__[5] = z__[1] + z__[2] + z__[3];
24901 0 : if (z__[2] > z__[3] * tol2) {
24902 0 : t = (z__[1] - z__[3] + z__[2]) * .5;
24903 0 : s = z__[3] * (z__[2] / t);
24904 0 : if (s <= t) {
24905 0 : s = z__[3] * (z__[2] / (t * ( std::sqrt(s / t + 1.) + 1.)));
24906 : } else {
24907 0 : s = z__[3] * (z__[2] / (t + std::sqrt(t) * std::sqrt(t + s)));
24908 : }
24909 0 : t = z__[1] + (s + z__[2]);
24910 0 : z__[3] *= z__[1] / t;
24911 0 : z__[1] = t;
24912 : }
24913 0 : z__[2] = z__[3];
24914 0 : z__[6] = z__[2] + z__[1];
24915 0 : return;
24916 : }
24917 0 : z__[*n * 2] = 0.;
24918 0 : emin = z__[2];
24919 0 : qmax = 0.;
24920 : zmax = 0.;
24921 : d__ = 0.;
24922 : e = 0.;
24923 :
24924 0 : i__1 = 2*(*n - 1);
24925 0 : for (k = 1; k <= i__1; k += 2) {
24926 0 : if (z__[k] < 0.) {
24927 0 : *info = -(k + 200);
24928 0 : return;
24929 0 : } else if (z__[k + 1] < 0.) {
24930 0 : *info = -(k + 201);
24931 0 : return;
24932 : }
24933 0 : d__ += z__[k];
24934 0 : e += z__[k + 1];
24935 0 : d__1 = qmax, d__2 = z__[k];
24936 0 : qmax = (d__1>d__2) ? d__1 : d__2;
24937 : d__1 = emin, d__2 = z__[k + 1];
24938 0 : emin = (d__1<d__2) ? d__1 : d__2;
24939 0 : d__1 = (qmax>zmax) ? qmax : zmax;
24940 : d__2 = z__[k + 1];
24941 0 : zmax = (d__1>d__2) ? d__1 : d__2;
24942 : }
24943 0 : if (z__[(*n << 1) - 1] < 0.) {
24944 0 : *info = -((*n << 1) + 199);
24945 0 : return;
24946 : }
24947 0 : d__ += z__[(*n << 1) - 1];
24948 0 : d__1 = qmax, d__2 = z__[(*n << 1) - 1];
24949 0 : qmax = (d__1>d__2) ? d__1 : d__2;
24950 :
24951 0 : if (std::abs(e)<PLUMED_GMX_FLOAT_MIN) {
24952 : i__1 = *n;
24953 0 : for (k = 2; k <= i__1; ++k) {
24954 0 : z__[k] = z__[(k << 1) - 1];
24955 : }
24956 0 : PLUMED_BLAS_F77_FUNC(slasrt,SLASRT)("D", n, &z__[1], &iinfo);
24957 0 : z__[(*n << 1) - 1] = d__;
24958 0 : return;
24959 : }
24960 :
24961 0 : trace = d__ + e;
24962 :
24963 0 : if (std::abs(trace)<PLUMED_GMX_FLOAT_MIN) {
24964 0 : z__[(*n << 1) - 1] = 0.;
24965 0 : return;
24966 : }
24967 :
24968 0 : ieee = 1;
24969 0 : posinf = one/zero;
24970 0 : if(posinf<=1.0)
24971 0 : ieee = 0;
24972 : neginf = -one/zero;
24973 0 : if(neginf>=0.0)
24974 0 : ieee = 0;
24975 0 : negzro = one/(neginf+one);
24976 0 : if(std::abs(negzro)>PLUMED_GMX_FLOAT_MIN)
24977 0 : ieee = 0;
24978 0 : neginf = one/negzro;
24979 0 : if(neginf>=0)
24980 0 : ieee = 0;
24981 0 : newzro = negzro + zero;
24982 0 : if(std::abs(newzro-zero)>PLUMED_GMX_FLOAT_MIN)
24983 0 : ieee = 0;
24984 0 : posinf = one /newzro;
24985 0 : if(posinf<=one)
24986 0 : ieee = 0;
24987 0 : neginf = neginf*posinf;
24988 0 : if(neginf>=zero)
24989 0 : ieee = 0;
24990 0 : posinf = posinf*posinf;
24991 0 : if(posinf<=1.0)
24992 0 : ieee = 0;
24993 :
24994 0 : for (k = *n << 1; k >= 2; k += -2) {
24995 0 : z__[k * 2] = 0.;
24996 0 : z__[(k << 1) - 1] = z__[k];
24997 0 : z__[(k << 1) - 2] = 0.;
24998 0 : z__[(k << 1) - 3] = z__[k - 1];
24999 : }
25000 :
25001 0 : i0 = 1;
25002 0 : n0 = *n;
25003 :
25004 0 : if (z__[(i0 << 2) - 3] * 1.5 < z__[(n0 << 2) - 3]) {
25005 0 : ipn4 = 4*(i0 + n0);
25006 0 : i__1 = 2*(i0 + n0 - 1);
25007 0 : for (i4 = i0 << 2; i4 <= i__1; i4 += 4) {
25008 0 : temp = z__[i4 - 3];
25009 0 : z__[i4 - 3] = z__[ipn4 - i4 - 3];
25010 0 : z__[ipn4 - i4 - 3] = temp;
25011 0 : temp = z__[i4 - 1];
25012 0 : z__[i4 - 1] = z__[ipn4 - i4 - 5];
25013 0 : z__[ipn4 - i4 - 5] = temp;
25014 : }
25015 : }
25016 :
25017 0 : pp = 0;
25018 :
25019 0 : for (k = 1; k <= 2; ++k) {
25020 :
25021 0 : d__ = z__[(n0 << 2) + pp - 3];
25022 0 : i__1 = (i0 << 2) + pp;
25023 0 : for (i4 = 4*(n0 - 1) + pp; i4 >= i__1; i4 += -4) {
25024 0 : if (z__[i4 - 1] <= tol2 * d__) {
25025 0 : z__[i4 - 1] = -0.;
25026 0 : d__ = z__[i4 - 3];
25027 : } else {
25028 0 : d__ = z__[i4 - 3] * (d__ / (d__ + z__[i4 - 1]));
25029 : }
25030 : }
25031 :
25032 0 : emin = z__[(i0 << 2) + pp + 1];
25033 0 : d__ = z__[(i0 << 2) + pp - 3];
25034 : i__1 = 4*(n0 - 1) + pp;
25035 0 : for (i4 = (i0 << 2) + pp; i4 <= i__1; i4 += 4) {
25036 0 : z__[i4 - (pp << 1) - 2] = d__ + z__[i4 - 1];
25037 0 : if (z__[i4 - 1] <= tol2 * d__) {
25038 0 : z__[i4 - 1] = -0.;
25039 0 : z__[i4 - (pp << 1) - 2] = d__;
25040 0 : z__[i4 - (pp << 1)] = 0.;
25041 0 : d__ = z__[i4 + 1];
25042 0 : } else if (safmin * z__[i4 + 1] < z__[i4 - (pp << 1) - 2] &&
25043 0 : safmin * z__[i4 - (pp << 1) - 2] < z__[i4 + 1]) {
25044 0 : temp = z__[i4 + 1] / z__[i4 - (pp << 1) - 2];
25045 0 : z__[i4 - (pp << 1)] = z__[i4 - 1] * temp;
25046 0 : d__ *= temp;
25047 : } else {
25048 0 : z__[i4 - (pp << 1)] = z__[i4 + 1] * (z__[i4 - 1] / z__[i4 - (
25049 : pp << 1) - 2]);
25050 0 : d__ = z__[i4 + 1] * (d__ / z__[i4 - (pp << 1) - 2]);
25051 : }
25052 0 : d__1 = emin, d__2 = z__[i4 - (pp << 1)];
25053 0 : emin = (d__1<d__2) ? d__1 : d__2;
25054 : }
25055 0 : z__[(n0 << 2) - pp - 2] = d__;
25056 :
25057 :
25058 0 : qmax = z__[(i0 << 2) - pp - 2];
25059 0 : i__1 = (n0 << 2) - pp - 2;
25060 0 : for (i4 = (i0 << 2) - pp + 2; i4 <= i__1; i4 += 4) {
25061 0 : d__1 = qmax, d__2 = z__[i4];
25062 0 : qmax = (d__1>d__2) ? d__1 : d__2;
25063 : }
25064 :
25065 0 : pp = 1 - pp;
25066 : }
25067 :
25068 0 : iter = 2;
25069 0 : nfail = 0;
25070 0 : ndiv = 2*(n0 - i0);
25071 :
25072 0 : i__1 = *n + 1;
25073 0 : for (iwhila = 1; iwhila <= i__1; ++iwhila) {
25074 0 : if (n0 < 1) {
25075 0 : goto L170;
25076 : }
25077 :
25078 0 : desig = 0.;
25079 0 : if (n0 == *n) {
25080 0 : sigma = 0.;
25081 : } else {
25082 0 : sigma = -z__[(n0 << 2) - 1];
25083 : }
25084 0 : if (sigma < 0.) {
25085 0 : *info = 1;
25086 0 : return;
25087 : }
25088 :
25089 : emax = 0.;
25090 0 : if (n0 > i0) {
25091 0 : emin = std::abs(z__[(n0 << 2) - 5]);
25092 : } else {
25093 : emin = 0.;
25094 : }
25095 0 : qmin = z__[(n0 << 2) - 3];
25096 0 : qmax = qmin;
25097 0 : for (i4 = n0 << 2; i4 >= 8; i4 += -4) {
25098 0 : if (z__[i4 - 5] <= 0.) {
25099 0 : goto L100;
25100 : }
25101 0 : if (qmin >= emax * 4.) {
25102 0 : d__1 = qmin, d__2 = z__[i4 - 3];
25103 0 : qmin = (d__1<d__2) ? d__1 : d__2;
25104 : d__1 = emax, d__2 = z__[i4 - 5];
25105 0 : emax = (d__1>d__2) ? d__1 : d__2;
25106 : }
25107 0 : d__1 = qmax, d__2 = z__[i4 - 7] + z__[i4 - 5];
25108 0 : qmax = (d__1>d__2) ? d__1 : d__2;
25109 : d__1 = emin, d__2 = z__[i4 - 5];
25110 0 : emin = (d__1<d__2) ? d__1 : d__2;
25111 : }
25112 : i4 = 4;
25113 :
25114 0 : L100:
25115 0 : i0 = i4 / 4;
25116 0 : pp = 0;
25117 :
25118 0 : if (n0 - i0 > 1) {
25119 0 : dee = z__[(i0 << 2) - 3];
25120 : deemin = dee;
25121 : kmin = i0;
25122 0 : i__2 = (n0 << 2) - 3;
25123 0 : for (i4 = (i0 << 2) - 3; i4 <= i__2; i4 += 4) {
25124 0 : dee = z__[i4] * (dee / (dee + z__[i4 - 2]));
25125 0 : if (dee <= deemin) {
25126 : deemin = dee;
25127 0 : kmin = (i4 + 3) / 4;
25128 : }
25129 : }
25130 0 : if (2*(kmin - i0) < n0 - kmin && deemin <= z__[(n0 << 2) - 3] *
25131 : .5) {
25132 0 : ipn4 = 4*(i0 + n0);
25133 0 : pp = 2;
25134 0 : i__2 = 2*(i0 + n0 - 1);
25135 0 : for (i4 = i0 << 2; i4 <= i__2; i4 += 4) {
25136 0 : temp = z__[i4 - 3];
25137 0 : z__[i4 - 3] = z__[ipn4 - i4 - 3];
25138 0 : z__[ipn4 - i4 - 3] = temp;
25139 0 : temp = z__[i4 - 2];
25140 0 : z__[i4 - 2] = z__[ipn4 - i4 - 2];
25141 0 : z__[ipn4 - i4 - 2] = temp;
25142 0 : temp = z__[i4 - 1];
25143 0 : z__[i4 - 1] = z__[ipn4 - i4 - 5];
25144 0 : z__[ipn4 - i4 - 5] = temp;
25145 0 : temp = z__[i4];
25146 0 : z__[i4] = z__[ipn4 - i4 - 4];
25147 0 : z__[ipn4 - i4 - 4] = temp;
25148 : }
25149 : }
25150 : }
25151 :
25152 :
25153 0 : d__1 = 0., d__2 = qmin - std::sqrt(qmin) * 2. * std::sqrt(emax);
25154 0 : dmin__ = -((d__1>d__2) ? d__1 : d__2);
25155 :
25156 0 : nbig = (n0 - i0 + 1) * 30;
25157 : i__2 = nbig;
25158 0 : for (iwhilb = 1; iwhilb <= i__2; ++iwhilb) {
25159 0 : if (i0 > n0) {
25160 0 : goto L150;
25161 : }
25162 :
25163 0 : PLUMED_BLAS_F77_FUNC(slasq3,SLASQ3)(&i0, &n0, &z__[1], &pp, &dmin__, &sigma, &desig, &qmax, &
25164 : nfail, &iter, &ndiv, &ieee);
25165 :
25166 0 : pp = 1 - pp;
25167 :
25168 0 : if (pp == 0 && n0 - i0 >= 3) {
25169 0 : if (z__[n0 * 4] <= tol2 * qmax || z__[(n0 << 2) - 1] <= tol2 *
25170 : sigma) {
25171 0 : splt = i0 - 1;
25172 0 : qmax = z__[(i0 << 2) - 3];
25173 0 : emin = z__[(i0 << 2) - 1];
25174 0 : oldemn = z__[i0 * 4];
25175 0 : i__3 = 4*(n0 - 3);
25176 0 : for (i4 = i0 << 2; i4 <= i__3; i4 += 4) {
25177 0 : if (z__[i4] <= tol2 * z__[i4 - 3] || z__[i4 - 1] <=
25178 0 : tol2 * sigma) {
25179 0 : z__[i4 - 1] = -sigma;
25180 0 : splt = i4 / 4;
25181 0 : qmax = 0.;
25182 0 : emin = z__[i4 + 3];
25183 0 : oldemn = z__[i4 + 4];
25184 : } else {
25185 0 : d__1 = qmax, d__2 = z__[i4 + 1];
25186 0 : qmax = (d__1>d__2) ? d__1 : d__2;
25187 : d__1 = emin, d__2 = z__[i4 - 1];
25188 0 : emin = (d__1<d__2) ? d__1 : d__2;
25189 : d__1 = oldemn, d__2 = z__[i4];
25190 0 : oldemn = (d__1<d__2) ? d__1 : d__2;
25191 : }
25192 : }
25193 0 : z__[(n0 << 2) - 1] = emin;
25194 0 : z__[n0 * 4] = oldemn;
25195 0 : i0 = splt + 1;
25196 : }
25197 : }
25198 : }
25199 :
25200 0 : *info = 2;
25201 0 : return;
25202 :
25203 : L150:
25204 : ;
25205 : }
25206 :
25207 0 : *info = 3;
25208 0 : return;
25209 :
25210 :
25211 : L170:
25212 :
25213 0 : i__1 = *n;
25214 0 : for (k = 2; k <= i__1; ++k) {
25215 0 : z__[k] = z__[(k << 2) - 3];
25216 : }
25217 :
25218 0 : PLUMED_BLAS_F77_FUNC(slasrt,SLASRT)("D", n, &z__[1], &iinfo);
25219 :
25220 : e = 0.;
25221 0 : for (k = *n; k >= 1; --k) {
25222 0 : e += z__[k];
25223 : }
25224 :
25225 :
25226 0 : z__[(*n << 1) + 1] = trace;
25227 0 : z__[(*n << 1) + 2] = e;
25228 0 : z__[(*n << 1) + 3] = (float) iter;
25229 0 : i__1 = *n;
25230 0 : z__[(*n << 1) + 4] = (float) ndiv / (float) (i__1 * i__1);
25231 0 : z__[(*n << 1) + 5] = nfail * 100. / (float) iter;
25232 :
25233 0 : return;
25234 :
25235 : }
25236 :
25237 :
25238 :
25239 : }
25240 : }
25241 : #include <cmath>
25242 : #include "real.h"
25243 :
25244 : #include "lapack.h"
25245 : #include "lapack_limits.h"
25246 :
25247 : #include "blas/blas.h"
25248 : namespace PLMD{
25249 : namespace lapack{
25250 : using namespace blas;
25251 : void
25252 0 : PLUMED_BLAS_F77_FUNC(slasq3,SLASQ3)(int *i0,
25253 : int *n0,
25254 : float *z__,
25255 : int *pp,
25256 : float *dmin__,
25257 : float *sigma,
25258 : float *desig,
25259 : float *qmax,
25260 : int *nfail,
25261 : int *iter,
25262 : int *ndiv,
25263 : int *ieee)
25264 : {
25265 :
25266 0 : int ttype = 0;
25267 0 : float dmin1 = 0.;
25268 0 : float dmin2 = 0.;
25269 0 : float dn = 0.;
25270 0 : float dn1 = 0.;
25271 0 : float dn2 = 0.;
25272 0 : float tau = 0.;
25273 :
25274 : int i__1;
25275 : float d__1, d__2;
25276 : float s, t;
25277 : int j4, nn;
25278 : float eps, tol;
25279 : int n0in, ipn4;
25280 : float tol2, temp;
25281 0 : --z__;
25282 :
25283 0 : n0in = *n0;
25284 : eps = PLUMED_GMX_FLOAT_EPS;
25285 : tol = eps * 100.;
25286 : d__1 = tol;
25287 : tol2 = d__1 * d__1;
25288 :
25289 :
25290 0 : L10:
25291 :
25292 0 : if (*n0 < *i0) {
25293 : return;
25294 : }
25295 0 : if (*n0 == *i0) {
25296 0 : goto L20;
25297 : }
25298 0 : nn = (*n0 << 2) + *pp;
25299 0 : if (*n0 == *i0 + 1) {
25300 0 : goto L40;
25301 : }
25302 :
25303 0 : if (z__[nn - 5] > tol2 * (*sigma + z__[nn - 3]) && z__[nn - (*pp << 1) -
25304 0 : 4] > tol2 * z__[nn - 7]) {
25305 0 : goto L30;
25306 : }
25307 :
25308 0 : L20:
25309 :
25310 0 : z__[(*n0 << 2) - 3] = z__[(*n0 << 2) + *pp - 3] + *sigma;
25311 0 : --(*n0);
25312 0 : goto L10;
25313 :
25314 : L30:
25315 :
25316 0 : if (z__[nn - 9] > tol2 * *sigma && z__[nn - (*pp << 1) - 8] > tol2 * z__[
25317 0 : nn - 11]) {
25318 0 : goto L50;
25319 : }
25320 :
25321 0 : L40:
25322 :
25323 0 : if (z__[nn - 3] > z__[nn - 7]) {
25324 : s = z__[nn - 3];
25325 0 : z__[nn - 3] = z__[nn - 7];
25326 0 : z__[nn - 7] = s;
25327 : }
25328 0 : if (z__[nn - 5] > z__[nn - 3] * tol2) {
25329 0 : t = (z__[nn - 7] - z__[nn - 3] + z__[nn - 5]) * .5;
25330 0 : s = z__[nn - 3] * (z__[nn - 5] / t);
25331 0 : if (s <= t) {
25332 0 : s = z__[nn - 3] * (z__[nn - 5] / (t * ( std::sqrt(s / t + 1.) + 1.)));
25333 : } else {
25334 0 : s = z__[nn - 3] * (z__[nn - 5] / (t + std::sqrt(t) * std::sqrt(t + s)));
25335 : }
25336 0 : t = z__[nn - 7] + (s + z__[nn - 5]);
25337 0 : z__[nn - 3] *= z__[nn - 7] / t;
25338 0 : z__[nn - 7] = t;
25339 : }
25340 0 : z__[(*n0 << 2) - 7] = z__[nn - 7] + *sigma;
25341 0 : z__[(*n0 << 2) - 3] = z__[nn - 3] + *sigma;
25342 0 : *n0 += -2;
25343 0 : goto L10;
25344 :
25345 : L50:
25346 0 : if (*pp == 2) {
25347 0 : *pp = 0;
25348 : }
25349 :
25350 0 : if (*dmin__ <= 0. || *n0 < n0in) {
25351 0 : if (z__[(*i0 << 2) + *pp - 3] * 1.5 < z__[(*n0 << 2) + *pp - 3]) {
25352 0 : ipn4 = 4*(*i0 + *n0);
25353 0 : i__1 = 2*(*i0 + *n0 - 1);
25354 0 : for (j4 = *i0 << 2; j4 <= i__1; j4 += 4) {
25355 0 : temp = z__[j4 - 3];
25356 0 : z__[j4 - 3] = z__[ipn4 - j4 - 3];
25357 0 : z__[ipn4 - j4 - 3] = temp;
25358 0 : temp = z__[j4 - 2];
25359 0 : z__[j4 - 2] = z__[ipn4 - j4 - 2];
25360 0 : z__[ipn4 - j4 - 2] = temp;
25361 0 : temp = z__[j4 - 1];
25362 0 : z__[j4 - 1] = z__[ipn4 - j4 - 5];
25363 0 : z__[ipn4 - j4 - 5] = temp;
25364 0 : temp = z__[j4];
25365 0 : z__[j4] = z__[ipn4 - j4 - 4];
25366 0 : z__[ipn4 - j4 - 4] = temp;
25367 : }
25368 0 : if (*n0 - *i0 <= 4) {
25369 0 : z__[(*n0 << 2) + *pp - 1] = z__[(*i0 << 2) + *pp - 1];
25370 0 : z__[(*n0 << 2) - *pp] = z__[(*i0 << 2) - *pp];
25371 : }
25372 0 : d__1 = dmin2, d__2 = z__[(*n0 << 2) + *pp - 1];
25373 0 : dmin2 = ((d__1<d__2) ? d__1 : d__2);
25374 0 : d__1 = z__[(*n0 << 2) + *pp - 1], d__2 = z__[(*i0 << 2) + *pp - 1]
25375 0 : , d__1 = ((d__1<d__2) ? d__1 : d__2), d__2 = z__[(*i0 << 2) + *pp + 3];
25376 0 : z__[(*n0 << 2) + *pp - 1] = ((d__1<d__2) ? d__1 : d__2);
25377 0 : d__1 = z__[(*n0 << 2) - *pp], d__2 = z__[(*i0 << 2) - *pp], d__1 =
25378 0 : ((d__1<d__2) ? d__1 : d__2), d__2 = z__[(*i0 << 2) - *pp + 4];
25379 0 : z__[(*n0 << 2) - *pp] = ((d__1<d__2) ? d__1 : d__2);
25380 0 : d__1 = *qmax;
25381 0 : d__2 = z__[(*i0 << 2) + *pp - 3];
25382 0 : d__1 = (d__1>d__2) ? d__1 : d__2;
25383 0 : d__2 = z__[(*i0 << 2) + *pp + 1];
25384 0 : *qmax = ((d__1>d__2) ? d__1 : d__2);
25385 0 : *dmin__ = -0.;
25386 : }
25387 : }
25388 :
25389 :
25390 0 : PLUMED_BLAS_F77_FUNC(slasq4,SLASQ4)(i0, n0, &z__[1], pp, &n0in, dmin__, &dmin1, &dmin2, &dn, &dn1, &
25391 : dn2, &tau, &ttype);
25392 :
25393 0 : L70:
25394 :
25395 0 : PLUMED_BLAS_F77_FUNC(slasq5,SLASQ5)(i0, n0, &z__[1], pp, &tau, dmin__, &dmin1, &dmin2, &dn, &dn1, &
25396 : dn2, ieee);
25397 :
25398 0 : *ndiv += *n0 - *i0 + 2;
25399 0 : ++(*iter);
25400 :
25401 0 : if (*dmin__ >= 0. && dmin1 > 0.) {
25402 :
25403 0 : goto L90;
25404 :
25405 0 : } else if (*dmin__ < 0. && dmin1 > 0. && z__[4*(*n0 - 1) - *pp] < tol *
25406 0 : (*sigma + dn1) && std::abs(dn) < tol * *sigma) {
25407 :
25408 0 : z__[4*(*n0 - 1) - *pp + 2] = 0.;
25409 0 : *dmin__ = 0.;
25410 0 : goto L90;
25411 0 : } else if (*dmin__ < 0.) {
25412 :
25413 0 : ++(*nfail);
25414 0 : if (ttype < -22) {
25415 :
25416 0 : tau = 0.;
25417 0 : } else if (dmin1 > 0.) {
25418 :
25419 0 : tau = (tau + *dmin__) * (1. - eps * 2.);
25420 0 : ttype += -11;
25421 : } else {
25422 :
25423 0 : tau *= .25;
25424 0 : ttype += -12;
25425 : }
25426 0 : goto L70;
25427 : }
25428 : else {
25429 :
25430 0 : goto L80;
25431 : }
25432 :
25433 : L80:
25434 0 : PLUMED_BLAS_F77_FUNC(slasq6,SLASQ6)(i0, n0, &z__[1], pp, dmin__, &dmin1, &dmin2, &dn, &dn1, &dn2);
25435 0 : *ndiv += *n0 - *i0 + 2;
25436 0 : ++(*iter);
25437 0 : tau = 0.;
25438 :
25439 0 : L90:
25440 0 : if (tau < *sigma) {
25441 0 : *desig += tau;
25442 0 : t = *sigma + *desig;
25443 0 : *desig -= t - *sigma;
25444 : } else {
25445 0 : t = *sigma + tau;
25446 0 : *desig = *sigma - (t - tau) + *desig;
25447 : }
25448 0 : *sigma = t;
25449 :
25450 0 : return;
25451 : }
25452 : }
25453 : }
25454 : #include <cmath>
25455 : #include "real.h"
25456 :
25457 : #include "lapack.h"
25458 :
25459 : #include "blas/blas.h"
25460 : namespace PLMD{
25461 : namespace lapack{
25462 : using namespace blas;
25463 : void
25464 0 : PLUMED_BLAS_F77_FUNC(slasq4,SLASQ4)(int *i0,
25465 : int *n0,
25466 : float *z__,
25467 : int *pp,
25468 : int *n0in,
25469 : float *dmin__,
25470 : float *dmin1,
25471 : float *dmin2,
25472 : float *dn,
25473 : float *dn1,
25474 : float *dn2,
25475 : float *tau,
25476 : int *ttype)
25477 : {
25478 : float g = 0.;
25479 : int i__1;
25480 : float d__1, d__2;
25481 :
25482 : float s, a2, b1, b2;
25483 : int i4, nn, np;
25484 : float gam, gap1, gap2;
25485 :
25486 :
25487 0 : if (*dmin__ <= 0.) {
25488 0 : *tau = -(*dmin__);
25489 0 : *ttype = -1;
25490 0 : return;
25491 : }
25492 :
25493 : s = 0.0;
25494 :
25495 0 : nn = (*n0 << 2) + *pp;
25496 0 : if (*n0in == *n0) {
25497 :
25498 0 : if ( std::abs(*dmin__ - *dn)<PLUMED_GMX_FLOAT_EPS*std::abs(*dmin__ + *dn) ||
25499 0 : std::abs(*dmin__ - *dn1)<PLUMED_GMX_FLOAT_EPS*std::abs(*dmin__ + *dn1)) {
25500 :
25501 0 : b1 = std::sqrt(z__[nn - 3]) * std::sqrt(z__[nn - 5]);
25502 0 : b2 = std::sqrt(z__[nn - 7]) * std::sqrt(z__[nn - 9]);
25503 0 : a2 = z__[nn - 7] + z__[nn - 5];
25504 :
25505 0 : if ( std::abs(*dmin__ - *dn)<PLUMED_GMX_FLOAT_EPS*std::abs(*dmin__ + *dn) &&
25506 0 : std::abs(*dmin1 - *dn1)<PLUMED_GMX_FLOAT_EPS*std::abs(*dmin1 + *dn1)) {
25507 :
25508 0 : gap2 = *dmin2 - a2 - *dmin2 * .25;
25509 0 : if (gap2 > 0. && gap2 > b2) {
25510 0 : gap1 = a2 - *dn - b2 / gap2 * b2;
25511 : } else {
25512 0 : gap1 = a2 - *dn - (b1 + b2);
25513 : }
25514 0 : if (gap1 > 0. && gap1 > b1) {
25515 0 : d__1 = *dn - b1 / gap1 * b1, d__2 = *dmin__ * .5;
25516 0 : s = (d__1>d__2) ? d__1 : d__2;
25517 0 : *ttype = -2;
25518 : } else {
25519 : s = 0.;
25520 0 : if (*dn > b1) {
25521 0 : s = *dn - b1;
25522 : }
25523 0 : if (a2 > b1 + b2) {
25524 0 : d__1 = s, d__2 = a2 - (b1 + b2);
25525 0 : s = (d__1<d__2) ? d__1 : d__2;
25526 : }
25527 0 : d__1 = s, d__2 = *dmin__ * .333;
25528 0 : s = (d__1>d__2) ? d__1 : d__2;
25529 0 : *ttype = -3;
25530 : }
25531 : } else {
25532 :
25533 :
25534 0 : *ttype = -4;
25535 0 : s = *dmin__ * .25;
25536 0 : if (std::abs(*dmin__ - *dn)<PLUMED_GMX_FLOAT_EPS*std::abs(*dmin__ + *dn)) {
25537 : gam = *dn;
25538 : a2 = 0.;
25539 0 : if (z__[nn - 5] > z__[nn - 7]) {
25540 : return;
25541 : }
25542 0 : b2 = z__[nn - 5] / z__[nn - 7];
25543 0 : np = nn - 9;
25544 : } else {
25545 0 : np = nn - (*pp << 1);
25546 0 : gam = *dn1;
25547 0 : if (z__[np - 4] > z__[np - 2]) {
25548 : return;
25549 : }
25550 0 : a2 = z__[np - 4] / z__[np - 2];
25551 0 : if (z__[nn - 9] > z__[nn - 11]) {
25552 : return;
25553 : }
25554 0 : b2 = z__[nn - 9] / z__[nn - 11];
25555 0 : np = nn - 13;
25556 : }
25557 :
25558 :
25559 0 : a2 += b2;
25560 0 : i__1 = (*i0 << 2) - 1 + *pp;
25561 0 : for (i4 = np; i4 >= i__1; i4 += -4) {
25562 0 : if (std::abs(b2)<PLUMED_GMX_FLOAT_MIN) {
25563 0 : goto L20;
25564 : }
25565 : b1 = b2;
25566 0 : if (z__[i4] > z__[i4 - 2]) {
25567 : return;
25568 : }
25569 0 : b2 *= z__[i4] / z__[i4 - 2];
25570 0 : a2 += b2;
25571 0 : if (((b2>b1) ? b2 : b1) * 100. < a2 || .563 < a2) {
25572 0 : goto L20;
25573 : }
25574 : }
25575 0 : L20:
25576 0 : a2 *= 1.05;
25577 :
25578 :
25579 0 : if (a2 < .563) {
25580 0 : s = gam * (1. - std::sqrt(a2)) / (a2 + 1.);
25581 : }
25582 : }
25583 0 : } else if (std::abs(*dmin__ - *dn2)<PLUMED_GMX_FLOAT_EPS*std::abs(*dmin__ + *dn2)) {
25584 :
25585 0 : *ttype = -5;
25586 0 : s = *dmin__ * .25;
25587 :
25588 0 : np = nn - (*pp << 1);
25589 0 : b1 = z__[np - 2];
25590 0 : b2 = z__[np - 6];
25591 0 : gam = *dn2;
25592 0 : if (z__[np - 8] > b2 || z__[np - 4] > b1) {
25593 : return;
25594 : }
25595 0 : a2 = z__[np - 8] / b2 * (z__[np - 4] / b1 + 1.);
25596 :
25597 :
25598 0 : if (*n0 - *i0 > 2) {
25599 0 : b2 = z__[nn - 13] / z__[nn - 15];
25600 0 : a2 += b2;
25601 0 : i__1 = (*i0 << 2) - 1 + *pp;
25602 0 : for (i4 = nn - 17; i4 >= i__1; i4 += -4) {
25603 0 : if (std::abs(b2)<PLUMED_GMX_FLOAT_MIN) {
25604 0 : goto L40;
25605 : }
25606 : b1 = b2;
25607 0 : if (z__[i4] > z__[i4 - 2]) {
25608 : return;
25609 : }
25610 0 : b2 *= z__[i4] / z__[i4 - 2];
25611 0 : a2 += b2;
25612 0 : if (((b2>b1) ? b2 : b1) * 100. < a2 || .563 < a2) {
25613 0 : goto L40;
25614 : }
25615 : }
25616 0 : L40:
25617 0 : a2 *= 1.05;
25618 : }
25619 :
25620 0 : if (a2 < .563) {
25621 0 : s = gam * (1. - std::sqrt(a2)) / (a2 + 1.);
25622 : }
25623 : } else {
25624 :
25625 0 : if (*ttype == -6) {
25626 : g += (1. - g) * .333;
25627 0 : } else if (*ttype == -18) {
25628 : g = .083250000000000005;
25629 : } else {
25630 : g = .25;
25631 : }
25632 0 : s = g * *dmin__;
25633 0 : *ttype = -6;
25634 : }
25635 :
25636 0 : } else if (*n0in == *n0 + 1) {
25637 :
25638 0 : if ( std::abs(*dmin1 - *dn1)<PLUMED_GMX_FLOAT_EPS*std::abs(*dmin1 + *dn1) &&
25639 0 : std::abs(*dmin2 - *dn2)<PLUMED_GMX_FLOAT_EPS*std::abs(*dmin2 + *dn2)) {
25640 :
25641 0 : *ttype = -7;
25642 0 : s = *dmin1 * .333;
25643 0 : if (z__[nn - 5] > z__[nn - 7]) {
25644 : return;
25645 : }
25646 0 : b1 = z__[nn - 5] / z__[nn - 7];
25647 : b2 = b1;
25648 0 : if (std::abs(b2)<PLUMED_GMX_FLOAT_MIN) {
25649 0 : goto L60;
25650 : }
25651 0 : i__1 = (*i0 << 2) - 1 + *pp;
25652 0 : for (i4 = (*n0 << 2) - 9 + *pp; i4 >= i__1; i4 += -4) {
25653 : a2 = b1;
25654 0 : if (z__[i4] > z__[i4 - 2]) {
25655 : return;
25656 : }
25657 0 : b1 *= z__[i4] / z__[i4 - 2];
25658 0 : b2 += b1;
25659 0 : if (((a2>b1) ? a2 : b1) * 100. < b2) {
25660 0 : goto L60;
25661 : }
25662 : }
25663 0 : L60:
25664 0 : b2 = std::sqrt(b2 * 1.05);
25665 : d__1 = b2;
25666 0 : a2 = *dmin1 / (d__1 * d__1 + 1.);
25667 0 : gap2 = *dmin2 * .5 - a2;
25668 0 : if (gap2 > 0. && gap2 > b2 * a2) {
25669 0 : d__1 = s, d__2 = a2 * (1. - a2 * 1.01 * (b2 / gap2) * b2);
25670 0 : s = (d__1>d__2) ? d__1 : d__2;
25671 : } else {
25672 0 : d__1 = s, d__2 = a2 * (1. - b2 * 1.01);
25673 0 : s = (d__1>d__2) ? d__1 : d__2;
25674 0 : *ttype = -8;
25675 : }
25676 : } else {
25677 :
25678 0 : s = *dmin1 * .25;
25679 0 : if (std::abs(*dmin1 - *dn1)<PLUMED_GMX_FLOAT_EPS*std::abs(*dmin1 + *dn1)) {
25680 0 : s = *dmin1 * .5;
25681 : }
25682 0 : *ttype = -9;
25683 : }
25684 :
25685 0 : } else if (*n0in == *n0 + 2) {
25686 :
25687 0 : if (std::abs(*dmin2 - *dn2)<PLUMED_GMX_FLOAT_EPS*std::abs(*dmin2 + *dn2) &&
25688 0 : z__[nn - 5] * 2. < z__[nn - 7]) {
25689 0 : *ttype = -10;
25690 0 : s = *dmin2 * .333;
25691 0 : if (z__[nn - 5] > z__[nn - 7]) {
25692 : return;
25693 : }
25694 0 : b1 = z__[nn - 5] / z__[nn - 7];
25695 : b2 = b1;
25696 0 : if (std::abs(b2)<PLUMED_GMX_FLOAT_MIN) {
25697 0 : goto L80;
25698 : }
25699 0 : i__1 = (*i0 << 2) - 1 + *pp;
25700 0 : for (i4 = (*n0 << 2) - 9 + *pp; i4 >= i__1; i4 += -4) {
25701 0 : if (z__[i4] > z__[i4 - 2]) {
25702 : return;
25703 : }
25704 0 : b1 *= z__[i4] / z__[i4 - 2];
25705 0 : b2 += b1;
25706 0 : if (b1 * 100. < b2) {
25707 0 : goto L80;
25708 : }
25709 : }
25710 0 : L80:
25711 0 : b2 = std::sqrt(b2 * 1.05);
25712 : d__1 = b2;
25713 0 : a2 = *dmin2 / (d__1 * d__1 + 1.);
25714 0 : gap2 = z__[nn - 7] + z__[nn - 9] - std::sqrt(z__[nn - 11]) * std::sqrt(z__[
25715 : nn - 9]) - a2;
25716 0 : if (gap2 > 0. && gap2 > b2 * a2) {
25717 0 : d__1 = s, d__2 = a2 * (1. - a2 * 1.01 * (b2 / gap2) * b2);
25718 0 : s = (d__1>d__2) ? d__1 : d__2;
25719 : } else {
25720 0 : d__1 = s, d__2 = a2 * (1. - b2 * 1.01);
25721 0 : s = (d__1>d__2) ? d__1 : d__2;
25722 : }
25723 : } else {
25724 0 : s = *dmin2 * .25;
25725 0 : *ttype = -11;
25726 : }
25727 0 : } else if (*n0in > *n0 + 2) {
25728 :
25729 : s = 0.;
25730 0 : *ttype = -12;
25731 : }
25732 :
25733 0 : *tau = s;
25734 0 : return;
25735 :
25736 : }
25737 :
25738 :
25739 : }
25740 : }
25741 : #include <cmath>
25742 : #include "lapack.h"
25743 :
25744 : #include "blas/blas.h"
25745 : namespace PLMD{
25746 : namespace lapack{
25747 : using namespace blas;
25748 : void
25749 0 : PLUMED_BLAS_F77_FUNC(slasq5,SLASQ5)(int *i0,
25750 : int *n0,
25751 : float *z__,
25752 : int *pp,
25753 : float *tau,
25754 : float *dmin__,
25755 : float *dmin1,
25756 : float *dmin2,
25757 : float *dn,
25758 : float *dnm1,
25759 : float *dnm2,
25760 : int *ieee)
25761 : {
25762 : int i__1;
25763 : float d__1, d__2;
25764 :
25765 : float d__;
25766 : int j4, j4p2;
25767 : float emin, temp;
25768 :
25769 0 : --z__;
25770 :
25771 0 : if (*n0 - *i0 - 1 <= 0) {
25772 : return;
25773 : }
25774 :
25775 0 : j4 = (*i0 << 2) + *pp - 3;
25776 0 : emin = z__[j4 + 4];
25777 0 : d__ = z__[j4] - *tau;
25778 0 : *dmin__ = d__;
25779 0 : *dmin1 = -z__[j4];
25780 :
25781 0 : if (*ieee) {
25782 :
25783 0 : if (*pp == 0) {
25784 0 : i__1 = 4*(*n0 - 3);
25785 0 : for (j4 = *i0 << 2; j4 <= i__1; j4 += 4) {
25786 0 : z__[j4 - 2] = d__ + z__[j4 - 1];
25787 0 : temp = z__[j4 + 1] / z__[j4 - 2];
25788 0 : d__ = d__ * temp - *tau;
25789 0 : if(d__<*dmin__)
25790 0 : *dmin__ = d__;
25791 0 : z__[j4] = z__[j4 - 1] * temp;
25792 : d__1 = z__[j4];
25793 0 : if(d__1<emin)
25794 : emin = d__1;
25795 : }
25796 : } else {
25797 0 : i__1 = 4*(*n0 - 3);
25798 0 : for (j4 = *i0 << 2; j4 <= i__1; j4 += 4) {
25799 0 : z__[j4 - 3] = d__ + z__[j4];
25800 0 : temp = z__[j4 + 2] / z__[j4 - 3];
25801 0 : d__ = d__ * temp - *tau;
25802 0 : if(d__<*dmin__)
25803 0 : *dmin__ = d__;
25804 0 : z__[j4 - 1] = z__[j4] * temp;
25805 : d__1 = z__[j4 - 1];
25806 0 : if(d__1<emin)
25807 : emin = d__1;
25808 : }
25809 : }
25810 :
25811 0 : *dnm2 = d__;
25812 0 : *dmin2 = *dmin__;
25813 0 : j4 = 4*(*n0 - 2) - *pp;
25814 0 : j4p2 = j4 + (*pp << 1) - 1;
25815 0 : z__[j4 - 2] = *dnm2 + z__[j4p2];
25816 0 : z__[j4] = z__[j4p2 + 2] * (z__[j4p2] / z__[j4 - 2]);
25817 0 : *dnm1 = z__[j4p2 + 2] * (*dnm2 / z__[j4 - 2]) - *tau;
25818 0 : if(*dnm1<*dmin__)
25819 0 : *dmin__ = *dnm1;
25820 :
25821 0 : *dmin1 = *dmin__;
25822 0 : j4 += 4;
25823 0 : j4p2 = j4 + (*pp << 1) - 1;
25824 0 : z__[j4 - 2] = *dnm1 + z__[j4p2];
25825 0 : z__[j4] = z__[j4p2 + 2] * (z__[j4p2] / z__[j4 - 2]);
25826 0 : *dn = z__[j4p2 + 2] * (*dnm1 / z__[j4 - 2]) - *tau;
25827 0 : if(*dn<*dmin__)
25828 0 : *dmin__ = *dn;
25829 :
25830 : } else {
25831 :
25832 0 : if (*pp == 0) {
25833 0 : i__1 = 4*(*n0 - 3);
25834 0 : for (j4 = *i0 << 2; j4 <= i__1; j4 += 4) {
25835 0 : z__[j4 - 2] = d__ + z__[j4 - 1];
25836 0 : if (d__ < 0.) {
25837 : return;
25838 : } else {
25839 0 : z__[j4] = z__[j4 + 1] * (z__[j4 - 1] / z__[j4 - 2]);
25840 0 : d__ = z__[j4 + 1] * (d__ / z__[j4 - 2]) - *tau;
25841 : }
25842 0 : if(d__<*dmin__)
25843 0 : *dmin__ = d__;
25844 0 : d__1 = emin, d__2 = z__[j4];
25845 0 : emin = (d__1<d__2) ? d__1 : d__2;
25846 : }
25847 : } else {
25848 0 : i__1 = 4*(*n0 - 3);
25849 0 : for (j4 = *i0 << 2; j4 <= i__1; j4 += 4) {
25850 0 : z__[j4 - 3] = d__ + z__[j4];
25851 0 : if (d__ < 0.) {
25852 : return;
25853 : } else {
25854 0 : z__[j4 - 1] = z__[j4 + 2] * (z__[j4] / z__[j4 - 3]);
25855 0 : d__ = z__[j4 + 2] * (d__ / z__[j4 - 3]) - *tau;
25856 : }
25857 0 : if(d__<*dmin__)
25858 0 : *dmin__ = d__;
25859 0 : d__1 = emin, d__2 = z__[j4 - 1];
25860 0 : emin = (d__1<d__2) ? d__1 : d__2;
25861 : }
25862 : }
25863 :
25864 0 : *dnm2 = d__;
25865 0 : *dmin2 = *dmin__;
25866 0 : j4 = 4*(*n0 - 2) - *pp;
25867 0 : j4p2 = j4 + (*pp << 1) - 1;
25868 0 : z__[j4 - 2] = *dnm2 + z__[j4p2];
25869 0 : if (*dnm2 < 0.) {
25870 : return;
25871 : } else {
25872 0 : z__[j4] = z__[j4p2 + 2] * (z__[j4p2] / z__[j4 - 2]);
25873 0 : *dnm1 = z__[j4p2 + 2] * (*dnm2 / z__[j4 - 2]) - *tau;
25874 : }
25875 0 : if(*dnm1<*dmin__)
25876 0 : *dmin__ = *dnm1;
25877 :
25878 0 : *dmin1 = *dmin__;
25879 0 : j4 += 4;
25880 0 : j4p2 = j4 + (*pp << 1) - 1;
25881 0 : z__[j4 - 2] = *dnm1 + z__[j4p2];
25882 0 : if (*dnm1 < 0.) {
25883 : return;
25884 : } else {
25885 0 : z__[j4] = z__[j4p2 + 2] * (z__[j4p2] / z__[j4 - 2]);
25886 0 : *dn = z__[j4p2 + 2] * (*dnm1 / z__[j4 - 2]) - *tau;
25887 : }
25888 0 : if(*dn<*dmin__)
25889 0 : *dmin__ = *dn;
25890 :
25891 : }
25892 :
25893 0 : z__[j4 + 2] = *dn;
25894 0 : z__[(*n0 << 2) - *pp] = emin;
25895 0 : return;
25896 :
25897 : }
25898 :
25899 : }
25900 : }
25901 : #include <cmath>
25902 : #include "lapack.h"
25903 : #include "lapack_limits.h"
25904 :
25905 : #include "real.h"
25906 :
25907 : #include "blas/blas.h"
25908 : namespace PLMD{
25909 : namespace lapack{
25910 : using namespace blas;
25911 : void
25912 0 : PLUMED_BLAS_F77_FUNC(slasq6,SLASQ6)(int *i0,
25913 : int *n0,
25914 : float *z__,
25915 : int *pp,
25916 : float *dmin__,
25917 : float *dmin1,
25918 : float *dmin2,
25919 : float *dn,
25920 : float *dnm1,
25921 : float *dnm2)
25922 : {
25923 : int i__1;
25924 : float d__1, d__2;
25925 :
25926 : /* Local variables */
25927 : float d__;
25928 : int j4, j4p2;
25929 : float emin, temp;
25930 : const float safemin = PLUMED_GMX_FLOAT_MIN*(1.0+PLUMED_GMX_FLOAT_EPS);
25931 :
25932 0 : --z__;
25933 :
25934 0 : if (*n0 - *i0 - 1 <= 0) {
25935 : return;
25936 : }
25937 :
25938 0 : j4 = (*i0 << 2) + *pp - 3;
25939 0 : emin = z__[j4 + 4];
25940 0 : d__ = z__[j4];
25941 0 : *dmin__ = d__;
25942 :
25943 0 : if (*pp == 0) {
25944 0 : i__1 = 4*(*n0 - 3);
25945 0 : for (j4 = *i0*4; j4 <= i__1; j4 += 4) {
25946 0 : z__[j4 - 2] = d__ + z__[j4 - 1];
25947 0 : if (std::abs(z__[j4 - 2])<PLUMED_GMX_FLOAT_MIN) {
25948 0 : z__[j4] = 0.;
25949 0 : d__ = z__[j4 + 1];
25950 0 : *dmin__ = d__;
25951 : emin = 0.;
25952 0 : } else if (safemin * z__[j4 + 1] < z__[j4 - 2] && safemin * z__[j4
25953 : - 2] < z__[j4 + 1]) {
25954 0 : temp = z__[j4 + 1] / z__[j4 - 2];
25955 0 : z__[j4] = z__[j4 - 1] * temp;
25956 0 : d__ *= temp;
25957 : } else {
25958 0 : z__[j4] = z__[j4 + 1] * (z__[j4 - 1] / z__[j4 - 2]);
25959 0 : d__ = z__[j4 + 1] * (d__ / z__[j4 - 2]);
25960 : }
25961 0 : if(d__<*dmin__)
25962 0 : *dmin__ = d__;
25963 :
25964 0 : d__1 = emin, d__2 = z__[j4];
25965 0 : emin = (d__1<d__2) ? d__1 : d__2;
25966 : }
25967 : } else {
25968 0 : i__1 = 4*(*n0 - 3);
25969 0 : for (j4 = *i0 << 2; j4 <= i__1; j4 += 4) {
25970 0 : z__[j4 - 3] = d__ + z__[j4];
25971 0 : if (std::abs(z__[j4 - 3])<PLUMED_GMX_FLOAT_MIN) {
25972 0 : z__[j4 - 1] = 0.;
25973 0 : d__ = z__[j4 + 2];
25974 0 : *dmin__ = d__;
25975 : emin = 0.;
25976 0 : } else if (safemin * z__[j4 + 2] < z__[j4 - 3] && safemin * z__[j4
25977 : - 3] < z__[j4 + 2]) {
25978 0 : temp = z__[j4 + 2] / z__[j4 - 3];
25979 0 : z__[j4 - 1] = z__[j4] * temp;
25980 0 : d__ *= temp;
25981 : } else {
25982 0 : z__[j4 - 1] = z__[j4 + 2] * (z__[j4] / z__[j4 - 3]);
25983 0 : d__ = z__[j4 + 2] * (d__ / z__[j4 - 3]);
25984 : }
25985 0 : if(d__<*dmin__)
25986 0 : *dmin__ = d__;
25987 0 : d__1 = emin, d__2 = z__[j4 - 1];
25988 0 : emin = (d__1<d__2) ? d__1 : d__2;
25989 : }
25990 : }
25991 :
25992 0 : *dnm2 = d__;
25993 0 : *dmin2 = *dmin__;
25994 0 : j4 = 4*(*n0 - 2) - *pp;
25995 0 : j4p2 = j4 + (*pp << 1) - 1;
25996 0 : z__[j4 - 2] = *dnm2 + z__[j4p2];
25997 0 : if (std::abs(z__[j4 - 2])<PLUMED_GMX_FLOAT_MIN) {
25998 0 : z__[j4] = 0.;
25999 0 : *dnm1 = z__[j4p2 + 2];
26000 0 : *dmin__ = *dnm1;
26001 : emin = 0.;
26002 0 : } else if (safemin * z__[j4p2 + 2] < z__[j4 - 2] && safemin * z__[j4 - 2] <
26003 : z__[j4p2 + 2]) {
26004 0 : temp = z__[j4p2 + 2] / z__[j4 - 2];
26005 0 : z__[j4] = z__[j4p2] * temp;
26006 0 : *dnm1 = *dnm2 * temp;
26007 : } else {
26008 0 : z__[j4] = z__[j4p2 + 2] * (z__[j4p2] / z__[j4 - 2]);
26009 0 : *dnm1 = z__[j4p2 + 2] * (*dnm2 / z__[j4 - 2]);
26010 : }
26011 0 : if(*dnm1<*dmin__)
26012 0 : *dmin__ = *dnm1;
26013 :
26014 0 : *dmin1 = *dmin__;
26015 0 : j4 += 4;
26016 0 : j4p2 = j4 + (*pp << 1) - 1;
26017 0 : z__[j4 - 2] = *dnm1 + z__[j4p2];
26018 0 : if (std::abs(z__[j4 - 2])<PLUMED_GMX_FLOAT_MIN) {
26019 0 : z__[j4] = 0.;
26020 0 : *dn = z__[j4p2 + 2];
26021 0 : *dmin__ = *dn;
26022 : emin = 0.;
26023 0 : } else if (safemin * z__[j4p2 + 2] < z__[j4 - 2] && safemin * z__[j4 - 2] <
26024 : z__[j4p2 + 2]) {
26025 0 : temp = z__[j4p2 + 2] / z__[j4 - 2];
26026 0 : z__[j4] = z__[j4p2] * temp;
26027 0 : *dn = *dnm1 * temp;
26028 : } else {
26029 0 : z__[j4] = z__[j4p2 + 2] * (z__[j4p2] / z__[j4 - 2]);
26030 0 : *dn = z__[j4p2 + 2] * (*dnm1 / z__[j4 - 2]);
26031 : }
26032 0 : if(*dn<*dmin__)
26033 0 : *dmin__ = *dn;
26034 :
26035 0 : z__[j4 + 2] = *dn;
26036 0 : z__[(*n0 << 2) - *pp] = emin;
26037 0 : return;
26038 :
26039 :
26040 : }
26041 : }
26042 : }
26043 : #include <cmath>
26044 :
26045 : #include "real.h"
26046 : #include "lapack.h"
26047 :
26048 : #include "blas/blas.h"
26049 : namespace PLMD{
26050 : namespace lapack{
26051 : using namespace blas;
26052 : void
26053 0 : PLUMED_BLAS_F77_FUNC(slasr,SLASR)(const char *side,
26054 : const char *pivot,
26055 : const char *direct,
26056 : int *m,
26057 : int *n,
26058 : float *c__,
26059 : float *s,
26060 : float *a,
26061 : int *lda)
26062 : {
26063 : /* System generated locals */
26064 : int a_dim1, a_offset, i__1, i__2;
26065 :
26066 : /* Local variables */
26067 : int i__, j;
26068 : float temp;
26069 : float ctemp, stemp;
26070 :
26071 0 : --c__;
26072 0 : --s;
26073 0 : a_dim1 = *lda;
26074 0 : a_offset = 1 + a_dim1;
26075 0 : a -= a_offset;
26076 :
26077 : /* Function Body */
26078 :
26079 0 : if (*m == 0 || *n == 0) {
26080 : return;
26081 : }
26082 0 : if (*side=='L' || *side=='l') {
26083 :
26084 0 : if (*pivot=='V' || *pivot=='v') {
26085 0 : if (*direct=='F' || *direct=='f') {
26086 : i__1 = *m - 1;
26087 0 : for (j = 1; j <= i__1; ++j) {
26088 0 : ctemp = c__[j];
26089 0 : stemp = s[j];
26090 0 : if (std::abs(ctemp-1.0)>PLUMED_GMX_FLOAT_EPS || std::abs(stemp)>PLUMED_GMX_FLOAT_MIN) {
26091 0 : i__2 = *n;
26092 0 : for (i__ = 1; i__ <= i__2; ++i__) {
26093 0 : temp = a[j + 1 + i__ * a_dim1];
26094 0 : a[j + 1 + i__ * a_dim1] = ctemp * temp - stemp *
26095 0 : a[j + i__ * a_dim1];
26096 0 : a[j + i__ * a_dim1] = stemp * temp + ctemp * a[j
26097 0 : + i__ * a_dim1];
26098 : }
26099 : }
26100 : }
26101 0 : } else if (*direct=='B' || *direct=='b') {
26102 0 : for (j = *m - 1; j >= 1; --j) {
26103 0 : ctemp = c__[j];
26104 0 : stemp = s[j];
26105 0 : if (std::abs(ctemp-1.0)>PLUMED_GMX_FLOAT_EPS || std::abs(stemp)>PLUMED_GMX_FLOAT_MIN) {
26106 0 : i__1 = *n;
26107 0 : for (i__ = 1; i__ <= i__1; ++i__) {
26108 0 : temp = a[j + 1 + i__ * a_dim1];
26109 0 : a[j + 1 + i__ * a_dim1] = ctemp * temp - stemp *
26110 0 : a[j + i__ * a_dim1];
26111 0 : a[j + i__ * a_dim1] = stemp * temp + ctemp * a[j
26112 0 : + i__ * a_dim1];
26113 : }
26114 : }
26115 : }
26116 : }
26117 0 : } else if (*pivot=='T' || *pivot=='t') {
26118 0 : if (*direct=='F' || *direct=='f') {
26119 : i__1 = *m;
26120 0 : for (j = 2; j <= i__1; ++j) {
26121 0 : ctemp = c__[j - 1];
26122 0 : stemp = s[j - 1];
26123 0 : if (std::abs(ctemp-1.0)>PLUMED_GMX_FLOAT_EPS || std::abs(stemp)>PLUMED_GMX_FLOAT_MIN) {
26124 0 : i__2 = *n;
26125 0 : for (i__ = 1; i__ <= i__2; ++i__) {
26126 0 : temp = a[j + i__ * a_dim1];
26127 0 : a[j + i__ * a_dim1] = ctemp * temp - stemp * a[
26128 0 : i__ * a_dim1 + 1];
26129 0 : a[i__ * a_dim1 + 1] = stemp * temp + ctemp * a[
26130 0 : i__ * a_dim1 + 1];
26131 : }
26132 : }
26133 : }
26134 0 : } else if (*direct=='B' || *direct=='b') {
26135 0 : for (j = *m; j >= 2; --j) {
26136 0 : ctemp = c__[j - 1];
26137 0 : stemp = s[j - 1];
26138 0 : if (std::abs(ctemp-1.0)>PLUMED_GMX_FLOAT_EPS || std::abs(stemp)>PLUMED_GMX_FLOAT_MIN) {
26139 0 : i__1 = *n;
26140 0 : for (i__ = 1; i__ <= i__1; ++i__) {
26141 0 : temp = a[j + i__ * a_dim1];
26142 0 : a[j + i__ * a_dim1] = ctemp * temp - stemp * a[
26143 0 : i__ * a_dim1 + 1];
26144 0 : a[i__ * a_dim1 + 1] = stemp * temp + ctemp * a[
26145 0 : i__ * a_dim1 + 1];
26146 : }
26147 : }
26148 : }
26149 : }
26150 0 : } else if (*pivot=='B' || *pivot=='b') {
26151 0 : if (*direct=='F' || *direct=='f') {
26152 : i__1 = *m - 1;
26153 0 : for (j = 1; j <= i__1; ++j) {
26154 0 : ctemp = c__[j];
26155 0 : stemp = s[j];
26156 0 : if (std::abs(ctemp-1.0)>PLUMED_GMX_FLOAT_EPS || std::abs(stemp)>PLUMED_GMX_FLOAT_MIN) {
26157 0 : i__2 = *n;
26158 0 : for (i__ = 1; i__ <= i__2; ++i__) {
26159 0 : temp = a[j + i__ * a_dim1];
26160 0 : a[j + i__ * a_dim1] = stemp * a[*m + i__ * a_dim1]
26161 0 : + ctemp * temp;
26162 0 : a[*m + i__ * a_dim1] = ctemp * a[*m + i__ *
26163 0 : a_dim1] - stemp * temp;
26164 : }
26165 : }
26166 : }
26167 0 : } else if (*direct=='B' || *direct=='b') {
26168 0 : for (j = *m - 1; j >= 1; --j) {
26169 0 : ctemp = c__[j];
26170 0 : stemp = s[j];
26171 0 : if (std::abs(ctemp-1.0)>PLUMED_GMX_FLOAT_EPS || std::abs(stemp)>PLUMED_GMX_FLOAT_MIN) {
26172 0 : i__1 = *n;
26173 0 : for (i__ = 1; i__ <= i__1; ++i__) {
26174 0 : temp = a[j + i__ * a_dim1];
26175 0 : a[j + i__ * a_dim1] = stemp * a[*m + i__ * a_dim1]
26176 0 : + ctemp * temp;
26177 0 : a[*m + i__ * a_dim1] = ctemp * a[*m + i__ *
26178 0 : a_dim1] - stemp * temp;
26179 : }
26180 : }
26181 : }
26182 : }
26183 : }
26184 0 : } else if (*side=='R' || *side=='r') {
26185 :
26186 0 : if (*pivot=='V' || *pivot=='v') {
26187 0 : if (*direct=='F' || *direct=='f') {
26188 : i__1 = *n - 1;
26189 0 : for (j = 1; j <= i__1; ++j) {
26190 0 : ctemp = c__[j];
26191 0 : stemp = s[j];
26192 0 : if (std::abs(ctemp-1.0)>PLUMED_GMX_FLOAT_EPS || std::abs(stemp)>PLUMED_GMX_FLOAT_MIN) {
26193 0 : i__2 = *m;
26194 0 : for (i__ = 1; i__ <= i__2; ++i__) {
26195 0 : temp = a[i__ + (j + 1) * a_dim1];
26196 0 : a[i__ + (j + 1) * a_dim1] = ctemp * temp - stemp *
26197 0 : a[i__ + j * a_dim1];
26198 0 : a[i__ + j * a_dim1] = stemp * temp + ctemp * a[
26199 0 : i__ + j * a_dim1];
26200 : }
26201 : }
26202 : }
26203 0 : } else if (*direct=='B' || *direct=='b') {
26204 0 : for (j = *n - 1; j >= 1; --j) {
26205 0 : ctemp = c__[j];
26206 0 : stemp = s[j];
26207 0 : if (std::abs(ctemp-1.0)>PLUMED_GMX_FLOAT_EPS || std::abs(stemp)>PLUMED_GMX_FLOAT_MIN) {
26208 0 : i__1 = *m;
26209 0 : for (i__ = 1; i__ <= i__1; ++i__) {
26210 0 : temp = a[i__ + (j + 1) * a_dim1];
26211 0 : a[i__ + (j + 1) * a_dim1] = ctemp * temp - stemp *
26212 0 : a[i__ + j * a_dim1];
26213 0 : a[i__ + j * a_dim1] = stemp * temp + ctemp * a[
26214 0 : i__ + j * a_dim1];
26215 : }
26216 : }
26217 : }
26218 : }
26219 0 : } else if (*pivot=='T' || *pivot=='t') {
26220 0 : if (*direct=='F' || *direct=='f') {
26221 : i__1 = *n;
26222 0 : for (j = 2; j <= i__1; ++j) {
26223 0 : ctemp = c__[j - 1];
26224 0 : stemp = s[j - 1];
26225 0 : if (std::abs(ctemp-1.0)>PLUMED_GMX_FLOAT_EPS || std::abs(stemp)>PLUMED_GMX_FLOAT_MIN) {
26226 0 : i__2 = *m;
26227 0 : for (i__ = 1; i__ <= i__2; ++i__) {
26228 0 : temp = a[i__ + j * a_dim1];
26229 0 : a[i__ + j * a_dim1] = ctemp * temp - stemp * a[
26230 0 : i__ + a_dim1];
26231 0 : a[i__ + a_dim1] = stemp * temp + ctemp * a[i__ +
26232 0 : a_dim1];
26233 : }
26234 : }
26235 : }
26236 0 : } else if (*direct=='B' || *direct=='b') {
26237 0 : for (j = *n; j >= 2; --j) {
26238 0 : ctemp = c__[j - 1];
26239 0 : stemp = s[j - 1];
26240 0 : if (std::abs(ctemp-1.0)>PLUMED_GMX_FLOAT_EPS || std::abs(stemp)>PLUMED_GMX_FLOAT_MIN) {
26241 0 : i__1 = *m;
26242 0 : for (i__ = 1; i__ <= i__1; ++i__) {
26243 0 : temp = a[i__ + j * a_dim1];
26244 0 : a[i__ + j * a_dim1] = ctemp * temp - stemp * a[
26245 0 : i__ + a_dim1];
26246 0 : a[i__ + a_dim1] = stemp * temp + ctemp * a[i__ +
26247 0 : a_dim1];
26248 : }
26249 : }
26250 : }
26251 : }
26252 0 : } else if (*pivot=='B' || *pivot=='b') {
26253 0 : if (*direct=='F' || *direct=='f') {
26254 : i__1 = *n - 1;
26255 0 : for (j = 1; j <= i__1; ++j) {
26256 0 : ctemp = c__[j];
26257 0 : stemp = s[j];
26258 0 : if (std::abs(ctemp-1.0)>PLUMED_GMX_FLOAT_EPS || std::abs(stemp)>PLUMED_GMX_FLOAT_MIN) {
26259 0 : i__2 = *m;
26260 0 : for (i__ = 1; i__ <= i__2; ++i__) {
26261 0 : temp = a[i__ + j * a_dim1];
26262 0 : a[i__ + j * a_dim1] = stemp * a[i__ + *n * a_dim1]
26263 0 : + ctemp * temp;
26264 0 : a[i__ + *n * a_dim1] = ctemp * a[i__ + *n *
26265 0 : a_dim1] - stemp * temp;
26266 : }
26267 : }
26268 : }
26269 0 : } else if (*direct=='B' || *direct=='b') {
26270 0 : for (j = *n - 1; j >= 1; --j) {
26271 0 : ctemp = c__[j];
26272 0 : stemp = s[j];
26273 0 : if (std::abs(ctemp-1.0)>PLUMED_GMX_FLOAT_EPS || std::abs(stemp)>PLUMED_GMX_FLOAT_MIN) {
26274 0 : i__1 = *m;
26275 0 : for (i__ = 1; i__ <= i__1; ++i__) {
26276 0 : temp = a[i__ + j * a_dim1];
26277 0 : a[i__ + j * a_dim1] = stemp * a[i__ + *n * a_dim1]
26278 0 : + ctemp * temp;
26279 0 : a[i__ + *n * a_dim1] = ctemp * a[i__ + *n *
26280 0 : a_dim1] - stemp * temp;
26281 : }
26282 : }
26283 : }
26284 : }
26285 : }
26286 : }
26287 :
26288 : return;
26289 :
26290 : }
26291 :
26292 :
26293 : }
26294 : }
26295 : #include "lapack.h"
26296 :
26297 : #include "blas/blas.h"
26298 : namespace PLMD{
26299 : namespace lapack{
26300 : using namespace blas;
26301 : void
26302 0 : PLUMED_BLAS_F77_FUNC(slasrt,SLASRT)(const char *id,
26303 : int *n,
26304 : float *d__,
26305 : int *info)
26306 : {
26307 : int i__1, i__2;
26308 :
26309 : int i__, j;
26310 : float d1, d2, d3;
26311 : int dir;
26312 : float tmp;
26313 : int endd;
26314 : int stack[64];
26315 : float dmnmx;
26316 : int start;
26317 : int stkpnt;
26318 :
26319 0 : --d__;
26320 :
26321 0 : *info = 0;
26322 : dir = -1;
26323 0 : if (*id=='D' || *id=='d')
26324 : dir = 0;
26325 0 : else if (*id=='I' || *id=='i')
26326 : dir = 1;
26327 :
26328 : if (dir == -1) {
26329 0 : *info = -1;
26330 0 : } else if (*n < 0) {
26331 0 : *info = -2;
26332 : }
26333 0 : if (*info != 0) {
26334 : return;
26335 : }
26336 0 : if (*n <= 1) {
26337 : return;
26338 : }
26339 :
26340 : stkpnt = 1;
26341 0 : stack[0] = 1;
26342 0 : stack[1] = *n;
26343 0 : L10:
26344 0 : start = stack[(stkpnt << 1) - 2];
26345 0 : endd = stack[(stkpnt << 1) - 1];
26346 0 : --stkpnt;
26347 0 : if (endd - start <= 20 && endd - start > 0) {
26348 :
26349 :
26350 0 : if (dir == 0) {
26351 :
26352 : i__1 = endd;
26353 0 : for (i__ = start + 1; i__ <= i__1; ++i__) {
26354 : i__2 = start + 1;
26355 0 : for (j = i__; j >= i__2; --j) {
26356 0 : if (d__[j] > d__[j - 1]) {
26357 : dmnmx = d__[j];
26358 0 : d__[j] = d__[j - 1];
26359 0 : d__[j - 1] = dmnmx;
26360 : } else {
26361 0 : goto L30;
26362 : }
26363 : }
26364 0 : L30:
26365 : ;
26366 : }
26367 :
26368 : } else {
26369 :
26370 : i__1 = endd;
26371 0 : for (i__ = start + 1; i__ <= i__1; ++i__) {
26372 : i__2 = start + 1;
26373 0 : for (j = i__; j >= i__2; --j) {
26374 0 : if (d__[j] < d__[j - 1]) {
26375 : dmnmx = d__[j];
26376 0 : d__[j] = d__[j - 1];
26377 0 : d__[j - 1] = dmnmx;
26378 : } else {
26379 0 : goto L50;
26380 : }
26381 : }
26382 0 : L50:
26383 : ;
26384 : }
26385 :
26386 : }
26387 :
26388 0 : } else if (endd - start > 20) {
26389 :
26390 0 : d1 = d__[start];
26391 0 : d2 = d__[endd];
26392 0 : i__ = (start + endd) / 2;
26393 0 : d3 = d__[i__];
26394 0 : if (d1 < d2) {
26395 0 : if (d3 < d1) {
26396 : dmnmx = d1;
26397 0 : } else if (d3 < d2) {
26398 : dmnmx = d3;
26399 : } else {
26400 : dmnmx = d2;
26401 : }
26402 : } else {
26403 0 : if (d3 < d2) {
26404 : dmnmx = d2;
26405 0 : } else if (d3 < d1) {
26406 : dmnmx = d3;
26407 : } else {
26408 : dmnmx = d1;
26409 : }
26410 : }
26411 :
26412 0 : if (dir == 0) {
26413 :
26414 0 : i__ = start - 1;
26415 0 : j = endd + 1;
26416 0 : L60:
26417 0 : L70:
26418 0 : --j;
26419 0 : if (d__[j] < dmnmx) {
26420 0 : goto L70;
26421 : }
26422 0 : L80:
26423 0 : ++i__;
26424 0 : if (d__[i__] > dmnmx) {
26425 0 : goto L80;
26426 : }
26427 0 : if (i__ < j) {
26428 : tmp = d__[i__];
26429 0 : d__[i__] = d__[j];
26430 0 : d__[j] = tmp;
26431 0 : goto L60;
26432 : }
26433 0 : if (j - start > endd - j - 1) {
26434 : ++stkpnt;
26435 : stack[(stkpnt << 1) - 2] = start;
26436 0 : stack[(stkpnt << 1) - 1] = j;
26437 0 : ++stkpnt;
26438 0 : stack[(stkpnt << 1) - 2] = j + 1;
26439 0 : stack[(stkpnt << 1) - 1] = endd;
26440 : } else {
26441 : ++stkpnt;
26442 0 : stack[(stkpnt << 1) - 2] = j + 1;
26443 0 : stack[(stkpnt << 1) - 1] = endd;
26444 0 : ++stkpnt;
26445 0 : stack[(stkpnt << 1) - 2] = start;
26446 0 : stack[(stkpnt << 1) - 1] = j;
26447 : }
26448 : } else {
26449 :
26450 0 : i__ = start - 1;
26451 0 : j = endd + 1;
26452 0 : L90:
26453 0 : L100:
26454 0 : --j;
26455 0 : if (d__[j] > dmnmx) {
26456 0 : goto L100;
26457 : }
26458 0 : L110:
26459 0 : ++i__;
26460 0 : if (d__[i__] < dmnmx) {
26461 0 : goto L110;
26462 : }
26463 0 : if (i__ < j) {
26464 : tmp = d__[i__];
26465 0 : d__[i__] = d__[j];
26466 0 : d__[j] = tmp;
26467 0 : goto L90;
26468 : }
26469 0 : if (j - start > endd - j - 1) {
26470 : ++stkpnt;
26471 : stack[(stkpnt << 1) - 2] = start;
26472 0 : stack[(stkpnt << 1) - 1] = j;
26473 0 : ++stkpnt;
26474 0 : stack[(stkpnt << 1) - 2] = j + 1;
26475 0 : stack[(stkpnt << 1) - 1] = endd;
26476 : } else {
26477 : ++stkpnt;
26478 0 : stack[(stkpnt << 1) - 2] = j + 1;
26479 0 : stack[(stkpnt << 1) - 1] = endd;
26480 0 : ++stkpnt;
26481 0 : stack[(stkpnt << 1) - 2] = start;
26482 0 : stack[(stkpnt << 1) - 1] = j;
26483 : }
26484 : }
26485 : }
26486 0 : if (stkpnt > 0) {
26487 0 : goto L10;
26488 : }
26489 : return;
26490 :
26491 : }
26492 : }
26493 : }
26494 : #include "lapack.h"
26495 : #include "blas/blas.h"
26496 : namespace PLMD{
26497 : namespace lapack{
26498 : using namespace blas;
26499 :
26500 0 : void PLUMED_BLAS_F77_FUNC(slasrt2,SLASRT2)(const char *id,
26501 : int *n,
26502 : float *d__,
26503 : int * key,
26504 : int *info)
26505 : {
26506 : int i__1, i__2;
26507 :
26508 : int i__, j;
26509 : float d1, d2, d3;
26510 : int dir;
26511 : float tmp;
26512 : int endd;
26513 : int stack[64];
26514 : float dmnmx;
26515 : int start;
26516 : int tmpkey, stkpnt;
26517 :
26518 0 : --key;
26519 0 : --d__;
26520 :
26521 0 : *info = 0;
26522 : dir = -1;
26523 0 : if (*id=='D' || *id=='d')
26524 : dir = 0;
26525 0 : else if (*id=='I' || *id=='i')
26526 : dir = 1;
26527 :
26528 : if (dir == -1) {
26529 0 : *info = -1;
26530 0 : } else if (*n < 0) {
26531 0 : *info = -2;
26532 : }
26533 0 : if (*info != 0) {
26534 : return;
26535 : }
26536 :
26537 0 : if (*n <= 1) {
26538 : return;
26539 : }
26540 :
26541 : stkpnt = 1;
26542 0 : stack[0] = 1;
26543 0 : stack[1] = *n;
26544 0 : L10:
26545 0 : start = stack[(stkpnt << 1) - 2];
26546 0 : endd = stack[(stkpnt << 1) - 1];
26547 0 : --stkpnt;
26548 0 : if (endd - start > 0) {
26549 :
26550 0 : if (dir == 0) {
26551 :
26552 : i__1 = endd;
26553 0 : for (i__ = start + 1; i__ <= i__1; ++i__) {
26554 : i__2 = start + 1;
26555 0 : for (j = i__; j >= i__2; --j) {
26556 0 : if (d__[j] > d__[j - 1]) {
26557 : dmnmx = d__[j];
26558 0 : d__[j] = d__[j - 1];
26559 0 : d__[j - 1] = dmnmx;
26560 0 : tmpkey = key[j];
26561 0 : key[j] = key[j - 1];
26562 0 : key[j - 1] = tmpkey;
26563 : } else {
26564 : break;
26565 : }
26566 : }
26567 : }
26568 :
26569 : } else {
26570 :
26571 : i__1 = endd;
26572 0 : for (i__ = start + 1; i__ <= i__1; ++i__) {
26573 : i__2 = start + 1;
26574 0 : for (j = i__; j >= i__2; --j) {
26575 0 : if (d__[j] < d__[j - 1]) {
26576 : dmnmx = d__[j];
26577 0 : d__[j] = d__[j - 1];
26578 0 : d__[j - 1] = dmnmx;
26579 0 : tmpkey = key[j];
26580 0 : key[j] = key[j - 1];
26581 0 : key[j - 1] = tmpkey;
26582 : } else {
26583 : break;
26584 : }
26585 : }
26586 : }
26587 :
26588 : }
26589 :
26590 0 : } else if (endd - start > 20) {
26591 :
26592 0 : d1 = d__[start];
26593 0 : d2 = d__[endd];
26594 0 : i__ = (start + endd) / 2;
26595 0 : d3 = d__[i__];
26596 0 : if (d1 < d2) {
26597 0 : if (d3 < d1) {
26598 : dmnmx = d1;
26599 0 : } else if (d3 < d2) {
26600 : dmnmx = d3;
26601 : } else {
26602 : dmnmx = d2;
26603 : }
26604 : } else {
26605 0 : if (d3 < d2) {
26606 : dmnmx = d2;
26607 0 : } else if (d3 < d1) {
26608 : dmnmx = d3;
26609 : } else {
26610 : dmnmx = d1;
26611 : }
26612 : }
26613 :
26614 0 : if (dir == 0) {
26615 :
26616 0 : i__ = start - 1;
26617 0 : j = endd + 1;
26618 0 : L60:
26619 0 : L70:
26620 0 : --j;
26621 0 : if (d__[j] < dmnmx) {
26622 0 : goto L70;
26623 : }
26624 0 : L80:
26625 0 : ++i__;
26626 0 : if (d__[i__] > dmnmx) {
26627 0 : goto L80;
26628 : }
26629 0 : if (i__ < j) {
26630 : tmp = d__[i__];
26631 0 : d__[i__] = d__[j];
26632 0 : d__[j] = tmp;
26633 0 : tmpkey = key[j];
26634 0 : key[j] = key[i__];
26635 0 : key[i__] = tmpkey;
26636 0 : goto L60;
26637 : }
26638 0 : if (j - start > endd - j - 1) {
26639 : ++stkpnt;
26640 : stack[(stkpnt << 1) - 2] = start;
26641 0 : stack[(stkpnt << 1) - 1] = j;
26642 0 : ++stkpnt;
26643 0 : stack[(stkpnt << 1) - 2] = j + 1;
26644 0 : stack[(stkpnt << 1) - 1] = endd;
26645 : } else {
26646 : ++stkpnt;
26647 0 : stack[(stkpnt << 1) - 2] = j + 1;
26648 0 : stack[(stkpnt << 1) - 1] = endd;
26649 0 : ++stkpnt;
26650 0 : stack[(stkpnt << 1) - 2] = start;
26651 0 : stack[(stkpnt << 1) - 1] = j;
26652 : }
26653 : } else {
26654 :
26655 0 : i__ = start - 1;
26656 0 : j = endd + 1;
26657 0 : L90:
26658 0 : L100:
26659 0 : --j;
26660 0 : if (d__[j] > dmnmx) {
26661 0 : goto L100;
26662 : }
26663 0 : L110:
26664 0 : ++i__;
26665 0 : if (d__[i__] < dmnmx) {
26666 0 : goto L110;
26667 : }
26668 0 : if (i__ < j) {
26669 : tmp = d__[i__];
26670 0 : d__[i__] = d__[j];
26671 0 : d__[j] = tmp;
26672 0 : tmpkey = key[j];
26673 0 : key[j] = key[i__];
26674 0 : key[i__] = tmpkey;
26675 0 : goto L90;
26676 : }
26677 0 : if (j - start > endd - j - 1) {
26678 : ++stkpnt;
26679 : stack[(stkpnt << 1) - 2] = start;
26680 0 : stack[(stkpnt << 1) - 1] = j;
26681 0 : ++stkpnt;
26682 0 : stack[(stkpnt << 1) - 2] = j + 1;
26683 0 : stack[(stkpnt << 1) - 1] = endd;
26684 : } else {
26685 : ++stkpnt;
26686 0 : stack[(stkpnt << 1) - 2] = j + 1;
26687 0 : stack[(stkpnt << 1) - 1] = endd;
26688 0 : ++stkpnt;
26689 0 : stack[(stkpnt << 1) - 2] = start;
26690 0 : stack[(stkpnt << 1) - 1] = j;
26691 : }
26692 : }
26693 : }
26694 0 : if (stkpnt > 0) {
26695 0 : goto L10;
26696 : }
26697 :
26698 : return;
26699 : }
26700 : }
26701 : }
26702 : #include <cmath>
26703 : #include "real.h"
26704 : #include "lapack.h"
26705 :
26706 : #include "blas/blas.h"
26707 : namespace PLMD{
26708 : namespace lapack{
26709 : using namespace blas;
26710 : void
26711 0 : PLUMED_BLAS_F77_FUNC(slassq,SLASSQ)(int *n,
26712 : float *x,
26713 : int *incx,
26714 : float *scale,
26715 : float *sumsq)
26716 : {
26717 : int ix;
26718 : float absxi,t;
26719 :
26720 0 : if(*n>0) {
26721 0 : for(ix=0;ix<=(*n-1)*(*incx);ix+=*incx) {
26722 0 : if(std::abs(x[ix])>PLUMED_GMX_FLOAT_MIN) {
26723 : absxi = std::abs(x[ix]);
26724 0 : if(*scale<absxi) {
26725 0 : t = *scale/absxi;
26726 0 : t = t*t;
26727 0 : *sumsq = 1.0 + (*sumsq)*t;
26728 0 : *scale = absxi;
26729 : } else {
26730 0 : t = absxi/(*scale);
26731 0 : *sumsq += t*t;
26732 : }
26733 : }
26734 : }
26735 : }
26736 0 : return;
26737 : }
26738 : }
26739 : }
26740 : #include <cmath>
26741 : #include "lapack.h"
26742 : #include "lapack_limits.h"
26743 :
26744 : #include "real.h"
26745 :
26746 : #include "blas/blas.h"
26747 : namespace PLMD{
26748 : namespace lapack{
26749 : using namespace blas;
26750 : void
26751 0 : PLUMED_BLAS_F77_FUNC(slasv2,SLASV2)(float *f,
26752 : float *g,
26753 : float *h__,
26754 : float *ssmin,
26755 : float *ssmax,
26756 : float *snr,
26757 : float *csr,
26758 : float *snl,
26759 : float *csl)
26760 : {
26761 : float d__1;
26762 :
26763 : float a, d__, l, m, r__, s, t, fa, ga, ha, ft, gt, ht, mm, tt,
26764 : clt, crt, slt, srt;
26765 : int pmax;
26766 : float temp;
26767 : int swap;
26768 : float tsign=1.0;
26769 : int gasmal;
26770 :
26771 0 : ft = *f;
26772 : fa = std::abs(ft);
26773 0 : ht = *h__;
26774 : ha = std::abs(*h__);
26775 :
26776 : pmax = 1;
26777 : swap = ha > fa;
26778 0 : if (swap) {
26779 : pmax = 3;
26780 : temp = ft;
26781 : ft = ht;
26782 : ht = temp;
26783 : temp = fa;
26784 : fa = ha;
26785 : ha = temp;
26786 :
26787 : }
26788 0 : gt = *g;
26789 : ga = std::abs(gt);
26790 0 : if (std::abs(ga)<PLUMED_GMX_FLOAT_MIN) {
26791 :
26792 0 : *ssmin = ha;
26793 0 : *ssmax = fa;
26794 : clt = 1.;
26795 : crt = 1.;
26796 : slt = 0.;
26797 : srt = 0.;
26798 : } else {
26799 : gasmal = 1;
26800 0 : if (ga > fa) {
26801 : pmax = 2;
26802 0 : if (fa / ga < PLUMED_GMX_FLOAT_EPS) {
26803 :
26804 : gasmal = 0;
26805 0 : *ssmax = ga;
26806 0 : if (ha > 1.) {
26807 0 : *ssmin = fa / (ga / ha);
26808 : } else {
26809 0 : *ssmin = fa / ga * ha;
26810 : }
26811 : clt = 1.;
26812 0 : slt = ht / gt;
26813 : srt = 1.;
26814 0 : crt = ft / gt;
26815 : }
26816 : }
26817 0 : if (gasmal) {
26818 :
26819 0 : d__ = fa - ha;
26820 0 : if ( std::abs( fa - d__ )<PLUMED_GMX_FLOAT_EPS*std::abs( fa + d__ )) {
26821 : l = 1.;
26822 : } else {
26823 0 : l = d__ / fa;
26824 : }
26825 :
26826 0 : m = gt / ft;
26827 0 : t = 2. - l;
26828 :
26829 0 : mm = m * m;
26830 0 : tt = t * t;
26831 0 : s = std::sqrt(tt + mm);
26832 :
26833 0 : if ( std::abs(l)<PLUMED_GMX_FLOAT_MIN) {
26834 : r__ = std::abs(m);
26835 : } else {
26836 0 : r__ = std::sqrt(l * l + mm);
26837 : }
26838 0 : a = (s + r__) * .5;
26839 :
26840 0 : *ssmin = ha / a;
26841 0 : *ssmax = fa * a;
26842 0 : if ( std::abs(mm)<PLUMED_GMX_FLOAT_MIN) {
26843 :
26844 0 : if (std::abs(l)<PLUMED_GMX_FLOAT_MIN) {
26845 0 : t = ( (ft>0) ? 2.0 : -2.0) * ( (gt>0) ? 1.0 : -1.0);
26846 : } else {
26847 0 : t = gt / ( (ft>0) ? d__ : -d__) + m / t;
26848 : }
26849 : } else {
26850 0 : t = (m / (s + t) + m / (r__ + l)) * (a + 1.);
26851 : }
26852 0 : l = std::sqrt(t * t + 4.);
26853 0 : crt = 2. / l;
26854 0 : srt = t / l;
26855 0 : clt = (crt + srt * m) / a;
26856 0 : slt = ht / ft * srt / a;
26857 : }
26858 : }
26859 0 : if (swap) {
26860 0 : *csl = srt;
26861 0 : *snl = crt;
26862 0 : *csr = slt;
26863 0 : *snr = clt;
26864 : } else {
26865 0 : *csl = clt;
26866 0 : *snl = slt;
26867 0 : *csr = crt;
26868 0 : *snr = srt;
26869 : }
26870 :
26871 0 : if (pmax == 1) {
26872 0 : tsign = ( (*csr>0) ? 1.0 : -1.0) * ( (*csl>0) ? 1.0 : -1.0) * ( (*f>0) ? 1.0 : -1.0);
26873 : }
26874 0 : if (pmax == 2) {
26875 0 : tsign = ( (*snr>0) ? 1.0 : -1.0) * ( (*csl>0) ? 1.0 : -1.0) * ( (*g>0) ? 1.0 : -1.0);
26876 : }
26877 0 : if (pmax == 3) {
26878 0 : tsign = ( (*snr>0) ? 1.0 : -1.0) * ( (*snl>0) ? 1.0 : -1.0) * ( (*h__>0) ? 1.0 : -1.0);
26879 : }
26880 0 : if(tsign<0)
26881 0 : *ssmax *= -1.0;
26882 0 : d__1 = tsign * ( (*f>0) ? 1.0 : -1.0) * ( (*h__>0) ? 1.0 : -1.0);
26883 0 : if(d__1<0)
26884 0 : *ssmin *= -1.0;
26885 0 : return;
26886 :
26887 : }
26888 : }
26889 : }
26890 : #include "lapack.h"
26891 :
26892 : /* LAPACK */
26893 : #include "blas/blas.h"
26894 : namespace PLMD{
26895 : namespace lapack{
26896 : using namespace blas;
26897 : void
26898 0 : PLUMED_BLAS_F77_FUNC(slaswp,SLASWP)(int *n,
26899 : float *a,
26900 : int *lda,
26901 : int *k1,
26902 : int *k2,
26903 : int *ipiv,
26904 : int *incx)
26905 : {
26906 : int ix0,i1,i2,inc,n32;
26907 : int ix,i,j,ip,k;
26908 : float temp;
26909 :
26910 0 : if(*incx>0) {
26911 0 : ix0 = *k1 - 1;
26912 : i1 = *k1 - 1;
26913 0 : i2 = *k2;
26914 : inc = 1;
26915 0 : } else if(*incx<0) {
26916 0 : ix0 = *incx * (1- *k2);
26917 0 : i1 = *k2 - 1;
26918 0 : i2 = *k1;
26919 : inc = -1;
26920 : } else
26921 : return;
26922 :
26923 0 : n32 = *n / 32;
26924 :
26925 0 : n32 *= 32;
26926 :
26927 :
26928 0 : if(n32!=0) {
26929 0 : for(j=0;j<n32;j+=32) {
26930 : ix = ix0;
26931 0 : for(i=i1;i<i2;i+=inc,ix+=*incx) {
26932 0 : ip = ipiv[ix] - 1;
26933 0 : if(ip != i) {
26934 0 : for(k=j;k<j+32;k++) {
26935 0 : temp = a[(k)*(*lda)+i];
26936 0 : a[(k)*(*lda)+i] = a[(k)*(*lda)+ip];
26937 0 : a[(k)*(*lda)+ip] = temp;
26938 : }
26939 : }
26940 : }
26941 : }
26942 : }
26943 0 : if(n32!=*n) {
26944 : ix = ix0;
26945 0 : for(i=i1;i<i2;i+=inc,ix+=*incx) {
26946 0 : ip = ipiv[ix] - 1;
26947 0 : if(ip != i) {
26948 0 : for(k=n32;k<*n;k++) {
26949 0 : temp = a[(k)*(*lda)+i];
26950 0 : a[(k)*(*lda)+i] = a[(k)*(*lda)+ip];
26951 0 : a[(k)*(*lda)+ip] = temp;
26952 : }
26953 : }
26954 : }
26955 : }
26956 : return;
26957 : }
26958 : }
26959 : }
26960 : #include <cctype>
26961 : #include "blas/blas.h"
26962 : #include "lapack.h"
26963 : #include "lapack_limits.h"
26964 :
26965 :
26966 : #include "blas/blas.h"
26967 : namespace PLMD{
26968 : namespace lapack{
26969 : using namespace blas;
26970 : void
26971 0 : PLUMED_BLAS_F77_FUNC(slatrd,SLATRD)(const char * uplo,
26972 : int * n,
26973 : int * nb,
26974 : float * a,
26975 : int * lda,
26976 : float * e,
26977 : float * tau,
26978 : float * w,
26979 : int * ldw)
26980 : {
26981 : int i,iw;
26982 : int ti1,ti2,ti3;
26983 : float one,zero,minusone,alpha;
26984 0 : const char ch=std::toupper(*uplo);
26985 :
26986 0 : one=1.0;
26987 0 : minusone=-1.0;
26988 0 : zero=0.0;
26989 :
26990 0 : if(*n<=0)
26991 : return;
26992 :
26993 0 : if(ch=='U') {
26994 0 : for(i=*n;i>=(*n-*nb+1);i--) {
26995 0 : iw = i -*n + *nb;
26996 :
26997 0 : if(i<*n) {
26998 0 : ti1 = *n-i;
26999 0 : ti2 = 1;
27000 : /* BLAS */
27001 0 : PLUMED_BLAS_F77_FUNC(sgemv,SGEMV)("N",&i,&ti1,&minusone, &(a[ i*(*lda) + 0]),lda,&(w[iw*(*ldw)+(i-1)]),
27002 0 : ldw,&one, &(a[ (i-1)*(*lda) + 0]), &ti2);
27003 : /* BLAS */
27004 0 : PLUMED_BLAS_F77_FUNC(sgemv,SGEMV)("N",&i,&ti1,&minusone, &(w[ iw*(*ldw) + 0]),ldw,&(a[i*(*lda)+(i-1)]),
27005 0 : lda,&one, &(a[ (i-1)*(*lda) + 0]), &ti2);
27006 : }
27007 :
27008 0 : if(i>1) {
27009 : /* Generate elementary reflector H(i) to annihilate
27010 : * A(1:i-2,i)
27011 : */
27012 0 : ti1 = i-1;
27013 0 : ti2 = 1;
27014 :
27015 : /* LAPACK */
27016 0 : PLUMED_BLAS_F77_FUNC(slarfg,SLARFG)(&ti1,&(a[(i-1)*(*lda)+(i-2)]),&(a[(i-1)*(*lda)+0]),&ti2,&(tau[i-2]));
27017 :
27018 0 : e[i-2] = a[(i-1)*(*lda)+(i-2)];
27019 0 : a[(i-1)*(*lda)+(i-2)] = 1.0;
27020 :
27021 : /* Compute W(1:i-1,i) */
27022 0 : ti1 = i-1;
27023 0 : ti2 = 1;
27024 :
27025 : /* BLAS */
27026 0 : PLUMED_BLAS_F77_FUNC(ssymv,SSYMV)("U",&ti1,&one,a,lda,&(a[(i-1)*(*lda)+0]),&ti2,&zero,
27027 0 : &(w[(iw-1)*(*ldw)+0]),&ti2);
27028 0 : if(i<*n) {
27029 0 : ti1 = i-1;
27030 0 : ti2 = *n-i;
27031 0 : ti3 = 1;
27032 : /* BLAS */
27033 0 : PLUMED_BLAS_F77_FUNC(sgemv,SGEMV)("T",&ti1,&ti2,&one,&(w[iw*(*ldw)+0]),ldw,&(a[(i-1)*(*lda)+0]),&ti3,
27034 0 : &zero,&(w[(iw-1)*(*ldw)+i]),&ti3);
27035 :
27036 : /* BLAS */
27037 0 : PLUMED_BLAS_F77_FUNC(sgemv,SGEMV)("N",&ti1,&ti2,&minusone,&(a[i*(*lda)+0]),lda,&(w[(iw-1)*(*ldw)+i]),&ti3,
27038 0 : &one,&(w[(iw-1)*(*ldw)+0]),&ti3);
27039 :
27040 : /* BLAS */
27041 0 : PLUMED_BLAS_F77_FUNC(sgemv,SGEMV)("T",&ti1,&ti2,&one,&(a[i*(*lda)+0]),lda,&(a[(i-1)*(*lda)+0]),&ti3,
27042 0 : &zero,&(w[(iw-1)*(*ldw)+i]),&ti3);
27043 :
27044 : /* BLAS */
27045 0 : PLUMED_BLAS_F77_FUNC(sgemv,SGEMV)("N",&ti1,&ti2,&minusone,&(w[iw*(*ldw)+0]),ldw,&(w[(iw-1)*(*ldw)+i]),&ti3,
27046 0 : &one,&(w[(iw-1)*(*ldw)+0]),&ti3);
27047 : }
27048 :
27049 0 : ti1 = i-1;
27050 0 : ti2 = 1;
27051 : /* BLAS */
27052 0 : PLUMED_BLAS_F77_FUNC(sscal,SSCAL)(&ti1,&(tau[i-2]),&(w[(iw-1)*(*ldw)+0]),&ti2);
27053 :
27054 0 : alpha = -0.5*tau[i-2]*PLUMED_BLAS_F77_FUNC(sdot,SDOT)(&ti1,&(w[(iw-1)*(*ldw)+0]),&ti2,
27055 0 : &(a[(i-1)*(*lda)+0]),&ti2);
27056 :
27057 : /* BLAS */
27058 0 : PLUMED_BLAS_F77_FUNC(saxpy,SAXPY)(&ti1,&alpha,&(a[(i-1)*(*lda)+0]),&ti2,&(w[(iw-1)*(*ldw)+0]),&ti2);
27059 :
27060 : }
27061 : }
27062 : } else {
27063 : /* lower */
27064 0 : for(i=1;i<=*nb;i++) {
27065 :
27066 0 : ti1 = *n-i+1;
27067 0 : ti2 = i-1;
27068 0 : ti3 = 1;
27069 : /* BLAS */
27070 0 : PLUMED_BLAS_F77_FUNC(sgemv,SGEMV)("N",&ti1,&ti2,&minusone, &(a[ i-1 ]),lda,&(w[ i-1 ]),
27071 0 : ldw,&one, &(a[ (i-1)*(*lda) + (i-1)]), &ti3);
27072 : /* BLAS */
27073 0 : PLUMED_BLAS_F77_FUNC(sgemv,SGEMV)("N",&ti1,&ti2,&minusone, &(w[ i-1 ]),ldw,&(a[ i-1 ]),
27074 0 : lda,&one, &(a[ (i-1)*(*lda) + (i-1)]), &ti3);
27075 :
27076 0 : if(i<*n) {
27077 0 : ti1 = *n - i;
27078 0 : ti2 = (*n < i+2 ) ? *n : (i+2);
27079 0 : ti3 = 1;
27080 : /* LAPACK */
27081 0 : PLUMED_BLAS_F77_FUNC(slarfg,SLARFG)(&ti1,&(a[(i-1)*(*lda)+(i)]),&(a[(i-1)*(*lda)+(ti2-1)]),&ti3,&(tau[i-1]));
27082 0 : e[i-1] = a[(i-1)*(*lda)+(i)];
27083 0 : a[(i-1)*(*lda)+(i)] = 1.0;
27084 :
27085 0 : ti1 = *n - i;
27086 0 : ti2 = 1;
27087 0 : PLUMED_BLAS_F77_FUNC(ssymv,SSYMV)("L",&ti1,&one,&(a[i*(*lda)+i]),lda,&(a[(i-1)*(*lda)+i]),&ti2,
27088 0 : &zero,&(w[(i-1)*(*ldw)+i]),&ti2);
27089 0 : ti1 = *n - i;
27090 0 : ti2 = i-1;
27091 0 : ti3 = 1;
27092 : /* BLAS */
27093 0 : PLUMED_BLAS_F77_FUNC(sgemv,SGEMV)("T",&ti1,&ti2,&one,&(w[ i ]),ldw,&(a[(i-1)*(*lda)+i]),&ti3,
27094 0 : &zero,&(w[(i-1)*(*ldw)+0]),&ti3);
27095 :
27096 : /* BLAS */
27097 0 : PLUMED_BLAS_F77_FUNC(sgemv,SGEMV)("N",&ti1,&ti2,&minusone,&(a[ i ]),lda,&(w[(i-1)*(*ldw)+0]),&ti3,
27098 0 : &one,&(w[(i-1)*(*ldw)+i]),&ti3);
27099 :
27100 : /* BLAS */
27101 0 : PLUMED_BLAS_F77_FUNC(sgemv,SGEMV)("T",&ti1,&ti2,&one,&(a[ i ]),lda,&(a[(i-1)*(*lda)+i]),&ti3,
27102 0 : &zero,&(w[(i-1)*(*ldw)+0]),&ti3);
27103 :
27104 : /* BLAS */
27105 0 : PLUMED_BLAS_F77_FUNC(sgemv,SGEMV)("N",&ti1,&ti2,&minusone,&(w[ i ]),ldw,&(w[(i-1)*(*ldw)+0]),&ti3,
27106 0 : &one,&(w[(i-1)*(*ldw)+i]),&ti3);
27107 :
27108 0 : PLUMED_BLAS_F77_FUNC(sscal,SSCAL)(&ti1,&(tau[i-1]),&(w[(i-1)*(*ldw)+i]),&ti3);
27109 0 : alpha = -0.5*tau[i-1]*PLUMED_BLAS_F77_FUNC(sdot,SDOT)(&ti1,&(w[(i-1)*(*ldw)+i]),&ti3,
27110 0 : &(a[(i-1)*(*lda)+i]),&ti3);
27111 :
27112 0 : PLUMED_BLAS_F77_FUNC(saxpy,SAXPY)(&ti1,&alpha,&(a[(i-1)*(*lda)+i]),&ti3,&(w[(i-1)*(*ldw)+i]),&ti3);
27113 : }
27114 : }
27115 : }
27116 : return;
27117 : }
27118 :
27119 :
27120 :
27121 :
27122 : }
27123 : }
27124 : #include <cmath>
27125 :
27126 : #include "blas/blas.h"
27127 : #include "lapack.h"
27128 :
27129 : #include "blas/blas.h"
27130 : namespace PLMD{
27131 : namespace lapack{
27132 : using namespace blas;
27133 : void
27134 0 : PLUMED_BLAS_F77_FUNC(sorg2r,SORG2R)(int *m,
27135 : int *n,
27136 : int *k,
27137 : float *a,
27138 : int *lda,
27139 : float *tau,
27140 : float *work,
27141 : int *info)
27142 : {
27143 : int a_dim1, a_offset, i__1, i__2;
27144 : float r__1;
27145 0 : int c__1 = 1;
27146 :
27147 : int i__, j, l;
27148 :
27149 0 : a_dim1 = *lda;
27150 0 : a_offset = 1 + a_dim1;
27151 0 : a -= a_offset;
27152 0 : --tau;
27153 : --work;
27154 :
27155 0 : *info = 0;
27156 :
27157 0 : if (*n <= 0) {
27158 : return;
27159 : }
27160 :
27161 0 : i__1 = *n;
27162 0 : for (j = *k + 1; j <= i__1; ++j) {
27163 0 : i__2 = *m;
27164 0 : for (l = 1; l <= i__2; ++l) {
27165 0 : a[l + j * a_dim1] = 0.0;
27166 : }
27167 0 : a[j + j * a_dim1] = 1.0;
27168 : }
27169 0 : for (i__ = *k; i__ >= 1; --i__) {
27170 0 : if (i__ < *n) {
27171 0 : a[i__ + i__ * a_dim1] = 1.0;
27172 0 : i__1 = *m - i__ + 1;
27173 0 : i__2 = *n - i__;
27174 0 : PLUMED_BLAS_F77_FUNC(slarf,SLARF)("L", &i__1, &i__2, &a[i__ + i__ * a_dim1], &c__1,
27175 0 : &tau[i__], &a[i__ + (i__ + 1) * a_dim1], lda, &work[1]);
27176 : }
27177 0 : if (i__ < *m) {
27178 0 : i__1 = *m - i__;
27179 0 : r__1 = -tau[i__];
27180 0 : PLUMED_BLAS_F77_FUNC(sscal,SSCAL)(&i__1, &r__1, &a[i__ + 1 + i__ * a_dim1], &c__1);
27181 : }
27182 0 : a[i__ + i__ * a_dim1] = 1.0 - tau[i__];
27183 0 : i__1 = i__ - 1;
27184 0 : for (l = 1; l <= i__1; ++l) {
27185 0 : a[l + i__ * a_dim1] = 0.0;
27186 : }
27187 : }
27188 : return;
27189 :
27190 : }
27191 :
27192 :
27193 : }
27194 : }
27195 : #include "lapack.h"
27196 : #include "lapack_limits.h"
27197 :
27198 : #include "blas/blas.h"
27199 : namespace PLMD{
27200 : namespace lapack{
27201 : using namespace blas;
27202 : void
27203 0 : PLUMED_BLAS_F77_FUNC(sorgbr,SORGBR)(const char *vect,
27204 : int *m,
27205 : int *n,
27206 : int *k,
27207 : float *a,
27208 : int *lda,
27209 : float *tau,
27210 : float *work,
27211 : int *lwork,
27212 : int *info)
27213 : {
27214 : int wantq,iinfo,j,i,i1,wrksz;
27215 0 : int mn = (*m < *n) ? *m : *n;
27216 :
27217 0 : wantq = (*vect=='Q' || *vect=='q');
27218 :
27219 0 : *info = 0;
27220 0 : wrksz = mn*DORGBR_BLOCKSIZE;
27221 0 : if(*lwork==-1) {
27222 0 : work[0] = wrksz;
27223 0 : return;
27224 : }
27225 :
27226 0 : if(*m==0 || *n==0)
27227 : return;
27228 :
27229 0 : if(wantq) {
27230 0 : if(*m>=*k)
27231 0 : PLUMED_BLAS_F77_FUNC(sorgqr,SORGQR)(m,n,k,a,lda,tau,work,lwork,&iinfo);
27232 : else {
27233 0 : for(j=*m;j>=2;j--) {
27234 0 : a[(j-1)*(*lda)+0] = 0.0;
27235 0 : for(i=j+1;i<=*m;i++)
27236 0 : a[(j-1)*(*lda)+(i-1)] = a[(j-2)*(*lda)+(i-1)];
27237 : }
27238 0 : a[0] = 1.0;
27239 0 : for(i=2;i<=*m;i++)
27240 0 : a[i-1] = 0.0;
27241 0 : if(*m>1) {
27242 0 : i1 = *m-1;
27243 0 : PLUMED_BLAS_F77_FUNC(sorgqr,SORGQR)(&i1,&i1,&i1,&(a[*lda+1]),lda,tau,work,lwork,&iinfo);
27244 : }
27245 : }
27246 : } else {
27247 0 : if(*k<*n)
27248 0 : PLUMED_BLAS_F77_FUNC(sorglq,SORGLQ)(m,n,k,a,lda,tau,work,lwork,&iinfo);
27249 : else {
27250 0 : a[0] = 1.0;
27251 0 : for(i=2;i<=*m;i++)
27252 0 : a[i-1] = 0.0;
27253 0 : for(j=2;j<=*n;j++) {
27254 0 : for(i=j-1;i>=2;i--)
27255 0 : a[(j-1)*(*lda)+(i-1)] = a[(j-1)*(*lda)+(i-2)];
27256 0 : a[(j-1)*(*lda)+0] = 0.0;
27257 : }
27258 0 : if(*n>1) {
27259 0 : i1 = *n-1;
27260 0 : PLUMED_BLAS_F77_FUNC(sorglq,SORGLQ)(&i1,&i1,&i1,&(a[*lda+1]),lda,tau,work,lwork,&iinfo);
27261 : }
27262 : }
27263 : }
27264 0 : work[0] = wrksz;
27265 0 : return;
27266 : }
27267 :
27268 : }
27269 : }
27270 : #include "blas/blas.h"
27271 : #include "lapack.h"
27272 :
27273 : #include "blas/blas.h"
27274 : namespace PLMD{
27275 : namespace lapack{
27276 : using namespace blas;
27277 : void
27278 0 : PLUMED_BLAS_F77_FUNC(sorgl2,SORGL2)(int *m,
27279 : int *n,
27280 : int *k,
27281 : float *a,
27282 : int *lda,
27283 : float *tau,
27284 : float *work,
27285 : int *info)
27286 : {
27287 : int a_dim1, a_offset, i__1, i__2;
27288 : float r__1;
27289 :
27290 : int i__, j, l;
27291 :
27292 0 : a_dim1 = *lda;
27293 0 : a_offset = 1 + a_dim1;
27294 0 : a -= a_offset;
27295 0 : --tau;
27296 : --work;
27297 :
27298 0 : i__ = (*m > 1) ? *m : 1;
27299 :
27300 0 : *info = 0;
27301 0 : if (*m < 0) {
27302 0 : *info = -1;
27303 0 : } else if (*n < *m) {
27304 0 : *info = -2;
27305 0 : } else if (*k < 0 || *k > *m) {
27306 0 : *info = -3;
27307 0 : } else if (*lda < i__) {
27308 0 : *info = -5;
27309 : }
27310 0 : if (*info != 0) {
27311 : return;
27312 : }
27313 0 : if (*m <= 0) {
27314 : return;
27315 : }
27316 :
27317 0 : if (*k < *m) {
27318 0 : i__1 = *n;
27319 0 : for (j = 1; j <= i__1; ++j) {
27320 0 : i__2 = *m;
27321 0 : for (l = *k + 1; l <= i__2; ++l) {
27322 0 : a[l + j * a_dim1] = 0.0;
27323 : }
27324 0 : if (j > *k && j <= *m) {
27325 0 : a[j + j * a_dim1] = 1.0;
27326 : }
27327 : }
27328 : }
27329 :
27330 0 : for (i__ = *k; i__ >= 1; --i__) {
27331 0 : if (i__ < *n) {
27332 0 : if (i__ < *m) {
27333 0 : a[i__ + i__ * a_dim1] = 1.0;
27334 0 : i__1 = *m - i__;
27335 0 : i__2 = *n - i__ + 1;
27336 0 : PLUMED_BLAS_F77_FUNC(slarf,SLARF)("R", &i__1, &i__2, &a[i__ + i__ * a_dim1], lda,
27337 0 : &tau[i__], &a[i__ + 1 + i__ * a_dim1], lda, &work[1]);
27338 : }
27339 0 : i__1 = *n - i__;
27340 0 : r__1 = -tau[i__];
27341 0 : PLUMED_BLAS_F77_FUNC(sscal,SSCAL)(&i__1, &r__1, &a[i__ + (i__ + 1) * a_dim1], lda);
27342 : }
27343 0 : a[i__ + i__ * a_dim1] = 1.0 - tau[i__];
27344 0 : i__1 = i__ - 1;
27345 0 : for (l = 1; l <= i__1; ++l) {
27346 0 : a[i__ + l * a_dim1] = 0.0;
27347 : }
27348 : }
27349 : return;
27350 :
27351 : }
27352 :
27353 :
27354 :
27355 : }
27356 : }
27357 : #include "lapack.h"
27358 :
27359 : #define SORGLQ_BLOCKSIZE 32
27360 : #define SORGLQ_MINBLOCKSIZE 2
27361 : #define SORGLQ_CROSSOVER 128
27362 :
27363 :
27364 : #include "blas/blas.h"
27365 : namespace PLMD{
27366 : namespace lapack{
27367 : using namespace blas;
27368 : void
27369 0 : PLUMED_BLAS_F77_FUNC(sorglq,SORGLQ)(int *m,
27370 : int *n,
27371 : int *k,
27372 : float *a,
27373 : int *lda,
27374 : float *tau,
27375 : float *work,
27376 : int *lwork,
27377 : int *info)
27378 : {
27379 : int a_dim1, a_offset, i__1, i__2, i__3;
27380 :
27381 : int i__, j, l, ib, nb, ki, kk, nx, iws, nbmin, iinfo;
27382 :
27383 : int ldwork, lwkopt;
27384 : int lquery;
27385 :
27386 0 : a_dim1 = *lda;
27387 0 : a_offset = 1 + a_dim1;
27388 0 : a -= a_offset;
27389 0 : --tau;
27390 : --work;
27391 :
27392 0 : *info = 0;
27393 : ki = 0;
27394 : nb = SORGLQ_BLOCKSIZE;
27395 0 : lwkopt = (*m) * nb;
27396 0 : work[1] = (float) lwkopt;
27397 0 : lquery = *lwork == -1;
27398 0 : if (*m < 0) {
27399 0 : *info = -1;
27400 0 : } else if (*n < *m) {
27401 0 : *info = -2;
27402 0 : } else if (*k < 0 || *k > *m) {
27403 0 : *info = -3;
27404 0 : } else if (*lda < (*m)) {
27405 0 : *info = -5;
27406 0 : } else if (*lwork < (*m) && ! lquery) {
27407 0 : *info = -8;
27408 : }
27409 0 : if (*info != 0) {
27410 : i__1 = -(*info);
27411 : return;
27412 0 : } else if (lquery) {
27413 : return;
27414 : }
27415 :
27416 0 : if (*m <= 0) {
27417 0 : work[1] = 1.;
27418 0 : return;
27419 : }
27420 :
27421 : nbmin = 2;
27422 : nx = 0;
27423 : iws = *m;
27424 0 : if (nb > 1 && nb < *k) {
27425 :
27426 : nx = SORGLQ_CROSSOVER;
27427 0 : if (nx < *k) {
27428 :
27429 0 : ldwork = *m;
27430 0 : iws = ldwork * nb;
27431 0 : if (*lwork < iws) {
27432 :
27433 0 : nb = *lwork / ldwork;
27434 : nbmin = SORGLQ_MINBLOCKSIZE;
27435 : }
27436 : }
27437 : }
27438 :
27439 0 : if (nb >= nbmin && nb < *k && nx < *k) {
27440 :
27441 0 : ki = (*k - nx - 1) / nb * nb;
27442 0 : i__1 = *k, i__2 = ki + nb;
27443 : kk = (i__1<i__2) ? i__1 : i__2;
27444 :
27445 0 : i__1 = kk;
27446 0 : for (j = 1; j <= i__1; ++j) {
27447 0 : i__2 = *m;
27448 0 : for (i__ = kk + 1; i__ <= i__2; ++i__) {
27449 0 : a[i__ + j * a_dim1] = 0.;
27450 : }
27451 : }
27452 : } else {
27453 : kk = 0;
27454 : }
27455 0 : if (kk < *m) {
27456 0 : i__1 = *m - kk;
27457 0 : i__2 = *n - kk;
27458 0 : i__3 = *k - kk;
27459 0 : PLUMED_BLAS_F77_FUNC(sorgl2,SORGL2)(&i__1, &i__2, &i__3, &a[kk + 1 + (kk + 1) * a_dim1], lda, &
27460 0 : tau[kk + 1], &work[1], &iinfo);
27461 : }
27462 :
27463 0 : if (kk > 0) {
27464 :
27465 0 : i__1 = -nb;
27466 0 : for (i__ = ki + 1; i__1 < 0 ? i__ >= 1 : i__ <= 1; i__ += i__1) {
27467 0 : i__2 = nb, i__3 = *k - i__ + 1;
27468 0 : ib = (i__2<i__3) ? i__2 : i__3;
27469 0 : if (i__ + ib <= *m) {
27470 :
27471 0 : i__2 = *n - i__ + 1;
27472 0 : PLUMED_BLAS_F77_FUNC(slarft,SLARFT)("Forward", "Rowwise", &i__2, &ib, &a[i__ + i__ *
27473 0 : a_dim1], lda, &tau[i__], &work[1], &ldwork);
27474 :
27475 0 : i__2 = *m - i__ - ib + 1;
27476 0 : i__3 = *n - i__ + 1;
27477 0 : PLUMED_BLAS_F77_FUNC(slarfb,SLARFB)("Right", "Transpose", "Forward", "Rowwise", &i__2, &
27478 : i__3, &ib, &a[i__ + i__ * a_dim1], lda, &work[1], &
27479 0 : ldwork, &a[i__ + ib + i__ * a_dim1], lda, &work[ib +
27480 0 : 1], &ldwork);
27481 : }
27482 :
27483 0 : i__2 = *n - i__ + 1;
27484 0 : PLUMED_BLAS_F77_FUNC(sorgl2,SORGL2)(&ib, &i__2, &ib, &a[i__ + i__ * a_dim1], lda, &tau[i__], &
27485 : work[1], &iinfo);
27486 :
27487 0 : i__2 = i__ - 1;
27488 0 : for (j = 1; j <= i__2; ++j) {
27489 0 : i__3 = i__ + ib - 1;
27490 0 : for (l = i__; l <= i__3; ++l) {
27491 0 : a[l + j * a_dim1] = 0.;
27492 : }
27493 : }
27494 : }
27495 : }
27496 :
27497 0 : work[1] = (float) iws;
27498 0 : return;
27499 :
27500 : }
27501 :
27502 :
27503 : }
27504 : }
27505 : #include "lapack.h"
27506 : #include "lapack_limits.h"
27507 :
27508 :
27509 : #include "blas/blas.h"
27510 : namespace PLMD{
27511 : namespace lapack{
27512 : using namespace blas;
27513 : void
27514 0 : PLUMED_BLAS_F77_FUNC(sorgqr,SORGQR)(int *m,
27515 : int *n,
27516 : int *k,
27517 : float *a,
27518 : int *lda,
27519 : float *tau,
27520 : float *work,
27521 : int *lwork,
27522 : int *info)
27523 : {
27524 : int a_dim1, a_offset, i__1, i__2, i__3;
27525 :
27526 : int i__, j, l, ib, nb, ki, kk, nx, iws, nbmin, iinfo;
27527 : int ldwork, lwkopt;
27528 : int lquery;
27529 :
27530 0 : a_dim1 = *lda;
27531 0 : a_offset = 1 + a_dim1;
27532 0 : a -= a_offset;
27533 0 : --tau;
27534 : --work;
27535 :
27536 : ki = 0;
27537 0 : *info = 0;
27538 : nb = DORGQR_BLOCKSIZE;
27539 0 : lwkopt = (*n) * nb;
27540 0 : work[1] = (float) lwkopt;
27541 0 : lquery = *lwork == -1;
27542 0 : if (*m < 0) {
27543 0 : *info = -1;
27544 0 : } else if (*n < 0 || *n > *m) {
27545 0 : *info = -2;
27546 0 : } else if (*k < 0 || *k > *n) {
27547 0 : *info = -3;
27548 0 : } else if (*lda < (*m)) {
27549 0 : *info = -5;
27550 0 : } else if (*lwork < (*n) && ! lquery) {
27551 0 : *info = -8;
27552 : }
27553 0 : if (*info != 0) {
27554 : i__1 = -(*info);
27555 : return;
27556 0 : } else if (lquery) {
27557 : return;
27558 : }
27559 :
27560 0 : if (*n <= 0) {
27561 0 : work[1] = 1.;
27562 0 : return;
27563 : }
27564 :
27565 : nbmin = 2;
27566 : nx = 0;
27567 : iws = *n;
27568 0 : if (nb > 1 && nb < *k) {
27569 :
27570 : nx = DORGQR_CROSSOVER;
27571 0 : if (nx < *k) {
27572 :
27573 0 : ldwork = *n;
27574 0 : iws = ldwork * nb;
27575 0 : if (*lwork < iws) {
27576 :
27577 0 : nb = *lwork / ldwork;
27578 : nbmin = DORGQR_MINBLOCKSIZE;
27579 : }
27580 : }
27581 : }
27582 :
27583 0 : if (nb >= nbmin && nb < *k && nx < *k) {
27584 :
27585 0 : ki = (*k - nx - 1) / nb * nb;
27586 0 : i__1 = *k, i__2 = ki + nb;
27587 : kk = (i__1<i__2) ? i__1 : i__2;
27588 :
27589 0 : i__1 = *n;
27590 0 : for (j = kk + 1; j <= i__1; ++j) {
27591 0 : i__2 = kk;
27592 0 : for (i__ = 1; i__ <= i__2; ++i__) {
27593 0 : a[i__ + j * a_dim1] = 0.;
27594 : }
27595 : }
27596 : } else {
27597 : kk = 0;
27598 : }
27599 :
27600 0 : if (kk < *n) {
27601 0 : i__1 = *m - kk;
27602 0 : i__2 = *n - kk;
27603 0 : i__3 = *k - kk;
27604 0 : PLUMED_BLAS_F77_FUNC(sorg2r,SORG2R)(&i__1, &i__2, &i__3, &a[kk + 1 + (kk + 1) * a_dim1], lda, &
27605 0 : tau[kk + 1], &work[1], &iinfo);
27606 : }
27607 :
27608 0 : if (kk > 0) {
27609 :
27610 0 : i__1 = -nb;
27611 0 : for (i__ = ki + 1; i__1 < 0 ? i__ >= 1 : i__ <= 1; i__ += i__1) {
27612 0 : i__2 = nb, i__3 = *k - i__ + 1;
27613 0 : ib = (i__2<i__3) ? i__2 : i__3;
27614 0 : if (i__ + ib <= *n) {
27615 :
27616 0 : i__2 = *m - i__ + 1;
27617 0 : PLUMED_BLAS_F77_FUNC(slarft,SLARFT)("Forward", "Columnwise", &i__2, &ib, &a[i__ + i__ *
27618 0 : a_dim1], lda, &tau[i__], &work[1], &ldwork);
27619 :
27620 0 : i__2 = *m - i__ + 1;
27621 0 : i__3 = *n - i__ - ib + 1;
27622 0 : PLUMED_BLAS_F77_FUNC(slarfb,SLARFB)("Left", "No transpose", "Forward", "Columnwise", &
27623 : i__2, &i__3, &ib, &a[i__ + i__ * a_dim1], lda, &work[
27624 0 : 1], &ldwork, &a[i__ + (i__ + ib) * a_dim1], lda, &
27625 0 : work[ib + 1], &ldwork);
27626 : }
27627 :
27628 0 : i__2 = *m - i__ + 1;
27629 0 : PLUMED_BLAS_F77_FUNC(sorg2r,SORG2R)(&i__2, &ib, &ib, &a[i__ + i__ * a_dim1], lda, &tau[i__], &
27630 : work[1], &iinfo);
27631 :
27632 0 : i__2 = i__ + ib - 1;
27633 0 : for (j = i__; j <= i__2; ++j) {
27634 0 : i__3 = i__ - 1;
27635 0 : for (l = 1; l <= i__3; ++l) {
27636 0 : a[l + j * a_dim1] = 0.;
27637 : }
27638 : }
27639 : }
27640 : }
27641 :
27642 0 : work[1] = (float) iws;
27643 0 : return;
27644 :
27645 : }
27646 : }
27647 : }
27648 : #include "lapack.h"
27649 :
27650 : #include "blas/blas.h"
27651 : namespace PLMD{
27652 : namespace lapack{
27653 : using namespace blas;
27654 : void
27655 0 : PLUMED_BLAS_F77_FUNC(sorm2l,SORM2L)(const char *side,
27656 : const char *trans,
27657 : int *m,
27658 : int *n,
27659 : int *k,
27660 : float *a,
27661 : int *lda,
27662 : float *tau,
27663 : float *c__,
27664 : int *ldc,
27665 : float *work,
27666 : int *info)
27667 : {
27668 : int a_dim1, a_offset, c_dim1, c_offset, i__1, i__2;
27669 0 : int c__1 = 1;
27670 :
27671 : int i__, i1, i2, i3, mi, ni, nq;
27672 : float aii;
27673 : int left;
27674 : int notran;
27675 :
27676 0 : a_dim1 = *lda;
27677 0 : a_offset = 1 + a_dim1;
27678 0 : a -= a_offset;
27679 : --tau;
27680 : c_dim1 = *ldc;
27681 : c_offset = 1 + c_dim1;
27682 : c__ -= c_offset;
27683 : --work;
27684 :
27685 : /* Function Body */
27686 0 : *info = 0;
27687 0 : left = (*side=='L' || *side=='l');
27688 0 : notran = (*trans=='N' || *trans=='n');
27689 :
27690 0 : if (left) {
27691 0 : nq = *m;
27692 : } else {
27693 0 : nq = *n;
27694 : }
27695 : if (*info != 0) {
27696 : return;
27697 : }
27698 :
27699 0 : if (*m == 0 || *n == 0 || *k == 0) {
27700 : return;
27701 : }
27702 :
27703 0 : if ((left && notran) || (! left && ! notran)) {
27704 : i1 = 1;
27705 : i2 = *k;
27706 : i3 = 1;
27707 : } else {
27708 : i1 = *k;
27709 : i2 = 1;
27710 : i3 = -1;
27711 : }
27712 :
27713 0 : if (left) {
27714 0 : ni = *n;
27715 : } else {
27716 0 : mi = *m;
27717 : }
27718 :
27719 : i__1 = i2;
27720 : i__2 = i3;
27721 0 : for (i__ = i1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) {
27722 0 : if (left) {
27723 :
27724 0 : mi = *m - *k + i__;
27725 : } else {
27726 :
27727 0 : ni = *n - *k + i__;
27728 : }
27729 :
27730 0 : aii = a[nq - *k + i__ + i__ * a_dim1];
27731 0 : a[nq - *k + i__ + i__ * a_dim1] = 1.;
27732 0 : PLUMED_BLAS_F77_FUNC(slarf,SLARF)(side, &mi, &ni, &a[i__ * a_dim1 + 1], &c__1, &tau[i__], &c__[
27733 : c_offset], ldc, &work[1]);
27734 0 : a[nq - *k + i__ + i__ * a_dim1] = aii;
27735 : }
27736 : return;
27737 : }
27738 : }
27739 : }
27740 : #include "lapack.h"
27741 :
27742 : #include "blas/blas.h"
27743 : namespace PLMD{
27744 : namespace lapack{
27745 : using namespace blas;
27746 : void
27747 0 : PLUMED_BLAS_F77_FUNC(sorm2r,SORM2R)(const char *side,
27748 : const char *trans,
27749 : int *m,
27750 : int *n,
27751 : int *k,
27752 : float *a,
27753 : int *lda,
27754 : float *tau,
27755 : float *c__,
27756 : int *ldc,
27757 : float *work,
27758 : int *info)
27759 : {
27760 : int a_dim1, a_offset, c_dim1, c_offset, i__1, i__2;
27761 :
27762 : int i__, i1, i2, i3, ic, jc, mi, ni;
27763 : float aii;
27764 : int left;
27765 : int notran;
27766 0 : int c__1 = 1;
27767 :
27768 0 : a_dim1 = *lda;
27769 0 : a_offset = 1 + a_dim1;
27770 0 : a -= a_offset;
27771 : --tau;
27772 0 : c_dim1 = *ldc;
27773 0 : c_offset = 1 + c_dim1;
27774 0 : c__ -= c_offset;
27775 : --work;
27776 0 : *info = 0;
27777 0 : left = (*side=='L' || *side=='l');
27778 0 : notran = (*trans=='N' || *trans=='n');
27779 :
27780 : ic = jc = 0;
27781 :
27782 0 : if (*m <= 0 || *n <= 0 || *k <= 0) {
27783 : return;
27784 : }
27785 :
27786 0 : if ((left && !notran) || (!left && notran)) {
27787 : i1 = 1;
27788 : i2 = *k;
27789 : i3 = 1;
27790 : } else {
27791 : i1 = *k;
27792 : i2 = 1;
27793 : i3 = -1;
27794 : }
27795 :
27796 0 : if (left) {
27797 0 : ni = *n;
27798 : jc = 1;
27799 : } else {
27800 0 : mi = *m;
27801 : ic = 1;
27802 : }
27803 :
27804 : i__1 = i2;
27805 : i__2 = i3;
27806 0 : for (i__ = i1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) {
27807 0 : if (left) {
27808 :
27809 0 : mi = *m - i__ + 1;
27810 : ic = i__;
27811 : } else {
27812 :
27813 0 : ni = *n - i__ + 1;
27814 : jc = i__;
27815 : }
27816 :
27817 :
27818 0 : aii = a[i__ + i__ * a_dim1];
27819 0 : a[i__ + i__ * a_dim1] = 1.;
27820 0 : PLUMED_BLAS_F77_FUNC(slarf,SLARF)(side, &mi, &ni, &a[i__ + i__ * a_dim1], &c__1, &tau[i__], &c__[
27821 0 : ic + jc * c_dim1], ldc, &work[1]);
27822 0 : a[i__ + i__ * a_dim1] = aii;
27823 : }
27824 : return;
27825 :
27826 : }
27827 : }
27828 : }
27829 : #include "lapack.h"
27830 : #include "lapack_limits.h"
27831 :
27832 : #include "blas/blas.h"
27833 : namespace PLMD{
27834 : namespace lapack{
27835 : using namespace blas;
27836 : void
27837 0 : PLUMED_BLAS_F77_FUNC(sormbr,SORMBR)(const char *vect,
27838 : const char *side,
27839 : const char *trans,
27840 : int *m,
27841 : int *n,
27842 : int *k,
27843 : float *a,
27844 : int *lda,
27845 : float *tau,
27846 : float *c__,
27847 : int *ldc,
27848 : float *work,
27849 : int *lwork,
27850 : int *info)
27851 : {
27852 : int a_dim1, a_offset, c_dim1, c_offset, i__1;
27853 :
27854 :
27855 : int i1, i2, nb, mi, ni, nq, nw;
27856 : int left;
27857 : int iinfo;
27858 : int notran;
27859 : int applyq;
27860 : char transt[1];
27861 : int lwkopt;
27862 : int lquery;
27863 :
27864 0 : a_dim1 = *lda;
27865 0 : a_offset = 1 + a_dim1;
27866 0 : a -= a_offset;
27867 : --tau;
27868 0 : c_dim1 = *ldc;
27869 0 : c_offset = 1 + c_dim1;
27870 0 : c__ -= c_offset;
27871 : --work;
27872 0 : *info = 0;
27873 0 : applyq = (*vect=='Q' || *vect=='q');
27874 0 : left = (*side=='L' || *side=='l');
27875 0 : notran = (*trans=='N' || *trans=='n');
27876 0 : lquery = *lwork == -1;
27877 :
27878 0 : if (left) {
27879 0 : nq = *m;
27880 0 : nw = *n;
27881 : } else {
27882 0 : nq = *n;
27883 0 : nw = *m;
27884 : }
27885 :
27886 : nb = DORMQR_BLOCKSIZE;
27887 0 : lwkopt = nw * nb;
27888 0 : work[1] = (float) lwkopt;
27889 :
27890 0 : if (*info != 0) {
27891 : i__1 = -(*info);
27892 : return;
27893 0 : } else if (lquery) {
27894 : return;
27895 : }
27896 :
27897 0 : work[1] = 1.;
27898 0 : if (*m == 0 || *n == 0) {
27899 : return;
27900 : }
27901 :
27902 0 : if (applyq) {
27903 :
27904 0 : if (nq >= *k) {
27905 :
27906 0 : PLUMED_BLAS_F77_FUNC(sormqr,SORMQR)(side, trans, m, n, k, &a[a_offset], lda, &tau[1], &c__[
27907 : c_offset], ldc, &work[1], lwork, &iinfo);
27908 0 : } else if (nq > 1) {
27909 :
27910 0 : if (left) {
27911 0 : mi = *m - 1;
27912 0 : ni = *n;
27913 : i1 = 2;
27914 : i2 = 1;
27915 : } else {
27916 0 : mi = *m;
27917 0 : ni = *n - 1;
27918 : i1 = 1;
27919 : i2 = 2;
27920 : }
27921 0 : i__1 = nq - 1;
27922 0 : PLUMED_BLAS_F77_FUNC(sormqr,SORMQR)(side, trans, &mi, &ni, &i__1, &a[a_dim1 + 2], lda, &tau[1]
27923 0 : , &c__[i1 + i2 * c_dim1], ldc, &work[1], lwork, &iinfo);
27924 : }
27925 : } else {
27926 :
27927 0 : if (notran) {
27928 0 : *(unsigned char *)transt = 'T';
27929 : } else {
27930 0 : *(unsigned char *)transt = 'N';
27931 : }
27932 0 : if (nq > *k) {
27933 :
27934 0 : PLUMED_BLAS_F77_FUNC(sormlq,SORMLQ)(side, transt, m, n, k, &a[a_offset], lda, &tau[1], &c__[
27935 : c_offset], ldc, &work[1], lwork, &iinfo);
27936 0 : } else if (nq > 1) {
27937 :
27938 0 : if (left) {
27939 0 : mi = *m - 1;
27940 0 : ni = *n;
27941 : i1 = 2;
27942 : i2 = 1;
27943 : } else {
27944 0 : mi = *m;
27945 0 : ni = *n - 1;
27946 : i1 = 1;
27947 : i2 = 2;
27948 : }
27949 0 : i__1 = nq - 1;
27950 0 : PLUMED_BLAS_F77_FUNC(sormlq,SORMLQ)(side, transt, &mi, &ni, &i__1, &a[(a_dim1 << 1) + 1], lda,
27951 0 : &tau[1], &c__[i1 + i2 * c_dim1], ldc, &work[1], lwork, &
27952 : iinfo);
27953 : }
27954 : }
27955 0 : work[1] = (float) lwkopt;
27956 0 : return;
27957 :
27958 :
27959 : }
27960 :
27961 :
27962 : }
27963 : }
27964 : #include <cctype>
27965 : #include "real.h"
27966 : #include "lapack.h"
27967 :
27968 : #include "blas/blas.h"
27969 : namespace PLMD{
27970 : namespace lapack{
27971 : using namespace blas;
27972 : void
27973 0 : PLUMED_BLAS_F77_FUNC(sorml2,SORML2)(const char *side,
27974 : const char *trans,
27975 : int *m,
27976 : int *n,
27977 : int *k,
27978 : float *a,
27979 : int *lda,
27980 : float *tau,
27981 : float *c,
27982 : int *ldc,
27983 : float *work,
27984 : int *info)
27985 : {
27986 0 : const char xside=std::toupper(*side);
27987 0 : const char xtrans=std::toupper(*trans);
27988 : int i,i1,i2,i3,ni,mi,ic,jc;
27989 : float aii;
27990 :
27991 0 : if(*m<=0 || *n<=0 || *k<=0)
27992 : return;
27993 :
27994 : ic = jc = 0;
27995 :
27996 0 : if((xside=='L' && xtrans=='N') || (xside!='L' && xtrans!='N')) {
27997 : i1 = 0;
27998 : i2 = *k;
27999 : i3 = 1;
28000 : } else {
28001 0 : i1 = *k-1;
28002 : i2 = -1;
28003 : i3 = -1;
28004 : }
28005 :
28006 0 : if(xside=='L') {
28007 0 : ni = *n;
28008 : jc = 0;
28009 : } else {
28010 0 : mi = *m;
28011 : ic = 0;
28012 : }
28013 :
28014 0 : for(i=i1;i!=i2;i+=i3) {
28015 0 : if(xside=='L') {
28016 0 : mi = *m - i;
28017 : ic = i;
28018 : } else {
28019 0 : ni = *n - i;
28020 : jc = i;
28021 : }
28022 0 : aii = a[i*(*lda)+i];
28023 0 : a[i*(*lda)+i] = 1.0;
28024 0 : PLUMED_BLAS_F77_FUNC(slarf,SLARF)(side,&mi,&ni,&(a[i*(*lda)+i]),lda,tau+i,
28025 0 : &(c[jc*(*ldc)+ic]),ldc,work);
28026 0 : a[i*(*lda)+i] = aii;
28027 : }
28028 : return;
28029 : }
28030 :
28031 : }
28032 : }
28033 : #include "lapack.h"
28034 : #include "lapack_limits.h"
28035 :
28036 :
28037 : #include "blas/blas.h"
28038 : namespace PLMD{
28039 : namespace lapack{
28040 : using namespace blas;
28041 : void
28042 0 : PLUMED_BLAS_F77_FUNC(sormlq,SORMLQ)(const char *side,
28043 : const char *trans,
28044 : int *m,
28045 : int *n,
28046 : int *k,
28047 : float *a,
28048 : int *lda,
28049 : float *tau,
28050 : float *c__,
28051 : int *ldc,
28052 : float *work,
28053 : int *lwork,
28054 : int *info)
28055 : {
28056 : int a_dim1, a_offset, c_dim1, c_offset, i__1, i__2, i__4,
28057 : i__5;
28058 :
28059 :
28060 : int i__;
28061 : float t[4160] /* was [65][64] */;
28062 : int i1, i2, i3, ib, ic, jc, nb, mi, ni, nq, nw, iws;
28063 : int left;
28064 : int nbmin, iinfo;
28065 : int notran;
28066 : int ldwork;
28067 : char transt[1];
28068 : int lwkopt;
28069 : int lquery;
28070 0 : int ldt = 65;
28071 :
28072 0 : a_dim1 = *lda;
28073 0 : a_offset = 1 + a_dim1;
28074 0 : a -= a_offset;
28075 : --tau;
28076 0 : c_dim1 = *ldc;
28077 0 : c_offset = 1 + c_dim1;
28078 0 : c__ -= c_offset;
28079 : --work;
28080 :
28081 : ic = jc = 0;
28082 :
28083 0 : *info = 0;
28084 0 : left = (*side=='L' || *side=='l');
28085 0 : notran = (*trans=='N' || *trans=='n');
28086 0 : lquery = *lwork == -1;
28087 :
28088 0 : if (left) {
28089 0 : nq = *m;
28090 0 : nw = *n;
28091 : } else {
28092 0 : nq = *n;
28093 0 : nw = *m;
28094 : }
28095 :
28096 : nb = DORMLQ_BLOCKSIZE;
28097 0 : lwkopt = nw * nb;
28098 0 : work[1] = (float) lwkopt;
28099 :
28100 0 : if (*info != 0) {
28101 : return;
28102 0 : } else if (lquery) {
28103 : return;
28104 : }
28105 :
28106 0 : if (*m == 0 || *n == 0 || *k == 0) {
28107 0 : work[1] = 1.;
28108 0 : return;
28109 : }
28110 :
28111 : nbmin = 2;
28112 0 : ldwork = nw;
28113 0 : if (nb > 1 && nb < *k) {
28114 : iws = nw * nb;
28115 0 : if (*lwork < iws) {
28116 0 : nb = *lwork / ldwork;
28117 : nbmin = DORMLQ_MINBLOCKSIZE;
28118 : }
28119 : }
28120 :
28121 0 : if (nb < nbmin || nb >= *k) {
28122 :
28123 :
28124 0 : PLUMED_BLAS_F77_FUNC(sorml2,SORML2)(side, trans, m, n, k, &a[a_offset], lda, &tau[1], &c__[
28125 : c_offset], ldc, &work[1], &iinfo);
28126 : } else {
28127 :
28128 0 : if ((left && notran) || (!left && !notran)) {
28129 : i1 = 1;
28130 : i2 = *k;
28131 : i3 = nb;
28132 : } else {
28133 0 : i1 = (*k - 1) / nb * nb + 1;
28134 : i2 = 1;
28135 0 : i3 = -nb;
28136 : }
28137 :
28138 0 : if (left) {
28139 0 : ni = *n;
28140 : jc = 1;
28141 : } else {
28142 0 : mi = *m;
28143 : ic = 1;
28144 : }
28145 :
28146 0 : if (notran) {
28147 0 : *(unsigned char *)transt = 'T';
28148 : } else {
28149 0 : *(unsigned char *)transt = 'N';
28150 : }
28151 :
28152 : i__1 = i2;
28153 : i__2 = i3;
28154 0 : for (i__ = i1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) {
28155 0 : i__4 = nb, i__5 = *k - i__ + 1;
28156 0 : ib = (i__4<i__5) ? i__4 : i__5;
28157 :
28158 0 : i__4 = nq - i__ + 1;
28159 0 : PLUMED_BLAS_F77_FUNC(slarft,SLARFT)("Forward", "Rowwise", &i__4, &ib, &a[i__ + i__ * a_dim1],
28160 0 : lda, &tau[i__], t, &ldt);
28161 0 : if (left) {
28162 :
28163 0 : mi = *m - i__ + 1;
28164 : ic = i__;
28165 : } else {
28166 :
28167 0 : ni = *n - i__ + 1;
28168 : jc = i__;
28169 : }
28170 :
28171 0 : PLUMED_BLAS_F77_FUNC(slarfb,SLARFB)(side, transt, "Forward", "Rowwise", &mi, &ni, &ib, &a[i__
28172 0 : + i__ * a_dim1], lda, t, &ldt, &c__[ic + jc * c_dim1],
28173 : ldc, &work[1], &ldwork);
28174 : }
28175 : }
28176 0 : work[1] = (float) lwkopt;
28177 0 : return;
28178 :
28179 : }
28180 :
28181 :
28182 : }
28183 : }
28184 : #include "lapack.h"
28185 : #include "lapack_limits.h"
28186 :
28187 : #include "blas/blas.h"
28188 : namespace PLMD{
28189 : namespace lapack{
28190 : using namespace blas;
28191 : void
28192 0 : PLUMED_BLAS_F77_FUNC(sormql,SORMQL)(const char *side, const char *trans, int *m, int *n,
28193 : int *k, float *a, int *lda, float *tau, float *
28194 : c__, int *ldc, float *work, int *lwork, int *info)
28195 : {
28196 : int a_dim1, a_offset, c_dim1, c_offset, i__1, i__2, i__4, i__5;
28197 0 : int c__65 = 65;
28198 :
28199 : int i__;
28200 : float t[4160];
28201 : int i1, i2, i3, ib, nb, mi, ni, nq, nw, iws;
28202 : int left;
28203 : int nbmin, iinfo;
28204 : int notran;
28205 : int ldwork, lwkopt;
28206 : int lquery;
28207 :
28208 :
28209 0 : a_dim1 = *lda;
28210 0 : a_offset = 1 + a_dim1;
28211 0 : a -= a_offset;
28212 : --tau;
28213 : c_dim1 = *ldc;
28214 : c_offset = 1 + c_dim1;
28215 : c__ -= c_offset;
28216 : --work;
28217 :
28218 0 : *info = 0;
28219 0 : left = (*side=='L' || *side=='l');
28220 0 : notran = (*trans=='N' || *trans=='n');
28221 0 : lquery = *lwork == -1;
28222 :
28223 0 : if (left) {
28224 0 : nq = *m;
28225 0 : nw = *n;
28226 : } else {
28227 0 : nq = *n;
28228 0 : nw = *m;
28229 : }
28230 :
28231 : nb = DORMQL_BLOCKSIZE;
28232 0 : lwkopt = nw * nb;
28233 0 : work[1] = (float) lwkopt;
28234 :
28235 0 : if (*info != 0) {
28236 : return;
28237 0 : } else if (lquery) {
28238 : return;
28239 : }
28240 :
28241 0 : if (*m == 0 || *n == 0 || *k == 0) {
28242 0 : work[1] = 1.;
28243 0 : return;
28244 : }
28245 :
28246 : nbmin = 2;
28247 0 : ldwork = nw;
28248 0 : if (nb > 1 && nb < *k) {
28249 : iws = nw * nb;
28250 0 : if (*lwork < iws) {
28251 0 : nb = *lwork / ldwork;
28252 : nbmin = DORMQL_MINBLOCKSIZE;
28253 : }
28254 : }
28255 :
28256 0 : if (nb < nbmin || nb >= *k) {
28257 :
28258 0 : PLUMED_BLAS_F77_FUNC(sorm2l,SORM2L)(side, trans, m, n, k, &a[a_offset], lda, &tau[1], &c__[
28259 : c_offset], ldc, &work[1], &iinfo);
28260 : } else {
28261 :
28262 0 : if ((left && notran) || (! left && ! notran)) {
28263 : i1 = 1;
28264 : i2 = *k;
28265 : i3 = nb;
28266 : } else {
28267 0 : i1 = (*k - 1) / nb * nb + 1;
28268 : i2 = 1;
28269 0 : i3 = -nb;
28270 : }
28271 :
28272 0 : if (left) {
28273 0 : ni = *n;
28274 : } else {
28275 0 : mi = *m;
28276 : }
28277 :
28278 : i__1 = i2;
28279 : i__2 = i3;
28280 0 : for (i__ = i1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) {
28281 0 : i__4 = nb, i__5 = *k - i__ + 1;
28282 0 : ib = (i__4<i__5) ? i__4 : i__5;
28283 :
28284 0 : i__4 = nq - *k + i__ + ib - 1;
28285 0 : PLUMED_BLAS_F77_FUNC(slarft,SLARFT)("Backward", "Columnwise", &i__4, &ib, &a[i__ * a_dim1 + 1]
28286 0 : , lda, &tau[i__], t, &c__65);
28287 0 : if (left) {
28288 :
28289 0 : mi = *m - *k + i__ + ib - 1;
28290 : } else {
28291 :
28292 0 : ni = *n - *k + i__ + ib - 1;
28293 : }
28294 :
28295 0 : PLUMED_BLAS_F77_FUNC(slarfb,SLARFB)(side, trans, "Backward", "Columnwise", &mi, &ni, &ib, &a[
28296 : i__ * a_dim1 + 1], lda, t, &c__65, &c__[c_offset], ldc, &
28297 : work[1], &ldwork);
28298 : }
28299 : }
28300 0 : work[1] = (float) lwkopt;
28301 0 : return;
28302 :
28303 : }
28304 :
28305 :
28306 : }
28307 : }
28308 : #include "lapack.h"
28309 : #include "lapack_limits.h"
28310 :
28311 : #include "blas/blas.h"
28312 : namespace PLMD{
28313 : namespace lapack{
28314 : using namespace blas;
28315 : void
28316 0 : PLUMED_BLAS_F77_FUNC(sormqr,SORMQR)(const char *side,
28317 : const char *trans,
28318 : int *m,
28319 : int *n,
28320 : int *k,
28321 : float *a,
28322 : int *lda,
28323 : float *tau,
28324 : float *c__,
28325 : int *ldc,
28326 : float *work,
28327 : int *lwork,
28328 : int *info)
28329 : {
28330 : int a_dim1, a_offset, c_dim1, c_offset, i__1, i__2, i__4, i__5;
28331 :
28332 : int i__;
28333 : float t[4160];
28334 : int i1, i2, i3, ib, ic, jc, nb, mi, ni, nq, nw, iws;
28335 : int left;
28336 : int nbmin, iinfo;
28337 : int notran;
28338 : int ldwork, lwkopt;
28339 : int lquery;
28340 0 : int ldt = 65;
28341 :
28342 0 : a_dim1 = *lda;
28343 0 : a_offset = 1 + a_dim1;
28344 0 : a -= a_offset;
28345 : --tau;
28346 0 : c_dim1 = *ldc;
28347 0 : c_offset = 1 + c_dim1;
28348 0 : c__ -= c_offset;
28349 : --work;
28350 :
28351 0 : *info = 0;
28352 0 : left = (*side=='L' || *side=='l');
28353 0 : notran = (*trans=='N' || *trans=='n');
28354 0 : lquery = *lwork == -1;
28355 :
28356 0 : if (left) {
28357 0 : nq = *m;
28358 0 : nw = *n;
28359 : } else {
28360 0 : nq = *n;
28361 0 : nw = *m;
28362 : }
28363 :
28364 : ic = jc = 0;
28365 : nb = DORMQR_BLOCKSIZE;
28366 0 : lwkopt = nw * nb;
28367 0 : work[1] = (float) lwkopt;
28368 :
28369 0 : if (*info != 0) {
28370 : return;
28371 0 : } else if (lquery) {
28372 : return;
28373 : }
28374 :
28375 0 : if (*m == 0 || *n == 0 || *k == 0) {
28376 0 : work[1] = 1.;
28377 0 : return;
28378 : }
28379 :
28380 : nbmin = 2;
28381 0 : ldwork = nw;
28382 0 : if (nb > 1 && nb < *k) {
28383 : iws = nw * nb;
28384 0 : if (*lwork < iws) {
28385 0 : nb = *lwork / ldwork;
28386 : nbmin = DORMQR_MINBLOCKSIZE;
28387 : }
28388 : }
28389 :
28390 0 : if (nb < nbmin || nb >= *k) {
28391 :
28392 0 : PLUMED_BLAS_F77_FUNC(sorm2r,SORM2R)(side, trans, m, n, k, &a[a_offset], lda, &tau[1], &c__[
28393 : c_offset], ldc, &work[1], &iinfo);
28394 : } else {
28395 :
28396 0 : if ((left && !notran) || (!left && notran)) {
28397 : i1 = 1;
28398 : i2 = *k;
28399 : i3 = nb;
28400 : } else {
28401 0 : i1 = (*k - 1) / nb * nb + 1;
28402 : i2 = 1;
28403 0 : i3 = -nb;
28404 : }
28405 :
28406 0 : if (left) {
28407 0 : ni = *n;
28408 : jc = 1;
28409 : } else {
28410 0 : mi = *m;
28411 : ic = 1;
28412 : }
28413 :
28414 : i__1 = i2;
28415 : i__2 = i3;
28416 0 : for (i__ = i1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) {
28417 0 : i__4 = nb, i__5 = *k - i__ + 1;
28418 0 : ib = (i__4<i__5) ? i__4 : i__5;
28419 :
28420 0 : i__4 = nq - i__ + 1;
28421 0 : PLUMED_BLAS_F77_FUNC(slarft,SLARFT)("Forward", "Columnwise", &i__4, &ib, &a[i__ + i__ *
28422 0 : a_dim1], lda, &tau[i__], t, &ldt);
28423 0 : if (left) {
28424 :
28425 0 : mi = *m - i__ + 1;
28426 : ic = i__;
28427 : } else {
28428 0 : ni = *n - i__ + 1;
28429 : jc = i__;
28430 : }
28431 :
28432 0 : PLUMED_BLAS_F77_FUNC(slarfb,SLARFB)(side, trans, "Forward", "Columnwise", &mi, &ni, &ib, &a[
28433 0 : i__ + i__ * a_dim1], lda, t, &ldt, &c__[ic + jc *
28434 : c_dim1], ldc, &work[1], &ldwork);
28435 : }
28436 : }
28437 0 : work[1] = (float) lwkopt;
28438 0 : return;
28439 :
28440 :
28441 : }
28442 :
28443 :
28444 : }
28445 : }
28446 : #include "lapack.h"
28447 : #include "lapack_limits.h"
28448 :
28449 :
28450 : #include "blas/blas.h"
28451 : namespace PLMD{
28452 : namespace lapack{
28453 : using namespace blas;
28454 : void
28455 0 : PLUMED_BLAS_F77_FUNC(sormtr,SORMTR)(const char *side,
28456 : const char *uplo,
28457 : const char *trans,
28458 : int *m,
28459 : int *n,
28460 : float *a,
28461 : int *lda,
28462 : float *tau,
28463 : float *c__,
28464 : int *ldc,
28465 : float *work,
28466 : int *lwork,
28467 : int *info)
28468 : {
28469 : int a_dim1, a_offset, c_dim1, c_offset, i__2;
28470 :
28471 : int i1, i2, nb, mi, ni, nq, nw;
28472 : int left;
28473 : int iinfo;
28474 : int upper;
28475 : int lwkopt;
28476 : int lquery;
28477 :
28478 :
28479 0 : a_dim1 = *lda;
28480 0 : a_offset = 1 + a_dim1;
28481 0 : a -= a_offset;
28482 : --tau;
28483 0 : c_dim1 = *ldc;
28484 0 : c_offset = 1 + c_dim1;
28485 0 : c__ -= c_offset;
28486 : --work;
28487 :
28488 0 : *info = 0;
28489 0 : left = (*side=='L' || *side=='l');
28490 0 : upper = (*uplo=='U' || *uplo=='u');
28491 0 : lquery = *lwork == -1;
28492 :
28493 0 : if (left) {
28494 0 : nq = *m;
28495 0 : nw = *n;
28496 : } else {
28497 0 : nq = *n;
28498 0 : nw = *m;
28499 : }
28500 :
28501 :
28502 : nb = DORMQL_BLOCKSIZE;
28503 0 : lwkopt = nw * nb;
28504 0 : work[1] = (float) lwkopt;
28505 :
28506 0 : if (*info != 0) {
28507 : i__2 = -(*info);
28508 : return;
28509 0 : } else if (lquery) {
28510 : return;
28511 : }
28512 :
28513 0 : if (*m == 0 || *n == 0 || nq == 1) {
28514 0 : work[1] = 1.;
28515 0 : return;
28516 : }
28517 :
28518 0 : if (left) {
28519 0 : mi = *m - 1;
28520 0 : ni = *n;
28521 : } else {
28522 0 : mi = *m;
28523 0 : ni = *n - 1;
28524 : }
28525 :
28526 0 : if (upper) {
28527 0 : i__2 = nq - 1;
28528 0 : PLUMED_BLAS_F77_FUNC(sormql,SORMQL)(side, trans, &mi, &ni, &i__2, &a[(a_dim1 << 1) + 1], lda, &
28529 : tau[1], &c__[c_offset], ldc, &work[1], lwork, &iinfo);
28530 : } else {
28531 0 : if (left) {
28532 : i1 = 2;
28533 : i2 = 1;
28534 : } else {
28535 : i1 = 1;
28536 : i2 = 2;
28537 : }
28538 0 : i__2 = nq - 1;
28539 0 : PLUMED_BLAS_F77_FUNC(sormqr,SORMQR)(side, trans, &mi, &ni, &i__2, &a[a_dim1 + 2], lda, &tau[1], &
28540 0 : c__[i1 + i2 * c_dim1], ldc, &work[1], lwork, &iinfo);
28541 : }
28542 0 : work[1] = (float) lwkopt;
28543 0 : return;
28544 :
28545 : }
28546 :
28547 :
28548 : }
28549 : }
28550 : #include <cmath>
28551 : #include "lapack.h"
28552 : #include "lapack_limits.h"
28553 :
28554 : #include "real.h"
28555 :
28556 : #include "blas/blas.h"
28557 : namespace PLMD{
28558 : namespace lapack{
28559 : using namespace blas;
28560 : void
28561 0 : PLUMED_BLAS_F77_FUNC(sstebz,SSTEBZ)(const char *range,
28562 : const char *order,
28563 : int *n,
28564 : float *vl,
28565 : float *vu,
28566 : int *il,
28567 : int *iu,
28568 : float *abstol,
28569 : float *d__,
28570 : float *e,
28571 : int *m,
28572 : int *nsplit,
28573 : float *w,
28574 : int *iblock,
28575 : int *isplit,
28576 : float *work,
28577 : int *iwork,
28578 : int *info)
28579 : {
28580 : int i__1, i__2, i__3;
28581 : float d__1, d__2, d__3, d__4, d__5;
28582 0 : int c__1 = 1;
28583 0 : int c__3 = 3;
28584 0 : int c__2 = 2;
28585 0 : int c__0 = 0;
28586 :
28587 : int j, ib, jb, ie, je, nb;
28588 : float gl;
28589 : int im, in;
28590 : float gu;
28591 : int iw;
28592 : float wl, wu;
28593 : int nwl;
28594 : float ulp, wlu, wul;
28595 : int nwu;
28596 : float tmp1, tmp2;
28597 : int iend, ioff, iout, itmp1, jdisc;
28598 : int iinfo;
28599 : float atoli;
28600 : int iwoff;
28601 : float bnorm;
28602 : int itmax;
28603 : float wkill, rtoli, tnorm;
28604 : int ibegin;
28605 : int irange, idiscl;
28606 : int idumma[1];
28607 : int idiscu, iorder;
28608 : int ncnvrg;
28609 : float pivmin;
28610 : int toofew;
28611 : const float safemn = PLUMED_GMX_FLOAT_MIN*(1.0+PLUMED_GMX_FLOAT_EPS);
28612 :
28613 0 : --iwork;
28614 0 : --work;
28615 0 : --isplit;
28616 0 : --iblock;
28617 0 : --w;
28618 0 : --e;
28619 0 : --d__;
28620 :
28621 0 : *info = 0;
28622 :
28623 0 : if (*range=='A' || *range=='a') {
28624 : irange = 1;
28625 0 : } else if (*range=='V' || *range=='v') {
28626 : irange = 2;
28627 : } else if (*range=='I' || *range=='i') {
28628 : irange = 3;
28629 : } else {
28630 : irange = 0;
28631 : }
28632 :
28633 0 : if (*order=='B' || *order=='b') {
28634 : iorder = 2;
28635 0 : } else if (*order=='E' || *order=='e') {
28636 : iorder = 1;
28637 : } else {
28638 : iorder = 0;
28639 : }
28640 :
28641 0 : if (irange <= 0) {
28642 0 : *info = -1;
28643 0 : } else if (iorder <= 0) {
28644 0 : *info = -2;
28645 0 : } else if (*n < 0) {
28646 0 : *info = -3;
28647 0 : } else if (irange == 2) {
28648 0 : if (*vl >= *vu) {
28649 0 : *info = -5;
28650 : }
28651 0 : } else if (irange == 3 && (*il < 1 || *il > (*n))) {
28652 0 : *info = -6;
28653 0 : } else if (irange == 3 && (*iu < ((*n<*il) ? *n : *il) || *iu > *n)) {
28654 0 : *info = -7;
28655 : }
28656 :
28657 0 : if (*info != 0) {
28658 : return;
28659 : }
28660 :
28661 0 : *info = 0;
28662 : ncnvrg = 0;
28663 : toofew = 0;
28664 :
28665 0 : *m = 0;
28666 0 : if (*n == 0) {
28667 : return;
28668 : }
28669 :
28670 0 : if (irange == 3 && *il == 1 && *iu == *n) {
28671 : irange = 1;
28672 : }
28673 :
28674 : ulp = 2*PLUMED_GMX_FLOAT_EPS;
28675 0 : rtoli = ulp * 2.;
28676 : nb = DSTEBZ_BLOCKSIZE;
28677 : // cppcheck-suppress knownConditionTrueFalse
28678 : if (nb <= 1) {
28679 0 : nb = 0;
28680 : }
28681 :
28682 0 : if (*n == 1) {
28683 0 : *nsplit = 1;
28684 0 : isplit[1] = 1;
28685 0 : if (irange == 2 && (*vl >= d__[1] || *vu < d__[1])) {
28686 0 : *m = 0;
28687 : } else {
28688 0 : w[1] = d__[1];
28689 0 : iblock[1] = 1;
28690 0 : *m = 1;
28691 : }
28692 0 : return;
28693 : }
28694 :
28695 0 : *nsplit = 1;
28696 0 : work[*n] = 0.;
28697 0 : pivmin = 1.;
28698 0 : i__1 = *n;
28699 0 : for (j = 2; j <= i__1; ++j) {
28700 0 : d__1 = e[j - 1];
28701 0 : tmp1 = d__1 * d__1;
28702 : d__2 = ulp;
28703 0 : if (std::abs(d__[j] * d__[j - 1]) * (d__2 * d__2) + safemn
28704 : > tmp1) {
28705 0 : isplit[*nsplit] = j - 1;
28706 0 : ++(*nsplit);
28707 0 : work[j - 1] = 0.;
28708 : } else {
28709 0 : work[j - 1] = tmp1;
28710 0 : pivmin = (pivmin>tmp1) ? pivmin : tmp1;
28711 : }
28712 : }
28713 0 : isplit[*nsplit] = *n;
28714 0 : pivmin *= safemn;
28715 :
28716 0 : if (irange == 3) {
28717 :
28718 0 : gu = d__[1];
28719 : gl = d__[1];
28720 : tmp1 = 0.;
28721 :
28722 : i__1 = *n - 1;
28723 0 : for (j = 1; j <= i__1; ++j) {
28724 0 : tmp2 = std::sqrt(work[j]);
28725 0 : d__1 = gu, d__2 = d__[j] + tmp1 + tmp2;
28726 0 : gu = (d__1>d__2) ? d__1 : d__2;
28727 0 : d__1 = gl, d__2 = d__[j] - tmp1 - tmp2;
28728 0 : gl = (d__1<d__2) ? d__1 : d__2;
28729 : tmp1 = tmp2;
28730 : }
28731 :
28732 0 : d__1 = gu, d__2 = d__[*n] + tmp1;
28733 0 : gu = (d__1>d__2) ? d__1 : d__2;
28734 0 : d__1 = gl, d__2 = d__[*n] - tmp1;
28735 0 : gl = (d__1<d__2) ? d__1 : d__2;
28736 : d__1 = std::abs(gl);
28737 : d__2 = std::abs(gu);
28738 0 : tnorm = (d__1>d__2) ? d__1 : d__2;
28739 0 : gl = gl - tnorm * 2. * ulp * *n - pivmin * 4.;
28740 0 : gu = gu + tnorm * 2. * ulp * *n + pivmin * 2.;
28741 :
28742 0 : itmax = (int) ((std::log(tnorm + pivmin) - std::log(pivmin)) / std::log(2.)) + 2;
28743 0 : if (*abstol <= 0.) {
28744 0 : atoli = ulp * tnorm;
28745 : } else {
28746 0 : atoli = *abstol;
28747 : }
28748 :
28749 0 : work[*n + 1] = gl;
28750 0 : work[*n + 2] = gl;
28751 0 : work[*n + 3] = gu;
28752 0 : work[*n + 4] = gu;
28753 0 : work[*n + 5] = gl;
28754 0 : work[*n + 6] = gu;
28755 0 : iwork[1] = -1;
28756 0 : iwork[2] = -1;
28757 0 : iwork[3] = *n + 1;
28758 0 : iwork[4] = *n + 1;
28759 0 : iwork[5] = *il - 1;
28760 0 : iwork[6] = *iu;
28761 :
28762 0 : PLUMED_BLAS_F77_FUNC(slaebz,SLAEBZ)(&c__3, &itmax, n, &c__2, &c__2, &nb, &atoli, &rtoli, &pivmin,
28763 0 : &d__[1], &e[1], &work[1], &iwork[5], &work[*n + 1], &work[*n
28764 0 : + 5], &iout, &iwork[1], &w[1], &iblock[1], &iinfo);
28765 :
28766 0 : if (iwork[6] == *iu) {
28767 0 : wl = work[*n + 1];
28768 0 : wlu = work[*n + 3];
28769 0 : nwl = iwork[1];
28770 0 : wu = work[*n + 4];
28771 0 : wul = work[*n + 2];
28772 0 : nwu = iwork[4];
28773 : } else {
28774 0 : wl = work[*n + 2];
28775 0 : wlu = work[*n + 4];
28776 0 : nwl = iwork[2];
28777 0 : wu = work[*n + 3];
28778 0 : wul = work[*n + 1];
28779 0 : nwu = iwork[3];
28780 : }
28781 :
28782 0 : if (nwl < 0 || nwl >= *n || nwu < 1 || nwu > *n) {
28783 0 : *info = 4;
28784 0 : return;
28785 : }
28786 : } else {
28787 :
28788 :
28789 : /* avoid warnings for high gcc optimization */
28790 : wlu = wul = 1.0;
28791 :
28792 0 : d__3 = std::abs(d__[1]) + std::abs(e[1]);
28793 0 : d__4 = std::abs(d__[*n]) + std::abs(e[*n - 1]);
28794 0 : tnorm = (d__3>d__4) ? d__3 : d__4;
28795 :
28796 : i__1 = *n - 1;
28797 0 : for (j = 2; j <= i__1; ++j) {
28798 : d__4 = tnorm;
28799 0 : d__5 = std::abs(d__[j]) + std::abs(e[j - 1]) + std::abs(e[j]);
28800 0 : tnorm = (d__4>d__5) ? d__4 : d__5;
28801 : }
28802 :
28803 0 : if (*abstol <= 0.) {
28804 0 : atoli = ulp * tnorm;
28805 : } else {
28806 0 : atoli = *abstol;
28807 : }
28808 :
28809 0 : if (irange == 2) {
28810 0 : wl = *vl;
28811 0 : wu = *vu;
28812 : } else {
28813 : wl = 0.;
28814 : wu = 0.;
28815 : }
28816 : }
28817 :
28818 0 : *m = 0;
28819 : iend = 0;
28820 0 : *info = 0;
28821 : nwl = 0;
28822 : nwu = 0;
28823 :
28824 0 : i__1 = *nsplit;
28825 0 : for (jb = 1; jb <= i__1; ++jb) {
28826 : ioff = iend;
28827 0 : ibegin = ioff + 1;
28828 0 : iend = isplit[jb];
28829 0 : in = iend - ioff;
28830 :
28831 0 : if (in == 1) {
28832 :
28833 0 : if (irange == 1 || wl >= d__[ibegin] - pivmin) {
28834 0 : ++nwl;
28835 : }
28836 0 : if (irange == 1 || wu >= d__[ibegin] - pivmin) {
28837 0 : ++nwu;
28838 : }
28839 0 : if (irange == 1 || ((wl < d__[ibegin] - pivmin) && (wu >= d__[ibegin] - pivmin))) {
28840 0 : ++(*m);
28841 0 : w[*m] = d__[ibegin];
28842 0 : iblock[*m] = jb;
28843 : }
28844 : } else {
28845 :
28846 0 : gu = d__[ibegin];
28847 : gl = d__[ibegin];
28848 : tmp1 = 0.;
28849 :
28850 : i__2 = iend - 1;
28851 0 : for (j = ibegin; j <= i__2; ++j) {
28852 0 : tmp2 = std::abs(e[j]);
28853 0 : d__1 = gu, d__2 = d__[j] + tmp1 + tmp2;
28854 0 : gu = (d__1>d__2) ? d__1 : d__2;
28855 0 : d__1 = gl, d__2 = d__[j] - tmp1 - tmp2;
28856 0 : gl = (d__1<d__2) ? d__1 : d__2;
28857 : tmp1 = tmp2;
28858 : }
28859 :
28860 0 : d__1 = gu, d__2 = d__[iend] + tmp1;
28861 0 : gu = (d__1>d__2) ? d__1 : d__2;
28862 0 : d__1 = gl, d__2 = d__[iend] - tmp1;
28863 0 : gl = (d__1<d__2) ? d__1 : d__2;
28864 : d__1 = std::abs(gl);
28865 : d__2 = std::abs(gu);
28866 0 : bnorm = (d__1>d__2) ? d__1 : d__2;
28867 0 : gl = gl - bnorm * 2. * ulp * in - pivmin * 2.;
28868 0 : gu = gu + bnorm * 2. * ulp * in + pivmin * 2.;
28869 :
28870 0 : if (*abstol <= 0.) {
28871 : d__1 = std::abs(gl);
28872 : d__2 = std::abs(gu);
28873 0 : atoli = ulp * ((d__1>d__2) ? d__1 : d__2);
28874 : } else {
28875 0 : atoli = *abstol;
28876 : }
28877 :
28878 0 : if (irange > 1) {
28879 0 : if (gu < wl) {
28880 0 : nwl += in;
28881 0 : nwu += in;
28882 : }
28883 : gl = (gl>wl) ? gl : wl;
28884 : gu = (gu<wu) ? gu : wu;
28885 : if (gl >= gu) {
28886 : }
28887 0 : continue;
28888 : }
28889 :
28890 0 : work[*n + 1] = gl;
28891 0 : work[*n + in + 1] = gu;
28892 0 : PLUMED_BLAS_F77_FUNC(slaebz,SLAEBZ)(&c__1, &c__0, &in, &in, &c__1, &nb, &atoli, &rtoli, &
28893 : pivmin, &d__[ibegin], &e[ibegin], &work[ibegin], idumma, &
28894 0 : work[*n + 1], &work[*n + (in << 1) + 1], &im, &iwork[1], &
28895 0 : w[*m + 1], &iblock[*m + 1], &iinfo);
28896 :
28897 0 : nwl += iwork[1];
28898 0 : nwu += iwork[in + 1];
28899 0 : iwoff = *m - iwork[1];
28900 :
28901 0 : itmax = (int) ((log(gu - gl + pivmin) - log(pivmin)) / log(2.)
28902 0 : ) + 2;
28903 0 : PLUMED_BLAS_F77_FUNC(slaebz,SLAEBZ)(&c__2, &itmax, &in, &in, &c__1, &nb, &atoli, &rtoli, &
28904 : pivmin, &d__[ibegin], &e[ibegin], &work[ibegin], idumma, &
28905 0 : work[*n + 1], &work[*n + (in << 1) + 1], &iout, &iwork[1],
28906 0 : &w[*m + 1], &iblock[*m + 1], &iinfo);
28907 :
28908 0 : i__2 = iout;
28909 0 : for (j = 1; j <= i__2; ++j) {
28910 0 : tmp1 = (work[j + *n] + work[j + in + *n]) * .5;
28911 :
28912 0 : if (j > iout - iinfo) {
28913 : ncnvrg = 1;
28914 0 : ib = -jb;
28915 : } else {
28916 : ib = jb;
28917 : }
28918 0 : i__3 = iwork[j + in] + iwoff;
28919 0 : for (je = iwork[j] + 1 + iwoff; je <= i__3; ++je) {
28920 0 : w[je] = tmp1;
28921 0 : iblock[je] = ib;
28922 : }
28923 : }
28924 :
28925 0 : *m += im;
28926 : }
28927 : }
28928 :
28929 0 : if (irange == 3) {
28930 0 : im = 0;
28931 0 : idiscl = *il - 1 - nwl;
28932 0 : idiscu = nwu - *iu;
28933 :
28934 0 : if (idiscl > 0 || idiscu > 0) {
28935 0 : i__1 = *m;
28936 0 : for (je = 1; je <= i__1; ++je) {
28937 0 : if (w[je] <= wlu && idiscl > 0) {
28938 0 : --idiscl;
28939 0 : } else if (w[je] >= wul && idiscu > 0) {
28940 0 : --idiscu;
28941 : } else {
28942 0 : ++im;
28943 0 : w[im] = w[je];
28944 0 : iblock[im] = iblock[je];
28945 : }
28946 : }
28947 0 : *m = im;
28948 : }
28949 0 : if (idiscl > 0 || idiscu > 0) {
28950 :
28951 0 : if (idiscl > 0) {
28952 : wkill = wu;
28953 : i__1 = idiscl;
28954 0 : for (jdisc = 1; jdisc <= i__1; ++jdisc) {
28955 : iw = 0;
28956 0 : i__2 = *m;
28957 0 : for (je = 1; je <= i__2; ++je) {
28958 0 : if (iblock[je] != 0 && (w[je] < wkill || iw == 0)) {
28959 : iw = je;
28960 : wkill = w[je];
28961 : }
28962 : }
28963 0 : iblock[iw] = 0;
28964 : }
28965 : }
28966 0 : if (idiscu > 0) {
28967 :
28968 : wkill = wl;
28969 : i__1 = idiscu;
28970 0 : for (jdisc = 1; jdisc <= i__1; ++jdisc) {
28971 : iw = 0;
28972 0 : i__2 = *m;
28973 0 : for (je = 1; je <= i__2; ++je) {
28974 0 : if (iblock[je] != 0 && (w[je] > wkill || iw == 0)) {
28975 : iw = je;
28976 : wkill = w[je];
28977 : }
28978 : }
28979 0 : iblock[iw] = 0;
28980 : }
28981 : }
28982 0 : im = 0;
28983 0 : i__1 = *m;
28984 0 : for (je = 1; je <= i__1; ++je) {
28985 0 : if (iblock[je] != 0) {
28986 0 : ++im;
28987 0 : w[im] = w[je];
28988 0 : iblock[im] = iblock[je];
28989 : }
28990 : }
28991 0 : *m = im;
28992 : }
28993 0 : if (idiscl < 0 || idiscu < 0) {
28994 : toofew = 1;
28995 : }
28996 : }
28997 :
28998 0 : if (iorder == 1 && *nsplit > 1) {
28999 0 : i__1 = *m - 1;
29000 0 : for (je = 1; je <= i__1; ++je) {
29001 : ie = 0;
29002 0 : tmp1 = w[je];
29003 0 : i__2 = *m;
29004 0 : for (j = je + 1; j <= i__2; ++j) {
29005 0 : if (w[j] < tmp1) {
29006 : ie = j;
29007 : tmp1 = w[j];
29008 : }
29009 : }
29010 :
29011 0 : if (ie != 0) {
29012 0 : itmp1 = iblock[ie];
29013 0 : w[ie] = w[je];
29014 0 : iblock[ie] = iblock[je];
29015 0 : w[je] = tmp1;
29016 0 : iblock[je] = itmp1;
29017 : }
29018 : }
29019 : }
29020 :
29021 0 : *info = 0;
29022 0 : if (ncnvrg) {
29023 0 : ++(*info);
29024 : }
29025 0 : if (toofew) {
29026 0 : *info += 2;
29027 : }
29028 : return;
29029 :
29030 : }
29031 :
29032 :
29033 : }
29034 : }
29035 : #include <cmath>
29036 : #include "blas/blas.h"
29037 : #include "lapack.h"
29038 : #include "lapack_limits.h"
29039 :
29040 : #include "real.h"
29041 :
29042 : #include "blas/blas.h"
29043 : namespace PLMD{
29044 : namespace lapack{
29045 : using namespace blas;
29046 : void
29047 0 : PLUMED_BLAS_F77_FUNC(sstegr,SSTEGR)(const char *jobz,
29048 : const char *range,
29049 : int *n,
29050 : float *d__,
29051 : float *e,
29052 : float *vl,
29053 : float *vu,
29054 : int *il,
29055 : int *iu,
29056 : float *abstol,
29057 : int *m,
29058 : float *w,
29059 : float *z__,
29060 : int *ldz,
29061 : int *isuppz,
29062 : float *work,
29063 : int *lwork,
29064 : int *iwork,
29065 : int *liwork,
29066 : int *info)
29067 : {
29068 : int z_dim1, z_offset, i__1, i__2;
29069 : float d__1, d__2;
29070 0 : int c__1 = 1;
29071 :
29072 : int i__, j;
29073 : int jj;
29074 : float eps, tol, tmp, rmin, rmax;
29075 : int itmp;
29076 : float tnrm;
29077 : float scale;
29078 : int iinfo, iindw;
29079 : int lwmin;
29080 : int wantz;
29081 : int iindbl;
29082 : int valeig,alleig,indeig;
29083 : float safmin,minval;
29084 : float bignum;
29085 : int iindwk, indgrs;
29086 : float thresh;
29087 : int iinspl, indwrk, liwmin, nsplit;
29088 : float smlnum;
29089 : int lquery;
29090 :
29091 :
29092 : --d__;
29093 : --e;
29094 0 : --w;
29095 0 : z_dim1 = *ldz;
29096 0 : z_offset = 1 + z_dim1;
29097 0 : z__ -= z_offset;
29098 0 : --isuppz;
29099 0 : --work;
29100 0 : --iwork;
29101 :
29102 0 : wantz = (*jobz=='V' || *jobz=='v');
29103 0 : alleig = (*range=='A' || *range=='a');
29104 0 : valeig = (*range=='V' || *range=='v');
29105 0 : indeig = (*range=='I' || *range=='i');
29106 :
29107 0 : lquery = *lwork == -1 || *liwork == -1;
29108 0 : lwmin = *n * 17;
29109 0 : liwmin = *n * 10;
29110 :
29111 0 : *info = 0;
29112 0 : if (! (wantz || (*jobz=='N' || *jobz=='n'))) {
29113 0 : *info = -1;
29114 0 : } else if (! (alleig || valeig || indeig)) {
29115 0 : *info = -2;
29116 0 : } else if (*n < 0) {
29117 0 : *info = -3;
29118 0 : } else if (valeig && *n > 0 && *vu <= *vl) {
29119 0 : *info = -7;
29120 0 : } else if (indeig && (*il < 1 || *il > *n)) {
29121 0 : *info = -8;
29122 0 : } else if (indeig && (*iu < *il || *iu > *n)) {
29123 0 : *info = -9;
29124 0 : } else if (*ldz < 1 || (wantz && *ldz < *n)) {
29125 0 : *info = -14;
29126 0 : } else if (*lwork < lwmin && ! lquery) {
29127 0 : *info = -17;
29128 0 : } else if (*liwork < liwmin && ! lquery) {
29129 0 : *info = -19;
29130 : }
29131 0 : if (*info == 0) {
29132 0 : work[1] = (float) lwmin;
29133 0 : iwork[1] = liwmin;
29134 : }
29135 :
29136 0 : if (*info != 0) {
29137 : i__1 = -(*info);
29138 : return;
29139 0 : } else if (lquery) {
29140 : return;
29141 : }
29142 :
29143 0 : *m = 0;
29144 0 : if (*n == 0) {
29145 : return;
29146 : }
29147 :
29148 0 : if (*n == 1) {
29149 0 : if (alleig || indeig) {
29150 0 : *m = 1;
29151 0 : w[1] = d__[1];
29152 : } else {
29153 0 : if (*vl < d__[1] && *vu >= d__[1]) {
29154 0 : *m = 1;
29155 0 : w[1] = d__[1];
29156 : }
29157 : }
29158 0 : if (wantz) {
29159 0 : z__[z_dim1 + 1] = 1.;
29160 : }
29161 0 : return;
29162 : }
29163 :
29164 : minval = PLUMED_GMX_FLOAT_MIN;
29165 : safmin = minval*(1.0+PLUMED_GMX_FLOAT_EPS);
29166 : eps = PLUMED_GMX_FLOAT_EPS;
29167 : smlnum = safmin / eps;
29168 : bignum = 1. / smlnum;
29169 : rmin = std::sqrt(smlnum);
29170 0 : d__1 = std::sqrt(bignum), d__2 = 1. / std::sqrt(sqrt(safmin));
29171 : rmax = (d__1<d__2) ? d__1 : d__2;
29172 0 : scale = 1.;
29173 0 : tnrm = PLUMED_BLAS_F77_FUNC(slanst,SLANST)("M", n, &d__[1], &e[1]);
29174 0 : if (tnrm > 0. && tnrm < rmin) {
29175 0 : scale = rmin / tnrm;
29176 0 : } else if (tnrm > rmax) {
29177 0 : scale = rmax / tnrm;
29178 : }
29179 0 : if ( std::abs(scale-1.0)>PLUMED_GMX_FLOAT_EPS) {
29180 0 : PLUMED_BLAS_F77_FUNC(sscal,SSCAL)(n, &scale, &d__[1], &c__1);
29181 0 : i__1 = *n - 1;
29182 0 : PLUMED_BLAS_F77_FUNC(sscal,SSCAL)(&i__1, &scale, &e[1], &c__1);
29183 0 : tnrm *= scale;
29184 : }
29185 : indgrs = 1;
29186 0 : indwrk = (*n << 1) + 1;
29187 :
29188 : iinspl = 1;
29189 0 : iindbl = *n + 1;
29190 : iindw = (*n << 1) + 1;
29191 0 : iindwk = *n * 3 + 1;
29192 :
29193 0 : thresh = eps * tnrm;
29194 0 : PLUMED_BLAS_F77_FUNC(slarrex,SLARREX)(range, n, vl, vu, il, iu, &d__[1], &e[1], &thresh, &nsplit, &
29195 0 : iwork[iinspl], m, &w[1], &iwork[iindbl], &iwork[iindw], &work[
29196 0 : indgrs], &work[indwrk], &iwork[iindwk], &iinfo);
29197 :
29198 0 : if (iinfo != 0) {
29199 0 : *info = 1;
29200 0 : return;
29201 : }
29202 :
29203 0 : if (wantz) {
29204 0 : d__1 = *abstol, d__2 = (float) (*n) * eps;
29205 0 : tol = (d__1>d__2) ? d__1 : d__2;
29206 0 : PLUMED_BLAS_F77_FUNC(slarrvx,SLARRVX)(n, &d__[1], &e[1], &iwork[iinspl], m, &w[1], &iwork[iindbl], &
29207 : iwork[iindw], &work[indgrs], &tol, &z__[z_offset], ldz, &
29208 : isuppz[1], &work[indwrk], &iwork[iindwk], &iinfo);
29209 0 : if (iinfo != 0) {
29210 0 : *info = 2;
29211 0 : return;
29212 : }
29213 : }
29214 :
29215 0 : i__1 = *m;
29216 0 : for (j = 1; j <= i__1; ++j) {
29217 0 : itmp = iwork[iindbl + j - 1];
29218 0 : w[j] += e[iwork[iinspl + itmp - 1]];
29219 : }
29220 :
29221 0 : if (std::abs(scale-1.0)>PLUMED_GMX_FLOAT_EPS) {
29222 0 : d__1 = 1. / scale;
29223 0 : PLUMED_BLAS_F77_FUNC(sscal,SSCAL)(m, &d__1, &w[1], &c__1);
29224 : }
29225 0 : if (nsplit > 1) {
29226 0 : i__1 = *m - 1;
29227 0 : for (j = 1; j <= i__1; ++j) {
29228 : i__ = 0;
29229 0 : tmp = w[j];
29230 0 : i__2 = *m;
29231 0 : for (jj = j + 1; jj <= i__2; ++jj) {
29232 0 : if (w[jj] < tmp) {
29233 : i__ = jj;
29234 : tmp = w[jj];
29235 : }
29236 : }
29237 0 : if (i__ != 0) {
29238 0 : w[i__] = w[j];
29239 0 : w[j] = tmp;
29240 0 : if (wantz) {
29241 0 : PLUMED_BLAS_F77_FUNC(sswap,SSWAP)(n, &z__[i__ * z_dim1 + 1], &c__1, &z__[j * z_dim1
29242 0 : + 1], &c__1);
29243 0 : itmp = isuppz[(i__ << 1) - 1];
29244 0 : isuppz[(i__ << 1) - 1] = isuppz[(j << 1) - 1];
29245 0 : isuppz[(j << 1) - 1] = itmp;
29246 0 : itmp = isuppz[i__ * 2];
29247 0 : isuppz[i__ * 2] = isuppz[j * 2];
29248 0 : isuppz[j * 2] = itmp;
29249 : }
29250 : }
29251 : }
29252 : }
29253 :
29254 0 : work[1] = (float) lwmin;
29255 0 : iwork[1] = liwmin;
29256 0 : return;
29257 :
29258 : }
29259 : }
29260 : }
29261 : #include <cmath>
29262 : #include "blas/blas.h"
29263 : #include "lapack.h"
29264 : #include "lapack_limits.h"
29265 :
29266 : #include "real.h"
29267 :
29268 : #include "blas/blas.h"
29269 : namespace PLMD{
29270 : namespace lapack{
29271 : using namespace blas;
29272 : void
29273 0 : PLUMED_BLAS_F77_FUNC(sstein,SSTEIN)(int *n,
29274 : float *d__,
29275 : float *e,
29276 : int *m,
29277 : float *w,
29278 : int *iblock,
29279 : int *isplit,
29280 : float *z__,
29281 : int *ldz,
29282 : float *work,
29283 : int *iwork,
29284 : int *ifail,
29285 : int *info)
29286 : {
29287 : int z_dim1, z_offset, i__1, i__2, i__3;
29288 : float d__2, d__3, d__4, d__5;
29289 :
29290 : int i__, j, b1, j1, bn;
29291 : float xj, scl, eps, sep, nrm, tol;
29292 : int its;
29293 : float xjm, ztr, eps1;
29294 : int jblk, nblk;
29295 : int jmax;
29296 :
29297 : int iseed[4], gpind, iinfo;
29298 : float ortol;
29299 : int indrv1, indrv2, indrv3, indrv4, indrv5;
29300 : int nrmchk;
29301 : int blksiz;
29302 : float onenrm, dtpcrt, pertol;
29303 0 : int c__2 = 2;
29304 0 : int c__1 = 1;
29305 0 : int c_n1 = -1;
29306 :
29307 0 : --d__;
29308 0 : --e;
29309 0 : --w;
29310 0 : --iblock;
29311 0 : --isplit;
29312 0 : z_dim1 = *ldz;
29313 0 : z_offset = 1 + z_dim1;
29314 0 : z__ -= z_offset;
29315 0 : --work;
29316 : --iwork;
29317 0 : --ifail;
29318 :
29319 0 : *info = 0;
29320 :
29321 : xjm = 0.0;
29322 0 : i__1 = *m;
29323 0 : for (i__ = 1; i__ <= i__1; ++i__) {
29324 0 : ifail[i__] = 0;
29325 : }
29326 :
29327 0 : if (*n < 0) {
29328 0 : *info = -1;
29329 0 : } else if (*m < 0 || *m > *n) {
29330 0 : *info = -4;
29331 0 : } else if (*ldz < (*n)) {
29332 0 : *info = -9;
29333 : } else {
29334 : i__1 = *m;
29335 0 : for (j = 2; j <= i__1; ++j) {
29336 0 : if (iblock[j] < iblock[j - 1]) {
29337 0 : *info = -6;
29338 0 : break;
29339 : }
29340 0 : if (iblock[j] == iblock[j - 1] && w[j] < w[j - 1]) {
29341 0 : *info = -5;
29342 0 : break;
29343 : }
29344 : }
29345 : }
29346 :
29347 0 : if (*info != 0) {
29348 : return;
29349 : }
29350 :
29351 0 : if (*n == 0 || *m == 0) {
29352 : return;
29353 0 : } else if (*n == 1) {
29354 0 : z__[z_dim1 + 1] = 1.;
29355 0 : return;
29356 : }
29357 :
29358 : eps = PLUMED_GMX_FLOAT_EPS;
29359 :
29360 0 : for (i__ = 1; i__ <= 4; ++i__) {
29361 0 : iseed[i__ - 1] = 1;
29362 : }
29363 :
29364 : indrv1 = 0;
29365 : indrv2 = indrv1 + *n;
29366 0 : indrv3 = indrv2 + *n;
29367 0 : indrv4 = indrv3 + *n;
29368 0 : indrv5 = indrv4 + *n;
29369 :
29370 : j1 = 1;
29371 0 : i__1 = iblock[*m];
29372 0 : for (nblk = 1; nblk <= i__1; ++nblk) {
29373 :
29374 0 : if (nblk == 1) {
29375 : b1 = 1;
29376 : } else {
29377 0 : b1 = isplit[nblk - 1] + 1;
29378 : }
29379 0 : bn = isplit[nblk];
29380 0 : blksiz = bn - b1 + 1;
29381 0 : if (blksiz == 1) {
29382 0 : continue;
29383 : }
29384 : gpind = b1;
29385 :
29386 0 : onenrm = std::abs(d__[b1]) + std::abs(e[b1]);
29387 : d__3 = onenrm;
29388 0 : d__4 = std::abs(d__[bn]) + std::abs(e[bn - 1]);
29389 0 : onenrm = (d__3>d__4) ? d__3 : d__4;
29390 : i__2 = bn - 1;
29391 0 : for (i__ = b1 + 1; i__ <= i__2; ++i__) {
29392 : d__4 = onenrm;
29393 0 : d__5 = std::abs(d__[i__]) + std::abs(e[i__ - 1]) + std::abs(e[i__]);
29394 0 : onenrm = (d__4>d__5) ? d__4 : d__5;
29395 : }
29396 0 : ortol = onenrm * .001;
29397 :
29398 0 : dtpcrt = std::sqrt(.1 / blksiz);
29399 :
29400 : jblk = 0;
29401 0 : i__2 = *m;
29402 0 : for (j = j1; j <= i__2; ++j) {
29403 0 : if (iblock[j] != nblk) {
29404 : j1 = j;
29405 : break;
29406 : }
29407 0 : ++jblk;
29408 0 : xj = w[j];
29409 :
29410 0 : if (blksiz == 1) {
29411 0 : work[indrv1 + 1] = 1.;
29412 0 : goto L120;
29413 : }
29414 :
29415 0 : if (jblk > 1) {
29416 0 : eps1 = std::abs(eps * xj);
29417 0 : pertol = eps1 * 10.;
29418 0 : sep = xj - xjm;
29419 0 : if (sep < pertol) {
29420 0 : xj = xjm + pertol;
29421 : }
29422 : }
29423 :
29424 : its = 0;
29425 : nrmchk = 0;
29426 :
29427 0 : PLUMED_BLAS_F77_FUNC(slarnv,SLARNV)(&c__2, iseed, &blksiz, &work[indrv1 + 1]);
29428 :
29429 0 : PLUMED_BLAS_F77_FUNC(scopy,SCOPY)(&blksiz, &d__[b1], &c__1, &work[indrv4 + 1], &c__1);
29430 0 : i__3 = blksiz - 1;
29431 0 : PLUMED_BLAS_F77_FUNC(scopy,SCOPY)(&i__3, &e[b1], &c__1, &work[indrv2 + 2], &c__1);
29432 0 : i__3 = blksiz - 1;
29433 0 : PLUMED_BLAS_F77_FUNC(scopy,SCOPY)(&i__3, &e[b1], &c__1, &work[indrv3 + 1], &c__1);
29434 :
29435 0 : tol = 0.;
29436 0 : PLUMED_BLAS_F77_FUNC(slagtf,SLAGTF)(&blksiz, &work[indrv4 + 1], &xj, &work[indrv2 + 2], &work[
29437 0 : indrv3 + 1], &tol, &work[indrv5 + 1], &iwork[1], &iinfo);
29438 :
29439 0 : L70:
29440 0 : ++its;
29441 0 : if (its > 5) {
29442 0 : goto L100;
29443 : }
29444 :
29445 : d__2 = eps;
29446 0 : d__3 = std::abs(work[indrv4 + blksiz]);
29447 0 : scl = blksiz * onenrm * ((d__2>d__3) ? d__2 : d__3) / PLUMED_BLAS_F77_FUNC(sasum,SASUM)(&blksiz, &work[
29448 : indrv1 + 1], &c__1);
29449 0 : PLUMED_BLAS_F77_FUNC(sscal,SSCAL)(&blksiz, &scl, &work[indrv1 + 1], &c__1);
29450 :
29451 0 : PLUMED_BLAS_F77_FUNC(slagts,SLAGTS)(&c_n1, &blksiz, &work[indrv4 + 1], &work[indrv2 + 2], &
29452 : work[indrv3 + 1], &work[indrv5 + 1], &iwork[1], &work[
29453 : indrv1 + 1], &tol, &iinfo);
29454 :
29455 0 : if (jblk == 1) {
29456 0 : goto L90;
29457 : }
29458 0 : if (std::abs(xj - xjm) > ortol) {
29459 : gpind = j;
29460 : }
29461 0 : if (gpind != j) {
29462 0 : i__3 = j - 1;
29463 0 : for (i__ = gpind; i__ <= i__3; ++i__) {
29464 0 : ztr = -PLUMED_BLAS_F77_FUNC(sdot,SDOT)(&blksiz, &work[indrv1 + 1], &c__1, &z__[b1 +
29465 0 : i__ * z_dim1], &c__1);
29466 0 : PLUMED_BLAS_F77_FUNC(saxpy,SAXPY)(&blksiz, &ztr, &z__[b1 + i__ * z_dim1], &c__1, &
29467 : work[indrv1 + 1], &c__1);
29468 : }
29469 : }
29470 :
29471 0 : L90:
29472 0 : jmax = PLUMED_BLAS_F77_FUNC(isamax,ISAMAX)(&blksiz, &work[indrv1 + 1], &c__1);
29473 0 : nrm = std::abs(work[indrv1 + jmax]);
29474 :
29475 0 : if (nrm < dtpcrt) {
29476 0 : goto L70;
29477 : }
29478 0 : ++nrmchk;
29479 0 : if (nrmchk < 3) {
29480 0 : goto L70;
29481 : }
29482 :
29483 0 : goto L110;
29484 :
29485 : L100:
29486 0 : ++(*info);
29487 0 : ifail[*info] = j;
29488 :
29489 0 : L110:
29490 0 : scl = 1. / PLUMED_BLAS_F77_FUNC(snrm2,SNRM2)(&blksiz, &work[indrv1 + 1], &c__1);
29491 0 : jmax = PLUMED_BLAS_F77_FUNC(isamax,ISAMAX)(&blksiz, &work[indrv1 + 1], &c__1);
29492 0 : if (work[indrv1 + jmax] < 0.) {
29493 0 : scl = -scl;
29494 : }
29495 0 : PLUMED_BLAS_F77_FUNC(sscal,SSCAL)(&blksiz, &scl, &work[indrv1 + 1], &c__1);
29496 0 : L120:
29497 0 : i__3 = *n;
29498 0 : for (i__ = 1; i__ <= i__3; ++i__) {
29499 0 : z__[i__ + j * z_dim1] = 0.;
29500 : }
29501 0 : i__3 = blksiz;
29502 0 : for (i__ = 1; i__ <= i__3; ++i__) {
29503 0 : z__[b1 + i__ - 1 + j * z_dim1] = work[indrv1 + i__];
29504 : }
29505 :
29506 0 : xjm = xj;
29507 : }
29508 : }
29509 :
29510 : return;
29511 :
29512 : }
29513 :
29514 :
29515 : }
29516 : }
29517 : #include <cmath>
29518 : #include "real.h"
29519 :
29520 : #include "blas/blas.h"
29521 : #include "lapack.h"
29522 : #include "lapack_limits.h"
29523 :
29524 : #include "blas/blas.h"
29525 : namespace PLMD{
29526 : namespace lapack{
29527 : using namespace blas;
29528 : void
29529 0 : PLUMED_BLAS_F77_FUNC(ssteqr,SSTEQR)(const char * compz,
29530 : int * n,
29531 : float * d__,
29532 : float * e,
29533 : float * z__,
29534 : int * ldz,
29535 : float * work,
29536 : int * info)
29537 : {
29538 0 : float c_b9 = 0.;
29539 0 : float c_b10 = 1.;
29540 0 : int c__0 = 0;
29541 0 : int c__1 = 1;
29542 0 : int c__2 = 2;
29543 : int z_dim1, z_offset, i__1, i__2;
29544 : float d__1, d__2;
29545 :
29546 : float b, c__, f, g;
29547 : int i__, j, k, l, m;
29548 : float p, r__, s;
29549 : int l1, ii, mm, lm1, mm1, nm1;
29550 : float rt1, rt2, eps;
29551 : int lsv;
29552 : float tst, eps2;
29553 : int lend, jtot;
29554 : float anorm;
29555 : int lendm1, lendp1;
29556 : int iscale;
29557 : float safmin,minval;
29558 : float safmax;
29559 : int lendsv;
29560 : float ssfmin;
29561 : int nmaxit, icompz;
29562 : float ssfmax;
29563 :
29564 :
29565 0 : --d__;
29566 0 : --e;
29567 0 : z_dim1 = *ldz;
29568 0 : z_offset = 1 + z_dim1;
29569 0 : z__ -= z_offset;
29570 0 : --work;
29571 :
29572 0 : *info = 0;
29573 :
29574 0 : if (*compz=='N' || *compz=='n') {
29575 : icompz = 0;
29576 0 : } else if (*compz=='V' || *compz=='v') {
29577 : icompz = 1;
29578 : } else if (*compz=='I' || *compz=='i') {
29579 : icompz = 2;
29580 : } else {
29581 : icompz = -1;
29582 : }
29583 : if (icompz < 0) {
29584 0 : *info = -1;
29585 0 : } else if (*n < 0) {
29586 0 : *info = -2;
29587 0 : } else if (*ldz < 1 || (icompz > 0 && *ldz < ((*n>1) ? *n : 1))) {
29588 0 : *info = -6;
29589 : }
29590 0 : if (*info != 0) {
29591 : return;
29592 : }
29593 :
29594 :
29595 0 : if (*n == 0) {
29596 : return;
29597 : }
29598 :
29599 0 : if (*n == 1) {
29600 0 : if (icompz == 2) {
29601 0 : z__[z_dim1 + 1] = 1.;
29602 : }
29603 0 : return;
29604 : }
29605 :
29606 : eps = PLUMED_GMX_FLOAT_EPS;
29607 : d__1 = eps;
29608 : eps2 = d__1 * d__1;
29609 : minval = PLUMED_GMX_FLOAT_MIN;
29610 : safmin = minval*(1.0+PLUMED_GMX_FLOAT_EPS);
29611 :
29612 : safmax = 1. / safmin;
29613 0 : ssfmax = std::sqrt(safmax) / 3.;
29614 0 : ssfmin = std::sqrt(safmin) / eps2;
29615 :
29616 0 : if (icompz == 2) {
29617 0 : PLUMED_BLAS_F77_FUNC(slaset,SLASET)("Full", n, n, &c_b9, &c_b10, &z__[z_offset], ldz);
29618 : }
29619 :
29620 0 : nmaxit = *n * 30;
29621 : jtot = 0;
29622 :
29623 : l1 = 1;
29624 0 : nm1 = *n - 1;
29625 :
29626 0 : L10:
29627 0 : if (l1 > *n) {
29628 0 : goto L160;
29629 : }
29630 0 : if (l1 > 1) {
29631 0 : e[l1 - 1] = 0.;
29632 : }
29633 0 : if (l1 <= nm1) {
29634 0 : i__1 = nm1;
29635 0 : for (m = l1; m <= i__1; ++m) {
29636 0 : tst = std::abs(e[m]);
29637 0 : if (std::abs(tst)<PLUMED_GMX_FLOAT_MIN) {
29638 0 : goto L30;
29639 : }
29640 0 : if (tst <= std::sqrt(std::abs(d__[m])) * std::sqrt(std::abs(d__[m + 1])) * eps) {
29641 0 : e[m] = 0.;
29642 0 : goto L30;
29643 : }
29644 : }
29645 : }
29646 0 : m = *n;
29647 :
29648 0 : L30:
29649 : l = l1;
29650 : lsv = l;
29651 : lend = m;
29652 : lendsv = lend;
29653 0 : l1 = m + 1;
29654 0 : if (lend == l) {
29655 0 : goto L10;
29656 : }
29657 :
29658 0 : i__1 = lend - l + 1;
29659 0 : anorm = PLUMED_BLAS_F77_FUNC(slanst,SLANST)("I", &i__1, &d__[l], &e[l]);
29660 : iscale = 0;
29661 0 : if (std::abs(anorm)<PLUMED_GMX_FLOAT_MIN) {
29662 0 : goto L10;
29663 : }
29664 0 : if (anorm > ssfmax) {
29665 : iscale = 1;
29666 0 : i__1 = lend - l + 1;
29667 0 : PLUMED_BLAS_F77_FUNC(slascl,SLASCL)("G", &c__0, &c__0, &anorm, &ssfmax, &i__1, &c__1, &d__[l], n,
29668 : info);
29669 0 : i__1 = lend - l;
29670 0 : PLUMED_BLAS_F77_FUNC(slascl,SLASCL)("G", &c__0, &c__0, &anorm, &ssfmax, &i__1, &c__1, &e[l], n,
29671 : info);
29672 0 : } else if (anorm < ssfmin) {
29673 : iscale = 2;
29674 0 : i__1 = lend - l + 1;
29675 0 : PLUMED_BLAS_F77_FUNC(slascl,SLASCL)("G", &c__0, &c__0, &anorm, &ssfmin, &i__1, &c__1, &d__[l], n,
29676 : info);
29677 0 : i__1 = lend - l;
29678 0 : PLUMED_BLAS_F77_FUNC(slascl,SLASCL)("G", &c__0, &c__0, &anorm, &ssfmin, &i__1, &c__1, &e[l], n,
29679 : info);
29680 : }
29681 :
29682 0 : if (std::abs(d__[lend]) < std::abs(d__[l])) {
29683 : lend = lsv;
29684 : l = lendsv;
29685 : }
29686 :
29687 0 : if (lend > l) {
29688 :
29689 0 : L40:
29690 0 : if (l != lend) {
29691 0 : lendm1 = lend - 1;
29692 0 : i__1 = lendm1;
29693 0 : for (m = l; m <= i__1; ++m) {
29694 0 : d__2 = std::abs(e[m]);
29695 0 : tst = d__2 * d__2;
29696 0 : if (tst <= eps2 * std::abs(d__[m]) * std::abs(d__[m+ 1]) + safmin) {
29697 0 : goto L60;
29698 : }
29699 : }
29700 : }
29701 :
29702 : m = lend;
29703 :
29704 0 : L60:
29705 0 : if (m < lend) {
29706 0 : e[m] = 0.;
29707 : }
29708 0 : p = d__[l];
29709 0 : if (m == l) {
29710 0 : goto L80;
29711 : }
29712 :
29713 0 : if (m == l + 1) {
29714 0 : if (icompz > 0) {
29715 0 : PLUMED_BLAS_F77_FUNC(slaev2,SLAEV2)(&d__[l], &e[l], &d__[l + 1], &rt1, &rt2, &c__, &s);
29716 0 : work[l] = c__;
29717 0 : work[*n - 1 + l] = s;
29718 0 : PLUMED_BLAS_F77_FUNC(slasr,SLASR)("R", "V", "B", n, &c__2, &work[l], &work[*n - 1 + l], &
29719 0 : z__[l * z_dim1 + 1], ldz);
29720 : } else {
29721 0 : PLUMED_BLAS_F77_FUNC(slae2,SLAE2)(&d__[l], &e[l], &d__[l + 1], &rt1, &rt2);
29722 : }
29723 0 : d__[l] = rt1;
29724 0 : d__[l + 1] = rt2;
29725 0 : e[l] = 0.;
29726 0 : l += 2;
29727 0 : if (l <= lend) {
29728 0 : goto L40;
29729 : }
29730 0 : goto L140;
29731 : }
29732 :
29733 0 : if (jtot == nmaxit) {
29734 0 : goto L140;
29735 : }
29736 0 : ++jtot;
29737 :
29738 0 : g = (d__[l + 1] - p) / (e[l] * 2.);
29739 0 : r__ = PLUMED_BLAS_F77_FUNC(slapy2,SLAPY2)(&g, &c_b10);
29740 0 : g = d__[m] - p + e[l] / (g + ( (g>0) ? r__ : -r__ ) );
29741 :
29742 0 : s = 1.;
29743 0 : c__ = 1.;
29744 : p = 0.;
29745 :
29746 0 : mm1 = m - 1;
29747 0 : i__1 = l;
29748 0 : for (i__ = mm1; i__ >= i__1; --i__) {
29749 0 : f = s * e[i__];
29750 0 : b = c__ * e[i__];
29751 0 : PLUMED_BLAS_F77_FUNC(slartg,SLARTG)(&g, &f, &c__, &s, &r__);
29752 0 : if (i__ != m - 1) {
29753 0 : e[i__ + 1] = r__;
29754 : }
29755 0 : g = d__[i__ + 1] - p;
29756 0 : r__ = (d__[i__] - g) * s + c__ * 2. * b;
29757 0 : p = s * r__;
29758 0 : d__[i__ + 1] = g + p;
29759 0 : g = c__ * r__ - b;
29760 :
29761 0 : if (icompz > 0) {
29762 0 : work[i__] = c__;
29763 0 : work[*n - 1 + i__] = -s;
29764 : }
29765 : }
29766 :
29767 0 : if (icompz > 0) {
29768 0 : mm = m - l + 1;
29769 0 : PLUMED_BLAS_F77_FUNC(slasr,SLASR)("R", "V", "B", n, &mm, &work[l], &work[*n - 1 + l], &z__[l
29770 0 : * z_dim1 + 1], ldz);
29771 : }
29772 :
29773 0 : d__[l] -= p;
29774 0 : e[l] = g;
29775 0 : goto L40;
29776 :
29777 : L80:
29778 : d__[l] = p;
29779 :
29780 0 : ++l;
29781 0 : if (l <= lend) {
29782 0 : goto L40;
29783 : }
29784 0 : goto L140;
29785 :
29786 : } else {
29787 :
29788 0 : L90:
29789 0 : if (l != lend) {
29790 0 : lendp1 = lend + 1;
29791 0 : i__1 = lendp1;
29792 0 : for (m = l; m >= i__1; --m) {
29793 0 : d__2 = std::abs(e[m - 1]);
29794 0 : tst = d__2 * d__2;
29795 0 : if (tst <= eps2 * std::abs(d__[m]) * std::abs(d__[m- 1]) + safmin) {
29796 0 : goto L110;
29797 : }
29798 : }
29799 : }
29800 :
29801 : m = lend;
29802 :
29803 0 : L110:
29804 0 : if (m > lend) {
29805 0 : e[m - 1] = 0.;
29806 : }
29807 0 : p = d__[l];
29808 0 : if (m == l) {
29809 0 : goto L130;
29810 : }
29811 0 : if (m == l - 1) {
29812 0 : if (icompz > 0) {
29813 0 : PLUMED_BLAS_F77_FUNC(slaev2,SLAEV2)(&d__[l - 1], &e[l - 1], &d__[l], &rt1, &rt2, &c__, &s)
29814 : ;
29815 0 : work[m] = c__;
29816 0 : work[*n - 1 + m] = s;
29817 0 : PLUMED_BLAS_F77_FUNC(slasr,SLASR)("R", "V", "F", n, &c__2, &work[m], &work[*n - 1 + m], &
29818 0 : z__[(l - 1) * z_dim1 + 1], ldz);
29819 : } else {
29820 0 : PLUMED_BLAS_F77_FUNC(slae2,SLAE2)(&d__[l - 1], &e[l - 1], &d__[l], &rt1, &rt2);
29821 : }
29822 0 : d__[l - 1] = rt1;
29823 0 : d__[l] = rt2;
29824 0 : e[l - 1] = 0.;
29825 0 : l += -2;
29826 0 : if (l >= lend) {
29827 0 : goto L90;
29828 : }
29829 0 : goto L140;
29830 : }
29831 :
29832 0 : if (jtot == nmaxit) {
29833 0 : goto L140;
29834 : }
29835 0 : ++jtot;
29836 :
29837 0 : g = (d__[l - 1] - p) / (e[l - 1] * 2.);
29838 0 : r__ = PLUMED_BLAS_F77_FUNC(slapy2,SLAPY2)(&g, &c_b10);
29839 0 : g = d__[m] - p + e[l - 1] / (g + ( (g>0) ? r__ : -r__ ));
29840 :
29841 0 : s = 1.;
29842 0 : c__ = 1.;
29843 : p = 0.;
29844 :
29845 : lm1 = l - 1;
29846 0 : i__1 = lm1;
29847 0 : for (i__ = m; i__ <= i__1; ++i__) {
29848 0 : f = s * e[i__];
29849 0 : b = c__ * e[i__];
29850 0 : PLUMED_BLAS_F77_FUNC(slartg,SLARTG)(&g, &f, &c__, &s, &r__);
29851 0 : if (i__ != m) {
29852 0 : e[i__ - 1] = r__;
29853 : }
29854 0 : g = d__[i__] - p;
29855 0 : r__ = (d__[i__ + 1] - g) * s + c__ * 2. * b;
29856 0 : p = s * r__;
29857 0 : d__[i__] = g + p;
29858 0 : g = c__ * r__ - b;
29859 :
29860 0 : if (icompz > 0) {
29861 0 : work[i__] = c__;
29862 0 : work[*n - 1 + i__] = s;
29863 : }
29864 : }
29865 :
29866 0 : if (icompz > 0) {
29867 0 : mm = l - m + 1;
29868 0 : PLUMED_BLAS_F77_FUNC(slasr,SLASR)("R", "V", "F", n, &mm, &work[m], &work[*n - 1 + m], &z__[m
29869 0 : * z_dim1 + 1], ldz);
29870 : }
29871 :
29872 0 : d__[l] -= p;
29873 0 : e[lm1] = g;
29874 0 : goto L90;
29875 :
29876 : L130:
29877 : d__[l] = p;
29878 :
29879 0 : --l;
29880 0 : if (l >= lend) {
29881 0 : goto L90;
29882 : }
29883 0 : goto L140;
29884 :
29885 : }
29886 :
29887 0 : L140:
29888 0 : if (iscale == 1) {
29889 0 : i__1 = lendsv - lsv + 1;
29890 0 : PLUMED_BLAS_F77_FUNC(slascl,SLASCL)("G", &c__0, &c__0, &ssfmax, &anorm, &i__1, &c__1, &d__[lsv],
29891 : n, info);
29892 0 : i__1 = lendsv - lsv;
29893 0 : PLUMED_BLAS_F77_FUNC(slascl,SLASCL)("G", &c__0, &c__0, &ssfmax, &anorm, &i__1, &c__1, &e[lsv], n,
29894 : info);
29895 0 : } else if (iscale == 2) {
29896 0 : i__1 = lendsv - lsv + 1;
29897 0 : PLUMED_BLAS_F77_FUNC(slascl,SLASCL)("G", &c__0, &c__0, &ssfmin, &anorm, &i__1, &c__1, &d__[lsv],
29898 : n, info);
29899 0 : i__1 = lendsv - lsv;
29900 0 : PLUMED_BLAS_F77_FUNC(slascl,SLASCL)("G", &c__0, &c__0, &ssfmin, &anorm, &i__1, &c__1, &e[lsv], n,
29901 : info);
29902 : }
29903 :
29904 0 : if (jtot < nmaxit) {
29905 0 : goto L10;
29906 : }
29907 0 : i__1 = *n - 1;
29908 0 : for (i__ = 1; i__ <= i__1; ++i__) {
29909 0 : if (std::abs(e[i__])>PLUMED_GMX_FLOAT_MIN) {
29910 0 : ++(*info);
29911 : }
29912 : }
29913 0 : goto L190;
29914 :
29915 : L160:
29916 0 : if (icompz == 0) {
29917 :
29918 0 : PLUMED_BLAS_F77_FUNC(slasrt,SLASRT)("I", n, &d__[1], info);
29919 :
29920 : } else {
29921 :
29922 0 : i__1 = *n;
29923 0 : for (ii = 2; ii <= i__1; ++ii) {
29924 0 : i__ = ii - 1;
29925 : k = i__;
29926 0 : p = d__[i__];
29927 0 : i__2 = *n;
29928 0 : for (j = ii; j <= i__2; ++j) {
29929 0 : if (d__[j] < p) {
29930 : k = j;
29931 : p = d__[j];
29932 : }
29933 : }
29934 0 : if (k != i__) {
29935 0 : d__[k] = d__[i__];
29936 0 : d__[i__] = p;
29937 0 : PLUMED_BLAS_F77_FUNC(sswap,SSWAP)(n, &z__[i__ * z_dim1 + 1], &c__1, &z__[k * z_dim1 + 1],
29938 : &c__1);
29939 : }
29940 : }
29941 : }
29942 :
29943 0 : L190:
29944 : return;
29945 : }
29946 :
29947 :
29948 : }
29949 : }
29950 : #include <cmath>
29951 : #include "lapack.h"
29952 : #include "lapack_limits.h"
29953 :
29954 : #include "real.h"
29955 :
29956 : #include "blas/blas.h"
29957 : namespace PLMD{
29958 : namespace lapack{
29959 : using namespace blas;
29960 : void
29961 0 : PLUMED_BLAS_F77_FUNC(ssterf,SSTERF)(int *n,
29962 : float *d__,
29963 : float *e,
29964 : int *info)
29965 : {
29966 : int i__1;
29967 : float d__1;
29968 :
29969 : float c__;
29970 : int i__, l, m;
29971 : float p, r__, s;
29972 : int l1;
29973 : float bb, rt1, rt2, eps, rte;
29974 : int lsv;
29975 : float eps2, oldc;
29976 : int lend, jtot;
29977 : float gamma, alpha, sigma, anorm;
29978 : int iscale;
29979 : float oldgam;
29980 : float safmax;
29981 : int lendsv;
29982 : float ssfmin;
29983 : int nmaxit;
29984 : float ssfmax;
29985 0 : int c__0 = 0;
29986 0 : int c__1 = 1;
29987 0 : float c_b32 = 1.;
29988 : const float safmin = PLUMED_GMX_FLOAT_MIN*(1.0+PLUMED_GMX_FLOAT_EPS);
29989 :
29990 0 : --e;
29991 0 : --d__;
29992 :
29993 0 : *info = 0;
29994 :
29995 0 : if (*n < 0) {
29996 0 : *info = -1;
29997 : i__1 = -(*info);
29998 0 : return;
29999 : }
30000 0 : if (*n <= 1) {
30001 : return;
30002 : }
30003 :
30004 : eps = PLUMED_GMX_FLOAT_EPS;
30005 : d__1 = eps;
30006 : eps2 = d__1 * d__1;
30007 : safmax = 1. / safmin;
30008 0 : ssfmax = std::sqrt(safmax) / 3.;
30009 0 : ssfmin = std::sqrt(safmin) / eps2;
30010 :
30011 0 : nmaxit = *n * 30;
30012 0 : sigma = 0.;
30013 : jtot = 0;
30014 :
30015 : l1 = 1;
30016 :
30017 0 : L10:
30018 0 : if (l1 > *n) {
30019 0 : PLUMED_BLAS_F77_FUNC(slasrt,SLASRT)("I", n, &d__[1], info);
30020 0 : return;
30021 : }
30022 0 : if (l1 > 1) {
30023 0 : e[l1 - 1] = 0.;
30024 : }
30025 0 : i__1 = *n - 1;
30026 0 : for (m = l1; m <= i__1; ++m) {
30027 0 : if (std::abs(e[m]) <= std::sqrt(std::abs(d__[m])) *
30028 0 : std::sqrt(std::abs(d__[m + 1])) * eps) {
30029 0 : e[m] = 0.;
30030 0 : goto L30;
30031 : }
30032 : }
30033 0 : m = *n;
30034 :
30035 0 : L30:
30036 : l = l1;
30037 : lsv = l;
30038 : lend = m;
30039 : lendsv = lend;
30040 0 : l1 = m + 1;
30041 0 : if (lend == l) {
30042 0 : goto L10;
30043 : }
30044 :
30045 0 : i__1 = lend - l + 1;
30046 0 : anorm = PLUMED_BLAS_F77_FUNC(slanst,SLANST)("I", &i__1, &d__[l], &e[l]);
30047 : iscale = 0;
30048 0 : if (anorm > ssfmax) {
30049 : iscale = 1;
30050 0 : i__1 = lend - l + 1;
30051 0 : PLUMED_BLAS_F77_FUNC(slascl,SLASCL)("G", &c__0, &c__0, &anorm, &ssfmax, &i__1, &c__1, &d__[l], n,
30052 : info);
30053 0 : i__1 = lend - l;
30054 0 : PLUMED_BLAS_F77_FUNC(slascl,SLASCL)("G", &c__0, &c__0, &anorm, &ssfmax, &i__1, &c__1, &e[l], n,
30055 : info);
30056 0 : } else if (anorm < ssfmin) {
30057 : iscale = 2;
30058 0 : i__1 = lend - l + 1;
30059 0 : PLUMED_BLAS_F77_FUNC(slascl,SLASCL)("G", &c__0, &c__0, &anorm, &ssfmin, &i__1, &c__1, &d__[l], n,
30060 : info);
30061 0 : i__1 = lend - l;
30062 0 : PLUMED_BLAS_F77_FUNC(slascl,SLASCL)("G", &c__0, &c__0, &anorm, &ssfmin, &i__1, &c__1, &e[l], n,
30063 : info);
30064 : }
30065 :
30066 0 : i__1 = lend - 1;
30067 0 : for (i__ = l; i__ <= i__1; ++i__) {
30068 0 : d__1 = e[i__];
30069 0 : e[i__] = d__1 * d__1;
30070 : }
30071 :
30072 0 : if (std::abs(d__[lend]) < std::abs(d__[l])) {
30073 : lend = lsv;
30074 : l = lendsv;
30075 : }
30076 :
30077 0 : if (lend >= l) {
30078 :
30079 0 : L50:
30080 0 : if (l != lend) {
30081 0 : i__1 = lend - 1;
30082 0 : for (m = l; m <= i__1; ++m) {
30083 0 : if (std::abs(e[m]) <= eps2 * std::abs(d__[m] * d__[m + 1])) {
30084 0 : goto L70;
30085 : }
30086 : }
30087 : }
30088 : m = lend;
30089 :
30090 0 : L70:
30091 0 : if (m < lend) {
30092 0 : e[m] = 0.;
30093 : }
30094 0 : p = d__[l];
30095 0 : if (m == l) {
30096 0 : goto L90;
30097 : }
30098 0 : if (m == l + 1) {
30099 0 : rte = std::sqrt(e[l]);
30100 0 : PLUMED_BLAS_F77_FUNC(slae2,SLAE2)(&d__[l], &rte, &d__[l + 1], &rt1, &rt2);
30101 0 : d__[l] = rt1;
30102 0 : d__[l + 1] = rt2;
30103 0 : e[l] = 0.;
30104 0 : l += 2;
30105 0 : if (l <= lend) {
30106 0 : goto L50;
30107 : }
30108 0 : goto L150;
30109 : }
30110 :
30111 0 : if (jtot == nmaxit) {
30112 0 : goto L150;
30113 : }
30114 0 : ++jtot;
30115 :
30116 0 : rte = std::sqrt(e[l]);
30117 0 : sigma = (d__[l + 1] - p) / (rte * 2.);
30118 0 : r__ = PLUMED_BLAS_F77_FUNC(slapy2,SLAPY2)(&sigma, &c_b32);
30119 0 : sigma = p - rte / (sigma + ( (sigma>0) ? r__ : -r__));
30120 :
30121 : c__ = 1.;
30122 : s = 0.;
30123 0 : gamma = d__[m] - sigma;
30124 0 : p = gamma * gamma;
30125 :
30126 0 : i__1 = l;
30127 0 : for (i__ = m - 1; i__ >= i__1; --i__) {
30128 0 : bb = e[i__];
30129 0 : r__ = p + bb;
30130 0 : if (i__ != m - 1) {
30131 0 : e[i__ + 1] = s * r__;
30132 : }
30133 : oldc = c__;
30134 0 : c__ = p / r__;
30135 0 : s = bb / r__;
30136 : oldgam = gamma;
30137 0 : alpha = d__[i__];
30138 0 : gamma = c__ * (alpha - sigma) - s * oldgam;
30139 0 : d__[i__ + 1] = oldgam + (alpha - gamma);
30140 0 : if (std::abs(c__)>PLUMED_GMX_FLOAT_MIN) {
30141 0 : p = gamma * gamma / c__;
30142 : } else {
30143 0 : p = oldc * bb;
30144 : }
30145 : }
30146 :
30147 0 : e[l] = s * p;
30148 0 : d__[l] = sigma + gamma;
30149 0 : goto L50;
30150 :
30151 : L90:
30152 : d__[l] = p;
30153 :
30154 0 : ++l;
30155 0 : if (l <= lend) {
30156 0 : goto L50;
30157 : }
30158 0 : goto L150;
30159 :
30160 : } else {
30161 :
30162 0 : L100:
30163 0 : i__1 = lend + 1;
30164 0 : for (m = l; m >= i__1; --m) {
30165 0 : if (std::abs(e[m - 1]) <= eps2 * std::abs(d__[m] * d__[m - 1])) {
30166 0 : goto L120;
30167 : }
30168 : }
30169 : m = lend;
30170 :
30171 0 : L120:
30172 0 : if (m > lend) {
30173 0 : e[m - 1] = 0.;
30174 : }
30175 0 : p = d__[l];
30176 0 : if (m == l) {
30177 0 : goto L140;
30178 : }
30179 :
30180 0 : if (m == l - 1) {
30181 0 : rte = std::sqrt(e[l - 1]);
30182 0 : PLUMED_BLAS_F77_FUNC(slae2,SLAE2)(&d__[l], &rte, &d__[l - 1], &rt1, &rt2);
30183 0 : d__[l] = rt1;
30184 0 : d__[l - 1] = rt2;
30185 0 : e[l - 1] = 0.;
30186 0 : l += -2;
30187 0 : if (l >= lend) {
30188 0 : goto L100;
30189 : }
30190 0 : goto L150;
30191 : }
30192 :
30193 0 : if (jtot == nmaxit) {
30194 0 : goto L150;
30195 : }
30196 0 : ++jtot;
30197 :
30198 0 : rte = std::sqrt(e[l - 1]);
30199 0 : sigma = (d__[l - 1] - p) / (rte * 2.);
30200 0 : r__ = PLUMED_BLAS_F77_FUNC(slapy2,SLAPY2)(&sigma, &c_b32);
30201 0 : sigma = p - rte / (sigma + ( (sigma>0) ? r__ : -r__));
30202 :
30203 : c__ = 1.;
30204 : s = 0.;
30205 0 : gamma = d__[m] - sigma;
30206 0 : p = gamma * gamma;
30207 :
30208 0 : i__1 = l - 1;
30209 0 : for (i__ = m; i__ <= i__1; ++i__) {
30210 0 : bb = e[i__];
30211 0 : r__ = p + bb;
30212 0 : if (i__ != m) {
30213 0 : e[i__ - 1] = s * r__;
30214 : }
30215 : oldc = c__;
30216 0 : c__ = p / r__;
30217 0 : s = bb / r__;
30218 : oldgam = gamma;
30219 0 : alpha = d__[i__ + 1];
30220 0 : gamma = c__ * (alpha - sigma) - s * oldgam;
30221 0 : d__[i__] = oldgam + (alpha - gamma);
30222 0 : if (std::abs(c__)>PLUMED_GMX_FLOAT_MIN) {
30223 0 : p = gamma * gamma / c__;
30224 : } else {
30225 0 : p = oldc * bb;
30226 : }
30227 : }
30228 :
30229 0 : e[l - 1] = s * p;
30230 0 : d__[l] = sigma + gamma;
30231 0 : goto L100;
30232 :
30233 : L140:
30234 : d__[l] = p;
30235 :
30236 0 : --l;
30237 0 : if (l >= lend) {
30238 0 : goto L100;
30239 : }
30240 0 : goto L150;
30241 :
30242 : }
30243 :
30244 0 : L150:
30245 0 : if (iscale == 1) {
30246 0 : i__1 = lendsv - lsv + 1;
30247 0 : PLUMED_BLAS_F77_FUNC(slascl,SLASCL)("G", &c__0, &c__0, &ssfmax, &anorm, &i__1, &c__1, &d__[lsv],
30248 : n, info);
30249 : }
30250 0 : if (iscale == 2) {
30251 0 : i__1 = lendsv - lsv + 1;
30252 0 : PLUMED_BLAS_F77_FUNC(slascl,SLASCL)("G", &c__0, &c__0, &ssfmin, &anorm, &i__1, &c__1, &d__[lsv],
30253 : n, info);
30254 : }
30255 :
30256 0 : if (jtot < nmaxit) {
30257 0 : goto L10;
30258 : }
30259 0 : i__1 = *n - 1;
30260 0 : for (i__ = 1; i__ <= i__1; ++i__) {
30261 0 : if (std::abs(e[i__])>PLUMED_GMX_FLOAT_MIN) {
30262 0 : ++(*info);
30263 : }
30264 : }
30265 : return;
30266 : }
30267 :
30268 :
30269 : }
30270 : }
30271 : #include "lapack.h"
30272 :
30273 :
30274 : /* Normally, SSTEVR is the LAPACK wrapper which calls one
30275 : * of the eigenvalue methods. However, our code includes a
30276 : * version of SSTEGR which is never than LAPACK 3.0 and can
30277 : * handle requests for a subset of eigenvalues/vectors too,
30278 : * and it should not need to call SSTEIN.
30279 : * Just in case somebody has a faster version in their lapack
30280 : * library we still call the driver routine, but in our own
30281 : * case this is just a wrapper to sstegr.
30282 : */
30283 : #include "blas/blas.h"
30284 : namespace PLMD{
30285 : namespace lapack{
30286 : using namespace blas;
30287 : void
30288 0 : PLUMED_BLAS_F77_FUNC(sstevr,SSTEVR)(const char *jobz,
30289 : const char *range,
30290 : int *n,
30291 : float *d,
30292 : float *e,
30293 : float *vl,
30294 : float *vu,
30295 : int *il,
30296 : int *iu,
30297 : float *abstol,
30298 : int *m,
30299 : float *w,
30300 : float *z,
30301 : int *ldz,
30302 : int *isuppz,
30303 : float *work,
30304 : int *lwork,
30305 : int *iwork,
30306 : int *liwork,
30307 : int *info)
30308 : {
30309 0 : PLUMED_BLAS_F77_FUNC(sstegr,SSTEGR)(jobz, range, n, d, e, vl, vu, il, iu, abstol, m, w,
30310 : z, ldz, isuppz, work, lwork, iwork, liwork, info);
30311 :
30312 :
30313 0 : return;
30314 :
30315 : }
30316 :
30317 :
30318 : }
30319 : }
30320 : #include <cmath>
30321 :
30322 : #include "real.h"
30323 :
30324 : #include "blas/blas.h"
30325 : #include "lapack.h"
30326 : #include "lapack_limits.h"
30327 :
30328 : #include "blas/blas.h"
30329 : namespace PLMD{
30330 : namespace lapack{
30331 : using namespace blas;
30332 : void
30333 0 : PLUMED_BLAS_F77_FUNC(ssyevr,SSYEVR)(const char *jobz, const char *range, const char *uplo, int *n,
30334 : float *a, int *lda, float *vl, float *vu, int *
30335 : il, int *iu, float *abstol, int *m, float *w,
30336 : float *z__, int *ldz, int *isuppz, float *work,
30337 : int *lwork, int *iwork, int *liwork, int *info)
30338 : {
30339 : /* System generated locals */
30340 : int a_dim1, a_offset, z_dim1, z_offset, i__1, i__2;
30341 : float d__1, d__2;
30342 :
30343 : /* Local variables */
30344 0 : int c__1 = 1;
30345 : int i__, j, nb, jj;
30346 : float eps, tmp1;
30347 : int indd, inde;
30348 : float anrm;
30349 : int imax;
30350 : float rmin, rmax;
30351 : int itmp1, inddd, indee;
30352 : float sigma;
30353 : int iinfo;
30354 : int indwk;
30355 : int lwmin;
30356 : int lower, wantz;
30357 : int alleig, indeig;
30358 : int iscale, indibl, indifl;
30359 : int valeig;
30360 : float safmin,minval;
30361 : float bignum;
30362 : int indtau;
30363 : int indwkn;
30364 : int liwmin;
30365 : int llwrkn, llwork;
30366 : float smlnum;
30367 : int lwkopt;
30368 : int lquery;
30369 :
30370 : /* Parameter adjustments */
30371 0 : a_dim1 = *lda;
30372 0 : a_offset = 1 + a_dim1;
30373 0 : a -= a_offset;
30374 0 : --w;
30375 0 : z_dim1 = *ldz;
30376 0 : z_offset = 1 + z_dim1;
30377 0 : z__ -= z_offset;
30378 : --isuppz;
30379 0 : --work;
30380 0 : --iwork;
30381 :
30382 0 : lower = (*uplo=='L' || *uplo=='l');
30383 0 : wantz = (*jobz=='V' || *jobz=='v');
30384 0 : alleig = (*range=='A' || *range=='a');
30385 0 : valeig = (*range=='V' || *range=='v');
30386 0 : indeig = (*range=='I' || *range=='i');
30387 :
30388 : indibl = 0;
30389 0 : lquery = *lwork == -1 || *liwork == -1;
30390 :
30391 : i__1 = 1;
30392 0 : i__2 = *n * 26;
30393 :
30394 0 : if(*n>0)
30395 : lwmin = *n * 26;
30396 : else
30397 : lwmin = 1;
30398 :
30399 0 : if(*n>0)
30400 0 : liwmin = *n * 10;
30401 : else
30402 : liwmin = 1;
30403 :
30404 0 : *info = 0;
30405 0 : if (! (wantz || (*jobz=='N' || *jobz=='n'))) {
30406 0 : *info = -1;
30407 0 : } else if (! (alleig || valeig || indeig)) {
30408 0 : *info = -2;
30409 0 : } else if (! (lower || (*uplo=='U' || *uplo=='u'))) {
30410 0 : *info = -3;
30411 0 : } else if (*n < 0) {
30412 0 : *info = -4;
30413 0 : } else if (*lda < ((*n>1) ? *n : 1) ) {
30414 0 : *info = -6;
30415 : } else {
30416 0 : if (valeig) {
30417 0 : if (*n > 0 && *vu <= *vl) {
30418 0 : *info = -8;
30419 : }
30420 0 : } else if (indeig) {
30421 0 : if (*il < 1 || *il > ((*n>1) ? *n : 1)) {
30422 0 : *info = -9;
30423 0 : } else if (*iu < ((*n<*il) ? *n : *il) || *iu > *n) {
30424 0 : *info = -10;
30425 : }
30426 : }
30427 : }
30428 0 : if (*info == 0) {
30429 0 : if (*ldz < 1 || (wantz && *ldz < *n)) {
30430 0 : *info = -15;
30431 0 : } else if (*lwork < lwmin && ! lquery) {
30432 0 : *info = -18;
30433 0 : } else if (*liwork < liwmin && ! lquery) {
30434 0 : *info = -20;
30435 : }
30436 : }
30437 :
30438 0 : if (*info == 0) {
30439 : nb = 32;
30440 : /* Computing MAX */
30441 0 : i__1 = (nb + 1) * *n;
30442 : lwkopt = (i__1>lwmin) ? i__1 : lwmin;
30443 0 : work[1] = (float) lwkopt;
30444 0 : iwork[1] = liwmin;
30445 : } else
30446 : return;
30447 :
30448 0 : if (lquery)
30449 : return;
30450 :
30451 0 : *m = 0;
30452 0 : if (*n == 0) {
30453 0 : work[1] = 1.;
30454 0 : return;
30455 : }
30456 :
30457 0 : if (*n == 1) {
30458 0 : work[1] = 7.;
30459 0 : if (alleig || indeig) {
30460 0 : *m = 1;
30461 0 : w[1] = a[a_dim1 + 1];
30462 : } else {
30463 0 : if (*vl < a[a_dim1 + 1] && *vu >= a[a_dim1 + 1]) {
30464 0 : *m = 1;
30465 0 : w[1] = a[a_dim1 + 1];
30466 : }
30467 : }
30468 0 : if (wantz) {
30469 0 : z__[z_dim1 + 1] = 1.;
30470 : }
30471 0 : return;
30472 : }
30473 : minval = PLUMED_GMX_FLOAT_MIN;
30474 : safmin = minval*(1.0+PLUMED_GMX_FLOAT_EPS);
30475 : eps = PLUMED_GMX_FLOAT_EPS;
30476 :
30477 : smlnum = safmin / eps;
30478 : bignum = 1. / smlnum;
30479 : rmin = std::sqrt(smlnum);
30480 :
30481 0 : d__1 = std::sqrt(bignum), d__2 = 1. / std::sqrt(sqrt(safmin));
30482 : rmax = (d__1<d__2) ? d__1 : d__2;
30483 :
30484 : iscale = 0;
30485 0 : anrm = PLUMED_BLAS_F77_FUNC(slansy,SLANSY)("M", uplo, n, &a[a_offset], lda, &work[1]);
30486 0 : if (anrm > 0. && anrm < rmin) {
30487 : iscale = 1;
30488 0 : sigma = rmin / anrm;
30489 0 : } else if (anrm > rmax) {
30490 : iscale = 1;
30491 0 : sigma = rmax / anrm;
30492 : }
30493 : if (iscale == 1) {
30494 0 : if (lower) {
30495 0 : i__1 = *n;
30496 0 : for (j = 1; j <= i__1; ++j) {
30497 0 : i__2 = *n - j + 1;
30498 0 : PLUMED_BLAS_F77_FUNC(sscal,SSCAL)(&i__2, &sigma, &a[j + j * a_dim1], &c__1);
30499 : }
30500 : } else {
30501 0 : i__1 = *n;
30502 0 : for (j = 1; j <= i__1; ++j) {
30503 0 : PLUMED_BLAS_F77_FUNC(sscal,SSCAL)(&j, &sigma, &a[j * a_dim1 + 1], &c__1);
30504 :
30505 : }
30506 : }
30507 : }
30508 :
30509 : indtau = 1;
30510 0 : inde = indtau + *n;
30511 0 : indd = inde + *n;
30512 0 : indee = indd + *n;
30513 0 : inddd = indee + *n;
30514 0 : indifl = inddd + *n;
30515 0 : indwk = indifl + *n;
30516 0 : llwork = *lwork - indwk + 1;
30517 0 : PLUMED_BLAS_F77_FUNC(ssytrd,SSYTRD)(uplo, n, &a[a_offset], lda, &work[indd], &work[inde], &work[
30518 0 : indtau], &work[indwk], &llwork, &iinfo);
30519 :
30520 0 : i__1 = *n - 1;
30521 0 : PLUMED_BLAS_F77_FUNC(scopy,SCOPY)(&i__1, &work[inde], &c__1, &work[indee], &c__1);
30522 0 : PLUMED_BLAS_F77_FUNC(scopy,SCOPY)(n, &work[indd], &c__1, &work[inddd], &c__1);
30523 :
30524 0 : PLUMED_BLAS_F77_FUNC(sstegr,SSTEGR)(jobz, range, n, &work[inddd], &work[indee], vl, vu, il, iu,
30525 : abstol, m, &w[1], &z__[z_offset], ldz, &isuppz[1],
30526 : &work[indwk], lwork, &iwork[1], liwork, info);
30527 0 : if (wantz && *info == 0) {
30528 : indwkn = inde;
30529 0 : llwrkn = *lwork - indwkn + 1;
30530 0 : PLUMED_BLAS_F77_FUNC(sormtr,SORMTR)("L", uplo, "N", n, m, &a[a_offset], lda, &work[indtau]
30531 : , &z__[z_offset], ldz, &work[indwkn], &llwrkn, &iinfo);
30532 : }
30533 :
30534 0 : if (*info != 0)
30535 : return;
30536 :
30537 0 : if (iscale == 1) {
30538 : if (*info == 0) {
30539 0 : imax = *m;
30540 : } else {
30541 : imax = *info - 1;
30542 : }
30543 0 : d__1 = 1. / sigma;
30544 0 : PLUMED_BLAS_F77_FUNC(sscal,SSCAL)(&imax, &d__1, &w[1], &c__1);
30545 : }
30546 :
30547 0 : if (wantz) {
30548 0 : i__1 = *m - 1;
30549 :
30550 0 : for (j = 1; j <= i__1; ++j) {
30551 : i__ = 0;
30552 0 : tmp1 = w[j];
30553 0 : i__2 = *m;
30554 0 : for (jj = j + 1; jj <= i__2; ++jj) {
30555 0 : if (w[jj] < tmp1) {
30556 : i__ = jj;
30557 : tmp1 = w[jj];
30558 : }
30559 : }
30560 :
30561 0 : if (i__ != 0) {
30562 0 : itmp1 = iwork[indibl + i__ - 1];
30563 0 : w[i__] = w[j];
30564 0 : iwork[indibl + i__ - 1] = iwork[indibl + j - 1];
30565 0 : w[j] = tmp1;
30566 0 : iwork[indibl + j - 1] = itmp1;
30567 0 : PLUMED_BLAS_F77_FUNC(sswap,SSWAP)(n, &z__[i__ * z_dim1 + 1], &c__1, &z__[j * z_dim1 + 1],
30568 : &c__1);
30569 : }
30570 : }
30571 : }
30572 :
30573 0 : work[1] = (float) lwkopt;
30574 0 : iwork[1] = liwmin;
30575 0 : return;
30576 :
30577 : }
30578 : }
30579 : }
30580 : #include <cctype>
30581 : #include <cmath>
30582 :
30583 : #include "real.h"
30584 :
30585 : #include "blas/blas.h"
30586 : #include "lapack.h"
30587 :
30588 : #include "blas/blas.h"
30589 : namespace PLMD{
30590 : namespace lapack{
30591 : using namespace blas;
30592 : void
30593 0 : PLUMED_BLAS_F77_FUNC(ssytd2,SSYTD2)(const char * uplo,
30594 : int * n,
30595 : float * a,
30596 : int * lda,
30597 : float * d,
30598 : float * e,
30599 : float * tau,
30600 : int * info)
30601 : {
30602 : float minusone,zero;
30603 : float taui,alpha,tmp;
30604 : int ti1,ti2,ti3,i;
30605 0 : const char ch=std::toupper(*uplo);
30606 :
30607 0 : zero = 0.0;
30608 0 : minusone = -1.0;
30609 :
30610 0 : if(*n<=0)
30611 : return;
30612 :
30613 0 : if(ch=='U') {
30614 0 : for(i=*n-1;i>=1;i--) {
30615 :
30616 0 : ti1 = 1;
30617 0 : PLUMED_BLAS_F77_FUNC(slarfg,SLARFG)(&i,&(a[i*(*lda)+(i-1)]),&(a[i*(*lda)+0]),&ti1,&taui);
30618 0 : e[i-1] = a[i*(*lda) + (i-1)];
30619 0 : if(std::abs(taui)>PLUMED_GMX_FLOAT_MIN) {
30620 0 : a[i*(*lda)+(i-1)] = 1.0;
30621 :
30622 0 : ti1 = 1;
30623 0 : PLUMED_BLAS_F77_FUNC(ssymv,SSYMV)("U",&i,&taui,a,lda,&(a[i*(*lda)+0]),&ti1,&zero,tau,&ti1);
30624 :
30625 0 : tmp = PLUMED_BLAS_F77_FUNC(sdot,SDOT)(&i,tau,&ti1,&(a[i*(*lda)+0]),&ti1);
30626 :
30627 0 : alpha = -0.5*taui*tmp;
30628 :
30629 0 : PLUMED_BLAS_F77_FUNC(saxpy,SAXPY)(&i,&alpha,&(a[i*(*lda)+0]),&ti1,tau,&ti1);
30630 :
30631 0 : PLUMED_BLAS_F77_FUNC(ssyr2,SSYR2)("U",&i,&minusone,&(a[i*(*lda)+0]),&ti1,tau,&ti1,a,lda);
30632 :
30633 0 : a[i*(*lda)+(i-1)] = e[i-1];
30634 :
30635 : }
30636 0 : d[i] = a[i*(*lda)+i];
30637 0 : tau[i-1] = taui;
30638 : }
30639 0 : d[0] = a[0];
30640 :
30641 : } else {
30642 : /* lower */
30643 :
30644 0 : for(i=1;i<*n;i++) {
30645 :
30646 0 : ti1 = *n - i;
30647 0 : ti2 = ( *n < i+2) ? *n : i+2;
30648 0 : ti3 = 1;
30649 0 : PLUMED_BLAS_F77_FUNC(slarfg,SLARFG)(&ti1,&(a[(i-1)*(*lda)+(i)]),&(a[(i-1)*(*lda)+ti2-1]),&ti3,&taui);
30650 :
30651 0 : e[i-1] = a[(i-1)*(*lda) + (i)];
30652 :
30653 0 : if(std::abs(taui)>PLUMED_GMX_FLOAT_MIN) {
30654 0 : a[(i-1)*(*lda)+(i)] = 1.0;
30655 :
30656 0 : ti1 = *n - i;
30657 0 : ti2 = 1;
30658 0 : PLUMED_BLAS_F77_FUNC(ssymv,SSYMV)(uplo,&ti1,&taui,&(a[i*(*lda)+i]),lda,&(a[(i-1)*(*lda)+i]),
30659 : &ti2,&zero,&(tau[i-1]),&ti2);
30660 :
30661 0 : tmp = PLUMED_BLAS_F77_FUNC(sdot,SDOT)(&ti1,&(tau[i-1]),&ti2,&(a[(i-1)*(*lda)+i]),&ti2);
30662 :
30663 0 : alpha = -0.5*taui*tmp;
30664 :
30665 0 : PLUMED_BLAS_F77_FUNC(saxpy,SAXPY)(&ti1,&alpha,&(a[(i-1)*(*lda)+i]),&ti2,&(tau[i-1]),&ti2);
30666 :
30667 0 : PLUMED_BLAS_F77_FUNC(ssyr2,SSYR2)(uplo,&ti1,&minusone,&(a[(i-1)*(*lda)+i]),&ti2,&(tau[i-1]),&ti2,
30668 0 : &(a[(i)*(*lda)+i]),lda);
30669 :
30670 0 : a[(i-1)*(*lda)+(i)] = e[i-1];
30671 :
30672 : }
30673 0 : d[i-1] = a[(i-1)*(*lda)+i-1];
30674 0 : tau[i-1] = taui;
30675 : }
30676 0 : d[*n-1] = a[(*n-1)*(*lda)+(*n-1)];
30677 :
30678 : }
30679 : return;
30680 : }
30681 : }
30682 : }
30683 : #include "blas/blas.h"
30684 : #include "lapack.h"
30685 : #include "lapack_limits.h"
30686 :
30687 : #include "blas/blas.h"
30688 : namespace PLMD{
30689 : namespace lapack{
30690 : using namespace blas;
30691 : void
30692 0 : PLUMED_BLAS_F77_FUNC(ssytrd,SSYTRD)(const char *uplo, int *n, float *a, int *
30693 : lda, float *d__, float *e, float *tau, float *
30694 : work, int *lwork, int *info)
30695 : {
30696 : /* System generated locals */
30697 : int a_dim1, a_offset, i__1, i__2, i__3;
30698 :
30699 : /* Local variables */
30700 : int i__, j, nb, kk, nx, iws;
30701 : int nbmin, iinfo;
30702 : int upper;
30703 : int ldwork, lwkopt;
30704 : int lquery;
30705 0 : float c_b22 = -1.;
30706 0 : float c_b23 = 1.;
30707 :
30708 :
30709 : /* Parameter adjustments */
30710 0 : a_dim1 = *lda;
30711 0 : a_offset = 1 + a_dim1;
30712 0 : a -= a_offset;
30713 0 : --d__;
30714 0 : --e;
30715 0 : --tau;
30716 : --work;
30717 :
30718 : /* Function Body */
30719 0 : *info = 0;
30720 0 : upper = (*uplo=='U' || *uplo=='u');
30721 0 : lquery = (*lwork == -1);
30722 :
30723 0 : if (! upper && ! (*uplo=='L' || *uplo=='l')) {
30724 0 : *info = -1;
30725 0 : } else if (*n < 0) {
30726 0 : *info = -2;
30727 0 : } else if (*lda < ((1>*n) ? 1 : *n)) {
30728 0 : *info = -4;
30729 0 : } else if (*lwork < 1 && ! lquery) {
30730 0 : *info = -9;
30731 : }
30732 :
30733 0 : if (*info == 0) {
30734 :
30735 0 : nb = DSYTRD_BLOCKSIZE;
30736 0 : lwkopt = *n * nb;
30737 0 : work[1] = (float) lwkopt;
30738 : } else
30739 : return;
30740 :
30741 0 : if (lquery)
30742 : return;
30743 :
30744 0 : if (*n == 0) {
30745 0 : work[1] = 1.;
30746 0 : return;
30747 : }
30748 :
30749 : nx = *n;
30750 0 : if (nb > 1 && nb < *n) {
30751 :
30752 : nx = DSYTRD_CROSSOVER;
30753 0 : if (nx < *n) {
30754 :
30755 0 : ldwork = *n;
30756 0 : iws = ldwork * nb;
30757 0 : if (*lwork < iws) {
30758 :
30759 0 : i__1 = *lwork / ldwork;
30760 0 : nb = (i__1>1) ? i__1 : 1;
30761 : nbmin = DSYTRD_MINBLOCKSIZE;
30762 0 : if (nb < nbmin) {
30763 : nx = *n;
30764 : }
30765 : }
30766 : } else {
30767 : nx = *n;
30768 : }
30769 : } else {
30770 0 : nb = 1;
30771 : }
30772 :
30773 0 : if (upper) {
30774 :
30775 0 : kk = *n - (*n - nx + nb - 1) / nb * nb;
30776 0 : i__1 = kk + 1;
30777 : i__2 = -nb;
30778 0 : for (i__ = *n - nb + 1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ +=
30779 : i__2) {
30780 :
30781 0 : i__3 = i__ + nb - 1;
30782 0 : PLUMED_BLAS_F77_FUNC(slatrd,SLATRD)(uplo, &i__3, &nb, &a[a_offset], lda, &e[1], &tau[1], &
30783 : work[1], &ldwork);
30784 :
30785 0 : i__3 = i__ - 1;
30786 0 : PLUMED_BLAS_F77_FUNC(ssyr2k,SSYR2K)(uplo, "No transpose", &i__3, &nb, &c_b22, &a[i__ * a_dim1
30787 0 : + 1], lda, &work[1], &ldwork, &c_b23, &a[a_offset], lda);
30788 :
30789 0 : i__3 = i__ + nb - 1;
30790 0 : for (j = i__; j <= i__3; ++j) {
30791 0 : a[j - 1 + j * a_dim1] = e[j - 1];
30792 0 : d__[j] = a[j + j * a_dim1];
30793 :
30794 : }
30795 :
30796 : }
30797 :
30798 0 : PLUMED_BLAS_F77_FUNC(ssytd2,SSYTD2)(uplo, &kk, &a[a_offset], lda, &d__[1], &e[1], &tau[1], &iinfo);
30799 : } else {
30800 :
30801 0 : i__2 = *n - nx;
30802 0 : i__1 = nb;
30803 0 : for (i__ = 1; i__1 < 0 ? i__ >= i__2 : i__ <= i__2; i__ += i__1) {
30804 :
30805 :
30806 0 : i__3 = *n - i__ + 1;
30807 0 : PLUMED_BLAS_F77_FUNC(slatrd,SLATRD)(uplo, &i__3, &nb, &a[i__ + i__ * a_dim1], lda, &e[i__], &
30808 0 : tau[i__], &work[1], &ldwork);
30809 :
30810 0 : i__3 = *n - i__ - nb + 1;
30811 0 : PLUMED_BLAS_F77_FUNC(ssyr2k,SSYR2K)(uplo, "No transpose", &i__3, &nb, &c_b22, &a[i__ + nb +
30812 0 : i__ * a_dim1], lda, &work[nb + 1], &ldwork, &c_b23, &a[
30813 0 : i__ + nb + (i__ + nb) * a_dim1], lda);
30814 :
30815 :
30816 0 : i__3 = i__ + nb - 1;
30817 0 : for (j = i__; j <= i__3; ++j) {
30818 0 : a[j + 1 + j * a_dim1] = e[j];
30819 0 : d__[j] = a[j + j * a_dim1];
30820 :
30821 : }
30822 :
30823 : }
30824 :
30825 :
30826 0 : i__1 = *n - i__ + 1;
30827 0 : PLUMED_BLAS_F77_FUNC(ssytd2,SSYTD2)(uplo, &i__1, &a[i__ + i__ * a_dim1], lda, &d__[i__], &e[i__],
30828 0 : &tau[i__], &iinfo);
30829 : }
30830 :
30831 0 : work[1] = (float) lwkopt;
30832 0 : return;
30833 :
30834 : }
30835 :
30836 :
30837 : }
30838 : }
30839 : #include "blas/blas.h"
30840 : #include "lapack.h"
30841 : #include "lapack_limits.h"
30842 :
30843 : #include "blas/blas.h"
30844 : namespace PLMD{
30845 : namespace lapack{
30846 : using namespace blas;
30847 : void
30848 0 : PLUMED_BLAS_F77_FUNC(strti2,STRTI2)(const char *uplo,
30849 : const char *diag,
30850 : int *n,
30851 : float *a,
30852 : int *lda,
30853 : int *info)
30854 : {
30855 : int a_dim1, a_offset, i__1, i__2;
30856 :
30857 : int j;
30858 : float ajj;
30859 : int upper, nounit;
30860 0 : int c__1 = 1;
30861 :
30862 :
30863 0 : a_dim1 = *lda;
30864 0 : a_offset = 1 + a_dim1;
30865 0 : a -= a_offset;
30866 :
30867 0 : *info = 0;
30868 0 : upper = (*uplo=='U' || *uplo=='u');
30869 0 : nounit = (*diag=='N' || *diag=='n');
30870 :
30871 : if (*info != 0) {
30872 : i__1 = -(*info);
30873 : return;
30874 : }
30875 :
30876 0 : if (upper) {
30877 :
30878 0 : i__1 = *n;
30879 0 : for (j = 1; j <= i__1; ++j) {
30880 0 : if (nounit) {
30881 0 : a[j + j * a_dim1] = 1. / a[j + j * a_dim1];
30882 0 : ajj = -a[j + j * a_dim1];
30883 : } else {
30884 0 : ajj = -1.;
30885 : }
30886 :
30887 0 : i__2 = j - 1;
30888 0 : PLUMED_BLAS_F77_FUNC(strmv,STRMV)("Upper", "No transpose", diag, &i__2, &a[a_offset], lda, &
30889 0 : a[j * a_dim1 + 1], &c__1);
30890 0 : i__2 = j - 1;
30891 0 : PLUMED_BLAS_F77_FUNC(sscal,SSCAL)(&i__2, &ajj, &a[j * a_dim1 + 1], &c__1);
30892 : }
30893 : } else {
30894 :
30895 0 : for (j = *n; j >= 1; --j) {
30896 0 : if (nounit) {
30897 0 : a[j + j * a_dim1] = 1. / a[j + j * a_dim1];
30898 0 : ajj = -a[j + j * a_dim1];
30899 : } else {
30900 0 : ajj = -1.;
30901 : }
30902 0 : if (j < *n) {
30903 :
30904 0 : i__1 = *n - j;
30905 0 : PLUMED_BLAS_F77_FUNC(strmv,STRMV)("Lower", "No transpose", diag, &i__1, &a[j + 1 + (j +
30906 0 : 1) * a_dim1], lda, &a[j + 1 + j * a_dim1], &c__1);
30907 0 : i__1 = *n - j;
30908 0 : PLUMED_BLAS_F77_FUNC(sscal,SSCAL)(&i__1, &ajj, &a[j + 1 + j * a_dim1], &c__1);
30909 : }
30910 : }
30911 : }
30912 : return;
30913 : }
30914 : }
30915 : }
30916 : #include <cmath>
30917 : #include "blas/blas.h"
30918 : #include "lapack.h"
30919 : #include "lapack_limits.h"
30920 :
30921 : #include "real.h"
30922 :
30923 : #include "blas/blas.h"
30924 : namespace PLMD{
30925 : namespace lapack{
30926 : using namespace blas;
30927 : void
30928 0 : PLUMED_BLAS_F77_FUNC(strtri,STRTRI)(const char *uplo,
30929 : const char *diag,
30930 : int *n,
30931 : float *a,
30932 : int *lda,
30933 : int *info)
30934 : {
30935 : int a_dim1, a_offset, i__1, i__3, i__4, i__5;
30936 : int j, jb, nb, nn;
30937 0 : float c_b18 = 1.;
30938 0 : float c_b22 = -1.;
30939 :
30940 : int upper;
30941 : int nounit;
30942 :
30943 0 : a_dim1 = *lda;
30944 0 : a_offset = 1 + a_dim1;
30945 0 : a -= a_offset;
30946 :
30947 0 : *info = 0;
30948 0 : upper = (*uplo=='U' || *uplo=='u');
30949 0 : nounit = (*diag=='N' || *diag=='n');
30950 :
30951 : if (*info != 0) {
30952 : i__1 = -(*info);
30953 : return;
30954 : }
30955 :
30956 0 : if (*n == 0) {
30957 : return;
30958 : }
30959 :
30960 0 : if (nounit) {
30961 0 : i__1 = *n;
30962 0 : for (*info = 1; *info <= i__1; ++(*info)) {
30963 0 : if (std::abs(a[*info + *info * a_dim1])<PLUMED_GMX_FLOAT_MIN) {
30964 : return;
30965 : }
30966 : }
30967 0 : *info = 0;
30968 : }
30969 :
30970 : nb = DTRTRI_BLOCKSIZE;
30971 0 : if (nb <= 1 || nb >= *n) {
30972 :
30973 0 : PLUMED_BLAS_F77_FUNC(strti2,STRTI2)(uplo, diag, n, &a[a_offset], lda, info);
30974 : } else {
30975 :
30976 0 : if (upper) {
30977 :
30978 0 : i__1 = *n;
30979 : i__3 = nb;
30980 0 : for (j = 1; i__3 < 0 ? j >= i__1 : j <= i__1; j += i__3) {
30981 0 : i__4 = nb, i__5 = *n - j + 1;
30982 0 : jb = (i__4<i__5) ? i__4 : i__5;
30983 :
30984 0 : i__4 = j - 1;
30985 0 : PLUMED_BLAS_F77_FUNC(strmm,STRMM)("Left", "Upper", "No transpose", diag, &i__4, &jb, &
30986 0 : c_b18, &a[a_offset], lda, &a[j * a_dim1 + 1], lda);
30987 0 : i__4 = j - 1;
30988 0 : PLUMED_BLAS_F77_FUNC(strsm,STRSM)("Right", "Upper", "No transpose", diag, &i__4, &jb, &
30989 0 : c_b22, &a[j + j * a_dim1], lda, &a[j * a_dim1 + 1],
30990 : lda);
30991 :
30992 0 : PLUMED_BLAS_F77_FUNC(strti2,STRTI2)("Upper", diag, &jb, &a[j + j * a_dim1], lda, info);
30993 : }
30994 : } else {
30995 :
30996 0 : nn = (*n - 1) / nb * nb + 1;
30997 : i__3 = -nb;
30998 0 : for (j = nn; i__3 < 0 ? j >= 1 : j <= 1; j += i__3) {
30999 0 : i__1 = nb, i__4 = *n - j + 1;
31000 0 : jb = (i__1<i__4) ? i__1 : i__4;
31001 0 : if (j + jb <= *n) {
31002 :
31003 0 : i__1 = *n - j - jb + 1;
31004 0 : PLUMED_BLAS_F77_FUNC(strmm,STRMM)("Left", "Lower", "No transpose", diag, &i__1, &jb,
31005 0 : &c_b18, &a[j + jb + (j + jb) * a_dim1], lda, &a[j
31006 0 : + jb + j * a_dim1], lda);
31007 0 : i__1 = *n - j - jb + 1;
31008 0 : PLUMED_BLAS_F77_FUNC(strsm,STRSM)("Right", "Lower", "No transpose", diag, &i__1, &jb,
31009 0 : &c_b22, &a[j + j * a_dim1], lda, &a[j + jb + j *
31010 0 : a_dim1], lda);
31011 : }
31012 :
31013 0 : PLUMED_BLAS_F77_FUNC(strti2,STRTI2)("Lower", diag, &jb, &a[j + j * a_dim1], lda, info);
31014 : }
31015 : }
31016 : }
31017 : return;
31018 : }
31019 :
31020 :
31021 : }
31022 : }
31023 : #endif
|
