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