/* nag_zgeesx (f08ppc) Example Program. * * Copyright 2011 Numerical Algorithms Group. * * Mark 23, 2011. */ #include #include #include #include #include #include #include #include #include #ifdef __cplusplus extern "C" { #endif static Nag_Boolean NAG_CALL sel(const Complex w); #ifdef __cplusplus } #endif static Nag_Boolean NAG_CALL sel(const Complex w); int main(void) { /* Scalars */ Complex alpha, beta; double anorm, eps, norm, rconde, rcondv; Integer exit_status = 0, i, j, n, pda, pdc, pdd, pdvs, sdim; NagError fail; Nag_OrderType order; /* Arrays */ Complex *a = 0, *c = 0, *d = 0, *vs = 0, *w = 0; #ifdef NAG_COLUMN_MAJOR #define A(I, J) a[(J-1)*pda + I - 1] #define D(I, J) d[(J-1)*pdd + I - 1] order = Nag_ColMajor; #else #define A(I, J) a[(I-1)*pda + J - 1] #define D(I, J) d[(I-1)*pdd + 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; goto END;; } 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); /* 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); 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; } printf("\n"); /* Find the Frobenius norms of A */ nag_zge_norm(order, Nag_FrobeniusNorm, 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; } /* Find the Schur factorization of A using nag_zgeesx (f08ppc). */ nag_zgeesx(order, Nag_Schur, Nag_SortEigVals, sel, Nag_RCondBoth, n, a, pda, &sdim, w, vs, pdvs, &rconde, &rcondv, &fail); if (fail.code != NE_NOERROR) { printf("Error from nag_zgeesx (f08ppc).\n%s\n", fail.message); exit_status = 1; goto END; } /* Reconstruct A from Schur Factorization Z*T*Trans(Z) where T is upper * triangular and stored in A. This can be done using the following steps: * i. C = Z*T (nag_dgemm, f16yac), * ii. D = D-C*trans(Z) (nag_dgemm, f16yac). */ 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) { 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 sel(w) is true = %4ld\n\n", sdim); printf("The selected eigenvaues are:\n"); for (i=0;i0.0?Nag_TRUE:Nag_FALSE); }