// JOB ITD00010 // DUP ITD00020 *DELETE ITDCL ITD00030 // ASM ITD00040 *LIST ITD00050 *************** ITD00060 * PROGRAM TO INITIALIZE AND CLEAR ITD00070 * THE DISK DATA AREA TO ZERO ITD00080 *************** ITD00090 GO LIBF WRTY0 SPACE TYPEWRITER ITD00100 DC /2000 ITD00110 DC CONTL ITD00120 BSI L ERTYP TYPE BEGINNING ITD00130 DC MSAG1 MESSAGE ITD00140 LDX I1 F1280 ITD00150 LDX I2 F1282 ITD00160 LDD L FZERO CLEAR THE DISK ITD00170 STD L2 WKIO-2 OUTPUT AREA TO ZERO ITD00180 MDX 2 -2 ITD00190 MDX 1 -2 ITD00200 LD L SCBGN INITIALIZE THE ITD00210 STO L WKIO&1 SECTOR NUMBER AND ITD00220 LD L F1280 WORD COUNT ITD00230 STO L WKIO ITD00240 LDD L TRAIL STORE THE TRAILER ITD00250 STD L WKIO&2 RECORD IN THE AREA ITD00260 AGN LIBF DISKN ITD00270 DC /5000 ITD00280 DC WKIO ITD00290 DC ERRS ITD00300 LIBF DISKN CLEAR FOUR SECTORS ITD00310 DC /4000 TO ZERO ON THE DISK ITD00320 DC WKIO EACH TIME THROUGH ITD00330 LIBF DISKN THE LOOP ITD00340 DC /0000 ITD00350 DC WKIO ITD00360 MDX *-4 ITD00370 LDD L FZERO COVER THE TRAILER ITD00380 STD L WKIO&2 RECORD WITH ZEROS ITD00390 LD L WKIO&1 INCREMENT THE ITD00400 A L FOUR SECTOR NUMBER ITD00410 STO L WKIO&1 ITD00420 S L SCEND ITD00430 BSC L AGN,Z& ITD00440 BSI L ERTYP ITD00450 DC MSAG3 ITDCL COMPLETE MESSAGE ITD00460 EXIT ITD00470 ERRS NOP ITD00480 LIBF WRTY0 DISK ERROR MESSAGE ITD00490 DC /2000 ITD00500 DC MSAG5 ITD00510 SRA 16 ITD00520 BSC I ERRS ITD00530 *************** ITD00540 * ERTYP SUBROUTINE ITD00550 *************** ITD00560 ERTYP NOP SUBROUTINE TO ITD00570 LD I ERTYP WRITE MESSAGES ITD00580 STO L ERTX ON THE CONSOLE ITD00590 MDX L ERTYP,+1 TYPEWRITER ITD00600 LD L ERTX ITD00610 S L ONE ITD00620 STO *+1 ITD00630 LD L 0 ITD00640 STO L ERTX+2 ITD00650 M L ONE ITD00660 D L TWO ITD00670 STO L TYPEX ITD00680 LIBF EBPRT ITD00690 DC /0000 ITD00700 ERTX DC 0 ITD00710 DC TYPEX+1 ITD00720 DC 0 ITD00730 LIBF WRTY0 ITD00740 DC /2000 ITD00750 DC TYPEX ITD00760 LIBF WRTY0 ITD00770 DC /2000 ITD00780 DC CONTL ITD00790 LIBF WRTY0 ITD00800 DC /0000 ITD00810 MDX *-3 ITD00820 BSC I ERTYP ITD00830 *************** ITD00840 * DEFINE ERROR MESSAGES ITD00850 *************** ITD00860 DC 16 ITD00870 MSAG1 EBC .ITDCL BEGINNING . ITD00880 DC 16 ITD00890 MSAG3 EBC .ITDCL COMPLETED . ITD00900 MSAG5 DC 20 DISK ERROR MESSAGE ITD00910 DC /3020 ITD00920 DC /9858 ITD00930 DC /2135 ITD00940 DC /6060 ITD00950 DC /5060 ITD00960 DC /2121 ITD00970 DC /9C34 ITD00980 DC /6070 ITD00990 DC /2074 ITD01000 DC /3C9C ITD01010 DC /3421 ITD01020 DC /7C50 ITD01030 DC /1821 ITD01040 DC /3C74 ITD01050 DC /3021 ITD01060 DC /6034 ITD01070 DC /989C ITD01080 DC /3C60 ITD01090 DC /9C21 ITD01100 DC /8103 ITD01110 CONTL DC 1 ITD01120 DC /8103 ITD01130 *************** ITD01140 * DEFINE CONSTANTS ITD01150 *************** ITD01160 SCBGN DC 448 ITD01170 SCEND DC 1255 ITD01180 ONE DC 1 ITD01190 TWO DC 2 ITD01200 FOUR DC 4 ITD01210 F1280 DC 1280 ITD01220 F1282 DC 1282 ITD01230 FZERO DEC 0. ITD01240 TRAIL DEC 9999. ITD01250 *************** ITD01260 * ALLOCATE STORAGE ITD01270 *************** ITD01280 WKIO BSS E 1282 DISK OUTPUT AREA ITD01290 TYPEX BSS E 30 MESSAGE AREA ITD01300 END GO ITD01310 // DUP ITD01320 *STORE WS UA ITDCL ITD01330 // JOB LDR00010 // DUP LDR00020 *DELETE LODAR LDR00030 // ASM LDR00040 *LIST LDR00050 *************** LDR00060 * PROGRAM TO LOAD RANDOM DATA LDR00070 *************** LDR00080 GO LIBF WRTY0 SPACE TYPEWRITER LDR00090 DC /2000 LDR00100 DC CONTL LDR00110 BSI L ERTYP TYPE BEGINNING LDR00120 DC MSAG1 MESSAGE LDR00130 LD L FXD80 LDR00140 STO L INPTA INITIALIZE THE LDR00150 LD L ZERO VARIOUS INDEX LDR00160 STO L COUNT VALUES LDR00170 STX L3 REG3 STORE LIBF TRANS VECTOR LDR00180 LD L ZERO LDR00190 STO L XXCNT LDR00200 *************** LDR00210 LIBF CARD0 READ THE FIRST CARD LDR00220 * LIBF READ0 READ THE FIRST CARD LDR00230 *************** LDR00240 DC /1000 WHICH SPECIFIES THE LDR00250 DC INPTA FORMAT OF THE DATA LDR00260 LD L PLUS CARDS WHICH ARE TO LDR00270 STO L EFORM BE READ IN LDR00280 LD L ZERO LDR00290 STO L EFORM+1 LDR00300 STO L EFORM+2 LDR00310 STO L EFORM+3 LDR00320 *************** LDR00330 LIBF CARD0 LDR00340 * LIBF READ0 TEST READ COMPLETE LDR00350 *************** LDR00360 DC /0000 LDR00370 MDX *-3 LDR00380 LD L INPTA+4 LDR00390 STO L EFORM+4 LDR00400 LD L INPTA+5 LDR00410 STO L EFORM+5 CONVERT THE LDR00420 LIBF DCBIN NUMBER OF RECORDS LDR00430 DC EFORM PER CARD OF DATA LDR00440 STO L RCKD LDR00450 M L FIVE DETERMINE THE LDR00460 D L ONE NUMBER OF COLUMNS LDR00470 A L FIVE OF INFORMATION LDR00480 STO L DUM GIVEN ON THE FIRST LDR00490 LDX I1 DUM CONTROL CARD LDR00500 LDX I2 RCKD LDR00510 CT4 LD L1 INPTA DETERMINE THE TYPE LDR00520 S L LTRE OF INFORMATION LDR00530 BSC L CT1,+- GIVEN IN EACH RECORD LDR00540 LD L1 INPTA ON A SINGLE CARD LDR00550 S L LTRA THIS INFORMATION LDR00560 BSC L CT2,+- CAN BE IN E-FORMAT, LDR00570 LD L ZERO F-FORMAT, OR IN LDR00580 STO L2 TYPE ALPHAMERIC LDR00590 BSC L CT3 LDR00600 CT1 LD L ONE LDR00610 STO L2 TYPE LDR00620 BSC L CT3 LDR00630 CT2 LD L TWO LDR00640 STO L2 TYPE LDR00650 CT3 LD L1 INPTA-1 DETERMINE THE LDR00660 STO L EFORM+5 ENDING COLUMN OF LDR00670 LD L1 INPTA-2 THE VARIOUS LDR00680 STO L EFORM+4 RECORDS ON EACH LDR00690 LIBF DCBIN DATA CARD LDR00700 DC EFORM LDR00710 STO L2 ENCOL LDR00720 LD L1 INPTA-3 DETERMINE THE LDR00730 STO L EFORM+5 BEGINNING COLUMN LDR00740 LD L1 INPTA-4 OF THE VARIOUS LDR00750 STO L EFORM+4 RECORDS ON EACH LDR00760 LIBF DCBIN DATA CARD LDR00770 DC EFORM LDR00780 STO L2 BGCOL LDR00790 MDX 1 -5 LDR00800 MDX 2 -1 LDR00810 MDX *+1 LDR00820 MDX *+2 LDR00830 BSC L CT4 LDR00840 *************** LDR00850 LIBF CARD0 READ THE NEXT LDR00860 * LIBF READ0 READ THE NEXT LDR00870 *************** LDR00880 DC /1000 CONTROL CARD LDR00890 DC INPTA WHICH GIVES THE LDR00900 *************** LDR00910 LIBF CARD0 NUMBER OF THE LDR00920 * LIBF READ0 NUMBER OF THE LDR00930 *************** LDR00940 DC /0000 X RECORD AND THE LDR00950 MDX *-3 NUMBER OF THE LDR00960 LD L INPTA+4 Y RECORD ON EACH LDR00970 STO L EFORM+4 DATA CARD LDR00980 LD L INPTA+5 LDR00990 STO L EFORM+5 LDR01000 LIBF DCBIN LDR01010 DC EFORM LDR01020 STO L XRCKD LDR01030 LD L INPTA+9 LDR01040 STO L EFORM+4 LDR01050 LD L INPTA+10 LDR01060 STO L EFORM+5 LDR01070 LIBF DCBIN LDR01080 DC EFORM LDR01090 STO L YRCKD LDR01100 LD L SCBGN INITIALIZE THE LDR01110 S L ONE SECTOR LOCATION IN LDR01120 STO L SCCNT THE DISK DATA AREA LDR01130 BACK3 LD L ZERO INITIALIZE THE LDR01140 STO L DTINX DATA COUNTS LDR01150 STO L SAVCT LDR01160 MDX L SCCNT,1 LDR01170 BACK2 LDX 1 1 LDR01180 *************** LDR01190 LIBF CARD0 READ THE DATA CARDS LDR01200 * LIBF READ0 READ THE DATA CARDS LDR01210 *************** LDR01220 DC /1000 ONE AT A TIME LDR01230 DC INPTA LDR01240 *************** LDR01250 LIBF CARD0 LDR01260 * LIBF READ0 LDR01270 *************** LDR01280 DC /0000 LDR01290 MDX *-3 LDR01300 LDD L INPTA+1 CHECK FOR THE DATA LDR01310 SD L RKMK TRAILER CARD LDR01320 BSC L IPTFN,+- LDR01330 MDX L COUNT,1 COUNT THE CARDS LDR01340 LD L COUNT LDR01350 S L F1600 LDR01360 BSC L IPTFN,Z- LDR01370 BACK1 LD L1 ENCOL LOCATE THE ENDING LDR01380 STO L BACKX+1 COLUMN OF THIS LDR01390 BACKX LDX L2 0 RECORD LDR01400 MDX 2 1 LDR01410 LD L1 TYPE DETERMINE THE TYPE OF LDR01420 S L ONE LDR01430 BSC L AFOR,-Z DATA FOR THIS RECORD LDR01440 LD L1 ENCOL LDR01450 S L1 BGCOL LDR01460 A L ONE LDR01470 STO L TBLK1+1 LDR01480 TBLK1 LDX L3 0 LDR01490 STX L1 DUM TEST FOR X AND Y FIELD LDR01500 LD L DUM LDR01510 S L XRCKD LDR01520 BSC L TFOR,+- LDR01530 LD L DUM LDR01540 S L YRCKD LDR01550 BSC L TFOR,+- LDR01560 TBLK2 LD L2 INPTA-1 TEST FOR BLANK FIELD LDR01570 BSC L TBLK3,Z LDR01580 MDX 2 -1 LDR01590 MDX 3 -1 LDR01600 MDX TBLK2 LDR01610 LDD L ZNIL THE FIELD IS BLANK, SET LDR01620 STD L BINFL VALUE TO NIL CODE LDR01630 BSC L CT6-2 LDR01640 TBLK3 LDX I2 BACKX+1 RRELOAD IR2 FOR CARD FIELD LDR01650 MDX 2 1 LOCATION LDR01660 TFOR LD L1 TYPE LDR01670 BSC L EFOR,Z LDR01680 LDX 3 10 CONVERT THE LDR01690 LD L ZERO F-FORMAT DATA LDR01700 STO L3 FFMAT-1 RECORD TO E-FORMAT LDR01710 MDX 3 -1 LDR01720 MDX *-4 LDR01730 LDX I3 TBLK1+1 LDR01740 STX L1 REGX LDR01750 LDX 1 11 LDR01760 CT7 LD L2 INPTA-1 LDR01770 STO L1 FFMAT-2 LDR01780 MDX 1 -1 LDR01790 MDX 2 -1 LDR01800 MDX 3 -1 LDR01810 MDX CT7 LDR01820 LDX I1 REGX LDR01830 LDX I3 REG3 LDR01840 BSI L FFORM LDR01850 BSC L ALL-2 LDR01860 AFOR LD L ZERO CONVERT THE ALPHA FIELDS LDR01870 STO L AFMAT TO EBCDIC WITH THE SPEED LDR01880 STO L AFMAT+1 ROUTINE LDR01890 STO L AFMAT+2 LDR01900 STO L AFMAT+3 LDR01910 LD L1 ENCOL LDR01920 S L1 BGCOL LDR01930 A L ONE LDR01940 STO L INDXA LDR01950 LDX I3 INDXA LDR01960 LD L2 INPTA-1 LDR01970 STO L3 AFMAT-1 LDR01980 MDX 2 -1 LDR01990 MDX 3 -1 LDR02000 MDX *-7 LDR02010 LDX I3 REG3 LDR02020 LIBF SPEED LDR02030 DC /0000 LDR02040 DC AFMAT LDR02050 DC BINFL LDR02060 DC 4 LDR02070 BSC L ALL LDR02080 EFOR LDX I3 TBLK1+1 CONVERT E-FORMAT TO LDR02090 LD L2 INPTA-1 FLOATING POINT LDR02100 STO L3 EFMAT-1 LDR02110 MDX 2 -1 LDR02120 MDX 3 -1 LDR02130 MDX *-7 LDR02140 LDX I3 REG3 LDR02150 BSI L CEFBF LDR02160 ALL STX L1 DUM DETERMINE IF THIS LDR02170 LD L DUM IS THE X RECORD ON LDR02180 S L XRCKD THE DATA CARD LDR02190 BSC L CT6,Z STORE THE X LDR02200 MDX L XXCNT,2 COORDINATE IN THE LDR02210 LDX I3 XXCNT ARRAY XX LDR02220 LDD L BINFL WHEN IT IS LDR02230 STD L3 XX-2 CONVERTED ON EACH LDR02240 LDX I3 REG3 DATA CARD LDR02250 CT6 MDX L DTINX,2 LDR02260 LDX I2 DTINX STORE EACH RECORD LDR02270 LDD L BINFL IN THE DISK OUTPUT LDR02280 STD L2 WKIO AREA AFTER IT HAS LDR02290 MDX 1 1 BEEN CONVERTED LDR02300 STX L1 DUM BRANCH BACK UNTIL LDR02310 LD L DUM ALL RECORDS ON EACH LDR02320 S L RCKD CARD HAVE BEEN LDR02330 BSC L BACK1,+ CONVERTED LDR02340 MDX L SAVCT,30 LDR02350 LD L SAVCT BRANCH TO DTOUT LDR02360 STO L DTINX WHEN THE DISK LDR02370 S L FX300 OUTPUT AREA HAS LDR02380 BSC L BACK2,Z+ BEEN FILLED LDR02390 DTOUT LD L SCCNT LDR02400 STO L WKIO+1 LDR02410 LD L FX300 LDR02420 STO L WKIO LDR02430 LIBF DISK1 WRITE THE FILLED LDR02440 DC /5000 DISK OUTPUT AREA LDR02450 DC WKIO INTO THE DISK LDR02460 DC ERRS DATA AREA LDR02470 LIBF DISK1 LDR02480 DC /4000 LDR02490 DC WKIO LDR02500 LIBF DISK1 LDR02510 DC /0000 LDR02520 DC WKIO LDR02530 MDX *-4 LDR02540 BSC L BACK3 LDR02550 IPTFN MDX L DTINX,2 LDR02560 LDX I2 DTINX PLACE THE DATA LDR02570 LDD L AZNIL TRAILER RECORD IN LDR02580 STD L2 WKIO THE DISK OUTPUT LDR02590 LD L SCCNT AREA WHEN THE LDR02600 STO L WKIO+1 TRAILER CARD IS FOUND LDR02610 LD L FX300 LDR02620 STO L WKIO LDR02630 LIBF DISK1 WRITE THE REMAINING LDR02640 DC /5000 DATA INTO THE LDR02650 DC WKIO DISK DATA AREA LDR02660 DC ERRS LDR02670 LIBF DISK1 LDR02680 DC /4000 LDR02690 DC WKIO LDR02700 LIBF DISK1 LDR02710 DC /0000 LDR02720 DC WKIO LDR02730 MDX *-4 LDR02740 LIBF DISK1 WRITE XX ARRAY ON THE DISK LDR02750 DC /5000 LDR02760 DC WRTDT LDR02770 DC ERRS LDR02780 LIBF DISK1 LDR02790 DC /4000 LDR02800 DC WRTDT LDR02810 LIBF DISK1 LDR02820 DC /0000 LDR02830 DC WRTDT LDR02840 MDX *-4 LDR02850 LINK SORTX LINK TO SORT X LDR02860 *************** LDR02870 * FFORM SUBROUTINE LDR02880 *************** LDR02890 FFORM NOP SUBROUTINE TO LDR02900 LDX 2 14 CONVERT AN F-FORMAT LDR02910 LD L NMZER CARD CODE NUMBER LDR02920 STO L2 EFMAT TO E-FORMAT LDR02930 MDX 2 -1 SET E-FORMAT AREA TO LDR02940 MDX *-4 ZERO CHARACTERS LDR02950 STX L1 REG1 SAVE IR1 LDR02960 LD L PLUS STORE PLUS, PERIOD AND LDR02970 STO L EFMAT E IN E-FORMAT WORD LDR02980 LD L PERID LDR02990 STO L EFMAT+1 LDR03000 LD L LTRE LDR03010 STO L EFMAT+10 LDR03020 LD L FX11 LDR03030 STO L FNDPR LDR03040 LDX 1 10 LDR03050 FFRM LD L1 FFMAT-1 TEST FOR LDR03060 BSC L FIND1,+- BLANK LDR03070 LD L1 FFMAT-1 PLUS SIGN LDR03080 S L PLUS LDR03090 BSC L FIND1,+- LDR03100 LD L1 FFMAT-1 AMPERSAND LDR03110 S L AMPER LDR03120 BSC L FIND1,+- LDR03130 LD L1 FFMAT-1 MINUS LDR03140 S L MINUS LDR03150 BSC L BCKF,Z LDR03160 LD L MINUS LDR03170 STO L EFMAT LDR03180 MDX FIND1 LDR03190 BCKF LD L1 FFMAT-1 PERIOD LDR03200 S L PERID LDR03210 BSC L BCKG,Z LDR03220 STX L1 FNDPR LDR03230 BCKG MDX 1 -1 LOOP TEST LDR03240 MDX FFRM TEST ANOTHER CHARACTER LDR03250 FIND1 STX L1 FNDEN CALCULATE AND STORE LDR03260 LD L FNDPR EXPONENT LDR03270 S L FNDEN LDR03280 S L ONE LDR03290 LIBF BINDC LDR03300 DC EFORM LDR03310 LD L EFORM LDR03320 STO L EFMAT+11 LDR03330 LD L EFORM+4 LDR03340 STO L EFMAT+12 LDR03350 LD L EFORM+5 LDR03360 STO L EFMAT+13 LDR03370 LD L TEN IS HIGH ORDER CHARACTER LDR03380 S L FNDEN IN RIGHTMOST POSITION LDR03390 BSC L FIND4,+ YES - GO TO FIND4 LDR03400 STO L FFMNB NO - STORE COUNT OF LDR03410 MDX 1 1 CHARACTERS TO BE MOVED LDR03420 LD L1 FFMAT-1 LOAD SIGNIFICANT DIGIT LDR03430 STO L EFMAT+2 OF F-FORMAT TO E-FORMAT LDR03440 LD L ONE MANTISSA LDR03450 STO L FFMCT LDR03460 S L FFMNB TEST FOR SINGLE DIGIT IN LDR03470 BSC L ONWD,- F-FORMAT LDR03480 LDX 2 0 YES - GO TO ONWD LDR03490 BCKH MDX 2 1 NO - MOVE DIGITS TO LDR03500 BCKJ MDX 1 1 E-FORMAT MANTISSA LDR03510 MDX L FFMCT,+1 LDR03520 LD L1 FFMAT-1 TEST FOR PERIOD LDR03530 S L PERID LDR03540 BSC L BCKI,+- LDR03550 LD L1 FFMAT-1 LDR03560 STO L2 EFMAT+2 LDR03570 LD L FFMCT LDR03580 S L FFMNB LDR03590 BSC L BCKH,+Z LDR03600 ONWD LDX I1 REG1 RESTORE IR1 LDR03610 BSC I FFORM RETURN LDR03620 FIND4 LD L NMZER STORE ZERO IN TENS POSITIONLDR03630 STO L EFMAT+13 OF EXPONENT LDR03640 MDX ONWD LDR03650 BCKI LD L FFMCT ARE ALL CHARACTERS MOVED LDR03660 S L FFMNB LDR03670 BSC L BCKJ,+Z NO - GO TO BCKJ LDR03680 MDX ONWD YES - GO TO RETURN LDR03690 *************** LDR03700 * CEFBF SUBROUTINE LDR03710 *************** LDR03720 CEFBF NOP SUBROUTINE TO LDR03730 LD L EFMAT CONVERT AN E-FORMAT LDR03740 S L PLUS TO FLOATING POINT LDR03750 BSC L NXTA,&- LDR03760 LD L EFMAT TEST FOR FORMAT ERRORS LDR03770 S L AMPER LDR03780 BSC L NXTA,&- LDR03790 LD L EFMAT LDR03800 S L MINUS LDR03810 BSC L NXTA,&- LDR03820 LD L EFMAT LDR03830 BSC L ERROR,Z LDR03840 NXTA LD L EFMAT+1 LDR03850 S L PERID LDR03860 BSC L ERROR,Z LDR03870 LD L EFMAT+10 LDR03880 S L LTRE LDR03890 BSC L ERROR,Z LDR03900 LD L EFMAT+11 LDR03910 S L PLUS LDR03920 BSC L NXTB,&- LDR03930 LD L EFMAT+11 LDR03940 S L AMPER LDR03950 BSC L NXTB,&- LDR03960 LD L EFMAT+11 LDR03970 S L MINUS LDR03980 BSC L NXTB,&- LDR03990 LD L EFMAT+11 LDR04000 BSC L ERROR,Z LDR04010 NXTB LD L EFMAT CONVERT HIGH ORDER DIGITS LDR04020 STO L EFORM TO BINARY AND THEN TO LDR04030 LD L ZERO FLOATING POINT LDR04040 STO L EFORM&1 LDR04050 LD L EFMAT+2 LDR04060 STO L EFORM&2 LDR04070 LD L EFMAT+3 LDR04080 STO L EFORM&3 LDR04090 LD L EFMAT+4 LDR04100 STO L EFORM&4 LDR04110 LD L EFMAT+5 LDR04120 STO L EFORM&5 LDR04130 LIBF DCBIN LDR04140 DC EFORM LDR04150 STO L FXMNT LDR04160 LIBF FLOAT LDR04170 LIBF FSTO LDR04180 DC MANT LDR04190 LD L ZERO CONVERT LOW ORDER DIGITS TOLDR04200 STO L EFORM&1 BINARY AND THEN TO LDR04210 LD L EFMAT+6 FLOATING POINT LDR04220 STO L EFORM&2 LDR04230 LD L EFMAT+7 LDR04240 STO L EFORM&3 LDR04250 LD L EFMAT+8 LDR04260 STO L EFORM&4 LDR04270 LD L EFMAT+9 LDR04280 STO L EFORM&5 LDR04290 LIBF DCBIN LDR04300 DC EFORM LDR04310 STO L FXMNR LDR04320 LIBF FLOAT LDR04330 LIBF FSTO LDR04340 DC MANR LDR04350 LD L FXMNT ARE HIGH ORDER DIGITS ZERO LDR04360 BSC L *&4,Z LDR04370 LD L FXMNR NO - CALCULATE LDR04380 BSC L ALTER,+- CHARACTERISTIC LDR04390 LD L EFMAT+11 YES - ARE LOW ORDER DIGITS LDR04400 STO L EFORM ZERO LDR04410 LD L ZERO YES - GO TO ALTER LDR04420 STO L EFORM&1 NO - CONVERT EXPONENT TO LDR04430 STO L EFORM&2 BINARY, COMBINE TWO LDR04440 STO L EFORM&3 FLOATING POINT LDR04450 LD L EFMAT+12 NUMBERS AND ADJUST LDR04460 STO L EFORM&4 CHARACTERISTIC FOR LDR04470 LD L EFMAT+13 EXPONENT OF E-FORMAT LDR04480 STO L EFORM&5 LDR04490 LIBF DCBIN LDR04500 DC EFORM LDR04510 STO L EXPON LDR04520 LIBF FLD LDR04530 DC FTEN LDR04540 LIBF FAXI LDR04550 DC EXPON LDR04560 LIBF FSTO LDR04570 DC EXPT LDR04580 LIBF FLD LDR04590 DC MANR LDR04600 LIBF FMPY LDR04610 DC TENG4 LDR04620 LIBF FADD LDR04630 DC MANT LDR04640 LIBF FMPY LDR04650 DC TENG4 LDR04660 LIBF FMPY LDR04670 DC EXPT LDR04680 LIBF FSTO LDR04690 DC BINFL LDR04700 BSC I CEFBF RETURN LDR04710 ALTER LDD L FZERO SET VALUE TO FLOATING LDR04720 STD L BINFL POINT ZERO LDR04730 BSC I CEFBF RETURN LDR04740 ERRS NOP TYPE DISK ERROR MESSAGE LDR04750 LIBF WRTY0 LDR04760 DC /2000 LDR04770 DC MSAG5 LDR04780 SRA 16 LDR04790 BSC I ERRS LDR04800 ERROR BSI L ERTYP TYPE FORMAT ERROR MESSAGE LDR04810 DC MSAG6 LDR04820 BSI L ERTYP LDR04830 DC MSAG4 LDR04840 WAIT LDR04850 EXIT LDR04860 *************** LDR04870 * ERTYP SUBROUTINE LDR04880 *************** LDR04890 ERTYP NOP SUBROUTINE TO LDR04900 LD I ERTYP WRITE MESSAGES LDR04910 STO L ERTX ON THE CONSOLE LDR04920 MDX L ERTYP,+1 TYPEWRITER LDR04930 LD L ERTX LDR04940 S L ONE LDR04950 STO *+1 LDR04960 LD L 0 LDR04970 STO L ERTX+2 LDR04980 M L ONE LDR04990 D L TWO LDR05000 STO L TYPEX LDR05010 LIBF EBPRT LDR05020 DC /0000 LDR05030 ERTX DC 0 LDR05040 DC TYPEX+1 LDR05050 DC 0 LDR05060 LIBF WRTY0 LDR05070 DC /2000 LDR05080 DC TYPEX LDR05090 LIBF WRTY0 LDR05100 DC /2000 LDR05110 DC CONTL LDR05120 LIBF WRTY0 LDR05130 DC /0000 LDR05140 MDX *-3 LDR05150 BSC I ERTYP LDR05160 *************** LDR05170 * DEFINE ERROR MESSAGES LDR05180 *************** LDR05190 DC 16 LDR05200 MSAG1 EBC .LODAR BEGINNING . LDR05210 DC 30 LDR05220 MSAG4 EBC .PUSH START FOR EXIT TO MONITOR. LDR05230 MSAG5 DC 20 DISK ERROR MESSAGE LDR05240 DC /3020 LDR05250 DC /9858 LDR05260 DC /2135 LDR05270 DC /6060 LDR05280 DC /5060 LDR05290 DC /2121 LDR05300 DC /9C34 LDR05310 DC /6070 LDR05320 DC /2074 LDR05330 DC /3C9C LDR05340 DC /3421 LDR05350 DC /7C50 LDR05360 DC /1821 LDR05370 DC /3C74 LDR05380 DC /3021 LDR05390 DC /6034 LDR05400 DC /989C LDR05410 DC /3C60 LDR05420 DC /9C21 LDR05430 DC /8103 LDR05440 DC 30 LDR05450 MSAG6 EBC .INPUT DATA NOT IN PROPER FORM . LDR05460 CONTL DC 1 LDR05470 DC /8103 LDR05480 *************** LDR05490 * DEFINE CONSTANTS LDR05500 *************** LDR05510 SCBGN DC 288 LDR05520 SCSTR DC 288 LDR05530 ZERO DC 0 LDR05540 ONE DC 1 LDR05550 TWO DC 2 LDR05560 FOUR DC 4 LDR05570 FIVE DC 5 LDR05580 TEN DC 10 LDR05590 FX11 DC 11 LDR05600 FX30 DC 30 LDR05610 FXD80 DC 80 LDR05620 FX300 DC 300 LDR05630 F1600 DC 1600 LDR05640 PLUS DC /80A0 LDR05650 MINUS DC /4000 LDR05660 AMPER DC /8000 LDR05670 NMZER DC /2000 LDR05680 PERID DC /8420 LDR05690 LTRA DC /9000 LDR05700 LTRE DC /8100 LDR05710 RKMK DC /4060 LDR05720 DC /4060 LDR05730 FZERO DEC 0. LDR05740 FTEN DEC 10. LDR05750 TENG4 DEC 1.0E-4 LDR05760 AZNIL DEC 1.E30 LDR05770 ZNIL DEC -1.0E30 NIL VALUE CODE LDR05780 *************** LDR05790 * ALLOCATE STORAGE LDR05800 *************** LDR05810 WRTDT DC 3203 WORD COUNT XX ARRAY LDR05820 DC 1584 SECTOR ADDRESS XX ARRAY LDR05830 XX BSS E 3200 STORAGE FOR X VALUES LDR05840 COUNT BSS 1 CARD COUNT LDR05850 REG3 BSS 1 STORE IR3 LIBF TRANS VECT LDR05860 YRCKD BSS 1 Y CARD FIELD NUMBER LDR05870 XRCKD BSS 1 X CARD FIELD NUMBER LDR05880 SAVCT BSS 1 RECORD INCREMENT FOR WKIO LDR05890 REG1 BSS 1 STORE IR1 LDR05900 REGX BSS 1 STORE IR LDR05910 FNDPR BSS 1 USED WITH FNDEN TO CALC EXPLDR05920 FNDEN BSS 1 IR VALUE FOR CHAR. SELECTIOLDR05930 FFMNB BSS 1 NO. DIGITS TO BE MOVED LDR05940 FFMCT BSS 1 USED WITH FFMNB, FFORM LDR05950 FXMNT BSS 1 HIGH ORDER DIGITS, BINARY LDR05960 FXMNR BSS 1 LOW ORDER DIGITS, BINARY LDR05970 EXPON BSS 1 EXPONENT, BINARY LDR05980 DTINX BSS 1 IR INCREMENT FOR WKIO LDR05990 RCKD BSS 1 RECORDS PER CARD LDR06000 INDXA BSS 1 CARD FIELD LENGTH, INDEX LDR06010 SCCNT BSS 1 SECTOR ADDRESS LDR06020 XXCNT BSS 1 IR VALUE FOR XX ARRAY LDR06030 EXPT BSS E 2 EXPONENT FLT PT, CEFBF LDR06040 MANT BSS E 2 HIGH ORDER DIGITS, FLT PT LDR06050 MANR BSS E 2 LOW ORDER DIGITS, FLT PT LDR06060 BINFL BSS E 2 VALUE IN FLT PT LDR06070 DUM BSS E 2 TEMPORARY STORAGE LDR06080 EFORM BSS E 6 USED IN E-FORMAT TO FLT PT LDR06090 AFMAT BSS E 4 ALPHA CHARACTERS IN EBCDIC LDR06100 FFMAT BSS E 10 F-FORMAT VALUE LDR06110 EFMAT BSS E 14 E-FORMAT VALUE LDR06120 BGCOL BSS 16 BEGINNING COLUMN NUMBERS LDR06130 ENCOL BSS 16 ENDING COLUMN NUMBERS LDR06140 TYPE BSS 16 CARD FIELD CODES LDR06150 BSS E 1 LDR06160 INPTA BSS 51 CARD INPUT BUFFER LDR06170 TYPEX BSS E 30 TYPEWRITER & CARD BUFFER LDR06180 WKIO BSS E 302 DISK OUTPUT BUFFER LDR06190 END GO LDR06200 // DUP LDR06210 *STORE WS UA LODAR LDR06220 // JOB SRT00010 // DUP SRT00020 *DELETE SORTX SRT00030 // ASM SRT00040 *LIST SRT00050 *************** SRT00060 * SORTX LINK FOR LODAR PROGRAM SRT00070 * DO NOT EXECUTE SEPARATELY SRT00080 *************** SRT00090 * SORT ON THE X COORDINATE SRT00100 *************** SRT00110 FC EQU 126 SRT00120 GO LIBF DISK1 READ X COORDINATES SRT00130 DC /5000 FROM DISK SRT00140 DC WRTDT SRT00150 DC ERRS SRT00160 LIBF DISK1 SRT00170 DC /1000 SRT00180 DC WRTDT SRT00190 DC ERRS SRT00200 LIBF DISK1 SRT00210 DC /0000 SRT00220 DC WRTDT SRT00230 MDX *-4 SRT00240 LD L FX300 SRT00250 STO L WKIO SRT00260 LDX 1 1 INITIALIZE THE INDEX SRT00270 LDX I2 COUNT VALUES IN THE SRT00280 SLA 16 STORAGE AREA SRT00290 INCR A L ONE SEQUENTIALLY NUMBER SRT00300 STO L1 INDEX-1 INDEX AREA SRT00310 MDX 1 1 SRT00320 MDX 2 -1 SRT00330 MDX INCR SRT00340 AGN SLA 16 INITIALIZE FOR SRT00350 STO L CNT EACH COMPLETE SRT00360 LDX I2 COUNT PASS THROUGH SRT00370 LDX I1 COUNT THE X-COORDINATES SRT00380 MDX I1 COUNT OF THE DATA SRT00390 MDX 1 -2 SRT00400 HERE LIBF FLDX COMPARE ADJACENT SRT00410 DC XX VALUES OF THE SRT00420 LIBF FSUBX X COORDINATES SRT00430 DC XX-2 BRANCH TO OVER SRT00440 LD 3 FC IF THEY ARE IN THE SRT00450 BSC L OVER,- PROPER ORDER. SRT00460 LDD L1 XX INTERCHANGE THE SRT00470 STD L RESUL VALUES IF THEY SRT00480 LDD L1 XX-2 ARE NOT IN THE SRT00490 STD L1 XX PROPER ORDER SRT00500 LDD L RESUL SRT00510 STD L1 XX-2 SRT00520 LD L2 INDEX-1 INTERCHANGE THE SRT00530 STO L DUM CORRESPONDING SRT00540 LD L2 INDEX-2 INDEX VALUES SRT00550 STO L2 INDEX-1 SRT00560 LD L DUM SRT00570 STO L2 INDEX-2 SRT00580 LD L ONE SRT00590 STO L CNT SRT00600 OVER MDX 1 -2 BRANCH BACK UNTIL SRT00610 MDX *+1 ALL X COORDINATES SRT00620 MDX *+3 HAVE BEEN PROCESSED SRT00630 MDX 2 -1 SRT00640 BSC L HERE SRT00650 LD L CNT SRT00660 BSC L AGN,Z SRT00670 *************** SRT00680 * SORT ON THE Y COORDINATE SRT00690 *************** SRT00700 LD L YRCKD SRT00710 A L YRCKD SRT00720 STO L DYRKD SRT00730 LD1 SLA 16 INITIALIZE FOR SRT00740 STO L CNT EACH COMPLETE SRT00750 LDX I2 COUNT PASS THROUGH SRT00760 LDX I1 COUNT THE Y-COORDINATES SRT00770 MDX I1 COUNT OF THE DATA SRT00780 MDX 1 -2 SRT00790 LD2 LIBF FLDX COMPARE ADJACENT SRT00800 DC XX VALUES OF THE SRT00810 LIBF FSUBX X COORDINATES TO SRT00820 DC XX-2 SEE IF THEY ARE SRT00830 LD 3 FC EQUAL SRT00840 BSC L LD3,Z SRT00850 LD L2 INDEX-1 IF THEY ARE EQUAL SRT00860 S L ONE LOCATE THE SRT00870 M L ONE Y COORDINATE SRT00880 D L TEN ASSOCIATED WITH SRT00890 STO L DUM THE FIRST X VALUE SRT00900 A L SCSTR SRT00910 STO L WKIO+1 SRT00920 LIBF DISK1 SRT00930 DC /5000 SRT00940 DC WKIO SRT00950 DC ERRS SRT00960 LIBF DISK1 SRT00970 DC /1000 SRT00980 DC WKIO SRT00990 DC ERRS SRT01000 LIBF DISK1 SRT01010 DC /0000 SRT01020 DC WKIO SRT01030 MDX *-4 SRT01040 LD L DUM SRT01050 M L TEN SRT01060 D L ONE SRT01070 STO L DUM SRT01080 LD L2 INDEX-1 SRT01090 S L DUM SRT01100 S L ONE SRT01110 M L FX30 SRT01120 D L ONE SRT01130 A L DYRKD SRT01140 STO L DUM SRT01150 STX L3 REG3 SRT01160 LDX I3 DUM STORE THIS Y VALUE SRT01170 LDD L3 WKIO IN THE FIRST SRT01180 STD L Y1CMP COMPARE LOCATION SRT01190 LDX I3 REG3 SRT01200 LD L2 INDEX-2 LOCATE THE SRT01210 S L ONE Y COORDINATE SRT01220 M L ONE ASSOCIATED WITH SRT01230 D L TEN THE SECOND SRT01240 STO L DUM X VALUE SRT01250 A L SCSTR SRT01260 STO L WKIO+1 SRT01270 LIBF DISK1 SRT01280 DC /5000 SRT01290 DC WKIO SRT01300 DC ERRS SRT01310 LIBF DISK1 SRT01320 DC /1000 SRT01330 DC WKIO SRT01340 DC ERRS SRT01350 LIBF DISK1 SRT01360 DC /0000 SRT01370 DC WKIO SRT01380 MDX *-4 SRT01390 LD L DUM SRT01400 M L TEN SRT01410 D L ONE SRT01420 STO L DUM SRT01430 STX L3 REG3 SRT01440 LD L2 INDEX-2 SRT01450 S L DUM SRT01460 S L ONE SRT01470 M L FX30 SRT01480 D L ONE SRT01490 A L DYRKD SRT01500 STO L DUM SRT01510 LDX I3 DUM STORE THIS Y VALUE SRT01520 LDD L3 WKIO AT THE SECOND SRT01530 STD L Y2CMP COMPARE LOCATION SRT01540 LDX I3 REG3 SRT01550 LIBF FLD COMPARE THE TWO SRT01560 DC Y1CMP Y COORDINATES SRT01570 LIBF FSUB SRT01580 DC Y2CMP SRT01590 LD 3 FC SRT01600 BSC L LD3,- SRT01610 LD L2 INDEX-2 INTERCHANGE THE SRT01620 STO L RESUL INDEX VALUES IF SRT01630 LD L2 INDEX-1 THE Y COORDINATES SRT01640 STO L2 INDEX-2 ARE NOT IN THE SRT01650 LD L RESUL PROPER ORDER SRT01660 STO L2 INDEX-1 SRT01670 MDX L CNT,1 SRT01680 LD3 MDX 1 -2 BRANCH BACK UNTIL SRT01690 MDX *+1 ALL EQUAL X VALUES SRT01700 MDX *+3 HAVE BEEN SRT01710 MDX 2 -1 PROCESSED SRT01720 BSC L LD2 SRT01730 LD L CNT SRT01740 BSC L LD1,Z SRT01750 LD L FX300 SRT01760 STO L WKIOX SRT01770 *************** SRT01780 * REARRANGE THE RANDOM DATA ON THE DISK SRT01790 *************** SRT01800 LDX I1 COUNT INTERCHANGE THE SRT01810 DO LD L1 INDEX-1 INDEX VALUES SRT01820 STO L DUM SRT01830 LDX I2 DUM SRT01840 STX L1 DUM SRT01850 LD L DUM SRT01860 STO L2 INDEZ-1 SRT01870 MDX 1 -1 SRT01880 MDX DO SRT01890 LD6 LDX I2 COUNT INITIALIZE THE SRT01900 SLA 16 COUNTS SRT01910 STO L CNT SRT01920 LD4 STX L2 THSCT SEE IF THIS DATA SET SRT01930 LD L THSCT IS TO BE MOVED SRT01940 S L2 INDEZ-1 SRT01950 BSC L LD5,+- SRT01960 MDX L CNT,1 SRT01970 LD L2 INDEZ-1 LOCATE AND READ SRT01980 S L ONE INTO STORAGE THE SRT01990 M L ONE SECTOR WHICH CONTAINS SRT02000 D L TEN THIS DATA SET SRT02010 STO L DUM SRT02020 A L SCSTR SRT02030 STO L WKIO+1 SRT02040 LIBF DISK1 SRT02050 DC /5000 SRT02060 DC WKIO SRT02070 DC ERRS SRT02080 LIBF DISK1 SRT02090 DC /1000 SRT02100 DC WKIO SRT02110 DC ERRS SRT02120 LIBF DISK1 SRT02130 DC /0000 SRT02140 DC WKIO SRT02150 MDX *-4 SRT02160 LD L DUM SRT02170 M L TEN SRT02180 D L ONE SRT02190 STO L DUM SRT02200 LD L2 INDEZ-1 SRT02210 S L DUM SRT02220 M L FX30 SRT02230 D L ONE SRT02240 A L TWO SRT02250 STO L DUM SRT02260 LDX I1 DUM SRT02270 STX L3 REG3 SRT02280 LDX 3 30 TRANSFER THIS SRT02290 LDD L1 WKIO-2 DATA SET TO A SRT02300 STD L3 BUFFR-2 BUFFER AREA SRT02310 MDX 1 -2 SRT02320 MDX 3 -2 SRT02330 MDX *-7 SRT02340 LDX I1 DUM SRT02350 STX L2 DUM LOCATE THE SECTOR SRT02360 LD L DUM INTO WHICH THIS SRT02370 S L ONE DATA SET IS TO SRT02380 M L ONE BE MOVED SRT02390 D L TEN SRT02400 STO L DUM SRT02410 A L SCSTR SRT02420 STO L WKIOX+1 SRT02430 LDX I3 REG3 SRT02440 LIBF DISK1 READ THIS SECTOR SRT02450 DC /5000 INTO STORAGE SRT02460 DC WKIOX SRT02470 DC ERRS SRT02480 LIBF DISK1 SRT02490 DC /1000 SRT02500 DC WKIOX SRT02510 DC ERRS SRT02520 LIBF DISK1 SRT02530 DC /0000 SRT02540 DC WKIOX SRT02550 MDX *-4 SRT02560 LD L DUM SRT02570 M L TEN SRT02580 D L ONE SRT02590 STO L DUM SRT02600 STX L2 RESUL SRT02610 LD L RESUL SRT02620 S L DUM SRT02630 M L FX30 SRT02640 D L ONE SRT02650 A L TWO SRT02660 STO L DUM SRT02670 STX L3 REG3 SRT02680 STX L2 REGX SRT02690 LDX 2 30 MOVE THE DATA SET SRT02700 LDX I3 DUM FROM ONE STORAGE SRT02710 LDD L3 WKIOX-2 AREA INTO THE OTHER SRT02720 STD L1 WKIO-2 WKIOX TO WKIO SRT02730 MDX 3 -2 SRT02740 MDX 1 -2 SRT02750 MDX 2 -2 SRT02760 MDX *-8 SRT02770 LDX I2 REGX SRT02780 LDX I3 DUM SRT02790 LDX 1 30 SRT02800 LD L WKIO+1 ARE THE SECTORS SRT02810 S L WKIOX+1 THE SAME SRT02820 BSC L SAMEX,+- SRT02830 LDD L1 BUFFR-2 MOVE THE BUFFER SRT02840 STD L3 WKIOX-2 INTO THE OTHER SRT02850 MDX 3 -2 STORAGE AREA SRT02860 MDX 1 -2 SRT02870 MDX *-7 SRT02880 LDX I3 REG3 SRT02890 LIBF DISK1 WRITE OUT THE SRT02900 DC /5000 STORAGE AREAS SRT02910 DC WKIOX SRT02920 DC ERRS SRT02930 LIBF DISK1 SRT02940 DC /4000 SRT02950 DC WKIOX SRT02960 SAMEZ LIBF DISK1 SRT02970 DC /5000 SRT02980 DC WKIO SRT02990 DC ERRS SRT03000 LIBF DISK1 SRT03010 DC /4000 SRT03020 DC WKIO SRT03030 LIBF DISK1 SRT03040 DC /0000 SRT03050 DC WKIO SRT03060 MDX *-4 SRT03070 LD L2 INDEZ-1 INTERCHANGE THE SRT03080 STO L RESUL INDEX VALUES TO SRT03090 LDX I3 RESUL CORRESPOND WITH SRT03100 LD L3 INDEZ-1 THE NEW DISK SRT03110 STO L2 INDEZ-1 LOCATIONS OF SRT03120 LD L RESUL THE DATA SETS SRT03130 STO L3 INDEZ-1 SRT03140 LDX I3 REG3 SRT03150 LD5 MDX 2 -1 SRT03160 MDX *+1 SRT03170 MDX *+2 SRT03180 BSC L LD4 SRT03190 LD L CNT SRT03200 BSC L LD6,Z SRT03210 BSI L ERTYP TYPE COMPLETION SRT03220 DC MSAG3 MESSAGE SRT03230 EXIT SRT03240 SAMEX LDD L1 BUFFR-2 MOVE THE BUFFER SRT03250 STD L3 WKIO-2 AREA BACK INTO SRT03260 MDX 3 -2 THE SAME STORAGE SRT03270 MDX 1 -2 AREA IF THE SECTORS SRT03280 MDX *-7 ARE THE SAME SRT03290 LDX I3 REG3 SRT03300 BSC L SAMEZ SRT03310 ERRS NOP SRT03320 LIBF WRTY0 SRT03330 DC /2000 SRT03340 DC MSAG5 SRT03350 SRA 16 SRT03360 BSC I ERRS SRT03370 *************** SRT03380 * ERTYP SUBROUTINE SRT03390 *************** SRT03400 ERTYP NOP SUBROUTINE TO SRT03410 LD I ERTYP WRITE MESSAGES SRT03420 STO L ERTX ON THE CONSOLE SRT03430 MDX L ERTYP,+1 TYPEWRITER SRT03440 LD L ERTX SRT03450 S L ONE SRT03460 STO *+1 SRT03470 LD L 0 SRT03480 STO L ERTX+2 SRT03490 SRA 1 SRT03500 STO L TYPEX SRT03510 LIBF EBPRT SRT03520 DC /0000 SRT03530 ERTX DC 0 SRT03540 DC TYPEX+1 SRT03550 DC 0 SRT03560 LIBF WRTY0 SRT03570 DC /2000 SRT03580 DC TYPEX SRT03590 LIBF WRTY0 SRT03600 DC /2000 SRT03610 DC CONTL SRT03620 LIBF WRTY0 SRT03630 DC /0000 SRT03640 MDX *-3 SRT03650 BSC I ERTYP SRT03660 * DEFINE ERROR MESSAGES SRT03670 *************** SRT03680 *************** SRT03690 DC 16 SRT03700 MSAG3 EBC .LODAR COMPLETED . SRT03710 MSAG5 DC 20 DISK ERROR MESSAGE SRT03720 DC /3020 SRT03730 DC /9858 SRT03740 DC /2135 SRT03750 DC /6060 SRT03760 DC /5060 SRT03770 DC /2121 SRT03780 DC /9C34 SRT03790 DC /6070 SRT03800 DC /2074 SRT03810 DC /3C9C SRT03820 DC /3421 SRT03830 DC /7C50 SRT03840 DC /1821 SRT03850 DC /3C74 SRT03860 DC /3021 SRT03870 DC /6034 SRT03880 DC /989C SRT03890 DC /3C60 SRT03900 DC /9C21 SRT03910 DC /8103 SRT03920 CONTL DC 1 SRT03930 DC /8103 SRT03940 *************** SRT03950 * DEFINE CONSTANTS SRT03960 *************** SRT03970 SCBGN DC 288 SRT03980 SCSTR DC 288 SRT03990 ONE DC 1 SRT04000 TWO DC 2 SRT04010 FOUR DC 4 SRT04020 FIVE DC 5 SRT04030 TEN DC 10 SRT04040 FX11 DC 11 SRT04050 FX30 DC 30 SRT04060 FXD80 DC 80 SRT04070 FX300 DC 300 SRT04080 F1600 DC 1600 SRT04090 PLUS DC /80A0 + SRT04100 MINUS DC /4000 - SRT04110 AMPER DC /8000 & SRT04120 NMZER DC /2000 0 SRT04130 PERID DC /8420 . SRT04140 LTRA DC /9000 A SRT04150 LTRE DC /8100 E SRT04160 RKMK DC /4060 SRT04170 DC /4060 SRT04180 FZERO DEC 0. SRT04190 FTEN DEC 10. SRT04200 TENG4 DEC 1.0E-4 SRT04210 AZNIL DEC 1.E30 SRT04220 *************** SRT04230 * ALLOCATE STORAGE SRT04240 *************** SRT04250 WRTDT DC 3203 X ARRAY WORD COUNT SRT04260 DC 1584 X ARRAY SECTOR ADRESS SRT04270 XX BSS E 898 X ARRAY STORAGE SRT04280 INDEZ BSS E 2000 Y SORT INDEX SRT04290 WKIOX BSS E 302 DISK IO DATA SET STORAGE SRT04300 COUNT BSS 1 NUMBER OF ENTRIES IN X AREASRT04310 REG3 BSS 1 STORE IR3 LIBF TRANS VECT SRT04320 YRCKD BSS 1 Y FIELD NUMBER SRT04330 REGX BSS 1 STORE IR SRT04340 CNT BSS 1 FINISHED SORT FLAG SRT04350 THSCT BSS 1 COMPARE INDEX, Y SORT SRT04360 DYRKD BSS 1 TWICE Y FIELD NUMBER SRT04370 DUM BSS E 2 TEMPORARY STORAGE SRT04380 Y1CMP BSS E 2 FIRST Y COMPARE LOCATION SRT04390 Y2CMP BSS E 2 SECOND Y COMPARE LOCATION SRT04400 RESUL BSS E 2 INTERCHANGE VALUE STORAGE SRT04410 TYPEX BSS E 2 MESSAGE AND DATA RECORD SRT04420 BUFFR BSS E 30 BUFFER SRT04430 WKIO BSS E 302 DISK OUTPUT BUFFER SRT04440 INDEX BSS E 1600 SORT INDEX SRT04450 END GO SRT04460 // DUP SRT04470 *STORE WS UA SORTX SRT04480 // JOB LDG00010 // DUP LDG00020 *DELETE UA LODAG LDG00030 // ASM LDG00040 *LIST LDG00050 *************** LDG00060 * LODAG - UTILITY PROGRAM CARD TO DISK LDG00070 * FOR A GRID DATA SET IN H FORMAT LDG00080 *************** LDG00090 GO LIBF WRTY0 RETURN CARRIAGE LDG00100 DC /2000 LDG00110 DC CONTL LDG00120 BSI L ERTYP TYPE STARTING MESSAGE LDG00130 DC BMESS LDG00140 BSI L NAME READ HEADER CARD LDG00150 BSI L LOCAT LOCATE TRAILER RECORD LDG00160 LD L IFOUN LDG00170 BSC L NO,Z NAME ALREADY USED LDG00180 BSI L LOCAS READ MASTER HEADER CARD LDG00190 BSI L WRTOU WRITE HEADER ON DISK LDG00200 BSI L REWRT WRITE TRAILER RECORD LDG00210 LD L ANAME LDG00220 STO L MSAG2+9 LDG00230 LD L ANAME+1 LDG00240 STO L MSAG2+10 LDG00250 BSI L ERTYP LDG00260 DC MSAG2 LDG00270 LD L ZERO INITIALIZE COLUMN LDG00280 STO L THCOL NUMBER LDG00290 LLQ LD L THCOL LDG00300 A L ONE INCREMENT COLUMN LDG00310 STO L THCOL LDG00320 BSI L GRDVS GET COLUMN OF GRID VALUES LDG00330 BSI L WRTGR WRITE ONE COL ON DISK LDG00340 LD L THCOL LDG00350 S L MXCOL LAST COLUMN? LDG00360 BSC L LLQ,Z+ NO, RETURN LDG00370 BSI L ERTYP YES, TYPE COMPLETION MSG LDG00380 DC EMESS LDG00390 EXIT RETURN TO MONITOR LDG00400 *************** LDG00410 * COME HERE IF NAME ALREADY USED LDG00420 *************** LDG00430 NO BSI L ERTYP LDG00440 DC NUMSG LDG00450 BSI L ERTYP LDG00460 DC MSAGB LDG00470 WAIT LDG00480 EXIT LDG00490 *************** LDG00500 * READ NAME OF OUTPUT DATA SET LDG00510 *************** LDG00520 NAME NOP LDG00530 LD L FOUR LDG00540 STO L BNAME-1 LDG00550 *************** LDG00560 LIBF CARD0 LDG00570 * LIBF READ0 LDG00580 *************** LDG00590 DC /0000 LDG00600 MDX *-3 LDG00610 *************** LDG00620 LIBF CARD0 LDG00630 * LIBF READ0 LDG00640 *************** LDG00650 DC /1000 LDG00660 DC BNAME-1 LDG00670 *************** LDG00680 LIBF CARD0 LDG00690 * LIBF READ0 LDG00700 *************** LDG00710 DC /0000 LDG00720 MDX *-3 LDG00730 LIBF SPEED LDG00740 DC /0000 LDG00750 DC BNAME LDG00760 DC ANAME LDG00770 DC 4 LDG00780 BSC I NAME LDG00790 *************** LDG00800 * LOCAT SUBROUTINE LDG00810 *************** LDG00820 LOCAT NOP RETURN ADDRESS LDG00830 LD L FX20 INITIALIZE LDG00840 STO L WKIO LDG00850 LD L SCBGN LDG00860 STO L WKIO+1 LDG00870 AGN LIBF DISKN READ MASTER HEADER LDG00880 DC /5000 FROM DISK LDG00890 DC WKIO LDG00900 DC ERRS LDG00910 LIBF DISKN LDG00920 DC /1000 LDG00930 DC WKIO LDG00940 DC ERRS LDG00950 LIBF DISKN LDG00960 DC /0000 LDG00970 DC WKIO LDG00980 MDX *-4 LDG00990 LIBF FLD TEST FOR TRAILER LDG01000 DC TRAIL RECORD LDG01010 LIBF FSUB LDG01020 DC WKIO+2 LDG01030 LIBF FSTO LDG01040 DC DUMY LDG01050 LD L DUMY LDG01060 BSC L OK,+- BRANCH IF FOUND LDG01070 LIBF FLD LDG01080 DC WKIO+2 LDG01090 LIBF FSUB TEST GRID NAME LDG01100 DC ANAME LDG01110 LIBF FSTO LDG01120 DC DUMY LDG01130 LD L DUMY LDG01140 BSC L FND,+- BRANCH IF USED LDG01150 LD L WKIO+6 LDG01160 BSC L EROB,& BRANCH ON ERROR LDG01170 M L FOUR CALCULATE ADDRESS OF LDG01180 STD L DUMY NEXT MASTER HEADER LDG01190 D L THREE RECORD LDG01200 STO L SCINC LDG01210 M L THREE LDG01220 D L ONE LDG01230 S L DUMY+1 LDG01240 BSC L AA3,- BRANCH NO REMAINDER LDG01250 A L FOUR REMAINDER, INCREMENT LDG01260 A L SCINC BY FOUR LDG01270 STO L SCINC LDG01280 AA3 LD L WKIO&1 STORE SECTOR LDG01290 A L SCINC ADDRESS OF NEXT LDG01300 STO L WKIO+1 GRID DATA SET LDG01310 S L SCBGN ERROR IF NOT WITHIN LDG01320 BSC L EROB,& GRID DATA SET AREA LDG01330 S L SCLGT LDG01340 BSC L EROB,- LDG01350 BSC L AGN TRY AGAIN LDG01360 FND LD L ONE NAME IS USED LDG01370 STO L IFOUN SET IFOUN TO 1 LDG01380 LDD L WKIO+4 COLLECT DATA SET LDG01390 STD L GRID PARAMETERS LDG01400 LD L WKIO+6 LDG01410 STO L ICMAX LDG01420 LD L WKIO+7 LDG01430 STO L IRMAX LDG01440 LD L WKIO&1 LDG01450 STO L SCSTR LDG01460 BSC I LOCAT AND RETURN LDG01470 OK LD L ZERO TRAILER RECORD FOUND LDG01480 STO L IFOUN SET IFOUN TO 0 LDG01490 LD L WKIO&1 STORE TRAILER LDG01500 STO L SCSTR RECORD ADDRESS LDG01510 BSC I LOCAT LDG01520 *************** LDG01530 * SCCOM SUBROUTINE LDG01540 *************** LDG01550 SCCOM NOP RETURN ADDRESS LDG01560 LD L THCOL LOCATE A GIVEN COLUMN LDG01570 S L ONE WITHIN A GRID DATA SET LDG01580 M L ONE AND CHECK TO SEE THAT LDG01590 D L THREE IT LIES WITHIN THE AREA LDG01600 STO L DUMY SET ASIDE FOR GRID LDG01610 M L FOUR DATA SETS LDG01620 D L ONE LDG01630 STO L SCINC LDG01640 LD L DUMY LDG01650 M L THREE LDG01660 D L ONE LDG01670 STO L DUMY LDG01680 LD L THCOL LDG01690 S L DUMY LDG01700 S L ONE LDG01710 STO L SCINX LDG01720 A L SCINC LDG01730 STO L SCINC LDG01740 A L SCSTR LDG01750 STO L SCLOC LDG01760 S L SCBGN LDG01770 BSC L EROB,Z+ BRANCH IF OUT OF LDG01780 S L SCLGT BOUNDS LDG01790 BSC L EROB,- LDG01800 LD L FX100 LDG01810 M L SCINX LDG01820 D L ONE LDG01830 A L FX22 LDG01840 STO L ININX LDG01850 BSC I SCCOM RETURN LDG01860 *************** LDG01870 * WRTGR SUBROUTINE LDG01880 *************** LDG01890 WRTGR NOP RETURN ADDRESS LDG01900 BSI L SCCOM MOVE ONE COLUMN TO LDG01910 LIBF DISKN THE DISK I/O BUFFER LDG01920 DC /0000 AND WRITE IT ON DISK LDG01930 DC WKIO LDG01940 MDX *-4 LDG01950 LD L FX640 LDG01960 STO L WKIO LDG01970 LD L SCLOC LDG01980 STO L WKIO+1 LDG01990 LIBF DISKN LDG02000 DC /5000 LDG02010 DC WKIO LDG02020 DC ERRS LDG02030 LIBF DISKN LDG02040 DC /1000 LDG02050 DC WKIO LDG02060 DC ERRS LDG02070 LIBF DISKN LDG02080 DC /0000 LDG02090 DC WKIO LDG02100 MDX *-4 LDG02110 LD L ININX LDG02120 A L FX418 LDG02130 STO L DUMY LDG02140 LDX I1 DUMY LDG02150 LDX I2 FX420 LDG02160 LDD L ZNIL CLEAR BUFFER LDG02170 STD L1 WKIO AREA LDG02180 MDX 1 -2 LDG02190 MDX 2 -2 LDG02200 MDX *-5 LDG02210 LD L IEZ DETERMINE LOCATION LDG02220 A L IEZ IN BUFFER LDG02230 STO L DUMY LDG02240 LDX I2 DUMY LDG02250 LD L ININX LDG02260 A L FX20 LDG02270 A L DUMY LDG02280 S L TWO LDG02290 STO L DUMY LDG02300 LDX I1 DUMY LDG02310 LDD L2 IZ-2 MOVE FROM IZ LDG02320 STD L1 WKIO TO BUFFER LDG02330 MDX 1 -2 LDG02340 MDX 2 -2 LDG02350 MDX *-7 LDG02360 LDX I1 ININX GATHER INFO FOR LDG02370 LD L KCOLZ COLUMN HEADER LDG02380 STO L1 WKIO LDG02390 LD L IBZ LDG02400 STO L1 WKIO+1 LDG02410 LD L IEZ LDG02420 STO L1 WKIO&2 LDG02430 LIBF DISKN LDG02440 DC /4000 LDG02450 DC WKIO LDG02460 BSC I WRTGR LDG02470 *************** LDG02480 * WRTOU SUBROUTINE LDG02490 *************** LDG02500 WRTOU NOP RETURN ADDRESS LDG02510 LDX 1 22 WRITE MASTER HEADER LDG02520 LDX 2 20 RECORD FOR OUTPUT LDG02530 LDD L ZNIL GRID DATA SET LDG02540 STD L1 WKIO-2 LDG02550 MDX 1 -2 LDG02560 MDX 2 -2 LDG02570 MDX *-5 LDG02580 LD L SCBGN TEST FOR ADEQUATE ROOM LDG02590 A L SCLGT ON DISK LDG02600 S L SCSTR LDG02610 M L THREE LDG02620 D L FOUR LDG02630 S L MXCOL LDG02640 BSC L NOROM,Z+ LDG02650 LD L FX20 LDG02660 STO L WKIO LDG02670 LD L SCSTR LDG02680 STO L WKIO+1 LDG02690 LDD L ANAME LDG02700 STD L WKIO+2 LDG02710 LDD L GRID LDG02720 STD L WKIO+4 LDG02730 LD L MXCOL LDG02740 STO L WKIO&6 LDG02750 LD L MXROW LDG02760 STO L WKIO&7 LDG02770 LDD L XMIN LDG02780 STD L WKIO+8 LDG02790 LDD L YMIN LDG02800 STD L WKIO+10 LDG02810 LIBF DISKN LDG02820 DC /5000 LDG02830 DC WKIO LDG02840 DC ERRS LDG02850 LIBF DISKN LDG02860 DC /4000 LDG02870 DC WKIO LDG02880 LIBF DISKN LDG02890 DC /0000 LDG02900 DC WKIO LDG02910 MDX *-4 LDG02920 BSC I WRTOU RETURN LDG02930 NOROM BSI L ERTYP TYPE NO ROOM MESSAGE LDG02940 DC MSAGC LDG02950 BSI L ERTYP LDG02960 DC MSAGB LDG02970 WAIT LDG02980 EXIT LDG02990 *************** LDG03000 * SUBROUTINE LOCAT TO READ GRID INTERVAL, ICMAX LDG03010 * IRMAX FROM A CARD IN HEXADECIMAL AND CONVERT LDG03020 * TO INTERNAL BINARY NUMBERS LDG03030 *************** LDG03040 LOCAS NOP RETURN ADDRESS LDG03050 LD L FXD32 READ MASTER HEADER LDG03060 STO L INPTA CARD AND CONVERT LDG03070 *************** LDG03080 LIBF CARD0 PARAMETERS TO BINARY LDG03090 * LIBF READ0 PARAMETERS TO BINARY LDG03100 DC /0000 LDG03110 MDX *-3 LDG03120 *************** LDG03130 *************** LDG03140 LIBF CARD0 LDG03150 * LIBF READ0 LDG03160 *************** LDG03170 DC /1000 LDG03180 DC INPTA LDG03190 *************** LDG03200 LIBF CARD0 LDG03210 * LIBF READ0 LDG03220 *************** LDG03230 DC /0000 LDG03240 MDX *-3 LDG03250 LIBF HXBIN LDG03260 DC INPTA&1 LDG03270 STO L GRID LDG03280 LIBF HXBIN LDG03290 DC INPTA+5 LDG03300 STO L GRID+1 LDG03310 LIBF HXBIN LDG03320 DC INPTA+9 LDG03330 STO L MXCOL LDG03340 LIBF HXBIN LDG03350 DC INPTA+13 LDG03360 STO L MXROW LDG03370 LIBF HXBIN LDG03380 DC INPTA+17 LDG03390 STO L XMIN LDG03400 LIBF HXBIN LDG03410 DC INPTA+21 LDG03420 STO L XMIN+1 LDG03430 LIBF HXBIN LDG03440 DC INPTA+25 LDG03450 STO L YMIN LDG03460 LIBF HXBIN LDG03470 DC INPTA+29 LDG03480 STO L YMIN+1 LDG03490 BSC I LOCAS RETURN LDG03500 *************** LDG03510 * GRDVA SUBROUTINE TO READ HEXADECIMAL GRID LDG03520 * VALUES, TEN PER CARD,AND STORE AS INTERNAL LDG03530 * FLOATING POINT NUMBERS LDG03540 *************** LDG03550 GRDVS NOP RETURN ADDRESS LDG03560 LD L TWELV READ COLUMN HEADER LDG03570 STO L INPTA CARD AND CONVERT LDG03580 *************** LDG03590 LIBF CARD0 TO BINARY LDG03600 * LIBF READ0 TO BINARY LDG03610 *************** LDG03620 DC /0000 LDG03630 MDX *-3 LDG03640 *************** LDG03650 LIBF CARD0 LDG03660 * LIBF READ0 LDG03670 *************** LDG03680 DC /1000 LDG03690 DC INPTA LDG03700 *************** LDG03710 LIBF CARD0 LDG03720 * LIBF READ0 LDG03730 *************** LDG03740 DC /0000 LDG03750 MDX *-3 LDG03760 LIBF HXBIN LDG03770 DC INPTA&1 LDG03780 STO L KCOLZ LDG03790 LIBF HXBIN LDG03800 DC INPTA&5 LDG03810 STO L IBZ LDG03820 LIBF HXBIN LDG03830 DC INPTA&9 LDG03840 STO L IEZ LDG03850 M L TWO INITIALIZE FOR LDG03860 D L ONE READING A COLUMN LDG03870 STO L DREND OF GRID VALUES LDG03880 LD L FXD80 LDG03890 STO L INPTA LDG03900 LDX 2 0 LDG03910 *************** LDG03920 LOP10 LIBF CARD0 LDG03930 *OP10 LIBF READ0 LDG03940 *************** LDG03950 DC /0000 LDG03960 MDX *-3 LDG03970 *************** LDG03980 LIBF CARD0 LDG03990 * LIBF READ0 LDG04000 *************** LDG04010 DC /1000 LDG04020 DC INPTA LDG04030 *************** LDG04040 LIBF CARD0 LDG04050 * LIBF READ0 LDG04060 *************** LDG04070 DC /0000 LDG04080 MDX *-3 LDG04090 LDX 1 1 LDG04100 LOP11 LDD L1 INPTA CONVERT ONE GRID LDG04110 STD L DUMM VALUE TO BINARY LDG04120 LDD L1 INPTA&2 LDG04130 STD L DUMM&2 LDG04140 LIBF HXBIN LDG04150 DC DUMM LDG04160 STO L2 IZ LDG04170 MDX 1 4 LDG04180 MDX 2 1 LDG04190 STX L2 DUMN IS THIS LAST VALUE? LDG04200 LD L DUMN LDG04210 S L DREND LDG04220 BSC L FINA,Z- YES, BRANCH LDG04230 STX L1 DUMN IS THIS LAST VALUE LDG04240 LD L DUMN FOR THIS CARD? LDG04250 S L FXD80 LDG04260 BSC L LOP11,& NO, RETURN LDG04270 BSC L LOP10 YES, READ ANOTHER CARD LDG04280 FINA BSC I GRDVS RETURN LDG04290 *************** LDG04300 * REWRT SUBROUTINE LDG04310 *************** LDG04320 REWRT NOP RETURN ADDRESS LDG04330 LD L ICMAX WRITE TRAILER RECORD LDG04340 M L FOUR IN GRID DATA SET AREA LDG04350 STD L DUMY LDG04360 D L THREE DETERMINE TRAILER LOCATION LDG04370 STO L SCINC LDG04380 M L THREE LDG04390 D L ONE LDG04400 S L DUMY+1 LDG04410 BSC L AA2,- LDG04420 A L FOUR LDG04430 A L SCINC LDG04440 STO L SCINC LDG04450 AA2 LD L SCINC WRITE TRAILER LDG04460 A L SCSTR LDG04470 STO L XXXX LDG04480 LIBF DISKN LDG04490 DC /0000 LDG04500 DC WKIO LDG04510 MDX *-4 LDG04520 LD L XXXX LDG04530 STO L WKIO+1 LDG04540 LD L TWO LDG04550 STO L WKIO LDG04560 LDD L TRAIL LDG04570 STD L WKIO+2 LDG04580 LIBF DISKN LDG04590 DC /5000 LDG04600 DC WKIO LDG04610 DC ERRS LDG04620 LIBF DISKN LDG04630 DC /4000 LDG04640 DC WKIO LDG04650 LIBF DISKN LDG04660 DC /0000 LDG04670 DC WKIO LDG04680 MDX *-4 LDG04690 BSC I REWRT RETURN LDG04700 ERRS DC 0 DISK ERROR LDG04710 BSI L ERTYP LDG04720 DC MSAGS LDG04730 SRA 16 LDG04740 BSC I ERRS LDG04750 EROB BSI L ERTYP TRAILER NOT FOUND LDG04760 DC MSAGA OR DATA SET AREA LDG04770 BSI L ERTYP LIMITS EXCEEDED LDG04780 DC MSAGB LDG04790 WAIT LDG04800 EXIT LDG04810 *************** LDG04820 * ERTYP SUBROUTINE LDG04830 *************** LDG04840 ERTYP NOP SUBROUTINE TO LDG04850 LD I ERTYP WRITE MESSAGES LDG04860 STO L ERTX ON THE CONSOLE LDG04870 MDX L ERTYP,&1 TYPEWRITER LDG04880 LD L ERTX LDG04890 S L ONE LDG04900 STO *&1 LDG04910 LD L 0 LDG04920 STO L ERTX+2 LDG04930 M L ONE LDG04940 D L TWO LDG04950 STO L TYPE LDG04960 LIBF EBPRT LDG04970 DC /0000 LDG04980 ERTX DC 0 LDG04990 DC TYPE+1 LDG05000 DC 0 LDG05010 LIBF WRTY0 LDG05020 DC /2000 LDG05030 DC TYPE LDG05040 LIBF WRTY0 LDG05050 DC /2000 LDG05060 DC CONTL LDG05070 LIBF WRTY0 LDG05080 DC /0000 LDG05090 MDX *-3 LDG05100 BSC I ERTYP RETURN LDG05110 *************** LDG05120 * ERROR MESSAGE CONSTANTS AND STORAGE LDG05130 *************** LDG05140 CONTL DC 1 RETURN CARRIAGE LDG05150 DC /8301 LDG05160 TYPE BSS E 30 MESSAGE AREA LDG05170 DC 36 LDG05180 MSAGS EBC .DISK ERROR. LDG05190 EBC . TERMINATE JOB AND RESTART. LDG05200 DC 16 LDG05210 BMESS EBC .LODAG BEGINNING . LDG05220 DC 14 LDG05230 EMESS EBC .LODAG COMPLETE. LDG05240 DC 30 LDG05250 MSAGA EBC .UNABLE TO FIND TRAILER RECORD . LDG05260 DC 30 LDG05270 MSAGB EBC .PUSH START FOR EXIT TO MONITOR. LDG05280 DC 26 LDG05290 NUMSG EBC .NAME ALREADY USED ON DISK. LDG05300 DC 54 LDG05310 MSAGC EBC .REQUIRED NUMBER OF COLUMNS. LDG05320 EBC .EXCEEDS AVAILABLE DISK AREA . LDG05330 DC 22 LDG05340 MSAG2 EBC .OUTPUT GRID NAMED . LDG05350 DC /4040 LDG05360 DC /4040 LDG05370 *************** LDG05380 * CONSTANTS LDG05390 *************** LDG05400 SCBGN DC 448 LDG05410 SCLGT DC 808 NO OF SECTORS IN D. S. LDG05420 ZERO DC 0 AREA LDG05430 ONE DC 1 LDG05440 TWO DC 2 LDG05450 THREE DC 3 LDG05460 FOUR DC 4 LDG05470 FIVE DC 5 LDG05480 SIX DC 6 LDG05490 SEVEN DC 7 LDG05500 TWELV DC 12 LDG05510 FX15 DC 15 LDG05520 FX19 DC 19 LDG05530 FX20 DC 20 LDG05540 FX22 DC 22 LDG05550 FXD32 DC 32 LDG05560 FXD80 DC 80 LDG05570 FX100 DC 100 LDG05580 FX272 DC 272 LDG05590 FX280 DC 280 LDG05600 FX400 DC 400 LDG05610 FX402 DC 402 LDG05620 FX418 DC 418 LDG05630 FX420 DC 420 LDG05640 FX422 DC 422 LDG05650 FX640 DC 640 LDG05660 FX808 DC 808 LDG05670 ZNIL DEC -1.0E30 LDG05680 TRAIL DEC 9999. LDG05690 XXXX DC /FFFF LDG05700 YYYY DC /EEEE LDG05710 *************** LDG05720 * STORAGE LDG05730 *************** LDG05740 DUMM BSS E 4 TEMP STORAGE LDG05750 DUMN BSS 1 LDG05760 DIRMX BSS 1 2*MXROW LDG05770 GRID BSS E 2 GRID INTERVAL LDG05780 XMIN BSS E 2 LDG05790 YMIN BSS E 2 LDG05800 THCOL BSS 1 COLUMN NO. LDG05810 IBZ BSS 1 BEGINNING ROW LDG05820 IEZ BSS 1 ENDING ROW LDG05830 ICOL BSS 1 TEMP STORAGE LDG05840 K BSS 1 LDG05850 KCOL BSS 1 LDG05860 KCOLZ BSS 1 LDG05870 MXCOL BSS 1 MAXIMUM COLUMN LDG05880 MXROW BSS 1 MAXIMUM ROW LDG05890 OUTS BSS 1 TEMP STORAGE LDG05900 BSS 12 LDG05910 OUTT BSS 1 LDG05920 BSS 12 LDG05930 BSS E 1 ALINEMENT LDG05940 AA BSS 81 INPUT AREA LDG05950 IZ BSS E 400 COLUMN VECTOR LDG05960 Z BSS E 400 COLUMN VECTOR LDG05970 CHKK BSS 29 TEMP STORAGE LDG05980 CHLL BSS E 16 LDG05990 ANAME BSS E 2 DATA SET NAME LDG06000 BSS E 2 LDG06010 BNAME BSS E 4 LDG06020 DUMY BSS E 2 LDG06030 BSS E 1 ALINEMENT LDG06040 INPTA BSS 81 LDG06050 DREND BSS E 2 LDG06060 IFOUN BSS 1 DATA SET LOCATION LDG06070 ININX BSS 1 PARAMETERS LDG06080 IRMIN BSS 1 LDG06090 SCLOC BSS 1 LDG06100 SCINC BSS 1 LDG06110 SCINX BSS 1 LDG06120 SCSTR BSS 1 LDG06130 WKIO BSS E 642 DISK I/O BUFFER LDG06140 *************** LDG06150 * EQUIVALENCES LDG06160 *************** LDG06170 ICMAX EQU MXCOL LDG06180 IRMAX EQU MXROW LDG06190 END GO LDG06200 // DUP LDG06210 *STORE WS UA LODAG LDG06220 // JOB DAO00070 // DUP DAO00080 *DELETE UA DAOUT DAO00090 // ASM DAO00100 *LIST DAO00110 *************** DAO00120 * DAOUT DAO00130 * PROGRAM TO DUMP A SET OF GRID DATA TO CARDS DAO00140 * IN H, E, OR I FORMAT DAO00150 *************** DAO00160 GO LIBF WRTY0 TYPE STARTING MESSAGE DAO00170 DC /2000 DAO00180 DC CONTL DAO00190 BSI L ERTYP DAO00200 DC MSAG1 DAO00210 BSI L NAME READ DATA SET NAME DAO00220 LD L ANAME AND FORMAT DAO00230 STO L MSAG2+6 DAO00240 LD L ANAME+1 DAO00250 STO L MSAG2+7 DAO00260 BSI L ERTYP TYPE DATA SET NAME DAO00270 DC MSAG2 DAO00280 BSI L LOCAT LOCATE DATA SET DAO00290 LD L IFOUN DAO00300 S L ONE DAO00310 BSC L NO,Z BRANCH IF NOT FOUND DAO00320 LD L IFORM DAO00330 S L E DAO00340 BSI L OUTP3,+- BRANCH FOR E FORMAT DAO00350 LD L IFORM DAO00360 S L I DAO00370 BSI L OUTP3,+- BRANCH FOR I FORMAT DAO00380 LD L IFORM DAO00390 S L H DAO00400 BSI L OUTP1,+- BRANCH FOR H FORMAT DAO00410 LD L ZERO DAO00420 STO L THCOL SET COL TO ZERO DAO00430 LLP LD L THCOL DAO00440 A L ONE INCREMENT COL DAO00450 STO L THCOL DAO00460 BSI L GRDVA GET GRID VALUES THIS COL DAO00470 LD L IFORM DAO00480 S L E DAO00490 BSI L OUTP4,+- BRANCH FOR E FORMAT DAO00500 LD L IFORM DAO00510 S L I DAO00520 BSI L OUTP4,+- BRANCH FOR I FORMAT DAO00530 LD L IFORM DAO00540 S L H DAO00550 BSI L OUTP2,+- BRANCH FOR H FORMAT DAO00560 LD L THCOL ARE WE FINISHED DAO00570 S L ICMAX DAO00580 BSC L LLP,Z+ NO, RETURN DAO00590 BSI L ERTYP YES, TYPE COMPLETION MESS DAO00600 DC MSAG3 DAO00610 EXIT DAO00620 *************** DAO00630 * COME HERE IF DATA SET CANNOT BE FOUND DAO00640 *************** DAO00650 NO BSI L ERTYP DAO00660 DC MSAG6 DAO00670 BSI L ERTYP DAO00680 DC MSAG4 DAO00690 WAIT DAO00700 EXIT DAO00710 *************** DAO00720 * NAME SUBROUTINE DAO00730 * READ CARD CONTAINING NAME AND FORMAT DAO00740 *************** DAO00750 NAME NOP RETURN ADDRESS DAO00760 LD L TEN DAO00770 STO L BNAME-1 DAO00780 *************** DAO00790 LIBF CARD0 DAO00800 * LIBF READ0 DAO00810 *************** DAO00820 DC /0000 DAO00830 MDX *-3 DAO00840 *************** DAO00850 LIBF CARD0 DAO00860 * LIBF READ0 DAO00870 *************** DAO00880 DC /1000 DAO00890 DC BNAME-1 DAO00900 *************** DAO00910 LIBF CARD0 DAO00920 * LIBF READ0 DAO00930 *************** DAO00940 DC /0000 DAO00950 MDX *-3 DAO00960 LIBF SPEED CONVERT NAME DAO00970 DC /0000 DAO00980 DC BNAME DAO00990 DC ANAME DAO01000 DC 4 DAO01010 LIBF SPEED CONVERT FORMAT DAO01020 DC /0000 DAO01030 DC BNAME+9 DAO01040 DC IFORM DAO01050 DC 1 DAO01060 BSC I NAME DAO01070 *************** DAO01080 * LOCAT SUBROUTINE DAO01090 * LOCATE GRID DATA SET ON THE DISK DAO01100 *************** DAO01110 LOCAT NOP RETURN ADDRESS DAO01120 LD L FX20 INITIALIZE DAO01130 STO L WKIO DAO01140 LD L SCBGN DAO01150 STO L WKIO+1 DAO01160 AGN LIBF DISKN READ MASTER DAO01170 DC /5000 HEADER RECORD DAO01180 DC WKIO DAO01190 DC ERRS DAO01200 LIBF DISKN DAO01210 DC /1000 DAO01220 DC WKIO DAO01230 DC ERRS DAO01240 LIBF DISKN DAO01250 DC /0000 DAO01260 DC WKIO DAO01270 MDX *-4 DAO01280 LIBF FLD TEST ROR DAO01290 DC TRAIL TRAILER RECORD DAO01300 LIBF FSUB DAO01310 DC WKIO+2 DAO01320 LIBF FSTO DAO01330 DC DUMY DAO01340 LD L DUMY DAO01350 BSC L OK,+- TRAILER FOUND DAO01360 LIBF FLD DAO01370 DC WKIO+2 DAO01380 LIBF FSUB DAO01390 DC ANAME DAO01400 LIBF FSTO DAO01410 DC DUMY DAO01420 LD L DUMY DAO01430 BSC L FND,+- NAME FOUND DAO01440 LD L WKIO+6 DAO01450 M L FOUR COMPUTE LOCATION OF DAO01460 STD L DUMY NEXT MASTER HEADER DAO01470 D L THREE DAO01480 STO L SCINC DAO01490 M L THREE DAO01500 D L ONE DAO01510 S L DUMY+1 DAO01520 BSC L AA3,- DAO01530 A L FOUR DAO01540 A L SCINC DAO01550 STO L SCINC DAO01560 AA3 LD L WKIO&1 DAO01570 A L SCINC DAO01580 STO L WKIO+1 DAO01590 S L SCBGN DAO01600 BSC L EROB,& OUT OF BOUNDS DAO01610 S L SCLGT DAO01620 BSC L EROB,- OUT OF BOUNDS DAO01630 BSC L AGN TRY AGAIN DAO01640 FND LD L ONE DAO01650 STO L IFOUN DATA SET FOUND DAO01660 LDD L WKIO+4 COLLECT DATA SET DAO01670 STD L GRID PARAMETERS DAO01680 LD L WKIO+6 DAO01690 STO L ICMAX DAO01700 LD L WKIO+7 DAO01710 STO L IRMAX DAO01720 LDD L WKIO+8 DAO01730 STD L XMIN DAO01740 LDD L WKIO+10 DAO01750 STD L YMIN DAO01760 LD L WKIO&1 DAO01770 STO L SCSTR DAO01780 BSC I LOCAT DAO01790 OK LD L ZERO DATA SET NOT FOUND DAO01800 STO L IFOUN DAO01810 LD L WKIO&1 DAO01820 STO L SCSTR DAO01830 BSC I LOCAT DAO01840 EROB BSI L ERTYP NO TRAILER RECORD DAO01850 DC MSAG7 DAO01860 BSI L ERTYP DAO01870 DC MSAG4 DAO01880 WAIT DAO01890 EXIT DAO01900 ERRS DC 0 DISK ERROR DAO01910 BSI L ERTYP DAO01920 DC MSAG5 DAO01930 SRA 16 DAO01940 BSC I ERRS DAO01950 *************** DAO01960 * SCCOM SUBROUTINE DAO01970 * LOCATE A SPECIFIED COLUMN WITHIN A DATA SET DAO01980 *************** DAO01990 SCCOM NOP RETURN ADDRESS DAO02000 LD L THCOL LOCATION OF THE COLUMN DAO02010 S L ONE DAO02020 M L ONE AND CHECKED TO SEE DAO02030 D L THREE IF IT IS WITHIN THE DAO02040 STO L DUMY AREA SET ASIDE FOR DAO02050 M L FOUR GRID DATA SETS DAO02060 D L ONE DAO02070 STO L SCINC DAO02080 LD L DUMY DAO02090 M L THREE DAO02100 D L ONE DAO02110 STO L DUMY DAO02120 LD L THCOL DAO02130 S L DUMY DAO02140 S L ONE DAO02150 STO L SCINX DAO02160 A L SCINC DAO02170 STO L SCINC DAO02180 A L SCSTR DAO02190 STO L SCLOC DAO02200 S L SCBGN DAO02210 BSC L ER,Z+ OUT OF BOUNDS DAO02220 S L SCLGT DAO02230 BSC L ER,- DAO02240 LD L FX100 DAO02250 M L SCINX DAO02260 D L ONE DAO02270 A L FX22 DAO02280 STO L ININX DAO02290 BSC I SCCOM RETURN DAO02300 ER BSI L ERTYP TYPE ERROR MESSAGE DAO02310 DC MSAG7 DAO02320 BSI L ERTYP DAO02330 DC MSAG4 DAO02340 WAIT DAO02350 EXIT DAO02360 *************** DAO02370 * GRDVA SUBROUTINE DAO02380 * READ A COLUMN OF GRID VALUES INTO THE VECTOR DAO02390 * Z DAO02400 *************** DAO02410 GRDVA NOP RETURN ADDRESS DAO02420 BSI L SCCOM LOCATE COLUMN DAO02430 LD L SCLOC DAO02440 STO L WKIO&1 DAO02450 LD L FX640 DAO02460 STO L WKIO DAO02470 LIBF DISKN READ COLUMN DAO02480 DC /5000 DAO02490 DC WKIO DAO02500 DC ERRM DAO02510 LIBF DISKN DAO02520 DC /1000 DAO02530 DC WKIO DAO02540 DC ERRM DAO02550 LD L ININX DAO02560 A L FX418 DAO02570 STO L DUMY DAO02580 LDX I1 DUMY DAO02590 LDX I2 FX400 DAO02600 LIBF DISKN DAO02610 DC /0000 DAO02620 DC WKIO DAO02630 MDX *-4 DAO02640 LDD L1 WKIO MOVE TO DAO02650 STD L2 Z-2 Z VECTOR DAO02660 MDX 1 -2 DAO02670 MDX 2 -2 DAO02680 MDX *-7 DAO02690 LDX I1 ININX DAO02700 LD L1 WKIO MOVE COLUMN DAO02710 STO L K PARAMETERS DAO02720 LD L1 WKIO+1 DAO02730 STO L IRMIN DAO02740 LD L1 WKIO+2 DAO02750 STO L IRMAX DAO02760 BSC I GRDVA DAO02770 ERRM DC 0 DISKERROR DAO02780 BSI L ERTYP DAO02790 DC MSAG5 DAO02800 WAIT DAO02810 BSC L GRDVA&1 DAO02820 *************** DAO02830 * OUTP1 SUBROUTINE DAO02840 * PUNCH MASTER HEADER CARD IN H FORMAT DAO02850 *************** DAO02860 OUTP1 NOP DAO02870 *************** DAO02880 LIBF CARD0 FEED THE FIRST CARD DAO02890 * LIBF PNCH0 FEED THE FIRST CARD DAO02900 ************** DAO02910 DC /3000 TO THE PUNCH DAO02920 LD L GRID DAO02930 LIBF BINHX AND STORE IN OUTS DAO02940 DC OUTS&1 DAO02950 LD L GRID+1 DAO02960 LIBF BINHX DAO02970 DC OUTS&5 AND STORE IN OUTS DAO02980 LD L ICMAX CONVERT THE MAXIMUM DAO02990 LIBF BINHX NUMBER OF COLUMNS DAO03000 DC OUTS&9 STORE IN OUTS DAO03010 LD L IRMAX CONVERT THE MAXIMUM DAO03020 LIBF BINHX NUMBER OF ROWS AND DAO03030 DC OUTS+13 DAO03040 LD L XMIN DAO03050 LIBF BINHX DAO03060 DC OUTS+17 DAO03070 LD L XMIN+1 DAO03080 LIBF BINHX DAO03090 DC OUTS+21 DAO03100 LD L YMIN DAO03110 LIBF BINHX DAO03120 DC OUTS+25 DAO03130 LD L YMIN+1 DAO03140 LIBF BINHX DAO03150 DC OUTS+29 DAO03160 LD L FX32 STORE THE WORD NUMBER DAO03170 STO L OUTS IN OUTS DAO03180 *************** DAO03190 LIBF CARD0 TEST TO SEE IF CARD DAO03200 * LIBF PNCH0 TEST TO SEE IF CARD DAO03210 *************** DAO03220 DC /0000 HAS FINISHED FEEDING DAO03230 MDX *-3 TO PUNCHING STATION DAO03240 *************** DAO03250 LIBF CARD0 DAO03260 DC /4000 DAO03270 *************** DAO03280 *************** DAO03290 LIBF CARD0 PUNCH THE DATA STORED DAO03300 * LIBF PNCH0 PUNCH THE DATA STORED DAO03310 *************** DAO03320 DC /2000 IN OUTS INTO THE DAO03330 DC OUTS CARD DAO03340 BSC I OUTP1 DAO03350 *************** DAO03360 * OUTP2 SUBROUTINE DAO03370 * PUNCH ONE COLUMN OF DATA IN H FORMAT DAO03380 *************** DAO03390 OUTP2 NOP DAO03400 LD L IRMAX DAO03410 A L IRMAX DAO03420 STO L DIRMX DAO03430 LD L K CONVERT THE COLUMN DAO03440 LIBF BINHX NUMBER AND STORE DAO03450 DC OUTT&1 IN OUTT DAO03460 LD L ONE CONVERT THE BEGINNING DAO03470 LIBF BINHX ROW NUMBER AND STORE DAO03480 DC OUTT&5 IN OUTT DAO03490 LD L IRMAX CONVERT THE ENDING DAO03500 LIBF BINHX ROW NUMBER AND STORE DAO03510 DC OUTT&9 IN OUTT DAO03520 LD L TWELV STORE THE WORD NUMBER DAO03530 STO L OUTT IN OUTT DAO03540 *************** DAO03550 LIBF CARD0 TEST TO SEE IF CARD DAO03560 * LIBF PNCH0 TEST TO SEE IF CARD DAO03570 *************** DAO03580 DC /0000 HAS FINISHED FEEDING DAO03590 MDX *-3 TO PUNCHING STATION DAO03600 *************** DAO03610 LIBF CARD0 DAO03620 DC /4000 DAO03630 *************** DAO03640 *************** DAO03650 LIBF CARD0 PUNCH THE DATA STORED DAO03660 * LIBF PNCH0 PUNCH THE DATA STORED DAO03670 *************** DAO03680 DC /2000 IN OUTT INTO THE DAO03690 DC OUTT FIRST CARD DAO03700 *************** DAO03710 LIBF CARD0 DAO03720 * LIBF PNCH0 DAO03730 *************** DAO03740 DC /0000 DAO03750 MDX *-3 DAO03760 LD L FXD80 LOAD THE NUMBER OF DAO03770 STO L AA WORDS INTO AA DAO03780 LDX 2 0 DAO03790 LOOP7 LDX 1 1 DAO03800 LOOP8 LD L2 Z TAKE THE VALUE OF Z DAO03810 LIBF BINHX FROM THE STORAGE DAO03820 DC DUMM LOCATION MODIFIED BY DAO03830 LDD L DUMM IR2, CONVERT IT TO DAO03840 STD L1 AA HEXADECIMAL FORM AND DAO03850 MDX 1 2 STORE THE RESULTING DAO03860 LDD L DUMM&2 FOUR HEXADECIMAL DAO03870 STD L1 AA CARD CODED DIGITS IN DAO03880 MDX 1 2 THE FOUR CONSECUTIVE DAO03890 MDX 2 1 LOCATIONS BEGINNING DAO03900 STX L2 DUMN AT LOCATION AA DAO03910 LD L DUMN DAO03920 S L DIRMX VALUE OF IR1 DAO03930 BSC L FINAL,- DAO03940 STX L1 DUMN DAO03950 LD L DUMN DAO03960 S L FXD80 UNTIL 80 DIGITS ARE DAO03970 BSC L LOOP8,Z& STORED IN AA DAO03980 *************** DAO03990 LIBF CARD0 TEST TO SEE IF CARD DAO04000 * LIBF PNCH0 TEST TO SEE IF CARD DAO04010 *************** DAO04020 DC /0000 HAS FINISHED FEEDING DAO04030 MDX *-3 TO PUNCHING STATION DAO04040 *************** DAO04050 LIBF CARD0 DAO04060 DC /4000 DAO04070 *************** DAO04080 *************** DAO04090 LIBF CARD0 PUNCH THE DATA FROM DAO04100 * LIBF PNCH0 PUNCH THE DATA FROM DAO04110 *************** DAO04120 DC /2000 AA INTO THE CARD DAO04130 DC AA BEGIN PROCESSING THE DAO04140 *************** DAO04150 LIBF CARD0 DAO04160 * LIBF PNCH0 DAO04170 *************** DAO04180 DC /0000 DAO04190 MDX *-3 DAO04200 BSC L LOOP7 DAO04210 FINAL STX L1 DUMN IF WE CONVERT THE DAO04220 LD L DUMN DAO04230 S L ONE COLUMN BEFORE WE DAO04240 STO L AA OBTAIN 80 DIGITS, DAO04250 *************** DAO04260 LIBF CARD0 WE BRANCH TO FINAL DAO04270 * LIBF PNCH0 WE BRANCH TO FINAL DAO04280 *************** DAO04290 DC /0000 WHICH ADJUSTS THE DAO04300 MDX *-3 WORD COUNT IN DAO04310 *************** DAO04320 LIBF CARD0 DAO04330 DC /4000 DAO04340 *************** DAO04350 *************** DAO04360 LIBF CARD0 LOCATION AA AND THEN DAO04370 * LIBF PNCH0 LOCATION AA AND THEN DAO04380 *************** DAO04390 DC /2000 PUNCHES THE LAST DAO04400 DC AA CARD AFTER TESTING DAO04410 *************** DAO04420 LIBF CARD0 DAO04430 * LIBF PNCH0 DAO04440 *************** DAO04450 DC /0000 DAO04460 MDX *-3 DAO04470 BSC I OUTP2 IS FINISHED DAO04480 *************** DAO04490 * OUTP3 SUBROUTINE DAO04500 * PUNCH MASTER HEADER IN I FORMAT DAO04510 *************** DAO04520 OUTP3 NOP DAO04530 *************** DAO04540 LIBF CARD0 FEED A CARD DAO04550 * LIBF PNCH0 FEED A CARD DAO04560 *************** DAO04570 DC /3000 DAO04580 *************** DAO04590 LIBF CARD0 DAO04600 * LIBF PNCH0 DAO04610 *************** DAO04620 DC /0000 DAO04630 MDX *-3 DAO04640 LD L IFORM DAO04650 S L E DAO04660 BSC L OUTP5,+- BRANCH FOR E FORMAT DAO04670 LDX 1 36 CLEAR BUFFER DAO04680 LD L ZERO DAO04690 BLOOP STO L1 OUTS DAO04700 MDX 1 -1 DAO04710 MDX BLOOP DAO04720 LIBF FLD CONVERT PARAMETERS DAO04730 DC GRID AND PLACE IN BUFFER DAO04740 LIBF IFIX DAO04750 LIBF BINDC DAO04760 DC OUTS DAO04770 LD L ICMAX DAO04780 LIBF BINDC DAO04790 DC DUMM DAO04800 LD L DUMM+3 DAO04810 STO L OUTS+8 DAO04820 LD L DUMM+4 DAO04830 STO L OUTS+9 DAO04840 LD L DUMM+5 DAO04850 STO L OUTS+10 DAO04860 LD L IRMAX DAO04870 LIBF BINDC DAO04880 DC DUMM DAO04890 LD L DUMM+3 DAO04900 STO L OUTS+13 DAO04910 LD L DUMM+4 DAO04920 STO L OUTS+14 DAO04930 LD L DUMM+5 DAO04940 STO L OUTS+15 DAO04950 LIBF FLD DAO04960 DC XMIN DAO04970 LIBF IFIX DAO04980 LIBF BINDC DAO04990 DC OUTS+20 DAO05000 LIBF FLD DAO05010 DC YMIN DAO05020 LIBF IFIX DAO05030 LIBF BINDC DAO05040 DC OUTS+30 DAO05050 LD L FX32 DAO05060 A L THREE DAO05070 STO L OUTS DAO05080 *************** DAO05090 RETN LIBF CARD0 PUNCH MASTER HEADER DAO05100 *ETN LIBF PNCH0 PUNCH MASTER HEADER DAO05110 *************** DAO05120 DC /0000 DAO05130 MDX *-3 DAO05140 *************** DAO05150 LIBF CARD0 DAO05160 DC /4000 DAO05170 *************** DAO05180 *************** DAO05190 LIBF CARD0 DAO05200 * LIBF PNCH0 DAO05210 *************** DAO05220 DC /2000 DAO05230 DC OUTS DAO05240 BSC I OUTP3 RETURN DAO05250 *************** DAO05260 * OUTP4 SUBROUTINE DAO05270 * PUNCH COLUMN HEADER FOR I AND E FORMATS DAO05280 *************** DAO05290 OUTP4 NOP DAO05300 LD L IRMAX DAO05310 A L IRMAX DAO05320 STO L DIRMX DAO05330 LD L K DAO05340 LIBF BINDC DAO05350 DC DUMM DAO05360 LD L DUMM+3 DAO05370 STO L OUTT+2 DAO05380 LD L DUMM+4 DAO05390 STO L OUTT+3 DAO05400 LD L DUMM+5 DAO05410 STO L OUTT+4 DAO05420 LD L ONE DAO05430 LIBF BINDC DAO05440 DC DUMM DAO05450 LD L DUMM+3 DAO05460 STO L OUTT+7 DAO05470 LD L DUMM+4 DAO05480 STO L OUTT+8 DAO05490 LD L DUMM+5 DAO05500 STO L OUTT+9 DAO05510 LD L IRMAX DAO05520 LIBF BINDC DAO05530 DC DUMM DAO05540 LD L DUMM+3 DAO05550 STO L OUTT+12 DAO05560 LD L DUMM+4 DAO05570 STO L OUTT+13 DAO05580 LD L DUMM+5 DAO05590 STO L OUTT+14 DAO05600 LD L ZERO DAO05610 STO L OUTT+1 DAO05620 STO L OUTT+5 DAO05630 STO L OUTT+6 DAO05640 STO L OUTT+10 DAO05650 STO L OUTT+11 DAO05660 LD L TWELV DAO05670 A L TWO DAO05680 STO L OUTT DAO05690 *************** DAO05700 LIBF CARD0 DAO05710 * LIBF PNCH0 DAO05720 *************** DAO05730 DC /0000 DAO05740 MDX *-3 DAO05750 *************** DAO05760 LIBF CARD0 DAO05770 DC /4000 DAO05780 *************** DAO05790 *************** DAO05800 LIBF CARD0 DAO05810 * LIBF PNCH0 DAO05820 *************** DAO05830 DC /2000 DAO05840 DC OUTT DAO05850 *************** DAO05860 LIBF CARD0 DAO05870 * LIBF PNCH0 DAO05880 *************** DAO05890 DC /0000 DAO05900 MDX *-3 DAO05910 LD L IFORM DAO05920 S L E DAO05930 BSC L OUTP6,+- BRANCH FOR E FORMAT DAO05940 *************** DAO05950 * PUNCH ONE COLUMN OF DATA IN I FORMAT DAO05960 *************** DAO05970 LD L FXD75 DAO05980 STO L AA DAO05990 LDX 1 0 INIT INDEXES DAO06000 LOP77 LDX 2 1 DAO06010 LOP88 LIBF FLDX LOAD GRID VALUE DAO06020 DC Z DAO06030 LIBF IFIX CONVERT TO DECIMAL DAO06040 LIBF BINDC DAO06050 DC DUMM DAO06060 BSC L SKIP,- IF MINUS, PLACE MINUS DAO06070 LD L DUMM SIGN AS FIRST CHAR DAO06080 STO L2 AA DAO06090 MDX SKIP1 DAO06100 SKIP LD L DUMM+1 DAO06110 STO L2 AA DAO06120 SKIP1 LD L DUMM+2 DAO06130 STO L2 AA+1 DAO06140 LD L DUMM+3 DAO06150 STO L2 AA+2 DAO06160 LD L DUMM+4 DAO06170 STO L2 AA+3 DAO06180 LD L DUMM+5 DAO06190 STO L2 AA+4 DAO06200 MDX 2 5 BUMP LOCATION IN BUFFER DAO06210 MDX 1 2 BUMP TO NEXT GRID VALUE DAO06220 STX L1 DUMN DAO06230 LD L DUMN DAO06240 S L DIRMX DAO06250 BSC L FINAA,- BRANCH IF LAST ROW DAO06260 STX L2 DUMN DAO06270 LD L DUMN DAO06280 S L FXD75 DAO06290 BSC L LOP88,Z+ BRANCH IF CARD NOT FULL DAO06300 *************** DAO06310 LIBF CARD0 PUNCH GRID VALUE CARD DAO06320 * LIBF PNCH0 PUNCH GRID VALUE CARD DAO06330 *************** DAO06340 DC /0000 DAO06350 MDX *-3 DAO06360 *************** DAO06370 LIBF CARD0 DAO06380 DC /4000 DAO06390 *************** DAO06400 *************** DAO06410 LIBF CARD0 DAO06420 * LIBF PNCH0 DAO06430 *************** DAO06440 DC /2000 DAO06450 DC AA DAO06460 *************** DAO06470 LIBF CARD0 DAO06480 * LIBF PNCH0 DAO06490 *************** DAO06500 DC /0000 DAO06510 MDX *-3 DAO06520 BSC L LOP77 RETURN DAO06530 FINAA STX L2 DUMN COME HERE AFTER DAO06540 LD L DUMN LAST ROW DAO06550 S L ONE DAO06560 STO L AA DAO06570 *************** DAO06580 LIBF CARD0 PUNCH LAST CARD DAO06590 * LIBF PNCH0 PUNCH LAST CARD DAO06600 *************** DAO06610 DC /0000 FOR THIS COLUMN DAO06620 MDX *-3 DAO06630 *************** DAO06640 LIBF CARD0 DAO06650 DC /4000 DAO06660 *************** DAO06670 *************** DAO06680 LIBF CARD0 DAO06690 * LIBF PNCH0 DAO06700 *************** DAO06710 DC /2000 DAO06720 DC AA DAO06730 *************** DAO06740 LIBF CARD0 DAO06750 * LIBF PNCH0 DAO06760 *************** DAO06770 DC /0000 DAO06780 MDX *-3 DAO06790 BSC I OUTP4 RETURN DAO06800 *************** DAO06810 * PUNCH ONE COLUMN OF DATA IN E FORMAT DAO06820 *************** DAO06830 OUTP6 LD L FXD80 DAO06840 STO L AA DAO06850 LDX 1 0 DAO06860 LO777 LD L ADRAA INITIALIZE ADDRESS DAO06870 STO L ADR+1 DAO06880 LO888 LIBF FLDX LOAD GRID VALUE DAO06890 DC Z DAO06900 CALL FBTD CONVERT TO DECIMAL DAO06910 DC AREA DAO06920 LDX 2 0 DAO06930 ALOOP LD L2 AREA SHIFT TO LEFT HALF WORD DAO06940 SLA 8 FOR SPEED ROUTINE DAO06950 ADR STO L2 AA+1 DAO06960 MDX 2 1 DAO06970 STX L2 DUMN DAO06980 LD L DUMN DAO06990 S L SIXTN DAO07000 BSC L ALOOP,Z+ DAO07010 MDX 1 2 BUMP TO NEXT GRID VALUE DAO07020 LD L ADR+1 INCREMENT ADDRESS DAO07030 A L SIXTN DAO07040 STO L ADR+1 DAO07050 STX L1 DUMN DAO07060 LD L DUMN DAO07070 S L DIRMX DAO07080 BSC L FIAAA,- BRANCH IF LAST ROW DAO07090 LD L ADR+1 DAO07100 S L ADRAB DAO07110 BSC L LO888,Z+ BRANCH IF CARD NOT COMPL DAO07120 LIBF SPEED CONVERT ENTIRE CARD DAO07130 DC /0011 AND PUNCH DAO07140 DC AA+1 DAO07150 DC AA+1 DAO07160 DC 80 DAO07170 *************** DAO07180 LIBF CARD0 DAO07190 * LIBF PNCH0 DAO07200 *************** DAO07210 DC /0000 DAO07220 MDX *-3 DAO07230 *************** DAO07240 LIBF CARD0 DAO07250 DC /4000 DAO07260 *************** DAO07270 *************** DAO07280 LIBF CARD0 DAO07290 * LIBF PNCH0 DAO07300 *************** DAO07310 DC /2000 DAO07320 DC AA DAO07330 *************** DAO07340 LIBF CARD0 DAO07350 * LIBF PNCH0 DAO07360 *************** DAO07370 DC /0000 DAO07380 MDX *-3 DAO07390 BSC L LO777 DAO07400 FIAAA LD L ADR+1 COME HERE FOR LAST ROW DAO07410 S L ADRAA DAO07420 STO L AA DAO07430 LIBF SPEED CONVERT LAST CARD DAO07440 DC /0011 DAO07450 DC AA+1 DAO07460 DC AA+1 DAO07470 DC 80 DAO07480 *************** DAO07490 LIBF CARD0 PUNCH THE CARD DAO07500 * LIBF PNCH0 PUNCH THE CARD DAO07510 *************** DAO07520 DC /0000 DAO07530 MDX *-3 DAO07540 *************** DAO07550 LIBF CARD0 DAO07560 DC /4000 DAO07570 *************** DAO07580 *************** DAO07590 LIBF CARD0 DAO07600 * LIBF PNCH0 DAO07610 *************** DAO07620 DC /2000 DAO07630 DC AA DAO07640 *************** DAO07650 * LIBF PNCH0 DAO07670 LIBF CARD0 DAO07660 *************** DAO07680 DC /0000 DAO07690 MDX *-3 DAO07700 BSC I OUTP4 RETURN DAO07710 *************** DAO07720 * OUTP5 SUBROUTINE DAO07730 * PUNCH MASTER HEADER CARD IN E FORMAT DAO07740 *************** DAO07750 OUTP5 LDX 1 65 DAO07760 LD L EBCZ DAO07770 CLOOP STO L1 OUTS DAO07780 MDX 1 -1 DAO07790 MDX CLOOP DAO07800 LIBF FLD CONVERT PARAMETERS DAO07810 DC GRID DAO07820 CALL FBTD DAO07830 DC AREA DAO07840 LDX 1 15 SHIFT FOR SPEED DAO07850 DLOOP LD L1 AREA-1 ROUTINE DAO07860 SLA 8 DAO07870 STO L1 OUTS DAO07880 MDX 1 -1 DAO07890 MDX DLOOP DAO07900 LIBF FLD DAO07910 DC XMIN DAO07920 CALL FBTD DAO07930 DC AREA DAO07940 LDX 1 15 DAO07950 ELOOP LD L1 AREA-1 DAO07960 SLA 8 DAO07970 STO L1 OUTS+29 DAO07980 MDX 1 -1 DAO07990 MDX ELOOP DAO08000 LIBF FLD DAO08010 DC YMIN DAO08020 CALL FBTD DAO08030 DC AREA DAO08040 LDX 1 15 DAO08050 FLOOP LD L1 AREA-1 DAO08060 SLA 8 DAO08070 STO L1 OUTS+49 DAO08080 MDX 1 -1 DAO08090 MDX FLOOP DAO08100 LIBF SPEED CONVERT TO CARD CODE DAO08110 DC /0011 DAO08120 DC OUTS+1 DAO08130 DC OUTS+1 DAO08140 DC 65 DAO08150 LD L ICMAX DAO08160 LIBF BINDC DAO08170 DC DUMM DAO08180 LD L DUMM+3 DAO08190 STO L OUTS+18 DAO08200 LD L DUMM+4 DAO08210 STO L OUTS+19 DAO08220 LD L DUMM+5 DAO08230 STO L OUTS+20 DAO08240 LD L IRMAX CONVERT OTHER PARAMETERS DAO08250 LIBF BINDC DAO08260 DC DUMM DAO08270 LD L DUMM+3 DAO08280 STO L OUTS+23 DAO08290 LD L DUMM+4 DAO08300 STO L OUTS+24 DAO08310 LD L DUMM+5 DAO08320 STO L OUTS+25 DAO08330 LD L FX64 DAO08340 STO L OUTS DAO08350 BSC L RETN RETURN TO PUNCH CARD DAO08360 *************** DAO08370 * ERTYP SUBROUTINE DAO08380 *************** DAO08390 ERTYP NOP SUBROUTINE TO DAO08400 LD I ERTYP WRITE MESSAGES DAO08410 STO L ERTX ON THE CONSOLE DAO08420 MDX L ERTYP,&1 TYPEWRITER DAO08430 LD L ERTX DAO08440 S L ONE DAO08450 STO *&1 DAO08460 LD L 0 DAO08470 STO L ERTX+2 DAO08480 M L ONE DAO08490 D L TWO DAO08500 STO L TYPE DAO08510 LIBF EBPRT DAO08520 DC /0000 DAO08530 ERTX DC 0 DAO08540 DC TYPE+1 DAO08550 DC 0 DAO08560 LIBF WRTY0 DAO08570 DC /2000 DAO08580 DC TYPE DAO08590 LIBF WRTY0 DAO08600 DC /2000 DAO08610 DC CONTL DAO08620 LIBF WRTY0 DAO08630 DC /0000 DAO08640 MDX *-3 DAO08650 BSC I ERTYP DAO08660 *************** DAO08670 * DEFINE ERROR MESAGES DAO08680 *************** DAO08690 DC 16 DAO08700 MSAG1 EBC .DAOUT BEGINNING . DAO08710 DC 16 DAO08720 MSAG2 EBC .GRID NAMED . DAO08730 BSS 2 DAO08740 DC 16 DAO08750 MSAG3 EBC .DAOUT COMPLETED . DAO08760 DC 30 DAO08770 MSAG4 EBC .PUSH START FOR EXIT TO MONITOR. DAO08780 DC 36 DAO08790 MSAG5 EBC .DISK ERROR. DAO08800 EBC . TERMINATE JOB AND RESTART. DAO08810 DC 26 DAO08820 MSAG6 EBC .NAME WAS NOT FOUND ON DISK. DAO08830 DC 30 DAO08840 MSAG7 EBC .UNABLE TO FIND TRAILER RECORD . DAO08850 CONTL DC 1 DAO08860 DC /8103 DAO08870 *************** DAO08880 * DEFINE CONSTANTS DAO08890 *************** DAO08900 ADRAA DC AA+1 DAO08910 ADRAB DC AA+81 DAO08920 SIXTN DC 16 DAO08930 SCBGN DC 448 DAO08940 SCLGT DC 808 DAO08950 ZERO DC 0 DAO08960 ONE DC 1 DAO08970 TWO DC 2 DAO08980 THREE DC 3 DAO08990 FOUR DC 4 DAO09000 FIVE DC 5 DAO09010 TEN DC 10 DAO09020 TWELV DC 12 DAO09030 FX19 DC 19 DAO09040 FX20 DC 20 DAO09050 FX22 DC 22 DAO09060 FX32 DC 32 DAO09070 FX64 DC 64 DAO09080 FXD75 DC 75 DAO09090 FXD80 DC 80 DAO09100 FX100 DC 100 DAO09110 FX272 DC 272 DAO09120 FX280 DC 280 DAO09130 FX400 DC 400 DAO09140 FX402 DC 402 DAO09150 FX418 DC 418 DAO09160 FX420 DC 420 DAO09170 FX422 DC 422 DAO09180 FX640 DC 640 DAO09190 FX808 DC 808 DAO09200 ZNIL DEC -1.0E30 DAO09210 TRAIL DEC 9999. DAO09220 IFORM DC /0000 DAO09230 H DC /C800 DAO09240 I DC /C900 DAO09250 E DC /C500 DAO09260 EBCZ DC /4000 DAO09270 *************** DAO09280 * ALLOCATE STORAGE DAO09290 *************** DAO09300 AREA BSS 15 CONVERSION AREA DAO09310 DC /0040 FOR SPEED DAO09320 ANAME BSS E 2 DATA SET NAME DAO09330 BSS E 2 DAO09340 BNAME BSS E 10 DECIMAL NAME DAO09350 DUMY BSS E 2 TEMP STORAGE DAO09360 DUMM BSS E 6 DAO09370 DUMN BSS 1 DAO09380 INPTA BSS 81 INPUT BUFFER DAO09390 DIRMX BSS 1 MAX ROW DAO09400 DREND BSS E 2 GRID SET PARAMS DAO09410 GRID BSS E 2 DAO09420 THCOL BSS 1 COL NUMBER DAO09430 IBZ BSS 1 BEG ROW DAO09440 IEZ BSS 1 END ROW DAO09450 ICOL BSS 1 COLUMN DAO09460 IFOUN BSS 1 DAO09470 ININX BSS 1 DATA SET LOCATION DAO09480 ICMAX BSS 1 PARAMETERS DAO09490 IRMIN BSS 1 DAO09500 IRMAX BSS 1 MAX ROW DAO09510 K BSS 1 DAO09520 KCOL BSS 1 COLUMN DAO09530 KCOLZ BSS 1 DAO09540 MXCOL BSS 1 MAX COLUMN DAO09550 MXROW BSS 1 MAX ROW DAO09560 SCLOC BSS 1 DATA SET LOCATION DAO09570 SCINC BSS 1 PARAMETERS DAO09580 SCINX BSS 1 DAO09590 SCSTR BSS 1 DAO09600 XMIN BSS E 2 DATA SET INPUT DAO09610 YMIN BSS E 2 PARAMETERS DAO09620 OUTS BSS 1 OUTPUT BUFFER DAO09630 BSS 65 DAO09640 OUTT BSS 1 DAO09650 BSS 12 DAO09660 BSS E 1 DAO09670 AA BSS 81 OUTPUT BUFFER DAO09680 IZ BSS E 400 COLUMN INPUT AREA DAO09690 Z BSS E 400 DAO09700 WKIO BSS E 642 DISK INPUT BUFFER DAO09710 TYPE BSS 30 MESSAGE BUFFER DAO09720 END GO DAO09730 // DUP DAO09740 *STORE WS UA DAOUT DAO09750 // JOB NUX00010 // DUP NUX00020 *DELETE UA NUPRX NUX00030 // JOB NUX00040 // ASM NUX00050 *LIST NUX00060 *************** NUX00070 * NUPRX - THIS PHASE READS THE PARAMETER NUX00080 * CARDS, CHECKS THE PARAMETERS FOR NUX00090 * VALIDITY, AND INITIALIZES THE NUX00100 * OUTPUT DATA SET ON THE DISK NUX00110 *************** NUX00120 START NOP NUX00130 LIBF WRTY0 RETURN NUX00140 DC /2000 CARRIAGE NUX00150 DC CONTL NUX00160 BSI L ERTYP TYPE STARTING NUX00170 DC SMSAG MESSAGE NUX00180 *************** NUX00190 LIBF CARD0 READ FIRST NUX00200 * LIBF READ0 READ FIRST NUX00210 *************** NUX00220 DC /0000 PARAMETER CARD NUX00230 MDX *-3 NUX00240 *************** NUX00250 LIBF CARD0 NUX00260 * LIBF READ0 NUX00270 *************** NUX00280 DC /1000 NUX00290 DC INBUF NUX00300 *************** NUX00310 LIBF CARD0 NUX00320 * LIBF READ0 NUX00330 *************** NUX00340 DC /0000 NUX00350 MDX *-3 NUX00360 BSI L SDUMS CONVERT OUTPUT DATA SET NUX00370 LIBF SPEED NAME TO EBCDIC NUX00380 DC /0000 NUX00390 DC INBUF+1 NUX00400 DC ANAME NUX00410 DC 4 NUX00420 LD L ANAME NUX00430 STO L MSAG2+9 NUX00440 LD L ANAME+1 NUX00450 STO L MSAG2+10 NUX00460 BSI L ERTYP NUX00470 DC MSAG2 NUX00480 LD L INBUF+9 NUX00490 STO L DUMS+4 CONVERT X NUX00500 LD L INBUF+10 FIELD NUMBER NUX00510 STO L DUMS+5 NUX00520 LIBF DCBIN NUX00530 DC DUMS NUX00540 SLA 1 NUX00550 S L TWO NUX00560 STO L IX NUX00570 LD L INBUF+14 CONVERT Y NUX00580 STO L DUMS+4 FIELD NUMBER NUX00590 LD L INBUF+15 NUX00600 STO L DUMS+5 NUX00610 LIBF DCBIN NUX00620 DC DUMS NUX00630 SLA 1 NUX00640 S L TWO NUX00650 STO L IY NUX00660 LD L INBUF+19 CONVERT Z NUX00670 STO L DUMS+4 FIELD NUMBER NUX00680 LD L INBUF+20 NUX00690 STO L DUMS+5 NUX00700 LIBF DCBIN NUX00710 DC DUMS NUX00720 SLA 1 NUX00730 S L TWO NUX00740 STO L IZ NUX00750 BSI L SDUMS NUX00760 LD L INBUF+25 CONVERT SIGN NUX00770 STO L DUMS+5 RESTRICTION NUX00780 LIBF DCBIN NUX00790 DC DUMS NUX00800 STO L ISIGN NUX00810 LD L INBUF+30 CONVERT BOUNDARY NUX00820 STO L DUMS+5 OPTION NUX00830 LIBF DCBIN NUX00840 DC DUMS NUX00850 STO L IRSTR NUX00860 LD L N70 NUX00870 STO L FFMAT-1 NUX00880 *************** NUX00890 LIBF CARD0 READ SECOND NUX00900 * LIBF READ0 READ SECOND NUX00910 *************** NUX00920 DC /1000 PARAMETER CARD NUX00930 DC FFMAT-1 NUX00940 *************** NUX00950 LIBF CARD0 NUX00960 * LIBF READ0 NUX00970 *************** NUX00980 DC /0000 NUX00990 MDX *-3 NUX01000 BSI L FFORM CONVERT NUX01010 BSI L CEFBF XMIN NUX01020 LDD L BINFL NUX01030 STD L XMIN NUX01040 LDX 2 10 NUX01050 LD L2 FFMAT+9 NUX01060 STO L2 FFMAT-1 NUX01070 MDX 2 -1 NUX01080 MDX *-6 NUX01090 BSI L FFORM CONVERT NUX01100 BSI L CEFBF XMAX NUX01110 LDD L BINFL NUX01120 STD L XMAX NUX01130 LDX 2 10 NUX01140 LD L2 FFMAT+19 NUX01150 STO L2 FFMAT-1 NUX01160 MDX 2 -1 NUX01170 MDX *-6 NUX01180 BSI L FFORM CONVERT NUX01190 BSI L CEFBF YMIN NUX01200 LDD L BINFL NUX01210 STD L YMIN NUX01220 LDX 2 10 NUX01230 LD L2 FFMAT+29 NUX01240 STO L2 FFMAT-1 NUX01250 MDX 2 -1 NUX01260 MDX *-6 NUX01270 BSI L FFORM CONVERT NUX01280 BSI L CEFBF YMAX NUX01290 LDD L BINFL NUX01300 STD L YMAX NUX01310 LDX 2 10 NUX01320 LD L2 FFMAT+39 NUX01330 STO L2 FFMAT-1 NUX01340 MDX 2 -1 NUX01350 MDX *-6 NUX01360 BSI L FFORM CONVERT GRID NUX01370 BSI L CEFBF INTERVAL NUX01380 LDD L BINFL NUX01390 STD L GRID NUX01400 LDX 2 10 NUX01410 LD L2 FFMAT+49 NUX01420 STO L2 FFMAT-1 NUX01430 MDX 2 -1 NUX01440 MDX *-6 NUX01450 BSI L FFORM CONVER NUX01460 BSI L CEFBF ZMIN NUX01470 LD L ZERO SET RESTRICTION NUX01480 STO L MINZ INDICATOR NUX01490 LDD L BINFL NUX01500 STD L ZMIN NUX01510 BSC L SKY,-+ NUX01520 LD L ONE NUX01530 STO L MINZ NUX01540 SKY LDX 2 10 NUX01550 LD L2 FFMAT+59 NUX01560 STO L2 FFMAT-1 NUX01570 MDX 2 -1 NUX01580 MDX *-6 NUX01590 BSI L FFORM CONVERT ZMAX NUX01600 BSI L CEFBF NUX01610 LD L ZERO NUX01620 STO L MAXZ NUX01630 LDD L BINFL NUX01640 STD L ZMAX NUX01650 BSC L SKZ,-+ NUX01660 LD L ONE SET RESTRICTION NUX01670 STO L MAXZ INDICATOR NUX01680 SKZ NOP NUX01690 OGR LIBF FLD DETERMINE NUMBER NUX01700 DC XMAX OF COLUMNS NUX01710 LIBF FSUB NUX01720 DC XMIN NUX01730 LIBF FDIV NUX01740 DC GRID NUX01750 LIBF FADD NUX01760 DC GFAC NUX01770 LIBF IFIX NUX01780 STO L ICMAX NUX01790 LIBF FLD DETERMINE NUMBER NUX01800 DC YMAX OF ROWS NUX01810 LIBF FSUB NUX01820 DC YMIN NUX01830 LIBF FDIV NUX01840 DC GRID NUX01850 LIBF FADD NUX01860 DC GFAC NUX01870 LIBF IFIX NUX01880 STO L IRMAX NUX01890 *************** NUX01900 * TEST INPUT PARAMETERS FOR VALIDITY NUX01910 *************** NUX01920 LD L GRID NUX01930 BSC L ERR5,+ INVALID GRID NUX01940 LD L ICMAX NUX01950 S L ONE NUX01960 BSC L ERR1,+ TOO FEW COLUMNS NUX01970 LD L IRMAX NUX01980 S L ONE NUX01990 BSC L ERR2,+ TOO FEW ROWS NUX02000 LD L ICMAX NUX02010 S L N100 NUX02020 BSC L ERR3,- TOO MANY COLUMNS NUX02030 LD L IRMAX NUX02040 S L N100 NUX02050 BSC L ERR4,- TOO MANY ROWS NUX02060 LD L MINZ NUX02070 BSC L OKA,+ NUX02080 LD L MAXZ NUX02090 BSC L OKA,+ NUX02100 LIBF FLD NUX02110 DC ZMAX NUX02120 LIBF FSUB NUX02130 DC ZMIN NUX02140 LIBF FSTO NUX02150 DC DUM NUX02160 LD L DUM NUX02170 BSC L ERR6,+ ILLOGICAL ZMIN - ZMAX NUX02180 OKA BSI L INLZG INIT OUTPUT DATA SET NUX02190 LIBF DISKN WRITE COMMON NUX02200 DC /5000 ON DISK NUX02210 DC DSKO NUX02220 DC ERRS NUX02230 LIBF DISKN NUX02240 DC /4000 NUX02250 DC DSKO NUX02260 LIBF DISKN NUX02270 DC /0000 NUX02280 DC DSKO NUX02290 MDX *-4 NUX02300 LINK RDDAT GO TO NEXT PHASE NUX02310 ************** NUX02320 * ROUTINE TO INITIALIZE THE AREA OF THE NUX02330 * DISK FOR THE OUTPUT SET OF GRID VALUES NUX02340 ************** NUX02350 INLZG NOP NUX02360 BSI L LOCAT FIND ALLOCATION NUX02370 LD L IFOUN HAS NAME BEEN USED NUX02380 BSC L INLZ1,-+ NUX02390 BSI L ERTYP NUX02400 DC MSAG9 NUX02410 BSI L ERTYP NUX02420 DC MSAG4 NUX02430 WAIT NUX02440 EXIT NUX02450 INLZ1 BSI L WRTOU OUTPUT HEADER NUX02460 BSI L REWRT OUTPUT TRAILER NUX02470 LD L ZERO NUX02480 STO L COL NUX02490 LDX I1 M200 NUX02500 LDD L ZNIL NUX02510 INLZ2 STD L1 ZG+200 SET VALUES TO ZNIL NUX02520 MDX 1 2 NUX02530 MDX INLZ2 NUX02540 INLZ3 MDX L COL,1 NUX02550 BSI L WRTGR WRITE OUT EACH NUX02560 LD L COL COLUMN NUX02570 S L ICMAX NUX02580 BSC L INLZ3,Z+ NUX02590 BSC I INLZG RETURN NUX02600 *************** NUX02610 * LOCAT SUBROUTINE NUX02620 *************** NUX02630 LOCAT NOP SUBROUTINE TO NUX02640 LD L FX20 SEARCH FOR THE NUX02650 STO L WKIO GRID NAME OR THE NUX02660 LD L SCBGN TRAILER RECORD NUX02670 STO L WKIO+1 IN THE DISK DATA NUX02680 AGN LIBF DISKN NUX02690 DC /5000 NUX02700 DC WKIO SETS IFOUN TO NUX02710 DC ERRS ONE IF GRID NAME NUX02720 LIBF DISKN NUX02730 DC /1000 SETS IFOUN TO NUX02740 DC WKIO ZERO IF TRAILER NUX02750 DC ERRS RECORD IS FOUND NUX02760 LIBF DISKN NUX02770 DC /0000 NUX02780 DC WKIO NUX02790 MDX *-4 NUX02800 LIBF FLD NUX02810 DC TRAIL NUX02820 LIBF FSUB NUX02830 DC WKIO+2 NUX02840 LIBF FSTO NUX02850 DC DUMY NUX02860 LD L DUMY NUX02870 BSC L OK,+- NUX02880 LIBF FLD NUX02890 DC WKIO+2 NUX02900 LIBF FSUB NUX02910 DC ANAME NUX02920 LIBF FSTO NUX02930 DC DUMY NUX02940 LD L DUMY NUX02950 BSC L FND,+- NUX02960 LD L WKIO+6 NUX02970 M L FOUR NUX02980 STD L DUMY NUX02990 D L THREE NUX03000 STO L SCINC NUX03010 M L THREE NUX03020 D L ONE NUX03030 S L DUMY+1 NUX03040 BSC L AA3,- NUX03050 A L FOUR NUX03060 A L SCINC NUX03070 STO L SCINC NUX03080 AA3 LD L WKIO&1 NUX03090 A L SCINC NUX03100 STO L WKIO+1 NUX03110 S L SCBGN NUX03120 BSC L EROB,& NUX03130 S L SCLGT NUX03140 BSC L EROB,- NUX03150 BSC L AGN NUX03160 FND LD L ONE NUX03170 STO L IFOUN NUX03180 LDD L WKIO+4 NUX03190 STD L GRID NUX03200 LD L WKIO+6 NUX03210 STO L MXCOL NUX03220 LD L WKIO+7 NUX03230 STO L MXROW NUX03240 LD L WKIO&1 NUX03250 STO L SCSTR NUX03260 BSC I LOCAT NUX03270 OK LD L ZERO NUX03280 STO L IFOUN NUX03290 LD L WKIO&1 NUX03300 STO L SCSTR NUX03310 BSC I LOCAT NUX03320 *************** NUX03330 * FFORM SUBROUTINE NUX03340 *************** NUX03350 FFORM NOP SUBROUTINE TO NUX03360 LDX 2 14 CONVERT AN F-FORMAT NUX03370 LD L NMZER CARD CODE NUMBER NUX03380 STO L2 EFMAT TO E-FORMAT NUX03390 MDX 2 -1 SET E - FORMAT AREA NUX03400 MDX *-4 TO ZERO CHARS NUX03410 STX L1 REG1 NUX03420 LD L PLUS STORE PLUS, PERIOD, AND NUX03430 STO L EFMAT E IN E - FORMAT WORD NUX03440 LD L PERID NUX03450 STO L EFMAT+1 NUX03460 LD L LTRE NUX03470 STO L EFMAT+10 NUX03480 LD L FX11 NUX03490 STO L FNDPR NUX03500 LDX 1 10 NUX03510 FFRM LD L1 FFMAT-1 TEST FOR NUX03520 BSC L FIND1,+- BLANK OR NUX03530 LD L1 FFMAT-1 PLUS SIGN NUX03540 S L PLUS NUX03550 BSC L FIND1,+- NUX03560 LD L1 FFMAT-1 AMPERS AND NUX03570 S L AMPER NUX03580 BSC L FIND1,+- NUX03590 LD L1 FFMAT-1 MINUS NUX03600 S L MINUS NUX03610 BSC L BCKF,Z NUX03620 LD L MINUS NUX03630 STO L EFMAT NUX03640 FIND1 LD L NMZER NUX03650 STO L1 FFMAT-1 NUX03660 MDX 1 -1 NUX03670 MDX FIND2 NUX03680 MDX FIND2 NUX03690 BCKF LD L1 FFMAT-1 PERIOD NUX03700 S L PERID NUX03710 BSC L BCKG,Z NUX03720 STX L1 FNDPR NUX03730 BCKG MDX 1 -1 LOOP TEST NUX03740 MDX *+1 NUX03750 MDX *+2 NUX03760 BSC L FFRM TEST ANOTHER CHARACTER NUX03770 FIND2 STX L1 FNDEN CALCULATE AND STORE NUX03780 LD L FNDPR EXPONENT NUX03790 S L FNDEN NUX03800 S L ONE NUX03810 LIBF BINDC NUX03820 DC EFORM NUX03830 LD L EFORM NUX03840 STO L EFMAT+11 NUX03850 LD L EFORM+4 NUX03860 STO L EFMAT+12 NUX03870 LD L EFORM+5 NUX03880 STO L EFMAT+13 NUX03890 LD L TEN IS HIGH ORDER CHAR NUX03900 S L FNDEN IN RIGHTMOST POS NUX03910 BSC L FIND4,+ YES, BRANCH NUX03920 STO L FFMNB NO, STORE COUNT OF NUX03930 MDX 1 1 CHARS TO BE MOVED NUX03940 LD L1 FFMAT-1 LOAD SIGNIFICANT DIGIT NUX03950 STO L EFMAT+2 OF F-FORM TO EFORM NUX03960 LD L ONE MANTISSA NUX03970 STO L FFMCT NUX03980 S L FFMNB TEST FOR SINGLE DIGIT NUX03990 BSC L ONWD,- IN F-FORMAT NUX04000 LDX 2 0 YES, BRANCH NUX04010 BCKH MDX 2 1 NO, MOVE DIGIT TO NUX04020 BCKJ MDX 1 1 E-FORMAT MANTISSA NUX04030 MDX L FFMCT,+1 NUX04040 LD L1 FFMAT-1 TEST FOR PERIOD NUX04050 S L PERID NUX04060 BSC L BCKI,+- NUX04070 LD L1 FFMAT-1 NUX04080 STO L2 EFMAT+2 NUX04090 LD L FFMCT NUX04100 S L FFMNB NUX04110 BSC L BCKH,+Z NUX04120 LDX I1 REG1 NUX04130 BSC I FFORM RETURN NUX04140 FIND4 LD L NMZER STORE 0 IN TENS POS NUX04150 STO L EFMAT+13 OF EXPONENT NUX04160 ONWD LDX I1 REG1 NUX04170 BSC I FFORM NUX04180 BCKI LD L FFMCT ARE ALL CHARS MOVED NUX04190 S L FFMNB NUX04200 BSC L BCKJ,+Z NO, BRANCH NUX04210 LDX I1 REG1 NUX04220 BSC I FFORM NUX04230 *************** NUX04240 * CEFBF SUBROUTINE NUX04250 *************** NUX04260 CEFBF NOP SUBROUTINE TO NUX04270 LD L EFMAT TO CONVERT A CARD NUX04280 S L PLUS CODE E-FORMAT NUX04290 BSC L NXTA,&- NUMBER TO BINARY NUX04300 LD L EFMAT FLOATING POINT NUX04310 S L AMPER TEST FOR NUX04320 BSC L NXTA,&- FORMAT ERRORS NUX04330 LD L EFMAT NUX04340 S L MINUS NUX04350 BSC L NXTA,&- NUX04360 LD L EFMAT NUX04370 BSC L ERROR,Z NUX04380 NXTA LD L EFMAT+1 NUX04390 S L PERID NUX04400 BSC L ERROR,Z NUX04410 LD L EFMAT+10 NUX04420 S L LTRE NUX04430 BSC L ERROR,Z NUX04440 LD L EFMAT+11 NUX04450 S L PLUS NUX04460 BSC L NXTB,&- NUX04470 LD L EFMAT+11 NUX04480 S L AMPER NUX04490 BSC L NXTB,&- NUX04500 LD L EFMAT+11 NUX04510 S L MINUS NUX04520 BSC L NXTB,&- NUX04530 LD L EFMAT+11 NUX04540 BSC L ERROR,Z NUX04550 NXTB LD L EFMAT CONVERT HIGH ORDER DIGS NUX04560 STO L EFORM TO BINARY AND THEN NUX04570 LD L ZERO TO FLOATING POINT NUX04580 STO L EFORM&1 NUX04590 LD L EFMAT+2 NUX04600 STO L EFORM&2 NUX04610 LD L EFMAT+3 NUX04620 STO L EFORM&3 NUX04630 LD L EFMAT+4 NUX04640 STO L EFORM&4 NUX04650 LD L EFMAT+5 NUX04660 STO L EFORM&5 NUX04670 LIBF DCBIN NUX04680 DC EFORM NUX04690 STO L FXMNT NUX04700 LIBF FLOAT NUX04710 LIBF FSTO NUX04720 DC MANT NUX04730 LD L ZERO CONVERT LOW ORDER NUX04740 STO L EFORM&1 DIGITS TO BINARY NUX04750 LD L EFMAT+6 AND THEN TO NUX04760 STO L EFORM&2 FLOATING POINT NUX04770 LD L EFMAT+7 NUX04780 STO L EFORM&3 NUX04790 LD L EFMAT+8 NUX04800 STO L EFORM&4 NUX04810 LD L EFMAT+9 NUX04820 STO L EFORM&5 NUX04830 LIBF DCBIN NUX04840 DC EFORM NUX04850 STO L FXMNR NUX04860 LIBF FLOAT NUX04870 LIBF FSTO NUX04880 DC MANR NUX04890 LD L FXMNT ARE HIGH ORDER DIGITS NUX04900 BSC L *&4,Z ZERO NUX04910 LD L FXMNR NO, CALCULATE NUX04920 BSC L ALTER,&- CHARACTERISTIC NUX04930 LD L EFMAT+11 YES, ARE LOW ORDER NUX04940 STO L EFORM DIGITS ZERO NUX04950 LD L ZERO YES, GO TO ALTER NUX04960 STO L EFORM&1 NO, CONVERT EXPONENT NUX04970 STO L EFORM&2 TO BINARY NUX04980 STO L EFORM&3 COMBINE THE TWO NUX04990 LD L EFMAT+12 NUMBERS AND ADJUST NUX05000 STO L EFORM&4 CHARACTERISTIC NUX05010 LD L EFMAT+13 NUX05020 STO L EFORM&5 NUX05030 LIBF DCBIN NUX05040 DC EFORM NUX05050 STO L EXPON NUX05060 LIBF FLD NUX05070 DC FTEN NUX05080 LIBF FAXI NUX05090 DC EXPON NUX05100 LIBF FSTO NUX05110 DC EXPT NUX05120 LIBF FLD NUX05130 DC MANR NUX05140 LIBF FMPY NUX05150 DC TENG4 NUX05160 LIBF FADD NUX05170 DC MANT NUX05180 LIBF FMPY NUX05190 DC TENG4 NUX05200 LIBF FMPY NUX05210 DC EXPT NUX05220 LIBF FSTO NUX05230 DC BINFL NUX05240 BSC I CEFBF RETURN NUX05250 ALTER LDD L FZERO SET VALUE TO NUX05260 STD L BINFL FLOATING POINT ZERO NUX05270 BSC I CEFBF RETURN NUX05280 ERROR MDX ALTER SET VALUE TO ZERO NUX05290 *************** NUX05300 * WRTOU SUBROUTINE NUX05310 *************** NUX05320 WRTOU NOP SUBROUTINE TO NUX05330 LDX 1 22 WRITE THE HEADER NUX05340 LDX 2 20 RECORD FOR THE NUX05350 LDD L ZNIL OUTPUT SET OF NUX05360 STD L1 WKIO-2 GRIDS NUX05370 MDX 1 -2 NUX05380 MDX 2 -2 NUX05390 MDX *-5 NUX05400 LD L SCBGN NUX05410 A L SCLGT NUX05420 S L SCSTC NUX05430 M L THREE NUX05440 D L FOUR NUX05450 S L ICMXA NUX05460 BSC L NOROM,+Z NUX05470 LD L FX20 NUX05480 STO L WKIO NUX05490 LD L SCSTC NUX05500 STO L WKIO+1 NUX05510 LDD L CNAME NUX05520 STD L WKIO+2 NUX05530 LDD L GRIDA NUX05540 STD L WKIO+4 NUX05550 LD L ICMXA NUX05560 STO L WKIO&6 NUX05570 LD L IRMXA NUX05580 STO L WKIO&7 NUX05590 LDD L XMINA NUX05600 STD L WKIO+8 NUX05610 LDD L YMINA NUX05620 STD L WKIO+10 NUX05630 LIBF DISKN NUX05640 DC /5000 NUX05650 DC WKIO NUX05660 DC ERRS NUX05670 LIBF DISKN NUX05680 DC /4000 NUX05690 DC WKIO NUX05700 LIBF DISKN NUX05710 DC /0000 NUX05720 DC WKIO NUX05730 MDX *-4 NUX05740 BSC I WRTOU NUX05750 NOROM BSI L ERTYP NUX05760 DC MSAG6 NUX05770 BSI L ERTYP NUX05780 DC MSAG4 NUX05790 WAIT NUX05800 EXIT NUX05810 *************** NUX05820 * REWRT SUBROUTINE NUX05830 *************** NUX05840 REWRT NOP SUBROUTINE TO NUX05850 LD L ICMXA WRITE THE TRAILER NUX05860 M L FOUR RECORD BEHIND THE NUX05870 STD L DUMY OUTPUT GRID SET NUX05880 D L THREE NUX05890 STO L SCINC NUX05900 M L THREE NUX05910 D L ONE NUX05920 S L DUMY+1 NUX05930 BSC L AA2,- NUX05940 A L FOUR NUX05950 A L SCINC NUX05960 STO L SCINC NUX05970 AA2 LD L SCINC NUX05980 A L SCSTC NUX05990 STO L XXXX NUX06000 LIBF DISKN NUX06010 DC /0000 NUX06020 DC WKIO NUX06030 MDX *-4 NUX06040 LD L XXXX NUX06050 STO L WKIO+1 NUX06060 LD L TWO NUX06070 STO L WKIO NUX06080 LDD L TRAIL NUX06090 STD L WKIO+2 NUX06100 LIBF DISKN NUX06110 DC /5000 NUX06120 DC WKIO NUX06130 DC ERRS NUX06140 LIBF DISKN NUX06150 DC /4000 NUX06160 DC WKIO NUX06170 LIBF DISKN NUX06180 DC /0000 NUX06190 DC WKIO NUX06200 MDX *-4 NUX06210 BSC I REWRT NUX06220 SDUMS NOP NUX06230 LD L PLUS NUX06240 STO L DUMS NUX06250 LD L ZERO NUX06260 STO L DUMS+1 NUX06270 STO L DUMS+2 NUX06280 STO L DUMS+3 NUX06290 STO L DUMS+4 NUX06300 STO L DUMS+5 NUX06310 BSC I SDUMS NUX06320 *************** NUX06330 * COME HERE FOR DISK ERRORS NUX06340 *************** NUX06350 ERRS DC 0 NUX06360 BSC I ERTYP NUX06370 DC MSAGS NUX06380 SRA 16 NUX06390 BSC I ERRS NUX06400 EROB BSI L ERTYP NUX06410 DC MSAGA NUX06420 BSI L ERTYP NUX06430 DC MSAGB NUX06440 WAIT NUX06450 EXIT NUX06460 *************** NUX06470 * WRTGR SUBROUTINE NUX06480 *************** NUX06490 WRTGR NOP SUBROUTINE TO NUX06500 STX L1 DIX1 NUX06510 STX L2 DIX2 NUX06520 BSI L SCCOM WRITE THE OUTPUT NUX06530 LIBF DISKN GRID COLUMNS ON NUX06540 DC /0000 THE DISK NUX06550 DC WKIO NUX06560 MDX *-4 NUX06570 LD L FX640 NUX06580 STO L WKIO NUX06590 LD L SCLOC NUX06600 STO L WKIO+1 NUX06610 LIBF DISKN NUX06620 DC /5000 NUX06630 DC WKIO NUX06640 DC ERRS NUX06650 LIBF DISKN NUX06660 DC /1000 NUX06670 DC WKIO NUX06680 DC ERRS NUX06690 LIBF DISKN NUX06700 DC /0000 NUX06710 DC WKIO NUX06720 MDX *-4 NUX06730 LD L ININX NUX06740 A L FX418 NUX06750 STO L DUMY NUX06760 LDX I1 DUMY NUX06770 LDX I2 FX420 NUX06780 LDD L ZNIL NUX06790 STD L1 WKIO NUX06800 MDX 1 -2 NUX06810 MDX 2 -2 NUX06820 MDX *-5 NUX06830 LD L IEZ NUX06840 A L IEZ NUX06850 STO L DUMY NUX06860 LDX I2 DUMY NUX06870 LD L ININX NUX06880 A L FX20 NUX06890 A L DUMY NUX06900 S L TWO NUX06910 STO L DUMY NUX06920 LDX I1 DUMY NUX06930 LDD L2 ZO-2 NUX06940 STD L1 WKIO NUX06950 MDX 1 -2 NUX06960 MDX 2 -2 NUX06970 MDX *-7 NUX06980 LDX I1 ININX NUX06990 LD L KCOLZ NUX07000 STO L1 WKIO NUX07010 LD L IBZ NUX07020 STO L1 WKIO+1 NUX07030 LD L IEZ NUX07040 STO L1 WKIO&2 NUX07050 LIBF DISKN NUX07060 DC /4000 NUX07070 DC WKIO NUX07080 LIBF DISKN NUX07090 DC /0000 NUX07100 DC WKIO NUX07110 MDX *-4 NUX07120 LDX I1 DIX1 NUX07130 LDX I2 DIX2 NUX07140 BSC I WRTGR NUX07150 *************** NUX07160 * ERTYP SUBROUTINE NUX07170 *************** NUX07180 ERTYP NOP SUBROUTINE TO NUX07190 LD I ERTYP WRITE MESSAGES NUX07200 STO L ERTX ON THE CONSOLE NUX07210 MDX L ERTYP,&1 TYPEWRITER NUX07220 LD L ERTX NUX07230 S L ONE NUX07240 STO *&1 NUX07250 LD L 0 NUX07260 STO L ERTX+2 NUX07270 M L ONE NUX07280 D L TWO NUX07290 STO L TYPE NUX07300 LIBF EBPRT NUX07310 DC /0000 NUX07320 ERTX DC 0 NUX07330 DC TYPE+1 NUX07340 DC 0 NUX07350 LIBF WRTY0 NUX07360 DC /2000 NUX07370 DC TYPE NUX07380 LIBF WRTY0 NUX07390 DC /2000 NUX07400 DC CONTL NUX07410 LIBF WRTY0 NUX07420 DC /0000 NUX07430 MDX *-3 NUX07440 BSC I ERTYP NUX07450 * SCCOM SUBROUTINE NUX07460 *************** NUX07470 SCCOM NOP SUBROUTINE TO NUX07480 LD L THCOL COMPUTE THE NUX07490 S L ONE LOCATION OF THE NUX07500 M L ONE SUCCESSIVE NUX07510 D L THREE COLUMNS IN THE NUX07520 STO L DUMY DISK DATA AREA NUX07530 M L FOUR NUX07540 D L ONE NUX07550 STO L SCINC NUX07560 LD L DUMY NUX07570 M L THREE NUX07580 D L ONE NUX07590 STO L DUMY NUX07600 LD L THCOL NUX07610 S L DUMY NUX07620 S L ONE NUX07630 STO L SCINX NUX07640 A L SCINC NUX07650 STO L SCINC NUX07660 A L SCSTR NUX07670 STO L SCLOC NUX07680 S L SCBGN NUX07690 BSC L EROB,Z+ NUX07700 S L SCLGT NUX07710 BSC L EROB,- NUX07720 LD L FX100 NUX07730 M L SCINX NUX07740 D L ONE NUX07750 A L FX22 NUX07760 STO L ININX NUX07770 BSC I SCCOM NUX07780 *************** NUX07790 * ALL PARAMETER ERRORS COME HERE TO WRITE NUX07800 * ERROR MESSAGES NUX07810 *************** NUX07820 ERR1 BSI L ERTYP NUX07830 DC TFCOL NUX07840 BSC L ERR7 NUX07850 ERR2 BSI L ERTYP NUX07860 DC TFROW NUX07870 BSC L ERR7 NUX07880 ERR3 BSI L ERTYP NUX07890 DC TMCOL NUX07900 BSC L ERR7 NUX07910 ERR4 BSI L ERTYP NUX07920 DC TMROW NUX07930 BSC L ERR7 NUX07940 ERR5 BSI L ERTYP NUX07950 DC ILLGD NUX07960 BSC L ERR7 NUX07970 ERR6 BSI L ERTYP NUX07980 DC ILLZS NUX07990 BSC L ERR7 NUX08000 ERR7 BSI L ERTYP NUX08010 DC MSAGB NUX08020 WAIT NUX08030 EXIT NUX08040 ************** NUX08050 * FLOATING POINT CONSTANTS NUX08060 ************** NUX08070 FZERO DEC 0. NUX08080 ZNIL DEC -1.E30 NUX08090 F100 DEC 100. NUX08100 TRAIL DEC 9999. NUX08110 AZNIL DEC 1.E30 NUX08120 FTEN DEC 10. NUX08130 TENG4 DEC 1.E-4 NUX08140 GFAC DEC 1.9999 NUX08150 FONE DEC 1.0 NUX08160 FTWO DEC 2.0 NUX08170 ************** NUX08180 * FIXED POINT CONSTANTS NUX08190 ************** NUX08200 FX218 DC 218 NUX08210 FX200 DC 200 NUX08220 ZERO DC 0 NUX08230 BSS E 0 NUX08240 DC 0 NUX08250 ONE DC 1 NUX08260 N100 DC 100 NUX08270 XNIL DC -20000 NUX08280 TNTHU DC 10000 NUX08290 N16 DC 16 NUX08300 SIX DC 6 NUX08310 M100 DC -100 NUX08320 TWO DC 2 NUX08330 M8 DC -8 NUX08340 M16 DC -16 NUX08350 M18 DC -18 NUX08360 FIVE DC 5 NUX08370 FX20 DC 20 NUX08380 SCBGN DC 448 NUX08390 FOUR DC 4 NUX08400 THREE DC 3 NUX08410 SCLGT DC 808 NUX08420 SCCNT DC 287 NUX08430 FX22 DC 22 NUX08440 FX640 DC 640 NUX08450 FX400 DC 400 NUX08460 FX300 DC 300 NUX08470 NMZER DC /2000 NUX08480 PLUS DC /80A0 NUX08490 PERID DC /8420 NUX08500 LTRE DC /8100 NUX08510 FX11 DC 11 NUX08520 AMPER DC /8000 NUX08530 MINUS DC /4000 NUX08540 TEN DC 10 NUX08550 FX418 DC 418 NUX08560 FX420 DC 420 NUX08570 N70 DC 70 NUX08580 N300 DC 300 NUX08590 M200 DC -200 NUX08600 CONTL DC 1 NUX08610 DC /8103 NUX08620 *************** NUX08630 * ERROR MESSAGES NUX08640 *************** NUX08650 DC 16 NUX08660 TFCOL EBC .TOO FEW COLUMNS . NUX08670 DC 12 NUX08680 TFROW EBC .TOO FEW ROWS. NUX08690 DC 16 NUX08700 TMCOL EBC .TOO MANY COLUMNS. NUX08710 DC 14 NUX08720 TMROW EBC .TOO MANY ROWS . NUX08730 DC 24 NUX08740 ILLGD EBC .ILLOGICAL GRID INTERVAL . NUX08750 DC 22 NUX08760 ILLZS EBC .ILLOGICAL ZMIN OR ZMAX. NUX08770 DC 16 NUX08780 SMSAG EBC .NUPRX BEGINNING . NUX08790 DC 36 NUX08800 MSAGS EBC .DISK ERROR TERMINATE JOB AND. NUX08810 EBC . RESTART. NUX08820 DC 30 NUX08830 MSAGA EBC .UNABLE TO FIND TRAILER RECORD. NUX08840 DC 30 NUX08850 MSAGB EBC .PUSH START FOR EXIT TO MONITOR. NUX08860 DC 26 NUX08870 MSAG9 EBC .NAME ALREADY USED ON DISK. NUX08880 DC 30 NUX08890 MSAG4 EBC .PUSH START FOR EXIT TO MONITOR. NUX08900 DC 54 NUX08910 MSAG6 EBC .REQUIRED NUMBER OF COLUMNS . NUX08920 EBC .EXCEEDS AVAILABLE DISK AREA. NUX08930 DC 22 NUX08940 MSAG2 EBC .OUTPUT GRID NAMED . NUX08950 DC /4040 NUX08960 DC /4040 NUX08970 *************** NUX08980 * VARIABLES NUX08990 *************** NUX09000 XNEW BSS E 2 TEMPORARY STORAGE NUX09010 YNEW BSS E 2 NUX09020 ND BSS E 2 NUX09030 FFMCT BSS E 2 NUX09040 XXXX BSS E 2 NUX09050 DIX1 BSS E 2 NUX09060 DIX2 BSS E 2 NUX09070 XP BSS 2 TEMPORARY X, Y, NUX09080 YP BSS 2 AND Z NUX09090 ZP BSS 2 NUX09100 DUM BSS 2 NUX09110 DUM1 BSS 2 NUX09120 DUMY BSS E 2 NUX09130 RESUL BSS E 2 NUX09140 MANT BSS E 2 NUX09150 MANR BSS E 2 NUX09160 EXPT BSS E 2 NUX09170 COUNT BSS 1 NUX09180 IFOUN BSS 1 NUX09190 ICOL BSS 1 COLUMN NUMBER NUX09200 DTCNT BSS 1 NO. OF POINTS NUX09210 NONE BSS 1 NUX09220 REG1 BSS 1 NUX09230 FNDPR BSS 1 NUX09240 FNDEN BSS 1 NUX09250 FFMNB BSS 1 NUX09260 FXMNR BSS 1 NUX09270 FXMNT BSS 1 NUX09280 EXPON BSS 1 NUX09290 NCOL BSS 1 NUX09300 COL BSS 1 NUX09310 BSS E 0 NUX09320 DC 0 ODD BOUNDARY NUX09330 ROW BSS 1 FOR ROW NUX09340 *************** NUX09350 * COMMON NUX09360 * THE COMMON THAT IS WRITTEN ON THE DISK NUX09370 * FOR RDDAT BEGINS AT DSKO, THE COMMON NUX09380 * FOR SUBSEQUENT PHASES BEGINS AT DSKOT NUX09390 *************** NUX09400 BSS E 1 ALIGNMENT NUX09410 DSKO DC 31 * NUX09420 DC 1592 * NUX09430 IX BSS 1 *X RECORD NUX09440 IY BSS 1 *Y RECORD NUX09450 IZ BSS 1 *Z RECORD NUX09460 XMIN BSS 2 * NUX09470 XMAX BSS 2 * NUX09480 YMIN BSS 2 * NUX09490 GRID BSS 2 * NUX09500 DSKOT DC 4018 *EVEN BOUNDARY NUX09510 DC 1584 *FOR LATER NUX09520 YMAX BSS 2 * NUX09530 ZMIN BSS 2 * NUX09540 ZMAX BSS 2 * NUX09550 ICMAX BSS 1 *NO. OF COLUMNS NUX09560 IRMAX BSS 1 *NO. OF ROWS NUX09570 ISIGN BSS 1 *SIGN RESTRICTION NUX09580 IRSTR BSS 1 *BORDER OPTION NUX09590 MINZ BSS 1 *Z RESTRICTION NUX09600 MAXZ BSS 1 *INDICATORS NUX09610 IPTS BSS 1 *NO. OF POINTS NUX09620 SCINC BSS 1 *OUTPUT DATA SET NUX09630 SCSTR BSS 1 *LOCATION PARAMETERS NUX09640 SCINX BSS 1 * NUX09650 SCLOC BSS 1 * NUX09660 ININX BSS 1 * NUX09670 ************** NUX09680 * ARRAYS NUX09690 ************** NUX09700 ZG BSS 200 COLUMN VECTOR NUX09710 ANAME BSS E 4 DATA SET NAME NUX09720 TYPE BSS E 30 TYPEWRITER AREA NUX09730 DUMS BSS 6 TEMPORARY STORAGE NUX09740 EFMAT BSS E 16 NUX09750 EFORM BSS E 6 NUX09760 BINFL BSS E 2 NUX09770 BSS E 1 NUX09780 INBUF DC 80 FIRST PARAM CARD NUX09790 BSS 80 NUX09800 BSS E 2 NUX09810 FFMAT BSS E 80 SECOND PARAM CARD NUX09820 WKIO BSS E 642 DISK I/O BUFFER NUX09830 *************** NUX09840 * EQUATES NUX09850 *************** NUX09860 IBZ EQU ONE NUX09870 IEZ EQU IRMAX NUX09880 KCOLZ EQU COL NUX09890 SCSTC EQU SCSTR NUX09900 CNAME EQU ANAME NUX09910 GRIDA EQU GRID NUX09920 ICMXA EQU ICMAX NUX09930 IRMXA EQU IRMAX NUX09940 XMINA EQU XMIN NUX09950 YMINA EQU YMIN NUX09960 XRCKD EQU IX NUX09970 YRCKD EQU IY NUX09980 ZRCKD EQU IZ NUX09990 FX100 EQU N100 NUX10000 THCOL EQU COL NUX10010 MXCOL EQU ICMAX NUX10020 MXROW EQU IRMAX NUX10030 N1 EQU ONE NUX10040 ZO EQU ZG NUX10050 END START NUX10060 // DUP NUX10070 *STORE WS UA NUPRX NUX10080 // JOB RDD00010 // DUP RDD00020 *DELETE UA RDDAT RDD00030 // JOB RDD00040 // ASM RDD00050 * LIST RDD00060 *************** RDD00070 * RDDAT - THIS PHASE READS THE RANDOM DATA RDD00080 * POINTS AND CREATES THE X, Y, AND Z RDD00090 * ARRAYS RDD00100 *************** RDD00110 GO LIBF DISKN RDD00120 DC /5000 BRING IN THE RDD00130 DC DSKO COMMON LEFT ON THE RDD00140 DC ERRS DISK BY NUPRX RDD00150 LIBF DISKN RDD00160 DC /1000 RDD00170 DC DSKO RDD00180 DC ERRS RDD00190 LIBF DISKN RDD00200 DC /0000 RDD00210 DC DSKO RDD00220 MDX *-4 RDD00230 LD L FX300 INITIALIZE RDD00240 STO L DTCNT PARAMETERS RDD00250 LD L ZERO RDD00260 STO L NONE RDD00270 STO L IPTS RDD00280 LDX 2 0 POINTER TO ARRAYS RDD00290 INDAT BSI L DATRD GET ONE RECORD RDD00300 LD L NONE TEST END OF DATA RDD00310 BSC L OGR,Z BRANCH ON DATA END RDD00320 LIBF FLD RDD00330 DC XP RDD00340 LIBF FSUB X LESS THAN XMIN RDD00350 DC XMIN RDD00360 LIBF FSTO RDD00370 DC XNEW RDD00380 LD L XNEW RDD00390 BSC L INDAT,Z+ YES, BRANCH RDD00400 LIBF FLD RDD00410 DC XP RDD00420 LIBF FSUB X GREATER THAN XMAX RDD00430 DC XMAX RDD00440 LIBF FSTO RDD00450 DC DUM RDD00460 LD L DUM RDD00470 BSC L OGR,-Z YES, BRANCH RDD00480 LIBF FLD RDD00490 DC YP RDD00500 LIBF FSUB Y LESS THAN YMIN RDD00510 DC YMIN RDD00520 LIBF FSTO RDD00530 DC YNEW RDD00540 LD L YNEW RDD00550 BSC L INDAT,Z+ YES, BRANCH RDD00560 LIBF FLD RDD00570 DC YP RDD00580 LIBF FSUB Y GREATER THAN YMAX RDD00590 DC YMAX RDD00600 LIBF FSTO RDD00610 DC DUM RDD00620 LD L DUM RDD00630 BSC L INDAT,-Z YES, BRANCH RDD00640 LIBF FLD RDD00650 DC ZP RDD00660 LIBF FSUB IS Z DEFINED RDD00670 DC ZNIL RDD00680 LIBF FSTO RDD00690 DC DUM RDD00700 LD L DUM RDD00710 BSC L INDAT,-+ NO, BRANCH RDD00720 LIBF FLD SCALE X AND Y RDD00730 DC XNEW IN TERMS OF GRID RDD00740 LIBF FDIV INTERVALS * 100 RDD00750 DC GRID AND CONVERT TO RDD00760 LIBF FMPY FIXED POINT RDD00770 DC F100 RDD00780 LIBF IFIX RDD00790 STO L2 X RDD00800 LIBF FLD RDD00810 DC YNEW RDD00820 LIBF FDIV RDD00830 DC GRID RDD00840 LIBF FMPY RDD00850 DC F100 RDD00860 LIBF IFIX RDD00870 STO L2 Y RDD00880 STX L2 DUM RDD00890 LD L DUM RDD00900 SLA 1 MOVE Z TO Z ARRAY RDD00910 STO L DUM1 IN ORIGINAL RDD00920 LDX I2 DUM1 FLT. PT. FORM RDD00930 LDD L ZP RDD00940 STD L2 Z RDD00950 LDX I2 DUM RDD00960 MDX 2 1 RDD00970 MDX L IPTS,1 INCREMENT POINTS RDD00980 LD L IPTS 1000 POINTS RDD00990 S L N1000 EXCEEDED? RDD01000 BSC L ERR1,Z- YES, BRANCH RDD01010 BSC L INDAT RETURN RDD01020 OGR LD L IPTS ANY POINTS AT ALL RDD01030 BSC L ERR2,+ NO, BRANCH RDD01040 LIBF FLD CONVERT YMAX TO RDD01050 DC YMAX FIXED POINT FOR RDD01060 LIBF FSUB USE BY NUPRY RDD01070 DC YMIN RDD01080 LIBF FDIV RDD01090 DC GRID RDD01100 LIBF FMPY RDD01110 DC F100 RDD01120 LIBF IFIX RDD01130 STO L YMAX RDD01140 LIBF DISKN WRITE COMMON RDD01150 DC /5000 ON DISK RDD01160 DC DSKOT RDD01170 DC ERRS RDD01180 LIBF DISKN RDD01190 DC /4000 RDD01200 DC DSKOT RDD01210 LIBF DISKN RDD01220 DC /0000 RDD01230 DC DSKOT RDD01240 MDX *-4 RDD01250 LINK NUPRY CALL NEXT PHASE RDD01260 *************** RDD01270 * DATRD SUBROUTINE RDD01280 *************** RDD01290 DATRD NOP SUBROUTINE TO RDD01300 LD L DTCNT READ THE X, Y, Z RDD01310 S L FX300 COORDINATES OF RDD01320 BSC L SAME,+Z RANDOM DATA ONE RDD01330 MDX L SCCNT,1 POINT AT A TIME RDD01340 LD L SCCNT RDD01350 STO L WKIO+1 RDD01360 LD L FX300 RDD01370 STO L WKIO RDD01380 LIBF DISKN RDD01390 DC /5000 RDD01400 DC WKIO RDD01410 DC ERRS RDD01420 LIBF DISKN RDD01430 DC /1000 RDD01440 DC WKIO RDD01450 DC ERRS RDD01460 LIBF DISKN RDD01470 DC /0000 RDD01480 DC WKIO RDD01490 MDX *-4 RDD01500 LD L TWO RDD01510 STO L DTCNT RDD01520 SAME LDX I1 DTCNT RDD01530 LIBF FLDX RDD01540 DC WKIO RDD01550 LIBF FSUB RDD01560 DC AZNIL IS THIS THE RDD01570 LIBF FSTO TRAILER RECORD RDD01580 DC RESUL RDD01590 LD L RESUL RDD01600 BSC L SAME1,Z NO, BRANCH RDD01610 LD L ONE SET COMPLETION RDD01620 STO L NONE SWITCH RDD01630 BSC L SKPA AND RETURN RDD01640 SAME1 LDX I1 XRCKD PICK UP X, Y, RDD01650 MDX I1 DTCNT AND Z RDD01660 LDD L1 WKIO AND STORE IN RDD01670 STD L XP TEMPORARY LOCATION RDD01680 LDX I1 YRCKD RDD01690 MDX I1 DTCNT RDD01700 LDD L1 WKIO RDD01710 STD L YP RDD01720 LDX I1 ZRCKD RDD01730 MDX I1 DTCNT RDD01740 LDD L1 WKIO RDD01750 STD L ZP RDD01760 SKPA MDX L DTCNT,30 GO NO TO NEXT RDD01770 BSC I DATRD RECORD RDD01780 *************** RDD01790 * ERROR CONDITIONS COME HERE RDD01800 *************** RDD01810 ERR1 BSI L ERTYP RDD01820 DC TMPTS RDD01830 BSC L ERR3 RDD01840 ERR2 BSI L ERTYP RDD01850 DC TFPTS RDD01860 ERR3 BSI L ERTYP RDD01870 DC MSAGB RDD01880 WAIT RDD01890 EXIT RDD01900 ERRS DC 0 RDD01910 LIBF WRTY0 RDD01920 BSI L ERTYP RDD01930 SRA 16 RDD01940 BSC I ERRS RDD01950 *************** RDD01960 * ERTYP SUBROUTINE RDD01970 *************** RDD01980 ERTYP NOP SUBROUTINE TO RDD01990 LD I ERTYP WRITE MESSAGES RDD02000 STO L ERTX ON THE CONSOLE RDD02010 MDX L ERTYP,&1 TYPEWRITER RDD02020 LD L ERTX RDD02030 S L ONE RDD02040 STO *&1 RDD02050 LD L 0 RDD02060 STO L ERTX+2 RDD02070 M L ONE RDD02080 D L TWO RDD02090 STO L TYPE RDD02100 LIBF EBPRT RDD02110 DC /0000 RDD02120 ERTX DC 0 RDD02130 DC TYPE+1 RDD02140 DC 0 RDD02150 LIBF WRTY0 RDD02160 DC /2000 RDD02170 DC TYPE RDD02180 LIBF WRTY0 RDD02190 DC /2000 RDD02200 DC CONTL RDD02210 LIBF WRTY0 RDD02220 DC /0000 RDD02230 MDX *-3 RDD02240 BSC I ERTYP RDD02250 *************** RDD02260 * ERROR MESSAGES RDD02270 *************** RDD02280 DC 36 RDD02290 MSAGS EBC .DISK ERROR TERMINATE JOB AND. RDD02300 EBC . RESTART. RDD02310 DC 30 RDD02320 MSAGB EBC .PUSH START FOR EXIT TO MONITOR. RDD02330 DC 22 RDD02340 TMPTS EBC .TOO MANY INPUT POINTS . RDD02350 DC 16 RDD02360 TFPTS EBC .NO INPUT POINTS . RDD02370 *************** RDD02380 * CONSTANTS RDD02390 *************** RDD02400 CONTL DC 1 TYPEWRITER RDD02410 DC /8103 CARRIAGE CONTROL RDD02420 ZERO DC 0 RDD02430 ONE DC 1 RDD02440 TWO DC 2 RDD02450 SCCNT DC 287 RANDOM DATA AREA RDD02460 FX300 DC 300 RDD02470 N1000 DC 1000 NO. OF POINTS RDD02480 ZNIL DEC -1.E30 RDD02490 AZNIL DEC 1.E30 RDD02500 F100 DEC 100. RDD02510 *************** RDD02520 * VARIABLES RDD02530 *************** RDD02540 DTCNT BSS 1 NO. OF RECS.PROCESS RDD02550 NONE BSS 1 END OF DATA SWITCH RDD02560 XNEW BSS E 2 TEMPORARY RDD02570 YNEW BSS E 2 STORAGE RDD02580 DUM BSS E 2 RDD02590 DUM1 BSS E 2 RDD02600 XP BSS E 2 RDD02610 YP BSS E 2 RDD02620 ZP BSS E 2 RDD02630 RESUL BSS E 2 RDD02640 *************** RDD02650 * COMMON RDD02660 * THIS PROGRAM HAS TWO COMMON AREAS, FROM RDD02670 * IX THROUGH ININX IS READ IN FROM NUPRX, RDD02680 * FROM YMAX THROUGH Z IS WRITTEN ON THE RDD02690 * DISK FOR NUPRY RDD02700 *************** RDD02710 BSS E 1 *ALIGNMENT RDD02720 DSKO DC 31 *NO. OF WORDS RDD02730 DC 1592 *SECTOR ADDRESS RDD02740 IX BSS 1 *X RECORD RDD02750 IY BSS 1 *Y RECORD RDD02760 IZ BSS 1 Z RECORD RDD02770 XMIN BSS 2 *MIN X RDD02780 XMAX BSS 2 *MAX X RDD02790 YMIN BSS 2 *MIN Y RDD02800 GRID BSS 2 *GRID INTERVAL RDD02810 DSKOT DC 4018 *EVEN BOUNDARY HERE RDD02820 DC 1584 *IS IMPORTANT RDD02830 YMAX BSS 2 *MAX Y RDD02840 ZMIN BSS 2 *MIN Z RDD02850 ZMAX BSS 2 *MAX Z RDD02860 ICMAX BSS 1 *MAX COLUMN RDD02870 IRMAX BSS 1 *MAX ROW RDD02880 ISIGN BSS 1 *SIGN RESTRICTION RDD02890 IRSTR BSS 1 *BORDER OPTION RDD02900 MINZ BSS 1 *Z LIMITS SWITCHES RDD02910 MAXZ BSS 1 * RDD02920 IPTS BSS 1 *NO. OF POINTS RDD02930 SCINC BSS 1 RDD02940 SCSTR BSS 1 RDD02950 SCINX BSS 1 *OUTPUT DATA SET RDD02960 SCLOC BSS 1 *LOCATION PARAMETERS RDD02970 ININX BSS 1 * RDD02980 X BSS 1000 *X ARRAY RDD02990 Y BSS 1000 *Y ARRAY RDD03000 Z BSS 2000 *Z ARRAY RDD03010 *************** RDD03020 * ARRAYS RDD03030 *************** RDD03040 TYPE BSS E 30 TYPEWRITER AREA RDD03050 WKIO BSS E 642 DISK I/O BUFFER RDD03060 *************** RDD03070 * EQUATES RDD03080 *************** RDD03090 XRCKD EQU IX RDD03100 YRCKD EQU IY RDD03110 ZRCKD EQU IZ RDD03120 END GO RDD03130 // DUP RDD03140 *STORE WS UA RDDAT RDD03150 // JOB NUY00010 // DUP NUY00020 *DELETE UA NUPRY NUY00030 // JOB NUY00040 // ASM NUY00050 * LIST NUY00060 *************** NUY00070 * NUPRY - THIS PHASE ESTABLISHES VALUES OF NUY00080 * GRID POINTS IMMEDIATELY AROUND NUY00090 * INPUT DATA POINTS NUY00100 *************** NUY00110 OKB LIBF DISKN BRING IN COMMON NUY00120 DC /5000 FROM THE DISK NUY00130 DC DSKOT NUY00140 DC ERRS NUY00150 LIBF DISKN NUY00160 DC /1000 NUY00170 DC DSKOT NUY00180 DC ERRS NUY00190 LIBF DISKN NUY00200 DC /0000 NUY00210 DC DSKOT NUY00220 MDX *-4 NUY00230 ***** **** ***** NUY00240 * THE FOLLOWING SECTION OF CODE IS TO NUY00250 * ESTABLISH THE VALUES OF GRID POINTS NUY00260 * IMMEDIATELY AROUND INPUT DATA POINTS NUY00270 ************** NUY00280 LD L ZERO XYCT CONTAINS THE NUY00290 STO L XYCT INDEX OF THE X AND NUY00300 STO L ZCT Y COORDINATES OF THE NUY00310 STO L XR2 NUY00320 ************** NUY00330 * DATA POINT ABOUT NUY00340 * WHICH GRID POINTS NUY00350 * ARE BEING EVALUATED NUY00360 * ZCT IS THE INDEX OF NUY00370 * THE Z COORDINATE NUY00380 ************** NUY00390 * SELECT A DATA POINT AND DETERMINE THE NUY00400 * GRID SQUARE WHICH CONTAINS IT NUY00410 ************** NUY00420 AD1 LDX I1 XYCT STORE THE X COORDI- NUY00430 LD L1 X NATE IN XP NUY00440 STO L XP NUY00450 LD L1 Y STORE THE Y COORDI NUY00460 STO L YP NATE IN YP NUY00470 LDX I1 ZCT NUY00480 LDD L1 Z STORE THE Z COORDI- NUY00490 STD L ZP NATE IN ZP NUY00500 LD L XP NUY00510 M L ONE COMPUTE THE LEFT NUY00520 D L N100 HAND COLUMN NUMBER NUY00530 STO L LLC AND THE X-COORDINATE NUY00540 M L N100 OF THE LEFT HAND NUY00550 SLT 16 NUY00560 STO L XLLC COLUMN NUY00570 LD L LLC NUY00580 A L ONE NUY00590 STO L LLC NUY00600 LD L YP NUY00610 M L ONE COMPUTE THE LOWER NUY00620 D L N100 ROW NUMBER AND THE NUY00630 STO L LLR Y-COORDINATE OF THE NUY00640 M L N100 LOWRT ROW NUY00650 SLT 16 NUY00660 STO L YLLC NUY00670 LD L LLR NUY00680 A L ONE NUY00690 STO L LLR NUY00700 LD L XYCT NUY00710 BSC L AD5,+ NUY00720 AD2 LDX I2 XYCT LOCATE THE FIRST NUY00730 MDX 2 -1 DATA POINT ON OR NUY00740 MDX AD3 TO THE RIGHT OF THE NUY00750 MDX AD4 LEFT COLUMN NUY00760 AD3 LD L2 X NUY00770 S L XLLC NUY00780 BSC L AD3-3,- NUY00790 AD4 MDX 2 1 NUY00800 NOP NUY00810 STX L2 XR2 NUY00820 AD5 MDX 2 1 LOCATE THE LAST NUY00830 NOP NUY00840 STX L2 DUM DATA POINT NUY00850 LD L DUM OF THE RIGHT HAND NUY00860 S L IPTS COLUMN NUY00870 BSC L AD6,- NUY00880 LD L2 X NUY00890 S L XLLC NUY00900 S L N100 NUY00910 BSC L AD5,Z+ NUY00920 AD6 MDX 2 -1 NUY00930 NOP NUY00940 STX L2 XR2P NUY00950 LD L YLLC COMPUTE Y-COORDINATE NUY00960 A L N100 OF UPPER ROW NUY00970 STO L YLLCP NUY00980 ************** NUY00990 ************** NUY01000 * COMPUTE THE CENTROID OF THE POINTS NUY01010 * LYING WITHIN THE GRID SQUARE NUY01020 ************** NUY01030 LD L ZERO NUY01040 STO L N NUY01050 STO L XC NUY01060 STO L YC NUY01070 LDD L FZERO NUY01080 STD L ZC NUY01090 AD7 LDX I2 XR2 NUY01100 AD8 LD L2 Y IS THE POINT ON OR NUY01110 S L YLLC ABOVE THE LOWER ROW NUY01120 BSC L AD9,Z+ NUY01130 LD L2 Y IS THE POINT BELOW NUY01140 S L YLLCP THE UPPER ROW NUY01150 BSC L AD9,- NUY01160 LD L2 X NUY01170 A L XC NUY01180 STO L XC NUY01190 LD L2 Y NUY01200 A L YC NUY01210 STO L YC NUY01220 LD L N NUY01230 A L N1 NUY01240 STO L N NUY01250 STX L2 DUM1 NUY01260 LD L DUM1 NUY01270 SLA 1 NUY01280 STO L DUM NUY01290 LDX I2 DUM NUY01300 LDD L2 Z NUY01310 LDX I2 DUM1 NUY01320 STD L DUM NUY01330 LIBF FLD NUY01340 DC DUM NUY01350 LIBF FADD NUY01360 DC ZC NUY01370 LIBF FSTO NUY01380 DC ZC NUY01390 AD9 MDX 2 1 NUY01400 NOP NUY01410 STX L2 DUM LAST POINT NUY01420 LD L DUM TO BE CHECKED TO NUY01430 S L XR2P DETERMINE THE NUY01440 BSC L AD8,+ CENTROID NUY01450 ************** NUY01460 * COMPUTE THE COORDINATES OF THE CENTROID NUY01470 ************** NUY01480 LD L XC NUY01490 M L ONE NUY01500 D L N NUY01510 STO L XC NUY01520 LD L YC NUY01530 M L ONE NUY01540 D L N NUY01550 STO L YC NUY01560 LD L N NUY01570 LIBF FLOAT NUY01580 LIBF FSTO NUY01590 DC XN NUY01600 LIBF FLD NUY01610 DC ZC NUY01620 LIBF FDIV NUY01630 DC XN NUY01640 LIBF FSTO NUY01650 DC ZC NUY01660 ************** NUY01670 * DETERMINE THE LAST POINT TO THE LEFT NUY01680 * HALF PLANE FROM THE CENTROID NUY01690 ************** NUY01700 LDX I2 XR2 NUY01710 AD10 LD L2 X NUY01720 S L XC NUY01730 BSC L AD11,-Z NUY01740 MDX 2 1 NUY01750 NOP NUY01760 STX L2 DUM NUY01770 LD L DUM NUY01780 S L IPTS NUY01790 BSC L AD10,Z+ NUY01800 AD11 MDX 2 -1 NUY01810 NOP NUY01820 LD L XNIL NUY01830 STO L XS1 SET THE X-COORDINATE NUY01840 STO L XS2 OF THE CLOSEST POINT NUY01850 STO L XS3 IN EACH SECTOR TO NUY01860 STO L XS4 THE NIL VALUE NUY01870 STO L XS5 NUY01880 STO L XS6 NUY01890 STO L XS7 NUY01900 STO L XS8 NUY01910 LD L ZERO SET XLAST TO ZERO NUY01920 STO L XLAST NUY01930 ************** NUY01940 * WORKING BACKWARDS THROUGH THE DATA POINTS NUY01950 * IN THE LEFT HALF PLANE DETERMINE THE NUY01960 * CLOSEST POINT IN EACH OF THE FOUR SECTORS NUY01970 * THAT LIE IN THE LEFT HALF PLANE NUY01980 ************** NUY01990 AD111 LD L2 X TRANSLATE X-COORDINAT NUY02000 S L XC NUY02010 STO L XP NUY02020 M L XP SQUARE OF X-COORDINAT NUY02030 D L TNTHU NUY02040 STO L X2 NUY02050 SLA 1 TWICE SQUARE OF X- NUY02060 STO L TX2 COORDINATE NUY02070 LD L2 Y NUY02080 S L YC TRANSLATE Y-COORDINAT NUY02090 STO L YP NUY02100 M L YP SQUARE OF DISTANCE NUY02110 D L TNTHU TO POINT NUY02120 A L X2 NUY02130 STO L R NUY02140 STX L2 DUM NUY02150 LD L DUM NUY02160 SLA 1 NUY02170 STO L DUM NUY02180 LDX I1 DUM NUY02190 LDD L1 Z NUY02200 STD L DUM NUY02210 LIBF FLD NUY02220 DC DUM NUY02230 LIBF FSUB NUY02240 DC ZC TRANSLATE Z-COOR. NUY02250 LIBF FSTO NUY02260 DC ZP NUY02270 ************** NUY02280 * DOES THE POINT COINCIDE WITH THE CENTROID NUY02290 ************** NUY02300 LD L XP NUY02310 BSC L AD12,Z SKIP POINT IF IT NUY02320 LD L YP COINCIDES WITH THE NUY02330 BSC L AD20,-+ CENTROID NUY02340 ************** NUY02350 *DETERMINE THE SECTOR THAT CONTAINS NUY02360 *DE THE POINT NUY02370 ************** NUY02380 AD12 LD L YP NUY02390 BSC L AD16,-Z NUY02400 S L XP NUY02410 BSC L AD14,-Z NUY02420 LD L XP NUY02430 BSC L AD20,-+ NUY02440 ************** NUY02450 * THE POINT IS IN THE SIXTH SECTOR NUY02460 ************** NUY02470 LD L XS6 HAS A PREVIOUS POINT NUY02480 S L XNIL BEEN FOUND IN SECTOR NUY02490 BSC L AD13,-+ SIX NUY02500 LD L RS6 IS THIS POINT CLOSER NUY02510 S L R THAN THE PREVIOUS NUY02520 BSC L AD20,+ POINT NUY02530 AD13 LD L XP STORE POINT AS THE NUY02540 STO L XS6 CLOSEST POINT IN THE NUY02550 LD L YP SIXTH SECTOR NUY02560 STO L YS6 NUY02570 LD L R NUY02580 STO L RS6 NUY02590 LDD L ZP NUY02600 STD L ZS6 NUY02610 MDX AD20 NUY02620 ************** NUY02630 * THE POINT IS IN THE FIFTH SECTOR NUY02640 ************** NUY02650 AD14 LD L XS5 HAS A PREVIOUS POINT NUY02660 S L XNIL BEEN FOUND IN THE NUY02670 BSC L AD15,-+ FIFTH SECTOR NUY02680 LD L RS5 IS THIS POINT CLOSER NUY02690 S L R THAN THE PREVIOUS NUY02700 BSC L AD20,+ POINT NUY02710 AD15 LD L XP STORE POINT AS THE NUY02720 STO L XS5 CLOSEST POINT IN THE NUY02730 LD L YP FIFTH SECTOR NUY02740 STO L YS5 NUY02750 LD L R NUY02760 STO L RS5 NUY02770 LDD L ZP NUY02780 STD L ZS5 NUY02790 MDX AD20 NUY02800 AD16 LD L XP NUY02810 A L YP NUY02820 BSC L AD18,-Z NUY02830 ************** NUY02840 * THE POINT IS IN THE FOURTH SECTOR NUY02850 ************** NUY02860 LD L XS4 HAS A PREVIOUS POINT NUY02870 S L XNIL BEEN FOUND IN THE NUY02880 BSC L AD17,-+ FOURTH SECTOR NUY02890 LD L RS4 IS THIS POINT CLOSER NUY02900 S L R THAN THE PREVIOUS NUY02910 BSC L AD20,+ POINT NUY02920 AD17 LD L XP STORE POINT AS NUY02930 STO L XS4 CLOSEST POINT IN THE NUY02940 LD L YP FOURTH SECTOR NUY02950 STO L YS4 NUY02960 LD L R NUY02970 STO L RS4 NUY02980 LDD L ZP NUY02990 STD L ZS4 NUY03000 MDX AD20 NUY03010 ************** NUY03020 * THE POINT IS THE THIRD SECTOR NUY03030 ************** NUY03040 AD18 LD L XS3 HAS A POINT BEEN NUY03050 S L XNIL FOUND IN THE THIRD NUY03060 BSC L AD19,-+ SECTOR BEFORE NUY03070 LD L RS3 IS THIS POINT CLOSER NUY03080 S L R THAN THE PREVIOUS NUY03090 BSC L AD20,+ POINT NUY03100 AD19 LD L XP STORE AS THE CLOSEST NUY03110 STO L XS3 POINT IN THE THIRD NUY03120 LD L YP SECTOR NUY03130 STO L YS3 NUY03140 LD L R NUY03150 STO L RS3 NUY03160 LDD L ZP NUY03170 STD L ZS3 NUY03180 AD20 STX L2 DUM NUY03190 LD L DUM NUY03200 BSC L AD28,+ NUY03210 MDX 2 -1 NUY03220 MDX AD21 NUY03230 BSC L AD28 NO MORE POINTS NUY03240 AD21 LD L XP HAS THE VALUE OF THE NUY03250 S L XLAST X-COORDINATE CHANGED NUY03260 BSC L AD111,-+ TRY NEXT POINT NUY03270 ************** NUY03280 * DETERMINE IF IT IS POSSIBLE TO FIND NUY03290 * ANY POINTS WHICH ARE CLOSER THAN THE NUY03300 * ESTABLISHED POINTS NUY03310 ************** NUY03320 AD22 LD L XP UPDATE X-COORDINATE NUY03330 STO L XLAST OF LAST POINT NUY03340 LD L XS3 HAS A POINT BEEN NUY03350 S L XNIL FOUND IN THE THIRD NUY03360 BSC L AD23,-+ SECTOR NUY03370 LD L TX2 IS IT POSSIBLE TO NUY03380 S L RS3 FIND A CLOSER POINT NUY03390 BSC L AD111,+ NUY03400 MDX AD24 NUY03410 AD23 LD L XP IS IT POSSIBLE TO NUY03420 A L YMAX FIND A POINT IN THE NUY03430 S L YC THIRD SECTOR NUY03440 BSC L AD111,-Z NUY03450 AD24 LD L XS4 HAS A POINT BEEN NUY03460 S L XNIL FOUND IN THE FOURTH NUY03470 BSC L AD25,-+ SECTOR NUY03480 LD L X2 IS IT POSSIBLE TO NUY03490 S L RS4 FIND A CLOSER POINT NUY03500 BSC L AD111,+ IN THE FOURTH SECTOR NUY03510 MDX AD26 NUY03520 AD25 LD L YMAX IS IT POSSIBLE TO NUY03530 S L YC FIND A POINT IN THE NUY03540 BSC L AD111,-Z FOURTH NUY03550 AD26 LD L XS5 HAS A POINT BEEN NUY03560 S L XNIL FOUND IN THE FIFTH NUY03570 BSC L AD111,-+ SECTOR NUY03580 LD L X2 IS IT POSSIBLE TO NUY03590 S L RS5 FIND A CLOSER POINT NUY03600 BSC L AD111,Z+ NUY03610 LD L XS6 HAS A POINT BEEN NUY03620 S L XNIL FOUND IN THE SIXTH NUY03630 BSC L AD27,-+ SECTOR NUY03640 LD L TX2 IS IT POSSIBLE TO NUY03650 S L RS6 FIND A CLOSER POINT NUY03660 BSC L AD111,+ NUY03670 MDX AD28 NUY03680 AD27 LD L XP IS IT POSSIBLE TO NUY03690 A L YC FIND A POINT IN THE NUY03700 BSC L AD111,- SIXTH SECTOR NUY03710 ************** NUY03720 * DETERMINE THE FIRST POINT IN THE RIGHT NUY03730 * HALF PLANE FROM THE CENTROID NUY03740 ************** NUY03750 AD28 LDX I2 XR2P NUY03760 LD L ZERO SET XLAST TO ZERO NUY03770 STO L XLAST NUY03780 AD29 LD L2 X NUY03790 S L XC NUY03800 BSC L AD30,Z+ NUY03810 MDX 2 -1 NUY03820 MDX AD29 NUY03830 AD30 MDX 2 1 NUY03840 NOP NUY03850 ************** NUY03860 * WORKING FORWARD THROUGH THE DATA POINTS INNUY03870 * THE RIGHT HALF PLANE, DETERMINE THE NUY03880 * CLOSEST POINT IN EACH OF THE FOUR SECTORS NUY03890 * IN THE RIGHT HALF PLANE NUY03900 ************** NUY03910 AD31 LD L2 X TRANSLATE X-COOR. NUY03920 S L XC NUY03930 STO L XP NUY03940 M L XP NUY03950 D L TNTHU NUY03960 STO L X2 SQUARE OF X-COOR. NUY03970 SLA 1 NUY03980 STO L TX2 2*SQUARE OF X-COOR. NUY03990 LD L2 Y TRANSLATE Y-COOR. NUY04000 S L YC NUY04010 STO L YP NUY04020 M L YP SQUARE OF Y-COOR. NUY04030 D L TNTHU NUY04040 A L X2 SQUARE OF DISTANCE NUY04050 STO L R OF POINT FROM CENTROD NUY04060 STX L2 DUM NUY04070 LD L DUM NUY04080 SLA 1 TRANSLATE Z-COOR. NUY04090 STO L DUM NUY04100 LDX I1 DUM NUY04110 LDD L1 Z NUY04120 STD L DUM NUY04130 LIBF FLD NUY04140 DC DUM NUY04150 LIBF FSUB NUY04160 DC ZC NUY04170 LIBF FSTO NUY04180 DC ZP NUY04190 LD L XP SKIP THIS POINT IF IT NUY04200 BSC L AD31P,Z COINCIDES WITH THE NUY04210 LD L YP CENTROID NUY04220 BSC L AD39,-+ NUY04230 ************** NUY04240 * DETERMINE IN WHICH SECTOR THE POINT LIES NUY04250 ************** NUY04260 AD31P LD L YP NUY04270 BSC L AD35,- NUY04280 A L XP NUY04290 BSC L AD33,- NUY04300 ************** NUY04310 * THE POINT IS IN THE SEVENTH SECTOR NUY04320 ************** NUY04330 LD L XS7 HAS A PREVIOUS POINT NUY04340 S L XNIL BEEN FOUND IN THE NUY04350 BSC L AD32,-+ SEVENTH SECTOR NUY04360 LD L RS7 IS THIS POINT CLOSER NUY04370 S L R THAN THE PREVIOUS NUY04380 BSC L AD39,+ POINT NUY04390 AD32 LD L XP STORE THEIS POINT AS NUY04400 STO L XS7 THE CLOSEST POINT IN NUY04410 LD L YP THE SEVENTH SECTOR NUY04420 STO L YS7 NUY04430 LD L R NUY04440 STO L RS7 NUY04450 LDD L ZP NUY04460 STD L ZS7 NUY04470 MDX AD39 NUY04480 ************** NUY04490 * THE POINT IS THE EIGHTH SECTOR NUY04500 ************** NUY04510 AD33 LD L XS8 HAS A PREVIOUS POINT NUY04520 S L XNIL BEEN FOUNS IN THE NUY04530 BSC L AD34,-+ EIGHTH SECTOR NUY04540 LD L RS8 IS THIS POINT CLOSER NUY04550 S L R THAN THE PREVIOUS NUY04560 BSC L AD39,+ POINT NUY04570 AD34 LD L XP STORE THIS POINT AS NUY04580 STO L XS8 THE CLOSEST POINT IN NUY04590 LD L YP THE EIGHTH SECTOR NUY04600 STO L YS8 NUY04610 LD L R NUY04620 STO L RS8 NUY04630 LDD L ZP NUY04640 STD L ZS8 NUY04650 MDX AD39 NUY04660 AD35 LD L XP NUY04670 BSC L AD39,-+ NUY04680 S L YP NUY04690 BSC L AD37,-Z NUY04700 ************** NUY04710 * THIS POINT IS IN THE SECOND SECTOR NUY04720 ************** NUY04730 LD L XS2 HAS A PREVIOUS POINT NUY04740 S L XNIL BEEN FOUND IN THE NUY04750 BSC L AD36,-+ SECOND SECTOR NUY04760 LD L RS2 IS THIS POINT CLOSER NUY04770 S L R THAN THE PREVIOUS NUY04780 BSC L AD39,+ POINT NUY04790 AD36 LD L XP STORE POINT AS THE NUY04800 STO L XS2 CLOSEST POINT IN THE NUY04810 LD L YP SECOND SECTOR NUY04820 STO L YS2 NUY04830 LD L R NUY04840 STO L RS2 NUY04850 LDD L ZP NUY04860 STD L ZS2 NUY04870 MDX AD39 NUY04880 ************** NUY04890 * THIS POINT IS IN THE FIRST SECTOR NUY04900 ************** NUY04910 AD37 LD L XS1 HAS A PREVIOUS POINT NUY04920 S L XNIL BEEN FOUND IN THE NUY04930 BSC L AD38,-+ FIRST SECTOR NUY04940 LD L RS1 IS THIS POINT CLOSER NUY04950 S L R THAN THE PREVIOUS NUY04960 BSC L AD39,+ POINT NUY04970 AD38 LD L XP STORE THIS POINT AS NUY04980 STO L XS1 THE CLOSEST POINT NUY04990 LD L YP IN THE FIRST SECTOR NUY05000 STO L YS1 NUY05010 LD L R NUY05020 STO L RS1 NUY05030 LDD L ZP NUY05040 STD L ZS1 NUY05050 AD39 MDX 2 1 INCREMENT INDEX NUY05060 STX L2 DUM NUY05070 LD L DUM ARE THERE MORE POINTS NUY05080 S L IPTS TO BE TESTED NUY05090 BSC L AD45,- NUY05100 LD L XP HAS THE X-COORDINATE NUY05110 S L XLAST CHANGED NUY05120 BSC L AD31,-+ NUY05130 LD L XP NUY05140 STO L XLAST NUY05150 ************** NUY05160 * DETERMINE IF IT IS POSSIBLE TO FIND ANY NUY05170 * POINTS CLOSER THAN THE PREVIOUSLY NUY05180 * ESTABLISHED POINTS NUY05190 ************** NUY05200 LD L XS1 HAS A POINT BEEN NUY05210 S L XNIL FOUND IN THE FIRST NUY05220 BSC L AD31,-+ SECTOR NUY05230 LD L X2 IS IT POSSIBLE TO NUY05240 S L RS1 FIND A CLOSER POINT NUY05250 BSC L AD31,+ NUY05260 LD L XS2 HAS A POINT BEEN NUY05270 S L XNIL FOUND IN THE SECOND NUY05280 BSC L AD40,-+ SECTOR NUY05290 LD L RS2 IS IT POSSIBLE TO NUY05300 S L TX2 FIND A CLOSER POINT NUY05310 BSC L AD31,- IN THE SECOND SECTOR NUY05320 MDX AD41 NUY05330 AD40 LD L XP IS IT POSSIBLE TO NUY05340 S L YMAX FIND A POINT IN THE NUY05350 A L YC SECOND SECTOR NUY05360 BSC L AD31,+ NUY05370 AD41 LD L XS8 HAS A POINT BEEN NUY05380 S L XNIL FOUND IN THE EIGHTH NUY05390 BSC L AD42,-+ SECTOR NUY05400 LD L X2 IS IT POSSIBLE TO NUY05410 S L RS8 FIND A POINT CLOSER NUY05420 BSC L AD31,+ THAN THIS POINT NUY05430 MDX AD43 NUY05440 AD42 LD L YC IS IT POSSIBLE NUY05450 BSC L AD31,-Z FIND A POINT IN THE NUY05460 * EIGHTH SECTOR NUY05470 AD43 LD L XS7 HAS A POINT BEEB NUY05480 S L XNIL FOUND IN THE SEVENTH NUY05490 BSC L AD44,-+ SECTOR NUY05500 LD L TX2 IS IT POSSIBLE TO NUY05510 S L RS7 FIND A POINT CLOSER NUY05520 BSC L AD31,+ THAN THIS POINT NUY05530 MDX AD45 NUY05540 AD44 LD L XP IS IT POSSIBLE TO NUY05550 S L YC FIND A POINT IN THE NUY05560 BSC L AD31,+ SEVENTH SECTOR NUY05570 ************** NUY05580 * PERFORM A LEAST SQUARES FIT TO THE NUY05590 * SURROUNDING DATA POINTS TO DETERMINE NUY05600 * THE SLOPE OF THE SURFACE THROUGH THE NUY05610 * CENTROID NUY05620 ************** NUY05630 AD45 LDX I2 ZERO CONVERT COORDINATES NUY05640 LD L XLLC OF CENTROID NUY05650 LIBF FLOAT TO FLOATING POINT NUY05660 LIBF FDIV NUY05670 DC F100 NUY05680 LIBF FSTO NUY05690 DC XLLC NUY05700 LD L XC NUY05710 LIBF FLOAT NUY05720 LIBF FDIV NUY05730 DC F100 NUY05740 LIBF FSTO NUY05750 DC XC NUY05760 LD L YLLC NUY05770 LIBF FLOAT NUY05780 LIBF FDIV NUY05790 DC F100 NUY05800 LIBF FSTO NUY05810 DC YLLC NUY05820 LD L YC NUY05830 LIBF FLOAT NUY05840 LIBF FDIV NUY05850 DC F100 NUY05860 LIBF FSTO NUY05870 DC YC NUY05880 AD451 LD L2 XS1 CONVERT COORDINATES NUY05890 S L XNIL OF POINTS IN THE NUY05900 BSC L AD452,-+ EIGHT SECTORS NUY05910 LD L2 XS1 TO FLOATING POINT NUY05920 LIBF FLOAT NUY05930 LIBF FDIV NUY05940 DC F100 NUY05950 LIBF FSTO NUY05960 DC DUM NUY05970 LDD L DUM NUY05980 STD L2 XS1 NUY05990 LD L2 YS1 NUY06000 LIBF FLOAT NUY06010 LIBF FDIV NUY06020 DC F100 NUY06030 LIBF FSTO NUY06040 DC DUM NUY06050 LDD L DUM NUY06060 STD L2 YS1 NUY06070 LD L2 RS1 NUY06080 LIBF FLOAT NUY06090 LIBF FSTO NUY06100 DC DUM NUY06110 LDD L DUM NUY06120 STD L2 RS1 NUY06130 MDX AD453 NUY06140 AD452 LDD L ZNIL INITIALIZE NUY06150 STD L2 ZS1 PARAMETERS NUY06160 AD453 MDX 2 2 FOR LEAST NUY06170 STX L2 DUM SQUARES FIT NUY06180 LD L DUM NUY06190 S L N16 NUY06200 BSC L AD451,Z+ NUY06210 LDD L FZERO NUY06220 STD L C1 NUY06230 STD L C2 NUY06240 STD L C3 NUY06250 STD L C4 NUY06260 STD L C7 NUY06270 LDX I2 ZERO NUY06280 AD46 LDD L2 ZS1 DETERMINE THE NUY06290 STD L ZS1 COEFFICIENTS OF NUY06300 LIBF FLD THE NORMAL EQUATIONS NUY06310 DC ZS1 NUY06320 LIBF FSUB NUY06330 DC ZNIL NUY06340 LIBF FSTO NUY06350 DC DUM NUY06360 LD L DUM NUY06370 BSC L AD47,-+ NUY06380 LDD L2 XS1 NUY06390 STD L XS1 NUY06400 LDD L2 YS1 NUY06410 STD L YS1 NUY06420 LDD L2 RS1 NUY06430 STD L RS1 NUY06440 LIBF FLD NUY06450 DC XS1 NUY06460 LIBF FDIV NUY06470 DC RS1 NUY06480 LIBF FSTO NUY06490 DC WX NUY06500 LIBF FLD NUY06510 DC YS1 NUY06520 LIBF FDIV NUY06530 DC RS1 NUY06540 LIBF FSTO NUY06550 DC WY NUY06560 LIBF FLD NUY06570 DC WX NUY06580 LIBF FMPY NUY06590 DC XS1 NUY06600 LIBF FADD NUY06610 DC C1 NUY06620 LIBF FSTO NUY06630 DC C1 NUY06640 LIBF FLD NUY06650 DC WX NUY06660 LIBF FMPY NUY06670 DC YS1 NUY06680 LIBF FADD NUY06690 DC C2 NUY06700 LIBF FSTO NUY06710 DC C2 NUY06720 LIBF FLD NUY06730 DC WY NUY06740 LIBF FMPY NUY06750 DC YS1 NUY06760 LIBF FADD NUY06770 DC C3 NUY06780 LIBF FSTO NUY06790 DC C3 NUY06800 LIBF FLD NUY06810 DC WX NUY06820 LIBF FMPY NUY06830 DC ZS1 NUY06840 LIBF FADD NUY06850 DC C4 NUY06860 LIBF FSTO NUY06870 DC C4 NUY06880 LIBF FLD NUY06890 DC WY NUY06900 LIBF FMPY NUY06910 DC ZS1 NUY06920 LIBF FADD NUY06930 DC C7 NUY06940 LIBF FSTO NUY06950 DC C7 NUY06960 AD47 MDX 2 2 NUY06970 STX L2 DUM NUY06980 LD L DUM NUY06990 S L N16 NUY07000 BSC L AD46,Z+ NUY07010 LIBF FLD SOLVE FOR THE NUY07020 DC C2 COEFFICIENTS OF NUY07030 LIBF FMPY THE X AND Y TERMS NUY07040 DC C2 NUY07050 LIBF FSTO NUY07060 DC ACC1 NUY07070 LIBF FLD NUY07080 DC C1 NUY07090 LIBF FMPY NUY07100 DC C3 NUY07110 LIBF FSUB NUY07120 DC ACC1 NUY07130 LIBF FSTO NUY07140 DC ACC1 NUY07150 LD L ACC1 NUY07160 BSC L AD48,Z NUY07170 LDD L FZERO NUY07180 STD L A NUY07190 STD L B NUY07200 MDX AD49 NUY07210 AD48 LIBF FLD NUY07220 DC C2 NUY07230 LIBF FMPY NUY07240 DC C4 NUY07250 LIBF FSTO NUY07260 DC ACC2 NUY07270 LIBF FLD NUY07280 DC C1 NUY07290 LIBF FMPY NUY07300 DC C7 NUY07310 LIBF FSUB NUY07320 DC ACC2 NUY07330 LIBF FDIV NUY07340 DC ACC1 NUY07350 LIBF FSTO NUY07360 DC B NUY07370 LIBF FMPY NUY07380 DC C2 NUY07390 LIBF FSTO NUY07400 DC ACC1 NUY07410 LIBF FLD NUY07420 DC C4 NUY07430 LIBF FSUB NUY07440 DC ACC1 NUY07450 LIBF FDIV NUY07460 DC C1 NUY07470 LIBF FSTO NUY07480 DC A NUY07490 AD49 LIBF FLD NUY07500 DC XLLC NUY07510 LIBF FSUB NUY07520 DC XC NUY07530 LIBF FMPY NUY07540 DC A NUY07550 LIBF FSTO NUY07560 DC ACC1 NUY07570 LIBF FADD NUY07580 DC A NUY07590 LIBF FSTO NUY07600 DC ACC3 NUY07610 LIBF FLD NUY07620 DC YLLC NUY07630 LIBF FSUB NUY07640 DC YC NUY07650 LIBF FMPY NUY07660 DC B NUY07670 LIBF FSTO NUY07680 DC ACC2 NUY07690 LIBF FADD NUY07700 DC B NUY07710 LIBF FSTO NUY07720 DC ACC4 NUY07730 LIBF FLD FIND THE VALUE OF NUY07740 DC ACC1 THE PLANE AT EACH NUY07750 LIBF FADD CORNER OF THE GRID NUY07760 DC ACC2 SQUARE NUY07770 LIBF FADD NUY07780 DC ZC NUY07790 LIBF FSTO NUY07800 DC ZLL NUY07810 LIBF FLD NUY07820 DC ACC3 NUY07830 LIBF FADD NUY07840 DC ACC2 NUY07850 LIBF FADD NUY07860 DC ZC NUY07870 LIBF FSTO NUY07880 DC ZLR NUY07890 LIBF FLD NUY07900 DC ACC3 NUY07910 LIBF FADD NUY07920 DC ACC4 NUY07930 LIBF FADD NUY07940 DC ZC NUY07950 LIBF FSTO NUY07960 DC ZUR NUY07970 LIBF FLD NUY07980 DC ACC1 NUY07990 LIBF FADD NUY08000 DC ACC4 NUY08010 LIBF FADD NUY08020 DC ZC NUY08030 LIBF FSTO NUY08040 DC ZUL NUY08050 LD L LLC STORE THE VALUE NUY08060 STO L COL AT EACH GRID POINT NUY08070 LD L LLR NUY08080 STO L ROW NUY08090 LDD L ZLL NUY08100 STD L ZP NUY08110 BSI L STGRD NUY08120 LD L COL NUY08130 A L ONE NUY08140 STO L COL NUY08150 LDD L ZLR NUY08160 STD L ZP NUY08170 BSI L STGRD NUY08180 LD L ROW NUY08190 A L ONE NUY08200 STO L ROW NUY08210 LDD L ZUR NUY08220 STD L ZP NUY08230 BSI L STGRD NUY08240 LD L COL NUY08250 S L ONE NUY08260 STO L COL NUY08270 LDD L ZUL NUY08280 STD L ZP NUY08290 BSI L STGRD NUY08300 MDX L XYCT,1 INCREMENT INDEX NUY08310 MDX L ZCT,2 NUY08320 LD L XYCT NUY08330 S L IPTS NUY08340 BSC L AD1,Z+ NUY08350 LD L N1047 NUY08360 STO L DSKOT NUY08370 OKA LIBF DISKN NUY08380 DC /5000 NUY08390 DC DSKOT NUY08400 DC ERRS NUY08410 LIBF DISKN NUY08420 DC /4000 NUY08430 DC DSKOT NUY08440 LIBF DISKN NUY08450 DC /0000 NUY08460 DC DSKOT NUY08470 MDX *-4 NUY08480 LINK NUPRZ NUY08490 ************** NUY08500 * ROUTINE TO STORE A COMPUTED GRID VALUE NUY08510 ************** NUY08520 STGRD NOP NUY08530 LD L COL NUY08540 S L ICMAX NUY08550 BSC L STGR6,Z- NUY08560 BSI L GRDVA READ COLUMN NUY08570 LD L ROW CONTAINING THE POINT NUY08580 A L ROW NUY08590 STO L DUM NUY08600 LDX I1 DUM NUY08610 LDD L1 ZG-2 IS THE POINT ALREADY NUY08620 STD L DUM DEFINED NUY08630 LIBF FLD NUY08640 DC DUM NUY08650 LIBF FSUB NUY08660 DC ZNIL NUY08670 LIBF FSTO NUY08680 DC DUM1 NUY08690 LD L DUM1 NUY08700 BSC L STGR1,-+ NUY08710 LIBF FLD AVERAGE THE TWO NUY08720 DC DUM VALUES NUY08730 LIBF FADD NUY08740 DC ZP NUY08750 LIBF FDIV NUY08760 DC FTWO NUY08770 LIBF FSTO NUY08780 DC ZP NUY08790 STGR1 LD L ISIGN IS A SIGN RESTRICTION NUY08800 S L ONE SPECIFIED NUY08810 BSC L STGR2,+ TEST THAT THE VALUE NUY08820 LD L ZP IS NOT POSITIVE NUY08830 BSC L STGR3,+ NUY08840 LDD L FZERO NUY08850 STD L ZP NUY08860 MDX STGR3 NUY08870 STGR2 LD L ISIGN NUY08880 BSC L STGR3,+ NUY08890 LD L ZP TEST THAT THE VALUE NUY08900 BSC L STGR3,- IS NOT NEGATIVE NUY08910 LDD L FZERO NUY08920 STD L ZP NUY08930 STGR3 LD L MINZ IS A MINIMUM VALUE NUY08940 BSC L STGR4,+ SPECIFIED NUY08950 LIBF FLD NUY08960 DC ZP NUY08970 LIBF FSUB TEST THAT THE VALUE NUY08980 DC ZMIN IS NOT LESS THAN THE NUY08990 LIBF FSTO MINIMUM NUY09000 DC DUM NUY09010 LD L DUM NUY09020 BSC L STGR4,- NUY09030 LDD L ZMIN NUY09040 STD L ZP NUY09050 STGR4 LD L MAXZ IS A MAXIMUM VALUE NUY09060 BSC L STGR5,+ SPECIFIED NUY09070 LIBF FLD NUY09080 DC ZP TEST THAT THE VALUE NUY09090 LIBF FSUB IS NOT GREATER THAN NUY09100 DC ZMAX THE MAXIMUM NUY09110 LIBF FSTO NUY09120 DC DUM NUY09130 LD L DUM NUY09140 BSC L STGR5,+ NUY09150 LDD L ZMAX NUY09160 STD L ZP NUY09170 STGR5 LDD L ZP STORE OUTPUT GRID NUY09180 STD L1 ZG-2 VALUE ON THE DISK NUY09190 BSI L WRTGR NUY09200 STGR6 BSC I STGRD NUY09210 *************** NUY09220 * GRDVA SUBROUTINE NUY09230 *************** NUY09240 GRDVA NOP SUBROUTINE TO NUY09250 STX L1 DIX1 NUY09260 STX L2 DIX2 NUY09270 BSI L SCCOM READ THE GRID NUY09280 LD L SCLOC VALUES FROM THE NUY09290 STO L WKIO&1 DISK DATA AREA NUY09300 LD L FX640 NUY09310 STO L WKIO NUY09320 LIBF DISKN NUY09330 DC /5000 NUY09340 DC WKIO NUY09350 DC ERRS NUY09360 LIBF DISKN NUY09370 DC /1000 NUY09380 DC WKIO NUY09390 DC ERRS NUY09400 LD L ININX NUY09410 A L FX218 NUY09420 STO L DUMY NUY09430 LDX I1 DUMY NUY09440 LDX I2 FX200 NUY09450 LIBF DISKN NUY09460 DC /0000 NUY09470 DC WKIO NUY09480 MDX *-4 NUY09490 LDD L1 WKIO NUY09500 STD L2 ZG-2 NUY09510 MDX 1 -2 NUY09520 MDX 2 -2 NUY09530 MDX *-7 NUY09540 LDX I1 ININX NUY09550 LD L1 WKIO NUY09560 STO L ICOL NUY09570 STO L THCOL NUY09580 LD L1 WKIO+1 NUY09590 STO L IRBGN NUY09600 LD L1 WKIO+2 NUY09610 STO L IREND NUY09620 LDX I1 DIX1 NUY09630 LDX I2 DIX2 NUY09640 BSC I GRDVA NUY09650 *************** NUY09660 * NO ROOM FOR ERROR MESSAGES IN THIS PHASE NUY09670 * SO ERRORS MUST BE HANDLED BY PHASES NUY09680 * ERRSL AND EROBL NUY09690 *************** NUY09700 ERRS DC 0 NUY09710 LINK ERRSL NUY09720 EROB LINK EROBL NUY09730 *************** NUY09740 * WRTGR SUBROUTINE NUY09750 *************** NUY09760 WRTGR NOP SUBROUTINE TO NUY09770 STX L1 DIX1 NUY09780 STX L2 DIX2 NUY09790 BSI L SCCOM WRITE THE OUTPUT NUY09800 LIBF DISKN GRID COLUMNS ON NUY09810 DC /0000 THE DISK NUY09820 DC WKIO NUY09830 MDX *-4 NUY09840 LD L FX640 NUY09850 STO L WKIO NUY09860 LD L SCLOC NUY09870 STO L WKIO+1 NUY09880 LIBF DISKN NUY09890 DC /5000 NUY09900 DC WKIO NUY09910 DC ERRS NUY09920 LIBF DISKN NUY09930 DC /1000 NUY09940 DC WKIO NUY09950 DC ERRS NUY09960 LIBF DISKN NUY09970 DC /0000 NUY09980 DC WKIO NUY09990 MDX *-4 NUY10000 LD L ININX NUY10010 A L FX418 NUY10020 STO L DUMY NUY10030 LDX I1 DUMY NUY10040 LDX I2 FX420 NUY10050 LDD L ZNIL NUY10060 STD L1 WKIO NUY10070 MDX 1 -2 NUY10080 MDX 2 -2 NUY10090 MDX *-5 NUY10100 LD L IEZ NUY10110 A L IEZ NUY10120 STO L DUMY NUY10130 LDX I2 DUMY NUY10140 LD L ININX NUY10150 A L FX20 NUY10160 A L DUMY NUY10170 S L TWO NUY10180 STO L DUMY NUY10190 LDX I1 DUMY NUY10200 LDD L2 ZO-2 NUY10210 STD L1 WKIO NUY10220 MDX 1 -2 NUY10230 MDX 2 -2 NUY10240 MDX *-7 NUY10250 LDX I1 ININX NUY10260 LD L KCOLZ NUY10270 STO L1 WKIO NUY10280 LD L IBZ NUY10290 STO L1 WKIO+1 NUY10300 LD L IEZ NUY10310 STO L1 WKIO&2 NUY10320 LIBF DISKN NUY10330 DC /4000 NUY10340 DC WKIO NUY10350 LIBF DISKN NUY10360 DC /0000 NUY10370 DC WKIO NUY10380 MDX *-4 NUY10390 LDX I1 DIX1 NUY10400 LDX I2 DIX2 NUY10410 BSC I WRTGR NUY10420 * SCCOM SUBROUTINE NUY10430 *************** NUY10440 SCCOM NOP SUBROUTINE TO NUY10450 LD L THCOL COMPUTE THE NUY10460 S L ONE LOCATION OF THE NUY10470 M L ONE SUCCESSIVE NUY10480 D L THREE COLUMNS IN THE NUY10490 STO L DUMY DISK DATA AREA NUY10500 M L FOUR NUY10510 D L ONE NUY10520 STO L SCINC NUY10530 LD L DUMY NUY10540 M L THREE NUY10550 D L ONE NUY10560 STO L DUMY NUY10570 LD L THCOL NUY10580 S L DUMY NUY10590 S L ONE NUY10600 STO L SCINX NUY10610 A L SCINC NUY10620 STO L SCINC NUY10630 A L SCSTR NUY10640 STO L SCLOC NUY10650 S L SCBGN NUY10660 BSC L EROB,Z+ NUY10670 S L SCLGT NUY10680 BSC L EROB,- NUY10690 LD L FX100 NUY10700 M L SCINX NUY10710 D L ONE NUY10720 A L FX22 NUY10730 STO L ININX NUY10740 BSC I SCCOM NUY10750 ************** NUY10760 * FLOATING POINT CONSTANTS NUY10770 ************** NUY10780 FZERO DEC 0. NUY10790 FONE DEC 1.0 NUY10800 FTWO DEC 2.0 NUY10810 ZNIL DEC -1.E30 NUY10820 F100 DEC 100. NUY10830 *************** NUY10840 * THIS AREA IS THE COMMON RETAINED ON THE NUY10850 * DISK AT THE END OF THE RDDAT PHASE NUY10860 *************** NUY10870 BSS E 0 *ALIGNMENT NUY10880 DSKOT DC 4018 * NUY10890 DC 1584 * NUY10900 YMAX BSS 2 * NUY10910 ZMIN BSS 2 * NUY10920 ZMAX BSS 2 * NUY10930 ICMAX BSS 1 *MAX COLUMN NUY10940 IRMAX BSS 1 *MAX ROW NUY10950 ISIGN BSS 1 *SIGN SWITCH NUY10960 IRSTR BSS 1 *BORDER SWITCH NUY10970 MINZ BSS 1 *Z LIMITS NUY10980 MAXZ BSS 1 *SWITCHES NUY10990 IPTS BSS 1 *NO. OF POINTS NUY11000 SCINC BSS 1 *OUTPUT DATA SET NUY11010 SCSTR BSS 1 *LOCATION NUY11020 SCINX BSS 1 *PARAMETERS NUY11030 SCLOC BSS 1 * NUY11040 ININX BSS 1 * NUY11050 X BSS E 1000 *VALUES OF X NUY11060 Y BSS E 1000 *VALUES OF Y NUY11070 Z BSS E 2000 *VALUES OF Z NUY11080 ************** NUY11090 * FIXED POINT CONSTANTS NUY11100 ************** NUY11110 FX218 DC 218 NUY11120 FX200 DC 200 NUY11130 ZERO DC 0 NUY11140 BSS E 0 NUY11150 DC 0 NUY11160 ONE DC 1 NUY11170 N100 DC 100 NUY11180 XNIL DC -20000 NUY11190 TNTHU DC 10000 NUY11200 N16 DC 16 NUY11210 TWO DC 2 NUY11220 FX20 DC 20 NUY11230 SCBGN DC 448 NUY11240 FOUR DC 4 NUY11250 THREE DC 3 NUY11260 SCLGT DC 808 NUY11270 FX22 DC 22 NUY11280 FX640 DC 640 NUY11290 FX418 DC 418 NUY11300 FX420 DC 420 NUY11310 N1047 DC 18 NUY11320 ************** NUY11330 * VARIABLES NUY11340 ************** NUY11350 COL BSS 1 COLUMN NO. NUY11360 ICOL BSS 1 SAME NUY11370 BSS E 0 ALIGNMENT NUY11380 DC 0 NUY11390 ROW BSS 1 ODD LOCATION NUY11400 ZG BSS 200 COLUMN VECTOR NUY11410 XP BSS 2 COORDINATES OF DATA NUY11420 YP BSS 2 POINTS TRANSLATED NUY11430 ZP BSS 2 RELATIVE TO CENTROID NUY11440 DUM BSS 2 TEMPORARY NUY11450 DUM1 BSS 2 STORAGE NUY11460 DUMY BSS 2 NUY11470 DIX1 BSS 2 NUY11480 DIX2 BSS 2 NUY11490 XC BSS E 2 COORDINATES OF NUY11500 YC BSS E 2 CENTROID NUY11510 ZC BSS E 2 NUY11520 XN BSS 2 NO. PTS. IN CENT. NUY11530 XS1 DEC 0. STORAGE USED NUY11540 XS2 DEC 0. IN LEAST SQUARES NUY11550 XS3 DEC 0. FIT NUY11560 XS4 DEC 0. NUY11570 XS5 DEC 0. NUY11580 XS6 DEC 0. NUY11590 XS7 DEC 0. NUY11600 XS8 DEC 0. NUY11610 YS1 BSS 2 NUY11620 YS2 BSS 2 NUY11630 YS3 BSS 2 NUY11640 YS4 BSS 2 NUY11650 YS5 BSS 2 NUY11660 YS6 BSS 2 NUY11670 YS7 BSS 2 NUY11680 YS8 BSS 2 NUY11690 ZS1 BSS 2 NUY11700 ZS2 BSS 2 NUY11710 ZS3 BSS 2 NUY11720 ZS4 BSS 2 NUY11730 ZS5 BSS 2 NUY11740 ZS6 BSS 2 NUY11750 ZS7 BSS 2 NUY11760 ZS8 BSS 2 NUY11770 RS1 BSS 2 NUY11780 RS2 BSS 2 NUY11790 RS3 BSS 2 NUY11800 RS4 BSS 2 NUY11810 RS5 BSS 2 NUY11820 RS6 BSS 2 NUY11830 RS7 BSS 2 NUY11840 RS8 BSS 2 NUY11850 R BSS 2 NUY11860 C1 BSS 2 NUY11870 C2 BSS 2 NUY11880 C3 BSS 2 NUY11890 C4 BSS 2 NUY11900 C5 BSS 2 NUY11910 C6 BSS 2 NUY11920 C7 BSS 2 NUY11930 C8 BSS 2 NUY11940 C9 BSS 2 NUY11950 WX BSS 2 NUY11960 WY BSS 2 NUY11970 ACC1 BSS 2 NUY11980 A BSS 2 NUY11990 B BSS 2 NUY12000 ACC2 BSS 2 NUY12010 ACC3 BSS 2 NUY12020 ACC4 BSS 2 NUY12030 ZLL BSS 2 VALUES AT NUY12040 ZLR BSS 2 GRID CORNERS NUY12050 ZUR BSS 2 NUY12060 ZUL BSS 2 NUY12070 XLLC BSS E 2 X LL CORNER NUY12080 YLLC BSS E 2 Y LL CORNER NUY12090 XYCT BSS 1 POINTERS TO NUY12100 ZCT BSS 1 ARRAYS NUY12110 LLC BSS 1 VALUES OF NUY12120 LLR BSS 1 GRID CORNERS NUY12130 XR2 BSS 1 CENTROID LIMIT NUY12140 XR2P BSS 1 POINTERS NUY12150 YLLCP BSS 1 NUY12160 N BSS 1 PTS. IN CENTROID NUY12170 XLAST BSS 1 NUY12180 X2 BSS 1 X*X NUY12190 TX2 BSS 1 2X*X NUY12200 IRBGN BSS 1 BEG. ROW NUY12210 IREND BSS 1 ENDING ROW NUY12220 WKIO BSS E 642 DISK I/O BUFFER NUY12230 *************** NUY12240 * EQUATES NUY12250 *************** NUY12260 IBZ EQU ONE NUY12270 IEZ EQU IRMAX NUY12280 KCOLZ EQU COL NUY12290 SCSTC EQU SCSTR NUY12300 ICMXA EQU ICMAX NUY12310 IRMXA EQU IRMAX NUY12320 FX100 EQU N100 NUY12330 THCOL EQU COL NUY12340 MXCOL EQU ICMAX NUY12350 MXROW EQU IRMAX NUY12360 N1 EQU ONE NUY12370 ZO EQU ZG NUY12380 END OKB NUY12390 // DUP NUY12400 *STORE WS UA NUPRY NUY12410 // JOB NUZ00010 // DUP NUZ00020 *DELETE UA NUPRZ NUZ00030 // JOB NUZ00040 // ASM NUZ00050 *LIST NUZ00060 *************** NUZ00070 * NUPRZ - THIS PHASE ESTABLISHES GRID VALUES NUZ00080 * FOR ALL REMAINING POINTS WITHIN THE NUZ00090 * SPECIFIED BOUNDARY BY WORKING NUZ00100 * OUTWARD FROM THE GRID POINTS NUZ00110 * ESTABLISHED BY NUPRY NUZ00120 *************** NUZ00130 OKB LIBF DISKN BRING IN COMMON NUZ00140 DC /5000 LEFT ON DISK BY NUZ00150 DC DSKOT NUPRY NUZ00160 DC ERRS NUZ00170 LIBF DISKN NUZ00180 DC /1000 NUZ00190 DC DSKOT NUZ00200 DC ERRS NUZ00210 LIBF DISKN NUZ00220 DC /0000 NUZ00230 DC DSKOT NUZ00240 MDX *-4 NUZ00 5 LDX I1 M100 NUZ00260 LDD L FZERO NUZ00270 STD L DUM NUZ00280 *************** NUZ00290 * ESTABLISH THE TN225 AND TN625 ARRAYS FOR NUZ00300 * USE IN DIRECTIONAL SEARCH NUZ00310 *************** NUZ00320 TANL LIBF FLD NUZ00330 DC DUM NUZ00340 LIBF FADD NUZ00350 DC FONE NUZ00360 LIBF FSTO NUZ00370 DC DUM NUZ00380 LIBF FMPY NUZ00390 DC TN225 NUZ00400 LIBF IFIX NUZ00410 STO L1 I225+100 NUZ00420 LIBF FLD NUZ00430 DC DUM NUZ00440 LIBF FMPY NUZ00450 DC TN675 NUZ00460 LIBF IFIX NUZ00470 STO L1 I675+100 NUZ00480 MDX 1 1 NUZ00490 MDX TANL NUZ00500 LD L ZERO NUZ00510 *************** NUZ00520 * ZERO OUT ARRAY OF BIT SWITCHES FOR EVALUATED NUZ00530 * POINTS NUZ00540 *************** NUZ00550 LDX I1 NG625 NUZ00560 BND STO L1 IZ+625 NUZ00570 MDX 1 1 NUZ00580 MDX BND NUZ00590 *************** NUZ00600 * DETERMINE WHICH POINTS HAVE ALREADY NUZ00610 * BEEN EVALUATED NUZ00620 *************** NUZ00630 LD L ZERO NUZ00640 STO L COL NUZ00650 REPCO MDX L COL,1 GET COLUMN OF NUZ00660 BSI L GRDVA GRID VALUES NUZ00670 LD L ZERO NUZ00680 STO L ROW NUZ00690 LDX I1 ZERO NUZ00700 REPZS MDX L ROW,1 INCREMENT ROW NUZ00710 LDD L1 ZG COMPARE Z VALUE NUZ00720 STD L DUM WITH ZNIL NUZ00730 LIBF FLD NUZ00740 DC DUM NUZ00750 LIBF FSUB NUZ00760 DC ZNIL NUZ00770 LIBF FSTO NUZ00780 DC DUM NUZ00790 LD L DUM NUZ00800 BSC L ISNIL,+- BRANCH IF ZNIL NUZ00810 BSI L SETSW SET BIT SWITCH NUZ00820 ISNIL MDX 1 2 NUZ00830 STX L1 DUM ARE ALL ROWS NUZ00840 LD L DUM DONE NUZ00850 SRA 1 NUZ00860 S L IRMAX NUZ00870 BSC L REPZS,Z+ BRANCH IF NOT NUZ00880 LD L COL ARE ALL COLUMNS NUZ00890 S L ICMAX DONE NUZ00900 BSC L REPCO,Z+ BRANCH IF NOT NUZ00910 ************** NUZ00920 * THIS SECTION OF CODE COMPUTES THE GRID NUZ00930 * VALUES THAT ARE NOT ADJACENT TO THE NUZ00940 * ORIGINAL INPUT DATA POINTS NUZ00950 ************** NUZ00960 STO LD L SIX SET THE NUMBER OF NUZ00970 STO L NMTST REQUIRED SURROUNDING NUZ00980 * POINTS TO SIX NUZ00990 ************** NUZ01000 * SET UP FOR A SWEEP THROUGH THE GRID NUZ01010 * SYSTEM TO DEFINE THE GRID VALUES IN A NUZ01020 * SEQUENCE WHICH RADIATES OUT FROM THE NUZ01030 * ORIGINAL DATA POINTS NUZ01040 ************** NUZ01050 ST1 LD L ZERO SET SWITCH THAT NO NUZ01060 STO L ICHNG GRID VALUE HAS BEEN NUZ01070 * DEFINED IN THIS SWEEP NUZ01080 LDX I1 ZERO SET SWITCHES THAT NO NUZ01090 ST1P STO L1 ICOL2 GRID VALUES HAVE BEEN NUZ01100 MDX 1 1 DEFINED IN THIS COL. NUZ01110 STX L1 DUM NUZ01120 LD L DUM NUZ01130 S L N100 NUZ01140 BSC L ST1P1,- NUZ01150 LD L ZERO NUZ01160 MDX ST1P NUZ01170 ST1P1 LD L ZERO NUZ01180 STO L I NUZ01190 ST2 MDX L I,1 I CONTAINS THE NUMBER NUZ01200 LDX I1 M100 OF THIS COLUMN NUZ01210 ST2P LD L1 ICOL2+100 NUZ01220 STO L1 ICOL1+100 UPDATE SWITCHES FOR NUZ01230 LD L ZERO THE PRECEDING NUZ01240 STO L1 ICOL2+100 COLUMN AND SET NUZ01250 MDX 1 1 SWITCHES FOR THIS NUZ01260 MDX ST2P COLUMN TH INDICATE NUZ01270 LD L I THAT NO GRID VALUES NUZ01280 S L TWO HAVE BEEN DEFINED NUZ01290 STO L IM2 THIS COLUMN MINUS 2 NUZ01300 A L ONE NUZ01310 STO L IM1 THIS COLUMN MINUS 1 NUZ01320 A L TWO NUZ01330 STO L IP1 THIS COLUMN PLUS 1 NUZ01340 A L ONE NUZ01350 STO L IP2 THIS COLUMN PLUS 2 NUZ01360 LD L ZERO NUZ01370 STO L J NUZ01380 ST3 MDX L J,1 J IS THE NUMBER OF NUZ01390 LD L I THIS ROW NUZ01400 STO L COL NUZ01410 LD L J NUZ01420 STO L ROW NUZ01430 BSI L TSTSW HAS THIS GRID VALUE NUZ01440 BSC L ST67,Z ALREADY BEEN DEFINED NUZ01450 ST4 LD L ZERO NUZ01460 STO L NT NUMBER OF ADJACENT NUZ01470 * POINTS DEFINED IN A NUZ01480 * PREVIOUS PASS NUZ01490 STO L WTC NUMBER OF THREESOMES NUZ01500 LDX I1 M8 NUZ01510 ST4P STO L1 T+8 SET SWITCHES FOR EACH NUZ01520 MDX 1 1 THREESOME NUZ01530 MDX ST4P NUZ01540 LD L J NUZ01550 S L TWO NUZ01560 STO L JM2 THIS ROW MINUS 2 NUZ01570 A L ONE NUZ01580 STO L JM1 THIS ROW MINUS 1 NUZ01590 A L TWO NUZ01600 STO L JP1 THIS ROW PLUS 1 NUZ01610 A L ONE NUZ01620 STO L JP2 THIS ROW PLUS 2 NUZ01630 LD L IP2 CAN THREESOMES BE NUZ01640 S L ICMAX FOUND TO THE RIGHT NUZ01650 BSC L ST7,-Z NUZ01660 ST5 LD L IP1 IS THE ADJACENT POINT NUZ01670 STO L COL TO THE RIGHT DEFINED NUZ01680 LD L J NUZ01690 STO L ROW NUZ01700 BSI L TSTSW NUZ01710 BSC L ST7,+ NUZ01720 MDX L NT,1 INCREMENT NT NUZ01730 LD L JP1 ARE THERE POINTS NUZ01740 S L IRMAX ABOVE THIS POINT NUZ01750 BSC L ST6,-Z NUZ01760 LD L JP1 NUZ01770 STO L ROW NUZ01780 BSI L TSTSW IS (1,1) DEFINED NUZ01790 BSC L ST6,+ NUZ01800 LD L IP2 NUZ01810 STO L COL NUZ01820 BSI L TSTSW IS (2,1) DEFINED NUZ01830 BSC L ST6,+ NUZ01840 MDX L T,1 SET SWITCH FOR THIS NUZ01850 MDX L WTC,1 THREESOME NUZ01860 ST6 LD L JM1 ARE THERE POINTS NUZ01870 BSC L ST7,+ BELOW THIS ROW NUZ01880 LD L IP1 NUZ01890 STO L COL NUZ01900 LD L JM1 NUZ01910 STO L ROW NUZ01920 BSI L TSTSW IS (1,-1) DEFINED NUZ01930 BSC L ST7,+ NUZ01940 LD L IP2 NUZ01950 STO L COL NUZ01960 BSI L TSTSW IS (2,-1) DEFINED NUZ01970 BSC L ST7,+ NUZ01980 MDX L T+7,1 SET SWITCH FOR THIS NUZ01990 MDX L WTC,1 THREESOME NUZ02000 ST7 LD L JP2 CAN THREESOME BE NUZ02010 S L IRMAX FOUND ABOVE THIS NUZ02020 BSC L ST9,-Z POINT NUZ02030 LD L I NUZ02040 STO L COL NUZ02050 LD L JP1 NUZ02060 STO L ROW IS THE ADJACENT POINT NUZ02070 BSI L TSTSW (0,1) DEFINED NUZ02080 BSC L ST9,+ NUZ02090 MDX L NT,1 NUZ02100 LD L IP1 ARE THERE POINTS TO NUZ02110 S L ICMAX THE RIGHT NUZ02120 BSC L ST8,-Z NUZ02130 LD L IP1 NUZ02140 STO L COL NUZ02150 BSI L TSTSW IS (1,1) DEFINED NUZ02160 BSC L ST8,+ NUZ02170 LD L JP2 NUZ02180 STO L ROW NUZ02190 BSI L TSTSW IS (1,2) DEFINED NUZ02200 BSC L ST8,+ NUZ02210 MDX L T+1,1 SET SWITCH FOR THIS NUZ02220 MDX L WTC,1 THREESOME NUZ02230 ST8 LD L IM1 ARE THREE POINTS TO NUZ02240 BSC L ST9,+ THE LEFT NUZ02250 STO L COL NUZ02260 LD L JP1 NUZ02270 STO L ROW NUZ02280 BSI L TSTSW IS (-1,1) DEFINED NUZ02290 BSC L ST9,+ NUZ02300 MDX L ROW,1 NUZ02310 BSI L TSTSW IS (-1,2) DEFINED NUZ02320 BSC L ST9,+ NUZ02330 MDX L T+2,1 SET SWITCH FOR THIS NUZ02340 MDX L WTC,1 THREESOME NUZ02350 ST9 LD L IM2 CAN THREESOME BE NUZ02360 BSC L ST11,+ FOUND TO THE RIGHT NUZ02370 LD L IM1 NUZ02380 STO L COL NUZ02390 LD L J NUZ02400 STO L ROW NUZ02410 BSI L TSTSW IS THE ADJACENT POINT NUZ02420 BSC L ST11,+ (-1,0) DEFINED NUZ02430 LDX I1 J NUZ02440 LD L1 ICOL1-1 NUZ02450 BSC L ST9P,-Z NUZ02460 MDX L NT,1 INCREMENT NT NUZ02470 ST9P LD L JP1 CAN POINTS BE FOUND NUZ02480 S L IRMAX ABOVE THIS POINT NUZ02490 BSC L ST10,-Z NUZ02500 LD L JP1 NUZ02510 STO L ROW NUZ02520 BSI L TSTSW IS (-1,1) DEFINED NUZ02530 BSC L ST10,+ NUZ02540 LD L IM2 NUZ02550 STO L COL NUZ02560 BSI L TSTSW IS (-2,1) DEFINED NUZ02570 BSC L ST10,+ NUZ02580 MDX L T+3,1 SET SWITCH FOR THIS NUZ02590 MDX L WTC,1 THREESOME NUZ02600 ST10 LD L JM1 ARE THERE POINTS NUZ02610 BSC L ST11,+ BELOW THIS POINT NUZ02620 STO L ROW NUZ02630 LD L IM1 NUZ02640 STO L COL NUZ02650 BSI L TSTSW IS (-1,-1) DEFINED NUZ02660 BSC L ST11,+ NUZ02670 LD L IM2 NUZ02680 STO L COL NUZ02690 BSI L TSTSW IS (-2,-1) DEFINED NUZ02700 BSC L ST11,+ NUZ02710 MDX L T+4,1 SET SWITCH FOR THIS NUZ02720 MDX L WTC,1 THREESOME NUZ02730 ST11 LD L JM2 CAN THREESOME BE NUZ02740 BSC L ST13,+ FOUND BELOW THIS PT. NUZ02750 LD L I NUZ02760 STO L COL NUZ02770 LD L JM1 NUZ02780 STO L ROW NUZ02790 BSI L TSTSW IS THE ADJACENT POINT NUZ02800 BSC L ST13,+ (0,-1) DEFINED NUZ02810 LDX I1 J NUZ02820 LD L1 ICOL2-2 NUZ02830 BSC L ST11P,-Z NUZ02840 MDX L NT,1 INCREMENT NT NUZ02850 ST11P LD L IM1 NUZ02860 BSC L ST12,+ NUZ02870 STO L COL NUZ02880 BSI L TSTSW IS (-1,-1) DEFINED NUZ02890 BSC L ST12,+ NUZ02900 LD L JM2 NUZ02910 STO L ROW NUZ02920 BSI L TSTSW IS (-1,-2) DEFINED NUZ02930 BSC L ST12,+ NUZ02940 MDX L T+5,1 SET SWITCH FOR THIS NUZ02950 MDX L WTC,1 THREESOME NUZ02960 ST12 LD L IP1 ARE THERE POINTS TO NUZ02970 S L ICMAX THE RIGHT NUZ02980 BSC L ST13,-Z NUZ02990 LD L IP1 NUZ03000 STO L COL NUZ03010 LD L JM1 NUZ03020 STO L ROW NUZ03030 BSI L TSTSW IS (1,-1) DEFINED NUZ03040 BSC L ST13,+ NUZ03050 LD L JM2 NUZ03060 STO L ROW NUZ03070 BSI L TSTSW IS (-1,-2) DEFINED NUZ03080 BSC L ST13,+ NUZ03090 MDX L T+6,1 NUZ03100 MDX L WTC,1 THREESOME NUZ03110 ST13 LD L NT NUZ03120 BSC L ST67,+ HAS A THREESOME BEEN NUZ03130 LD L WTC NUZ03140 BSC L ST67,+ NUZ03150 LD L ZERO FOUND NUZ03160 LDX I1 M16 NUZ03170 ST13P STO L1 XS1+16 NUZ03180 MDX 1 2 NUZ03190 MDX ST13P NUZ03200 ST14 LD L ICMAX NUZ03210 S L I ARE THERE GRID POINTS NUZ03220 STO L IPP TO THE RIGHT OF THE NUZ03230 BSC L ST31,+ GRID TO BE DEFINED NUZ03240 ************** NUZ03250 * DETERMINE THE NEAREST DEFINED GRID NUZ03260 * POINT IN THE FIRST SECTOR NUZ03270 ************** NUZ03280 LD L I NUZ03290 STO L COL NUZ03300 LDX I1 ZERO NUZ03310 ST15 MDX L COL,1 SELECT COLUMN NUZ03320 LD L J SELECT THE ROW CON- NUZ03330 STO L ROW TAINING THE GRID NUZ03340 * POINT TO BE DEFINED NUZ03350 BSI L TSTSW IS THE POINT DEFINED NUZ03360 BSC L ST20,-Z NUZ03370 MDX 1 1 SET UP TO STEP NUZ03380 LD L1 I225-1 THROUGH THE ROWS IN NUZ03390 BSC L ST19,+ THIS COLUMN NUZ03400 STO L JPP NUZ03410 LD L ZERO NUZ03420 STO L JP NUZ03430 ST16 MDX L JP,1 SELECT A ROW ABOVE NUZ03440 LD L JP THE ROW CONTAINING NUZ03450 A L J THE POINT TO BE NUZ03460 STO L ROW DEFINED NUZ03470 S L IRMAX NUZ03480 BSC L ST17,-Z NUZ03490 BSI L TSTSW IS THE GRID DEFINED NUZ03500 BSC L ST20,-Z NUZ03510 ST17 LD L J SELECT A ROW BELOW NUZ03520 S L JP THE ROW CONTAINING NUZ03530 BSC L ST18,+ THE POINT TO BE NUZ03540 STO L ROW DEFINED NUZ03550 BSI L TSTSW IS THE GRID DEFINED NUZ03560 BSC L ST20,-Z NUZ03570 ST18 LD L JP ARE THERE MORE ROWS NUZ03580 S L JPP ON THIS COLUMN IN NUZ03590 BSC L ST16,Z+ THE FIRST SECTOR NUZ03600 ST19 LD L COL ARE THERE MORE NUZ03610 S L ICMAX COLUMNS TO BE TESTED NUZ03620 BSC L ST15,Z+ NUZ03630 MDX ST21 NUZ03640 ST20 LD L COL STORE COLUMN AND NUZ03650 STO L XS1 ROW NUMBERS OF NUZ03660 LD L ROW CLOSEST DEFINED POINT NUZ03670 STO L YS1 IN THE FIRST SECTOR NUZ03680 ST21 LD L I STEP THROUGH COLUMNS NUZ03690 STO L COL IN THE SECOND NUZ03700 LDX I1 ZERO SECTOR NUZ03710 ************** NUZ03720 * DETERMINE THE CLOSEST DEFINED POINT IN NUZ03730 * THE SECOND SECTOR NUZ03740 ************** NUZ03750 ST22 MDX L COL,1 SELECT A COLUMN NUZ03760 MDX 1 1 SET UP TO STEP NUZ03770 LD L1 I225-1 THROUGH THE ROWS ON NUZ03780 STO L STEP THIS COLUMN IN THE NUZ03790 A L J SECOND SECTOR NUZ03800 STO L ROW NUZ03810 S L IRMAX NUZ03820 BSC L ST26,- NUZ03830 ST23 LD L ROW SELECT A ROW NUZ03840 A L ONE NUZ03850 STO L ROW NUZ03860 S L IRMAX NUZ03870 BSC L ST24,-Z NUZ03880 MDX L STEP,1 NUZ03890 BSI L TSTSW IS THIS GRID POINT NUZ03900 BSC L ST25,-Z DEFINED NUZ03910 LD L STEP ARE THERE MORE ROWS NUZ03920 S L1 I675-1 ON THIS COLUMN IN THE NUZ03930 BSC L ST23,Z+ SECOND SECTOR NUZ03940 ST24 LD L COL ARE THERE MORE NUZ03950 S L ICMAX COLUMNS TO BE TESTED NUZ03960 BSC L ST22,Z+ IN THE SECOND SECTOR NUZ03970 MDX ST26 NUZ03980 ST25 LD L COL STORE COLUMN AND ROW NUZ03990 STO L XS2 NUMBERS OF THE NUZ04000 LD L ROW CLOSEST POINT IN THE NUZ04010 STO L YS2 SECOND SECTOR NUZ04020 ************** NUZ04030 * DETERMINE THE CLOSEST DEFINED GRID POINT NUZ04040 * IN THE EIGHTH SECTOR NUZ04050 ************** NUZ04060 ST26 LD L I SET UP TO STEP NUZ04070 STO L COL THROUGH THE COLUMNS NUZ04080 LDX I1 ZERO NUZ04090 ST27 MDX L COL,1 SELECT A COLUMN NUZ04100 MDX 1 1 SET UP TO STEP NUZ04110 LD L J THROUGH THE ROWS ON NUZ04120 S L1 I225-1 THIS COLUMN IN THE NUZ04130 STO L ROW SECOND SECTOR NUZ04140 S L ONE NUZ04150 BSC L ST31,+ NUZ04160 LD L1 I225-1 NUZ04170 STO L STEP NUZ04180 ST28 LD L ROW SELECT A ROW NUZ04190 S L ONE NUZ04200 STO L ROW NUZ04210 BSC L ST29,+ NUZ04220 MDX L STEP,1 NUZ04230 BSI L TSTSW IS THIS GRID POINT NUZ04240 BSC L ST30,-Z DEFINED NUZ04250 LD L STEP ARE THERE MORE POINTS NUZ04260 S L1 I675-1 ON THIS ROW TO BE NUZ04270 BSC L ST28,Z+ TESTED NUZ04280 ST29 LD L COL ARE THERE MORE NUZ04290 S L ICMAX NUZ04300 BSC L ST27,Z+ SECTOR TO TEST NUZ04310 MDX ST31 STORE COLUMN AND ROW NUZ04320 ST30 LD L COL NUMBERS OF THE NUZ04330 STO L XS8 CLOSEST DEFINED POINT NUZ04340 LD L ROW IN THE EIGHTH SECTOR NUZ04350 STO L YS8 NUZ04360 ************** NUZ04370 * TEST FOR THE NEAREST DEFINED GRID POINT NUZ04380 * IN THE THIRD SECTOR NUZ04390 ************** NUZ04400 ST31 LD L J ARE THERE GRID POINTS NUZ04410 S L IRMAX ABOVE THIS POINT NUZ04420 BSC L ST37,- NUZ04430 LD L J SET UP TO STEP NUZ04440 STO L ROW THROUGH THE ROWS IN NUZ04450 LDX I1 ZERO THE THIRD SECTOR NUZ04460 ST32 MDX L ROW,1 SELECT A ROW NUZ04470 LD L I SELECT THE COLUMN NUZ04480 STO L COL CONTAINING THE POINT NUZ04490 * TO BE DEFINED NUZ04500 BSI L TSTSW IS THIS GRID POINT NUZ04510 BSC L ST36,-Z DEFINED NUZ04520 MDX 1 1 SET UP TO STEP NUZ04530 LD L1 I225-1 THROUGH THE COLUMNS NUZ04540 BSC L ST35P,+ ON THIS ROW IN THE NUZ04550 STO L JPP THIRD SECTOR NUZ04560 LD L ZERO NUZ04570 STO L JP NUZ04580 ST33 MDX L JP,1 SELECT A COLUMN TO NUZ04590 LD L JP THE RIGHT OF THE NUZ04600 A L I COLUMN CONTAINING THE NUZ04610 STO L COL GRID TO BE DEFINED NUZ04620 S L ICMAX NUZ04630 BSC L ST34,-Z NUZ04640 BSI L TSTSW IS THIS GRID POINT NUZ04650 BSC L ST36,-Z DEFINED NUZ04660 ST34 LD L I SELECT A COLUMN TO NUZ04670 S L JP THE LEFT OF THE NUZ04680 BSC L ST35,+ COLUMN CONTAINING THE NUZ04690 STO L COL GRID TO BE DEFINED NUZ04700 BSI L TSTSW IS THE POINT DEFINED NUZ04710 BSC L ST36,-Z NUZ04720 ST35 LD L JP ARE THERE MORE NUZ04730 S L JPP COLUMNS ON THIS ROW NUZ04740 BSC L ST33,Z+ TO BE TESTED NUZ04750 ST35P LD L ROW ARE THERE MORE ROWS NUZ04760 S L IRMAX IN THE THIRD SECTOR NUZ04770 BSC L ST32,Z+ NUZ04780 MDX ST37 NUZ04790 ST36 LD L COL STORE THIS POINT AS NUZ04800 STO L XS3 THE CLOSEST DEFINED NUZ04810 LD L ROW GRID POINT IN THE NUZ04820 STO L YS3 THIRD SECTOR NUZ04830 ************** NUZ04840 * DETERMINE THE CLOSEST DEFINED GRID NUZ04850 * POINT IN THE SEVENTH SECTOR NUZ04860 ************** NUZ04870 ST37 LD L J ARE THERE GRID POINTS NUZ04880 STO L ROW BELOW THE GRID POINT NUZ04890 S L ONE TO BE DEFINED NUZ04900 BSC L ST44,+ NUZ04910 LDX I1 ZERO SET UP TO STEP NUZ04920 * THROUGH THE ROWS IN NUZ04930 * THE SEVENTH SECTOR NUZ04940 ST38 MDX L ROW,-1 SELECT A ROW NUZ04950 LD L I SELECT THE COLUMN NUZ04960 STO L COL CONTAINING THE GRID NUZ04970 * POINT TO BE DEFINED NUZ04980 BSI L TSTSW IS THE POINT DEFINED NUZ04990 BSC L ST43,-Z NUZ05000 MDX 1 1 SET UP TO STEP NUZ05010 LD L1 I225-1 THROUGH THE ROWS IN NUZ05020 BSC L ST42,+ THE SEVENTH SECTOR NUZ05030 STO L JPP NUZ05040 LD L ZERO NUZ05050 STO L JP NUZ05060 ST39 MDX L JP,1 SELECT A COLUMN TO NUZ05070 LD L I THE RIGHT OF THE NUZ05080 A L JP COLUMN CONTAINING THE NUZ05090 STO L COL POINT TO BE DEFINED NUZ05100 S L ICMAX NUZ05110 BSC L ST40,-Z NUZ05120 BSI L TSTSW IS THE POINT DEFINED NUZ05130 BSC L ST43,-Z NUZ05140 ST40 LD L I SELECT A COLUMN TO NUZ05150 S L JP THE LEFT OF THE NUZ05160 BSC L ST41,+ COLUMN CONTAINING THE NUZ05170 STO L COL POINT TO BE DEFINED NUZ05180 BSI L TSTSW IS THE POINT DEFINED NUZ05190 BSC L ST43,-Z NUZ05200 ST41 LD L JP ARE THERE MORE NUZ05210 S L JPP COLUMNS ON THIS ROW NUZ05220 BSC L ST39,Z+ IN THE SEVENTH NUZ05230 * SECTOR NUZ05240 ST42 LD L ROW ARE THERE MORE ROWS NUZ05250 S L ONE IN THE SEVENTH SECTOR NUZ05260 BSC L ST38,-Z NUZ05270 MDX ST44 NUZ05280 ST43 LD L COL STORE THIS POINT AS NUZ05290 STO L XS7 THE CLOSEST DEFINED NUZ05300 LD L ROW POINT IN THE SEVENTH NUZ05310 STO L YS7 SECTOR NUZ05320 ************** NUZ05330 * ARE THERE GRID POINTS TO THE LEFT OF NUZ05340 * THE GRID POINT TO BE DEFINED NUZ05350 ************** NUZ05360 ST44 LD L I NUZ05370 S L ONE NUZ05380 BSC L ST58,+ NUZ05390 ************** NUZ05400 * TEST FOR THE CLOSEST DEFINED GRID NUZ05410 * POINT IN THE FIFTH SECTOR NUZ05420 ************** NUZ05430 LD L I SET UP TO STEP NUZ05440 STO L COL THROUGH THE COLUMNS NUZ05450 LDX I1 ZERO IN THE FIFTH SECTOR NUZ05460 ST45 MDX L COL,-1 SELECT A COLUMN NUZ05470 LD L J SELECT THE ROW NUZ05480 STO L ROW CONTAINING THE POINT NUZ05490 * TO BE DEFINED NUZ05500 BSI L TSTSW IS THE POINT DEFINED NUZ05510 BSC L ST50,-Z NUZ05520 MDX 1 1 SET UP TO STEP NUZ05530 LD L1 I225-1 THROUGH THE ROWS ON NUZ05540 BSC L ST49,+ THIS COLUMN IN THE NUZ05550 STO L JPP FIFTH SECTOR NUZ05560 LD L ZERO NUZ05570 STO L JP NUZ05580 ST46 MDX L JP,1 SELECT A ROW ABOVE NUZ05590 LD L J NUZ05600 A L JP DEFINED NUZ05610 STO L ROW NUZ05620 S L IRMAX NUZ05630 BSC L ST47,-Z NUZ05640 BSI L TSTSW IS THE POINT DEFINED NUZ05650 BSC L ST50,-Z NUZ05660 ST47 LD L J SELECT A ROW BELOW NUZ05670 S L JP THE POINT TO BE NUZ05680 BSC L ST48,+ DEFINED NUZ05690 STO L ROW NUZ05700 BSI L TSTSW IS THE POINT DEFINED NUZ05710 BSC L ST50,-Z NUZ05720 ST48 LD L JP ARE MORE ROWS ON NUZ05730 S L JPP THIS COLUMN TO BE NUZ05740 BSC L ST46,Z+ TESTED NUZ05750 ST49 LD L COL ARE MORE COLUMNS IN NUZ05760 S L ONE THE FIFTH SECTOR TO NUZ05770 BSC L ST45,-Z BE TESTED NUZ05780 MDX ST51 NUZ05790 ST50 LD L COL STORE POINT AS NUZ05800 STO L XS5 CLOSEST DEFINED POINT NUZ05810 LD L ROW IN THE FIFTH SECTOR NUZ05820 STO L YS5 NUZ05830 ************** NUZ05840 * DETERMINE THE CLOSEST DEFINED NUZ05850 * GRID POINT IN THE FOURTH SECTOR NUZ05860 ************** NUZ05870 ST51 LD L J ARE THERE POINTS NUZ05880 S L IRMAX ABOVE THE POINT TO NUZ05890 BSC L ST54,- BE DEFINED NUZ05900 LD L I SET UP TO STEP NUZ05910 STO L COL THROUGH THE COLUMNS NUZ05920 LDX I1 ZERO IN THE FOURTH SECTOR NUZ05930 ST52 MDX L COL,-1 SELECT A COLUMN NUZ05940 MDX 1 1 SET UP TO STEP NUZ05950 LD L1 I225-1 THROUGH THE ROWS NUZ05960 STO L STEP ON THIS COLUMN IN NUZ05970 A L J THE FOURTH SECTOR NUZ05980 STO L ROW NUZ05990 S L IRMAX NUZ06000 BSC L ST54,- NUZ06010 ST53P MDX L ROW,1 SELECT A ROW NUZ06020 LD L ROW NUZ06030 S L IRMAX NUZ06040 BSC L ST53,-Z NUZ06050 MDX L STEP,1 NUZ06060 LD L STEP NUZ06070 S L1 I675-1 NUZ06080 BSC L ST53,-Z NUZ06090 BSI L TSTSW IS THE POINT DEFINED NUZ06100 BSC L ST53P,+ NUZ06110 LD L COL STORE THIS POINT AS NUZ06120 STO L XS4 THE CLOSEST DEFINED NUZ06130 LD L ROW POINT IN THE FOURTH NUZ06140 STO L YS4 SECTOR NUZ06150 MDX ST54 NUZ06160 ST53 LD L COL ARE THERE MORE NUZ06170 S L ONE COLUMNS TO TEST NUZ06180 BSC L ST52,-Z NUZ06190 ************** NUZ06200 * DETERMINE THE CLOSEST DEFINED POINT NUZ06210 * IN THE SIXTH SECTOR NUZ06220 ************** NUZ06230 ST54 LD L J ARE THERE POINTS NUZ06240 S L ONE BELOW THE POINT TO NUZ06250 BSC L ST58,+ BE DEFINED NUZ06260 LD L I SET UP TO STEP NUZ06270 STO L COL THROUGH THE COLUMNS NUZ06280 LDX I1 ZERO IN THE SIXTH SECTOR NUZ06290 ST55 MDX L COL,-1 SELECT A COLUMN NUZ06300 MDX 1 1 SET UP TO STEP NUZ06310 LD L J THROUGH THE ROWS ON NUZ06320 S L1 I225-1 THIS COLUMN IN THE NUZ06330 STO L ROW SIXTH SECTOR NUZ06340 S L ONE NUZ06350 BSC L ST58,+ NUZ06360 LD L1 I225-1 NUZ06370 STO L STEP NUZ06380 ST56 MDX L ROW,-1 SELECT A ROW NUZ06390 LD L ROW NUZ06400 BSC L ST57,+ NUZ06410 MDX L STEP,1 NUZ06420 LD L STEP NUZ06430 S L1 I675-1 NUZ06440 BSC L ST57,-Z NUZ06450 BSI L TSTSW IS THE POINT DEFINED NUZ06460 BSC L ST56,+ NUZ06470 LD L COL STORE POINT AS THE NUZ06480 STO L XS6 CLOSEST DEFINED POINT NUZ06490 LD L ROW IN THE SIXTH SECTOR NUZ06500 STO L YS6 NUZ06510 MDX ST58 NUZ06520 ST57 LD L COL ARE MORE COLUMNS TO NUZ06530 S L ONE BE TESTED NUZ06540 BSC L ST55,-Z NUZ06550 ************** NUZ06560 * DETERMINE THE NUMBER OF SECTORS NUZ06570 * THAT CONTAIN DEFINED POINTS NUZ06580 ************** NUZ06590 ST58 LDX I1 M16 NUZ06600 LD L ZERO NUZ06610 STO L COUNT NUZ06620 ST59 LD L1 XS1+16 NUZ06630 BSC L ST59P,+ NUZ06640 MDX L COUNT,1 NUZ06650 ST59P MDX 1 2 NUZ06660 MDX ST59 NUZ06670 LD L COUNT NUZ06680 S L NMTST NUZ06690 BSC L ST67,Z+ NUZ06700 BSI L GETZS RETRIEVE THE Z VALUES NUZ06710 * FOR THE DEFINED NUZ06720 * POINTS FROM THE DISK NUZ06730 ************** NUZ06740 * CONVERT THE X-Y COORDINATES TO FLOATING NUZ06750 * POINT AND COMPUTE THE DISTANCE OF EACH NUZ06760 * DEFINED POINT FROM THE POINT TO BE NUZ06770 * DEFINED NUZ06780 ************** NUZ06790 LDX I1 M18 NUZ06800 LDD L FZERO NUZ06810 ST60 STD L1 C1+18 NUZ06820 MDX 1 2 NUZ06830 MDX ST60 NUZ06840 STD L RSLOP NUZ06850 LDX I1 M16 NUZ06860 ST61 LD L1 XS1+16 NUZ06870 BSC L ST62P,+ NUZ06880 S L I NUZ06890 LIBF FLOAT NUZ06900 LIBF FSTO NUZ06910 DC DUM NUZ06920 LDD L DUM NUZ06930 STD L1 XS1+16 NUZ06940 LIBF FMPY NUZ06950 DC DUM NUZ06960 LIBF FSTO NUZ06970 DC DUM NUZ06980 LDD L DUM NUZ06990 STD L1 RS1+16 NUZ07000 LD L1 YS1+16 NUZ07010 S L J NUZ07020 LIBF FLOAT NUZ07030 LIBF FSTO NUZ07040 DC DUM NUZ07050 LDD L DUM NUZ07060 STD L1 YS1+16 NUZ07070 LIBF FMPY NUZ07080 DC DUM NUZ07085 LDD L1 RS1+16 NUZ07090 STD L DUM NUZ07100 LIBF FADD NUZ07110 DC DUM NUZ07120 LIBF FSTO NUZ07130 DC DUM NUZ07140 LDD L DUM NUZ07150 STD L1 RS1+16 NUZ07160 MDX ST62 NUZ07170 ST62P LDD L ZNIL NUZ07180 STD L1 ZS1+16 NUZ07190 ST62 MDX 1 2 NUZ07200 MDX ST61 NUZ07210 ************** NUZ07220 * PERFORM A LEAST SQUARES FIT TO THE NUZ07230 * DEFINED POINTS TO DETERMINE THE SECANT NUZ07240 * APPROXIMATION AT THE POINT TO BE DEFINED NUZ07250 ************** NUZ07260 ST63 LDX I1 M16 NUZ07270 ST64 LDD L1 ZS1+16 NUZ07280 STD L DUM NUZ07290 LIBF FLD NUZ07300 DC DUM NUZ07310 LIBF FSUB NUZ07320 DC ZNIL NUZ07330 LIBF FSTO NUZ07340 DC DUM NUZ07350 LD L DUM NUZ07360 BSC L ST65,-+ NUZ07370 LDD L1 XS1+16 NUZ07380 STD L XP NUZ07390 LDD L1 YS1+16 NUZ07400 STD L YP NUZ07410 LDD L1 ZS1+16 NUZ07420 STD L ZP NUZ07430 LDD L1 RS1+16 NUZ07440 STD L RP NUZ07450 LIBF FLD NUZ07460 DC XP NUZ07470 LIBF FDIV NUZ07480 DC RP NUZ07490 LIBF FSTO NUZ07500 DC WX NUZ07510 LIBF FLD NUZ07520 DC YP NUZ07530 LIBF FDIV NUZ07540 DC RP NUZ07550 LIBF FSTO NUZ07560 DC WY NUZ07570 LIBF FLD NUZ07580 DC XP NUZ07590 LIBF FMPY NUZ07600 DC WX NUZ07610 LIBF FADD NUZ07620 DC C1 NUZ07630 LIBF FSTO NUZ07640 DC C1 NUZ07650 LIBF FLD NUZ07660 DC YP NUZ07670 LIBF FMPY NUZ07680 DC WX NUZ07690 LIBF FADD NUZ07700 DC C2 NUZ07710 LIBF FSTO NUZ07720 DC C2 NUZ07730 LIBF FLD NUZ07740 DC WX NUZ07750 LIBF FADD NUZ07760 DC C3 NUZ07770 LIBF FSTO NUZ07780 DC C3 NUZ07790 LIBF FLD NUZ07800 DC ZP NUZ07810 LIBF FMPY NUZ07820 DC WX NUZ07830 LIBF FADD NUZ07840 DC C4 NUZ07850 LIBF FSTO NUZ07860 DC C4 NUZ07870 LIBF FLD NUZ07880 DC YP NUZ07890 LIBF FMPY NUZ07900 DC WY NUZ07910 LIBF FADD NUZ07920 DC C5 NUZ07930 LIBF FSTO NUZ07940 DC C5 NUZ07950 LIBF FLD NUZ07960 DC WY NUZ07970 LIBF FADD NUZ07980 DC C6 NUZ07990 LIBF FSTO NUZ08000 DC C6 NUZ08010 LIBF FLD NUZ08020 DC ZP NUZ08030 LIBF FMPY NUZ08040 DC WY NUZ08050 LIBF FADD NUZ08060 DC C7 NUZ08070 LIBF FSTO NUZ08080 DC C7 NUZ08090 LIBF FLD NUZ08100 DC FONE NUZ08110 LIBF FDIV NUZ08120 DC RP NUZ08130 LIBF FADD NUZ08140 DC C8 NUZ08150 LIBF FSTO NUZ08160 DC C8 NUZ08170 LIBF FLD NUZ08180 DC ZP NUZ08190 LIBF FDIV NUZ08200 DC RP NUZ08210 LIBF FADD NUZ08220 DC C9 NUZ08230 LIBF FSTO NUZ08240 DC C9 NUZ08250 LIBF FLD NUZ08260 DC RSLOP NUZ08270 LIBF FADD NUZ08280 DC RP NUZ08290 LIBF FSTO NUZ08300 DC RSLOP NUZ08310 ST65 MDX 1 2 NUZ08320 MDX ST64 NUZ08330 ST66 LIBF FLD NUZ08340 DC C2 NUZ08350 LIBF FMPY NUZ08360 DC C2 NUZ08370 LIBF FSTO NUZ08380 DC A NUZ08390 LIBF FLD NUZ08400 DC C1 NUZ08410 LIBF FMPY NUZ08420 DC C5 NUZ08430 LIBF FSUB NUZ08440 DC A NUZ08450 LIBF FSTO NUZ08460 DC A NUZ08470 LIBF FLD NUZ08480 DC C2 NUZ08490 LIBF FMPY NUZ08500 DC C3 NUZ08510 LIBF FSTO NUZ08520 DC B NUZ08530 LIBF FLD NUZ08540 DC C1 NUZ08550 LIBF FMPY NUZ08560 DC C6 NUZ08570 LIBF FSUB NUZ08580 DC B NUZ08590 LIBF FSTO NUZ08600 DC B NUZ08610 LIBF FLD NUZ08620 DC C3 NUZ08630 LIBF FMPY NUZ08640 DC C3 NUZ08650 LIBF FSTO NUZ08660 DC ACC1 NUZ08670 LIBF FLD NUZ08680 DC C1 NUZ08690 LIBF FMPY NUZ08700 DC C8 NUZ08710 LIBF FSUB NUZ08720 DC ACC1 NUZ08730 LIBF FSTO NUZ08740 DC ACC1 NUZ08750 LIBF FLD NUZ08760 DC A NUZ08770 LIBF FMPY NUZ08780 DC ACC1 NUZ08790 LIBF FSTO NUZ08800 DC ACC2 NUZ08810 LIBF FLD NUZ08820 DC B NUZ08830 LIBF FMPY NUZ08840 DC B NUZ08850 LIBF FSUB NUZ08860 DC ACC2 NUZ08870 LIBF FSTO NUZ08880 DC ACC2 NUZ08890 LD L ACC2 SINGULARITY TEST NUZ08900 BSC L ST67,-+ BRANCH IF SINGULAR NUZ08910 LD L ACC2+1 NUZ08920 AND L TOLM TRY SINGULARITY NUZ08930 S L C72 TOLERANCE NUZ08940 BSC L ST67,+Z BRANCH FOR NOW BUT NUZ08950 LIBF FLD THIS POINT MAY BE NUZ08960 DC C2 EVALUATED LATER NUZ08970 LIBF FMPY NUZ08980 DC C4 NUZ08990 LIBF FSTO NUZ09000 DC C NUZ09010 LIBF FLD NUZ09020 DC C1 NUZ09030 LIBF FMPY NUZ09040 DC C7 NUZ09050 LIBF FSUB NUZ09060 DC C NUZ09070 LIBF FSTO NUZ09080 DC C NUZ09090 LIBF FMPY NUZ09100 DC B NUZ09110 LIBF FSTO NUZ09120 DC ACC1 NUZ09130 LIBF FLD NUZ09140 DC C3 NUZ09150 LIBF FMPY NUZ09160 DC C4 NUZ09170 LIBF FSTO NUZ09180 DC C NUZ09190 LIBF FLD NUZ09200 DC C1 NUZ09210 LIBF FMPY NUZ09220 DC C9 NUZ09230 LIBF FSUB NUZ09240 DC C NUZ09250 LIBF FSTO NUZ09260 DC C NUZ09270 LIBF FMPY NUZ09280 DC A NUZ09290 LIBF FSTO NUZ09300 DC DUM NUZ09310 LIBF FLD NUZ09320 DC ACC1 NUZ09330 LIBF FSUB NUZ09340 DC DUM NUZ09350 LIBF FSTO NUZ09360 DC ACC1 NUZ09370 LIBF FDIV NUZ09380 DC ACC2 NUZ09390 LIBF FSTO NUZ09400 DC A NUZ09410 LD L COUNT NUZ09420 LIBF FLOAT NUZ09430 LIBF FSTO NUZ09440 DC XP NUZ09450 LIBF FDIV NUZ09460 DC RSLOP NUZ09470 LIBF FSTO NUZ09480 DC B NUZ09490 LIBF FLD NUZ09500 DC FONE NUZ09510 LIBF FSUB NUZ09520 DC B NUZ09530 LIBF FSTO NUZ09540 DC B NUZ09550 LIBF FMPY NUZ09560 DC B NUZ09570 LIBF FSTO NUZ09580 DC B NUZ09590 LIBF FADD NUZ09600 DC FONE NUZ09610 LIBF FSTO NUZ09620 DC ZP NUZ09630 LD L WTC NUZ09640 LIBF FLOAT NUZ09650 LIBF FSTO NUZ09660 DC WTC NUZ09670 LIBF FLD NUZ09680 DC ZTAN1 NUZ09690 LIBF FSUB NUZ09700 DC ZTAN3 NUZ09710 LIBF FADD NUZ09720 DC ZTAN2 NUZ09730 LIBF FMPY NUZ09740 DC B NUZ09750 LIBF FDIV NUZ09760 DC WTC NUZ09770 LIBF FADD NUZ09780 DC A NUZ09790 LIBF FDIV NUZ09800 DC ZP NUZ09810 LIBF FSTO NUZ09820 DC ZP POINT EVALUATED NUZ09830 MDX L ICHNG,1 THIS PASS NUZ09840 BSI L STCL2 SET SWITCH NUZ09850 LD L I NUZ09860 STO L COL NUZ09870 LD L J NUZ09880 STO L ROW NUZ09890 BSI L STGRD STORE NEW GRID VALUE NUZ09900 ST67 LD L J TEST FOR LAST ROW NUZ09910 S L IRMAX NUZ09920 BSC L ST3,Z+ NUZ09930 LD L I TEST FOR LAST COLUMN NUZ09940 S L ICMAX NUZ09950 BSC L ST2,Z+ NUZ09960 LD L ICHNG WAS A POINT DEFINED NUZ09970 BSC L ST1,-Z IN THIS SWEEP NUZ09980 ST68 LD L NMTST HAS THE REQUIRED NUZ09990 S L SIX NUMBER OF POINTS NUZ10000 BSC L ST70,Z+ BEEN REDUCED NUZ10010 ST69 LD L IRSTR CAN THE NUMBER OF NUZ10020 BSC L ST70,-Z REQUIRED POINTS BE NUZ10030 LD L FIVE REDUCED NUZ10040 STO L NMTST NUZ10050 BSC L ST1 NUZ10060 ST70 BSI L ERTYP TYPE COMPLETION NUZ10070 DC EMSAG MESSAGE AND NUZ10080 EXIT CALL MONITOR NUZ10090 ************** NUZ10100 * ROUTINE TO RETRIEVE THE SELECTED DATA NUZ10110 * POINTS NEEDED TO COMPUTE A NEW GRID VALUE NUZ10120 ************** NUZ10130 GETZS NOP NUZ10140 LDD L FZERO ZERO ACCUMULATORS NUZ10150 STD L ZTAN1 FOR THE VALUES OF NUZ10160 STD L ZTAN2 THE THREESOMES NUZ10170 STD L ZTAN3 NUZ10180 LDX I1 M16 NUZ10190 LDX I2 ZERO NUZ10200 GETZ1 LD L1 XS1+16 DETERMINE THE COLUMNS NUZ10210 BSC L GETZ2,+ CONTAINING DATA NUZ10220 MDX 2 1 FROM SECTOR SEARCH NUZ10230 STO L2 WCOL-1 DETERMINE NUZ10240 GETZ2 MDX 1 2 COLUMNS NUZ10250 MDX GETZ1 NEEDED TO NUZ10260 LD L T+3 RETRIEVE DATA NUZ10270 A L T+4 FOR TANGENT NUZ10280 BSC L GETZ3,+ PLANES NUZ10290 MDX 2 1 NUZ10300 LD L I NUZ10310 S L TWO NUZ10320 STO L2 WCOL-1 NUZ10330 GETZ3 LD L T+2 NUZ10340 A L T+3 NUZ10350 A L T+4 NUZ10360 A L T+5 NUZ10370 BSC L GETZ4,+ NUZ10380 LD L I NUZ10390 S L ONE NUZ10400 MDX 2 1 NUZ10410 STO L2 WCOL-1 NUZ10420 GETZ4 LD L T+1 NUZ10430 A L T+2 NUZ10440 A L T+5 NUZ10450 A L T+6 NUZ10460 BSC L GETZ5,+ NUZ10470 MDX 2 1 NUZ10480 LD L I NUZ10490 STO L2 WCOL-1 NUZ10500 GETZ5 LD L T NUZ10510 A L T+1 NUZ10520 A L T+6 NUZ10530 A L T+7 NUZ10540 BSC L GETZ6,+ NUZ10550 LD L I NUZ10560 A L ONE NUZ10570 MDX 2 1 NUZ10580 STO L2 WCOL-1 NUZ10590 GETZ6 LD L T NUZ10600 A L T+7 NUZ10610 BSC L GETZ7,+ NUZ10620 MDX 2 1 NUZ10630 LD L I NUZ10640 A L TWO NUZ10650 STO L2 WCOL-1 NUZ10660 GETZ7 STX L2 NCOL NUZ10670 LDX I1 ZERO NUZ10680 GETZ8 MDX 1 1 NUZ10690 STX L1 DUM NUZ10700 LDX I2 DUM NUZ10710 GETZ9 MDX 2 1 NUZ10720 LD L1 WCOL-1 TEST FOR DUPLICATE NUZ10730 S L2 WCOL-1 COLUMNS AND NUZ10740 BSC L GET10,Z ELIMINATE NUZ10750 LD L ZERO DUPLICATES NUZ10760 STO L2 WCOL-1 NUZ10770 GET10 STX L2 DUM NUZ10780 LD L DUM NUZ10790 S L NCOL NUZ10800 BSC L GETZ9,Z+ NUZ10810 STX L1 DUM NUZ10820 LD L DUM NUZ10830 A L ONE NUZ10840 S L NCOL NUZ10850 BSC L GETZ8,Z+ NUZ10860 *************** NUZ10870 * THE FOLLOWING SECTION OF CODE BRINGS IN THE NUZ10880 * COLUMNS SPECIFIED IN WCOL AND DETERMINES NUZ10890 * WHICH Z VALUES ARE NEEDED FROM A GIVEN NUZ10900 * COLUMN AND WHERE THESE VALUES ARE TO BE NUZ10910 * STORED OR ACCUMULATED FOR THE LEAST NUZ10920 * SQUARES FIT NUZ10930 *************** NUZ10940 LDX I1 ZERO NUZ10950 GET11 MDX 1 1 NUZ10960 LD L1 WCOL-1 NUZ10970 BSC L GET35,+ NUZ10980 STO L COL NUZ10990 BSI L GRDVA NUZ11000 LD L COL NUZ11010 S L XS1 NUZ11020 BSC L GET12,Z NUZ11030 LD L YS1 NUZ11040 SLA 1 NUZ11050 STO L DUM NUZ11060 LDX I2 DUM NUZ11070 LDD L2 ZG-2 NUZ11080 STD L ZS1 NUZ11090 GET12 LD L COL NUZ11100 S L XS2 NUZ11110 BSC L GET13,Z NUZ11120 LD L YS2 NUZ11130 SLA 1 NUZ11140 STO L DUM NUZ11150 LDX I2 DUM NUZ11160 LDD L2 ZG-2 NUZ11170 STD L ZS2 NUZ11180 GET13 LD L COL NUZ11190 S L XS3 NUZ11200 BSC L GET14,Z NUZ11210 LD L YS3 NUZ11220 SLA 1 NUZ11230 STO L DUM NUZ11240 LDX I2 DUM NUZ11250 LDD L2 ZG-2 NUZ11260 STD L ZS3 NUZ11270 GET14 LD L COL NUZ11280 S L XS4 NUZ11290 BSC L GET15,Z NUZ11300 LD L YS4 NUZ11310 SLA 1 NUZ11320 STO L DUM NUZ11330 LDX I2 DUM NUZ11340 LDD L2 ZG-2 NUZ11350 STD L ZS4 NUZ11360 GET15 LD L COL NUZ11370 S L XS5 NUZ11380 BSC L GET16,Z NUZ11390 LD L YS5 NUZ11400 SLA 1 NUZ11410 STO L DUM NUZ11420 LDX I2 DUM NUZ11430 LDD L2 ZG-2 NUZ11440 STD L ZS5 NUZ11450 GET16 LD L COL NUZ11460 S L XS6 NUZ11470 BSC L GET17,Z NUZ11480 LD L YS6 NUZ11490 SLA 1 NUZ11500 STO L DUM NUZ11510 LDX I2 DUM NUZ11520 LDD L2 ZG-2 NUZ11530 STD L ZS6 NUZ11540 GET17 LD L COL NUZ11550 S L XS7 NUZ11560 BSC L GET18,Z NUZ11570 LD L YS7 NUZ11580 SLA 1 NUZ11590 STO L DUM NUZ11600 LDX I2 DUM NUZ11610 LDD L2 ZG-2 NUZ11620 STD L ZS7 NUZ11630 GET18 LD L COL NUZ11640 S L XS8 NUZ11650 BSC L GET19,Z NUZ11660 LD L YS8 NUZ11670 SLA 1 NUZ11680 STO L DUM NUZ11690 LDX I2 DUM NUZ11700 LDD L2 ZG-2 NUZ11710 STD L ZS8 NUZ11720 GET19 LD L COL NUZ11730 S L I NUZ11740 A L TWO NUZ11750 BSC L GET21,Z NUZ11760 LD L T+3 NUZ11770 BSC L GET20,+ NUZ11780 LD L J NUZ11790 SLA 1 NUZ11800 STO L DUM NUZ11810 LDX I2 DUM NUZ11820 LDD L2 ZG NUZ11830 STD L DUM NUZ11840 LIBF FLD NUZ11850 DC DUM NUZ11860 LIBF FADD NUZ11870 DC ZTAN3 NUZ11880 LIBF FSTO NUZ11890 DC ZTAN3 NUZ11900 GET20 LD L T+4 NUZ11910 BSC L GET21,+ NUZ11920 LD L J NUZ11930 SLA 1 NUZ11940 STO L DUM NUZ11950 LDX I2 DUM NUZ11960 LDD L2 ZG-4 NUZ11970 STD L DUM NUZ11980 LIBF FLD NUZ11990 DC DUM NUZ12000 LIBF FADD NUZ12010 DC ZTAN3 NUZ12020 LIBF FSTO NUZ12030 DC ZTAN3 NUZ12040 GET21 LD L COL NUZ12050 S L I NUZ12060 A L ONE NUZ12070 BSC L GET25,Z NUZ12080 LD L T+5 NUZ12090 BSC L GET22,+ NUZ12100 LD L J NUZ12110 SLA 1 NUZ12120 STO L DUM NUZ12130 LDX I2 DUM NUZ12140 LDD L2 ZG-6 NUZ12150 STD L DUM NUZ12160 LIBF FLD NUZ12170 DC DUM NUZ12180 LIBF FADD NUZ12190 DC ZTAN3 NUZ12200 LIBF FSTO NUZ12210 DC ZTAN3 NUZ12220 LDD L2 ZG-4 NUZ12230 STD L DUM NUZ12240 LIBF FLD NUZ12250 DC DUM NUZ12260 LIBF FADD NUZ12270 DC ZTAN2 NUZ12280 LIBF FSTO NUZ12290 DC ZTAN2 NUZ12300 GET22 LD L T+4 NUZ12310 BSC L GET23,+ NUZ12320 LD L J NUZ12330 SLA 1 NUZ12340 STO L DUM NUZ12350 LDX I2 DUM NUZ12360 LDD L2 ZG-4 NUZ12370 STD L DUM NUZ12380 LIBF FLD NUZ12390 DC DUM NUZ12400 LIBF FADD NUZ12410 DC ZTAN2 NUZ12420 LIBF FSTO NUZ12430 DC ZTAN2 NUZ12440 LDD L2 ZG-2 NUZ12450 STD L DUM NUZ12460 LIBF FLD NUZ12470 DC DUM NUZ12480 LIBF FADD NUZ12490 DC ZTAN1 NUZ12500 LIBF FSTO NUZ12510 DC ZTAN1 NUZ12520 GET23 LD L T+3 NUZ12530 BSC L GET24,+ NUZ12540 LD L J NUZ12550 SLA 1 NUZ12560 STO L DUM NUZ12570 LDX I2 DUM NUZ12580 LDD L2 ZG-2 NUZ12590 STD L DUM NUZ12600 LIBF FLD NUZ12610 DC DUM NUZ12620 LIBF FADD NUZ12630 DC ZTAN1 NUZ12640 LIBF FSTO NUZ12650 DC ZTAN1 NUZ12660 LDD L2 ZG NUZ12670 STD L DUM NUZ12680 LIBF FLD NUZ12690 DC DUM NUZ12700 LIBF FADD NUZ12710 DC ZTAN2 NUZ12720 LIBF FSTO NUZ12730 DC ZTAN2 NUZ12740 GET24 LD L T+2 NUZ12750 BSC L GET25,+ NUZ12760 LD L J NUZ12770 SLA 1 NUZ12780 STO L DUM NUZ12790 LDX I2 DUM NUZ12800 LDD L2 ZG NUZ12810 STD L DUM NUZ12820 LIBF FLD NUZ12830 DC DUM NUZ12840 LIBF FADD NUZ12850 DC ZTAN2 NUZ12860 LIBF FSTO NUZ12870 DC ZTAN2 NUZ12880 LDD L2 ZG+2 NUZ12890 STD L DUM NUZ12900 LIBF FLD NUZ12910 DC DUM NUZ12920 LIBF FADD NUZ12930 DC ZTAN3 NUZ12940 LIBF FSTO NUZ12950 DC ZTAN3 NUZ12960 GET25 LD L COL NUZ12970 S L I NUZ12980 BSC L GET29,Z NUZ12990 LD L J NUZ13000 SLA 1 NUZ13010 STO L DUM NUZ13020 LDX I2 DUM NUZ13030 LD L T+5 NUZ13040 BSC L GET26,+ NUZ13050 LDD L2 ZG-4 NUZ13060 STD L DUM NUZ13070 LIBF FLD NUZ13080 DC DUM NUZ13090 LIBF FADD NUZ13100 DC ZTAN1 NUZ13110 LIBF FSTO NUZ13120 DC ZTAN1 NUZ13130 GET26 LD L T+6 NUZ13140 BSC L GET27,+ NUZ13150 LDD L2 ZG-4 NUZ13160 STD L DUM NUZ13170 LIBF FLD NUZ13180 DC DUM NUZ13190 LIBF FADD NUZ13200 DC ZTAN1 NUZ13210 LIBF FSTO NUZ13220 DC ZTAN1 NUZ13230 GET27 LD L T+2 NUZ13240 BSC L GET28,+ NUZ13250 LDD L2 ZG NUZ13260 STD L DUM NUZ13270 LIBF FLD NUZ13280 DC DUM NUZ13290 LIBF FADD NUZ13300 DC ZTAN1 NUZ13310 LIBF FSTO NUZ13320 DC ZTAN1 NUZ13330 GET28 LD L T+1 NUZ13340 BSC L GET29,+ NUZ13350 LDD L2 ZG NUZ13360 STD L DUM NUZ13370 LIBF FLD NUZ13380 DC DUM NUZ13390 LIBF FADD NUZ13400 DC ZTAN1 NUZ13410 LIBF FSTO NUZ13420 DC ZTAN1 NUZ13430 GET29 LD L COL NUZ13440 S L I NUZ13450 S L ONE NUZ13460 BSC L GET33,Z NUZ13470 LD L J NUZ13480 SLA 1 NUZ13490 STO L DUM NUZ13500 LDX I2 DUM NUZ13510 LD L T+6 NUZ13520 BSC L GET30,+ NUZ13530 LDD L2 ZG-6 NUZ13540 STD L DUM NUZ13550 LIBF FLD NUZ13560 DC DUM NUZ13570 LIBF FADD NUZ13580 DC ZTAN3 NUZ13590 LIBF FSTO NUZ13600 DC ZTAN3 NUZ13610 LDD L2 ZG-4 NUZ13620 STD L DUM NUZ13630 LIBF FLD NUZ13640 DC DUM NUZ13650 LIBF FADD NUZ13660 DC ZTAN2 NUZ13670 LIBF FSTO NUZ13680 DC ZTAN2 NUZ13690 GET30 LD L T+7 NUZ13700 BSC L GET31,+ NUZ13710 LDD L2 ZG-4 NUZ13720 STD L DUM NUZ13730 LIBF FLD NUZ13740 DC DUM NUZ13750 LIBF FADD NUZ13760 DC ZTAN2 NUZ13770 LIBF FSTO NUZ13780 DC ZTAN2 NUZ13790 LDD L2 ZG-2 NUZ13800 STD L DUM NUZ13810 LIBF FLD NUZ13820 DC DUM NUZ13830 LIBF FADD NUZ13840 DC ZTAN1 NUZ13850 LIBF FSTO NUZ13860 DC ZTAN1 NUZ13870 GET31 LD L T NUZ13880 BSC L GET32,+ NUZ13890 LDD L2 ZG-2 NUZ13900 STD L DUM NUZ13910 LIBF FLD NUZ13920 DC DUM NUZ13930 LIBF FADD NUZ13940 DC ZTAN1 NUZ13950 LIBF FSTO NUZ13960 DC ZTAN1 NUZ13970 LDD L2 ZG NUZ13980 STD L DUM NUZ13990 LIBF FLD NUZ14000 DC DUM NUZ14010 LIBF FADD NUZ14020 DC ZTAN2 NUZ14030 LIBF FSTO NUZ14040 DC ZTAN2 NUZ14050 GET32 LD L T+1 NUZ14060 BSC L GET33,+ NUZ14070 LDD L2 ZG NUZ14080 STD L DUM NUZ14090 LIBF FLD NUZ14100 DC DUM NUZ14110 LIBF FADD NUZ14120 DC ZTAN2 NUZ14130 LIBF FSTO NUZ14140 DC ZTAN2 NUZ14150 LDD L2 ZG+2 NUZ14160 STD L DUM NUZ14170 LIBF FLD NUZ14180 DC DUM NUZ14190 LIBF FADD NUZ14200 DC ZTAN3 NUZ14210 LIBF FSTO NUZ14220 DC ZTAN3 NUZ14230 GET33 LD L COL NUZ14240 S L I NUZ14250 S L TWO NUZ14260 BSC L GET35,Z NUZ14270 LD L J NUZ14280 SLA 1 NUZ14290 STO L DUM NUZ14300 LDX I2 DUM NUZ14310 LD L T+7 NUZ14320 BSC L GET34,+ NUZ14330 LDD L2 ZG-4 NUZ14340 STD L DUM NUZ14350 LIBF FLD NUZ14360 DC DUM NUZ14370 LIBF FADD NUZ14380 DC ZTAN3 NUZ14390 LIBF FSTO NUZ14400 DC ZTAN3 NUZ14410 GET34 LD L T NUZ14420 BSC L GET35,+ NUZ14430 LDD L2 ZG NUZ14440 STD L DUM NUZ14450 LIBF FLD NUZ14460 DC DUM NUZ14470 LIBF FADD NUZ14480 DC ZTAN3 NUZ14490 LIBF FSTO NUZ14500 DC ZTAN3 NUZ14510 GET35 STX L1 DUM NUZ14520 LD L DUM NUZ14530 S L NCOL NUZ14540 BSC L GET11,Z+ NUZ14550 BSC I GETZS NUZ14560 ************** NUZ14570 * ROUTINE TO SET SWITCH FOR NEWLY DEFINED NUZ14580 * GRID VALUES NUZ14590 ************** NUZ14600 STCL2 NOP NUZ14610 LDX I1 J NUZ14620 LD L ONE NUZ14630 STO L1 ICOL2-1 NUZ14640 BSC I STCL2 NUZ14650 ************** NUZ14660 * ROUTINE TO SET A ONE IN THE SWITCH NUZ14670 * FOR A DESIGNATED GRID POINT NUZ14680 * GRID POINT AT (COL,ROW) NUZ14690 ***************** NUZ14700 SETSW NOP RETURN ADDRESS NUZ14710 STX L1 DUM1 NUZ14720 STX L2 DUM2 NUZ14730 LD L COL FROM THE COLUMN AND NUZ14740 S L ONE ROW DETERMINE THE NUZ14750 M L COLNG WORD AND BIT POSITION NUZ14760 AD L ROW-1 OF THE SWITCH NUZ14770 SD L ONE-1 NUZ14780 D L WRDLG NUZ14790 STD L DUM NUZ14800 LDX I1 DUM WORD NUZ14810 LDX I2 DUM+1 BIT POSITION NUZ14820 LD L1 IZ LOAD WORD IN ACC NUZ14830 OR L2 MASK LOGICAL OR WITH MASK NUZ14840 STO L1 IZ STORE WORD BACK NUZ14850 LDX I1 DUM1 RESTORES INDEX NUZ14860 LDX I2 DUM2 REGISTERS NUZ14870 BSC I SETSW RETURN NUZ14880 ************** NUZ14890 * ROUTINE TO TEST THE SWITCH FOR A NUZ14900 * DESIGNATED GRID POINT NUZ14910 * THE VALUE OF THE SWITCH WILL BE NUZ14920 * LOADED INTO THE ACCUMULATOR NUZ14930 ************** NUZ14940 TSTSW NOP RETURN ADDRESS NUZ14950 STX L1 DUM1 NUZ14960 STX L2 DUM2 NUZ14970 LD L COL FROM THE COLUMN AND NUZ14980 S L ONE ROW DETERMINE THE NUZ14990 M L COLNG WORD AND BIT POSITION NUZ15000 AD L ROW-1 OF THE SWITCH NUZ15010 SD L ONE-1 NUZ15020 D L WRDLG NUZ15030 STD L DUM NUZ15040 LDX I1 DUM WORD NUZ15050 LD L DUM+1 BIT POSITION NUZ15060 A L ONE COMPUTE SHIFT NUZ15070 STO L DUM+1 NUZ15080 LD L1 IZ LOAD WORD IN ACC NUZ15090 LDX I2 DUM+1 NUZ15100 SLA 2 SHIFT BIT TO CARRY NUZ15110 BSC L SO,C TEST CARRY NUZ15120 LD L ZERO ZERO IN ACC NUZ15130 MDX RET NUZ15140 SO LD L ONE ONE IN ACC NUZ15150 RET LDX I1 DUM1 RESTORE INDEX NUZ15160 LDX I2 DUM2 REGISTERS NUZ15170 BSC I TSTSW RETURN NUZ15180 ************** NUZ15190 * ROUTINE TO STORE A COMPUTED GRID VALUE NUZ15200 ************** NUZ15210 STGRD NOP NUZ15220 BSI L GRDVA READ COLUMN NUZ15230 LD L ROW CONTAINING THE POINT NUZ15240 A L ROW NUZ15250 STO L DUM NUZ15260 LDX I1 DUM NUZ15270 LDD L1 ZG-2 IS THE POINT ALREADY NUZ15280 STD L DUM DEFINED NUZ15290 LIBF FLD NUZ15300 DC DUM NUZ15310 LIBF FSUB NUZ15320 DC ZNIL NUZ15330 LIBF FSTO NUZ15340 DC DUM1 NUZ15350 LD L DUM1 NUZ15360 BSC L STGR1,-+ NUZ15370 LIBF FLD AVERAGE THE TWO NUZ15380 DC DUM VALUES NUZ15390 LIBF FADD NUZ15400 DC ZP NUZ15410 LIBF FDIV NUZ15420 DC FTWO NUZ15430 LIBF FSTO NUZ15440 DC ZP NUZ15450 STGR1 LD L ISIGN IS A SIGN RESTRICTION NUZ15460 S L ONE SPECIFIED NUZ15470 BSC L STGR2,+ TEST THAT THE VALUE NUZ15480 LD L ZP IS NOT POSITIVE NUZ15490 BSC L STGR3,+ NUZ15500 LDD L FZERO NUZ15510 STD L ZP NUZ15520 MDX STGR3 NUZ15530 STGR2 LD L ISIGN NUZ15540 BSC L STGR3,+ NUZ15550 LD L ZP TEST THAT THE VALUE NUZ15560 BSC L STGR3,- IS NOT NEGATIVE NUZ15570 LDD L FZERO NUZ15580 STD L ZP NUZ15590 STGR3 LD L MINZ IS A MINIMUM VALUE NUZ15600 BSC L STGR4,+ SPECIFIED NUZ15610 LIBF FLD NUZ15620 DC ZP NUZ15630 LIBF FSUB TEST THAT THE VALUE NUZ15640 DC ZMIN IS NOT LESS THAN THE NUZ15650 LIBF FSTO MINIMUM NUZ15660 DC DUM NUZ15670 LD L DUM NUZ15680 BSC L STGR4,- NUZ15690 LDD L ZMIN NUZ15700 STD L ZP NUZ15710 STGR4 LD L MAXZ IS A MAXIMUM VALUE NUZ15720 BSC L STGR5,+ SPECIFIED NUZ15730 LIBF FLD NUZ15740 DC ZP TEST THAT THE VALUE NUZ15750 LIBF FSUB IS NOT GREATER THAN NUZ15760 DC ZMAX THE MAXIMUM NUZ15770 LIBF FSTO NUZ15780 DC DUM NUZ15790 LD L DUM NUZ15800 BSC L STGR5,+ NUZ15810 LDD L ZMAX NUZ15820 STD L ZP NUZ15830 STGR5 LDD L ZP STORE OUTPUT GRID NUZ15840 STD L1 ZG-2 VALUE ON THE DISK NUZ15850 BSI L WRTGR NUZ15860 BSI L SETSW NUZ15870 BSC I STGRD NUZ15880 *************** NUZ15890 * GRDVA SUBROUTINE NUZ15900 *************** NUZ15910 GRDVA NOP SUBROUTINE TO NUZ15920 STX L1 DIX1 NUZ15930 STX L2 DIX2 NUZ15940 BSI L SCCOM READ THE GRID NUZ15950 LD L SCLOC VALUES FROM THE NUZ15960 STO L WKIO&1 DISK DATA AREA NUZ15970 LD L FX640 NUZ15980 STO L WKIO NUZ15990 LIBF DISKN NUZ16000 DC /5000 NUZ16010 DC WKIO NUZ16020 DC ERRS NUZ16030 LIBF DISKN NUZ16040 DC /1000 NUZ16050 DC WKIO NUZ16060 DC ERRS NUZ16070 LD L ININX NUZ16080 A L FX218 NUZ16090 STO L DUMY NUZ16100 LDX I1 DUMY NUZ16110 LDX I2 FX200 NUZ16120 LIBF DISKN NUZ16130 DC /0000 NUZ16140 DC WKIO NUZ16150 MDX *-4 NUZ16160 LDD L1 WKIO NUZ16170 STD L2 ZG-2 NUZ16180 MDX 1 -2 NUZ16190 MDX 2 -2 NUZ16200 MDX *-7 NUZ16210 LDX I1 ININX NUZ16220 LD L1 WKIO NUZ16230 STO L ICOL NUZ16240 STO L THCOL NUZ16250 LD L1 WKIO+1 NUZ16260 STO L IRBGN NUZ16270 LD L1 WKIO+2 NUZ16280 STO L IREND NUZ16290 LDX I1 DIX1 NUZ16300 LDX I2 DIX2 NUZ16310 BSC I GRDVA NUZ16320 ERRS DC 0 NUZ16330 BSI L ERTYP NUZ16340 DC MSAGS NUZ16350 SRA 16 NUZ16360 BSC I ERRS NUZ16370 EROB BSI L ERTYP NUZ16380 DC MSAGA NUZ16390 BSI L ERTYP NUZ16400 DC MSAGB NUZ16410 WAIT NUZ16420 EXIT NUZ16430 *************** NUZ16440 * ERTYP SUBROUTINE NUZ16450 *************** NUZ16460 ERTYP NOP SUBROUTINE TO NUZ16470 LD I ERTYP WRITE MESSAGES NUZ16480 STO L ERTX ON THE CONSOLE NUZ16490 MDX L ERTYP,&1 TYPEWRITER NUZ16500 LD L ERTX NUZ16510 S L ONE NUZ16520 STO *&1 NUZ16530 LD L 0 NUZ16540 STO L ERTX+2 NUZ16550 M L ONE NUZ16560 D L TWO NUZ16570 STO L TYPE NUZ16580 LIBF EBPRT NUZ16590 DC /0000 NUZ16600 ERTX DC 0 NUZ16610 DC TYPE+1 NUZ16620 DC 0 NUZ16630 LIBF WRTY0 NUZ16640 DC /2000 NUZ16650 DC TYPE NUZ16660 LIBF WRTY0 NUZ16670 DC /2000 NUZ16680 DC CONTL NUZ16690 LIBF WRTY0 NUZ16700 DC /0000 NUZ16710 MDX *-3 NUZ16720 BSC I ERTYP NUZ16730 *************** NUZ16740 * WRTGR SUBROUTINE NUZ16750 *************** NUZ16760 WRTGR NOP SUBROUTINE TO NUZ16770 STX L1 DIX1 NUZ16780 STX L2 DIX2 NUZ16790 BSI L SCCOM WRITE THE OUTPUT NUZ16800 LIBF DISKN GRID COLUMNS ON NUZ16810 DC /0000 THE DISK NUZ16820 DC WKIO NUZ16830 MDX *-4 NUZ16840 LD L FX640 NUZ16850 STO L WKIO NUZ16860 LD L SCLOC NUZ16870 STO L WKIO+1 NUZ16880 LIBF DISKN NUZ16890 DC /5000 NUZ16900 DC WKIO NUZ16910 DC ERRS NUZ16920 LIBF DISKN NUZ16930 DC /1000 NUZ16940 DC WKIO NUZ16950 DC ERRS NUZ16960 LIBF DISKN NUZ16970 DC /0000 NUZ16980 DC WKIO NUZ16990 MDX *-4 NUZ17000 LD L ININX NUZ17010 A L FX418 NUZ17020 STO L DUMY NUZ17030 LDX I1 DUMY NUZ17040 LDX I2 FX420 NUZ17050 LDD L ZNIL NUZ17060 STD L1 WKIO NUZ17070 MDX 1 -2 NUZ17080 MDX 2 -2 NUZ17090 MDX *-5 NUZ17100 LD L IEZ NUZ17110 A L IEZ NUZ17120 STO L DUMY NUZ17130 LDX I2 DUMY NUZ17140 LD L ININX NUZ17150 A L FX20 NUZ17160 A L DUMY NUZ17170 S L TWO NUZ17180 STO L DUMY NUZ17190 LDX I1 DUMY NUZ17200 LDD L2 ZO-2 NUZ17210 STD L1 WKIO NUZ17220 MDX 1 -2 NUZ17230 MDX 2 -2 NUZ17240 MDX *-7 NUZ17250 LDX I1 ININX NUZ17260 LD L KCOLZ NUZ17270 STO L1 WKIO NUZ17280 LD L IBZ NUZ17290 STO L1 WKIO+1 NUZ17300 LD L IEZ NUZ17310 STO L1 WKIO&2 NUZ17320 LIBF DISKN NUZ17330 DC /4000 NUZ17340 DC WKIO NUZ17350 LIBF DISKN NUZ17360 DC /0000 NUZ17370 DC WKIO NUZ17380 MDX *-4 NUZ17390 LDX I1 DIX1 NUZ17400 LDX I2 DIX2 NUZ17410 BSC I WRTGR NUZ17420 * SCCOM SUBROUTINE NUZ17430 *************** NUZ17440 SCCOM NOP SUBROUTINE TO NUZ17450 LD L THCOL COMPUTE THE NUZ17460 S L ONE LOCATION OF THE NUZ17470 M L ONE SUCCESSIVE NUZ17480 D L THREE COLUMNS IN THE NUZ17490 STO L DUMY DISK DATA AREA NUZ17500 M L FOUR NUZ17510 D L ONE NUZ17520 STO L SCINC NUZ17530 LD L DUMY NUZ17540 M L THREE NUZ17550 D L ONE NUZ17560 STO L DUMY NUZ17570 LD L THCOL NUZ17580 S L DUMY NUZ17590 S L ONE NUZ17600 STO L SCINX NUZ17610 A L SCINC NUZ17620 STO L SCINC NUZ17630 A L SCSTR NUZ17640 STO L SCLOC NUZ17650 S L SCBGN NUZ17660 BSC L EROB,Z+ NUZ17670 S L SCLGT NUZ17680 BSC L EROB,- NUZ17690 LD L FX100 NUZ17700 M L SCINX NUZ17710 D L ONE NUZ17720 A L FX22 NUZ17730 STO L ININX NUZ17740 BSC I SCCOM NUZ17750 *************** NUZ17760 * THIS AREA IS THE COMMON WRITTEN ON THE NUZ17770 * DISK AT THE END OF NUPRY NUZ17780 *************** NUZ17790 BSS E 0 *ALIGNMENT NUZ17800 DSKOT DC 18 *NO. OF WORDS NUZ17810 DC 1584 *SECTOR ADDRESS NUZ17820 YMAX BSS 2 * NUZ17830 ZMIN BSS 2 *Z LIMITS NUZ17840 ZMAX BSS 2 * NUZ17850 ICMAX BSS 1 *MAX COLUMN NUZ17860 IRMAX BSS 1 *MAX ROW NUZ17870 ISIGN BSS 1 *SIGN LIMITATION NUZ17880 IRSTR BSS 1 *BORDER OPTION NUZ17890 MINZ BSS 1 *Z LIMITS NUZ17900 MAXZ BSS 1 *SWITCHES NUZ17910 IPTS BSS 1 *NO. OF POINTS NUZ17920 SCINC BSS 1 *OUTPUT DATA SET NUZ17930 SCSTR BSS 1 *LOCATION NUZ17940 SCINX BSS 1 *PARAMETERS NUZ17950 SCLOC BSS 1 * NUZ17960 ININX BSS 1 * NUZ17970 ************** NUZ17980 * ARRAYS NUZ17990 ************** NUZ18000 TYPE BSS E 30 TYPEWRITER AREA NUZ18010 I225 BSS 100 LIMITS FOR SECTOR NUZ18020 I675 BSS 100 SEARCH NUZ18030 IZ BSS 626 BIT SWITCHES NUZ18040 ZG BSS 200 COLUMN VECTOR NUZ18050 ICOL1 BSS 100 WORD SWITCHES NUZ18060 ICOL2 BSS 100 NUZ18070 T BSS E 8 THREESOME SWITCHES NUZ18080 WCOL BSS 16 COLUMNS NEEDED NUZ18090 *************** NUZ18100 * ERROR MESSAGES NUZ18110 *************** NUZ18120 DC 36 NUZ18130 MSAGS EBC .DISK ERROR TERMINATE JOB AND. NUZ18140 EBC . RESTART. NUZ18150 DC 30 NUZ18160 MSAGA EBC .UNABLE TO FIND TRAILER RECORD. NUZ18170 DC 30 NUZ18180 MSAGB EBC .PUSH START FOR EXIT TO MONITOR. NUZ18190 DC 14 NUZ18200 EMSAG EBC .NUPRX COMPLETE. NUZ18210 ************** NUZ18220 * FLOATING POINT CONSTANTS NUZ18230 ************** NUZ18240 FZERO DEC 0. NUZ18250 ZNIL DEC -1.E30 NUZ18260 F100 DEC 100. NUZ18270 TN225 DEC .4142 NUZ18280 TN675 DEC 2.4142 NUZ18290 GFAC DEC 1.9999 NUZ18300 FONE DEC 1.0 NUZ18310 FTWO DEC 2.0 NUZ18320 ************** NUZ18330 * FIXED POINT CONSTANTS NUZ18340 ************** NUZ18350 FX218 DC 218 NUZ18360 FX200 DC 200 NUZ18370 ZERO DC 0 NUZ18380 BSS E 0 NUZ18390 DC 0 NUZ18400 ONE DC 1 ODD BOUNDARY NUZ18410 N100 DC 100 NUZ18420 XNIL DC -20000 NUZ18430 TNTHU DC 10000 NUZ18440 N16 DC 16 NUZ18450 SIX DC 6 NUZ18460 M100 DC -100 NUZ18470 TWO DC 2 NUZ18480 M8 DC -8 NUZ18490 M16 DC -16 NUZ18500 M18 DC -18 NUZ18510 FIVE DC 5 NUZ18520 COLNG DC 100 COLUMN LENGTH NUZ18530 WRDLG DC 16 WORD LENGTH NUZ18540 MASK DC /8000 MASK FOR SETTING NUZ18550 DC /4000 OF BIT SWITCHES NUZ18560 DC /2000 NUZ18570 DC /1000 NUZ18580 DC /0800 NUZ18590 DC /0400 NUZ18600 DC /0200 NUZ18610 DC /0100 NUZ18620 DC /0080 NUZ18630 DC /0040 NUZ18640 DC /0020 NUZ18650 DC /0010 NUZ18660 DC /0008 NUZ18670 DC /0004 NUZ18680 DC /0002 NUZ18690 DC /0001 NUZ18700 C72 DC /0080 TOLERANCE VALUE NUZ18710 TOLM DC /00FF MASK NUZ18720 FX20 DC 20 NUZ18730 SCBGN DC 448 STARTING SECTOR NUZ18740 FOUR DC 4 NUZ18750 THREE DC 3 NUZ18760 SCLGT DC 808 NO. OF SECTORS NUZ18770 FX22 DC 22 NUZ18780 FX640 DC 640 NUZ18790 FX400 DC 400 NUZ18800 FX300 DC 300 NUZ18810 SCCNT DC 287 NUZ18820 TEN DC 10 NUZ18830 FX418 DC 418 NUZ18840 FX420 DC 420 NUZ18850 N300 DC 300 NUZ18860 M200 DC -200 NUZ18870 NG625 DC -625 NUZ18880 CONTL DC 1 TYPEWRITER NUZ18890 DC /8103 CARRIAGE RETURN NUZ18900 ************** NUZ18910 * VARIABLES NUZ18920 ************** NUZ18930 XN BSS 2 NUZ18940 XS1 DEC 0. PARAMETERS USED NUZ18950 XS2 DEC 0. IN LEAST NUZ18960 XS3 DEC 0. SQUARES FIT NUZ18970 XS4 DEC 0. NUZ18980 XS5 DEC 0. NUZ18990 XS6 DEC 0. NUZ19000 XS7 DEC 0. NUZ19010 XS8 DEC 0. NUZ19020 YS1 BSS 2 NUZ19030 YS2 BSS 2 NUZ19040 YS3 BSS 2 NUZ19050 YS4 BSS 2 NUZ19060 YS5 BSS 2 NUZ19070 YS6 BSS 2 NUZ19080 YS7 BSS 2 NUZ19090 YS8 BSS 2 NUZ19100 ZS1 BSS 2 NUZ19110 ZS2 BSS 2 NUZ19120 ZS3 BSS 2 NUZ19130 ZS4 BSS 2 NUZ19140 ZS5 BSS 2 NUZ19150 ZS6 BSS 2 NUZ19160 ZS7 BSS 2 NUZ19170 ZS8 BSS 2 NUZ19180 RS1 BSS 2 NUZ19190 RS2 BSS 2 NUZ19200 RS3 BSS 2 NUZ19210 RS4 BSS 2 NUZ19220 RS5 BSS 2 NUZ19230 RS6 BSS 2 NUZ19240 RS7 BSS 2 NUZ19250 RS8 BSS 2 NUZ19260 R BSS 2 NUZ19270 C1 BSS 2 NUZ19280 C2 BSS 2 NUZ19290 C3 BSS 2 NUZ19300 C4 BSS 2 NUZ19310 C5 BSS 2 NUZ19320 C6 BSS 2 NUZ19330 C7 BSS 2 NUZ19340 C8 BSS 2 NUZ19350 C9 BSS 2 NUZ19360 WX BSS 2 NUZ19370 WY BSS 2 NUZ19380 ACC1 BSS 2 NUZ19390 A BSS 2 NUZ19400 B BSS 2 NUZ19410 ACC2 BSS 2 NUZ19420 ACC3 BSS 2 NUZ19430 ACC4 BSS 2 NUZ19440 WTC BSS 2 NUZ19450 RSLOP BSS 2 NUZ19460 RP BSS 2 NUZ19470 C BSS 2 NUZ19480 ZTAN1 BSS 2 TANGENT PLANE NUZ19490 ZTAN2 BSS 2 ACCUMULATORS NUZ19500 ZTAN3 BSS 2 NUZ19510 DUM2 BSS 2 TEMPORARY STORAGE NUZ19520 BSS E 0 NUZ19530 XP BSS 2 NUZ19540 YP BSS 2 NUZ19550 ZP BSS 2 NUZ19560 DUM BSS 2 NUZ19570 DUM1 BSS 2 NUZ19580 DUMY BSS E 2 NUZ19590 ND BSS E 2 NUZ19600 XNEW BSS E 2 NUZ19610 YNEW BSS E 2 NUZ19620 NCOL BSS 1 NO. OF COLS. NEEDED NUZ19630 COL BSS 1 COLUMN NO. NUZ19640 BSS E 0 NUZ19650 DC 0 NUZ19660 ROW BSS 1 ODD BOUNDARY NUZ19670 NMTST BSS 1 NO. OF PTS. REDUCED NUZ19680 ICHNG BSS 1 POINT EVALUATED NUZ19690 IM2 BSS 1 COL-2 NUZ19700 IM1 BSS 1 COL-1 NUZ19710 IP1 BSS 1 COL+1 NUZ19720 IP2 BSS 1 COL+2 NUZ19730 JM2 BSS 1 ROW-2 NUZ19740 JM1 BSS 1 ROW-1 NUZ19750 JP1 BSS 1 ROW+1 NUZ19760 JP2 BSS 1 ROW+2 NUZ19770 I BSS 1 COLUMN NUZ19780 J BSS 1 ROW NUZ19790 NT BSS 1 NO. OF THREESOMES NUZ19800 IRBGN BSS 1 BEG. ROW NUZ19810 IREND BSS 1 ENDING ROW NUZ19820 DIX1 BSS 1 TEMPORARY STORAGE NUZ19830 DIX2 BSS 1 NUZ19840 IPP BSS 1 STORAGE FOR NUZ19850 JPP BSS 1 PARAMETERS IN NUZ19860 JP BSS 1 SECTOR SEARCH NUZ19870 STEP BSS 1 NUZ19880 COUNT BSS 1 NUZ19890 IFOUN BSS 1 NUZ19900 ICOL BSS 1 COLUMN NUZ19910 DTCNT BSS 1 NUZ19920 NONE BSS 1 NUZ19930 REG1 BSS 1 NUZ19940 WKIO BSS E 642 DISK I/O BUFFER NUZ19950 *************** NUZ19960 * EQUATES NUZ19970 *************** NUZ19980 IBZ EQU ONE NUZ19990 IEZ EQU IRMAX NUZ20000 KCOLZ EQU COL NUZ20010 SCSTC EQU SCSTR NUZ20020 FX100 EQU N100 NUZ20030 THCOL EQU COL NUZ20040 MXCOL EQU ICMAX NUZ20050 MXROW EQU IRMAX NUZ20060 N1 EQU ONE NUZ20070 ZO EQU ZG NUZ20080 END OKB NUZ20090 // DUP NUZ20100 *STORE WS UA NUPRZ NUZ20110 // JOB ERR00010 // DUP ERR00020 *DELETE UA ERRSL ERR00030 // ASM ERR00040 *LIST ERR00050 *************** ERR00060 * ERRSL - NUPRY COMES HERE IF A DISK ERR00070 * ERROR OCCURS ERR00080 *************** ERR00090 START NOP ERR00100 ERRS BSI L ERTYP TYPE ERROR ERR00110 DC MSAGS MESSAGE ERR00120 WAIT WAIT BEFORE ERR00130 EXIT EXIT TO MONITOR ERR00140 *************** ERR00150 * ERTYP SUBROUTINE ERR00160 *************** ERR00170 ERTYP NOP SUBROUTINE TO ERR00180 LD I ERTYP WRITE MESSAGES ERR00190 STO L ERTX ON THE CONSOLE ERR00200 MDX L ERTYP,&1 TYPEWRITER ERR00210 LD L ERTX ERR00220 S L ONE ERR00230 STO *&1 ERR00240 LD L 0 ERR00250 STO L ERTX+2 ERR00260 M L ONE ERR00270 D L TWO ERR00280 STO L TYPE ERR00290 LIBF EBPRT ERR00300 DC /0000 ERR00310 ERTX DC 0 ERR00320 DC TYPE+1 ERR00330 DC 0 ERR00340 LIBF WRTY0 ERR00350 DC /2000 ERR00360 DC TYPE ERR00370 LIBF WRTY0 ERR00380 DC /2000 ERR00390 DC CONTL ERR00400 LIBF WRTY0 ERR00410 DC /0000 ERR00420 MDX *-3 ERR00430 BSC I ERTYP ERR00440 *************** ERR00450 * MESSAGE ERR00460 *************** ERR00470 DC 36 ERR00480 MSAGS EBC .DISK ERROR TERMINATE JOB AND. ERR00490 EBC . RESTART. ERR00500 *************** ERR00510 * CONSTANTS ERR00520 *************** ERR00530 ONE DC 1 ERR00540 TWO DC 2 ERR00550 CONTL DC 1 TYPEWRITER ERR00560 DC /8103 CARRIAGE RETURN ERR00570 *************** ERR00580 * STORAGE ERR00590 *************** ERR00600 TYPE BSS E 30 TYPEWRITER AREA ERR00610 END START ERR00620 // DUP ERR00630 *STORE WS UA ERRSL ERR00640 // JOB ERO00010 // DUP ERO00020 *DELETE UA EROBL ERO00030 // ASM ERO00040 *LIST ERO00050 *************** ERO00060 * EROBL - NUPRY COMES HERE IF THE LIMITS OF ERO00070 * THE GRID DATA SET AREA ARE ABOUT TO ERO00080 * BE EXCEEDED BY THE NEXT DISK ERO00090 * OPERATION ERO00100 *************** ERO00110 START NOP ERO00120 EROB BSI L ERTYP TYPE ERROR ERO00130 DC MSAGA MESSAGE ERO00140 BSI L ERTYP ERO00150 DC MSAGB ERO00160 WAIT WAIT BEFORE ERO00170 EXIT EXIT TO MONITOR ERO00180 *************** ERO00190 * ERTYP SUBROUTINE ERO00200 *************** ERO00210 ERTYP NOP SUBROUTINE TO ERO00220 LD I ERTYP WRITE MESSAGES ERO00230 STO L ERTX ON THE CONSOLE ERO00240 MDX L ERTYP,&1 TYPEWRITER ERO00250 LD L ERTX ERO00260 S L ONE ERO00270 STO *&1 ERO00280 LD L 0 ERO00290 STO L ERTX+2 ERO00300 M L ONE ERO00310 D L TWO ERO00320 STO L TYPE ERO00330 LIBF EBPRT ERO00340 DC /0000 ERO00350 ERTX DC 0 ERO00360 DC TYPE+1 ERO00370 DC 0 ERO00380 LIBF WRTY0 ERO00390 DC /2000 ERO00400 DC TYPE ERO00410 LIBF WRTY0 ERO00420 DC /2000 ERO00430 DC CONTL ERO00440 LIBF WRTY0 ERO00450 DC /0000 ERO00460 MDX *-3 ERO00470 BSC I ERTYP ERO00480 *************** ERO00490 * MESSAGES ERO00500 *************** ERO00510 DC 30 ERO00520 MSAGA EBC .UNABLE TO FIND TRAILER RECORD. ERO00530 DC 30 ERO00540 MSAGB EBC .PUSH START FOR EXIT TO MONITOR. ERO00550 *************** ERO00560 * CONSTANTS ERO00570 *************** ERO00580 ONE DC 1 ERO00590 TWO DC 2 ERO00600 CONTL DC 1 TYPEWRITER ERO00610 DC /8103 CARRIAGE RETURN ERO00620 *************** ERO00630 * STORAGE ERO00640 *************** ERO00650 TYPE BSS E 30 TYPEWRITER AREA ERO00660 END START ERO00670 // DUP ERO00680 *STORE WS UA EROBL ERO00690 // JOB FIN00010 // DUP FIN00020 *DELETE FINGR FIN00030 // ASM FIN00040 *LIST FIN00050 *************** FIN00060 * PROGRAM TO GENERATE A SET OF GRID VALUES WITH FIN00070 * ONE HALF THE GRID INTERVAL OF THE INPUT. THE FIN00080 * ROUTINE USES A NON-LINEAR INTERPOLATION. FIN00090 *************** FIN00100 FC EQU 126 FIN00110 GO LIBF WRTY0 SPACE TYPEWRITER FIN00120 DC /2000 FIN00130 DC CONTL FIN00140 BSI L ERTYP FIN00150 DC MSAG1 TYPE ' BEGINNING FINGR' FIN00160 LD L FX100 SET L TO 100 FIN00170 STO L L FIN00180 SLA 16 ZERO INPUT AND OUTPUT FIN00190 STO L IPTCL COLUMN COUNT FIN00200 STO L KCOLZ FIN00210 BSI L HEADS READ NAME HEADER CARD AND FIN00220 LD L ANAME STORE INPUT AND OUTPUT FIN00230 STO L MSAG2+9 NAMES FIN00240 LD L ANAME+1 FIN00250 STO L MSAG2+10 FIN00260 BSI L ERTYP TYPE NAME OF FIN00270 DC MSAG2 INPUT GRID FIN00280 LDD L ANAME FIN00290 STD L XNAME FIN00300 BSI L LOCAT LOCATE INPUT GRID FIN00310 LD L SCSTR IN DISK DATA AREA FIN00320 STO L SCSTA FIN00330 LD L IFOUN TYPE ERROR MESSAGE FIN00340 BSC L OKA,Z IF INPUT NAME CANNOT FIN00350 BSI L ERTYP BE FOUND ON THE FIN00360 DC MSAG6 DISK FIN00370 BSI L ERTYP FIN00380 DC MSAG4 FIN00390 MDX OUT FIN00400 OKA LD L IRMAX TEST NUMBER OF ROWS FIN00410 S L FX100 FIN00420 BSC L LERR,-Z + TOO MANY ROWS, TYPE MSG FIN00430 LD L ICMAX TEST NUMBER OF COLUMNS FIN00440 S L FX100 FIN00450 BSC L OKC,+ -Z OK GO ON FIN00460 LERR BSI L ERTYP + TYPE ERROR MESSAGE FIN00470 DC MSAG9 INPUT GRID TOO LARGE FIN00480 BSI L ERTYP FIN00490 DC MSAG4 PUSH START TO EXIT TO MONIT FIN00500 OUT WAIT FIN00510 EXIT FIN00520 OKC LDD L CNAME STORE OUTPUT NAME FOR LOCATFIN00530 STD L XNAME SUBROUTINE FIN00540 LD L CNAME FIN00550 STO L MSAGA+9 FIN00560 LD L CNAME+1 FIN00570 STO L MSAGA+10 FIN00580 BSI L ERTYP TYPE NAME OF FIN00590 DC MSAGA OUTPUT GRID FIN00600 BSI L LOCAT LOCATE TRAILER FIN00610 LD L SCSTR RECORD AND CHECK FOR FIN00620 STO L SCSTC OUTPUT NAME IN DISK FIN00630 LD L IFOUN DATA AREA FIN00640 BSC L OKB,+- FIN00650 BSI L ERTYP TYPE ERROR MESSAGE FIN00660 DC MSAG8 IF OUTPUT NAME HAS FIN00670 BSI L ERTYP ALREADY BEEN USED FIN00680 DC MSAG4 ON THE DISK FIN00690 MDX OUT FIN00700 OKB LD L SCSTA GET FIRST COLUMN OF GRID FIN00710 STO L SCSTR DATA SET FROM DISK AND FIN00720 MDX L IPTCL,1 MOVE FROM WRKIO BUFFER FIN00730 LD L IPTCL TO ZG4 FIN00740 STO L THCOL FIN00750 BSI L GRDVA FIN00760 LDX I1 FX200 MOVE COLUMN IN ZG4 TO ZG3 FIN00770 LP1 LDD L1 ZA-2 FIN00780 STD L1 ZG3-2 FIN00790 MDX 1 -2 FIN00800 MDX LP1 FIN00810 MDX L IPTCL,1 GET SECOND COLUMN OF GRID FIN00820 LD L IPTCL DATA SET MOVE TO ZG4 FIN00830 STO L THCOL FIN00840 BSI L GRDVA FIN00850 LDX I1 FX200 SET ZG2 TO ZNIL FIN00860 LDD L ZNIL FIN00870 LP2 STD L1 ZG2-2 FIN00880 MDX 1 -2 FIN00890 MDX LP2 FIN00900 LD L SCSTC PREPARE MASTER HEADER FIN00910 STO L SCSTR RECORD OF OUTPUT GRID FIN00920 LIBF FLD HALVE GRID INTERVAL FIN00930 DC GRID FIN00940 LIBF FMPY FIN00950 DC FHALF FIN00960 LIBF FSTO FIN00970 DC GRID FIN00980 LD L ICMAX NO. COLUMNS FOR NEW GRID FIN00990 SLA 1 FIN01000 S L ONE FIN01010 STO L MXCOL FIN01020 S L ONE IS THERE ROOM ON DISK FOR FIN01030 SRT 16 OUTPUT GRID FIN01040 D L THREE FIN01050 A L ONE FIN01060 SLA 2 FIN01070 A L SCSTC FIN01080 STO L SCSTT FIN01090 S L SCBGN FIN01100 S L SCLGT FIN01110 BSC L ER,- NO, PRINT ERROR MESSAGE FIN01120 LD L IRMAX NO. ROWS FOR NEW GRID FIN01130 SLA 1 FIN01140 S L ONE FIN01150 STO L MXROW FIN01160 BSI L WRTOU WRITE MASTER HEADER RECORD FIN01170 * OF OUTPUT GRID FIN01180 BSI L REWRT WRITE TRAILER RECORD FIN01190 SLA 16 SET COLUMN COUNT I TO 0 FIN01200 STO L I FIN01210 DFN44 MDX L I,1 *** SELECT A COLUMN *** FIN01220 LDX I1 IRMAX SHIFT COLUMNS 2,3,4 LEFT FIN01230 MDX I1 IRMAX FIN01240 LP3 LDD L1 ZG2-2 FIN01250 STD L1 ZG-2 FIN01260 LDD L1 ZG3-2 FIN01270 STD L1 ZG2-2 FIN01280 LDD L1 ZA-2 FIN01290 STD L1 ZG3-2 FIN01300 MDX 1 -2 FIN01310 MDX LP3 FIN01320 LD L ICMAX LOAD ANOTHER COLUMN OR FIN01330 S L I SET LAST ROW TO ZNIL FIN01340 S L ONE FIN01350 BSC L NILC,+ FIN01360 MDX L IPTCL,1 LOAD A COLUMN TO ZG4 FIN01370 LD L IPTCL FIN01380 STO L THCOL FIN01390 LD L SCSTA FIN01400 STO L SCSTR FIN01410 BSI L GRDVA FIN01420 MDX INROW FIN01430 NILC LDX I1 FX200 SET COLUMN ZG4 TO ZNIL FIN01440 LDD L ZNIL FIN01450 LP4 STD L1 ZA-2 FIN01460 MDX 1 -2 FIN01470 MDX LP4 FIN01480 INROW SLA 16 ZERO ROW COUNT INDEX J FIN01490 STO L J FIN01500 DFN43 LD L J *** SELECT A ROW *** FIN01510 SLA 1 SET LOCATION INDICES FIN01520 STO L K1 K1=2*J FIN01530 A L ONE FIN01540 STO L K2 K2=K1+1 FIN01550 LD L J FIN01560 A L L FIN01570 STO L I2 I2=J+100 FIN01580 MDX L J,1 J=J+1 FIN01590 LDX I1 I2 IS THE GRID VALUE FIN01600 MDX I1 I2 ZG2(M) DEFINED FIN01610 LIBF FLDX M=J THE SELECTED ROW FIN01620 DC ZG FIN01630 LIBF FSTO FIN01640 DC Z2 FIN01650 LIBF FSUB FIN01660 DC ZNIL FIN01670 LD 3 FC FIN01680 BSC L FN6,Z YES - GO TO FN6 FIN01690 FN1 LDX I1 K1 NO - SET ZO1(2M-1) TO ZNIL FIN01700 MDX I1 K1 FIN01710 NOP FIN01720 LDD L ZNIL FIN01730 STD L1 ZO1 FIN01740 LD L J IS THIS THE LAST ROW FIN01750 S L IRMAX FIN01760 BSC L FN3,- YES - GO TO FN3 FIN01770 FN2 LDX I1 K2 NO - SET ZO1(2M) TO ZNIL FIN01780 MDX I1 K2 FIN01790 LDD L ZNIL FIN01800 STD L1 ZO1 FIN01810 FN3 LD L I IS THIS THE LAST COLUMN FIN01820 S L ICMAX FIN01830 BSC L FN43,- YES - GO TO FN43 FIN01840 FN4 LDX I1 K1 NO - SET ZO2(2M-1) TO ZNIL FIN01850 MDX I1 K1 FIN01860 NOP FIN01870 LDD L ZNIL FIN01880 STD L1 ZO2 FIN01890 LD L J IS THIS THE LAST ROW FIN01900 S L IRMAX FIN01910 BSC L FN43,- YES - GO TO FN43 FIN01920 FN5 LDX I1 K2 NO - SET ZO2(2M) TO ZNIL FIN01930 MDX I1 K2 FIN01940 LDD L ZNIL FIN01950 STD L1 ZO2 FIN01960 BSC L FN43 GO TO FN43 FIN01970 FN6 LD L J IS THIS THE LAST ROW FIN01980 S L IRMAX FIN01990 BSC L FN8,Z+ YES - GO TO FN8 FIN02000 FN7 LDX I1 K1 NO - STORE Z2 IN ZO1(2M-1) FIN02010 MDX I1 K1 FIN02020 NOP FIN02030 LDD L Z2 FIN02040 STD L1 ZO1 FIN02050 MDX FN16 GO TO FN16 FIN02060 FN8 LD L I2 IS THE GRID VALUE ZG2(M+1) FIN02070 A L ONE DEFINED FIN02080 STO L I3 FIN02090 LDX I1 I3 FIN02100 MDX I1 I3 FIN02110 LIBF FLDX FIN02120 DC ZG FIN02130 LIBF FSTO FIN02140 DC Z3 FIN02150 LIBF FSUB FIN02160 DC ZNIL FIN02170 LD 3 FC FIN02180 BSC L FN10,Z YES - GO TO FN10 FIN02190 FN9 LDX I1 K2 NO - STORE ZNIL IN ZO1(2M) FIN02200 MDX I1 K2 FIN02210 LDD L ZNIL FIN02220 STD L1 ZO1 FIN02230 MDX FN7 GO TO FN7 FIN02240 FN10 LD L J IS THIS THE FIRST ROW FIN02250 S L ONE FIN02260 BSC L FN12,Z- NO - GO TO FN12 FIN02270 FN11 BSI L TL YES - GO TO INTERPOLATE TL FIN02280 LDX I1 K2 ROUTINE AND STORE RESULT FIN02290 MDX I1 K2 IN ZO1(2M) FIN02300 LIBF FSTOX FIN02310 DC ZO1 FIN02320 MDX FN7 GO TO FN7 FIN02330 FN12 LD L I2 IS THE GRID VALUE ZG2(M-1) FIN02340 S L ONE DEFINED FIN02350 STO L I1 FIN02360 LDX I1 I1 FIN02370 MDX I1 I1 FIN02380 LIBF FLDX FIN02390 DC ZG FIN02400 LIBF FSTO FIN02410 DC Z1 FIN02420 LIBF FSUB FIN02430 DC ZNIL FIN02440 LD 3 FC FIN02450 BSC L FN11,+- NO - GO TO FN11 FIN02460 FN13 LD L J IS THIS THE LAST OR NEXT FIN02470 A L ONE TO LAST ROW FIN02480 S L IRMAX FIN02490 BSC L FN11,- YES - GO TO FN11 FIN02500 FN14 LD L I2 NO - IS THE GRID VALUE FIN02510 A L TWO ZG2(M+2) DEFINED FIN02520 STO L I4 FIN02530 LDX I1 I4 FIN02540 MDX I1 I4 FIN02550 LIBF FLDX FIN02560 DC ZG FIN02570 LIBF FSTO FIN02580 DC Z4 FIN02590 LIBF FSUB FIN02600 DC ZNIL FIN02610 LD 3 FC FIN02620 BSC L FN11,+- NO - GO TO FN11 FIN02630 FN15 BSI L FNL YES - GO TO FNL FIN02640 LDX I1 K2 INTERPOLATE ROUTINE FIN02650 MDX I1 K2 STORE RESULT IN ZO1(2M) FIN02660 LIBF FSTOX FIN02670 DC ZO1 FIN02680 MDX FN7 GO TO FN7 FIN02690 FN16 LD L I IS THIS THE LAST COLUMN FIN02700 S L ICMAX FIN02710 BSC L FN43,- YES - GO TO FN43 FIN02720 FN17 LD L I2 NO - IS THE GRID VALUE TO FIN02730 A L L THE RIGHT OF I2 FIN02740 STO L I3 DEFINED, ZG3(M) FIN02750 LDX I1 I3 FIN02760 MDX I1 I3 FIN02770 LIBF FLDX FIN02780 DC ZG FIN02790 LIBF FSTO FIN02800 DC Z3 FIN02810 LIBF FSUB FIN02820 DC ZNIL FIN02830 LD 3 FC FIN02840 BSC L FN20,Z YES - GO TO FN20 FIN02850 FN18 LDX I1 K1 NO - STORE ZNIL IN FIN02860 MDX I1 K1 ZO2(2M-1) AND FIN02870 NOP FIN02880 LDD L ZNIL FIN02890 STD L1 ZO2 FIN02900 FN19 LDX I1 K2 STORE ZNIL IN ZO2(2M) FIN02910 MDX I1 K2 FIN02920 LDD L ZNIL FIN02930 STD L1 ZO2 FIN02940 BSC L FN43 GO TO FN43 FIN02950 FN20 LD L I IS THIS THE FIRST COLUMN FIN02960 S L ONE FIN02970 BSC L FN22,Z- NO - GO TO FN22 FIN02980 FN21 BSI L TL YES - INTERPOLATE WITH TL FIN02990 LDX I1 K1 SUBROUTINE AND STORE FIN03000 MDX I1 K1 RESULT IN ZO2(2M-1) FIN03010 NOP FIN03020 LIBF FSTOX FIN03030 DC ZO2 FIN03040 MDX FN26 GO TO FN26 FIN03050 FN22 LD L I2 IS THE GRID VALUE TO THE FIN03060 S L L LEFT OF I2,ZG1(M), FIN03070 STO L I1 DEFINED FIN03080 LDX I1 I1 FIN03090 MDX I1 I1 FIN03100 NOP FIN03110 LIBF FLDX FIN03120 DC ZG FIN03130 LIBF FSTO FIN03140 DC Z1 FIN03150 LIBF FSUB FIN03160 DC ZNIL FIN03170 LD 3 FC FIN03180 BSC L FN21,+- NO - GO TO FN21 FIN03190 FN23 LD L I YES - IS THIS THE NEXT FIN03200 A L ONE TO LAST COLUMN FIN03210 S L ICMAX FIN03220 BSC L FN21,- YES - GO TO FN21 FIN03230 FN24 LD L I3 NO - IS THE SECOND GRID FIN03240 A L L VALUE TO THE RIGHT FIN03250 STO L I4 ZG4(M) DEFINED FIN03260 LDX I1 I4 FIN03270 MDX I1 I4 FIN03280 LIBF FLDX FIN03290 DC ZG FIN03300 LIBF FSTO FIN03310 DC Z4 FIN03320 LIBF FSUB FIN03330 DC ZNIL FIN03340 LD 3 FC FIN03350 BSC L FN21,+- NO - GO TO FN21 FIN03360 FN25 BSI L FNL YES - INTERPOLATE WITH FIN03370 LDX I1 K1 FNL SUBROUTINE AND FIN03380 MDX I1 K1 STORE RESULT IN ZO2(2M-1) FIN03390 NOP FIN03400 LIBF FSTOX FIN03410 DC ZO2 FIN03420 FN26 LDD L Z3 FIN03430 STD L Z6 FIN03440 LD L J IS THIS THE LAST ROW FIN03450 S L IRMAX FIN03460 BSC L FN43,- YES - GO TO FN43 FIN03470 FN27 LD L I2 NO - IS THE GRID VALUE TO FIN03480 A L L THE RIGHT AND ABOVE FIN03490 A L ONE DEFINED, ZG3(M-1) FIN03500 STO L I3 FIN03510 LDX I1 I3 FIN03520 MDX I1 I3 FIN03530 LIBF FLDX FIN03540 DC ZG FIN03550 LIBF FSTO FIN03560 DC Z3 FIN03570 LIBF FSUB FIN03580 DC ZNIL FIN03590 LD 3 FC FIN03600 BSC L FN19,+- NO - GO TO FN19 FIN03610 FN28 LD L I2 YES - IS THE GRID VALUE FIN03620 A L ONE ABOVE DEFINED, ZG2(M+1) FIN03630 STO L I7 FIN03640 LDX I1 I7 FIN03650 MDX I1 I7 FIN03660 LIBF FLDX FIN03670 DC ZG FIN03680 LIBF FSTO FIN03690 DC Z7 FIN03700 LIBF FSUB FIN03710 DC ZNIL FIN03720 LD 3 FC FIN03730 BSC L FN19,+- NO - GO TO FN19 FIN03740 FN29 LD L I YES - IS THIS THE FIRST FIN03750 S L ONE COLUMN FIN03760 BSC L FN31,Z- NO - GO TO FN31 FIN03770 FN30 BSI L FL YES - INTERPOLATE WITH FL FIN03780 LDX I1 K2 SUBROUTINE AND FIN03790 MDX I1 K2 STORE RESULT IN ZO2(2M) FIN03800 LIBF FSTOX FIN03810 DC ZO2 FIN03820 BSC L FN43 GO TO FN43 FIN03830 FN31 LD L J IS THIS THE FIRST ROW FIN03840 S L ONE FIN03850 BSC L FN30,+ YES - GO TO FN30 FIN03860 FN32 LD L I2 NO - IS THE GRID VALUE FIN03870 S L L TO THE LEFT AND BELOW FIN03880 S L ONE DEFINED, ZG1(M-1) FIN03890 STO L I1 FIN03900 LDX I1 I1 FIN03910 MDX I1 I1 FIN03920 NOP FIN03930 LIBF FLDX FIN03940 DC ZG FIN03950 LIBF FSTO FIN03960 DC Z1 FIN03970 LIBF FSUB FIN03980 DC ZNIL FIN03990 LD 3 FC FIN04000 BSC L FN34,Z YES - GO TO FN34 FIN04010 FN33 BSI L FL NO - INTERPOLATE WITH FIN04020 LIBF FSTO FL AND STORE RESULT IN FIN04030 DC ZD1 ZD1 FIN04040 MDX FN38 GO TO FN38 FIN04050 FN34 LD L I IS THIS THE LAST OR NEXT FIN04060 A L ONE TO THE LAST COLUMN FIN04070 S L ICMAX FIN04080 BSC L FN30,- YES - GO TO FN30 FIN04090 FN35 LD L J NO - IS THIS THE LAST FIN04100 A L ONE OR NEXT TO THE LAST ROW FIN04110 S L IRMAX FIN04120 BSC L FN30,- YES - GO TO FN30 FIN04130 FN36 LD L I3 NO - IS THE SECOND GRID FIN04140 A L L VALUE TO THE RIGHT AND FIN04150 STO L I4 ABOVE DEFINED, ZG4(M+1) FIN04160 LDX I1 I4 FIN04170 MDX I1 I4 FIN04180 LIBF FLDX FIN04190 DC ZG FIN04200 LIBF FSTO FIN04210 DC Z4 FIN04220 LIBF FSUB FIN04230 DC ZNIL FIN04240 LD 3 FC FIN04250 BSC L FN33,+- NO - GO TO FN33 FIN04260 FN37 BSI L FNL YES - INTERPOLATE WITH FNL FIN04270 LIBF FSTO AND STORE RESULT IN ZD1 FIN04280 DC ZD1 FIN04290 FN38 LD L I7 IS THE GRID VALUE TO FIN04300 S L L THE LEFT AND ABOVE FIN04310 A L ONE DEFINED, ZG1(M+1) FIN04320 STO L I8 FIN04330 LDX I1 I8 FIN04340 MDX I1 I8 FIN04350 LIBF FLDX FIN04360 DC ZG FIN04370 LIBF FSTO FIN04380 DC Z8 FIN04390 LIBF FSUB FIN04400 DC ZNIL FIN04410 LD 3 FC FIN04420 BSC L FN40,Z YES - GO TO FN40 FIN04430 FN39 BSI L FL NO - INTERPOLATE WITH FL FIN04440 LIBF FSTO AND STORE RESULT IN ZD2 FIN04450 DC ZD2 FIN04460 MDX FN42 GO TO FN42 FIN04470 FN40 LD L I7 IS THE SECOND GRID FIN04480 A L L VALUE TO THE RIGHT FIN04490 A L L AND BELOW DEFINED, FIN04500 S L TWO ZG4(M-1) FIN04510 STO L I5 FIN04520 LDX I1 I5 FIN04530 MDX I1 I5 FIN04540 LIBF FLDX FIN04550 DC ZG FIN04560 LIBF FSTO FIN04570 DC Z5 FIN04580 LIBF FSUB FIN04590 DC ZNIL FIN04600 LD 3 FC FIN04610 BSC L FN39,+- NO - GO TO FN39 FIN04620 FN41 LDD L Z5 YES - INTERPOLATE WITH FNL FIN04630 STD L Z1 SUBROUTINE AND STORE THE FIN04640 LDD L Z6 RESULT IN ZD2 FIN04650 STD L Z2 FIN04660 LDD L Z7 FIN04670 STD L Z3 FIN04680 LDD L Z8 FIN04690 STD L Z4 FIN04700 BSI L FNL INTERPOLATE WITH FNL FIN04710 LIBF FSTO AND STORE RESULT IN ZD2 FIN04720 DC ZD2 FIN04730 FN42 LDX I1 K2 STORE (ZD1+ZD2)*.5 IN FIN04740 MDX I1 K2 ZO2(2M) FIN04750 LIBF FLD FIN04760 DC ZD1 FIN04770 LIBF FADD FIN04780 DC ZD2 FIN04790 LIBF FMPY FIN04800 DC FHALF FIN04810 LIBF FSTOX FIN04820 DC ZO2 FIN04830 FN43 LD L J IS THIS THE LAST ROW FIN04840 S L IRMAX FIN04850 BSC L DFN43,Z+ NO - GO TO PROCESS ANOTHERFIN04860 * ROW ELEMENT FIN04870 LD L SCSTC YES - WRITE ZO1 ON DISK FIN04880 STO L SCSTR FIN04890 MDX L KCOLZ,1 FIN04900 LD L KCOLZ FIN04910 STO L THCOL FIN04920 BSI L WRTGR WRITE COLUMN 1 FIN04930 LD L I IS THIS THE LAST COLUMN FIN04940 S L ICMAX NO WRITE 2ND COLUMN FIN04950 BSC L FN44,- YES WRITE TRAILER RECORD FIN04960 MDX L KCOLZ,1 NO - WRITE ZO2 ON THE DISK FIN04970 LD L KCOLZ FIN04980 STO L THCOL FIN04990 LD L WRT+1 MODIFY ADDRESS TO Z02 FIN05000 A L FX402 FIN05010 STO L WRT+1 FIN05020 BSI L WRTGR FIN05030 LD L WRT+1 MODIFY ADDRESS TO Z01 FIN05040 S L FX402 FIN05050 STO L WRT+1 FIN05060 BSC L DFN44 GO TO PROCESS ANOTHER COL FIN05070 FN44 BSI L ERTYP FIN05080 DC MSAG3 TYPE ' FINGR COMPLETED' FIN05090 EXIT FIN05100 *************** FIN05110 * TL SUBROUTINE FIN05120 *************** FIN05130 TL NOP INTERPOLATE WITH 2 VALUES FIN05140 LIBF FLD FIN05150 DC Z2 FIN05160 LIBF FADD FIN05170 DC Z3 FIN05180 LIBF FMPY FIN05190 DC FHALF FIN05200 BSC I TL FIN05210 *************** FIN05220 * FL SUBROUTINE FIN05230 *************** FIN05240 FL NOP INTERPOLATE WITH 4 VALUES FIN05250 LIBF FLD FIN05260 DC Z2 FIN05270 LIBF FADD FIN05280 DC Z3 FIN05290 LIBF FADD FIN05300 DC Z6 FIN05310 LIBF FADD FIN05320 DC Z7 FIN05330 LIBF FMPY FIN05340 DC FFRTH FIN05350 BSC I FL FIN05360 *************** FIN05370 * FNL SUBROUTINE FIN05380 *************** FIN05390 FNL NOP INTERPOLATE WITH NEWTON FIN05400 LIBF FLD METHOD USING 4 VALUES FIN05410 DC Z2 FIN05420 LIBF FADD FIN05430 DC Z3 FIN05440 LIBF FMPY FIN05450 DC FNINE FIN05460 LIBF FSUB FIN05470 DC Z1 FIN05480 LIBF FSUB FIN05490 DC Z4 FIN05500 LIBF FMPY FIN05510 DC FSIXH FIN05520 BSC I FNL FIN05530 *************** FIN05540 * HEADS SUBROUTINE FIN05550 *************** FIN05560 HEADS NOP SUBROUTINE TO FIN05570 LD L FX9 READ A CARD FIN05580 STO L WKIO CONTAINING THE FIN05590 *************** FIN05600 LIBF CARD0 DATA SET NAMES FIN05610 * LIBF READ0 DATA SET NAMES FIN05620 *************** FIN05630 DC /0000 FIN05640 MDX *-3 FIN05650 *************** FIN05660 LIBF CARD0 FIN05670 * LIBF READ0 FIN05680 *************** FIN05690 DC /1000 FIN05700 DC WKIO FIN05710 *************** FIN05720 LIBF CARD0 FIN05730 * LIBF READ0 FIN05740 *************** FIN05750 DC /0000 FIN05760 MDX *-3 FIN05770 LIBF SPEED FIN05780 DC /0000 FIN05790 DC WKIO+1 FIN05800 DC ANAME FIN05810 DC 4 FIN05820 LIBF SPEED FIN05830 DC /0000 FIN05840 DC WKIO+6 FIN05850 DC CNAME FIN05860 DC 4 FIN05870 BSC I HEADS FIN05880 *************** FIN05890 * LOCAT SUBROUTINE FIN05900 *************** FIN05910 LOCAT NOP SUBROUTINE TO LOCATE A GRIDFIN05920 LD L FX20 DATA SET ON THE DISK FIN05930 STO L WKIO INPUT - GRID DATA SET FIN05940 LD L SCBGN NAME, XNAME FIN05950 STO L WKIO+1 BEGINNING SECTOR FIN05960 AGN LIBF DISKN SCBGN FIN05970 DC /5000 OUTPUT - SECTOR ADDRESS FIN05980 DC WKIO OF HEADER RECORDFIN05990 DC ERRS FOR GRID DATA FIN06000 LIBF DISKN SET IN SCSTR FIN06010 DC /1000 IFOUN=1 - GRID FIN06020 DC WKIO DATA SET IS FIN06030 DC ERRS FOUND FIN06040 LIBF DISKN IFOUN=0 - GRID FIN06050 DC /0000 DATA SET NOT FIN06060 DC WKIO FOUND FIN06070 MDX *-4 FIN06080 LIBF FLD FIN06090 DC TRAIL FIN06100 LIBF FSUB FIN06110 DC WKIO+2 FIN06120 LD 3 FC FIN06130 BSC L OK,+- FIN06140 LIBF FLD FIN06150 DC WKIO+2 FIN06160 LIBF FSUB FIN06170 DC XNAME FIN06180 LD 3 FC FIN06190 BSC L FND,+- FIN06200 LD L WKIO+6 FIN06210 S L ONE FIN06220 SRT 16 FIN06230 D L THREE FIN06240 A L ONE FIN06250 SLA 2 FIN06260 A L WKIO+1 FIN06270 STO L WKIO+1 FIN06280 S L SCBGN FIN06290 BSC L EROB,& FIN06300 S L SCLGT FIN06310 BSC L EROB,- FIN06320 MDX AGN FIN06330 FND LDD L WKIO+4 TRANSFER HEADER RECORD FIN06340 STD L GRID DATA FROM WKIO TO FIN06350 LD L WKIO+6 STORAGE FIN06360 STO L ICMAX FIN06370 LD L WKIO+7 FIN06380 STO L IRMAX FIN06390 LDD L WKIO+8 FIN06400 STD L XMIN FIN06410 LDD L WKIO+10 FIN06420 STD L YMIN FIN06430 LD L ONE FIN06440 RTRN STO L IFOUN FIN06450 LD L WKIO&1 FIN06460 STO L SCSTR FIN06470 BSC I LOCAT FIN06480 OK SLA 16 FIN06490 MDX RTRN FIN06500 EROB BSI L ERTYP FIN06510 DC MSAG7 NO TRAILER RECORD MESSAGE FIN06520 BSI L ERTYP FIN06530 DC MSAG4 FIN06540 WAIT FIN06550 EXIT FIN06560 ERRS DC 0 DISK ERROR MESSAGE FIN06570 LIBF WRTY0 FIN06580 DC /2000 FIN06590 DC MSAG5 FIN06600 SRA 16 FIN06610 BSC I ERRS FIN06620 *************** FIN06630 * SCCOM SUBROUTINE FIN06640 *************** FIN06650 SCCOM NOP COMPUTE SECTOR ADDRESS FIN06660 LD L THCOL FROM THE COLUMN NUMBER FIN06670 S L ONE AND BEGINNING SECTOR FIN06680 SRT 16 OF DATA SET AREA FIN06690 D L THREE FIN06700 SLT 2 FIN06710 STO L DUMY FIN06720 SLT 14 FIN06730 STO L SCINX FIN06740 A L DUMY FIN06750 A L SCSTR FIN06760 STO L SCLOC FIN06770 LD L FX100 FIN06780 M L SCINX FIN06790 D L ONE FIN06800 A L FX22 FIN06810 STO L ININX FIN06820 BSC I SCCOM FIN06830 *************** FIN06840 * NO ROOM ON DISK MESSAGE FIN06850 *************** FIN06860 ER BSI L ERTYP FIN06870 DC MSAGB FIN06880 BSI L ERTYP FIN06890 DC MSAG4 FIN06900 WAIT FIN06910 EXIT FIN06920 *************** FIN06930 * GRDVA SUBROUTINE FIN06940 *************** FIN06950 GRDVA NOP SUBROUTINE TO FIN06960 BSI L SCCOM READ A COLUMN FIN06970 LD L SCLOC OF GRID VALUES FIN06980 STO L WKIO&1 FROM THE DISK FIN06990 LD L FX640 FIN07000 STO L WKIO FIN07010 LIBF DISKN FIN07020 DC /5000 FIN07030 DC WKIO FIN07040 DC ERRS FIN07050 LIBF DISKN FIN07060 DC /1000 FIN07070 DC WKIO FIN07080 DC ERRS FIN07090 LIBF DISKN FIN07100 DC /0000 FIN07110 DC WKIO FIN07120 MDX *-4 FIN07130 LD L ININX MOVE COLUMN FROM INPUT FIN07140 A L FX218 BUFFER TO COLUMN 4 OF FIN07150 STO L DUMY WORK MATRIX, ZG FIN07160 LDX I1 DUMY FIN07170 LDX I2 FX200 FIN07180 LDD L1 WKIO FIN07190 STD L2 ZA-2 FIN07200 MDX 1 -2 FIN07210 MDX 2 -2 FIN07220 MDX *-7 FIN07230 BSC I GRDVA FIN07240 *************** FIN07250 * WRTOU SUBROUTINE FIN07260 *************** FIN07270 WRTOU NOP WRITE MASTER HEADER RECORD FIN07280 LDX 1 22 FIN07290 LDX 2 20 FIN07300 LDD L ZNIL FIN07310 STD L1 WKIO-2 FIN07320 MDX 1 -2 FIN07330 MDX 2 -2 FIN07340 MDX *-5 FIN07350 LD L FX20 FIN07360 STO L WKIO FIN07370 LD L SCSTR FIN07380 STO L WKIO+1 FIN07390 LDD L CNAME FIN07400 STD L WKIO+2 FIN07410 LDD L GRID FIN07420 STD L WKIO+4 FIN07430 LD L MXCOL FIN07440 STO L WKIO&6 FIN07450 LD L MXROW FIN07460 STO L WKIO&7 FIN07470 LDD L XMIN FIN07480 STD L WKIO+8 FIN07490 LDD L YMIN FIN07500 STD L WKIO+10 FIN07510 LIBF DISKN FIN07520 DC /5000 FIN07530 DC WKIO FIN07540 DC ERRS FIN07550 LIBF DISKN FIN07560 DC /4000 FIN07570 DC WKIO FIN07580 LIBF DISKN FIN07590 DC /0000 FIN07600 DC WKIO FIN07610 MDX *-4 FIN07620 BSC I WRTOU FIN07630 *************** FIN07640 * WRTGR SUBROUTINE FIN07650 *************** FIN07660 WRTGR NOP WRITE A COLUMN OF GRID FIN07670 BSI L SCCOM VALUES ON THE DISK FIN07680 LIBF DISKN FIN07690 DC /0000 FIN07700 DC WKIO FIN07710 MDX *-4 FIN07720 LD L FX640 FIN07730 STO L WKIO FIN07740 LD L SCLOC FIN07750 STO L WKIO+1 FIN07760 LIBF DISKN FIN07770 DC /5000 FIN07780 DC WKIO FIN07790 DC ERRS FIN07800 LIBF DISKN FIN07810 DC /1000 FIN07820 DC WKIO FIN07830 DC ERRS FIN07840 LIBF DISKN FIN07850 DC /0000 FIN07860 DC WKIO FIN07870 MDX *-4 FIN07880 LD L ININX FIN07890 A L FX418 FIN07900 STO L DUMY FIN07910 LDX I1 DUMY FIN07920 LDX I2 FX420 FIN07930 LDD L ZNIL FIN07940 STD L1 WKIO FIN07950 MDX 1 -2 FIN07960 MDX 2 -2 FIN07970 MDX *-5 FIN07980 LD L MXROW SET ZO1 INDEX TO 2*MXROW FIN07990 SLA 1 FIN08000 STO L DUMY FIN08010 LDX I2 DUMY FIN08020 A L ININX SET WKIO INDEX TO FIN08030 A L FX20 ININX+20+2*MXROW-2 FIN08040 S L TWO FIN08050 STO L DUMY FIN08060 LDX I1 DUMY FIN08070 WRT LDD L2 ZO1-2 FIN08080 STD L1 WKIO FIN08090 MDX 1 -2 FIN08100 MDX 2 -2 FIN08110 MDX *-7 FIN08120 LDX I1 ININX FIN08130 LD L KCOLZ FIN08140 STO L1 WKIO FIN08150 LD L ONE FIN08160 STO L1 WKIO+1 FIN08170 LD L MXROW FIN08180 STO L1 WKIO&2 FIN08190 LIBF DISKN FIN08200 DC /4000 FIN08210 DC WKIO FIN08220 LIBF DISKN FIN08230 DC /0000 FIN08240 DC WKIO FIN08250 MDX *-4 FIN08260 BSC I WRTGR FIN08270 *************** FIN08280 * REWRT SUBROUTINE FIN08290 *************** FIN08300 REWRT NOP WRITE THE TRAILER RECORD FIN08310 LIBF DISKN FIN08320 DC /0000 FIN08330 DC WKIO FIN08340 MDX *-4 FIN08350 LD L SCSTT FIN08360 STO L WKIO+1 FIN08370 LD L TWO FIN08380 STO L WKIO FIN08390 LDD L TRAIL FIN08400 STD L WKIO+2 FIN08410 LIBF DISKN FIN08420 DC /5000 FIN08430 DC WKIO FIN08440 DC ERRS FIN08450 LIBF DISKN FIN08460 DC /4000 FIN08470 DC WKIO FIN08480 LIBF DISKN FIN08490 DC /0000 FIN08500 DC WKIO FIN08510 MDX *-4 FIN08520 BSC I REWRT FIN08530 *************** FIN08540 * ERTYP SUBROUTINE FIN08550 *************** FIN08560 ERTYP NOP SUBROUTINE TO FIN08570 LD I ERTYP WRITE MESSAGES FIN08580 STO L ERTX ON THE CONSOLE FIN08590 MDX L ERTYP,&1 TYPEWRITER FIN08600 LD L ERTX FIN08610 S L ONE FIN08620 STO *&1 FIN08630 LD L 0 FIN08640 STO L ERTX+2 FIN08650 M L ONE FIN08660 D L TWO FIN08670 STO L TYPE FIN08680 LIBF EBPRT FIN08690 DC /0000 FIN08700 ERTX DC 0 FIN08710 DC TYPE+1 FIN08720 DC 0 FIN08730 LIBF WRTY0 FIN08740 DC /2000 FIN08750 DC TYPE FIN08760 LIBF WRTY0 FIN08770 DC /2000 FIN08780 DC CONTL FIN08790 LIBF WRTY0 FIN08800 DC /0000 FIN08810 MDX *-3 FIN08820 BSC I ERTYP FIN08830 *************** FIN08840 * DEFINE ERROR MESAGES FIN08850 *************** FIN08860 DC 16 FIN08870 MSAG1 EBC .FINGR BEGINNING . FIN08880 DC 22 FIN08890 MSAG2 EBC .INPUT GRID NAMED . FIN08900 DC /4040 FIN08910 DC /4040 FIN08920 DC 16 FIN08930 MSAG3 EBC .FINGR COMPLETED . FIN08940 DC 30 FIN08950 MSAG4 EBC .PUSH START FOR EXIT TO MONITOR. FIN08960 DC 26 FIN08970 MSAG6 EBC .NAME WAS NOT FOUND ON DISK. FIN08980 DC 30 FIN08990 MSAG7 EBC .UNABLE TO FIND TRAILER RECORD . FIN09000 DC 26 FIN09010 MSAG8 EBC .NAME ALREADY USED ON DISK . FIN09020 DC 28 FIN09030 MSAG9 EBC .GRID TOO LARGE TO BE REDUCED. FIN09040 DC 22 FIN09050 MSAGA EBC .OUTPUT GRID NAMED . FIN09060 DC /4040 FIN09070 DC /4040 FIN09080 DC 54 FIN09090 MSAGB EBC .REQUIRED NUMBER OF COLUMNS. FIN09100 EBC .EXCEEDS AVAILABLE DISK AREA . FIN09110 MSAG5 DC 20 DISK ERROR TERMINATE FIN09120 DC /3020 JOB AND RESTART FIN09130 DC /9858 FIN09140 DC /2135 FIN09150 DC /6060 FIN09160 DC /5060 FIN09170 DC /2121 FIN09180 DC /9C34 FIN09190 DC /6070 FIN09200 DC /2074 FIN09210 DC /3C9C FIN09220 DC /3421 FIN09230 DC /7C50 FIN09240 DC /1821 FIN09250 DC /3C74 FIN09260 DC /3021 FIN09270 DC /6034 FIN09280 DC /989C FIN09290 DC /3C60 FIN09300 DC /9C21 FIN09310 DC /8103 FIN09320 CONTL DC 1 FIN09330 DC /8103 FIN09340 *************** FIN09350 * DEFINE CONSTANTS FIN09360 *************** FIN09370 SCBGN DC 448 FIN09380 SCLGT DC 808 FIN09390 ONE DC 1 FIN09400 TWO DC 2 FIN09410 THREE DC 3 FIN09420 FOUR DC 4 FIN09430 FX9 DC 9 FIN09440 FX20 DC 20 FIN09450 FX22 DC 22 FIN09460 FX100 DC 100 FIN09470 FX200 DC 200 FIN09480 FX218 DC 218 FIN09490 FX402 DC 402 FIN09500 FX418 DC 418 FIN09510 FX420 DC 420 FIN09520 FX640 DC 640 FIN09530 FHALF DEC 0.5 FIN09540 ZNIL DEC -1.0E30 FIN09550 TRAIL DEC 9999. FIN09560 FNINE DEC 9.0 FIN09570 FFRTH DEC 0.25 FIN09580 FSIXH DEC .0625 FIN09590 *************** FIN09600 * ALLOCATE STORAGE FIN09610 *************** FIN09620 IPTCL BSS 1 INPUT COLUMN COUNT FIN09630 ICMAX BSS 1 MAXIMUM COLS, INPUT GRID FIN09640 IRMAX BSS 1 MAXIMUM ROWS, INPUT GRID FIN09650 I BSS 1 INPUT COLUMN SELECTED FIN09660 J BSS 1 INPUT ROW SELECTED FIN09670 L BSS 1 SET TO 100 FIN09680 K1 BSS 1 INDICES USED TO LOCATE FIN09690 K2 BSS 1 GRID VALUES FIN09700 I1 BSS 1 FIN09710 I2 BSS 1 FIN09720 I3 BSS 1 FIN09730 I4 BSS 1 FIN09740 I5 BSS 1 FIN09750 I7 BSS 1 FIN09760 I8 BSS 1 FIN09770 ZD1 BSS E 2 STORAGE USED FOR FIN09780 ZD2 BSS E 2 INTERPOLATION FIN09790 Z1 BSS E 2 FIN09800 Z2 BSS E 2 FIN09810 Z3 BSS E 2 FIN09820 Z4 BSS E 2 FIN09830 Z5 BSS E 2 FIN09840 Z6 BSS E 2 FIN09850 Z7 BSS E 2 FIN09860 Z8 BSS E 2 FIN09870 ZO1 BSS E 402 FIRST OUTPUT COLUMN FIN09880 ZO2 BSS E 402 SECOND OUTPUT COLUMN FIN09890 ZG BSS E 802 INPUT GRID MATRIX FIN09900 ANAME BSS E 2 INPUT GRID NAME FIN09910 CNAME BSS E 2 OUTPUT GRID NAME FIN09920 XNAME BSS E 2 NAME USED BY LOCAT FIN09930 DUMY BSS E 2 TEMPORARY STORAGE FIN09940 GRID BSS E 2 GRID INTERVAL FIN09950 IFOUN BSS 1 FLAG STORED BY LOCAT FIN09960 ININX BSS 1 INITIAL ADDRESS OF COLUMN FIN09970 KCOLZ BSS 1 OUTPUT COLUMN NO. FIN09980 MXCOL BSS 1 MAXIMUM COLS, OUTPUT GRID FIN09990 MXROW BSS 1 MAXIMUM ROWS, OUTPUT GRID FIN10000 SCLOC BSS 1 COLUMN DISK SECTOR ADDRESS FIN10010 SCINX BSS 1 MULTIPLIER TO COMPUTE ININXFIN10020 SCSTA BSS 1 INPUT GRID SECTOR ADDRESS FIN10030 SCSTC BSS 1 OUTPUT GRID SECTOR ADDRESS FIN10040 SCSTR BSS 1 SECTOR ADDRESS USED BY FIN10050 * LOCAT SUBROUTINE FIN10060 SCSTT BSS 1 TRAILER RECORD SECTOR ADDR FIN10070 THCOL BSS 1 COLUMN NUMBER USED BY FIN10080 * GRDVA AND WRTGR FIN10090 XMIN BSS E 2 MINIMUM VALUE OF X FIN10100 YMIN BSS E 2 MINIMUM VALUE OF Y FIN10110 WKIO BSS E 642 IO BUFFER FOR DISK FIN10120 TYPE BSS 30 OUTPUT BUFFER FOR MESSAGES FIN10130 ZG2 EQU ZG+200 COLUMN 2 OF ZG FIN10140 ZG3 EQU ZG+400 COLUMN 3 OF ZG FIN10150 ZA EQU ZG+600 CCOLUMN 4 OF ZG FIN10160 END GO FIN10170 // DUP FIN10180 *STORE WS UA FINGR FIN10190 // JOB COM00010 // DUP COM00020 *DELETE COMPR COM00030 // ASM COM00040 *************** COM00060 * PROGRAM TO LIST GRID NAMES FROM DISK COM00070 * OR TO SELECTIVELY DELETE A GRID SET COM00080 *************** COM00090 FC EQU 126 COM00100 GO LIBF WRTY0 SPACE TYPEWRITER COM00110 DC /2000 COM00120 DC CONTL COM00130 BSI L NAME READ NAME CARD COM00140 LD L BNAME+9 TEST FOR LIST OPTION COM00150 BSC L LST,Z YES - GO TO LST COM00160 BSI L ERTYP TYPE BEGINNING COM00170 DC MSAG5 MESSAGE IF A GRID COM00180 LD L ANAME SET IS TO BE COM00190 STO L MSAG6+6 DELETED FROM THE COM00200 LD L ANAME+1 DISK DATA AREA COM00210 STO L MSAG6+7 COM00220 BSI L ERTYP COM00230 DC MSAG6 COM00240 BSI L LOCAT SEARCH THE DISK COM00250 LD L IFOUN DATA AREA FOR THE COM00260 BSC L OKK,Z GRID SET TO BE COM00270 BSI L ERTYP DELETED COM00280 DC MSAGB COM00290 BSI L ERTYP TYPE ERROR MESSAGE COM00300 DC MSAGA IF THE NAME CAN COM00310 WAIT NOT BE FOUND COM00320 EXIT COM00330 OKK LD L WKIO+1 SAVE SECTOR ADDRESS COM00340 STO L WKIOX OF DELETE DATA SET COM00350 LD L WKIO+6 COMPUTE SECTOR ADDRESS COM00360 S L ONE OF MASTER HEADER COM00370 SRT 16 RECORD OF NEXT DATA COM00380 D L THREE SET FROM MAXIMUM COM00390 A L ONE COLUMN NUMBER COM00400 SLA 2 COM00410 STO L SCINC COM00420 A L WKIO+1 COM00430 STO L WKIO+1 COM00440 AB4 LD L F1280 INITIALIZE THE COM00450 STO L WKIO DISK OUTPUT AREA COM00460 LIBF DISKN COM00470 DC /5000 COM00480 DC WKIO COM00490 DC ERRS COM00500 LIBF DISKN READ IN THE FOLLOWING COM00510 DC /1000 GRID SETS FOUR COM00520 DC WKIO SECTORS AT A TIME COM00530 DC ERRS COM00540 LIBF DISKN COM00550 DC /0000 COM00560 DC WKIO COM00570 MDX *-4 COM00580 LD L WKIOX COM00590 STO L WKIO+1 COM00600 S L SCBGN COM00610 S L SCLGT COM00620 BSC L TEST,- COM00630 MDX L WKIOX,4 COM00640 LIBF DISKN COM00650 DC /5000 COM00660 DC WKIO COM00670 DC ERRS COM00680 LIBF DISKN WRITE OUT THE COM00690 DC /4000 GRID SETS INTO COM00700 DC WKIO THEIR NEW COM00710 LIBF DISKN LOCATIONS FOUR COM00720 DC /0000 SECTORS AT A TIME COM00730 DC WKIO COM00740 MDX *-4 COM00750 LD L WKIOX COM00760 A L SCINC COM00770 STO L WKIO+1 COM00780 LDD L TRAIL TEST FOR TRAILER RECORD COM00790 SD L WKIO+2 COM00800 LDX 1 32 COM00810 SLC 1 0 COM00820 BSC L AB4,C IF NO TRAILER, GO TO AB4 COM00830 LDX 1 4 IF TRAILER, ZERO TRAILER COM00840 ZLOOP STD L1 WKIO LEFT IN DATA SET AREA COM00850 MDX 1 -2 COM00860 MDX ZLOOP COM00870 MDX L WKIO+1,-4 COM00880 LD L FOUR WRITE ZEROES ON DISK COM00890 STO L WKIO COM00900 LIBF DISKN COM00910 DC /5000 COM00920 DC WKIO COM00930 DC ERRS COM00940 LIBF DISKN COM00950 DC /4000 COM00960 DC WKIO COM00970 LIBF DISKN COM00980 DC /0000 COM00990 DC WKIO COM01000 MDX *-4 COM01010 MDX *-4 COM01020 TEST BSI L ERTYP TYPE COMPLETION COM01030 DC MSAG9 MESSAGE COM01040 EXIT COM01050 LST LD L SCBGN COM01060 STO L WKIO+1 COM01070 BSI L ERTYP TYPE BEGINNING MESSAGE COM01080 DC MSAG1 FOR THE LIST OF COM01090 BSI L ERTYP GRID SETS IN COM01100 DC MSAG8 THE DISK DATA AREA COM01110 AGNL LD L FX20 COM01120 STO L WKIO COM01130 LIBF DISKN COM01140 DC /5000 COM01150 DC WKIO COM01160 DC ERRS COM01170 LIBF DISKN READ IN THE COM01180 DC /1000 HEADER RECORD COM01190 DC WKIO FOR EACH GRID SET COM01200 DC ERRS COM01210 LIBF DISKN COM01220 DC /0000 COM01230 DC WKIO COM01240 MDX *-4 COM01250 LD L WKIO+1 CONVERT THE SECTOR COM01260 LIBF BINDC NUMBER TO EBCDIC COM01270 DC OUTPT COM01280 LIBF SPEED COM01290 DC /0000 COM01300 DC OUTPT+2 COM01310 DC OUTA+1 COM01320 DC 4 COM01330 LIBF FLD CHECK TO SEE IF COM01340 DC TRAIL THE TRAILER RECORD COM01350 LIBF FSUB HAS BEEN REACHED COM01360 DC WKIO+2 COM01370 LIBF FSTO COM01380 DC DUMY COM01390 LD L DUMY COM01400 BSC L OKL,+- COM01410 LD L WKIO+2 CONVERT THE GRID COM01420 STO L OUTA+5 NAME TO EBCDIC COM01430 LD L WKIO+3 COM01440 STO L OUTA+6 COM01450 LD L WKIO+6 CONVERT THE COM01460 LIBF BINDC MAXIMUM COLUMN COM01470 DC OUTPT NUMBER TO EBCDIC COM01480 LIBF SPEED COM01490 DC /0000 COM01500 DC OUTPT+3 COM01510 DC OUTA+12 COM01520 DC 3 COM01530 LIBF FLD CONVERT THE GRID COM01540 DC WKIO+4 INTERVAL TO COM01550 LIBF FADD EBCDIC AFTER IT COM01560 DC ROUND HAS BEEN ROUNDED OFF COM01570 CALL FBTD COM01580 DC OUTA+18 COM01590 LD L OUTA+19 COM01600 SLA 8 PACK THE EBCDIC COM01610 OR L OUTA+20 CHARACTERS COM01620 STO L OUTA+19 COM01630 LD L OUTA+21 COM01640 SLA 8 COM01650 OR L OUTA+22 COM01660 STO L OUTA+20 COM01670 LD L OUTA+23 COM01680 SLA 8 COM01690 OR L OUTA+24 COM01700 STO L OUTA+21 COM01710 LD L OUTA+25 COM01720 SLA 8 COM01730 OR L OUTA+29 COM01740 STO L OUTA+22 COM01750 LD L OUTA+30 COM01760 SLA 8 COM01770 OR L OUTA+31 COM01780 STO L OUTA+23 COM01790 LD L OUTA+32 COM01800 SLA 8 COM01810 OR L OUTA+33 COM01820 STO L OUTA+24 COM01830 LIBF EBPRT CONVERT THE EBCDIC COM01840 DC /0000 CHARACTERS TO COM01850 DC OUTA ROTATE TILT CODE COM01860 DC OUTA FOR THE CONSOLE COM01870 DC 50 TYPEWRITER COM01880 LIBF WRTY0 TYPE OUT THE LINE COM01890 DC /2000 OF INFORMATION FOR COM01900 DC OUTA-1 EACH GRID SET COM01910 LIBF WRTY0 COM01920 DC /2000 COM01930 DC CONTL COM01940 LIBF WRTY0 COM01950 DC /0000 COM01960 MDX *-3 COM01970 LD L WKIO+6 COMPUTE THE COM01980 S L ONE SECTOR ADDRESS OF COM01990 SRT 16 NEXT MASTER HEADER COM02000 D L THREE RECORD COM02010 A L ONE COM02020 SLA 2 COM02030 A L WKIO+1 COM02040 STO L WKIO+1 COM02050 S L SCBGN COM02060 BSC L EROB,+ COM02070 S L SCLGT COM02080 BSC L EROB,- COM02090 BSC L AGNL COM02100 OKL LD L OUTA+1 TYPE OUT THE COM02110 STO L MSAG7+2 SECTOR NUMBER COM02120 LD L OUTA+2 AT WHICH THE COM02130 STO L MSAG7+3 TRAILER RECORD COM02140 LIBF EBPRT WAS FOUND COM02150 DC /0000 COM02160 DC MSAG7+1 COM02170 DC MSAG7+1 COM02180 DC 24 COM02190 LIBF WRTY0 COM02200 DC /2000 COM02210 DC MSAG7 COM02220 LIBF WRTY0 COM02230 DC /2000 COM02240 DC CONTL COM02250 LIBF WRTY0 COM02260 DC /0000 COM02270 MDX *-3 COM02280 LD L F1240 COMPUTE THE COM02290 S L WKIO+1 NUMBER OF COLUMNS COM02300 M L THREE FOR WHICH THERE COM02310 D L FOUR IS ROOM COM02320 LIBF BINDC AVAILABLE ON COM02330 DC OUTPT THE DISK COM02340 LIBF SPEED COM02350 DC /0000 COM02360 DC OUTPT+3 COM02370 DC MSG4 COM02380 DC 3 COM02390 BSI L ERTYP TYPE OUT THE COM02400 DC MSAG3 MESSAGE WITH ROOM COM02410 BSI L ERTYP AVAILABLE AND THEN COM02420 DC MSAG2 TYPE THE COMPLETION COM02430 EXIT MESSAGE COM02440 *************** COM02450 * NAME SUBROUTINE COM02460 *************** COM02470 NAME NOP SUBROUTINE TO COM02480 LD L TEN READ THE CONTROL COM02490 STO L BNAME-1 CARD WHICH COM02500 *************** COM02509 LIBF CARD0 SPECIFIES EITHER COM02510 * LIBF READ0 SPECIFIES EITHER COM02511 *************** COM02512 DC /1000 THE LIST OPTION COM02520 DC BNAME-1 OR THE NAME OF A COM02530 *************** COM02538 LIBF CARD0 GRID SET TO BE COM02539 * LIBF READ0 GRID SET TO BE COM02540 *************** COM02541 DC /0000 DELETED FROM THE COM02550 MDX *-3 DISK DATA AREA COM02560 LIBF SPEED COM02570 DC /0000 COM02580 DC BNAME COM02590 DC ANAME COM02600 DC 4 COM02610 BSC I NAME COM02620 *************** COM02630 * LOCAT SUBROUTINE COM02640 *************** COM02650 LOCAT NOP SUBROUTINE TO COM02660 LD L FX20 LOCATE THE NAME OF COM02670 STO L WKIO THE GRID SET IN THE COM02680 LD L SCBGN DISK DATA AREA COM02690 STO L WKIO+1 INPUT - ANAME COM02700 AGN LIBF DISKN OUTPUT - SECTOR ADDRESSCOM02710 DC /5000 SCSTR COM02720 DC WKIO IFOUN=1 - DATA SET COM02730 DC ERRS FOUND COM02740 LIBF DISKN IFOUN=0 - DATA SET COM02750 DC /1000 NOT FOUND COM02760 DC WKIO COM02770 DC ERRS COM02780 LIBF DISKN COM02790 DC /0000 COM02800 DC WKIO COM02810 MDX *-4 COM02820 LIBF FLD COM02830 DC TRAIL COM02840 LIBF FSUB COM02850 DC WKIO+2 COM02860 LD 3 FC COM02870 BSC L OK,+- COM02880 LIBF FLD COM02890 DC WKIO+2 COM02900 LIBF FSUB COM02910 DC ANAME COM02920 LD 3 FC COM02930 BSC L FND,+- COM02940 LD L WKIO+6 COM02950 S L ONE CALCULATE LOCATION OF COM02960 SRT 16 NEXT MASTER HEADER COM02970 D L THREE RECORD COM02980 A L ONE COM02990 SLA 2 COM03000 A L WKIO+1 COM03010 STO L WKIO+1 COM03020 S L SCBGN COM03030 BSC L EROB,& COM03040 S L SCLGT COM03050 BSC L EROB,- COM03060 MDX AGN COM03070 FND LD L ONE COM03080 FND1 STO L IFOUN SET IFOUN TO 1 COM03090 LD L WKIO&1 COM03100 STO L SCSTR COM03110 BSC I LOCAT COM03120 OK SLA 16 SET IFOUN TO 0 COM03130 MDX FND1 COM03140 EROB BSI L ERTYP COM03150 DC MSAGC COM03160 BSI L ERTYP COM03170 DC MSAGA COM03180 WAIT COM03190 EXIT COM03200 ERRS NOP COM03210 LIBF WRTY0 COM03220 DC /2000 COM03230 DC MSAGD COM03240 SRA 16 COM03250 BSC I ERRS COM03260 *************** COM03270 * ERTYP SUBROUTINE COM03280 *************** COM03290 ERTYP NOP SUBROUTINE TO COM03300 LD I ERTYP WRITE MESSAGES COM03310 STO L ERTX ON THE CONSOLE COM03320 MDX L ERTYP,&1 TYPEWRITER COM03330 LD L ERTX COM03340 S L ONE COM03350 STO *&1 COM03360 LD L 0 COM03370 STO L ERTX+2 COM03380 SRA 1 COM03390 STO L TYPE COM03400 LIBF EBPRT COM03410 DC /0000 COM03420 ERTX DC 0 COM03430 DC TYPE+1 COM03440 DC 0 COM03450 LIBF WRTY0 COM03460 DC /2000 COM03470 DC TYPE COM03480 LIBF WRTY0 COM03490 DC /2000 COM03500 DC CONTL COM03510 LIBF WRTY0 COM03520 DC /0000 COM03530 MDX *-3 COM03540 BSC I ERTYP COM03550 *************** COM03560 * DEFINE MESSAGES COM03570 *************** COM03580 DC 28 COM03590 MSAG1 EBC .LIST OF GRID NAMES FROM DISK. COM03600 DC 14 COM03610 MSAG2 EBC .LIST COMPLETED. COM03620 DC 40 COM03630 MSAG3 EBC .DISK AREA AVAILABLE FOR . COM03640 MSG4 EBC . MORE COLUMNS. COM03650 DC 28 COM03660 MSAG5 EBC .PROGRAM BEGINNING TO DELETE . COM03670 DC 16 COM03680 MSAG6 EBC .GRID NAMED . COM03690 DC /4040 COM03700 DC /4040 COM03710 MSAG7 DC 12 COM03720 EBC . TRAILER RECORD. COM03730 DC 50 COM03740 MSAG8 EBC . SECTOR NAME NUMBER OF COLUMNS. COM03750 EBC . GRID INTERVAL. COM03760 DC 22 COM03770 MSAG9 EBC .DELETION IS COMPLETED . COM03780 DC 30 COM03790 MSAGA EBC .PUSH START FOR EXIT TO MONITOR. COM03800 DC 22 COM03810 MSAGB EBC .NAME NOT FOUND ON DISK. COM03820 DC 30 COM03830 MSAGC EBC .UNABLE TO FIND TRAILER RECORD . COM03840 MSAGD DC 20 DISK ERROR MESSAGE COM03850 DC /3020 COM03860 DC /9858 COM03870 DC /2135 COM03880 DC /6060 COM03890 DC /5060 COM03900 DC /2121 COM03910 DC /9C34 COM03920 DC /6070 COM03930 DC /2074 COM03940 DC /3C9C COM03950 DC /3421 COM03960 DC /7C50 COM03970 DC /1821 COM03980 DC /3C74 COM03990 DC /3021 COM04000 DC /6034 COM04010 DC /989C COM04020 DC /3C60 COM04030 DC /9C21 COM04040 DC /8103 COM04050 CONTL DC 1 COM04060 DC /8103 COM04070 *************** COM04080 * DEFINE CONSTANTS COM04090 *************** COM04100 SCBGN DC 448 COM04110 SCLGT DC 808 COM04120 ZERO DC 0 COM04130 ONE DC 1 COM04140 TWO DC 2 COM04150 THREE DC 3 COM04160 FOUR DC 4 COM04170 TEN DC 10 COM04180 FX20 DC 20 COM04190 F1240 DC 1248 COM04200 F1280 DC 1280 COM04210 NINES DC /F9F9 COM04220 ROUND DEC 5.E-6 COM04230 TRAIL DEC 9999. COM04240 OUTB DC 25 COM04250 OUTA DC /4040 BLANK CODE FOR CONSOLE COM04260 DC /4040 PRINTER OUTPUT AREA COM04270 DC /4040 COM04280 DC /4040 COM04290 DC /4040 COM04300 DC /4040 COM04310 DC /4040 COM04320 DC /4040 COM04330 DC /4040 COM04340 DC /4040 COM04350 DC /4040 COM04360 DC /4040 COM04370 DC /4040 COM04380 DC /4040 COM04390 DC /4040 COM04400 DC /4040 COM04410 DC /4040 COM04420 DC /4040 COM04430 DC /4040 COM04440 DC /4040 COM04450 DC /4040 COM04460 DC /4040 COM04470 DC /4040 COM04480 DC /4040 COM04490 DC /4040 COM04500 DC /0040 COM04510 DC /0040 COM04520 DC /0040 COM04530 DC /0040 COM04540 DC /0040 COM04550 DC /0040 COM04560 DC /0040 COM04570 DC /0040 COM04580 DC /0040 COM04590 *************** COM04600 * ALLOCATE STORAGE COM04610 *************** COM04620 ANAME BSS E 2 DATA SET NAME COM04630 BSS E 2 COM04640 BNAME BSS E 10 CARD INPUT BUFFER COM04650 WKIOX BSS 1 SAVE SECTOR ADDRESS COM04660 IFOUN BSS 1 LOCAT SUBROUT. FLAG COM04670 SCSTR BSS 1 SECTOR ADDRESS COM04680 SCINC BSS 1 SECTOR ADDRESS INCREMENT COM04690 DUMY BSS E 2 TEMPOARY STORAGE COM04700 OUTPT BSS E 6 CONVERSION - NOS. TO EBCDICCOM04710 WKIO BSS E 1282 DISK OUTPUT AREA COM04720 TYPE BSS 30 MESSAGE OUTPUT AREA COM04730 END GO COM04740 // DUP COM04750 *STORE WS UA COMPR COM04760 // JOB SMO00010 // DUP SMO00020 *DELETE UA SMOTH SMO00030 // ASM SMO00040 *LIST SMO00050 *************** SMO00060 * ROUTINE TO SMOOTH GRID VALUES WITH SMO00070 * A SPECIFIED SMOOTHING OPERATOR SMO00080 *************** SMO00090 SM100 LD L FX100 INITIALIZE SMO00100 STO L L COLUMN LENGTH SMO00110 LIBF WRTY0 SMO00120 DC /2000 SMO00130 DC CONTL SMO00140 BSI L ERTYP TYPE BEGINNING SMO00150 DC MSAG1 MESSAGE SMO00160 LD L ZERO SMO00170 STO L IPTCL SMO00180 BSI L HEADS READ HEADER CARDS SMO00190 LD L ANAME SMO00200 STO L MSAG2+9 SMO00210 LD L ANAME+1 SMO00220 STO L MSAG2+10 SMO00230 BSI L ERTYP TYPE NAME OF SMO00240 DC MSAG2 INPUT GRID SMO00250 LDD L ANAME SMO00260 STD L XNAME SMO00270 BSI L LOCAT LOCATE INPUT GRID SMO00280 LD L SCSTR IN DISK DATA AREA SMO00290 STO L SCSTA SMO00300 LD L IFOUN TYPE ERROR MESSAGE SMO00310 BSC L OKA,Z IF INPUT NAME CANNOT SMO00320 BSI L ERTYP BE FOUND ON THE SMO00330 DC MSAG6 DISK SMO00340 BSI L ERTYP SMO00350 DC MSAG4 SMO00360 MDX OUT SMO00370 OKA LDD L CNAME SMO00380 STD L XNAME SMO00390 LD L CNAME SMO00400 STO L MSAGA+9 SMO00410 LD L CNAME+1 SMO00420 STO L MSAGA+10 SMO00430 BSI L ERTYP TYPE NAME OF SMO00440 DC MSAGA OUTPUT GRID SMO00450 BSI L LOCAT LOCATE TRAILER SMO00460 LD L SCSTR RECORD AND CHECK FOR SMO00470 STO L SCSTC OUTPUT NAME IN DISK SMO00480 LD L IFOUN DATA AREA SMO00490 BSC L OKB,+- SMO00500 BSI L ERTYP TYPE ERROR MESSAGE SMO00510 DC MSAG8 IF OUTPUT NAME HAS SMO00520 BSI L ERTYP ALREADY BEEN USED SMO00530 DC MSAG4 ON THE DISK SMO00540 OUT WAIT SMO00550 EXIT SMO00560 OKB LD L ISM SMO00570 BSC L OKC,Z- SMO00580 OKX BSI L ERTYP TYPE ERROR MESSAGE SMO00590 DC MSAG9 IF THE ORDER OF SMO00600 BSI L ERTYP SMOOTHING IS NOT SMO00610 DC MSAG4 GREATER THAN ZERO SMO00620 MDX OUT BUT LESS THAN FIVE SMO00630 OKC BSI L WRTOU WRITE HEADER RECORD SMO00640 BSI L REWRT WRITE TRAILER RECORD SMO00650 LD L ISM SMO00660 S L FOUR SMO00670 BSC L OKX,Z- SMO00680 SM102 LD L ISM COMPUTE SQUARE OF SMO00690 M L ISM ORDER OF SMOOTHING SMO00700 D L ONE TO USE AS SQUARE SMO00710 LIBF FLOAT OF DISTANCE IN SMO00720 LIBF FSTO SELECTING SMO00730 DC RSQ SURROUNDING SMO00740 LD L ISM POINTS SMO00750 M L FX200 COMPUTE INDEXING SMO00760 D L ONE VALUES FROM SMO00770 STO L LINX ORDER OF SMO00780 LD L ISM SMOOTHING SMO00790 A L ONE SMO00800 M L FX100 SMO00810 D L ONE SMO00820 STO L MINX SMO00830 LD L ZERO INITIALIZE COLUMN SMO00840 STO L I NUMBER SMO00850 SM777 LD L I INPUT THE FIRST ISM SMO00860 A L ONE COLUMNS TO THE ARRAY SMO00870 STO L I IN STORAGE SMO00880 S L ONE SMO00890 M L FX100 SMO00900 D L ONE SMO00910 A L MINX SMO00920 STO L KJ SMO00930 LD L SCSTA SMO00940 STO L SCSTR SMO00950 MDX L IPTCL,1 SMO00960 LD L IPTCL SMO00970 STO L THCOL SMO00980 BSI L GRDVA SMO00990 LD L ZERO SMO01000 STO L J SMO01010 SM778 LD L J SMO01020 A L ONE SMO01030 STO L J SMO01040 A L KJ SMO01050 STO L K SMO01060 LDX I1 J TRANSFER THE SMO01070 MDX I1 J COLUMN OF VALUES SMO01080 LDD L1 ZA-2 JUST READ IN FROM SMO01090 LDX I1 K THE BUFFER AREA SMO01100 MDX I1 K TO THE PROPER SMO01110 STD L1 ZG-2 POSITION IN SMO01120 LD L IRMAX THE ARRAY SMO01130 S L J SMO01140 BSC L SM778,Z- SMO01150 LD L ISM RETURN TO SM777 SMO01160 S L I UNTIL ISM SMO01170 BSC L SM777,Z- COLUMNS HAVE BEEN SMO01180 LD L ZERO READ INTO THE ARRAY SMO01190 STO L I SMO01200 SM779 LD L I SMO01210 A L ONE SMO01220 STO L I SMO01230 LDX I1 I FILL THE REMAINDER SMO01240 MDX I1 I OF THE ARRAY SMO01250 LDD L ZNIL WITH ZNIL VALUES SMO01260 STD L1 ZG-2 SMO01270 LD L I SMO01280 S L MINX SMO01290 BSC L SM779,Z+ SMO01300 LD L ZERO SMO01310 STO L I SMO01320 SM151 LD L I SELECT A COLUMN FROM SMO01330 A L ONE THE ARRAY SMO01340 STO L I SMO01350 LD L ZERO SMO01360 STO L K SMO01370 SM780 LD L K SHIFT THE COLUMNS SMO01380 A L ONE IN THE ARRAY SMO01390 STO L K BY ONE LOCATION SMO01400 LDX I1 K TO THE LEFT SMO01410 MDX I1 K SMO01420 LDD L1 ZG+198 SMO01430 STD L1 ZG-2 SMO01440 LD L K SMO01450 S L LINX SMO01460 BSC L SM780,Z+ SMO01470 LD L ISM DETERMINE THE SMO01480 A L TWO BEGINNING COLUMN SMO01490 S L I WITHIN A DISTANCE SMO01500 STO L IBGN ISM OF THE SMO01510 BSC L SM402,Z- SELECTED COLUMN SMO01520 SM401 LD L ONE SMO01530 STO L IBGN SMO01540 SM402 LD L I SMO01550 A L ISM SMO01560 S L ICMAX SMO01570 STO L IDUM SMO01580 BSC L SM783,Z- SMO01590 SM781 LD L ISM DETERMINE THE ENDING SMO01600 M L TWO COLUMN WITHIN A SMO01610 D L ONE DISTANCE ISM OF THE SMO01620 A L ONE SELECTED COLUMN SMO01630 STO L IEND SMO01640 LD L SCSTA SMO01650 STO L SCSTR SMO01660 MDX L IPTCL,1 SMO01670 LD L IPTCL SMO01680 STO L THCOL SMO01690 BSI L GRDVA INPUT THE SMO01700 LD L ZERO NEXT COLUMN SMO01710 STO L K TO THE BUFFER SMO01720 SM782 LD L K STORAGE AREA SMO01730 A L ONE SMO01740 STO L K SMO01750 LD L K SMO01760 A L LINX SMO01770 STO L KK SMO01780 LDX I1 KK MOVE THE COLUMN SMO01790 MDX I1 KK FROM THE BUFFER SMO01800 LDX I2 K AREA TO THE SMO01810 MDX I2 K PROPER POSITION SMO01820 LDD L2 ZA-2 IN THE ARRAY SMO01830 STD L1 ZG-2 SMO01840 LD L K SMO01850 S L IRMAX SMO01860 BSC L SM782,Z+ SMO01870 BSC L SM403 SMO01880 SM783 LD L ISM SMO01890 M L TWO SMO01900 D L ONE SMO01910 A L ONE SMO01920 S L IDUM SMO01930 STO L IEND SMO01940 SM403 LD L ISM SMO01950 M L FX100 SMO01960 D L ONE SMO01970 STO L I1 SMO01980 LD L ZERO SMO01990 STO L J SMO02000 SM150 LD L J SELECT A ROW FROM SMO02010 A L ONE THE ARRAY SMO02020 STO L J SMO02030 LD L ISM DETERMINE THE SMO02040 S L J BEGINNING ROW SMO02050 A L TWO WITHIN A DISTANCE SMO02060 STO L JBGN ISM OF THE SMO02070 BSC L SM405,Z- SELECTED ROW SMO02080 SM404 LD L ONE SMO02090 STO L JBGN SMO02100 SM405 LD L J SMO02110 A L ISM SMO02120 S L IRMAX SMO02130 STO L IDUM SMO02140 LD L ISM DETERMINE THE ENDING SMO02150 M L TWO ROW WITHIN THE SMO02160 D L ONE DISTANCE ISM OF SMO02170 A L ONE THE SELECTED ROW SMO02180 STO L JEND SMO02190 LD L IDUM SMO02200 BSC L SM407,+ SMO02210 SM406 LD L JEND SMO02220 S L IDUM SMO02230 STO L JEND SMO02240 SM407 LD L J CALCULATE I2 SMO02250 A L I1 WHICH GIVES THE SMO02260 STO L I2 LOCATION IN THE SMO02270 LDX I1 I2 ARRAY OF THE POINT SMO02280 MDX I1 I2 TO BE SMOOTHED SMO02290 LIBF FLDX SMO02300 DC ZG-2 SMO02310 LDX I1 J SMO02320 MDX I1 J SMO02330 LIBF FSTOX STORE THE SMO02340 DC ZGG-2 UNSMOOTHED POINT SMO02350 LIBF FSUB IN THE OUTPUT ARRAY SMO02360 DC ZNIL SMO02370 LIBF FSTO CHECK TO SEE IF SMO02380 DC RESUL THE POINT IS A ZNIL SMO02390 LD L RESUL AND IGNORE IT SMO02400 BSC L SMM50,+- IF IT IS SMO02410 SM1 LDD L FZERO INITIALIZE THE SMO02420 STD L SN VARIOUS SMO02430 STD L SX ACCUMULATORS SMO02440 STD L SY SMO02450 STD L SX2 SMO02460 STD L SXY SMO02470 STD L SY2 SMO02480 STD L SZ SMO02490 STD L SXZ SMO02500 STD L SYZ SMO02510 LD L L CALCULATE IZ WHICH SMO02520 M L ISM LOCATES THE BOTTOM SMO02530 D L ONE LEFT CORNER OF THE SMO02540 A L ISM AREA OF INFLUENCE SMO02550 A L L SURROUNDING THE SMO02560 A L ONE GIVEN POINT SMO02570 STO L IZ SMO02580 LD L I2 SMO02590 S L IZ SMO02600 STO L IZ SMO02610 LD L IBGN SMO02620 S L ONE SMO02630 STO L II SMO02640 SM5 LD L II SELECT A COLUMN OF SMO02650 A L ONE SURROUNDING POINTS SMO02660 STO L II SMO02670 M L L SMO02680 D L ONE SMO02690 A L IZ SMO02700 STO L I3 SMO02710 LD L II COMPUTA THE VALUE SMO02720 S L ISM OF THE X-COORDINATE SMO02730 S L ONE OF THE SURROUNDING SMO02740 LIBF FLOAT POINT SMO02750 LIBF FSTO SMO02760 DC X SMO02770 LD L JBGN SMO02780 S L ONE SMO02790 STO L JJ SMO02800 SM4 LD L JJ SELECT A ROW OF SMO02810 A L ONE SURROUNDING POINTS SMO02820 STO L JJ SMO02830 A L I3 SMO02840 STO L I4 SMO02850 LD L JJ COMPUTE THE VALUE SMO02860 S L ISM OF THE Y-COORDINATE SMO02870 S L ONE OF THE SURROUNDING SMO02880 LIBF FLOAT POINT SMO02890 LIBF FSTO SMO02900 DC Y SMO02910 LIBF FMPY SMO02920 DC Y SMO02930 LIBF FSTO COMPUTE THE SQUARE SMO02940 DC YSQ OF THE DISTANCE SMO02950 LIBF FLD BETWEEN THE GIVEN SMO02960 DC X POINT AND THE SMO02970 LIBF FMPY SURROUNDING POINT SMO02980 DC X SMO02990 LIBF FSTO SMO03000 DC XSQ SMO03010 LIBF FADD SMO03020 DC YSQ SMO03030 LIBF FSUB IS THE POINT WITHIN SMO03040 DC RSQ THE SPECIFIED RADIUS SMO03050 LIBF FSTO IGNORE THE POINT SMO03060 DC RESUL IF IT IS NOT SMO03070 LD L RESUL SMO03080 BSC L SMM4,Z- SMO03090 SM2 LDX I1 I4 SMO03100 MDX I1 I4 SMO03110 LDD L1 ZG-2 STORE THE VALUE OF SMO03120 STD L Z THE SURROUNDING SMO03130 LIBF FLD POINT IN Z SMO03140 DC Z SMO03150 LIBF FSUB DOES THE POINT EXIST SMO03160 DC ZNIL SMO03170 LIBF FSTO SMO03180 DC RESUL SMO03190 LD L RESUL SMO03200 BSC L SMM4,+- SMO03210 SM3 LIBF FLD ACCUMULATE THE POWERS SMO03220 DC SN OF THE COORDINATES SMO03230 LIBF FADD OF THE POINT SMO03240 DC FONE SMO03250 LIBF FSTO SMO03260 DC SN SMO03270 LIBF FLD THE X TERM SMO03280 DC SX SMO03290 LIBF FADD SMO03300 DC X SMO03310 LIBF FSTO SMO03320 DC SX SMO03330 LIBF FLD THE Y TERM SMO03340 DC SY SMO03350 LIBF FADD SMO03360 DC Y SMO03370 LIBF FSTO SMO03380 DC SY SMO03390 LIBF FLD THE Z TERM SMO03400 DC SZ SMO03410 LIBF FADD SMO03420 DC Z SMO03430 LIBF FSTO SMO03440 DC SZ SMO03450 LIBF FLD THE (X*X) TERM SMO03460 DC SX2 SMO03470 LIBF FADD SMO03480 DC XSQ SMO03490 LIBF FSTO SMO03500 DC SX2 SMO03510 LIBF FLD SMO03520 DC X SMO03530 LIBF FMPY SMO03540 DC Y SMO03550 LIBF FADD THE (X*Y) TERM SMO03560 DC SXY SMO03570 LIBF FSTO SMO03580 DC SXY SMO03590 LIBF FLD THE (Y*Y) TERM SMO03600 DC SY2 SMO03610 LIBF FADD SMO03620 DC YSQ SMO03630 LIBF FSTO SMO03640 DC SY2 SMO03650 LIBF FLD SMO03660 DC X SMO03670 LIBF FMPY SMO03680 DC Z SMO03690 LIBF FADD THE (X*Z) TERM SMO03700 DC SXZ SMO03710 LIBF FSTO SMO03720 DC SXZ SMO03730 LIBF FLD SMO03740 DC Y SMO03750 LIBF FMPY SMO03760 DC Z SMO03770 LIBF FADD THE (Y*Z) TERM SMO03780 DC SYZ SMO03790 LIBF FSTO SMO03800 DC SYZ SMO03810 SMM4 LD L JJ RETURN IF ALL COLUMNS SMO03820 S L JEND OR ROWS OF SURROUNDING SMO03830 BSC L SM4,Z+ POINTS HAVE NOT BEEN SMO03840 LD L II USED SMO03850 S L IEND SMO03860 BSC L SM5,Z+ SMO03870 LIBF FLD COMPUTE THE ADJUSTED SMO03880 DC SN VALUE FOR THE SMO03890 LIBF FSUB SELECTED GRID POINT SMO03900 DC FFOUR SMO03910 LIBF FSTO DO NOT SMOOTH THE SMO03920 DC RESUL POINT IF FEWER THAN SMO03930 LD L RESUL FOUR SURROUNDING SMO03940 BSC L SMM50,Z+ POINTS WERE FOUND SMO03950 SM148 LIBF FLD SMO03960 DC SXY SMO03970 LIBF FMPY SMO03980 DC SXY SMO03990 LIBF FSTO SMO04000 DC RESUL SMO04010 LIBF FLD SMO04020 DC SX2 SMO04030 LIBF FMPY SMO04040 DC SY2 SMO04050 LIBF FSUB SMO04060 DC RESUL SMO04070 LIBF FSTO SMO04080 DC A SMO04090 LIBF FLD SMO04100 DC SX SMO04110 LIBF FMPY SMO04120 DC SXY SMO04130 LIBF FSTO SMO04140 DC RESUL SMO04150 LIBF FLD SMO04160 DC SY SMO04170 LIBF FMPY SMO04180 DC SX2 SMO04190 LIBF FSUB SMO04200 DC RESUL SMO04210 LIBF FSTO SMO04220 DC B SMO04230 LIBF FMPY SMO04240 DC B SMO04250 LIBF FSTO SMO04260 DC BSQ SMO04270 LIBF FLD SMO04280 DC SX SMO04290 LIBF FMPY SMO04300 DC SX SMO04310 LIBF FSTO SMO04320 DC RESUL SMO04330 LIBF FLD SMO04340 DC SN SMO04350 LIBF FMPY SMO04360 DC SX2 SMO04370 LIBF FSUB SMO04380 DC RESUL SMO04390 LIBF FMPY SMO04400 DC A SMO04410 LIBF FSUB SMO04420 DC BSQ SMO04430 LIBF FSTO DO NOT SMOOTH THE SMO04440 DC D POINT IF A ZERO SMO04450 LD L D DIVISOR APPEARS IN SMO04460 BSC L SMM50,+- THE CALCULATIONS SMO04470 SM149 LIBF FLD SMO04480 DC SXZ SMO04490 LIBF FMPY SMO04500 DC SXY SMO04510 LIBF FSTO SMO04520 DC RESUL SMO04530 LIBF FLD SMO04540 DC SX2 SMO04550 LIBF FMPY SMO04560 DC SYZ SMO04570 LIBF FSUB SMO04580 DC RESUL SMO04590 LIBF FMPY SMO04600 DC B SMO04610 LIBF FSTO SMO04620 DC RESUL SMO04630 LIBF FLD SMO04640 DC SXZ SMO04650 LIBF FMPY SMO04660 DC SX SMO04670 LIBF FSTO SMO04680 DC Z SMO04690 LIBF FLD SMO04700 DC SZ SMO04710 LIBF FMPY SMO04720 DC SX2 SMO04730 LIBF FSUB SMO04740 DC Z SMO04750 LIBF FMPY SMO04760 DC A SMO04770 LIBF FSUB SMO04780 DC RESUL SMO04790 LIBF FDIV SMO04800 DC D SMO04810 LIBF FSTO SMO04820 DC Z SMO04830 LDX I1 I2 SMO04840 MDX I1 I2 SMO04850 LIBF FLDX SMO04860 DC ZG-2 SMO04870 LIBF FADD SMO04880 DC Z SMO04890 LIBF FMPY SMO04900 DC FHALF SMO04910 LDX I1 J STORE THE ADJUSTED SMO04920 MDX I1 J VALUE IN THE SMO04930 LIBF FSTOX OUTPUT ARRAY SMO04940 DC ZGG-2 SMO04950 SMM50 LD L J HAVE ALL THE SMO04960 S L IRMAX ROWS BEEN SMO04970 BSC L SM150,Z+ PROCESSED SMO04980 LD L I SMO04990 STO L THCOL OUTPUT THE NEW SMO05000 LD L SCSTC COLUMN OF GRID SMO05010 STO L SCSTR VALUES SMO05020 BSI L WRTGR SMO05030 LD L I HAVE ALL THE SMO05040 S L ICMAX ROWS BEEN SMO05050 BSC L SM151,Z+ PROCESSED SMO05060 BSI L ERTYP TYPE COMPLETION SMO05070 DC MSAG3 MESSAGE SMO05080 EXIT SMO05090 *************** SMO05100 * HEADS SUBROUTINE FOR SMOOTHING PROGRAM SMO05110 *************** SMO05120 HEADS NOP SUBROUTINE TO SMO05130 LD L FX15 READ A CARD SMO05140 STO L WKIO CONTAINING THE SMO05150 LD L PLUS NAME OF THE INPUT SMO05160 STO L DUMM GRID, THE NAME OF SMO05170 LD L ZERO THE OUTPUT GRID, SMO05180 STO L DUMM&1 AND THE ORDER OF SMO05190 STO L DUMM&2 SMOOTHING TO BE USED SMO05200 STO L DUMM&3 SMO05210 STO L DUMM&4 SMO05220 *************** SMO05230 LIBF CARD0 SMO05240 * LIBF READ0 SMO05250 *************** SMO05260 DC /0000 SMO05270 MDX *-3 SMO05280 *************** SMO05290 LIBF CARD0 SMO05300 * LIBF READ0 SMO05310 *************** SMO05320 DC /1000 SMO05330 DC WKIO SMO05340 *************** SMO05350 LIBF CARD0 SMO05360 * LIBF READ0 SMO05370 *************** SMO05380 DC /0000 SMO05390 MDX *-3 SMO05400 LD L WKIO+15 SMO05410 STO L DUMM&5 SMO05420 LIBF DCBIN SMO05430 DC DUMM SMO05440 STO L ISM SMO05450 LIBF SPEED SMO05460 DC /0000 SMO05470 DC WKIO+1 SMO05480 DC ANAME SMO05490 DC 4 SMO05500 LIBF SPEED SMO05510 DC /0000 SMO05520 DC WKIO+6 SMO05530 DC CNAME SMO05540 DC 4 SMO05550 BSC I HEADS SMO05560 *************** SMO05570 * LOCAT SUBROUTINE SMO05580 *************** SMO05590 LOCAT NOP SUBROUTINE TO SMO05600 LD L FX20 LOCATE EITHER THE SMO05610 STO L WKIO GRID NAME OR THE SMO05620 LD L SCBGN TRAILER RECORD IN SMO05630 STO L WKIO+1 THE DISK DATA AREA SMO05640 AGN LIBF DISK1 SMO05650 DC /5000 IFOUN IS SET TO SMO05660 DC WKIO ONE IF THE GRID SMO05670 DC ERRS NAME IS FOUND SMO05680 LIBF DISK1 SMO05690 DC /1000 IFOUN IS SET TO SMO05700 DC WKIO ZERO IF THE SMO05710 DC ERRS TRAILER RECORD SMO05720 LIBF DISK1 IS FOUND SMO05730 DC /0000 SMO05740 DC WKIO SMO05750 MDX *-4 SMO05760 LIBF FLD SMO05770 DC TRAIL SMO05780 LIBF FSUB SMO05790 DC WKIO+2 SMO05800 LIBF FSTO SMO05810 DC DUMY SMO05820 LD L DUMY SMO05830 BSC L OK,+- SMO05840 LIBF FLD SMO05850 DC WKIO+2 SMO05860 LIBF FSUB SMO05870 DC XNAME SMO05880 LIBF FSTO SMO05890 DC DUMY SMO05900 LD L DUMY SMO05910 BSC L FND,+- SMO05920 LD L WKIO+6 SMO05930 M L FOUR SMO05940 STD L DUMY SMO05950 D L THREE SMO05960 STO L SCINC SMO05970 M L THREE SMO05980 D L ONE SMO05990 S L DUMY+1 SMO06000 BSC L AA3,- SMO06010 A L FOUR SMO06020 A L SCINC SMO06030 STO L SCINC SMO06040 AA3 LD L WKIO&1 SMO06050 A L SCINC SMO06060 STO L WKIO+1 SMO06070 S L SCBGN SMO06080 BSC L EROB,& SMO06090 S L SCLGT SMO06100 BSC L EROB,- SMO06110 BSC L AGN SMO06120 FND LD L ONE TRANSFER HEADER RECORD SMO06130 STO L IFOUN DATA FROM WKIO TO SMO06140 LDD L WKIO+4 STORAGE SMO06150 STD L GRID SMO06160 LD L WKIO+6 SMO06170 STO L ICMAX SMO06180 LD L WKIO+7 SMO06190 STO L IRMAX SMO06200 LDD L WKIO+8 SMO06210 STD L XMIN SMO06220 LDD L WKIO+10 SMO06230 STD L YMIN SMO06240 LD L WKIO&1 SMO06250 STO L SCSTR SMO06260 BSC I LOCAT SMO06270 OK LD L ZERO SMO06280 STO L IFOUN SMO06290 LD L WKIO&1 SMO06300 STO L SCSTR SMO06310 BSC I LOCAT SMO06320 EROB BSI L ERTYP TYPE ERROR MESSAGE SMO06330 DC MSAG7 IF UNABLE TO LOCATE SMO06340 BSI L ERTYP TRAILER RECORD SMO06350 DC MSAG4 SMO06360 WAIT SMO06370 EXIT SMO06380 ERRS DC 0 DISK ERROR MESSAGE SMO06390 LIBF WRTY0 SMO06400 DC /2000 SMO06410 DC MSAG5 SMO06420 SRA 16 SMO06430 BSC I ERRS SMO06440 *************** SMO06450 * SCCOM SUBROUTINE SMO06460 *************** SMO06470 SCCOM NOP COMPUTE SECTOR ADDRESS SMO06480 LD L THCOL FROM THE COLUMN NUMBER SMO06490 S L ONE AND BEGINNING SECTOR SMO06500 M L ONE OF DATA SET AREA SMO06510 D L THREE TEST ADDRESS OF SECTOR SMO06520 STO L DUMY AGAINST UPPER AND LOWER SMO06530 M L FOUR LIMITS OF DATA SET AREA SMO06540 D L ONE SMO06550 STO L SCINC SMO06560 LD L DUMY SMO06570 M L THREE SMO06580 D L ONE SMO06590 STO L DUMY SMO06600 LD L THCOL SMO06610 S L DUMY SMO06620 S L ONE SMO06630 STO L SCINX SMO06640 A L SCINC SMO06650 STO L SCINC SMO06660 A L SCSTR SMO06670 STO L SCLOC SMO06680 S L SCBGN SMO06690 BSC L EROB,Z+ SMO06700 S L SCLGT SMO06710 BSC L EROB,- SMO06720 LD L FX100 SMO06730 M L SCINX SMO06740 D L ONE SMO06750 A L FX22 SMO06760 STO L ININX SMO06770 BSC I SCCOM SMO06780 *************** SMO06790 * GRDVA SUBROUTINE SMO06800 *************** SMO06810 GRDVA NOP SUBROUTINE TO SMO06820 BSI L SCCOM READ A COLUMN SMO06830 LD L SCLOC OF GRID VALUES SMO06840 STO L WKIO&1 FROM THE DISK SMO06850 LD L FX640 SMO06860 STO L WKIO SMO06870 LIBF DISK1 SMO06880 DC /5000 SMO06890 DC WKIO SMO06900 DC ERRS SMO06910 LIBF DISK1 SMO06920 DC /1000 SMO06930 DC WKIO SMO06940 DC ERRS SMO06950 LD L ININX SMO06960 A L FX418 SMO06970 STO L DUMY SMO06980 LDX I1 DUMY SMO06990 LDX I2 FX400 SMO07000 LIBF DISK1 SMO07010 DC /0000 SMO07020 DC WKIO SMO07030 MDX *-4 SMO07040 LDD L1 WKIO SMO07050 STD L2 ZA-2 SMO07060 MDX 1 -2 SMO07070 MDX 2 -2 SMO07080 MDX *-7 SMO07090 LDX I1 ININX SMO07100 LD L1 WKIO+1 SMO07110 STO L IBZ SMO07120 LD L1 WKIO+2 SMO07130 STO L IEZ SMO07140 BSC I GRDVA SMO07150 *************** SMO07160 * WRTOU SUBROUTINE SMO07170 *************** SMO07180 WRTOU NOP SUBROUTINE TO SMO07190 LDX 1 22 WRITE THE HEADER SMO07200 LDX 2 20 RECORD FOR THE GRID SMO07210 LDD L ZNIL SET ON THE DISK SMO07220 STD L1 WKIO-2 SMO07230 MDX 1 -2 SMO07240 MDX 2 -2 SMO07250 MDX *-5 SMO07260 LD L SCBGN SMO07270 A L SCLGT SMO07280 S L SCSTC SMO07290 M L THREE SMO07300 D L FOUR SMO07310 S L ICMAX SMO07320 BSC L NOROM,+Z SMO07330 LD L FX20 SMO07340 STO L WKIO SMO07350 LD L SCSTC SMO07360 STO L WKIO+1 SMO07370 LDD L CNAME SMO07380 STD L WKIO+2 SMO07390 LDD L GRID SMO07400 STD L WKIO+4 SMO07410 LD L ICMAX SMO07420 STO L WKIO&6 SMO07430 LD L IRMAX SMO07440 STO L WKIO&7 SMO07450 LDD L XMIN SMO07460 STD L WKIO+8 SMO07470 LDD L YMIN SMO07480 STD L WKIO+10 SMO07490 LIBF DISK1 SMO07500 DC /5000 SMO07510 DC WKIO SMO07520 DC ERRS SMO07530 LIBF DISK1 SMO07540 DC /4000 SMO07550 DC WKIO SMO07560 LIBF DISK1 SMO07570 DC /0000 SMO07580 DC WKIO SMO07590 MDX *-4 SMO07600 BSC I WRTOU SMO07610 NOROM BSI L ERTYP SMO07620 DC MSAGB SMO07630 BSI L ERTYP SMO07640 DC MSAG4 SMO07650 WAIT SMO07660 EXIT SMO07670 *************** SMO07680 * WRTGR SUBROUTINE SMO07690 *************** SMO07700 WRTGR NOP SUBROUTINE TO SMO07710 BSI L SCCOM WRITE A COLUMN SMO07720 LIBF DISK1 OF GRID VALUES SMO07730 DC /0000 ON THE DISK SMO07740 DC WKIO SMO07750 MDX *-4 SMO07760 LD L FX640 SMO07770 STO L WKIO SMO07780 LD L SCLOC SMO07790 STO L WKIO+1 SMO07800 LIBF DISK1 SMO07810 DC /5000 SMO07820 DC WKIO SMO07830 DC ERRS SMO07840 LIBF DISK1 SMO07850 DC /1000 SMO07860 DC WKIO SMO07870 DC ERRS SMO07880 LIBF DISK1 SMO07890 DC /0000 SMO07900 DC WKIO SMO07910 MDX *-4 SMO07920 LD L ININX SMO07930 A L FX418 SMO07940 STO L DUMY SMO07950 LDX I1 DUMY SMO07960 LDX I2 FX420 SMO07970 LDD L ZNIL SMO07980 STD L1 WKIO SMO07990 MDX 1 -2 SMO08000 MDX 2 -2 SMO08010 MDX *-5 SMO08020 LD L IEZ SET INDEX TO 2*IEZ SMO08030 A L IEZ SMO08040 STO L DUMY SMO08050 LDX I2 DUMY SMO08060 LD L ININX SET WKIO INDEX TO SMO08070 A L FX20 ININX+20+2*IEZ-2 SMO08080 A L DUMY SMO08090 S L TWO SMO08100 STO L DUMY SMO08110 LDX I1 DUMY SMO08120 LDD L2 ZGG-2 SMO08130 STD L1 WKIO SMO08140 MDX 1 -2 SMO08150 MDX 2 -2 SMO08160 MDX *-7 SMO08170 LDX I1 ININX SMO08180 LD L I SMO08190 STO L1 WKIO SMO08200 LD L IBZ SMO08210 STO L1 WKIO+1 SMO08220 LD L IEZ SMO08230 STO L1 WKIO&2 SMO08240 LIBF DISK1 SMO08250 DC /4000 SMO08260 DC WKIO SMO08270 LIBF DISK1 SMO08280 DC /0000 SMO08290 DC WKIO SMO08300 MDX *-4 SMO08310 BSC I WRTGR SMO08320 *************** SMO08330 * REWRT SUBROUTINE SMO08340 *************** SMO08350 REWRT NOP SUBROUTINE TO SMO08360 LD L ICMAX WRITE THE TRAILER SMO08370 M L FOUR RECORD FOLLOWING SMO08380 STD L DUMY THE NEW GRID SET SMO08390 D L THREE ON THE DISK SMO08400 STO L SCINC SMO08410 M L THREE SMO08420 D L ONE SMO08430 S L DUMY+1 SMO08440 BSC L AA2,- SMO08450 A L FOUR SMO08460 A L SCINC SMO08470 STO L SCINC SMO08480 AA2 LD L SCINC SMO08490 A L SCSTC SMO08500 STO L XXXX SMO08510 LIBF DISK1 SMO08520 DC /0000 SMO08530 DC WKIO SMO08540 MDX *-4 SMO08550 LD L XXXX SMO08560 STO L WKIO+1 SMO08570 LD L TWO SMO08580 STO L WKIO SMO08590 LDD L TRAIL SMO08600 STD L WKIO+2 SMO08610 LIBF DISK1 SMO08620 DC /5000 SMO08630 DC WKIO SMO08640 DC ERRS SMO08650 LIBF DISK1 SMO08660 DC /4000 SMO08670 DC WKIO SMO08680 LIBF DISK1 SMO08690 DC /0000 SMO08700 DC WKIO SMO08710 MDX *-4 SMO08720 BSC I REWRT SMO08730 *************** SMO08740 * ERTYP SUBROUTINE SMO08750 *************** SMO08760 ERTYP NOP SUBROUTINE TO SMO08770 LD I ERTYP WRITE MESSAGES SMO08780 STO L ERTX ON THE CONSOLE SMO08790 MDX L ERTYP,&1 TYPEWRITER SMO08800 LD L ERTX SMO08810 S L ONE SMO08820 STO *&1 SMO08830 LD L 0 SMO08840 STO L ERTX+2 SMO08850 M L ONE SMO08860 D L TWO SMO08870 STO L TYPE SMO08880 LIBF EBPRT SMO08890 DC /0000 SMO08900 ERTX DC 0 SMO08910 DC TYPE+1 SMO08920 DC 0 SMO08930 LIBF WRTY0 SMO08940 DC /2000 SMO08950 DC TYPE SMO08960 LIBF WRTY0 SMO08970 DC /2000 SMO08980 DC CONTL SMO08990 LIBF WRTY0 SMO09000 DC /0000 SMO09010 MDX *-3 SMO09020 BSC I ERTYP SMO09030 *************** SMO09040 * DEFINE ERROR MESAGES SMO09050 *************** SMO09060 DC 16 SMO09070 MSAG1 EBC .SMOTH BEGINNING . SMO09080 DC 22 SMO09090 MSAG2 EBC .INPUT GRID NAMED . SMO09100 DC /4040 SMO09110 DC /4040 SMO09120 DC 16 SMO09130 MSAG3 EBC .SMOTH COMPLETED . SMO09140 DC 30 SMO09150 MSAG4 EBC .PUSH START FOR EXIT TO MONITOR. SMO09160 MSAG5 DC 20 DISK ERROR MESSAGE SMO09170 DC /3020 SMO09180 DC /9858 SMO09190 DC /2135 SMO09200 DC /6060 SMO09210 DC /5060 SMO09220 DC /2121 SMO09230 DC /9C34 SMO09240 DC /6070 SMO09250 DC /2074 SMO09260 DC /3C9C SMO09270 DC /3421 SMO09280 DC /7C50 SMO09290 DC /1821 SMO09300 DC /3C74 SMO09310 DC /3021 SMO09320 DC /6034 SMO09330 DC /989C SMO09340 DC /3C60 SMO09350 DC /9C21 SMO09360 DC /8103 SMO09370 DC 26 SMO09380 MSAG6 EBC .NAME WAS NOT FOUND ON DISK. SMO09390 DC 30 SMO09400 MSAG7 EBC .UNABLE TO FIND TRAILER RECORD . SMO09410 DC 26 SMO09420 MSAG8 EBC .NAME ALREADY USED ON DISK . SMO09430 DC 42 SMO09440 MSAG9 EBC .REQUESTED ORDER OF SMOOTHING. SMO09450 EBC . NOT ALLOWABLE. SMO09460 DC 22 SMO09470 MSAGA EBC .OUTPUT GRID NAMED . SMO09480 DC /4040 SMO09490 DC /4040 SMO09500 DC 54 SMO09510 MSAGB EBC .REQUIRED NUMBER OF COLUMNS. SMO09520 EBC .EXCEEDS AVAILABLE DISK AREA . SMO09530 CONTL DC 1 SMO09540 DC /8103 SMO09550 *************** SMO09560 * DEFINE CONSTANTS SMO09570 *************** SMO09580 SCBGN DC 448 START OF DATA SET AREA SMO09590 SCLGT DC 808 NO. OF SECTORS IN D.S. AREASMO09600 PLUS DC /80A0 SMO09610 XXXX DC /FFFF SMO09620 ZERO DC 0 SMO09630 ONE DC 1 SMO09640 TWO DC 2 SMO09650 THREE DC 3 SMO09660 FOUR DC 4 SMO09670 FX15 DC 15 SMO09680 FX20 DC 20 SMO09690 FX22 DC 22 SMO09700 FX100 DC 100 SMO09710 FX200 DC 200 SMO09720 FX400 DC 400 SMO09730 FX418 DC 418 SMO09740 FX420 DC 420 SMO09750 FX640 DC 640 SMO09760 FZERO DEC 0. SMO09770 FHALF DEC 0.5 SMO09780 FONE DEC 1.0 SMO09790 FFOUR DEC 4. SMO09800 ZNIL DEC -1.0E30 SMO09810 TRAIL DEC 9999. SMO09820 *************** SMO09830 * ALLOCATE STORAGE SMO09840 *************** SMO09850 L BSS 1 INDEXING PARAMETER SMO09860 ISM BSS 1 SMOOTHING RADIUS SMO09870 I BSS 1 COLUMN SMO09880 KJ BSS 1 SMO09890 J BSS 1 ROW SMO09900 IBGN BSS 1 BEGINNING COLUMN SMO09910 IDUM BSS 1 SMO09920 IEND BSS 1 ENDING COLUMN SMO09930 I1 BSS 1 SMO09940 JBGN BSS 1 BEGINNING ROW SMO09950 JEND BSS 1 ENDING ROW SMO09960 I2 BSS 1 INDEXING PARAMETERS SMO09970 IZ BSS 1 SMO09980 II BSS 1 SMO09990 I3 BSS 1 SMO10000 JJ BSS 1 SMO10010 I4 BSS 1 SMO10020 LINX BSS 1 SMO10030 MINX BSS 1 SMO10040 IBZ BSS 1 BEGINNING ROW SMO10050 IEZ BSS 1 ENDING ROW SMO10060 THCOL BSS 1 COLUMN SMO10070 IFOUN BSS 1 LOCAT SWITCH SMO10080 ININX BSS 1 BUFFER INCRIMENT SMO10090 ICMAX BSS 1 MAX COLUMN SMO10100 IRMAX BSS 1 MAX ROW SMO10110 K BSS 1 INDEXING PARAMETER SMO10120 SCLOC BSS 1 DATA SET SMO10130 SCINC BSS 1 LOCATION SMO10140 SCINX BSS 1 PARAMETERS SMO10150 SCSTR BSS 1 SMO10160 SCSTA BSS 1 SMO10170 SCSTC BSS 1 SMO10180 KK BSS 1 INDEXING PARAMETER SMO10190 IPTCL BSS 1 SMO10200 RSQ BSS E 2 STORAGE FOR SMO10210 RESUL BSS E 2 SOLUTION OF SMO10220 SN BSS E 2 SECOND ORDER SMO10230 SX BSS E 2 EQUATION SMO10240 SY BSS E 2 SMO10250 SX2 BSS E 2 SMO10260 SXY BSS E 2 SMO10270 SY2 BSS E 2 SMO10280 SZ BSS E 2 SMO10290 SXZ BSS E 2 SMO10300 SYZ BSS E 2 SMO10310 X BSS E 2 SMO10320 Y BSS E 2 SMO10330 YSQ BSS E 2 SMO10340 XSQ BSS E 2 SMO10350 Z BSS E 2 SMO10360 A BSS E 2 SMO10370 B BSS E 2 SMO10380 BSQ BSS E 2 SMO10390 D BSS E 2 SMO10400 ANAME BSS E 2 DATA SET SMO10410 CNAME BSS E 2 NAMES SMO10420 XNAME BSS E 2 SMO10430 GRID BSS E 2 GRID INTERVAL SMO10440 XMIN BSS E 2 MIN X SMO10450 YMIN BSS E 2 MIN Y SMO10460 DUMY BSS E 2 TEMPORARY STORAGE SMO10470 DUMM BSS E 6 SMO10480 ZA BSS E 400 COLUMN VECTOR SMO10490 ZGG BSS E 400 COLUMN VECTOR SMO10500 WKIO BSS E 642 DISK I/O BUFFER SMO10510 ZG BSS E 1800 COLUMN STORAGE SMO10520 TYPE BSS 30 TYPEWRITER AREA SMO10530 END SM100 SMO10540 // DUP SMO10550 *STORE WS UA SMOTH SMO10560 // JOB LSF00010 // DUP LSF00020 *DELETE LSFO LSF00030 // ASM LSF00040 *LIST LSF00050 *************** LSF00060 * LSFO LINK FOR SRFIT PROGRAM LSF00070 * DO NOT EXECUTE SEPARATELY LSF00080 *************** LSF00090 OKA LD L ZERO SET THE INITIAL VALUE LSF00100 STO L IBCOL OF THE VARIOUS LSF00110 BSI L ERTYP LSF00120 DC MSAGE LSF00130 WAIT LSF00140 *************** LSF00150 LIBF CARD0 LSF00160 * LIBF PNCH0 LSF00170 *************** LSF00180 DC /3000 LSF00190 *************** LSF00200 LIBF CARD0 LSF00210 * LIBF PNCH0 LSF00220 *************** LSF00230 DC /0000 LSF00240 MDX *-3 LSF00250 LIBF DISK1 LSF00260 DC /5000 LSF00270 DC DSKOT LSF00280 DC ERRS LSF00290 LIBF DISK1 LSF00300 DC /1000 LSF00310 DC DSKOT LSF00320 DC ERRS LSF00330 LIBF DISK1 LSF00340 DC /0000 LSF00350 DC DSKOT LSF00360 MDX *-4 LSF00370 LD L M INDEXING TERMS THAT LSF00380 A L ONE WILL BE USED IN LSF00390 STO L INCC CALCULATING THE LSF00400 LD L NEG1 B COEFFICIENTS LSF00410 STO L INC LSF00420 LD L ZERO LSF00430 STO L ACCSR LSF00440 STO L IND LSF00450 LD L ONE LSF00460 STO L SRIDX LSF00470 STO L LOC LSF00480 STO L NUM LSF00490 LDD L FONE SET B(0) EQUAL TO ONE LSF00500 STD L B LSF00510 RTN3 LD L INC INCREMENT THE INDEX LSF00520 A L ONE VALUES EACH TIME A LSF00530 STO L INC SET OF B COEFF AND LSF00540 A L IND COLUMN VALUES IS LSF00550 STO L IND CALCULATED LSF00560 LD L NUM LSF00570 STO L J LSF00580 LOOP2 LDD L FZERO DETERMINE WHICH TERM LSF00590 STD L TRM IN THIS PARTICULAR LSF00600 LDX I2 J COLUMN IS TO BE LSF00610 LD L2 IX-1 CALCULATED NEXT LSF00620 STO L IXX LSF00630 LD L2 IY-1 LSF00640 STO L IYY LSF00650 LD L ONE LSF00660 STO L I LSF00670 LOOP1 LDX I2 I DETERMINE WHICH LSF00680 LD L2 IY-1 INDIVIDUAL TERM OF LSF00690 A L IYY THIS PARTICULAR TERM LSF00700 STO L JPP IS TO BE CALCULATED LSF00710 LD L2 IX-1 THESE INDIVIDUAL LSF00720 A L IXX TERMS ARE LSF00730 A L JPP ACCUMULATED AS THEY LSF00740 STO L IPP ARE CALCULATED IN LSF00750 M L IPP ORDER TO FORM THE LSF00760 D L ONE DESIRED TERM IN THE LSF00770 A L IPP COLUMN LSF00780 A L TWO LSF00790 M L ONE LSF00800 D L TWO LSF00810 A L JPP LSF00820 STO L NN LSF00830 LD L IND LSF00840 A L I LSF00850 STO L INDX LSF00860 A L INDX LSF00870 STO L DUM LSF00880 LDX I1 DUM LSF00890 LIBF FLDX LSF00900 DC B-2 LSF00910 LD L NN LSF00920 A L NN LSF00930 STO L DUM LSF00940 LDX I1 DUM LSF00950 LIBF FMPYX LSF00960 DC S-2 LSF00970 LIBF FADD LSF00980 DC TRM LSF00990 LIBF FSTO LSF01000 DC TRM LSF01010 LD L I INCREMENT AND RETURN LSF01020 A L ONE TO LOOP1 IF ALL THE LSF01030 STO L I TERMS OF THIS TERM LSF01040 S L NUM HAVE NOT BEEN CALC LSF01050 BSC L LOOP1,& AND ACCUMULATED LSF01060 LD L LOC LSF01070 A L LOC LSF01080 STO L DUM LSF01090 LDX I1 DUM STORE THE ACCUMULATED LSF01100 LDD L TRM TERM AT THE PROPER LSF01110 STD L1 TR-2 LOCATION IN TR LSF01120 LD L LOC INCREMENT THE INDEX LSF01130 A L ONE VALUES AND RETURN LSF01140 STO L LOC TO LOOP2 IF ALL OF LSF01150 LD L J THE TERMS IN THIS LSF01160 A L ONE PARTICULAR COLUMN LSF01170 STO L J HAVE NOT BEEN LSF01180 S L M CALCULATED LSF01190 BSC L LOOP2,& LSF01200 LD L M SEE IF ALL OF THE LSF01210 S L NUM COLUMNS HAVE BEEN LSF01220 BSC L NXT,& CALCULATED LSF01230 LD L NUM INCREMENT AND SET LSF01240 A L ONE THESE INDEX VALUES LSF01250 STO L NUM EACH TIME A SET OF LSF01260 A L ONE B COEFFICIENTS LSF01270 M L NUM CALCULATED LSF01280 D L TWO LSF01290 STO L ISUB LSF01300 STO L JSUB LSF01310 LD L ISUB LSF01320 A L ISUB LSF01330 STO L DUM LSF01340 LDX I1 DUM LSF01350 LDD L FONE LSF01360 STD L1 B-2 LSF01370 LD L IBCOL LSF01380 STO L JBCOL LSF01390 LD L TWO LSF01400 STO L K LSF01410 LOOP3 LD L JSUB DETERMINE WHICH B LSF01420 S L ONE COEFF IN THIS LSF01430 STO L JSUB PARTICULAR GROUP IS LSF01440 STO L KSUB TO BE CALCULATED LSF01450 LDD L FZERO NEXT LSF01460 STD L BSUM LSF01470 LD L TWO LSF01480 STO L KK LSF01490 LOOP4 LD L KSUB CALCULATE EACH LSF01500 A L ONE INDIVIDUAL TERM IN LSF01510 STO L KSUB THE NUMERATOR OF THE LSF01520 LD L JBCOL EXPRESSION FOR THIS LSF01530 A L KK B COEFF AND SUM LSF01540 STO L ITRSB THESE TERMS LSF01550 A L ITRSB LSF01560 STO L DUM LSF01570 LDX I1 DUM LSF01580 LIBF FLDX LSF01590 DC TR-2 LSF01600 LD L KSUB LSF01610 A L KSUB LSF01620 STO L DUM LSF01630 LDX I1 DUM LSF01640 LIBF FMPYX LSF01650 DC B-2 LSF01660 LIBF FADD LSF01670 DC BSUM LSF01680 LIBF FSTO LSF01690 DC BSUM LSF01700 LD L KK INCREMENT KK AND LSF01710 A L ONE RETURN TO LOOP4 IF LSF01720 STO L KK ALL THE TERMS OF LSF01730 S L K THIS B COEFF HAVE LSF01740 BSC L LOOP4,& NOT BEEN CALCULATED LSF01750 LD L JBCOL CALCULATE THE VALUE LSF01760 A L JBCOL OF THE B COEFF BY LSF01770 STO L DJBCL DIVIDING THE SUMMED LSF01780 LDX I1 DJBCL TERMS BY THE PROPER LSF01790 LIBF FLD COLUMN VALUE, THEN LSF01800 DC BSUM STORE IN THE PROPER LSF01810 LIBF FDIVX SEQUENTIAL POSITION LSF01820 DC TR LSF01830 LD L JSUB LSF01840 A L JSUB LSF01850 STO L DUM LSF01860 LDX I1 DUM LSF01870 LIBF FSTOX LSF01880 DC B-2 LSF01890 LIBF FLD LSF01900 DC FZERO LSF01910 LIBF FSUBX LSF01920 DC B-2 LSF01930 LIBF FSTOX LSF01940 DC B-2 LSF01950 LD L JBCOL ADJUST THE VALUE OF LSF01960 S L M JBCOL AND INCREMENT LSF01970 A L NUM THE VALUE OF K. LSF01980 S L K RETURN TO LOOP3 IF LSF01990 S L ONE ALL OF THE B COEFF LSF02000 STO L JBCOL IN THIS GROUP HAVE LSF02010 LD L K NOT BEEN CALCULATED LSF02020 A L ONE LSF02030 STO L K LSF02040 S L NUM LSF02050 BSC L LOOP3,& LSF02060 LD L INCC INCREMENT THESE INDEX LSF02070 S L ONE VALUES BEFORE TAKING LSF02080 STO L INCC THE RETURN LSF02090 A L IBCOL LSF02100 STO L IBCOL LSF02110 BSC L RTN3 UNCONDITIONAL RETURN LSF02120 NXT LIBF FLD CALCULATE A(0) BY LSF02130 DC SZ DIVIDING SZ(0) BY LSF02140 LIBF FDIV TR(0) AND STORE IN LSF02150 DC TR THE FIRST A LOCATION LSF02160 LIBF FSTO LSF02170 DC A LSF02180 LIBF FLD LSF02190 DC SZ LSF02200 LIBF FMPY LSF02210 DC SZ LSF02220 LIBF FDIV LSF02230 DC S LSF02240 LIBF FSTO LSF02250 DC SSZO LSF02260 LIBF FLD LSF02270 DC ZSQSU LSF02280 LIBF FSUB LSF02290 DC SSZO LSF02300 LIBF FSTO LSF02310 DC SSZO LSF02320 LD L M LSF02330 A L ONE LSF02340 M L M LSF02350 D L ONE LSF02360 STO L QXX OUTPUT THE B LSF02370 BSI L OUTB COEFFICIENTS LSF02380 BSI L ERTYP LSF02390 DC MSAG7 LSF02400 BSI L ERTYP LSF02410 DC MSAG4 LSF02420 BSI L ERTYP LSF02430 DC MSAG7 LSF02440 BSI L ERTYP LSF02450 DC MSAG5 LSF02460 BSI L ERTYP LSF02470 DC MSAG6 LSF02480 BSI L ERTYP LSF02490 DC MSAG7 LSF02500 BSI L ERTYP LSF02510 DC MSAG8 LSF02520 LD L ONE SET THE INITIAL INDEX LSF02530 STO L INDB VALUES TO BE USED LSF02540 STO L INDA IN CALCULATING THE LSF02550 LD L NEG1 A COEFFICIENTS LSF02560 STO L INCA LSF02570 LD L TWO LSF02580 STO L I LSF02590 LOOP5 LD L INCA DETERMINE THE LSF02600 A L ONE PARTICULAR A COEFF LSF02610 STO L INCA WHICH IS TO BE LSF02620 LD L INDA CALCULATED NEXT AND LSF02630 A L M SET THE INDEX VALUES LSF02640 S L INCA ACCORDINGLY LSF02650 STO L INDA LSF02660 LDD L FZERO LSF02670 STD L ASUM LSF02680 LD L ONE LSF02690 STO L J LSF02700 LOOP6 LD L INDB DETERMINE WHICH LSF02710 A L ONE PARTICULAR TERM OF LSF02720 STO L INDB THE NUMERATOR OF LSF02730 LD L J THE EXPRESSION FOR LSF02740 A L J THIS A COEFFICIENT LSF02750 STO L DJ IS TO BE CALCULATED LSF02760 LDX I1 DJ NEXT LSF02770 LIBF FLDX THESE TERMS ARE LSF02780 DC SZ-2 ACCUMULATED AS THEY LSF02790 LD L INDB ARE CALCULATED LSF02800 A L INDB LSF02810 STO L DUM LSF02820 LDX I1 DUM LSF02830 LIBF FMPYX LSF02840 DC B-2 LSF02850 LIBF FADD LSF02860 DC ASUM LSF02870 LIBF FSTO LSF02880 DC ASUM LSF02890 LD L J RETURN TO LOOP6 IF LSF02900 A L ONE ALL OF THE TERMS IN LSF02910 STO L J THE NUMERATOR HAVE LSF02920 S L I NOT BEEN CALCULATED LSF02930 BSC L LOOP6,& AND ACCUMULATED LSF02940 LD L INDA LSF02950 A L INDA LSF02960 STO L DUM LSF02970 LDX I1 DUM DIVIDE THE ACCUMULATED LSF02980 LIBF FDIVX NUMERATOR BY PROPER LSF02990 DC TR-2 VALUE OF TR AND LSF03000 LD L I STORE IN THE PROPER LSF03010 A L I A LOCATION LSF03020 STO L DUM LSF03030 LDX I1 DUM LSF03040 LIBF FSTOX LSF03050 DC A-2 LSF03060 LIBF FMPY LSF03070 DC ASUM LSF03080 LIBF FDIV LSF03090 DC SSZO LSF03100 LIBF FMPY LSF03110 DC FL100 LSF03120 LIBF IFIX LSF03130 STO L FXSSR LSF03140 A L ACCSR LSF03150 STO L ACCSR LSF03160 LIBF BINDC LSF03170 DC OUTT LSF03180 LIBF SPEED LSF03190 DC /0000 LSF03200 DC OUTT+4 LSF03210 DC MSAG8+14 LSF03220 DC 2 LSF03230 LD L FXSSR LSF03240 LIBF BINDC LSF03250 DC OUTT LSF03260 LIBF SPEED LSF03270 DC /0000 LSF03280 DC OUTT+4 LSF03290 DC MSAG8+7 LSF03300 DC 2 LSF03310 LD L SRIDX LSF03320 A L ONE LSF03330 STO L SRIDX LSF03340 LIBF BINDC LSF03350 DC OUTT LSF03360 LIBF SPEED LSF03370 DC /0000 LSF03380 DC OUTT+4 LSF03390 DC MSAG8+1 LSF03400 DC 2 LSF03410 BSI L ERTYP LSF03420 DC MSAG7 LSF03430 BSI L ERTYP LSF03440 DC MSAG8 LSF03450 LD L I RETURN TO LOOP5 IF LSF03460 A L ONE ALL OF THE A LSF03470 STO L I COEFFICIENTS HAVE LSF03480 S L M NOT BEEN CALCULATED LSF03490 BSC L LOOP5,& LSF03500 LD L M LSF03510 A L M LSF03520 STO L QXX LSF03530 LD L ADDRA OUTPUT THE A LSF03540 STO L ADDRS COEFFICIENTS LSF03550 LD L ALTRA LSF03560 STO L CHAR+1 LSF03570 BSI L OUTC LSF03580 LD L ONE DETERMINE WHICH LSF03590 STO L I C COEFFICIENT IS TO LSF03600 LOOP7 LDD L FZERO BE CALCULATED AND LSF03610 STD L SP SET THE INDEX VALUES LSF03620 LD L I ACCORDINGLY LSF03630 STO L J LSF03640 LOOP8 LD L J DETERMINE WHICH LSF03650 S L ONE INDIVIDUAL TERM OF LSF03660 M L J THIS PARTICULAR LSF03670 D L TWO C COEFFICIENT IS TO LSF03680 A L I BE CALCULATED LSF03690 STO L INDD LSF03700 LD L INDD LSF03710 A L INDD LSF03720 STO L DUM THESE INDIVIDUAL LSF03730 LDX I1 DUM TERMS ARE ACCUMULATD LSF03740 LIBF FLDX IN ORDER TO FORM THE LSF03750 DC B-2 PARTICULAR C VALUE LSF03760 LD L J LSF03770 A L J LSF03780 STO L DUM LSF03790 LDX I1 DUM LSF03800 LIBF FMPYX LSF03810 DC A-2 LSF03820 LIBF FADD LSF03830 DC SP LSF03840 LIBF FSTO LSF03850 DC SP LSF03860 LD L J RETURN TO LOOP8 IF LSF03870 A L ONE ALL OF THE INDIVIDUL LSF03880 STO L J TERMS FOR THIS C LSF03890 S L M HAVE NOT BEEN LSF03900 BSC L LOOP8,& CALCULATED LSF03910 LD L I LSF03920 A L I LSF03930 STO L DUM LSF03940 LDX I1 DUM STORE THE ACCUMULATED LSF03950 LDD L SP VALUE OF C IN THE LSF03960 STD L1 C-2 PROPER LOCATION LSF03970 LD L I RETURN TO LOOP7 IF LSF03980 A L ONE ALL OF THE C COEFF LSF03990 STO L I HAVE NOT BEEN LSF04000 S L M CALCULATED LSF04010 BSC L LOOP7,& LSF04020 LD L ALTRC LSF04030 STO L CHAR+1 LSF04040 LD L ADDRC LSF04050 STO L ADDRS OUTPUT THE C LSF04060 BSI L OUTC COEFFICIENTS LSF04070 BSI L ERTYP LSF04080 DC MSAG3 LSF04090 EXIT LSF04100 ERRS NOP LSF04110 LIBF WRTY0 LSF04120 DC /2000 LSF04130 DC MSAG9 LSF04140 SRA 16 LSF04150 BSC I ERRS LSF04160 *************** LSF04170 * OUTB FOR COEFFICIENTS LSF04180 *************** LSF04190 OUTB NOP SUBROUTINE TO LSF04200 LDX 1 29 PUNCH OUT THE B LSF04210 LD L ZERO COEFFICIENTS, LSF04220 STO L1 AA ONE PER CARD LSF04230 MDX 1 -1 LSF04240 MDX *-4 LSF04250 LD L ZERO LSF04260 STO L SCRPT LSF04270 STO L SUB2 LSF04280 LD L LFTPR LSF04290 STO L AA+15 LSF04300 LD L RGTPR LSF04310 STO L AA+21 LSF04320 LD L EBEQU LSF04330 STO L AA+23 LSF04340 LD L COMMA LSF04350 STO L AA+18 LSF04360 LD L LTRB LSF04370 STO L AA+14 LSF04380 LDX 1 0 LSF04390 FINAD LIBF FLDX LSF04400 DC B LSF04410 LIBF FMPY LSF04420 DC FTEN LSF04430 CALL FBTD LSF04440 DC INPTA+30 LSF04450 LD L INPTA+41 LSF04460 STO L INPTA+40 LSF04470 LD L INPTA+42 LSF04480 STO L INPTA+41 LSF04490 LD L INPTA+43 LSF04500 STO L INPTA+42 LSF04510 LD L INPTA+44 LSF04520 STO L INPTA+43 LSF04530 LD L INPTA+31 LSF04540 STO L INPTA+32 LSF04550 LD L EBPER LSF04560 STO L INPTA+31 LSF04570 LDX 2 14 LSF04580 LD L2 INPTA+29 LSF04590 SLA 8 LSF04600 STO L2 INPTA+29 LSF04610 MDX 2 -1 LSF04620 MDX *-7 LSF04630 LIBF SPEED LSF04640 DC /0011 LSF04650 DC INPTA+30 LSF04660 DC AA+30 LSF04670 DC 14 LSF04680 LD L SCRPT LSF04690 LIBF BINDC LSF04700 DC OUTT LSF04710 LD L OUTT+5 LSF04720 STO L AA+17 LSF04730 LD L OUTT+4 LSF04740 STO L AA+16 LSF04750 S L NMZER LSF04760 BSC L OKN,Z LSF04770 LD L ZERO LSF04780 STO L AA+16 LSF04790 OKN LD L SUB2 LSF04800 LIBF BINDC LSF04810 DC OUTT LSF04820 LD L OUTT+5 LSF04830 STO L AA+20 LSF04840 LD L OUTT+4 LSF04850 STO L AA+19 LSF04860 S L NMZER LSF04870 BSC L OKP,Z LSF04880 LD L ZERO LSF04890 STO L AA+19 LSF04900 OKP LD L FX43 LSF04910 STO L AA LSF04920 *************** LSF04930 LIBF CARD0 LSF04940 * LIBF PNCH0 LSF04950 *************** LSF04960 DC /2000 LSF04970 DC AA LSF04980 *************** LSF04990 LIBF CARD0 LSF05000 * LIBF PNCH0 LSF05010 *************** LSF05020 DC /0000 LSF05030 MDX *-3 LSF05040 MDX 1 2 LSF05050 STX L1 DUMN LSF05060 LD L DUMN LSF05070 S L QXX LSF05080 BSC L OKO,- LSF05090 LD L SUB2 LSF05100 S L SCRPT LSF05110 BSC L SUBX,Z- LSF05120 MDX L SUB2,1 LSF05130 LD L ZERO LSF05140 STO L SCRPT LSF05150 BSC L FINAD LSF05160 SUBX MDX L SCRPT,1 LSF05170 BSC L FINAD LSF05180 OKO BSC I OUTB LSF05190 *************** LSF05200 * OUTC FOR COEFFICIENTS LSF05210 *************** LSF05220 OUTC NOP SUBROUTINE TO LSF05230 LDX 1 29 PUNCH OUT THE LSF05240 LD L ZERO COEFFICIENTS, LSF05250 STO L1 AA ONE PER CARD LSF05260 MDX 1 -1 LSF05270 MDX *-4 LSF05280 LD L ZERO LSF05290 STO L SCRPT LSF05300 LD L LFTPR LSF05310 STO L AA+15 LSF05320 LD L RGTPR LSF05330 STO L AA+18 LSF05340 LD L EBEQU LSF05350 STO L AA+20 LSF05360 CHAR LD L 0 LSF05370 STO L AA+14 LSF05380 LDX 1 0 LSF05390 FINAC LIBF FLDX LSF05400 ADDRS DC 0 LSF05410 LIBF FMPY LSF05420 DC FTEN LSF05430 CALL FBTD LSF05440 DC INPTA+30 LSF05450 LD L INPTA+41 LSF05460 STO L INPTA+40 LSF05470 LD L INPTA+42 LSF05480 STO L INPTA+41 LSF05490 LD L INPTA+43 LSF05500 STO L INPTA+42 LSF05510 LD L INPTA+44 LSF05520 STO L INPTA+43 LSF05530 LD L INPTA+31 LSF05540 STO L INPTA+32 LSF05550 LD L EBPER LSF05560 STO L INPTA+31 LSF05570 LDX 2 14 LSF05580 LD L2 INPTA+29 LSF05590 SLA 8 LSF05600 STO L2 INPTA+29 LSF05610 MDX 2 -1 LSF05620 MDX *-7 LSF05630 LIBF SPEED LSF05640 DC /0011 LSF05650 DC INPTA+30 LSF05660 DC AA+30 LSF05670 DC 14 LSF05680 LD L SCRPT LSF05690 LIBF BINDC LSF05700 DC OUTT LSF05710 LD L OUTT+5 LSF05720 STO L AA+17 LSF05730 LD L OUTT+4 LSF05740 STO L AA+16 LSF05750 S L NMZER LSF05760 BSC L OKM,Z LSF05770 LD L ZERO LSF05780 STO L AA+16 LSF05790 OKM MDX L SCRPT,1 LSF05800 LD L FX43 LSF05810 STO L AA LSF05820 *************** LSF05830 LIBF CARD0 LSF05840 * LIBF PNCH0 LSF05850 *************** LSF05860 DC /2000 LSF05870 DC AA LSF05880 *************** LSF05890 LIBF CARD0 LSF05900 * LIBF PNCH0 LSF05910 *************** LSF05920 DC /0000 LSF05930 MDX *-3 LSF05940 MDX 1 2 LSF05950 STX L1 DUMN LSF05960 LD L DUMN LSF05970 S L QXX LSF05980 BSC L FINAC,Z+ LSF05990 BSC I OUTC LSF06000 *************** LSF06010 * ERTYP SUBROUTINE LSF06020 *************** LSF06030 ERTYP NOP SUBROUTINE TO LSF06040 LD I ERTYP WRITE MESSAGES LSF06050 STO L ERTX ON THE CONSOLE LSF06060 MDX L ERTYP,&1 TYPEWRITER LSF06070 LD L ERTX LSF06080 S L ONE LSF06090 STO *&1 LSF06100 LD L 0 LSF06110 STO L ERTX+2 LSF06120 M L ONE LSF06130 D L TWO LSF06140 STO L TYPE LSF06150 LIBF EBPRT LSF06160 DC /0000 LSF06170 ERTX DC 0 LSF06180 DC TYPE+1 LSF06190 DC 0 LSF06200 LIBF WRTY0 LSF06210 DC /2000 LSF06220 DC TYPE LSF06230 LIBF WRTY0 LSF06240 DC /2000 LSF06250 DC CONTL LSF06260 LIBF WRTY0 LSF06270 DC /0000 LSF06280 MDX *-3 LSF06290 BSC I ERTYP LSF06300 *************** LSF06310 * DEFINE ERROR MESAGES LSF06320 *************** LSF06330 DC 16 LSF06340 MSAG1 EBC .SRFIT BEGINNING . LSF06350 DC 22 LSF06360 MSAG2 EBC .INPUT GRID NAMED . LSF06370 DC /4040 LSF06380 DC /4040 LSF06390 DC 16 LSF06400 MSAG3 EBC .SRFIT COMPLETED . LSF06410 DC 30 LSF06420 MSAG4 EBC . SUM OF SQUARES REDUCTION . LSF06430 DC 34 LSF06440 MSAG5 EBC . TERM PERCENT ACCUMULATED. LSF06450 DC 32 LSF06460 MSAG6 EBC .NUMBER CONTRIBUTION PERCENT. LSF06470 DC 2 LSF06480 MSAG7 EBC . . LSF06490 DC 30 LSF06500 MSAG8 EBC . 01 00 00. LSF06510 MSAG9 DC 20 DISK ERROR MESSAGE LSF06520 DC /3020 LSF06530 DC /9858 LSF06540 DC /2135 LSF06550 DC /6060 LSF06560 DC /5060 LSF06570 DC /2121 LSF06580 DC /9C34 LSF06590 DC /6070 LSF06600 DC /2074 LSF06610 DC /3C9C LSF06620 DC /3421 LSF06630 DC /7C50 LSF06640 DC /1821 LSF06650 DC /3C74 LSF06660 DC /3021 LSF06670 DC /6034 LSF06680 DC /989C LSF06690 DC /3C60 LSF06700 DC /9C21 LSF06710 DC /8103 LSF06720 DC 30 LSF06730 MSAGA EBC .UNABLE TO FIND TRAILER RECORD . LSF06740 DC 30 LSF06750 MSAGB EBC .PUSH START FOR EXIT TO MONITOR. LSF06760 DC 22 LSF06770 MSAGC EBC .NAME NOT FOUND ON DISK. LSF06780 DC 18 LSF06790 MSAGD EBC .RANDOM DATA INPUT . LSF06800 DC 38 LSF06810 MSAGE EBC .PLACE BLANK CARDS IN HOPPER . LSF06820 EBC .PUSH START. LSF06830 CONTL DC 1 LSF06840 DC /8105 LSF06850 *************** LSF06860 * DEFINE CONSTANTS LSF06870 *************** LSF06880 SCBGN DC 448 LSF06890 SCLGT DC 808 LSF06900 SCCNT DC 287 LSF06910 EBPER DC /004B LSF06920 FX43 DC 43 LSF06930 ADDRA DC A LSF06940 ADDRB DC B LSF06950 ADDRC DC C LSF06960 ALTRA DC LTRA LSF06970 ALTRC DC LTRC LSF06980 FX19 DC 19 LSF06990 FX20 DC 20 LSF07000 FX22 DC 22 LSF07010 FX100 DC 100 LSF07020 FX272 DC 272 LSF07030 FX280 DC 280 LSF07040 FX300 DC 300 LSF07050 FX400 DC 400 LSF07060 FX402 DC 402 LSF07070 FX418 DC 418 LSF07080 FX420 DC 420 LSF07090 FX422 DC 422 LSF07100 FX640 DC 640 LSF07110 FX808 DC 808 LSF07120 ZNIL DEC -1.0E30 LSF07130 AZNIL DEC 1.0E30 LSF07140 TRAIL DEC 9999. LSF07150 PLUS DC /80A0 LSF07160 NMZER DC /2000 LSF07170 LFTPR DC /8120 LSF07180 RGTPR DC /4120 LSF07190 EBEQU DC /00A0 LSF07200 COMMA DC /2420 LSF07210 LTRA DC /9000 LSF07220 LTRB DC /8800 LSF07230 LTRC DC /8400 LSF07240 LTRE DC /8100 LSF07250 AMPER DC /8000 LSF07260 MINUS DC /4000 LSF07270 PERID DC /8420 LSF07280 ZERO DC 0 SET THE CONSTANTS LSF07290 ONE DC 1 LSF07300 TWO DC 2 LSF07310 THREE DC 3 LSF07320 FOUR DC 4 LSF07330 NINE DC 9 LSF07340 TEN DC 10 LSF07350 FX11 DC 11 LSF07360 TWELV DC 12 LSF07370 FX55 DC 55 LSF07380 FXD80 DC 80 LSF07390 NEG1 DC -1 LSF07400 NEG2 DC -2 LSF07410 FZERO DEC 0. LSF07420 FONE DEC 1. LSF07430 TENG4 DEC 1.0E-4 LSF07440 FTEN DEC 10. LSF07450 FL100 DEC 100. LSF07460 IX DC 0 EXPONENTS OF X FOR LSF07470 DC 1 EACH TERM IN A POWER LSF07480 DC 0 SERIES LSF07490 DC 2 LSF07500 DC 1 LSF07510 DC 0 LSF07520 DC 3 LSF07530 DC 2 LSF07540 DC 1 LSF07550 DC 0 LSF07560 DC 4 LSF07570 DC 3 LSF07580 DC 2 LSF07590 DC 1 LSF07600 DC 0 LSF07610 DC 5 LSF07620 DC 4 LSF07630 DC 3 LSF07640 DC 2 LSF07650 DC 1 LSF07660 DC 0 LSF07670 DC 6 LSF07680 DC 5 LSF07690 DC 4 LSF07700 DC 3 LSF07710 DC 2 LSF07720 DC 1 LSF07730 DC 0 LSF07740 DC 7 LSF07750 DC 6 LSF07760 DC 5 LSF07770 DC 4 LSF07780 DC 3 LSF07790 DC 2 LSF07800 DC 1 LSF07810 DC 0 LSF07820 IY DC 0 EXPONENTS OF Y FOR LSF07830 DC 0 EACH TERM IN A POWER LSF07840 DC 1 SERIES LSF07850 DC 0 LSF07860 DC 1 LSF07870 DC 2 LSF07880 DC 0 LSF07890 DC 1 LSF07900 DC 2 LSF07910 DC 3 LSF07920 DC 0 LSF07930 DC 1 LSF07940 DC 2 LSF07950 DC 3 LSF07960 DC 4 LSF07970 DC 0 LSF07980 DC 1 LSF07990 DC 2 LSF08000 DC 3 LSF08010 DC 4 LSF08020 DC 5 LSF08030 DC 0 LSF08040 DC 1 LSF08050 DC 2 LSF08060 DC 3 LSF08070 DC 4 LSF08080 DC 5 LSF08090 DC 6 LSF08100 DC 0 LSF08110 DC 1 LSF08120 DC 2 LSF08130 DC 3 LSF08140 DC 4 LSF08150 DC 5 LSF08160 DC 6 LSF08170 DC 7 LSF08180 *************** LSF08190 * ALLOCATE STORAGE LSF08200 *************** LSF08210 DSKOT DC 320 LSF08220 DC 1599 LSF08230 S BSS E 240 SUMMATIONS OF Q TERMS LSF08240 SZ BSS E 72 SUMMATIONS OF Z*Q LSF08250 ZSQSU BSS E 2 LSF08260 M BSS 1 NUMBER OF SZ TERMS LSF08270 A BSS E 72 VALUES OF A COEFF LSF08280 C BSS E 72 VALUES OF C COEFF LSF08290 NPWER BSS 1 MAX POWER OF TERMS LSF08300 DPWER BSS 1 DOUBLE VALUE OF NPWER LSF08310 MN BSS 1 MAX Q POWER NEEDED LSF08320 MM BSS 1 NUMBER OF S TERMS LSF08330 DUM BSS 1 DUMMY LOCATION LSF08340 IDATA BSS 1 TYPE OF INPUT DATA LSF08350 XMAX BSS E 2 MAXIMUM VALUE FOR X LSF08360 XMIN BSS E 2 MINIMUM VALUE FOR X LSF08370 YMAX BSS E 2 MAXIMUM VALUE FOR Y LSF08380 YMIN BSS E 2 MINIMUM VALUE FOR Y LSF08390 X BSS E 2 CURRENT VALUE OF X LSF08400 Y BSS E 2 CURRENT VALUE OF Y LSF08410 MXCOL BSS 1 MAX NUMBER OF COLUMNS LSF08420 MXROW BSS 1 MAX NUMBER OF ROWS LSF08430 XPDIV BSS E 2 RECIPROCAL,MXCOL-1. LSF08440 YPDIV BSS E 2 RECIPROCAL,MXROW-1. LSF08450 JP BSS 1 ONE LESS THAN IBEG LSF08460 ICOL BSS 1 COLUMN NUMBER LSF08470 Z BSS E 2 CURRENT VALUE OF Z LSF08480 QQ BSS E 2 LAST VALUE OF Q LSF08490 QA BSS E 2 NEXT TO LAST Q VALUE LSF08500 K BSS 1 INDEX OF S,SZ TERMS LSF08510 LL BSS 1 ORDER OF S,SZ TERMS LSF08520 L BSS 1 LOCATION INDEX FOR Q LSF08530 Q BSS E 34 LAST SET OF Z VALUES LSF08540 LCD BSS 1 LAST CARD INDICATION LSF08550 IBCOL BSS 1 INDEX OF COLUMN OF TR LSF08560 INCC BSS 1 INCREMENT FOR IBCOL LSF08570 INC BSS 1 INCREMENT FOR IND LSF08580 IND BSS 1 SETS INITIAL INDX LSF08590 LOC BSS 1 STORAGE INDEX FOR TR LSF08600 NUM BSS 1 COLUMN NUMBER FOR TR LSF08610 J BSS 1 INDEX FOR LOOPS LSF08620 TRM BSS E 2 PRESENT SUM FOR TR LSF08630 IXX BSS 1 PARTICULAR VALUE OFIX LSF08640 IYY BSS 1 PARTICULAR VALUE OFIY LSF08650 I BSS 1 INDEX FOR LOOPS LSF08660 JPP BSS E 2 DOUBLE VALUE OF JJP LSF08670 IPP BSS 1 SUM OF X,Y EXPONENTS LSF08680 NN BSS 1 LOCATION INDEX FOR S LSF08690 INDX BSS E 2 LOCATION INDEX FOR B LSF08700 ISUB BSS E 2 INDEX OF B GROUPING LSF08710 JSUB BSS E 2 INDEX OF PARTICULAR B LSF08720 JBCOL BSS 1 INDEX OF PARTICLAR TR LSF08730 KSUB BSS 1 LOCATION INDEX FOR B LSF08740 BSUM BSS E 2 SUM OF TERMS FOR B LSF08750 KK BSS 1 INDEX FOR LOOP LSF08760 ITRSB BSS E 2 SUBSCRIPT FOR TR LSF08770 DJBCL BSS E 2 DOUBLE VALUE OF JBCOL LSF08780 INDB BSS 1 LOCATION INDEX FOR B LSF08790 INDA BSS 1 LOCATION INDEX FOR TR LSF08800 INCA BSS 1 INCREMENT FOR INDA LSF08810 ASUM BSS E 2 SUM OF TERMS FOR A LSF08820 DJ BSS E 2 DOUBLE INDEX J VALUE LSF08830 SP BSS E 2 SUM OF TERMS FOR C LSF08840 INDD BSS 1 LOCATION INDEX FOR B LSF08850 BSS E 1 LSF08860 INPTA BSS 45 LSF08870 DUMS BSS 6 LSF08880 GRID BSS E 2 LSF08890 IRBGN BSS 1 LSF08900 IREND BSS 1 LSF08910 BSS E 1 LSF08920 AA BSS 45 LSF08930 DUMM BSS E 6 LSF08940 DUMN BSS 1 LSF08950 QXX BSS 1 LSF08960 DTCNT BSS 1 LSF08970 NONE BSS 1 LSF08980 XRCKD BSS 1 LSF08990 YRCKD BSS 1 LSF09000 ZRCKD BSS 1 LSF09010 REG1 BSS 1 LSF09020 FNDPR BSS 1 LSF09030 FNDEN BSS 1 LSF09040 FFMNB BSS 1 LSF09050 FFMCT BSS 1 LSF09060 FXMNT BSS 1 LSF09070 FXMNR BSS 1 LSF09080 EXPON BSS 1 LSF09090 RESUL BSS E 2 LSF09100 MANT BSS E 2 LSF09110 MANR BSS E 2 LSF09120 EXPT BSS E 2 LSF09130 BINFL BSS E 2 LSF09140 EFORM BSS E 6 LSF09150 EFMAT BSS E 14 LSF09160 BSS E 2 LSF09170 FFMAT BSS E 55 LSF09180 SSZO BSS E 2 LSF09190 SSR BSS E 2 LSF09200 ANAME BSS E 2 LSF09210 BSS E 2 LSF09220 BNAME BSS E 4 LSF09230 DUMY BSS E 2 LSF09240 DIRMX BSS 1 LSF09250 DREND BSS E 2 LSF09260 IFOUN BSS 1 LSF09270 ININX BSS 1 LSF09280 SCLOC BSS 1 LSF09290 SCINC BSS 1 LSF09300 SCINX BSS 1 LSF09310 SCSTR BSS 1 LSF09320 THCOL BSS 1 LSF09330 ACCSR BSS 1 LSF09340 FXSSR BSS 1 LSF09350 SRIDX BSS 1 LSF09360 SCRPT BSS 1 LSF09370 SUB2 BSS 1 LSF09380 OUTT BSS 6 LSF09390 TR BSS E 1332 LSF09400 B BSS E 290 LSF09410 IZ BSS E 400 Z VALUES FOR ONE COL LSF09420 WKIO BSS E 642 LSF09430 TYPE BSS 30 LSF09440 END OKA LSF09450 // DUP LSF09460 *STORE WS UA LSFO LSF09470 // JOB SUR00010 // DUP SUR00020 *DELETE SRFIT SUR00030 // ASM SUR00040 *LIST SUR00050 *************** SUR00060 * LEAST SQUARES ORTHOGONAL POLYNOMIALS SUR00070 *************** SUR00080 GO LIBF WRTY0 SUR00090 DC /2000 SUR00100 DC CONTL SUR00110 BSI L ERTYP TYPE BEGINNING SRFIT SUR00120 DC MSAG1 SUR00130 LDD L FZERO SUR00140 STD L ZSQSU SUR00150 LD L FX300 SUR00160 STO L DTCNT SUR00170 LD L ZERO SET END OF DATA SET SUR00180 STO L NONE FLAG OFF SUR00190 BSI L INPT1 INPUT IDATA AND NPWER SUR00200 LD L ONE SUR00210 STO L THCOL SUR00220 LD L NPWER CALCULATE THE NUMBERS SUR00230 A L NPWER OF THE DIFFERENT SUR00240 STO L DPWER TYPES OF TERMS THAT SUR00250 A L ONE HAVE TO BE SUR00260 STO L MN ACCUMULATED SUR00270 LD L NPWER SUR00280 A L ONE SUR00290 STO L DUM SUR00300 A L ONE SUR00310 M L DUM SUR00320 D L TWO SUR00330 STO L M SUR00340 LD L MN SUR00350 A L ONE SUR00360 M L MN SUR00370 D L ONE SUR00380 STO L MM SUR00390 LDX I1 MM SET EACH OF THE SUR00400 LDD L FZERO ACCUMULATED S TERMS SUR00410 STD L1 S-2 TO ZERO INITIALLY SUR00420 MDX 1 -2 SUR00430 MDX *-4 SUR00440 LD L M SUR00450 A L M SUR00460 STO L DUM SUR00470 LDX I1 DUM SET EACH OF THE SUR00480 LDD L FZERO ACCUMULATED SZ TERMS SUR00490 STD L1 SZ-2 TO ZERO INITIALLY SUR00500 MDX 1 -2 SUR00510 MDX *-4 SUR00520 LD L IDATA SELECT PROPER INPUT SUR00530 S L ONE ROUTINE FOR THE TYPE SUR00540 BSC L DATAC,-Z OF DATA SUPPLIED SUR00550 DATAA BSI L HEADN INPUT DATA OF THE SUR00560 LIBF FLD TYPE WHICH SPECIFIES SUR00570 DC XMAX THE LIMITS ON X AND SUR00580 LIBF FSUB Y. THE FIRST CARD SUR00590 DC XMIN GIVES XMIN,XMAX,YMIN SUR00600 LIBF FDVR AND YMAX. USE THESE SUR00610 DC FONE TO DETERMINE THE SUR00620 LIBF FSTO SCALING FACTORS SUR00630 DC XPDIV FOR X AND Y SUR00640 LIBF FLD SUR00650 DC YMAX SUR00660 LIBF FSUB SUR00670 DC YMIN SUR00680 LIBF FDVR SUR00690 DC FONE SUR00700 LIBF FSTO SUR00710 DC YPDIV SUR00720 BSI L ERTYP SUR00730 DC MSAGD SUR00740 DATAB BSI L DATRD GET A GRID POINT SUR00750 LD L NONE IS THIS POINT THE SUR00760 BSC L OKA,Z TRAILER RECORD SUR00770 LIBF FLD CHECK TO SEE IF Z SUR00780 DC Z IS A ZNIL VALUE AND SUR00790 LIBF FSUB IGNORE THE POINT SUR00800 DC ZNIL IF IT IS SUR00810 LIBF FSTO SUR00820 DC RESUL SUR00830 LD L RESUL SUR00840 BSC L DATAB,+- SUR00850 LIBF FLD CHECK TO SEE IF SUR00860 DC X X IS LESS THAN SUR00870 LIBF FSUB XMIN AND IGNORE SUR00880 DC XMIN THE POINT IF IT IS SUR00890 LIBF FSTO SUR00900 DC RESUL SUR00910 LD L RESUL SUR00920 BSC L DATAB,Z+ SUR00930 LIBF FLD CHECK TO SEE IF SUR00940 DC X X IS GREATER THAN SUR00950 LIBF FSUB XMAX AND IGNORE SUR00960 DC XMAX THE REMAINING DATA SUR00970 LIBF FSTO POINTS IF IT IS SUR00980 DC RESUL SUR00990 LD L RESUL SUR01000 BSC L DATAB,Z- SUR01010 LIBF FLD CHECK TO SEE IF SUR01020 DC Y Y IS LESS THAN SUR01030 LIBF FSUB YMIN AND IGNORE SUR01040 DC YMIN THE POINT IF IT IS SUR01050 LIBF FSTO SUR01060 DC RESUL SUR01070 LD L RESUL SUR01080 BSC L DATAB,Z+ SUR01090 LIBF FLD CHECK TO SEE IF SUR01100 DC Y Y IS GREATER THAN SUR01110 LIBF FSUB YMAX AND IGNORE SUR01120 DC YMAX THE POINT IF IT IS SUR01130 LIBF FSTO SUR01140 DC RESUL SUR01150 LD L RESUL SUR01160 BSC L DATAB,Z- SUR01170 LIBF FLD SUR01180 DC X EACH POINT HAS A SUR01190 LIBF FSUB VALUE FOR X,Y,AND Z SUR01200 DC XMIN USE THE MINIMUM SUR01210 LIBF FMPY VALUES AND THE SUR01220 DC XPDIV SCALING FACTORS TO SUR01230 LIBF FSTO DETERMINE THE ACTUAL SUR01240 DC X VALUES FOR X AND Y SUR01250 LIBF FLD SUR01260 DC Y SUR01270 LIBF FSUB SUR01280 DC YMIN SUR01290 LIBF FMPY SUR01300 DC YPDIV SUR01310 LIBF FSTO SUR01320 DC Y SUR01330 BSC L SUMMS SUR01340 DATAC BSI L NAME INPUT GRID NAME SUR01350 LD L ANAME SUR01360 STO L MSAG2+9 SUR01370 LD L ANAME+1 SUR01380 STO L MSAG2+10 SUR01390 BSI L ERTYP TYPE GRID NAME SUR01400 DC MSAG2 SUR01410 BSI L LOCAT SUR01420 LD L IFOUN SUR01430 BSC L OKK,Z SUR01440 BSI L ERTYP SUR01450 DC MSAGC SUR01460 BSI L ERTYP SUR01470 DC MSAGB SUR01480 WAIT SUR01490 EXIT INPUT DATA OF THE SUR01500 OKK LD L MXCOL ALTERNATE TYPE SUR01510 S L ONE WHICH SPECIFIED THE SUR01520 LIBF FLOAT MAXIMUM NUMBER OF SUR01530 LIBF FDVR COLUMNS AND ROWS. SUR01540 DC FONE SUR01550 LIBF FSTO DETERMINE THE SUR01560 DC XPDIV SCALING FACTORS SUR01570 LD L MXROW FOR X AND Y. SUR01580 S L ONE SUR01590 LIBF FLOAT SUR01600 LIBF FDVR SUR01610 DC FONE SUR01620 LIBF FSTO SUR01630 DC YPDIV SUR01640 DATAD BSI L GRDVA INPUT THE GRID VALUES SUR01650 LD L IRBGN ONE SET AT A TIME SUR01660 S L ONE EACH SET GIVES SUR01670 STO L JP THE COLUMN NUMBER, SUR01680 LD L ICOL THE BEGINNING AND SUR01690 S L ONE ENDING ROWS AND THE SUR01700 LIBF FLOAT GRID VALUES FOR THAT SUR01710 LIBF FMPY ROW. USE THE COLUMN SUR01720 DC XPDIV NUMBER TO DETERMINE SUR01730 LIBF FSTO THE VALUE OF X SUR01740 DC X FOR THAT COLUMN. SUR01750 DATAE LD L JP DETERMINE THE VALUE SUR01760 A L ONE OF Y FOR EACH ROW SUR01770 STO L JP AND IDENTIFY THE SUR01780 S L ONE CORRESPONDING VALUE SUR01790 LIBF FLOAT OF IZ. SUR01800 LIBF FMPY SUR01810 DC YPDIV SUR01820 LIBF FSTO SUR01830 DC Y SUR01840 LD L JP SUR01850 A L JP SUR01860 STO L DUM SUR01870 LDX I1 DUM SUR01880 LIBF FLDX SUR01890 DC IZ-2 SUR01900 LIBF FSTO SUR01910 DC Z SUR01920 LIBF FSUB CHECK TO SEE IF Z SUR01930 DC ZNIL IS A ZNIL VALUE AND SUR01940 LIBF FSTO IGNORE THE POINT SUR01950 DC RESUL IF IT IS SUR01960 LD L RESUL SUR01970 BSC L NILEQ,+- SUR01980 SUMMS LD L ONE SUR01990 STO L K SUR02000 LIBF FLD SUR02010 DC Z SUR02020 LIBF FMPY SUR02030 DC Z SUR02040 LIBF FADD SUR02050 DC ZSQSU SUR02060 LIBF FSTO SUR02070 DC ZSQSU SUR02080 LDD L FONE INITIALIZE THE VALUE SUR02090 STD L Q OF Q SUR02100 LIBF FLD ACCUMULATE THE SUM SUR02110 DC S OF THE S(0) TERMS SUR02120 LIBF FADD SUR02130 DC FONE SUR02140 LIBF FSTO SUR02150 DC S SUR02160 LIBF FLD ACCUMULATE THE SUM SUR02170 DC SZ OF THE S(0) TERMS SUR02180 LIBF FADD SUR02190 DC Z SUR02200 LIBF FSTO SUR02210 DC SZ SUR02220 LD L ONE SUR02230 STO L LL SUR02240 RTN1 LD L ONE SET THE ORDER OF SUR02250 STO L L THE TERMS THAT ARE SUR02260 RTN2 LD L K TO BE CALCULATED SUR02270 A L ONE CALCULATE THE FIRST SUR02280 STO L K LL TERMS OF THE SUR02290 LD L L LL TH ORDER AND ADD SUR02300 A L L EACH TERM TO ITS SUR02310 STO L DUM ACCUMULATED VALUE SUR02320 LDX I1 DUM FOR ALL DATA POINTS SUR02330 LIBF FLDX SUR02340 DC Q-2 SUR02350 LIBF FSTO SUR02360 DC QQ SUR02370 LIBF FMPY SUR02380 DC X SUR02390 LIBF FSTOX SUR02400 DC Q-2 SUR02410 LIBF FSTO SUR02420 DC QA SUR02430 LD L K SUR02440 A L K SUR02450 STO L DUM SUR02460 LDX I1 DUM SUR02470 LIBF FADDX SUR02480 DC S-2 SUR02490 LIBF FSTOX SUR02500 DC S-2 SUR02510 LD L L SUR02520 A L ONE SUR02530 STO L J SUR02540 LD L LL CALCULATE THE FIRST SUR02550 S L NPWER NPWER SZ TERMS AND SUR02560 BSC L *+8,-Z ADD EACH TO ITS SUR02570 LIBF FLD ACCUMULATED VALUE SUR02580 DC QA THEN SKIP THIS SUR02590 LIBF FMPY ROUTINE FOR HIGHER SUR02600 DC Z ORDERS SUR02610 LIBF FADDX SUR02620 DC SZ-2 SUR02630 LIBF FSTOX SUR02640 DC SZ-2 SUR02650 LD L L SUR02660 A L ONE SUR02670 STO L L RETURN IF ALL LL SUR02680 S L LL TERMS HAVE NOT BEEN SUR02690 BSC L RTN2,& CALCULATED SUR02700 LD L K CALCULATE THE LAST SUR02710 A L ONE TERM OF THE LL TH SUR02720 STO L K ORDER AND ACCUMULATE SUR02730 LD L J THIS VALUE FOR ALL SUR02740 A L J DATA POINTS SUR02750 STO L DUM SUR02760 LDX I1 DUM SUR02770 LIBF FLD SUR02780 DC QQ SUR02790 LIBF FMPY SUR02800 DC Y SUR02810 LIBF FSTOX SUR02820 DC Q-2 SUR02830 LIBF FSTO SUR02840 DC QA SUR02850 LD L K SUR02860 A L K SUR02870 STO L DUM SUR02880 LDX I1 DUM SUR02890 LIBF FADDX SUR02900 DC S-2 SUR02910 LIBF FSTOX SUR02920 DC S-2 SUR02930 LD L LL CALCULATE THE SZ SUR02940 S L NPWER VALUE IF NEEDED AND SUR02950 BSC L *+8,-Z ADD TO ITS SUR02960 LIBF FLD ACCUMULATED VALUE SUR02970 DC QA SKIP THIS ROUTINE SUR02980 LIBF FMPY FOR ORDERS HIGHER SUR02990 DC Z THAN NPWER SUR03000 LIBF FADDX SUR03010 DC SZ-2 SUR03020 LIBF FSTOX SUR03030 DC SZ-2 SUR03040 LD L LL SUR03050 A L ONE SUR03060 STO L LL RETURN IF ALL ORDERS SUR03070 S L DPWER HAVE NOT BEEN SUR03080 BSC L RTN1,& CALCULATED SUR03090 LD L IDATA IDENTIFY THE TYPE OF SUR03100 S L ONE DATA THAT IS BEING SUR03110 BSC L DATAB,+ SUR03120 NILEQ LD L JP SEE IF THE LAST ROW SUR03130 S L IREND OF THE SECOND TYPE SUR03140 BSC L DATAE,Z& HAS BEEN PROCESSED SUR03150 LD L ICOL SEE IF THE LAST COL SUR03160 S L MXCOL OF THE SECOND TYPE SUR03170 BSC L DATAD,Z& HAS BEEN PROCESSED SUR03180 OKA LIBF DISK1 SUR03190 DC /5000 SUR03200 DC DSKOT SUR03210 DC ERRS SUR03220 LIBF DISK1 SUR03230 DC /4000 SUR03240 DC DSKOT SUR03250 LIBF DISK1 SUR03260 DC /0000 SUR03270 DC DSKOT SUR03280 MDX *-4 SUR03290 LINK LSFO SUR03300 *************** SUR03310 * SUBROUTINE INPT1 FOR LEAST SQUARES SURFACE SUR03320 * FIT SUR03330 *************** SUR03340 INPT1 NOP SUBROUTINE TO SUR03350 LD L TEN READ THE HEADER SUR03360 STO L INPTA CARD WITH IDATA SUR03370 *************** SUR03380 LIBF CARD0 AND NPWER SUR03390 * LIBF READ0 AND NPWER SUR03400 *************** SUR03410 DC /0000 SUR03420 MDX *-3 SUR03430 *************** SUR03440 LIBF CARD0 IF IDATA=1, THEN SUR03450 * LIBF READ0 IF DATA=1, THEN SUR03460 *************** SUR03470 DC /1000 RANDOM DATA POINTS SUR03480 DC INPTA WILL BE USED SUR03490 LD L PLUS IF IDATA=2, THEN SUR03500 STO L DUMS THE GRID VALUES SUR03510 LD L ZERO INDICATED BY ANAME SUR03520 STO L DUMS&1 WILL BE USED SUR03530 STO L DUMS&2 SUR03540 STO L DUMS&3 NPWER SPECIFIES THE SUR03550 STO L DUMS&4 MAXIMUM POWER OF TERMS SUR03560 *************** SUR03570 LIBF CARD0 TO BE USED IN FITTING SUR03580 * LIBF READ0 TO BE USED IN FITTING SUR03590 *************** SUR03600 DC /0000 THE DATA SUR03610 MDX *-3 SUR03620 LD L INPTA&5 SUR03630 STO L DUMS&5 SUR03640 LIBF DCBIN SUR03650 DC DUMS SUR03660 STO L IDATA SUR03670 LD L INPTA&10 SUR03680 STO L DUMS&5 SUR03690 LIBF DCBIN SUR03700 DC DUMS SUR03710 STO L NPWER SUR03720 BSC I INPT1 SUR03730 *************** SUR03740 * NAME SUBROUTINE SUR03750 *************** SUR03760 NAME NOP SUBROUTINE TO SUR03770 LD L FOUR READ THE GRID SUR03780 STO L BNAME-1 NAME FROM A CARD SUR03790 *************** SUR03800 LIBF CARD0 AND CONVERT SUR03810 * LIBF READ0 AND CONVERT SUR03820 *************** SUR03830 DC /1000 TO EBCDIC SUR03840 DC BNAME-1 SUR03850 *************** SUR03860 LIBF CARD0 SUR03870 * LIBF READ0 SUR03880 *************** SUR03890 DC /0000 SUR03900 MDX *-3 SUR03910 LIBF SPEED SUR03920 DC /0000 SUR03930 DC BNAME SUR03940 DC ANAME SUR03950 DC 4 SUR03960 BSC I NAME SUR03970 LOCAT NOP SUBROUTINE TO SUR03980 LD L FX20 SEARCH FOR THE SUR03990 STO L WKIO GRID NAME OR THE SUR04000 LD L SCBGN TRAILER RECORD SUR04010 STO L WKIO+1 IN THE DISK DATA SUR04020 AGN LIBF DISK1 SUR04030 DC /5000 SUR04040 DC WKIO SETS IFOUN TO SUR04050 DC ERRS ONE IF GRID NAME SUR04060 LIBF DISK1 SUR04070 DC /1000 SETS IFOUN TO SUR04080 DC WKIO ZERO IF TRAILER SUR04090 DC ERRS RECORD IS FOUND SUR04100 LIBF DISK1 SUR04110 DC /0000 SUR04120 DC WKIO SUR04130 MDX *-4 SUR04140 LIBF FLD SUR04150 DC TRAIL SUR04160 LIBF FSUB SUR04170 DC WKIO+2 SUR04180 LIBF FSTO SUR04190 DC DUMY SUR04200 LD L DUMY SUR04210 BSC L OK,+- SUR04220 LIBF FLD SUR04230 DC WKIO+2 SUR04240 LIBF FSUB SUR04250 DC ANAME SUR04260 LIBF FSTO SUR04270 DC DUMY SUR04280 LD L DUMY SUR04290 BSC L FND,+- SUR04300 LD L WKIO+6 SUR04310 M L FOUR SUR04320 STD L DUMY SUR04330 D L THREE SUR04340 STO L SCINC SUR04350 M L THREE SUR04360 D L ONE SUR04370 S L DUMY+1 SUR04380 BSC L AA3,- SUR04390 A L FOUR SUR04400 A L SCINC SUR04410 STO L SCINC SUR04420 AA3 LD L WKIO&1 SUR04430 A L SCINC SUR04440 STO L WKIO+1 SUR04450 S L SCBGN SUR04460 BSC L EROB,& SUR04470 S L SCLGT SUR04480 BSC L EROB,- SUR04490 BSC L AGN SUR04500 FND LD L ONE SUR04510 STO L IFOUN SUR04520 LDD L WKIO+4 SUR04530 STD L GRID SUR04540 LD L WKIO+6 SUR04550 STO L MXCOL SUR04560 LD L WKIO+7 SUR04570 STO L MXROW SUR04580 LD L WKIO&1 SUR04590 STO L SCSTR SUR04600 BSC I LOCAT SUR04610 OK LD L ZERO SUR04620 STO L IFOUN SUR04630 LD L WKIO&1 SUR04640 STO L SCSTR SUR04650 BSC I LOCAT SUR04660 ERRS DC 0 SUR04670 LIBF WRTY0 SUR04680 DC /2000 SUR04690 DC MSAG9 SUR04700 SRA 16 SUR04710 BSC I ERRS SUR04720 EROB BSI L ERTYP SUR04730 DC MSAGA SUR04740 BSI L ERTYP SUR04750 DC MSAGB SUR04760 WAIT SUR04770 EXIT SUR04780 *************** SUR04790 * SCCOM SUBROUTINE SUR04800 *************** SUR04810 SCCOM NOP SUBROUTINE TO SUR04820 LD L THCOL COMPUTE THE SUR04830 S L ONE LOCATION OF THE SUR04840 M L ONE SUCCESSIVE SUR04850 D L THREE COLUMNS IN THE SUR04860 STO L DUMY DISK DATA AREA SUR04870 M L FOUR SUR04880 D L ONE SUR04890 STO L SCINC SUR04900 LD L DUMY SUR04910 M L THREE SUR04920 D L ONE SUR04930 STO L DUMY SUR04940 LD L THCOL SUR04950 S L DUMY SUR04960 S L ONE SUR04970 STO L SCINX SUR04980 A L SCINC SUR04990 STO L SCINC SUR05000 A L SCSTR SUR05010 STO L SCLOC SUR05020 S L SCBGN SUR05030 BSC L EROB,Z+ SUR05040 S L SCLGT SUR05050 BSC L EROB,- SUR05060 LD L FX100 SUR05070 M L SCINX SUR05080 D L ONE SUR05090 A L FX22 SUR05100 STO L ININX SUR05110 BSC I SCCOM SUR05120 *************** SUR05130 GRDVA NOP SUBROUTINE TO SUR05140 BSI L SCCOM READ THE GRID SUR05150 LD L SCLOC VALUES FROM THE SUR05160 STO L WKIO&1 DISK DATA AREA SUR05170 LD L FX640 SUR05180 STO L WKIO SUR05190 LIBF DISK1 SUR05200 DC /5000 SUR05210 DC WKIO SUR05220 DC ERRS SUR05230 LIBF DISK1 SUR05240 DC /1000 SUR05250 DC WKIO SUR05260 DC ERRS SUR05270 LD L ININX SUR05280 A L FX418 SUR05290 STO L DUMY SUR05300 LDX I1 DUMY SUR05310 LDX I2 FX400 SUR05320 LIBF DISK1 SUR05330 DC /0000 SUR05340 DC WKIO SUR05350 MDX *-4 SUR05360 LDD L1 WKIO SUR05370 STD L2 IZ-2 SUR05380 MDX 1 -2 SUR05390 MDX 2 -2 SUR05400 MDX *-7 SUR05410 LDX I1 ININX SUR05420 LD L1 WKIO SUR05430 STO L ICOL SUR05440 A L ONE SUR05450 STO L THCOL SUR05460 LD L1 WKIO+1 SUR05470 STO L IRBGN SUR05480 LD L1 WKIO+2 SUR05490 STO L IREND SUR05500 BSC I GRDVA SUR05510 *************** SUR05520 * HEADN SUBROUTINE FOR SRFIT SUR05530 *************** SUR05540 HEADN NOP SUBROUTINE TO SUR05550 LD L FX55 READ CONTROL CARD SUR05560 STO L FFMAT-1 WITH XMIN, XMAX, SUR05570 *************** SUR05580 LIBF CARD0 YMIN, YMAX, AND THE SUR05590 * LIBF READ0 YMIN, YMAX, AND THE SUR05600 *************** SUR05610 DC /1000 RECORD LOCATIONS SUR05620 DC FFMAT-1 OF X, Y, Z IN THE SUR05630 *************** SUR05640 LIBF CARD0 RANDOM DATA SUR05650 * LIBF READ0 RANDOM DATA SUR05660 *************** SUR05670 DC /0000 SUR05680 MDX *-3 SUR05690 BSI L FFORM SUR05700 BSI L CEFBF SUR05710 LDD L BINFL SUR05720 STD L XMIN SUR05730 LDX 2 10 SUR05740 LD L2 FFMAT+9 SUR05750 STO L2 FFMAT-1 SUR05760 MDX 2 -1 SUR05770 MDX *-6 SUR05780 BSI L FFORM SUR05790 BSI L CEFBF SUR05800 LDD L BINFL SUR05810 STD L XMAX SUR05820 LDX 2 10 SUR05830 LD L2 FFMAT+19 SUR05840 STO L2 FFMAT-1 SUR05850 MDX 2 -1 SUR05860 MDX *-6 SUR05870 BSI L FFORM SUR05880 BSI L CEFBF SUR05890 LDD L BINFL SUR05900 STD L YMIN SUR05910 LDX 2 10 SUR05920 LD L2 FFMAT+29 SUR05930 STO L2 FFMAT-1 SUR05940 MDX 2 -1 SUR05950 MDX *-6 SUR05960 BSI L FFORM SUR05970 BSI L CEFBF SUR05980 LDD L BINFL SUR05990 STD L YMAX SUR06000 LD L FFMAT+43 SUR06010 STO L DUMS+4 SUR06020 LD L FFMAT+44 SUR06030 STO L DUMS+5 SUR06040 LIBF DCBIN SUR06050 DC DUMS SUR06060 STO L XRCKD SUR06070 A L XRCKD SUR06080 S L TWO SUR06090 STO L XRCKD SUR06100 LD L FFMAT+48 SUR06110 STO L DUMS+4 SUR06120 LD L FFMAT+49 SUR06130 STO L DUMS+5 SUR06140 LIBF DCBIN SUR06150 DC DUMS SUR06160 STO L YRCKD SUR06170 A L YRCKD SUR06180 S L TWO SUR06190 STO L YRCKD SUR06200 LD L FFMAT+53 SUR06210 STO L DUMS+4 SUR06220 LD L FFMAT+54 SUR06230 STO L DUMS+5 SUR06240 LIBF DCBIN SUR06250 DC DUMS SUR06260 STO L ZRCKD SUR06270 A L ZRCKD SUR06280 S L TWO SUR06290 STO L ZRCKD SUR06300 BSC I HEADN SUR06310 *************** SUR06320 *************** SUR06330 DATRD NOP SUBROUTINE TO SUR06340 LD L DTCNT READ THE X, Y, Z SUR06350 S L FX300 COORDINATES OF SUR06360 BSC L SAME,+Z RANDOM DATA ONE SUR06370 MDX L SCCNT,1 POINT AT A TIME SUR06380 LD L SCCNT SUR06390 STO L WKIO+1 SUR06400 LD L FX300 SUR06410 STO L WKIO SUR06420 LIBF DISK1 SUR06430 DC /5000 SUR06440 DC WKIO SUR06450 DC ERRS SUR06460 LIBF DISK1 SUR06470 DC /1000 SUR06480 DC WKIO SUR06490 DC ERRS SUR06500 LIBF DISK1 SUR06510 DC /0000 SUR06520 DC WKIO SUR06530 MDX *-4 SUR06540 LD L TWO SUR06550 STO L DTCNT SUR06560 SAME LDX I1 DTCNT SUR06570 LIBF FLDX SUR06580 DC WKIO SUR06590 LIBF FSUB SUR06600 DC AZNIL IS THIS THE SUR06610 LIBF FSTO TRAILER RECORD SUR06620 DC RESUL SUR06630 LD L RESUL SUR06640 BSC L SAME1,Z NO, BRANCH SUR06650 LD L ONE YES, SET COMPLETION SUR06660 STO L NONE SWITCH ON SUR06670 BSC L SKPA AND RETURN SUR06680 SAME1 LDX I1 XRCKD PICK UP X, Y, SUR06690 MDX I1 DTCNT AND Z SUR06700 LDD L1 WKIO AND STORE IN SUR06710 STD L X TEMPORARY LOCATION SUR06720 LDX I1 YRCKD SUR06730 MDX I1 DTCNT SUR06740 LDD L1 WKIO SUR06750 STD L Y SUR06760 LDX I1 ZRCKD SUR06770 MDX I1 DTCNT SUR06780 LDD L1 WKIO SUR06790 STD L Z SUR06800 SKPA MDX L DTCNT,30 GO NO TO NEXT SUR06810 BSC I DATRD RECORD SUR06820 *************** SUR06830 * FFORM SUBROUTINE SUR06840 *************** SUR06850 FFORM NOP SUBROUTINE TO SUR06860 LDX 2 14 CONVERT AN F-FORMAT SUR06870 LD L NMZER CARD CODE NUMBER SUR06880 STO L2 EFMAT TO E-FORMAT SUR06890 MDX 2 -1 SET E - FORMAT AREA SUR06900 MDX *-4 TO ZERO CHARS SUR06910 STX L1 REG1 SUR06920 LD L PLUS STORE PLUS, PERIOD, AND SUR06930 STO L EFMAT E IN E - FORMAT WORD SUR06940 LD L PERID SUR06950 STO L EFMAT+1 SUR06960 LD L LTRE SUR06970 STO L EFMAT+10 SUR06980 LD L FX11 SUR06990 STO L FNDPR SUR07000 LDX 1 10 SUR07010 FFRM LD L1 FFMAT-1 TEST FOR SUR07020 BSC L FIND1,+- BLANK OR SUR07030 LD L1 FFMAT-1 PLUS SIGN SUR07040 S L PLUS SUR07050 BSC L FIND1,+- SUR07060 LD L1 FFMAT-1 AMPERS AND SUR07070 S L AMPER SUR07080 BSC L FIND1,+- SUR07090 LD L1 FFMAT-1 MINUS SUR07100 S L MINUS SUR07110 BSC L BCKF,Z SUR07120 LD L MINUS SUR07130 STO L EFMAT SUR07140 BSC L FIND1 SUR07150 BCKF LD L1 FFMAT-1 PERIOD SUR07160 S L PERID SUR07170 BSC L BCKG,Z SUR07180 STX L1 FNDPR SUR07190 BCKG MDX 1 -1 LOOP TEST SUR07200 MDX *+1 SUR07210 MDX *+2 SUR07220 BSC L FFRM TEST ANOTHER CHARACTER SUR07230 FIND1 STX L1 FNDEN CALCUATE AND STORE SUR07240 LD L FNDPR EXPONENT SUR07250 S L FNDEN SUR07260 S L ONE SUR07270 LIBF BINDC SUR07280 DC EFORM SUR07290 LD L EFORM SUR07300 STO L EFMAT+11 SUR07310 LD L EFORM+4 SUR07320 STO L EFMAT+12 SUR07330 LD L EFORM+5 SUR07340 STO L EFMAT+13 SUR07350 LD L TEN IS HIGH ORDER CHAR SUR07360 S L FNDEN IN RIGHTMOST POS SUR07370 BSC L FIND4,+ YES, BRANCH SUR07380 STO L FFMNB NO, STORE COUNT OF SUR07390 MDX 1 1 CHARS TO BE MOVED SUR07400 LD L1 FFMAT-1 LOAD SIGNIFICANT DIGIT SUR07410 STO L EFMAT+2 OF F-FORM TO EFORM SUR07420 LD L ONE MANTISSA SUR07430 STO L FFMCT SUR07440 S L FFMNB TEST FOR SINGLE DIGIT SUR07450 BSC L ONWD,- IN F-FORMAT SUR07460 LDX 2 0 YES, BRANCH SUR07470 BCKH MDX 2 1 NO, MOVE DIGIT TO SUR07480 BCKJ MDX 1 1 E-FORMAT MANTISSA SUR07490 MDX L FFMCT,+1 SUR07500 LD L1 FFMAT-1 TEST FOR PERIOD SUR07510 S L PERID SUR07520 BSC L BCKI,+- SUR07530 LD L1 FFMAT-1 SUR07540 STO L2 EFMAT+2 SUR07550 LD L FFMCT SUR07560 S L FFMNB SUR07570 BSC L BCKH,+Z SUR07580 LDX I1 REG1 SUR07590 BSC I FFORM RETURN SUR07600 FIND4 LD L NMZER STORE 0 IN TENS POS SUR07610 STO L EFMAT+13 OF EXPONENT SUR07620 ONWD LDX I1 REG1 SUR07630 BSC I FFORM SUR07640 BCKI LD L FFMCT ARE ALL CHARS MOVED SUR07650 S L FFMNB SUR07660 BSC L BCKJ,+Z NO, BRANCH SUR07670 LDX I1 REG1 SUR07680 BSC I FFORM SUR07690 *************** SUR07700 * CEFBF SUBROUTINE SUR07710 *************** SUR07720 CEFBF NOP SUBROUTINE TO SUR07730 LD L EFMAT TO CONVERT A CARD SUR07740 S L PLUS CODE E-FORMAT SUR07750 BSC L NXTA,&- NUMBER TO BINARY SUR07760 LD L EFMAT FLOATING POINT SUR07770 S L AMPER TEST FOR SUR07780 BSC L NXTA,&- FORMAT ERRORS SUR07790 LD L EFMAT SUR07800 S L MINUS SUR07810 BSC L NXTA,&- SUR07820 LD L EFMAT SUR07830 BSC L ERROR,Z SUR07840 NXTA LD L EFMAT+1 SUR07850 S L PERID SUR07860 BSC L ERROR,Z SUR07870 LD L EFMAT+10 SUR07880 S L LTRE SUR07890 BSC L ERROR,Z SUR07900 LD L EFMAT+11 SUR07910 S L PLUS SUR07920 BSC L NXTB,&- SUR07930 LD L EFMAT+11 SUR07940 S L AMPER SUR07950 BSC L NXTB,&- SUR07960 LD L EFMAT+11 SUR07970 S L MINUS SUR07980 BSC L NXTB,&- SUR07990 LD L EFMAT+11 SUR08000 BSC L ERROR,Z SUR08010 NXTB LD L EFMAT CONVERT HIGH ORDER DIGS SUR08020 STO L EFORM TO BINARY AND THEN SUR08030 LD L ZERO TO FLOATING POINT SUR08040 STO L EFORM&1 SUR08050 LD L EFMAT+2 SUR08060 STO L EFORM&2 SUR08070 LD L EFMAT+3 SUR08080 STO L EFORM&3 SUR08090 LD L EFMAT+4 SUR08100 STO L EFORM&4 SUR08110 LD L EFMAT+5 SUR08120 STO L EFORM&5 SUR08130 LIBF DCBIN SUR08140 DC EFORM SUR08150 STO L FXMNT SUR08160 LIBF FLOAT SUR08170 LIBF FSTO SUR08180 DC MANT SUR08190 LD L ZERO CONVERT LOW ORDER SUR08200 STO L EFORM&1 DIGITS TO BINARY SUR08210 LD L EFMAT+6 AND THEN TO SUR08220 STO L EFORM&2 FLOATING POINT SUR08230 LD L EFMAT+7 SUR08240 STO L EFORM&3 SUR08250 LD L EFMAT+8 SUR08260 STO L EFORM&4 SUR08270 LD L EFMAT+9 SUR08280 STO L EFORM&5 SUR08290 LIBF DCBIN SUR08300 DC EFORM SUR08310 STO L FXMNR SUR08320 LIBF FLOAT SUR08330 LIBF FSTO SUR08340 DC MANR SUR08350 LD L FXMNT ARE HIGH ORDER DIGITS SUR08360 BSC L *&4,Z ZERO SUR08370 LD L FXMNR NO, CALCULATE SUR08380 BSC L ALTER,&- CHARACTERISTIC SUR08390 LD L EFMAT+11 YES, ARE LOW ORDER SUR08400 STO L EFORM DIGITS ZERO SUR08410 LD L ZERO YES, GO TO ALTER SUR08420 STO L EFORM&1 NO, CONVERT EXPONENT SUR08430 STO L EFORM&2 TO BINARY SUR08440 STO L EFORM&3 COMBINE THE TWO SUR08450 LD L EFMAT+12 NUMBERS AND ADJUST SUR08460 STO L EFORM&4 CHARACTERISTIC SUR08470 LD L EFMAT+13 SUR08480 STO L EFORM&5 SUR08490 LIBF DCBIN SUR08500 DC EFORM SUR08510 STO L EXPON SUR08520 LIBF FLD SUR08530 DC FTEN SUR08540 LIBF FAXI SUR08550 DC EXPON SUR08560 LIBF FSTO SUR08570 DC EXPT SUR08580 LIBF FLD SUR08590 DC MANR SUR08600 LIBF FMPY SUR08610 DC TENG4 SUR08620 LIBF FADD SUR08630 DC MANT SUR08640 LIBF FMPY SUR08650 DC TENG4 SUR08660 LIBF FMPY SUR08670 DC EXPT SUR08680 LIBF FSTO SUR08690 DC BINFL SUR08700 BSC I CEFBF RETURN SUR08710 ALTER LDD L FZERO SET VALUE TO SUR08720 STD L BINFL FLOATING POINT ZERO SUR08730 BSC I CEFBF RETURN SUR08740 ERROR MDX ALTER SET VALUE TO ZERO SUR08750 *************** SUR08760 * ERTYP SUBROUTINE SUR08770 *************** SUR08780 ERTYP NOP SUBROUTINE TO SUR08790 LD I ERTYP WRITE MESSAGES SUR08800 STO L ERTX ON THE CONSOLE SUR08810 MDX L ERTYP,&1 TYPEWRITER SUR08820 LD L ERTX SUR08830 S L ONE SUR08840 STO *&1 SUR08850 LD L 0 SUR08860 STO L ERTX+2 SUR08870 M L ONE SUR08880 D L TWO SUR08890 STO L TYPE SUR08900 LIBF EBPRT SUR08910 DC /0000 SUR08920 ERTX DC 0 SUR08930 DC TYPE+1 SUR08940 DC 0 SUR08950 LIBF WRTY0 SUR08960 DC /2000 SUR08970 DC TYPE SUR08980 LIBF WRTY0 SUR08990 DC /2000 SUR09000 DC CONTL SUR09010 LIBF WRTY0 SUR09020 DC /0000 SUR09030 MDX *-3 SUR09040 BSC I ERTYP SUR09050 *************** SUR09060 * DEFINE ERROR MESAGES SUR09070 *************** SUR09080 DC 16 SUR09090 MSAG1 EBC .SRFIT BEGINNING . SUR09100 DC 22 SUR09110 MSAG2 EBC .INPUT GRID NAMED . SUR09120 DC /4040 SUR09130 DC /4040 SUR09140 DC 16 SUR09150 MSAG3 EBC .SRFIT COMPLETED . SUR09160 DC 30 SUR09170 MSAG4 EBC . SUM OF SQUARES REDUCTION . SUR09180 DC 34 SUR09190 MSAG5 EBC . TERM PERCENT ACCUMULATED. SUR09200 DC 32 SUR09210 MSAG6 EBC .NUMBER CONTRIBUTION PERCENT. SUR09220 DC 2 SUR09230 MSAG7 EBC . . SUR09240 DC 30 SUR09250 MSAG8 EBC . 01 00 00. SUR09260 MSAG9 DC 20 DISK ERROR MESSAGE SUR09270 DC /3020 SUR09280 DC /9858 SUR09290 DC /2135 SUR09300 DC /6060 SUR09310 DC /5060 SUR09320 DC /2121 SUR09330 DC /9C34 SUR09340 DC /6070 SUR09350 DC /2074 SUR09360 DC /3C9C SUR09370 DC /3421 SUR09380 DC /7C50 SUR09390 DC /1821 SUR09400 DC /3C74 SUR09410 DC /3021 SUR09420 DC /6034 SUR09430 DC /989C SUR09440 DC /3C60 SUR09450 DC /9C21 SUR09460 DC /8103 SUR09470 DC 30 SUR09480 MSAGA EBC .UNABLE TO FIND TRAILER RECORD . SUR09490 DC 30 SUR09500 MSAGB EBC .PUSH START FOR EXIT TO MONITOR. SUR09510 DC 22 SUR09520 MSAGC EBC .NAME NOT FOUND ON DISK. SUR09530 DC 18 SUR09540 MSAGD EBC .RANDOM DATA INPUT . SUR09550 DC 38 SUR09560 MSAGE EBC .PLACE BLANK CARDS IN HOPPER . SUR09570 EBC .PUSH START. SUR09580 CONTL DC 1 SUR09590 DC /8105 SUR09600 *************** SUR09610 * DEFINE CONSTANTS SUR09620 *************** SUR09630 SCBGN DC 448 SUR09640 SCLGT DC 808 SUR09650 SCCNT DC 287 SUR09660 EBPER DC /004B SUR09670 FX43 DC 43 SUR09680 ADDRA DC A SUR09690 ADDRB DC B SUR09700 ADDRC DC C SUR09710 ALTRA DC LTRA SUR09720 ALTRC DC LTRC SUR09730 FX19 DC 19 SUR09740 FX20 DC 20 SUR09750 FX22 DC 22 SUR09760 FX100 DC 100 SUR09770 FX272 DC 272 SUR09780 FX280 DC 280 SUR09790 FX300 DC 300 SUR09800 FX400 DC 400 SUR09810 FX402 DC 402 SUR09820 FX418 DC 418 SUR09830 FX420 DC 420 SUR09840 FX422 DC 422 SUR09850 FX640 DC 640 SUR09860 FX808 DC 808 SUR09870 ZNIL DEC -1.0E30 SUR09880 AZNIL DEC 1.0E30 SUR09890 TRAIL DEC 9999. SUR09900 PLUS DC /80A0 SUR09910 NMZER DC /2000 SUR09920 LFTPR DC /8120 SUR09930 RGTPR DC /4120 SUR09940 EBEQU DC /00A0 SUR09950 COMMA DC /2420 SUR09960 LTRA DC /9000 SUR09970 LTRB DC /8800 SUR09980 LTRC DC /8400 SUR09990 LTRE DC /8100 SUR10000 AMPER DC /8000 SUR10010 MINUS DC /4000 SUR10020 PERID DC /8420 SUR10030 ZERO DC 0 SET THE CONSTANTS SUR10040 ONE DC 1 SUR10050 TWO DC 2 SUR10060 THREE DC 3 SUR10070 FOUR DC 4 SUR10080 NINE DC 9 SUR10090 TEN DC 10 SUR10100 FX11 DC 11 SUR10110 TWELV DC 12 SUR10120 FX55 DC 55 SUR10130 FXD80 DC 80 SUR10140 NEG1 DC -1 SUR10150 NEG2 DC -2 SUR10160 FZERO DEC 0. SUR10170 FONE DEC 1. SUR10180 TENG4 DEC 1.0E-4 SUR10190 FTEN DEC 10. SUR10200 FL100 DEC 100. SUR10210 IX DC 0 EXPONENTS OF X FOR SUR10220 DC 1 EACH TERM IN A POWER SUR10230 DC 0 SERIES SUR10240 DC 2 SUR10250 DC 1 SUR10260 DC 0 SUR10270 DC 3 SUR10280 DC 2 SUR10290 DC 1 SUR10300 DC 0 SUR10310 DC 4 SUR10320 DC 3 SUR10330 DC 2 SUR10340 DC 1 SUR10350 DC 0 SUR10360 DC 5 SUR10370 DC 4 SUR10380 DC 3 SUR10390 DC 2 SUR10400 DC 1 SUR10410 DC 0 SUR10420 DC 6 SUR10430 DC 5 SUR10440 DC 4 SUR10450 DC 3 SUR10460 DC 2 SUR10470 DC 1 SUR10480 DC 0 SUR10490 DC 7 SUR10500 DC 6 SUR10510 DC 5 SUR10520 DC 4 SUR10530 DC 3 SUR10540 DC 2 SUR10550 DC 1 SUR10560 DC 0 SUR10570 IY DC 0 EXPONENTS OF Y FOR SUR10580 DC 0 EACH TERM IN A POWER SUR10590 DC 1 SERIES SUR10600 DC 0 SUR10610 DC 1 SUR10620 DC 2 SUR10630 DC 0 SUR10640 DC 1 SUR10650 DC 2 SUR10660 DC 3 SUR10670 DC 0 SUR10680 DC 1 SUR10690 DC 2 SUR10700 DC 3 SUR10710 DC 4 SUR10720 DC 0 SUR10730 DC 1 SUR10740 DC 2 SUR10750 DC 3 SUR10760 DC 4 SUR10770 DC 5 SUR10780 DC 0 SUR10790 DC 1 SUR10800 DC 2 SUR10810 DC 3 SUR10820 DC 4 SUR10830 DC 5 SUR10840 DC 6 SUR10850 DC 0 SUR10860 DC 1 SUR10870 DC 2 SUR10880 DC 3 SUR10890 DC 4 SUR10900 DC 5 SUR10910 DC 6 SUR10920 DC 7 SUR10930 *************** SUR10940 * ALLOCATE STORAGE SUR10950 *************** SUR10960 DSKOT DC 320 SUR10970 DC 1599 SUR10980 S BSS E 240 SUMMATIONS OF Q TERMS SUR10990 SZ BSS E 72 SUMMATIONS OF Z*Q SUR11000 ZSQSU BSS E 2 SUR11010 M BSS 1 NUMBER OF SZ TERMS SUR11020 A BSS E 72 VALUES OF A COEFF SUR11030 C BSS E 72 VALUES OF C COEFF SUR11040 NPWER BSS 1 MAX POWER OF TERMS SUR11050 DPWER BSS 1 DOUBLE VALUE OF NPWER SUR11060 MN BSS 1 MAX Q POWER NEEDED SUR11070 MM BSS 1 NUMBER OF S TERMS SUR11080 DUM BSS 1 DUMMY LOCATION SUR11090 IDATA BSS 1 TYPE OF INPUT DATA SUR11100 XMAX BSS E 2 MAXIMUM VALUE FOR X SUR11110 XMIN BSS E 2 MINIMUM VALUE FOR X SUR11120 YMAX BSS E 2 MAXIMUM VALUE FOR Y SUR11130 YMIN BSS E 2 MINIMUM VALUE FOR Y SUR11140 X BSS E 2 CURRENT VALUE OF X SUR11150 Y BSS E 2 CURRENT VALUE OF Y SUR11160 MXCOL BSS 1 MAX NUMBER OF COLUMNS SUR11170 MXROW BSS 1 MAX NUMBER OF ROWS SUR11180 XPDIV BSS E 2 RECIPROCAL,MXCOL-1. SUR11190 YPDIV BSS E 2 RECIPROCAL,MXROW-1. SUR11200 JP BSS 1 ONE LESS THAN IBEG SUR11210 ICOL BSS 1 COLUMN NUMBER SUR11220 Z BSS E 2 CURRENT VALUE OF Z SUR11230 QQ BSS E 2 LAST VALUE OF Q SUR11240 QA BSS E 2 NEXT TO LAST Q VALUE SUR11250 K BSS 1 INDEX OF S,SZ TERMS SUR11260 LL BSS 1 ORDER OF S,SZ TERMS SUR11270 L BSS 1 LOCATION INDEX FOR Q SUR11280 Q BSS E 34 LAST SET OF Z VALUES SUR11290 LCD BSS 1 LAST CARD INDICATION SUR11300 IBCOL BSS 1 INDEX OF COLUMN OF TR SUR11310 INCC BSS 1 INCREMENT FOR IBCOL SUR11320 INC BSS 1 INCREMENT FOR IND SUR11330 IND BSS 1 SETS INITIAL INDX SUR11340 LOC BSS 1 STORAGE INDEX FOR TR SUR11350 NUM BSS 1 COLUMN NUMBER FOR TR SUR11360 J BSS 1 INDEX FOR LOOPS SUR11370 TRM BSS E 2 PRESENT SUM FOR TR SUR11380 IXX BSS 1 PARTICULAR VALUE OFIX SUR11390 IYY BSS 1 PARTICULAR VALUE OFIY SUR11400 I BSS 1 INDEX FOR LOOPS SUR11410 JPP BSS E 2 DOUBLE VALUE OF JJP SUR11420 IPP BSS 1 SUM OF X,Y EXPONENTS SUR11430 NN BSS 1 LOCATION INDEX FOR S SUR11440 INDX BSS E 2 LOCATION INDEX FOR B SUR11450 ISUB BSS E 2 INDEX OF B GROUPING SUR11460 JSUB BSS E 2 INDEX OF PARTICULAR B SUR11470 JBCOL BSS 1 INDEX OF PARTICLAR TR SUR11480 KSUB BSS 1 LOCATION INDEX FOR B SUR11490 BSUM BSS E 2 SUM OF TERMS FOR B SUR11500 KK BSS 1 INDEX FOR LOOP SUR11510 ITRSB BSS E 2 SUBSCRIPT FOR TR SUR11520 DJBCL BSS E 2 DOUBLE VALUE OF JBCOL SUR11530 INDB BSS 1 LOCATION INDEX FOR B SUR11540 INDA BSS 1 LOCATION INDEX FOR TR SUR11550 INCA BSS 1 INCREMENT FOR INDA SUR11560 ASUM BSS E 2 SUM OF TERMS FOR A SUR11570 DJ BSS E 2 DOUBLE INDEX J VALUE SUR11580 SP BSS E 2 SUM OF TERMS FOR C SUR11590 INDD BSS 1 LOCATION INDEX FOR B SUR11600 BSS E 1 ALIGNMENT SUR11610 INPTA BSS 45 INPUT AREA SUR11620 DUMS BSS 6 TEMPORARY STORAGE SUR11630 GRID BSS E 2 GRID INTERVAL SUR11640 IRBGN BSS 1 BEGINNING SUR11650 IREND BSS 1 ENDING ROW SUR11660 BSS E 1 NO. OF CARD COLS. SUR11670 AA BSS 45 INPUT AREA SUR11680 DUMM BSS E 6 TEMPORARY STORAGE SUR11690 DUMN BSS 1 INDEXING SUR11700 QXX BSS 1 PARAMETERS SUR11710 DTCNT BSS 1 SUR11720 NONE BSS 1 END DATA SET FLAG SUR11730 XRCKD BSS 1 SUR11740 YRCKD BSS 1 SUR11750 ZRCKD BSS 1 SUR11760 REG1 BSS 1 SUR11770 FNDPR BSS 1 SUR11780 FNDEN BSS 1 SUR11790 FFMNB BSS 1 SUR11800 FFMCT BSS 1 SUR11810 FXMNT BSS 1 SUR11820 FXMNR BSS 1 SUR11830 EXPON BSS 1 SUR11840 RESUL BSS E 2 TEMPORARY SUR11850 MANT BSS E 2 CONVERSION SUR11860 MANR BSS E 2 RESULTS SUR11870 EXPT BSS E 2 SUR11880 BINFL BSS E 2 SUR11890 EFORM BSS E 6 SUR11900 EFMAT BSS E 14 CONVERSION AREA SUR11910 BSS E 2 ALIGNMENT SUR11920 FFMAT BSS E 55 CONVERSION AREA SUR11930 SSZO BSS E 2 SUR11940 SSR BSS E 2 SUR11950 ANAME BSS E 2 DATA SET NAME SUR11960 BSS E 2 SUR11970 BNAME BSS E 4 SUR11980 DUMY BSS E 2 SUR11990 DIRMX BSS 1 2*IRMAX SUR12000 DREND BSS E 2 SUR12010 IFOUN BSS 1 SUR12020 ININX BSS 1 OUTPUT DATA SET SUR12030 SCLOC BSS 1 LOCATION SUR12040 SCINC BSS 1 PARAMETERS SUR12050 SCINX BSS 1 SUR12060 SCSTR BSS 1 SUR12070 THCOL BSS 1 COLUMN NUMBER SUR12080 ACCSR BSS 1 SUR12090 FXSSR BSS 1 SUR12100 SRIDX BSS 1 SUR12110 SCRPT BSS 1 SUR12120 SUB2 BSS 1 SUR12130 OUTT BSS 6 TEMPORARY AREA SUR12140 TR BSS E 1332 B COEFFICIENTS SUR12150 B BSS E 290 B VECTOR SUR12160 IZ BSS E 400 Z VALUES FOR ONE COL SUR12170 WKIO BSS E 642 DISK I/O BUFFER SUR12180 TYPE BSS 30 TYPEWRITER AREA SUR12190 END GO SUR12200 // DUP SUR12210 *STORE WS UA SRFIT SUR12220 // JOB EQU00010 // DUP EQU00020 *DELETE EQUNS EQU00030 // ASM EQU00040 *LIST EQU00050 *************** EQU00060 * EQUATION EVALUATION EQUNS EQU00070 *************** EQU00080 GO LIBF WRTY0 EQU00090 DC /2000 EQU00100 DC CONTL EQU00110 BSI L ERTYP TYPE BEGINNING EQUNS EQU00120 DC MSAG1 EQU00130 BSI L NAME INPUT GRID NAME EQU00140 LD L ANAME EQU00150 STO L MSAG2+9 EQU00160 LD L ANAME+1 EQU00170 STO L MSAG2+10 EQU00180 BSI L ERTYP TYPE GRID NAME EQU00190 DC MSAG2 EQU00200 BSI L LOCAT SEARCH FOR TRAILER EQU00210 LD L IFOUN RECORD OR GRID NAME EQU00220 BSC L OKK,+- IN DISK DATA AREA EQU00230 BSI L ERTYP EQU00240 DC MSAG6 EQU00250 BSI L ERTYP NAME ALREADY USED EQU00260 DC MSAG4 EQU00270 WAIT EQU00280 EXIT EQU00290 OKK BSI L INPU1 INPUT PARAMETERS EQU00300 LD L GRID CHECK FOR POSITIVE EQU00310 BSC L *+8,-Z GRID INTERVAL EQU00320 BSI L ERTYP EQU00330 DC ERRU1 EQU00340 BSI L ERTYP EQU00350 DC MSAG4 EQU00360 WAIT EQU00370 EXIT EQU00380 LD L NTERM CHECK TO MAKE SURE EQU00390 S L MAXTR NTERM DOES NOT EQU00400 BSC L *+8,+ EXCEED MAX ALLOWED EQU00410 BSI L ERTYP EQU00420 DC ERRU2 EQU00430 BSI L ERTYP EQU00440 DC MSAG4 EQU00450 WAIT EQU00460 EXIT EQU00470 LIBF FLD CHECK TO MAKE SURE EQU00480 DC XMAX XMAX IS GREATER EQU00490 LIBF FSUB THAN XMIN AND BRANCH EQU00500 DC XMIN TO ERROR MESSAGE IF EQU00510 LIBF FSTO IT IS NOT EQU00520 DC RESUL EQU00530 LD L RESUL EQU00540 BSC L *+8,-Z EQU00550 BSI L ERTYP EQU00560 DC ERRU3 EQU00570 BSI L ERTYP EQU00580 DC MSAG4 EQU00590 WAIT EQU00600 EXIT EQU00610 LIBF FLD CHECK TO MAKE SURE EQU00620 DC YMAX YMAX IS GREATER EQU00630 LIBF FSUB THAN YMIN AND BRANCH EQU00640 DC YMIN TO ERROR MESSAGE IF EQU00650 LIBF FSTO IT IS NOT EQU00660 DC RESUL EQU00670 LD L RESUL EQU00680 BSC L *+8,-Z EQU00690 BSI L ERTYP EQU00700 DC ERRU3 EQU00710 BSI L ERTYP EQU00720 DC MSAG4 EQU00730 WAIT EQU00740 EXIT EQU00750 LIBF FLD COMPUTE MAX NUMBER OF EQU00760 DC XMAX COLUMNS REQUIRED EQU00770 LIBF FSUB FROM THE LIMITS ON EQU00780 DC XMIN THE VALUES OF X AND EQU00790 LIBF FDIV THE SPECIFIED VALUE EQU00800 DC GRID OF THE GRID INTERVAL EQU00810 LIBF FADD EQU00820 DC GFAC EQU00830 LIBF IFIX EQU00840 STO L ICMAX EQU00850 LD L ICMAX CHECK TO MAKE SURE EQU00860 S L MAXCR ICMAX DOES NOT EQU00870 BSC L *+8,+ EXCEED MAXCR, BRANCH EQU00880 BSI L ERTYP TO ERROR MESSAGE EQU00890 DC ERRU4 IF IT DOES EQU00900 BSI L ERTYP EQU00910 DC MSAG4 EQU00920 WAIT EQU00930 EXIT EQU00940 LIBF FLD COMPUTE MAX NUMBER OF EQU00950 DC YMAX ROWS REQUIRED FROM EQU00960 LIBF FSUB THE LIMITS ON THE EQU00970 DC YMIN VALUES OF Y AND THE EQU00980 LIBF FDIV SPECIFIED VALUE OF EQU00990 DC GRID THE GRID INTERVAL EQU01000 LIBF FADD EQU01010 DC GFAC EQU01020 LIBF IFIX EQU01030 STO L IRMAX EQU01040 LD L IRMAX CHECK TO MAKE SURE EQU01050 S L MAXCR IRMAX DOES NOT EQU01060 BSC L *+8,+ EXCEED MAXCR, BRANCH EQU01070 BSI L ERTYP TO ERROR MESSAGE EQU01080 DC ERRU4 IF IT DOES EQU01090 BSI L ERTYP EQU01100 DC MSAG4 EQU01110 WAIT EQU01120 EXIT EQU01130 LD L NTERM EQU01140 M L TWO DOUBLE THE VALUES OF EQU01150 D L ONE NTERM AND IRMAX FOR EQU01160 STO L DNTRM USE IN CHECKING THE EQU01170 LD L IRMAX NUMBER OF FLOATING EQU01180 M L TWO POINT NUMBERS THAT EQU01190 D L ONE WILL BE CALCULATED EQU01200 STO L DIRMX EQU01210 BSI L WRTOU WRITE HEADER RECORD EQU01220 BSI L REWRT WRITE TRAILER RECORD EQU01230 BSI L INPU2 INPUT COEFFICIENTS EQU01240 LD L IORD DOUBLE THE VALUE OF EQU01250 M L TWO IORD AND STORE FOR EQU01260 D L ONE EQU01270 STO L DIORD LATER USE IN CHECKING EQU01280 LD L ONE SET THE COLUMN NUMBER EQU01290 STO L K K TO ONE INITIALLY EQU01300 LIBF FLD SET THE VALUE OF X EQU01310 DC XMIN TO XMIN MINUS THE EQU01320 LIBF FSUB GRID INTERVAL EQU01330 DC GRID INITIALLY EQU01340 LIBF FSTO EQU01350 DC X EQU01360 LOOP1 LIBF FLD COMPUTE THE VALUE OF EQU01370 DC X X FOR COLUMN K BY EQU01380 LIBF FADD ADDING THE GRID EQU01390 DC GRID INTERVAL TO THE EQU01400 LIBF FSTO PREVIOUS VALUE OF X EQU01410 DC X FOR COLUMN%K-1< EQU01420 LDD L FONE SET THE ZERO POWER OF EQU01430 STD L XX X TO ONE EQU01440 LDX 1 0 LOAD IR1 WITH A ZERO EQU01450 LOOP2 LIBF FLDX CALCULATE THE EQU01460 DC XX SUCCESSIVE POWERS OF EQU01470 LIBF FMPY X BY MULTIPLYING THE EQU01480 DC X PREVIOUSLY CALCULATED EQU01490 MDX 1 2 POWER BY X EACH TIME EQU01500 LIBF FSTOX AND STORE AT LOCAT EQU01510 DC XX ION XX MODIFIED BY EQU01520 STX L1 DUM IR1 EQU01530 LD L DUM SKIP OUT OF LOOP 2 EQU01540 S L DIORD WHEN VALUE FOR IORD EQU01550 BSC L LOOP2,Z& HAS BEEN CALCULATED EQU01560 LD L ZERO SET THE ROW NUMBER EQU01570 STO L L L TO ZERO INITIALLY EQU01580 LIBF FLD SET THE VALUE OF Y EQU01590 DC YMIN TO YMIN MINUS THE EQU01600 LIBF FSUB GRID INTERVAL EQU01610 DC GRID INITIALLY EQU01620 LIBF FSTO EQU01630 DC Y EQU01640 LOOP3 LIBF FLD COMPUTE THE VALUE OF EQU01650 DC Y Y FOR ROW L BY EQU01660 LIBF FADD ADDING THE GRID EQU01670 DC GRID INTERVAL TO THE EQU01680 LIBF FSTO PREVIOUS VALUE OF Y EQU01690 DC Y FOR ROW%L-1< EQU01700 LDD L FONE SET THE ZERO POWER OF EQU01710 STD L YY Y TO ONE EQU01720 LDX 1 0 LOAD IR1 WITH A ZERO EQU01730 LOOP4 LIBF FLDX CALCULATE THE EQU01740 DC YY SUCCESSIVE POWERS OF EQU01750 LIBF FMPY Y BY MULTIPLYING THE EQU01760 DC Y PREVIOUSLY CALCULATED EQU01770 MDX 1 2 POWER BY Y EACH TIME EQU01780 LIBF FSTOX AND STORE AT EQU01790 DC YY LOCATION YY MODIFIED EQU01800 STX L1 DUM BY IR1 EQU01810 LD L DUM SKIP OUT OF LOOP 4 EQU01820 S L DIORD WHEN VALUE FOR IORD EQU01830 BSC L LOOP4,Z& HAS BEEN CALCULATED EQU01840 LD L ZERO INITIALIZE THE VALUE EQU01850 STO L ISUB OF THE COEFF SUBSCRP EQU01860 LDX I1 L EQU01870 LDD L FZERO INITIALIZE THE VALUE EQU01880 STD L1 A OF THE EQUATION EQU01890 LD L NEG2 INITIALIZE THE ORDER EQU01900 STO L N OF THE TERMS EQU01910 LOOP5 LD L N SET THE ORDER OF THE EQU01920 A L TWO TERMS THAT ARE TO EQU01930 STO L N BE CALCULATED EQU01940 LD L ISUB DETERMINE THE SUBSCRP EQU01950 A L N OF THE FIRST COEFF EQU01960 STO L ISUB OF THIS ORDER EQU01970 LD L NEG2 INITIALIZE THE NUMBER EQU01980 STO L J OF THE TERM EQU01990 LOOP6 LD L J DETERMINE THE NUMBER EQU02000 A L TWO OF THE TERM OF THIS EQU02010 STO L J ORDER EQU02020 A L ISUB DETERMINE THE SUBSCRP EQU02030 STO L JSUB OF THIS COEFFICIENT EQU02040 S L DNTRM CHECK TO SEE IF NTERM EQU02050 BSC L OUT,Z- HAS BEEN EXCEEDED EQU02060 LDX I1 JSUB COMPUTE THE VALUE OF EQU02070 LIBF FLDX THIS PARTICULAR TERM EQU02080 DC C FOR COLUMN K AND ROW EQU02090 LD L N L BY MULTIPLYING EQU02100 S L J TOGETHER THE EQU02110 STO L NJ APPROPRIATE COEFF, EQU02120 LDX I1 NJ POWER OF X, AND EQU02130 LIBF FMPYX POWER OF Y EQU02140 DC XX EQU02150 LDX I1 J EQU02160 LIBF FMPYX EQU02170 DC YY EQU02180 LDX I1 L ADD VALUE OF THIS EQU02190 LIBF FADDX TERM TO THE VALUE OF EQU02200 DC A PREVIOUSLY COMPUTED EQU02210 LIBF FSTOX TERMS EQU02220 DC A EQU02230 LD L NJ BRANCH IF ALL TERMS EQU02240 BSC L LOOP6,Z- HAVE NOT BEEN COMPUT EQU02250 LD L N BRANCH BACK IF ALL EQU02260 S L DIORD ORDERS HAVE NOT BEEN EQU02270 BSC L LOOP5,Z& COMPUTED EQU02280 OUT LD L L INCREMENT TO THIS ROW EQU02290 A L TWO NUMBER AND BRANCH EQU02300 STO L L BACK IF A(L) HAS NOT EQU02310 S L DIRMX BEEN COMPUTED FOR EQU02320 BSC L LOOP3,Z& ALL ROWS IN COLUMN K EQU02330 BSI L WRTGR EQU02340 LD L K INCREMENT TO NEXT EQU02350 A L ONE COLUMN NUMBER AND EQU02360 STO L K BRANCH BACK IF ALL EQU02370 S L ICMAX COLUMNS HAVE NOT EQU02380 BSC L LOOP1,& BEEN COMPUTED EQU02390 BSI L ERTYP TYPE COMPLETION EQU02400 DC MSAG3 MESSAGE EQU02410 EXIT EQU02420 *************** EQU02430 * INPU1 SUBROUTINE EQU02440 *************** EQU02450 INPU1 NOP SUBROUTINE TO READ EQU02460 LD L FXD55 XMIN,XMAX,YMIN,YMAX, EQU02470 STO L INPTA GRID INTERVAL AND EQU02480 *************** EQU02490 LIBF CARD0 NUMBER OF TERMS FROM EQU02500 * LIBF READ0 NUMBER OF TERMS FROM EQU02510 *************** EQU02520 DC /0000 PARAMETER CARD EQU02530 MDX *-3 EQU02540 *************** EQU02550 LIBF CARD0 EQU02560 * LIBF READ0 EQU02570 *************** EQU02580 DC /1000 EQU02590 DC INPTA EQU02600 *************** EQU02610 LIBF CARD0 EQU02620 * LIBF READ0 EQU02630 *************** EQU02640 DC /0000 EQU02650 MDX *-3 EQU02660 BSI L FFORM EQU02670 BSI L CEFBF EQU02680 LDD L BINFL EQU02690 STD L XMIN EQU02700 LDX 2 10 EQU02710 LD L2 INPTA&10 EQU02720 STO L2 INPTA EQU02730 MDX 2 -1 EQU02740 MDX *-6 EQU02750 BSI L FFORM EQU02760 BSI L CEFBF EQU02770 LDD L BINFL EQU02780 STD L XMAX EQU02790 LDX 2 10 EQU02800 LD L2 INPTA&20 EQU02810 STO L2 INPTA EQU02820 MDX 2 -1 EQU02830 MDX *-6 EQU02840 BSI L FFORM EQU02850 BSI L CEFBF EQU02860 LDD L BINFL EQU02870 STD L YMIN EQU02880 LDX 2 10 EQU02890 LD L2 INPTA&30 EQU02900 STO L2 INPTA EQU02910 MDX 2 -1 EQU02920 MDX *-6 EQU02930 BSI L FFORM EQU02940 BSI L CEFBF EQU02950 LDD L BINFL EQU02960 STD L YMAX EQU02970 LDX 2 10 EQU02980 LD L2 INPTA&40 EQU02990 STO L2 INPTA EQU03000 MDX 2 -1 EQU03010 MDX *-6 EQU03020 BSI L FFORM EQU03030 BSI L CEFBF EQU03040 LDD L BINFL EQU03050 STD L GRID EQU03060 LD L NMZER EQU03070 STO L INPTA&51 EQU03080 STO L INPTA&52 EQU03090 STO L INPTA&53 EQU03100 STO L INPTA+54 EQU03110 LD L PLUS EQU03120 STO L INPTA&50 EQU03130 LIBF DCBIN EQU03140 DC INPTA&50 EQU03150 STO L IORD EQU03160 A L ONE EQU03170 STO L NTERM EQU03180 A L ONE EQU03190 M L NTERM EQU03200 SLT 15 EQU03210 STO L NTERM EQU03220 BSC I INPU1 EQU03230 *************** EQU03240 * INPU2 SUBROUTINE EQU03250 *************** EQU03260 INPU2 NOP SUBROUTINE TO READ EQU03270 LD L ZERO COEFFICIENTS, ONE EQU03280 STO L NUMB PER CARD EQU03290 LD L FXD43 EQU03300 STO L CRDCD EQU03310 LDX 2 0 EQU03320 *************** EQU03330 LIBF CARD0 EQU03340 * LIBF READ0 EQU03350 *************** EQU03360 DC /0000 EQU03370 MDX *-3 EQU03380 *************** EQU03390 ERR3 LIBF CARD0 EQU03400 *RR3 LIBF READ0 EQU03410 *************** EQU03420 DC /1000 EQU03430 DC CRDCD EQU03440 *************** EQU03450 LIBF CARD0 EQU03460 * LIBF READ0 EQU03470 *************** EQU03480 DC /0000 EQU03490 MDX *-3 EQU03500 BSI L CEFBF EQU03510 LDD L BINFL EQU03520 STD L2 C EQU03530 MDX 2 2 EQU03540 LD L NUMB EQU03550 A L ONE EQU03560 STO L NUMB EQU03570 S L NTERM EQU03580 BSC L ERR3,Z& EQU03590 BSC I INPU2 EQU03600 *************** EQU03610 * CEFBF SUBROUTINE EQU03620 *************** EQU03630 CEFBF NOP SUBROUTINE TO EQU03640 LD L CRDCD&30 CONVERT AN E-FORMAT EQU03650 S L PLUS TO FLOATING POINT EQU03660 BSC L NXTA,&- EQU03670 LD L CRDCD&30 TEST FOR FORMAT ERRORS EQU03680 S L AMPER EQU03690 BSC L NXTA,&- EQU03700 LD L CRDCD&30 EQU03710 S L MINUS EQU03720 BSC L NXTA,&- EQU03730 LD L CRDCD&30 EQU03740 BSC L ERROR,Z EQU03750 NXTA LD L CRDCD&31 EQU03760 S L PERID EQU03770 BSC L ERROR,Z EQU03780 LD L CRDCD&40 EQU03790 S L LTRE EQU03800 BSC L ERROR,Z EQU03810 LD L CRDCD&41 EQU03820 S L PLUS EQU03830 BSC L NXTB,&- EQU03840 LD L CRDCD&41 EQU03850 S L AMPER EQU03860 BSC L NXTB,&- EQU03870 LD L CRDCD&41 EQU03880 S L MINUS EQU03890 BSC L NXTB,&- EQU03900 LD L CRDCD&41 EQU03910 BSC L ERROR,Z EQU03920 NXTB LD L CRDCD&30 CONVERT HIGH ORDER DIGITS EQU03930 STO L EFORM TO BINARY AND THEN TO EQU03940 LD L ZERO FLOATING POINT EQU03950 STO L EFORM&1 EQU03960 LD L CRDCD&32 EQU03970 STO L EFORM&2 EQU03980 LD L CRDCD&33 EQU03990 STO L EFORM&3 EQU04000 LD L CRDCD&34 EQU04010 STO L EFORM&4 EQU04020 LD L CRDCD&35 EQU04030 STO L EFORM&5 EQU04040 LIBF DCBIN EQU04050 DC EFORM EQU04060 STO L FXMNT EQU04070 LIBF FLOAT EQU04080 LIBF FSTO EQU04090 DC MANT EQU04100 LD L ZERO CONVERT LOW ORDER DIGITS TOEQU04110 STO L EFORM&1 BINARY AND THEN TO EQU04120 LD L CRDCD&36 FLOATING POINT EQU04130 STO L EFORM&2 EQU04140 LD L CRDCD&37 EQU04150 STO L EFORM&3 EQU04160 LD L CRDCD&38 EQU04170 STO L EFORM&4 EQU04180 LD L CRDCD&39 EQU04190 STO L EFORM&5 EQU04200 LIBF DCBIN EQU04210 DC EFORM EQU04220 STO L FXMNR EQU04230 LIBF FLOAT EQU04240 LIBF FSTO EQU04250 DC MANR EQU04260 LD L FXMNT ARE HIGH ORDER DIGITS ZERO EQU04270 BSC L *&4,Z EQU04280 LD L FXMNR NO - CALCULATE EQU04290 BSC L ALTER,&- CHARACTERISTIC EQU04300 LD L CRDCD&41 YES - ARE LOW ORDER DIGITS EQU04310 STO L EFORM ZERO EQU04320 LD L ZERO YES - GO TO ALTER EQU04330 STO L EFORM&1 NO - CONVERT EXPONENT TO EQU04340 STO L EFORM&2 BINARY, COMBINE TWO EQU04350 STO L EFORM&3 FLOTING POINT EQU04360 LD L CRDCD&42 NUMBERS AND ADJUST EQU04370 STO L EFORM&4 CHARACTERISTIC FOR EQU04380 LD L CRDCD&43 EXPONENT OF E-FORMAT EQU04390 STO L EFORM&5 EQU04400 LIBF DCBIN EQU04410 DC EFORM EQU04420 STO L EXPON EQU04430 LIBF FLD EQU04440 DC FTEN EQU04450 LIBF FAXI EQU04460 DC EXPON EQU04470 LIBF FSTO EQU04480 DC EXPT EQU04490 LIBF FLD EQU04500 DC MANR EQU04510 LIBF FMPY EQU04520 DC TENG4 EQU04530 LIBF FADD EQU04540 DC MANT EQU04550 LIBF FMPY EQU04560 DC TENG4 EQU04570 LIBF FMPY EQU04580 DC EXPT EQU04590 LIBF FSTO EQU04600 DC BINFL EQU04610 BSC I CEFBF RETURN EQU04620 ALTER LDD L FZERO SET VALUE TO FLOATING EQU04630 STD L BINFL POINT ZERO EQU04640 BSC I CEFBF RETURN EQU04650 ERROR BSI L ERTYP TYPE FORMAT ERROR MESSAGE EQU04660 DC ERRU6 EQU04670 BSI L ERTYP EQU04680 DC MSAG4 EQU04690 WAIT EQU04700 EXIT EQU04710 *************** EQU04720 * FFORM SUBROUTINE EQU04730 *************** EQU04740 FFORM NOP SUBROUTINE TO EQU04750 LDX 2 14 CONVERT AN F-FORMAT EQU04760 LD L NMZER CARD CODE NUMBER EQU04770 STO L2 CRDCD+30 TO E-FORMAT EQU04780 MDX 2 -1 SET E-FORMAT AREA TO EQU04790 MDX *-4 ZERO CHARACTERS EQU04800 LD L PLUS STORE PLUS, PERIOD AND EQU04810 STO L CRDCD+30 E IN E-FORMAT WORD EQU04820 LD L PERID EQU04830 STO L CRDCD+31 EQU04840 LD L LTRE EQU04850 STO L CRDCD+40 EQU04860 LD L FX11 EQU04870 STO L FNDPR EQU04880 LDX 1 10 EQU04890 FFRM LD L1 INPTA TEST FOR EQU04900 BSC L FIND1,+- BLANK EQU04910 LD L1 INPTA PLUS SIGN EQU04920 S L PLUS EQU04930 BSC L FIND1,+- EQU04940 LD L1 INPTA AMPERS AND EQU04950 S L AMPER EQU04960 BSC L FIND1,+- EQU04970 LD L1 INPTA MINUS EQU04980 S L MINUS EQU04990 BSC L BCKF,Z EQU05000 LD L MINUS EQU05010 STO L CRDCD+30 EQU05020 FIND1 LD L NMZER EQU05030 STO L1 INPTA EQU05040 MDX 1 -1 EQU05050 MDX FIND2 EQU05060 MDX FIND2 EQU05070 BCKF LD L1 INPTA PERIOD EQU05080 S L PERID EQU05090 BSC L BCKG,Z EQU05100 STX L1 FNDPR EQU05110 BCKG MDX 1 -1 LOOP TEST EQU05120 MDX *+1 EQU05130 MDX *+2 EQU05140 BSC L FFRM TEST ANOTHER CHARACTER EQU05150 FIND2 STX L1 FNDEN CALCULATE AND STORE EQU05160 LD L FNDPR EXPONENT EQU05170 S L FNDEN EQU05180 S L ONE EQU05190 LIBF BINDC EQU05200 LD L EFORM EQU05210 STO L CRDCD+41 EQU05220 LD L EFORM+4 EQU05230 STO L CRDCD+42 EQU05240 LD L EFORM+5 EQU05250 STO L CRDCD+43 EQU05260 LD L TEN IS HIGH ORDER CHARACTER EQU05270 S L FNDEN IN RIGTMOST POSITION EQU05280 BSC L FIND4,+ YES - GO TO FIND4 EQU05290 STO L FFMNB NO - STORE COUNT OF EQU05300 MDX 1 1 CHARACTERS TO BE MOVED EQU05310 LD L1 INPTA LOAD SIGNIFICANT DIGIT EQU05320 STO L CRDCD+32 OF F-FORMAT TO E-FORMAT EQU05330 LD L ONE MANTISSA EQU05340 STO L FFMCT EQU05350 S L FFMNB TEST FOR SINGLE DIGIT IN EQU05360 BSC L ONWD,- F-FORMAT EQU05370 LDX 2 0 YES - GO TO ONWD EQU05380 BCKH MDX 2 1 NO - MOVE DIGIT TO EQU05390 BCKJ MDX 1 1 E-FORMAT MANTISSA EQU05400 MDX L FFMCT,+1 EQU05410 LD L1 INPTA TEST FOR PERIOD EQU05420 S L PERID EQU05430 BSC L BCKI,+- EQU05440 LD L1 INPTA EQU05450 STO L2 CRDCD+32 EQU05460 LD L FFMCT EQU05470 S L FFMNB EQU05480 BSC L BCKH,+Z EQU05490 BSC I FFORM RETURN EQU05500 FIND4 LD L NMZER STORE ZERO IN TENS POSITIONEQU05510 STO L CRDCD+44 OF EXPONENT EQU05520 ONWD BSC I FFORM EQU05530 BCKI LD L FFMCT ARE ALL CHARACTERS MOVED EQU05540 S L FFMNB EQU05550 BSC L BCKJ,+Z NO - GO TO BCKJ EQU05560 BSC I FFORM EQU05570 *************** EQU05580 * NAME SUBROUTINE EQU05590 *************** EQU05600 NAME NOP SUBROUTINE TO EQU05610 LD L FOUR READ THE GRID EQU05620 STO L BNAME-1 NAME FROM A CARD EQU05630 *************** EQU05640 LIBF CARD0 AND CONVERT EQU05650 * LIBF READ0 AND CONVERT EQU05660 *************** EQU05670 DC /0000 TO EBCDIC EQU05680 MDX *-3 EQU05690 *************** EQU05700 LIBF CARD0 EQU05710 * LIBF READ0 EQU05720 *************** EQU05730 DC /1000 EQU05740 DC BNAME-1 EQU05750 *************** EQU05760 LIBF CARD0 EQU05770 * LIBF READ0 EQU05780 *************** EQU05790 DC /0000 EQU05800 MDX *-3 EQU05810 LIBF SPEED EQU05820 DC /0000 EQU05830 DC BNAME EQU05840 DC ANAME EQU05850 DC 4 EQU05860 BSC I NAME EQU05870 *************** EQU05880 * LOCAT SUBROUTINE EQU05890 *************** EQU05900 LOCAT NOP SUBROUTINE TO EQU05910 LD L FX20 SEARCH FOR THE EQU05920 STO L WKIO TRAILER RECORD EQU05930 LD L SCBGN OR THE GRID NAME EQU05940 STO L WKIO+1 IN THE DISK DATA EQU05950 AGN LIBF DISKN AREA EQU05960 DC /5000 EQU05970 DC WKIO SETS IFOUN TO EQU05980 DC ERRS ZERO IF TRAILER EQU05990 LIBF DISKN RECORD IS FOUND EQU06000 DC /1000 SETS IFOUN TO EQU06010 DC WKIO ONE IF GRID NAME EQU06020 DC ERRS IS FOUND EQU06030 LIBF DISKN EQU06040 DC /0000 EQU06050 DC WKIO EQU06060 MDX *-4 EQU06070 LIBF FLD EQU06080 DC TRAIL EQU06090 LIBF FSUB EQU06100 DC WKIO+2 EQU06110 LIBF FSTO EQU06120 DC DUMY EQU06130 LD L DUMY EQU06140 BSC L OK,+- EQU06150 LIBF FLD EQU06160 DC WKIO+2 EQU06170 LIBF FSUB EQU06180 DC ANAME EQU06190 LIBF FSTO EQU06200 DC DUMY EQU06210 LD L DUMY EQU06220 BSC L FND,+- EQU06230 LD L WKIO+6 EQU06240 BSC L EROB,& EQU06250 M L FOUR EQU06260 STD L DUMY EQU06270 D L THREE EQU06280 STO L SCINC EQU06290 M L THREE EQU06300 D L ONE EQU06310 S L DUMY+1 EQU06320 BSC L AA3,- EQU06330 A L FOUR EQU06340 A L SCINC EQU06350 STO L SCINC EQU06360 AA3 LD L WKIO&1 EQU06370 A L SCINC EQU06380 STO L WKIO+1 EQU06390 S L SCBGN EQU06400 BSC L EROB,& EQU06410 S L SCLGT EQU06420 BSC L EROB,- EQU06430 BSC L AGN EQU06440 FND LD L ONE TRANSFER HEADER RECORD EQU06450 STO L IFOUN DATA FROM WKIO TO EQU06460 LDD L WKIO+4 STORAGE EQU06470 STD L GRID EQU06480 LD L WKIO+6 EQU06490 STO L ICMAX EQU06500 LD L WKIO+7 EQU06510 STO L IRMAX EQU06520 LD L WKIO&1 EQU06530 STO L SCSTR EQU06540 BSC I LOCAT EQU06550 OK LD L ZERO EQU06560 STO L IFOUN EQU06570 LD L WKIO&1 EQU06580 STO L SCSTR EQU06590 BSC I LOCAT EQU06600 ERRS DC 0 DISK ERROR MESSAGE EQU06610 LIBF WRTY0 EQU06620 DC /2000 EQU06630 DC MSAG5 EQU06640 SRA 16 EQU06650 BSC I ERRS EQU06660 EROB BSI L ERTYP EQU06670 DC MSAG7 NO TRAILER RECORD MESSAGE EQU06680 BSI L ERTYP EQU06690 DC MSAG4 EQU06700 WAIT EQU06710 EXIT EQU06720 *************** EQU06730 * SCCOM SUBROUTINE EQU06740 *************** EQU06750 SCCOM NOP COMPUTE SECTOR ADDRESS EQU06760 LD L K FROM THE COLUMN NUMBER EQU06770 S L ONE AND BEGINNING SECTOR EQU06780 M L ONE OF DATA SET AREA EQU06790 D L THREE TEST ADDRESS OF SECTOR EQU06800 STO L DUMY AGAINST UPPER AND LOWER EQU06810 M L FOUR LIMITS OF DATA SET AREA EQU06820 D L ONE EQU06830 STO L SCINC EQU06840 LD L DUMY EQU06850 M L THREE EQU06860 D L ONE EQU06870 STO L DUMY EQU06880 LD L K EQU06890 S L DUMY EQU06900 S L ONE EQU06910 STO L SCINX EQU06920 A L SCINC EQU06930 STO L SCINC EQU06940 A L SCSTR EQU06950 STO L SCLOC EQU06960 S L SCBGN EQU06970 BSC L ER,Z+ EQU06980 S L SCLGT EQU06990 BSC L ER,- EQU07000 LD L FX100 EQU07010 M L SCINX EQU07020 D L ONE EQU07030 A L FX22 EQU07040 STO L ININX EQU07050 BSC I SCCOM EQU07060 ER BSI L ERTYP EQU07070 DC MSAG7 EQU07080 BSI L ERTYP EQU07090 DC MSAG4 EQU07100 WAIT EQU07110 EXIT EQU07120 *************** EQU07130 * WRTOU SUBROUTINE EQU07140 *************** EQU07150 WRTOU NOP WRITE MASTER HEADER RECORD EQU07160 LDX 1 22 EQU07170 LDX 2 20 EQU07180 LDD L ZNIL EQU07190 STD L1 WKIO-2 EQU07200 MDX 1 -2 EQU07210 MDX 2 -2 EQU07220 MDX *-5 EQU07230 LD L SCBGN EQU07240 A L SCLGT EQU07250 S L SCSTR EQU07260 M L THREE EQU07270 D L FOUR EQU07280 S L ICMAX EQU07290 BSC L NOROM,+Z EQU07300 LD L FX20 EQU07310 STO L WKIO EQU07320 LD L SCSTR EQU07330 STO L WKIO+1 EQU07340 LDD L ANAME EQU07350 STD L WKIO+2 EQU07360 LDD L GRID EQU07370 STD L WKIO+4 EQU07380 LD L ICMAX EQU07390 STO L WKIO&6 EQU07400 LD L IRMAX EQU07410 STO L WKIO&7 EQU07420 LDD L XMIN EQU07430 STD L WKIO+8 EQU07440 LDD L YMIN EQU07450 STD L WKIO+10 EQU07460 LIBF DISKN EQU07470 DC /5000 EQU07480 DC WKIO EQU07490 DC ERRS EQU07500 LIBF DISKN EQU07510 DC /4000 EQU07520 DC WKIO EQU07530 LIBF DISKN EQU07540 DC /0000 EQU07550 DC WKIO EQU07560 MDX *-4 EQU07570 BSC I WRTOU EQU07580 NOROM BSI L ERTYP EQU07590 DC MSAG8 EQU07600 BSI L ERTYP EQU07610 DC MSAG4 EQU07620 WAIT EQU07630 EXIT EQU07640 *************** EQU07650 * WRTGR SUBROUTINE EQU07660 *************** EQU07670 WRTGR NOP SUBROUTINE TO EQU07680 BSI L SCCOM WRITE THE EQU07690 LIBF DISKN COLUMNS IN THE EQU07700 DC /0000 DISK DATA AREA EQU07710 DC WKIO EQU07720 MDX *-4 EQU07730 LD L FX640 EQU07740 STO L WKIO EQU07750 LD L SCLOC EQU07760 STO L WKIO+1 EQU07770 LIBF DISKN EQU07780 DC /5000 EQU07790 DC WKIO EQU07800 DC ERRS EQU07810 LIBF DISKN EQU07820 DC /1000 EQU07830 DC WKIO EQU07840 DC ERRS EQU07850 LIBF DISKN EQU07860 DC /0000 EQU07870 DC WKIO EQU07880 MDX *-4 EQU07890 LD L ININX EQU07900 A L FX418 EQU07910 STO L DUMY EQU07920 LDX I1 DUMY EQU07930 LDX I2 FX420 EQU07940 LDD L ZNIL EQU07950 STD L1 WKIO EQU07960 MDX 1 -2 EQU07970 MDX 2 -2 EQU07980 MDX *-5 EQU07990 LD L IRMAX SET Z01 INDEX TO 2*IRMAX EQU08000 A L IRMAX EQU08010 STO L DUMY EQU08020 LDX I2 DUMY EQU08030 LD L ININX EQU08040 A L FX20 SET WKIO INDEX TO EQU08050 A L DUMY ININX+20+2*IRMAX-2 EQU08060 S L TWO EQU08070 STO L DUMY EQU08080 LDX I1 DUMY EQU08090 LDD L2 A-2 EQU08100 STD L1 WKIO EQU08110 MDX 1 -2 EQU08120 MDX 2 -2 EQU08130 MDX *-7 EQU08140 LDX I1 ININX EQU08150 LD L K EQU08160 STO L1 WKIO EQU08170 LD L ONE EQU08180 STO L1 WKIO+1 EQU08190 LD L IRMAX EQU08200 STO L1 WKIO&2 EQU08210 LIBF DISKN EQU08220 DC /4000 EQU08230 DC WKIO EQU08240 BSC I WRTGR EQU08250 *************** EQU08260 * REWRT SUBROUTINE EQU08270 *************** EQU08280 REWRT NOP SUBROUTINE TO EQU08290 LD L ICMAX PLACE TRAILER EQU08300 M L FOUR RECORD FOLLOWING EQU08310 STD L DUMY LAST COLUMN IN EQU08320 D L THREE THE DISK DATA AREA EQU08330 STO L SCINC EQU08340 M L THREE EQU08350 D L ONE EQU08360 S L DUMY+1 EQU08370 BSC L AA2,- EQU08380 A L FOUR EQU08390 A L SCINC EQU08400 STO L SCINC EQU08410 AA2 LD L SCINC EQU08420 A L SCSTR EQU08430 STO L XXXX EQU08440 LIBF DISKN EQU08450 DC /0000 EQU08460 DC WKIO EQU08470 MDX *-4 EQU08480 LD L XXXX EQU08490 STO L WKIO+1 EQU08500 LD L TWO EQU08510 STO L WKIO EQU08520 LDD L TRAIL EQU08530 STD L WKIO+2 EQU08540 LIBF DISKN EQU08550 DC /5000 EQU08560 DC WKIO EQU08570 DC ERRS EQU08580 LIBF DISKN EQU08590 DC /4000 EQU08600 DC WKIO EQU08610 LIBF DISKN EQU08620 DC /0000 EQU08630 DC WKIO EQU08640 MDX *-4 EQU08650 BSC I REWRT EQU08660 *************** EQU08670 * ERTYP SUBROUTINE EQU08680 *************** EQU08690 ERTYP NOP SUBROUTINE TO EQU08700 LD I ERTYP WRITE MESSAGES EQU08710 STO L ERTX ON THE CONSOLE EQU08720 MDX L ERTYP,&1 TYPEWRITER EQU08730 LD L ERTX EQU08740 S L ONE EQU08750 STO *&1 EQU08760 LD L 0 EQU08770 STO L ERTX+2 EQU08780 M L ONE EQU08790 D L TWO EQU08800 STO L TYPE EQU08810 LIBF EBPRT EQU08820 DC /0000 EQU08830 ERTX DC 0 EQU08840 DC TYPE+1 EQU08850 DC 0 EQU08860 LIBF WRTY0 EQU08870 DC /2000 EQU08880 DC TYPE EQU08890 LIBF WRTY0 EQU08900 DC /2000 EQU08910 DC CONTL EQU08920 LIBF WRTY0 EQU08930 DC /0000 EQU08940 MDX *-3 EQU08950 BSC I ERTYP EQU08960 *************** EQU08970 * DEFINE CONSTANTS EQU08980 *************** EQU08990 SCBGN DC 448 EQU09000 SCLGT DC 808 EQU09010 THREE DC 3 EQU09020 FOUR DC 4 EQU09030 FIVE DC 5 EQU09040 SIX DC 6 EQU09050 SEVEN DC 7 EQU09060 FX15 DC 15 EQU09070 FX19 DC 19 EQU09080 FX20 DC 20 EQU09090 FX22 DC 22 EQU09100 FX100 DC 100 EQU09110 FX272 DC 272 EQU09120 FX280 DC 280 EQU09130 FX400 DC 400 EQU09140 FX402 DC 402 EQU09150 FX418 DC 418 EQU09160 FX420 DC 420 EQU09170 FX422 DC 422 EQU09180 FX640 DC 640 EQU09190 FX808 DC 808 EQU09200 ZNIL DEC -1.0E30 EQU09210 TRAIL DEC 9999. EQU09220 XXXX DC /FFFF EQU09230 YYYY DC /EEEE EQU09240 MAXCR DC 200 EQU09250 MAXTR DC 66 EQU09260 PLUS DC /80A0 EQU09270 MINUS DC /4000 EQU09280 AMPER DC /8000 EQU09290 PERID DC /8420 EQU09300 LTRE DC /8100 EQU09310 NMZER DC /2000 EQU09320 ZERO DC 0 EQU09330 ONE DC 1 EQU09340 TWO DC 2 EQU09350 TEN DC 10 EQU09360 ELEVN DC 11 EQU09370 FX11 DC 11 EQU09380 TWELV DC 12 EQU09390 FXD43 DC 43 EQU09400 FXD55 DC 55 EQU09410 FXD80 DC 80 EQU09420 NEG2 DC -2 EQU09430 FZERO DEC 0. EQU09440 FONE DEC 1. EQU09450 FTWO DEC 2. EQU09460 F3 DEC 3. EQU09470 F8 DEC 8. EQU09480 FTEN DEC 10. EQU09490 TENG4 DEC 1.0E-4 EQU09500 GFAC DEC 1.9999 EQU09510 *************** EQU09520 * DEFINE ERROR MESSAGES EQU09530 *************** EQU09540 DC 30 EQU09550 ERRU1 EBC .GRID INTERVAL IS NOT POSITIVE . EQU09560 DC 50 EQU09570 ERRU2 EBC .SPECIFIED NUMBER OF TERMS EXCEEDS . EQU09580 EBC .MAXIMUM ALLOWED . EQU09590 DC 46 EQU09600 ERRU3 EBC .MAX AND MIN VALUES ARE NOT. EQU09610 EBC . PROPERLY SPECIFIED . EQU09620 DC 58 EQU09630 ERRU4 EBC .REQUIRED NUMBER OF COLUMNS OR ROWS. EQU09640 EBC . EXCEEDS MAXIMUM ALLOWED. EQU09650 DC 30 EQU09660 ERRU6 EBC .INPUT DATA NOT IN PROPER FORM . EQU09670 DC 16 EQU09680 MSAG1 EBC .EQUNS BEGINNING . EQU09690 DC 22 EQU09700 MSAG2 EBC .OUTPUT GRID NAMED . EQU09710 DC /4040 EQU09720 DC /4040 EQU09730 DC 16 EQU09740 MSAG3 EBC .EQUNS COMPLETED . EQU09750 DC 30 EQU09760 MSAG4 EBC .PUSH START FOR EXIT TO MONITOR. EQU09770 MSAG5 DC 20 DISK ERROR MESSAGE EQU09780 DC /3020 EQU09790 DC /9858 EQU09800 DC /2135 EQU09810 DC /6060 EQU09820 DC /5060 EQU09830 DC /2121 EQU09840 DC /9C34 EQU09850 DC /6070 EQU09860 DC /2074 EQU09870 DC /3C9C EQU09880 DC /3421 EQU09890 DC /7C50 EQU09900 DC /1821 EQU09910 DC /3C74 EQU09920 DC /3021 EQU09930 DC /6034 EQU09940 DC /989C EQU09950 DC /3C60 EQU09960 DC /9C21 EQU09970 DC /8103 EQU09980 DC 26 EQU09990 MSAG6 EBC .NAME ALREADY USED ON DISK . EQU10000 DC 30 EQU10010 MSAG7 EBC .UNABLE TO FIND TRAILER RECORD . EQU10020 DC 54 EQU10030 MSAG8 EBC .REQUIRED NUMBER OF COLUMNS. EQU10040 EBC .EXCEEDS AVAILABLE DISK AREA . EQU10050 CONTL DC 1 EQU10060 DC /8103 EQU10070 *************** EQU10080 * ALLOCATE STORAGE EQU10090 *************** EQU10100 GRID BSS E 2 GRID INTERVAL EQU10110 NTERM BSS 1 NUMBER OF TERMS EQU10120 XMAX BSS E 2 EQU10130 XMIN BSS E 2 EQU10140 RESUL BSS E 2 TEMPORARY STORAGE EQU10150 YMAX BSS E 2 EQU10160 YMIN BSS E 2 EQU10170 ICMAX BSS 1 EQU10180 ACMAX BSS E 2 MAX. COLUMN - FLOATING PT. EQU10190 CCMAX BSS E 2 EQU10200 IRMAX BSS 1 EQU10210 ARMAX BSS E 2 MAX. ROW - FLOATING PT. EQU10220 DNTRM BSS 1 2*NUMBER OF TERMS EQU10230 DIRMX BSS 1 2* NUMBER OF ROWS EQU10240 IORD BSS 1 ORDER OF EQUATION EQU10250 DIORD BSS 1 2* ORDER EQU10260 K BSS 1 EQU10270 X BSS E 2 EQU10280 XX BSS E 22 POWER OF X EQU10290 DUM BSS 1 EQU10300 L BSS 1 EQU10310 Y BSS E 2 EQU10320 YY BSS E 22 POWER OF Y EQU10330 ISUB BSS 1 EQU10340 A BSS E 400 COLUMN SECTOR EQU10350 N BSS 1 INDEXING PARAMETER EQU10360 J BSS 1 EQU10370 JSUB BSS 1 EQU10380 C BSS E 132 COEFFICIENT STORAGE EQU10390 NJ BSS 1 EQU10400 CRDCD BSS 46 CONVERTED CARD EQU10410 EFORM BSS 16 CONVERSSION AREA EQU10420 FXMNT BSS 1 TEMPORARY STORAGE EQU10430 MANT BSS E 2 EQU10440 MANR BSS E 2 EQU10450 FXMNR BSS 1 EQU10460 EXPON BSS 1 EQU10470 EXPT BSS E 2 EQU10480 BINFL BSS E 2 EQU10490 NUMB BSS 1 EQU10500 INDF BSS 1 EQU10510 INDG BSS 1 EQU10520 OUTS BSS 1 EQU10530 BSS 4 EQU10540 BSS 4 EQU10550 BSS 4 EQU10560 OUTT BSS 1 EQU10570 BSS 4 EQU10580 BSS 4 EQU10590 BSS 4 EQU10600 BSS E 1 EQU10610 AA BSS 81 CARD INPUT AREA EQU10620 DUMM BSS E 4 TEMPORARY STORAGE EQU10630 DUMN BSS 1 EQU10640 CHKK BSS 29 EQU10650 CHLL BSS E 16 EQU10660 ANAME BSS E 2 EQU10670 BSS E 2 EQU10680 BNAME BSS E 4 EQU10690 DUMY BSS E 2 EQU10700 INPTA BSS 81 INPUT AREA EQU10710 DREND BSS E 2 EQU10720 IFOUN BSS 1 EQU10730 ININX BSS 1 EQU10740 IRMIN BSS 1 EQU10750 SCLOC BSS 1 DATA SET EQU10760 SCINC BSS 1 LOCATION EQU10770 SCINX BSS 1 PARAMETERS EQU10780 SCSTR BSS 1 EQU10790 FNDEN BSS 1 EQU10800 FNDPR BSS 1 EQU10810 FFMNB BSS 1 EQU10820 FFMCT BSS 1 EQU10830 XINC BSS E 2 X INTERVAL EQU10840 YINC BSS E 2 Y INTERVAL EQU10850 WKIO BSS E 642 DISK I/O BUFFER EQU10860 TYPE BSS 30 MESSAGE AREA EQU10870 END GO EQU10880 // DUP EQU10890 *STORE WS UA EQUNS EQU10900 // JOB EQS00010 // DUP EQS00020 *DELETE EQSCA EQS00030 // ASM EQS00040 *LIST EQS00050 *************** EQS00060 * EQUATION EVALUATION EQSCA EQS00070 *************** EQS00080 GO LIBF WRTY0 EQS00090 DC /2000 EQS00100 DC CONTL EQS00110 BSI L ERTYP TYPE BEGINNING EQSCA EQS00120 DC MSAG1 EQS00130 BSI L NAME INPUT GRID NAME EQS00140 LD L ANAME EQS00150 STO L MSAG2+9 EQS00160 LD L ANAME+1 EQS00170 STO L MSAG2+10 EQS00180 BSI L ERTYP TYPE GRID NAME EQS00190 DC MSAG2 EQS00200 BSI L LOCAT SEARCH FOR TRAILER EQS00210 LD L IFOUN RECORD OR GRID NAME EQS00220 BSC L OKK,+- IN DISK DATA AREA EQS00230 BSI L ERTYP EQS00240 DC MSAG6 EQS00250 BSI L ERTYP NAME ALREADY USED EQS00260 DC MSAG4 EQS00270 WAIT EQS00280 EXIT EQS00290 OKK BSI L INPU1 INPUT PARAMETERS EQS00300 LD L GRID CHECK FOR POSITIVE EQS00310 BSC L *+8,-Z GRID INTERVAL EQS00320 BSI L ERTYP EQS00330 DC ERRU1 EQS00340 BSI L ERTYP EQS00350 DC MSAG4 EQS00360 WAIT EQS00370 EXIT EQS00380 LD L NTERM CHECK TO MAKE SURE EQS00390 S L MAXTR NTERM DOES NOT EQS00400 BSC L *+8,+ EXCEED MAX ALLOWED EQS00410 BSI L ERTYP EQS00420 DC ERRU2 EQS00430 BSI L ERTYP EQS00440 DC MSAG4 EQS00450 WAIT EQS00460 EXIT EQS00470 LIBF FLD CHECK TO MAKE SURE EQS00480 DC XMAX XMAX IS GREATER EQS00490 LIBF FSUB THAN XMIN AND BRANCH EQS00500 DC XMIN TO ERROR MESSAGE IF EQS00510 LIBF FSTO IT IS NOT EQS00520 DC RESUL EQS00530 LD L RESUL EQS00540 BSC L *+8,-Z EQS00550 BSI L ERTYP EQS00560 DC ERRU3 EQS00570 BSI L ERTYP EQS00580 DC MSAG4 EQS00590 WAIT EQS00600 EXIT EQS00610 LIBF FLD CHECK TO MAKE SURE EQS00620 DC YMAX YMAX IS GREATER EQS00630 LIBF FSUB THAN YMIN AND BRANCH EQS00640 DC YMIN TO ERROR MESSAGE IF EQS00650 LIBF FSTO IT IS NOT EQS00660 DC RESUL EQS00670 LD L RESUL EQS00680 BSC L *+8,-Z EQS00690 BSI L ERTYP EQS00700 DC ERRU3 EQS00710 BSI L ERTYP EQS00720 DC MSAG4 EQS00730 WAIT EQS00740 EXIT EQS00750 LIBF FLD COMPUTE MAX NUMBER OF EQS00760 DC XMAX COLUMNS REQUIRED EQS00770 LIBF FSUB FROM THE LIMITS ON EQS00780 DC XMIN THE VALUES OF X AND EQS00790 LIBF FDIV THE SPECIFIED VALUE EQS00800 DC GRID OF THE GRID INTERVAL EQS00810 LIBF FADD EQS00820 DC GFAC EQS00830 LIBF IFIX EQS00840 STO L ICMAX EQS00850 LD L ICMAX CHECK TO MAKE SURE EQS00860 S L MAXCR ICMAX DOES NOT EQS00870 BSC L *+8,+ EXCEED MAXCR, BRANCH EQS00880 BSI L ERTYP TO ERROR MESSAGE EQS00890 DC ERRU4 IF IT DOES EQS00900 BSI L ERTYP EQS00910 DC MSAG4 EQS00920 WAIT EQS00930 EXIT EQS00940 LIBF FLD COMPUTE MAX NUMBER OF EQS00950 DC YMAX ROWS REQUIRED FROM EQS00960 LIBF FSUB THE LIMITS ON THE EQS00970 DC YMIN VALUES OF Y AND THE EQS00980 LIBF FDIV SPECIFIED VALUE OF EQS00990 DC GRID THE GRID INTERVAL EQS01000 LIBF FADD EQS01010 DC GFAC EQS01020 LIBF IFIX EQS01030 STO L IRMAX EQS01040 LD L IRMAX CHECK TO MAKE SURE EQS01050 S L MAXCR IRMAX DOES NOT EQS01060 BSC L *+8,+ EXCEED MAXCR, BRANCH EQS01070 BSI L ERTYP TO ERROR MESSAGE EQS01080 DC ERRU4 IF IT DOES EQS01090 BSI L ERTYP EQS01100 DC MSAG4 EQS01110 WAIT EQS01120 EXIT EQS01130 LD L NTERM EQS01140 M L TWO DOUBLE THE VALUES OF EQS01150 D L ONE NTERM AND IRMAX FOR EQS01160 STO L DNTRM USE IN CHECKING THE EQS01170 LD L IRMAX NUMBER OF FLOATING EQS01180 M L TWO POINT NUMBERS THAT EQS01190 D L ONE WILL BE CALCULATED EQS01200 STO L DIRMX WILL BE CALCULATED EQS01210 BSI L WRTOU WRITE HEADER RECORD EQS01220 BSI L REWRT EQS01230 BSI L INPU2 INPUT COEFFICIENTS EQS01240 LD L IORD DOUBLE THE VALUE OF EQS01250 M L TWO IORD AND STORE FOR EQS01260 D L ONE LATER USE IN CHECKING EQS01270 STO L DIORD EQS01280 LIBF FLD CALCULATE THE EQS01290 DC XMAX INCREMENT FOR X EQS01300 LIBF FSUB IN THE INTERVAL EQS01310 DC XMIN FROM ZERO TO ONE EQS01320 LIBF FDVR EQS01330 DC GRID EQS01340 LIBF FSTO EQS01350 DC XINC EQS01360 LIBF FLD CALCULATE THE EQS01370 DC YMAX INCREMENT FOR Y EQS01380 LIBF FSUB IN THE INTERVAL EQS01390 DC YMIN FROM ZERO TO ONE EQS01400 LIBF FDVR EQS01410 DC GRID EQS01420 LIBF FSTO EQS01430 DC YINC EQS01440 LD L ONE SET THE COLUMN NUMBER EQS01450 STO L K K TO ONE INITIALLY EQS01460 LIBF FLD SET THE VALUE OF X EQS01470 DC FZERO TO ZERO MINUS THE EQS01480 LIBF FSUB XINC INITIALLY EQS01490 DC XINC EQS01500 LIBF FSTO EQS01510 DC X EQS01520 LOOP1 LIBF FLD COMPUTE THE VALUE OF EQS01530 DC X X FOR COLUMN K BY EQS01540 LIBF FADD ADDING THE XINC TO EQS01550 DC XINC THE PREVIOUS VALUE EQS01560 LIBF FSTO OF X FOR COLUMN%K-1< EQS01570 DC X EQS01580 LDD L FONE SET THE ZERO POWER OF EQS01590 STD L XX X TO ONE EQS01600 LDX 1 0 LOAD IR1 WITH A ZERO EQS01610 LOOP2 LIBF FLDX CALCULATE THE EQS01620 DC XX SUCCESSIVE POWERS OF EQS01630 LIBF FMPY X BY MULTIPLYING THE EQS01640 DC X PREVIOUSLY CALCULATED EQS01650 MDX 1 2 POWER BY X EACH TIME EQS01660 LIBF FSTOX AND STORE AT LOCAT EQS01670 DC XX ION XX MODIFIED BY EQS01680 STX L1 DUM IR1 EQS01690 LD L DUM SKIP OUT OF LOOP 2 EQS01700 S L DIORD WHEN VALUE FOR IORD EQS01710 BSC L LOOP2,Z& HAS BEEN CALCULATED EQS01720 LD L ZERO SET THE ROW NUMBER EQS01730 STO L L L TO ZERO INITIALLY EQS01740 LIBF FLD SET THE VALUE OF Y EQS01750 DC FZERO TO ZERO MINUS THE EQS01760 LIBF FSUB YINC INITIALLY EQS01770 DC YINC EQS01780 LIBF FSTO EQS01790 DC Y EQS01800 LOOP3 LIBF FLD COMPUTE THE VALUE OF EQS01810 DC Y Y FOR ROW L BY EQS01820 LIBF FADD ADDING THE YINC TO EQS01830 DC YINC THE PREVIOUS VALUE EQS01840 LIBF FSTO OF Y FOR ROW%L-1< EQS01850 DC Y EQS01860 LDD L FONE SET THE ZERO POWER OF EQS01870 STD L YY Y TO ONE EQS01880 LDX 1 0 LOAD IR1 WITH A ZERO EQS01890 LOOP4 LIBF FLDX CALCULATE THE EQS01900 DC YY SUCCESSIVE POWERS OF EQS01910 LIBF FMPY Y BY MULTIPLYING THE EQS01920 DC Y PREVIOUSLY CALCULATED EQS01930 MDX 1 2 POWER BY Y EACH TIME EQS01940 LIBF FSTOX AND STORE AT EQS01950 DC YY LOCATION YY MODIFIED EQS01960 STX L1 DUM BY IR1 EQS01970 LD L DUM SKIP OUT OF LOOP 4 EQS01980 S L DIORD WHEN VALUE FOR IORD EQS01990 BSC L LOOP4,Z& HAS BEEN CALCULATED EQS02000 LD L ZERO INITIALIZE THE VALUE EQS02010 STO L ISUB OF THE COEFF SUBSCRP EQS02020 LDX I1 L EQS02030 LDD L FZERO INITIALIZE THE VALUE EQS02040 STD L1 A OF THE EQUATION EQS02050 LD L NEG2 INITIALIZE THE ORDER EQS02060 STO L N OF THE TERMS EQS02070 LOOP5 LD L N SET THE ORDER OF THE EQS02080 A L TWO TERMS THAT ARE TO EQS02090 STO L N BE CALCULATED EQS02100 LD L ISUB DETERMINE THE SUBSCRP EQS02110 A L N OF THE FIRST COEFF EQS02120 STO L ISUB OF THIS ORDER EQS02130 LD L NEG2 INITIALIZE THE NUMBER EQS02140 STO L J OF THE TERM EQS02150 LOOP6 LD L J DETERMINE THE NUMBER EQS02160 A L TWO OF THE TERM OF THIS EQS02170 STO L J ORDER EQS02180 A L ISUB DETERMINE THE SUBSCRP EQS02190 STO L JSUB OF THIS COEFFICIENT EQS02200 S L DNTRM CHECK TO SEE IF NTERM EQS02210 BSC L OUT,Z- HAS BEEN EXCEEDED EQS02220 LDX I1 JSUB COMPUTE THE VALUE OF EQS02230 LIBF FLDX THIS PARTICULAR TERN EQS02240 DC C FOR COLUMN K AND ROW EQS02250 LD L N L BY MULTIPLYING EQS02260 S L J TOGETHER THE EQS02270 STO L NJ APPROPRIATE COEFF EQS02280 LDX I1 NJ POWER OF X, AND EQS02290 LIBF FMPYX POWER OF Y EQS02300 DC XX EQS02310 LDX I1 J EQS02320 LIBF FMPYX EQS02330 DC YY EQS02340 LDX I1 L ADD VALUE OF THIS EQS02350 LIBF FADDX TERM TO THE VALUE OF EQS02360 DC A PREVIOUSLY COMPUTED EQS02370 LIBF FSTOX TERMS EQS02380 DC A EQS02390 LD L NJ BRANCH IF ALL TERMS EQS02400 BSC L LOOP6,Z- HAVE NOT BEEN COMPUT EQS02410 LD L N BRANCH BACK IF ALL EQS02420 S L DIORD ORDERS HAVE NOT BEEN EQS02430 BSC L LOOP5,Z& COMPUTED EQS02440 OUT LD L L INCREMENT TO THIS ROW EQS02450 A L TWO NUMBER AND BRANCH EQS02460 STO L L BACK IF A(L) HAS NOT EQS02470 S L DIRMX BEEN COMPUTED FOR EQS02480 BSC L LOOP3,Z& ALL ROWS IN COLUMN K EQS02490 BSI L WRTGR EQS02500 LD L K INCREMENT TO NEXT EQS02510 A L ONE COLUMN NUMBER AND EQS02520 STO L K BRANCH BACK IF ALL EQS02530 S L ICMAX COLUMNS HAVE NOT EQS02540 BSC L LOOP1,& BEEN COMPUTED EQS02550 BSI L ERTYP TYPE COMPLETION EQS02560 DC MSAG3 MESSAGE EQS02570 EXIT EQS02580 *************** EQS02590 * INPU1 SUBROUTINE EQS02600 *************** EQS02610 INPU1 NOP SUBROUTINE TO READ EQS02620 LD L FXD55 XMIN,XMAX,YMIN,YMAX, EQS02630 STO L INPTA GRID INTERVAL AND EQS02640 *************** EQS02650 LIBF CARD0 NUMBER OF TERMS FROM EQS02660 * LIBF READ0 NUMBER OF TERMS FROM EQS02670 *************** EQS02680 DC /0000 PARAMETER CARD EQS02690 MDX *-3 EQS02700 *************** EQS02710 LIBF CARD0 EQS02720 * LIBF READ0 EQS02730 *************** EQS02740 DC /1000 EQS02750 DC INPTA EQS02760 *************** EQS02770 LIBF CARD0 EQS02780 * LIBF READ0 EQS02790 *************** EQS02800 DC /0000 EQS02810 MDX *-3 EQS02820 BSI L FFORM EQS02830 BSI L CEFBF EQS02840 LDD L BINFL EQS02850 STD L XMIN EQS02860 LDX 2 10 EQS02870 LD L2 INPTA&10 EQS02880 STO L2 INPTA EQS02890 MDX 2 -1 EQS02900 MDX *-6 EQS02910 BSI L FFORM EQS02920 BSI L CEFBF EQS02930 LDD L BINFL EQS02940 STD L XMAX EQS02950 LDX 2 10 EQS02960 LD L2 INPTA&20 EQS02970 STO L2 INPTA EQS02980 MDX 2 -1 EQS02990 MDX *-6 EQS03000 BSI L FFORM EQS03010 BSI L CEFBF EQS03020 LDD L BINFL EQS03030 STD L YMIN EQS03040 LDX 2 10 EQS03050 LD L2 INPTA&30 EQS03060 STO L2 INPTA EQS03070 MDX 2 -1 EQS03080 MDX *-6 EQS03090 BSI L FFORM EQS03100 BSI L CEFBF EQS03110 LDD L BINFL EQS03120 STD L YMAX EQS03130 LDX 2 10 EQS03140 LD L2 INPTA&40 EQS03150 STO L2 INPTA EQS03160 MDX 2 -1 EQS03170 MDX *-6 EQS03180 BSI L FFORM EQS03190 BSI L CEFBF EQS03200 LDD L BINFL EQS03210 STD L GRID EQS03220 LD L NMZER EQS03230 STO L INPTA&51 EQS03240 STO L INPTA&52 EQS03250 STO L INPTA&53 EQS03260 STO L INPTA+54 EQS03270 LD L PLUS EQS03280 STO L INPTA&50 EQS03290 LIBF DCBIN EQS03300 DC INPTA&50 EQS03310 STO L IORD EQS03320 A L ONE EQS03330 STO L NTERM EQS03340 A L ONE EQS03350 M L NTERM EQS03360 SLT 15 EQS03370 STO L NTERM EQS03380 BSC I INPU1 EQS03390 *************** EQS03400 * INPU2 SUBROUTINE EQS03410 *************** EQS03420 INPU2 NOP SUBROUTINE TO READ EQS03430 LD L ZERO COEFFICIENTS, ONE EQS03440 STO L NUMB PER CARD EQS03450 LD L FXD43 EQS03460 STO L CRDCD EQS03470 LDX 2 0 EQS03480 *************** EQS03490 LIBF CARD0 EQS03500 * LIBF READ0 EQS03510 *************** EQS03520 DC /0000 EQS03530 MDX *-3 EQS03540 *************** EQS03550 ERR3 LIBF CARD0 EQS03560 *RR3 LIBF READ0 EQS03570 *************** EQS03580 DC /1000 EQS03590 DC CRDCD EQS03600 *************** EQS03610 LIBF CARD0 EQS03620 * LIBF READ0 EQS03630 *************** EQS03640 DC /0000 EQS03650 MDX *-3 EQS03660 BSI L CEFBF EQS03670 LDD L BINFL EQS03680 STD L2 C EQS03690 MDX 2 2 EQS03700 LD L NUMB EQS03710 A L ONE EQS03720 STO L NUMB EQS03730 S L NTERM EQS03740 BSC L ERR3,Z& EQS03750 BSC I INPU2 EQS03760 *************** EQS03770 * CEFBF SUBROUTINE EQS03780 *************** EQS03790 CEFBF NOP SUBROUTINE TO EQS03800 LD L CRDCD&30 CONVERT AN E-FORMAT EQS03810 S L PLUS TO FLOATING POINT EQS03820 BSC L NXTA,&- EQS03830 LD L CRDCD&30 TEST FOR FORMAT ERRORS EQS03840 S L AMPER EQS03850 BSC L NXTA,&- EQS03860 LD L CRDCD&30 EQS03870 S L MINUS EQS03880 BSC L NXTA,&- EQS03890 LD L CRDCD&30 EQS03900 BSC L ERROR,Z EQS03910 NXTA LD L CRDCD&31 EQS03920 S L PERID EQS03930 BSC L ERROR,Z EQS03940 LD L CRDCD&40 EQS03950 S L LTRE EQS03960 BSC L ERROR,Z EQS03970 LD L CRDCD&41 EQS03980 S L PLUS EQS03990 BSC L NXTB,&- EQS04000 LD L CRDCD&41 EQS04010 S L AMPER EQS04020 BSC L NXTB,&- EQS04030 LD L CRDCD&41 EQS04040 S L MINUS EQS04050 BSC L NXTB,&- EQS04060 LD L CRDCD&41 EQS04070 BSC L ERROR,Z EQS04080 NXTB LD L CRDCD&30 CONVERT HIGH ORDER DIGITS EQS04090 STO L EFORM TO BINARY AND THEN TO EQS04100 LD L ZERO FLOATING POINT EQS04110 STO L EFORM&1 EQS04120 LD L CRDCD&32 EQS04130 STO L EFORM&2 EQS04140 LD L CRDCD&33 EQS04150 STO L EFORM&3 EQS04160 LD L CRDCD&34 EQS04170 STO L EFORM&4 EQS04180 LD L CRDCD&35 EQS04190 STO L EFORM&5 EQS04200 LIBF DCBIN EQS04210 DC EFORM EQS04220 STO L FXMNT EQS04230 LIBF FLOAT EQS04240 LIBF FSTO EQS04250 DC MANT EQS04260 LD L ZERO CONVERT LOW ORDER DIGITS EQS04270 STO L EFORM&1 TO BINARY AND THEN TO EQS04280 LD L CRDCD&36 FLOATING POINT EQS04290 STO L EFORM&2 EQS04300 LD L CRDCD&37 EQS04310 STO L EFORM&3 EQS04320 LD L CRDCD&38 EQS04330 STO L EFORM&4 EQS04340 LD L CRDCD&39 EQS04350 STO L EFORM&5 EQS04360 LIBF DCBIN EQS04370 DC EFORM EQS04380 STO L FXMNR EQS04390 LIBF FLOAT EQS04400 LIBF FSTO EQS04410 DC MANR EQS04420 LD L FXMNT ARE HIGH ORDER DIGITS ZERO EQS04430 BSC L *&4,Z EQS04440 LD L FXMNR NO - CALCULATE EQS04450 BSC L ALTER,&- CHARACTERISTIC EQS04460 LD L CRDCD&41 YES - ARE LOW ORDER DIGITS EQS04470 STO L EFORM ZERO EQS04480 LD L ZERO YES - GO TO ALTER EQS04490 STO L EFORM&1 NO - CONVERT EXPONENT TO EQS04500 STO L EFORM&2 BINARY, COMBINE TWO EQS04510 STO L EFORM&3 FLOATING POINT EQS04520 LD L CRDCD&42 NUMBERS AND ADJUST EQS04530 STO L EFORM&4 CHARACTERISTIC FOR EQS04540 LD L CRDCD&43 EXPONENNT OF E-FORMAT EQS04550 STO L EFORM&5 EQS04560 LIBF DCBIN EQS04570 DC EFORM EQS04580 STO L EXPON EQS04590 LIBF FLD EQS04600 DC FTEN EQS04610 LIBF FAXI EQS04620 DC EXPON EQS04630 LIBF FSTO EQS04640 DC EXPT EQS04650 LIBF FLD EQS04660 DC MANR EQS04670 LIBF FMPY EQS04680 DC TENG4 EQS04690 LIBF FADD EQS04700 DC MANT EQS04710 LIBF FMPY EQS04720 DC TENG4 EQS04730 LIBF FMPY EQS04740 DC EXPT EQS04750 LIBF FSTO EQS04760 DC BINFL EQS04770 BSC I CEFBF RETURN EQS04780 ALTER LDD L FZERO SET VALUE TO FLOATING EQS04790 STD L BINFL POINT ZERO EQS04800 BSC I CEFBF RETURN EQS04810 ERROR BSI L ERTYP TYPE FORMAT ERROR MESSAGE EQS04820 DC ERRU6 EQS04830 BSI L ERTYP EQS04840 DC MSAG4 EQS04850 WAIT EQS04860 EXIT EQS04870 *************** EQS04880 * FFORM SUBROUTINE EQS04890 *************** EQS04900 FFORM NOP SUBROUTINE TO EQS04910 LDX 2 14 CONVERT AN F-FORMAT EQS04920 LD L NMZER CARD CODE NUMBER EQS04930 STO L2 CRDCD+30 TO E-FORMAT EQS04940 MDX 2 -1 SET E-FORMAT AREA TO EQS04950 MDX *-4 ZERO CHARACTERS EQS04960 LD L PLUS STORE PLUS, PERIOD AND EQS04970 STO L CRDCD+30 E IN E-FORMAT WORD EQS04980 LD L PERID EQS04990 STO L CRDCD+31 EQS05000 LD L LTRE EQS05010 STO L CRDCD+40 EQS05020 LD L FX11 EQS05030 STO L FNDPR EQS05040 LDX 1 10 EQS05050 FFRM LD L1 INPTA TEST FOR EQS05060 BSC L FIND1,+- BLANK EQS05070 LD L1 INPTA PLUS SIGN EQS05080 S L PLUS EQS05090 BSC L FIND1,+- EQS05100 LD L1 INPTA AMPERS AND EQS05110 S L AMPER EQS05120 BSC L FIND1,+- EQS05130 LD L1 INPTA MINUS EQS05140 S L MINUS EQS05150 BSC L BCKF,Z EQS05160 LD L MINUS EQS05170 STO L CRDCD+30 EQS05180 FIND1 LD L NMZER EQS05190 STO L1 INPTA EQS05200 MDX 1 -1 EQS05210 MDX FIND2 EQS05220 MDX FIND2 EQS05230 BCKF LD L1 INPTA PERIOD EQS05240 S L PERID EQS05250 BSC L BCKG,Z EQS05260 STX L1 FNDPR EQS05270 BCKG MDX 1 -1 LOOP TEST EQS05280 MDX *+1 EQS05290 MDX *+2 EQS05300 BSC L FFRM TEST ANOTHER CHARACTER EQS05310 FIND2 STX L1 FNDEN CALCULATE AND STORE EQS05320 LD L FNDPR EXPONENT EQS05330 S L FNDEN EQS05340 S L ONE EQS05350 LIBF BINDC EQS05360 DC EFORM EQS05370 LD L EFORM EQS05380 STO L CRDCD+41 EQS05390 LD L EFORM+4 EQS05400 STO L CRDCD+42 EQS05410 LD L EFORM+5 EQS05420 STO L CRDCD+43 EQS05430 LD L TEN IS HIGH ORDER CHARACTER EQS05440 S L FNDEN IN RIGHTMOST POSITION EQS05450 BSC L FIND4,+ YES - GO TO FIND4 EQS05460 STO L FFMNB NO - STORE COUNT OF EQS05470 MDX 1 1 CHARACTERS TO BE MOVED EQS05480 LD L1 INPTA LOAD SIGNIFICANT DIGIT EQS05490 STO L CRDCD+32 OF F-FORMAT TO E-FORMAT EQS05500 LD L ONE MANTISSA EQS05510 STO L FFMCT EQS05520 S L FFMNB TEST FOR SINGLE DIGIT IN EQS05530 BSC L ONWD,- F-FORMAT EQS05540 LDX 2 0 YES - GO TO ONWD EQS05550 BCKH MDX 2 1 NO - MOVE DIGIT TO EQS05560 BCKJ MDX 1 1 E-FORMAT MANTISSA EQS05570 MDX L FFMCT,+1 EQS05580 LD L1 INPTA TEST FOR PERIOD EQS05590 S L PERID EQS05600 BSC L BCKI,+- EQS05610 LD L1 INPTA EQS05620 STO L2 CRDCD+32 EQS05630 LD L FFMCT EQS05640 S L FFMNB EQS05650 BSC L BCKH,+Z EQS05660 BSC I FFORM RETURN EQS05670 FIND4 LD L NMZER STORE ZERO IN TENS POSITIONEQS05680 STO L CRDCD+44 OF EXPONENT EQS05690 ONWD BSC I FFORM EQS05700 BCKI LD L FFMCT ARE ALL CHARACTERS MOVED EQS05710 S L FFMNB EQS05720 BSC L BCKJ,+Z NO - GO TO BCKJ EQS05730 BSC I FFORM EQS05740 *************** EQS05750 * NAME SUBROUTINE EQS05760 *************** EQS05770 NAME NOP SUBROUTINE TO EQS05780 LD L FOUR READ THE GRID EQS05790 STO L BNAME-1 NAME FROM A CARD EQS05800 *************** EQS05810 LIBF CARD0 AND CONVERT EQS05820 * LIBF READ0 AND CONVERT EQS05830 *************** EQS05840 DC /0000 TO EBCDIC EQS05850 MDX *-3 EQS05860 *************** EQS05870 LIBF CARD0 EQS05880 * LIBF READ0 EQS05890 *************** EQS05900 DC /1000 EQS05910 DC BNAME-1 EQS05920 *************** EQS05930 LIBF CARD0 EQS05940 * LIBF READ0 EQS05950 *************** EQS05960 DC /0000 EQS05970 MDX *-3 EQS05980 LIBF SPEED EQS05990 DC /0000 EQS06000 DC BNAME EQS06010 DC ANAME EQS06020 DC 4 EQS06030 BSC I NAME EQS06040 *************** EQS06050 * LOCAT SUBROUTINE EQS06060 *************** EQS06070 LOCAT NOP SUBROUTINE TO EQS06080 LD L FX20 SEARCH FOR THE EQS06090 STO L WKIO TRAILER RECORD EQS06100 LD L SCBGN OR THE GRID NAME EQS06110 STO L WKIO+1 IN THE DISK DATA EQS06120 AGN LIBF DISKN AREA EQS06130 DC /5000 EQS06140 DC WKIO SETS IFOUN TO EQS06150 DC ERRS ZERO IF TRAILER EQS06160 LIBF DISKN RECORD IS FOUND EQS06170 DC /1000 SETS IFOUN TO EQS06180 DC WKIO ONE IF GRID NAME EQS06190 DC ERRS IS FOUND EQS06200 LIBF DISKN EQS06210 DC /0000 EQS06220 DC WKIO EQS06230 MDX *-4 EQS06240 LIBF FLD EQS06250 DC TRAIL EQS06260 LIBF FSUB EQS06270 DC WKIO+2 EQS06280 LIBF FSTO EQS06290 DC DUMY EQS06300 LD L DUMY EQS06310 BSC L OK,+- EQS06320 LIBF FLD EQS06330 DC WKIO+2 EQS06340 LIBF FSUB EQS06350 DC ANAME EQS06360 LIBF FSTO EQS06370 DC DUMY EQS06380 LD L DUMY EQS06390 BSC L FND,+- EQS06400 LD L WKIO+6 EQS06410 BSC L EROB,& EQS06420 M L FOUR EQS06430 STD L DUMY EQS06440 D L THREE EQS06450 STO L SCINC EQS06460 M L THREE EQS06470 D L ONE EQS06480 S L DUMY+1 EQS06490 BSC L AA3,- EQS06500 A L FOUR EQS06510 A L SCINC EQS06520 STO L SCINC EQS06530 AA3 LD L WKIO&1 EQS06540 A L SCINC EQS06550 STO L WKIO+1 EQS06560 S L SCBGN EQS06570 BSC L EROB,& EQS06580 S L SCLGT EQS06590 BSC L EROB,- EQS06600 BSC L AGN EQS06610 FND LD L ONE TRANSFER HEADER RECORD EQS06620 STO L IFOUN DATA FROM WKIO TO EQS06630 LDD L WKIO+4 STORAGE EQS06640 STD L GRID EQS06650 LD L WKIO+6 EQS06660 STO L ICMAX EQS06670 LD L WKIO+7 EQS06680 STO L IRMAX EQS06690 LD L WKIO&1 EQS06700 STO L SCSTR EQS06710 BSC I LOCAT EQS06720 OK LD L ZERO EQS06730 STO L IFOUN EQS06740 LD L WKIO&1 EQS06750 STO L SCSTR EQS06760 BSC I LOCAT EQS06770 ERRS DC 0 DISK ERROR MESSAGE EQS06780 LIBF WRTY0 EQS06790 DC /2000 EQS06800 DC MSAG5 EQS06810 SRA 16 EQS06820 BSC I ERRS EQS06830 EROB BSI L ERTYP EQS06840 DC MSAG7 NO TRAILER RECORD MESSAGE EQS06850 BSI L ERTYP EQS06860 DC MSAG4 EQS06870 WAIT EQS06880 EXIT EQS06890 *************** EQS06900 * SCCOM SUBROUTINE EQS06910 *************** EQS06920 SCCOM NOP COMPUTE SECTOR ADDRESS EQS06930 LD L K FROM THE COLUMN NUMBER EQS06940 S L ONE AND BEGINNING SECTOR EQS06950 M L ONE OF DATA SET AREA EQS06960 D L THREE TEST ADDRESS OF SECTOR EQS06970 STO L DUMY AGAINST UPPER AND LOWER EQS06980 M L FOUR LIMITS OF DATA SET AREA EQS06990 D L ONE EQS07000 STO L SCINC EQS07010 LD L DUMY EQS07020 M L THREE EQS07030 D L ONE EQS07040 STO L DUMY EQS07050 LD L K EQS07060 S L DUMY EQS07070 S L ONE EQS07080 STO L SCINX EQS07090 A L SCINC EQS07100 STO L SCINC EQS07110 A L SCSTR EQS07120 STO L SCLOC EQS07130 S L SCBGN EQS07140 BSC L ER,Z+ EQS07150 S L SCLGT EQS07160 BSC L ER,- EQS07170 LD L FX100 EQS07180 M L SCINX EQS07190 D L ONE EQS07200 A L FX22 EQS07210 STO L ININX EQS07220 BSC I SCCOM EQS07230 ER BSI L ERTYP EQS07240 DC MSAG7 EQS07250 BSI L ERTYP EQS07260 DC MSAG4 EQS07270 WAIT EQS07280 EXIT EQS07290 *************** EQS07300 * WRTOU SUBROUTINE EQS07310 *************** EQS07320 WRTOU NOP WRITE MASTER HEADER RECORD EQS07330 LDX 1 22 EQS07340 LDX 2 20 EQS07350 LDD L ZNIL EQS07360 STD L1 WKIO-2 EQS07370 MDX 1 -2 EQS07380 MDX 2 -2 EQS07390 MDX *-5 EQS07400 LD L SCBGN EQS07410 A L SCLGT EQS07420 S L SCSTR EQS07430 M L THREE EQS07440 D L FOUR EQS07450 S L ICMAX EQS07460 BSC L NOROM,+Z NO SPACE AVAILABLE EQS07470 LD L FX20 EQS07480 STO L WKIO EQS07490 LD L SCSTR EQS07500 STO L WKIO+1 EQS07510 LDD L ANAME EQS07520 STD L WKIO+2 EQS07530 LDD L GRID EQS07540 STD L WKIO+4 EQS07550 LD L ICMAX EQS07560 STO L WKIO&6 EQS07570 LD L IRMAX EQS07580 STO L WKIO&7 EQS07590 LDD L XMIN EQS07600 STD L WKIO+8 EQS07610 LDD L YMIN EQS07620 STD L WKIO+10 EQS07630 LIBF DISKN EQS07640 DC /5000 EQS07650 DC WKIO EQS07660 DC ERRS EQS07670 LIBF DISKN EQS07680 DC /4000 EQS07690 DC WKIO EQS07700 LIBF DISKN EQS07710 DC /0000 EQS07720 DC WKIO EQS07730 MDX *-4 EQS07740 BSC I WRTOU EQS07750 NOROM BSI L ERTYP EQS07760 DC MSAG8 EQS07770 BSI L ERTYP EQS07780 DC MSAG4 EQS07790 WAIT EQS07800 EXIT EQS07810 *************** EQS07820 * WRTGR SUBROUTINE EQS07830 *************** EQS07840 WRTGR NOP SUBROUTINE TO EQS07850 BSI L SCCOM WRITE THE EQS07860 LIBF DISKN COLUMNS IN THE EQS07870 DC /0000 DISK DATA AREA EQS07880 DC WKIO EQS07890 MDX *-4 EQS07900 LD L FX640 EQS07910 STO L WKIO EQS07920 LD L SCLOC EQS07930 STO L WKIO+1 EQS07940 LIBF DISKN EQS07950 DC /5000 EQS07960 DC WKIO EQS07970 DC ERRS EQS07980 LIBF DISKN EQS07990 DC /1000 EQS08000 DC WKIO EQS08010 DC ERRS EQS08020 LIBF DISKN EQS08030 DC /0000 EQS08040 DC WKIO EQS08050 MDX *-4 EQS08060 LD L ININX EQS08070 A L FX418 EQS08080 STO L DUMY EQS08090 LDX I1 DUMY EQS08100 LDX I2 FX420 EQS08110 LDD L ZNIL EQS08120 STD L1 WKIO EQS08130 MDX 1 -2 EQS08140 MDX 2 -2 EQS08150 MDX *-5 EQS08160 LD L IRMAX SET Z01 INDEX TO 2*IRMAX EQS08170 A L IRMAX EQS08180 STO L DUMY EQS08190 LDX I2 DUMY EQS08200 LD L ININX EQS08210 A L FX20 SET WKIO INDEX TO EQS08220 A L DUMY ININX+20+2*IRMAX-2 EQS08230 S L TWO EQS08240 STO L DUMY EQS08250 LDX I1 DUMY EQS08260 LDD L2 A-2 EQS08270 STD L1 WKIO EQS08280 MDX 1 -2 EQS08290 MDX 2 -2 EQS08300 MDX *-7 EQS08310 LDX I1 ININX EQS08320 LD L K EQS08330 STO L1 WKIO EQS08340 LD L ONE EQS08350 STO L1 WKIO+1 EQS08360 LD L IRMAX EQS08370 STO L1 WKIO&2 EQS08380 LIBF DISKN EQS08390 DC /4000 EQS08400 DC WKIO EQS08410 BSC I WRTGR EQS08420 *************** EQS08430 * REWRT SUBROUTINE EQS08440 *************** EQS08450 REWRT NOP SUBROUTINE TO EQS08460 LD L ICMAX PLACE TRAILER EQS08470 M L FOUR RECORD FOLLOWING EQS08480 STD L DUMY LAST COLUMN IN EQS08490 D L THREE THE DISK DATA AREA EQS08500 STO L SCINC EQS08510 M L THREE EQS08520 D L ONE EQS08530 S L DUMY+1 EQS08540 BSC L AA2,- EQS08550 A L FOUR EQS08560 A L SCINC EQS08570 STO L SCINC EQS08580 AA2 LD L SCINC EQS08590 A L SCSTR EQS08600 STO L XXXX EQS08610 LIBF DISKN EQS08620 DC /0000 EQS08630 DC WKIO EQS08640 MDX *-4 EQS08650 LD L XXXX EQS08660 STO L WKIO+1 EQS08670 LD L TWO EQS08680 STO L WKIO EQS08690 LDD L TRAIL EQS08700 STD L WKIO+2 EQS08710 LIBF DISKN EQS08720 DC /5000 EQS08730 DC WKIO EQS08740 DC ERRS EQS08750 LIBF DISKN EQS08760 DC /4000 EQS08770 DC WKIO EQS08780 LIBF DISKN EQS08790 DC /0000 EQS08800 DC WKIO EQS08810 MDX *-4 EQS08820 BSC I REWRT EQS08830 *************** EQS08840 * ERTYP SUBROUTINE EQS08850 *************** EQS08860 ERTYP NOP SUBROUTINE TO EQS08870 LD I ERTYP WRITE MESSAGES EQS08880 STO L ERTX ON THE CONSOLE EQS08890 MDX L ERTYP,&1 TYPEWRITER EQS08900 LD L ERTX EQS08910 S L ONE EQS08920 STO *&1 EQS08930 LD L 0 EQS08940 STO L ERTX+2 EQS08950 M L ONE EQS08960 D L TWO EQS08970 STO L TYPE EQS08980 LIBF EBPRT EQS08990 DC /0000 EQS09000 ERTX DC 0 EQS09010 DC TYPE+1 EQS09020 DC 0 EQS09030 LIBF WRTY0 EQS09040 DC /2000 EQS09050 DC TYPE EQS09060 LIBF WRTY0 EQS09070 DC /2000 EQS09080 DC CONTL EQS09090 LIBF WRTY0 EQS09100 DC /0000 EQS09110 MDX *-3 EQS09120 BSC I ERTYP EQS09130 *************** EQS09140 * DEFINE CONSTANTS EQS09150 *************** EQS09160 SCBGN DC 448 START OF DATA SET AREA EQS09170 SCLGT DC 808 NO. OF SECT. IN D.S. AREA EQS09180 THREE DC 3 EQS09190 FOUR DC 4 EQS09200 FIVE DC 5 EQS09210 SIX DC 6 EQS09220 SEVEN DC 7 EQS09230 FX15 DC 15 EQS09240 FX19 DC 19 EQS09250 FX20 DC 20 EQS09260 FX22 DC 22 EQS09270 FX100 DC 100 EQS09280 FX272 DC 272 EQS09290 FX280 DC 280 EQS09300 FX400 DC 400 EQS09310 FX402 DC 402 EQS09320 FX418 DC 418 EQS09330 FX420 DC 420 EQS09340 FX422 DC 422 EQS09350 FX640 DC 640 EQS09360 FX808 DC 808 EQS09370 ZNIL DEC -1.0E30 EQS09380 TRAIL DEC 9999. EQS09390 XXXX DC /FFFF EQS09400 YYYY DC /EEEE EQS09410 MAXCR DC 200 EQS09420 MAXTR DC 66 EQS09430 PLUS DC /80A0 EQS09440 MINUS DC /4000 EQS09450 AMPER DC /8000 EQS09460 PERID DC /8420 EQS09470 LTRE DC /8100 EQS09480 NMZER DC /2000 EQS09490 ZERO DC 0 EQS09500 ONE DC 1 EQS09510 TWO DC 2 EQS09520 TEN DC 10 EQS09530 ELEVN DC 11 EQS09540 FX11 DC 11 EQS09550 TWELV DC 12 EQS09560 FXD43 DC 43 EQS09570 FXD55 DC 55 EQS09580 FXD80 DC 80 EQS09590 NEG2 DC -2 EQS09600 FZERO DEC 0. EQS09610 FONE DEC 1. EQS09620 FTWO DEC 2. EQS09630 F3 DEC 3. EQS09640 F8 DEC 8. EQS09650 FTEN DEC 10. EQS09660 TENG4 DEC 1.0E-4 EQS09670 GFAC DEC 1.9999 EQS09680 *************** EQS09690 * DEFINE ERROR MESSAGES EQS09700 *************** EQS09710 DC 30 EQS09720 ERRU1 EBC .GRID INTERVAL IS NOT POSITIVE . EQS09730 DC 50 EQS09740 ERRU2 EBC .SPECIFIED NUMBER OF TERMS EXCEEDS . EQS09750 EBC .MAXIMUM ALLOWED . EQS09760 DC 46 EQS09770 ERRU3 EBC .MAX AND MIN VALUES ARE NOT. EQS09780 EBC . PROPERLY SPECIFIED . EQS09790 DC 58 EQS09800 ERRU4 EBC .REQUIRED NUMBER OF COLUMNS OR ROWS. EQS09810 EBC . EXCEEDS MAXIMUM ALLOWED. EQS09820 DC 30 EQS09830 ERRU6 EBC .INPUT DATA NOT IN PROPER FORM . EQS09840 DC 16 EQS09850 MSAG1 EBC .EQSCA BEGINNING . EQS09860 DC 22 EQS09870 MSAG2 EBC .OUTPUT GRID NAMED . EQS09880 DC /4040 EQS09890 DC /4040 EQS09900 DC 16 EQS09910 MSAG3 EBC .EQSCA COMPLETED . EQS09920 DC 30 EQS09930 MSAG4 EBC .PUSH START FOR EXIT TO MONITOR. EQS09940 MSAG5 DC 20 DISK ERROR MESSAGE EQS09950 DC /3020 EQS09960 DC /9858 EQS09970 DC /2135 EQS09980 DC /6060 EQS09990 DC /5060 EQS10000 DC /2121 EQS10010 DC /9C34 EQS10020 DC /6070 EQS10030 DC /2074 EQS10040 DC /3C9C EQS10050 DC /3421 EQS10060 DC /7C50 EQS10070 DC /1821 EQS10080 DC /3C74 EQS10090 DC /3021 EQS10100 DC /6034 EQS10110 DC /989C EQS10120 DC /3C60 EQS10130 DC /9C21 EQS10140 DC /8103 EQS10150 DC 26 EQS10160 MSAG6 EBC .NAME ALREADY USED ON DISK . EQS10170 DC 30 EQS10180 MSAG7 EBC .UNABLE TO FIND TRAILER RECORD . EQS10190 DC 54 EQS10200 MSAG8 EBC .REQUIRED NUMBER OF COLUMNS. EQS10210 EBC .EXCEEDS AVAILABLE DISK AREA . EQS10220 CONTL DC 1 EQS10230 DC /8103 EQS10240 *************** EQS10250 * ALLOCATE STORAGE EQS10260 *************** EQS10270 GRID BSS E 2 GRID INTERVAL EQS10280 NTERM BSS 1 NUMBER OF TERMS EQS10290 XMAX BSS E 2 EQS10300 XMIN BSS E 2 EQS10310 RESUL BSS E 2 TEMPORARY STORAGE EQS10320 YMAX BSS E 2 EQS10330 YMIN BSS E 2 EQS10340 ICMAX BSS 1 EQS10350 ACMAX BSS E 2 MAX. COLUMN FLOATING PT. EQS10360 CCMAX BSS E 2 EQS10370 IRMAX BSS 1 EQS10380 ARMAX BSS E 2 MAX. ROW FLOATING POINT EQS10390 DNTRM BSS 1 2*NO. OF TERMS EQS10400 DIRMX BSS 1 2*NO. OF ROWS EQS10410 IORD BSS 1 ORDER OF EQUATION EQS10420 DIORD BSS 1 2*ORDER EQS10430 K BSS 1 EQS10440 X BSS E 2 EQS10450 XX BSS E 22 POWER OF X EQS10460 DUM BSS 1 EQS10470 L BSS 1 EQS10480 Y BSS E 2 EQS10490 YY BSS E 22 POWER OF Y EQS10500 ISUB BSS 1 EQS10510 A BSS E 400 COLUMN VECTOR EQS10520 N BSS 1 INDEXING PARAMETER EQS10530 J BSS 1 EQS10540 JSUB BSS 1 EQS10550 C BSS E 132 COEFF. STORAGE EQS10560 NJ BSS 1 EQS10570 CRDCD BSS 46 CONVERTED CARD EQS10580 EFORM BSS 16 CONVERSSION AREA EQS10590 FXMNT BSS 1 TEMPORARY STORAGE EQS10600 MANT BSS E 2 EQS10610 MANR BSS E 2 EQS10620 FXMNR BSS 1 EQS10630 EXPON BSS 1 EQS10640 EXPT BSS E 2 EQS10650 BINFL BSS E 2 EQS10660 NUMB BSS 1 EQS10670 INDF BSS 1 EQS10680 INDG BSS 1 EQS10690 OUTS BSS 1 EQS10700 BSS 4 EQS10710 BSS 4 EQS10720 BSS 4 EQS10730 OUTT BSS 1 EQS10740 BSS 4 EQS10750 BSS 4 EQS10760 BSS 4 EQS10770 BSS E 1 ALIGN BOUNDARY EQS10780 AA BSS 81 CARD INPUT AREA EQS10790 DUMM BSS E 4 TEMPORARY STORAGE EQS10800 DUMN BSS 1 EQS10810 CHKK BSS 29 EQS10820 CHLL BSS E 16 EQS10830 ANAME BSS E 2 EQS10840 BSS E 2 EQS10850 BNAME BSS E 4 EQS10860 DUMY BSS E 2 EQS10870 INPTA BSS 81 INPUT AREA EQS10880 DREND BSS E 2 EQS10890 IFOUN BSS 1 EQS10900 ININX BSS 1 EQS10910 IRMIN BSS 1 EQS10920 SCLOC BSS 1 DATA SET EQS10930 SCINC BSS 1 LOCATION PARAMETERS EQS10940 SCINX BSS 1 EQS10950 SCSTR BSS 1 EQS10960 FNDEN BSS 1 EQS10970 FNDPR BSS 1 EQS10980 FFMNB BSS 1 EQS10990 FFMCT BSS 1 EQS11000 XINC BSS E 2 X INTERVAL EQS11010 YINC BSS E 2 Y INTERVAL EQS11020 WKIO BSS E 642 DISK I/O BUFFER EQS11030 TYPE BSS 30 MESSAGE AREA EQS11040 END GO EQS11050 // DUP EQS11060 *STORE WS UA EQSCA EQS11070 // JOB DSK00010 // DUP DSK00020 *DELETE DSKIN DSK00030 // ASM DSK00040 *LIST DSK00050 ******************** DSK00060 * TWO SUBROUTINES - ONE TO LOCATE A GRID DATA SET DSK00070 * THE SECOND TO READ A COLUMN AND TRANSFER A SUBSET DSK00080 * TO THE WORK MATRIX, ZG DSK00090 ******************** DSK00100 ENT DSKIN DSK00110 ENT LOCAT DSK00120 ENT COLIN DSK00130 FC EQU 126 DSK00140 ******************** DSK00150 * LOCATE A GRID DATA SET ON THE DISK DSK00160 * CALL LOCAT (NAME,IFOUN,GRID,ICMAX,JRMAX,XMIN, DSK00170 * YMIN,NSCTR) DSK00180 ******************** DSK00190 DSKIN NOP DSK00200 LOCAT NOP DSK00210 LD I LOCAT LOAD NAME ADDRESS TO ACC DSK00220 STO LOC1 DSK00230 LD FX20 INITIALIZE DISK ADDRESSES DSK00240 STO L WKIO AND WORD COUNT DSK00250 LD SCBGN DSK00260 STO L WKIO+1 DSK00270 AGN LIBF DISK1 READ MASTER HEADER RECORD DSK00280 DC /5000 DSK00290 DC WKIO DSK00300 DC ERRS DSK00310 LIBF DISK1 DSK00320 DC /1000 DSK00330 DC WKIO DSK00340 DC ERRS DSK00350 LIBF DISK1 DSK00360 DC /0000 DSK00370 DC WKIO DSK00380 MDX *-4 DSK00390 LIBF FLD TEST FOR TRAILER LABEL DSK00400 DC TRAIL DSK00410 LIBF FSUB DSK00420 DC WKIO+2 DSK00430 LDX I1 LOCAT DSK00440 LD 3 FC DSK00450 BSC L OK,+- DSK00460 LIBF FLD TEST FOR NAME IN HEADER DSK00470 DC WKIO+2 RECORD DSK00480 LIBF FSUB DSK00490 LOC1 DC 0 NAME ADDRESS DSK00500 LD 3 FC DSK00510 BSC L FND,+- DSK00520 LD L WKIO+6 LOAD NO OF COLUMNS TO ACC DSK00530 S ONE SET COLUMN COUNT TO A DSK00540 SRT 16 MULTIPLE OF FOUR, MODULI DSK00550 D THREE THREE DSK00560 A ONE DSK00570 SLA 2 *4 DSK00580 A L WKIO+1 DSK00590 STO L WKIO+1 STORE NEW DISK ADDRESSS IN DSK00600 S SCBGN WKIO+1 DSK00610 BSC L EROB,+ TEST SECTOR ADDRESS DSK00620 S SCLGT AGAINST LIMITS DSK00630 BSC L EROB,- DSK00640 MDX AGN DSK00650 * STORE MASTER HEADER DATA DSK00660 FND LDD L WKIO+4 GRID DSK00670 STD I1 2 DSK00680 LD L WKIO+6 ICMAX DSK00690 STO I1 3 DSK00700 LD L WKIO+7 JRMAX DSK00710 STO I1 4 DSK00720 LDD L WKIO+8 XMIN DSK00730 STD I1 5 DSK00740 LDD L WKIO+10 YMIN DSK00750 STD I1 6 DSK00760 LD TWO FOUND NAME FLAG DSK00770 MDX RTRN DSK00780 OK LD ONE NO NAME FLAG DSK00790 RTRN STO I1 1 DSK00800 LD L WKIO+1 STORE SECTOR ADDRESS DSK00810 STO I1 7 DSK00820 BSC L1 8 RETURN DSK00830 EROB LD THREE NO TRAILER RECORD FLAG DSK00840 MDX RTRN DSK00850 ERRS LDX I1 LOCAT DSK00860 LD FOUR DISK ERROR DSK00870 MDX RTRN DSK00880 ******************** DSK00890 * CONSTANTS DSK00900 ******************** DSK00910 ONE DC 1 DSK00920 TWO DC 2 DSK00930 THREE DC 3 DSK00940 FOUR DC 4 DSK00950 FX20 DC 20 DSK00960 FX22 DC 22 DSK00970 FX100 DC 100 DSK00980 FX320 DC 320 DSK00990 SCBGN DC 448 DSK01000 SCLGT DC 808 DSK01010 TRAIL DEC 9999. DSK01020 DZ000 EQU /00F2 DSK01030 ******************** DSK01040 * STORAGE DSK01050 ******************** DSK01060 ININX BSS 1 INITIAL COL ADDRESS IN WKIODSK01070 SCINX BSS 1 MULTIPLIER FOR ININX DSK01080 DUMY BSS 1 TEMPORARY STORAGE DSK01090 ******************** DSK01100 * READ A COLUMN FROM A GRID DATA SET ON DISK AND DSK01110 * STORE 51 ELEMENTS IN THE LAST COLUMN OF THE ZG DSK01120 * MATRIX DSK01130 * CALL COLIN (IC,JLIMX,JQ,AZ,IFOUN,NSCTR) DSK01140 * IC=COLUMN NUMBER DSK01150 * JLIMX=FIRST ROW OF SUBSET DSK01160 * JQ=NUMBER OF ELEMENTS TO BE MOVED DSK01170 * AZ=ADDRESS-2 OF ZG COLUMN 6 DSK01180 * IFOUN=FLAG DSK01190 * NSCTR=SECTOR ADDRESS OF COLUMN DSK01200 ******************** DSK01210 COLIN NOP DSK01220 LDX I1 COLIN CALCULATE SECTOR ADDRESS DSK01230 LD I1 0 FOR COLUMN DSK01240 S ONE DSK01250 SRT 16 DSK01260 D THREE DSK01270 SLT 2 DSK01280 STO DUMY DSK01290 SLT 14 DSK01300 STO SCINX DSK01310 A DUMY DSK01320 A I1 5 ADD NSCTR DSK01330 STO DUMY DSK01340 S SCBGN DSK01350 BSC L EROB1,Z+ TEST SECTOR ADDRESS DSK01360 S SCLGT AGAINST LIMITS DSK01370 BSC L EROB1,- DSK01380 LD DUMY STORE SECOND SECTOR ADDRESSDSK01390 A ONE DSK01400 STO L WKIO+321 DSK01410 LD FX100 CALC WKIO ADDRESS OF COL DSK01420 M SCINX DSK01430 SLT 16 DSK01440 A FX22 DSK01450 STO ININX DSK01460 LD FX320 STORE COUNT DSK01470 STO L WKIO+320 DSK01480 LIBF DISK1 READ SECOND SECTOR OF DATA DSK01490 DC /5000 DSK01500 DC WKIO+320 DSK01510 DC ERRS1 DSK01520 LIBF DISK1 DSK01530 DC /1000 DSK01540 DC WKIO+320 DSK01550 DC ERRS1 DSK01560 LIBF DISK1 DSK01570 DC /0000 DSK01580 DC WKIO+320 DSK01590 MDX *-4 DSK01600 LD DUMY STORE FIRST SECTOR ADDRESS DSK01610 STO WKIO+1 DSK01620 LD FX320 DSK01630 STO WKIO DSK01640 LIBF DISK1 READ FIRST SECTOR OF DATA DSK01650 DC /5000 DSK01660 DC WKIO DSK01670 DC ERRS1 DSK01680 LIBF DISK1 DSK01690 DC /1000 DSK01700 DC WKIO DSK01710 DC ERRS1 DSK01720 LIBF DISK1 DSK01730 DC /0000 DSK01740 DC WKIO DSK01750 MDX *-4 DSK01760 LDX I1 COLIN SET INDEX REGISTERS AND DSK01770 LD I1 1 TRANSFER COLUMN SUBSET DSK01780 SLA 1 TO WORK MATRIX DSK01790 A ININX IR1=JLIMX*2+ININX+20 DSK01800 A FX20 DSK01810 STO DUMY DSK01820 LDX I1 DUMY DSK01830 LDX I2 COLIN STORE AZ ADDRESS IN DATA DSK01840 LD 2 3 TRANSFER LOOP DSK01850 STO COL1+1 DSK01860 SLA 16 LOAD -JQ*2 INTO IR2 DSK01870 S I2 2 DSK01880 SLA 1 DSK01890 STO DUMY DSK01900 LDX I2 DUMY DSK01910 LDD L1 WKIO TRANSFER COLUMN SUBSET DSK01920 COL1 STD L2 0 TO WORK MATRIX DSK01930 MDX 1 -2 DSK01940 MDX 2 2 DSK01950 MDX *-7 DSK01960 LDX I1 COLIN STORE ZERO IN IFOUN DSK01970 SLA 16 SUCCESS FLAG DSK01980 COL2 STO I1 4 DSK01990 BSC L1 6 DSK02000 EROB1 LD ONE STORE ONE IN IFOUN DSK02010 MDX COL2 NO TRAILER RECORD FLAG DSK02020 ERRS1 LDX I1 COLIN DISK ERROR FLAG DSK02030 LD TWO DSK02040 MDX COL2 DSK02050 WKIO BSS E 642 DISK IO BUFFER DSK02060 END DSKIN DSK02070 // DUP DSK02080 *STORE WS UA DSKIN DSK02090 // JOB EQO00010 // DUP EQO00020 *DELETE EQORT EQO00030 // ASM EQO00040 *LIST EQO00050 *************** EQO00060 * EQUATION EVALUATION EQORT EQO00070 *************** EQO00080 GO LIBF WRTY0 EQO00090 DC /2000 EQO00100 DC CONTL EQO00110 BSI L ERTYP TYPE BEGINNING EQORT EQO00120 DC MSAG1 EQO00130 BSI L NAME INPUT GRID NAME EQO00140 LD L ANAME EQO00150 STO L MSAG2+9 EQO00160 LD L ANAME+1 EQO00170 STO L MSAG2+10 EQO00180 BSI L ERTYP TYPE GRID NAME EQO00190 DC MSAG2 EQO00200 BSI L LOCAT SEARCH FOR TRAILER EQO00210 LD L IFOUN RECORD OR GRID NAME EQO00220 BSC L OKK,+- IN DISK DATA AREA EQO00230 BSI L ERTYP EQO00240 DC MSAG6 EQO00250 BSI L ERTYP NAME ALREADY USED EQO00260 DC MSAG4 EQO00270 WAIT EQO00280 EXIT EQO00290 OKK BSI L INPU1 INPUT PARAMETERS EQO00300 LD L GRID CHECK FOR POSITIVE EQO00310 BSC L *+8,-Z GRID INTERVAL EQO00320 BSI L ERTYP EQO00330 DC ERRU1 EQO00340 BSI L ERTYP EQO00350 DC MSAG4 EQO00360 WAIT EQO00370 EXIT EQO00380 LD L NTERM CHECK TO MAKE SURE EQO00390 S L MAXTR NTERM DOES NOT EQO00400 BSC L *+8,+ EXCEED MAX ALLOWED EQO00410 BSI L ERTYP EQO00420 DC ERRU2 EQO00430 BSI L ERTYP EQO00440 DC MSAG4 EQO00450 WAIT EQO00460 EXIT EQO00470 LIBF FLD CHECK TO MAKE SURE EQO00480 DC XMAX XMAX IS GREATER EQO00490 LIBF FSUB THAN XMIN AND BRANCH EQO00500 DC XMIN TO ERROR MESSAGE IF EQO00510 LIBF FSTO IT IS NOT EQO00520 DC RESUL EQO00530 LD L RESUL EQO00540 BSC L *+8,-Z EQO00550 BSI L ERTYP EQO00560 DC ERRU3 EQO00570 BSI L ERTYP EQO00580 DC MSAG4 EQO00590 WAIT EQO00600 EXIT EQO00610 LIBF FLD CHECK TO MAKE SURE EQO00620 DC YMAX YMAX IS GREATER EQO00630 LIBF FSUB THAN YMIN AND BRANCH EQO00640 DC YMIN TO ERROR MESSAGE IF EQO00650 LIBF FSTO IT IS NOT EQO00660 DC RESUL EQO00670 LD L RESUL EQO00680 BSC L *+8,-Z EQO00690 BSI L ERTYP EQO00700 DC ERRU3 EQO00710 BSI L ERTYP EQO00720 DC MSAG4 EQO00730 WAIT EQO00740 EXIT EQO00750 LIBF FLD COMPUTE MAX NUMBER OF EQO00760 DC XMAX COLUMNS REQUIRED EQO00770 LIBF FSUB FROM THE LIMITS ON EQO00780 DC XMIN THE VALUES OF X AND EQO00790 LIBF FDIV THE SPECIFIED VALUE EQO00800 DC GRID OF THE GRID INTERVAL EQO00810 LIBF FADD EQO00820 DC GFAC EQO00830 LIBF IFIX EQO00840 STO L ICMAX EQO00850 LD L ICMAX CHECK TO MAKE SURE EQO00860 S L MAXCR ICMAX DOES NOT EQO00870 BSC L *+8,+ EXCEED MAXCR, BRANCH EQO00880 BSI L ERTYP TO ERROR MESSAGE EQO00890 DC ERRU4 IF IT DOES EQO00900 BSI L ERTYP EQO00910 DC MSAG4 EQO00920 WAIT EQO00930 EXIT EQO00940 LIBF FLD COMPUTE MAX NUMBER OF EQO00950 DC YMAX ROWS REQUIRED FROM EQO00960 LIBF FSUB THE LIMITS ON THE EQO00970 DC YMIN VALUES OF Y AND THE EQO00980 LIBF FDIV SPECIFIED VALUE OF EQO00990 DC GRID THE GRID INTERVAL EQO01000 LIBF FADD EQO01010 DC GFAC EQO01020 LIBF IFIX EQO01030 STO L IRMAX EQO01040 LD L IRMAX CHECK TO MAKE SURE EQO01050 S L MAXCR IRMAX DOES NOT EQO01060 BSC L *+8,+ EXCEED MAXCR, BRANCH EQO01070 BSI L ERTYP TO ERROR MESSAGE EQO01080 DC ERRU4 IF IT DOES EQO01090 BSI L ERTYP EQO01100 DC MSAG4 EQO01110 WAIT EQO01120 EXIT EQO01130 BSI L WRTOU WRITE HEADER RECORD EQO01140 BSI L REWRT WRITE TRAILER RECORD EQO01150 LD L NTERM CALCULATE THE NUMBER EQO01160 A L ONE OF B COEFFICIENTS EQO01170 M L NTERM THAT ARE NEEDED FROM EQO01180 D L TWO THE SPECIFIED NUMBER EQO01190 STO L NCOEF OF TERMS EQO01200 BSI L INPU3 INPUT COEFFICIENTS EQO01210 LDX I1 NTERM LOCATE THE LAST A EQO01220 LOOP9 LD L1 MT-1 COEFFICIENT FOR EQO01230 BSC L PRCED,Z WHICH MT IS NOT EQO01240 MDX 1 -1 ZERO AND SET THE EQO01250 MDX LOOP9 VALUE OF JTERM EQO01260 BSI L ERTYP ACCORDINGLY EQO01270 DC ERRU5 EQO01280 BSI L ERTYP EQO01290 DC MSAG4 EQO01300 WAIT EQO01310 EXIT EQO01320 PRCED STX L1 JTERM EQO01330 LD L JTERM EQO01340 LIBF FLOAT EQO01350 LIBF FMPY EQO01360 DC F8 EQO01370 LIBF FADD EQO01380 DC FONE EQO01390 CALL FSQR EQO01400 LIBF FSUB EQO01410 DC F3 EQO01420 LIBF FDIV EQO01430 DC FTWO EQO01440 LIBF FADD EQO01450 DC FTWO EQO01460 LIBF IFIX EQO01470 STO L IORD EQO01480 LIBF FSTO EQO01490 DC AORD CHECK THE VALUE OF EQO01500 LIBF FLOAT IORD TO SEE IF IT EQO01510 LIBF FSUB REPRESENTS THE EQO01520 DC AORD CORRECT ORDER OF THE EQO01530 LIBF FSTO EQUATION OR IF IT EQO01540 DC CORD HAS BEEN TRUNCATED EQO01550 LD L CORD TO ONE LESS THAN THE EQO01560 BSC L *&6,- CORRECT ORDER EQO01570 LD L IORD ADD ONE TO IORD OF EQO01580 A L ONE NECESSARY TO OBTAIN EQO01590 STO L IORD THE CORRECT ORDER EQO01600 LIBF FLD CALCULATE THE EQO01610 DC XMAX INCREMENT FOR X EQO01620 LIBF FSUB IN THE INTERVAL EQO01630 DC XMIN FROM ZERO TO ONE EQO01640 LIBF FDVR EQO01650 DC GRID EQO01660 LIBF FSTO EQO01670 DC XINC EQO01680 LIBF FLD CALCULATE THE EQO01690 DC YMAX INCREMENT FOR Y EQO01700 LIBF FSUB IN THE INTERVAL EQO01710 DC YMIN FROM ZERO TO ONE EQO01720 LIBF FDVR EQO01730 DC GRID EQO01740 LIBF FSTO EQO01750 DC YINC EQO01760 LD L NTERM DOUBLE THE VALUES OF EQO01770 M L TWO NTERM AND IRMAX FOR EQO01780 D L ONE USE IN CHECKING THE EQO01790 STO L DNTRM NUMBER OF FLOATING EQO01800 LD L IRMAX POINT NUMBERS THAT EQO01810 M L TWO WILL BE CALCULATED EQO01820 D L ONE LATER EQO01830 STO L DIRMX EQO01840 LD L ONE SET THE COLUMN NUMBER EQO01850 STO L K K TO ONE INITIALLY EQO01860 LIBF FLD SET THE VALUE OF X EQO01870 DC FZERO TO ZERO MINUS THE EQO01880 LIBF FSUB XINC INITIALLY EQO01890 DC XINC EQO01900 LIBF FSTO EQO01910 DC X EQO01920 LOOP1 LIBF FLD COMPUTE THE VALUE OF EQO01930 DC X X FOR COLUMN K BY EQO01940 LIBF FADD ADDING THE XINC TO EQO01950 DC XINC THE PREVIOUS VALUE EQO01960 LIBF FSTO OF X FOR COLUMN%K-1< EQO01970 DC X EQO01980 LD L ZERO SET THE ROW NUMBER L EQO01990 STO L L TO ZERO INITIALLY EQO02000 LIBF FLD SET THE VALUE OF Y EQO02010 DC FZERO TO ZERO MINUS THE EQO02020 LIBF FSUB YINC INITIALLY EQO02030 DC YINC EQO02040 LIBF FSTO EQO02050 DC Y EQO02060 LOOP2 LIBF FLD COMPUTE THE VALUE OF EQO02070 DC Y Y FOR ROW L BY EQO02080 LIBF FADD ADDING THE YINC TO EQO02090 DC YINC THE PREVIOUS VALUE EQO02100 LIBF FSTO OF Y FOR ROW%L-1< EQO02110 DC Y EQO02120 LDD L FONE SET THE ZERO ORDER EQO02130 STD L Q TERM TO ONE EQO02140 LD L ONE SET M TO ZERO EQO02150 STO L M INITIALLY EQO02160 LOOP3 LD L M INCREMENT M BY ONE EQO02170 A L ONE EACH TIME THROUGH EQO02180 STO L M THE LOOP EQO02190 S L ONE DETERMINE MM WHICH EQO02200 M L M REPRESENTS THE ORDER EQO02210 D L TWO OF THE TERMS BEING EQO02220 STO L MM CALCULATED EQO02230 S L M DETERMINE NN WHICH EQO02240 A L ONE REPRESENTS THE ORDER EQO02250 STO L NN OF THE PREVIOUS TERMS EQO02260 LD L M DETERMINE NM WHICH EQO02270 S L ONE SETS THE NUMBER OF EQO02280 STO L NM TIMES THRU LOOP4 EQO02290 LD L ZERO SET J TO ZERO INITIAL EQO02300 STO L J EQO02310 LOOP4 LD L J INCREMENT J BY ONE EQO02320 A L ONE EACH TIME THROUGH EQO02330 STO L J THE LOOP EQO02340 A L MM DETERMINE KK WHICH EQO02350 S L ONE IS THE NUMBER OF EQO02360 M L TWO THE POLYNOMIAL TERM EQO02370 STD L KK WHICH IS TO BE EQO02380 LD L KK&1 CALCULATED EQO02390 S L DNTRM CHECK TO SEE IF ALL EQO02400 BSC L NXTAA,- TERMS CALCULATED EQO02410 LD L J DETERMINE LL WHICH EQO02420 A L NN IS THE NUMBER OF THE EQO02430 S L ONE CORRESPONDING TERM EQO02440 M L TWO OF ORDER ONE LESS EQO02450 STD L LL THAN THAT BEING CALC EQO02460 LDX I1 LL&1 LOAD THE VALUE OF THE EQO02470 LIBF FLDX TERM Q(LL), MULTIPLY EQO02480 DC Q BY X AND STORE IN EQO02490 LIBF FMPY LOCATION Q(KK) EQO02500 DC X EQO02510 LDX I1 KK&1 EQO02520 LIBF FSTOX EQO02530 DC Q EQO02540 LD L NM CHECK TO SEE IF LOOP4 EQO02550 S L J HAS BEEN GONE THRU EQO02560 BSC L LOOP4,Z- NM TIMES EQO02570 LD L MM DETERMINE KMM, THE EQO02580 A L M NUMBER OF THE LAST EQO02590 S L ONE TERM OF THE ORDER EQO02600 M L TWO THAT IS BEING EQO02610 STD L KMM CALCULATED EQO02620 LD L MM DETERMINE MMM, THE EQO02630 S L ONE NUMBER OF THE LAST EQO02640 M L TWO TERM OF ORDER ONE EQO02650 STD L MMM LESS THAN BEING CALC EQO02660 LD L KMM&1 CHECK TO SEE IF ALL EQO02670 S L DNTRM REQUIRED TERMS HAVE EQO02680 BSC L NXTAA,- BEEN CALCULATED EQO02690 LDX I1 MMM&1 LOAD THE VALUE OF THE EQO02700 LIBF FLDX TERM Q(MMM) AND EQO02710 DC Q MULTIPLY BY Y IN EQO02720 LIBF FMPY ORDER TO GET Q(KMM) EQO02730 DC Y WHICH IS THE LAST EQO02740 LDX I1 KMM&1 TERM OF THIS ORDER EQO02750 LIBF FSTOX EQO02760 DC Q EQO02770 LD L M CHECK TO SEE IF ALL EQO02780 S L IORD REQUIRED ORDERS HAVE EQO02790 BSC L LOOP3,&Z BEEN CALCULATED EQO02800 NXTAA LDX I2 L EQO02810 LDD L FZERO INITIALIZE Z FOR EQO02820 STD L2 Z COLUMN K AND ROW L EQO02830 LD L ZERO EQO02840 STO L JJ EQO02850 LDX 2 0 EQO02860 LOOP5 LD L JJ DETERMINE THE NUMBER EQO02870 A L ONE OF THE POLYNOMIAL TO EQO02880 STO L JJ BE CALCULATED EQO02890 MDX 2 1 FOR THIS POLY AND EQO02900 LDD L FZERO SET INITIAL VALUE OF EQO02910 STD L SUMP THIS POLY TO ZERO EQO02920 LD L ZERO EQO02930 STO L JM EQO02940 LOOP6 LD L JM SET THE NUMBER OF THE EQO02950 A L ONE TERM IN THIS EQO02960 STO L JM PARTICULAR POLY- EQO02970 LD L JJ SET THE NUMBER OF THE EQO02980 S L ONE B COEFFICIENT WHICH EQO02990 M L JJ CORRESPONDS TO THE EQO03000 D L TWO JDM TERM OF THE EQO03010 A L JM POLYNOMIAL AND STORE EQO03020 STO L JDN AS JDN EQO03030 LD L JM EQO03040 A L JM EQO03050 STO L JDM EQO03060 LDX I1 JDM EQO03070 LIBF FLDX EQO03080 DC Q-2 EQO03090 LD L JDN EQO03100 A L JDN MULTIPLY THE JDM EQO03110 STO L JDN TERM OF THE POLY- EQO03120 LDX I1 JDN NOMIAL BY THE JDN EQO03130 LIBF FMPYX COEFFICIENT AND ADD EQO03140 DC B-2 TO THE ACCUMULATED EQO03150 LIBF FADD SUM OF THE POLY- EQO03160 DC SUMP NOMIAL EQO03170 LIBF FSTO EQO03180 DC SUMP EQO03190 LD L JJ EQO03200 S L JM EQO03210 BSC L LOOP6,Z- EQO03220 LD L JJ EQO03230 A L JJ EQO03240 STO L JDN EQO03250 LDX I1 JDN ACCUMULATE THE SUM OF EQO03260 LIBF FLDX THE POLYNOMIALS FOR EQO03270 DC A-2 COLUMN K AND ROW L EQO03280 LIBF FMPY EQO03290 DC SUMP EQO03300 LDX I1 L EQO03310 LIBF FADDX EQO03320 DC Z EQO03330 LIBF FSTOX EQO03340 DC Z EQO03350 LD L NTERM CHECK TO SEE IF ALL EQO03360 S L JJ OF THE POLYNOMIALS EQO03370 BSC L LOOP5,Z- HAVE BEEN CALCULATED EQO03380 LD L L INCREMENT TO THIS ROW EQO03390 A L TWO NUMBER AND BRANCH EQO03400 STO L L BACK IF A(L) HAS NOT EQO03410 LD L DIRMX BEEN COMPUTED FOR EQO03420 S L L ALL OF THE ROWS IN EQO03430 BSC L LOOP2,Z- THIS COLUMN EQO03440 BSI L WRTGR EQO03450 LD L K INCREMENT TO NEXT EQO03460 A L ONE COLUMN NUMBER AND EQO03470 STO L K BRANCH BACK IF ALL EQO03480 LD L ICMAX COLUMNS HAVE NOT EQO03490 S L K BEEN COMPUTED EQO03500 BSC L LOOP1,- EQO03510 BSI L ERTYP TYPE COMPLETION EQO03520 DC MSAG3 MESSAGE EQO03530 EXIT EQO03540 *************** EQO03550 * INPU1 SUBROUTINE EQO03560 *************** EQO03570 INPU1 NOP SUBROUTINE TO READ EQO03580 LD L FXD55 XMIN,XMAX,YMIN,YMAX EQO03590 STO L INPTA GRID INTERVAL AND EQO03600 *************** EQO03610 LIBF CARD0 NUMBER OF TERMS FROM EQO03620 * LIBF READ0 NUMBER OF TERMS FROM EQO03630 *************** EQO03640 DC /0000 PARAMETER CARD EQO03650 MDX *-3 EQO03660 *************** EQO03670 LIBF CARD0 EQO03680 * LIBF READ0 EQO03690 *************** EQO03700 DC /1000 EQO03710 DC INPTA EQO03720 *************** EQO03730 LIBF CARD0 EQO03740 * LIBF READ0 EQO03750 *************** EQO03760 DC /0000 EQO03770 MDX *-3 EQO03780 BSI L FFORM EQO03790 BSI L CEFBF EQO03800 LDD L BINFL EQO03810 STD L XMIN EQO03820 LDX 2 10 EQO03830 LD L2 INPTA&10 EQO03840 STO L2 INPTA EQO03850 MDX 2 -1 EQO03860 MDX *-6 EQO03870 BSI L FFORM EQO03880 BSI L CEFBF EQO03890 LDD L BINFL EQO03900 STD L XMAX EQO03910 LDX 2 10 EQO03920 LD L2 INPTA&20 EQO03930 STO L2 INPTA EQO03940 MDX 2 -1 EQO03950 MDX *-6 EQO03960 BSI L FFORM EQO03970 BSI L CEFBF EQO03980 LDD L BINFL EQO03990 STD L YMIN EQO04000 LDX 2 10 EQO04010 LD L2 INPTA&30 EQO04020 STO L2 INPTA EQO04030 MDX 2 -1 EQO04040 MDX *-6 EQO04050 BSI L FFORM EQO04060 BSI L CEFBF EQO04070 LDD L BINFL EQO04080 STD L YMAX EQO04090 LDX 2 10 EQO04100 LD L2 INPTA&40 EQO04110 STO L2 INPTA EQO04120 MDX 2 -1 EQO04130 MDX *-6 EQO04140 BSI L FFORM EQO04150 BSI L CEFBF EQO04160 LDD L BINFL EQO04170 STD L GRID EQO04180 LD L NMZER EQO04190 STO L INPTA&51 EQO04200 STO L INPTA&52 EQO04210 STO L INPTA&53 EQO04220 STO L INPTA+54 EQO04230 LD L PLUS EQO04240 STO L INPTA&50 EQO04250 LIBF DCBIN EQO04260 DC INPTA&50 EQO04270 STO L IORD EQO04280 A L ONE (I+1)(I+2)/2 EQO04290 STO L NTERM EQO04300 A L ONE EQO04310 M L NTERM EQO04320 SLT 15 EQO04330 STO L NTERM EQO04340 BSC I INPU1 EQO04350 *************** EQO04360 * INPU3 SUBROUTINE EQO04370 *************** EQO04380 INPU3 NOP SUBROUTINE TO READ EQO04390 LD L NTERM COEFFICIENTS, ONE EQO04400 STO L MT-1 PER CARD EQO04410 *************** EQO04420 LIBF CARD0 EQO04430 * LIBF READ0 EQO04440 *************** EQO04450 DC /0000 EQO04460 MDX *-3 EQO04470 *************** EQO04480 LIBF CARD0 EQO04490 * LIBF READ0 EQO04500 *************** EQO04510 DC /1000 EQO04520 DC MT-1 EQO04530 LD L ZERO EQO04540 STO L NUMB EQO04550 LD L FXD43 EQO04560 STO L CRDCD EQO04570 LDX 2 0 EQO04580 *************** EQO04590 LIBF CARD0 EQO04600 * LIBF READ0 EQO04610 *************** EQO04620 DC /0000 EQO04630 MDX *-3 EQO04640 *************** EQO04650 ERR3 LIBF CARD0 EQO04660 *RR3 LIBF READ0 EQO04670 *************** EQO04680 DC /1000 EQO04690 DC CRDCD EQO04700 *************** EQO04710 LIBF CARD0 EQO04720 * LIBF READ0 EQO04730 *************** EQO04740 DC /0000 EQO04750 MDX *-3 EQO04760 BSI CEFBF EQO04770 LDD L BINFL EQO04780 STD L2 B EQO04790 MDX 2 2 EQO04800 LD L NUMB EQO04810 A L ONE EQO04820 STO L NUMB EQO04830 S L NCOEF EQO04840 BSC L ERR3,Z& EQO04850 LD L ZERO EQO04860 STO L NUMB EQO04870 LD L FXD43 EQO04880 STO L CRDCD EQO04890 LDX 2 0 EQO04900 *************** EQO04910 LIBF CARD0 EQO04920 * LIBF READ0 EQO04930 *************** EQO04940 DC /0000 EQO04950 MDX *-3 EQO04960 *************** EQO04970 ER33 LIBF CARD0 EQO04980 *R33 LIBF READ0 EQO04990 *************** EQO05000 DC /1000 EQO05010 DC CRDCD EQO05020 *************** EQO05030 LIBF CARD0 EQO05040 * LIBF READ0 EQO05050 *************** EQO05060 DC /0000 EQO05070 MDX *-3 EQO05080 BSI CEFBF EQO05090 LDD L BINFL EQO05100 STD L2 A EQO05110 STX L2 DUMN SAVE A POINTER EQO05120 LD L DUMN EQO05130 SRA 1 CALC MT POINTER EQO05140 STO L DUMN EQO05150 LDX I1 DUMN LOAD MT POINTER EQO05160 LD L1 MT SETZ EQO05170 BSC L SETZ,+- EQO05180 S L NMZER EQO05190 BSC L SETZ,+- EQO05200 NOTZ MDX 2 2 EQO05210 LD L NUMB EQO05220 A L ONE EQO05230 STO L NUMB EQO05240 S L NTERM EQO05250 BSC L ER33,Z& EQO05260 BSC I INPU3 EQO05270 SETZ LDD L FZERO EQO05280 STD L2 A EQO05290 BSC L NOTZ EQO05300 *************** EQO05310 * CEFBF SUBROUTINE EQO05320 *************** EQO05330 CEFBF NOP SUBROUTINE TO EQO05340 LD L CRDCD&30 CONVERT AN E-FORMAT EQO05350 S L PLUS TO FLOATING POINT EQO05360 BSC L NXTA,&- EQO05370 LD L CRDCD&30 TEST FOR FORMAT ERRORS EQO05380 S L AMPER EQO05390 BSC L NXTA,&- EQO05400 LD L CRDCD&30 EQO05410 S L MINUS EQO05420 BSC L NXTA,&- EQO05430 LD L CRDCD&30 EQO05440 BSC L ERROR,Z EQO05450 NXTA LD L CRDCD&31 EQO05460 S L PERID EQO05470 BSC L ERROR,Z EQO05480 LD L CRDCD&40 EQO05490 S L LTRE EQO05500 BSC L ERROR,Z EQO05510 LD L CRDCD&41 EQO05520 S L PLUS EQO05530 BSC L NXTB,&- EQO05540 LD L CRDCD&41 EQO05550 S L AMPER EQO05560 BSC L NXTB,&- EQO05570 LD L CRDCD&41 EQO05580 S L MINUS EQO05590 BSC L NXTB,&- EQO05600 LD L CRDCD&41 EQO05610 BSC L ERROR,Z EQO05620 NXTB LD L CRDCD&30 CONVERT HIGH ORDER DIGITS EQO05630 STO L EFORM TO BINARY AND THEN TO EQO05640 LD L ZERO FLOATING POINT EQO05650 STO L EFORM&1 EQO05660 LD L CRDCD&32 EQO05670 STO L EFORM&2 EQO05680 LD L CRDCD&33 EQO05690 STO L EFORM&3 EQO05700 LD L CRDCD&34 EQO05710 STO L EFORM&4 EQO05720 LD L CRDCD&35 EQO05730 STO L EFORM&5 EQO05740 LIBF DCBIN EQO05750 DC EFORM EQO05760 STO L FXMNT EQO05770 LIBF FLOAT EQO05780 LIBF FSTO EQO05790 DC MANT EQO05800 LD L ZERO CONVERT LOW ORDER DIGIT TO EQO05810 STO L EFORM&1 BINARY AND THEN TO EQO05820 LD L CRDCD&36 FLOATING POINT EQO05830 STO L EFORM&2 EQO05840 LD L CRDCD&37 EQO05850 STO L EFORM&3 EQO05860 LD L CRDCD&38 EQO05870 STO L EFORM&4 EQO05880 LD L CRDCD&39 EQO05890 STO L EFORM&5 EQO05900 LIBF DCBIN EQO05910 DC EFORM EQO05920 STO L FXMNR EQO05930 LIBF FLOAT EQO05940 LIBF FSTO EQO05950 DC MANR EQO05960 LD L FXMNT ARE HIGH ORDER DIGIT ZERO EQO05970 BSC L *&4,Z EQO05980 LD L FXMNR NO - CALCULATE EQO05990 BSC L ALTER,&- CHARACTERISTIC EQO06000 LD L CRDCD&41 YES - ARE LOW ORDER DIGITS EQO06010 STO L EFORM ZERO EQO06020 LD L ZERO YES - GO TO ALTER EQO06030 STO L EFORM&1 NO - CONVERT EXPONENT TO EQO06040 STO L EFORM&2 &BBINARY, COMBINE TWO EQO06050 STO L EFORM&3 FLOATING POINT EQO06060 LD L CRDCD&42 NUMBERS AND ADJUST EQO06070 STO L EFORM&4 CHARACTERISTIC FOR EQO06080 LD L CRDCD&43 EXPONENT OF E-FORMAT EQO06090 STO L EFORM&5 EQO06100 LIBF DCBIN EQO06110 DC EFORM EQO06120 STO L EXPON EQO06130 LIBF FLD EQO06140 DC FTEN EQO06150 LIBF FAXI EQO06160 DC EXPON EQO06170 LIBF FSTO EQO06180 DC EXPT EQO06190 LIBF FLD EQO06200 DC MANR EQO06210 LIBF FMPY EQO06220 DC TENG4 EQO06230 LIBF FADD EQO06240 DC MANT EQO06250 LIBF FMPY EQO06260 DC TENG4 EQO06270 LIBF FMPY EQO06280 DC EXPT EQO06290 LIBF FSTO EQO06300 DC BINFL EQO06310 BSC I CEFBF RETURN EQO06320 ALTER LDD L FZERO SET VALUE OF FLOATING EQO06330 STD L BINFL POINT ZERO EQO06340 BSC I CEFBF RETURN EQO06350 ERROR BSI L ERTYP TYPE FORMAT ERROR MESSAGE EQO06360 DC ERRU6 EQO06370 BSI L ERTYP EQO06380 DC MSAG4 EQO06390 WAIT EQO06400 EXIT EQO06410 *************** EQO06420 * FFORM SUBROUTINE EQO06430 *************** EQO06440 FFORM NOP SUBROUTINE TO EQO06450 LDX 2 14 CONVERT AN F-FORMAT EQO06460 LD L NMZER CARD CODE NUMBER EQO06470 STO L2 CRDCD+30 TO E-FORMAT EQO06480 MDX 2 -1 SET E-FORMAT AREA TO EQO06490 MDX *-4 ZERO CHARACTERS EQO06500 LD L PLUS STORE PLUS, PERIOD AND EQO06510 STO L CRDCD+30 EIN E-FORMAT WORD EQO06520 LD L PERID EQO06530 STO L CRDCD+31 EQO06540 LD L LTRE EQO06550 STO L CRDCD+40 EQO06560 LD L FX11 EQO06570 STO L FNDPR EQO06580 LDX 1 10 EQO06590 FFRM LD L1 INPTA TEST FOR EQO06600 BSC L FIND1,+- BLANK EQO06610 LD L1 INPTA PLUS SIGN EQO06620 S L PLUS EQO06630 BSC L FIND1,+- EQO06640 LD L1 INPTA AMPERS AND EQO06650 S L AMPER EQO06660 BSC L FIND1,+- EQO06670 LD L1 INPTA MINUS EQO06680 S L MINUS EQO06690 BSC L BCKF,Z EQO06700 LD L MINUS EQO06710 STO L CRDCD+30 EQO06720 FIND1 LD L NMZER EQO06730 STO L1 INPTA EQO06740 MDX 1 -1 EQO06750 MDX FIND2 EQO06760 MDX FIND2 EQO06770 BCKF LD L1 INPTA PERIOD EQO06780 S L PERID EQO06790 BSC L BCKG,Z EQO06800 STX L1 FNDPR EQO06810 BCKG MDX 1 -1 LOOP TEST EQO06820 MDX *+1 EQO06830 MDX *+2 EQO06840 BSC L FFRM TEST ANOTHER CHARACTER EQO06850 FIND2 STX L1 FNDEN CALCULATE AND STORE EQO06860 LD L FNDPR EXPONENT EQO06870 S L FNDEN EQO06880 S L ONE EQO06890 LIBF BINDC EQO06900 DC EFORM EQO06910 LD L EFORM EQO06920 STO L CRDCD+41 EQO06930 LD L EFORM+4 EQO06940 STO L CRDCD+42 EQO06950 LD L EFORM+5 EQO06960 STO L CRDCD+43 EQO06970 LD L TEN IS HIGH ORDER CHARACTER EQO06980 S L FNDEN IN RIGHTMOST POSITION EQO06990 BSC L FIND4,+ YES - GO TO FIND4 EQO07000 STO L FFMNB NO - STORE COUNT OF EQO07010 MDX 1 1 CHARACTERS TO BE MOVED EQO07020 LD L1 INPTA LOAD SIGNIFICANT DIGIT EQO07030 STO L CRDCD+32 OF F-FORMAT TO E-FORMAT EQO07040 LD L ONE MANTISSA EQO07050 STO L FFMCT EQO07060 S L FFMNB TEST FOR SINGLE DIGIT IN EQO07070 BSC L ONWD,- F-FORMAT EQO07080 LDX 2 0 YES - GO TO ONWD EQO07090 BCKH MDX 2 1 NO - MOVE DIGIT TO EQO07100 BCKJ MDX 1 1 E-FORMAT MANTISSA EQO07110 MDX L FFMCT,+1 EQO07120 LD L1 INPTA TEST FOR PERIOD EQO07130 S L PERID EQO07140 BSC L BCKI,+- EQO07150 LD L1 INPTA EQO07160 STO L2 CRDCD+32 EQO07170 LD L FFMCT EQO07180 S L FFMNB EQO07190 BSC L BCKH,+Z EQO07200 BSC I FFORM RETURN EQO07210 FIND4 LD L NMZER STORE ZERO IN TENS POSITIONEQO07220 STO L CRDCD+44 OF EXPONENT EQO07230 ONWD BSC I FFORM EQO07240 BCKI LD L FFMCT ARE ALL CHARACTERS MOVED EQO07250 S L FFMNB EQO07260 BSC L BCKJ,+Z NO - GO TO BCKJ EQO07270 BSC I FFORM EQO07280 *************** EQO07290 * NAME SUBROUTINE EQO07300 *************** EQO07310 NAME NOP SUBROUTINE TO EQO07320 LD L FOUR READ THE GRID EQO07330 STO L BNAME-1 NAME FROM A CARD EQO07340 *************** EQO07350 LIBF CARD0 AND CONVERT EQO07360 * LIBF READ0 AND CONVERT EQO07370 *************** EQO07380 DC /0000 TO EBCDIC EQO07390 MDX *-3 EQO07400 *************** EQO07410 LIBF CARD0 EQO07420 * LIBF READ0 EQO07430 *************** EQO07440 DC /1000 EQO07450 DC BNAME-1 EQO07460 *************** EQO07470 LIBF CARD0 EQO07480 * LIBF READ0 EQO07490 *************** EQO07500 DC /0000 EQO07510 MDX *-3 EQO07520 LIBF SPEED EQO07530 DC /0000 EQO07540 DC BNAME EQO07550 DC ANAME EQO07560 DC 4 EQO07570 BSC I NAME EQO07580 *************** EQO07590 * LOCAT SUBROUTINE EQO07600 *************** EQO07610 LOCAT NOP SUBROUTINE TO EQO07620 LD L FX20 SEARCH FOR THE EQO07630 STO L WKIO TRAILER RECORD EQO07640 LD L SCBGN OR THE GRID NAME EQO07650 STO L WKIO+1 IN THE DISK DATA EQO07660 AGN LIBF DISKN AREA EQO07670 DC /5000 EQO07680 DC WKIO SET IFOUN TO EQO07690 DC ERRS ZERO IF TRAILER EQO07700 LIBF DISKN RECORD IS FOUND EQO07710 DC /1000 SETS IFOUN TO EQO07720 DC WKIO ONE IF GRID NAME EQO07730 DC ERRS IS FOUND EQO07740 LIBF DISKN EQO07750 DC /0000 EQO07760 DC WKIO EQO07770 MDX *-4 EQO07780 LIBF FLD EQO07790 DC TRAIL EQO07800 LIBF FSUB EQO07810 DC WKIO+2 EQO07820 LIBF FSTO EQO07830 DC DUMY EQO07840 LD L DUMY EQO07850 BSC L OK,+- EQO07860 LIBF FLD EQO07870 DC WKIO+2 EQO07880 LIBF FSUB EQO07890 DC ANAME EQO07900 LIBF FSTO EQO07910 DC DUMY EQO07920 LD L DUMY EQO07930 BSC L FND,+- EQO07940 LD L WKIO+6 EQO07950 BSC L EROB,& EQO07960 M L FOUR EQO07970 STD L DUMY EQO07980 D L THREE EQO07990 STO L SCINC EQO08000 M L THREE EQO08010 D L ONE EQO08020 S L DUMY+1 EQO08030 BSC L AA3,- EQO08040 A L FOUR EQO08050 A L SCINC EQO08060 STO L SCINC EQO08070 AA3 LD L WKIO&1 EQO08080 A L SCINC EQO08090 STO L WKIO+1 EQO08100 S L SCBGN EQO08110 BSC L EROB,& EQO08120 S L SCLGT EQO08130 BSC L EROB,- EQO08140 BSC L AGN EQO08150 FND LD L ONE TRANSFER HEADER RECORD EQO08160 STO L IFOUN DATA FROM WKIO TO EQO08170 LDD L WKIO+4 STORAGE EQO08180 STD L GRID EQO08190 LD L WKIO+6 EQO08200 STO L ICMAX EQO08210 LD L WKIO+7 EQO08220 STO L IRMAX EQO08230 LD L WKIO&1 EQO08240 STO L SCSTR EQO08250 BSC I LOCAT EQO08260 OK LD L ZERO EQO08270 STO L IFOUN EQO08280 LD L WKIO&1 EQO08290 STO L SCSTR EQO08300 BSC I LOCAT EQO08310 ERRS DC 0 DISK ERROR MESSAGE EQO08320 LIBF WRTY0 EQO08330 DC /2000 EQO08340 DC MSAG5 EQO08350 SRA 16 EQO08360 BSC I ERRS EQO08370 EROB BSI L ERTYP EQO08380 DC MSAG7 NO TRAILER RECORD MESSAGE EQO08390 BSI L ERTYP EQO08400 DC MSAG4 EQO08410 WAIT EQO08420 EXIT EQO08430 *************** EQO08440 * SCCOM SUBROUTINE EQO08450 *************** EQO08460 SCCOM NOP COMPUTE SECTOR ADDRESS EQO08470 LD L K FROM THE COLUMN NUMBER EQO08480 S L ONE AND BEGINNING SECTOR EQO08490 M L ONE OF DATA SET AREA EQO08500 D L THREE TEST ADDRESS OF SECTOR EQO08510 STO L DUMY AGAINST UPPER AND LOWER EQO08520 M L FOUR LIMITS OF DATA SET AREA EQO08530 D L ONE EQO08540 STO L SCINC EQO08550 LD L DUMY EQO08560 M L THREE EQO08570 D L ONE EQO08580 STO L DUMY EQO08590 LD L K EQO08600 S L DUMY EQO08610 S L ONE EQO08620 STO L SCINX EQO08630 A L SCINC EQO08640 STO L SCINC EQO08650 A L SCSTR EQO08660 STO L SCLOC EQO08670 S L SCBGN EQO08680 BSC L ER,Z+ EQO08690 S L SCLGT EQO08700 BSC L ER,- EQO08710 LD L FX100 EQO08720 M L SCINX EQO08730 D L ONE EQO08740 A L FX22 EQO08750 STO L ININX EQO08760 BSC I SCCOM EQO08770 ER BSI L ERTYP EQO08780 DC MSAG7 EQO08790 BSI L ERTYP EQO08800 DC MSAG4 EQO08810 WAIT EQO08820 EXIT EQO08830 *************** EQO08840 * WRTOU SUBROUTINE EQO08850 *************** EQO08860 WRTOU NOP WRITE MASTER HEADER RECORD EQO08870 LDX 1 22 EQO08880 LDX 2 20 EQO08890 LDD L ZNIL EQO08900 STD L1 WKIO-2 EQO08910 MDX 1 -2 EQO08920 MDX 2 -2 EQO08930 MDX *-5 EQO08940 LD L SCBGN EQO08950 A L SCLGT EQO08960 S L SCSTR EQO08970 M L THREE EQO08980 D L FOUR EQO08990 S L ICMAX EQO09000 BSC L NOROM,+Z EQO09010 LD L FX20 EQO09020 STO L WKIO EQO09030 LD L SCSTR EQO09040 STO L WKIO+1 EQO09050 LDD L ANAME EQO09060 STD L WKIO+2 EQO09070 LDD L GRID EQO09080 STD L WKIO+4 EQO09090 LD L ICMAX EQO09100 STO L WKIO&6 EQO09110 LD L IRMAX EQO09120 STO L WKIO&7 EQO09130 LDD L XMIN EQO09140 STD L WKIO+8 EQO09150 LDD L YMIN EQO09160 STD L WKIO+10 EQO09170 LIBF DISKN EQO09180 DC /5000 EQO09190 DC WKIO EQO09200 DC ERRS EQO09210 LIBF DISKN EQO09220 DC /4000 EQO09230 DC WKIO EQO09240 LIBF DISKN EQO09250 DC /0000 EQO09260 DC WKIO EQO09270 MDX *-4 EQO09280 BSC I WRTOU EQO09290 NOROM BSI L ERTYP EQO09300 DC MSAG8 EQO09310 BSI L ERTYP EQO09320 DC MSAG4 EQO09330 WAIT EQO09340 EXIT EQO09350 *************** EQO09360 * WRTGR SUBROUTINE EQO09370 *************** EQO09380 WRTGR NOP SUBROUTINE TO EQO09390 BSI L SCCOM WRITE THE EQO09400 LIBF DISKN COLUMNS IN THE EQO09410 DC /0000 DISK DATA AREA EQO09420 DC WKIO EQO09430 MDX *-4 EQO09440 LD L FX640 EQO09450 STO L WKIO EQO09460 LD L SCLOC EQO09470 STO L WKIO+1 EQO09480 LIBF DISKN EQO09490 DC /5000 EQO09500 DC WKIO EQO09510 DC ERRS EQO09520 LIBF DISKN EQO09530 DC /1000 EQO09540 DC WKIO EQO09550 DC ERRS EQO09560 LIBF DISKN EQO09570 DC /0000 EQO09580 DC WKIO EQO09590 MDX *-4 EQO09600 LD L ININX EQO09610 A L FX418 EQO09620 STO L DUMY EQO09630 LDX I1 DUMY EQO09640 LDX I2 FX420 EQO09650 LDD L ZNIL EQO09660 STD L1 WKIO EQO09670 MDX 1 -2 EQO09680 MDX 2 -2 EQO09690 MDX *-5 EQO09700 LD L IRMAX SET Z01 INDEX TO 2*IRMAX EQO09710 A L IRMAX EQO09720 STO L DUMY EQO09730 LDX I2 DUMY EQO09740 LD L ININX EQO09750 A L FX20 SET WKIO INDEX TO EQO09760 A L DUMY ININX+20+2*IRMAX-2 EQO09770 S L TWO EQO09780 STO L DUMY EQO09790 LDX I1 DUMY EQO09800 LDD L2 Z-2 EQO09810 STD L1 WKIO EQO09820 MDX 1 -2 EQO09830 MDX 2 -2 EQO09840 MDX *-7 EQO09850 LDX I1 ININX EQO09860 LD L K EQO09870 STO L1 WKIO EQO09880 LD L ONE EQO09890 STO L1 WKIO+1 EQO09900 LD L IRMAX EQO09910 STO L1 WKIO&2 EQO09920 LIBF DISKN EQO09930 DC /4000 EQO09940 DC WKIO EQO09950 BSC I WRTGR EQO09960 *************** EQO09970 * REWRT SUBROUTINE EQO09980 *************** EQO09990 REWRT NOP SUBROUTINE TO EQO10000 LD L ICMAX PLACE TRAILER EQO10010 M L FOUR RECORD FOLLOWING EQO10020 STD L DUMY LAST COLUMN IN EQO10030 D L THREE THE DISK DATA AREA EQO10040 STO L SCINC EQO10050 M L THREE EQO10060 D L ONE EQO10070 S L DUMY+1 EQO10080 BSC L AA2,- EQO10090 A L FOUR EQO10100 A L SCINC EQO10110 STO L SCINC EQO10120 AA2 LD L SCINC EQO10130 A L SCSTR EQO10140 STO L XXXX EQO10150 LIBF DISKN EQO10160 DC /0000 EQO10170 DC WKIO EQO10180 MDX *-4 EQO10190 LD L XXXX EQO10200 STO L WKIO+1 EQO10210 LD L TWO EQO10220 STO L WKIO EQO10230 LDD L TRAIL EQO10240 STD L WKIO+2 EQO10250 LIBF DISKN EQO10260 DC /5000 EQO10270 DC WKIO EQO10280 DC ERRS EQO10290 LIBF DISKN EQO10300 DC /4000 EQO10310 DC WKIO EQO10320 LIBF DISKN EQO10330 DC /0000 EQO10340 DC WKIO EQO10350 MDX *-4 EQO10360 BSC I REWRT EQO10370 *************** EQO10380 * ERTYP SUBROUTINE EQO10390 *************** EQO10400 ERTYP NOP SUBROUTINE TO EQO10410 LD I ERTYP WRITE MESSAGES EQO10420 STO L ERTX ON THE CONSOLE EQO10430 MDX L ERTYP,+1 TYPEWRITER EQO10440 LD L ERTX EQO10450 S L ONE EQO10460 STO *&1 EQO10470 LD L 0 EQO10480 STO L ERTX+2 EQO10490 M L ONE EQO10500 D L TWO EQO10510 STO L TYPE EQO10520 LIBF EBPRT EQO10530 DC /0000 EQO10540 ERTX DC 0 EQO10550 DC TYPE+1 EQO10560 DC 0 EQO10570 LIBF WRTY0 EQO10580 DC /2000 EQO10590 DC TYPE EQO10600 LIBF WRTY0 EQO10610 DC /2000 EQO10620 DC CONTL EQO10630 LIBF WRTY0 EQO10640 DC /0000 EQO10650 MDX *-3 EQO10660 BSC I ERTYP EQO10670 *************** EQO10680 * DEFINE CONSTANTS EQO10690 *************** EQO10700 SCBGN DC 448 START OF DATA SET AREA EQO10710 SCLGT DC 808 NO. OFSECTORS IN D.S. AREA EQO10720 THREE DC 3 EQO10730 FOUR DC 4 EQO10740 FIVE DC 5 EQO10750 SIX DC 6 EQO10760 SEVEN DC 7 EQO10770 FX15 DC 15 EQO10780 FX19 DC 19 EQO10790 FX20 DC 20 EQO10800 FX22 DC 22 EQO10810 FX100 DC 100 EQO10820 FX272 DC 272 EQO10830 FX280 DC 280 EQO10840 FX400 DC 400 EQO10850 FX402 DC 402 EQO10860 FX418 DC 418 EQO10870 FX420 DC 420 EQO10880 FX422 DC 422 EQO10890 FX640 DC 640 EQO10900 FX808 DC 808 EQO10910 ZNIL DEC -1.0E30 EQO10920 TRAIL DEC 9999. EQO10930 XXXX DC /FFFF EQO10940 YYYY DC /EEEE EQO10950 MAXCR DC 200 EQO10960 MAXTR DC 36 EQO10970 PLUS DC /80A0 EQO10980 MINUS DC /4000 EQO10990 AMPER DC /8000 EQO11000 PERID DC /8420 EQO11010 LTRE DC /8100 EQO11020 NMZER DC /2000 EQO11030 ZERO DC 0 EQO11040 ONE DC 1 EQO11050 TWO DC 2 EQO11060 TEN DC 10 EQO11070 ELEVN DC 11 EQO11080 FX11 DC 11 EQO11090 TWELV DC 12 EQO11100 FXD43 DC 43 EQO11110 FXD55 DC 55 EQO11120 FXD80 DC 80 EQO11130 NEG1 DC -1 EQO11140 NEG2 DC -2 EQO11150 FZERO DEC 0. EQO11160 FONE DEC 1. EQO11170 FTWO DEC 2. EQO11180 F3 DEC 3. EQO11190 F8 DEC 8. EQO11200 FTEN DEC 10. EQO11210 TENG4 DEC 1.0E-4 EQO11220 GFAC DEC 1.9999 EQO11230 *************** EQO11240 * DEFINE ERROR MESSAGES EQO11250 *************** EQO11260 DC 30 EQO11270 ERRU1 EBC .GRID INTERVAL IS NOT POSITIVE . EQO11280 DC 50 EQO11290 ERRU2 EBC .SPECIFIED NUMBER OF TERMS EXCEEDS . EQO11300 EBC .MAXIMUM ALLOWED . EQO11310 DC 46 EQO11320 ERRU3 EBC .MAX AND MIN VALUES ARE NOT. EQO11330 EBC . PROPERLY SPECIFIED . EQO11340 DC 58 EQO11350 ERRU4 EBC .REQUIRED NUMBER OF COLUMNS OR ROWS. EQO11360 EBC . EXCEEDS MAXIMUM ALLOWED. EQO11370 DC 34 EQO11380 ERRU5 EBC .THERE ARE NO NONZERO VALUES OF MT . EQO11390 DC 30 EQO11400 ERRU6 EBC .INPUT DATA NOT IN PROPER FORM . EQO11410 DC 16 EQO11420 MSAG1 EBC .EQORT BEGINNING . EQO11430 DC 22 EQO11440 MSAG2 EBC .OUTPUT GRID NAMED . EQO11450 DC /4040 EQO11460 DC /4040 EQO11470 DC 16 EQO11480 MSAG3 EBC .EQORT COMPLETED . EQO11490 DC 30 EQO11500 MSAG4 EBC .PUSH START FOR EXIT TO MONITOR. EQO11510 MSAG5 DC 20 DISK ERROR MESSAGE EQO11520 DC /3020 EQO11530 DC /9858 EQO11540 DC /2135 EQO11550 DC /6060 EQO11560 DC /5060 EQO11570 DC /2121 EQO11580 DC /9C34 EQO11590 DC /6070 EQO11600 DC /2074 EQO11610 DC /3C9C EQO11620 DC /3421 EQO11630 DC /7C50 EQO11640 DC /1821 EQO11650 DC /3C74 EQO11660 DC /3021 EQO11670 DC /6034 EQO11680 DC /989C EQO11690 DC /3C60 EQO11700 DC /9C21 EQO11710 DC /8103 EQO11720 DC 26 EQO11730 MSAG6 EBC .NAME ALREADY USED ON DISK . EQO11740 DC 30 EQO11750 MSAG7 EBC .UNABLE TO FIND TRAILER RECORD . EQO11760 DC 54 EQO11770 MSAG8 EBC .REQUIRED NUMBER OF COLUMNS. EQO11780 EBC .EXCEEDS AVAILABLE DISK AREA . EQO11790 CONTL DC 1 EQO11800 DC /8103 EQO11810 *************** EQO11820 * ALLOCATE STORAGE EQO11830 *************** EQO11840 GRID BSS E 2 GRID INTERVAL EQO11850 NTERM BSS 1 NUMBER OF TERMS EQO11860 XMAX BSS E 2 EQO11870 XMIN BSS E 2 EQO11880 RESUL BSS E 2 TEMPORARY STORAGE EQO11890 YMAX BSS E 2 EQO11900 YMIN BSS E 2 EQO11910 ICMAX BSS 1 MAX. COLUMN EQO11920 ACMAX BSS E 2 EQO11930 CCMAX BSS E 2 FLOATING POINT MAX. COLUMN EQO11940 IRMAX BSS 1 MAX. ROW EQO11950 ARMAX BSS E 2 FLOATING POINT MAX. ROW EQO11960 DNTRM BSS 1 2*NTERM EQO11970 DIRMX BSS 1 2*IRMAX EQO11980 IORD BSS 1 EQUATION ORDER EQO11990 AORD BSS E 2 EQO12000 CORD BSS E 2 FLOATING POINT ORDER EQO12010 DIORD BSS 1 2*IORD EQO12020 K BSS 1 INDEXING PARAMETER EQO12030 X BSS E 2 EQO12040 XX BSS E 22 POWER OF X EQO12050 DUM BSS 1 EQO12060 Y BSS E 2 EQO12070 YY BSS E 22 POWER OF Y EQO12080 NCOEF BSS 1 EQO12090 JTERM BSS 1 INDEXING PARAMETER EQO12100 XINC BSS E 2 X INCRIMENT EQO12110 YINC BSS E 2 Y INCRIMENT EQO12120 L BSS 1 INDEXING PARAMETER EQO12130 Q BSS E 90 Q VECTOR EQO12140 M BSS 1 INDEXING PARAMETER EQO12150 MM BSS 1 EQO12160 NN BSS 1 EQO12170 NM BSS 1 EQO12180 J BSS 1 EQO12190 KK BSS E 2 EQO12200 LL BSS E 2 EQO12210 KMM BSS E 2 EQO12220 MMM BSS E 2 EQO12230 Z BSS E 400 COLUMN OF VALUES EQO12240 JJ BSS 1 EQO12250 BSS 1 EQO12260 MT BSS 36 VECTOR IN WHICH COEFF. ARE EQO12270 SUMP BSS E 2 SELECTED EQO12280 JM BSS 1 EQO12290 JDM BSS E 2 EQO12300 JDN BSS E 2 EQO12310 A BSS 72 A COEFF. EQO12320 CRDCD BSS 46 CONTROLED RECORD EQO12330 EFORM BSS 16 TEMPORARY CONV. AREA EQO12340 FXMNT BSS 1 TEMPORARY STORAGE FOR EQO12350 MANT BSS E 2 CONVERSSION EQO12360 MANR BSS E 2 ROUTINES EQO12370 FXMNR BSS 1 EQO12380 EXPON BSS 1 EQO12390 EXPT BSS E 2 EQO12400 BINFL BSS E 2 EQO12410 NUMB BSS 1 EQO12420 INDF BSS 1 EQO12430 INDG BSS 1 EQO12440 OUTS BSS 1 EQO12450 BSS 4 EQO12460 BSS 4 EQO12470 BSS 4 EQO12480 OUTT BSS 1 EQO12490 BSS 4 EQO12500 BSS 4 EQO12510 BSS 4 EQO12520 BSS E 1 EQO12530 AA BSS 81 CARD INPUT AREA EQO12540 DUMM BSS E 4 EQO12550 DUMN BSS 1 EQO12560 CHKK BSS 29 EQO12570 CHLL BSS E 16 EQO12580 ANAME BSS E 2 DATA SET MANE EQO12590 BSS E 2 EQO12600 BNAME BSS E 4 EQO12610 DUMY BSS E 2 EQO12620 INPTA BSS 81 CARD INPUT AREA EQO12630 DREND BSS E 2 EQO12640 IFOUN BSS 1 EQO12650 ININX BSS 1 EQO12660 IRMIN BSS 1 EQO12670 SCLOC BSS 1 D.S. LOCATION EQO12680 SCINC BSS 1 PARAMETERS EQO12690 SCINX BSS 1 EQO12700 SCSTR BSS 1 EQO12710 FNDEN BSS 1 EQO12720 FNDPR BSS 1 EQO12730 FFMNB BSS 1 EQO12740 FFMCT BSS 1 EQO12750 B BSS E 1332 B COEFFICIENTS EQO12760 WKIO BSS E 642 DISK I/O BUFFER EQO12770 TYPE BSS 30 TYPEWRITTER AREA EQO12780 END GO EQO12790 // DUP EQO12800 *STORE WS UA EQORT EQO12810 // DUP GRD00010 *DELETE GRDOP GRD00020 // ASM GRD00030 *LIST GRD00040 *OVERFLOWSECTORS08 GRD00050 *************** GRD00060 * OPERATIONS BETWEEN THE CORRESPONDING GRD00070 * ELEMENTS OF TWO SETS OF GRID VALUES GRD00080 *************** GRD00090 GO LIBF WRTY0 GRD00100 DC /2000 GRD00110 DC CONTL GRD00120 BSI L ERTYP TYPE BEGINNING GRD00130 DC MSAG1 MESSAGE GRD00140 LD L ONE SELECT FIRST COLUMN GRD00150 STO L THCOL GRD00160 LD L ZERO GRD00170 STO L IERR GRD00180 BSI L NAME READ NAME CARD AND GRD00190 LDD L ANAME OPERATION NUMBER GRD00200 STD L XNAME GRD00210 BSI L LOCAT LOCATE FIRST INPUT GRD00220 LD L SCSTR SET OF GRIDS GRD00230 STO L SCSTA GRD00240 LD L ICMAX STORE HEADER GRD00250 STO L ICMXA INFORMATION FOR GRD00260 LD L IRMAX FIRST SET GRD00270 STO L IRMXA GRD00280 LDD L GRID GRD00290 STD L GRIDA GRD00300 LDD L XMIN GRD00310 STD L XMINA GRD00320 LDD L YMIN GRD00330 STD L YMINA GRD00340 LD L IFOUN WAS THE SET FOUND? GRD00350 BSC L OKKA,Z GRD00360 BSI L ERTYP TYPE ERROR MESSAGE GRD00370 DC MSAG8 IF FIRST SET WAS GRD00380 BSI L ERTYP NOT FOUND ON DISK GRD00390 DC MSAG4 GRD00400 MDX OUT GRD00410 OKKA LD L ANAME GRD00420 STO L MSAGA+12 GRD00430 LD L ANAME+1 GRD00440 STO L MSAGA+13 GRD00450 BSI L ERTYP TYPE MESSAGE GIVING GRD00460 DC MSAGA NAME OF FIRST GRD00470 LDD L BNAME INPUT SET GRD00480 STD L XNAME GRD00490 BSI L LOCAT LOCATE SECOND INPUT GRD00500 LD L SCSTR SET OF GRIDS GRD00510 STO L SCSTB GRD00520 LD L ICMAX STORE HEADER GRD00530 STO L ICMXB INFORMATION FOR GRD00540 LD L IRMAX SECOND SET GRD00550 STO L IRMXB GRD00560 LDD L GRID GRD00570 STD L GRIDB GRD00580 LDD L XMIN GRD00590 STD L XMINB GRD00600 LDD L YMIN GRD00610 STD L YMINB GRD00620 LD L IFOUN WAS THE SET FOUND? GRD00630 BSC L OKKB,Z GRD00640 BSI L ERTYP TYPE ERROR MESSAGE GRD00650 DC MSAG8 IF SECOND SET WAS GRD00660 BSI L ERTYP NOT FOUND ON DISK GRD00670 DC MSAG4 GRD00680 OUT WAIT GRD00690 EXIT GRD00700 OKKB LD L BNAME GRD00710 STO L MSAGB+12 GRD00720 LD L BNAME+1 GRD00730 STO L MSAGB+13 GRD00740 BSI L ERTYP TYPE MESSAGE GIVING GRD00750 DC MSAGB NAME OF SECOND GRD00760 LDD L CNAME INPUT SET GRD00770 STD L XNAME GRD00780 BSI L LOCAT CHECK TO SEE GRD00790 LD L SCSTR IF NAME OF OUTPUT GRID GRD00800 STO L SCSTC IS ALREADY USED ON GRD00810 LD L IFOUN DISK GRD00820 BSC L OKKC,+- GRD00830 BSI L ERTYP GRD00840 DC MSAG9 TYPE ERROR MESSAGE GRD00850 BSI L ERTYP IF IT HAS BEEN GRD00860 DC MSAG4 USED GRD00870 MDX OUT GRD00880 OKKC LD L CNAME GRD00890 STO L MSAGC+9 GRD00900 LD L CNAME+1 GRD00910 STO L MSAGC+10 GRD00920 BSI L ERTYP TYPE MESSAGE GIVING GRD00930 DC MSAGC NAME OF OUTPUT SET GRD00940 BSI L HEADN READ IN THE MAX AND GRD00950 LD L IMINV MIN SPECIFICATIONS GRD00960 STO L IMIN1 ON THE INPUT GRIDS GRD00970 LD L IMAXV GRD00980 STO L IMAX1 GRD00990 LD L IBELO GRD01000 STO L IMIN2 GRD01010 LD L IABOV GRD01020 STO L IMAX2 GRD01030 LDD L ZMINV GRD01040 STD L ZMIN1 GRD01050 LDD L ZMAXV GRD01060 STD L ZMAX1 GRD01070 LDD L BELOW GRD01080 STD L ZMIN2 GRD01090 LDD L ABOVE GRD01100 STD L ZMAX2 GRD01110 BSI L HEADN READ IN THE MAX AND GRD01120 LD L IMINV MIN SPECIFICATIONS GRD01130 STO L IMINO ON THE OUTPUT GRID GRD01140 LD L IMAXV GRD01150 STO L IMAXO GRD01160 LDD L ZMINV GRD01170 STD L ZMINO GRD01180 LDD L ZMAXV GRD01190 STD L ZMAXO GRD01200 LDD L BELOW GRD01210 STD L ZFILL GRD01220 LIBF FLD CHECK TO SEE GRD01230 DC GRIDA IF THE TWO INPUT GRD01240 LIBF FSUB GRID INTERVALS GRD01250 DC GRIDB ARE THE SAME GRD01260 LIBF FSTO GRD01270 DC ZRES GRD01280 LD L ZRES GRD01290 BSC L *+2,+- GRD01300 MDX L IERR,1 GRD01310 LIBF FLD CHECK TO SEE GRD01320 DC XMINA IF THE TWO INPUT GRD01330 LIBF FSUB XMIN VALUES GRD01340 DC XMINB ARE THE SAME GRD01350 LIBF FSTO GRD01360 DC ZRES GRD01370 LD L ZRES GRD01380 BSC L *+2,+- GRD01390 MDX L IERR,1 GRD01400 LIBF FLD CHECK TO SEE GRD01410 DC YMINA IF THE TWO INPUT GRD01420 LIBF FSUB YMIN VALUES GRD01430 DC YMINB ARE THE SAME GRD01440 LIBF FSTO GRD01450 DC ZRES GRD01460 LD L ZRES GRD01470 BSC L *+2,+- GRD01480 MDX L IERR,1 GRD01490 LD L IERR DID THE HEADER GRD01500 BSC L OKKD,+- RECORDS AGREE? GRD01510 BSI L ERTYP TYPE MESSAGE IF GRD01520 DC ERRU7 THEY DID NOT GRD01530 LD L IGNOR IS THIS ERROR GRD01540 BSC L YES,Z TO BE IGNORED? GRD01550 BSI L ERTYP EXIT IF NO GRD01560 DC ERRU8 GRD01570 EXIT GRD01580 YES BSI L ERTYP CONTINUE IF GRD01590 DC ERRU9 YES GRD01600 OKKD LD L ICMXA SET THE MAXIMUM GRD01610 S L ICMXB NUMBER OF COLUMNS GRD01620 BSC L GGR1,+ FOR THE OUTPUT EQUAL GRD01630 LD L ICMXB TO THE SMALLER OF THE GRD01640 STO L ICMXA TWO INPUT VALUES GRD01650 GGR1 LD L IRMXA SET THE MAXIMUM GRD01660 S L IRMXB NUMBER OF ROWS GRD01670 BSC L GGR2,+ FOR THE OUTPUT EQUAL GRD01680 LD L IRMXB TO THE SMALLER OF THE GRD01690 STO L IRMXA TWO INPUT VALUES GRD01700 GGR2 BSI L WRTOU WRITE OUTPUT HDR RCD GRD01710 BSI L REWRT WRITE TRAILER RECORD GRD01720 LD L ZERO GRD01730 STO L I GRD01740 DGR30 LD L I SELECT A COLUMN GRD01750 A L ONE OF GRID VALUES GRD01760 STO L I GRD01770 LD L SCSTA GRD01780 STO L SCSTR GRD01790 BSI L GRDVA INPUT COLUMN FROM GRD01800 LD L SCSTB FIRST GRID SET GRD01810 STO L SCSTR GRD01820 BSI L ICOLS INPUT CORRESPONDING GRD01830 LD L ZERO COLUMN OF THE SECOND GRD01840 STO L J SET OF GRID VALUES GRD01850 DGR29 LD L J SELECT A ROW GRD01860 A L ONE GRD01870 STO L J GRD01880 LDX I1 J GRD01890 MDX I1 J GRD01900 LDD L1 Z1-2 FIND THE GRD01910 STD L ZF CORRESPONDING GRD01920 LDD L1 Z2-2 GRID POINTS GRD01930 STD L ZS GRD01940 LIBF FLD IS THE FIRST GRID GRD01950 DC ZF VALUE DEFINED GRD01960 LIBF FSUB GRD01970 DC ZNIL GRD01980 LIBF FSTO GRD01990 DC ZRES GRD02000 LD L ZRES GRD02010 BSC L GGR3,+- GRD02020 GR1 LIBF FLD IS THE SECOND GRID GRD02030 DC ZS VALUE DEFINED GRD02040 LIBF FSUB GRD02050 DC ZNIL GRD02060 LIBF FSTO GRD02070 DC ZRES GRD02080 LD L ZRES GRD02090 BSC L GGR3,+- GRD02100 GR2 LD L IMIN1 IS A MINIMUM VALUE GRD02110 BSC L GR4,+- FOR THE FIRST SET GRD02120 GR3 LIBF FLD SPECIFIED GRD02130 DC ZF GRD02140 LIBF FSUB GRD02150 DC ZMIN1 GRD02160 LIBF FSTO GRD02170 DC ZRES GRD02180 LD L ZRES GRD02190 BSC L GR21,Z+ GRD02200 GR4 LD L IMAX1 IS A MAXIMUM VALUE GRD02210 BSC L GR6,+- FOR THE FIRST SET GRD02220 GR5 LIBF FLD SPECIFIED GRD02230 DC ZF GRD02240 LIBF FSUB GRD02250 DC ZMAX1 GRD02260 LIBF FSTO GRD02270 DC ZRES GRD02280 LD L ZRES GRD02290 BSC L GR21,Z- GRD02300 GR6 LD L IMIN2 IS A MINIMUM VALUE GRD02310 BSC L GR8,+- FOR THE SECOND GRD02320 GR7 LIBF FLD SET SPECIFIED GRD02330 DC ZS GRD02340 LIBF FSUB GRD02350 DC ZMIN2 GRD02360 LIBF FSTO GRD02370 DC ZRES GRD02380 LD L ZRES GRD02390 BSC L GR21,Z+ GRD02400 GR8 LD L IMAX2 IS A MAXIMUM VALUE GRD02410 BSC L GR40,+- FOR THE SECOND GRD02420 GR9 LIBF FLD SET SPECIFIED GRD02430 DC ZS GRD02440 LIBF FSUB GRD02450 DC ZMAX2 GRD02460 LIBF FSTO GRD02470 DC ZRES GRD02480 LD L ZRES GRD02490 BSC L GR21,Z- GRD02500 GR40 LDX I1 IOP SELECT THE GRD02510 BSC I1 *-1 SPECIFIED GRD02520 DC GR10 OPERATION GRD02530 DC GR11 GRD02540 DC GR12 GRD02550 DC GR13 GRD02560 DC GR16 GRD02570 DC GR17 GRD02580 DC GR20 GRD02590 GR10 LIBF FLD OPERATION NUMBER ONE GRD02600 DC ZF ADD THE TWO GRID GRD02610 LIBF FADD POINTS GRD02620 DC ZS GRD02630 LIBF FSTO GRD02640 DC ZT GRD02650 BSC L GR22 GRD02660 GR11 LIBF FLD OPERATION NUMBER TWO GRD02670 DC ZF SUBTRACT THE SECOND GRD02680 LIBF FSUB GRID POINT FROM GRD02690 DC ZS THE FIRST GRID POINT GRD02700 LIBF FSTO GRD02710 DC ZT GRD02720 BSC L GR22 GRD02730 GR12 LIBF FLD OPERATION NUMBER GRD02740 DC ZF THREE GRD02750 LIBF FMPY MULTIPLY THE TWO GRD02760 DC ZS GRID POINTS GRD02770 LIBF FSTO GRD02780 DC ZT GRD02790 BSC L GR22 GRD02800 GR13 LD L ZS OPERATION NUMBER FOUR GRD02810 BSC L GR15,Z DIVIDE THE FIRST GRD02820 GR14 LIBF FLD GRID POINT BY THE GRD02830 DC ZNIL SECOND GRID POINT GRD02840 LIBF FSTO SET EQUAL TO ZNIL GRD02850 DC ZT IS SECOND POINT IS GRD02860 BSC L GR28 ZERO GRD02870 GR15 LIBF FLD GRD02880 DC ZF GRD02890 LIBF FDIV GRD02900 DC ZS GRD02910 LIBF FSTO GRD02920 DC ZT GRD02930 BSC L GR22 GRD02940 GR16 LIBF FLD OPERATION NUMBER FIVE GRD02950 DC ZF SET THE OUTPUT POINT GRD02960 LIBF FSTO EQUAL TO THE GRD02970 DC ZT FIRST INPUT POINT GRD02980 BSC L GR22 GRD02990 GR17 LIBF FLD OPERATION NUMBER SIX GRD03000 DC ZF SET THE OUTPUT POINT GRD03010 LIBF FSUB EQUAL TO THE GRD03020 DC ZS SMALLER OF THE GRD03030 LIBF FSTO INPUT POINTS GRD03040 DC ZRES GRD03050 LD L ZRES GRD03060 BSC L GR19,Z- GRD03070 GR18 LIBF FLD GRD03080 DC ZF GRD03090 LIBF FSTO GRD03100 DC ZT GRD03110 BSC L GR22 GRD03120 GR19 LIBF FLD GRD03130 DC ZS GRD03140 LIBF FSTO GRD03150 DC ZT GRD03160 BSC L GR22 GRD03170 GR20 LIBF FLD OPERATION NUMBER GRD03180 DC ZF SEVEN GRD03190 LIBF FSUB SET THE OUTPUT POINT GRD03200 DC ZS EQUAL TO THE GRD03210 LIBF FSTO LARGER OF THE GRD03220 DC ZRES INPUT POINTS GRD03230 LD L ZRES GRD03240 BSC L GR18,Z- GRD03250 BSC L GR19 GRD03260 GR21 LIBF FLD SET OUTPUT VALUE IF GRD03270 DC ZFILL INPUT FAILS TO MEET GRD03280 LIBF FSTO SPECIFICATIONS GRD03290 DC ZT GRD03300 BSC L GR28 GRD03310 GR22 LD L IMINO IS MINIMUM OUTPUT GRD03320 BSC L GR25,+- VALUE SPECIFIED GRD03330 GR23 LIBF FLD GRD03340 DC ZT GRD03350 LIBF FSUB GRD03360 DC ZMINO GRD03370 LIBF FSTO GRD03380 DC ZRES GRD03390 LD L ZRES GRD03400 BSC L GR25,- GRD03410 GR24 LIBF FLD GRD03420 DC ZMINO GRD03430 LIBF FSTO GRD03440 DC ZT GRD03450 GR25 LD L IMAXO IS MAXIMUM OUTPUT GRD03460 BSC L GR28,+- VALUE SPECIFIED GRD03470 GR26 LIBF FLD GRD03480 DC ZT GRD03490 LIBF FSUB GRD03500 DC ZMAXO GRD03510 LIBF FSTO GRD03520 DC ZRES GRD03530 LD L ZRES GRD03540 BSC L GR28,+ GRD03550 GR27 LIBF FLD GRD03560 DC ZMAXO GRD03570 LIBF FSTO GRD03580 DC ZT GRD03590 GR28 LDX I1 J STORE THE OUTPUT GRD03600 MDX I1 J GRD03610 LDD L ZT GRD03620 STD L1 ZO-2 GRD03630 GR29 LD L J HAVE ALL THE ROWS GRD03640 S L IRMXA BEEN PROCESSED GRD03650 BSC L DGR29,+Z GRD03660 LD L SCSTC GRD03670 STO L SCSTR GRD03680 BSI L WRTGR OUTPUT THE COLUMN GRD03690 MDX L THCOL,1 GRD03700 GR30 LD L I HAVE ALL THE COLUMNS GRD03710 S L ICMXA BEEN PROCESSED GRD03720 BSC L DGR30,+Z GRD03730 BSI L ERTYP TYPE COMPLETION GRD03740 DC MSAG3 MESSAGE GRD03750 EXIT GRD03760 GGR3 LD L IOP BRANCH TO GR14 UNLESS GRD03770 S L SIX OPERATION NUMBER SIX GRD03780 BSC L GGR4,+- OR SEVEN HAS BEEN GRD03790 S L ONE SPECIFIED GRD03800 BSC L GR14,Z GRD03810 GGR4 LIBF FLD IF OPERATION NUMBER GRD03820 DC ZF SIX OR SEVEN IS GRD03830 LIBF FSUB SPECIFIED AND ONE GRD03840 DC ZNIL OR BOTH INPUT POINTS GRD03850 LIBF FSTO IS UNDEFINED THEN GRD03860 DC ZRES CHECK TO SEE IF GRD03870 LD L ZRES THE FIRST INPUT GRD03880 BSC L GGR5,+- POINT WAS DEFINED GRD03890 LIBF FLD SET THE OUTPUT POINT GRD03900 DC ZF EQUAL TO THE FIRST GRD03910 LIBF FSTO POINT IF IT IS GRD03920 DC ZT DEFINED GRD03930 BSC L GR28 GRD03940 GGR5 LIBF FLD IF THE FIRST POINT GRD03950 DC ZS WAS NOT DEFINED THEN GRD03960 LIBF FSUB CHECK TO SEE IF THE GRD03970 DC ZNIL SECOND INPUT POINT GRD03980 LIBF FSTO WAS DEFINED GRD03990 DC ZRES SET THE OUTPUT GRD04000 LD L ZRES POINT EQUAL TO THIS GRD04010 BSC L GR14,+- POINT IF IT WAS GRD04020 LIBF FLD DEFINED GRD04030 DC ZS IF BOTH POINTS WERE GRD04040 LIBF FSTO UNDEFINED THEN BRANCH GRD04050 DC ZT TO GR14 WHICH SETS GRD04060 BSC L GR28 THE OUTPUT TO ZNIL GRD04070 *************** GRD04080 * NAME SUBROUTINE GRD04090 *************** GRD04100 NAME NOP SUBROUTINE TO GRD04110 LD L FX25 READ THE INPUT GRD04120 STO L INPTA AND OUTPUT GRID GRD04130 *************** GRD04140 LIBF CARD0 NAMES FROM A GRD04150 * LIBF READ0 NAMES FROM A GRD04160 *************** GRD04170 DC /0000 CARD AND ALSO GRD04180 MDX *-3 TO READ IOP GRD04190 *************** GRD04200 LIBF CARD0 FROM THIS CARD GRD04210 * LIBF READ0 FROM THIS CARD GRD04220 *************** GRD04230 DC /1000 GRD04240 DC INPTA GRD04250 *************** GRD04260 LIBF CARD0 GRD04270 * LIBF READ0 GRD04280 *************** GRD04290 DC /0000 GRD04300 MDX *-3 GRD04310 LIBF SPEED GRD04320 DC /0000 GRD04330 DC INPTA+1 GRD04340 DC ANAME GRD04350 DC 4 GRD04360 LIBF SPEED GRD04370 DC /0000 GRD04380 DC INPTA+6 GRD04390 DC BNAME GRD04400 DC 4 GRD04410 LIBF SPEED GRD04420 DC /0000 GRD04430 DC INPTA+11 GRD04440 DC CNAME GRD04450 DC 4 GRD04460 LD L PLUS GRD04470 STO L DUMM GRD04480 LD L ZERO GRD04490 STO L DUMM&1 GRD04500 STO L DUMM&2 GRD04510 STO L DUMM&3 GRD04520 STO L DUMM&4 GRD04530 LD L INPTA&20 GRD04540 STO L DUMM&5 GRD04550 LIBF DCBIN GRD04560 DC DUMM GRD04570 STO L IOP GRD04580 LD L INPTA+25 GRD04590 STO L IGNOR GRD04600 BSC I NAME GRD04610 *************** GRD04620 * SUBROUTINE HEADN FOR GRDOP GRD04630 *************** GRD04640 HEADN NOP SUBROUTINE TO GRD04650 *************** GRD04660 LIBF CARD0 READ MAX AND GRD04670 * LIBF READ0 READ MAX AND GRD04680 *************** GRD04690 DC /0000 MIN VALUES FROM GRD04700 MDX *-3 A CARD GRD04710 LD L FXD80 GRD04720 STO L INPTA GRD04730 *************** GRD04740 LIBF CARD0 GRD04750 * LIBF READ0 GRD04760 *************** GRD04770 DC /1000 GRD04780 DC INPTA GRD04790 *************** GRD04800 LIBF CARD0 GRD04810 * LIBF READ0 GRD04820 *************** GRD04830 DC /0000 GRD04840 MDX *-3 GRD04850 LD L INPTA+20 GRD04860 BSC L INT1,Z GRD04870 LD L ZERO GRD04880 STO L IMINV GRD04890 MDX INT2 GRD04900 INT1 LD L ONE GRD04910 STO L IMINV GRD04920 INT2 LD L INPTA+40 GRD04930 BSC L INT3,Z GRD04940 LD L ZERO GRD04950 STO L IMAXV GRD04960 MDX INT4 GRD04970 INT3 LD L ONE GRD04980 STO L IMAXV GRD04990 INT4 LD L INPTA+60 GRD05000 BSC L INT5,Z GRD05010 LD L ZERO GRD05020 STO L IBELO GRD05030 MDX INT6 GRD05040 INT5 LD L ONE GRD05050 STO L IBELO GRD05060 INT6 LD L INPTA+80 GRD05070 BSC L INT7,Z GRD05080 LD L ZERO GRD05090 STO L IABOV GRD05100 MDX INT8 GRD05110 INT7 LD L ONE GRD05120 STO L IABOV GRD05130 INT8 LDX 2 10 GRD05140 LD L2 INPTA&10 GRD05150 STO L2 INPTA GRD05160 MDX 2 -1 GRD05170 MDX *-6 GRD05180 BSI L FFORM GRD05190 BSI L CEFBF GRD05200 LDD L BINFL GRD05210 STD L ZMINV GRD05220 LDX 2 10 GRD05230 LD L2 INPTA&30 GRD05240 STO L2 INPTA GRD05250 MDX 2 -1 GRD05260 MDX *-6 GRD05270 BSI L FFORM GRD05280 BSI L CEFBF GRD05290 LDD L BINFL GRD05300 STD L ZMAXV GRD05310 LDX 2 10 GRD05320 LD L2 INPTA&50 GRD05330 STO L2 INPTA GRD05340 MDX 2 -1 GRD05350 MDX *-6 GRD05360 BSI L FFORM GRD05370 BSI L CEFBF GRD05380 LDD L BINFL GRD05390 STD L BELOW GRD05400 LDX 2 10 GRD05410 LD L2 INPTA&70 GRD05420 STO L2 INPTA GRD05430 MDX 2 -1 GRD05440 MDX *-6 GRD05450 BSI L FFORM GRD05460 BSI L CEFBF GRD05470 LDD L BINFL GRD05480 STD L ABOVE GRD05490 BSC I HEADN GRD05500 *************** GRD05510 * LOCAT SUBROUTINE GRD05520 *************** GRD05530 LOCAT NOP SUBROUTINE TO GRD05540 LD L FX20 LOCATE THE GRID GRD05550 STO L WKIO NAME OR THE GRD05560 LD L SCBGN TRAILER RECORD GRD05570 STO L WKIO+1 IN THE DISK DATA GRD05580 AGN LIBF DISKN AREA GRD05590 DC /5000 GRD05600 DC WKIO SETS IFOUN EQUAL GRD05610 DC ERRS TO ONE IF THE GRD05620 LIBF DISKN NAME IS FOUND GRD05630 DC /1000 GRD05640 DC WKIO SETS IFOUN EQUAL GRD05650 DC ERRS TO ZERO IF THE GRD05660 LIBF DISKN TRAILER RECORD GRD05670 DC /0000 IS FOUND GRD05680 DC WKIO GRD05690 MDX *-4 GRD05700 LIBF FLD GRD05710 DC TRAIL GRD05720 LIBF FSUB GRD05730 DC WKIO+2 GRD05740 LIBF FSTO GRD05750 DC DUMY GRD05760 LD L DUMY GRD05770 BSC L OK,+- GRD05780 LIBF FLD GRD05790 DC WKIO+2 GRD05800 LIBF FSUB GRD05810 DC XNAME GRD05820 LIBF FSTO GRD05830 DC DUMY GRD05840 LD L DUMY GRD05850 BSC L FND,+- GRD05860 LD L WKIO+6 GRD05870 M L FOUR GRD05880 STD L DUMY GRD05890 D L THREE GRD05900 STO L SCINC GRD05910 M L THREE GRD05920 D L ONE GRD05930 S L DUMY+1 GRD05940 BSC L AA3,- GRD05950 A L FOUR GRD05960 A L SCINC GRD05970 STO L SCINC GRD05980 AA3 LD L WKIO&1 GRD05990 A L SCINC GRD06000 STO L WKIO+1 GRD06010 S L SCBGN GRD06020 BSC L EROB,& GRD06030 S L SCLGT GRD06040 BSC L EROB,- GRD06050 BSC L AGN GRD06060 FND LD L ONE GRD06070 STO L IFOUN GRD06080 LDD L WKIO+4 GRD06090 STD L GRID GRD06100 LD L WKIO+6 GRD06110 STO L ICMAX GRD06120 LD L WKIO+7 GRD06130 STO L IRMAX GRD06140 LDD L WKIO+8 GRD06150 STD L XMIN GRD06160 LDD L WKIO+10 GRD06170 STD L YMIN GRD06180 LD L WKIO&1 GRD06190 STO L SCSTR GRD06200 BSC I LOCAT GRD06210 OK LD L ZERO GRD06220 STO L IFOUN GRD06230 LD L WKIO&1 GRD06240 STO L SCSTR GRD06250 BSC I LOCAT GRD06260 EROB BSI L ERTYP GRD06270 DC MSAG7 GRD06280 BSI L ERTYP GRD06290 DC MSAG4 GRD06300 WAIT GRD06310 EXIT GRD06320 ERRS NOP GRD06330 LIBF WRTY0 GRD06340 DC /2000 GRD06350 DC MSAG5 GRD06360 SRA 16 GRD06370 BSC I ERRS GRD06380 *************** GRD06390 * SCCOM SUBROUTINE GRD06400 *************** GRD06410 SCCOM NOP SUBROUTINE TO GRD06420 LD L THCOL COMPUTE THE SECTOR GRD06430 S L ONE NUMBER IN WHICH GRD06440 M L ONE THE SELECTED GRD06450 D L THREE COLUMN BEGINS GRD06460 STO L DUMY GRD06470 M L FOUR GRD06480 D L ONE GRD06490 STO L SCINC GRD06500 LD L DUMY GRD06510 M L THREE GRD06520 D L ONE GRD06530 STO L DUMY GRD06540 LD L THCOL GRD06550 S L DUMY GRD06560 S L ONE GRD06570 STO L SCINX GRD06580 A L SCINC GRD06590 STO L SCINC GRD06600 A L SCSTR GRD06610 STO L SCLOC GRD06620 S L SCBGN GRD06630 BSC L ER,Z+ GRD06640 S L SCLGT GRD06650 BSC L ER,- GRD06660 LD L FX100 GRD06670 M L SCINX GRD06680 D L ONE GRD06690 A L FX22 GRD06700 STO L ININX GRD06710 BSC I SCCOM GRD06720 ER BSI L ERTYP GRD06730 DC MSAG7 GRD06740 BSI L ERTYP GRD06750 DC MSAG4 GRD06760 WAIT GRD06770 EXIT GRD06780 *************** GRD06790 * GRDVA SUBROUTINE GRD06800 *************** GRD06810 GRDVA NOP SUBROUTINE TO GRD06820 BSI L SCCOM READ GRID VALUES GRD06830 LD L SCLOC FROM THE FIRST GRD06840 STO L WKIO&1 INPUT SET GRD06850 LD L FX640 GRD06860 STO L WKIO GRD06870 LIBF DISKN GRD06880 DC /5000 GRD06890 DC WKIO GRD06900 DC ERRS GRD06910 LIBF DISKN GRD06920 DC /1000 GRD06930 DC WKIO GRD06940 DC ERRS GRD06950 LD L ININX GRD06960 A L FX418 GRD06970 STO L DUMY GRD06980 LDX I1 DUMY GRD06990 LDX I2 FX400 GRD07000 LIBF DISKN GRD07010 DC /0000 GRD07020 DC WKIO GRD07030 MDX *-4 GRD07040 LDD L1 WKIO GRD07050 STD L2 Z1-2 GRD07060 MDX 1 -2 GRD07070 MDX 2 -2 GRD07080 MDX *-7 GRD07090 LDX I1 ININX GRD07100 LD L1 WKIO GRD07110 STO L KCOLZ GRD07120 LD L1 WKIO+1 GRD07130 STO L IBZ GRD07140 LD L1 WKIO+2 GRD07150 STO L IEZ GRD07160 BSC I GRDVA GRD07170 *************** GRD07180 * ICOLS SUBROUTINE GRD07190 *************** GRD07200 ICOLS NOP SUBROUTINE TO GRD07210 BSI L SCCOM READ GRID VALUES GRD07220 LD L SCLOC FROM THE SECOND GRD07230 STO L WKIO&1 INPUT SET GRD07240 LD L FX640 GRD07250 STO L WKIO GRD07260 LIBF DISKN GRD07270 DC /5000 GRD07280 DC WKIO GRD07290 DC ERRS GRD07300 LIBF DISKN GRD07310 DC /1000 GRD07320 DC WKIO GRD07330 DC ERRS GRD07340 LD L ININX GRD07350 A L FX418 GRD07360 STO L DUMY GRD07370 LDX I1 DUMY GRD07380 LDX I2 FX400 GRD07390 LIBF DISKN GRD07400 DC /0000 GRD07410 DC WKIO GRD07420 MDX *-4 GRD07430 LDD L1 WKIO GRD07440 STD L2 Z2-2 GRD07450 MDX 1 -2 GRD07460 MDX 2 -2 GRD07470 MDX *-7 GRD07480 LDX I1 ININX GRD07490 LD L1 WKIO GRD07500 STO L K GRD07510 LD L1 WKIO+1 GRD07520 STO L IRMIN GRD07530 BSC I ICOLS GRD07540 *************** GRD07550 * WRTOU SUBROUTINE GRD07560 *************** GRD07570 WRTOU NOP SUBROUTINE TO GRD07580 LDX 1 22 WRITE THE HEADER GRD07590 LDX 2 20 RECORD FOR THE GRD07600 LDD L ZNIL OUTPUT SET OF GRD07610 STD L1 WKIO-2 GRIDS GRD07620 MDX 1 -2 GRD07630 MDX 2 -2 GRD07640 MDX *-5 GRD07650 LD L SCBGN GRD07660 A L SCLGT GRD07670 S L SCSTC GRD07680 M L THREE GRD07690 D L FOUR GRD07700 S L ICMXA GRD07710 BSC L NOROM,+Z GRD07720 LD L FX20 GRD07730 STO L WKIO GRD07740 LD L SCSTC GRD07750 STO L WKIO+1 GRD07760 LDD L CNAME GRD07770 STD L WKIO+2 GRD07780 LDD L GRIDA GRD07790 STD L WKIO+4 GRD07800 LD L ICMXA GRD07810 STO L WKIO&6 GRD07820 LD L IRMXA GRD07830 STO L WKIO&7 GRD07840 LDD L XMINA GRD07850 STD L WKIO+8 GRD07860 LDD L YMINA GRD07870 STD L WKIO+10 GRD07880 LIBF DISKN GRD07890 DC /5000 GRD07900 DC WKIO GRD07910 DC ERRS GRD07920 LIBF DISKN GRD07930 DC /4000 GRD07940 DC WKIO GRD07950 LIBF DISKN GRD07960 DC /0000 GRD07970 DC WKIO GRD07980 MDX *-4 GRD07990 BSC I WRTOU GRD08000 NOROM BSI L ERTYP GRD08010 DC MSAG6 GRD08020 BSI L ERTYP GRD08030 DC MSAG4 GRD08040 WAIT GRD08050 EXIT GRD08060 *************** GRD08070 * WRTGR SUBROUTINE GRD08080 *************** GRD08090 WRTGR NOP SUBROUTINE TO GRD08100 BSI L SCCOM WRITE THE OUTPUT GRD08110 LIBF DISKN GRID COLUMNS ON GRD08120 DC /0000 THE DISK GRD08130 DC WKIO GRD08140 MDX *-4 GRD08150 LD L FX640 GRD08160 STO L WKIO GRD08170 LD L SCLOC GRD08180 STO L WKIO+1 GRD08190 LIBF DISKN GRD08200 DC /5000 GRD08210 DC WKIO GRD08220 DC ERRS GRD08230 LIBF DISKN GRD08240 DC /1000 GRD08250 DC WKIO GRD08260 DC ERRS GRD08270 LIBF DISKN GRD08280 DC /0000 GRD08290 DC WKIO GRD08300 MDX *-4 GRD08310 LD L ININX GRD08320 A L FX418 GRD08330 STO L DUMY GRD08340 LDX I1 DUMY GRD08350 LDX I2 FX420 GRD08360 LDD L ZNIL GRD08370 STD L1 WKIO GRD08380 MDX 1 -2 GRD08390 MDX 2 -2 GRD08400 MDX *-5 GRD08410 LD L IRMXA GRD08420 A L IRMXA GRD08430 STO L DUMY GRD08440 LDX I2 DUMY GRD08450 LD L ININX GRD08460 A L FX20 GRD08470 A L DUMY GRD08480 S L TWO GRD08490 STO L DUMY GRD08500 LDX I1 DUMY GRD08510 LDD L2 ZO-2 GRD08520 STD L1 WKIO GRD08530 MDX 1 -2 GRD08540 MDX 2 -2 GRD08550 MDX *-7 GRD08560 LDX I1 ININX GRD08570 LD L KCOLZ GRD08580 STO L1 WKIO GRD08590 LD L ONE GRD08600 STO L1 WKIO+1 GRD08610 LD L IRMXA GRD08620 STO L1 WKIO&2 GRD08630 LIBF DISKN GRD08640 DC /4000 GRD08650 DC WKIO GRD08660 LIBF DISKN GRD08670 DC /0000 GRD08680 DC WKIO GRD08690 MDX *-4 GRD08700 BSC I WRTGR GRD08710 *************** GRD08720 * CEFBF SUBROUTINE GRD08730 *************** GRD08740 CEFBF NOP SUBROUTINE TO GRD08750 LD L CRDCD&30 CONVERT E-FORMAT GRD08760 S L PLUS CARD CODE NUMBERS GRD08770 BSC L NXTA,&- TO INTERNAL GRD08780 LD L CRDCD&30 BINARY NOTATION GRD08790 S L AMPER GRD08800 BSC L NXTA,&- GRD08810 LD L CRDCD&30 GRD08820 S L MINUS GRD08830 BSC L NXTA,&- GRD08840 LD L CRDCD&30 GRD08850 BSC L ERROR,Z GRD08860 NXTA LD L CRDCD&31 GRD08870 S L PERID GRD08880 BSC L ERROR,Z GRD08890 LD L CRDCD&40 GRD08900 S L LTRE GRD08910 BSC L ERROR,Z GRD08920 LD L CRDCD&41 GRD08930 S L PLUS GRD08940 BSC L NXTB,&- GRD08950 LD L CRDCD&41 GRD08960 S L AMPER GRD08970 BSC L NXTB,&- GRD08980 LD L CRDCD&41 GRD08990 S L MINUS GRD09000 BSC L NXTB,&- GRD09010 LD L CRDCD&41 GRD09020 BSC L ERROR,Z GRD09030 NXTB LD L CRDCD&30 GRD09040 STO L EFORM GRD09050 LD L ZERO GRD09060 STO L EFORM&1 GRD09070 LD L CRDCD&32 GRD09080 STO L EFORM&2 GRD09090 LD L CRDCD&33 GRD09100 STO L EFORM&3 GRD09110 LD L CRDCD&34 GRD09120 STO L EFORM&4 GRD09130 LD L CRDCD&35 GRD09140 STO L EFORM&5 GRD09150 LIBF DCBIN GRD09160 DC EFORM GRD09170 STO L FXMNT GRD09180 LIBF FLOAT GRD09190 LIBF FSTO GRD09200 DC MANT GRD09210 LD L ZERO GRD09220 STO L EFORM&1 GRD09230 LD L CRDCD&36 GRD09240 STO L EFORM&2 GRD09250 LD L CRDCD&37 GRD09260 STO L EFORM&3 GRD09270 LD L CRDCD&38 GRD09280 STO L EFORM&4 GRD09290 LD L CRDCD&39 GRD09300 STO L EFORM&5 GRD09310 LIBF DCBIN GRD09320 DC EFORM GRD09330 STO L FXMNR GRD09340 LIBF FLOAT GRD09350 LIBF FSTO GRD09360 DC MANR GRD09370 LD L FXMNT GRD09380 BSC L *&4,Z GRD09390 LD L FXMNR GRD09400 BSC L ALTER,&- GRD09410 LD L CRDCD&41 GRD09420 STO L EFORM GRD09430 LD L ZERO GRD09440 STO L EFORM&1 GRD09450 STO L EFORM&2 GRD09460 STO L EFORM&3 GRD09470 LD L CRDCD&42 GRD09480 STO L EFORM&4 GRD09490 LD L CRDCD&43 GRD09500 STO L EFORM&5 GRD09510 LIBF DCBIN GRD09520 DC EFORM GRD09530 STO L EXPON GRD09540 LIBF FLD GRD09550 DC FTEN GRD09560 LIBF FAXI GRD09570 DC EXPON GRD09580 LIBF FSTO GRD09590 DC EXPT GRD09600 LIBF FLD GRD09610 DC MANR GRD09620 LIBF FMPY GRD09630 DC TENG4 GRD09640 LIBF FADD GRD09650 DC MANT GRD09660 LIBF FMPY GRD09670 DC TENG4 GRD09680 LIBF FMPY GRD09690 DC EXPT GRD09700 LIBF FSTO GRD09710 DC BINFL GRD09720 BSC I CEFBF GRD09730 ALTER LDD L FZERO GRD09740 STD L BINFL GRD09750 BSC I CEFBF GRD09760 ERROR BSI L ERTYP GRD09770 DC ERRU6 GRD09780 BSI L ERTYP GRD09790 DC MSAG4 GRD09800 WAIT GRD09810 EXIT GRD09820 *************** GRD09830 * FFORM SUBROUTINE GRD09840 *************** GRD09850 FFORM NOP SUBROUTINE TO GRD09860 LDX 2 14 CONVERT AN F-FORMAT GRD09870 LD L NMZER CARD CODE NUMBER GRD09880 STO L2 CRDCD+30 TO E-FORMAT GRD09890 MDX 2 -1 GRD09900 MDX *-4 GRD09910 LD L PLUS GRD09920 STO L CRDCD+30 GRD09930 LD L PERID GRD09940 STO L CRDCD+31 GRD09950 LD L LTRE GRD09960 STO L CRDCD+40 GRD09970 LD L FX11 GRD09980 STO L FNDPR GRD09990 LDX 1 10 GRD10000 FFRM LD L1 INPTA GRD10010 BSC L FIND1,+- GRD10020 LD L1 INPTA GRD10030 S L PLUS GRD10040 BSC L FIND1,+- GRD10050 LD L1 INPTA GRD10060 S L AMPER GRD10070 BSC L FIND1,+- GRD10080 LD L1 INPTA GRD10090 S L MINUS GRD10100 BSC L BCKF,Z GRD10110 LD L MINUS GRD10120 STO L CRDCD+30 GRD10130 BSC L FIND1 GRD10140 BCKF LD L1 INPTA GRD10150 S L PERID GRD10160 BSC L BCKG,Z GRD10170 STX L1 FNDPR GRD10180 BCKG MDX 1 -1 GRD10190 MDX *+1 GRD10200 MDX *+2 GRD10210 BSC L FFRM GRD10220 FIND1 STX L1 FNDEN GRD10230 LD L FNDPR GRD10240 S L FNDEN GRD10250 S L ONE GRD10260 LIBF BINDC GRD10270 DC EFORM GRD10280 LD L EFORM GRD10290 STO L CRDCD+41 GRD10300 LD L EFORM+4 GRD10310 STO L CRDCD+42 GRD10320 LD L EFORM+5 GRD10330 STO L CRDCD+43 GRD10340 LD L TEN GRD10350 S L FNDEN GRD10360 BSC L FIND4,+ GRD10370 STO L FFMNB GRD10380 MDX 1 1 GRD10390 LD L1 INPTA GRD10400 STO L CRDCD+32 GRD10410 LD L ONE GRD10420 STO L FFMCT GRD10430 S L FFMNB GRD10440 BSC L ONWD,- GRD10450 LDX 2 0 GRD10460 BCKH MDX 2 1 GRD10470 BCKJ MDX 1 1 GRD10480 MDX L FFMCT,+1 GRD10490 LD L1 INPTA GRD10500 S L PERID GRD10510 BSC L BCKI,+- GRD10520 LD L1 INPTA GRD10530 STO L2 CRDCD+32 GRD10540 LD L FFMCT GRD10550 S L FFMNB GRD10560 BSC L BCKH,+ GRD10570 BSC I FFORM GRD10580 FIND4 LD L NMZER GRD10590 STO L CRDCD+44 GRD10600 ONWD BSC I FFORM GRD10610 BCKI LD L FFMCT GRD10620 S L FFMNB GRD10630 BSC L BCKJ,+ GRD10640 BSC I FFORM GRD10650 *************** GRD10660 * REWRT SUBROUTINE GRD10670 *************** GRD10680 REWRT NOP SUBROUTINE TO GRD10690 LD L ICMXA WRITE THE TRAILER GRD10700 M L FOUR RECORD BEHIND THE GRD10710 STD L DUMY OUTPUT GRID SET GRD10720 D L THREE GRD10730 STO L SCINC GRD10740 M L THREE GRD10750 D L ONE GRD10760 S L DUMY+1 GRD10770 BSC L AA2,- GRD10780 A L FOUR GRD10790 A L SCINC GRD10800 STO L SCINC GRD10810 AA2 LD L SCINC GRD10820 A L SCSTC GRD10830 STO L XXXX GRD10840 LIBF DISKN GRD10850 DC /0000 GRD10860 DC WKIO GRD10870 MDX *-4 GRD10880 LD L XXXX GRD10890 STO L WKIO+1 GRD10900 LD L TWO GRD10910 STO L WKIO GRD10920 LDD L TRAIL GRD10930 STD L WKIO+2 GRD10940 LIBF DISKN GRD10950 DC /5000 GRD10960 DC WKIO GRD10970 DC ERRS GRD10980 LIBF DISKN GRD10990 DC /4000 GRD11000 DC WKIO GRD11010 LIBF DISKN GRD11020 DC /0000 GRD11030 DC WKIO GRD11040 MDX *-4 GRD11050 BSC I REWRT GRD11060 *************** GRD11070 * ERTYP SUBROUTINE GRD11080 *************** GRD11090 ERTYP NOP SUBROUTINE TO GRD11100 LD I ERTYP WRITE MESSAGES GRD11110 STO L ERTX ON THE CONSOLE GRD11120 MDX L ERTYP,&1 TYPEWRITER GRD11130 LD L ERTX GRD11140 S L ONE GRD11150 STO *&1 GRD11160 LD L 0 GRD11170 STO L ERTX+2 GRD11180 M L ONE GRD11190 D L TWO GRD11200 STO L TYPE GRD11210 LIBF EBPRT GRD11220 DC /0000 GRD11230 ERTX DC 0 GRD11240 DC TYPE+1 GRD11250 DC 0 GRD11260 LIBF WRTY0 GRD11270 DC /2000 GRD11280 DC TYPE GRD11290 LIBF WRTY0 GRD11300 DC /2000 GRD11310 DC CONTL GRD11320 LIBF WRTY0 GRD11330 DC /0000 GRD11340 MDX *-3 GRD11350 BSC I ERTYP GRD11360 *************** GRD11370 * DEFINE ERROR MESAGES GRD11380 *************** GRD11390 DC 16 GRD11400 MSAG1 EBC .GRDOP BEGINNING . GRD11410 DC 16 GRD11420 MSAG3 EBC .GRDOP COMPLETED . GRD11430 DC 30 GRD11440 MSAG4 EBC .PUSH START FOR EXIT TO MONITOR. GRD11450 MSAG5 DC 20 DISK ERROR MESSAGE GRD11460 DC /3020 GRD11470 DC /9858 GRD11480 DC /2135 GRD11490 DC /6060 GRD11500 DC /5060 GRD11510 DC /2121 GRD11520 DC /9C34 GRD11530 DC /6070 GRD11540 DC /2074 GRD11550 DC /3C9C GRD11560 DC /3421 GRD11570 DC /7C50 GRD11580 DC /1821 GRD11590 DC /3C74 GRD11600 DC /3021 GRD11610 DC /6034 GRD11620 DC /989C GRD11630 DC /3C60 GRD11640 DC /9C21 GRD11650 DC /8103 GRD11660 DC 54 GRD11670 MSAG6 EBC .REQUIRED NUMBER OF COLUMNS. GRD11680 EBC .EXCEEDS AVAILABLE DISK AREA. GRD11690 DC 30 GRD11700 MSAG7 EBC .UNABLE TO FIND TRAILER RECORD . GRD11710 DC 22 GRD11720 MSAG8 EBC .NAME NOT FOUND ON DISK. GRD11730 DC 26 GRD11740 MSAG9 EBC .NAME ALREADY USED ON DISK . GRD11750 DC 28 GRD11760 MSAGA EBC .FIRST INPUT GRID NAMED . GRD11770 DC /4040 GRD11780 DC /4040 GRD11790 DC 28 GRD11800 MSAGB EBC .SECOND INPUT GRID NAMED . GRD11810 DC /4040 GRD11820 DC /4040 GRD11830 DC 22 GRD11840 MSAGC EBC .OUTPUT GRID NAMED . GRD11850 DC /4040 GRD11860 DC /4040 GRD11870 DC 30 GRD11880 ERRU6 EBC .INPUT DATA NOT IN PROPER FORM . GRD11890 DC 26 GRD11900 ERRU7 EBC .INPUT HEADERS DO NOT AGREE. GRD11910 DC 26 GRD11920 ERRU8 EBC .GRDOP EXECUTION TERMINATED. GRD11930 DC 46 GRD11940 ERRU9 EBC .OUTPUT HEADER SET EQUAL TO. GRD11950 EBC . FIRST INPUT HEADER . GRD11960 CONTL DC 1 GRD11970 DC /8103 GRD11980 *************** GRD11990 * DEFINE CONSTANTS GRD12000 *************** GRD12010 TEN DC 10 GRD12020 FX11 DC 11 GRD12030 SCBGN DC 448 GRD12040 SCLGT DC 808 GRD12050 NMZER DC /2000 GRD12060 PLUS DC /80A0 GRD12070 AMPER DC /8000 GRD12080 MINUS DC /4000 GRD12090 PERID DC /8420 GRD12100 LTRE DC /8100 GRD12110 FX25 DC 25 GRD12120 FZERO DEC 0. GRD12130 FTEN DEC 10. GRD12140 TENG4 DEC 1.0E-4 GRD12150 ZERO DC 0 GRD12160 ONE DC 1 GRD12170 TWO DC 2 GRD12180 THREE DC 3 GRD12190 FOUR DC 4 GRD12200 FIVE DC 5 GRD12210 SIX DC 6 GRD12220 SEVEN DC 7 GRD12230 TWELV DC 12 GRD12240 FX15 DC 15 GRD12250 FX19 DC 19 GRD12260 FX20 DC 20 GRD12270 FX22 DC 22 GRD12280 FXD80 DC 80 GRD12290 FX100 DC 100 GRD12300 FX272 DC 272 GRD12310 FX280 DC 280 GRD12320 FX400 DC 400 GRD12330 FX402 DC 402 GRD12340 FX418 DC 418 GRD12350 FX420 DC 420 GRD12360 FX422 DC 422 GRD12370 FX640 DC 640 GRD12380 FX808 DC 808 GRD12390 ZNIL DEC -1.0E30 GRD12400 TRAIL DEC 9999. GRD12410 XXXX DC /FFFF GRD12420 YYYY DC /EEEE GRD12430 *************** GRD12440 * ALLOCATE STORAGE GRD12450 *************** GRD12460 FNDPR BSS 1 GRD12470 FNDEN BSS 1 GRD12480 FFMNB BSS 1 GRD12490 FFMCT BSS 1 GRD12500 EXPT BSS E 2 GRD12510 EFORM BSS E 6 GRD12520 FXMNT BSS 1 GRD12530 MANT BSS E 2 GRD12540 FXMNR BSS 1 GRD12550 MANR BSS E 2 GRD12560 EXPON BSS 1 GRD12570 BINFL BSS E 2 GRD12580 DUMM BSS E 6 GRD12590 CRDCD BSS E 45 GRD12600 BSS E 1 GRD12610 INPTA BSS 81 GRD12620 IMINV BSS 1 GRD12630 IMAXV BSS 1 GRD12640 IBELO BSS 1 GRD12650 IABOV BSS 1 GRD12660 ZMINV BSS E 2 GRD12670 ZMAXV BSS E 2 GRD12680 ABOVE BSS E 2 GRD12690 BELOW BSS E 2 GRD12700 IGNOR BSS 1 GRD12710 SCSTC BSS 1 GRD12720 YMINB BSS E 2 GRD12730 XMINB BSS E 2 GRD12740 GRIDB BSS E 2 GRD12750 ICMXB BSS 1 GRD12760 IRMXB BSS 1 GRD12770 SCSTB BSS 1 GRD12780 YMINA BSS E 2 GRD12790 XMINA BSS E 2 GRD12800 GRIDA BSS E 2 GRD12810 ICMXA BSS 1 GRD12820 IRMXA BSS 1 GRD12830 SCSTA BSS 1 GRD12840 BNAME BSS E 2 GRD12850 CNAME BSS E 2 GRD12860 XNAME BSS E 2 GRD12870 TYPE BSS E 30 GRD12880 DUMN BSS 1 GRD12890 DIRMX BSS 1 GRD12900 GRID BSS E 2 GRD12910 THCOL BSS 1 GRD12920 IBZ BSS 1 GRD12930 IEZ BSS 1 GRD12940 ICMAX BSS 1 GRD12950 IRMAX BSS 1 GRD12960 K BSS 1 GRD12970 KCOLZ BSS 1 GRD12980 OUTS BSS 1 GRD12990 BSS 12 GRD13000 OUTT BSS 1 GRD13010 BSS 12 GRD13020 BSS E 1 GRD13030 AA BSS 81 GRD13040 CHKK BSS 29 GRD13050 CHLL BSS E 16 GRD13060 ANAME BSS E 2 GRD13070 DUMY BSS E 2 GRD13080 DREND BSS E 2 GRD13090 IFOUN BSS 1 GRD13100 ININX BSS 1 GRD13110 IRMIN BSS 1 GRD13120 SCLOC BSS 1 GRD13130 SCINC BSS 1 GRD13140 SCINX BSS 1 GRD13150 SCSTR BSS 1 GRD13160 WKIO BSS E 642 GRD13170 J BSS 1 GRD13180 ZF BSS E 2 GRD13190 ZS BSS E 2 GRD13200 ZT BSS E 2 GRD13210 ZRES BSS E 2 GRD13220 I BSS 1 GRD13230 Z1 BSS E 402 GRD13240 Z2 BSS E 402 GRD13250 ZO BSS E 402 GRD13260 IMIN1 BSS 1 GRD13270 IMAX1 BSS 1 GRD13280 ZMIN1 BSS E 2 GRD13290 ZMAX1 BSS E 2 GRD13300 IMIN2 BSS 1 GRD13310 IMAX2 BSS 1 GRD13320 ZMIN2 BSS E 2 GRD13330 ZMAX2 BSS E 2 GRD13340 IOP BSS 1 GRD13350 ZFILL BSS E 2 GRD13360 IMINO BSS 1 GRD13370 IMAXO BSS 1 GRD13380 ZMINO BSS E 2 GRD13390 XMIN BSS E 2 GRD13400 YMIN BSS E 2 GRD13410 IERR BSS 1 GRD13420 ZMAXO BSS E 2 GRD13430 END GO GRD13440 // DUP GRD13450 *STORE WS UA GRDOP GRD13460 // JOB NUI00010 // DUP NUI00020 *DELETE NUINT NUI00030 // ASM NUI00040 *LIST *************** NUI00050 * NUMERICAL INTEGRATION NUI00060 *************** NUI00070 * THE TECHNIQUE USED IN THIS ROUTINE IS TO TAKE NUI00080 * THREE ADJACENT GRID POINTS WHICH FORM THE NUI00090 * VERTICES OF A RIGHT TRIANGLE IN THE X-Y NUI00100 * PLANE. IT IS ASSUMED THAT A PLANE THROUGH THE NUI00110 * THREE POINTS APPROXIMATES THE SURFACE NUI00120 * INTERIOR TO THE THREE POINTS. THE INTEGRATION NUI00130 * IS ACCOMPLISHED BY ACCUMULATING OVER THE NUI00140 * TRIANGULAR SECTIONS. NUI00150 *************** NUI00160 GO LIBF WRTY0 NUI00170 DC /2000 NUI00180 DC CONTL NUI00190 BSI L ERTYP TYPE BEGINNING NUI00200 DC MSAG1 MESSAGE NUI00210 LDD L FZERO INITIALIZE ACC WITH NUI00220 STD L ACC A VALUE OF ZERO NUI00230 BSI L NAME INPUT GRID NAME NUI00240 LD L ANAME NUI00250 STO L MSAG2+6 NUI00260 LD L ANAME+1 NUI00270 STO L MSAG2+7 NUI00280 BSI L HEADN INPUT INTEGRATION NUI00290 BSI L LOCAT FACTS AND PARAMETERS NUI00300 LD L IFOUN LOCATE THE GRID NUI00310 BSC L OKK,Z SET IN THE DISK NUI00320 BSI L ERTYP DATA AREA NUI00330 DC MSAG8 TYPE ERROR MESSAGE NUI00340 BSI L ERTYP IF IT CANNOT NUI00350 DC MSAG4 BE FOUND NUI00360 WAIT NUI00370 EXIT NUI00380 OKK LD L NEG2 INITIALIZE THE NUI00390 STO L KCOLB COLUMN INDEX NUI00400 LD L ZERO VALUES NUI00410 STO L NCOL NUI00420 LD L ONE NUI00430 STO L THCOL NUI00440 LOOP1 BSI L GRDVA INPUT COLUMN VALUES NUI00450 MDX L THCOL,1 NUI00460 LD L IBZ CHECK THE VALUE OF NUI00470 BSC L *&8,Z THE FIRST ROW FOR A NUI00480 LD L MXCOL ZERO NUI00490 S L KCOLZ CHECK FOR LAST NUI00500 BSC L LOOP1,Z- COLUMN NUI00510 BSC L LAST NUI00520 LD L IEZ CALCULATE THE NUMBER NUI00530 S L IBZ OF ROWS IN COLUMN Z NUI00540 A L ONE AND DOUBLE THIS NUI00550 M L TWO VALUE NUI00560 STD L DDIF NUI00570 LD L NCOL ASSIGN EACH COLUMN A NUI00580 A L ONE CONSECUTIVE NUMBER NUI00590 STO L NCOL WHEN IT IS READ IN NUI00600 BSC L ODD,E IF THE CONSECUTIVE NUI00610 EVEN LD L KCOLZ NUMBER ASSIGNED TO NUI00620 STO L KCOLB A PARTICULAR COLUMN NUI00630 LD L IBZ Z IS EVEN THEN STORE NUI00640 STO L IBB ALL THE INFORMATION NUI00650 LD L IEZ RELATED TO COLUMN Z NUI00660 STO L IEB IN THE STORAGE NUI00670 LD L IBB AREA DESIGNATED NUI00680 A L IBB AS COLUMN B NUI00690 STO L DUM NUI00700 LDX I1 DUM NUI00710 LOOP2 LIBF FLDX NUI00720 DC IZ-2 NUI00730 LIBF FSTOX NUI00740 DC B-2 NUI00750 MDX 1 2 NUI00760 STX L1 DUM NUI00770 LD L DUM NUI00780 S L DDIF&1 NUI00790 BSC L LOOP2,& NUI00800 BSC L TESTA NUI00810 ODD LD L KCOLZ IF THE CONSECUTIVE NUI00820 STO L KCOLA NUMBER ASSIGNED TO NUI00830 LD L IBZ A PARTICULAR COLUMN NUI00840 STO L IBA Z IS ODD THEN STORE NUI00850 LD L IEZ ALL THE INFORMATION NUI00860 STO L IEA RELATED TO COLUMN Z NUI00870 LD L IBA IN THE STORAGE NUI00880 A L IBA AREA DESIGNATED NUI00890 STO L DUM AS COLUMN A NUI00900 LDX I1 DUM NUI00910 LOOP3 LIBF FLDX NUI00920 DC IZ-2 NUI00930 LIBF FSTOX NUI00940 DC A-2 NUI00950 MDX 1 2 NUI00960 STX L1 DUM NUI00970 LD L DUM NUI00980 S L DDIF&1 NUI00990 BSC L LOOP3,& NUI01000 TESTA LD L KCOLA CHECK THE ACTUAL NUI01010 S L KCOLB COLUMN NUMBERS OF NUI01020 A L ONE COLUMNS A AND B AND NUI01030 BSC L *&16,&- SEE IF THEY ARE NUI01040 LD L KCOLB CONSECTUTIVE NUI01050 S L KCOLA NUI01060 A L ONE NUI01070 BSC L *&8,&- NUI01080 LD L MXCOL IF NOT CONSEC,CHECK NUI01090 S L KCOLZ TO SEE IF MXCOL WILL NUI01100 BSC L LOOP1,Z- BE EXCEEDED BY NEXT NUI01110 BSC L LAST COL TO BE READ IN NUI01120 LD L MXCOL IF CONSEC, CHECK TO NUI01130 S L KCOLZ SEE IF MXCOL WAS NUI01140 BSC L LAST,Z& EXCEEDED BY LAST COL NUI01150 BTTM LD L IBA SEE IF A SINGLE NUI01160 S L IBB TRIANGLE IS DEFINED NUI01170 BSC L NONA,&- AT THE BEGINNING OF NUI01180 BSC L NEGA,& THE COLUMN NUI01190 POSA LD L IBA NUI01200 STO L IBMIN NUI01210 S L ONE NUI01220 STO L JBMIN NUI01230 LD L IBMIN NUI01240 A L IBMIN NUI01250 STO L DUM NUI01260 LDX I1 DUM NUI01270 LIBF FLDX THE TRIANGLE NUI01280 DC A-2 (Z2,Z3,Z4) IS NUI01290 LIBF FSTO DEFINED AT THE NUI01300 DC Z2 BEGINNING OF THE NUI01310 LIBF FLDX COLUMN NUI01320 DC B-2 NUI01330 LIBF FSTO NUI01340 DC Z3 NUI01350 LD L JBMIN NUI01360 A L JBMIN NUI01370 STO L DUM NUI01380 LDX I1 DUM NUI01390 LIBF FLDX NUI01400 DC B-2 NUI01410 LIBF FSTO NUI01420 DC Z4 NUI01430 BSI L INTG INTEGRATE OVER NUI01440 DC Z2 THIS TRIANGLE NUI01450 DC Z3 NUI01460 DC Z4 NUI01470 BSC L TOP NUI01480 NEGA LD L IBB NUI01490 STO L IBMIN NUI01500 S L ONE NUI01510 STO L JBMIN NUI01520 LD L IBMIN NUI01530 A L IBMIN NUI01540 STO L DUM NUI01550 LDX I1 DUM NUI01560 LIBF FLDX THE TRIANGLE NUI01570 DC A-2 (Z1,Z2,Z3) IS NUI01580 LIBF FSTO DEFINED AT THE NUI01590 DC Z2 BEGINNING OF THE NUI01600 LIBF FLDX COLUMN NUI01610 DC B-2 NUI01620 LIBF FSTO NUI01630 DC Z3 NUI01640 LD L JBMIN NUI01650 A L JBMIN NUI01660 STO L DUM NUI01670 LDX I1 DUM NUI01680 LIBF FLDX NUI01690 DC A-2 NUI01700 LIBF FSTO NUI01710 DC Z1 NUI01720 BSI L INTG INTEGRATE OVER NUI01730 DC Z1 THIS TRIANGLE NUI01740 DC Z2 NUI01750 DC Z3 NUI01760 BSC L TOP NUI01770 NONA LD L IBA NUI01780 STO L IBMIN NUI01790 TOP LD L IEA SEE IF A SINGLE NUI01800 S L IEB TRIANGLE IS DEFINED NUI01810 BSC L NONB,&- AT THE END OF THE NUI01820 BSC L NEGB,& COLUMN NUI01830 POSB LD L IEB NUI01840 S L ONE NUI01850 STO L IEMAX NUI01860 A L TWO NUI01870 STO L KEMAX NUI01880 LD L IEB NUI01890 A L IEB NUI01900 STO L DUM NUI01910 LDX I1 DUM NUI01920 LIBF FLDX THE TRIANGLE NUI01930 DC A-2 (Z2,Z1,Z4) IS NUI01940 LIBF FSTO DEFINED AT THE END NUI01950 DC Z1 OF THE COLUMN NUI01960 LIBF FLDX NUI01970 DC B-2 NUI01980 LIBF FSTO NUI01990 DC Z4 NUI02000 LD L KEMAX NUI02010 A L KEMAX NUI02020 STO L DUM NUI02030 LDX I1 DUM NUI02040 LIBF FLDX NUI02050 DC A-2 NUI02060 LIBF FSTO NUI02070 DC Z2 NUI02080 BSI L INTG INTEGRATE OVER NUI02090 DC Z2 THIS TRIANGLE NUI02100 DC Z1 NUI02110 DC Z4 NUI02120 BSC L MIDL NUI02130 NEGB LD L IEA NUI02140 S L ONE NUI02150 STO L IEMAX NUI02160 A L TWO NUI02170 STO L KEMAX NUI02180 LD L IEA NUI02190 A L IEA NUI02200 STO L DUM NUI02210 LDX I1 DUM NUI02220 LIBF FLDX THE TRIANGLE NUI02230 DC A-2 (Z1,Z4,Z3) IS NUI02240 LIBF FSTO DEFINED AT THE END NUI02250 DC Z1 OF THE COLUMN NUI02260 LIBF FLDX NUI02270 DC B-2 NUI02280 LIBF FSTO NUI02290 DC Z4 NUI02300 LD L KEMAX NUI02310 A L KEMAX NUI02320 STO L DUM NUI02330 LDX I1 DUM NUI02340 LIBF FLDX NUI02350 DC B-2 NUI02360 LIBF FSTO NUI02370 DC Z3 NUI02380 BSI L INTG INTEGRATE OVER NUI02390 DC Z1 THIS TRIANGLE NUI02400 DC Z4 NUI02410 DC Z3 NUI02420 BSC L MIDL NUI02430 NONB LD L IEA NUI02440 S L ONE NUI02450 STO L IEMAX NUI02460 MIDL LD L IEMAX SEE IF ANY PAIRS OF NUI02470 S L IBMIN TRIANGLES ARE NUI02480 BSC L TESTB,&Z DEFINED IN THIS NUI02490 A L ONE COLUMN NUI02500 M L TWO NUI02510 STD L DIF NUI02520 LD L IBMIN NUI02530 A L IBMIN NUI02540 STO L DUM NUI02550 LDX I1 DUM NUI02560 LOOP4 LIBF FLDX THE PAIR OF TRIANGLES NUI02570 DC A-2 (P2,P1,P4) AND NUI02580 LIBF FSTO %P2,P3,P4< ARE NUI02590 DC Z1 DEFINED IN THIS NUI02600 LIBF FLDX COLUMN NUI02610 DC B-2 NUI02620 LIBF FSTO NUI02630 DC Z4 NUI02640 MDX 1 2 NUI02650 LIBF FLDX NUI02660 DC A-2 NUI02670 LIBF FSTO NUI02680 DC Z2 NUI02690 LIBF FLDX NUI02700 DC B-2 NUI02710 LIBF FSTO NUI02720 DC Z3 NUI02730 BSI INTG INTEGRATE OVER NUI02740 DC Z2 THE PAIR OF NUI02750 DC Z1 TRIANGLES NUI02760 DC Z4 NUI02770 BSI INTG NUI02780 DC Z2 NUI02790 DC Z3 NUI02800 DC Z4 NUI02810 STX L1 DUM NUI02820 LD L DUM SEE IF THE MAXIMUM NUI02830 S L DIF&1 ROW NUMBER HAS NUI02840 BSC L LOOP4,& BEEN REACHED NUI02850 TESTB LD L MXCOL SEE IF THE MAXIMUM NUI02860 S L KCOLZ COLUMN NUMBER HAS NUI02870 BSC L LOOP1,-Z BEEN REACHED NUI02880 LAST LD L ISARA NUI02890 S L ONE NUI02900 BSC L MSGS,+- NUI02910 S L ONE NUI02920 BSC L MSGP,+- NUI02930 BSI L ERTYP TYPE OUTPUT NUI02940 DC MSAGV MESSAGE WHICH NUI02950 MDX MSG CORRESPONDS TO NUI02960 MSGS BSI L ERTYP THE TYPE OF NUI02970 DC MSAGS INTEGRATION NUI02980 MDX MSG WHICH HAS BEEN NUI02990 MSGP BSI L ERTYP PERFORMED NUI03000 DC MSAGP NUI03010 MSG BSI L ERTYP NUI03020 DC MSAG9 NUI03030 BSI L OUTPT OUTPUT THE RESULT NUI03040 BSI L ERTYP TYPE COMPLETION NUI03050 DC MSAG3 MESSAGE NUI03060 EXIT NUI03070 *************** NUI03080 * NUMERICAL INTEGRATION SUBROUTINE NUI03090 *************** NUI03100 * SUBROUTINE TO PERFORM THE SPECIFIED TYPE OF NUI03110 * INTEGRATION OVER A RIGHT TRIANGULAR SECTION NUI03120 *************** NUI03130 INTG NOP TRANSFER THE VALUES NUI03140 LD I INTG OF THE THREE POINTS NUI03150 STO *&1 SUPPLIED BY THE MAIN NUI03160 LDD L PROGRAM INTO NUI03170 STD L ZA LOCATIONS (ZA,ZC,AND NUI03180 LD L INTG ZB),MAKING SURE THAT NUI03190 A L ONE THE POINT AT THE NUI03200 STO L INTG RIGHT ANGLE OF THE NUI03210 LD I INTG TRIANGLE IS PLACED NUI03220 STO *&1 IN LOCATION ZC. NUI03230 LDD L NUI03240 STD L ZC NUI03250 LD L INTG NUI03260 A L ONE NUI03270 STO L INTG NUI03280 LD I INTG NUI03290 STO *&1 NUI03300 LDD L NUI03310 STD L ZB NUI03320 LD L INTG MODIFY INTG IN ORDER NUI03330 A L ONE TO OBTAIN CORRECT NUI03340 STO L INTG ADDRESS TO RETURN TO NUI03350 LIBF FLD TRANSFER THE THREE NUI03360 DC ZA POINTS TO NEW NUI03370 LIBF FSTO STORAGE LOCATIONS NUI03380 DC ZAP SO THAT THESE VALUES NUI03390 LIBF FLD CAN BE OPERATED ON NUI03400 DC ZC WHILE THE ORIGINAL NUI03410 LIBF FSTO VALUES OF THE POINTS NUI03420 DC ZCP ARE RETAINED FOR NUI03430 LIBF FLD LATER USE NUI03440 DC ZB NUI03450 LIBF FSTO NUI03460 DC ZBP NUI03470 LD L ISARA SKIP IF VOLUME NUI03480 BSC L INTG1,Z NUI03490 LIBF FLD NUI03500 DC ZAP NUI03510 LIBF FSUB NUI03520 DC ZNIL NUI03530 LIBF FSTO NUI03540 DC RESUL NUI03550 LD L RESUL NUI03560 BSC L FINAL,+ NUI03570 LIBF FLD NUI03580 DC ZBP NUI03590 LIBF FSUB NUI03600 DC ZNIL NUI03610 LIBF FSTO NUI03620 DC RESUL NUI03630 LD L RESUL NUI03640 BSC L FINAL,+ NUI03650 LIBF FLD NUI03660 DC ZCP NUI03670 LIBF FSUB NUI03680 DC ZNIL NUI03690 LIBF FSTO NUI03700 DC RESUL NUI03710 LD L RESUL NUI03720 BSC L FINAL,+ NUI03730 INTG1 LD L ZERO INITIALIZE COUNT NUI03740 STO L KOUNT NUI03750 LD L IMINV IS A MINIMUM NUI03760 S L ONE ACCEPTABLE VALUE NUI03770 BSC L NXTAA,Z SPECIFIED NUI03780 LIBF FLD IS THE VALUE OF ZAP NUI03790 DC ZAP LESS THAN THE NUI03800 LIBF FSUB SPECIFIED MINIMUM NUI03810 DC ZMINV VALUE NUI03820 LIBF FSTO NUI03830 DC RESUL NUI03840 LD L RESUL NUI03850 BSC L *+2,- NUI03860 MDX L KOUNT,1 NUI03870 LIBF FLD IS THE VALUE OF ZBP NUI03880 DC ZBP LESS THAN THE NUI03890 LIBF FSUB SPECIFIED MINIMUM NUI03900 DC ZMINV VALUE NUI03910 LIBF FSTO NUI03920 DC RESUL NUI03930 LD L RESUL NUI03940 BSC L *+2,- NUI03950 MDX L KOUNT,1 NUI03960 LIBF FLD IS THE VALUE OF ZCP NUI03970 DC ZCP LESS THAN THE NUI03980 LIBF FSUB SPECIFIED MINIMUM NUI03990 DC ZMINV VALUE NUI04000 LIBF FSTO NUI04010 DC RESUL NUI04020 LD L RESUL NUI04030 BSC L *+2,- NUI04040 MDX L KOUNT,1 NUI04050 LD L KOUNT ARE TWO OF THREE NUI04060 S L ONE POINTS ABOVE MIN NUI04070 BSC L FINAL,-Z NUI04080 NXTAA LD L IMAXV IS A MAXIMUM NUI04090 S L ONE ACCEPTABLE VALUE NUI04100 BSC L NXTBB,Z SPECIFIED NUI04110 LIBF FLD IS THE VALUE OF ZAP NUI04120 DC ZAP GREATER THAN THE NUI04130 LIBF FSUB SPECIFIED MAXIMUM NUI04140 DC ZMAXV VALUE NUI04150 LIBF FSTO NUI04160 DC RESUL NUI04170 LD L RESUL NUI04180 BSC L *+2,+ NUI04190 MDX L KOUNT,1 NUI04200 LIBF FLD IS THE VALUE OF ZBP NUI04210 DC ZBP GREATER THAN THE NUI04220 LIBF FSUB SPECIFIED MAXIMUM NUI04230 DC ZMAXV VALUE NUI04240 LIBF FSTO NUI04250 DC RESUL NUI04260 LD L RESUL NUI04270 BSC L *+2,+ NUI04280 MDX L KOUNT,1 NUI04290 LIBF FLD IS THE VALUE OF ZCP NUI04300 DC ZCP GREATER THAN THE NUI04310 LIBF FSUB SPECIFIED MAXIMUM NUI04320 DC ZMAXV VALUE NUI04330 LIBF FSTO NUI04340 DC RESUL NUI04350 LD L RESUL NUI04360 BSC L *+2,+ NUI04370 MDX L KOUNT,1 NUI04380 LD L KOUNT ARE TWO OF THREE NUI04390 S L ONE POINTS BELOW MAX NUI04400 BSC L FINAL,-Z NUI04410 NXTBB LD L IBELO IS THE SURFACE BELOW NUI04420 S L ONE A GIVEN PLANE TO BE NUI04430 BSC L NXTC,Z CONSIDERED NUI04440 LIBF FLD IS THE POINT ZAP NUI04450 DC ZAP ABOVE THE SPECIFIED NUI04460 LIBF FSUB PLANE NUI04470 DC BELOW NUI04480 LIBF FSTO NUI04490 DC ZAPBL NUI04500 LD L ZAPBL NUI04510 BSC L *&4,& NUI04520 LIBF FLD SET ZAP EQUAL TO THE NUI04530 DC BELOW VALUE OF BELOW IF NUI04540 LIBF FSTO IT IS ABOVE THE NUI04550 DC ZAP SPECIFIED PLANE NUI04560 LIBF FLD IS THE POINT ZBP NUI04570 DC ZBP ABOVE THE SPECIFIED NUI04580 LIBF FSUB PLANE NUI04590 DC BELOW NUI04600 LIBF FSTO NUI04610 DC ZAPBL NUI04620 LD L ZAPBL NUI04630 BSC L *&4,& NUI04640 LIBF FLD SET ZBP EQUAL TO THE NUI04650 DC BELOW VALUE OF BELOW IF NUI04660 LIBF FSTO IT IS ABOVE THE NUI04670 DC ZBP SPECIFIED PLANE NUI04680 LIBF FLD IS THE POINT ZCP NUI04690 DC ZCP ABOVE THE SPECIFIED NUI04700 LIBF FSUB PLANE NUI04710 DC BELOW NUI04720 LIBF FSTO NUI04730 DC ZAPBL NUI04740 LD L ZAPBL NUI04750 BSC L *&4,& NUI04760 LIBF FLD SET ZCP EQUAL TO THE NUI04770 DC BELOW VALUE OF BELOW IF NUI04780 LIBF FSTO IT IS ABOVE THE NUI04790 DC ZCP SPECIFIED PLANE NUI04800 NXTC LD L IABOV IS THE SURFACE ABOVE NUI04810 S L ONE A GIVEN PLANE TO BE NUI04820 BSC L NXTD,Z CONSIDERED NUI04830 LIBF FLD SUBTRACT THE VALUE OF NUI04840 DC ZAP ABOVE FROM ZAP NUI04850 LIBF FSUB NUI04860 DC ABOVE NUI04870 LIBF FSTO NUI04880 DC ZAP NUI04890 LIBF FLD SUBTRACT THE VALUE OF NUI04900 DC ZBP ABOVE FROM ZBP NUI04910 LIBF FSUB NUI04920 DC ABOVE NUI04930 LIBF FSTO NUI04940 DC ZBP NUI04950 LIBF FLD SUBTRACT THE VALUE OF NUI04960 DC ZCP ABOVE FROM ZCP NUI04970 LIBF FSUB NUI04980 DC ABOVE NUI04990 LIBF FSTO NUI05000 DC ZCP NUI05010 LD L ZAP NUI05020 LD L ZERO NUI05030 STO L KOUNT INITIALIZE COUNT NUI05040 BSC L *+2,- ARE TWO OF THREE NUI05050 MDX L KOUNT,1 POINTS ABOVE PLANE NUI05060 LD L ZBP ABOVE THE SPECIFIED NUI05070 BSC L *+2,- NUI05080 MDX L KOUNT,1 NUI05090 LD L ZCP NUI05100 BSC L *+2,- NUI05110 MDX L KOUNT,1 NUI05120 LD L KOUNT NUI05130 S L ONE NUI05140 BSC L FINAL,-Z NUI05150 NXTD LD L ISARA IS A SURFACE AREA NUI05160 S L ONE INTEGRATION NUI05170 BSC L NXTE,&- SPECIFIED NUI05180 LD L ISARA NUI05190 S L TWO IS THE AREA OF THE NUI05200 BSC L NXTFF,&- PROJECTION SPECIFIED NUI05210 LIBF FLD COMPUTE VOLUME NUI05220 DC ZAP WHICH IS NUI05230 LIBF FADD DETERMINED BY NUI05240 DC ZBP THIS PARTICULAR NUI05250 LIBF FADD TRIANGLE NUI05260 DC ZCP NUI05270 LIBF FDIV NUI05280 DC FSIX NUI05290 LIBF FMPY NUI05300 DC GRID NUI05310 LIBF FMPY NUI05320 DC GRID NUI05330 LIBF FMPY NUI05340 DC SCALE NUI05350 LIBF FADD NUI05360 DC ACC NUI05370 LIBF FSTO NUI05380 DC ACC NUI05390 BSC L FINAL NUI05400 NXTFF LIBF FLD COMPUTE THE PROJECTED NUI05410 DC FHALF AREA WHICH IS NUI05420 LIBF FMPY DETERMINED BY NUI05430 DC GRID THIS PARTICULAR NUI05440 LIBF FMPY TRIANGLE NUI05450 DC GRID NUI05460 LIBF FMPY NUI05470 DC SCALE NUI05480 LIBF FADD NUI05490 DC ACC NUI05500 LIBF FSTO NUI05510 DC ACC NUI05520 BSC L FINAL NUI05530 NXTE LIBF FLD COMPUTE THE SURFACE NUI05540 DC ZA AREA OF THIS NUI05550 LIBF FSUB PARTICULAR NUI05560 DC ZB TRIANGLE NUI05570 LIBF FSTO NUI05580 DC ZRES NUI05590 LIBF FMPY CALCULATE THE NUI05600 DC ZRES LENGTHS OF EACH NUI05610 LIBF FSTO OF THE SIDES OF NUI05620 DC ZRES THE TRIANGLE NUI05630 LIBF FLD NUI05640 DC GRID NUI05650 LIBF FMPY NUI05660 DC GRID NUI05670 LIBF FMPY NUI05680 DC FTWO NUI05690 LIBF FADD NUI05700 DC ZRES NUI05710 LIBF FSTO NUI05720 DC DSQ NUI05730 LIBF FLD NUI05740 DC ZB NUI05750 LIBF FSUB NUI05760 DC ZC NUI05770 LIBF FSTO NUI05780 DC ZRES NUI05790 LIBF FMPY NUI05800 DC ZRES NUI05810 LIBF FSTO NUI05820 DC ZRES NUI05830 LIBF FLD NUI05840 DC GRID NUI05850 LIBF FMPY NUI05860 DC GRID NUI05870 LIBF FADD NUI05880 DC ZRES NUI05890 LIBF FSTO NUI05900 DC ESQ NUI05910 LIBF FLD NUI05920 DC ZC NUI05930 LIBF FSUB NUI05940 DC ZA NUI05950 LIBF FSTO NUI05960 DC ZRES NUI05970 LIBF FMPY NUI05980 DC ZRES NUI05990 LIBF FSTO NUI06000 DC ZRES NUI06010 LIBF FLD NUI06020 DC GRID NUI06030 LIBF FMPY NUI06040 DC GRID NUI06050 LIBF FADD NUI06060 DC ZRES NUI06070 LIBF FSTO NUI06080 DC FSQ NUI06090 LIBF FLD DETERMINE WHICH NUI06100 DC DSQ SIDE IS THE NUI06110 LIBF FSUB LONGEST NUI06120 DC ESQ NUI06130 LIBF FSTO NUI06140 DC ZRES NUI06150 LD L ZRES NUI06160 BSC L IN32,- NUI06170 LIBF FLD NUI06180 DC ESQ NUI06190 LIBF FSUB NUI06200 DC FSQ NUI06210 LIBF FSTO NUI06220 DC ZRES NUI06230 LD L ZRES NUI06240 BSC L IN34,- NUI06250 BSC L IN33 NUI06260 IN32 LIBF FLD NUI06270 DC DSQ NUI06280 LIBF FSUB NUI06290 DC FSQ NUI06300 LIBF FSTO NUI06310 DC ZRES NUI06320 LD L ZRES NUI06330 BSC L IN35,- NUI06340 IN33 LIBF FLD NUI06350 DC FSQ NUI06360 LIBF FSTO NUI06370 DC ASQ NUI06380 LIBF FLD NUI06390 DC DSQ NUI06400 LIBF FSTO NUI06410 DC BSQ NUI06420 LIBF FLD NUI06430 DC ESQ NUI06440 LIBF FSTO NUI06450 DC CSQ NUI06460 BSC L IN36 NUI06470 IN34 LIBF FLD NUI06480 DC ESQ NUI06490 LIBF FSTO NUI06500 DC ASQ NUI06510 LIBF FLD NUI06520 DC DSQ NUI06530 LIBF FSTO NUI06540 DC BSQ NUI06550 LIBF FLD NUI06560 DC FSQ NUI06570 LIBF FSTO NUI06580 DC CSQ NUI06590 BSC L IN36 NUI06600 IN35 LIBF FLD NUI06610 DC DSQ NUI06620 LIBF FSTO NUI06630 DC ASQ NUI06640 LIBF FLD NUI06650 DC ESQ NUI06660 LIBF FSTO NUI06670 DC BSQ NUI06680 LIBF FLD NUI06690 DC FSQ NUI06700 LIBF FSTO NUI06710 DC CSQ NUI06720 IN36 LIBF FLD CALCULATE THE NUI06730 DC ASQ AREA NUI06740 LIBF FMPY NUI06750 DC FTWO NUI06760 LIBF FSBR NUI06770 DC CSQ NUI06780 LIBF FMPY NUI06790 DC CSQ NUI06800 LIBF FSTO NUI06810 DC ZRES NUI06820 LIBF FLD NUI06830 DC CSQ NUI06840 LIBF FMPY NUI06850 DC FTWO NUI06860 LIBF FSBR NUI06870 DC BSQ NUI06880 LIBF FMPY NUI06890 DC BSQ NUI06900 LIBF FADD NUI06910 DC ZRES NUI06920 LIBF FSTO NUI06930 DC ZRES NUI06940 LIBF FLD NUI06950 DC BSQ NUI06960 LIBF FMPY NUI06970 DC FTWO NUI06980 LIBF FADD NUI06990 DC ASQ NUI07000 LIBF FMPY NUI07010 DC ASQ NUI07020 LIBF FADD NUI07030 DC ZRES NUI07040 LIBF FDIV NUI07050 DC FFOUR NUI07060 LIBF FSTO NUI07070 DC ZRES NUI07080 LIBF FLD NUI07090 DC ASQ NUI07100 LIBF FMPY NUI07110 DC BSQ NUI07120 LIBF FSUB NUI07130 DC ZRES NUI07140 CALL FSQR NUI07150 LIBF FMPY NUI07160 DC SCALE NUI07170 LIBF FMPY NUI07180 DC FHALF NUI07190 LIBF FADD NUI07200 DC ACC NUI07210 LIBF FSTO NUI07220 DC ACC RETURN TO NUI07230 FINAL BSC I INTG MAINLINE NUI07240 *************** NUI07250 * SUBROUTINE HEADN FOR NUMERICAL INTEGRATION NUI07260 *************** NUI07270 HEADN NOP SUBROUTINE TO NUI07280 *************** NUI07290 LIBF CARD0 READ THE INPUT NUI07300 * LIBF READ0 READ THE INPUT NUI07310 *************** NUI07320 DC /0000 PARAMETERS NUI07330 MDX *-3 NUI07340 LD L FX20 NUI07350 STO L INPTA NUI07360 *************** NUI07370 LIBF CARD0 THE FIRST CARD NUI07380 * LIBF READ0 THE FIRST CARD NUI07390 *************** NUI07400 DC /1000 CONTAINS THE NUI07410 DC INPTA SCALE AND THE NUI07420 *************** NUI07430 LIBF CARD0 TYPE OF NUI07440 * LIBF READ0 TYPE OF NUI07450 *************** NUI07460 DC /0000 INTEGRATION NUI07470 MDX *-3 REQUESTED NUI07480 LDX 2 14 NUI07490 LD L2 INPTA NUI07500 STO L2 CRDCD&29 NUI07510 MDX 2 -1 NUI07520 MDX *-6 NUI07530 BSI L CEFBF NUI07540 LD L BINFL NUI07550 BSC L MDFY1,Z NUI07560 LDD L FONE NUI07570 STD L SCALE NUI07580 MDX MDFY2 NUI07590 MDFY1 LDD L BINFL NUI07600 STD L SCALE NUI07610 MDFY2 LD L PLUS NUI07620 STO L DUMM NUI07630 LD L ZERO NUI07640 STO L DUMM&1 NUI07650 STO L DUMM&2 NUI07660 STO L DUMM&3 NUI07670 STO L DUMM&4 NUI07680 LD L INPTA&20 NUI07690 STO L DUMM&5 NUI07700 LIBF DCBIN NUI07710 DC DUMM NUI07720 STO L ISARA NUI07730 LIBF CARD0 NUI07750 * LIBF READ0 NUI07760 *************** NUI07740 *************** NUI07770 DC /0000 NUI07780 MDX *-3 NUI07790 LD L FXD80 NUI07800 STO L INPTA NUI07810 *************** NUI07820 LIBF CARD0 THE SECOND CARD NUI07830 * LIBF READ0 THE SECOND CARD NUI07840 *************** NUI07850 DC /1000 CONTAINS IMINV, NUI07860 DC INPTA IMAXV, BELOW, AND NUI07870 *************** NUI07880 LIBF CARD0 ABOVE NUI07890 * LIBF READ0 ABOVE NUI07900 *************** NUI07910 DC /0000 NUI07920 MDX *-3 NUI07930 LD L INPTA+20 NUI07940 BSC L INT1,Z NUI07950 LD L ZERO NUI07960 STO L IMINV NUI07970 MDX INT2 NUI07980 INT1 LD L ONE NUI07990 STO L IMINV NUI08000 INT2 LD L INPTA+40 NUI08010 BSC L INT3,Z NUI08020 LD L ZERO NUI08030 STO L IMAXV NUI08040 MDX INT4 NUI08050 INT3 LD L ONE NUI08060 STO L IMAXV NUI08070 INT4 LD L INPTA+60 NUI08080 BSC L INT5,Z NUI08090 LD L ZERO NUI08100 STO L IBELO NUI08110 MDX INT6 NUI08120 INT5 LD L ONE NUI08130 STO L IBELO NUI08140 INT6 LD L INPTA+80 NUI08150 BSC L INT7,Z NUI08160 LD L ZERO NUI08170 STO L IABOV NUI08180 MDX INT8 NUI08190 INT7 LD L ONE NUI08200 STO L IABOV NUI08210 INT8 LDX 2 10 NUI08220 LD L2 INPTA&10 NUI08230 STO L2 INPTA NUI08240 MDX 2 -1 NUI08250 MDX *-6 NUI08260 BSI L FFORM NUI08270 BSI L CEFBF NUI08280 LDD L BINFL NUI08290 STD L ZMINV NUI08300 LDX 2 10 NUI08310 LD L2 INPTA&30 NUI08320 STO L2 INPTA NUI08330 MDX 2 -1 NUI08340 MDX *-6 NUI08350 BSI L FFORM NUI08360 BSI L CEFBF NUI08370 LDD L BINFL NUI08380 STD L ZMAXV NUI08390 LDX 2 10 NUI08400 LD L2 INPTA&50 NUI08410 STO L2 INPTA NUI08420 MDX 2 -1 NUI08430 MDX *-6 NUI08440 BSI L FFORM NUI08450 BSI L CEFBF NUI08460 LDD L BINFL NUI08470 STD L BELOW NUI08480 LDX 2 10 NUI08490 LD L2 INPTA&70 NUI08500 STO L2 INPTA NUI08510 MDX 2 -1 NUI08520 MDX *-6 NUI08530 BSI L FFORM NUI08540 BSI L CEFBF NUI08550 LDD L BINFL NUI08560 STD L ABOVE NUI08570 BSC I HEADN NUI08580 *************** NUI08590 * NAME SUBROUTINE NUI08600 *************** NUI08610 NAME NOP SUBROUTINE TO NUI08620 LD L FOUR READ A CARD NUI08630 STO L BNAME-1 CONTAINING NUI08640 *************** NUI08650 LIBF CARD0 THE NAME OF NUI08660 * LIBF READ0 THE NAME OF NUI08670 *************** NUI08680 DC /0000 THE GRID SET NUI08690 MDX *-3 TO BE USED NUI08700 *************** NUI08710 LIBF CARD0 AS INPUT NUI08720 * LIBF READ0 AS INPUT NUI08730 *************** NUI08740 DC /1000 NUI08750 DC BNAME-1 NUI08760 *************** NUI08770 LIBF CARD0 NUI08780 * LIBF READ0 NUI08790 *************** NUI08800 DC /0000 NUI08810 MDX *-3 NUI08820 LIBF SPEED NUI08830 DC /0000 NUI08840 DC BNAME NUI08850 DC ANAME NUI08860 DC 4 NUI08870 BSC I NAME NUI08880 *************** NUI08890 * LOCAT SUBROUTINE NUI08900 *************** NUI08910 LOCAT NOP SUBROUTINE TO NUI08920 LD L FX20 LOCATE THE GRID NUI08930 STO L WKIO SET IN THE NUI08940 LD L SCBGN DISK DATA AREA NUI08950 STO L WKIO+1 NUI08960 AGN LIBF DISKN SETS IFOUN TO NUI08970 DC /5000 ONE IF THE NUI08980 DC WKIO GRID SET IS NUI08990 DC ERRS FOUND NUI09000 LIBF DISKN NUI09010 DC /1000 SETS IFOUN TO NUI09020 DC WKIO ZERO IF THE NUI09030 DC ERRS TRAILER RECORD NUI09040 LIBF DISKN IS FOUND NUI09050 DC /0000 NUI09060 DC WKIO NUI09070 MDX *-4 NUI09080 LIBF FLD NUI09090 DC TRAIL NUI09100 LIBF FSUB NUI09110 DC WKIO+2 NUI09120 LIBF FSTO NUI09130 DC DUMY NUI09140 LD L DUMY NUI09150 BSC L OK,+- NUI09160 LIBF FLD NUI09170 DC WKIO+2 NUI09180 LIBF FSUB NUI09190 DC ANAME NUI09200 LIBF FSTO NUI09210 DC DUMY NUI09220 LD L DUMY NUI09230 BSC L FND,+- NUI09240 LD L WKIO+6 NUI09250 M L FOUR NUI09260 STD L DUMY NUI09270 D L THREE NUI09280 STO L SCINC NUI09290 M L THREE NUI09300 D L ONE NUI09310 S L DUMY+1 NUI09320 BSC L AA3,- NUI09330 A L FOUR NUI09340 A L SCINC NUI09350 STO L SCINC NUI09360 AA3 LD L WKIO&1 NUI09370 A L SCINC NUI09380 STO L WKIO+1 NUI09390 S L SCBGN NUI09400 BSC L EROB,& NUI09410 S L SCLGT NUI09420 BSC L EROB,- NUI09430 BSC L AGN NUI09440 FND LD L ONE TRANSFER HEADER RECORD NUI09450 STO L IFOUN DATA FROM WKIO TO NUI09460 LDD L WKIO+4 STORAGE NUI09470 STD L GRID NUI09480 LD L WKIO+6 NUI09490 STO L MXCOL NUI09500 LD L WKIO+7 NUI09510 STO L MXROW NUI09520 LDD L WKIO+8 NUI09530 STD L XMIN NUI09540 LDD L WKIO+10 NUI09550 STD L YMIN NUI09560 LD L WKIO&1 NUI09570 STO L SCSTR NUI09580 BSC I LOCAT NUI09590 OK LD L ZERO NUI09600 STO L IFOUN NUI09610 LD L WKIO&1 NUI09620 STO L SCSTR NUI09630 BSC I LOCAT NUI09640 EROB BSI L ERTYP NUI09650 DC MSAG7 NO TRAILER RECORD MESSAG5 NUI09660 BSI L ERTYP NUI09670 DC MSAG4 NUI09680 WAIT NUI09690 EXIT NUI09700 ERRS NOP DISK ERROR MESSAGE NUI09710 LIBF WRTY0 NUI09720 DC /2000 NUI09730 DC MSAG5 NUI09740 SRA 16 NUI09750 BSC I ERRS NUI09760 *************** NUI09770 * SCCOM SUBROUTINE NUI09780 *************** NUI09790 SCCOM NOP COMPUTE SECTOR ADDRESS NUI09800 LD L THCOL FROM THE COLUMN NUMBER NUI09810 S L ONE AND BEGINNING SECTOR NUI09820 M L ONE OF DATA SET AREA NUI09830 D L THREE TEST ADDRESS OF SECTOR NUI09840 STO L DUMY AGAINST UPPER AND LOWER NUI09850 M L FOUR LIMITS OF DATA SET AREA NUI09860 D L ONE NUI09870 STO L SCINC NUI09880 LD L DUMY NUI09890 M L THREE NUI09900 D L ONE NUI09910 STO L DUMY NUI09920 LD L THCOL NUI09930 S L DUMY NUI09940 S L ONE NUI09950 STO L SCINX NUI09960 A L SCINC NUI09970 STO L SCINC NUI09980 A L SCSTR NUI09990 STO L SCLOC NUI10000 S L SCBGN NUI10010 BSC L ER,Z+ NUI10020 S L SCLGT NUI10030 BSC L ER,- NUI10040 LD L FX100 NUI10050 M L SCINX NUI10060 D L ONE NUI10070 A L FX22 NUI10080 STO L ININX NUI10090 BSC I SCCOM NUI10100 ER BSI L ERTYP NUI10110 DC MSAG7 NUI10120 BSI L ERTYP NUI10130 DC MSAG4 NUI10140 WAIT NUI10150 EXIT NUI10160 *************** NUI10170 * GRDVA SUBROUTINE NUI10180 *************** NUI10190 GRDVA NOP SUBROUTINE TO NUI10200 BSI L SCCOM READ THE GRID NUI10210 LD L SCLOC VALUES FROM THE NUI10220 STO L WKIO&1 DISK DATA AREA NUI10230 LD L FX640 NUI10240 STO L WKIO NUI10250 LIBF DISKN NUI10260 DC /5000 NUI10270 DC WKIO NUI10280 DC ERRS NUI10290 LIBF DISKN NUI10300 DC /1000 NUI10310 DC WKIO NUI10320 DC ERRS NUI10330 LD L ININX NUI10340 A L FX418 NUI10350 STO L DUMY NUI10360 LDX I1 DUMY NUI10370 LDX I2 FX400 NUI10380 LIBF DISKN NUI10390 DC /0000 NUI10400 DC WKIO NUI10410 MDX *-4 NUI10420 LDD L1 WKIO NUI10430 STD L2 IZ-2 NUI10440 MDX 1 -2 NUI10450 MDX 2 -2 NUI10460 MDX *-7 NUI10470 LDX I1 ININX NUI10480 LD L1 WKIO NUI10490 STO L KCOLZ NUI10500 LD L1 WKIO+1 NUI10510 STO L IBZ NUI10520 LD L1 WKIO+2 NUI10530 STO L IEZ NUI10540 BSC I GRDVA NUI10550 *************** NUI10560 * CEFBF SUBROUTINE NUI10570 *************** NUI10580 CEFBF NOP SUBROUTINE TO NUI10590 LD L CRDCD&30 CONVERT AN E-FORMAT NUI10600 S L PLUS TO FLOATING POINT NUI10610 BSC L NXTA,&- NUI10620 LD L CRDCD&30 TEST FOR FORMAT ERRORS NUI10630 S L AMPER NUI10640 BSC L NXTA,&- NUI10650 LD L CRDCD&30 NUI10660 S L MINUS NUI10670 BSC L NXTA,&- NUI10680 LD L CRDCD&30 NUI10690 BSC L ERROR,Z NUI10700 NXTA LD L CRDCD&31 NUI10710 S L PERID NUI10720 BSC L ERROR,Z NUI10730 LD L CRDCD&40 NUI10740 S L LTRE NUI10750 BSC L ERROR,Z NUI10760 LD L CRDCD&41 NUI10770 S L PLUS NUI10780 BSC L NXTB,&- NUI10790 LD L CRDCD&41 NUI10800 S L AMPER NUI10810 BSC L NXTB,&- NUI10820 LD L CRDCD&41 NUI10830 S L MINUS NUI10840 BSC L NXTB,&- NUI10850 LD L CRDCD&41 NUI10860 BSC L ERROR,Z NUI10870 NXTB LD L CRDCD&30 CONVERT HIGH ORDER DIGITS NUI10880 STO L EFORM TO BINARY AND THEN TO NUI10890 LD L ZERO FLOATING POINT NUI10900 STO L EFORM&1 NUI10910 LD L CRDCD&32 NUI10920 STO L EFORM&2 NUI10930 LD L CRDCD&33 NUI10940 STO L EFORM&3 NUI10950 LD L CRDCD&34 NUI10960 STO L EFORM&4 NUI10970 LD L CRDCD&35 NUI10980 STO L EFORM&5 NUI10990 LIBF DCBIN NUI11000 DC EFORM NUI11010 STO L FXMNT NUI11020 LIBF FLOAT NUI11030 LIBF FSTO NUI11040 DC MANT NUI11050 LD L ZERO CONVERT LOW ORDER DIGITS NUI11060 STO L EFORM&1 TO BINARY AND THEN TO NUI11070 LD L CRDCD&36 FLOATING POINT NUI11080 STO L EFORM&2 NUI11090 LD L CRDCD&37 NUI11100 STO L EFORM&3 NUI11110 LD L CRDCD&38 NUI11120 STO L EFORM&4 NUI11130 LD L CRDCD&39 NUI11140 STO L EFORM&5 NUI11150 LIBF DCBIN NUI11160 DC EFORM NUI11170 STO L FXMNR NUI11180 LIBF FLOAT NUI11190 LIBF FSTO NUI11200 DC MANR NUI11210 LD L FXMNT ARE HIGH ORDER DIGITS ZERO NUI11220 BSC L *&4,Z NUI11230 LD L FXMNR NO - CALCULATE NUI11240 BSC L ALTER,&- CHARACTERISTIC NUI11250 LD L CRDCD&41 YES - ARE LOW ORDER DIGITS NUI11260 STO L EFORM ZERO NUI11270 LD L ZERO YES - GO TO ALTER NUI11280 STO L EFORM&1 NO - CONVERT EXPONENT TO NUI11290 STO L EFORM&2 BINARY, COMBINE TWO NUI11300 STO L EFORM&3 FLOATING POINT NUI11310 LD L CRDCD&42 NUMBERS AND ADJUST NUI11320 STO L EFORM&4 CHARACTERISTIC FOR NUI11330 LD L CRDCD&43 EXPONENT OF E-FORMAT NUI11340 STO L EFORM&5 NUI11350 LIBF DCBIN NUI11360 DC EFORM NUI11370 STO L EXPON NUI11380 LIBF FLD NUI11390 DC FTEN NUI11400 LIBF FAXI NUI11410 DC EXPON NUI11420 LIBF FSTO NUI11430 DC EXPT NUI11440 LIBF FLD NUI11450 DC MANR NUI11460 LIBF FMPY NUI11470 DC TENG4 NUI11480 LIBF FADD NUI11490 DC MANT NUI11500 LIBF FMPY NUI11510 DC TENG4 NUI11520 LIBF FMPY NUI11530 DC EXPT NUI11540 LIBF FSTO NUI11550 DC BINFL NUI11560 BSC I CEFBF RETURN NUI11570 ALTER LDD L FZERO SET VALUE OF FLOATING NUI11580 STD L BINFL POINT ZERO NUI11590 BSC I CEFBF RETURN NUI11600 ERROR MDX ALTER TYPE FORMAT ERROR MESSAGE NUI11610 *************** NUI11620 * FFORM SUBROUTINE NUI11630 *************** NUI11640 FFORM NOP SUBROUTINE TO NUI11650 LDX 2 14 CONVERT AN F-FORMAT NUI11660 LD L NMZER CARD CODE NUMBER NUI11670 STO L2 CRDCD+30 TO E-FORMAT NUI11680 MDX 2 -1 SET E-FORMAT AREA TO NUI11690 MDX *-4 ZERO CHARACTERS NUI11700 LD L PLUS STORE PLUS, PERIOD AND NUI11710 STO L CRDCD+30 E IN E-FORMAT WORD NUI11720 LD L PERID NUI11730 STO L CRDCD+31 NUI11740 LD L LTRE NUI11750 STO L CRDCD+40 NUI11760 LD L FX11 NUI11770 STO L FNDPR NUI11780 LDX 1 10 NUI11790 FFRM LD L1 INPTA TSET FOR NUI11800 BSC L FIND1,+- BLANK NUI11810 LD L1 INPTA PLUS SIGN NUI11820 S L PLUS NUI11830 BSC L FIND1,+- NUI11840 LD L1 INPTA AMPERS AND NUI11850 S L AMPER NUI11860 BSC L FIND1,+- NUI11870 LD L1 INPTA MINUS NUI11880 S L MINUS NUI11890 BSC L BCKF,Z NUI11900 LD L MINUS NUI11910 STO L CRDCD+30 NUI11920 BSC L FIND1 NUI11930 BCKF LD L1 INPTA PERIOD NUI11940 S L PERID NUI11950 BSC L BCKG,Z NUI11960 STX L1 FNDPR NUI11970 BCKG MDX 1 -1 LOOP TEST NUI11980 MDX *+1 NUI11990 MDX *+2 NUI12000 BSC L FFRM TEST ANOTHER CHARACTER NUI12010 FIND1 STX L1 FNDEN CALCULATE AND STORE NUI12020 LD L FNDPR EXPONENT NUI12030 S L FNDEN NUI12040 S L ONE NUI12050 LIBF BINDC NUI12060 DC EFORM NUI12070 LD L EFORM NUI12080 STO L CRDCD+41 NUI12090 LD L EFORM+4 NUI12100 STO L CRDCD+42 NUI12110 LD L EFORM+5 NUI12120 STO L CRDCD+43 NUI12130 LD L TEN IS HIGH ORDER CHARACTER NUI12140 S L FNDEN IN RIGHTMOST POSITION NUI12150 BSC L FIND4,+ YES - GO TO FIND4 NUI12160 STO L FFMNB NO - STORE COUNT OF NUI12170 MDX 1 1 CHARACTERS TO BE MOVED NUI12180 LD L1 INPTA LOAD SIGNIFICANT DIGIT NUI12190 STO L CRDCD+32 OF F-FORMAT TO E-FORMAT NUI12200 LD L ONE MANTISSA NUI12210 STO L FFMCT NUI12220 S L FFMNB TEST FOR SINGLE DIGIT IN NUI12230 BSC L ONWD,- F-FORMAT NUI12240 LDX 2 0 YES - GO TO ONWD NUI12250 BCKH MDX 2 1 NO - MOVE DIGIT TO NUI12260 BCKJ MDX 1 1 E-FORMAT MANTISSA NUI12270 MDX L FFMCT,+1 NUI12280 LD L1 INPTA TEST FOR PERIOD NUI12290 S L PERID NUI12300 BSC L BCKI,+- NUI12310 LD L1 INPTA NUI12320 STO L2 CRDCD+32 NUI12330 LD L FFMCT NUI12340 S L FFMNB NUI12350 BSC L BCKH,+Z NUI12360 BSC I FFORM RETURN NUI12370 FIND4 LD L NMZER STORE ZERO IN TENS POSITIONNUI12380 STO L CRDCD+44 OF EXPONENT NUI12390 ONWD BSC I FFORM NUI12400 BCKI LD L FFMCT ARE ALL CHARACTERS MOVED NUI12410 S L FFMNB NUI12420 BSC L BCKJ,+Z NO - GO TO BCKJ NUI12430 BSC I FFORM NUI12440 *************** NUI12450 * ERTYP SUBROUTINE NUI12460 *************** NUI12470 ERTYP NOP SUBROUTINE TO NUI12480 LD I ERTYP WRITE MESSAGES NUI12490 STO L ERTX ON THE CONSOLE NUI12500 MDX L ERTYP,&1 TYPEWRITER NUI12510 LD L ERTX NUI12520 S L ONE NUI12530 STO *&1 NUI12540 LD L 0 NUI12550 STO L ERTX+2 NUI12560 M L ONE NUI12570 D L TWO NUI12580 STO L TYPE NUI12590 LIBF EBPRT NUI12600 DC /0000 NUI12610 ERTX DC 0 NUI12620 DC TYPE+1 NUI12630 DC 0 NUI12640 LIBF WRTY0 NUI12650 DC /2000 NUI12660 DC TYPE NUI12670 LIBF WRTY0 NUI12680 DC /2000 NUI12690 DC CONTL NUI12700 LIBF WRTY0 NUI12710 DC /0000 NUI12720 MDX *-3 NUI12730 BSC I ERTYP NUI12740 *************** NUI12750 * SUBROUTINE OUTPT FOR RESULT OF NUI12760 * NUMERICAL INTEGRATION NUI12770 *************** NUI12780 OUTPT NOP SUBROUTINE TO NUI12790 LIBF FLD TYPE OUT THE NUI12800 DC ACC NUMERICAL NUI12810 CALL FBTD RESULT OF THE NUI12820 DC LDEC INTEGRATION NUI12830 LD L ZERO NUI12840 STO L LDEC+15 NUI12850 LDX 2 9 NUI12860 LDX 1 16 NUI12870 LD L1 LDEC-2 NUI12880 SLA 8 NUI12890 OR L1 LDEC-1 NUI12900 STO L2 ANSWR-1 NUI12910 MDX 2 -1 NUI12920 MDX 1 -2 NUI12930 MDX *-10 NUI12940 LIBF EBPRT NUI12950 DC /0000 NUI12960 DC ANSWR+1 NUI12970 DC ANSWR+1 NUI12980 DC 16 NUI12990 LD L EIGHT NUI13000 STO L ANSWR NUI13010 LIBF WRTY0 NUI13020 DC /2000 NUI13030 DC ANSWR NUI13040 LIBF WRTY0 NUI13050 DC /2000 NUI13060 DC CONTL NUI13070 LIBF WRTY0 NUI13080 DC /0000 NUI13090 MDX *-3 NUI13100 BSC I OUTPT NUI13110 *************** NUI13120 * DEFINE CONSTANTS NUI13130 *************** NUI13140 SCBGN DC 448 BEGIN SECTION OF D.S. AREA NUI13150 SCLGT DC 808 NO. OF SECTIONS D.S. AREA NUI13160 NMZER DC /2000 NUI13170 PLUS DC /80A0 NUI13180 MINUS DC /4000 NUI13190 AMPER DC /8000 NUI13200 PERID DC /8420 NUI13210 LTRE DC /8100 NUI13220 ZERO DC 0 NUI13230 ONE DC 1 NUI13240 TWO DC 2 NUI13250 THREE DC 3 NUI13260 FOUR DC 4 NUI13270 EIGHT DC 8 NUI13280 TEN DC 10 NUI13290 ELEVN DC 11 NUI13300 TWELV DC 12 NUI13310 FXD15 DC 15 NUI13320 FX19 DC 19 NUI13330 FX20 DC 20 NUI13340 FX22 DC 22 NUI13350 FX32 DC 32 NUI13360 FXD80 DC 80 NUI13370 FX100 DC 100 NUI13380 FX272 DC 272 NUI13390 FX280 DC 280 NUI13400 FX400 DC 400 NUI13410 FX402 DC 402 NUI13420 FX418 DC 418 NUI13430 FX420 DC 420 NUI13440 FX422 DC 422 NUI13450 FX640 DC 640 NUI13460 FX808 DC 808 NUI13470 NEG2 DC -2 NUI13480 FX11 DC 11 NUI13490 FZERO DEC 0. NUI13500 FHALF DEC 0.5 NUI13510 FONE DEC 1. NUI13520 FTWO DEC 2. NUI13530 FFOUR DEC 4. NUI13540 FSIX DEC 6. NUI13550 FTEN DEC 10. NUI13560 TENG4 DEC 1.0E-4 NUI13570 ZNIL DEC -1.0E30 NUI13580 TRAIL DEC 9999. NUI13590 *************** NUI13600 * DEFINE ERROR MESSAGE NUI13610 *************** NUI13620 DC 16 NUI13630 MSAG1 EBC .NUINT BEGINNING . NUI13640 DC 16 NUI13650 MSAG3 EBC .NUINT COMPLETED . NUI13660 DC 30 NUI13670 MSAG4 EBC .PUSH START FOR EXIT TO MONITOR. NUI13680 MSAG5 DC 20 DISK ERROR MESSAGE NUI13690 DC /3020 NUI13700 DC /9858 NUI13710 DC /2135 NUI13720 DC /6060 NUI13730 DC /5060 NUI13740 DC /2121 NUI13750 DC /9C34 NUI13760 DC /6070 NUI13770 DC /2074 NUI13780 DC /3C9C NUI13790 DC /3421 NUI13800 DC /7C50 NUI13810 DC /1821 NUI13820 DC /3C74 NUI13830 DC /3021 NUI13840 DC /6034 NUI13850 DC /989C NUI13860 DC /3C60 NUI13870 DC /9C21 NUI13880 DC /8103 NUI13890 DC 30 NUI13900 MSAG7 EBC .UNABLE TO FIND TRAILER RECORD . NUI13910 DC 22 NUI13920 MSAG8 EBC .NAME NOT FOUND ON DISK. NUI13930 DC 28 NUI13940 MSAG9 EBC .OVER THE. NUI13950 MSAG2 EBC . GRID NAMED . NUI13960 DC /4040 NUI13970 DC /4040 NUI13980 EBC . IS . NUI13990 DC 36 NUI14000 MSAGV EBC .THE RESULT OF THE VOLUME. NUI14010 EBC . INTEGRATION. NUI14020 DC 42 NUI14030 MSAGS EBC .THE RESULT OF THE SURFACE . NUI14040 EBC .AREA INTEGRATION. NUI14050 DC 44 NUI14060 MSAGP EBC .THE RESULT OF THE PROJECTED . NUI14070 EBC .AREA INTEGRATION. NUI14080 CONTL DC 1 NUI14090 DC /8103 NUI14100 *************** NUI14110 * ALLOCATE STORAGE NUI14120 *************** NUI14130 LDEC BSS E 16 CONVERSION AREA NUI14140 ANSWR BSS 16 NUI14150 ACC BSS E 2 ACCUMULATED ANSWER NUI14160 KCOLB BSS 1 COLUMN NO. NUI14170 NCOL BSS 1 NUI14180 MXCOL BSS 1 MAX. COLUMN NUI14190 KCOLZ BSS 1 NUI14200 IEZ BSS 1 MIN. ROW NUI14210 IBZ BSS 1 MAX. ROW NUI14220 DDIF BSS E 2 TEMPORARY STORAGE NUI14230 IBB BSS 1 NUI14240 IEB BSS 1 NUI14250 B BSS E 400 COLUMN VECTOR NUI14260 DUM BSS 1 TEMPORARY STORAGE NUI14270 KCOLA BSS 1 NUI14280 IBA BSS 1 NUI14290 IEA BSS 1 NUI14300 A BSS E 400 COLUMN VECTOR NUI14310 IBMIN BSS 1 NUI14320 JBMIN BSS 1 NUI14330 Z1 BSS E 2 STORAGE FOR NUI14340 Z2 BSS E 2 TRIANGLE NUI14350 Z3 BSS E 2 SOLUTION NUI14360 Z4 BSS E 2 NUI14370 IEMAX BSS 1 NUI14380 KEMAX BSS 1 NUI14390 DIF BSS E 2 NUI14400 GRID BSS E 2 DRIG INTERVAL NUI14410 SCALE BSS E 2 SCALE FACTOR NUI14420 ZAP BSS E 2 NUI14430 ZCP BSS E 2 NUI14440 ZBP BSS E 2 NUI14450 IMINV BSS 1 SWITCH NUI14460 ZMINV BSS E 2 MIN Z NUI14470 RESUL BSS E 2 NUI14480 IMAXV BSS 1 SWITCH NUI14490 ZMAXV BSS E 2 MAX. Z NUI14500 IBELO BSS 1 NUI14510 BELOW BSS E 2 BELOW BOUNDARY NUI14520 ZAPBL BSS E 2 NUI14530 IABOV BSS 1 NUI14540 ABOVE BSS E 2 ABOVE BOUNDARY NUI14550 ISARA BSS 1 NUI14560 IPARA BSS 1 NUI14570 ZAZC BSS E 2 NUI14580 ZA BSS E 2 NUI14590 ZC BSS E 2 NUI14600 ZB BSS E 2 NUI14610 BSS E 1 NUI14620 INPTA BSS 81 CARD INPUT BUFFER NUI14630 MXROW BSS 1 MAX NUMBER OF ROWS NUI14640 ICOL BSS 1 COLUMN NUMBER NUI14650 IRBGN BSS 1 BEGINNING ROW NUI14660 IREND BSS 1 ENDING ROW NUI14670 DUMM BSS E 6 TEMP. STORAGE NUI14680 DUMN BSS 1 NUI14690 CRDCD BSS 44 TEMP. STORAGE NUI14700 EFORM BSS 6 NUI14710 FXMNT BSS 1 NUI14720 MANT BSS E 2 NUI14730 FXMNR BSS 1 NUI14740 MANR BSS E 2 NUI14750 EXPON BSS 1 NUI14760 EXPT BSS E 2 NUI14770 BINFL BSS E 2 NUI14780 INDF BSS 1 NUI14790 INDG BSS 1 NUI14800 FNDPR BSS 1 NUI14810 FNDEN BSS 1 NUI14820 FFMNB BSS 1 NUI14830 FFMCT BSS 1 NUI14840 ZRES BSS E 2 NUI14850 ASQ BSS E 2 SIDES OF TRIANGLE NUI14860 BSQ BSS E 2 FOR AREA NUI14870 CSQ BSS E 2 CALCULATION NUI14880 DSQ BSS E 2 NUI14890 ESQ BSS E 2 NUI14900 FSQ BSS E 2 NUI14910 ANAME BSS E 2 DATA SET NAME NUI14920 BSS E 2 NUI14930 BNAME BSS E 4 NUI14940 DUMY BSS E 2 TEMP. STORAGE NUI14950 DIRMX BSS 1 2*IRMAX NUI14960 DREND BSS E 2 NUI14970 THCOL BSS 1 COLUMN NUI14980 IFOUN BSS 1 LOCAT SWITCH NUI14990 ININX BSS 1 DATA SET LOCATION NUI15000 PARAMETERS SCLOC BSS 1 NUI15010 SCINC BSS 1 NUI15020 SCINX BSS 1 NUI15030 SCSTR BSS 1 NUI15040 KOUNT BSS 1 NUI15050 XMIN BSS E 2 DATA SET NUI15060 YMIN BSS E 2 PARAMETERS NUI15070 IZ BSS E 400 COLUMN VECTOR NUI15080 WKIO BSS E 642 DISK I/O BUFFER NUI15090 TYPE BSS 30 TYPEWRITER AREA NUI15100 END GO NUI15110 // DUP NUI15120 *STORE WS UA NUINT NUI15130 // JOB SEG00010 // DUP SEG00020 *DELETE SEGMN SEG00030 // FOR SEG00040 *ONE WORD INTEGERS SEG00050 SUBROUTINE SEGMN SEG00060 DIMENSION ZG(306) SEG00070 COMMON ZG,I1,L,IFCOL,ILCOL,IFROW,ILROW,ISW1,ISW2,ISW3,ISW4,Z1P, SEG00080 1Z2P,Z3P,Z4P,U1P,V1P,U2P,V2P,U3P,V3P,U4P,V4P,IS1,IS2,IS3,IS4,CONVA,SEG00090 2XNIL,YNIL,ZNIL,D1,D2,D3,D4,X1,Y1,X2,Y2,X3,Y3,X4,Y4,X,Y,I,J,ZPMIN, SEG00100 3ZPMAX,U1,V1,U2,V2,U3,V3,U4,V4,CONIN,A,B,C,D,R1,R2,NNN,NNN1,NNN2, SEG00110 4ANSTR,ANEND,ANINT,NLNSW,XQ,MULTR SEG00120 Z1=ZG(I1) SEG00130 Z2=ZG(I1&1) SEG00140 K=I1&L SEG00150 Z3=ZG(K&1) SEG00160 Z4=ZG(K) SEG00170 ZNIL = - 1.*(10.**29) SEG00180 XNIL=ZNIL SEG00190 YNIL=ZNIL SEG00200 C************** SEG00210 C**** FIND ZMIN AND ZMAX, IGNORE SIDES ADJACENT TO A ZNIL. IF MORE THAN SEG00220 C**** ONE ZNIL, RETURN. SEG00230 C************** SEG00240 IF(Z1-ZNIL)2,2,1 SEG00250 2 IF(Z2-ZNIL)4,4,3 SEG00260 4 RETURN SEG00270 1 ZMIN=Z1 SEG00280 ZMAX=Z1 SEG00290 IF(Z2-ZNIL)13,13,5 SEG00300 5 IF(Z2-ZMIN)7,10,8 SEG00310 7 ZMIN=Z2 SEG00320 GO TO 10 SEG00330 8 IF(Z2-ZMAX)10,10,9 SEG00340 9 ZMAX=Z2 SEG00350 10 IF(Z3-ZNIL)22,22,12 SEG00360 3 ZMIN=Z2 SEG00370 ZMAX=Z2 SEG00380 13 IF(Z3-ZNIL) 4,4,11 SEG00390 11 IF(Z4-ZNIL) 4,4,12 SEG00400 12 IF(Z3-ZMIN)14,17,15 SEG00410 14 ZMIN=Z3 SEG00420 GO TO 17 SEG00430 15 IF(Z3-ZMAX)17,17,16 SEG00440 16 ZMAX=Z3 SEG00450 17 IF(Z4-ZNIL)29,29,18 SEG00460 18 IF(Z4-ZMIN)19,29,20 SEG00470 19 ZMIN=Z4 SEG00480 GO TO 29 SEG00490 20 IF(Z4-ZMAX)29,29,21 SEG00500 21 ZMAX=Z4 SEG00510 GO TO 29 SEG00520 22 IF(Z4-ZNIL) 4,4,18 SEG00530 C************** SEG00540 C**** IS A LIST OF CONTOUR VALUES SPECIFIED SEG00550 C************** SEG00560 29 TSTHL = ANEND + .001 SEG00570 TSTLL = ANSTR - .001 SEG00580 IF (ZMIN - TSTLL) 420,425,425 SEG00590 420 ZMIN = ANSTR SEG00600 425 IF (TSTHL - ZMAX) 430,435,435 SEG00610 430 ZMAX = ANEND SEG00620 435 N = ZMIN/CONIN SEG00630 XN=N SEG00640 30 IF(XN*CONIN-ZMIN)31,32,32 SEG00650 31 XN=XN&1. SEG00660 GO TO 30 SEG00670 32 IF (XN*CONIN - ZMAX) 33,4,4 SEG00680 33 CONVA=XN*CONIN SEG00690 C SEG00700 C ******************************************************************SEG00710 C SEG00720 C DETERMINE IF CONTOUR NEEDS ANNOTATION, YES - NNN2=2 NO - NNN2=1 SEG00730 C SEG00740 C ******************************************************************SEG00750 C SEG00760 NNN2 = 1 SEG00770 IF (NNN1 - 2) 410,405,410 SEG00780 405 CALL ANSWT (ZMIN,ZMAX ) SEG00790 410 CONTINUE SEG00800 C************** SEG00810 C**** DETERMINE WHICH SIDES OR VERTICES CONVA PASSES THROUGH. AT THIS SEG00820 C**** POINT IN PROGRAM THERE CAN ONLY BE ONE ZNIL, IF ANY. IGNORE ZNIL SEG00830 C**** IF IT EXISTS, AS WELL AS THE ADJACENT SIDES. SEG00840 C************** SEG00850 U1=1000. SEG00860 V1=1000. SEG00870 U2=1000. SEG00880 V2=1000. SEG00890 U3=1000. SEG00900 V3=1000. SEG00910 U4=1000. SEG00920 V4=1000. SEG00930 ISW1=0 SEG00940 ISW2=0 SEG00950 ISW3=0 SEG00960 ISW4=0 SEG00970 IF(Z1-ZNIL)35,35,34 SEG00980 34 IF(Z2-ZNIL)37,37,36 SEG00990 36 IF(CONVA-Z1)38,38,40 SEG01000 38 IF(CONVA-Z2)43,43,41 SEG01010 41 ISW1=1 SEG01020 U1=0. SEG01030 V1=(CONVA-Z1)/(Z2-Z1) SEG01040 43 IF(Z3-ZNIL)44,44,35 SEG01050 40 IF(CONVA-Z2)41,41,43 SEG01060 35 IF(CONVA-Z3)45,45,47 SEG01070 45 IF(CONVA-Z2)48,48,49 SEG01080 49 ISW2=1 SEG01090 U2=(CONVA-Z2)/(Z3-Z2) SEG01100 V2=1. SEG01110 48 IF(Z4-ZNIL)60,60,37 SEG01120 47 IF(CONVA-Z2)49,49,48 SEG01130 37 IF(CONVA-Z3)51,51,52 SEG01140 51 IF(CONVA-Z4)55,55,53 SEG01150 53 ISW3=1 SEG01160 U3=1. SEG01170 V3=(CONVA-Z4)/(Z3-Z4) SEG01180 55 IF(Z1-ZNIL)60,60,44 SEG01190 52 IF(CONVA-Z4)53,53,55 SEG01200 44 IF(CONVA-Z1)56,56,58 SEG01210 56 IF(CONVA-Z4)60,60,59 SEG01220 59 ISW4=1 SEG01230 U4=(CONVA-Z1)/(Z4-Z1) SEG01240 V4=0. SEG01250 GO TO 60 SEG01260 58 IF(CONVA-Z4)59,59,60 SEG01270 C************** SEG01280 C**** TEST SWITCHES. IF MORE THAN 2 Z'S EQUAL CONVA, FIND NEXT CONVA. IFSEG01290 C**** MORE THAN 2 SIDES INTERSECTED, TEST FOR LOOP. MAKE SURE THERE ARE SEG01300 C**** AT LEAST TWO POINTS IN GRID EQUAL TO CONVA. SEG01310 C************** SEG01320 60 IF((ISW1&ISW2&ISW3&ISW4)-2)31,64,63 SEG01330 C************** SEG01340 C**** IF SIDE 1 IS INTERSECTED, THE POINT WILL BE AN ENTRY. TEST OTHER SEG01350 C**** SIDES AND Z3 AND Z4 FOR EXIT. USING APPROPROATE PRSC SUBROUTINES, SEG01360 C**** FIND THE PREDECESSOR AND THE SUCCESSOR, AND PLOT THE SEGMENT. SEG01370 C************** SEG01380 64 IF(ISW1-1)66,65,66 SEG01390 65 X2=I-1&U1 SEG01400 Y2=J-1&V1 SEG01410 IF(CONVA-Z1)140,141,140 SEG01420 141 CALL PRSC1 SEG01430 X1=X SEG01440 Y1=Y SEG01450 GO TO 135 SEG01460 140 IF(CONVA-Z2)144,145,144 SEG01470 145 CALL PRSC3 SEG01480 X1=X SEG01490 Y1=Y SEG01500 GO TO 68 SEG01510 144 CALL PRSC2 SEG01520 X1=X SEG01530 Y1=Y SEG01540 135 IF(ISW2-1)68,67,68 SEG01550 67 X3=I-1&U2 SEG01560 Y3=J-1&V2 SEG01570 IF(CONVA-Z3)201,204,201 SEG01580 68 IF(ISW3-1)70,69,70 SEG01590 69 X3=I-1&U3 SEG01600 Y3=J-1&V3 SEG01610 IF(CONVA-Z3)148,204,148 SEG01620 148 IF(CONVA-Z4)202,205,202 SEG01630 70 X3=I-1&U4 SEG01640 Y3=J-1&V4 SEG01650 IF(CONVA-Z4)203,205,203 SEG01660 C************** SEG01670 C**** IF SIDE 1 IS NOT INTERSECTED, TEST SIDE 3 FOR INTERSECTION. IF ONESEG01680 C**** EXISTS, TEST SIDES 2 AND 4, AND Z1 AND Z2 FOR EXIT. USING APPRO- SEG01690 C**** PRIATE PRSC SUBROUTINES, FIND PREDECESSOR AND SUCCESSOR, AND PLOT SEG01700 C**** THE SEGMENT. SEG01710 C************** SEG01720 66 IF(ISW3-1)78,77,78 SEG01730 77 X2=I-1&U3 SEG01740 Y2=J-1&V3 SEG01750 IF(CONVA-Z3)159,154,159 SEG01760 154 CALL PRSC5 SEG01770 155 X1=X SEG01780 Y1=Y SEG01790 GO TO 153 SEG01800 159 IF(CONVA-Z4)157,158,157 SEG01810 158 CALL PRSC7 SEG01820 X1=X SEG01830 Y1=Y SEG01840 GO TO 81 SEG01850 157 CALL PRSC6 SEG01860 GO TO 155 SEG01870 153 IF(ISW4-1)81,79,81 SEG01880 79 X3=I-1&U4 SEG01890 Y3=J-1&V4 SEG01900 IF(CONVA-Z1)203,206,203 SEG01910 81 X3=I-1&U2 SEG01920 Y3=J-1&V2 SEG01930 IF(CONVA-Z2)201,207,201 SEG01940 C************** SEG01950 C**** IF SIDES 1 AND 3 ARE NOT INTERSECTED, TEST SIDE Z FOR INTERSECTIONSEG01960 C**** IF ONE EXISTS, TEST SIDE 4 AND Z1 AND Z4 FOR ENTRY. USING APPRO- SEG01970 C**** PROATE PRSC SUBROUTINES, FIND THE PREDECESSOR AND SUCCESSOR, AND SEG01980 C**** PLOT THE SEGMENT. SEG01990 C************** SEG02000 78 X2=I-1&U4 SEG02010 Y2=J-1&V4 SEG02020 X3=I-1&U2 SEG02030 Y3=J-1&V2 SEG02040 IF(CONVA-Z2)161,162,161 SEG02050 162 CALL PRSC8 SEG02060 X1=X SEG02070 Y1=Y SEG02080 GO TO 207 SEG02090 161 IF(CONVA-Z3)163,164,163 SEG02100 164 CALL PRSC8 SEG02110 X1=X SEG02120 Y1=Y SEG02130 GO TO 204 SEG02140 163 IF(CONVA-Z1)168,169,168 SEG02150 169 CALL PRSC1 SEG02160 170 X1=X SEG02170 Y1=Y SEG02180 GO TO 201 SEG02190 168 IF(CONVA-Z4)171,172,171 SEG02200 172 CALL PRSC7 SEG02210 GO TO 170 SEG02220 171 CALL PRSC8 SEG02230 GO TO 170 SEG02240 C************** SEG02250 C**** ALL FOUR SIDES OF GRID ARE INTERSECTED. TEST TO SEE IF LOOP OCCURSSEG02260 C**** CAUSING INTERSECTIONS ON SIDES 1 AND 2 AND THOSE ON SIDES 3 AND 4 SEG02270 C**** TO BE CONNECTED. IF NOT, TEST TO SEE IF LOOP OCCURS CAUSING INTER-SEG02280 C**** SECTIONS ON SIDES 1 AND 4 AND THOSE ON SIDES 2 AND 3 TO BE CON- SEG02290 C**** NECTED. IF NEITHER OF THESE SITUATIONS EXIST, CONNECT THE PAIRS OFSEG02300 C**** POINTS WITH THE SHORTEST DISTANCE BETWEEN THEM. SEG02310 C************** SEG02320 63 IF(CONVA-Z1)125,126,125 SEG02330 126 ISW1=0 SEG02340 ISW4=0 SEG02350 GO TO 64 SEG02360 125 IF(CONVA-Z2)127,128,127 SEG02370 128 ISW1=0 SEG02380 ISW2=0 SEG02390 GO TO 64 SEG02400 127 IF(CONVA-Z3)129,130,129 SEG02410 130 ISW2=0 SEG02420 ISW3=0 SEG02430 GO TO 64 SEG02440 129 IF(CONVA-Z4)131,132,131 SEG02450 132 ISW3=0 SEG02460 ISW4=0 SEG02470 GO TO 64 SEG02480 131 IF(I-IFCOL)185,185,119 SEG02490 119 IF(J-IFROW)185,185,122 SEG02500 122 M=I1-L SEG02510 Z1P=ZG(M-1) SEG02520 Z2P=ZG(M) SEG02530 Z3P=ZG(I1) SEG02540 Z4P=ZG(I1-1) SEG02550 CALL XNTRP SEG02560 IF(IS2-1)185,102,185 SEG02570 102 IF(IS3-1)185,112,185 SEG02580 185 IF(I-(ILCOL-1))186,175,175 SEG02590 186 IF(J-(ILROW-1))101,175,175 SEG02600 101 MM=I1&L SEG02610 Z1P=ZG(MM&1) SEG02620 Z2P=ZG(MM&2) SEG02630 MMM=I1&2*L SEG02640 Z3P=ZG(MMM&2) SEG02650 Z4P=ZG(MMM&1) SEG02660 CALL XNTRP SEG02670 IF(IS1-1)175,104,175 SEG02680 104 IF(IS4-1)175,112,175 SEG02690 175 IF(I-IFCOL)182,182,187 SEG02700 187 IF(J-(ILROW-1))188,182,182 SEG02710 188 M=I1-L SEG02720 Z1P=ZG(M&1) SEG02730 Z2P=ZG(M&2) SEG02740 Z3P=ZG(I1&2) SEG02750 Z4P=ZG(I1&1) SEG02760 CALL XNTRP SEG02770 IF(IS4-1)182,106,182 SEG02780 106 IF(IS3-1)182,111,182 SEG02790 182 IF(I-(ILCOL-1))189,110,110 SEG02800 189 IF(J-IFROW)110,110,183 SEG02810 183 MM=I1&L SEG02820 MMM=I1+2*L SEG02830 Z1P=ZG(MM-1) SEG02840 Z2P=ZG(MM) SEG02850 Z3P=ZG(MMM) SEG02860 Z4P=ZG(MMM-1) SEG02870 CALL XNTRP SEG02880 IF(IS1-1)110,108,110 SEG02890 108 IF(IS2-1)110,111,110 SEG02900 110 CALL DSTNC SEG02910 IF(D1&D3 - D2&D4 )111,112,112 SEG02920 111 X2=I-1&U1 SEG02930 Y2=J-1&V1 SEG02940 X3=I-1&U4 SEG02950 Y3=J-1&V4 SEG02960 CALL PRSC2 SEG02970 X1=X SEG02980 Y1=Y SEG02990 CALL PRSC8 SEG03000 X4=X SEG03010 Y4=Y SEG03020 CALL PLTSG SEG03030 X2=I-1&U3 SEG03040 Y2=J-1&V3 SEG03050 X3=I-1&U2 SEG03060 Y3=J-1&V2 SEG03070 CALL PRSC6 SEG03080 X1=X SEG03090 Y1=Y SEG03100 CALL PRSC4 SEG03110 X4=X SEG03120 Y4=Y SEG03130 CALL PLTSG SEG03140 GO TO 31 SEG03150 112 X2=I-1&U1 SEG03160 Y2=J-1&V1 SEG03170 X3=I-1&U2 SEG03180 Y3=J-1&V2 SEG03190 CALL PRSC2 SEG03200 X1=X SEG03210 Y1=Y SEG03220 CALL PRSC4 SEG03230 X4=X SEG03240 Y4=Y SEG03250 CALL PLTSG SEG03260 X2=I-1&U3 SEG03270 Y2=J-1&V3 SEG03280 X3=I-1&U4 SEG03290 Y3=J-1&V4 SEG03300 CALL PRSC6 SEG03310 X1=X SEG03320 Y1=Y SEG03330 CALL PRSC8 SEG03340 X4=X SEG03350 Y4=Y SEG03360 CALL PLTSG SEG03370 GO TO 31 SEG03380 201 CALL PRSC4 SEG03390 GO TO 300 SEG03400 202 CALL PRSC6 SEG03410 GO TO 300 SEG03420 203 CALL PRSC8 SEG03430 GO TO 300 SEG03440 204 CALL PRSC5 SEG03450 GO TO 300 SEG03460 205 CALL PRSC7 SEG03470 GO TO 300 SEG03480 206 CALL PRSC1 SEG03490 GO TO 300 SEG03500 207 CALL PRSC3 SEG03510 GO TO 300 SEG03520 300 X4=X SEG03530 Y4=Y SEG03540 CALL PLTSG SEG03550 GO TO 31 SEG03560 END SEG03570 // DUP SEG03580 *STORE WS UA SEGMN SEG03590 // JOB MAP00010 // DUP MAP00020 *DELETE MAPAT MAP00030 // ASM MAP00040 *LIST *********************** MAP00050 * A PROGRAM TO ANNOTATE A MAP BY DRAWING WELL MAP00060 * SYMBOLS WITH IDENTIFYING INFORMATION, AN MAP00070 * ANNOTATED BORDER, AND A TITLE. DATA IS USED MAP00080 * FROM CARDS AND A RANDOM DATA SET ON THE DISK. MAP00090 *********************** MAP00100 FC EQU 126 MAP00110 GO STX L3 REG3 SAVE REG 3 MAP00120 LIBF WRTY0 RETURN CARRIAGE MAP00130 DC /2000 MAP00140 DC CONTL MAP00150 BSI L ERTYP TYPE MAPAT BEGINING MAP00160 DC MESS2 MAP00170 LD L REG3 MAP00180 A L B126 MAP00190 STO L FAC ADDRESS OF FLOATING ACC MAP00200 LD L B80 INITIALIZE INPTA TO READ MAP00210 STO L INPTA 80 COLUMNS MAP00220 *************** MAP00230 LIBF CARD0 READ SCALE CARD MAP00240 * LIBF READ0 READ SCALE CARD MAP00250 *************** MAP00260 DC /0 MAP00270 MDX *-3 MAP00280 *************** MAP00290 LIBF CARD0 MAP00300 * LIBF READ0 MAP00310 *************** MAP00320 DC /1000 MAP00330 DC INPTA MAP00340 *************** MAP00350 LIBF CARD0 MAP00360 * LIBF READ0 MAP00370 *************** MAP00380 DC /0 MAP00390 MDX *-3 MAP00400 BSI L FFORM CONVERT XMIN TO F.P. MAP00410 BSI L CEFBF MAP00420 LDD L BINFL MAP00430 STD L XMIN MAP00440 LDX 2 10 CONVERT XMAX TO F.P. MAP00450 LD L2 INPTA+10 MAP00460 STO L2 INPTA MAP00470 MDX 2 -1 MAP00480 MDX *-6 MAP00490 BSI L FFORM MAP00500 BSI L CEFBF MAP00510 LDD L BINFL MAP00520 STD L XMAX MAP00530 LDX 2 10 CONVERT YMIN TO F.P. MAP00540 LD L2 INPTA+20 MAP00550 STO L2 INPTA MAP00560 MDX 2 -1 MAP00570 MDX *-6 MAP00580 BSI L FFORM MAP00590 BSI L CEFBF MAP00600 LDD L BINFL MAP00610 STD L YMIN MAP00620 LDX 2 10 CONVERT YMAX TO F.P. MAP00630 LD L2 INPTA+30 MAP00640 STO L2 INPTA MAP00650 MDX 2 -1 MAP00660 MDX *-6 MAP00670 BSI L FFORM MAP00680 BSI L CEFBF MAP00690 LDD L BINFL MAP00700 STD L YMAX MAP00710 LDX 2 10 CONVERT SCALE TO F.P. MAP00720 LD L2 INPTA+40 MAP00730 STO L2 INPTA MAP00740 MDX 2 -1 MAP00750 MDX *-6 MAP00760 BSI L FFORM MAP00770 BSI L CEFBF MAP00780 LDD L BINFL MAP00790 STD L SCAL MAP00800 LDX 2 10 CONVERT FREQ OF ANNOTATION MAP00810 LD L2 INPTA+60 TO F.P. MAP00820 STO L2 INPTA MAP00830 MDX 2 -1 MAP00840 MDX *-6 MAP00850 BSI L FFORM MAP00860 BSI L CEFBF MAP00870 LDD L BINFL MAP00880 STD L FREQ MAP00890 LD L INPTA+59 CONVERT SHIFT TO MAP00900 S L MINUS BINARY MAP00910 BSC L POS,Z MAP00920 LD L MINUS MAP00930 STO L DUMM MAP00940 MDX *+4 MAP00950 POS LD L PLUS MAP00960 STO L DUMM MAP00970 LD L ZERO MAP00980 STO L DUMM+1 MAP00990 STO L DUMM+2 MAP01000 STO L DUMM+3 MAP01010 STO L DUMM+4 MAP01020 LD L INPTA+60 MAP01030 STO L DUMM+5 MAP01040 LIBF DCBIN MAP01050 DC DUMM MAP01060 STO L SHIFT+26 ARRAY 28 WORDS LONG MAP01070 LIBF SPEED CONVERT SYMBOL TO BE MAP01080 DC /0 PLOTTED TO ALPHA MAP01090 DC INPTA+54 MAP01100 DC SYMBL MAP01110 DC 2 MAP01120 BSI L TLKUP FIND SYMBOL IN TABLE MAP01130 LDX I1 NOOP MAP01140 BSC L NOSTD,+- BR IF SYMBOL IS BLANK MAP01150 BSC L NOALP,Z+ BR IF ALPHA SYMBOL IS USED MAP01160 STX L1 SW2 SET SW2 ON MAP01170 NOALP STX L1 SW01 SET SW1 ON MAP01180 MDX *+2 MAP01190 NOSTD STX L1 SW3 SET SW3 ON MAP01200 LD L B80 READ RECORD ID. CARD MAP01210 STO L INPTA MAP01220 *************** MAP01230 * LIBF READ0 MAP01240 LIBF CARD0 MAP01250 *************** MAP01260 DC /1000 MAP01270 DC INPTA MAP01280 *************** MAP01290 LIBF CARD0 MAP01300 * LIBF READ0 MAP01310 *************** MAP01320 DC /0 MAP01330 MDX *-3 MAP01340 LDX 2 17 MAP01350 LDX 1 80 CONVERT FIELD NUMBERS MAP01360 CNVID LD L PLUS TO BINARY AND STORE MAP01370 STO L DUMM IN ARRAY 'RECID' MAP01380 LD L ZERO MAP01390 STO L DUMM+1 MAP01400 STO L DUMM+2 MAP01410 STO L DUMM+3 MAP01420 LD L1 INPTA-1 MAP01430 STO L DUMM+4 MAP01440 LD L1 INPTA MAP01450 STO L DUMM+5 MAP01460 LIBF DCBIN MAP01470 DC DUMM MAP01480 STO L2 RECID-2 ARRAY 16 WORDS LONG MAP01490 LD L SW1 SW1=0 FIRST TIME THRU MAP01500 BSC L CONT,Z SKIP UNUSED FIELDS MAP01510 LD L2 RECID-2 MAP01520 S L B13 MAP01530 BSC L ERR1,-Z TEST FOR MORE THAN 13 Z MAP01540 STO L INDX MAP01550 MDX I2 INDX MAP01560 M L B5 MAP01570 SLT 16 MAP01580 STO L INDX MAP01590 MDX I1 INDX MAP01600 MDX L SW1,1 SET SW1 TO 1 MAP01610 CONT LD L2 RECID-2 CHANGE FIELD NUMBER MAP01620 S L ONE TO WORD NUMBER MAP01630 SLA 1 MAP01640 STO L2 RECID-2 MAP01650 MDX 2 -1 MAP01660 MDX 1 -5 MAP01670 MDX CNVID MAP01680 LD L RECID+15 MAP01690 BSC L RTITL,+- TEST FOR NO ANNOTATION MAP01700 LDX I1 RECID+15 MAP01710 LDX 2 0 MAP01720 LD L B45 MAP01730 STO L INPTA MAP01740 *************** MAP01750 RDANT LIBF CARD0 READ ANNOTATION CARDS MAP01760 *DANT LIBF READ0 READ ANNOTATION CARDS MAP01770 *************** MAP01780 DC /1000 MAP01790 DC INPTA MAP01800 *************** MAP01810 LIBF CARD0 MAP01820 * LIBF READ0 MAP01830 *************** MAP01840 DC /0 MAP01850 MDX *-3 MAP01860 BSI L FFORM CONVERT HORIZONTAL MAP01870 BSI L CEFBF DISPLACEMENT TO F.P. MAP01880 LIBF FLD CONVERT TO USERS UNITS MAP01890 DC BINFL MAP01900 LIBF FMPY MAP01910 DC SCAL MAP01920 LIBF FSTO MAP01930 DC BINFL MAP01940 LDD L BINFL AND STORE IN ARRAY MAP01950 STD L2 HDISP 'HDISP' MAP01960 LDX 3 10 CONVERT VERTICAL MAP01970 LD L3 INPTA+10 DISPLACEMENT TO F.P. MAP01980 STO L3 INPTA MAP01990 MDX 3 -1 MAP02000 MDX *-6 MAP02010 LDX I3 REG3 MAP02020 BSI L FFORM MAP02030 BSI L CEFBF MAP02040 LIBF FLD CONVERT TO USERS UNITS MAP02050 DC BINFL MAP02060 LIBF FMPY MAP02070 DC SCAL MAP02080 LIBF FSTO MAP02090 DC BINFL MAP02100 LDD L BINFL STORE IN ARRAY 'VDISP' MAP02110 STD L2 VDISP ARRAY 26 WORDS LONG MAP02120 LDX 3 10 CONVERT CHARACTER MAP02130 LD L3 INPTA+20 SIZE TO F.P. MAP02140 STO L3 INPTA STORE IN ARRAY 'CSIZE' MAP02150 MDX 3 -1 MAP02160 MDX *-6 MAP02170 LDX I3 REG3 MAP02180 BSI L FFORM MAP02190 BSI L CEFBF MAP02200 LDD L BINFL MAP02210 STD L2 CSIZE ARRAY 26 WORDS LONG MAP02220 LD L PLUS CONVERT TYPE TO BINARY MAP02230 STO L DUMM AND STORE IN ARRAY MAP02240 LD L ZERO 'TYPE' MAP02250 STO L DUMM+4 MAP02260 LD L INPTA+35 MAP02270 STO L DUMM+5 MAP02280 LIBF DCBIN MAP02290 DC DUMM MAP02300 STO L2 TYPE ARRAY 26 WORDS LONG MAP02310 LD L INPTA+40 CONVERT OFFSET MAP02320 STO L DUMM+5 DIRECTION TO BINARY MAP02330 LIBF DCBIN STORE IN ARRAY 'OFTX' MAP02340 DC DUMM MAP02350 STO L2 OFTX ARRAY 26 WORDS LONG MAP02360 LD L INPTA+44 CONVERT SHIFT TO MAP02370 S L MINUS BINARY AND STORE IN MAP02380 BSC L LPLUS,Z ARRAY 'SHIFT' MAP02390 LD L MINUS MAP02400 STO L DUMM MAP02410 MDX *+4 MAP02420 LPLUS LD L PLUS MAP02430 STO L DUMM MAP02440 LD L INPTA+45 MAP02450 STO L DUMM+5 MAP02460 LIBF DCBIN MAP02470 DC DUMM MAP02480 STO L2 SHIFT ARRAY 28 WORDS LONG MAP02490 MDX 2 2 MAP02500 MDX 1 -1 CHECK FOR MORE ANNOT CARDS MAP02510 MDX RDANT GET NEXT CARD MAP02520 RTITL LD L B80 MAP02530 STO L INPTA MAP02540 *************** MAP02550 LIBF CARD0 MAP02560 * LIBF READ0 MAP02570 *************** MAP02580 DC /1000 MAP02590 DC INPTA MAP02600 *************** MAP02610 LIBF CARD0 MAP02620 * LIBF READ0 MAP02630 *************** MAP02640 DC /0 MAP02650 MDX *-3 MAP02660 LIBF SPEED CONVERT TITLE TO MAP02670 DC /0 PACKED EBCDIC MAP02680 DC INPTA+1 MAP02690 DC EEE+2 MAP02700 DC 80 MAP02710 LIBF FLD CONVERT SCALE FROM MAP02720 DC F1 UNITS PER INCH TO MAP02730 LIBF FDIV INCHES PER UNIT MAP02740 DC SCAL MAP02750 LIBF FSTO MAP02760 DC SCAL MAP02770 CALL SCALF ESTABLISH SCALE MAP02780 DC SCAL AND ORIGIN MAP02790 DC SCAL MAP02800 DC XMIN MAP02810 DC YMIN MAP02820 LD L SHIFT+26 IS BORDER TO BE MAP02830 A L TWO PLOTTED MAP02840 BSC L DISK,+- NO, GO TO DISK MAP02850 BSI L BORDR YES, PLOT BORDER MAP02860 DISK LD L FX300 INITIALIZE DISK I/O MAP02870 STO L DTCNT MAP02880 STO L OFTPY SET SWITCH TO USE MAP02890 LD L SCBGN SPECIFIED OFFSET MAP02900 S L ONE MAP02910 STO L SCCNT MAP02920 RETRN LDX 2 0 MAP02930 STX L2 XR2 MAP02940 LDX 1 1 MAP02950 STX L1 XR1 MAP02960 LD L DTCNT IS A NEW RECORD NEEDED MAP02970 S L FX300 MAP02980 BSC L SAME,+Z MAP02990 MDX L SCCNT,1 MAP03000 LD L SCCNT MAP03010 STO L WKIO+1 MAP03020 LD L FX300 MAP03030 STO L WKIO MAP03040 LIBF DISK0 READ DISK MAP03050 DC /5000 MAP03060 DC WKIO MAP03070 DC ERR MAP03080 LIBF DISK0 MAP03090 DC /1000 MAP03100 DC WKIO MAP03110 DC ERR MAP03120 LIBF DISK0 MAP03130 DC /0000 MAP03140 DC WKIO MAP03150 MDX *-4 MAP03160 LD L TWO MAP03170 STO L DTCNT MAP03180 SAME LDX I1 DTCNT TEST FOR TRAILER RECORD MAP03190 LIBF FLDX MAP03200 DC WKIO MAP03210 LIBF FSUB MAP03220 DC AZNIL MAP03230 LD 3 FC MAP03240 BSC L SAME1,Z MAP03250 LIBF FLD SET Y COORDINATE TO MAP03260 DC NP5 OUTSIDE BORDER MAP03270 LIBF FDIV MAP03280 DC SCAL MAP03290 LIBF FSUB MAP03300 DC FREQ MAP03310 LIBF FADD MAP03320 DC YMIN MAP03330 LIBF FSTO MAP03340 DC YCORA MAP03350 CALL FCHAR PLOT TITLE MAP03360 DC XMIN MAP03370 DC YCORA MAP03380 DC P1 MAP03390 DC P1 MAP03400 DC FZERO MAP03410 LIBF FCHRI MAP03420 DC 10 MAP03430 DC EEE MAP03440 DC 0 MAP03450 CALL FPLOT RETURN PEN TO XMIN,YMIN MAP03460 DC ONE MAP03470 DC XMIN MAP03480 DC YMIN MAP03490 BSI L ERTYP MAP03500 DC MESS4 END OF JOB MESSAGE MAP03510 EXIT END OF JOB MAP03520 SAME1 LD L RECID GET X MAP03530 A L DTCNT MAP03540 STO L RESUL MAP03550 LDX I1 RESUL MAP03560 LDD L1 WKIO MAP03570 STD L XX MAP03580 LIBF FLD CHECK FOR X GREATER MAP03590 DC XX THAN XMAX MAP03600 LIBF FSUB MAP03610 DC XMAX MAP03620 LD I FAC MAP03630 BSC L SKPA,-Z MAP03640 LIBF FLD CHECK FOR X LESS MAP03650 DC XMIN THAN XMIN MAP03660 LIBF FSUB MAP03670 DC XX MAP03680 LD I FAC MAP03690 BSC L SKPA,-Z MAP03700 LD L RECID+1 MAP03710 A L DTCNT MAP03720 STO L RESUL MAP03730 LDX I1 RESUL MAP03740 LDD L1 WKIO MAP03750 STD L YY MAP03760 LIBF FLD CHECK FOR Y GREATER MAP03770 DC YY THAN YMAX MAP03780 LIBF FSUB MAP03790 DC YMAX MAP03800 LD I FAC MAP03810 BSC L SKPA,-Z MAP03820 LIBF FLD CHECK FOR Y LESS MAP03830 DC YMIN THAN YMIN MAP03840 LIBF FSUB MAP03850 DC YY MAP03860 LD I FAC MAP03870 BSC L SKPA,-Z MAP03880 CALL FPLOT MOVE TO X,Y MAP03890 DC NEG2 MAP03900 DC XX MAP03910 DC YY MAP03920 SW01 MDX GETZ NO OP IF STANDARD SYMBOL MAP03930 SW2 MDX ASYMB NO OP IF WELL SYMBOL MAP03940 BSI L PLTWS PLOT WELL SYMBOL MAP03950 MDX GETZ MAP03960 ASYMB BSI L APLOT PLOT ALPHA CHARACTER MAP03970 GETZ LDX I1 XR1 GET Z FIELD FROM DISK REC MAP03980 LDX I2 XR2 MAP03990 LD L RECID+15 TEST FOR NO Z FIELDS MAP04000 BSC L SKPA,+- MAP04010 LD L1 RECID+1 MAP04020 A L DTCNT MAP04030 STO L RESUL MAP04040 LDX I1 RESUL MAP04050 LIBF FLDX STORE Z FIELD MAP04060 DC WKIO MAP04070 LIBF FSTO MAP04080 DC ZZ MAP04090 LIBF FSUB IF Z FIELD IS BLANK MAP04100 DC ZNIL BYPASS ANNOTATION MAP04110 LD 3 FC MAP04120 BSC L BUMP,+- MAP04130 LD L2 TYPE TEST ANNOTATION FOR MAP04140 BSC L ALPHA,Z ALPHA OR NUMERIC MAP04150 BSI L ANOTA MAP04160 DC ZZ MAP04170 BUMP MDX L XR2,2 BUMP INDEXES MAP04180 MDX L XR1,1 MAP04190 LD L XR1 TEST TO SEE IF LAST MAP04200 S L RECID+15 PLOT (PER WELL) HAS MAP04210 BSC L GETZ,+ BEEN DONE MAP04220 SKPA MDX L DTCNT,30 MAP04230 BSC L RETRN MAP04240 ALPHA S L TWO TEST FOR TYPE TWO MAP04250 BSC L ALPH1,Z BR IF NOT MAP04260 SW3 MDX BUMP BR IF STANDARD SYMBOL MAP04270 LD L ZZ PUT SYMBOL FROM DISK MAP04280 STO L SYMBL RECORD IN SYMBL MAP04290 BSI L TLKUP GET ADDRESS OF SYMBOL MAP04300 BSC L BUMP,+- BR IF BLANK MAP04310 BSC L ALPH2,+ BR IF ALPHA CHARACTER MAP04320 CALL FPLOT MOVE PEN TO X,Y MAP04330 DC NEG2 MAP04340 DC XX MAP04350 DC YY MAP04360 BSI L PLTWS PLOT WELL SYMBOL MAP04370 MDX BUMP MAP04380 ALPH2 BSI L APLOT PLOT ALPHA CHARACTER MAP04390 MDX BUMP MAP04400 ALPH1 LD L THREE MAP04410 STO L LDECA-1 MAP04420 LD L ZERO MAP04430 STO L LDECA MAP04440 LD L ZZ MAP04450 STO L LDECA+1 MAP04460 LD L ZZ+1 MAP04470 STO L LDECA+2 MAP04480 LD L FOUR MAP04490 STO L NMBER MAP04500 BSI L OFFST MAP04510 LIBF FCHRI MAP04520 DC 10 MAP04530 DC LDECA-1 MAP04540 DC 0 MAP04550 MDX BUMP MAP04560 ************************* MAP04570 * SUBROUTINE CEFBF * MAP04580 * CONVERTS E-FORMAT * MAP04590 * CARD CODE TO INTERNAL * MAP04600 * BINARY NOTATION * MAP04610 ************************* MAP04620 CEFBF NOP MAP04630 LD L CRDCD+30 TEST FOR FORMAT ERRORS MAP04640 S L PLUS MAP04650 BSC L NXTA,+- MAP04660 LD L CRDCD+30 MAP04670 S L AMPER MAP04680 BSC L NXTA,+- MAP04690 LD L CRDCD+30 MAP04700 S L MINUS MAP04710 BSC L NXTA,+- MAP04720 LD L CRDCD+30 MAP04730 BSC L ERROR,Z MAP04740 NXTA LD L CRDCD+31 MAP04750 S L PERID MAP04760 BSC L ERROR,Z MAP04770 LD L CRDCD+40 MAP04780 S L LTRE MAP04790 BSC L ERROR,Z MAP04800 LD L CRDCD+41 MAP04810 S L PLUS MAP04820 BSC L NXTB,+- MAP04830 LD L CRDCD+41 MAP04840 S L AMPER MAP04850 BSC L NXTB,+- MAP04860 LD L CRDCD+41 MAP04870 S L MINUS MAP04880 BSC L NXTB,+- MAP04890 LD L CRDCD+41 MAP04900 BSC L ERROR,Z MAP04910 NXTB LD L CRDCD+30 CONVERT HIGH ORDER DIGITS MAP04920 STO L EFORM TO BINARY AND THEN TO MAP04930 LD L ZERO FLOATING POINT MAP04940 STO L EFORM+1 MAP04950 LD L CRDCD+32 MAP04960 STO L EFORM+2 MAP04970 LD L CRDCD+33 MAP04980 STO L EFORM+3 MAP04990 LD L CRDCD+34 MAP05000 STO L EFORM+4 MAP05010 LD L CRDCD+35 MAP05020 STO L EFORM+5 MAP05030 LIBF DCBIN MAP05040 DC EFORM MAP05050 STO L FXMNT MAP05060 LIBF FLOAT MAP05070 LIBF FSTO MAP05080 DC MANT MAP05090 LD L ZERO CONVERT LOW ORDER DIGITS TOMAP05100 STO L EFORM+1 BINARY AND THEN TO MAP05110 LD L CRDCD+36 FLOATING POINT MAP05120 STO L EFORM+2 MAP05130 LD L CRDCD+37 MAP05140 STO L EFORM+3 MAP05150 LD L CRDCD+38 MAP05160 STO L EFORM+4 MAP05170 LD L CRDCD+39 MAP05180 STO L EFORM+5 MAP05190 LIBF DCBIN MAP05200 DC EFORM MAP05210 STO L FXMNR MAP05220 LIBF FLOAT MAP05230 LIBF FSTO MAP05240 DC MANR MAP05250 LD L FXMNT ARE HIGH ORDER DIGITS ZERO MAP05260 BSC L *+4,Z NO - CALC CHARACTERISTIC MAP05270 LD L FXMNR YES - ARE LOW ORDER DIGITS MAP05280 BSC L ALTER,+- ZERO MAP05290 LD L CRDCD+41 YES - GO TO ALTER MAP05300 STO L EFORM NO - CONVERT EXPONENT TO MAP05310 LD L ZERO BINARY, COMBINE TWO MAP05320 STO L EFORM+1 FLOATING POINT MAP05330 STO L EFORM+2 NUMBERS AND ADJUST MAP05340 STO L EFORM+3 CHARACTERISTIC FO MAP05350 LD L CRDCD+42 EXPONENT OF E-FORMAT MAP05360 STO L EFORM+4 MAP05370 LD L CRDCD+43 MAP05380 STO L EFORM+5 MAP05390 LIBF DCBIN MAP05400 DC EFORM MAP05410 STO L EXPON MAP05420 LIBF FLD MAP05430 DC FTEN MAP05440 LIBF FAXI MAP05450 DC EXPON MAP05460 LIBF FSTO MAP05470 DC EXPT MAP05480 LIBF FLD MAP05490 DC MANR MAP05500 LIBF FMPY MAP05510 DC TENG4 MAP05520 LIBF FADD MAP05530 DC MANT MAP05540 LIBF FMPY MAP05550 DC TENG4 MAP05560 LIBF FMPY MAP05570 DC EXPT MAP05580 LIBF FSTO MAP05590 DC BINFL MAP05600 BSC I CEFBF RETURN MAP05610 ALTER LDD L FZERO SET VALUE TO FLOATING MAP05620 STD L BINFL POINT ZERO MAP05630 BSC I CEFBF RETURN MAP05640 ERROR MDX ALTER FORMAT ERROR SET VALUE TO 0MAP05650 ******************************* MAP05660 * SUBROUTINE FFORM * MAP05670 * CONVERTS F-FORMAT CARD CODE MAP05680 * TO E-FORMAT MAP05690 ****************************** MAP05700 FFORM NOP MAP05710 STX L1 REG1 SAVE IR1 MAP05720 STX L2 REG2 SAVE IR2 MAP05730 LDX 2 14 SET E-FORMAT AREA TO MAP05740 LD L NMZER ZERO CHARACTERS MAP05750 STO L2 CRDCD+30 MAP05760 MDX 2 -1 MAP05770 MDX *-4 MAP05780 LD L PLUS STORE PLUS, PERIOD AND MAP05790 STO L CRDCD+30 E IN E-FORMAT WORD MAP05800 LD L PERID MAP05810 STO L CRDCD+31 MAP05820 LD L LTRE MAP05830 STO L CRDCD+40 MAP05840 LD L FX11 MAP05850 STO L FNDPR MAP05860 LDX 1 10 MAP05870 FFRM LD L1 INPTA TEST FOR MAP05880 BSC L FIND1,+- BLANK MAP05890 S L PLUS PLUS SIGN MAP05900 BSC L FIND1,+- MAP05910 LD L1 INPTA AMPERSAND MAP05920 S L AMPER MAP05930 BSC L FIND1,+- MAP05940 LD L1 INPTA MINUS MAP05950 S L MINUS MAP05960 BSC L BCKF,Z MAP05970 LD L MINUS MAP05980 STO L CRDCD+30 MAP05990 FIND1 LD L CDZRO MAP06000 STO L1 INPTA MAP06010 MDX 1 -1 MAP06020 MDX FIND2 MAP06030 MDX FIND2 MAP06040 BCKF LD L1 INPTA PERIOD MAP06050 S L PERID MAP06060 BSC L BCKG,Z MAP06070 STX L1 FNDPR MAP06080 BCKG MDX 1 -1 LOOP TEST MAP06090 MDX *+1 MAP06100 MDX *+2 MAP06110 BSC L FFRM TEST ANOTHER CHARACTER MAP06120 FIND2 STX L1 FNDEN CALCULATE AND STORE MAP06130 LD L FNDPR EXPONENT MAP06140 S L FNDEN MAP06150 S L ONE MAP06160 LIBF BINDC MAP06170 DC EFORM MAP06180 LD L EFORM MAP06190 STO L CRDCD+41 MAP06200 LD L EFORM+4 MAP06210 STO L CRDCD+42 MAP06220 LD L EFORM+5 MAP06230 STO L CRDCD+43 MAP06240 LD L TEN IS HIGH ORDER CHARACTER MAP06250 S L FNDEN IN RIGHTMOST POSITION MAP06260 BSC L FIND4,+ YES - GO TO FIND4 MAP06270 STO L FFMNB NO - STORE COUNT OF MAP06280 MDX 1 1 CHARACTERS TO BE MOVED MAP06290 LD L1 INPTA LOAD SIGNIFICANT DIGIT MAP06300 STO L CRDCD+32 OF F-FORMAT TO E-FORMAT MAP06310 LD L ONE MANTISSA MAP06320 STO L FFMCT MAP06330 S L FFMNB TEST FOR SINGLE DIGIT IN MAP06340 BSC L ONWD,- F-FORMAT MAP06350 LDX 2 0 YES - GO TO ONWD MAP06360 BCKH MDX 2 1 NO - MOVE DIGITS TO MAP06370 BCKJ MDX 1 1 E-FORMAT MANTISSA MAP06380 MDX L FFMCT,+1 MAP06390 LD L1 INPTA TEST FOR PERIOD MAP06400 S L PERID MAP06410 BSC L BCKI,+- MAP06420 LD L1 INPTA MAP06430 STO L2 CRDCD+32 MAP06440 LD L FFMCT MAP06450 S L FFMNB MAP06460 BSC L BCKH,+Z MAP06470 MDX ONWD MAP06480 FIND4 LD L NMZER STORE ZERO IN TENS POSITIONMAP06490 STO L CRDCD+43 OF EXPONENT MAP06500 ONWD LDX I1 REG1 RESTORE IR1 MAP06510 LDX I2 REG2 RESTORE IR2 MAP06520 BSC I FFORM RETURN MAP06530 BCKI LD L FFMCT ARE ALL CHARACTERS MOVED MAP06540 S L FFMNB MAP06550 BSC L BCKJ,+Z NO - GO TO BCKJ MAP06560 MDX ONWD YES - GO TO RETURN MAP06570 *************** MAP06580 * BORDR SUBROUTINE MAP06590 *************** MAP06600 BORDR NOP MAP06610 LD L FREQ TEST FOR BORDER ANNOTATION MAP06620 BSC L BERR,+ FREQUENCY GREATER THAN 0 MAP06630 LIBF FLD MAP06640 DC XMAX MAP06650 LIBF FSUB MAP06660 DC XMIN MAP06670 LD I FAC MAP06680 BSC L ERR3,+ XMAX LESS THAN XMIN MAP06690 LIBF FDIV MAP06700 DC FREQ MAP06710 LIBF IFIX MAP06720 A L TWO MAP06730 STO L NXDIV MAP06740 A L ONE MAP06750 STO L XINC MAP06760 LIBF FLD MAP06770 DC YMAX MAP06780 LIBF FSUB MAP06790 DC YMIN MAP06800 LD I FAC MAP06810 BSC L ERR4,+ YMAX LESS THAN YMIN MAP06820 LIBF FDIV MAP06830 DC FREQ MAP06840 LIBF IFIX CALCULATE NUMBER OF MAP06850 A L TWO DIVISIONS OF Y BORDER MAP06860 STO L NYDIV MAP06870 A L ONE MAP06880 STO L YINC MAP06890 LIBF FLD MAP06900 DC NTENH MAP06910 LIBF FDIV MAP06920 DC SCAL MAP06930 LIBF FSTO MAP06940 DC HDISP+26 MAP06950 CALL FPLOT MOVE TO XMIN,YMIN MAP06960 DC TWO MAP06970 DC XMIN MAP06980 DC YMIN MAP06990 CALL POINT DRAW + MAP07000 DC ZERO MAP07010 LIBF FLD PREPARE TO DRAW BORDER MAP07020 DC XMIN MAP07030 LIBF FSUB MAP07040 DC FREQ MAP07050 LIBF FSTO MAP07060 DC NXINC MAP07070 LIBF FSTO MAP07080 DC XCORA MAP07090 LIBF FLD MAP07100 DC YMIN MAP07110 LIBF FSUB MAP07120 DC FREQ MAP07130 LIBF FSTO MAP07140 DC NYINC MAP07150 LIBF FSTO MAP07160 DC YCORA MAP07170 CALL FGRID DRAW BORDER (+X) MAP07180 DC ZERO MAP07190 DC NXINC MAP07200 DC NYINC MAP07210 DC FREQ MAP07220 DC XINC MAP07230 CALL FPLOT MOVE TO XMAX,YMIN MAP07240 DC NEG2 MAP07250 DC XMAX MAP07260 DC YMIN MAP07270 CALL POINT DRAW + MAP07280 DC ZERO MAP07290 LD L NXDIV MAP07300 LIBF FLOAT MAP07310 LIBF FMPY MAP07320 DC FREQ MAP07330 LIBF FADD MAP07340 DC XMIN MAP07350 LIBF FSTO MAP07360 DC NXINC MAP07370 CALL FGRID DRAW BORDER (+Y) MAP07380 DC ONE MAP07390 DC NXINC MAP07400 DC NYINC MAP07410 DC FREQ MAP07420 DC YINC MAP07430 CALL FPLOT MOVE TO XMAX,YMAX MAP07440 DC NEG2 MAP07450 DC XMAX MAP07460 DC YMAX MAP07470 CALL POINT DRAW + MAP07480 DC ZERO MAP07490 LD L NYDIV MAP07500 LIBF FLOAT MAP07510 LIBF FMPY MAP07520 DC FREQ MAP07530 LIBF FADD MAP07540 DC YMIN MAP07550 LIBF FSTO MAP07560 DC NYINC MAP07570 CALL FGRID DRAW BORDER (-X) MAP07580 DC TWO MAP07590 DC NXINC MAP07600 DC NYINC MAP07610 DC FREQ MAP07620 DC XINC MAP07630 CALL FPLOT MOVE TO XMIN,YMAX MAP07640 DC NEG2 MAP07650 DC XMIN MAP07660 DC YMAX MAP07670 CALL POINT DRAW + MAP07680 DC ZERO MAP07690 LIBF FLD MAP07700 DC XMIN MAP07710 LIBF FSUB MAP07720 DC FREQ MAP07730 LIBF FSTO MAP07740 DC NXINC MAP07750 CALL FGRID DRAW BORDER (-Y) MAP07760 DC THREE MAP07770 DC NXINC MAP07780 DC NYINC MAP07790 DC FREQ MAP07800 DC YINC MAP07810 LD L SHIFT+26 TEST FOR BORDER MAP07820 A L THREE ANNOTATION MAP07830 BSC L DISK,+- MAP07840 LDX I1 NXDIV MAP07850 LDD L XMIN MAP07860 STD L XX MAP07870 LDD L YCORA MAP07880 STD L YY MAP07890 ANT1 STX L1 REG1 ANNOTATE X BORDER MAP07900 LDX 2 26 MAP07910 STX L2 XR2 MAP07920 BSI L ANOTA MAP07930 DC XX MAP07940 LIBF FLD MAP07950 DC XX MAP07960 LIBF FADD MAP07970 DC FREQ MAP07980 LIBF FSTO MAP07990 DC XX MAP08000 LDX I1 REG1 MAP08010 MDX 1 -1 MAP08020 MDX ANT1 MAP08030 LD L ONE SET UP PARAMETERS TO MAP08040 STO L OFTPY ANNOTATE Y BORDER MAP08050 LDX I1 NYDIV MAP08060 LDD L YMIN MAP08070 STD L YY MAP08080 LDD L XCORA MAP08090 STD L XX MAP08100 MDX L OFTX+26,2 MAP08110 ANT2 STX L1 REG1 ANNOTATE Y BORDER MAP08120 LDX 2 26 MAP08130 STX L2 XR2 MAP08140 BSI L ANOTA MAP08150 DC YY MAP08160 LIBF FLD MAP08170 DC YY MAP08180 LIBF FADD MAP08190 DC FREQ MAP08200 LIBF FSTO MAP08210 DC YY MAP08220 LDX I1 REG1 MAP08230 MDX 1 -1 MAP08240 MDX ANT2 MAP08250 BSC I BORDR MAP08260 *************************************************** MAP08270 * THE ANNOTA SUBROUTINE ANNOTATES FLOATING POINT MAP08280 * FIELDS WITH THE DESIRED NUMBER OF DECIMAL MAP08290 * PLACES. ANNOTA IS CALLED WITH THE ADDRESS OF MAP08300 * THE NUMBER. 'XR2' CONTAINS THE INDEX OF THE Z MAP08310 * FIELD ARRAYS (CSIZE,VDISP,HDISP). MAP08320 *************************************************** MAP08330 ANOTA NOP MAP08340 LD I ANOTA GET ADDRESS OF Z FIELD MAP08350 STO L ADDR MAP08360 MDX L ANOTA,1 MAP08370 LIBF FLD MAP08380 ADDR DC 0 LOAD Z FIELD MAP08390 LIBF FSTO ROUND OFF NUMBER MAP08400 DC RNDF MAP08410 LIBF FDIV MAP08420 DC F100K MAP08430 LIBF FADD MAP08440 DC RNDF MAP08450 CALL FBTD CONVERT F.&. TO E FORMAT MAP08460 DC LDEC MAP08470 LDX 2 3 MAP08480 ADDR1 LD L2 LDEC+11 MAP08490 SLA 8 MAP08500 STO L2 LDECM-1 MAP08510 MDX 2 -1 MAP08520 MDX ADDR1 MAP08530 LIBF SPEED CONVERT EXPONENT TO CARD C MAP08540 DC /0011 MAP08550 DC LDECM MAP08560 DC LDECA+3 MAP08570 DC 3 MAP08580 LD L LDECA+3 MAP08590 STO L LDECA MAP08600 LDX 2 3 MAP08610 LD L ZERO MAP08620 ADDR2 STO L2 LDECA MAP08630 MDX 2 -1 MAP08640 MDX ADDR2 MAP08650 LIBF DCBIN CONVERT EXP TO BINARY MAP08660 DC LDECA MAP08670 STO L EXP MAP08680 LDX I2 XR2 GET NUMBER OF DECIMAL MAP08690 A L2 SHIFT PLACES DESIRED FROM ARRAY MAP08700 A L THREE 'SHIFT' AND CALCULATE NO. MAP08710 STO L NMBER OF CHARACTERS TO BE PLOTTE MAP08720 S L TWO TEST FOR NO DIGITS TO BE MAP08730 BSC L RT,Z+ PLOTTED MAP08740 S L2 SHIFT MAP08750 A L ONE MAP08760 STO L POSIT POSITION OF DECIMAL PT. MAP08770 LDX 1 30 INITIALIZE OUTPUT AREA MAP08780 LD L BLANK MAP08790 ADDR7 STO L1 LDECA-1 MAP08800 MDX 1 -1 MAP08810 MDX ADDR7 MAP08820 LDX I1 POSIT MAP08830 LD L EBPER INSERT PERIOD IN OUTPUT MAP08840 STO L1 LDECA MAP08850 LD L LDEC MAP08860 S L EPLUS IF PLUS SET SIGN TO BLANK MAP08870 BSC L ADDR9,Z MAP08880 LD L BLANK MAP08890 MDX *+2 MAP08900 ADDR9 LD L LDEC MAP08910 STO L LDECA INSERT SIGN IN OUTPUT MAP08920 LD L LDEC+1 MAP08930 STO L LDEC+2 MAP08940 LDX 1 9 MAP08950 LDX 2 1 MAP08960 ADDR3 LD L2 LDECA INSERT CHARACTERS TO LEFT MAP08970 S L EBPER OF DECIMAL MAP08980 BSC L FWD,+- MAP08990 LD L2 LDEC+1 MAP09000 STO L2 LDECA MAP09010 MDX 2 +1 MAP09020 MDX 1 -1 MAP09030 MDX ADDR3 MAP09040 MDX ADDR4 MAP09050 RT LD L ADZ MAP09060 STO ADDR MAP09070 MDX ADDR-1 MAP09080 FWD MDX 2 +1 MAP09090 LD L2 LDEC INSERT CHARACTERS TO MAP09100 STO L2 LDECA RIGHT OF DECIMAL MAP09110 MDX 1 -1 MAP09120 MDX FWD MAP09130 ADDR4 LDX I1 NMBER MAP09140 LDX 2 1 MAP09150 LDX 3 1 MAP09160 ADDR5 LD L2 LDECA-1 MAP09170 SLA 8 PACK CHARACTERS MAP09180 OR L2 LDECA MAP09190 STO L3 LDECA MAP09200 MDX 3 1 MAP09210 MDX 2 2 MAP09220 MDX 1 -1 MAP09230 MDX ADDR5 MAP09240 LD L NMBER MAP09250 BSC L ADDR6,E MAP09260 MDX ADDR8 MAP09270 ADDR6 A L ONE IF NUMBER OF CHARACTERS MAP09280 STO L NUMM NOT EVEN RIGHT HALF OF LAS MAP09290 SRA 1 WORD MUST BE SET TO BLANK MAP09300 STO L NUM MAP09310 LDX I3 NUM MAP09320 LD L3 LDECA MAP09330 AND L MASK MAP09340 OR L BLANK MAP09350 STO L3 LDECA MAP09360 LD L NUMM MAP09370 ADDR8 SRA 1 SET NUMBER OF WORDS TO BE MAP09380 A L ONE PLOTTED MAP09390 STO L LDECA-1 MAP09400 LD L ZERO MAP09410 STO L LDECA MAP09420 LDX I3 REG3 MAP09430 BSI L OFFST CALCULATE OFFSET MAP09440 LIBF FCHRI PLOT Z FIELD MAP09450 DC 10 MAP09460 DC LDECA-1 MAP09470 DC 0 MAP09480 BSC I ANOTA RETURN MAP09490 *************************************************** MAP09500 * OFFST ROUTINE COMPUTES DIRECTION AND DISTANCE MAP09510 * OF Z FIELD DISPLACEMENT AND MOVES PEN TO MAP09520 * STARTING POSITION MAP09530 *************************************************** MAP09540 OFFST NOP MAP09550 LDX I2 XR2 MAP09560 LDD L2 CSIZE GET CHARACTER SIZE MAP09570 STD L XSIZE MAP09580 LDD L2 OFTX GET OFFSET DIRECTION MAP09590 STD L OFTPX MAP09600 LDD L2 HDISP GET HORIZON DISPLACEMENT MAP09610 STD L XOFF MAP09620 LDD L2 VDISP GET VERTICAL DISPLACEMENT MAP09630 STD L YOFF MAP09640 LD L NMBER NUMBER OF PLACES TO PLOT MAP09650 LIBF FLOAT MAP09660 LIBF FMPY MAP09670 DC XSIZE MAP09680 LIBF FDIV MAP09690 DC SCAL MAP09700 LIBF FSTO MAP09710 DC CHLGT TOTAL LENGTH OF FIELD MAP09720 LD L OFTPX MAP09730 BSC L OFF0,+- CENTERED MAP09740 S L ONE MAP09750 BSC L OFF1,+- LEFT CORNER MAP09760 LIBF FLD CALCULATE OFFSET RELATIVE MAP09770 DC XX TO RIGHT CORNER OF FIELD MAP09780 LIBF FADD MAP09790 DC XOFF MAP09800 LIBF FSUB MAP09810 DC CHLGT MAP09820 LIBF FSTO MAP09830 DC XN MAP09840 MDX OFF4 MAP09850 OFF0 LIBF FLD CALCULATE OFFSET RELATIVE MAP09860 DC CHLGT TO CENTER OF FIELD MAP09870 LIBF FDIV MAP09880 DC FTWO MAP09890 LIBF FSBR MAP09900 DC XX MAP09910 LIBF FADD MAP09920 DC XOFF MAP09930 LIBF FSTO MAP09940 DC XN MAP09950 MDX OFF4 MAP09960 OFF1 LIBF FLD CALCULATE OFFSET RELATIVE MAP09970 DC XX TO LEFT CORNER OF FIELD MAP09980 LIBF FADD MAP09990 DC XOFF MAP10000 LIBF FSTO MAP10010 DC XN MAP10020 OFF4 LD L OFTPY CALCULATE VERTICAL OFFSET MAP10030 BSC L OFF5,Z MAP10040 LIBF FLD FOR X BORDER ANNOTATION MAP10050 DC XSIZE MAP10060 LIBF FMPY MAP10070 DC FLT3 MAP10080 LIBF FDIV MAP10090 DC SCAL MAP10100 LIBF FSBR MAP10110 DC YY MAP10120 LIBF FSTO MAP10130 DC YN MAP10140 MDX OFF6 MAP10150 OFF5 LIBF FLD FOR Y BORDER ANNOTATION MAP10160 DC YY AND POINTS MAP10170 LIBF FADD MAP10180 DC YOFF MAP10190 LIBF FSTO MAP10200 DC YN MAP10210 OFF6 CALL FCHAR MOVE PEN TO STARTING MAP10220 DC XN POSITION AND INITIALIZE MAP10230 DC YN FCHRI ROUTINE MAP10240 DC XSIZE MAP10250 DC XSIZE MAP10260 DC FZERO MAP10270 BSC I OFFST RETURN MAP10280 ERR NOP MAP10290 WAIT MAP10300 BSC I ERR MAP10310 *********************** MAP10320 * THE FOLLOWING ROUTINE PLOTS A WELL SYMBOL MAP10330 * THE PEN IS LEFT IN AN UP POSITION MAP10340 *********************** MAP10350 PLTWS NOP MAP10360 STX L1 XR11 SAVE XR1 MAP10370 STX L2 XR22 SAVE XR2 MAP10380 LDX I2 SYMAD ADDR OF SYMBOL IN XR2 MAP10390 LD L2 0 GET WORD COUNT MAP10400 STO L WORK MAP10410 LDX I1 WORK PUT WORD COUNT IN XR1 MAP10420 PLTW1 MDX 2 +1 SET X2 TO NEXT WORD MAP10430 LD L2 0 LOAD WORD OF DATA MAP10440 SRT 12 SHIFT TO 1ST HEX DIGIT MAP10450 AND L ANDOT BLANK 1ST 12 BITS MAP10460 STO L DIG1 MAP10470 LIBF PLOTX PLOT DIGIT IN ACCUM MAP10480 DIG1 DC 0 MAP10490 SLT 4 SHIFT IN NEXT DIGIT MAP10500 AND L ANDOT BLANK 1ST 12 BITS MAP10510 STO L DIG2 MAP10520 LIBF PLOTX PLOT 2ND DIGIT MAP10530 DIG2 DC 0 MAP10540 SLT 4 SHIFT IN 3RD DIGIT MAP10550 AND L ANDOT BLANK 1ST 12 BITS MAP10560 STO L DIG3 MAP10570 LIBF PLOTX PLOT 3RD DIGIT MAP10580 DIG3 DC 0 MAP10590 SLT 4 SHIFT IN 4\' DIGIT MAP10600 AND L ANDOT BLANK 1ST 12 BITS MAP10610 STO L DIG4 MAP10620 LIBF PLOTX PLOT 4TH DIGIT MAP10630 DIG4 DC 0 MAP10640 MDX 1 -1 DECREMENT WORD COUNT MAP10650 MDX PLTW1 PLOT NEXT WORD MAP10660 LDX I1 XR11 RESTORE INDEX REGS MAP10670 LDX I2 XR22 MAP10680 BSC I PLTWS RETURN MAP10690 *********************** MAP10700 * THIS ROUTINE PLOTS A .1 INCH SQUARE ALPHA CHARACT MAP10710 * CENTERED AT X,Y MAP10720 *********************** MAP10730 APLOT DC 0 MAP10740 LIBF FLD CONVERT .05 INCHES TO MAP10750 DC F05 PROPER SCALE AND STORE MAP10760 LIBF FDIV IN P05 MAP10770 DC SCAL MAP10780 LIBF FSTO MAP10790 DC P05 MAP10800 LIBF FLD SET STARTING X VALUE TO MAP10810 DC XX X-.05 MAP10820 LIBF FSUB MAP10830 DC P05 MAP10840 LIBF FSTO MAP10850 DC PXX MAP10860 LIBF FLD MAP10870 DC YY SEY STARTING Y VALUE TO MAP10880 LIBF FSUB Y-.05 MAP10890 DC P05 MAP10900 LIBF FSTO MAP10910 DC PYY MAP10920 CALL FCHAR SET SCALE AND STARTING MAP10930 DC PXX MAP10940 DC PYY MAP10950 DC P1 MAP10960 DC P1 MAP10970 DC FZERO MAP10980 LIBF FCHRI PLOT ALPHA CHARACTER MAP10990 DC 1 MAP11000 DC WDCNT MAP11010 DC 0 MAP11020 BSC I APLOT MAP11030 *********************** MAP11040 * TABLE LOOK UP ROUTINE TO FIND WELL SYMBOL. MAP11050 * SYMBOL TO BE FOUND IS IN 'SYMBL'. MAP11060 * ADDRESS OF WELL SYMBOL TO BE PLOTTED IS PUT IN MAP11070 * SYMAD. MAP11080 * IF SYMBOL IS BLANK SYMAD IS SET TO ZERO. MAP11090 * IF ALPHA CHAR IS TO BE PLOTTED SYMAD IS SET TO MAP11100 * HEX /FFFF . MAP11110 *********************** MAP11120 TLKUP NOP MAP11130 STX L1 XR11 SAVE REGISTER 1 MAP11140 LDX 1 11 SET REG TO TABLE LENGTH MAP11150 TLK1 LD L1 TSYMB LOAD ENTRY FROM TABLE MAP11160 S L SYMBL COMPARE WITH ARGUMENT MAP11170 BSC L TLK3,+- BRANCH IF EQUAL MAP11180 MDX 1 -1 CHECK NEXT ENTRY MAP11190 MDX TLK1 MAP11200 LD L SYMBL MAP11210 AND L ANDOP CHECK FOR BLANK IN 1ST MAP11220 BSC L TLK2,+- CHARACTER MAP11230 LDX 1 1 INVALID CODE-SET TO X MAP11240 MDX TLK3 MAP11250 TLK2 LDD L SYMBL SHIFT CHAR TO 1ST POSITION MAP11260 SLT 8 TO BE PLOTTED MAP11270 STO L SYMBL MAP11280 LD L HEXF SET ADDRESS OF WELL SYMBOL MAP11290 MDX TLK4 STRING TO HEX F & RETURN MAP11300 TLK3 LD L1 TADDR PUT ADDR OF WELL SYMBOL MAP11310 TLK4 STO L SYMAD STRING IN SYMAD MAP11320 LDX I1 XR11 RESTORE XR1 MAP11330 BSC I TLKUP RETURN MAP11340 *********************** MAP11350 * ERROR CALLS AND MESSAGES MAP11360 *********************** MAP11370 ERR1 BSI L ERTYP MORE THAN 13 Z FIELDS MAP11380 DC MESS1 SPECIFIED ERROR MAP11390 BSI L ERTYP MAP11400 DC ERMSG MAP11410 WAIT MAP11420 EXIT CALL MONITOR MAP11430 ERR3 BSI L ERTYP MAP11440 DC MESS6 XMAX LESS THAN XMIN ERROR MAP11450 BSI L ERTYP MAP11460 DC ERMSG MAP11470 BINFL BSS E 2 MAP12550 NMZER DC /2000 CARD CODE 0 MAP12560 EXPON BSS 1 MAP12570 FNDPR BSS 1 MAP12580 FNDEN BSS 1 MAP12590 FFMNB BSS 1 MAP12600 FFMCT BSS 1 MAP12610 FXMNR BSS 1 MAP12620 SCAL BSS E 2 SCALE MAP12630 DUMM BSS E 6 MAP12640 SHIFT BSS 28 NO. OF DEC.PLACES ARRAY MAP12650 BSS 1 MAP12660 RECID BSS 16 X,Y,Z FIELD ARRAY MAP12670 INDX BSS 1 MAP12680 SW1 DC 0 MAP12690 XR3 DC 0 SAVE REG 3 MAP12700 HDISP BSS E 28 HORIZ. DISPL. ARRAY MAP12710 BSS E 0 MAP12720 RND DC 0 MAP12730 DC /0100 MAP12740 RNDF DC 0 MAP12750 DC /0180 MAP12760 VDISP BSS E 26 VERTICAL DISPL. ARRAY MAP12770 FZERO DEC 0.0 USED IN Y BORDER ANNOTAT. MAP12780 CSIZE BSS E 26 CHARACTER SIZE ARRAY MAP12790 XSIZE DEC 0.07 MAP12800 TYPE BSS 26 TYPE Z FIELD ARRAY MAP12810 OFTX BSS 26 OFFSET DIRECTION ARRAY MAP12820 DC 0 MAP12830 NONE DC 0 MAP12840 MASK DC /FF00 MAP12850 EEE DC 41 TITLE OUTPUT AREA MAP12860 DC 0 MAP12870 BSS 40 MAP12880 YMAX BSS E 2 MAX Y TO BE PLOTTED MAP12890 YMIN BSS E 2 MIN Y TO BE PLOTTED MAP12900 XMAX BSS E 2 MAX X TO BE PLOTTED MAP12910 XMIN BSS E 2 MIN X TO BE PLOTTED MAP12920 NUMM BSS 1 MAP12930 NUM BSS 1 MAP12940 XR2 DC 0 MAP12950 NMBER DC 4 MAP12960 FAC DC 0 MAP12970 XR1 DC 100 MAP12980 XINC DC 0 NUMBER OF X INCREMENTS MAP12990 YINC DC 0 NUMBER OF Y INCREMENTS MAP13000 *********************** MAP13010 * STRINGS OF DIGITS USED TO DRAW WELL SYMBOLS MAP13020 *********************** MAP13030 X DC /0005 X MAP13040 DC /2266 MAP13050 DC /6622 MAP13060 DC /8844 MAP13070 DC /4488 MAP13080 DC /9FFF MAP13090 CR DC /0007 CIRCLE MAP13100 DC /9111 MAP13110 DC /0344 MAP13120 DC /5566 MAP13130 DC /7788 MAP13140 DC /1122 MAP13150 DC /3955 MAP13160 DC /59FF MAP13170 GW DC /000F GAS WELL MAP13180 DC /9111 MAP13190 DC /0115 MAP13200 DC /5342 MAP13210 DC /2664 MAP13220 DC /5337 MAP13230 DC /7564 MAP13240 DC /4886 MAP13250 DC /7551 MAP13260 DC /1786 MAP13270 DC /6228 MAP13280 DC /1773 MAP13290 DC /3128 MAP13300 DC /8442 MAP13310 DC /3955 MAP13320 DC /59FF MAP13330 TA DC /0009 TEMPORARILY ABANDONED MAP13340 DC /9111 MAP13350 DC /0115 MAP13360 DC /5344 MAP13370 DC /5566 MAP13380 DC /7551 MAP13390 DC /1788 MAP13400 DC /1122 MAP13410 DC /3955 MAP13420 DC /59FF MAP13430 PR DC /000F PRODUCING OIL WELL MAP13440 DC /1113 MAP13450 DC /4662 MAP13460 DC /2457 MAP13470 DC /7733 MAP13480 DC /3568 MAP13490 DC /8446 MAP13500 DC /7111 MAP13510 DC /5557 MAP13520 DC /8226 MAP13530 DC /6813 MAP13540 DC /3377 MAP13550 DC /7124 MAP13560 DC /4882 MAP13570 DC /3555 MAP13580 DC /9FFF MAP13590 AP DC /0013 ABANDONED AFTER PRODUCTION MAP13600 DC /1111 MAP13610 DC /1553 MAP13620 DC /4662 MAP13630 DC /2453 MAP13640 DC /3777 MAP13650 DC /7733 MAP13660 DC /3568 MAP13670 DC /8446 MAP13680 DC /7551 MAP13690 DC /1111 MAP13700 DC /5557 MAP13710 DC /8226 MAP13720 DC /6817 MAP13730 DC /7333 MAP13740 DC /3377 MAP13750 DC /7124 MAP13760 DC /4882 MAP13770 DC /3555 MAP13780 DC /9FFF MAP13790 AD DC /000B ABANDONED DRY WELL MAP13800 DC /9111 MAP13810 DC /0115 MAP13820 DC /5344 MAP13830 DC /5337 MAP13840 DC /7566 MAP13850 DC /7551 MAP13860 DC /1788 MAP13870 DC /1773 MAP13880 DC /3122 MAP13890 DC /3955 MAP13900 DC /59FF MAP13910 IN DC /000E INJECTION WELL MAP13920 DC /9111 MAP13930 DC /1103 MAP13940 DC /3333 MAP13950 DC /5555 MAP13960 DC /5555 MAP13970 DC /5577 MAP13980 DC /7777 MAP13990 DC /7777 MAP14000 DC /1111 MAP14010 DC /1111 MAP14020 DC /1133 MAP14030 DC /3339 MAP14040 DC /5555 MAP14050 DC /5FFF MAP14060 PL DC /0005 PLUS SIGN MAP14070 DC /1155 MAP14080 DC /5511 MAP14090 DC /7733 MAP14100 DC /3377 MAP14110 DC /9FFF MAP14120 HEXF DC /FFFF MAP14130 TSYMB EBC . . TABLE OF WELL SYMBOL CODES MAP14140 EBC .X . MAP14150 EBC .CR. MAP14160 EBC .GW. MAP14170 EBC .TA. MAP14180 EBC .PR. MAP14190 EBC .AP. MAP14200 EBC .AD. MAP14210 EBC .IN. MAP14220 EBC .PL. MAP14230 EBC .NO. MAP14240 EBC . . MAP14250 TADDR DC 0 ADDRESS OF SYMBOL STRINGS MAP14260 DC X MAP14270 DC CR MAP14280 DC GW MAP14290 DC TA MAP14300 DC PR MAP14310 DC AP MAP14320 DC AD MAP14330 DC IN MAP14340 DC PL MAP14350 DC /0000 MAP14360 DC /0000 MAP14370 BSS E 0 MAP14380 WDCNT DC /0002 MAP14390 DC 0 MAP14400 SYMBL DC 0 WELL SYMBOL TO BE PLOTTED MAP14410 DC /4000 BLANK FOR SHIFT MAP14420 ANDOP DC /BF00 CHECK FOR BLANK IN SYMBOL MAP14430 XR11 DC 0 SAVE REG 1 MAP14440 PXX DEC 0. MAP14450 PYY DEC 0. MAP14460 XR22 BSS 1 MAP14470 WORK DC 0 MAP14480 ANDOT DC /000F MAP14490 SYMAD DC 0 ADDRESS OF WELL SYMBOL STR MAP14500 NOOP NOP SWITCH MAP14510 CDZRO DC /2000 CARD CODE ZERO MAP14520 NYDIV DC 0 NO. OF DIVISIONS OF Y BORD MAP14530 NXDIV DC 0 NO. DIVISIONS OF X BORDER MAP14540 FREQ DEC 0.0 FREQ OF BORDER TICK MARKS MAP14550 NEG2 DC -2 MAP14560 ONE DC 1 MAP14570 TWO DC 2 MAP14580 THREE DC 3 MAP14590 FX300 DC 300 LENGTH OF DATA RECORDS MAP14600 ZNIL DEC -1.0E30 NULL MAP14610 AZNIL DEC 1.E30 RANDOM SET TRAILER FLAG MAP14620 FTWO DEC 2. MAP14630 FLT3 DEC 3.0 MAP14640 B71 DC 71 MAP14650 FTEN DEC 10. MAP14660 TENG4 DEC 1.0E-4 MAP14670 FX11 DC 11 MAP14680 TEN DC 10 MAP14690 B80 DC 80 MAP14700 B13 DC 13 MAP14710 B5 DC 5 MAP14720 B45 DC 45 MAP14730 NTENH DEC -0.10 MAP14740 ZERO DC 0 MAP14750 B60 DC 60 MAP14760 F1 DEC 1. MAP14770 B126 DC 126 MAP14780 FOUR DC 4 MAP14790 NP5 DEC -.5 MAP14800 F05 DEC .05 MAP14810 P05 DEC .05 MAP14820 WAIT MAP11480 EXIT RETURN TO MONITOR MAP11490 ERR4 BSI L ERTYP YMAX LESS THAN YMIN MAP11500 DC MESS7 MAP11510 BSI L ERTYP MAP11520 DC ERMSG MAP11530 WAIT MAP11540 EXIT CALL MONITOR MAP11550 BERR BSI L ERTYP MAP11560 DC MESS5 BORDER ANNOTATION MAP11570 BSI L ERTYP FREQUENCY NOT SPECIFIED MAP11580 DC ERMSG MAP11590 WAIT MAP11600 EXIT CALL MONITOR MAP11610 DC 32 MAP11620 MESS1 EBC .MORE THAN 13 Z FIELDS SPECIFIED. MAP11630 DC 26 MAP11640 ERMSG EBC .PUSH START TO CALL MONITOR. MAP11650 DC 16 MAP11660 MESS2 EBC .MAPAT BEGINNING . MAP11670 DC 14 MAP11680 MESS4 EBC .MAPAT COMPLETE. MAP11690 DC 12 MAP11700 MESS5 EBC .FREQ INVALID. MAP11710 DC 20 MAP11720 MESS6 EBC .XMAX LESS THAN XMIN. MAP11730 DC 20 MAP11740 MESS7 EBC .YMAX LESS THAN YMIN. MAP11750 *************** MAP11760 * ERTYP SUBROUTINE MAP11770 *************** MAP11780 ERTYP NOP SUBROUTINE TO MAP11790 LD I ERTYP WRITE MESSAGES MAP11800 STO L ERTX ON THE CONSOLE MAP11810 MDX L ERTYP,&1 TYPEWRITER MAP11820 S L ONE MAP11830 STO *&1 MAP11840 LD L 0 MAP11850 STO L ERTX+2 MAP11860 SRA 1 MAP11870 STO L TYP MAP11880 LIBF EBPRT MAP11890 DC /0000 MAP11900 ERTX DC 0 MAP11910 DC TYP+1 MAP11920 DC 0 MAP11930 LIBF WRTY0 MAP11940 DC /2000 MAP11950 DC TYP MAP11960 LIBF WRTY0 MAP11970 DC /2000 MAP11980 DC CONTL MAP11990 LIBF WRTY0 MAP12000 DC /0000 MAP12010 MDX *-3 MAP12020 BSC I ERTYP MAP12030 TYP BSS E 30 MAP12040 CONTL DC 1 MAP12050 DC /8103 MAP12060 *************** MAP12070 * DEFINE CONSTANTS MAP12080 *************** MAP12090 ADZ DC FZERO ADDRESS OF FLOATING ZERO MAP12100 SCBGN DC 288 BEGINNING DISK ADDRESS MAP12110 OFTPY DC 0 Y OFFSET MAP12120 OFTPX DC 0 X OFFSET MAP12130 EBPER DC /004B EBCDIC PERIOD MAP12140 BLANK DC /0040 EBCDIC BLANK MAP12150 EPLUS DC /004E EBCDIC PLUS MAP12160 YOFF DEC 0. Y OFFSET MAP12170 XOFF DEC 0. X OFFSET MAP12180 BBB DEC -.5 MAP12190 REG1 BSS 1 SAVE REG 1 MAP12200 REG2 BSS 1 SAVE REG 2 MAP12210 ZZ BSS E 2 Z FIELD MAP12220 YN BSS E 2 OFFSET Y MAP12230 XN BSS E 2 OFFSET X MAP12240 CHLGT BSS E 2 CHARACTER LENGTH MAP12250 REG3 BSS 1 SAVE REG 3 MAP12260 POSIT BSS 1 MAP12270 EXP BSS 1 MAP12280 BSS E 2 MAP12290 LDECA BSS E 30 MAP12300 LDECM BSS E 6 MAP12310 LDEC BSS E 16 MAP12320 YY BSS E 2 Y COORDINATE MAP12330 XX BSS E 2 X COORDINATE MAP12340 SCCNT BSS 1 DISK SECTOR ADDRESS MAP12350 DTCNT BSS 1 POINTER TO DATA RECORD MAP12360 NYINC BSS E 2 MAP12370 NXINC BSS E 2 MAP12380 RESUL BSS E 2 MAP12390 XCORA DEC 0.0 X COORDINATE OF BORDER MAP12400 YCORA DEC 0.0 Y COORDINATE OF BORDER MAP12410 WKIO BSS E 322 DISK INPUT AREA MAP12420 INPTA BSS E 81 CARD INPUT AREA MAP12430 CRDCD BSS E 46 CARD CODE + MAP12440 PLUS DC /80A0 CARD CODE + MAP12450 AMPER DC /8000 CARD CODE & MAP12460 MINUS DC /4000 CARD CODE - MAP12470 PERID DC /8420 CARD CODE . MAP12480 LTRE DC /8100 CARD CODE E MAP12490 EFORM BSS E 6 MAP12500 FXMNT BSS 1 MAP12510 MANT BSS E 2 MAP12520 MANR BSS E 2 MAP12530 EXPT BSS E 2 MAP12540 P1 DEC .1 MAP14830 F100K DEC 100000. MAP14840 END GO MAP14850 // DUP MAP14860 *STORE WS UA MAPAT MAP14870 // JOB CTM00010 // DUP CTM00020 *DELETE UA CTMAN CTM00030 // FOR CTM00040 *ONE WORD INTEGERS CTM00050 *IOCS(PLOTTER) CTM00060 REAL NAME CTM00080 DIMENSION ZG(306) CTM00090 DIMENSION AZ(52) CTM00100 COMMON ZG,I1,L,IFCOL,ILCOL,IFROW,ILROW,ISW1,ISW2,ISW3,ISW4,Z1P, CTM00110 1Z2P,Z3P,Z4P,U1P,V1P,U2P,V2P,U3P,V3P,U4P,V4P,IS1,IS2,IS3,IS4,CONVA,CTM00120 2XNIL,YNIL,ZNIL,D1,D2,D3,D4,X1,Y1,X2,Y2,X3,Y3,X4,Y4,X,Y,I,J,ZPMIN, CTM00130 3ZPMAX,U1,V1,U2,V2,U3,V3,U4,V4,CONIN,A,B,C,D,R1,R2,NNN,NNN1,NNN2, CTM00140 4ANSTR,ANEND,ANINT,NLNSW,XQ,MULTR CTM00150 COMMON INPUT,NAME,XSCAL,LSW,INTIN,IMORB,IBORD CTM00160 EQUIVALENCE(AZ(1),ZG(255)) CTM00170 C************** CTM00180 CALL LOCAT (NAME,IFOUN,GRID,ICMAX,JRMAX,XMIN,YMIN,NSCTR) CTM00190 GO TO(211,81,212,213),IFOUN CTM00200 81 L = 51 CTM00210 IF (ANSTR) 82,83,82 CTM00220 83 IF (ANEND) 82,84,82 CTM00230 84 ANEND = 10.**10 CTM00240 ANSTR = - ANEND CTM00250 82 R2 = 0. CTM00260 IXCOL=ICMAX-1 CTM00270 XQ=GRID/XSCAL CTM00280 C************** CTM00290 C**** CALL ROUTINES TO PLOT THE BORDER CTM00300 C************** CTM00310 NX = IXCOL CTM00320 NY = JRMAX - 1 CTM00330 XMAX = IXCOL*XQ CTM00340 YMAX = NY*XQ CTM00350 IF (IBORD - 1) 90,91,92 CTM00360 91 NX = 1 CTM00370 NY = 1 CTM00380 92 DISTX = XMAX/NX CTM00390 DISTY = YMAX/NY CTM00400 CALL FGRID(0,0.0,0.0,DISTX,NX) CTM00410 CALL FGRID(1,XMAX,0.0,DISTY,NY) CTM00420 CALL FGRID(2,XMAX,YMAX,DISTX,NX) CTM00430 CALL FGRID(3,0.0,YMAX,DISTY,NY) CTM00440 C************** CTM00450 C**** INITIALIZE XBAN, WHICH IS A SECTION OF 50 STRIPS OF GRIDS IN THE CTM00460 C**** Y DIRECTION. CTM00470 C**** XQ NUMBER OF INCHES PER UNIT CTM00480 C************** CTM00490 90 XBAN = 0. CTM00500 JLIM = - 49 CTM00510 JA = 1 CTM00520 IXQ = INTIN CTM00530 3 JLIM = JLIM + 50 CTM00540 IYQ = - IXQ CTM00550 IXQQ = 1 CTM00560 JLIMX = JLIM + 49 CTM00570 IF(JLIMX-JRMAX) 5,4,4 CTM00580 4 JLIMX=JRMAX-1 CTM00590 5 JQ=JLIMX-JLIM+2 CTM00600 C************** CTM00610 C**** READ IN THREE COLUMNS OF GRID VALUES. CTM00620 C************** CTM00630 DO 7 IC=1,3 CTM00640 CALL COLIN(IC,JLIMX,JQ,AZ,IFOUN,NSCTR) CTM00650 IF (IFOUN-1) 46,212,213 CTM00660 46 KQ = 51*(IC+2) CTM00670 DO 7 JS=1,JQ CTM00680 IP=KQ+JS CTM00690 7 ZG(IP)=AZ(JS+1) CTM00700 YQ = -50.*XBAN*XQ CTM00710 C************** CTM00720 C**** CALL ROUTINE TO SCALE MAP. SET NN=2 TO ANNOTATE IF NOT SET NN=1 CTM00730 C************** CTM00740 CALL SCALF(XQ,XQ,0.,YQ) CTM00750 J1 = 1 CTM00760 IYQQ = JA CTM00770 DO 18 I=1,IXCOL CTM00780 NN = 1 CTM00790 IF (I - IXQQ) 50,51,50 CTM00800 51 IXQQ = IXQQ + IXQ CTM00810 NN = 2 CTM00820 50 DO 9 KP = 1,255 CTM00830 9 ZG(KP) = ZG(KP + 51) CTM00840 IF(I+2-ICMAX) 10,12,12 CTM00850 10 IC = I+3 CTM00860 CALL COLIN(IC,JLIMX,JQ,AZ,IFOUN,NSCTR) CTM00870 IF (IFOUN-1) 12,212,213 CTM00880 12 JS=JLIMX-JLIM+1 CTM00890 IFROW=1 CTM00900 ILROW=JS+1 CTM00910 IF(I-3) 13,13,14 CTM00920 13 IFCOL=1 CTM00930 GO TO 20 CTM00940 14 IFCOL=I-2 CTM00950 20 IF(I+3-ICMAX) 15,16,16 CTM00960 15 ILCOL=I+3 CTM00970 GO TO 21 CTM00980 16 ILCOL=ICMAX CTM00990 21 J1 = -1*J1 CTM01000 IYQ = - IYQ CTM01010 DO 17 JJ = 1,JS CTM01020 J = JJ CTM01030 C*************** CTM01040 C**** SET NNN1=2 TO ANNOTATE WITHIN GRID IF NOT NNN1=1 CTM01050 C*************** CTM01060 IF (J1 - 1) 71,70,71 CTM01070 70 J = JS + 1 - JJ CTM01080 71 NNN1 = 1 CTM01090 IF (J - IYQQ) 52,54,52 CTM01100 54 IYQQ = IYQQ + IYQ CTM01110 IF (NN - 2) 52,53,52 CTM01120 53 IF (IMORB - 1)52,110,111 CTM01130 111 IF (I - 1) 113,110,113 CTM01140 113 IF (I - IXCOL) 114,110,114 CTM01150 114 IF (JLIM - J) 112,110,112 CTM01160 112 IF (JRMAX - JLIM - J) 52,110,52 CTM01170 110 NNN1 = 2 CTM01180 52 I1 = J + 102 CTM01190 CALL SEGMN CTM01200 17 CONTINUE CTM01210 18 IYQQ = IYQQ - IYQ CTM01220 JA = (50/IXQ + 1)*IXQ - 49 CTM01230 CALL FPLOT(3,0.,YQ) CTM01240 XBAN=XBAN+1./XQ CTM01250 IF(JLIMX+1-JRMAX) 3 ,19,19 CTM01260 19 CALL SCALF (1.,1.,0.,0.) CTM01270 IF (LSW) 321,322,325 CTM01280 321 I=4 CTM01290 399 CALL LINK (CTERR) CTM01300 325 CALL FPLOT (1,XMAX + LSW,0.) CTM01310 CALL SCALF (1.,1.,0.,0.) CTM01320 GO TO 323 CTM01330 211 I=1 CTM01340 GO TO 399 CTM01350 212 I=2 CTM01360 GO TO 399 CTM01370 213 I=3 CTM01380 GO TO 399 CTM01390 322 CALL EXIT CTM01400 323 CALL LINK (CONTR) CTM01410 END CTM01420 // DUP CTM01430 *STORE WS UA CTMAN CTM01440 // JOB CTE00010 // DUP CTE00020 *DELETE UA CTERR CTE00030 // FOR CTE00040 *ONE WORD INTEGERS CTE00060 *IOCS(TYPEWRITER) CTE00070 C CTE00080 C ******************************************************************CTE00090 C CTE00100 C LINK TO PRINT MESSAGES FOR CONTOURING PROGRAM CTE00110 C CTE00120 C ******************************************************************CTE00130 C CTE00140 REAL NAME CTE00150 DIMENSION ZG(306) CTE00160 COMMON ZG,I1,L,IFCOL,ILCOL,IFROW,ILROW,ISW1,ISW2,ISW3,ISW4,Z1P, CTE00170 1Z2P,Z3P,Z4P,U1P,V1P,U2P,V2P,U3P,V3P,U4P,V4P,IS1,IS2,IS3,IS4,CONVA,CTE00180 2XNIL,YNIL,ZNIL,D1,D2,D3,D4,X1,Y1,X2,Y2,X3,Y3,X4,Y4,X,Y,I,J,ZPMIN, CTE00190 3ZPMAX,U1,V1,U2,V2,U3,V3,U4,V4,CONIN,A,B,C,D,R1,R2,NNN,NNN1,NNN2, CTE00200 4ANSTR,ANEND,ANINT,NLNSW,XQ,MULTR CTE00210 COMMON INPUT,NAME,XSCAL,LSW,INTIN,IMORB,IBORD CTE00220 ICT=1 CTE00230 GO TO (211,212,213,321),I CTE00240 211 WRITE(ICT,101) CTE00250 101 FORMAT(23H NAME NOT FOUND ON DISK) CTE00260 GO TO 115 CTE00270 212 WRITE(ICT,102) CTE00280 102 FORMAT(18H NO TRAILER RECORD) CTE00290 GO TO 115 CTE00300 213 WRITE(ICT,103) CTE00310 103 FORMAT(11H DISK ERROR) CTE00320 115 WRITE(ICT,105) CTE00330 105 FORMAT(31H PUSH START FOR EXIT TO MONITOR) CTE00340 PAUSE CTE00350 CALL EXIT CTE00360 321 WRITE (ICT,324) CTE00370 324 FORMAT (' READY PLOTTER FOR NEXT MAP - LOAD CONTROL CARDS - CTE00380 1 PUSH START ') CTE00390 PAUSE CTE00400 CALL LINK (CONTR) CTE00410 END CTE00420 // DUP CTE00430 *STORE WS UA CTERR CTE00440 // JOB CTR00010 // DUP CTR00020 *DELETE UA CONTR CTR00030 // FOR CTR00040 *ONE WORD INTEGERS CTR00060 *IOCS(CARD,TYPEWRITER) C ***************************************************************** CTR00080 C CTR00090 C LINK TO READ ALL INPUT DATA FOR CONTOURING PROGRAM CTR00100 C CTR00110 C ******************************************************************CTR00120 C CTR00130 REAL NAME CTR00140 DIMENSION ZG(306) CTR00150 COMMON ZG,I1,L,IFCOL,ILCOL,IFROW,ILROW,ISW1,ISW2,ISW3,ISW4,Z1P, CTR00160 1Z2P,Z3P,Z4P,U1P,V1P,U2P,V2P,U3P,V3P,U4P,V4P,IS1,IS2,IS3,IS4,CONVA,CTR00170 2XNIL,YNIL,ZNIL,D1,D2,D3,D4,X1,Y1,X2,Y2,X3,Y3,X4,Y4,X,Y,I,J,ZPMIN, CTR00180 3ZPMAX,U1,V1,U2,V2,U3,V3,U4,V4,CONIN,A,B,C,D,R1,R2,NNN,NNN1,NNN2, CTR00190 4ANSTR,ANEND,ANINT,NLNSW,XQ,MULTR CTR00200 COMMON INPUT,NAME,XSCAL,LSW,INTIN,IMORB,IBORD CTR00210 C************** CTR00220 C INPUT = 8 ALL INPUT IS ON THE 2501 CARD READER CTR00230 C INPUT = 2 ALL INPUT IS ON THE 1442 CARD READER CTR00240 INPUT = 2 C************** CTR00260 ICT=1 CTR00270 C************** CTR00280 C FIRST CONTROL CARD CTR00290 C NAME = GRID CALLED FROM DISK CTR00300 C CONIN= INTERVAL BETWEEN TWO CONSECUTIVE CONTOURS CTR00310 C XSCAL= SCALE OF GRID CTR00320 C LSW = 0 TO CALL EXIT, NEGATIVE TO DRAW ANOTHER MAP, CTR00330 C POSITIVE INDICATES NO. OF INCHES BETWEEN MAPS - AUTOMATIC PLOTCTR00340 C************** CTR00350 READ(INPUT,1) NAME,CONIN,XSCAL,LSW CTR00360 1 FORMAT(A4,2F10.0,I6) CTR00370 WRITE(ICT,2) NAME CTR00380 2 FORMAT(18H INPUT GRID NAMED ,A4) CTR00390 C*************** CTR00400 C ANSTR = CONTOUR TO START CTR00410 C ANEND = CONTOUR TO END CTR00420 C ANINT = CONTOUR INTERVAL BETWEEN 2 CONSECUTIVE ANNOTATIONS CTR00430 C INTIN = INTERVAL IN INCHES BETWEEN 2 CONSECUTIVE ANNOTATIONS CTR00440 C IMORB = 1 ANNOTATE WITHIN MAP , IF 2 ONLY ON BORDERS CTR00450 C IMORB = 0 NO ANNOTATION CTR00460 C NLNSW = 1 NON LINEAR PLOT, IF ZERO LINEAR PLOT CTR00470 C NNN1 = 2 ANNOTATE, IF 1 NO ANNOTATIONS CTR00480 C MULTR = ANNOTATION - DECIMAL POINT SHIFT FROM RIGHTMOST POSITION CTR00490 C*************** CTR00500 READ (INPUT,80) ANSTR,ANEND,ANINT,INTIN,IMORB,NLNSW,MULTR,IBORD CTR00510 80 FORMAT (3F10.0,5I5) CTR00520 CALL LINK(CTMAN) CTR00530 END CTR00540 // DUP CTR00550 *STORE WS UA CONTR CTR00560 // JOB // DUP NUM00010 *DELETE NUMAN NUM00020 // FOR NUM00030 *ONE WORD INTEGERS NUM00040 SUBROUTINE NUMAN (XX,YY,XX0,XX5) NUM00050 DIMENSION ZG(306) NUM00060 DIMENSION M(5) NUM00070 COMMON ZG,I1,L,IFCOL,ILCOL,IFROW,ILROW,ISW1,ISW2,ISW3,ISW4,Z1P, NUM00080 1Z2P,Z3P,Z4P,U1P,V1P,U2P,V2P,U3P,V3P,U4P,V4P,IS1,IS2,IS3,IS4,CONVA,NUM00090 2XNIL,YNIL,ZNIL,D1,D2,D3,D4,X1,Y1,X2,Y2,X3,Y3,X4,Y4,X,Y,I,J,ZPMIN, NUM00100 3ZPMAX,U1,V1,U2,V2,U3,V3,U4,V4,CONIN,A,B,C,D,R1,R2,NNN,NNN1,NNN2, NUM00110 4ANSTR,ANEND,ANINT,NLNSW,XQ,MULTR NUM00120 C NUM00130 C ******************************************************************NUM00140 C NUM00150 C SUBROUTINE TO ANNOTATE CONTOUR VALUE. DIGIT SIZE .08 INCH SQUARE NUM00160 C NUMBERS ARE PARALLEL TO X AXIS NUM00170 C ICONV IS CONTOUR VALUE TO ANNOTATE NUM00180 C NUM00190 C ******************************************************************NUM00200 C NUM00210 XX2 = XX0 + XX0 NUM00220 XX4 = XX2 + XX2 NUM00230 XX6 = XX2 + XX4 NUM00240 XX = XX + XX0 NUM00250 YY2 = YY + XX4 NUM00260 YY1 = YY2 + XX4 NUM00270 C NUM00280 C ******************************************************************NUM00290 C NUM00300 C DETERMINE 5 DIGITS TO DRAW NUM00310 C NUM00320 C ******************************************************************NUM00330 C NUM00340 C NUM00350 C NUM00360 C NUM00370 ICONV = FABS(CONVA/(10.**MULTR))+.1 NUM00380 M(1) = ICONV/10000 NUM00390 M(4) = ICONV/1000 NUM00400 M(5) = ICONV/100 NUM00410 N = ICONV/10 NUM00420 M(2) = M(4) - M(1)*10 NUM00430 M(3) = M(5) - M(4)*10 NUM00440 M(4) = N - M(5)*10 NUM00450 M(5) = ICONV - N*10 NUM00460 CALL FPLOT (1,XX,YY) NUM00470 N = 1 NUM00480 IF (M(1)) 41,42,41 NUM00490 42 XX = XX + XX4 NUM00500 N = 2 NUM00510 IF (M(2)) 41,44,41 NUM00520 44 XX = XX + XX4 NUM00530 N = 3 NUM00540 IF (M(3)) 41,46,41 NUM00550 46 XX = XX + XX4 NUM00560 N = 4 NUM00570 IF (M(4)) 41,49,41 NUM00580 49 XX = XX + XX4 NUM00590 N = 5 NUM00600 C NUM00610 C ******************************************************************NUM00620 C NUM00630 C DRAW MINUS SIGN FOR NEGATIVE CONTOUR VALUE NUM00640 C PROCEED WITH DRAWING OF 5 DIGITS NUM00650 C NUM00660 C ******************************************************************NUM00670 C NUM00680 41 IF (CONVA) 47,48,48 NUM00690 47 CALL FPLOT (-2,XX - XX2,YY2) NUM00700 CALL FPLOT (- 1,XX - XX4 - XX4,YY2) NUM00710 48 DO 50 MM = N,5 NUM00720 XX1 = XX + XX6 NUM00730 K = M(MM) NUM00740 IF ( K - 9 ) 1,2,1 NUM00750 2 CALL FPLOT (-2,XX1,YY2) NUM00760 GO TO 4 NUM00770 1 IF ( K - 5 ) 3,4,3 NUM00780 4 CALL FPLOT (-2,XX1,YY1) NUM00790 CALL FPLOT (0,XX,YY1) NUM00800 CALL FPLOT (0,XX,YY2) NUM00810 19 CALL FPLOT (0,XX1,YY2) NUM00820 CALL FPLOT (0,XX1,YY) NUM00830 CALL FPLOT (0,XX,YY) NUM00840 IF ( K - 6 ) 5,6,5 NUM00850 6 CALL FPLOT (0,XX,YY1) NUM00860 5 GO TO 100 NUM00870 3 IF ( K - 6 ) 7,4,7 NUM00880 7 IF ( K - 1 ) 9,8,9 NUM00890 8 CALL FPLOT (-2,XX + XX2,YY + XX6) NUM00900 12 CALL FPLOT ( 0,XX + XX4,YY1) NUM00910 CALL FPLOT ( 0,XX + XX4,YY) NUM00920 GO TO 100 NUM00930 9 IF ( K - 4 ) 10,11,10 NUM00940 11 CALL FPLOT (-2,XX1,YY + XX2) NUM00950 CALL FPLOT (0,XX,YY + XX2) NUM00960 GO TO 12 NUM00970 10 CALL FPLOT (-2,XX,YY1) NUM00980 CALL FPLOT (0,XX1,YY1) NUM00990 IF ( K - 7 ) 13,14,13 NUM01000 14 CALL FPLOT (0,XX,YY) NUM01010 GO TO 100 NUM01020 13 IF ( K ) 15,16,15 NUM01030 16 CALL FPLOT (0,XX1,YY) NUM01040 CALL FPLOT (0,XX,YY) NUM01050 CALL FPLOT (0,XX,YY1) NUM01060 GO TO 100 NUM01070 15 IF ( K - 3 ) 17,18,17 NUM01080 18 CALL FPLOT (0,XX,YY2) NUM01090 GO TO 19 NUM01100 17 CALL FPLOT (0,XX1,YY + XX5) NUM01110 CALL FPLOT (0,XX + XX5,YY2) NUM01120 CALL FPLOT (0,XX + XX0,YY2) NUM01130 CALL FPLOT (0,XX,YY + XX2 + XX0) NUM01140 CALL FPLOT (0,XX,YY) NUM01150 CALL FPLOT (0,XX1,YY) NUM01160 IF ( K - 8 ) 100,20,100 NUM01170 20 GO TO 4 NUM01180 100 XX = XX1 + XX2 NUM01190 50 CALL FPLOT (1,XX,YY) NUM01200 RETURN NUM01210 END NUM01220 // DUP NUM01230 *STORE WS UA NUMAN NUM01240 // DUP XNT00010 *DELETE XNTRP XNT00020 // FOR XNT00030 *ONE WORD INTEGERS XNT00040 SUBROUTINE XNTRP XNT00050 DIMENSION ZG(306) XNT00060 COMMON ZG,I1,L,IFCOL,ILCOL,IFROW,ILROW,ISW1,ISW2,ISW3,ISW4,Z1P, XNT00070 1Z2P,Z3P,Z4P,U1P,V1P,U2P,V2P,U3P,V3P,U4P,V4P,IS1,IS2,IS3,IS4,CONVA,XNT00080 2XNIL,YNIL,ZNIL,D1,D2,D3,D4,X1,Y1,X2,Y2,X3,Y3,X4,Y4,X,Y,I,J,ZPMIN, XNT00090 3ZPMAX,U1,V1,U2,V2,U3,V3,U4,V4,CONIN,A,B,C,D,R1,R2,NNN,NNN1,NNN2, XNT00100 4ANSTR,ANEND,ANINT,NLNSW,XQ,MULTR XNT00110 C XNT00120 C************** XNT00130 C**** SUBROUTINE TO COMPUTE COORDINATES OF INTERSECTIONS IN PREDECESSOR XNT00140 C**** GRIDS. XNT00150 C************** XNT00160 C XNT00170 U1P#1000. XNT00180 V1P#1000. XNT00190 U2P#1000. XNT00200 V2P#1000. XNT00210 U3P#1000. XNT00220 V3P#1000. XNT00230 U4P#1000. XNT00240 V4P#1000. XNT00250 IS1#0 XNT00260 IS2#0 XNT00270 IS3#0 XNT00280 IS4#0 XNT00290 MZ#0 XNT00300 IF%Z1P-ZNIL<28,28,27 XNT00310 28 MZ#MZ&1 XNT00320 27 IF%Z2P-ZNIL<30,30,29 XNT00330 30 MZ#MZ&1 XNT00340 29 IF%Z3P-ZNIL<32,32,31 XNT00350 32 MZ#MZ&1 XNT00360 31 IF%Z4P-ZNIL<34,34,33 XNT00370 34 MZ#MZ&1 XNT00380 33 IF%MZ-1<36,36,24 XNT00390 36 IF%Z1P-ZNIL< 7,7,25 XNT00400 25 IF%Z2P-ZNIL<13,13,26 XNT00410 26 IF%CONVA-Z1P<1,1,3 XNT00420 1 IF%CONVA-Z2P<6,6,4 XNT00430 4 IS1#1 XNT00440 U1P#0. XNT00450 V1P#%CONVA-Z1P