C     .TITLE MORT3
C
C  31 OCT 77 (PDH) SURROUND EACH RUN WITH 'CALL OPEN', 'CALL CLOSE'
C  21 JAN 74 (PDH) SPACE AFTER EACH YEAR, NO MATTER HOW MANY PAYMENTS
C  15 JAN 73 - TIDY UP INITIAL HEADING
C   8 DEC 72 - CONVERT TO WATRAN
C  16 OCT 72 - PAUL HENDERSON (UPDATED FROM AN EARLIER VERSION)
C
C  PROGRAM TO PRODUCE AN AMORTIZATION TABLE FROM INFORMATION
C  ENTERED FROM THE KEYBOARD AT RUN TIME.  OUTPUT IS ON .DAT +6.
C
      REAL NUMBER,NP,JBYP,NYEARS
 101  WRITE(4,10)
      WRITE(4,11)
      READ(4,15) DEBT
      WRITE(4,12)
      READ(4,15) ANNINT
      WRITE(4,13)
      READ(4,15) NYEARS
      WRITE(4,14)
      READ(4,15) PPERYR
      KPAYS=PPERYR
      NP=NYEARS*PPERYR
      JBYP=ANNINT/PPERYR/100.
      RATE=JBYP
      PAY=DEBT*JBYP/(1.-(1./(1.+JBYP))**NP)
 104  WRITE (4,3)  PAY
      WRITE (4,20)
      READ  (4,15) ANS
      IF (ANS) 106,103,105
 105  PAY=ANS
      GO TO 104
 106  PAY = 0.
 103  CALL OPEN (6,'AMORT LST')
      WRITE (6,3) PAY,PPERYR,ANNINT
      WRITE(6,4)
      I=0
      TOTINT=0.
      DEBTI=DEBT
      WRITE(6,5)I,DEBT
   1  PAYINT=RATE*DEBT
      TOTINT=TOTINT+PAYINT
      PPRINC=PAY-PAYINT
      DEBTJ=DEBT
      DEBT=DEBT-PPRINC
      I=I+1
      IF (DEBT) 2,2,102
 102  WRITE(6,6)I,PAYINT,PPRINC,DEBT
      IF (MOD(I,KPAYS).EQ.0) WRITE (6,21)
      IF (MOD(I,48).NE.0) GO TO 1
      WRITE (6,22)
      WRITE (6,4)
      GO TO 1
   2  REPAY=TOTINT+DEBTI
      PPRINC=DEBTJ
      DEBT=0.
      WRITE(6,6)I,PAYINT,PPRINC,DEBT
      WRITE(6,8)TOTINT
      WRITE(6,9)REPAY
      WRITE (6,22)
      WRITE(4,8)TOTINT
      WRITE(4,9)REPAY
      CALL CLOSE (6)
      GO TO 101
C
   3  FORMAT (' $',F7.2,' PER PERIOD,',I4,' PERIODS PER YEAR @',
     *F6.2,'% PER ANNUM'/)
   4  FORMAT(7H PERIOD,9H INTEREST,11H  PRINCIPAL,9H     DEBT/)
   5  FORMAT(I5,20XF12.2)
   6  FORMAT(I5,F9.2,F11.2,F12.2)
   8  FORMAT(/17H TOTAL INTEREST $,F8.2)
   9  FORMAT(/17H  AMOUNT REPAID $,F8.2)
  10  FORMAT(//29H           AMORTIZATION TABLE//)
  11  FORMAT(28H WHAT IS THE AMOUNT BORROWED)
  12  FORMAT(39H WHAT IS THE RATE OF INTEREST PER ANNUM)
  13  FORMAT(33H HOW MANY YEARS WILL THE DEBT RUN)
  14  FORMAT(27H HOW MANY PAYMENTS PER YEAR)
  15  FORMAT(F10.2)
  20  FORMAT (25H CHANGE PERIODIC PAYMENT:)
  21  FORMAT (1H )
  22  FORMAT (1H1)
      END
      FUNCTION MOD (I,K)
      MOD=I-(I/K)*K
      RETURN
      END
