199 lines
4.6 KiB
C
199 lines
4.6 KiB
C
/* simplx.f -- translated by f2c (version 20031025).
|
|
You must link the resulting object file with libf2c:
|
|
on Microsoft Windows system, link with libf2c.lib;
|
|
on Linux or Unix systems, link with .../path/to/libf2c.a -lm
|
|
or, if you install libf2c.a in a standard place, with -lf2c -lm
|
|
-- in that order, at the end of the command line, as in
|
|
cc *.o -lf2c -lm
|
|
Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
|
|
|
|
http://www.netlib.org/f2c/libf2c.zip
|
|
*/
|
|
|
|
#ifdef __cplusplus
|
|
extern "C" {
|
|
#endif
|
|
#include "f2c.h"
|
|
#include <stdio.h>
|
|
|
|
/* Table of constant values */
|
|
|
|
static integer c__0 = 0;
|
|
static integer c__1 = 1;
|
|
|
|
/* Subroutine */ int simplx_(doublereal *a, integer *m, integer *n, integer *
|
|
mp, integer *np, integer *m1, integer *m2, integer *m3, integer *
|
|
icase, integer *izrov, integer *iposv)
|
|
{
|
|
/* System generated locals */
|
|
integer a_dim1, a_offset, i__1, i__2;
|
|
|
|
/* Builtin functions */
|
|
/* Subroutine */ int s_paus(char *, ftnlen);
|
|
|
|
/* Local variables */
|
|
static integer i__, k, l1[1000], l2[1000], l3[1000];
|
|
static doublereal q1;
|
|
static integer m12, kh, ip, ir, kp, is, nl1, nl2;
|
|
static doublereal bmax;
|
|
extern /* Subroutine */ int simp1_(doublereal *, integer *, integer *,
|
|
integer *, integer *, integer *, integer *, integer *, doublereal
|
|
*), simp2_(doublereal *, integer *, integer *, integer *, integer
|
|
*, integer *, integer *, integer *, integer *, doublereal *),
|
|
simp3_(doublereal *, integer *, integer *, integer *, integer *,
|
|
integer *, integer *);
|
|
|
|
/* Parameter adjustments */
|
|
--iposv;
|
|
--izrov;
|
|
a_dim1 = *mp;
|
|
a_offset = 1 + a_dim1;
|
|
a -= a_offset;
|
|
|
|
/* Function Body */
|
|
if (*m != *m1 + *m2 + *m3) {
|
|
printf(" %d %d %d %d ", *m, *m1, *m2, *m3);
|
|
s_paus("Bad input constraint counts.", (ftnlen)28);
|
|
}
|
|
nl1 = *n;
|
|
i__1 = *n;
|
|
for (k = 1; k <= i__1; ++k) {
|
|
l1[k - 1] = k;
|
|
izrov[k] = k;
|
|
/* L11: */
|
|
}
|
|
nl2 = *m;
|
|
i__1 = *m;
|
|
for (i__ = 1; i__ <= i__1; ++i__) {
|
|
if (a[i__ + 1 + a_dim1] < 0.) {
|
|
/* write(*,*) 'The A matrix input to SIMPLX is invalid.' */
|
|
s_paus("Bad input tableau.", (ftnlen)18);
|
|
}
|
|
l2[i__ - 1] = i__;
|
|
iposv[i__] = *n + i__;
|
|
/* L12: */
|
|
}
|
|
i__1 = *m2;
|
|
for (i__ = 1; i__ <= i__1; ++i__) {
|
|
l3[i__ - 1] = 1;
|
|
/* L13: */
|
|
}
|
|
ir = 0;
|
|
if (*m2 + *m3 == 0) {
|
|
goto L30;
|
|
}
|
|
ir = 1;
|
|
i__1 = *n + 1;
|
|
for (k = 1; k <= i__1; ++k) {
|
|
q1 = (float)0.;
|
|
i__2 = *m;
|
|
for (i__ = *m1 + 1; i__ <= i__2; ++i__) {
|
|
q1 += a[i__ + 1 + k * a_dim1];
|
|
/* L14: */
|
|
}
|
|
a[*m + 2 + k * a_dim1] = -q1;
|
|
/* L15: */
|
|
}
|
|
L10:
|
|
i__1 = *m + 1;
|
|
simp1_(&a[a_offset], mp, np, &i__1, l1, &nl1, &c__0, &kp, &bmax);
|
|
if (bmax <= 1e-6 && a[*m + 2 + a_dim1] < -1e-6) {
|
|
*icase = -1;
|
|
return 0;
|
|
} else if (bmax <= 1e-6 && a[*m + 2 + a_dim1] <= 1e-6) {
|
|
m12 = *m1 + *m2 + 1;
|
|
if (m12 <= *m) {
|
|
i__1 = *m;
|
|
for (ip = m12; ip <= i__1; ++ip) {
|
|
if (iposv[ip] == ip + *n) {
|
|
simp1_(&a[a_offset], mp, np, &ip, l1, &nl1, &c__1, &kp, &
|
|
bmax);
|
|
if (bmax > (float)0.) {
|
|
goto L1;
|
|
}
|
|
}
|
|
/* L16: */
|
|
}
|
|
}
|
|
ir = 0;
|
|
--m12;
|
|
if (*m1 + 1 > m12) {
|
|
goto L30;
|
|
}
|
|
i__1 = m12;
|
|
for (i__ = *m1 + 1; i__ <= i__1; ++i__) {
|
|
if (l3[i__ - *m1 - 1] == 1) {
|
|
i__2 = *n + 1;
|
|
for (k = 1; k <= i__2; ++k) {
|
|
a[i__ + 1 + k * a_dim1] = -a[i__ + 1 + k * a_dim1];
|
|
/* L17: */
|
|
}
|
|
}
|
|
/* L18: */
|
|
}
|
|
goto L30;
|
|
}
|
|
simp2_(&a[a_offset], m, n, mp, np, l2, &nl2, &ip, &kp, &q1);
|
|
if (ip == 0) {
|
|
*icase = -1;
|
|
return 0;
|
|
}
|
|
L1:
|
|
i__1 = *m + 1;
|
|
simp3_(&a[a_offset], mp, np, &i__1, n, &ip, &kp);
|
|
if (iposv[ip] >= *n + *m1 + *m2 + 1) {
|
|
i__1 = nl1;
|
|
for (k = 1; k <= i__1; ++k) {
|
|
if (l1[k - 1] == kp) {
|
|
goto L2;
|
|
}
|
|
/* L19: */
|
|
}
|
|
L2:
|
|
--nl1;
|
|
i__1 = nl1;
|
|
for (is = k; is <= i__1; ++is) {
|
|
l1[is - 1] = l1[is];
|
|
/* L21: */
|
|
}
|
|
} else {
|
|
if (iposv[ip] < *n + *m1 + 1) {
|
|
goto L20;
|
|
}
|
|
kh = iposv[ip] - *m1 - *n;
|
|
if (l3[kh - 1] == 0) {
|
|
goto L20;
|
|
}
|
|
l3[kh - 1] = 0;
|
|
}
|
|
a[*m + 2 + (kp + 1) * a_dim1] += (float)1.;
|
|
i__1 = *m + 2;
|
|
for (i__ = 1; i__ <= i__1; ++i__) {
|
|
a[i__ + (kp + 1) * a_dim1] = -a[i__ + (kp + 1) * a_dim1];
|
|
/* L22: */
|
|
}
|
|
L20:
|
|
is = izrov[kp];
|
|
izrov[kp] = iposv[ip];
|
|
iposv[ip] = is;
|
|
if (ir != 0) {
|
|
goto L10;
|
|
}
|
|
L30:
|
|
simp1_(&a[a_offset], mp, np, &c__0, l1, &nl1, &c__0, &kp, &bmax);
|
|
if (bmax <= (float)0.) {
|
|
*icase = 0;
|
|
return 0;
|
|
}
|
|
simp2_(&a[a_offset], m, n, mp, np, l2, &nl2, &ip, &kp, &q1);
|
|
if (ip == 0) {
|
|
*icase = 1;
|
|
return 0;
|
|
}
|
|
simp3_(&a[a_offset], mp, np, m, n, &ip, &kp);
|
|
goto L20;
|
|
} /* simplx_ */
|
|
|
|
#ifdef __cplusplus
|
|
}
|
|
#endif
|