ETHZ_Logo RAMSES_Logo_Right   RAMSES   RAMSES_Logo_Left Systems Ecology  
Start    search button      Modules:   A-Z   Function   Layer        QuickRefs:   DM   AuxLib   AuxLibE   SciLib   EasyMW   MW   ISIS   RMSLib

DEFINITION MODULE SimBase;

  (*******************************************************************

    Module  SimBase     (MW_V3.0)

      Copyright (c) 1986-2006 by Markus Ulrich, Andreas Fischlin, Dimitrios
      Gyalistras, Olivier Roth and ETH Zurich.

    Purpose   Run time library containing basic objects for the
              declaration of models, state variables, model parameters,
              and monitorable variables.  Furthermore there
              are procedures which may be used by the modeller
              to set or get defaults, current values and to control
              simulations in various ways.

    Remarks   This module is part of the mandatory client interface of
              'ModelWorks', an interactive Modula-2 modelling and
              simulation environment.


    Programming

      o Design
        Markus Ulrich             20/08/1986
        Andreas Fischlin          02/05/1987

      o Implementation
        Markus Ulrich             20/08/1986
        Andreas Fischlin          02/05/1987
        Dimitrios Gyalistras      13/06/1989
        Olivier Roth              23/06/1989


    ETH Zurich
    Systems Ecology
    CHN E 35.1
    Universitaetstrasse 16
    8092 Zurich
    SWITZERLAND

    URLs:
        <mailto:RAMSES@env.ethz.ch>
        <http://www.sysecol.ethz.ch>
        <http://www.sysecol.ethz.ch/SimSoftware/RAMSES>


    Last revision of definition:  24/09/1997  AF

  *******************************************************************)


  FROM SYSTEM IMPORT ADDRESS;


  (*********************************************************)
  (*#####   Declaration of models and model objects   #####*)
  (*********************************************************)


  (*---------------------------------*)
  (*=====   Model declaration   =====*)
  (*---------------------------------*)

  TYPE

    Model; (* variables of this type are used to reference models *)

    (* Model objects, always belonging to a model *)

    StateVar    = REAL;
    Derivative  = REAL;
    NewState    = REAL;
    Parameter   = REAL;
    AuxVar      = REAL;
    InVar       = REAL;
    OutVar      = REAL;

    IntegrationMethod = (Euler, Heun, RungeKutta4,
                         RungeKutta45Var, stiff,
                         discreteTime, discreteEvent);

  VAR
    notDeclaredModel: Model; (* read only variable, e.g. use it for initializations *)


  PROCEDURE DeclM(VAR m: Model; defaultMethod: IntegrationMethod;
                  initialize, input, output, dynamic, terminate: PROC;
                  declModelObjects: PROC;
                  descriptor, identifier: ARRAY OF CHAR; about: PROC);

  (*
    Model declaration ("Declare model"):

     m      variable, to be declared in client module(s), used for
            further references to the (sub)model.

     defaultMethod:
            Default integration method of (sub)model m

            2 cases have to be distinguished:
            - discrete: discrete time model (system of ordinary
                        difference equations)
                        IMPORTANT NOTE: this method can NOT be
                        changed! The default and the current
                        method will always be the same.
            - continuous method (e.g. Heun): continuous time
                        numerical integration method for solving
                        ordinary differential equations is being
                        installed; This method is associated with
                        (sub)model m (any model may have
                        a different method), and is stored for
                        reinstallation for resetting after
                        eventual interactive selection of a
                        different method.  Note: the size of
                        the integration step is the same for
                        all (sub)models, except for the discrete
                        time (sub)models, which may have individual
                        time steps.

                        The default integration method is
                        (re)assigned to the current integration
                        method by ModelWorks during the
                        initialization phase of the simulation
                        session or after every reset of the
                        integration methods.  During a simulation
                        session the current integration method may
                        be changed by the simulationist (using an
                        IO-window) or by the modeller via the
                        procedure SetM.

     initialize
            For any initializations before a simulation run.  It is
            only called once at the begin of a simulation run.

     input
            Calculates the input variables of (sub)model m.  It is
            only called once during a time (integration) step.

     output
            Calculates the output variables of (sub)model m. It is
            only called once during a time (integration) step.
            Implementation restriction: Output variables must not
            depend directly on input variables.

     dynamic
            Contains equations of (sub)model m.
              - continuous time: calculates the new derivatives from
                the current values of the state variables. Depending
                on the order of the integration method, this procedure
                is called at least once up to several times during
                one time (integration) step.
              - discrete time: calculates new values of the state
                variables. It is only called once during a time
                step (also called integration step).

     terminate
            For any termination actions to be performed just
            before leaving a simulation run.  It is only called
            once at the end of a simulation run.

     installModelObjects
            Procedure declaring all model objects, i.e. state
            variables, model parameters, and monitorable variables
            of (sub)model m.  Implementation restriction:
            Declarations of (sub)models within this procedure are
            not allowed.

     descriptor
            String containing a long description of (sub)model m

     identifier
            Short string identifying (sub)model m

     about
            Procedure writing additional information about the
            (sub)model, e.g. by using routines from the "Dialog
            Machine" module DMWindIO, into a special help window.
  *)

  PROCEDURE CurCalcM(): Model;
  (*
    Returns model of which the initialize, input, output, or
    dynamic etc. procedure is currently calculated. The value
    notDeclaredModel is returned if (SimMaster.MWState <>
    simulating) or (SimMaster.MWSubState <> running).
  *)

  PROCEDURE CurAboutM(): Model;
  (*
    Returns model of which the about procedure is currently
    executed. The value notDeclaredModel is returned if this
    procedure is called outside 'about'.
  *)


  (*
    The following empty body procedures allow to declare a model
    with minimum effort, i.e. use any of these procedures as actual
    parameters when calling DeclM if for instance only Dynamic is
    to be used for the model definition
  *)
  PROCEDURE NoInitialize;
  PROCEDURE NoInput;
  PROCEDURE NoOutput;
  PROCEDURE NoDynamic;
  PROCEDURE NoTerminate;
  PROCEDURE NoModelObjects;
  PROCEDURE NoAbout;
  PROCEDURE DoNothing;



  (*------------------------------------------*)
  (*=====   State variable declaration   =====*)
  (*------------------------------------------*)

  PROCEDURE DeclSV(VAR s: StateVar; VAR ds: Derivative (* or NewState*);
                   defaultInitial, minCurInit, maxCurInit: REAL;
                   descriptor, identifier, unit: ARRAY OF CHAR);

  (*
    State variable declaration ("Declare as state variable"):

     s
        Variable to be declared as state variable.  "DeclSV" does assign
        to "s" the value "defaultInitial".

     ds
        Variable to be declared as the derivative (for continuous
        time simulation / type Derivative) or the new value (for
        discrete time simulation / type NewState) of "s". The
        derivative or the new value must be written into this
        variable by the procedure "dynamic" (see procedure DeclM),
        which is called during the numerical integration by
        ModelWorks' run time system. Consider ds as
        "dummy"-variable, which may appear only on the left side of
        the dynamic equations in procedure "dynamic".  Warning:
        Any further use may lead to unpredictable results.
        "DeclSV" assigns to "ds" the value 0.0.

     defaultInitial
        Default initial value for state variable "s".
        ModelWorks uses the current initial value at the beginning
        of each simlation run to initialize "s".  The default
        initial value is (re)assigned to the current initial value
        by ModelWorks during the initialization phase of the
        simulation session or after every reset of the state
        variables.  During a simulation session the current initial
        value may be changed by the simulationist (using an
        IO-window) or by the modeller via the procedure SetSV.

            The modeller could also overwrite the value of s with
            another value within procedure Initial (see procedure
            DeclM), since ModelWorks has already assigned the
            current initial value to the state variable s. Note
            however, that in the latter case inconsistencies might
            occur between the display of the current value in the
            IO-window with the current values actually used in the
            simulations. Avoid this method.

     minCurInit, maxCurInit
        Lower and upper bounds for the current initial value.
        Attempts by the simulationist to assign values out of this
        range are not accepted.

     descriptor
        String containing a long description of the state variable s.
        This string may be truncated when it is displayed during a
        simulation session (see also identifier).

     identifier
        Short string identifying the state variable s.  This
        abbreviated description should be kept as small as possible
        in order to ensure full visibility for the displays during
        a simulation session.

     unit
        String containing the unit used for the state variable s.
        This string is used for displays during a simulation
        session. Example: "kcal/m2/day".
  *)



  (*-------------------------------------------*)
  (*=====   Model parameter declaration   =====*)
  (*-------------------------------------------*)

  TYPE
    RTCType = (rtc, noRtc);

  PROCEDURE DeclP(VAR p: Parameter; defaultVal, minCurVal, maxCurVal: REAL;
                  runTimeChange: RTCType;
                  descriptor, identifier, unit: ARRAY OF CHAR);
  (*
    Model parameter declaration "Declare as parameter":

     p
        Variable to be declared as model parameter. "DeclP" assigns
        to "p" the value of "default". If the value of "p" should
        be out of range [minCurVal, maxCurVal], a warning message will be
        produced.

     defaultVal
        Default value for the model parameter "p".
        The default value is (re)assigned to the current parameter
        value p by ModelWorks during the initialization phase of
        the simulation session or after every reset of the model
        parameters. During a simulation session the current
        parameter value p may be changed by the simulationist
        (using an IO-window) or by the modeller via overwriting the
        value of p with another value, e.g. within procedure
        Initial (see also procedure DeclM).

     minCurVal, maxCurVal
        Lower and upper value bounds for "p".
        Attempts by the simulationist to assign values out of this
        range are not accepted.

     runTimeChange
        "rtc" (=run time change) changing of values of model parameter
            "p" during a simulation run in the program state "Pause"
            is enabled.
        "noRtc" (=no run time change) disallows  completely  any changing
            of values of the model parameter "p" during a
            simulation run, even in the program state
            "Pause".

     descriptor/identifier
        Strings containing a long and a short description (identifier) of
        the model parameter p.

     unit
        Unit of model parameter p.

  *)


  (*------------------------------------------------*)
  (*=====   Monitorable variable declaration   =====*)
  (*------------------------------------------------*)

  TYPE
    StashFiling = (writeOnFile, notOnFile);
    (*
       controls stashing away (writing) of simulation results on the
       stash file (a text file) for future reference.
    *)

    Tabulation = (writeInTable, notInTable);
    (* controls tabulation of simulation results in the table window *)

    Graphing = (isX, isY, isZ, notInGraph);
    (* Kind of graphical monitoring of simulation results in the graph *)


  PROCEDURE DeclMV(VAR mv: REAL; defaultScaleMin, defaultScaleMax: REAL;
                   descriptor, identifier, unit: ARRAY OF CHAR;
                   defaultSf: StashFiling; defaultT: Tabulation; defaultG: Graphing);

  (*
    Declaration of monitorable variable "Declare as monitorable
    variable":

     mv
        The variable to be declared as monitorable variable.
        Note:  "DeclMV" assigns to "mv" the value 0.0.

     defaultScaleMin/defaultScaleMax
        Default minimum and maximum values used for the scaling of
        the curve to the ordinate while drawing values of the
        monitorable variable mv in the graph.
        The default minimum and maximum of the ordinate scale is
        (re)assigned to the current scale minimum and scale maximum
        by ModelWorks during the initialization phase of the
        simulation session or after every reset of the scaling.
        During a simulation session the current scale minimum and
        scale maximum may be changed by the simulationist (using an
        IO-window) or by the modeller via procedure SetMV.

     descriptor/identifier
        Strings containing a long and a short description (identifier) of
        the monitorable variable mv.

     unit
        Unit of monitorable variable mv.

     defaultSf, defaultT, defaultG
        Default settings for the kind of monitoring for the
        monitorable variable mv.  If defaultSf, defaultT, defaultG
        are selected to be written on a file, tabulated or to be
        plotted, the values of the variable mv is written in the
        default stashFile, resp. table, or drawn in the graph as a
        curve vs the current independent variable. The defaults for
        the kind of monitoring are (re)assigned to the current kind
        by ModelWorks during the initialization phase of the
        simulation session or after every reset of the stash
        filing, tabulation respectively graphing. During a
        simulation session the current kind of monitoring may be
        changed by the simulationist (using the IO-window for
        monitorable variables)  or by the modeller via procedure
        SetMV.
   *)


  PROCEDURE SelectM (m: Model; VAR done: BOOLEAN);

  (*
    Overrides current selection of the model to which model objects
    will be attached after their declaration by means of the
    procedures DeclSV, DeclP and DeclMV. A call to "DeclM" allways
    resets this selection to the model it is declaring. The current
    selection remains unchanged, if m can not be found ("done" will
    then be returned FALSE). If a selected model is removed by a call
    to "RemoveM" (see below), the selection is reset to the last
    declared model.
  *)



  (*******************************************************)
  (*#####   Modifying of models and model objects   #####*)
  (*******************************************************)

  (*
    The model and model objects themselves are static and once
    declared may not be changed during a simulation session.
    However, it is possible to modify the attributes and values
    associated with a model or model object.  Modifications are
    supported by the existence of procedure pairs:  a get and a set
    procedure.  Moreover the procedures are grouped into two sets:
    The first set is to modify the defaults, the other to modify
    the current values.  The meaning of the parameters are the same
    as listed under the declaration procedures DeclM, DeclSV,
    DeclP, and DeclMV. The parameter lists are kept similar to the
    ones used by the declaration procedures; with one exception:
    the procedure installModelObjects to declare the model objects
    may not be accessed because of the object's static nature.
  *)


  (*******************************************************************)
  (*#####   Modifying of defaults of models and model objects   #####*)
  (*******************************************************************)

  PROCEDURE GetDefltM(VAR m: Model; VAR defaultMethod: IntegrationMethod;
                      VAR initialize, input, output, dynamic, terminate: PROC;
                      VAR descriptor, identifier: ARRAY OF CHAR; VAR about: PROC);
  PROCEDURE SetDefltM(VAR m: Model; defaultMethod: IntegrationMethod;
                      initialize, input, output, dynamic, terminate: PROC;
                      descriptor, identifier: ARRAY OF CHAR; about: PROC);

  PROCEDURE GetDefltSV(m: Model; VAR s: StateVar; VAR defaultInit,
                       minCurInit, maxCurInit: REAL;
                       VAR descriptor, identifier, unit: ARRAY OF CHAR);
  PROCEDURE SetDefltSV(m: Model; VAR s: StateVar; defaultInit,
                       minCurInit, maxCurInit: REAL;
                       descriptor, identifier, unit: ARRAY OF CHAR);

  PROCEDURE GetDefltP(m: Model; VAR p: Parameter; VAR defaultVal, minCurVal, maxCurVal: REAL;
                      VAR runTimeChange: RTCType;
                      VAR descriptor, identifier, unit: ARRAY OF CHAR);
  PROCEDURE SetDefltP(m: Model; VAR p: Parameter; defaultVal, minCurVal, maxCurVal: REAL;
                      runTimeChange: RTCType;
                      descriptor, identifier, unit: ARRAY OF CHAR);

  PROCEDURE GetDefltMV(m: Model; VAR mv: REAL; VAR defaultScaleMin, defaultScaleMax: REAL;
                       VAR descriptor, identifier, unit: ARRAY OF CHAR;
                       VAR defaultSf: StashFiling; VAR defaultT: Tabulation;
                       VAR defaultG: Graphing);
  PROCEDURE SetDefltMV(m: Model; VAR mv: REAL; defaultScaleMin, defaultScaleMax: REAL;
                       descriptor, identifier, unit: ARRAY OF CHAR;
                       defaultSf: StashFiling; defaultT: Tabulation;
                       defaultG: Graphing);
  (*
    Setting defaults with any of above procedures will not imply a
    setting of the current values also, i.e. no implicit reset!
    Until the next corresponding reset, no changes will become
    effective or visible.  Only the change of the descriptors,
    identifiers, and the unit strings as well as the change of the
    range boundaries (used during the interactive changing of
    initial values or model parameter values via IO-windows) will
    become effective immediately.
  *)


  (*************************************************************************)
  (*#####   Modifying of current values of models and model objects   #####*)
  (*************************************************************************)

  PROCEDURE GetM (VAR m: Model; VAR curMethod: IntegrationMethod);
  PROCEDURE SetM (VAR m: Model; curMethod: IntegrationMethod);

  PROCEDURE GetSV (m: Model; VAR s: StateVar; VAR curInit: REAL);
  PROCEDURE SetSV (m: Model; VAR s: StateVar; curInit: REAL);

  PROCEDURE GetP (m: Model; VAR p: Parameter; VAR curVal: REAL);
  PROCEDURE SetP (m: Model; VAR p: Parameter; curVal: REAL);

  PROCEDURE GetMV (m: Model; VAR mv: REAL; VAR curScaleMin, curScaleMax: REAL;
                   VAR curSf: StashFiling; VAR curT: Tabulation;
                   VAR curG: Graphing);
  PROCEDURE SetMV (m: Model; VAR mv: REAL; curScaleMin, curScaleMax: REAL;
                   curSf: StashFiling; curT: Tabulation; curG: Graphing);
  (*
    If SetMV is called in the middle of a simulation run (progam
    state 'Running') the call will have no effect at all!  SetM
    should not be called from within procedure Dynamic, all other
    Set procedures may be called freely and the effect will be
    immediate.  Note however, that the change of an initial value,
    even if it is immediate, won't affect an already running
    simulation;  the change will become effective only at the begin
    of the next simulation run.
  *)


  (***************************************************************)
  (*#####   Resetting of current values to their defaults   #####*)
  (***************************************************************)

  PROCEDURE ResetAllIntegrationMethods;
  PROCEDURE ResetAllInitialValues;
  PROCEDURE ResetAllParameters;

  PROCEDURE ResetAllScaling;
  PROCEDURE ResetAllStashFiling;
  PROCEDURE ResetAllTabulation;
  PROCEDURE ResetAllGraphing;

  (*
    The first three procedures reset all currently declared models,
    state variables and parameters, respectively, to their default
    values. The second four procedures operate on the respective
    attributes of all currently declared monitorable variables.
  *)


  (******************************************************************)
  (*#####   Attaching attributes to models and model objects   #####*)
  (******************************************************************)

  TYPE
    Attribute = INTEGER;

  CONST
    noAttr = MIN(Attribute);

  PROCEDURE SetModelAttr(m: Model; val: Attribute);
  PROCEDURE GetModelAttr(m: Model): Attribute;

  PROCEDURE SetObjAttr(m: Model; VAR o: REAL; val: Attribute);
  PROCEDURE GetObjAttr(m: Model; VAR o: REAL): Attribute;

  (*
    You may associate with any model or model object an integer
    attribute by calling SetModelAttr or SetObjAttr respectively.
    This attribute's value may then be freely
    used via SetObjAttr for assignments or GetObjAttr for retrieval
    purposes. Attributes are particularly useful when using one of
    the following DoForAllXYZ procedures.  Note that in case there
    is currently no attribute attached to a model or object, the
    value noAttr is returned by ModelWorks.
  *)



  (*******************************************************************)
  (*#####   Access helps for all models and all model objects   #####*)
  (*******************************************************************)


  PROCEDURE MDeclared(m: Model): BOOLEAN;
  PROCEDURE SVDeclared(m: Model; VAR sv: StateVar): BOOLEAN;
  PROCEDURE PDeclared(m: Model; VAR p: Parameter): BOOLEAN;
  PROCEDURE MVDeclared(m: Model; VAR mv: REAL): BOOLEAN;
  (*
    Above routines allow to test whether a model or a model
    object is currently declared.
  *)

  TYPE
    ModelProc       = PROCEDURE( VAR Model, VAR Attribute );
    ModelObjectProc = PROCEDURE( Model, VAR REAL, VAR Attribute );

  PROCEDURE DoForAllModels( p: ModelProc );
  PROCEDURE DoForAllSVs   ( m: Model; p: ModelObjectProc );
  PROCEDURE DoForAllPs    ( m: Model; p: ModelObjectProc );
  PROCEDURE DoForAllMVs   ( m: Model; p: ModelObjectProc );
  (*
    Be careful when using these procedures, since they allow
    to access also models and model objects which might not
    belong to the caller.
  *)




  (******************************************************)
  (*#####   Removing of models and model objects   #####*)
  (******************************************************)


  PROCEDURE RemoveM     (VAR m: Model);
  PROCEDURE RemoveSV    (m: Model; VAR s : StateVar);
  PROCEDURE RemoveMV    (m: Model; VAR mv: REAL);
  PROCEDURE RemoveP     (m: Model; VAR p : Parameter);
  PROCEDURE RemoveAllModels;



  (**********************************************************************)
  (*#####   Global simulation parameters and project description   #####*)
  (**********************************************************************)

  (*-----------------------------------*)
  (*=====   Setting of defaults   =====*)
  (*-----------------------------------*)

  PROCEDURE SetDefltGlobSimPars(    t0, tend, h, er, c, hm: REAL);
  PROCEDURE GetDefltGlobSimPars(VAR t0, tend, h, er, c, hm: REAL);

  PROCEDURE SetDefltProjDescrs(    title,remark,footer: ARRAY OF CHAR;
                                   wtitle,wremark,autofooter,
                                   recM, recSV, recP, recMV, recG: BOOLEAN);
  PROCEDURE GetDefltProjDescrs(VAR title,remark,footer: ARRAY OF CHAR;
                               VAR wtitle,wremark,autofooter,
                                   recM, recSV, recP, recMV, recG: BOOLEAN);
  (*
    Sets or gets the defaults for the global simulation parameters
    or the project description plus the recording option flags.
    Where:

     t0         Simulation start time
     tend       Simulation stop time
     h          Integration step (if fixed step length method)
                maximum integration step (if at least one variable
                                         step length method in use)
                (h is only used if at least one continuous time
                model present, otherwise ignored)
     er         Maximum relative local error
                (er is only used if at least one variable step length
                method in use)
     c          Discrete time step (if only discrete time models present)
                Coincidence interval (if continous as well as discrete
                                     discrete time models present)
     hm         Monitoring interval

     title      Project title string
     remark     Remark string
     footer     Footer string
     wtitle     With title in graph
     wremark    With remarks in graph
     autofooter Automatic update of date, time, and run# in footer
     recM       Recording of data on models in stash file
     recSV      Recording of data on state variables in stash file
     recP       Recording of data on model parameters in stash file
     recMV      Recording of data on monitorable variables in stash file
     recG       Automatic dumping of the current graph once a
                simulation run has been completed onto the stash
                file (RTF-Format which can be opened by Microsoftš
                Word document processing software)

    The call of procedure SetDefltGlobSimPars or SetDefltProjDescrs
    will have no effect until the global simulation parameters
    respectively the project description are reset.
  *)

  PROCEDURE SetDefltTabFuncRecording( recTF: BOOLEAN);
  PROCEDURE GetDefltTabFuncRecording( VAR recTF: BOOLEAN);
  (*
    Set or get the default for the recording option flag of table
    functions.
  *)

  PROCEDURE SetDefltIndepVarIdent(descr,ident,unit:   ARRAY OF CHAR);
  PROCEDURE GetDefltIndepVarIdent(VAR descr, ident, unit: ARRAY OF CHAR);
  (*
    Set or get the default descriptor, identifier and  unit of the
    default independent variable, which is used by ModelWorks if no
    monitorable variable has been selected as independent variable
    ('X', 'isX').  The predefined values ModelWorks uses are
    descriptor = "time", ident = "t" and unit = "".  Setting of
    the defaults will become visible once the global simulation
    parameters are reset.
  *)


        (* * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
        The following procedures are actually only kept for upward
        compatibility with previous versions of the ModelWorks client
        interface. Their functions are also available (>= V1.2) by
        using the procedure SetDefltGlobSimPars and SetGlobSimPars)
        * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *)

        PROCEDURE SetMonInterval(hm: REAL);
        (*
          Sets the default of the monitoring interval only, not the
          current value. The call of this procedure will have no
          effect until the global simulation parameters are
          reset.
        *)

        PROCEDURE SetIntegrationStep(h: REAL);
        (*
          Sets the default integration step only, not the current
          value.  The call of this procedure will have no effect
          until the global simulation parameters are
          reset.
        *)

        PROCEDURE SetSimTime(t0,tend: REAL);
        (*
          Sets the defaults for the simulation start and stop time as
          well as the current simulation start and stop time (Differs
          in this respect from all other parameter setting routines,
          which affect either only the defaults or only the current
          values!)  Do not call this procedure from within a model,
          during a simulation run or an experiment, since the
          simulation time must not be changed during a simulation run
          (procedure is ineffective if called while running a
          simulation).
        *)



  (*-----------------------------------------*)
  (*=====   Setting of current values   =====*)
  (*-----------------------------------------*)

  PROCEDURE SetGlobSimPars(    t0, tend, h, er, c, hm: REAL);
  PROCEDURE GetGlobSimPars(VAR t0, tend, h, er, c, hm: REAL);
  (*
    Set or get the current global simulation parameters where:
     t0     Simulation start time
     tend   Simulation stop time
     h      Integration step (if fixed step length method)
            maximum integration step (if at least one variable
                                      step length method in use)
            (h is only used if at least one continuous time
            model present, otherwise ignored)
     er     Maximum relative local error
            (er is only used if at least one variable step length
            method in use)
     c      Discrete time step (if only discrete time models present)
            Coincidence interval (if continous as well as discrete
                                 discrete time models present)
     hm     Monitoring interval

    The call of procedure SetGlobSimPars in the middle of a
    simulation will become effective from the next integration
    or monitoring or coincidence time point on, depending on
    which of the three events occurs first.
  *)


  PROCEDURE SetProjDescrs(    title,remark,footer: ARRAY OF CHAR;
                              wtitle,wremark,autofooter,
                              recM, recSV, recP, recMV, recG: BOOLEAN);
  PROCEDURE GetProjDescrs(VAR title,remark,footer: ARRAY OF CHAR;
                          VAR wtitle,wremark,autofooter,
                              recM, recSV, recP, recMV, recG: BOOLEAN);
  (*
    Set or get the current project description where:
     title      Project title string
     remark     Remark string
     footer     Footer string
     wtitle     With title in graph
     wremark    With remarks in graph
     autofooter Automatic update of date, time, and run# in footer
     recM       Recording of data on models in stash file
     recSV      Recording of data on state variables in stash file
     recP       Recording of data on model parameters in stash file
     recMV      Recording of data on monitorable variables in stash file
     recG       Automatic dumping of the current graph once a
                simulation run has been completed onto the stash
                file (RTF-Format which can be opened by Microsoftš
                Word document processing software)
  *)

  PROCEDURE SetTabFuncRecording( recTF: BOOLEAN);
  PROCEDURE GetTabFuncRecording( VAR recTF: BOOLEAN);
  (*
    Set or get the current recording option flag of tabl    functions.
  *)

  PROCEDURE SetIndepVarIdent(descr,ident,unit:    ARRAY OF CHAR);
  PROCEDURE GetIndepVarIdent(VAR descr,ident,unit: ARRAY OF CHAR);
  (*
    Set or get the current descripotr, identifier and unit of the
    default independent variable, which is used by ModelWorks if no
    monitorable variable has been selected as independent variable
    ('X', 'isX').  The predefined values ModelWorks uses are
    descriptor = "time", ident = "t" and unit = "". The call of
    this procedure will have no effect until the next simulation
    run.
  *)



  (*------------------------------------------------------------*)
  (*=====   Reseting of current values to their defaults   =====*)
  (*------------------------------------------------------------*)

  PROCEDURE ResetGlobSimPars;
  (*
    Reset the following current values to their defaults:
        t0, tend, h, er, c, hm
    and the
        descr, ident, unit
    of the default independent variable.
  *)

  PROCEDURE ResetProjDescrs;
  (*
    Reset the following variables to their defaults:
        title,remark,footer, wtitle, wremark,
        autofooter, recM, recSV, recP, recMV, recG
    as well as
        recTF.
   *)



  (***************************************************)
  (*#####   Control of Display and Monitoring   #####*)
  (***************************************************)


  (*-----------------------*)
  (*=====   Windows   =====*)
  (*-----------------------*)


  PROCEDURE TileWindows; (* tile windows on the screen *)
  PROCEDURE StackWindows; (* stack windows on the screen similar
                          to start up display *)

  PROCEDURE InstallTileWindowsHandler(doAtTile:PROC);
  PROCEDURE InstallStackWindowsHandler(doAtStack:PROC);
  (*
    The installed procedures atTile or atStack will be called
    immediately after TileWindows or StackWindows, if the the level
    at which their installation ocurred is the current DM-level.
  *)


  TYPE
    MWWindow = (MIOW, SVIOW, PIOW, MVIOW, TableW, GraphW, AboutMW, TimeW);

  PROCEDURE SetWindowPlace(mww: MWWindow; x,y,w,h: INTEGER);
  (*
    Place the window mww with its lower left corner at the position
    x,y and resize it to the width w and height h (size of outer
    frame including title bar and margins).  The point [x,y] is
    given in coordinates with an origin at the lower left corner of
    the main computer screen.  All values are given in pixels.  If
    this procedure is called in case the window should not already
    be open, it will open the window with the specified properties.
  *)
  PROCEDURE GetWindowPlace(     mww: MWWindow; VAR x,y,w,h: INTEGER;
                                               VAR isOpen : BOOLEAN  );
  PROCEDURE SetDefltWindowPlace(mww: MWWindow; x,y,w,h: INTEGER);
  PROCEDURE GetDefltWindowPlace( mww: MWWindow; VAR x,y,w,h: INTEGER;
                                               VAR enabled: BOOLEAN );

  PROCEDURE CloseWindow(w: MWWindow);

  TYPE
    IOWColsDisplay = RECORD
      descrCol, identCol : BOOLEAN;
      CASE iow: MWWindow OF
        MIOW  : m : RECORD
                      integMethCol: BOOLEAN;
                    END(*RECORD*);
      | SVIOW : sv: RECORD
                      unitCol, sVInitCol: BOOLEAN;
                      fw,dec: INTEGER;
                    END(*RECORD*);
      | PIOW  : p : RECORD
                      unitCol, pValCol, pRtcCol: BOOLEAN;
                      fw,dec: INTEGER;
                    END(*RECORD*);
      | MVIOW : mv: RECORD
                      unitCol, scaleMinCol, scaleMaxCol, mVMonSetCol: BOOLEAN;
                      fw,dec: INTEGER;
                    END(*RECORD*);
      END(*CASE*)
    END(*RECORD*);

  PROCEDURE SetIOWColDisplay( mww: MWWindow;     wd: IOWColsDisplay );
  PROCEDURE GetIOWColDisplay( mww: MWWindow; VAR wd: IOWColsDisplay );
  PROCEDURE SetDefltIOWColDisplay( mww: MWWindow;     wd: IOWColsDisplay );
  PROCEDURE GetDefltIOWColDisplay( mww: MWWindow; VAR wd: IOWColsDisplay );

  PROCEDURE DisableWindow(w: MWWindow);
  PROCEDURE EnableWindow(w: MWWindow);
  (*
    Disable the window w for any usage, i.e. opening or closing
    of the window, or reenable a previously disabled window.
  *)

  TYPE
    MWWindowArrangement = (current, stacked, tiled);

  PROCEDURE SetDefltWindowArrangement(    a: MWWindowArrangement);
  PROCEDURE GetDefltWindowArrangement(VAR a: MWWindowArrangement);
  (*
    Sets or gets, respectively, the default window arrangement.
    If you call SetDefltWindowArrangement with the argument
    current, all current windows and window positions are used
    as the defaults (inverse function of ResetWindows).
    Otherwise the defaults are exactly those you would obtain
    if you called procedure StackWindows (stacked) or
    TileWindows (tiled), respectively.  Note: To make good use
    of screen space, the actual positions you obtain differ in
    function of the sizes of the screen(s) which you actually
    use; this is particularly critical in case of a tiled
    window arrangement.
  *)

  PROCEDURE GetWindowArrangement(VAR a: MWWindowArrangement);
  (*
    Allows you to learn about the current window arrangement.
    NOTE: There is no routine SetWindowArrangement, since you can
    use StackWindows (stacked), TileWindows (tiled), and
    the routines SetWindowPlace (current) instead.
  *)

  PROCEDURE ResetWindows;
  (*
    Reset window places and columns display to their default values
  *)



  (*-----------------------------------------*)
  (*=====   Global Monitoring Control   =====*)
  (*-----------------------------------------*)


  PROCEDURE SuppressMonitoring;
  PROCEDURE ResumeMonitoring;
  (*
    Suppress respectively resume all monitoring without affecting
    any of the current monitoring settings.
  *)


  PROCEDURE InstallClientMonitoring( initClientMon, doClientMon, termClientMon: PROC );
  (*
    Installs in ModelWorks client provided monitoring procedures.
    At the begin respectively the end of every simulation run the
    procedures initClientMon respectively termClientMon are
    called. During the simulation run the monitoring procedure
    doClientMon is called every time or integration step once.
    Procedure initClientMon serves to initialize the client
    monitoring such as opening of a window, a file, and is called
    at the very first monitoring point (time = t0).  The procedures
    initClientMon and doClientMon will be called as the last
    monitoring procedure, i.e. after ModelWorks executes its stash
    file, tabulation, and graph monitoring procedures.
    termClientMon will be called as the first monitoring
    termination procedure, i.e. before ModelWorks closes the stash
    file, terminates tabulation, and draws in the graph for the
    last time.
  *)



  PROCEDURE SetStashFileName     (     sfn: ARRAY OF CHAR);
  PROCEDURE GetStashFileName     (VAR  sfn: ARRAY OF CHAR);
  (*
    Sets or gets the current name of the stash file (may contain a
    path, e.g. Disk:Folder:MyFile.DAT).  The call to
    SetStashFileName will have no effect until the stash file is
    actually opened during a subsequent simulation. Calling this
    procedure in the middle of a simulation run (substate
    'Running') will have no effect, however in the substate 'No
    run' it allows to switch the stash file, e.g. during an
    experiment, by closing the one currently in use and open as the
    new stash file one with the name sfn.
    I M P O R T A N T   N O T I C E:  If a file with the same
    name should already exist, it will be overwritten without any
    warning!! This behavior contrasts with the setting of the
    name via the user interface (menu command 'Settings/Select
    stash file...').
  *)

  PROCEDURE SetDefltStashFileName(    dsfn: ARRAY OF CHAR);
  PROCEDURE GetDefltStashFileName(VAR dsfn: ARRAY OF CHAR);
  (*
    Sets or gets the default name of the stash file (may contain a path,
    e.g. Disk:Folder:MyFile.DAT). The call to SetDefltStashFileName
    will have no effect until the stash file name is actually reset.
    I M P O R T A N T   N O T I C E:  If a file with the same
    name should already exist, stash filing will overwrite this
    file without any warning!!
  *)

  PROCEDURE SwitchStashFile(newsfn: ARRAY OF CHAR);
  (*
    Similar to SetStashFileName, but always actually switches
    to a new file (forced switch).  In particular, if a stash
    file is currently open, this routine always closes first
    the currently opened stash file and opens another, new one
    with the name 'newsfn'.  Of course, in case if there is
    currently no stash file open, this routine behaves similar
    to what SetStashFileName does, i.e. the name of the stash
    file to be opened next time a simulation run requires stash
    filing, is the name passed for argument 'newsfn'.
  *)

  PROCEDURE SetStashFileType     (     filetype, creator: ARRAY OF CHAR);
  PROCEDURE GetStashFileType     (VAR  filetype, creator: ARRAY OF CHAR);
  PROCEDURE SetDefltStashFileType(    dFiletype,dCreator: ARRAY OF CHAR);
  PROCEDURE GetDefltStashFileType(VAR dFiletype,dCreator: ARRAY OF CHAR);
  (*
    On the Macintosh, any file is of a particular type and is
    associated with a particular application characterized by the
    creator, each given by a 4 character long string. The purpose
    and timing of the effects by these routines is exactly the same
    as that described for the routines affecting the name of the
    stash file.  The predefined defaults are those inherited from
    the 'Dialog Machine'.
  *)

  PROCEDURE ResetStashFile;
  (*
    Resets the current name of the stash file, its type and its
    creator to its default name, type and creator.
  *)




  PROCEDURE Message(m: ARRAY OF CHAR);
  (*
    Write the message m onto the stash file and into the window
    table.  This procedure surrounds the string m with quotes
    '"' and preceeds it with the reserved word MESSAGE.  In
    case neither the stash file nor the table window are
    currently open, the call to this procedure will not force
    the opening of the stash file or the table and the message
    display will be suppressed.
  *)


  (*--------------------------------*)
  (*=====   Curve Attributes   =====*)
  (*--------------------------------*)

  TYPE
    Stain =
      (coal, snow, ruby, emerald, sapphire, turquoise, pink, gold, autoDefCol);
      (* Order is the same as the sequence in which the color variables are
      listed in the definition of module DMWindIO; for autoDefCol see comment
      for procedures Set/GetCurveAttrForMV *)
    LineStyle =
      (unbroken, broken, dashSpotted, spotted, invisible, purge, autoDefStyle);

  CONST
    autoDefSym = 200C;

  PROCEDURE SetCurveAttrForMV(m: Model; VAR mv: REAL;
                              col: Stain; ls: LineStyle;
                              sym: CHAR);
  PROCEDURE GetCurveAttrForMV(m: Model; VAR mv: REAL;
                              VAR col: Stain; VAR ls: LineStyle;
                              VAR sym: CHAR);
  (*
    Sets or gets the curve attributes used by ModelWorks for the
    monitoring of simulation results in the graph for the monitorable
    variable mv belonging to model m. Where:
     col      Stain to be used to draw the lines and/or symbols
              of a curve in the graph (autoDefCol can be used for
              automatic color definition provided by ModelWorks)
     ls       LineStyle of lines to be drawn between monitoring
              times.
                 unbroken    _______________   broken    - - - - - - - -
                 dashSpotted -.-.-.-.-.-.-.-   spotted   ...............
                 invisible                     (no drawing at all,
                 may be used to stop drawing of a particular curve,
                 while others are still drawn)
                 wipeout                      (used to erase already
                                              drawn curves)
                 autoDefStyle                 (used for automatic style
                                              definition  provided by
                                              ModelWorks)
      sym     Character to be used to draw a value at a monitoring
              time, e.g. "*" to obtain curves like ---*---*---
              (autoDefSym can be used for automatic symbol definition)
  *)


  PROCEDURE SetDefltCurveAttrForMV(m: Model; VAR mv: REAL;
                                   col: Stain; ls: LineStyle;
                                   sym: CHAR);

  PROCEDURE GetDefltCurveAttrForMV(m: Model; VAR mv: REAL;
                                   VAR col: Stain; VAR ls: LineStyle;
                                   VAR sym: CHAR);


  PROCEDURE ResetAllCurveAttributes;
  (*
    Reset curve attributes of all monitorable variables to their
    defaults.
  *)


  PROCEDURE ClearTable;
  PROCEDURE ClearGraph;
  (*
    Clear and redraw the table respectively the graph window.
  *)

  PROCEDURE DumpGraph;
  (*
    Dumps the graph onto the stash file in case it is currently in
    use.  The data are written to the file in the so-called
    RTF-Format which can be opened by the Microsoftš Word document
    processing software.  Note: the graph is dumped regardless of
    the current setting of the flag «Automatic dumping of graph at
    end of simulation run» recG (see procedures to access the
    project descriptors).
  *)



  (*************************************************)
  (*#####   Assignment of predefined values   #####*)
  (*************************************************)

  PROCEDURE SetPredefinitions;
  (*
    Sets the defaults for the
         global simulation parameters,
         project description,
         stash file (name, type, creator)
    and the
         windows (position, columns display)
    to ModelWorks-predefined values. See the ModelWorks manual for
    more information on the predefined defaults.
  *)


  PROCEDURE ResetAll;
   (*
     Resets all
         global simulation parameters,
         project description,
         stash file (name, type, creator)
         windows (position, columns display)
      as well as all declared
         models,
         state variables,
         parameters,
         monitorable variables (filing, tabulation, graphing,
         scaling, curve attributes)
     to their defaults.
   *)





  (**************************************************************)
  (*#####   Preferences and simulation environment modes   #####*)
  (**************************************************************)

  (* The simulation environment of ModelWorks knows several modes
  which can be set according to the preferences of the
  simulationist (see Menu command "Preferences…") or which can be
  controlled via the client interface by the following procedures.
  Note that these procedures affect the current settings of the
  modes permanently such that they will be remembered and used
  again by the simulation environment if it is started the next
  time. Note also that this behavior differs from the default
  concept ModelWorks normally adopts for the maintenance of other
  values, i.e. there exist no defaults for the modes of the
  simulation environment, just current values. *)


  PROCEDURE SetDocumentRunAlwaysMode(dra: BOOLEAN);
  PROCEDURE GetDocumentRunAlwaysMode(VAR dra: BOOLEAN);
  (*
    If the mode «document run allways» is activated, every
    execution of a simulation run will be documented onto
    stash-file according to the current settings of the project
    descriptors. Note that the stash file gets rewritten with every
    new run.
  *)

  PROCEDURE SetAskStashFileTypeMode(asft: BOOLEAN);
  PROCEDURE GetAskStashFileTypeMode(VAR asft: BOOLEAN);
  (*
    If the mode «ask for stash file type» is activated, every time
    the simulationist has selected a new stash file a dialog is
    displayed allowing to specify the file's type and creator.
  *)


  PROCEDURE SetRedrawTableAlwaysMode(rta: BOOLEAN);
  PROCEDURE GetRedrawTableAlwaysMode(VAR rta: BOOLEAN);
  (*
    The mode «redraw table always» describes the behaviour of the
    table window in respect to modifications of the tabulation
    monitoring settings. For further explanations see mode «redraw
    graph always» below.
  *)

  PROCEDURE SetCommonPageUpRows(rows: CARDINAL);
  PROCEDURE GetCommonPageUpRows(VAR rows: CARDINAL);
  (*
    This mode controls the number of common rows between page ups
    in the table window.
  *)


  PROCEDURE SetRedrawGraphAlwaysMode(rga: BOOLEAN);
  PROCEDURE GetRedrawGraphAlwaysMode(VAR rga: BOOLEAN);
  (*
    If the mode «redraw graph always» is activated, each
    modification of the graphing monitoring settings will be
    displayed immediately, not only just at the begin of the next
    simulation run. This implies an immediate loss of all
    simulation results eventually currently visible in the graph.
    If this mode is not active, the current graph will not be
    touched unless the user starts the next simulation run, before
    which the graph will be completely redrawn. It is recommended
    to activate this mode, since if deactivated this might result
    in discrepancies between current settings and what is visible
    on the screen. Only in situations where another simulation run
    is too costly (rerun takes too much time) such discrepancies
    can be tolerated in order to keep the precious simulation results
    as long as possible.
  *)

  PROCEDURE SetColorVectorGraphSaveMode(cvgs: BOOLEAN);
  PROCEDURE GetColorVectorGraphSaveMode(VAR cvgs: BOOLEAN);
  (*
    If the mode «color and vector graph saving» is activated, each
    time the graph window needs to be redrawn because some parts of
    it become visible again after they have been covered by another
    window (see also description of restore or update mechanism in
    module DMWindows of the 'Dialog Machine') the graph will be
    reconstructed in colors otherwise only black and white. Note
    that this mode won't affect the very first drawing of the
    graph, i.e. on a color screen you may get colored curves, even
    if this mode should be turned off.  Since the full
    reconstruction in colors for complicated graphs may be slow,
    especially on monochrome monitors it may be preferable to
    deactivate this mode (trade-off between colors and speed). In
    addition to the colors all graphical output is stored as
    vectorized objects. This allows printing and copying to the
    clipboard of graphs in high resolution quality, but requires a
    corresponding amount of memory. Deactivation of this mode
    results in storing graphical output in a bitmap without colors,
    with a coarser resolution and more modest memory requirements.
    Note that on black-and-white monitors only, this mode must be
    active in order to obtain colored output on a printer or other
    color device (transferred via clipboard).
  *)



  (***********************************************************************)
  (*#####   Customization of keyboard shortcuts for menu commands   #####*)
  (***********************************************************************)

  (* Alias characters associated with ModelWorks menu-commands may
  be customized according to the needs of the simulationist either
  interactively (see Menu command “Customize…”) or by means of the
  following procedures. While an interactive specification is only
  possible for the most important commands, the so-called “core”
  menu commands, the client interface allows to modify the keyboard
  equivalents for all commands (except the ones listed under the
  “Edit” Menu). In either case, the newly set alias characters will
  be immediately used and remembered by the simulation environment
  when it is started the next time. *)


  TYPE
    MWMenuCommand = ( pageSetUpCmd, printGraphCmd, preferencesCmd, customizeCmd,

  (*core commands*)  setGlobSimParsCmd, setProjDescrCmd, selectStashFileCmd,

                     resetGlobSimParsCmd, resetProjDescrCmd, resetStashFileCmd,
                     resetWindowsCmd, resetAllIntegrMethodsCmd, resetAllInitialValuesCmd,
                     resetAllParametersCmd, resetAllStashFilingCmd, resetAllTabulationCmd,
                     resetAllGraphingCmd, resetAllScalingCmd, resetAllCurveAttrsCmd,
                     resetAllCmd, defineSimEnvCmd,

  (*core commands*)  tileWindowsCmd, stackWindowsCmd, modelsCmd, stateVarsCmd,
  (*core commands*)  modelParamsCmd, monitorableVarsCmd, tableCmd, clearTableCmd,
  (*core commands*)  graphCmd, clearGraphCmd,

  (*core commands*)  startRunCmd, haltOrResumeRunCmd, stopCmd, startExperimentCmd);


  PROCEDURE SetMenuCmdAliasChar(cmd: MWMenuCommand; alias: CHAR);
  PROCEDURE GetMenuCmdAliasChar(cmd: MWMenuCommand; VAR alias: CHAR);
  (*
    Get, respectively set, an alias character (i.e. keyboard equivalent or
    shortcut) associated with a particular ModelWorks menu-command.
  *)

  PROCEDURE ResetCoreMenuCmdsAliasChars;
  (*
    The interactively specifiable alias characters are reset to
    their default values as described in the ModelWorks reference.
  *)

  PROCEDURE ResetAllMenuCmdsAliasChars;
  (*
    The alias characters of all menu commands are reset to the
    defaults described in the ModelWorks reference.
  *)



END SimBase.

  Contact RAMSES@env.ethz.ch Last updated: 25-Jul-2011 [Top of page]