示例#1
0
文件: qrfactor.c 项目: Rainwin2015/C
VEC	*QRsolve(const MAT *QR, const VEC *diag, const VEC *b, VEC *x)
#endif
{
    int	limit;
    STATIC	VEC	*tmp = VNULL;
    
    if ( ! QR || ! diag || ! b )
	error(E_NULL,"QRsolve");
    limit = min(QR->m,QR->n);
    if ( diag->dim < limit || b->dim != QR->m )
	error(E_SIZES,"QRsolve");
    tmp = v_resize(tmp,limit);
    MEM_STAT_REG(tmp,TYPE_VEC);

    x = v_resize(x,QR->n);
    _Qsolve(QR,diag,b,x,tmp);
    x = Usolve(QR,x,x,0.0);
    v_resize(x,QR->n);

#ifdef	THREADSAFE
    V_FREE(tmp);
#endif

    return x;
}
示例#2
0
int
LUsolve(Matrix A, int *indexarray, Vector b, Vector x)
{
    int i, dim = A->dim;

    for (i = 0; i < dim; i++)
        x->ve[i] = b->ve[indexarray[i]];

    if (Lsolve(A, x, x, 1.) == -1 || Usolve(A, x, x, 0.) == -1)
        return -1;
    return 0;
}
VEC	*LUsolve(const MAT *LU, PERM *pivot, const VEC *b, VEC *x)
#endif
{
	if ( ! LU || ! b || ! pivot )
		error(E_NULL,"LUsolve");
	if ( LU->m != LU->n || LU->n != b->dim )
		error(E_SIZES,"LUsolve");

	x = v_resize(x,b->dim);
	px_vec(pivot,b,x);	/* x := P.b */
	Lsolve(LU,x,x,1.0);	/* implicit diagonal = 1 */
	Usolve(LU,x,x,0.0);	/* explicit diagonal */

	return (x);
}
示例#4
0
/************************************
  Given the factorization LB = U for some B, solve the problem
  Bx = vec for x
  Solve using LUMOD functions.
************************************/
void LU_Solve0(PT_Matrix pL, PT_Matrix pU, double *vec, double *x)
{
	int mode;
	ptrdiff_t n;

	n = Matrix_Rows(pL);

	/* solve using lumod */
	/* solve for Bx = vec */
	mode = 1;

	/* due to 1-based indexing in Lprod, Usolve we need to shift vectors backwards */
	/* Computes x = L*vec */
	Lprod(mode, pL->rows_alloc, n, pL->A-1, vec-1, x-1);

	/* Computes x_new s.t. U x_new = x */
	Usolve(mode, pU->rows_alloc, n, pU->A-1, x-1);
	
	/* Vector_Print_raw(x,n); */
}
示例#5
0
文件: iternsym.c 项目: Rainwin2015/C
VEC *iter_mgcr(ITER *ip)
#endif
{
    STATIC VEC *As=VNULL, *beta=VNULL, *alpha=VNULL, *z=VNULL;
    STATIC MAT *N=MNULL, *H=MNULL;

    VEC *rr, v, s;  /* additional pointer and structures */
    Real nres;      /* norm of a residual */
    Real dd;        /* coefficient d_i */
    int i,j;
    int done;      /* if TRUE then stop the iterative process */
    int dim;       /* dimension of the problem */

    /* ip cannot be NULL */
    if (ip == INULL) error(E_NULL,"mgcr");
    /* Ax, b and stopping criterion must be given */
    if (! ip->Ax || ! ip->b || ! ip->stop_crit)
        error(E_NULL,"mgcr");
    /* at least one direction vector must exist */
    if ( ip->k <= 0) error(E_BOUNDS,"mgcr");
    /* if the vector x is given then b and x must have the same dimension */
    if ( ip->x && ip->x->dim != ip->b->dim)
        error(E_SIZES,"mgcr");
    if (ip->eps <= 0.0) ip->eps = MACHEPS;

    dim = ip->b->dim;
    As = v_resize(As,dim);
    alpha = v_resize(alpha,ip->k);
    beta = v_resize(beta,ip->k);

    MEM_STAT_REG(As,TYPE_VEC);
    MEM_STAT_REG(alpha,TYPE_VEC);
    MEM_STAT_REG(beta,TYPE_VEC);

    H = m_resize(H,ip->k,ip->k);
    N = m_resize(N,ip->k,dim);

    MEM_STAT_REG(H,TYPE_MAT);
    MEM_STAT_REG(N,TYPE_MAT);

    /* if a preconditioner is defined */
    if (ip->Bx) {
        z = v_resize(z,dim);
        MEM_STAT_REG(z,TYPE_VEC);
    }

    /* if x is NULL then it is assumed that x has
       entries with value zero */
    if ( ! ip->x ) {
        ip->x = v_get(ip->b->dim);
        ip->shared_x = FALSE;
    }

    /* v and s are additional pointers to rows of N */
    /* they must have the same dimension as rows of N */
    v.dim = v.max_dim = s.dim = s.max_dim = dim;


    done = FALSE;
    for (ip->steps = 0; ip->steps < ip->limit; ) {
        (*ip->Ax)(ip->A_par,ip->x,As);         /* As = A*x */
        v_sub(ip->b,As,As);                    /* As = b - A*x */
        rr = As;                               /* rr is an additional pointer */

        /* if a preconditioner is defined */
        if (ip->Bx) {
            (*ip->Bx)(ip->B_par,As,z);               /* z = B*(b-A*x)  */
            rr = z;
        }

        /* norm of the residual */
        nres = v_norm2(rr);
        dd = nres;                            /* dd = ||r_i||  */

        /* check if the norm of the residual is zero */
        if (ip->steps == 0) {
            /* information for a user */
            if (ip->info) (*ip->info)(ip,nres,As,rr);
            ip->init_res = fabs(nres);
        }

        if (nres == 0.0) {
            /* iterative process is finished */
            done = TRUE;
            break;
        }

        /* save this residual in the first row of N */
        v.ve = N->me[0];
        v_copy(rr,&v);

        for (i = 0; i < ip->k && ip->steps < ip->limit; i++) {
            ip->steps++;
            v.ve = N->me[i];                /* pointer to a row of N (=s_i) */
            /* note that we must use here &v, not v */
            (*ip->Ax)(ip->A_par,&v,As);
            rr = As;                        /* As = A*s_i */
            if (ip->Bx) {
                (*ip->Bx)(ip->B_par,As,z);    /* z = B*A*s_i  */
                rr = z;
            }

            if (i < ip->k - 1) {
                s.ve = N->me[i+1];         /* pointer to a row of N (=s_{i+1}) */
                v_copy(rr,&s);                   /* s_{i+1} = B*A*s_i */
                for (j = 0; j <= i-1; j++) {
                    v.ve = N->me[j+1];      /* pointer to a row of N (=s_{j+1}) */
                    /* beta->ve[j] = in_prod(&v,rr); */      /* beta_{j,i} */
                    /* modified Gram-Schmidt algorithm */
                    beta->ve[j] = in_prod(&v,&s);  	         /* beta_{j,i} */
                    /* s_{i+1} -= beta_{j,i}*s_{j+1} */
                    v_mltadd(&s,&v,- beta->ve[j],&s);
                }

                /* beta_{i,i} = ||s_{i+1}||_2 */
                beta->ve[i] = nres = v_norm2(&s);
                if ( nres <= MACHEPS*ip->init_res) {
                    /* s_{i+1} == 0 */
                    i--;
                    done = TRUE;
                    break;
                }
                sv_mlt(1.0/nres,&s,&s);           /* normalize s_{i+1} */

                v.ve = N->me[0];
                alpha->ve[i] = in_prod(&v,&s);     /* alpha_i = (s_0 , s_{i+1}) */

            }
            else {
                for (j = 0; j <= i-1; j++) {
                    v.ve = N->me[j+1];      /* pointer to a row of N (=s_{j+1}) */
                    beta->ve[j] = in_prod(&v,rr);       /* beta_{j,i} */
                }

                nres = in_prod(rr,rr);                 /* rr = B*A*s_{k-1} */
                for (j = 0; j <= i-1; j++)
                    nres -= beta->ve[j]*beta->ve[j];

                if (sqrt(fabs(nres)) <= MACHEPS*ip->init_res)  {
                    /* s_k is zero */
                    i--;
                    done = TRUE;
                    break;
                }
                if (nres < 0.0) { /* do restart */
                    i--;
                    ip->steps--;
                    break;
                }
                beta->ve[i] = sqrt(nres);         /* beta_{k-1,k-1} */

                v.ve = N->me[0];
                alpha->ve[i] = in_prod(&v,rr);
                for (j = 0; j <= i-1; j++)
                    alpha->ve[i] -= beta->ve[j]*alpha->ve[j];
                alpha->ve[i] /= beta->ve[i];                /* alpha_{k-1} */

            }

            set_col(H,i,beta);

            /* other method of computing dd */
            /* if (fabs((double)alpha->ve[i]) > dd)  {
                nres = - dd*dd + alpha->ve[i]*alpha->ve[i];
                nres = sqrt((double) nres);
                if (ip->info) (*ip->info)(ip,-nres,VNULL,VNULL);
                break;
             }  */
            /* to avoid overflow/underflow in computing dd */
            /* dd *= cos(asin((double)(alpha->ve[i]/dd))); */

            nres = alpha->ve[i]/dd;
            if (fabs(nres-1.0) <= MACHEPS*ip->init_res)
                dd = 0.0;
            else {
                nres = 1.0 - nres*nres;
                if (nres < 0.0) {
                    nres = sqrt((double) -nres);
                    if (ip->info) (*ip->info)(ip,-dd*nres,VNULL,VNULL);
                    break;
                }
                dd *= sqrt((double) nres);
            }

            if (ip->info) (*ip->info)(ip,dd,VNULL,VNULL);
            if ( ip->stop_crit(ip,dd,VNULL,VNULL) ) {
                /* stopping criterion is satisfied */
                done = TRUE;
                break;
            }

        } /* end of for */

        if (i >= ip->k) i = ip->k - 1;

        /* use (i+1) by (i+1) submatrix of H */
        H = m_resize(H,i+1,i+1);
        alpha = v_resize(alpha,i+1);
        Usolve(H,alpha,alpha,0.0);       /* c_i is saved in alpha */

        for (j = 0; j <= i; j++) {
            v.ve = N->me[j];
            v_mltadd(ip->x,&v,alpha->ve[j],ip->x);
        }


        if (done) break;              /* stop the iterative process */
        alpha = v_resize(alpha,ip->k);
        H = m_resize(H,ip->k,ip->k);

    }  /* end of while */

#ifdef THREADSAFE
    V_FREE(As);
    V_FREE(beta);
    V_FREE(alpha);
    V_FREE(z);
    M_FREE(N);
    M_FREE(H);
#endif

    return ip->x;                    /* return the solution */
}
示例#6
0
文件: iternsym.c 项目: Rainwin2015/C
VEC	*iter_gmres(ITER *ip)
#endif
{
    STATIC VEC *u=VNULL, *r=VNULL, *rhs = VNULL;
    STATIC VEC *givs=VNULL, *givc=VNULL, *z = VNULL;
    STATIC MAT *Q = MNULL, *R = MNULL;
    VEC *rr, v, v1;   /* additional pointers (not real vectors) */
    int	i,j, done;
    Real	nres;
    /*   Real last_h;  */

    if (ip == INULL)
        error(E_NULL,"iter_gmres");
    if ( ! ip->Ax || ! ip->b )
        error(E_NULL,"iter_gmres");
    if ( ! ip->stop_crit )
        error(E_NULL,"iter_gmres");
    if ( ip->k <= 0 )
        error(E_BOUNDS,"iter_gmres");
    if (ip->x != VNULL && ip->x->dim != ip->b->dim)
        error(E_SIZES,"iter_gmres");
    if (ip->eps <= 0.0) ip->eps = MACHEPS;

    r = v_resize(r,ip->k+1);
    u = v_resize(u,ip->b->dim);
    rhs = v_resize(rhs,ip->k+1);
    givs = v_resize(givs,ip->k);  /* Givens rotations */
    givc = v_resize(givc,ip->k);

    MEM_STAT_REG(r,TYPE_VEC);
    MEM_STAT_REG(u,TYPE_VEC);
    MEM_STAT_REG(rhs,TYPE_VEC);
    MEM_STAT_REG(givs,TYPE_VEC);
    MEM_STAT_REG(givc,TYPE_VEC);

    R = m_resize(R,ip->k+1,ip->k);
    Q = m_resize(Q,ip->k,ip->b->dim);
    MEM_STAT_REG(R,TYPE_MAT);
    MEM_STAT_REG(Q,TYPE_MAT);

    if (ip->x == VNULL) {  /* ip->x == 0 */
        ip->x = v_get(ip->b->dim);
        ip->shared_x = FALSE;
    }

    v.dim = v.max_dim = ip->b->dim;      /* v and v1 are pointers to rows */
    v1.dim = v1.max_dim = ip->b->dim;  	/* of matrix Q */

    if (ip->Bx != (Fun_Ax)NULL) {    /* if precondition is defined */
        z = v_resize(z,ip->b->dim);
        MEM_STAT_REG(z,TYPE_VEC);
    }

    done = FALSE;
    for (ip->steps = 0; ip->steps < ip->limit; ) {

        /* restart */

        ip->Ax(ip->A_par,ip->x,u);    		/* u = A*x */
        v_sub(ip->b,u,u);		 		/* u = b - A*x */
        rr = u;				/* rr is a pointer only */

        if (ip->Bx) {
            (ip->Bx)(ip->B_par,u,z);            /* tmp = B*(b-A*x)  */
            rr = z;
        }

        nres = v_norm2(rr);
        if (ip->steps == 0) {
            if (ip->info) ip->info(ip,nres,VNULL,VNULL);
            ip->init_res = nres;
        }

        if ( nres == 0.0 ) {
            done = TRUE;
            break;
        }

        v.ve = Q->me[0];
        sv_mlt(1.0/nres,rr,&v);

        v_zero(r);
        v_zero(rhs);
        rhs->ve[0] = nres;

        for ( i = 0; i < ip->k && ip->steps < ip->limit; i++ ) {
            ip->steps++;
            v.ve = Q->me[i];
            (ip->Ax)(ip->A_par,&v,u);
            rr = u;
            if (ip->Bx) {
                (ip->Bx)(ip->B_par,u,z);
                rr = z;
            }

            if (i < ip->k - 1) {
                v1.ve = Q->me[i+1];
                v_copy(rr,&v1);
                for (j = 0; j <= i; j++) {
                    v.ve = Q->me[j];
                    /* r->ve[j] = in_prod(&v,rr); */
                    /* modified Gram-Schmidt algorithm */
                    r->ve[j] = in_prod(&v,&v1);
                    v_mltadd(&v1,&v,-r->ve[j],&v1);
                }

                r->ve[i+1] = nres = v_norm2(&v1);
                if (nres <= MACHEPS*ip->init_res) {
                    for (j = 0; j < i; j++)
                        rot_vec(r,j,j+1,givc->ve[j],givs->ve[j],r);
                    set_col(R,i,r);
                    done = TRUE;
                    break;
                }
                sv_mlt(1.0/nres,&v1,&v1);
            }
            else {  /* i == ip->k - 1 */
                /* Q->me[ip->k] need not be computed */

                for (j = 0; j <= i; j++) {
                    v.ve = Q->me[j];
                    r->ve[j] = in_prod(&v,rr);
                }

                nres = in_prod(rr,rr) - in_prod(r,r);
                if (sqrt(fabs(nres)) <= MACHEPS*ip->init_res) {
                    for (j = 0; j < i; j++)
                        rot_vec(r,j,j+1,givc->ve[j],givs->ve[j],r);
                    set_col(R,i,r);
                    done = TRUE;
                    break;
                }
                if (nres < 0.0) { /* do restart */
                    i--;
                    ip->steps--;
                    break;
                }
                r->ve[i+1] = sqrt(nres);
            }

            /* QR update */

            /* last_h = r->ve[i+1]; */ /* for test only */
            for (j = 0; j < i; j++)
                rot_vec(r,j,j+1,givc->ve[j],givs->ve[j],r);
            givens(r->ve[i],r->ve[i+1],&givc->ve[i],&givs->ve[i]);
            rot_vec(r,i,i+1,givc->ve[i],givs->ve[i],r);
            rot_vec(rhs,i,i+1,givc->ve[i],givs->ve[i],rhs);

            set_col(R,i,r);

            nres = fabs((double) rhs->ve[i+1]);
            if (ip->info) ip->info(ip,nres,VNULL,VNULL);
            if ( ip->stop_crit(ip,nres,VNULL,VNULL) ) {
                done = TRUE;
                break;
            }
        }

        /* use ixi submatrix of R */

        if (i >= ip->k) i = ip->k - 1;

        R = m_resize(R,i+1,i+1);
        rhs = v_resize(rhs,i+1);

        /* test only */
        /* test_gmres(ip,i,Q,R,givc,givs,last_h);  */

        Usolve(R,rhs,rhs,0.0); 	 /* solve a system: R*x = rhs */

        /* new approximation */

        for (j = 0; j <= i; j++) {
            v.ve = Q->me[j];
            v_mltadd(ip->x,&v,rhs->ve[j],ip->x);
        }

        if (done) break;

        /* back to old dimensions */

        rhs = v_resize(rhs,ip->k+1);
        R = m_resize(R,ip->k+1,ip->k);

    }

#ifdef THREADSAFE
    V_FREE(u);
    V_FREE(r);
    V_FREE(rhs);
    V_FREE(givs);
    V_FREE(givc);
    V_FREE(z);
    M_FREE(Q);
    M_FREE(R);
#endif

    return ip->x;
}
示例#7
0
文件: qrfactor.c 项目: Rainwin2015/C
double	QRcondest(const MAT *QR)
#endif
{
    STATIC	VEC	*y=VNULL;
    Real	norm1, norm2, sum, tmp1, tmp2;
    int		i, j, limit;

    if ( QR == MNULL )
	error(E_NULL,"QRcondest");

    limit = min(QR->m,QR->n);
    for ( i = 0; i < limit; i++ )
	if ( QR->me[i][i] == 0.0 )
	    return HUGE_VAL;

    y = v_resize(y,limit);
    MEM_STAT_REG(y,TYPE_VEC);
    /* use the trick for getting a unit vector y with ||R.y||_inf small
       from the LU condition estimator */
    for ( i = 0; i < limit; i++ )
    {
	sum = 0.0;
	for ( j = 0; j < i; j++ )
	    sum -= QR->me[j][i]*y->ve[j];
	sum -= (sum < 0.0) ? 1.0 : -1.0;
	y->ve[i] = sum / QR->me[i][i];
    }
    UTmlt(QR,y,y);

    /* now apply inverse power method to R^T.R */
    for ( i = 0; i < 3; i++ )
    {
	tmp1 = v_norm2(y);
	sv_mlt(1/tmp1,y,y);
	UTsolve(QR,y,y,0.0);
	tmp2 = v_norm2(y);
	sv_mlt(1/v_norm2(y),y,y);
	Usolve(QR,y,y,0.0);
    }
    /* now compute approximation for ||R^{-1}||_2 */
    norm1 = sqrt(tmp1)*sqrt(tmp2);

    /* now use complementary approach to compute approximation to ||R||_2 */
    for ( i = limit-1; i >= 0; i-- )
    {
	sum = 0.0;
	for ( j = i+1; j < limit; j++ )
	    sum += QR->me[i][j]*y->ve[j];
	y->ve[i] = (sum >= 0.0) ? 1.0 : -1.0;
	y->ve[i] = (QR->me[i][i] >= 0.0) ? y->ve[i] : - y->ve[i];
    }

    /* now apply power method to R^T.R */
    for ( i = 0; i < 3; i++ )
    {
	tmp1 = v_norm2(y);
	sv_mlt(1/tmp1,y,y);
	Umlt(QR,y,y);
	tmp2 = v_norm2(y);
	sv_mlt(1/tmp2,y,y);
	UTmlt(QR,y,y);
    }
    norm2 = sqrt(tmp1)*sqrt(tmp2);

    /* printf("QRcondest: norm1 = %g, norm2 = %g\n",norm1,norm2); */

#ifdef THREADSAFE
    V_FREE(y);
#endif

    return norm1*norm2;
}