35 #ifndef TEMPLATE_LAPACK_LALN2_HEADER 36 #define TEMPLATE_LAPACK_LALN2_HEADER 41 const Treal *smin,
const Treal *ca,
const Treal *a,
const integer *lda,
42 const Treal *d1,
const Treal *d2,
const Treal *b,
const integer *ldb,
43 const Treal *wr,
const Treal *wi, Treal *x,
const integer *ldx,
44 Treal *scale, Treal *xnorm,
integer *info)
172 integer ipivot[16] = { 1,2,3,4,2,1,4,3,3,4,1,2,
175 integer a_dim1, a_offset, b_dim1, b_offset, x_dim1, x_offset;
176 Treal d__1, d__2, d__3, d__4, d__5, d__6;
177 Treal equiv_0[4], equiv_1[4];
179 Treal bbnd, cmax, ui11r, ui12s, temp, ur11r, ur12s;
183 Treal bnorm, cnorm, smini;
186 Treal bignum, bi1, bi2, br1, br2, smlnum, xi1, xi2, xr1, xr2,
187 ci21, ci22, cr21, cr22, li21, csi, ui11, lr21, ui12, ui22;
188 #define civ (equiv_0) 189 Treal csr, ur11, ur12, ur22;
190 #define crv (equiv_1) 191 #define a_ref(a_1,a_2) a[(a_2)*a_dim1 + a_1] 192 #define b_ref(a_1,a_2) b[(a_2)*b_dim1 + a_1] 193 #define x_ref(a_1,a_2) x[(a_2)*x_dim1 + a_1] 194 #define ci_ref(a_1,a_2) ci[(a_2)*2 + a_1 - 3] 195 #define cr_ref(a_1,a_2) cr[(a_2)*2 + a_1 - 3] 196 #define ipivot_ref(a_1,a_2) ipivot[(a_2)*4 + a_1 - 5] 199 a_offset = 1 + a_dim1 * 1;
202 b_offset = 1 + b_dim1 * 1;
205 x_offset = 1 + x_dim1 * 1;
213 bignum = 1. / smlnum;
234 csr = *ca *
a_ref(1, 1) - *wr * *d1;
248 if (cnorm < 1. && bnorm > 1.) {
249 if (bnorm > bignum * cnorm) {
264 csr = *ca *
a_ref(1, 1) - *wr * *d1;
281 if (cnorm < 1. && bnorm > 1.) {
282 if (bnorm > bignum * cnorm) {
289 d__1 = *scale *
b_ref(1, 1);
290 d__2 = *scale *
b_ref(1, 2);
321 for (j = 1; j <= 4; ++j) {
336 if (smini < 1. && bnorm > 1.) {
337 if (bnorm > bignum * smini) {
341 temp = *scale / smini;
344 *xnorm = temp * bnorm;
351 ur11 =
crv[icmax - 1];
357 ur22 = cr22 - ur12 * lr21;
365 if (rswap[icmax - 1]) {
376 if (bbnd > 1. &&
absMACRO(ur22) < 1.) {
377 if (bbnd >= bignum *
absMACRO(ur22)) {
382 xr2 = br2 * *scale / ur22;
383 xr1 = *scale * br1 * ur11r - xr2 * (ur11r * ur12);
384 if (zswap[icmax - 1]) {
397 if (*xnorm > 1. && cmax > 1.) {
398 if (*xnorm > bignum / cmax) {
399 temp = cmax / bignum;
402 *xnorm = temp * *xnorm;
403 *scale = temp * *scale;
412 ci_ref(1, 1) = -(*wi) * *d1;
415 ci_ref(2, 2) = -(*wi) * *d2;
419 for (j = 1; j <= 4; ++j) {
437 if (smini < 1. && bnorm > 1.) {
438 if (bnorm > bignum * smini) {
442 temp = *scale / smini;
447 *xnorm = temp * bnorm;
454 ur11 =
crv[icmax - 1];
455 ui11 =
civ[icmax - 1];
462 if (icmax == 1 || icmax == 4) {
470 ur11r = 1. / (ur11 * (d__1 * d__1 + 1.));
471 ui11r = -temp * ur11r;
476 ui11r = -1. / (ui11 * (d__1 * d__1 + 1.));
477 ur11r = -temp * ui11r;
481 ur12s = ur12 * ur11r;
482 ui12s = ur12 * ui11r;
483 ur22 = cr22 - ur12 * lr21;
484 ui22 = ci22 - ur12 * li21;
493 ur12s = ur12 * ur11r;
494 ui12s = ui12 * ur11r;
495 ur22 = cr22 - ur12 * lr21 + ui12 * li21;
496 ui22 = -ur12 * li21 - ui12 * lr21;
502 if (u22abs < smini) {
507 if (rswap[icmax - 1]) {
518 br2 = br2 - lr21 * br1 + li21 * bi1;
519 bi2 = bi2 - li21 * br1 - lr21 * bi1;
524 if (bbnd > 1. && u22abs < 1.) {
525 if (bbnd >= bignum * u22abs) {
535 xr1 = ur11r * br1 - ui11r * bi1 - ur12s * xr2 + ui12s * xi2;
536 xi1 = ui11r * br1 + ur11r * bi1 - ui12s * xr2 - ur12s * xi2;
537 if (zswap[icmax - 1]) {
554 if (*xnorm > 1. && cmax > 1.) {
555 if (*xnorm > bignum / cmax) {
556 temp = cmax / bignum;
561 *xnorm = temp * *xnorm;
562 *scale = temp * *scale;
#define absMACRO(x)
Definition: template_blas_common.h:45
int integer
Definition: template_blas_common.h:38
int template_lapack_ladiv(const Treal *a, const Treal *b, const Treal *c__, const Treal *d__, Treal *p, Treal *q)
Definition: template_lapack_ladiv.h:40
#define maxMACRO(a, b)
Definition: template_blas_common.h:43
#define ipivot_ref(a_1, a_2)
Treal template_lapack_lamch(const char *cmach, Treal dummyReal)
Definition: template_lapack_lamch.h:199
bool logical
Definition: template_blas_common.h:39
#define TRUE_
Definition: template_lapack_common.h:40
int template_lapack_laln2(const logical *ltrans, const integer *na, const integer *nw, const Treal *smin, const Treal *ca, const Treal *a, const integer *lda, const Treal *d1, const Treal *d2, const Treal *b, const integer *ldb, const Treal *wr, const Treal *wi, Treal *x, const integer *ldx, Treal *scale, Treal *xnorm, integer *info)
Definition: template_lapack_laln2.h:40
#define FALSE_
Definition: template_lapack_common.h:41