All Downloads are FREE. Search and download functionalities are using the official Maven repository.

edu.ufl.cise.klu.tdouble.Dklu_factor Maven / Gradle / Ivy

/**
 * KLU: a sparse LU factorization algorithm.
 * Copyright (C) 2004-2009, Timothy A. Davis.
 * Copyright (C) 2011-2012, Richard W. Lincoln.
 * http://www.cise.ufl.edu/research/sparse/klu
 *
 * -------------------------------------------------------------------------
 *
 * KLU is free software; you can redistribute it and/or
 * modify it under the terms of the GNU Lesser General Public
 * License as published by the Free Software Foundation; either
 * version 2.1 of the License, or (at your option) any later version.
 *
 * KLU is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
 * Lesser General Public License for more details.
 *
 * You should have received a copy of the GNU Lesser General Public
 * License along with this Module; if not, write to the Free Software
 * Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
 *
 */

package edu.ufl.cise.klu.tdouble;

import edu.ufl.cise.klu.common.KLU_common;
import edu.ufl.cise.klu.common.KLU_numeric;
import edu.ufl.cise.klu.common.KLU_symbolic;

import static edu.ufl.cise.klu.tdouble.Dklu_scale.klu_scale;
import static edu.ufl.cise.klu.tdouble.Dklu_memory.klu_malloc_int;
import static edu.ufl.cise.klu.tdouble.Dklu_memory.klu_malloc_dbl;
import static edu.ufl.cise.klu.tdouble.Dklu_memory.klu_add_size_t;
import static edu.ufl.cise.klu.tdouble.Dklu_dump.klu_valid_LU;
import static edu.ufl.cise.klu.tdouble.Dklu_dump.klu_valid;
import static edu.ufl.cise.klu.tdouble.Dklu.klu_kernel_factor;

/**
 * Factor the matrix, after ordering and analyzing it with KLU_analyze
 * or KLU_analyze_given.
 */
public class Dklu_factor extends Dklu_internal
{

	/**
	 *
	 * @param Ap size n+1, column pointers
	 * @param Ai size nz, row indices
	 * @param Ax
	 * @param Symbolic
	 * @param Numeric
	 * @param Common
	 */
	public static void factor2(final int[] Ap, final int[] Ai, final double[] Ax,
			final KLU_symbolic Symbolic, KLU_numeric Numeric, KLU_common Common)
	{
		double lsize ;
		double[] Lnz, Rs ;
		int[] P, Q, R, Pnum, Offp, Offi, Pblock, Pinv, Iwork,
			Lip, Uip, Llen, Ulen ;
		double[] Offx, X, Udiag ;
		double s ;
		double[][] LUbx ;
		int k1, k2, nk, k, block, oldcol, pend, oldrow, n, lnz, unz, p, newrow,
			nblocks, poff, nzoff, scale, max_lnz_block,
			max_unz_block ;
		int[] lnz_block = new int [1] ;
		int[] unz_block = new int [1] ;

		/* ---------------------------------------------------------------------- */
		/* initializations */
		/* ---------------------------------------------------------------------- */

		/* get the contents of the Symbolic object */
		n = Symbolic.n ;
		P = Symbolic.P ;
		Q = Symbolic.Q ;
		R = Symbolic.R ;
		Lnz = Symbolic.Lnz ;
		nblocks = Symbolic.nblocks ;
		nzoff = Symbolic.nzoff ;

		Pnum = Numeric.Pnum ;
		Offp = Numeric.Offp ;
		Offi = Numeric.Offi ;
		Offx = Numeric.Offx ;

		Lip = Numeric.Lip ;
		Uip = Numeric.Uip ;
		Llen = Numeric.Llen ;
		Ulen = Numeric.Ulen ;
		LUbx = Numeric.LUbx ;
		Udiag = Numeric.Udiag ;

		Rs = Numeric.Rs ;
		Pinv = Numeric.Pinv ;
		X = Numeric.Xwork ;              /* X is of size n */
		Iwork = Numeric.Iwork ;		/* 5*maxblock for KLU_factor */
		//Pblock = Iwork + 5*((int) Symbolic.maxblock) ;  /* 1*maxblock for Pblock */
		Pblock = new int [Symbolic.maxblock] ;
		Common.nrealloc = 0 ;
		scale = Common.scale ;
		max_lnz_block = 1 ;
		max_unz_block = 1 ;

		/* compute the inverse of P from symbolic analysis.  Will be updated to
		 * become the inverse of the numerical factorization when the factorization
		 * is done, for use in KLU_refactor */
		if (!NDEBUG)
		{
			for (k = 0 ; k < n ; k++)
			{
				Pinv [k] = EMPTY ;
			}
		}
		for (k = 0 ; k < n ; k++)
		{
			ASSERT (P [k] >= 0 && P [k] < n) ;
			Pinv [P [k]] = k ;
		}
		if (!NDEBUG)
		{
			for (k = 0 ; k < n ; k++) ASSERT (Pinv [k] != EMPTY) ;
		}

		lnz = 0 ;
		unz = 0 ;
		Common.noffdiag = 0 ;
		Offp [0] = 0 ;

		/* ---------------------------------------------------------------------- */
		/* optionally check input matrix and compute scale factors */
		/* ---------------------------------------------------------------------- */

		if (scale >= 0)
		{
			/* use Pnum as workspace. NOTE: scale factors are not yet permuted
			 * according to the final pivot row ordering, so Rs [oldrow] is the
			 * scale factor for A (oldrow,:), for the user's matrix A.  Pnum is
			 * used as workspace in KLU_scale.  When the factorization is done,
			 * the scale factors are permuted according to the final pivot row
			 * permutation, so that Rs [k] is the scale factor for the kth row of
			 * A(p,q) where p and q are the final row and column permutations. */
			klu_scale (scale, n, Ap, Ai, Ax, Rs, Pnum, Common) ;
			if (Common.status < KLU_OK)
			{
				/* matrix is invalid */
				return ;
			}
		}

		if (!NDEBUG)
		{
			if (scale > 0)
			{
				for (k = 0 ; k < n ; k++) PRINTF ("Rs [%d] %g\n", k, Rs [k]) ;
			}
		}

		/* ---------------------------------------------------------------------- */
		/* factor each block using klu */
		/* ---------------------------------------------------------------------- */

		for (block = 0 ; block < nblocks ; block++)
		{

			/* ------------------------------------------------------------------ */
			/* the block is from rows/columns k1 to k2-1 */
			/* ------------------------------------------------------------------ */

			k1 = R [block] ;
			k2 = R [block+1] ;
			nk = k2 - k1 ;
			PRINTF ("FACTOR BLOCK %d, k1 %d k2-1 %d nk %d\n", block, k1,k2-1,nk) ;

			if (nk == 1)
			{

				/* -------------------------------------------------------------- */
				/* singleton case */
				/* -------------------------------------------------------------- */

				poff = Offp [k1] ;
				oldcol = Q [k1] ;
				pend = Ap [oldcol+1] ;
				//CLEAR (s) ;
				s = 0.0;

				if (scale <= 0)
				{
					/* no scaling */
					for (p = Ap [oldcol] ; p < pend ; p++)
					{
						oldrow = Ai [p] ;
						newrow = Pinv [oldrow] ;
						if (newrow < k1)
						{
							Offi [poff] = oldrow ;
							Offx [poff] = Ax [p] ;
							poff++ ;
						}
						else
						{
							ASSERT (newrow == k1) ;
							PRINTF ("singleton block %d", block) ;
							PRINT_ENTRY (Ax [p]) ;
							s = Ax [p] ;
						}
					}
				}
				else
				{
					/* row scaling.  NOTE: scale factors are not yet permuted
					 * according to the pivot row permutation, so Rs [oldrow] is
					 * used below.  When the factorization is done, the scale
					 * factors are permuted, so that Rs [newrow] will be used in
					 * klu_solve, klu_tsolve, and klu_rgrowth */
					for (p = Ap [oldcol] ; p < pend ; p++)
					{
						oldrow = Ai [p] ;
						newrow = Pinv [oldrow] ;
						if (newrow < k1)
						{
							Offi [poff] = oldrow ;
							//SCALE_DIV_ASSIGN (Offx [poff], Ax [p], Rs [oldrow]) ;
							Offx [poff] = Ax [p] / Rs [oldrow] ;
							poff++ ;
						}
						else
						{
							ASSERT (newrow == k1) ;
							PRINTF ("singleton block %d ", block) ;
							PRINT_ENTRY (Ax[p]) ;
							s = Ax [p] / Rs [oldrow] ;
							//SCALE_DIV_ASSIGN (s, Ax [p], Rs [oldrow]) ;
						}
					}
				}

				Udiag [k1] = s ;

				if (IS_ZERO (s))
				{
					/* singular singleton */
					Common.status = KLU_SINGULAR ;
					Common.numerical_rank = k1 ;
					Common.singular_col = oldcol ;
					if (Common.halt_if_singular == 1)
					{
						return ;
					}
				}

				Offp [k1+1] = poff ;
				Pnum [k1] = P [k1] ;
				lnz++ ;
				unz++ ;

			}
			else
			{

				/* -------------------------------------------------------------- */
				/* construct and factorize the kth block */
				/* -------------------------------------------------------------- */

				if (Lnz [block] < 0)
				{
					/* COLAMD was used - no estimate of fill-in */
					/* use 10 times the nnz in A, plus n */
					lsize = -(Common.initmem) ;
				}
				else
				{
					lsize = Common.initmem_amd * Lnz [block] + nk ;
				}

				/* allocates 1 arrays: LUbx [block] */
				Numeric.LUsize [block] = klu_kernel_factor (
						nk, Ap, Ai, Ax, Q,
						lsize, LUbx, block, Udiag, k1, Llen, k1,
						Ulen, k1, Lip, k1, Uip, k1, Pblock, lnz_block, unz_block,
						X, Iwork, k1, Pinv, Rs, Offp, Offi, Offx, Common) ;

				if (Common.status < KLU_OK ||
				   (Common.status == KLU_SINGULAR &&
						   Common.halt_if_singular == 1))
				{
					/* out of memory, invalid inputs, or singular */
					return ;
				}

				PRINTF ("\n----------------------- L %d:\n", block) ;
				if (!NDEBUG) ASSERT (klu_valid_LU (nk, TRUE, Lip, k1, Llen, k1, LUbx [block])) ;
				PRINTF ("\n----------------------- U %d:\n", block) ;
				if (!NDEBUG) ASSERT (klu_valid_LU (nk, FALSE, Uip, k1, Ulen, k1, LUbx [block])) ;

				/* -------------------------------------------------------------- */
				/* get statistics */
				/* -------------------------------------------------------------- */

				lnz += lnz_block[0] ;
				unz += unz_block[0] ;
				max_lnz_block = MAX (max_lnz_block, lnz_block[0]) ;
				max_unz_block = MAX (max_unz_block, unz_block[0]) ;

				if (Lnz [block] == EMPTY)
				{
					/* revise estimate for subsequent factorization */
					Lnz [block] = MAX (lnz_block[0], unz_block[0]) ;
				}

				/* -------------------------------------------------------------- */
				/* combine the klu row ordering with the symbolic pre-ordering */
				/* -------------------------------------------------------------- */

				PRINTF ("Pnum, 1-based:\n") ;
				for (k = 0 ; k < nk ; k++)
				{
					ASSERT (k + k1 < n) ;
					ASSERT (Pblock [k] + k1 < n) ;
					Pnum [k + k1] = P [Pblock [k] + k1] ;
					PRINTF ("Pnum (%d + %d + 1 = %d) = %d + 1 = %d\n",
						k, k1, k+k1+1, Pnum [k+k1], Pnum [k+k1]+1) ;
				}

				/* the local pivot row permutation Pblock is no longer needed */
			}
		}
		ASSERT (nzoff == Offp [n]) ;
		PRINTF ("\n------------------- Off diagonal entries:\n") ;
		if (!NDEBUG) ASSERT (klu_valid (n, Offp, Offi, Offx)) ;

		Numeric.lnz = lnz ;
		Numeric.unz = unz ;
		Numeric.max_lnz_block = max_lnz_block ;
		Numeric.max_unz_block = max_unz_block ;

		/* compute the inverse of Pnum */
		if (!NDEBUG)
		{
			for (k = 0 ; k < n ; k++)
			{
				Pinv [k] = EMPTY ;
			}
		}
		for (k = 0 ; k < n ; k++)
		{
			ASSERT (Pnum [k] >= 0 && Pnum [k] < n) ;
			Pinv [Pnum [k]] = k ;
		}
		if (!NDEBUG)
		{
			for (k = 0 ; k < n ; k++) ASSERT (Pinv [k] != EMPTY) ;
		}

		/* permute scale factors Rs according to pivotal row order */
		if (scale > 0)
		{
			for (k = 0 ; k < n ; k++)
			{
				//REAL (X [k]) = Rs [Pnum [k]] ;
				X [k] = Rs [Pnum [k]] ;
			}
			for (k = 0 ; k < n ; k++)
			{
				Rs [k] = X [k] ; //REAL (X [k]) ;
			}
		}

		PRINTF ("\n------------------- Off diagonal entries, old:\n") ;
		if (!NDEBUG) ASSERT (klu_valid (n, Offp, Offi, Offx)) ;

		/* apply the pivot row permutations to the off-diagonal entries */
		for (p = 0 ; p < nzoff ; p++)
		{
			ASSERT (Offi [p] >= 0 && Offi [p] < n) ;
			Offi [p] = Pinv [Offi [p]] ;
		}

		PRINTF ("\n------------------- Off diagonal entries, new:\n") ;
		if (!NDEBUG) ASSERT (klu_valid (n, Offp, Offi, Offx)) ;

		if (!NDEBUG)
		{
			PRINTF ("\n ############# KLU_BTF_FACTOR done, nblocks %d\n",
					nblocks);
			double ss ;
			Udiag = Numeric.Udiag ;
			for (block = 0 ; block < nblocks && Common.status == KLU_OK ; block++)
			{
				k1 = R [block] ;
				k2 = R [block+1] ;
				nk = k2 - k1 ;
				PRINTF ("\n======================KLU_factor output: k1 %d k2 %d nk %d\n",k1,k2,nk) ;
				if (nk == 1)
				{
					PRINTF ("singleton  ") ;
					/* ENTRY_PRINT (singleton [block]) ; */
					ss = Udiag [k1] ;
					PRINT_ENTRY (ss) ;
				}
				else
				{
					double[] LU ;
					Lip = Numeric.Lip ;
					int Lip_offset = k1 ;
					Llen = Numeric.Llen ;
					int Llen_offset = k1 ;
					LU = (double[]) Numeric.LUbx [block] ;
					PRINTF ("\n---- L block %d\n", block);
					if (!NDEBUG) ASSERT (klu_valid_LU (nk, TRUE, Lip, Lip_offset, Llen, Llen_offset, LU)) ;
					Uip = Numeric.Uip ;
					int Uip_offset = k1 ;
					Ulen = Numeric.Ulen ;
					int Ulen_offset = k1 ;
					PRINTF ("\n---- U block %d\n", block) ;
					if (!NDEBUG) ASSERT (klu_valid_LU (nk, FALSE, Uip, Uip_offset, Ulen, Ulen_offset, LU)) ;
				}
			}
		}
	}

	/**
	 *
	 * @param Ap size n+1, column pointers
	 * @param Ai size nz, row indices
	 * @param Ax
	 * @param Symbolic
	 * @param Common
	 * @return null if error, or a valid KLU_numeric object if successful
	 */
	public static KLU_numeric klu_factor(int[] Ap, int[] Ai, double[] Ax,
			KLU_symbolic Symbolic, KLU_common Common)
	{
		int n, nzoff, nblocks, maxblock, k ;
		int[] ok = new int [] {TRUE} ;
		KLU_numeric Numeric ;
		int n1, nzoff1, s, b6, n3 ;

		if (Common == null)
		{
			return (null) ;
		}
		Common.status = KLU_OK ;
		Common.numerical_rank = EMPTY ;
		Common.singular_col = EMPTY ;

		/* ---------------------------------------------------------------------- */
		/* get the contents of the Symbolic object */
		/* ---------------------------------------------------------------------- */

		/* check for a valid Symbolic object */
		if (Symbolic == null)
		{
			Common.status = KLU_INVALID ;
			return (null) ;
		}

		n = Symbolic.n ;
		nzoff = Symbolic.nzoff ;
		nblocks = Symbolic.nblocks ;
		maxblock = Symbolic.maxblock ;
		PRINTF ("KLU_factor:  n %d nzoff %d nblocks %d maxblock %d\n",
			n, nzoff, nblocks, maxblock) ;

		/* ---------------------------------------------------------------------- */
		/* get control parameters and make sure they are in the proper range */
		/* ---------------------------------------------------------------------- */

		Common.initmem_amd = MAX (1.0, Common.initmem_amd) ;
		Common.initmem = MAX (1.0, Common.initmem) ;
		Common.tol = MIN (Common.tol, 1.0) ;
		Common.tol = MAX (0.0, Common.tol) ;
		Common.memgrow = MAX (1.0, Common.memgrow) ;

		/* ---------------------------------------------------------------------- */
		/* allocate the Numeric object  */
		/* ---------------------------------------------------------------------- */

		/* this will not cause int overflow (already checked by KLU_symbolic) */
		n1 = n + 1 ;
		nzoff1 = nzoff + 1 ;

		//Numeric = klu_malloc (sizeof (KLU_numeric), 1, Common) ;
		try
		{
			Numeric = new KLU_numeric();
		}
		catch (OutOfMemoryError e)
		{
			Common.status = KLU_OUT_OF_MEMORY ;
			return (null) ;
		}
		Numeric.n = n ;
		Numeric.nblocks = nblocks ;
		Numeric.nzoff = nzoff ;
		Numeric.Pnum = klu_malloc_int (n, Common) ;
		Numeric.Offp = klu_malloc_int (n1, Common) ;
		Numeric.Offi = klu_malloc_int (nzoff1, Common) ;
		Numeric.Offx = klu_malloc_dbl (nzoff1, Common) ;

		Numeric.Lip  = klu_malloc_int (n, Common) ;
		Numeric.Uip  = klu_malloc_int (n, Common) ;
		Numeric.Llen = klu_malloc_int (n, Common) ;
		Numeric.Ulen = klu_malloc_int (n, Common) ;

		Numeric.LUsize = klu_malloc_int (nblocks, Common) ;

		//Numeric.LUbx = klu_malloc (nblocks, sizeof (double[]), Common) ;
		Numeric.LUbx = new double [nblocks][] ;
		if (Numeric.LUbx != null)
		{
			for (k = 0 ; k < nblocks ; k++)
			{
				Numeric.LUbx [k] = null ;
			}
		}

		Numeric.Udiag = klu_malloc_dbl (n, Common) ;

		if (Common.scale > 0)
		{
			Numeric.Rs = klu_malloc_dbl (n, Common) ;
		}
		else
		{
			/* no scaling */
			Numeric.Rs = null ;
		}

		Numeric.Pinv = klu_malloc_int (n, Common) ;

		/* allocate permanent workspace for factorization and solve.  Note that the
		 * solver will use an Xwork of size 4n, whereas the factorization codes use
		 * an Xwork of size n and integer space (Iwork) of size 6n. KLU_condest
		 * uses an Xwork of size 2n.  Total size is:
		 *
		 *    n*sizeof(double) + max (6*maxblock*sizeof(Int), 3*n*sizeof(double))
		 */
		//s = klu_mult_size_t (n, sizeof (double), ok) ;
		s = n ;
		//n3 = klu_mult_size_t (n, 3 * sizeof (double), ok) ;
		n3 = 3 * n ;
		//b6 = klu_mult_size_t (maxblock, 6 * sizeof (Int), ok) ;
		b6 = 6 * maxblock ;
		Numeric.worksize = klu_add_size_t (s, MAX (n3, b6), ok) ;
		try
		{
			if (ok[0] == 0) throw new OutOfMemoryError() ;

			//Numeric.Work = klu_malloc (Numeric.worksize, 1, Common) ;
			Numeric.Work = new double [Numeric.worksize] ;
			Numeric.Xwork = Numeric.Work ;
			//Numeric.Iwork = (Int[]) ((double[]) Numeric.Xwork + n) ;
			Numeric.Iwork = new int [b6] ;
		}
		catch (OutOfMemoryError e)
		{
			/* out of memory or problem too large */
			Common.status = ok[0] == 1 ? KLU_OUT_OF_MEMORY : KLU_TOO_LARGE ;
			//klu_free_numeric (Numeric, Common) ;
			Numeric = null;
			return (null) ;
		}

		/* ---------------------------------------------------------------------- */
		/* factorize the blocks */
		/* ---------------------------------------------------------------------- */

		factor2 (Ap, Ai, Ax, Symbolic, Numeric, Common) ;

		/* ---------------------------------------------------------------------- */
		/* return or free the Numeric object */
		/* ---------------------------------------------------------------------- */

		if (Common.status < KLU_OK)
		{
			/* out of memory or inputs invalid */
			//klu_free_numeric (Numeric, Common) ;
			Numeric = null ;
		}
		else if (Common.status == KLU_SINGULAR)
		{
			if (Common.halt_if_singular == 1)
			{
				/* Matrix is singular, and the Numeric object is only partially
				 * defined because we halted early.  This is the default case for
				 * a singular matrix. */
				//klu_free_numeric (Numeric, Common) ;
				Numeric = null ;

			}
		}
		else if (Common.status == KLU_OK)
		{
			/* successful non-singular factorization */
			Common.numerical_rank = n ;
			Common.singular_col = n ;
		}
		return (Numeric) ;
	}

}




© 2015 - 2024 Weber Informatics LLC | Privacy Policy