Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-09 - decus/20-34/reopr.for
There are 6 other files named reopr.for in the archive. Click here to see a list.
C     RENBR(REOPR/CONSTRUCT RENBR OPERATOR TABLES)
C
C     DONALD BARTH, HARVARD BUSINESS SCHOOL
C
C     THIS PROGRAM CONSTRUCTS THE TABLE USED BY THE FORTRAN
C     RENUMBERING  PROGRAM RENBR FOR RECOGNIZING THE SINGLE
C     CHARACTER FORTRAN OPERATORS SUCH AS +, -,  *,  /  AND
C     THE MULTIPLE CHARACTER FORTRAN OPERATORS SUCH AS .EQ.
C     AND .NOT.
C
C     INPUT TO THIS PROGRAM, READ FROM UNIT  IIN,  CONSISTS
C     OF A FILE CONTAINING A SINGLE OPERATOR LEFT JUSTIFIED
C     ON EACH LINE.  THE INPUT FILE SHOULD BE TERMINATED BY
C     AN  EMPTY  LINE  IF  THE  END  OF  FILE  TEST  IS NOT
C     AVAILABLE.  ALPHABETIC CHARACTERS IN THE  INPUT  FILE
C     SHOULD EITHER ALL BE UPPER CASE OR ALL BE LOWER CASE.
C
C     OUTPUT FROM THIS PROGRAM,  WRITTEN  ONTO  UNIT  IOUT,
C     CONSISTS  OF  COMMENT LINES DESCRIBING THE OPERATIONS
C     PERFORMED WHEN CHARACTERS ARE  MATCHED,  FOLLOWED  BY
C     THE  OPERATIONS  PERFORMED WHEN THEY ARE NOT MATCHED.
C     THESE COMMENT LINES ARE FOLLOWED BY  DATA  STATEMENTS
C     CONTAINING   THE   CHARACTERS   TO  BE  MATCHED,  THE
C     LOCATIONS OF THE CHARACTERS TO BE TESTED  IF  MATCHES
C     ARE  FOUND, AND THE LOCATIONS OF THE CHARACTERS TO BE
C     TESTED IF MATCHES  ARE  NOT  FOUND.   ALL  ALPHABETIC
C     CHARACTERS  APPEAR TWICE IN THE OUTPUT, REGARDLESS OF
C     THEIR CASE IN THE INPUT FILE, FIRST IN UPPER CASE AND
C     THEN  IN  LOWER  CASE TO BE TESTED AGAINST IF MATCHES
C     ARE NOT FOUND WITH THE  UPPER  CASE  CHARACTERS.   IF
C     BOTH CASES ARE NOT NEEDED, THEN THE ENTIRE SECTION OF
C     CODE  WHICH  SEARCHES  FOR  ALPHABETIC  LETTERS   AND
C     INSERTS THE LOWER CASE CHARACTERS CAN BE REMOVED.
C
C     THE FOLLOWING LINES, IF  STRIPPED  OF  THE  INITAL  6
C     CHARACTERS   ON   EACH  LINE,  CONTAIN  THE  OPERATOR
C     DEFINITIONS  WHICH  WERE  READ  BY  THIS  PROGRAM  TO
C     CONSTRUCT  THE  TABLE  IN  THE 1979 VERSION OF RENBR.
C     THESE OPERATOR DEFINITIONS MUST  BE  FOLLOWED  BY  AN
C     EXTRA  BLANK  LINE  IF  THE  END-OF-FILE TEST IN READ
C     STATEMENTS IS NOT AVAILABLE.
C     .AND.
C     .EQV.
C     .EQ.
C     .GE.
C     .GT.
C     .LE.
C     .LT.
C     .NEQV.
C     .NE.
C     .NOT.
C     .XOR.
C     .OR.
C     (
C     )
C     =
C     +
C     -
C     *
C     /
C     ,
C     <
C     >
C     #
C     :
C     ^
C
C     GLOSSARY OF VARIABLE AND ARRAY NAMES
C
C     LTRONE = NAME OF ARRAY TO CONTAIN CHARACTERS  FORMING
C              OPERATORS.
C     LTRTWO = NAME OF ARRAY TO CONTAIN LOCATIONS  OF  NEXT
C              CHARACTERS TO BE TESTED IF CURRENT CHARACTER
C              MATCHES OR ZERO FOR COMPLETED MATCH.
C     LTRTHR = NAME OF ARRAY TO CONTAIN LOCATIONS  OF  NEXT
C              CHARACTERS TO BE TESTED IF CURRENT CHARACTER
C              DOES NOT MATCH OR ZERO FOR TOTAL FAILURE.
C     LTRDGT = CHARACTERS 0 THROUGH 9.
C     LTRABC = UPPER CASE CHARACTERS A THROUGH Z.
C     LWRABC = LOWER CASE CHARACTERS A THROUGH Z.
C     LTRBFR = BUFFER INTO WHICH EACH OPERATOR IS READ.
C     LTRLIN = BUFFER  IN  WHICH  EACH  COMMENT   LINE   IS
C              CONSTRUCTED.
C     LTRSPL = CHARACTERS IN OPERATORS AFTER DUPLICATES ARE
C              REMOVED.
C     LTRINI = CHARACTERS ORIGINALLY  IN  OPERATORS  BEFORE
C              DUPLICATES WERE REMOVED.
C     LOCPNT = USED IN CONSTRUCTION OF COMMENT LINES TO MAP
C              FROM THE ORIGINAL CHARACTERS IN LTRINI ARRAY
C              TO THE CHARACTERS IN THE LTRSPL ARRAY.
C     LOCMCH = USED IN CONSTRUCTION  OF  COMMENT  LINES  TO
C              CONTAIN  SUBSCRIPTS  OF CHARACTERS IN LTRSPL
C              ARRAY  TO  BE  MATCHED  IF   CURRENT   MATCH
C              SUCCEEDS.
C     LOCNOT = USED IN CONSTRUCTION  OF  COMMENT  LINES  TO
C              CONTAIN  SUBSCRIPTS  OF CHARACTERS IN LTRSPL
C              ARRAY TO BE MATCHED IF CURRENT MATCH FAILS.
C     MCHPNT = SUBSCRIPTS OF CHARACTERS IN LTRSPL ARRAY  TO
C              BE  TESTED NEXT IF CURRENT MATCH SUCCEEDS OR
C              ZERO FOR COMPLETED MATCH.
C     NOTPNT = SUBSCRIPTS OF CHARACTERS IN LTRSPL ARRAY  TO
C              BE  TESTED  NEXT  IF  CURRENT MATCH FAILS OR
C              ZERO FOR TOTAL FAILURE.
C     LNGSPL = NUMBER  OF  CHARACTERS  IN   EACH   ORIGINAL
C              OPERATOR IN LTRINI ARRAY.
C     LOCINI = ORIGINAL LOCATION IN  LTRINI  ARRAY  OF  THE
C              CHARACTERS NOW IN THE LTRSPL ARRAY.
C
      DIMENSION LTRONE(6),LTRTWO(6),LTRTHR(6),LTRDGT(10),
     1LTRABC(26),LWRABC(26),LTRBFR(10),LTRLIN(120),
     2LTRSPL(200),LTRINI(200)
      DIMENSION LOCPNT(10),LOCMCH(10),LOCNOT(10),
     1MCHPNT(200),NOTPNT(200),LNGSPL(100),LOCINI(200)
C
C     FILE NAMES
      DOUBLE PRECISION FILINP,FILOUT
C
C     MAXONE = DIMENSION OF THE LTRBFR, LOCPNT, LOCMCH  AND
C              LOCNOT ARRAYS.  MAXONE IS THE MAXIMUM NUMBER
C              OF CHARACTERS IN A SINGLE OPERATOR.   LTRLIN
C              SHOULD BE DIMENSIONED TO 12 TIMES MAXONE.
C     MAXALL = DIMENSION OF  THE  LTRSPL,  LTRINI,  MCHPNT,
C              NOTPNT  AND  LOCINI  ARRAYS.   MAXALL IS THE
C              MAXIMUM NUMBER OF CHARACTERS WHICH CAN BE IN
C              THE TABLE AT ANY POINT, INCLUDING CHARACTERS
C              WHICH ARE DUPLICATES WHICH  ARE  REMOVED  IN
C              THE  FIRST  PASS AND INCLUDING BOTH CASES OF
C              ALPHABETIC CHARACTERS WHICH ARE GENERATED IN
C              THE FINAL PASS.
C     MAXOPR = DIMENSION OF THE LNGSPL  ARRAY.   MAXOPR  IS
C              THE MAXIMUM NUMBER OF OPERATORS WHICH CAN BE
C              HANDLED.
C     MAXCLM = DIMENSION  OF  THE  LTRLIN  ARRAY.   THIS IS
C              NUMBER OF  CHARACTERS,  NEGLECTING INITIAL C
C              AND SPACE, WHICH CAN  BE WRITTEN ON A SINGLE
C              COMMENT LINE.
C
      DATA MAXONE,MAXALL,MAXOPR,MAXCLM/10,200,100,120/
C
C     ITTY   = UNIT NUMBER OF THE CONTROLLING TERMINAL.
C     IIN    = UNIT NUMBER FROM WHICH INPUT FILE IS READ.
C     IOUT   = UNIT NUMBER TO WHICH OUTPUT FILE IS WRITTEN.
C
      DATA ITTY,IIN,IOUT/5,1,20/
      DATA LTRONE/1HL,1HT,1HR,1HO,1HP,1HR/
      DATA LTRTWO/1HM,1HC,1HH,1HO,1HP,1HR/
      DATA LTRTHR/1HN,1HO,1HT,1HO,1HP,1HR/
      DATA LTRSPC/1H /
      DATA LTRDGT/1H0,1H1,1H2,1H3,1H4,1H5,1H6,1H7,1H8,1H9/
      DATA LTRABC/1HA,1HB,1HC,1HD,1HE,1HF,1HG,1HH,1HI,1HJ,
     1            1HK,1HL,1HM,1HN,1HO,1HP,1HQ,1HR,1HS,1HT,
     2            1HU,1HV,1HW,1HX,1HY,1HZ/
      DATA LWRABC/1Ha,1Hb,1Hc,1Hd,1He,1Hf,1Hg,1Hh,1Hi,1Hj,
     1            1Hk,1Hl,1Hm,1Hn,1Ho,1Hp,1Hq,1Hr,1Hs,1Ht,
     2            1Hu,1Hv,1Hw,1Hx,1Hy,1Hz/
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')
    2 FORMAT(1A10)
    3 FORMAT(' FILE SPECIFYING FORTRAN OPERATORS? ',$)
    4 FORMAT(' FILE TO WHICH DATA STATEMENTS ARE TO BE WRITTEN? ',$)
C
C     READ LIST OF OPERATORS
      MAXWID=0
      KNTOPR=0
      KNTSPL=0
    5 READ(IIN,6,END=9)LTRBFR
    6 FORMAT(100A1)
      MAXPRT=MAXONE+1
    7 MAXPRT=MAXPRT-1
      IF(MAXPRT.LE.0)GO TO 9
      IF(LTRBFR(MAXPRT).EQ.LTRSPC)GO TO 7
      IF((KNTSPL+MAXPRT).GT.MAXALL)GO TO 9
      KNTOPR=KNTOPR+1
      LNGSPL(KNTOPR)=MAXPRT
      DO 8 I=1,MAXPRT
      KNTSPL=KNTSPL+1
      LTRSPL(KNTSPL)=LTRBFR(I)
      LTRINI(KNTSPL)=LTRBFR(I)
    8 LOCINI(KNTSPL)=KNTSPL
      IF(MAXWID.LT.MAXPRT)MAXWID=MAXPRT
      IF(KNTOPR.LT.MAXOPR)GO TO 5
C
C     REMOVE INITIAL MATCHING CHARACTERS FROM OPERATORS
    9 KNTSPL=0
      LOCEND=0
      INDEX=0
      JNDEX=0
      KNDEX=1
   10 IF(INDEX.GE.KNTOPR)GO TO 16
      INDEX=INDEX+1
      LOCBGN=LOCEND+1
      LOCEND=LOCEND+LNGSPL(INDEX)
      DO 15 INNER=LOCBGN,LOCEND
      IF(JNDEX.EQ.0)GO TO 12
   11 KNDEX=JNDEX
      IF(LTRSPL(INNER).EQ.LTRSPL(JNDEX))GO TO 14
      JNDEX=NOTPNT(JNDEX)
      IF(JNDEX.NE.0)GO TO 11
      NOTPNT(KNDEX)=KNTSPL+1
      GO TO 13
   12 MCHPNT(KNDEX)=KNTSPL+1
   13 KNTSPL=KNTSPL+1
      LTRSPL(KNTSPL)=LTRSPL(INNER)
      LOCINI(KNTSPL)=LOCINI(INNER)
      NOTPNT(KNTSPL)=0
      MCHPNT(KNTSPL)=0
      KNDEX=KNTSPL
      GO TO 15
   14 JNDEX=MCHPNT(JNDEX)
   15 CONTINUE
      JNDEX=1
      GO TO 10
C
C     REMOVE TERMINAL MATCHING CHARACTERS FROM OPERATORS
   16 INDEX=0
   17 INDEX=INDEX+1
      IF(INDEX.GE.KNTSPL)GO TO 21
      INNER=INDEX
   18 INNER=INNER+1
      IF(INNER.GT.KNTSPL)GO TO 17
      IF(LTRSPL(INDEX).NE.LTRSPL(INNER))GO TO 18
      IF(MCHPNT(INDEX).NE.MCHPNT(INNER))GO TO 18
      IF(NOTPNT(INDEX).NE.NOTPNT(INNER))GO TO 18
      KNTSPL=KNTSPL-1
      DO 19 I=INDEX,KNTSPL
      LTRSPL(I)=LTRSPL(I+1)
      LOCINI(I)=LOCINI(I+1)
      MCHPNT(I)=MCHPNT(I+1)
   19 NOTPNT(I)=NOTPNT(I+1)
      DO 20 I=1,KNTSPL
      IF(MCHPNT(I).EQ.INDEX)MCHPNT(I)=INNER
      IF(MCHPNT(I).GT.INDEX)MCHPNT(I)=MCHPNT(I)-1
      IF(NOTPNT(I).EQ.INDEX)NOTPNT(I)=INNER
   20 IF(NOTPNT(I).GT.INDEX)NOTPNT(I)=NOTPNT(I)-1
      GO TO 16
C
C     INSERT LOWER CASE LETTERS AFTER UPPER CASE LETTERS
   21 INDEX=0
   22 IF(INDEX.GE.KNTSPL)GO TO 28
      IF((KNTSPL+1).GT.MAXALL)GO TO 28
      INDEX=INDEX+1
      MATCH=0
   23 IF(MATCH.GE.26)GO TO 22
      MATCH=MATCH+1
      IF(LTRSPL(INDEX).EQ.LTRABC(MATCH))GO TO 24
      IF(LTRSPL(INDEX).NE.LWRABC(MATCH))GO TO 23
   24 KNTSPL=KNTSPL+1
      INNER=KNTSPL
   25 IF(INNER.LE.INDEX)GO TO 26
      LTRSPL(INNER)=LTRSPL(INNER-1)
      LOCINI(INNER)=LOCINI(INNER-1)
      MCHPNT(INNER)=MCHPNT(INNER-1)
      NOTPNT(INNER)=NOTPNT(INNER-1)
      INNER=INNER-1
      GO TO 25
   26 DO 27 I=1,KNTSPL
      IF(MCHPNT(I).GT.INDEX)MCHPNT(I)=MCHPNT(I)+1
   27 IF(NOTPNT(I).GT.INDEX)NOTPNT(I)=NOTPNT(I)+1
      LTRSPL(INDEX)=LTRABC(MATCH)
      LTRSPL(INDEX+1)=LWRABC(MATCH)
      LOCINI(INDEX+1)=0
      NOTPNT(INDEX)=INDEX+1
      INDEX=INDEX+1
      GO TO 22
C
C     CONSTRUCT DIMENSION AND EQUIVALENCE LINES
   28 CALL DASAVE(-4,-1,53,10,MCHPNT,
     1KNTSPL,LTRSPL,KNTSPL,LTRONE,6,IOUT,IERR)
      CALL DASAVE(-4,3,53,10,MCHPNT,
     1KNTSPL,LTRSPL,KNTSPL,LTRTWO,6,IOUT,IERR)
      CALL DASAVE(-4,3,53,10,NOTPNT,
     1KNTSPL,LTRSPL,KNTSPL,LTRTHR,6,IOUT,IERR)
      WRITE(IOUT,42)
C
C     CONSTRUCT COMMENT LINES
      LOCEND=0
      KOLUMN=0
      INDEX=KNTSPL
   29 KOLUMN=KOLUMN+1
      INDEX=INDEX/10
      IF(INDEX.GT.0)GO TO 29
      DO 43 INDEX=1,KNTOPR
      LOCBGN=LOCEND+1
      LOCEND=LOCEND+LNGSPL(INDEX)
      NEWSPL=0
      DO 32 INNER=LOCBGN,LOCEND
      NEWSPL=NEWSPL+1
      MATCH=KNTSPL
   30 IF(LOCINI(MATCH).EQ.INNER)GO TO 31
      MATCH=MATCH-1
      IF(MATCH.GT.0)GO TO 30
   31 LTRBFR(NEWSPL)=LTRINI(INNER)
      LOCPNT(NEWSPL)=MATCH
      LOCMCH(NEWSPL)=0
      LOCNOT(NEWSPL)=0
      IF(MATCH.LE.0)GO TO 32
      LOCMCH(NEWSPL)=MCHPNT(MATCH)
      LOCNOT(NEWSPL)=NOTPNT(MATCH)
   32 CONTINUE
      KOUNT=0
      DO 40 IOUTER=1,3
      DO 39 INNER=1,MAXWID
      IF(INNER.GT.NEWSPL)GO TO 35
      IF(IOUTER.EQ.3)GO TO 34
      IF(IOUTER.EQ.2)GO TO 33
      IVALUE=LOCPNT(INNER)
      IF(IVALUE.LE.0)IVALUE=-1
      LTRNEW=LTRBFR(INNER)
      GO TO 37
   33 IF(LOCPNT(INNER).LE.0)GO TO 35
      IVALUE=LOCMCH(INNER)
      IF(IVALUE.LE.0)GO TO 36
      LTRNEW=LTRSPL(IVALUE)
      GO TO 37
   34 IF(LOCPNT(INNER).LE.0)GO TO 35
      IVALUE=LOCNOT(INNER)
      IF(IVALUE.LE.0)GO TO 36
      IF(LOCINI(IVALUE).EQ.0)IVALUE=NOTPNT(IVALUE)
      IF(IVALUE.LE.0)GO TO 36
      LTRNEW=LTRSPL(IVALUE)
      GO TO 37
   35 IVALUE=-1
   36 LTRNEW=LTRSPC
   37 IF((KOUNT+KOLUMN).GE.MAXCLM)GO TO 41
      KOUNT=KOUNT+KOLUMN+1
      DO 38 I=1,KOLUMN
      KOUNT=KOUNT-1
      LTRLIN(KOUNT)=LTRSPC
      IF(IVALUE.LT.0)GO TO 38
      JVALUE=IVALUE
      IVALUE=IVALUE/10
      JVALUE=JVALUE-(10*IVALUE)
      LTRLIN(KOUNT)=LTRDGT(JVALUE+1)
      IF(IVALUE.EQ.0)IVALUE=-1
   38 CONTINUE
      KOUNT=KOUNT+KOLUMN
      LTRLIN(KOUNT)=LTRNEW
   39 CONTINUE
   40 CONTINUE
   41 WRITE(IOUT,42)(LTRLIN(I),I=1,KOUNT)
   42 FORMAT(2HC ,120A1)
   43 CONTINUE
C
C     CONSTRUCT DATA STATEMENTS
      WRITE(IOUT,42)
      CALL DASAVE(3,-1,53,10,MCHPNT,
     1KNTSPL,LTRSPL,KNTSPL,LTRONE,6,IOUT,IERR)
      CALL DASAVE(3,3,53,10,MCHPNT,
     1KNTSPL,LTRSPL,KNTSPL,LTRTWO,6,IOUT,IERR)
      CALL DASAVE(3,3,53,10,NOTPNT,
     1KNTSPL,LTRSPL,KNTSPL,LTRTHR,6,IOUT,IERR)
C919568056337
      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