(*                MEXTools



           Techno-Sciences, Inc.
           10001 Derekwood Lane, Suite 204
           Lanham, MD 20706
           (301) 577-6000
           
           
Copyright © 1997, 1998 Techno-Sciences Incorporated
All Rights Reserved  

7/28/99- C.A. Teolis   
	1. add compiler directive "#include \"linsolv.c\" to all c code generated
		from CreateModelMEX
	2. using compiler conditional statements #ifdef MATLAB_MEX_FILE 
		c code is generated that uses double and int for mex files and
		real_T and int_T for dSpace files.  Some of the function parameters
		have also been changed to const for the dSpace versions as indicated
		in the dSpace Real-Time Interface to Simulink 2 users guide.     
     
           
*)
spell1 = (Head[General::spell1] === $Off);
spell = (Head[General::spell] === $Off);
Off[General::spell1];
Off[General::spell]; 



BeginPackage["ProPac`MEXTools`",{"Utilities`FilterOptions`"}]

(* ********************************************************************** *)
(* ********************************************************************** *)


(* Function Usage Statements *)

MEXTools::usage="
The basic functions available in MEXTools are\n
\n
CreateModelMEX, CreateControllerMEX,\n
\n
In addition, the following utility functions are available\n
\n
FindMostFrequentTerms,SinCosPowerReplaceToo,\n
ReduceFLOPSToo,ReplaceVariablesStr.
"

CreateMEXFile::usage = 
"To create MEX-files for use with Simulink 1.2 and earlier.\n
It is no longer supported." 

CreateModelMEX::usage = 
"To create MEX-files for use with Simulink 1.3 and later.\n
CreateModelMEX[p,q,Inputs,Outputs,PassedParams,PassedParamsDimensions,\n
               V,C,Fp,M,MEXFilename] \n
creates a Simulink S-function MEX file for simulation of the equations of\n
motion. The input arguments are:\n
        p,q - lists of the state variables\n
        Inputs - a list of the input variables\n
        Outputs - a list of the desired outputs (state dependent expressions)\n
        PassedParams - a list of parameter names enclosed in double \n
quotation  marks which are designated to be passed to the S-Function from \n
the Matlab workspace during simulation. This list, by default, must always \n
have as its first element the initial state vector name given as X0. Note:\n 
These parameters must appear in the equations of motion expressions defined\n 
by Fp and M and must be scalars (except the initial state vector). In \n
Simulink,  the user must double click on the S-Function model created by\n 
this function and specify this list of parameters on the parameter line of\n 
the form that pops up on the screen. The order of the parameters specified\n
on this line is important. The first parameter must be the initial state\n
name followed by the names of the parameters in the same order that they\n 
appear in PassedParams.\n
        PassedParamsDimensions - a list of lists of the dimensions of the\n 
parameters specified in PassedParams. It should have the form\n
  {{nrow1,ncol1},{nrow2,ncol2},{nrow3,ncol3},...{nrowm,ncolm}}\n
 where m is the length of PassedParams. Note: with the exception of the\n
initial state vector, all must be scalars in this version of the software.\n
        V - kinematic matrix list\n
        Fp - Poincares function\n
        M - the inertia matrix.\n
        MEXFilename - the name of the C Code Simulink MEX file that is\n
created (it can contain path information)."

CreateMEX::usage = 
"To create MEX-files for use with Simulink 1.2 and earlier.\n
It is no longer supported." 

CreateControllerMEX::usage = 
"To create MEX-files for use with Simulink 1.3 and later.\n
CreateControllerMEX[StateList,Inputs,OutputEquations,StateEquations,PassedParams,\n
                 PassedParamsDimensions,MEXFilename]\n
 Creates a Simulink S-function MEX file for simulation of the equations in\n
 EquationList. The input arguments are:\n
        StateList - lists of the state variables\n
        Inputs - a list of the input variables\n
        OutputEquations - a list of right hand side of the output equations\n 
                  (empty list defaults to using states as outputs)\n
        StateEquations - a list of right hand side of the state equations\n
        PassedParams - a list of parameter names enclosed in double\n
quotation  marks which are designated to be passed to the S-Function from\n 
the Matlab workspace during simulation. This list, by default, must always\n 
have as its first element the initial state vector name given as X0. Note:\n 
These parameters must appear in StateEquations\n
and must be scalars (except the initial state vector). In\n
Simulink,  the user must double click on the S-Function model created by\n
this function and specify this list of parameters on the parameter line of\n 
the form that pops up on the screen. The order of the parameters specified\n
on this line is important. The first parameter must be the initial state\n 
name followed by the names of the parameters in the same order that they\n
appear in PassedParams.\n
        PassedParamsDimensions - a list of lists of the dimensions of the\n 
parameters specified in PassedParams. It should have the form\n
  {{nrow1,ncol1},{nrow2,ncol2},{nrow3,ncol3},...{nrowm,ncolm}}\n
 where m is the length of PassedParams. Note: with the exception of the\n 
initial state vector, all must be scalars in this version of the software.\n
        MEXFilename - the name of the C Code Simulink MEX file that is\n 
created (it can contain path information)"

FindMostFrequentTerms::usage = 
"MostFrequenctTerms = FindMostFrequentTerms[F] returns a list of the 
the most frequently occuring symbol(s) in the expression F"

SinCosPowerReplaceToo::usage =
"{FpNew,MNew,Cnew,Replacements} = SinCosPowerReplaceToo[Fp,M,C] replaces 
all occurences of Sin, Cos, and Power with temporary variables in the 
expressions Fp and M.  The replacement rules used are returned in the rule 
list Replacements."

ReduceFLOPSToo::usage = 
"ExprWithLowestFLOPS = ReduceFLOPSToo[Expr] manipulates Expr so as to 
reduce the number of flops required to evaluate it by collecting
the coefficients of symbols appearing at least twice."

ReplaceVariablesStr::usage =
"Exprstr=ReplaceVariablesStr[Expr,InputList,StateList,PassedParamsList]
Replaces the expressions in Expr that appear in:
InputList with u[1] thru u[Length[InputList]
StateList with x[1] thru u[Length[StateList]
PassedParamsList with pr[0] appended to PassedParamsList[[]] 
Also puts a space after every * so that there is no ambiguity with 
respect to pointer variables and multiplication and converts 
returns the result in ExprStr as a string."

(* ****** Options ****** *)

AssignMaxSize::"Sets the maximum length (in bytes) of a function line\n
in the C Code that is generated. AssignMaxSize -> a positive integer \n
(>= 200) or Infinity"

Options[CreateModelMex]={AssignMaxSize->Infinity};


(*  Functions *)


Unprotect[abs,acos,acosh,Ai,aimag,aint,alog,alog10,amax0,amax1,amin0,amin1,
amod,and,anint,arccos,arccosh,arccot,arccoth,arccsc,arccsch,arcsec,arcsech,arcsin,
arcsinh,arctan,arctanh,asin,asinh,atan,atan2,atanh,bernoulli,Bi,binomial,cabs,
ccos,ceil,cexp,char,Ci,clog,cmplx,collect,conjg,cos,cosh,cot,coth,csc,csch,csin,
csqrt,dabs,dacos,dasin,datan,datan2,dble,dcos,dcosh,ddim,denom,dexp,dilog,dim,
dint,dlog,dlog10,dmax1,dmin1,dmod,dnint,dprod,dsign,dsin,dsinh,dsqrt,dtan,dtanh,
Ei,erf,erfc,euler,evalf,exp,expand,fabs,factor,factorial,false,float,fsolve,GAMMA,iabs,
ichar,idim,idint,idnint,ifix,index,infinity,int,isign,len,lge,lgt,lle,llt,log,log10,lnGAMMA,
map,max,max0,max1,min,min0,min1,mod,mtaylor,nint,not,NULL,num,op,or,pow,Psi,real,RootOf,
round,sec,sech,series,Si,sign,sin,sinh,sngl,solve,sqrt,subs,tan,tanh,true,
Lower,Upper];

Begin["`private`"]

Clear[CreateMEXFile];
CreateMEXFile[p_,q_,Inputs_,Outputs_,PassedParams_,
                 PassedParamsDimensions_,V_,Cp_,Fp_,M_,MEXFilename_]:=
 Print["Simulink 1.2 and earlier is no longer supported."];
SetAttributes[CreateMEXFile,ReadProtected];
SetAttributes[CreateMEXFile,Protected];
SetAttributes[CreateMEXFile,Locked];


(****************************************************************)
(*                      CreateModelMEX                          *)
(****************************************************************)

Clear[CreateModelMEX];
CreateModelMEX[p_,q_,Inputs_,Outputs_,PassedParams_,
                 PassedParamsDimensions_,V_,Cp_,Fp_,M_,MEXFilename_,opts___]:=
 Module[{StateList,PLength,QLength,NumberOfContinuousStates,NumberOfDiscreteStates,
         NumberOfInputs,NumberOfOutputs,NumberOfPassedParams,Vp,PassedParamDefines,
         PassedParamsPointerDefinitionLines,InitialSampleTimeLines,
         HeaderCCodeLines,PassedParamsPointerGetLines,ParameterSizesLines,
         SizeCheckingLines,GlobalSizeInfoFunctionLines,
         InitialConditionFunctionCCodeLines,Ftmp,Mtmp,Ctmp, 
         FReduced,MReduced,CReduced,InitialStateDefinitionLines,
         FunctionReplacements,NumberOfReplacements,ReplStr,
         FunctionCCodeLines,TempVariablesList,TempVariablesListStr,
         TVLength,TempVariablesDeclarationLines,
         BreakVariablesListStr,BreakVariablesDeclarationLines,BVLength,
         CStringFp,BrLines,VpLength,CStringVp,DxLines,CStringM,MString,
         Ar,ArLines,CCString,CStringC,Cr,CrLines,DerivativeFunctionCCodeLines,      
         RHSOutputLines,OutputFunctionCCodeLines,DiscretStateUpdateCCodeLines,sfile,MEXFunctionname,RHSExp,
         DotPosition,ArgumentString,LineSpec=AssignMaxSize/.Flatten[{opts}]/.Options[CreateModelMEX]
         },(
  (*                            *)
  (* Compute problem parameters *)
  (*                            *)
  StateList = Flatten[{p,q}];
  PLength = Length[p];
  QLength=Length[q];
  NumberOfContinuousStates = PLength+QLength;
  NumberOfInputs = Length[Inputs];
  NumberOfOutputs = Length[Outputs];
  NumberOfPassedParams = Length[PassedParams];
  DotPosition=StringPosition[MEXFilename,"."];
  SlashPositions=StringPosition[MEXFilename,"\\"];
  If[Length[DotPosition]==0, 
      MEXFunctionName = MEXFilename,
      MEXFunctionName = StringTake[MEXFilename,StringPosition[MEXFilename,"."][[1,1]]-1]];
  If[Length[SlashPositions]!=0, 
     MEXFunctionName = StringTake[MEXFunctionName,
        {SlashPositions[[Length[SlashPositions],1]]+1,StringLength[MEXFunctionName]}]];

  (*                        *)
  (* Compute Vp = V(q)*p   *)
  (*                        *)
  Vp = ComputeVp[V,p];
 
  Print["...Generating Header Code"];
  (*-------------------------------------------*)
  (*        Create Header C Code Lines         *)
  (*-------------------------------------------*)
  IF[NumberOfPassedParams>1,
     PassedParamsPointers = Map[StringJoin[ToString[PassedParams[[#]]],
           "pr"]&,Range[2,NumberOfPassedParams]];

    PassedParamsPointerDefinitionLines = Flatten[Map[StringJoin["    double ","*",
		    PassedParamsPointers[[#-1]],
                     " = mxGetPr(ssGetArg(S,",
                    ToString[#-1],
                     "));"]&,Range[2,NumberOfPassedParams]]];
 
     PassedParamsPointerDefinitionLinesdSpace = Flatten[Map[StringJoin["    real_T ","*",
		    PassedParamsPointers[[#-1]],
                     " = mxGetPr(ssGetArg(S,",
                    ToString[#-1],
                     "));"]&,Range[2,NumberOfPassedParams]]];

                    
(*     PassedParamsPointerGetLines = Flatten[
                     Map[StringJoin["    ",ToString[PassedParamsPointers[[#-1]]],
                    " = mxGetPr(ssGetArg(S,",
                    ToString[#-1],
                     "));"]&,
                     Range[2,NumberOfPassedParams]]];
*)
  ];
  ArgumentString="";
  For[n=1, n<NumberOfPassedParams+1, n++,
       ArgumentString = StringJoin[ArgumentString,",",ToString[PassedParams[[n]]]];
      ];
 
HeaderCCodeLines = {
  "#include <math.h>   ", 
  "#include \"trigfun.h\" ",
  "/*",
  " * ",
  StringJoin[" *            Syntax  [sys, x0] = ",MEXFunctionName,"(t,x,u,flag",ArgumentString,")"],
  "*/",
  "/*",
  "* The following #define is used to specify the name of this S-Function.",
  "*/",
  StringJoin["#define S_FUNCTION_NAME ",MEXFunctionName],
  "/*", 
  "* need to include simstruc.h for the definition of the SimStruct and",
  "* its associated macro definitions.",
  "*/",
  "#include \"simstruc.h\"",
  " ",
 "/* Defines for work arrays */",              
 "#define Br(j) RWork[j]", 
 StringJoin["#define Ar(i,j) RWork[",
             ToString[PLength],
             "+ i+j*",
             ToString[PLength],
             "]"],
 StringJoin["#define Cr(i,j) RWork[",
             ToString[PLength*(1+PLength)],
             "+ i+j*",
             ToString[PLength],
             "]"]
};
HeaderCCodeLines=Flatten[HeaderCCodeLines];

SizeCheckingLines = Flatten[
                    Map[
 {StringJoin["    if (mxGetM(ssGetArg(S,",
            ToString[#-1],
            ")) != ",
            ToString[PassedParamsDimensions[[#,1]]],
            "  || mxGetN(ssGetArg(S,",
            ToString[#-1],
            ")) !=",
            ToString[PassedParamsDimensions[[#,2]]],
            ")  {"
           ],
 StringJoin["        ssSetErrorStatus( S, \"",
         ToString[PassedParams[[#]]],
         " must have dimensions: ",
         ToString[PassedParamsDimensions[[#,1]]],
         " by ",
         ToString[PassedParamsDimensions[[#,2]]],
         "\");"
         ],
  "        return;",
 "    }"
 }
&,Range[1,NumberOfPassedParams]]];

(* Determine if there are any input variables in the outputs so
that the direct feed flag can be set as required by SIMULINK *)

InputOcurrences = Map[Count[Union[Level[Apply[Plus,Outputs],{-1}]],#]&,Inputs];
If[ Apply[Plus,InputOcurrences]==0,
    DirectFeedFlag = 0,
    (*else*)
    DirectFeedFlag = 1
  ];

InitialSizeRoutineLines = {
 "/*",
 " * mdlInitializeSizes - initialize the sizes array",
 " *",
 " * The sizes array is used by SIMULINK to determine the S-function block's",
 " * characteristics (number of inputs, outputs, states, etc.).",
 " */",
 "static void mdlInitializeSizes(S)",
 "    SimStruct *S;",
 "{",
 StringJoin["    ssSetNumContStates(    S, ",
           ToString[NumberOfContinuousStates],
           ");      /* number of continuous states */"],
 "    ssSetNumDiscStates(    S, 0);      /* number of discrete states */",
 StringJoin["    ssSetNumInputs(        S, ",
            ToString[NumberOfInputs],
            " );      /* number of inputs */"],
 StringJoin["    ssSetNumOutputs(       S, ",
            ToString[NumberOfOutputs],
            " );      /* number of outputs */"],
 StringJoin["    ssSetDirectFeedThrough(S, ",
                ToString[DirectFeedFlag],
            ");      /* direct feedthrough flag */"],
 "    ssSetNumSampleTimes(   S, 1);      /* number of sample times */",
 StringJoin["    ssSetNumInputArgs(     S, ",
            ToString[NumberOfPassedParams],
            ");      /* number of input arguments */"],
 StringJoin["    ssSetNumRWork(         S, ",
            ToString[PLength*(1+2*PLength)],
            ");      /* number of real work vector elements */"],
"    ssSetNumIWork(         S, 0);      /* number of integer work vector elements */",
"    ssSetNumPWork(         S, 0);      /* number of pointer work vector elements */", 
"     /*",
"     * if there aren't the correct number of parameters, just return, simulink.c will",
"     * flag the error",
"     */",
StringJoin["    if (ssGetNumArgs(S) != ",
            ToString[NumberOfPassedParams],
            ")"],
"       return;",
SizeCheckingLines,
"}"
};
InitialSizeRoutineLines=Flatten[InitialSizeRoutineLines];

InitialSampleTimeLines = {
"/*",
" * mdlInitializeSampleTimes - initialize the sample times array",
" *",
" * This function is used to specify the sample time(s) for your S-function.",
" * If your S-function is continuous, you must specify a sample time of 0.0.",
" * Sample times must be registered in ascending order.",
" */",
"static void mdlInitializeSampleTimes(S)",
"    SimStruct *S;",
"{",
"    ssSetSampleTimeEvent(S, 0, 0.0);",
"    ssSetOffsetTimeEvent(S, 0, 0.0);",
"}"
};
If[NumberOfPassedParams>0,
	InitialConditionAssignments = {"    double *X0pr;",
                                 "/* Set initial value for state vector */",
                                 "    X0pr = mxGetPr(ssGetArg(S,0)); ",
                                 "    imax = mxGetM(ssGetArg(S,0));",
                                 "    for(i=0;i<imax;i++){",
                                 "        x0[i] = X0pr[i];"};
	InitialConditionAssignmentsdSpace = {"    real_T *X0pr;",
                                 "/* Set initial value for state vector */",
                                 "    X0pr = mxGetPr(ssGetArg(S,0)); ",
                                 "    imax = mxGetM(ssGetArg(S,0));",
                                 "    for(i=0;i<imax;i++){",
                                 "        x0[i] = X0pr[i];"},
   (* else *)
   InitialConditionAssignments = {"/* Set initial value for state vector */",
                                 StringJoin["    for(i=0;i<",ToString[NumberOfContinuousStates],
                                 ";i++){"],
                                 "        x0[i] = 0;"};
   
   InitialConditionAssignmentsdSpace = {"/* Set initial value for state vector */",
                                 StringJoin["    for(i=0;i<",ToString[NumberOfContinuousStates],
                                 ";i++){"],
                                 "        x0[i] = 0;"}
  ];
   

(* ----------------------------------------------------- *)
(*Create Initial Condition Function C  Code Lines        *)
(* ----------------------------------------------------- *)
 Print["...Generating Initial Condition Function Code"];
InitialConditionFunctionCCodeLines = {
"/*",
" * mdlInitializeConditions - initialize the states",
" *",
" * In this function, you should initialize the continuous and discrete",
" * states for your S-function block.  The initial states are placed",
" * in the x0 variable.  You can also perform any other initialization",
" * activities that your S-function may require.",
" */",
"static void mdlInitializeConditions(x0, S)",
"#ifdef MATLAB_MEX_FILE    /* Is this file being compiled as a MEX-file? */",
"    double *x0;",
"    SimStruct *S;",
"{",
"    int i,imax;", 
InitialConditionAssignments,
"    }", 
"}",
"#else    /* compiled for dSpace board? */", 
   "    real_T *x0;",
   "    SimStruct *S;",
"{",
"    int_T i,imax;", 
InitialConditionAssignmentsdSpace,
"    }", 
"}",
"#endif"
};
InitialConditionFunctionCCodeLines =
Flatten[InitialConditionFunctionCCodeLines];

(*------------------------------------------------*)
(* Create State Derivative Function C Code Lines  *)
(*------------------------------------------------*)
 Print["...Generating State Derivative Function Code"];
(* Optimize the Floating Point Operations contained in the equations of
   motion defined by Fp and M *)
(*  First Collect all function terms so that they are only 
    computed once *)
Print["...Collecting all function terms"];
Ftmp = Expand[Fp];
Ctmp = Expand[Cp];
Mtmp = Expand[M];


{FReduced,FunctionReplacements} = 
           FunctionReplace[Flatten[{Ftmp,Mtmp,Ctmp}]];

FReduced = Ftmp//.FunctionReplacements;
MReduced = Mtmp//.FunctionReplacements;
CReduced = Ctmp//.FunctionReplacements;

(* Generate the lines of code that compute the Sines, Cosines and Powers
   with arguments in terms of the state vector x  *)
NumberOfReplacements = Length[FunctionReplacements];

(*
ReplStr =
Map[ReplaceVariablesStr[FunctionReplacements[[#,1]],Inputs,StateList,
                    PassedParams]&,
          Range[1,NumberOfReplacements]];
FunctionCCodeLines = Map[StringJoin["    t",ToString[#]," =",
                                             ReplStr[[#]],";"]&,
                             Range[1,NumberOfReplacements]];
*)

FunctionCCodeLines =
Map[ReplaceVariablesStr1[StringJoin["t",ToString[#]],FunctionReplacements[[#,1]],Inputs,StateList,
                    PassedParams,LineLength->LineSpec]&,
          Range[1,NumberOfReplacements]];

                             
(* Code to generate the temp variable declarations *)
Print["...Generating temp variable declarations"];
TempVariablesList = Map[StringJoin["t",ToString[#]]&,
                                    Range[1,NumberOfReplacements]];
TempVariablesListStr = ToString[TempVariablesList];
TVLength = Length[TempVariablesListStr];
If[Length[TempVariablesList]==0,
   TempVariablesDeclarationLines = " ";
   TempVariablesDeclarationLinesdSpace = " ",
   (*else*)
   TempVariablesDeclarationLines = StringJoin["    double ",
      StringTake[TempVariablesListStr,{2,TVLength-2}],";"];
   TempVariablesDeclarationLinesdSpace = StringJoin["    real_T ",
	StringTake[TempVariablesListStr,{2,TVLength-2}],";"]
  ];
                    
BreakVariablesListStr=ToString[Map[StringJoin["s",ToString[#]]&,Range[1,Max[10,Round[NumberOfReplacements/2]]]]];
BVLength=Length[BreakVariablesListStr];
BreakVariablesDeclarationLines= StringJoin["    double ",
                    StringTake[BreakVariablesListStr,{2,BVLength-2}],";"];
BreakVariablesDeclarationLinesdSpace= StringJoin["    real_T ",
                    StringTake[BreakVariablesListStr,{2,BVLength-2}],";"];

Ftmp = Map[ReduceFLOPSToo,FReduced];
Mtmp = Map[ReduceFLOPSToo,MReduced];
Ctmp = Map[ReduceFLOPSToo,CReduced];

(* Replace all occurrences of the variables designated in the list 
{passed params} in the equations of motion defined in F C, and M *)
Print["...Converting Expressions to C form"];
(* Convert Expressions for F, C, Vp, and M into C Language Strings that can
    be written to the Simulink S-Function File. *)
(* ----------- Fp --------------*)

(*
CStringFp = Map[ReplaceVariablesStr[-Ftmp[[#]],Inputs,StateList,PassedParams]
                          &,Range[1,PLength]];
BrLines = Map[StringJoin["    Br(",ToString[#-1],") = ",CStringFp[[#]],";"]&,
                          Range[1,PLength]];
*) 
BrLines = Map[ReplaceVariablesStr1[StringJoin["Br(",ToString[#-1],")"],-Ftmp[[#]],Inputs,StateList,PassedParams,LineLength->LineSpec]
                          &,Range[1,PLength]];

Vp=Flatten[Vp];
VpLength=Length[Vp];

CStringVp =
Map[ReplaceVariablesStr[Vp[[#]],Inputs,StateList,PassedParams]&,
                                   Range[1,VpLength]];
DxLines = Flatten[{
          Map[StringJoin["    dx[",ToString[#],"] =
Br(",ToString[#],");"]&,
                          Range[0,PLength-1]],
          Map[StringJoin["    dx[",ToString[#+PLength-1],"] =
",CStringVp[[#]],";"]&,
                          Range[1,QLength]]
                    }];

(* ------------ M -------------- *) 
ArLines={};
For[n=1, n<PLength+1, n++,
   Ar =
Map[ReplaceVariablesStr1[StringJoin["Ar(",ToString[n-1],",",ToString[#-1],")"],Mtmp[[n,#]],Inputs,StateList,PassedParams,LineLength->LineSpec]&,
                      Range[1,n]];
   ArLines = Join[ArLines,Ar];
];
(*
CStringM = {};
For[n=1, n<PLength+1, n++,
   MString =
Map[ReplaceVariablesStr[Mtmp[[n,#]],Inputs,StateList,PassedParams]&,
                      Range[1,n]];
   CStringM = Join[CStringM,{MString}];
];
ArLines={};
For[n=1, n<PLength+1, n++,
    Ar = Map[StringJoin["    Ar(",ToString[n-1],",",ToString[#-1],") =
",CStringM[[n,#]],";"]&,Range[1,n]];
    ArLines = Join[ArLines,Ar];
];
*)

(* ----------- C ----------------- *)
(* 
CStringC = {};
For[n=1, n<PLength+1, n++,
   CCString =
Map[ReplaceVariablesStr[-Ctmp[[n,#]],Inputs,StateList,PassedParams]&,
                      Range[1,PLength]];
   CStringC = Join[CStringC,{CCString}];
];

CrLines={};
For[n=1, n<PLength+1, n++,
        For[m=1, m<PLength+1, m++,
             (* RHSExp = ToExpression[CStringC[[n,m]]]; *)
             RHSExp = CStringC[[n,m]];
             (* Check for equality to zero and if true do not include in equations *)
             If[SameQ[RHSExp,"0"]||SameQ[RHSExp,"0."],,
                 CrLines = Flatten[{CrLines,StringJoin["    Cr(",
                                                       ToString[n-1],
                                                       ",",
                                                       ToString[m-1],
                                                       ")=",
                                                       CStringC[[n,m]],
                                                        ";"]}]
              ];
         ];
];
*)

CrLines={};
For[n=1, n<PLength+1, n++,
        For[m=1, m<PLength+1, m++,
             (* RHSExp = ToExpression[CStringC[[n,m]]]; *)
             RHSExp = ToString[Ctmp[[n,m]]];
             (* Check for equality to zero and if true do not include in equations *)
             If[SameQ[RHSExp,"0"]||SameQ[RHSExp,"0."],Null,
                 Cr=ReplaceVariablesStr1[StringJoin["Cr(",
                                                        ToString[n-1],
                                                        ",",
                                                        ToString[m-1],
                                                        ")"],-Ctmp[[n,m]],Inputs,StateList,PassedParams,LineLength->LineSpec];
                 CrLines = Flatten[{CrLines,Cr}]
              ];
         ];
];

DerivativeFunctionCCodeLines = {
  "/*",
  " * mdlDerivatives - compute the derivatives",
  " *",
  " * In this function, you compute the S-function block's derivatives.",
  " * The derivatives are placed in the dx variable.",
  " */",
  "static void mdlDerivatives(dx, x, u, S, tid)",
  "#ifdef MATLAB_MEX_FILE    /* Is this file being compiled as a MEX-file? */",
  "    double *dx, *x, *u;",
  "    SimStruct *S;",
  "    int tid;",
  "{ ",
  "    int n;",
  BreakVariablesDeclarationLines, 
  TempVariablesDeclarationLines,
  "    double *RWork = ssGetRWork(S);",
  "    int i,j;",
  "    char s='L';",
  "    int nrhs, LDA, info;",
 PassedParamsPointerDefinitionLines,
  "#else    /* compiled for dSpace board? */", 
  "    real_T *dx;",
  "	 const real_T *x, *u;",
  "    SimStruct *S;",
  "    int_T tid;",
  "{ ",
  "    int_T n;",
  BreakVariablesDeclarationLinesdSpace, 
  TempVariablesDeclarationLinesdSpace,
  "    real_T *RWork = ssGetRWork(S);",
  "    int_T i,j;",
  "    char s='L';",
  "    int_T nrhs, LDA, info;",
 PassedParamsPointerDefinitionLinesdSpace,
  "#endif",
  
  StringJoin["    n = ",ToString[PLength],";"],
  FunctionCCodeLines,
  ArLines,
  BrLines,
  CrLines,
  "/* Compute C*p + F */",
  StringJoin["    for (i=0;i<=",
              ToString[PLength-1],
              ";++i){"],
  StringJoin["        for(j=0;j<=",
               ToString[PLength-1],
               ";++j){"],
  "               Br(i) +=  Cr(i,j)*x[j];",
  "       }",
  "  }",
  "    /* Solve linear system A*X = C*P + F  */",
  "    nrhs = 1;",
  "    LDA = n;",
  "    dposv_(&s,&n,&nrhs,&Ar(0,0),&LDA,&Br(0),&LDA,&info);", 
  "    /* reassign results */",
  DxLines,
  "}"
};
DerivativeFunctionCCodeLines = Flatten[DerivativeFunctionCCodeLines];
(* -------------------------------------------*)
(*    Create Output Function C Code Lines     *)
(* -------------------------------------------*)
(*RHSOutputLines = Map[ReplaceVariablesStr[Outputs[[#]],Inputs,StateList,
                     PassedParams]&,Range[1,NumberOfOutputs]];*)


(* Optimize the Floating Point Operations contained in the equations
   defined by Outputs *)
(*  First Collect most functions so that they are only computed once *)
{FReduced,FunctionReplacements} = 
           FunctionReplace[Expand[Outputs]];
(* Generate the lines of code that compute the functions
   with arguments in terms of the state vector x  *)
NumberOfReplacements = Length[FunctionReplacements];
(*
ReplStr =  Map[ReplaceVariablesStr[FunctionReplacements[[#,1]],Inputs,StateList,
                    PassedParams]&,Range[1,NumberOfReplacements]];
FunctionCCodeLines = Map[StringJoin["    t",
                                    ToString[#]," =",
                                    ReplStr[[#]],";"]&,
                         Range[1,NumberOfReplacements]];
*)
FunctionCCodeLines =
Map[ReplaceVariablesStr1[StringJoin["t",ToString[#]],FunctionReplacements[[#,1]],Inputs,StateList,
                    PassedParams,LineLength->LineSpec]&,
          Range[1,NumberOfReplacements]];


(* Code to generate the temp variable declarations *)
TempVariablesList = Map[StringJoin["t",
                                    ToString[#]]&,
                         Range[1,NumberOfReplacements]];
TempVariablesListStr = ToString[TempVariablesList];
TVLength = Length[TempVariablesListStr];
If[Length[TempVariablesList]==0,
   TempVariablesDeclarationLines = " ";
   TempVariablesDeclarationLinesdSpace = " ",
(* else *)
   TempVariablesDeclarationLines = StringJoin["    double ",
                    StringTake[TempVariablesListStr,{2,TVLength-2}],";"];
   TempVariablesDeclarationLinesdSpace = StringJoin["    real_T ",
                    StringTake[TempVariablesListStr,{2,TVLength-2}],";"]
  ];
BreakVariablesListStr=ToString[Map[StringJoin["s",ToString[#]]&,Range[1,Max[10,Round[NumberOfReplacements/2]]]]];
BVLength=Length[BreakVariablesListStr];
BreakVariablesDeclarationLines= StringJoin["    double ",
                    StringTake[BreakVariablesListStr,{2,BVLength-2}],";"];
BreakVariablesDeclarationLinesdSpace= StringJoin["    real_T ",
                    StringTake[BreakVariablesListStr,{2,BVLength-2}],";"];


Output2 = Map[ReduceFLOPSToo,FReduced];

(* Replace all occurrences of the variables designated in the list 
{passed params} in the equations defined in EquationList *)

(* Convert Expressions in EquationList into C Language Strings that can
    be written to the Simulink S-Function File. *)
(*
OutputsStr = Map[ReplaceVariablesStr[Output2[[#]],Inputs,StateList,PassedParams]
                          &,Range[1,NumberOfOutputs]];

OutputLines =  Map[StringJoin["    y[",ToString[#-1],"] = "
                         ,OutputsStr[[#]],";"]&,
                          Range[1,NumberOfOutputs]];
*)
OutputLines = Map[ReplaceVariablesStr1[StringJoin["y[",ToString[#-1],"]"],Output2[[#]],Inputs,StateList,PassedParams,LineLength->LineSpec]
                          &,Range[1,NumberOfOutputs]];


OutputFunctionCCodeLines=Flatten[{
"/*",
" * mdlOutputs - compute the outputs",
" *",
" * In this function, you compute the outputs of your S-function",
" * block.  The outputs are placed in the y variable.",
" */",
"static void mdlOutputs(y, x, u, S, tid)",
"#ifdef MATLAB_MEX_FILE    /* Is this file being compiled as a MEX-file? */",
"    double *y, *x, *u;",
"    SimStruct *S;",
"    int tid;",
"{",
  BreakVariablesDeclarationLines,
  TempVariablesDeclarationLines,
  PassedParamsPointerDefinitionLines,
"#else    /* compiled for dSpace board? */", 
"    real_T *y;",
"	  const real_T *x, *u;",
"    SimStruct *S;",
"    int_T tid;",
"{",
  BreakVariablesDeclarationLinesdSpace,
  TempVariablesDeclarationLinesdSpace,
  PassedParamsPointerDefinitionLinesdSpace,
"#endif",
  FunctionCCodeLines,
  OutputLines,
"}"
}];

Print["...Generating Output Function Code"];

OtherLines={
"/*",
" * mdlUpdate - perform action at major integration time step",
" *",
" * This function is called once for every major integration time step.",
" * Discrete states are typically updated here, but this function is useful",
" * for performing any tasks that should only take place once per integration",
" * step.",
" */",
"static void mdlUpdate(x, u, S, tid)",
"#ifdef MATLAB_MEX_FILE    /* Is this file being compiled as a MEX-file? */",
"    double  *x, *u;",
"    SimStruct *S;",
"    int tid;",
"#else    /* compiled for dSpace board? */", 
"    real_T *x;",
"	  const real_T *u;",
"    SimStruct *S;",
"    int_T tid;",
"#endif",
"{",
"}",
"/*",
" * mdlTerminate - called when the simulation is terminated.",
" *",
" * In this function, you should perform any actions that are necessary",
" * at the termination of a simulation.  For example, if memory was allocated",
" * in mdlInitializeConditions, this is the place to free it.",
" */",
"static void mdlTerminate(S)",
"    SimStruct *S;",
"{",
"}",
"#include \"linsolv.c\"    /* includes linsolve routine dposv_ linear equation solver*/",
"#ifdef MATLAB_MEX_FILE    /* Is this file being compiled as a MEX-file? */",
"#include \"simulink.c\"      /* MEX-file interface mechanism */",
"#else",
"#include \"cg_sfun.h\"       /* Code generation registration function */",
"#endif"
};
(*--------------------------------------------*)
(*      Write Simulink Mex File               *)
(* -------------------------------------------*)
sfile = OpenWrite[MEXFilename];

(* Write Header C Code Lines *)
WriteCCode[HeaderCCodeLines,sfile];

(* Write Size Initialization C Code Lines *)
WriteCCode[InitialSizeRoutineLines,sfile];

(* Write Initial Sample Time C Code Lines *)
WriteCCode[InitialSampleTimeLines,sfile];

(* Write Initial Conditions Function C Code Lines *)
WriteCCode[InitialConditionFunctionCCodeLines,sfile];


(* Write State Derivative Function C Code Lines *)
WriteCCode[DerivativeFunctionCCodeLines,sfile];

(* Write Output Function C Code Lines *)
WriteCCode[OutputFunctionCCodeLines,sfile];

(* Write Other C Code Lines *)
WriteCCode[OtherLines,sfile];

Print[StringJoin["MEX File created with name: ",MEXFilename]];
Close[MEXFilename];


)];

SetAttributes[CreateModelMEX,ReadProtected];
SetAttributes[CreateModelMEX,Protected];
SetAttributes[CreateModelMEX,Locked];

(****************************************************************)
(*                      CreateMEX                                   *)
(****************************************************************)


Clear[CreateMEX];
CreateMEX[StateList_,Inputs_,Outputs_,EquationList_,PassedParams_,
                 PassedParamsDimensions_,MEXFilename_]:=
Print["Simulink 1.2 and earlier is no longer supported."];
SetAttributes[CreateMEX,ReadProtected];
SetAttributes[CreateMEX,Locked];

(****************************************************************)
(*                      CreateControllerMEX                                   *)
(****************************************************************)

CreateControllerMEX[StateList_,Inputs_,Outputs_,EquationList_,PassedParams_,
                 PassedParamsDimensions_,MEXFilename_]:=
 Module[{StateLength,NumberOfContinuousStates,NumberOfDiscreteStates,
         NumberOfInputs,NumberOfOutputs,NumberOfPassedParams,PassedParamDefines,
         PassedParamsPointerDefinitionLines,InitialSampleTimeLines,
         HeaderCCodeLines,PassedParamsPointerGetLines,ParameterSizesLines,
         SizeCheckingLines,GlobalSizeInfoFunctionLines,
         InitialConditionFunctionCCodeLines,Ftmp, 
         FReduced,InitialStateDefinitionLines,
         FunctionReplacements,NumberOfReplacements,ReplStr,
         FunctionCCodeLines,TempVariablesList,TempVariablesListStr,
         TVLength,TempVariablesDeclarationLines,
         BreakVariablesListStr,BreakVariablesDeclarationLines,BVLength,
         CStringFp,DxLines,DerivativeFunctionCCodeLines,      
         RHSOutputLines,OutputFunctionCCodeLines,DiscretStateUpdateCCodeLines,
         sfile,MEXFunctionname,RHSExp,outputsLocal,
         DotPosition,ArgumentString
         },(
  (*                            *)
  (* Compute problem parameters *)
  (*                            *)
  OutputsLocal = Outputs;
  StateLength = Length[StateList];
  NumberOfContinuousStates = StateLength;
  NumberOfDiscreteStates = 0;
  NumberOfInputs = Length[Inputs];
  NumberOfOutputs = Length[Outputs];
  If[NumberOfOutputs==0,(
    (*then*)
      NumberOfOutputs=NumberOfContinuousStates;
      OutputsLocal=StateList),
    (*else*)
      NumberOfOutputs;];
  NumberOfDiscontinuousRoots = 0;
  NumberOfDirectFeeds = 0;
  NumberOfPassedParams = Length[PassedParams];

  DotPosition=StringPosition[MEXFilename,"."];
  SlashPositions=StringPosition[MEXFilename,"\\"];
  If[Length[DotPosition]==0, 
      MEXFunctionName = MEXFilename,
      MEXFunctionName = StringTake[MEXFilename,DotPosition[[1,1]]-1]];
  If[Length[SlashPositions]!=0, 
     MEXFunctionName = StringTake[MEXFunctionName,
        {SlashPositions[[Length[SlashPositions],1]]+1,StringLength[MEXFunctionName]}]];


 
  Print["...Generating Header Code"];
  (*-------------------------------------------*)
  (*        Create Header C Code Lines         *)
  (*-------------------------------------------*)
  IF[NumberOfPassedParams>1,
     PassedParamsPointers = Map[StringJoin[ToString[PassedParams[[#]]],
                                           "pr"]&,Range[2,NumberOfPassedParams]];
     PassedParamsPointerDefinitionLines = Flatten[Map[StringJoin["    double ","*",
                    PassedParamsPointers[[#-1]],
                     " = mxGetPr(ssGetArg(S,",
                    ToString[#-1],
                     "));"]&,Range[2,NumberOfPassedParams]]];
     PassedParamsPointerDefinitionLinesdSpace = Flatten[Map[StringJoin["    real_T ","*",
                    PassedParamsPointers[[#-1]],
                     " = mxGetPr(ssGetArg(S,",
                    ToString[#-1],
                     "));"]&,Range[2,NumberOfPassedParams]]];
(*     PassedParamsPointerGetLines = Flatten[
                     Map[StringJoin["    ",ToString[PassedParamsPointers[[#-1]]],
                    " = mxGetPr(ssGetArg(S,",
                    ToString[#-1],
                     "));"]&,
                     Range[2,NumberOfPassedParams]]];
*)
  ];
  ArgumentString="";
  For[n=1, n<NumberOfPassedParams+1, n++,
       ArgumentString = StringJoin[ArgumentString,",",ToString[PassedParams[[n]]]];
      ];
 
HeaderCCodeLines = {
  "#include <math.h>   ", 
  "#include \"trigfun.h\" ",
  "/*",
  " * ",
  StringJoin[" *            Syntax  [sys, x0] = ",MEXFunctionName,"(t,x,u,flag",ArgumentString,")"],
  "*/",
  "/*",
  "* The following #define is used to specify the name of this S-Function.",
  "*/",
  StringJoin["#define S_FUNCTION_NAME ",MEXFunctionName],
  "/*", 
  "* need to include simstruc.h for the definition of the SimStruct and",
  "* its associated macro definitions.",
  "*/",
  "#include \"simstruc.h\"",
  " "
};
HeaderCCodeLines=Flatten[HeaderCCodeLines];

SizeCheckingLines = Flatten[
                    Map[
 {StringJoin["    if (mxGetM(ssGetArg(S,",
            ToString[#-1],
            ")) != ",
            ToString[PassedParamsDimensions[[#,1]]],
            "  || mxGetN(ssGetArg(S,",
            ToString[#-1],
            ")) !=",
            ToString[PassedParamsDimensions[[#,2]]],
            ")  {"
           ],
 StringJoin["        ssSetErrorStatus( S,\"",
         ToString[PassedParams[[#]]],
         " must have dimensions: ",
         ToString[PassedParamsDimensions[[#,1]]],
         " by ",
         ToString[PassedParamsDimensions[[#,2]]],
         "\");"
         ],
  "        return;",
 "    }"
 }
&,Range[1,NumberOfPassedParams]]];

(* Determine if there are any input variables in the outputs so
that the direct feed flag can be set as required by SIMULINK *)

InputOcurrences = Map[Count[Union[Level[Apply[Plus,Outputs],{-1}]],#]&,Inputs];
If[ Apply[Plus,InputOcurrences]==0,
    DirectFeedFlag = 0,
    (*else*)
    DirectFeedFlag = 1
  ];

InitialSizeRoutineLines = {
 "/*",
 " * mdlInitializeSizes - initialize the sizes array",
 " *",
 " * The sizes array is used by SIMULINK to determine the S-function block's",
 " * characteristics (number of inputs, outputs, states, etc.).",
 " */",
 "static void mdlInitializeSizes(S)",
 "    SimStruct *S;",
 "{",
 StringJoin["    ssSetNumContStates(    S, ",
           ToString[NumberOfContinuousStates],
           ");      /* number of continuous states */"],
 "    ssSetNumDiscStates(    S, 0);      /* number of discrete states */",
 StringJoin["    ssSetNumInputs(        S, ",
            ToString[NumberOfInputs],
            " );      /* number of inputs */"],
 StringJoin["    ssSetNumOutputs(       S, ",
            ToString[NumberOfOutputs],
            " );      /* number of outputs */"],
 StringJoin["    ssSetDirectFeedThrough(S, ",
                ToString[DirectFeedFlag],
            ");      /* direct feedthrough flag */"],
 "    ssSetNumSampleTimes(   S, 1);      /* number of sample times */",
 StringJoin["    ssSetNumInputArgs(     S, ",
            ToString[NumberOfPassedParams],
            ");      /* number of input arguments */"],
"    ssSetNumRWork(         S, 0);      /* number of real work vector elements */",
"    ssSetNumIWork(         S, 0);      /* number of integer work vector elements */",
"    ssSetNumPWork(         S, 0);      /* number of pointer work vector elements */", 
"     /*",
"     * if there aren't the correct number of parameters, just return, simulink.c will",
"     * flag the error",
"     */",
StringJoin["    if (ssGetNumArgs(S) != ",
            ToString[NumberOfPassedParams],
            ")"],
"       return;",
SizeCheckingLines,
"}"
};
InitialSizeRoutineLines=Flatten[InitialSizeRoutineLines];

InitialSampleTimeLines = {
"/*",
" * mdlInitializeSampleTimes - initialize the sample times array",
" *",
" * This function is used to specify the sample time(s) for your S-function.",
" * If your S-function is continuous, you must specify a sample time of 0.0.",
" * Sample times must be registered in ascending order.",
" */",
"static void mdlInitializeSampleTimes(S)",
"    SimStruct *S;",
"{",
"    ssSetSampleTimeEvent(S, 0, 0.0);",
"    ssSetOffsetTimeEvent(S, 0, 0.0);",
"}"
};

If[NumberOfPassedParams>0,
   InitialConditionAssignments = {
				"    double *X0pr;",
                                 "/* Set initial value for state vector */",
                                 "    X0pr = mxGetPr(ssGetArg(S,0)); ",
                                 "    imax = mxGetM(ssGetArg(S,0));",
                                 "    for(i=0;i<imax;i++){",
                                 "        x0[i] = X0pr[i];"};
	InitialConditionAssignmentsdSpace = {
				"    real_T *X0pr;",
                                 "/* Set initial value for state vector */",
                                 "    X0pr = mxGetPr(ssGetArg(S,0)); ",
                                 "    imax = mxGetM(ssGetArg(S,0));",
                                 "    for(i=0;i<imax;i++){",
                                 "        x0[i] = X0pr[i];"},
	
   (* else *)
   InitialConditionAssignments = {"/* Set initial value for state vector */",
                                 StringJoin["    for(i=0;i<",ToString[NumberOfContinuousStates],
                                 ";i++){"],
                                 "        x0[i] = 0;"};
   InitialConditionAssignmentsdSpace = {"/* Set initial value for state vector */",
                                 StringJoin["    for(i=0;i<",ToString[NumberOfContinuousStates],
                                 ";i++){"],
                                 "        x0[i] = 0;"}
  ];
   

(* ----------------------------------------------------- *)
(*Create Initial Condition Function C  Code Lines        *)
(* ----------------------------------------------------- *)
 Print["...Generating Initial Condition Function Code"];
InitialConditionFunctionCCodeLines = {
"/*",
" * mdlInitializeConditions - initialize the states",
" *",
" * In this function, you should initialize the continuous and discrete",
" * states for your S-function block.  The initial states are placed",
" * in the x0 variable.  You can also perform any other initialization",
" * activities that your S-function may require.",
" */",
"static void mdlInitializeConditions(x0, S)",
"#ifdef MATLAB_MEX_FILE    /* Is this file being compiled as a MEX-file? */",
"    double *x0;",
"    SimStruct *S;",
"{",
"    int i,imax;", 
InitialConditionAssignments,
"    }", 
"}",
"#else    /* compiled for dSpace board? */", 
"    real_T *x0;",
"    SimStruct *S;",
"{",
"    int_T i,imax;", 
InitialConditionAssignmentsdSpace,
"    }", 
"}",
"#endif"
};
InitialConditionFunctionCCodeLines =
Flatten[InitialConditionFunctionCCodeLines];

(*------------------------------------------------*)
(* Create State Derivative Function C Code Lines  *)
(*------------------------------------------------*)
 Print["...Generating State Derivative Function Code"];
(* Optimize the Floating Point Operations contained in the equations of
   motion defined by Fp and M *)
(*  First Collect all function terms so that they are only 
    computed once *)
Print["...Removing Function terms"];
Ftmp = Expand[EquationList];
{FReduced,FunctionReplacements} = 
           FunctionReplace[Ftmp];    

FReduced = Ftmp//.FunctionReplacements;

(* Generate the lines of code that compute the Sines, Cosines and Powers
   with arguments in terms of the state vector x  *)
NumberOfReplacements = Length[FunctionReplacements];

ReplStr =
Map[ReplaceVariablesStr[FunctionReplacements[[#,1]],Inputs,StateList,
                    PassedParams]&,
          Range[1,NumberOfReplacements]];
FunctionCCodeLines = Map[StringJoin["    t",ToString[#]," =",
                                             ReplStr[[#]],";"]&,
                             Range[1,NumberOfReplacements]];
(* Code to generate the temp variable declarations *)
Print["...Generating temp variable declarations"];
TempVariablesList = Map[StringJoin["t",ToString[#]]&,
                                    Range[1,NumberOfReplacements]];
TempVariablesListStr = ToString[TempVariablesList];
TVLength = Length[TempVariablesListStr];
If[Length[TempVariablesList]==0,
   TempVariablesDeclarationLines = " ";
   TempVariablesDeclarationLinesdSpace = " ",
(* else *)
   TempVariablesDeclarationLines = StringJoin["    double ",
                    StringTake[TempVariablesListStr,{2,TVLength-2}],";"]; 
   TempVariablesDeclarationLinesdSpace = StringJoin["    real_T ",
                    StringTake[TempVariablesListStr,{2,TVLength-2}],";"]
  ];
BreakVariablesListStr=ToString[Map[StringJoin["s",ToString[#]]&,Range[1,Max[10,Round[NumberOfReplacements/2]]]]];
BVLength=Length[BreakVariablesListStr];
BreakVariablesDeclarationLines= StringJoin["    double ",
                    StringTake[BreakVariablesListStr,{2,BVLength-2}],";"];
BreakVariablesDeclarationLinesdSpace= StringJoin["    real_T ",
                    StringTake[BreakVariablesListStr,{2,BVLength-2}],";"];

Ftmp = Map[ReduceFLOPSToo,FReduced];

(* Replace all occurrences of the variables designated in the list 
{passed params} in the equations of motion defined in F *)
Print["...Converting Expressions to C form"];
(* Convert Expressions for F, C, Vp, and M into C Language Strings that can
    be written to the Simulink S-Function File. *)
(* ----------- Fp --------------*)

CStringFp = Map[ReplaceVariablesStr[Ftmp[[#]],Inputs,StateList,PassedParams]
                          &,Range[1,StateLength]];

DxLines =  Map[StringJoin["  dx[",ToString[#-1],"] = "
                         ,CStringFp[[#]],";"]&,
                          Range[1,StateLength]];
DerivativeFunctionCCodeLines = {
  "/*",
  " * mdlDerivatives - compute the derivatives",
  " *",
  " * In this function, you compute the S-function block's derivatives.",
  " * The derivatives are placed in the dx variable.",
  " */",
  "static void mdlDerivatives(dx, x, u, S, tid)",
  "#ifdef MATLAB_MEX_FILE    /* Is this file being compiled as a MEX-file? */",
  "    double *dx, *x, *u;",
  "    SimStruct *S;",
  "    int tid;",
    "{ ",
  "    int n;",
  BreakVariablesDeclarationLines, 
  TempVariablesDeclarationLines,
  "    double *RWork = ssGetRWork(S);",
  "    int i,j;",
  "    char s='L';",
  "    int nrhs, LDA, info;",
  PassedParamsPointerDefinitionLines,
  "#else    /* compiled for dSpace board? */", 
  "    real_T *dx;",
  "	 const real_T *x, *u;",
  "    SimStruct *S;",
  "    int_T tid;",
    "{ ",
  "    int_T n;",
  BreakVariablesDeclarationLinesdSpace, 
  TempVariablesDeclarationLinesdSpace,
  "    real_T *RWork = ssGetRWork(S);",
  "    int_T i,j;",
  "    char s='L';",
  "    int_T nrhs, LDA, info;",
  PassedParamsPointerDefinitionLinesdSpace,
  "#endif",
  StringJoin["    n = ",ToString[StateLength],";"],
  FunctionCCodeLines,
  DxLines,
  "}"
};
DerivativeFunctionCCodeLines = Flatten[DerivativeFunctionCCodeLines];
(* -------------------------------------------*)
(*    Create Output Function C Code Lines     *)
(* -------------------------------------------*)
(*RHSOutputLines = Map[ReplaceVariablesStr[Outputs[[#]],Inputs,StateList,
                     PassedParams]&,Range[1,NumberOfOutputs]];*)


(* Optimize the Floating Point Operations contained in the equations
   defined by Outputs *)
(*  First Collect most functions so that they are only computed once *)
{FReduced,FunctionReplacements} = 
           FunctionReplace[Expand[OutputsLocal]];
(* Generate the lines of code that compute the functions
   with arguments in terms of the state vector x  *)
NumberOfReplacements = Length[FunctionReplacements];
ReplStr =  Map[ReplaceVariablesStr[FunctionReplacements[[#,1]],Inputs,StateList,
                    PassedParams]&,Range[1,NumberOfReplacements]];
FunctionCCodeLines = Map[StringJoin["    t",
                                    ToString[#]," =",
                                    ReplStr[[#]],";"]&,
                         Range[1,NumberOfReplacements]];

(* Code to generate the temp variable declarations *)
TempVariablesList = Map[StringJoin["t",
                                    ToString[#]]&,
                         Range[1,NumberOfReplacements]];
TempVariablesListStr = ToString[TempVariablesList];
TVLength = Length[TempVariablesListStr];

If[Length[TempVariablesList]==0,
   TempVariablesDeclarationLines = " ";
   TempVariablesDeclarationLinesdSpace = " ",
   (*else*)
   TempVariablesDeclarationLines = StringJoin["    double ",
                  StringTake[TempVariablesListStr,{2,TVLength-2}],";"];
   TempVariablesDeclarationLinesdSpace = StringJoin["    real_T ",
                  StringTake[TempVariablesListStr,{2,TVLength-2}],";"]
  ];
BreakVariablesListStr=ToString[Map[StringJoin["s",ToString[#]]&,Range[1,Max[10,Round[NumberOfReplacements/2]]]]];
BVLength=Length[BreakVariablesListStr];
BreakVariablesDeclarationLines= StringJoin["    double ",
                    StringTake[BreakVariablesListStr,{2,BVLength-2}],";"];
BreakVariablesDeclarationLinesdSpace= StringJoin["    real_T ",
                    StringTake[BreakVariablesListStr,{2,BVLength-2}],";"];

Output2 = Map[ReduceFLOPSToo,FReduced];

(* Replace all occurrences of the variables designated in the list 
{passed params} in the equations defined in EquationList *)

(* Convert Expressions in EquationList into C Language Strings that can
    be written to the Simulink S-Function File. *)
OutputsStr = Map[ReplaceVariablesStr[Output2[[#]],Inputs,StateList,PassedParams]
                          &,Range[1,NumberOfOutputs]];

OutputLines =  Map[StringJoin["    y[",ToString[#-1],"] = "
                         ,OutputsStr[[#]],";"]&,
                          Range[1,NumberOfOutputs]];



OutputFunctionCCodeLines=Flatten[{
"/*",
" * mdlOutputs - compute the outputs",
" *",
" * In this function, you compute the outputs of your S-function",
" * block.  The outputs are placed in the y variable.",
" */",
"static void mdlOutputs(y, x, u, S, tid)",
"#ifdef MATLAB_MEX_FILE    /* Is this file being compiled as a MEX-file? */",
"    double *y, *x, *u;",
"    SimStruct *S;",
"    int tid;",
"{",
  BreakVariablesDeclarationLines,
  TempVariablesDeclarationLines,
  PassedParamsPointerDefinitionLines,
"#else    /* compiled for dSpace board? */", 
"    real_T *y;",
"	  const real_T *x, *u;",
"    SimStruct *S;",
"    int_T tid;",
"{",
  BreakVariablesDeclarationLinesdSpace,
  TempVariablesDeclarationLinesdSpace,
  PassedParamsPointerDefinitionLinesdSpace,
"#endif",
  FunctionCCodeLines,
  OutputLines,
"}"
}];

Print["...Generating Output Function Code"];

OtherLines={
"/*",
" * mdlUpdate - perform action at major integration time step",
" *",
" * This function is called once for every major integration time step.",
" * Discrete states are typically updated here, but this function is useful",
" * for performing any tasks that should only take place once per integration",
" * step.",
" */",
"static void mdlUpdate(x, u, S, tid)",
"#ifdef MATLAB_MEX_FILE    /* Is this file being compiled as a MEX-file? */",
"    double  *x, *u;",
"    SimStruct *S;",
"    int tid;",
"#else    /* compiled for dSpace board? */", 
"    real_T *x;",
"	  const real_T *u;",
"    SimStruct *S;",
"    int_T tid;",
"#endif",
"{",
"}",
"/*",
" * mdlTerminate - called when the simulation is terminated.",
" *",
" * In this function, you should perform any actions that are necessary",
" * at the termination of a simulation.  For example, if memory was allocated",
" * in mdlInitializeConditions, this is the place to free it.",
" */",
"static void mdlTerminate(S)",
"    SimStruct *S;",
"{",
"}",
"#ifdef MATLAB_MEX_FILE    /* Is this file being compiled as a MEX-file? */",
"#include \"simulink.c\"      /* MEX-file interface mechanism */",
"#else",
"#include \"cg_sfun.h\"       /* Code generation registration function */",
"#endif"
};

(*--------------------------------------------*)
(*      Write Simulink Mex File               *)
(* -------------------------------------------*)
sfile = OpenWrite[MEXFilename];

(* Write Header C Code Lines *)
WriteCCode[HeaderCCodeLines,sfile];

(* Write Size Initialization C Code Lines *)
WriteCCode[InitialSizeRoutineLines,sfile];

(* Write Initial Sample Time C Code Lines *)
WriteCCode[InitialSampleTimeLines,sfile];

(* Write Initial Conditions Function C Code Lines *)
WriteCCode[InitialConditionFunctionCCodeLines,sfile];


(* Write State Derivative Function C Code Lines *)
WriteCCode[DerivativeFunctionCCodeLines,sfile];

(* Write Output Function C Code Lines *)
WriteCCode[OutputFunctionCCodeLines,sfile];

(* Write Other C Code Lines *)
WriteCCode[OtherLines,sfile];

Print[StringJoin["MEX File created with name: ",MEXFilename]];
Close[MEXFilename];


)];

SetAttributes[CreateControllerMEX,ReadProtected];
SetAttributes[CreateControllerMEX,Locked];

Clear[FunctionReplace];
FunctionReplace[EquationList_]:= Module[{FCombined,FExp,FExpU,FExpLength,
                                     FunctionHeads,FunctionTerms ,
                                     NumberOfFunctionTerms,Replacements,
                                     ArcTanTerms,NumberOfArcTanTerms,ArcTanTermsNumberOfArgs,
                                     ArcTanRules,i,NewRule,
                                     FNew},(

       FCombined = Apply[Plus,Flatten[EquationList]];
       FExp = Level[FCombined,Infinity];
       FExpU = Union[FExp];
       FExpLength = Length[FExp];
       FunctionHeads = {_Sin,_ArcSin,_Cos,_ArcCos,_Tan,_ArcTan,_Global`ArcTan2,
                           _Csc,_Sec,_Cot,_Power,_Exp,_Log,_Sinh,_Cosh,
                           _Tanh,_Csch,_Sech,_Coth,_ArcSinh,_ArcCosh,_ArcTanh,
                           _Abs,_Sign};
       (* First examine ArcTan functions and deteremine whether any are called with two arguments *)
       ArcTanTerms = Cases[FExpU,_ArcTan];
       NumberOfArcTanTerms = Length[ArcTanTerms];
       ArcTanTermsNumberOfArgs=Flatten[Map[Dimensions,Map[Level[#,{1}]&,ArcTanTerms]]];
       ArcTanRules = {};
       For[i=1,i<NumberOfArcTanTerms+1,i++,
          If[ArcTanTermsNumberOfArgs[[i]]==2, 
             NewRule = Rule[ArcTanTerms[[i]],ArcTanTerms[[i]]/.ArcTan->Global`ArcTan2];
             ArcTanRules = Join[ArcTanRules,{NewRule}];
          ];
       ];

       FNew = EquationList/.ArcTanRules;
       FExpU = FExpU/.ArcTanRules;
       FunctionTerms = Flatten[Map[Cases[FExpU,FunctionHeads[[#]]]&,
                                   Range[1,Length[FunctionHeads]]]];
       FunctionTerms=Sort[FunctionTerms,(Depth[#2]>Depth[#1])&];
       NumberOfFunctionTerms = Length[FunctionTerms];

       Replacements = Map[Rule[FunctionTerms[[#]],
                        ToExpression[StringJoin["t",ToString[#]]]]&,
                   Range[1,NumberOfFunctionTerms]];

       FNew  = FNew/. Replacements;
(* Apply replacement rules to the rhs of the replacement rules themselves *)
       For[i=2,i<NumberOfFunctionTerms+1,i++,
          FunctionTerms[[i]] = FunctionTerms[[i]]/.Drop[Replacements,{i,NumberOfFunctionTerms}];

];

       Replacements = Map[Rule[FunctionTerms[[#]],
                        ToExpression[StringJoin["t",ToString[#]]]]&,
                   Range[1,NumberOfFunctionTerms]];
 

{FNew,Replacements} )];
SetAttributes[FunctionReplace,ReadProtected];
SetAttributes[FunctionReplace,Protected];
SetAttributes[FunctionReplace,Locked];

Clear[ReplaceVariablesStr];
ReplaceVariablesStr[Expr_,InputList_,StateList_,PassedParamsList_]:=
       Module[{Inputs,States,NumberOfInputs,NumberOfStates,InputReplacements,
        StateReplacements,TotalReplacements,Freplace,Str,StrInputRules,
        StrPointerRules,StrStateRules,StrRules,ExprStr,NumberOfPassedParams,
        PassedParams,PassedParamsPr,StrPassedParamsRules,nnprec=8,
        Tempu=False,Tempx=False},(
        Inputs = Flatten[InputList];
        States = Flatten[StateList];
        PassedParams = Flatten[PassedParamsList];
        NumberOfInputs = Length[Inputs];
        NumberOfStates = Length[States];
        NumberOfPassedParams = Length[PassedParams];
        (*
        InputReplacements = 
          Map[Rule[Inputs[[#]],Global`u[#-1]]&,Range[1,NumberOfInputs]];
          *)
        If[Definition[Global`u]===Null,ToExpression["utmp=u"];
          ToExpression["Remove[u]"];Tempu=True];
        If[Definition[Global`x]===Null,ToExpression["xtmp=x"];
          ToExpression["Remove[x]"];Tempx=True];
        (*
        ToExpression["utmp=u;"];
        ToExpression["Remove[u]"];
        ToExpression["xtmp=x;"];
        ToExpression["Remove[x]"];
        *)

        InputReplacements = 
          Map[Rule[Inputs[[#]],ToExpression[StringJoin["u[",
                                     ToString[#-1],
                                    "]"]]]&,Range[1,NumberOfInputs]];
        (*
        StateReplacements = 
          Map[Rule[States[[#]],Global`x[#-1]]&,Range[1,NumberOfStates]];
          *)

        StateReplacements = 
          Map[Rule[States[[#]],ToExpression[StringJoin["x[",
                                    ToString[#-1],
                                    "]"]]]&,Range[1,NumberOfStates]];

        TotalReplacements = Flatten[{InputReplacements,StateReplacements}];
        Freplace = Expr /. TotalReplacements;
        (* Str = ToString[ CForm[Freplace]]; *)
        Str = ToString[CAssign[Freplace,AssignMaxSize->Infinity,
                                        AssignTemporary->{"s",Sequence},
                                        AssignBreak->False,
                                        AssignIndent->"    ",
                                        AssignEnd->"",
                                        AssignPrecision->nnprec]];
        StrInputRules=
                Map[Rule[StringJoin["u(",
                                     ToString[CForm[SetPrecision[#-1,nnprec]]],
                                    ")"],
                        StringJoin["u[",
                                     ToString[#-1],
                                    "]"]]&,
                Range[1,NumberOfInputs]];
        StrPointerRules={" * "->"*"," + "->"+"," - "->"-","1.*"->""};
        StrStateRules=
                Map[Rule[StringJoin["x(",
                                    ToString[CForm[SetPrecision[#-1,nnprec]]],
                                    ")"],
                         StringJoin["x[",
                                    ToString[#-1],
                                    "]"]]&,
                Range[1,NumberOfStates]];
       PassedParamsPr = Map[StringJoin[ToString[PassedParams[[#]]],
                                             "pr"]&,
                              Range[1,NumberOfPassedParams]];
       StrPassedParamsRules = Map[Rule[
                              ToString[PassedParams[[#]]],
                              StringJoin[ToString[PassedParamsPr[[#]]],
                                         "[0]"]]&,
                              Range[1,NumberOfPassedParams]];
        StrRules = Join[StrInputRules,StrStateRules];
        ExprStr = StringReplace[Str,StrRules];
        ExprStr = StringReplace[ExprStr,StrPointerRules];
        ExprStr = StringReplace[ExprStr,StrPassedParamsRules];

If[Tempu,ToExpression["u=utmp"];ToExpression["Remove[utmp]"]];
If[Tempx,ToExpression["x=xtmp"];ToExpression["Remove[xtmp]"]];
(*
ToExpression["u=utmp"];
ToExpression["Remove[utmp]"];
ToExpression["x=xtmp"];
ToExpression["Remove[xtmp]"];
*)

        ExprStr
)];
SetAttributes[ReplaceVariablesStr,ReadProtected];
SetAttributes[ReplaceVariablesStr,Protected];
SetAttributes[ReplaceVariablesStr,Locked];

Clear[ReplaceVariablesStr1];
ReplaceVariablesStr1[LHSide_,Expr_,InputList_,StateList_,PassedParamsList_,opts___]:=
       Module[{Inputs,States,NumberOfInputs,NumberOfStates,InputReplacements,
        StateReplacements,TotalReplacements,Freplace,Str,StrInputRules,
        StrPointerRules,StrStateRules,StrRules,ExprStr,NumberOfPassedParams,
        PassedParams,PassedParamsPr,StrPassedParamsRules,nnprec=8,
        Tempu=False,Tempx=False,
        LineSpec=(LineLength/.Flatten[{opts}])/.{LineLength->Infinity}},(      
        Inputs = Flatten[InputList];
        States = Flatten[StateList];
        PassedParams = Flatten[PassedParamsList];
        NumberOfInputs = Length[Inputs];
        NumberOfStates = Length[States];
        NumberOfPassedParams = Length[PassedParams];
        (*
        InputReplacements = 
          Map[Rule[Inputs[[#]],Global`u[#-1]]&,Range[1,NumberOfInputs]];
          *)
        
        If[Definition[Global`u]===Null,ToExpression["utmp=u"];
          ToExpression["Remove[u]"];Tempu=True];
        If[Definition[Global`x]===Null,ToExpression["xtmp=x"];
          ToExpression["Remove[x]"];Tempx=True];
        (*
        ToExpression["utmp=u;"];
        ToExpression["Remove[u]"];
        ToExpression["xtmp=x;"];
        ToExpression["Remove[x]"];
        *)
        
        InputReplacements = 
          Map[Rule[Inputs[[#]],ToExpression[StringJoin["u[",
                                     ToString[#-1],
                                    "]"]]]&,Range[1,NumberOfInputs]];
        (*
        StateReplacements = 
          Map[Rule[States[[#]],Global`x[#-1]]&,Range[1,NumberOfStates]];
          *)
        StateReplacements = 
          Map[Rule[States[[#]],ToExpression[StringJoin["x[",
                                    ToString[#-1],
                                    "]"]]]&,Range[1,NumberOfStates]];
        TotalReplacements = Flatten[{InputReplacements,StateReplacements}];
        Freplace = Expr /. TotalReplacements;
        (* Str = ToString[ CForm[Freplace]]; *)
        Str = ToString[CAssign[LHSide,Freplace,
                                  AssignMaxSize->LineSpec,
                                  AssignTemporary->{"s",Sequence},
                                  AssignBreak->False,
                                  AssignIndent->"    ",
                                  AssignEnd->";",
                                  AssignPrecision->nnprec]];
        StrInputRules=
                Map[Rule[StringJoin["u(",
                                     ToString[CForm[SetPrecision[#-1,nnprec]]],
                                    ")"],
                        StringJoin["u[",
                                     ToString[#-1],
                                    "]"]]&,
                Range[1,NumberOfInputs]];
        StrPointerRules={" * "->"*"," + "->"+"," - "->"-","1.*"->""};
        StrStateRules=
                Map[Rule[StringJoin["x(",
                                    ToString[CForm[SetPrecision[#-1,nnprec]]],
                                    ")"],
                         StringJoin["x[",
                                    ToString[#-1],
                                    "]"]]&,
                Range[1,NumberOfStates]];
       PassedParamsPr = Map[StringJoin[ToString[PassedParams[[#]]],
                                             "pr"]&,
                              Range[1,NumberOfPassedParams]];
       StrPassedParamsRules = Map[Rule[
                              ToString[PassedParams[[#]]],
                              StringJoin[ToString[PassedParamsPr[[#]]],
                                         "[0]"]]&,
                              Range[1,NumberOfPassedParams]];
        StrRules = Join[StrInputRules,StrStateRules];
        ExprStr = StringReplace[Str,StrRules];
        ExprStr = StringReplace[ExprStr,StrPointerRules];
        ExprStr = StringReplace[ExprStr,StrPassedParamsRules];
        
If[Tempu,ToExpression["u=utmp"];ToExpression["Remove[utmp]"]];
If[Tempx,ToExpression["x=xtmp"];ToExpression["Remove[xtmp]"]];
(*
ToExpression["u=utmp"];
ToExpression["Remove[utmp]"];
ToExpression["x=xtmp"];
ToExpression["Remove[xtmp]"];
*)

        ExprStr
)];
SetAttributes[ReplaceVariablesStr1,ReadProtected];
SetAttributes[ReplaceVariablesStr1,Protected];
SetAttributes[ReplaceVariablesStr1,Locked];

Clear[WriteCCode];
WriteCCode[CCodeList_,sfile_]:=
       Module[{NumberOfCCodeLines,n},(
        NumberOfCCodeLines = Length[CCodeList];
        For[n=1, n<NumberOfCCodeLines+1, n++,
           WriteString[sfile,StringJoin[CCodeList[[n]]," \n"]];
        ];
)];
SetAttributes[WriteCCode,ReadProtected];
SetAttributes[WriteCCode,Protected];
SetAttributes[WriteCCode,Locked];

Clear[SinCosPowerReplaceToo];
SinCosPowerReplaceToo[Fp_,Mp_,Cp_]:= Module[{FCombined,FExpU,FExpLength,
                                     SinCosPowerHeads,SinCosPowerTerms ,
                                     NumberOfSinCosPowerTerms,Replacements,
                                     FNew,MNew,CNew},(
       FCombined = Apply[Plus,Flatten[{Fp,Mp,Cp}]];    
       FExp = Level[FCombined,Infinity];
       FExpU = Union[FExp];
       FExpLength = Length[FExp];
       SinCosPowerHeads = {_Sin,_Cos,_Power,_Tan,_Cot,_Sec,_Csc};
       SinCosPowerTerms = Flatten[Map[Cases[FExpU,SinCosPowerHeads[[#]]]&,
                                   Range[1,Length[SinCosPowerHeads]]]];
       NumberOfSinCosPowerTerms = Length[SinCosPowerTerms];
       Replacements = Map[Rule[SinCosPowerTerms[[#]],
                        ToExpression[StringJoin["t",ToString[#]]]]&,
                   Range[1,NumberOfSinCosPowerTerms]];
       FNew  = Fp/. Replacements;
       MNew = Mp/. Replacements;
       CNew = Cp/. Replacements;
{FNew,MNew,CNew,Replacements} )];
SetAttributes[SinCosPowerReplaceToo,ReadProtected];
SetAttributes[SinCosPowerReplaceToo,Protected];
SetAttributes[SinCosPowerReplaceToo,Locked];

Clear[FindMostFrequentTerms];
FindMostFrequentTerms[F_]:=Module[{FExp,FExpU,FExpLength,
                                   AcceptableHeads,NumberOfAcceptableHeads,
                                   LowestLevelExps,InstancesOfOccurences,
                                   LengthLowestLevelExps,NumberOfOccurences,
                                   MaxElem,IndexOfMaxElem},(
       FExp = Level[F,Infinity];
       FExpU = Union[FExp];
       FExpLength = Length[FExp];
       AcceptableHeads = {_Cos,_Sin,_Power,_Symbol,_Tan,_Cot,_Sec,_Csc,_Abs,_Sign};
       NumberOfAcceptableHeads = Length[AcceptableHeads];
       LowestLevelExps = Flatten[Map[Cases[FExpU,AcceptableHeads[[#]]]&,
                                  Range[1,NumberOfAcceptableHeads]]];
       InstancesOfOccurences = Flatten[Map[Cases[FExp,AcceptableHeads[[#]]]&,
                                  Range[1,NumberOfAcceptableHeads]]];
       LengthLowestLevelExps = Length[LowestLevelExps];
       NumberOfOccurences = Map[Count[InstancesOfOccurences,
                                      LowestLevelExps[[#]]]&,
                                Range[1,LengthLowestLevelExps]];
       MaxElem = Max[NumberOfOccurences];
       IndexOfMaxElem = Flatten[Position[NumberOfOccurences,MaxElem]];
       MostFrequentTerms = LowestLevelExps[[IndexOfMaxElem]];
       
MostFrequentTerms)];
SetAttributes[FindMostFrequentTerms,ReadProtected];
SetAttributes[FindMostFrequentTerms,Protected];
SetAttributes[FindMostFrequentTerms,Locked];


Clear[ReduceFLOPSToo];
ReduceFLOPSToo[Expr_]:=Module[{FExp,FExpU,FExpLength,AcceptableHeads,
       ListOfExpressions,LengthListOfExpresions,ContinueCollection,
       CollectionList,InstancesOfOccurences,NumberOfOccurences,MaxElem,
       IndexOfMaxElem,MostFrequentExpression,ExprTmp},(
(* Compute a list of all expression with specified heads *)
       ExprTmp = Expr;
       FExp = Level[ExprTmp,Infinity];
       FExpU = Union[FExp];
       FExpLength = Length[FExp];
       AcceptableHeads = {_Cos,_Sin,_Power,_Symbol,_Tan,_Cot,_Sec,_Csc,_Abs,_Sign};
       ListOfExpressions = Flatten[Map[Cases[FExpU,#]&,AcceptableHeads]];
       LengthListOfExpresions = Length[ListOfExpressions];
       ContinueCollection = True;
       CollectionList = {};
       Exprnew= Collect[ExprTmp,CollectionList];
     While[ContinueCollection,(
(* Compute how many times each expression in ListOfExpressions appears in Expr *)
         InstancesOfOccurences = Flatten[Map[Cases[FExp,#]&,AcceptableHeads]];
         NumberOfOccurences = Map[Count[InstancesOfOccurences,#]&,
                                     ListOfExpressions];
(* Find expression(s) with the highest frequency of occurence *)
         MaxElem = Max[NumberOfOccurences];
         IndexOfMaxElem = Flatten[Position[NumberOfOccurences,MaxElem]];
         MostFrequentExpression =ListOfExpressions[[IndexOfMaxElem]];
(* Add it to collection list *)
         CollectionList =Flatten[{CollectionList,MostFrequentExpression}];
(* Remove it from list of expressions *)
         ListOfExpressions = Complement[ListOfExpressions,CollectionList];
        (* Print[ListOfExpressions];
         Print[CollectionList];*)
         If [Length[ListOfExpressions] != 0,(
           (*then*)
           (* Perform Collections *)
            Exprnew= Collect[ExprTmp,CollectionList];
            FExp = Level[Exprnew,Infinity];
            ContinueCollection = True),
        (*else*)   
            ContinueCollection = False;];
    )];
  Exprnew)];
SetAttributes[ReduceFLOPSToo,ReadProtected];
SetAttributes[ReduceFLOPSToo,Protected];
SetAttributes[ReduceFLOPSToo,Locked];

Clear[ComputeVp];
ComputeVp[V_,p_]:=V.p /; MatrixQ[V];                          
ComputeVp[V_,p_]:=Module[{Finish,Start,Inds,VdimsCols,Vp},(
    VdimsCols = Transpose[Map[Dimensions,V]][[1]];
    LengthV = Length[VdimsCols];
    Finish = Map[Apply[Plus,Take[VdimsCols,#]]&,Range[1,LengthV]];
    Start = Finish-VdimsCols+1;
    Inds = Map[Range[Start[[#]],Finish[[#]]]&,Range[1,LengthV]];
    Vp = Flatten[Map[V[[#]].p[[Inds[[#]]]]&,Range[1,LengthV]]];
    Vp
   )];



(* ********************************************************************** *)
(* ********************************************************************** *)

(* **************** Utility CAssign ************************************* *)

(* ********************************************************************** *)
(* ********************************************************************** *)

errmsgs = {
  {"argument lhs","a (flat) list of the same length as rhs"},
  {"option AssignBreak","False or a List of a positive integer and a string"},
  {"option AssignCase","Default, Lower, or Upper"},
  {"option AssignEnd","a string"},
  {"option AssignFortranNumbers","True or False"},
  {"option AssignHyperbolic","True or False"},
  {"option AssignIndent","a string or a positive integer"},
  {"option AssignIndex","a positive integer or zero"},
  {"option AssignLabel","a string or positive integer"},
  {"option AssignMaxSize","a positive integer (>= 200) or infinity"},
  {"option AssignOptimize","True or False"},
  {"option AssignPrecision","a positive integer or infinity"},
  {"option AssignRange","True or False"},
  {"option AssignReplace","a (possibly empty) list of string replacement rules"},
  {"option AssignTemporary","a list of the form {_Symbol|_String,Sequence|Array}"},
  {"option AssignToArray","a (possibly empty) list of symbols"},
  {"option AssignToFile","a string"},
  {"option AssignTrig","True or False"},
  {"option AssignZero","True or False"}};

(* Function to check the data types of options with error messages. *)

OptionTest[expr_,var_,assignfn_,opts___?OptionQ]:= 
  Module[{defaults=Options[assignfn],optlist,types,linbrk,acase,
    aend,fnumsQ,hypQ,indent,index,albl,amxsz,optQ,
    prec,rangeQ,arep,tvar,atoarry,atofile,trigQ,zeroQ},

    optlist =
      {linbrk,acase,aend,fnumsQ,hypQ,indent,index,albl,amxsz,optQ,
       prec,rangeQ,arep,tvar,atoarry,atofile,trigQ,zeroQ} =
         Map[First,defaults] /. {opts} /. defaults;

    types = {
If[VectorQ[var],
  MatchQ[expr,_List]&&Length[var]===Length[expr],
  If[ListQ[var],False,True]
],
MatchQ[linbrk,False|{_Integer?Positive,_String}],
MatchQ[acase,Default|Lower|Upper],
StringQ[aend],
MatchQ[fnumsQ,True|False],
MatchQ[hypQ,True|False],
StringQ[indent],
MatchQ[index,_Integer?Positive|0],
MatchQ[albl,_Integer?(0<#<100000&)|_String?(StringLength[#]<6&)],
MatchQ[amxsz,_Integer?(#>=200&)|Infinity],
MatchQ[optQ,True|False],
MatchQ[prec,_Integer?Positive|Infinity],
MatchQ[rangeQ,True|False],
MatchQ[arep,{}|{(_String->_String)...}],
MatchQ[tvar,{}|{_Symbol|_String,Sequence|Array}],
MatchQ[atoarry,{___Symbol}],
StringQ[atofile],
MatchQ[trigQ,True|False],
MatchQ[zeroQ,True|False] };

(* Add optimization variable to list of arrays and avoid duplicates. *)

If[optQ&&MatchQ[#,{_Symbol,Array}],
  optlist[[-4]] = Union[ Join[ atoarry, {First[#]} ] ]
]& @ (Optimize`OptimizeVariable /. {opts} /. Options[Optimize`Optimize]);

    Check[
      MapThread[
        If[#1,#1,Message[assignfn::args,Apply[Sequence,#2]]]&,
        {types,errmsgs}
      ]; optlist,      (* Return list of option values. *)
      $Failed,         (* Option of wrong type. *)
      assignfn::args   (* Check only for these messages. *)
    ]
  ];    (* End of OptionTest. *)



(* C assignment format. *)

SetAttributes[CAssign,HoldFirst];

Options[CAssign]:= {
AssignBreak->{Options[$Output,PageWidth][[1,2]]-2,"\\\n"},
AssignCase->Default, AssignEnd->";", AssignFortranNumbers->False, AssignHyperbolic->False,
AssignIndent->"", AssignIndex->0, AssignLabel->"", AssignMaxSize->Infinity,
AssignOptimize->False, AssignPrecision->$MachinePrecision-1,
AssignRange->False, AssignReplace->{" "->""}, AssignTemporary->{"t",Array},
AssignToArray->{}, AssignToFile->"", AssignTrig->True, AssignZero->True};

CAssign[lhs_:"",expr_?(!OptionQ[#]&),opts___?OptionQ]:=
  Module[{optvals},
    optvals /; 
      And[
        (optvals = OptionTest[expr,GetShape[lhs],CAssign,FilterOptions[CAssign,opts]])=!=$Failed,
        optvals = CMain[lhs,expr,optvals,{FilterOptions[Optimize`Optimize,opts]}];
        True
      ]
  ];


(* Perform assignments and code translation. Output resulting list as a 
 column and avoid string delimiters "". *)

SetAttributes[CMain,HoldFirst];

CMain[lhs_,expr_,{linbrk_,acase_,aend_,fnumsQ_,hypQ_,indent_,index_,albl_,
amxsz_,optQ_,prec_,rangeQ_,arep_,tvar_,atoarry_,atofile_,trigQ_,zeroQ_},optopts_]:=
Block[{$RecursionLimit=Infinity},
  Block[atoarry,

    AssignTemporaryIndex = 0;

(* Format C Arrays. *)

    Map[ (Format[#[i__],CForm]:=HoldForm[Part[#,i]])&, atoarry ];

    ColumnForm[
      Flatten[
        CommonAssign[
          Makelhs[lhs,CForm],
          RangeTest[
            CDefs[
              MyN[expr,prec,atoarry,CMain],
            trigQ,hypQ,optQ,prec,atoarry,optopts],
          prec,CForm,rangeQ],
          CForm,
          " = ",acase,aend,tvar,atofile,zeroQ,
          indent,index,albl,linbrk,amxsz,arep
        ]
      ]
    ] //OutputForm
  ]
]; (* End of CMain.*)



(* Define rules for C translation. *)

(* C expression head replacement. *)

SetAttributes[ApplyCDefs,Listable];

ApplyCDefs[expr_]:= CRH[Map[CRH,expr,-2]];

Literal[CRH[ArcTan[x_,y_]]]:= atan2[y,x];

(* Nest logical operators. *)

Literal[CRH[Equal[x_,y_,z__]]]:= Apply[CD[And], Map[CD[Equal][x,#]&,{y,z}] ];
Literal[CRH[e:Unequal[x_,y_,z__]]]:=
  Apply[CD[And],
    Flatten[ Table[Map[CD[Unequal][e[[i]],#]&,Drop[{x,y,z},i]],{i,Length[e]-1}] ]
  ];
Literal[CRH[(h:Greater|GreaterEqual|Less|LessEqual)[x_,y__,z_]]]:=
  Apply[CD[And],MapThread[CD[h],{{x,y},{y,z}}]];
Literal[CRH[Inequality[x_,op_,y_,z__]]]:= CD[And][CD[op][x,y],CRH[Inequality[y,z]]];
Literal[CRH[Inequality[x_,op_,y_]]]:= CD[op][x,y];

(* Recover minus sign. *)

Literal[CRH[Times[-1.,x__]]]:= CD[Times][-1,x];

(* Replace heads in remaining expressions. *)

Literal[CRH[expr_]]:= Operate[CD,expr];

(* Legal C functions. *)

cfuns = {abs,acos,AddTo,asin,atan,atan2,ceil,cos,cosh,Decrement,
  div,DivideBy,exp,fabs,floor,fmod,frexp,Increment,labs,ldexp,ldiv,
  log,log10,mod,modf,pow,Power,PreIncrement,PreDecrement,rand,srand,
  sin,sinh,sqrt,SubtractFrom,tan,tanh,TimesBy};

ANSIC[funct_]:=
 If[MemberQ[cfuns,funct],
   funct,
   (*Message[AssignFunction::undef,funct,"C"];*) funct
 ];

(* Add C definitions. *)

SetAttributes[CDefs,{HoldAll}];

CDefs[expr_,trigQ_,hypQ_,optQ_,prec_,atoarry_,{optopts___}]:=
  Block[{Csc,Cot,Sec,ArcCsc,ArcCot,ArcSec,Csch,Coth,Sech,
    ArcCsch,ArcCoth,ArcSech,acosh,asinh,atanh,CD,pow},
    With[{one=N[1,prec],two=N[2,prec]},
      Module[{optexpr},

(* Handled correctly by CForm. *)

        CD[Times]=Times; CD[Plus]=Plus; CD[Equal]=Equal; CD[Unequal]=Unequal;
        CD[Greater]=Greater; CD[Less]=Less; CD[GreaterEqual]=GreaterEqual;
        CD[LessEqual]=LessEqual; CD[Or]=Or; CD[And]=And; CD[Not]=Not;

(* Needs additional rules. *)

        CD[Power]=Power;

(* Numeric. *)

        CD[Abs]=fabs; CD[Conjugate]=conjg; CD[Floor]=floor; CD[Max]=max;
        CD[Min]=min; CD[Mod]=mod;  CD[Random]=rand; CD[Round]=ceil;
        CD[Sign]=sign; CD[Sqrt]=sqrt;

(* Trigonometric related. *)

        CD[ArcCos]=acos; CD[ArcCosh]=acosh; CD[ArcSin]=asin;
        CD[ArcSinh]=asinh; CD[ArcTan]=atan; CD[ArcTanh]=atanh;
        CD[Cos]=cos; CD[Cosh]=cosh; CD[Sin]=sin; CD[Sinh]=sinh;
        CD[Tan]=tan; CD[Tanh]=tanh; CD[Log]=log; CD[exp]=exp;

(* Numbers. *)

        CD[Complex]=Complex; CD[Rational]=Rational;

(* Arrays. *)

        Map[ (CD[#]=#)&, atoarry];

(* Legal C function? Only check head once. *)

        CD[x_]:= CD[x]=ANSIC[x];

(* Add format rules. *)

        If[trigQ,
          Csc[x_]:= Evaluate[one/CD[Sin][x]];
          Cot[x_]:= Evaluate[one/CD[Tan][x]];
          Sec[x_]:= Evaluate[one/CD[Cos][x]];
          ArcCsc[x_]:= Evaluate[CD[ArcSin][one/x]];
          ArcCot[x_]:= Evaluate[CD[ArcTan][one/x]];
          ArcSec[x_]:= Evaluate[CD[ArcCos][one/x]];
        ];

        If[hypQ,
          Csch[x_]:= Evaluate[one/CD[Sinh][x]];
          Coth[x_]:= Evaluate[one/CD[Tanh][x]];
          Sech[x_]:= Evaluate[one/CD[Cosh][x]];
          ArcCsch[x_]:= Evaluate[CD[ArcSinh][one/x]];
          ArcCoth[x_]:= Evaluate[CD[ArcTanh][one/x]];
          ArcSech[x_]:= Evaluate[CD[ArcCosh][one/x]];
          CD[ArcCosh][x_]:= Evaluate[CD[Log][x+CD[Sqrt][x^2-one]]];
          CD[ArcSinh][x_]:= Evaluate[CD[Log][x+CD[Sqrt][x^2+one]]];
          CD[ArcTanh][x_]:= Evaluate[CD[Log][(one+x)/(one-x)]/two];
          CD[ArcTanh][(x_:one)/y_]:= Evaluate[CD[Log][(y+x)/(y-x)]/two];
        ];

(* Apply formatting rules and optimize. *)

        optexpr = If[optQ, AssignOpt[#,optopts], # ]& @ ApplyCDefs[expr];

(* Add remaining formatting rules. These are applied here to avoid
 any conflict with code optimization. *)

        Block[{Power},

(* Rational powers. *)

          Power[x_,Rational[1,2]]:= Evaluate[CD[Sqrt][x]];
          Power[x_,Rational[-1,2]]:= Evaluate[one/CD[Sqrt][x]];

          Power[a_,Rational[b_,c_]]:=
            With[{nb=N[b,prec],nc=N[c,prec]}, pow[a,HoldForm[nb/nc]] ];

(* Remaining powers. *)

          Power[a_,b_?(NumberQ[#]&&#!=-1&)]:= pow[a,N[b,prec]];
          Power[a_,b_?(#=!=-1&)]:= pow[a,b];

          optexpr

        ]
      ]
    ]
  ];  (* End of CDefs. *)



(* Define assignment for specified format. *)

SetAttributes[Assign,HoldFirst];

Options[Assign]:= {
AssignBreak->{Options[$Output,PageWidth][[1,2]]-1,"\n"},
AssignCase->Default, AssignEnd->"", AssignFortranNumbers->False, AssignHyperbolic->False,
AssignIndent->"", AssignIndex->1, AssignLabel->"", AssignMaxSize->Infinity,
AssignOptimize->False, AssignPrecision->Infinity, AssignRange->False,
AssignReplace->{}, AssignTemporary->{}, AssignToArray->{},
AssignToFile->"", AssignTrig->False, AssignZero->True};


Assign[lhs_:"",expr_?(!OptionQ[#]&),form_?(!OptionQ[#]&),opts___?OptionQ]:=
  Module[{optvals},
    optvals /;
      And[
        (optvals = OptionTest[expr,GetShape[lhs],Assign,opts])=!=$Failed,
            optvals = AMain[lhs,expr,form,optvals]; True
          ]
  ];


(* Perform assignments and code translation. *)

SetAttributes[AMain,HoldFirst];

AMain[lhs_,expr_,form_,{linbrk_,acase_,aend_,fnumsQ_,hypQ_,indent_,index_,
albl_,amxsz_,optQ_,prec_,rangeQ_,arep_,tvar_,atoarry_,atofile_,trigQ_,zeroQ_}]:=
Block[{$RecursionLimit=Infinity},

  AssignTemporaryIndex = 0;

  OutputForm[
    Flatten[
      CommonAssign[
        Makelhs[lhs,form],
        MyN[expr,prec,atoarry],
        form,
        " = ",acase,aend,tvar,atofile,zeroQ,
        indent,index,albl,linbrk,amxsz,arep
      ]
    ] //ColumnForm
  ]
]; (* End of AMain. *)



(* Define main assignment formatting. *)

(* This definition ensures compatibility with the code optimization
 package Optimize.m - which returns a list of replacement rules
 and an optimized expression or list of expressions. *)

CommonAssign[lhs_,{optrules:{__Rule},expr_},form_,args__]:=
  Apply[
    CommonAssign[ Join[Makelhs[#1,form],{lhs}],
      Join[#2,{expr}],form,args]&,
    Thread[optrules,Rule]
  ];

(* Assignments to single expressions. *)

CommonAssign[lhs_,expr_,form_,eqstr_,acase_,aend_,tvar_,atofile_,
  zeroQ_,indent_,index_,albl_,linbrk_,amxsz_,arep_]:=
  Module[{outchan,lbllen,redexpr,strings},

(* Remove zero-valued expressions and add array indices to lhs. *)

    redexpr = RemoveZeros[lhs,expr,form,index,!zeroQ];

(* Break up long expressions and convert to strings. *)

    strings =
      Map[BreakExpression[#,eqstr,amxsz,tvar,form]&,redexpr];

(* Apply string replacement rules and indentation/termination strings. *)

    strings =
      Map[
        StringJoin[ indent, #, aend ]&,
        StringReplace[ Flatten[{strings}],arep ]
      ];

(* Attach a label to the first expression. *)

    label = ToString[albl];  lbllen = StringLength[label];

    If[ lbllen =!=0,
      strings[[1]] = StringJoin[label,StringDrop[strings[[1]],lbllen]]
    ];

(* Convert to Lower, or Upper case. *)

    Switch[acase,
      Upper,strings = Map[ToUpperCase,strings],
      Lower,strings = Map[ToLowerCase,strings]
    ];

(* Add continuation characters to break up long lines of code. *)

    If[ListQ[linbrk], strings = Map[BreakLines[#,linbrk]&,strings] ];

(* Output results to a file. *)

    If[atofile=!="",
      outchan = OpenWrite[atofile,FormatType->OutputForm];
      Write[outchan, strings //ColumnForm];
      Close[outchan] ];

    strings    (* Output. *)

  ];  (* End of CommonAssign. *)



(* Add index and delete zero-valued elements. *)

(* Remove zero-valued elements. The variable index is used as
 an offset for the starting index. *)

(* Lists of assignments (remove outer List). *)

RemoveZeros[lhs_List,rhs_List,format_,index_,remzero_]:=
  Apply[Join,MapThread[ RemoveZeros[#1,#2,format,index,remzero]&, {lhs,rhs} ]];

(* No zeros removed. *)

RemoveZeros["",rhs_List,format_,index_,False]:= Thread[{"",Flatten[rhs]}];

RemoveZeros[lhs_,rhs_List,format_,index_,False]:=
  JoinIndices[lhs,FindPositions[rhs,Null],Flatten[rhs],format,index];

RemoveZeros[lhs_,rhs_,format_,index_,False]:= {{lhs,rhs}};

(* Zeros removed. *)

(* Check for expressions with no non-zeros present. *)

AssignZero::continue = "Expression encountered with no non-zero elements.
Continuing with zero assignments.";

RemoveZeros[lhs_,0,format_,index_,True]:=
  (Message[AssignZero::continue]; {{lhs,0}});

RemoveZeros["",rhs_List,format_,index_,True]:=
  Module[{redrhs = Flatten[Delete[rhs,Position[rhs,0,Heads->False]]]},
    If[redrhs==={}, Message[AssignZero::continue]; redrhs = Flatten[rhs]];
    Thread[{"",redrhs}]
  ];

RemoveZeros[lhs_,rhs_List,format_,index_,True]:=
  Module[{redrhs = Flatten[Delete[rhs,Position[rhs,0,Heads->False]]],posntest=0},
    If[redrhs==={},
      Message[AssignZero::continue]; redrhs = Flatten[rhs]; posntest=Null;];
    JoinIndices[lhs,FindPositions[rhs,posntest],redrhs,format,index]
  ];

RemoveZeros[lhs_,rhs_,format_,index_,True]:= {{lhs,rhs}};

(* Find positions of non-null and non-zero elements. *)

FindPositions[expr_,Null]:=
  Position[ Function[x,UnsameQ[x,Null],Listable][expr],True,Heads->False];

FindPositions[expr_,0]:=
  Position[ Function[x,UnsameQ[x,0]&&UnsameQ[x,Null],Listable][expr],True,Heads->False];

(* Join index string to lhs string. *)

JoinIndices[lhs_,posns_List,rhs_,format_,index_]:=
  (MapThread[
    {StringJoin[ lhs, StringIndex[#1,format] ],#2}&,
    {posns+index-1,Flatten[rhs]}
  ]);

(* StringIndex is used to convert the position into the
 appropriate form for an array element. *)

StringIndex[psn_,CForm]:= 
  StringReplace[ ToString[psn] ,{"{"->"[","}"->"]",", "->"]["}];

(* Default is FORTRAN case. *)

StringIndex[psn_,_]:= 
  StringReplace[ ToString[psn] ,{"{"->"(","}"->")"}];



(* Break up large expressions into sub-expressions. *)

BreakUp[subexpr_,maxlen_,temp_]:=
  If[LengthTest[subexpr,maxlen],
    Fragment[subexpr,maxlen,temp],
    subexpr (* else *)
  ];

(* Add temporary variable and sub-expression to list. *)

AddTemp[temp_,subexpr_]:= (parts = Join[parts,{{temp,subexpr}}]; temp);

(* Test used for permissible sub-expression size. *)

LengthTest[expr_,maxlen_]:= ByteCount[expr]>maxlen;

(* Ignore numeric exponents, temporary variables etc. *)

Fragment[subexpr:(_temp|_?AtomQ),maxlen_,tmpvar_]:= subexpr;

(* Binary decomposition of Plus and Times. *)

Fragment[subexpr:(_Plus|_Times),maxlen_,temp_]:=
  If[LengthTest[subexpr,maxlen],
    With[{quo = Quotient[Length[subexpr],2]},
      BreakUp[
        Head[subexpr][
          Fragment[Take[subexpr,quo],maxlen,temp],
          Fragment[Drop[subexpr,quo],maxlen,temp]
        ],
      maxlen,temp]
    ],
    AddTemp[temp[++index],subexpr] (* else *)
  ];

(* n-ary decomposition of remaining functions. *)

Fragment[subexpr_,maxlen_,temp_]:=
  If[LengthTest[subexpr,maxlen],
    BreakUp[Map[Fragment[#,maxlen,temp]&,subexpr],maxlen,temp],
    AddTemp[temp[++index],subexpr] (* else *)
  ];


(* Recursively decompose expression. *)

BreakExpression[args_,eqstr_,Infinity,_,form_]:=
  MyFormat[args,eqstr,form];

Assign::notemp = "No temporary variable was specified. Continuing
with original expression.";

BreakExpression[args_,eqstr_,maxlen_,{}|{"",_},form_]:=
  (Message[Assign::notemp]; MyFormat[args,eqstr,form]);

BreakExpression[{lhs_,expr_},eqstr_,maxlen_,{tvar_,tform_},form_]:=
  Block[{index=0,parts={},$RecursionLimit=Infinity},
    Module[{outexpr,tmp},

(* Array or sequence of temporaries. *)

      If[tform===Array,
        If[form===CForm,
          Format[tmp[i_],form]:=HoldForm[Part[#,i]],
          Format[tmp[i_],form]:=#[i]
        ],
        Format[tmp[i_],form]:= SequenceForm[#,i]
      ]& @ ToExpression[ToString[tvar]];

(* Recursively break up expression and re-use temporary variables. *)

      outexpr = BreakUp[expr,maxlen,tmp];

(* Store maximum number of temporaries introduced. *)

      If[ index>AssignTemporaryIndex, AssignTemporaryIndex=index ];

(* Output list of temp strings and final expression. *)

      {Map[ MyFormat[#,eqstr,form]&, parts ],
       MyFormat[{lhs,outexpr},eqstr,form]}
    ]
  ]; (* End of BreakExpression *)


(* Convert the expression to a string of appropriate form. *)

MyFormat[{"",expr_},_,form_]:= ToString[ expr, FormatType->form ];

MyFormat[{lhs_String,expr_},eqstr_,form_]:=
  StringJoin[ lhs, eqstr, ToString[ expr, FormatType->form ] ];

MyFormat[{lhs_,expr_},eqstr_,form_]:=
  StringJoin[
    ToString[ lhs, FormatType->form ],
    eqstr,
    ToString[ expr, FormatType->form ]
  ];


(* Break up long lines of code and add continuation characters. *)

BreakLines[string_,{lineln_,indstr_}]:= 
  Module[{indlen=StringLength[indstr],linelen,numlines,
    strlen=StringLength[string]},

(* (\n is counted as one character). *)

    linelen = lineln - indlen + 1;

    If[strlen >=linelen,
      numlines = Floor[(strlen - (linelen+indlen))/linelen];
      StringJoin[
        StringTake[string,indlen-1],  (* first part *)
          Table[
            StringTake[
              string,                         (* middle part *)
              {linelen i + indlen,
               linelen (i+1) + indlen-1}
            ]<>indstr
          ,{i,0,numlines}],
          StringTake[
            string                            (* end part *)
          ,((numlines+1) linelen + indlen-1) - strlen]
        ],
        string (* else *)
      ]
    ];  (* End of BreakLines. *)


(* Determine `shape' of lhs lists. Extract elements to avoid evaluation. *)

SetAttributes[GetShape,{Listable,HoldAll}];
GetShape[_]:="";


(* Make lhs into a list of held strings. *)

SetAttributes[Makelhs,{Listable,HoldAll}];
Makelhs[lhs_String,_]:= lhs;
Makelhs[lhs_,InputForm]:= ToString[ HoldForm[lhs] ];
Makelhs[lhs_,form_]:= ToString[ form[HoldForm[lhs]] ];


(* Slightly modified version of N. Arguments to specified
 symbols are temporarily protected from N. *)

SetAttributes[MyN,HoldAll];

(* Protect exponential from N. *)

MyN[expr_,_DirectedInfinity,_,CMain|FMain]:=
  Block[{E}, E /: Power[E,x_]:= exp[x]; expr ];

(* Approximate numeric Exp. *)

MyN[args__,CMain|FMain]:=
  Block[{E}, E /: Power[E,x_?(!NumberQ[#]&)]:= exp[x]; MyN[args] ];

(* Infinite Precision. *)

MyN[expr_,_DirectedInfinity,__]:= expr;

(* Finite precision. *)

MyN[expr_,prec_,{}]:=
  If[prec===$MachinePrecision,
    #,
    # //. {r_Real:>SetPrecision[r,prec]}
  ]& @ N[ expr, prec ];

(* Finite Precision, protect array arguments from N. *)

MyN[expr_,prec_,atoarry_]:=
  Block[atoarry,
    SetAttributes[atoarry,NProtectedAll];
    MyN[ expr, prec, {} ]
  ];


(* Optimize expressions. *)

AssignOpt[expr_,optopts___?OptionQ]:=
  Check[
    RuleGen[
      Optimize`Optimize[expr,optopts],
      expr
    ],
    Message[AssignOptimize::fail]; expr, (* Else proceed with unoptimized expression. *)
    Optimize`Optimize::args              (* Check only for this message. *)
  ];

(* Check for optimization. *)

RuleGen[{{},expr_},expr_]:= expr;     (* No optimization. *)
RuleGen[optexpr_,_]:= optexpr;        (* Optimization. *)



(* Test range of real and integer numbers. *)

spc = {2.^-125,2.^128,HoldForm[-2^31],HoldForm[2^31-1],-2^31,2^31-1,"single"};
dpc = {2.^-1021,2.^1024,HoldForm[-2^63],HoldForm[2^63-1],-2^63,2^63-1,"double"};

SetAttributes[RangeTest,HoldFirst];

RangeTest[expr_,nprec_,form_,False]:= expr;

RangeTest[expr_,nprec_,CForm,True]:=
  CheckRange[expr,CForm,If[nprec<=8, spc, dpc]];

AssignRange::float = "Expression contains machine numbers outside
the permissible range `1` to `2` for IEEE `3` precision.";

AssignRange::integer = "Expression contains integers outside the
permissible range `1` to `2` which cannot be represented in IEEE
`3` precision and have been converted to floating point numbers.";

CheckRange[expr_,form_,{xrmin_,xrmax_,xihmin_,xihmax_,ximin_,ximax_,prec_}]:=
  Module[{complxQ,intmsg=True,intQ,realQ,rlmsg=True},

    realQ = r_Real?((Abs[#]>xrmax||Abs[#]<xrmin)&&rlmsg&):>
              (If[rlmsg, rlmsg=False; Message[AssignRange::float,xrmin,xrmax,prec]];
                 r);

    intQ = i_Integer?(#>ximax||#<ximin&):>
             (If[intmsg,  intmsg=False; Message[AssignRange::integer,xihmin,xihmax,prec]];
                N[i] /. realQ);

    cmplxQ = Complex[r_,i_]:>Complex[r /. {realQ,intQ},i /. {realQ,intQ}];

    expr /. {realQ,intQ,cmplxQ}
  ]; (* End of CheckRange. *)

(* ********************************************************************** *)
(* ********************************************************************** *)

(* ********************************************************************** *)
(* ********************************************************************** *)


Print["  *** MEXTools successfully loaded ***"];

End[]

Protect[abs,acos,acosh,Ai,aimag,aint,alog,alog10,amax0,amax1,amin0,amin1,
amod,and,anint,arccos,arccosh,arccot,arccoth,arccsc,arccsch,arcsec,arcsech,arcsin,
arcsinh,arctan,arctanh,asin,asinh,atan,atan2,atanh,bernoulli,Bi,binomial,cabs,
ccos,ceil,cexp,char,Ci,clog,cmplx,collect,conjg,cos,cosh,cot,coth,csc,csch,csin,
csqrt,dabs,dacos,dasin,datan,datan2,dble,dcos,dcosh,ddim,denom,dexp,dilog,dim,
dint,dlog,dlog10,dmax1,dmin1,dmod,dnint,dprod,dsign,dsin,dsinh,dsqrt,dtan,dtanh,
Ei,erf,erfc,euler,evalf,exp,expand,fabs,factor,factorial,false,float,fsolve,GAMMA,iabs,
ichar,idim,idint,idnint,ifix,index,infinity,int,isign,len,lge,lgt,lle,llt,log,log10,lnGAMMA,
map,max,max0,max1,min,min0,min1,mod,mtaylor,nint,not,NULL,num,op,or,pow,Psi,real,RootOf,
round,sec,sech,series,Si,sign,sin,sinh,sngl,solve,sqrt,subs,tan,tanh,true,
Lower,Upper];

EndPackage[ ]

(* ********************************************************************** *)
(* ********************************************************************** *)
If[!spell1, On[General::spell1]];
If[!spell, On[General::spell]];

