IMPLEMENTATION MODULE CONT; (************************************************************************** Environnement : DOS et TopSpeed Modula-2. ------------- Programmeurs : ------------ Pierre L'Ecuyer, Jean Belanger ***************************************************************************) FROM Storage IMPORT ALLOCATE, DEALLOCATE; FROM MYINOUT IMPORT WriteLn, WriteString; FROM SYSTEM IMPORT ADDRESS; FROM EVENT IMPORT EventType, EventNotice, ScheduleNotice, ScheduleNext, CancelNotice; FROM NUM IMPORT WriteLR; IMPORT SIM, EVENT; TYPE VarCont = POINTER TO InfoVarCont; InfoVarCont = RECORD Active : BOOLEAN; (* = TRUE si on a fait StartInteg. *) val : LONGREAL; (* Valeur de la variable. *) deriv : Deriv; (* Procedure donnant sa derivee. *) ParV : ADDRESS; (* Attributs associes a la variable. *) Ev : EventType; (* Type d'even. que l'on doit executer *) (* juste apres chaque pas d'integ. *) ParEv : ADDRESS; (* Param. pour chaque even. de ce type. *) Phi : LONGREAL; Pi : LONGREAL; Buffer : LONGREAL; Sum : LONGREAL; Prec, Succ : VarCont END; VAR FreeVarConts : VarCont; (* Pile des variables continues libres. *) ActiveVarConts : VarCont; (* Liste des variables continues qui sont *) (* actives (qui bougent). *) StepSize : LONGREAL; (* Pas d'integration. *) IntegMethod : Method; (* Methode d'integration. *) Order : CARDINAL; (* Ordre de la methode. *) OneStep : EventType; (* Un pas d'integration. *) StepNotice : EventNotice; (* L'avis pour le prochain pas d'integ. *) VC : VarCont; (* Variable que l'on est en train d'inte- *) (* grer. = NIL sinon. *) A, B, C : ARRAY [1..4] OF LONGREAL; (* Param. definissant une methode de *) (* Runge Kutta explicite. *) PROCEDURE Error (Number : CARDINAL); BEGIN WriteLn; WriteString ('***** ERROR from module CONT, at time '); WriteLR (SIM.Time (), 10, 3, 2); WriteString (' ***** ' ); WriteLn; CASE Number OF 0 : WriteString ("Referencing to a VarCont not created yet.") | 11 : WriteString ("Trying to create a cont. variable already created.") END; WriteLn; WriteLn; HALT END Error; PROCEDURE Create ( VAR V : VarCont; Val : LONGREAL; D : Deriv; Par : ADDRESS ); BEGIN IF FreeVarConts = NIL THEN NEW (V) ELSE V := FreeVarConts; FreeVarConts := V^.Succ END; WITH V^ DO Active := FALSE; val := Val; deriv := D; ParV := Par END END Create; PROCEDURE Init ( V : VarCont; Value : LONGREAL ); BEGIN IF V = NIL THEN Error (0) END; V^.val := Value END Init; PROCEDURE Value ( V : VarCont ) : LONGREAL; BEGIN RETURN V^.val END Value; PROCEDURE VarAttrib ( V : VarCont ) : ADDRESS; BEGIN IF V = NIL THEN Error (0) END; RETURN V^.ParV END VarAttrib; PROCEDURE CurrentVar () : VarCont; BEGIN RETURN VC END CurrentVar; PROCEDURE ProcOneStepRK; VAR Time : LONGREAL; i : CARDINAL; BEGIN Time := SIM.Time () - StepSize; VC := ActiveVarConts; WHILE VC # NIL DO WITH VC^ DO Buffer := val; Sum := 0.0; Pi := 0.0; VC := Succ END END; FOR i := 1 TO Order - 1 DO VC := ActiveVarConts; WHILE VC # NIL DO WITH VC^ DO Pi := deriv (Time + StepSize * C [i]); Sum := Sum + Pi * B [i]; Phi := Buffer + StepSize * Pi * A [i]; VC := Succ END END; VC := ActiveVarConts; WHILE VC # NIL DO WITH VC^ DO val := Phi; VC := Succ END END END; VC := ActiveVarConts; WHILE VC # NIL DO WITH VC^ DO IF ADDRESS (Ev) # NIL THEN ScheduleNext (Ev, ParEv) END; Pi := deriv (Time + StepSize * C [Order]); val := Buffer + StepSize * (Sum + Pi * B [Order]); VC := Succ END END END ProcOneStepRK; PROCEDURE ProcOneStepEuler; VAR Time : LONGREAL; BEGIN Time := SIM.Time () - StepSize; VC := ActiveVarConts; WHILE VC # NIL DO WITH VC^ DO Phi := val + StepSize * deriv (Time); VC := Succ END END; VC := ActiveVarConts; WHILE VC # NIL DO WITH VC^ DO val := Phi; IF ADDRESS (Ev) # NIL THEN ScheduleNext (Ev, ParEv) END; VC := Succ END END END ProcOneStepEuler; PROCEDURE ProcOneStep; BEGIN CASE IntegMethod OF Euler : ProcOneStepEuler ELSE ProcOneStepRK END; ScheduleNotice (OneStep, StepSize, NIL, StepNotice) END ProcOneStep; PROCEDURE SelectMethod ( M : Method; h : LONGREAL ); BEGIN IntegMethod := M; StepSize := h; CASE IntegMethod OF RungeKutta2 : Order := 2; A [1] := 1.0; A [2] := 0.0; B [1] := 0.5; B [2] := 0.5; C [1] := 0.0; C [2] := 1.0 | RungeKutta4 : Order := 4; A [1] := 0.5; A [2] := 0.5; A [3] := 1.0; A [4] := 0.0; B [1] := 1.0/6.0; B [2] := 1.0/3.0; B [3] := 1.0/3.0; B [4] := 1.0/6.0; C [1] := 0.0; C [2] := 0.5; C [3] := 0.5; C [4] := 1.0 ELSE END END SelectMethod; PROCEDURE StartInteg ( V : VarCont; E : EventType; Par : ADDRESS ); BEGIN IF V = NIL THEN Error (0) END; WITH V^ DO Active := TRUE; Ev := E; ParEv := Par; Succ := ActiveVarConts; ActiveVarConts := V; Prec := NIL; IF Succ # NIL THEN Succ^.Prec := V END END; IF ADDRESS (StepNotice) = NIL THEN ScheduleNotice (OneStep, StepSize, NIL, StepNotice) END END StartInteg; PROCEDURE StopInteg (V : VarCont); BEGIN IF V = NIL THEN Error (0) END; WITH V^ DO IF NOT Active THEN Error (1) END; Active := FALSE; IF Prec = NIL THEN ActiveVarConts := Succ (* C'est le premier de la liste. *) ELSE Prec^.Succ := Succ END; IF Succ # NIL THEN Succ^.Prec := Prec (* Ce n'est pas le dernier. *) END END; IF ActiveVarConts = NIL THEN CancelNotice (StepNotice) END END StopInteg; PROCEDURE Delete (VAR V : VarCont); BEGIN IF V = NIL THEN Error (0) END; WITH V^ DO IF Active THEN StopInteg (V) END; Succ := FreeVarConts; FreeVarConts := V; V := NIL END END Delete; BEGIN ActiveVarConts := NIL; FreeVarConts := NIL; VC := NIL; StepNotice := EventNotice (NIL); EVENT.Create (OneStep, ProcOneStep, "One integration step") END CONT.