Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-06 - decus/20-160/ndtrn2.for
There are no other files named ndtrn2.for in the archive.
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(8192)                                      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,4096)                                                     00000190
      INTEGER INIT0(21644),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     38,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(38000,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,21644                                                   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=4096                                                        00001000
      LITND=8192                                                        00001010
      DSKND=38000                                                       00001020
      VARND=18705                                                       00001030
      OBJND=37410                                                       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(8192)                                      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,4096)                                                     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(8192)                                      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,4096)                                                     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(8192)                                      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,4096)                                                     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(8192)                                      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,4096)                                                     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(8192)                                      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,4096)                                                     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(8192)                                      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,4096)                                                     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(8192)                                      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,4096)                                                     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(8192)                                      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,4096)                                                     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(8192)                                      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,4096)                                                     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(8192)                                      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,4096)                                                     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(8192)                                      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,4096)                                                     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(8192)                                      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,4096)                                                     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(8192)                                      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,4096)                                                     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(8192)                                      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,4096)                                                     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(8192)                                      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,4096)                                                     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(8192)                                      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,4096)                                                     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(8192)                                      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,4096)                                                     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(8192)                                      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,4096)                                                     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(8192)                                      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,4096)                                                     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(8192)                                      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,4096)                                                     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(8192)                                      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,4096)                                                     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(8192)                                      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,4096)                                                     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(8192)                                      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,4096)                                                     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(8192)                                      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,4096)                                                     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(8192)                                      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,4096)                                                     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(8192)                                      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,4096)                                                     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(8192)                                      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,4096)                                                     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(8192)                                      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,4096)                                                     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(8192)                                      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,4096)                                                     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(8192)                                      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,4096)                                                     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(8192)                                      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,4096)                                                     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(8192)                                      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,4096)                                                     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(8192)                                      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,4096)                                                     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(8192)                                      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,4096)                                                     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(8192)                                      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,4096)                                                     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(8192)                                      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,4096)                                                     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(8192)                                      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,4096)                                                     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(8192)                                      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,4096)                                                     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(8192)                                      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,4096)                                                     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
      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(8192)                                      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,4096)                                                     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(8192)                                      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,4096)                                                     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(8192)                                      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,4096)                                                     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(8192)                                      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,4096)                                                     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(8192)                                      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,4096)                                                     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(8192)                                      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,4096)                                                     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(8192)                                      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,4096)                                                     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(8192)                                      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,4096)                                                     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(8192)                                      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,4096)                                                     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(8192)                                      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,4096)                                                     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(8192)                                      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,4096)                                                     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(8192)                                      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,4096)                                                     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(8192)                                      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,4096)                                                     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(8192)                                      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,4096)                                                     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(8192)                                      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,4096)                                                     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(8192)                                      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,4096)                                                     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(8192)                                      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,4096)                                                     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(8192)                                      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,4096)                                                     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(8192)                                      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,4096)                                                     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(8192)                                      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,4096)                                                     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(8192)                                      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,4096)                                                     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(8192)                                      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,4096)                                                     00074420
      INTEGER SYMND,I,VTYPE,RECNO,START,REC,EQNPT,EQEND,DISK,DIST,      00074430
     1EQSRT(16384),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(18705),ACCUM,EXTME,RSTME(10)           00079390
      INTEGER PTRS(45),TITLE(120),CRSET(39),OPER(9),SYM(15),            00079400
     1SUBSC(6),OUTPT(240),LINE(120),OBJCD(37410)                        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(18705),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(37410)                        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(18705),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(37410)                        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(8192)                                      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,4096)                                                     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(8192)                                      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,4096)                                                     00094670
      INTEGER LINCT,TAG,TYPE,SMART,NAME(6),J,VNUM,SRTPT,PRNTR,          00094680
     1SORT(16384)                                                       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(8192)                                      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,4096)                                                     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(16384),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(8192)                                      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,4096)                                                     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(18705),ACCUM,EXTME,RSTME(10)                 00096960
      INTEGER PTRS(45),TITLE(120),CRSET(39),OPER(9),SYM(15),            00096970
     1SUBSC(6),OUTPT(240),LINE(120),OBJCD(37410)                        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(18705),ACCUM,EXTME,RSTME(10)                 00098230
      INTEGER PTRS(45),TITLE(120),CRSET(39),OPER(9),SYM(15),            00098240
     1SUBSC(6),OUTPT(240),LINE(120),OBJCD(37410)                        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(18705),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(37410)                        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(18705),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(37410)                        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(18705),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(37410)                        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(18705),ACCUM,EXTME,RSTME(10)                 00103320
      INTEGER PTRS(45),TITLE(120),CRSET(39),OPER(9),SYM(15),            00103330
     1SUBSC(6),OUTPT(240),LINE(120),OBJCD(37410)                        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(8192)                                      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,4096),SORT(16384)                                         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(18705),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(37410)                        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(18705),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(37410)                        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(18705),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(37410)                        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(18705),ACCUM,EXTME,RSTME(10)                 00108910
      INTEGER PTRS(45),TITLE(120),CRSET(39),OPER(9),SYM(15),            00108920
     1SUBSC(6),OUTPT(240),LINE(120),OBJCD(37410)                        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(18705),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(37410)                        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(18705),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(37410)                        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(18705),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(37410)                        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(8192)                                      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,4096)                                                     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(18705),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(37434),                      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