[Back to MISC SWAG index]  [Back to Main SWAG index]  [Original]

program Amortization_Table;

Uses Crt,Printer;

var Month                 : 1..12;
    Starting_Month        : 1..12;
    Balance               : real;
    Payment               : real;
    Interest_Rate         : real;
    Annual_Accum_Interest : real;
    Year                  : integer;
    Number_Of_Years       : integer;
    Original_Loan         : real;


procedure Calculate_Payment; (* **************** calculate payment *)
var Temp  : real;
    Index : integer;
begin
   Temp := 1.0;
   for Index := 1 to 12*Number_Of_Years do
      Temp := Temp * (1.0 + Interest_Rate);
   Payment := Original_Loan*Interest_Rate/(1.0 - 1.0/Temp);
end;

procedure Initialize_Data; (* ******************** initialize data *)
begin
   Writeln('   Pascal amortization program');
   Writeln;
   Write('Enter amount borrowed                         ');
   Readln(Original_Loan);
   Balance := Original_Loan;
   Write('Enter interest rate as percentage (i.e. 13.5) ');
   Readln(Interest_Rate);
   Interest_Rate := Interest_Rate/1200.0;
   Write('Enter number of years of payoff               ');
   Readln(Number_Of_Years);
   Write('Enter month of first payment (i.e. 5 for May) ');
   Readln(Starting_Month);
   Write('Enter year of first payment (i.e. 1994)       ');
   Readln(Year);
   Calculate_Payment;
   Annual_Accum_Interest := 0.0; (* This is to accumulate Interest *)
end;

procedure Print_Annual_Header; (* ************ print annual header *)
begin
   Writeln;
   Writeln;
   Writeln('Original loan amount = ',Original_Loan:10:2,
           '   Interest rate = ',1200.0*Interest_Rate:6:2,'%');
   Writeln;
   Writeln('Month    payment  interest    princ   balance');
   Writeln;
   Writeln(Lst);
   Writeln(Lst);
   Writeln(Lst,'Original loan amount = ',Original_Loan:10:2,
           '   Interest rate = ',1200.0*Interest_Rate:6:2,'%');
   Writeln(Lst);
   Writeln(Lst,'Month    payment  interest    princ   balance');
   Writeln(Lst);
end;

procedure Calculate_And_Print; (* ************ calculate and print *)
var Interest_Payment : real;
    Principal_Payment : real;
begin
   if Balance > 0.0 then begin
      Interest_Payment := Interest_Rate * Balance;
      Principal_Payment := Payment - Interest_Payment;
      if Principal_Payment > Balance then begin  (* loan payed off *)
         Principal_Payment := Balance;              (* this month *)
         Payment := Principal_Payment + Interest_Payment;
         Balance := 0.0;
      end
      else begin  (* regular monthly payment *)
         Balance := Balance - Principal_Payment;
      end;
      Annual_Accum_Interest := Annual_Accum_Interest+Interest_Payment;
      Writeln(Month:5,Payment:10:2,Interest_Payment:10:2,
              Principal_Payment:10:2,Balance:10:2);
      Writeln(Lst,Month:5,Payment:10:2,Interest_Payment:10:2,
              Principal_Payment:10:2,Balance:10:2);
   end; (* of if Balance > 0.0 then *)
end;

procedure Print_Annual_Summary; (* ********** print annual summary *)
begin
   Writeln;
   Writeln('Total interest for ',Year:5,' = ',
            Annual_Accum_Interest:10:2);
   Writeln;
   Writeln(Lst);
   Writeln(Lst,'Total interest for ',Year:5,' = ',
            Annual_Accum_Interest:10:2);
   Annual_Accum_Interest := 0.0;
   Year := Year + 1;
   Writeln(Lst);
end;

begin   (* ******************************************* main program *)
   Clrscr;
   Initialize_Data;
   repeat
      Print_Annual_Header;
      for Month := Starting_Month to 12 do begin
         Calculate_And_Print;
      end;
      Print_Annual_Summary;
      Starting_Month := 1;
   until Balance <= 0.0;
end. (* of main program *)

[Back to MISC SWAG index]  [Back to Main SWAG index]  [Original]