/* nag_dbdsqr (f08mec) Example Program. * * Copyright 2001 Numerical Algorithms Group. * * Mark 7, 2001. */ #include #include #include #include #include #include int main(void) { /* Scalars */ Integer i, n, pdvt, pdu; Integer exit_status = 0, ncc = 0, ldc = 1; double zero = 0.0, one = 1.0; /* Arrays */ char nag_enum_arg[40]; double c[1]; double *d = 0, *e = 0, *u = 0, *vt = 0; /* Nag Types */ NagError fail; Nag_UploType uplo; Nag_OrderType order; INIT_FAIL(fail); printf("nag_dbdsqr (f08mec) 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;; } #ifdef NAG_COLUMN_MAJOR #define U(I, J) u[(J-1)*pdu + I - 1] #define VT(I, J) vt[(J-1)*pdvt + I - 1] order = Nag_ColMajor; #else #define U(I, J) u[(I-1)*pdu + J - 1] #define VT(I, J) vt[(I-1)*pdvt + J - 1] order = Nag_RowMajor; #endif pdu = n; pdvt = n; /* Allocate memory */ if (!(d = NAG_ALLOC(n, double)) || !(e = NAG_ALLOC(n-1, double)) || !(u = NAG_ALLOC(n * n, double)) || !(vt = NAG_ALLOC(n * n, double))) { printf("Allocation failure\n"); exit_status = -1; goto END; } /* Read B from data file */ for (i = 0; i < n; ++i) scanf("%lf", &d[i]); scanf("%*[^\n]"); for (i = 0; i < n - 1; ++i) scanf("%lf", &e[i]); scanf("%*[^\n]"); scanf("%39s%*[^\n]", nag_enum_arg); /* nag_enum_name_to_value (x04nac). * Converts NAG enum member name to value */ uplo = (Nag_UploType) nag_enum_name_to_value(nag_enum_arg); /* Initialise U and VT to be the unit matrix to obtain SVD of input * bidiagonal matrix nag_dge_load (f16qhc). * General matrix initialisation. */ nag_dge_load(order, n, n, zero, one, u, pdu, &fail); nag_dge_load(order, n, n, zero, one, vt, pdvt, &fail); if (fail.code != NE_NOERROR) { printf("Error from nag_dge_load (f16qhc).\n%s\n", fail.message); exit_status = 1; goto END; } /* nag_dbdsqr (f08mec). * SVD of real bidiagonal matrix reduced from real general * matrix. */ nag_dbdsqr(order, uplo, n, n, n, ncc, d, e, vt, pdvt, u, pdu, c, ldc, &fail); if (fail.code != NE_NOERROR) { printf("Error from nag_dbdsqr (f08mec).\n%s\n", fail.message); exit_status = 1; goto END; } /* Print singular values, left & right singular vectors */ printf("\nSingular values\n "); for (i = 0; i < n; ++i) printf(" %7.4f%s", d[i], i%8 == 7?"\n":""); printf("\n\n"); /* nag_gen_real_mat_print (x04cac). * Print real general matrix (easy-to-use) */ fflush(stdout); nag_gen_real_mat_print(order, Nag_GeneralMatrix, Nag_NonUnitDiag, n, n, vt, pdvt, "Right singular vectors, by row", 0, &fail); if (fail.code != NE_NOERROR) { printf("Error from nag_gen_real_mat_print (x04cac).\n%s\n", fail.message); exit_status = 1; goto END; } printf("\n"); /* nag_gen_real_mat_print (x04cac), see above. */ fflush(stdout); nag_gen_real_mat_print(order, Nag_GeneralMatrix, Nag_NonUnitDiag, n, n, u, pdu, "Left singular vectors, by column", 0, &fail); if (fail.code != NE_NOERROR) { printf("Error from nag_gen_real_mat_print (x04cac).\n%s\n", fail.message); exit_status = 1; goto END; } END: NAG_FREE(d); NAG_FREE(e); NAG_FREE(u); NAG_FREE(vt); return exit_status; }