37 #ifndef TEMPLATE_LAPACK_LAR1V_HEADER 38 #define TEMPLATE_LAPACK_LAR1V_HEADER 42 *lambda, Treal *d__, Treal *l, Treal *ld, Treal *
43 lld, Treal *pivmin, Treal *gaptol, Treal *z__,
logical 44 *wantnc,
integer *negcnt, Treal *ztz, Treal *mingma,
46 Treal *rqcorr, Treal *work)
50 Treal d__1, d__2, d__3;
220 inds = (*n << 1) + 1;
225 work[inds + *b1 - 1] = lld[*b1 - 1];
233 s = work[inds + *b1 - 1] - *lambda;
235 for (i__ = *b1; i__ <= i__1; ++i__) {
236 dplus = d__[i__] + s;
237 work[indlpl + i__] = ld[i__] / dplus;
241 work[inds + i__] = s * work[indlpl + i__] * l[i__];
242 s = work[inds + i__] - *lambda;
250 for (i__ = r1; i__ <= i__1; ++i__) {
251 dplus = d__[i__] + s;
252 work[indlpl + i__] = ld[i__] / dplus;
253 work[inds + i__] = s * work[indlpl + i__] * l[i__];
254 s = work[inds + i__] - *lambda;
263 s = work[inds + *b1 - 1] - *lambda;
265 for (i__ = *b1; i__ <= i__1; ++i__) {
266 dplus = d__[i__] + s;
270 work[indlpl + i__] = ld[i__] / dplus;
274 work[inds + i__] = s * work[indlpl + i__] * l[i__];
275 if (work[indlpl + i__] == 0.) {
276 work[inds + i__] = lld[i__];
278 s = work[inds + i__] - *lambda;
282 for (i__ = r1; i__ <= i__1; ++i__) {
283 dplus = d__[i__] + s;
287 work[indlpl + i__] = ld[i__] / dplus;
288 work[inds + i__] = s * work[indlpl + i__] * l[i__];
289 if (work[indlpl + i__] == 0.) {
290 work[inds + i__] = lld[i__];
292 s = work[inds + i__] - *lambda;
302 work[indp + *bn - 1] = d__[*bn] - *lambda;
304 for (i__ = *bn - 1; i__ >= i__1; --i__) {
305 dminus = lld[i__] + work[indp + i__];
306 tmp = d__[i__] / dminus;
310 work[indumn + i__] = l[i__] * tmp;
311 work[indp + i__ - 1] = work[indp + i__] * tmp - *lambda;
314 tmp = work[indp + r1 - 1];
320 for (i__ = *bn - 1; i__ >= i__1; --i__) {
321 dminus = lld[i__] + work[indp + i__];
325 tmp = d__[i__] / dminus;
329 work[indumn + i__] = l[i__] * tmp;
330 work[indp + i__ - 1] = work[indp + i__] * tmp - *lambda;
332 work[indp + i__ - 1] = d__[i__] - *lambda;
341 *mingma = work[inds + r1 - 1] + work[indp + r1 - 1];
346 *negcnt = neg1 + neg2;
351 *mingma = eps * work[inds + r1 - 1];
355 for (i__ = r1; i__ <= i__1; ++i__) {
356 tmp = work[inds + i__] + work[indp + i__];
358 tmp = eps * work[inds + i__];
376 if (! sawnan1 && ! sawnan2) {
378 for (i__ = *r__ - 1; i__ >= i__1; --i__) {
379 z__[i__] = -(work[indlpl + i__] * z__[i__ + 1]);
381 d__2))) * (d__3 = ld[i__],
absMACRO(d__3)) < *gaptol) {
386 *ztz += z__[i__] * z__[i__];
394 for (i__ = *r__ - 1; i__ >= i__1; --i__) {
395 if (z__[i__ + 1] == 0.) {
396 z__[i__] = -(ld[i__ + 1] / ld[i__]) * z__[i__ + 2];
398 z__[i__] = -(work[indlpl + i__] * z__[i__ + 1]);
401 d__2))) * (d__3 = ld[i__],
absMACRO(d__3)) < *gaptol) {
406 *ztz += z__[i__] * z__[i__];
413 if (! sawnan1 && ! sawnan2) {
415 for (i__ = *r__; i__ <= i__1; ++i__) {
416 z__[i__ + 1] = -(work[indumn + i__] * z__[i__]);
418 d__2))) * (d__3 = ld[i__],
absMACRO(d__3)) < *gaptol) {
423 *ztz += z__[i__ + 1] * z__[i__ + 1];
431 for (i__ = *r__; i__ <= i__1; ++i__) {
432 if (z__[i__] == 0.) {
433 z__[i__ + 1] = -(ld[i__ - 1] / ld[i__]) * z__[i__ - 1];
435 z__[i__ + 1] = -(work[indumn + i__] * z__[i__]);
438 d__2))) * (d__3 = ld[i__],
absMACRO(d__3)) < *gaptol) {
443 *ztz += z__[i__ + 1] * z__[i__ + 1];
454 *resid =
absMACRO(*mingma) * *nrminv;
455 *rqcorr = *mingma * tmp;
#define absMACRO(x)
Definition: template_blas_common.h:47
logical template_lapack_isnan(Treal *din)
Definition: template_lapack_isnan.h:45
int integer
Definition: template_blas_common.h:40
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:41
Treal template_lapack_lamch(const char *cmach, Treal dummyReal)
Definition: template_lapack_lamch.h:202
bool logical
Definition: template_blas_common.h:41
#define FALSE_
Definition: template_lapack_common.h:43
Treal template_blas_sqrt(Treal x)