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 [\].