35 #ifndef TEMPLATE_LAPACK_LAR1V_HEADER
36 #define TEMPLATE_LAPACK_LAR1V_HEADER
40 *lambda, Treal *d__, Treal *l, Treal *ld, Treal *
41 lld, Treal *pivmin, Treal *gaptol, Treal *z__,
logical
42 *wantnc,
integer *negcnt, Treal *ztz, Treal *mingma,
44 Treal *rqcorr, Treal *work)
48 Treal d__1, d__2, d__3;
218 inds = (*n << 1) + 1;
223 work[inds + *b1 - 1] = lld[*b1 - 1];
231 s = work[inds + *b1 - 1] - *lambda;
233 for (i__ = *b1; i__ <= i__1; ++i__) {
234 dplus = d__[i__] + s;
235 work[indlpl + i__] = ld[i__] / dplus;
239 work[inds + i__] = s * work[indlpl + i__] * l[i__];
240 s = work[inds + i__] - *lambda;
248 for (i__ = r1; i__ <= i__1; ++i__) {
249 dplus = d__[i__] + s;
250 work[indlpl + i__] = ld[i__] / dplus;
251 work[inds + i__] = s * work[indlpl + i__] * l[i__];
252 s = work[inds + i__] - *lambda;
261 s = work[inds + *b1 - 1] - *lambda;
263 for (i__ = *b1; i__ <= i__1; ++i__) {
264 dplus = d__[i__] + s;
268 work[indlpl + i__] = ld[i__] / dplus;
272 work[inds + i__] = s * work[indlpl + i__] * l[i__];
273 if (work[indlpl + i__] == 0.) {
274 work[inds + i__] = lld[i__];
276 s = work[inds + i__] - *lambda;
280 for (i__ = r1; i__ <= i__1; ++i__) {
281 dplus = d__[i__] + s;
285 work[indlpl + i__] = ld[i__] / dplus;
286 work[inds + i__] = s * work[indlpl + i__] * l[i__];
287 if (work[indlpl + i__] == 0.) {
288 work[inds + i__] = lld[i__];
290 s = work[inds + i__] - *lambda;
300 work[indp + *bn - 1] = d__[*bn] - *lambda;
302 for (i__ = *bn - 1; i__ >= i__1; --i__) {
303 dminus = lld[i__] + work[indp + i__];
304 tmp = d__[i__] / dminus;
308 work[indumn + i__] = l[i__] * tmp;
309 work[indp + i__ - 1] = work[indp + i__] * tmp - *lambda;
312 tmp = work[indp + r1 - 1];
318 for (i__ = *bn - 1; i__ >= i__1; --i__) {
319 dminus = lld[i__] + work[indp + i__];
323 tmp = d__[i__] / dminus;
327 work[indumn + i__] = l[i__] * tmp;
328 work[indp + i__ - 1] = work[indp + i__] * tmp - *lambda;
330 work[indp + i__ - 1] = d__[i__] - *lambda;
339 *mingma = work[inds + r1 - 1] + work[indp + r1 - 1];
344 *negcnt = neg1 + neg2;
349 *mingma = eps * work[inds + r1 - 1];
353 for (i__ = r1; i__ <= i__1; ++i__) {
354 tmp = work[inds + i__] + work[indp + i__];
356 tmp = eps * work[inds + i__];
374 if (! sawnan1 && ! sawnan2) {
376 for (i__ = *r__ - 1; i__ >= i__1; --i__) {
377 z__[i__] = -(work[indlpl + i__] * z__[i__ + 1]);
379 d__2))) * (d__3 = ld[i__],
absMACRO(d__3)) < *gaptol) {
384 *ztz += z__[i__] * z__[i__];
392 for (i__ = *r__ - 1; i__ >= i__1; --i__) {
393 if (z__[i__ + 1] == 0.) {
394 z__[i__] = -(ld[i__ + 1] / ld[i__]) * z__[i__ + 2];
396 z__[i__] = -(work[indlpl + i__] * z__[i__ + 1]);
399 d__2))) * (d__3 = ld[i__],
absMACRO(d__3)) < *gaptol) {
404 *ztz += z__[i__] * z__[i__];
411 if (! sawnan1 && ! sawnan2) {
413 for (i__ = *r__; i__ <= i__1; ++i__) {
414 z__[i__ + 1] = -(work[indumn + i__] * z__[i__]);
416 d__2))) * (d__3 = ld[i__],
absMACRO(d__3)) < *gaptol) {
421 *ztz += z__[i__ + 1] * z__[i__ + 1];
429 for (i__ = *r__; i__ <= i__1; ++i__) {
430 if (z__[i__] == 0.) {
431 z__[i__ + 1] = -(ld[i__ - 1] / ld[i__]) * z__[i__ - 1];
433 z__[i__ + 1] = -(work[indumn + i__] * z__[i__]);
436 d__2))) * (d__3 = ld[i__],
absMACRO(d__3)) < *gaptol) {
441 *ztz += z__[i__ + 1] * z__[i__ + 1];
452 *resid =
absMACRO(*mingma) * *nrminv;
453 *rqcorr = *mingma * tmp;
#define absMACRO(x)
Definition: template_blas_common.h:45
logical template_lapack_isnan(Treal *din)
Definition: template_lapack_isnan.h:43
int integer
Definition: template_blas_common.h:38
int template_lapack_lar1v(integer *n, integer *b1, integer *bn, Treal *lambda, Treal *d__, Treal *l, Treal *ld, Treal *lld, Treal *pivmin, Treal *gaptol, Treal *z__, logical *wantnc, integer *negcnt, Treal *ztz, Treal *mingma, integer *r__, integer *isuppz, Treal *nrminv, Treal *resid, Treal *rqcorr, Treal *work)
Definition: template_lapack_lar1v.h:39
Treal template_lapack_lamch(const char *cmach, Treal dummyReal)
Definition: template_lapack_lamch.h:199
bool logical
Definition: template_blas_common.h:39
#define FALSE_
Definition: template_lapack_common.h:41
Treal template_blas_sqrt(Treal x)