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