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