kusano 7d535a
kusano 7d535a
/*! @file sgscon.c
kusano 7d535a
 * \brief Estimates reciprocal of the condition number of a general matrix
kusano 7d535a
 * 
kusano 7d535a
 * 
kusano 7d535a
 * -- SuperLU routine (version 3.0) --
kusano 7d535a
 * Univ. of California Berkeley, Xerox Palo Alto Research Center,
kusano 7d535a
 * and Lawrence Berkeley National Lab.
kusano 7d535a
 * October 15, 2003
kusano 7d535a
 *
kusano 7d535a
 * Modified from lapack routines SGECON.
kusano 7d535a
 *  
kusano 7d535a
 */
kusano 7d535a
kusano 7d535a
/*
kusano 7d535a
 * File name:	sgscon.c
kusano 7d535a
 * History:     Modified from lapack routines SGECON.
kusano 7d535a
 */
kusano 7d535a
#include <math.h></math.h>
kusano 7d535a
#include "slu_sdefs.h"
kusano 7d535a
kusano 7d535a
/*! \brief
kusano 7d535a
 *
kusano 7d535a
 * 
kusano 7d535a
 *   Purpose   
kusano 7d535a
 *   =======   
kusano 7d535a
 *
kusano 7d535a
 *   SGSCON estimates the reciprocal of the condition number of a general 
kusano 7d535a
 *   real matrix A, in either the 1-norm or the infinity-norm, using   
kusano 7d535a
 *   the LU factorization computed by SGETRF.   *
kusano 7d535a
 *
kusano 7d535a
 *   An estimate is obtained for norm(inv(A)), and the reciprocal of the   
kusano 7d535a
 *   condition number is computed as   
kusano 7d535a
 *      RCOND = 1 / ( norm(A) * norm(inv(A)) ).   
kusano 7d535a
 *
kusano 7d535a
 *   See supermatrix.h for the definition of 'SuperMatrix' structure.
kusano 7d535a
 * 
kusano 7d535a
 *   Arguments   
kusano 7d535a
 *   =========   
kusano 7d535a
 *
kusano 7d535a
 *    NORM    (input) char*
kusano 7d535a
 *            Specifies whether the 1-norm condition number or the   
kusano 7d535a
 *            infinity-norm condition number is required:   
kusano 7d535a
 *            = '1' or 'O':  1-norm;   
kusano 7d535a
 *            = 'I':         Infinity-norm.
kusano 7d535a
 *	    
kusano 7d535a
 *    L       (input) SuperMatrix*
kusano 7d535a
 *            The factor L from the factorization Pr*A*Pc=L*U as computed by
kusano 7d535a
 *            sgstrf(). Use compressed row subscripts storage for supernodes,
kusano 7d535a
 *            i.e., L has types: Stype = SLU_SC, Dtype = SLU_S, Mtype = SLU_TRLU.
kusano 7d535a
 * 
kusano 7d535a
 *    U       (input) SuperMatrix*
kusano 7d535a
 *            The factor U from the factorization Pr*A*Pc=L*U as computed by
kusano 7d535a
 *            sgstrf(). Use column-wise storage scheme, i.e., U has types:
kusano 7d535a
 *            Stype = SLU_NC, Dtype = SLU_S, Mtype = SLU_TRU.
kusano 7d535a
 *	    
kusano 7d535a
 *    ANORM   (input) float
kusano 7d535a
 *            If NORM = '1' or 'O', the 1-norm of the original matrix A.   
kusano 7d535a
 *            If NORM = 'I', the infinity-norm of the original matrix A.
kusano 7d535a
 *	    
kusano 7d535a
 *    RCOND   (output) float*
kusano 7d535a
 *           The reciprocal of the condition number of the matrix A,   
kusano 7d535a
 *           computed as RCOND = 1/(norm(A) * norm(inv(A))).
kusano 7d535a
 *	    
kusano 7d535a
 *    INFO    (output) int*
kusano 7d535a
 *           = 0:  successful exit   
kusano 7d535a
 *           < 0:  if INFO = -i, the i-th argument had an illegal value   
kusano 7d535a
 *
kusano 7d535a
 *    ===================================================================== 
kusano 7d535a
 * 
kusano 7d535a
 */
kusano 7d535a
kusano 7d535a
void
kusano 7d535a
sgscon(char *norm, SuperMatrix *L, SuperMatrix *U,
kusano 7d535a
       float anorm, float *rcond, SuperLUStat_t *stat, int *info)
kusano 7d535a
{
kusano 7d535a
kusano 7d535a
kusano 7d535a
    /* Local variables */
kusano 7d535a
    int    kase, kase1, onenrm, i;
kusano 7d535a
    float ainvnm;
kusano 7d535a
    float *work;
kusano 7d535a
    int    *iwork;
kusano 7d535a
    extern int srscl_(int *, float *, float *, int *);
kusano 7d535a
kusano 7d535a
    extern int slacon_(int *, float *, float *, int *, float *, int *);
kusano 7d535a
kusano 7d535a
    
kusano 7d535a
    /* Test the input parameters. */
kusano 7d535a
    *info = 0;
kusano 7d535a
    onenrm = *(unsigned char *)norm == '1' || lsame_(norm, "O");
kusano 7d535a
    if (! onenrm && ! lsame_(norm, "I")) *info = -1;
kusano 7d535a
    else if (L->nrow < 0 || L->nrow != L->ncol ||
kusano 7d535a
             L->Stype != SLU_SC || L->Dtype != SLU_S || L->Mtype != SLU_TRLU)
kusano 7d535a
	 *info = -2;
kusano 7d535a
    else if (U->nrow < 0 || U->nrow != U->ncol ||
kusano 7d535a
             U->Stype != SLU_NC || U->Dtype != SLU_S || U->Mtype != SLU_TRU) 
kusano 7d535a
	*info = -3;
kusano 7d535a
    if (*info != 0) {
kusano 7d535a
	i = -(*info);
kusano 7d535a
	xerbla_("sgscon", &i);
kusano 7d535a
	return;
kusano 7d535a
    }
kusano 7d535a
kusano 7d535a
    /* Quick return if possible */
kusano 7d535a
    *rcond = 0.;
kusano 7d535a
    if ( L->nrow == 0 || U->nrow == 0) {
kusano 7d535a
	*rcond = 1.;
kusano 7d535a
	return;
kusano 7d535a
    }
kusano 7d535a
kusano 7d535a
    work = floatCalloc( 3*L->nrow );
kusano 7d535a
    iwork = intMalloc( L->nrow );
kusano 7d535a
kusano 7d535a
kusano 7d535a
    if ( !work || !iwork )
kusano 7d535a
	ABORT("Malloc fails for work arrays in sgscon.");
kusano 7d535a
    
kusano 7d535a
    /* Estimate the norm of inv(A). */
kusano 7d535a
    ainvnm = 0.;
kusano 7d535a
    if ( onenrm ) kase1 = 1;
kusano 7d535a
    else kase1 = 2;
kusano 7d535a
    kase = 0;
kusano 7d535a
kusano 7d535a
    do {
kusano 7d535a
	slacon_(&L->nrow, &work[L->nrow], &work[0], &iwork[0], &ainvnm, &kase);
kusano 7d535a
kusano 7d535a
	if (kase == 0) break;
kusano 7d535a
kusano 7d535a
	if (kase == kase1) {
kusano 7d535a
	    /* Multiply by inv(L). */
kusano 7d535a
	    sp_strsv("L", "No trans", "Unit", L, U, &work[0], stat, info);
kusano 7d535a
kusano 7d535a
	    /* Multiply by inv(U). */
kusano 7d535a
	    sp_strsv("U", "No trans", "Non-unit", L, U, &work[0], stat, info);
kusano 7d535a
	    
kusano 7d535a
	} else {
kusano 7d535a
kusano 7d535a
	    /* Multiply by inv(U'). */
kusano 7d535a
	    sp_strsv("U", "Transpose", "Non-unit", L, U, &work[0], stat, info);
kusano 7d535a
kusano 7d535a
	    /* Multiply by inv(L'). */
kusano 7d535a
	    sp_strsv("L", "Transpose", "Unit", L, U, &work[0], stat, info);
kusano 7d535a
	    
kusano 7d535a
	}
kusano 7d535a
kusano 7d535a
    } while ( kase != 0 );
kusano 7d535a
kusano 7d535a
    /* Compute the estimate of the reciprocal condition number. */
kusano 7d535a
    if (ainvnm != 0.) *rcond = (1. / ainvnm) / anorm;
kusano 7d535a
kusano 7d535a
    SUPERLU_FREE (work);
kusano 7d535a
    SUPERLU_FREE (iwork);
kusano 7d535a
    return;
kusano 7d535a
kusano 7d535a
} /* sgscon */
kusano 7d535a