home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / l / l042 / 2.ddi / CHAP8.ARC / ADAMS_1.PAS next >
Encoding:
Pascal/Delphi Source File  |  1987-12-30  |  8.9 KB  |  242 lines
  1. program Adams_Prog;
  2.  
  3. {----------------------------------------------------------------------------}
  4. {-                                                                          -}
  5. {-     Turbo Pascal Numerical Methods Toolbox                               -}
  6. {-     Copyright (c) 1986, 87 by Borland International, Inc.                -}
  7. {-                                                                          -}
  8. {-         Purpose:  This unit demonstrates the procedure Adams             -}
  9. {-                   which solves an initial value problem - a first order  -}
  10. {-                   ordinary differential equation with initial condition  -}
  11. {-                   specified - using the Adams-Bashforth, Adams-Moulton   -}
  12. {-                   predictor/corrector scheme.                            -}
  13. {-                                                                          -}
  14. {-         Unit   : InitVal    procedure Adams                              -}
  15. {-                                                                          -}
  16. {----------------------------------------------------------------------------}
  17.  
  18. {$I-}      { Disable I/O error trapping }
  19. {$R+}      { Enable range checking }
  20.  
  21. uses
  22.   InitVal, Dos, Crt, Common;
  23.  
  24. var
  25.   LowerLimit, UpperLimit : Float;   { Limits over which to approximate X }
  26.   XInitial : Float;                 { Intial value of X at LowerLimit }
  27.   NumReturn : integer;              { Number of values to return }
  28.   NumIntervals : integer;           { Number of equal sub-intervals }
  29.   TValues : TNvector;               { Value of T between the limits }
  30.   XValues : TNvector;               { Value of X at TValues }
  31.   Error : byte;                     { Flags if something went wrong }
  32.  
  33. {$F+}
  34. function TNTargetF(T, X : Float) : Float;
  35.  
  36. {---------------------------------------------------------------}
  37. {-         This is the first order differential equation       -}
  38. {---------------------------------------------------------------}
  39.  
  40. begin
  41.   TNTargetF := X / T + T - 1;
  42. end; { function TNTargetF }
  43. {$F-}
  44.  
  45. procedure Initialize(var LowerLimit   : Float;
  46.                      var UpperLimit   : Float;
  47.                      var XInitial     : Float;
  48.                      var NumIntervals : integer;
  49.                      var NumReturn    : integer;
  50.                      var Error        : byte);
  51.  
  52. {------------------------------------------------------------------}
  53. {- Output: LowerLimit, UpperLimit, XInitial, NumIntervals,        -}
  54. {-         NumReturn, Error                                       -}
  55. {-                                                                -}
  56. {- This procedure initializes the above variables to zero         -}
  57. {------------------------------------------------------------------}
  58.  
  59. begin
  60.   LowerLimit := 0;
  61.   UpperLimit := 0;
  62.   XInitial := 0;
  63.   NumIntervals := 0;
  64.   NumReturn := 0;
  65.   Error := 0;
  66. end; { procedure Initialize }
  67.  
  68. procedure GetData(var LowerLimit   : Float;
  69.                   var UpperLimit   : Float;
  70.                   var XInitial     : Float;
  71.                   var NumIntervals : integer;
  72.                   var NumReturn    : integer);
  73.  
  74. {------------------------------------------------------------}
  75. {- Output: LowerLimit, UpperLimit, XInitial, NumIntervals   -}
  76. {-         NumReturn                                        -}
  77. {-                                                          -}
  78. {- This procedure assigns values to the above variables     -}
  79. {- from keyboard input                                      -}
  80. {------------------------------------------------------------}
  81.  
  82. procedure GetLimits(var LowerLimit : Float;
  83.                     var UpperLimit : Float);
  84.  
  85. {------------------------------------------------------------}
  86. {- Output: LowerLimit, UpperLimit                           -}
  87. {-                                                          -}
  88. {- This procedure assigns values to the limits of           -}
  89. {- integration from keyboard input                          -}
  90. {------------------------------------------------------------}
  91.  
  92. begin
  93.   repeat
  94.     repeat
  95.       Write('Lower limit of interval? ');
  96.       Readln(LowerLimit);
  97.       IOCheck;
  98.     until not IOerr;
  99.     Writeln;
  100.     repeat
  101.       Write('Upper limit of interval? ');
  102.       Readln(UpperLimit);
  103.       IOCheck;
  104.     until not IOerr;
  105.  
  106.     if LowerLimit = UpperLimit then
  107.     begin
  108.       Writeln;
  109.       Writeln('       The limits of integration must be different.');
  110.       Writeln;
  111.     end;
  112.   until LowerLimit <> UpperLimit;
  113. end; { procedure GetLimits }
  114.  
  115. procedure GetXInitial(LowerLimit : Float;
  116.                   var XInitial   : Float);
  117.  
  118. {----------------------------------------------}
  119. {- Input: LowerLimit                          -}
  120. {- Output: XInitial                           -}
  121. {-                                            -}
  122. {- This procedure assigns a value to XInitial -}
  123. {- from keyboard input.                       -}
  124. {----------------------------------------------}
  125.  
  126. begin
  127.   Writeln;
  128.   repeat
  129.     Write('X value at t =', LowerLimit : 14, ': ');
  130.     Readln(XInitial);
  131.     IOCheck;
  132.   until not IOerr;
  133. end; { procedure GetXInitial }
  134.  
  135. procedure GetNumReturn(var NumReturn : integer);
  136.  
  137. {----------------------------------------------------------}
  138. {- Output: NumReturn                                      -}
  139. {-                                                        -}
  140. {- This procedure reads in the number of values to return -}
  141. {- in the TValues and XValues vectors                     -}
  142. {----------------------------------------------------------}
  143.  
  144. begin
  145.   Writeln;
  146.   repeat
  147.     Write('Number of values to return (1-', TNArraySize, ')? ');
  148.     Readln(NumReturn);
  149.     IOCheck;
  150.   until not IOerr and (NumReturn <= TNArraySize) and (NumReturn >= 1);
  151. end; { procedure GetNumReturn }
  152.  
  153. procedure GetNumIntervals(NumReturn    : integer;
  154.                       var NumIntervals : integer);
  155.  
  156. {------------------------------------------------------------}
  157. {- Input: NumReturn                                         -}
  158. {- Output: NumIntervals                                     -}
  159. {-                                                          -}
  160. {- This procedure reads in the number of intervals          -}
  161. {- over which to apply the Adams formulas                   -}
  162. {------------------------------------------------------------}
  163.  
  164. begin
  165.   Writeln;
  166.   NumIntervals := NumReturn;
  167.   repeat
  168.     Write('Number of intervals (>= ', NumReturn, ')? ');
  169.     ReadInt(NumIntervals);
  170.     IOCheck;
  171.     if NumIntervals < NumReturn then
  172.     begin
  173.       IOerr := true;
  174.       NumIntervals := NumReturn;
  175.     end;
  176.   until not IOerr;
  177. end; { procedure GetNumIntervals }
  178.  
  179. begin { procedure GetData }
  180.   GetLimits(LowerLimit, UpperLimit);
  181.   GetXInitial(LowerLimit, XInitial);
  182.   GetNumReturn(NumReturn);
  183.   GetNumIntervals(NumReturn, NumIntervals);
  184.   GetOutputFile(OutFile);
  185. end; { procedure GetData }
  186.  
  187. procedure Results(LowerLimit   : Float;
  188.                   UpperLimit   : Float;
  189.                   XInitial     : Float;
  190.                   NumIntervals : integer;
  191.                   NumReturn    : integer;
  192.               var TValues      : TNvector;
  193.               var XValues      : TNvector;
  194.                   Error        : byte);
  195.  
  196. {------------------------------------------------------------}
  197. {- This procedure outputs the results to the device OutFile -}
  198. {------------------------------------------------------------}
  199.  
  200. var
  201.   Index : integer;
  202.  
  203. begin
  204.   Writeln(OutFile);
  205.   Writeln(OutFile);
  206.   Writeln(OutFile, 'Lower Limit:' : 29, LowerLimit);
  207.   Writeln(OutFile, 'Upper Limit:' : 29, UpperLimit);
  208.   Writeln(OutFile, 'Value of X at ' : 19, LowerLimit:8:4, ' :' , XInitial);
  209.   Writeln(OutFile, 'Number of intervals: ' : 30, NumIntervals);
  210.   Writeln(OutFile);
  211.   if Error >= 1 then
  212.     DisplayError;
  213.   case Error of
  214.     0 : begin
  215.           Writeln(OutFile, 't' : 15, 'X' : 15);
  216.           for Index := 0 to NumReturn do
  217.             Writeln(OutFile, TValues[Index] : 20 : 8, ' ', XValues[Index]);
  218.         end;
  219.  
  220.     1 : Writeln(OutFile,
  221.                 'The number of values to return must be greater than zero.');
  222.     2 : begin
  223.           Writeln(OutFile, 'The number of intervals must be greater than');
  224.           Writeln(OutFile, 'or equal to the number of values to return.');
  225.         end;
  226.     3 : Writeln(OutFile, 'The lower limit must be different ',
  227.                          'from the upper limit.');
  228.  
  229.   end;
  230. end; { procedure Results }
  231.  
  232. begin { program Adams }
  233.   ClrScr;
  234.   Initialize(LowerLimit, UpperLimit, XInitial, NumIntervals, NumReturn, Error);
  235.   GetData(LowerLimit, UpperLimit, XInitial, NumIntervals, NumReturn);
  236.   Adams(LowerLimit, UpperLimit, XInitial, NumReturn,
  237.         NumIntervals, TValues, XValues, Error, @TNTargetF);
  238.   Results(LowerLimit, UpperLimit, XInitial, NumIntervals,
  239.           NumReturn, TValues, XValues, Error);
  240.   Close(OutFile);
  241. end. { program Adams }
  242.