37 #ifndef TEMPLATE_LAPACK_STEIN_HEADER 38 #define TEMPLATE_LAPACK_STEIN_HEADER 148 integer z_dim1, z_offset, i__1, i__2, i__3;
149 Treal d__1, d__2, d__3, d__4, d__5;
154 integer iseed[4], gpind, iinfo;
158 integer indrv1, indrv2, indrv3, indrv4, indrv5, bn;
162 Treal onenrm, dtpcrt, pertol, scl, eps, sep, nrm, tol;
164 Treal xjm, ztr, eps1;
165 #define z___ref(a_1,a_2) z__[(a_2)*z_dim1 + a_1] 174 z_offset = 1 + z_dim1 * 1;
181 ortol = dtpcrt = xjm = onenrm = gpind = 0;
185 for (i__ = 1; i__ <= i__1; ++i__) {
192 }
else if (*m < 0 || *m > *n) {
198 for (j = 2; j <= i__1; ++j) {
199 if (iblock[j] < iblock[j - 1]) {
203 if (iblock[j] == iblock[j - 1] && w[j] < w[j - 1]) {
221 if (*n == 0 || *m == 0) {
223 }
else if (*n == 1) {
234 for (i__ = 1; i__ <= 4; ++i__) {
242 indrv2 = indrv1 + *n;
243 indrv3 = indrv2 + *n;
244 indrv4 = indrv3 + *n;
245 indrv5 = indrv4 + *n;
251 for (nblk = 1; nblk <= i__1; ++nblk) {
258 b1 = isplit[nblk - 1] + 1;
261 blksiz = bn - b1 + 1;
271 d__3 = onenrm, d__4 = (d__1 = d__[bn],
absMACRO(d__1)) + (d__2 = e[bn - 1],
275 for (i__ = b1 + 1; i__ <= i__2; ++i__) {
277 d__4 = onenrm, d__5 = (d__1 = d__[i__],
absMACRO(d__1)) + (d__2 = e[
282 ortol = onenrm * .001;
291 for (j = j1; j <= i__2; ++j) {
292 if (iblock[j] != nblk) {
302 work[indrv1 + 1] = 1.;
310 eps1 = (d__1 = eps * xj,
absMACRO(d__1));
337 indrv3 + 1], &tol, &work[indrv5 + 1], &iwork[1], &iinfo);
350 d__2 = eps, d__3 = (d__1 = work[indrv4 + blksiz],
absMACRO(d__1));
358 work[indrv3 + 1], &work[indrv5 + 1], &iwork[1], &work[
359 indrv1 + 1], &tol, &iinfo);
367 if ((d__1 = xj - xjm,
absMACRO(d__1)) > ortol) {
372 for (i__ = gpind; i__ <= i__3; ++i__) {
385 nrm = (d__1 = work[indrv1 + jmax],
absMACRO(d__1));
412 if (work[indrv1 + jmax] < 0.) {
418 for (i__ = 1; i__ <= i__3; ++i__) {
423 for (i__ = 1; i__ <= i__3; ++i__) {
424 z___ref(b1 + i__ - 1, j) = work[indrv1 + i__];
int template_blas_scal(const integer *n, const Treal *da, Treal *dx, const integer *incx)
Definition: template_blas_scal.h:43
Treal template_blas_nrm2(const integer *n, const Treal *x, const integer *incx)
Definition: template_blas_nrm2.h:42
#define absMACRO(x)
Definition: template_blas_common.h:47
int template_lapack_larnv(const integer *idist, integer *iseed, const integer *n, Treal *x)
Definition: template_lapack_larnv.h:42
#define z___ref(a_1, a_2)
integer template_blas_idamax(const integer *n, const Treal *dx, const integer *incx)
Definition: template_blas_idamax.h:42
int integer
Definition: template_blas_common.h:40
#define maxMACRO(a, b)
Definition: template_blas_common.h:45
int template_lapack_lagtf(const integer *n, Treal *a, const Treal *lambda, Treal *b, Treal *c__, const Treal *tol, Treal *d__, integer *in, integer *info)
Definition: template_lapack_lagtf.h:42
Treal template_blas_asum(const integer *n, const Treal *dx, const integer *incx)
Definition: template_blas_asum.h:42
int template_blas_erbla(const char *srname, integer *info)
Definition: template_blas_common.cc:146
int template_lapack_stein(const integer *n, const Treal *d__, const Treal *e, const integer *m, const Treal *w, const integer *iblock, const integer *isplit, Treal *z__, const integer *ldz, Treal *work, integer *iwork, integer *ifail, integer *info)
Definition: template_lapack_stein.h:42
int template_lapack_lagts(const integer *job, const integer *n, const Treal *a, const Treal *b, const Treal *c__, const Treal *d__, const integer *in, Treal *y, Treal *tol, integer *info)
Definition: template_lapack_lagts.h:42
Treal template_lapack_lamch(const char *cmach, Treal dummyReal)
Definition: template_lapack_lamch.h:202
int template_blas_copy(const integer *n, const Treal *dx, const integer *incx, Treal *dy, const integer *incy)
Definition: template_blas_copy.h:42
int template_blas_axpy(const integer *n, const Treal *da, const Treal *dx, const integer *incx, Treal *dy, const integer *incy)
Definition: template_blas_axpy.h:43
Treal template_blas_sqrt(Treal x)
Treal template_blas_dot(const integer *n, const Treal *dx, const integer *incx, const Treal *dy, const integer *incy)
Definition: template_blas_dot.h:43