COPASI API  4.16.103
Macros | Functions | Variables
CTruncatedNewton.cpp File Reference
#include <cmath>
#include "copasi.h"
#include "CTruncatedNewton.h"
#include "lapack/blaswrap.h"
#include "lapack/lapackwrap.h"
Include dependency graph for CTruncatedNewton.cpp:

Go to the source code of this file.

Macros

#define FALSE_   (0)
 
#define subscr_1   (mpsubscr_->_1)
 
#define subscr_2   (mpsubscr_->_2)
 
#define subscr_3   (mpsubscr_->_3)
 
#define TRUE_   (1)
 

Functions

int chkucp_ (C_INT *, C_INT *, C_INT *, C_INT *, C_FLOAT64 *, C_FLOAT64 *, C_FLOAT64 *, C_FLOAT64 *, C_FLOAT64 *, C_FLOAT64 *, C_FLOAT64 *, C_FLOAT64 *, C_FLOAT64 *, C_FLOAT64 *, C_FLOAT64 *, C_FLOAT64 *, C_INT *, C_FLOAT64 *, C_FLOAT64 *, C_FLOAT64 *)
 
int cnvtst_ (C_INT *, C_FLOAT64 *, C_FLOAT64 *, C_FLOAT64 *, C_FLOAT64 *, C_FLOAT64 *, C_FLOAT64 *, C_FLOAT64 *, C_FLOAT64 *, C_FLOAT64 *, C_FLOAT64 *, C_FLOAT64 *, C_FLOAT64 *, C_FLOAT64 *, C_FLOAT64 *, C_INT *, C_INT *, C_FLOAT64 *)
 
int crash_ (C_INT *, C_FLOAT64 *, C_INT *, C_FLOAT64 *, C_FLOAT64 *, C_INT *)
 
int dxpy_ (C_INT *, C_FLOAT64 *, C_INT *, C_FLOAT64 *, C_INT *)
 
int initp3_ (C_FLOAT64 *, C_FLOAT64 *, C_INT *, C_INT *, C_FLOAT64 *, C_FLOAT64 *, C_FLOAT64 *, C_FLOAT64 *, C_FLOAT64 *, C_FLOAT64 *, C_FLOAT64 *, C_INT *, C_INT *)
 
int lsout_ (C_INT *, C_INT *, C_FLOAT64 *, C_FLOAT64 *, C_FLOAT64 *, C_FLOAT64 *, C_FLOAT64 *, C_FLOAT64 *, C_FLOAT64 *, C_FLOAT64 *, C_FLOAT64 *, C_FLOAT64 *, C_FLOAT64 *, C_FLOAT64 *, C_FLOAT64 *)
 
C_FLOAT64 mchpr1_ (void)
 
int modz_ (C_INT *, C_FLOAT64 *, C_FLOAT64 *, C_INT *, C_FLOAT64 *, C_FLOAT64 *, C_FLOAT64 *, C_FLOAT64 *, C_FLOAT64 *)
 
int monit_ (C_INT *, C_FLOAT64 *, C_FLOAT64 *, C_FLOAT64 *, C_INT *, C_INT *, C_INT *, C_INT *, C_INT *)
 
int mslv_ (C_FLOAT64 *, C_FLOAT64 *, C_INT *, C_FLOAT64 *, C_FLOAT64 *, C_FLOAT64 *, C_FLOAT64 *, C_FLOAT64 *, C_FLOAT64 *, C_FLOAT64 *, C_FLOAT64 *, C_INT *, C_FLOAT64 *, C_FLOAT64 *, C_FLOAT64 *, C_INT *, C_INT *)
 
int ndia3_ (C_INT *, C_FLOAT64 *, C_FLOAT64 *, C_FLOAT64 *, C_FLOAT64 *, C_FLOAT64 *, C_INT *)
 
int negvec_ (C_INT *, C_FLOAT64 *)
 
C_FLOAT64 pow_dd (C_FLOAT64 *ap, C_FLOAT64 *bp)
 
int ssbfgs_ (C_INT *, C_FLOAT64 *, C_FLOAT64 *, C_FLOAT64 *, C_FLOAT64 *, C_FLOAT64 *, C_FLOAT64 *, C_FLOAT64 *, C_FLOAT64 *, C_FLOAT64 *, C_FLOAT64 *)
 
C_FLOAT64 step1_ (C_FLOAT64 *fnew, C_FLOAT64 *fm, C_FLOAT64 *gtp, C_FLOAT64 *smax)
 
int stpmax_ (C_FLOAT64 *, C_FLOAT64 *, C_FLOAT64 *, C_INT *, C_FLOAT64 *, C_FLOAT64 *, C_INT *, C_FLOAT64 *, C_FLOAT64 *)
 
int ztime_ (C_INT *, C_FLOAT64 *, C_INT *)
 

Variables

static C_INT c__1 = 1
 
static C_FLOAT64 c_b246 = .6666
 
static C_INT c_false = (0)
 
static C_INT c_true = (1)
 

Macro Definition Documentation

#define FALSE_   (0)
#define subscr_1   (mpsubscr_->_1)

Definition at line 73 of file CTruncatedNewton.cpp.

Referenced by CTruncatedNewton::lmqn_(), and CTruncatedNewton::lmqnbc_().

#define subscr_2   (mpsubscr_->_2)
#define subscr_3   (mpsubscr_->_3)

Definition at line 75 of file CTruncatedNewton.cpp.

Referenced by CTruncatedNewton::setpar_().

#define TRUE_   (1)

Function Documentation

int chkucp_ ( C_INT lwtest,
C_INT maxfun,
C_INT nwhy,
C_INT n,
C_FLOAT64 alpha,
C_FLOAT64 epsmch,
C_FLOAT64 eta,
C_FLOAT64 peps,
C_FLOAT64 rteps,
C_FLOAT64 rtol,
C_FLOAT64 rtolsq,
C_FLOAT64 stepmx,
C_FLOAT64 test,
C_FLOAT64 xtol,
C_FLOAT64 xnorm,
C_FLOAT64 x,
C_INT lw,
C_FLOAT64 small,
C_FLOAT64 tiny,
C_FLOAT64 accrcy 
)

Definition at line 2191 of file CTruncatedNewton.cpp.

References c__1, c_b246, dnrm2_(), and mchpr1_().

Referenced by CTruncatedNewton::lmqn_(), and CTruncatedNewton::lmqnbc_().

2197 {
2198  /* Local variables */
2199  /* CHECKS PARAMETERS AND SETS CONSTANTS WHICH ARE COMMON TO BOTH */
2200  /* DERIVATIVE AND NON-DERIVATIVE ALGORITHMS */
2201 
2202  /* Parameter adjustments */
2203  --x;
2204 
2205  /* Function Body */
2206  *epsmch = mchpr1_();
2207  *small = *epsmch * *epsmch;
2208  *tiny = *small;
2209  *nwhy = -1;
2210  *rteps = sqrt(*epsmch);
2211  *rtol = *xtol;
2212 
2213  if (fabs(*rtol) < *accrcy)
2214  {
2215  *rtol = *rteps * 10.;
2216  }
2217 
2218  /* CHECK FOR ERRORS IN THE INPUT PARAMETERS */
2219 
2220  if (*lw < *lwtest || *n < 1 || *rtol < 0. || *eta >= 1. || *eta < 0. || *
2221  stepmx < *rtol || *maxfun < 1)
2222  {
2223  return 0;
2224  }
2225 
2226  *nwhy = 0;
2227 
2228  /* SET CONSTANTS FOR LATER */
2229 
2230  *rtolsq = *rtol * *rtol;
2231  *peps = pow(*accrcy, c_b246);
2232  *xnorm = dnrm2_(n, &x[1], &c__1);
2233  *alpha = 0.;
2234  *test = 0.;
2235  return 0;
2236 } /* chkucp_ */
static C_FLOAT64 c_b246
static C_INT c__1
doublereal dnrm2_(integer *n, doublereal *x, integer *incx)
C_FLOAT64 mchpr1_(void)
int cnvtst_ ( C_INT conv,
C_FLOAT64 alpha,
C_FLOAT64 pnorm,
C_FLOAT64 toleps,
C_FLOAT64 xnorm,
C_FLOAT64 difnew,
C_FLOAT64 rtleps,
C_FLOAT64 ftest,
C_FLOAT64 gtg,
C_FLOAT64 peps,
C_FLOAT64 ,
C_FLOAT64 gtpnew,
C_FLOAT64 fnew,
C_FLOAT64 flast,
C_FLOAT64 g,
C_INT ipivot,
C_INT n,
C_FLOAT64 accrcy 
)

Definition at line 1510 of file CTruncatedNewton.cpp.

References C_FLOAT64, C_INT, FALSE_, and TRUE_.

Referenced by CTruncatedNewton::lmqnbc_().

1516 {
1517  /* System generated locals */
1518  C_INT i__1;
1519 
1520  /* Local variables */
1521  C_FLOAT64 cmax;
1522  C_INT imax, i__;
1523  C_FLOAT64 t;
1524  C_INT ltest;
1525  C_FLOAT64 one;
1526 
1527  /* TEST FOR CONVERGENCE */
1528 
1529  /* Parameter adjustments */
1530  --ipivot;
1531  --g;
1532 
1533  /* Function Body */
1534  imax = 0;
1535  cmax = 0.;
1536  ltest = *flast - *fnew <= *gtpnew * -.5;
1537  i__1 = *n;
1538 
1539  for (i__ = 1; i__ <= i__1; ++i__)
1540  {
1541  if (ipivot[i__] == 0 || ipivot[i__] == 2)
1542  {
1543  goto L10;
1544  }
1545 
1546  t = -ipivot[i__] * g[i__];
1547 
1548  if (t >= 0.)
1549  {
1550  goto L10;
1551  }
1552 
1553  *conv = FALSE_;
1554 
1555  if (ltest)
1556  {
1557  goto L10;
1558  }
1559 
1560  if (cmax <= t)
1561  {
1562  goto L10;
1563  }
1564 
1565  cmax = t;
1566  imax = i__;
1567 L10:
1568  ;
1569  }
1570 
1571  if (imax == 0)
1572  {
1573  goto L15;
1574  }
1575 
1576  ipivot[imax] = 0;
1577  *flast = *fnew;
1578  return 0;
1579 L15:
1580  *conv = FALSE_;
1581  one = 1.;
1582 
1583  if ((*alpha * *pnorm >= *toleps * (one + *xnorm) || fabs(*difnew) >= *
1584  rtleps * *ftest || *gtg >= *peps * *ftest * *ftest) && *gtg >= *
1585  accrcy * 1e-4 * *ftest * *ftest)
1586  {
1587  return 0;
1588  }
1589 
1590  *conv = TRUE_;
1591 
1592  /* FOR DETAILS, SEE GILL, MURRAY, AND WRIGHT (1981, P. 308) AND */
1593  /* FLETCHER (1981, P. 116). THE MULTIPLIER TESTS (HERE, TESTING */
1594  /* THE SIGN OF THE COMPONENTS OF THE GRADIENT) MAY STILL NEED TO */
1595  /* MODIFIED TO INCORPORATE TOLERANCES FOR ZERO. */
1596 
1597  return 0;
1598 } /* cnvtst_ */
#define C_INT
Definition: copasi.h:115
#define TRUE_
#define C_FLOAT64
Definition: copasi.h:92
#define FALSE_
int crash_ ( C_INT n,
C_FLOAT64 x,
C_INT ipivot,
C_FLOAT64 low,
C_FLOAT64 up,
C_INT ier 
)

Definition at line 1600 of file CTruncatedNewton.cpp.

References C_INT.

Referenced by CTruncatedNewton::lmqnbc_().

1602 {
1603  /* System generated locals */
1604  C_INT i__1;
1605 
1606  /* Local variables */
1607  C_INT i__;
1608 
1609  /* THIS INITIALIZES THE CONSTRAINT INFORMATION, AND ENSURES THAT THE */
1610  /* INITIAL POINT SATISFIES LOW <= X <= UP. */
1611  /* THE CONSTRAINTS ARE CHECKED FOR CONSISTENCY. */
1612 
1613  /* Parameter adjustments */
1614  --up;
1615  --low;
1616  --ipivot;
1617  --x;
1618 
1619  /* Function Body */
1620  *ier = 0;
1621  i__1 = *n;
1622 
1623  for (i__ = 1; i__ <= i__1; ++i__)
1624  {
1625  if (x[i__] < low[i__])
1626  {
1627  x[i__] = low[i__];
1628  }
1629 
1630  if (x[i__] > up[i__])
1631  {
1632  x[i__] = up[i__];
1633  }
1634 
1635  ipivot[i__] = 0;
1636 
1637  if (x[i__] == low[i__])
1638  {
1639  ipivot[i__] = -1;
1640  }
1641 
1642  if (x[i__] == up[i__])
1643  {
1644  ipivot[i__] = 1;
1645  }
1646 
1647  if (up[i__] == low[i__])
1648  {
1649  ipivot[i__] = 2;
1650  }
1651 
1652  if (low[i__] > up[i__])
1653  {
1654  *ier = -i__;
1655  }
1656 
1657  /* L30: */
1658  }
1659 
1660  return 0;
1661 } /* crash_ */
#define C_INT
Definition: copasi.h:115
int dxpy_ ( C_INT n,
C_FLOAT64 dx,
C_INT incx,
C_FLOAT64 dy,
C_INT incy 
)

Definition at line 3383 of file CTruncatedNewton.cpp.

References C_INT.

Referenced by CTruncatedNewton::lmqn_(), and CTruncatedNewton::lmqnbc_().

3385 {
3386  /* System generated locals */
3387  C_INT i__1;
3388 
3389  /* Local variables */
3390  C_INT i__, m, ix, iy, mp1;
3391 
3392  /* VECTOR PLUS A VECTOR. */
3393  /* USES UNROLLED LOOPS FOR INCREMENTS EQUAL TO ONE. */
3394  /* STEPHEN G. NASH 5/30/89. */
3395 
3396  /* Parameter adjustments */
3397  --dy;
3398  --dx;
3399 
3400  /* Function Body */
3401  if (*n <= 0)
3402  {
3403  return 0;
3404  }
3405 
3406  if (*incx == 1 && *incy == 1)
3407  {
3408  goto L20;
3409  }
3410 
3411  /* CODE FOR UNEQUAL INCREMENTS OR EQUAL INCREMENTS */
3412  /* NOT EQUAL TO 1 */
3413 
3414  ix = 1;
3415  iy = 1;
3416 
3417  if (*incx < 0)
3418  {
3419  ix = (-(*n) + 1) * *incx + 1;
3420  }
3421 
3422  if (*incy < 0)
3423  {
3424  iy = (-(*n) + 1) * *incy + 1;
3425  }
3426 
3427  i__1 = *n;
3428 
3429  for (i__ = 1; i__ <= i__1; ++i__)
3430  {
3431  dy[iy] += dx[ix];
3432  ix += *incx;
3433  iy += *incy;
3434  /* L10: */
3435  }
3436 
3437  return 0;
3438 
3439  /* CODE FOR BOTH INCREMENTS EQUAL TO 1 */
3440 
3441  /* CLEAN-UP LOOP */
3442 
3443 L20:
3444  m = *n % 4;
3445 
3446  if (m == 0)
3447  {
3448  goto L40;
3449  }
3450 
3451  i__1 = m;
3452 
3453  for (i__ = 1; i__ <= i__1; ++i__)
3454  {
3455  dy[i__] += dx[i__];
3456  /* L30: */
3457  }
3458 
3459  if (*n < 4)
3460  {
3461  return 0;
3462  }
3463 
3464 L40:
3465  mp1 = m + 1;
3466  i__1 = *n;
3467 
3468  for (i__ = mp1; i__ <= i__1; i__ += 4)
3469  {
3470  dy[i__] += dx[i__];
3471  dy[i__ + 1] += dx[i__ + 1];
3472  dy[i__ + 2] += dx[i__ + 2];
3473  dy[i__ + 3] += dx[i__ + 3];
3474  /* L50: */
3475  }
3476 
3477  return 0;
3478 } /* dxpy_ */
#define C_INT
Definition: copasi.h:115
int initp3_ ( C_FLOAT64 diagb,
C_FLOAT64 emat,
C_INT n,
C_INT lreset,
C_FLOAT64 yksk,
C_FLOAT64 yrsr,
C_FLOAT64 bsk,
C_FLOAT64 sk,
C_FLOAT64 yk,
C_FLOAT64 sr,
C_FLOAT64 yr,
C_INT modet,
C_INT upd1 
)

Definition at line 2535 of file CTruncatedNewton.cpp.

References c__1, C_FLOAT64, C_INT, dcopy_(), and ddot_().

Referenced by CTruncatedNewton::initpc_().

2539 {
2540  /* Format strings */
2541  // char fmt_800[] = "(\002 \002,//8x,\002DMIN =\002,1pd12.4,\002 DM"
2542  // "AX =\002,1pd12.4,\002 COND =\002,1pd12.4,/)";
2543 
2544  /* System generated locals */
2545  C_INT i__1;
2546 
2547  /* Builtin functions */
2548  // C_INT s_wsfe(cilist *), do_fio(C_INT *, char *, ftnlen), e_wsfe(void);
2549 
2550  /* Local variables */
2551  C_FLOAT64 cond;
2552  C_FLOAT64 srds, yrsk;
2553  C_INT i__;
2554  C_FLOAT64 d1, dn, td, sds;
2555 
2556  /* Fortran I/O blocks */
2557  // cilist io___235 = {0, 6, 0, fmt_800, 0 };
2558 
2559  /* Parameter adjustments */
2560  --yr;
2561  --sr;
2562  --yk;
2563  --sk;
2564  --bsk;
2565  --emat;
2566  --diagb;
2567 
2568  /* Function Body */
2569  if (*upd1)
2570  {
2571  goto L90;
2572  }
2573 
2574  if (*lreset)
2575  {
2576  goto L60;
2577  }
2578 
2579  i__1 = *n;
2580 
2581  for (i__ = 1; i__ <= i__1; ++i__)
2582  {
2583  bsk[i__] = diagb[i__] * sr[i__];
2584  /* L10: */
2585  }
2586 
2587  sds = ddot_(n, &sr[1], &c__1, &bsk[1], &c__1);
2588  srds = ddot_(n, &sk[1], &c__1, &bsk[1], &c__1);
2589  yrsk = ddot_(n, &yr[1], &c__1, &sk[1], &c__1);
2590  i__1 = *n;
2591 
2592  for (i__ = 1; i__ <= i__1; ++i__)
2593  {
2594  td = diagb[i__];
2595  bsk[i__] = td * sk[i__] - bsk[i__] * srds / sds + yr[i__] * yrsk / *
2596  yrsr;
2597  emat[i__] = td - td * td * sr[i__] * sr[i__] / sds + yr[i__] * yr[i__]
2598  / *yrsr;
2599  /* L20: */
2600  }
2601 
2602  sds = ddot_(n, &sk[1], &c__1, &bsk[1], &c__1);
2603  i__1 = *n;
2604 
2605  for (i__ = 1; i__ <= i__1; ++i__)
2606  {
2607  emat[i__] = emat[i__] - bsk[i__] * bsk[i__] / sds + yk[i__] * yk[i__]
2608  / *yksk;
2609  /* L30: */
2610  }
2611 
2612  goto L110;
2613 L60:
2614  i__1 = *n;
2615 
2616  for (i__ = 1; i__ <= i__1; ++i__)
2617  {
2618  bsk[i__] = diagb[i__] * sk[i__];
2619  /* L70: */
2620  }
2621 
2622  sds = ddot_(n, &sk[1], &c__1, &bsk[1], &c__1);
2623  i__1 = *n;
2624 
2625  for (i__ = 1; i__ <= i__1; ++i__)
2626  {
2627  td = diagb[i__];
2628  emat[i__] = td - td * td * sk[i__] * sk[i__] / sds + yk[i__] * yk[i__]
2629  / *yksk;
2630  /* L80: */
2631  }
2632 
2633  goto L110;
2634 L90:
2635  dcopy_(n, &diagb[1], &c__1, &emat[1], &c__1);
2636 L110:
2637 
2638  if (*modet < 1)
2639  {
2640  return 0;
2641  }
2642 
2643  d1 = emat[1];
2644  dn = emat[1];
2645  i__1 = *n;
2646 
2647  for (i__ = 1; i__ <= i__1; ++i__)
2648  {
2649  if (emat[i__] < d1)
2650  {
2651  d1 = emat[i__];
2652  }
2653 
2654  if (emat[i__] > dn)
2655  {
2656  dn = emat[i__];
2657  }
2658 
2659  /* L120: */
2660  }
2661 
2662  cond = dn / d1;
2663  /*s_wsfe(&io___235);
2664  do_fio(&c__1, (char *)&d1, (ftnlen)sizeof(C_FLOAT64));
2665  do_fio(&c__1, (char *)&dn, (ftnlen)sizeof(C_FLOAT64));
2666  do_fio(&c__1, (char *)&cond, (ftnlen)sizeof(C_FLOAT64));
2667  e_wsfe();*/
2668  return 0;
2669 } /* initp3_ */
#define C_INT
Definition: copasi.h:115
int dcopy_(integer *n, doublereal *dx, integer *incx, doublereal *dy, integer *incy)
static C_INT c__1
doublereal ddot_(integer *n, doublereal *dx, integer *incx, doublereal *dy, integer *incy)
#define C_FLOAT64
Definition: copasi.h:92
int lsout_ ( C_INT ,
C_INT ,
C_FLOAT64 xmin,
C_FLOAT64 ,
C_FLOAT64 ,
C_FLOAT64 xw,
C_FLOAT64 ,
C_FLOAT64 ,
C_FLOAT64 u,
C_FLOAT64 a,
C_FLOAT64 b,
C_FLOAT64 ,
C_FLOAT64 ,
C_FLOAT64 scxbd,
C_FLOAT64  
)

Definition at line 2079 of file CTruncatedNewton.cpp.

References C_FLOAT64.

Referenced by CTruncatedNewton::linder_().

2084 {
2085  /* Format strings */
2086  /* char fmt_800[] = "(///\002 OUTPUT FROM LINEAR SEARCH\002)";
2087  char fmt_810[] = "(\002 TOL AND EPS\002/2d25.14)";
2088  char fmt_820[] = "(\002 CURRENT UPPER AND LOWER BOUNDS\002/2d25."
2089  "14)";
2090  char fmt_830[] = "(\002 STRICT UPPER BOUND\002/d25.14)";
2091  char fmt_840[] = "(\002 XW, FW, GW\002/3d25.14)";
2092  char fmt_850[] = "(\002 XMIN, FMIN, GMIN\002/3d25.14)";
2093  char fmt_860[] = "(\002 NEW ESTIMATE\002/2d25.14)";
2094  char fmt_870[] = "(\002 ILOC AND ITEST\002/2i3)"; */
2095 
2096  /* Builtin functions */
2097  // C_INT s_wsfe(cilist *), e_wsfe(void), do_fio(C_INT *, char *, ftnlen);
2098 
2099  /* Local variables */
2100  C_FLOAT64 ybnd, ya, yb, yu, yw;
2101 
2102  /* ERROR PRINTOUTS FOR GETPTC */
2103 
2104  yu = *xmin + *u;
2105  ya = *a + *xmin;
2106  yb = *b + *xmin;
2107  yw = *xw + *xmin;
2108  ybnd = *scxbd + *xmin;
2109  //remove the printing
2110  /* s_wsfe(&io___199);
2111  e_wsfe();
2112  s_wsfe(&io___200);
2113  do_fio(&c__1, (char *)&(*tol), (ftnlen)sizeof(C_FLOAT64));
2114  do_fio(&c__1, (char *)&(*eps), (ftnlen)sizeof(C_FLOAT64));
2115  e_wsfe();
2116  s_wsfe(&io___201);
2117  do_fio(&c__1, (char *)&ya, (ftnlen)sizeof(C_FLOAT64));
2118  do_fio(&c__1, (char *)&yb, (ftnlen)sizeof(C_FLOAT64));
2119  e_wsfe();
2120  s_wsfe(&io___202);
2121  do_fio(&c__1, (char *)&ybnd, (ftnlen)sizeof(C_FLOAT64));
2122  e_wsfe();
2123  s_wsfe(&io___203);
2124  do_fio(&c__1, (char *)&yw, (ftnlen)sizeof(C_FLOAT64));
2125  do_fio(&c__1, (char *)&(*fw), (ftnlen)sizeof(C_FLOAT64));
2126  do_fio(&c__1, (char *)&(*gw), (ftnlen)sizeof(C_FLOAT64));
2127  e_wsfe();
2128  s_wsfe(&io___204);
2129  do_fio(&c__1, (char *)&(*xmin), (ftnlen)sizeof(C_FLOAT64));
2130  do_fio(&c__1, (char *)&(*fmin), (ftnlen)sizeof(C_FLOAT64));
2131  do_fio(&c__1, (char *)&(*gmin), (ftnlen)sizeof(C_FLOAT64));
2132  e_wsfe();
2133  s_wsfe(&io___205);
2134  do_fio(&c__1, (char *)&yu, (ftnlen)sizeof(C_FLOAT64));
2135  e_wsfe();
2136  s_wsfe(&io___206);
2137  do_fio(&c__1, (char *)&(*iloc), (ftnlen)sizeof(C_INT));
2138  do_fio(&c__1, (char *)&(*itest), (ftnlen)sizeof(C_INT));
2139  e_wsfe(); */
2140  return 0;
2141 } /* lsout_ */
#define C_FLOAT64
Definition: copasi.h:92
C_FLOAT64 mchpr1_ ( void  )

Definition at line 2176 of file CTruncatedNewton.cpp.

References C_FLOAT64.

Referenced by chkucp_(), step1_(), CTruncatedNewton::tn_(), and CTruncatedNewton::tnbc_().

2177 {
2178  /* System generated locals */
2179  C_FLOAT64 ret_val;
2180 
2181  /* RETURNS THE VALUE OF EPSMCH, WHERE EPSMCH IS THE SMALLEST POSSIBLE */
2182  /* REAL NUMBER SUCH THAT 1.0 + EPSMCH .GT. 1.0 */
2183 
2184  /* FOR IEEE */
2185 
2186  ret_val = std::numeric_limits< C_FLOAT64 >::epsilon();
2187 
2188  return ret_val;
2189 } /* mchpr1_ */
#define C_FLOAT64
Definition: copasi.h:92
int modz_ ( C_INT n,
C_FLOAT64 x,
C_FLOAT64 p,
C_INT ipivot,
C_FLOAT64 epsmch,
C_FLOAT64 low,
C_FLOAT64 up,
C_FLOAT64 flast,
C_FLOAT64 fnew 
)

Definition at line 1440 of file CTruncatedNewton.cpp.

References C_FLOAT64, and C_INT.

Referenced by CTruncatedNewton::lmqnbc_().

1443 {
1444  /* System generated locals */
1445  C_INT i__1;
1446  C_FLOAT64 d__1;
1447 
1448  /* Local variables */
1449  C_INT i__;
1450  C_FLOAT64 tol;
1451 
1452  /* UPDATE THE CONSTRAINT MATRIX IF A NEW CONSTRAINT IS ENCOUNTERED */
1453 
1454  /* Parameter adjustments */
1455  --up;
1456  --low;
1457  --ipivot;
1458  --p;
1459  --x;
1460 
1461  /* Function Body */
1462  i__1 = *n;
1463 
1464  for (i__ = 1; i__ <= i__1; ++i__)
1465  {
1466  if (ipivot[i__] != 0)
1467  {
1468  goto L10;
1469  }
1470 
1471  if (p[i__] == 0.)
1472  {
1473  goto L10;
1474  }
1475 
1476  if (p[i__] > 0.)
1477  {
1478  goto L5;
1479  }
1480 
1481  tol = *epsmch * 10. * ((d__1 = low[i__], fabs(d__1)) + 1.);
1482 
1483  if (x[i__] - low[i__] > tol)
1484  {
1485  goto L10;
1486  }
1487 
1488  *flast = *fnew;
1489  ipivot[i__] = -1;
1490  x[i__] = low[i__];
1491  goto L10;
1492 L5:
1493  tol = *epsmch * 10. * ((d__1 = up[i__], fabs(d__1)) + 1.);
1494 
1495  if (up[i__] - x[i__] > tol)
1496  {
1497  goto L10;
1498  }
1499 
1500  *flast = *fnew;
1501  ipivot[i__] = 1;
1502  x[i__] = up[i__];
1503 L10:
1504  ;
1505  }
1506 
1507  return 0;
1508 } /* modz_ */
#define C_INT
Definition: copasi.h:115
#define C_FLOAT64
Definition: copasi.h:92
int monit_ ( C_INT n,
C_FLOAT64 x,
C_FLOAT64 ,
C_FLOAT64 g,
C_INT ,
C_INT ,
C_INT ,
C_INT ,
C_INT ipivot 
)

Definition at line 1315 of file CTruncatedNewton.cpp.

References C_FLOAT64, and C_INT.

Referenced by CTruncatedNewton::lmqnbc_().

1318 {
1319  /* Format strings */
1320  // char fmt_800[] = "(\002 \002,i4,1x,i4,1x,i4,1x,1pd22.15,2x,1pd15." "8)";
1321 
1322  /* System generated locals */
1323  C_INT i__1;
1324 
1325  /* Builtin functions */
1326  //C_INT s_wsfe(cilist *), do_fio(C_INT *, char *, ftnlen), e_wsfe(void);
1327 
1328  /* Local variables */
1329  C_INT i__;
1330  C_FLOAT64 gtg;
1331 
1332  /* PRINT RESULTS OF CURRENT ITERATION */
1333 
1334  /* Parameter adjustments */
1335  --ipivot;
1336  --g;
1337  --x;
1338 
1339  /* Function Body */
1340  gtg = 0.;
1341  i__1 = *n;
1342 
1343  for (i__ = 1; i__ <= i__1; ++i__)
1344  {
1345  if (ipivot[i__] != 0)
1346  {
1347  goto L10;
1348  }
1349 
1350  gtg += g[i__] * g[i__];
1351 L10:
1352  ;
1353  }
1354 
1355  //remove the printing
1356  /* s_wsfe(&io___154);
1357  do_fio(&c__1, (char *)&(*niter), (ftnlen)sizeof(C_INT));
1358  do_fio(&c__1, (char *)&(*nftotl), (ftnlen)sizeof(C_INT));
1359  do_fio(&c__1, (char *)&(*nfeval), (ftnlen)sizeof(C_INT));
1360  do_fio(&c__1, (char *)&(*f), (ftnlen)sizeof(C_FLOAT64));
1361  do_fio(&c__1, (char *)&gtg, (ftnlen)sizeof(C_FLOAT64));
1362  e_wsfe();*/
1363  return 0;
1364 } /* monit_ */
#define C_INT
Definition: copasi.h:115
#define C_FLOAT64
Definition: copasi.h:92
int mslv_ ( C_FLOAT64 g,
C_FLOAT64 y,
C_INT n,
C_FLOAT64 sk,
C_FLOAT64 yk,
C_FLOAT64 diagb,
C_FLOAT64 sr,
C_FLOAT64 yr,
C_FLOAT64 hyr,
C_FLOAT64 hg,
C_FLOAT64 hyk,
C_INT upd1,
C_FLOAT64 yksk,
C_FLOAT64 gsk,
C_FLOAT64 yrsr,
C_INT lreset,
C_INT first 
)

Definition at line 2339 of file CTruncatedNewton.cpp.

References c__1, C_FLOAT64, C_INT, ddot_(), and ssbfgs_().

Referenced by CTruncatedNewton::msolve_().

2344 {
2345  /* System generated locals */
2346  C_INT i__1;
2347 
2348  /* Local variables */
2349  C_FLOAT64 ghyk, ghyr, yksr = 0.0;
2350  C_INT i__;
2351  C_FLOAT64 ykhyk = 0.0, ykhyr = 0.0, yrhyr = 0.0, rdiagb;
2352  C_FLOAT64 one, gsr;
2353 
2354  /* THIS ROUTINE ACTS AS A PRECONDITIONING STEP FOR THE */
2355  /* LINEAR CONJUGATE-GRADIENT ROUTINE. IT IS ALSO THE */
2356  /* METHOD OF COMPUTING THE SEARCH DIRECTION FROM THE */
2357  /* GRADIENT FOR THE NON-LINEAR CONJUGATE-GRADIENT CODE. */
2358  /* IT REPRESENTS A TWO-STEP SELF-SCALED BFGS FORMULA. */
2359 
2360  /* Parameter adjustments */
2361  --hyk;
2362  --hg;
2363  --hyr;
2364  --yr;
2365  --sr;
2366  --diagb;
2367  --yk;
2368  --sk;
2369  --y;
2370  --g;
2371 
2372  /* Function Body */
2373  if (*upd1)
2374  {
2375  goto L100;
2376  }
2377 
2378  one = 1.;
2379  *gsk = ddot_(n, &g[1], &c__1, &sk[1], &c__1);
2380 
2381  if (*lreset)
2382  {
2383  goto L60;
2384  }
2385 
2386  /* COMPUTE HG AND HY WHERE H IS THE INVERSE OF THE DIAGONALS */
2387 
2388  i__1 = *n;
2389 
2390  for (i__ = 1; i__ <= i__1; ++i__)
2391  {
2392  rdiagb = 1. / diagb[i__];
2393  hg[i__] = g[i__] * rdiagb;
2394 
2395  if (*first)
2396  {
2397  hyk[i__] = yk[i__] * rdiagb;
2398  }
2399 
2400  if (*first)
2401  {
2402  hyr[i__] = yr[i__] * rdiagb;
2403  }
2404 
2405  /* L57: */
2406  }
2407 
2408  if (*first)
2409  {
2410  yksr = ddot_(n, &yk[1], &c__1, &sr[1], &c__1);
2411  }
2412 
2413  if (*first)
2414  {
2415  ykhyr = ddot_(n, &yk[1], &c__1, &hyr[1], &c__1);
2416  }
2417 
2418  gsr = ddot_(n, &g[1], &c__1, &sr[1], &c__1);
2419  ghyr = ddot_(n, &g[1], &c__1, &hyr[1], &c__1);
2420 
2421  if (*first)
2422  {
2423  yrhyr = ddot_(n, &yr[1], &c__1, &hyr[1], &c__1);
2424  }
2425 
2426  ssbfgs_(n, &one, &sr[1], &yr[1], &hg[1], &hyr[1], yrsr, &yrhyr, &gsr, &
2427  ghyr, &hg[1]);
2428 
2429  if (*first)
2430  {
2431  ssbfgs_(n, &one, &sr[1], &yr[1], &hyk[1], &hyr[1], yrsr, &yrhyr, &
2432  yksr, &ykhyr, &hyk[1]);
2433  }
2434 
2435  ykhyk = ddot_(n, &hyk[1], &c__1, &yk[1], &c__1);
2436  ghyk = ddot_(n, &hyk[1], &c__1, &g[1], &c__1);
2437  ssbfgs_(n, &one, &sk[1], &yk[1], &hg[1], &hyk[1], yksk, &ykhyk, gsk, &
2438  ghyk, &y[1]);
2439  return 0;
2440 L60:
2441 
2442  /* COMPUTE GH AND HY WHERE H IS THE INVERSE OF THE DIAGONALS */
2443 
2444  i__1 = *n;
2445 
2446  for (i__ = 1; i__ <= i__1; ++i__)
2447  {
2448  rdiagb = 1. / diagb[i__];
2449  hg[i__] = g[i__] * rdiagb;
2450 
2451  if (*first)
2452  {
2453  hyk[i__] = yk[i__] * rdiagb;
2454  }
2455 
2456  /* L65: */
2457  }
2458 
2459  if (*first)
2460  {
2461  ykhyk = ddot_(n, &yk[1], &c__1, &hyk[1], &c__1);
2462  }
2463 
2464  ghyk = ddot_(n, &g[1], &c__1, &hyk[1], &c__1);
2465  ssbfgs_(n, &one, &sk[1], &yk[1], &hg[1], &hyk[1], yksk, &ykhyk, gsk, &
2466  ghyk, &y[1]);
2467  return 0;
2468 L100:
2469  i__1 = *n;
2470 
2471  for (i__ = 1; i__ <= i__1; ++i__)
2472  {
2473  /* L110: */
2474  y[i__] = g[i__] / diagb[i__];
2475  }
2476 
2477  return 0;
2478 } /* mslv_ */
#define C_INT
Definition: copasi.h:115
static C_INT c__1
int ssbfgs_(C_INT *, C_FLOAT64 *, C_FLOAT64 *, C_FLOAT64 *, C_FLOAT64 *, C_FLOAT64 *, C_FLOAT64 *, C_FLOAT64 *, C_FLOAT64 *, C_FLOAT64 *, C_FLOAT64 *)
doublereal ddot_(integer *n, doublereal *dx, integer *incx, doublereal *dy, integer *incy)
#define C_FLOAT64
Definition: copasi.h:92
int ndia3_ ( C_INT n,
C_FLOAT64 e,
C_FLOAT64 v,
C_FLOAT64 gv,
C_FLOAT64 r__,
C_FLOAT64 vgv,
C_INT modet 
)

Definition at line 1995 of file CTruncatedNewton.cpp.

References c__1, C_FLOAT64, C_INT, and ddot_().

Referenced by CTruncatedNewton::modlnp_().

1997 {
1998  /* Format strings */
1999  // char fmt_800[] = "(\002 *** EMAT NEGATIVE: \002,1pd16.8)";
2000 
2001  /* System generated locals */
2002  C_INT i__1;
2003 
2004  /* Builtin functions */
2005  // C_INT s_wsfe(cilist *), do_fio(C_INT *, char *, ftnlen), e_wsfe(void);
2006 
2007  /* Local variables */
2008  C_INT i__;
2009  C_FLOAT64 vr;
2010 
2011  /* Fortran I/O blocks */
2012  // cilist io___192 = {0, 6, 0, fmt_800, 0 };
2013 
2014  /* UPDATE THE PRECONDITIOING MATRIX BASED ON A DIAGONAL VERSION */
2015  /* OF THE BFGS QUASI-NEWTON UPDATE. */
2016 
2017  /* Parameter adjustments */
2018  --r__;
2019  --gv;
2020  --v;
2021  --e;
2022 
2023  /* Function Body */
2024  vr = ddot_(n, &v[1], &c__1, &r__[1], &c__1);
2025  i__1 = *n;
2026 
2027  for (i__ = 1; i__ <= i__1; ++i__)
2028  {
2029  e[i__] = e[i__] - r__[i__] * r__[i__] / vr + gv[i__] * gv[i__] / *vgv;
2030 
2031  if (e[i__] > 1e-6)
2032  {
2033  goto L10;
2034  }
2035 
2036  if (*modet > -2)
2037  {
2038  /*
2039  s_wsfe(&io___192);
2040  do_fio(&c__1, (char *)&e[i__], (ftnlen)sizeof(C_FLOAT64));
2041  e_wsfe();*/
2042  }
2043 
2044  e[i__] = 1.;
2045 L10:
2046  ;
2047  }
2048 
2049  return 0;
2050 } /* ndia3_ */
#define C_INT
Definition: copasi.h:115
static C_INT c__1
doublereal ddot_(integer *n, doublereal *dx, integer *incx, doublereal *dy, integer *incy)
#define C_FLOAT64
Definition: copasi.h:92
int negvec_ ( C_INT n,
C_FLOAT64 v 
)

Definition at line 2054 of file CTruncatedNewton.cpp.

References C_INT.

Referenced by CTruncatedNewton::modlnp_().

2055 {
2056  /* System generated locals */
2057  C_INT i__1;
2058 
2059  /* Local variables */
2060  C_INT i__;
2061 
2062  /* NEGATIVE OF THE VECTOR V */
2063 
2064  /* Parameter adjustments */
2065  --v;
2066 
2067  /* Function Body */
2068  i__1 = *n;
2069 
2070  for (i__ = 1; i__ <= i__1; ++i__)
2071  {
2072  v[i__] = -v[i__];
2073  /* L10: */
2074  }
2075 
2076  return 0;
2077 } /* negvec_ */
#define C_INT
Definition: copasi.h:115
C_FLOAT64 pow_dd ( C_FLOAT64 ap,
C_FLOAT64 bp 
)

Definition at line 3480 of file CTruncatedNewton.cpp.

3481 {
3482  return(pow(*ap, *bp));
3483 }
int ssbfgs_ ( C_INT n,
C_FLOAT64 gamma,
C_FLOAT64 sj,
C_FLOAT64 yj,
C_FLOAT64 hjv,
C_FLOAT64 hjyj,
C_FLOAT64 yjsj,
C_FLOAT64 yjhyj,
C_FLOAT64 vsj,
C_FLOAT64 vhyj,
C_FLOAT64 hjp1v 
)

Definition at line 2480 of file CTruncatedNewton.cpp.

References C_FLOAT64, and C_INT.

Referenced by mslv_().

2484 {
2485  /* System generated locals */
2486  C_INT i__1;
2487 
2488  /* Local variables */
2489  C_FLOAT64 beta;
2490  C_INT i__;
2491  C_FLOAT64 delta;
2492 
2493  /* SELF-SCALED BFGS */
2494 
2495  /* Parameter adjustments */
2496  --hjp1v;
2497  --hjyj;
2498  --hjv;
2499  --yj;
2500  --sj;
2501 
2502  /* Function Body */
2503  delta = (*gamma * *yjhyj / *yjsj + 1.) * *vsj / *yjsj - *gamma * *vhyj / *
2504  yjsj;
2505  beta = -(*gamma) * *vsj / *yjsj;
2506  i__1 = *n;
2507 
2508  for (i__ = 1; i__ <= i__1; ++i__)
2509  {
2510  hjp1v[i__] = *gamma * hjv[i__] + delta * sj[i__] + beta * hjyj[i__];
2511  /* L10: */
2512  }
2513 
2514  return 0;
2515 } /* ssbfgs_ */
#define C_INT
Definition: copasi.h:115
#define C_FLOAT64
Definition: copasi.h:92
C_FLOAT64 step1_ ( C_FLOAT64 fnew,
C_FLOAT64 fm,
C_FLOAT64 gtp,
C_FLOAT64 smax 
)

Definition at line 2143 of file CTruncatedNewton.cpp.

References C_FLOAT64, and mchpr1_().

Referenced by CTruncatedNewton::lmqn_(), and CTruncatedNewton::lmqnbc_().

2145 {
2146  /* System generated locals */
2147  C_FLOAT64 ret_val, d__1;
2148 
2149  /* Local variables */
2150  C_FLOAT64 d__, alpha;
2151  C_FLOAT64 epsmch;
2152 
2153  /* ******************************************************** */
2154  /* STEP1 RETURNS THE LENGTH OF THE INITIAL STEP TO BE TAKEN ALONG THE */
2155  /* VECTOR P IN THE NEXT LINEAR SEARCH. */
2156  /* ******************************************************** */
2157 
2158  epsmch = mchpr1_();
2159  d__ = (d__1 = *fnew - *fm, fabs(d__1));
2160  alpha = 1.;
2161 
2162  if (d__ * 2. <= -(*gtp) && d__ >= epsmch)
2163  {
2164  alpha = d__ * -2. / *gtp;
2165  }
2166 
2167  if (alpha >= *smax)
2168  {
2169  alpha = *smax;
2170  }
2171 
2172  ret_val = alpha;
2173  return ret_val;
2174 } /* step1_ */
C_FLOAT64 mchpr1_(void)
#define C_FLOAT64
Definition: copasi.h:92
int stpmax_ ( C_FLOAT64 stepmx,
C_FLOAT64 pe,
C_FLOAT64 spe,
C_INT n,
C_FLOAT64 x,
C_FLOAT64 p,
C_INT ipivot,
C_FLOAT64 low,
C_FLOAT64 up 
)

Definition at line 1396 of file CTruncatedNewton.cpp.

References C_FLOAT64, and C_INT.

Referenced by CTruncatedNewton::lmqnbc_().

1399 {
1400  /* System generated locals */
1401  C_INT i__1;
1402  /* Local variables */
1403  C_INT i__;
1404  C_FLOAT64 t;
1405 
1406  /* COMPUTE THE MAXIMUM ALLOWABLE STEP LENGTH */
1407 
1408  /* Parameter adjustments */
1409  --up; --low; --ipivot; --p; --x;
1410 
1411  /* Function Body */
1412  *spe = *stepmx / *pe;
1413  /* SPE IS THE STANDARD (UNCONSTRAINED) MAX STEP */
1414  i__1 = *n;
1415 
1416  for (i__ = 1; i__ <= i__1; ++i__)
1417  {
1418  if (ipivot[i__] != 0) goto L10;
1419 
1420  if (p[i__] == 0.) goto L10;
1421 
1422  if (p[i__] > 0.) goto L5;
1423 
1424  t = low[i__] - x[i__];
1425 
1426  if (t > *spe * p[i__]) *spe = t / p[i__];
1427 
1428  goto L10;
1429 L5:
1430  t = up[i__] - x[i__];
1431 
1432  if (t < *spe * p[i__]) *spe = t / p[i__];
1433 
1434 L10:;
1435  }
1436 
1437  return 0;
1438 } /* stpmax_ */
#define C_INT
Definition: copasi.h:115
#define C_FLOAT64
Definition: copasi.h:92
int ztime_ ( C_INT n,
C_FLOAT64 x,
C_INT ipivot 
)

Definition at line 1366 of file CTruncatedNewton.cpp.

References C_INT.

Referenced by CTruncatedNewton::lmqnbc_(), and CTruncatedNewton::modlnp_().

1367 {
1368  /* System generated locals */
1369  C_INT i__1;
1370 
1371  /* Local variables */
1372  C_INT i__;
1373 
1374  /* THIS ROUTINE MULTIPLIES THE VECTOR X BY THE CONSTRAINT MATRIX Z */
1375 
1376  /* Parameter adjustments */
1377  --ipivot;
1378  --x;
1379 
1380  /* Function Body */
1381  i__1 = *n;
1382 
1383  for (i__ = 1; i__ <= i__1; ++i__)
1384  {
1385  if (ipivot[i__] != 0)
1386  {
1387  x[i__] = 0.;
1388  }
1389 
1390  /* L10: */
1391  }
1392 
1393  return 0;
1394 } /* ztime_ */
#define C_INT
Definition: copasi.h:115

Variable Documentation

C_INT c__1 = 1
static
C_FLOAT64 c_b246 = .6666
static

Definition at line 86 of file CTruncatedNewton.cpp.

Referenced by chkucp_().

C_INT c_false = (0)
static

Definition at line 84 of file CTruncatedNewton.cpp.

Referenced by CTruncatedNewton::lmqn_().

C_INT c_true = (1)
static

Definition at line 85 of file CTruncatedNewton.cpp.

Referenced by CTruncatedNewton::lmqnbc_().