Google
 

Trailing-Edge - PDP-10 Archives - decus_20tap2_198111 - decus/20-0034/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 ,IHIHDO,
     2IIN   ,ILEVEL,ILPT  ,INCR  ,INCSAV,INDENT,INITOC,
     3INRCPY,INRFND,INIOPR,IOUT  ,IPAGE ,IPASS ,ISPACE,
     4ISPLIT,ISPR  ,ISTART,ISTN  ,ITAB  ,ITBL  ,ITITLE,
     5ITTY  ,J     ,JBGN  ,JBREAK,JEND  ,JEOF  ,JFORM ,
     6JIN   ,JIN1  ,JLEVEL,JMPBGN,JMPEND,JOUT  ,JPASS ,
     7JSPLIT,JSTN  ,JTAB  ,JTTY  ,K     ,KLEVEL,KNDGRP,
     8KNT   ,MAXPRT,KNTONE,KNTPNT,KNTSPL,KNTTOC,KNTTWO,
     9KOMENT,KOMKNT,KOMNUM,KONTRL,KOUNT ,KPAGE
      COMMON/RNBTWO/MASTER,KPYEND,KSTN  ,KTAB  ,KUTNUM,
     1KUTPNT,KUTSPL,L     ,LCLNUM,LCLPNT,LCLSPL,LEFT  ,
     2LIKE  ,LMTTOC,LOW1  ,LOW2  ,LOWDO ,LOWER ,
     3LPTTTY,LRGSPL,LRGNUM,LRGPNT,LRGTOC,LSTKNT,LSTN  ,
     4LSTSTN,LTAB  ,M     ,MANY  ,MAXEND,MAXLIN,MAXPNT,
     5MAXSPL,MAXTOC,MID   ,MOST  ,MOVE  ,MSTN  ,MTAB  ,
     6N     ,NCD   ,NEED  ,NEWNUM,NEWSTN,NONFOR,
     7NSTN  ,NUM   ,LOWTOC,NXTLST,IPOINT,JPOINT,NXTEND,
     8KEND  ,NTAB  ,IFREAR,KPOINT,KBGN  ,LEND  ,LNGNAM,
     9LOWSHO,ININAM,JTBL  ,NOWTOC,LPOINT,INIPRT,JOBNUM
      COMMON/RNBTHR/MODBAS,MODINC,MODMAX,MODMIN,MODNEW,
     1MODOLD,KMDMIN,KMDMAX,ITRACE,LNGCOM,LNGNXT,KPASS
      COMMON/RNBFOU/INRSTR(21)  ,JPNT  (10)  ,MCHOPR(50)  ,
     1 NNEW  (1000),NOLD  (1000),NOTOPR(50)  ,NUMPNT(5000),
     2 NUMPRS(515) ,NUMTOC(112) ,NUMTYP(7)   ,LINREF(9)
      COMMON/RNBFIV/LTRCCC,LTRCLN,LTREQL,LTREXC,LTRHHH,
     1LTRLFT,LTRMNS,LTRPLS,LTRQOT,LTRRIT,LTRSEM,LTRSLA,
     2LTRSPC,LTRTAB,LWRCCC,LWRHHH,LTRNOW,LTR1ST,LTR2ND,
     3LTRREF,LTRDDD,LWRDDD,LTREEE,LWREEE,LTRDOT,LTRSTR
      COMMON/RNBSIX/LTRABC(26)  ,LTRBGN(5)   ,LTRBIG(2211),
     1 LTRDGT(10)  ,LTREND(3)   ,LTRFLG(7)   ,LTRKEY(5)   ,
     2 LTROPR(50)  ,LTRPRS(247) ,LTRSPL(2000),LTRTOC(168) ,
     3 LTRTOP(117) ,LTRTTL(5)   ,LTRTYP(55)  ,LTRUSE(6)   ,
     4 LWRABC(26)  ,LWRBGN(5)   ,LWREND(3)   ,LWRFLG(7)   ,
     5 LWRKEY(5)   ,LWRPRS(247) ,LWRTTL(5)   ,LTRNAM(10)  ,
     6 LTRSRT(26)  ,LWRSRT(26)  ,LTR120(120)
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  AND ITTY ALSO APPEAR IN THE
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     AN INPUT WHICH CONSISTED ONLY OF 2 BLANK LINES  WOULD
C     RESULT  IN  MERELY  A  LISTING OF THE CONNECTION TREE
C     REPRESENTED BY THESE TABLES.
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.
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),LTRNXT(30),ISAVE(30),LTRNM1(6),
     1LTRNM2(6),LTRNM3(6)
      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     ILPT   = UNIT NUMBER TO WHICH LISTING IS WRITTEN.
C     ITTY   = UNIT NUMBER  TO  WHICH  ERROR  MESSAGES  ARE
C              WRITTEN.
C
      DATA IIN,IOUT,ILPT,ITTY/1,20,21,5/
C
C     DETERMINE SIZE OF ARRAYS
      LMTNMB=0
      LMTLST=0
      L=1
      LMTGRP=0
    1 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 2 M=1,N
      IF(LMTNMB.LT.NUMPRS(J))LMTNMB=NUMPRS(J)
    2 J=J+1
      N=N+3
    3 L=L+5
      N=N-5
      IF(N.GT.0)GO TO 3
      IF(L.LE.LMTNMB)GO TO 1
      LMTNMB=L-1
C
C     **********************************
C     *                                *
C     *  RESTRUCTURE THE LTRPRS ARRAY  *
C     *                                *
C     **********************************
C
C     READ NEXT WORD TO BE MOVED
      NEXT=1
    4 READ(IIN,5)(LTRNXT(I),I=1,30)
    5 FORMAT(30A1)
      IF(NEXT.GT.LMTLST)GO TO 34
      LENGTH=30
    6 IF(LTRNXT(LENGTH).NE.LTRNON)GO TO 7
      LENGTH=LENGTH-1
      IF(LENGTH.GT.0)GO TO 6
      GO TO 34
C
C     LOCATE THIS WORD IN LIST OF CHARACTERS
    7 INITAL=NEXT
    8 J=1
      INDEX=INITAL
    9 IF(LTRPRS(INDEX).EQ.LTRNXT(J))GO TO 13
   10 INITAL=INITAL+1
      IF((INITAL+LENGTH-1).LE.LMTLST)GO TO 8
      WRITE(ITTY,11)(LTRNXT(I),I=1,LENGTH)
   11 FORMAT(18H WORD NOT MATCHED ,30A1)
      IF(ITTY.EQ.IIN)WRITE(ITTY,12)
   12 FORMAT(1X)
      GO TO 4
   13 IF(J.EQ.LENGTH)GO TO 14
      INDEX=INDEX+1
      J=J+1
      GO TO 9
C
C     DETERMINE IF MATCH IS LEGAL
   14 K=1
      N=0
   15 IF(NUMPRS(K).EQ.3)GO TO 16
      IF(NUMPRS(K).EQ.10)GO TO 16
      IF(NUMPRS(K).EQ.13)GO TO 16
      IF(NUMPRS(K+1).EQ.INITAL)GO TO 17
      GO TO 18
   16 IF(LENGTH.NE.1)GO TO 18
      IF(NUMPRS(K+1).EQ.INDEX)GO TO 26
   17 IF(NUMPRS(K+2).EQ.INDEX)GO TO 26
   18 IF(NUMPRS(K+1).EQ.0)GO TO 21
      IF(NUMPRS(K+2).EQ.0)GO TO 20
      IF(NUMPRS(K+1).LE.INDEX)GO TO 19
      IF(NUMPRS(K+2).GT.INDEX)GO TO 24
   19 IF(NUMPRS(K+1).GE.INITAL)GO TO 23
      GO TO 22
   20 IF(NUMPRS(K+1).GT.INDEX)GO TO 24
      IF(NUMPRS(K+1).LT.INITAL)GO TO 24
      GO TO 23
   21 IF(NUMPRS(K+2).GT.INDEX)GO TO 24
   22 IF(NUMPRS(K+2).LT.INITAL)GO TO 24
   23 N=1
   24 M=2
      IF(NUMPRS(K).EQ.6)M=NUMPRS(K+2)-NUMPRS(K+1)+2
      M=M+3
   25 K=K+5
      M=M-5
      IF(M.GT.0)GO TO 25
      IF(K.LT.LMTNMB)GO TO 15
      IF(N.NE.0)GO TO 10
C
C     CHANGE POINTERS TO CHARACTERS
   26 I=1
   27 J=I
      DO 29 K=1,2
      J=J+1
      L=NUMPRS(J)
      IF(L.LT.NEXT)GO TO 29
      IF(L.GT.INDEX)GO TO 29
      IF(L.LT.INITAL)GO TO 28
      NUMPRS(J)=NEXT+L-INITAL
      GO TO 29
   28 NUMPRS(J)=L+LENGTH
   29 CONTINUE
      M=2
      IF(NUMPRS(I).EQ.6)M=NUMPRS(I+2)-NUMPRS(I+1)+2
      M=M+3
   30 I=I+5
      M=M-5
      IF(M.GT.0)GO TO 30
      IF(I.LT.LMTNMB)GO TO 27
C
C     MOVE LETTERS UP TO MAKE ROOM FOR INSERTION
   31 IF(INITAL.LE.NEXT)GO TO 32
      INITAL=INITAL-1
      LTRPRS(INDEX)=LTRPRS(INITAL)
      INDEX=INDEX-1
      GO TO 31
C
C     INSERT LETTERS TO BE MOVED
   32 DO 33 I=1,LENGTH
      LTRPRS(NEXT)=LTRNXT(I)
   33 NEXT=NEXT+1
      GO TO 4
C
C     **********************************
C     *                                *
C     *  RESTRUCTURE THE NUMPRS ARRAY  *
C     *                                *
C     **********************************
C
   34 DO 35 I=1,LMTGRP
   35 KPNT(I)=I
      NEXT=1
      INIT=1
C
C     OBTAIN NUMBER OF NEXT GROUP TO BE MOVED
   36 READ(IIN,37)INDEX
   37 FORMAT(I)
      IF(INDEX.LE.0)GO TO 55
      IF(INDEX.LE.LMTGRP)GO TO 39
      WRITE(ITTY,38)INDEX
   38 FORMAT(13H NUMPRS GROUP,1I5,10H TOO LARGE)
      IF(ITTY.EQ.IIN)WRITE(ITTY,12)
      GO TO 36
C
C     DETERMINE LOCATION AND SIZE OF PRESENT GROUP
   39 LCTN=INIT
      KNTGRP=NEXT
   40 N=2
      IF(NUMPRS(LCTN).EQ.6)N=NUMPRS(LCTN+2)-NUMPRS(LCTN+1)+2
      N=N+3
      LENGTH=0
   41 LCTN=LCTN+5
      N=N-5
      LENGTH=LENGTH+5
      IF(N.GT.0)GO TO 41
      IF(INDEX.EQ.KPNT(KNTGRP))GO TO 43
      KNTGRP=KNTGRP+1
      IF(KNTGRP.LE.LMTGRP)GO TO 40
      WRITE(ITTY,42)INDEX
   42 FORMAT(13H NUMPRS GROUP,1I5,18H ALREADY PROCESSED)
      IF(ITTY.EQ.IIN)WRITE(ITTY,12)
      GO TO 36
   43 IF(KNTGRP.EQ.NEXT)GO TO 53
      LCTN=LCTN-LENGTH
C
C     UPDATE REFERENCES TO GROUPS BEING SHIFTED
      L=1
   44 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 46 M=1,N
      IF(NUMPRS(J).LT.INIT)GO TO 46
      IF(NUMPRS(J).EQ.LCTN)GO TO 45
      IF(NUMPRS(J).LT.LCTN)NUMPRS(J)=NUMPRS(J)+LENGTH
      GO TO 46
   45 NUMPRS(J)=INIT
   46 J=J+1
      N=N+3
   47 L=L+5
      N=N-5
      IF(N.GT.0)GO TO 47
      IF(L.LT.LMTNMB)GO TO 44
C
C     MOVE GROUP TO ITS NEW LOCATION
      I=LCTN
      DO 48 J=1,LENGTH
      ISAVE(J)=NUMPRS(I)
   48 I=I+1
   49 IF(LCTN.LE.INIT)GO TO 50
      I=I-1
      LCTN=LCTN-1
      NUMPRS(I)=NUMPRS(LCTN)
      GO TO 49
   50 DO 51 J=1,LENGTH
      NUMPRS(INIT)=ISAVE(J)
   51 INIT=INIT+1
C
C     UPDATE RECORD OF WHERE UNPROCESSED GROUPS ARE FOUND
   52 IF(KNTGRP.LE.NEXT)GO TO 54
      KPNT(KNTGRP)=KPNT(KNTGRP-1)
      KNTGRP=KNTGRP-1
      GO TO 52
   53 INIT=INIT+LENGTH
   54 NEXT=NEXT+1
      IF(NEXT.LE.LMTGRP)GO TO 36
C
C     CONSTRUCT ARRAY CONTAINING LOWER CASE LETTERS
   55 DO 57 I=1,LMTLST
      LTRNEW=LTRPRS(I)
      LWRPRS(I)=LTRNEW
      DO 56 J=1,26
      IF(LTRNEW.NE.LTRABC(J))GO TO 56
      LWRPRS(I)=LWRABC(J)
      GO TO 57
   56 CONTINUE
   57 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,ILPT)
      STOP
C643017621152
      END
      SUBROUTINE RETREE(LTRPRS,LMTLST,NUMPRS,LMTNMB,KPNT,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)
      DATA LTRDOT,LTRNON/1H.,1H /
C
C     PRINT CONTENTS OF LIST
      WRITE(ILPT,1)
    1 FORMAT(20H1WORDS IN DICTIONARY/1X)
      J=0
    2 M=0
    3 I=J+1
      IF(I.GT.LMTLST)GO TO 12
      K=1
    4 IF(NUMPRS(K).EQ.3)GO TO 7
      IF(NUMPRS(K).EQ.10)GO TO 7
      IF(NUMPRS(K).EQ.13)GO TO 7
      IF(NUMPRS(K+1).NE.I)GO TO 8
      IF(NUMPRS(K+2).LE.I)GO TO 10
      J=I-1
      IF(M.NE.0)WRITE(ILPT,5)(LTRPRS(N),N=M,J)
    5 FORMAT(1X,8HNOT USED,1X,40A1)
      J=NUMPRS(K+2)
      WRITE(ILPT,6)I,J,(LTRPRS(K),K=I,J)
    6 FORMAT(1X,2I4,1X,40A1)
      GO TO 2
    7 IF(NUMPRS(K+1).EQ.I)GO TO 10
      IF(NUMPRS(K+2).EQ.I)GO TO 10
    8 N=2
      IF(NUMPRS(K).EQ.6)N=NUMPRS(K+2)-NUMPRS(K+1)+2
      N=N+3
    9 K=K+5
      N=N-5
      IF(N.GT.0)GO TO 9
      IF(K.LT.LMTNMB)GO TO 4
      J=I
      IF(M.EQ.0)M=I
      GO TO 3
   10 J=I-1
      IF(M.NE.0)WRITE(ILPT,5)(LTRPRS(N),N=M,J)
      J=I
      WRITE(ILPT,11)I,LTRPRS(I)
   11 FORMAT(5X,1I4,1X,40A1)
      GO TO 2
C
C     PRINT WHICH GROUPS USE WHICH FUNCTIONS
   12 WRITE(ILPT,13)
   13 FORMAT(41H1GROUPS USING FUNCTIONS AND WORDS MATCHED/
     11X)
      J=0
      I=1
   14 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
   15 I=I+5
      N=N-5
      IF(N.GT.0)GO TO 15
      IF(I.LT.LMTNMB)GO TO 14
      DO 33 I=1,J
      M=0
      K=0
      L=1
   16 IF(NUMPRS(L).NE.I)GO TO 22
      IF(K.LT.10)GO TO 21
      IF(M.NE.0)GO TO 18
      WRITE(ILPT,17)I,(KPNT(N),N=1,K)
   17 FORMAT(1X,1H(,1I2,1H),10I5)
      M=1
      GO TO 20
   18 WRITE(ILPT,19)(KPNT(N),N=1,K)
   19 FORMAT(5X,10I5)
   20 K=0
   21 K=K+1
      KPNT(K)=L
   22 N=2
      IF(NUMPRS(L).EQ.6)N=NUMPRS(L+2)-NUMPRS(L+1)+2
      N=N+3
   23 L=L+5
      N=N-5
      IF(N.GT.0)GO TO 23
      IF(L.LT.LMTNMB)GO TO 16
      IF(K.EQ.0)GO TO 25
      IF(M.NE.0)GO TO 24
      WRITE(ILPT,17)I,(KPNT(N),N=1,K)
      M=1
      GO TO 25
   24 WRITE(ILPT,19)(KPNT(N),N=1,K)
C
C     PRINT WHICH WORDS ARE REFERENCED BY THIS FUNCTION
   25 IF(M.EQ.0)GO TO 33
      II=0
   26 L=LMTLST+1
      K=1
   27 IF(NUMPRS(K).NE.I)GO TO 30
      IF(NUMPRS(K).EQ.3)GO TO 28
      IF(NUMPRS(K).EQ.10)GO TO 28
      IF(NUMPRS(K).EQ.13)GO TO 28
      IF(NUMPRS(K+1).GE.L)GO TO 30
      IF(NUMPRS(K+1).LE.II)GO TO 30
      L=NUMPRS(K+1)
      M=NUMPRS(K+2)
      GO TO 30
   28 IF(NUMPRS(K+1).GE.L)GO TO 29
      IF(NUMPRS(K+1).LE.II)GO TO 29
      L=NUMPRS(K+1)
      M=L
   29 IF(NUMPRS(K+2).GE.L)GO TO 30
      IF(NUMPRS(K+2).LE.II)GO TO 30
      L=NUMPRS(K+2)
      M=L
   30 N=2
      IF(NUMPRS(K).EQ.6)N=NUMPRS(K+2)-NUMPRS(K+1)+2
      N=N+3
   31 K=K+5
      N=N-5
      IF(N.GT.0)GO TO 31
      IF(K.LT.LMTNMB)GO TO 27
      IF(L.GT.LMTLST)GO TO 33
      WRITE(ILPT,32)(LTRPRS(N),N=L,M)
   32 FORMAT(7X,40A1)
      II=M
      IF(II.LT.LMTLST)GO TO 26
   33 CONTINUE
C
C     ***************************************
C     *                                     *
C     *  DESCRIBE TREE STRUCTURE OF PARSER  *
C     *                                     *
C     ***************************************
C
      WRITE(ILPT,34)
   34 FORMAT(40H1TESTS PERFORMED UPON SUCCESS OR FAILURE)
      IGROUP=1
      INDEX=1
C
C     GET THE ITEM ITSELF
   35 LINE=0
      DO 36 J=1,7
   36 LTRONE(J)=LTRNON
      IF(NUMPRS(INDEX).EQ.3)GO TO 38
      IF(NUMPRS(INDEX).EQ.10)GO TO 38
      IF(NUMPRS(INDEX).EQ.13)GO TO 38
      L=NUMPRS(INDEX+1)
      IF(L.LE.0)GO TO 39
      DO 37 J=1,7
      IF(L.GT.NUMPRS(INDEX+2))GO TO 39
      LTRONE(J)=LTRPRS(L)
   37 L=L+1
      GO TO 39
   38 J=NUMPRS(INDEX+1)
      LTRONE(1)=LTRPRS(J)
      J=NUMPRS(INDEX+2)
      LTRONE(2)=LTRPRS(J)
   39 L=INDEX
      DO 40 J=1,5
      NMBONE(J)=NUMPRS(L)
   40 L=L+1
      IN=INDEX+4
      IF(NUMPRS(IN-1).GT.0)GO TO 41
      WRITE(ILPT,56)NMBONE,LTRONE
      GO TO 61
C
C     GET THE DESTINATION ITEM IF SUCCESS
   41 DO 42 J=1,5
   42 LTRTWO(J)=LTRNON
      JJ=NUMPRS(IN-1)
      IF(NUMPRS(JJ).EQ.3)GO TO 44
      IF(NUMPRS(JJ).EQ.10)GO TO 44
      IF(NUMPRS(JJ).EQ.13)GO TO 44
      L=NUMPRS(JJ+1)
      IF(L.LE.0)GO TO 45
      DO 43 J=1,5
      IF(L.GT.NUMPRS(JJ+2))GO TO 45
      LTRTWO(J)=LTRPRS(L)
   43 L=L+1
      GO TO 45
   44 J=NUMPRS(JJ+1)
      LTRTWO(1)=LTRPRS(J)
      J=NUMPRS(JJ+2)
      LTRTWO(2)=LTRPRS(J)
   45 NMBTWO(1)=NUMPRS(JJ)
      NMBTWO(2)=NUMPRS(JJ+3)
      NMBTWO(3)=NUMPRS(JJ+4)
      IF(NUMPRS(INDEX).EQ.16)GO TO 47
      IF(NUMPRS(INDEX).NE.6)GO TO 46
      IF(IN.GT.(INDEX+NUMPRS(INDEX+2)-NUMPRS(INDEX+1)+4))
     1GO TO 48
   46 IF(NUMPRS(IN).GT.0)GO TO 51
      IF(IN.GT.(INDEX+4))GO TO 48
   47 WRITE(ILPT,56)NMBONE,LTRONE,NMBTWO,LTRTWO
      GO TO 61
   48 KM=IN-1
      IF(LINE.EQ.0)WRITE(ILPT,49)INDEX,IGROUP,NUMPRS(KM),
     1NMBTWO,LTRTWO
   49 FORMAT(1X,1I4,2H (,1I3,1H),1I4,13X,1I2,2I4,1X,5A1)
      IF(LINE.NE.0)WRITE(ILPT,50)NUMPRS(KM),NMBTWO,LTRTWO
   50 FORMAT(11X,1I4,13X,1I2,2I4,1X,5A1,1X,1I2,2I4,1X,5A1)
      LINE=1
      GO TO 61
C
C     GET THE DESTINATION ITEM IF FAILURE
   51 DO 52 J=1,5
   52 LTRTHR(J)=LTRNON
      JJ=NUMPRS(IN)
      IF(NUMPRS(JJ).EQ.3)GO TO 54
      IF(NUMPRS(JJ).EQ.10)GO TO 54
      IF(NUMPRS(JJ).EQ.13)GO TO 54
      L=NUMPRS(JJ+1)
      IF(L.LE.0)GO TO 55
      DO 53 J=1,5
      IF(L.GT.NUMPRS(JJ+2))GO TO 55
      LTRTHR(J)=LTRPRS(L)
   53 L=L+1
      GO TO 55
   54 J=NUMPRS(JJ+1)
      LTRTHR(1)=LTRPRS(J)
      J=NUMPRS(JJ+2)
      LTRTHR(2)=LTRPRS(J)
   55 NMBTHR(1)=NUMPRS(JJ)
      NMBTHR(2)=NUMPRS(JJ+3)
      NMBTHR(3)=NUMPRS(JJ+4)
      IF(IN.GT.(INDEX+4))GO TO 57
      WRITE(ILPT,56)NMBONE,LTRONE,NMBTWO,LTRTWO,NMBTHR,
     1LTRTHR
   56 FORMAT(/1H ,1I2,4I4,1X,7A1,1X,1I2,2I4,1X,5A1,
     11X,1I2,2I4,1X,5A1)
      GO TO 60
   57 KM=IN-1
      IF(LINE.EQ.0)WRITE(ILPT,58)INDEX,IGROUP,NUMPRS(KM),
     1NUMPRS(IN),NMBTWO,LTRTWO,NMBTHR,LTRTHR
   58 FORMAT(1X,1I4,2H (,1I3,1H),2I4,9X,1I2,2I4,1X,5A1,
     11X,1I2,2I4,1X,5A1)
      IF(LINE.NE.0)WRITE(ILPT,59)NUMPRS(KM),NUMPRS(IN),NMBTWO,
     1LTRTWO,NMBTHR,LTRTHR
   59 FORMAT(11X,2I4,9X,1I2,2I4,1X,5A1,1X,1I2,2I4,1X,5A1)
      LINE=1
   60 IF(NUMPRS(INDEX).NE.6)GO TO 61
      IF(IN.GE.(INDEX+NUMPRS(INDEX+2)-NUMPRS(INDEX+1)+4))
     1GO TO 61
      IN=IN+2
      IF(NUMPRS(IN-1).GT.0)GO TO 41
C
C     PRINT THE LIST OF GROUPS WHICH CALL THIS GROUP
   61 IK=0
      IL=1
   62 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 63 J=1,N
      IF(NUMPRS(L).NE.INDEX)GO TO 63
      IK=IK+1
      KPNT(IK)=IL
   63 L=L+1
      N=N+3
   64 IL=IL+5
      N=N-5
      IF(N.GT.0)GO TO 64
      IF(IL.LT.LMTNMB)GO TO 62
      IF(IK.EQ.0)GO TO 67
      IM=IK
      IF(IM.GT.12)IM=12
      IF(LINE.EQ.0)WRITE(ILPT,65)INDEX,IGROUP,
     1(KPNT(IL),IL=1,IM)
   65 FORMAT(1X,1I4,2H (,1I3,1H),12I4)
      IF(LINE.NE.0)WRITE(ILPT,66)(KPNT(IL),IL=1,IM)
      IF(IK.GT.12)WRITE(ILPT,66)(KPNT(IL),IL=13,IK)
   66 FORMAT(11X,12I4)
      GO TO 70
   67 IF(LINE.EQ.0)WRITE(ILPT,68)INDEX,IGROUP
   68 FORMAT(1X,1I4,2H (,1I3,1H),23H *** NOT REFERENCED ***)
      IF(LINE.NE.0)WRITE(ILPT,69)
   69 FORMAT(11X,23H *** NOT REFERENCED ***)
   70 IGROUP=IGROUP+1
      N=2
      IF(NUMPRS(INDEX).EQ.6)N=NUMPRS(INDEX+2)-NUMPRS(INDEX+1)+2
      N=N+3
   71 INDEX=INDEX+5
      N=N-5
      IF(N.GT.0)GO TO 71
      IF(INDEX.LT.LMTNMB)GO TO 35
C
C     DRAW STRUCTURE OF TREE
      WRITE(ILPT,72)
   72 FORMAT(27H1DIAGRAM OF TESTS PERFORMED/1X)
      KOUNT=0
      INDEX=1
   73 N=2
      IF(NUMPRS(INDEX).EQ.16)N=1
      IF(NUMPRS(INDEX).EQ.6)N=NUMPRS(INDEX+2)-NUMPRS(INDEX+1)+2
      L=INDEX+3
      M=0
      DO 74 I=1,N
      IF(NUMPRS(L).LE.0)GO TO 75
      IF(M.EQ.0)KOUNT=KOUNT+2
      M=M+1
      KOUNT=KOUNT+1
      NUMPRS(KOUNT)=NUMPRS(L)
   74 L=L+1
   75 N=N+3
      IF(M.LE.0)GO TO 76
      J=KOUNT-M-1
      NUMPRS(J)=M+1
      NUMPRS(J+1)=INDEX
   76 INDEX=INDEX+5
      N=N-5
      IF(N.GT.0)GO TO 76
      IF(INDEX.LT.LMTNMB)GO TO 73
      NOWCLM=0
   77 CALL DATREE(1,1,0,1,KOUNT,
     1NUMPRS,1,33,NOWCLM,KOLUMN,IDUMMY,KIND,
     2NEWCLM)
      IF(KIND.LE.1)GO TO 81
      K=0
      DO 79 I=1,NOWCLM
      IF(I.GE.NEWCLM)GO TO 78
      LTRSHO(K+1)=LTRNON
      LTRSHO(K+2)=LTRNON
      LTRSHO(K+3)=LTRNON
      LTRSHO(K+4)=LTRDOT
      K=K+4
      GO TO 79
   78 J=KOLUMN(I)
      J=NUMPRS(J)
      M=K+4
      CALL DANUMB(1,J,10,LTRSHO,K,M,132)
   79 CONTINUE
      WRITE(ILPT,80)(LTRSHO(I),I=1,K)
   80 FORMAT(1X,132A1)
      GO TO 77
   81 STOP
C787956574294
      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)
C985104445547
      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.
C423899686864
      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
C353052349589
      END
      SUBROUTINE DATREE(KLIMB ,KOMPAR,ITYPE ,MINNOD,MAXNOD,
     1    NODES ,MINCLM,MAXCLM,NOWCLM,KOLUMN,INITAL,KIND  ,
     2    NEWCLM)
C     RENBR(/NODES IN NEXT LINE OF TREE REPRESENTATION)
C
C     DONALD BARTH, HARVARD BUSINESS SCHOOL
C
C     ROUTINE TO RETURN THE NODES WHICH WOULD  BE  IN  NEXT
C     LINE   OF   THE   REPRESENTATION  OF  A  SIMPLE  TREE
C     STRUCTURE.   THE  NODES  ARE  IDENTIFIED  TO  CALLING
C     PROGRAM  BY  SUBSCRIPTS, AND ARE NOT REPRESENTED IN A
C     FORM WHICH CAN BE DIRECTLY WRITTEN WITH A MULTIPLE OF
C     AN A1 FORMAT.
C
C     KLIMB  = 0, ENTIRE TREE IS TO BE REPRESENTED
C            = 1, ONLY PORTION OF  TREE  STARTING  AT  NODE
C              HAVING  IDENTIFICATION NUMBER IN NODES ARRAY
C              EQUAL TO INPUT VALUE  OF  KOMPAR  IS  TO  BE
C              REPRESENTED
C     KOMPAR = IF KLIMB=1, THEN KOMPAR IS EQUAL  TO  NUMBER
C              IN NODES ARRAY WHICH IDENTIFIES NODE AT BASE
C              OF TREE.  PORTION OF TREE  BELOW  THIS  NODE
C              WILL NOT BE REPRESENTED.
C     ITYPE  = 0, EACH GROUP IN  NODES  ARRAY  CONSISTS  OF
C              NUMBER  OF  ITEMS  WHICH  ARE  IDENTIFIED IN
C              GROUP FOLLOWED BY IDENTIFICATION OF  CALLING
C              ITEM  AND THEN BY IDENTIFICATIONS OR SOME OR
C              ALL OF ITEMS WHICH IT CALLS.  NODES ARRAY IS
C              TERMINATED  BY  GROUP CONTAINING ONLY SINGLE
C              ZERO.  IF ITEM 10 CALLS 11 AND 12, AND  ITEM
C              11  CALLS  12 AND 13, THEN NODES ARRAY WOULD
C              CONTAIN
C                 3, 10, 11, 12, 3, 11, 12, 13 AND 0
C            = 1, EACH GROUP IN  NODES  ARRAY  CONSISTS  OF
C              NUMBER OF ITEMS IDENTIFIED IN GROUP FOLLOWED
C              BY IDENTIFICATION OF ITEM CALLED AND THEN BY
C              IDENTIFICATIONS  OF  SOME  OR  ALL  OF ITEMS
C              CALLING IT.  NODES ARRAY  IS  TERMINATED  BY
C              GROUP  CONTAINING  ONLY  SINGLE  ZERO.   FOR
C              ABOVE EXAMPLE IN WHICH 12 IS CALLED BY  BOTH
C              10  AND  11, IN WHICH 11 IS CALLED BY 10 AND
C              IN WHICH 13 IS CALLED  BY  11,  NODES  ARRAY
C              WOULD CONTAIN
C                 3, 12, 10, 11, 2, 11, 10, 2, 13, 11 AND 0
C     MINNOD = LOWEST SUBSCRIPT TO USE IN NODES ARRAY
C     MAXNOD = DIMENSION OF NODES ARRAY
C     NODES  = ARRAY CONTAINING NODE IDENTIFIERS
C     MINCLM = SUBSCRIPT OF FIRST LOCATION IN KOLUMN ARRAY
C     MAXCLM = SUBSCRIPT OF FINAL LOCATION IN KOLUMN  ARRAY
C              WHICH IS AVAILABLE FOR USE
C     NOWCLM = MUST BE SET TO MINCLM-1 BEFORE THIS  ROUTINE
C              IS  FIRST  CALLED  TO  REPRESENT  PARTICULAR
C              TREE.  RETURNED CONTAINING HIGHEST SUBSCRIPT
C              USED  IN  KOLUMN  ARRAY TO REPRESENT CURRENT
C              LINE AND MUST BE SENT TO SUBSEQUENT CALL  OF
C              THIS ROUTINE UNCHANGED
C     KOLUMN = ARRAY  RETURNED  CONTAINING  SUBSCRIPTS   IN
C              NODES  ARRAY OF THOSE NODES ON CURRENT LINE.
C              CONTENTS OF KOLUMN ARRAY  MUST  BE  SENT  TO
C              SUBSEQUENT  CALL  OF THIS ROUTINE UNCHANGED.
C              CONTENTS OF KOLUMN ARRAY  ARE  IGNORED  WHEN
C              THIS ROUTINE IS CALLED WITH NOWCLM LESS THAN
C              MINCLM
C     INITAL = ARRAY DIMENSIONED SAME AS KOLUMN ARRAY,  BUT
C              WHICH  IS  USED  ONLY FOR TRANSFER OF VALUES
C              FROM ONE  CALL  OF  THIS  ROUTINE  TO  NEXT.
C              CONTENTS  OF  THIS ARRAY MUST NOT BE CHANGED
C              BETWEEN CALLS TO THIS ROUTINE UNTIL KIND  IS
C              RETURNED  CONTAINING  1 INDICATING THAT TREE
C              HAS BEEN COMPLETED.
C     KIND   = 1, RETURNED IF REPRESENTATION  OF  TREE  HAD
C              BEEN FINISHED BY PREVIOUS CALL
C            = 2, LINE IN REPRESENTATION IS BEING  RETURNED
C              IN   KOLUMN(MINCLM)  THROUGH  AND  INCLUDING
C              KOLUMN(NOWCLM)
C            = 3, SAME AS KIND=2 EXCEPT THAT REPRESENTATION
C              IS TERMINATED AT LOOP END
C            = 4, SAME AS KIND=2 EXCEPT THAT NOT ALL  NODES
C              COULD  BE REPRESENTED DUE TO TOO LITTLE ROOM
C              IN KOLUMN ARRAY
C            = 5, KLIMB WAS INPUT CONTAINING 1  AND  NOWCLM
C              CONTAINING  MINCLM-1 INDICATING THAT PARTIAL
C              TREE WAS DESIRED,  BUT  NODE  IDENTIFIED  BY
C              KOMPAR  COULD  NOT  BE FOUND IN NODES ARRAY.
C              NO NODES ARE BEING RETURNED IN KOLUMN ARRAY,
C              AND NOWCLM IS RETURNED CONTAINING MINCLM-1.
C     NEWCLM = RETURNED  CONTAINING  LOWEST   SUSCRIPT   OF
C              KOLUMN   ARRAY   WHICH   HAS  BEEN  RETURNED
C              CHANGED.  INPUT VALUE IS IGNORED
C
      DIMENSION NODES(MAXNOD),KOLUMN(MAXCLM),INITAL(MAXCLM)
C
      KIND=1
      IF(NOWCLM.GE.MINCLM)GO TO 21
      NOWCLM=MINCLM-1
      NEWCLM=MINCLM
      LIMIT=MINNOD
      IF(KLIMB.EQ.0)GO TO 3
C
C     FIND ROOT IF SPECIFIED BY CALLING PROGRAM
    1 ISIZE=NODES(LIMIT)
      IF(ISIZE.LE.0)GO TO 25
      JTEST=LIMIT
      LOWER=LIMIT
      LIMIT=LIMIT+ISIZE+1
      IF(LIMIT.GT.MAXNOD)GO TO 25
    2 LOWER=LOWER+1
      IF(LOWER.GE.LIMIT)GO TO 1
      IF(NODES(LOWER).NE.KOMPAR)GO TO 2
      GO TO 14
C
C     FIND NEXT ROOT IF NOT SPECIFIED BY CALLING PROGRAM
    3 ISIZE=NODES(LIMIT)
      IF(ISIZE.LE.0)GO TO 26
      JTEST=LIMIT
      LOWER=LIMIT+1
      LIMIT=LOWER+ISIZE
      IF(LIMIT.GT.MAXNOD)GO TO 26
      IF(ITYPE.EQ.0)GO TO 9
      IF(ISIZE.LE.1)GO TO 5
    4 LOWER=LOWER+1
      IF(LOWER.GE.LIMIT)GO TO 3
    5 IDNTFY=NODES(LOWER)
    6 NODTST=MINNOD
    7 ISIZE=NODES(NODTST)
      IF(ISIZE.LE.0)GO TO 10
      ITEST=NODTST+1
      NODTST=ITEST+ISIZE
      IF(NODTST.GT.MAXNOD)GO TO 10
      IF(ITYPE.EQ.0)GO TO 8
      IF(ISIZE.LE.1)GO TO 7
    8 IF(NODES(ITEST).NE.IDNTFY)GO TO 7
      IF(ITYPE.NE.0)GO TO 4
      IF(ITEST.LT.LOWER)GO TO 3
      GO TO 14
    9 IDNTFY=NODES(LOWER)
   10 NODTST=MINNOD
   11 ISIZE=NODES(NODTST)
      IF(ISIZE.LE.0)GO TO 6
      ITEST=NODTST+1
      NODTST=ITEST+ISIZE
      IF(NODTST.GT.MAXNOD)GO TO 6
      IF(ITYPE.EQ.0)GO TO 12
      IF(ISIZE.LE.1)GO TO 13
   12 ITEST=ITEST+1
      IF(ITEST.GE.NODTST)GO TO 11
   13 IF(NODES(ITEST).NE.IDNTFY)GO TO 12
      IF(ITYPE.EQ.0)GO TO 3
      IF(ITEST.LT.LOWER)GO TO 4
C
C     INSERT NEW NODE ONTO BRANCH
   14 IF(NOWCLM.GE.MAXCLM)GO TO 24
      NOWCLM=NOWCLM+1
      KOLUMN(NOWCLM)=LOWER
      INITAL(NOWCLM)=JTEST
      IDNTFY=NODES(LOWER)
      LIMIT=MINNOD
      KIND=2
C
C     CHECK THAT BRANCH DOES NOT CONTAIN A LOOP
      J=MINCLM
   15 IF(J.GE.NOWCLM)GO TO 16
      I=KOLUMN(J)
      IF(NODES(I).EQ.NODES(LOWER))GO TO 23
      J=J+1
      GO TO 15
C
C     SEARCH FOR NEXT NODE ALONG BRANCH
   16 ISIZE=NODES(LIMIT)
      IF(ISIZE.LE.0)GO TO 20
      JTEST=LIMIT
      LOWER=LIMIT+1
      LIMIT=LOWER+ISIZE
      IF(LIMIT.GT.MAXNOD)GO TO 20
      IF(ITYPE.EQ.0)GO TO 18
      ITEST=LOWER
   17 ITEST=ITEST+1
      IF(ITEST.GE.LIMIT)GO TO 16
      IF(NODES(ITEST).NE.IDNTFY)GO TO 17
      GO TO 14
   18 IF(NODES(LOWER).NE.IDNTFY)GO TO 16
   19 LOWER=LOWER+1
      IF(LOWER.GE.LIMIT)GO TO 16
      GO TO 14
C
C     BACK UP TO PREVIOUS NODE IF CURRENT NODE COMPLETED
   20 IF(KIND.NE.1)GO TO 26
   21 LOWER=KOLUMN(NOWCLM)
      JTEST=INITAL(NOWCLM)
      LIMIT=JTEST+NODES(JTEST)+1
      NEWCLM=NOWCLM
      NOWCLM=NOWCLM-1
      IF(NOWCLM.LT.MINCLM)GO TO 22
      I=KOLUMN(NOWCLM)
      IDNTFY=NODES(I)
      IF(ITYPE.EQ.0)GO TO 19
      GO TO 16
   22 IF(KLIMB.NE.0)GO TO 26
      IF(ITYPE.EQ.0)GO TO 3
      GO TO 4
C
C     RETURN TO CALLING PROGRAM
   23 KIND=3
      GO TO 26
   24 KIND=4
      GO TO 26
   25 KIND=5
   26 RETURN
C660045846000
      END