MRT
  24
AMORT@SRC
COVR@@SRC
COVRTNSRC
EDIT@@SRC
FREQ@@SRC
GNCMR@SRC
INTT@@SRC
IREAD@SRC
IWRIT@SRC
MAIN@@SRC
MNMORTSRC
MORT@@SRC
MRTST@SRC
NOEND@SRC
PRTOC@SRC
RREAD@SRC
RUNMN@SRC
RUNOF@SRC
RWRIT@SRC
STEST@SRC
TOC@@@SRC
UNBLNDSRC
UNPAK@SRC
WHOLE@SRC
[\].
AMORT@SRC
      SUBROUTINE AMORT(NOPER,TJ,IAYR,IAMO)
C
C  CALCULATE AMORTIZATION PERIOD
C
      DOUBLE PRECISION TJ
C  NUMBER OF YEARS
      IAYR=NOPER/TJ
      ZIAYR=NOPER/TJ
      ZREM=ZIAYR-IAYR
C  NUMBER OF MONTHS
      IAMO=ZREM*12
      ZIAMO=ZREM*12
      ZNUM=ZIAMO-IAMO
C  TO ALLOW FOR LAST PAYMENT IF TIME DOES NOT WORK OUT EVENLY
      IF(ZNUM.NE.0) IAMO=IAMO+1
      RETURN
      END
[\].
COVR@@SRC
	SUBROUTINE COVR
C                                                                               
C  OUTPUTS COVER PAGE FOR EACH DIFFERENT MORTGAGE                               
C
	IMPLICIT DOUBLE INTEGER (I-N),DOUBLE PRECISION(A-H,O-Y)
      INTEGER TYR,TMO,AYR,AMO,I,J,NBLND,IFRQ1,IFRQ2
      DIMENSION ZBLND1(2),ZBLND2(2),ZDATE(2)
      DIMENSION JOBID(4),ZBLND(2)
      COMMON ZSPA1(2),ZSPA2(2),ZSPA3(2),ZTIME(3),NAM(3),AMTMRT,RATE
      COMMON IFRQ1,NBLND,IFRQ2,PAYAMT,TYR,TMO,AYR,AMO,NOJOB,RATE2
	COMMON ZPAY(2)
      DATA ZBLND1(1),ZBLND1(2)/'BLEND','ED   '/
      DATA ZBLND2(1),ZBLND2(2)/'NONBL','ENDED'/
C
C COVER SHEET
C
C  PRINTS MAIN TITLE AND BORDER                                                 
	WRITE(6,50)
      WRITE(6,100)
      WRITE(6,120)
      WRITE(6,240)
      WRITE(6,140)
C  FETCHES CURRENT DATE                                                         
	CALL WATDAY(ZDATE)
      WRITE(6,150)ZDATE(1),ZDATE(2)
      WRITE(6,160)
      WRITE(6,170)
      WRITE(6,180)
      WRITE(6,190)
      WRITE(6,200)
      WRITE(6,210)
      WRITE(6,220)
      WRITE(6,230)
	WRITE (6,231)
	WRITE(6,232)
      WRITE(6,240)
      WRITE(6,250)
      WRITE(6,240)
      WRITE(6,260)
      WRITE(6,240)
      WRITE(6,240)
      WRITE(6,270)
      WRITE(6,280)
	WRITE(6,290)
	WRITE(6,300)
      WRITE(6,310)
      WRITE(6,320)
      WRITE(6,240)
      WRITE(6,330)
      WRITE(6,340)
      WRITE(6,350)
      WRITE(6,360)
      WRITE(6,370)
      WRITE(6,380)
      WRITE(6,240)
50    FORMAT('1')
100   FORMAT(5X,25('*****'),3X)
120   FORMAT(4X,'*',125X,'*  ')
140   FORMAT(3X,'*', 9X,'DATE',T64,'**  ********',56X,'*')
150   FORMAT(3X,'*',7X,2A5,T63,'****  ********',55X,'*')
160   FORMAT(3X,'*',T62,'******  ********',54X,'*')
170   FORMAT(3X,'*',T61,'********  ********',53X,'*')
180   FORMAT(3X,'*',T60,'*********   ********',52X,'*')
190   FORMAT(3X,'*',T59,'*********     ********'51X,'*')
200   FORMAT(3X,'*',T58,'*********       ********'50X,'*')
210   FORMAT(3X,'*',T59,'*******',66X,'*')
220   FORMAT(3X,'*',T60,'*****  **************',51X,'*')
230   FORMAT(3X,'*',T61,'***  **************',52X'*')
231	FORMAT(3X,'*',T62,'*  **************',53X,'*')
232	FORMAT (3X,'*',T64'**************',54X,'*')
240   FORMAT(3X,'*',127X,'* ')
250   FORMAT(3X,'*',T56,'ABBEY GLEN PROPERTY CORPORATION',
     145X,'* ')
260   FORMAT(3X,'*',55X,'COMPUTER SERVICES GROUP',49X,'*')
270   FORMAT(3X,'*',30X,'**   **    ****    ****    *****    ****     **
     1*     ****    *****',31X,'* ')
280   FORMAT(3X,'*',30X,'* * * *   *    *   *   *     *     *    *   *
     1   *   *    *   *    ',31X,'* ')
290   FORMAT(3X,'*',30X,'*  *  *   *    *   ****      *     *        *
     1   *   *        **** ',31X,'* ')
300   FORMAT(3X,'*',30X,'*     *   *    *   * *       *     *  ***   ***
     1**   *  ***   *    ',31X,'* ')
310   FORMAT(3X,'*',30X,'*     *   *    *   *  *      *     *    *   *
     1   *   *    *   *    ',31X,'* ')
320   FORMAT(3X,'*',30X,'*     *    ****    *   *     *      ****    *
     1   *    ****    *****',31X,'* ')
330   FORMAT(3X,'*',18X,' ****     ****    *         ****    *    *   *
     1         ****    *****   *****    ****    *    *',15X,'* ')
340   FORMAT(3X,'*',18X,'*    *   *    *   *        *    *   *    *   *
     1        *    *     *       *     *    *   **   *',15X,'* ')
350   FORMAT(3X,'*',18X,'*        *    *   *        *        *    *   *
     1        *    *     *       *     *    *   * *  *',15X,'* ')
360   FORMAT(3X,'*',18X,'*        ******   *        *        *    *   *
     1        ******     *       *     *    *   *  * *',15X,'* ')
370   FORMAT(3X,'*',18X,'*    *   *    *   *        *    *   *    *   *
     1        *    *     *       *     *    *   *   **',15X,'* ')
380   FORMAT(3X,'*',18X,' ****    *    *   ******    ****     ****    **
     1****   *    *     *     *****    ****    *    *',15X,'* ')
C
C  SET UP JOB IDENTIFICATION FIELD CONSISTING OF JOB NUMBER AND USER NAME       
      JOBID(1)=NOJOB
      DO 6 I=1,3
6     JOBID(I+1)=NAM(I)
      WRITE(6,390)(JOBID(J),J=1,4)
390   FORMAT(3X,'*',32X,'JOB IDENTIFICATION:',11X,I4,1X,3A5,45X,'* ')
      WRITE(6,240)
C
      WRITE(6,400)AMTMRT
400   FORMAT(3X,'*',32X,'AMOUNT OF MORTGAGE:',11X,F12.2,53X,'* ')
	WRITE(6,240)
C
      WRITE(6,420)RATE
420   FORMAT(3X,'*',32X,'ANNUAL INTEREST RATE:',9X,F5.2,'  PERCENT',51X,
     1'* ')
      WRITE(6,240)
C
C  CALL SUBROUTINE TO DETERMINE HOW OFTEN INTEREST IS CALCULATED                
      CALL FREQ(IFRQ1)
      WRITE(6,430)(ZTIME(J),J=1,3),ZSPA1(1),ZSPA1(2)
430   FORMAT(3X,'*',32X,'       CALCULATED:',12X,3A5,4X,2A5,36X,'* ')
      WRITE(6,240)
C
C  CHANGE INTEREST FACTOR TO PERCENTAGE
	RATE3=RATE2*100
	WRITE(6,435)RATE3
435   FORMAT(3X,'*',32X,'INTEREST PAYMENT FACTOR:',6X,F13.9,' PERCENT',
     146X,'* ')
	WRITE(6,240)
C
C  CALL SUBROUTINE TO DETERMINE FREQUENCY OF PAYMENT                            
      CALL FREQ(IFRQ2)
C  COMPUTED GO TO OUTPUTS IF PAYMENTS ARE BLENDED OR NONBLENDED                 
      GO TO (510,520),NBLND
510   ZBLND(1) = ZBLND1(1)
      ZBLND(2) = ZBLND1(2)
      GO TO 99
520   ZBLND(1) = ZBLND2(1)
      ZBLND(2) = ZBLND2(2)
C  PRINTS PAYMENT TYPE AND FREQUENCY
99    WRITE(6,440)ZBLND(1),ZBLND(2),ZSPA2(1),ZSPA2(2)
440   FORMAT(3X,'*',32X,'PAYMENTS:',21X,2A5,8X,2A5,37X,'* ')
	WRITE(6,445)(ZTIME(J),J=1,3),ZSPA3(1),ZSPA3(2)
445   FORMAT(3X,'*',62X,3A5,4X,2A5,36X,'* ')
      WRITE(6,240)
C
C  CONVERTS AMOUNT OF PAYMENT TO DOLLARS BEFORE PRINTING                        
	QPAYAM=PAYAMT/100.
      WRITE(6,450)QPAYAM,ZPAY(1),ZPAY(2)
450   FORMAT(3X,'*',32X,'PAYMENT AMOUNT:',15X,F11.2,'  (',2A5,')',40X,
     1'* ')
      WRITE(6,240)
C
C  TERM PERIOD                                                                  
      WRITE(6,460)TYR,TMO
460   FORMAT(3X,'*',32X,'TERM:',25X,I2,' YEARS ',I2,' MONTHS',47X,'* ')
      WRITE(6,240)
C
C  AMORTIZATION PERIOD                                                          
      WRITE(6,470)AYR,AMO
470   FORMAT(3X,'*',32X,'AMORTIZATION PERIOD:',10X,I2,' YEARS ',I2,
     1' MONTHS',47X,'* ')
      WRITE(6,240)
      WRITE(6,120)
      WRITE(6,100)
999   RETURN
      END
[\].
COVRTNSRC
      SUBROUTINE COVRTN                                                         
      COMMON COVLN(16)                                                          
      DATA TITL/'.TITL'/,SKIP/'.SKIP'/                                          
C  KICK TO GET PRINTER STARTED
      WRITE(6,100)
100   FORMAT(100X,'X')
C READ LINE OF COVER PAGE                                                       
5     READ(1,6,END=99)(COVLN(I),I=1,16)                                         
6     FORMAT(16A5)                                                              
C
C  TEST FOR .TITL MEANING END OF COVER PAGE                                     
      IF(COVLN(1).EQ.TITL) RETURN                                               
C  TEST FOR .SKIP                                                               
      IF(COVLN(1).EQ.SKIP) GO TO 10                                             
C                                                                               
C  NO SYNTAX COMMANDS PRINT COVER PAGE LINE                                     
      WRITE(6,6)(COVLN(I),I=1,16)                                               
      GO TO 5                                                                   
C                                                                               
C  STRIP NUMBER OFF .SKIP COMMAND                                               
C  (-48 FUDGE FACTOR TO CHANGE NUMBER FROM                                      
C  OCTAL TO DECIMAL)                                                            
10    NOLIN=COVLN(2)[0:6]-48                                                    
C  PRINT BLANK LINES ON COVER PAGE                                              
      DO 20 I=1,NOLIN                                                           
      WRITE(6,15)                                                               
20    CONTINUE                                                                  
      GO TO 5                                                                   
15    FORMAT (1X)
99    STOP                                                                      
      END                                                                       
[\].
EDIT@@SRC
      SUBROUTINE EDIT(IFRQ1,NBLND,IFRQ2)
C
C  CHECKS FIELDS ON INPUT CARD FOR ERRORS. REPLACES ANY WITH DEFAULT
C  VALUES
C
      DIMENSION DEF(2)
      COMMON SPA1(2),SPA2(2),SPA3(2)
      DATA DEF(1),DEF(2),BLNK/'(DEFA','ULT) ','     '/
C
C  INITIALIZING FIELD THAT WILL CONTAIN WORD 'DEFAULT'                          
      SPA1(1) = BLNK
      SPA1(2) = BLNK
      SPA2(1) = BLNK
      SPA2(2) = BLNK
      SPA3(1) = BLNK
      SPA3(2) = BLNK
C  HOW OFTEN INTEREST RATE APPLIED (DEFAULTS TO SEMI-ANNUALLY)                  
      IF((IFRQ1.GE.1).AND.(IFRQ1.LE.8)) GO TO 30
      IFRQ1 = 3
      SPA1(1) = DEF(1)
      SPA1(2) = DEF(2)
C  TYPE OF PAYMENT (DEFAULTS TO BLENDED)                                        
30    IF((NBLND.EQ.1).OR.(NBLND.EQ.2)) GO TO 50
      NBLND=1
      SPA2(1) = DEF(1)
      SPA2(2) = DEF(2)
C  FREQUENCY OF PAYMENTS (DEFAULTS TO MONTHLY)                                  
50    IF((IFRQ2.GE.1).AND.(IFRQ2.LE.8)) RETURN
      IFRQ2 = 1
      SPA3(1) = DEF(1)
      SPA3(2) = DEF(2)
      RETURN
      END
[\].
FREQ@@SRC
      SUBROUTINE FREQ(IFREQ)
C                                                                               
C  INTERPRETS CODES FOR FREQUENCY                                               
C
      DIMENSION ZMON(3),QAR(3),SMA(3),ANN(3),WEK(3),BLND1(2),BLND2(2)
      DIMENSION BIW(3),SMM(3),PER(3)
      COMMON SPA1(2),SPA2(2),SPA3(2),TIME(3)
C
C  EIGHT POSSIBILITIES                                                          
      DATA ZMON(1),ZMON(2),ZMON(3)/'MONTH','LY   ','     '/
      DATA QAR(1),QAR(2),QAR(3)/'QUART','ERLY ','     '/
      DATA SMA(1),SMA(2),SMA(3)/'SEMI ','ANNUA','LLY  '/
      DATA ANN(1),ANN(2),ANN(3)/'ANNUA','LLY  ','     '/
      DATA WEK(1),WEK(2),WEK(3)/'WEEKL','Y    ','     '/
      DATA BIW(1),BIW(2),BIW(3)/'BI-WE','EKLY ','     '/
      DATA SMM(1),SMM(2),SMM(3)/'SEMI ','MONTH','LY   '/
      DATA PER(1),PER(2),PER(3)/'13 PE','RIODS','1YEAR'/
C
C  COMPUTED GOTO DEPENDS ON CODE USED                                           
      GO TO (10,20,30,40,50,60,70,80),IFREQ
C  MONTHLY
10    DO 15 I=1,3
15    TIME(I)=ZMON(I)
      GO TO 90
C  QUARTERLY                                                                    
20    DO 25 I=1,3
25    TIME(I)=QAR(I)
      GO TO 90
C  SEMI-ANNUALLY                                                                
30    DO 35 I=1,3
35    TIME(I)=SMA(I)
      GO TO 90
C  ANNUALLY                                                                     
40    DO 45 I=1,3
45    TIME(I)=ANN(I)
      GO TO 90
C  WEEKLY                                                                       
50    DO 55 I=1,3
55    TIME(I)=WEK(I)
      GO TO 90
C  BI-WEEKLY                                                                    
60    DO 65 I=1,3
65    TIME(I)=BIW(I)
      GO TO 90
C  SEMI-MONTHLY                                                                 
70    DO 75 I=1,3
75    TIME(I)=SMM(I)
      GO TO 90
C  13 PERIODS/YEAR                                                              
80    DO 85 I=1,3
85    TIME(I)=PER(I)
90    RETURN
      END
[\].
GNCMR@SRC
.TITL                              GNC MORTGAGE                                 
.SUBT                            INTRODUCTION                                   
.SKIP1                                                                          
          THE MORTGAGE PROGRAM CALCULATES AMORTIZATION TABLES FOR ANY           
      AMOUNT, ANY PERIOD, ANY INTEREST RATE. IT GIVES THE USER FOUR             
      OPTIONS.                                                                  
       1) A REGULAR AMORTIZATION TABLE                                          
       2) A TABLE CONTAINING 'END OF TERM' MESSAGE AFTER THE SPECIFIED          
          TERM PERIOD (IF TERM PERIOD NOT SPECIFIED, ASSUMED TO BE SAME         
          AS AMORTIZATION PERIOD)                                               
       3) BY SPECIFYING A PAYMENT AMOUNT THE AMORTIZATION PERIOD WILL           
          BE CALCULATED                                                         
       4) PAYMENTS CAN BE UNBLENDED I.E. AMOUNT OF PRINCIPAL TO BE PAID         
          AT EACH PAYMENT REMAINS CONSTANT. (SPECIFIED IN PAYMENT               
          AMOUNT FIELD)                                                         
.SKIP1                                                                          
          IF NOT STATED THE PROGRAM WILL DEFAULT TO INTEREST COMPOUNDED         
      SEMI-ANNUALLY AND BLENDED PAYMENTS MADE MONTHLY. INPUT TO THE             
      PROGRAM CAN BE EITHER READ IN FROM CARDS OR TYPED IN CONVERSATIONALLY.    
      TO DISTINGUISH THE PROGRAM CALLS SUBROUTINE DATSW TO QUERY DAT            
      SWITCH 17. IF THE SWITCH = 1, INPUT CAN COME FROM THE VT05. THE           
      USER IS ASKED TO MAKE SURE THE INPUT IS NOT ON CARDS                      
.SKIP1                                                                          
          THERE IS A COVER PAGE FOR EVERY TABLE CONTAINING TITLE, CURRENT       
      DATE, JOB IDENTIFICATION, AMOUNT OF MORTGAGE, ANNUAL INTEREST RATE        
      AND WHEN ITS CALCULATED, INTEREST PAYMENT FACTOR, PAYMENT TYPE AND        
      FREQUENCY, AMOUNT OF PAYMENT, TERM PERIOD AND AMORTIZATION PERIOD.        
.SKIP1                                                                          
          ALL AMOUNTS ARE CHANGED TO PENNIES BEFORE USED IN ANY                 
      CALCULATIONS.  PRECISION IS TO 11 DIGITS.  AFTER PAYMENT AMOUNT IS        
      CALCULATED IT IS ALWAYS ROUNDED UP (.9999999 ADDED), THEREFORE,           
      THE USER ALWAYS PAYS THE FRACTION OF A CENT. THE AMOUNT OF INTEREST       
      IS HALF ROUNDED (.5 ADDED), THEREFORE, THE USER ONLY PAYS THE             
      FRACTION OF A CENT IF IT IS GREATER THAN .4. THE ROUNDING WAS DONE        
      IN THIS WAY SO THE OUTPUT WOULD AGREE WITH THAT OF COMPUTER               
      SERVICES CONSUMERS'. THE AMOUNTS ARE CONVERTED BACK TO DOLLARS            
      BEFORE PRINTING.                                                          
.SKIP1                                                                          
          THE FINAL PAYMENT IS CALCULATED SEPARATELY TO ACCOUNT FOR ANY         
      OVERCHARGING CAUSED BY ALWAYS ROUNDING UPWARDS. THE INTEREST RATE         
      IS INPUT AS PERCENTAGE AND CHANGED TO DECIMAL. VALUES INPUT FOR           
      FREQUENCY OF INTEREST CALCULATIONS, PAYMENT TYPE, AND PAYMENT             
      FREQUENCY ARE USED AS SUBSCRIPTS.                                         
.SKIP1                                                                          
           INFORMATION AIDING IN FORMULATING THE FORMULAS FOR INTEREST          
      PAYMENT FACTOR AND PAYMENT AMOUNT CAME FROM 'CANADIAN MORTGAGES'          
      BY H. WOODARD AND 'ALGEBRA - A SENIOR COURSE'  PETRIE, BAKER,             
      LEVITT, & MACLEAN.                                                        
.EJEC                                                                           
.SUBT                                 DAT SLOTS                                 
.SKIP3                                                                          
            DAT                     USE                     ASSIGNMENT          
.SKIP2                                                                          
             4              CONVERSATIONAL INPUT            LT (OR TT)          
.SKIP1                                                                          
             5                INPUT ON CARDS                   CDB              
.SKIP1                                                                          
             6           AMORTIZATION TABLES OUTPUT          LP OR LV           
.EJEC                                                                           
.SUBT                          EXECUTION OF PROGRAM                             
.SKIP1                                                                          
     THE USER HAS TWO CHOICES OF INPUT EITHER ON CARDS OR CONVERSATIONALLY. IF  
INPUT IS ON CARDS MAKE SURE DAT SWITCH 17 IS OFF. IF DATA IS TO BE INPUT        
CONVERSATIONALLY MAKE SURE DAT SWITCH 17 IS ON (SET TO ONE). IF YOU DON'T TURN  
THE SWITCH OFF FOR CARD INPUT YOU GET A SECOND CHANCE BECAUSE THE PROGRAM ASKS  
IF YOU MEAN CONVERSATIONAL INPUT. HOWEVER IF YOU FORGET TO SET THE SWITCH YOU   
MUST START THE PROGRAM OVER.                                                    
.SKIP1                                                                          
     TO BEGIN TYPE 'E MNMORT' ON THE MASTER CONSOLE.                            
.EJEC                                                                           
.SUBT                               PROGRAM LOGIC                               
.SKIP1                                                                          
     AFTER INITIALIZING THE JOB NUMBER TO 100 THE PROGRAM CALLS SUBROUTINE DATSW
TO FIND OUT FROM WHERE THE INPUT IS COMING. THIS SUBROUTINE QUERIES DAT SWITCH  
17. A VALUE OF 1 MEANS INPUT IS ENTERED CONVERSATIONALLY, OTHERWISE INPUT COMES 
FROM CARDS. THE EDIT SUBROUTINE IS CALLED TO EDIT CERTAIN FIELDS REPLACING THEM 
WITH A DEFAULT VALUE IF THEY ARE IN ERROR. THE NUMBERS INPUT FOR THE FREQUENCIES
ARE USED AS SUBSCRIPTS TO CHANGE THE ALPHA REQUEST INTO NUMERIC. IF THE TERM    
PERIOD IS NOT GIVEN IT IS SET EQUIVALENT TO THE AMORTIZATION PERIOD.            
.SKIP1                                                                          
     ON RETURN FROM THE EDIT ROUTINE THE JOB NUMBER IS INCREMENTED AND THE      
SUBSCRIPTS ARE SET. THE INTEREST RATE IS CHANGED FROM PERCENTAGE TO DECIMAL. THE
INTEREST PAYMENT FACTOR IS CALCULATED USING THE FORMULA:                        
.SKIP1                                                                          
                                              COMPOUNDING RATE                  
                                              ----------------                  
                        (1    INTEREST RATE  )PAYMENT FREQUENCY     1           
      INTEREST FACTOR = (1 + ----------------)                   -- 1           
                        (1   COMPOUNDING RATE)                      1           
.SKIP1                                                                          
     THE PROGRAM TESTS PAYMENT TYPE. IF THEY ARE NONBLENDED THE SUBROUTINE FOR  
CALCULATING NONBLENDED PAYMENTS IS CALLED. IF THE PAYMENTS ARE BLENDED THE      
PROGRAM TESTS TO SEE IF PAYMENT AMOUNT IS PRESENT. IF IT IS CONTROL GOES TO THE 
PAYMENT AMOUNT SECTION. A MESSAGE IS PRINTED ON THE COVER PAGE AS TO WHETHER    
THE PAYMENT AMOUNT WAS INPUT OR CALCULATED.                                     
.SKIP1                                                                          
     TO CALCULATE THE PAYMENT AMOUNT FIRST THE MORTGAGE MUST BE CHANGED TO      
PENNIES. PAYMENT AMOUNT IS CALCULATED BY THE FOLLOWING FORMULA:                 
.SKIP1                                                                          
                                                   AMORT X FREQ                 
                             AMTMRT X INT X (1+INT)                             
                    PAYAMT = ----------------------                             
                                    AMORT X FREQ                                
                             (1+INT)            - 1                             
WHERE                                                                           
      AMTMRT - AMOUNT OF MORTGAGE                                               
      AMORT  - AMORTIZATION PERIOD                                              
      FREQ   - PAYMENT FREQUENCY                                                
      INT    - INTEREST FACTOR                                                  
      PAYAMT - AMOUNT OF PAYMENT                                                
.SKIP1                                                                          
     THE PAYMENT AMOUNT IS THEN ROUNDED UPWARDS USING FUNCTION SUBROUTINE WHOLE.
.SKIP1                                                                          
     THE PROGRAM NOW CALLS THE SUBROUTINE THAT PRINTS THE COVER PAGE. THE COVER 
PAGE CONTAINS THE CURRENT DATE; THE JOB IDENTIFICATION CONSISTING OF JOB NUMBER 
AND USER NAME; AMOUNT OF MORTGAGE; ANNUAL INTEREST RATE; INTEREST COMPOUNDING   
PERIOD; INTEREST FACTOR IN PERCENT; PAYMENT TYPE AND FREQUENCY; PAYMENT AMOUNT  
IN DOLLARS AND PAYMENT MESSAGE; TERM PERIOD AND AMORTIZATION PERIOD.            
.SKIP1                                                                          
     ON RETURNING FROM THE COVER PAGE ROUTINE THE HEADERS ARE PRINTED IN        
PREPARATION FOR THE AMORTIZATION TABLE. FIRST ALL FIELDS AND COUNTERS ARE       
INITIALIZED AND THE NUMBER OF PAYMENTS IS CALCULATED BY MULTIPLYING THE NUMBER  
OF YEARS IN AMORTIZATION PERIOD BY PAYMENT FREQUENCY. TO CALCULATE END OF TERM  
PAYMENT, THE TERM PERIOD IS CHANGED TO MONTHS AND SUBROUTINE NOEND IS CALLED    
TO CHANGE THE NUMBER OF MONTHS INTO PAYMENT NUMBER.                             
.SKIP1                                                                          
     A DO LOOP IS EXECUTED TO CALCULATE AND PRINT EACH LINE OF THE AMORTIZATION 
TABLE. THE PROGRAM IS SET FOR 50 PAYMENTS PER PAGE. THE INTEREST AMOUNT IS HALF 
ROUNDED AND ALL VALUES ARE CHANGED TO DOLLARS BEFORE PRINTING. A MESSAGE IS     
PRINTED FOR END OF TERM. THE FINAL PAYMENT IS CALCULATED SEPARATELY TO ACCOUNT  
FOR ANY OVERCHARGING. THE PROGRAM GOES BACK TO RECEIVE THE NEXT SET OF INPUT.   
.SKIP1                                                                          
     THE PAYMENT AMOUNT SECTION CALCULATES THE AMORTIZATION PERIOD GIVEN  THE   
AMOUNT THE USER WISHES TO PAY EACH PAYMENT PERIOD. THE LOGIC IN THIS SECTION IS 
BASICALLY THE SAME AS THE SECTION FOR THE REGULAR AMORTIZATION TABLE EXCEPT     
PAYMENT AMOUNT DOES NOT HAVE TO BE CALCULATED AND A COUNTER KEEPS TRACK OF THE  
NUMBER OF PAYMENTS. SUBROUTINE AMORT IS CALLED TO CHANGE THE NUMBER OF PAYMENTS 
INTO THE AMORTIZATION PERIOD. WHICH IS PRINTED AT THE END OF THE TABLE.         
.SKIP1                                                                          
     IN UNBLENDED PAYMENTS, THE USER SPECIFIES HOW MUCH PRINCIPAL HE WISHES TO  
PAY EACH PAYMENT PERIOD. THE INTEREST IS CALCULATED AND ADDED ONTO THAT VARYING 
THE PAYMENT AMOUNT EACH PAYMENT. THE AMOUNT OF PRINCIPAL IS INPUT IN THE        
PAYMENT AMOUNT FIELD AND IS CHECKED FOR VALIDITY. IF THE AMOUNT IS VALID THE    
NUMBER OF PAYMENT PERIODS IS CALCULATED BY DIVIDING THE AMOUNT OF MORTGAGE BY   
PRINCIPAL AMOUNT. SUBROUTINE AMORT IS CALLED TO CHANGE NUMBER OF PAYMENT        
PERIODS INTO AMORTIZATION PERIOD. THE REST OF THE ROUTINE IS THE SAME AS THE    
REGULAR AMORTIZATION TABLE EXCEPT THAT PAYMENT AMOUNT HAS TO BE RECALCULATED    
EACH TIME.                                                                      
.EJEC                                                                           
.SUBT                         EXPLANATION OF INPUT FORM                         
.SKIP2                                                                          
       FIELD                        USE                                         
.SKIP1                                                                          
 1) NAME                     -USER NAME WILL BECOME PART OF JOB IDENTIFICATION  
                              ALONG WITH JOB NUMBER                             
.SKIP1                                                                          
 2) MORTGAGE AMOUNT          -MAXIMUM AMOUNT $99,999,999.99                     
.SKIP1                                                                          
 3) ANNUAL INTEREST RATE     -INPUT AS PERCENTAGE                               
.SKIP1                                                                          
 4) INTEREST COMPOUNDED      -DEFAULTS TO SEMIANNUALLY                          
.SKIP1                                                                          
 5) PAYMENT TYPE             -EITHER BLENDED OR NONBLENDED (IE.CONSTANT         
                              PRINCIPAL PAYMENT AND VARIABLE INTEREST PAYMENT)  
                              DEFAULTS TO BLENDED                               
.SKIP1                                                                          
 6) PAYMENT FREQUENCY        -HOW OFTEN PAYMENTS ARE TO BE MADE                 
                              DEFAULTS TO MONTHLY                               
.SKIP1                                                                          
 7) PAYMENT AMOUNT           -CALCULATED FOR ORDINARY AMORTIZATION TABLE        
                              USED TO CALCULATE AMORTIZATION PERIOD             
                              USED AS PRINCIPAL AMOUNT FOR NONBLENDED           
                              PAYMENTS                                          
.SKIP1                                                                          
 8) TERM PERIOD              -(YEAR AND MONTH)                                  
                              LENGTH OF TIME REGULAR PAYMENTS ARE MADE          
                              AT END OF TERM MORTGAGE PAID OFF IN FULL OR RATES 
                              RENEGOTIATED                                      
.SKIP1                                                                          
 9) AMORTIZATION PERIOD      -(YEAR AND MONTH)                                  
                              LENGTH OF TIME TILL MORTGAGE COMPLETELY PAID OFF  
                              WITH REGULAR PAYMENTS                             
.EJEC                                                                           
.SUBT                EXPLANATION OF CONVERSATION INPUT                          
.SKIP2                                                                          
      QUESTION                     ANSWER                                       
.SKIP1                                                                          
 1) ARE YOU SURE YOU WANT    -ONLY ASKED ONCE                                   
    CONVERSATIONAL INPUT?     TYPE Y TO CONTINUE IN CONVERSATIONAL MODE         
                              TYPE N IF YOU CHANGE YOUR MIND AND WANT INPUT FROM
                              CARDS                                             
.SKIP1                                                                          
 2) NAME PLEASE, 15          -TO BE USED AS PART OF JOB IDENTIFICATION          
    CHARACTERS (CR TO END     WITH MAXIMUM LENGTH OF 15 CHARACTERS              
    PROGRAM)                  TYPE CR (CARRIAGE RETURN) TO END PROGRAM          
.SKIP1                                                                          
 3) ENTER AMOUNT OF MORTGAGE -MAXIMUM 99999999.99, DO NOT NEED DECIMAL POINT IF 
                              IN WHOLE DOLLARS                                  
.SKIP1                                                                          
 4) WHAT IS INTEREST RATE?   -TYPE AMOUNT IN PERCENT, DECIMAL POINT NEEDED ONLY 
    (IN PERCENT)              IF FRACTION PART IS PRESENT                       
.SKIP1                                                                          
 5) DO YOU WANT INTEREST     -TYPE NUMBER CORRESPONDING TO REQUIRED PERIOD      
    CALCULATED: SEE LIST      DEFAULT IS SEMIANNUAL                             
                              TYPE CR FOR DEFAULT                               
.SKIP1                                                                          
 6) ARE PAYMENTS:            -TYPE NUMBER CORRESPONDING TO PAYMENT TYPE         
      1) BLENDED (DEFAULT)    DEFAULT IS BLENDED                                
      2) NONBLENDED           TYPE CR FOR DEFAULT                               
.SKIP1                                                                          
 7) HOW OFTEN ARE PAYMENTS   -TYPE NUMBER CORRESPONDING TO REQUIRED PERIOD      
    MADE: SEE LIST            DEFAULT IS MONTHLY                                
                              TYPE CR FOR DEFAULT                               
.SKIP1                                                                          
 8) ENTER PAYMENT AMOUNT     -TYPE CR FOR ORDINARY MORTGAGE                     
                              SPECIFY IF AMORTIZATION PERIOD UNKNOWN (WILL BE   
                              CALCULATED)                                       
                              MUST SPECIFY IF PAYMENTS NONBLENDED (USED AS      
                              PRINCIPAL AMOUNT)                                 
                              DECIMAL MUST ALWAYS BE INCLUDED                   
.SKIP1                                                                          
 9) WHAT IS TERM PERIOD?     -ENTER YEAR AND MONTH OR TYPE CR TO IGNORE         
.SKIP1                                                                          
10) WHAT IS AMORTIZATION     -ENTER YEAR AND MONTH OR TYPE CR TO IGNORE         
    PERIOD?                                                                     
.EJEC                                                                           
     LIST OF FREQUENCIES                                                        
.SKIP1                                                                          
      1) MONTHLY                                                                
      2) QUARTERLY                                                              
      3) SEMI ANNUALLY                                                          
      4) ANNUALLY                                                               
      5) WEEKLY                                                                 
      6) BI-WEEKLY                                                              
      7) SEMI-MONTHLY                                                           
      8) 13 PERIODS/YEAR                                                        
.EJEC                                                                           
.SUBT                          EXPLANATION OF OUTPUT                            
.SKIP1                                                                          
     SINCE THIS PROGRAM CAN BE RUN IN BATCH MODE, THERE IS A NEED TO DISTINGUISH
DIFFERENT JOBS. THIS IS DONE BY A COVER PAGE CONTAINING A JOB IDENTIFICATION    
FIELD WHICH USES A JOB NUMBER AND USER NAME.  THE COVER PAGE ALSO CONTAINS ALL  
PERTINENT INPUT INFORMATION: AMOUNT OF MORTGAGE; ANNUAL INTEREST RATE;          
COMPOUNDING TIME OF INTEREST; PAYMENT TYPE AND FREQUENCY; TERM PERIOD AND       
AMORTIZATION PERIOD. TWO OTHER FIELDS SHOWN ON THE COVER PAGE INTEREST PAYMENT  
FACTOR AND PAYMENT AMOUNT HAVE BEEN CALCULATED.                                 
.SKIP1                                                                          
     THE OUTPUT LISTINGS DO NOT VARY GREATLY FOR THE DIFFERENT OPTIONS. THE     
MAIN LISTING CONTAINS PAYMENT NUMBER; INTEREST CALCULATED FOR THAT PAYMENT;     
TOTAL INTEREST PAID-TO-DATE; PRINCIPAL PAYMENT; TOTAL PRINCIPAL PAID-TO-DATE;   
AND BALANCE OUTSTANDING AFTER PAYMENT MADE. AT THE END OF EVERY TABLE THE END   
OF TERM MESSAGE AND THE FINAL PAYMENT IS PRINTED. WHEN THE AMORTIZATION PERIOD  
IS UNKNOWN AND THE PAYMENT AMOUNT IS GIVEN, A MESSAGE IS WRITTEN AT THE END OF  
THE TABLE STATING THE AMORTIZATION PERIOD. FOR UNBLENDED PAYMENTS AN EXTRA      
COLUMN CONTAINING THE TOTAL AMOUNT PAID EACH PAYMENT PERIOD IS ADDED TO THE     
LISTING.                                                                        
.EJEC                                                                           
[\].
INTT@@SRC
      SUBROUTINE INTT (X,I)                                                     
C  TO IDENTIFY A SINGLE CHARACTER AND TO                                        
C  RETURN ITS INTEGER EQUIVALENT                                                
C  FLAG NON INTEGERS BY I=-999                                                  
      DATA ONE,TWO,THREE,FOUR,FIVE,SIX,SEVEN,EIGHT,XNINE,ZERO/1H1,1H2,          
     11H3,1H4,1H5,1H6,1H7,1H8,1H9,1H0/                                          
C                                                                               
      I=-999                                                                    
      IF(X[0:6].EQ.ONE)   I=1                                                        
      IF(X[0:6].EQ.TWO)   I=2                                                        
      IF(X[0:6].EQ.THREE) I=3                                                        
      IF(X[0:6].EQ.FOUR)  I=4                                                        
      IF(X[0:6].EQ.FIVE)  I=5                                                        
      IF(X[0:6].EQ.SIX)   I=6                                                        
      IF(X[0:6].EQ.SEVEN) I=7                                                        
      IF(X[0:6].EQ.EIGHT) I=8                                                        
      IF(X[0:6].EQ.XNINE) I=9                                                        
      IF(X[0:6].EQ.ZERO)  I=0                                                        
      RETURN                                                                    
      END                                                                       
[\].
IREAD@SRC
      SUBROUTINE IREAD(NARAY,STREC,NOELE)                                       
C  NARAY -- NAME OF ARRAY                                                       
C  STREC -- STARTING RECORD                                                     
C  NOELE -- NUMBER OF ELEMENTS OF ARRAY                                         
      INTEGER STREC                                                             
      DIMENSION NARAY(1)                                                        
	WRITE(4,20)
20     FORMAT(' SUBRTN IREAD')
C  CALCULATE LIMIT OF DO LOOP                                                   
      NOLP=NOELE/20                                                             
C  IF DIVISION GIVES REMAINDER MUST INCREMENT NOLP TO GET CORRECT NUM.          
	ITEMP=20*NOLP
      IF(ITEMP.LT.NOELE)     NOLP=NOLP+1                                      
C  SET VARIABLES OF IMPLIED LOOP OF READ STATEMENT                              
      K=1                                                                       
      KK=K+20-1                                                                 
      DO 10 I=1,NOLP                                                            
	WRITE(6,)(NARAY(JJJ),JJJ=K,KK)
      READ(1'STREC)(NARAY(J),J=K,KK)                                            
	WRITE(6,)(NARAY(JJ),JJ=K,KK)
C   INCREMENT ABOVE VARIABLES                                                   
      STREC=STREC+1                                                             
      K=K+20                                                                    
      KK=K+20-1                                                                 
C   CHECK LIMIT TO MAKE SURE DON'T HAVE ILLEGAL ELEMENT NUM.                    
      IF(KK.GT.NOELE) KK=NOELE                                                  
10    CONTINUE                                                                  
	WRITE (4,30)
30     FORMAT (' EXIT IREAD')
      RETURN                                                                    
      END                                                                       
[\].
IWRIT@SRC
      SUBROUTINE IWRIT(NARAY,STREC,NOELE)
C  NARAY -- NAME OF ARRAY                                                       
      INTEGER STREC                                                             
      DIMENSION NARAY(NOELE)                                                        
	WRITE(4,20)
20     FORMAT (' SUBRTN IWRIT')
      NOLP=NOELE/20                                                             
	ITEMP=20*NOLP
      IF(ITEMP.LT.NOELE)     NOLP=NOLP+1                                      
      K=1                                                                       
      KK=K+20-1                                                                 
      DO 10 I=1,NOLP                                                            
	DO 30 KKK=K,KK
30      WRITE(6,40)KKK,NARAY(KKK)
40      FORMAT('  NARAY(',I2,') = ',I3)
      WRITE(1'STREC)(NARAY(J),J=K,KK)                                           
      STREC=STREC+1                                                             
      K=K+20                                                                    
      KK=K+20-1                                                                 
      IF(KK.GT.NOELE) KK=NOELE                                                  
10    CONTINUE                                                                  
      RETURN                                                                    
      END                                                                       
[\].
MAIN@@SRC
C*****************ABBEY GLEN MORTGAGE PROGRAM************
C
*********************************************************
C***********************************************************************
C                                                                      *
C     GNC MORTGAGE PROGRAM                                             *
C                                                                      *
C     LIZ LUCIANI  	MODIFIED BY J ROBINSON FOR RSX-11D                                                      *
C     JAN 1974		22AUG75
C                                                                      *
C     LUNS 5 = TERMINAL INPUT                                              *
C          6 = REPORT OUTPUT (LP/LV)                                   *
C          4 = DEFAULT FILE INPUT FOR004.DAT
C     TO CALCULATE AMORTIZATION TABLES FOR ANY AMOUNT, ANY PERIOD,     *
C     ANY INTEREST RATE. IF NOT SPECIFIED PROGRAM WILL DEFAULT TO      *
C     INTEREST COMPOUNDED SEMI-ANNUALLY AND PAYMENTS MADE MONTHLY.     *
C     PAYMENTS CAN BE EITHER BLENDED (DEFAULT) OR UNBLENDED            *        
C     IF PAYMENT AMOUNT GIVEN PROGRAM WILL CALCULATE AMORTIZATION      *        
C     PERIOD                                                           *        
C                                                                      *
C***********************************************************************
	IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      INTEGER TYR,TMO,AYR,AMO,IFRQ1,IFRQ2,NBLND,I,J
	DIMENSION T(8),ZCAL(2),ZINP(2)
      COMMON ZSPA1(2),ZSPA2(2),ZSPA3(2),ZTIME(3),ANAM(3),AMTMRT,RAT1
      COMMON IFRQ1,NBLND,IFRQ2,PAYAMT,TYR,TMO,AYR,AMO,NOJOB,RATE2
	COMMON ZPAY(2)
C
C  ARRAY CONTAINING FIGURES FOR FREQUENCY                                       
	DATA T(1),T(2),T(3),T(4)/12.0D00,4.0D00,2.0D00,1.0D00/
	DATA T(5),T(6),T(7),T(8)/52.0D00,26.0D00,24.0D00,13.0D00/
C
	DATA BLANK,DZER0/'     ',1.0D+09/
      DATA ZCAL(1),ZCAL(2)/'CALCU','LATED'/
      DATA ZINP(1),ZINP(2)/'INPUT','     '/
C
C  INITIALIZE JOB NUMBER AT 100                                                 
      NOJOB = 100
      IFRST=0
C
C  SUBROUTINE TO TEST DAT SWITCH. IF SWITCH = 1 INPUT COMES FROM                
C  CONVERSATIONAL VT05. IF NOT INPUT READ FROM CARDS                            
      CALL SSWTCH(15,ISW)
900   IF(ISW.EQ.2)GO TO 500
C
C  READ STATEMENT FOR CARD INPUT CONTAINS USER ANAME, AMOUNT OF MORTGAGE,        
C    RATE OF INTEREST (PERCENT), WHEN INTEREST CALCULATED, PAYMENT TYPE,        
C    FREQUENCY OF PAYMENTS, PAYMENT AMOUNT, TERM PERIOD, AMORTIZATION           
C    PERIOD                                                                     
510   READ(4,600,END=999)(ANAM(I),I=1,3),AMTMRT,RAT1,IFRQ1,NBLND,
     1IFRQ2,PAYAMT,TYR,TMO,AYR,AMO
	PAYAMT=PAYAMT*100.
600   FORMAT(3A5,D12.2,D5.2,3I1,D9.2,4I2)
C  IF TERM PERIOD NOT ENTERED ASSUMED TO BE SAME AS AMORTIZATION PERIOD         
      IF(TYR.NE.0) GO TO 650
      TYR=AYR
      TMO=AMO
	GO TO 650
C
C  QUESTIONS ASKED CONVERSATIONALLY                                             
500   IF(IFRST.EQ.1)GO TO 530
C  MAKE DOUBLELY SURE INPUT NOT COMING FROM CARDS (ONLY ASKED ONCE)             
C  BLEEP TO ATTRACT ATTENTION                                                   
      IFRST = 1
      WRITE(5,300)
300   FORMAT(' FOR BATCH SW15 ON & RERUN USING FOR004.DAT')
C
C  REQUESTING USER ANAME FOR ID. PURPOSES (15-CHARACTERS)                        
530   WRITE(5,320)
320   FORMAT(' ANAME PLEASE, 15 CHARACTERS (CR TO END PROGRAM)')
      READ(5,330)(ANAM(I),I=1,3)
330   FORMAT(3A5)
C  BLANK ANAME FIELD SIGNALS END OF PROGRAM                                      
      IF(ANAM(1).EQ.BLANK) STOP
C
      WRITE(5,340)
340   FORMAT(' ENTER AMOUNT OF MORTGAGE')
      READ(5,)AMTMRT
C
      WRITE(5,360)
360   FORMAT(' WHAT IS INTEREST RATE? (IN PERCENT)')
	READ(5,)RAT1
C
      WRITE(5,370)
370   FORMAT(' DO YOU WANT INTEREST CALCULATED:   1) MONTHLY'/36X,'2) QU
     1ARTERLY'/36X,'3) SEMI ANNUALLY (DEFAULT)'/36X,'4) ANNUALLY'/36X,'5
     2) WEEKLY'/36X,'6) BI-WEEKLY'/36X,'7) SEMI-MONTHLY'/36X,'8) 13 PERI
     3ODS/YEAR')
      READ(5,380)IFRQ1
380   FORMAT(I1)
C
      WRITE(5,390)
390   FORMAT(' ARE PAYMENTS: 1) BLENDED (DEFAULT)'/15X,'2) NONBLENDED')
      READ(5,380)NBLND
C
      WRITE(5,400)
400   FORMAT(' HOW OFTEN ARE PAYMENTS MADE:   1) MONTHLY (DEFAULT)'/32X,
     1'2) QUARTERLY'/32X,'3) SEMI ANNUALLY'/32X,'4) ANNUALLY'/32X,'5) WE
     2EKLY'/32X,'6) BI-WEEKLY',/32X,'7) SEMI-MONTHLY'/32X,'8) 13 PERIODS
     3/YEAR')
      READ(5,380)IFRQ2
C
      WRITE(5,410)
410   FORMAT(' ENTER PAYMENT AMOUNT (IF PAYMENTS NONBLENDED MUST SPECIFY
     1)'/22X,'(TO BE USED AS PRNICIPAL PAYMENT)'/22X,'INCLUDE DECIMAL')
      READ(5,420)PAYAMT
420   FORMAT(D9.2)
C  CHANGE PAYMENT AMOUNT TO CENTS
	PAYAMT=PAYAMT*100.
C                                                                               
      WRITE(5,425)                                                              
425   FORMAT(' WHAT IS TERM PERIOD?'//5X,'YEARS')                               
      READ(5,430)TYR                                                            
430   FORMAT(I2)                                                                
      WRITE(5,435)                                                              
435   FORMAT(5X,'MONTHS')                                                       
      READ(5,430)TMO                                                            
C                                                                               
      WRITE(5,440)                                                              
440   FORMAT(' WHAT IS  AMORTIZATION PERIOD?'//5X,'YEARS')                      
      READ(5,430)AYR                                                            
      WRITE(5,435)                                                              
      READ(5,430)AMO                                                            
C
C  END OF QUESTIONS
455   WRITE(5,460)
460   FORMAT(' THANK YOU')
C                                                                               
C  SETS TERM PERIOD EQUAL TO AMORTIZATION PERIOD
	IF(TYR.NE.0) GO TO 650
	TYR=AYR
	TMO=AMO
C  RESET END OF TERM SWITCH
650   SWEND=0
C  SUBROUTINE TO EDIT VALUES REPLACING WITH DEFAULTS IF NEEDED
      CALL EDIT(IFRQ1,NBLND,IFRQ2)
C  INCREMENT JOB NUMBER                                                         
      NOJOB=NOJOB+1
C  I,J ARE SUBSCRIPTS FOR ARRAY OF FREQUENCY FIGURES                            
	I=IFRQ1
	J=IFRQ2
C  CHANGE INTEREST RATE FROM PERCENTAGE TO DECIMAL                              
	RATE=RAT1/100.
C  FORMULA TO CALCULATE INTEREST PAYMENT FACTOR                                 
	RATE2=(((1.+(RATE/T(I)))**(T(I)/T(J)))-1.)
C
      IF(NBLND.EQ.1) GO TO 190
C  SUBROUTINE CALCULATING NONBLENDED PAYMENTS
	PRNPAY=PAYAMT
      CALL UNBLND(PRNPAY,T(J))
C  FORM FEED
      WRITE(6,1)
C  TEST FOR INPUT COMING FROM CARDS
      IF(ZANS.EQ.1HN) GO TO 510
      GO TO 900
C                                                                               
C  SETS UP MESSAGE THAT PAYMENT IS EITHER INPUT OR CALCULATED                   
190   IF(PAYAMT.EQ.0.0) GO TO 200
      ZPAY(1) = ZINP(1)
      ZPAY(2) = ZINP(2)
      AYR = 999
      GO TO 210
200   ZPAY(1) = ZCAL(1)
      ZPAY(2) = ZCAL(2)
C
C  CHANGES AMOUNT OF MORTGAGE TO PENNIES AND CALCULATES PAYMENT AMOUNT          
	PRNC=AMTMRT*100
      PAYAMT=((PRNC*RATE2*((1.+RATE2)**(AYR*T(J))))/(((1.+RATE2)**
     1(AYR*T(J)))-1.))
C  ALWAYS ROUNDS PAYMENT AMOUNT UPWARDS
	PAYAMT=WHOLE(1.0*PAYAMT+.9999999)
C  SUBROUTINE TO PRINT COVER PAGE                                               
      CALL COVR
C
C  OUTPUT AMORTIZATION TABLE
C  WRITE HEADER LINES                                                           
      WRITE(6,100)
100   FORMAT('1',6X,'PAYMENT',16X,'INTEREST',12X,'INTEREST PAID',10X,
     1'PRINCIPAL',11X,'PRINCIPAL PAID',12X,'BALANCE')
      WRITE(6,110)
110   FORMAT(8X,'NUMBER',39X,'TO-DATE',14X,'PAYMENT',15X,'TO-DATE',
     114X,'OUTSTANDING'//)
C
C  CALCULATE NUMBER OF PAYMENTS                                                 
	NOPER=AYR*T(J)
C  INITIALIZE FIELDS AND COUNTERS, CHANGE BALANCE OUTSTANDING TO PENNIES        
	PTDINT=0.0
	PRNPTD=0.0
	BALOUT=AMTMRT*100.
	ILNCNT=0
C  CHANGING TERM PERIOD INTO MONTHS
      NOMON=TYR*12+TMO
C  CALCULATES WHICH PAYMENT IS END OF TERM
      CALL NOEND(NOMON,J,NEND)
C  LOOP EXECUTED 'NUMBER OF PAYMENT' TIMES
      DO 50 NOPAY=1,NOPER
C  CALCULATIONS FOR AMORTIZATION TABLE                                          
	AINT=BALOUT*RATE2
	IF(NOPER.EQ.NOPAY) PAYAMT=BALOUT+AINT
C  HALF ROUNDS AMOUNT OF INTEREST
	AINT=WHOLE(1.0*AINT+.5)
	PTDINT=PTDINT+AINT
C  COMPARING NUMBER OF PAYMENTS TO END OF TERM NUMBER
	IF(NOPAY.LT.NEND) GO TO 112
C  SETTING FINAL PAYMENT LINE FOR END OF TERM PAYMENT
	SWEND=1
	PRNPAY=BALOUT
	PRNPTD=AMTMRT*100.
	BALOUT=0.0
	GO TO 115
C  REGULAR CALCULATIONS
112   PRNPAY=PAYAMT-AINT
	PRNPTD=PRNPTD+PRNPAY
	BALOUT=BALOUT-PRNPAY
C  TO AVOID A NEGATIVE ZERO                                                     
      IF(BALOUT.LT.0.00) BALOUT=ABS(BALOUT)
C  TESTS LINE COUNTER NEW PAGE AFTER 50 PAYMENTS                                
115   ILNCNT=ILNCNT+1
      IF(ILNCNT.LE.50) GO TO 117
      ILNCNT = 1
C  HEADER LINES                                                                 
      WRITE(6,100)
      WRITE(6,110)
C
C  CHANGES ALL VALUES FROM PENNIES TO DOLLARS                                   
117   QAINT=AINT/100.
      QPTDIN=PTDINT/100.
      QPRNPA=PRNPAY/100.
      QPRNPT=PRNPTD/100.
      QBALOU=BALOUT/100.
C  PRINT LINE OF AMORTIZATION TABLE                                             
      WRITE(6,120)NOPAY,QAINT,QPTDIN,QPRNPA,QPRNPT,QBALOU
120   FORMAT(9X,I3,15X,'$',F10.2,11X,'$',F11.2,10X,'$',F10.2,11X,'$',
     1F12.2,9X,'$',F12.2)
	IF(SWEND.EQ.1) GO TO 799
50    CONTINUE
799   WRITE(6,113)                                                              
113   FORMAT(/'   END OF TERM'/)                                                
C
C  CALCULATE AND PRINT FINAL PAYMENT                                            
800   ZFPAY=(PRNPAY+AINT)/100.
850   WRITE(6,860)ZFPAY
860   FORMAT(//5X,'FINAL PAYMENT  ',F11.2)
C  FORM FEED
205   WRITE(6,1)
1     FORMAT('1')
C  TEST FOR INPUT COMING FROM CARDS                                             
	IF(ZANS.EQ.1HN) GO TO 510
      GO TO 900
C
C
C  THIS SECTION IS EXECUTED ONLY IF PAYMENT AMOUNT IS SPECIFIED BY
C  THE USER
210   CALL COVR
	ILNCNT=0
C  INITIALIZE COUNTERS AND FIELDS AND PRINT HEADER LINES                        
      AYR=0
      NOPAY=0
      WRITE(6,100)
      WRITE(6,110)
      PTDINT=0.0
      PRNPTD=0.0
      BALOUT=AMTMRT*100.
C  COUNTS NUMBER OF PAYMENTS                                                    
215   NOPAY=NOPAY+1
C  CALCULATIONS FOR AMORTIZATION TABLE                                          
217   AINT=BALOUT*RATE2
	AINT=WHOLE(1.0*AINT+.5)
      PTDINT=PTDINT+AINT
      PRNPAY=PAYAMT-AINT
      PRNPTD=PRNPTD+PRNPAY
      BALOUT=BALOUT-PRNPAY
      IF(BALOUT.GE.0.0) GO TO 219
C  FOR LAST PAYMENT MUST CORRECT FOR OVERCHARGING
C  (BALOUT IS NEGATIVE NUMBER)
	PRNPAY=PRNPAY+BALOUT
	PRNPTD=PRNPTD+BALOUT
	BALOUT=0.0
C  LINE COUNT                                                                   
219   ILNCNT=ILNCNT+1
      IF(ILNCNT.LE.50) GO TO 220
      ILNCNT=1
      WRITE(6,100)
      WRITE(6,110)
C
C  CHANGE VALUES FROM PENNIES TO DOLLARS                                        
220   QAINT=AINT/100.
	QPTDIN=PTDINT/100.
	QPRNPA=PRNPAY/100.
	QPRNPT=PRNPTD/100.
	QBALOU=BALOUT/100.
C  PRINT LINE OF AMORTIZATION TABLE                                             
      WRITE(6,120)NOPAY,QAINT,QPTDIN,QPRNPA,QPRNPT,QBALOU
      IF(BALOUT.GT.0.0) GO TO 215
	PAYAMT=PAYAMT/100.
C  FINAL PAYMENT
	ZFPAY=(PRNPAY+AINT)/100.
	WRITE(6,860)ZFPAY
C
C  PRINT STATEMENT OF AMORTIZATION PERIOD                                       
      WRITE(6,230)AMTMRT,RAT1,PAYAMT
230   FORMAT(//7X,'A MORTGAGE OF ',F12.2,' AT ',F5.2,' PERCENT INTEREST
     1 WITH PAYMENTS OF ',F9.2)
C  SUBROUTINE TO CHANGE NUMBER OF PERIODS TO YEARS AND MONTHS
	CALL AMORT(NOPAY,T(J),AYR,AMO)
      WRITE(6,240)AYR,AMO
240   FORMAT(/62X,'HAS AN AMORTIZATION PERIOD OF ',I2,' YEARS ',I2,' MON
     1THS')
C  FORM FEED
	WRITE(6,1)
C  TEST FOR INPUT COMING FROM CARDS
	IF(ZANS.EQ.1HN) GO TO 510
      GO TO 900
999   STOP
      END
C***************************
	SUBROUTINE COVR
C                                                                               
C  OUTPUTS COVER PAGE FOR EACH DIFFERENT MORTGAGE                               
C
	IMPLICIT DOUBLE PRECISION(A-H,O-Z)
      INTEGER TYR,TMO,AYR,AMO,I,J,NBLND,IFRQ1,IFRQ2
      DIMENSION ZBLND1(2),ZBLND2(2),ZDATE(2)
      DIMENSION AJOBID(4),ZBLND(2)
      COMMON ZSPA1(2),ZSPA2(2),ZSPA3(2),ZTIME(3),ANAM(3),AMTMRT,RATE
      COMMON IFRQ1,NBLND,IFRQ2,PAYAMT,TYR,TMO,AYR,AMO,NOJOB,RATE2
	COMMON ZPAY(2)
      DATA ZBLND1(1),ZBLND1(2)/'BLEND','ED   '/
      DATA ZBLND2(1),ZBLND2(2)/'NONBL','ENDED'/
	DATA BLANK /'        '/
C
C COVER SHEET
C
C  PRINTS MAIN TITLE AND BORDER                                                 
	WRITE(6,50)
      WRITE(6,100)
      WRITE(6,120)
      WRITE(6,240)
      WRITE(6,140)
C  FETCHES CURRENT DATE                                                         
	ZDATE(1)=BLANK
	ZDATE(2)=BLANK
	CALL DATE (ZDATE)
      WRITE(6,150)ZDATE(1),ZDATE(2)
      WRITE(6,160)
      WRITE(6,170)
      WRITE(6,180)
      WRITE(6,190)
      WRITE(6,200)
      WRITE(6,210)
      WRITE(6,220)
      WRITE(6,230)
	WRITE (6,231)
	WRITE(6,232)
      WRITE(6,240)
      WRITE(6,250)
      WRITE(6,240)
      WRITE(6,260)
      WRITE(6,240)
      WRITE(6,240)
      WRITE(6,270)
      WRITE(6,280)
	WRITE(6,290)
	WRITE(6,300)
      WRITE(6,310)
      WRITE(6,320)
      WRITE(6,240)
      WRITE(6,330)
      WRITE(6,340)
      WRITE(6,350)
      WRITE(6,360)
      WRITE(6,370)
      WRITE(6,380)
      WRITE(6,240)
50    FORMAT('1')
100   FORMAT(5X,25('*****'),3X)
120   FORMAT(4X,'*',125X,'*  ')
140   FORMAT(3X,'*', 9X,'DATE',T64,'**  ********',56X,'*')
150   FORMAT(3X,'*',7X,2A5,T63,'****  ********',55X,'*')
160   FORMAT(3X,'*',T62,'******  ********',54X,'*')
170   FORMAT(3X,'*',T61,'********  ********',53X,'*')
180   FORMAT(3X,'*',T60,'*********   ********',52X,'*')
190   FORMAT(3X,'*',T59,'*********     ********'51X,'*')
200   FORMAT(3X,'*',T58,'*********       ********'50X,'*')
210   FORMAT(3X,'*',T59,'*******',66X,'*')
220   FORMAT(3X,'*',T60,'*****  **************',51X,'*')
230   FORMAT(3X,'*',T61,'***  **************',52X'*')
231	FORMAT(3X,'*',T62,'*  **************',53X,'*')
232	FORMAT (3X,'*',T64'**************',54X,'*')
240   FORMAT(3X,'*',127X,'* ')
250   FORMAT(3X,'*',T56,'ABBEY GLEN PROPERTY CORPORATION',
     145X,'* ')
260   FORMAT(3X,'*',55X,'COMPUTER SERVICES GROUP',49X,'*')
270   FORMAT(3X,'*',30X,'**   **    ****    ****    *****    ****     **
     1*     ****    *****',31X,'* ')
280   FORMAT(3X,'*',30X,'* * * *   *    *   *   *     *     *    *   *
     1   *   *    *   *    ',31X,'* ')
290   FORMAT(3X,'*',30X,'*  *  *   *    *   ****      *     *        *
     1   *   *        **** ',31X,'* ')
300   FORMAT(3X,'*',30X,'*     *   *    *   * *       *     *  ***   ***
     1**   *  ***   *    ',31X,'* ')
310   FORMAT(3X,'*',30X,'*     *   *    *   *  *      *     *    *   *
     1   *   *    *   *    ',31X,'* ')
320   FORMAT(3X,'*',30X,'*     *    ****    *   *     *      ****    *
     1   *    ****    *****',31X,'* ')
330   FORMAT(3X,'*',18X,' ****     ****    *         ****    *    *   *
     1         ****    *****   *****    ****    *    *',15X,'* ')
340   FORMAT(3X,'*',18X,'*    *   *    *   *        *    *   *    *   *
     1        *    *     *       *     *    *   **   *',15X,'* ')
350   FORMAT(3X,'*',18X,'*        *    *   *        *        *    *   *
     1        *    *     *       *     *    *   * *  *',15X,'* ')
360   FORMAT(3X,'*',18X,'*        ******   *        *        *    *   *
     1        ******     *       *     *    *   *  * *',15X,'* ')
370   FORMAT(3X,'*',18X,'*    *   *    *   *        *    *   *    *   *
     1        *    *     *       *     *    *   *   **',15X,'* ')
380   FORMAT(3X,'*',18X,' ****    *    *   ******    ****     ****    **
     1****   *    *     *     *****    ****    *    *',15X,'* ')
C
C  SET UP JOB IDENTIFICATION FIELD CONSISTING OF JOB NUMBER AND USER ANAME       
      DO 6 I=1,3
6     AJOBID(I+1)=ANAM(I)
      WRITE(6,390)(AJOBID(J),J=2,4)
390   FORMAT(3X,'*',32X,'JOB IDENTIFICATION:',11X,4X,1X,3A5,45X,'* ')
      WRITE(6,240)
C
      WRITE(6,400)AMTMRT
400   FORMAT(3X,'*',32X,'AMOUNT OF MORTGAGE:',11X,F12.2,53X,'* ')
	WRITE(6,240)
C
      WRITE(6,420)RATE
420   FORMAT(3X,'*',32X,'ANNUAL INTEREST RATE:',9X,F5.2,'  PERCENT',51X,
     1'* ')
      WRITE(6,240)
C
C  CALL SUBROUTINE TO DETERMINE HOW OFTEN INTEREST IS CALCULATED                
      CALL FREQ(IFRQ1)
      WRITE(6,430)(ZTIME(J),J=1,3),ZSPA1(1),ZSPA1(2)
430   FORMAT(3X,'*',32X,'       CALCULATED:',12X,3A5,4X,2A5,36X,'* ')
      WRITE(6,240)
C
C  CHANGE INTEREST FACTOR TO PERCENTAGE
	RATE3=RATE2*100
	WRITE(6,435)RATE3
435   FORMAT(3X,'*',32X,'INTEREST PAYMENT FACTOR:',6X,F13.9,' PERCENT',
     146X,'* ')
	WRITE(6,240)
C
C  CALL SUBROUTINE TO DETERMINE FREQUENCY OF PAYMENT                            
      CALL FREQ(IFRQ2)
C  COMPUTED GO TO OUTPUTS IF PAYMENTS ARE BLENDED OR NONBLENDED                 
      GO TO (510,520),NBLND
510   ZBLND(1) = ZBLND1(1)
      ZBLND(2) = ZBLND1(2)
      GO TO 99
520   ZBLND(1) = ZBLND2(1)
      ZBLND(2) = ZBLND2(2)
C  PRINTS PAYMENT TYPE AND FREQUENCY
99    WRITE(6,440)ZBLND(1),ZBLND(2),ZSPA2(1),ZSPA2(2)
440   FORMAT(3X,'*',32X,'PAYMENTS:',21X,2A5,8X,2A5,37X,'* ')
	WRITE(6,445)(ZTIME(J),J=1,3),ZSPA3(1),ZSPA3(2)
445   FORMAT(3X,'*',62X,3A5,4X,2A5,36X,'* ')
      WRITE(6,240)
C
C  CONVERTS AMOUNT OF PAYMENT TO DOLLARS BEFORE PRINTING                        
	QPAYAM=PAYAMT/100.
      WRITE(6,450)QPAYAM,ZPAY(1),ZPAY(2)
450   FORMAT(3X,'*',32X,'PAYMENT AMOUNT:',15X,F11.2,'  (',2A5,')',40X,
     1'* ')
      WRITE(6,240)
C
C  TERM PERIOD                                                                  
      WRITE(6,460)TYR,TMO
460   FORMAT(3X,'*',32X,'TERM:',25X,I2,' YEARS ',I2,' MONTHS',47X,'* ')
      WRITE(6,240)
C
C  AMORTIZATION PERIOD                                                          
      WRITE(6,470)AYR,AMO
470   FORMAT(3X,'*',32X,'AMORTIZATION PERIOD:',10X,I2,' YEARS ',I2,
     1' MONTHS',47X,'* ')
      WRITE(6,240)
      WRITE(6,120)
      WRITE(6,100)
999   RETURN
      END
C*********************
      SUBROUTINE EDIT(IFRQ1,NBLND,IFRQ2)
C
C  CHECKS FIELDS ON INPUT CARD FOR ERRORS. REPLACES ANY WITH DEFAULT
C  VALUES
C
	IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DIMENSION DEF(2)
      COMMON SPA1(2),SPA2(2),SPA3(2)
      DATA DEF(1),DEF(2),BLNK/'(DEFA','ULT) ','     '/
C
C  INITIALIZING FIELD THAT WILL CONTAIN WORD 'DEFAULT'                          
      SPA1(1) = BLNK
      SPA1(2) = BLNK
      SPA2(1) = BLNK
      SPA2(2) = BLNK
      SPA3(1) = BLNK
      SPA3(2) = BLNK
C  HOW OFTEN INTEREST RATE APPLIED (DEFAULTS TO SEMI-ANNUALLY)                  
      IF((IFRQ1.GE.1).AND.(IFRQ1.LE.8)) GO TO 30
      IFRQ1 = 3
      SPA1(1) = DEF(1)
      SPA1(2) = DEF(2)
C  TYPE OF PAYMENT (DEFAULTS TO BLENDED)                                        
30    IF((NBLND.EQ.1).OR.(NBLND.EQ.2)) GO TO 50
      NBLND=1
      SPA2(1) = DEF(1)
      SPA2(2) = DEF(2)
C  FREQUENCY OF PAYMENTS (DEFAULTS TO MONTHLY)                                  
50    IF((IFRQ2.GE.1).AND.(IFRQ2.LE.8)) RETURN
      IFRQ2 = 1
      SPA3(1) = DEF(1)
      SPA3(2) = DEF(2)
      RETURN
      END
C*********************
      SUBROUTINE FREQ(IFREQ)
C                                                                               
C  INTERPRETS CODES FOR FREQUENCY                                               
C
	IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DIMENSION ZMON(3),QAR(3),SMA(3),ANN(3),WEK(3),BLND1(2),BLND2(2)
      DIMENSION BIW(3),SMM(3),PER(3)
      COMMON SPA1(2),SPA2(2),SPA3(2),TIME(3)
C
C  EIGHT POSSIBILITIES                                                          
      DATA ZMON(1),ZMON(2),ZMON(3)/'MONTH','LY   ','     '/
      DATA QAR(1),QAR(2),QAR(3)/'QUART','ERLY ','     '/
      DATA SMA(1),SMA(2),SMA(3)/'SEMI ','ANNUA','LLY  '/
      DATA ANN(1),ANN(2),ANN(3)/'ANNUA','LLY  ','     '/
      DATA WEK(1),WEK(2),WEK(3)/'WEEKL','Y    ','     '/
      DATA BIW(1),BIW(2),BIW(3)/'BI-WE','EKLY ','     '/
      DATA SMM(1),SMM(2),SMM(3)/'SEMI ','MONTH','LY   '/
      DATA PER(1),PER(2),PER(3)/'13 PE','RIODS','1YEAR'/
C
C  COMPUTED GOTO DEPENDS ON CODE USED                                           
      GO TO (10,20,30,40,50,60,70,80),IFREQ
C  MONTHLY
10    DO 15 I=1,3
15    TIME(I)=ZMON(I)
      GO TO 90
C  QUARTERLY                                                                    
20    DO 25 I=1,3
25    TIME(I)=QAR(I)
      GO TO 90
C  SEMI-ANNUALLY                                                                
30    DO 35 I=1,3
35    TIME(I)=SMA(I)
      GO TO 90
C  ANNUALLY                                                                     
40    DO 45 I=1,3
45    TIME(I)=ANN(I)
      GO TO 90
C  WEEKLY                                                                       
50    DO 55 I=1,3
55    TIME(I)=WEK(I)
      GO TO 90
C  BI-WEEKLY                                                                    
60    DO 65 I=1,3
65    TIME(I)=BIW(I)
      GO TO 90
C  SEMI-MONTHLY                                                                 
70    DO 75 I=1,3
75    TIME(I)=SMM(I)
      GO TO 90
C  13 PERIODS/YEAR                                                              
80    DO 85 I=1,3
85    TIME(I)=PER(I)
90    RETURN
      END
C*********************
C WHOLE - INTERIM FUNCTION                                                      
      DOUBLE PRECISION FUNCTION WHOLE (X)                                       
	DOUBLE PRECISION TEMP,RY
      DOUBLE INTEGER Y                                                          
C     REAL TO INTEGER                                                           
	Y=X
	RY=Y
	TEMP=X-RY
	WHOLE=X-TEMP
      RETURN                                                                    
      END                                                                       
C*********************
      SUBROUTINE NOEND(NOMON,J,NZEND)
C
C  CALCULATES NUMBER OF PAYMENTS BEFORE END OF TERM
C
      GO TO (10,20,30,40,50,60,70,80),J
C  MONTHLY: NUMBER OF PAYMENTS EQUALS NUMBER OF MONTHS
10    NZEND=NOMON
      RETURN
C  QUARTERLY: NUMBER OF PAYMENTS EQUALS A THIRD NUMBER OF MONTHS
20    NZEND=NOMON/3
      ZEND=NOMON/3
      GO TO 90
C  SEMI-ANNULLLY: NUMBER OF PAYMENTS EQUALS A SIXTH NUMBER OF MONTHS
30    NZEND=NOMON/6
      ZEND=NOMON/6
      GO TO 90
C  ANNUALLY: NUMBER OF PAYMENTS EQUALS A TWELFTH NUMBER OF MONTHS
40    NZEND=NOMON/12
      ZEND=NOMON/12
      GO TO 90
C  WEEKLY: NUMBER OF PAYMENTS EQUALS 52/12 NUMBER OF MONTHS
50    NZEND=NOMON*52/12
      ZEND=NOMON*52/12
      GO TO 90
C  BI-WEEKLY: NUMBER OF PAYMENTS EQUALS 26/12 NUMBER OF MONTHS
60    NZEND=NOMON*26/12
      ZEND=NOMON*26/12
      GO TO 90
C  SEMI-MONTHLY: NUMBER OF PAYMENTS EQUALS TWICE NUMBER OF MONTHS
70    NZEND=NOMON*2
      ZEND=NOMON*2
      GO TO 90
C  13 PERIODS/YEAR: NUMBER OF PAYMENTS EQUALS 13/12 NUMBER OF MONTHS
80    NZEND=NOMON*13/12
      ZEND=NOMON*13/12
C
C  IF NUMBER OF PAYMENTS NOT CALCULATED EVENLY MUST INCREMENT BY ONE
C  TO ALLOW FOR EXTRA FRACTION
90    TEMP=ZEND-NZEND
      IF(TEMP.NE.0.0)NZEND=NZEND+1
      RETURN
      END
C*********************
      SUBROUTINE UNBLND(PRNPAY,TJ)
C
C  CALCULATES AND OUTPUTS AMORTIZATION TABLE WITH NONBLENDED PAYMENTS
C
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      INTEGER AYR,AMO,TYR,TMO
      COMMON ZSPA1(2),ZSPA2(2),ZSPA3(2),ZTIME(3),ANAM(3),AMTMRT,RAT1
      COMMON IFRQ1,NBLND,IFRQ2,PAYAMT,TYR,TMO,AYR,AMO,NOJOB,RATE2
      COMMON ZPAY(2)
	DATA ZPAY1,ZPAY2/'SEE T','ABLE '/
	ZPAY(1)=ZPAY1
	ZPAY(2)=ZPAY2
C
C  CHECK FOR VALID PRINCIPAL PAYMENT
      IF(PRNPAY.GT.0.0) GO TO 10
	WRITE(5,200)
      WRITE(6,200)
200   FORMAT('1'//' SORRY, AMORTIZATION TABLE CANNOT BE COMPUTED BECAUSE
     1OF INVALID PRINCIPAL PAYMENT.'/31X,'PLEASE CHECK PAYMENT AMOUNT FI
     2ELD ON INPUT RECORD.')
      RETURN
C
C  CALCULATE NUMBER OF PAYMENT PERIODS
C  MUST CHECK FOR EVEN DIVISION IF NOT ADD 1 TO NUMBER OF PAYMENT PERIOD
C  TO ALLOW FOR LAST PAYMENT
10    NOPER=(AMTMRT*100)/PRNPAY
      NUM = NOPER*PRNPAY/100
      IF(NUM.NE.AMTMRT) NOPER=NOPER+1
C
C  CALCULATE AMORTIZATION PERIOD
	CALL AMORT(NOPER,TJ,AYR,AMO)
	PAYAMT=0.0
C
C  PRINT COVER PAGE
      CALL COVR
C
C  PRINT HEADERS
      WRITE(6,210)
210   FORMAT('1',6X,'PAYMENT',11X,'INTEREST',8X,'INTEREST PAID',8X,'PRIN
     1CIPAL',8X,'PRINCIPAL PAID',9X,'TOTAL',13X,'BALANCE')
      WRITE(6,220)
220   FORMAT(7X,'NUMBER',31X,'TO-DATE',12X,'PAYMENT',12X,'TO-DATE',12X,
     1'PAYMENT',10X,'OUTSTANDING'//)
C  INITIALIZE COUNTERS AND FIELDS
C  CHANGE TO PENNIES
      BALOUT=AMTMRT*100
      PTDINT=0.0
      PRNPTD=0.0
      ILNCNT=0
C  LOOP EXCECUTED 'NUMBER OF PAYMENT' TIMES
      DO 100 NOPAY=1,NOPER
C  COMPUTE AMOUNT OF INTEREST
      AINT=BALOUT*RATE2
      AINT=WHOLE(1.0*AINT+.5)
C  INTEREST PAID-TO-DATE
      PTDINT=PTDINT+AINT
C  PAYMENT AMOUNT
      PAYAMT=AINT+PRNPAY
C  PRINCIPAL PAID-TO-DATE
      PRNPTD=PRNPTD+PRNPAY
C  BALANCE OUTSTANDING
      BALOUT=BALOUT-PRNPAY
      IF(BALOUT.GE.0.0) GO TO 120
C  LAST PAYMENT CORRECTS FOR ANY OVERPAYMENT
	PAYAMT=PAYAMT+BALOUT
	PRNPAY=PRNPAY+BALOUT
	PRNPTD=PRNPTD+BALOUT
	BALOUT=0.0
C  SETTING & TESTING LINE COUNT
120   ILNCNT=ILNCNT+1
      IF(ILNCNT.LE.50)GO TO 300
      ILNCNT=1
C  WRITE HEADERS ON NEW PAGE
      WRITE(6,210)
      WRITE(6,220)
C  CHANGE ALL AMOUNTS FROM PENNIES TO DOLLARS
300   QAINT=AINT/100
      QPTDIN=PTDINT/100
      QPRNPA=PRNPAY/100
      QPRNPT=PRNPTD/100
      QPAYAM=PAYAMT/100
      QBALOU=BALOUT/100
C  PRINT LINE OF TABLE
      WRITE(6,230)NOPAY,QAINT,QPTDIN,QPRNPA,QPRNPT,QPAYAM,QBALOU
230   FORMAT(9X,I3,10X,'$',F10.2,7X,'$',F11.2,8X,'$',F10.2,8X,'$',F12.2,
     16X,'$',F11.2,6X,'$',F12.2)
100   CONTINUE
C  PRINT FINAL PAYMENT
      ZFPAY=(PRNPAY+AINT)/100
      WRITE(6,860)ZFPAY
860   FORMAT(/15X,'FINAL PAYMENT  ',F11.2)
      RETURN
      END
C*********************
      SUBROUTINE AMORT(NOPER,TJ,IAYR,IAMO)
C
C  CALCULATE AMORTIZATION PERIOD
C
	IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DOUBLE PRECISION TJ
C  NUMBER OF YEARS
      IAYR=NOPER/TJ
      ZIAYR=NOPER/TJ
      ZREM=ZIAYR-IAYR
C  NUMBER OF MONTHS
      IAMO=ZREM*12
      ZIAMO=ZREM*12
      ZNUM=ZIAMO-IAMO
C  TO ALLOW FOR LAST PAYMENT IF TIME DOES NOT WORK OUT EVENLY
      IF(ZNUM.NE.0) IAMO=IAMO+1
      RETURN
      END
[\].
MNMORTSRC
C***********************************************************************
C                                                                      *
C     GNC MORTGAGE PROGRAM                                             *
C                                                                      *
C     LIZ LUCIANI                                                      *
C     JAN 1974                                                         *
C                                                                      *
C     DATS 5 = CARD INPUT                                              *
C          6 = REPORT OUTPUT (LP/LV)                                   *
C                                                                      *
C     TO CALCULATE AMORTIZATION TABLES FOR ANY AMOUNT, ANY PERIOD,     *
C     ANY INTEREST RATE. IF NOT SPECIFIED PROGRAM WILL DEFAULT TO      *
C     INTEREST COMPOUNDED SEMI-ANNUALLY AND PAYMENTS MADE MONTHLY.     *
C     PAYMENTS CAN BE EITHER BLENDED (DEFAULT) OR UNBLENDED            *        
C     IF PAYMENT AMOUNT GIVEN PROGRAM WILL CALCULATE AMORTIZATION      *        
C     PERIOD                                                           *        
C                                                                      *
C***********************************************************************
	IMPLICIT DOUBLE PRECISION (A-H,O-Y)
	DOUBLE INTEGER NAM,NOJOB,NBLNK
      INTEGER TYR,TMO,AYR,AMO,IFRQ1,IFRQ2,NBLND,I,J
	DIMENSION T(8),ZCAL(2),ZINP(2)
      COMMON ZSPA1(2),ZSPA2(2),ZSPA3(2),ZTIME(3),NAM(3),AMTMRT,RAT1
      COMMON IFRQ1,NBLND,IFRQ2,PAYAMT,TYR,TMO,AYR,AMO,NOJOB,RATE2
	COMMON ZPAY(2)
C
C  ARRAY CONTAINING FIGURES FOR FREQUENCY                                       
	DATA T(1),T(2),T(3),T(4)/12.0D00,4.0D00,2.0D00,1.0D00/
	DATA T(5),T(6),T(7),T(8)/52.0D00,26.0D00,24.0D00,13.0D00/
C
	DATA NBLNK,DZER0/'     ',1.0D+09/
      DATA ZCAL(1),ZCAL(2)/'CALCU','LATED'/
      DATA ZINP(1),ZINP(2)/'INPUT','     '/
C
C  INITIALIZE JOB NUMBER AT 100                                                 
	CALL TTON
      NOJOB = 100
      IFRST=0
C
C  SUBROUTINE TO TEST DAT SWITCH. IF SWITCH = 1 INPUT COMES FROM                
C  CONVERSATIONAL VT05. IF NOT INPUT READ FROM CARDS                            
      CALL DATSW(17,ISW)
900   IF(ISW.EQ.1)GO TO 500
C
C  READ STATEMENT FOR CARD INPUT CONTAINS USER NAME, AMOUNT OF MORTGAGE,        
C    RATE OF INTEREST (PERCENT), WHEN INTEREST CALCULATED, PAYMENT TYPE,        
C    FREQUENCY OF PAYMENTS, PAYMENT AMOUNT, TERM PERIOD, AMORTIZATION           
C    PERIOD                                                                     
510   READ(5,600,END=999)(NAM(I),I=1,3),AMTMRT,RAT1,IFRQ1,NBLND,
     1IFRQ2,PAYAMT,TYR,TMO,AYR,AMO
	PAYAMT=PAYAMT*100.
600   FORMAT(3A5,D12.2,D5.2,3I1,D9.2,4I2)
C  IF TERM PERIOD NOT ENTERED ASSUMED TO BE SAME AS AMORTIZATION PERIOD         
      IF(TYR.NE.0) GO TO 650
      TYR=AYR
      TMO=AMO
	GO TO 650
C
C  QUESTIONS ASKED CONVERSATIONALLY                                             
500   IF(IFRST.EQ.1)GO TO 530
C  MAKE DOUBLELY SURE INPUT NOT COMING FROM CARDS (ONLY ASKED ONCE)             
C  BLEEP TO ATTRACT ATTENTION                                                   
      IFRST = 1
      WRITE(4,300)
300   FORMAT(' ARE YOU SURE YOU WANT CONVERSATIONAL INPUT?',30X)
      READ(4,310)ZANS
310   FORMAT(A1)
      IF(ZANS.EQ.1HN)GO TO 510
C
C  REQUESTING USER NAME FOR ID. PURPOSES (15-CHARACTERS)                        
530   WRITE(4,320)
320   FORMAT(' NAME PLEASE, 15 CHARACTERS (CR TO END PROGRAM)')
      READ(4,330)(NAM(I),I=1,3)
330   FORMAT(3A5)
C  BLANK NAME FIELD SIGNALS END OF PROGRAM                                      
      IF(NAM(1).EQ.NBLNK) CALL EXIT
C
      WRITE(4,340)
340   FORMAT(' ENTER AMOUNT OF MORTGAGE')
      READ(4,)AMTMRT
C
      WRITE(4,360)
360   FORMAT(' WHAT IS INTEREST RATE? (IN PERCENT)')
	READ(4,)RAT1
C
      WRITE(4,370)
370   FORMAT(' DO YOU WANT INTEREST CALCULATED:   1) MONTHLY'/36X,'2) QU
     1ARTERLY'/36X,'3) SEMI ANNUALLY (DEFAULT)'/36X,'4) ANNUALLY'/36X,'5
     2) WEEKLY'/36X,'6) BI-WEEKLY'/36X,'7) SEMI-MONTHLY'/36X,'8) 13 PERI
     3ODS/YEAR')
      READ(4,380)IFRQ1
380   FORMAT(I1)
C
      WRITE(4,390)
390   FORMAT(' ARE PAYMENTS: 1) BLENDED (DEFAULT)'/15X,'2) NONBLENDED')
      READ(4,380)NBLND
C
      WRITE(4,400)
400   FORMAT(' HOW OFTEN ARE PAYMENTS MADE:   1) MONTHLY (DEFAULT)'/32X,
     1'2) QUARTERLY'/32X,'3) SEMI ANNUALLY'/32X,'4) ANNUALLY'/32X,'5) WE
     2EKLY'/32X,'6) BI-WEEKLY',/32X,'7) SEMI-MONTHLY'/32X,'8) 13 PERIODS
     3/YEAR')
      READ(4,380)IFRQ2
C
      WRITE(4,410)
410   FORMAT(' ENTER PAYMENT AMOUNT (IF PAYMENTS NONBLENDED MUST SPECIFY
     1)'/22X,'(TO BE USED AS PRNICIPAL PAYMENT)'/22X,'INCLUDE DECIMAL')
      READ(4,420)PAYAMT
420   FORMAT(D9.2)
C  CHANGE PAYMENT AMOUNT TO CENTS
	PAYAMT=PAYAMT*100.
C                                                                               
      WRITE(4,425)                                                              
425   FORMAT(' WHAT IS TERM PERIOD?'//5X,'YEARS')                               
      READ(4,430)TYR                                                            
430   FORMAT(I2)                                                                
      WRITE(4,435)                                                              
435   FORMAT(5X,'MONTHS')                                                       
      READ(4,430)TMO                                                            
C                                                                               
      WRITE(4,440)                                                              
440   FORMAT(' WHAT IS  AMORTIZATION PERIOD?'//5X,'YEARS')                      
      READ(4,430)AYR                                                            
      WRITE(4,435)                                                              
      READ(4,430)AMO                                                            
C
C  END OF QUESTIONS
455   WRITE(4,460)
460   FORMAT(' THANK YOU')
C                                                                               
C  SETS TERM PERIOD EQUAL TO AMORTIZATION PERIOD
	IF(TYR.NE.0) GO TO 650
	TYR=AYR
	TMO=AMO
C  RESET END OF TERM SWITCH
650   SWEND=0
C  SUBROUTINE TO EDIT VALUES REPLACING WITH DEFAULTS IF NEEDED
      CALL EDIT(IFRQ1,NBLND,IFRQ2)
C  INCREMENT JOB NUMBER                                                         
      NOJOB=NOJOB+1
C  I,J ARE SUBSCRIPTS FOR ARRAY OF FREQUENCY FIGURES                            
	I=IFRQ1
	J=IFRQ2
C  CHANGE INTEREST RATE FROM PERCENTAGE TO DECIMAL                              
	RATE=RAT1/100.
C  FORMULA TO CALCULATE INTEREST PAYMENT FACTOR                                 
	RATE2=(((1.+(RATE/T(I)))**(T(I)/T(J)))-1.)
C
      IF(NBLND.EQ.1) GO TO 190
C  SUBROUTINE CALCULATING NONBLENDED PAYMENTS
	PRNPAY=PAYAMT
      CALL UNBLND(PRNPAY,T(J))
C  FORM FEED
      WRITE(6,1)
C  TEST FOR INPUT COMING FROM CARDS
      IF(ZANS.EQ.1HN) GO TO 510
      GO TO 900
C                                                                               
C  SETS UP MESSAGE THAT PAYMENT IS EITHER INPUT OR CALCULATED                   
190   IF(PAYAMT.EQ.0.0) GO TO 200
      ZPAY(1) = ZINP(1)
      ZPAY(2) = ZINP(2)
      AYR = 999
      GO TO 210
200   ZPAY(1) = ZCAL(1)
      ZPAY(2) = ZCAL(2)
C
C  CHANGES AMOUNT OF MORTGAGE TO PENNIES AND CALCULATES PAYMENT AMOUNT          
	PRNC=AMTMRT*100
      PAYAMT=((PRNC*RATE2*((1.+RATE2)**(AYR*T(J))))/(((1.+RATE2)**
     1(AYR*T(J)))-1.))
C  ALWAYS ROUNDS PAYMENT AMOUNT UPWARDS
	PAYAMT=WHOLE(1.0*PAYAMT+.9999999)
C  SUBROUTINE TO PRINT COVER PAGE                                               
      CALL COVR
C
C  OUTPUT AMORTIZATION TABLE
C  WRITE HEADER LINES                                                           
      WRITE(6,100)
100   FORMAT('1',6X,'PAYMENT',16X,'INTEREST',12X,'INTEREST PAID',10X,
     1'PRINCIPAL',11X,'PRINCIPAL PAID',12X,'BALANCE')
      WRITE(6,110)
110   FORMAT(8X,'NUMBER',39X,'TO-DATE',14X,'PAYMENT',15X,'TO-DATE',
     114X,'OUTSTANDING'//)
C
C  CALCULATE NUMBER OF PAYMENTS                                                 
	NOPER=AYR*T(J)
C  INITIALIZE FIELDS AND COUNTERS, CHANGE BALANCE OUTSTANDING TO PENNIES        
	PTDINT=0.0
	PRNPTD=0.0
	BALOUT=AMTMRT*100.
	ILNCNT=0
C  CHANGING TERM PERIOD INTO MONTHS
      NOMON=TYR*12+TMO
C  CALCULATES WHICH PAYMENT IS END OF TERM
      CALL NOEND(NOMON,J,NEND)
C  LOOP EXECUTED 'NUMBER OF PAYMENT' TIMES
      DO 50 NOPAY=1,NOPER
C  CALCULATIONS FOR AMORTIZATION TABLE                                          
	AINT=BALOUT*RATE2
	IF(NOPER.EQ.NOPAY) PAYAMT=BALOUT+AINT
C  HALF ROUNDS AMOUNT OF INTEREST
	AINT=WHOLE(1.0*AINT+.5)
	PTDINT=PTDINT+AINT
C  COMPARING NUMBER OF PAYMENTS TO END OF TERM NUMBER
	IF(NOPAY.LT.NEND) GO TO 112
C  SETTING FINAL PAYMENT LINE FOR END OF TERM PAYMENT
	SWEND=1
	PRNPAY=BALOUT
	PRNPTD=AMTMRT*100.
	BALOUT=0.0
	GO TO 115
C  REGULAR CALCULATIONS
112   PRNPAY=PAYAMT-AINT
	PRNPTD=PRNPTD+PRNPAY
	BALOUT=BALOUT-PRNPAY
C  TO AVOID A NEGATIVE ZERO                                                     
      IF(BALOUT.LT.0.00) BALOUT=ABS(BALOUT)
C  TESTS LINE COUNTER NEW PAGE AFTER 50 PAYMENTS                                
115   ILNCNT=ILNCNT+1
      IF(ILNCNT.LE.50) GO TO 117
      ILNCNT = 1
C  HEADER LINES                                                                 
      WRITE(6,100)
      WRITE(6,110)
C
C  CHANGES ALL VALUES FROM PENNIES TO DOLLARS                                   
117   QAINT=AINT/100.
      QPTDIN=PTDINT/100.
      QPRNPA=PRNPAY/100.
      QPRNPT=PRNPTD/100.
      QBALOU=BALOUT/100.
C  PRINT LINE OF AMORTIZATION TABLE                                             
      WRITE(6,120)NOPAY,QAINT,QPTDIN,QPRNPA,QPRNPT,QBALOU
120   FORMAT(9X,I3,15X,'$',F10.2,11X,'$',F11.2,10X,'$',F10.2,11X,'$',
     1F12.2,9X,'$',F12.2)
	IF(SWEND.EQ.1) GO TO 799
50    CONTINUE
799   WRITE(6,113)                                                              
113   FORMAT(/'   END OF TERM'/)                                                
C
C  CALCULATE AND PRINT FINAL PAYMENT                                            
800   ZFPAY=(PRNPAY+AINT)/100.
850   WRITE(6,860)ZFPAY
860   FORMAT(//5X,'FINAL PAYMENT  ',F11.2)
C  FORM FEED
205   WRITE(6,1)
1     FORMAT('1')
C  TEST FOR INPUT COMING FROM CARDS                                             
	IF(ZANS.EQ.1HN) GO TO 510
      GO TO 900
C
C
C  THIS SECTION IS EXECUTED ONLY IF PAYMENT AMOUNT IS SPECIFIED BY
C  THE USER
210   CALL COVR
	ILNCNT=0
C  INITIALIZE COUNTERS AND FIELDS AND PRINT HEADER LINES                        
      AYR=0
      NOPAY=0
      WRITE(6,100)
      WRITE(6,110)
      PTDINT=0.0
      PRNPTD=0.0
      BALOUT=AMTMRT*100.
C  COUNTS NUMBER OF PAYMENTS                                                    
215   NOPAY=NOPAY+1
C  CALCULATIONS FOR AMORTIZATION TABLE                                          
217   AINT=BALOUT*RATE2
	AINT=WHOLE(1.0*AINT+.5)
      PTDINT=PTDINT+AINT
      PRNPAY=PAYAMT-AINT
      PRNPTD=PRNPTD+PRNPAY
      BALOUT=BALOUT-PRNPAY
      IF(BALOUT.GE.0.0) GO TO 219
C  FOR LAST PAYMENT MUST CORRECT FOR OVERCHARGING
C  (BALOUT IS NEGATIVE NUMBER)
	PRNPAY=PRNPAY+BALOUT
	PRNPTD=PRNPTD+BALOUT
	BALOUT=0.0
C  LINE COUNT                                                                   
219   ILNCNT=ILNCNT+1
      IF(ILNCNT.LE.50) GO TO 220
      ILNCNT=1
      WRITE(6,100)
      WRITE(6,110)
C
C  CHANGE VALUES FROM PENNIES TO DOLLARS                                        
220   QAINT=AINT/100.
	QPTDIN=PTDINT/100.
	QPRNPA=PRNPAY/100.
	QPRNPT=PRNPTD/100.
	QBALOU=BALOUT/100.
C  PRINT LINE OF AMORTIZATION TABLE                                             
      WRITE(6,120)NOPAY,QAINT,QPTDIN,QPRNPA,QPRNPT,QBALOU
      IF(BALOUT.GT.0.0) GO TO 215
	PAYAMT=PAYAMT/100.
C  FINAL PAYMENT
	ZFPAY=(PRNPAY+AINT)/100.
	WRITE(6,860)ZFPAY
C
C  PRINT STATEMENT OF AMORTIZATION PERIOD                                       
      WRITE(6,230)AMTMRT,RAT1,PAYAMT
230   FORMAT(//7X,'A MORTGAGE OF ',F12.2,' AT ',F5.2,' PERCENT INTEREST
     1 WITH PAYMENTS OF ',F9.2)
C  SUBROUTINE TO CHANGE NUMBER OF PERIODS TO YEARS AND MONTHS
	CALL AMORT(NOPAY,T(J),AYR,AMO)
      WRITE(6,240)AYR,AMO
240   FORMAT(/62X,'HAS AN AMORTIZATION PERIOD OF ',I2,' YEARS ',I2,' MON
     1THS')
C  FORM FEED
	WRITE(6,1)
C  TEST FOR INPUT COMING FROM CARDS
	IF(ZANS.EQ.1HN) GO TO 510
      GO TO 900
999   CALL EXIT
      END
[\].
MORT@@SRC
      SUBROUTINE MORT(AMT,NOYRS,RATE,IYR,BDBT,AINT,PRNC,ANPAY,EDBT)             
	DOUBLE PRECISION AMT,RATE,BDBT,AINT,PRNC,ANPAY,EDBT
C  AMT   -- AMOUNT OF MORTAGE                                                   
C  NOYRS -- NUMBER OF YEARS OF MORTGAGE                                         
C  RATE  -- PERCENT OF INTEREST                                                 
C  IYR   -- YEAR IN QUESTION                                                    
C  BDBT  -- DEBT AT BEGINNING OF YEAR                                           
C  AINT  -- AMOUNT OF INTEREST                                                  
C  PRNC  -- AMOUNT OF PRINCIPAL                                                 
C  ANPAY -- ANNUAL PAYMENTS                                                     
C  EDBT  -- DEBT AT END OF YEAR                                                 
C                                                                               
C  CALCULATE  ANNUAL PAYMENTS                                                   
      ANPAY=AMT*(RATE/(((1.+RATE)**NOYRS)-1.))*(1.+RATE)**NOYRS                      
C  INITIALIZE DEBT AT END OF YEAR                                               
      EDBT=AMT                                                                  
      DO 10 I=1,IYR                                                             
C  SET DEBT OF NEW YEAR TO THAT AT END OF OLD YEAR                              
      BDBT=EDBT                                                                 
C                                                                               
C  CALCULATE AMOUNT OF INTEREST AND PRINCIPAL ON YEAR IN QUESTION               
      AINT=BDBT*RATE                                                            
      PRNC=ANPAY-AINT                                                           
C  CALCULATE DEBT AT END OF YEAR IN QUESTION                                    
10    EDBT=BDBT-PRNC                                                            
      RETURN                                                                    
      END                                                                       
[\].
MRTST@SRC
	DOUBLE PRECISION AMT,RATE,BDBT,AINT,PRNC,ANPAY,EDBT
C  MAINLINE TO TEST MORT SUBRTN                                                 
5      WRITE(4,1)
1     FORMAT(' INPUT AMT,NOYRS,RATE,IYR',60X)
      READ(4,)AMT,NOYRS,RATE,IYR                                       
	IF(NOYRS.EQ.99) STOP
      CALL MORT(AMT,NOYRS,RATE,IYR,BDBT,AINT,PRNC,ANPAY,EDBT)                   
      WRITE(6,20)AMT,NOYRS,RATE                                                 
20    FORMAT(' THIS IS A ',F13.2,' MORTGAGE FOR ',I2,' YEARS AT ',F6.4,         
     1' INTEREST RATE'//)                                                       
      WRITE(6,30)IYR                                                            
30    FORMAT (' FOR THE ',I2,' YEAR')                                           
      WRITE(6,40)ANPAY,AINT,PRNC                                                
40    FORMAT ('   ANNUAL PAYMENT ',F10.2,'IS INTEREST (',F10.2,                 
     1') + PRINCIPAL (',F10.2,')')                                                   
      WRITE(6,50)BDBT                                                           
50    FORMAT ('   THEREFORE DEBT AT BEGINNING OF YEAR IS ',F13.2,' AND')        
      WRITE(6,60)EDBT                                                           
60    FORMAT ('             DEBT AT END OF YEAR IS       ',F13.2)               
      GO TO 5                                                                   
99    STOP                                                                      
      END                                                                       
[\].
NOEND@SRC
      SUBROUTINE NOEND(NOMON,J,NZEND)
C
C  CALCULATES NUMBER OF PAYMENTS BEFORE END OF TERM
C
      GO TO (10,20,30,40,50,60,70,80),J
C  MONTHLY: NUMBER OF PAYMENTS EQUALS NUMBER OF MONTHS
10    NZEND=NOMON
      RETURN
C  QUARTERLY: NUMBER OF PAYMENTS EQUALS A THIRD NUMBER OF MONTHS
20    NZEND=NOMON/3
      ZEND=NOMON/3
      GO TO 90
C  SEMI-ANNULLLY: NUMBER OF PAYMENTS EQUALS A SIXTH NUMBER OF MONTHS
30    NZEND=NOMON/6
      ZEND=NOMON/6
      GO TO 90
C  ANNUALLY: NUMBER OF PAYMENTS EQUALS A TWELFTH NUMBER OF MONTHS
40    NZEND=NOMON/12
      ZEND=NOMON/12
      GO TO 90
C  WEEKLY: NUMBER OF PAYMENTS EQUALS 52/12 NUMBER OF MONTHS
50    NZEND=NOMON*52/12
      ZEND=NOMON*52/12
      GO TO 90
C  BI-WEEKLY: NUMBER OF PAYMENTS EQUALS 26/12 NUMBER OF MONTHS
60    NZEND=NOMON*26/12
      ZEND=NOMON*26/12
      GO TO 90
C  SEMI-MONTHLY: NUMBER OF PAYMENTS EQUALS TWICE NUMBER OF MONTHS
70    NZEND=NOMON*2
      ZEND=NOMON*2
      GO TO 90
C  13 PERIODS/YEAR: NUMBER OF PAYMENTS EQUALS 13/12 NUMBER OF MONTHS
80    NZEND=NOMON*13/12
      ZEND=NOMON*13/12
C
C  IF NUMBER OF PAYMENTS NOT CALCULATED EVENLY MUST INCREMENT BY ONE
C  TO ALLOW FOR EXTRA FRACTION
90    TEMP=ZEND-NZEND
      IF(TEMP.NE.0.0)NZEND=NZEND+1
      RETURN
      END
[\].
PRTOC@SRC
      SUBROUTINE PRTOC                                                          
      INTEGER TOCPG                                                             
        DIMENSION TOCLN(15),DATE(2)
C
C  INTIALIZE PAGE AND LINE COUNTERS
      TOCPG=0                                                                   
3     TOCPG=TOCPG +1                                                            
      LINCT=2                                                                   
C
C  OUTPUT HEADING
      WRITE(6,5)TOCPG                                                           
5     FORMAT('1',30X,'TABLE OF CONTENTS',21X,'PAGE ',I3)                        
      WRITE(6,7)                                                                
7     FORMAT(//,7X,'SECTION',55X,'PAGE NO',//)                                   
C
C  READ SCRATCH FILE AND OUTPUT TABLE OF CONTENTS
9     READ(2,10,END=50)(TOCLN(II),II=1,14),KNTLN                                      
10    FORMAT(1X,14A5,I3)                                                           
      WRITE(6,10)(TOCLN(II),II=1,14),KNTLN                                      
20    LINCT=LINCT + 2                                                           
      IF (LINCT.GT.50) GO TO 3                                                  
	GO TO 9
C
C  PRINTS RUN DATE ON TABLE OF CONTENTS
50    CALL WATDAY(DATE)
      WRITE(6,55)DATE(1),DATE(2)
55    FORMAT(//'   ISSUE DATE: ',2A5)
C
C  FORM FEED
       WRITE(6,60)
60      FORMAT('1')
      REWIND 2
	RETURN
      END                                                                       
[\].
RREAD@SRC
      SUBROUTINE RREAD (ARAY,STREC,NOELE)                                       
C   ARAY -- NAME OF ARRAY                                                       
      INTEGER STREC                                                             
      DIMENSION  ARAY(1)                                                        
	WRITE(4,20)
20     FORMAT(' SUBRTN RREAD')
      NOLP=NOELE/10                                                             
      IF(10*NOLP.LT.NOELE)     NOLP=NOLP+1                                      
      K=1                                                                       
      KK=K+10-1                                                                 
      DO 10 I=1,NOLP                                                            
      READ(1'STREC) (ARAY(J),J=K,KK)                                            
      STREC=STREC+1                                                             
      K=K+10                                                                    
      KK=K+10-1                                                                 
      IF(KK.GT.NOELE) KK=NOELE                                                  
10    CONTINUE                                                                  
      RETURN                                                                    
      END                                                                       
[\].
RUNMN@SRC
.COVR                                                                           
.SKIP7                                                                          
                       ****   *    *  *****  ****    ******                     
                      *    *  *    *    *    *   *   *                          
                      *       *    *    *    *    *  *                          
                      * ****  *    *    *    *    *  *****                      
                      *    *  *    *    *    *    *  *                          
                      *    *  *    *    *    *   *   *                          
                       ****    ****   *****  ****    ******                     
.SKIP5                                                                          
                                   *****   ****                                 
                                     *    *    *                                
                                     *    *    *                                
                                     *    *    *                                
                                     *    *    *                                
                                     *    *    *                                
                                     *     ****                                 
.SKIP5                                                                          
                     *****   *    *  *     *   ****   ******                    
                     *    *  *    *  **    *  *    *  *                         
                     *    *  *    *  * *   *  *    *  *                         
                     *****   *    *  *  *  *  *    *  ****                      
                     *  *    *    *  *   * *  *    *  *                         
                     *   *   *    *  *    **  *    *  *                         
                     *    *   ****   *     *   ****   *                         
.TITL                        GUIDE TO RUNOF FOR USER                            
.SUBT 1.00  INTRODUCTION                                                        
.SKIP1                                                                          
      THIS PROGRAM PRODUCES AS MANY COPIES AS DESIRED OF A REPORT.              
A TABLE OF CONTENTS CONTAINING ALL SUBTITLES AND THE PAGES UPON WHICH THEY OCCUR
IS ALSO  PRODUCED.                                                              
      THE REPORT IS WRITTEN AND PUNCHED ONTO CARDS AND THEN TRANSFERRED TO DISK.
EACH LINE (RECORD) OF TEXT CAN BE UP TO 80 CHARACTERS LONG.                     
.SKIP3                                                                          
.SUBT 2.00  INTERACTIVE CONVERSATION                                            
.SKIP1                                                                          
      TO EXECUTE THE PROGRAM TYPE IN     E RUNOF.                               
      THE PROGRAM WILL ASK VIA THE DISPLAY SCREEN.                              
.SKIP1                                                                          
               WHAT IS NAME OF FILE                                             
                  (5 CHARACTERS)                                                
.SKIP1                                                                          
      YOU RESPOND WITH A 5 CHARACTER NAME.                                      
      IF THE FILE NAME IS NOT THERE THE PROGRAM WILL STATE                      
.SKIP1                                                                          
               FILE NAME ----- NOT FOUND                                        
.SKIP1                                                                          
               DO YOU WANT TO STOP                                              
.SKIP1                                                                          
      YOU RESPOND 'Y' (YES)  IF YOU WANT TO STOP                                
                  'N' (NO)   IF YOU DO NOT                                      
.SKIP1                                                                          
      IF THE FILE IS FOUND THE PROGRAM WILL ASK                                 
.SKIP1                                                                          
               HOW MANY COPIES DO YOU WANT                                      
.SKIP1                                                                          
      YOU RESPOND WITH AN INTEGER.                                              
      WHEN THE PROGRAM HAS FINISHED WRITING THE REPORT IT WILL ASK              
.SKIP1                                                                          
               DO YOU WANT TO STOP                                              
.SKIP1                                                                          
      YOUR RESPONSE IS AS ABOVE                                                 
.SKIP1                                                                          
      IN THIS WAY DIFFERENT REPORTS CAN BE RUNOFF WITHOUT CONTROL RETURNING     
      TO THE MONITOR.                                                           
.EJEC                                                                           
.SUBT 2.00  SYNTAX COMMANDS                                                     
.SKIP1                                                                          
      THERE ARE 6 SYNTAX COMMANDS -- .COVR, .TITL, .SUBT, .EJEC, .SKIP, .END    
.SKIP1                                                                          
   1).COVR                                                                      
      THIS WILL PRODUCE A COVER PAGE FOR THE REPORT FROM THE DATA THAT FOLLOWS. 
            CC 1    6                                                           
      FORMAT   .COVR                                                            
   2).TITL                                                                      
      THIS IS THE MAIN TITLE THAT WILL APPEAR ON THE HEAD OF EVERY PAGE.        
      ALL COMMANDS ARE OPTIONAL EXCEPT .TITL.  IT SIGNIFIES THE END OF THE      
      COVER PAGE DATA.  THIS COMMAND IS NEEDED EVEN THOUGH THERE IS NO TITLE    
      OR COVER PAGE.  CENTERING FOR THE HEADING MUST BE DONE BY THE USER.       
            CC 1    6                70                                         
      FORMAT   .TITLXXXXXXXXXXXXXXXXXX                                          
.SKIP1                                                                          
   3).SUBT                                                                      
      THESE ARE THE SUBTITLES THAT APPEAR THRU OUT THE TEXT AND ARE PRINTED     
      ON A TABLE OF CONTENTS.                                                   
            CC 1    6                75                                         
      FORMAT   .SUBTXXXXXXXXXXXXXXXXXX                                          
.SKIP1                                                                          
   4).EJEC                                                                      
      THIS WILL CAUSE THE PRINTER TO SKIP TO A NEW PAGE BEFORE MAXIMUM NUMBER   
      OF LINES IS REACHED (NATURAL END OF PAGE)                                 
            CC 1    6                                                           
      FORMAT   .EJEC                                                            
   5).SKIP                                                                      
      THIS TELLS THE PRINTER TO SKIP  N  BLANK LINES WHERE  N  IS AN INTEGER    
      FROM 1 TO 9.                                                              
            CC 1    6                                                           
      FORMAT   .SKIPN                                                           
.SKIP1                                                                          
   6).END                                                                       
      THIS COMMAND IS OPTIONAL.  IT CAN BE USED TO TERMINATE THE PRINTING OF THE
      REPORT ANYWHERE DESIRED.                                                  
            CC 1    6                                                           
      FORMAT   .END                                                             
.TITL                   GUIDE TO RUNOF FOR KEYPUNCH                             
.SKIP1                                                                          
      THERE ARE 6 COMMANDS THAT ARE USED WHEN PUNCHING A REPORT, MANUAL, ETC.   
      TO BE PRINTED WITH THE RUNOF PROGRAM.  ALL COMMANDS BEGIN IN CARD         
      COLUMN 1.                                                                 
.SKIP1                                                                          
      1)  .COVR                                                                 
.SKIP1                                                                          
          THIS COMMAND IS OPTIONAL AND SIGNALS THAT THE CARDS FOLLOWING WILL    
          PRINT THE COVER PAGE.  THE COVER PAGE ROUTINE USES THE .SKIP COMMAND  
          TO SKIP BLANK LINES.  A .TITL CARD MUST FOLLOW THE LAST COVER PAGE    
          CARD.                                                                 
               CC 1    6                                                        
          FORMAT  .COVR                                                         
.SKIP1                                                                          
      2)  .TITL                                                                 
.SKIP1                                                                          
          THIS COMMAND IS MANDATORY WHETHER OR NOT A COVER PAGE OR A TITLE      
          IS PRESENT.  THE TITLE CANNOT BE MORE THAN 65 CHARACTERS LONG.        
          CENTERING THE TITLE MUST BE DONE MANUALLY.                            
               CC 1    6                     70                                 
          FORMAT  .TITLXXXXXXXXXXXXXXXXXXXXXXXX                                 
.SKIP1                                                                          
      3)  .SUBT                                                                 
.SKIP1                                                                          
          THIS COMMAND IS OPTIONAL.  IT MEANS THAT THE REMAINING DATA ON        
          THE CARD IS A SUBTITLE.  IF THE SUBTITLE IS TO BE UNDERLINED THEN     
          THE DASHES MUST LINE UP WITH THE PART TO BE UNDERLINED.               
               CC 1    6                     80                                 
          FORMAT  .SUBTXXXXXXXXXXXXXXXXXXXXXXXX                                 
.SKIP1                                                                          
      4)  .SKIPN                                                                
.SKIP1                                                                          
          THIS COMMAND IS OPTIONAL.  IT CAUSES THE PRINTER TO SKIP N NUMBER OF  
          BLANK LINES WHERE N IS A VALUE BETWEEN 1 AND 9.  THERE CAN BE         
          AN UNLIMITED NUMBER OF .SKIP CARDS SO THERE CAN BE MORE THAN          
          9 BLANK LINES.                                                        
               CC 1    6                                                        
          FORMAT  .SKIPN                                                        
.SKIP1                                                                          
      5)  .EJEC                                                                 
.SKIP1                                                                          
          THIS COMMAND IS OPTIONAL.  IT CAUSES THE PRINTER TO SKIP TO A NEW     
          PAGE BEFORE THE NATURAL END OF A PAGE.                                
               CC 1    6                                                        
          FORMAT  .EJEC                                                         
.SKIP1                                                                          
      6)  .END                                                                  
.SKIP1                                                                          
          THIS COMMAND IS OPTIONAL.  IT SIGNALS THE END OF THE DATA.            
               CC 1    6                                                        
          FORMAT  .END                                                          
[\].
RUNOF@SRC
C  TITLE          RUNOF
C  DATE CREATED  SEPT, 1973
C  ANALYST        LIZ LUCIANI
C  
C  DAT/SLOT ASG.  RK/DT 1
C                 RK 2
C                 LT 4
C                 LP 6
C
C  USES ROUTINES TOC
C                PRTOC
C                COVRTN
C
       REAL NAME,INDEX
      DIMENSION NAME(2),        INDEX(2)                                        
      COMMON REC(16),IFRST,SUB
      DATA NAME(2)/' SRC'/
	DATA END/'.END '/
      DATA INDEX/'INDEX',' SRC'/                                                
      IFRST=0
C  ASK FOR NAME OF FILE                                                         
5     WRITE(4,10)                                                               
10    FORMAT (' WHAT IS NAME OF FILE ?'/'  (5 CHARACTERS)')
      READ(4,20) NAME(1)                                                        
20    FORMAT (A5)                                                               
C                                                                               
C  SEARCH FOR FILE NAME                                                         
      CALL FSTAT(1,NAME,I)                                                      
      IF (I.NE.0) GO TO 50                                                      
      WRITE(4,25) NAME(1)                                                       
25    FORMAT (' FILE NAME  ',A5,'  NOT FOUND')                                
30    WRITE(4,35)                                                               
35    FORMAT(' DO YOU WANT TO STOP ?')                                       
      READ(4,20) QUEST                                                          
      IF (QUEST.EQ.1HY  ) GO TO 110                                               
      GO TO 5                                                                   
C                                                                               
C  ASK FOR NUMBER OF COPIES                                                     
50    WRITE(4,60)                                                               
60    FORMAT (' HOW MANY COPIES DO YOU WANT ?')                               
      READ(4,)NUM                                                               
C  OPEN FILES                                                                   
      CALL SEEK (1,NAME)                                                        
      CALL ENTER (2,INDEX)                                                      
C
C  DO LOOP TO OUTPUT REQUESTED NUMBER OF COPIES
      DO 100 I=1,NUM                                                            
      IF(IFRST.EQ.2) CALL SEEK(1,NAME)
63    IFRST=1                                                                   
C
C  READ IN RECORD
65    READ(1,70,END=99)(REC(II),II=1,16)                                        
70    FORMAT (16A5)                                                             
C
C  TEST FOR .END
	IF(REC(1).EQ.END) GO TO 99
C  CALL SUBROUTINE TO WRITE INFORMATION ON INDEX                                
C  AND OUTPUT REPORT
      CALL TOC                                                                  
      GO TO 65                                                                  
99    CALL CLOSE(1)
      REWIND 2
C 
C  SUBROUTINE TO PRINT TABLE OF CONTENTS (INDEX)
      CALL PRTOC                                                                
100   CONTINUE                                                                  
      GO TO 30                                                                  
C 
110   CALL CLOSE(2)
C  DELETE SCRATCH FILE INDEX
      CALL DLETE(2,INDEX,I)                                                     
      IF (I.NE.0) STOP                                                          
      WRITE(4,120)                                                              
120   FORMAT(' ','ERROR IN DELETING FILE')                                      
      STOP                                                                      
      END                                                                       
[\].
RWRIT@SRC
      SUBROUTINE RWRIT (ARAY,STREC,NOELE)                                       
C   ARAY -- NAME OF ARRAY                                                       
      INTEGER STREC                                                             
      DIMENSION  ARAY(1)                                                        
	WRITE(4,20)
20     FORMAT (' SUBRTN RWRIT')
      NOLP=NOELE/10                                                             
      IF(10*NOLP.LT.NOELE)     NOLP=NOLP+1                                      
      K=1                                                                       
      KK=K+10-1                                                                 
      DO 10 I=1,NOLP                                                            
      WRITE(1'STREC) (ARAY(J),J=K,KK)                                           
      STREC=STREC+1                                                             
      K=K+10                                                                    
      KK=K+10-1                                                                 
      IF(KK.GT.NOELE) KK=NOELE                                                  
10    CONTINUE                                                                  
      RETURN                                                                    
      END                                                                       
[\].
STEST@SRC
      DIMENSION IA(60),IB(60),C(60),D(60),IC(60),F(60)                                
      DATA IA,IB,C,D/60*2,60*4,60*1.0,60*3.0/                                   
C  MAINLINE TESTING SUBRTN TO READ & WRITE INTEGER & REAL                       
C  DISC FILES                                                                   
	WRITE(4,20)
20     FORMAT (' CALLING DEFINE')
      CALL DEFINE(1,20,120,0,IAU,0,0,1)                                         
	WRITE(6,)IA
      CALL IWRIT(IA,1,60)
      CALL IREAD(IC,1,60)                                                       
      WRITE(6,)IC                                                               
	STOP 6
      CALL IWRIT(IB,1,60)                                                       
      CALL IREAD(IC,1,60)                                                       
      WRITE(6,)IC                                                               
      CALL RWRIT(C,61,60)                                                       
      CALL RREAD(F,61,60)                                                       
      WRITE(6,)F                                                                
      CALL RWRIT(D,61,60)                                                       
      CALL RREAD(F,61,60)                                                       
      WRITE(6,)F                                                                
	ENDFILE 1
	STOP
      END                                                                       
[\].
TOC@@@SRC
      SUBROUTINE TOC                                                            
      INTEGER RPLIN,PGCT
      DIMENSION RPTHD(16)                                                       
      COMMON TOCLN(16),IFRST,SUB
       DATA RPLIN/0/,DASH/'-----'/
	DATA TITL/'.TITL'/,EJEC/'.EJEC'/,SUBT/'.SUBT'/
	DATA SKIP/'.SKIP'/,COVR/'.COVR'/
C  TEST FOR .COVR                                                               
      IF(TOCLN(1).NE.COVR) GO TO 9                                              
      CALL COVRTN                                                               
      GO TO 10                                                                  
C  TEST FOR .TITL                                                               
9     IF (TOCLN(1).EQ.TITL)  GO TO 10                                             
C  TEST FOR .SUBT                                                               
      IF (TOCLN(1).EQ.SUBT)  GO TO 20                                             
C  TEST FOR .EJEC
      IF (TOCLN(1).EQ.EJEC)  GO TO 30                                             
C  TEST FOR .SKIP                                                               
      IF (TOCLN(1).EQ.SKIP)  GO TO 40                                             
C 
C  ASSUME RECORD DOES NOT CONTAIN SYNTAX COMMAND 
C  THEREFORE MUST BE LINE OF REPORT
C
C  CHECK FOR AND REALIGN UNDERLINING OF SUBTITLE
      IF(SUB.NE.1) GO TO 60
      SUB=0
C  #55 OCTAL EQUIVALENT OF DASH (-)
      DO 98 J=1,16
      IF(TOCLN(J)[14:20].EQ.#55) GO TO 99
98    CONTINUE
      GO TO 60
99    DO 100 I=2,16
100   TOCLN(I-1)=TOCLN(I)
	GOTO 60
C
C  SET PAGE AND LINE COUNT TO ZERO, STORE THE PAGE HEADING
10    PGCT = 0                                                                  
      RPLIN=0                                                                   
      IFRST=1
      DO 13 I=2,14                                                              
13    RPTHD(I-1) = TOCLN(I)                                                       
      GO TO 50                                                                  
C 
C  WRITE SUBTITLE ON SCRATCH FILE
20    WRITE(2,25)(TOCLN(II),II=2,15),PGCT                                       
25    FORMAT(' ',14A5,I3)
	DO 27 JJ=2,16
27     TOCLN(JJ-1)=TOCLN(JJ)
      SUB=1
	GO TO 60
C
C  RESET LINE COUNTER TO EJECT PAGE
30     IFRST=1
	RPLIN=0
	GO TO 50
C
C  STRIP NUMBER OFF .SKIP COMMAND 
C  (-48 IS FUDGE FACTOR TO TRANSFORM NUMBER FROM
C  OCTAL TO DECIMAL)
40     NOLIN=TOCLN(2)[0:6]-48
      RPLIN=RPLIN + NOLIN                                                       
      IF (RPLIN.GT.50) GO TO 30                                                 
C 
C  SKIP REQUESTED NUMBER OF LINES
      DO 45 M=1,NOLIN                                                           
      WRITE(6,43)                                                               
43    FORMAT (1X)                                                               
45    CONTINUE                                                                  
      RETURN                                                                    
C
C  WRITE PAGE HEADER
50    PGCT=PGCT + 1                                                             
      WRITE(6,55)(RPTHD(II),II=1,13),PGCT                                       
55    FORMAT('1',5X,13A5,5X,'PAGE ',I3,//)                                         
      IF (IFRST.EQ.1) GO TO 70                                                  
      RPLIN=0                                                                   
C
C  WRITE LINE ON REPORT
60    RPLIN=RPLIN + 1                                                           
      IF (RPLIN.GT.50) GO TO 50                                                 
      WRITE(6,65)(TOCLN(II),II=1,16)                                            
65    FORMAT(' ',5X,16A5)                                                      
70    IFRST=2                                                                   
      RETURN                                                                    
      END                                                                       
[\].
UNBLNDSRC
      SUBROUTINE UNBLND(PRNPAY,TJ)
C
C  CALCULATES AND OUTPUTS AMORTIZATION TABLE WITH NONBLENDED PAYMENTS
C
      IMPLICIT DOUBLE PRECISION (A-H,O-Y)
	DOUBLE INTEGER NAM,NOJOB
      INTEGER AYR,AMO,TYR,TMO
      COMMON ZSPA1(2),ZSPA2(2),ZSPA3(2),ZTIME(3),NAM(3),AMTMRT,RAT1
      COMMON IFRQ1,NBLND,IFRQ2,PAYAMT,TYR,TMO,AYR,AMO,NOJOB,RATE2
      COMMON ZPAY(2)
	DATA ZPAY1,ZPAY2/'SEE T','ABLE '/
	ZPAY(1)=ZPAY1
	ZPAY(2)=ZPAY2
C
C  CHECK FOR VALID PRINCIPAL PAYMENT
      IF(PRNPAY.GT.0.0) GO TO 10
	WRITE(4,200)
      WRITE(6,200)
200   FORMAT('1'//' SORRY, AMORTIZATION TABLE CANNOT BE COMPUTED BECAUSE
     1OF INVALID PRINCIPAL PAYMENT.'/31X,'PLEASE CHECK PAYMENT AMOUNT FI
     2ELD ON INPUT RECORD.')
      RETURN
C
C  CALCULATE NUMBER OF PAYMENT PERIODS
C  MUST CHECK FOR EVEN DIVISION IF NOT ADD 1 TO NUMBER OF PAYMENT PERIOD
C  TO ALLOW FOR LAST PAYMENT
10    NOPER=(AMTMRT*100)/PRNPAY
      NUM = NOPER*PRNPAY/100
      IF(NUM.NE.AMTMRT) NOPER=NOPER+1
C
C  CALCULATE AMORTIZATION PERIOD
	CALL AMORT(NOPER,TJ,AYR,AMO)
	PAYAMT=0.0
C
C  PRINT COVER PAGE
      CALL COVR
C
C  PRINT HEADERS
      WRITE(6,210)
210   FORMAT('1',6X,'PAYMENT',11X,'INTEREST',8X,'INTEREST PAID',8X,'PRIN
     1CIPAL',8X,'PRINCIPAL PAID',9X,'TOTAL',13X,'BALANCE')
      WRITE(6,220)
220   FORMAT(7X,'NUMBER',31X,'TO-DATE',12X,'PAYMENT',12X,'TO-DATE',12X,
     1'PAYMENT',10X,'OUTSTANDING'//)
C  INITIALIZE COUNTERS AND FIELDS
C  CHANGE TO PENNIES
      BALOUT=AMTMRT*100
      PTDINT=0.0
      PRNPTD=0.0
      ILNCNT=0
C  LOOP EXCECUTED 'NUMBER OF PAYMENT' TIMES
      DO 100 NOPAY=1,NOPER
C  COMPUTE AMOUNT OF INTEREST
      AINT=BALOUT*RATE2
      AINT=WHOLE(1.0*AINT+.5)
C  INTEREST PAID-TO-DATE
      PTDINT=PTDINT+AINT
C  PAYMENT AMOUNT
      PAYAMT=AINT+PRNPAY
C  PRINCIPAL PAID-TO-DATE
      PRNPTD=PRNPTD+PRNPAY
C  BALANCE OUTSTANDING
      BALOUT=BALOUT-PRNPAY
      IF(BALOUT.GE.0.0) GO TO 120
C  LAST PAYMENT CORRECTS FOR ANY OVERPAYMENT
	PAYAMT=PAYAMT+BALOUT
	PRNPAY=PRNPAY+BALOUT
	PRNPTD=PRNPTD+BALOUT
	BALOUT=0.0
C  SETTING & TESTING LINE COUNT
120   ILNCNT=ILNCNT+1
      IF(ILNCNT.LE.50)GO TO 300
      ILNCNT=1
C  WRITE HEADERS ON NEW PAGE
      WRITE(6,210)
      WRITE(6,220)
C  CHANGE ALL AMOUNTS FROM PENNIES TO DOLLARS
300   QAINT=AINT/100
      QPTDIN=PTDINT/100
      QPRNPA=PRNPAY/100
      QPRNPT=PRNPTD/100
      QPAYAM=PAYAMT/100
      QBALOU=BALOUT/100
C  PRINT LINE OF TABLE
      WRITE(6,230)NOPAY,QAINT,QPTDIN,QPRNPA,QPRNPT,QPAYAM,QBALOU
230   FORMAT(9X,I3,10X,'$',F10.2,7X,'$',F11.2,8X,'$',F10.2,8X,'$',F12.2,
     16X,'$',F11.2,6X,'$',F12.2)
100   CONTINUE
C  PRINT FINAL PAYMENT
      ZFPAY=(PRNPAY+AINT)/100
      WRITE(6,860)ZFPAY
860   FORMAT(/15X,'FINAL PAYMENT  ',F11.2)
      RETURN
      END
[\].
UNPAK@SRC
	.GLOBL	UNPAK,.DA
UNPAK	0
	JMS*	.DA
	JMP	.+1+2
WORD	0
C1	0
	LAC*	WORD
	DAC	W1#	/SAVE FIRST WORD
	ISZ	WORD	/AND SECORD WORD
	LAC*	WORD
	DAC	W2#	/SAVE SECOND WORD
	LAC*	C1	/GET ADDRESS OF FIRST WORD OF ARRAY
	DAC	RET#
	LAC	W1
	AND	(774000	/MASK OFF FIRST 7 BITS
	XOR	(1004	/ADD SPACES
	DAC*	RET	/FIRST CHAR.
	ISZ	RET	/BUMP ADDRESS
	IAC
	LAC	(20100
	DAC*	RET	/INSERT SPACES IN SECOND WORD
	ISZ	RET
	LAC	W1
	AND	(003760	/MASK OFF SECOND 7
	RCL
	.REPT	3	/ROTATE 7 LEFT
	RTL
	XOR	(1004
	DAC*	RET	/SECOND CHAR.
	ISZ	RET
	LAC	(20100
	DAC*	RET
	ISZ	RET
	LAC	W1
	AND	(17	/MASK OFF HALF OFF THIRD
	CLL
	.REPT	7	/SHIFT 14 LEFT
	RTL
	DAC	TEMP#	/SAVE THIS
	LAC	W2
	AND	(700000	/MASK OFF LEFT 3 BITS
	CLL
	RTR
	RTR		/SHIFT 3 RIGHT
	XOR	TEMP	/COMBINE WITH FIRST 4 BITS
	XOR	(1004
	DAC*	RET	/THIRD CHAR.
	ISZ	RET
	LAC	(20100
	DAC*	RET
	ISZ	RET
	LAC	W2
	AND	(077400	/MASK OFF NEXT 7
	RCL
	RTL		/SHIFT 3 LEFT
	XOR	(1004
	DAC*	RET	/FOURTH CHAR.
	ISZ	RET
	LAC	(20100
	DAC*	RET
	ISZ	RET
	LAC	W2
	AND	(376	/MASK OFF LAST 7 (LESS 1)
	.REPT	5
	RTL		/SHIFT 10 LEFT
	XOR	(1004
	DAC*	RET	/FIFTH CHAR.
	ISZ	RET
	LAC	(20100
	DAC*	RET
	JMP*	UNPAK
	.END
[\].
WHOLE@SRC
C WHOLE - INTERIM FUNCTION                                                      
      DOUBLE PRECISION FUNCTION WHOLE (X)                                       
	DOUBLE PRECISION TEMP,RY
      DOUBLE INTEGER Y                                                          
C     REAL TO INTEGER                                                           
	Y=X
	RY=Y
	TEMP=X-RY
	WHOLE=X-TEMP
      RETURN                                                                    
      END                                                                       
[\].
