home *** CD-ROM | disk | FTP | other *** search
/ Collection of Hack-Phreak Scene Programs / cleanhpvac.zip / cleanhpvac / PASSRC.ZIP / AMORT5.PAS < prev    next >
Pascal/Delphi Source File  |  1991-02-04  |  4KB  |  113 lines
  1.                                      (* Chapter 16 - Program 5 *)
  2. program Amortization_Table;
  3.  
  4. Uses Printer;       (* This is needed for Turbo Pascal 4.0 or 5.0 *)
  5.  
  6. var Month                 : 1..12;
  7.     Starting_Month        : 1..12;
  8.     Balance               : real;
  9.     Payment               : real;
  10.     Interest_Rate         : real;
  11.     Annual_Accum_Interest : real;
  12.     Year                  : integer;
  13.     Number_Of_Years       : integer;
  14.     Original_Loan         : real;
  15.  
  16.  
  17. procedure Calculate_Payment; (* **************** calculate payment *)
  18. var Temp  : real;
  19.     Index : integer;
  20. begin
  21.    Temp := 1.0;
  22.    for Index := 1 to 12*Number_Of_Years do
  23.       Temp := Temp * (1.0 + Interest_Rate);
  24.    Payment := Original_Loan*Interest_Rate/(1.0 - 1.0/Temp);
  25. end;
  26.  
  27. procedure Initialize_Data; (* ******************** initialize data *)
  28. begin
  29.    Writeln('   Pascal amortization program');
  30.    Writeln;
  31.    Write('Enter amount borrowed                         ');
  32.    Readln(Original_Loan);
  33.    Balance := Original_Loan;
  34.    Write('Enter interest rate as percentage (i.e. 13.5) ');
  35.    Readln(Interest_Rate);
  36.    Interest_Rate := Interest_Rate/1200.0;
  37.    Write('Enter number of years of payoff               ');
  38.    Readln(Number_Of_Years);
  39.    Write('Enter month of first payment (i.e. 5 for May) ');
  40.    Readln(Starting_Month);
  41.    Write('Enter year of first payment (i.e. 1991)       ');
  42.    Readln(Year);
  43.    Calculate_Payment;
  44.    Annual_Accum_Interest := 0.0; (* This is to accumulate Interest *)
  45. end;
  46.  
  47. procedure Print_Annual_Header; (* ************ print annual header *)
  48. begin
  49.    Writeln;
  50.    Writeln;
  51.    Writeln('Original loan amount = ',Original_Loan:10:2,
  52.            '   Interest rate = ',1200.0*Interest_Rate:6:2,'%');
  53.    Writeln;
  54.    Writeln('Month    payment  interest    princ   balance');
  55.    Writeln;
  56.    Writeln(Lst);
  57.    Writeln(Lst);
  58.    Writeln(Lst,'Original loan amount = ',Original_Loan:10:2,
  59.            '   Interest rate = ',1200.0*Interest_Rate:6:2,'%');
  60.    Writeln(Lst);
  61.    Writeln(Lst,'Month    payment  interest    princ   balance');
  62.    Writeln(Lst);
  63. end;
  64.  
  65. procedure Calculate_And_Print; (* ************ calculate and print *)
  66. var Interest_Payment : real;
  67.     Principal_Payment : real;
  68. begin
  69.    if Balance > 0.0 then begin
  70.       Interest_Payment := Interest_Rate * Balance;
  71.       Principal_Payment := Payment - Interest_Payment;
  72.       if Principal_Payment > Balance then begin  (* loan payed off *)
  73.          Principal_Payment := Balance;              (* this month *)
  74.          Payment := Principal_Payment + Interest_Payment;
  75.          Balance := 0.0;
  76.       end
  77.       else begin  (* regular monthly payment *)
  78.          Balance := Balance - Principal_Payment;
  79.       end;
  80.       Annual_Accum_Interest := Annual_Accum_Interest+Interest_Payment;
  81.       Writeln(Month:5,Payment:10:2,Interest_Payment:10:2,
  82.               Principal_Payment:10:2,Balance:10:2);
  83.       Writeln(Lst,Month:5,Payment:10:2,Interest_Payment:10:2,
  84.               Principal_Payment:10:2,Balance:10:2);
  85.    end; (* of if Balance > 0.0 then *)
  86. end;
  87.  
  88. procedure Print_Annual_Summary; (* ********** print annual summary *)
  89. begin
  90.    Writeln;
  91.    Writeln('Total interest for ',Year:5,' = ',
  92.             Annual_Accum_Interest:10:2);
  93.    Writeln;
  94.    Writeln(Lst);
  95.    Writeln(Lst,'Total interest for ',Year:5,' = ',
  96.             Annual_Accum_Interest:10:2);
  97.    Annual_Accum_Interest := 0.0;
  98.    Year := Year + 1;
  99.    Writeln(Lst);
  100. end;
  101.  
  102. begin   (* ******************************************* main program *)
  103.    Initialize_Data;
  104.    repeat
  105.       Print_Annual_Header;
  106.       for Month := Starting_Month to 12 do begin
  107.          Calculate_And_Print;
  108.       end;
  109.       Print_Annual_Summary;
  110.       Starting_Month := 1;
  111.    until Balance <= 0.0;
  112. end. (* of main program *)
  113.