Example #1
0
int main (int argc, char **argv)
{
	cholmod_common Common, *cc ;
	cholmod_sparse *A ;
	cholmod_dense *X, *B, *Residual ;
	double rnorm, one [2] = {1,0}, minusone [2] = {-1,0} ;
	int mtype ;
	// start CHOLMOD
	cc = &Common ;
	cholmod_l_start (cc) ;
	// load A
	A = (cholmod_sparse *) cholmod_l_read_matrix (stdin, 1, &mtype, cc) ;
	// B = ones (size (A,1),1)
	B = cholmod_l_ones (A->nrow, 1, A->xtype, cc) ;
	// X = A\B
	X = SuiteSparseQR <double> (A, B, cc) ;
	// rnorm = norm (B-A*X)
	Residual = cholmod_l_copy_dense (B, cc) ;
	cholmod_l_sdmult (A, 0, minusone, one, X, Residual, cc) ;
	rnorm = cholmod_l_norm_dense (Residual, 2, cc) ;
	printf ("2-norm of residual: %8.1e\n", rnorm) ;
	printf ("rank %ld\n", cc->SPQR_istat [4]) ;
	// free everything and finish CHOLMOD
	cholmod_l_free_dense (&Residual, cc) ;
	cholmod_l_free_sparse (&A, cc) ;
	cholmod_l_free_dense (&X, cc) ;
	cholmod_l_free_dense (&B, cc) ;
	cholmod_l_finish (cc) ;
	return (0) ;
Example #2
0
void evaluateSPQRSolver(const Eigen::MatrixXd& A, const Eigen::VectorXd& b,
    const Eigen::VectorXd& x) {
  cholmod_common cholmod;
  cholmod_l_start(&cholmod);
  cholmod_sparse* A_CS = aslam::calibration::eigenDenseToCholmodSparseCopy(A,
    &cholmod);
  cholmod_dense b_CD;
  aslam::calibration::eigenDenseToCholmodDenseView(b, &b_CD);
  Eigen::VectorXd x_est;
//  const double before = aslam::calibration::Timestamp::now();
  SuiteSparseQR_factorization<double>* factor = SuiteSparseQR_factorize<double>(
    SPQR_ORDERING_BEST, SPQR_DEFAULT_TOL, A_CS, &cholmod);
  cholmod_dense* Qtb = SuiteSparseQR_qmult<double>(SPQR_QTX, factor, &b_CD,
    &cholmod);
  cholmod_dense* x_est_cd = SuiteSparseQR_solve<double>(SPQR_RETX_EQUALS_B,
    factor, Qtb, &cholmod);
  cholmod_l_free_dense(&Qtb, &cholmod);
  aslam::calibration::cholmodDenseToEigenDenseCopy(x_est_cd, x_est);
  cholmod_l_free_dense(&x_est_cd, &cholmod);
//  std::cout << "estimated rank: " << factor->rank << std::endl;
//  std::cout << "estimated rank deficiency: " << A.cols() - factor->rank
//    << std::endl;
  SuiteSparseQR_free(&factor, &cholmod);
//  const double after = aslam::calibration::Timestamp::now();
//  const double error = (b - A * x_est).norm();
//  std::cout << std::fixed << std::setprecision(18) << "error: " << error
//    << " est_diff: " << (x - x_est).norm() << " time: " << after - before
//    << std::endl;
  cholmod_l_free_sparse(&A_CS, &cholmod);
  cholmod_l_finish(&cholmod);
}
Example #3
0
void evaluateSVDSPQRSolver(const Eigen::MatrixXd& A, const Eigen::VectorXd& b,
    const Eigen::VectorXd& x, double tol = 1e-9) {
  cholmod_common cholmod;
  cholmod_l_start(&cholmod);
  cholmod_sparse* A_CS = aslam::calibration::eigenDenseToCholmodSparseCopy(A,
    &cholmod);
  cholmod_dense b_CD;
  aslam::calibration::eigenDenseToCholmodDenseView(b, &b_CD);
  Eigen::VectorXd x_est;
  aslam::calibration::LinearSolver linearSolver;
  for (std::ptrdiff_t i = 1; i < A.cols(); ++i) {
//    double before = aslam::calibration::Timestamp::now();
    linearSolver.solve(A_CS, &b_CD, i, x_est);
//    double after = aslam::calibration::Timestamp::now();
    double error = (b - A * x_est).norm();
//    std::cout << std::fixed << std::setprecision(18) << "noscale: " << "error: "
//      << error << " est_diff: " << (x - x_est).norm() << " time: "
//      << after - before << std::endl;
    ASSERT_NEAR(error, 0, tol);
    linearSolver.getOptions().columnScaling = true;
//    before = aslam::calibration::Timestamp::now();
    linearSolver.solve(A_CS, &b_CD, i, x_est);
//    after = aslam::calibration::Timestamp::now();
    error = (b - A * x_est).norm();
//    std::cout << std::fixed << std::setprecision(18) << "onscale: " << "error: "
//      << error << " est_diff: " << (x - x_est).norm() << " time: "
//      << after - before << std::endl;
    linearSolver.getOptions().columnScaling = false;
    ASSERT_NEAR(error, 0, tol);
//    std::cout << "SVD rank: " << linearSolver.getSVDRank() << std::endl;
//    std::cout << "SVD rank deficiency: " << linearSolver.getSVDRankDeficiency()
//      << std::endl;
//    std::cout << "QR rank: " << linearSolver.getQRRank() << std::endl;
//    std::cout << "QR rank deficiency: "
//      << linearSolver.getQRRankDeficiency() << std::endl;
//    std::cout << "SV gap: " << linearSolver.getSvGap() << std::endl;
  }
  cholmod_l_free_sparse(&A_CS, &cholmod);
  cholmod_l_finish(&cholmod);
}
Example #4
0
int main (void)
{
    cholmod_sparse *A ;
    cholmod_common ch ;
    cholmod_l_start (&ch) ;
    A = cholmod_l_read_sparse (stdin, &ch) ;
    if (A)
    {
        if (A->nrow != A->ncol || A->stype != 0
            || (!(A->xtype == CHOLMOD_REAL || A->xtype == CHOLMOD_COMPLEX)))
        {
            printf ("invalid matrix\n") ;
        }
        else
        {
            klu_l_demo (A->nrow, A->p, A->i, A->x, A->xtype == CHOLMOD_REAL) ;
        }
        cholmod_l_free_sparse (&A, &ch) ;
    }
    cholmod_l_finish (&ch) ;
    return (0) ;
}
Example #5
0
void mexFunction
(
    int nargout,
    mxArray *pargout [ ],
    int nargin,
    const mxArray *pargin [ ]
)
{
    double dummy = 0 ;
    double *Lx, *Lx2 ;
    Long *Li, *Lp, *Li2, *Lp2, *Lnz2, *ColCount ;
    cholmod_sparse Cmatrix, *C, *Lsparse ;
    cholmod_factor *L ;
    cholmod_common Common, *cm ;
    Long j, k, s, rowadd, n, lnz, ok ;

    /* ---------------------------------------------------------------------- */
    /* start CHOLMOD and set parameters */ 
    /* ---------------------------------------------------------------------- */

    cm = &Common ;
    cholmod_l_start (cm) ;
    sputil_config (SPUMONI, cm) ;

    /* ---------------------------------------------------------------------- */
    /* check inputs */
    /* ---------------------------------------------------------------------- */

    if (nargout > 1 || nargin < 2 || nargin > 3)
    {
	mexErrMsgTxt ("Usage: LD = ldlrowmod (LD,k,C) or ldlrowmod (LD,k)") ; 
    }

    n = mxGetN (pargin [0]) ;
    k = (Long) mxGetScalar (pargin [1]) ;
    k = k - 1 ;         /* change from 1-based to 0-based */

    if (!mxIsSparse (pargin [0])
	    || n != mxGetM (pargin [0])
	    || mxIsComplex (pargin [0]))
    {
	mexErrMsgTxt ("ldlrowmod: L must be real, square, and sparse") ;
    }

    /* ---------------------------------------------------------------------- */
    /* determine if we're doing an rowadd or rowdel */
    /* ---------------------------------------------------------------------- */

    rowadd = (nargin > 2) ;

    if (rowadd)
    {
        if (!mxIsSparse (pargin [2])
                || n != mxGetM (pargin [2])
                || 1 != mxGetN (pargin [2])
                || mxIsComplex (pargin [2]))
        {
            mexErrMsgTxt ("ldlrowmod: C must be a real sparse vector, "
                "with the same number of rows as LD") ;
        }
    }

    /* ---------------------------------------------------------------------- */
    /* get C: sparse vector of incoming/outgoing column */
    /* ---------------------------------------------------------------------- */

    C = (rowadd) ? sputil_get_sparse (pargin [2], &Cmatrix, &dummy, 0) : NULL ;

    /* ---------------------------------------------------------------------- */
    /* construct a copy of the input sparse matrix L */
    /* ---------------------------------------------------------------------- */

    /* get the MATLAB L */
    Lp = (Long *) mxGetJc (pargin [0]) ;
    Li = (Long *) mxGetIr (pargin [0]) ;
    Lx = mxGetPr (pargin [0]) ;

    /* allocate the CHOLMOD symbolic L */
    L = cholmod_l_allocate_factor (n, cm) ;
    L->ordering = CHOLMOD_NATURAL ;
    ColCount = L->ColCount ;
    for (j = 0 ; j < n ; j++)
    {
	ColCount [j] = Lp [j+1] - Lp [j] ;
    }

    /* allocate space for a CHOLMOD LDL' packed factor */
    cholmod_l_change_factor (CHOLMOD_REAL, FALSE, FALSE, TRUE, TRUE, L, cm) ;

    /* copy MATLAB L into CHOLMOD L */
    Lp2 = L->p ;
    Li2 = L->i ;
    Lx2 = L->x ;
    Lnz2 = L->nz ;
    lnz = L->nzmax ;
    for (j = 0 ; j <= n ; j++)
    {
	Lp2 [j] = Lp [j] ;
    }
    for (j = 0 ; j < n ; j++)
    {
	Lnz2 [j] = Lp [j+1] - Lp [j] ;
    }
    for (s = 0 ; s < lnz ; s++)
    {
	Li2 [s] = Li [s] ;
    }
    for (s = 0 ; s < lnz ; s++)
    {
	Lx2 [s] = Lx [s] ;
    }

    /* ---------------------------------------------------------------------- */
    /* rowadd/rowdel the LDL' factorization */
    /* ---------------------------------------------------------------------- */

    if (rowadd)
    {
        ok = cholmod_l_rowadd (k, C, L, cm) ;
    }
    else
    {
        ok = cholmod_l_rowdel (k, NULL, L, cm) ;
    }
    if (!ok) mexErrMsgTxt ("ldlrowmod failed\n") ;

    /* ---------------------------------------------------------------------- */
    /* copy the results back to MATLAB */
    /* ---------------------------------------------------------------------- */

    /* change L back to packed LDL' (it may have become unpacked if the
     * sparsity pattern changed).  This change takes O(n) time if the pattern
     * of L wasn't updated. */
    Lsparse = cholmod_l_factor_to_sparse (L, cm) ;

    /* return L as a sparse matrix */
    pargout [0] = sputil_put_sparse (&Lsparse, cm) ;

    /* ---------------------------------------------------------------------- */
    /* free workspace and the CHOLMOD L, except for what is copied to MATLAB */
    /* ---------------------------------------------------------------------- */

    cholmod_l_free_factor (&L, cm) ;
    cholmod_l_finish (cm) ;
    cholmod_l_print_common (" ", cm) ;
    /*
    if (cm->malloc_count != 3 + mxIsComplex (pargout[0])) mexErrMsgTxt ("!") ;
    */
}
Example #6
0
void mexFunction
(
    int	nargout,
    mxArray *pargout [ ],
    int	nargin,
    const mxArray *pargin [ ]
)
{
    double dummy = 0, rcond, *p ;
    cholmod_sparse Amatrix, Bspmatrix, *A, *Bs, *Xs ;
    cholmod_dense Bmatrix, *X, *B ;
    cholmod_factor *L ;
    cholmod_common Common, *cm ;
    Int n, B_is_sparse, ordering, k, *Perm ;

    /* ---------------------------------------------------------------------- */
    /* start CHOLMOD and set parameters */ 
    /* ---------------------------------------------------------------------- */

    cm = &Common ;
    cholmod_l_start (cm) ;
    sputil_config (SPUMONI, cm) ;

    /* There is no supernodal LDL'.  If cm->final_ll = FALSE (the default), then
     * this mexFunction will use a simplicial LDL' when flops/lnz < 40, and a
     * supernodal LL' otherwise.  This may give suprising results to the MATLAB
     * user, so always perform an LL' factorization by setting cm->final_ll
     * to TRUE. */

    cm->final_ll = TRUE ;
    cm->quick_return_if_not_posdef = TRUE ;

    /* ---------------------------------------------------------------------- */
    /* get inputs */
    /* ---------------------------------------------------------------------- */

    if (nargout > 2 || nargin < 2 || nargin > 3)
    {
	mexErrMsgTxt ("usage: [x,rcond] = cholmod2 (A,b,ordering)") ;
    }
    n = mxGetM (pargin [0]) ;
    if (!mxIsSparse (pargin [0]) || (n != mxGetN (pargin [0])))
    {
    	mexErrMsgTxt ("A must be square and sparse") ;
    }
    if (n != mxGetM (pargin [1]))
    {
    	mexErrMsgTxt ("# of rows of A and B must match") ;
    }

    /* get sparse matrix A.  Use triu(A) only. */
    A = sputil_get_sparse (pargin [0], &Amatrix, &dummy, 1) ;

    /* get sparse or dense matrix B */
    B = NULL ;
    Bs = NULL ;
    B_is_sparse = mxIsSparse (pargin [1]) ;
    if (B_is_sparse)
    {
	/* get sparse matrix B (unsymmetric) */
	Bs = sputil_get_sparse (pargin [1], &Bspmatrix, &dummy, 0) ;
    }
    else
    {
	/* get dense matrix B */
	B = sputil_get_dense (pargin [1], &Bmatrix, &dummy) ;
    }

    /* get the ordering option */
    if (nargin < 3)
    {
	/* use default ordering */
	ordering = -1 ;
    }
    else
    {
	/* use a non-default option */
	ordering = mxGetScalar (pargin [2]) ;
    }

    p = NULL ;
    Perm = NULL ;

    if (ordering == 0)
    {
	/* natural ordering */
	cm->nmethods = 1 ;
	cm->method [0].ordering = CHOLMOD_NATURAL ;
	cm->postorder = FALSE ;
    }
    else if (ordering == -1)
    {
	/* default strategy ... nothing to change */
    }
    else if (ordering == -2)
    {
	/* default strategy, but with NESDIS in place of METIS */
	cm->default_nesdis = TRUE ;
    }
    else if (ordering == -3)
    {
	/* use AMD only */
	cm->nmethods = 1 ;
	cm->method [0].ordering = CHOLMOD_AMD ;
	cm->postorder = TRUE ;
    }
    else if (ordering == -4)
    {
	/* use METIS only */
	cm->nmethods = 1 ;
	cm->method [0].ordering = CHOLMOD_METIS ;
	cm->postorder = TRUE ;
    }
    else if (ordering == -5)
    {
	/* use NESDIS only */
	cm->nmethods = 1 ;
	cm->method [0].ordering = CHOLMOD_NESDIS ;
	cm->postorder = TRUE ;
    }
    else if (ordering == -6)
    {
	/* natural ordering, but with etree postordering */
	cm->nmethods = 1 ;
	cm->method [0].ordering = CHOLMOD_NATURAL ;
	cm->postorder = TRUE ;
    }
    else if (ordering == -7)
    {
	/* always try both AMD and METIS, and pick the best */
	cm->nmethods = 2 ;
	cm->method [0].ordering = CHOLMOD_AMD ;
	cm->method [1].ordering = CHOLMOD_METIS ;
	cm->postorder = TRUE ;
    }
    else if (ordering >= 1)
    {
	/* assume the 3rd argument is a user-provided permutation of 1:n */
	if (mxGetNumberOfElements (pargin [2]) != n)
	{
	    mexErrMsgTxt ("invalid input permutation") ;
	}
	/* copy from double to integer, and convert to 0-based */
	p = mxGetPr (pargin [2]) ;
	Perm = cholmod_l_malloc (n, sizeof (Int), cm) ;
	for (k = 0 ; k < n ; k++)
	{
	    Perm [k] = p [k] - 1 ;
	}
	/* check the permutation */
	if (!cholmod_l_check_perm (Perm, n, n, cm))
	{
	    mexErrMsgTxt ("invalid input permutation") ;
	}
	/* use only the given permutation */
	cm->nmethods = 1 ;
	cm->method [0].ordering = CHOLMOD_GIVEN ;
	cm->postorder = FALSE ;
    }
    else
    {
	mexErrMsgTxt ("invalid ordering option") ;
    }

    /* ---------------------------------------------------------------------- */
    /* analyze and factorize */
    /* ---------------------------------------------------------------------- */

    L = cholmod_l_analyze_p (A, Perm, NULL, 0, cm) ;
    cholmod_l_free (n, sizeof (Int), Perm, cm) ;
    cholmod_l_factorize (A, L, cm) ;

    rcond = cholmod_l_rcond (L, cm) ;

    if (rcond == 0)
    {
	mexWarnMsgTxt ("Matrix is indefinite or singular to working precision");
    }
    else if (rcond < DBL_EPSILON)
    {
	mexWarnMsgTxt ("Matrix is close to singular or badly scaled.") ;
	mexPrintf ("         Results may be inaccurate. RCOND = %g.\n", rcond) ;
    }

    /* ---------------------------------------------------------------------- */
    /* solve and return solution to MATLAB */
    /* ---------------------------------------------------------------------- */

    if (B_is_sparse)
    {
	/* solve AX=B with sparse X and B; return sparse X to MATLAB */
	Xs = cholmod_l_spsolve (CHOLMOD_A, L, Bs, cm) ;
	pargout [0] = sputil_put_sparse (&Xs, cm) ;
    }
    else
    {
	/* solve AX=B with dense X and B; return dense X to MATLAB */
	X = cholmod_l_solve (CHOLMOD_A, L, B, cm) ;
	pargout [0] = sputil_put_dense (&X, cm) ;
    }

    /* return statistics, if requested */
    if (nargout > 1)
    {
	pargout [1] = mxCreateDoubleMatrix (1, 5, mxREAL) ;
	p = mxGetPr (pargout [1]) ;
	p [0] = rcond ;
	p [1] = L->ordering ;
	p [2] = cm->lnz ;
	p [3] = cm->fl ;
	p [4] = cm->memory_usage / 1048576. ;
    }

    cholmod_l_free_factor (&L, cm) ;
    cholmod_l_finish (cm) ;
    cholmod_l_print_common (" ", cm) ;
    /*
    if (cm->malloc_count !=
	(mxIsComplex (pargout [0]) + (mxIsSparse (pargout[0]) ? 3:1)))
	mexErrMsgTxt ("memory leak!") ;
    */
}
int main(int argc, char* argv[])
{
	const int bufsize = 512;
    	char buffer[bufsize];
	int m,n,S;
	double time_st,time_end,time_avg;
	//omp_set_num_threads(2);
//	printf("\n-----------------\nnumber of threads fired = %d\n-----------------\n",(int)omp_get_num_threads());
	if(argc!=2)
	{
		cout<<"Insufficient arguments"<<endl;
		return 1;
	}
	
	graph G;

	cerr<<"Start reading                    ";
//	time_st=dsecnd();
	G.create_graph(argv[1]);
//	time_end=dsecnd();
//	time_avg = (time_end-time_st);
//	cout<<"Success              "<<endl;
//	cerr<<"Reading time                     "<<time_avg<<endl;

	cerr<<"Constructing Matrices            ";
//	time_st=dsecnd();
	G.construct_MNA();
	G.construct_NA();
//	time_end=dsecnd();
//	time_avg = (time_end-time_st);
//	cerr<<"Done                 "<<time_avg<<endl;

//	G.construct_sparse_MNA();
	m=G.node_array.size()-1;
	n=G.voltage_edge_id.size();
	
	cout<<endl;
	cout<<"MATRIX STAT:"<<endl;
	cout<<"Nonzero elements:               "<<G.nonzero<<endl;
	cout<<"Number of Rows:                 "<<m+n<<endl;
	cout<<"Nonzero in G:			"<<G.Gnonzero<<endl;
	cout<<"Number of rows in G:		"<<m<<endl;
	cout<<"Nonzero in P: 			"<<G.Pnonzero<<endl;
	cout<<"Number of rows in P:		"<<m<<endl;


//	printf("\n Nonzero = %d", G.nonzero);
//	printf("\n Rows = %d", m+n);

	cout<<"MAT val:		       "<<endl;
	int i,j;

	G.Mat_val[0] += 100;
	G.Gmat[0] +=100;
/*
	for(i=0;i<G.Gnonzero;i++)
		cout<<" "<<G.Gmat[i];
	cout<<endl;
	for(i=0;i<G.Gnonzero;i++)
		cout<<" "<<G.Gcolumns[i];
	cout<<endl;	
	for(i=0;i<m+1;i++)
		cout<<" "<<G.GrowIndex[i];
	cout<<endl;
	for(i=0;i<m;i++)
		printf(" %.8f", G.b1[i]);
	cout<<endl;
	for(i=0;i<m;i++)
		printf(" %.8f", G.x1[i]);
	cout<<endl;	
	
	
*/	SuiteSparse_long *Gnz = (SuiteSparse_long*)calloc(m,sizeof(SuiteSparse_long));
	for(i=0;i<m;i++)
	{
	//	cout<<endl;
		SuiteSparse_long startindex=G.GrowIndex[i];
		SuiteSparse_long endindex=G.GrowIndex[i+1];
		Gnz[i] = endindex - startindex;

//		for(j=startindex;j<endindex;j++)
//			cout<<" "<<G.Gmat[j];
//		cout<<endl;
		
	}


/*	for(i=0;i<G.Pnonzero;i++)
		cout<<" "<<G.Pmat[i];
	cout<<endl;
	for(i=0;i<G.Pnonzero;i++)
		cout<<" "<<G.Pcolumns[i];
	cout<<endl;	
	for(i=0;i<m+1;i++)
		cout<<" "<<G.ProwIndex[i];
	cout<<endl;
/*	for(i=0;i<m;i++)
		printf(" %.8f", G.b1[i]);
	cout<<endl;
	for(i=0;i<m;i++)
		printf(" %.8f", G.x1[i]);
	cout<<endl;	
	
	
	for(i=0;i<m;i++)
	{
		cout<<endl;
		int startindex=G.ProwIndex[i];
		int endindex=G.ProwIndex[i+1];
		for(j=startindex;j<endindex;j++)
			cout<<" "<<G.Pmat[j];
		cout<<endl;
		
	}
	
/*	for(i=0;i<G.nonzero;i++)
		cout<<" "<<G.Mat_val[i];
	cout<<endl;
	for(i=0;i<G.nonzero;i++)
		cout<<" "<<G.columns[i];
	cout<<endl;	
	for(i=0;i<m+n+1;i++)
		cout<<" "<<G.rowIndex[i];
	cout<<endl;
	for(i=0;i<m+n;i++)
		printf(" %.8f", G.b[i]);
	cout<<endl;
	for(i=0;i<m+n;i++)
		printf(" %.8f", G.x[i]);
	cout<<endl;	
	
	
	for(i=0;i<m+n;i++)
	{
		cout<<endl;
		int startindex=G.rowIndex[i];
		int endindex=G.rowIndex[i+1];
		for(j=startindex;j<endindex;j++)
			cout<<" "<<G.Mat_val[j];
		cout<<endl;
		
	}
*/
/*	for (i=0;i<m+n+1;i++)
	{
		//cout<<endl;
		if(G.rowIndex[i]==G.rowIndex[i+1])
			break;
		
		for(j=G.rowIndex[i];j<G.rowIndex[i+1];j++)
		{
			if(G.Mat_val[j]>10)
				cout<<G.Mat_val[j]<<"\t";
		}
		//cout<<endl;
		/*for(j=G.rowIndex[i];j<G.rowIndex[i+1];j++)
		{
			cout<<G.columns[j]<<"\t";
		}
		//cout<<endl;
	}
	cout<<endl;
*/

//printing the matrix
	printf("\n Fine till here");
	printf("\n");
//	int* rowmIndex=(int*)calloc(m+1,sizeof(int));
	printf("\n Fine till here");
	printf("\n");
	//int rowmIndex[5]={1,2,3,4,5};
/*	for(i=0;i<m+1;i++)
	{
		rowmIndex[i]=G.rowIndex[i];
		printf(" %d", rowmIndex[i]);
	}
*/
	printf("\n Allocating GPU memory\n");
	cudaDeviceReset();
	size_t free, total;
	cudaMemGetInfo(&free, &total);
	printf("\n Free Mem = %lf MB, Total mem = %lf MB\n", (double)(free)/(1024*1024), (double)(total)/(1024*1024));


	double *dev_csrValA, *dev_b, *dev_x;
	int *dev_csrRowIdxA, *dev_csrColA;

	double *dev_GcsrVal, *dev_b1, *dev_x1;
	double *dev_PcsrVal, *dev_b2, *dev_x2;
	
	int *dev_GcsrRowIdx, *dev_PcsrRowIdx, *dev_GcsrCol, *dev_PcsrCol;
	

	
	cudaMalloc((void**)&dev_PcsrVal, G.Pnonzero*sizeof(double));
	cudaMalloc((void**)&dev_PcsrRowIdx, (m+1)*sizeof(int));
	cudaMalloc((void**)&dev_PcsrCol, G.Pnonzero*sizeof(int));


	cudaMalloc((void**)&dev_b1, (m)*sizeof(double));
	cudaMalloc((void**)&dev_b2, n*sizeof(double));
	cudaMalloc((void**)&dev_x1, m*sizeof(double));
	cudaMalloc((void**)&dev_x2, n*sizeof(double));

	cudaMemcpy(dev_b1, G.b1, (m)*sizeof(double), cudaMemcpyHostToDevice);
	cudaMemcpy(dev_x1, G.x1, (m)*sizeof(double), cudaMemcpyHostToDevice);

	cudaMemcpy(dev_PcsrVal, G.Pmat, G.Pnonzero*sizeof(double), cudaMemcpyHostToDevice);
	cudaMemcpy(dev_b2, G.b2, (n)*sizeof(double), cudaMemcpyHostToDevice);
	cudaMemcpy(dev_x2, G.x2, (n)*sizeof(double), cudaMemcpyHostToDevice);
	cudaMemcpy(dev_PcsrRowIdx, G.ProwIndex, (m+1)*sizeof(int), cudaMemcpyHostToDevice);
	cudaMemcpy(dev_PcsrCol, G.Pcolumns, (G.Pnonzero)*sizeof(int), cudaMemcpyHostToDevice);


	/* Matrix has been created and stored in CSR format.
	However, CHOLMOD requires CSC format. Since our matrix is symmetric positive definite, we can simply swap 
	csrColA with csrRowIdx and vice versa
	*/

	/* Starting the CHOLMOD routine now*/
	printf("\n Initiating CHOLMOD\n");
	cholmod_sparse *A, *P;
	cholmod_dense *x, *b, *r, *midvec;
	cholmod_factor *L;
	cholmod_common *Common, cm;
	Common = &cm;
	cholmod_l_start(Common);
//	&Common->useGPU=1;
	printf("\n m = %d, G.Gnonzero = %d\n", m, G.Gnonzero);	


	
	cholmod_sparse *C = cholmod_l_allocate_sparse((size_t)(m), (size_t)(m), (size_t)(G.Gnonzero), 1, 0, 1, 1, Common); 
//	P = cholmod_l_allocate_sparse((size_t)(m), (size_t)(n), (size_t)(G.Pnonzero), 1, 0, 0, 1, Common); 
//	printf("\n Allocated \n");

	C->itype = CHOLMOD_LONG;	
//	printf("\n Itype \n");
	C->p = &G.GrowIndex[0];
//	printf("\n Columns \n");
	C->nz = &Gnz[0];
//	printf("\n Rows \n");
	C->i = &G.Gcolumns[0];
	C->dtype = 0;
	C->x = &G.Gmat[0];
	 
/*	P->itype = CHOLMOD_LONG;
	P->p = &G.ProwIndex[0];
	P->nz = &Pnz[0];
	P->i = &G.Pcolumns[0];
	P->dtype = 0;
	P->x = &G.Pmat[0]; 
*/	 

	b = cholmod_l_allocate_dense((size_t)(m), 1, (size_t)(m), 1, Common);
	b->dtype=0;
	b->x = &G.b1[0];
	b->xtype = 1;

	printf("\n CHOLMOD manually set\n");
	cholmod_l_print_sparse(C, "A", Common);
	cholmod_l_print_dense(b, "b", Common);


	cudaEvent_t start, stop;
	cudaEventCreate(&start);
	cudaEventCreate(&stop);

	cudaEventRecord(start, 0);

	L = cholmod_l_analyze(C, Common);
	printf("\n Analysis: Flops: %g \t lnz: %g\n", Common->fl, Common->lnz);
	cholmod_l_factorize(C, L, Common);
	x = cholmod_l_solve(CHOLMOD_A, L, b, Common);
	
	cudaEventRecord(stop, 0);
	cudaEventSynchronize(stop);
	
	

	float elapsedTime;
	cudaEventElapsedTime(&elapsedTime, start, stop);
	printf("\n Time : %.6f secs :\n", elapsedTime);
	
	cholmod_l_print_dense(x, "X", Common);
	
	double *x1_mod = (double*)x->x;
	
	cudaMemcpy(dev_x1, x1_mod, m*sizeof(double), cudaMemcpyHostToDevice);
	
	cusparseStatus_t cuSparseStatus;
	cusparseHandle_t cuspHandle;
	cuSparseStatus = cusparseCreate(&cuspHandle);

	cusparseMatDescr_t descrP;
	cusparseCreateMatDescr(&descrP);

	cusparseSetMatType(descrP, CUSPARSE_MATRIX_TYPE_GENERAL);	
	cusparseSetMatIndexBase(descrP, CUSPARSE_INDEX_BASE_ZERO);
	
	
	double *dev_res1, *dev_simple;
	double *res1 = (double*)calloc(n,sizeof(double));
	cudaMalloc((void**)&dev_res1, n*sizeof(double));
	cudaMalloc((void**)&dev_simple, n*sizeof(double));
	
	const double alpha = 1.0, beta=0.0;
	//alpha = 1.0;
	//beta = 0.0;
	
	//solving P^T * G^-1 * b1 Result stored in dev_res1
	
	cuSparseStatus = cusparseDcsrmv(cuspHandle, CUSPARSE_OPERATION_TRANSPOSE, m, n, G.Pnonzero, &alpha, descrP, dev_PcsrVal, dev_PcsrRowIdx, dev_PcsrCol, dev_x1, &beta, dev_res1);
		
	if(cuSparseStatus == CUSPARSE_STATUS_SUCCESS)
	{
/*		cudaMemcpy(res1, dev_res1, n*sizeof(double), cudaMemcpyDeviceToHost);
		for(i=0;i<n;i++)
		{
			printf("\nres1[%d] = %.8f", i, res1[i]);
		}
		printf("\n P^T * G^-1 * b1 done! Vector stored in res1");
*/	}
	else
	{
		printf("\n P^T * G^-1 * b1 failed\n");
		exit(1);
	}
	
	const double alphaneg = -1.0;
		
		//Solving P^T * G^-1 * b1 - b2 ; Result stored in dev_res1
	
		
	cublasStatus_t cuBlasStatus;
	cublasHandle_t cubHandle;
	cuBlasStatus = cublasCreate(&cubHandle);
		
	cuBlasStatus = cublasDaxpy(cubHandle, n, &alphaneg, dev_b2, 1, dev_res1, 1);
	if(cuBlasStatus == CUBLAS_STATUS_SUCCESS)
	{
//		cudaMemcpy(res1, dev_res1, n*sizeof(double), cudaMemcpyDeviceToHost);
//		for(i=0;i<n;i++)
//		{
//			printf("\nres1[%d] = %.8f", i, res1[i]);
//		}
		printf("\n res1 = res1 - b2 done\n");
		 
	}
	else
	{
		printf("\n res1 = res1 - b2 failed\n");
	}
		
	
	
	
	///NOW COMPUTING G^-1 * P
	
	
	int k = 0;
	int breakloop=0;
	
	double **midMat = (double**)malloc(m*sizeof(double*));
	for(i=0;i<m;i++)
	{
		midMat[i] = (double*)calloc(n,sizeof(double));
	}
	
	cudaEventRecord(start, 0);
	
	for(i=0;i<n;i++)
	{
		breakloop = 0;
		double *vect = (double*)calloc(m,sizeof(double*));

		for(j=0;j<m;j++)
		{
			int startin = G.ProwIndex[j];
			int endin = G.ProwIndex[j+1];
			if(startin == endin)
				continue;
				
			k = startin;

			while(k<endin)
			{

				if(G.Pcolumns[k] == i)
				{	
					vect[j] = G.Pmat[k];
					breakloop=1;
					break;
				
				}
				k++;
			}
			if(breakloop == 1)
			{
				break;
			}
		}
		
		midvec = cholmod_l_allocate_dense((size_t)(m), 1, (size_t)(m), 1, Common);
		midvec->dtype=0;
		midvec->x=&vect[0];
		midvec->xtype = 1;
		
		cholmod_dense *res2;
		
		res2 = cholmod_l_solve(CHOLMOD_A, L, midvec, Common);

		
		double *re = (double*)res2->x;
		
//		printf("\n vector %d is:\n", i);
		int i1, j1, k1;
//		for(j1=0;j1<m;j1++)
//		{
//			midmat2flat[i+j1*n] = re[j1];
//			printf(" %lf", re[j1]);
//		}
//		printf("\n");
		for(i1=0;i1<m;i1++)
		{
			midMat[i1][i] = re[i1];
		}
		
		cholmod_l_free_dense(&midvec, Common);
			
	}
	
/*	printf("\n Midmat = \n");
	for(i=0;i<m;i++)
	{
		for(j=0;j<n;j++)
		{
			printf(" %lf", midMat[i][j]);
		}
		printf("\n");
	} 
*/
	double *midMatflat = (double*)calloc((m*n),sizeof(double));
	double *dev_midMat;
	double *dev_solut;
	int counter = 0;
	for(i=0;i<n;i++)
	{
		for(j=0;j<m;j++)
		{
			midMatflat[counter] = midMat[j][i];
			counter++; 
		}
	}
	
	cudaMalloc((void**)&dev_midMat, m*n*sizeof(double));
	cudaMalloc((void**)&dev_solut, n*n*sizeof(double));
	
	cudaMemcpy(dev_midMat, midMatflat, m*n*sizeof(double), cudaMemcpyHostToDevice);
		
	//Solving P^T * midMat; Result stored in dev_solut
		
	cuSparseStatus = cusparseDcsrmm(cuspHandle, CUSPARSE_OPERATION_TRANSPOSE, m, n, n, G.Pnonzero, &alpha, descrP, dev_PcsrVal, dev_PcsrRowIdx, dev_PcsrCol, dev_midMat, m, &beta, dev_solut, n);
	
	if(cuSparseStatus == CUSPARSE_STATUS_SUCCESS)
	{
		printf("\n Solved P^T * G^-1 * P. Result stored in solut\n");
		
	}  
	else
	{
		printf("\n  Failed to Solve P^T * G^-1 * P \n");
		exit(1);
	}

/*	double *matGflat = (double*)calloc(n*n,sizeof(double));
	cudaMemcpy(matGflat, dev_solut, n*n*sizeof(double), cudaMemcpyDeviceToHost);
	counter = 0;
	printf("\nBefore LU starts\n");
	for(i=0;i<n;i++)
	{
		for(j=0;j<n;j++)
		{
			printf(" %lf ", matGflat[counter]);
			counter++;
		}
		printf("\n");
	}
	printf("\n");
*/	
	cusolverStatus_t cuSolverStatus;
	
	
	cusolverDnHandle_t cudenHandle;
	cuSolverStatus = cusolverDnCreate(&cudenHandle);
	int Lwork = 0;
	cuSolverStatus = cusolverDnDgetrf_bufferSize(cudenHandle, n, n, dev_solut, n, &Lwork);
	
	if(cuSolverStatus == CUSOLVER_STATUS_SUCCESS)
	{
		printf("\n Buffer works\n Lwork = %d\n", Lwork);
	}
	else
	{
		exit(1);	
	}
	double *dev_Workspace;
	int *dev_Ipiv, *dev_Info;
	
	cudaMalloc((void**)&dev_Workspace, Lwork*sizeof(double));
	cudaMalloc((void**)&dev_Ipiv, n*sizeof(int));
	cudaMalloc((void**)&dev_Info, sizeof(int));
	
	//Calculating LU for dev_solut
//	double *nnmat = (double*)calloc(n*n,sizeof(double));
//	cudaMemcpy(nnmat, dev_solut, n*n*sizeof(double), cudaMemcpyDeviceToHost);
//	cuSolverStatus = cusolverDnDgetrfHost(cudenHandle, n, n, 

	cuSolverStatus = cusolverDnDgetrf(cudenHandle, n, n, dev_solut, n, dev_Workspace, dev_Ipiv, dev_Info);
	
	if(cuSolverStatus == CUSOLVER_STATUS_SUCCESS)
	{
		printf("\n solut has be defactorized into L and U. dev_Ipiv * solut = L * U\n");
	}
	else
	{
	
		printf("\n Unable to defactorize solut into LU\n");
		exit(1);	
	}
	
	//solving dev_solut * x = dev_res1. Result stored in dev_res1
	
	cuSolverStatus = cusolverDnDgetrs(cudenHandle, CUBLAS_OP_N, n, 1, dev_solut, n, dev_Ipiv, dev_res1, n, dev_Info);
	if(cuSolverStatus == CUSOLVER_STATUS_SUCCESS)
	{
		printf("\n Solution obtained for x2 \n");
	}
	else
	{
		printf("\n LU decomposition obtained by LU solver failed\n");
	}

/*	cudaMemcpy(G.x2, dev_res1, n*sizeof(double), cudaMemcpyDeviceToHost);
	printf("\n x2 = \n");
	for(i=0;i<n;i++)
	{
		printf("\n x2[%d] = %lf", i, G.x2[i]); 
	}
*/	
	
	double *dev_dummy;
	cudaMalloc((void**)&dev_dummy, m*sizeof(double));
	cudaMemset(dev_dummy, 0.0, m*sizeof(double));
	
	printf("\n Starting solving for x1 \n");
	//Solving for x1
	
		//Solving G^-1 * P * x2;  G^-1 * P is stored in midMat
	cuBlasStatus = cublasDgemv(cubHandle, CUBLAS_OP_N, m, n, &alpha, dev_midMat, m, dev_res1, 1, &beta, dev_dummy, 1);
	if(cuBlasStatus == CUBLAS_STATUS_SUCCESS)
	{
/*		double *toprint = (double*)calloc(m,sizeof(double));
		cudaMemcpy(toprint, dev_dummy, m*sizeof(double), cudaMemcpyDeviceToHost);
		printf("\n Intermediate vector :\n");
		for(i=0;i<m;i++)
		{
			printf("\ndummy[%d] = %lf", i, toprint[i]);
		}
*/		printf("\n midmat * x2 obtained. Stored in dummy\n");
	}
	else
	{
		printf("\n Failed to obtain midmat * x2\n");
	}
	
	cuBlasStatus = cublasDaxpy(cubHandle, m, &alphaneg, dev_dummy, 1, dev_x1, 1);
	if(cuBlasStatus == CUBLAS_STATUS_SUCCESS)
	{
/*		cudaMemcpy(G.x1, dev_x1, m*sizeof(double), cudaMemcpyDeviceToHost);
		printf("\n x1 = \n");
		for(i=0;i<m;i++)
		{
			printf("\n x1[%d] = %.15f", i, G.x1[i]);
		}
*/		printf("\n x1 obtained");
	}
	else
	{
		printf("\n Failed to obtain x1");
	}

	printf("\n Solver finished its work\n");

/*		cudaEventRecord(stop, 0);
		cudaEventSynchronize(stop);

		cudaEventElapsedTime(&elapsedTime, start, stop);
		printf("\n Time: %.6f msecs :\n", elapsedTime);
*/








	
	
	
	
	

	cholmod_l_finish(Common);
	return 0;

} 
Example #8
0
void mexFunction
(
    int	nargout,
    mxArray *pargout [ ],
    int	nargin,
    const mxArray *pargin [ ]
)
{
    double dummy = 0, beta [2], *px ;
    cholmod_sparse Amatrix, *A, *Lsparse ;
    cholmod_factor *L ;
    cholmod_common Common, *cm ;
    Long n, minor ;

    /* ---------------------------------------------------------------------- */
    /* start CHOLMOD and set parameters */ 
    /* ---------------------------------------------------------------------- */

    cm = &Common ;
    cholmod_l_start (cm) ;
    sputil_config (SPUMONI, cm) ;

    /* convert to packed LDL' when done */
    cm->final_asis = FALSE ;
    cm->final_super = FALSE ;
    cm->final_ll = FALSE ;
    cm->final_pack = TRUE ;
    cm->final_monotonic = TRUE ;

    /* since numerically zero entries are NOT dropped from the symbolic
     * pattern, we DO need to drop entries that result from supernodal
     * amalgamation. */
    cm->final_resymbol = TRUE ;

    cm->quick_return_if_not_posdef = (nargout < 2) ;

    /* This will disable the supernodal LL', which will be slow. */
    /* cm->supernodal = CHOLMOD_SIMPLICIAL ; */

    /* ---------------------------------------------------------------------- */
    /* get inputs */
    /* ---------------------------------------------------------------------- */

    if (nargin < 1 || nargin > 2 || nargout > 3)
    {
	mexErrMsgTxt ("usage: [L,p,q] = ldlchol (A,beta)") ;
    }

    n = mxGetM (pargin [0]) ;

    if (!mxIsSparse (pargin [0]))
    {
    	mexErrMsgTxt ("A must be sparse") ;
    }
    if (nargin == 1 && n != mxGetN (pargin [0]))
    {
    	mexErrMsgTxt ("A must be square") ;
    }

    /* get sparse matrix A, use tril(A)  */
    A = sputil_get_sparse (pargin [0], &Amatrix, &dummy, -1) ; 

    if (nargin == 1)
    {
	A->stype = -1 ;	    /* use lower part of A */
	beta [0] = 0 ;
	beta [1] = 0 ;
    }
    else
    {
	A->stype = 0 ;	    /* use all of A, factorizing A*A' */
	beta [0] = mxGetScalar (pargin [1]) ;
	beta [1] = 0 ;
    }

    /* use natural ordering if no q output parameter */
    if (nargout < 3)
    {
	cm->nmethods = 1 ;
	cm->method [0].ordering = CHOLMOD_NATURAL ;
	cm->postorder = FALSE ;
    }

    /* ---------------------------------------------------------------------- */
    /* analyze and factorize */
    /* ---------------------------------------------------------------------- */

    L = cholmod_l_analyze (A, cm) ;
    cholmod_l_factorize_p (A, beta, NULL, 0, L, cm) ;

    if (nargout < 2 && cm->status != CHOLMOD_OK)
    {
	mexErrMsgTxt ("matrix is not positive definite") ;
    }

    /* ---------------------------------------------------------------------- */
    /* convert L to a sparse matrix */
    /* ---------------------------------------------------------------------- */

    /* the conversion sets L->minor back to n, so get a copy of it first */
    minor = L->minor ;
    Lsparse = cholmod_l_factor_to_sparse (L, cm) ;
    if (Lsparse->xtype == CHOLMOD_COMPLEX)
    {
	/* convert Lsparse from complex to zomplex */
	cholmod_l_sparse_xtype (CHOLMOD_ZOMPLEX, Lsparse, cm) ;
    }

    /* ---------------------------------------------------------------------- */
    /* return results to MATLAB */
    /* ---------------------------------------------------------------------- */

    /* return L as a sparse matrix (it may contain numerically zero entries) */
    pargout [0] = sputil_put_sparse (&Lsparse, cm) ;

    /* return minor (translate to MATLAB convention) */
    if (nargout > 1)
    {
	pargout [1] = mxCreateDoubleMatrix (1, 1, mxREAL) ;
	px = mxGetPr (pargout [1]) ;
	px [0] = ((minor == n) ? 0 : (minor+1)) ;
    }

    /* return permutation */
    if (nargout > 2)
    {
	pargout [2] = sputil_put_int (L->Perm, n, 1) ;
    }

    /* ---------------------------------------------------------------------- */
    /* free workspace and the CHOLMOD L, except for what is copied to MATLAB */
    /* ---------------------------------------------------------------------- */

    cholmod_l_free_factor (&L, cm) ;
    cholmod_l_finish (cm) ;
    cholmod_l_print_common (" ", cm) ;
    /*
    if (cm->malloc_count != 3 + mxIsComplex (pargout[0])) mexErrMsgTxt ("!") ;
    */
}
Example #9
0
void mexFunction
(
    int nargout,
    mxArray *pargout [ ],
    int nargin,
    const mxArray *pargin [ ]
)
{
    double dummy = 0 ;
    double *Lx, *px ;
    Int *Parent, *Post, *ColCount, *First, *Level, *Rp, *Ri, *Lp, *Li, *W ;
    cholmod_sparse *A, Amatrix, *F, *Aup, *Alo, *R, *A1, *A2, *L, *S ;
    cholmod_common Common, *cm ;
    Int n, i, coletree, j, lnz, p, k, height, c ;
    char buf [LEN] ;

    /* ---------------------------------------------------------------------- */
    /* start CHOLMOD and set defaults */
    /* ---------------------------------------------------------------------- */

    cm = &Common ;
    cholmod_l_start (cm) ;
    sputil_config (SPUMONI, cm) ;

    /* ---------------------------------------------------------------------- */
    /* get inputs */
    /* ---------------------------------------------------------------------- */

    if (nargout > 5 || nargin < 1 || nargin > 3)
    {
	mexErrMsgTxt (
	    "Usage: [count h parent post R] = symbfact2 (A, mode, Lmode)") ;
    }

    /* ---------------------------------------------------------------------- */
    /* get input matrix A */
    /* ---------------------------------------------------------------------- */

    A = sputil_get_sparse_pattern (pargin [0], &Amatrix, &dummy, cm) ;
    S = (A == &Amatrix) ? NULL : A ;

    /* ---------------------------------------------------------------------- */
    /* get A->stype, default is to use triu(A) */
    /* ---------------------------------------------------------------------- */

    A->stype = 1 ;
    n = A->nrow ;
    coletree = FALSE ;
    if (nargin > 1)
    {
	buf [0] = '\0' ;
	if (mxIsChar (pargin [1]))
	{
	    mxGetString (pargin [1], buf, LEN) ;
	}
	c = buf [0] ;
	if (tolower (c) == 'r')
	{
	    /* unsymmetric case (A*A') if string starts with 'r' */
	    A->stype = 0 ;
	}
	else if (tolower (c) == 'c')
	{
	    /* unsymmetric case (A'*A) if string starts with 'c' */
	    n = A->ncol ;
	    coletree = TRUE ;
	    A->stype = 0 ;
	}
	else if (tolower (c) == 's')
	{
	    /* symmetric upper case (A) if string starts with 's' */
	    A->stype = 1 ;
	}
	else if (tolower (c) == 'l')
	{
	    /* symmetric lower case (A) if string starts with 'l' */
	    A->stype = -1 ;
	}
	else
	{
	    mexErrMsgTxt ("symbfact2: unrecognized mode") ;
	}
    }

    if (A->stype && A->nrow != A->ncol)
    {
	mexErrMsgTxt ("symbfact2: A must be square") ;
    }

    /* ---------------------------------------------------------------------- */
    /* compute the etree, its postorder, and the row/column counts */
    /* ---------------------------------------------------------------------- */

    Parent = cholmod_l_malloc (n, sizeof (Int), cm) ;
    Post = cholmod_l_malloc (n, sizeof (Int), cm) ;
    ColCount = cholmod_l_malloc (n, sizeof (Int), cm) ;
    First = cholmod_l_malloc (n, sizeof (Int), cm) ;
    Level = cholmod_l_malloc (n, sizeof (Int), cm) ;

    /* F = A' */
    F = cholmod_l_transpose (A, 0, cm) ;

    if (A->stype == 1 || coletree)
    {
	/* symmetric upper case: find etree of A, using triu(A) */
	/* column case: find column etree of A, which is etree of A'*A */
	Aup = A ;
	Alo = F ;
    }
    else
    {
	/* symmetric lower case: find etree of A, using tril(A) */
	/* row case: find row etree of A, which is etree of A*A' */
	Aup = F ;
	Alo = A ;
    }

    cholmod_l_etree (Aup, Parent, cm) ;

    if (cm->status < CHOLMOD_OK)
    {
	/* out of memory or matrix invalid */
	mexErrMsgTxt ("symbfact2 failed: matrix corrupted!") ;
    }

    if (cholmod_l_postorder (Parent, n, NULL, Post, cm) != n)
    {
	/* out of memory or Parent invalid */
	mexErrMsgTxt ("symbfact2 postorder failed!") ;
    }

    /* symmetric upper case: analyze tril(F), which is triu(A) */
    /* column case: analyze F*F', which is A'*A */
    /* symmetric lower case: analyze tril(A) */
    /* row case: analyze A*A' */
    cholmod_l_rowcolcounts (Alo, NULL, 0, Parent, Post, NULL, ColCount,
		First, Level, cm) ;

    if (cm->status < CHOLMOD_OK)
    {
	/* out of memory or matrix invalid */
	mexErrMsgTxt ("symbfact2 failed: matrix corrupted!") ;
    }

    /* ---------------------------------------------------------------------- */
    /* return results to MATLAB: count, h, parent, and post */
    /* ---------------------------------------------------------------------- */

    pargout [0] = sputil_put_int (ColCount, n, 0) ;
    if (nargout > 1)
    {
	/* compute the elimination tree height */
	height = 0 ;
	for (i = 0 ; i < n ; i++)
	{
	    height = MAX (height, Level [i]) ;
	}
	height++ ;
	pargout [1] = mxCreateDoubleMatrix (1, 1, mxREAL) ;
	px = mxGetPr (pargout [1]) ;
	px [0] = height ;
    }
    if (nargout > 2)
    {
	pargout [2] = sputil_put_int (Parent, n, 1) ;
    }
    if (nargout > 3)
    {
	pargout [3] = sputil_put_int (Post, n, 1) ;
    }

    /* ---------------------------------------------------------------------- */
    /* construct L, if requested */
    /* ---------------------------------------------------------------------- */

    if (nargout > 4)
    {

	if (A->stype == 1)
	{
	    /* symmetric upper case: use triu(A) only, A2 not needed */
	    A1 = A ;
	    A2 = NULL ;
	}
	else if (A->stype == -1)
	{
	    /* symmetric lower case: use tril(A) only, A2 not needed */
	    A1 = F ;
	    A2 = NULL ;
	}
	else if (coletree)
	{
	    /* column case: analyze F*F' */
	    A1 = F ;
	    A2 = A ;
	}
	else
	{
	    /* row case: analyze A*A' */
	    A1 = A ;
	    A2 = F ;
	}

	/* count the total number of entries in L */
	lnz = 0 ;
	for (j = 0 ; j < n ; j++)
	{
	    lnz += ColCount [j] ;
	}

	/* allocate the output matrix L (pattern-only) */
	L = cholmod_l_allocate_sparse (n, n, lnz, TRUE, TRUE, 0,
	    CHOLMOD_PATTERN, cm) ;
	Lp = L->p ;
	Li = L->i ;

	/* initialize column pointers */
	lnz = 0 ;
	for (j = 0 ; j < n ; j++)
	{
	    Lp [j] = lnz ;
	    lnz += ColCount [j] ;
	}
	Lp [j] = lnz ;

	/* create a copy of the column pointers */
	W = First ;
	for (j = 0 ; j < n ; j++)
	{
	    W [j] = Lp [j] ;
	}

	/* get workspace for computing one row of L */
	R = cholmod_l_allocate_sparse (n, 1, n, FALSE, TRUE, 0, CHOLMOD_PATTERN,
		cm) ;
	Rp = R->p ;
	Ri = R->i ;

	/* compute L one row at a time */
	for (k = 0 ; k < n ; k++)
	{
	    /* get the kth row of L and store in the columns of L */
	    cholmod_l_row_subtree (A1, A2, k, Parent, R, cm) ;
	    for (p = 0 ; p < Rp [1] ; p++)
	    {
		Li [W [Ri [p]]++] = k ;
	    }
	    /* add the diagonal entry */
	    Li [W [k]++] = k ;
	}

	/* free workspace */
	cholmod_l_free_sparse (&R, cm) ;

	/* transpose L to get R, or leave as is */
	if (nargin < 3)
	{
	    /* R = L' */
	    R = cholmod_l_transpose (L, 0, cm) ;
	    cholmod_l_free_sparse (&L, cm) ;
	    L = R ;
	}

	/* fill numerical values of L with one's (only MATLAB needs this...) */
	L->x = cholmod_l_malloc (lnz, sizeof (double), cm) ;
	Lx = L->x ;
	for (p = 0 ; p < lnz ; p++)
	{
	    Lx [p] = 1 ;
	}
	L->xtype = CHOLMOD_REAL ;

	/* return L (or R) to MATLAB */
	pargout [4] = sputil_put_sparse (&L, cm) ;
    }

    /* ---------------------------------------------------------------------- */
    /* free workspace */
    /* ---------------------------------------------------------------------- */

    cholmod_l_free (n, sizeof (Int), Parent, cm) ;
    cholmod_l_free (n, sizeof (Int), Post, cm) ;
    cholmod_l_free (n, sizeof (Int), ColCount, cm) ;
    cholmod_l_free (n, sizeof (Int), First, cm) ;
    cholmod_l_free (n, sizeof (Int), Level, cm) ;
    cholmod_l_free_sparse (&F, cm) ;
    cholmod_l_free_sparse (&S, cm) ;
    cholmod_l_finish (cm) ;
    cholmod_l_print_common (" ", cm) ;
    /*
    if (cm->malloc_count != ((nargout == 5) ? 3:0)) mexErrMsgTxt ("!") ;
    */
}
Example #10
0
void mexFunction
(
    int nargout,
    mxArray *pargout [ ],
    int nargin,
    const mxArray *pargin [ ]
)
{
    Int *P, *Q, *Rp, *Pinv ;
    double *Ax, dummy, tol ;
    Int m, n, anz, is_complex, n1rows, n1cols, i, k ;
    cholmod_sparse *A, Amatrix, *Y ;
    cholmod_common Common, *cc ;

    // -------------------------------------------------------------------------
    // start CHOLMOD and set parameters
    // -------------------------------------------------------------------------

    cc = &Common ;
    cholmod_l_start (cc) ;
    spqr_mx_config (SPUMONI, cc) ;

    // -------------------------------------------------------------------------
    // check inputs
    // -------------------------------------------------------------------------

    if (nargout > 5)
    {
        mexErrMsgIdAndTxt ("MATLAB:maxlhs", "Too many output arguments") ;
    }
    if (nargin < 1)
    {
        mexErrMsgIdAndTxt ("MATLAB:minrhs", "Not enough input arguments") ;
    }
    if (nargin > 2)
    {
        mexErrMsgIdAndTxt ("MATLAB:maxrhs", "Too many input arguments") ;
    }

    // -------------------------------------------------------------------------
    // get the input matrix A and convert to merged-complex if needed
    // -------------------------------------------------------------------------

    if (!mxIsSparse (pargin [0]))
    {
        mexErrMsgIdAndTxt ("QR:invalidInput", "A must be sparse") ;
    }

    A = spqr_mx_get_sparse (pargin [0], &Amatrix, &dummy) ;
    m = A->nrow ;
    n = A->ncol ;
    is_complex = mxIsComplex (pargin [0]) ;
    Ax = spqr_mx_merge_if_complex (pargin [0], is_complex, &anz, cc) ; 
    if (is_complex)
    {
        // A has been converted from real or zomplex to complex
        A->x = Ax ;
        A->z = NULL ;
        A->xtype = CHOLMOD_COMPLEX ;
    }

    // -------------------------------------------------------------------------
    // get the tolerance
    // -------------------------------------------------------------------------

    if (nargin < 2)
    {
        tol = is_complex ? spqr_tol <Complex> (A,cc) : spqr_tol <double> (A,cc);
    }
    else
    {
        tol = mxGetScalar (pargin [1]) ;
    }

    // -------------------------------------------------------------------------
    // find the singletons
    // -------------------------------------------------------------------------

    if (is_complex)
    {
        spqr_1colamd <Complex> (SPQR_ORDERING_NATURAL, tol, 0, A,
            &Q, &Rp, &Pinv, &Y, &n1cols, &n1rows, cc) ;
    }
    else
    {
        spqr_1colamd <double> (SPQR_ORDERING_NATURAL, tol, 0, A,
            &Q, &Rp, &Pinv, &Y, &n1cols, &n1rows, cc) ;
    }

    // -------------------------------------------------------------------------
    // free unused outputs from spqr_1colamd, and the merged-complex copy of A
    // -------------------------------------------------------------------------

    cholmod_l_free (n1rows+1, sizeof (Int), Rp, cc) ;
    cholmod_l_free_sparse (&Y, cc) ;
    if (is_complex)
    {
        // this was allocated by merge_if_complex
        cholmod_l_free (anz, sizeof (Complex), Ax, cc) ;
    }

    // -------------------------------------------------------------------------
    // find P from Pinv
    // -------------------------------------------------------------------------

    P = (Int *) cholmod_l_malloc (m, sizeof (Int), cc) ;
    for (i = 0 ; i < m ; i++)
    {
        k = Pinv ? Pinv [i] : i ;
        P [k] = i ;
    }
    cholmod_l_free (m, sizeof (Int), Pinv, cc) ;

    // -------------------------------------------------------------------------
    // return results
    // -------------------------------------------------------------------------

    pargout [0] = spqr_mx_put_permutation (P, m, TRUE, cc) ;
    cholmod_l_free (m, sizeof (Int), P, cc) ;
    if (nargout > 1) pargout [1] = spqr_mx_put_permutation (Q, n, TRUE, cc) ;
    cholmod_l_free (n, sizeof (Int), Q, cc) ;
    if (nargout > 2) pargout [2] = mxCreateDoubleScalar ((double) n1rows) ;
    if (nargout > 3) pargout [3] = mxCreateDoubleScalar ((double) n1cols) ;
    if (nargout > 4) pargout [4] = mxCreateDoubleScalar (tol) ;

    cholmod_l_finish (cc) ;
}
Example #11
0
void mexFunction
(
    int nargout,
    mxArray *pargout [ ],
    int nargin,
    const mxArray *pargin [ ]
)
{
    Int *Bp, *Bi ;
    double *Ax, *Bx, dummy ;
    Int m, n, k, bncols, p, i, rank, A_complex, B_complex, is_complex,
        anz, bnz ;
    spqr_mx_options opts ;
    cholmod_sparse *A, Amatrix, *Xsparse ; 
    cholmod_dense *Xdense ;
    cholmod_common Common, *cc ;
    char msg [LEN+1] ;

#ifdef TIMING
    double t0 = (nargout > 1) ? spqr_time ( ) : 0 ;
#endif

    // -------------------------------------------------------------------------
    // start CHOLMOD and set parameters
    // -------------------------------------------------------------------------

    cc = &Common ;
    cholmod_l_start (cc) ;
    spqr_mx_config (SPUMONI, cc) ;

    // -------------------------------------------------------------------------
    // check inputs
    // -------------------------------------------------------------------------

    if (nargout > 2)
    {
        mexErrMsgIdAndTxt ("MATLAB:maxlhs", "Too many output arguments") ;
    }
    if (nargin < 2)
    {
        mexErrMsgIdAndTxt ("MATLAB:minrhs", "Not enough input arguments") ;
    }
    if (nargin > 3)
    {
        mexErrMsgIdAndTxt ("MATLAB:maxrhs", "Too many input arguments") ;
    }

    // -------------------------------------------------------------------------
    // get the input matrix A (must be sparse)
    // -------------------------------------------------------------------------

    if (!mxIsSparse (pargin [0]))
    {
        mexErrMsgIdAndTxt ("QR:invalidInput", "A must be sparse") ;
    }

    A = spqr_mx_get_sparse (pargin [0], &Amatrix, &dummy) ;
    m = A->nrow ;
    n = A->ncol ;
    A_complex = mxIsComplex (pargin [0]) ;

    B_complex = mxIsComplex (pargin [1]) ;
    is_complex = (A_complex || B_complex) ;
    Ax = spqr_mx_merge_if_complex (pargin [0], is_complex, &anz, cc) ; 
    if (is_complex)
    {
        // A has been converted from real or zomplex to complex
        A->x = Ax ;
        A->z = NULL ;
        A->xtype = CHOLMOD_COMPLEX ;
    }

    // -------------------------------------------------------------------------
    // determine usage and parameters
    // -------------------------------------------------------------------------

    spqr_mx_get_options ((nargin < 3) ? NULL : pargin [2], &opts, m, 3, cc) ;

    opts.Qformat = SPQR_Q_DISCARD ;
    opts.econ = 0 ;
    opts.permvector = TRUE ;
    opts.haveB = TRUE ;

    // -------------------------------------------------------------------------
    // get the input matrix B (sparse or dense)
    // -------------------------------------------------------------------------

    if (!mxIsNumeric (pargin [1]))
    {
        mexErrMsgIdAndTxt ("QR:invalidInput", "invalid non-numeric B") ;
    }
    if (mxGetM (pargin [1]) != m)
    {
        mexErrMsgIdAndTxt ("QR:invalidInput",
            "A and B must have the same number of rows") ;
    }

    cholmod_sparse Bsmatrix, *Bsparse ;
    cholmod_dense  Bdmatrix, *Bdense ;

    // convert from real or zomplex to complex
    Bx = spqr_mx_merge_if_complex (pargin [1], is_complex, &bnz, cc) ;

    int B_is_sparse = mxIsSparse (pargin [1]) ;
    if (B_is_sparse)
    {
        Bsparse = spqr_mx_get_sparse (pargin [1], &Bsmatrix, &dummy) ;
        Bdense = NULL ;
        if (is_complex)
        {
            // Bsparse has been converted from real or zomplex to complex
            Bsparse->x = Bx ;
            Bsparse->z = NULL ;
            Bsparse->xtype = CHOLMOD_COMPLEX ;
        }
    }
    else
    {
        Bsparse = NULL ;
        Bdense = spqr_mx_get_dense (pargin [1], &Bdmatrix, &dummy) ;
        if (is_complex)
        {
            // Bdense has been converted from real or zomplex to complex
            Bdense->x = Bx ;
            Bdense->z = NULL ;
            Bdense->xtype = CHOLMOD_COMPLEX ;
        }
    }

    // -------------------------------------------------------------------------
    // X = A\B
    // -------------------------------------------------------------------------

    if (opts.min2norm && m < n)
    {
#ifndef NEXPERT
        // This requires SuiteSparseQR_expert.cpp
        if (is_complex)
        {
            if (B_is_sparse)
            {
                // X and B are both sparse and complex
                Xsparse = SuiteSparseQR_min2norm <Complex> (opts.ordering,
                    opts.tol, A, Bsparse, cc) ;
                pargout [0] = spqr_mx_put_sparse (&Xsparse, cc) ;
            }
            else
            {
                // X and B are both dense and complex
                Xdense = SuiteSparseQR_min2norm <Complex> (opts.ordering,
                    opts.tol, A, Bdense, cc) ;
                pargout [0] = spqr_mx_put_dense (&Xdense, cc) ;
            }
        }
        else
        {
            if (B_is_sparse)
            {
                // X and B are both sparse and real
                Xsparse = SuiteSparseQR_min2norm <double> (opts.ordering,
                    opts.tol, A, Bsparse, cc) ;
                pargout [0] = spqr_mx_put_sparse (&Xsparse, cc) ;
            }
            else
            {
                // X and B are both dense and real
                Xdense = SuiteSparseQR_min2norm <double> (opts.ordering,
                    opts.tol, A, Bdense, cc) ;
                pargout [0] = spqr_mx_put_dense (&Xdense, cc) ;
            }
        }
#else
        mexErrMsgIdAndTxt ("QR:notInstalled", "min2norm method not installed") ;
#endif

    }
    else
    {

        if (is_complex)
        {
            if (B_is_sparse)
            {
                // X and B are both sparse and complex
                Xsparse = SuiteSparseQR <Complex> (opts.ordering, opts.tol,
                    A, Bsparse, cc) ;
                pargout [0] = spqr_mx_put_sparse (&Xsparse, cc) ;
            }
            else
            {
                // X and B are both dense and complex
                Xdense = SuiteSparseQR <Complex> (opts.ordering, opts.tol,
                    A, Bdense, cc) ;
                pargout [0] = spqr_mx_put_dense (&Xdense, cc) ;
            }
        }
        else
        {
            if (B_is_sparse)
            {
                // X and B are both sparse and real
                Xsparse = SuiteSparseQR <double> (opts.ordering, opts.tol,
                    A, Bsparse, cc) ;
                pargout [0] = spqr_mx_put_sparse (&Xsparse, cc) ;
            }
            else
            {
                // X and B are both dense and real
                Xdense = SuiteSparseQR <double> (opts.ordering, opts.tol,
                    A, Bdense, cc) ;
                pargout [0] = spqr_mx_put_dense (&Xdense, cc) ;
            }
        }
    }

    // -------------------------------------------------------------------------
    // info output
    // -------------------------------------------------------------------------

    if (nargout > 1)
    {
#ifdef TIMING
        double flops = cc->other1 [0] ;
        double t = spqr_time ( ) - t0 ;
#else
        double flops = -1 ;
        double t = -1 ;
#endif
        pargout [1] = spqr_mx_info (cc, t, flops) ;
    }

    // -------------------------------------------------------------------------
    // warn if rank deficient
    // -------------------------------------------------------------------------

    rank = cc->SPQR_istat [4] ;
    if (rank < MIN (m,n))
    {
        // snprintf would be safer, but Windows is oblivious to safety ...
        // (Visual Studio C++ 2008 does not recognize snprintf!)
        sprintf (msg, "rank deficient. rank = %ld tol = %g\n", rank,
            cc->SPQR_xstat [1]) ;
        mexWarnMsgIdAndTxt ("MATLAB:rankDeficientMatrix", msg) ;
    }

    if (is_complex)
    {
        // free the merged complex copies of A and B
        cholmod_l_free (anz, sizeof (Complex), Ax, cc) ;
        cholmod_l_free (bnz, sizeof (Complex), Bx, cc) ;
    }

    cholmod_l_finish (cc) ;
    if (opts.spumoni > 0) spqr_mx_spumoni (&opts, is_complex, cc) ;
}
Example #12
0
File: metis.c Project: GHilmarG/Ua
void mexFunction
(
    int nargout,
    mxArray *pargout [ ],
    int nargin,
    const mxArray *pargin [ ]
)
{
#ifndef NPARTITION
    double dummy = 0 ;
    Long *Perm ;
    cholmod_sparse *A, Amatrix, *C, *S ;
    cholmod_common Common, *cm ;
    Long n, transpose, c, postorder ;
    char buf [LEN] ;

    /* ---------------------------------------------------------------------- */
    /* start CHOLMOD and set defaults */
    /* ---------------------------------------------------------------------- */

    cm = &Common ;
    cholmod_l_start (cm) ;
    sputil_config (SPUMONI, cm) ;

    /* ---------------------------------------------------------------------- */
    /* get inputs */
    /* ---------------------------------------------------------------------- */

    if (nargout > 1 || nargin < 1 || nargin > 3)
    {
	mexErrMsgTxt ("Usage: p = metis (A, mode)") ;
    }

    /* ---------------------------------------------------------------------- */
    /* get input matrix A */
    /* ---------------------------------------------------------------------- */

    A = sputil_get_sparse_pattern (pargin [0], &Amatrix, &dummy, cm) ;
    S = (A == &Amatrix) ? NULL : A ;

    /* ---------------------------------------------------------------------- */
    /* get A->stype, default is to use tril(A) */
    /* ---------------------------------------------------------------------- */

    A->stype = -1 ;
    transpose = FALSE ;

    if (nargin > 1)
    {
	buf [0] = '\0' ;
	if (mxIsChar (pargin [1]))
	{
	    mxGetString (pargin [1], buf, LEN) ;
	}
	c = buf [0] ;
	if (tolower (c) == 'r')
	{
	    /* unsymmetric case (A*A') if string starts with 'r' */
	    transpose = FALSE ;
	    A->stype = 0 ;
	}
	else if (tolower (c) == 'c')
	{
	    /* unsymmetric case (A'*A) if string starts with 'c' */
	    transpose = TRUE ;
	    A->stype = 0 ;
	}
	else if (tolower (c) == 's')
	{
	    /* symmetric case (A) if string starts with 's' */
	    transpose = FALSE ;
	    A->stype = -1 ;
	}
	else
	{
	    mexErrMsgTxt ("metis: p=metis(A,mode) ; unrecognized mode") ;
	}
    }

    if (A->stype && A->nrow != A->ncol)
    {
	mexErrMsgTxt ("metis: A must be square") ;
    }

    C = NULL ;
    if (transpose)
    {
	/* C = A', and then order C*C' with METIS */
	C = cholmod_l_transpose (A, 0, cm) ;
	if (C == NULL)
	{
	    mexErrMsgTxt ("metis failed") ;
	}
	A = C ;
    }

    n = A->nrow ;

    /* ---------------------------------------------------------------------- */
    /* get workspace */
    /* ---------------------------------------------------------------------- */

    Perm = cholmod_l_malloc (n, sizeof (Long), cm) ;

    /* ---------------------------------------------------------------------- */
    /* order the matrix with CHOLMOD's interface to METIS_NodeND */ 
    /* ---------------------------------------------------------------------- */

    postorder = (nargin < 3) ;
    if (!cholmod_l_metis (A, NULL, 0, postorder, Perm, cm))
    {
	mexErrMsgTxt ("metis failed") ;
	return ;
    }

    /* ---------------------------------------------------------------------- */
    /* return Perm */
    /* ---------------------------------------------------------------------- */

    pargout [0] = sputil_put_int (Perm, n, 1) ;

    /* ---------------------------------------------------------------------- */
    /* free workspace */
    /* ---------------------------------------------------------------------- */

    cholmod_l_free (n, sizeof (Long), Perm, cm) ;
    cholmod_l_free_sparse (&C, cm) ;
    cholmod_l_free_sparse (&S, cm) ;
    cholmod_l_finish (cm) ;
    cholmod_l_print_common (" ", cm) ;
    /*
    if (cm->malloc_count != 0) mexErrMsgTxt ("!") ;
    */
#else
    mexErrMsgTxt ("METIS and the CHOLMOD Partition Module not installed\n") ;
#endif
}
Example #13
0
void mexFunction
(
    int nargout,
    mxArray *pargout [ ],
    int nargin,
    const mxArray *pargin [ ]
)
{
    int ki;
    double dummy = 0 ;
    double *Lx, *Lx2 ;
    Int *Li, *Lp, *Li2, *Lp2, *Lnz2, *ColCount ;
    cholmod_sparse Cmatrix, *R, *Lsparse ;
    cholmod_factor *L ;
    cholmod_common Common, *cm ;
    Int j, k, s, update, n, lnz ;
    char buf [LEN] ;

    /* ---------------------------------------------------------------------- */
    /* start CHOLMOD and set parameters */ 
    /* ---------------------------------------------------------------------- */

    cm = &Common ;
    cholmod_l_start (cm) ;
    sputil_config (SPUMONI, cm) ;

    /* ---------------------------------------------------------------------- */
    /* check inputs */
    /* ---------------------------------------------------------------------- */

    if (nargout > 1 || nargin < 3 || nargin > 4)
    {
	mexErrMsgTxt ("Usage: L = ldlrowupdate (k, L, R, '+')") ; 
    }

    n = mxGetN (pargin [1]) ;
    k = mxGetN (pargin [2]) ;

    if (!mxIsSparse (pargin [1]) || !mxIsSparse (pargin [2])
	    || n != mxGetM (pargin [1]) || n != mxGetM (pargin [2])
	    || mxIsComplex (pargin [1]) || mxIsComplex (pargin [2]))
    {
      k = mxGetM (pargin [2]);
      j = mxGetM (pargin [1]);
      printf("n=%d  L=%d  R=%d \n", n, j, k);
	mexErrMsgTxt ("ldlrowupdate: R and/or L not sparse, complex, or wrong"
		" dimensions") ;
    }

    /* ---------------------------------------------------------------------- */
    /* determine if we're doing an update or downdate */
    /* ---------------------------------------------------------------------- */

    update = TRUE ;
    if (nargin > 3 && mxIsChar (pargin [3]))
    {
	mxGetString (pargin [3], buf, LEN) ;
	if (buf [0] == '-')
	{
	    update = FALSE ;
	}
	else if (buf [0] != '+')
	{
	    mexErrMsgTxt ("ldlrowupdate: update string must be '+' or '-'") ;
	}
    }

    /* ---------------------------------------------------------------------- */
    /* get ki: column integer of update */
    /* ---------------------------------------------------------------------- */
    ki = (int) *mxGetPr(pargin[0]);
    ki = ki-1;

    /* ---------------------------------------------------------------------- */
    /* get R: sparse matrix of incoming/outgoing columns */
    /* ---------------------------------------------------------------------- */

    R = sputil_get_sparse (pargin [2], &Cmatrix, &dummy, 0) ;

    /* ---------------------------------------------------------------------- */
    /* construct a copy of the input sparse matrix L */
    /* ---------------------------------------------------------------------- */

    /* get the MATLAB L */
    Lp = (Int *) mxGetJc (pargin [1]) ;
    Li = (Int *) mxGetIr (pargin [1]) ;
    Lx = mxGetPr (pargin [1]) ;

    /* allocate the CHOLMOD symbolic L */
    L = cholmod_l_allocate_factor (n, cm) ;
    L->ordering = CHOLMOD_NATURAL ;
    ColCount = L->ColCount ;
    for (j = 0 ; j < n ; j++)
    {
	ColCount [j] = Lp [j+1] - Lp [j] ;
    }

    /* allocate space for a CHOLMOD LDL' packed factor */
    cholmod_l_change_factor (CHOLMOD_REAL, FALSE, FALSE, TRUE, TRUE, L, cm) ;

    /* copy MATLAB L into CHOLMOD L */
    Lp2 = L->p ;
    Li2 = L->i ;
    Lx2 = L->x ;
    Lnz2 = L->nz ;
    lnz = L->nzmax ;
    for (j = 0 ; j <= n ; j++)
    {
	Lp2 [j] = Lp [j] ;
    }
    for (j = 0 ; j < n ; j++)
    {
	Lnz2 [j] = Lp [j+1] - Lp [j] ;
    }
    for (s = 0 ; s < lnz ; s++)
    {
	Li2 [s] = Li [s] ;
    }
    for (s = 0 ; s < lnz ; s++)
    {
	Lx2 [s] = Lx [s] ;
    }

    /* ---------------------------------------------------------------------- */
    /* update/downdate the LDL' factorization */
    /* ---------------------------------------------------------------------- */
    /* add row */
    if (update){
      if (!cholmod_l_rowadd (ki, R, L, cm))
	{
	  mexErrMsgTxt ("rowadd failed\n") ;
	}
    }
    /* delete row */
    else {
      if (!cholmod_l_rowdel (ki, NULL, L, cm))
	{
	  mexErrMsgTxt ("rowdel failed\n") ;
	}
    }
      

    /* ---------------------------------------------------------------------- */
    /* copy the results back to MATLAB */
    /* ---------------------------------------------------------------------- */

    /* change L back to packed LDL' (it may have become unpacked if the
     * sparsity pattern changed).  This change takes O(n) time if the pattern
     * of L wasn't updated. */
    Lsparse = cholmod_l_factor_to_sparse (L, cm) ;

    /* return L as a sparse matrix */
    pargout [0] = sputil_put_sparse (&Lsparse, cm) ;

    /* ---------------------------------------------------------------------- */
    /* free workspace and the CHOLMOD L, except for what is copied to MATLAB */
    /* ---------------------------------------------------------------------- */

    cholmod_l_free_factor (&L, cm) ;
    cholmod_l_finish (cm) ;
    cholmod_l_print_common (" ", cm) ;
    /*
    if (cm->malloc_count != 3 + mxIsComplex (pargout[0])) mexErrMsgTxt ("!") ;
    */
}
Example #14
0
 Common :: ~Common( void )
 {
    cholmod_l_finish( &common );
 }
Example #15
0
void mexFunction
(
    int nargout,
    mxArray *pargout [ ],
    int nargin,
    const mxArray *pargin [ ]
)
{
    double dummy = 0 ;
    cholmod_sparse Amatrix, Zmatrix, *A, *Z ;
    cholmod_dense Xmatrix, *X ;
    cholmod_common Common, *cm ;
    Int arg_z, arg_comments, sym ;
    char filename [MAXLEN], comments [MAXLEN] ;

    /* ---------------------------------------------------------------------- */
    /* start CHOLMOD and set parameters */ 
    /* ---------------------------------------------------------------------- */

    cm = &Common ;
    cholmod_l_start (cm) ;
    sputil_config (SPUMONI, cm) ;

    /* ---------------------------------------------------------------------- */
    /* check inputs */
    /* ---------------------------------------------------------------------- */

    if (nargin < 2 || nargin > 4 || nargout > 1)
    {
	mexErrMsgTxt ("Usage: mwrite (filename, A, Z, comments_filename)") ;
    }

    /* ---------------------------------------------------------------------- */
    /* get the output filename */
    /* ---------------------------------------------------------------------- */

    if (!mxIsChar (pargin [0]))
    {
	mexErrMsgTxt ("first parameter must be a filename") ;
    }
    mxGetString (pargin [0], filename, MAXLEN) ;

    /* ---------------------------------------------------------------------- */
    /* get the A matrix (sparse or dense) */
    /* ---------------------------------------------------------------------- */

    if (mxIsSparse (pargin [1]))
    {
	A = sputil_get_sparse (pargin [1], &Amatrix, &dummy, 0) ;
	X = NULL ;
    }
    else
    {
	X = sputil_get_dense (pargin [1], &Xmatrix, &dummy) ;
	A = NULL ;
    }

    /* ---------------------------------------------------------------------- */
    /* determine if the Z matrix and comments_file are present */
    /* ---------------------------------------------------------------------- */

    if (nargin == 3)
    {
	if (mxIsChar (pargin [2]))
	{
	    /* mwrite (file, A, comments) */
	    arg_z = -1 ;
	    arg_comments = 2 ;
	}
	else
	{
	    /* mwrite (file, A, Z).  Ignore Z if A is full */
	    arg_z = (A == NULL) ? -1 : 2 ;
	    arg_comments = -1 ;
	}
    }
    else if (nargin == 4)
    {
	/* mwrite (file, A, Z, comments).  Ignore Z is A is full */
	arg_z = (A == NULL) ? -1 : 2 ;
	arg_comments = 3 ;
    }
    else
    {
	arg_z = -1 ;
	arg_comments = -1 ;
    }

    /* ---------------------------------------------------------------------- */
    /* get the Z matrix */
    /* ---------------------------------------------------------------------- */

    if (arg_z == -1 ||
	mxGetM (pargin [arg_z]) == 0 || mxGetN (pargin [arg_z]) == 0)
    {
	/* A is dense, Z is not present, or Z is empty.  Ignore Z. */
	Z = NULL ;
    }
    else
    {
	/* A is sparse and Z is present and not empty */
	if (!mxIsSparse (pargin [arg_z]))
	{
	    mexErrMsgTxt ("Z must be sparse") ;
	}
	Z = sputil_get_sparse (pargin [arg_z], &Zmatrix, &dummy, 0) ;
    }

    /* ---------------------------------------------------------------------- */
    /* get the comments filename */
    /* ---------------------------------------------------------------------- */

    comments [0] = '\0' ;
    if (arg_comments != -1)
    {
	if (!mxIsChar (pargin [arg_comments]))
	{
	    mexErrMsgTxt ("comments filename must be a string") ;
	}
	mxGetString (pargin [arg_comments], comments, MAXLEN) ;
    }

    /* ---------------------------------------------------------------------- */
    /* write the matrix to the file */
    /* ---------------------------------------------------------------------- */

    sputil_file = fopen (filename, "w") ;
    if (sputil_file == NULL)
    {
	mexErrMsgTxt ("error opening file") ;
    }
    if (A != NULL)
    {
	sym = cholmod_l_write_sparse (sputil_file, A, Z, comments, cm) ;
    }
    else
    {
	sym = cholmod_l_write_dense (sputil_file, X, comments, cm) ;
    }
    fclose (sputil_file) ;
    sputil_file = NULL ;
    if (sym < 0)
    {
	mexErrMsgTxt ("mwrite failed") ;
    }

    /* ---------------------------------------------------------------------- */
    /* free workspace and return symmetry */
    /* ---------------------------------------------------------------------- */

    pargout [0] = sputil_put_int (&sym, 1, 0) ;
    cholmod_l_finish (cm) ;
    cholmod_l_print_common (" ", cm) ;
}
Example #16
0
 static int finish(cholmod_common* c) {
   return cholmod_l_finish(c);
 }
Example #17
0
int main (int argc, char **argv)
{
    cholmod_common Common, *cc ;
    cholmod_sparse *A ;
    cholmod_dense *X, *B ;
    int mtype ;
    Long m, n ;

    // start CHOLMOD
    cc = &Common ;
    cholmod_l_start (cc) ;

    // A = mread (stdin) ; read in the sparse matrix A
    A = (cholmod_sparse *) cholmod_l_read_matrix (stdin, 1, &mtype, cc) ;
    if (mtype != CHOLMOD_SPARSE)
    {
        printf ("input matrix must be sparse\n") ;
        exit (1) ;
    }

    // [m n] = size (A) ;
    m = A->nrow ;
    n = A->ncol ;

    printf ("Matrix %6ld-by-%-6ld nnz: %6ld\n", m, n, cholmod_l_nnz (A, cc)) ;

    // B = ones (m,1), a dense right-hand-side of the same type as A
    B = cholmod_l_ones (m, 1, A->xtype, cc) ;

    // X = A\B ; with default ordering and default column 2-norm tolerance
    if (A->xtype == CHOLMOD_REAL)
    {
        // A, X, and B are all real
        X = SuiteSparseQR <double>
            (SPQR_ORDERING_DEFAULT, SPQR_DEFAULT_TOL, A, B, cc) ;
    }
    else
    {
        // A, X, and B are all complex
        X = SuiteSparseQR < std::complex<double> >
            (SPQR_ORDERING_DEFAULT, SPQR_DEFAULT_TOL, A, B, cc) ;
    }

    check_residual (A, X, B, cc) ;
    cholmod_l_free_dense (&X, cc) ;

    // -------------------------------------------------------------------------
    // factorizing once then solving twice with different right-hand-sides
    // -------------------------------------------------------------------------

    // Just the real case.  Complex case is essentially identical
    if (A->xtype == CHOLMOD_REAL)
    {
        SuiteSparseQR_factorization <double> *QR ;
        cholmod_dense *Y ;
        Long i ;
        double *Bx ;

        // factorize once
        QR = SuiteSparseQR_factorize <double>
            (SPQR_ORDERING_DEFAULT, SPQR_DEFAULT_TOL, A, cc) ;

        // solve Ax=b, using the same B as before

        // Y = Q'*B
        Y = SuiteSparseQR_qmult (SPQR_QTX, QR, B, cc) ;
        // X = R\(E*Y)
        X = SuiteSparseQR_solve (SPQR_RETX_EQUALS_B, QR, Y, cc) ;
        // check the results
        check_residual (A, X, B, cc) ;
        // free X and Y
        cholmod_l_free_dense (&Y, cc) ;
        cholmod_l_free_dense (&X, cc) ;

        // repeat with a different B
        Bx = (double *) (B->x) ;
        for (i = 0 ; i < m ; i++)
        {
            Bx [i] = i ;
        }

        // Y = Q'*B
        Y = SuiteSparseQR_qmult (SPQR_QTX, QR, B, cc) ;
        // X = R\(E*Y)
        X = SuiteSparseQR_solve (SPQR_RETX_EQUALS_B, QR, Y, cc) ;
        // check the results
        check_residual (A, X, B, cc) ;
        // free X and Y
        cholmod_l_free_dense (&Y, cc) ;
        cholmod_l_free_dense (&X, cc) ;

        // free QR
        SuiteSparseQR_free (&QR, cc) ;
    }

    // -------------------------------------------------------------------------
    // free everything that remains
    // -------------------------------------------------------------------------

    cholmod_l_free_sparse (&A, cc) ;
    cholmod_l_free_dense (&B, cc) ;
    cholmod_l_finish (cc) ;
    return (0) ;
}
Example #18
0
void mexFunction
(
    int nargout,
    mxArray *pargout [ ],
    int nargin,
    const mxArray *pargin [ ]
)
{
    double dummy = 0 ;
    Long *Parent ;
    cholmod_sparse *A, Amatrix, *S ;
    cholmod_common Common, *cm ;
    Long n, coletree, c ;
    char buf [LEN] ;

    /* ---------------------------------------------------------------------- */
    /* start CHOLMOD and set defaults */
    /* ---------------------------------------------------------------------- */

    cm = &Common ;
    cholmod_l_start (cm) ;
    sputil_config (SPUMONI, cm) ;

    /* ---------------------------------------------------------------------- */
    /* get inputs */
    /* ---------------------------------------------------------------------- */

    if (nargout > 2 || nargin < 1 || nargin > 2)
    {
	mexErrMsgTxt ("Usage: [parent post] = etree2 (A, mode)") ;
    }

    /* ---------------------------------------------------------------------- */
    /* get input matrix A */
    /* ---------------------------------------------------------------------- */

    A = sputil_get_sparse_pattern (pargin [0], &Amatrix, &dummy, cm) ;
    S = (A == &Amatrix) ? NULL : A ;

    /* ---------------------------------------------------------------------- */
    /* get A->stype, default is to use triu(A) */
    /* ---------------------------------------------------------------------- */

    A->stype = 1 ;
    n = A->nrow ;
    coletree = FALSE ;
    if (nargin > 1)
    {
	buf [0] = '\0' ;
	if (mxIsChar (pargin [1]))
	{
	    mxGetString (pargin [1], buf, LEN) ;
	}
	c = buf [0] ;
	if (tolower (c) == 'r')
	{
	    /* unsymmetric case (A*A') if string starts with 'r' */
	    A->stype = 0 ;
	}
	else if (tolower (c) == 'c')
	{
	    /* unsymmetric case (A'*A) if string starts with 'c' */
	    n = A->ncol ;
	    coletree = TRUE ;
	    A->stype = 0 ;
	}
	else if (tolower (c) == 's')
	{
	    /* symmetric upper case (A) if string starts with 's' */
	    A->stype = 1 ;
	}
	else if (tolower (c) == 'l')
	{
	    /* symmetric lower case (A) if string starts with 'l' */
	    A->stype = -1 ;
	}
	else
	{
	    mexErrMsgTxt ("etree2: unrecognized mode") ;
	}
    }

    if (A->stype && A->nrow != A->ncol)
    {
	mexErrMsgTxt ("etree2: A must be square") ;
    }

    /* ---------------------------------------------------------------------- */
    /* compute the etree */
    /* ---------------------------------------------------------------------- */

    Parent = cholmod_l_malloc (n, sizeof (Long), cm) ;
    if (A->stype == 1 || coletree)
    {
	/* symmetric case: find etree of A, using triu(A) */
	/* column case: find column etree of A, which is etree of A'*A */
	cholmod_l_etree (A, Parent, cm) ;
    }
    else
    {
	/* symmetric case: find etree of A, using tril(A) */
	/* row case: find row etree of A, which is etree of A*A' */
	/* R = A' */
	cholmod_sparse *R ;
	R = cholmod_l_transpose (A, 0, cm) ;
	cholmod_l_etree (R, Parent, cm) ;
	cholmod_l_free_sparse (&R, cm) ;
    }

    if (cm->status < CHOLMOD_OK)
    {
	/* out of memory or matrix invalid */
	mexErrMsgTxt ("etree2 failed: matrix corrupted!") ;
    }

    /* ---------------------------------------------------------------------- */
    /* return Parent to MATLAB */
    /* ---------------------------------------------------------------------- */

    pargout [0] = sputil_put_int (Parent, n, 1) ;

    /* ---------------------------------------------------------------------- */
    /* postorder the tree and return results to MATLAB */
    /* ---------------------------------------------------------------------- */

    if (nargout > 1)
    {
	Long *Post ;
	Post = cholmod_l_malloc (n, sizeof (Long), cm) ;
	if (cholmod_l_postorder (Parent, n, NULL, Post, cm) != n)
	{
	    /* out of memory or Parent invalid */
	    mexErrMsgTxt ("etree2 postorder failed!") ;
	}
	pargout [1] = sputil_put_int (Post, n, 1) ;
	cholmod_l_free (n, sizeof (Long), Post, cm) ;
    }

    /* ---------------------------------------------------------------------- */
    /* free workspace */
    /* ---------------------------------------------------------------------- */

    cholmod_l_free (n, sizeof (Long), Parent, cm) ;
    cholmod_l_free_sparse (&S, cm) ;
    cholmod_l_finish (cm) ;
    cholmod_l_print_common (" ", cm) ;
    /* if (cm->malloc_count != 0) mexErrMsgTxt ("!") ; */
}
Example #19
0
void mexFunction
(
    int	nargout,
    mxArray *pargout [ ],
    int	nargin,
    const mxArray *pargin [ ]
)
{
    void *G ;
    cholmod_dense *X = NULL ;
    cholmod_sparse *A = NULL, *Z = NULL ;
    cholmod_common Common, *cm ;
    Long *Ap = NULL, *Ai ;
    double *Ax, *Az = NULL ;
    char filename [MAXLEN] ;
    Long nz, k, is_complex = FALSE, nrow = 0, ncol = 0, allzero ;
    int mtype ;

    /* ---------------------------------------------------------------------- */
    /* start CHOLMOD and set parameters */
    /* ---------------------------------------------------------------------- */

    cm = &Common ;
    cholmod_l_start (cm) ;
    sputil_config (SPUMONI, cm) ;

    /* ---------------------------------------------------------------------- */
    /* get inputs */
    /* ---------------------------------------------------------------------- */

    if (nargin < 1 || nargin > 2 || nargout > 2)
    {
        mexErrMsgTxt ("usage: [A Z] = mread (filename, prefer_binary)") ;
    }
    if (!mxIsChar (pargin [0]))
    {
        mexErrMsgTxt ("mread requires a filename") ;
    }
    mxGetString (pargin [0], filename, MAXLEN) ;
    sputil_file = fopen (filename, "r") ;
    if (sputil_file == NULL)
    {
        mexErrMsgTxt ("cannot open file") ;
    }
    if (nargin > 1)
    {
        cm->prefer_binary = (mxGetScalar (pargin [1]) != 0) ;
    }

    /* ---------------------------------------------------------------------- */
    /* read the matrix, as either a dense or sparse matrix */
    /* ---------------------------------------------------------------------- */

    G = cholmod_l_read_matrix (sputil_file, 1, &mtype, cm) ;
    fclose (sputil_file) ;
    sputil_file = NULL ;
    if (G == NULL)
    {
        mexErrMsgTxt ("could not read file") ;
    }

    /* get the specific matrix (A or X), and change to ZOMPLEX if needed */
    if (mtype == CHOLMOD_SPARSE)
    {
        A = (cholmod_sparse *) G ;
        nrow = A->nrow ;
        ncol = A->ncol ;
        is_complex = (A->xtype == CHOLMOD_COMPLEX) ;
        Ap = A->p ;
        Ai = A->i ;
        if (is_complex)
        {
            /* if complex, ensure A is ZOMPLEX */
            cholmod_l_sparse_xtype (CHOLMOD_ZOMPLEX, A, cm) ;
        }
        Ax = A->x ;
        Az = A->z ;
    }
    else if (mtype == CHOLMOD_DENSE)
    {
        X = (cholmod_dense *) G ;
        nrow = X->nrow ;
        ncol = X->ncol ;
        is_complex = (X->xtype == CHOLMOD_COMPLEX) ;
        if (is_complex)
        {
            /* if complex, ensure X is ZOMPLEX */
            cholmod_l_dense_xtype (CHOLMOD_ZOMPLEX, X, cm) ;
        }
        Ax = X->x ;
        Az = X->z ;
    }
    else
    {
        mexErrMsgTxt ("invalid file") ;
    }

    /* ---------------------------------------------------------------------- */
    /* if requested, extract the zero entries and place them in Z */
    /* ---------------------------------------------------------------------- */

    if (nargout > 1)
    {
        if (mtype == CHOLMOD_SPARSE)
        {
            /* A is a sparse real/zomplex double matrix */
            Z = sputil_extract_zeros (A, cm) ;
        }
        else
        {
            /* input is full; just return an empty Z matrix */
            Z = cholmod_l_spzeros (nrow, ncol, 0, CHOLMOD_REAL, cm) ;
        }
    }

    /* ---------------------------------------------------------------------- */
    /* prune the zero entries from A and set nzmax(A) to nnz(A) */
    /* ---------------------------------------------------------------------- */

    if (mtype == CHOLMOD_SPARSE)
    {
        sputil_drop_zeros (A) ;
        cholmod_l_reallocate_sparse (cholmod_l_nnz (A, cm), A, cm) ;
    }

    /* ---------------------------------------------------------------------- */
    /* change a complex matrix to real if its imaginary part is all zero */
    /* ---------------------------------------------------------------------- */

    if (is_complex)
    {
        if (mtype == CHOLMOD_SPARSE)
        {
            nz = Ap [ncol] ;
        }
        else
        {
            nz = nrow * ncol ;
        }
        allzero = TRUE ;
        for (k = 0 ; k < nz ; k++)
        {
            if (Az [k] != 0)
            {
                allzero = FALSE ;
                break ;
            }
        }
        if (allzero)
        {
            /* discard the all-zero imaginary part */
            if (mtype == CHOLMOD_SPARSE)
            {
                cholmod_l_sparse_xtype (CHOLMOD_REAL, A, cm) ;
            }
            else
            {
                cholmod_l_dense_xtype (CHOLMOD_REAL, X, cm) ;
            }
        }
    }

    /* ---------------------------------------------------------------------- */
    /* return results to MATLAB */
    /* ---------------------------------------------------------------------- */

    if (mtype == CHOLMOD_SPARSE)
    {
        pargout [0] = sputil_put_sparse (&A, cm) ;
    }
    else
    {
        pargout [0] = sputil_put_dense (&X, cm) ;
    }
    if (nargout > 1)
    {
        pargout [1] = sputil_put_sparse (&Z, cm) ;
    }

    /* ---------------------------------------------------------------------- */
    /* free workspace */
    /* ---------------------------------------------------------------------- */

    cholmod_l_finish (cm) ;
    cholmod_l_print_common (" ", cm) ;
}
Example #20
0
void mexFunction
(
    int nargout,
    mxArray *pargout [ ],
    int nargin,
    const mxArray *pargin [ ]
)
{
    double dummy = 0, one [2] = {1,0}, zero [2] = {0,0} ;
    cholmod_sparse *S, Smatrix ;
    cholmod_dense *F, Fmatrix, *C ;
    cholmod_common Common, *cm ;
    Long srow, scol, frow, fcol, crow, transpose ; 

    /* ---------------------------------------------------------------------- */
    /* start CHOLMOD and set parameters */ 
    /* ---------------------------------------------------------------------- */

    cm = &Common ;
    cholmod_l_start (cm) ;
    sputil_config (SPUMONI, cm) ;

    /* ---------------------------------------------------------------------- */
    /* check inputs */
    /* ---------------------------------------------------------------------- */

    if (nargout > 1 || nargin < 2 || nargin > 3)
    {
	mexErrMsgTxt ("Usage: C = sdmult (S,F,transpose)") ; 
    }

    srow = mxGetM (pargin [0]) ;
    scol = mxGetN (pargin [0]) ;
    frow = mxGetM (pargin [1]) ;
    fcol = mxGetN (pargin [1]) ;

    transpose = !((nargin == 2) || (mxGetScalar (pargin [2]) == 0)) ;

    if (frow != (transpose ? srow : scol))
    {
	mexErrMsgTxt ("invalid inner dimensions") ;
    }

    if (!mxIsSparse (pargin [0]) || mxIsSparse (pargin [1]))
    {
	mexErrMsgTxt ("sdmult (S,F): S must be sparse, F must be full") ;
    }

    /* ---------------------------------------------------------------------- */
    /* get S and F */
    /* ---------------------------------------------------------------------- */

    S = sputil_get_sparse (pargin [0], &Smatrix, &dummy, 0) ;
    F = sputil_get_dense  (pargin [1], &Fmatrix, &dummy) ;

    /* ---------------------------------------------------------------------- */
    /* C = S*F or S'*F */
    /* ---------------------------------------------------------------------- */

    crow = transpose ? scol : srow ;
    C = cholmod_l_allocate_dense (crow, fcol, crow, F->xtype, cm) ;
    cholmod_l_sdmult (S, transpose, one, zero, F, C, cm) ;
    pargout [0] = sputil_put_dense (&C, cm) ;

    /* ---------------------------------------------------------------------- */
    /* free workspace and the CHOLMOD L, except for what is copied to MATLAB */
    /* ---------------------------------------------------------------------- */

    cholmod_l_finish (cm) ;
    cholmod_l_print_common (" ", cm) ;
    /*
    if (cm->malloc_count != (mxIsComplex (pargout [0]) + 1)) mexErrMsgTxt ("!");
    */
}
Example #21
0
int main() {
  /* Time Recording Variables */
  int now_s, now_u;
  struct rusage usage;
  double time_now, time_past;
  
  /* x, y, z and global indices */
  int i, j, k, m, n, nodes;
  /* Connectivity enties */
  int m_above, m_below, m_left, m_right, m_front, m_back;
  double c_above, c_below, c_left, c_right, c_front, c_back, c_self;
  
  /* Creat cholmod object */
  cholmod_common Common, *cc;
  /* Compress column form sparse matrix */
  cholmod_sparse *S, *ST;
  /* forcing function on input; voltages after solving */
  cholmod_dense *b, *v0, *r;  
  size_t *Si, *Sp, *Snz, *bi, *bj;
  double *Sx, *bx, *v0x;
 
  /* store the sparse matrix */
  FILE *store;
  char filename[100];
  
  /* start CHOLMOD */
  cc = &Common;
  cholmod_l_start(cc);
  
  /* initialize timing variables*/ 
  getrusage(0, &usage);
  now_s = usage.ru_utime.tv_sec;
  now_u = usage.ru_utime.tv_usec;
  time_past = now_s + now_u  / 1.e6;
  time_now = time_past;
  
  /* total nodes in the grid */
  nodes = IMAX * JMAX * KMAX;
  
  /* Allocate space for connectivity matrix and forcing vector. */
  S = cholmod_l_allocate_sparse(nodes, nodes, 7 * nodes, 
				0, 0, 0, CHOLMOD_REAL, cc);

  b = cholmod_l_allocate_dense(nodes, 1, nodes, CHOLMOD_REAL, cc);
  bx = b->x;

  v0 = cholmod_l_allocate_dense(nodes, 1, nodes, CHOLMOD_REAL, cc);
  v0x = v0->x;



  /*================================================================*/
  /*===============  make connectivity matrix ======================*/
  /*================================================================*/
  Si = (size_t *) S->i;
  Sp = (size_t *) S->p;
  Sx = (double *) S->x;
  Snz = (size_t *) S->nz;
  n = 0;
  Sp[0] = 0;
  for (k = 0; k < KMAX; k++) {
    for (j = 0; j < JMAX; j++) {
      for (i = 0; i < IMAX; i++) {
	/* Global index in x-fastest order*/
	m = k * IMAX * JMAX + j * IMAX + i;
	Sp[m + 1] = Sp[m];
	v0x[m] = (k + 1.0) / (KMAX + 1.0);

	/* Six coef.s of every node */
	c_below = (mepr(i - 0.5, j - 0.5, k - 0.5) + 
		   mepr(i + 0.5, j - 0.5, k - 0.5) + 
		   mepr(i - 0.5, j + 0.5, k - 0.5) +
		   mepr(i + 0.5, j + 0.5, k - 0.5)) / 4.0;

	c_front = (mepr(i - 0.5, j - 0.5, k - 0.5) + 
		   mepr(i + 0.5, j - 0.5, k - 0.5) + 
		   mepr(i - 0.5, j - 0.5, k + 0.5) +
		   mepr(i + 0.5, j - 0.5, k + 0.5)) / 4.0;

	c_left = (mepr(i - 0.5, j + 0.5, k - 0.5) + 
		  mepr(i - 0.5, j - 0.5, k - 0.5) + 
		  mepr(i - 0.5, j + 0.5, k + 0.5) +
		  mepr(i - 0.5, j - 0.5, k + 0.5)) / 4.0;

	c_right = (mepr(i + 0.5, j + 0.5, k - 0.5) + 
		   mepr(i + 0.5, j - 0.5, k - 0.5) + 
		   mepr(i + 0.5, j + 0.5, k + 0.5) +
		   mepr(i + 0.5, j - 0.5, k + 0.5)) / 4.0;

	c_back = (mepr(i - 0.5, j + 0.5, k - 0.5) + 
		  mepr(i + 0.5, j + 0.5, k - 0.5) + 
		  mepr(i - 0.5, j + 0.5, k + 0.5) +
		  mepr(i + 0.5, j + 0.5, k + 0.5)) / 4.0;

	c_above = (mepr(i - 0.5, j - 0.5, k + 0.5) + 
		   mepr(i + 0.5, j - 0.5, k + 0.5) + 
		   mepr(i - 0.5, j + 0.5, k + 0.5) +
		   mepr(i + 0.5, j + 0.5, k + 0.5))/4.0;

	/* Self term. */
	c_self = -(c_above + c_below + c_left + c_right + c_front + c_back);
	Si[n] = m; Sx[n] = c_self; n++; Sp[m + 1]++;

	/* Node below. Ensure not on bottom face */
	if (k != 0) {
	  m_below = m - IMAX * JMAX;
 	  Si[n] = m_below; Sx[n] = c_below; n++; Sp[m + 1]++;
	} else {
	  bx[m] = -c_below * VBOT;
	}

	/* Node front.  Ensure not on front face. */
	if (j != 0) {
	  m_front = m - IMAX;
	} else {
	  m_front = m + (JMAX - 1) * IMAX;
	}
	Si[n] = m_front; Sx[n] = c_front; n++; Sp[m + 1]++;

	/* Node to left.  Ensure not on left face. */
	if (i != 0) {
	  m_left = m - 1;
	} else {
	  m_left = m + IMAX -1;
	}
	Si[n] = m_left; Sx[n] = c_left; n++; Sp[m + 1]++;	   

	/* Node to right.  Ensure not on right face. */
	if (i != IMAX - 1) {
	  m_right = m + 1;
	} else{
	  m_right = m - IMAX + 1;
	}
	Si[n] = m_right; Sx[n] = c_right; n++; Sp[m + 1]++;

	/* Node back.  Ensure not on back face. */
	if (j != JMAX - 1) {
	  m_back = m + IMAX;
	} else {
	  m_back = m - (JMAX - 1) * IMAX;
	}
	Si[n] = m_back; Sx[n] = c_back; n++; Sp[m + 1]++;

	/* Node top. Ensure not on top face */
	if (k != KMAX - 1) {
	  m_above = m + IMAX * JMAX;
 	  Si[n] = m_above; Sx[n] = c_above; n++; Sp[m + 1]++;
	} else {
	  bx[m] = -c_above * VTOP;
	}

	Snz[m] = Sp[m + 1] - Sp[m];
      }
    }
  }
  /*====================================================================*/
  /*===================Done creating connectivity matrix.===============*/
  /*====================================================================*/

  /* report time*/
  getrusage(0, &usage);
  now_s = usage.ru_utime.tv_sec;
  now_u = usage.ru_utime.tv_usec;
  time_now = now_s + now_u / 1.e6;
  printf("\nFinished creating connectivity matrix\n"
	 "  Incremental time %f\n"
	 "  Running time %f\n", time_now - time_past, time_now);
  time_past = time_now;

  /* Print all three matrixes */
  cholmod_l_print_sparse(S, "S", cc);
  cholmod_l_print_dense(b, "b", cc);
  cholmod_l_print_dense(v0, "v0", cc);

  /* Allocate residual vector */
  r = cholmod_l_zeros(nodes, 1, CHOLMOD_REAL, cc);

  /* The Preconditioned Conjugate Gradient Method */
  /* Calculate the first residual value */
  double one[2], zero[2], minusone[2];
  zero[0] = 0.0;
  zero[1] = 0.0;
  one[0] = 1.0;
  one[1] = 0.0;
  minusone[0] = -1.0;
  minusone[1] = 0.0;

  cholmod_l_copy_dense2(b, r, cc);
  cholmod_l_sdmult(S, 0, minusone, one, v0, r, cc);
  printf("Initial 2-norm = %f\n", cholmod_l_norm_dense(r, 2, cc));
  printf("Initial 1-norm = %f\n", cholmod_l_norm_dense(r, 1, cc));
  printf("Initial 0-norm = %f\n", cholmod_l_norm_dense(r, 0, cc));
  

  /* The iteration */
  double rho1, rho0, beta = 0.0, alpha = 0.0;
  cholmod_dense *p1, *p0, *q;
  double *p1x, *p0x, *qx, *rx;
  /*
  p1 = cholmod_l_allocate_dense(nodes, 1, nodes, CHOLMOD_REAL, cc);
  p0 = cholmod_l_allocate_dense(nodes, 1, nodes, CHOLMOD_REAL, cc);
  q = cholmod_l_allocate_dense(nodes, 1, nodes, CHOLMOD_REAL, cc);  
  */
  p1 = cholmod_l_zeros(nodes, 1, CHOLMOD_REAL, cc);
  p0 = cholmod_l_zeros(nodes, 1, CHOLMOD_REAL, cc);
  q = cholmod_l_zeros(nodes, 1, CHOLMOD_REAL, cc);
  p1x = (double *) p1->x;
  p0x = (double *) p0->x;
  qx = (double *) q->x;
  rx = (double *) r->x;

  int iter;
  for (iter = 0; iter < MAX_ITER; iter++) {
    if (cholmod_l_norm_dense(r, 0, cc) < 1e-10)
      break;
    
    rho1 = cholmod_l_norm_dense(r, 2, cc);
    rho1 = rho1 * rho1;
    
    if (iter == 0) {
      cholmod_l_copy_dense2(r, p1, cc);
    } else {
      beta = rho1 / rho0;
      for (i = 0; i < nodes; i++) {
	p1x[i] = rx[i] + beta * p0x[i];
      }
    }
   
    cholmod_l_sdmult(S, 0, one, zero, p1, q, cc);
    alpha = 0;
    for (i = 0; i < nodes; i++) {
      alpha += p1x[i] * qx[i];
    }
    alpha = rho1 / alpha;

    for (i = 0; i < nodes; i++) {
      v0x[i] += alpha * p1x[i];
      rx[i] -= alpha * qx[i];
    }
    /*
    printf("iter = %d\n: rho1 = %f, rho0 = %f, alpha = %f, beta = %f\n", 
	   iter, rho1, rho0, alpha, beta);
    */
    cholmod_l_copy_dense2(p1, p0, cc);
    rho0 = rho1;
  }
  
  cholmod_l_copy_dense2(b, r, cc);
  cholmod_l_sdmult(S, 0, minusone, one, v0, r, cc);
  printf("After %d iterations:\n", iter);
  printf("Final 2-norm: %f\n", cholmod_l_norm_dense(r, 2, cc));
  printf("Final 1-norm: %f\n", cholmod_l_norm_dense(r, 1, cc));
  printf("Final 0-norm: %f\n", cholmod_l_norm_dense(r, 0, cc));
  /* sort sparse matrix and store it 
  cholmod_l_sort(S, cc);
  S->stype = 0;
  */

  /* Check if S is symmetric
  ST = cholmod_l_transpose(S, 2, cc);
  store = fopen("LpT.dat", "w");
  cholmod_l_write_sparse(store, ST, NULL, NULL, cc);
  fclose(store);
  cholmod_l_free_sparse(&ST, cc);
  */
  
  /* store the sparse matrix   */
  /*
  store = fopen("Laplace.dat", "w");
  cholmod_l_write_sparse(store, S, NULL, NULL, cc);
  fclose(store);
  cholmod_l_free_sparse(&S, cc);
  */

  /* store the force vector  */
  /*
  store = fopen("Force.dat", "w");
  cholmod_l_write_dense(store, b, NULL, cc);
  fclose(store);
  cholmod_l_free_dense(&b,cc);
  */

  /* store the guess vector   */
  store = fopen("Voltage.dat", "w");
  cholmod_l_write_dense(store, v0, NULL, cc);
  fclose(store);

  cholmod_l_free_dense(&v0, cc);

  /* store the residual vector  */
  store = fopen("Residual.dat", "w");
  cholmod_l_write_dense(store, r, NULL, cc);
  fclose(store);

  cholmod_l_free_dense(&r, cc);

  /* report time*/
  getrusage(0, &usage);
  now_s = usage.ru_utime.tv_sec;
  now_u = usage.ru_utime.tv_usec;
  time_now = now_s + now_u / 1.e6;
  printf("\nFinished writing matrix\n"
	 "  Incremental time %f\n"
	 "  Running time %f\n", time_now - time_past, time_now);

  cholmod_l_finish(cc);
  return 0;
}
Example #22
0
void mexFunction
(
    int nargout,
    mxArray *pargout [ ],
    int nargin,
    const mxArray *pargin [ ]
)
{
    double dummy = 0 ;
    double *Lx, *Lx2, *Lz, *Lz2 ;
    Long *Li, *Lp, *Lnz2, *Li2, *Lp2, *ColCount ;
    cholmod_sparse *A, Amatrix, *Lsparse, *S ;
    cholmod_factor *L ;
    cholmod_common Common, *cm ;
    Long j, s, n, lnz, is_complex ;

    /* ---------------------------------------------------------------------- */
    /* start CHOLMOD and set parameters */ 
    /* ---------------------------------------------------------------------- */

    cm = &Common ;
    cholmod_l_start (cm) ;
    sputil_config (SPUMONI, cm) ;

    /* ---------------------------------------------------------------------- */
    /* check inputs */
    /* ---------------------------------------------------------------------- */

    if (nargout > 1 || nargin != 2)
    {
	mexErrMsgTxt ("usage: L = resymbol (L, A)\n") ;
    }

    n = mxGetN (pargin [0]) ;
    if (!mxIsSparse (pargin [0]) || n != mxGetM (pargin [0]))
    {
	mexErrMsgTxt ("resymbol: L must be sparse and square") ;
    }
    if (n != mxGetM (pargin [1]) || n != mxGetN (pargin [1]))
    {
	mexErrMsgTxt ("resymbol: A and L must have same dimensions") ;
    }

    /* ---------------------------------------------------------------------- */
    /* get the sparse matrix A */
    /* ---------------------------------------------------------------------- */

    A = sputil_get_sparse_pattern (pargin [1], &Amatrix, &dummy, cm) ;
    S = (A == &Amatrix) ? NULL : A ;

    A->stype = -1 ;

    /* A = sputil_get_sparse (pargin [1], &Amatrix, &dummy, -1) ; */

    /* ---------------------------------------------------------------------- */
    /* construct a copy of the input sparse matrix L */
    /* ---------------------------------------------------------------------- */

    /* get the MATLAB L */
    Lp = (Long *) mxGetJc (pargin [0]) ;
    Li = (Long *) mxGetIr (pargin [0]) ;
    Lx = mxGetPr (pargin [0]) ;
    Lz = mxGetPi (pargin [0]) ;
    is_complex = mxIsComplex (pargin [0]) ;

    /* allocate the CHOLMOD symbolic L */
    L = cholmod_l_allocate_factor (n, cm) ;
    L->ordering = CHOLMOD_NATURAL ;
    ColCount = L->ColCount ;
    for (j = 0 ; j < n ; j++)
    {
	ColCount [j] = Lp [j+1] - Lp [j] ;
    }

    /* allocate space for a CHOLMOD LDL' packed factor */
    /* (LL' and LDL' are treated identically) */
    cholmod_l_change_factor (is_complex ? CHOLMOD_ZOMPLEX : CHOLMOD_REAL,
	    FALSE, FALSE, TRUE, TRUE, L, cm) ;

    /* copy MATLAB L into CHOLMOD L */
    Lp2 = L->p ;
    Li2 = L->i ;
    Lx2 = L->x ;
    Lz2 = L->z ;
    Lnz2 = L->nz ;
    lnz = L->nzmax ;
    for (j = 0 ; j <= n ; j++)
    {
	Lp2 [j] = Lp [j] ;
    }
    for (j = 0 ; j < n ; j++)
    {
	Lnz2 [j] = Lp [j+1] - Lp [j] ;
    }
    for (s = 0 ; s < lnz ; s++)
    {
	Li2 [s] = Li [s] ;
    }
    for (s = 0 ; s < lnz ; s++)
    {
	Lx2 [s] = Lx [s] ;
    }
    if (is_complex)
    {
	for (s = 0 ; s < lnz ; s++)
	{
	    Lz2 [s] = Lz [s] ;
	}
    }

    /* ---------------------------------------------------------------------- */
    /* resymbolic factorization */
    /* ---------------------------------------------------------------------- */

    cholmod_l_resymbol (A, NULL, 0, TRUE, L, cm) ;

    /* ---------------------------------------------------------------------- */
    /* copy the results back to MATLAB */
    /* ---------------------------------------------------------------------- */

    Lsparse = cholmod_l_factor_to_sparse (L, cm) ;

    /* return L as a sparse matrix */
    pargout [0] = sputil_put_sparse (&Lsparse, cm) ;

    /* ---------------------------------------------------------------------- */
    /* free workspace and the CHOLMOD L, except for what is copied to MATLAB */
    /* ---------------------------------------------------------------------- */

    cholmod_l_free_factor (&L, cm) ;
    cholmod_l_free_sparse (&S, cm) ;
    cholmod_l_finish (cm) ;
    cholmod_l_print_common (" ", cm) ;
    /*
    if (cm->malloc_count != 3 + mxIsComplex (pargout[0])) mexErrMsgTxt ("!") ;
    */
}
Example #23
0
void mexFunction
(
    int nargout,
    mxArray *pargout [ ],
    int nargin,
    const mxArray *pargin [ ]
)
{
    double dummy = 0 ;
    cholmod_factor *L ;
    cholmod_sparse *A, Amatrix, *C, *S ;
    cholmod_common Common, *cm ;
    Long n, transpose, c ;
    char buf [LEN] ;

    /* ---------------------------------------------------------------------- */
    /* start CHOLMOD and set defaults */
    /* ---------------------------------------------------------------------- */

    cm = &Common ;
    cholmod_l_start (cm) ;
    sputil_config (SPUMONI, cm) ;

    /* only do the simplicial analysis (L->Perm and L->ColCount) */
    cm->supernodal = CHOLMOD_SIMPLICIAL ;

    /* ---------------------------------------------------------------------- */
    /* get inputs */
    /* ---------------------------------------------------------------------- */

    if (nargout > 2 || nargin < 1 || nargin > 3)
    {
	mexErrMsgTxt ("Usage: [p count] = analyze (A, mode)") ;
    }
    if (nargin == 3)
    {
	cm->nmethods = mxGetScalar (pargin [2]) ;
	if (cm->nmethods == -1)
	{
	    /* use AMD only */
	    cm->nmethods = 1 ;
	    cm->method [0].ordering = CHOLMOD_AMD ;
	    cm->postorder = TRUE ;
	}
	else if (cm->nmethods == -2)
	{
	    /* use METIS only */
	    cm->nmethods = 1 ;
	    cm->method [0].ordering = CHOLMOD_METIS ;
	    cm->postorder = TRUE ;
	}
	else if (cm->nmethods == -3)
	{
	    /* use NESDIS only */
	    cm->nmethods = 1 ;
	    cm->method [0].ordering = CHOLMOD_NESDIS ;
	    cm->postorder = TRUE ;
	}
    }

    /* ---------------------------------------------------------------------- */
    /* get input matrix A */
    /* ---------------------------------------------------------------------- */

    A = sputil_get_sparse_pattern (pargin [0], &Amatrix, &dummy, cm) ;
    S = (A == &Amatrix) ? NULL : A ;

    /* ---------------------------------------------------------------------- */
    /* get A->stype, default is to use tril(A) */
    /* ---------------------------------------------------------------------- */

    A->stype = -1 ;
    transpose = FALSE ;

    if (nargin > 1)
    {
	buf [0] = '\0' ;
	if (mxIsChar (pargin [1]))
	{
	    mxGetString (pargin [1], buf, LEN) ;
	}
	c = buf [0] ;
	if (tolower (c) == 'r')
	{
	    /* unsymmetric case (A*A') if string starts with 'r' */
	    transpose = FALSE ;
	    A->stype = 0 ;
	}
	else if (tolower (c) == 'c')
	{
	    /* unsymmetric case (A'*A) if string starts with 'c' */
	    transpose = TRUE ;
	    A->stype = 0 ;
	}
	else if (tolower (c) == 's')
	{
	    /* symmetric case (A) if string starts with 's' */
	    transpose = FALSE ;
	    A->stype = -1 ;
	}
	else
	{
	    mexErrMsgTxt ("analyze: unrecognized mode") ;
	}
    }

    if (A->stype && A->nrow != A->ncol)
    {
	mexErrMsgTxt ("analyze: A must be square") ;
    }

    C = NULL ;
    if (transpose)
    {
	/* C = A', and then order C*C' */
	C = cholmod_l_transpose (A, 0, cm) ;
	if (C == NULL)
	{
	    mexErrMsgTxt ("analyze failed") ;
	}
	A = C ;
    }

    n = A->nrow ;

    /* ---------------------------------------------------------------------- */
    /* analyze and order the matrix */
    /* ---------------------------------------------------------------------- */

    L = cholmod_l_analyze (A, cm) ;

    /* ---------------------------------------------------------------------- */
    /* return Perm */
    /* ---------------------------------------------------------------------- */

    pargout [0] = sputil_put_int (L->Perm, n, 1) ;
    if (nargout > 1)
    {
	pargout [1] = sputil_put_int (L->ColCount, n, 0) ;
    }

    /* ---------------------------------------------------------------------- */
    /* free workspace */
    /* ---------------------------------------------------------------------- */

    cholmod_l_free_factor (&L, cm) ;
    cholmod_l_free_sparse (&C, cm) ;
    cholmod_l_free_sparse (&S, cm) ;
    cholmod_l_finish (cm) ;
    cholmod_l_print_common (" ", cm) ;
    /* if (cm->malloc_count != 0) mexErrMsgTxt ("!") ; */
}
Example #24
0
void mexFunction
(
    int nargout,
    mxArray *pargout [ ],
    int nargin,
    const mxArray *pargin [ ]
)
{
    double dummy = 0, *Px, *Xsetx ;
    Long *Lp, *Lnz, *Xp, *Xi, xnz, *Perm, *Lprev, *Lnext, *Xsetp ;
    cholmod_sparse *Bset, Bmatrix, *Xset ;
    cholmod_dense *Bdense, *X, *Y, *E ;
    cholmod_factor *L ;
    cholmod_common Common, *cm ;
    Long k, j, n, head, tail, xsetlen ;
    int sys, kind ;

    /* ---------------------------------------------------------------------- */
    /* start CHOLMOD and set parameters */
    /* ---------------------------------------------------------------------- */

    cm = &Common ;
    cholmod_l_start (cm) ;
    sputil_config (SPUMONI, cm) ;

    /* ---------------------------------------------------------------------- */
    /* check inputs */
    /* ---------------------------------------------------------------------- */

    if (nargin != 5 || nargout > 2)
    {
        mexErrMsgTxt ("usage: [x xset] = lsubsolve (L,kind,P,b,system)") ;
    }

    n = mxGetN (pargin [0]) ;
    if (!mxIsSparse (pargin [0]) || n != mxGetM (pargin [0]))
    {
        mexErrMsgTxt ("lsubsolve: L must be sparse and square") ;
    }
    if (mxGetNumberOfElements (pargin [1]) != 1)
    {
        mexErrMsgTxt ("lsubsolve: kind must be a scalar") ;
    }

    if (mxIsSparse (pargin [2]) ||
            !(mxIsEmpty (pargin [2]) || mxGetNumberOfElements (pargin [2]) == n))
    {
        mexErrMsgTxt ("lsubsolve: P must be size n, or empty") ;
    }

    if (mxGetM (pargin [3]) != n || mxGetN (pargin [3]) != 1)
    {
        mexErrMsgTxt ("lsubsolve: b wrong dimension") ;
    }
    if (!mxIsSparse (pargin [3]))
    {
        mexErrMsgTxt ("lxbpattern: b must be sparse") ;
    }
    if (mxGetNumberOfElements (pargin [4]) != 1)
    {
        mexErrMsgTxt ("lsubsolve: system must be a scalar") ;
    }

    /* ---------------------------------------------------------------------- */
    /* get the inputs */
    /* ---------------------------------------------------------------------- */

    kind = (int) sputil_get_integer (pargin [1], FALSE, 0) ;
    sys  = (int) sputil_get_integer (pargin [4], FALSE, 0) ;

    /* ---------------------------------------------------------------------- */
    /* get the sparse b */
    /* ---------------------------------------------------------------------- */

    /* get sparse matrix B (unsymmetric) */
    Bset = sputil_get_sparse (pargin [3], &Bmatrix, &dummy, 0) ;
    Bdense = cholmod_l_sparse_to_dense (Bset, cm) ;
    Bset->x = NULL ;
    Bset->z = NULL ;
    Bset->xtype = CHOLMOD_PATTERN ;

    /* ---------------------------------------------------------------------- */
    /* construct a shallow copy of the input sparse matrix L */
    /* ---------------------------------------------------------------------- */

    /* the construction of the CHOLMOD takes O(n) time and memory */

    /* allocate the CHOLMOD symbolic L */
    L = cholmod_l_allocate_factor (n, cm) ;
    L->ordering = CHOLMOD_NATURAL ;

    /* get the MATLAB L */
    L->p = mxGetJc (pargin [0]) ;
    L->i = mxGetIr (pargin [0]) ;
    L->x = mxGetPr (pargin [0]) ;
    L->z = mxGetPi (pargin [0]) ;

    /* allocate and initialize the rest of L */
    L->nz = cholmod_l_malloc (n, sizeof (Long), cm) ;
    Lp = L->p ;
    Lnz = L->nz ;
    for (j = 0 ; j < n ; j++)
    {
        Lnz [j] = Lp [j+1] - Lp [j] ;
    }

    /* these pointers are not accessed in cholmod_solve2 */
    L->prev = cholmod_l_malloc (n+2, sizeof (Long), cm) ;
    L->next = cholmod_l_malloc (n+2, sizeof (Long), cm) ;
    Lprev = L->prev ;
    Lnext = L->next ;

    head = n+1 ;
    tail = n ;
    Lnext [head] = 0 ;
    Lprev [head] = -1 ;
    Lnext [tail] = -1 ;
    Lprev [tail] = n-1 ;
    for (j = 0 ; j < n ; j++)
    {
        Lnext [j] = j+1 ;
        Lprev [j] = j-1 ;
    }
    Lprev [0] = head ;

    L->xtype = (mxIsComplex (pargin [0])) ? CHOLMOD_ZOMPLEX : CHOLMOD_REAL ;
    L->nzmax = Lp [n] ;

    /* get the permutation */
    if (mxIsEmpty (pargin [2]))
    {
        L->Perm = NULL ;
        Perm = NULL ;
    }
    else
    {
        L->ordering = CHOLMOD_GIVEN ;
        L->Perm = cholmod_l_malloc (n, sizeof (Long), cm) ;
        Perm = L->Perm ;
        Px = mxGetPr (pargin [2]) ;
        for (k = 0 ; k < n ; k++)
        {
            Perm [k] = ((Long) Px [k]) - 1 ;
        }
    }

    /* set the kind, LL' or LDL' */
    L->is_ll = (kind == 0) ;
    /*
    cholmod_l_print_factor (L, "L", cm) ;
    */

    /* ---------------------------------------------------------------------- */
    /* solve the system */
    /* ---------------------------------------------------------------------- */

    X = cholmod_l_zeros (n, 1, L->xtype, cm) ;
    Xset = NULL ;
    Y = NULL ;
    E = NULL ;

    cholmod_l_solve2 (sys, L, Bdense, Bset, &X, &Xset, &Y, &E, cm) ;

    cholmod_l_free_dense (&Y, cm) ;
    cholmod_l_free_dense (&E, cm) ;

    /* ---------------------------------------------------------------------- */
    /* return result */
    /* ---------------------------------------------------------------------- */

    pargout [0] = sputil_put_dense (&X, cm) ;

    /* fill numerical values of Xset with one's */
    Xsetp = Xset->p ;
    xsetlen = Xsetp [1] ;
    Xset->x = cholmod_l_malloc (xsetlen, sizeof (double), cm) ;
    Xsetx = Xset->x ;
    for (k = 0 ; k < xsetlen ; k++)
    {
        Xsetx [k] = 1 ;
    }
    Xset->xtype = CHOLMOD_REAL ;

    pargout [1] = sputil_put_sparse (&Xset, cm) ;

    /* ---------------------------------------------------------------------- */
    /* free workspace and the CHOLMOD L, except for what is copied to MATLAB */
    /* ---------------------------------------------------------------------- */

    L->p = NULL ;
    L->i = NULL ;
    L->x = NULL ;
    L->z = NULL ;
    cholmod_l_free_factor (&L, cm) ;
    cholmod_l_finish (cm) ;
    cholmod_l_print_common (" ", cm) ;
}
Example #25
0
void mexFunction
(
    int	nargout,
    mxArray *pargout [ ],
    int	nargin,
    const mxArray *pargin [ ]
)
{
    double dummy = 0 ;
    cholmod_sparse Amatrix, *A ;
    cholmod_common Common, *cm ;
    Long result, quick, option, xmatched, pmatched, nzoffdiag, nzdiag ;

    /* ---------------------------------------------------------------------- */
    /* start CHOLMOD and set parameters */ 
    /* ---------------------------------------------------------------------- */

    cm = &Common ;
    cholmod_l_start (cm) ;
    sputil_config (SPUMONI, cm) ;

    /* ---------------------------------------------------------------------- */
    /* get inputs */
    /* ---------------------------------------------------------------------- */

    if (nargin > 2 || nargin < 1 || nargout > 5)
    {
	mexErrMsgTxt ("usage: [s xmatch pmatch nzoff nzd] = spsym (A,quick)") ;
    }
    if (!mxIsSparse (pargin [0]))
    {
    	mexErrMsgTxt ("A must be sparse and double") ;
    }

    /* get sparse matrix A */
    A = sputil_get_sparse (pargin [0], &Amatrix, &dummy, 0) ;

    /* get the "quick" parameter */
    quick = (nargin > 1) ? (mxGetScalar (pargin [1]) != 0) : FALSE ;

    if (nargout > 1)
    {
	option = 2 ;
    }
    else if (quick)
    {
	option = 0 ;
    }
    else
    {
	option = 1 ;
    }

    /* ---------------------------------------------------------------------- */
    /* determine symmetry */
    /* ---------------------------------------------------------------------- */

    xmatched = 0 ;
    pmatched = 0 ;
    nzoffdiag = 0 ;
    nzdiag = 0 ;

    result = cholmod_l_symmetry (A, option, &xmatched, &pmatched, &nzoffdiag,
	&nzdiag, cm) ;

    /* ---------------------------------------------------------------------- */
    /* return results to MATLAB */
    /* ---------------------------------------------------------------------- */

    pargout [0] = sputil_put_int (&result, 1, 0) ;

    if (nargout > 1) pargout [1] = sputil_put_int (&xmatched, 1, 0) ;
    if (nargout > 2) pargout [2] = sputil_put_int (&pmatched, 1, 0) ;
    if (nargout > 3) pargout [3] = sputil_put_int (&nzoffdiag, 1, 0) ;
    if (nargout > 4) pargout [4] = sputil_put_int (&nzdiag, 1, 0) ;

    /* ---------------------------------------------------------------------- */
    /* free workspace */
    /* ---------------------------------------------------------------------- */

    cholmod_l_finish (cm) ;
    cholmod_l_print_common (" ", cm) ;
}
Example #26
0
File: init.c Project: rforge/matrix
void R_unload_Matrix(DllInfo *dll)
{
    cholmod_l_finish(&c);
}
Example #27
0
void mexFunction
(
    int	nargout,
    mxArray *pargout [ ],
    int	nargin,
    const mxArray *pargin [ ]
    )
{
  double dummy = 0, beta [2], *px, *C, *Ct, *C2, *fil, *Zt, *zt, done=1.0, *zz, dzero=0.0;
  cholmod_sparse Amatrix, *A, *Lsparse ;
  cholmod_factor *L ;
  cholmod_common Common, *cm ;
  Int minor, *It2, *Jt2 ;
  mwIndex l, k2, h, k, i, j, ik, *I, *J, *Jt, *It, *I2, *J2, lfi, *w, *w2, *r;
  mwSize nnz, nnzlow, m, n;
  int nz = 0;
  mwSignedIndex one=1, lfi_si;
  mxArray *Am, *Bm;
  char *uplo="L", *trans="N";
  

  /* ---------------------------------------------------------------------- */
  /* Only one input. We have to find first the Cholesky factorization.      */ 
  /* start CHOLMOD and set parameters */ 
  /* ---------------------------------------------------------------------- */

  if (nargin == 1) {
    cm = &Common ;
    cholmod_l_start (cm) ;
    sputil_config (SPUMONI, cm) ;
    
    /* convert to packed LDL' when done */
    cm->final_asis = FALSE ;
    cm->final_super = FALSE ;
    cm->final_ll = FALSE ;
    cm->final_pack = TRUE ;
    cm->final_monotonic = TRUE ;

    /* since numerically zero entries are NOT dropped from the symbolic
     * pattern, we DO need to drop entries that result from supernodal
     * amalgamation. */
    cm->final_resymbol = TRUE ;

    cm->quick_return_if_not_posdef = (nargout < 2) ;
  }

  /* This will disable the supernodal LL', which will be slow. */
  /* cm->supernodal = CHOLMOD_SIMPLICIAL ; */
  
  /* ---------------------------------------------------------------------- */
  /* get inputs */
  /* ---------------------------------------------------------------------- */
  
  if (nargin > 3)
    {
      mexErrMsgTxt ("usage: Z = sinv(A), or Z = sinv(LD, 1)") ;
    }
  
  n = mxGetM (pargin [0]) ;
  m = mxGetM (pargin [0]) ;
  
  if (!mxIsSparse (pargin [0]))
    {
      mexErrMsgTxt ("A must be sparse") ;
    }
  if (n != mxGetN (pargin [0]))
    {
      mexErrMsgTxt ("A must be square") ;
    }

  /* Only one input. We have to find first the Cholesky factorization.      */
  if (nargin == 1) {
    /* get sparse matrix A, use tril(A)  */
    A = sputil_get_sparse (pargin [0], &Amatrix, &dummy, -1) ; 
    
    A->stype = -1 ;	    /* use lower part of A */
    beta [0] = 0 ;
    beta [1] = 0 ;
    
    /* ---------------------------------------------------------------------- */
    /* analyze and factorize */
    /* ---------------------------------------------------------------------- */
    
    L = cholmod_l_analyze (A, cm) ;
    cholmod_l_factorize_p (A, beta, NULL, 0, L, cm) ;
    
    if (cm->status != CHOLMOD_OK)
      {
	mexErrMsgTxt ("matrix is not positive definite") ;
      }
    
    /* ---------------------------------------------------------------------- */
    /* convert L to a sparse matrix */
    /* ---------------------------------------------------------------------- */

    Lsparse = cholmod_l_factor_to_sparse (L, cm) ;
    if (Lsparse->xtype == CHOLMOD_COMPLEX)
      {
	mexErrMsgTxt ("matrix is complex") ;
      }
    
    /* ---------------------------------------------------------------------- */
    /* Set the sparse Cholesky factorization in Matlab format */
    /* ---------------------------------------------------------------------- */
    /*Am = sputil_put_sparse (&Lsparse, cm) ;
      I = mxGetIr(Am);
      J = mxGetJc(Am);
      C = mxGetPr(Am);
      nnz = mxGetNzmax(Am); */

    It2 = Lsparse->i;
    Jt2 = Lsparse->p;
    Ct = Lsparse->x;
    nnz = (mwSize) Lsparse->nzmax;

    Am = mxCreateSparse(m, m, nnz, mxREAL) ;
    I = mxGetIr(Am);
    J = mxGetJc(Am);
    C = mxGetPr(Am);
    for (j = 0 ;  j < n+1 ; j++)  J[j] = (mwIndex) Jt2[j];
    for ( i = 0 ; i < nnz ; i++) {
	I[i] = (mwIndex) It2[i];
	C[i] = Ct[i];
    }
    
    cholmod_l_free_sparse (&Lsparse, cm) ;

    /*FILE *out1 = fopen( "output1.txt", "w" );
    if( out1 != NULL )
      fprintf( out1, "Hello %d\n", nnz );
      fclose (out1);*/
    
  } else {
    /* The cholesky factorization is given as an input.      */
    /* We have to copy it into workspace                     */
    It = mxGetIr(pargin [0]);
    Jt = mxGetJc(pargin [0]);
    Ct = mxGetPr(pargin [0]);
    nnz = mxGetNzmax(pargin [0]);
    
    Am = mxCreateSparse(m, m, nnz, mxREAL) ;
    I = mxGetIr(Am);
    J = mxGetJc(Am);
    C = mxGetPr(Am);
    for (j = 0 ;  j < n+1 ; j++)  J[j] = Jt[j];
    for ( i = 0 ; i < nnz ; i++) {
	I[i] = It[i];
	C[i] = Ct[i];
    }    
  }

  /* Evaluate the sparse inverse */
  C[nnz-1] = 1.0/C[J[m-1]];               /* set the last element of sparse inverse */
  fil = mxCalloc((mwSize)1,sizeof(double));
  zt = mxCalloc((mwSize)1,sizeof(double));
  Zt = mxCalloc((mwSize)1,sizeof(double));
  zz = mxCalloc((mwSize)1,sizeof(double));
  for (j=m-2;j!=-1;j--){
    lfi = J[j+1]-(J[j]+1);
    
    /* if (lfi > 0) */
    if ( J[j+1] > (J[j]+1) )
      {
	/*	printf("lfi = %u \n ", lfi);
	printf("lfi*double = %u \n", (mwSize)lfi*sizeof(double));
	printf("lfi*lfi*double = %u \n", (mwSize)lfi*(mwSize)lfi*sizeof(double));
	printf("\n \n");
	*/
	
	fil = mxRealloc(fil,(mwSize)lfi*sizeof(double));
	for (i=0;i<lfi;i++) fil[i] = C[J[j]+i+1];                   /* take the j'th lower triangular column of the Cholesky */
	
	zt = mxRealloc(zt,(mwSize)lfi*sizeof(double));              /* memory for the sparse inverse elements to be evaluated */
	Zt = mxRealloc(Zt,(mwSize)lfi*(mwSize)lfi*sizeof(double));  /* memory for the needed sparse inverse elements */
	
	/* Set the lower triangular for Zt */
	k2 = 0;
	for (k=J[j]+1;k<J[j+1];k++){
	  ik = I[k];
	  h = k2;
	  for (l=J[ik];l<=J[ik+1];l++){
	    if (I[l] == I[ J[j]+h+1 ]){
	      Zt[h+lfi*k2] = C[l];
	      h++;
	    }
	  }
	  k2++;
	}
	
	
	/* evaluate zt = fil*Zt */
	lfi_si = (mwSignedIndex) lfi;
	dsymv(uplo, &lfi_si, &done, Zt, &lfi_si, fil, &one, &dzero, zt, &one);
	
	/* Set the evaluated sparse inverse elements, zt, into C */
	k=lfi-1;
	for (i = J[j+1]-1; i!=J[j] ; i--){
	  C[i] = -zt[k];
	  k--;
	}
	/* evaluate the j'th diagonal of sparse inverse */
	dgemv(trans, &one, &lfi_si, &done, fil, &one, zt, &one, &dzero, zz, &one); 
	C[J[j]] = 1.0/C[J[j]] + zz[0];
      }
    else
      {
	/* evaluate the j'th diagonal of sparse inverse */
	C[J[j]] = 1.0/C[J[j]];	
      }
  }
    
  /* Free the temporary variables */
  mxFree(fil);
  mxFree(zt);
  mxFree(Zt);
  mxFree(zz);

  /* ---------------------------------------------------------------------- */
  /* Permute the elements according to r(q) = 1:n                           */
  /* Done only if the Cholesky was evaluated here                           */
  /* ---------------------------------------------------------------------- */
  if (nargin == 1) {
   
    Bm = mxCreateSparse(m, m, nnz, mxREAL) ;     
    It = mxGetIr(Bm);
    Jt = mxGetJc(Bm);
    Ct = mxGetPr(Bm);                            /* Ct = C(r,r) */ 
    
    r = (mwIndex *) L->Perm;                         /* fill reducing ordering */
    w = mxCalloc(m,sizeof(mwIndex));                 /* column counts of Am */
    
    /* count entries in each column of Bm */
    for (j=0; j<m; j++){
      k = r ? r[j] : j ;       /* column j of Bm is column k of Am */
      for (l=J[j] ; l<J[j+1] ; l++){
	i = I[l];
	ik = r ? r[i] : i ;    /* row i of Bm is row ik of Am */
	w[ max(ik,k) ]++;
      }
    }
    cumsum2(Jt, w, m);
    for (j=0; j<m; j++){
      k = r ? r[j] : j ;             /* column j of Bm is column k of Am */
      for (l=J[j] ; l<J[j+1] ; l++){
	i= I[l];
	ik = r ? r[i] : i ;          /* row i of Bm is row ik of Am */
	It [k2 = w[max(ik,k)]++ ] = min(ik,k);
	Ct[k2] = C[l];
      }
    }
    mxFree(w);
    
    /* ---------------------------------------------------------------------- */
    /* Transpose the permuted (upper triangular) matrix Bm into Am */
    /* (this way we get sorted columns)                            */
    /* ---------------------------------------------------------------------- */
    w = mxCalloc(m,sizeof(mwIndex));                 
    for (i=0 ; i<Jt[m] ; i++) w[It[i]]++;        /* row counts of Bm */
    cumsum2(J, w, m);                            /* row pointers */
    for (j=0 ; j<m ; j++){
      for (i=Jt[j] ; i<Jt[j+1] ; i++){
	I[ l=w[ It[i] ]++ ] = j;
	C[l] = Ct[i];
      }
    }
    mxFree(w);
    mxDestroyArray(Bm);
  }
  
  /* ---------------------------------------------------------------------- */
  /* Fill the upper triangle of the sparse inverse */
  /* ---------------------------------------------------------------------- */
  
  w = mxCalloc(m,sizeof(mwIndex));        /* workspace */
  w2 = mxCalloc(m,sizeof(mwIndex));       /* workspace */
  for (k=0;k<J[m];k++) w[I[k]]++;     /* row counts of the lower triangular */
  for (k=0;k<m;k++) w2[k] = w[k] + J[k+1] - J[k] - 1;   /* column counts of the sparse inverse */
  
  nnz = (mwSize)2*nnz - m;                       /* The number of nonzeros in Z */
  pargout[0] = mxCreateSparse(m,m,nnz,mxREAL);   /* The sparse matrix */
  It = mxGetIr(pargout[0]);
  Jt = mxGetJc(pargout[0]);
  Ct = mxGetPr(pargout[0]);
  
  cumsum2(Jt, w2, m);               /* column starting points */
  for (j = 0 ; j < m ; j++){           /* fill the upper triangular */
    for (k = J[j] ; k < J[j+1] ; k++){
      It[l = w2[ I[k]]++] = j ;	 /* place C(i,j) as entry Ct(j,i) */
      if (Ct) Ct[l] = C[k] ;
    }
  }
  for (j = 0 ; j < m ; j++){           /* fill the lower triangular */
    for (k = J[j]+1 ; k < J[j+1] ; k++){
      It[l = w2[j]++] = I[k] ;         /* place C(j,i) as entry Ct(j,i) */
      if (Ct) Ct[l] = C[k] ;
    }
  }
  
  mxFree(w2);
  mxFree(w);
  
  /* ---------------------------------------------------------------------- */
  /* return to MATLAB */
  /* ---------------------------------------------------------------------- */
  
  /* ---------------------------------------------------------------------- */
  /* free workspace and the CHOLMOD L, except for what is copied to MATLAB */
  /* ---------------------------------------------------------------------- */
  if (nargin == 1) {
    cholmod_l_free_factor (&L, cm) ;
    cholmod_l_finish (cm) ;
    cholmod_l_print_common (" ", cm) ;
  }
  mxDestroyArray(Am);
  
}
Example #28
0
int main (int argc, char **argv)
{
    cholmod_sparse *A, *R ;
    cholmod_dense *B, *C ;
    SuiteSparse_long *E ;
    int mtype ;
    long m, n, rnk ;
    size_t total_mem, available_mem ;
    double t ;

    // start CHOLMOD
    cholmod_common *cc, Common ;
    cc = &Common ;
    cholmod_l_start (cc) ;

    // warmup the GPU.  This can take some time, but only needs
    // to be done once
    cc->useGPU = false ;
    t = SuiteSparse_time ( ) ;
    cholmod_l_gpu_memorysize (&total_mem, &available_mem, cc) ;
    cc->gpuMemorySize = available_mem ;
    t = SuiteSparse_time ( ) - t ;
    if (cc->gpuMemorySize <= 1)
    {
        printf ("no GPU available\n") ;
    }
    printf ("available GPU memory: %g MB, warmup time: %g\n",
        (double) (cc->gpuMemorySize) / (1024 * 1024), t) ;

    // A = mread (stdin) ; read in the sparse matrix A
    const char *filename = argv[1];
    FILE *file = fopen(filename, "r");
    A = (cholmod_sparse *) cholmod_l_read_matrix (file, 1, &mtype, cc) ;
    fclose(file);
    if (mtype != CHOLMOD_SPARSE)
    {
        printf ("input matrix must be sparse\n") ;
        exit (1) ;
    }

    // [m n] = size (A) ;
    m = A->nrow ;
    n = A->ncol ;

    long ordering = (argc < 3 ? SPQR_ORDERING_DEFAULT : atoi(argv[2]));

    printf ("Matrix %6ld-by-%-6ld nnz: %6ld\n",
        m, n, cholmod_l_nnz (A, cc)) ;

    // B = ones (m,1), a dense right-hand-side of the same type as A
    B = cholmod_l_ones (m, 1, A->xtype, cc) ;

    double tol = SPQR_NO_TOL ;
    long econ = 0 ;

    // [Q,R,E] = qr (A), but discard Q
    // SuiteSparseQR <double> (ordering, tol, econ, A, &R, &E, cc) ;

    // [C,R,E] = qr (A,b), but discard Q
    SuiteSparseQR <double> (ordering, tol, econ, A, B, &C, &R, &E, cc) ;

    // now R'*R-A(:,E)'*A(:,E) should be epsilon
    // and C = Q'*b.  The solution to the least-squares problem
    // should be x=R\C.

    // write out R to a file
    FILE *f = fopen ("R.mtx", "w") ;
    cholmod_l_write_sparse (f, R, NULL, NULL, cc) ;
    fclose (f) ;

    // write out C to a file
    f = fopen ("C.mtx", "w") ;
    cholmod_l_write_dense (f, C, NULL, cc) ;
    fclose (f) ;

    // write out E to a file
    f = fopen ("E.txt", "w") ;
    for (long i = 0 ; i < n ; i++)
    {
        fprintf (f, "%ld\n", 1 + E [i]) ;
    }
    fclose (f) ;

    // free everything
    cholmod_l_free_sparse (&A, cc) ;
    cholmod_l_free_sparse (&R, cc) ;
    cholmod_l_free_dense  (&C, cc) ;
    // cholmod_l_free (&E, cc) ;
    cholmod_l_finish (cc) ;

    return (0) ;
}
Example #29
0
File: chol2.c Project: GHilmarG/Ua
void mexFunction
(
    int	nargout,
    mxArray *pargout [ ],
    int	nargin,
    const mxArray *pargin [ ]
)
{
    double dummy = 0, *px ;
    cholmod_sparse Amatrix, *A, *Lsparse, *R ;
    cholmod_factor *L ;
    cholmod_common Common, *cm ;
    Long n, minor ;

    /* ---------------------------------------------------------------------- */
    /* start CHOLMOD and set parameters */ 
    /* ---------------------------------------------------------------------- */

    cm = &Common ;
    cholmod_l_start (cm) ;
    sputil_config (SPUMONI, cm) ;

    /* convert to packed LL' when done */
    cm->final_asis = FALSE ;
    cm->final_super = FALSE ;
    cm->final_ll = TRUE ;
    cm->final_pack = TRUE ;
    cm->final_monotonic = TRUE ;

    /* no need to prune entries due to relaxed supernodal amalgamation, since
     * zeros are dropped with sputil_drop_zeros instead */
    cm->final_resymbol = FALSE ;

    cm->quick_return_if_not_posdef = (nargout < 2) ;

    /* ---------------------------------------------------------------------- */
    /* get inputs */
    /* ---------------------------------------------------------------------- */

    if (nargin != 1 || nargout > 3)
    {
	mexErrMsgTxt ("usage: [R,p,q] = chol2 (A)") ;
    }

    n = mxGetN (pargin [0]) ;

    if (!mxIsSparse (pargin [0]) || n != mxGetM (pargin [0]))
    {
    	mexErrMsgTxt ("A must be square and sparse") ;
    }

    /* get input sparse matrix A.  Use triu(A) only */
    A = sputil_get_sparse (pargin [0], &Amatrix, &dummy, 1) ;

    /* use natural ordering if no q output parameter */
    if (nargout < 3)
    {
	cm->nmethods = 1 ;
	cm->method [0].ordering = CHOLMOD_NATURAL ;
	cm->postorder = FALSE ;
    }

    /* ---------------------------------------------------------------------- */
    /* analyze and factorize */
    /* ---------------------------------------------------------------------- */

    L = cholmod_l_analyze (A, cm) ;
    cholmod_l_factorize (A, L, cm) ;

    if (nargout < 2 && cm->status != CHOLMOD_OK)
    {
	mexErrMsgTxt ("matrix is not positive definite") ;
    }

    /* ---------------------------------------------------------------------- */
    /* convert L to a sparse matrix */
    /* ---------------------------------------------------------------------- */

    /* the conversion sets L->minor back to n, so get a copy of it first */
    minor = L->minor ;
    Lsparse = cholmod_l_factor_to_sparse (L, cm) ;
    if (Lsparse->xtype == CHOLMOD_COMPLEX)
    {
	/* convert Lsparse from complex to zomplex */
	cholmod_l_sparse_xtype (CHOLMOD_ZOMPLEX, Lsparse, cm) ;
    }

    if (minor < n)
    {
	/* remove columns minor to n-1 from Lsparse */
	sputil_trim (Lsparse, minor, cm) ;
    }

    /* drop zeros from Lsparse */
    sputil_drop_zeros (Lsparse) ;

    /* Lsparse is lower triangular; conjugate transpose to get R */
    R = cholmod_l_transpose (Lsparse, 2, cm) ;
    cholmod_l_free_sparse (&Lsparse, cm) ;

    /* ---------------------------------------------------------------------- */
    /* return results to MATLAB */
    /* ---------------------------------------------------------------------- */

    /* return R */
    pargout [0] = sputil_put_sparse (&R, cm) ;

    /* return minor (translate to MATLAB convention) */
    if (nargout > 1)
    {
	pargout [1] = mxCreateDoubleMatrix (1, 1, mxREAL) ;
	px = mxGetPr (pargout [1]) ;
	px [0] = ((minor == n) ? 0 : (minor+1)) ;
    }

    /* return permutation */
    if (nargout > 2)
    {
	pargout [2] = sputil_put_int (L->Perm, n, 1) ;
    }

    /* ---------------------------------------------------------------------- */
    /* free workspace and the CHOLMOD L, except for what is copied to MATLAB */
    /* ---------------------------------------------------------------------- */

    cholmod_l_free_factor (&L, cm) ;
    cholmod_l_finish (cm) ;
    cholmod_l_print_common (" ", cm) ;
    /*
    if (cm->malloc_count != (3 + mxIsComplex (pargout[0]))) mexErrMsgTxt ("!") ;
    */
}
Example #30
0
void mexFunction
(
    int nargout,
    mxArray *pargout [ ],
    int nargin,
    const mxArray *pargin [ ]
)
{
    Int *Ap, *Ai, *E, *Bp, *Bi, *HPinv ;
    double *Ax, *Bx, dummy, tol ;
    Int m, n, anz, bnz, is_complex, econ, A_complex, B_complex ;
    spqr_mx_options opts ;
    cholmod_sparse *A, Amatrix, *R, *Q, *Csparse, Bsmatrix, *Bsparse, *H ;
    cholmod_dense *Cdense, Bdmatrix, *Bdense, *HTau ;
    cholmod_common Common, *cc ;

#ifdef TIMING
    double t0 = (nargout > 3) ? spqr_time ( ) : 0 ;
#endif

    // -------------------------------------------------------------------------
    // start CHOLMOD and set parameters
    // -------------------------------------------------------------------------

    cc = &Common ;
    cholmod_l_start (cc) ;
    spqr_mx_config (SPUMONI, cc) ;

    // -------------------------------------------------------------------------
    // check inputs
    // -------------------------------------------------------------------------

    // nargin can be 1, 2, or 3
    // nargout can be 0, 1, 2, 3, or 4

    if (nargout > 4)
    {
        mexErrMsgIdAndTxt ("MATLAB:maxlhs", "Too many output arguments") ;
    }
    if (nargin < 1)
    {
        mexErrMsgIdAndTxt ("MATLAB:minrhs", "Not enough input arguments") ;
    }
    if (nargin > 3)
    {
        mexErrMsgIdAndTxt ("MATLAB:maxrhs", "Too many input arguments") ;
    }

    // -------------------------------------------------------------------------
    // get the input matrix A
    // -------------------------------------------------------------------------

    if (!mxIsSparse (pargin [0]))
    {
        mexErrMsgIdAndTxt ("QR:invalidInput", "A must be sparse") ;
    }

    A = spqr_mx_get_sparse (pargin [0], &Amatrix, &dummy) ;
    Ap = (Int *) A->p ;
    Ai = (Int *) A->i ;
    m = A->nrow ;
    n = A->ncol ;
    A_complex = mxIsComplex (pargin [0]) ;

    // -------------------------------------------------------------------------
    // determine usage and parameters
    // -------------------------------------------------------------------------

    if (nargin == 1)
    {

        // ---------------------------------------------------------------------
        // [ ] = qr (A)
        // ---------------------------------------------------------------------

        spqr_mx_get_options (NULL, &opts, m, nargout, cc) ;
        // R = qr (A)
        // [Q,R] = qr (A)
        // [Q,R,E] = qr (A)

    }
    else if (nargin == 2)
    {

        // ---------------------------------------------------------------------
        // [ ] = qr (A,0), [ ] = qr (A,opts), or [ ] = qr (A,B)
        // ---------------------------------------------------------------------

        if (is_zero (pargin [1]))
        {

            // -----------------------------------------------------------------
            // [ ... ] = qr (A,0)
            // -----------------------------------------------------------------

            spqr_mx_get_options (NULL, &opts, m, nargout, cc) ;
            opts.econ = n ;
            opts.permvector = TRUE ;
            // R = qr (A,0)
            // [Q,R] = qr (A,0)
            // [Q,R,E] = qr (A,0)

        }
        else if (mxIsEmpty (pargin [1]) || mxIsStruct (pargin [1]))
        {

            // -----------------------------------------------------------------
            // [ ] = qr (A,opts)
            // -----------------------------------------------------------------

            spqr_mx_get_options (pargin [1], &opts, m, nargout, cc) ;
            // R = qr (A,opts)
            // [Q,R] = qr (A,opts)
            // [Q,R,E] = qr (A,opts)

        }
        else
        {

            // -----------------------------------------------------------------
            // [ ] = qr (A,B)
            // -----------------------------------------------------------------

            spqr_mx_get_options (NULL, &opts, m, nargout, cc) ;
            opts.haveB = TRUE ;
            opts.Qformat = SPQR_Q_DISCARD ;
            if (nargout <= 1)
            {
                mexErrMsgIdAndTxt ("MATLAB:minlhs",
                    "Not enough output arguments") ;
            }
            // [C,R] = qr (A,B)
            // [C,R,E] = qr (A,B)

        }

    }
    else // if (nargin == 3)
    {

        // ---------------------------------------------------------------------
        // [ ] = qr (A,B,opts)
        // ---------------------------------------------------------------------

        if (is_zero (pargin [2]))
        {

            // -----------------------------------------------------------------
            // [ ] = qr (A,B,0)
            // -----------------------------------------------------------------

            spqr_mx_get_options (NULL, &opts, m, nargout, cc) ;
            opts.econ = n ;
            opts.permvector = TRUE ;
            opts.haveB = TRUE ;
            opts.Qformat = SPQR_Q_DISCARD ;
            if (nargout <= 1)
            {
                mexErrMsgIdAndTxt ("MATLAB:minlhs",
                    "Not enough output arguments") ;
            }
            // [C,R] = qr (A,B,0)
            // [C,R,E] = qr (A,B,0)

        }
        else if (mxIsEmpty (pargin [2]) || mxIsStruct (pargin [2]))
        {

            // -----------------------------------------------------------------
            // [ ] = qr (A,B,opts)
            // -----------------------------------------------------------------

            spqr_mx_get_options (pargin [2], &opts, m, nargout, cc) ;
            opts.haveB = TRUE ;
            opts.Qformat = SPQR_Q_DISCARD ;
            if (nargout <= 1)
            {
                mexErrMsgIdAndTxt ("MATLAB:minlhs",
                    "Not enough output arguments") ;
            }
            // [C,R] = qr (A,B,opts)
            // [C,R,E] = qr (A,B,opts)

        }
        else
        {
            mexErrMsgIdAndTxt ("QR:invalidInput", "Invalid opts argument") ;
        }
    }

    int order = opts.ordering ;
    tol = opts.tol ;
    econ = opts.econ ;

    // -------------------------------------------------------------------------
    // get A and convert to merged-complex if needed
    // -------------------------------------------------------------------------

    if (opts.haveB)
    {
        B_complex = mxIsComplex (pargin [1]) ;
    }
    else
    {
        B_complex = FALSE ;
    }

    is_complex = (A_complex || B_complex) ;
    Ax = spqr_mx_merge_if_complex (pargin [0], is_complex, &anz, cc) ; 
    if (is_complex)
    {
        // A has been converted from real or zomplex to complex
        A->x = Ax ;
        A->z = NULL ;
        A->xtype = CHOLMOD_COMPLEX ;
    }

    // -------------------------------------------------------------------------
    // analyze, factorize, and get the results
    // -------------------------------------------------------------------------

    if (opts.haveB)
    {

        // ---------------------------------------------------------------------
        // get B, and convert to complex if necessary
        // ---------------------------------------------------------------------

        if (!mxIsNumeric (pargin [1]))
        {
            mexErrMsgIdAndTxt ("QR:invalidInput", "invalid non-numeric B") ;
        }
        if (mxGetM (pargin [1]) != m)
        {
            mexErrMsgIdAndTxt ("QR:invalidInput",
                "A and B must have the same number of rows") ;
        }

        // convert from real or zomplex to complex
        Bx = spqr_mx_merge_if_complex (pargin [1], is_complex, &bnz, cc) ;

        int B_is_sparse = mxIsSparse (pargin [1]) ;
        if (B_is_sparse)
        {
            Bsparse = spqr_mx_get_sparse (pargin [1], &Bsmatrix, &dummy) ;
            Bdense = NULL ;
            if (is_complex)
            {
                // Bsparse has been converted from real or zomplex to complex
                Bsparse->x = Bx ;
                Bsparse->z = NULL ;
                Bsparse->xtype = CHOLMOD_COMPLEX ;
            }
        }
        else
        {
            Bsparse = NULL ;
            Bdense = spqr_mx_get_dense (pargin [1], &Bdmatrix, &dummy) ;
            if (is_complex)
            {
                // Bdense has been converted from real or zomplex to complex
                Bdense->x = Bx ;
                Bdense->z = NULL ;
                Bdense->xtype = CHOLMOD_COMPLEX ;
            }
        }

        // ---------------------------------------------------------------------
        // [C,R,E] = qr (A,B,...) or [C,R] = qr (A,B,...)
        // ---------------------------------------------------------------------

        if (is_complex)
        {

            // -----------------------------------------------------------------
            // [C,R,E] = qr (A,B): complex case
            // -----------------------------------------------------------------

            if (B_is_sparse)
            {
                // B and C are both sparse and complex
                SuiteSparseQR <Complex> (order, tol, econ, A, Bsparse,
                    &Csparse, &R, &E, cc) ;
                pargout [0] = spqr_mx_put_sparse (&Csparse, cc) ;
            }
            else
            {
                // B and C are both dense and complex
                SuiteSparseQR <Complex> (order, tol, econ, A, Bdense,
                    &Cdense, &R, &E, cc) ;
                pargout [0] = spqr_mx_put_dense (&Cdense, cc) ;
            }

        }
        else
        {

            // -----------------------------------------------------------------
            // [C,R,E] = qr (A,B): real case
            // -----------------------------------------------------------------

            if (B_is_sparse)
            {
                // B and C are both sparse and real
                SuiteSparseQR <double> (order, tol, econ, A, Bsparse,
                    &Csparse, &R, &E, cc) ;
                pargout [0] = spqr_mx_put_sparse (&Csparse, cc) ;
            }
            else
            {
                // B and C are both dense and real
                SuiteSparseQR <double> (order, tol, econ, A, Bdense,
                    &Cdense, &R, &E, cc) ;
                pargout [0] = spqr_mx_put_dense (&Cdense, cc) ;
            }
        }

        pargout [1] = spqr_mx_put_sparse (&R, cc) ;

    }
    else if (nargout <= 1)
    {

        // ---------------------------------------------------------------------
        // R = qr (A) or R = qr (A,opts)
        // ---------------------------------------------------------------------

        if (is_complex)
        {
            SuiteSparseQR <Complex> (0, tol, econ, A, &R, NULL, cc) ;
        }
        else
        {
            SuiteSparseQR <double> (0, tol, econ, A, &R, NULL, cc) ;
        }
        pargout [0] = spqr_mx_put_sparse (&R, cc) ;

    }
    else
    {

        // ---------------------------------------------------------------------
        // [Q,R,E] = qr (A,...) or [Q,R] = qr (A,...)
        // ---------------------------------------------------------------------

        if (opts.Qformat == SPQR_Q_DISCARD)
        {

            // -----------------------------------------------------------------
            // Q is discarded, and Q = [ ] is returned as a placeholder
            // -----------------------------------------------------------------

            if (is_complex)
            {
                SuiteSparseQR <Complex> (order, tol, econ, A, &R, &E, cc);
            }
            else
            {
                SuiteSparseQR <double> (order, tol, econ, A, &R, &E, cc) ;
            }
            pargout [0] = mxCreateDoubleMatrix (0, 0, mxREAL) ;

        }
        else if (opts.Qformat == SPQR_Q_MATRIX)
        {

            // -----------------------------------------------------------------
            // Q is a sparse matrix
            // -----------------------------------------------------------------

            if (is_complex)
            {
                SuiteSparseQR <Complex> (order, tol, econ, A, &Q, &R, &E, cc) ;
            }
            else
            {
                SuiteSparseQR <double> (order, tol, econ, A, &Q, &R, &E, cc) ;
            }
            pargout [0] = spqr_mx_put_sparse (&Q, cc) ;

        }
        else
        {

            // -----------------------------------------------------------------
            // H is kept, and Q is a struct containing H, Tau, and P
            // -----------------------------------------------------------------

            mxArray *Tau, *P, *Hmatlab ;
            if (is_complex)
            {
                SuiteSparseQR <Complex> (order, tol, econ, A,
                    &R, &E, &H, &HPinv, &HTau, cc) ;
            }
            else
            {
                SuiteSparseQR <double> (order, tol, econ, A,
                    &R, &E, &H, &HPinv, &HTau, cc) ;
            }

            Tau = spqr_mx_put_dense (&HTau, cc) ;
            Hmatlab = spqr_mx_put_sparse (&H, cc) ;

            // Q.P contains the inverse row permutation
            P = mxCreateDoubleMatrix (1, m, mxREAL) ;
            double *Tx = mxGetPr (P) ;
            for (Int i = 0 ; i < m ; i++)
            {
                Tx [i] = HPinv [i] + 1 ;
            }

            // return Q
            const char *Qstruct [ ] = { "H", "Tau", "P" } ;
            pargout [0] = mxCreateStructMatrix (1, 1, 3, Qstruct) ;
            mxSetFieldByNumber (pargout [0], 0, 0, Hmatlab) ;
            mxSetFieldByNumber (pargout [0], 0, 1, Tau) ;
            mxSetFieldByNumber (pargout [0], 0, 2, P) ;

        }
        pargout [1] = spqr_mx_put_sparse (&R, cc) ;
    }

    // -------------------------------------------------------------------------
    // return E
    // -------------------------------------------------------------------------

    if (nargout > 2)
    {
        pargout [2] = spqr_mx_put_permutation (E, n, opts.permvector, cc) ;
    }

    // -------------------------------------------------------------------------
    // free copy of merged-complex, if needed
    // -------------------------------------------------------------------------

    if (is_complex)
    {
        // this was allocated by merge_if_complex
        cholmod_l_free (anz, sizeof (Complex), Ax, cc) ;
        if (opts.haveB)
        {
            cholmod_l_free (bnz, sizeof (Complex), Bx, cc) ;
        }
    }

    // -------------------------------------------------------------------------
    // info output
    // -------------------------------------------------------------------------

    if (nargout > 3)
    {
#ifdef TIMING
        double flops = cc->other1 [0] ;
        double t = spqr_time ( ) - t0 ;
#else
        double flops = -1 ;
        double t = -1 ;
#endif
        pargout [3] = spqr_mx_info (cc, t, flops) ;
    }

    cholmod_l_finish (cc) ;
    if (opts.spumoni > 0) spqr_mx_spumoni (&opts, is_complex, cc) ;
}