Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-13 - refmt.for
There are 6 other files named refmt.for in the archive. Click here to see a list.
      COMMON/RNBONE/I     ,IALPHA,IBASE ,IBR   ,IBREAK,
     1IEND  ,IENTER,IEOF  ,IERR  ,IFILL ,IFORM ,IFREAR,
     2IHIHDO,IIN   ,ILEVEL,ILPT  ,INCR  ,INCSAV,INDENT,
     3INDSAV,ININAM,INIOPR,INIPRT,INITOC,INRCPY,INRFND,
     4IOUT  ,IPAGE ,IPASS ,IPOINT,ISPACE,ISPLIT,ISPR  ,
     5ISTART,ISTN  ,ITAB  ,ITBL  ,ITITLE,ITRACE,ITTY  ,
     6J     ,JBGN  ,JBREAK,JEND  ,JEOF  ,JFORM ,JIN   ,
     7JIN1  ,JLEVEL,JMPBGN,JMPEND,JOBNUM,JOUT  ,JPASS ,
     8JPOINT,JSPLIT,JSTN  ,JTAB  ,JTBL  ,JTTY  ,K     ,
     9KBGN  ,KEND  ,KLEVEL,KMDMAX,KMDMIN,KNDGRP,KNT
C
      COMMON/RNBTWO/KNTONE,KNTPNT,KNTSPL,KNTTOC,KNTTWO,
     1KOMENT,KOMKNT,KOMNUM,KONTRL,KOUNT ,KPAGE ,KPASS ,
     2KPOINT,KPYEND,KSTN  ,KTAB  ,KUTNUM,KUTPAG,KUTPNT,
     3KUTSPL,L     ,LCLNUM,LCLPNT,LCLSPL,LEFT  ,LEND  ,
     4LIKE  ,LMTTOC,LNGCOM,LNGNAM,LNGNXT,LOWDO ,LOWER ,
     5LOWSHO,LOWTOC,LOW1  ,LOW2  ,LPOINT,LPTTTY,LRGNUM,
     6LRGPNT,LRGSPL,LRGTOC,LSTKNT,LSTN  ,LSTSTN,LTAB  ,
     7M     ,MANY  ,MASTER,MAXCOM,MAXEND,MAXLIN,MAXPNT,
     8MAXPRT,MAXSPL,MAXTOC,MID   ,MODBAS,MODINC,MODMAX,
     9MODMIN,MODNEW,MODOLD,MOST  ,MOVE  ,MSTN  ,MTAB
C
      COMMON/RNBTHR/N     ,NCD   ,NEED  ,NEWNUM,NEWSTN,
     1NONFOR,NOWTOC,NSTN  ,NTAB  ,NUM   ,NXTEND,NXTLST
C
      COMMON/RNBFOU/INRSTR(21)  ,JPNT(10)    ,LINREF(9)   ,
     1 MCHOPR(51)  ,NNEW(1000)  ,NOLD(1000)  ,NOTOPR(51)  ,
     2 NUMPNT(5000),NUMPRS(655) ,NUMTOC(112) ,NUMTYP(7)
C
      COMMON/RNBFIV/LTRCLN,LTRDDD,LTRDOT,LTREEE,LTREQL,
     1LTREXC,LTRHHH,LTRLFT,LTRMNS,LTRNOW,LTRPLS,LTRQOT,
     2LTRREF,LTRRIT,LTRSEM,LTRSLA,LTRSPC,LTRTAB,LTR1ST,
     3LTR2ND,LWRDDD,LWREEE,LWRHHH
C
      COMMON/RNBSIX/LTRABC(26)  ,LTRBGN(5)   ,LTRBIG(2211),
     1 LTRCOM(6)   ,LTRDGT(10)  ,LTREND(3)   ,LTRFLG(8)   ,
     2 LTRKEY(5)   ,LTRNAM(10)  ,LTROPR(51)  ,LTRPRS(331) ,
     3 LTRSPL(2000),LTRSRT(26)  ,LTRTOC(168) ,LTRTOP(117) ,
     4 LTRTTL(5)   ,LTRTYP(55)  ,LTRUSE(6)   ,LTR120(120) ,
     5 LWRABC(26)  ,LWRBGN(5)   ,LWREND(3)   ,LWRFLG(8)   ,
     6 LWRKEY(5)   ,LWRPRS(331) ,LWRSRT(26)  ,LWRTTL(5)
C     RENBR(REFMT/RESTRUCTURE RENBR FORTRAN PARSING TABLES)
C
C     DONALD BARTH, HARVARD BUSINESS SCHOOL
C
C     THIS PROGRAM ALLOWS THE ORDER OF  WORDS RECOGNIZED BY
C     THE PARSER FOR THE FORTRAN RENUMBERING PROGRAM RENBR,
C     AND  OF THE  NUMBERS WITHIN  THE TABLE DESCRIBING HOW
C     THE PARSING  IS DONE,  TO BE CHANGED.   ALL  POINTERS
C     WITHIN  THE  TABLE  ARE  KEPT  CORRECT.    THE   TREE
C     STRUCTURE OF THE TABLE IS ALSO LISTED.
C
C     THE BLOCK  DATA  ROUTINE  FROM  RENBR  AND  THE  DATA
C     STATEMENT   GENERATOR   FROM  THE  FASP  PACKAGE  ARE
C     REQUIRED.   THE  LABELED  COMMON  STATEMENT  IN  THIS
C     PROGRAM  MUST  BE IDENTICAL TO THAT IN THE BLOCK DATA
C     ROUTINE.
C
C     THE ONLY ITEMS WHICH ARE NEEDED FROM THE  BLOCK  DATA
C     ROUTINE  ARE  THE  DEFINITIONS OF THE LTRPRS, LWRPRS,
C     NUMPRS, LTRABC  AND  LWRABC  ARRAYS.   THE  VARIABLES
C     NAMED IIN, ILPT,  IOUT, JOUT AND ITTY  ALSO APPEAR IN
C     COMMON BLOCK AND ARE USED IN THIS PROGRAM, BUT  THESE
C     ARE DEFINED WITHIN THIS PROGRAM AND WOULD NOT NEED TO
C     BE IN THE COMMON BLOCK OR TO BE DEFINED IN THE  BLOCK
C     DATA ROUTINE.
C
C     DATA FOR THIS PROGRAM CONSIST OF THE WORDS RECOGNIZED
C     BY  THE  PARSER,  ONE  WORD PER LINE, TERMINATED BY A
C     BLANK LINE.   LTRPRS ARRAY  WILL BE REORDERED IN  THE
C     ORDER  OF  THE  INPUT WORDS.  ANY WORDS NOT SPECIFIED
C     WILL BE MOVED UPWARD IN THE ARRAY.   THE  BLANK  LINE
C     FOLLOWING  THE  WORD SPECIFICATIONS IS NECESSARY EVEN
C     IF ALL WORDS IN THE LTRPRS ARRAY ARE INCLUDED.
C
C     FOLLOWING THE FIRST SECTION SHOULD BE A LIST  OF  THE
C     SERIAL NUMBERS OF THE GROUPS OF ENTRIES IN THE NUMPRS
C     ARRAY IN THE ORDER IN WHICH THESE ARE DESIRED  TO  BE
C     OUTPUT,  AGAIN  A  SINGLE NUMBER PER LINE.  GROUPS OF
C     ENTRIES IN THE NUMPRS ARRAY EACH CONSIST OF  A  WHOLE
C     NUMBER  MULTIPLE  OF 5 LOCATIONS.  THUS, LOCATIONS 46
C     THRU 50 WOULD BE SPECIFIED BY THE NUMBER 10  IF  EACH
C     OF  THE LOWER GROUPS OF ENTRIES CONTAINS 5 LOCATIONS,
C     SINCE  THESE  LOCATIONS  FORM  THE  10TH   GROUP   OF
C     LOCATIONS  IN  THE ORIGINAL ARRAY.  A ZERO ENTRY OR A
C     BLANK LINE TERMINATES THIS SECTION  AND  ANY  ENTRIES
C     NOT SPECIFIED WILL BE LEFT IN THEIR PRIOR ORDER
C
C     IN DETERMINING THE SERIAL NUMBERS, LOWER GROUPS WHICH
C     CONTAIN MORE THAN 5 NUMBERS ARE EACH CONSIDERED TO BE
C     SINGLE GROUPS.  THUS, IF THE NUMPRS ARRAY STARTS WITH
C     A TYPE 1 TEST, THEN A LONG TYPE 6  TAKING MORE THAN 5
C     LOCATIONS, THEN  ANOTHER TYPE 1 TEST, THE  THIRD TEST
C     WILL  HAVE 3  AS ITS  SERIAL  NUMBER  EVEN  THOUGH IT
C     STARTS BEYOND LOCATION 11.
C
C     AN INPUT WHICH CONSISTED ONLY OF 2 BLANK LINES  WOULD
C     RESULT IN A LISTING OF THE PARSER STRUCTURE AND A NEW
C     VERSION OF THE INPUT FILE REFERENCING  ONLY THE WORDS
C     NODES WHICH  ARE ACTUALLY USED.   THIS NEW VERSION OF
C     THE INPUT FILE CAN THEN BE  EDITED AND USED TO CHANGE
C     THE ACTUAL ORDER OF THE ITEMS IN THE ARRAYS.
C
C     IF THE NEW VERSION OF THE INPUT FILE PRODUCED BY THIS
C     PROGRAM IS  USED DIRECTLY  AS THE INPUT FILE THE NEXT
C     TIME, WITHOUT CHANGING THE ORDER OF THE  ITEMS IN THE
C     ARRAYS  DEFINED BY  THE BLOCK  DATA ROUTINE, THEN THE
C     RESULTING ARRAYS PRODUCED  BY THIS SECOND RUN WILL BE
C     ORDERED IN SUCH A MANNER THAT THEY CAN BE EASILY READ
C     BUT OF  COURSE THE ORDER  MAKES NO  DIFFERENCE TO THE
C     PROGRAM.  THE PROCEDURE TO  OBTAIN THIS LOGICAL ORDER
C     WOULD THUS BE AS FOLLOWS.
C     1.  CONSTRUCT AN EMPTY INPUT FILE CONTAINING ONLY TWO
C         BLANK LINES.
C     2.  RUN THE REFMT PROGRAM.
C     3.  RENAME THE RESULTING  NEW SUGGESTED INPUT FILE SO
C         THAT IT WILL BE READ THE NEXT TIME REFMT IS RUN.
C     4.  WITHOUT  CHANGING THE ORDER  OF THE ARRAYS IN THE
C         PARSING TABLE DEFINED BY THE BLOCK  DATA ROUTINE,
C         RUN THE REFMT PROGRAM AGAIN.
C     5.  INSERT THE  RESULTING DIMENSION,  EQUIVALENCE AND
C         DATA  STATEMENTS INTO  THE BLOCK DATA  ROUTINE IN
C         PLACE OF THE PREVIOUS VERSION.
C     NOW, IF REFMT IS RUN AGAIN  EITHER WITH A BLANK INPUT
C     FILE, OR  ONE SPECIFYING AN UNCHANGED ORDER (1, 2, 3,
C     ETC.),  A  NEW  VERSION OF  THE INPUT  FILE  WOULD BE
C     PRODUCED WHICH  WOULD ALSO SPECIFY AN UNCHANGED ORDER
C     (1, 2, 3, ETC.).
C
C     KPNT   = MUST BE DIMENSIONED AT  LEAST  AS  LARGE  AS
C              NUMBER OF GROUPS  IN  NUMPRS ARRAY.  WILL BE
C              LARGE ENOUGH IF  DIMENSIONED  TO  NUMBER  OF
C              VALUES IN NUMPRS ARRAY DIVIDED BY 5.  ACTUAL
C              SIZE OF KPNT ARRAY MUST BE STORED IN MAXGRP.
C     LPNT   = MUST BE DIMENSIONED SAME AS KPNT.
C     LTRNXT = MUST BE BIG ENOUGH TO HOLD LONGEST  WORD  IN
C              PARSER.
C     ISAVE  = MUST BE BIG ENOUGH TO HOLD LARGEST GROUP  OF
C              NUMBERS  IN  PARSER.  MUST BE DIMENSIONED TO
C              NEXT MULTPLE OF 5 EQUAL TO OR  GREATER  THAN
C              SIZE OF GROUP DESCRIBING LONGEST FUNCTION 6
C              DESCRIPTION.
      DIMENSION KPNT(300),LPNT(300),LTRNXT(30),ISAVE(30),
     1LTRNM1(6),LTRNM2(6),LTRNM3(6)
C
C     FILE NAMES
      DOUBLE PRECISION FILINP,FILOUT,FILNXT,FILLPT
C
C     MAXGRP = DIMENSION OF KPNT AND LPNT ARRAYS AND MAXIMUM
C              NUMBER OF DIFFERENT OPERATIONS IN PARSER
C              TABLES.
      DATA MAXGRP/300/
C
      DATA LTRNON/1H /
      DATA LTRNM1/1HN,1HU,1HM,1HP,1HR,1HS/
      DATA LTRNM2/1HL,1HT,1HR,1HP,1HR,1HS/
      DATA LTRNM3/1HL,1HW,1HR,1HP,1HR,1HS/
C
C     IIN    = UNIT  NUMBER  FROM  WHICH  INSTRUCTIONS  ARE
C              READ.
C     IOUT   = UNIT NUMBER TO WHICH NEW DATA STATEMENTS ARE
C              WRITTEN.
C     JOUT   = UNIT NUMBER TO WHICH NEW INPUT FILE IS
C              WRITTEN
C     ILPT   = UNIT NUMBER TO WHICH LISTING IS WRITTEN.
C     ITTY   = UNIT NUMBER  TO  WHICH  ERROR  MESSAGES  ARE
C              WRITTEN.
C
      DATA IIN,IOUT,JOUT,ILPT,ITTY/1,20,21,22,5/
C
C     GET NAMES OF FILES AND OPEN THEM
    1 WRITE(ITTY,3)
      READ(ITTY,2)FILINP
      OPEN(UNIT=IIN,FILE=FILINP,ACCESS='SEQIN',ERR=1)
      WRITE(ITTY,4)
      READ(ITTY,2)FILOUT
      OPEN(UNIT=IOUT,FILE=FILOUT,ACCESS='SEQOUT')
      WRITE(ITTY,5)
      READ(ITTY,2)FILNXT
      OPEN(UNIT=JOUT,FILE=FILNXT,ACCESS='SEQOUT')
      WRITE(ITTY,6)
      READ(ITTY,2)FILLPT
      OPEN(UNIT=ILPT,FILE=FILLPT,ACCESS='SEQOUT')
    2 FORMAT(1A10)
    3 FORMAT(' FILE SPECIFYING DESIRED ORDER? ',$)
    4 FORMAT(' FILE TO WHICH DATA STATEMENTS ARE TO BE WRITTEN? ',$)
    5 FORMAT(' FILE TO WHICH NEXT INPUT FILE IS TO BE WRITTEN? ',$)
    6 FORMAT(' FILE TO WHICH LISTING IS TO BE WRITTEN? ',$)
C
C     DETERMINE SIZE OF ARRAYS
      LMTNMB=0
      LMTLST=0
      L=1
      LMTGRP=0
    7 LMTGRP=LMTGRP+1
      N=2
      IF(NUMPRS(L).EQ.16)N=1
      IF(NUMPRS(L).EQ.6)N=NUMPRS(L+2)-NUMPRS(L+1)+2
      J=L+3
      IF(NUMPRS(L+1).GT.LMTLST)LMTLST=NUMPRS(L+1)
      IF(NUMPRS(L+2).GT.LMTLST)LMTLST=NUMPRS(L+2)
      DO 8 M=1,N
      IF(LMTNMB.LT.NUMPRS(J))LMTNMB=NUMPRS(J)
    8 J=J+1
      N=N+3
    9 L=L+5
      N=N-5
      IF(N.GT.0)GO TO 9
      IF(L.LE.LMTNMB)GO TO 7
      LMTNMB=L-1
      IF(LMTGRP.GT.MAXGRP)GO TO 65
C
C     **********************************
C     *                                *
C     *  RESTRUCTURE THE LTRPRS ARRAY  *
C     *                                *
C     **********************************
C
C     READ NEXT WORD TO BE MOVED
      NEXT=1
      IATEND=0
   10 READ(IIN,11,END=40)(LTRNXT(I),I=1,30)
   11 FORMAT(30A1)
      IF(NEXT.GT.LMTLST)GO TO 41
      LENGTH=30
   12 IF(LTRNXT(LENGTH).NE.LTRNON)GO TO 13
      LENGTH=LENGTH-1
      IF(LENGTH.GT.0)GO TO 12
      GO TO 41
C
C     LOCATE THIS WORD IN LIST OF CHARACTERS
   13 INITAL=NEXT
   14 J=1
      INDEX=INITAL
   15 IF(LTRPRS(INDEX).EQ.LTRNXT(J))GO TO 19
   16 INITAL=INITAL+1
      IF((INITAL+LENGTH-1).LE.LMTLST)GO TO 14
      WRITE(ITTY,17)(LTRNXT(I),I=1,LENGTH)
   17 FORMAT(18H WORD NOT MATCHED ,30A1)
      IF(ITTY.EQ.IIN)WRITE(ITTY,18)
   18 FORMAT(1X)
      GO TO 10
   19 IF(J.EQ.LENGTH)GO TO 20
      INDEX=INDEX+1
      J=J+1
      GO TO 15
C
C     DETERMINE IF MATCH IS LEGAL
   20 K=1
      N=0
   21 IF(NUMPRS(K).EQ.3)GO TO 22
      IF(NUMPRS(K).EQ.10)GO TO 22
      IF(NUMPRS(K).EQ.13)GO TO 22
      IF(NUMPRS(K+1).EQ.INITAL)GO TO 23
      GO TO 24
   22 IF(LENGTH.NE.1)GO TO 24
      IF(NUMPRS(K+1).EQ.INDEX)GO TO 32
   23 IF(NUMPRS(K+2).EQ.INDEX)GO TO 32
   24 IF(NUMPRS(K+1).EQ.0)GO TO 27
      IF(NUMPRS(K+2).EQ.0)GO TO 26
      IF(NUMPRS(K+1).LE.INDEX)GO TO 25
      IF(NUMPRS(K+2).GT.INDEX)GO TO 30
   25 IF(NUMPRS(K+1).GE.INITAL)GO TO 29
      GO TO 28
   26 IF(NUMPRS(K+1).GT.INDEX)GO TO 30
      IF(NUMPRS(K+1).LT.INITAL)GO TO 30
      GO TO 29
   27 IF(NUMPRS(K+2).GT.INDEX)GO TO 30
   28 IF(NUMPRS(K+2).LT.INITAL)GO TO 30
   29 N=1
   30 M=2
      IF(NUMPRS(K).EQ.6)M=NUMPRS(K+2)-NUMPRS(K+1)+2
      M=M+3
   31 K=K+5
      M=M-5
      IF(M.GT.0)GO TO 31
      IF(K.LT.LMTNMB)GO TO 21
      IF(N.NE.0)GO TO 16
C
C     CHANGE POINTERS TO CHARACTERS
   32 I=1
   33 J=I
      DO 35 K=1,2
      J=J+1
      L=NUMPRS(J)
      IF(L.LT.NEXT)GO TO 35
      IF(L.GT.INDEX)GO TO 35
      IF(L.LT.INITAL)GO TO 34
      NUMPRS(J)=NEXT+L-INITAL
      GO TO 35
   34 NUMPRS(J)=L+LENGTH
   35 CONTINUE
      M=2
      IF(NUMPRS(I).EQ.6)M=NUMPRS(I+2)-NUMPRS(I+1)+2
      M=M+3
   36 I=I+5
      M=M-5
      IF(M.GT.0)GO TO 36
      IF(I.LT.LMTNMB)GO TO 33
C
C     MOVE LETTERS UP TO MAKE ROOM FOR INSERTION
   37 IF(INITAL.LE.NEXT)GO TO 38
      INITAL=INITAL-1
      LTRPRS(INDEX)=LTRPRS(INITAL)
      INDEX=INDEX-1
      GO TO 37
C
C     INSERT LETTERS TO BE MOVED
   38 DO 39 I=1,LENGTH
      LTRPRS(NEXT)=LTRNXT(I)
   39 NEXT=NEXT+1
      GO TO 10
C
C     **********************************
C     *                                *
C     *  RESTRUCTURE THE NUMPRS ARRAY  *
C     *                                *
C     **********************************
C
   40 IATEND=1
   41 DO 42 I=1,LMTGRP
   42 KPNT(I)=I
      IF(IATEND.NE.0)GO TO 62
      NEXT=1
      INIT=1
C
C     OBTAIN NUMBER OF NEXT GROUP TO BE MOVED
   43 READ(IIN,44,END=62)INDEX
   44 FORMAT(I)
      IF(INDEX.LE.0)GO TO 62
      IF(INDEX.LE.LMTGRP)GO TO 46
      WRITE(ITTY,45)INDEX
   45 FORMAT(13H NUMPRS GROUP,1I5,10H TOO LARGE)
      IF(ITTY.EQ.IIN)WRITE(ITTY,18)
      GO TO 43
C
C     DETERMINE LOCATION AND SIZE OF PRESENT GROUP
   46 LCTN=INIT
      KNTGRP=NEXT
   47 N=2
      IF(NUMPRS(LCTN).EQ.6)N=NUMPRS(LCTN+2)-NUMPRS(LCTN+1)+2
      N=N+3
      LENGTH=0
   48 LCTN=LCTN+5
      N=N-5
      LENGTH=LENGTH+5
      IF(N.GT.0)GO TO 48
      IF(INDEX.EQ.KPNT(KNTGRP))GO TO 50
      KNTGRP=KNTGRP+1
      IF(KNTGRP.LE.LMTGRP)GO TO 47
      WRITE(ITTY,49)INDEX
   49 FORMAT(13H NUMPRS GROUP,1I5,18H ALREADY PROCESSED)
      IF(ITTY.EQ.IIN)WRITE(ITTY,18)
      GO TO 43
   50 IF(KNTGRP.EQ.NEXT)GO TO 60
      LCTN=LCTN-LENGTH
C
C     UPDATE REFERENCES TO GROUPS BEING SHIFTED
      L=1
   51 N=2
      IF(NUMPRS(L).EQ.16)N=1
      IF(NUMPRS(L).EQ.6)N=NUMPRS(L+2)-NUMPRS(L+1)+2
      J=L+3
      DO 53 M=1,N
      IF(NUMPRS(J).LT.INIT)GO TO 53
      IF(NUMPRS(J).EQ.LCTN)GO TO 52
      IF(NUMPRS(J).LT.LCTN)NUMPRS(J)=NUMPRS(J)+LENGTH
      GO TO 53
   52 NUMPRS(J)=INIT
   53 J=J+1
      N=N+3
   54 L=L+5
      N=N-5
      IF(N.GT.0)GO TO 54
      IF(L.LT.LMTNMB)GO TO 51
C
C     MOVE GROUP TO ITS NEW LOCATION
      I=LCTN
      DO 55 J=1,LENGTH
      ISAVE(J)=NUMPRS(I)
   55 I=I+1
   56 IF(LCTN.LE.INIT)GO TO 57
      I=I-1
      LCTN=LCTN-1
      NUMPRS(I)=NUMPRS(LCTN)
      GO TO 56
   57 DO 58 J=1,LENGTH
      NUMPRS(INIT)=ISAVE(J)
   58 INIT=INIT+1
C
C     UPDATE RECORD OF WHERE UNPROCESSED GROUPS ARE FOUND
   59 IF(KNTGRP.LE.NEXT)GO TO 61
      KPNT(KNTGRP)=KPNT(KNTGRP-1)
      KNTGRP=KNTGRP-1
      GO TO 59
   60 INIT=INIT+LENGTH
   61 NEXT=NEXT+1
      IF(NEXT.LE.LMTGRP)GO TO 43
C
C     CONSTRUCT ARRAY CONTAINING LOWER CASE LETTERS
   62 DO 64 I=1,LMTLST
      LTRNEW=LTRPRS(I)
      LWRPRS(I)=LTRNEW
      DO 63 J=1,26
      IF(LTRNEW.NE.LTRABC(J))GO TO 63
      LWRPRS(I)=LWRABC(J)
      GO TO 64
   63 CONTINUE
   64 CONTINUE
C
C     WRITE DATA STATEMENTS SPECIFYING PARSER
      CALL DASAVE(-4,1,53,10,NUMPRS,
     1LMTNMB,LTRPRS,LMTLST,LTRNM1,6,IOUT,IFERR)
      CALL DASAVE(-4,-1,53,10,NUMPRS,
     1LMTNMB,LTRPRS,LMTLST,LTRNM2,6,IOUT,IFERR)
      CALL DASAVE(-4,-1,53,10,NUMPRS,
     1LMTNMB,LWRPRS,LMTLST,LTRNM3,6,IOUT,IFERR)
      CALL DASAVE(3,1,53,10,NUMPRS,
     1LMTNMB,LTRPRS,LMTLST,LTRNM1,6,IOUT,IFERR)
      CALL DASAVE(3,-1,53,10,NUMPRS,
     1LMTNMB,LTRPRS,LMTLST,LTRNM2,6,IOUT,IFERR)
      CALL DASAVE(3,-1,53,10,NUMPRS,
     1LMTNMB,LWRPRS,LMTLST,LTRNM3,6,IOUT,IFERR)
C
C     CALL FOR LISTING OF SYNTAX TABLE STRUCTURE
      CALL RETREE(LTRPRS,LMTLST,NUMPRS,LMTNMB,KPNT,LPNT,
     1 JOUT,ILPT)
      GO TO 67
C
C     KPNT ARRAY TOO SMALL
   65 WRITE(ITTY,66)MAXGRP,LMTGRP
   66 FORMAT(' INCREASE DIMENSION OF KPNT ARRAY FROM',
     11I5,' TO',1I5/' AND THEN RUN THIS PROGRAM AGAIN')
      GO TO 67
C
C     ALL DONE
   67 STOP
      END
      SUBROUTINE RETREE(LTRPRS,LMTLST,NUMPRS,LMTNMB,KPNT,LPNT,
     1 JOUT,ILPT)
C     RENBR(/LIST STRUCTURE OF RENBR PARSER)R=
C
C     REFMT ROUTINE TO LIST STRUCTURE OF RENBR SYNTAX
C     DRIVING TABLE.
C
C     EACH SET OF 5 ENTRIES IS LISTED ON A SINGLE LINE
C     TOGETHER WITH THE ALPHAMERIC LETTERS TESTED AGAINST
C     FOLLOWED BY AN ABBREVIATED LISTING OF THE SETS
C     TRANSFERRED TO IN CASE OF SUCCESS AND FAILURE
C     RESPECTIVELY.  THE FIRST NUMBER IN THE LINE
C     IDENTIFIES THE FUNCTION PERFORMED.  THESE FUNCTIONS
C     ARE DESCRIBED IN COMMENT CARDS IN THE RENBR BLOCK
C     DATA PROGRAM.  ON THE NEXT LINE ARE LISTED
C     ALL THE SETS WHICH TRANSFER TO THE PRESENT SET.
C
      DIMENSION KPNT(500),LTRPRS(500),NUMPRS(500),LTRONE(7),
     1LTRTWO(5),LTRTHR(5),NMBONE(5),NMBTWO(3),NMBTHR(3),
     2KOLUMN(33),IDUMMY(33),LTRSHO(132),LPNT(500)
      DATA LNGPAG/60/
      DATA LTRDOT,LTRNON/1H.,1H /
C
C     ****************************************************
C     *                                                  *
C     *  NEW INPUT FILE INCLUDING ONLY REFERENCED ITEMS  *
C     *                                                  *
C     ****************************************************
C
C     DETERMINE WHICH NODES ARE ACTUALLY USED
      KPNT(1)=1
      NXTTST=1
    1 MAXTST=NXTTST
      DO 13 NEWTST=1,MAXTST
      NOWTST=MAXTST-NEWTST+1
C     LOOK FOR A CHAIN OF FAILURES, ALTERNATE TESTS
      I2=KPNT(NOWTST)
    2 I4=NUMPRS(I2+4)
      IF(I4.EQ.0)GO TO 3
      IF(NUMPRS(I2).EQ.NUMPRS(I4))GO TO 6
    3 IF(NUMPRS(I2).EQ.1)GO TO 6
      IF(NUMPRS(I2).EQ.29)GO TO 6
      IF(NUMPRS(I2).LT.17)GO TO 4
      IF(NUMPRS(I2).LE.24)GO TO 6
    4 CONTINUE
      GO TO 10
    5 I2=I4
      I4=NUMPRS(I2+4)
    6 DO 7 I1=1,NXTTST
      IF(KPNT(I1).EQ.I2)GO TO 8
    7 CONTINUE
      NXTTST=NXTTST+1
      KPNT(NXTTST)=I2
    8 IF(I4.EQ.0)GO TO 10
      IF(NUMPRS(I2).EQ.NUMPRS(I4))GO TO 5
    9 I2=I4
      GO TO 2
C     CHECK ALL DESTINATIONS TO SEE IF IN LIST
   10 L=KPNT(NOWTST)
      I2=L
      N=2
      IF(NUMPRS(L).EQ.16)N=1
      IF(NUMPRS(L).EQ.6)N=NUMPRS(L+2)-NUMPRS(L+1)+2
      L=L+3
      DO 12 M=1,N
      IF(NUMPRS(L).LE.0)GO TO 12
      DO 11 K=1,NXTTST
      IF(KPNT(K).EQ.NUMPRS(L))GO TO 12
   11 CONTINUE
      NXTTST=NXTTST+1
      KPNT(NXTTST)=NUMPRS(L)
      IF(NUMPRS(I2).NE.6)GO TO 1
      I2=NUMPRS(L)
      GO TO 2
   12 L=L+1
      IF(MAXTST.LT.NXTTST)GO TO 1
   13 CONTINUE
C
C     ******************************
C     *                            *
C     *  IDENTIFY CHAINS OF TESTS  *
C     *                            *
C     ******************************
C
C     SORT THE EXIT NODES TO TOP OF LIST
      K=MAXTST
      L=MAXTST
   14 I=KPNT(K)
      IF(NUMPRS(I+3).NE.0)GO TO 17
      J=K
   15 IF(J.EQ.L)GO TO 16
      KPNT(J)=KPNT(J+1)
      J=J+1
      GO TO 15
   16 KPNT(L)=I
      L=L-1
   17 K=K-1
      IF(K.GT.0)GO TO 14
C
C     GET NEXT NODE WHICH MIGHT START CHAIN
      NOWTST=1
      KNTGRP=0
   18 KNTGRP=KNTGRP+1
      LPNT(NOWTST)=KNTGRP
   19 LOCTST=KPNT(NOWTST)
      IF(NUMPRS(LOCTST).EQ.6)GO TO 23
C
C     DETERMINE IF THIS NODE POINTS TO ONE NEXT HIGHER
   20 IF(NOWTST.GE.MAXTST)GO TO 27
      N=2
      IF(NUMPRS(LOCTST).EQ.16)N=1
      IF(NUMPRS(LOCTST).EQ.6)N=NUMPRS(LOCTST+2)-NUMPRS(LOCTST+1)+2
      I=LOCTST+3
      DO 21 M=1,N
      L21=NUMPRS(I)
      IF(L21.EQ.0)GO TO 21
      IF(NUMPRS(L21+3).EQ.0)GO TO 21
      IF(L21.EQ.KPNT(NOWTST+1))GO TO 22
   21 I=I+1
      NOWTST=NOWTST+1
      GO TO 18
   22 NOWTST=NOWTST+1
      LPNT(NOWTST)=KNTGRP
      GO TO 19
C
C     CHECK FOR END OF FUNCTION 6 CHAIN
   23 I=LOCTST+3
      N=NUMPRS(LOCTST+2)-NUMPRS(LOCTST+1)+1
      DO 26 M=1,N
      L21=NUMPRS(I)
   24 IF(NUMPRS(L21).EQ.1)GO TO 25
      IF(NUMPRS(L21).EQ.29)GO TO 25
      GO TO 26
   25 IF(NOWTST.EQ.MAXTST)GO TO 26
      IF(KPNT(NOWTST+1).NE.L21)GO TO 26
      NOWTST=NOWTST+1
      LPNT(NOWTST)=KNTGRP
      L21=NUMPRS(L21+4)
      IF(L21.NE.0)GO TO 24
   26 I=I+1
      LOCTST=KPNT(NOWTST)
      GO TO 20
   27 CONTINUE
C
C     *****************************
C     *                           *
C     *  CONNECT CHAINS OF TESTS  *
C     *                           *
C     *****************************
C
C     FIND FIRST NODE NOT IN CURRENT CHAIN
      NOWTST=1
   28 IF(NOWTST.GT.MAXTST)GO TO 39
      IF(NOWTST.EQ.MAXTST)GO TO 30
      IF(LPNT(NOWTST).NE.LPNT(NOWTST+1))GO TO 30
   29 NOWTST=NOWTST+1
      GO TO 28
C
C     IF DOES NOT POINT TO NEXT, LOOK FOR NODE IT DOES POINT TO
   30 LOCTST=KPNT(NOWTST)
      N=2
      IF(NUMPRS(LOCTST).EQ.16)N=1
      IF(NUMPRS(LOCTST).EQ.6)N=NUMPRS(LOCTST+2)-NUMPRS(LOCTST+1)+2
      LOCTST=LOCTST+3
      DO 37 M=1,N
      L21=NUMPRS(LOCTST)
      IF(L21.EQ.0)GO TO 37
      IF(NUMPRS(L21+3).EQ.0)GO TO 37
      IF(L21.EQ.1)GO TO 37
      NXTTST=0
   31 NXTTST=NXTTST+1
      IF(KPNT(NXTTST).NE.L21)GO TO 31
      MAXTGT=NXTTST
      MINTGT=NXTTST
C
C     FIND BOTTOM NODE IN SECTION POINTED TO
   32 IF(MINTGT.LE.1)GO TO 33
      IF(LPNT(MINTGT).NE.LPNT(MINTGT-1))GO TO 33
      MINTGT=MINTGT-1
      GO TO 32
C
C     FIND TOP NODE IN SECTION POINTED TO
   33 IF(MAXTGT.GE.MAXTST)GO TO 34
      IF(LPNT(MAXTGT).NE.LPNT(MAXTGT+1))GO TO 34
      MAXTGT=MAXTGT+1
      GO TO 33
C
C     CHECK IF ARE REALLY AT BOTTOM OF THE SECTION
C     ALSO, DON'T MOVE BOTTOM GROUP, NOR GROUP POINTING TO SELF
   34 CONTINUE
      IF(MINTGT.EQ.1)GO TO 37
      IF(MAXTGT.EQ.NOWTST)GO TO 37
      IF(MINTGT.NE.NXTTST)GO TO 37
C
C     CHANGE CHAIN IDENTIFICATION NUMBERS TO BE SAME IN BOTH PARTS
      DO 35 I=MINTGT,MAXTGT
      LPNT(I)=LPNT(NOWTST)
   35 CONTINUE
C
C     IF NODE POINTED TO IS TRULY ALONE, THEN MOVE IT ABOVE NEW ONE
      IF(NXTTST.GT.NOWTST)GO TO 36
C
C     IF MOVING LOWER NODE, MOVE COLUMN DOWN AND INSERT AT TOP
C     MINTGT ... MAXTGT, MAXTGT+1 ... NOWTST
C     BECOMES
C     MAXTGT+1 ... NOWTST, MINTGT ... MAXTGT
      CALL DASWAP(KPNT,MINTGT,MAXTGT,NOWTST)
      CALL DASWAP(LPNT,MINTGT,MAXTGT,NOWTST)
      NOWTST=NOWTST-1
      GO TO 38
C
C     IF MOVING HIGHER NODE, SHIFT COLUMN UP AND INSERT ABOVE FIXED NODE
C     NOWTST, NOWTST+1 ... MINTGT-1, MINTGT ... MAXTGT
C     BECOMES
C     NOWTST, MINTGT ... MAXTGT, NOWTST+1 ... MINTGT-1
   36 L3=NOWTST+1
      L4=MINTGT-1
      CALL DASWAP(KPNT,L3,L4,MAXTGT)
      CALL DASWAP(LPNT,L3,L4,MAXTGT)
      NOWTST=NOWTST+MAXTGT-MINTGT
      GO TO 38
C
C     PREPARE TO CHECK NEXT DESTINATION IF CANNOT MOVE CURRENT DESTINATI
   37 LOCTST=LOCTST+1
C
C     DONE MERGING THESE CHAINS
   38 GO TO 29
C
C     ALL POSSIBLE CHAINS MERGED
   39 CONTINUE
C
C     *******************************************
C     *                                         *
C     *  ATTEMPT TO MAKE EACH CHAIN BE BETWEEN  *
C     *  THOSE CALLING IT AND ONES IT CALLS     *
C     *                                         *
C     *******************************************
C
C     LOOK FOR EXTENT OF INITIAL CHAIN
      KOUTER=MAXTST+1
   40 MAXBGN=0
      JOUTER=KOUTER
      KOUTER=0
   41 MAXBGN=MAXBGN+1
      MINBGN=MAXBGN
   42 IF(MAXBGN.GT.MAXTST)GO TO 59
      IF(MAXBGN.EQ.MAXTST)GO TO 43
      IF(LPNT(MAXBGN).NE.LPNT(MAXBGN+1))GO TO 43
      MAXBGN=MAXBGN+1
      GO TO 42
C
C     FIND ALL CHAINS POINTED TO BY INITIAL CHAIN
   43 DO 58 NEWBGN=MINBGN,MAXBGN
      IOUTER=KPNT(NEWBGN)
      N38=2
      IF(NUMPRS(IOUTER).EQ.16)N38=1
      IF(NUMPRS(IOUTER).EQ.6)N38=NUMPRS(IOUTER+2)-NUMPRS(IOUTER+1)+2
      IOUTER=IOUTER+3
      DO 57 M38=1,N38
      L21=NUMPRS(IOUTER)
      IF(L21.EQ.0)GO TO 57
      IF(NUMPRS(L21+3).EQ.0)GO TO 57
      IF(L21.EQ.1)GO TO 57
      NOWMID=0
   44 NOWMID=NOWMID+1
      IF(KPNT(NOWMID).NE.L21)GO TO 44
      MINMID=NOWMID
      MAXMID=NOWMID
C
C     LOOK FOR EXTENT OF MIDDLE CHAIN
   45 IF(MINMID.LE.1)GO TO 46
      IF(LPNT(MINMID).NE.LPNT(MINMID-1))GO TO 46
      MINMID=MINMID-1
      GO TO 45
   46 IF(MAXMID.GE.MAXTST)GO TO 47
      IF(LPNT(MAXMID).NE.LPNT(MAXMID+1))GO TO 47
      MAXMID=MAXMID+1
      GO TO 46
C
C     FIND ALL CHAINS POINTED TO BY MIDDLE CHAIN
   47 MINEND=MAXTST+1
      MAXEND=0
      DO 54 NEWMID=MINMID,MAXMID
      INNER=KPNT(NEWMID)
      N39=2
      IF(NUMPRS(INNER).EQ.16)N39=1
      IF(NUMPRS(INNER).EQ.6)N39=NUMPRS(INNER+2)-NUMPRS(INNER+1)+2
      INNER=INNER+3
      DO 53 M39=1,N39
      L22=NUMPRS(INNER)
      IF(L22.EQ.0)GO TO 53
      NOWEND=0
   48 NOWEND=NOWEND+1
      IF(KPNT(NOWEND).NE.L22)GO TO 48
C
C     INSURE NOT POINTING TO SELF
      IF(NOWEND.LT.MINMID)GO TO 49
      IF(NOWEND.LE.MAXMID)GO TO 53
   49 CONTINUE
C
C     LOOK FOR EXTENT OF FINAL CHAIN
      MININR=NOWEND
      MAXINR=NOWEND
   50 IF(MININR.LE.1)GO TO 51
      IF(LPNT(MININR).NE.LPNT(MININR-1))GO TO 51
      MININR=MININR-1
      GO TO 50
   51 IF(MAXINR.GE.MAXTST)GO TO 52
      IF(LPNT(MAXINR).NE.LPNT(MAXINR+1))GO TO 52
      MAXINR=MAXINR+1
      GO TO 51
   52 IF(MINEND.GT.MININR)MINEND=MININR
      IF(MAXEND.LT.MAXINR)MAXEND=MAXINR
   53 INNER=INNER+1
   54 CONTINUE
C
C     MAXBGN                 MAXMID                 MAXEND
C       .                    .    .                   .
C     NEWBGN .......... NOWMID    NEWMID .......... NOWEND
C       .                    .    .                   .
C     MINBGN                 MINMID                 MINEND
C
C     INSURE THAT MIDDLE SECTION CAN ACTUALLY BE MOVED
      IF(MINMID.EQ.1)GO TO 57
      IF(MINMID.EQ.MINBGN)GO TO 57
C
C     DON'T ALLOW MISSING FINAL, OR FINAL THAT OVERLAPS INITIAL
      IF(MINEND.GT.MAXEND)GO TO 57
      IF(MINEND.LE.MAXBGN)GO TO 57
C
C     CHECK IF MIDDLE SECTION IS BELOW INITIAL OR ABOVE FINAL
      IF(MINMID.GT.MAXEND)GO TO 55
      IF(MAXMID.GE.MINBGN)GO TO 57
C
C     MIDDLE FUNCTION BELOW INITIAL AND FINAL FUNCTIONS
C     MOVE MIDDLE FUNCTION BETWEEN THESE
C
C                        NOWEND                         NOWEND
C                       .                              .
C                      .                              .
C     NEWBGN          .         BECOMES         NOWMID
C           .        .                         .
C            .      .                         .
C             NOWMID                    NEWBGN
C
      CALL DASWAP(KPNT,MINMID,MAXMID,MAXBGN)
      CALL DASWAP(LPNT,MINMID,MAXMID,MAXBGN)
      GO TO 56
C
C     MIDDLE FUNCTION ABOVE INITIAL AND FINAL FUNCTIONS
C     MOVE MIDDLE FUNCTION BETWEEN THESE
C
C                NOWMID                                  NOWEND
C               .      .                                .
C              .        .                              .
C             .          NOWEND  BECOMES         NOWMID
C            .                                  .
C           .                                  .
C     NEWBGN                             NEWBGN
C
   55 L1=MAXBGN+1
      L2=MINMID-1
      CALL DASWAP(KPNT,L1,L2,MAXMID)
      CALL DASWAP(LPNT,L1,L2,MAXMID)
C
C     RESCAN ENTIRE TREE IF MOVING MIDDLE COULD NOT LEAD TO LOOP
   56 KOUTER=KOUTER+1
   57 IOUTER=IOUTER+1
   58 CONTINUE
      GO TO 41
   59 CONTINUE
      IF(KOUTER.LE.1)GO TO 60
      IF(KOUTER.LT.JOUTER)GO TO 40
   60 CONTINUE
C
C     *********************************************************
C     *                                                       *
C     *  WRITE LIST OF REFERENCED WORDS INTO NEW OUTPUT FILE  *
C     *                                                       *
C     *********************************************************
C
      J=0
   61 I=J+1
      IF(I.GT.LMTLST)GO TO 68
      NOWTST=0
   62 NOWTST=NOWTST+1
      IF(NOWTST.LE.MAXTST)GO TO 63
      J=I
      GO TO 61
   63 K=KPNT(NOWTST)
      IF(NUMPRS(K).EQ.3)GO TO 64
      IF(NUMPRS(K).EQ.10)GO TO 64
      IF(NUMPRS(K).EQ.13)GO TO 64
      IF(NUMPRS(K+1).NE.I)GO TO 62
      IF(NUMPRS(K+2).LE.I)GO TO 65
      J=NUMPRS(K+2)
      GO TO 66
   64 IF(NUMPRS(K+1).EQ.I)GO TO 65
      IF(NUMPRS(K+2).NE.I)GO TO 62
   65 J=I
      GO TO 66
   66 WRITE(JOUT,67)(LTRPRS(K),K=I,J)
   67 FORMAT(40A1)
      GO TO 61
   68 WRITE(JOUT,69)
   69 FORMAT(1X)
C
C     LIST REFERENCED NODES
      DO 74 NXTTST=1,MAXTST
      L=1
      NOWTST=0
   70 NOWTST=NOWTST+1
      IF(KPNT(NXTTST).EQ.L)GO TO 72
      N=2
      IF(NUMPRS(L).EQ.16)N=1
      IF(NUMPRS(L).EQ.6)N=NUMPRS(L+2)-NUMPRS(L+1)+2
      N=N+3
   71 L=L+5
      N=N-5
      IF(N.GT.0)GO TO 71
      GO TO 70
   72 WRITE(JOUT,73)NOWTST
   73 FORMAT(I4)
   74 CONTINUE
   75 WRITE(JOUT,76)
   76 FORMAT(1X)
C
C     ******************************
C     *                            *
C     *  LIST WORDS IN DICTIONARY  *
C     *                            *
C     ******************************
C
      KNTPAG=0
      IRETRN=1
      GO TO 217
   77 WRITE(ILPT,78)
   78 FORMAT(11X,'WORDS IN DICTIONARY'/1X)
      KNTLIN=KNTLIN+2
      J=0
   79 M=0
   80 I=J+1
      IF(I.GT.LMTLST)GO TO 95
      K=1
   81 IF(NUMPRS(K).EQ.3)GO TO 87
      IF(NUMPRS(K).EQ.10)GO TO 87
      IF(NUMPRS(K).EQ.13)GO TO 87
      IF(NUMPRS(K+1).NE.I)GO TO 88
      IF(NUMPRS(K+2).LE.I)GO TO 90
      J=I-1
      IF(M.EQ.0)GO TO 84
      IRETRN=2
      IF(KNTLIN.GE.LNGPAG)GO TO 217
   82 WRITE(ILPT,83)(LTRPRS(N),N=M,J)
   83 FORMAT(11X,8HNOT USED,1X,40A1)
      KNTLIN=KNTLIN+1
   84 IRETRN=3
      IF(KNTLIN.GE.LNGPAG)GO TO 217
   85 J=NUMPRS(K+2)
      WRITE(ILPT,86)I,J,(LTRPRS(K),K=I,J)
   86 FORMAT(11X,2I4,1X,40A1)
      KNTLIN=KNTLIN+1
      GO TO 79
   87 IF(NUMPRS(K+1).EQ.I)GO TO 90
      IF(NUMPRS(K+2).EQ.I)GO TO 90
   88 N=2
      IF(NUMPRS(K).EQ.6)N=NUMPRS(K+2)-NUMPRS(K+1)+2
      N=N+3
   89 K=K+5
      N=N-5
      IF(N.GT.0)GO TO 89
      IF(K.LT.LMTNMB)GO TO 81
      J=I
      IF(M.EQ.0)M=I
      GO TO 80
   90 J=I-1
      IF(M.EQ.0)GO TO 92
      IRETRN=4
      IF(KNTLIN.GE.LNGPAG)GO TO 217
   91 WRITE(ILPT,83)(LTRPRS(N),N=M,J)
      KNTLIN=KNTLIN+1
   92 IRETRN=5
      IF(KNTLIN.GE.LNGPAG)GO TO 217
   93 J=I
      WRITE(ILPT,94)I,LTRPRS(I)
   94 FORMAT(15X,1I4,1X,40A1)
      KNTLIN=KNTLIN+1
      GO TO 79
   95 CONTINUE
C
C     *********************************************
C     *                                           *
C     *  FOR EACH FUNCTION, LIST NODES AND WORDS  *
C     *                                           *
C     *********************************************
C
      IRETRN=6
      GO TO 217
   96 WRITE(ILPT,97)
   97 FORMAT(11X,'GROUPS USING FUNCTIONS AND WORDS MATCHED')
      KNTLIN=KNTLIN+1
      J=0
      I=1
   98 IF(NUMPRS(I).GT.J)J=NUMPRS(I)
      N=2
      IF(NUMPRS(I).EQ.6)N=NUMPRS(I+2)-NUMPRS(I+1)+2
      N=N+3
   99 I=I+5
      N=N-5
      IF(N.GT.0)GO TO 99
      IF(I.LT.LMTNMB)GO TO 98
      I=0
  100 I=I+1
      IF(I.GT.J)GO TO 123
      M=0
      K=0
      L=1
  101 IF(NUMPRS(L).NE.I)GO TO 103
      IF(K.GE.10)GO TO 105
  102 K=K+1
      KPNT(K)=L
  103 N=2
      IF(NUMPRS(L).EQ.6)N=NUMPRS(L+2)-NUMPRS(L+1)+2
      N=N+3
  104 L=L+5
      N=N-5
      IF(N.GT.0)GO TO 104
      IF(L.LT.LMTNMB)GO TO 101
      IF(K.EQ.0)GO TO 114
  105 IRETRN=7
      IF(M.NE.0)GO TO 106
      IF((KNTLIN+2).GE.LNGPAG)GO TO 217
      GO TO 107
  106 IF(KNTLIN.GE.LNGPAG)GO TO 217
  107 IF(M.NE.0)GO TO 111
      WRITE(ILPT,108)
  108 FORMAT(1X)
      INDEX=KPNT(1)
      GO TO 141
  109 KNTLIN=KNTLIN+2
      M=1
      WRITE(ILPT,110)I,(KPNT(N),N=1,K)
  110 FORMAT(11X,1H(,1I2,1H),10I5)
      GO TO 113
  111 WRITE(ILPT,112)(KPNT(N),N=1,K)
  112 FORMAT(15X,10I5)
  113 KNTLIN=KNTLIN+1
      K=0
      IF(L.LT.LMTNMB)GO TO 102
  114 CONTINUE
C
C     PRINT WHICH WORDS ARE REFERENCED BY THIS FUNCTION
      IF(M.EQ.0)GO TO 100
      II=0
  115 L=LMTLST+1
      K=1
  116 IF(NUMPRS(K).NE.I)GO TO 119
      IF(NUMPRS(K).EQ.3)GO TO 117
      IF(NUMPRS(K).EQ.10)GO TO 117
      IF(NUMPRS(K).EQ.13)GO TO 117
      IF(NUMPRS(K+1).GE.L)GO TO 119
      IF(NUMPRS(K+1).LE.II)GO TO 119
      L=NUMPRS(K+1)
      M=NUMPRS(K+2)
      GO TO 119
  117 IF(NUMPRS(K+1).GE.L)GO TO 118
      IF(NUMPRS(K+1).LE.II)GO TO 118
      L=NUMPRS(K+1)
      M=L
  118 IF(NUMPRS(K+2).GE.L)GO TO 119
      IF(NUMPRS(K+2).LE.II)GO TO 119
      L=NUMPRS(K+2)
      M=L
  119 N=2
      IF(NUMPRS(K).EQ.6)N=NUMPRS(K+2)-NUMPRS(K+1)+2
      N=N+3
  120 K=K+5
      N=N-5
      IF(N.GT.0)GO TO 120
      IF(K.LT.LMTNMB)GO TO 116
      IF(L.GT.LMTLST)GO TO 100
      IRETRN=8
      IF(KNTLIN.GE.LNGPAG)GO TO 217
  121 WRITE(ILPT,122)(LTRPRS(N),N=L,M)
  122 FORMAT(17X,40A1)
      KNTLIN=KNTLIN+1
      II=M
      IF(II.LT.LMTLST)GO TO 115
      GO TO 100
  123 CONTINUE
C
C     ****************************************
C     *                                      *
C     *  DESCRIBE TESTS PERFORMED BY PARSER  *
C     *                                      *
C     ****************************************
C
      IRETRN=9
      GO TO 217
  124 WRITE(ILPT,125)
  125 FORMAT(11X,'DESCRIPTION OF TEST PERFORMED',7X,'SUCCESS',
     17X,'FAILURE'//11X,'WHAT BGNLTR ENDLTR OKGOTO NOGOTO   ',
     2' WHAT OK NO    WHAT OK NO'/11X,'WHERE (SERIAL) REFERE',
     3'NCEDBY'//11X,'FUNCTION 6 HAS MANY SUCCESS TRANSFERS A',
     4'ND 1 FAILURE TRANSFER')
      IGROUP=1
      INDEX=1
      KNTLIN=KNTLIN+6
C
C     INDICATE IF THIS IS A NEW GROUP
C     ALWAYS CONSIDER TERMINAL CELL AS NEW GROUP
      ITYPE6=0
  126 ILOOP=1
  127 IF(ILOOP.EQ.1)GO TO 173
      IF(INDEX.EQ.1)GO TO 132
      IF(NUMPRS(INDEX+3).EQ.0)GO TO 129
      N=2
      IF(NUMPRS(LSTNDX).EQ.6)N=NUMPRS(LSTNDX+2)-NUMPRS(LSTNDX+1)+2
      IF(NUMPRS(LSTNDX).EQ.16)N=1
      LSTNDX=LSTNDX+3
      DO 128 J=1,N
      IF(NUMPRS(LSTNDX).EQ.INDEX)GO TO 132
      LSTNDX=LSTNDX+1
  128 CONTINUE
      IF(INDEX.LE.ITYPE6)GO TO 132
  129 IF((KNTLIN+KNTNEW+1).LE.LNGPAG)GO TO 130
      WRITE(ILPT,131)
      IRETRN=10
      GO TO 217
  130 WRITE(ILPT,131)
  131 FORMAT(11X,'------------------')
      GO TO 135
  132 IF((KNTLIN+KNTNEW+1).LE.LNGPAG)GO TO 133
      WRITE(ILPT,134)
      IRETRN=11
      GO TO 217
  133 WRITE(ILPT,134)
  134 FORMAT(1X)
  135 KNTLIN=KNTLIN+KNTNEW
C
C     TEST FOR RANGE OF FUNCTION OF TYPE 6
      IF(NUMPRS(INDEX).NE.6)GO TO 140
      N=NUMPRS(INDEX+2)-NUMPRS(INDEX+1)+1
      ITYPE6=INDEX-5
      I=NUMPRS(INDEX+2)-NUMPRS(INDEX+1)+5
  136 ITYPE6=ITYPE6+5
      I=I-5
      IF(I.GT.0)GO TO 136
      L=INDEX+3
      DO 139 J=1,N
      IF(NUMPRS(L).EQ.0)GO TO 139
      I=NUMPRS(L)
  137 IF(NUMPRS(I).EQ.1)GO TO 138
      IF(NUMPRS(I).EQ.29)GO TO 138
      GO TO 139
  138 IF(ITYPE6.EQ.(I-5))ITYPE6=I
      I=NUMPRS(I+4)
      IF(I.NE.0)GO TO 137
  139 L=L+1
  140 CONTINUE
C
C     DESCRIBE THE TEST PERFORMED
  141 IF(NUMPRS(INDEX).EQ. 1)WRITE(ILPT,142)
      IF(NUMPRS(INDEX).EQ. 2)WRITE(ILPT,143)
      IF(NUMPRS(INDEX).EQ. 3)WRITE(ILPT,144)
      IF(NUMPRS(INDEX).EQ. 4)WRITE(ILPT,145)
      IF(NUMPRS(INDEX).EQ. 5)WRITE(ILPT,146)
      IF(NUMPRS(INDEX).EQ. 6)WRITE(ILPT,147)
      IF(NUMPRS(INDEX).EQ. 7)WRITE(ILPT,148)
      IF(NUMPRS(INDEX).EQ. 8)WRITE(ILPT,149)
      IF(NUMPRS(INDEX).EQ. 9)WRITE(ILPT,150)
      IF(NUMPRS(INDEX).EQ.10)WRITE(ILPT,151)
      IF(NUMPRS(INDEX).EQ.11)WRITE(ILPT,152)
      IF(NUMPRS(INDEX).EQ.12)WRITE(ILPT,153)
      IF(NUMPRS(INDEX).EQ.13)WRITE(ILPT,154)
      IF(NUMPRS(INDEX).EQ.14)WRITE(ILPT,155)
      IF(NUMPRS(INDEX).EQ.15)WRITE(ILPT,156)
      IF(NUMPRS(INDEX).EQ.16)WRITE(ILPT,157)
      IF(NUMPRS(INDEX).EQ.17)WRITE(ILPT,158)
      IF(NUMPRS(INDEX).EQ.18)WRITE(ILPT,159)
      IF(NUMPRS(INDEX).EQ.19)WRITE(ILPT,160)
      IF(NUMPRS(INDEX).EQ.20)WRITE(ILPT,161)
      IF(NUMPRS(INDEX).EQ.21)WRITE(ILPT,162)
      IF(NUMPRS(INDEX).EQ.22)WRITE(ILPT,163)
      IF(NUMPRS(INDEX).EQ.23)WRITE(ILPT,164)
      IF(NUMPRS(INDEX).EQ.24)WRITE(ILPT,165)
      IF(NUMPRS(INDEX).EQ.25)WRITE(ILPT,166)
      IF(NUMPRS(INDEX).EQ.26)WRITE(ILPT,167)
      IF(NUMPRS(INDEX).EQ.27)WRITE(ILPT,168)
      IF(NUMPRS(INDEX).EQ.28)WRITE(ILPT,169)
      IF(NUMPRS(INDEX).EQ.29)WRITE(ILPT,170)
      IF(NUMPRS(INDEX).EQ.30)WRITE(ILPT,171)
      IF(NUMPRS(INDEX).EQ.31)WRITE(ILPT,172)
  142 FORMAT(11X,'IS THIS WORD NEXT, IF SO COPY')
  143 FORMAT(11X,'DOES NUMBER APPEAR NEXT')
  144 FORMAT(11X,'DOES 1ST CHARACTER APPEAR AS OPERATOR B',
     1'EFORE 2ND')
  145 FORMAT(11X,'REPLACE NUMBER')
  146 FORMAT(11X,'COPY THROUGH )')
  147 FORMAT(11X,'IS ANY CHARACTER IN LIST NEXT, BRANCH, ',
     1'BUT DO NOT COPY')
  148 FORMAT(11X,'COPY TEXT UP TO POINTER')
  149 FORMAT(11X,'EXIT WITHOUT PUTTING REST OF LINE IN IN',
     1'DEX')
  150 FORMAT(11X,'EXIT PUTTING REST OF LINE IN INDEX')
  151 FORMAT(11X,'DOES 1ST APPEAR AS OPERATOR BEFORE 2ND ',
     1'WHILE (=)')
  152 FORMAT(11X,'INDEX COPIED TEXT IGNORING BLANKS')
  153 FORMAT(11X,'INDEX ALL BUT LAST CHARACTER OF COPIED ',
     1'TEXT')
  154 FORMAT(11X,'DOES 1ST APPEAR OUTSIDE OPERATOR BEFORE',
     1' 2ND WHILE (=)')
  155 FORMAT(11X,'RETURN POINTERS TO START OF UNCOPIED TE',
     1'XT')
  156 FORMAT(11X,'EXCLUDE COPIED TEXT FROM INDEX')
  157 FORMAT(11X,'PUT NEXT IN TABLE OF CONTENTS WITH FAIL',
     1' FIELD AS TYPE')
  158 FORMAT(11X,'IS WORD SOMEWHERE WHILE (=) BEFORE END ',
     1'OF LINE')
  159 FORMAT(11X,'IS WORD SOMEWHERE WHILE (=) BEFORE NEXT',
     1' NON () OPERATOR')
  160 FORMAT(11X,'IS WORD SOMEWHERE WHILE (=) BEFORE NEXT',
     1' (')
  161 FORMAT(11X,'IS WORD SOMEWHERE WHILE (=) BEFORE NEXT',
     1' OPERATOR ( OR )')
  162 FORMAT(11X,'IS WORD NEXT WHILE (=) BEFORE END OF LI',
     1'NE')
  163 FORMAT(11X,'IS WORD NEXT WHILE (=) BEFORE NEXT NON ',
     1'() OPERATOR')
  164 FORMAT(11X,'IS WORD NEXT WHILE (=) BEFORE NEXT (')
  165 FORMAT(11X,'IS WORD NEXT WHILE (=) BEFORE NEXT OPER',
     1'ATOR ( OR )')
  166 FORMAT(11X,'IS THIS LINE AT START OF PROGRAM')
  167 FORMAT(11X,'THIS STATEMENT NUMBER WILL END LOOP, AD',
     1'D INDENTATION')
  168 FORMAT(11X,'ADD INDENTATION')
  169 FORMAT(11X,'REMOVE INDENTATION')
  170 FORMAT(11X,'IS THIS WORD NEXT, BUT DO NOT COPY')
  171 FORMAT(11X,'POINT BEYOND () EXPRESSION, BUT DO NOT ',
     1'COPY')
  172 FORMAT(11X,'IS POINTER AT END OF STATEMENT')
      IF(IRETRN.EQ.7)GO TO 109
C
C     GET THE ITEM ITSELF
  173 KNTNEW=2
      LINE=0
      DO 174 J=1,7
  174 LTRONE(J)=LTRNON
      IF(NUMPRS(INDEX).EQ.3)GO TO 176
      IF(NUMPRS(INDEX).EQ.10)GO TO 176
      IF(NUMPRS(INDEX).EQ.13)GO TO 176
      L=NUMPRS(INDEX+1)
      IF(L.LE.0)GO TO 177
      DO 175 J=1,7
      IF(L.GT.NUMPRS(INDEX+2))GO TO 177
      LTRONE(J)=LTRPRS(L)
  175 L=L+1
      GO TO 177
  176 J=NUMPRS(INDEX+1)
      LTRONE(1)=LTRPRS(J)
      J=NUMPRS(INDEX+2)
      LTRONE(2)=LTRPRS(J)
  177 L=INDEX
      DO 178 J=1,5
      NMBONE(J)=NUMPRS(L)
  178 L=L+1
      IN=INDEX+4
      IF(NUMPRS(IN-1).GT.0)GO TO 180
      IF(ILOOP.EQ.1)GO TO 179
      WRITE(ILPT,197)NMBONE,LTRONE
  179 KNTNEW=KNTNEW+1
      GO TO 204
C
C     GET THE DESTINATION ITEM IF SUCCESS
  180 DO 181 J=1,5
  181 LTRTWO(J)=LTRNON
      JJ=NUMPRS(IN-1)
      IF(NUMPRS(JJ).EQ.3)GO TO 183
      IF(NUMPRS(JJ).EQ.10)GO TO 183
      IF(NUMPRS(JJ).EQ.13)GO TO 183
      L=NUMPRS(JJ+1)
      IF(L.LE.0)GO TO 184
      DO 182 J=1,5
      IF(L.GT.NUMPRS(JJ+2))GO TO 184
      LTRTWO(J)=LTRPRS(L)
  182 L=L+1
      GO TO 184
  183 J=NUMPRS(JJ+1)
      LTRTWO(1)=LTRPRS(J)
      J=NUMPRS(JJ+2)
      LTRTWO(2)=LTRPRS(J)
  184 NMBTWO(1)=NUMPRS(JJ)
      NMBTWO(2)=NUMPRS(JJ+3)
      NMBTWO(3)=NUMPRS(JJ+4)
      IF(NUMPRS(INDEX).EQ.16)GO TO 186
      IF(NUMPRS(INDEX).NE.6)GO TO 185
      IF(IN.GT.(INDEX+NUMPRS(INDEX+2)-NUMPRS(INDEX+1)+4))
     1GO TO 188
  185 IF(NUMPRS(IN).GT.0)GO TO 192
      IF(IN.GT.(INDEX+4))GO TO 188
  186 IF(ILOOP.EQ.1)GO TO 187
      WRITE(ILPT,197)NMBONE,LTRONE,NMBTWO,LTRTWO
  187 KNTNEW=KNTNEW+1
      GO TO 204
  188 KM=IN-1
      IF(ILOOP.EQ.1)GO TO 191
      IF(LINE.EQ.0)WRITE(ILPT,189)INDEX,IGROUP,NUMPRS(KM),
     1NMBTWO,LTRTWO
  189 FORMAT(11X,1I4,2H (,1I3,1H),1I4,13X,1I2,2I4,1X,5A1)
      IF(LINE.NE.0)WRITE(ILPT,190)NUMPRS(KM),NMBTWO,LTRTWO
  190 FORMAT(21X,1I4,13X,1I2,2I4,1X,5A1,1X,1I2,2I4,1X,5A1)
  191 KNTNEW=KNTNEW+1
      LINE=1
      GO TO 204
C
C     GET THE DESTINATION ITEM IF FAILURE
  192 DO 193 J=1,5
  193 LTRTHR(J)=LTRNON
      JJ=NUMPRS(IN)
      IF(NUMPRS(JJ).EQ.3)GO TO 195
      IF(NUMPRS(JJ).EQ.10)GO TO 195
      IF(NUMPRS(JJ).EQ.13)GO TO 195
      L=NUMPRS(JJ+1)
      IF(L.LE.0)GO TO 196
      DO 194 J=1,5
      IF(L.GT.NUMPRS(JJ+2))GO TO 196
      LTRTHR(J)=LTRPRS(L)
  194 L=L+1
      GO TO 196
  195 J=NUMPRS(JJ+1)
      LTRTHR(1)=LTRPRS(J)
      J=NUMPRS(JJ+2)
      LTRTHR(2)=LTRPRS(J)
  196 NMBTHR(1)=NUMPRS(JJ)
      NMBTHR(2)=NUMPRS(JJ+3)
      NMBTHR(3)=NUMPRS(JJ+4)
      IF(IN.GT.(INDEX+4))GO TO 199
      IF(ILOOP.EQ.1)GO TO 198
      WRITE(ILPT,197)NMBONE,LTRONE,NMBTWO,LTRTWO,NMBTHR,
     1LTRTHR
  197 FORMAT(11X,1I2,4I4,1X,7A1,1X,1I2,2I4,1X,5A1,
     11X,1I2,2I4,1X,5A1)
  198 KNTNEW=KNTNEW+1
      GO TO 203
  199 KM=IN-1
      IF(ILOOP.EQ.1)GO TO 202
      IF(LINE.EQ.0)WRITE(ILPT,200)INDEX,IGROUP,NUMPRS(KM),
     1NUMPRS(IN),NMBTWO,LTRTWO,NMBTHR,LTRTHR
  200 FORMAT(11X,1I4,2H (,1I3,1H),2I4,9X,1I2,2I4,1X,5A1,
     11X,1I2,2I4,1X,5A1)
      IF(LINE.NE.0)WRITE(ILPT,201)NUMPRS(KM),NUMPRS(IN),NMBTWO,
     1LTRTWO,NMBTHR,LTRTHR
  201 FORMAT(21X,2I4,9X,1I2,2I4,1X,5A1,1X,1I2,2I4,1X,5A1)
  202 LINE=1
      KNTNEW=KNTNEW+1
  203 IF(NUMPRS(INDEX).NE.6)GO TO 204
      IF(IN.GE.(INDEX+NUMPRS(INDEX+2)-NUMPRS(INDEX+1)+4))
     1GO TO 204
      IN=IN+2
      IF(NUMPRS(IN-1).GT.0)GO TO 180
C
C     PRINT THE LIST OF GROUPS WHICH CALL THIS GROUP
  204 IK=0
      IL=1
  205 N=2
      IF(NUMPRS(IL).EQ.16)N=1
      IF(NUMPRS(IL).EQ.6)N=NUMPRS(IL+2)-NUMPRS(IL+1)+2
      L=IL+3
      DO 206 J=1,N
      IF(NUMPRS(L).NE.INDEX)GO TO 206
      IK=IK+1
      KPNT(IK)=IL
  206 L=L+1
      N=N+3
  207 IL=IL+5
      N=N-5
      IF(N.GT.0)GO TO 207
      IF(IL.LT.LMTNMB)GO TO 205
      IF(IK.EQ.0)GO TO 211
      IM=IK
      IF(IM.GT.12)IM=12
      IF(ILOOP.EQ.1)GO TO 210
      IF(LINE.EQ.0)WRITE(ILPT,208)INDEX,IGROUP,
     1(KPNT(IL),IL=1,IM)
  208 FORMAT(11X,1I4,2H (,1I3,1H),12I4)
      IF(LINE.NE.0)WRITE(ILPT,209)(KPNT(IL),IL=1,IM)
      IF(IK.GT.12)WRITE(ILPT,209)(KPNT(IL),IL=13,IK)
  209 FORMAT(21X,12I4)
  210 KNTNEW=KNTNEW+(IK+11)/12
      GO TO 215
  211 IF(ILOOP.EQ.1)GO TO 214
      IF(LINE.EQ.0)WRITE(ILPT,212)INDEX,IGROUP
  212 FORMAT(11X,1I4,2H (,1I3,1H),23H *** NOT REFERENCED ***)
      IF(LINE.NE.0)WRITE(ILPT,213)
  213 FORMAT(21X,23H *** NOT REFERENCED ***)
  214 KNTLIN=KNTLIN+1
  215 ILOOP=ILOOP+1
      IF(ILOOP.EQ.2)GO TO 127
      IGROUP=IGROUP+1
      N=2
      IF(NUMPRS(INDEX).EQ.6)N=NUMPRS(INDEX+2)-NUMPRS(INDEX+1)+2
      N=N+3
      LSTNDX=INDEX
  216 INDEX=INDEX+5
      N=N-5
      IF(N.GT.0)GO TO 216
      IF(INDEX.LT.LMTNMB)GO TO 126
      GO TO 219
C
C     PAGE HEADING
  217 KNTPAG=KNTPAG+1
      WRITE(ILPT,218)KNTPAG
  218 FORMAT('1',10X,'RENBR PARSER',41X,'PAGE',1I3/1X)
      KNTLIN=2
      GO TO(77,82,85,91,93,96,107,121,124,130,
     1      133)IRETRN
C
C     ALL DONE
  219 RETURN
      END
      SUBROUTINE DASAVE(IPART ,IFORMT,MAXCLM,MAXLIN,IDATA ,
     1    KNTDAT,LETTER,KNTLTR,NAME  ,KNTNAM,IOUT  ,IERR  )
C     RENBR(/INTEGER AND 1H DATA STATEMENT GENERATOR)
C
C     DONALD BARTH, CHEM. DEPT., HARVARD UNIVERSITY
C     JUL 14, 1970
C
C     IPART  = -1,  CONSTRUCT  DIMENSION  AND   EQUIVALENCE
C              STATEMENTS BUT NOT DATA STATEMENTS
C            = 0, CONSTRUCT DIMENSION, EQUIVALENCE AND DATA
C              STATEMENTS
C            = 1, CONSTRUCT DIMENSION STATEMENTS ONLY
C            = 2, CONSTRUCT EQUIVALENCE STATEMENTS ONLY
C            = 3, CONSTRUCT DATA STATEMENTS ONLY
C            = -4, -3 OR -2, IDENTICAL TO IPART=-1, 0 OR  1
C              RESPECTIVELY,    EXCEPT    THAT    DIMENSION
C              STATEMENTS SPECIFY COMPONENT ARRAYS NECESARY
C              TO   CONSTRUCT  ORGINAL  ARRAY  BUT  DO  NOT
C              INCLUDE  NAME  AND  DIMENSION  OF   ORIGINAL
C              ARRAY.
C     IFORMT = -1, REPRESENT  CHARACTERS  IN  LETTER  ARRAY
C              WHICH WERE DEFINED BY 1H FIELDS OR READ WITH
C              A1 FORMATS
C            = 0, REPRESENT  INTEGERS  IN  IDATA  ARRAY  IN
C              COMPACT FORM
C            = 1 OR GREATER, REPRESENT  INTEGERS  IN  IDATA
C              ARRAY  IN  COLUMNS WHICH ARE AT LEAST IFORMT
C              CHARACTERS WIDE (IFORMT=10 IS EQUIVALENT  TO
C              I10 FORMAT)
C     MAXCLM = NUMBER OF  CHARACTERS  TO  BE  IN  STATEMENT
C              FIELD  (66  IF  MAXIMUM,  IE 72 MINUS LEFT 6
C              COLUMNS)
C     MAXLIN = MAXIMUM NUMBER OF LINES FOR SINGLE STATEMENT
C     IDATA  = ARRAY OF INTEGERS TO BE REPRESENTED IN  DATA
C              STATEMENTS IF IFORMT IS ZERO OR GREATER
C     KNTDAT = NUMBER OF LOCATIONS IN  IDATA  ARRAY  TO  BE
C              REPRESENTED IN DATA STATEMENTS
C     LETTER = ARRAY OF CHARACTERS READ WITH A1  FORMAT  OR
C              DEFINED USING 1H FIELDS TO BE REPRESENTED IN
C              DATA STATEMENTS IF IFORMT HAS VALUE -1
C     KNTLTR = NUMBER OF LOCATIONS IN LETTER  ARRAY  TO  BE
C              REPRESENTED IN DATA STATEMENTS
C     NAME   = ALPHAMERIC ARRAY CONTAINING  NAME  OF  ARRAY
C              (READ BY MULTIPLE OF A1 FORMAT)
C     KNTNAM = NUMBER OF LETTERS IN NAME OF ARRAY
C     IOUT   = OUTPUT UNIT ON WHICH STATEMENT IS WRITTEN
C     IERR   = 0 RETURNED IF COULD GENERATE DATA STATEMENT
C            = 1 RETURNED IF MAXCLM TOO SMALL
C            = 2 RETURNED IF ISTORE ARRAY TOO SMALL
C
      DIMENSION IDATA(KNTDAT),LETTER(KNTLTR),NAME(KNTNAM),
     1IBUFFR(66),ISTORE(200)
      DATA IBLANK,ISLASH,KOMMA,ILPR,IRPR,IONE,IHOLLR/
     11H ,1H/,1H,,1H(,1H),1H1,1HH/
C
C     JSTORE = DIMENSION OF ISTORE ARRAY.  THIS IS THE
C              MAXIMUM NUMBER OF SMALL ARRAYS WHICH CAN
C              BE USED TO REPRESENT THE IDATA ARRAY.
C
      DATA JSTORE/200/
C
      JPART=IPART
      IF(JPART.LT.-1)JPART=JPART+3
      IERR=0
      IF(IFORMT)1,2,2
    1 NEEDED=KNTLTR
      GO TO 3
    2 NEEDED=KNTDAT
    3 IF(NEEDED)113,113,4
    4 LOCK=1
      MOST=0
      MAX1=MAXCLM-1
      MAX2=MAXCLM-2
      LEFT=0
      CALL DANUMB(0,NEEDED,10,IBUFFR,LEFT,0,MAXCLM)
      LENGTH=KNTNAM+LEFT
      IF(LENGTH-6)6,6,5
    5 LENGTH=6
    6 IF(IFORMT)12,81,7
C
C     PREPARE FOR EXPANDED FORMAT
    7 MOST=IDATA(1)
      LEAST=MOST
      DO 8 INDEX=1,NEEDED
      IF(LEAST.GT.IDATA(INDEX))LEAST=IDATA(INDEX)
      IF(MOST.LT.IDATA(INDEX))MOST=IDATA(INDEX)
    8 CONTINUE
      KOUNT=0
      CALL DANUMB(0,MOST,10,IBUFFR,KOUNT,0,MAXCLM)
      MOST=KOUNT
      KOUNT=0
      CALL DANUMB(0,LEAST,10,IBUFFR,KOUNT,0,MAXCLM)
      IF(MOST-KOUNT)9,10,10
    9 MOST=KOUNT
   10 IF(MOST-IFORMT)11,13,13
   11 MOST=IFORMT
      GO TO 13
   12 MOST=3
   13 LIMIT=MAXLIN*((MAXCLM-LENGTH-6)/(MOST+1))
      IF(LIMIT)112,112,14
   14 KNTPRT=1+((NEEDED-1)/LIMIT)
      IF(KNTPRT-JSTORE)15,15,111
   15 LEAST=1
      DO 16 INDEX=1,KNTPRT
      ISTORE(INDEX)=LEAST
   16 LEAST=LEAST+LIMIT
C
C     TEST IF LABELS ARE OF MINIMUM LENGTH
   17 ITEST=0
      CALL DANUMB(0,ISTORE(KNTPRT),10,IBUFFR,ITEST,0,
     1MAXCLM)
      IF(KNTNAM+ITEST-LENGTH)18,19,19
   18 LENGTH=KNTNAM+ITEST
      IF(IFORMT)13,81,13
   19 LOCK=0
      IF(IFORMT)21,20,21
   20 LEFT=0
      ITEST=0
C
C     CONSTRUCT SINGLE LINE OF DIMENSION STATEMENT
   21 IF(JPART-2)22,59,81
   22 INDEX=0
      DO 23 LEAST=1,10
   23 IBUFFR(LEAST)=IBLANK
   24 LINE=1
      LAST=INDEX
   25 KOUNT=10
   26 IF(INDEX)27,27,39
C
C     INSERT NAME OF MAIN ARRAY
   27 IF(IFORMT)28,29,28
   28 LIMIT=-LENGTH
      GO TO 30
   29 LIMIT=0
   30 LEAST=KOUNT
      CALL DABOTH(LIMIT,LEFT,NAME,KNTNAM,0,NEEDED,IBUFFR,
     1KOUNT,MAX1)
C
C     OUTPUT COMMENT LINE DESCRIBING DIMENSION
      IF(IPART+1)31,38,38
   31 IF(LINE-1)32,32,35
   32 IF(KOUNT-10)33,33,34
   33 WRITE(IOUT,120)
      GO TO 52
   34 WRITE(IOUT,120)(IBUFFR(LEAST),LEAST=11,KOUNT)
      GO TO 37
   35 IF(KOUNT-LEAST)112,112,36
   36 WRITE(IOUT,121)MANY,(IBUFFR(LEAST),LEAST=1,KOUNT)
   37 INDEX=1
      GO TO 24
C
C     INSERT NAME OF SMALL ARRAY
   38 IF(KOUNT-LEAST)46,46,43
   39 IF(INDEX-KNTPRT)41,40,40
   40 LIMIT=NEEDED-ISTORE(INDEX)+1
      GO TO 42
   41 LIMIT=ISTORE(INDEX+1)-ISTORE(INDEX)
   42 LEAST=KOUNT
      CALL DABOTH(LENGTH,LEFT,NAME,KNTNAM,ISTORE(INDEX),
     1LIMIT,IBUFFR,KOUNT,MAX1)
      IF(KOUNT-LEAST)44,44,43
   43 INDEX=INDEX+1
      KOUNT=KOUNT+1
      IBUFFR(KOUNT)=KOMMA
      IF(INDEX-KNTPRT)26,26,45
C
C     OUTPUT SINGLE LINE OF DIMENSION STATEMENT
   44 IF(LINE-MAXLIN)46,45,45
   45 KOUNT=KOUNT-1
   46 IF(LINE-1)47,47,50
   47 IF(KOUNT-10)48,48,49
   48 WRITE(IOUT,116)
      GO TO 52
   49 WRITE(IOUT,116)(IBUFFR(LEAST),LEAST=11,KOUNT)
      GO TO 52
   50 IF(KOUNT)112,112,51
   51 WRITE(IOUT,119)MANY,(IBUFFR(LEAST),LEAST=1,KOUNT)
      MANY=MANY+1
      IF(MANY-9)53,53,52
   52 MANY=1
   53 IF(INDEX-KNTPRT)54,54,58
   54 IF(LINE-MAXLIN)56,55,55
   55 IF(INDEX-LAST)112,112,24
   56 LINE=LINE+1
      IF(IFORMT)25,57,25
   57 KOUNT=0
      GO TO 26
C
C     CONSTRUCT SINGLE LINE OF EQUIVALENCE STATEMENT
   58 IF(JPART)59,59,113
   59 INDEX=1
      DO 60 LEAST=1,12
   60 IBUFFR(LEAST)=IBLANK
   61 LINE=1
      LAST=INDEX
   62 KOUNT=12
C
C     INSERT NAME OF SMALL ARRAY
   63 KOUNT=KOUNT+1
      LEAST=KOUNT
      CALL DABOTH(LENGTH,0,NAME,KNTNAM,ISTORE(INDEX),1,
     1IBUFFR,KOUNT,MAX2)
      IF(KOUNT-LEAST)66,66,64
C
C     INSERT NAME OF MAIN ARRAY
   64 KOUNT=KOUNT+1
      LIMIT=KOUNT
      CALL DABOTH(0,ITEST,NAME,KNTNAM,0,ISTORE(INDEX),
     1IBUFFR,KOUNT,MAX2)
      IF(KOUNT-LIMIT)66,66,65
   65 IBUFFR(LEAST)=ILPR
      IBUFFR(LIMIT)=KOMMA
      KOUNT=KOUNT+1
      IBUFFR(KOUNT)=IRPR
      KOUNT=KOUNT+1
      IBUFFR(KOUNT)=KOMMA
      INDEX=INDEX+1
      IF(INDEX-KNTPRT)63,63,67
C
C     OUTPUT SINGLE LINE OF EQUIVALENCE STATEMENT
   66 KOUNT=LEAST-1
      IF(LINE-MAXLIN)68,67,67
   67 KOUNT=KOUNT-1
   68 IF(LINE-1)69,69,72
   69 IF(KOUNT-12)70,70,71
   70 WRITE(IOUT,117)
      GO TO 74
   71 WRITE(IOUT,117)(IBUFFR(LEAST),LEAST=13,KOUNT)
      GO TO 74
   72 IF(KOUNT)112,112,73
   73 WRITE(IOUT,119)MANY,(IBUFFR(LEAST),LEAST=1,KOUNT)
      MANY=MANY+1
      IF(MANY-9)75,75,74
   74 MANY=1
   75 IF(INDEX-KNTPRT)76,76,80
   76 IF(LINE-MAXLIN)78,77,77
   77 IF(INDEX-LAST)112,112,61
   78 LINE=LINE+1
      IF(IFORMT)62,79,62
   79 KOUNT=0
      GO TO 63
C
C     CONSTRUCT SINGLE LINE OF DATA STATEMENT
   80 IF(JPART)113,81,113
   81 INDEX=1
      KNTPRT=0
   82 LINE=1
      LAST=INDEX+1
      KOUNT=5
   83 LIMIT=KOUNT+MOST
   84 LEAST=KOUNT
      IF(LAST-INDEX)88,88,85
C
C     INSERT NAME OF SMALL ARRAY
   85 CALL DABOTH(LENGTH,-1,NAME,KNTNAM,INDEX,0,IBUFFR,
     1KOUNT,MAX1)
      IF(KOUNT-LEAST)97,97,86
   86 LAST=INDEX
      KOUNT=KOUNT+1
      IBUFFR(KOUNT)=ISLASH
      IF(KNTPRT-JSTORE)87,111,111
   87 KNTPRT=KNTPRT+1
      ISTORE(KNTPRT)=INDEX
      GO TO 83
C
C     INSERT INTEGER ENTRY
   88 IF(IFORMT)90,89,89
   89 CALL DANUMB(IFORMT,IDATA(INDEX),10,IBUFFR,KOUNT,
     1LIMIT,MAX1)
      IF(KOUNT-LEAST)95,95,94
      GO TO 94
   90 IF(LIMIT-MAX1)91,91,95
   91 IF(KOUNT-(LIMIT-3))92,93,93
   92 KOUNT=KOUNT+1
      IBUFFR(KOUNT)=IBLANK
      GO TO 91
   93 KOUNT=KOUNT+3
      IBUFFR(KOUNT-2)=IONE
      IBUFFR(KOUNT-1)=IHOLLR
      IBUFFR(KOUNT)=LETTER(INDEX)
   94 KOUNT=KOUNT+1
      IBUFFR(KOUNT)=KOMMA
      INDEX=INDEX+1
      IF(INDEX-NEEDED)83,83,96
C
C     OUTPUT SINGLE LINE OF DATA STATEMENT
   95 IF(LINE-MAXLIN)97,96,96
   96 IBUFFR(KOUNT)=ISLASH
   97 IF(LOCK)98,98,105
   98 IF(LINE-1)99,99,102
   99 IF(KOUNT-5)100,100,101
  100 WRITE(IOUT,118)
      GO TO 104
  101 WRITE(IOUT,118)(IBUFFR(LEAST),LEAST=6,KOUNT)
      GO TO 104
  102 IF(KOUNT)112,112,103
  103 WRITE(IOUT,119)MANY,(IBUFFR(LEAST),LEAST=1,KOUNT)
      MANY=MANY+1
      IF(MANY-9)105,105,104
  104 MANY=1
  105 IF(INDEX-NEEDED)106,106,110
  106 IF(LINE-MAXLIN)108,107,107
  107 IF(INDEX-LAST)112,112,82
  108 LINE=LINE+1
      KOUNT=0
      IF(IFORMT)109,83,109
  109 LIMIT=6+LENGTH+MOST
      GO TO 84
  110 IF(LOCK)113,113,17
C
C     RETURN TO CALLING PROGRAM
  111 WRITE(IOUT,114)JSTORE
      IERR=2
      GO TO 113
  112 WRITE(IOUT,115)MAXCLM
      IERR=1
  113 RETURN
  114 FORMAT(19H DASAVE - MORE THAN,1I4,11H STATEMENTS)
  115 FORMAT(21H DASAVE - FIELD WIDTH,1I3,10H TOO SHORT)
  116 FORMAT(6X,10HDIMENSION ,66A1)
  117 FORMAT(6X,12HEQUIVALENCE ,66A1)
  118 FORMAT(6X,5HDATA ,61A1)
  119 FORMAT(5X,1I1,66A1)
  120 FORMAT(1HC,5X,10HDIMENSION ,66A1)
  121 FORMAT(1HC,4X,1I1,66A1)
      END
      SUBROUTINE DANUMB(KONTRL,NUMBER,IRADIX,LETTER,
     1KOUNT,LFTCOL,MAX)
C     RENBR(/REPRESENT INTEGER VALUE)
C
C     DONALD BARTH, CHEM. DEPT., HARVARD UNIVERSITY
C     JAN 2, 1970
C
C     KONTRL = 0 LEFT JUSTIFIES AT LFTCOL OR AT KOUNT+1
C              IF KOUNT IS GREATER THAN LFTCOL.
C     KONTRL = 1 RIGHT JUSTIFIES AT LFTCOL.
C     NUMBER = NUMBER TO BE INSERTED.
C     IRADIX = BASE TO WHICH NUMBER WILL BE EXPRESSED.
C     LETTER = ALPHAMERIC BUFFER ARRAY TO BE CODED.
C     KOUNT  = NUMBER OF LOCATIONS IN LETTER IN USE.
C     LFTCOL = LOCATION OF NEW NUMBER.
C     LFTCOL = CHARACTERS LEFT OF NUMBER IF KONTRL = 0.
C     LFTCOL = POSITION OF RIGHT DIGIT IF KONTRL = 1.
C     MAX    = DIMENSION OF LETTER ARRAY.
C
C     THE ONLY ARGUMENTS RETURNED CHANGED ARE THE
C     LETTER ARRAY WHICH IS RETURNED WITH THE NEW NUMBER
C     REPRESENTED AT ITS RIGHT END, AND KOUNT WHICH IS
C     RETURNED CONTAINING THE NUMBER OF CHARACTERS IN THE
C     LETTER ARRAY.
C
      DIMENSION LETTER(MAX),IDGT(10)
      DATA IDGT/1H0,1H1,1H2,1H3,1H4,1H5,1H6,1H7,1H8,1H9/
      DATA IBLANK,IMINUS/1H ,1H-/
C
C     EVEN UP RIGHT MARGIN IF NEEDED
      KSAVE=KOUNT
      KOLLFT=LFTCOL
      IF(KOLLFT-MAX)1,1,26
    1 IF(KOUNT-MAX)2,26,26
    2 IF(KONTRL)26,4,3
    3 IF(KOUNT-KOLLFT)6,26,26
    4 IF(KOUNT-KOLLFT)5,6,5
    5 KOUNT=KOUNT+1
      LETTER(KOUNT)=IBLANK
      IF(KOUNT-KOLLFT)5,6,6
C
C     SET INITIAL POINTERS
    6 KNT=0
      KEEP=KOUNT+1
      IF(NUMBER)8,7,7
C
C     POSITIVE NUMBER
    7 NUMB=NUMBER
      IF(KOUNT-MAX)12,25,25
C
C     NEGATIVE NUMBER
    8 IF(KEEP-MAX)9,25,25
    9 KOUNT=KOUNT+1
      LETTER(KOUNT)=IMINUS
C     ABSOLUTE VALUE OF A NEGATIVE NUMBER IS DECREMENTED
C     BY ONE SINCE, ON A TWO'S COMPLEMENT COMPUTER, THE
C     ABSOLUTE VALUE OF THE LARGEST NEGATIVE NUMBER (SIGN
C     BIT ON AND ALL OTHER BITS OFF) CANNOT BE REPRESENTED.
C     THIS NUMBER CAN BE EASILY OBTAINED IF SIGN BIT IS
C     USED FOR STORING INFORMATION IN SETS.
      INDEX=NUMBER+1
      NUMB=-INDEX
      GO TO 12
C
C     INSERT DIGITS OF NUMBER
   10 INDEX=KOUNT+KNT
   11 LETTER(INDEX+1)=LETTER(INDEX)
      INDEX=INDEX-1
      IF(INDEX-KOUNT)26,12,11
   12 KNT=KNT+1
      INDEX=NUMB
      NUMB=NUMB/IRADIX
      INDEX=INDEX-IRADIX*NUMB
      IF(NUMBER)13,16,16
   13 IF(KNT-1)26,14,16
   14 INDEX=INDEX+1
      IF(INDEX-IRADIX)16,15,26
   15 INDEX=0
      NUMB=NUMB+1
   16 LETTER(KOUNT+1)=IDGT(INDEX+1)
      IF(NUMB)26,18,17
   17 IF(KNT+KOUNT-MAX)10,25,25
   18 KOUNT=KOUNT+KNT
C
C     EVEN UP LEFT MARGIN IF NEEDED
      IF(KONTRL)26,26,19
   19 IF(KOUNT-KOLLFT)20,26,23
C
C     ADD BLANKS TO LEFT MARGIN
   20 DO 21 KNT=KEEP,KOUNT
      INDEX=KOLLFT-KNT+KEEP
      NUMB=KOUNT-KNT+KEEP
   21 LETTER(INDEX)=LETTER(NUMB)
      INDEX=KOLLFT-KOUNT+KEEP-1
      DO 22 KNT=KEEP,INDEX
   22 LETTER(KNT)=IBLANK
      KOUNT=KOLLFT
      GO TO 26
C
C     REMOVE EXCESS DIGITS FROM LEFT MARGIN
   23 DO 24 KNT=KEEP,KOLLFT
      INDEX=KNT+KOUNT-KOLLFT
   24 LETTER(KNT)=LETTER(INDEX)
      KOUNT=KOLLFT
      GO TO 26
   25 KOUNT=KSAVE
   26 RETURN
C     KEEP   = SUBSCRIPT AT WHICH INSERT 1ST CHARACTER.
C     KNT    = NUMBER OF DIGITS ADDED TO ARRAY.
C     KSAVE  = NUMBER OF CHARACTERS IN ORIGINAL ARRAY.
C     NUMB   = ABSOLUTE VALUE OF UNUSED PART OF NUMBER.
      END
      SUBROUTINE DABOTH(INDEX,IFORMT,NAME,KNTLTR,NUMBER,
     1IVALUE,LETTER,KOUNT,MAX)
C
C     ROUTINE TO CREATE ARRAY NAMES WITH DIMENSION NUMBERS
C
C     DONALD BARTH, CHEM. DEPT., HARVARD UNIVERSITY
C
C     INDEX  = NEGATIVE OR 0, A SYMBOL CONTAINING AT LEAST
C              -INDEX CHARACTERS IS PRODUCED IN LETTER
C              ARRAY BY COPYING LOCATIONS 1 THRU KNTLTR OF
C              NAME ARRAY AND INSERTING RIGHT BLANKS IF
C              NECESSARY.
C            = 1 OR GREATER, IS LENGTH OF SYMBOL TO BE
C              OUTPUT IN LETTER ARRAY BY RIGHT JUSTIFYING
C              DIGITS OF NUMBER AND MAKING LEFT CHARACTERS
C              BE THOSE IN NAME ARRAY OR THE LETTER ZERO.
C     IFORMT = -1, NO NUMBER IS GIVEN ENCLOSED IN
C              PARENTHESES.
C            = 0, IVALUE IS REPRESENTED ENCLOSED IN
C              PARENTHESES TO RIGHT OF SYMBOL.
C            = 1 OR GREATER, IVALUE IS REPRESENTED RIGHT
C              JUSTIFIED IN A FIELD OF IFORMT LOCATIONS AND
C              ENCLOSED IN PARENTHESES TO RIGHT OF SYMBOL.
C     NAME   = ALPHAMERIC ARRAY READ BY MULTIPLE OF A1
C              FORMAT AND CONTAINING LETTERS OF SYMBOL.
C     KNTLTR = NUMBER OF SYMBOL CHARACTERS IN NAME ARRAY.
C     NUMBER = NUMBER TO BECOME PART OF SYMBOL IF INDEX=1
C              OR GREATER.
C     IVALUE = NUMBER TO FOLLOW SYMBOL IF IFORMT=1 OR
C              GREATER.
C     LETTER = ARRAY TO RECEIVE SYMBOL.
C     KOUNT  = NUMBER OF LOCATIONS OF LETTER ARRAY IN USE.
C     MAX    = MAXIMUM NUMBER OF LOCATIONS IN LETTER WHICH
C              CAN BE FILLED.
C
      DIMENSION LETTER(MAX),NAME(KNTLTR)
      DATA IBLANK,IZERO,ILPR,IRPR/1H ,1H0,1H(,1H)/
C
C     COPY SYMBOL WITHOUT RIGHT JUSTIFIED NUMBER
      INIT=KOUNT
      IF(INDEX)1,1,8
    1 IF(KOUNT+KNTLTR-MAX)2,2,17
    2 KOLUMN=0
    3 IF(KOLUMN-KNTLTR)4,5,5
    4 KOUNT=KOUNT+1
      KOLUMN=KOLUMN+1
      LETTER(KOUNT)=NAME(KOLUMN)
      GO TO 3
    5 IF(KOUNT-INDEX-KNTLTR-MAX)7,7,15
    6 KOUNT=KOUNT+1
      KOLUMN=KOLUMN+1
      LETTER(KOUNT)=IBLANK
    7 IF(KOLUMN+INDEX)6,13,13
C
C     COPY SYMBOL WITH RIGHT JUSTIFIED NUMBER
    8 KOLUMN=KOUNT+INDEX
      IF(KOLUMN-MAX)9,9,17
    9 LONG=KOUNT
      CALL DANUMB(1,NUMBER,10,LETTER,KOUNT,KOLUMN,MAX)
      KOLUMN=0
   10 LONG=LONG+1
      IF(LETTER(LONG).NE.IBLANK)GO TO 13
      IF(KOLUMN-KNTLTR)12,11,11
   11 LETTER(LONG)=IZERO
      GO TO 10
   12 KOLUMN=KOLUMN+1
      LETTER(LONG)=NAME(KOLUMN)
      GO TO 10
C
C     INSERT NUMBER ENCLOSED IN PARENTHESES
   13 IF(IFORMT)17,14,14
   14 KOLUMN=KOUNT+IFORMT+1
      CALL DANUMB(IFORMT,IVALUE,10,LETTER,KOUNT,KOLUMN,
     1MAX-1)
      IF(KOUNT-KOLUMN)15,16,16
   15 KOUNT=INIT
      GO TO 17
   16 KOLUMN=KOLUMN-IFORMT
      LETTER(KOLUMN)=ILPR
      KOUNT=KOUNT+1
      LETTER(KOUNT)=IRPR
C
C     RETURN TO CALLING PROGRAM
   17 RETURN
      END
      SUBROUTINE DASWAP(IARRAY,LOW,MID,MAX)
C
C     DONALD BARTH, CHEMISTRY DEPT., HARVARD UNIVERSITY
C
C     ROUTINE TO SWAP ADJACENT SECTIONS OF SINGLE ARRAY
C
C     IARRAY = ARRAY CONTAINING SECTIONS TO BE SWAPPED
C     LOW    = SUBSCRIPT OF LOWEST LOCATION IN LOW SECTION
C     MID    = SUBSCRIPT OF HIGHEST LOCATION IN LOW SECTION
C     MAX    = SUBSCRIPT OF HIGHEST LOCATION IN HIGH
C              SECTION
C
C     SWAP IS PERFORMED BY MOVING VALUES DIRECTLY TO
C     LOCATIONS THEY ARE TO OCCUPY IN THE RESULT.
C
C     FOR EXAMPLE, TO SWAP ABCD AND 123 IN THE
C     FOLLOWING EXAMPLE, 3 IS MOVED TO LOCATION HOLDING C
C     WHICH IS MOVED TO LOCATION HOLDING 2 AND SO ON.
C
C     A  B  C  D  1  2  3
C     .  .  I-----------I
C     .  .  I--------I  .
C     .  I-----------I  .
C     .  I--------I  .  .
C     I-----------I  .  .
C     I--------I  .  .  .
C     .  .  .  I--------I
C
C     IARRAY ARRAY AND NEW AND KEEP VARIABLES SHOULD BE
C     MADE FLOATING POINT TO SWAP A FLOATING POINT ARRAY.
C
      DIMENSION IARRAY(MAX)
      IF(LOW.GT.MID)GO TO 5
      IF(MID.GE.MAX)GO TO 5
      KOUNT=LOW-MAX-1
      LAST=MAX
      LONGLO=LOW-MID-1
      LONGHI=MAX-MID
    1 INDEX=LAST+LONGLO
      KEEP=IARRAY(LAST)
    2 KOUNT=KOUNT+1
      NEW=IARRAY(INDEX)
      IARRAY(INDEX)=KEEP
      KEEP=NEW
      IF(INDEX.GT.MID)GO TO 3
      INDEX=INDEX+LONGHI
      GO TO 2
    3 IF(INDEX.EQ.LAST)GO TO 4
      INDEX=INDEX+LONGLO
      GO TO 2
    4 IF(KOUNT.EQ.0)GO TO 5
      LAST=LAST-1
      GO TO 1
    5 RETURN
C107401072377
      END