#! /bin/sh
######################################
##### Model Transformation Tools #####
######################################
# Bourne shell script: cse2smx_lang
# Constrained-state equation to state matrices with x vector
# Used for implicit integration
# Copyright (C) 2000 by Peter J. Gawthrop
## Modified from eailier version
# Args
## Now default to matrix form
matrix='yes'
while [ -n "`echo $1 | grep '^-'`" ]; do
case $1 in
-noglobals)
noglobals='-noglobals';
;;
-parameters)
parameters='-parameters';
;;
-matrix)
matrix='yes';
;;
-optimise_global | -optimise_local )
optimise='LOAD SCOPE; ON GENTRANOPT;';
iname='INAME mtt_o;';
;;
-fixcc )
fix_mtt_pow='FOR ALL x,y LET x^y = mtt_pow(x,y);'
operator='OPERATOR mtt_pow;'
blurb2='fixing c and cc code';
unfix_mtt_pow='FOR ALL x,y CLEAR x^y;'
unfix_pow='FOR ALL x,y LET pow(x,y) = x^y;';
;;
*)
echo $1 is an unknown option
exit;;
esac
shift
done
## Representation
if [ -z $1 ]; then
echo 'usage [options] cse2smx_lang system [smx|smxa|smxax]'
exit
fi
# Language
if [ -n "$3" ]; then
lang=$3
else
lang="m"
fi
## Representation
if [ -z $2 ]; then
rep=smx;
else
rep=$2
fi
case $rep in
smx)
nrep=0;
out='[mtta,mttax]';
nmatrix=1;
;;
smxa)
nrep=1;
if [ -n "$matrix" ]; then
blurb="in matrix form";
nmatrix=1;
else
blurb="in vector form";
nmatrix=0;
fi
out='mtta';
;;
smxax)
nrep=2
out='mttax';
nmatrix=0;
;;
*) echo Representation $2 not recognised;
exit;;
esac
# Inform user
if [ -n "$optimise" ]; then
blurbopt=' using code optimisation'
fi
echo Creating $1_$rep.$lang $blurb $blurbopt $blurb2
#echo Creating $1_smxx.$lang
#echo Creating $1_smxtx.$lang
# Remove the old log file
rm -f cse2smx_r.log
rm -f $1_smx.$lang
rm -f $1_smxx.$lang
rm -f $1_smxtx.$lang
rm -f $1_$rep.body
# Use reduce to accomplish the transformation
$SYMBOLIC << EOF >cse2smx_lang.log
${operator} %% Define mtt_pow if needed
lang := $lang;
in "$1_subs.r";
in "$1_def.r";
in "$1_cse.r";
in "$1_cr.r";
clear mttx; % Dont need this now - use mkid instead
OFF Echo;
% Load the general translator package
LOAD GENTRAN;
GENTRANLANG!* := 'Pascal;
ON GENTRANSEG; % Segmentation
OFF GENDECS; % No declarations
MAXEXPPRINTLEN!* := 80;
TEMPVARNUM!* := 1;
TEMPVARNAME!* := 'mtt_tmp;
%% '
% Optimise
$optimise
ON GETDECS; % Create decrarations automatically
DEFTYPE!* := 'REAL; % and default to real
%%% The following is a bug fix from ZIB to fix
%%% segmentation violation problem
symbolic procedure maxtype type;
% ------------------------------------------------------------------- ;
% A type may be a pair (l u) wher l is the minimum type for a variable;
% and u is the maximum type. This procedure returns the maximum type.;
% ------------------------------------------------------------------- ;
if atom type
then type
else if pairp cdr type then cadr type else car type;
% This fix handles the case that the type is a list with ONE entry.
% Should never happen ?? W.N.
%%%%%% End of bug fix
%Set up output according to the language.
OFF NAT;
GENTRANOUT "$1_$rep.body";
% Set up output according to the language.
IF (lang = r) THEN
BEGIN
write "matrix mtta(", mttnx, ",", mttnx, ");";
write "matrix mttb(", mttnx, ",", mttnu, ");";
write "matrix mttc(", mttny, ",", mttnx, ");";
write "matrix mttd(", mttny, ",", mttnu, ");";
END;
${unfix_pow} %% set pow(x,y) to x^y
% find MTTA : the A matrix
FOR i := 1:MTTNx DO
BEGIN
mttAAx_i := 0;
FOR j := 1:MTTNx DO
BEGIN
${unfix_mtt_pow} %% Revert to x^y form
ij := i + MTTNx*(j-1);
xj := mkid(mttx,j);
a_ij := df(MTTEdx(i,1), xj, 1);
aa_ij := MTTE(i,j) - mttt*a_ij;
${fix_mtt_pow} %% set x^y to mtt_pow(x,y)
IF (aa_ij NEQ 0) THEN
IF ($nmatrix EQ 1) THEN
BEGIN
%% Write a with full indexing
$iname
GENTRAN mtta(i,j) ::=: aa_ij;
END;
IF (($nmatrix EQ 0) AND ($nrep EQ 1)) THEN
BEGIN
%% Write a with vector indexing
$iname
GENTRAN mtta(ij) ::=: aa_ij;
END;
mttAAx_i := mttAAx_i + aa_ij*xj;
END;
IF (mttAAx_i NEQ 0) THEN
IF (($nrep EQ 0) OR ($nrep EQ 2)) THEN
BEGIN
$iname
GENTRAN mttax(i) ::=: mttAAx_i;
END;
END;
%Shut the output according to the language.
GENTRANSHUT "$1_$rep.body";
EOF
fix_broken_numbers ( ) {
sed -e "/[0-9.]$/ N" -e "s/\([0-9.]\)[\n\t\ ]*\([0-9]\)/\1\2/g"
}
refix_pow() {
sed 's/mtt_pow/pow/g'
}
if [ "$lang" = "m" ]; then
# lang_header $noglobals $parameters $1 $rep m 'mttx,mttu,mttt,mttpar' $out > $1_$rep.m
mtt_header $1 $rep m > $1_$rep.m
cat $1_$rep.body | fix_broken_numbers | refix_pow | mtt_p2m >> $1_$rep.m
echo "## END Code" >> $1_$rep.m
echo "endfunction" >> $1_$rep.m
fi
# Now invoke the standard error handling.
mtt_error_r cse2smx_lang.log