File mttroot/mtt/bin/trans/make_ode2odes artifact 5dd9cf654b part of check-in 30eac5fc49


#! /bin/sh

     ###################################### 
     ##### Model Transformation Tools #####
    ######################################

###############################################################
## Version control history
###############################################################
## $Id$
## $Log$
## 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>

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 aborting = false)
{
  static Matrix data;
  static int row;

  if (aborting)
    {
       Matrix written_data = data.extract (0, 0, row-1, data.cols ()-1);
       save_ascii_data_for_plotting (cout, written_data, "MTT_data");
    }

  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 (cout, data, "MTT_data");
//    cout << data << endl;
#else // ! STANDALONE
  set_global_value ("MTT_data", data);
#endif
    }
}

#ifdef STANDALONE
void handle_sigfpe (int i)
#ifdef __GNUC__
__attribute__ ((noreturn));
void handle_sigfpe (int i)
#endif // __GNUC__
{
  ColumnVector null (0.0);
  cerr << "Error: Caught floating point exception ..." << endl
       << " ...   writing data to standard output ..." << endl;
  mtt_write (0.0, null, null, 0, true);
  cerr << " ...   aborting." << endl;
  abort ();
}

int main (void) {
  signal (SIGFPE, handle_sigfpe);
#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


MTT: Model Transformation Tools
GitHub | SourceHut | Sourceforge | Fossil RSS ]