#! /bin/sh
######################################
##### Model Transformation Tools #####
######################################
###############################################################
## Version control history
###############################################################
## $Id$
## $Log$
## Revision 1.51.2.4 2001/03/12 03:59:30 geraint
## SIGINT (C-c C-c) now causes simulation data to be dumped to MTT.core.
## SIGQUIT (C-c C-\) as for SIGINT, then raises default SIGQUIT.
## SIGFPE as for SIGINT, then raises default SIGABRT.
##
## Revision 1.51.2.3 2001/03/07 04:06:55 geraint
## Irix: catch SIGFPE and write data before aborting (.exe).
## GNU/Linux: nada.
##
## Revision 1.51.2.2 2001/03/02 00:45:21 geraint
## Separated Euler and Implicit methods in .cc code and dependencies.
##
## Revision 1.51.2.1 2001/03/01 05:05:53 geraint
## Minor revisions.
##
## Revision 1.51 2001/02/19 06:33:19 geraint
## Removed operation form loop.
##
## Revision 1.50 2001/02/18 09:18:49 geraint
## Removed temporary Matrices from mtt_implicit.cc
##
## Revision 1.49 2001/02/14 06:06:34 geraint
## Removed octave_value_list wrappers from standalone.exe - speed improvements
##
## Revision 1.48 2001/02/11 07:08:59 geraint
## Static declarations of octave_value_lists: small .exe speed improvement
##
## Revision 1.47 2001/02/11 05:25:52 geraint
## Reduced number of matrix operations during .oct simulation data write
##
## Revision 1.46 2001/02/05 08:32:31 geraint
## typo
##
## Revision 1.45 2001/02/05 04:32:35 geraint
## Octave version 2.1.x compatability and #ifdef statements for standalone rep
##
## Revision 1.46 2001/01/08 06:21:59 geraint
## #ifdef STANDALONE stuff
##
## Revision 1.45 2001/01/07 01:25:49 geraint
## Compatibility with Octave 2.1.33
##
## Revision 1.44 2000/12/05 12:11:45 peterg
## Changed function name to name()
##
## Revision 1.43 2000/12/04 10:59:40 peterg
## *** empty log message ***
##
## Revision 1.42 2000/11/10 14:19:50 peterg
## Corrected the csex and cseo functions
##
## Revision 1.41 2000/11/09 17:06:39 peterg
## Now does euler for cc
##
## Revision 1.40 2000/10/17 09:55:00 peterg
## Replaced switchopen by logic
##
## Revision 1.39 2000/10/14 08:04:40 peterg
## Changed arguments to _inout for consistency
##
## Revision 1.38 2000/10/11 09:08:08 peterg
## cse --> csex
##
## Revision 1.37 2000/08/01 12:25:06 peterg
## Now includes euler
##
## Revision 1.36 2000/05/19 17:48:16 peterg
## Argument to state
##
## Revision 1.35 2000/05/18 18:59:40 peterg
## Removed the First time stuff
##
## Revision 1.34 2000/05/16 18:56:14 peterg
## *** empty log message ***
##
## Revision 1.33 2000/05/11 19:33:18 peterg
## Uniform version for _sim.m
##
## Revision 1.32 2000/05/11 08:30:00 peterg
##
## Revision 1.31 2000/05/10 18:33:25 peterg
## Use smxa and smxax in place of smx
##
## Revision 1.30 2000/04/18 11:24:19 peterg
## Removed _numpar.
##
## Revision 1.29 2000/04/07 19:10:57 peterg
## *** empty log message ***
##
## Revision 1.28 1999/12/08 05:56:52 peterg
## Reordered the writing of the input and output.
## Note that last value now discarded.
##
## Revision 1.27 1999/11/15 22:47:53 peterg
## Generates method-specific code.
##
## Revision 1.26 1999/10/20 01:31:43 peterg
## *** empty log message ***
##
## Revision 1.25 1999/08/29 06:55:26 peterg
## Removed [MTTu] = zero_input($Nu); # Zero the input
## to avoide the p2c bug ????
##
## Revision 1.24 1999/08/27 06:02:16 peterg
## removed zero_input to avoid p2c bug
##
## Revision 1.23 1999/08/02 13:39:19 peterg
## Replaced zero_vector by zero_input
##
## Revision 1.22 1999/04/20 06:16:07 peterg
## Removed initialisation of AA and AAx
## Remove _switch calls -- uses _switchopen exclusively
##
## Revision 1.21 1999/04/02 06:29:25 peterg
## New implicit method - solves numerical prob with ISW
##
## Revision 1.20 1999/04/02 02:13:58 peterg
## Back to RCS
##
## Revision 1.19 1999/03/30 21:39:25 peterg
## In implicit approach, set derivatives to zero (when switch is off)
## before update. This seems to stop numerical leakage though non-return
## switches.
##
## Revision 1.18 1999/03/15 01:17:07 peterg
## Removed some spurious debugging code
##
## Revision 1.17 1999/03/15 01:09:15 peterg
## Fixed bugs when Nx=0 (no state)
##
## Revision 1.16 1999/03/06 02:28:38 peterg
## Rearranged evaluation to: state - input - output - write
##
## Revision 1.15 1999/03/06 02:19:43 peterg
## Changed args to _input
##
## Revision 1.14 1998/10/01 16:02:01 peterg
## Integration with switches handled separately fro Euler and Implicit.
##
## Revision 1.13 1998/09/30 17:41:24 peterg
## Implicit method now allows for switches via _switchA
##
## Revision 1.12 1998/08/27 08:55:18 peterg
## Mods to integration methods
##
## Revision 1.11 1998/08/25 12:28:31 peterg
## Move initila switch to after initial input
##
## Revision 1.10 1998/08/25 12:22:45 peterg
## Put _switch after update and also at initilisation
##
## Revision 1.9 1998/08/15 13:46:59 peterg
## New versions of integration routines
##
## Revision 1.8 1998/08/11 13:28:03 peterg
## Lowercase mttLAST etc
##
## Revision 1.7 1998/07/30 11:29:54 peterg
## Added implicit integration stuff
##
## Revision 1.6 1998/07/30 10:44:37 peterg
## INcluded othe integration methods.
##
## Revision 1.5 1998/07/26 11:02:20 peterg
## Put mtt or MTT in front of variable names to avoid clashes with
## globals
##
## Revision 1.4 1998/07/25 20:14:00 peterg
## update code added for flexibility and octave efficiency
##
###############################################################
# Bourne shell script: make_ode2odes
# Copyright (c) P.J.Gawthrop July 1998.
# Tell user
sys=$1
lang=$2
filename=${sys}_ode2odes.${lang}
if [ -n "$3" ]; then
method=$3
else
method=implicit
fi
echo Creating $filename with $method integration method
# Find system constants
Nx=`mtt_getsize $sys x` # States
Nu=`mtt_getsize $sys u` # Inputs
Ny=`mtt_getsize $sys y` # Inputs
if [ "$method" = "implicit" ]; then
ode=csex
odeo=cseo
algorithm="mtt_implicit(x,dx,AA,AAx,ddt,$Nx,open_switches)"
else
ode=ode
odeo=odeo
algorithm="mtt_euler(x,dx,ddt,$Nx,open_switches)"
fi
make_m()
{
#lang_header $1 ode2odes m 'x,par,simpar' '[Y,X,t]' > $filename
mtt_header ${sys} ode2odes m > $filename
cat <<EOF >> $filename
global MTT_data;
if nargin<3
simpar = ${sys}_simpar();
[simpar.dt] = mtt_simpar_update;
endif
if nargin<2
par = ${sys}_numpar();
[par] = mtt_numpar_update(par);
endif
if nargin<1
[x] = ${sys}_state(par);
[x] = mtt_state_update(x);
endif
## Initialise
t = 0.0;
ddt = simpar.dt/simpar.stepfactor;
ilast = round(simpar.last/ddt)+1; # Total number of steps
## Following removed due to p2c bug
## [u] = zero_input($Nu); # Zero the input
for MTTi=1:$Ny
y(MTTi) = 0;
endfor;
mttj = 0;
for it = 1:ilast #Integration loop
[u] = ${sys}_input(x,y,t,par); # Input
[y] = ${sys}_$odeo(x,u,t,par); # Output
if mttj==0
mtt_write(t,x,y,$Nx,$Ny); # Write it out
endif
[dx] = ${sys}_$ode(x,u,t,par); # State derivative
EOF
if [ "$method" = "implicit" ]; then
cat<< EOF >> $filename
[AA] = ${sys}_smxa(x,u,ddt,par); # (I-Adt) and (I-Adt)x
[AAx] = ${sys}_smxax(x,u,ddt,par); # (I-Adt) and (I-Adt)x
EOF
fi
cat <<EOF >> $filename
[open_switches] = ${sys}_logic(x,u,t,par); # Switch logic
[x] = $algorithm; # Integration update
t = t + ddt; # Time update
mttj = mttj+1; # Increment counter
if mttj==simpar.stepfactor
mttj = 0; # Reset counter
endif
endfor; # Integration loop
t = MTT_data(:,1);
Y = MTT_data(:,2);
X = MTT_data(:,4);
endfunction
EOF
} # make_m
make_cc()
{
# get octave version
octave_development=`octave --version | awk '{print $4}' | awk -F\. '{print $2}'`
if [ $octave_development ]; then
vector_value=column_vector_value
feval_header=parse.h
else
vector_value=vector_value
feval_header=toplev.h
fi
cat <<EOF > $filename
#include <octave/oct.h>
#include <octave/ov-struct.h>
#include <octave/load-save.h>
#include <octave/lo-mappers.h>
#include <octave/variables.h>
#ifndef STANDALONE
#include <octave/${feval_header}>
#endif
#include "${sys}_def.h"
#include "${sys}_sympar.h"
#ifdef STANDALONE
#include <csignal>
#include <siginfo.h> // for Irix psignal
#include <fstream>
extern ColumnVector F${sys}_input (
ColumnVector &x,
ColumnVector &y,
const double &t,
ColumnVector &par);
extern ColumnVector F${sys}_logic (
ColumnVector &x,
ColumnVector &u,
const double &t,
ColumnVector &par);
extern ColumnVector F${sys}_numpar (
void);
extern Octave_map F${sys}_simpar (
void);
extern ColumnVector F${sys}_state (
ColumnVector &x);
extern ColumnVector F${sys}_${ode} (
ColumnVector &x,
ColumnVector &u,
const double &t,
ColumnVector &par);
extern ColumnVector F${sys}_${odeo} (
ColumnVector &x,
ColumnVector &u,
const double &t,
ColumnVector &par);
EOF
if [ "$method" != "implicit" ]; then
cat <<EOF >> $filename
extern ColumnVector Fmtt_euler (
ColumnVector &x,
const ColumnVector &dx,
const double &ddt,
const int &nx,
const ColumnVector &open_switches);
EOF
else
cat <<EOF >> $filename
extern ColumnVector Fmtt_implicit (
ColumnVector &x,
ColumnVector &dx,
Matrix &AA,
ColumnVector &AAx,
const double &ddt,
const int &nx,
const ColumnVector &open_switches);
extern Matrix F${sys}_smxa (
ColumnVector &x,
ColumnVector &u,
const double &t,
ColumnVector &par);
extern ColumnVector F${sys}_smxax (
ColumnVector &x,
ColumnVector &u,
const double &t,
ColumnVector &par);
EOF
fi
cat <<EOF >> $filename
#endif // STANDALONE
inline ColumnVector
mtt_input (ColumnVector &x,
ColumnVector &y,
const double &t,
ColumnVector &par)
{
#ifdef STANDALONE
return F${sys}_input (x, y, t, par);
#else
static octave_value_list args, f;
args (0) = octave_value (x);
args (1) = octave_value (y);
args (2) = octave_value (t);
args (3) = octave_value (par);
f = feval ("${sys}_input", args, 1);
return f(0).${vector_value} ();
#endif
}
inline ColumnVector
mtt_logic (ColumnVector &x,
ColumnVector &u,
const double &t,
ColumnVector &par)
{
#ifdef STANDALONE
return F${sys}_logic (x, u, t, par);
#else
static octave_value_list args, f;
args (0) = octave_value (x);
args (1) = octave_value (u);
args (2) = octave_value (t);
args (3) = octave_value (par);
f = feval ("${sys}_logic", args, 1);
return f(0).${vector_value} ();
#endif
}
inline ColumnVector
mtt_numpar (void)
{
#ifdef STANDALONE
return F${sys}_numpar ();
#else
static octave_value_list args, f;
f = feval ("${sys}_numpar", args, 1);
return f(0).${vector_value} ();
#endif
}
inline Octave_map
mtt_simpar (void)
{
#ifdef STANDALONE
return F${sys}_simpar ();
#else
static octave_value_list args;
static Octave_map f;
f["first"] = feval ("${sys}_simpar", args, 1)(0).map_value ()["first"];
f["dt"] = feval ("${sys}_simpar", args, 1)(0).map_value ()["dt"];
f["last"] = feval ("${sys}_simpar", args, 1)(0).map_value ()["last"];
f["stepfactor"] = feval ("${sys}_simpar", args, 1)(0).map_value ()["stepfactor"];
f["wmin"] = feval ("${sys}_simpar", args, 1)(0).map_value ()["wmin"];
f["wmax"] = feval ("${sys}_simpar", args, 1)(0).map_value ()["wmax"];
f["wsteps"] = feval ("${sys}_simpar", args, 1)(0).map_value ()["wsteps"];
f["input"] = feval ("${sys}_simpar", args, 1)(0).map_value ()["input"];
return (f);
#endif
}
inline ColumnVector
mtt_state (ColumnVector &x)
{
#ifdef STANDALONE
return F${sys}_state (x);
#else
static octave_value_list args, f;
args (0) = octave_value (x);
f = feval ("${sys}_state", args, 1);
return f(0).${vector_value} ();
#endif
}
inline ColumnVector
mtt_${ode} (ColumnVector &x,
ColumnVector &u,
const double &t,
ColumnVector &par)
{
#ifdef STANDALONE
return F${sys}_${ode} (x, u, t, par);
#else
static octave_value_list args, f;
args (0) = octave_value (x);
args (1) = octave_value (u);
args (2) = octave_value (t);
args (3) = octave_value (par);
f = feval ("${sys}_${ode}", args, 1);
return f(0).${vector_value} ();
#endif
}
inline ColumnVector
mtt_${odeo} (ColumnVector &x,
ColumnVector &u,
const double &t,
ColumnVector &par)
{
#ifdef STANDALONE
return F${sys}_${odeo} (x, u, t, par);
#else
static octave_value_list args, f;
args (0) = octave_value (x);
args (1) = octave_value (u);
args (2) = octave_value (t);
args (3) = octave_value (par);
f = feval ("${sys}_${odeo}", args, 1);
return f(0).${vector_value} ();
#endif
}
EOF
if [ "$method" != "implicit" ];then
cat <<EOF >> $filename
inline ColumnVector
mtt_euler (ColumnVector &x,
const ColumnVector &dx,
const double &ddt,
const int &nx,
const ColumnVector &open_switches)
{
#ifdef STANDALONE
return Fmtt_euler (x, dx, ddt, nx, open_switches);
#else
static octave_value_list args, f;
args (0) = octave_value (x);
args (1) = octave_value (dx);
args (2) = octave_value (ddt);
args (3) = octave_value ((double)nx);
args (4) = octave_value (open_switches);
f = feval ("mtt_euler", args, 1);
return f(0).${vector_value} ();
#endif
}
EOF
else
cat <<EOF >> $filename
inline ColumnVector
mtt_implicit (ColumnVector &x,
ColumnVector &dx,
Matrix &AA,
ColumnVector &AAx,
const double &ddt,
const int &nx,
const ColumnVector &open_switches)
{
#ifdef STANDALONE
return Fmtt_implicit (x, dx, AA, AAx, ddt, nx, open_switches);
#else
static octave_value_list args, f;
args (0) = octave_value (x);
args (1) = octave_value (dx);
args (2) = octave_value (AA);
args (3) = octave_value (AAx);
args (4) = octave_value (ddt);
args (5) = octave_value ((double)nx);
args (6) = octave_value (open_switches);
f = feval ("mtt_implicit", args, 1);
return f(0).${vector_value} ();
#endif
}
inline Matrix
mtt_smxa (ColumnVector &x,
ColumnVector &u,
const double &t,
ColumnVector &par)
{
#ifdef STANDALONE
return F${sys}_smxa (x, u, t, par);
#else
static octave_value_list args, f;
args (0) = octave_value (x);
args (1) = octave_value (u);
args (2) = octave_value (t);
args (3) = octave_value (par);
f = feval ("${sys}_smxa", args, 1);
return f(0).matrix_value ();
#endif
}
inline ColumnVector
mtt_smxax (ColumnVector &x,
ColumnVector &u,
const double &t,
ColumnVector &par)
{
#ifdef STANDALONE
return F${sys}_smxax (x, u, t, par);
#else
static octave_value_list args, f;
args (0) = octave_value (x);
args (1) = octave_value (u);
args (2) = octave_value (t);
args (3) = octave_value (par);
f = feval ("${sys}_smxax", args, 1);
return f(0).${vector_value} ();
#endif
}
EOF
fi
cat <<EOF >> $filename
inline void
mtt_write (const double &t,
ColumnVector &x,
ColumnVector &y,
const int &nrows,
const bool dump_data = false,
ostream &file = cout)
{
static Matrix data;
static int row;
if (dump_data)
{
Matrix written_data = data.extract (0, 0, row-1, data.cols ()-1);
save_ascii_data_for_plotting (file, written_data, "MTT_data");
return;
}
const int nx = x.length (), ny = y.length ();
register int col = 0;
if (0 == row)
data = Matrix (nrows, 1+ny+1+nx, 0.0);
data.elem (row, col) = t;
for (register int i = 0; i < ny; i++)
data.elem (row, ++col) = y.elem (i);
data.elem (row, ++col) = t;
for (register int i = 0; i < nx; i++)
data.elem (row, ++col) = x.elem (i);
row++;
if (nrows == row)
{
#ifdef STANDALONE
save_ascii_data_for_plotting (file, data, "MTT_data");
// cout << data << endl;
#else // ! STANDALONE
set_global_value ("MTT_data", data);
#endif
}
}
#ifdef STANDALONE
void dump_data (ostream &file)
{
ColumnVector null (0.0);
mtt_write (0.0, null, null, 0, true, file);
}
void set_signal_handlers (void);
void handle_signal (int signum)
{
// handle some signals to ensure data is written.
psignal (signum, "# Writing data to MTT.core");
ofstream corefile ("MTT.core");
dump_data (corefile);
switch (signum)
{
case SIGFPE:
// Intel chips do not raise SIGFPE for DIVZERO :-(
raise (SIGABRT);
break;
case SIGINT:
break;
case SIGQUIT:
signal (SIGQUIT, SIG_DFL);
raise (SIGQUIT);
break;
default:
cerr << "# Warning: make_ode2odes needs updating!" << endl;
signal (signum, SIG_DFL);
raise (signum);
break;
}
corefile.close ();
set_signal_handlers ();
}
void set_signal_handlers (void)
{
signal (SIGFPE, handle_signal);
signal (SIGINT, handle_signal);
signal (SIGQUIT, handle_signal);
}
int main (void) {
set_signal_handlers ();
#else
DEFUN_DLD (${sys}_ode2odes, args, ,
"Octave ode2odes representation of system with $method integration method
Usage: ${sys}_ode2odes (x, par, simpar)
")
{
static octave_value_list retval;
#endif // STANDALONE
static ColumnVector x;
static ColumnVector par;
static Octave_map simpar;
static double
first = 0.0,
dt = 0.0,
last = 0.0,
stepfactor = 0.0;
#ifndef STANDALONE
int nargin = args.length ();
switch (nargin)
{
case 3:
first = args (2).map_value ()["first"].double_value ();
dt = args (2).map_value ()["dt"].double_value ();
last = args (2).map_value ()["last"].double_value ();
stepfactor = args (2).map_value ()["stepfactor"].double_value ();
par = args (1).${vector_value} ();
x = args (0).${vector_value} ();
break;
case 2:
first = mtt_simpar ()["first"].double_value ();
dt = mtt_simpar ()["dt"].double_value ();
last = mtt_simpar ()["last"].double_value ();
stepfactor = mtt_simpar ()["stepfactor"].double_value ();
par = args (1).${vector_value} ();
x = args (0).${vector_value} ();
break;
case 1:
first = mtt_simpar ()["first"].double_value ();
dt = mtt_simpar ()["dt"].double_value ();
last = mtt_simpar ()["last"].double_value ();
stepfactor = mtt_simpar ()["stepfactor"].double_value ();
par = mtt_numpar ();
x = args (0).${vector_value} ();
break;
case 0:
#endif // ! STANDALONE
first = mtt_simpar ()["first"].double_value ();
dt = mtt_simpar ()["dt"].double_value ();
last = mtt_simpar ()["last"].double_value ();
stepfactor = mtt_simpar ()["stepfactor"].double_value ();
par = mtt_numpar ();
x = mtt_state (par);
#ifndef STANDALONE
break;
default:
usage("${sys}_ode2odes (x par simpar)", nargin);
error("aborting.");
}
#endif // STANDALONE
static ColumnVector dx (MTTNX);
static ColumnVector u (MTTNU);
static ColumnVector y (MTTNY);
static Matrix AA (MTTNX, MTTNX);
static ColumnVector AAx (MTTNX);
static ColumnVector open_switches (MTTNX);
register double t = 0.0;
const double ddt = dt / stepfactor;
const int ilast = static_cast<int> (round ((last - first) / ddt)) + 1;
const int nrows = static_cast<int> (round ((last - first) / dt)) + 1;
for (register int i = 0; i < MTTNU; i++)
{
u (i) = 0.0;
}
for (register int j = 0, i = 1; i <= ilast; i++)
{
y = mtt_${odeo} (x, u, t, par);
u = mtt_input (x, y, t, par);
if (0 == j)
{
mtt_write (t, x, y, nrows);
}
dx = mtt_${ode} (x, u, t, par);
EOF
if [ "$method" = "implicit" ]; then
cat <<EOF >> $filename
AA = mtt_smxa (x, u, ddt, par);
AAx = mtt_smxax (x, u, ddt, par);
EOF
fi
## Common stuff
cat <<EOF >> $filename
open_switches = mtt_logic (x, u, t, par);
x = $algorithm;
t += ddt;
j++;
j = (j == static_cast<int> (stepfactor)) ? 0 : j;
}
#ifdef STANDALONE
return 0;
#else
retval (0) = octave_value (y);
retval (1) = octave_value (x);
retval (2) = octave_value (t);
return (retval);
#endif // STANDALONE
}
EOF
}
case ${lang} in
m)
make_m
;;
cc)
make_cc
;;
*)
echo Language ${lang} is not supported
esac