C COPYRIGHT (C) 1978 - UNIVERSITY OF NOTRE DAME - V2R1I1 00000010
C 00000020
C * * * * * N D T R A N * * * * * 00000030
C 00000040
C NDTRAN IS A SYSTEM DYNAMICS CONTINUOUS SIMULATION LANGUAGE 00000050
C DEVELOPED AT THE UNIVERSITY OF NOTRE DAME, FINANCED BY A 00000060
C GRANT FROM THE MAX D. FLEISCHMANN FOUNDATION, UNDER THE 00000070
C DIRECTION OF DR. WILLIAM I. DAVISSON AND DR. JOHN J. UHRAN, JR. 00000080
C THIS INTERPRETER WHICH COMPUTERIZES THE NDTRAN LANGUAGE WAS 00000090
C WRITTEN BY DANIEL A. POYDENCE, THOMAS L. EVERMAN, JR., 00000100
C GARY L. PELKEY, AND TIMOTHY J. MALLOY AS UNDERGRADUATES 00000110
C OF THE UNIVERSITY. 00000120
C 00000130
C 00000140
REAL*8 RMIN,RMAX,LITBL(1024) 00000150
INTEGER PTRS(45),TITLE(120),CRSET(39),OPER(9),SYM(15), 00000160
1SUBSC(6),TYPCT(20),EQCHN(80),TOKEN(80),CARD1(80),CARD2(80), 00000170
2ERROR(80),OBJCD(160),DEF(80),XREF(80),TMAP(80),FCTN(5,22), 00000180
3SYMTB(5,512) 00000190
INTEGER INIT0(5772), INIT1(48),INIT2(48),I,READR,PRNTR, 00000200
1DISK,LINPP,EXPMX,INTYP,PSSWT,SYMND,LITND,VALCT,STPGM, 00000210
2DSKND,VARND,OBJND,PGMCT,CBIT,EOF,ASC1,RRBST,RRBPT,OPTNS 00000220
COMMON RMIN,RMAX,PTRS,TITLE,CRSET,OPER,SYM,SUBSC,TYPCT, 00000230
1EQCHN,TOKEN,CARD1,CARD2,ERROR,OBJCD,DEF,XREF,TMAP,FCTN, 00000240
2SYMTB,LITBL 00000250
EQUIVALENCE (INIT0(1),PTRS(1)),(INIT1(1),CRSET(1)), 00000260
1(READR,PTRS(1)),(PRNTR,PTRS(2)),(DISK,PTRS(3)),(LINPP,PTRS(6)), 00000270
2(EXPMX,PTRS(9)),(INTYP,PTRS(8)),(PSSWT,PTRS(10)),(SYMND,PTRS(17)),00000280
3(LITND,PTRS(19)),(VALCT,PTRS(20)),(STPGM,PTRS(21)),(DSKND,PTRS(25)00000290
4),(VARND,PTRS(26)),(OBJND,PTRS(27)),(PGMCT,PTRS(22)), 00000300
5(CBIT,TOKEN(2)),(RRBST,PTRS(36)),(RRBPT,PTRS(37)),(OPTNS,PTRS(7)) 00000310
DATA INIT2 /' ','$','#','A','B','C','D','E','F','G','H','I', 00000320
1'J','K','L','M','N','O','P','Q','R','S','T','U','V','W','X', 00000330
2'Y','Z','0','1','2','3','4','5','6','7','8','9','.','+','-', 00000340
3'*','/','=','(',')',','/ 00000350
C 00000360
C 00000370
C DEFINE THE CHARACTERISTICS FOR THE DIRECT ACCESS FILE. 00000380
C 5,000 RECORDS OF 80 INTEGER WORDS ARE REQUIRED. THE 00000390
C RECORDS ARE UNFORMATTED AND 'ASC1' IS THE ASSOCIATED 00000400
C VARIABLE. NDTRAN DOES NOT USE THE ASSOCIATED VARIABLE. 00000410
C ANY UNIT NUMBER MAY BE ASSIGNED FOR THE FILE. 00000420
C 00000430
C 00000440
C DEC / FORDHAM UNIVERSITY /
C DEFINE FILE 1(5000,80,U,ASC1) 00000450
OPEN(UNIT=20,DEVICE='DSK',ACCESS='RANDOM',
1MODE='ASCII',DISPOSE='DELETE',RECORD SIZE=80,FILE='NDTF1')
C DEC / END /
C 00000460
C 00000470
C ALL COMMON STORAGE LOCATIONS MUST BE INITIALIZED FOR 00000480
C THOSE SYSTEMS WHICH PREVENT A REFERENCE TO A STORAGE 00000490
C LOCATION WHICH HAS NOT BEEN ASSIGNED A VALUE. 00000500
C 00000510
C 00000520
DO 10 I=1,5772 00000530
10 INIT0(I)=0 00000540
C 00000550
C 00000560
C THE FOLLOWING ASSIGNMENTS ESTABLISH INSTALLATION DEPENDENT 00000570
C PARAMETERS. READR IS THE INPUT DEVICE NUMBER (THE CARD READER 00000580
C OR ANY SEQUENTIAL INPUT FILE), PRNTR IS THE OUTPUT DEVICE 00000590
C NUMBER (LINE PRINTER OR ANY SEQUENTIAL OUTPUT FILE), AND 00000600
C DISK IS THE DIRECT ACCESS FILE NUMBER. LINPP IS THE NUMBER 00000610
C OF LINES PER PAGE OF PRINTED OUTPUT. EXPMX IS THE MAXIMUM 00000620
C EXPONENT PERMITTED DURING EXECUTION AND SHOULD BE SET TO 00000630
C ONE LESS THAN THE SMALLEST OF THE THE ABSOLUTE VALUE OF THE 00000640
C CHARACTERISTICS OF THE FLOATING POINT MINIMUM AND THE MAXIMUM. 00000650
C 00000660
C AS AN EXAMPLE, THE IBM 370 FLOATING POINT MINIMUM AND MAXIMUM 00000670
C VALUES ARE APPROXIMATELY 1E-78 AND 1E75 SO EXPMX IS 74 ON 00000680
C THAT SYSTEM. NDTRAN WILL PERMIT NUMBERS BETWEEN AND INCLUDING 00000690
C 1E-74 AND 1E74 DURING EXECUTION. 00000700
C 00000710
C 00000720
C DEC / FORDHAM UNIVERSITY /
READR=1 00000730
PRNTR=6 00000740
DISK=20 00000750
LINPP=60 00000760
EXPMX=37 00000770
C DEC / END /
C 00000780
C 00000790
C INTYP IS INITIALIZED TO THE DESIRED DEFAULT INTEGRATION 00000800
C TECHNIQUE TO BE USED DURING EXECUTION. INTYP MAY HAVE 00000810
C THE FOLLOWING VALUES: 00000820
C 00000830
C 1 - EULER LOWER SUM 00000840
C 2 - FOURTH ORDER RUNGE-KUTTA 00000850
C 3 - ADAMS-BASHFORTH PREDICTOR 00000860
C 00000870
C 00000880
INTYP=3 00000890
C 00000900
C 00000910
C THE FOLLOWING ASSIGNMENTS ESTABLISH THE LIMITS ON SIZE AND 00000920
C REQUIREMENTS FOR NDTRAN PROGRAMS. SYMND LIMITS THE SYMBOL 00000930
C TABLE SIZE, LITND LIMITS THE NUMBER OF NUMERIC LITERALS, 00000940
C AND DSKND LIMITS THE NUMBER OF RECORDS THAT MAY BE WRITTEN 00000950
C TO AND READ FROM THE DISK FILE. VARND AND OBJND LIMIT THE 00000960
C REAL AND INTEGER STORAGE AVAILABLE DURING EXECUTION. 00000970
C 00000980
C 00000990
SYMND=512 00001000
LITND=1024 00001010
DSKND=5000 00001020
VARND=5000 00001030
OBJND=5154 00001040
C 00001050
C 00001060
C THE FLOATING POINT MINIMUM AND MAXIMUM VALUES ARE COMPUTED 00001070
C AND THE NDTRAN CHARACTER SET IS INITIALIZED. 00001080
C 00001090
C 00001100
RMAX=10.**EXPMX 00001110
RMIN=10.**(-EXPMX) 00001120
DO 20 I=1,48 00001130
20 INIT1(I)=INIT2(I) 00001140
C 00001150
C 00001160
C NDT03 INITIALIZES THE SYMBOL AND FUNCTION TABLES AND PUTS 00001170
C BUILTIN MACRO RECORDS ON DISK. 00001180
C 00001190
C 00001200
CALL NDT03 00001210
C 00001220
C 00001230
C THE REQUIRED INITIALIZATIONS ARE COMPLETED. STPGM IS 00001240
C THE FIRST RECORD AVAILABLE FOR SOURCE PROGRAM INFORMATION 00001250
C STORAGE. PGMCT POINTS TO THE LAST RECORD USED FOR THAT 00001260
C PURPOSE. ASC1 IS SET TO 1 FOR SYSTEMS THAT REQUIRE THE 00001270
C ASSOCIATED VARIABLE TO BE VALID WHETHER IT IS USED OR NOT. 00001280
C PSSWT, THE PROGRAM STATUS SWITCH IS SET TO BEGIN LOOKING 00001290
C FOR A TITLE CARD DURING INPUT. VALCT, THE VARIABLE 00001300
C ALLOCATION COUNTER, IS SET TO THE LAST STORAGE LOCATION 00001310
C ALLOCATED FOR USE DURING EXECUTION. EOF IS AN END OF FILE 00001320
C FLAG (1 = END OF FILE HAS OCCURRED). CBIT, THE CONTINUATION 00001330
C BIT, INDICATES THAT THE PREVIOUS CARD WAS CONTINUED WITH 00001340
C A VALUE OF 1. IT IS SET TO 1 TO CAUSE 2 CARDS TO BE INPUT 00001350
C INITIALLY. RRBST IS THE FIRST RECORD AVAILABLE FOR RERUN 00001360
C BUFFERS. RRBPT POINTS TO THE LAST RECORD USED FOR THAT PURPOSE. 00001370
C RRBPT IS INITIALIZED TO ALLOW THE RERUN CARD PROCESSOR TO 00001380
C DISTINGUISH THE FIRST RERUN CARD FROM THE OTHERS. 00001390
C 00001400
C 00001410
STPGM=150 00001420
PGMCT=STPGM-1 00001430
C DEC / FORDHAM UNIVERSITY /
C ASC1=1 00001440
C DEC / END /
PSSWT=1 00001450
VALCT=21 00001460
EOF=0 00001470
CBIT=1 00001480
RRBST=53 00001490
RRBPT=-1 00001500
C 00001510
C 00001520
C IF CBIT IS 1 THEN THE PREVIOUS CARD WAS CONTINUED AND 00001530
C BOTH CARDS HAVE BEEN PROCESSED. IN THIS CASE TWO MORE 00001540
C CARDS ARE READ. IF CBIT IS 0 THEN CARD1 WAS PROCESSED. 00001550
C CARD2 MUST BE MOVED TO CARD1 AND ONE CARD MUST BE READ. 00001560
C THIS SCHEME ALLOWS INPUT TO BE PROCESSED FROM CARD1 WITH 00001570
C AN OPTIONAL CONTINUATION IN CARD2. 00001580
C 00001590
C 00001600
400 IF(CBIT.EQ.1) GO TO 600 00001610
DO 500 I=1,80 00001620
500 CARD1(I)=CARD2(I) 00001630
READ(READR,700,END=800) CARD2 00001640
GO TO 900 00001650
600 READ(READR,700,END=1400) CARD1 00001660
READ(READR,700,END=800) CARD2 00001670
GO TO 900 00001680
700 FORMAT(80A1) 00001690
C 00001700
C 00001710
C END OF FILE HAS OCCURRED BUT THE LAST CARD NEEDS TO BE 00001720
C PROCESSED SO EOF IS SET. THE CARD CANNOT BE CONTINUED 00001730
C SO THE KEY FIELD OF CARD2 MUST NOT INDICATE A CONTINUATION. 00001740
C 00001750
C 00001760
800 EOF=1 00001770
CARD2(1)=0 00001780
C 00001790
C 00001800
C NDT01 PROCESSES THE INPUT SOURCE CARDS AND UPDATES PSSWT 00001810
C TO INDICATE THE MODE OF INPUT. IF PSSWT IS 6 THEN THE 00001820
C SOURCE CARD REQUESTED A MACRO EXPANSION WHICH IS HANDLED 00001830
C BY NDT02. 00001840
C 00001850
C 00001860
900 CALL NDT01 00001870
IF(PSSWT.EQ.6) CALL NDT02 00001880
IF(EOF.EQ.0) GO TO 400 00001890
C 00001900
C 00001910
C ALL SOURCE STATEMENTS HAVE BEEN INPUT AND PROCESSED. 00001920
C THE CONTEXT ANALYSIS BEGINS AT THIS POINT. 00001930
C 00001940
C 00001950
1400 CALL NDT04 00001960
C 00001970
C 00001980
C THE TABLES REQUESTED BY CONTROL CARDS ARE PRODUCED NEXT. 00001990
C 00002000
C 00002010
CALL NDT61 00002020
C 00002030
C 00002040
C THE EQUATION ORDERING ROUTINE IS CALLED TO RECONSTRUCT THE 00002050
C EQUATION CHAIN TO BE USED BY THE LOADER. 00002060
C 00002070
C 00002080
CALL NDT62 00002090
C 00002100
C 00002110
C THE LOADER IS NOW CALLED TO READ THE OBJECT CODE INTO MEMORY 00002120
C AND INITIALIZE THE DATA BUFFERS REQUIRED FOR EXECUTION. 00002130
C 00002140
C 00002150
CALL NDT75 00002160
C 00002170
C 00002180
C THE EXECUTION PHASE IS READY TO BEGIN. CALL THE APPROPRIATE 00002190
C EXECUTION ROUTINE ACCORDING TO THE 'CHECK' OPTION. 00002200
C 00002210
C 00002220
IF(MOD(OPTNS,2).EQ.1) CALL NDT64 00002230
IF(MOD(OPTNS,2).EQ.0) CALL NDT65 00002240
C 00002250
C 00002260
C EXECUTION IS COMPLETE. CALL THE OUTPUT ROUTINE. 00002270
C 00002280
C 00002290
CALL NDT70 00002300
STOP 00002310
END 00002330
C COPYRIGHT (C) 1978 - UNIVERSITY OF NOTRE DAME 00002340
C PROGRAM AUTHOR - DANIEL A. POYDENCE 00002350
C 00002360
C 00002370
SUBROUTINE NDT01 00002380
C 00002390
C 00002400
C NDT01 IS THE INPUT PROCESSING COORDINATOR. PSSWT IS 00002410
C UPDATED AND MAINTAINED HERE INDICATING THE CURRENT MODE 00002420
C OF SOURCE INPUT. PSSWT MAY HAVE THE FOLLOWING VALUES: 00002430
C 00002440
C 1 - TITLE CARD INPUT 00002450
C 2 - CONTROL CARD INPUT 00002460
C 3 - NORMAL SOURCE INPUT 00002470
C 4 - MARCO GROUP INPUT 00002480
C 5 - RERUN GROUP INPUT 00002490
C 6 - EXPANSION REQUEST 00002500
C 00002510
C INPUT IS PROCESSED ACCORDING TO THE MODE OF INPUT AND 00002520
C THE TYPE OF STATEMENT ENCOUNTERED. 00002530
C 00002540
C 00002550
REAL*8 RMIN,RMAX,LITBL(1024) 00002560
INTEGER PTRS(45),TITLE(120),CRSET(39),OPER(9),SYM(15), 00002570
1SUBSC(6),TYPCT(20),EQCHN(80),TOKEN(80),CARD1(80),CARD2(80), 00002580
2ERROR(80),OBJCD(160),DEF(80),XREF(80),TMAP(80),FCTN(5,22), 00002590
3SYMTB(5,512) 00002600
INTEGER PSSWT,STYPE,EQNCD,PGMCD,DISK,PGMCT,OBJ1(80),OBJ2(80), 00002610
1OPTNS,STPGM,OUT1(80),OUT2(80),OUT3(80),LSTGP,CBIT,SYMND,OBJPT, 00002620
2CRSMT 00002630
COMMON RMIN,RMAX,PTRS,TITLE,CRSET,OPER,SYM,SUBSC,TYPCT, 00002640
1EQCHN,TOKEN,CARD1,CARD2,ERROR,OBJCD,DEF,XREF,TMAP,FCTN, 00002650
2SYMTB,LITBL 00002660
EQUIVALENCE (PSSWT,PTRS(10)),(STYPE,TOKEN(1)),(EQNCD,ERROR(1)), 00002670
1(PGMCD,PTRS(15)),(DISK,PTRS(3)),(PGMCT,PTRS(22)),(OBJ1(1),OBJPT, 00002680
2OBJCD(1)),(OBJ2(1),OBJCD(81)),(OPTNS,PTRS(7)),(STPGM,PTRS 00002690
3(21)),(OUT1(1),DEF(1)),(OUT2(1),XREF(1)),(OUT3(1),TMAP(1)), 00002700
4(LSTGP,PTRS(35)),(CBIT,TOKEN(2)),(SYMND,PTRS(17)),(CRSMT,TMAP(1)) 00002710
C 00002720
C 00002730
C IF THE PROGRAM IS TOO LARGE TO PROCESS, SIGNAL A SYSTEM ERROR. 00002740
C 00002750
C 00002760
IF((PGMCT-STPGM+1)/9.EQ.SYMND) CALL NDT12 (1) 00002770
1 CONTINUE 00002780
C 00002790
C 00002800
C INITIALIZE ALL STATEMENT DATA AREAS FOR PROCESSING. 00002810
C 00002820
C 00002830
CALL NDT05 00002840
GO TO (100,200,300,400,500),PSSWT 00002850
C 00002860
C 00002870
C TITLE MODE PROCESSING IS REQUESTED. IF A TITLE CARD IS 00002880
C SUPPLIED IT MUST BE THE FIRST CARD IN THE SOURCE DECK. 00002890
C WHETHER ONE IS SUPPLIED OR NOT THE TITLE PROCESSOR MUST 00002900
C BE CALLED TO INITIALIZE THE TITLE BUFFER. 00002910
C 00002920
C 00002930
100 CALL NDT06 00002940
C 00002950
C 00002960
C SET PSSWT TO PROCESS CONTROL CARDS. IF THE USER DID ENTER 00002970
C A TITLE CARD THEN PROCESSING FOR THIS STATEMENT IS FINISHED. 00002980
C IF IT WAS NOT A TITLE CARD NOR A CONTROL CARD THEN SET PSSWT 00002990
C TO PROCESS NORMAL CARD INPUT. OTHERWISE, PROCESS THE CONTROL 00003000
C CARD AND LEAVE PSSWT IN CONTROL CARD MODE. 00003010
C 00003020
C 00003030
PSSWT=2 00003040
IF(STYPE.EQ.19) GO TO 9000 00003050
200 IF(STYPE.NE.10) GO TO 600 00003060
C 00003070
C 00003080
C CONTROL CARD PROCESSING IS REQUESTED. IF THE CONTROL CARD 00003090
C WAS BLANK EQNCD WILL HAVE A VALUE OF 3. NO MODE CHANGE OR 00003100
C CARD PROCESSING WILL BE PERFORMED. 00003110
C 00003120
C 00003130
IF(EQNCD.EQ.3) GO TO 9000 00003140
CALL NDT07 00003150
GO TO 9000 00003160
C 00003170
C 00003180
C AS PSSWT CHANGES TO NORMAL MODE, NDT59 IS CALLED TO COMPLETE 00003190
C THE TITLE BUFFER AND TITLE RELATED INFORMATION. 00003200
C 00003210
C 00003220
600 PSSWT=3 00003230
CALL NDT59 00003240
C 00003250
C 00003260
C NORMAL SOURCE INPUT PROCESSING IS REQUESTED. THIS CONSISTS OF 00003270
C THE EQUATIONS FOR THE MODEL, OUTPUT CARDS, AND PARAMETER 00003280
C SPECIFICATIONS. 00003290
C 00003300
C 00003310
300 IF(EQNCD.EQ.3) GO TO 9000 00003320
GO TO (700,800,800,800,800,800,800,800,9000,1000, 00003330
1 9000,1100,1100,1200,1300,1400,1500,1600,1700,9000),STYPE 00003340
C 00003350
C 00003360
C INVOKE THE TABLE CARD PROCESSOR. 00003370
C 00003380
C 00003390
700 CALL NDT15 00003400
GO TO 900 00003410
C 00003420
C 00003430
C INVOKE THE EQUATION LEXICAL ANALYZER, THE EQUATION COMPILER, 00003440
C AND THE DEFAULT DEFINITION BUILDER. 00003450
C 00003460
C 00003470
800 CALL NDT08 00003480
CALL NDT16 00003490
900 CALL NDT17 00003500
C 00003510
C 00003520
C IF ANY CRITICAL ERRORS HAVE OCCURRED IN THE PROGRAM, EXECUTION 00003530
C WILL BE INHIBITED SO ONLY TABLE AND CONSTANT EQUATION OBJECT 00003540
C CODE NEED BE SAVED FOR RERUN CONTEXT PROCESSING. WRITE ALL 00003550
C EQUATION RELATED DATA AREAS TO DISK. 00003560
C 00003570
C 00003580
IF(PGMCD.EQ.3.AND.STYPE.GT.2) GO TO 910 00003590
WRITE(DISK'PGMCT+5) OBJ1 00003600
IF(OBJPT.GT.80) WRITE(DISK'PGMCT+6) OBJ2 00003610
910 WRITE(DISK'PGMCT+7) DEF 00003620
WRITE(DISK'PGMCT+9) TMAP 00003630
C 00003640
C 00003650
C ADD AN ELEMENT TO THE EQUATION CHAIN. THE FORMAT FOR EACH 00003660
C ELEMENT IS AS FOLLOWS: 00003670
C 00003680
C BIT 0 - RESERVED 00003690
C BITS 1 - 3 - EQUATION TYPE 00003700
C BITS 4 - 15 - DISK EQUATION NUMBER 00003710
C 00003720
C 00003730
CALL NDT21 ((STYPE-1)*4096+CRSMT) 00003740
GO TO 9000 00003750
C 00003760
C 00003770
C A CONTROL CARD WAS ENTERED BUT CONTROL CARD MODE WAS NOT 00003780
C IN EFFECT. PROCESS AS AN ERROR. 00003790
C 00003800
C 00003810
1000 CALL NDT14 (0,107,2) 00003820
GO TO 9000 00003830
C 00003840
C 00003850
C INVOKE THE OUTPUT CARD PROCESSOR AND STORE THE OUTPUT 00003860
C BUFFERS TO DISK. 00003870
C 00003880
C 00003890
1100 CALL NDT09 00003900
WRITE(DISK'PGMCT+7) OUT1 00003910
WRITE(DISK'PGMCT+8) OUT2 00003920
WRITE(DISK'PGMCT+9) OUT3 00003930
GO TO 9000 00003940
C 00003950
C 00003960
C THE FIRST RERUN CARD HAS BEEN ENCOUNTERED. SET PSSWT TO 00003970
C INDICATE RERUN MODE. 00003980
C 00003990
C 00004000
1200 PSSWT=5 00004010
GO TO 2500 00004020
C 00004030
C 00004040
C CHANGE PSSWT TO MACRO MODE AND INVOKE THE MACRO STATEMENT 00004050
C PROCESSOR. SAVE THE DISK ADDRESS OF THIS STATEMENT FOR 00004060
C ANY GROUP ERROR PROCESSING. 00004070
C 00004080
C 00004090
1300 PSSWT=4 00004100
CALL NDT10 00004110
LSTGP=PGMCT+1 00004120
GO TO 9000 00004130
C 00004140
C 00004150
C AN MEND STATEMENT WAS ENCOUNTERED BUT A MACRO WAS NOT BEING 00004160
C PROCESSED. 00004170
C 00004180
C 00004190
1400 CALL NDT14 (0,103,2) 00004200
GO TO 9000 00004210
C 00004220
C 00004230
C AN EXPANSION OF A MACRO HAS BEEN REQUESTED. SET PSSWT 00004240
C TO INDICATE THIS REQUEST AND RETURN SO THAT THE APPROPRIATE 00004250
C PROCESSOR MAY BE GIVEN CONTROL. 00004260
C 00004270
C 00004280
1500 PSSWT=6 00004290
GO TO 9000 00004300
C 00004310
C 00004320
C INVOKE THE DEF CARD PROCESSOR. 00004330
C 00004340
C 00004350
1600 CALL NDT11 00004360
GO TO 9000 00004370
C 00004380
C 00004390
C A TITLE CARD WAS ENCOUNTERED AS OTHER THAN THE FIRST CARD. 00004400
C 00004410
C 00004420
1700 CALL NDT14 (0,108,2) 00004430
GO TO 9000 00004440
C 00004450
C 00004460
C MACRO MODE IS IN PROGRESS. CARDS FOR THE GROUP ARE NOT 00004470
C PROCESSED, BUT ARE WRITTEN TO DISK. 00004480
C 00004490
C 00004500
400 GO TO (9000,9000,9000,9000,9000,9000,9000,9000,9000,9000, 00004510
1 9000,9000,9000,1800,1900,2000,2100,1600,1700,9000),STYPE 00004520
C 00004530
C 00004540
C RERUN MODE HAS BEEN REQUESTED, BUT A MACRO WAS BEING INPUT. 00004550
C 00004560
C 00004570
1800 CALL NDT14 (0,104,3) 00004580
GO TO 9000 00004590
C 00004600
C 00004610
C A MACRO STATEMENT WAS ENCOUNTERED BEFORE AN MEND FOR THE 00004620
C PREVIOUS MACRO GROUP. 00004630
C 00004640
C 00004650
1900 CALL NDT14 (0,109,3) 00004660
GO TO 9000 00004670
C 00004680
C 00004690
C AN MEND STATEMENT TERMINATES MACRO MODE. 00004700
C 00004710
C 00004720
2000 PSSWT=3 00004730
GO TO 9000 00004740
C 00004750
C 00004760
C A EXPND STATEMENT WAS ENCOUNTERED BEFORE AN MEND FOR THE 00004770
C MACRO THAT WAS BEING INPUT. 00004780
C 00004790
C 00004800
2100 CALL NDT14 (0,111,3) 00004810
GO TO 9000 00004820
C 00004830
C 00004840
C RERUN MODE IS IN PROGRESS. A BLANK CARD REQUIRES NO PROCESSING. 00004850
C 00004860
C 00004870
500 IF(EQNCD.EQ.3) GO TO 9000 00004880
GO TO (2300,2300,2300,2400,2400,2400,2400,2400,9000,2300, 00004890
1 9000,2400,2400,2500,2400,2400,2400,2400,1700,9000),STYPE 00004900
C 00004910
C 00004920
C A T, C, PARM, OR * CARD REQUIRES RERUN PROCESSING. 00004930
C 00004940
C 00004950
2300 CALL NDT19 00004960
GO TO 9000 00004970
C 00004980
C 00004990
C A CARD TYPE OTHER THAN T, C, PARM, OR * HAS APPEARED IN 00005000
C RERUN MODE AND CANNOT BE PROCESSED. 00005010
C 00005020
C 00005030
2400 CALL NDT14 (0,105,2) 00005040
GO TO 9000 00005050
C 00005060
C 00005070
C ANOTHER RERUN GROUP FOLLOWS. FINISH PROCESSING FOR THE PREVIOUS 00005080
C RERUN AND INITIALIZE BUFFERS FOR THIS RERUN. SET THE GROUP 00005090
C DISK ADDRESS. 00005100
C 00005110
C 00005120
2500 CALL NDT18 00005130
LSTGP=PGMCT+1 00005140
C 00005150
C 00005160
C WRITE THE REQUIRED DATA AREAS TO DISK AND INCREMENT THE 00005170
C PROGRAM COUNTER TO POINT TO THE LAST RECORD USED. 00005180
C 00005190
C 00005200
9000 WRITE(DISK'PGMCT+1) TOKEN 00005210
WRITE(DISK'PGMCT+2) CARD1 00005220
IF(CBIT.EQ.1) WRITE(DISK'PGMCT+3) CARD2 00005230
WRITE(DISK'PGMCT+4) ERROR 00005240
PGMCT=PGMCT+9 00005250
RETURN 00005260
END 00005310
C***************************************************************** 00005320
C * 00005330
C COPYRIGHT (C) 1978 - UNIVERSITY OF NOTRE DAME * 00005340
C PROGRAM AUTHOR - THOMAS L EVERMAN JR * 00005350
C * 00005360
C THIS SUBROUTINE EXPANDS MACROS * 00005370
C * 00005380
C***************************************************************** 00005390
SUBROUTINE NDT02 00005400
REAL*8 RMIN,RMAX,LITBL(1024) 00005410
INTEGER PTRS(45),TITLE(120),CRSET(39),OPER(9),SYM(15), 00005420
1SUBSC(6),TYPCT(20),EQCHN(80),TOKEN(80),CARD1(80),CARD2(80), 00005430
2ERROR(80),OBJCD(160),DEF(80),XREF(80),TMAP(80),FCTN(5,22), 00005440
3SYMTB(5,512) 00005450
INTEGER MACBF(160),MAC1(80),MAC2(80),SUBCD(80),CARD(80,2), 00005460
1SUBFD(78),EXPBF(160),EXP1(80),EXP2(80),TEXP(160),SCD2(80), 00005470
2PSSWT,MCEXP,DISP,DUPFG,REC,ARGIG,ARGPS,I,J,MCARG(144), 00005480
3EXARG(144),FIELD(4),NXTCD,BLANK,CBIT,ARGEG,STYPE,MEND(5), 00005490
4TYPE,INDEX,CDNUM,BLFND,POS,ARGT,LENTH,CHAR,SSPOS,SCBIT, 00005500
5SUBS,DISK,CDPOS,START,PGMCT 00005510
COMMON RMIN,RMAX,PTRS,TITLE,CRSET,OPER,SYM,SUBSC,TYPCT, 00005520
1EQCHN,TOKEN,CARD1,CARD2,ERROR,OBJCD,DEF,XREF,TMAP,FCTN, 00005530
2SYMTB,LITBL 00005540
EQUIVALENCE (MACBF(1),MAC1(1)),(MACBF(81),MAC2(1)), 00005550
1(EXPBF(1),EXP1(1)),(EXPBF(81),EXP2(1)),(TEXP(1),DEF(1)), 00005560
2(MCARG(1),MACBF(14)),(EXARG(1),EXPBF(14)),(SUBFD(1),TOKEN(3)), 00005570
3(FIELD(1),SUBFD(1)),(PSSWT,PTRS(10)),(MCEXP,PTRS(39)), 00005580
4(CARD(1,1),CARD1(1)),(ARGIG,MACBF(13)),(ARGEG,MACBF(10)), 00005590
5(STYPE,TOKEN(1)),(CBIT,TOKEN(2)),(BLANK,CRSET(1)),(DISK,PTRS(3)) 00005600
EQUIVALENCE (PGMCT,PTRS(22)) 00005610
DATA MEND /'M','E','N','D',' '/ 00005620
C***************************************************************** 00005630
C * 00005640
C SET THE PSSWT TO 3 FOR USE BY NDT01. ASSUME U-D MACRO AND * 00005650
C SET DISP TO 8. INCREMENT THE EXPANSION COUNTER. DUPFG IS * 00005660
C ZERO SO THAT NDT39 DOES NOT CHECK FOR DUPLICATE ARGUMENTS. * 00005670
C THE CONTENTS OF CARD2 ARE SAVED AND RESTORED AT END OF EXPA* 00005680
C NDT39 IS CALLED TO FORM THE EXPANSION DEFINITION BUFFER. * 00005690
C * 00005700
C***************************************************************** 00005710
PSSWT = 3 00005720
DISP = 8 00005730
MCEXP = MCEXP + 1 00005740
DUPFG = 0 00005750
DO 100 I = 1, 80 00005760
100 SCD2(I) = CARD2(I) 00005770
SCBIT = CBIT 00005780
CALL NDT39 (REC, DUPFG) 00005790
C***************************************************************** 00005800
C * 00005810
C IF REC IS ZERO, THE MACRO NAME WAS NEVER DEFINED. * 00005820
C OTHERWISE, REC GIVES THE RECORD NUMBER OF THE MACRO * 00005830
C DEFINITION RECORD. BOTH THE MACRO AND EXPAND DEFINITIONS * 00005840
C ARE CHECKED FOR CRITICAL ERRORS. A CHECK IS ALSO MADE TO * 00005850
C SEE THAT BOTH THE EXPAND AND MACRO DEFINITIONS REFER TO * 00005860
C THE SAME NUMBER OF ARGUMENTS. * 00005870
C * 00005880
C***************************************************************** 00005890
IF (REC .EQ. 0) GO TO 3200 00005900
DO 150 I = 1, 160 00005910
150 EXPBF(I) = TEXP(I) 00005920
READ (DISK'REC) MAC1 00005930
REC = REC + 1 00005940
READ (DISK'REC) MAC2 00005950
NXTCD = MACBF(11) 00005960
IF (MACBF(12) .NE. 0 .OR. EXPBF(12) .NE. 0) GO TO 3400 00005970
IF (ARGEG .NE. EXPBF(10)) GO TO 3300 00005980
WRITE(DISK'PGMCT-5) ERROR 00005990
IF (ARGIG .EQ. 0) GO TO 500 00006000
C***************************************************************** 00006010
C * 00006020
C INSERT THE INTERNALLY GENERATED ARGUMENT NAMES INTO THE * 00006030
C EXPBF. COPY THE DUMMY NAMES FROM MACBF, ADDING THE CHARACT* 00006040
C REPRESENTATION OF THE EXPAND COUNTER TO KEEP THE NAME UNIQU* 00006050
C * 00006060
C***************************************************************** 00006070
DISP = 1 00006080
ARGPS = ARGEG * 8 00006090
DO 400 I = 1, ARGIG 00006100
DO 200 J = 1, 3 00006110
ARGPS = ARGPS + 1 00006120
200 EXARG(ARGPS) = MCARG(ARGPS) 00006130
CALL NDT45 (MCEXP, FIELD, 0) 00006140
DO 300 J = 1,4 00006150
ARGPS = ARGPS + 1 00006160
300 EXARG(ARGPS) = FIELD(J) 00006170
ARGPS = ARGPS + 1 00006180
400 CONTINUE 00006190
C***************************************************************** 00006200
C * 00006210
C ARGT IS THE TOTAL NUMBER OF ARGUMENTS. IT IS NOW NECESSARY* 00006220
C TO READ IN THE CARDS TO BE EXPANDED. THE NEXT CARD (FROM DI* 00006230
C TO BE READ IS POINTED TO BY NXTCD. IF A U-D MACRO IS * 00006240
C BEING EXPANDED, IT IS NECESSARY TO READ A CARD, ITS * 00006250
C TOKEN STRING TO DETERMINE WHETHER THAT CARD IS CONTINUED, * 00006260
C AND ITS CONTINUATION IF IT EXISTS. FOR B-I MACROS, THERE * 00006270
C ARE NO CONTINUATIONS AND NO TOKEN STRING. HENCE, A SEPARAT* 00006280
C CHECK MUST BE MADE FOR THE MEND STATEMENT * 00006290
C * 00006300
C***************************************************************** 00006310
500 ARGT = ARGEG + ARGIG 00006320
510 READ (DISK'NXTCD) CARD1 00006330
IF (DISP .EQ. 1) GO TO 600 00006340
REC = NXTCD - 1 00006350
READ (DISK'REC) TOKEN 00006360
NXTCD = NXTCD + 1 00006370
CARD2(1) = 0 00006380
IF (CBIT .EQ. 0) GO TO 800 00006390
READ (DISK'NXTCD) CARD2 00006400
GO TO 800 00006410
600 CARD2(1) = 0 00006420
CBIT = 0 00006430
STYPE = 1 00006440
DO 700 I = 1, 5 00006450
IF (CARD1(I) .NE. MEND(I)) GO TO 800 00006460
700 CONTINUE 00006470
STYPE = 16 00006480
C***************************************************************** 00006490
C * 00006500
C INCREMENT NXTCD TO POINT TO THE NEXT MACRO STATEMENT. * 00006510
C CHECK FOR END OF EXPANSION, WHICH MAY BE INDICATED BY * 00006520
C A MEND CARD, OR IGNORE RERUN, MACRO, EXPND. * 00006530
C * 00006540
C***************************************************************** 00006550
800 NXTCD = NXTCD + DISP 00006560
DO 900 TYPE = 14, 17 00006570
INDEX = TYPE - 13 00006580
IF (STYPE .EQ. TYPE) GO TO (510,510,3100,510), INDEX 00006590
900 CONTINUE 00006600
C***************************************************************** 00006610
C * 00006620
C INITIALIZE FOR SYMBOLIC SUBSTITION (SS). CDNUM INDICATES * 00006630
C EITHER CARD1 OR CARD2. SSPOS IS A POINTER FOR ENTERING * 00006640
C A SS INTO SUBCD. BLFND WILL GIVE THE LAST POSITION IN * 00006650
C THE COMMENT FIELD. START IS A POINTER FOR THE OPERATOR * 00006660
C SEARCH SUBROUTINE (NDT29). * 00006670
C * 00006680
C***************************************************************** 00006690
CDNUM = 1 00006700
950 START = 1 00006710
DO 975 I = 1, 80 00006720
975 SUBCD(I) = BLANK 00006730
SSPOS = 0 00006740
BLFND = 0 00006750
C***************************************************************** 00006760
C * 00006770
C COPY THE EQUATION TYPES AND INITIAL BLANKS INTO SUBCD. * 00006780
C * 00006790
C***************************************************************** 00006800
DO 1000 START = 1, 72 00006810
IF (CARD(START,CDNUM) .EQ. BLANK) BLFND = 1 00006820
IF (CARD(START,CDNUM) .NE. BLANK .AND. BLFND .NE. 0) GO TO 1100 00006830
SSPOS = SSPOS + 1 00006840
SUBCD(SSPOS) = CARD(START,CDNUM) 00006850
1000 CONTINUE 00006860
GO TO 2700 00006870
C***************************************************************** 00006880
C * 00006890
C SEARCH FOR AN OPERATOR. WHEN ONE IS FOUND, CHECK THE PRECE* 00006900
C SUBSTRING TO SEE WHETHER IT COMPARES TO ANY OF THE MACRO * 00006910
C ARGUMENTS. IF IT DOES, PLACE THE EXPND ARGUMENT INTO SUBFD* 00006920
C OTHERWISE, LEAVE THE CARD IMAGE DATA IN SUBFD. ALSO PLACE * 00006930
C THE TRAILING OPERATOR IN SUBFD TO INSURE ITS ADDITION TO SU* 00006940
C * 00006950
C***************************************************************** 00006960
1100 SUBS = 0 00006970
BLFND = 0 00006980
1150 CALL NDT29 (TYPE, START, POS, CDNUM) 00006990
IF (POS .LT. START) GO TO 1700 00007000
IF (SUBS .EQ. 1) GO TO 1800 00007010
IF (TYPE .EQ. 1) SUBS = 1 00007020
LENTH = POS - START + 1 00007030
DO 1300 I = 1, ARGT 00007040
ARGPS = I * 8 - 8 00007050
DO 1200 J = 1, LENTH 00007060
ARGPS = ARGPS + 1 00007070
CDPOS = START + J - 1 00007080
CHAR = CARD(CDPOS,CDNUM) 00007090
IF (CHAR .NE. MCARG(ARGPS)) GO TO 1300 00007100
1200 CONTINUE 00007110
ARGPS = ARGPS + 1 00007120
IF (MCARG(ARGPS) .NE. BLANK) GO TO 1300 00007130
GO TO 1400 00007140
1300 CONTINUE 00007150
LENTH = LENTH + 1 00007160
DO 1350 J = START, POS 00007170
I = J - START + 1 00007180
1350 SUBFD(I) = CARD(J,CDNUM) 00007190
GO TO 1600 00007200
1400 ARGPS = (I - 1) * 8 00007210
DO 1500 LENTH = 1, 7 00007220
ARGPS = ARGPS + 1 00007230
IF (EXARG(ARGPS) .EQ. BLANK) GO TO 1600 00007240
1500 SUBFD(LENTH) = EXARG(ARGPS) 00007250
1600 SUBFD(LENTH) = CARD(POS + 1,CDNUM) 00007260
GO TO 2000 00007270
C***************************************************************** 00007280
C * 00007290
C CONSECUTIVE OPERATORS WERE FOUND. INSERT SECOND INTO * 00007300
C SUBFD AND MAKE SS. * 00007310
C * 00007320
C***************************************************************** 00007330
1700 LENTH = 1 00007340
SUBFD(1) = CARD(START,CDNUM) 00007350
GO TO 2000 00007360
C***************************************************************** 00007370
C * 00007380
C THE CODING BELOW AVOIDS CHECKING FOR A SYMBOLIC SUBSTITUTIO* 00007390
C IN A SUBSCRIPT. * 00007400
C * 00007410
C***************************************************************** 00007420
1800 LENTH = POS - START + 2 00007430
DO 1900 I = 1, LENTH 00007440
CDPOS = START + I - 1 00007450
1900 SUBFD(I) = CARD(CDPOS,CDNUM) 00007460
IF (TYPE .NE. 1) SUBS = 0 00007470
C***************************************************************** 00007480
C * 00007490
C MOVE SUBFD TO SUBCD. CHECK FOR EXCESS LENGTH OF EXPANSION.* 00007500
C * 00007510
C***************************************************************** 00007520
2000 DO 2100 I = 1, LENTH 00007530
SSPOS = SSPOS + 1 00007540
IF (SSPOS .GT. 72) GO TO 2600 00007550
2100 SUBCD(SSPOS) = SUBFD(I) 00007560
IF (BLFND .NE. 0) GO TO 2400 00007570
IF (TYPE .NE. 0) GO TO 2500 00007580
C***************************************************************** 00007590
C * 00007600
C BLANK DELIMITING END OF STATEMENT HAS BEEN FOUND. LOCATE * 00007610
C THE END OF THE COMMENT FIELD AND SET BLFND. * 00007620
C * 00007630
C***************************************************************** 00007640
DO 2200 I = 1, 72 00007650
J = 73 - I 00007660
IF (CARD(J,CDNUM) .NE. BLANK) GO TO 2300 00007670
2200 CONTINUE 00007680
2300 BLFND = J 00007690
C***************************************************************** 00007700
C * 00007710
C CHECK TO SEE IF ENTIRE COMMENT HAS BEEN COPIED. IF NOT, * 00007720
C CHECK FOR MORE SS'S. * 00007730
C * 00007740
C***************************************************************** 00007750
2400 IF (START .GE. BLFND) GO TO 2700 00007760
2500 START = POS + 2 00007770
GO TO 1150 00007780
C***************************************************************** 00007790
C * 00007800
C GIVE EXCESS LENGTH ERRORS. * 00007810
C 312 - EQUATION TO LONG * 00007820
C 315 - COMMENT TOO LONG * 00007830
C COPY SUBCD INTO THE APPROPRIATE CARD BUFFER, * 00007840
C THEN CHECK TO SEE IF THERE IS A CONINUATION TO EXPAND. * 00007850
C * 00007860
C***************************************************************** 00007870
2600 IF (BLFND .EQ. 0) CALL NDT13 (72, 312, 3) 00007880
IF (BLFND .NE. 0) CALL NDT13 (72, 315, 1) 00007890
2700 DO 2750 I = 1, 80 00007900
2750 CARD(I,CDNUM) = SUBCD(I) 00007910
IF (CDNUM .EQ. 2 .OR. CBIT .EQ. 0) GO TO 2800 00007920
CDNUM = 2 00007930
GO TO 950 00007940
C***************************************************************** 00007950
C * 00007960
C EXPANSION OF A CARD IS COMPLETE. CALL NDT01 FOR FURTHER * 00007970
C ANALYSIS. THEN PROCESS ANOTHER CARD. * 00007980
C * 00007990
C***************************************************************** 00008000
2800 CALL NDT01 00008010
GO TO 510 00008020
C***************************************************************** 00008030
C * 00008040
C MEND STATEMENT HAS BEEN ENCOUNTERED. * 00008050
C UPDATE PSSWT AND CALL NDT01. * 00008060
C BRANCH TO FINAL PROCESSING. * 00008070
C * 00008080
C***************************************************************** 00008090
3100 PSSWT = 4 00008100
CALL NDT01 00008110
GO TO 3500 00008120
C***************************************************************** 00008130
C * 00008140
C ERROR MESSAGES: * 00008150
C 310 - NO MACRO DEFINITION * 00008160
C 311 - UNEQUAL NUMBER OF ARGUMENTS * 00008170
C 316 - UNABLE TO EXPAND DUE TO MACRO OR EXPAND CRITICALS * 00008180
C * 00008190
C***************************************************************** 00008200
3200 CALL NDT13 (1, 310, 3) 00008210
GO TO 3400 00008220
3300 CALL NDT13 (1, 311, 3) 00008230
3400 CALL NDT13 (0, 316, 3) 00008240
DO 3450 I = 1, 5 00008250
3450 CARD1(I) = MEND(I) 00008260
CARD2(1) = 0 00008270
GO TO 3100 00008280
C***************************************************************** 00008290
C * 00008300
C RECOPY CARD2 FROM SCD2, RESTORE CBIT, AND RETURN * 00008310
C * 00008320
C***************************************************************** 00008330
3500 DO 3600 I = 1, 80 00008340
3600 CARD2(I) = SCD2(I) 00008350
CBIT = SCBIT 00008360
RETURN 00008370
END 00008390
C***************************************************************** 00008400
C * 00008410
C COPYRIGHT 1978 - UNIVERSITY OF NOTRE DAME * 00008420
C WRITTEN BY THOMAS L EVERMAN JR * 00008430
C * 00008440
C***************************************************************** 00008450
SUBROUTINE NDT03 00008460
C***************************************************************** 00008470
C * 00008480
C THIS PROGRAM LOADS THE BUILT-IN MACRO STATEMENTS,DEFINITION* 00008490
C AND THE MACRO DEFINITION TABLE (MDT). IT ALSO LOADS THE FU* 00008500
C TABLE AS WELL AS PARAMETERS INTO THE SYMBOL TABLE. * 00008510
C * 00008520
C***************************************************************** 00008530
REAL*8 RMIN,RMAX,LITBL(1024) 00008540
INTEGER PTRS(45),TITLE(120),CRSET(39),OPER(9),SYM(15), 00008550
1SUBSC(6),TYPCT(20),EQCHN(80),TOKEN(80),CARD1(80),CARD2(80), 00008560
2ERROR(80),OBJCD(160),DEF(80),XREF(80),TMAP(80),FCTN(5,22), 00008570
3SYMTB(5,512) 00008580
INTEGER SM1(30),SM2(10),SM3(14),SM4(13),SM5(5) 00008590
INTEGER D11(23),D12(25),D13(8),D14(12),D15(5) 00008600
INTEGER D31(27),D32(25),D33(8),D34(29),D35(25) 00008610
INTEGER D36(8),D37(29),D38(25),D39(8),D40(12),D41(5) 00008620
INTEGER DY1(30),DY2(12),DY3(21),DY4(32),DY5(12) 00008630
INTEGER DY6(21),DY7(30),DY8(12),DY9(19),DY0(5) 00008640
INTEGER Y11(28),Y12(10),Y13(17),Y14(5) 00008650
INTEGER BIM1(31),C11(18),C12 00008660
INTEGER BIM2(31),C21(18),C22 00008670
INTEGER BIM3(31),C31(20),C32(26),C33(5) 00008680
INTEGER BIM4(31),C41(20),C42(23) 00008690
INTEGER BIM5(31),C51(11) 00008700
INTEGER MCREC(80) 00008710
INTEGER B(898) 00008720
INTEGER I,J,SYMPT,REC,BLANK,DISK,POS 00008730
INTEGER FUN01(5),FUN02(5),FUN03(5),FUN04(5),FUN05(5) 00008740
INTEGER FUN06(5),FUN07(5),FUN08(5),FUN09(5),FUN10(5) 00008750
INTEGER FUN11(5),FUN12(5),FUN13(5),FUN14(5),FUN15(5) 00008760
INTEGER FUN16(5),FUN17(5),FUN18(5),FUN19(5),FUN20(5) 00008770
INTEGER FUN21(5),FUN22(5),FUNS(110) 00008780
INTEGER PARM1(2),PARM2(2),PARM3(2),PARM4(2),PARM5(2) 00008790
INTEGER PARM6(2),PARMS(2,6) 00008800
INTEGER MDT(3,53),MDTL,MDT1(3),MDT2(3),MDT3(3),MDT4(3),MDT5(3) 00008810
INTEGER MDTT(160),MDTT1(80),MDTT2(80) 00008820
INTEGER FUNEQ(110),VTYPE,INTBT,DEFBT,VNUM,VALCT,SYMND 00008830
COMMON RMIN,RMAX,PTRS,TITLE,CRSET,OPER,SYM,SUBSC,TYPCT, 00008840
1EQCHN,TOKEN,CARD1,CARD2,ERROR,OBJCD,DEF,XREF,TMAP,FCTN, 00008850
2SYMTB,LITBL 00008860
C***************************************************************** 00008870
C * 00008880
C THE EQUIVALENCE STATEMENTS BELOW ENTER DATA FOR THE BUILT-I* 00008890
C MACROS INTO A LARGE ARRAY FROM WHICH DATA IS TAKEN TO FORM * 00008900
C THE DISK RECORDS. * 00008910
C * 00008920
C***************************************************************** 00008930
EQUIVALENCE (SM1(1),B(1)),(SM2(1),B(31)),(SM3(1),B(41)) 00008940
EQUIVALENCE (SM4(1),B(55)),(SM5(1),B(68)) 00008950
EQUIVALENCE (D11(1),B(73)),(D12(1),B(96)),(D13(1),B(121)) 00008960
EQUIVALENCE (D14(1),B(129)),(D15(1),B(141)) 00008970
EQUIVALENCE (D31(1),B(146)),(D32(1),B(173)),(D33(1),B(198)) 00008980
EQUIVALENCE (D34(1),B(206)),(D35(1),B(235)),(D36(1),B(260)) 00008990
EQUIVALENCE (D37(1),B(268)),(D38(1),B(297)),(D39(1),B(322)) 00009000
EQUIVALENCE (D40(1),B(330)),(D41(1),B(342)) 00009010
EQUIVALENCE (DY1(1),B(347)),(DY2(1),B(377)),(DY3(1),B(389)) 00009020
EQUIVALENCE (DY4(1),B(410)),(DY5(1),B(442)),(DY6(1),B(454)) 00009030
EQUIVALENCE (DY7(1),B(475)),(DY8(1),B(505)),(DY9(1),B(517)) 00009040
EQUIVALENCE (DY0(1),B(536)) 00009050
EQUIVALENCE (Y11(1),B(541)),(Y12(1),B(569)) 00009060
EQUIVALENCE (Y13(1),B(579)),(Y14(1),B(596)) 00009070
EQUIVALENCE (BIM1(1),B(601)),(C11(1),B(632)),(C12,B(650)) 00009080
EQUIVALENCE (BIM2(1),B(651)),(C21(1),B(682)),(C22,B(700)) 00009090
EQUIVALENCE (BIM3(1),B(701)),(C31(1),B(732)),(C32(1),B(752)) 00009100
EQUIVALENCE (C33(1),B(778)) 00009110
EQUIVALENCE (BIM4(1),B(783)),(C41(1),B(814)),(C42(1),B(834)) 00009120
EQUIVALENCE (BIM5(1),B(857)),(C51(1),B(888)) 00009130
EQUIVALENCE (MCREC(1),TOKEN(1)),(BLANK,CRSET(1)),(VTYPE,SYM(7)) 00009140
EQUIVALENCE (INTBT,SYM(13)),(DEFBT,SYM(11)),(VNUM,SYM(14)) 00009150
EQUIVALENCE (DISK,PTRS(3)),(STPGM,PTRS(21)),(VALCT,PTRS(20)) 00009160
EQUIVALENCE (SYMND,PTRS(17)) 00009170
C***************************************************************** 00009180
C * 00009190
C THE STATEMENTS BELOW PLACE INDIVIDUAL FUNCTION TABLE ENTRIE* 00009200
C AND SYMBOL TABLE ENTRIES FOR PARAMETERS INTO LARGER ARRAYS.* 00009210
C THE SAME OPERATION IS PERFORMED FOR THE MDT. * 00009220
C * 00009230
C***************************************************************** 00009240
EQUIVALENCE (FUN01(1),FUNS(1)),(FUN02(1),FUNS(6)) 00009250
EQUIVALENCE (FUN03(1),FUNS(11)),(FUN04(1),FUNS(16)), 00009260
1(FUN05(1),FUNS(21)),(FUN06(1),FUNS(26)),(FUN07(1),FUNS(31)), 00009270
2(FUN08(1),FUNS(36)),(FUN09(1),FUNS(41)),(FUN10(1),FUNS(46)), 00009280
3(FUN11(1),FUNS(51)),(FUN12(1),FUNS(56)),(FUN13(1),FUNS(61)), 00009290
4(FUN14(1),FUNS(66)),(FUN15(1),FUNS(71)),(FUN16(1),FUNS(76)), 00009300
5(FUN17(1),FUNS(81)),(FUN18(1),FUNS(86)),(FUN19(1),FUNS(91)) 00009310
EQUIVALENCE (FUN20(1),FUNS(96)),(FUN21(1),FUNS(101)), 00009320
1(FUN22(1),FUNS(106)) 00009330
EQUIVALENCE (PARM1(1),PARMS(1,1)),(PARM2(1),PARMS(1,2)), 00009340
1(PARM3(1),PARMS(1,3)),(PARM4(1),PARMS(1,4)), 00009350
2(PARM5(1),PARMS(1,5)),(PARM6(1),PARMS(1,6)) 00009360
EQUIVALENCE (MDTL,MDTT(1)),(MDT(1,1),MDTT(2)), 00009370
1(MDTT(1),MDTT1(1)),(MDTT(81),MDTT2(1)) 00009380
EQUIVALENCE (MDT1(1),MDT(1,1)),(MDT2(1),MDT(1,2)), 00009390
1(MDT3(1),MDT(1,3)),(MDT4(1),MDT(1,4)),(MDT5(1),MDT(1,5)) 00009400
EQUIVALENCE (FCTN(1,1),FUNEQ(1)) 00009410
C***************************************************************** 00009420
C * 00009430
C THE DATA STATEMENTS BELOW ARE FOR THE FUNCTION TABLE ENTRIE* 00009440
C THE FORMAT IS AS FOLLOWS: * 00009450
C 1 & 2 - PACKED REPRESENTATION OF FUNCTION NAME. * 00009460
C 3 - OP CODE FOR THE FUNCTION. * 00009470
C 4 - NUMBER OF ARGUMENTS TO THE FUNCTION. * 00009480
C 5 - NUMBER OF SAVE AREAS REQUIRED BY THE FUNCTION. * 00009490
C THE FUNCTIONS ARE REPRESENTED IN THE FOLLOWING ORDER: * 00009500
C 1 - ABS 9 - MIN 16 - SQRT * 00009510
C 2 - CLIP 10 - NOISE 17 - STEP * 00009520
C 3 - COS 11 - NORMRN 18 - SWITCH * 00009530
C 4 - DELAY 12 - PULSE 19 - TABFL * 00009540
C 5 - EXP 13 - RAMP 20 - TABHL * 00009550
C 6 - INTGRL 14 - SAMPLE 21 - TABLE * 00009560
C 7 - LOG 15 - SIN 22 - TABND * 00009570
C 8 - MAX * 00009580
C * 00009590
C***************************************************************** 00009600
DATA FUN01 /-24159,-28899,17,1,0/ 00009610
DATA FUN02 /-20737,-1521,18,4,0/ 00009620
DATA FUN03 /-20610,-28899,19,1,0/ 00009630
DATA FUN04 /-19486,-23283,20,2,1/ 00009640
DATA FUN05 /-17220,-28899,21,1,0/ 00009650
DATA FUN06 /-11522,-14416,16,1,7/ 00009660
DATA FUN07 /-6933,-28899,22,1,0/ 00009670
DATA FUN08 /-5941,-28899,23,2,0/ 00009680
DATA FUN09 /-5639,-28899,24,2,0/ 00009690
DATA FUN10 /-3889,3315,25,1,1/ 00009700
DATA FUN11 /-3880,-5288,26,3,1/ 00009710
DATA FUN12 /-610,3315,27,4,2/ 00009720
DATA FUN13 /1653,-1521,28,2,8/ 00009730
DATA FUN14 /3174,-968,29,2,2/ 00009740
DATA FUN15 /3487,-28899,30,1,0/ 00009750
DATA FUN16 /3803,4563,31,1,0/ 00009760
DATA FUN17 /3907,-1521,32,2,0/ 00009770
DATA FUN18 /4028,4768,33,3,0/ 00009780
DATA FUN19 /4684,-16185,34,4,0/ 00009790
DATA FUN20 /4684,-13143,35,5,0/ 00009800
DATA FUN21 /4684,-7332,36,4,0/ 00009810
DATA FUN22 /4684,-4329,37,4,0/ 00009820
C***************************************************************** 00009830
C * 00009840
C THE FOLLOWING DATA IS FOR THE MDT ENTRIES FOR THE BUILT-IN * 00009850
C MACROS. THE FORMAT IS AS FOLLOWS: * 00009860
C 1 & 2 - PACKED REPRESENTATION OF MACRO NAMES. * 00009870
C 3 - POINTER TO FILE RECORD CONTAINING MACRO DEFINITIO* 00009880
C THE SEQUENCE IS AS FOLLOWS: * 00009890
C 1 - SMOOTH 3 - DLINF3 5 - DELAY1 * 00009900
C 2 - DLINF1 4 - DELAY3 * 00009910
C * 00009920
C***************************************************************** 00009930
DATA MDT1 /3644,-2174,88/ 00009940
DATA MDT2 /-19216,-4221,90/ 00009950
DATA MDT3 /-19216,-4219,92/ 00009960
DATA MDT4 /-19486,-23251,94/ 00009970
DATA MDT5 /-19486,-23253,96/ 00009980
DATA MDTL /5/ 00009990
C***************************************************************** 00010000
C * 00010010
C THE FOLLOWING DATA DEFINES THE STATEMENTS WHICH ARE EXPANDE* 00010020
C TO FORM THE SMOOTH MACRO. * 00010030
C * 00010040
C***************************************************************** 00010050
DATA SM1/'L',' ','$','L','1','.','K','=','I','N','T','G','R','L', 00010060
1'(','B','.','J','K','-','$','R','1','.','J','K',')',' ',' ',100/ 00010070
DATA SM2/'N',' ','$','L','1','=','B','*','C',100/ 00010080
DATA SM3/'A',' ','A','.','K','=','$','L','1','.','K','/','C',100/ 00010090
DATA SM4/'R',' ','$','R','1','.','K','L','=','A','.','K',100/ 00010100
DATA SM5/'M','E','N','D',100/ 00010110
C***************************************************************** 00010120
C * 00010130
C THE FOLLOWING DATA DEFINES THE STATEMENTS * 00010140
C WHICH ARE EXPANDED TO FORM THE DLINF1 MACRO. * 00010150
C * 00010160
C***************************************************************** 00010170
DATA D11/'R',' ','$','R','1','.','K','L','=','(','B','.','K','-', 00010180
1'$','L','1','.','K',')','/','C',100/ 00010190
DATA D12/'L',' ','$','L','1','.','K','=','I','N','T','G','R', 00010200
1'L','(','$','R','1','.','J','K',')',' ',' ',100/ 00010210
DATA D13/'N',' ','$','L','1','=','B',100/ 00010220
DATA D14/'A',' ','A','.','K','=','$','L','1','.','K',100/ 00010230
DATA D15/'M','E','N','D',100/ 00010240
C***************************************************************** 00010250
C * 00010260
C THE FOLLOWING DATA DEFINES THE STATEMENTS * 00010270
C WHICH ARE EXPANDED TO FORM THE DLINF3 MACRO * 00010280
C * 00010290
C***************************************************************** 00010300
DATA D31/'R',' ','$','R','1','.','K','L','=','(','B','.','K','-', 00010310
1'$','L','1','.','K',')','/','(','C','/','3',')',100/ 00010320
DATA D32/'L',' ','$','L','1','.','K','=','I','N','T','G','R', 00010330
1'L','(','$','R','1','.','J','K',')',' ',' ',100/ 00010340
DATA D33/'N',' ','$','L','1','=','B',100/ 00010350
DATA D34/'R',' ','$','R','2','.','K','L','=','(','$','L','1','.', 00010360
1'K','-','$','L','2','.','K',')','/','(','C','/','3',')',100/ 00010370
DATA D35/'L',' ','$','L','2','.','K','=','I','N','T','G','R', 00010380
1'L','(','$','R','2','.','J','K',')',' ',' ',100/ 00010390
DATA D36/'N',' ','$','L','2','=','B',100/ 00010400
DATA D37/'R',' ','$','R','3','.','K','L','=','(','$','L','2','.', 00010410
1'K','-','$','L','3','.','K',')','/','(','C','/','3',')',100/ 00010420
DATA D38/'L',' ','$','L','3','.','K','=','I','N','T','G','R', 00010430
1'L','(','$','R','3','.','J','K',')',' ',' ',100/ 00010440
DATA D39/'N',' ','$','L','3','=','B',100/ 00010450
DATA D40/'A',' ','A','.','K','=','$','L','3','.','K',100/ 00010460
DATA D41/'M','E','N','D',100/ 00010470
C***************************************************************** 00010480
C * 00010490
C THE FOLLOWING DATA DEFINES THE STATEMENTS * 00010500
C WHICH ARE EXPANDED TO FORM THE DELAY3 MACRO * 00010510
C * 00010520
C***************************************************************** 00010530
DATA DY1/'L',' ','$','L','1','.','K','=','I','N','T','G','R','L', 00010540
1'(','B','.','J','K','-','$','R','1','.','J','K',')',' ',' ',100/ 00010550
DATA DY2/'N',' ','$','L','1','=','B','*','C','/','3',100/ 00010560
DATA DY3/'R',' ','$','R','1','.','K','L','=','$','L','1','.','K', 00010570
1'/','(','C','/','3',')',100/ 00010580
DATA DY4/'L',' ','$','L','2','.','K','=','I','N','T','G','R', 00010590
1'L','(','$','R','1','.','J','K','-','$','R','2','.','J','K', 00010600
2')',' ',' ',100/ 00010610
DATA DY5/'N',' ','$','L','2','=','B','*','C','/','3',100/ 00010620
DATA DY6/'R',' ','$','R','2','.','K','L','=','$','L','2','.','K', 00010630
1'/','(','C','/','3',')',100/ 00010640
DATA DY7/'L',' ','$','L','3','.','K','=','I','N','T','G','R','L', 00010650
1'(','$','R','2','.','J','K','-','A','.','J','K',')',' ',' ',100/ 00010660
DATA DY8/'N',' ','$','L','3','=','B','*','C','/','3',100/ 00010670
DATA DY9/'R',' ','A','.','K','L','=','$','L','3','.','K','/','(', 00010680
1'C','/','3',')',100/ 00010690
DATA DY0/'M','E','N','D',100/ 00010700
C***************************************************************** 00010710
C * 00010720
C THE FOLLOWING DATA DEFINES THE STATEMENTS * 00010730
C WHICH ARE EXPANDED TO FORM THE DELAY1 MACRO. * 00010740
C * 00010750
C***************************************************************** 00010760
DATA Y11/'L',' ','$','L','1','.','K','=','I','N','T','G','R', 00010770
1'L','(','B','.','J','K','-','A','.','J','K',')',' ',' ',100/ 00010780
DATA Y12/'N',' ','$','L','1','=','B','*','C',100/ 00010790
DATA Y13/'R',' ','A','.','K','L','=','$','L','1','.','K','/','C', 00010800
1' ',' ',100/ 00010810
DATA Y14/'M','E','N','D',100/ 00010820
C***************************************************************** 00010830
C * 00010840
C MACRO DEFINITION FOR SMOOTH. * 00010850
C * 00010860
C***************************************************************** 00010870
DATA BIM1 /'S','M','O','O','T','H',' ',' ',0,3,53,0,2,'A',' ',' ',00010880
1' ',' ',' ',' ',' ','B',' ',' ',' ',' ',' ',' ',' ','C',' '/ 00010890
DATA C11 /' ',' ',' ',' ',' ', 00010900
1' ','$','L','1',' ',' ',' ',' ',' ','$','R','1',100/ 00010910
DATA C12 /100/ 00010920
C***************************************************************** 00010930
C * 00010940
C MACRO DEFINITION FOR DLINF1. * 00010950
C * 00010960
C***************************************************************** 00010970
DATA BIM2 /'D','L','I','N','F','1',' ',' ',0,3,58,0,2,'A',' ',' ',00010980
1' ',' ',' ',' ',' ','B',' ',' ',' ',' ',' ',' ',' ','C',' '/ 00010990
DATA C21 /' ',' ',' ',' ',' ', 00011000
1' ','$','L','1',' ',' ',' ',' ',' ','$','R','1',100/ 00011010
DATA C22 /100/ 00011020
C***************************************************************** 00011030
C * 00011040
C MACRO DEFINITION FOR DLINF3. * 00011050
C * 00011060
C***************************************************************** 00011070
DATA BIM3 /'D','L','I','N','F','3',' ',' ',0,3,63,0,6,'A',' ',' ',00011080
1' ',' ',' ',' ',' ','B',' ',' ',' ',' ',' ',' ',' ','C',' '/ 00011090
DATA C31 /' ',' ',' ',' ',' ', 00011100
1' ','$','L','1',' ',' ',' ',' ',' ','$','R','1',' ',' ',' '/ 00011110
DATA C32 /' ',' ','$','L','2',' ',' ',' ',' ',' ','$','R','2',' ',00011120
1' ',' ',' ',' ','$','L','3',' ',' ',' ',' ',' '/ 00011130
DATA C33 /'$','R','3',100,100/ 00011140
C***************************************************************** 00011150
C * 00011160
C MACRO DEFINITION FOR DELAY3. * 00011170
C * 00011180
C***************************************************************** 00011190
DATA BIM4 /'D','E','L','A','Y','3',' ',' ',0,3,74,0,5,'A',' ',' ',00011200
1' ',' ',' ',' ',' ','B',' ',' ',' ',' ',' ',' ',' ','C',' '/ 00011210
DATA C41 /' ',' ',' ',' ',' ', 00011220
1' ','$','L','1',' ',' ',' ',' ',' ','$','R','1',' ',' ',' '/ 00011230
DATA C42 /' ',' ','$','L','2',' ',' ',' ',' ',' ','$','R','2',' ',00011240
1' ',' ',' ',' ','$','L','3',100,100/ 00011250
C***************************************************************** 00011260
C * 00011270
C MACRO DEFINTION FOR DELAY1. * 00011280
C * 00011290
C***************************************************************** 00011300
DATA BIM5 /'D','E','L','A','Y','1',' ',' ',0,3,84,0,1,'A',' ',' ',00011310
1' ',' ',' ',' ',' ','B',' ',' ',' ',' ',' ',' ',' ','C',' '/ 00011320
DATA C51 /' ',' ',' ',' ',' ', 00011330
1' ','$','L','1',100,100/ 00011340
C***************************************************************** 00011350
C * 00011360
C THE FOLLOWING DATA IS FOR ENTERING THE PARAMETERS * 00011370
C INTO THE SYMBOL TABLE. PARAMETERS ARE ENTERED IN * 00011380
C THE FOLLOWING ORDER: * 00011390
C 1 - DT 3 - STOP 5 - PRTPER * 00011400
C 2 - TIME 4 - START 6 - PLTPER * 00011410
C * 00011420
C***************************************************************** 00011430
DATA PARM1 /-18915,-28899/ 00011440
DATA PARM2 /5007,-18252/ 00011450
DATA PARM3 /3917,-1521/ 00011460
DATA PARM4 /3903,2379/ 00011470
DATA PARM5 /-719,-1228/ 00011480
DATA PARM6 /-953,-1228/ 00011490
C***************************************************************** 00011500
C * 00011510
C LOAD THE BUILT-IN MACRO STATEMENTS AND DEFINITIONS. * 00011520
C * 00011530
C***************************************************************** 00011540
DO 50 I = 1, 80 00011550
50 MCREC(I) = BLANK 00011560
SYMPT = 0 00011570
REC = 52 00011580
DO 100 I = 1, 898 00011590
IF (B(I) .NE. 100) GO TO 75 00011600
REC = REC + 1 00011610
WRITE (DISK'REC) MCREC 00011620
IF (SYMPT .EQ. 0) GO TO 100 00011630
DO 60 J = 1, SYMPT 00011640
60 MCREC(J) = BLANK 00011650
SYMPT = 0 00011660
GO TO 100 00011670
75 SYMPT = SYMPT + 1 00011680
MCREC(SYMPT) = B(I) 00011690
100 CONTINUE 00011700
C***************************************************************** 00011710
C * 00011720
C LOAD THE FUNCTION TABLE. * 00011730
C * 00011740
C***************************************************************** 00011750
DO 300 I = 1, 110 00011760
300 FUNEQ(I) = FUNS(I) 00011770
C***************************************************************** 00011780
C * 00011790
C LOAD THE MDT. * 00011800
C * 00011810
C***************************************************************** 00011820
WRITE (DISK'98) MDTT1 00011830
WRITE (DISK'99) MDTT2 00011840
C***************************************************************** 00011850
C * 00011860
C LOAD THE PARAMETERS INTO THE SYMBOL TABLE. * 00011870
C * 00011880
C***************************************************************** 00011890
DO 400 J=1, SYMND 00011900
400 SYMTB(1,J)=32767 00011910
VALCT = 10 00011920
DO 600 I = 1, 6 00011930
CALL NDT37 (PARMS(1,I),POS) 00011940
IF (VNUM .NE. 12) GO TO 500 00011950
VTYPE = 5 00011960
INTBT = 1 00011970
DEFBT = 1 00011980
GO TO 600 00011990
500 VTYPE = 3 00012000
600 CALL NDT40 (SYMTB(1,POS)) 00012010
RETURN 00012020
END 00012040
C COPYRIGHT (C) 1978 - UNIVERSITY OF NOTRE DAME 00012050
C PROGRAM AUTHOR - DANIEL A. POYDENCE 00012060
C 00012070
C 00012080
SUBROUTINE NDT04 00012090
C 00012100
C 00012110
C NDT04 IS THE CONTEXT ANALYSIS PHASE COORDINATOR. LEXICAL AND 00012120
C COMPILE PHASE INFORMATION IS READ IN FOR EACH SOURCE STATEMENT 00012130
C AND CONTEXT DEPENDENT FEATURES ARE CHECKED FOR VALIDITY. 00012140
C 00012150
C 00012160
REAL*8 RMIN,RMAX,LITBL(1024) 00012170
INTEGER PTRS(45),TITLE(120),CRSET(39),OPER(9),SYM(15), 00012180
1SUBSC(6),TYPCT(20),EQCHN(80),TOKEN(80),CARD1(80),CARD2(80), 00012190
2ERROR(80),OBJCD(160),DEF(80),XREF(80),TMAP(80),FCTN(5,22), 00012200
3SYMTB(5,512) 00012210
INTEGER PSSWT,PGMND,PGMCT,RRBND,RRBPT,RUNCT,RRBST,DOC,OCBST, 00012220
1LINCT,OPTNS,PRNTR,STPGM,DISK,CBIT,STYPE,NOTBT,EQPOS,OCBPT, 00012230
2SYMPT,VNUM,CRITS,PGMCD,XRFND,DGMSG,CRSMT,EXCHR,BLANK,OCBND, 00012240
3OBJ2(80),RELOC 00012250
COMMON RMIN,RMAX,PTRS,TITLE,CRSET,OPER,SYM,SUBSC,TYPCT, 00012260
1EQCHN,TOKEN,CARD1,CARD2,ERROR,OBJCD,DEF,XREF,TMAP,FCTN, 00012270
2SYMTB,LITBL 00012280
EQUIVALENCE (PSSWT,PTRS(10)),(PGMND,PTRS(23)),(PGMCT,PTRS(22)), 00012290
1(RRBND,PTRS(38)),(RRBPT,PTRS(37)),(RUNCT,PTRS(14)),(RRBST, 00012300
2PTRS(36)),(LINCT,PTRS(5)),(OPTNS,PTRS(7)),(PRNTR,PTRS(2)), 00012310
3(STPGM,PTRS(21)),(DISK,PTRS(3)),(CBIT,TOKEN(2)),(STYPE, 00012320
4TOKEN(1)),(NOTBT,OBJCD(1)),(EQPOS,TMAP(3)),(VNUM,SYM(14)) 00012330
EQUIVALENCE (CRITS,PTRS(13)),(PGMCD,PTRS(15)),(XRFND,PTRS(16)), 00012340
1(DGMSG,PTRS(41)),(CRSMT,TMAP(1)),(EXCHR,PTRS(39)), 00012350
2(BLANK,CRSET(1)),(OCBST,PTRS(42)),(OCBPT,PTRS(43)) 00012360
EQUIVALENCE (OCBND,PTRS(44)),(OBJ2(1),OBJCD(81)),(RELOC,PTRS(40)) 00012370
C 00012380
C 00012390
C EXAMINE THE PROGRAM STATUS SWITCH FOR SPECIAL CONDITIONS AT 00012400
C THE END OF THE PROGRAM. IF MACRO MODE IS IN EFFECT THEN 00012410
C AN MEND CARD WAS MISSING AND THE MACRO COULD NOT BE EXPANDED. 00012420
C IF RERUN MODE WAS IN EFFECT THEN THE LAST RERUN BUFFER NEEDS 00012430
C TO BE VALIDITY CHECKED AND WRITTEN TO DISK. THE RERUN 00012440
C PROCESSOR WILL ALSO STOP EQUATION CHAINING AND COMPUTE THE 00012450
C RELOCATING CONSTANT FOR NUMERIC LITERALS IF THIS HAD NOT 00012460
C BEEN DONE PREVIOUSLY. 00012470
C 00012480
C 00012490
IF(PSSWT.EQ.4) CALL NDT20 (112,3) 00012500
CALL NDT18 00012510
C 00012520
C 00012530
C ESTABLISH PROGRAM AND RERUN END OF DATA POINTERS, COMPUTE 00012540
C THE NUMBER OF VALID RUNS, AND INITIALIZE DGMSG TO BEGIN 00012550
C THE SOURCE LISTING. DGMSG HAS 2 VALUES AT THIS POINT: 00012560
C 00012570
C 0 - THE NOSOURCE OPTION IS IN EFFECT AND THE DIAGNOSTIC 00012580
C HEADER HAS NOT PRINTED 00012590
C 1 - THE SOURCE OPTION IS IN EFFECT OR NOSOURCE IS IN 00012600
C EFFECT AND THE DIAGNOSTIC HEADER HAS ALREADY PRINTED 00012610
C 00012620
C 00012630
PGMND=PGMCT 00012640
RRBND=RRBPT 00012650
XRFND=PGMND 00012660
RUNCT=RRBND-RRBST+2 00012670
DGMSG=0 00012680
IF(MOD(OPTNS/1024,2).EQ.0) DGMSG=1 00012690
C 00012700
C 00012710
C INITIALIZE THE POINTERS FOR OUTPUT CONTROL BLOCKS TO BE 00012720
C WRITTEN TO DISK AFTER CONTEXT PROCESSING. 00012730
C 00012740
C 00012750
OCBST=RRBND+1 00012760
OCBPT=RRBND 00012770
C 00012780
C 00012790
C INITIALIZE EXCHR TO A BLANK TO BEGIN THE SOURCE LISTING. 00012800
C 00012810
C 00012820
EXCHR=BLANK 00012830
C 00012840
C 00012850
C INITIALIZE PSSWT FOR THE CONTEXT PHASE. ALL CARDS IN RERUN 00012860
C GROUPS HAVE ALREADY BEEN CONTEXT PROCESSED SO ONCE THE FIRST 00012870
C RERUN CARD IS ENCOUNTERED, PSSWT IS SET AND FURTHER CONTEXT 00012880
C PROCESSING IS SKIPPED. PSSWT HAS 3 VALUES IN THIS PHASE: 00012890
C 00012900
C 3 - NORMAL MAINLINE PROGRAM 00012910
C 4 - MACRO MODE 00012920
C 5 - RERUN MODE 00012930
C 00012940
C 00012950
PSSWT=3 00012960
C 00012970
C 00012980
C SET A FLAG FOR THE DOCUMENTOR OPTION AND SET LINCT TO FORCE 00012990
C PAGING FOR THE FIRST PAGE OF OUTPUT. IF THE SOURCE OPTION 00013000
C IS IN EFFECT THEN PRINT THE SOURCE LISTING HEADER. 00013010
C 00013020
C 00013030
DOC=MOD(OPTNS/4,2) 00013040
LINCT=-1 00013050
IF(MOD(OPTNS/1024,2).EQ.1) GO TO 1200 00013060
CALL NDT57 (2) 00013070
WRITE(PRNTR,1100) 00013080
1100 FORMAT(5X,'* * * * * S O U R C E L I S T I N G * *', 00013090
1' * * *'/) 00013100
C 00013110
C 00013120
C BEGIN THE CONTEXT PHASE. TOKEN, ERROR, CARD IMAGE AND TMAP 00013130
C INFORMATION IS READ FROM DISK. 00013140
C 00013150
C 00013160
1200 DO 100 PGMCT=STPGM,PGMND,9 00013170
READ(DISK'PGMCT) TOKEN 00013180
READ(DISK'PGMCT+1) CARD1 00013190
IF(CBIT.EQ.1) READ(DISK'PGMCT+2) CARD2 00013200
READ(DISK'PGMCT+3) ERROR 00013210
IF(STYPE.LE.8.AND.PSSWT.EQ.3) READ(DISK'PGMCT+8) TMAP 00013220
C 00013230
C 00013240
C COMPUTE THE CURRENT STATEMENT NUMBER. 00013250
C 00013260
C 00013270
CRSMT=(PGMCT-STPGM)/9+1 00013280
C 00013290
C 00013300
C CONTEXT PROCESSING IS SKIPPED IF PSSWT INDICATES RERUN OR 00013310
C MACRO MODES. SET PSSWT APPROPRIATELY: ONCE A RERUN CARD IS 00013320
C ENCOUNTERED RERUN MODE REMAINS IN EFFECT, MACRO AND MEND CARDS 00013330
C CAUSE MODE CHANGES BETWEEN MACRO AND NORMAL MODES. 00013340
C 00013350
C 00013360
IF(PSSWT.EQ.5) GO TO 800 00013370
IF(STYPE.EQ.14) PSSWT=5 00013380
IF(STYPE.EQ.15) PSSWT=4 00013390
IF(STYPE.EQ.16) PSSWT=3 00013400
IF(PSSWT.EQ.4) GO TO 800 00013410
C 00013420
C 00013430
C IF THE CARD IS NOT A NOTE OR AN OUTPUT CARD THEN INDICATE 00013440
C NO INFORMATION IN THE NOTE ARRAY. 00013450
C 00013460
C 00013470
IF(STYPE.LT.11 .OR. STYPE.GT.13) NOTBT=0 00013480
C 00013490
C 00013500
C CALL THE APPROPRIATE CONTEXT PROCESSORS TO PERFORM THE 00013510
C ANALYSES FOR DIFFERENT CARD TYPES. 00013520
C 00013530
C 00013540
GO TO (210,300,400,300,600,300,300,300,800,800, 00013550
1 900,1000,1000,800,800,800,800,500,800,800),STYPE 00013560
C 00013570
C 00013580
C CONTEXT PROCESSING FOR TABLE CARDS. FIRST THE ADDRESS OF 00013590
C THE TABLE ARRAY WHICH IS IN THE LITERAL TABLE MUST BE 00013600
C RELOCATED. LEFT OF EQUAL SIGN PROCESSING FOLLOWS. 00013610
C 00013620
C 00013630
210 READ(DISK'PGMCT+4) OBJ2 00013640
SYMPT=-OBJ2(6) 00013650
LITBL(SYMPT)=SYMPT+RELOC+1 00013660
GO TO 200 00013670
C 00013680
C 00013690
C CONTEXT PROCESSING FOR PARM CARDS. IF THE EQUATION IS FOR 00013700
C 'DT' THEN NORMAL LEFT AND RIGHT PROCESSING IS REQUIRED. 00013710
C IF THE EQUATION IS NOT FOR 'DT' THEN NUMERIC ONLY AND LEFT 00013720
C PROCESSING ARE REQUIRED. 00013730
C 00013740
C 00013750
400 IF(EQPOS.NE.5) GO TO 800 00013760
IF(TOKEN(4).LT.0.OR.TOKEN(4).GT.20479) GO TO 800 00013770
SYMPT=MOD(TOKEN(4),4096)+1 00013780
CALL NDT41 (SYMTB(1,SYMPT)) 00013790
IF(VNUM.EQ.11) GO TO 300 00013800
CALL NDT49 00013810
GO TO 200 00013820
C 00013830
C 00013840
C TMAP INFORMATION IS NOT SAVED FOR DEF CARDS SO IT MUST BE 00013850
C SET TO ALLOW PROPER LEFT OF EQUAL SIGN PROCESSING. 00013860
C 00013870
C 00013880
500 EQPOS=5 00013890
TMAP(4)=0 00013900
GO TO 200 00013910
C 00013920
C 00013930
C CONTEXT PROCESS THE LEVEL EQUATIONS. 00013940
C 00013950
C 00013960
600 CALL NDT51 00013970
GO TO 300 00013980
C 00013990
C 00014000
C SAVE NOTE CARD INFORMATION FOR PRINT AND PLOT TITLES. 00014010
C 00014020
C 00014030
900 CALL NDT55 00014040
GO TO 800 00014050
C 00014060
C 00014070
C CONTEXT PROCESS THE OUTPUT CARDS. 00014080
C 00014090
C 00014100
1000 CALL NDT52 00014110
EQPOS=3 00014120
C 00014130
C 00014140
C RIGHT AND LEFT OF EQUAL SIGN VARIABLE USAGE ANALYSIS IS 00014150
C PERFORMED HERE. 00014160
C 00014170
C 00014180
300 CALL NDT48 00014190
200 CALL NDT47 00014200
C 00014210
C 00014220
C AFTER THE CONTEXT PROCESSING, THE SOURCE IS LISTED IF THE 00014230
C OPTION IS IN EFFECT AND ANY DIAGNOSTIC MESSAGES ARE PRINTED. 00014240
C 00014250
C 00014260
800 CALL NDT56 00014270
C 00014280
C 00014290
C IF THE DOCUMENT OPTION IS IN EFFECT AND THE STATEMENT IS AN 00014300
C EQUATION OR OUTPUT CARD, BUT NOT IN AN EXPND GROUP, CALL 00014310
C THE DOCUMENTOR. 00014320
C 00014330
C 00014340
IF(DOC.EQ.1.AND.EXCHR.EQ.BLANK.AND.PSSWT.NE.4.AND.STYPE.NE.3 00014350
1 .AND.(STYPE.LE.8.OR.STYPE.EQ.12.OR.STYPE.EQ.13)) CALL NDT50 00014360
100 CONTINUE 00014370
C 00014380
C 00014390
C SET THE OUTPUT CONTROL BLOCK GROUP END POINTER. 00014400
C 00014410
C 00014420
OCBND=OCBPT 00014430
C 00014440
C 00014450
C A VALID MODEL MUST HAVE A LEVEL EQUATION AND A PROGRAM 00014460
C MUST CONTAIN A REQUEST FOR OUTPUT. 00014470
C 00014480
C 00014490
IF(TYPCT(5).NE.0) GO TO 1300 00014500
CRITS=CRITS+1 00014510
PGMCD=3 00014520
CALL NDT57 (4) 00014530
WRITE(PRNTR,1400) 00014540
1400 FORMAT(/' A VALID MODEL MUST HAVE AT LEAST ONE LEVEL EQUATION.'/, 00014550
1' THIS PROGRAM HAS NONE SO EXECUTION WILL BE INHIBITED.'/) 00014560
1300 IF(TYPCT(12)+TYPCT(13).NE.0) GO TO 1500 00014570
CRITS=CRITS+1 00014580
PGMCD=3 00014590
CALL NDT57 (4) 00014600
WRITE(PRNTR,1600) 00014610
1600 FORMAT(/' THIS PROGRAM HAS NO PRINT OR PLOT STATEMENTS.'/, 00014620
1' SINCE NO OUTPUT IS REQUESTED, THE MODEL WILL NOT BE RUN.'/) 00014630
C 00014640
C 00014650
C IF CRITICAL ERRORS OCCURRED THEN THE 'GO' AND 'OBJECT' OPTIONS 00014660
C CANNOT BE SUPPORTED. IF THEY ARE IN EFFECT THEN CANCEL THEM. 00014670
C 00014680
C 00014690
1500 IF(MOD(OPTNS/32,2).EQ.0.AND.PGMCD.EQ.3) OPTNS=OPTNS+32 00014700
IF(MOD(OPTNS/512,2).EQ.1.AND.PGMCD.EQ.3) OPTNS=OPTNS-512 00014710
RETURN 00014720
END 00014740
C COPYRIGHT (C) 1978 - UNIVERSITY OF NOTRE DAME 00014750
C PROGRAM AUTHOR - DANIEL A. POYDENCE 00014760
C 00014770
C 00014780
SUBROUTINE NDT05 00014790
C 00014800
C 00014810
C NDT05 INITIALIZES THE DATA AREAS REQUIRED BY THE LEXICAL 00014820
C AND SYNTAX PHASES DURING SOURCE CARD INPUT. 00014830
C 00014840
REAL*8 RMIN,RMAX,LITBL(1024) 00014850
INTEGER PTRS(45),TITLE(120),CRSET(39),OPER(9),SYM(15), 00014860
1SUBSC(6),TYPCT(20),EQCHN(80),TOKEN(80),CARD1(80),CARD2(80), 00014870
2ERROR(80),OBJCD(160),DEF(80),XREF(80),TMAP(80),FCTN(5,22), 00014880
3SYMTB(5,512) 00014890
INTEGER EQNCD,ERRPT,CRSMT,PGMCT,STPGM,REFPT,RFCPT, 00014900
1RFDEF,PNT,START,OUTER,STOP,COL,LOOP,CARD(80,2),BLANK, 00014910
2TYPE(2),STYPE,CBIT,PSSWT,CDSTC,FIND,CDATA(144),LENM1(19), 00014920
3PARSE(19),CHAR(53),TOKPT,EQPOS,DISK,OPTNS 00014930
COMMON RMIN,RMAX,PTRS,TITLE,CRSET,OPER,SYM,SUBSC,TYPCT, 00014940
1EQCHN,TOKEN,CARD1,CARD2,ERROR,OBJCD,DEF,XREF,TMAP,FCTN, 00014950
2SYMTB,LITBL 00014960
EQUIVALENCE (EQNCD,ERROR(1)),(ERRPT,ERROR(2)),(CRSMT,TMAP(1)), 00014970
1(PGMCT,PTRS(22)),(STPGM,PTRS(21)),(REFPT, 00014980
2XREF(1)),(RFCPT,XREF(2)),(RFDEF,XREF(3)),(CARD(1,1),CARD1(1)), 00014990
3(BLANK,CRSET(1)),(TYPE(1),STYPE,TOKEN(1)),(CBIT,TOKEN(2)), 00015000
4(PSSWT,PTRS(10)),(CDSTC,CDATA(143)),(CDATA(1),OBJCD(1)), 00015010
5(TOKPT,TOKEN(3)),(EQPOS,TMAP(3)),(DISK,PTRS(3)),(OPTNS,PTRS(7)) 00015020
DATA LENM1 /0,0,3,0,0,0,0,0,0,0,3,4,3,4,4,3,4,2,4/ 00015030
DATA PARSE /0,0,0,0,0,0,0,0,2,1,2,0,0,2,0,2,0,1,1/ 00015040
DATA CHAR /'T','C','P','A','R','M','N','L','A','R','S','X', 00015050
1'*','N','O','T','E','P','R','I','N','T','P','L','O','T','R', 00015060
2'E','R','U','N','M','A','C','R','O','M','E','N','D','E','X', 00015070
3'P','N','D','D','E','F','T','I','T','L','E'/ 00015080
C 00015090
C 00015100
C INITIALIZE THE ERROR INFORMATION ARRAY. 00015110
C 00015120
C 00015130
EQNCD=0 00015140
ERRPT=2 00015150
C 00015160
C 00015170
C INITIALIZE THE TMAP AND TOKEN INFORMATION ARRAYS. 00015180
C 00015190
C 00015200
CRSMT=(PGMCT-STPGM+1)/9+1 00015210
TOKPT=3 00015220
EQPOS=0 00015230
C 00015240
C 00015250
C INITIALIZE THE XREF INFORMATION ARRAY. 00015260
C 00015270
C 00015280
REFPT=3 00015290
RFCPT=0 00015300
RFDEF=CRSMT 00015310
IF(MOD(OPTNS/128,2).EQ.1) WRITE(DISK'PGMCT+8) XREF 00015320
C 00015330
C 00015340
C ENTER THE NUMERICAL VALUE ASSOCIATED WITH EACH CARD INTO 00015350
C THE STYPE AND CBIT FIELDS OF THE TOKEN ARRAY. 'TYPE' IS 00015360
C EQUIVALENCED ACROSS THESE LOCATIONS. 00015370
C 00015380
C THE FOLLOWING VALUES ARE ASSIGNED BASED ON CARD TYPE: 00015390
C 00015400
C CARD TYPE VALUE 00015410
C 00015420
C T 1 00015430
C C 2 00015440
C PARM 3 00015450
C N 4 00015460
C L 5 00015470
C A 6 00015480
C R 7 00015490
C S 8 00015500
C X 9 00015510
C * 10 00015520
C NOTE 11 00015530
C PRINT 12 00015540
C PLOT 13 00015550
C RERUN 14 00015560
C MACRO 15 00015570
C MEND 16 00015580
C EXPND 17 00015590
C DEF 18 00015600
C TITLE 19 00015610
C 00015620
C UNRECOGNIZED 20 00015630
C 00015640
C 00015650
DO 400 PNT=1,2 00015660
C 00015670
C 00015680
C THE OUTER LOOP CONTROLLED BY THE INDEX VARIABLE 'OUTER' 00015690
C CAUSES A COMPARISON CHARACTER BY CHARACTER AGAINST THE 00015700
C ARRAY 'CHAR' WITH THE CARD REFERENCED BY 'PNT'. EACH 00015710
C CHARACTER SEQUENCE IS CHECKED UNTIL ONE COMPARES. 00015720
C 00015730
C 00015740
100 START=1 00015750
DO 300 OUTER=1,19 00015760
C 00015770
C 00015780
C COMPUTE 'STOP' FROM THE START OF THE STRING AND THE ARRAY 00015790
C 'LENM1' WHICH CONTAINS THE LENGTH OF THE STRING MINUS ONE. 00015800
C 00015810
C 00015820
STOP=START+LENM1(OUTER) 00015830
C 00015840
C THIS LOOP PERFORMS THE CHARACTER COMPARISON. 00015850
C IF ANY CHARACTER IN THE COMPARITOR SEQUENCE DOES 00015860
C NOT COMPARE, TRY THE NEXT CHARACTER SEQUENCE. 00015870
C 00015880
C 00015890
COL=1 00015900
DO 200 LOOP=START,STOP 00015910
IF(CARD(COL,PNT).NE.CHAR(LOOP)) GO TO 300 00015920
200 COL=COL+1 00015930
C 00015940
C 00015950
C ALL CHARACTERS IN THE SEQUENCE WERE EQUAL TO THE 00015960
C CHARACTERS ON THE INDICATED CARD. CHECK THE NEXT 00015970
C POSITION FOR A BLANK SPACE. 00015980
C 00015990
C 00016000
IF(CARD(COL,PNT).NE.BLANK) GO TO 300 00016010
C 00016020
C 00016030
C THE CARD TYPE KEY IS VALID. SET THE APPROPRIATE TYPE VALUE. 00016040
C 00016050
C 00016060
TYPE(PNT)=OUTER 00016070
GO TO 400 00016080
C 00016090
C 00016100
C BUMP 'START' TO POINT TO THE NEXT CHARACTER STRING. 00016110
C 00016120
C 00016130
300 START=STOP+1 00016140
C 00016150
C 00016160
C THE CARD TYPE KEY FOR THE INDICATED CARD IS UNRECOGNIZED. 00016170
C 00016180
C 00016190
TYPE(PNT)=20 00016200
400 CONTINUE 00016210
C 00016220
C 00016230
C UPDATE THE TYPCT ARRAY WHICH COUNTS THE OCCURRENCE OF EACH 00016240
C CARD TYPE. IF CARD2 IS A CONTINUATION OF CARD1 SET CBIT 00016250
C TO 1. OTHERWISE, SET CBIT TO 0. 00016260
C 00016270
C 00016280
TYPCT(STYPE)=TYPCT(STYPE)+1 00016290
IF(CBIT.NE.9) CBIT=0 00016300
IF(CBIT.EQ.0) GO TO 500 00016310
CBIT=1 00016320
TYPCT(9)=TYPCT(9)+1 00016330
C 00016340
C 00016350
C IF MACRO MODE IS IN EFFECT OR THE CARD REQUIRES NO PARSING 00016360
C IN ANY MODE THEN SKIP THE PARSE STEP. THE ARRAY 'PARSE' 00016370
C INDICATES THE APPROPRIATE ACTION WITH THE FOLLOWING VALUES: 00016380
C 00016390
C 0 - PARSE THE CARD AND THE OPTIONAL CONTINUATION 00016400
C 1 - PARSE THE CARD AND DISALLOW A CONTINUATION 00016410
C 2 - DO NOT PARSE THE CARD AND DISALLOW A CONTINUATION 00016420
C 00016430
C 00016440
500 IF(PSSWT.EQ.4) GO TO 9000 00016450
C 00016460
C 00016470
C CHECK FOR AN UNRECOGNIZED CARD TYPE OR A CONTINUATION AS 00016480
C THE FIRST CARD. 00016490
C 00016500
C 00016510
IF(STYPE.EQ.20) GO TO 600 00016520
IF(STYPE.EQ.9) GO TO 700 00016530
IF(PARSE(STYPE).EQ.2) GO TO 1400 00016540
C 00016550
C 00016560
C CARD PARSING IS REQUIRED. INITIALIZE THE CONTINUATION 00016570
C START OF DATA POINTER TO POINT TO THE END OF THE BUFFER. 00016580
C 'PNT' WILL POINT TO THE CARD BEING PARSED, AND 'COL' IS 00016590
C THE NEXT AVAILABLE POSITION IN CDATA FOR CARD CHARACTERS. 00016600
C 00016610
C 00016620
CDSTC=142 00016630
PNT=0 00016640
COL=1 00016650
C 00016660
C 00016670
C FIND THE STARTING LOCATION OF THE CARD DATA FIELD. 00016680
C 00016690
C 00016700
800 PNT=PNT+1 00016710
DO 900 FIND=1,72 00016720
IF(CARD(FIND,PNT).EQ.BLANK) GO TO 850 00016730
900 CONTINUE 00016740
C 00016750
C 00016760
C THE END OF THE KEY FIELD HAS BEEN FOUND. THE NEXT NON-BLANK 00016770
C CHARACTER IS THE START OF THE DATA FIELD. 00016780
C 00016790
C 00016800
850 START=FIND+1 00016810
DO 950 FIND=START,72 00016820
IF(CARD(FIND,PNT).NE.BLANK) GO TO 1000 00016830
950 CONTINUE 00016840
C 00016850
C 00016860
C THE CARD DATA FIELD WAS NOT FOUND. THE CARD IS BLANK AND 00016870
C CANNOT BE PROCESSED FURTHER. 00016880
C 00016890
C 00016900
CALL NDT14 (PNT-1,110,3) 00016910
GO TO 1300 00016920
C 00016930
C 00016940
C IF THE CURRENT CARD IS THE CONTINUATION THEN SET THE 00016950
C CONTINUATION STARTING ADDRESS POINTER. THE STARTING LOCATION 00016960
C FOUND PREVIOUSLY IS SAVED FOR THE APPROPRIATE CARD. 00016970
C 00016980
C 00016990
1000 IF(PNT.EQ.2) CDSTC=COL 00017000
CDATA(2*PNT+140)=FIND 00017010
C 00017020
C 00017030
C COPY THE CARD DATA INTO CDATA. STOP AFTER COPYING THE 00017040
C THE BLANK DELIMITER. 00017050
C 00017060
C 00017070
DO 1100 LOOP=FIND,72 00017080
CDATA(COL)=CARD(LOOP,PNT) 00017090
IF(CDATA(COL).EQ.BLANK) GO TO 1300 00017100
1100 COL=COL+1 00017110
CDATA(COL)=BLANK 00017120
C 00017130
C 00017140
C IF THIS CARD WAS THE CONTINUATION THEN THE JOB IS FINISHED. 00017150
C CHECK PARSE TO VERIFY THE VALIDITY OF A CONTINUATION. 00017160
C IF A CONTINUATION IS ALLOWED AND ONE EXISTS THEN PARSE IT. 00017170
C 00017180
C 00017190
1300 IF(PNT.EQ.2) GO TO 9000 00017200
IF(PARSE(STYPE).NE.0) GO TO 1400 00017210
IF(CBIT.EQ.1) GO TO 800 00017220
GO TO 9000 00017230
C 00017240
C 00017250
C AN UNRECOGNIZED CARD TYPE WAS ENCOUNTERED. 00017260
C 00017270
C 00017280
600 CALL NDT14 (0,100,3) 00017290
GO TO 1400 00017300
C 00017310
C 00017320
C THE FIRST CARD WAS A CONTINUATION. THIS CAN HAPPEN TWO 00017330
C DIFFERENT WAYS: THE FIRST CARD OF THE USER'S SOURCE DECK 00017340
C WAS A CONTINUATION, OR TOO MANY CONTINUATIONS FOLLOWED A CARD. 00017350
C 00017360
C 00017370
700 IF(PGMCT.LT.STPGM) GO TO 1500 00017380
CALL NDT14 (0,102,3) 00017390
IF(CBIT.EQ.1) CALL NDT14 (1,102,3) 00017400
GO TO 9000 00017410
1500 CALL NDT14 (0,106,2) 00017420
C 00017430
C 00017440
C THE FIRST CARD MAY NOT BE CONTINUED. 00017450
C 00017460
C 00017470
1400 IF(CBIT.EQ.1) CALL NDT14 (1,101,2) 00017480
9000 RETURN 00017490
END 00017510
C***************************************************************** 00017520
C * 00017530
C COPYRIGHT (C) 1978 - UNIVERSITY OF NOTRE DAME * 00017540
C PROGRAM AUTHOR - TIMOTHY J. MALLOY * 00017550
C * 00017560
C***************************************************************** 00017570
SUBROUTINE NDT06 00017580
C***************************************************************** 00017590
C * 00017600
C TITLE CARD PROCESSOR * 00017610
C * 00017620
C * 00017630
C THIS PROGRAM SETS UP THE TITLE ARRAY WITH ANY INFORMATION * 00017640
C THAT APPEARS ON A TITLE CARD. * 00017650
C * 00017660
C***************************************************************** 00017670
REAL*8 RMIN,RMAX,LITBL(1024) 00017680
INTEGER PTRS(45),TITLE(120),CRSET(39),OPER(9),SYM(15), 00017690
1SUBSC(6),TYPCT(20),EQCHN(80),TOKEN(80),CARD1(80),CARD2(80), 00017700
2ERROR(80),OBJCD(160),DEF(80),XREF(80),TMAP(80),FCTN(5,22), 00017710
3SYMTB(5,512) 00017720
INTEGER PAGE(4),BLANK,TPNT,STYPE,EQNCD,XCHAR,LSPOS 00017730
COMMON RMIN,RMAX,PTRS,TITLE,CRSET,OPER,SYM,SUBSC,TYPCT, 00017740
1EQCHN,TOKEN,CARD1,CARD2,ERROR,OBJCD,DEF,XREF,TMAP,FCTN, 00017750
2SYMTB,LITBL 00017760
EQUIVALENCE (BLANK,CRSET(1)),(TPNT,PTRS(30)), 00017770
1(STYPE,TOKEN(1)),(EQNCD,ERROR(1)) 00017780
DATA PAGE /'P','A','G','E'/ 00017790
C***************************************************************** 00017800
C * 00017810
C INITIALLY, SET UP THE TITLE ARRAY WITH ALL BLANKS, AND * 00017820
C "PAGE" AT THE FAR LEFT. SET TPNT TO 10. * 00017830
C * 00017840
C TPNT POINTS TO THE LAST POSITION USED IN TITLE. THE PAGE * 00017850
C DATA TAKES UP THE FIRST 9, SO THE LAST POSITION USED IS * 00017860
C THE BLANK IN POSITION 10. * 00017870
C * 00017880
C***************************************************************** 00017890
DO 100 XCHAR = 1, 4 00017900
100 TITLE(XCHAR) = PAGE(XCHAR) 00017910
DO 200 XCHAR = 5, 120 00017920
200 TITLE(XCHAR) = BLANK 00017930
TPNT = 10 00017940
C***************************************************************** 00017950
C * 00017960
C IF THIS CARD IS NOT A TITLE CARD, OR THE TITLE CARD WAS * 00017970
C BLANK, THE TITLE WILL REMAIN BLANK, SO RETURN. * 00017980
C * 00017990
C***************************************************************** 00018000
IF (STYPE .NE. 19 .OR. EQNCD .EQ. 3) GO TO 600 00018010
C***************************************************************** 00018020
C * 00018030
C FIND THE END OF THE TITLE. BECAUSE THE TITLE CARD IS NOT * 00018040
C BLANK, THIS SEARCH WILL BE SUCCESSFUL. * 00018050
C * 00018060
C***************************************************************** 00018070
LSPOS = 73 00018080
300 LSPOS = LSPOS - 1 00018090
IF (CARD1(LSPOS) .NE. BLANK) GO TO 400 00018100
GO TO 300 00018110
C***************************************************************** 00018120
C * 00018130
C PUT THE TITLE INTO THE TITLE ARRAY, AND UPDATE TPNT. * 00018140
C * 00018150
C***************************************************************** 00018160
400 DO 500 XCHAR = 7, LSPOS 00018170
500 TITLE(XCHAR+4) = CARD1(XCHAR) 00018180
TPNT = LSPOS + 4 00018190
C***************************************************************** 00018200
C * 00018210
C RETURN SECTION * 00018220
C * 00018230
C***************************************************************** 00018240
600 RETURN 00018250
END 00018270
C***************************************************************** 00018280
C * 00018290
C COPYRIGHT (C) 1978 - UNIVERSITY OF NOTRE DAME * 00018300
C PROGRAM AUTHOR - THOMAS L EVERMAN JR * 00018310
C * 00018320
C THIS PROGRAM PROCESSES CONTROL CARDS. * 00018330
C * 00018340
C***************************************************************** 00018350
SUBROUTINE NDT07 00018360
REAL*8 RMIN,RMAX,LITBL(1024) 00018370
INTEGER PTRS(45),TITLE(120),CRSET(39),OPER(9),SYM(15), 00018380
1SUBSC(6),TYPCT(20),EQCHN(80),TOKEN(80),CARD1(80),CARD2(80), 00018390
2ERROR(80),OBJCD(160),DEF(80),XREF(80),TMAP(80),FCTN(5,22), 00018400
3SYMTB(5,512) 00018410
INTEGER OPTNS,OPTSP,INTYP,CDATA(144),DFLT(12),OPCHR(81),START 00018420
INTEGER STOP,CNT,NO,LOOK,OPT,N,O,LOOP,LOOP2,CDPOS,CHCNT 00018430
INTEGER BLANK,USE,MDVAL 00018440
COMMON RMIN,RMAX,PTRS,TITLE,CRSET,OPER,SYM,SUBSC,TYPCT, 00018450
1EQCHN,TOKEN,CARD1,CARD2,ERROR,OBJCD,DEF,XREF,TMAP,FCTN, 00018460
2SYMTB,LITBL 00018470
EQUIVALENCE (OPTNS,PTRS(7)),(OPTSP,PTRS(34)),(INTYP,PTRS(8)), 00018480
1(CDATA(1),OBJCD(1)),(N,CRSET(17)),(O,CRSET(18)), 00018490
2(BLANK,CRSET(1)) 00018500
C***************************************************************** 00018510
C * 00018520
C DFLT INDICATES THE DEFAULT ACTION FOR A CONTROL OPTION. * 00018530
C 0 = INVOKE THE OPTION IS THE DEFAULT. * 00018540
C 1 = DO NOT INVOKE THE OPTION IS THE DEFAULT. * 00018550
C THE FOLLOWING IS A LIST OF THE OPTIONS AVAILABLE IN NDTRAN.* 00018560
C THE LIST IS ORDERED BY LEAST SIGNIFICANT BIT IN OPTNS AND * 00018570
C BY LOWEST SUBSCRIPT IN DFLT. THE LIST ALSO INDICATES * 00018580
C THE DEFAULT FOR EACH OPTION. * 00018590
C 1) NOCHECK / CHECK * 00018600
C 2) NOSYSTEM / SYSTEM * 00018610
C 3) NODOCUMENT / DOCUMENT * 00018620
C 4) WIDE / NARROW * 00018630
C 5) STATS / NOSTATS * 00018640
C 6) GO / NOGO * 00018650
C 7) NOSYMBOL / SYMBOL * 00018660
C 8) NOXREF / XREF * 00018670
C 9) WARN / NOWARN * 00018680
C 10) NOOBJECT / OBJECT * 00018690
C 11) SOURCE / NOSOURCE * 00018700
C 12) NOTIME / TIME * 00018710
C OPTNS IS USED TO SET BITS FOR EACH OPTION SPECIFIED WHICH * 00018720
C IS NOT A DEFAULT AND IS REFERENCED BY THE ACTION ROUTINES * 00018730
C FOR EACH OPTION. OPTSP SIMPLY INDICATES WHICH OPTIONS * 00018740
C HAVE ALREADY BEEN SPECIFIED IN ORDER TO CHECK FOR * 00018750
C DUPLICATION. INTYP SPECIFIES THE INTEGRATION METHOD. * 00018760
C THE OPCHR ARRAY CONTAINS A SEQUENTIAL LIST OF THE CHARACTER* 00018770
C WHICH MAKE UP EACH OPTION. * 00018780
C * 00018790
C***************************************************************** 00018800
DATA DFLT /1,1,1,0,0,0,1,1,0,1,0,1/ 00018810
DATA OPCHR /'C','H','E','C','K','S','Y','S','T','E','M', 00018820
1'D','O','C','U','M','E','N','T','W','I','D','E', 00018830
2'S','T','A','T','S','G','O','S','Y','M','B','O','L', 00018840
3'X','R','E','F','W','A','R','N','O','B','J','E','C','T', 00018850
4'S','O','U','R','C','E','T','I','M','E','N','A','R','R','O','W', 00018860
5'E','U','L','E','R','R','K','I','N','T','A','B','I','N','T'/ 00018870
C***************************************************************** 00018880
C * 00018890
C START IS THE POSITION OF THE INTITIAL CHARACTER IN THE OPCH* 00018900
C ARRAY TO BE COMPARED TO THE PRESENT OPTION. STOP IS THE * 00018910
C POSITION OF THE FINAL CHARACTER. CNT IS THE NUMBER OF * 00018920
C CHARACTERS CONTAINED IN THE OPTION TO COMPARE. NO IS * 00018930
C USED TO INDICATE WHETHER 'NO' WAS SPECIFIED BEFORE THE * 00018940
C OPTION. LOOK IS THE POSITION IN CDATA AT WHICH TO CHECK * 00018950
C FOR THE OPTION TYPE. * 00018960
C * 00018970
C***************************************************************** 00018980
START = 1 00018990
STOP = 0 00019000
CNT = 0 00019010
NO = 0 00019020
LOOK = 1 00019030
C***************************************************************** 00019040
C * 00019050
C CHECK FOR 'NO' PRECEDING THE OPTION. IF FOUND, SET * 00019060
C NO TO 1 AND SET LOOK TO SKIP 'NO' DURING COMPARISON. * 00019070
C * 00019080
C***************************************************************** 00019090
IF (CDATA(1) .EQ. N .AND. CDATA(2) .EQ. O) NO = 1 00019100
IF (NO .EQ. 1) LOOK = 3 00019110
C***************************************************************** 00019120
C * 00019130
C BEGIN CHECKING FOR OPTIONS. COMPARE CHARACTERS IN CDATA * 00019140
C TO ALL POSSIBLE OPTIONS. START IS INCREMENTED BY THE * 00019150
C LENGTH OF THE PREVIOUS COMPARISON STRING TO GET THE * 00019160
C START OF THE NEW STRING. THE LENGTH OF THE STRING IS * 00019170
C DETERMINED AND ADDED TO THE STOP VALUE FOR THE * 00019180
C PREVIOUS STRING. * 00019190
C * 00019200
C***************************************************************** 00019210
DO 650 LOOP = 1, 16 00019220
START = START + CNT 00019230
CNT = 2 00019240
GO TO (300,200,100,400,300,500,200,400,400,200,200,400, 00019250
1200,300,300,300), LOOP 00019260
100 CNT = CNT + 2 00019270
200 CNT = CNT + 1 00019280
300 CNT = CNT + 1 00019290
400 CNT = CNT + 2 00019300
500 STOP = STOP + CNT 00019310
CHCNT = 0 00019320
C***************************************************************** 00019330
C * 00019340
C COMPARE THE CHARACTER STRINGS. CHECK FOR BLANK AFTER 3RD * 00019350
C CHARACTER IN ORDER TO FIND ABBREVIATED NAMES. IF A VALID * 00019360
C COMPARISON IS MADE, MAKE SURE THE NEXT POSITION IN CDATA * 00019370
C CONTAINS A BLANK. IF NO VALID COMPARISONS OCCUR, GIVE * 00019380
C INVALID OPTION ERROR (204). * 00019390
C * 00019400
C***************************************************************** 00019410
DO 600 LOOP2 = START, STOP 00019420
CDPOS = LOOK + LOOP2 - START 00019430
CHCNT = CHCNT + 1 00019440
IF (CDATA(CDPOS) .NE. OPCHR(LOOP2)) GO TO 650 00019450
IF (CHCNT .EQ. 3 .AND. CDATA(CDPOS + 1) .EQ. BLANK) GO TO 700 00019460
600 CONTINUE 00019470
IF (CDATA(CDPOS + 1) .EQ. BLANK) GO TO 700 00019480
650 CONTINUE 00019490
CALL NDT13 (LOOK, 204, 2) 00019500
GO TO 1200 00019510
C***************************************************************** 00019520
C * 00019530
C OPTION HAS BEEN RECOGNIZED AS BEING VALID. * 00019540
C CHECK WID, NAR, EUL, RKI, ABI FOR PRECEDING 'NO' (206). * 00019550
C SET NAR VALUES TO TREAT IT AS A 'NOWID'. * 00019560
C * 00019570
C***************************************************************** 00019580
700 OPT = LOOP - 1 00019590
IF (OPT .LT. 12 .AND. OPT .NE. 3) GO TO 800 00019600
IF (NO .EQ. 1) CALL NDT13 (LOOK, 206, 2) 00019610
IF (OPT .GE. 13) GO TO 900 00019620
IF (OPT .EQ. 12) NO = 1 00019630
OPT = 3 00019640
C***************************************************************** 00019650
C * 00019660
C CHECK FOR PREVIOUS SPECIFICATION OF THE OPTION, THEN MAKE * 00019670
C THE APPROPRIATE BIT SETTING IN OPTSP AND OPTNS. * 00019680
C * 00019690
C***************************************************************** 00019700
800 MDVAL = 2 ** OPT 00019710
USE = MOD (OPTSP / MDVAL, 2) 00019720
IF (USE .NE. 0) GO TO 1100 00019730
OPTSP = OPTSP + MDVAL 00019740
IF (NO .EQ. DFLT(OPT + 1)) GO TO 1200 00019750
OPTNS = OPTNS + MDVAL 00019760
GO TO 1200 00019770
C***************************************************************** 00019780
C * 00019790
C OPTION SPECIFIES AN INTEGRATION TYPE. CHECK FOR PREVIOUS * 00019800
C SPECIFICATION, THEN SET INTYP BASED ON OPT. * 00019810
C * 00019820
C***************************************************************** 00019830
900 IF (OPTSP .GE. 16384) GO TO 1100 00019840
OPTSP = OPTSP + 16384 00019850
INTYP = OPT - 12 00019860
GO TO 1200 00019870
1100 CALL NDT13 (LOOK, 205, 2) 00019880
1200 RETURN 00019890
END 00019910
C COPYRIGHT 1978 - UNIVERSITY OF NOTRE DAME 00019920
C PROGRAM AUTHOR - GARY PELKEY 00019930
C 00019940
C 00019950
SUBROUTINE NDT08 00019960
REAL*8 RMIN,RMAX,LITBL(1024) 00019970
INTEGER PTRS(45),TITLE(120),CRSET(39),OPER(9),SYM(15), 00019980
1SUBSC(6),TYPCT(20),EQCHN(80),TOKEN(80),CARD1(80),CARD2(80), 00019990
2ERROR(80),OBJCD(160),DEF(80),XREF(80),TMAP(80),FCTN(5,22), 00020000
3SYMTB(5,512) 00020010
INTEGER POS,EQOCC,PNT1,PNT2,CHAR,BLANK,TOKPT,I,NMBIT,EQPOS 00020020
1,NMSET(11),RTC,CDATA(144),N,LASTI 00020030
COMMON RMIN,RMAX,PTRS,TITLE,CRSET,OPER,SYM,SUBSC,TYPCT, 00020040
1EQCHN,TOKEN,CARD1,CARD2,ERROR,OBJCD,DEF,XREF,TMAP,FCTN, 00020050
2SYMTB,LITBL 00020060
EQUIVALENCE (BLANK,CRSET(1)),(TOKPT,TOKEN(3)), 00020070
1(NMSET(1),CRSET(30)),(POS,OBJCD(145)),(EQOCC,OBJCD(146)), 00020080
2(PNT1,OBJCD(147)),(PNT2,OBJCD(148)),(CHAR,OBJCD(149)), 00020090
3(I,OBJCD(150)),(NMBIT,OBJCD(151)),(RTC,OBJCD(152)) 00020100
4,(CDATA(1),OBJCD(1)),(EQPOS,TMAP(3)) 00020110
C 00020120
C 00020130
C POS AND EQOCC ARE INITIALIZED HERE. POS IS THE POSITION 00020140
C IN CDATA CURRENTLY UNDER SCRUTINY. EQOCC IS AN INDICATOR 00020150
C TO THE VARIABLE CHECKER. IT IS SET TO 3 IF AN '=' HAS 00020160
C BEEN ENCOUNTERED. 00020170
C 00020180
C 00020190
POS=1 00020200
EQOCC=0 00020210
C 00020220
C 00020230
C STATEMENT LABEL 100 HERE IS THE ADDRESS AT WHICH THE SEARCH 00020240
C FOR A NEW TOKEN BEGINS. PNT1 AND PNT2 ARE INDICATORS TO 00020250
C THE VARIOUS PROCESSORS AS TO THE STARTING AND STOPPING POS 00020260
C ITIONS OF STRINGS. A BLANK IN CDATA DELIMITS DATA. 00020270
C CDATA(141) HAS ALREADY BEEN SET TO A BLANK TO INSURE THAT 00020280
C THIS ROUTINE DOES NOT PROCESS FARTHER THAN 140. 00020290
C 00020300
C 00020310
100 PNT1=POS 00020320
CHAR=CDATA(POS) 00020330
IF(CHAR.EQ.BLANK) GO TO 1000 00020340
DO 150 I=2,9 00020350
IF(CHAR.EQ.OPER(I)) GO TO 200 00020360
150 CONTINUE 00020370
GO TO 400 00020380
C 00020390
C 00020400
C THIS SECTION ENTERS THE TOKEN FOR AN OPERATOR WITH 00020410
C THE FORMULA: TOKEN=28672+OPNUM. '**' IS ONE TOKEN WITH AN 00020420
C OPNUM OF 10. ')(' IS THREE TOKENS, THE '*' BEING IMPLIED. 00020430
C 00020440
C 00020450
200 IF(I.NE.6) GO TO 250 00020460
EQOCC=3 00020470
IF(EQPOS.EQ.0) EQPOS=TOKPT+1 00020480
C 00020490
C 00020500
C A SERIES OF TESTS ARE PERFORMED TO DETERMINE IF THE INCOMING 00020510
C CHARACTER SHOULD BE CONSIDERED AS A UNARY OPERATOR. IF IT 00020520
C PASSES THESE TESTS, THE OPERATOR IS CONSIDERED PART OF THE 00020530
C NUMBER AND CONTROL IS PASSED TO THE NUMERIC PROCESSING PART 00020540
C OF THIS ROUTINE. 00020550
C 00020560
C 00020570
250 IF(I.NE.2.AND.I.NE.3) GO TO 290 00020580
LASTI=MOD(TOKEN(TOKPT),4096) 00020590
IF(LASTI.NE.6.AND.LASTI.NE.7.AND.LASTI.NE.9) GO TO 290 00020600
DO 260 N=1,11 00020610
IF(CDATA(POS+1).EQ.NMSET(N)) GO TO 270 00020620
260 CONTINUE 00020630
GO TO 290 00020640
270 POS=POS+1 00020650
NMBIT=2 00020660
GO TO 500 00020670
C 00020680
C 00020690
C THE OPERATOR IS NOT UNARY, PROCESSING CONTINUES. 00020700
C 00020710
C 00020720
290 TOKPT=TOKPT+1 00020730
IF(TOKPT.GT.80) CALL NDT12(2) 00020740
IF(I.EQ.4.AND.CDATA(POS+1).EQ.OPER(4)) GO TO 300 00020750
TOKEN(TOKPT)=28672+I 00020760
POS=POS+1 00020770
IF(I.NE.8.OR.CDATA(POS).NE.OPER(7)) GO TO 350 00020780
TOKPT=TOKPT+1 00020790
IF(TOKPT.GT.80) CALL NDT12(2) 00020800
TOKEN(TOKPT)=28676 00020810
GO TO 350 00020820
300 TOKEN(TOKPT)=28682 00020830
POS=POS+2 00020840
350 CALL NDT23(PNT1,TMAP(TOKPT)) 00020850
GO TO 100 00020860
C 00020870
C 00020880
C THIS SECTION ASSUMES A VARIABLE IS BEING SCANNED IF THE 00020890
C STARTING POSITION IS NOT A 'NUM' OR 'POINT'. IT FINDS 00020900
C THE END OF THE STRING (DELIMITED BY AN 'OPER'), AND CALLS 00020910
C THE APPROPRIATE ROUTINE. 00020920
C 00020930
C 00020940
400 NMBIT=1 00020950
DO 450 I=1,11 00020960
IF(CHAR.EQ.NMSET(I)) NMBIT=2 00020970
450 CONTINUE 00020980
500 POS=POS+1 00020990
CHAR=CDATA(POS) 00021000
IF(CHAR.EQ.BLANK) GO TO 600 00021010
DO 570 I=NMBIT,9 00021020
PNT2=POS-1 00021030
IF(CHAR.EQ.OPER(I).AND.(CDATA(PNT2).NE.CRSET(8).OR.(I.NE.2. 00021040
1 AND.I.NE.3).OR.NMBIT.EQ.1)) GO TO 600 00021050
570 CONTINUE 00021060
GO TO 500 00021070
600 PNT2=POS-1 00021080
IF(NMBIT.EQ.1) GO TO 620 00021090
CALL NDT22(PNT1,PNT2) 00021100
GO TO 100 00021110
620 CALL NDT24(PNT1,PNT2,RTC) 00021120
C 00021130
C 00021140
C IF THE NEXT CHARACTER AFTER A VARIABLE-TYPE STRING IS AN 00021150
C '(' NDT25 IS CALLED. IF NOT IT IS ASSUMED TO BE A VARIABLE. 00021160
C 00021170
C 00021180
IF(CHAR.NE.OPER(7)) GO TO 800 00021190
CALL NDT25 (PNT1,PNT2,RTC) 00021200
GO TO 100 00021210
800 IF(RTC.EQ.0) GO TO 900 00021220
TOKPT=TOKPT+1 00021230
IF(TOKPT.GT.80) CALL NDT12(2) 00021240
TOKEN(TOKPT)=24576 00021250
GO TO 950 00021260
900 CALL NDT27 (PNT1,EQOCC) 00021270
950 IF(CHAR.NE.OPER(1)) GO TO 100 00021280
C 00021290
C 00021300
C IF A VARIABLE IS FOLLOWED BY A 'POINT' THE SUBSCRIPT CHECKER 00021310
C IS CALLED TO UPDATE THE ALREADY EXITING TOKEN AND PRODUCE 00021320
C ANY ASSOCIATED ERROR MESSAGES. 00021330
C 00021340
C 00021350
POS=POS+1 00021360
CALL NDT26 (POS) 00021370
GO TO 100 00021380
C 00021390
C 00021400
C THE TOKEN PROCESSING FOR THIS EQUATION HAS BEEN COMPLETED. 00021410
C WHAT FOLLOWS IS A SIMPLE SCAN OVER THE TOKEN RECORD TO LOCATE 00021420
C ERRORS SUCH AS A MISSING OR MISPLACED EQUALS SIGN OR MISSING 00021430
C BEGINNING VARIABLE. 00021440
C 00021450
C 00021460
1000 CALL NDT38 00021470
RETURN 00021480
END 00021500
C***************************************************************** 00021510
C * 00021520
C COPYRIGHT (C) 1978 - UNIVERSITY OF NOTRE DAME * 00021530
C PROGRAM AUTHOR - TIMOTHY J. MALLOY * 00021540
C * 00021550
C***************************************************************** 00021560
SUBROUTINE NDT09 00021570
C***************************************************************** 00021580
C * 00021590
C OUTPUT LEXICAL ANALYZER / COMPILER * 00021600
C * 00021610
C * 00021620
C THIS PROGRAM ANALYZES AN OUTPUT REQUEST FOR SYNTACTICAL * 00021630
C ERRORS AND BUILDS THE OUTPUT BUFFER. NDT09 IS CALLED BY * 00021640
C NDT01, AND IN TURN CALLS NDT30 THROUGH NDT34, AND NDT13. * 00021650
C * 00021660
C * 00021670
C * 00021680
C OUTPT, AN ARRAY OF LENGTH 240, IS THE OUTPUT BUFFER. IT * 00021690
C CONTAINS INFORMATION USED BY THE OUTPUT PHASE TO DETERMINE * 00021700
C THE TYPE AND FORMAT OF THE OUTPUT. THE FOLLOWING VARIABLES* 00021710
C ARE STORED IN THIS ARRAY: * 00021720
C * 00021730
C POSITION VARI- DESCRIPTION * 00021740
C IN OUTPT ABLE * 00021750
C --------- ----- -----------------------------------------* 00021760
C 1 VARCT NUMBER OF VARIABLES ON THE OUTPUT CARD * 00021770
C 2 TYPE TYPE INDICATES A PRINT OR A PLOT. * 00021780
C 3 RUNNO THE HIGHEST RUN NUMBER REQUESTED * 00021790
C 4 - 91 VNAM EACH VARIABLE NAME (UP TO 6 CHARACTERS * 00021800
C PLUS THE RUN NUMBER) IS PLACED HERE, * 00021810
C CENTERED. THE INDEPENDENT VARIABLE NAME * 00021820
C FIELD STARTS AT POSITION 4. * 00021830
C 92 - 102 VNUM EACH VARIABLE NUMBER IS PLACED HERE; THE * 00021840
C INDEPENDENT VARIABLE NUMBER IS IN * 00021850
C VNUM(1), OUTPT(92). * 00021860
C 103 - 124 LOW A REAL ARRAY, LOW CONTAINS THE LOW VALUE * 00021870
C FOR THE RANGE OF EACH VARIABLE. * 00021880
C 125 - 146 HIGH A REAL ARRAY, HIGH CONTAINS THE HIGH * 00021890
C VALUE FOR THE RANGE OF EACH VARIABLE. * 00021900
C 147 - 157 FLAG FLAG CONTAINS DEFAULT INFORMATION FOR A * 00021910
C PLOT VARIABLE'S RANGE. * 00021920
C ONE'S DIGIT - 0,1,2,3 * 00021930
C 0 - NO DEFAULTS * 00021940
C 1 - LOW DEFAULT * 00021950
C 2 - HIGH DEFAULT * 00021960
C 3 - BOTH DEFAULTS * 00021970
C TEN'S DIGIT * 00021980
C THERE IS ONE CLAUSE IN EACH * 00021990
C SERIES WHICH CONTAINS THE RANGE * 00022000
C FOR THAT SERIES. THIS DIGIT * 00022010
C POINTS TO IT. * 00022020
C 158 IVPLT A FLAG TO DENOTE AN INDEP. VAR. PLOT * 00022030
C 159 - 177 ----- RESERVED * 00022040
C 178 SRCNT THE NUMBER OF SERIES ON THIS OUTPUT CARD.* 00022050
C 179 - 189 RUN THE RUN NUMBER OF THE VARIABLE TO BE USED* 00022060
C ON THE OUTPUT IS STORED HERE. IT MUST BE* 00022070
C BETWEEN 1 AND THE NUMBER OF RERUNS. * 00022080
C 190 - 199 CHAR NOT USED FOR A PRINT, THE CHARACTER IS * 00022090
C USED ON THE PLOT FOR ITS VARIABLE. * 00022100
C 200 CFLAG CFLAG INDICATES THE PRESCENCE OF ANY * 00022110
C TITLE INFO IN THE USER'S COMMENT FIELD. * 00022120
C * 00022130
C***************************************************************** 00022140
REAL*8 RMIN,RMAX,LITBL(1024) 00022150
REAL*8 LOW(11),HIGH(11) 00022160
INTEGER PTRS(45),TITLE(120),CRSET(39),OPER(9),SYM(15), 00022170
1SUBSC(6),TYPCT(20),EQCHN(80),TOKEN(80),CARD1(80),CARD2(80), 00022180
2ERROR(80),OBJCD(160),DEF(80),XREF(80),TMAP(80),FCTN(5,22), 00022190
3SYMTB(5,512) 00022200
INTEGER CDATA(144),OUTPT(240),VARCT,TYPE,RUNNO,VNUM(11), 00022210
1FLAG(11),RUN(11),CHAR(10),CFLAG,SRCNT,IVPLT 00022220
INTEGER DMODE,RMODE,SMODE,LOOP,CLNUM,BGF(4),NDF(4), 00022230
1SRNUM,CLFST,SLASH,BLANK,VMAX,SFLAG, 00022240
2NARO,XCHAR,OPTNS,TIME(8) 00022250
COMMON RMIN,RMAX,PTRS,TITLE,CRSET,OPER,SYM,SUBSC,TYPCT, 00022260
1EQCHN,TOKEN,CARD1,CARD2,ERROR,OBJCD,DEF,XREF,TMAP,FCTN, 00022270
2SYMTB,LITBL 00022280
EQUIVALENCE (OUTPT(1),DEF(1),VARCT),(OUTPT(2),TYPE), 00022290
1(OUTPT(3),RUNNO),(OUTPT(92),VNUM(1)),(OUTPT(103),LOW(1)), 00022300
2(OUTPT(125),HIGH(1)),(OUTPT(147),FLAG(1)),(OUTPT(158),IVPLT), 00022310
3(OUTPT(178),SRCNT),(OUTPT(179),RUN(1)),(OUTPT(190),CHAR(1)), 00022320
4(OUTPT(200),CFLAG),(CDATA(1),OBJCD(1)) 00022330
EQUIVALENCE (DMODE,OUTPT(201)),(RMODE,OUTPT(202)), 00022340
1(SMODE,OUTPT(203)),(LOOP,OUTPT(204)),(CLNUM,OUTPT(205)), 00022350
2(BGF(1),OUTPT(206)),(NDF(1),OUTPT(210)),(OPTNS,PTRS(7)), 00022360
3(SRNUM,OUTPT(220)),(CLFST,OUTPT(221)),(VMAX,OUTPT(223)) 00022370
EQUIVALENCE (SLASH,OPER(5)),(BLANK,CRSET(1)) 00022380
EQUIVALENCE (SFLAG,OUTPT(222)) 00022390
DATA TIME /'T','I','M','E',' ',' ',' ',' '/ 00022400
C***************************************************************** 00022410
C * 00022420
C THIS FIRST SECTION INITIALIZES SOME OF THE VARIABLES USED. * 00022430
C * 00022440
C DMODE DATA MODE -1 BEGINNING DATA MODE * 00022450
C (BEFORE A LEGAL CHARACTER OCCURS)* 00022460
C 0 INTERIOR MODE * 00022470
C 1 END MODE - END OF DATA * 00022480
C 2 END MODE - INDEPENDENT VARIABLE * 00022490
C * 00022500
C SMODE SERIES MODE -1 NO RANGE DEFINED * 00022510
C 0 FIRST RANGE DEFINITION * 00022520
C 1 RANGE PREVIOUSLY DEFINED * 00022530
C * 00022540
C ZERO OUT THE OUTPT ARRAY. * 00022550
C * 00022560
C***************************************************************** 00022570
DO 50 XCHAR = 1, 157 00022580
50 OUTPT(XCHAR) = 0 00022590
DO 60 XCHAR = 179, 200 00022600
60 OUTPT(XCHAR) = 0 00022610
DMODE = -1 00022620
SMODE = -1 00022630
SRCNT = 1 00022640
C***************************************************************** 00022650
C * 00022660
C CLNUM, CURRENT CLAUSE NUMBER, AND CLFST, THE FIRST CLAUSE * 00022670
C IN THE CURRENT SERIES, ARE SET FOR THE FIRST CLAUSE. * 00022680
C * 00022690
C***************************************************************** 00022700
CLNUM = 2 00022710
CLFST = 2 00022720
C***************************************************************** 00022730
C * 00022740
C NARO IS 1 FOR THE NARROW OUTPUT OPTION, 0 FOR WIDE. * 00022750
C * 00022760
C TYPE IS SET TO DENOTE PRINT OR PLOT, 12 OR 13. * 00022770
C * 00022780
C VMAX, THE MAXIMUM NUMBER OF VARIABLES ALLOWED, IS SET TO * 00022790
C 10 FOR WIDE OUTPUT, 5 FOR A NARROW PRINT, AND 6 FOR A * 00022800
C NARROW PLOT. * 00022810
C * 00022820
C***************************************************************** 00022830
TYPE = TOKEN(1) 00022840
NARO = MOD(OPTNS/8,2) 00022850
VMAX = 11 - NARO*(TYPE-8) 00022860
C***************************************************************** 00022870
C * 00022880
C IVPRT WILL BE 0 FOR A REGULAR PLOT, * 00022890
C AND 1 FOR AN INDEPENDENT VARIABLE PLOT. * 00022900
C * 00022910
C LOOP, THE CURRENT CHARACTER POSITION IN CDATA, IS SET TO 0.* 00022920
C * 00022930
C***************************************************************** 00022940
IVPLT = 0 00022950
LOOP = 0 00022960
C***************************************************************** 00022970
C * 00022980
C EACH SEARCH FOR A NEW CLAUSE BEGINS HERE. * 00022990
C * 00023000
C * 00023010
C CALL THE OUTPUT FIELD PROCESSOR TO GET THE BEGINNING AND * 00023020
C END FIELDS FOR THIS CLAUSE. * 00023030
C IF BGF(1) INDICATES THAT NDT30 FOUND NO VARIABLE, * 00023040
C GO TO THE RETURN SECTION. * 00023050
C THEN PROCESS THESE FIELDS BY CALLING THE OUTPUT VARIABLE * 00023060
C PROCESSOR, AND IF THE CARD IS A PLOT CARD, THE PLOT * 00023070
C CHARACTER PROCESSOR AND THE OUTPUT RANGE ANALYZER. * 00023080
C * 00023090
C***************************************************************** 00023100
100 CALL NDT30 00023110
IF (BGF(1) .LT. 0) GO TO 800 00023120
CALL NDT31 00023130
IF (TYPE .EQ. 12) GO TO 150 00023140
CALL NDT32 00023150
CALL NDT33 00023160
C***************************************************************** 00023170
C * 00023180
C IF THE CLAUSE JUST PROCESSED WAS THE INDEPENDENT VARIABLE, * 00023190
C GO TO THE RETURN SECTION. * 00023200
C * 00023210
C***************************************************************** 00023220
150 IF (CLNUM .EQ. 1) GO TO 800 00023230
C***************************************************************** 00023240
C * 00023250
C GO TO END OF DATA SECTION IF DMODE INDICATES END OF DATA. * 00023260
C * 00023270
C CHECK FOR AN AUTOPLOT OUTPUT CARD. * 00023280
C * 00023290
C***************************************************************** 00023300
IF (CLNUM .GT. VMAX) GO TO 200 00023310
IF (DMODE .GT. 0) GO TO 500 00023320
IF (RUNNO .NE. 0) GO TO 175 00023330
CALL NDT13(LOOP,724,2) 00023340
GO TO 250 00023350
C***************************************************************** 00023360
C * 00023370
C CHECK FOR MORE VARIABLES THAN PERMITTED. * 00023380
C IF LESS THAN VMAX, SEARCH FOR A NEW CLAUSE. * 00023390
C AN ERROR OCCURS IF CLNUM GREATER THAN VMAX. * 00023400
C * 00023410
C***************************************************************** 00023420
175 CLNUM = CLNUM + 1 00023430
GO TO 100 00023440
200 CALL NDT13(LOOP,6*NARO+711,2) 00023450
C***************************************************************** 00023460
C * 00023470
C THE END OF THE CARD HAS NOT OCCURED, SO * 00023480
C SEARCH FOR INDEPENDENT VARIABLE. * 00023490
C * 00023500
C A DOUBLE SLASH DENOTES AN INDEPENDENT VARIABLE. * 00023510
C SINCE A PRINT IS NOT ALLOWED TO HAVE AN INDEPENDENT VARIBLE* 00023520
C DO NOT LOOK FOR ONE. * 00023530
C * 00023540
C***************************************************************** 00023550
250 IF (TYPE .EQ. 12) GO TO 500 00023560
300 LOOP = LOOP + 1 00023570
IF (CDATA(LOOP) .EQ. SLASH) GO TO 400 00023580
IF (CDATA(LOOP) .EQ. BLANK) GO TO 500 00023590
GO TO 300 00023600
400 IF (CDATA(LOOP+1) .NE. SLASH) GO TO 300 00023610
C***************************************************************** 00023620
C * 00023630
C IF AN INDEPENDENT VARIABLE IS FOUND, SET DMODE TO * 00023640
C INDEPENDENT VARIABLE MODE. * 00023650
C * 00023660
C***************************************************************** 00023670
DMODE = 2 00023680
LOOP = LOOP + 1 00023690
C***************************************************************** 00023700
C * 00023710
C END OF CARD * 00023720
C * 00023730
C * 00023740
C SET VARCT TO THE NUMBER OF VARIABLES. * 00023750
C IF IN INDEPENDENT VARIABLE MODE, SEARCH FOR A CLAUSE. * 00023760
C * 00023770
C***************************************************************** 00023780
500 VARCT = CLNUM 00023790
SRCNT = SRCNT - 1 00023800
IF (DMODE .LE. 1) GO TO 600 00023810
CLNUM = 1 00023820
GO TO 100 00023830
C***************************************************************** 00023840
C * 00023850
C TIME IS THE DEFAULT FOR INDEPENDENT VARIABLE, * 00023860
C FILL IN THE NAME, RUN NO. AND VAR NO. IN OUTPT FOR TIME. * 00023870
C * 00023880
C***************************************************************** 00023890
600 DO 700 XCHAR = 1,8 00023900
700 OUTPT(XCHAR+3) = TIME(XCHAR) 00023910
VNUM(1) = 12 00023920
FLAG(1) = 13 00023930
RUN(1) = 1 00023940
C***************************************************************** 00023950
C * 00023960
C ASSIGN ANY PLOT CHARACTER DEFAULTS BY CALLING THE * 00023970
C PLOT CHARACTER DEFAULT ASSIGNMENT ROUTINE. * 00023980
C * 00023990
C***************************************************************** 00024000
800 IF (RUNNO .NE. 0) CALL NDT34 00024010
C***************************************************************** 00024020
C * 00024030
C RETURN TO NDT01 * 00024040
C * 00024050
C***************************************************************** 00024060
RETURN 00024070
END 00024090
C***************************************************************** 00024100
C * 00024110
C COPYRIGHT (C) 1978 - UNIVERSITY OF NOTRE DAME * 00024120
C PROGRAM AUTHOR - THOMAS L EVERMAN JR * 00024130
C * 00024140
C THIS PROGRAM STORES THE MACRO DEFINITION BUFFER BUILT BY * 00024150
C NDT39 ONTO THE SPECIFIED DISK RECORD. * 00024160
C * 00024170
C***************************************************************** 00024180
SUBROUTINE NDT10 00024190
REAL*8 RMIN,RMAX,LITBL(1024) 00024200
INTEGER PTRS(45),TITLE(120),CRSET(39),OPER(9),SYM(15), 00024210
1SUBSC(6),TYPCT(20),EQCHN(80),TOKEN(80),CARD1(80),CARD2(80), 00024220
2ERROR(80),OBJCD(160),DEF(80),XREF(80),TMAP(80),FCTN(5,22), 00024230
3SYMTB(5,512) 00024240
INTEGER REC,DUPFG,DISK,MAC1(80),MAC2(80) 00024250
COMMON RMIN,RMAX,PTRS,TITLE,CRSET,OPER,SYM,SUBSC,TYPCT, 00024260
1EQCHN,TOKEN,CARD1,CARD2,ERROR,OBJCD,DEF,XREF,TMAP,FCTN, 00024270
2SYMTB,LITBL 00024280
EQUIVALENCE (DISK,PTRS(3)),(MAC1(1),DEF(1)), 00024290
1(MAC2(1),XREF(1)) 00024300
C***************************************************************** 00024310
C * 00024320
C SET DUPFG TO 1 SO THAT NDT39 CHECKS FOR DUPLICATE ARGUMENTS* 00024330
C CALL NDT39 TO BUILD BUFFER. IF REC IS RETURNED AS 0, THEN * 00024340
C THE MACRO WAS ALREADY DEFINED AND NO NEW RECORD SHOULD * 00024350
C BE WRITTEN. * 00024360
C * 00024370
C***************************************************************** 00024380
DUPFG = 1 00024390
CALL NDT39 (REC, DUPFG) 00024400
IF (REC .EQ. 0) GO TO 100 00024410
WRITE (DISK'REC) MAC1 00024420
REC = REC + 1 00024430
WRITE (DISK'REC) MAC2 00024440
100 RETURN 00024450
END 00024470
C***************************************************************** 00024480
C * 00024490
C COPYRIGHT (C) 1978 - UNIVERSITY OF NOTRE DAME * 00024500
C PROGRAM AUTHOR - TIMOTHY J. MALLOY * 00024510
C * 00024520
C***************************************************************** 00024530
SUBROUTINE NDT11 00024540
C***************************************************************** 00024550
C * 00024560
C DEF CARD PROCESSOR * 00024570
C * 00024580
C * 00024590
C THIS PROGRAM PROCESSES DEF CARDS. * 00024600
C THE DEF CARD, WHICH WILL BE USED ONLY WHEN THE DOCUMENTER * 00024610
C OPTION IS IN EFFECT, CONTAINS A DEFINITION FOR A VARIABLE. * 00024620
C * 00024630
C THE DEFINITION FOR EACH VARIABLE IS PUT INTO THE DEF * 00024640
C ARRAY, WHICH IS THEN WRITTEN OUT TO DISK. * 00024650
C * 00024660
C***************************************************************** 00024670
REAL*8 RMIN,RMAX,LITBL(1024) 00024680
INTEGER PTRS(45),TITLE(120),CRSET(39),OPER(9),SYM(15), 00024690
1SUBSC(6),TYPCT(20),EQCHN(80),TOKEN(80),CARD1(80),CARD2(80), 00024700
2ERROR(80),OBJCD(160),DEF(80),XREF(80),TMAP(80),FCTN(5,22), 00024710
3SYMTB(5,512) 00024720
INTEGER CDATA(144),DASH(3),BLANK,POINT,DOCBT,CDST1,PGMCT, 00024730
1DISK,LOOP,RTC,PNTR,XCHAR,LENTH,POS,RECNO,BUFFR(5),TOKPT 00024740
COMMON RMIN,RMAX,PTRS,TITLE,CRSET,OPER,SYM,SUBSC,TYPCT, 00024750
1EQCHN,TOKEN,CARD1,CARD2,ERROR,OBJCD,DEF,XREF,TMAP,FCTN, 00024760
2SYMTB,LITBL 00024770
EQUIVALENCE (CDATA(1),OBJCD(1)),(PGMCT,PTRS(22)), 00024780
1(DISK,PTRS(3)),(DOCBT,SYM(12)),(BLANK,CRSET(1)), 00024790
2(CDST1,CDATA(142)),(RECNO,SYM(15)),(POINT,OPER(1)), 00024800
3(TOKPT,TOKEN(3)) 00024810
DATA DASH /' ','-',' '/ 00024820
C***************************************************************** 00024830
C * 00024840
C BEFORE THE VARIABLE SYNTAX CHECKER CAN BE CALLED, THE * 00024850
C STARTING AND STOPPING ADDRESSES OF THE VARIABLE MUST BE * 00024860
C DETERMINED. ON A DEF CARD, SUBSCRIPTING IS NOT ALLOWED. * 00024870
C * 00024880
C BLANK OUT DEF ARRAY. * 00024890
C * 00024900
C***************************************************************** 00024910
DO 50 XCHAR = 1, 80 00024920
50 DEF(XCHAR) = BLANK 00024930
LOOP = 0 00024940
100 LOOP = LOOP + 1 00024950
IF (CDATA(LOOP) .EQ. BLANK) GO TO 200 00024960
IF (CDATA(LOOP) .NE. POINT) GO TO 100 00024970
CALL NDT13(LOOP, 530, 1) 00024980
C***************************************************************** 00024990
C * 00025000
C CHECK THE VARIABLE FOR PROPER SYNTAX. IF IT IS ILLEGAL, * 00025010
C RETURN. THEN CALL THE HASH ENTRY ROUTINE TO GET ITS * 00025020
C TOKEN. * 00025030
C * 00025040
C***************************************************************** 00025050
200 CALL NDT24(1, LOOP-1, RTC) 00025060
IF (RTC .GT. 0) GO TO 1400 00025070
CALL NDT40(BUFFR) 00025080
CALL NDT37(BUFFR,PNTR) 00025090
TOKEN(4) = PNTR - 1 00025100
TOKPT = 4 00025110
C***************************************************************** 00025120
C * 00025130
C THE DOCUMENTER BIT, DOCBT, WILL BE 1 IF A DEF CARD FOR * 00025140
C THIS VARIABLE HAS EXISTED PREVIOUSLY. IF SO, RETURN. * 00025150
C * 00025160
C***************************************************************** 00025170
IF (DOCBT .EQ. 0) GO TO 300 00025180
CALL NDT14(0,152,2) 00025190
GO TO 1400 00025200
C***************************************************************** 00025210
C * 00025220
C SEARCH THE CARD FOR THE COMMENT FIELD. IT BEGINS WITH * 00025230
C THE FIRST NON-BLANK CHARACTER AFTER THE FIRST BLANK * 00025240
C AFTER THE VARIABLE. * 00025250
C * 00025260
C***************************************************************** 00025270
300 DO 400 LOOP = CDST1, 72 00025280
IF (CARD1(LOOP) .EQ. BLANK) GO TO 500 00025290
400 CONTINUE 00025300
GO TO 700 00025310
500 DO 600 LOOP1 = LOOP, 72 00025320
IF (CARD1(LOOP1) .NE. BLANK) GO TO 800 00025330
600 CONTINUE 00025340
C***************************************************************** 00025350
C * 00025360
C THE SEARCH FAILED; NO DEFINITION EXISTS FOR THIS VARIABLE.* 00025370
C * 00025380
C***************************************************************** 00025390
700 CALL NDT14(0, 153, 2) 00025400
GO TO 1400 00025410
C***************************************************************** 00025420
C * 00025430
C THE DEFINTION FIELD HAS BEEN FOUND. SET THE DOCBT, AND * 00025440
C BUILD THE DEF ARRAY. * 00025450
C * 00025460
C***************************************************************** 00025470
800 DOCBT = 1 00025480
DO 900 XCHAR = 1, 6 00025490
900 DEF(XCHAR) = SYM(XCHAR) 00025500
DO 1000 XCHAR = 1, 3 00025510
1000 DEF(XCHAR+6) = DASH(XCHAR) 00025520
LENTH = 73 - LOOP1 00025530
DO 1100 XCHAR = 1, LENTH 00025540
POS = XCHAR + LOOP1 - 1 00025550
1100 DEF(XCHAR+9) = CARD1(POS) 00025560
C***************************************************************** 00025570
C * 00025580
C IF THIS IS THE FIRST OCCURRENCE OF THIS VARIABLE, WRITE * 00025590
C OUT THE DEF ARRAY TO THE DISK AND SET THE RECORD NUMBER * 00025600
C (RECNO) TO THIS LOCATION. IF THIS VARIABLE WAS ALREADY * 00025610
C DEFINED, WRITE THE DEF ARRAY TO THE OLD LOCATION. * 00025620
C * 00025630
C***************************************************************** 00025640
IF (RECNO .EQ. 0) GO TO 1200 00025650
WRITE (DISK'RECNO+6) DEF 00025660
GO TO 1300 00025670
1200 WRITE (DISK'PGMCT+7) DEF 00025680
RECNO = PGMCT + 1 00025690
C***************************************************************** 00025700
C * 00025710
C PACK THE SYMBOL TABLE INFORMATION WHENCE IT CAME. * 00025720
C * 00025730
C***************************************************************** 00025740
1300 CALL NDT40(SYMTB(1,PNTR)) 00025750
C***************************************************************** 00025760
C * 00025770
C RETURN 00025780
C * 00025790
C***************************************************************** 00025800
1400 RETURN 00025810
END 00025830
C COPYRIGHT (C) 1978 - UNIVERSITY OF NOTRE DAME 00025840
C PROGRAM AUTHOR - DANIEL A. POYDENCE 00025850
C 00025860
C 00025870
SUBROUTINE NDT12 (CODE) 00025880
REAL*8 RMIN,RMAX,LITBL(1024) 00025890
INTEGER PTRS(45),TITLE(120),CRSET(39),OPER(9),SYM(15), 00025900
1SUBSC(6),TYPCT(20),EQCHN(80),TOKEN(80),CARD1(80),CARD2(80), 00025910
2ERROR(80),OBJCD(160),DEF(80),XREF(80),TMAP(80),FCTN(5,22), 00025920
3SYMTB(5,512) 00025930
INTEGER CODE 00025940
COMMON RMIN,RMAX,PTRS,TITLE,CRSET,OPER,SYM,SUBSC,TYPCT, 00025950
1EQCHN,TOKEN,CARD1,CARD2,ERROR,OBJCD,DEF,XREF,TMAP,FCTN, 00025960
2SYMTB,LITBL 00025970
WRITE(6,100) CODE 00025980
100 FORMAT(' SYSTEM ERROR:',I2) 00025990
STOP 00026000
END 00026010
C COPYRIGHT 1978 - UNIVERSITY OF NOTRE DAME 00026020
C PROGRAM AUTHOR - GARY PELKEY 00026030
C 00026040
C 00026050
SUBROUTINE NDT13 (POS,CODE,SEVER) 00026060
C 00026070
C 00026080
C THIS ROUTINE PROCESSES ERRORS IN THE LEXICAL PHASE. THE 00026090
C ONLY DIFFERENCE BETWEEN THIS ROUTINE AND NDT14 IS NDT14 00026100
C REQUIRES THE FIRST ARGUMENT (DESIGNATING POSITION ON THE 00026110
C CARD WHERE THE ERROR OCCURED), TO BE IN THE PACKED FORM 00026120
C COMPATIBLE WITH AN ERROR ARRAY ENTRY. THEREFORE, THIS ROUTINE 00026130
C SIMPLY CALLS NDT23 TO PACK THE POSITION IN THE COMPATIBLE 00026140
C FORM AND THEN CALLS NDT14 TO FINISH. 00026150
C 00026160
C 00026170
REAL*8 RMIN,RMAX,LITBL(1024) 00026180
INTEGER PTRS(45),TITLE(120),CRSET(39),OPER(9),SYM(15), 00026190
1SUBSC(6),TYPCT(20),EQCHN(80),TOKEN(80),CARD1(80),CARD2(80), 00026200
2ERROR(80),OBJCD(160),DEF(80),XREF(80),TMAP(80),FCTN(5,22), 00026210
3SYMTB(5,512) 00026220
INTEGER POS,CODE,SEVER,PNT 00026230
COMMON RMIN,RMAX,PTRS,TITLE,CRSET,OPER,SYM,SUBSC,TYPCT, 00026240
1EQCHN,TOKEN,CARD1,CARD2,ERROR,OBJCD,DEF,XREF,TMAP,FCTN, 00026250
2SYMTB,LITBL 00026260
CALL NDT23 (POS,PNT) 00026270
CALL NDT14 (PNT,CODE,SEVER) 00026280
RETURN 00026290
END 00026310
C COPYRIGHT 1978 - UNIVERSITY OF NOTRE DAME 00026320
C PROGRAM AUTHOR - GARY PELKEY 00026330
C 00026340
C 00026350
SUBROUTINE NDT14 (LOC,CODE,SEVER) 00026360
C 00026370
C 00026380
C THIS ROUTINE PROCESSES ALL CONTEXT ERRORS. THE INCOMING 00026390
C ARGUMENT LOC CONTAINS INFORMATION AS TO WHICH CARD AND 00026400
C WHICH POSITION ON THE CARD THE ERROR OCCURED; ALL IN A FORM 00026410
C COMPATIBLE WITH THE FIRST WORD OF AN ERROR ENTRY. EACH 00026420
C ERROR ENTRY CONSISTS OF 2 CONSECUTIVE WORDS IN THE ERROR 00026430
C ARRAY STARTING WITH ERROR(3). ERROR(2) OR ERRPT POINTS TO 00026440
C THE LAST WORD USED IN THE ERROR ARRAY. IN ADDITION TO THE 00026450
C ABOVE, THE FIRST WORD OF AN ERROR ENTRY CONTAIN INFORMATION 00026460
C AS TO THE SEVERITY OF THE ERROR. THE SECOND WORD IS A CODE 00026470
C USED TO SPECIFY WHICH ERROR HAS OCCURED. PROCESSING OF ERRORS 00026480
C IS SKIPPED IF ERRPT IS 80 OR IF THE INCOMING ERROR IS A 00026490
C WARNING AND THE NOWARN OPTION HAS BEEN SPECIFIED. EQCND AND 00026500
C PGMCD ARE UPDATED IF THE ERROR IS OF HIGHER SEVERITY THAN 00026510
C ANY IN THIS EQUATION THUS FAR OR IN THE PROGRAM THUS FAR, 00026520
C RESPECTIVLY. WARNS, ERRS, AND CRITS ARE INCRIMENTED DEPENDING 00026530
C ON WHETHER THE ERROR WAS A WARNING, ERROR OR CRITICAL. 00026540
C 00026550
C 00026560
REAL*8 RMIN,RMAX,LITBL(1024) 00026570
INTEGER PTRS(45),TITLE(120),CRSET(39),OPER(9),SYM(15), 00026580
1SUBSC(6),TYPCT(20),EQCHN(80),TOKEN(80),CARD1(80),CARD2(80), 00026590
2ERROR(80),OBJCD(160),DEF(80),XREF(80),TMAP(80),FCTN(5,22), 00026600
3SYMTB(5,512) 00026610
INTEGER ERRPT,LOC,SEVER,CODE,EQNCD,PGMCD,DINOG(3),OPTNS,PSSWT 00026620
INTEGER BADNS 00026630
COMMON RMIN,RMAX,PTRS,TITLE,CRSET,OPER,SYM,SUBSC,TYPCT, 00026640
1EQCHN,TOKEN,CARD1,CARD2,ERROR,OBJCD,DEF,XREF,TMAP,FCTN, 00026650
2SYMTB,LITBL 00026660
EQUIVALENCE (ERRPT,ERROR(2)),(EQNCD,ERROR(1)),(OPTNS,PTRS(7)) 00026670
EQUIVALENCE (PGMCD,PTRS(15)),(DINOG(1),PTRS(11)) 00026680
EQUIVALENCE (PSSWT,PTRS(10)) 00026690
IF((MOD(OPTNS/256,2).EQ.1.AND.SEVER.EQ.1).OR.ERRPT.EQ.80)GOTO 100000026700
BADNS=SEVER 00026710
IF(PSSWT.EQ.5.AND.BADNS.EQ.3) BADNS=2 00026720
ERROR(ERRPT+1)=LOC+2*BADNS 00026730
ERROR(ERRPT+2)=CODE 00026740
ERRPT=ERRPT+2 00026750
IF(BADNS.GT.EQNCD) EQNCD=BADNS 00026760
IF(BADNS.GT.PGMCD) PGMCD=BADNS 00026770
DINOG(BADNS)=DINOG(BADNS)+1 00026780
1000 RETURN 00026790
END 00026810
C COPYRIGHT 1978 - UNIVERSITY OF NOTRE DAME 00026820
C PROGRAM AUTHOR - GARY PELKEY 00026830
C 00026840
C 00026850
SUBROUTINE NDT15 00026860
C 00026870
C 00026880
C THIS PROGRAM PROCESSES TABLE STATEMENTS. TABLES ARE HANDLED 00026890
C BY LOADING THE ELEMENTS SEQUENTIALLY INTO THE LITERAL TABLE 00026900
C AFTER A POINTER TO THE ENTRY AND ONE WORD SPECIFYING THE 00026910
C NUMBER OF ELEMENTS IN THE TABLE. TWO INSTRUCTIONS OF OBJECT 00026920
C CODE ARE THEN PRODUCED TO LOAD THE -POINTER AND STORE IT 00026930
C INTO THE VNUM OF THE TABLE VARIABLE. IN THIS WAY, AFTER 00026940
C RELOCATION, THE TABLE EXECUTION INSTRUCTIONS CAN FIND THEIR 00026950
C WAY BACK TO THE TABLE DATA THAT THEY MUST OPERATE ON. 00026960
C 00026970
C 00026980
REAL*8 RMIN,RMAX,LITBL(1024) 00026990
INTEGER PTRS(45),TITLE(120),CRSET(39),OPER(9),SYM(15), 00027000
1SUBSC(6),TYPCT(20),EQCHN(80),TOKEN(80),CARD1(80),CARD2(80), 00027010
2ERROR(80),OBJCD(160),DEF(80),XREF(80),TMAP(80),FCTN(5,22), 00027020
3SYMTB(5,512) 00027030
INTEGER COUNT,SAVE,LITCT,POS,TOKPT,START,CRSMT,OBJPT,EQPOS, 00027040
1PNTR,PSSWT 00027050
COMMON RMIN,RMAX,PTRS,TITLE,CRSET,OPER,SYM,SUBSC,TYPCT, 00027060
1EQCHN,TOKEN,CARD1,CARD2,ERROR,OBJCD,DEF,XREF,TMAP,FCTN, 00027070
2SYMTB,LITBL 00027080
EQUIVALENCE (LITCT,PTRS(18)),(TOKPT,TOKEN(3)),(CRSMT,TMAP(1)) 00027090
EQUIVALENCE (OBJPT,OBJCD(1)),(PSSWT,PTRS(10)),(EQPOS,TMAP(3)) 00027100
C 00027110
C 00027120
C COUNT IS THE NUMBER OF NUMERICS ON THE RIGHT OF THE '='. 00027130
C SAVE SAVES THE NEXT AVAILABLE ADDRESS IN THE LITBL FOR 00027140
C FUTURE REFERENCE. LITCT IS BUMPED BY 2 TO RESERVE 2 LOC- 00027150
C ATIONS IN LITBL BEFORE THE ELEMENTS OF THIS TABLE CARD ARE 00027160
C ENTERED. NDT08 IS CALLED TO BREAK THE CARD INTO TOKENS AND 00027170
C TO ENTER THE ENTRYS INTO THE LITBL. 00027180
C 00027190
C 00027200
COUNT=0 00027210
SAVE=LITCT+1 00027220
LITCT=LITCT+2 00027230
CALL NDT08 00027240
C 00027250
C 00027260
C THE NEWLY FORMED TOKENS ARE SEARCHED FOR AN EQUALS SIGN. 00027270
C IF NOT FOUND, THE ASSOCIATED ERRORS HAVE ALREADY BEEN 00027280
C FLAGGED AND THERE IS NOTHING MORE FOR THIS ROUTINE TO DO. 00027290
C OTHERWISE THE TOKENS FROM POS+1 TO TOKPT SEARCHING AND 00027300
C COUNTING THE LITERALS. COMMAS ARE IGNORED UNLESS THEY 00027310
C BEGIN OR END THIS STRING OR UNLESS THEY ARE CONSECUTIVE. 00027320
C ALL OTHER TOKEN TYPES ARE FLAGGED. 00027330
C 00027340
C 00027350
IF(EQPOS.EQ.0) GO TO 900 00027360
POS=EQPOS 00027370
150 START=POS+1 00027380
200 POS=POS+1 00027390
IF(POS.GT.TOKPT) GO TO 600 00027400
IF(TOKEN(POS).GT.0) GO TO 300 00027410
C 00027420
C 00027430
C A LITERAL HAS BEEN FOUND. COUNT IS INCREMENTED AND A NEW 00027440
C LITERAL IS SEARCHED FOR. 00027450
C 00027460
C 00027470
COUNT=COUNT+1 00027480
GO TO 200 00027490
300 IF(TOKEN(POS).EQ.28681) GO TO 400 00027500
C 00027510
C 00027520
C AN OPERATOR, VARIABLE, OR FUNCTION HAS BEEN ENCOUNTERED. 00027530
C IT IS FLAGGED AND THE SEARCH CONTINUES. 00027540
C 00027550
C 00027560
CALL NDT14 (TMAP(POS),804,2) 00027570
GO TO 200 00027580
C 00027590
C 00027600
C A COMMA HAS BEEN ENCOUNTERED. IT IS FLAGGED AS UNNECESSARY 00027610
C IF IT STARTS OR STOPS THIS STRING (IT DELIMITS NOTHING), OR 00027620
C IF IT IS FOLLOWED BY ANOTHER COMMA (CONSECUTIVE DELIMETER). 00027630
C 00027640
C 00027650
400 IF(POS.NE.START.AND.POS.NE.TOKPT) GO TO 500 00027660
CALL NDT14 (TMAP(POS),718,1) 00027670
GO TO 200 00027680
500 IF(TOKEN(POS+1).NE.28681) GO TO 200 00027690
CALL NDT14 (TMAP(POS),701,1) 00027700
POS=POS+1 00027710
GO TO 200 00027720
C 00027730
C 00027740
C IF NO LITERALS WERE FOUND, THE CARD IS BOMBED AND THIS 00027750
C ROUTINE RETURNS. IF ONLY 1 WAS FOUND, AN ERROR IS ISSUED 00027760
C AND PROCESSING CONTINUES. 00027770
C 00027780
C 00027790
600 IF(COUNT.GT.0) GO TO 700 00027800
CALL NDT14 (0,802,3) 00027810
GO TO 900 00027820
700 IF(COUNT.EQ.1.AND.PSSWT.NE.5) CALL NDT14 (0,803,1) 00027830
C 00027840
C 00027850
C THE TWO RESERVED WORDS OF LITBL ARE SET HERE. THE FIRST 00027860
C SIMPLY POINTS TO THE SECOND AND THE SECOND CONTAINS THE 00027870
C NUMBER OF ENTRIES IN THIS TABLE CARD. 00027880
C 00027890
C 00027900
900 LITBL(SAVE+1)=COUNT 00027910
LITBL(SAVE)=SAVE+1 00027920
C 00027930
C 00027940
C TWO INSTRUCTIONS OF OBJECT CODE ARE PRODUCED HERE: 00027950
C L -SAVE 00027960
C S VNUM (OF THIS TABLE VARIABLE) 00027970
C THIS PREVENTS THE TABLE FROM BEING LOST DURING RELOCATION 00027980
C AND PROVIDES A METHOD BY WHICH THE TABLE INSTRUCTION CAN 00027990
C REFERENCE THE DATA. OBJECT CODE IS NOT PRODUCED IF IN RERUN 00028000
C MODE. 00028010
C 00028020
C 00028030
IF(PSSWT.EQ.5.OR.TOKEN(4).EQ.24576) GO TO 1000 00028040
OBJPT=8 00028050
OBJCD(3)=15 00028060
OBJCD(4)=CRSMT 00028070
OBJCD(5)=1 00028080
OBJCD(6)=-SAVE 00028090
OBJCD(7)=2 00028100
PNTR=MOD(TOKEN(4),4096)+1 00028110
CALL NDT41 (SYMTB(1,PNTR)) 00028120
OBJCD(8)=SYM(14) 00028130
1000 RETURN 00028140
END 00028160
C***************************************************************** 00028170
C * 00028180
C COPYRIGHT (C) 1978 - UNIVERSITY OF NOTRE DAME * 00028190
C PROGRAM AUTHOR - THOMAS L EVERMAN JR * 00028200
C * 00028210
C THIS PROGRAM PRODUCES OBJECT CODE FOR EQUATIONS. * 00028220
C * 00028230
C***************************************************************** 00028240
SUBROUTINE NDT16 00028250
REAL*8 RMIN,RMAX,LITBL(1024) 00028260
INTEGER PTRS(45),TITLE(120),CRSET(39),OPER(9),SYM(15), 00028270
1SUBSC(6),TYPCT(20),EQCHN(80),TOKEN(80),CARD1(80),CARD2(80), 00028280
2ERROR(80),OBJCD(160),DEF(80),XREF(80),TMAP(80),FCTN(5,22), 00028290
3SYMTB(5,512) 00028300
INTEGER OPSTK(50),HISTK(50),VASTK(50),NEWOP,NEWHI,OBJPT,EQNCD 00028310
INTEGER CRSMT,STYPE,TOKPT,VAPNT,OHPNT,FNON,PNEST,LAST,EQOCC,PNT 00028320
INTEGER TOKE1,TOKE2,VNUM,NXTOP(10),NXTHI(10),NXLST(10),CKLST(10) 00028330
INTEGER UMIN,FUNC,ACC,OPCOD,TEMP,BRNCH,OPRND,I,STARG,ARGNM,POS 00028340
INTEGER COMMA,SA,VALCT,CBIT 00028350
COMMON RMIN,RMAX,PTRS,TITLE,CRSET,OPER,SYM,SUBSC,TYPCT, 00028360
1EQCHN,TOKEN,CARD1,CARD2,ERROR,OBJCD,DEF,XREF,TMAP,FCTN, 00028370
2SYMTB,LITBL 00028380
EQUIVALENCE (OBJPT,OBJCD(1)),(EQNCD,ERROR(1)),(CRSMT,TMAP(1)), 00028390
1(STYPE,TOKEN(1)),(TOKPT,TOKEN(3)),(VNUM,SYM(14)), 00028400
2(I,BRNCH),(VASTK(1),XREF(1)),(CBIT,TOKEN(2)) 00028410
EQUIVALENCE (VALCT,PTRS(20)) 00028420
C***************************************************************** 00028430
C * 00028440
C OPSTK IS THE OPERATION STACK * 00028450
C HISTK IS THE ASSOCIATED HIERARCHY STACK * 00028460
C VASTK IS THE VARIABLE STACK * 00028470
C NEWOP IS THE LATEST OPERATION ENCOUNTERED. * 00028480
C NEWHI IS THE HIERARCHY OF THE NEW OPERATION. * 00028490
C THE DATA AREAS HAVE VALUES FOR THEIR ELEMENTS WHICH ARE IN * 00028500
C ONE TO ONE CORRESPONDENCE TO THE OPERS ARRAY. * 00028510
C NXTOP CONTAINS A CODE FOR THE OPERATOR. * 00028520
C NXTHI CONTAINS A HIERARCHY FOR THE OPERATOR. * 00028530
C CKLST IS USED AS A COMPARISON FOR CONTEXT ANALYSIS. * 00028540
C NXLST IS USED TO SET UP FOR FUTURE CONTEXT ANALYSIS. * 00028550
C THE ASSOCIATION OF THESE ELEMENTS IS AS FOLLOWS: * 00028560
C 1 - '.' 4 - '*' 7 - '(' 9 - ',' * 00028570
C 2 - '+' 5 - '/' 8 - ')' 10 - 'EXP' * 00028580
C 3 - '-' 6 - '=' * 00028590
C UMIN REPRESENTS THE UNARY MINUS OPERATION * 00028600
C FUNC REPRESENTS A PERFORM FUNCTION OPERATION * 00028610
C ACC IS USED TO DENOTE A RESULT IN THE ACCUMULATOR. * 00028620
C * 00028630
C***************************************************************** 00028640
DATA NXTOP /0,3,4,5,6,2,0,0,1,7/ 00028650
DATA NXTHI /0,2,2,3,3,1,0,0,1,5/ 00028660
DATA CKLST /0,2,2,1,1,3,0,0,1,2/ 00028670
DATA NXLST /0,2,2,2,2,1,0,0,1,2/ 00028680
DATA COMMA /1/, UMIN /8/, FUNC /9/, ACC /0/ 00028690
C***************************************************************** 00028700
C * 00028710
C INITIALIZATION OCCURS BELOW: * 00028720
C OBJPT IS THE OBJCD BUFFER POINTER. * 00028730
C NDT46 IS CALLED TO PLACE THE STATEMENT NUMBER IN OBJCD. * 00028740
C OPSTK AND HISTK ARE SET TO INDICATE EQUATION START. * 00028750
C OHPNT IS THE LENGTH OF OPSTK AND HISTK * 00028760
C TEMP IS THE NUMBER OF TEMPORARY LOCATION ALLOCATED. * 00028770
C FNON IS A FUNCTION NESTING COUNTER. * 00028780
C VAPNT IS THE LENGTH OF THE VARIABLE STACK * 00028790
C PNEST IS THE DEPTH OF PAREN NESTING. * 00028800
C LAST IS THE TYPE OF THE LAST TOKEN ENCOUNTERED. * 00028810
C 0 - NEXT TOKEN MUST BE OPERATION. * 00028820
C 1 - LEFT PAREN OR COMMA, ALLOW UNARY - OPERATION. * 00028830
C 2 - OPERATOR, NO OPERATORS MAY FOLLOW. * 00028840
C EQOCC DENOTES THE OCCURRENCE OF DUPLICATE EQUAL SIGNS. * 00028850
C PNT IS A POINTER TO THE CURRENT TOKEN. * 00028860
C * 00028870
C***************************************************************** 00028880
OBJPT = 2 00028890
CALL NDT46 (15, CRSMT) 00028900
OPSTK(1) = 1 00028910
HISTK(1) = 0 00028920
OHPNT = 1 00028930
FNON = 0 00028940
VAPNT = 0 00028950
PNEST = 0 00028960
LAST = 2 00028970
EQOCC = 1 00028980
PNT = 3 00028990
TEMP = 0 00029000
C***************************************************************** 00029010
C * 00029020
C DETERMINE WHAT ACTION TO TAKE FOR NEXT TOKEN. * 00029030
C SEPARATE TOKEN INTO TOKE1 AND TOKE2. TOKE1 INDICATES TOKEN * 00029040
C TYPE. TOKE2 IS THE TOKEN POINTER. * 00029050
C * 00029060
C***************************************************************** 00029070
100 PNT = PNT + 1 00029080
IF (PNT .GT. TOKPT) GO TO 200 00029090
TOKE1 = TOKEN(PNT) / 4096 00029100
TOKE2 = MOD (TOKEN(PNT), 4096) 00029110
C***************************************************************** 00029120
C * 00029130
C TOKEN IS AN OPERATOR. BRANCH TO THE APPROPRIATE OPERATOR * 00029140
C ACTION ROUTINE. * 00029150
C * 00029160
C***************************************************************** 00029170
IF (TOKE1 .EQ. 7) GO TO (100,400,400,700,700,500,800, 00029180
11100,600,700), TOKE2 00029190
C***************************************************************** 00029200
C * 00029210
C TOKEN IS NOT OPERATOR, THEREFORE IT SHOULD BE ENTERED INTO * 00029220
C THE VARIABLE STACK. IF TOKEN IS NEGATIVE, SET VNUM TO * 00029230
C TOKEN FOR NUMERIC LITERAL. * 00029240
C * 00029250
C***************************************************************** 00029260
IF (TOKEN(PNT) .GE. 0) GO TO 125 00029270
VNUM = TOKEN(PNT) 00029280
GO TO 160 00029290
C***************************************************************** 00029300
C * 00029310
C TOKEN INDICATES VARIABLE OR FUNCTION. ADD 1 TO TOKE1 TO * 00029320
C OBTAIN APPROPRIATE INDEX FOR COMPUTED GO TO. TOKE1 VALUES * 00029330
C ARE AS FOLLOWS: * 00029340
C 1 - 5: VALID VARIABLES OF VARIOUS SUBSCRIPTS. * 00029350
C 6: FUNCTION * 00029360
C 7: INVALID VARIABLE * 00029370
C IF INVALID VARIABLE OR FUNCTION, SET VNUM TO 4999. * 00029380
C FOR FUNCTION, SET VNUM TO INDICATE BOTH FUNCTION OPCODE * 00029390
C AND THE NUMBER OF REQUIRED SAVE AREAS, THEN INCREMENT BY * 00029400
C 5000 FOR IDENTIFICATION IN VASTK. IF VALID VARIABLE, * 00029410
C VNUM WILL BE SET IN UNPACK SUBROUTINE. AFTER VNUM IS * 00029420
C DETERMINED, ENTER IT IN VASTK. ALSO CHECK FOR MISSING * 00029430
C OPERATOR ERROR. * 00029440
C * 00029450
C***************************************************************** 00029460
125 TOKE1 = TOKE1 + 1 00029470
GO TO (150,150,150,150,150,140,130), TOKE1 00029480
130 VNUM = 4999 00029490
GO TO 160 00029500
140 IF (TOKE2 .EQ. 0) GO TO 130 00029510
VNUM = FCTN(5,TOKE2) * 100 + FCTN(3,TOKE2) + 5000 00029520
GO TO 160 00029530
150 CALL NDT41 (SYMTB(1,TOKE2 + 1)) 00029540
160 VAPNT = VAPNT + 1 00029550
VASTK(VAPNT) = VNUM 00029560
IF (LAST .EQ. 0) CALL NDT14 (TMAP(PNT), 406, 3) 00029570
LAST = 0 00029580
GO TO 100 00029590
C***************************************************************** 00029600
C * 00029610
C END OF TOKEN STRING HAS BEEN ENCOUNTERED. * 00029620
C SET NEWOP AND NEWHI TO 1 TO FORCE COMPILATION OF STACKS. * 00029630
C CHECK FOR PAREN BALANCE (403). * 00029640
C MAKE SURE SOMETHING FOLLOWS EQUAL SIGN (404). * 00029650
C DO NOT COMPILE IF THERE HAVE BEEN CRITICAL ERRORS. * 00029660
C BRANCH TO COMPILATION ROUTINES. * 00029670
C * 00029680
C***************************************************************** 00029690
200 NEWOP = 1 00029700
NEWHI = 0 00029710
IF (TOKEN(PNT - 1) .EQ. 28678 .AND. EQOCC .EQ. 2) GO TO 300 00029720
IF (LAST .NE. 0) CALL NDT14 (TMAP(PNT - 1), 402, 3) 00029730
IF (PNEST .GT. 0) CALL NDT14 (CBIT, 403, 3) 00029740
IF (EQNCD .GE. 3) GO TO 1500 00029750
GO TO 1200 00029760
300 CALL NDT14 (TMAP(PNT - 1), 404, 3) 00029770
GO TO 1500 00029780
C***************************************************************** 00029790
C * 00029800
C THE FOLLOWING STATEMENTS ARE EXECUTED WHEN A + OR - SIGN * 00029810
C IS ENCOUNTERED. A CHECK IS MADE TO DETERMINE WHETHER THE * 00029820
C SIGN IS A UNARY OPERATOR. IF A UNARY + OCCURS, IT IS * 00029830
C IGNORED. A UNARY - CAUSES THE SETTING OF NEWOP AND NEWHI * 00029840
C AND A BRANCH TO THE COMPILATION ROUTINES. * 00029850
C IF THE OPERATOR IS NOT UNARY, THE ORDINARY OPERATOR * 00029860
C ROUTINE IS EXECUTED. * 00029870
C * 00029880
C***************************************************************** 00029890
400 IF (LAST .NE. 1) GO TO 700 00029900
LAST = 2 00029910
IF (TOKE2 .EQ. 2) GO TO 100 00029920
NEWOP = UMIN 00029930
NEWHI = 4 + PNEST 00029940
GO TO 1200 00029950
C***************************************************************** 00029960
C * 00029970
C THE CODING BELOW IS EXECUTED TO DETERMINE THE EXISTENCE * 00029980
C OF DUPLICATE EQUAL SIGNS. * 00029990
C * 00030000
C***************************************************************** 00030010
500 IF (EQOCC .NE. 1) CALL NDT14 (TMAP(PNT), 401, 3) 00030020
EQOCC = EQOCC + 1 00030030
GO TO 700 00030040
C***************************************************************** 00030050
C * 00030060
C THE CODING BELOW GIVES AN ERROR WHEN A COMMA OCCURS OUTSIDE* 00030070
C THE ARGUMENT LIST OF A FUNCTION. * 00030080
C * 00030090
C***************************************************************** 00030100
600 IF (FNON .LE. 0) CALL NDT14 (TMAP(PNT), 407, 3) 00030110
C***************************************************************** 00030120
C * 00030130
C THE FOLLOWING CODE IS EXECUTED FOR ALL OPERATORS BUT PARENS* 00030140
C A COMPARISON TO CKLST RAISES ERROR CONDITIONS FOR IMPROPER * 00030150
C OPERATOR SEQUENCES. NEWOP AND NEWHI ARE SET TO THE PROPER * 00030160
C VALUES FOR THE GIVEN OPERATOR. THE VALUE OF LAST IS THEN * 00030170
C SET FOR EVALUATION WHEN THE NEXT TOKEN IS ENCOUNTERED. * 00030180
C * 00030190
C***************************************************************** 00030200
700 IF (LAST .GE. CKLST(TOKE2)) CALL NDT14 (TMAP(PNT), 402, 3) 00030210
NEWOP = NXTOP(TOKE2) 00030220
NEWHI = NXTHI(TOKE2) + PNEST 00030230
LAST = NXLST(TOKE2) 00030240
GO TO 1200 00030250
C***************************************************************** 00030260
C * 00030270
C A LEFT PAREN HAS BEEN ENCOUNTERED. INCREMENT FNON IF IT * 00030280
C IS ALREADY IN FUNCTION MODE. IF LAST IS 0, THERE IS A * 00030290
C POSSIBLE FUNCTION. * 00030300
C * 00030310
C***************************************************************** 00030320
800 IF (FNON .GT. 0) FNON = FNON + 1 00030330
IF (LAST .EQ. 0) GO TO 900 00030340
C***************************************************************** 00030350
C * 00030360
C NO FUNCTION HAS OCCURED. SET LAST TO 1 TO ALLOW UNARY OP. * 00030370
C INCREMENT PAREN NESTING AND GET NEXT TOKEN. (THE PAREN * 00030380
C NESTING INCREMENT IS 10 SO THAT IT IS GREATER THAN THE * 00030390
C HIERARCHY OF ANY OPERATION. THEREFORE, WHEN PNEST IS ADDED* 00030400
C TO THE HIERARCHY OF ANY OPERATION, AN OPERATION WITHIN * 00030410
C PARENS WILL HAVE A GREATER HIERARCHY.) * 00030420
C * 00030430
C***************************************************************** 00030440
850 LAST = 1 00030450
PNEST = PNEST + 10 00030460
GO TO 100 00030470
C***************************************************************** 00030480
C * 00030490
C DETERMINE WHETHER A FUNCTION EXISTS BY CHECKING VASTK. * 00030500
C PREVIOUS TOKEN MAY BE VARIABLE OR LITERAL. * 00030510
C * 00030520
C***************************************************************** 00030530
900 IF (VASTK(VAPNT) .GE. 4999) GO TO 1000 00030540
CALL NDT14 (TMAP(PNT), 406, 3) 00030550
GO TO 850 00030560
C***************************************************************** 00030570
C * 00030580
C PAREN HAS BEEN DETERMINED TO INDICATE FUNCTION. * 00030590
C ENTER IT IN OPSTK AND HISTK, INCREMENT PAREN NESTING, * 00030600
C AND SET FNON IF IT IS NOT ALREADY SET. * 00030610
C * 00030620
C***************************************************************** 00030630
1000 OHPNT = OHPNT + 1 00030640
OPSTK(OHPNT) = FUNC 00030650
HISTK(OHPNT) = 6 + PNEST 00030660
PNEST = PNEST + 10 00030670
IF (FNON .EQ. 0) FNON = 1 00030680
LAST = 1 00030690
GO TO 100 00030700
C***************************************************************** 00030710
C * 00030720
C TOKEN INDICATES A RIGHT PAREN. DECREMENT NESTING. DECREMEN* 00030730
C FNON IF NECESSARY. GIVE PAREN IMBALANCE ERROR (405) AND * 00030740
C INVALID SEQUENCE ERROR(402). * 00030750
C * 00030760
C***************************************************************** 00030770
1100 PNEST = PNEST - 10 00030780
IF (FNON .GT. 0) FNON = FNON - 1 00030790
IF (PNEST .LT. 0) CALL NDT14 (TMAP(PNT), 405, 3) 00030800
IF (LAST .GE. 1) CALL NDT14 (TMAP(PNT), 402, 3) 00030810
LAST = 0 00030820
GO TO 100 00030830
C***************************************************************** 00030840
C * 00030850
C THE FOLLOWING PROGRAM SECTION PRODUCES OBJECT CODE FROM THE* 00030860
C STACK INFORMATION. THE HIERARCHY OF THE NEW OPERATION IS * 00030870
C COMPARED TO THE HIERARCHY OF THE TOP STACK OPERATION. IF * 00030880
C NEWHI IS LESS OR EQUAL THE OPERATIONS IN THE STACK ARE * 00030890
C COMPILED UNTIL NEWHI IS GREATER THAN THE TOP STACK ELEMENT.* 00030900
C WHEN NEWHI IS GREATER, NEWOP AND NEWHI ARE ADDED TO THE * 00030910
C RESPECTIVE STACKS. * 00030920
C * 00030930
C***************************************************************** 00030940
1200 IF (EQNCD .GE. 3) GO TO 100 00030950
IF (NEWHI .GT. HISTK(OHPNT)) GO TO 1400 00030960
BRNCH = OPSTK(OHPNT) 00030970
GO TO (1500,1600,1700,1700,1700,1700,1700,2000,2100), BRNCH 00030980
1400 IF (NEWOP .EQ. COMMA) GO TO 100 00030990
OHPNT = OHPNT + 1 00031000
OPSTK(OHPNT) = NEWOP 00031010
HISTK(OHPNT) = NEWHI 00031020
GO TO 100 00031030
1500 CALL NDT85 00031040
RETURN 00031050
C***************************************************************** 00031060
C * 00031070
C COMPILE = * 00031080
C FIRST CHECK TO SEE IF ACC MUST BE LOADED. THIS OCCURS ONLY * 00031090
C IN THE CASE A=B. STORE THE CONTENTS OF THE ACCUMULATOR IN * 00031100
C THE FIRST ADDRESS IN THE STACK. * 00031110
C * 00031120
C***************************************************************** 00031130
1600 IF (VASTK(2) .NE. ACC) CALL NDT46 (1, VASTK(2)) 00031140
CALL NDT46 (2, VASTK(1)) 00031150
OHPNT = OHPNT - 1 00031160
GO TO 1200 00031170
C***************************************************************** 00031180
C * 00031190
C COMPILE + - * / OR ** * 00031200
C INITIAL OPCODE IS EQUAL TO THE BRNCH VALUE FROM COMP GO TO.* 00031210
C NDT28 DETERMINES WHETHER TEMPORARY STORAGE IS NEEDED. AFTE* 00031220
C NDT28 IS CALLED THE ACCUMULATOR WILL APPEAR IN VASTK AT THE* 00031230
C TOP, 2ND FROM THE TOP, OR NOT AT ALL. * 00031240
C FOR ACC AT TOP OF VASTK: * 00031250
C 1) CHANGE OPCODE OF - / OR ** TO A REVERSE OPERATION. * 00031260
C 2) OPERAND IS ADDRESS 2ND FROM TOP OF VASTK. * 00031270
C FOR ACC AT 2ND POSITION FROM THE TOP: * 00031280
C 1) NORMAL OPERATION IS COMPILED. * 00031290
C 2) OPERAND IS ADDRESS AT TOP OF VASTK. * 00031300
C WHEN ACC DOES NOT OCCUR IN TOP TWO POSITIONS: * 00031310
C 1) GENERATE A LOAD INSTRUCTION WHOSE OPERAND IS THE * 00031320
C ADDRESS SECOND FROM THE TOP OF VASTK. * 00031330
C 2) GENERATE A NORMAL OPERATION FOR THE ADDRESS AT THE * 00031340
C TOP OF VASTK. * 00031350
C OPCOD IS THE OP CODE. * 00031360
C OPRND IS THE OPERAND. * 00031370
C WHEN FINISHED, DECREMENT ALL STACK POINTERS AND PLACE * 00031380
C ACC INDICATOR AT THE TOP OF VASTK. * 00031390
C * 00031400
C***************************************************************** 00031410
1700 OPCOD = BRNCH 00031420
CALL NDT28 (TEMP, VAPNT - 2) 00031430
IF (VASTK(VAPNT) .EQ. ACC) GO TO 1800 00031440
IF (VASTK(VAPNT - 1) .NE. ACC) CALL NDT46 (1, VASTK(VAPNT - 1)) 00031450
OPRND = VASTK(VAPNT) 00031460
GO TO 1900 00031470
1800 IF (OPCOD .EQ. 4) OPCOD = 8 00031480
IF (OPCOD .EQ. 6) OPCOD = 9 00031490
IF (OPCOD .EQ. 7) OPCOD = 10 00031500
OPRND = VASTK(VAPNT - 1) 00031510
1900 CALL NDT46 (OPCOD, OPRND) 00031520
VAPNT = VAPNT - 1 00031530
VASTK(VAPNT) = ACC 00031540
OHPNT = OHPNT - 1 00031550
GO TO 1200 00031560
C***************************************************************** 00031570
C * 00031580
C COMPILE UNARY * 00031590
C NDT28 IS CALLED FOR TEMPORARY STORAGE ALLOCATION. * 00031600
C STORE INSTRUCTION GENERATED IN NDT28 WILL ZERO ACC. * 00031610
C NEGATION OCCURS BY SUBTRACTING DATA FROM ACC. * 00031620
C OPSTK IS DECREMENTED AND RESULT IS IN ACC AT TOP OF VASTK. * 00031630
C * 00031640
C***************************************************************** 00031650
2000 CALL NDT28 (TEMP, VAPNT) 00031660
CALL NDT46 (4, VASTK(VAPNT)) 00031670
VASTK(VAPNT) = ACC 00031680
OHPNT = OHPNT - 1 00031690
GO TO 1200 00031700
C***************************************************************** 00031710
C * 00031720
C COMPILE FUNCTIONS * 00031730
C NDT28 IS CALLED TO GENERATE REQUIRED TEMPORARY STORAGE. * 00031740
C THE VARIABLE STACK IS SEARCHED DOWNWARD FROM THE TOP * 00031750
C UNTIL AN ADDRESS GREATER THAN 5000 INDICATES A FUNCTION. * 00031760
C THE FUNCTION ARGUMENTS ARE CONTAINED IN THE ADDRESSES * 00031770
C IN VASTK ABOVE THE FUNCTION. THEY ARE LOADED AND STORED * 00031780
C IN VARIABLE ARRAY LOCATIONS 17 - 21, AS NEEDED. THE * 00031790
C VASTK IS DEMODULATED TO OBTAIN THE FUNCTION OPCODE AND * 00031800
C THE SAVE AREA ADDRESS AS THE OPRND. INCREMENT THE VALCT * 00031810
C TO THE END OF THE FUNCTION'S SAVE AREA. * 00031820
C * 00031830
C***************************************************************** 00031840
2100 CALL NDT28 (TEMP, VAPNT) 00031850
DO 2200 I = 1, VAPNT 00031860
POS = VAPNT + 1 - I 00031870
IF (VASTK(POS) .GE. 5000) GO TO 2300 00031880
2200 CONTINUE 00031890
2300 STARG = POS + 1 00031900
ARGNM = 16 00031910
DO 2400 I = STARG, VAPNT 00031920
ARGNM = ARGNM + 1 00031930
CALL NDT46 (1, VASTK(I)) 00031940
2400 CALL NDT46 (2, ARGNM) 00031950
OPCOD = VASTK(POS) - 5000 00031960
SA = OPCOD / 100 00031970
OPCOD = MOD (OPCOD, 100) 00031980
IF (SA .EQ. 0) CALL NDT46 (OPCOD, 0) 00031990
IF (SA .NE. 0) CALL NDT46 (OPCOD, VALCT + 1) 00032000
VALCT = VALCT + SA 00032010
VAPNT = POS 00032020
VASTK(VAPNT) = ACC 00032030
OHPNT = OHPNT - 1 00032040
GO TO 1200 00032050
END 00032070
C***************************************************************** 00032080
C * 00032090
C COPYRIGHT (C) 1978 - UNIVERSITY OF NOTRE DAME * 00032100
C PROGRAM AUTHOR - TIMOTHY J. MALLOY * 00032110
C * 00032120
C***************************************************************** 00032130
SUBROUTINE NDT17 00032140
C***************************************************************** 00032150
C * 00032160
C DEFAULT DOCUMENTATION GENERATOR * 00032170
C * 00032180
C * 00032190
C THIS PROGRAM PREPARES THE DOCUMENTATION AREAS FOR THE CARD * 00032200
C CURRENTLY IN CARD1. IT TAKES THE USER'S COMMENT FIELD AND * 00032210
C PUTS IT IN THE DEF ARRAY. IF THE COMMENT FIELD IS BLANK, * 00032220
C "NO DEFINITION PROVIDED" IS INSERTED. * 00032230
C * 00032240
C***************************************************************** 00032250
REAL*8 RMIN,RMAX,LITBL(1024) 00032260
INTEGER PTRS(45),TITLE(120),CRSET(39),OPER(9),SYM(15), 00032270
1SUBSC(6),TYPCT(20),EQCHN(80),TOKEN(80),CARD1(80),CARD2(80), 00032280
2ERROR(80),OBJCD(160),DEF(80),XREF(80),TMAP(80),FCTN(5,22), 00032290
3SYMTB(5,512) 00032300
INTEGER DEFBT,DOCBT,DASH(3),NODEF(22),BLANK,CDST1, 00032310
1LENTH,LOOP,LOOP1,XCHAR,POS,PNTR,CDATA(144),STYPE 00032320
COMMON RMIN,RMAX,PTRS,TITLE,CRSET,OPER,SYM,SUBSC,TYPCT, 00032330
1EQCHN,TOKEN,CARD1,CARD2,ERROR,OBJCD,DEF,XREF,TMAP,FCTN, 00032340
2SYMTB,LITBL 00032350
EQUIVALENCE (DEFBT,SYM(11)),(DOCBT,SYM(12)),(BLANK,DASH(1)), 00032360
1(CDST1,CDATA(142)),(STYPE,TOKEN(1)) 00032370
EQUIVALENCE (CDATA(1),OBJCD(1)) 00032380
DATA DASH /' ','-',' '/ 00032390
DATA NODEF /'N','O',' ','D','E','F','I','N','I','T','I','O', 00032400
1 'N',' ','P','R','O','V','I','D','E','D'/ 00032410
C***************************************************************** 00032420
C * 00032430
C THE FORMAT OF THE DEF ARRAY IS AS FOLLOWS: * 00032440
C * 00032450
C POSITION IN DEF * 00032460
C 1 -- 6 10 --- 80 * 00032470
C VARIABLE - DEFINITION FIELD * 00032480
C * 00032490
C * 00032500
C FIRST, THE TOKEN MUST BE A LEGAL VARIABLE. TOKEN(4) WILL * 00032510
C INDICATE IF THE TOKEN IS A VARIABLE. UNPACK THE TOKEN FROM* 00032520
C THE SYMBOL TABLE, AND THE DEFINE BIT WILL TELL IF THE * 00032530
C VARIBLE IS LEGAL. * 00032540
C * 00032550
C***************************************************************** 00032560
IF (TOKEN(4) .LT. 0 .OR. TOKEN(4) .GT. 20479) GO TO 1100 00032570
PNTR = MOD(TOKEN(4),4096) + 1 00032580
CALL NDT41(SYMTB(1,PNTR)) 00032590
IF (DEFBT .EQ. 0) GO TO 1100 00032600
C***************************************************************** 00032610
C * 00032620
C IF A DEF CARD FOR THIS VARIABLE HAS BEEN ENCOUNTERED, OR * 00032630
C THE EQUATION IS FOR AN INITIAL VALUE AND THE DEFINING * 00032640
C EQUATION'S COMMENT FIELD HAS ALREADY BEEN USED, DO * 00032650
C NOT PROCESS THIS CARD'S COMMENT FIELD. * 00032660
C * 00032670
C BEGIN PROCESSING BY PUTTING THE VARIABLE NAME INTO THE * 00032680
C DEF ARRAY, ALONG WITH THE DASH. * 00032690
C * 00032700
C***************************************************************** 00032710
IF (DOCBT.EQ.1.OR.(STYPE.EQ.4.AND.DEF(10).NE.0)) GO TO 1100 00032720
DO 50 XCHAR = 1, 80 00032730
50 DEF(XCHAR) = BLANK 00032740
DO 100 XCHAR = 1, 6 00032750
100 DEF(XCHAR) = SYM(XCHAR) 00032760
DO 200 XCHAR = 1, 3 00032770
200 DEF(XCHAR + 6) = DASH(XCHAR) 00032780
C***************************************************************** 00032790
C * 00032800
C THE USER'S COMMENT FIELD BEGINS AT THE FIRST NON-BLANK * 00032810
C CHARACTER AFTER THE FIRST BLANK AFTER THE EQUATION ON * 00032820
C THIS CARD. * 00032830
C * 00032840
C***************************************************************** 00032850
DO 400 LOOP = CDST1, 72 00032860
IF (CARD1(LOOP) .EQ. BLANK) GO TO 500 00032870
400 CONTINUE 00032880
GO TO 700 00032890
500 DO 600 LOOP1 = LOOP, 72 00032900
IF (CARD1(LOOP1) .NE. BLANK) GO TO 900 00032910
600 CONTINUE 00032920
C***************************************************************** 00032930
C * 00032940
C IF THE FIELD IS BLANK, PUT THE DEFAULT MESSAGE INTO DEF. * 00032950
C * 00032960
C***************************************************************** 00032970
700 DO 800 XCHAR = 1, 22 00032980
800 DEF(XCHAR + 9) = NODEF(XCHAR) 00032990
GO TO 1100 00033000
C***************************************************************** 00033010
C * 00033020
C IF THE FIELD DID INDEED EXIST, PUT THE FIELD INTO DEF. * 00033030
C * 00033040
C***************************************************************** 00033050
900 LENTH = 73 - LOOP1 00033060
DO 1000 XCHAR = 1, LENTH 00033070
POS = LOOP1 + XCHAR - 1 00033080
1000 DEF(XCHAR + 9) = CARD1(POS) 00033090
C***************************************************************** 00033100
C * 00033110
C RETURN SECTION * 00033120
C * 00033130
C***************************************************************** 00033140
1100 RETURN 00033150
END 00033170
C COPYRIGHT 1978 - UNIVERSITY OF NOTRE DAME 00033180
C PROGRAM AUTHOR - GARY PELKEY 00033190
C 00033200
C 00033210
SUBROUTINE NDT18 00033220
C 00033230
C 00033240
C THIS ROUTINE PROCESSES RERUN CARDS. ITS MAIN FUNCTIONS ARE 00033250
C TO TIE OFF AND WRITE OUT PREVIOUSLY BUILT RERUN BUFFERS AND 00033260
C TO INITIALIZE THE BUFFER FOR THE NEXT BATCH OF RERUN CHANGES. 00033270
C 00033280
C 00033290
REAL*8 RMIN,RMAX,LITBL(1024) 00033300
INTEGER PTRS(45),TITLE(120),CRSET(39),OPER(9),SYM(15), 00033310
1SUBSC(6),TYPCT(20),EQCHN(80),TOKEN(80),CARD1(80),CARD2(80), 00033320
2ERROR(80),OBJCD(160),DEF(80),XREF(80),TMAP(80),FCTN(5,22), 00033330
3SYMTB(5,512) 00033340
INTEGER RRBPT,RRBST,RELOC,VALCT,INTBT,RBFPT 00033350
INTEGER RERUN(80),DISK 00033360
COMMON RMIN,RMAX,PTRS,TITLE,CRSET,OPER,SYM,SUBSC,TYPCT, 00033370
1EQCHN,TOKEN,CARD1,CARD2,ERROR,OBJCD,DEF,XREF,TMAP,FCTN, 00033380
2SYMTB,LITBL 00033390
EQUIVALENCE (RRBPT,PTRS(37)),(RRBST,PTRS(36)),(RELOC,PTRS(40)) 00033400
EQUIVALENCE (VALCT,PTRS(20)),(INTBT,RERUN(1),DEF(1)) 00033410
EQUIVALENCE (RBFPT,RERUN(2)),(DISK,PTRS(3)) 00033420
C 00033430
C 00033440
C A NEGATIVE RRBPT INDICATES THAT THIS IS THE FIRST RERUN CARD 00033450
C THUS FAR ENCOUNTERED. NO TIE OFF IS NECESSARY BUT EQUATION 00033460
C CHAINING MUST BE TERMINATED BY CALLING NDT21 WITH A 0. 00033470
C RELOC IS SET HERE THUS DEFINING THE END OF THE MAINLINE VAR 00033480
C IABLES AND THE BEGINNING OF THE LITBL AFTER RELOCATION. 00033490
C RRBPT IS SET SO AS TO BE CORRECT WHEN THIS PROGRAM IS CALLED 00033500
C NEXT. 00033510
C 00033520
C 00033530
IF(RRBPT.GT.0) GO TO 100 00033540
CALL NDT21 (0) 00033550
RELOC=VALCT 00033560
RRBPT=RRBST-1 00033570
GO TO 300 00033580
C 00033590
C 00033600
C IF A RERUN NEEDS TO BE TIED OFF, A GROUP ERROR IS ISSUED IF 00033610
C THERE HAVE BEEN NO VALID RERUN CHANGES REQUESTED SINCE THE 00033620
C LAST RERUN CARD WAS ENCOUNTERED. OTHERWISE THE RERUN BUFFER 00033630
C IS WRITTEN OUT TO DISK AND RRBPT IS INCREMENTED. 00033640
C 00033650
C 00033660
100 IF(INTBT.NE.0.OR.RBFPT.NE.2) GO TO 200 00033670
CALL NDT20 (113,2) 00033680
GO TO 300 00033690
200 WRITE(DISK'RRBPT+1) RERUN 00033700
RRBPT=RRBPT+1 00033710
C 00033720
C 00033730
C IN ALL CASES THE RERUN BUFFER IS INITIALIZED. INTBT IS SET 00033740
C TO ZERO (IF IT COMES BACK AT ZERO, NO INTEGRATION CHANGE WAS 00033750
C REQUESTED), RBFPT IS SET TO 2 (THE LAST USED POSITION OF A 00033760
C RERUN PARM,C OR T CHANGE). POSITIONS 7 THRU 72 OF CARD1 ARE 00033770
C COPIED ONTO THE HIGH END OF THE RERUN BUFFER. 00033780
C 00033790
C 00033800
300 INTBT=0 00033810
RBFPT=2 00033820
RETURN 00033830
END 00033850
C COPYRIGHT (C) 1978 - UNIVERSITY OF NOTRE DAME 00033860
C PROGRAM AUTHOR - GARY PELKEY 00033870
C 00033880
C 00033890
SUBROUTINE NDT19 00033900
C 00033910
C 00033920
C THIS SUBROUTINE PROCESSES CARDS IN RERUN MODE. THE ONLY 00033930
C TYPES OF CARDS PARSED IN CDATA WHEN THIS IS CALLED ARE C,*, 00033940
C T, AND PARM. CONSTANTS MUST BE CHECKED FOR NUMERIC ONLY 00033950
C AND ALL OTHER SYNTAX RULES AS IN THE MAINLINE PROGRAM. 00033960
C THE ONLY CONTROL CARD ALLOWED IS ONE SPECIFYING INTEGRATION 00033970
C TYPE. TABLES MUST HAVE THE SAME NUMBER OF ENTRIES AS ITS 00033980
C DEFINITION IN THE MAINLINE. THE ONLY PARAMATER CHANGE ALLOWED 00033990
C IS DT. DT MUST ALSO BE NUMERIC ONLY IN RERUNS. 00034000
C RERUN CHANGES ARE SAVED IN A RERUN BUFFER. INTEGRATOR CHANGES 00034010
C ARE SAVED IN THE FIRST WORD OF THE BUFFER BUT ALL OTHER 00034020
C CHANGES ARE SAVED AS FOUR CONSECUTIVE WORDS; RBFPT POINTING 00034030
C TO THE LAST CHANGE MADE. THE FIRST TWO OF THE FOUR WORDS IS 00034040
C THE PACKED NAME OF THE VARIABLE. THE NEXT WORD IS STYPE*4096+ 00034050
C VNUM. THE FOURTH WORD IS THE ABSOLUTE LITBL LOCATION OF THE 00034060
C NEW NUMERIC OR TABLE. 00034070
C 00034080
C 00034090
REAL*8 RMIN,RMAX,LITBL(1024) 00034100
INTEGER PTRS(45),TITLE(120),CRSET(39),OPER(9),SYM(15), 00034110
1SUBSC(6),TYPCT(20),EQCHN(80),TOKEN(80),CARD1(80),CARD2(80), 00034120
2ERROR(80),OBJCD(160),DEF(80),XREF(80),TMAP(80),FCTN(5,22), 00034130
3SYMTB(5,512) 00034140
INTEGER STYPE,I,J,INTRS(6,3),CDATA(144),INTBT,SAVE,LITCT, 00034150
1PNTR,DISK,RECNO,SAVE1,POINT,VNUM,EQNCD,RBFPT,RERUN(80), 00034160
2RELOC,OBJPT,OBJ1(80) 00034170
COMMON RMIN,RMAX,PTRS,TITLE,CRSET,OPER,SYM,SUBSC,TYPCT, 00034180
1EQCHN,TOKEN,CARD1,CARD2,ERROR,OBJCD,DEF,XREF,TMAP,FCTN, 00034190
2SYMTB,LITBL 00034200
EQUIVALENCE (STYPE,TOKEN(1)),(CDATA(1),OBJCD(1)), 00034210
1(INTBT,RERUN(1),DEF(1)),(LITCT,PTRS(18)),(DISK,PTRS(3)), 00034220
2(VNUM,SYM(14)),(EQNCD,ERROR(1)),(RELOC,PTRS(40)) 00034230
3,(RBFPT,RERUN(2)),(RECNO,SYM(15)),(OBJPT,OBJCD(1),OBJ1(1)) 00034240
DATA INTRS /'E','U','L','E','R',' ','R','K','I','N','T',' ', 00034250
1'A','B','I','N','T',' '/ 00034260
C 00034270
C 00034280
IF(STYPE.NE.10) GO TO 400 00034290
C 00034300
C 00034310
C IF A CONTROL CARD IS ENTERED, ITS CONTENTS ARE COMPARED 00034320
C AGAINST AN ARRAY CONTAINING THE THREE LEGAL INTEGRATION 00034330
C TYPES. IF ONE IS FOUND, THE NUMBER IS SAVED IN INTBT; IF 00034340
C NOT, THE CONTROL CARD IS FLAGGED FOR BEING ILLEGAL IN A 00034350
C RERUN. THE CORRESPONDENCE OF THE SAVED NUMBER TO THE INTE- 00034360
C GRATION TYPE IS SHOWN BELOW: 00034370
C 00034380
C EULER - 1 00034390
C RKINT - 2 00034400
C ABINT - 3 00034410
C 00034420
C 00034430
DO 200 I=1,3 00034440
DO 100 J=1,6 00034450
IF(INTRS(J,I).NE.CDATA(J)) GO TO 200 00034460
100 CONTINUE 00034470
IF(INTBT.EQ.0) GO TO 150 00034480
CALL NDT14 (0,114,2) 00034490
GO TO 2000 00034500
150 INTBT=I 00034510
GO TO 2000 00034520
200 CONTINUE 00034530
CALL NDT14 (0,115,2) 00034540
GO TO 2000 00034550
C 00034560
C 00034570
C FOR T,C OR PARM CARDS, THE ADDRESS AT WHICH THEY WILL BE 00034580
C STORED IN THE LITBL MUST BE SAVED. WHEN LATER ADDED TO 00034590
C RELOC THIS WILL GIVE THE ADDRESS OF THE NEW CONSTANT OR 00034600
C CONSTANTS AT EXECUTION TIME. 00034610
C 00034620
C 00034630
400 SAVE=LITCT+1 00034640
IF(STYPE.NE.1) GO TO 800 00034650
C 00034660
C 00034670
C IF THE CARD IS A TABLE, THE TABLE PROCESSOR IS CALLED. 00034680
C FURTHER PROCESSING IS DISCONTINUED IF THE TABLE PROCESSOR 00034690
C DETECTED ERRORS OR CRITICALS ON THIS CARD. OTHERWISE 00034700
C THE TABLE'S MAINLINE OBJECT CODE IS READ OFF OF DISK TO 00034710
C BACKTRACK AND COMPARE THE NUMBER OF LITERALS ON THE RIGHT 00034720
C OF THE '='. 00034730
C 00034740
C 00034750
CALL NDT15 00034760
IF(EQNCD.GT.1) GO TO 2000 00034770
LITBL(SAVE) = SAVE + 1 + RELOC 00034780
PNTR=MOD(TOKEN(4),4096)+1 00034790
CALL NDT41 (SYMTB(1,PNTR)) 00034800
READ(DISK'RECNO+4) OBJ1 00034810
SAVE1=-OBJCD(6) 00034820
POINT=LITBL(SAVE1) 00034830
750 IF(LITBL(POINT).EQ.LITBL(SAVE+1)) GO TO 900 00034840
CALL NDT14 (0,539,2) 00034850
GO TO 2000 00034860
C 00034870
C 00034880
C IF THE CARD IS A CONSTANT OR PARM, NDT08 IS CALLED TO 00034890
C PERFORM THE LEXICAL ANALYSIS AND THEN NDT49 IS CALLED TO 00034900
C INSURE THAT THERE IS ONLY ONE LITERAL ON THE RIGHT OF '='. 00034910
C 00034920
C 00034930
800 CALL NDT08 00034940
CALL NDT49 00034950
C 00034960
C 00034970
C AN ATTEMPT BY THE USER TO WRITE AN EQUATION FOR A PARAMETER 00034980
C (OTHER THAN DT) IN RERUN MODE IS FLAGGED HERE. 00034990
C 00035000
C 00035010
900 IF(VNUM.EQ.11.OR.VNUM.GT.16) GO TO 1000 00035020
CALL NDT14 (TMAP(4),538,2) 00035030
GO TO 2000 00035040
C 00035050
C 00035060
C IF THERE HAVE BEEN NO ERRORS OR CRITICALS TO THIS POINT AND 00035070
C THE RERUN BUFFER IS NOT IN DANGER OF OVERFLOWING, TWO WORDS 00035080
C ARE BUILT WHICH SPECIFY THE RERUN CHANGE. THESE TWO 00035090
C WORDS CONTAIN INFORMATION WHICH SPECIFIES THE VNUM AND THE 00035100
C LOCATION OF THE NEW LITERAL (OR GROUP OF LITERALS, AS IN 00035110
C TABLES) WHERE THE RERUN VALUES CAN BE FOUND AFTER RELOCATION. 00035120
C 00035130
C 00035140
1000 IF(EQNCD.GT.1) GO TO 2000 00035150
IF(RBFPT.LE.78) GO TO 1100 00035160
CALL NDT14 (0,116,2) 00035170
GO TO 2000 00035180
1100 IF(STYPE.EQ.1) GO TO 1150 00035190
PNTR=MOD(TOKEN(4),4096)+1 00035200
CALL NDT41 (SYMTB(1,PNTR)) 00035210
READ(DISK'RECNO+4) OBJ1 00035220
SAVE1 = - OBJCD(6) 00035230
IF(OBJPT.EQ.8.AND.SAVE1.GT.0) GO TO 1150 00035240
CALL NDT14 (0,999,2) 00035250
GO TO 2000 00035260
1150 RERUN(RBFPT+1)=SAVE1+RELOC 00035270
RERUN(RBFPT+2)=SAVE+RELOC 00035280
RBFPT=RBFPT+2 00035290
2000 RETURN 00035300
END 00035320
C COPYRIGHT 1978 - UNIVERSITY OF NOTRE DAME 00035330
C PROGRAM AUTHOR - GARY PELKEY 00035340
C 00035350
C 00035360
SUBROUTINE NDT20 (CODE,SEVER) 00035370
C 00035380
C 00035390
C THIS PROGRAM PROCESSES GROUP ERRORS. IT DOES THIS BY UPDATING 00035400
C THE ERROR DISK RECORD OF THE LAST GROUP STARTER. THE LAST 00035410
C GROUP'S TOKEN RECORD IS POINTED TO BY LSTGP. 00035420
C 00035430
C 00035440
REAL*8 RMIN,RMAX,LITBL(1024) 00035450
INTEGER PTRS(45),TITLE(120),CRSET(39),OPER(9),SYM(15), 00035460
1SUBSC(6),TYPCT(20),EQCHN(80),TOKEN(80),CARD1(80),CARD2(80), 00035470
2ERROR(80),OBJCD(160),DEF(80),XREF(80),TMAP(80),FCTN(5,22), 00035480
3SYMTB(5,512) 00035490
INTEGER CODE,SEVER,ERRPT,I,DISK,ENDER,LSTGP 00035500
COMMON RMIN,RMAX,PTRS,TITLE,CRSET,OPER,SYM,SUBSC,TYPCT, 00035510
1EQCHN,TOKEN,CARD1,CARD2,ERROR,OBJCD,DEF,XREF,TMAP,FCTN, 00035520
2SYMTB,LITBL 00035530
EQUIVALENCE (ERRPT,ERROR(2)),(ENDER,OBJCD(2)),(DISK,PTRS(3)) 00035540
EQUIVALENCE (LSTGP,PTRS(35)) 00035550
C 00035560
C 00035570
C THE PRESENT CARDS ERROR INFORMATION IS SAVED. 00035580
C 00035590
C 00035600
DO 100 I=1,ERRPT 00035610
100 OBJCD(I)=ERROR(I) 00035620
C 00035630
C 00035640
C THE GROUP STARTER'S ERROR RECORD IS READ IN AND UPDATED 00035650
C BY CALLING NDT14. (THE POSITION OF A GROUP ERROR IS ALWAYS 00035660
C 0, OR THE WHOLE CARD.) 00035670
C 00035680
C 00035690
READ(DISK'LSTGP+3) ERROR 00035700
CALL NDT14 (0,CODE,SEVER) 00035710
WRITE(DISK'LSTGP+3) ERROR 00035720
C 00035730
C 00035740
C THE PRESENT CARDS ERROR INFORMATION IS RESTORED. 00035750
C 00035760
C 00035770
DO 200 I=1,ENDER 00035780
200 ERROR(I)=OBJCD(I) 00035790
RETURN 00035800
END 00035810
C COPYRIGHT (C) 1978 - UNIVERSITY OF NOTRE DAME 00035820
C PROGRAM AUTHOR - DANIEL A. POYDENCE 00035830
C 00035840
C 00035850
SUBROUTINE NDT21 (EQELM) 00035860
C 00035870
C 00035880
C NDT21 MONITORS THE SEQUENTIAL CONSTRUCTION OF THE EQCHN 00035890
C ARRAY. THIS ARRAY IS BUILT AT TWO DIFFERENT TIMES. DURING 00035900
C THE INPUT PHASE, NDT21 ADDS AN EQCHN ELEMENT FOR EACH 00035910
C EQUATION AND TABLE IN THE MODEL. DURING THE EQUATION 00035920
C ORDING PHASE THIS ROUTINE MONITORS THE CONSTRUCTION OF THE 00035930
C ORDERED EQCHN ELEMENTS. 00035940
C 00035950
C 00035960
REAL*8 RMIN,RMAX,LITBL(1024) 00035970
INTEGER PTRS(45),TITLE(120),CRSET(39),OPER(9),SYM(15), 00035980
1SUBSC(6),TYPCT(20),EQCHN(80),TOKEN(80),CARD1(80),CARD2(80), 00035990
2ERROR(80),OBJCD(160),DEF(80),XREF(80),TMAP(80),FCTN(5,22), 00036000
3SYMTB(5,512) 00036010
INTEGER CHNPT,EQNPT,DISK,EQELM 00036020
COMMON RMIN,RMAX,PTRS,TITLE,CRSET,OPER,SYM,SUBSC,TYPCT, 00036030
1EQCHN,TOKEN,CARD1,CARD2,ERROR,OBJCD,DEF,XREF,TMAP,FCTN, 00036040
2SYMTB,LITBL 00036050
EQUIVALENCE (CHNPT,PTRS(29)),(EQNPT,PTRS(28)),(DISK,PTRS(3)) 00036060
C 00036070
C 00036080
C CHNPT POINTS TO THE LAST POSITION USED IN EQCHN. EQNPT POINTS 00036090
C TO THE LAST DISK RECORD USED FOR EQCHN INFORMATION. 00036100
C 00036110
C 00036120
CHNPT=CHNPT+1 00036130
EQCHN(CHNPT)=EQELM 00036140
C 00036150
C 00036160
C IF EQCHN IS FILLED OR THE LAST ELEMENT ADDED WAS A 0 INDICATING 00036170
C THE END OF EQCHN BUILDING THEN WRITE THE INFORMATION TO DISK 00036180
C AND RESET THE POINTERS. 00036190
C 00036200
C 00036210
IF(CHNPT.NE.80.AND.EQELM.NE.0) GO TO 100 00036220
EQNPT=EQNPT+1 00036230
WRITE(DISK'EQNPT) EQCHN 00036240
CHNPT=0 00036250
100 RETURN 00036260
END 00036280
C COPYRIGHT (C) 1978 - UNIVERSITY OF NOTRE DAME 00036290
C PROGRAM AUTHOR - DANIEL A. POYDENCE 00036300
C 00036310
C 00036320
SUBROUTINE NDT22 (START,STOP) 00036330
C 00036340
C 00036350
C NDT22 PERFORMS A SYNTAX ANALYSIS ON NUMERIC LITERAL STRINGS, 00036360
C ADDS AN ELEMENT TO THE TOKEN AND TMAP ARRAYS, AND PLACES THE 00036370
C VALUE OF THE LITERAL INTO THE LITERAL TABLE. 00036380
C 00036390
C THE FIRST AND SECOND ARGUMENTS ARE THE STARTING AND 00036400
C STOPPING POSITIONS OF THE STRING. 00036410
C 00036420
C 00036430
REAL*8 RMIN,RMAX,LITBL(1024) 00036440
REAL*8 VAL 00036450
INTEGER PTRS(45),TITLE(120),CRSET(39),OPER(9),SYM(15), 00036460
1SUBSC(6),TYPCT(20),EQCHN(80),TOKEN(80),CARD1(80),CARD2(80), 00036470
2ERROR(80),OBJCD(160),DEF(80),XREF(80),TMAP(80),FCTN(5,22), 00036480
3SYMTB(5,512) 00036490
INTEGER PNTTMP
INTEGER SPCL(4),PNT,COUNT,SGDCT,ESIGN,DIGIT,DEC,START,EXP, 00036500
1LITCT,LITND,TOKPT,STOP,NSIGN,LOOP,NUM(10),EXPMX,CDATA(144) 00036510
COMMON RMIN,RMAX,PTRS,TITLE,CRSET,OPER,SYM,SUBSC,TYPCT, 00036520
1EQCHN,TOKEN,CARD1,CARD2,ERROR,OBJCD,DEF,XREF,TMAP,FCTN, 00036530
2SYMTB,LITBL 00036540
EQUIVALENCE (NUM(1),CRSET(30)),(EXPMX,PTRS(9)),(LITCT,PTRS(18)), 00036550
1(LITND,PTRS(19)),(TOKPT,TOKEN(3)),(CDATA(1),OBJCD(1)) 00036560
DATA SPCL /'.','E','+','-'/ 00036570
C 00036580
C 00036590
C INITIALIZE ALL COUNTERS AND FLAGS. 00036600
C 00036610
C 00036620
VAL=0.D0 00036630
COUNT=0 00036640
SGDCT=-1 00036650
DEC=-1 00036660
EXP=-1 00036670
NSIGN=0 00036680
ESIGN=0 00036690
C 00036700
C 00036710
C IF THE STARTING POSITION IS NOT LESS THAN OR EQUAL TO 00036720
C THE STOPPING POSITION, THEN THE NUMBER IS MISSING. 00036730
C SIGNAL THE ERROR, AND ASSUME A ZERO PRESENT. 00036740
C 00036750
C 00036760
IF(START.LE.STOP) GO TO 100 00036770
CALL NDT13 (START,601,2) 00036780
GO TO 2100 00036790
C 00036800
C 00036810
C THE OUTER LOOP PROCESSES CHARACTER BY CHARACTER FROM THE 00036820
C LEFT TO THE RIGHT. 00036830
C 00036840
C 00036850
100 DO 1800 PNT=START,STOP 00036860
PNTTMP=PNT
C 00036870
C 00036880
C TEST FOR A VALID DIGIT. THE VALUE OF LOOP WILL 00036890
C INDICATE WHICH DIGIT WAS FOUND. 00036900
C 00036910
C 00036920
DO 200 LOOP=1,10 00036930
IF(CDATA(PNT).EQ.NUM(LOOP)) GO TO 500 00036940
200 CONTINUE 00036950
C 00036960
C 00036970
C THE CHARACTER WAS NOT A DIGIT SO CHECK FOR 00036980
C ONE OF THE SPECIAL SYMBOLS. 00036990
C 00037000
C 00037010
DO 300 LOOP=1,4 00037020
IF(CDATA(PNT).EQ.SPCL(LOOP)) GO TO (800,1300,1100,1100),LOOP 00037030
300 CONTINUE 00037040
C 00037050
C 00037060
C THE CHARACTER IS NOT LEGAL IN A NUMERIC LITERAL. INDICATE 00037070
C THE ERROR AND ASSUME IT TO BE A ZERO. 00037080
C 00037090
C 00037100
CALL NDT13 (PNTTMP,600,2) 00037110
LOOP=1 00037120
GO TO 500 00037130
C 00037140
C 00037150
C THIS IS THE DIGIT PROCESSING ROUTINE. COUNT IS A 00037160
C COUNTER FOR THE NUMBER OF DIGITS ENCOUNTERED SINCE 00037170
C THE START OF THE MANTISSA OR THE START OF THE 00037180
C EXPONENT. SGDCT IS THE NUMBER OF THOSE DIGITS 00037190
C THAT ARE SIGNIFICANT (COUNT LESS THE LEADING ZEROS). 00037200
C IF COUNT IS LESS THAN ZERO THEN MORE DIGITS HAVE 00037210
C ALREADY OCCURRED THAN ARE ALLOWED SO IGNORE THIS ONE. 00037220
C 00037230
C 00037240
500 IF(COUNT.LT.0) GO TO 1800 00037250
C 00037260
C 00037270
C ADD ONE TO COUNT AND TEST TO SEE WHETHER THE DIGIT 00037280
C IS A LEADING ZERO. IF IT IS GET THE NEXT CHARACTER 00037290
C WITHOUT INITIALIZING SGDCT. IF IT IS NOT A LEADING 00037300
C ZERO THEN INCREMENT SGDCT AND TEST THE LENGTH. 00037310
C A MANTISSA LENGTH MAY NOT EXCEED 8 AND AN EXPONENT 00037320
C LENGTH MAY NOT EXCEED 2. 00037330
C 00037340
C 00037350
COUNT=COUNT+1 00037360
IF(SGDCT.LT.0.AND.LOOP.NE.1) SGDCT=0 00037370
IF(SGDCT.LT.0) GO TO 1800 00037380
SGDCT=SGDCT+1 00037390
IF(EXP.LT.0.AND.SGDCT.EQ.9) GO TO 600 00037400
IF(EXP.GE.0.AND.SGDCT.EQ.3) GO TO 700 00037410
C 00037420
C 00037430
C THE DIGIT IS VALID AND SIGNIFICANT. UPDATE THE VALUE 00037440
C AND THE REAL VARIABLE VAL ACCORDING TO THE FLAGS AND 00037450
C COUNTERS. DEC IS THE DECIMAL POINT FLAG AND COUNTER. 00037460
C A NEGATIVE VALUE INDICATES THAT THE DECIMAL POINT 00037470
C HAS NOT BEEN ENCOUNTERED. A NON-NEGATIVE VALUE 00037480
C INDICATES THAT IT HAS OCCURRED AND IS A COUNTER 00037490
C OF THE NUMBER OF DIGITS THAT HAVE FOLLOWED IT. 00037500
C EXP HAS THE SAME FUNCTION WITH THE EXPONENT CHARACTER. 00037510
C UPDATE ALL OF THE APPROPRIATE COUNTERS. 00037520
C 00037530
C 00037540
IF(DEC.GE.0) DEC=DEC+1 00037550
DIGIT=LOOP-1 00037560
IF(DEC.LT.0.AND.EXP.LT.0) VAL=VAL*10.D0+DFLOAT(DIGIT) 00037570
IF(DEC.GE.0.AND.EXP.LT.0) VAL=VAL+DFLOAT(DIGIT)/10.D0**DEC 00037580
IF(EXP.GE.0) EXP=EXP*10+DIGIT 00037590
GO TO 1800 00037600
C 00037610
C 00037620
C THE MANTISSA EXCEEDS THE PREVIOUSLY STATED LIMITS FOR 00037630
C LENGTH. PROCESS THE ERROR, IGNORE THIS DIGIT, AND 00037640
C SET COUNT TO A NEGATIVE VALUE AS A FLAG. 00037650
C 00037660
C 00037670
600 CALL NDT13 (PNTTMP,603,2) 00037680
COUNT=-1 00037690
GO TO 1800 00037700
C 00037710
C 00037720
C THE EXPONENT EXCEEDS THE PREVIOUSLY STATED LINITS FOR 00037730
C LENGTH. PROCESS THE ERROR, ASSUME THE MAXIMUM VALUE, 00037740
C EXPMX, AND SET COUNT TO A NEGATIVE VALUE AS A FLAG. 00037750
C 00037760
C 00037770
700 CALL NDT13 (PNTTMP,604,2) 00037780
EXP=EXPMX 00037790
VAL=1.D0 00037800
COUNT=-1 00037810
GO TO 1800 00037820
C 00037830
C 00037840
C THIS IS THE DECIMAL POINT PROCESSING ROUTINE. 00037850
C IF THE EXPONENT CHARACTER OR THE DECIMAL POINT 00037860
C HAVE OCCURRED PREVIOUSLY IT IS AN ERROR. 00037870
C IF THERE ARE NO ERRORS SET DEC TO ZERO AS A FLAG. 00037880
C SINCE ZEROS ARE NOW SIGNIFICANT, SET SGDCT TO 00037890
C ZERO AS A FLAG UNLESS IT IS ALREADY NON-NEGATIVE. 00037900
C 00037910
C 00037920
800 IF(EXP.GE.0) GO TO 900 00037930
IF(DEC.GE.0) GO TO 1000 00037940
DEC=0 00037950
IF(SGDCT.LT.0) SGDCT=0 00037960
GO TO 1800 00037970
C 00037980
C 00037990
C THE DECIMAL POINT HAS OCCURRED IN THE EXPONENT. 00038000
C SIGNAL THIS AS AN ERROR. 00038010
C 00038020
C 00038030
900 CALL NDT13 (PNTTMP,606,2) 00038040
GO TO 1800 00038050
C 00038060
C 00038070
C A DUPLICATE DECIMAL POINT HAS OCCURRED IN THE 00038080
C MANTISSA. SIGNAL THIS AS AN ERROR. 00038090
C 00038100
C 00038110
1000 CALL NDT13 (PNTTMP,605,2) 00038120
GO TO 1800 00038130
C 00038140
C 00038150
C THIS ROUTINE PROCESSES THE PLUS AND MINUS SIGNS. 00038160
C IF COUNT IS NOT ZERO THE SIGN HAS OCCURRED IN THE 00038170
C MIDDLE OF A DIGIT STRING WHICH IS AN ERROR. IF THE 00038180
C SIGN FOLLOWS A DECIMAL POINT IT IS AN ERROR. 00038190
C IF IT IS FOR THE MANTISSA AND THE MANTISSA SIGN HAS 00038200
C ALREADY BEEN ENCOUNTERED IT IS AN ERROR. 00038210
C IF IT IS FOR THE EXPONENT AND THE EXPONENT SIGN HAS 00038220
C ALREADY BEEN ENCOUNTERED IT IS AN ERROR. OTHERWISE, 00038230
C THE SIGN IS VALID SO SET THE APPROPRIATE FLAG TO 00038240
C INDICATE THAT IT HAS OCCURRED. 00038250
C 00038260
C 00038270
1100 IF(COUNT.NE.0) GO TO 1200 00038280
IF(DEC.GE.0.AND.EXP.LT.0) GO TO 1200 00038290
IF(EXP.LT.0.AND.NSIGN.NE.0) GO TO 1200 00038300
IF(EXP.GE.0.AND.ESIGN.NE.0) GO TO 1200 00038310
IF(EXP.LT.0.AND.LOOP.EQ.3) NSIGN=1 00038320
IF(EXP.LT.0.AND.LOOP.EQ.4) NSIGN=-1 00038330
IF(EXP.GE.0.AND.LOOP.EQ.3) ESIGN=1 00038340
IF(EXP.GE.0.AND.LOOP.EQ.4) ESIGN=-1 00038350
GO TO 1800 00038360
C 00038370
C 00038380
C THE SIGN CHARACTER IS ILLEGAL AS USED FOR ONE OF THE 00038390
C REASONS STATED PREVIOUSLY. PROCESS THE ERROR. 00038400
C 00038410
C 00038420
1200 CALL NDT13 (PNTTMP,602,2) 00038430
GO TO 1800 00038440
C 00038450
C 00038460
C THIS IS THE EXPONENT CHARACTER PROCESSING ROUTINE. 00038470
C IF THE EXPONENT CHARACTER HAS OCCURRED PREVIOUSLY 00038480
C IT IS AN ERROR. 00038490
C 00038500
C 00038510
1300 IF(EXP.GE.0) GO TO 1500 00038520
C 00038530
C 00038540
C IF NO DIGITS HAVE BEEN ENCOUNTERED PREVIOUSLY 00038550
C SIGNAL THE ERROR. IF VAL HAS A VALUE OF ZERO 00038560
C THEN WARN THE USER THAT HE IS EXPONENTIATING 00038570
C ZERO. OTHERWISE, THE CHARACTER IS VALID SO 00038580
C SET THE APPROPRIATE FLAGS. 00038590
C 00038600
C 00038610
IF(COUNT.EQ.0) GO TO 1600 00038620
IF(VAL.EQ.0.D0) GO TO 1700 00038630
1400 EXP=0 00038640
COUNT=0 00038650
SGDCT=-1 00038660
GO TO 1800 00038670
C 00038680
C 00038690
C A DUPLICATE EXPONENT CHARACTER HAS BEEN ENCOUNTERED. 00038700
C PROCESS THE ERROR AND IGNORE IT. 00038710
C 00038720
C 00038730
1500 CALL NDT13 (PNTTMP,608,2) 00038740
GO TO 1800 00038750
C 00038760
C 00038770
C THE EXPONENT CHARACTER WAS ENCOUNTERED BEFORE THE 00038780
C MANTISSA. SIGNAL THE ERROR AND ASSUME A '1' PRESENT. 00038790
C SET VAL TO TO A VALUE OF 1 UNLESS THE DECIMAL POINT 00038800
C HAS PRECEEDED. IN THAT CASE SET VAL TO .1 AND CONTINUE 00038810
C PROCESSING THE EXPONENT CHARACTER AS VALID. 00038820
C 00038830
C 00038840
1600 CALL NDT13 (PNTTMP,609,2) 00038850
VAL=1.D0 00038860
IF(DEC.EQ.0) VAL=1.D-1 00038870
GO TO 1400 00038880
C 00038890
C 00038900
C THE NUMBER BEING EXPONENTIATED IS ZERO. WARN THE USER 00038910
C AND PROCESS THE EXPONENT CHARACTER AS VALID. 00038920
C 00038930
C 00038940
1700 CALL NDT13 (PNTTMP,607,1) 00038950
GO TO 1400 00038960
1800 CONTINUE 00038970
C 00038980
C 00038990
C ALL CHARACTERS OF THE STRING HAVE BEEN PROCESSED. 00039000
C SET THE SIGN FLAGS TO THE DEFAULT VALUES IF THEY 00039010
C INDICATE THAT NO SIGN OCCURRED. 00039020
C 00039030
C 00039040
IF(NSIGN.EQ.0) NSIGN=1 00039050
IF(ESIGN.EQ.0) ESIGN=1 00039060
C 00039070
C 00039080
C IF THE EXPONENT FLAG IS NEGATIVE SET IT TO ZERO SO 00039090
C THAT THE FINAL VALUE OF 'VAL' MAY BE FORMED CORRECTLY. 00039100
C CHECK FOR AN OVERFLOW OR AN UNDERFLOW BEFORE FORMING 'VAL'. 00039110
C 00039120
C 00039130
IF(EXP.LT.0) EXP=0 00039140
IF(VAL.EQ.0.D0) GO TO 1900 00039150
IF(DLOG10(VAL)+DFLOAT(EXP).LE.DFLOAT(EXPMX)) GO TO 1900 00039160
EXP=EXPMX 00039170
VAL=1.D0 00039180
CALL NDT13 (PNT,612,2) 00039190
C 00039200
C 00039210
C IF NO DIGITS HAVE OCCURRED THEN EITHER THE EXPECTED 00039220
C MANTISSA IS MISSING OR THE EXPONENT CHARACTER WAS 00039230
C NOT FOLLOWED BY AN EXPONENT. SIGNAL THE APPROPRIATE 00039240
C ERROR AND ASSUME A ZERO. 00039250
C 00039260
C 00039270
1900 IF(COUNT.NE.0) GO TO 2000 00039280
IF(EXP.LT.0) CALL NDT13 (PNT+1,610,2) 00039290
IF(EXP.GE.0) CALL NDT13 (PNT+1,611,2) 00039300
C 00039310
C 00039320
C FORM THE VALUE OF THE LITERAL AND PLACE IT IN THE LITERAL 00039330
C IF THE TABLE OVERFLOWS, INDICATE THE SYSTEM ERROR. 00039340
C 00039350
C 00039360
2000 VAL=VAL*DFLOAT(NSIGN)*10.D0**(ESIGN*EXP) 00039370
2100 LITCT=LITCT+1 00039380
IF(LITCT.GT.LITND) CALL NDT12 (4) 00039390
LITBL(LITCT)=VAL 00039400
C 00039410
C 00039420
C ADD A NEW TOKEN AND TMAP ELEMENT FOR THE LITERAL AFTER 00039430
C CHECKING FOR TOKEN OVERFLOW. 00039440
C 00039450
C 00039460
TOKPT=TOKPT+1 00039470
IF(TOKPT.GT.80) CALL NDT12 (2) 00039480
TOKEN(TOKPT)=-LITCT 00039490
CALL NDT23 (START,TMAP(TOKPT)) 00039500
RETURN 00039510
END 00039530
C COPYRIGHT 1978 - UNIVERSITY OF NOTRE DAME 00039540
C PROGRAM AUTHOR - GARY PELKEY 00039550
C 00039560
C 00039570
SUBROUTINE NDT23 (POS,OUT) 00039580
REAL*8 RMIN,RMAX,LITBL(1024) 00039590
INTEGER PTRS(45),TITLE(120),CRSET(39),OPER(9),SYM(15), 00039600
1SUBSC(6),TYPCT(20),EQCHN(80),TOKEN(80),CARD1(80),CARD2(80), 00039610
2ERROR(80),OBJCD(160),DEF(80),XREF(80),TMAP(80),FCTN(5,22), 00039620
3SYMTB(5,512) 00039630
INTEGER POS,OUT,CDATA(144) 00039640
COMMON RMIN,RMAX,PTRS,TITLE,CRSET,OPER,SYM,SUBSC,TYPCT, 00039650
1EQCHN,TOKEN,CARD1,CARD2,ERROR,OBJCD,DEF,XREF,TMAP,FCTN, 00039660
2SYMTB,LITBL 00039670
EQUIVALENCE (CDATA(1),OBJCD(1)) 00039680
OUT=8*(POS+CDATA(142)-1) 00039690
IF(POS.GE.CDATA(143)) OUT=8*(POS-CDATA(143)+CDATA(144))+1 00039700
IF(POS.EQ.0) OUT=0 00039710
RETURN 00039720
END 00039740
C COPYRIGHT 1978 - UNIVERSITY OF NOTRE DAME 00039750
C PROGRAM AUTHOR - GARY PELKEY 00039760
C 00039770
C 00039780
SUBROUTINE NDT24 (PNT1,PNT2,RTC) 00039790
REAL*8 RMIN,RMAX,LITBL(1024) 00039800
INTEGER PTRS(45),TITLE(120),CRSET(39),OPER(9),SYM(15), 00039810
1SUBSC(6),TYPCT(20),EQCHN(80),TOKEN(80),CARD1(80),CARD2(80), 00039820
2ERROR(80),OBJCD(160),DEF(80),XREF(80),TMAP(80),FCTN(5,22), 00039830
3SYMTB(5,512) 00039840
INTEGER POSTMP
INTEGER CDATA(144),PNT1,PNT2,RTC,SUB,POS,I 00039850
COMMON RMIN,RMAX,PTRS,TITLE,CRSET,OPER,SYM,SUBSC,TYPCT, 00039860
1EQCHN,TOKEN,CARD1,CARD2,ERROR,OBJCD,DEF,XREF,TMAP,FCTN, 00039870
2SYMTB,LITBL 00039880
EQUIVALENCE (SUB,OBJCD(153)),(CDATA(1),OBJCD(1)) 00039890
EQUIVALENCE (POS,OBJCD(154)),(I,OBJCD(155)) 00039900
C 00039910
C 00039920
C THIS PROGRAM PERFORMS A SYNTAX CHECK ON A VARIABLE CANDIDATE 00039930
C LOCATED IN CDATA SPECIFIED BY THE INPUT STARTING AND 00039940
C STOPPING ADDRESSES. CHARACTERS ARE COMPARED AGAINST THE 00039950
C ELEMENTS OF CRSET AND THE SUBSCRIPTS OF THE MATCHING 00039960
C ELEMENT OF CRSET ARE SAVED IN THE SUBSC ARRAY. SUBSC IS 00039970
C INITIALLY BLANKED OUT (SET TO ALL 1'S). 00039980
C 00039990
C 00040000
RTC=0 00040010
DO 100 SUB=1,6 00040020
100 SUBSC(SUB)=1 00040030
SUB=0 00040040
IF(PNT2.GE.PNT1) GO TO 150 00040050
C 00040060
C 00040070
C THE CALLING ROUTINE EXPECTED TO FIND A VARIABLE STARTING 00040080
C AT PNT1 AND ENDING AT PNT2. PNT2 IS LESS THAN PNT1 SO 00040090
C THERE IS NO VARIABLE. THE ERROR IS FLAGGED. 00040100
C 00040110
C 00040120
CALL NDT13 (PNT1,519,3) 00040130
GO TO 600 00040140
150 DO 400 POS=PNT1,PNT2 00040150
SUB=SUB+1 00040160
DO 200 I=1,39 00040170
IF(CRSET(I).EQ.CDATA(POS)) GO TO 300 00040180
200 CONTINUE 00040190
RTC=3 00040200
C 00040210
C 00040220
C AN ILLEGAL CHARACTER HAS BEEN ENCOUNTERED. IT IS FLAGGED. 00040230
C 00040240
C 00040250
POSTMP=POS
CALL NDT13 (POSTMP,502,RTC) 00040260
GO TO 400 00040270
300 IF(SUB.LT.7) SUBSC(SUB)=I 00040280
400 CONTINUE 00040290
C 00040300
C 00040310
C THE SUBSC ARRAY HAS BEEN FILLED AND ANY ILLEGAL CHARACTERS 00040320
C HAVE BEEN DETECTED. WHAT REMAINS IS JUST A CHECK TO 00040330
C MAKE SURE THAT THE VARIABLE BEGINS WITH A LEGAL CHARACTER 00040340
C AND THAT THE STRING IS NOT OVER SIX CHARACTERS LONG. 00040350
C EITHER OF THESE ERRORS WILL BE FLAGGED. 00040360
C 00040370
C 00040380
IF(SUB.LT.7) GO TO 500 00040390
RTC=3 00040400
CALL NDT13 (PNT1+6,503,RTC) 00040410
500 IF(SUBSC(1).LT.30) GO TO 600 00040420
RTC=3 00040430
CALL NDT13 (PNT1,501,RTC) 00040440
600 RETURN 00040450
END 00040470
C COPYRIGHT 1978 - UNIVERSITY OF NOTRE DAME 00040480
C PROGRAM AUTHOR - GARY PELKEY 00040490
C 00040500
C 00040510
SUBROUTINE NDT25 (PNT1,PNT2,INCOD) 00040520
C 00040530
C 00040540
C THIS ROUTINE ENTERS TOKENS FOR FUNCTIONS. UPON BEING INVOKED 00040550
C THE SUBSC ARRAY HAS ALREADY BEEN BUILT AND THE CHARACTERS 00040560
C SERVING AS THE FUNCT. NAME HAVE ALREADY BEEN SYNTAX CHECKED. 00040570
C WHAT REMAINS IS TO IDENTIFY THE FUNCTION, IF POSSIBLE, AS ONE 00040580
C SUPPORTED BY NDTRAN, BUILD THE TOKEN, AND MAKE SURE THE 00040590
C ARGUMENT COUNT IS CORRECT. 00040600
C 00040610
C 00040620
REAL*8 RMIN,RMAX,LITBL(1024) 00040630
INTEGER PTRS(45),TITLE(120),CRSET(39),OPER(9),SYM(15), 00040640
1SUBSC(6),TYPCT(20),EQCHN(80),TOKEN(80),CARD1(80),CARD2(80), 00040650
2ERROR(80),OBJCD(160),DEF(80),XREF(80),TMAP(80),FCTN(5,22), 00040660
3SYMTB(5,512) 00040670
INTEGER BUFFR(5),I,PNT1,PNT2,TOKPT,INCOD 00040680
COMMON RMIN,RMAX,PTRS,TITLE,CRSET,OPER,SYM,SUBSC,TYPCT, 00040690
1EQCHN,TOKEN,CARD1,CARD2,ERROR,OBJCD,DEF,XREF,TMAP,FCTN, 00040700
2SYMTB,LITBL 00040710
EQUIVALENCE (TOKPT,TOKEN(3)) 00040720
IF(INCOD.NE.0) GO TO 125 00040730
C 00040740
C 00040750
C PACKING THE FUNCTION 'CANDIDATE' FOR COMPARISON 00040760
C 00040770
C 00040780
CALL NDT40 (BUFFR) 00040790
DO 100 I=1,22 00040800
IF(BUFFR(1).EQ.FCTN(1,I).AND.BUFFR(2).EQ.FCTN(2,I)) GO TO 200 00040810
100 CONTINUE 00040820
CALL NDT13 (PNT1,523,3) 00040830
C 00040840
C 00040850
C THE INCOMING FUNCTION WAS NOT FOUND IN THE FCTN ARRAY SO 00040860
C ITS STARTING POSITION WAS FLAGGED. SETTING I TO 0 HERE 00040870
C WILL HAVE THE EFFECT OF INSERTING A TOKEN FOR A FUNCTION 00040880
C INTO THE TOKEN ARRAY WITH A POINTER TO THE FCTN TABLE OF 0. 00040890
C 00040900
C 00040910
125 I=0 00040920
200 TOKPT=TOKPT+1 00040930
IF(TOKPT.GT.80) CALL NDT12 (2) 00040940
TOKEN(TOKPT)=20480+I 00040950
C 00040960
C 00040970
C IF A VALID FUNCTION HAS BEEN ENCOUNTERED, NDT23 IS CALLED 00040980
C TO VARIFY THAT THE NUMBER OF ARGUMENTS IS CORRECT. 00040990
C BEFORE RETURNING, NDT23 IS CALLED TO MAP THE NEW TOKEN BACK 00041000
C ONTO THE ORIGINAL CARDS. 00041010
C 00041020
C 00041030
IF(I.NE.0) CALL NDT42 (PNT1,PNT2,FCTN(4,I)) 00041040
CALL NDT23 (PNT1,TMAP(TOKPT)) 00041050
RETURN 00041060
END 00041080
C COPYRIGHT 1978 - UNIVERSITY OF NOTRE DAME 00041090
C PROGRAM AUTHOR - GARY PELKEY 00041100
C 00041110
C 00041120
SUBROUTINE NDT26 (POS) 00041130
C 00041140
C 00041150
C THIS ROUTINE UPDATES AN EXISTING VARIABLE TOKEN TO INDICATE 00041160
C SUBSCRIPT INFORMATION. THE FOLLOWING SCHEME IS USED TO 00041170
C REPRESENT TOKEN CLASS: 00041180
C 00041190
C TYPE CLASS 00041200
C 00041210
C UNSUBSCRIPTED 0 00041220
C INVALID 1 00041230
C .K 2 00041240
C .JK 3 00041250
C .KL 4 00041260
C 00041270
C TOKEN=4096*CLASS+(POINTER TO SYMTB)-1 00041280
C 00041290
C 00041300
REAL*8 RMIN,RMAX,LITBL(1024) 00041310
INTEGER PTRS(45),TITLE(120),CRSET(39),OPER(9),SYM(15), 00041320
1SUBSC(6),TYPCT(20),EQCHN(80),TOKEN(80),CARD1(80),CARD2(80), 00041330
2ERROR(80),OBJCD(160),DEF(80),XREF(80),TMAP(80),FCTN(5,22), 00041340
3SYMTB(5,512) 00041350
INTEGER POS,START,CDATA(144),BLANK,I,FIRST,SCOND,J,K,L,LENTH 00041360
INTEGER TOKPT 00041370
COMMON RMIN,RMAX,PTRS,TITLE,CRSET,OPER,SYM,SUBSC,TYPCT, 00041380
1EQCHN,TOKEN,CARD1,CARD2,ERROR,OBJCD,DEF,XREF,TMAP,FCTN, 00041390
2SYMTB,LITBL 00041400
EQUIVALENCE (CDATA(1),OBJCD(1)),(BLANK,CRSET(1)) 00041410
EQUIVALENCE (J,CRSET(13)),(K,CRSET(14)),(L,CRSET(15)) 00041420
EQUIVALENCE (TOKPT,TOKEN(3)) 00041430
START=POS 00041440
C 00041450
C 00041460
C HERE STARTS A SEARCH FOR A DELIMITER. IF ONE IS FOUND, POS 00041470
C WILL POINT TO IT AND THUS POS WILL POINT TO THE NEXT TOKEN 00041480
C WHEN THIS ROUTINE RETURNS. 00041490
C 00041500
C 00041510
100 IF(CDATA(POS).EQ.BLANK) GO TO 200 00041520
DO 150 I=2,9 00041530
IF(CDATA(POS).EQ.OPER(I)) GO TO 200 00041540
150 CONTINUE 00041550
POS=POS+1 00041560
GO TO 100 00041570
200 LENTH=POS-START 00041580
IF(TOKEN(TOKPT).EQ.24576) GO TO 1000 00041590
IF(LENTH.GT.0) GO TO 300 00041600
CALL NDT13 (START-1,508,1) 00041610
GO TO 900 00041620
C 00041630
C 00041640
C A SIFTING ALGORITHM IS USED TO DETERMINE WHICH MULTIPLE OF 00041650
C 4096 IS TO BE ADDED TO THE EXISTING TOKEN. 00041660
C 00041670
C 00041680
300 FIRST=CDATA(START) 00041690
SCOND=CDATA(START+1) 00041700
IF(LENTH.EQ.1.AND.(FIRST.EQ.J.OR.FIRST.EQ.L)) GO TO 900 00041710
C 00041720
C 00041730
C .J AND .L HAVE BEEN GIVEN AN 'INVALID' CLASSIFICATION BUT 00041740
C ARE NOT FLAGGED IN THIS ROUTINE. 00041750
C 00041760
C 00041770
IF(LENTH.EQ.1.AND.FIRST.EQ.K) GO TO 800 00041780
IF(LENTH.EQ.2.AND.FIRST.EQ.J.AND.SCOND.EQ.K) GO TO 700 00041790
IF(LENTH.EQ.2.AND.FIRST.EQ.K.AND.SCOND.EQ.L) GO TO 600 00041800
C 00041810
C 00041820
C INVALID SUBSCRIPTS ARE FLAGGED HERE. 00041830
C 00041840
C 00041850
CALL NDT13 (START,504,1) 00041860
GO TO 900 00041870
600 TOKEN(TOKPT)=TOKEN(TOKPT)+4096 00041880
700 TOKEN(TOKPT)=TOKEN(TOKPT)+4096 00041890
800 TOKEN(TOKPT)=TOKEN(TOKPT)+4096 00041900
900 TOKEN(TOKPT)=TOKEN(TOKPT)+4096 00041910
1000 RETURN 00041920
END 00041940
C COPYRIGHT 1978 - UNIVERSITY OF NOTRE DAME 00041950
C PROGRAM AUTHOR - GARY PELKEY 00041960
C 00041970
C 00041980
SUBROUTINE NDT27 (PNT1,UPDAT) 00041990
C 00042000
C 00042010
C THIS ROUTINE ENTERS AND UPDATES SYMBOLS IN THE SYMBOL TABLE 00042020
C AND ENTERS A TOKEN AND TMAP ENTRY FOR THEM. THE SUBSCRIPTS 00042030
C FOR THE SYMBOL ARE ASSUMED TO BE IN THE SUBSC ARRAY ALREADY. 00042040
C 00042050
C 00042060
REAL*8 RMIN,RMAX,LITBL(1024) 00042070
INTEGER PTRS(45),TITLE(120),CRSET(39),OPER(9),SYM(15), 00042080
1SUBSC(6),TYPCT(20),EQCHN(80),TOKEN(80),CARD1(80),CARD2(80), 00042090
2ERROR(80),OBJCD(160),DEF(80),XREF(80),TMAP(80),FCTN(5,22), 00042100
3SYMTB(5,512) 00042110
INTEGER PNT1,UPDAT,BUFFR(5),TOKPT 00042120
COMMON RMIN,RMAX,PTRS,TITLE,CRSET,OPER,SYM,SUBSC,TYPCT, 00042130
1EQCHN,TOKEN,CARD1,CARD2,ERROR,OBJCD,DEF,XREF,TMAP,FCTN, 00042140
2SYMTB,LITBL 00042150
EQUIVALENCE (TOKPT,TOKEN(3)) 00042160
CALL NDT40 (BUFFR) 00042170
C 00042180
C 00042190
C THE HASH ROUTINE IS CALLED TO FIND OR CREATE THE 00042200
C INCOMING SYMBOL AND RETURN A POINTER TO IT. 00042210
C 00042220
C 00042230
CALL NDT37 (BUFFR(1),LOC) 00042240
IF(UPDAT.EQ.0) GO TO 100 00042250
C 00042260
C 00042270
C SYM(8,9 OR 10) IS UPDATED AS REQUESTED INDICATING PRINT, 00042280
C PLOT OR USED ON RIGHT OF EQUALS SIGN, RESPECTIVELY. 00042290
C 00042300
C 00042310
SYM(UPDAT+7)=1 00042320
CALL NDT40 (SYMTB(1,LOC)) 00042330
100 TOKPT=TOKPT+1 00042340
IF(TOKPT.GT.80) CALL NDT12 (2) 00042350
C 00042360
C 00042370
C THE TOKEN AND ITS MAPPING ENTRY ARE CREATED. 00042380
C 00042390
C 00042400
TOKEN(TOKPT)=LOC-1 00042410
CALL NDT23 (PNT1,TMAP(TOKPT)) 00042420
RETURN 00042430
END 00042450
C***************************************************************** 00042460
C * 00042470
C COPYRIGHT (C) 1978 - UNIVERSITY OF NOTRE DAME * 00042480
C PROGRAM AUTHOR - THOMAS L EVERMAN JR * 00042490
C * 00042500
C THIS SUBROUTINE ALLOCATES TEMPORARY STORAGE LOCATIONS * 00042510
C FOR INTERMEDIATE RESULTS OF ARITHMETIC OPERATIONS. * 00042520
C * 00042530
C***************************************************************** 00042540
SUBROUTINE NDT28 (TEMP, VATOP) 00042550
REAL*8 RMIN,RMAX,LITBL(1024) 00042560
INTEGER PTRS(45),TITLE(120),CRSET(39),OPER(9),SYM(15), 00042570
1SUBSC(6),TYPCT(20),EQCHN(80),TOKEN(80),CARD1(80),CARD2(80), 00042580
2ERROR(80),OBJCD(160),DEF(80),XREF(80),TMAP(80),FCTN(5,22), 00042590
3SYMTB(5,512) 00042600
INTEGER I,ACC,TEMP,VATOP,VASTK(50) 00042610
COMMON RMIN,RMAX,PTRS,TITLE,CRSET,OPER,SYM,SUBSC,TYPCT, 00042620
1EQCHN,TOKEN,CARD1,CARD2,ERROR,OBJCD,DEF,XREF,TMAP,FCTN, 00042630
2SYMTB,LITBL 00042640
EQUIVALENCE (VASTK(1),XREF(1)) 00042650
DATA ACC /0/ 00042660
C***************************************************************** 00042670
C * 00042680
C A 0 IN VASTK INDICATES THE RESULT OF A PRECEDING OPERATION * 00042690
C IS STORED IN THE ACCUMULATOR. THIS SUBROUTINE MOVES ANY * 00042700
C SUCH RESULT TO A TEMPORARY STORAGE LOCATION. TEMP IS THE * 00042710
C NUMBER OF TEMPORARY LOCATIONS USED PREVIOUSLY. TEMPORARY * 00042720
C STORAGE LOCATIONS ARE POSITIONS 1 - 10 IN THE VARIABLE ARRA* 00042730
C VATOP IS THE LAST POSITION IN THE VARIABLE STACK TO BE * 00042740
C SEARCHED FOR THE ACCUMULATOR. THE ENTIRE STACK IS OFTEN * 00042750
C NOT SEARCHED BECAUSE OF THE REVERSE OPERATIONS AND COMMU * 00042760
C TATIVE PROPERTIES. IF THE ACCUMULATOR IS FOUND IN THE * 00042770
C STACK, A STORE INSTRUCTION IS GENERATED. * 00042780
C * 00042790
C***************************************************************** 00042800
DO 100 I = 1, VATOP 00042810
IF (VASTK(I) .EQ. ACC) GO TO 200 00042820
100 CONTINUE 00042830
GO TO 300 00042840
200 TEMP = TEMP + 1 00042850
IF (TEMP .GT. 10) CALL NDT12 (6) 00042860
CALL NDT46 (2, TEMP) 00042870
VASTK(I) = TEMP 00042880
300 RETURN 00042890
END 00042910
C***************************************************************** 00042920
C * 00042930
C COPYRIGHT (C) 1978 - UNIVERSITY OF NOTRE DAME * 00042940
C PROGRAM AUTHOR - THOMAS L EVERMAN JR * 00042950
C * 00042960
C***************************************************************** 00042970
SUBROUTINE NDT29 (TYPE,START,POS,STR) 00042980
REAL*8 RMIN,RMAX,LITBL(1024) 00042990
INTEGER PTRS(45),TITLE(120),CRSET(39),OPER(9),SYM(15), 00043000
1SUBSC(6),TYPCT(20),EQCHN(80),TOKEN(80),CARD1(80),CARD2(80), 00043010
2ERROR(80),OBJCD(160),DEF(80),XREF(80),TMAP(80),FCTN(5,22), 00043020
3SYMTB(5,512) 00043030
INTEGER TYPE,START,BLANK,POS,I,STRNG(384) 00043040
INTEGER LPBGN,LPEND,STR 00043050
COMMON RMIN,RMAX,PTRS,TITLE,CRSET,OPER,SYM,SUBSC,TYPCT, 00043060
1EQCHN,TOKEN,CARD1,CARD2,ERROR,OBJCD,DEF,XREF,TMAP,FCTN, 00043070
2SYMTB,LITBL 00043080
EQUIVALENCE (BLANK,CRSET(1)),(STRNG(1),CARD1(1)) 00043090
C***************************************************************** 00043100
C * 00043110
C THIS PROGRAM SEARCHES AN EQUATION STRING FOR THE * 00043120
C OCCURENCE OF AN OPERATOR. IF AN OPERATOR IS FOUND, * 00043130
C ITS SUBSCRIPT IN THE OPER ARRAY IS RETURNED IN TYPE * 00043140
C AND THE POSITION IN THE STRING PRECEDING THE OPERATOR * 00043150
C IS RETURNED IN POS. THE ARGUMENT START INDICATES THE * 00043160
C POSITION IN THE STRING AT WHICH THE SEARCH IS TO BEGIN. * 00043170
C THE ARGUMENT STR INDICATES WHICH STRING IS TO BE SEARCHED: * 00043180
C 1 - CARD1 2 - CARD2 4 - CDATA * 00043190
C * 00043200
C***************************************************************** 00043210
TYPE = 0 00043220
LPBGN = START + (STR - 1) * 80 00043230
LPEND = 80 * STR - 8 00043240
IF (STR .EQ. 4) LPEND = 381 00043250
DO 100 POS = LPBGN, LPEND 00043260
IF (STRNG(POS) .EQ. BLANK) GO TO 300 00043270
DO 100 I = 1, 9 00043280
IF (STRNG(POS) .EQ. OPER(I)) GO TO 200 00043290
100 CONTINUE 00043300
POS = POS + 1 00043310
GO TO 300 00043320
200 TYPE = I 00043330
300 POS = POS - 1 - (STR - 1) * 80 00043340
RETURN 00043350
END 00043370
C***************************************************************** 00043380
C * 00043390
C COPYRIGHT (C) 1978 - UNIVERSITY OF NOTRE DAME * 00043400
C PROGRAM AUTHOR - TIMOTHY J. MALLOY * 00043410
C * 00043420
C***************************************************************** 00043430
SUBROUTINE NDT30 00043440
C***************************************************************** 00043450
C * 00043460
C OUTPUT FIELD PROCESSOR * 00043470
C * 00043480
C THIS PROGRAM, PART OF THE OUTPUT SYNTAX PHASE, PROCESSES * 00043490
C A CLAUSE INTO ITS BEGINNING AND END FIELDS. IT IS CALLED * 00043500
C BY NDT09, CALLS NDT35, AND USES NDT13 FOR HANDLING ERRORS. * 00043510
C * 00043520
C * 00043530
C***************************************************************** 00043540
REAL*8 RMIN,RMAX,LITBL(1024) 00043550
INTEGER PTRS(45),TITLE(120),CRSET(39),OPER(9),SYM(15), 00043560
1SUBSC(6),TYPCT(20),EQCHN(80),TOKEN(80),CARD1(80),CARD2(80), 00043570
2ERROR(80),OBJCD(160),DEF(80),XREF(80),TMAP(80),FCTN(5,22), 00043580
3SYMTB(5,512) 00043590
INTEGER CDATA(144),OUTPT(240),VARCT,TYPE,RUNNO,FLAG(11), 00043600
1CHAR(10),RUN(11),CFLAG,VMAX,IVPLT 00043610
INTEGER DMODE,RMODE,SMODE,LOOP,CLNUM,BGF(4),NDF(4),DELIM(6), 00043620
1SRNUM,RGFST,SFLAG,SLASH,EQSGN,OPNTH,CPNTH,COMMA,BLANK,XCHAR 00043630
COMMON RMIN,RMAX,PTRS,TITLE,CRSET,OPER,SYM,SUBSC,TYPCT, 00043640
1EQCHN,TOKEN,CARD1,CARD2,ERROR,OBJCD,DEF,XREF,TMAP,FCTN, 00043650
2SYMTB,LITBL 00043660
EQUIVALENCE (OUTPT(1),DEF(1),VARCT),(OUTPT(2),TYPE), 00043670
1(OUTPT(3),RUNNO),(OUTPT(158),IVPLT), 00043680
2(OUTPT(147),FLAG(1)),(OUTPT(179),RUN(1)),(OUTPT(200),CFLAG), 00043690
3(OUTPT(190),CHAR(1)),(CDATA(1),OBJCD(1)) 00043700
EQUIVALENCE (DMODE,OUTPT(201)),(RMODE,OUTPT(202)), 00043710
1(SMODE,OUTPT(203)),(LOOP,OUTPT(204)),(CLNUM,OUTPT(205)), 00043720
2(BGF(1),OUTPT(206)),(NDF(1),OUTPT(210)), 00043730
3(SRNUM,OUTPT(220)),(RGFST,OUTPT(221)),(SFLAG,OUTPT(222)), 00043740
4(VMAX,OUTPT(223)) 00043750
EQUIVALENCE (DELIM(1),SLASH),(DELIM(2),EQSGN), 00043760
1(DELIM(3),OPNTH),(DELIM(4),CPNTH),(DELIM(5),COMMA), 00043770
2(DELIM(6),BLANK) 00043780
DATA DELIM /'/','=','(',')',',',' '/ 00043790
C***************************************************************** 00043800
C * 00043810
C THIS FIRST SECTION INITIALIZES RMODE AND THE FIELD MARKERS * 00043820
C FOR A NEW CLAUSE. * 00043830
C * 00043840
C RMODE RANGE MODE 0 BEFORE PARENTHESES OCCUR * 00043850
C 1 INSIDE PARENTHESES, BEFORE COMMA * 00043860
C 2 INSIDE PARENTHESES, AFTER COMMA * 00043870
C * 00043880
C BGF, NDF BEGINNING AND END FIELD MARKERS * 00043890
C A CLAUSE IS DIVIDED INTO FOUR FIELDS: * 00043900
C 1 - VARIABLE FIELD (INCLUDES RUN NUMBER), * 00043910
C 2 - PLOT CHARACTER FIELD, * 00043920
C 3 - LOW FIELD, AND * 00043930
C 4 - HIGH FIELD. * 00043940
C BGF MARKS THE BEGINNING OF EACH FIELD, AND * 00043950
C NDF MARKS THE END OF THE FIELD. * 00043960
C BGF(1) IS SET TO THE NEXT CHARACTER. * 00043970
C * 00043980
C SFLAG END OF SERIES FLAG 0 SERIES CONTINUES * 00043990
C 1 END OF SERIES * 00044000
C * 00044010
C***************************************************************** 00044020
SFLAG = 0 00044030
RMODE = 0 00044040
DO 50 XCHAR = 1, 4 00044050
BGF(XCHAR) = 0 00044060
50 NDF(XCHAR) = 0 00044070
BGF(1) = LOOP + 1 00044080
C***************************************************************** 00044090
C * 00044100
C THIS SECTION SEARCHES FOR A MEMBER OF THE DELIMITER ARRAY * 00044110
C IN CDATA. * 00044120
C * 00044130
C DELIM - CONTAINS THE SIX DELIMITERS THE OUTPUT FIELD * 00044140
C PROCESSOR LOOKS FOR: * 00044150
C 1 - SLASH '/' * 00044160
C 2 - EQSGN '=' EQUAL SIGN * 00044170
C 3 - OPNTH '(' OPEN PARENTHESES * 00044180
C 4 - CPNTH ')' CLOSED PARENTHESES * 00044190
C 5 - COMMA ',' * 00044200
C 6 - BLANK ' ' * 00044210
C * 00044220
C***************************************************************** 00044230
100 LOOP = LOOP + 1 00044240
DO 200 XCHAR = 1,6 00044250
IF (CDATA(LOOP) .EQ. DELIM(XCHAR)) GO TO 300 00044260
200 CONTINUE 00044270
C***************************************************************** 00044280
C * 00044290
C IF THE CHARACTER WAS NOT ONE OF THE DELIM ARRAY, THE DATA * 00044300
C MODE IS SET TO INTERIOR MODE (DMODE = 0), AND THEN CONTROL * 00044310
C IS SENT BACK TO CHECK THE NEXT CHARACTER. * 00044320
C * 00044330
C***************************************************************** 00044340
DMODE = 0 00044350
GO TO 100 00044360
C***************************************************************** 00044370
C * 00044380
C A CHARACTER WAS FOUND. IF IN INTERIOR MODE, CONTROL IS * 00044390
C SENT TO THE APPROPRIATE SECTION. IF A BLANK OCCURS, GO TO * 00044400
C THE BLANK SECTION ANYWAY. * 00044410
C * 00044420
C IF DMODE INDICATES BEGINNING MODE, A DELIMITER HAS OCCURED * 00044430
C BEFORE ANY OTHER CHARACTER. * 00044440
C * 00044450
C***************************************************************** 00044460
300 IF (DMODE .GE. 0) GO TO (400,900,1200,1500,1600,2100),XCHAR 00044470
IF (XCHAR .EQ. 6) GO TO 2100 00044480
CALL NDT13(LOOP, 703, 2) 00044490
BGF(1) = LOOP + 1 00044500
GO TO 100 00044510
C***************************************************************** 00044520
C * 00044530
C * * * * * SLASH * * * * * * 00044540
C * 00044550
C * 00044560
C SET THE END OF CLAUSE MARKER (NDF(4)). * 00044570
C * 00044580
C***************************************************************** 00044590
400 NDF(4) = LOOP - 1 00044600
C***************************************************************** 00044610
C * 00044620
C ENTRY POINT FOR FINDING A )/ * 00044630
C PRINT CARDS ARE NOT ALLOWED TO HAVE SLASHES. * 00044640
C * 00044650
C***************************************************************** 00044660
500 IF (TYPE .EQ. 13) GO TO 600 00044670
CALL NDT13(LOOP, 702, 1) 00044680
GO TO 700 00044690
C***************************************************************** 00044700
C * 00044710
C SET SFLAG TO INDICATE END OF SERIES. * 00044720
C FOR A PLOT, A DOUBLE SLASH INDICATES AN INDEPENDENT * 00044730
C VARIABLE FIELD. IF ENCOUNERED, SET DMODE TO INDEPENDENT * 00044740
C VARIABLE MODE. * 00044750
C * 00044760
C***************************************************************** 00044770
600 SFLAG = 1 00044780
IF (CDATA(LOOP+1) .NE. SLASH) GO TO 700 00044790
DMODE = 2 00044800
IVPLT = 1 00044810
LOOP = LOOP + 1 00044820
C***************************************************************** 00044830
C * 00044840
C CALL NDT35, THE OUTPUT DELIMITER PROCESSOR, TO CHECK FOR * 00044850
C CONSECUTIVE COMMAS AND SLASHES. * 00044860
C * 00044870
C***************************************************************** 00044880
700 CALL NDT35(COMMA) 00044890
CALL NDT35(SLASH) 00044900
IF (CDATA(LOOP+1) .EQ. COMMA) GO TO 700 00044910
C***************************************************************** 00044920
C * 00044930
C IF NOT INSIDE PARENTHESES, GO TO THE END OF CLAUSE SECTION.* 00044940
C OTHERWISE, THERE SHOULD HAVE BEEN A CLOSED PARENTHESES * 00044950
C BEFORE THIS SLASH. * 00044960
C * 00044970
C CHECK THE NEXT CHARACTER FOR A CPNTH, CALL THE APPROPRIATE * 00044980
C ERROR MESSAGE, AND THEN GO TO THE END OF CLAUSE SECTION. * 00044990
C IF THE CPNTH WAS MISSING, CHANGE THE CHARACTER SO THAT THE * 00045000
C RANGE PROCESSOR CAN SET THE SERIES CORRECTLY. * 00045010
C * 00045020
C***************************************************************** 00045030
IF (RMODE .EQ. 0) GO TO 2300 00045040
IF (CDATA(LOOP+1) .EQ. CPNTH) GO TO 800 00045050
CALL NDT13(LOOP, 710, 2) 00045060
GO TO 2300 00045070
800 CALL NDT13(LOOP, 705, 1) 00045080
LOOP = LOOP + 1 00045090
GO TO 2300 00045100
C***************************************************************** 00045110
C * 00045120
C * * * * * EQUAL SIGN * * * * * * 00045130
C * 00045140
C * 00045150
C AN EQUAL SIGN MAY NOT APPEAR WITHIN PARENTHESES. IF FOUND,* 00045160
C NOTE THE ERROR AND LOOK FOR ANOTHER DELIMITER. * 00045170
C * 00045180
C***************************************************************** 00045190
900 IF (RMODE .EQ. 0) GO TO 1000 00045200
CALL NDT13(LOOP, 718, 2) 00045210
GO TO 100 00045220
C***************************************************************** 00045230
C * 00045240
C NO PARENTHESES HAVE OCCURED. SET THE FIELD MARKERS, CHECK * 00045250
C FOR CONSECUTIVE EQSGNS, AND CHECK FOR A PRINT CARD. THE * 00045260
C EQUAL SIGN IS NOT LEGAL ON A PRINT CARD. * 00045270
C * 00045280
C THEN GO SEARCH FOR ANOTHER DELIMITER. * 00045290
C * 00045300
C***************************************************************** 00045310
1000 NDF(1) = LOOP - 1 00045320
CALL NDT35(EQSGN) 00045330
IF (TYPE .EQ. 12) GO TO 1100 00045340
BGF(2) = LOOP + 1 00045350
GO TO 100 00045360
1100 CALL NDT13(LOOP, 712, 2) 00045370
BGF(2) = -1 00045380
GO TO 100 00045390
C***************************************************************** 00045400
C * 00045410
C * * * * * OPEN PARENTHESIS * * * * * * 00045420
C * 00045430
C * 00045440
C * 00045450
C PARENTHESES ARE NOT ALLOWED ON PRINT CARDS. * 00045460
C * 00045470
C FIRST CHECK FOR PROPER PARENTHESES. IF A SECOND OPNTH * 00045480
C IS ENCOUNTERED, IT IS ASSUMED TO BE A CLOSED PARNTHESIS. * 00045490
C CONTROL IS SENT TO THAT SECTION. * 00045500
C * 00045510
C***************************************************************** 00045520
1200 IF (TYPE .EQ. 12) CALL NDT13(LOOP, 722, 2) 00045530
IF (RMODE .EQ. 0) GO TO 1300 00045540
CALL NDT13(LOOP, 706, 2) 00045550
GO TO 1500 00045560
C***************************************************************** 00045570
C * 00045580
C SET THE RANGE MODE AND FIELD MARKERS. CHECK IF THE END * 00045590
C OF THE VARIABLE FIELD (NDF(1)) HAS BEEN DEFINED. IF IT * 00045600
C HASN'T, THEN SET IT NOW. * 00045610
C * 00045620
C***************************************************************** 00045630
1300 RMODE = 1 00045640
NDF(2) = LOOP - 1 00045650
IF (NDF(1) .NE. 0) GO TO 1400 00045660
NDF(1) = LOOP - 1 00045670
BGF(2) = -1 00045680
C***************************************************************** 00045690
C * 00045700
C CHECK FOR CONSECUTIVE OPNTH, THEN LOOK FOR ANOTHER * 00045710
C DELIMITER. * 00045720
C * 00045730
C***************************************************************** 00045740
1400 CALL NDT35(OPNTH) 00045750
BGF(3) = LOOP + 1 00045760
GO TO 100 00045770
C***************************************************************** 00045780
C * 00045790
C * * * * * CLOSED PARENTHESIS * * * * * * 00045800
C * 00045810
C * 00045820
C SET FIELD MARKERS. CHECK FOR PARENTHESIS ERRORS, AND * 00045830
C CONSECUTIVE CPNTHS. SET RMODE TO INDICATE COMPLETED * 00045840
C PARENTHESES. * 00045850
C * 00045860
C***************************************************************** 00045870
1500 NDF(4) = LOOP - 1 00045880
IF (RMODE .NE. 2) CALL NDT13(LOOP, 708 + RMODE*11, 2) 00045890
CALL NDT35(CPNTH) 00045900
RMODE = 0 00045910
C***************************************************************** 00045920
C * 00045930
C A SLASH OR A COMMA SHOULD OCCUR AFTER A CPNTH. UPON THIS * 00045940
C OCCURENCE, SEND CONTROL TO THE CORRESPONDING SECTION. * 00045950
C NOTE THE ERROR IF BOTH TESTS FAIL, THEN GO TO * 00045960
C END OF CLAUSE. * 00045970
C * 00045980
C***************************************************************** 00045990
LOOP = LOOP + 1 00046000
IF (CDATA(LOOP) .EQ. COMMA) GO TO 1700 00046010
IF (CDATA(LOOP) .EQ. SLASH) GO TO 500 00046020
IF (CDATA(LOOP) .EQ. BLANK) GO TO 2200 00046030
LOOP = LOOP - 1 00046040
CALL NDT13(LOOP, 707, 2) 00046050
GO TO 2300 00046060
C***************************************************************** 00046070
C * 00046080
C * * * * * COMMA * * * * * * 00046090
C * 00046100
C * 00046110
C SET FIELD MARKER, CHECK FOR CONSECUTIVE COMMAS. * 00046120
C * 00046130
C***************************************************************** 00046140
1600 NDF(4) = LOOP - 1 00046150
CALL NDT35(COMMA) 00046160
C***************************************************************** 00046170
C * 00046180
C A COMMA IS HANDLED DIFFERENTLY, ACCORDING TO THE STATUS * 00046190
C OF THE PARENTHESES, AS INDICATED BY RMODE. * 00046200
C * 00046210
C***************************************************************** 00046220
IF (RMODE - 1) 1700, 1800, 1900 00046230
C * 00046240
C * 00046250
C OUTSIDE PARENTHESES * 00046260
C * 00046270
C CHECK FOR CONSECUTIVE SLASHES AND COMMAS, AND THEN GO TO * 00046280
C END OF CLAUSE. * 00046290
C * 00046300
C***************************************************************** 00046310
1700 CALL NDT35(SLASH) 00046320
CALL NDT35(COMMA) 00046330
IF (CDATA(LOOP + 1) .EQ. SLASH) GO TO 1700 00046340
GO TO 2300 00046350
C***************************************************************** 00046360
C * 00046370
C INSIDE PARENTHESES * 00046380
C * 00046390
C SET RMODE, FIELD MARKERS, AND SEARCH FOR ANOTHER DELIMITER.* 00046400
C * 00046410
C***************************************************************** 00046420
1800 NDF(3) = NDF(4) 00046430
RMODE = 2 00046440
BGF(4) = LOOP + 1 00046450
GO TO 100 00046460
C***************************************************************** 00046470
C * 00046480
C SECOND COMMA WITHIN PARENTHESES * 00046490
C * 00046500
C IF NEXT CHARACTER IS A CLOSED PARENTHESIS, ASSUME THE ,) * 00046510
C WAS MEANT TO BE A ),. * 00046520
C IF NOT, TREAT THE SECOND COMMA AS AN OUTSIDE COMMA. * 00046530
C * 00046540
C***************************************************************** 00046550
1900 IF (CDATA(LOOP + 1) .EQ. CPNTH) GO TO 2000 00046560
CALL NDT13(LOOP, 709, 2) 00046570
GO TO 1700 00046580
2000 CALL NDT13(LOOP, 705, 1) 00046590
LOOP = LOOP + 1 00046600
GO TO 2300 00046610
C***************************************************************** 00046620
C * 00046630
C * * * * * BLANK * * * * * * 00046640
C * 00046650
C * 00046660
C SET END FIELD MARKER. * 00046670
C IF DMODE IS ZERO, THEN THERE WAS NO VARIABLE FIELD ON THIS * 00046680
C CARD. SET BGF(1) TO -1 TO SIGNIFY THIS CONDITION. * 00046690
C THEN GO TO THE RETURN SECTION. * 00046700
C * 00046710
C***************************************************************** 00046720
2100 NDF(4) = LOOP - 1 00046730
IF (DMODE .GE. 0) GO TO 2200 00046740
CALL NDT13(LOOP, 704, 3) 00046750
BGF(1) = -1 00046760
GO TO 2800 00046770
C***************************************************************** 00046780
C * 00046790
C CHECK THE LAST CHARACTERS BEFORE THE BLANK FOR A COMMA OR * 00046800
C SLASH. THIS IS AN ERROR. * 00046810
C * 00046820
C***************************************************************** 00046830
2200 IF (CDATA(LOOP-1) .EQ. SLASH .OR. CDATA(LOOP-1) .EQ. COMMA) 00046840
1 CALL NDT13(LOOP-1, 703, 2) 00046850
DMODE = 1 00046860
SFLAG = 1 00046870
C***************************************************************** 00046880
C * 00046890
C * * * * * END OF CLAUSE * * * * * * 00046900
C * 00046910
C * 00046920
C THIS SECTION CHECKS THROUGH THE FIELD MARKERS TO MAKE SURE * 00046930
C ALL DEFAULTS ARE SET. THERE ARE THREE CASES THAT MAY OCCUR* 00046940
C THAT ARE HANDLED: * 00046950
C * 00046960
C VARIABLE BY ITSELF (NDF1 = 0) * 00046970
C NDF(1) = CURRENT POSITION * 00046980
C BEGINNING FIELDS 2 - 4 DEFAULT (-1) * 00046990
C * 00047000
C VARIABLE AND PLOT CHARACTER (NDF2 = 0) * 00047010
C NDF(2) = CURRENT POSITION * 00047020
C BEGINNING FIELDS 3 AND 4 DEFAULT * 00047030
C * 00047040
C NO COMMA INSIDE PARENTHESES (BGF(4) = 0) * 00047050
C NDF(3) = NDF(4) * 00047060
C BEGINNING FIELD 4 DEFAULT * 00047070
C * 00047080
C***************************************************************** 00047090
2300 IF (NDF(2) .EQ. 0) GO TO 2400 00047100
IF (BGF(4) .NE. 0) GO TO 2800 00047110
NDF(3) = NDF(4) 00047120
GO TO 2700 00047130
2400 IF (NDF(1) .EQ. 0) GO TO 2500 00047140
NDF(2) = NDF(4) 00047150
GO TO 2600 00047160
2500 NDF(1) = NDF(4) 00047170
BGF(2) = -1 00047180
2600 BGF(3) = -1 00047190
2700 BGF(4) = -1 00047200
C***************************************************************** 00047210
C * 00047220
C * * * * * RETURN SECTION * * * * * * 00047230
C * 00047240
C IF LAST VARIABLE TO BE PROCESSED, SET END OF SERIES FLAG. * 00047250
C * 00047260
C***************************************************************** 00047270
2800 IF (CLNUM .EQ. VMAX) SFLAG = 1 00047280
RETURN 00047290
END 00047310
C***************************************************************** 00047320
C * 00047330
C COPYRIGHT (C) 1978 - UNIVERSITY OF NOTRE DAME * 00047340
C PROGRAM AUTHOR - TIMOTHY J. MALLOY * 00047350
C * 00047360
C***************************************************************** 00047370
SUBROUTINE NDT31 00047380
C***************************************************************** 00047390
C * 00047400
C OUTPUT VARIABLE PROCESSOR * 00047410
C * 00047420
C THIS PROGRAM, PART OF THE OUTPUT SYNTAX PHASE, PROCESSES * 00047430
C THE VARIABLES FOUND ON AN OUTPUT CARD. IT IS CALLED BY * 00047440
C NDT09, CALLS NDT36 TO PROCESS THE RUN NUMBER FIELD, CALLS * 00047450
C NDT24 AND NDT27 TO CHECK THE SYNTAX OF THE VARIABLE, AND * 00047460
C USES NDT13 FOR ERROR HANDLING. * 00047470
C * 00047480
C***************************************************************** 00047490
REAL*8 RMIN,RMAX,LITBL(1024) 00047500
REAL*8 LOW(11),HIGH(11) 00047510
INTEGER PTRS(45),TITLE(120),CRSET(39),OPER(9),SYM(15), 00047520
1SUBSC(6),TYPCT(20),EQCHN(80),TOKEN(80),CARD1(80),CARD2(80), 00047530
2ERROR(80),OBJCD(160),DEF(80),XREF(80),TMAP(80),FCTN(5,22), 00047540
3SYMTB(5,512) 00047550
INTEGER CDATA(144),OUTPT(240),VARCT,TYPE,RUNNO,VNUM(11), 00047560
1FLAG(11),RUN(11),CHAR(10),CFLAG 00047570
INTEGER DMODE,RMODE,SMODE,LOOP,CLNUM,BGF(4),NDF(4), 00047580
1XCHAR,VAROK,BGF1,NDF1,XOTPT 00047590
COMMON RMIN,RMAX,PTRS,TITLE,CRSET,OPER,SYM,SUBSC,TYPCT, 00047600
1EQCHN,TOKEN,CARD1,CARD2,ERROR,OBJCD,DEF,XREF,TMAP,FCTN, 00047610
2SYMTB,LITBL 00047620
EQUIVALENCE (OUTPT(1),DEF(1),VARCT),(OUTPT(2),TYPE), 00047630
1(OUTPT(3),RUNNO),(OUTPT(103),LOW(1)),(OUTPT(125),HIGH(1)), 00047640
2(OUTPT(147),FLAG(1)),(OUTPT(179),RUN(1)),(OUTPT(200),CFLAG), 00047650
3(OUTPT(190),CHAR(1)),(CDATA(1),OBJCD(1)),(OUTPT(92),VNUM(1)) 00047660
EQUIVALENCE (DMODE,OUTPT(201)),(RMODE,OUTPT(202)), 00047670
1(SMODE,OUTPT(203)),(LOOP,OUTPT(204)),(CLNUM,OUTPT(205)), 00047680
2(BGF(1),OUTPT(206),BGF1),(NDF(1),OUTPT(210),NDF1), 00047690
3(SRNUM,OUTPT(220)),(CLFST,OUTPT(221)) 00047700
C***************************************************************** 00047710
C * 00047720
C BEFORE ACTUALLY CHECKING THE VARIABLE, THE RUN NUMBER MUST * 00047730
C BE FOUND AND CHECKED. CALL NDT36 TO DO THIS. * 00047740
C * 00047750
C***************************************************************** 00047760
CALL NDT36 00047770
C***************************************************************** 00047780
C * 00047790
C CALL THE VARIABLE SYNTAX CHECKER. VAROK, THE RETURN CODE * 00047800
C INDICATES IF THE VARIABLE IS OKAY. IF IT ISN'T, RETURN. * 00047810
C THEN CALL THE VARIABLE PROCESSOR. * 00047820
C * 00047830
C***************************************************************** 00047840
CALL NDT24(BGF1, NDF1, VAROK) 00047850
IF (VAROK .NE. 0) GO TO 1000 00047860
CALL NDT27(BGF1, TYPE-11) 00047870
C***************************************************************** 00047880
C * 00047890
C PLACE THE VARIABLE NAME AND VARIABLE NUMBER IN THE * 00047900
C OUTPUT BUFFER. * 00047910
C * 00047920
C***************************************************************** 00047930
DO 900 XCHAR = 1, 6 00047940
XOTPT = 8*CLNUM - 5 + XCHAR 00047950
900 OUTPT(XOTPT) = SYM(XCHAR) 00047960
VNUM(CLNUM) = SYM(14) 00047970
C***************************************************************** 00047980
C * 00047990
C * * * * * RETURN SECTION * * * * * * 00048000
C * 00048010
C***************************************************************** 00048020
1000 RETURN 00048030
END 00048050
C***************************************************************** 00048060
C * 00048070
C COPYRIGHT (C) 1978 - UNIVERSITY OF NOTRE DAME * 00048080
C PROGRAM AUTHOR - TIMOTHY J. MALLOY * 00048090
C * 00048100
C***************************************************************** 00048110
SUBROUTINE NDT32 00048120
C***************************************************************** 00048130
C * 00048140
C PLOT CHARACTER PROCESSOR * 00048150
C * 00048160
C THIS PROGRAM, PART OF THE OUTPUT SYNTAX PHASE, PROCESSES * 00048170
C THE PLOT CHARACTERS FOUND ON A PLOT CARD. IT IS CALLED * 00048180
C BY NDT09, AND USES NDT13 FOR HANDLING ERRORS. * 00048190
C * 00048200
C NDT32 FILLS IN THE OUTPUT BUFFER PLOT CHARACTER ARRAY, * 00048210
C CHAR, CHECKING FOR ILLEGAL CHARACTERS AND DUPLICATIONS. * 00048220
C * 00048230
C***************************************************************** 00048240
REAL*8 RMIN,RMAX,LITBL(1024) 00048250
REAL*8 LOW(11),HIGH(11) 00048260
INTEGER PTRS(45),TITLE(120),CRSET(39),OPER(9),SYM(15), 00048270
1SUBSC(6),TYPCT(20),EQCHN(80),TOKEN(80),CARD1(80),CARD2(80), 00048280
2ERROR(80),OBJCD(160),DEF(80),XREF(80),TMAP(80),FCTN(5,22), 00048290
3SYMTB(5,512) 00048300
INTEGER CDATA(144),OUTPT(240),VARCT,TYPE,RUNNO,FLAG(11), 00048310
1CHAR(10),RUN(11),CFLAG 00048320
INTEGER DMODE,RMODE,SMODE,LOOP,CLNUM,BGF(4),NDF(4),BGF2, 00048330
1SRNUM,CLFST,XCHAR,OMEGA 00048340
COMMON RMIN,RMAX,PTRS,TITLE,CRSET,OPER,SYM,SUBSC,TYPCT, 00048350
1EQCHN,TOKEN,CARD1,CARD2,ERROR,OBJCD,DEF,XREF,TMAP,FCTN, 00048360
2SYMTB,LITBL 00048370
EQUIVALENCE (OUTPT(1),DEF(1),VARCT),(OUTPT(2),TYPE), 00048380
1(OUTPT(3),RUNNO),(OUTPT(103),LOW(1)),(OUTPT(125),HIGH(1)), 00048390
2(OUTPT(147),FLAG(1)),(OUTPT(179),RUN(1)),(OUTPT(200),CFLAG), 00048400
3(OUTPT(190),CHAR(1)),(CDATA(1),OBJCD(1)) 00048410
EQUIVALENCE (DMODE,OUTPT(201)),(RMODE,OUTPT(202)), 00048420
1(SMODE,OUTPT(203)),(LOOP,OUTPT(204)),(CLNUM,OUTPT(205)), 00048430
2(BGF(1),OUTPT(206)),(NDF(1),OUTPT(210)),(DOT,OPER(1)), 00048440
3(SRNUM,OUTPT(220)),(CLFST,OUTPT(221)) 00048450
C***************************************************************** 00048460
C * 00048470
C IF THERE IS NO PLOT CHARACTER FIELD, PROCEED IMMEDIATELY * 00048480
C TO THE RETURN SECTION. * 00048490
C * 00048500
C AN INDEPENDENT VARIABLE MAY NOT HAVE A PLOT CHARACTER. * 00048510
C * 00048520
C***************************************************************** 00048530
BGF2 = BGF(2) 00048540
IF (BGF2 .LE. 0) GO TO 700 00048550
IF (CLNUM .NE. 1) GO TO 100 00048560
CALL NDT13(BGF2-1, 723, 2) 00048570
GO TO 100 00048580
C***************************************************************** 00048590
C * 00048600
C CHECK THE LENGTH OF THE PLOT CHARACTER FIELD. * 00048610
C * 00048620
C***************************************************************** 00048630
100 IF (NDF(2)-BGF2) 200, 400, 300 00048640
C***************************************************************** 00048650
C * 00048660
C NO FIELD AFTER EQUAL SIGN. * 00048670
C CALL THE ERROR ROUTINE, AND GO TO THE RETURN SECTION. * 00048680
C * 00048690
C***************************************************************** 00048700
200 CALL NDT13(NDF(2), 715, 2) 00048710
GO TO 700 00048720
C***************************************************************** 00048730
C * 00048740
C FIELD TOO LONG --- NOTE ERROR AND IGNORE EXTRA CHARACTERS. * 00048750
C * 00048760
C***************************************************************** 00048770
300 CALL NDT13(BGF2+1, 713, 2) 00048780
C***************************************************************** 00048790
C * 00048800
C FIELD IS LENGTH 1 --- CHECK FOR DUPLICATE CHARACTERS * 00048810
C * 00048820
C***************************************************************** 00048830
400 OMEGA = CLNUM - 2 00048840
DO 500 XCHAR = 1, OMEGA 00048850
IF(CHAR(XCHAR) .EQ. CDATA(BGF2)) GO TO 600 00048860
500 CONTINUE 00048870
C***************************************************************** 00048880
C * 00048890
C IF THIS CHARACTER WAS NOT USED BEFORE, ASSIGN IT * 00048900
C IN THE CHAR ARRAY OF OUTPT, THEN RETURN. * 00048910
C * 00048920
C***************************************************************** 00048930
CHAR(CLNUM - 1) = CDATA(BGF2) 00048940
GO TO 700 00048950
C***************************************************************** 00048960
C * 00048970
C DUPLICATE PLOT CHARACTERS * 00048980
C * 00048990
C***************************************************************** 00049000
600 CALL NDT13(BGF2, 714, 1) 00049010
C***************************************************************** 00049020
C * 00049030
C RETURN SECTION * 00049040
C * 00049050
C***************************************************************** 00049060
700 RETURN 00049070
END 00049090
C***************************************************************** 00049100
C * 00049110
C COPYRIGHT (C) 1978 - UNIVERSITY OF NOTRE DAME * 00049120
C PROGRAM AUTHOR - TIMOTHY J. MALLOY * 00049130
C * 00049140
C***************************************************************** 00049150
SUBROUTINE NDT33 00049160
C***************************************************************** 00049170
C * 00049180
C PLOT RANGE ANALYZER * 00049190
C * 00049200
C * 00049210
C THIS PROGRAM, PART OF THE OUTPUT SYNTAX PHASE, ANALYZES A * 00049220
C PLOT RANGE FOR DEFAULT INFORMATION ABOUT THE LOW AND HIGH * 00049230
C VALUES, SETTING FLAG. NDT33 IS CALLED BY NDT09, AND CALLS * 00049240
C NDT22 TO SYNTAX CHECK THE NUMBERS. * 00049250
C * 00049260
C***************************************************************** 00049270
REAL*8 RMIN,RMAX,LITBL(1024) 00049280
REAL*8 LOW(11),HIGH(11) 00049290
INTEGER PTRS(45),TITLE(120),CRSET(39),OPER(9),SYM(15), 00049300
1SUBSC(6),TYPCT(20),EQCHN(80),TOKEN(80),CARD1(80),CARD2(80), 00049310
2ERROR(80),OBJCD(160),DEF(80),XREF(80),TMAP(80),FCTN(5,22), 00049320
3SYMTB(5,512) 00049330
INTEGER CDATA(144),OUTPT(240),VARCT,TYPE,RUNNO,FLAG(11), 00049340
1CHAR(10),RUN(11),CFLAG,SRCNT 00049350
INTEGER DMODE,RMODE,SMODE,LOOP,CLNUM,BGF(4),NDF(4), 00049360
1SRNUM,CLFST,SFLAG,CLSPT,HILO,BGFLD,SLASH,STAR 00049370
INTEGER LITCT,TOKPT 00049380
COMMON RMIN,RMAX,PTRS,TITLE,CRSET,OPER,SYM,SUBSC,TYPCT, 00049390
1EQCHN,TOKEN,CARD1,CARD2,ERROR,OBJCD,DEF,XREF,TMAP,FCTN, 00049400
2SYMTB,LITBL 00049410
EQUIVALENCE (OUTPT(1),DEF(1),VARCT),(OUTPT(2),TYPE), 00049420
1(OUTPT(3),RUNNO),(OUTPT(103),LOW(1)),(OUTPT(125),HIGH(1)), 00049430
2(OUTPT(147),FLAG(1)),(OUTPT(179),RUN(1)),(OUTPT(200),CFLAG), 00049440
3(OUTPT(190),CHAR(1)),(CDATA(1),OBJCD(1)),(SRCNT,OUTPT(178)) 00049450
EQUIVALENCE (DMODE,OUTPT(201)),(RMODE,OUTPT(202)), 00049460
1(SMODE,OUTPT(203)),(LOOP,OUTPT(204)),(CLNUM,OUTPT(205)), 00049470
2(BGF(1),OUTPT(206)),(NDF(1),OUTPT(210)), 00049480
3(SRNUM,OUTPT(220)),(CLFST,OUTPT(221)),(SFLAG,OUTPT(222)) 00049490
EQUIVALENCE (TOKPT,TOKEN(3)),(LITCT,PTRS(18)) 00049500
DATA SLASH,STAR /'/','*'/ 00049510
C***************************************************************** 00049520
C * 00049530
C HILO KEEPS TRACK OF WHETHER THE LOW OR THE HIGH IS * 00049540
C CURRENTLY BEING USED: 3 FOR LOW, 4 FOR HIGH. IF THE * 00049550
C FIELD WAS NOT FOUND, THIS VALUE WILL BE ASSIGNED LATER, SO * 00049560
C GO TO THE DEFAULT SECTION. * 00049570
C * 00049580
C***************************************************************** 00049590
HILO = 2 00049600
100 HILO = HILO + 1 00049610
BGFLD = BGF(HILO) 00049620
IF (BGFLD .LT. 0) GO TO 600 00049630
C***************************************************************** 00049640
C * 00049650
C WHEN CHECKING LOW, CHECK THE STATUS OF RANGE DEFINITIONS * 00049660
C FOR THIS SERIES, ACCORDING TO SMODE. * 00049670
C SMODE -1 NO RANGE DEFINED, SET SMODE TO 0. * 00049680
C 0 FIRST RANGE DEFINITION, WILL NOT OCCUR * 00049690
C AT THIS TIME. * 00049700
C 1 A RANGE HAS BEEN PREVIOUSLY DEFINED FOR * 00049710
C FOR THIS SERIES, ERROR. * 00049720
C * 00049730
C***************************************************************** 00049740
IF (SMODE .LE. 0) GO TO 200 00049750
IF (HILO .EQ. 3) CALL NDT13(BGFLD, 716, 2) 00049760
GO TO 600 00049770
200 SMODE = 0 00049780
C***************************************************************** 00049790
C * 00049800
C A STAR DENOTES A DEFAULT VALUE. * 00049810
C * 00049820
C***************************************************************** 00049830
IF (NDF(HILO) - BGFLD .EQ. 0 .AND. CDATA(BGFLD) .EQ. STAR) 00049840
1 GO TO 600 00049850
C***************************************************************** 00049860
C * 00049870
C CALL NDT22 TO CHECK THE NUMBER'S VALIDITY, INSERT IN EITHER* 00049880
C THE LOW OR HIGH ARRAY, AND DELETE THE ENTRY FROM BOTH THE * 00049890
C LITERAL TABLE AND TOKEN ARRAY. * 00049900
C * 00049910
C***************************************************************** 00049920
CALL NDT22(BGFLD, NDF(HILO)) 00049930
IF (HILO .EQ. 3) LOW(CLNUM) = LITBL(LITCT) 00049940
IF (HILO .EQ. 4) HIGH(CLNUM) = LITBL(LITCT) 00049950
TOKPT = TOKPT - 1 00049960
LITCT = LITCT - 1 00049970
GO TO 700 00049980
C***************************************************************** 00049990
C * 00050000
C * * * * * DEFAULT * * * * * * 00050010
C OCCURRENCE OF A STAR CHANGES SMODE, * 00050020
C SET FLAG FOR ANY DEFAULT. * 00050030
C * 00050040
C***************************************************************** 00050050
600 FLAG(CLNUM) = FLAG(CLNUM) + HILO - 2 00050060
C***************************************************************** 00050070
C * 00050080
C DO AGAIN FOR HIGH. CHECK SMODE FOR SERIES INFORMATION. * 00050090
C * 00050100
C***************************************************************** 00050110
700 IF (HILO .EQ. 3) GO TO 100 00050120
IF (CLNUM .NE. 1) GO TO 750 00050130
FLAG(1) = FLAG(1) + 10 00050140
GO TO 1200 00050150
750 IF (SMODE) 800, 900, 1000 00050160
C***************************************************************** 00050170
C * 00050180
C NO RANGE DEFINED YET, BUT A SLASH OR BLANK MARKS THE END OF* 00050190
C THE SERIES. THE FIRST VARIABLE IN THE SERIES WILL DEFINE * 00050200
C THE RANGE FOR THE ENTIRE SERIES. * 00050210
C * 00050220
C***************************************************************** 00050230
800 IF (SFLAG .EQ. 0) GO TO 1200 00050240
SRNUM = 10 * CLFST 00050250
GO TO 1000 00050260
C***************************************************************** 00050270
C * 00050280
C THIS VARIABLE HOLDS THE RANGE DATA FOR THIS SERIES. * 00050290
C * 00050300
C***************************************************************** 00050310
900 SRNUM = 10 * CLNUM 00050320
C***************************************************************** 00050330
C * 00050340
C THE RANGE HAS ALREADY BEEN DEFINED FOR THIS SERIES, ADD * 00050350
C THE DEFAULT INFORMATION TO THIS VARIABLE. * 00050360
C * 00050370
C***************************************************************** 00050380
1000 DO 1100 CLSPT = CLFST, CLNUM 00050390
1100 FLAG(CLSPT) = FLAG(CLSPT) + SRNUM 00050400
CLFST = CLNUM + 1 00050410
C***************************************************************** 00050420
C * 00050430
C SET SMODE TO SHOW SERIES STATUS. A SLASH MARKS THE * 00050440
C BEGINNING OF A NEW SERIES. * 00050450
C * 00050460
C***************************************************************** 00050470
SMODE = 1 00050480
IF (SFLAG .EQ. 0) GO TO 1200 00050490
SMODE = -1 00050500
IF (CLNUM .NE. 1) SRCNT = SRCNT + 1 00050510
1200 RETURN 00050520
END 00050540
C***************************************************************** 00050550
C * 00050560
C COPYRIGHT (C) 1978 - UNIVERSITY OF NOTRE DAME * 00050570
C PROGRAM AUTHOR - TIMOTHY J. MALLOY * 00050580
C * 00050590
C***************************************************************** 00050600
SUBROUTINE NDT34 00050610
C***************************************************************** 00050620
C * 00050630
C PLOT CHARACTER DEFAULT ASSIGNMENTS * 00050640
C * 00050650
C * 00050660
C * 00050670
C THIS PROGRAM, PART OF THE OUTPUT SYNTAX PHASE, ASSIGNS PLOT* 00050680
C CHARACTERS TO EACH VARIABLE TO BE PLOTTED. * 00050690
C NDT34 IS CALLED BY THE OUTPUT ANALYZER, NDT09. * 00050700
C * 00050710
C***************************************************************** 00050720
REAL*8 RMIN,RMAX,LITBL(1024) 00050730
REAL*8 LOW(11),HIGH(11) 00050740
INTEGER PTRS(45),TITLE(120),CRSET(39),OPER(9),SYM(15), 00050750
1SUBSC(6),TYPCT(20),EQCHN(80),TOKEN(80),CARD1(80),CARD2(80), 00050760
2ERROR(80),OBJCD(160),DEF(80),XREF(80),TMAP(80),FCTN(5,22), 00050770
3SYMTB(5,512) 00050780
INTEGER CDATA(144),OUTPT(240),VARCT,TYPE,RUNNO,FLAG(11), 00050790
1CHAR(10),RUN(11),CFLAG 00050800
INTEGER CLNUM,XCHAR,CHAR1,OMEGA,XALPH,NVAR,DIGIT(9) 00050810
COMMON RMIN,RMAX,PTRS,TITLE,CRSET,OPER,SYM,SUBSC,TYPCT, 00050820
1EQCHN,TOKEN,CARD1,CARD2,ERROR,OBJCD,DEF,XREF,TMAP,FCTN, 00050830
2SYMTB,LITBL 00050840
EQUIVALENCE (OUTPT(1),DEF(1),VARCT),(OUTPT(2),TYPE), 00050850
1(OUTPT(3),RUNNO),(OUTPT(103),LOW(1)),(OUTPT(125),HIGH(1)), 00050860
2(OUTPT(147),FLAG(1)),(OUTPT(179),RUN(1)),(OUTPT(200),CFLAG), 00050870
3(OUTPT(190),CHAR(1)),(CDATA(1),OBJCD(1)),(DIGIT(1),CRSET(31)) 00050880
C***************************************************************** 00050890
C * 00050900
C EACH VARIABLE IS FIRST CHECKED IF IT HAS BEEN ASSIGNED A * 00050910
C PLOT CHARACTER. * 00050920
C***************************************************************** 00050930
NVAR = VARCT - 1 00050940
DO 700 CLNUM = 1, NVAR 00050950
IF (CHAR(CLNUM) .NE. 0) GO TO 700 00050960
C***************************************************************** 00050970
C * 00050980
C IF THERE IS MORE THAN ONE RUN, FIRST TRY TO ASSIGN THE * 00050990
C RUN NUMBER. * 00051000
C * 00051010
C***************************************************************** 00051020
IF (RUNNO .EQ. 1) GO TO 200 00051030
XALPH = RUN(CLNUM + 1) 00051035
DO 100 XCHAR = 1, NVAR 00051040
IF (DIGIT(XALPH) .EQ. CHAR(XCHAR)) GO TO 200 00051050
100 CONTINUE 00051060
CHAR(CLNUM) = DIGIT(XALPH) 00051080
GO TO 700 00051090
C***************************************************************** 00051100
C * 00051110
C NEXT TRY TO ASSIGN THE FIRST LETTER OF THE VARIABLE NAME. * 00051120
C * 00051130
C***************************************************************** 00051140
200 CHAR1 = OUTPT(8*CLNUM + 4) 00051150
DO 300 XCHAR = 1, NVAR 00051160
IF (CHAR1 .EQ. CHAR(XCHAR)) GO TO 400 00051170
300 CONTINUE 00051180
CHAR(CLNUM) = CHAR1 00051190
GO TO 700 00051200
C***************************************************************** 00051210
C * 00051220
C FINALLY, ASSIGN FROM THE ALPHABET. * 00051230
C * 00051240
C***************************************************************** 00051250
400 OMEGA = NVAR + 4 00051260
DO 600 XALPH = 4, OMEGA 00051270
DO 500 XCHAR = 1, NVAR 00051280
IF (CRSET(XALPH) .EQ. CHAR(XCHAR)) GO TO 600 00051290
500 CONTINUE 00051300
CHAR(CLNUM) = CRSET(XALPH) 00051310
GO TO 700 00051320
600 CONTINUE 00051330
700 CONTINUE 00051340
RETURN 00051350
END 00051370
C***************************************************************** 00051380
C * 00051390
C COPYRIGHT (C) 1978 - UNIVERSITY OF NOTRE DAME * 00051400
C PROGRAM AUTHOR - TIMOTHY J. MALLOY * 00051410
C * 00051420
C***************************************************************** 00051430
SUBROUTINE NDT35 (CHAR) 00051440
C***************************************************************** 00051450
C * 00051460
C OUTPUT DELIMITER ANALYZER * 00051470
C * 00051480
C * 00051490
C * 00051500
C THIS PROGRAM, PART OF THE OUTPUT SYNTAX PHASE, CHECKS FOR * 00051510
C THE OCCURRENCE OF THE CHARACTER CHAR IN CDATA AFTER THE * 00051520
C POSITION HELD IN LOOP. * 00051530
C * 00051540
C***************************************************************** 00051550
REAL*8 RMIN,RMAX,LITBL(1024) 00051560
INTEGER PTRS(45),TITLE(120),CRSET(39),OPER(9),SYM(15), 00051570
1SUBSC(6),TYPCT(20),EQCHN(80),TOKEN(80),CARD1(80),CARD2(80), 00051580
2ERROR(80),OBJCD(160),DEF(80),XREF(80),TMAP(80),FCTN(5,22), 00051590
3SYMTB(5,512) 00051600
INTEGER CDATA(144),LOOP,CHAR,OUTPT(240) 00051610
COMMON RMIN,RMAX,PTRS,TITLE,CRSET,OPER,SYM,SUBSC,TYPCT, 00051620
1EQCHN,TOKEN,CARD1,CARD2,ERROR,OBJCD,DEF,XREF,TMAP,FCTN, 00051630
2SYMTB,LITBL 00051640
EQUIVALENCE (CDATA(1),OBJCD(1)),(OUTPT(1),DEF(1)), 00051650
1(LOOP,OUTPT(204)) 00051660
C***************************************************************** 00051670
C * 00051680
C IT ALSO CHECKS FOR CONSECUTIVE APPEARANCES OF CHAR, AND * 00051690
C SETS LOOP TO THE LAST OCCURRENCE OF THAT CHARACTER, IF CHAR* 00051700
C WAS FOUND. IF NOT, LOOP IS NOT CHANGED. * 00051710
C * 00051720
C***************************************************************** 00051730
100 IF (CDATA(LOOP+1) .NE. CHAR) GO TO 200 00051740
LOOP = LOOP + 1 00051750
CALL NDT13(LOOP, 701, 1) 00051760
GO TO 100 00051770
200 RETURN 00051780
END 00051800
C***************************************************************** 00051810
C * 00051820
C COPYRIGHT (C) 1978 - UNIVERSITY OF NOTRE DAME * 00051830
C PROGRAM AUTHOR - TIMOTHY J. MALLOY * 00051840
C * 00051850
C***************************************************************** 00051860
SUBROUTINE NDT36 00051870
C***************************************************************** 00051880
C * 00051890
C OUTPUT RUN NUMBER PROCESSOR * 00051900
C * 00051910
C THIS PROGRAM, PART OF THE OUTPUT SYNTAX PHASE, PROCESSES * 00051920
C THE RUN NUMBERS ATTACHED TO THE VARIABLES ON AN OUTPUT * 00051930
C CARD. IT IS CALLED BY NDT31, THE OUTPUT VARIABLE * 00051940
C PROCESSOR, AND USES NDT13 FOR ERROR HANDLING. * 00051950
C * 00051960
C***************************************************************** 00051970
REAL*8 RMIN,RMAX,LITBL(1024) 00051980
REAL*8 LOW(11),HIGH(11) 00051990
INTEGER PTRS(45),TITLE(120),CRSET(39),OPER(9),SYM(15), 00052000
1SUBSC(6),TYPCT(20),EQCHN(80),TOKEN(80),CARD1(80),CARD2(80), 00052010
2ERROR(80),OBJCD(160),DEF(80),XREF(80),TMAP(80),FCTN(5,22), 00052020
3SYMTB(5,512) 00052030
INTEGER CDATA(144),OUTPT(240),VARCT,TYPE,RUNNO,FLAG(11), 00052040
1CHAR(10),RUN(11),CFLAG 00052050
INTEGER DMODE,RMODE,SMODE,LOOP,CLNUM,BGF(4),NDF(4), 00052060
1DOTPS,XCHAR,POINT,DIGIT(9),BGF1,NDF1,STAR 00052070
COMMON RMIN,RMAX,PTRS,TITLE,CRSET,OPER,SYM,SUBSC,TYPCT, 00052080
1EQCHN,TOKEN,CARD1,CARD2,ERROR,OBJCD,DEF,XREF,TMAP,FCTN, 00052090
2SYMTB,LITBL 00052100
EQUIVALENCE (OUTPT(1),DEF(1),VARCT),(OUTPT(2),TYPE), 00052110
1(OUTPT(3),RUNNO),(OUTPT(103),LOW(1)),(OUTPT(125),HIGH(1)), 00052120
2(OUTPT(147),FLAG(1)),(OUTPT(179),RUN(1)),(OUTPT(200),CFLAG), 00052130
3(OUTPT(190),CHAR(1)),(CDATA(1),OBJCD(1)) 00052140
EQUIVALENCE (DMODE,OUTPT(201)),(RMODE,OUTPT(202)), 00052150
1(SMODE,OUTPT(203)),(LOOP,OUTPT(204)),(CLNUM,OUTPT(205)), 00052160
2(BGF(1),OUTPT(206),BGF1),(NDF(1),OUTPT(210),NDF1), 00052170
3(SRNUM,OUTPT(220)),(CLFST,OUTPT(221)) 00052180
EQUIVALENCE (DIGIT(1),CRSET(31)),(SFLAG,OUTPT(222)) 00052190
EQUIVALENCE (STAR,OPER(4)),(POINT,OPER(1)) 00052200
C***************************************************************** 00052210
C * 00052220
C DIGIT IS EQUIVALENCED INTO THE CRSET ARRAY SO THAT EACH * 00052230
C ARRAY MEMBER CONTAINS THE CHARACTER CORRESPONDING TO ITS * 00052240
C POSITION NUMBER. (EX. - DIGIT(1) = '1') * 00052250
C * 00052260
C * 00052270
C * 00052280
C FIRST, LOOK THROUGH THE VARIABLE FIELD FOR A DECIMAL POINT.* 00052290
C IF POINT IS FOUND, DOTPS CONTAINS ITS POSITION IN CDATA. * 00052300
C IF NOT FOUND, DOTPS IS SET TO THE POSITION PAST THE END * 00052310
C OF THE VARIABLE FIELD, AND THE RUN NUMBER IS DEFAULTED * 00052320
C TO ONE. * 00052330
C * 00052340
C***************************************************************** 00052350
DO 100 DOTPS = BGF1, NDF1 00052360
IF (CDATA(DOTPS) .EQ. POINT) GO TO 200 00052370
100 CONTINUE 00052380
DOTPS = NDF1 + 1 00052390
GO TO 700 00052400
C***************************************************************** 00052410
C * 00052420
C CHECK THE LENGTH OF THE RUN NUMBER FIELD. * 00052430
C * 00052440
C***************************************************************** 00052450
200 IF (NDF1 - DOTPS - 1) 300, 400, 600 00052460
C***************************************************************** 00052470
C * 00052480
C POINT PRESENT, BUT NO CHARACTER. * 00052490
C * 00052500
C***************************************************************** 00052510
300 CALL NDT13(DOTPS, 720, 1) 00052520
GO TO 700 00052530
C***************************************************************** 00052540
C * 00052550
C FIELD IS ONE CHARACTER LONG --- CHECK IF THE CHARACTER IS * 00052560
C BETWEEN ONE AND NINE. IF IT ISN'T, DEFAULT THE RUN NUMBER.* 00052570
C * 00052580
C***************************************************************** 00052590
400 IF (CDATA(DOTPS+1) .NE. STAR) GO TO 450 00052600
IF (CLNUM .EQ. 2) GO TO 425 00052610
CALL NDT13(DOTPS+1,725,2) 00052620
GO TO 700 00052630
425 SFLAG = 1 00052640
RUNNO = 0 00052650
GO TO 900 00052660
450 DO 500 XCHAR = 1, 9 00052670
IF (DIGIT(XCHAR) .EQ. CDATA(DOTPS+1)) GO TO 800 00052680
500 CONTINUE 00052690
C***************************************************************** 00052700
C * 00052710
C ERROR --- FIELD TOO LONG OR CHARACTER NOT BETWEEN 1 AND 9. * 00052720
C * 00052730
C***************************************************************** 00052740
600 CALL NDT13(DOTPS+1, 721, 1) 00052750
C***************************************************************** 00052760
C * 00052770
C * * * * * RUN NUMBER DEFAULT * * * * * * 00052780
C * 00052790
C * 00052800
C RUN NUMBER DEFAULT IS ONE. * 00052810
C * 00052820
C***************************************************************** 00052830
700 XCHAR = 1 00052840
C***************************************************************** 00052850
C * 00052860
C PLACE THE RUN NUMBER CHARACTER IN THE OUTPUT BUFFER. * 00052870
C CHECK THE HIGHEST RUN NUMBER. * 00052880
C * 00052890
C***************************************************************** 00052900
800 IF ((RUNNO.NE.0 .OR. CLNUM.NE.1) .AND. XCHAR.GT.RUNNO) 00052910
1 RUNNO = XCHAR 00052920
RUN(CLNUM) = XCHAR 00052930
C***************************************************************** 00052940
C * 00052950
C BEFORE RETURNING, SET THE END FIELD MARKER TO DISCLUDE * 00052960
C THE RUN NUMBER FIELD. * 00052970
C * 00052980
C***************************************************************** 00052990
900 NDF(1) = DOTPS - 1 00053000
RETURN 00053010
END 00053030
C COPYRIGHT 1978 - UNIVERSITY OF NOTRE DAME 00053040
C PROGRAM AUTHOR - GARY PELKEY 00053050
C 00053060
C 00053070
SUBROUTINE NDT37 (WORDS,LOC) 00053080
C 00053090
C 00053100
C THIS IS THE HASH ENTRY PROGRAM FOR A VARIABLE. WORDS ARE 00053110
C THE TWO PACKED WORDS THAT REPRESENT THE SYMBOL STRING. 00053120
C AN INITIAL SEARCH LOCATION IS COMPUTED AND THE SEARCH 00053130
C CONTINUES THRU THE SYMBOL TABLE UNTIL A MATCH IS FOUND OR 00053140
C AN EMPTY POSITION IS ENCOUNTERED. IF A MATCH IS FOUND, 00053150
C THE SYMBOL INFORMATION IS UNPACKED INTO SYM AND THE SYMBOL 00053160
C LOCATION IS RETURNED. IF AN EMPTY LOCATION IS ENCOUNTERED, 00053170
C THE TWO WORDS AND A VNUM ARE INSERTED, THUS CREATING A NEW 00053180
C SYMBOL. 00053190
C 00053200
C 00053210
REAL*8 RMIN,RMAX,LITBL(1024) 00053220
INTEGER PTRS(45),TITLE(120),CRSET(39),OPER(9),SYM(15), 00053230
1SUBSC(6),TYPCT(20),EQCHN(80),TOKEN(80),CARD1(80),CARD2(80), 00053240
2ERROR(80),OBJCD(160),DEF(80),XREF(80),TMAP(80),FCTN(5,22), 00053250
3SYMTB(5,512) 00053260
INTEGER LOC,ORLOC,WORDS(2),SYMND,VALCT 00053270
COMMON RMIN,RMAX,PTRS,TITLE,CRSET,OPER,SYM,SUBSC,TYPCT, 00053280
1EQCHN,TOKEN,CARD1,CARD2,ERROR,OBJCD,DEF,XREF,TMAP,FCTN, 00053290
2SYMTB,LITBL 00053300
EQUIVALENCE (SYMND,PTRS(17)),(VALCT,PTRS(20)) 00053310
LOC=(MOD(IABS(WORDS(1)),SYMND)+MOD(IABS(WORDS(2)),SYMND))/2+1 00053320
ORLOC=LOC 00053330
C 00053340
C 00053350
C HERE STARTS THE CYCLIC SEARCH THRU THE SYMBOL TABLE. 00053360
C ORLOC HAS BEEN SET TO THE ORIGINAL LOCATION FOR LATER 00053370
C COMPARISONS TO INSURE THAT THE SEARCH DOESN'T CONTINUE 00053380
C FOREVER. 00053390
C 00053400
C 00053410
100 IF(SYMTB(1,LOC).EQ.32767) GO TO 200 00053420
IF(SYMTB(1,LOC).EQ.WORDS(1).AND.SYMTB(2,LOC).EQ.WORDS(2)) 00053430
1GO TO 300 00053440
LOC=MOD(LOC,SYMND)+1 00053450
IF(ORLOC.NE.LOC) GO TO 100 00053460
C 00053470
C 00053480
C THE FAILING OF THE ABOVE TEST INTICATES THAT THE INCOMING 00053490
C SYMBOL IS NOT IN THE SYMBOL TABLE AND THAT THE TABLE ITSELF 00053500
C IS FULL. THUS THERE IS NO ROOM FOR THIS NEW SYMBOL AND 00053510
C THIS SYSTEM ERROR IS FLAGGED. 00053520
C 00053530
C 00053540
CALL NDT12 (3) 00053550
C 00053560
C 00053570
C AN EMPTY LOCATION HAS BEEN ENCOUNTERED INDICATING THAT THE 00053580
C INCOMING SYMBOL IS NEW. AN ENTRY IS MADE FOR IT BY DEPOSITING 00053590
C THE PACKED SYMBOL IN POSITIONS 1 AND 2 AND CALCULATING AND 00053600
C DEPOSITING A NEW VNUM IN POSITION 3. 00053610
C 00053620
C 00053630
200 VALCT=VALCT+1 00053640
SYMTB(3,LOC)=12287+VALCT 00053650
SYMTB(1,LOC)=WORDS(1) 00053660
SYMTB(2,LOC)=WORDS(2) 00053670
C 00053680
C 00053690
C THE SYMBOL IS UNPACKED BEFORE RETURNING FOR FUTURE USE 00053700
C BY CALLING ROUTINES. 00053710
C 00053720
C 00053730
300 CALL NDT41 (SYMTB(1,LOC)) 00053740
400 RETURN 00053750
END 00053770
C COPYRIGHT 1978 - UNIVERSITY OF NOTRE DAME 00053780
C PROGRAM AUTHOR - GARY PELKEY 00053790
C 00053800
C 00053810
SUBROUTINE NDT38 00053820
C 00053830
C 00053840
C THIS PROGRAM IS CALLED BY THE LEXICAL PROCESSOR (NDT08) TO 00053850
C FURTHER PROCESS VARIABLES ON THE LEFT OF AN EQUALS SIGN. 00053860
C IT IS RESPONSIBLE FOR MARKING THE DEFINED BIT FOR THE VARIABLE 00053870
C AND DETECTING ERRORS SUCH AS MISSING VARIABLE, MISSING OR 00053880
C MISPLACED EQUALS SIGN, OR VARIABLE HAVING BEEN PREVIOUSLY 00053890
C DEFINED. 00053900
C 00053910
C 00053920
REAL*8 RMIN,RMAX,LITBL(1024) 00053930
INTEGER PTRS(45),TITLE(120),CRSET(39),OPER(9),SYM(15), 00053940
1SUBSC(6),TYPCT(20),EQCHN(80),TOKEN(80),CARD1(80),CARD2(80), 00053950
2ERROR(80),OBJCD(160),DEF(80),XREF(80),TMAP(80),FCTN(5,22), 00053960
3SYMTB(5,512) 00053970
INTEGER TOKPT,PNTR,STYPE,INTBT,VNUM,VTYPE,DEFBT,RECNO 00053980
INTEGER PGMCT,EQPOS,DISK,PSSWT 00053990
COMMON RMIN,RMAX,PTRS,TITLE,CRSET,OPER,SYM,SUBSC,TYPCT, 00054000
1EQCHN,TOKEN,CARD1,CARD2,ERROR,OBJCD,DEF,XREF,TMAP,FCTN, 00054010
2SYMTB,LITBL 00054020
EQUIVALENCE (TOKPT,TOKEN(3)),(STYPE,TOKEN(1)),(INTBT,SYM(13)) 00054030
EQUIVALENCE (VNUM,SYM(14)),(VTYPE,SYM(7)),(DEFBT,SYM(11)) 00054040
EQUIVALENCE (RECNO,SYM(15)),(PGMCT,PTRS(22)),(DISK,PTRS(3)) 00054050
EQUIVALENCE (EQPOS,TMAP(3)),(USDBT,SYM(10)),(PSSWT,PTRS(10)) 00054060
C 00054070
C 00054080
C IN THE FOLLOWING SECTION THE EQUALS SIGN IS SEARCHED FOR. 00054090
C IF NOT FOUND AN ERROR IS ISSUED. IF IT WAS THE FIRST TOKEN 00054100
C THE MISSING VARIABLE IS FLAGGED. IF THERE ARE MORE THAN 1 00054110
C TOKENS TO THE LEFT OF THE EQUALS SIGN THIS ERROR IS ALSO 00054120
C FLAGGED. 00054130
C 00054140
C 00054150
IF(EQPOS.NE.0) GO TO 1200 00054160
CALL NDT14 (0,801,3) 00054170
GO TO 2000 00054180
1200 IF(EQPOS.NE.4) GO TO 1300 00054190
CALL NDT14 (TMAP(4),519,3) 00054200
GO TO 2000 00054210
1300 IF(TOKEN(4) .EQ. 24576) GO TO 2000 00054220
IF(EQPOS.EQ.5.AND.TOKEN(4).GE.0.AND.TOKEN(4).LT.20480) GO TO 1325 00054230
CALL NDT14 (TMAP(4),805,3) 00054240
GO TO 2000 00054250
C 00054260
C 00054270
C HAVING PASSED THE ABOVE SYNTAX TESTS, THE LEFT VARIABLE IS 00054280
C READY TO BE MARKED AS DEFINED (OR INITIALIZED). ERRORS 00054290
C SUCH AS MULTIPLY DEFINING OR INITIALIZING AS WELL AS DEFINING 00054300
C OR INITIALIZING TIME ARE FLAGGED HERE. 00054310
C 00054320
C 00054330
1325 PNTR=MOD(TOKEN(4),4096)+1 00054340
CALL NDT41 (SYMTB(1,PNTR)) 00054350
IF(VTYPE.NE.3.OR.STYPE.EQ.3) GO TO 1350 00054360
CALL NDT14(TMAP(4),551,3) 00054370
GO TO 2000 00054380
1350 IF(PSSWT.NE.5) GO TO 1395 00054390
C 00054400
C 00054410
C IF RERUN MODE IS IN EFFECT, THE VARIABLE MUST BE CHECKED 00054420
C FOR PREVIOUS DEFINITION. ALSO THE STATEMENT TYPES FROM RUN 00054430
C TO RUN MUST BE CONSISTANT. IF NORMAL MODE IS IN EFFECT, 00054440
C DIFFERENT CHECKS MUST BE PERFORMED. 00054450
C 00054460
C 00054470
IF(DEFBT.EQ.1) GO TO 1370 00054480
CALL NDT14 (TMAP(4),536,2) 00054490
GO TO 2000 00054500
1370 IF(USDBT.EQ.0.AND.VNUM.NE.11) CALL NDT14 (TMAP(4),537,2) 00054510
IF(STYPE.NE.VTYPE) CALL NDT14(TMAP(4),548,2) 00054520
GO TO 2000 00054530
C 00054540
C 00054550
C IF THE VARIABLE ON THIS INITIAL VALUE CARD HAS ALREADY BEEN 00054560
C INITIALIZED, THIS OCCURRENCE IS FLAGGED. A SEPARATE ERROR 00054570
C IS ISSUED IF THE VARIABLE BEING INITIALIZED IS TIME. 00054580
C 00054590
C 00054600
1395 IF(STYPE.NE.4) GO TO 1600 00054610
IF(INTBT.EQ.0) GO TO 1500 00054620
IF(VNUM.EQ.12) GO TO 1400 00054630
CALL NDT14 (TMAP(4),559,3) 00054640
GO TO 2000 00054650
1400 CALL NDT14 (TMAP(4),550,3) 00054660
GO TO 2000 00054670
1500 INTBT=1 00054680
GO TO 1900 00054690
C 00054700
C 00054710
C IF THIS VARIABLE HAS ALREADY BEEN DEFINED IN ANOTHER EQUATION 00054720
C THIS OCCURRENCE IS FLAGGED. A SEPARATE ERROR IS ISSUED IF 00054730
C THE VARIABLE BEING DEFINED IS TIME. 00054740
C 00054750
C 00054760
1600 IF(DEFBT.EQ.0) GO TO 1800 00054770
IF(VNUM.EQ.12) GO TO 1700 00054780
CALL NDT14 (TMAP(4),539+VTYPE,3) 00054790
GO TO 2000 00054800
1700 CALL NDT14 (TMAP(4),560,3) 00054810
GO TO 2000 00054820
C 00054830
C 00054840
C IF A NON-INITIAL VALUE CARD IS BEING PROCESSED AND THE 00054850
C VARIABLE HASN'T PREVIOUSLY BEEN DEFINED, IT IS HERE DEFINED 00054860
C BY MARKING DEFBT AND SETTING VTYPE. A NON-ZERO RECNO MEANS 00054870
C THAT THE VARIABLE HAS A DOCUMENTOR DEFINITION ON DISK THAT 00054880
C MUST BE MOVED TO THIS CARD'S DEF ARRAY. 00054890
C 00054900
C 00054910
1800 DEFBT=1 00054920
VTYPE=STYPE 00054930
1900 DEF(10) = 0 00054940
IF(RECNO.EQ.0) GO TO 1910 00054950
READ(DISK'RECNO+6) DEF 00054960
IF(STYPE.NE.4.OR.VTYPE.NE.5) GO TO 1999 00054970
1910 RECNO = PGMCT + 1 00054980
1999 CALL NDT40 (SYMTB(1,PNTR)) 00054990
2000 RETURN 00055000
END 00055020
C***************************************************************** 00055030
C * 00055040
C COPYRIGHT (C) 1978 - UNIVERSITY OF NOTRE DAME * 00055050
C PROGRAM AUTHOR - THOMAS L EVERMAN JR * 00055060
C * 00055070
C***************************************************************** 00055080
SUBROUTINE NDT39 (REC,DUPFG) 00055090
C***************************************************************** 00055100
C * 00055110
C THIS PROGRAM BUILDS A MACRO DEFINITION BUFFER FOR * 00055120
C A MACRO OR AN EXPAND STATEMENT. IT ALSO LOCATES A PREVIOUS* 00055130
C DEFINITION RECORD IF IT EXISTS. THE ARGUMENTS ARE: * 00055140
C REC - RETURNS THE RECORD NUMBER OF THE DEFINITION. * 00055150
C DUPFG - INDICATES WHETHER OR NOT THE SUBROUTINE SHOULD * 00055160
C CHECK FOR DUPLICATE NAMES IN THE ARGUMENT LIST. * 00055170
C A '0' SPECIFIES NO CHECK, '1' MEANS CHECK. * 00055180
C * 00055190
C***************************************************************** 00055200
REAL*8 RMIN,RMAX,LITBL(1024) 00055210
INTEGER PTRS(45),TITLE(120),CRSET(39),OPER(9),SYM(15), 00055220
1SUBSC(6),TYPCT(20),EQCHN(80),TOKEN(80),CARD1(80),CARD2(80), 00055230
2ERROR(80),OBJCD(160),DEF(80),XREF(80),TMAP(80),FCTN(5,22), 00055240
3SYMTB(5,512) 00055250
INTEGER CDATA(144),SYNCK,MACRO(160),MAC1(80),MAC2(80),I,J 00055260
INTEGER BLANK,PNTR,PNEST,PKREP(5),MDT(3,53),MDTL,MDT1(80) 00055270
INTEGER MDT2(80),TEST,PGMCT,EQNCD 00055280
INTEGER DISK,START,ARGS,TYPE,POS,REC,DUPFG,OLDSY,SORCE 00055290
INTEGER DEST,FLAG,NOARG 00055300
COMMON RMIN,RMAX,PTRS,TITLE,CRSET,OPER,SYM,SUBSC,TYPCT, 00055310
1EQCHN,TOKEN,CARD1,CARD2,ERROR,OBJCD,DEF,XREF,TMAP,FCTN, 00055320
2SYMTB,LITBL 00055330
EQUIVALENCE (CDATA(1),OBJCD(1)),(MACRO(1),DEF(1)),(MAC1(1),MACRO(100055340
1)),(MAC2(1),MACRO(81)),(BLANK,CRSET(1)),(MDT(1,1),MACRO(2)), 00055350
2(MDTL,MACRO(1)),(MDT1(1),MAC1(1)),(MDT2(1),MAC2(1)), 00055360
3(PGMCT,PTRS(22)),(EQNCD,ERROR(1)) 00055370
EQUIVALENCE (DISK,PTRS(3)) 00055380
C***************************************************************** 00055390
C * 00055400
C INITIALIZE THE VARIABLES AND MACRO BUFFER. * 00055410
C SYNCK TELLS WHETHER A SYNTAX CHECK SHOULD BE PERFORMED * 00055420
C AFTER AN OPERATOR IS ENCOUNTERED. START IS THE INPUT * 00055430
C POSITION TO NDT29. ARGS IS THE NUMBER OF ARGUMENTS * 00055440
C FOUND IN THE MACRO OR EXPAND STATEMENT. THE MACRO * 00055450
C ARRAY IS USED TO BUILD THE BUFFER OF MACRO INFORMATION. * 00055460
C * 00055470
C***************************************************************** 00055480
SYNCK = 0 00055490
START = 1 00055500
ARGS = 0 00055510
C***************************************************************** 00055520
C * 00055530
C THE FOLLOWING LOOP LOCATES THE MACRO NAME AND SYNTAXES * 00055540
C THE STATEMENT UP TO THE FIRST '('. IN PARTICULAR, * 00055550
C THEIR SHOULD BE NO SUBSCRIPTS OR OPERATORS. * 00055560
C * 00055570
C***************************************************************** 00055580
200 CALL NDT29 (TYPE, START, POS, 4) 00055590
IF (POS .LT. START .AND. SYNCK .EQ. 0) GO TO 900 00055600
IF (TYPE .EQ. 0) GO TO 800 00055610
IF (TYPE .NE. 1 .AND. TYPE .NE. 7) GO TO 1000 00055620
IF (SYNCK .NE. 0) GO TO 250 00055630
C***************************************************************** 00055640
C * 00055650
C SYNTAX CHECK THE MACRO NAME, THEN OBTAIN PACKED * 00055660
C REPRESENTATION OF NAME IN PKREP. READ IN THE MDT * 00055670
C AND SEARCH FOR AN ENTRY WITH THE SAME REPRESENTATION. * 00055680
C * 00055690
C***************************************************************** 00055700
CALL NDT24 (START, POS, RTC) 00055710
CALL NDT40 (PKREP) 00055720
READ (DISK'98) MDT1 00055730
READ (DISK'99) MDT2 00055740
TEST = DUPFG + 1 00055750
DO 220 I = 1, MDTL 00055760
IF (MDT(1,I) .EQ. PKREP(1) .AND. MDT(2,I) .EQ. PKREP(2)) 00055770
1GO TO 230 00055780
220 CONTINUE 00055790
C***************************************************************** 00055800
C * 00055810
C NO PREVIOUS DEFINITION WAS FOUND. IF CALLED BY EXPND * 00055820
C (TEST=1), SET REC TO 0 AND CONTINUE. IF CALLED BY * 00055830
C MACRO, MAKE A NEW ENTRY INTO THE MDT, SET REC TO THE * 00055840
C RECORD NUMBER WHERE THE DEFINITION WILL BE STORED, * 00055850
C AND REWRITE THE MDT TO THE DISK FILE. * 00055860
C * 00055870
C***************************************************************** 00055880
GO TO (225,226), TEST 00055890
225 REC = 0 00055900
GO TO 250 00055910
226 MDTL = MDTL + 1 00055920
MDT(1,MDTL) = PKREP(1) 00055930
MDT(2,MDTL) = PKREP(2) 00055940
REC = PGMCT + 7 00055950
MDT(3,MDTL) = REC 00055960
GO TO 240 00055970
C***************************************************************** 00055980
C * 00055990
C A PREVIOUS DEFINTION WAS FOUND. IF IN EXPND MODE, SET * 00056000
C REC TO THE RECORD NUMBER OF THE DEFINTION AND CONTINUE * 00056010
C PROCESSING. IF IN MACRO MODE, MUST EITHER REPLACE A * 00056020
C BUILT-IN MACRO DEFINITION OR GIVE A 305 ERROR FOR A * 00056030
C DUPLICATE MACRO DEFINITION. IF A BUILT-IN MACRO IS * 00056040
C REPLACED, THE MDT MUST BE UPDATED AND REWRITTEN. * 00056050
C * 00056060
C***************************************************************** 00056070
230 GO TO (235,236), TEST 00056080
235 REC = MDT(3,I) 00056090
GO TO 250 00056100
236 IF (I .LE. 5 .AND. MDT(3,I) .LT. 100) GO TO 237 00056110
CALL NDT13 (START, 305, 2) 00056120
REC = 0 00056130
GO TO 250 00056140
237 REC = PGMCT + 7 00056150
MDT(3,I) = REC 00056160
240 WRITE (DISK'98) MDT1 00056170
WRITE (DISK'99) MDT2 00056180
C***************************************************************** 00056190
C * 00056200
C CHECK UNTIL '(' IS FOUND TO DELIMIT ARGUMENT LIST. * 00056210
C GIVE ERROR FOR SUBSCRIPT IF FOUND. SYNTAX CHECK ONLY * 00056220
C THE FIRST VARIABLE UNTIL '(' IS FOUND. * 00056230
C * 00056240
C***************************************************************** 00056250
250 START = POS + 2 00056260
SYNCK = 1 00056270
IF (TYPE .EQ. 7) GO TO 300 00056280
CALL NDT13 (POS + 1, 530, 1) 00056290
GO TO 200 00056300
C***************************************************************** 00056310
C * 00056320
C MOVE MACRO NAME TO MACRO BUFFER, THEN BEGINNING CHECKING * 00056330
C ARGUMENTS. THE ARGUMENT LIST MUST CONTAIN NO OPERATIONS. * 00056340
C PNEST COUNTS PAREN NESTING AND INDICATES THE END OF THE * 00056350
C ARGUMENT LIST. PNTR POINTS TO THE POSITION IN THE MACRO * 00056360
C BUFFER WHERE THE NEXT ARGUMENT NAME IS TO BE ENTERED. * 00056370
C * 00056380
C***************************************************************** 00056390
300 DO 100 I = 1, 160 00056400
100 MACRO(I) = BLANK 00056410
DO 400 I = 1, POS 00056420
400 MACRO(I) = CDATA(I) 00056430
PNEST = 1 00056440
NOARG = 1 00056450
PNTR = 5 00056460
SYNCK = 0 00056470
500 CALL NDT29 (TYPE, START, POS, 4) 00056480
C***************************************************************** 00056490
C * 00056500
C CHECK FOR OPERATORS OR BLANK TO END LIST WITH PAREN * 00056510
C IMBALANCE. NOARG IS A FLAG TO MAKE SURE THAT BACK TO * 00056520
C BACK PARENS DO NOT OCCUR WITHOUT AN ARGUMENT LIST. * 00056530
C * 00056540
C***************************************************************** 00056550
IF (TYPE .NE. 1 .AND. TYPE .NE. 9 .AND. TYPE .NE. 0) 00056560
1GO TO 1100 00056570
IF (SYNCK .NE. 0) GO TO 600 00056580
C***************************************************************** 00056590
C * 00056600
C PREPARE TO MAKE NEW ARGUMENT ENTRY TO MACRO BUFFER * 00056610
C INCREMENT THE ARGUMENT NUMBER AND MAKE SURE IT IS WITHIN * 00056620
C LIMITS. MAKE THE SYNTAX CHECK AND THEN THE ENTRY. IF * 00056630
C REQUIRED, CHECK FOR DUPLICATE ARGUMENT ENTRIES. * 00056640
C * 00056650
C***************************************************************** 00056660
549 ARGS = ARGS + 1 00056670
IF (ARGS .EQ. 19) GO TO 1200 00056680
PNTR = PNTR + 8 00056690
CALL NDT24 (START, POS, RTC) 00056700
DO 550 I = 1, 6 00056710
DEST = PNTR + I 00056720
SORCE = START + I - 1 00056730
IF (SORCE .GT. POS) GO TO 560 00056740
NOARG = 0 00056750
550 MACRO(DEST) = CDATA(SORCE) 00056760
560 IF (ARGS .EQ. 1) GO TO 600 00056770
IF (DUPFG .EQ. 0) GO TO 600 00056780
DO 570 I = 14, PNTR, 8 00056790
FLAG = 0 00056800
DO 580 J = 1, 6 00056810
SORCE = PNTR + J 00056820
DEST = I + J - 1 00056830
IF (MACRO(DEST) .NE. MACRO(SORCE)) FLAG = 1 00056840
580 CONTINUE 00056850
IF (FLAG .EQ. 0) CALL NDT13 (START, 308, 2) 00056860
570 CONTINUE 00056870
C***************************************************************** 00056880
C * 00056890
C BRANCH OUT OF ARGUMENT LOOP IF BLANK WAS FOUND. * 00056900
C CHECK FOR ARGUMENT SUBSCRIPT AND UPDATE SYNCK. * 00056910
C * 00056920
C***************************************************************** 00056930
600 IF(TYPE .EQ. 0) GO TO 700 00056940
IF (PNEST .EQ. 0) GO TO 1300 00056950
START = POS + 2 00056960
IF (TYPE .EQ. 1) CALL NDT13 (POS + 1, 530, 1) 00056970
IF (TYPE .EQ. 1) SYNCK = 1 00056980
IF (TYPE .EQ. 9) SYNCK = 0 00056990
GO TO 500 00057000
C***************************************************************** 00057010
C * 00057020
C ERROR INDICATORS * 00057030
C 303 - NO FINAL PAREN * 00057040
C 304 - NO ARGUMENT LIST * 00057050
C 313 - MISSING MACRO NAME * 00057060
C 314 - OPERATION IN MACRO NAME FIELD * 00057070
C * 00057080
C***************************************************************** 00057090
700 CALL NDT13 (POS + 1, 303, 2) 00057100
GO TO 1350 00057110
800 CALL NDT13 (POS + 1, 304, 3) 00057120
GO TO 1350 00057130
900 CALL NDT13 (START, 313, 3) 00057140
GO TO 1350 00057150
1000 CALL NDT13 (POS + 1, 314, 3) 00057160
GO TO 1350 00057170
C***************************************************************** 00057180
C * 00057190
C AN ARITHMETIC OPERATOR WAS ENCOUNTERED IN THE ARGUMENT LIST* 00057200
C IF PAREN, UPDATE PNEST, AND IF PNEST = 0, END OF ARGUMENT * 00057210
C LIST HAS OCCURRED. OTHERWISE GIVE AN ERROR, UPDATE SYNCK * 00057220
C INFORMATION, AND CONTINUE PROCESSING. ALSO CHECK NOARG * 00057230
C FOR MISSING ARGUMENT LIST * 00057240
C * 00057250
C***************************************************************** 00057260
1100 IF (TYPE .EQ. 7) PNEST = PNEST + 1 00057270
IF (TYPE .EQ. 8) PNEST = PNEST - 1 00057280
IF (PNEST .NE. 0) CALL NDT13 (POS + 1, 307, 3) 00057290
OLDSY = SYNCK 00057300
SYNCK = 1 00057310
IF (OLDSY .EQ. 0) GO TO 549 00057320
IF (PNEST .EQ. 0) GO TO 1300 00057330
GO TO 600 00057340
C***************************************************************** 00057350
C * 00057360
C 302 - MORE THAN 18 ARGUMENTS * 00057370
C * 00057380
C***************************************************************** 00057390
1200 CALL NDT13 (START, 302, 3) 00057400
ARGS = 18 00057410
GO TO 1350 00057420
1300 IF (NOARG .EQ. 1) GO TO 800 00057430
POS = POS + 2 00057440
IF (CDATA(POS) .NE. BLANK) CALL NDT13(POS, 309, 2) 00057450
C***************************************************************** 00057460
C * 00057470
C SET FINAL INFORMATION IN MACRO BUFFER * 00057480
C 9 - RESERVED * 00057490
C 10 - NUMBER OF ARGUMENTS * 00057500
C 11 - RECORD NUMBER OF STARTING STATEMENT * 00057510
C 12 - CRITICAL ERROR IN STATEMENT * 00057520
C 13 - NUMBER OF INTERNAL VRAIABLES IN BUILT-IN MACRO * 00057530
C * 00057540
C***************************************************************** 00057550
1350 MACRO(13) = 0 00057560
MACRO(12) = 0 00057570
IF (EQNCD .EQ. 3) MACRO(12) = 1 00057580
IF (EQNCD .EQ. 3) CALL NDT13(1, 316, 3) 00057581
MACRO(11) = PGMCT + 11 00057590
MACRO(10) = ARGS 00057600
MACRO(9) = 0 00057610
RETURN 00057620
END 00057640
C COPYRIGHT 1978 - UNIVERSITY OF NOTRE DAME 00057650
C PROGRAM AUTHOR - GARY PELKEY 00057660
C 00057670
C 00057680
SUBROUTINE NDT40 (OUT) 00057690
C 00057700
C 00057710
C THIS ROUTINE PACKS SYMBOL INFORMATION FROM THE SUBSC ARRAY 00057720
C AND THE SYM ARRAY INTO THE 5 WORD ARGUMENT ARRAY. 00057730
C 00057740
C 00057750
REAL*8 RMIN,RMAX,LITBL(1024) 00057760
INTEGER PTRS(45),TITLE(120),CRSET(39),OPER(9),SYM(15), 00057770
1SUBSC(6),TYPCT(20),EQCHN(80),TOKEN(80),CARD1(80),CARD2(80), 00057780
2ERROR(80),OBJCD(160),DEF(80),XREF(80),TMAP(80),FCTN(5,22), 00057790
3SYMTB(5,512) 00057800
INTEGER OUT(5) 00057810
COMMON RMIN,RMAX,PTRS,TITLE,CRSET,OPER,SYM,SUBSC,TYPCT, 00057820
1EQCHN,TOKEN,CARD1,CARD2,ERROR,OBJCD,DEF,XREF,TMAP,FCTN, 00057830
2SYMTB,LITBL 00057840
OUT(1)=1521*(SUBSC(1)-20)+39*(SUBSC(2)-1)+SUBSC(3)-1 00057850
OUT(2)=1521*(SUBSC(4)-20)+39*(SUBSC(5)-1)+SUBSC(6)-1 00057860
OUT(3)=4096*(SYM(7)-1)+SYM(14)-1 00057870
OUT(4)=32*SYM(8)+16*SYM(9)+8*SYM(10)+4*SYM(11)+2*SYM(12)+SYM(13) 00057880
OUT(5)=SYM(15) 00057890
RETURN 00057900
END 00057920
C COPYRIGHT 1978 - UNIVERSITY OF NOTRE DAME 00057930
C PROGRAM AUTHOR - GARY PELKEY 00057940
C 00057950
C 00057960
SUBROUTINE NDT41 (IN) 00057970
C 00057980
C 00057990
C THIS PROGRAM UNPACKS THE 5 WORD INPUT ARRAY INTO SUBSC(1-6) 00058000
C AND SYM(7-15). IT THEN PUTS THE CORRECT CHARACTERS IN SYM(1-6) 00058010
C BASED ON WHAT IS IN SUBSC. 00058020
C 00058030
C 00058040
REAL*8 RMIN,RMAX,LITBL(1024) 00058050
INTEGER PTRS(45),TITLE(120),CRSET(39),OPER(9),SYM(15), 00058060
1SUBSC(6),TYPCT(20),EQCHN(80),TOKEN(80),CARD1(80),CARD2(80), 00058070
2ERROR(80),OBJCD(160),DEF(80),XREF(80),TMAP(80),FCTN(5,22), 00058080
3SYMTB(5,512) 00058090
INTEGER IN(5),FLAG,PT,N,TEMP,BIGPT,SUB 00058100
COMMON RMIN,RMAX,PTRS,TITLE,CRSET,OPER,SYM,SUBSC,TYPCT, 00058110
1EQCHN,TOKEN,CARD1,CARD2,ERROR,OBJCD,DEF,XREF,TMAP,FCTN, 00058120
2SYMTB,LITBL 00058130
DO 100 PT=1,2 00058140
N=3*PT-2 00058150
TEMP=IN(PT) 00058160
FLAG=1 00058170
IF(IN(PT).GT.0) GO TO 50 00058180
FLAG=0 00058190
TEMP=IN(PT)+28899 00058200
50 BIGPT=TEMP/1521 00058210
SUBSC(N)=BIGPT+19*FLAG+1 00058220
SUBSC(N+2)=MOD(TEMP,39)+1 00058230
100 SUBSC(N+1)=(MOD(TEMP,1521)-SUBSC(N+2)+1)/39+1 00058240
SYM(7)=IN(3)/4096+1 00058250
SYM(14)=MOD(IN(3),4096)+1 00058260
SYM(15)=IN(5) 00058270
DO 200 I=1,6 00058280
200 SYM(I+7)=MOD(IN(4),2**(7-I))/(2**(6-I)) 00058290
400 DO 350 PT=1,6 00058300
SUB=SUBSC(PT) 00058310
350 SYM(PT)=CRSET(SUB) 00058320
RETURN 00058330
END 00058350
C COPYRIGHT 1978 - UNIVERSITY OF NOTRE DAME 00058360
C PROGRAM AUTHOR - THOMAS L. EVERMAN JR. 00058370
C 00058380
C 00058390
SUBROUTINE NDT42 (PNT1,PNT2,ARGNM) 00058400
REAL*8 RMIN,RMAX,LITBL(1024) 00058410
INTEGER PTRS(45),TITLE(120),CRSET(39),OPER(9),SYM(15), 00058420
1SUBSC(6),TYPCT(20),EQCHN(80),TOKEN(80),CARD1(80),CARD2(80), 00058430
2ERROR(80),OBJCD(160),DEF(80),XREF(80),TMAP(80),FCTN(5,22), 00058440
3SYMTB(5,512) 00058450
INTEGER START,PNT1,PNT2,ARGNM,ARGS,LTPAR,RTPAR,COMMA,PNEST 00058460
1,CDATA(144) 00058470
COMMON RMIN,RMAX,PTRS,TITLE,CRSET,OPER,SYM,SUBSC,TYPCT, 00058480
1EQCHN,TOKEN,CARD1,CARD2,ERROR,OBJCD,DEF,XREF,TMAP,FCTN, 00058490
2SYMTB,LITBL 00058500
EQUIVALENCE (COMMA,OPER(9)),(LTPAR,OPER(7)),(RTPAR,OPER(8)) 00058510
EQUIVALENCE (CDATA(1),OBJCD(1)) 00058520
PNEST=0 00058530
ARGS=1 00058540
START=PNT2+1 00058550
DO 100 I=START,140 00058560
IF(CDATA(I).EQ.LTPAR) PNEST=PNEST+10 00058570
IF(CDATA(I).EQ.RTPAR) PNEST=PNEST-10 00058580
IF(PNEST.EQ.0) GO TO 200 00058590
IF(PNEST.GT.10) GO TO 100 00058600
IF(CDATA(I).EQ.COMMA) ARGS=ARGS+1 00058610
100 CONTINUE 00058620
200 IF(ARGS.NE.ARGNM) CALL NDT13(PNT1,506,3) 00058630
RETURN 00058640
END 00058660
C***************************************************************** 00058670
C * 00058680
C COPYRIGHT (C) 1978 - UNIVERSITY OF NOTRE DAME * 00058690
C PROGRAM AUTHOR - THOMAS L EVERMAN JR * 00058700
C * 00058710
C THIS SUBROUTINE RIGHT JUSTIFIES REAL NUMBERS. * 00058720
C * 00058730
C***************************************************************** 00058740
SUBROUTINE NDT43 (DVAL, FIELD, SCALE, PLACE) 00058750
REAL*8 RMIN,RMAX,LITBL(1024) 00058760
REAL*8 VAL,DVAL,POWER 00058770
INTEGER PTRS(45),TITLE(120),CRSET(39),OPER(9),SYM(15), 00058780
1SUBSC(6),TYPCT(20),EQCHN(80),TOKEN(80),CARD1(80),CARD2(80), 00058790
2ERROR(80),OBJCD(160),DEF(80),XREF(80),TMAP(80),FCTN(5,22), 00058800
3SYMTB(5,512) 00058810
INTEGER FIELD(7),NUM(10),BLANK,SCALE,DEC,LEAD,POINT,SIGN 00058820
INTEGER DIGIT,MINUS,PLACE,STDEC,POS 00058830
COMMON RMIN,RMAX,PTRS,TITLE,CRSET,OPER,SYM,SUBSC,TYPCT, 00058840
1EQCHN,TOKEN,CARD1,CARD2,ERROR,OBJCD,DEF,XREF,TMAP,FCTN, 00058850
2SYMTB,LITBL 00058860
EQUIVALENCE (BLANK,CRSET(1)),(POINT,OPER(1)),(MINUS,OPER(3)) 00058870
EQUIVALENCE (NUM(1),CRSET(30)) 00058880
EQUIVALENCE (DEC,LEAD) 00058890
C***************************************************************** 00058900
C * 00058910
C DVAL IS THE INPUT REAL NUMBER. FIELD IS THE OUTPUT RIGHT * 00058920
C JUSTIFIED NUMBER. SCALE IS THE POWER OF 10 TO WHICH THE * 00058930
C NUMBER IS TO BE SCALED. PLACE INDICATES THE NUMBER * 00058940
C OF DECIMAL PLACES. * 00058950
C SET VAL TO THE VALUE OF THE SCALED NUMBER. ASSUME A PLUS * 00058960
C SIGN AND THEN CHECK FOR MEGATIVE VAL. TAKE ABSOLUTE * 00058970
C VALUE OF VAL AND ROUND IT TO THE APPROPRIATE NUMBER OF * 00058980
C DECIMAL PLACES. * 00058990
C * 00059000
C***************************************************************** 00059010
VAL = DVAL / 10. ** SCALE 00059020
FIELD(1) = BLANK 00059030
SIGN = 1 00059040
IF (DVAL .LT. 0.) SIGN = -1 00059050
VAL = DABS (VAL + .5 * SIGN * 10. ** (-PLACE)) 00059060
C***************************************************************** 00059070
C * 00059080
C SET DEC EQUAL TO DECIMAL POINT POSITION. IF IT OCCUPIES TH* 00059090
C LAST FIELD POSITION, SET DEC TO 8 SO THAT NO DECIMAL POINT * 00059100
C APPEARS IN THE FIELD. STDEC IS A HOLD AREA FOR DEC. * 00059110
C * 00059120
C***************************************************************** 00059130
DEC = 7 - PLACE 00059140
IF (DEC .EQ. 7) DEC = 8 00059150
STDEC = DEC 00059160
C***************************************************************** 00059170
C * 00059180
C EXTRACT THE NUMERIC CHARACTERS FROM VAL. VALUE FOR DEC * 00059190
C MUST BE INCREMENTED AT THE DECIMAL POINT POSITION TO AVOID * 00059200
C INVALID COMPUTATION OF NUMERIC CHARACTER. * 00059210
C * 00059220
C***************************************************************** 00059230
DO 300 POS = 2, 7 00059240
IF (POS .EQ. STDEC) GO TO 200 00059250
POWER = 10. ** (DEC - POS - 1) 00059260
DIGIT = VAL / POWER 00059270
FIELD(POS) = NUM(DIGIT + 1) 00059280
VAL = VAL - FLOAT (DIGIT) * POWER 00059290
GO TO 300 00059300
200 DEC = DEC + 1 00059310
FIELD(POS) = POINT 00059320
300 CONTINUE 00059330
C***************************************************************** 00059340
C * 00059350
C REPLACE LEADING ZEROS WITH BLANKS AND ENTER THE SIGN. * 00059360
C * 00059370
C***************************************************************** 00059380
IF (DEC .EQ. 8) DEC = 9 00059390
LEAD = DEC - 3 00059400
POS = 2 00059410
IF (LEAD .LE. 1) GO TO 500 00059420
DO 400 POS = 2, LEAD 00059430
IF (FIELD(POS) .NE. NUM(1)) GO TO 500 00059440
FIELD(POS) = BLANK 00059450
400 CONTINUE 00059460
POS = POS + 1 00059470
500 IF (SIGN .EQ. -1) FIELD(POS - 1) = MINUS 00059480
RETURN 00059490
END 00059510
SUBROUTINE NDT44 (VAL,FIELD) 00059520
INTEGER CHAR,EXP,PLACE,PNT,OUTER,BLANK,PLUS,POINT,E,SUB 00059530
INTEGER COUNT,ZERO,FIELD(11),NUM(10),LOOP,MINUS 00059540
REAL*8 VAL 00059550
EQUIVALENCE (ZERO,NUM(1)) 00059560
DATA NUM /'0','1','2','3','4','5','6','7','8','9'/ 00059570
DATA BLANK,E,PLUS,MINUS,POINT /' ','E','+','-','.'/ 00059580
DO 90 LOOP=8,11 00059590
90 FIELD(LOOP)=BLANK 00059600
CALL NDT77 (DABS(VAL),CHAR) 00059610
IF(CHAR.LT.-1.OR.CHAR.GT.4) GO TO 100 00059620
EXP=0 00059630
PLACE=4-CHAR 00059640
GO TO 200 00059650
100 EXP=CHAR 00059660
PLACE=4 00059670
200 CALL NDT43 (VAL,FIELD,EXP,PLACE) 00059680
DO 300 OUTER=1,6 00059690
IF(FIELD(1).NE.BLANK) GO TO 500 00059700
DO 400 LOOP=1,6 00059710
400 FIELD(LOOP)=FIELD(LOOP+1) 00059720
300 FIELD(7)=BLANK 00059730
500 IF(CHAR.EQ.4) GO TO 800 00059740
DO 600 LOOP=1,7 00059750
PNT=8-LOOP 00059760
IF(FIELD(PNT).EQ.BLANK) GO TO 600 00059770
IF(FIELD(PNT).EQ.ZERO) GO TO 700 00059780
IF(FIELD(PNT).NE.POINT) GO TO 800 00059790
FIELD(PNT)=BLANK 00059800
PNT=PNT-1 00059810
GO TO 800 00059820
700 FIELD(PNT)=BLANK 00059830
600 CONTINUE 00059840
800 IF(EXP) 825,5000,850 00059850
825 COUNT=-EXP-1 00059860
IF(COUNT.GT.5.OR.COUNT.GT.7-PNT) GO TO 850 00059870
PNT=2 00059880
IF(FIELD(2).NE.POINT.AND.FIELD(2).NE.BLANK) PNT=3 00059890
FIELD(PNT)=FIELD(PNT-1) 00059900
FIELD(PNT-1)=POINT 00059910
DO 1000 OUTER=1,COUNT 00059920
DO 1100 LOOP=PNT,6 00059930
SUB=7-LOOP+PNT 00059940
1100 FIELD(SUB)=FIELD(SUB-1) 00059950
1000 FIELD(PNT)=ZERO 00059960
GO TO 5000 00059970
850 FIELD(PNT+1)=E 00059980
FIELD(PNT+2)=PLUS 00059990
IF(EXP.GT.0) GO TO 900 00060000
EXP=-EXP 00060010
FIELD(PNT+2)=MINUS 00060020
900 PNT=PNT+3 00060030
SUB=EXP/10+1 00060040
FIELD(PNT)=NUM(SUB) 00060050
IF(SUB.NE.1) PNT=PNT+1 00060060
SUB=EXP-10*SUB+11 00060070
FIELD(PNT)=NUM(SUB) 00060080
5000 RETURN 00060090
END 00060110
C COPYRIGHT (C) 1978 - UNIVERSITY OF NOTRE DAME 00060120
C PROGRAM AUTHOR - DANIEL A. POYDENCE 00060130
C 00060140
C 00060150
SUBROUTINE NDT45 (NUMBR,FIELD,OPTN) 00060160
C 00060170
C 00060180
C NDT45 FORMATS INTEGER NUMBERS FOR PRINTING IN A1 FORMAT. 00060190
C 00060200
C THE FIRST ARGUMENT IS THE NUMBER IN INTEGER MODE WHICH IS 00060210
C TO BE CONVERTED TO CHARACTER FORMAT. 00060220
C 00060230
C THE SECOND ARGUMENT IS THE TARGET FIELD IN WHICH THE 00060240
C CHARACTER STRING REPRESENTATION IS PLACED. 00060250
C 00060260
C THE THIRD ARGUMENT INDICATES THE FORMAT OPTION: 00060270
C 00060280
C 0 - THE NUMBER IS LEFT JUSTIFIED IN THE FIELD WITH LEADING 00060290
C ZERO SUPPRESSION AND BLANK PADDING ON THE RIGHT. 00060300
C 1 - THE NUMBER IS RIGHT JUSTIFIED IN THE FIELD WITH LEADING 00060310
C ZEROS LEFT IN THE FIELD AND NO BLANK PADDING. 00060320
C 00060330
C 00060340
REAL*8 RMIN,RMAX,LITBL(1024) 00060350
INTEGER PTRS(45),TITLE(120),CRSET(39),OPER(9),SYM(15), 00060360
1SUBSC(6),TYPCT(20),EQCHN(80),TOKEN(80),CARD1(80),CARD2(80), 00060370
2ERROR(80),OBJCD(160),DEF(80),XREF(80),TMAP(80),FCTN(5,22), 00060380
3SYMTB(5,512) 00060390
INTEGER FIELD(4),NUM(10),DIGIT,PNT,BLANK,LOOP,NUMBR,OPTN 00060400
COMMON RMIN,RMAX,PTRS,TITLE,CRSET,OPER,SYM,SUBSC,TYPCT, 00060410
1EQCHN,TOKEN,CARD1,CARD2,ERROR,OBJCD,DEF,XREF,TMAP,FCTN, 00060420
2SYMTB,LITBL 00060430
EQUIVALENCE (DIGIT,PNT),(NUM(1),CRSET(30)),(BLANK,CRSET(1)) 00060440
C 00060450
C 00060460
C THIS LOOP PLACES THE CHARACTER REPRESENTATION OF EACH DIGIT 00060470
C IN ITS CORRESPONDING POSITION IN THE TARGET FIELD. 00060480
C 00060490
C 00060500
DO 100 LOOP=1,4 00060510
DIGIT=MOD(NUMBR/10**(4-LOOP),10)+1 00060520
100 FIELD(LOOP)=NUM(DIGIT) 00060530
C 00060540
C 00060550
C IF THE RIGHT JUSTIFY OPTION IS REQUESTED THEN PROCESSING 00060560
C IS FINISHED. 00060570
C 00060580
C 00060590
IF(OPTN.EQ.1) GO TO 400 00060600
C 00060610
C 00060620
C THIS LOOP CHECKS THE LEADING POSITION FOR A ZERO. 00060630
C IF IT IS NOT A ZERO THEN THE STRING IS LEFT JUSTIFIED. 00060640
C 00060650
C 00060660
DO 300 PNT=1,3 00060670
IF(FIELD(1).NE.NUM(1)) GO TO 400 00060680
C 00060690
C 00060700
C THE LEADING CHARACTER IS A ZERO SO SHIFT ALL CHARACTERS 00060710
C ONE POSITION TO THE LEFT AND BLANK OUT THE LAST POSTITON. 00060720
C 00060730
C 00060740
DO 200 LOOP=1,3 00060750
200 FIELD(LOOP)=FIELD(LOOP+1) 00060760
300 FIELD(4)=BLANK 00060770
400 RETURN 00060780
END 00060800
C***************************************************************** 00060810
C * 00060820
C COPYRIGHT (C) 1978 - UNIVERSITY OF NOTRE DAME * 00060830
C PROGRAM AUTHOR - THOMAS L EVERMAN JR * 00060840
C * 00060850
C THIS PROGRAM CONSTRUCTS THE OBJECT CODE BUFFER. * 00060860
C * 00060870
C***************************************************************** 00060880
SUBROUTINE NDT46 (OPCOD, OPRND) 00060890
REAL*8 RMIN,RMAX,LITBL(1024) 00060900
INTEGER PTRS(45),TITLE(120),CRSET(39),OPER(9),SYM(15), 00060910
1SUBSC(6),TYPCT(20),EQCHN(80),TOKEN(80),CARD1(80),CARD2(80), 00060920
2ERROR(80),OBJCD(160),DEF(80),XREF(80),TMAP(80),FCTN(5,22), 00060930
3SYMTB(5,512) 00060940
INTEGER OPCOD,OPRND,OBJPT 00060950
COMMON RMIN,RMAX,PTRS,TITLE,CRSET,OPER,SYM,SUBSC,TYPCT, 00060960
1EQCHN,TOKEN,CARD1,CARD2,ERROR,OBJCD,DEF,XREF,TMAP,FCTN, 00060970
2SYMTB,LITBL 00060980
EQUIVALENCE (OBJPT,OBJCD(1)) 00060990
C***************************************************************** 00061000
C * 00061010
C INCREMENT OBJPT AND CHECK FOR EXCEEDING BUFFER LENGTH. * 00061020
C ENTER THE OPCODE AND OPERAND FROM THE ARGUMENT LIST INTO * 00061030
C THE NEXT 2 LOCATIONS IN THE BUFFER. * 00061040
C * 00061050
C***************************************************************** 00061060
OBJPT = OBJPT + 2 00061070
IF (OBJPT .LE. 160) GO TO 100 00061080
CALL NDT12 (5) 00061090
GO TO 200 00061100
100 OBJCD(OBJPT - 1) = OPCOD 00061110
OBJCD(OBJPT) = OPRND 00061120
200 RETURN 00061130
END 00061150
C***************************************************************** 00061160
C * 00061170
C COPYRIGHT (C) 1978 - UNIVERSITY OF NOTRE DAME * 00061180
C PROGRAM AUTHOR - THOMAS L EVERMAN JR * 00061190
C * 00061200
C THIS PROGRAM PROCESSES VARIABLES ON THE LEFT SIDE OF EQUATI* 00061210
C * 00061220
C***************************************************************** 00061230
SUBROUTINE NDT47 00061240
REAL*8 RMIN,RMAX,LITBL(1024) 00061250
INTEGER PTRS(45),TITLE(120),CRSET(39),OPER(9),SYM(15), 00061260
1SUBSC(6),TYPCT(20),EQCHN(80),TOKEN(80),CARD1(80),CARD2(80), 00061270
2ERROR(80),OBJCD(160),DEF(80),XREF(80),TMAP(80),FCTN(5,22), 00061280
3SYMTB(5,512) 00061290
INTEGER EQPOS,STYPE,SUBCK(8),LFTYP,VSUB,SYMPT,USDBT,VTYPE, 00061300
1INTBT,PRTBT,PLTBT,USOUT(3),I,DEFBT,TOKPT 00061310
COMMON RMIN,RMAX,PTRS,TITLE,CRSET,OPER,SYM,SUBSC,TYPCT, 00061320
1EQCHN,TOKEN,CARD1,CARD2,ERROR,OBJCD,DEF,XREF,TMAP,FCTN, 00061330
2SYMTB,LITBL 00061340
EQUIVALENCE (EQPOS,TMAP(3)),(STYPE,TOKEN(1)),(USDBT,SYM(10)), 00061350
1(VTYPE,SYM(7)),(INTBT,SYM(13)),(PRTBT,SYM(8)), 00061360
2(PLTBT,SYM(9)),(DEFBT,SYM(11)),(TOKPT,TOKEN(3)) 00061370
DATA USOUT /2,5,8/ 00061380
DATA SUBCK /0,0,0,0,2,2,4,2/ 00061390
C***************************************************************** 00061400
C * 00061410
C THE USOUT ARRAY LISTS EQUATION TYPES WHICH DEFINE VARIABLES* 00061420
C WHOSE USE IN OUTPUT STATEMENTS IS ACCEPTABLE AS USAGE OF * 00061430
C THE VARIABLE. THE SUBCK ARRAY GIVES A CORRESPONDENCE * 00061440
C BETWEEN THE STATEMENT TYPE AND THE SUBSCRIPT OF THE NAME * 00061450
C ON THE LEFT OF THE EQUAL SIGN. A CHECK IS FIRST MADE TO SE* 00061460
C IF AN EQUAL SIGN EXISTS IN THE EQUATION. THEN, THE TOKEN * 00061470
C TYPE IS DETERMINED. IF THE TOKEN DOES NOT INDICATE A * 00061480
C VALID VARIABLE, THE PROGRAM RETURNS. * 00061490
C * 00061500
C***************************************************************** 00061510
IF (EQPOS .NE. 5 .OR. TOKPT .EQ. 3) GO TO 400 00061520
VSUB = TOKEN(4) / 4096 00061530
IF (TOKEN(4) .LT. 0 .OR. VSUB .GT. 4) GO TO 400 00061540
C***************************************************************** 00061550
C * 00061560
C COMPUTE THE SYMBOL TABLE POINTER FROM THE TOKEN. CALL THE * 00061570
C UNPACK SUBROUTINE SO THAT VARIABLE INFORMATION IS AVAILABLE* 00061580
C IN SYM. SET LFTYP TO THE STATEMENT TYPE * 00061590
C BRANCH TO THE DEF CARD PROCESSING ROUTINE. * 00061600
C***************************************************************** 00061610
SYMPT = MOD (TOKEN(4), 4096) + 1 00061620
CALL NDT41 (SYMTB(1,SYMPT)) 00061630
LFTYP = STYPE 00061640
IF (LFTYP .EQ. 18) GO TO 300 00061650
C***************************************************************** 00061660
C * 00061670
C CROSS-CHECK THE SUBSCRIPTS. ALSO BRANCH TO RETURN * 00061680
C IF PARM CARD VARIABLE IS BEING PROCESSED. * 00061690
C * 00061700
C***************************************************************** 00061710
IF (VSUB .NE. SUBCK(LFTYP)) CALL NDT14 (TMAP(4), 530 + 00061720
1SUBCK(LFTYP), 1) 00061730
IF (VTYPE .EQ. 3) GO TO 400 00061740
C***************************************************************** 00061750
C * 00061760
C MAKE SPECIAL CHECKS FOR INITIAL VALUE EQUATION. MAKE SURE * 00061770
C INITIALIZED VARIABLE IS A LEVEL. IF N EQUATION DOES NOT * 00061780
C INITIALIZE ANYTHING, GIVE WARNING AND CHANGE ITS TYPE * 00061790
C TO A LEVEL. * 00061800
C * 00061810
C***************************************************************** 00061820
IF (STYPE .NE. 4 .OR. DEFBT .NE. 0) GO TO 90 00061830
CALL NDT14 (TMAP(4), 525, 1) 00061840
VTYPE = 5 00061850
CALL NDT40 (SYMTB(1,SYMPT)) 00061860
GO TO 90 00061870
C***************************************************************** 00061880
C * 00061890
C CHECK TO MAKE SURE A LEVEL VARIABLE HAS BEEN INITIALIZED. * 00061900
C THEN CHECK TO MAKE SURE THAT THE VARIABLE HAS BEEN USED * 00061910
C ON THE RIGHT SIDE OF AN EQUATION. IF IT IS NOT USED, NO * 00061920
C WARNING IS ISSUED AS LONG AS THE VARIABLE IS A L, S, OR C * 00061930
C AND IS USED FOR OUTPUT. IF A R OR A EQUATION IS USED FOR * 00061940
C OUTPUT ONLY, A WARNING IS GIVEN TO INDICATE THAT THE * 00061950
C VARIABLE SHOULD BE DEFINED AS A SUPPLEMENTARY. IF THE * 00061960
C VARIABLE IS NEITHER USED NOR OUTPUT, A WARNING INDICATING * 00061970
C THAT THE VARIABLE HAS NO USAGE IN THE PROGRAM IS GIVEN. * 00061980
C * 00061990
C***************************************************************** 00062000
90 IF (VTYPE .EQ. 5 .AND. INTBT .EQ. 0) CALL NDT14 (TMAP(4),524,3) 00062010
IF (USDBT .NE. 0) GO TO 400 00062020
IF (PRTBT .EQ. 0 .AND. PLTBT .EQ. 0) GO TO 200 00062030
DO 100 I = 1, 3 00062040
IF (VTYPE .EQ. USOUT(I)) GO TO 400 00062050
100 CONTINUE 00062060
C***************************************************************** 00062070
C * 00062080
C ERROR MESSAGES: * 00062090
C 587 - VARIABLE IS USED FOR OUTPUT ONLY AND SHOULD HAVE * 00062100
C BEEN DEFINED AS A SUPPLEMENTARY. * 00062110
C 588 - A VARIABLE HAS NO PURPOSE IN THE PROGRAM. * 00062120
C 589 - THE DEF CARD OCCURS FOR AN UNDEFINED VARIABLE. * 00062130
C * 00062140
C***************************************************************** 00062150
CALL NDT14 (TMAP(4), 587, 1) 00062160
GO TO 400 00062170
200 CALL NDT14 (TMAP(4), 588, 1) 00062180
GO TO 400 00062190
300 IF (DEFBT .EQ. 0) CALL NDT14 (TMAP(4), 589, 1) 00062200
400 RETURN 00062210
END 00062230
C***************************************************************** 00062240
C * 00062250
C COPYRIGHT (C) 1978 - UNIVERSITY OF NOTRE DAME * 00062260
C PROGRAM AUTHOR - THOMAS L EVERMAN JR * 00062270
C * 00062280
C THIS PROGRAM PROCESSES VARABLES ON THE RIGHT SIDE OF * 00062290
C AN EQUATION. * 00062300
C * 00062310
C***************************************************************** 00062320
SUBROUTINE NDT48 00062330
REAL*8 RMIN,RMAX,LITBL(1024) 00062340
INTEGER PTRS(45),TITLE(120),CRSET(39),OPER(9),SYM(15), 00062350
1SUBSC(6),TYPCT(20),EQCHN(80),TOKEN(80),CARD1(80),CARD2(80), 00062360
2ERROR(80),OBJCD(160),DEF(80),XREF(80),TMAP(80),FCTN(5,22), 00062370
3SYMTB(5,512) 00062380
INTEGER EQPOS,STYPE,RSTYP,VTYPE,RVTYP,DEFBT,SUBCK(8,7), 00062390
1VSUB,PNT,TOKPT,SYMPT,FUNPT,CHECK,OPTNS,XRFBT,DVSYM,INTBT 00062400
COMMON RMIN,RMAX,PTRS,TITLE,CRSET,OPER,SYM,SUBSC,TYPCT, 00062410
1EQCHN,TOKEN,CARD1,CARD2,ERROR,OBJCD,DEF,XREF,TMAP,FCTN, 00062420
2SYMTB,LITBL 00062430
EQUIVALENCE (EQPOS,TMAP(3)),(STYPE,TOKEN(1)),(VTYPE,SYM(7)), 00062440
1(DEFBT,SYM(11)),(TOKPT,TOKEN(3)),(SYMPT,FUNPT), 00062450
2(OPTNS,PTRS(7)),(INTBT,SYM(13)) 00062460
C***************************************************************** 00062470
C * 00062480
C THE SUBCK ARRAY IS USED TO SEE WHETHER A GIVEN VARIABLE * 00062490
C TYPE IS VALID IN AN EQUATION AND WHETHER OR NOT IT IS * 00062500
C PROPERLY SUBSCRIPTED. THE ROWS CORRESPOND TO STATEMENTS, * 00062510
C AND THE COLUMNS CORRESPOND TO VARIABLE TYPES. THE VALUES * 00062520
C AT THE INTERSECTING POSITION INDICATE THE FOLLOWING: * 00062530
C 0 - USAGE IS PERMISSIBLE. NO SUBSCRIPT. * 00062540
C 2 - USAGE IS PERMISSIBLE. SUBSCRIPT .K. * 00062550
C 3 - USAGE IS PERMISSIBLE. SUBSCRIPT .JK. * 00062560
C 100 - USAGE IS NOT PERMISSIBLE. * 00062570
C * 00062580
C***************************************************************** 00062590
DATA SUBCK /0,0,0,100,0,0,0,0,100,0,100,100,100,100,100,100, 00062600
1100,100,0,100,100,100,100,0,100,100,0,100,2,2,2,0, 00062610
2100,100,0,100,2,2,2,0,100,100,0,3,100,100,3,0, 00062620
3100,100,100,100,100,100,2,0/ 00062630
C***************************************************************** 00062640
C * 00062650
C MAKE SURE EQUAL SIGN EXISTS IN EQUATION. PNT IS THE POSITI* 00062660
C OF THE NEXT AVAILABLE TOKEN. RSTYP IS USED TO KEEP STYPE * 00062670
C WITHIN THE BOUNDS OF THE SUBCK ARRAY. DVSYM IS THE SYMBOL * 00062680
C TABLE POINTER OF THE DEPENDENT VARIABLE FOR THIS EQUATION. * 00062690
C * 00062700
C***************************************************************** 00062710
IF (EQPOS .EQ. 0) GO TO 600 00062720
XRFBT = MOD (OPTNS / 128, 2) 00062730
PNT = EQPOS 00062740
RSTYP = STYPE - 1 00062750
IF (STYPE .EQ. 12 .OR. STYPE .EQ. 13) RSTYP = 8 00062760
DVSYM = MOD (TOKEN(4), 4096) + 1 00062770
C***************************************************************** 00062780
C * 00062790
C INCREMENT THE TOKEN POINTER AND CHECK FOR THE END OF * 00062800
C OF THE TOKEN STRING. DETERMINE THE SUBSCRIPT TYPE IN * 00062810
C VSUB. GET NEXT TOKEN IF PRESENT TOKEN INDICATES A * 00062820
C NUMERIC, FUNCTION, INVALID VARIABLE, OR OPERATOR. * 00062830
C * 00062840
C***************************************************************** 00062850
100 PNT = PNT + 1 00062860
IF (PNT .GT. TOKPT) GO TO 600 00062870
VSUB = TOKEN(PNT) / 4096 00062880
IF (TOKEN(PNT) .LT. 0 .OR. VSUB .GT. 5) GO TO 100 00062890
C***************************************************************** 00062900
C * 00062910
C GET THE POINTER TO THE SYMBOL OR FUNCTION TABLE FROM THE * 00062920
C TOKEN. BRANCH IF NOT A FUNCTION. * 00062930
C * 00062940
C***************************************************************** 00062950
SYMPT = MOD (TOKEN(PNT), 4096) + 1 00062960
IF (VSUB .NE. 5) GO TO 300 00062970
C***************************************************************** 00062980
C * 00062990
C FUNCTION NAME HAS BEEN ENCOUNTERED. IF IT IS NOT ONE OF * 00063000
C THE TABLE FUNCTIONS, GET THE NEXT TOKEN. OTHERWISE, GET * 00063010
C A TOKEN TWO POSITIONS AWAY AND DETERMINE WHETHER IT IS * 00063020
C POINTING TO A TABLE. IF IT IS A TABLE, CHECK SUBSCRIPT. * 00063030
C * 00063040
C***************************************************************** 00063050
FUNPT = FUNPT - 1 00063060
IF(FUNPT.EQ.6.AND.STYPE.NE.5) CALL NDT14 (TMAP(PNT),526,3) 00063070
IF (FUNPT .LT. 19) GO TO 100 00063080
PNT = PNT + 2 00063090
VSUB = TOKEN(PNT) / 4096 00063100
SYMPT = MOD (TOKEN(PNT), 4096) + 1 00063110
IF (TOKEN(PNT) .LT. 0 .OR. VSUB .GT. 4) GO TO 200 00063120
CALL NDT41 (SYMTB(1,SYMPT)) 00063130
IF (XRFBT .NE. 0) CALL NDT58 (SYMPT) 00063140
IF (VTYPE .NE. 1) GO TO 200 00063150
IF (VSUB .NE. 0) CALL NDT14 (TMAP(PNT), 530, 1) 00063160
PNT = PNT + 1 00063170
IF (TOKEN(PNT) .NE. 28681) GO TO 200 00063180
GO TO 100 00063190
200 CALL NDT14 (TMAP(PNT), 521, 3) 00063200
GO TO 100 00063210
C***************************************************************** 00063220
C * 00063230
C PROCESS ORDINARY VARIABLE. IF A TABLE NAME IS FOUND, IT * 00063240
C HAS NOT OCCURRED IN THE CORRECT POSITION. RVTYP KEEPS * 00063250
C VTYPE WITHIN SUBCK ARRAY BOUNDS. THE VARIABLE MUST BE * 00063260
C DEFINED, IT MUST BE ALLOWED IN THE PARTICULAR TYPE OF * 00063270
C EQUATION, AND IT MUST BE SUBSCRIPTED CORRECTLY. * 00063280
C * 00063290
C***************************************************************** 00063300
300 IF(SYMPT .EQ. DVSYM .AND. STYPE .LE. 8) 00063310
1 CALL NDT14 (TMAP(PNT), 505, 3) 00063320
CALL NDT41 (SYMTB(1,SYMPT)) 00063330
IF (XRFBT .NE. 0) CALL NDT58 (SYMPT) 00063340
IF (VTYPE .EQ. 1) GO TO 550 00063350
RVTYP = VTYPE - 1 00063360
IF (DEFBT .EQ. 0) GO TO 400 00063370
350 CHECK = SUBCK(RSTYP,RVTYP) 00063380
IF (CHECK .EQ. 100) GO TO 500 00063390
IF (VSUB .NE. CHECK) CALL NDT14 00063400
1(TMAP(PNT), 530 + CHECK, 1) 00063410
GO TO 100 00063420
400 IF(INTBT .EQ. 0) GO TO 450 00063430
RVTYP = 1 00063440
GO TO 350 00063450
450 CALL NDT14 (TMAP(PNT), 516, 3) 00063460
GO TO 100 00063470
500 CALL NDT14 (TMAP(PNT), 570 + RVTYP, 3) 00063480
GO TO 100 00063490
550 CALL NDT14 (TMAP(PNT), 522, 3) 00063500
GO TO 100 00063510
600 RETURN 00063520
END 00063540
C***************************************************************** 00063550
C * 00063560
C COPYRIGHT (C) 1978 - UNIVERSITY OF NOTRE DAME * 00063570
C PROGRAM AUTHOR - THOMAS L EVERMAN JR * 00063580
C * 00063590
C THIS PROGRAM INSURES THAT ONLY A NUMERIC LITERAL * 00063600
C OCCURS ON THE RIGHT SIDE OF AN EQUAL SIGN. * 00063610
C * 00063620
C***************************************************************** 00063630
SUBROUTINE NDT49 00063640
REAL*8 RMIN,RMAX,LITBL(1024) 00063650
INTEGER PTRS(45),TITLE(120),CRSET(39),OPER(9),SYM(15), 00063660
1SUBSC(6),TYPCT(20),EQCHN(80),TOKEN(80),CARD1(80),CARD2(80), 00063670
2ERROR(80),OBJCD(160),DEF(80),XREF(80),TMAP(80),FCTN(5,22), 00063680
3SYMTB(5,512) 00063690
INTEGER EQPOS,TOKPT 00063700
COMMON RMIN,RMAX,PTRS,TITLE,CRSET,OPER,SYM,SUBSC,TYPCT, 00063710
1EQCHN,TOKEN,CARD1,CARD2,ERROR,OBJCD,DEF,XREF,TMAP,FCTN, 00063720
2SYMTB,LITBL 00063730
EQUIVALENCE (EQPOS,TMAP(3)),(TOKPT,TOKEN(3)) 00063740
C***************************************************************** 00063750
C * 00063760
C THE TOKEN AFTER THE EQUAL SIGN MAY ONLY BE A NUMERIC * 00063770
C LITERAL. FIRST CHECK TO SEE THAT THERE IS AN EQUAL SIGN. * 00063780
C THEN MAKE SURE THAT THERE IS ONE AND ONLY ONE TOKEN * 00063790
C FOLLOWING THE EQUAL SIGN. IF THERE IS ONLY SUCH A SINGLE * 00063800
C TOKEN, MAKE SURE THAT IT REPRESENTS A NUMERIC LITERAL. * 00063810
C * 00063820
C***************************************************************** 00063830
IF (EQPOS .EQ. 0) GO TO 200 00063840
IF (TOKPT .NE. EQPOS + 1) GO TO 100 00063850
IF (TOKEN(TOKPT) .LT. 0) GO TO 200 00063860
100 CALL NDT14 (TMAP(TOKPT), 806, 3) 00063870
200 RETURN 00063880
END 00063900
C***************************************************************** 00063910
C * 00063920
C COPYRIGHT (C) 1978 - UNIVERSITY OF NOTRE DAME * 00063930
C PROGRAM AUTHOR - TIMOTHY J. MALLOY * 00063940
C * 00063950
C***************************************************************** 00063960
SUBROUTINE NDT50 00063970
C***************************************************************** 00063980
C * 00063990
C * 00064000
C DOCUMENTER * 00064010
C * 00064020
C * 00064030
C THIS PROGRAM, CALLED BY THE SOURCE LISTING PROGRAM, * 00064040
C HANDLES THE LISTING OF THE DEFINTIONS OF VARIABLES, * 00064050
C WHEN THE DOCUMENT CONTROL CARD OPTION IS IN EFFECT. * 00064060
C * 00064070
C***************************************************************** 00064080
REAL*8 RMIN,RMAX,LITBL(1024) 00064090
INTEGER PTRS(45),TITLE(120),CRSET(39),OPER(9),SYM(15), 00064100
1SUBSC(6),TYPCT(20),EQCHN(80),TOKEN(80),CARD1(80),CARD2(80), 00064110
2ERROR(80),OBJCD(160),DEF(80),XREF(80),TMAP(80),FCTN(5,22), 00064120
3SYMTB(5,512) 00064130
INTEGER TOKPT,RECNO,PRNTR,DISK,PNTR,TOKE 00064140
COMMON RMIN,RMAX,PTRS,TITLE,CRSET,OPER,SYM,SUBSC,TYPCT, 00064150
1EQCHN,TOKEN,CARD1,CARD2,ERROR,OBJCD,DEF,XREF,TMAP,FCTN, 00064160
2SYMTB,LITBL 00064170
EQUIVALENCE (TOKPT,TOKEN(3)),(RECNO,SYM(15)),(DISK,PTRS(3)), 00064180
1(PRNTR,PTRS(2)) 00064190
C***************************************************************** 00064200
C * 00064210
C GO THROUGH THE TOKEN ARRAY, TOKEN BY TOKEN, FIRST CHECKING * 00064220
C FOR A VARIABLE. * 00064230
C * 00064240
C***************************************************************** 00064250
CALL NDT57(1) 00064260
WRITE (PRNTR,300) 00064270
DO 100 TOKE = 4, TOKPT 00064280
IF (TOKEN(TOKE) .LE. 0 .OR. TOKEN(TOKE) .GT. 20479) 00064290
1 GO TO 100 00064300
C***************************************************************** 00064310
C * 00064320
C IF IT IS A VARIABLE, UNPACK ITS SYMBOL TABLE ENTRY. * 00064330
C CHECK FOR THE EXISTENCE OF A RECORD. * 00064340
C * 00064350
C***************************************************************** 00064360
PNTR = MOD(TOKEN(TOKE),4096) + 1 00064370
CALL NDT41(SYMTB(1,PNTR)) 00064380
IF (RECNO .EQ. 0) GO TO 100 00064390
C***************************************************************** 00064400
C * 00064410
C READ IN THE DEF ARRAY FROM DISK, AND THEN WRITE IT OUT * 00064420
C TO THE PRINTER. * 00064430
C * 00064440
C***************************************************************** 00064450
READ (DISK'RECNO+6) DEF 00064460
CALL NDT57(1) 00064470
WRITE (PRNTR,200) DEF 00064480
C***************************************************************** 00064490
C * 00064500
C LOOK AT NEXT TOKEN. * 00064510
C * 00064520
C***************************************************************** 00064530
100 CONTINUE 00064540
CALL NDT57(1) 00064550
WRITE (PRNTR,300) 00064560
200 FORMAT (15X,80A1) 00064570
300 FORMAT(1X) 00064580
RETURN 00064590
END 00064610
C***************************************************************** 00064620
C * 00064630
C COPYRIGHT (C) 1978 - UNIVERSITY OF NOTRE DAME * 00064640
C PROGRAM AUTHOR - THOMAS L EVERMAN JR * 00064650
C * 00064660
C THIS PROGRAM CHECKS THE FORMAT OF LEVEL EQUATIONS. * 00064670
C * 00064680
C***************************************************************** 00064690
SUBROUTINE NDT51 00064700
REAL*8 RMIN,RMAX,LITBL(1024) 00064710
INTEGER PTRS(45),TITLE(120),CRSET(39),OPER(9),SYM(15), 00064720
1SUBSC(6),TYPCT(20),EQCHN(80),TOKEN(80),CARD1(80),CARD2(80), 00064730
2ERROR(80),OBJCD(160),DEF(80),XREF(80),TMAP(80),FCTN(5,22), 00064740
3SYMTB(5,512) 00064750
INTEGER EQPOS,TOKPT,PNT,PNEST,FNUM,OPTYP,FNOCC,EQNCD,TKNTP 00064760
COMMON RMIN,RMAX,PTRS,TITLE,CRSET,OPER,SYM,SUBSC,TYPCT, 00064770
1EQCHN,TOKEN,CARD1,CARD2,ERROR,OBJCD,DEF,XREF,TMAP,FCTN, 00064780
2SYMTB,LITBL 00064790
EQUIVALENCE (TOKPT,TOKEN(3)),(FNUM,OPTYP), 00064800
1(EQNCD,ERROR(1)),(EQPOS,TMAP(3)) 00064810
C***************************************************************** 00064820
C * 00064830
C THE LEVEL EQUATION MUST CONFORM TO THE FORMAT: * 00064840
C LEVEL=INTGRL(SUM OF RATES) * 00064850
C CHECK FOR OTHER CRITICAL ERRORS BEFORE CONTINUING. * 00064860
C * 00064870
C***************************************************************** 00064880
IF (EQNCD .GE. 3) GO TO 700 00064890
C***************************************************************** 00064900
C * 00064910
C INITIALIZE PNT, THE POINTER TO THE NEXT TOKEN. PNEST * 00064920
C CHECKS PAREN NESTING TO DETERMINE END OF TOKEN STRING. * 00064930
C FNOCC DENOTES THAT AN INTGRL FUNCTION HAS OCCURRED. * 00064940
C * 00064950
C***************************************************************** 00064960
PNT = EQPOS 00064970
PNEST = 0 00064980
FNOCC = 0 00064990
C***************************************************************** 00065000
C * 00065010
C INCREMENT THE TOKEN POINTER TO THE NEXT TOKEN. SEPARATE * 00065020
C THE TOKEN TYPE AND ITS ASSOCIATED POINTER. CHECK FOR FUNCTI* 00065030
C * 00065040
C***************************************************************** 00065050
100 PNT = PNT + 1 00065060
IF (PNT .GT. TOKPT) GO TO 600 00065070
TKNTP = TOKEN(PNT) / 4096 00065080
FNUM = MOD (TOKEN(PNT), 4096) 00065090
IF (TKNTP .NE. 5) GO TO 250 00065100
C***************************************************************** 00065110
C * 00065120
C A FUNCTION HAS BEEN FOUND IN THE TOKEN STRING. CHECK TO * 00065130
C SEE IF IT IS AN INTEGRATION FUNCTION. IF IT IS INTGRL, * 00065140
C MAKE SURE IT FOLLOWS DIRECTLY AFTER EQUAL SIGN. IF NOT * 00065150
C INTGRL, FLAG AS AN INVALID FUNCTION. * 00065160
C * 00065170
C***************************************************************** 00065180
IF (FNUM .NE. 6) GO TO 200 00065190
IF (PNT .NE. EQPOS + 1) CALL NDT14 (TMAP(PNT), 903, 3) 00065200
FNOCC = 1 00065210
GO TO 100 00065220
200 CALL NDT14 (TMAP(PNT), 905, 3) 00065230
GO TO 100 00065240
C***************************************************************** 00065250
C * 00065260
C FLAG ANY NUMERIC LITERALS WHICH OCCUR. * 00065270
C * 00065280
C***************************************************************** 00065290
250 IF (TOKEN(PNT) .GE. 0) GO TO 300 00065300
CALL NDT14 (TMAP(PNT), 904, 3) 00065310
GO TO 100 00065320
C***************************************************************** 00065330
C * 00065340
C IF TOKEN INDICATES A VARIABLE, OBTAIN NEXT TOKEN. * 00065350
C OTHERWISE, AN OPERATOR TOKEN IS PRESENT. IF INTGRL * 00065360
C HAS NOT OCCURRED, TAKE NO ACTION. WITHIN AN INTGRL * 00065370
C THE ONLY VALID OPERATORS ARE '+' AND '-'. PARENS * 00065380
C ARE PERMITTED FOR GROUPING AND ARE USED TO DETERMINE * 00065390
C THE END OF THE FUNCTION GROUP. * 00065400
C * 00065410
C***************************************************************** 00065420
300 IF (TKNTP .LT. 7) GO TO 100 00065430
IF (FNOCC .EQ. 0) GO TO 100 00065440
GO TO (100,100,100,350,350,100,400,500,100,350), OPTYP 00065450
C***************************************************************** 00065460
C * 00065470
C FLAG '*', '/', '**' AS INVALID OPERATIONS. * 00065480
C * 00065490
C***************************************************************** 00065500
350 CALL NDT14 (TMAP(PNT), 901, 3) 00065510
GO TO 100 00065520
C***************************************************************** 00065530
C * 00065540
C PARENS HAVE OCCURRED. INCREMENT OR DECREMENT PNEST. * 00065550
C * 00065560
C***************************************************************** 00065570
400 PNEST = PNEST + 1 00065580
GO TO 100 00065590
500 PNEST = PNEST - 1 00065600
IF (PNEST .LE. 0) GO TO 550 00065610
GO TO 100 00065620
C***************************************************************** 00065630
C * 00065640
C CHECK FOR ADDITIONAL TOKENS AFTER END OF FUNCTION GROUP. * 00065650
C THEN MAKE SURE AN INTEGRATION FUNCTION HAS OCCURRED. * 00065660
C * 00065670
C***************************************************************** 00065680
550 IF (PNT .LT. TOKPT) CALL NDT14 (TMAP(PNT + 1), 902, 3) 00065690
600 IF (FNOCC .EQ. 0) CALL NDT14 (TMAP(EQPOS + 1), 903, 3) 00065700
700 RETURN 00065710
END 00065730
C***************************************************************** 00065740
C * 00065750
C COPYRIGHT (C) 1978 - UNIVERSITY OF NOTRE DAME * 00065760
C PROGRAM AUTHOR - TIMOTHY J. MALLOY * 00065770
C * 00065780
C***************************************************************** 00065790
SUBROUTINE NDT52 00065800
C***************************************************************** 00065810
C * 00065820
C OUTPUT CONTEXT ANALYZER * 00065830
C * 00065840
C * 00065850
C THIS PROGRAM CHECKS AN OUTPUT REQUEST FOR CONTEXT ERRORS. * 00065860
C * 00065870
C***************************************************************** 00065880
REAL*8 RMIN,RMAX,LITBL(1024) 00065890
REAL*8 LOW(11),HIGH(11) 00065900
INTEGER PTRS(45),TITLE(120),CRSET(39),OPER(9),SYM(15), 00065910
1SUBSC(6),TYPCT(20),EQCHN(80),TOKEN(80),CARD1(80),CARD2(80), 00065920
2ERROR(80),OBJCD(160),DEF(80),XREF(80),TMAP(80),FCTN(5,22), 00065930
3SYMTB(5,512) 00065940
INTEGER OUTPT(240),VARCT,TYPE,RUNNO,FLAG(11),IVPLT, 00065950
1CHAR(10),RUN(11),CFLAG,OUT1(80),OUT2(80),OUT3(80) 00065960
INTEGER RUNCT,PNTR,VTYPE,NOTBT,XCHAR,NOTE(40) 00065970
INTEGER DISK,OCBPT,PGMCT,TOKPT,VNUM(11) 00065980
COMMON RMIN,RMAX,PTRS,TITLE,CRSET,OPER,SYM,SUBSC,TYPCT, 00065990
1EQCHN,TOKEN,CARD1,CARD2,ERROR,OBJCD,DEF,XREF,TMAP,FCTN, 00066000
2SYMTB,LITBL 00066010
EQUIVALENCE (OUTPT(1),DEF(1),OUT1(1),VARCT),(OUTPT(2),TYPE), 00066020
1(OUTPT(3),RUNNO),(OUTPT(103),LOW(1)),(OUTPT(125),HIGH(1)), 00066030
2(OUTPT(147),FLAG(1)),(OUTPT(179),RUN(1)),(OUTPT(200),CFLAG), 00066040
3(OUTPT(190),CHAR(1)),(VNUM(1),OUTPT(92)),(IVPLT,OUTPT(158)), 00066050
4(OUT2(1),XREF(1)),(OUT3(1),TMAP(1)) 00066060
EQUIVALENCE (RUNCT,PTRS(14)),(VTYPE,SYM(7)), 00066070
1(NOTBT,OBJCD(1)),(NOTE(1),OBJCD(2)),(DISK,PTRS(3)), 00066080
2(PGMCT,PTRS(22)),(TOKPT,TOKEN(3)),(OCBPT,PTRS(43)) 00066090
C***************************************************************** 00066100
C * 00066110
C FIRST, THE OUTPUT BUFFER MUST BE READ IN FROM DISK. DUE * 00066120
C TO THE EQUIVALENCE STRUCTURE, THE BUFFER IS READ INTO * 00066130
C DEF, XREF, AND TMAP. * 00066140
C * 00066150
C***************************************************************** 00066160
READ (DISK'PGMCT+6) OUT1 00066170
READ (DISK'PGMCT+7) OUT2 00066180
READ (DISK'PGMCT+8) OUT3 00066190
C***************************************************************** 00066200
C * 00066210
C CHECK FOR AN OUTPUT REQUEST WITH A RUN NUMBER GREATER * 00066220
C THAN THE NUMBER OF RUNS IN THE MODEL. * 00066230
C * 00066240
C***************************************************************** 00066250
IF (RUNNO .LE. RUNCT) GO TO 100 00066260
CALL NDT14(0,728,3) 00066270
GO TO 300 00066280
C***************************************************************** 00066290
C * 00066300
C CALL THE AUTOPLOT ROUTINE IF THE AUTOPLOT OPTION IS * 00066310
C REQUESTED. * 00066320
C * 00066330
C***************************************************************** 00066340
100 IF (RUNNO .EQ. 0) CALL NDT53 00066350
C***************************************************************** 00066360
C * 00066370
C CALL THE VARIABLE ALIGNMENT ROUTINE TO PUT IN RUN * 00066380
C NUMBERS IF THEY'RE NEEDED, AND TO CENTER THE VARIABLE * 00066390
C NAMES FOR A PRINT. * 00066400
C * 00066410
C***************************************************************** 00066420
CALL NDT54 00066430
C***************************************************************** 00066440
C * 00066450
C CHECK FOR AN ATTEMPT TO USE A CONSTANT AS THE * 00066460
C INDEPENDENT VARIABLE. THE INFORMATION MUST BE UNPACKED * 00066470
C FROM THE SYMBOL TABLE. * 00066480
C * 00066490
C***************************************************************** 00066500
IF (IVPLT .EQ. 0) GO TO 150 00066510
PNTR = MOD(TOKEN(TOKPT),4096) + 1 00066520
CALL NDT41(SYMTB(1,PNTR)) 00066530
IF (VTYPE .EQ. 2) CALL NDT14(0,727,3) 00066540
C***************************************************************** 00066550
C * 00066560
C IF THERE IS SUBTITLE INFORMATION OUT THERE, PULL IT * 00066570
C IN, AND SET CFLAG. * 00066580
C * 00066590
C***************************************************************** 00066600
150 IF (NOTBT .EQ. 0) GO TO 300 00066610
CFLAG = 1 00066620
DO 200 XCHAR = 1, 40 00066630
200 OUTPT(200 + XCHAR) = NOTE(XCHAR) 00066640
C***************************************************************** 00066650
C * 00066660
C WRITE THE OUTPT ARRAY TO DISK, THEN RETURN. * 00066670
C * 00066680
C***************************************************************** 00066690
300 WRITE (DISK'OCBPT+1) OUT1 00066700
WRITE (DISK'OCBPT+2) OUT2 00066710
WRITE (DISK'OCBPT+3) OUT3 00066720
OCBPT = OCBPT + 3 00066730
RETURN 00066740
END 00066760
C***************************************************************** 00066770
C * 00066780
C COPYRIGHT (C) 1978 - UNIVERSITY OF NOTRE DAME * 00066790
C PROGRAM AUTHOR - TIMOTHY J. MALLOY * 00066800
C * 00066810
C***************************************************************** 00066820
SUBROUTINE NDT53 00066830
C***************************************************************** 00066840
C * 00066850
C AUTOPLOT PROCESSOR * 00066860
C * 00066870
C * 00066880
C IF THE USER SPECIFIED AN OUTPUT CARD WITH A VARIABLE * 00066890
C HAVING A STAR '*' AS A RUN NUMBER, "VAR.*", NDTRAN WILL * 00066900
C AUTOMATICALLY EXPAND THAT STATEMENT TO OUTPUT A PLOT * 00066910
C OR PRINT COMPARING THAT VARIABLE ACROSS EVERY RUN. * 00066920
C * 00066930
C***************************************************************** 00066940
REAL*8 RMIN,RMAX,LITBL(1024) 00066950
REAL*8 LOW(11),HIGH(11) 00066960
INTEGER PTRS(45),TITLE(120),CRSET(39),OPER(9),SYM(15), 00066970
1SUBSC(6),TYPCT(20),EQCHN(80),TOKEN(80),CARD1(80),CARD2(80), 00066980
2ERROR(80),OBJCD(160),DEF(80),XREF(80),TMAP(80),FCTN(5,22), 00066990
3SYMTB(5,512) 00067000
INTEGER OUTPT(240),VARCT,TYPE,RUNNO,FLAG(11), 00067010
1CHAR(10),RUN(11),VNUM(11),VNAM(8,11),CFLAG 00067020
INTEGER RUNCT,CLNUM,XCHAR,OPTNS,VMAX 00067030
COMMON RMIN,RMAX,PTRS,TITLE,CRSET,OPER,SYM,SUBSC,TYPCT, 00067040
1EQCHN,TOKEN,CARD1,CARD2,ERROR,OBJCD,DEF,XREF,TMAP,FCTN, 00067050
2SYMTB,LITBL 00067060
EQUIVALENCE (OUTPT(1),DEF(1),VARCT),(OUTPT(2),TYPE), 00067070
1(OUTPT(3),RUNNO),(OUTPT(103),LOW(1)),(OUTPT(125),HIGH(1)), 00067080
2(OUTPT(147),FLAG(1)),(OUTPT(179),RUN(1)),(OUTPT(200),CFLAG), 00067090
3(OUTPT(190),CHAR(1)),(OUTPT(92),VNUM(1)) 00067100
EQUIVALENCE (RUNCT,PTRS(14)),(OUTPT(4),VNAM(1,1)), 00067110
1(OPTNS,PTRS(7)) 00067120
C***************************************************************** 00067130
C * 00067140
C SET RUNNO TO THE NUMBER OF RUNS IN THIS MODEL. * 00067150
C * 00067160
C THE NARROW OPTION RESTRICTS THE NUMBER OF VARIABLES. * 00067170
C * 00067180
C***************************************************************** 00067190
RUNNO = RUNCT 00067200
VMAX = 10 - MOD(OPTNS/8,2)*(TYPE-8) 00067210
IF (RUNNO .LE. VMAX) GO TO 100 00067220
RUNNO = VMAX 00067230
CALL NDT14(0, 726, 1) 00067240
C***************************************************************** 00067250
C * 00067260
C CREATE A VARIABLE ENTRY IN THE OUTPT BUFFER FOR EACH * 00067270
C RUN, SETTING VNAM, VNUM, RUN, AND FLAG. * 00067280
C * 00067290
C***************************************************************** 00067300
100 VARCT = RUNNO + 1 00067310
RUN(2) = 1 00067320
IF (RUNNO .EQ. 1) GO TO 400 00067330
DO 300 CLNUM = 2, VARCT 00067340
DO 200 XCHAR = 1, 8 00067350
200 VNAM(XCHAR,CLNUM) = VNAM(XCHAR,2) 00067360
VNUM(CLNUM) = VNUM(2) 00067370
RUN(CLNUM) = CLNUM - 1 00067380
300 FLAG(CLNUM) = 23 00067390
FLAG(1) = 13 00067400
C***************************************************************** 00067410
C * 00067420
C ASSIGN THE PLOT CHARACTERS BY CALLING NDT34, AND SET * 00067430
C VARCT. * 00067440
C * 00067450
C***************************************************************** 00067460
400 CALL NDT34 00067470
RETURN 00067480
END 00067500
C***************************************************************** 00067510
C * 00067520
C COPYRIGHT (C) 1978 - UNIVERSITY OF NOTRE DAME * 00067530
C PROGRAM AUTHOR - TIMOTHY J. MALLOY * 00067540
C * 00067550
C***************************************************************** 00067560
SUBROUTINE NDT54 00067570
C***************************************************************** 00067580
C * 00067590
C VARIABLE ALIGNMENT * 00067600
C * 00067610
C * 00067620
C * 00067630
C THIS PROGRAM, PART OF THE OUTPUT CONTEXT PHASE, WILL * 00067640
C PREPARE THE VARIABLE NAME FIELD FOR OUTPUT. IT WILL * 00067650
C INSERT THE RUN NUMBER IF THERE IS MORE THAN ONE RUN, * 00067660
C AND WILL CENTER THE VARIABLES FOR A PRINT AND THE * 00067670
C INDEPENDENT VARIABLE ON A PLOT. * 00067680
C * 00067690
C***************************************************************** 00067700
REAL*8 RMIN,RMAX,LITBL(1024) 00067710
REAL*8 LOW(11),HIGH(11) 00067720
INTEGER PTRS(45),TITLE(120),CRSET(39),OPER(9),SYM(15), 00067730
1SUBSC(6),TYPCT(20),EQCHN(80),TOKEN(80),CARD1(80),CARD2(80), 00067740
2ERROR(80),OBJCD(160),DEF(80),XREF(80),TMAP(80),FCTN(5,22), 00067750
3SYMTB(5,512) 00067760
INTEGER OUTPT(240),VARCT,TYPE,RUNNO,FLAG(11), 00067770
1CHAR(10),RUN(11),VNUM(11),VNAM(8,11),CFLAG 00067780
INTEGER CLNUM,XCHAR,DOT,BLANK,CHARS,MOVES,XPOS,XPOS1 00067790
COMMON RMIN,RMAX,PTRS,TITLE,CRSET,OPER,SYM,SUBSC,TYPCT, 00067800
1EQCHN,TOKEN,CARD1,CARD2,ERROR,OBJCD,DEF,XREF,TMAP,FCTN, 00067810
2SYMTB,LITBL 00067820
EQUIVALENCE (OUTPT(1),DEF(1),VARCT),(OUTPT(2),TYPE), 00067830
1(OUTPT(3),RUNNO),(OUTPT(103),LOW(1)),(OUTPT(125),HIGH(1)), 00067840
2(OUTPT(147),FLAG(1)),(OUTPT(179),RUN(1)),(OUTPT(200),CFLAG), 00067850
3(OUTPT(190),CHAR(1)),(OUTPT(92),VNUM(1)) 00067860
EQUIVALENCE (OUTPT(4),VNAM(1,1)),(DOT,OPER(1)), 00067870
1(BLANK,CRSET(1)) 00067880
C***************************************************************** 00067890
C * 00067900
C THE FIRST VARIABLE PROCESSED IS THE INDEPENDENT VARIABLE. * 00067910
C * 00067920
C***************************************************************** 00067930
DO 800 CLNUM = 1, VARCT 00067940
C***************************************************************** 00067950
C * 00067960
C EXTEND THE VARIABLE NAME LENGTH FROM 6 TO 8. * 00067970
C * 00067980
C***************************************************************** 00067990
VNAM(7,CLNUM) = BLANK 00068000
VNAM(8,CLNUM) = BLANK 00068010
C***************************************************************** 00068020
C * 00068030
C LOCATE THE END OF THE VARIABLE NAME BY FINDING THE FIRST * 00068040
C BLANK. * 00068050
C * 00068060
C***************************************************************** 00068070
DO 200 XCHAR = 1, 8 00068080
IF (VNAM(XCHAR,CLNUM) .EQ. BLANK) GO TO 300 00068090
200 CONTINUE 00068100
C***************************************************************** 00068110
C * 00068120
C IF THERE IS MORE THAN ONE RUN, INSERT THE RUN NUMBER. * 00068130
C * 00068140
C***************************************************************** 00068150
300 IF (RUNNO .EQ. 1 .OR. VNUM(CLNUM) .EQ. 12)GO TO 400 00068160
VNAM(XCHAR,CLNUM) = DOT 00068170
XPOS = RUN(CLNUM) + 30 00068180
VNAM(XCHAR+1,CLNUM) = CRSET(XPOS) 00068190
XCHAR = XCHAR + 2 00068200
C***************************************************************** 00068210
C * 00068220
C IF A PRINT VARIABLE OR THE PLOT'S INDEPENDENT VARIABLE, * 00068230
C CENTER THE VARIABLE NAME FIELD. * 00068240
C * 00068250
C***************************************************************** 00068260
400 IF (TYPE .EQ. 13 .AND. CLNUM .GT. 1) GO TO 800 00068270
MOVES = 4 - XCHAR/2 00068280
IF (MOVES .EQ. 0) GO TO 800 00068290
CHARS = XCHAR - 1 00068300
DO 500 XCHAR = 1, CHARS 00068310
XPOS = CHARS - XCHAR + 1 00068320
XPOS1 = XPOS + MOVES 00068330
500 VNAM(XPOS1,CLNUM) = VNAM(XPOS,CLNUM) 00068340
DO 600 XCHAR = 1, MOVES 00068350
600 VNAM(XCHAR,CLNUM) = BLANK 00068360
800 CONTINUE 00068370
RETURN 00068380
END 00068400
C***************************************************************** 00068410
C * 00068420
C COPYRIGHT (C) 1978 - UNIVERSITY OF NOTRE DAME * 00068430
C PROGRAM AUTHOR - TIMOTHY J. MALLOY * 00068440
C * 00068450
C***************************************************************** 00068460
SUBROUTINE NDT55 00068470
C***************************************************************** 00068480
C * 00068490
C * 00068500
C NOTE CARD PROCESSOR * 00068510
C * 00068520
C * 00068530
C THIS PROGRAM, CALLED BY THE CONTEXT ANALYSIS ROUTINE, * 00068540
C SETS UP THE NOTE INFORMATION FROM A NOTE CARD FOR * 00068550
C POSSIBLE USE ON AN OUTPUT CARD AS A SUBTITLE. * 00068560
C * 00068570
C***************************************************************** 00068580
REAL*8 RMIN,RMAX,LITBL(1024) 00068590
INTEGER PTRS(45),TITLE(120),CRSET(39),OPER(9),SYM(15), 00068600
1SUBSC(6),TYPCT(20),EQCHN(80),TOKEN(80),CARD1(80),CARD2(80), 00068610
2ERROR(80),OBJCD(160),DEF(80),XREF(80),TMAP(80),FCTN(5,22), 00068620
3SYMTB(5,512) 00068630
INTEGER NOTBT,NOTE(40),BLANK,XCHAR,XCARD,XNOTE,LNOTE 00068640
EQUIVALENCE (NOTBT,OBJCD(1)),(NOTE(1),OBJCD(2)), 00068650
1(BLANK,CRSET(1)) 00068660
COMMON RMIN,RMAX,PTRS,TITLE,CRSET,OPER,SYM,SUBSC,TYPCT, 00068670
1EQCHN,TOKEN,CARD1,CARD2,ERROR,OBJCD,DEF,XREF,TMAP,FCTN, 00068680
2SYMTB,LITBL 00068690
C***************************************************************** 00068700
C * 00068710
C CHECK FOR A BLANK CARD. IF IT IS, RETURN. * 00068720
C * 00068730
C***************************************************************** 00068740
DO 100 XCHAR = 6, 72 00068750
IF (CARD1(XCHAR) .NE. BLANK) GO TO 200 00068760
100 CONTINUE 00068770
GO TO 400 00068780
C***************************************************************** 00068790
C * 00068800
C SET THE NOTE BIT, AND CALCULATE THE LAST POSITION TO BE * 00068810
C READ ONTO THE NOTE CARD. * 00068820
C * 00068830
C***************************************************************** 00068840
200 NOTBT = 1 00068850
LNOTE = 73 - XCHAR 00068860
IF (LNOTE .GT. 40) LNOTE = 40 00068870
C***************************************************************** 00068880
C * 00068890
C PUT THE INFORMATION FROM CARD1 INTO THE NOTE ARRAY. * 00068900
C * 00068910
C***************************************************************** 00068920
DO 300 XNOTE = 1, LNOTE 00068930
XCARD = XNOTE + XCHAR - 1 00068940
300 NOTE(XNOTE) = CARD1(XCARD) 00068950
C***************************************************************** 00068960
C * 00068970
C RETURN SECTION * 00068980
C * 00068990
C***************************************************************** 00069000
400 RETURN 00069010
END 00069030
C***************************************************************** 00069040
C * 00069050
C COPYRIGHT (C) 1978 - UNIVERSITY OF NOTRE DAME * 00069060
C PROGRAM AUTHOR - TIMOTHY J. MALLOY * 00069070
C * 00069080
C***************************************************************** 00069090
SUBROUTINE NDT56 00069100
C***************************************************************** 00069110
C * 00069120
C * 00069130
C SOURCE/DIAGNOSTIC LISTINGS * 00069140
C * 00069150
C THIS PROGRAM LISTS A SOURCE STATEMENT AND ANY ERROR * 00069160
C MESSAGES FOR IT. * 00069170
C * 00069180
C***************************************************************** 00069190
REAL*8 RMIN,RMAX,LITBL(1024) 00069200
INTEGER PTRS(45),TITLE(120),CRSET(39),OPER(9),SYM(15), 00069210
1SUBSC(6),TYPCT(20),EQCHN(80),TOKEN(80),CARD1(80),CARD2(80), 00069220
2ERROR(80),OBJCD(160),DEF(80),XREF(80),TMAP(80),FCTN(5,22), 00069230
3SYMTB(5,512) 00069240
INTEGER TLIMT,OPTNS,ERRPT,PRNTR,CRSMT,CBIT,BLANK,PLUS, 00069250
1STYPE,EXCHR,LENTH,STMT(4),LINE1,LINE2,XERR,XCARD,XCHAR 00069260
COMMON RMIN,RMAX,PTRS,TITLE,CRSET,OPER,SYM,SUBSC,TYPCT, 00069270
1EQCHN,TOKEN,CARD1,CARD2,ERROR,OBJCD,DEF,XREF,TMAP,FCTN, 00069280
2SYMTB,LITBL 00069290
EQUIVALENCE (TLIMT,PTRS(33)),(OPTNS,PTRS(7)), 00069300
1(ERRPT,ERROR(2)),(PRNTR,PTRS(2)),(CRSMT,TMAP(1)), 00069310
2(CBIT,TOKEN(2)),(BLANK,CRSET(1)),(STYPE,TOKEN(1)), 00069320
3(PLUS,OPER(2)),(EXCHR,PTRS(39)) 00069330
C***************************************************************** 00069340
C * 00069350
C THE SOURCE WILL NOT BE LISTED UNLESS THE SOURCE OPTION * 00069360
C IS IN EFFECT OR THERE IS AN ERROR ON THE CURRENT CARD. * 00069370
C * 00069380
C***************************************************************** 00069390
IF (MOD(OPTNS/1024,2) .EQ. 1 .AND. ERRPT .EQ. 2) GO TO 600 00069400
C***************************************************************** 00069410
C * 00069420
C COMPUTE THE LENGTH OF THE OUTPUT LINE. (THIS INHIBITS * 00069430
C THE PRINTING OF THE LINE NUMBERS FOR NARROW OUTPUT.) * 00069440
C * 00069450
C CALLING NDT45 SETS UP THE CURRENT STATEMENT NUMBER * 00069460
C TO BE OUTPUTTED. * 00069470
C * 00069480
C***************************************************************** 00069490
LENTH = TLIMT 00069500
IF (LENTH .GT. 80) LENTH = 80 00069510
CALL NDT45(CRSMT,STMT,1) 00069520
C***************************************************************** 00069530
C * 00069540
C CALCULATE THE NUMBER OF LINES OF OUTPUT BY CHECKING FOR * 00069550
C ERRORS ON THIS CARD AND ITS CONTINUATION. * 00069560
C * 00069570
C***************************************************************** 00069580
LINE1 = 1 00069590
LINE2 = 1 00069600
IF (ERRPT .EQ. 2) GO TO 300 00069610
DO 200 XERR = 3, ERRPT, 2 00069620
IF (MOD(ERROR(XERR),2) .EQ. 0) GO TO 100 00069630
LINE2 = 2 00069640
GO TO 200 00069650
100 LINE1 = 2 00069660
200 CONTINUE 00069670
C***************************************************************** 00069680
C * 00069690
C WRITE OUT THE SOURCE STATEMENT, FIRST CHECKING FOR THE * 00069700
C END OF PAGE. * 00069710
C * 00069720
C***************************************************************** 00069730
300 CALL NDT57(LINE1) 00069740
WRITE (PRNTR,400) STMT,EXCHR,(CARD1(XCHAR),XCHAR=1,LENTH) 00069750
400 FORMAT (5X,5A1,1X,80A1) 00069760
C***************************************************************** 00069770
C * 00069780
C IF THERE ARE ANY ERRORS ON THE FIRST CARD, CALL NDT60 * 00069790
C TO PRINT OUT THE ERROR MESSAGES. * 00069800
C * 00069810
C***************************************************************** 00069820
IF (LINE1 .EQ. 2) CALL NDT60(0) 00069830
C***************************************************************** 00069840
C * 00069850
C PRINT OUT THE CONTINUATION CARD IF THERE IS ONE. * 00069860
C * 00069870
C***************************************************************** 00069880
IF (CBIT .EQ. 0) GO TO 600 00069890
CALL NDT57(LINE2) 00069900
WRITE (PRNTR,500) EXCHR,(CARD2(XCHAR),XCHAR=1,LENTH) 00069910
500 FORMAT(9X,A1,1X,80A1) 00069920
C***************************************************************** 00069930
C * 00069940
C IF THERE ARE ERRORS ON THE CONTINUATION CARD, PRINT * 00069950
C THEM OUT BY CALLING NDT60. * 00069960
C * 00069970
C***************************************************************** 00069980
IF (LINE2 .EQ. 2) CALL NDT60(1) 00069990
C***************************************************************** 00070000
C * 00070010
C EXCHR IS THE EXPANSION CHARACTER. IT IS INITIALIZED * 00070020
C TO BLANK. DURING A MACRO EXPANSION, IT IS A PLUS SIGN. * 00070030
C * 00070040
C***************************************************************** 00070050
600 IF (STYPE .EQ. 17) EXCHR = PLUS 00070060
IF (STYPE .EQ. 16) EXCHR = BLANK 00070070
RETURN 00070080
END 00070100
C COPYRIGHT (C) 1978 - UNIVERSITY OF NOTRE DAME 00070110
C PROGRAM AUTHOR - DANIEL A. POYDENCE 00070120
C 00070130
C 00070140
SUBROUTINE NDT57 (LINES) 00070150
C 00070160
C 00070170
C NDT57 MONITORS THE NUMBER OF OUTPUT LINES WRITTEN TO THE 00070180
C PRINTER OR OUTPUT DEVICE AND CAUSES PAGING WHEN THE NUMBER 00070190
C OF LINES THAT ARE WAITING TO BE WRITTEN WILL CAUSE PAGE 00070200
C OVERFLOW. 00070210
C 00070220
C THE ONLY ARGUMENT IS THE NUMBER OF LINES THAT ARE WAITING 00070230
C TO PRINT. 00070240
C 00070250
C 00070260
REAL*8 RMIN,RMAX,LITBL(1024) 00070270
INTEGER PTRS(45),TITLE(120),CRSET(39),OPER(9),SYM(15), 00070280
1SUBSC(6),TYPCT(20),EQCHN(80),TOKEN(80),CARD1(80),CARD2(80), 00070290
2ERROR(80),OBJCD(160),DEF(80),XREF(80),TMAP(80),FCTN(5,22), 00070300
3SYMTB(5,512) 00070310
INTEGER LINCT,LINES,LINPP,PAGCT,PRNTR,I,TLIMT,DGMSG,PGMCD 00070320
COMMON RMIN,RMAX,PTRS,TITLE,CRSET,OPER,SYM,SUBSC,TYPCT, 00070330
1EQCHN,TOKEN,CARD1,CARD2,ERROR,OBJCD,DEF,XREF,TMAP,FCTN, 00070340
2SYMTB,LITBL 00070350
EQUIVALENCE (LINCT,PTRS(5)),(LINPP,PTRS(6)),(PAGCT,PTRS(4)), 00070360
1(PRNTR,PTRS(2)),(TLIMT,PTRS(33)),(DGMSG,PTRS(41)),(PGMCD, 00070370
2PTRS(15)) 00070380
C 00070390
C 00070400
C IF LINCT IS NEGATIVE THEN PAGING IS FORCED. UPDATE THE NUMBER 00070410
C OF LINES OF OUTPUT FOR THIS PAGE AND SKIP TO A NEW PAGE IN THE 00070420
C EVENT OF PAGE OVERFLOW. IF OVERFLOW DID NOT OCCUR RETURN. 00070430
C 00070440
C 00070450
IF(LINCT.LT.0) GO TO 100 00070460
LINCT=LINCT+LINES 00070470
IF(LINCT.LT.LINPP) GO TO 300 00070480
C 00070490
C 00070500
C INCREMENT PAGCT AND PLACE IT LEFT JUSTIFIED IN THE TITLE 00070510
C BUFFER, SKIP TO A NEW PAGE, PRINT OUT THE TITLE, AND 00070520
C SKIP ONE LINE. 00070530
C 00070540
C 00070550
100 LINCT=LINES+2 00070560
PAGCT=PAGCT+1 00070570
CALL NDT45 (PAGCT,TITLE(6),0) 00070580
WRITE(PRNTR,200) (TITLE(I),I=1,TLIMT) 00070590
200 FORMAT('1',120A1) 00070600
WRITE(PRNTR,201) 00070610
201 FORMAT(1X) 00070620
C 00070630
C 00070640
C IF NOSOURCE WAS SPECIFIED AND DIAGNOSTICS HAVE OCCURRED THEN 00070650
C THE DIAGNOSTIC HEADER SHOULD BE PRINTED AT THE TOP OF THE 00070660
C FIRST PAGE OF MESSAGES. 00070670
C 00070680
C 00070690
IF(DGMSG.EQ.1.OR.DGMSG.EQ.0.AND.PGMCD.EQ.0) GO TO 300 00070700
DGMSG=1 00070710
LINCT=LINCT+2 00070720
WRITE(PRNTR,400) 00070730
400 FORMAT(5X,'* * * * * D I A G N O S T I C S * * * * *'/) 00070740
300 RETURN 00070750
END 00070770
C***************************************************************** 00070780
C * 00070790
C COPYRIGHT (C) 1978 - UNIVERSITY OF NOTRE DAME * 00070800
C PROGRAM AUTHOR - THOMAS L EVERMAN JR * 00070810
C * 00070820
C THIS PROGRAM BUILDS THE CROSS REFERENCE BUFFER. * 00070830
C * 00070840
C***************************************************************** 00070850
SUBROUTINE NDT58 (SYMPT) 00070860
REAL*8 RMIN,RMAX,LITBL(1024) 00070870
INTEGER PTRS(45),TITLE(120),CRSET(39),OPER(9),SYM(15), 00070880
1SUBSC(6),TYPCT(20),EQCHN(80),TOKEN(80),CARD1(80),CARD2(80), 00070890
2ERROR(80),OBJCD(160),DEF(80),XREF(80),TMAP(80),FCTN(5,22), 00070900
3SYMTB(5,512) 00070910
INTEGER RECNO,XRFND,DSKND,CRSMT,REFPT,RFCPT,DISK,RFDEF,I, 00070920
1 REC,SYMPT 00070930
COMMON RMIN,RMAX,PTRS,TITLE,CRSET,OPER,SYM,SUBSC,TYPCT, 00070940
1EQCHN,TOKEN,CARD1,CARD2,ERROR,OBJCD,DEF,XREF,TMAP,FCTN, 00070950
2SYMTB,LITBL 00070960
EQUIVALENCE (RECNO,SYM(15)),(XRFND,PTRS(16)),(DSKND,PTRS(25)), 00070970
1(CRSMT,TMAP(1)),(REFPT,XREF(1)),(RFCPT,XREF(2)), 00070980
2(RFDEF,XREF(3)),(DISK,PTRS(3)) 00070990
C***************************************************************** 00071000
C * 00071010
C MAKE SURE VARIABLE HAS A CROSS-REFERENCE RECORD, THEN READ * 00071020
C THE RECORD. CHECK TO SEE WHETHER THE STATEMENT NUMBER IS * 00071030
C ALREADY CONTAINED IN THE RECORD BY EXAMINING THE DEFINITION* 00071040
C WORD AND THE LAST NUMBER ENTERED INTO THE XREF BUFFER. * 00071050
C * 00071060
C***************************************************************** 00071070
IF (RECNO .NE. 0) GO TO 50 00071080
XRFND = XRFND + 1 00071090
IF(XRFND .GT. DSKND) CALL NDT12 (7) 00071100
REFPT = 3 00071110
RFCPT = 0 00071120
RFDEF = 0 00071130
RECNO = XRFND - 7 00071140
REC = XRFND 00071150
CALL NDT40 (SYMTB(1,SYMPT)) 00071160
GO TO 150 00071170
50 REC = RECNO + 7 00071180
100 READ (DISK'REC) XREF 00071190
IF (CRSMT .EQ. RFDEF .OR. CRSMT .EQ. XREF(REFPT)) GO TO 500 00071200
C***************************************************************** 00071210
C * 00071220
C CHECK TO SEE IF BUFFER IS FULL. IF IT IS NOT FULL, * 00071230
C INCREMENT THE POINTER, ENTER THE CURRENT STATEMENT NUMBER, * 00071240
C AND REWRITE THE XREF BUFFER TO THE DISK FILE. * 00071250
C * 00071260
C***************************************************************** 00071270
IF (REFPT .EQ. 80) GO TO 200 00071280
150 REFPT = REFPT + 1 00071290
XREF(REFPT) = CRSMT 00071300
WRITE (DISK'REC) XREF 00071310
GO TO 500 00071320
C***************************************************************** 00071330
C * 00071340
C DETERMINE WHETHER A CONTINUATION RECORD ALREADY EXISTS. * 00071350
C IF NO CONTINUATION EXISTS, ALLOCATE A NEW DISK RECORD * 00071360
C AND INITIALIZE THE NEW XREF BUFFER AND WRITE IT TO THE FILE* 00071370
C REWRITE THE OLD RECORD WITH THE ADDED CONTINUATION POINTER.* 00071380
C * 00071390
C***************************************************************** 00071400
200 IF (RFCPT .NE. 0) GO TO 400 00071410
XRFND = XRFND + 1 00071420
IF (XRFND .GT. DSKND) CALL NDT12 (7) 00071430
RFCPT = XRFND 00071440
WRITE (DISK'REC) XREF 00071450
DO 300 I = 1, 80 00071460
300 XREF(I) = 0 00071470
REFPT = 3 00071480
RFDEF = CRSMT 00071490
WRITE (DISK'XRFND) XREF 00071500
GO TO 500 00071510
C***************************************************************** 00071520
C * 00071530
C A CONTINUATION RECORD ALREADY EXISTS. READ IT IN USING THE* 00071540
C POINTER FROM THE INITIAL RECORD. SET REC AND PROCESS THE * 00071550
C CONTINUATION LIKE A NORMAL RECORD. * 00071560
C * 00071570
C***************************************************************** 00071580
400 REC = RFCPT 00071590
GO TO 100 00071600
500 RETURN 00071610
END 00071630
C***************************************************************** 00071640
C * 00071650
C COPYRIGHT (C) 1978 - UNIVERSITY OF NOTRE DAME * 00071660
C PROGRAM AUTHOR - TIMOTHY J. MALLOY * 00071670
C * 00071680
C***************************************************************** 00071690
SUBROUTINE NDT59 00071700
C***************************************************************** 00071710
C * 00071720
C * 00071730
C TITLE COMPLEMENTER * 00071740
C * 00071750
C THIS PROGRAM COMPLETES THE TITLE BUFFER, INSERTING THE * 00071760
C COPYRIGHT INFORMATION, AND SETS TPNT. * 00071770
C * 00071780
C THIS PROGRAM ALSO MAKES SURE THE SOURCE OPTION IS IN * 00071790
C EFFECT IF THE DOCUMENT OPTION IS. * 00071800
C * 00071810
C***************************************************************** 00071820
REAL*8 RMIN,RMAX,LITBL(1024) 00071830
INTEGER PTRS(45),TITLE(120),CRSET(39),OPER(9),SYM(15), 00071840
1SUBSC(6),TYPCT(20),EQCHN(80),TOKEN(80),CARD1(80),CARD2(80), 00071850
2ERROR(80),OBJCD(160),DEF(80),XREF(80),TMAP(80),FCTN(5,22), 00071860
3SYMTB(5,512) 00071870
INTEGER OPTNS,TPNT,NARO,RIGHT(14),XCOPY,XTITL,TLIMT 00071880
COMMON RMIN,RMAX,PTRS,TITLE,CRSET,OPER,SYM,SUBSC,TYPCT, 00071890
1EQCHN,TOKEN,CARD1,CARD2,ERROR,OBJCD,DEF,XREF,TMAP,FCTN, 00071900
2SYMTB,LITBL 00071910
EQUIVALENCE (OPTNS,PTRS(7)),(TLIMT,PTRS(33)), 00071920
1(TPNT,PTRS(30)) 00071930
DATA RIGHT /' ',' ','(','C',')',' ','1','9','7','8', 00071940
1 ' ','U','N','D'/ 00071950
C***************************************************************** 00071960
C * 00071970
C DETERMINE THE LENGTH OF THE OUTPUT, WIDE OR NARROW. * 00071980
C SET TPNT TO THE LAST WORD USED IN THE TITLE. * 00071990
C * 00072000
C***************************************************************** 00072010
NARO = MOD(OPTNS/8,2) 00072020
TLIMT = 120 - NARO*48 00072030
IF (TPNT .GT. TLIMT-14) TPNT = TLIMT - 14 00072040
C***************************************************************** 00072050
C * 00072060
C PUT THE COPYRIGHT INFORMATION INTO THE TITLE BUFFER. * 00072070
C * 00072080
C***************************************************************** 00072090
DO 100 XCOPY = 1, 14 00072100
XTITL = TLIMT - 14 + XCOPY 00072110
100 TITLE(XTITL) = RIGHT(XCOPY) 00072120
C***************************************************************** 00072130
C * 00072140
C IF DOCUMENT AND NOSOURCE WERE SPECIFIED, SET SOURCE. * 00072150
C * 00072160
C***************************************************************** 00072170
IF (MOD(OPTNS/1024,2).EQ.1 .AND. MOD(OPTNS/4,2).EQ.1) 00072180
1 OPTNS = OPTNS - 1024 00072190
RETURN 00072200
END 00072220
C***************************************************************** 00072230
C * 00072240
C COPYRIGHT (C) 1978 - UNIVERSITY OF NOTRE DAME * 00072250
C PROGRAM AUTHOR - TIMOTHY J. MALLOY * 00072260
C * 00072270
C***************************************************************** 00072280
SUBROUTINE NDT60(CARD) 00072290
C***************************************************************** 00072300
C * 00072310
C * 00072320
C ERROR MESSAGE PRINTING * 00072330
C * 00072340
C THIS IS CALLED ONLY WHEN THERE IS AN ERROR ON THE CURRENT * 00072350
C CARD, BY THE SOURCE LISTING ROUTINE. IT WILL GATHER AND * 00072360
C PRINT OUT THE ERROR INFORMATION. * 00072370
C * 00072380
C***************************************************************** 00072390
REAL*8 RMIN,RMAX,LITBL(1024) 00072400
REAL ERMSG(4,3) 00072410
INTEGER PTRS(45),TITLE(120),CRSET(39),OPER(9),SYM(15), 00072420
1SUBSC(6),TYPCT(20),EQCHN(80),TOKEN(80),CARD1(80),CARD2(80), 00072430
2ERROR(80),OBJCD(160),DEF(80),XREF(80),TMAP(80),FCTN(5,22), 00072440
3SYMTB(5,512) 00072450
INTEGER CARD 00072460
INTEGER ERRPT,PRNTR,BLANK,DSIGN 00072470
INTEGER ERFLG(80),XERR,ERRCT,ERPOS,ERNUM,SEVER 00072480
COMMON RMIN,RMAX,PTRS,TITLE,CRSET,OPER,SYM,SUBSC,TYPCT, 00072490
1EQCHN,TOKEN,CARD1,CARD2,ERROR,OBJCD,DEF,XREF,TMAP,FCTN, 00072500
2SYMTB,LITBL 00072510
EQUIVALENCE (ERRPT,ERROR(2)),(PRNTR,PTRS(2)), 00072520
1(BLANK,CRSET(1)),(DSIGN,CRSET(2)) 00072530
DATA ERMSG /' W A',' R N',' I N',' G',' ','E R','R O','R', 00072540
1'C R','I T','I C','A L'/ 00072550
C***************************************************************** 00072560
C * 00072570
C ERFLG IS THE ARRAY THAT WILL HOLD THE POINTERS TO THE * 00072580
C ERROR POSITION ON THE CARD. * 00072590
C * 00072600
C FIRST, BLANK IT OUT. * 00072610
C * 00072620
C***************************************************************** 00072630
DO 100 XERR = 1, 80 00072640
100 ERFLG(XERR) = BLANK 00072650
C***************************************************************** 00072660
C * 00072670
C SEARCH THROUGH THE ERROR ARRAY, AND IF THE ERROR IS ON * 00072680
C THIS CARD (IT COULD BE ON A CONTINUATION CARD), NOTE * 00072690
C ITS POSITION, AND SET ERFLG ACCORDINGLY. * 00072700
C * 00072710
C***************************************************************** 00072720
DO 200 ERRCT = 3, ERRPT, 2 00072730
IF (MOD(ERROR(ERRCT),2) .NE. CARD) GO TO 200 00072740
ERPOS = MOD(ERROR(ERRCT)/8,128) 00072750
IF(ERPOS.NE.0) ERFLG(ERPOS) = DSIGN 00072760
200 CONTINUE 00072770
C***************************************************************** 00072780
C * 00072790
C WRITE OUT THE ERFLG ARRAY. THIS WILL APPEAR DIRECTLY * 00072800
C UNDER THE SOURCE LISTING. NDT57 WAS NOT CALLED FOR * 00072810
C THIS WRITE BECAUSE THE CHECK WAS DONE IN NDT56. * 00072820
C * 00072830
C***************************************************************** 00072840
WRITE (PRNTR,300) ERFLG 00072850
300 FORMAT(11X,80A1) 00072860
C***************************************************************** 00072870
C * 00072880
C NOW CONVERT ERFLG TO HOLD THE ORDINAL POSITIONS OF * 00072890
C THE ERRORS. * 00072900
C * 00072910
C***************************************************************** 00072920
ERNUM = 1 00072930
DO 500 XERR = 1, 80 00072940
IF (ERFLG(XERR) .EQ. BLANK) GO TO 400 00072950
ERFLG(XERR) = ERNUM 00072960
ERNUM = ERNUM + 1 00072970
GO TO 500 00072980
400 ERFLG(XERR) = 0 00072990
500 CONTINUE 00073000
C***************************************************************** 00073010
C * 00073020
C GO THROUGH THE ERROR ARRAY AND PRINT OUT THE ERROR * 00073030
C MESSAGE ASSOCIATED WITH EACH ERROR. * 00073040
C * 00073050
C***************************************************************** 00073060
DO 600 ERRCT = 3, ERRPT, 2 00073070
IF(MOD(ERROR(ERRCT),2).NE.CARD) GO TO 600 00073080
SEVER = MOD(ERROR(ERRCT)/2,4) 00073090
ERPOS = MOD(ERROR(ERRCT)/8,128) 00073100
IF(ERPOS .EQ. 0) ERPOS = 1 00073110
CALL NDT57(1) 00073120
WRITE(PRNTR,700) ERFLG(ERPOS),(ERMSG(XERR,SEVER),XERR=1,4), 00073130
1 ERROR(ERRCT+1) 00073140
600 CONTINUE 00073150
700 FORMAT(11X,I2,') ***** ',4A4,' ***** ND0',I3) 00073160
C***************************************************************** 00073170
C * 00073180
C SKIP ONE LINE AFTER PRINTING ALL ERROR MESSAGES. * 00073190
C * 00073200
C***************************************************************** 00073210
CALL NDT57 (1) 00073220
WRITE(PRNTR,800) 00073230
800 FORMAT(1X) 00073240
C***************************************************************** 00073250
C * 00073260
C RETURN * 00073270
C * 00073280
C***************************************************************** 00073290
RETURN 00073300
END 00073320
C COPYRIGHT 1978 - UNIVERSITY OF NOTRE DAME 00073330
C PROGRAM AUTHOR - GARY PELKEY 00073340
C 00073350
C 00073360
SUBROUTINE NDT61 00073370
C 00073380
C 00073390
C NDT61 DIRECTS PROCESSING OF THE VARIOUS USER DEFINED OPTIONS. 00073400
C IT BEGINS BY ALLOCATING SPACE FOR THE VARIOUS OPTION PROC 00073410
C ESSORS BY WRITTING THE LITERAL TABLE OUT TO DISK. IT THEN 00073420
C SIMPLY CHECKS THE OPTION BITS AND CALLS THE ROUTINES NECESS 00073430
C ARY. A STOP IS ISSUED IF THE NOGO IS IN EFFECT. 00073440
C 00073450
C 00073460
REAL*8 RMIN,RMAX,LITBL(1024) 00073470
INTEGER PTRS(45),TITLE(120),CRSET(39),OPER(9),SYM(15), 00073480
1SUBSC(6),TYPCT(20),EQCHN(80),TOKEN(80),CARD1(80),CARD2(80), 00073490
2ERROR(80),OBJCD(160),DEF(80),XREF(80),TMAP(80),FCTN(5,22), 00073500
3SYMTB(5,512) 00073510
INTEGER DSKCT,XRFND,START,STOP,LITCT,DSKND,DISK,OPTNS,SRTPT 00073520
COMMON RMIN,RMAX,PTRS,TITLE,CRSET,OPER,SYM,SUBSC,TYPCT, 00073530
1EQCHN,TOKEN,CARD1,CARD2,ERROR,OBJCD,DEF,XREF,TMAP,FCTN, 00073540
2SYMTB,LITBL 00073550
EQUIVALENCE (DSKCT,PTRS(24)),(XRFND,PTRS(16)),(LITCT,PTRS(18)) 00073560
EQUIVALENCE (DSKND,PTRS(25)),(DISK,PTRS(3)),(OPTNS,PTRS(7)) 00073570
C 00073580
C 00073590
C THE LITERAL TABLE IS WRITTEN OUT TO DISK. 00073600
C 00073610
C 00073620
DSKCT=XRFND 00073630
START=1 00073640
100 STOP=START+39 00073650
IF(STOP.GT.LITCT) STOP=LITCT 00073660
DSKCT=DSKCT+1 00073670
IF(DSKCT.GT.DSKND) CALL NDT12 (7) 00073680
WRITE(DISK'DSKCT) (LITBL(I),I=START,STOP) 00073690
IF(STOP.EQ.LITCT) GO TO 200 00073700
START=STOP+1 00073710
GO TO 100 00073720
C 00073730
C 00073740
C THE SYMBOL TABLE LISTING PROGRAM AND THE CROSS REFERENCE 00073750
C LISTING PROGRAM BOTH NEED A TAG SORT. NDT76 IS CALLED 00073760
C HERE TO PERFORM THIS SORT IF IT WILL BE NEEDED. 00073770
C 00073780
C 00073790
200 IF(MOD(OPTNS/64,2).EQ.1.OR.MOD(OPTNS/128,2).EQ.1) 00073800
1CALL NDT76 (SRTPT) 00073810
C 00073820
C 00073830
C THE STATS PROCESSOR IS CALLED IF ITS BIT IS MARKED. 00073840
C 00073850
C 00073860
IF(MOD((OPTNS/16),2).EQ.0) CALL NDT66 00073870
C 00073880
C 00073890
C LIKEWISE THE SYMBOL TABLE PROCESSOR, 00073900
C 00073910
C 00073920
IF(MOD(OPTNS/64,2).EQ.1) CALL NDT67 (SRTPT) 00073930
C 00073940
C 00073950
C AND THE CROSS REFERENCE ROUTINE, 00073960
C 00073970
C 00073980
IF(MOD(OPTNS/128,2).EQ.1) CALL NDT68 (SRTPT) 00073990
C 00074000
C 00074010
C AND FINALLY THE SYSTEMS ANALYSIS ROUTINE. 00074020
C 00074030
C 00074040
IF(MOD(OPTNS/2,2).EQ.1) CALL NDT69 00074050
C 00074060
C 00074070
C IF NOGO IS IN EFFECT A STOP IS ISSUED HERE TO ABORT EQUATION 00074080
C SORTING, LOADING, AND EXECUTION. 00074090
C 00074100
C 00074110
IF(MOD(OPTNS/32,2).EQ.1) STOP 00074120
RETURN 00074130
END 00074150
C COPYRIGHT (C) 1978 - UNIVERSITY OF NOTRE DAME 00074160
C PROGRAM AUTHOR - DANIEL A. POYDENCE 00074170
C 00074180
C 00074190
SUBROUTINE NDT62 00074200
C 00074210
C 00074220
C NDT62 TAKES THE SEQUENTIAL CHAIN OF EQUATION ELEMENTS BUILT 00074230
C DURING PASS1 AND ORDERS THEM SO THAT THE LOADER MAY ORDER 00074240
C THE OBJECT CODE PROPERLY. THE ORDERING SCHEME IS AS FOLLOWS: 00074250
C 00074260
C EQUATIONS ARE SORTED BY TYPE: T, C, PARM, N, L, A, R, AND S. 00074270
C AFTER THE SORT BY TYPE CERTAIN EQUATION TYPES REQUIRE FURTHER 00074280
C SORTING. ANY EQUATION WHICH DEFINES A VARIABLE USED TO 00074290
C INITIALIZE A LEVEL MUST BE EVALUATED AT THE STARTING TIME 00074300
C OF THE MODEL. AUXILIARY AND SUPPLEMENTARY EQUATIONS MAY 00074310
C BE DEPENDENT ON VARIABLES WITHIN THEIR OWN TYPES SO THEY 00074320
C MUST BE ORDERED TO ENSURE THAT A VARIABLE IS EVALUATED 00074330
C BEFORE IT IS USED. 00074340
C 00074350
C 00074360
REAL*8 RMIN,RMAX,LITBL(1024) 00074370
REAL STNAM(4,4) 00074380
INTEGER PTRS(45),TITLE(120),CRSET(39),OPER(9),SYM(15), 00074390
1SUBSC(6),TYPCT(20),EQCHN(80),TOKEN(80),CARD1(80),CARD2(80), 00074400
2ERROR(80),OBJCD(160),DEF(80),XREF(80),TMAP(80),FCTN(5,22), 00074410
3SYMTB(5,512) 00074420
INTEGER SYMND,I,VTYPE,RECNO,START,REC,EQNPT,EQEND,DISK,DIST, 00074430
1EQSRT(2048), STOP,FLAG,PNT,PNT2,SAVE,CHNPT,LSTYP,EQNXT, 00074440
2TYPE,STPGM,ACTN(8),SRTPT,LSTPT,IDVPT,SRLST,TOKPT,VNUM, 00074450
3SYMPT,SMFLG,OLDCT,EQNCT,SMEQN(80),SMQPT,BLANK,COMMA, 00074460
4PRNTR,OPTNS,LINCT 00074470
COMMON RMIN,RMAX,PTRS,TITLE,CRSET,OPER,SYM,SUBSC,TYPCT, 00074480
1EQCHN,TOKEN,CARD1,CARD2,ERROR,OBJCD,DEF,XREF,TMAP,FCTN, 00074490
2SYMTB,LITBL 00074500
EQUIVALENCE (SYMND,PTRS(17)),(VTYPE,SYM(7)),(RECNO,SYM(15)), 00074510
1(EQNPT,PTRS(28)),(DISK,PTRS(3)),(EQSRT(1),LITBL(1)), 00074520
2(CHNPT,PTRS(29)),(STPGM,PTRS(21)),(TOKPT,TOKEN(3)), 00074530
3(BLANK,CRSET(1)),(COMMA,OPER(9)),(PRNTR,PTRS(2)), 00074540
4(OPTNS,PTRS(7)),(LINCT,PTRS(5)),(VNUM,SYM(14)) 00074550
DATA ACTN /0,1,0,2,0,1,0,1/ 00074560
DATA STNAM /'CONS','TANT','S:',' ','INIT','IAL','VALU','ES:', 00074570
1'AUXI','LIAR','IES:',' ','SUPP','LEME','NTAR','IES:'/ 00074580
LINCT=-1 00074590
C 00074600
C 00074610
C THE SYMBOL TABLE MUST BE PREPARED FOR EQUATION ORDERING. 00074620
C EACH ENTRY IS UNPACKED AND REFORMATTED: 00074630
C 00074640
C 1:2 - PACKED VARIABLE NAMES 00074650
C 3 - VARIABLE TYPE 00074660
C 4 - THE RECORD NUMBER FOR THE DEFINING EQUATION 00074670
C 5 - DEFINITION WORD 00074680
C 0 - UNDEFINED 00074690
C 1 - DEFINED 00074700
C 00074710
C 00074720
DO 100 I=1,SYMND 00074730
IF(SYMTB(1,I).EQ.32767) GO TO 100 00074740
CALL NDT41 (SYMTB(1,I)) 00074750
SYMTB(3,I)=VTYPE 00074760
IF(VNUM.EQ.12) SYMTB(3,I)=0 00074770
SYMTB(4,I)=RECNO 00074780
100 CONTINUE 00074790
C 00074800
C 00074810
C THE EQUATION CHAIN ELEMENTS ON DISK ARE READ INTO SEQUENTIAL 00074820
C MEMORY LOCATIONS FOR PROCESSING. 00074830
C 00074840
C 00074850
START=1 00074860
DO 300 REC=1,EQNPT 00074870
STOP=START+79 00074880
READ(DISK'REC) (EQSRT(I),I=START,STOP) 00074890
300 START=STOP+1 00074900
C 00074910
C 00074920
C EQEND MUST BE SET TO THE LAST ELEMENT IN THE CHAIN WHICH 00074930
C IS FOLLOWED BY A ZERO. 00074940
C 00074950
C 00074960
START=START-80 00074970
STOP=START+79 00074980
DO 310 EQEND=START,STOP 00074990
IF(EQSRT(EQEND).EQ.0) GO TO 320 00075000
310 CONTINUE 00075010
320 EQEND=EQEND-1 00075020
C 00075030
C 00075040
C THE EQUATION ELEMENTS ARE PACKED SUCH THAT AN INTEGER SORT 00075050
C WILL ARRANGE THEM IN THE DESIRED ORDER BY TYPE AND IN THE 00075060
C ORDER IN WHICH THEY WERE RECEIVED WITHIN TYPE. 00075070
C 00075080
C A 'SHELL-D' SORT IS USED TO PERFORM THE FIRST STEP OF ORDERING. 00075090
C 00075100
C 00075110
DIST=EQEND 00075120
2600 DIST=DIST/2 00075130
IF(DIST.EQ.0) GO TO 3200 00075140
DO 3100 START=1,DIST 00075150
STOP=EQEND-DIST 00075160
FLAG=1 00075170
2700 IF(FLAG.EQ.0) GO TO 3100 00075180
FLAG=0 00075190
DO 3000 PNT=START,STOP,DIST 00075200
PNT2=PNT+DIST 00075210
IF(EQSRT(PNT).LT.EQSRT(PNT2)) GO TO 3000 00075220
SAVE=EQSRT(PNT) 00075230
EQSRT(PNT)=EQSRT(PNT2) 00075240
EQSRT(PNT2)=SAVE 00075250
FLAG=1 00075260
3000 CONTINUE 00075270
GO TO 2700 00075280
3100 CONTINUE 00075290
GO TO 2600 00075300
C 00075310
C 00075320
C THE EQUATION ELEMENTS ARE ORDERED BY TYPE. THEY MUST NOW 00075330
C BE CHAINED IN THE ORDER DESIRED FOR LOADING. 00075340
C 00075350
C INITIALIZE THE DISK RECORD POINTER, EQNPT, AND THE ELEMENT 00075360
C POINTER, CHNPT. LSTYP IS THE EQUATION TYPE OF THE LAST 00075370
C GROUP AND IS INITIALIZED SUCH THAT THE FIRST EQUATION WILL 00075380
C SIGNAL A NEW GROUP. EQNXT IS A POINTER TO THE FIRST EQUATION 00075390
C OF THE NEXT GROUP AND IS INITIALIZED TO THE FIRST EQUATION. 00075400
C 00075410
C 00075420
3200 EQNPT=0 00075430
CHNPT=0 00075440
LSTYP=0 00075450
EQNXT=1 00075460
C 00075470
C 00075480
C IF THE LAST EQUATION HAS BEEN CHAINED THEN STOP PROCESSING. 00075490
C 00075500
C 00075510
3500 IF(EQNXT.GT.EQEND) GO TO 6200 00075520
C 00075530
C 00075540
C BEGIN PROCESSING THE NEXT GROUP. A NEW GROUP IS INDICATED 00075550
C WHEN THE EQUATION TYPE DOES NOT MATCH LSTYP. THE FOLLOWING 00075560
C LOOP CHAINS EQUATIONS IN THE ORDER IN WHICH THEY ARE RECEIVED 00075570
C AS THE ORDER IS ARBITRARY FOR THE GROUP. 00075580
C 00075590
C 00075600
3550 DO 3600 PNT=EQNXT,EQEND 00075610
TYPE=EQSRT(PNT)/4096+1 00075620
IF(TYPE.NE.LSTYP) GO TO 3700 00075630
CALL NDT21 ((MOD(EQSRT(PNT),4096)-1)*9+STPGM) 00075640
3600 CONTINUE 00075650
GO TO 6200 00075660
C 00075670
C 00075680
C A NEW GROUP HAS BEEN INDICATED. SET LSTYP AND ADD AN ELEMENT 00075690
C TO THE CHAIN SO THAT THE LOADER MAY IDENTIFY THE START OF 00075700
C THIS GROUP. SET EQNXT TO POINT TO THE FIRST ELEMENT FOR 00075710
C THE GROUP. 00075720
C 00075730
C 00075740
3700 LSTYP=TYPE 00075750
CALL NDT21 (-TYPE) 00075760
EQNXT=PNT 00075770
C 00075780
C 00075790
C EACH NEW GROUP MUST BE CHECKED FOR A REQUIREMENT FOR FURTHER 00075800
C ORDERING. THE 'ACTN' ARRAY INDICATES THE REQUIREMENTS: 00075810
C 00075820
C 0 - THE ORDERING WITHIN THE GROUP IS ARBITRARY. 00075830
C 1 - THE ELEMENTS OF THE GROUP MUST BE ARRANGED SUCH 00075840
C THAT ALL VARIABLES ARE DEFINED BEFORE USED. 00075850
C 2 - THE ELEMENTS MUST BE ARRANGED AS IN 1 ABOVE AND 00075860
C ELEMENTS MUST BE ADDED TO SOLVE INITIAL VALUES 00075870
C FOR AUXILIARY OR RATE VARIABLES IN N EQUATIONS. 00075880
C 00075890
C 00075900
IF(ACTN(TYPE).EQ.0) GO TO 3550 00075910
C 00075920
C 00075930
C FURTHER ORDERING IS REQUIRED. SRTPT IS THE LAST LOCATION 00075940
C USED IN THE EQSRT ARRAY. THE SYMBOL TABLE IS INITIALIZED 00075950
C TO INDICATE THAT ALL VARIABLES WHOSE TYPE IS LESS THAN THE 00075960
C TYPE OF THE GROUP BEING PROCESSED ARE DEFINED AND ALL OTHERS 00075970
C ARE UNDEFINED. 00075980
C 00075990
C 00076000
SRTPT=EQEND 00076010
DO 3800 I=1,SYMND 00076020
IF(SYMTB(1,I).EQ.32767) GO TO 3800 00076030
SYMTB(5,I)=0 00076040
IF(SYMTB(3,I).LT.TYPE) SYMTB(5,I)=1 00076050
3800 CONTINUE 00076060
C 00076070
C 00076080
C PROCESSING BEGINS WITH THE FOLLOWING LOOP WHICH BUILDS A 00076090
C VARIABLE LENGTH INFORMATION LIST NEEDED FOR PROPER ORDERING. 00076100
C STOP IF A NEW GROUP IS ENCOUNTERED. 00076110
C 00076120
C 00076130
DO 4400 PNT=EQNXT,EQEND 00076140
TYPE=EQSRT(PNT)/4096+1 00076150
IF(TYPE.NE.LSTYP) GO TO 4500 00076160
C 00076170
C 00076180
C INITIALIZE THE REQUIRED POINTERS FOR INITIAL VALUE EQUATIONS. 00076190
C LSTPT IS A POINTER TO THE FIRST LOCATION FOR THE LIST WHICH 00076200
C IS CURRENTLY BEING SCANNED FOR AUXILIARY OR RATE VARIABLES 00076210
C WHOSE INITIAL VALUES MUST BE COMPUTED. IDVPT IS A POINTER 00076220
C TO THE INDEPENDENT VARIABLE BEING EVALUATED IN THE LIST 00076230
C THAT IS BEING SCANNED. 00076240
C 00076250
C 00076260
LSTPT=SRTPT+1 00076270
IDVPT=LSTPT+2 00076280
C 00076290
C 00076300
C THE REQUIRED INFORMATION IS CONTAINED IN THE TOKEN RECORD 00076310
C SO ITS DISK LOCATION IS COMPUTED AND IT IS READ INTO MEMORY. 00076320
C 00076330
C 00076340
REC=(MOD(EQSRT(PNT),4096)-1)*9+STPGM 00076350
3850 READ(DISK'REC) TOKEN 00076360
C 00076370
C 00076380
C THE INFORMATION LISTS CONTAIN: 00076390
C 00076400
C 1 - THE RECORD NUMBER FOR THE EQUATION 00076410
C 2 - A POINTER TO THE LAST LOCATION USED BY THIS LIST. 00076420
C 3 - A SYMBOL TABLE POINTER FOR THE VARIABLE ON THE 00076430
C LEFT OF THE EQUAL SIGN. 00076440
C 4:N - POINTERS TO THE SYMBOL TABLE FOR EACH VARIABLE 00076450
C WHICH MUST BE DEFINED BEFORE THIS EQUATION CAN 00076460
C BE EVALUATED. 00076470
C 00076480
C 00076490
SRTPT=SRTPT+1 00076500
EQSRT(SRTPT)=REC 00076510
C 00076520
C 00076530
C SRLST IS A POINTER TO THE LAST LOCATION USED BY THIS LIST. 00076540
C THE FOLLOWING LOOP PUTS THE SYMBOL TABLE POINTERS INTO THE 00076550
C LIST IF THEY ARE REQUIRED. 00076560
C 00076570
C 00076580
SRLST=SRTPT+1 00076590
DO 4000 PNT2=4,TOKPT 00076600
C 00076610
C 00076620
C ONLY VARIABLES MAY AFFECT THE EQUATION ORDERING. IF A TOKEN 00076630
C IS NOT FOR A VARIABLE THEN NO ENTRY IS MADE FOR IT IN THE LIST. 00076640
C 00076650
C 00076660
IF(TOKEN(PNT2).LT.0.OR.TOKEN(PNT2).GT.20479) GO TO 4000 00076670
C 00076680
C 00076690
C GET THE SYMBOL TABLE POINTER FROM THE TOKEN. IF THE VARIABLE 00076700
C IS ALREADY DEFINED IT DOESN'T NEED TO BE ADDED TO THE LIST. 00076710
C IF THE VARIABLE IS UNDEFINED AND THE ACTION FOR THIS GROUP 00076720
C IS 1 THEN ADD A POINTER TO THE LIST IF THE VARIABLE TYPE MACTHES 00076730
C THE EQUATION TYPE. IF THE VARIABLE IS UNDEFINED AND THE ACTION 00076740
C CODE IS 2 THEN ADD A POINTER TO THE LIST IF THE VARIABLE IS 00076750
C NOT A SUPPLEMENTARY. 00076760
C 00076770
C 00076780
SYMPT=MOD(TOKEN(PNT2),4096)+1 00076790
IF(SYMTB(5,SYMPT).EQ.1) GO TO 4000 00076800
IF(ACTN(TYPE).EQ.1.AND.SYMTB(3,SYMPT).NE.TYPE) GO TO 4000 00076810
IF(ACTN(TYPE).EQ.2.AND.SYMTB(3,SYMPT).EQ.8) GO TO 4000 00076820
SRLST=SRLST+1 00076830
EQSRT(SRLST)=SYMPT 00076840
4000 CONTINUE 00076850
C 00076860
C 00076870
C UNDEFINED EXPLANATORY VARIABLES WERE ENCOUNTERED. UPDATE 00076880
C THE LIST ELEMENT WHICH POINTS TO THE LAST POINTER IN THIS 00076890
C LIST AND UPDATE SRTPT, THE POINTER TO THE LAST LOCATION USED. 00076900
C 00076910
C 00076920
EQSRT(SRTPT+1)=SRLST 00076930
SRTPT=SRLST 00076940
C 00076950
C 00076960
C IF THE ACTION CODE IS 1 THEN NO EQUATIONS NEED TO BE ADDED 00076970
C TO EVALUATE INITIAL CONDITIONS. 00076980
C 00076990
C 00077000
IF(ACTN(TYPE).EQ.1) GO TO 4400 00077010
C 00077020
C 00077030
C THE LIST JUST ADDED MUST BE SCANNED FOR VARIABLES WHOSE INITIAL 00077040
C VALUES NEED TO BE COMPUTED. EACH OF THOSE VARIABLES WILL 00077050
C GENERATE A LIST ENTRY WHICH MUST ALSO BE SCANNED. CHECK THE 00077060
C NEXT INDEPENDENT VARIABLE IN THE LIST CURRENTLY BEING SCANNED. 00077070
C 00077080
C 00077090
4010 IDVPT=IDVPT+1 00077100
C 00077110
C 00077120
C IF ALL INDEPENDENT VARIABLES IN THIS LIST HAVE BEEN CHECKED, 00077130
C START ON THE NEXT LIST. 00077140
C 00077150
C 00077160
IF(IDVPT.GT.EQSRT(LSTPT+1)) GO TO 4020 00077170
C 00077180
C 00077190
C IF THE VARIABLE TYPE IS LESS THAN OR EQUAL TO THE TYPE OF 00077200
C THIS GROUP THEN IT IS DEFINED OR WILL HAVE A LIST ENTRY 00077210
C ADDED FOR IT WHEN IT'S EQUATION IS ENCOUNTERED SO AN ENTRY 00077220
C NEED NOT BE MADE. 00077230
C 00077240
C 00077250
SYMPT=EQSRT(IDVPT) 00077260
IF(SYMTB(3,SYMPT).LE.5) GO TO 4010 00077270
C 00077280
C 00077290
C ANOTHER LIST ENTRY MUST BE ADDED FOR THIS VARIABLE UNLESS 00077300
C A LIST ENTRY ALREADY EXISTS FOR THIS VARIABLE. THE RECORD 00077310
C NUMBER IS COMPARED AGAINST THE RECORD NUMBERS OF THE OTHER 00077320
C LIST ENTRIES. 00077330
C 00077340
C 00077350
REC=SYMTB(4,SYMPT) 00077360
PNT2=EQEND+1 00077370
4030 IF(REC.EQ.EQSRT(PNT2)) GO TO 4010 00077380
PNT2=EQSRT(PNT2+1)+1 00077390
C 00077400
C 00077410
C AFTER CHECKING ALL OF THE LISTS AND FINDING NO MATCH, GO 00077420
C BACK AND ADD A NEW LIST ENTRY. 00077430
C 00077440
C 00077450
IF(PNT2.GT.SRTPT) GO TO 3850 00077460
GO TO 4030 00077470
C 00077480
C 00077490
C THE SCAN FOR THIS LIST IS COMPLETE. UPDATE THE LIST POINTER 00077500
C AND INDEPENDENT VARIABLE POINTER FOR THE NEXT LIST. IF NO 00077510
C LISTS REMAIN FOR SCANNING THEN ALL VARIABLES WILL BE EVALUATED 00077520
C TO SOLVE THE ORIGINAL INITIAL VALUE EQUATION. 00077530
C 00077540
C 00077550
4020 LSTPT=IDVPT 00077560
IDVPT=LSTPT+2 00077570
IF(LSTPT.LT.SRTPT) GO TO 4010 00077580
4400 CONTINUE 00077590
C 00077600
C 00077610
C ALL EQUATIONS FOR THE GROUP HAVE EITHER BEEN CHAINED OR HAVE 00077620
C THE REQUIRED ORDERING INFORMATION IN THE LIST ENTRIES. 00077630
C IF A NEW GROUP WAS NOT ENCOUNTERED THEN SET PNT BEYOND 00077640
C THE END OF THE EQUATION ELEMENTS FOR A LATER TEST. 00077650
C THE FIRST EQUATION OF THE NEXT GROUP IS SAVED. 00077660
C 00077670
C 00077680
PNT=EQEND+1 00077690
4500 EQNXT=PNT 00077700
C 00077710
C 00077720
C IF NO LISTS EXIST THEN ALL EQUATIONS WERE CHAINED SO GO BACK 00077730
C AND PROCESS THE NEXT GROUP OF EQUATIONS. 00077740
C 00077750
C 00077760
IF(SRTPT.EQ.EQEND) GO TO 3500 00077770
C 00077780
C 00077790
C LISTS DO EXIST INDICATING THAT EQUATIONS NEED TO BE ORDERED. 00077800
C INITIALIZE SMFLG, THE SIMULTANEOUS EQUATION FLAG, OLDCT AND 00077810
C EQNCT, THE OLD AND NEW EQUATION COUNTERS. 00077820
C 00077830
C 00077840
SMFLG=0 00077850
OLDCT=0 00077860
5000 EQNCT=0 00077870
C 00077880
C 00077890
C INITIALIZE THE LIST POINTER TO THE FIRST LIST AND BEGIN. 00077900
C 00077910
C 00077920
LSTPT=EQEND+1 00077930
C 00077940
C 00077950
C GET THE STARTING AND STOPPING LOCATIONS FOR THE INDEPENDENT 00077960
C VARIABLES FOR THIS EQUATION. IF THE FIRST WORD IN THE LIST 00077970
C IS A ZERO THEN THE EQUATION HAS ALREADY BEEN DEFINED AND THE 00077980
C LIST ENTRY IS TO BE IGNORED. 00077990
C 00078000
C 00078010
5100 START=LSTPT+3 00078020
STOP=EQSRT(LSTPT+1) 00078030
IF(EQSRT(LSTPT).EQ.0) GO TO 6000 00078040
C 00078050
C 00078060
C THIS EQUATION NEEDS TO BE CHECKED. INCREMENT EQNCT TO KEEP 00078070
C TRACK OF HOW MANY EQUATIONS ARE STILL UNRESOLVED. IF A 00078080
C SIMULTANEOUS CONDITION HAS BEEN DETERMINED THEN LIST THIS 00078090
C EQUATION AND IT'S SIMULTANEOUS VARIABLES. 00078100
C 00078110
C 00078120
EQNCT=EQNCT+1 00078130
IF(SMFLG.EQ.0) GO TO 5700 00078140
C 00078150
C 00078160
C PUT THE EQUATION NUMBER INTO THE SMEQN PRINT BUFFER AND SET 00078170
C THE BUFFER POINTER, SMQPT, TO THE LAST LOCATION USED. 00078180
C 00078190
CALL NDT45 ((EQSRT(LSTPT)-STPGM)/9+1,SMEQN(1),1) 00078200
SMQPT=4 00078210
C 00078220
C 00078230
C COPY THE SIMULTANEOUS VARIABLES INTO THE SMEQN BUFFER. 00078240
C 00078250
C 00078260
DO 5400 PNT=START,STOP 00078270
SYMPT=EQSRT(PNT) 00078280
IF(SYMTB(5,SYMPT).EQ.1) GO TO 5400 00078290
CALL NDT41 (SYMTB(1,SYMPT)) 00078300
DO 5200 I=1,6 00078310
IF(SYM(I).EQ.BLANK) GO TO 5300 00078320
SMQPT=SMQPT+1 00078330
5200 SMEQN(SMQPT)=SYM(I) 00078340
5300 SMQPT=SMQPT+1 00078350
SMEQN(SMQPT)=COMMA 00078360
5400 CONTINUE 00078370
C 00078380
C 00078390
C BLANK OUT THE REMAINING BUFFER LOCATIONS AND WRITE THE BUFFER 00078400
C TO THE PRINTER. 00078410
C 00078420
C 00078430
5500 DO 5600 I=SMQPT,80 00078440
5600 SMEQN(I)=BLANK 00078450
CALL NDT57 (1) 00078460
WRITE(PRNTR,5650) SMEQN 00078470
5650 FORMAT(3X,4A1,12X,76A1) 00078480
GO TO 6000 00078490
C 00078500
C 00078510
C EXAMINE ALL OF THE INDEPENDENT VARIABLES. IF ANY OF THEM ARE 00078520
C STILL UNDEFINED THEN THE EQUATION CANNOT BE CHAINED. IF THERE 00078530
C ARE NO UNRESOLVED INDEPENDENT VARIABLES TO BEGIN WITH THEN 00078540
C THE EQUATION MAY BE IMMEDIATELY CHAINED. 00078550
C 00078560
C 00078570
5700 IF(START.GT.STOP) GO TO 5900 00078580
DO 5800 I=START,STOP 00078590
PNT=EQSRT(I) 00078600
IF(SYMTB(5,PNT).EQ.0) GO TO 6000 00078610
5800 CONTINUE 00078620
C 00078630
C 00078640
C ALL OF THE INDEPENDENT VARIABLES WERE DEFINED. THE EQUATION 00078650
C MAY BE CHAINED AND IT'S LIST ENTRY MARKED NOT IN USE. THE 00078660
C DEPENDENT VARIABLE MAY BE MARKED DEFINED. 00078670
C 00078680
C 00078690
5900 CALL NDT21 (EQSRT(LSTPT)) 00078700
EQSRT(LSTPT)=0 00078710
SYMPT=EQSRT(LSTPT+2) 00078720
SYMTB(5,SYMPT)=1 00078730
C 00078740
C 00078750
C GET THE NEXT LIST ENTRY AND EXAMINE IT'S VARIABLES. IF ALL 00078760
C LISTS HAVE BEEN EXAMINED, CHECK FOR SIMULTANEOUS CONDITIONS. 00078770
C SIMULTANEOUS EQUATIONS EXIST IF AFTER EXAMINING ALL OF THE 00078780
C LISTS NO EQUATIONS COULD BE RESOLVED. THIS IS DETERMINED 00078790
C BY COMPARING THE NUMBER OF EQUATIONS IN THE LIST WITH THE 00078800
C NUMBER IN THE LIST BEFORE THE LAST PASS. IF ALL EQUATIONS 00078810
C HAVE BEEN RESOLVED OR THE SIMULTANEOUS CONDITION HAS ALREADY 00078820
C BEEN REPORTED, GO BACK AND PROCESS THE NEXT GROUP. 00078830
C 00078840
C 00078850
6000 LSTPT=STOP+1 00078860
IF(LSTPT.LT.SRTPT) GO TO 5100 00078870
IF(EQNCT.EQ.0.OR.SMFLG.NE.0) GO TO 3500 00078880
IF(EQNCT.NE.OLDCT) GO TO 6100 00078890
C 00078900
C 00078910
C SIMULTANEOUS EQUATIONS EXIST. REPORT THIS CONDITION, SET 00078920
C SMFLG, AND FORCE THE NOGO OPTION IF GO WAS IN EFFECT. 00078930
C 00078940
C 00078950
PNT=LSTYP/2 00078960
CALL NDT57 (5) 00078970
WRITE(PRNTR,6010) (STNAM(I,PNT),I=1,4) 00078980
6010 FORMAT(/' SIMULTANEOUS EQUATIONS HAVE BEEN DETECTED IN THE ', 00078990
14A4,//' EQUATION',10X,'SIMULTANEOUS VARIABLES'/) 00079000
SMFLG=1 00079010
IF(MOD(OPTNS/32,2).EQ.0) OPTNS=OPTNS+32 00079020
C 00079030
C 00079040
C ANOTHER PASS IS REQUIRED. SAVE THE EQUATION COUNT AND 00079050
C GO BACK FOR ANOTHER PASS. 00079060
C 00079070
C 00079080
6100 OLDCT=EQNCT 00079090
GO TO 5000 00079100
C 00079110
C 00079120
C ALL EQUATIONS FOR ALL GROUPS HAVE BEEN PROCESSED. SIGNAL 00079130
C NDT21 TO STOP CHAINING AND SAVE THE LAST BUFFER TO DISK. 00079140
C 00079150
C 00079160
6200 CALL NDT21 (0) 00079170
C 00079180
C 00079190
C IF SIMULTANEOUS EQUATIONS DID OCCUR THEN WE CAN PROCEED 00079200
C NO FURTHER, SO TERMINATE PROCESSING. 00079210
C 00079220
C 00079230
IF(MOD(OPTNS/32,2).EQ.1) STOP 00079240
RETURN 00079250
END 00079270
C COPYRIGHT 1978 - UNIVERSITY OF NOTRE DAME 00079280
C PROGRAM AUTHOR - GARY PELKEY 00079290
C 00079300
C 00079310
SUBROUTINE NDT63 (PRFLG,PLFLG) 00079320
C 00079330
C 00079340
C THIS ROUTINE UPDATES OUTPUT DATA FOR PRINT OR PLOT CARDS 00079350
C WHEN CALLED BY NDT64 OR NDT65. 00079360
C 00079370
C 00079380
REAL*8 CMPAR,RMIN,RMAX,VAR(5000), ACCUM,EXTME,RSTME(10) 00079390
INTEGER PTRS(45),TITLE(120),CRSET(39),OPER(9),SYM(15), 00079400
1SUBSC(6),OUTPT(240),LINE(120),OBJCD(6000) 00079410
INTEGER PRFLG,OUTCT,PLFLG,END,OAB,I,FLOC,TYPE,LOWRN, 00079420
1RUNCT,VPOS,BUFPT,VNUM,SUBHI,FRONT,VARCT,HIPNT,COUNT,HERE, 00079430
2THERE,REC,DISK,J,OCCUR,DSKND 00079440
COMMON RMIN,RMAX,PTRS,TITLE,CRSET,OPER,SYM,SUBSC,OUTPT,LINE, 00079450
1EXTME,RSTME,ACCUM,VAR 00079460
EQUIVALENCE(VAR(1),OBJCD(1)),(OUTCT,PTRS(10)), 00079470
1(OAB,PTRS(12)),(RUNCT,PTRS(14)),(DISK,PTRS(3)),(DSKND,PTRS(25)) 00079480
C 00079490
C 00079500
C THE MAJOR LOOP IS ONE WHICH CHECKS ALL THE DATA BUFFERS 00079510
C AND SKIPS PROCESSING OF THE ONES WHOSE OUTPUT UPDATE IS 00079520
C NOT REQUESTED. THIS IS DONE BY COMPARING THE FIRST WORD 00079530
C OF EACH DATA BUFFER (TYPE) WITH THE INCOMING ARGUMENTS. 00079540
C 00079550
C 00079560
END=OAB+OUTCT-1 00079570
DO 1000 I=OAB,END 00079580
FLOC=OBJCD(I) 00079590
TYPE=OBJCD(FLOC) 00079600
IF((TYPE.EQ.12.AND.PRFLG.EQ.0).OR.(TYPE.EQ.13.AND.PLFLG.EQ.0)) 00079610
1GO TO 1000 00079620
C 00079630
C 00079640
C PROCESSING FOR A SINGLE DATA BUFFER IS READY. HOWEVER, 00079650
C PROCESSING IS COMPLETELY SKIPPED IF NONE OF THE VARIABLE'S 00079660
C RUN SUBSCRIPTS MATCH THE CURRENT RUNCT. 00079670
C 00079680
C 00079690
OCCUR=OBJCD(FLOC+3) 00079700
IF(MOD(OCCUR/2**(RUNCT-1),2).EQ.0) GO TO 1000 00079710
VARCT=OBJCD(FLOC+1) 00079720
HIPNT=OBJCD(FLOC+5) 00079730
C 00079740
C 00079750
C THE POINTER TO THE 40 WORD BUFFER IS INCREMENTED. IF THE 00079760
C VARIABLES RUN SUBSCRIPT MATCHES RUNCT ITS VALUE IS DEPOSITED 00079770
C IN THE BUFFER AND IT IS COMPARED TO THE PREVIOUS HIGH AND 00079780
C LOW FOR POSSIBLE UPDATING. IF THE SUBSCRIPT DOES NOT MATCH 00079790
C RUNCT, THE POSITION IN THE BUFFER IS SKIPPED OVER, THUS 00079800
C RESERVING ROOM FOR ITS VALUE IN SUBSEQUENT RUNS. 00079810
C 00079820
C 00079830
DO 500 COUNT=1,VARCT 00079840
OBJCD(FLOC+6)=OBJCD(FLOC+6)+1 00079850
BUFPT=OBJCD(FLOC+6) 00079860
VPOS=FLOC+6+2*COUNT 00079870
IF(OBJCD(VPOS+1).NE.RUNCT) GO TO 400 00079880
VNUM=OBJCD(VPOS) 00079890
VAR(BUFPT)=VAR(VNUM) 00079900
CMPAR=VAR(VNUM) 00079910
IF(CMPAR.LT.0.D0.AND.TYPE.EQ.12) CMPAR=-CMPAR 00079920
SUBHI=HIPNT+2*COUNT-2 00079930
IF(CMPAR.GT.VAR(SUBHI)) VAR(SUBHI)=CMPAR 00079940
IF(CMPAR.LT.VAR(SUBHI+1)) VAR(SUBHI+1)=CMPAR 00079950
C 00079960
C 00079970
C HERE THE BUFFER IS CHECKED TO SEE IF IT IS FULL. IF SO, 00079980
C IT IS WRITTEN OUT TO DISK. IF RUNCT IS GREATER THAN LOWRN, 00079990
C PREVIOUS RUN VARIABLE VALUES ARE SAVED BY READING THE NEXT 00080000
C RECORD BACK INTO THE BUFFER. BUFPT IS SET TO THE FIRST REAL 00080010
C POSITION PRECEEDING THE BUFFER AND THE RECORD POINTER (OBJCD( 00080020
C FLOC+4)) IS UPDATED. 00080030
C 00080040
C 00080050
400 FRONT=HIPNT+2*VARCT-1 00080060
IF((BUFPT-FRONT).LT.40) GO TO 500 00080070
HERE=FRONT+1 00080080
THERE=HERE+39 00080090
OBJCD(FLOC+6)=FRONT 00080100
REC=OBJCD(FLOC+4) 00080110
IF(REC.GT.DSKND) CALL NDT12 (9) 00080120
WRITE(DISK'REC) (VAR(J),J=HERE,THERE) 00080130
REC = REC + OUTCT 00080140
OBJCD(FLOC+4) = REC 00080150
LOWRN=OBJCD(FLOC+2) 00080160
IF(RUNCT.GT.LOWRN) READ(DISK'REC) (VAR(J),J=HERE,THERE) 00080170
C 00080180
C 00080190
C GET THE NEXT VARIABLE IN THIS DATA BUFFER. 00080200
C 00080210
C 00080220
500 CONTINUE 00080230
C 00080240
C 00080250
C GET THE NEXT DATA BUFFER. 00080260
C 00080270
C 00080280
1000 CONTINUE 00080290
RETURN 00080300
END 00080320
C COPYRIGHT 1979 - UNIVERSITY OF NOTRE DAME 00080330
C PROGRAM AUTHOR - DANIEL A. POYDENCE 00080340
C 00080350
C 00080360
SUBROUTINE NDT64 00080370
C 00080380
C 00080390
C THIS SUBROUTINE EXECUTES THE NDTRAN OBJECT CODE CHECKING 00080400
C FOR ALL ERROR CONDITIONS WHICH MIGHT RESULT IN LOSS OF 00080410
C CONTROL DUE TO FORTRAN OR SYSTEM ERRORS. IN THE EVENT 00080420
C OF AN ERROR, A MESSAGE I PRINTED GIVING THE SOURCE 00080430
C STATEMENT NUMBER BEING EXECUTED WHEN THE CONDITION 00080440
C WAS DETECTED AND THE TIME. ERROR RECOVERY IS ATTEMPTED 00080450
C WHERE POSSIBLE UNTIL AN EXCESSIVE NUMBER OF ERRORS 00080460
C TERMINATES THE RUN IN PROGRESS. 00080470
C 00080480
C 00080490
REAL*8 RMIN,RMAX,VAR(5000), EXTME,RSTME(10) 00080500
REAL*8 ACCUM,TIME,DT,START,STOP,PRTPR,PLTPR,HAFDT,RKCON, 00080510
1ABCON,ARG1,ARG2,ARG3,ARG4,ARG5,Z,X,RANGE,INDEP,DISP, 00080520
2A,B,C,D,TOLER,TEST 00080530
INTEGER PTRS(45),TITLE(120),CRSET(39),OPER(9),SYM(15), 00080540
1SUBSC(6),OUTPT(240),LINE(120),OBJCD(6000) 00080550
INTEGER FLAG,OPCOD,RADDR,INTYP,PC,PRTBT,PLTBT,OPRND,VNUM, 00080560
1RERUN,EXPMX,LADDR,VARNM,I,J,COUNT,SUB,PNT,RRUN(80),RUNCT, 00080570
2RRBST,RBFPT,INTBT,REC,DISK,TO,FROM,OBJST,OUTCT,OAB, 00080580
3HERE,THERE,OCBND,STMT,CODE,ERRCT,PRNTR,ERMSG(40) 00080590
COMMON RMIN,RMAX,PTRS,TITLE,CRSET,OPER,SYM,SUBSC,OUTPT,LINE, 00080600
1EXTME,RSTME,ACCUM,VAR 00080610
EQUIVALENCE (VAR(1),OBJCD(1)) 00080620
EQUIVALENCE (DT,VAR(11)),(TIME,VAR(12)),(STOP,VAR(13)), 00080630
1(START,VAR(14)),(PRTPR,VAR(15)),(PLTPR,VAR(16)), 00080640
2(ARG1,VAR(17)),(ARG2,VAR(18)),(ARG3,VAR(19)), 00080650
3(ARG4,VAR(20)),(ARG5,VAR(21)),(OPRND,VNUM),(PC,PTRS(15)), 00080660
4(RERUN,PTRS(13)),(LADDR,PTRS(19)),(INTYP,PTRS(8)),(RADDR,PTRS(21))00080670
EQUIVALENCE (EXPMX,PTRS(9)),(RUNCT,PTRS(14)), 00080680
1(RRUN(1),OUTPT(1),INTBT),(RRBST,PTRS(36)), 00080690
2(RBFPT,RRUN(2)),(DISK,PTRS(3)),(OBJST,PTRS(17)), 00080700
3(OUTCT,PTRS(10)),(OAB,PTRS(12)),(OCBND,PTRS(44)), 00080710
4(PRNTR,PTRS(2)) 00080720
DATA ERMSG /' ','I','N',' ','S','T','A','T','E','M','E', 00080730
1'N','T',' ',0,0,0,0,' ','A','T',' ','T','I','M','E', 00080740
2' ','=',' ',0,0,0,0,0,0,0,0,0,0,0/ 00080750
C 00080760
C 00080770
C STATEMENT LABEL 10000 IS RETURNED TO AFTER EACH INSTRUCTION 00080780
C THE OPCODE AND ASSOCIATED OPERAND/VNUM ARE COMPUTED, 00080790
C PC IS INCREMENTED, AND A COMPUTED GO TO IS EXECUTED 00080800
C BASED UPON THE OPCODE. THE PROGRAM IS SET UP SO THAT 00080810
C THE STATEMENT LABEL IS ALWAYS THE OPCODE*100+10000. 00080820
C 00080830
C 00080840
C 00080850
10000 OPCOD=OBJCD(PC) 00080860
OPRND=OBJCD(PC+1) 00080870
PC=PC+2 00080880
GO TO (10100,10200,10300,10400,10500,10600,10700,10800,10900, 00080890
111000,11100,11200,11300,11400,11500,11600,11700,11800, 00080900
211900,12000,12100,12200,12300,12400,12500,12500,12700, 00080910
312800,12700,13000,13100,13200,13300,13400,13400,13400, 00080920
413400) ,OPCOD 00080930
C**************************************************************** 00080940
C 00080950
C THE LOAD INSTRUCTION. 00080960
C 00080970
C 00080980
10100 ACCUM=VAR(VNUM) 00080990
GO TO 10000 00081000
C 00081010
C**************************************************************** 00081020
C 00081030
C THE STORE INSTRUCTION. (NOTE, THE STORE ZEROS OUT ACCUM) 00081040
C 00081050
C 00081060
10200 VAR(VNUM)=ACCUM 00081070
ACCUM=0.D0 00081080
GO TO 10000 00081090
C 00081100
C**************************************************************** 00081110
C 00081120
C THE ADD INSTRUCTION. 00081130
C 00081140
C NDTRAN FLOATING POINT EXTREMES ARE SETUP SUCH THAT ADDITIONS 00081150
C AND SUBTRACTIONS CANNOT RESULT IN LOSS OF CONTROL DUE TO 00081160
C ERROR CONDITIONS. THE OPERATIONS ARE SIMPLY PERFORMED 00081170
C AND CHECKED FOR NDTRAN OVERFLOW OR UNDERFLOW AFTERWARD.C 00081180
C 00081190
C THE FLOATING POINT MAXIMUM, RMAX ,WITH THE ORIGINAL SIGN 00081200
C IS SUPPLIED AS THE RESULT IN THE CASE OF OVERFLOW. 00081210
C ZERO IS SUPPLIED FOR THE UNDERFLOW CONDITION. 00081220
C 00081230
C 00081240
C 00081250
10300 ACCUM=ACCUM+VAR(VNUM) 00081260
10310 TEST = DABS(ACCUM) 00081270
IF(TEST .LE. RMAX) GO TO 10320 00081280
CODE = 1 00081290
TEST = RMAX 00081300
IF(ACCUM .LT. 0.D0) TEST = -TEST 00081310
ACCUM = TEST 00081320
GO TO 20000 00081330
10320 IF(TEST.GT. RMIN.OR.TEST.EQ.0.D0) GO TO 10000 00081340
CODE = 2 00081350
ACCUM = 0.D0 00081360
GO TO 20000 00081370
C**************************************************************** 00081380
C 00081390
C THE SUBTRACT INSTRUCTION. 00081400
C 00081410
C 00081420
10400 ACCUM=ACCUM - VAR(VNUM) 00081430
GO TO 10310 00081440
C**************************************************************** 00081450
C 00081460
C THE MULTIPLY INSTRUCTION. 00081470
C 00081480
C 00081490
C IF BOTH OPERANDS ARE NON-ZERO THEN LOSS OF CONTROL COULD 00081500
C RESULT BY PERFORMING THE MULTIPLICATION. THEREFORE, 00081510
C BEFORE PERFORMING THE OPERATION WE MUST DETERMINE 00081520
C WHETHER IT IS SAFE TO DO SO. IF THE SUM OF THE CHARACTERISTICS 00081530
C OF THE OPERANDS IS WITHIN THE LIMITS OF EXPMX, THE 00081540
C EXTREMUM CHARACTERISTIC, THEN NO ERROR WILL OCCUR. 00081550
C 00081560
C 00081570
C IF THE SUM IS GREATER THAN EXPMX THEN OVERFLOW WOULD 00081580
C OCCUR AND NDTRAN SUPPLIES THE FLOATING POINT MAXIMUM 00081590
C VALUE WITH THE SIGN OF THE WOULD-BE PRODUCT. Q SUM 00081600
C LESS THAN -EXPMX INDICATES UNDERFLOW FOR WHICH A 00081610
C ZERO PRODUCT IS SUPPLIED. 00081620
C 00081630
C 00081640
10500 A = ACCUM 00081650
B = VAR(VNUM) 00081660
IF(A .EQ. 0.D0 .OR. B .EQ. 0.D0) GO TO 10510 00081670
TEST = DLOG10(DABS(A)) + DLOG10(DABS(B)) 00081680
IF(TEST .GT. FLOAT(EXPMX)) GO TO 10520 00081690
IF(TEST .LT. FLOAT(-EXPMX)) GO TO 10530 00081700
10510 ACCUM = A*B 00081710
GO TO 10000 00081720
10520 CODE = 1 00081730
ACCUM = RMAX *(A/DABS(A)) *(B/DABS(B)) 00081740
GO TO 20000 00081750
10530 CODE = 2 00081760
ACCUM = 0.D0 00081770
GO TO 20000 00081780
C 00081790
C**************************************************************** 00081800
C 00081810
C THE DIVIDE INSTRUCTION. 00081820
C 00081830
C 00081840
C BEFORE PERFORMING A DIVISION WE MUST CHECK FOR POTENTIAL 00081850
C ERROR CONDITIONS. 00081860
C 00081870
C IN THE EVENT OF A ZERO DIVISOR, THE OPERATION IS NOT 00081880
C PERFORMED AND THE DIVIDEND IS PROVIDED AS THE RESULT. 00081890
C 00081900
C IF THE DIFFERENCE OF THE CHARACTERISTICS OF THE DIVIDEND 00081910
C AND THE DIVISOR IS WITHIN EXPMX LIMITS THEN THE OPERATION 00081920
C MAY BE SAFELY PERFORMED. 00081930
C 00081940
C IF THE DIFFERENCE EXCEEDS EXPMX, THEN OVERFLOW WOULD 00081950
C OCCUR AND NDTRAN SUPPLIES THE MAXIMUM VALUE WITH THE 00081960
C SIGN OF THE WOULD BE QUOTIENT. IF THE DIFFERENCE 00081970
C IS LESS THAN -EXPMX, THEN UNDERFLOW WOULD OCCUR AND 00081980
C A ZERO RESULT IS SUPPLIED. 00081990
C 00082000
C 00082010
C 00082020
10600 A = ACCUM 00082030
B = VAR(VNUM) 00082040
10610 CODE = 3 00082050
ACCUM = A 00082060
IF(B .EQ. 0.D0) GO TO 20000 00082070
ACCUM = 0.D0 00082080
IF(A .EQ. 0.D0) GO TO 10000 00082090
TEST = DLOG10(DABS(A)) - DLOG10(DABS(B)) 00082100
IF(TEST .GT. FLOAT(EXPMX)) GO TO 10520 00082110
IF(TEST .LT. FLOAT(-EXPMX)) GO TO 10530 00082120
ACCUM = A / B 00082130
GO TO 10000 00082140
C 00082150
C**************************************************************** 00082160
C 00082170
C THE EXPONENTIATE INSTRUCTION. 00082180
C 00082190
C 00082200
10700 B = ACCUM 00082210
A = VAR(VNUM) 00082220
10710 ACCUM=1.D0 00082222
IF(A .EQ. 0.D0) GOTO 10000 00082224
ACCUM=0.D0 00082226
IF (B) 10720,10000,10740 00082230
10740 ACCUM = DEXP(A*DLOG(B)) 00082240
GO TO 10000 00082250
10720 ACCUM = DEXP(A*DLOG(-B))*DFLOAT(1-MOD(IDINT(DABS(A)+.5),2)*2) 00082260
GO TO 10000 00082270
C 00082280
C**************************************************************** 00082290
C 00082300
C THE REVERSE SUBTRACT INSTRUCTION. 00082310
C 00082320
C 00082330
10800 ACCUM=VAR(VNUM)-ACCUM 00082340
GO TO 10310 00082350
C 00082360
C**************************************************************** 00082370
C 00082380
C THE REVERSE DIVIDE INSTRUCTION. 00082390
C 00082400
C 00082410
10900 A = VAR(VNUM) 00082420
B = ACCUM 00082430
GO TO 10610 00082440
C 00082450
C**************************************************************** 00082460
C 00082470
C THE REVERSE EXPONENTIATE INSTRUCTION. 00082480
C 00082490
C 00082500
11000 B=VAR(VNUM) 00082510
A=ACCUM 00082520
GO TO 10710 00082530
C 00082540
C**************************************************************** 00082550
C 00082560
C THE INITIALIZATION INSTRUCTION. 00082570
C 00082580
C 00082590
11100 PC=RADDR 00082600
ERRCT = 0 00082610
FLAG=4 00082620
RKCON=DT/6.D0 00082630
ABCON=DT/24.D0 00082640
HAFDT=DT/2.D0 00082650
TOLER=DT/2.1D0 00082660
DO 11110 I=1,OUTCT 00082670
SUB=OAB+I-1 00082680
SUB=OBJCD(SUB) 00082690
IF(MOD(OBJCD(SUB+3)/2**(RUNCT-1),2).EQ.0) GO TO 11110 00082700
OBJCD(SUB+6)=OBJCD(SUB+5)+2*OBJCD(SUB+1)-1 00082710
REC=OBJCD(SUB+4) 00082720
IF(REC.EQ.OCBND+I) GO TO 11110 00082730
HERE=OBJCD(SUB+6)+1 00082740
THERE=HERE+39 00082750
WRITE(DISK'REC) (VAR(J),J=HERE,THERE) 00082760
REC=OCBND+I 00082770
READ(DISK'REC) (VAR(J),J=HERE,THERE) 00082780
OBJCD(SUB+4)=REC 00082790
11110 CONTINUE 00082800
GO TO 10000 00082810
C 00082820
C**************************************************************** 00082830
C 00082840
C THE TIME INSTRUCTION. 00082850
C 00082860
C 00082870
11200 IF(FLAG.NE.4.AND.(INTYP.EQ.2.OR.(INTYP.EQ.3.AND.TIME-START 00082880
1 .LT.3.D0*DT))) GO TO 11250 00082890
PRTBT=0 00082900
PLTBT=0 00082910
IF(PRTPR.EQ.0.D0) GO TO 11211 00082920
IF(DABS(TIME/PRTPR-IDINT(TIME/PRTPR 00082930
1+.5D0)).LE.TOLER/PRTPR) PRTBT=1 00082940
11211 IF(PLTPR.EQ.0.D0) GO TO 11212 00082950
IF(DABS(TIME/PLTPR-IDINT(TIME/PLTPR 00082960
1+.5D0)).LE.TOLER/PLTPR) PLTBT=1 00082970
11212 IF(PRTBT.EQ.1.OR.PLTBT.EQ.1) CALL NDT63 (PRTBT,PLTBT) 00082980
IF(TIME.LT.STOP-TOLER) GO TO 11250 00082990
PC=RERUN 00083000
GO TO 10000 00083010
11250 PC=LADDR 00083020
ARG1=1.D0 00083030
IF(INTYP.EQ.2.OR.(INTYP.EQ.3.AND.(TIME-START.LT.3.1D0*DT))) 00083040
1 FLAG=MOD(FLAG,4)+1 00083050
VARNM=12 00083060
GO TO 11601 00083070
C 00083080
C**************************************************************** 00083090
C 00083100
C THE RERUN INSTRUCTION. 00083110
C 00083120
C 00083130
11300 RUNCT=RUNCT+1 00083140
RERUN=RERUN+2 00083150
PC=OBJST 00083160
C 00083170
C THE RERUN CHANGES THEMSELVES ARE MADE. 00083180
C 00083190
REC=RRBST+RUNCT-2 00083200
READ(DISK'REC) RRUN 00083210
IF(INTBT.NE.0) INTYP=INTBT 00083220
IF(RBFPT.EQ.2) GO TO 10000 00083230
DO 11350 I=3,RBFPT,2 00083240
TO=RRUN(I) 00083250
FROM=RRUN(I+1) 00083260
11350 VAR(TO)=VAR(FROM) 00083270
GO TO 10000 00083280
C 00083290
C**************************************************************** 00083300
C 00083310
C THE STOP INSTRUCTION. 00083320
C 00083330
C 00083340
11400 RETURN 00083350
C 00083360
C**************************************************************** 00083370
C 00083380
C THE STMT INSTRUCTION 00083390
C 00083400
11500 STMT = OPRND 00083410
GO TO 10000 00083420
C**************************************************************** 00083430
C 00083440
C THE INTEGRATE INSTRUCTION. 00083450
C 00083460
C 00083470
11600 VARNM=OBJCD(PC+1) 00083480
C 00083490
C**************************************************************** 00083500
C 00083510
C BRANCH TO THE CORRECT INTEGRATOR. 00083520
C 00083530
C 00083540
11601 GO TO (11610,11620,11650),INTYP 00083550
C 00083560
C**************************************************************** 00083570
C 00083580
C EULER INTEGRATION-------- 00083590
C 00083600
C 00083610
11610 ACCUM = VAR(VARNM) + DT * ARG1 00083620
IGO=1 00083625
GO TO 11697 00083630
C 00083640
C 00083650
C**************************************************************** 00083660
C RUNGE-KUTTA INTEGRATION-------- 00083670
C 00083680
C 00083690
11620 GO TO (11625,11630,11635,11640),FLAG 00083700
11625 VAR(OPRND)=VAR(VARNM) 00083710
VAR(OPRND+1)=ARG1 00083720
ACCUM=VAR(OPRND)+HAFDT*ARG1 00083730
GO TO 11699 00083740
11630 VAR(OPRND+2)=ARG1 00083750
ACCUM=VAR(OPRND)+HAFDT*ARG1 00083760
GO TO 11699 00083770
11635 VAR(OPRND+3)=ARG1 00083780
ACCUM=VAR(OPRND)+DT*ARG1 00083790
GO TO 11699 00083800
11640 ACCUM=VAR(OPRND)+RKCON*(VAR(OPRND+1)+2.D0*VAR(OPRND+2) 00083810
1+2.D0*VAR(OPRND+3)+ARG1) 00083820
GO TO 11699 00083830
C 00083840
C**************************************************************** 00083850
C 00083860
C ADAMS-BASHFORTH INTEGRATION------- 00083870
C 00083880
C 00083890
11650 IF(FLAG.NE.1) GO TO 11620 00083900
COUNT=(TIME-START)/DT+1.1D0 00083910
IF(COUNT.GT.3) GO TO 11670 00083920
SUB=COUNT+OPRND+3 00083930
VAR(SUB)=ARG1 00083940
GO TO 11620 00083950
11670 ACCUM=VAR(VARNM)+ABCON*(55.D0*ARG1-59.D0*VAR(OPRND+6) 00083960
1+37.D0*VAR(OPRND+5)-9.D0*VAR(OPRND+4)) 00083970
VAR(OPRND+4)=VAR(OPRND+5) 00083980
VAR(OPRND+5)=VAR(OPRND+6) 00083990
VAR(OPRND+6)=ARG1 00084000
11699 IGO=1 00084010
TEST=DABS(ACCUM) 00084011
IF(TEST.LE.RMAX) GO TO 11698 00084012
CODE=1 00084013
TEST=RMAX 00084014
IF(ACCUM.LT.0D0) TEST=-TEST 00084015
ACCUM=TEST 00084016
IGO=2 00084017
GO TO 11697 00084018
11698 IF(TEST.GT.RMIN.OR.TEST.EQ.0D0) GO TO 11697 00084019
CODE=2 00084020
ACCUM=0.D0 00084021
IGO=2 00084022
C 00084030
C THE TIME INSTRUCTION IS NOT FOLLOWED BY A STORE. THEREFORE, 00084040
C IF TIME WAS JUST INTEGRATED, THE STORE MUST BE DONE HERE 00084050
C BEFORE THE NEXT INSTRUCTION IS EXECUTED. 00084060
C 00084070
C 00084080
11697 IF(OPCOD.NE.12.AND.OPCOD.NE.28) GO TO (10000,20000),IGO 00084085
VAR(VARNM)=ACCUM 00084090
IF(OPCOD.EQ.12) ACCUM=0.D0 00084100
GO TO (10000,20000), IGO 00084110
C 00084120
C**************************************************************** 00084130
C 00084140
C THE ABSOLUTE VALUE FUNCTION. 00084150
C 00084160
C 00084170
11700 ACCUM=DABS(ARG1) 00084180
GO TO 10000 00084190
C 00084200
C**************************************************************** 00084210
C 00084220
C THE CLIP FUNCTION. 00084230
C 00084240
C 00084250
11800 ACCUM=ARG1 00084260
IF(ARG3.LT.ARG4) ACCUM=ARG2 00084270
GO TO 10000 00084280
C 00084290
C**************************************************************** 00084300
C 00084310
C THE COSINE FUNCTION. 00084320
C 00084330
C 00084340
11900 ACCUM=DCOS(ARG1) 00084350
GO TO 10000 00084360
C 00084370
C**************************************************************** 00084380
C 00084390
C THE DELAY FUNCTION. 00084400
C 00084410
C 00084420
12000 GO TO 10000 00084430
C**************************************************************** 00084440
C 00084450
C THE EXP FUNCTION. 00084460
C 00084470
C 00084480
12100 IF(ARG1 .LT. 2.3025851D0 * DFLOAT(EXPMX)) GO TO 12110 00084481
CODE = 1 00084482
ACCUM = RMAX 00084483
GO TO 20000 00084484
12110 ACCUM = DEXP(ARG1) 00084485
GO TO 10000 00084486
C 00084510
C**************************************************************** 00084520
C 00084530
C THE NATURAL LOG FUNCTION. 00084540
C 00084550
C 00084560
12200 IF(ARG1 .GT. 0.D0) GO TO 12210 00084570
CODE = 5 00084580
ACCUM = 0.D0 00084590
GO TO 20000 00084600
12210 ACCUM = DLOG(ARG1) 00084610
GO TO 10000 00084620
C 00084630
C**************************************************************** 00084640
C 00084650
C THE MAX FUNCTION. 00084660
C 00084670
C 00084680
12300 ACCUM=ARG1 00084690
IF(ARG2.GT.ARG1) ACCUM=ARG2 00084700
GO TO 10000 00084710
C 00084720
C**************************************************************** 00084730
C 00084740
C THE MIN FUNCTION. 00084750
C 00084760
C 00084770
12400 ACCUM=ARG1 00084780
IF(ARG2.LT.ARG1) ACCUM=ARG2 00084790
GO TO 10000 00084800
C 00084810
C**************************************************************** 00084820
C 00084830
C THE RANDOM NUMBER GENERATOR (NOISE). 00084840
C 00084850
C 00084860
12500 IF(TIME.GT.START) GO TO 12540 00084870
IF(ARG1.GT.100000.D0.OR.ARG1.LT.1.D0) ARG1=50000.D0 00084880
VAR(OPRND)=ARG1 00084890
12540 Z=899.D0*VAR(OPRND) 00084900
I=Z/65536.D0 00084910
VAR(OPRND)=Z-FLOAT(I)*65536.D0 00084920
ACCUM=VAR(OPRND)/65536.D0 00084930
IF(OPCOD.EQ.25) GO TO 10000 00084940
C 00084950
C**************************************************************** 00084960
C 00084970
C THE NORMALIZED RANDOM NUMBER GENERATOR (NORMN). 00084980
C 00084990
C 00085000
X=2.D0*ACCUM-1.D0 00085010
ACCUM=(((-.38709D0*X*X-.80611D0)*X*X)+(1.24056D0)*X/1.D0-X*X) 00085020
1*ARG3+ARG2 00085030
GO TO 10000 00085040
C 00085050
C**************************************************************** 00085060
C 00085070
C THE PULSE AND SAMPLE FUNCTIONS. 00085080
C 00085090
C 00085100
12700 IF(TIME.NE.START) GO TO 12710 00085110
IF(OPCOD.EQ.29.OR.ARG3.LT.START) GO TO 12725 00085120
VAR(OPRND)=ARG3 00085130
12710 ACCUM=0.D0 00085140
IF(VAR(OPRND).LT.0.D0) GO TO 12750 00085150
IF(VAR(OPRND)-TIME.GT.TOLER.OR.INTYP.EQ.2.AND.FLAG.NE.4)GOTO10000 00085160
12725 VAR(OPRND)=-(TIME+ARG2) 00085170
VAR(OPRND+1)=ARG1 00085180
ACCUM=ARG1 00085190
GO TO 10000 00085200
12750 IF(-VAR(OPRND).LT.TIME+TOLER) GO TO 12775 00085210
ACCUM=VAR(OPRND+1) 00085220
GO TO 10000 00085230
12775 IF(OPCOD.EQ.29) GO TO 12725 00085240
IF(ARG4.LT.TOLER) ARG4=STOP+1 00085250
VAR(OPRND)=TIME+ARG4 00085260
GO TO 10000 00085270
C 00085280
C**************************************************************** 00085290
C 00085300
C THE RAMP FUNCTION. 00085310
C 00085320
12800 IF(TIME.EQ.START) VAR(OPRND+7)=0.D0 00085330
IF(TIME-ARG2.GT.TOLER) GO TO 12850 00085340
ACCUM=VAR(OPRND+7) 00085350
GO TO 10000 00085360
12850 VARNM=OPRND+7 00085370
GO TO 11601 00085380
C 00085390
C**************************************************************** 00085400
C 00085410
C THE SINE FUNCTION. 00085420
C 00085430
C 00085440
13000 ACCUM=DSIN(ARG1) 00085450
GO TO 10000 00085460
C 00085470
C**************************************************************** 00085480
C 00085490
C THE SQUARE ROOT FUNCTION. 00085500
C 00085510
C 00085520
13100 IF(ARG1 .GE. 0.D0) GO TO 13110 00085530
CODE = 6 00085540
ACCUM = 0.D0 00085550
GO TO 20000 00085560
13110 ACCUM = DSQRT(ARG1) 00085570
GO TO 10000 00085580
C 00085590
C**************************************************************** 00085600
C 00085610
C THE STEP FUNCTION. 00085620
C 00085630
C 00085640
13200 ACCUM=0.D0 00085650
IF(ARG2-TIME.LE.TOLER) ACCUM=ARG1 00085660
GO TO 10000 00085670
C 00085680
C**************************************************************** 00085690
C 00085700
C THE SWITCH FUNCTION. 00085710
C 00085720
C 00085730
13300 ACCUM=ARG1 00085740
IF(ARG3.LE.0.D0) ACCUM=ARG2 00085750
GO TO 10000 00085760
C 00085770
C**************************************************************** 00085780
C**************************************************************** 00085790
C**************************************************************** 00085800
C 00085810
C THE TABLE FUNCTIONS: TABFL, TABHL, TABLE, AND TABND. 00085820
C 00085830
C 00085840
C GET THE TABLE ADDRESS AND THE NO. OF ELEMENTS IN THE TABLE. 00085850
C 00085860
C 00085870
13400 PNT=ARG1 00085880
COUNT=VAR(PNT) 00085890
C 00085900
C 00085910
C IF THERE IS ONLY ONE ELEMENT IN THE TABLE OUTPUT THAT VALUE. 00085920
C 00085930
C 00085940
IF(COUNT.NE.1) GO TO 13410 00085950
ACCUM=VAR(PNT+1) 00085960
GO TO 10000 00085970
C 00085980
C 00085990
C THE TABLE HAS MORE THAN ONE VALUE. CHECK THE INDEPENDENT 00086000
C VARIABLE AGAINST THE SUPPLIED BOUNDS. IF IT IS OUT OF BOUNDS 00086010
C THE RESULT IS DEPENDENT ON WHICH TABLE FUNCTION WAS USED. 00086020
C 00086030
C 00086040
13410 OPCOD=OPCOD-33 00086050
IF(ARG2.LT.ARG3) GO TO (13550,13530,13420,13560),OPCOD 00086060
IF(ARG2.GT.ARG4) GO TO (13550,13540,13420,13570),OPCOD 00086070
C 00086080
C 00086090
C MAP THE INDEPENDENT VARIABLE'S RANGE ONTO THE TABLE'S RANGE 00086100
C AND SELECT THE TABLE ELEMENT WHOSE PERCENT DISPLACEMENT 00086110
C FROM THE FIRST ELEMENT IS CLOSEST TO BUT NOT HIGHER THAN 00086120
C THE PERCENT DISPLACEMENT OF THE INDEPENDENT VARIABLE FROM 00086130
C IT'S LOWER BOUND. 00086140
C 00086150
C 00086160
13420 DPCT=(ARG2-ARG3)/(ARG4-ARG3) 00086170
I=PNT+1+IDINT(DPCT*DFLOAT(COUNT-1)) 00086180
C 00086190
C**************************************************************** 00086200
C IF TABHL WAS REQUESTED OR THE TABLE ONLY HAS TWO ELEMENTS 00086210
C THEN INTERPOLATE. 00086220
C 00086230
C 00086240
IF(OPCOD.NE.2.AND.COUNT.NE.2) GO TO 13500 00086250
IF(I.EQ.PNT+COUNT) I=I-1 00086260
DISP=DPCT*DFLOAT(COUNT-1)-DFLOAT(I-PNT-1) 00086270
ACCUM=DISP*(VAR(I+1)-VAR(I))+VAR(I) 00086280
GO TO 10000 00086290
C 00086300
C**************************************************************** 00086310
C ONE OF THE THIRD ORDER TABLE FUNCTIONS WAS REQUESTED. 00086320
C IF THE TABLE ONLY HAS THREE ELEMENTS THEN A SECOND ORDER 00086330
C CURVE FIT IS THE BEST WE CAN DO. 00086340
C 00086350
C 00086360
13500 IF(COUNT.NE.3) GO TO 13510 00086370
I=PNT+1 00086380
A=0.D0 00086390
D=VAR(I+2) 00086400
B=(D+VAR(I))/2.D0-VAR(I+1) 00086410
C=(D-VAR(I))/2.D0+2.D0*B 00086420
GO TO 13520 00086430
C 00086440
C**************************************************************** 00086450
C 00086460
C A THIRD ORDER CURVE FIT IS PERFORMED AS THE TABLE CONTAINS 00086470
C A SUFFICIENT NUMBER OF ELEMENTS. FOUR ELEMENT VALUES ARE 00086480
C USED INCLUDING THE ONE BEFORE THE ELEMENT PREVIOUSLY SELECTED 00086490
C AND TWO AFTER THAT ELEMENT. IF THE ELEMENT SELECTED DOES NOT 00086500
C HAVE ONE ELEMENT BEFORE IT OR TWO AFTER THEN THE INDEPENDENT 00086510
C VARIABLE IS CLOSE TO ONE OF IT'S BOUNDS SO USE THE LAST OR 00086520
C FIRST FOUR ELEMENTS DEPENDING ON WHICH BOUND IS INVOLVED. 00086530
C 00086540
C 00086550
13510 IF(I.LT.PNT+2) I=PNT+2 00086560
IF(I.GT.PNT+COUNT-2) I=PNT+COUNT-2 00086570
D=VAR(I) 00086580
B=(VAR(I-1)+VAR(I+1)-2.D0*D)/2.D0 00086590
C=(8.D0*VAR(I+1)-7.D0*D-VAR(I+2)-4.D0*B)/6.D0 00086600
A=B-C+D-VAR(I-1) 00086610
13520 DISP=DPCT*DFLOAT(COUNT-1)-DFLOAT(I-PNT-1) 00086620
ACCUM=((A*DISP+B)*DISP+C)*DISP+D 00086630
GO TO 10000 00086640
13530 ARG2=ARG3 00086650
GO TO 13420 00086660
13540 ARG2=ARG4 00086670
GO TO 13420 00086680
13550 SUB = PNT + COUNT 00086690
ACCUM=(ARG2-ARG3)/(ARG4-ARG3)*(VAR(SUB)-VAR(PNT+1))+VAR(PNT+1) 00086700
GO TO 10000 00086710
13560 SUB = PNT + 2 00086720
ACCUM=(ARG2-ARG3)/(ARG4-ARG3)*DFLOAT(COUNT-1)* 00086730
1 (VAR(SUB)-VAR(SUB-1)) + VAR(SUB-1) 00086740
GO TO 10000 00086750
13570 SUB = PNT + COUNT 00086760
ACCUM=(ARG2-ARG4)/(ARG4-ARG3)*DFLOAT(COUNT-1)* 00086770
1 (VAR(SUB)-VAR(SUB-1)) + VAR(SUB) 00086780
GO TO 10000 00086790
C**************************************************************** 00086800
C**************************************************************** 00086810
C**************************************************************** 00086820
C 00086840
C 00086850
C 00086860
C AN EXECUTION TIME ERROR HAS OCCURRED. IF IT IS THE FIRST 00086870
C ERROR OF THE RUN, THEN PRINT A HEADER IDENTIFYING THE RUN. 00086880
C IF 10 ERRORS HAVE OCCURRED THEN TERMINATE THE RUN. TELL THE 00086890
C USER , AND BEGIN THE NEXT RUN. 00086900
C 00086910
C 00086920
20000 IF(ERRCT .NE. 0) GO TO 20020 00086930
CALL NDT78(3) 00086940
WRITE(PRNTR,20010) RUNCT 00086950
20010 FORMAT(/' ERRORS DURING RUN', I2,':'/) 00086960
20020 ERRCT = ERRCT + 1 00086970
IF(ERRCT .LE. 10) GO TO 20040 00086980
CALL NDT78(3) 00086990
WRITE(PRNTR,20030) 00087000
20030 FORMAT(/'RUN',I2,' IS BEING TERMINATED DUE TO THE', 00087010
A' EXCESSIVE NUMBER OF ERRORS.') 00087020
RSTME(RUNCT) = TIME 00087030
PC = RERUN 00087040
GO TO 10000 00087050
20040 CALL NDT78(1) 00087060
CALL NDT45(STMT,ERMSG(15),1) 00087070
CALL NDT44(TIME,ERMSG(30)) 00087080
GO TO (20100,20200,20300,20400,20500,20600,20700,20800),CODE 00087090
20100 WRITE(PRNTR,20110) ERMSG 00087100
20110 FORMAT(' OVERFLOW HAS OCCURRED ',40A1) 00087110
GO TO 10000 00087120
20200 WRITE(PRNTR,20210) ERMSG 00087130
20210 FORMAT(' UNDERFLOW HAS OCCURRED', 40A1) 00087140
GO TO 10000 00087150
20300 WRITE(PRNTR,20310) ERMSG 00087160
20310 FORMAT(' DIVISION BY ZERO HAS OCCURRED', 40A1) 00087170
GO TO 10000 00087180
20400 WRITE(PRNTR,20410) ERMSG 00087190
20410 FORMAT(' A NEGATIVE NUMBER IS BEING RAISED TO A', 00087200
A' FRACTIONAL POWER', 40A1) 00087210
GO TO 10000 00087220
20500 WRITE(PRNTR,20510) ERMSG 00087230
20510 FORMAT(' THE NATURAL LOG OF A NON-POSITIVE', 00087240
A' NUMBER HAS BEEN REQUESTED', 40A1) 00087250
GO TO 10000 00087260
20600 WRITE(PRNTR,20610) ERMSG 00087270
20610 FORMAT(' THE SQUARE ROOT OF A NEGATIVE NUMBER', 00087280
A' HAS BEEN REQUESTED', 40A1) 00087290
GO TO 10000 00087300
20700 GO TO 10000 00087310
20800 GO TO 10000 00087320
END 00087330
C COPYRIGHT 1978 - UNIVERSITY OF NOTRE DAME 00087340
C PROGRAM AUTHOR - GARY PELKEY 00087350
C 00087360
C 00087370
SUBROUTINE NDT65 00087380
C 00087390
C 00087400
C THIS SUBROUTINE EXECUTES NDTRAN OBJECT CODE WITHOUT CHECKING 00087410
C FOR CONDITIONS WHICH MIGHT CAUSE ACTUAL FORTRAN BOMBS. THE 00087420
C OBJECT CODE IS ALREADY LOADED INTO THE OBJCD ARRAY SO THIS 00087430
C PROGRAM SIMPLY EXECUTES THE SEQUENTIAL TWO WORD INSTRUCTIONS 00087440
C UNTIL A STOP OPCODE IS EXECUTED, WHEREUPON THE PROGRAM 00087450
C RETURNS. INTERMEDIATE OUTPUT VALUES ARE RETAINED BY THE 00087460
C TIME COMMAND WHICH CALLS NDT63, THE OUTPUT UPDATE PROGRAM, 00087470
C AT THE APPROPRIATE TIMES. RERUNS ARE HANDLED INTERNALLY 00087480
C TO THIS PROGRAM BY EXECUTING THE RERUN INSTRUCTION. 00087490
C 00087500
C 00087510
REAL*8 RMIN,RMAX,VAR(5000), EXTME,RSTME(10) 00087520
REAL*8 ACCUM,TIME,DT,START,STOP,PRTPR,PLTPR,HAFDT,RKCON, 00087530
1ABCON,ARG1,ARG2,ARG3,ARG4,ARG5,Z,X,RANGE,INDEP,DISP,A,B,C,D,TOLER 00087540
INTEGER PTRS(45),TITLE(120),CRSET(39),OPER(9),SYM(15), 00087550
1SUBSC(6),OUTPT(240),LINE(120),OBJCD(6000) 00087560
INTEGER FLAG,OPCOD,RADDR,INTYP,PC,PRTBT,PLTBT,OPRND,VNUM, 00087570
1RERUN,CRSMT,LADDR,VARNM,I,J,COUNT,SUB,PNT,RRUN(80),RUNCT, 00087580
2RRBST,RBFPT,INTBT,REC,DISK,TO,FROM,OBJST,OUTCT,OAB,HERE, 00087590
3THERE,OCBND 00087600
COMMON RMIN,RMAX,PTRS,TITLE,CRSET,OPER,SYM,SUBSC,OUTPT,LINE, 00087610
1EXTME,RSTME,ACCUM,VAR 00087620
EQUIVALENCE (VAR(1),OBJCD(1)) 00087630
EQUIVALENCE (DT,VAR(11)),(TIME,VAR(12)),(STOP,VAR(13)), 00087640
1(START,VAR(14)),(PRTPR,VAR(15)),(PLTPR,VAR(16)), 00087650
2(ARG1,VAR(17)),(ARG2,VAR(18)),(ARG3,VAR(19)),(ARG4,VAR(20)), 00087660
3(ARG5,VAR(21)),(OPRND,VNUM),(PC,PTRS(15)),(RADDR,PTRS(21)), 00087670
4(RERUN,PTRS(13)),(LADDR,PTRS(19)),(INTYP,PTRS(8)) 00087680
EQUIVALENCE (LEV,VAR(23)),(RUNCT,PTRS(14)), 00087690
1(RRUN(1),OUTPT(1),INTBT),(RRBST,PTRS(36)),(RBFPT,RRUN(2)), 00087700
2(DISK,PTRS(3)),(OBJST,PTRS(17)),(OUTCT,PTRS(10)), 00087710
3(OAB,PTRS(12)),(OCBND,PTRS(44)) 00087720
C 00087730
C 00087740
C STATEMENT LABEL 10000 IS RETURNED TO AFTER EACH INSTRUCTION. 00087750
C THE OPCODE AND ASSOCIATED OPERAND/VNUM ARE COMPUTED, PC 00087760
C IS INCREMENTED, AND A COMPUTED GO TO IS EXECUTED BASED UPON 00087770
C THE OPCODE. THE PROGRAM IS SET UP SO THAT THE STATEMENT 00087780
C LABEL IS ALWAYS THE OPCODE*100+10000. 00087790
C 00087800
C 00087810
10000 OPCOD=OBJCD(PC) 00087820
OPRND=OBJCD(PC+1) 00087830
PC=PC+2 00087840
GO TO (10100,10200,10300,10400,10500,10600,10700,10800,10900, 00087850
111000,11100,11200,11300,11400,10000,11600,11700,11800, 00087860
211900,12000,12100,12200,12300,12400,12500,12500,12700, 00087870
312800,12700,13000,13100,13200,13300,13400,13400,13400, 00087880
413400) ,OPCOD 00087890
C**************************************************************** 00087900
C 00087910
C THE LOAD INSTRUCTION. 00087920
C 00087930
C 00087940
10100 ACCUM=VAR(VNUM) 00087950
GO TO 10000 00087960
C 00087970
C**************************************************************** 00087980
C 00087990
C THE STORE INSTRUCTION. (NOTE, THE STORE ZEROS OUT ACCUM) 00088000
C 00088010
C 00088020
10200 VAR(VNUM)=ACCUM 00088030
ACCUM=0.D0 00088040
GO TO 10000 00088050
C 00088060
C**************************************************************** 00088070
C 00088080
C THE ADD INSTRUCTION. 00088090
C 00088100
C 00088110
10300 ACCUM=ACCUM+VAR(VNUM) 00088120
GO TO 10000 00088130
C 00088140
C**************************************************************** 00088150
C 00088160
C THE SUBTRACT INSTRUCTION. 00088170
C 00088180
C 00088190
10400 ACCUM=ACCUM-VAR(VNUM) 00088200
GO TO 10000 00088210
C 00088220
C**************************************************************** 00088230
C 00088240
C THE MULTIPLY INSTRUCTION. 00088250
C 00088260
C 00088270
10500 ACCUM=ACCUM*VAR(VNUM) 00088280
GO TO 10000 00088290
C 00088300
C**************************************************************** 00088310
C 00088320
C THE DIVIDE INSTRUCTION. 00088330
C 00088340
C 00088350
10600 ACCUM=ACCUM/VAR(VNUM) 00088360
GO TO 10000 00088370
C 00088380
C**************************************************************** 00088390
C 00088400
C THE EXPONENTIATE INSTRUCTION. 00088410
C 00088420
C 00088430
10700 B=ACCUM 00088440
A=VAR(VNUM) 00088450
10710 ACCUM = 1.D0 00088460
IF (A .EQ. 0.D0) GO TO 10000 00088470
ACCUM = 0.D0 00088480
IF (B) 10720,10000,10740 00088490
10740 ACCUM = DEXP(A*DLOG(B)) 00088492
GO TO 10000 00088494
10720 ACCUM=DEXP(A*DLOG(-B))*DFLOAT(1-MOD(IDINT(DABS(A)),2)*2) 00088500
GO TO 10000 00088505
C 00088510
C**************************************************************** 00088520
C 00088530
C THE REVERSE SUBTRACT INSTRUCTION. 00088540
C 00088550
C 00088560
10800 ACCUM=VAR(VNUM)-ACCUM 00088570
GO TO 10000 00088580
C 00088590
C**************************************************************** 00088600
C 00088610
C THE REVERSE DIVIDE INSTRUCTION. 00088620
C 00088630
C 00088640
10900 ACCUM=VAR(VNUM)/ACCUM 00088650
GO TO 10000 00088660
C 00088670
C**************************************************************** 00088680
C 00088690
C THE REVERSE EXPONENTIATE INSTRUCTION. 00088700
C 00088710
C 00088720
11000 B=VAR(VNUM) 00088730
A=ACCUM 00088740
GO TO 10710 00088750
C 00088760
C**************************************************************** 00088770
C 00088780
C THE INITIALIZATION INSTRUCTION. 00088790
C 00088800
C 00088810
11100 PC=RADDR 00088820
FLAG=4 00088830
RKCON=DT/6.D0 00088840
ABCON=DT/24.D0 00088850
HAFDT=DT/2.D0 00088860
TOLER=DT/2.1D0 00088870
DO 11110 I=1,OUTCT 00088880
SUB=OAB+I-1 00088890
SUB=OBJCD(SUB) 00088900
IF(MOD(OBJCD(SUB+3)/2**(RUNCT-1),2).EQ.0) GO TO 11110 00088910
OBJCD(SUB+6)=OBJCD(SUB+5)+2*OBJCD(SUB+1)-1 00088920
REC=OBJCD(SUB+4) 00088930
IF(REC.EQ.OCBND+I) GO TO 11110 00088940
HERE=OBJCD(SUB+6)+1 00088950
THERE=HERE+39 00088960
WRITE(DISK'REC) (VAR(J),J=HERE,THERE) 00088970
REC=OCBND+I 00088980
READ(DISK'REC) (VAR(J),J=HERE,THERE) 00088990
OBJCD(SUB+4)=REC 00089000
11110 CONTINUE 00089010
GO TO 10000 00089020
C 00089030
C**************************************************************** 00089040
C 00089050
C THE TIME INSTRUCTION. 00089060
C 00089070
C 00089080
11200 IF(FLAG.NE.4.AND.(INTYP.EQ.2.OR.(INTYP.EQ.3.AND.TIME-START 00089090
1 .LT.3.D0*DT))) GO TO 11250 00089100
PRTBT=0 00089110
PLTBT=0 00089120
IF(PRTPR.EQ.0.D0) GO TO 11211 00089130
IF(DABS(TIME/PRTPR-IDINT(TIME/PRTPR 00089140
1+.5D0)).LE.TOLER/PRTPR) PRTBT=1 00089150
11211 IF(PLTPR.EQ.0.D0) GO TO 11212 00089160
IF(DABS(TIME/PLTPR-IDINT(TIME/PLTPR 00089170
1+.5D0)).LE.TOLER/PLTPR) PLTBT=1 00089180
11212 IF(PRTBT.EQ.1.OR.PLTBT.EQ.1) CALL NDT63 (PRTBT,PLTBT) 00089190
IF(TIME.LT.STOP-TOLER) GO TO 11250 00089200
PC=RERUN 00089210
GO TO 10000 00089220
11250 PC=LADDR 00089230
ARG1=1.D0 00089240
IF(INTYP.EQ.2.OR.(INTYP.EQ.3.AND.(TIME-START.LT.3.1D0*DT))) 00089250
1 FLAG=MOD(FLAG,4)+1 00089260
VARNM=12 00089270
GO TO 11601 00089280
C 00089290
C**************************************************************** 00089300
C 00089310
C THE RERUN INSTRUCTION. 00089320
C 00089330
C 00089340
11300 RUNCT=RUNCT+1 00089350
RERUN=RERUN+2 00089360
PC=OBJST 00089370
C 00089380
C THE RERUN CHANGES THEMSELVES ARE MADE. 00089390
C 00089400
REC=RRBST+RUNCT-2 00089410
READ(DISK'REC) RRUN 00089420
IF(INTBT.NE.0) INTYP=INTBT 00089430
IF(RBFPT.EQ.2) GO TO 10000 00089440
DO 11350 I=3,RBFPT,2 00089450
TO=RRUN(I) 00089460
FROM=RRUN(I+1) 00089470
11350 VAR(TO)=VAR(FROM) 00089480
GO TO 10000 00089490
C 00089500
C**************************************************************** 00089510
C 00089520
C THE STOP INSTRUCTION. 00089530
C 00089540
C 00089550
11400 RETURN 00089560
C 00089570
C**************************************************************** 00089580
C 00089590
C THE INTEGRATE INSTRUCTION. 00089600
C 00089610
C 00089620
11600 VARNM=OBJCD(PC+1) 00089630
C 00089640
C 00089650
C BRANCHING TO THE CORRECT INTEGRATOR. 00089660
C 00089670
C 00089680
11601 GO TO (11610,11620,11650),INTYP 00089690
C 00089700
C 00089710
C EULER INTEGRATION-------- 00089720
C 00089730
C 00089740
11610 ACCUM=VAR(VARNM)+DT*ARG1 00089750
GO TO 11699 00089760
C 00089770
C 00089780
C RUNGE-KUTTA INTEGRATION-------- 00089790
C 00089800
C 00089810
11620 GO TO (11625,11630,11635,11640),FLAG 00089820
11625 VAR(OPRND)=VAR(VARNM) 00089830
VAR(OPRND+1)=ARG1 00089840
ACCUM=VAR(OPRND)+HAFDT*ARG1 00089850
GO TO 11699 00089860
11630 VAR(OPRND+2)=ARG1 00089870
ACCUM=VAR(OPRND)+HAFDT*ARG1 00089880
GO TO 11699 00089890
11635 VAR(OPRND+3)=ARG1 00089900
ACCUM=VAR(OPRND)+DT*ARG1 00089910
GO TO 11699 00089920
11640 ACCUM=VAR(OPRND)+RKCON*(VAR(OPRND+1)+2.D0*VAR(OPRND+2) 00089930
1+2.D0*VAR(OPRND+3)+ARG1) 00089940
GO TO 11699 00089950
C 00089960
C 00089970
C ADAMS-BASHFORTH INTEGRATION------- 00089980
C 00089990
C 00090000
11650 IF(FLAG.NE.1) GO TO 11620 00090010
COUNT=(TIME-START)/DT+1.1 00090020
IF(COUNT.GT.3) GO TO 11670 00090030
SUB=COUNT+OPRND+3 00090040
VAR(SUB)=ARG1 00090050
GO TO 11620 00090060
11670 ACCUM=VAR(VARNM)+ABCON*(55.D0*ARG1-59.D0*VAR(OPRND+6) 00090070
1+37.D0*VAR(OPRND+5)-9.D0*VAR(OPRND+4)) 00090080
VAR(OPRND+4)=VAR(OPRND+5) 00090090
VAR(OPRND+5)=VAR(OPRND+6) 00090100
VAR(OPRND+6)=ARG1 00090110
11699 IF(OPCOD.NE.12.AND.OPCOD.NE.28) GO TO 10000 00090120
C 00090130
C 00090140
C THE TIME INSTRUCTION IS NOT FOLLOWED BY A STORE. THEREFORE, 00090150
C IF TIME WAS JUST INTEGRATED, THE STORE MUST BE DONE HERE 00090160
C BEFORE THE NEXT INSTRUCTION IS EXECUTED. 00090170
C 00090180
C 00090190
VAR(VARNM)=ACCUM 00090200
IF(OPCOD.EQ.12) ACCUM=0.D0 00090210
GO TO 10000 00090220
C 00090230
C**************************************************************** 00090240
C 00090250
C THE ABSOLUTE VALUE FUNCTION. 00090260
C 00090270
C 00090280
11700 ACCUM=DABS(ARG1) 00090290
GO TO 10000 00090300
C 00090310
C**************************************************************** 00090320
C 00090330
C THE CLIP FUNCTION. 00090340
C 00090350
C 00090360
11800 ACCUM=ARG1 00090370
IF(ARG3.LT.ARG4) ACCUM=ARG2 00090380
GO TO 10000 00090390
C 00090400
C**************************************************************** 00090410
C 00090420
C THE COSINE FUNCTION. 00090430
C 00090440
C 00090450
11900 ACCUM=DCOS(ARG1) 00090460
GO TO 10000 00090470
C 00090480
C**************************************************************** 00090490
C 00090500
C THE DELAY FUNCTION. 00090510
C 00090520
00090530
00090540
00090550
00090560
00090570
00090580
00090590
00090600
00090610
C 00090620
12000 GO TO 10000 00090630
C**************************************************************** 00090640
C 00090650
C THE EXP FUNCTION. 00090660
C 00090670
C 00090680
12100 ACCUM=DEXP(ARG1) 00090690
GO TO 10000 00090700
C 00090710
C**************************************************************** 00090720
C 00090730
C THE NATURAL LOG FUNCTION. 00090740
C 00090750
C 00090760
12200 ACCUM=DLOG(ARG1) 00090770
GO TO 10000 00090780
C 00090790
C**************************************************************** 00090800
C 00090810
C THE MAX FUNCTION. 00090820
C 00090830
C 00090840
12300 ACCUM=ARG1 00090850
IF(ARG2.GT.ARG1) ACCUM=ARG2 00090860
GO TO 10000 00090870
C 00090880
C**************************************************************** 00090890
C 00090900
C THE MIN FUNCTION. 00090910
C 00090920
C 00090930
12400 ACCUM=ARG1 00090940
IF(ARG2.LT.ARG1) ACCUM=ARG2 00090950
GO TO 10000 00090960
C 00090970
C**************************************************************** 00090980
C 00090990
C THE RANDOM NUMBER GENERATOR (NOISE). 00091000
C 00091010
C 00091020
12500 IF(TIME.GT.START) GO TO 12540 00091030
IF(ARG1.GT.100000.D0.OR.ARG1.LT.1.D0) ARG1=50000.D0 00091040
VAR(OPRND)=ARG1 00091050
12540 Z=899.D0*VAR(OPRND) 00091060
I=Z/65536.D0 00091070
VAR(OPRND)=Z-FLOAT(I)*65536.D0 00091080
ACCUM=VAR(OPRND)/65536.D0 00091090
IF(OPCOD.EQ.25) GO TO 10000 00091100
C 00091110
C**************************************************************** 00091120
C 00091130
C THE NORMALIZED RANDOM NUMBER GENERATOR (NORMN). 00091140
C 00091150
C 00091160
X=2.D0*ACCUM-1.D0 00091170
ACCUM=(((-.38709D0*X*X-.80611D0)*X*X)+(1.24056D0)*X/1.D0-X*X) 00091180
1*ARG3+ARG2 00091190
GO TO 10000 00091200
C 00091210
C**************************************************************** 00091220
C 00091230
C THE PULSE AND SAMPLE FUNCTIONS. 00091240
C 00091250
C 00091260
12700 IF(TIME.NE.START) GO TO 12710 00091270
IF(ARG3.LT.0.D0) GO TO 12725 00091280
VAR(OPRND)=ARG3 00091290
12710 ACCUM=0.D0 00091300
IF(VAR(OPRND).LT.0.D0) GO TO 12750 00091310
IF(VAR(OPRND)-TIME.GT.TOLER.OR.INTYP.EQ.2.AND.FLAG.NE.4)GOTO10000 00091320
12725 VAR(OPRND)=-(TIME+ARG2) 00091330
VAR(OPRND+1)=ARG1 00091340
ACCUM=ARG1 00091350
GO TO 10000 00091360
12750 IF(-VAR(OPRND).LT.TIME+TOLER) GO TO 12775 00091370
ACCUM=VAR(OPRND+1) 00091380
GO TO 10000 00091390
12775 IF(OPCOD.EQ.29) GO TO 12725 00091400
IF(ARG4.LT.TOLER) ARG4=STOP+1 00091410
VAR(OPRND)=TIME+ARG4 00091420
GO TO 10000 00091430
C 00091440
C**************************************************************** 00091450
C 00091460
C THE RAMP FUNCTION. 00091470
C 00091480
12800 IF(TIME.EQ.START) VAR(OPRND+7)=0.D0 00091490
IF(TIME-ARG2.GT.TOLER) GO TO 12850 00091500
ACCUM=VAR(OPRND+7) 00091510
GO TO 10000 00091520
12850 VARNM=OPRND+7 00091530
GO TO 11601 00091540
C 00091550
C**************************************************************** 00091560
C 00091570
C THE SINE FUNCTION. 00091580
C 00091590
C 00091600
13000 ACCUM=DSIN(ARG1) 00091610
GO TO 10000 00091620
C 00091630
C**************************************************************** 00091640
C 00091650
C THE SQUARE ROOT FUNCTION. 00091660
C 00091670
C 00091680
13100 ACCUM=DSQRT(ARG1) 00091690
GO TO 10000 00091700
C 00091710
C**************************************************************** 00091720
C 00091730
C THE STEP FUNCTION. 00091740
C 00091750
C 00091760
13200 ACCUM=0.D0 00091770
IF(ARG2-TIME.LE.TOLER) ACCUM=ARG1 00091780
GO TO 10000 00091790
C 00091800
C**************************************************************** 00091810
C 00091820
C THE SWITCH FUNCTION. 00091830
C 00091840
C 00091850
13300 ACCUM=ARG1 00091860
IF(ARG3.LE.0.D0) ACCUM=ARG2 00091870
GO TO 10000 00091880
C 00091890
C**************************************************************** 00091900
C 00091910
C THE TABLE FUNCTIONS: TABFL, TABHL, TABLE, AND TABND. 00091920
C 00091930
C 00091940
C GET THE TABLE ADDRESS AND THE NO. OF ELEMENTS IN THE TABLE. 00091950
C 00091960
C 00091970
13400 PNT=ARG1 00091980
COUNT=VAR(PNT) 00091990
C 00092000
C 00092010
C IF THERE IS ONLY ONE ELEMENT IN THE TABLE OUTPUT THAT VALUE. 00092020
C 00092030
C 00092040
IF(COUNT.NE.1) GO TO 13410 00092050
ACCUM=VAR(PNT+1) 00092060
GO TO 10000 00092070
C 00092080
C 00092090
C THE TABLE HAS MORE THAN ONE VALUE. CHECK THE INDEPENDENT 00092100
C VARIABLE AGAINST THE SUPPLIED BOUNDS. IF IT IS OUT OF BOUNDS 00092110
C THE RESULT IS DEPENDENT ON WHICH TABLE FUNCTION WAS USED. 00092120
C 00092130
C 00092140
13410 OPCOD=OPCOD-33 00092150
IF(ARG2.LT.ARG3) GO TO (13550,13530,13420,13560),OPCOD 00092160
IF(ARG2.GT.ARG4) GO TO (13550,13540,13420,13570),OPCOD 00092170
C 00092180
C 00092190
C MAP THE INDEPENDENT VARIABLE'S RANGE ONTO THE TABLE'S RANGE 00092200
C AND SELECT THE TABLE ELEMENT WHOSE PERCENT DISPLACEMENT 00092210
C FROM THE FIRST ELEMENT IS CLOSEST TO BUT NOT HIGHER THAN 00092220
C THE PERCENT DISPLACEMENT OF THE INDEPENDENT VARIABLE FROM 00092230
C IT'S LOWER BOUND. 00092240
C 00092250
C 00092260
13420 DPCT=(ARG2-ARG3)/(ARG4-ARG3) 00092270
I=PNT+1+IDINT(DPCT*DFLOAT(COUNT-1)) 00092280
C 00092290
C 00092300
C IF TABHL WAS REQUESTED OR THE TABLE ONLY HAS TWO ELEMENTS 00092310
C THEN INTERPOLATE. 00092320
C 00092330
C 00092340
IF(OPCOD.NE.2.AND.COUNT.NE.2) GO TO 13500 00092350
IF(I.EQ.PNT+COUNT) I=I-1 00092360
DISP=DPCT*DFLOAT(COUNT-1)-DFLOAT(I-PNT-1) 00092370
ACCUM=DISP*(VAR(I+1)-VAR(I))+VAR(I) 00092380
GO TO 10000 00092390
C 00092400
C 00092410
C ONE OF THE THIRD ORDER TABLE FUNCTIONS WAS REQUESTED. 00092420
C IF THE TABLE ONLY HAS THREE ELEMENTS THEN A SECOND ORDER 00092430
C CURVE FIT IS THE BEST WE CAN DO. 00092440
C 00092450
C 00092460
13500 IF(COUNT.NE.3) GO TO 13510 00092470
I=PNT+1 00092480
A=0.D0 00092490
D=VAR(I+2) 00092500
B=(D+VAR(I))/2.D0-VAR(I+1) 00092510
C=(D-VAR(I))/2.D0+2.D0*B 00092520
GO TO 13520 00092530
C 00092540
C 00092550
C A THIRD ORDER CURVE FIT IS PERFORMED AS THE TABLE CONTAINS 00092560
C A SUFFICIENT NUMBER OF ELEMENTS. FOUR ELEMENT VALUES ARE 00092570
C USED INCLUDING THE ONE BEFORE THE ELEMENT PREVIOUSLY SELECTED 00092580
C AND TWO AFTER THAT ELEMENT. IF THE ELEMENT SELECTED DOES NOT 00092590
C HAVE ONE ELEMENT BEFORE IT OR TWO AFTER THEN THE INDEPENDENT 00092600
C VARIABLE IS CLOSE TO ONE OF IT'S BOUNDS SO USE THE LAST OR 00092610
C FIRST FOUR ELEMENTS DEPENDING ON WHICH BOUND IS INVOLVED. 00092620
C 00092630
C 00092640
13510 IF(I.LT.PNT+2) I=PNT+2 00092650
IF(I.GT.PNT+COUNT-2) I=PNT+COUNT-2 00092660
D=VAR(I) 00092670
B=(VAR(I-1)+VAR(I+1)-2.D0*D)/2.D0 00092680
C=(8.D0*VAR(I+1)-7.D0*D-VAR(I+2)-4.D0*B)/6.D0 00092690
A=B-C+D-VAR(I-1) 00092700
13520 DISP=DPCT*DFLOAT(COUNT-1)-DFLOAT(I-PNT-1) 00092710
ACCUM=((A*DISP+B)*DISP+C)*DISP+D 00092720
GO TO 10000 00092730
13530 ARG2=ARG3 00092740
GO TO 13420 00092750
13540 ARG2=ARG4 00092760
GO TO 13420 00092770
13550 SUB = PNT + COUNT 00092780
ACCUM=(ARG2-ARG3)/(ARG4-ARG3)*(VAR(SUB)-VAR(PNT+1))+VAR(PNT+1) 00092790
GO TO 10000 00092800
13560 SUB = PNT + 2 00092810
ACCUM=(ARG2-ARG3)/(ARG4-ARG3)*DFLOAT(COUNT-1)* 00092820
1 (VAR(SUB)-VAR(SUB-1)) + VAR(SUB-1) 00092830
GO TO 10000 00092840
13570 SUB = PNT + COUNT 00092850
ACCUM=(ARG2-ARG4)/(ARG4-ARG3)*DFLOAT(COUNT-1)* 00092860
1 (VAR(SUB)-VAR(SUB-1)) + VAR(SUB) 00092870
GO TO 10000 00092880
END 00092900
C COPYRIGHT 1978 - UNIVERSITY OF NOTRE DAME 00092910
C PROGRAM AUTHOR - GARY PELKEY 00092920
C 00092930
C 00092940
SUBROUTINE NDT66 00092950
C 00092960
C 00092970
C THIS PROGRAM, THE OPTIONS PROCESSOR, GIVES THE USER A 00092980
C SUMMARY OF ERRORS FOR HIS PROGRAM, A LISTING AND COUNT OF 00092990
C EACH CARD TYPE IN THE PROGRAM, AND A LISTING OF THE VARIOUS 00093000
C OPTIONS CURRENTLY IN EFFECT. 00093010
C 00093020
C 00093030
REAL*8 RMIN,RMAX,LITBL(1024) 00093040
REAL SECND(3),THIRD(2,3),OUT(12),OPTS(3,2,12),TYPE1(19),TYPE2(19) 00093050
INTEGER PTRS(45),TITLE(120),CRSET(39),OPER(9),SYM(15), 00093060
1SUBSC(6),TYPCT(20),EQCHN(80),TOKEN(80),CARD1(80),CARD2(80), 00093070
2ERROR(80),OBJCD(160),DEF(80),XREF(80),TMAP(80),FCTN(5,22), 00093080
3SYMTB(5,512) 00093090
INTEGER LINCT,STMTS,PGMND,STPGM,SUM,WARNS,ERRS,CRITS,INTYP 00093100
INTEGER I,TRDPT,BAD(3),FIRST(3),J,K,PTR,BIT,OPTNS,OUTPT,PRNTR 00093110
COMMON RMIN,RMAX,PTRS,TITLE,CRSET,OPER,SYM,SUBSC,TYPCT, 00093120
1EQCHN,TOKEN,CARD1,CARD2,ERROR,OBJCD,DEF,XREF,TMAP,FCTN, 00093130
2SYMTB,LITBL 00093140
EQUIVALENCE (LINCT,PTRS(5)),(PGMND,PTRS(23)),(STPGM,PTRS(2 00093150
1 1)),(WARNS,PTRS(11)),(ERRS,PTRS(12)),(CRITS,PTRS(13)), 00093160
2(BAD(1),PTRS(11)),(OPTNS,PTRS(7)),(INTYP,PTRS(8)) 00093170
3,(PRNTR,PTRS(2)) 00093180
DATA FIRST /'W','E','C'/ 00093190
DATA SECND /'ARNI','RROR','RITI'/ 00093200
DATA THIRD /'NGS ','NG ','S ',' ','CALS','CAL '/ 00093210
DATA TYPE1 /'T ','C ','PARM','N ','L ','A ','R ', 00093220
1'S ','X ','* ','NOTE','PRIN','PLOT','RERU','MACR', 00093230
2'MEND','EXPN','DEF ','TITL'/ 00093240
DATA TYPE2 /' ',' ',' ',' ',' ',' ',' ', 00093250
1' ',' ',' ',' ','T ',' ','N ','O ', 00093260
2' ','D ',' ','E '/ 00093270
DATA OPTS /'NOCH','ECK ',' ','CHEC','K ',' ','NOSY','STEM',00093280
1' ','SYST','EM ',' ','NODO','CUME','NT ','DOCU', 00093290
2'MENT',' ','WIDE',' ',' ','NARR','OW ',' ', 00093300
3'STAT','S ',' ','A JO','KE I','T IS','GO ',' ', 00093310
4' ','NOGO',' ',' ','NOSY','MBOL',' ','SYMB', 00093320
5'OL ',' ','NOXR','EF ',' ','XREF',' ',' ', 00093330
6'WARN',' ',' ','NOWA','RN ',' ','NOOB','JECT', 00093340
7' ','OBJE','CT ',' ','SOUR','CE ',' ','NOSO', 00093350
8'URCE',' ','NOTI','ME ',' ','TIME',' ',' '/ 00093360
C 00093370
C 00093380
C WRITING OUT THE HEADING. 00093390
C 00093400
C 00093410
LINCT=-1 00093420
CALL NDT57 (5) 00093430
WRITE(PRNTR,200) 00093440
WRITE(PRNTR,100) 00093450
100 FORMAT(1X) 00093460
200 FORMAT(5X,'* * * S T A T S A N D O P T I O N S *', 00093470
1' * *') 00093480
C 00093490
C 00093500
C COMPUTING AND WRITING OUT THE NUMBER OF SOURCE STATEMENTS. 00093510
C 00093520
C 00093530
STMTS=(PGMND-STPGM+1)/9 00093540
WRITE(PRNTR,300) STMTS 00093550
300 FORMAT(5X,I4,' SOURCE STATEMENTS') 00093560
WRITE(PRNTR,100) 00093570
C 00093580
C 00093590
C A SUMMARY OF ERRORS IS GIVEN. IF NO ERRORS HAVE BEEN 00093600
C DETECTED, A MESSAGE TO THAT EFFECT IS GIVEN AND THE SUMMARY 00093610
C IS SKIPPED. 00093620
C 00093630
C 00093640
SUM=WARNS+ERRS+CRITS 00093650
IF(SUM-1) 900,350,360 00093660
350 WRITE(PRNTR,355) SUM 00093670
355 FORMAT(5X,I4,' DIAGNOSTIC MESSAGE') 00093680
GO TO 390 00093690
360 WRITE(PRNTR,365) SUM 00093700
365 FORMAT(5X,I4,' DIAGNOSTIC MESSAGES') 00093710
390 WRITE(PRNTR,100) 00093720
DO 700 I=1,3 00093730
TRDPT=1 00093740
IF(BAD(I)-1) 700,400,500 00093750
400 TRDPT=2 00093760
500 WRITE(PRNTR,600) BAD(I),FIRST(I),SECND(I),THIRD(TRDPT,I) 00093770
WRITE(PRNTR,100) 00093780
600 FORMAT(11X,I3,1X,A1,A4,A4) 00093790
700 CONTINUE 00093800
GO TO 1000 00093810
900 WRITE(PRNTR,950) 00093820
950 FORMAT(7X,'NO DIAGNOSTIC MESSAGES') 00093830
WRITE(PRNTR,100) 00093840
1000 WRITE(PRNTR,100) 00093850
C 00093860
C 00093870
C A SUMMARY OF THE TYPES AND HOW MANY OF EACH TYPE OF CARD 00093880
C IN THE USERS PROGRAM IS GIVEN. 00093890
C 00093900
C 00093910
WRITE(PRNTR,1100) 00093920
1100 FORMAT(6X,'CARD TYPE OCCURRENCE') 00093930
WRITE(PRNTR,100) 00093940
DO 2000 I=1,19 00093950
IF(TYPCT(I).EQ.0) GO TO 2000 00093960
WRITE(PRNTR,1500) TYPE1(I),TYPE2(I),TYPCT(I) 00093970
1500 FORMAT(8X,A4,A4,8X,I4) 00093980
2000 CONTINUE 00093990
IF(TYPCT(20).EQ.0) GO TO 3000 00094000
WRITE(PRNTR,2500) TYPCT(20) 00094010
2500 FORMAT(8X,'UNRECOGNIZED',5X,I3) 00094020
3000 WRITE(PRNTR,100) 00094030
WRITE(PRNTR,100) 00094040
C 00094050
C 00094060
C A LISTING OF WHICH OPTIONS ARE IN EFFECT OR NOT IN EFFECT 00094070
C IS GIVEN IN BLOCKED FORM. 00094080
C 00094090
C 00094100
WRITE(PRNTR,3100) 00094110
3100 FORMAT(6X,'OPTIONS IN EFFECT:') 00094120
WRITE(PRNTR,100) 00094130
DO 5000 I=1,3 00094140
DO 4000 J=1,4 00094150
PTR=4*(I-1)+J 00094160
BIT=MOD(OPTNS/2**(PTR-1),2) 00094170
DO 4000 K=1,3 00094180
OUTPT=3*(J-1)+K 00094190
4000 OUT(OUTPT)=OPTS(K,BIT+1,PTR) 00094200
4500 FORMAT(8X,12A4) 00094210
5000 WRITE(PRNTR,4500) OUT 00094220
WRITE(PRNTR,100) 00094230
WRITE(PRNTR,100) 00094240
C 00094250
C 00094260
C FINALLY, THE INTEGRATION TYPE BEING USED IN THE FIRST RUN 00094270
C IS LISTED. 00094280
C 00094290
C 00094300
WRITE(PRNTR,6000) 00094310
WRITE(PRNTR,100) 00094320
6000 FORMAT(6X,'INTEGRATION METHOD:') 00094330
GO TO (6100,6200,6300),INTYP 00094340
6100 WRITE(PRNTR,6150) 00094350
6150 FORMAT(11X,'EULER LOWER SUM') 00094360
GO TO 7000 00094370
6200 WRITE(PRNTR,6250) 00094380
6250 FORMAT(11X,'FOURTH ORDER RUNGE-KUTTA') 00094390
GO TO 7000 00094400
6300 WRITE(PRNTR,6350) 00094410
6350 FORMAT(11X,'ADAMS-BASHFORTH PREDICTOR') 00094420
7000 WRITE(PRNTR,100) 00094430
WRITE(PRNTR,100) 00094440
RETURN 00094450
END 00094460
C COPYRIGHT 1978 - UNIVERSITY OF NOTRE DAME 00094470
C PROGRAM AUTHOR - GARY PELKEY 00094480
C 00094490
C 00094500
SUBROUTINE NDT67 (SRTPT) 00094510
C 00094520
C 00094530
C THIS SUBROUTINE PRODUCES A SYMBOL TABLE LISTING. A TAG SORT 00094540
C HAS ALREADY BEEN PERFORMED ON THE SYMBOLS TO GET THEM IN 00094550
C ALPHABETICAL ORDER. THE TAGS ARE POINTERS TO THE SYMBOL 00094560
C TABLE AND ARE LOCATED IN THE SORT ARRAY FROM 1 TO SRTPT. 00094570
C BY UNPACKING THE VARIABLES ENTRY INTO THE SYM ARRAY, ALL 00094580
C THE INFORMATION IS PRESENT TO PRINT OUT THE VARIABLE'S 00094590
C NAME, NUMBER, TYPE AND OUTPUT REQUEST. 00094600
C 00094610
C 00094620
REAL*8 RMIN,RMAX,LITBL(1024) 00094630
INTEGER PTRS(45),TITLE(120),CRSET(39),OPER(9),SYM(15), 00094640
1SUBSC(6),TYPCT(20),EQCHN(80),TOKEN(80),CARD1(80),CARD2(80), 00094650
2ERROR(80),OBJCD(160),DEF(80),XREF(80),TMAP(80),FCTN(5,22), 00094660
3SYMTB(5,512) 00094670
INTEGER LINCT,TAG,TYPE,SMART,NAME(6),J,VNUM,SRTPT,PRNTR, 00094680
1SORT(2048) 00094690
REAL TNAME(4,8),REQST(4,4) 00094700
COMMON RMIN,RMAX,PTRS,TITLE,CRSET,OPER,SYM,SUBSC,TYPCT, 00094710
1EQCHN,TOKEN,CARD1,CARD2,ERROR,OBJCD,DEF,XREF,TMAP,FCTN, 00094720
2SYMTB,LITBL 00094730
EQUIVALENCE (LINCT,PTRS(5)),(TYPE,SYM(7)),(NAME(1),SYM(1)) 00094740
1,(VNUM,SYM(14)),(PRNTR,PTRS(2)),(LITBL(1),SORT(1)) 00094750
DATA TNAME /' ',' TA','BLE ',' ',' ','CONS','TANT', 00094760
1' ',' ','PARA','METE','R ',' ',' ',' ', 00094770
2' ',' ',' LE','VEL ',' ',' ','AUXI','LIAR', 00094780
3'Y ',' ',' RA','TE ',' ',' SU','PPLE','MENT', 00094790
4'ARY '/ 00094800
DATA REQST /' ',' ',' ',' ',' ','PRIN','T ', 00094810
1' ',' ',' PLO','T ',' ','PRIN','T AN','D PL', 00094820
2'OT '/ 00094830
C 00094840
C 00094850
C PAGING IS FORCED BY SETTING LINCT TO -1 AND CALLING NDT57. 00094860
C THE HEADING IS PRINTED OUT. 00094870
C 00094880
C 00094890
LINCT=-1 00094900
CALL NDT57 (4) 00094910
WRITE(PRNTR,700) 00094920
WRITE(PRNTR,800) 00094930
WRITE(PRNTR,900) 00094940
WRITE(PRNTR,800) 00094950
700 FORMAT(5X,'* * * * * * S Y M B O L T A B L E *', 00094960
1' * * * * *') 00094970
800 FORMAT(1X) 00094980
900 FORMAT(5X,'VARIABLE NAME VARIABLE TYPE OUTPUT REQ', 00094990
1'UEST VARIABLE NUMBER') 00095000
C 00095010
C 00095020
C THE TITLES AND HEADINGS HAVE BEEN PRINTED OUT AND ALL THAT 00095030
C REMAINS IS TO LOOP FROM 1 TO SRTPT, FORMAT THE OUTPUT FOR 00095040
C EACH VARIABLE, AND WRITE IT OUT. 00095050
C 00095060
C 00095070
DO 2000 I=1,SRTPT 00095080
TAG=SORT(I) 00095090
CALL NDT41 (SYMTB(1,TAG)) 00095100
SMART=SYM(9)*2+SYM(8)+1 00095110
2000 WRITE(PRNTR,3000) NAME,(TNAME(J,TYPE),J=1,4),(REQST(J,SMART 00095120
1),J=1,4),VNUM 00095130
3000 FORMAT(9X,6A1,5X,4A4,3X,4A4,8X,I4) 00095140
RETURN 00095150
END 00095170
C COPYRIGHT 1978 - UNIVERSITY OF NOTRE DAME 00095180
C PROGRAM AUTHOR - GARY PELKEY 00095190
C 00095200
C 00095210
SUBROUTINE NDT68 (SRTPT) 00095220
C 00095230
C 00095240
C THIS ROUTINE PERFORMS A CROSS REFERENCE LISTING ON ALL 00095250
C THE VARIABLES DEFINED IN THE USERS PROGRAM. ITS OUTPUT 00095260
C IS IN THE FORM OF A LIST WHICH CONTAINS THE VARIABLE'S 00095270
C NAME, THE STATEMENT NUMBER IT WAS DEFINED IN, AND THE 00095280
C STATEMENT NUMBERS OF ALL THE STATEMENTS IN WHICH IT IS 00095290
C REFERENCED. 00095300
C 00095310
C 00095320
REAL*8 RMIN,RMAX,LITBL(1024) 00095330
INTEGER PTRS(45),TITLE(120),CRSET(39),OPER(9),SYM(15), 00095340
1SUBSC(6),TYPCT(20),EQCHN(80),TOKEN(80),CARD1(80),CARD2(80), 00095350
2ERROR(80),OBJCD(160),DEF(80),XREF(80),TMAP(80),FCTN(5,22), 00095360
3SYMTB(5,512) 00095370
INTEGER LINCT,PRNTR,SETPT,I,SRTPT,TAG,J,OUT(120),BLANK, 00095380
1RECNO,DISK,LOC,SUB,NUM(10),FIRST,LAST,REFPT,RFCPT,DIST, 00095390
2START,STOP,FLAG,PNT,PNT2,TLIMT,REF,SORT(2048),VNUM, 00095400
3DEFBT,USDBT 00095410
COMMON RMIN,RMAX,PTRS,TITLE,CRSET,OPER,SYM,SUBSC,TYPCT, 00095420
1EQCHN,TOKEN,CARD1,CARD2,ERROR,OBJCD,DEF,XREF,TMAP,FCTN, 00095430
2SYMTB,LITBL 00095440
EQUIVALENCE (LINCT,PTRS(5)),(PRNTR,PTRS(2)),(BLANK,CRSET(1)), 00095450
1(RECNO,SYM(15)),(DISK,PTRS(3)),(NUM(1),CRSET(30)), 00095460
2(REFPT,XREF(1)),(RFCPT,XREF(2)),(TLIMT,PTRS(33)),(SORT(1), 00095470
3LITBL(1)),(VNUM,SYM(14)),(DEFBT,SYM(11)),(USDBT,SYM(10)), 00095480
4(OUT(1),OBJCD(1)) 00095490
C 00095500
C 00095510
C THE TITLE, HEADING, AND BLANK LINES ARE PRINTED. 00095520
C 00095530
C 00095540
LINCT=-1 00095550
CALL NDT57 (4) 00095560
WRITE(PRNTR,200) 00095570
WRITE(PRNTR,300) 00095580
200 FORMAT(5X,'* * * * * C R O S S R E F E R E N C', 00095590
1' E * * * * *'/) 00095600
300 FORMAT(5X,'VARIABLE NAME DEFINITION REFERENCES'/) 00095610
C 00095620
C 00095630
C MAINLINE ITERATIVE PROCESSING IS BEGUN. 00095640
C 00095650
C 00095660
SETPT=26 00095670
DO 5000 I=1,SRTPT 00095680
TAG=SORT(I) 00095690
CALL NDT41 (SYMTB(1,TAG)) 00095700
C 00095710
C 00095720
C THE LISTING OF THIS VARIABLE IS SUPPRESSED IF IT HAS NOT 00095730
C BEEN DEFINED IN AN EQUATION. 00095740
C 00095750
C 00095760
IF(DEFBT.EQ.0) GO TO 5000 00095770
C 00095780
C 00095790
C THE OUTPUT BUFFER IS BLANKED OUT. 00095800
C 00095810
C 00095820
DO 400 J=1,TLIMT 00095830
400 OUT(J)=BLANK 00095840
C 00095850
C 00095860
C THE VARIABLE'S NAME IS MOVED INTO THE NAME FIELD. 00095870
C 00095880
C 00095890
DO 500 J=1,6 00095900
500 OUT(J+8)=SYM(J) 00095910
C 00095920
C 00095930
C THE CROSS REFERENCE INFORMATION FOR THIS VARIABLE IS MOVED 00095940
C INTO MEMORY FROM DISK. 00095950
C 00095960
C 00095970
READ(DISK'RECNO+7) XREF 00095980
C 00095990
C 00096000
C THE STATEMENT DEFINITION NUMBER IS PLACED INTO ITS FIELD. 00096010
C THIS STEP IS SKIPPED IF THE VARIABLE IS TIME. 00096020
C 00096030
C 00096040
IF(VNUM.EQ.12) GO TO 600 00096050
CALL NDT45 (XREF(3),OUT(25),1) 00096060
C 00096070
C 00096080
C BRING ALL REFERENCES INTO SORT STARTING AFTER SRTPT IF THERE 00096090
C ARE ANY (USDBT=1). OTHERWISE SIMPLY WRITE OUT THE NAME AND 00096100
C THE STATEMENT DEFINITION NUMBER AND PROCESS THE NEXT VARIABLE. 00096110
C 00096120
C 00096130
600 IF(USDBT.EQ.0) GO TO 4900 00096140
FIRST=SRTPT+1 00096150
LAST=SRTPT 00096160
900 DO 1000 J=4,REFPT 00096170
LAST=LAST+1 00096180
1000 SORT(LAST)=XREF(J) 00096190
IF(RFCPT.EQ.0) GO TO 3000 00096200
READ(DISK'RFCPT) XREF 00096210
GO TO 900 00096220
C 00096230
C 00096240
C THE REFERENCES ARE NOW PLACED IN THE OUT ARRAY AND 00096250
C THE ARRAY IS PRINTED OUT WHEN IT IS FILLED UP TO 'TLIMT'. 00096260
C 00096270
C 00096280
3000 PNT=SETPT 00096290
DO 4000 REF=FIRST,LAST 00096300
PNT=PNT+6 00096310
OUT(PNT)=BLANK 00096320
OUT(PNT+1)=BLANK 00096330
CALL NDT45 (SORT(REF),OUT(PNT+2),1) 00096340
IF(PNT+13.LE.TLIMT) GO TO 4000 00096350
CALL NDT57 (1) 00096360
WRITE(PRNTR,3300) (OUT(K),K=1,TLIMT) 00096370
3300 FORMAT(1X,120A1) 00096380
STOP=SETPT+6 00096390
DO 3500 J=1,STOP 00096400
3500 OUT(J)=BLANK 00096410
PNT=SETPT 00096420
4000 CONTINUE 00096430
C 00096440
C 00096450
C THE OUT BUFFER MUST BE PRINTED OUT ONE MORE TIME IF IT IS 00096460
C JUST PARTIALLY FILLED. (IF PNT=SETPT, IT HAS JUST BEEN 00096470
C PRINTED OUT ABOVE.) 00096480
C 00096490
C 00096500
IF(PNT.EQ.SETPT) GO TO 5000 00096510
4900 CALL NDT57 (1) 00096520
WRITE(PRNTR,3300) (OUT(K),K=1,TLIMT) 00096530
5000 CONTINUE 00096540
RETURN 00096550
END 00096570
C COPYRIGHT 1978 - UNIVERSITY OF NOTRE DAME 00096580
C PROGRAM AUTHOR - DANIEL A. POYDENCE 00096590
C 00096600
C 00096610
SUBROUTINE NDT69 00096620
REAL*8 RMIN,RMAX,LITBL(1024) 00096630
INTEGER PTRS(45),TITLE(120),CRSET(39),OPER(9),SYM(15), 00096640
1SUBSC(6),TYPCT(20),EQCHN(80),TOKEN(80),CARD1(80),CARD2(80), 00096650
2ERROR(80),OBJCD(160),DEF(80),XREF(80),TMAP(80),FCTN(5,22), 00096660
3SYMTB(5,512) 00096670
INTEGER PRNTR,LINCT 00096680
COMMON RMIN,RMAX,PTRS,TITLE,CRSET,OPER,SYM,SUBSC,TYPCT, 00096690
1EQCHN,TOKEN,CARD1,CARD2,ERROR,OBJCD,DEF,XREF,TMAP,FCTN, 00096700
2SYMTB,LITBL 00096710
EQUIVALENCE (PRNTR,PTRS(2)),(LINCT,PTRS(5)) 00096720
LINCT=-1 00096730
CALL NDT57 (1) 00096740
WRITE(PRNTR,100) 00096750
100 FORMAT('A SYSTEM ANALYSIS IS CURRENTLY UNAVAILABLE.') 00096760
RETURN 00096770
END 00096780
C* 00096790
C 00096800
C COPYRIGHT (C) 1978 - UNIVERSITY OF NOTRE DAME 00096810
C PROGRAM AUTHOR - TIMOTHY J. MALLOY 00096820
C 00096830
C* 00096840
SUBROUTINE NDT70 00096850
C* 00096860
C 00096870
C OUTPUT PHASE 00096880
C 00096890
C THIS PROGRAM COORDINATES ALL OUTPUT. IT BRINGS IN THE DATA 00096900
C AND THE OUTPUT BUFFERS FROM DISK, AND COMPLETES THE TITLE 00096910
C DATA FOR OUTPUTTING. THEN IT WILL CALL THE PRINT OR PLOT 00096920
C ROUTINE APPROPRIATELY. 00096930
C 00096940
C* 00096950
REAL*8 RMIN,RMAX,VAR(5000), ACCUM,EXTME,RSTME(10) 00096960
INTEGER PTRS(45),TITLE(120),CRSET(39),OPER(9),SYM(15), 00096970
1SUBSC(6),OUTPT(240),LINE(120),OBJCD(6000) 00096980
INTEGER DISK,LINCT,TPNT,TLIMT,OCBST,OCBPT,OCBND,BLANK,DASH, 00096990
1VARCT,TYPE,CFLAG,OUT1(80),OUT2(80),OUT3(80),OAB, 00097000
2OUTCT,DBEND,FIRST,LAST,LOOP,SUB,FADDR,PNTR,FLOC,START, 00097010
3STOP,TEND,FHIGH,REC,VARND 00097020
COMMON RMIN,RMAX,PTRS,TITLE,CRSET,OPER,SYM,SUBSC,OUTPT,LINE, 00097030
1EXTME,RSTME,ACCUM,VAR 00097040
EQUIVALENCE (DISK,PTRS(3)),(LINCT,PTRS(5)),(TPNT,PTRS(30)), 00097050
1(TLIMT,PTRS(33)),(OCBST,PTRS(42)),(OCBPT,PTRS(43)), 00097060
2(OCBND,PTRS(44)),(BLANK,CRSET(1)),(DASH,OPER(3)), 00097070
3(OAB,PTRS(12)),(OUTCT,PTRS(10)),(DBEND,PTRS(22)) 00097080
EQUIVALENCE (VARCT,OUTPT(1),OUT1(1)),(TYPE,OUTPT(2)), 00097090
1(OUT2(1),OUTPT(81)),(OUT3(1),OUTPT(161),FHIGH), 00097100
2(START,OUTPT(162)),(STOP,OUTPT(163)),(CFLAG,OUTPT(200)) 00097110
EQUIVALENCE (VAR(1),OBJCD(1)),(VARND,PTRS(26)) 00097120
C* 00097130
C 00097140
C OCBPT SETS UP THE MASTER LOOP, GOING THROUGH ONCE FOR EACH 00097150
C OUTPUT REQUEST. 00097160
C 00097170
C LINCT IS SET TO -1 TO FORCE PAGING. 00097180
C 00097190
C* 00097200
DO 3000 OCBPT = OCBST, OCBND, 3 00097210
LINCT = -1 00097220
C* 00097230
C 00097240
C READ THE OUTPT ARRAY IN TO COMMON FROM DISK. 00097250
C 00097260
C* 00097270
READ (DISK'OCBPT) OUT1 00097280
READ (DISK'OCBPT+1) OUT2 00097290
READ (DISK'OCBPT+2) OUT3 00097300
C* 00097310
C 00097320
C COMPLETE THE TITLE ARRAY FOR THIS OUTPUT REQUEST. 00097330
C 00097340
C IF THERE IS NO SUBTITLE DATA (CFLAG=0), OR IF THERE IS 00097350
C NO ROOM FOR IT, DO NOT ATTEMPT TO PROCESS THE DATA. 00097360
C 00097370
C IF THE PROGRAM IS TITLE-LESS, SUPPRESS THE PRINTING OF 00097380
C DASH. 00097390
C 00097400
C* 00097410
FIRST = TPNT + 1 00097420
IF (FIRST .GT. TLIMT-3) GO TO 1000 00097430
TEND = TLIMT - 14 00097440
DO 100 LOOP = FIRST, TEND 00097450
100 TITLE(LOOP) = BLANK 00097460
IF (CFLAG .EQ. 0) GO TO 1000 00097470
IF (FIRST .EQ. 10) GO TO 200 00097480
TITLE(FIRST+1) = DASH 00097490
FIRST = FIRST + 3 00097500
200 LAST = FIRST + 39 00097510
IF (LAST .GT. TEND) LAST = TEND 00097520
DO 300 LOOP = FIRST, LAST 00097530
SUB = 201 + LOOP - FIRST 00097540
300 TITLE(LOOP) = OUTPT(SUB) 00097550
C* 00097560
C 00097570
C CALCULATE THE ADDRESSES FOR THE DATA BUFFER. 00097580
C 00097590
C* 00097600
1000 FADDR = OAB + (OCBPT-OCBST)/3 00097610
FLOC = OBJCD(FADDR) 00097620
FHIGH = OBJCD(FLOC + 5) 00097630
C* 00097640
C 00097650
C PULL DATA IN FROM DISK TO CORE. 00097660
C 00097670
C FIRST, READ IN ANY DATA THAT WAS WRITTEN OUT TO DISK. 00097680
C 00097690
C* 00097700
FIRST = (OCBPT-OCBST)/3 + 1 + OCBND 00097710
START = DBEND + 1 00097720
REC = OBJCD(FLOC + 4) 00097730
LAST = REC - OUTCT 00097740
IF (LAST .LT. FIRST) GO TO 2100 00097750
DO 2000 LOOP = FIRST, LAST, OUTCT 00097760
STOP = START + 39 00097770
IF (STOP .GT. VARND) CALL NDT12(8) 00097780
READ (DISK'LOOP) (VAR(SUB),SUB=START,STOP) 00097790
2000 START = STOP + 1 00097800
C* 00097810
C 00097820
C BRING IN ANY DATA THAT WAS STILL IN THE OBJCD ARRAY TO 00097830
C THE VAR ARRAY, BEHIND THE DATA FROM DISK. 00097840
C 00097850
C* 00097860
2100 LOOP = START 00097870
START = FHIGH + 2*VARCT 00097880
STOP = OBJCD(FLOC + 6) 00097890
IF (STOP .LT. START) GO TO 2300 00097900
DO 2200 SUB = START, STOP 00097910
VAR(LOOP) = VAR(SUB) 00097920
2200 LOOP = LOOP + 1 00097930
2300 START = DBEND + 1 00097940
STOP = LOOP - VARCT 00097950
C* 00097960
C 00097970
C CALL EITHER THE PRINT OR PLOT ROUTINE. 00097980
C 00097990
C* 00098000
IF (STOP .LT. START) GO TO 3000 00098010
IF (TYPE .EQ. 12) CALL NDT71 00098020
IF (TYPE .EQ. 13) CALL NDT72 00098030
3000 CONTINUE 00098040
RETURN 00098050
END 00098070
C* 00098080
C 00098090
C COPYRIGHT (C) 1978 - UNIVERSITY OF NOTRE DAME 00098100
C PROGRAM AUTHOR - GARY PELKEY 00098110
C TRANSLATED BY - TIMOTHY J. MALLOY 00098120
C 00098130
C* 00098140
SUBROUTINE NDT71 00098150
C* 00098160
C 00098170
C PRINT 00098180
C 00098190
C THIS ROUTINE HANDLES PRINTED OUTPUT. 00098200
C 00098210
C* 00098220
REAL*8 RMIN,RMAX,VAR(5000), ACCUM,EXTME,RSTME(10) 00098230
INTEGER PTRS(45),TITLE(120),CRSET(39),OPER(9),SYM(15), 00098240
1SUBSC(6),OUTPT(240),LINE(120),OBJCD(6000) 00098250
INTEGER VARCT,PLINS,AFTER(11),CRSTC(11),ECHAR(4,11),FLOC, 00098260
1START,STOP,OUT(7,11),PRNTR,BLANK,E,PLUS,MINUS,NUM(10) 00098270
INTEGER LOOP,HIPNT,FHIGH,HCRST,LCRST,MOVES,SUB,BUFF 00098280
COMMON RMIN,RMAX,PTRS,TITLE,CRSET,OPER,SYM,SUBSC,OUTPT,LINE, 00098290
1EXTME,RSTME,ACCUM,VAR 00098300
EQUIVALENCE (VAR(1),OBJCD(1)) 00098310
EQUIVALENCE (VARCT,OUTPT(1)),(PLINS,PTRS(32)),(AFTER(1), 00098320
1OUTPT(92)),(CRSTC(1),OUTPT(103)),(ECHAR(1,1),OUTPT(114)), 00098330
2(FLOC,OUTPT(161)),(START,OUTPT(162)),(STOP,OUTPT(163)), 00098340
3(OUT(1,1),OUTPT(164)),(FHIGH,OUTPT(161)) 00098350
EQUIVALENCE (PRNTR,PTRS(2)),(BLANK,CRSET(1)),(E,CRSET(8)), 00098360
1(PLUS,OPER(2)),(MINUS,OPER(3)),(NUM(1),CRSET(30)) 00098370
C* 00098380
C 00098390
C SET PLINS --- THE NUMBER OF LINES IN THE OUTPUT HEADING 00098400
C 00098410
C* 00098420
PLINS = 2 00098430
C* 00098440
C 00098450
C ENTER A LOOP TO DETERMINE EACH VARIABLE'S PRINT 00098460
C CHARACTERISTIC. 00098470
C 00098480
C SCALE IS A 2 BY 11 ARRAY WHICH HOLDS THIS CHARACTERISTIC 00098490
C INFORMATION. THE FIRST ROW IN SCALE CONTAINS THE NUMBER 00098500
C OF PLACES AFTER THE DECIMAL POINT FOR THE CORRESPONDING 00098510
C VARIABLE, AND THE SECOND ROW CONTAINS THE CHARACTERISTIC. 00098520
C 00098530
C* 00098540
DO 500 LOOP = 1, VARCT 00098550
HIPNT = FHIGH + 2*(LOOP-1) 00098560
CALL NDT77(VAR(HIPNT),HCRST) 00098570
IF (HCRST .LE. -1 .OR. HCRST .GE. 3) GO TO 200 00098580
AFTER(LOOP) = 4 - HCRST 00098590
CRSTC(LOOP) = 0 00098600
GO TO 500 00098610
200 AFTER(LOOP) = 4 00098620
CRSTC(LOOP) = HCRST 00098630
400 MOVES = MOD(IABS(HCRST),3) 00098640
IF(HCRST .LT. 0 .AND. MOVES .NE. 0) MOVES = 3 - MOVES 00098650
AFTER(LOOP) = AFTER(LOOP) - MOVES 00098660
CRSTC(LOOP) = CRSTC(LOOP) - MOVES 00098670
IF (CRSTC(LOOP) .NE. 0) PLINS = 3 00098680
500 CONTINUE 00098690
C 00098700
C BLANK OUT THE ECHAR ARRAY, AND THEN FILL IT TO HOLD THE 00098710
C EXPONENTIAL CHARACTERS FOR PRINTING. 00098720
C 00098730
C* 00098740
DO 600 LOOP = 114, 157 00098750
600 OUTPT(LOOP) = BLANK 00098760
IF (PLINS .EQ. 2) GO TO 800 00098770
DO 700 LOOP = 1, VARCT 00098780
ECHAR(1,LOOP) = E 00098790
ECHAR(2,LOOP) = PLUS 00098800
IF (CRSTC(LOOP) .LT. 0) ECHAR(2,LOOP) = MINUS 00098810
SUB = IABS(CRSTC(LOOP)/10) + 1 00098820
ECHAR(3,LOOP) = NUM(SUB) 00098830
SUB = IABS(CRSTC(LOOP)) - SUB*10 + 11 00098840
700 ECHAR(4,LOOP) = NUM(SUB) 00098850
C* 00098860
C 00098870
C BLANK OUT THE OUT ARRAY, WHICH WILL BE USED TO STORE THE 00098880
C ACTUAL CHARACTERS USED FOR OUTPUT. 00098890
C 00098900
C* 00098910
800 DO 900 LOOP = 164, 240 00098920
900 OUTPT(LOOP) = BLANK 00098930
C* 00098940
C 00098950
C GO THROUGH THE DATA BUFFERS, CONVERT THE DATA TO CHARACTERS 00098960
C BY CALLING NDT43, AND PRINT OUT THE OUTPUT. 00098970
C 00098980
C* 00098990
DO 1100 BUFF = START, STOP, VARCT 00099000
DO 1000 LOOP = 1, VARCT 00099010
SUB = BUFF + LOOP - 1 00099020
1000 CALL NDT43(VAR(SUB),OUT(1,LOOP),CRSTC(LOOP),AFTER(LOOP)) 00099030
CALL NDT78(1) 00099040
WRITE (PRNTR,1200) ((OUT(SUB,LOOP),SUB=1,7),LOOP=1,VARCT) 00099050
1100 CONTINUE 00099060
1200 FORMAT(5X,11(1X,7A1,2X)) 00099070
RETURN 00099080
END 00099100
C* 00099110
C 00099120
C COPYRIGHT (C) 1978 - UNIVERSITY OF NOTRE DAME 00099130
C PROGRAM AUTHOR - TIMOTHY J. MALLOY 00099140
C 00099150
C* 00099160
SUBROUTINE NDT72 00099170
C* 00099180
C 00099190
C PLOT PRELIMINARIES 00099200
C 00099210
C* 00099220
REAL*8 RMIN,RMAX,VAR(5000), ACCUM,EXTME,RSTME(10) 00099230
REAL*8 LOW(11),HIGH(11) 00099240
INTEGER PTRS(45),TITLE(120),CRSET(39),OPER(9),SYM(15), 00099250
1SUBSC(6),OUTPT(240),LINE(120),OBJCD(6000) 00099260
INTEGER VARCT,SRNUM,FLAG(11),PLINS,SRCNT,LSTSR,CLNUM, 00099270
1POS,OPTNS,NARO,PLTSZ,PLTBG,PLTND,PLTDV,IVPLT,I, 00099280
2IVNAM(10),BLANK 00099290
COMMON RMIN,RMAX,PTRS,TITLE,CRSET,OPER,SYM,SUBSC,OUTPT,LINE, 00099300
1EXTME,RSTME,ACCUM,VAR 00099310
EQUIVALENCE (VARCT,OUTPT(1)),(SRNUM,OUTPT(171)),(LOW(1), 00099320
1OUTPT(103)),(HIGH(1),OUTPT(125)),(FLAG(1),OUTPT(147)), 00099330
2(PLINS,PTRS(32)),(OPTNS,PTRS(7)),(PLTSZ,OUTPT(164)),(PLTDV, 00099340
3OUTPT(165)),(PLTBG,OUTPT(166)),(PLTND,OUTPT(167)), 00099350
4(VAR(1),OBJCD(1)),(SRCNT,OUTPT(178)),(IVPLT,OUTPT(158)), 00099360
5(BLANK,CRSET(1)),(IVNAM(1),OUTPT(2)) 00099370
C* 00099380
C 00099390
C SET PLINS --- THE NUMBER OF LINES IN THE OUTPUT HEADING 00099400
C 00099410
C* 00099420
PLINS = - (SRCNT + 2) 00099430
C* 00099440
C 00099450
C SET THE PLOT VARIABLES WHICH DESIGNATE THE SIZE OF THE PLOT, 00099460
C ITS BEGINNING AND END POSITIONS ON THE OUTPUT PAGE, AND THE 00099470
C SIZE OF THE DIVISION BETWEEN THE GRIDS ON THE PLOTTED PAGE. 00099480
C 00099490
C* 00099500
NARO = MOD(OPTNS/8,2) 00099510
PLTSZ = 89 - 32*NARO 00099520
PLTBG = 1 + 6*NARO 00099530
PLTND = 120 - 42*NARO 00099540
PLTDV = (PLTSZ - 1)/4 00099550
C* 00099560
C 00099570
C GO THROUGH THE FLAG ARRAY, AND FOR EACH DISTINCT SERIES 00099580
C CALL NDT79 TO GET THE HIGH AND LOW VALUES FOR THAT SERIES. 00099590
C 00099600
C* 00099610
LSTSR = 0 00099620
DO 100 CLNUM = 1, VARCT 00099630
SRNUM = FLAG(CLNUM)/10 00099640
IF (SRNUM .EQ. LSTSR) GO TO 100 00099650
CALL NDT79 00099660
LSTSR = SRNUM 00099670
100 CONTINUE 00099680
C* 00099690
C 00099700
C NOW COPY THE HIGH AND LOW VALUES FOR EACH VARIABLE, 00099710
C ACCORDING TO ITS SERIES. 00099720
C 00099730
C REMEMBER: DIVIDING FLAG BY TEN LEAVES THE SERIES NUMBER. 00099740
C 00099750
C* 00099760
DO 200 CLNUM = 1, VARCT 00099770
FLAG(CLNUM) = FLAG(CLNUM)/10 00099780
POS = FLAG(CLNUM) 00099790
LOW(CLNUM) = LOW(POS) 00099800
200 HIGH(CLNUM) = HIGH(POS) 00099810
C* 00099820
C 00099830
C MOVE THE INDEP VAR NAME FIELD FROM AN 00099840
C EIGHT WORD ARRAY TO A TEN WORD ARRAY. 00099850
C 00099860
C* 00099870
DO 400 I = 2, 9 00099880
400 IVNAM(I) = IVNAM(I+1) 00099890
IVNAM(1) = BLANK 00099900
IVNAM(10) = BLANK 00099910
C* 00099920
C 00099930
C IVPLT IS 0 FOR A TIME PLOT, 1 FOR AN X//Y PLOT. 00099940
C 00099950
C CALL THE APPROPRIATE PLOT ROUTINE. 00099960
C 00099970
C BUT FIRST MAKE SURE THE LINE ARRAY IS BLANK. 00099980
C 00099981
C* 00099982
DO 450 I = 1, 120 00099983
450 LINE(I) = BLANK 00099984
IF (IVPLT .EQ. 0) GO TO 300 00099990
CALL NDT74 00100000
GO TO 500 00100010
300 CALL NDT73 00100020
500 RETURN 00100030
END 00100050
C* 00100060
C 00100070
C COPYRIGHT (C) 1978 - UNIVERSITY OF NOTRE DAME 00100080
C PROGRAM AUTHOR - TIMOTHY J. MALLOY 00100090
C 00100100
C* 00100110
SUBROUTINE NDT73 00100120
C* 00100130
C 00100140
C TIME PLOT 00100150
C 00100160
C* 00100170
REAL*8 RMIN,RMAX,VAR(5000), ACCUM,EXTME,RSTME(10) 00100180
REAL*8 LOW(11),HIGH(11) 00100190
INTEGER PTRS(45),TITLE(120),CRSET(39),OPER(9),SYM(15), 00100200
1SUBSC(6),OUTPT(240),LINE(120),OBJCD(6000) 00100210
INTEGER PRNTR,BLANK,DOT,COMMA,VARCT,START,STOP,PLTSZ,PLTDV, 00100220
1PLTBG,PLTND,PCHAR,ODD,IVPRT,CHAR(10),PLOT(89),DUP(17), 00100230
2OVRLP(11),LOOP,I,CLNUM,PLACE,HERE,POS,END 00100240
COMMON RMIN,RMAX,PTRS,TITLE,CRSET,OPER,SYM,SUBSC,OUTPT,LINE, 00100250
1EXTME,RSTME,ACCUM,VAR 00100260
EQUIVALENCE (VAR(1),OBJCD(1)) 00100270
EQUIVALENCE (PRNTR,PTRS(2)),(BLANK,CRSET(1)),(DOT,OPER(1)), 00100280
1(COMMA,OPER(9)),(VARCT,OUTPT(1)),(LOW(1),OUTPT(103)), 00100290
2(HIGH(1),OUTPT(125)),(START,OUTPT(162)),(STOP,OUTPT(163)), 00100300
3(PLTSZ,OUTPT(164)),(PLTDV,OUTPT(165)),(PLTBG,OUTPT(166)), 00100310
4(PLTND,OUTPT(167)),(PCHAR,OUTPT(168)),(ODD,OUTPT(169)), 00100320
5(IVPRT,OUTPT(170)),(CHAR(1),OUTPT(190)),(PLOT(1),LINE(14)), 00100330
6(DUP(1),LINE(105)),(OVRLP(1),OUTPT(179)) 00100340
C* 00100350
C 00100360
C PHASE I --- INITIALIZATION 00100370
C 00100380
C 00100390
C LOOP IS USED TO KEEP TRACK OF THE BUFFER ADDRESS. 00100400
C 00100410
C IVPRT CAUSES EVERY TENTH LINE TO BE GRIDDED. 00100420
C 00100430
C* 00100440
IVPRT = 1 00100450
DO 1300 LOOP = START, STOP, VARCT 00100460
C* 00100470
C 00100480
C THE LAST LINE OF DATA IS ALWAYS GRIDDED. 00100490
C 00100500
C CHECK FOR THE NEED TO GRID THIS LINE (NDT82). 00100510
C 00100520
C* 00100530
IF (LOOP .GT. STOP-VARCT) IVPRT = 1 00100540
CALL NDT82(VAR(LOOP)) 00100550
C* 00100560
C 00100570
C ZERO OUT THE PLOT AND OVERLAP ARRAYS. 00100580
C 00100590
C* 00100600
DO 200 I = 1, PLTSZ 00100610
200 PLOT(I) = 0 00100620
DO 300 I = 1, 11 00100630
300 OVRLP(I) = 0 00100640
C* 00100650
C 00100660
C PHASE II --- INTERPRETATION 00100670
C 00100680
C 00100690
C TRANSFER DATA FROM THE BUFFER TO THE PLOT. 00100700
C 00100710
C IF THE PLACE THE DATA WOULD APPEAR ON THE PLOT LINE IS NOT 00100720
C IN THE RANGE, IGNORE IT. 00100730
C 00100740
C* 00100750
DO 500 CLNUM = 2, VARCT 00100760
POS = LOOP + CLNUM - 1 00100770
PLACE=(VAR(POS)-LOW(CLNUM))*((PLTSZ-1)/(HIGH(CLNUM)-LOW(CLNUM))) 00100780
A+1.5D0 00100790
IF (PLACE .LT. 1 .OR. PLACE .GT. PLTSZ) GO TO 500 00100800
C* 00100810
C 00100820
C CHECK FOR OVERLAPS. 00100830
C 00100840
C* 00100850
IF (PLOT(PLACE) .EQ. 0) GO TO 400 00100860
HERE = PLOT(PLACE) 00100870
OVRLP(CLNUM) = HERE 00100880
OVRLP(HERE) = -1 00100890
GO TO 500 00100900
C* 00100910
C 00100920
C STORE THE VARIABLE NUMBER ON THE PLOT LINE. 00100930
C 00100940
C* 00100950
400 PLOT(PLACE) = CLNUM 00100960
500 CONTINUE 00100970
C* 00100980
C 00100990
C PHASE III --- OVERLAP 00101000
C 00101010
C 00101020
C GO THROUGH THE OVERLAP ARRAY. IF OVRLP IS NOT ZERO, 00101030
C THERE WAS NO OVERLAP. 00101040
C 00101050
C* 00101060
HERE = 1 00101070
DO 700 CLNUM = 2, VARCT 00101080
IF (OVRLP(CLNUM) .GE. 0) GO TO 700 00101090
C* 00101100
C 00101110
C AN OVERLAP OCCURRED --- NOW CHECK TO SEE WHICH WERE SUPPRESSED 00101120
C AND NOTE THEM IN THE DUP ARRAY. 00101130
C 00101140
C* 00101150
DUP(HERE) = CHAR(CLNUM - 1) 00101160
HERE = HERE + 1 00101170
PLACE = CLNUM + 1 00101180
DO 600 I = PLACE, VARCT 00101190
IF (OVRLP(I) .NE. CLNUM) GO TO 600 00101200
DUP(HERE) = CHAR(I - 1) 00101210
HERE = HERE + 1 00101220
600 CONTINUE 00101230
DUP(HERE) = COMMA 00101240
HERE = HERE + 1 00101250
700 CONTINUE 00101260
C* 00101270
C 00101280
C BLANK OUT THE REST OF THE DUP ARRAY. 00101290
C 00101300
C* 00101310
IF (HERE .NE. 1) HERE = HERE - 1 00101320
DO 800 I = HERE, 17 00101330
800 DUP(I) = BLANK 00101340
C* 00101350
C 00101360
C TRANSFER DUP ARRAY ONTO THE PLOT LINE. 00101370
C 00101380
C* 00101390
DO 900 I = 1, 16 00101400
POS = PLTSZ + 15 + I 00101410
900 LINE(POS) = DUP(I) 00101420
LINE(PLTSZ + 14) = BLANK 00101430
LINE(PLTSZ + 15) = BLANK 00101440
C* 00101450
C 00101460
C PHASE IV --- CHARACTER TRANSFER 00101470
C 00101480
C 00101490
C CHANGE THE VARIABLE NUMBERS TO CHARACTERS. 00101500
C CHECK THE FIRST POSITION, AND THEN EACH PLACE ON THE 00101510
C PLOT LINE. 00101520
C 00101530
C* 00101540
PCHAR = DOT 00101550
CALL NDT81(PLOT(1)) 00101560
DO 1100 I = 2, PLTSZ, PLTDV 00101570
END = PLTDV - 2 + I 00101580
DO 1000 PLACE = I, END 00101590
PCHAR = BLANK 00101600
IF (PLACE .NE. PLACE/2*2) PCHAR = ODD 00101610
CALL NDT81(PLOT(PLACE)) 00101620
1000 CONTINUE 00101630
C* 00101640
C 00101650
C CHECK END + 1 00101660
C 00101670
C* 00101680
PCHAR = DOT 00101690
CALL NDT81(PLOT(END + 1)) 00101700
1100 CONTINUE 00101710
C* 00101720
C 00101730
C PHASE V --- OUTPUTTING THE FINISHED PLOT LINE 00101740
C 00101750
C 00101760
C* 00101770
CALL NDT78(1) 00101780
WRITE (PRNTR,1200) (LINE(I),I=PLTBG,PLTND) 00101790
1200 FORMAT (1X, 120A1) 00101800
1300 CONTINUE 00101810
RETURN 00101820
END 00101840
C* 00101850
C 00101860
C COPYRIGHT (C) 1978 - UNIVERSITY OF NOTRE DAME 00101870
C PROGRAM AUTHOR - TIMOTHY J. MALLOY 00101880
C 00101890
C* 00101900
SUBROUTINE NDT74 00101910
C* 00101920
C 00101930
C INDEPENDENT VARIABLE PLOT 00101940
C 00101950
C* 00101960
REAL*8 RMIN,RMAX,VAR(5000), ACCUM,EXTME,RSTME(10) 00101970
REAL*8 LOW(11),HIGH(11),IVHI,IVLOW,INVAL,INRNG,IVVAL,RANGE 00101980
INTEGER PTRS(45),TITLE(120),CRSET(39),OPER(9),SYM(15), 00101990
1SUBSC(6),OUTPT(240),LINE(120),OBJCD(6000) 00102000
INTEGER PRNTR,LINPP,PLINS,BLANK,DOT,VARCT,START,STOP,PLTSZ, 00102010
1PLTDV,PLTBG,PLTND,PCHAR,ODD,IVPRT,CHAR(10),PLOT(89),SUB, 00102020
2END,NARO,DPLOT,LNLFT,CLNUM,NVAR,PLACE,OPTNS 00102030
COMMON RMIN,RMAX,PTRS,TITLE,CRSET,OPER,SYM,SUBSC,OUTPT,LINE, 00102040
1EXTME,RSTME,ACCUM,VAR 00102050
EQUIVALENCE (VAR(1),OBJCD(1)) 00102060
EQUIVALENCE (PRNTR,PTRS(2)),(LINPP,PTRS(6)),(PLINS,PTRS(32)), 00102070
1(BLANK,CRSET(1)),(DOT,OPER(1)),(VARCT,OUTPT(1)),(LOW(1), 00102080
2OUTPT(103),IVLOW),(HIGH(1),OUTPT(125),IVHI),(START, 00102090
3OUTPT(162)),(STOP,OUTPT(163)),(PLTSZ,OUTPT(164)),(PLTDV, 00102100
4OUTPT(165)),(PLTBG,OUTPT(166)),(PLTND,OUTPT(167)),(PCHAR, 00102110
5OUTPT(168)),(ODD,OUTPT(169)),(IVPRT,OUTPT(170)),(CHAR(1), 00102120
6OUTPT(190)),(PLOT(1),LINE(14)),(SUB,END),(OPTNS,PTRS(7)) 00102130
C* 00102140
C 00102150
C NARROW VARIABLE-VARIABLE PLOT IS SHIFTED TWO PLACES. 00102160
C 00102170
C* 00102180
NARO = MOD(OPTNS/8,2) 00102190
PLTBG = PLTBG - 2*NARO 00102200
PLTND = PLTND - 2*NARO 00102210
DPLOT = 51 - NARO*10 00102220
C* 00102230
C 00102240
C CALCULATE THE SIZE OF THE PLOT. 00102250
C 00102260
C* 00102270
LNLFT = LINPP + PLINS - 2 00102280
LNLFT = LNLFT - MOD(LNLFT,10) 00102290
IF (LNLFT .GT. DPLOT) LNLFT = DPLOT 00102300
IVPRT = 1 00102310
C* 00102320
C 00102330
C SORT THE DATA TO MAKE CERTAIN IT IS IN ORDER. 00102340
C 00102350
C* 00102360
CALL NDT83 00102370
C* 00102380
C 00102390
C THE VARIABLE-VARIABLE PLOT HAS ONE LINE FOR EVERY RANGE 00102400
C OF VALUES. IVVAL KEEPS TRACK OF THE CURRENT LOCATION. 00102410
C 00102420
C* 00102430
RANGE = (IVHI - IVLOW)/FLOAT(LNLFT) 00102440
INRNG = (IVHI - IVLOW)/(FLOAT(DPLOT-1)/10) 00102450
IVVAL = IVLOW - RANGE/2. 00102460
INVAL = IVLOW 00102470
C* 00102480
C 00102490
C LOOP IS THE COUNTER FOR THE DATA BUFFERS. 00102500
C 00102510
C CHECK FOR THE NEED TO PRINT THE INDEPENDENT VARIABLE VALUE. 00102520
C 00102530
C* 00102540
LOOP = START 00102550
100 IVVAL = IVVAL + RANGE 00102560
IF (IVVAL .GT. IVHI) GO TO 900 00102570
IF (IVVAL .GT. IVHI-RANGE) IVPRT=1 00102580
CALL NDT82(INVAL) 00102590
IF (IVPRT .EQ. 2) INVAL = INVAL + INRNG 00102600
C* 00102610
C 00102620
C BLANK OUT THE PLOT LINE. 00102630
C 00102640
C* 00102650
DO 200 I = 1, PLTSZ 00102660
200 PLOT(I) = BLANK 00102670
C* 00102680
C 00102690
C CHECK FOR DATA WITHIN THE RANGE FOR THIS LINE. 00102700
C 00102710
C* 00102720
LOOP = LOOP - VARCT 00102730
300 LOOP = LOOP + VARCT 00102740
IF (VAR(LOOP) .LT. IVLOW .OR. VAR(LOOP) .GT. IVVAL+RANGE 00102750
1 .OR. LOOP .GT. STOP) GO TO 500 00102760
C* 00102770
C 00102780
C TRANSFER DATA FROM THE BUFFER TO THE PLOT. 00102790
C IF THE PLACE THE DATA WOULD APPEAR ON THE PLOT LINE 00102800
C IS NOT IN THE RANGE, IGNORE IT. 00102810
C 00102820
C* 00102830
DO 400 CLNUM = 2, VARCT 00102840
SUB = LOOP + CLNUM - 1 00102850
PLACE=(VAR(SUB)-LOW(CLNUM))*((PLTSZ-1)/(HIGH(CLNUM)-LOW(CLNUM))) 00102860
A+1.5 00102870
IF (PLACE .LT. 1 .OR. PLACE .GT. PLTSZ ) GO TO 400 00102880
IF ( PLOT(PLACE) .EQ. BLANK) PLOT(PLACE) = CHAR(CLNUM - 1) 00102890
400 CONTINUE 00102900
GO TO 300 00102910
C* 00102920
C 00102930
C THIS ALGORITHM CREATES THE FRAME FOR THE PLOT. 00102940
C 00102950
C* 00102960
500 IF (PLOT(1) .EQ. BLANK) PLOT(1) = DOT 00102970
DO 700 I = 2, PLTSZ, PLTDV 00102980
END = PLTDV - 2 + I 00102990
DO 600 PLACE = I, END 00103000
PCHAR = BLANK 00103010
IF (PLACE .NE. PLACE/2*2) PCHAR = ODD 00103020
IF (PLOT(PLACE) .EQ. BLANK) PLOT(PLACE) = PCHAR 00103030
600 CONTINUE 00103040
IF (PLOT(END + 1) .EQ. BLANK) PLOT(END + 1) = DOT 00103050
700 CONTINUE 00103060
C* 00103070
C 00103080
C OUTPUT THE FINISHED PLOT LINE. 00103090
C 00103100
C* 00103110
CALL NDT78(1) 00103120
WRITE(PRNTR,800) (LINE(I),I=PLTBG,PLTND) 00103130
800 FORMAT (1X, 120A1) 00103140
GO TO 100 00103150
900 RETURN 00103160
END 00103180
C***************************************************************** 00103190
C * 00103200
C COPYRIGHT (C) 1978 - UNIVERSITY OF NOTRE DAME * 00103210
C WRITTEN BY THOMAS L EVERMAN JR * 00103220
C * 00103230
C***************************************************************** 00103240
SUBROUTINE NDT75 00103250
C***************************************************************** 00103260
C * 00103270
C THIS PROGRAM LOADS THE LITERAL POOL AND OBJECT CODE. * 00103280
C IT ALSO PERFORMS PASS 3 INITIALIZATION AND BUILDS OCB'S. * 00103290
C * 00103300
C***************************************************************** 00103310
REAL*8 RMIN,RMAX,VAR(5000), ACCUM,EXTME,RSTME(10) 00103320
INTEGER PTRS(45),TITLE(120),CRSET(39),OPER(9),SYM(15), 00103330
1SUBSC(6),OUTPT(240),LINE(120),OBJCD(6000) 00103340
INTEGER INPUT(160),START,RELOC,DSKCT,XRFND,STOP,LITCT,DISK,VALCT 00103350
INTEGER CHAIN(80),CHREC,CHNPT,CHOBJ,PC,OBJST,OBJIN 00103360
INTEGER LADDR,RADDR,OBJLN,I,IN1(80),IN2(80),INPVL,RERUN 00103370
INTEGER RUNCT,RUNNO,DBEND,LINCT 00103380
INTEGER BIT(10),RUN(11),VNUM(11),PRTCT,PLTCT,OUTCT,OAB,OUT1(80) 00103390
INTEGER OUT2(80),OUT3(80),TYPE,VARCT,OCBST,OCBND,OCBPT,DBPNT 00103400
INTEGER LOWRN,RSTRT,SUB1,SUB2,EXPMX,TSAPT,SKSMT,OPTNS 00103410
COMMON RMIN,RMAX,PTRS,TITLE,CRSET,OPER,SYM,SUBSC,OUTPT,LINE, 00103420
1EXTME,RSTME,ACCUM,VAR 00103430
EQUIVALENCE (VAR(1),OBJCD(1)),(RELOC,PTRS(40)),(XRFND,PTRS(16)), 00103440
1(LITCT,PTRS(18)),(DISK,PTRS(3)),(VALCT,PTRS(20)), 00103450
2(PC,PTRS(15)),(OBJST,PTRS(17)),(OBJIN,START),(RUNNO,OUTPT(14)), 00103460
3(LADDR,PTRS(19)),(RADDR,PTRS(21)),(OBJLN,INPUT(1)), 00103470
4(IN1(1),INPUT(1)),(IN2(1),INPUT(81)),(RERUN,PTRS(13)), 00103480
5(RUNCT,PTRS(14)),(DBEND,PTRS(22)),(OPTNS,PTRS(7)) 00103490
EQUIVALENCE (INPUT(1),OUTPT(1)),(CHAIN(1),OUTPT(161)), 00103500
1(RUN(1),OUTPT(179)),(VNUM(1),OUTPT(92)),(OUTCT,PTRS(10)), 00103510
2(OAB,PTRS(12)),(OUT1(1),OUTPT(1)),(OUT2(1),OUTPT(81)), 00103520
3(OUT3(1),OUTPT(161)),(PRTCT,OUTPT(12)),(PLTCT,OUTPT(13)), 00103530
4(TYPE,OUTPT(2)),(VARCT,OUTPT(1)),(OCBST,PTRS(42)), 00103540
5(OCBND,PTRS(44)),(OCBPT,PTRS(43)),(EXPMX,PTRS(9)) 00103550
EQUIVALENCE(LOWRN,RSTRT),(LINCT,PTRS(5)) 00103560
C***************************************************************** 00103570
C * 00103580
C READ IN THE LITERAL POOL AND STORE IT STARTING AT LOCATION * 00103590
C RELOC + 1. EACH LITERAL OCCUPIES TWO INTEGER WORDS. * 00103600
C * 00103610
C***************************************************************** 00103620
OUTCT = PRTCT + PLTCT 00103630
START = RELOC + 1 00103640
DSKCT = XRFND 00103650
100 STOP = START + 39 00103660
IF (STOP .GT. LITCT + RELOC) STOP = LITCT + RELOC 00103670
DSKCT = DSKCT + 1 00103680
READ (DISK'DSKCT) (VAR(I), I = START, STOP) 00103690
IF (STOP .EQ. LITCT + RELOC) GO TO 200 00103700
START = STOP + 1 00103710
GO TO 100 00103720
C***************************************************************** 00103730
C * 00103740
C SET THE VARIABLE ALLOCATION COUNTER AND OBJECT CODE START. * 00103750
C OBTAIN CHAIN RECORDS WHICH POINT TO TOKEN BUFFERS OF EACH * 00103760
C STATEMENT IN ORDER BY WHICH THEY SHOULD BE EXECUTED. * 00103770
C * 00103780
C***************************************************************** 00103790
200 VALCT = STOP 00103800
OBJST = 2 * VALCT + 1 00103810
CHREC = 0 00103820
RADDR = 0 00103830
SKSMT = 3 00103840
IF (MOD (OPTNS, 2) .EQ. 0) SKSMT = 5 00103850
OBJIN = OBJST 00103860
300 CHREC = CHREC + 1 00103870
READ (DISK'CHREC) CHAIN 00103880
CHNPT = 0 00103890
400 CHNPT = CHNPT + 1 00103900
IF (CHNPT .GT. 80) GO TO 300 00103910
CHOBJ = CHAIN(CHNPT) 00103920
IF (CHOBJ .EQ. 0) GO TO 1000 00103930
IF (CHOBJ .GT. 0) GO TO 800 00103940
C***************************************************************** 00103950
C * 00103960
C CHAIN ELEMENT IS NEGATIVE. THIS INDICATES THAT THE NEXT OB* 00103970
C CODE BUFFER WILL REPRESENT A STATEMENT WHOSE TYPE IS THE * 00103980
C ABSOLUTE VALUE OF THE CHAIN ELEMENT. THIS VALUE SHOULD BE * 00103990
C STORED IN THE OBJECT CODE AS AN INDICATOR. ALSO, THE LOCAT* 00104000
C OF THE FIRST RATE AND LEVEL EQUATIONS SHOULD BE STORED, AND* 00104010
C A SKIP INSTRUCTION SHOULD BE INSERTED BEFORE THE FIRST LEVE* 00104020
C * 00104030
C***************************************************************** 00104040
CHOBJ = - CHOBJ 00104050
GO TO (400,400,400,700,500,600,600,400), CHOBJ 00104060
500 OBJCD(OBJIN) = 11 00104070
OBJCD(OBJIN + 1) = 0 00104080
OBJIN = OBJIN + 2 00104090
LADDR = OBJIN 00104100
GO TO 400 00104110
600 IF(RADDR .EQ. 0) RADDR = OBJIN 00104120
GO TO 400 00104130
700 OBJCD(OBJIN) = 1 00104140
OBJCD(OBJIN + 1) = 14 00104150
OBJCD(OBJIN + 2) = 2 00104160
OBJCD(OBJIN + 3) = 12 00104170
OBJIN = OBJIN + 4 00104180
GO TO 400 00104190
C***************************************************************** 00104200
C * 00104210
C CHAIN ELEMENT INDICATES A TOKEN RECORD NUMBER. INCREMENT * 00104220
C IT TO POINT TO THE OBJECT CODE BUFFER AND READ IN THE * 00104230
C BUFFER AND, IF NECESSARY, ITS CONTINUATION. RELOCATE * 00104240
C ANY NEGATIVE VALUES FOUND IN THE OBJECT CODE AND STORE * 00104250
C THE RELOCATED CODE IN THE OBJCD ARRAY. * 00104260
C * 00104270
C***************************************************************** 00104280
800 CHOBJ = CHOBJ + 4 00104290
READ (DISK'CHOBJ) IN1 00104300
IF (OBJLN .GT. 80) READ (DISK'CHOBJ + 1) IN2 00104310
DO 900 I = SKSMT, OBJLN 00104320
INPVL = INPUT(I) 00104330
IF (INPVL .LT. 0) INPVL = RELOC - INPVL 00104340
OBJCD(OBJIN) = INPVL 00104350
900 OBJIN = OBJIN + 1 00104360
GO TO 400 00104370
C***************************************************************** 00104380
C * 00104390
C A CHAIN ELEMENT WITH A VALUE OF 0 HAS INDICATED THE END * 00104400
C OF THE OBJECT CODE CHAIN. IT IS NOW NECESSARY TO * 00104410
C GENERATE THE TIME AND RERUN INSTRUCTIONS. * 00104420
C * 00104430
C***************************************************************** 00104440
1000 OBJCD(OBJIN) = 12 00104450
TSAPT = OBJIN + 1 00104460
OBJIN = OBJIN + 2 00104470
RERUN = OBJIN 00104480
RUNCT = RUNCT - 1 00104490
IF (RUNCT .EQ. 0) GO TO 1200 00104500
DO 1100 I = 1, RUNCT 00104510
OBJCD(OBJIN) = 13 00104520
OBJCD(OBJIN + 1) = I 00104530
1100 OBJIN = OBJIN + 2 00104540
1200 OBJCD(OBJIN) = 14 00104550
OBJCD(OBJIN + 1) = 0 00104560
VALCT = (OBJIN + 2) / 2 00104570
C* 00104580
C 00104590
C ALLOCATE SAVE AREA SPACE FOR THE TIME INSTRUCTION. 00104600
C 00104610
C* 00104620
OBJCD(TSAPT) = VALCT + 1 00104630
VALCT = VALCT + 7 00104640
PC = OBJST 00104650
RUNCT = 1 00104660
C***************************************************************** 00104670
C * 00104680
C ALLOCATE SPACE FOR THE DATA BUFFER POINTERS 00104690
C THERE ARE OUTCT NUMBER OF THEM. OAB POINTS 00104700
C TO THE FIRST OF THE DATA BUFFER POINTERS. 00104710
C 00104720
C* 00104730
OAB = 2 * VALCT + 1 00104740
OABPT = OAB - 1 00104750
VALCT = (OABPT + OUTCT + 1) / 2 00104760
OCBPT = OCBST 00104770
C* 00104780
C READ THREE DATA BUFFERS FOR EACH PRINT OR PLOT CARD. 00104790
C 00104800
C* 00104810
1300 IF (OCBPT .GT. OCBND) GO TO 1800 00104820
READ (DISK'OCBPT) OUT1 00104830
READ (DISK'OCBPT + 1) OUT2 00104840
READ (DISK'OCBPT + 2) OUT3 00104850
OCBPT = OCBPT + 3 00104860
C* 00104870
C 00104880
C ALLOCATE STORAGE FOR THE NEXT DATA BUFFER. 00104890
C SET THE NEXT BUFFER POINTER TO THE FIRST INTEGER WORD. 00104900
C 00104910
C* 00104920
OABPT = OABPT + 1 00104930
DBPNT = 2 * VALCT + 1 00104940
OBJCD(OABPT) = DBPNT 00104950
VALCT = VALCT + 44 + 3 * VARCT 00104960
C* 00104970
C 00104980
C BEGIN BUILDING DATA BUFFERS. INSERT TYPE OF BUFFER, 00104990
C NUMBER OF VARIABLE, LOWEST RUN NUMBER, RUN NUMBER USAGE 00105000
C INDICATORS, RECORD NUMBER, AND POINTERS TO REAL BUFFERS. 00105010
C 00105020
C* 00105030
OBJCD(DBPNT) = TYPE 00105040
OBJCD(DBPNT + 1) = VARCT 00105050
LOWRN = 10 00105060
DO 1400 I = 1, 10 00105070
1400 BIT(I) = 0 00105080
DO 1500 I = 1, VARCT 00105090
RUNNO = RUN(I) 00105100
BIT(RUNNO) = I 00105110
IF (RUNNO .LT. LOWRN) LOWRN = RUNNO 00105120
1500 CONTINUE 00105130
OBJCD(DBPNT + 2) = LOWRN 00105140
RUNNO = 0 00105150
DO 1600 I = 1, 10 00105160
IF (BIT(I) .NE. 0) RUNNO = RUNNO + 2 ** (I - 1) 00105170
1600 CONTINUE 00105180
OBJCD(DBPNT + 3) = RUNNO 00105190
OBJCD(DBPNT + 4) = OABPT - OAB + 1 + OCBND 00105200
RSTRT = (DBPNT + 8 + 2 * VARCT) / 2 + 1 00105210
OBJCD(DBPNT + 5) = RSTRT 00105220
OBJCD(DBPNT + 6) = RSTRT - 1 + 2 * VARCT 00105230
DBPNT = DBPNT + 7 00105240
DO 1700 I = 1, VARCT 00105250
C* 00105260
C 00105270
C STORE PAIRS OF VNUM AND RUN IN CONSECUTIVE INTEGER WORDS. 00105280
C 00105290
C* 00105300
SUB2 = DBPNT + I * 2 00105310
SUB1 = SUB2 - 1 00105320
OBJCD(SUB1) = VNUM(I) 00105330
OBJCD(SUB2) = RUN(I) 00105340
C* 00105350
C 00105360
C INITIALIZE HIGH AND LOW VALUES OF EACH VARIABLE IN 00105370
C CONSECUTIVE REAL WORDS. 00105380
C 00105390
C* 00105400
SUB2 = RSTRT - 1 + 2 * I 00105410
SUB1 = SUB2 - 1 00105420
VAR(SUB1) = 0.D0 00105430
IF (TYPE .EQ. 13) VAR(SUB1) = -1.1D0 * 10.D0 ** EXPMX 00105440
1700 VAR(SUB2) = 1.1D0 * 10.D0 ** EXPMX 00105450
C* 00105460
C 00105470
C INITIALIZE THE 40 WORD STORAGE BUFFER TO ZEROS. 00105480
C 00105490
C* 00105500
SUB1 = OBJCD(DBPNT - 1) + 1 00105510
SUB2 = SUB1 + 39 00105520
DO 1750 I = SUB1, SUB2 00105530
1750 VAR(I) = 0.D0 00105540
GO TO 1300 00105550
1800 DBEND = VALCT 00105560
C* 00105570
C 00105580
C INITIALIZE ALL PARAMETER LOCATIONS. 00105590
C 00105600
C* 00105610
DO 1900 I = 11, 16 00105620
1900 VAR(I) = 0.D0 00105630
IF (MOD (OPTNS / 512, 2) .EQ. 1) CALL NDT84 00105640
IF (MOD (OPTNS / 2048, 2) .EQ. 1) CALL NDT86 00105650
C 00105660
C 00105670
C FORCE PAGE EJECT FOR EXECUTION ERROR MESSAGES 00105680
C 00105690
C 00105700
LINCT = -1 00105710
RETURN 00105720
END 00105740
C COPYRIGHT 1978 - UNIVERSITY OF NOTRE DAME 00105750
C PROGRAM AUTHOR - GARY PELKEY 00105760
C 00105770
C 00105780
SUBROUTINE NDT76 (SRTPT) 00105790
C 00105800
C 00105810
C THIS ROUTINE PERFORMS A TAG SORT ON THE SYMBOL TABLE 00105820
C FOR THE SYMBOL TABLE LISTING PROGRAM AND THE CROSS 00105830
C REFERENCE PROGRAM. IT IS CALLED BY NDT61 IF EITHER OF 00105840
C THESE OPTIONS IS IN EFFECT. 00105850
C 00105860
C 00105870
REAL*8 RMIN,RMAX,LITBL(1024) 00105880
INTEGER PTRS(45),TITLE(120),CRSET(39),OPER(9),SYM(15), 00105890
1SUBSC(6),TYPCT(20),EQCHN(80),TOKEN(80),CARD1(80),CARD2(80), 00105900
2ERROR(80),OBJCD(160),DEF(80),XREF(80),TMAP(80),FCTN(5,22), 00105910
3SYMTB(5,512) ,SORT(2048) 00105920
INTEGER SRTPT,I,DIST,START,STOP,FLAG,PNT,PNT2,TAG1,TAG2,SYMND 00105930
REAL TNAME(4,8),REQST(4,4) 00105950
COMMON RMIN,RMAX,PTRS,TITLE,CRSET,OPER,SYM,SUBSC,TYPCT, 00105960
1EQCHN,TOKEN,CARD1,CARD2,ERROR,OBJCD,DEF,XREF,TMAP,FCTN, 00105970
2SYMTB,LITBL 00105980
EQUIVALENCE (SORT(1),LITBL(1)),(SYMND,PTRS(17)) 00105990
C 00106000
C 00106010
C A TAG (POINTER TO THE SYMBOL TABLE) IS CREATED FOR EACH NON- 00106020
C EMPTY LOCATION IN THE SYMBOL TABLE. AN EMPTY LOCATION IS 00106030
C SPECIFIED BY THE FIRST WORD = 32767. 00106040
C 00106050
C 00106060
SRTPT=0 00106070
DO 100 I=1,SYMND 00106080
IF(SYMTB(1,I).EQ.32767) GO TO 100 00106090
SRTPT=SRTPT+1 00106100
SORT(SRTPT)=I 00106110
100 CONTINUE 00106120
C 00106130
C 00106140
C A SHELL D SORT IS NOW PERFORMED ON THE TAGS. THE TAGS RATHER 00106150
C THAN THE SYMBOLS THEMSELVES ARE INTERCHANGED FOR ORDERING 00106160
C BECAUSE THE SYMBOL TABLE MUST BE PRESERVED INTACT FOR FUTURE 00106170
C REFERENCING. 00106180
C 00106190
C 00106200
DIST=SRTPT 00106210
200 DIST=DIST/2 00106220
IF(DIST.EQ.0) GO TO 600 00106230
DO 500 START=1,DIST 00106240
STOP=SRTPT-DIST 00106250
FLAG=1 00106260
300 IF(FLAG.EQ.0) GO TO 500 00106270
FLAG=0 00106280
DO 400 PNT=START,STOP,DIST 00106290
PNT2=PNT+DIST 00106300
TAG1=SORT(PNT) 00106310
TAG2=SORT(PNT2) 00106320
IF(SYMTB(1,TAG1).LT.SYMTB(1,TAG2)) GO TO 400 00106330
IF(SYMTB(1,TAG1).EQ.SYMTB(1,TAG2).AND.SYMTB(2,TAG1).LE. 00106340
1SYMTB(2,TAG2)) GO TO 400 00106350
SORT(PNT)=TAG2 00106360
SORT(PNT2)=TAG1 00106370
FLAG=1 00106380
400 CONTINUE 00106390
GO TO 300 00106400
500 CONTINUE 00106410
GO TO 200 00106420
600 RETURN 00106430
END 00106450
C COPYRIGHT 1978 - UNIVERSITY OF NOTRE DAME 00106460
C PROGRAM AUTHOR - GARY PELKEY 00106470
C 00106480
C 00106490
SUBROUTINE NDT77 (VAL,ICHAR) 00106500
C 00106510
C 00106520
C THIS ROUTINE RETURNS TO THE PRINT AND PLOT ROUTINES 00106530
C THE CHARACTERISTIC OF THE INPUT ARGUMENT VAL. 00106540
C IF VAL IS ZERO OR NEGATIVE, SPECIAL DOCTORING 00106550
C MUST TAKE PLACE TO RETURN THE DESIRED VALUE OF ICHAR. 00106560
C 00106570
C 00106580
INTEGER ICHAR 00106590
REAL*8 VAL,CHAR 00106600
ICHAR=0 00106610
IF (VAL .EQ. 0.) GOTO 100 00106620
CHAR=DLOG10(DABS(VAL)) 00106630
IF (CHAR .LT. 0.) CHAR=CHAR-.99999 00106640
ICHAR=CHAR 00106650
IF(10.**(ICHAR+1).LE.VAL+5.*10.**(ICHAR-5)) ICHAR=ICHAR+1 00106660
100 RETURN 00106670
END 00106690
C* 00106700
C 00106710
C COPYRIGHT (C) 1978 - UNIVERSITY OF NOTRE DAME 00106720
C PROGRAM AUTHOR - DANIEL A. POYDENCE 00106730
C TRANSLATED BY - TIMOTHY J. MALLOY 00106740
C 00106750
C* 00106760
SUBROUTINE NDT78 (LINES) 00106770
C* 00106780
C 00106790
C EXECUTION TIME OUTPUT MONITOR 00106800
C 00106810
C* 00106820
REAL*8 RMIN,RMAX,VAR(5000), ACCUM,EXTME,RSTME(10) 00106830
REAL*8 INCR,LOW(11),HIGH(11) 00106840
INTEGER PTRS(45),TITLE(120),CRSET(39),OPER(9),SYM(15), 00106850
1SUBSC(6),OUTPT(240),LINE(120),OBJCD(6000) 00106860
INTEGER LINES 00106870
INTEGER PRNTR,PAGCT,LINCT,LINPP,PLINS,BLANK,VARCT,VNAMS(8,11), 00106880
1IVNUM,ECHRS(44),SERIE(11),SRCNT,CHAR(10),TLIMT 00106890
INTEGER LOOP,PNT,SRLST,SRPNT,NARO,CHRBF(10),CHRBS(5),CHRPT, 00106900
1OPTNS,SCALE(11,5) 00106910
COMMON RMIN,RMAX,PTRS,TITLE,CRSET,OPER,SYM,SUBSC,OUTPT,LINE, 00106920
1EXTME,RSTME,ACCUM,VAR 00106930
EQUIVALENCE (VAR(1),OBJCD(1)),(PRNTR,PTRS(2)),(PAGCT, 00106940
1PTRS(4)),(LINCT,PTRS(5)),(LINPP,PTRS(6)),(PLINS, 00106950
2PTRS(32)),(BLANK,CRSET(1)),(VARCT,OUTPT(1)),(VNAMS(1,1), 00106960
3OUTPT(4)),(IVNUM,OUTPT(92)),(LOW(1),OUTPT(103)), 00106970
4(HIGH(1),OUTPT(125)),(ECHRS(1),OUTPT(114)),(SERIE(1), 00106980
5OUTPT(147)),(SRCNT,OUTPT(178)),(CHAR(1),OUTPT(190)), 00106990
6(CHRBS(1),CHRBF(6)),(OPTNS,PTRS(7)),(TLIMT,PTRS(33)) 00107000
IF (LINCT .LT. 0) GO TO 100 00107010
LINCT = LINCT + LINES 00107020
IF (LINCT .LE. LINPP) GO TO 1600 00107030
100 LINCT = LINES + 2 00107040
PAGCT = PAGCT + 1 00107050
CALL NDT45 (PAGCT, TITLE(6), 0) 00107060
WRITE (PRNTR, 200) (TITLE(LOOP),LOOP=1,TLIMT) 00107070
200 FORMAT ('1', 120A1) 00107080
WRITE(PRNTR, 500) 00107090
IF (PLINS .EQ. 0) GO TO 1600 00107100
IF (PLINS .LT. 0) GO TO 600 00107110
LINCT = LINCT + PLINS 00107120
WRITE(PRNTR,300)((VNAMS(LOOP,PNT),LOOP=1,8),PNT=1,VARCT) 00107130
300 FORMAT (5X,11(1X,8A1,1X)) 00107140
WRITE (PRNTR,400) ECHRS 00107150
400 FORMAT (5X,11(3X,4A1,3X)) 00107160
IF (PLINS .EQ. 3) WRITE (PRNTR,500) 00107170
500 FORMAT (1X) 00107180
GO TO 1600 00107190
C 00107200
C 00107210
C 00107220
C 00107230
600 LINCT = LINCT - PLINS 00107240
WRITE (PRNTR,700) 00107250
1 (CHAR(PNT-1),(VNAMS(LOOP,PNT), LOOP=1,8),PNT=2,VARCT) 00107260
700 FORMAT (6X,8(A1,'=',8A1,2X)) 00107270
WRITE (PRNTR,500) 00107280
SRLST = SERIE(2) 00107290
SRPNT = 2 00107300
NARO = MOD(OPTNS/8,2) 00107310
DO 1500 PNT = 1, SRCNT 00107320
DO 800 LOOP = 1, 10 00107330
800 CHRBF(LOOP) = BLANK 00107340
CHRPT = 11 00107350
900 IF (SERIE(SRPNT) .NE. SRLST) GO TO 1000 00107360
CHRPT = CHRPT - 1 00107370
CHRBF(CHRPT) = CHAR(SRPNT - 1) 00107380
SRPNT = SRPNT + 1 00107390
IF (SRPNT .LE. 11) GO TO 900 00107400
1000 INCR = (HIGH(SRLST) - LOW(SRLST))/4. 00107410
DO 1100 LOOP = 1, 5 00107420
1100 CALL NDT44(LOW(SRLST)+FLOAT(LOOP-1)*INCR,SCALE(1,LOOP)) 00107430
IF (NARO .EQ. 0) WRITE (PRNTR,1200) CHRBF,SCALE 00107440
IF (NARO.EQ.1 .AND. IVNUM.EQ.12) WRITE (PRNTR,1300) CHRBS,SCALE 00107450
IF (NARO.EQ.1 .AND. IVNUM.NE.12) WRITE (PRNTR,1400) CHRBS,SCALE 00107460
1200 FORMAT (2X,10A1,2X,4(11A1,11X),11A1) 00107470
1300 FORMAT (1X,5A1,2X,5(11A1,3X)) 00107480
1400 FORMAT (3X,5A1,2X,5(11A1,3X)) 00107490
IF (SRPNT .LE. 10) SRLST = SERIE(SRPNT) 00107500
1500 CONTINUE 00107510
1600 RETURN 00107520
END 00107540
C* 00107550
C 00107560
C COPYRIGHT (C) 1978 - UNIVERSITY OF NOTRE DAME 00107570
C PROGRAM AUTHOR - TIMOTHY J. MALLOY 00107580
C 00107590
C* 00107600
SUBROUTINE NDT79 00107610
C* 00107620
C 00107630
C EXTREMUM TRANSFER - DEFAULT CHECKING 00107640
C 00107650
C* 00107660
REAL*8 RMIN,RMAX,VAR(5000), ACCUM,EXTME,RSTME(10) 00107670
REAL*8 HI,LO,HIGH(11),LOW(11) 00107680
INTEGER PTRS(45),TITLE(120),CRSET(39),OPER(9),SYM(15), 00107690
1SUBSC(6),OUTPT(240),LINE(120),OBJCD(6000) 00107700
INTEGER SRNUM,FLAG(11),DEFLT,ICHAR 00107710
COMMON RMIN,RMAX,PTRS,TITLE,CRSET,OPER,SYM,SUBSC,OUTPT,LINE, 00107720
1EXTME,RSTME,ACCUM,VAR 00107730
EQUIVALENCE (VAR(1),OBJCD(1)) 00107740
EQUIVALENCE (SRNUM,OUTPT(171)),(LOW(1),OUTPT(103)), 00107750
1(HIGH(1),OUTPT(125)),(FLAG(1),OUTPT(147)) 00107760
C* 00107770
C 00107780
C DEFLT CONTAINS THE DEFAULT INFORMATION FOR THE HIGH AND LOW 00107790
C VALUES FOR THIS VARIABLE: 00107800
C DEFLT = 0 NO DEFAULTS 00107810
C 1 LOW DEFAULT ONLY 00107820
C 2 HIGH DEFAULT ONLY 00107830
C 3 BOTH DEFAULTS 00107840
C 00107850
C* 00107860
DEFLT = MOD(FLAG(SRNUM),10) 00107870
C* 00107880
C 00107890
C FIRST CHECK FOR A HIGH DEFAULT. IF ONE EXISTS, CALL THE 00107900
C SUBROUTINE NDT80 TO READ IN THE HIGH VALUE FROM THE DATA 00107910
C BUFFERS. 00107920
C 00107930
C* 00107940
IF (DEFLT .EQ. 0) GO TO 200 00107950
IF (DEFLT .LT. 2) GO TO 100 00107960
CALL NDT80(1) 00107970
DEFLT = DEFLT - 2 00107980
C* 00107990
C 00108000
C IF THERE IS A LOW DEFAULT, READ IN THE LOW VALUE FROM THE 00108010
C DATA BUFFERS BY CALLING NDT80. 00108020
C 00108030
C* 00108040
100 IF (DEFLT .EQ. 1) CALL NDT80(0) 00108050
C* 00108060
C 00108070
C CHECK FOR AN INDEPENDENT VARIABLE WHOSE HIGH AND LOW ARE 00108080
C EITHER EQUAL, OR REVERSED. 00108090
C 00108100
C* 00108110
200 HI = HIGH(SRNUM) 00108120
LO = LOW(SRNUM) 00108130
IF (HI .GT. LO) GO TO 400 00108140
IF (HI .EQ. LO) GO TO 300 00108150
C* 00108160
C 00108170
C IF HIGH WAS LESS THAN LOW, SWITCH THEM. 00108180
C 00108190
C* 00108200
LOW(SRNUM) = HI 00108210
HIGH(SRNUM) = LO 00108220
GO TO 400 00108230
C* 00108240
C 00108250
C IF HIGH EQUALS LOW, EXPAND THE RANGE. 00108260
C 00108270
C* 00108280
300 CALL NDT77(HI,ICHAR) 00108290
HIGH(SRNUM) = HI + 2.*(10.**(ICHAR-1)) 00108300
LOW(SRNUM) = LO - 2.*(10.**(ICHAR-1)) 00108310
400 RETURN 00108320
END 00108340
C* 00108350
C 00108360
C COPYRIGHT (C) 1978 - UNIVERSITY OF NOTRE DAME 00108370
C PROGRAM AUTHOR - TIMOTHY J. MALLOY 00108380
C 00108390
C* 00108400
SUBROUTINE NDT80 (HILO) 00108410
C* 00108420
C 00108430
C EXTREMUM TRANSFER - ROUNDING 00108440
C 00108450
C* 00108460
REAL*8 RMIN,RMAX,VAR(5000), ACCUM,EXTME,RSTME(10) 00108470
REAL*8 VAL,XLOW(22) 00108480
INTEGER PTRS(45),TITLE(120),CRSET(39),OPER(9),SYM(15), 00108490
1SUBSC(6),OUTPT(240),LINE(120),OBJCD(6000) 00108500
INTEGER HILO,SRNUM,FHIGH,POS,ICHAR,SUB,SIGN 00108510
COMMON RMIN,RMAX,PTRS,TITLE,CRSET,OPER,SYM,SUBSC,OUTPT,LINE, 00108520
1EXTME,RSTME,ACCUM,VAR 00108530
EQUIVALENCE (VAR(1),OBJCD(1)) 00108540
EQUIVALENCE (SRNUM,OUTPT(171)),(XLOW(1),OUTPT(103)), 00108550
1(FHIGH,OUTPT(161)) 00108560
C* 00108570
C 00108580
C THIS PROGRAM TAKES THE HIGH OR LOW VALUE FROM THE DATA 00108590
C BUFFERS AND PUTS IT IN THE OUTPT ARRAY, ROUNDING THE VALUE. 00108600
C 00108610
C HILO DETERMINES WHETHER THE HIGH OR THE LOW IS USED. 00108620
C HILO = 0 ==> LOW HILO = 1 ==> HIGH 00108630
C 00108640
C THE ROUNDING IS DONE TO TWO SIGNIFICANT DIGITS. 00108650
C 00108660
C* 00108670
POS = FHIGH + 2*SRNUM - HILO - 1 00108680
CALL NDT77 (VAR(POS), ICHAR) 00108690
SUB = 11*HILO + SRNUM 00108700
XLOW(SUB) = FLOAT(IDINT(VAR(POS)/10.**(ICHAR-1)))*10.**(ICHAR-1) 00108710
SIGN = -2*HILO + 1 00108720
VAL = VAR(POS) + SIGN*10.**(ICHAR-3) 00108730
IF (FLOAT(SIGN)*XLOW(SUB) .GT. FLOAT(SIGN)*VAL) 00108740
1 XLOW(SUB) = XLOW(SUB) - SIGN*10.**(ICHAR-1) 00108750
RETURN 00108760
END 00108780
C* 00108790
C 00108800
C COPYRIGHT (C) 1978 - UNIVERSITY OF NOTRE DAME 00108810
C PROGRAM AUTHOR - TIMOTHY J. MALLOY 00108820
C 00108830
C* 00108840
SUBROUTINE NDT81(POS) 00108850
C* 00108860
C 00108870
C PLOTTED CHARACTER INSERTION 00108880
C 00108890
C* 00108900
REAL*8 RMIN,RMAX,VAR(5000), ACCUM,EXTME,RSTME(10) 00108910
INTEGER PTRS(45),TITLE(120),CRSET(39),OPER(9),SYM(15), 00108920
1SUBSC(6),OUTPT(240),LINE(120),OBJCD(6000) 00108930
INTEGER POS,XCHAR,CHAR(10),PCHAR 00108940
COMMON RMIN,RMAX,PTRS,TITLE,CRSET,OPER,SYM,SUBSC,OUTPT,LINE, 00108950
1EXTME,RSTME,ACCUM,VAR 00108960
EQUIVALENCE (CHAR(1),OUTPT(190)),(PCHAR,OUTPT(168)), 00108970
1(VAR(1),OBJCD(1)) 00108980
C* 00108990
C 00109000
C IF POS IS ZERO, INSERT PCHAR. 00109010
C IF NOT, PRINT THE CHARACTER FROM THE CHAR ARRAY. 00109020
C 00109030
C* 00109040
IF (POS .EQ. 0) GO TO 100 00109050
XCHAR = POS - 1 00109060
POS = CHAR(XCHAR) 00109070
GO TO 200 00109080
100 POS = PCHAR 00109090
200 RETURN 00109100
END 00109120
C* 00109130
C 00109140
C COPYRIGHT (C) 1978 - UNIVERSITY OF NOTRE DAME 00109150
C PROGRAM AUTHOR - TIMOTHY J. MALLOY 00109160
C 00109170
C* 00109180
SUBROUTINE NDT82 (VAL) 00109190
C* 00109200
C 00109210
C PLOT INDEPENDENT VARIABLE NAME PROCESSING 00109220
C 00109230
C* 00109240
REAL*8 RMIN,RMAX,VAR(5000), ACCUM,EXTME,RSTME(10) 00109250
REAL*8 VAL 00109260
INTEGER PTRS(45),TITLE(120),CRSET(39),OPER(9),SYM(15), 00109270
1SUBSC(6),OUTPT(240),LINE(120),OBJCD(6000) 00109280
INTEGER BLANK,DOT,IVNAM(10),ODD,IVPRT,I,J 00109290
COMMON RMIN,RMAX,PTRS,TITLE,CRSET,OPER,SYM,SUBSC,OUTPT,LINE, 00109300
1EXTME,RSTME,ACCUM,VAR 00109310
EQUIVALENCE (BLANK,CRSET(1)),(DOT,OPER(1)),(IVNAM(1),OUTPT(2)), 00109320
1(ODD,OUTPT(169)),(IVPRT,OUTPT(170)),(VAR(1),OBJCD(1)) 00109330
C* 00109340
C 00109350
C ODD IS A CHARACTER THAT USUALLY CONTAINS A BLANK, BUT ON 00109360
C EVERY TENTH LINE IS A DOT. 00109370
C 00109380
C* 00109390
ODD = BLANK 00109400
IF (IVPRT .EQ. 1) GO TO 200 00109410
C* 00109420
C 00109430
C NO NEED TO PRINT THE INDEPENDENT VARIABLE. 00109440
C IVNAM IS PRINTED DOWN IN THE FIRST GRID, AND THEN 00109450
C BLANKED OUT FOR THE REST. 00109460
C 00109470
C* 00109480
DO 100 I = 1, 13 00109490
100 LINE(I) = BLANK 00109500
LINE(7) = IVNAM(IVPRT) 00109510
IVNAM(IVPRT) = BLANK 00109520
GO TO 600 00109530
C* 00109540
C 00109550
C ON EVERY TENTH LINE, PRINT THE INDEPENDENT VALUE. 00109560
C 00109570
C* 00109580
200 ODD = DOT 00109590
CALL NDT44(VAL,LINE(1)) 00109600
C* 00109610
C 00109620
C RIGHT JUSTIFY THE INDEP VALUE. 00109630
C 00109640
C* 00109650
300 IF (LINE(11) .NE. BLANK) GO TO 500 00109660
DO 400 I = 1, 10 00109670
J = 11 - I 00109680
400 LINE(J+1) = LINE(J) 00109690
LINE(1) = BLANK 00109700
GO TO 300 00109710
500 LINE(12) = BLANK 00109720
LINE(13) = BLANK 00109730
600 IVPRT = MOD(IVPRT, 10) + 1 00109740
RETURN 00109750
END 00109770
C* 00109780
C 00109790
C COPYRIGHT (C) 1978 - UNIVERSITY OF NOTRE DAME 00109800
C PROGRAM AUTHOR - TIMOTHY J. MALLOY 00109810
C 00109820
C* 00109830
SUBROUTINE NDT83 00109840
C* 00109850
C 00109860
C SORT OF DATA BUFFERS 00109870
C 00109880
C* 00109890
REAL*8 RMIN,RMAX,VAR(5000), ACCUM,EXTME,RSTME(10) 00109900
REAL*8 TEMP 00109910
INTEGER PTRS(45),TITLE(120),CRSET(39),OPER(9),SYM(15), 00109920
1SUBSC(6),OUTPT(240),LINE(120),OBJCD(6000) 00109930
INTEGER VARCT,START,STOP,PLNTH,DIST,SORT,SORT1,DSORT,LOOP,LOOP1, 00109940
1 SRTFG,ADDR,ADDR1 00109950
COMMON RMIN,RMAX,PTRS,TITLE,CRSET,OPER,SYM,SUBSC,OUTPT,LINE, 00109960
1EXTME,RSTME,ACCUM,VAR 00109970
EQUIVALENCE (VARCT,OUTPT(1)),(START,OUTPT(162)), 00109980
1(STOP,OUTPT(163)),(VAR(1),OBJCD(1)) 00109990
C* 00110000
C 00110010
C PLNTH IS THE NUMBER OF ELEMENTS IN DATA BUFFER. 00110020
C 00110030
C THE SHELL-D SORT COMPARES AT A DISTANCE 00110040
C HALF OF PREVIOUS DISTANCE. 00110050
C 00110060
C* 00110070
PLNTH = ((STOP - START)/VARCT) + 1 00110080
DIST = PLNTH/2 00110090
C* 00110100
C 00110110
C COMPARE THROUGH THE LIST DIST TIMES. 00110120
C 00110130
C* 00110140
100 DO 400 SORT = 1, DIST 00110150
SORT1 = (SORT - 1)*VARCT + START 00110160
DSORT = DIST * VARCT 00110170
200 LOOP1 = SORT1 00110180
C* 00110190
C 00110200
C SRTFG IS 1 IF A CHANGE WAS MADE DURING THIS LOOP. 00110210
C COMPARE LIST AT A DISTANCE DSORT APART. 00110220
C 00110230
C* 00110240
SRTFG = 0 00110250
DO 300 LOOP = SORT1, STOP, DSORT 00110260
IF (VAR(LOOP) .GE. VAR(LOOP1)) GO TO 300 00110270
C* 00110280
C 00110290
C IF OUT OF ORDER, REVERSE THE ITEMS. 00110300
C 00110310
C* 00110320
SRTFG = 1 00110330
DO 250 I = 1, VARCT 00110340
ADDR = LOOP - 1 + I 00110350
ADDR1 = LOOP1 - 1 + I 00110360
TEMP = VAR(ADDR) 00110370
VAR(ADDR) = VAR(ADDR1) 00110380
250 VAR(ADDR1) = TEMP 00110390
C* 00110400
C 00110410
C COMPARE THE NEXT ELEMENT. 00110420
C 00110430
C* 00110440
300 LOOP1 = LOOP 00110450
C* 00110460
C 00110470
C CONTINUE ONLY IF NO CHANGES WERE MADE IN THIS SEARCH. 00110480
C 00110490
C* 00110500
IF (SRTFG .EQ. 1) GO TO 200 00110510
400 CONTINUE 00110520
DIST = DIST/2 00110530
C* 00110540
C 00110550
C WHEN DIST GETS DOWN TO ZERO, SORT IS COMPLETED. 00110560
C 00110570
C* 00110580
IF (DIST .NE. 0) GO TO 100 00110590
RETURN 00110600
END 00110620
C* 00110630
C 00110640
C COPYRIGHT (C) 1978 - UNIVERSITY OF NOTRE DAME 00110650
C WRITTEN BY THOMAS L EVERMAN JR 00110660
C 00110670
C* 00110680
SUBROUTINE NDT84 00110690
C* 00110700
C 00110710
C THIS SUBROUTINE PRINTS THE OBJECT CODE LISTING. IT IS 00110720
C INVOKED AT THE CONCLUSION OF THE LOADER PROGRAM IF 00110730
C THE 'OBJECT' OPTION HAS BEEN SPECIFIED. 00110740
C 00110750
C* 00110760
REAL*8 RMIN,RMAX,VAR(5000), ACCUM,EXTME,RSTME(10) 00110770
REAL INST(37) 00110780
INTEGER PTRS(45),TITLE(120),CRSET(39),OPER(9),SYM(15), 00110790
1SUBSC(6),OUTPT(240),LINE(120),OBJCD(6000) 00110800
INTEGER LINCT,OBJST,FLD1(4),FLD2,FLD3(4),OBPNT 00110810
INTEGER OPRND,FIELD(4,2),SWTCH,I,BLANK,PRNTR 00110820
COMMON RMIN,RMAX,PTRS,TITLE,CRSET,OPER,SYM,SUBSC,OUTPT,LINE, 00110830
1EXTME,RSTME,ACCUM,VAR 00110840
EQUIVALENCE (VAR(1),OBJCD(1)),(LINCT,PTRS(5)),(OBJST,PTRS(17)) 00110850
EQUIVALENCE (FLD1(1),FIELD(1,1)),(FLD3(1),FIELD(1,2)) 00110860
EQUIVALENCE (BLANK,CRSET(1)),(PRNTR,PTRS(2)) 00110870
DATA INST /'LOAD','ST ','ADD ','SUB ','MULT','DIV ','EXP ', 00110880
1'RSUB','RDIV','REXP','INIT','TIME','RERN','STOP','STMT', 00110890
2'INTG','ABS ','CLIP','COS ','DLAY','EXPF','LOG ','MAX ', 00110900
3'MIN ','NOIS','NMRN','PULS','RAMP','SAMP','SIN ','SQRT', 00110910
4'STEP','SWCH','TBFL','TBHL','TBLE','TBND'/ 00110920
C* 00110930
C 00110940
C THE ABOVE ARRAY CONTAINS THE MNEMONICS FOR THE INSTRUCTION 00110950
C SET. THE FIRST STEP IN THE PROGRAM IS TO TITLE A NEW PAGE. 00110960
C 00110970
C* 00110980
LINCT = - 1 00110990
CALL NDT57(4) 00111000
WRITE (PRNTR,1) 00111010
1 FORMAT (5X,'* * * * * O B J E C T C O D E * * * * *'/) 00111020
WRITE (PRNTR,2) 00111030
2 FORMAT (5X,'SOURCE STATEMENT OP CODE OPERAND'/) 00111040
OBPNT = OBJST 00111050
50 FLD2 = OBJCD(OBPNT) 00111060
C* 00111070
C 00111080
C THE MNEMONIC HAS BEEN MATCHED TO THE OP CODE. NOW THE 00111090
C OPERAND MUST BE LEFT JUSTIFIED IN A1 FORMAT AND INSERTED 00111100
C INTO THE OPERAND FIELD UNLESS THE 'STMT' INSTRUCTION 00111110
C IS ENCOUNTERED, IN THIS CASE, THE STATEMENT NUMBER OPERAND 00111120
C IS PLACED IN FIELD1 SO THAT IT IS LISTED TO THE LEFT OF 00111130
C THE OP CODE. 00111140
C 00111150
C* 00111160
OPRND = OBJCD(OBPNT + 1) 00111170
SWTCH = 1 00111180
IF (FLD2 .NE. 15) SWTCH = 2 00111190
CALL NDT45 (OPRND, FIELD(1, SWTCH), 2 - SWTCH) 00111200
SWTCH = MOD (SWTCH, 2) + 1 00111210
DO 100 I = 1, 4 00111220
100 FIELD(I, SWTCH) = BLANK 00111230
IF (OPRND .EQ. 0) FLD3(1) = BLANK 00111240
CALL NDT57(1) 00111250
IF (LINCT .NE. 3) GO TO 200 00111260
LINCT = LINCT + 2 00111270
WRITE (PRNTR,2) 00111280
200 WRITE (PRNTR,3) FLD1, INST(FLD2), FLD3 00111290
3 FORMAT (11X,4A1,12X,A4,7X,4A1) 00111300
C* 00111310
C 00111320
C CHECK AND RETURN FOR 'STOP' INSTRUCTION 00111330
C OTHERWISE INCREMENT AND LIST NEXT OPERATION 00111340
C 00111350
C* 00111360
IF (FLD2 .EQ. 14) RETURN 00111370
OBPNT = OBPNT + 2 00111380
GO TO 50 00111390
END 00111400
C***************************************************************** 00111410
C * 00111420
C COPYRIGHT (C) 1978 - UNIVERSITY OF NOTRE DAME * 00111430
C PROGRAM AUTHOR - THOMAS L EVERMAN JR * 00111440
C * 00111450
C THIS PROGRAM OPTIMIZES THE OBJECT CODE 00111460
C * 00111470
C***************************************************************** 00111480
SUBROUTINE NDT85 00111490
REAL*8 RMIN,RMAX,LITBL(1024) 00111500
INTEGER PTRS(45),TITLE(120),CRSET(39),OPER(9),SYM(15), 00111510
1SUBSC(6),TYPCT(20),EQCHN(80),TOKEN(80),CARD1(80),CARD2(80), 00111520
2ERROR(80),OBJCD(160),DEF(80),XREF(80),TMAP(80),FCTN(5,22), 00111530
3SYMTB(5,512) 00111540
INTEGER OBJPT,INSPT,MOVBK,INSRT 00111550
COMMON RMIN,RMAX,PTRS,TITLE,CRSET,OPER,SYM,SUBSC,TYPCT, 00111560
1EQCHN,TOKEN,CARD1,CARD2,ERROR,OBJCD,DEF,XREF,TMAP,FCTN, 00111570
2SYMTB,LITBL 00111580
EQUIVALENCE (OBJPT,OBJCD(1)) 00111590
C* 00111600
C 00111610
C MOVBK INDICATES THE NUMBER OF DELETED OP CODES AND 00111620
C OPERANDS. INSPT POINTS TO THE NEXT INSTRUCTION TO 00111630
C CHECK FOR THE 'ST' OPERATION. 00111640
C 00111650
C* 00111660
MOVBK = 0 00111670
INSPT = 5 00111680
C* 00111690
C 00111700
C CHECK FOR STORE. THEN CHECK FOR A SUBSEQUENT LOAD WITH 00111710
C THE IDENTICAL OPERAND BY LOOKING AT NEXT THREE WORDS. 00111720
C 00111730
C* 00111740
50 IF (OBJCD(INSPT) .NE. 2) GO TO 100 00111750
IF (OBJCD(INSPT + 2) .NE. 1 .OR. OBJCD(INSPT + 1) .NE. 00111760
1OBJCD(INSPT + 3)) GO TO 100 00111770
C* 00111780
C 00111790
C A CONSECUTIVE ST/LOAD HAS BEEN FOUND. UPDATE POINTERS 00111800
C TO CAUSE THESE WORDS TO BE OVERWRITTEN. 00111810
C 00111820
C* 00111830
MOVBK = MOVBK + 4 00111840
INSPT = INSPT + 2 00111850
GO TO 200 00111860
C* 00111870
C 00111880
C OVERWRITE ANY ST/LOAD COMBINATION IF IT EXISTS 00111890
C 00111900
C* 00111910
100 IF (MOVBK .EQ. 0) GO TO 200 00111920
INSRT = INSPT - MOVBK 00111930
OBJCD(INSRT) = OBJCD(INSPT) 00111940
OBJCD(INSRT + 1) = OBJCD(INSPT + 1) 00111950
C* 00111960
C 00111970
C UPDATE POINTER AND CHECK FOR END OF BUFFER. IF 00111980
C COMPLETE REDUCE BUFFER LENGTH INDICATOR (OBJPT). 00111990
C 00112000
C* 00112010
200 INSPT = INSPT + 2 00112020
IF (INSPT .LT. OBJPT - 2) GO TO 50 00112030
IF (MOVBK .EQ. 0) GO TO 300 00112040
OBJPT = OBJPT - MOVBK 00112050
OBJCD(OBJPT) = OBJCD(INSPT + 1) 00112060
OBJCD(OBJPT - 1) = OBJCD(INSPT) 00112070
300 RETURN 00112080
END 00112100
SUBROUTINE NDT86 00112110
REAL*8 RMIN,RMAX,VAR(5000), ACCUM,EXTME,RSTME(10), 00112120
1 AVGTM(37) 00112130
INTEGER PTRS(45),TITLE(120),CRSET(39),OPER(9),SYM(15), 00112140
1 SUBSC(6),OUTPT(240),LINE(120),OBJCD(6000), 00112150
2 LADDR,ADDR,SUB,PRNTR 00112160
COMMON RMIN,RMAX,PTRS,TITLE,CRSET,OPER,SYM,SUBSC,OUTPT,LINE, 00112170
1 EXTME,RSTME,ACCUM,VAR 00112180
EQUIVALENCE (VAR(1),OBJCD(1)),(LADDR,PTRS(19)), 00112190
1 (PRNTR,PTRS(2)) 00112200
DATA AVGTM /1.D0,2.D0,3.D0,4.D0,5.D0,6.D0,7.D0, 00112210
1 1.D0,2.D0,3.D0,4.D0,5.D0,6.D0,7.D0, 00112220
2 1.D0,2.D0,3.D0,4.D0,5.D0,6.D0,7.D0, 00112230
3 1.D0,2.D0,3.D0,4.D0,5.D0,6.D0,7.D0, 00112240
4 1.D0,2.D0,3.D0,4.D0,5.D0,6.D0,7.D0, 00112250
5 1.D0,2.D0/ 00112260
EXTME = 0.D0 00112270
ADDR = LADDR - 2 00112280
100 ADDR = ADDR + 2 00112290
IF (OBJCD(ADDR) .EQ. 12) GO TO 200 00112300
SUB = OBJCD(ADDR) 00112310
EXTME = EXTME + AVGTM(SUB) 00112320
GO TO 100 00112330
200 WRITE (PRNTR,300) EXTME 00112340
300 FORMAT (' EXECUTION TIME ESTIMATES ',E9.3,'UNITS') 00112350
RETURN 00112360
END 00112380
SUBROUTINE NDT87 00112390
RETURN 00112400
END 00112410