37 #ifndef TEMPLATE_LAPACK_LALN2_HEADER 38 #define TEMPLATE_LAPACK_LALN2_HEADER 43 const Treal *smin,
const Treal *ca,
const Treal *a,
const integer *lda,
44 const Treal *d1,
const Treal *d2,
const Treal *b,
const integer *ldb,
45 const Treal *wr,
const Treal *wi, Treal *x,
const integer *ldx,
46 Treal *scale, Treal *xnorm,
integer *info)
174 integer ipivot[16] = { 1,2,3,4,2,1,4,3,3,4,1,2,
177 integer a_dim1, a_offset, b_dim1, b_offset, x_dim1, x_offset;
178 Treal d__1, d__2, d__3, d__4, d__5, d__6;
179 Treal equiv_0[4], equiv_1[4];
181 Treal bbnd, cmax, ui11r, ui12s, temp, ur11r, ur12s;
185 Treal bnorm, cnorm, smini;
188 Treal bignum, bi1, bi2, br1, br2, smlnum, xi1, xi2, xr1, xr2,
189 ci21, ci22, cr21, cr22, li21, csi, ui11, lr21, ui12, ui22;
190 #define civ (equiv_0) 191 Treal csr, ur11, ur12, ur22;
192 #define crv (equiv_1) 193 #define a_ref(a_1,a_2) a[(a_2)*a_dim1 + a_1] 194 #define b_ref(a_1,a_2) b[(a_2)*b_dim1 + a_1] 195 #define x_ref(a_1,a_2) x[(a_2)*x_dim1 + a_1] 196 #define ci_ref(a_1,a_2) ci[(a_2)*2 + a_1 - 3] 197 #define cr_ref(a_1,a_2) cr[(a_2)*2 + a_1 - 3] 198 #define ipivot_ref(a_1,a_2) ipivot[(a_2)*4 + a_1 - 5] 201 a_offset = 1 + a_dim1 * 1;
204 b_offset = 1 + b_dim1 * 1;
207 x_offset = 1 + x_dim1 * 1;
215 bignum = 1. / smlnum;
236 csr = *ca *
a_ref(1, 1) - *wr * *d1;
250 if (cnorm < 1. && bnorm > 1.) {
251 if (bnorm > bignum * cnorm) {
266 csr = *ca *
a_ref(1, 1) - *wr * *d1;
283 if (cnorm < 1. && bnorm > 1.) {
284 if (bnorm > bignum * cnorm) {
291 d__1 = *scale *
b_ref(1, 1);
292 d__2 = *scale *
b_ref(1, 2);
323 for (j = 1; j <= 4; ++j) {
338 if (smini < 1. && bnorm > 1.) {
339 if (bnorm > bignum * smini) {
343 temp = *scale / smini;
346 *xnorm = temp * bnorm;
353 ur11 =
crv[icmax - 1];
359 ur22 = cr22 - ur12 * lr21;
367 if (rswap[icmax - 1]) {
378 if (bbnd > 1. &&
absMACRO(ur22) < 1.) {
379 if (bbnd >= bignum *
absMACRO(ur22)) {
384 xr2 = br2 * *scale / ur22;
385 xr1 = *scale * br1 * ur11r - xr2 * (ur11r * ur12);
386 if (zswap[icmax - 1]) {
399 if (*xnorm > 1. && cmax > 1.) {
400 if (*xnorm > bignum / cmax) {
401 temp = cmax / bignum;
404 *xnorm = temp * *xnorm;
405 *scale = temp * *scale;
414 ci_ref(1, 1) = -(*wi) * *d1;
417 ci_ref(2, 2) = -(*wi) * *d2;
421 for (j = 1; j <= 4; ++j) {
439 if (smini < 1. && bnorm > 1.) {
440 if (bnorm > bignum * smini) {
444 temp = *scale / smini;
449 *xnorm = temp * bnorm;
456 ur11 =
crv[icmax - 1];
457 ui11 =
civ[icmax - 1];
464 if (icmax == 1 || icmax == 4) {
472 ur11r = 1. / (ur11 * (d__1 * d__1 + 1.));
473 ui11r = -temp * ur11r;
478 ui11r = -1. / (ui11 * (d__1 * d__1 + 1.));
479 ur11r = -temp * ui11r;
483 ur12s = ur12 * ur11r;
484 ui12s = ur12 * ui11r;
485 ur22 = cr22 - ur12 * lr21;
486 ui22 = ci22 - ur12 * li21;
495 ur12s = ur12 * ur11r;
496 ui12s = ui12 * ur11r;
497 ur22 = cr22 - ur12 * lr21 + ui12 * li21;
498 ui22 = -ur12 * li21 - ui12 * lr21;
504 if (u22abs < smini) {
509 if (rswap[icmax - 1]) {
520 br2 = br2 - lr21 * br1 + li21 * bi1;
521 bi2 = bi2 - li21 * br1 - lr21 * bi1;
526 if (bbnd > 1. && u22abs < 1.) {
527 if (bbnd >= bignum * u22abs) {
537 xr1 = ur11r * br1 - ui11r * bi1 - ur12s * xr2 + ui12s * xi2;
538 xi1 = ui11r * br1 + ur11r * bi1 - ui12s * xr2 - ur12s * xi2;
539 if (zswap[icmax - 1]) {
556 if (*xnorm > 1. && cmax > 1.) {
557 if (*xnorm > bignum / cmax) {
558 temp = cmax / bignum;
563 *xnorm = temp * *xnorm;
564 *scale = temp * *scale;
#define absMACRO(x)
Definition: template_blas_common.h:47
int integer
Definition: template_blas_common.h:40
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:42
#define maxMACRO(a, b)
Definition: template_blas_common.h:45
#define ipivot_ref(a_1, a_2)
Treal template_lapack_lamch(const char *cmach, Treal dummyReal)
Definition: template_lapack_lamch.h:202
bool logical
Definition: template_blas_common.h:41
#define TRUE_
Definition: template_lapack_common.h:42
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:42
#define FALSE_
Definition: template_lapack_common.h:43