/* nag_zgeesx (f08ppc) Example Program. * * Copyright 2013 Numerical Algorithms Group. * * Mark 24, 2013. */ #include #include #include #include #include #include #include #include #include #ifdef __cplusplus extern "C" { #endif static Nag_Boolean NAG_CALL select_fun(const Complex w); #ifdef __cplusplus } #endif int main(void) { /* Scalars */ Complex alpha, beta; double anorm, eps, norm, rconde, rcondv; Integer i, j, n, pda, pdc, pdd, pdvs, sdim; Integer exit_status = 0; /* Arrays */ Complex *a = 0, *c = 0, *d = 0, *vs = 0, *w = 0; /* Nag Types */ NagError fail; Nag_OrderType order; #ifdef NAG_COLUMN_MAJOR #define A(I, J) a[(J-1)*pda + I - 1] order = Nag_ColMajor; #else #define A(I, J) a[(I-1)*pda + J - 1] order = Nag_RowMajor; #endif INIT_FAIL(fail); printf("nag_zgeesx (f08ppc) Example Program Results\n\n"); /* Skip heading in data file */ scanf("%*[^\n]"); scanf("%ld%*[^\n]", &n); if (n < 0) { printf("Invalid n\n"); exit_status = 1; return exit_status; } pda = n; pdc = n; pdd = n; pdvs = n; /* Allocate memory */ if (!(a = NAG_ALLOC(n * n, Complex)) || !(c = NAG_ALLOC(n * n, Complex)) || !(d = NAG_ALLOC(n * n, Complex)) || !(vs = NAG_ALLOC(n * n, Complex)) || !(w = NAG_ALLOC(n, Complex))) { printf("Allocation failure\n"); exit_status = -1; goto END; } /* Read in the matrix A */ for (i = 1; i <= n; ++i) for (j = 1; j <= n; ++j) scanf(" ( %lf , %lf )", &A(i, j).re, &A(i, j).im); scanf("%*[^\n]"); /* Copy A to D: nag_zge_copy (f16tfc), * Complex valued general matrix copy. */ nag_zge_copy(order, Nag_NoTrans, n, n, a, pda, d, pdd, &fail); if (fail.code != NE_NOERROR) { printf("Error from nag_zge_copy (f16tfc).\n%s\n", fail.message); exit_status = 1; goto END; } /* nag_zge_norm (f16uac): Find norm of matrix A for use later * in relative error test. */ nag_zge_norm(order, Nag_OneNorm, n, n, a, pda, &anorm, &fail); if (fail.code != NE_NOERROR) { printf("Error from nag_zge_norm (f16uac).\n%s\n", fail.message); exit_status = 1; goto END; } /* nag_gen_complx_mat_print_comp (x04dbc): Print matrix A */ fflush(stdout); nag_gen_complx_mat_print_comp(order, Nag_GeneralMatrix, Nag_NonUnitDiag, n, n, a, pda, Nag_BracketForm, "%7.4f", "Matrix A", Nag_IntegerLabels, 0, Nag_IntegerLabels, 0, 80, 0, 0, &fail); printf("\n"); if (fail.code != NE_NOERROR) { printf("Error from nag_gen_complx_mat_print_comp (x04dbc).\n%s\n", fail.message); exit_status = 1; goto END; } /* Find the Schur factorization of A using nag_zgeesx (f08ppc). */ nag_zgeesx(order, Nag_Schur, Nag_SortEigVals, select_fun, Nag_RCondBoth, n, a, pda, &sdim, w, vs, pdvs, &rconde, &rcondv, &fail); if (fail.code != NE_NOERROR && fail.code != NE_SCHUR_REORDER_SELECT) { printf("Error from nag_zgeesx (f08ppc).\n%s\n", fail.message); exit_status = 1; goto END; } /* Reconstruct A from Schur Factorization Z*T*ConjTrans(Z) where T is upper * triangular and stored in A. This can be done using the following steps: * i. C = Z*T (nag_zgemm, f16zac), * ii. D = D-C*ConjTrans(Z) (nag_zgemm, f16zac). */ alpha = nag_complex(1.0,0.0); beta = nag_complex(0.0,0.0); nag_zgemm(order, Nag_NoTrans, Nag_NoTrans, n, n, n, alpha, vs, pdvs, a, pda, beta, c, pdc, &fail); if (fail.code != NE_NOERROR) { printf("Error from nag_zgemm (f16zac).\n%s\n", fail.message); exit_status = 1; goto END; } /* nag_zgemm (f16zac): * Compute D = A - C*Z^H. */ alpha = nag_complex(-1.0,0.0); beta = nag_complex(1.0,0.0); nag_zgemm(order, Nag_NoTrans, Nag_ConjTrans, n, n, n, alpha, c, pdc, vs, pdvs, beta, d, pdd, &fail); if (fail.code != NE_NOERROR) { printf("Error from nag_zgemm (f16zac).\n%s\n", fail.message); exit_status = 1; goto END; } /* nag_zge_norm (f16uac): Find norm of difference matrix D and print * warning if it is too large relative to norm of A. */ nag_zge_norm(order, Nag_OneNorm, n, n, d, pdd, &norm, &fail); if (fail.code != NE_NOERROR) { printf("Error from nag_zge_norm (f16uac).\n%s\n", fail.message); exit_status = 1; goto END; } /* Get the machine precision, using nag_machine_precision (x02ajc) */ eps = nag_machine_precision; if (norm > pow(eps,0.8)*MAX(anorm,1.0)) { printf("||A-(Z*T*Z^H)||/||A|| is larger than expected.\n" "Schur factorization has failed.\n"); exit_status = 1; goto END; } /* Print details on eigenvalues */ printf("Number of eigenvalues for which select is true = %4ld\n\n", sdim); if (fail.code == NE_SCHUR_REORDER_SELECT) { printf(" ** Note that rounding errors mean that leading eigenvalues in the" " Schur form\n no longer satisfy select(lambda) = Nag_TRUE\n\n"); } else { printf("The selected eigenvalues are:\n"); for (i=0;i0.0 ? Nag_TRUE : Nag_FALSE); }