Exemplo n.º 1
0
int
ilu_dsnode_dfs(
           const int  jcol,         /* in - start of the supernode */
           const int  kcol,         /* in - end of the supernode */
           const int  *asub,        /* in */
           const int  *xa_begin,    /* in */
           const int  *xa_end,      /* in */
           int        *marker,      /* modified */
           GlobalLU_t *Glu          /* modified */
           )
{

    register int i, k, nextl;
    int          nsuper, krow, kmark, mem_error;
    int          *xsup, *supno;
    int          *lsub, *xlsub;
    int          nzlmax;

    xsup    = Glu->xsup;
    supno   = Glu->supno;
    lsub    = Glu->lsub;
    xlsub   = Glu->xlsub;
    nzlmax  = Glu->nzlmax;

    nsuper = ++supno[jcol];     /* Next available supernode number */
    nextl = xlsub[jcol];

    for (i = jcol; i <= kcol; i++)
    {
        /* For each nonzero in A[*,i] */
        for (k = xa_begin[i]; k < xa_end[i]; k++)
        {
            krow = asub[k];
            kmark = marker[krow];
            if ( kmark != kcol )
            { /* First time visit krow */
                marker[krow] = kcol;
                lsub[nextl++] = krow;
                if ( nextl >= nzlmax )
                {
                    if ( (mem_error = dLUMemXpand(jcol, nextl, LSUB, &nzlmax,
                            Glu)) != 0)
                        return (mem_error);
                    lsub = Glu->lsub;
                }
            }
        }
        supno[i] = nsuper;
    }

    /* Supernode > 1 */
    if ( jcol < kcol )
        for (i = jcol+1; i <= kcol; i++) xlsub[i] = nextl;

    xsup[nsuper+1] = kcol + 1;
    supno[kcol+1]  = nsuper;
    xlsub[kcol+1]  = nextl;

    return 0;
}
Exemplo n.º 2
0
int
dcolumn_dfs(
	   const int  m,         /* in - number of rows in the matrix */
	   const int  jcol,      /* in */
	   int        *perm_r,   /* in */
	   int        *nseg,     /* modified - with new segments appended */
	   int        *lsub_col, /* in - defines the RHS vector to start the dfs */
	   int        *segrep,   /* modified - with new segments appended */
	   int        *repfnz,   /* modified */
	   int        *xprune,   /* modified */
	   int        *marker,   /* modified */
	   int        *parent,	 /* working array */
	   int        *xplore,   /* working array */
	   GlobalLU_t *Glu       /* modified */
	   )
{
/* 
 * Purpose
 * =======
 *   "column_dfs" performs a symbolic factorization on column jcol, and
 *   decide the supernode boundary.
 *
 *   This routine does not use numeric values, but only use the RHS 
 *   row indices to start the dfs.
 *
 *   A supernode representative is the last column of a supernode.
 *   The nonzeros in U[*,j] are segments that end at supernodal
 *   representatives. The routine returns a list of such supernodal 
 *   representatives in topological order of the dfs that generates them.
 *   The location of the first nonzero in each such supernodal segment
 *   (supernodal entry location) is also returned.
 *
 * Local parameters
 * ================
 *   nseg: no of segments in current U[*,j]
 *   jsuper: jsuper=NO if column j does not belong to the same
 *	supernode as j-1. Otherwise, jsuper=nsuper.
 *
 *   marker2: A-row --> A-row/col (0/1)
 *   repfnz: SuperA-col --> PA-row
 *   parent: SuperA-col --> SuperA-col
 *   xplore: SuperA-col --> index to L-structure
 *
 * Return value
 * ============
 *     0  success;
 *   > 0  number of bytes allocated when run out of space.
 *
 */
    int     jcolp1, jcolm1, jsuper, nsuper, nextl;
    int     k, krep, krow, kmark, kperm;
    int     *marker2;           /* Used for small panel LU */
    int	    fsupc;		/* First column of a snode */
    int     myfnz;		/* First nonz column of a U-segment */
    int	    chperm, chmark, chrep, kchild;
    int     xdfs, maxdfs, kpar, oldrep;
    int     jptr, jm1ptr;
    int     ito, ifrom, istop;	/* Used to compress row subscripts */
    int     mem_error;
    int     *xsup, *supno, *lsub, *xlsub;
    int     nzlmax;
    static  int  first = 1, maxsuper;
    
    xsup    = Glu->xsup;
    supno   = Glu->supno;
    lsub    = Glu->lsub;
    xlsub   = Glu->xlsub;
    nzlmax  = Glu->nzlmax;

    if ( first ) {
	maxsuper = sp_ienv(3);
	first = 0;
    }
    jcolp1  = jcol + 1;
    jcolm1  = jcol - 1;
    nsuper  = supno[jcol];
    jsuper  = nsuper;
    nextl   = xlsub[jcol];
    marker2 = &marker[2*m];


    /* For each nonzero in A[*,jcol] do dfs */
    for (k = 0; lsub_col[k] != EMPTY; k++) {

	krow = lsub_col[k];
    	lsub_col[k] = EMPTY;
	kmark = marker2[krow];    	

	/* krow was visited before, go to the next nonz */
        if ( kmark == jcol ) continue; 

	/* For each unmarked nbr krow of jcol
	 *	krow is in L: place it in structure of L[*,jcol]
	 */
	marker2[krow] = jcol;
	kperm = perm_r[krow];

   	if ( kperm == EMPTY ) {
	    lsub[nextl++] = krow; 	/* krow is indexed into A */
	    if ( nextl >= nzlmax ) {
		if ( mem_error = dLUMemXpand(jcol, nextl, LSUB, &nzlmax, Glu) )
		    return (mem_error);
		lsub = Glu->lsub;
	    }
            if ( kmark != jcolm1 ) jsuper = NO;	/* Row index subset testing */
  	} else {
	    /*	krow is in U: if its supernode-rep krep
	     *	has been explored, update repfnz[*]
	     */
	    krep = xsup[supno[kperm]+1] - 1;
	    myfnz = repfnz[krep];

	    if ( myfnz != EMPTY ) {	/* Visited before */
	    	if ( myfnz > kperm ) repfnz[krep] = kperm;
		/* continue; */
	    }
	    else {
		/* Otherwise, perform dfs starting at krep */
		oldrep = EMPTY;
	 	parent[krep] = oldrep;
	  	repfnz[krep] = kperm;
		xdfs = xlsub[krep];
	  	maxdfs = xprune[krep];

		do {
		    /* 
		     * For each unmarked kchild of krep 
		     */
		    while ( xdfs < maxdfs ) {

		   	kchild = lsub[xdfs];
			xdfs++;
		  	chmark = marker2[kchild];

		   	if ( chmark != jcol ) { /* Not reached yet */
		   	    marker2[kchild] = jcol;
		   	    chperm = perm_r[kchild];

		   	    /* Case kchild is in L: place it in L[*,k] */
		   	    if ( chperm == EMPTY ) {
			    	lsub[nextl++] = kchild;
				if ( nextl >= nzlmax ) {
				    if ( mem_error =
					 dLUMemXpand(jcol,nextl,LSUB,&nzlmax,Glu) )
					return (mem_error);
				    lsub = Glu->lsub;
				}
				if ( chmark != jcolm1 ) jsuper = NO;
			    } else {
		    	    	/* Case kchild is in U: 
				 *   chrep = its supernode-rep. If its rep has 
			         *   been explored, update its repfnz[*]
			         */
		   	    	chrep = xsup[supno[chperm]+1] - 1;
		   		myfnz = repfnz[chrep];
		   		if ( myfnz != EMPTY ) { /* Visited before */
				    if ( myfnz > chperm )
     				  	repfnz[chrep] = chperm;
				} else {
		        	    /* Continue dfs at super-rep of kchild */
		   		    xplore[krep] = xdfs;	
		   		    oldrep = krep;
		   		    krep = chrep; /* Go deeper down G(L^t) */
				    parent[krep] = oldrep;
		    		    repfnz[krep] = chperm;
		   		    xdfs = xlsub[krep];     
				    maxdfs = xprune[krep];
				} /* else */

			   } /* else */

			} /* if */

		    } /* while */

		    /* krow has no more unexplored nbrs;
	   	     *    place supernode-rep krep in postorder DFS.
	   	     *    backtrack dfs to its parent
		     */
		    segrep[*nseg] = krep;
		    ++(*nseg);
		    kpar = parent[krep]; /* Pop from stack, mimic recursion */
		    if ( kpar == EMPTY ) break; /* dfs done */
		    krep = kpar;
		    xdfs = xplore[krep];
		    maxdfs = xprune[krep];

		} while ( kpar != EMPTY ); 	/* Until empty stack */

	    } /* else */

	} /* else */

    } /* for each nonzero ... */

    /* Check to see if j belongs in the same supernode as j-1 */
    if ( jcol == 0 ) { /* Do nothing for column 0 */
	nsuper = supno[0] = 0;
    } else {
   	fsupc = xsup[nsuper];
	jptr = xlsub[jcol];	/* Not compressed yet */
	jm1ptr = xlsub[jcolm1];

#ifdef T2_SUPER
	if ( (nextl-jptr != jptr-jm1ptr-1) ) jsuper = NO;
#endif
	/* Make sure the number of columns in a supernode doesn't
	   exceed threshold. */
	if ( jcol - fsupc >= maxsuper ) jsuper = NO;

	/* If jcol starts a new supernode, reclaim storage space in
	 * lsub from the previous supernode. Note we only store
	 * the subscript set of the first and last columns of
   	 * a supernode. (first for num values, last for pruning)
	 */
	if ( jsuper == NO ) {	/* starts a new supernode */
	    if ( (fsupc < jcolm1-1) ) {	/* >= 3 columns in nsuper */
#ifdef CHK_COMPRESS
		printf("  Compress lsub[] at super %d-%d\n", fsupc, jcolm1);
#endif
	        ito = xlsub[fsupc+1];
		xlsub[jcolm1] = ito;
		istop = ito + jptr - jm1ptr;
		xprune[jcolm1] = istop; /* Initialize xprune[jcol-1] */
		xlsub[jcol] = istop;
		for (ifrom = jm1ptr; ifrom < nextl; ++ifrom, ++ito)
		    lsub[ito] = lsub[ifrom];
		nextl = ito;            /* = istop + length(jcol) */
	    }
	    nsuper++;
	    supno[jcol] = nsuper;
	} /* if a new supernode */

    }	/* else: jcol > 0 */ 
    
    /* Tidy up the pointers before exit */
    xsup[nsuper+1] = jcolp1;
    supno[jcolp1]  = nsuper;
    xprune[jcol]   = nextl;	/* Initialize upper bound for pruning */
    xlsub[jcolp1]  = nextl;

    return 0;
}
Exemplo n.º 3
0
/*! \brief 
 *
 * <pre>
 * Purpose:
 * ========
 * Performs numeric block updates (sup-col) in topological order.
 * It features: col-col, 2cols-col, 3cols-col, and sup-col updates.
 * Special processing on the supernodal portion of L\U[*,j]
 * Return value:   0 - successful return
 *               > 0 - number of bytes allocated when run out of space
 * </pre>
 */
int
dcolumn_bmod (
	     const int  jcol,	  /* in */
	     const int  nseg,	  /* in */
	     double     *dense,	  /* in */
	     double     *tempv,	  /* working array */
	     int        *segrep,  /* in */
	     int        *repfnz,  /* in */
	     int        fpanelc,  /* in -- first column in the current panel */
	     GlobalLU_t *Glu,     /* modified */
	     SuperLUStat_t *stat  /* output */
	     )
{

#ifdef _CRAY
    _fcd ftcs1 = _cptofcd("L", strlen("L")),
         ftcs2 = _cptofcd("N", strlen("N")),
         ftcs3 = _cptofcd("U", strlen("U"));
#endif
    int         incx = 1, incy = 1;
    double      alpha, beta;
    
    /* krep = representative of current k-th supernode
     * fsupc = first supernodal column
     * nsupc = no of columns in supernode
     * nsupr = no of rows in supernode (used as leading dimension)
     * luptr = location of supernodal LU-block in storage
     * kfnz = first nonz in the k-th supernodal segment
     * no_zeros = no of leading zeros in a supernodal U-segment
     */
    double       ukj, ukj1, ukj2;
    int          luptr, luptr1, luptr2;
    int          fsupc, nsupc, nsupr, segsze;
    int          nrow;	  /* No of rows in the matrix of matrix-vector */
    int          jcolp1, jsupno, k, ksub, krep, krep_ind, ksupno;
    register int lptr, kfnz, isub, irow, i;
    register int no_zeros, new_next; 
    int          ufirst, nextlu;
    int          fst_col; /* First column within small LU update */
    int          d_fsupc; /* Distance between the first column of the current
			     panel and the first column of the current snode. */
    int          *xsup, *supno;
    int          *lsub, *xlsub;
    double       *lusup;
    int          *xlusup;
    int          nzlumax;
    double       *tempv1;
    double      zero = 0.0;
    double      one = 1.0;
    double      none = -1.0;
    int          mem_error;
    flops_t      *ops = stat->ops;

    xsup    = Glu->xsup;
    supno   = Glu->supno;
    lsub    = Glu->lsub;
    xlsub   = Glu->xlsub;
    lusup   = (double *) Glu->lusup;
    xlusup  = Glu->xlusup;
    nzlumax = Glu->nzlumax;
    jcolp1 = jcol + 1;
    jsupno = supno[jcol];
    
    /* 
     * For each nonz supernode segment of U[*,j] in topological order 
     */
    k = nseg - 1;
    for (ksub = 0; ksub < nseg; ksub++) {

	krep = segrep[k];
	k--;
	ksupno = supno[krep];
	if ( jsupno != ksupno ) { /* Outside the rectangular supernode */

	    fsupc = xsup[ksupno];
	    fst_col = SUPERLU_MAX ( fsupc, fpanelc );

  	    /* Distance from the current supernode to the current panel; 
	       d_fsupc=0 if fsupc > fpanelc. */
  	    d_fsupc = fst_col - fsupc; 

	    luptr = xlusup[fst_col] + d_fsupc;
	    lptr = xlsub[fsupc] + d_fsupc;

	    kfnz = repfnz[krep];
	    kfnz = SUPERLU_MAX ( kfnz, fpanelc );

	    segsze = krep - kfnz + 1;
	    nsupc = krep - fst_col + 1;
	    nsupr = xlsub[fsupc+1] - xlsub[fsupc];	/* Leading dimension */
	    nrow = nsupr - d_fsupc - nsupc;
	    krep_ind = lptr + nsupc - 1;

	    ops[TRSV] += segsze * (segsze - 1);
	    ops[GEMV] += 2 * nrow * segsze;


	    /* 
	     * Case 1: Update U-segment of size 1 -- col-col update 
	     */
	    if ( segsze == 1 ) {
	  	ukj = dense[lsub[krep_ind]];
		luptr += nsupr*(nsupc-1) + nsupc;

		for (i = lptr + nsupc; i < xlsub[fsupc+1]; ++i) {
		    irow = lsub[i];
		    dense[irow] -=  ukj*lusup[luptr];
		    luptr++;
		}

	    } else if ( segsze <= 3 ) {
		ukj = dense[lsub[krep_ind]];
		luptr += nsupr*(nsupc-1) + nsupc-1;
		ukj1 = dense[lsub[krep_ind - 1]];
		luptr1 = luptr - nsupr;

		if ( segsze == 2 ) { /* Case 2: 2cols-col update */
		    ukj -= ukj1 * lusup[luptr1];
		    dense[lsub[krep_ind]] = ukj;
		    for (i = lptr + nsupc; i < xlsub[fsupc+1]; ++i) {
		    	irow = lsub[i];
		    	luptr++;
		    	luptr1++;
		    	dense[irow] -= ( ukj*lusup[luptr]
					+ ukj1*lusup[luptr1] );
		    }
		} else { /* Case 3: 3cols-col update */
		    ukj2 = dense[lsub[krep_ind - 2]];
		    luptr2 = luptr1 - nsupr;
		    ukj1 -= ukj2 * lusup[luptr2-1];
		    ukj = ukj - ukj1*lusup[luptr1] - ukj2*lusup[luptr2];
		    dense[lsub[krep_ind]] = ukj;
		    dense[lsub[krep_ind-1]] = ukj1;
		    for (i = lptr + nsupc; i < xlsub[fsupc+1]; ++i) {
		    	irow = lsub[i];
		    	luptr++;
		    	luptr1++;
			luptr2++;
		    	dense[irow] -= ( ukj*lusup[luptr]
			     + ukj1*lusup[luptr1] + ukj2*lusup[luptr2] );
		    }
		}



	    } else {
	  	/*
		 * Case: sup-col update
		 * Perform a triangular solve and block update,
		 * then scatter the result of sup-col update to dense
		 */

		no_zeros = kfnz - fst_col;

	        /* Copy U[*,j] segment from dense[*] to tempv[*] */
	        isub = lptr + no_zeros;
	        for (i = 0; i < segsze; i++) {
	  	    irow = lsub[isub];
		    tempv[i] = dense[irow];
		    ++isub; 
	        }

	        /* Dense triangular solve -- start effective triangle */
		luptr += nsupr * no_zeros + no_zeros; 
		
#ifdef USE_VENDOR_BLAS
#ifdef _CRAY
		STRSV( ftcs1, ftcs2, ftcs3, &segsze, &lusup[luptr], 
		       &nsupr, tempv, &incx );
#else		
		dtrsv_( "L", "N", "U", &segsze, &lusup[luptr], 
		       &nsupr, tempv, &incx );
#endif		
 		luptr += segsze;  /* Dense matrix-vector */
		tempv1 = &tempv[segsze];
                alpha = one;
                beta = zero;
#ifdef _CRAY
		SGEMV( ftcs2, &nrow, &segsze, &alpha, &lusup[luptr], 
		       &nsupr, tempv, &incx, &beta, tempv1, &incy );
#else
		dgemv_( "N", &nrow, &segsze, &alpha, &lusup[luptr], 
		       &nsupr, tempv, &incx, &beta, tempv1, &incy );
#endif
#else
		dlsolve ( nsupr, segsze, &lusup[luptr], tempv );

 		luptr += segsze;  /* Dense matrix-vector */
		tempv1 = &tempv[segsze];
		dmatvec (nsupr, nrow , segsze, &lusup[luptr], tempv, tempv1);
#endif
		
		
                /* Scatter tempv[] into SPA dense[] as a temporary storage */
                isub = lptr + no_zeros;
                for (i = 0; i < segsze; i++) {
                    irow = lsub[isub];
                    dense[irow] = tempv[i];
                    tempv[i] = zero;
                    ++isub;
                }

		/* Scatter tempv1[] into SPA dense[] */
		for (i = 0; i < nrow; i++) {
		    irow = lsub[isub];
		    dense[irow] -= tempv1[i];
		    tempv1[i] = zero;
		    ++isub;
		}
	    }
	    
	} /* if jsupno ... */

    } /* for each segment... */

    /*
     *	Process the supernodal portion of L\U[*,j]
     */
    nextlu = xlusup[jcol];
    fsupc = xsup[jsupno];

    /* Copy the SPA dense into L\U[*,j] */
    new_next = nextlu + xlsub[fsupc+1] - xlsub[fsupc];
    while ( new_next > nzlumax ) {
	if (mem_error = dLUMemXpand(jcol, nextlu, LUSUP, &nzlumax, Glu))
	    return (mem_error);
	lusup = (double *) Glu->lusup;
	lsub = Glu->lsub;
    }

    for (isub = xlsub[fsupc]; isub < xlsub[fsupc+1]; isub++) {
  	irow = lsub[isub];
	lusup[nextlu] = dense[irow];
        dense[irow] = zero;
	++nextlu;
    }

    xlusup[jcolp1] = nextlu;	/* Close L\U[*,jcol] */

    /* For more updates within the panel (also within the current supernode), 
     * should start from the first column of the panel, or the first column 
     * of the supernode, whichever is bigger. There are 2 cases:
     *    1) fsupc < fpanelc, then fst_col := fpanelc
     *    2) fsupc >= fpanelc, then fst_col := fsupc
     */
    fst_col = SUPERLU_MAX ( fsupc, fpanelc );

    if ( fst_col < jcol ) {

  	/* Distance between the current supernode and the current panel.
	   d_fsupc=0 if fsupc >= fpanelc. */
  	d_fsupc = fst_col - fsupc;

	lptr = xlsub[fsupc] + d_fsupc;
	luptr = xlusup[fst_col] + d_fsupc;
	nsupr = xlsub[fsupc+1] - xlsub[fsupc];	/* Leading dimension */
	nsupc = jcol - fst_col;	/* Excluding jcol */
	nrow = nsupr - d_fsupc - nsupc;

	/* Points to the beginning of jcol in snode L\U(jsupno) */
	ufirst = xlusup[jcol] + d_fsupc;	

	ops[TRSV] += nsupc * (nsupc - 1);
	ops[GEMV] += 2 * nrow * nsupc;
	
#ifdef USE_VENDOR_BLAS
#ifdef _CRAY
	STRSV( ftcs1, ftcs2, ftcs3, &nsupc, &lusup[luptr], 
	       &nsupr, &lusup[ufirst], &incx );
#else
	dtrsv_( "L", "N", "U", &nsupc, &lusup[luptr], 
	       &nsupr, &lusup[ufirst], &incx );
#endif
	
	alpha = none; beta = one; /* y := beta*y + alpha*A*x */

#ifdef _CRAY
	SGEMV( ftcs2, &nrow, &nsupc, &alpha, &lusup[luptr+nsupc], &nsupr,
	       &lusup[ufirst], &incx, &beta, &lusup[ufirst+nsupc], &incy );
#else
	dgemv_( "N", &nrow, &nsupc, &alpha, &lusup[luptr+nsupc], &nsupr,
	       &lusup[ufirst], &incx, &beta, &lusup[ufirst+nsupc], &incy );
#endif
#else
	dlsolve ( nsupr, nsupc, &lusup[luptr], &lusup[ufirst] );

	dmatvec ( nsupr, nrow, nsupc, &lusup[luptr+nsupc],
		&lusup[ufirst], tempv );
	
        /* Copy updates from tempv[*] into lusup[*] */
	isub = ufirst + nsupc;
	for (i = 0; i < nrow; i++) {
	    lusup[isub] -= tempv[i];
	    tempv[i] = 0.0;
	    ++isub;
	}

#endif
	
	
    } /* if fst_col < jcol ... */ 

    return 0;
}
Exemplo n.º 4
0
/*! \brief
 *
 * <pre>
 * Purpose
 * =======
 *   ILU_DCOLUMN_DFS performs a symbolic factorization on column jcol, and
 *   decide the supernode boundary.
 *
 *   This routine does not use numeric values, but only use the RHS
 *   row indices to start the dfs.
 *
 *   A supernode representative is the last column of a supernode.
 *   The nonzeros in U[*,j] are segments that end at supernodal
 *   representatives. The routine returns a list of such supernodal
 *   representatives in topological order of the dfs that generates them.
 *   The location of the first nonzero in each such supernodal segment
 *   (supernodal entry location) is also returned.
 *
 * Local parameters
 * ================
 *   nseg: no of segments in current U[*,j]
 *   jsuper: jsuper=EMPTY if column j does not belong to the same
 *	supernode as j-1. Otherwise, jsuper=nsuper.
 *
 *   marker2: A-row --> A-row/col (0/1)
 *   repfnz: SuperA-col --> PA-row
 *   parent: SuperA-col --> SuperA-col
 *   xplore: SuperA-col --> index to L-structure
 *
 * Return value
 * ============
 *     0  success;
 *   > 0  number of bytes allocated when run out of space.
 * </pre>
 */
int
ilu_dcolumn_dfs(
	   const int  m,	 /* in - number of rows in the matrix */
	   const int  jcol,	 /* in */
	   int	      *perm_r,	 /* in */
	   int	      *nseg,	 /* modified - with new segments appended */
	   int	      *lsub_col, /* in - defines the RHS vector to start the
				    dfs */
	   int	      *segrep,	 /* modified - with new segments appended */
	   int	      *repfnz,	 /* modified */
	   int	      *marker,	 /* modified */
	   int	      *parent,	 /* working array */
	   int	      *xplore,	 /* working array */
	   GlobalLU_t *Glu	 /* modified */
	   )
{

    int     jcolp1, jcolm1, jsuper, nsuper, nextl;
    int     k, krep, krow, kmark, kperm;
    int     *marker2;		/* Used for small panel LU */
    int     fsupc;		/* First column of a snode */
    int     myfnz;		/* First nonz column of a U-segment */
    int     chperm, chmark, chrep, kchild;
    int     xdfs, maxdfs, kpar, oldrep;
    int     jptr, jm1ptr;
    int     ito, ifrom; 	/* Used to compress row subscripts */
    int     mem_error;
    int     *xsup, *supno, *lsub, *xlsub;
    int     nzlmax;
    int     maxsuper;

    xsup    = Glu->xsup;
    supno   = Glu->supno;
    lsub    = Glu->lsub;
    xlsub   = Glu->xlsub;
    nzlmax  = Glu->nzlmax;

    maxsuper = sp_ienv(7);
    jcolp1  = jcol + 1;
    jcolm1  = jcol - 1;
    nsuper  = supno[jcol];
    jsuper  = nsuper;
    nextl   = xlsub[jcol];
    marker2 = &marker[2*m];


    /* For each nonzero in A[*,jcol] do dfs */
    for (k = 0; lsub_col[k] != EMPTY; k++) {

	krow = lsub_col[k];
	lsub_col[k] = EMPTY;
	kmark = marker2[krow];

	/* krow was visited before, go to the next nonzero */
	if ( kmark == jcol ) continue;

	/* For each unmarked nbr krow of jcol
	 *	krow is in L: place it in structure of L[*,jcol]
	 */
	marker2[krow] = jcol;
	kperm = perm_r[krow];

	if ( kperm == EMPTY ) {
	    lsub[nextl++] = krow;	/* krow is indexed into A */
	    if ( nextl >= nzlmax ) {
		if ((mem_error = dLUMemXpand(jcol, nextl, LSUB, &nzlmax, Glu)))
		    return (mem_error);
		lsub = Glu->lsub;
	    }
	    if ( kmark != jcolm1 ) jsuper = EMPTY;/* Row index subset testing */
	} else {
	    /*	krow is in U: if its supernode-rep krep
	     *	has been explored, update repfnz[*]
	     */
	    krep = xsup[supno[kperm]+1] - 1;
	    myfnz = repfnz[krep];

	    if ( myfnz != EMPTY ) {	/* Visited before */
		if ( myfnz > kperm ) repfnz[krep] = kperm;
		/* continue; */
	    }
	    else {
		/* Otherwise, perform dfs starting at krep */
		oldrep = EMPTY;
		parent[krep] = oldrep;
		repfnz[krep] = kperm;
		xdfs = xlsub[xsup[supno[krep]]];
		maxdfs = xlsub[krep + 1];

		do {
		    /*
		     * For each unmarked kchild of krep
		     */
		    while ( xdfs < maxdfs ) {

			kchild = lsub[xdfs];
			xdfs++;
			chmark = marker2[kchild];

			if ( chmark != jcol ) { /* Not reached yet */
			    marker2[kchild] = jcol;
			    chperm = perm_r[kchild];

			    /* Case kchild is in L: place it in L[*,k] */
			    if ( chperm == EMPTY ) {
				lsub[nextl++] = kchild;
				if ( nextl >= nzlmax ) {
				    if ( (mem_error = dLUMemXpand(jcol,nextl,
					    LSUB,&nzlmax,Glu)) )
					return (mem_error);
				    lsub = Glu->lsub;
				}
				if ( chmark != jcolm1 ) jsuper = EMPTY;
			    } else {
				/* Case kchild is in U:
				 *   chrep = its supernode-rep. If its rep has
				 *   been explored, update its repfnz[*]
				 */
				chrep = xsup[supno[chperm]+1] - 1;
				myfnz = repfnz[chrep];
				if ( myfnz != EMPTY ) { /* Visited before */
				    if ( myfnz > chperm )
					repfnz[chrep] = chperm;
				} else {
				    /* Continue dfs at super-rep of kchild */
				    xplore[krep] = xdfs;
				    oldrep = krep;
				    krep = chrep; /* Go deeper down G(L^t) */
				    parent[krep] = oldrep;
				    repfnz[krep] = chperm;
				    xdfs = xlsub[xsup[supno[krep]]];
				    maxdfs = xlsub[krep + 1];
				} /* else */

			   } /* else */

			} /* if */

		    } /* while */

		    /* krow has no more unexplored nbrs;
		     *	  place supernode-rep krep in postorder DFS.
		     *	  backtrack dfs to its parent
		     */
		    segrep[*nseg] = krep;
		    ++(*nseg);
		    kpar = parent[krep]; /* Pop from stack, mimic recursion */
		    if ( kpar == EMPTY ) break; /* dfs done */
		    krep = kpar;
		    xdfs = xplore[krep];
		    maxdfs = xlsub[krep + 1];

		} while ( kpar != EMPTY );	/* Until empty stack */

	    } /* else */

	} /* else */

    } /* for each nonzero ... */

    /* Check to see if j belongs in the same supernode as j-1 */
    if ( jcol == 0 ) { /* Do nothing for column 0 */
	nsuper = supno[0] = 0;
    } else {
	fsupc = xsup[nsuper];
	jptr = xlsub[jcol];	/* Not compressed yet */
	jm1ptr = xlsub[jcolm1];

	if ( (nextl-jptr != jptr-jm1ptr-1) ) jsuper = EMPTY;

	/* Always start a new supernode for a singular column */
	if ( nextl == jptr ) jsuper = EMPTY;

	/* Make sure the number of columns in a supernode doesn't
	   exceed threshold. */
	if ( jcol - fsupc >= maxsuper ) jsuper = EMPTY;

	/* If jcol starts a new supernode, reclaim storage space in
	 * lsub from the previous supernode. Note we only store
	 * the subscript set of the first columns of the supernode.
	 */
	if ( jsuper == EMPTY ) {	/* starts a new supernode */
	    if ( (fsupc < jcolm1) ) { /* >= 2 columns in nsuper */
#ifdef CHK_COMPRESS
		printf("  Compress lsub[] at super %d-%d\n", fsupc, jcolm1);
#endif
		ito = xlsub[fsupc+1];
		xlsub[jcolm1] = ito;
		xlsub[jcol] = ito;
		for (ifrom = jptr; ifrom < nextl; ++ifrom, ++ito)
		    lsub[ito] = lsub[ifrom];
		nextl = ito;
	    }
	    nsuper++;
	    supno[jcol] = nsuper;
	} /* if a new supernode */

    }	/* else: jcol > 0 */

    /* Tidy up the pointers before exit */
    xsup[nsuper+1] = jcolp1;
    supno[jcolp1]  = nsuper;
    xlsub[jcolp1]  = nextl;

    return 0;
}
Exemplo n.º 5
0
int
dcopy_to_ucol(
	      int        jcol,	  /* in */
	      int        nseg,	  /* in */
	      int        *segrep,  /* in */
	      int        *repfnz,  /* in */
	      int        *perm_r,  /* in */
	      double     *dense,   /* modified - reset to zero on return */
	      GlobalLU_t *Glu      /* modified */
	      )
{
/* 
 * Gather from SPA dense[*] to global ucol[*].
 */
    int ksub, krep, ksupno;
    int i, k, kfnz, segsze;
    int fsupc, isub, irow;
    int jsupno, nextu;
    int new_next, mem_error;
    int       *xsup, *supno;
    int       *lsub, *xlsub;
    double    *ucol;
    int       *usub, *xusub;
    int       nzumax;
    double zero = 0.0;

    xsup    = Glu->xsup;
    supno   = Glu->supno;
    lsub    = Glu->lsub;
    xlsub   = Glu->xlsub;
    ucol    = (double *) Glu->ucol;
    usub    = Glu->usub;
    xusub   = Glu->xusub;
    nzumax  = Glu->nzumax;
    
    jsupno = supno[jcol];
    nextu  = xusub[jcol];
    k = nseg - 1;
    for (ksub = 0; ksub < nseg; ksub++) {
	krep = segrep[k--];
	ksupno = supno[krep];

	if ( ksupno != jsupno ) { /* Should go into ucol[] */
	    kfnz = repfnz[krep];
	    if ( kfnz != EMPTY ) {	/* Nonzero U-segment */

	    	fsupc = xsup[ksupno];
	        isub = xlsub[fsupc] + kfnz - fsupc;
	        segsze = krep - kfnz + 1;

		new_next = nextu + segsze;
		while ( new_next > nzumax ) {
		    if (mem_error = dLUMemXpand(jcol, nextu, UCOL, &nzumax, Glu))
			return (mem_error);
		    ucol = (double *) Glu->ucol;
		    if (mem_error = dLUMemXpand(jcol, nextu, USUB, &nzumax, Glu))
			return (mem_error);
		    usub = Glu->usub;
		    lsub = Glu->lsub;
		}
		
		for (i = 0; i < segsze; i++) {
		    irow = lsub[isub];
		    usub[nextu] = perm_r[irow];
		    ucol[nextu] = dense[irow];
		    dense[irow] = zero;
		    nextu++;
		    isub++;
		} 

	    }

	}

    } /* for each segment... */

    xusub[jcol + 1] = nextu;      /* Close U[*,jcol] */
    return 0;
}
Exemplo n.º 6
0
int
dsnode_dfs (
	   const int  jcol,	    /* in - start of the supernode */
	   const int  kcol, 	    /* in - end of the supernode */
	   const int  *asub,        /* in */
	   const int  *xa_begin,    /* in */
	   const int  *xa_end,      /* in */
	   int        *xprune,      /* out */
	   int        *marker,      /* modified */
	   GlobalLU_t *Glu          /* modified */
	   )
{

    register int i, k, ifrom, ito, nextl, new_next;
    int          nsuper, krow, kmark, mem_error;
    int          *xsup, *supno;
    int          *lsub, *xlsub;
    int          nzlmax;
    
    xsup    = Glu->xsup;
    supno   = Glu->supno;
    lsub    = Glu->lsub;
    xlsub   = Glu->xlsub;
    nzlmax  = Glu->nzlmax;

    nsuper = ++supno[jcol];	/* Next available supernode number */
    nextl = xlsub[jcol];

    for (i = jcol; i <= kcol; i++) {
	/* For each nonzero in A[*,i] */
	for (k = xa_begin[i]; k < xa_end[i]; k++) {	
	    krow = asub[k];
	    kmark = marker[krow];
	    if ( kmark != kcol ) { /* First time visit krow */
		marker[krow] = kcol;
		lsub[nextl++] = krow;
		if ( nextl >= nzlmax ) {
			mem_error = dLUMemXpand(jcol, nextl, LSUB, &nzlmax, Glu) ;
		    if ( mem_error )
				return (mem_error);
		    lsub = Glu->lsub;
		}
	    }
    	}
	supno[i] = nsuper;
    }

    /* Supernode > 1, then make a copy of the subscripts for pruning */
    if ( jcol < kcol ) {
	new_next = nextl + (nextl - xlsub[jcol]);
	while ( new_next > nzlmax ) {
		mem_error = dLUMemXpand(jcol, nextl, LSUB, &nzlmax, Glu);
	    if ( mem_error )
			return (mem_error);
	    lsub = Glu->lsub;
	}
	ito = nextl;
	for (ifrom = xlsub[jcol]; ifrom < nextl; )
	    lsub[ito++] = lsub[ifrom++];	
        for (i = jcol+1; i <= kcol; i++) xlsub[i] = nextl;
	nextl = ito;
    }

    xsup[nsuper+1] = kcol + 1;
    supno[kcol+1]  = nsuper;
    xprune[kcol]   = nextl;
    xlsub[kcol+1]  = nextl;

    return 0;
}
Exemplo n.º 7
0
int
ilu_dcopy_to_ucol(
	      int	 jcol,	   /* in */
	      int	 nseg,	   /* in */
	      int	 *segrep,  /* in */
	      int	 *repfnz,  /* in */
	      int	 *perm_r,  /* in */
	      double	 *dense,   /* modified - reset to zero on return */
	      int  	 drop_rule,/* in */
	      milu_t	 milu,	   /* in */
	      double	 drop_tol, /* in */
	      int	 quota,    /* maximum nonzero entries allowed */
	      double	 *sum,	   /* out - the sum of dropped entries */
	      int	 *nnzUj,   /* in - out */
	      GlobalLU_t *Glu,	   /* modified */
	      double	 *work	   /* working space with minimum size n,
				    * used by the second dropping rule */
	      )
{
/*
 * Gather from SPA dense[*] to global ucol[*].
 */
    int       ksub, krep, ksupno;
    int       i, k, kfnz, segsze;
    int       fsupc, isub, irow;
    int       jsupno, nextu;
    int       new_next, mem_error;
    int       *xsup, *supno;
    int       *lsub, *xlsub;
    double    *ucol;
    int       *usub, *xusub;
    int       nzumax;
    int       m; /* number of entries in the nonzero U-segments */
    register double d_max = 0.0, d_min = 1.0 / dmach("Safe minimum");
    register double tmp;
    double zero = 0.0;
    int i_1 = 1;

    xsup    = Glu->xsup;
    supno   = Glu->supno;
    lsub    = Glu->lsub;
    xlsub   = Glu->xlsub;
    ucol    = (double *) Glu->ucol;
    usub    = Glu->usub;
    xusub   = Glu->xusub;
    nzumax  = Glu->nzumax;

    *sum = zero;
    if (drop_rule == NODROP) {
	drop_tol = -1.0, quota = Glu->n;
    }

    jsupno = supno[jcol];
    nextu  = xusub[jcol];
    k = nseg - 1;
    for (ksub = 0; ksub < nseg; ksub++) {
	krep = segrep[k--];
	ksupno = supno[krep];

	if ( ksupno != jsupno ) { /* Should go into ucol[] */
	    kfnz = repfnz[krep];
	    if ( kfnz != EMPTY ) {	/* Nonzero U-segment */

		fsupc = xsup[ksupno];
		isub = xlsub[fsupc] + kfnz - fsupc;
		segsze = krep - kfnz + 1;

		new_next = nextu + segsze;
		while ( new_next > nzumax ) {
		    if ((mem_error = dLUMemXpand(jcol, nextu, UCOL, &nzumax,
			    Glu)) != 0)
			return (mem_error);
		    ucol = Glu->ucol;
		    if ((mem_error = dLUMemXpand(jcol, nextu, USUB, &nzumax,
			    Glu)) != 0)
			return (mem_error);
		    usub = Glu->usub;
		    lsub = Glu->lsub;
		}

		for (i = 0; i < segsze; i++) {
		    irow = lsub[isub++];
		    tmp = fabs(dense[irow]);

		    /* first dropping rule */
		    if (quota > 0 && tmp >= drop_tol) {
			if (tmp > d_max) d_max = tmp;
			if (tmp < d_min) d_min = tmp;
			usub[nextu] = perm_r[irow];
			ucol[nextu] = dense[irow];
			nextu++;
		    } else {
			switch (milu) {
			    case SMILU_1:
			    case SMILU_2:
				*sum += dense[irow];
				break;
			    case SMILU_3:
				/* *sum += fabs(dense[irow]);*/
				*sum += tmp;
				break;
			    case SILU:
			    default:
				break;
			}
#ifdef DEBUG
			num_drop_U++;
#endif
		    }
		    dense[irow] = zero;
		}

	    }

	}

    } /* for each segment... */

    xusub[jcol + 1] = nextu;	  /* Close U[*,jcol] */
    m = xusub[jcol + 1] - xusub[jcol];

    /* second dropping rule */
    if (drop_rule & DROP_SECONDARY && m > quota) {
	register double tol = d_max;
	register int m0 = xusub[jcol] + m - 1;

	if (quota > 0) {
	    if (drop_rule & DROP_INTERP) {
		d_max = 1.0 / d_max; d_min = 1.0 / d_min;
		tol = 1.0 / (d_max + (d_min - d_max) * quota / m);
	    } else {
		dcopy_(&m, &ucol[xusub[jcol]], &i_1, work, &i_1);
		tol = dqselect(m, work, quota);
#if 0
		A = &ucol[xusub[jcol]];
		for (i = 0; i < m; i++) work[i] = i;
		qsort(work, m, sizeof(int), _compare_);
		tol = fabs(usub[xusub[jcol] + work[quota]]);
#endif
	    }
	}
	for (i = xusub[jcol]; i <= m0; ) {
	    if (fabs(ucol[i]) <= tol) {
		switch (milu) {
		    case SMILU_1:
		    case SMILU_2:
			*sum += ucol[i];
			break;
		    case SMILU_3:
			*sum += fabs(ucol[i]);
			break;
		    case SILU:
		    default:
			break;
		}
		ucol[i] = ucol[m0];
		usub[i] = usub[m0];
		m0--;
		m--;
#ifdef DEBUG
		num_drop_U++;
#endif
		xusub[jcol + 1]--;
		continue;
	    }
	    i++;
	}
    }

    if (milu == SMILU_2) *sum = fabs(*sum);

    *nnzUj += m;

    return 0;
}
Exemplo n.º 8
0
void
dgstrf (superlu_options_t *options, SuperMatrix *A, double drop_tol,
        int relax, int panel_size, int *etree, void *work, int lwork,
        int *perm_c, int *perm_r, SuperMatrix *L, SuperMatrix *U,
        SuperLUStat_t *stat, int *info)
{
/*
 * Purpose
 * =======
 *
 * DGSTRF computes an LU factorization of a general sparse m-by-n
 * matrix A using partial pivoting with row interchanges.
 * The factorization has the form
 *     Pr * A = L * U
 * where Pr is a row permutation matrix, L is lower triangular with unit
 * diagonal elements (lower trapezoidal if A->nrow > A->ncol), and U is upper
 * triangular (upper trapezoidal if A->nrow < A->ncol).
 *
 * See supermatrix.h for the definition of 'SuperMatrix' structure.
 *
 * Arguments
 * =========
 *
 * options (input) superlu_options_t*
 *         The structure defines the input parameters to control
 *         how the LU decomposition will be performed.
 *
 * A        (input) SuperMatrix*
 *	    Original matrix A, permuted by columns, of dimension
 *          (A->nrow, A->ncol). The type of A can be:
 *          Stype = SLU_NCP; Dtype = SLU_D; Mtype = SLU_GE.
 *
 * drop_tol (input) double (NOT IMPLEMENTED)
 *	    Drop tolerance parameter. At step j of the Gaussian elimination,
 *          if abs(A_ij)/(max_i abs(A_ij)) < drop_tol, drop entry A_ij.
 *          0 <= drop_tol <= 1. The default value of drop_tol is 0.
 *
 * relax    (input) int
 *          To control degree of relaxing supernodes. If the number
 *          of nodes (columns) in a subtree of the elimination tree is less
 *          than relax, this subtree is considered as one supernode,
 *          regardless of the row structures of those columns.
 *
 * panel_size (input) int
 *          A panel consists of at most panel_size consecutive columns.
 *
 * etree    (input) int*, dimension (A->ncol)
 *          Elimination tree of A'*A.
 *          Note: etree is a vector of parent pointers for a forest whose
 *          vertices are the integers 0 to A->ncol-1; etree[root]==A->ncol.
 *          On input, the columns of A should be permuted so that the
 *          etree is in a certain postorder.
 *
 * work     (input/output) void*, size (lwork) (in bytes)
 *          User-supplied work space and space for the output data structures.
 *          Not referenced if lwork = 0;
 *
 * lwork   (input) int
 *         Specifies the size of work array in bytes.
 *         = 0:  allocate space internally by system malloc;
 *         > 0:  use user-supplied work array of length lwork in bytes,
 *               returns error if space runs out.
 *         = -1: the routine guesses the amount of space needed without
 *               performing the factorization, and returns it in
 *               *info; no other side effects.
 *
 * perm_c   (input) int*, dimension (A->ncol)
 *	    Column permutation vector, which defines the
 *          permutation matrix Pc; perm_c[i] = j means column i of A is
 *          in position j in A*Pc.
 *          When searching for diagonal, perm_c[*] is applied to the
 *          row subscripts of A, so that diagonal threshold pivoting
 *          can find the diagonal of A, rather than that of A*Pc.
 *
 * perm_r   (input/output) int*, dimension (A->nrow)
 *          Row permutation vector which defines the permutation matrix Pr,
 *          perm_r[i] = j means row i of A is in position j in Pr*A.
 *          If options->Fact = SamePattern_SameRowPerm, the pivoting routine
 *             will try to use the input perm_r, unless a certain threshold
 *             criterion is violated. In that case, perm_r is overwritten by
 *             a new permutation determined by partial pivoting or diagonal
 *             threshold pivoting.
 *          Otherwise, perm_r is output argument;
 *
 * L        (output) SuperMatrix*
 *          The factor L from the factorization Pr*A=L*U; use compressed row
 *          subscripts storage for supernodes, i.e., L has type:
 *          Stype = SLU_SC, Dtype = SLU_D, Mtype = SLU_TRLU.
 *
 * U        (output) SuperMatrix*
 *	    The factor U from the factorization Pr*A*Pc=L*U. Use column-wise
 *          storage scheme, i.e., U has types: Stype = SLU_NC,
 *          Dtype = SLU_D, Mtype = SLU_TRU.
 *
 * stat     (output) SuperLUStat_t*
 *          Record the statistics on runtime and floating-point operation count.
 *          See util.h for the definition of 'SuperLUStat_t'.
 *
 * info     (output) int*
 *          = 0: successful exit
 *          < 0: if info = -i, the i-th argument had an illegal value
 *          > 0: if info = i, and i is
 *             <= A->ncol: U(i,i) is exactly zero. The factorization has
 *                been completed, but the factor U is exactly singular,
 *                and division by zero will occur if it is used to solve a
 *                system of equations.
 *             > A->ncol: number of bytes allocated when memory allocation
 *                failure occurred, plus A->ncol. If lwork = -1, it is
 *                the estimated amount of space needed, plus A->ncol.
 *
 * ======================================================================
 *
 * Local Working Arrays:
 * ======================
 *   m = number of rows in the matrix
 *   n = number of columns in the matrix
 *
 *   xprune[0:n-1]: xprune[*] points to locations in subscript
 *	vector lsub[*]. For column i, xprune[i] denotes the point where
 *	structural pruning begins. I.e. only xlsub[i],..,xprune[i]-1 need
 *	to be traversed for symbolic factorization.
 *
 *   marker[0:3*m-1]: marker[i] = j means that node i has been
 *	reached when working on column j.
 *	Storage: relative to original row subscripts
 *	NOTE: There are 3 of them: marker/marker1 are used for panel dfs,
 *	      see dpanel_dfs.c; marker2 is used for inner-factorization,
 *            see dcolumn_dfs.c.
 *
 *   parent[0:m-1]: parent vector used during dfs
 *      Storage: relative to new row subscripts
 *
 *   xplore[0:m-1]: xplore[i] gives the location of the next (dfs)
 *	unexplored neighbor of i in lsub[*]
 *
 *   segrep[0:nseg-1]: contains the list of supernodal representatives
 *	in topological order of the dfs. A supernode representative is the
 *	last column of a supernode.
 *      The maximum size of segrep[] is n.
 *
 *   repfnz[0:W*m-1]: for a nonzero segment U[*,j] that ends at a
 *	supernodal representative r, repfnz[r] is the location of the first
 *	nonzero in this segment.  It is also used during the dfs: repfnz[r]>0
 *	indicates the supernode r has been explored.
 *	NOTE: There are W of them, each used for one column of a panel.
 *
 *   panel_lsub[0:W*m-1]: temporary for the nonzeros row indices below
 *      the panel diagonal. These are filled in during dpanel_dfs(), and are
 *      used later in the inner LU factorization within the panel.
 *	panel_lsub[]/dense[] pair forms the SPA data structure.
 *	NOTE: There are W of them.
 *
 *   dense[0:W*m-1]: sparse accumulating (SPA) vector for intermediate values;
 *	    	   NOTE: there are W of them.
 *
 *   tempv[0:*]: real temporary used for dense numeric kernels;
 *	The size of this array is defined by NUM_TEMPV() in dsp_defs.h.
 *
 */
    /* Local working arrays */
    NCPformat *Astore;
    int       *iperm_r = NULL; /* inverse of perm_r; used when
                                  options->Fact == SamePattern_SameRowPerm */
    int       *iperm_c; /* inverse of perm_c */
    int       *iwork;
    double    *dwork;
    int	      *segrep, *repfnz, *parent, *xplore;
    int	      *panel_lsub; /* dense[]/panel_lsub[] pair forms a w-wide SPA */
    int	      *xprune;
    int	      *marker;
    double    *dense, *tempv;
    int       *relax_end;
    double    *a;
    int       *asub;
    int       *xa_begin, *xa_end;
    int       *xsup, *supno;
    int       *xlsub, *xlusup, *xusub;
    int       nzlumax;
    static GlobalLU_t Glu; /* persistent to facilitate multiple factors. */

    /* Local scalars */
    fact_t    fact = options->Fact;
    double    diag_pivot_thresh = options->DiagPivotThresh;
    int       pivrow;   /* pivotal row number in the original matrix A */
    int       nseg1;	/* no of segments in U-column above panel row jcol */
    int       nseg;	/* no of segments in each U-column */
    register int jcol;
    register int kcol;	/* end column of a relaxed snode */
    register int icol;
    register int i, k, jj, new_next, iinfo;
    int       m, n, min_mn, jsupno, fsupc, nextlu, nextu;
    int       w_def;	/* upper bound on panel width */
    int       usepr, iperm_r_allocated = 0;
    int       nnzL, nnzU;
    int       *panel_histo = stat->panel_histo;
    flops_t   *ops = stat->ops;

    iinfo    = 0;
    m        = A->nrow;
    n        = A->ncol;
    min_mn   = SUPERLU_MIN(m, n);
    Astore   = A->Store;
    a        = Astore->nzval;
    asub     = Astore->rowind;
    xa_begin = Astore->colbeg;
    xa_end   = Astore->colend;

    /* Allocate storage common to the factor routines */
    *info = dLUMemInit(fact, work, lwork, m, n, Astore->nnz,
                       panel_size, L, U, &Glu, &iwork, &dwork);
    if ( *info ) return;

    xsup    = Glu.xsup;
    supno   = Glu.supno;
    xlsub   = Glu.xlsub;
    xlusup  = Glu.xlusup;
    xusub   = Glu.xusub;

    SetIWork(m, n, panel_size, iwork, &segrep, &parent, &xplore,
	     &repfnz, &panel_lsub, &xprune, &marker);
    dSetRWork(m, panel_size, dwork, &dense, &tempv);

    usepr = (fact == SamePattern_SameRowPerm);
    if ( usepr ) {
	/* Compute the inverse of perm_r */
	iperm_r = (int *) intMalloc(m);
	for (k = 0; k < m; ++k) iperm_r[perm_r[k]] = k;
	iperm_r_allocated = 1;
    }
    iperm_c = (int *) intMalloc(n);
    for (k = 0; k < n; ++k) iperm_c[perm_c[k]] = k;

    /* Identify relaxed snodes */
    relax_end = (int *) intMalloc(n);
    if ( options->SymmetricMode == YES ) {
        heap_relax_snode(n, etree, relax, marker, relax_end);
    } else {
        relax_snode(n, etree, relax, marker, relax_end);
    }

    ifill (perm_r, m, EMPTY);
    ifill (marker, m * NO_MARKER, EMPTY);
    supno[0] = -1;
    xsup[0]  = xlsub[0] = xusub[0] = xlusup[0] = 0;
    w_def    = panel_size;

    /*
     * Work on one "panel" at a time. A panel is one of the following:
     *	   (a) a relaxed supernode at the bottom of the etree, or
     *	   (b) panel_size contiguous columns, defined by the user
     */
    for (jcol = 0; jcol < min_mn; ) {

	if ( relax_end[jcol] != EMPTY ) { /* start of a relaxed snode */
   	    kcol = relax_end[jcol];	  /* end of the relaxed snode */
	    panel_histo[kcol-jcol+1]++;

	    /* --------------------------------------
	     * Factorize the relaxed supernode(jcol:kcol)
	     * -------------------------------------- */
	    /* Determine the union of the row structure of the snode */
	    if ( (*info = dsnode_dfs(jcol, kcol, asub, xa_begin, xa_end,
				    xprune, marker, &Glu)) != 0 )
		return;

            nextu    = xusub[jcol];
	    nextlu   = xlusup[jcol];
	    jsupno   = supno[jcol];
	    fsupc    = xsup[jsupno];
	    new_next = nextlu + (xlsub[fsupc+1]-xlsub[fsupc])*(kcol-jcol+1);
	    nzlumax = Glu.nzlumax;
	    while ( new_next > nzlumax ) {
		if ( (*info = dLUMemXpand(jcol, nextlu, LUSUP, &nzlumax, &Glu)) )
		    return;
	    }

	    for (icol = jcol; icol<= kcol; icol++) {
		xusub[icol+1] = nextu;

    		/* Scatter into SPA dense[*] */
    		for (k = xa_begin[icol]; k < xa_end[icol]; k++)
        	    dense[asub[k]] = a[k];

	       	/* Numeric update within the snode */
	        dsnode_bmod(icol, jsupno, fsupc, dense, tempv, &Glu, stat);

		if ( (*info = dpivotL(icol, diag_pivot_thresh, &usepr, perm_r,
				      iperm_r, iperm_c, &pivrow, &Glu, stat)) )
		    if ( iinfo == 0 ) iinfo = *info;

#ifdef DEBUG
		dprint_lu_col("[1]: ", icol, pivrow, xprune, &Glu);
#endif

	    }

	    jcol = icol;

	} else { /* Work on one panel of panel_size columns */

	    /* Adjust panel_size so that a panel won't overlap with the next
	     * relaxed snode.
	     */
	    panel_size = w_def;
	    for (k = jcol + 1; k < SUPERLU_MIN(jcol+panel_size, min_mn); k++)
		if ( relax_end[k] != EMPTY ) {
		    panel_size = k - jcol;
		    break;
		}
	    if ( k == min_mn ) panel_size = min_mn - jcol;
	    panel_histo[panel_size]++;

	    /* symbolic factor on a panel of columns */
	    dpanel_dfs(m, panel_size, jcol, A, perm_r, &nseg1,
		      dense, panel_lsub, segrep, repfnz, xprune,
		      marker, parent, xplore, &Glu);

	    /* numeric sup-panel updates in topological order */
	    dpanel_bmod(m, panel_size, jcol, nseg1, dense,
		        tempv, segrep, repfnz, &Glu, stat);

	    /* Sparse LU within the panel, and below panel diagonal */
    	    for ( jj = jcol; jj < jcol + panel_size; jj++) {
 		k = (jj - jcol) * m; /* column index for w-wide arrays */

		nseg = nseg1;	/* Begin after all the panel segments */

	    	if ((*info = dcolumn_dfs(m, jj, perm_r, &nseg, &panel_lsub[k],
					segrep, &repfnz[k], xprune, marker,
					parent, xplore, &Glu)) != 0) return;

	      	/* Numeric updates */
	    	if ((*info = dcolumn_bmod(jj, (nseg - nseg1), &dense[k],
					 tempv, &segrep[nseg1], &repfnz[k],
					 jcol, &Glu, stat)) != 0) return;

	        /* Copy the U-segments to ucol[*] */
		if ((*info = dcopy_to_ucol(jj, nseg, segrep, &repfnz[k],
					  perm_r, &dense[k], &Glu)) != 0)
		    return;

	    	if ( (*info = dpivotL(jj, diag_pivot_thresh, &usepr, perm_r,
				      iperm_r, iperm_c, &pivrow, &Glu, stat)) )
		    if ( iinfo == 0 ) iinfo = *info;

		/* Prune columns (0:jj-1) using column jj */
	    	dpruneL(jj, perm_r, pivrow, nseg, segrep,
                        &repfnz[k], xprune, &Glu);

		/* Reset repfnz[] for this column */
	    	resetrep_col (nseg, segrep, &repfnz[k]);

#ifdef DEBUG
		dprint_lu_col("[2]: ", jj, pivrow, xprune, &Glu);
#endif

	    }

   	    jcol += panel_size;	/* Move to the next panel */

	} /* else */

    } /* for */

    *info = iinfo;

    if ( m > n ) {
	k = 0;
        for (i = 0; i < m; ++i)
            if ( perm_r[i] == EMPTY ) {
    		perm_r[i] = n + k;
		++k;
	    }
    }

    countnz(min_mn, xprune, &nnzL, &nnzU, &Glu);
    fixupL(min_mn, perm_r, &Glu);

    dLUWorkFree(iwork, dwork, &Glu); /* Free work space and compress storage */

    if ( fact == SamePattern_SameRowPerm ) {
        /* L and U structures may have changed due to possibly different
	   pivoting, even though the storage is available.
	   There could also be memory expansions, so the array locations
           may have changed, */
        ((SCformat *)L->Store)->nnz = nnzL;
	((SCformat *)L->Store)->nsuper = Glu.supno[n];
	((SCformat *)L->Store)->nzval = Glu.lusup;
	((SCformat *)L->Store)->nzval_colptr = Glu.xlusup;
	((SCformat *)L->Store)->rowind = Glu.lsub;
	((SCformat *)L->Store)->rowind_colptr = Glu.xlsub;
	((NCformat *)U->Store)->nnz = nnzU;
	((NCformat *)U->Store)->nzval = Glu.ucol;
	((NCformat *)U->Store)->rowind = Glu.usub;
	((NCformat *)U->Store)->colptr = Glu.xusub;
    } else {
        dCreate_SuperNode_Matrix(L, A->nrow, min_mn, nnzL, Glu.lusup,
	                         Glu.xlusup, Glu.lsub, Glu.xlsub, Glu.supno,
			         Glu.xsup, SLU_SC, SLU_D, SLU_TRLU);
    	dCreate_CompCol_Matrix(U, min_mn, min_mn, nnzU, Glu.ucol,
			       Glu.usub, Glu.xusub, SLU_NC, SLU_D, SLU_TRU);
    }

    ops[FACT] += ops[TRSV] + ops[GEMV];

    if ( iperm_r_allocated ) SUPERLU_FREE (iperm_r);
    SUPERLU_FREE (iperm_c);
    SUPERLU_FREE (relax_end);

}
Exemplo n.º 9
0
void
dgsitrf(superlu_options_t *options, SuperMatrix *A, int relax, int panel_size,
	int *etree, void *work, int lwork, int *perm_c, int *perm_r,
	SuperMatrix *L, SuperMatrix *U, 
    	GlobalLU_t *Glu, /* persistent to facilitate multiple factorizations */
	SuperLUStat_t *stat, int *info)
{
    /* Local working arrays */
    NCPformat *Astore;
    int       *iperm_r = NULL; /* inverse of perm_r; used when
				  options->Fact == SamePattern_SameRowPerm */
    int       *iperm_c; /* inverse of perm_c */
    int       *swap, *iswap; /* swap is used to store the row permutation
				during the factorization. Initially, it is set
				to iperm_c (row indeces of Pc*A*Pc').
				iswap is the inverse of swap. After the
				factorization, it is equal to perm_r. */
    int       *iwork;
    double   *dwork;
    int       *segrep, *repfnz, *parent, *xplore;
    int       *panel_lsub; /* dense[]/panel_lsub[] pair forms a w-wide SPA */
    int       *marker, *marker_relax;
    double    *dense, *tempv;
    int       *relax_end, *relax_fsupc;
    double    *a;
    int       *asub;
    int       *xa_begin, *xa_end;
    int       *xsup, *supno;
    int       *xlsub, *xlusup, *xusub;
    int       nzlumax;
    double    *amax; 
    double    drop_sum;
    double alpha, omega;  /* used in MILU, mimicing DRIC */
    double    *dwork2;	   /* used by the second dropping rule */

    /* Local scalars */
    fact_t    fact = options->Fact;
    double    diag_pivot_thresh = options->DiagPivotThresh;
    double    drop_tol = options->ILU_DropTol; /* tau */
    double    fill_ini = options->ILU_FillTol; /* tau^hat */
    double    gamma = options->ILU_FillFactor;
    int       drop_rule = options->ILU_DropRule;
    milu_t    milu = options->ILU_MILU;
    double    fill_tol;
    int       pivrow;	/* pivotal row number in the original matrix A */
    int       nseg1;	/* no of segments in U-column above panel row jcol */
    int       nseg;	/* no of segments in each U-column */
    register int jcol;
    register int kcol;	/* end column of a relaxed snode */
    register int icol;
    register int i, k, jj, new_next, iinfo;
    int       m, n, min_mn, jsupno, fsupc, nextlu, nextu;
    int       w_def;	/* upper bound on panel width */
    int       usepr, iperm_r_allocated = 0;
    int       nnzL, nnzU;
    int       *panel_histo = stat->panel_histo;
    flops_t   *ops = stat->ops;

    int       last_drop;/* the last column which the dropping rules applied */
    int       quota;
    int       nnzAj;	/* number of nonzeros in A(:,1:j) */
    int       nnzLj, nnzUj;
    double    tol_L = drop_tol, tol_U = drop_tol;
    double zero = 0.0;
    double one = 1.0;

    /* Executable */	   
    iinfo    = 0;
    m	     = A->nrow;
    n	     = A->ncol;
    min_mn   = SUPERLU_MIN(m, n);
    Astore   = A->Store;
    a	     = Astore->nzval;
    asub     = Astore->rowind;
    xa_begin = Astore->colbeg;
    xa_end   = Astore->colend;

    /* Allocate storage common to the factor routines */
    *info = dLUMemInit(fact, work, lwork, m, n, Astore->nnz, panel_size,
		       gamma, L, U, Glu, &iwork, &dwork);
    if ( *info ) return;

    xsup    = Glu->xsup;
    supno   = Glu->supno;
    xlsub   = Glu->xlsub;
    xlusup  = Glu->xlusup;
    xusub   = Glu->xusub;

    SetIWork(m, n, panel_size, iwork, &segrep, &parent, &xplore,
	     &repfnz, &panel_lsub, &marker_relax, &marker);
    dSetRWork(m, panel_size, dwork, &dense, &tempv);

    usepr = (fact == SamePattern_SameRowPerm);
    if ( usepr ) {
	/* Compute the inverse of perm_r */
	iperm_r = (int *) intMalloc(m);
	for (k = 0; k < m; ++k) iperm_r[perm_r[k]] = k;
	iperm_r_allocated = 1;
    }

    iperm_c = (int *) intMalloc(n);
    for (k = 0; k < n; ++k) iperm_c[perm_c[k]] = k;
    swap = (int *)intMalloc(n);
    for (k = 0; k < n; k++) swap[k] = iperm_c[k];
    iswap = (int *)intMalloc(n);
    for (k = 0; k < n; k++) iswap[k] = perm_c[k];
    amax = (double *) doubleMalloc(panel_size);
    if (drop_rule & DROP_SECONDARY)
	dwork2 = (double *)doubleMalloc(n);
    else
	dwork2 = NULL;

    nnzAj = 0;
    nnzLj = 0;
    nnzUj = 0;
    last_drop = SUPERLU_MAX(min_mn - 2 * sp_ienv(7), (int)(min_mn * 0.95));
    alpha = pow((double)n, -1.0 / options->ILU_MILU_Dim);

    /* Identify relaxed snodes */
    relax_end = (int *) intMalloc(n);
    relax_fsupc = (int *) intMalloc(n);
    if ( options->SymmetricMode == YES )
	ilu_heap_relax_snode(n, etree, relax, marker, relax_end, relax_fsupc);
    else
	ilu_relax_snode(n, etree, relax, marker, relax_end, relax_fsupc);

    ifill (perm_r, m, EMPTY);
    ifill (marker, m * NO_MARKER, EMPTY);
    supno[0] = -1;
    xsup[0]  = xlsub[0] = xusub[0] = xlusup[0] = 0;
    w_def    = panel_size;

    /* Mark the rows used by relaxed supernodes */
    ifill (marker_relax, m, EMPTY);
    i = mark_relax(m, relax_end, relax_fsupc, xa_begin, xa_end,
	         asub, marker_relax);
#if ( PRNTlevel >= 1)
    printf("%d relaxed supernodes.\n", i);
#endif

    /*
     * Work on one "panel" at a time. A panel is one of the following:
     *	   (a) a relaxed supernode at the bottom of the etree, or
     *	   (b) panel_size contiguous columns, defined by the user
     */
    for (jcol = 0; jcol < min_mn; ) {

	if ( relax_end[jcol] != EMPTY ) { /* start of a relaxed snode */
	    kcol = relax_end[jcol];	  /* end of the relaxed snode */
	    panel_histo[kcol-jcol+1]++;

	    /* Drop small rows in the previous supernode. */
	    if (jcol > 0 && jcol < last_drop) {
		int first = xsup[supno[jcol - 1]];
		int last = jcol - 1;
		int quota;

		/* Compute the quota */
		if (drop_rule & DROP_PROWS)
		    quota = gamma * Astore->nnz / m * (m - first) / m
			    * (last - first + 1);
		else if (drop_rule & DROP_COLUMN) {
		    int i;
		    quota = 0;
		    for (i = first; i <= last; i++)
			quota += xa_end[i] - xa_begin[i];
		    quota = gamma * quota * (m - first) / m;
		} else if (drop_rule & DROP_AREA)
		    quota = gamma * nnzAj * (1.0 - 0.5 * (last + 1.0) / m)
			    - nnzLj;
		else
		    quota = m * n;
		fill_tol = pow(fill_ini, 1.0 - 0.5 * (first + last) / min_mn);

		/* Drop small rows */
		i = ilu_ddrop_row(options, first, last, tol_L, quota, &nnzLj,
				  &fill_tol, Glu, tempv, dwork2, 0);
		/* Reset the parameters */
		if (drop_rule & DROP_DYNAMIC) {
		    if (gamma * nnzAj * (1.0 - 0.5 * (last + 1.0) / m)
			     < nnzLj)
			tol_L = SUPERLU_MIN(1.0, tol_L * 2.0);
		    else
			tol_L = SUPERLU_MAX(drop_tol, tol_L * 0.5);
		}
		if (fill_tol < 0) iinfo -= (int)fill_tol;
#ifdef DEBUG
		num_drop_L += i * (last - first + 1);
#endif
	    }

	    /* --------------------------------------
	     * Factorize the relaxed supernode(jcol:kcol)
	     * -------------------------------------- */
	    /* Determine the union of the row structure of the snode */
	    if ( (*info = ilu_dsnode_dfs(jcol, kcol, asub, xa_begin, xa_end,
					 marker, Glu)) != 0 )
		return;

	    nextu    = xusub[jcol];
	    nextlu   = xlusup[jcol];
	    jsupno   = supno[jcol];
	    fsupc    = xsup[jsupno];
	    new_next = nextlu + (xlsub[fsupc+1]-xlsub[fsupc])*(kcol-jcol+1);
	    nzlumax = Glu->nzlumax;
	    while ( new_next > nzlumax ) {
		if ((*info = dLUMemXpand(jcol, nextlu, LUSUP, &nzlumax, Glu)))
		    return;
	    }

	    for (icol = jcol; icol <= kcol; icol++) {
		xusub[icol+1] = nextu;

		amax[0] = 0.0;
		/* Scatter into SPA dense[*] */
		for (k = xa_begin[icol]; k < xa_end[icol]; k++) {
		    register double tmp = fabs(a[k]);
		    if (tmp > amax[0]) amax[0] = tmp;
		    dense[asub[k]] = a[k];
		}
		nnzAj += xa_end[icol] - xa_begin[icol];
		if (amax[0] == 0.0) {
		    amax[0] = fill_ini;
#if ( PRNTlevel >= 1)
		    printf("Column %d is entirely zero!\n", icol);
		    fflush(stdout);
#endif
		}

		/* Numeric update within the snode */
		dsnode_bmod(icol, jsupno, fsupc, dense, tempv, Glu, stat);

		if (usepr) pivrow = iperm_r[icol];
		fill_tol = pow(fill_ini, 1.0 - (double)icol / (double)min_mn);
		if ( (*info = ilu_dpivotL(icol, diag_pivot_thresh, &usepr,
					  perm_r, iperm_c[icol], swap, iswap,
					  marker_relax, &pivrow,
                                          amax[0] * fill_tol, milu, zero,
                                          Glu, stat)) ) {
		    iinfo++;
		    marker[pivrow] = kcol;
		}

	    }

	    jcol = kcol + 1;

	} else { /* Work on one panel of panel_size columns */

	    /* Adjust panel_size so that a panel won't overlap with the next
	     * relaxed snode.
	     */
	    panel_size = w_def;
	    for (k = jcol + 1; k < SUPERLU_MIN(jcol+panel_size, min_mn); k++)
		if ( relax_end[k] != EMPTY ) {
		    panel_size = k - jcol;
		    break;
		}
	    if ( k == min_mn ) panel_size = min_mn - jcol;
	    panel_histo[panel_size]++;

	    /* symbolic factor on a panel of columns */
	    ilu_dpanel_dfs(m, panel_size, jcol, A, perm_r, &nseg1,
                          dense, amax, panel_lsub, segrep, repfnz,
                          marker, parent, xplore, Glu);

	    /* numeric sup-panel updates in topological order */
	    dpanel_bmod(m, panel_size, jcol, nseg1, dense,
			tempv, segrep, repfnz, Glu, stat);

	    /* Sparse LU within the panel, and below panel diagonal */
	    for (jj = jcol; jj < jcol + panel_size; jj++) {

		k = (jj - jcol) * m; /* column index for w-wide arrays */

		nseg = nseg1;	/* Begin after all the panel segments */

		nnzAj += xa_end[jj] - xa_begin[jj];

		if ((*info = ilu_dcolumn_dfs(m, jj, perm_r, &nseg,
					     &panel_lsub[k], segrep, &repfnz[k],
					     marker, parent, xplore, Glu)))
		    return;

		/* Numeric updates */
		if ((*info = dcolumn_bmod(jj, (nseg - nseg1), &dense[k],
					  tempv, &segrep[nseg1], &repfnz[k],
					  jcol, Glu, stat)) != 0) return;

		/* Make a fill-in position if the column is entirely zero */
		if (xlsub[jj + 1] == xlsub[jj]) {
		    register int i, row;
		    int nextl;
		    int nzlmax = Glu->nzlmax;
		    int *lsub = Glu->lsub;
		    int *marker2 = marker + 2 * m;

		    /* Allocate memory */
		    nextl = xlsub[jj] + 1;
		    if (nextl >= nzlmax) {
			int error = dLUMemXpand(jj, nextl, LSUB, &nzlmax, Glu);
			if (error) { *info = error; return; }
			lsub = Glu->lsub;
		    }
		    xlsub[jj + 1]++;
		    assert(xlusup[jj]==xlusup[jj+1]);
		    xlusup[jj + 1]++;
		    ((double *) Glu->lusup)[xlusup[jj]] = zero;

		    /* Choose a row index (pivrow) for fill-in */
		    for (i = jj; i < n; i++)
			if (marker_relax[swap[i]] <= jj) break;
		    row = swap[i];
		    marker2[row] = jj;
		    lsub[xlsub[jj]] = row;
#ifdef DEBUG
		    printf("Fill col %d.\n", jj);
		    fflush(stdout);
#endif
		}

		/* Computer the quota */
		if (drop_rule & DROP_PROWS)
		    quota = gamma * Astore->nnz / m * jj / m;
		else if (drop_rule & DROP_COLUMN)
		    quota = gamma * (xa_end[jj] - xa_begin[jj]) *
			    (jj + 1) / m;
		else if (drop_rule & DROP_AREA)
		    quota = gamma * 0.9 * nnzAj * 0.5 - nnzUj;
		else
		    quota = m;

		/* Copy the U-segments to ucol[*] and drop small entries */
		if ((*info = ilu_dcopy_to_ucol(jj, nseg, segrep, &repfnz[k],
					       perm_r, &dense[k], drop_rule,
					       milu, amax[jj - jcol] * tol_U,
					       quota, &drop_sum, &nnzUj, Glu,
					       dwork2)) != 0)
		    return;

		/* Reset the dropping threshold if required */
		if (drop_rule & DROP_DYNAMIC) {
		    if (gamma * 0.9 * nnzAj * 0.5 < nnzLj)
			tol_U = SUPERLU_MIN(1.0, tol_U * 2.0);
		    else
			tol_U = SUPERLU_MAX(drop_tol, tol_U * 0.5);
		}

		if (drop_sum != zero)
		{
		    if (drop_sum > zero)
			omega = SUPERLU_MIN(2.0 * (1.0 - alpha)
				* amax[jj - jcol] / drop_sum, one);
		    else
			omega = SUPERLU_MAX(2.0 * (1.0 - alpha)
				* amax[jj - jcol] / drop_sum, -one);
		    drop_sum *= omega;
                }
		if (usepr) pivrow = iperm_r[jj];
		fill_tol = pow(fill_ini, 1.0 - (double)jj / (double)min_mn);
		if ( (*info = ilu_dpivotL(jj, diag_pivot_thresh, &usepr, perm_r,
					  iperm_c[jj], swap, iswap,
					  marker_relax, &pivrow,
					  amax[jj - jcol] * fill_tol, milu,
					  drop_sum, Glu, stat)) ) {
		    iinfo++;
		    marker[m + pivrow] = jj;
		    marker[2 * m + pivrow] = jj;
		}

		/* Reset repfnz[] for this column */
		resetrep_col (nseg, segrep, &repfnz[k]);

		/* Start a new supernode, drop the previous one */
		if (jj > 0 && supno[jj] > supno[jj - 1] && jj < last_drop) {
		    int first = xsup[supno[jj - 1]];
		    int last = jj - 1;
		    int quota;

		    /* Compute the quota */
		    if (drop_rule & DROP_PROWS)
			quota = gamma * Astore->nnz / m * (m - first) / m
				* (last - first + 1);
		    else if (drop_rule & DROP_COLUMN) {
			int i;
			quota = 0;
			for (i = first; i <= last; i++)
			    quota += xa_end[i] - xa_begin[i];
			quota = gamma * quota * (m - first) / m;
		    } else if (drop_rule & DROP_AREA)
			quota = gamma * nnzAj * (1.0 - 0.5 * (last + 1.0)
				/ m) - nnzLj;
		    else
			quota = m * n;
		    fill_tol = pow(fill_ini, 1.0 - 0.5 * (first + last) /
			    (double)min_mn);

		    /* Drop small rows */
		    i = ilu_ddrop_row(options, first, last, tol_L, quota,
				      &nnzLj, &fill_tol, Glu, tempv, dwork2,
				      1);

		    /* Reset the parameters */
		    if (drop_rule & DROP_DYNAMIC) {
			if (gamma * nnzAj * (1.0 - 0.5 * (last + 1.0) / m)
				< nnzLj)
			    tol_L = SUPERLU_MIN(1.0, tol_L * 2.0);
			else
			    tol_L = SUPERLU_MAX(drop_tol, tol_L * 0.5);
		    }
		    if (fill_tol < 0) iinfo -= (int)fill_tol;
#ifdef DEBUG
		    num_drop_L += i * (last - first + 1);
#endif
		} /* if start a new supernode */

	    } /* for */

	    jcol += panel_size; /* Move to the next panel */

	} /* else */

    } /* for */

    *info = iinfo;

    if ( m > n ) {
	k = 0;
	for (i = 0; i < m; ++i)
	    if ( perm_r[i] == EMPTY ) {
		perm_r[i] = n + k;
		++k;
	    }
    }

    ilu_countnz(min_mn, &nnzL, &nnzU, Glu);
    fixupL(min_mn, perm_r, Glu);

    dLUWorkFree(iwork, dwork, Glu); /* Free work space and compress storage */

    if ( fact == SamePattern_SameRowPerm ) {
	/* L and U structures may have changed due to possibly different
	   pivoting, even though the storage is available.
	   There could also be memory expansions, so the array locations
	   may have changed, */
	((SCformat *)L->Store)->nnz = nnzL;
	((SCformat *)L->Store)->nsuper = Glu->supno[n];
	((SCformat *)L->Store)->nzval = (double *) Glu->lusup;
	((SCformat *)L->Store)->nzval_colptr = Glu->xlusup;
	((SCformat *)L->Store)->rowind = Glu->lsub;
	((SCformat *)L->Store)->rowind_colptr = Glu->xlsub;
	((NCformat *)U->Store)->nnz = nnzU;
	((NCformat *)U->Store)->nzval = (double *) Glu->ucol;
	((NCformat *)U->Store)->rowind = Glu->usub;
	((NCformat *)U->Store)->colptr = Glu->xusub;
    } else {
	dCreate_SuperNode_Matrix(L, A->nrow, min_mn, nnzL,
              (double *) Glu->lusup, Glu->xlusup,
              Glu->lsub, Glu->xlsub, Glu->supno, Glu->xsup,
	      SLU_SC, SLU_D, SLU_TRLU);
	dCreate_CompCol_Matrix(U, min_mn, min_mn, nnzU,
	      (double *) Glu->ucol, Glu->usub, Glu->xusub,
	      SLU_NC, SLU_D, SLU_TRU);
    }

    ops[FACT] += ops[TRSV] + ops[GEMV];
    stat->expansions = --(Glu->num_expansions);

    if ( iperm_r_allocated ) SUPERLU_FREE (iperm_r);
    SUPERLU_FREE (iperm_c);
    SUPERLU_FREE (relax_end);
    SUPERLU_FREE (swap);
    SUPERLU_FREE (iswap);
    SUPERLU_FREE (relax_fsupc);
    SUPERLU_FREE (amax);
    if ( dwork2 ) SUPERLU_FREE (dwork2);

}