35 #ifndef TEMPLATE_LAPACK_STEIN_HEADER
36 #define TEMPLATE_LAPACK_STEIN_HEADER
146 integer z_dim1, z_offset, i__1, i__2, i__3;
147 Treal d__1, d__2, d__3, d__4, d__5;
152 integer iseed[4], gpind, iinfo;
156 integer indrv1, indrv2, indrv3, indrv4, indrv5, bn;
160 Treal onenrm, dtpcrt, pertol, scl, eps, sep, nrm, tol;
162 Treal xjm, ztr, eps1;
163 #define z___ref(a_1,a_2) z__[(a_2)*z_dim1 + a_1]
172 z_offset = 1 + z_dim1 * 1;
179 ortol = dtpcrt = xjm = onenrm = gpind = 0;
183 for (i__ = 1; i__ <= i__1; ++i__) {
190 }
else if (*m < 0 || *m > *n) {
196 for (j = 2; j <= i__1; ++j) {
197 if (iblock[j] < iblock[j - 1]) {
201 if (iblock[j] == iblock[j - 1] && w[j] < w[j - 1]) {
219 if (*n == 0 || *m == 0) {
221 }
else if (*n == 1) {
232 for (i__ = 1; i__ <= 4; ++i__) {
240 indrv2 = indrv1 + *n;
241 indrv3 = indrv2 + *n;
242 indrv4 = indrv3 + *n;
243 indrv5 = indrv4 + *n;
249 for (nblk = 1; nblk <= i__1; ++nblk) {
256 b1 = isplit[nblk - 1] + 1;
259 blksiz = bn - b1 + 1;
269 d__3 = onenrm, d__4 = (d__1 = d__[bn],
absMACRO(d__1)) + (d__2 = e[bn - 1],
273 for (i__ = b1 + 1; i__ <= i__2; ++i__) {
275 d__4 = onenrm, d__5 = (d__1 = d__[i__],
absMACRO(d__1)) + (d__2 = e[
280 ortol = onenrm * .001;
289 for (j = j1; j <= i__2; ++j) {
290 if (iblock[j] != nblk) {
300 work[indrv1 + 1] = 1.;
308 eps1 = (d__1 = eps * xj,
absMACRO(d__1));
335 indrv3 + 1], &tol, &work[indrv5 + 1], &iwork[1], &iinfo);
348 d__2 = eps, d__3 = (d__1 = work[indrv4 + blksiz],
absMACRO(d__1));
356 work[indrv3 + 1], &work[indrv5 + 1], &iwork[1], &work[
357 indrv1 + 1], &tol, &iinfo);
365 if ((d__1 = xj - xjm,
absMACRO(d__1)) > ortol) {
370 for (i__ = gpind; i__ <= i__3; ++i__) {
383 nrm = (d__1 = work[indrv1 + jmax],
absMACRO(d__1));
410 if (work[indrv1 + jmax] < 0.) {
416 for (i__ = 1; i__ <= i__3; ++i__) {
421 for (i__ = 1; i__ <= i__3; ++i__) {
422 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:41
Treal template_blas_nrm2(const integer *n, const Treal *x, const integer *incx)
Definition: template_blas_nrm2.h:40
#define absMACRO(x)
Definition: template_blas_common.h:45
int template_lapack_larnv(const integer *idist, integer *iseed, const integer *n, Treal *x)
Definition: template_lapack_larnv.h:40
#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:40
int integer
Definition: template_blas_common.h:38
#define maxMACRO(a, b)
Definition: template_blas_common.h:43
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:40
Treal template_blas_asum(const integer *n, const Treal *dx, const integer *incx)
Definition: template_blas_asum.h:40
int template_blas_erbla(const char *srname, integer *info)
Definition: template_blas_common.cc:144
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:40
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:40
Treal template_lapack_lamch(const char *cmach, Treal dummyReal)
Definition: template_lapack_lamch.h:199
int template_blas_copy(const integer *n, const Treal *dx, const integer *incx, Treal *dy, const integer *incy)
Definition: template_blas_copy.h:40
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:41
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:41