/* nag_nearest_correlation (g02aac) Example Program. * * Copyright 2008, Numerical Algorithms Group. * * Mark 9, 2009. */ /* Pre-processor includes */ #include #include #include #include #include #include int main(void) { /*Integer scalar and array declarations */ Integer exit_status = 0; Integer feval, i, iter, j, maxit, maxits, n; Integer ldg, pdg, pdx; /*Double scalar and array declarations */ double errtol, nrmgrd; double *g = 0, *x = 0; Nag_OrderType order; NagError fail; INIT_FAIL(fail); printf("%s\n", "nag_nearest_correlation (g02aac) Example Program Results"); printf("\n"); n = 4; ldg = 5; #ifdef NAG_COLUMN_MAJOR pdg = ldg; #define G(I, J) g[(J-1)*pdg + I-1] pdx = n; #define X(I, J) x[(J-1)*pdx + I-1] order = Nag_ColMajor; #else pdg = n; #define G(I, J) g[(I-1)*pdg + J-1] pdx = n; #define X(I, J) x[(I-1)*pdx + J-1] order = Nag_RowMajor; #endif if (!(g = NAG_ALLOC(ldg*n, double)) || !(x = NAG_ALLOC(n*n, double))) { printf("Allocation failure\n"); exit_status = -1; goto END; } /* Set up matrix G*/ for (j = 1; j <= n; j++) { for (i = 1; i <= n; i++) G(i, j) = 0.0; G(j, j) = 2.00e0; } for (j = 2; j <= n; j++) { G(j-1, j) = (-(1.00e0)); G(j, j-1) = (-(1.00e0)); } /* Set up method parameters*/ errtol = 1.00e-7; maxits = 200; maxit = 10; /* * nag_nearest_correlation (g02aac) * Computes the nearest correlation matrix to a real square matrix, * using the method of Qi and Sun */ nag_nearest_correlation(order, g, pdg, n, errtol, maxits, maxit, x, pdx, &iter, &feval, &nrmgrd, &fail); if (fail.code != NE_NOERROR) { printf("Error from nag_nearest_correlation (g02aac).\n%s\n", fail.message); exit_status = 1; goto END; } printf("%s\n", " Nearest Correlation Matrix"); for (i = 1; i <= n; i++) { for (j = 1; j <= n; j++) printf("%11.5f%s", X(i, j), j%4?" ":"\n"); } printf("\n"); printf("\n"); printf("%s%11ld\n", " Number of Newton steps taken:", iter); printf("%s%9ld\n", " Number of function evaluations:", feval); if (nrmgrd > errtol) printf("%s %12.3e\n", " Norm of gradient of last Newton step:", nrmgrd); printf("\n"); END: if (g) NAG_FREE(g); if (x) NAG_FREE(x); return exit_status; }