/*! @file ilu_zpivotL.c

 * \brief Performs numerical pivoting

 *

 * 

 * -- SuperLU routine (version 4.0) --

 * Lawrence Berkeley National Laboratory

 * June 30, 2009

 * 

 */

#include <math.h></math.h>

#include <stdlib.h></stdlib.h>

#include "slu_zdefs.h"

#ifndef SGN

#define SGN(x) ((x)>=0?1:-1)

#endif

/*! \brief

 *

 * 

 * Purpose

 * =======

 *   Performs the numerical pivoting on the current column of L,

 *   and the CDIV operation.

 *

 *   Pivot policy:

 *   (1) Compute thresh = u * max_(i>=j) abs(A_ij);

 *   (2) IF user specifies pivot row k and abs(A_kj) >= thresh THEN

 *	     pivot row = k;

 *	 ELSE IF abs(A_jj) >= thresh THEN

 *	     pivot row = j;

 *	 ELSE

 *	     pivot row = m;

 *

 *   Note: If you absolutely want to use a given pivot order, then set u=0.0.

 *

 *   Return value: 0	  success;

 *		   i > 0  U(i,i) is exactly zero.

 * 

 */

int

ilu_zpivotL(

	const int  jcol,     /* in */

	const double u,      /* in - diagonal pivoting threshold */

	int	   *usepr,   /* re-use the pivot sequence given by

			      * perm_r/iperm_r */

	int	   *perm_r,  /* may be modified */

	int	   diagind,  /* diagonal of Pc*A*Pc' */

	int	   *swap,    /* in/out record the row permutation */

	int	   *iswap,   /* in/out inverse of swap, it is the same as

				perm_r after the factorization */

	int	   *marker,  /* in */

	int	   *pivrow,  /* in/out, as an input if *usepr!=0 */

	double	   fill_tol, /* in - fill tolerance of current column

			      * used for a singular column */

	milu_t	   milu,     /* in */

	doublecomplex	   drop_sum, /* in - computed in ilu_zcopy_to_ucol()

                                (MILU only) */

	GlobalLU_t *Glu,     /* modified - global LU data structures */

	SuperLUStat_t *stat  /* output */

       )

{

    int		 n;	 /* number of columns */

    int		 fsupc;  /* first column in the supernode */

    int		 nsupc;  /* no of columns in the supernode */

    int		 nsupr;  /* no of rows in the supernode */

    int		 lptr;	 /* points to the starting subscript of the supernode */

    register int	 pivptr;

    int		 old_pivptr, diag, ptr0;

    register double  pivmax, rtemp;

    double	 thresh;

    doublecomplex	 temp;

    doublecomplex	 *lu_sup_ptr;

    doublecomplex	 *lu_col_ptr;

    int		 *lsub_ptr;

    register int	 isub, icol, k, itemp;

    int		 *lsub, *xlsub;

    doublecomplex	 *lusup;

    int		 *xlusup;

    flops_t	 *ops = stat->ops;

    int		 info;

    doublecomplex one = {1.0, 0.0};

    /* Initialize pointers */

    n	       = Glu->n;

    lsub       = Glu->lsub;

    xlsub      = Glu->xlsub;

    lusup      = Glu->lusup;

    xlusup     = Glu->xlusup;

    fsupc      = (Glu->xsup)[(Glu->supno)[jcol]];

    nsupc      = jcol - fsupc;		/* excluding jcol; nsupc >= 0 */

    lptr       = xlsub[fsupc];

    nsupr      = xlsub[fsupc+1] - lptr;

    lu_sup_ptr = &lusup[xlusup[fsupc]]; /* start of the current supernode */

    lu_col_ptr = &lusup[xlusup[jcol]];	/* start of jcol in the supernode */

    lsub_ptr   = &lsub[lptr];	/* start of row indices of the supernode */

    /* Determine the largest abs numerical value for partial pivoting;

       Also search for user-specified pivot, and diagonal element. */

    pivmax = -1.0;

    pivptr = nsupc;

    diag = EMPTY;

    old_pivptr = nsupc;

    ptr0 = EMPTY;

    for (isub = nsupc; isub < nsupr; ++isub) {

        if (marker[lsub_ptr[isub]] > jcol)

            continue; /* do not overlap with a later relaxed supernode */

	switch (milu) {

	    case SMILU_1:

                z_add(&temp, &lu_col_ptr[isub], &drop_sum);

		rtemp = z_abs1(&temp);

		break;

	    case SMILU_2:

	    case SMILU_3:

                /* In this case, drop_sum contains the sum of the abs. value */

		rtemp = z_abs1(&lu_col_ptr[isub]);

		break;

	    case SILU:

	    default:

		rtemp = z_abs1(&lu_col_ptr[isub]);

		break;

	}

	if (rtemp > pivmax) { pivmax = rtemp; pivptr = isub; }

	if (*usepr && lsub_ptr[isub] == *pivrow) old_pivptr = isub;

	if (lsub_ptr[isub] == diagind) diag = isub;

	if (ptr0 == EMPTY) ptr0 = isub;

    }

    if (milu == SMILU_2 || milu == SMILU_3) pivmax += drop_sum.r;

    /* Test for singularity */

    if (pivmax < 0.0) {

	fprintf(stderr, "[0]: jcol=%d, SINGULAR!!!\n", jcol);

	fflush(stderr);

	exit(1);

    }

    if ( pivmax == 0.0 ) {

	if (diag != EMPTY)

	    *pivrow = lsub_ptr[pivptr = diag];

	else if (ptr0 != EMPTY)

	    *pivrow = lsub_ptr[pivptr = ptr0];

	else {

	    /* look for the first row which does not

	       belong to any later supernodes */

	    for (icol = jcol; icol < n; icol++)

		if (marker[swap[icol]] <= jcol) break;

	    if (icol >= n) {

		fprintf(stderr, "[1]: jcol=%d, SINGULAR!!!\n", jcol);

		fflush(stderr);

		exit(1);

	    }

	    *pivrow = swap[icol];

	    /* pick up the pivot row */

	    for (isub = nsupc; isub < nsupr; ++isub)

		if ( lsub_ptr[isub] == *pivrow ) { pivptr = isub; break; }

	}

	pivmax = fill_tol;

	lu_col_ptr[pivptr].r = pivmax;

	lu_col_ptr[pivptr].i = 0.0;

	*usepr = 0;

#ifdef DEBUG

	printf("[0] ZERO PIVOT: FILL (%d, %d).\n", *pivrow, jcol);

	fflush(stdout);

#endif

	info =jcol + 1;

    } /* if (*pivrow == 0.0) */

    else {

	thresh = u * pivmax;

	/* Choose appropriate pivotal element by our policy. */

	if ( *usepr ) {

	    switch (milu) {

		case SMILU_1:

                    z_add(&temp, &lu_col_ptr[old_pivptr], &drop_sum);

		    rtemp = z_abs1(&temp);

		    break;

		case SMILU_2:

		case SMILU_3:

		    rtemp = z_abs1(&lu_col_ptr[old_pivptr]) + drop_sum.r;

		    break;

		case SILU:

		default:

		    rtemp = z_abs1(&lu_col_ptr[old_pivptr]);

		    break;

	    }

	    if ( rtemp != 0.0 && rtemp >= thresh ) pivptr = old_pivptr;

	    else *usepr = 0;

	}

	if ( *usepr == 0 ) {

	    /* Use diagonal pivot? */

	    if ( diag >= 0 ) { /* diagonal exists */

		switch (milu) {

		    case SMILU_1:

                        z_add(&temp, &lu_col_ptr[diag], &drop_sum);

         	        rtemp = z_abs1(&temp);

			break;

		    case SMILU_2:

		    case SMILU_3:

			rtemp = z_abs1(&lu_col_ptr[diag]) + drop_sum.r;

			break;

		    case SILU:

		    default:

			rtemp = z_abs1(&lu_col_ptr[diag]);

			break;

		}

		if ( rtemp != 0.0 && rtemp >= thresh ) pivptr = diag;

	    }

	    *pivrow = lsub_ptr[pivptr];

	}

	info = 0;

	/* Reset the diagonal */

	switch (milu) {

	    case SMILU_1:

		z_add(&lu_col_ptr[pivptr], &lu_col_ptr[pivptr], &drop_sum);

		break;

	    case SMILU_2:

	    case SMILU_3:

                temp = z_sgn(&lu_col_ptr[pivptr]);

                zz_mult(&temp, &temp, &drop_sum);

                z_add(&lu_col_ptr[pivptr], &lu_col_ptr[pivptr], &drop_sum);

		break;

	    case SILU:

	    default:

		break;

	}

    } /* else */

    /* Record pivot row */

    perm_r[*pivrow] = jcol;

    if (jcol < n - 1) {

	register int t1, t2, t;

	t1 = iswap[*pivrow]; t2 = jcol;

	if (t1 != t2) {

	    t = swap[t1]; swap[t1] = swap[t2]; swap[t2] = t;

	    t1 = swap[t1]; t2 = t;

	    t = iswap[t1]; iswap[t1] = iswap[t2]; iswap[t2] = t;

	}

    } /* if (jcol < n - 1) */

    /* Interchange row subscripts */

    if ( pivptr != nsupc ) {

	itemp = lsub_ptr[pivptr];

	lsub_ptr[pivptr] = lsub_ptr[nsupc];

	lsub_ptr[nsupc] = itemp;

	/* Interchange numerical values as well, for the whole snode, such 

	 * that L is indexed the same way as A.

	 */

	for (icol = 0; icol <= nsupc; icol++) {

	    itemp = pivptr + icol * nsupr;

	    temp = lu_sup_ptr[itemp];

	    lu_sup_ptr[itemp] = lu_sup_ptr[nsupc + icol*nsupr];

	    lu_sup_ptr[nsupc + icol*nsupr] = temp;

	}

    } /* if */

    /* cdiv operation */

    ops[FACT] += 10 * (nsupr - nsupc);

    z_div(&temp, &one, &lu_col_ptr[nsupc]);

    for (k = nsupc+1; k < nsupr; k++) 

	zz_mult(&lu_col_ptr[k], &lu_col_ptr[k], &temp);

    return info;

}