Пример #1
0
static int solve_lp(glp_prob *P, const glp_smcp *parm)
{     /* solve LP directly without using the preprocessor */
      int ret;
      if (!glp_bf_exists(P))
      {  ret = glp_factorize(P);
         if (ret == 0)
            ;
         else if (ret == GLP_EBADB)
         {  if (parm->msg_lev >= GLP_MSG_ERR)
               xprintf("glp_simplex: initial basis is invalid\n");
         }
         else if (ret == GLP_ESING)
         {  if (parm->msg_lev >= GLP_MSG_ERR)
               xprintf("glp_simplex: initial basis is singular\n");
         }
         else if (ret == GLP_ECOND)
         {  if (parm->msg_lev >= GLP_MSG_ERR)
               xprintf(
                  "glp_simplex: initial basis is ill-conditioned\n");
         }
         else
            xassert(ret != ret);
         if (ret != 0) goto done;
      }
      if (parm->meth == GLP_PRIMAL)
         ret = spx_primal(P, parm);
      else if (parm->meth == GLP_DUALP)
      {  ret = spx_dual(P, parm);
         if (ret == GLP_EFAIL && P->valid)
            ret = spx_primal(P, parm);
      }
      else if (parm->meth == GLP_DUAL)
         ret = spx_dual(P, parm);
      else
         xassert(parm != parm);
done: return ret;
}
Пример #2
0
static void remove_cuts(glp_tree *T)
{     /* remove inactive cuts (some valueable globally valid cut might
         be saved in the global cut pool) */
      int i, cnt = 0, *num = NULL;
      xassert(T->curr != NULL);
      for (i = T->orig_m+1; i <= T->mip->m; i++)
      {  if (T->mip->row[i]->origin == GLP_RF_CUT &&
             T->mip->row[i]->level == T->curr->level &&
             T->mip->row[i]->stat == GLP_BS)
         {  if (num == NULL)
               num = xcalloc(1+T->mip->m, sizeof(int));
            num[++cnt] = i;
         }
      }
      if (cnt > 0)
      {  glp_del_rows(T->mip, cnt, num);
#if 0
         xprintf("%d inactive cut(s) removed\n", cnt);
#endif
         xfree(num);
         xassert(glp_factorize(T->mip) == 0);
      }
      return;
}
Пример #3
0
int lpx_print_sens_bnds(LPX *lp, const char *fname)
{     /* write bounds sensitivity information */
      if (glp_get_status(lp) == GLP_OPT && !glp_bf_exists(lp))
         glp_factorize(lp);
      return glp_print_ranges(lp, 0, NULL, 0, fname);
}
Пример #4
0
static PyObject* LPX_write(LPXObject *self, PyObject *args, PyObject *keywds)
{
	static char* kwlist[] = {"mps", "freemps", "prob", "sol", "sens_bnds",
		"ips", "mip", NULL};
	char* fnames[] = {NULL,NULL,NULL,NULL,NULL,NULL,NULL};
	char* fname;
	const char* err_msg = "writer for '%s' failed to write to '%s'";
	int rv;

	rv = PyArg_ParseTupleAndKeywords(args, keywds, "|sssssss", kwlist,
	fnames,fnames+1,fnames+2,fnames+3, fnames+4,fnames+5,fnames+6);

	if (!rv)
		return NULL;

	fname = fnames[0];
	if (fname != NULL) {
		rv = glp_write_mps(LP, GLP_MPS_DECK, NULL, fname);
		if (rv != 0) {
			PyErr_Format(PyExc_RuntimeError, err_msg, kwlist[0], fname);
			return NULL;
		}
	}

	fname = fnames[1];
	if (fname != NULL) {
		rv = glp_write_mps(LP, GLP_MPS_FILE, NULL, fname);
		if (rv != 0) {
			PyErr_Format(PyExc_RuntimeError, err_msg, kwlist[1], fname);
			return NULL;
		}
	}

	fname = fnames[2];
	if (fname != NULL) {
		rv = glp_write_lp(LP, NULL, fname);
		if (rv != 0) {
			PyErr_Format(PyExc_RuntimeError, err_msg, kwlist[2], fname);
			return NULL;
		}
	}

	fname = fnames[3];
	if (fname != NULL) {
		rv = glp_print_sol(LP, fname);
		if (rv != 0) {
			PyErr_Format(PyExc_RuntimeError, err_msg, kwlist[3], fname);
			return NULL;
		}
	}

	fname = fnames[4];
	if (fname != NULL) {
		if (glp_get_status(LP) == GLP_OPT && !glp_bf_exists(LP))
			glp_factorize(LP);
		rv = glp_print_ranges(LP, 0, NULL, 0, fname);
		if (rv != 0) {
			PyErr_Format(PyExc_RuntimeError, err_msg, kwlist[4], fname);
			return NULL;
		}
	}

	fname = fnames[5];
	if (fname != NULL) {
		rv = glp_print_ipt(LP, fname);
		if (rv != 0) {
			PyErr_Format(PyExc_RuntimeError, err_msg, kwlist[5], fname);
			return NULL;
		}
	}

	fname = fnames[6];
	if (fname != NULL) {
		glp_print_mip(LP, fname);
		if (rv != 0) {
			PyErr_Format(PyExc_RuntimeError, err_msg, kwlist[6], fname);
			return NULL;
		}
	}
	Py_RETURN_NONE;
}
Пример #5
0
int ios_driver(glp_tree *T)
{     int p, curr_p, p_stat, d_stat, ret;
#if 1 /* carry out to glp_tree */
      int pred_p = 0;
      /* if the current subproblem has been just created due to
         branching, pred_p is the reference number of its parent
         subproblem, otherwise pred_p is zero */
#endif
      glp_long ttt = T->tm_beg;
#if 0
      ((glp_iocp *)T->parm)->msg_lev = GLP_MSG_DBG;
#endif
      /* on entry to the B&B driver it is assumed that the active list
         contains the only active (i.e. root) subproblem, which is the
         original MIP problem to be solved */
loop: /* main loop starts here */
      /* at this point the current subproblem does not exist */
      xassert(T->curr == NULL);
      /* if the active list is empty, the search is finished */
      if (T->head == NULL)
      {  if (T->parm->msg_lev >= GLP_MSG_DBG)
            xprintf("Active list is empty!\n");
         xassert(dmp_in_use(T->pool).lo == 0);
         ret = 0;
         goto done;
      }
      /* select some active subproblem to continue the search */
      xassert(T->next_p == 0);
      /* let the application program select subproblem */
      if (T->parm->cb_func != NULL)
      {  xassert(T->reason == 0);
         T->reason = GLP_ISELECT;
         T->parm->cb_func(T, T->parm->cb_info);
         T->reason = 0;
         if (T->stop)
         {  ret = GLP_ESTOP;
            goto done;
         }
      }
      if (T->next_p != 0)
      {  /* the application program has selected something */
         ;
      }
      else if (T->a_cnt == 1)
      {  /* the only active subproblem exists, so select it */
         xassert(T->head->next == NULL);
         T->next_p = T->head->p;
      }
      else if (T->child != 0)
      {  /* select one of branching childs suggested by the branching
            heuristic */
         T->next_p = T->child;
      }
      else
      {  /* select active subproblem as specified by the backtracking
            technique option */
         T->next_p = ios_choose_node(T);
      }
      /* the active subproblem just selected becomes current */
      ios_revive_node(T, T->next_p);
      T->next_p = T->child = 0;
      /* invalidate pred_p, if it is not the reference number of the
         parent of the current subproblem */
      if (T->curr->up != NULL && T->curr->up->p != pred_p) pred_p = 0;
      /* determine the reference number of the current subproblem */
      p = T->curr->p;
      if (T->parm->msg_lev >= GLP_MSG_DBG)
      {  xprintf("-----------------------------------------------------"
            "-------------------\n");
         xprintf("Processing node %d at level %d\n", p, T->curr->level);
      }
      /* if it is the root subproblem, initialize cut generators */
      if (p == 1)
      {  if (T->parm->gmi_cuts == GLP_ON)
         {  if (T->parm->msg_lev >= GLP_MSG_ALL)
               xprintf("Gomory's cuts enabled\n");
         }
         if (T->parm->mir_cuts == GLP_ON)
         {  if (T->parm->msg_lev >= GLP_MSG_ALL)
               xprintf("MIR cuts enabled\n");
            xassert(T->mir_gen == NULL);
            T->mir_gen = ios_mir_init(T);
         }
         if (T->parm->cov_cuts == GLP_ON)
         {  if (T->parm->msg_lev >= GLP_MSG_ALL)
               xprintf("Cover cuts enabled\n");
         }
         if (T->parm->clq_cuts == GLP_ON)
         {  xassert(T->clq_gen == NULL);
            if (T->parm->msg_lev >= GLP_MSG_ALL)
               xprintf("Clique cuts enabled\n");
            T->clq_gen = ios_clq_init(T);
         }
      }
more: /* minor loop starts here */
      /* at this point the current subproblem needs either to be solved
         for the first time or re-optimized due to reformulation */
      /* display current progress of the search */
      if (T->parm->msg_lev >= GLP_MSG_DBG ||
          T->parm->msg_lev >= GLP_MSG_ON &&
        (double)(T->parm->out_frq - 1) <=
            1000.0 * xdifftime(xtime(), T->tm_lag))
         show_progress(T, 0);
      if (T->parm->msg_lev >= GLP_MSG_ALL &&
            xdifftime(xtime(), ttt) >= 60.0)
#if 0 /* 16/II-2012 */
      {  glp_long total;
         glp_mem_usage(NULL, NULL, &total, NULL);
         xprintf("Time used: %.1f secs.  Memory used: %.1f Mb.\n",
            xdifftime(xtime(), T->tm_beg), xltod(total) / 1048576.0);
         ttt = xtime();
      }
#else
      {  size_t total;
         glp_mem_usage(NULL, NULL, &total, NULL);
         xprintf("Time used: %.1f secs.  Memory used: %.1f Mb.\n",
            xdifftime(xtime(), T->tm_beg), (double)total / 1048576.0);
         ttt = xtime();
      }
#endif
      /* check the mip gap */
      if (T->parm->mip_gap > 0.0 &&
          ios_relative_gap(T) <= T->parm->mip_gap)
      {  if (T->parm->msg_lev >= GLP_MSG_DBG)
            xprintf("Relative gap tolerance reached; search terminated "
               "\n");
         ret = GLP_EMIPGAP;
         goto done;
      }
      /* check if the time limit has been exhausted */
      if (T->parm->tm_lim < INT_MAX &&
         (double)(T->parm->tm_lim - 1) <=
         1000.0 * xdifftime(xtime(), T->tm_beg))
      {  if (T->parm->msg_lev >= GLP_MSG_DBG)
            xprintf("Time limit exhausted; search terminated\n");
         ret = GLP_ETMLIM;
         goto done;
      }
      /* let the application program preprocess the subproblem */
      if (T->parm->cb_func != NULL)
      {  xassert(T->reason == 0);
         T->reason = GLP_IPREPRO;
         T->parm->cb_func(T, T->parm->cb_info);
         T->reason = 0;
         if (T->stop)
         {  ret = GLP_ESTOP;
            goto done;
         }
      }
      /* perform basic preprocessing */
      if (T->parm->pp_tech == GLP_PP_NONE)
         ;
      else if (T->parm->pp_tech == GLP_PP_ROOT)
      {  if (T->curr->level == 0)
         {  if (ios_preprocess_node(T, 100))
               goto fath;
         }
      }
      else if (T->parm->pp_tech == GLP_PP_ALL)
      {  if (ios_preprocess_node(T, T->curr->level == 0 ? 100 : 10))
            goto fath;
      }
      else
         xassert(T != T);
      /* preprocessing may improve the global bound */
      if (!is_branch_hopeful(T, p))
      {  xprintf("*** not tested yet ***\n");
         goto fath;
      }
      /* solve LP relaxation of the current subproblem */
      if (T->parm->msg_lev >= GLP_MSG_DBG)
         xprintf("Solving LP relaxation...\n");
      ret = ios_solve_node(T);
      if (!(ret == 0 || ret == GLP_EOBJLL || ret == GLP_EOBJUL))
      {  if (T->parm->msg_lev >= GLP_MSG_ERR)
            xprintf("ios_driver: unable to solve current LP relaxation;"
               " glp_simplex returned %d\n", ret);
         ret = GLP_EFAIL;
         goto done;
      }
      /* analyze status of the basic solution to LP relaxation found */
      p_stat = T->mip->pbs_stat;
      d_stat = T->mip->dbs_stat;
      if (p_stat == GLP_FEAS && d_stat == GLP_FEAS)
      {  /* LP relaxation has optimal solution */
         if (T->parm->msg_lev >= GLP_MSG_DBG)
            xprintf("Found optimal solution to LP relaxation\n");
      }
      else if (d_stat == GLP_NOFEAS)
      {  /* LP relaxation has no dual feasible solution */
         /* since the current subproblem cannot have a larger feasible
            region than its parent, there is something wrong */
         if (T->parm->msg_lev >= GLP_MSG_ERR)
            xprintf("ios_driver: current LP relaxation has no dual feas"
               "ible solution\n");
         ret = GLP_EFAIL;
         goto done;
      }
      else if (p_stat == GLP_INFEAS && d_stat == GLP_FEAS)
      {  /* LP relaxation has no primal solution which is better than
            the incumbent objective value */
         xassert(T->mip->mip_stat == GLP_FEAS);
         if (T->parm->msg_lev >= GLP_MSG_DBG)
            xprintf("LP relaxation has no solution better than incumben"
               "t objective value\n");
         /* prune the branch */
         goto fath;
      }
      else if (p_stat == GLP_NOFEAS)
      {  /* LP relaxation has no primal feasible solution */
         if (T->parm->msg_lev >= GLP_MSG_DBG)
            xprintf("LP relaxation has no feasible solution\n");
         /* prune the branch */
         goto fath;
      }
      else
      {  /* other cases cannot appear */
         xassert(T->mip != T->mip);
      }
      /* at this point basic solution to LP relaxation of the current
         subproblem is optimal */
      xassert(p_stat == GLP_FEAS && d_stat == GLP_FEAS);
      xassert(T->curr != NULL);
      T->curr->lp_obj = T->mip->obj_val;
      /* thus, it defines a local bound to integer optimal solution of
         the current subproblem */
      {  double bound = T->mip->obj_val;
         /* some local bound to the current subproblem could be already
            set before, so we should only improve it */
         bound = ios_round_bound(T, bound);
         if (T->mip->dir == GLP_MIN)
         {  if (T->curr->bound < bound)
               T->curr->bound = bound;
         }
         else if (T->mip->dir == GLP_MAX)
         {  if (T->curr->bound > bound)
               T->curr->bound = bound;
         }
         else
            xassert(T->mip != T->mip);
         if (T->parm->msg_lev >= GLP_MSG_DBG)
            xprintf("Local bound is %.9e\n", bound);
      }
      /* if the local bound indicates that integer optimal solution of
         the current subproblem cannot be better than the global bound,
         prune the branch */
      if (!is_branch_hopeful(T, p))
      {  if (T->parm->msg_lev >= GLP_MSG_DBG)
            xprintf("Current branch is hopeless and can be pruned\n");
         goto fath;
      }
      /* let the application program generate additional rows ("lazy"
         constraints) */
      xassert(T->reopt == 0);
      xassert(T->reinv == 0);
      if (T->parm->cb_func != NULL)
      {  xassert(T->reason == 0);
         T->reason = GLP_IROWGEN;
         T->parm->cb_func(T, T->parm->cb_info);
         T->reason = 0;
         if (T->stop)
         {  ret = GLP_ESTOP;
            goto done;
         }
         if (T->reopt)
         {  /* some rows were added; re-optimization is needed */
            T->reopt = T->reinv = 0;
            goto more;
         }
         if (T->reinv)
         {  /* no rows were added, however, some inactive rows were
               removed */
            T->reinv = 0;
            xassert(glp_factorize(T->mip) == 0);
         }
      }
      /* check if the basic solution is integer feasible */
      check_integrality(T);
      /* if the basic solution satisfies to all integrality conditions,
         it is a new, better integer feasible solution */
      if (T->curr->ii_cnt == 0)
      {  if (T->parm->msg_lev >= GLP_MSG_DBG)
            xprintf("New integer feasible solution found\n");
         if (T->parm->msg_lev >= GLP_MSG_ALL)
            display_cut_info(T);
         record_solution(T);
         if (T->parm->msg_lev >= GLP_MSG_ON)
            show_progress(T, 1);
         /* make the application program happy */
         if (T->parm->cb_func != NULL)
         {  xassert(T->reason == 0);
            T->reason = GLP_IBINGO;
            T->parm->cb_func(T, T->parm->cb_info);
            T->reason = 0;
            if (T->stop)
            {  ret = GLP_ESTOP;
               goto done;
            }
         }
         /* since the current subproblem has been fathomed, prune its
            branch */
         goto fath;
      }
      /* at this point basic solution to LP relaxation of the current
         subproblem is optimal, but integer infeasible */
      /* try to fix some non-basic structural variables of integer kind
         on their current bounds due to reduced costs */
      if (T->mip->mip_stat == GLP_FEAS)
         fix_by_red_cost(T);
      /* let the application program try to find some solution to the
         original MIP with a primal heuristic */
      if (T->parm->cb_func != NULL)
      {  xassert(T->reason == 0);
         T->reason = GLP_IHEUR;
         T->parm->cb_func(T, T->parm->cb_info);
         T->reason = 0;
         if (T->stop)
         {  ret = GLP_ESTOP;
            goto done;
         }
         /* check if the current branch became hopeless */
         if (!is_branch_hopeful(T, p))
         {  if (T->parm->msg_lev >= GLP_MSG_DBG)
               xprintf("Current branch became hopeless and can be prune"
                  "d\n");
            goto fath;
         }
      }
      /* try to find solution with the feasibility pump heuristic */
      if (T->parm->fp_heur)
      {  xassert(T->reason == 0);
         T->reason = GLP_IHEUR;
         ios_feas_pump(T);
         T->reason = 0;
         /* check if the current branch became hopeless */
         if (!is_branch_hopeful(T, p))
         {  if (T->parm->msg_lev >= GLP_MSG_DBG)
               xprintf("Current branch became hopeless and can be prune"
                  "d\n");
            goto fath;
         }
      }
      /* it's time to generate cutting planes */
      xassert(T->local != NULL);
      xassert(T->local->size == 0);
      /* let the application program generate some cuts; note that it
         can add cuts either to the local cut pool or directly to the
         current subproblem */
      if (T->parm->cb_func != NULL)
      {  xassert(T->reason == 0);
         T->reason = GLP_ICUTGEN;
         T->parm->cb_func(T, T->parm->cb_info);
         T->reason = 0;
         if (T->stop)
         {  ret = GLP_ESTOP;
            goto done;
         }
      }
      /* try to generate generic cuts with built-in generators
         (as suggested by Matteo Fischetti et al. the built-in cuts
         are not generated at each branching node; an intense attempt
         of generating new cuts is only made at the root node, and then
         a moderate effort is spent after each backtracking step) */
      if (T->curr->level == 0 || pred_p == 0)
      {  xassert(T->reason == 0);
         T->reason = GLP_ICUTGEN;
         generate_cuts(T);
         T->reason = 0;
      }
      /* if the local cut pool is not empty, select useful cuts and add
         them to the current subproblem */
      if (T->local->size > 0)
      {  xassert(T->reason == 0);
         T->reason = GLP_ICUTGEN;
         ios_process_cuts(T);
         T->reason = 0;
      }
      /* clear the local cut pool */
      ios_clear_pool(T, T->local);
      /* perform re-optimization, if necessary */
      if (T->reopt)
      {  T->reopt = 0;
         T->curr->changed++;
         goto more;
      }
      /* no cuts were generated; remove inactive cuts */
      remove_cuts(T);
      if (T->parm->msg_lev >= GLP_MSG_ALL && T->curr->level == 0)
         display_cut_info(T);
      /* update history information used on pseudocost branching */
      if (T->pcost != NULL) ios_pcost_update(T);
      /* it's time to perform branching */
      xassert(T->br_var == 0);
      xassert(T->br_sel == 0);
      /* let the application program choose variable to branch on */
      if (T->parm->cb_func != NULL)
      {  xassert(T->reason == 0);
         xassert(T->br_var == 0);
         xassert(T->br_sel == 0);
         T->reason = GLP_IBRANCH;
         T->parm->cb_func(T, T->parm->cb_info);
         T->reason = 0;
         if (T->stop)
         {  ret = GLP_ESTOP;
            goto done;
         }
      }
      /* if nothing has been chosen, choose some variable as specified
         by the branching technique option */
      if (T->br_var == 0)
         T->br_var = ios_choose_var(T, &T->br_sel);
      /* perform actual branching */
      curr_p = T->curr->p;
      ret = branch_on(T, T->br_var, T->br_sel);
      T->br_var = T->br_sel = 0;
      if (ret == 0)
      {  /* both branches have been created */
         pred_p = curr_p;
         goto loop;
      }
      else if (ret == 1)
      {  /* one branch is hopeless and has been pruned, so now the
            current subproblem is other branch */
         /* the current subproblem should be considered as a new one,
            since one bound of the branching variable was changed */
         T->curr->solved = T->curr->changed = 0;
         goto more;
      }
      else if (ret == 2)
      {  /* both branches are hopeless and have been pruned; new
            subproblem selection is needed to continue the search */
         goto fath;
      }
      else
         xassert(ret != ret);
fath: /* the current subproblem has been fathomed */
      if (T->parm->msg_lev >= GLP_MSG_DBG)
         xprintf("Node %d fathomed\n", p);
      /* freeze the current subproblem */
      ios_freeze_node(T);
      /* and prune the corresponding branch of the tree */
      ios_delete_node(T, p);
      /* if a new integer feasible solution has just been found, other
         branches may become hopeless and therefore must be pruned */
      if (T->mip->mip_stat == GLP_FEAS) cleanup_the_tree(T);
      /* new subproblem selection is needed due to backtracking */
      pred_p = 0;
      goto loop;
done: /* display progress of the search on exit from the solver */
      if (T->parm->msg_lev >= GLP_MSG_ON)
         show_progress(T, 0);
      if (T->mir_gen != NULL)
         ios_mir_term(T->mir_gen), T->mir_gen = NULL;
      if (T->clq_gen != NULL)
         ios_clq_term(T->clq_gen), T->clq_gen = NULL;
      /* return to the calling program */
      return ret;
}
Пример #6
0
int lpx_warm_up(LPX *lp)
{     int m, n, j, k, ret, type, stat, p_stat, d_stat;
      double lb, ub, prim, dual, tol_bnd, tol_dj, dir;
      double *row_prim, *row_dual, *col_prim, *col_dual, sum;
      m = lpx_get_num_rows(lp);
      n = lpx_get_num_cols(lp);
      /* reinvert the basis matrix, if necessary */
      if (lpx_is_b_avail(lp))
         ret = LPX_E_OK;
      else
      {  if (m == 0 || n == 0)
         {  ret = LPX_E_EMPTY;
            goto done;
         }
#if 0
         ret = lpx_invert(lp);
         switch (ret)
         {  case 0:
               ret = LPX_E_OK;
               break;
            case 1:
            case 2:
               ret = LPX_E_SING;
               goto done;
            case 3:
               ret = LPX_E_BADB;
               goto done;
            default:
               xassert(ret != ret);
         }
#else
         switch (glp_factorize(lp))
         {  case 0:
               ret = LPX_E_OK;
               break;
            case GLP_EBADB:
               ret = LPX_E_BADB;
               goto done;
            case GLP_ESING:
            case GLP_ECOND:
               ret = LPX_E_SING;
               goto done;
            default:
               xassert(lp != lp);
         }
#endif
      }
      /* allocate working arrays */
      row_prim = xcalloc(1+m, sizeof(double));
      row_dual = xcalloc(1+m, sizeof(double));
      col_prim = xcalloc(1+n, sizeof(double));
      col_dual = xcalloc(1+n, sizeof(double));
      /* compute primal basic solution components */
      lpx_eval_b_prim(lp, row_prim, col_prim);
      /* determine primal status of basic solution */
      tol_bnd = 3.0 * lpx_get_real_parm(lp, LPX_K_TOLBND);
      p_stat = LPX_P_FEAS;
      for (k = 1; k <= m+n; k++)
      {  if (k <= m)
         {  type = lpx_get_row_type(lp, k);
            lb = lpx_get_row_lb(lp, k);
            ub = lpx_get_row_ub(lp, k);
            prim = row_prim[k];
         }
         else
         {  type = lpx_get_col_type(lp, k-m);
            lb = lpx_get_col_lb(lp, k-m);
            ub = lpx_get_col_ub(lp, k-m);
            prim = col_prim[k-m];
         }
         if (type == LPX_LO || type == LPX_DB || type == LPX_FX)
         {  /* variable x[k] has lower bound */
            if (prim < lb - tol_bnd * (1.0 + fabs(lb)))
            {  p_stat = LPX_P_INFEAS;
               break;
            }
         }
         if (type == LPX_UP || type == LPX_DB || type == LPX_FX)
         {  /* variable x[k] has upper bound */
            if (prim > ub + tol_bnd * (1.0 + fabs(ub)))
            {  p_stat = LPX_P_INFEAS;
               break;
            }
         }
      }
      /* compute dual basic solution components */
      lpx_eval_b_dual(lp, row_dual, col_dual);
      /* determine dual status of basic solution */
      tol_dj = 3.0 * lpx_get_real_parm(lp, LPX_K_TOLDJ);
      dir = (lpx_get_obj_dir(lp) == LPX_MIN ? +1.0 : -1.0);
      d_stat = LPX_D_FEAS;
      for (k = 1; k <= m+n; k++)
      {  if (k <= m)
         {  stat = lpx_get_row_stat(lp, k);
            dual = row_dual[k];
         }
         else
         {  stat = lpx_get_col_stat(lp, k-m);
            dual = col_dual[k-m];
         }
         if (stat == LPX_BS || stat == LPX_NL || stat == LPX_NF)
         {  /* reduced cost of x[k] must be non-negative (minimization)
               or non-positive (maximization) */
            if (dir * dual < - tol_dj)
            {  d_stat = LPX_D_INFEAS;
               break;
            }
         }
         if (stat == LPX_BS || stat == LPX_NU || stat == LPX_NF)
         {  /* reduced cost of x[k] must be non-positive (minimization)
               or non-negative (maximization) */
            if (dir * dual > + tol_dj)
            {  d_stat = LPX_D_INFEAS;
               break;
            }
         }
      }
      /* store basic solution components */
      p_stat = p_stat - LPX_P_UNDEF + GLP_UNDEF;
      d_stat = d_stat - LPX_D_UNDEF + GLP_UNDEF;
      sum = lpx_get_obj_coef(lp, 0);
      for (j = 1; j <= n; j++)
         sum += lpx_get_obj_coef(lp, j) * col_prim[j];
      glp_put_solution(lp, 0, &p_stat, &d_stat, &sum,
         NULL, row_prim, row_dual, NULL, col_prim, col_dual);
      xassert(lpx_is_b_avail(lp));
      /* free working arrays */
      xfree(row_prim);
      xfree(row_dual);
      xfree(col_prim);
      xfree(col_dual);
done: /* return to the calling program */
      return ret;
}