home *** CD-ROM | disk | FTP | other *** search
/ CD Shareware Magazine 1996 December / CD_shareware_12-96.iso / DOS / Programa / NUMANA01.ZIP / SRC / TESTS / DETEST.MOD next >
Encoding:
Text File  |  1996-08-16  |  4.3 KB  |  144 lines
  1. MODULE DEtest;
  2.  
  3.         (********************************************************)
  4.         (*                                                      *)
  5.         (*              Test of module Integration              *)
  6.         (*                                                      *)
  7.         (*  Programmer:         P. Moylan                       *)
  8.         (*  Last edited:        16 August 1996                  *)
  9.         (*  Status:             Working                         *)
  10.         (*                                                      *)
  11.         (********************************************************)
  12.  
  13. (*
  14. FROM Windows IMPORT
  15.     (* type *)  Window, Colour, FrameType, DividerType,
  16.     (* proc *)  OpenWindow, CloseWindow;
  17. *)
  18.  
  19. FROM SYSTEM IMPORT
  20.     (* type *)  ADDRESS;
  21.  
  22. FROM MiscM2 IMPORT
  23.     (* type *)  Window,
  24.     (* proc *)  SelectWindow, PressAnyKey, WriteString, WriteLn, WriteLongReal, Exp, Cos;
  25.  
  26. FROM Integration IMPORT
  27.     (* type *)  SolutionMethod,
  28.     (* proc *)  Solve;
  29.  
  30. FROM Vec IMPORT
  31.     (* type *)  VectorPtr,
  32.     (* proc *)  NewVector, DisposeVector;
  33.  
  34. (************************************************************************)
  35.  
  36. PROCEDURE Deriv1 (t: LONGREAL;  y: ARRAY OF LONGREAL;  VAR (*OUT*) RHS: ARRAY OF LONGREAL);
  37.  
  38.     (* Calculates right side for equation dy/dt = -y.   *)
  39.  
  40.     BEGIN
  41.         RHS[0] := -y[0];
  42.     END Deriv1;
  43.  
  44. (************************************************************************)
  45.  
  46. PROCEDURE Plot1 (dummy: ADDRESS;  t: LONGREAL;  y: ARRAY OF LONGREAL);
  47.  
  48.     (* Solution plotter for equation 1. *)
  49.  
  50.     BEGIN
  51.         WriteLongReal (t, 8);  WriteString ("   ");
  52.         WriteLongReal (y[0], 8);  WriteString ("   ");
  53.         WriteLongReal (3.0*Exp(-t), 8);
  54.         WriteLn;
  55.     END Plot1;
  56.  
  57. (************************************************************************)
  58.  
  59. PROCEDURE Test1;
  60.  
  61.     CONST minstep = 0.05;  maxstep = 0.5;  tmax = 3.0;
  62.  
  63.     VAR y: VectorPtr;
  64.         (*w: Window;*)
  65.  
  66.     BEGIN
  67.         (*
  68.         OpenWindow (w, black, brown, 0, 24, 0, 79, simpleframe, nodivider);
  69.         SelectWindow (w);
  70.         *)
  71.         WriteString ("Solving a first order differential equation.");
  72.         WriteLn;  WriteLn;
  73.         y := NewVector (1);
  74.         y^[0] := 3.0;
  75.         WriteString ("      t    computed y   true y");
  76.         WriteLn;
  77.         Solve (1, Deriv1, BS, Plot1, NIL,
  78.                         0.0, tmax, minstep, maxstep, y^, 1.0E-5);
  79.         DisposeVector (y, 1);
  80.         (*CloseWindow (w);*)
  81.     END Test1;
  82.  
  83. (************************************************************************)
  84.  
  85. PROCEDURE Deriv2 (t: LONGREAL;  x: ARRAY OF LONGREAL;  VAR (*OUT*) RHS: ARRAY OF LONGREAL);
  86.  
  87.     (* Calculates right side for equation dx1/dt = x2, dx2/dt = -x1.   *)
  88.  
  89.     BEGIN
  90.         RHS[0] := x[1];
  91.         RHS[1] := -x[0];
  92.     END Deriv2;
  93.  
  94. (************************************************************************)
  95.  
  96. PROCEDURE Plot2 (dummy: ADDRESS;  t: LONGREAL;  x: ARRAY OF LONGREAL);
  97.  
  98.     (* Solution plotter for equation 1. *)
  99.  
  100.     BEGIN
  101.         WriteLongReal (t, 8);  WriteString ("   ");
  102.         WriteLongReal (x[0], 8);  WriteString ("   ");
  103.         WriteLongReal (Cos(t), 8);
  104.         WriteLn;
  105.     END Plot2;
  106.  
  107. (************************************************************************)
  108.  
  109. PROCEDURE Test2;
  110.  
  111.     CONST minstep = 0.05;  maxstep = 0.5;  tmax = 8.0;
  112.  
  113.     VAR x: VectorPtr;
  114.         (*w: Window;*)
  115.  
  116.     BEGIN
  117.         (*
  118.         OpenWindow (w, black, brown, 0, 24, 0, 79, simpleframe, nodivider);
  119.         SelectWindow (w);
  120.         *)
  121.         WriteString ("Solving a second order differential equation.");
  122.         WriteLn;  WriteLn;
  123.         x := NewVector (2);
  124.         x^[0] := 1.0;
  125.         x^[1] := 0.0;
  126.         WriteString ("      t    computed y   true y");
  127.         WriteLn;
  128.         Solve (2, Deriv2, BS, Plot2, NIL,
  129.                         0.0, tmax, minstep, maxstep, x^, 1.0E-5);
  130.         DisposeVector (x, 2);
  131.         (*CloseWindow (w);*)
  132.     END Test2;
  133.  
  134. (************************************************************************)
  135. (*                              MAIN PROGRAM                            *)
  136. (************************************************************************)
  137.  
  138. BEGIN
  139.     Test1;
  140.     PressAnyKey;
  141.     Test2;
  142. END DEtest.
  143.  
  144.