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__];