void bfd_ftran(BFD *bfd, double x[])
{ if (!bfd->valid)
xfault("bfd_ftran: the factorization is not valid\n");
if (bfd->fhv != NULL)
fhv_ftran(bfd->fhv, x);
else if (bfd->lpf != NULL)
lpf_ftran(bfd->lpf, x);
else
xassert(bfd != bfd);
return;
}
int bfd_factorize(BFD *bfd, int m, const int bh[], int (*col)
(void *info, int j, int ind[], double val[]), void *info)
#if 0 /* 06/VI-2013 */
{ LUF *luf;
#else
{
#endif
int nov, ret;
xassert(bfd != NULL);
xassert(1 <= m && m <= M_MAX);
/* invalidate the factorization */
bfd->valid = 0;
/* create the factorization, if necessary */
nov = 0;
switch (bfd->type)
{ case GLP_BF_FT:
if (bfd->lpf != NULL)
lpf_delete_it(bfd->lpf), bfd->lpf = NULL;
#if 0 /* 27/IV-2013 */
if (bfd->fhv == NULL)
bfd->fhv = fhv_create_it(), nov = 1;
#else
if (bfd->fi == NULL)
bfd->fi = fhvint_create(), nov = 1;
#endif
break;
case GLP_BF_BG:
case GLP_BF_GR:
#if 0 /* 27/IV-2013 */
if (bfd->fhv != NULL)
fhv_delete_it(bfd->fhv), bfd->fhv = NULL;
#else
if (bfd->fi != NULL)
fhvint_delete(bfd->fi), bfd->fi = NULL;
#endif
if (bfd->lpf == NULL)
bfd->lpf = lpf_create_it(), nov = 1;
break;
default:
xassert(bfd != bfd);
}
#if 0 /* 06/VI-2013 */
/* set control parameters specific to LUF */
#if 0 /* 27/IV-2013 */
if (bfd->fhv != NULL)
luf = bfd->fhv->luf;
#else
if (bfd->fi != NULL)
goto skip;
#endif
else if (bfd->lpf != NULL)
luf = bfd->lpf->luf;
else
xassert(bfd != bfd);
if (nov) luf->new_sva = bfd->lu_size;
luf->piv_tol = bfd->piv_tol;
luf->piv_lim = bfd->piv_lim;
luf->suhl = bfd->suhl;
luf->eps_tol = bfd->eps_tol;
luf->max_gro = bfd->max_gro;
#endif
#if 0 /* 27/IV-2013 */
/* set control parameters specific to FHV */
if (bfd->fhv != NULL)
{ if (nov) bfd->fhv->hh_max = bfd->nfs_max;
bfd->fhv->upd_tol = bfd->upd_tol;
}
#endif
/* set control parameters specific to LPF */
if (bfd->lpf != NULL)
{ if (nov) bfd->lpf->n_max = bfd->nrs_max;
if (nov) bfd->lpf->v_size = bfd->rs_size;
}
#if 0 /* 27/IV-2013 */
/* try to factorize the basis matrix */
if (bfd->fhv != NULL)
{ switch (fhv_factorize(bfd->fhv, m, col, info))
{ case 0:
break;
case FHV_ESING:
ret = BFD_ESING;
goto done;
case FHV_ECOND:
ret = BFD_ECOND;
goto done;
default:
xassert(bfd != bfd);
}
}
#else
skip: /* try to factorize the basis matrix */
if (bfd->fi != NULL)
{ /* FIXME */
if (fhvint_factorize(bfd->fi, m, col, info) != 0)
{ ret = BFD_ESING;
goto done;
}
/* printf("*** FACTORIZED; m = %d ***\n", m); */
}
#endif
else if (bfd->lpf != NULL)
{ switch (lpf_factorize(bfd->lpf, m, bh, col, info))
{ case 0:
/* set the Schur complement update type */
switch (bfd->type)
{ case GLP_BF_BG:
/* Bartels-Golub update */
bfd->lpf->scf->t_opt = SCF_TBG;
break;
case GLP_BF_GR:
/* Givens rotation update */
bfd->lpf->scf->t_opt = SCF_TGR;
break;
default:
xassert(bfd != bfd);
}
break;
case LPF_ESING:
ret = BFD_ESING;
goto done;
case LPF_ECOND:
ret = BFD_ECOND;
goto done;
default:
xassert(bfd != bfd);
}
}
else
xassert(bfd != bfd);
/* the basis matrix has been successfully factorized */
bfd->valid = 1;
bfd->upd_cnt = 0;
ret = 0;
done: /* return to the calling program */
return ret;
}
/***********************************************************************
* NAME
*
* bfd_ftran - perform forward transformation (solve system B*x = b)
*
* SYNOPSIS
*
* #include "glpbfd.h"
* void bfd_ftran(BFD *bfd, double x[]);
*
* DESCRIPTION
*
* The routine bfd_ftran performs forward transformation, i.e. solves
* the system B*x = b, where B is the basis matrix, x is the vector of
* unknowns to be computed, b is the vector of right-hand sides.
*
* On entry elements of the vector b should be stored in dense format
* in locations x[1], ..., x[m], where m is the number of rows. On exit
* the routine stores elements of the vector x in the same locations. */
void bfd_ftran(BFD *bfd, double x[])
{ xassert(bfd != NULL);
xassert(bfd->valid);
#if 0 /* 27/IV-2013 */
if (bfd->fhv != NULL)
fhv_ftran(bfd->fhv, x);
#else
if (bfd->fi != NULL)
fhvint_ftran(bfd->fi, x);
#endif
else if (bfd->lpf != NULL)
lpf_ftran(bfd->lpf, x);
else
xassert(bfd != bfd);
return;
}
