File mttroot/mtt/bin/trans/mtt_m2p artifact 5aa349fe2c part of check-in f9bcb979da


#! /bin/sh


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

# Bourne shell script: mtt_m2p
# Reduce octave 2 Pascal converter for MTT   
# P.J.Gawthrop July 1998
# Copyright (c) P.J.Gawthrop 1998

###############################################################
## Version control history
###############################################################
## $Id$
## $Log$
## Revision 1.67  2002/04/18 17:02:15  gawthrop
## foo=zeros(3,1) translated as zero_state(foo,3)
##
## Revision 1.66  2001/03/30 15:13:58  gawthrop
## Rationalised simulation modes to each return mtt_data
##
## Revision 1.65  2001/02/09 02:56:46  geraint
## Translate some binary operators
## Allows use of ! in logic.txt
##
## Revision 1.64  2001/02/03 14:00:01  gawthrop
## Geraint's temp. variable patch applied
##
## Revision 1.63  2000/12/04 08:24:29  peterg
## Added swithc logic declarations
##
## Revision 1.62  2000/12/03 17:15:18  peterg
## *** empty log message ***
##
## Revision 1.61  2000/11/10 14:46:53  peterg
## More fixes to avoid interpering variables as funs - basicly all
## functions now have at least ()
##
## Revision 1.60  2000/11/10 09:38:30  peterg
## Got rid of sys_name functions with no ()
##
## Revision 1.59  2000/11/10 09:29:31  peterg
## Changed the name regexp to be at least 3 characters long
##  - avoids problem translating som state files - but needs more work
##
## Revision 1.58  2000/10/17 09:54:29  peterg
## replaced switchopen by logic
##
## Revision 1.57  2000/10/15 10:35:35  peterg
## Fixed _input.p header
##
## Revision 1.56  2000/10/14 09:14:24  peterg
## *** empty log message ***
##
## Revision 1.55  2000/10/11 09:06:17  peterg
## New csex rep (uses scope optimisation)
##
## Revision 1.54  2000/09/30 14:10:06  peterg
## Zap lines containing "Remove in mtt_m2p"
##
## Revision 1.53  2000/08/24 17:10:59  peterg
## New dummy variables mtt_o (for optimisation), mtt_s (for segmentation)
##
## Revision 1.52  2000/08/24 08:30:45  peterg
## *** empty log message ***
##
## Revision 1.51  2000/08/01 12:25:24  peterg
## Some changes to include files
##
## Revision 1.50  2000/05/19 17:46:41  peterg
## New version of state with par argument
##
## Revision 1.49  2000/05/18 09:45:45  peterg
## Fixed missing ;
##
## Revision 1.48  2000/05/18 09:39:38  peterg
## Removed fifth argument from _input
##
## Revision 1.47  2000/05/16 18:56:03  peterg
## Upgraded for new simulation approach - uses data files to input
## parameters -- no more argv stuff
##
## Revision 1.46  2000/05/16 11:59:01  peterg
## Updated for new data file parameter/state update
##
## Revision 1.45  2000/05/13 13:16:52  peterg
## Matrix initialisation for smxa
##
## Revision 1.44  2000/05/13 11:52:16  peterg
## A now matrix in smxa rep
##
## Revision 1.43  2000/05/11 19:35:16  peterg
## Major revisions for new paprameter passing versions
##
## Revision 1.42  2000/04/18 11:11:44  peterg
## mtt_parameters ---> mttpar
## mtt_n_parameters ---> mttnpar
##
## Revision 1.41  2000/04/18 10:13:43  peterg
## Getargs now after numpar file
##
## Revision 1.40  2000/04/07 19:09:04  peterg
## New smxa and smxax reps
##
## Revision 1.39  2000/04/07 13:38:13  peterg
## New mtt_getsize to replace bc
##
## Revision 1.38  2000/04/07 13:24:41  peterg
## Modified for smxa and smxax
##
## Revision 1.37  2000/04/07 08:17:37  peterg
## Added mttpar to the arg list of cse and cseo
##
## Revision 1.36  1999/11/29 06:49:26  peterg
## Upped number of mtt_tnn
##
## Revision 1.35  1999/11/15 22:47:17  peterg
## Generates method-specific code for the ode2odeso rep.
##
## Revision 1.34  1999/10/28 05:08:48  peterg
## Added elseif
##
## Revision 1.33  1999/09/17 04:25:01  peterg
## END --> END; in translation
##
## Revision 1.32  1999/08/29 06:54:42  peterg
## Added code (mtt_parameters, get args etc) to allow arguments to the
## a.out file
##
## Revision 1.31  1999/08/02 13:40:03  peterg
## Added zero-state and zero_input to include list
## Removed zero_matrix
##
## Revision 1.30  1999/04/20 06:16:46  peterg
## Removed calls to _switch.m
##
## Revision 1.29  1999/04/02 06:27:55  peterg
## Modified for new implicit method with swoitches
##
## Revision 1.28  1999/02/17 02:59:54  peterg
## Added -q switch to mtt
##
## Revision 1.27  1999/02/16 21:56:52  peterg
## Now gets standard include files directly from source,
##
## Revision 1.26  1999/02/16 21:43:54  peterg
## Revises smx generation.
##
## Revision 1.25  1999/02/16 04:38:09  peterg
## Now forces creation of _smx file if METHOD=IMPLICIT in simpar.txt
##
## Revision 1.24  1998/11/18 16:56:15  peterg
## Now handles comments after IFS
##
## Revision 1.23  1998/11/18 14:38:01  peterg
## Now convert ALL globals to VAR .. the last one isn't repeated now
##
## Revision 1.22  1998/11/17 17:39:45  peterg
## Put _smx include at end of list (?????)
##
## Revision 1.21  1998/11/17 17:26:11  peterg
## Put sign.p first
##
## Revision 1.20  1998/10/01 16:01:09  peterg
## Now does implicit integration with switches
##
## Revision 1.19  1998/09/29 15:37:18  peterg
## Declare mttINPUT
##
## Revision 1.18  1998/08/27 08:55:40  peterg
## Mods to integration methods
##
## Revision 1.17  1998/08/27 07:38:40  peterg
## About to change to new integration (Euler/Implicit only)
##
## Revision 1.16  1998/08/19 08:46:00  peterg
## Now translates ; % to #
##
## Revision 1.15  1998/08/15 13:46:01  peterg
## Included new sparse update routines
##
## Revision 1.14  1998/08/12 15:21:12  peterg
## Added type definition for the SVD procedures
##
## Revision 1.13  1998/08/11 09:32:07  peterg
## Added comments at procedure begin and end.
##
## Revision 1.12  1998/07/30 11:30:42  peterg
## Included zeros function
##
## Revision 1.11  1998/07/29 14:18:34  peterg
## Reorganised rep dependednt output
##
## Revision 1.10  1998/07/27 20:26:15  peterg
## Added new VARs mttWSTEPS, MTTWMIN,mttWMAX
##
## Revision 1.9  1998/07/27 17:20:42  peterg
## Allow , between ()
##
## Revision 1.8  1998/07/26 19:38:17  peterg
## Replaced t0..t9 by mtt_temp0..
##
## Revision 1.7  1998/07/25 20:06:23  peterg
## Does the mtt_update function
##
## Revision 1.6  1998/07/25 16:59:40  peterg
## Give other procedures local i,j vars.
##
## Revision 1.5  1998/07/25 15:06:17  peterg
## Added DDT VAR
##
## Revision 1.4  1998/07/25 15:05:54  peterg
## DD
##
## Revision 1.3  1998/07/25 14:03:30  peterg
## Added () to [] conversion when the variable is i j k or an integer or
## combination
##
## Revision 1.2  1998/07/25 12:39:57  peterg
## begin on same line as for and if
##
## Revision 1.1  1998/07/25 09:42:52  peterg
## Initial revision
##
###############################################################



# Set up variables
args=`echo $1 | sed 's/_/ /' | sed 's/\./ /'`
Sys=`echo $args  | gawk '{print $1}'`
sys=`echo $Sys  | gawk '{print tolower($1)}'`
rep=`echo $args  | gawk '{print $2}'`
Sys_rep="$Sys""_""$rep"
Sys_smx="$Sys""_smx"
Sys_smxp="$Sys""_smx.p"
Filename="$Sys""_""$rep.p"
filename="$sys""_""$rep.p"

Method=$2; # The integration method
Stdin=$3;  # Using standard input

if [ -n "$Method" ]; then
  MethodBlurb=" with $Method integration method"
fi

if [ -n "$Stdin" ]; then
   StdinBlurb=" using standard input"
fi

# Inform user
  echo Creating $Filename $MethodBlurb $StdinBlurb 

# Find system constants
Nx=`mtt_getsize $Sys x` # States
Nxx=`mtt_getsize $Sys xx` # States x States
Nu=`mtt_getsize $Sys u` # Inputs 
Ny=`mtt_getsize $Sys y` # Inputs 
Npar=`wc -l $Sys\_sympar.txt | gawk '{print $1}'`


#if [ "$rep" = "simpar" ]; then
#    mtt -q $Sys smx p
#fi

# Heading
(case $rep in
    state)
        echo "PROCEDURE $Sys_rep(VAR mttx : StateVector; 
                                     mttpar : ParameterVector);"
        ;;
    numpar)
        echo "PROCEDURE $Sys_rep(VAR mttpar : ParameterVector);"
        ;;
    simpar)
        echo "PROCEDURE $Sys_rep(VAR mttsimpar : SimulationParameters);"
        ;;
    input)
        echo "PROCEDURE $Sys_rep(VAR mttu : InputVector;"
	echo "                       mttx : StateVector;"
	echo "                       mtty : OutputVector;"
	echo "                       mttt : REAL;"
	echo "                       mttpar : ParameterVector);"
	;;
    logic)
	echo "PROCEDURE $Sys_rep(VAR mttopen : StateVector;"
	echo "                       mttx : StateVector;"
	echo "                       mttu : InputVector;"
	echo "                       mttt : REAL;"
	echo "                       mttpar : ParameterVector);"
	;;
    ode)
	echo "PROCEDURE $Sys_rep(VAR mttdx: StateVector;"
	echo "                       mttx : StateVector;"
	echo "                       mttu : InputVector;"
	echo "                       mttt : REAL;"
	echo "                       mttpar : ParameterVector);"
	;;
    odeo)
	echo "PROCEDURE $Sys_rep(VAR mtty : OutputVector;"
	echo "                       mttx : StateVector;"
	echo "                       mttu : InputVector;"
	echo "                       mttt : REAL;"
	echo "                       mttpar : ParameterVector);"
	;;
    csex)
	echo "PROCEDURE $Sys_rep(VAR mttedx: StateVector;"
	echo "                       mttx : StateVector;"
	echo "                       mttu : InputVector;"
	echo "                       mttt : REAL;"
	echo "                       mttpar : ParameterVector);"
	;;
    cseo)
	echo "PROCEDURE $Sys_rep(VAR mtty : OutputVector;"
	echo "                       mttx : StateVector;"
	echo "                       mttu : InputVector;"
	echo "                       mttt : REAL;"
	echo "                       mttpar : ParameterVector);"

	;;
    smx )
	echo "PROCEDURE $Sys_rep(VAR mtta       : StateMatrix;"
	echo "                   VAR mttax      : StateVector;"
	echo "                       mttx       : StateVector;"
	echo "                       mttu       : InputVector;"
	echo "                       mttdt      : REAL;"
	echo "                       mttpar     : ParameterVector);"
	;;
    smxa )
	echo "PROCEDURE $Sys_rep(VAR mtta       : StateMatrix;"
	echo "                       mttx       : StateVector;"
	echo "                       mttu       : InputVector;"
	echo "                       mttt      : REAL;"
	echo "                       mttpar     : ParameterVector);"
	;;
    smxax )
	echo "PROCEDURE $Sys_rep(VAR mttax      : StateVector;"
	echo "                       mttx       : StateVector;"
	echo "                       mttu       : InputVector;"
	echo "                       mttt      : REAL;"
	echo "                       mttpar     : ParameterVector);"
	;;
    ode2odes)
	echo "PROGRAM $Sys_rep;"
        echo ""
	echo "CONST"
	echo "    MTT_MaxParameters = 100;"
	echo "    MTT_Npar = $Npar;"
	echo "    MTT_Nx = $Nx;"
        echo ""
	echo "TYPE"
	echo "    StateVector  = ARRAY[1..$Nx] OF REAL;"
	echo "    InputVector  = ARRAY[1..$Nu] OF REAL;"
	echo "    OutputVector = ARRAY[1..$Ny] OF REAL;"
	echo "    ParameterVector = ARRAY[1..$Npar] OF REAL;"
	echo "    SimulationParameters = RECORD"
	echo "    dt, first, input, last, stepfactor, wmax, wmin, wsteps: REAL"
	echo "                           END;"
	echo "    StateMatrix  = ARRAY[1..$Nx,1..$Nx] OF REAL;"
	echo "    StateMatrixVector  = ARRAY[1..$Nxx] OF REAL;"
	echo "    glnparray    = StateVector;"
	echo "    glmparray    = StateVector;"
	echo "    glnarray     = StateVector;"
	echo "    glnpbynp     = StateMatrix;"
	echo "    glmpbynp     = StateMatrix;"
	## echo "    IntegrationMethod = 1..4;"
	echo ""
	echo "VAR"
	echo "    simpar                      : SimulationParameters;"
        echo "    t,ddt                       : REAL;"
	echo "    x,x0,dx,AAx                 : StateVector;"
	echo "    mttx,mttdx,mttAAx,mttedx    : StateVector;"
	echo "    u,mttu                      : InputVector;"
	echo "    y,mtty                      : OutputVector;"
	echo "    par                         : ParameterVector;"
	echo "    mttpar                      : ParameterVector;"
	echo "    mttnpar                     : INTEGER;"
	echo "    AA,mtte                     : StateMatrix;"
	echo "    MTTi,MTTj,it,iLast: INTEGER;"
	##echo "    mttSTEPFACTOR,mttWSTEPS,mttSTEPS,mttINPUT : INTEGER;"
	## echo "    mttMETHOD : IntegrationMethod;"
	echo "    open_switches  : StateVector;"
	echo "    numparfile, statefile, simparfile  : TEXT;"
        strip_comments <${Sys}_switch.txt |\
          gawk '{printf("%s_logic : REAL;\n", tolower($1))}' 
	echo ""
        mtt_txt2declare $Sys sympar p
        mtt_txt2declare $Sys struc p
        ;;
#    switchopen)
#	echo "PROCEDURE $Sys_rep(VAR open : StateVector; mttx : StateVector);"
#	echo "VAR"
#	echo "    MTTi,MTTj :  INTEGER;"
#	;;
    *)	echo "PROCEDURE $Sys_rep;"
	echo "VAR"
	echo "    MTTi,MTTj :  INTEGER;"
        ;;
esac) > $Filename

cat<<EOF >> $Filename

{*** System $Sys, rep $rep, language Pascal, file $Filename ***}
{*** Translated by MTT from $Sys_rep.m on `date` ***}

EOF

# Regexps
  name="[a-zA-Z0-9_]*"
  fun_name="$Sys\_$name"
  mttfun_name=$name
  tab='	'
  space="[ $tab]*"
  spaces="[ $tab][ $tab]*"
  non_space="[^ ]*"
  args='[a-zA-Z0-9,._"]*'

# Body	
fix_operators ()
{
    m_neq="(\!\=)|(\~\=)"
    m_not="\!"
    m__eq="\=\="

    p_neq="\<\>"
    p_not="NOT\ "
    p__eq="\="

    sed "s/$m_neq/$p_neq/g"	|\
    sed "s/$m_not/$p_not/g"	|\
    sed "s/$m__eq/$p__eq/g"
}

cat $Sys_rep.m |\
grep -v 'Remove in mtt_m2p'  |\
grep -v '^[ ]*function'  |\
grep -v '^[ ]*endfunction'  |\
grep -v 'MTT_data'  |\
sed "s/^$space%/#/" | sed "s/\([;)]$space\)%/\1#/" |\
gawk -F# '{printf("%s",$1) 
          if (NF>1) printf("{* %s *}", $2)
          printf("\n") 
         }' |\
sed "s/$space\[\($non_space\)\]$spaces=$spaces\($fun_name\)(\($args\))/\2(\1,\3)/" |\
sed "s/$space\[\($non_space\)\]$spaces=$spaces\($mttfun_name\)(\($args\))/\2(\1,\3)/" |\
sed "s/$space\[\($non_space\)\]$spaces=$spaces\($mttfun_name\)/\2(\1)/" |\
sed "s/$space\($non_space\)$spaces=${spaces}zeros(\([0-9]*\),1)/zero_state(\1,\2)/" |\
sed "s/$space\($non_space\)$spaces=$spaces\($fun_name\)(\($args\))/\2(\1,\3)/" |\
sed "s/,)/)/" |\
fix_operators |\
gawk '
function printvar(Name,N) {
  if (N<1) return;
  width = 10;
  kk = 0; 
  for (k=1;k<=N;k++) {
    printf("mtt%s%i", Name, k);
    if (k==N)
      printf(" : REAL;\n")
    else
      printf(", "); 
    kk++;
    if (kk==width){printf("\n"); kk=0}
  }
}
BEGIN{
  comment_regexp = "{"
  doing_header = 0
  doing_globals = 0
  N_tmp = 100;
  inc ="$I"
}
{
  if ($1=="global") 
    doing_globals = 1
  else{ 
    if (doing_globals==1){
      global[++i]=$1; 
      if (match($0,";")==0){
      }
      else{
        doing_globals = 0
        doing_header = 1
      }
    }
    else 
    {
      if (doing_header==1){
        if (rep=="ode2odes"){
          printf("\n{%s $MTTPATH/trans/p/mtt_write.p}\n",inc)
          printf("{%s $MTTPATH/trans/p/mtt_par_update.p}\n",inc)
          printf("{%s $MTTPATH/trans/p/sign.p}\n",inc)
          printf("{%s $MTTPATH/trans/p/mtt_euler.p}\n",inc)
          #printf("{%s $MTTPATH/trans/p/mtt_solve.p}\n",inc)
          printf("{%s $MTTPATH/trans/p/mtt_implicit.p}\n",inc)
          #printf("{%s $MTTPATH/trans/p/zero_matrix.p}\n",inc)
          printf("{%s $MTTPATH/trans/p/zero_input.p}\n",inc)
          printf("{%s $MTTPATH/trans/p/zero_state.p}\n",inc)
          printf("{%s %s_simpar.p}\n",inc,Sys) 
          printf("{%s %s_numpar.p}\n",inc,Sys)
          # printf("{%s $MTTPATH/trans/p/mtt_getargs.p}\n",inc)
          printf("{%s %s_state.p}\n",inc,Sys)
          printf("{%s %s_input.p}\n",inc,Sys)

          if (Method=="euler") {
            printf("{%s %s_ode.p}\n",inc,Sys)
            printf("{%s %s_odeo.p}\n",inc,Sys)
          }
          if (Method=="implicit") {
            printf("{%s %s_csex.p}\n",inc,Sys)
            printf("{%s %s_cseo.p}\n",inc,Sys)
            printf("\n{%s %s_smxa.p}\n",inc,Sys);
            printf("\n{%s %s_smxax.p}\n",inc,Sys);
          }
          printf("{%s %s_logic.p}\n\n",inc,Sys)

          for (k=1;k<=j;k++) printf("%s\n", comment[k])
          printf("\n")
          printf("\nBEGIN{%s}\n", Sys_rep)
          printf("  open(statefile,\"%s_state.dat\");\n", Sys)
          printf("  open(simparfile,\"%s_simpar.dat\");\n", Sys)
          printf("  open(numparfile,\"%s_numpar.dat\");\n", Sys)
        }
        else{
          for (k=1;k<=j;k++) printf("%s\n", comment[k])
          printf("\n")
          printf("VAR \n");
          for (k=1;k<i;k++) printf("  %s,\n",global[k])
          printf("%s : REAL;\n", global[i])
          printvar("x",Nx);
          printvar("u",Nu);
          printvar("y",Ny);
	  if ((rep=="ode")||(rep=="odeo")||(rep=="csex")||(rep=="cseo")||(rep=="smx")||(rep=="smxa")||(rep=="smxax")){
	    printvar("_tmp",N_tmp);
	    printvar("_s",N_tmp);
	  }
          printf("VAR mtt_i, mtt_j : INTEGER;\n");
          #if ( (rep=="smxa")||(rep=="smxax") ) {
          #  printvar("_t",Nt);
          #}
          printf("\nBEGIN{%s}\n", Sys_rep)
          if (rep=="smxa"){
            printf("FOR mtt_i:= 1 to %i DO\n\tFOR mtt_j:= 1 to %i DO\n\tmtta[mtt_i,mtt_j] := 0;\n", Nx,Nx);
          }
          if (rep=="smxax"){
            printf("FOR mtt_i:= 1 to %i DO\n\tmttax[mtt_i] := 0;\n", Nx);
          }
       }
        doing_header = 0;
      }
      if (match($1,comment_regexp)>0){
        if (doing_header==1)
          comment[++j] = $0
        else
          printf("%s\n", $0)
      }
      else {
        if ($1=="if") {
          sub(/==/, "=", $0)
            gsub(/&&/," AND ",$0)
            gsub(/\|\|/," OR ",$0)
          printf("%s THEN BEGIN\n", $0)
        }
        else { 
          #if ((match($1,"mtt_write")>0)&&(length(Stdin)>0)) {
          # sub(/mtt_write/, "if NOT eof THEN mtt_write");
          #}
          if ($1=="for"){
            if (($2=="it")&&(length(Stdin)>0)){
	      printf("WHILE NOT eof DO BEGIN {Integration loop}\n")
            }
            else {
              sub(/:/," TO ",$0)
              sub(/=/,":=",$0)
              printf("%s DO BEGIN\n", $0)
            } 
          }
          else{
            sub(/=/,":=",$0)
            sub(/endif/,"END;{IF}",$0)
            sub(/endfor/,"END;{FOR}",$0)
            sub(/elseif/,"END ELSEIF BEGIN",$0)
            sub(/else/,"END ELSE BEGIN",$0)
            gsub(/\^/,"**",$0)
            gsub(/&&/," AND ",$0)
            gsub(/\|\|/," OR ",$0)
            printf("%s\n",$0)
          }
        }
      }
    }
  }
}
END{
  if (rep=="def"){
    printf("EULER = 1,\n")
    printf("IMPLICITL = 2;\n")
    printf("IMPLICIT = 3;\n")
    }
    else
      if (rep=="ode2odes")
                printf("END{%s}.\n", Sys_rep)
      else
        printf("END{%s};\n", Sys_rep)
}' Sys=$Sys sys=$sys Sys_rep=$Sys_rep rep=$rep \
   Nx=$Nx Nu=$Nu Ny=$Ny Method=$Method Stdin=$Stdin |\
sed 's/\\$//'    |\
sed 's/(\([ijk0-9,]*\))/\[\1\]/g'    |\
sed 's/(\(MTT[ijk0-9],[0-9]*\))/\[\1\]/g' |\
sed 's/(\([0-9]*,MTT[ijk0-9]\))/\[\1\]/g' |\
sed 's/(\(MTT[ijk0-9],MTT[ijk0-9]\))/\[\1\]/g' |\
sed 's/(\(MTT[ijk0-9,]*\))/\[\1\]/g'  |\
sed 's/switcha(mttAA,/switcha(/g'   |\
sed 's/switch(MTTx,/switch(/g'  |\
sed 's/if nargin<[1-9] THEN//'  |\
sed 's/if nargin>[0-9] THEN//'  \
>> $Filename

# p2c doesn't like mixed case filenames!
#if [ "$Filename" != "$filename" ]; then
#  echo Creating $filename
#  cp -f $Filename $filename
#fi

if [ "$rep" = "ode2odes" ]; then
    # Explicitly include files
    mtt_pinclude $Filename>junk.p
    mv junk.p $Filename
fi





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