/* ========================================================================== */
/* === UMF_scale_column ===================================================== */
/* ========================================================================== */

/* -------------------------------------------------------------------------- */
/* UMFPACK Version 3.2 (Jan. 1, 2002), Copyright (c) 2002 by Timothy A.       */
/* Davis, University of Florida, davis@cise.ufl.edu.  All Rights Reserved.    */
/* See README, umfpack.h, or type "umfpack_details" in Matlab for License.    */
/* -------------------------------------------------------------------------- */

/*
    Scale the current pivot column, and log the permutation.
    Store the LU factors.  Called by the kernel.

    Returns TRUE if successful, FALSE if out of memory.
*/

#include "umf_internal.h"
#include "umf_mem_alloc_head_block.h"
#include "umf_mem_free_tail_block.h"
#include "umf_get_memory.h"

/* ========================================================================== */

GLOBAL Int UMF_scale_column
(
    NumericType *Numeric,
    WorkType *Work
)
{
    /* ---------------------------------------------------------------------- */
    /* local variables */
    /* ---------------------------------------------------------------------- */

    Int i, k, k1, fnrows_max, fnrows, fncols, *Frpos, *Fcpos, pos, row, col,
	pivrow, pivcol, *Frows, *Fcols, *Lpattern, *Upattern, *Lpos, *Upos,
	llen, ulen, fncols_max, fnpiv, uilen, lnz, unz, *Row_tuples,
	*Col_tuples, *Rperm, *Cperm, *Lilen, *Uilen, *Lip, *Uip, *Li, *Ui,
	pivcol_position, newLchain, newUchain, pivrow_position, p, size, lip,
	uip, lnzi, lnzx, unzx, lnz2i, lnz2x, unz2i, unz2x ;
    double *D, z, pivot_value, *Fx, *Fcol, *Frow, *Lx, *Ux ;

#ifndef NDEBUG
    Int n ;
    Int *Col_degree, *Row_degree ;
    n = Work->n ;
    UMF_allocfail = FALSE ;
    if (UMF_gprob > 0)
    {
	double rrr = ((double) (rand ( ))) / (((double) RAND_MAX) + 1) ;
	DEBUG4 (("Check random %e %e\n", rrr, UMF_gprob)) ;
	UMF_allocfail = rrr < UMF_gprob ;
	if (UMF_allocfail)
	{
	    DEBUG1 (("Random garbage collection (scale_column)\n")) ;
	}
    }
#endif

    /* ---------------------------------------------------------------------- */
    /* get parameters */
    /* ---------------------------------------------------------------------- */

    fnrows = Work->fnrows ;
    fncols = Work->fncols ;

    /* ---------------------------------------------------------------------- */

    Rperm = Numeric->Rperm ;
    Cperm = Numeric->Cperm ;
    Lpos = Numeric->Lpos ;
    Upos = Numeric->Upos ;
    Lilen = Numeric->Lilen ;
    Uilen = Numeric->Uilen ;

    Lip = Numeric->Lip ;
    Uip = Numeric->Uip ;
    D = Numeric->D ;

    /* ---------------------------------------------------------------------- */

    k = Work->npiv++ ;

    Fx = Work->Fx ;
    fnrows_max = Work->fnrows_max ;
    fncols_max = Work->fncols_max ;
    fnpiv = Work->fnpiv ;
    Frpos = Work->Frpos ;
    Fcpos = Work->Fcpos ;
    Frows = Work->Frows ;
    Fcols = Work->Fcols ;
    pivrow = Work->pivrow ;
    pivcol = Work->pivcol ;

    ASSERT (pivrow >= 0 && pivrow < n) ;
    ASSERT (pivcol >= 0 && pivcol < n) ;

#ifndef NDEBUG
    Col_degree = Numeric->Cperm ;	/* for NON_PIVOTAL_COL macro */
    Row_degree = Numeric->Rperm ;	/* for NON_PIVOTAL_ROW macro */
    if (k % 1000 == 0) DEBUG0 (("step "ID"\n", k))  ;
#endif

    Row_tuples = Numeric->Uip ;
    Col_tuples = Numeric->Lip ;

    Lpattern = Work->Lpattern ;
    llen = Work->llen ;
    Upattern = Work->Upattern ;
    ulen = Work->ulen ;

    /* ---------------------------------------------------------------------- */

    /* Frpos [row] >= 0 for each row in pivot column pattern.   */
    /* offset into pattern is given by:			   	*/
    /* Frpos [row] == offset - 1				*/
    /* Frpos [pivrow] is the offset of the latest pivot row	*/

    /* Fcpos [col] >= 0 for each col in pivot row pattern.	*/
    /* Fcpos [col] == (offset - 1) * fnrows_max		 	*/
    /* Fcpos [pivcol] is the offset of the latest pivot column  */

    /* Fcols [0..fncols-1] is the pivot row pattern (excl pivot cols) */
    /* Frows [0..fnrows-1] is the pivot col pattern (excl pivot rows) */

#ifndef NDEBUG
    DEBUG7 (("Current frontal matrix: (prior to pivcol scale)\n")) ;
    UMF_dump_current_front (Numeric, Work, TRUE) ;
#endif

    /* ---------------------------------------------------------------------- */

#ifndef NDEBUG
    {
	Int row, col, i, lcnt, ucnt ;

	DEBUG2 (("Store column of L, k = "ID", llen "ID"\n", k, llen)) ;
	for (i = 0 ; i < llen ; i++)
	{
	    row = Lpattern [i] ;
	    ASSERT (row >= 0 && row < n) ;
	    DEBUG2 (("    Lpattern["ID"] "ID" Lpos "ID, i, row, Lpos [row])) ;
	    if (row == pivrow) DEBUG2 ((" <- pivot row")) ;
	    DEBUG2 (("\n")) ;
	    ASSERT (NON_PIVOTAL_ROW (row)) ;
	    ASSERT (i == Lpos [row]) ;
	}

	DEBUG2 (("Store row of U, k = "ID", ulen "ID"\n", k, ulen)) ;
	for (i = 0 ; i < ulen ; i++)
	{
	    col = Upattern [i] ;
	    DEBUG2 (("    Upattern["ID"] "ID, i, col)) ;
	    if (col == pivcol) DEBUG2 ((" <- pivot col")) ;
	    DEBUG2 (("\n")) ;
	    ASSERT (col >= 0 && col < n) ;
	    ASSERT (NON_PIVOTAL_COL (col)) ;
	    ASSERT (i == Upos [col]) ;
	}

	lcnt = 0 ;
	ucnt = 0 ;
	if (n < 1000)
	{
	    for (i = 0 ; i < n ; i++)
	    {
		if (NON_PIVOTAL_ROW (i) && Lpos [i] != EMPTY) lcnt++ ;
		if (NON_PIVOTAL_COL (i) && Upos [i] != EMPTY) ucnt++ ;
	    }
	    ASSERT (lcnt == llen) ;
	    ASSERT (ucnt == ulen) ;
	}
    }
#endif

    /* ---------------------------------------------------------------------- */
    /* remove pivot row from L */
    /* ---------------------------------------------------------------------- */

    /* remove pivot row index from current column of L */
    /* if a new Lchain starts, then all entries are removed later */
    DEBUG2 (("Removing pivrow from Lpattern, k = "ID"\n", k)) ;
    ASSERT (NON_PIVOTAL_ROW (pivrow)) ;
    pivrow_position = Lpos [pivrow] ;
    if (pivrow_position != EMPTY)
    {
	/* place the last entry in the column in the */
	/* position of the pivot row index */
	ASSERT (pivrow == Lpattern [pivrow_position]) ;
	row = Lpattern [--llen] ;
	ASSERT (NON_PIVOTAL_ROW (row)) ;
	Lpattern [pivrow_position] = row ;
	Lpos [row] = pivrow_position ;
	Lpos [pivrow] = EMPTY ;
    }

    /* ---------------------------------------------------------------------- */
    /* store the pivot value, for the diagonal matrix D */
    /* ---------------------------------------------------------------------- */

    /* fnpiv-th pivot in frontal matrix located in */
    /* Fx (fnrows_max-fnpiv, fncols_max-fnpiv) */

    Fcol = Fx + (fncols_max - fnpiv) * fnrows_max ;
    pivot_value = Fcol [fnrows_max - fnpiv] ;
    ASSERT (ABS (pivot_value) > 0.) ;

    D [k] = pivot_value ;
    pivot_value = 1.0 / pivot_value ;

    /* ---------------------------------------------------------------------- */
    /* scale pivot column and count nonzeros in kth column of L */
    /* ---------------------------------------------------------------------- */

    lnz = 0 ;
    lnz2i = 0 ;
    lnz2x = llen ;
    for (i = 0 ; i < fnrows ; i++)
    {
	z = (Fcol [i] *= pivot_value) ;

	/* if we start a new Lchain: */
	if (z != 0.0)
	{
	    /* one new integer and one new double */
	    lnz++ ;
	}

	/* if we continue the prior Lchain: */
	row = Frows [i] ;
	ASSERT (row != pivrow) ;
	ASSERT (NON_PIVOTAL_ROW (row)) ;
	pos = Lpos [row] ;
	if (pos == EMPTY && z != 0.0)
	{
	    /* row is not in the Lpattern, add it if z is nonzero */
	    lnz2i++ ;
	    lnz2x++ ;
	}
	DEBUG3 (("Scale L col, row "ID" pos "ID" scaled value %g"
	    "   ::: lnz "ID"  lnz2i "ID" lnz2x "ID"\n",
	    row, pos, z, lnz, lnz2i, lnz2x)) ;
    }

    /* determine if we start a new Lchain or continue the old one */
    if (llen == 0)
    {
	/* there is no prior Lchain */
	newLchain = TRUE ;
    }
    else
    {
	newLchain =
		/* storage for starting a new Lchain */
		UNITS (double, lnz) + UNITS (Int, lnz)
	    <=
		/* storage for continuing a prior Lchain */
		UNITS (double, lnz2x) + UNITS (Int, lnz2i) ;
    }

    if (newLchain)
    {
	/* start a new chain for column k of L */
	DEBUG2 (("Start new Lchain, k = "ID"\n", k)) ;

	pivrow_position = EMPTY ;

	/* clear the prior Lpattern */
	for (i = 0 ; i < llen ; i++)
	{
	    row = Lpattern [i] ;
	    ASSERT (NON_PIVOTAL_ROW (row)) ;
	    Lpos [row] = EMPTY ;
	}
	llen = 0 ;

	lnzi = lnz ;
	lnzx = lnz ;
    }
    else
    {
	/* continue the prior Lchain */
	DEBUG2 (("Continue  Lchain, k = "ID"\n", k)) ;
	lnzi = lnz2i ;
	lnzx = lnz2x ;
    }

    /* ---------------------------------------------------------------------- */
    /* count the nonzeros in the row of U */
    /* ---------------------------------------------------------------------- */

    /* store the numerical entries and find new nonzeros */
    Frow = Fx + (fnrows_max - fnpiv) ;

    unz = 0 ;
    unz2i = 0 ;
    unz2x = ulen ;
    DEBUG2 (("unz2x is "ID"\n", unz2x)) ;

    /* if row k does not end a Uchain, pivcol will not be included in ulen */

    ASSERT (NON_PIVOTAL_COL (pivcol)) ;
    pivcol_position = Upos [pivcol] ;
    if (pivcol_position != EMPTY)
    {
	unz2x-- ;
	DEBUG2 (("(exclude pivcol) unz2x is now "ID"\n", unz2x)) ;
    }

    ASSERT (unz2x >= 0) ;

    for (i = 0 ; i < fncols ; i++)
    {
	z = Frow [i * fnrows_max] ;

	/* if we start a new Uchain */
	if (z != 0.0)
	{
	    unz++ ;
	    DEBUG2 (("If new: "ID" : %g\n", unz, z)) ;
	}

	/* if we continue the prior Uchain */
	col = Fcols [i] ;
	ASSERT (col != pivcol) ;
	ASSERT (NON_PIVOTAL_COL (col)) ;
	pos = Upos [col] ;
	if (pos == EMPTY && z != 0.0)
	{
	    /* add this new nonzero entry to the U pattern, if nonzero */
	    unz2i++ ;
	    unz2x++ ;
	    DEBUG2 (("If old:                      "ID" : %g\n", unz2x, z)) ;
	}
    }

    ASSERT (IMPLIES (k == 0, ulen == 0)) ;

    /* determine if we start a new Uchain or continue the old one */
    if (ulen == 0)
    {
	/* there is no prior Uchain */
	newUchain = TRUE ;
    }
    else
    {
	newUchain =
		/* approximate storage for starting a new Uchain */
		UNITS (double, unz) + UNITS (Int, unz)
	    <=
		/* approximate storage for continuing a prior Uchain */
		UNITS (double, unz2x) + UNITS (Int, unz2i) ;

	/* this would be exact, except for the Int to Unit rounding, */
	/* because the Upattern is stored only at the end of the Uchain */
    }

    /* ---------------------------------------------------------------------- */
    /* allocate space for the column of L and the row of U */
    /* ---------------------------------------------------------------------- */

    size = UNITS (Int, lnzi) + UNITS (double, lnzx) ;
    if (newUchain)
    {
	/* store the pattern of the last row in the prior Uchain */
	size += UNITS (Int, ulen) ;
	unzx = unz ;
    }
    else
    {
	unzx = unz2x ;
    }
    size += UNITS (double, unzx) ;

    p = UMF_mem_alloc_head_block (Numeric, size) ;
    if (!p)
    {
	/* do garbage collection, realloc, and try again */
	if (!UMF_get_memory (Numeric, Work, size))
	{
	    return (FALSE) ;	/* out of memory */
	}
	p = UMF_mem_alloc_head_block (Numeric, size) ;
    }
    if (!p)
    {
	return (FALSE) ;	/* out of memory */
    }

    /* ---------------------------------------------------------------------- */
    /* store the column of L */
    /* ---------------------------------------------------------------------- */

    lip = p ;

    Li = (Int *) (Numeric->Memory + p) ;
    p += UNITS (Int, lnzi) ;
    Lx = (double *) (Numeric->Memory + p) ;
    p += UNITS (double, lnzx) ;

    for (i = 0 ; i < lnzx ; i++)
    {
	Lx [i] = 0. ;
    }

    /* store the numerical entries */

    if (newLchain)
    {
	/* flag the first column in the Lchain by negating Lip [k] */
	lip = -lip ;

	ASSERT (llen == 0) ;
	for (i = 0 ; i < fnrows ; i++)
	{
	    z = Fcol [i] ;
	    if (z != 0.0)
	    {
		row = Frows [i] ;
		ASSERT (NON_PIVOTAL_ROW (row)) ;
		pos = llen++ ;
		Lpattern [pos] = row ;
		Lpos [row] = pos ;
		Li [pos] = row ;
		Lx [pos] = z ;
		DEBUG2 (("(newLchain) New entry in Lpattern: row "ID" pos "ID
		    "\n", row, pos)) ;
		DEBUG2 (("(newLchain) Store Lx row "ID" pos "ID" value %g\n",
		    row, pos, z)) ;
	    }
	}
    }
    else
    {
	ASSERT (llen > 0) ;
	for (i = 0 ; i < fnrows ; i++)
	{
	    z = Fcol [i] ;
	    if (z != 0.0)
	    {
		row = Frows [i] ;
		ASSERT (NON_PIVOTAL_ROW (row)) ;
		pos = Lpos [row] ;
		if (pos == EMPTY)
		{
		    /* add this new nonzero entry to the L pattern */
		    pos = llen++ ;
		    DEBUG2 (("New entry in Lpattern: row "ID" pos "ID"\n",
			row, pos)) ;
		    ASSERT (llen <= lnzx) ;
		    Lpattern [pos] = row ;
		    Lpos [row] = pos ;
		    *Li++ = row ;
		}
		DEBUG2 (("Store Lx row "ID" pos "ID" value %g\n", row, pos, z));
		ASSERT (row == Lpattern [pos]) ;
		ASSERT (pos < lnzx) ;
		Lx [pos] = z ;
	    }
	}
    }
    ASSERT (llen == lnzx) ;
    ASSERT (lnz <= llen) ;

    Numeric->lnz += lnz ;
    Numeric->nLentries += lnzx ;
    Work->llen = llen ;
    Numeric->isize += lnzi ;

    /* ---------------------------------------------------------------------- */
    /* store the row of U */
    /* ---------------------------------------------------------------------- */

    uip = p ;

    if (newUchain)
    {
	/* starting a new Uchain - flag this by negating Uip [k] */
	uip = -uip ;
	DEBUG2 (("Start new Uchain, k = "ID"\n", k)) ;

	pivcol_position = EMPTY ;

	/* end the prior Uchain */
	/* save the current Upattern, and then */
	/* clear it and start a new Upattern */
	DEBUG2 (("Ending prior chain, k-1 = "ID"\n", k-1)) ;
	uilen = ulen ;
	Ui = (Int *) (Numeric->Memory + p) ;
	Numeric->isize += ulen ;
	p += UNITS (Int, ulen) ;
	for (i = 0 ; i < ulen ; i++)
	{
	    col = Upattern [i] ;
	    ASSERT (col >= 0 && col < n) ;
	    ASSERT (NON_PIVOTAL_COL (col)) ;
	    Upos [col] = EMPTY ;
	    Ui [i] = col ;
	}

	ulen = 0 ;

    }
    else
    {
	/* continue the prior Uchain */
	DEBUG2 (("Continue  Uchain, k = "ID"\n", k)) ;
	ASSERT (k > 0) ;

	/* remove pivot col index from current row of U */
	/* if a new Uchain starts, then all entries are removed later */
	DEBUG2 (("Removing pivcol from Upattern, k = "ID"\n", k)) ;

	if (pivcol_position != EMPTY)
	{
	    /* place the last entry in the row in the */
	    /* position of the pivot col index */
	    ASSERT (pivcol == Upattern [pivcol_position]) ;
	    col = Upattern [--ulen] ;
	    ASSERT (col >= 0 && col < n) ;
	    ASSERT (NON_PIVOTAL_COL (col)) ;
	    Upattern [pivcol_position] = col ;
	    Upos [col] = pivcol_position ;
	    Upos [pivcol] = EMPTY ;
	}

	/* this row continues the Uchain.  Keep track of how much */
	/* to trim from the k-th length to get the length of the */
	/* (k-1)st row of U */
	uilen = unz2i ;

    }

    Ux = (double *) (Numeric->Memory + p) ;
    /* p += UNITS (double, unzx), no need to increment p */

    for (i = 0 ; i < unzx ; i++)
    {
	Ux [i] = 0. ;
    }

    if (newUchain)
    {
	ASSERT (ulen == 0) ;
	for (i = 0 ; i < fncols ; i++)
	{
	    z = Frow [i * fnrows_max] ;
	    if (z != 0.0)
	    {
		/* add this new nonzero entry to the U pattern */
		col = Fcols [i] ;
		ASSERT (col >= 0 && col < n) ;
		ASSERT (NON_PIVOTAL_COL (col)) ;
		pos = ulen++ ;
		Upattern [pos] = col ;
		Upos [col] = pos ;
		Ux [pos] = z ;
		DEBUG2 (("(newUchain) New entry in Upattern: col "ID" pos "ID
		    "\n", col, pos)) ;
		DEBUG2 (("(newUchain) Store Ux col "ID" pos "ID" value %g\n",
		    col, pos, z)) ;
	    }
	}
    }
    else
    {

	ASSERT (ulen > 0) ;

	/* store the numerical entries and find new nonzeros */

	for (i = 0 ; i < fncols ; i++)
	{
	    z = Frow [i * fnrows_max] ;
	    if (z != 0.0)
	    {
		col = Fcols [i] ;
		ASSERT (col >= 0 && col < n) ;
		ASSERT (NON_PIVOTAL_COL (col)) ;
		pos = Upos [col] ;
		if (pos == EMPTY)
		{
		    /* add this new nonzero entry to the U pattern */
		    ASSERT (ulen < unzx) ;
		    pos = ulen++ ;
		    Upattern [pos] = col ;
		    Upos [col] = pos ;
		    DEBUG2 (("New entry in Upattern: col "ID" pos "ID"\n",
			col, pos)) ;
		}
		DEBUG2 (("Store Ux col "ID" pos "ID" value %g\n", col, pos, z));
		ASSERT (col == Upattern [pos]) ;
		ASSERT (pos < unzx) ;
		Ux [pos] = z ;
	    }
	}
    }

    ASSERT (ulen == unzx) ;
    ASSERT (unz <= ulen) ;
    Numeric->unz += unz ;
    Numeric->nUentries += unzx ;
    Work->ulen = ulen ;

    /* ---------------------------------------------------------------------- */
    /* count the "true" flops, based on LU pattern only */
    /* ---------------------------------------------------------------------- */

    Numeric->flops += 2 * lnz * unz + lnz ;

    /* ====================================================================== */
    /* A pivot step is complete */
    /* ====================================================================== */

#ifndef NDEBUG
    if (Work->n <= UMF_DBMAX)
    {
	double b, zx, *F2 ;
	/* divide rhs by pivot: */
	UMF_DBrhs [pivcol] *= pivot_value ;
	/* check right-hand-side (diagonal of L^T is one) */
	b = XTRUE (pivrow, Work->n) ;
	for (i = 0 ; i < fnrows ; i++)
	{
	    b += Fcol [i] * XTRUE (Frows [i], Work->n) ;
	}
	DEBUG6 ((" b=     %g (pivcol)\n", b)) ;
	DEBUG6 ((" UMF_DBrhs= %g (pivcol)\n", UMF_DBrhs [pivcol])) ;
	zx = b - UMF_DBrhs [pivcol] ;
	zx = ABS (zx) ;
	if (ABS (b) >= 1.) zx /= ABS (b) ;
	DEBUG2 ((" differ: %g (pivcol)\n", zx)) ;
	/* update the remaining right-hand-side */
	b = UMF_DBrhs [pivcol] ;
	F2 = Fx + (fnrows_max - fnpiv) ;
	for (i = 0 ; i < fncols ; i++)
	{
	    UMF_DBrhs [Fcols [i]] -= (*F2) * b ;
	    F2 += fnrows_max ;
	}
    }
    DEBUG7 (("Current frontal matrix: (after pivcol scale)\n")) ;
    UMF_dump_current_front (Numeric, Work, TRUE) ;
#endif

    /* ---------------------------------------------------------------------- */
    /* remove pivot row and column from frontal pattern */
    /* ---------------------------------------------------------------------- */

    Frpos [pivrow] = EMPTY ;
    Fcpos [pivcol] = EMPTY ;

    /* ---------------------------------------------------------------------- */
    /* deallocate the pivot row and pivot column tuples */
    /* ---------------------------------------------------------------------- */

    UMF_mem_free_tail_block (Numeric, Row_tuples [pivrow]) ;
    UMF_mem_free_tail_block (Numeric, Col_tuples [pivcol]) ;

    /* ---------------------------------------------------------------------- */
    /* the pivot column is fully assembled and scaled, and is now the */
    /* k-th column of L. The pivot row is the k-th row of U. */
    /* ---------------------------------------------------------------------- */

    DEBUG5 (("number of pivots so far: "ID"\n", k)) ;
    ASSERT (NON_PIVOTAL_ROW (pivrow)) ;
    ASSERT (NON_PIVOTAL_COL (pivcol)) ;

    /* save row and column inverse permutation */
    k1 = ONES_COMPLEMENT (k) ;
    Rperm [pivrow] = k1 ;			/* aliased with Row_degree */
    Cperm [pivcol] = k1 ;			/* aliased with Col_degree */

    ASSERT (!NON_PIVOTAL_ROW (pivrow)) ;
    ASSERT (!NON_PIVOTAL_COL (pivcol)) ;

    Lpos [pivrow] = pivrow_position ;
    Upos [pivcol] = pivcol_position ;

    Lip [pivcol] = lip ;			/* aliased with Col_tuples */
    Lilen [pivcol] = lnzi ;			/* aliased with Col_tlen */

    Uip [pivrow] = uip ;			/* aliased with Row_tuples */
    Uilen [pivrow] = uilen ;			/* aliased with Row_tlen */

    return (TRUE) ;

}

