	PROGRAM AMORT
!+
! This program performs loan amortization calculations for loans which
! are paid monthly.  It uses scaled double-precision values in order to
! avoid losing fractions of cents.
!
!-

	IMPLICIT NONE
	REAL*8 RATE,RATE_PER_PAYMENT
	INTEGER NUMBER_OF_PAYMENTS
	REAL*8 REMAINING_PRINCIPAL
	REAL*8 MONTHLY_PAYMENT,SCHEDULED_PAYMENT
	REAL*8 MONTHLY_PRINCIPAL
	REAL*8 MONTHLY_INTEREST
	REAL*8 PRINCIPAL_FACTOR
	REAL*8 YTD_PRINCIPAL,YTD_INTEREST
	REAL*8 TOTAL_INTEREST
	INTEGER YEAR_NUMBER, MONTH_NUMBER, DAY_NUMBER, PAYMENT_NUMBER
	LOGICAL*4 DONE 
	CHARACTER*3 MONTHS(12) /'Jan','Feb','Mar','Apr','May','Jun',
	1  'Jul','Aug','Sep','Oct','Nov','Dec'/
	CHARACTER*80 FILESPEC
	CHARACTER*1 YN

11	FORMAT ($,A)
12	FORMAT (BN,2PG10.0)
13	FORMAT (BN,I10)
14	FORMAT (BN,-2PG12.0)
15	FORMAT (A)

100	CONTINUE
	WRITE (6,11) ' Enter interest rate in percent, ^Z to exit: '
	READ (5,12,END=999) RATE
	RATE_PER_PAYMENT = RATE/12.0D0
	WRITE (6,11) ' Enter number of months: '
	READ (5,13,END=999) NUMBER_OF_PAYMENTS
	WRITE (6,11) ' Enter principal amount: '
	READ (5,14,END=999) REMAINING_PRINCIPAL

	PRINCIPAL_FACTOR = 1.0D0 - ((RATE_PER_PAYMENT+1.0D0)**
	1  (-NUMBER_OF_PAYMENTS))
	PRINCIPAL_FACTOR = RATE_PER_PAYMENT / PRINCIPAL_FACTOR

	SCHEDULED_PAYMENT = DNINT(REMAINING_PRINCIPAL * PRINCIPAL_FACTOR)
	TOTAL_INTEREST = (NUMBER_OF_PAYMENTS * SCHEDULED_PAYMENT) -
	1  REMAINING_PRINCIPAL

101	FORMAT ( ' Principal amount = $',-2PF9.2)
102	FORMAT ( ' Interest rate    =  ',2PF9.3,'%')
103     FORMAT ( ' Duration of loan =  ',I9,' months')
104	FORMAT (/' Monthly payment  = $',-2PF9.2)
105	FORMAT ( ' Total interest   = $',-2PF9.2)

	WRITE (6,101) REMAINING_PRINCIPAL
	WRITE (6,102) RATE
	WRITE (6,103) NUMBER_OF_PAYMENTS
	WRITE (6,104) SCHEDULED_PAYMENT
	WRITE (6,105) TOTAL_INTEREST
	
110	WRITE (6,11) ' Do you wish an amortization report? [Y]'
	READ (5,15,END=999) YN
	IF (YN .EQ. 'Y' .OR. YN .EQ. 'y' .OR. YN .EQ. ' ') GOTO 200
	IF (YN .EQ. 'N' .OR. YN .EQ. 'n') GOTO 999
	WRITE (6,11) ' Please respond with Y or N'
	GOTO 110

200	WRITE (6,11) ' Enter loan year number (1993, etc.): '
	READ (5,13,END=999) YEAR_NUMBER
	WRITE (6,11) ' Enter loan month number (1-12): '
	READ (5,13,END=999) MONTH_NUMBER
	WRITE (6,11) ' Enter loan day number (1-31): '
	READ (5,13,END=999) DAY_NUMBER
	WRITE (6,11) ' Enter file specification for report: '
	READ (5,15) FILESPEC
	OPEN (UNIT=1,FILE=FILESPEC,STATUS='NEW',FORM='FORMATTED',
	1  CARRIAGECONTROL='LIST')
	WRITE (1,101) REMAINING_PRINCIPAL
	WRITE (1,102) RATE
	WRITE (1,103) NUMBER_OF_PAYMENTS
	WRITE (1,104) SCHEDULED_PAYMENT
	WRITE (1,105) TOTAL_INTEREST
106	FORMAT (///,T30,'Calendar year ',I4//
	1      '     Payment',T25,'Remaining',T37,'Principal',T48,
	2        'Interest',T61,'Total'/
	3      '   #     Date',  T25,'Principal',T39,'Payment', T49,
	4        'Payment', T59,'Payment'/
	5      1X,3('-------------------------'))
107	FORMAT (1X,I3,1X I2,'-',A3,'-',I4,2X,-2PF15.2,2X,3(-2PF10.2))
109	FORMAT (//' Year-to-date interest paid    = $',-2PF9.2/
	1         ' Year-to-date principal paid   = $',-2PF9.2/
	2         ' End-of-year principal balance = $',-2PF9.2)

	DONE = .FALSE.
	DO WHILE (PAYMENT_NUMBER .LT. NUMBER_OF_PAYMENTS)
	    IF (MONTH_NUMBER .LT. 12) WRITE (1,106) YEAR_NUMBER

	    YTD_INTEREST = 0
	    YTD_PRINCIPAL = 0
	    DO WHILE ((MONTH_NUMBER .LT. 12) .AND. .NOT. DONE)
		PAYMENT_NUMBER = PAYMENT_NUMBER + 1
		MONTH_NUMBER = MONTH_NUMBER + 1
		MONTHLY_INTEREST = 
	1         DNINT(REMAINING_PRINCIPAL * RATE_PER_PAYMENT)
		MONTHLY_PRINCIPAL = SCHEDULED_PAYMENT - MONTHLY_INTEREST
		IF (PAYMENT_NUMBER .EQ. NUMBER_OF_PAYMENTS) THEN
		  MONTHLY_PRINCIPAL = REMAINING_PRINCIPAL
		  DONE = .TRUE.
		  END IF
		MONTHLY_PAYMENT = MONTHLY_INTEREST + MONTHLY_PRINCIPAL
		WRITE (1,107) PAYMENT_NUMBER, DAY_NUMBER,
	1	  MONTHS(MONTH_NUMBER),YEAR_NUMBER,
	2	  REMAINING_PRINCIPAL, MONTHLY_PRINCIPAL,
	3	  MONTHLY_INTEREST, MONTHLY_PAYMENT
		REMAINING_PRINCIPAL = REMAINING_PRINCIPAL - MONTHLY_PRINCIPAL
		YTD_INTEREST = YTD_INTEREST + MONTHLY_INTEREST
		YTD_PRINCIPAL = YTD_PRINCIPAL + MONTHLY_PRINCIPAL
		END DO

	    IF (PAYMENT_NUMBER .GT. 0) WRITE (1,109) YTD_INTEREST,
	1    YTD_PRINCIPAL, REMAINING_PRINCIPAL
	    YEAR_NUMBER = YEAR_NUMBER + 1
	    MONTH_NUMBER = 0
	    END DO
	CLOSE (UNIT=1)
	GO TO 100  ! Get next loan data
999	END
