home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / l / l042 / 1.ddi / CHAP5.ARC / SIMPSON.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1987-12-30  |  5.8 KB  |  165 lines
  1. program Simpson_Prog;
  2.  
  3. {----------------------------------------------------------------------------}
  4. {-                                                                          -}
  5. {-     Turbo Pascal Numerical Methods Toolbox                               -}
  6. {-     Copyright (c) 1986, 87 by Borland International, Inc.                -}
  7. {-                                                                          -}
  8. {-           Purpose: This program demonstrates integration with            -}
  9. {-                    Simpson's Composite Algorithm.                        -}
  10. {-                                                                          -}
  11. {-           Unit   : Integrat    procedure Simpson                         -}
  12. {-                                                                          -}
  13. {----------------------------------------------------------------------------}
  14.  
  15. {$I-}      { Disable I/O error trapping }
  16. {$R+}      { Enable range checking }
  17.  
  18. uses
  19.   Integrat, Dos, Crt, Common;
  20.  
  21. var
  22.   LowerLimit, UpperLimit : Float;   { Limits of integration }
  23.   NumIntervals : integer;           { Number of intervals }
  24.   Integral : Float;                 { Value of the integral }
  25.   Error : byte;                     { Flags if something went wrong }
  26.  
  27. {$F+}
  28. function TNTargetF(X : Float) : Float;
  29.  
  30. {-----------------------------------------------------}
  31. {-         This is the function to integrate         -}
  32. {-----------------------------------------------------}
  33.  
  34. begin
  35.   TNTargetF := Exp(3 * X) + Sqr(X) / 3;
  36. end; { function TNTargetF }
  37. {$F-}
  38.  
  39. procedure Initialize(var LowerLimit   : Float;
  40.                      var UpperLimit   : Float;
  41.                      var Integral     : Float;
  42.                      var NumIntervals : integer;
  43.                      var Error        : byte);
  44.  
  45. {------------------------------------------------------------------}
  46. {- Output: LowerLimit, UpperLimit, Integral, NumIntervals, Error  -}
  47. {-                                                                -}
  48. {- This procedure initializes the above variables to zero         -}
  49. {------------------------------------------------------------------}
  50.  
  51. begin
  52.   Writeln;
  53.   LowerLimit := 0;
  54.   UpperLimit := 0;
  55.   Integral := 0;
  56.   NumIntervals := 0;
  57.   Error := 0;
  58. end; { procedure Initialize }
  59.  
  60. procedure GetData(var LowerLimit   : Float;
  61.                   var UpperLimit   : Float;
  62.                   var NumIntervals : integer);
  63.  
  64. {------------------------------------------------------------}
  65. {- Output: LowerLimit, UpperLimit, NumIntervals             -}
  66. {-                                                          -}
  67. {- This procedure assigns values to the above variables     -}
  68. {- from keyboard input                                      -}
  69. {------------------------------------------------------------}
  70.  
  71. procedure GetLimits(var LowerLimit : Float;
  72.                     var UpperLimit : Float);
  73.  
  74. {------------------------------------------------------------}
  75. {- Output: LowerLimit, UpperLimit                           -}
  76. {-                                                          -}
  77. {- This procedure assigns values to the limits of           -}
  78. {- integration from keyboard input                          -}
  79. {------------------------------------------------------------}
  80.  
  81. begin
  82.   repeat
  83.     repeat
  84.       Write('Lower limit of integration? ');
  85.       Readln(LowerLimit);
  86.       IOCheck;
  87.     until not IOerr;
  88.     Writeln;
  89.     repeat
  90.       Write('Upper limit of integration? ');
  91.       Readln(UpperLimit);
  92.       IOCheck;
  93.     until not IOerr;
  94.     if LowerLimit = UpperLimit then
  95.     begin
  96.       Writeln;
  97.       Writeln('       The limits of integration must be different.');
  98.       Writeln;
  99.     end;
  100.   until LowerLimit <> UpperLimit;
  101. end; { procedure GetLimits }
  102.  
  103. procedure GetNumIntervals(var NumIntervals : integer);
  104.  
  105. {------------------------------------------------------------}
  106. {- Output: NumIntervals                                     -}
  107. {-                                                          -}
  108. {- This procedure reads in the number of intervals          -}
  109. {- over which to apply Simpson's rule                       -}
  110. {------------------------------------------------------------}
  111.  
  112. begin
  113.   Writeln;
  114.   repeat
  115.     Write('Number of intervals (> 0)? ');
  116.     Readln(NumIntervals);
  117.     IOCheck;
  118.     if NumIntervals <= 0 then
  119.       IOerr := true;
  120.   until not IOerr;
  121. end; { procedure GetNumIntervals }
  122.  
  123. begin { procedure GetData }
  124.   GetLimits(LowerLimit, UpperLimit);
  125.   GetNumIntervals(NumIntervals);
  126.   GetOutputFile(OutFile);
  127. end; { procedure GetData }
  128.  
  129. procedure Results(LowerLimit   : Float;
  130.                   UpperLimit   : Float;
  131.                   NumIntervals : integer;
  132.                   Integral     : Float;
  133.                   Error        : byte);
  134.  
  135. {------------------------------------------------------------}
  136. {- This procedure outputs the results to the device OutFile -}
  137. {------------------------------------------------------------}
  138.  
  139. begin
  140.   Writeln(OutFile);
  141.   Writeln(OutFile);
  142.   Writeln(OutFile, 'Lower Limit:' : 25, LowerLimit : 25);
  143.   Writeln(OutFile, 'Upper Limit:' : 25, UpperLimit : 25);
  144.   Writeln(OutFile, 'Number of intervals:' : 25, NumIntervals : 5);
  145.   Writeln(OutFile);
  146.   if Error = 1 then
  147.     DisplayError;
  148.  
  149.   case Error of
  150.     0 : Writeln(OutFile, 'Integral:' : 25, Integral : 25);
  151.  
  152.     1 : Writeln(OutFile, 'The number of intervals must be greater than 0.');
  153.  
  154.   end; { case }
  155. end; { procedure Results }
  156.  
  157. begin { program Simpson }
  158.   ClrScr;
  159.   Initialize(LowerLimit, UpperLimit, Integral, NumIntervals, Error);
  160.   GetData(LowerLimit, UpperLimit, NumIntervals);
  161.   Simpson(LowerLimit, UpperLimit, NumIntervals, Integral, Error, @TNTargetF);
  162.   Results(LowerLimit, UpperLimit, NumIntervals, Integral, Error);
  163.   Close(OutFile);
  164. end. { program Simpson }
  165.