C     RENBR(FONT/BIT PACK CHARACTER SHAPES FOR FROFF)
C
C     DONALD BARTH, CHEMISTRY DEPT., HARVARD UNIVERSITY
C
C     THE FIRST LINE IN THE INPUT DATA FILE WILL BE  COPIED
C     INTO  THE  OUTPUT FILE WITH AN INITIAL LETTER C BEING
C     ADDED SO THAT IT  BECOMES  A  FORTRAN  COMMENT  LINE.
C     SUBSEQUENT  LINES  IN THE DATA FILE SHOULD CONSIST OF
C     THE CHARACTER SHAPES CONSTRUCTED  OF  THE  CHARACTERS
C     WHICH  THEY  ARE  TO  REPRESENT.   THE  FIRST  ROW OF
C     CHARACTER SHAPES MUST BE OF THE MAXIMUM HEIGHT  SINCE
C     THE  HEIGHT OF THE FIRST ROW IS ASSUMED TO DEFINE THE
C     HEIGHT FOR  ALL  SUBSEQUENT ROWS.   A LINE CONTAINING
C     WORD END SHOULD APPEAR BETWEEN SUBSEQUENT FONTS.  THE
C     THE FINAL  LINE OF THE INPUT FILE  SHOULD CONTAIN THE
C     WORD END.
C
      DIMENSION IPACKD(2880),LENGTH(480),LTRKNO(480),
     1LTRBFR(2400),LTRLNG(6),LTRPAC(6),LTRINP(80),
     2LTRSUB(6),LTRCOM(80),LTRSTR(96),LTRLET(6),LTRNXT(4),
     3LWRNXT(4),LTREND(3),LWREND(3),MSTWID(10),MAXWID(10),
     4LOCEND(10),ITALL(10),LTRHIH(6),LTRLMT(6),LTRMAX(6),
     5LTRMNY(6)
      DOUBLE PRECISION NAMSRC,NAMOUT
C
      DATA MAXHIH,LMTWID,MAXLNG,MAXPAC,LMTFNT/30,60,480,2880,10/
      DATA LTRLNG/1HI,1HC,1HL,1HM,1HN,1HS/
      DATA LTRPAC/1HI,1HP,1HA,1HC,1HK,1HD/
      DATA LTRLET/1HL,1HT,1HR,1HF,1HN,1HT/
      DATA LTRHIH/1HI,1HL,1HI,1HN,1HE,1HS/
      DATA LTRLMT/1HI,1HL,1HI,1HM,1HI,1HT/
      DATA LTRMAX/1HI,1HM,1HA,1HX,1HM,1HM/
      DATA LTRMNY/1HI,1HC,1HO,1HM,1HM,1HN/
C
C     LTRBFR = ARRAY INTO WHICH ALL OF THE INPUT LINES
C              WHICH COULD DEFINE THE CURRENT LETTER SHAPES
C              ARE PLACED BEFORE SEARCHING THIS ARRAY TO
C              DIVIDE IT UP INTO THE ACTUAL LETTER SHAPES.
C     IPACKD = ARRAY IN WHICH ARE STORED THE BINARY PACKED
C              REPRESENTATIONS OF FORMS OF LETTERS.
C     LTRSUB = ARRAY IN WHICH THE ROUTINE NAME TO BE
C              WRITTEN AS OUTPUT IS STORED.  IF THIS MERELY
C              CONTAINS SPACES, THEN A BLOCK DATA ROUTINE
C              IS WRITTEN.  OTHERWISE A SUBROUTINE IS
C              GENERATED.
C     LTRINP = BUFFER INTO WHICH EACH LINE IS FIRST READ
C              TO DETERMINE IF IT IS PART OF SPECIFICATION
C              OF THE CURRENT BATCH OF LETTERS.
C     LTRKNO = ARRAY IN WHICH ARE STORED THOSE LETTERS
C              WHICH HAVE BEEN REPRESENTED.
C     LTRCOM = ARRAY IN WHICH IS STORED THE FIRST LINE
C              OF THE INPUT FILE UNTIL THIS IS WRITTEN INTO
C              THE OUTPUT FILE AS A FORTRAN COMMENT LINE.
C     LENGTH = ARRAY USED TO STORE THE WIDTHS OF EACH OF
C              THE CHARACTERS WHICH HAVE BEEN DEFINED.
C     LTRSTR = ARRAY USED TO HOLD ALL DIFFERENT CHARACTERS
C              BEING DEFINED BY CURRENT LINES AND USED TO
C              DETECT END OF ONE GROUP AND START OF NEXT
C     LTRLNG = ARRAY CONTAINING THE LETTERS OF THE NAME OF
C              ONE OF THE ARRAYS WHICH MUST BE WRITTEN AS A
C              FORTRAN DATA STATEMENT.
C     LTRPAC = ARRAY CONTAINING THE LETTERS OF THE NAME OF
C              ONE OF THE ARRAYS WHICH MUST BE WRITTEN AS A
C              FORTRAN DATA STATEMENT.
C     MAXHIH = MAXIMUM HEIGHT OF LETTERS.
C              LTRBFR MUST BE DIMENSIONED LMTWID*MAXHIH
C     MAXLNG = DIMENSION OF LENGTH AND LTRKNO ARRAYS
C              THIS IS MAXIMUM NUMBER OF CHARACTERS
C              WHICH CAN BE REPRESENTED.  LETTER ARRAY
C              MUST BE DIMENSIONED AT LEAST 4*MAXLNG.
C     MAXPAC = DIMENSION OF IPACKD ARRAY.  IPACKD
C              STORES BIT PACKED REPRESENTATION OF
C              CHARACTERS, 1 LINE PER CHARACTER.
C              MAXPAC SHOULD BE AT LEAST HEIGHT
C              OF CHARACTER TIMES NUMBER OF CHARACTERS.
C     LMTWID = NUMBER OF CHARACTERS READ FROM EACH LINE.
C              LTRBFR MUST BE ABLE TO HOLD MAXHIH LINES
C
C     IDSK   = INPUT UNIT NUMBER
C     JDSK   = OUTPUT UNIT NUMBER
C
      DATA IDSK,JDSK/1,20/
      DATA LTRSPA/1H /
      DATA LTRNXT/1HN,1HE,1HX,1HT/
      DATA LWRNXT/1Hn,1He,1Hx,1Ht/
      DATA LTREND/1HE,1HN,1HD/
      DATA LWREND/1He,1Hn,1Hd/
C
C     TELL USER WHAT PROGRAM THIS IS
      TYPE 1
    1 FORMAT(' FONT'/
     1' BIT CODES MULTILINE LETTERING FOR CONSTRUCTION BY FROFF')
C
C     ASK USER FOR FILE NAMES AND OPEN FILES
      TYPE 2
    2 FORMAT(19H INPUT FILE NAME = ,$)
      ACCEPT 3,NAMSRC
    3 FORMAT(1A10)
      OPEN(UNIT=IDSK,FILE=NAMSRC,ACCESS='SEQIN')
      TYPE 4
    4 FORMAT(20H OUTPUT FILE NAME = ,$)
      ACCEPT 3,NAMOUT
      OPEN(UNIT=JDSK,FILE=NAMOUT,ACCESS='SEQOUT')
C
C     ASK IF ARE TO GENERATE BLOCK DATA OR SUBROUTINE
    5 TYPE 6
    6 FORMAT(40H SUBROUTINE NAME (NONE IF BLOCK DATA) = ,$)
      ACCEPT 7,LTRSUB
    7 FORMAT(6A1)
C
C     PREPARE FOR FIRST FONT
      READ(IDSK,11)LTRCOM
      KNTFNT=0
      KNTLNG=0
      KNTPAC=0
    8 KNTFNT=KNTFNT+1
C
C     PREPARE TO READ IN FILE
      INITAL=KNTLNG
      IHIGH=0
      ISTORE=0
      IEOF=0
C
C     READ IN NEXT LINE
    9 KNTBFR=0
      L=0
      INIKNO=KNTLNG
      KNTSTR=0
      IF(ISTORE.GT.0)GO TO 25
   10 READ(IDSK,11,END=23)LTRINP
   11 FORMAT(80A1)
      INIPRT=0
   12 INIPRT=INIPRT+1
      IF(INIPRT.GT.LMTWID)GO TO 13
      IF(LTRINP(INIPRT).EQ.LTRSPA)GO TO 12
   13 MAXPRT=LMTWID+1
   14 MAXPRT=MAXPRT-1
      IF(MAXPRT.LT.INIPRT)GO TO 21
      IF(LTRINP(MAXPRT).EQ.LTRSPA)GO TO 14
      J=INIPRT
      DO 16 I=1,4
      IF(J.GT.MAXPRT)GO TO 17
      IF(LTRINP(J).EQ.LTRNXT(I))GO TO 15
      IF(LTRINP(J).EQ.LWRNXT(I))GO TO 15
      GO TO 17
   15 J=J+1
   16 CONTINUE
      IF(J.LE.MAXPRT)GO TO 17
      GO TO 22
   17 J=INIPRT
      DO 19 I=1,3
      IF(J.GT.MAXPRT)GO TO 20
      IF(LTRINP(J).EQ.LTREND(I))GO TO 18
      IF(LTRINP(J).EQ.LWREND(I))GO TO 18
      GO TO 20
   18 J=J+1
   19 CONTINUE
      IF(J.LE.MAXPRT)GO TO 20
      GO TO 23
   20 GO TO 26
   21 IF(KNTBFR.EQ.0)GO TO 10
      IF(KNTLNG.EQ.INITAL)GO TO 35
      GO TO 26
C
C     TEST FOR END OF CURRENT CHARACTER DEFINTIONS
   22 IEOF=-1
      GO TO 24
   23 IEOF=1
   24 IF(KNTBFR.EQ.0)GO TO 48
      IF(KNTLNG.EQ.INITAL)GO TO 35
      GO TO 30
   25 ISTORE=0
   26 INISTR=KNTSTR
      DO 29 I=1,LMTWID
      IF(LTRINP(I).EQ.LTRSPA)GO TO 29
      IF(KNTSTR.EQ.0)GO TO 28
      DO 27 J=1,KNTSTR
      IF(LTRINP(I).NE.LTRSTR(J))GO TO 27
      IF(J.LE.INISTR)INISTR=0
      GO TO 29
   27 CONTINUE
   28 KNTSTR=KNTSTR+1
      LTRSTR(KNTSTR)=LTRINP(I)
   29 CONTINUE
      IF(INISTR.EQ.0)GO TO 32
      IF(INISTR.EQ.KNTSTR)GO TO 32
      ISTORE=1
   30 DO 31 I=1,LMTWID
      KNTBFR=KNTBFR+1
   31 LTRBFR(KNTBFR)=LTRSPA
      L=L+1
      IF(L.LT.IHIGH)GO TO 30
      GO TO 35
   32 DO 33 I=1,LMTWID
      KNTBFR=KNTBFR+1
   33 LTRBFR(KNTBFR)=LTRINP(I)
      IF(KNTLNG.EQ.INITAL)GO TO 34
      L=L+1
      IF(L.LT.IHIGH)GO TO 10
      GO TO 35
   34 IHIGH=IHIGH+1
      IF(IHIGH.LT.MAXHIH)GO TO 10
C
C     FIND HOW FAR NEXT CHARACTER EXTENDS TO RIGHT
   35 IEND=0
   36 LTRCMP=LTRSPA
   37 ISTART=IEND+1
   38 IEND=IEND+1
      I=IEND
   39 IF(I.GT.LMTWID)GO TO 42
      K=I
      DO 40 J=1,IHIGH
      IF(LTRBFR(K).EQ.LTRSPA)GO TO 40
      IF(LTRCMP.EQ.LTRBFR(K))GO TO 41
      IF(LTRCMP.NE.LTRSPA)GO TO 43
      LTRCMP=LTRBFR(K)
      GO TO 38
   40 K=K+LMTWID
      IF(LTRCMP.EQ.LTRSPA)GO TO 37
      I=I+1
      GO TO 39
   41 IEND=I
      GO TO 38
   42 IF(LTRCMP.NE.LTRSPA)GO TO 43
      IF(IEOF.EQ.0)GO TO 9
      GO TO 48
C
C     STORE THE NEW CHARACTER
   43 IEND=IEND-1
      I=INIKNO
   44 I=I+1
      IF(I.GT.KNTLNG)GO TO 45
      IF(LTRCMP.NE.LTRKNO(I))GO TO 44
      GO TO 36
   45 KNTLNG=KNTLNG+1
      LTRKNO(KNTLNG)=LTRCMP
      LENGTH(KNTLNG)=IEND-ISTART+1
   46 K=ISTART
      ISTART=ISTART+1
      I=KNTPAC
      DO 47 J=1,IHIGH
      I=I+1
      IPACKD(I)=2*IPACKD(I)
      IF(LTRBFR(K).NE.LTRSPA)IPACKD(I)=IPACKD(I)+1
   47 K=K+LMTWID
      IF(ISTART.LE.IEND)GO TO 46
      KNTPAC=KNTPAC+IHIGH
      IF((KNTPAC+IHIGH).GT.MAXPAC)GO TO 48
      IF(KNTLNG.LT.MAXLNG)GO TO 36
C
C     ALL READ, FIND MOST COMMON WIDTH TO USE FOR BLANK
C     J      = TOTAL NUMBER OF CHARACTERS HAVING WIDTHS
C              LESS THAN CURRENT TEST WIDTH
C     K      = NUMBER OF CHARACTER WIDTHS MATCHED FOR
C              CURRENT VALUE OF IWIDE
C     L      = SUBSCRIPT IN MATCHING LOOP
C     M      = NUMBER OF CHARACTERS HAVING WIDTH EQUAL TO
C              THE CURRENT TEST WIDTH
C     IWIDE  = TEST WIDTH FOR WHICH THERE HAS BEEN THE
C              MOST MATCHES
C     JWIDE  = TEST WIDTH,  LEFT WITH MAXIMUM WIDTH
   48 JWIDE=0
      J=INITAL
      K=0
   49 JWIDE=JWIDE+1
      IF(JWIDE.GT.LMTWID)GO TO 53
      L=INITAL
      M=0
   50 L=L+1
      IF(L.GT.KNTLNG)GO TO 51
      IF(LENGTH(L).EQ.JWIDE)M=M+1
      GO TO 50
   51 IF(K.GT.M)GO TO 52
      K=M
      IWIDE=JWIDE
   52 J=J+M
      IF(J.LT.KNTLNG)GO TO 49
C
C     CREATE THE BLOCK DATA PROGRAM AS OUTPUT
   53 MAXWID(KNTFNT)=JWIDE
      MSTWID(KNTFNT)=IWIDE
      LOCEND(KNTFNT)=KNTLNG
      ITALL(KNTFNT)=IHIGH
      IF(KNTFNT.GE.LMTFNT)GO TO 54
      IF(IEOF.LT.0)GO TO 8
   54 IF(LTRSUB(1).EQ.LTRSPA)WRITE(JDSK,55)
   55 FORMAT(6X,10HBLOCK DATA)
      IF(LTRSUB(1).NE.LTRSPA)WRITE(JDSK,56)LTRSUB
   56 FORMAT(6X,11HSUBROUTINE ,6A1)
      J=LMTWID
   57 IF(LTRCOM(J).NE.LTRSPA)GO TO 58
      J=J-1
      IF(J.GT.1)GO TO 57
   58 WRITE(JDSK,59),(LTRCOM(I),I=1,J)
   59 FORMAT(1HC,80A1)
      I=KNTPAC
      IF(I.LT.672)I=672
      WRITE(JDSK,60)KNTLNG
   60 FORMAT(
     1'      COMMON/RNOTWE/LTRFNT(',I4,')')
      WRITE(JDSK,61)KNTLNG,
     1KNTFNT,KNTFNT,KNTFNT,KNTFNT,KNTPAC
   61 FORMAT(
     1'      COMMON/RNOTHI/LOCKED,KNTFNT,ICLMNS(',1I4,'),'/
     2'     1ILIMIT(',1I4,'),ILINES(',1I4,'),IMAXMM(',1I4,'),'/
     3'     2ICOMMN(',1I4,'),IPACKD(',1I4,')')
C
C     GENERATE THE DIMENSION STATEMENTS
      CALL DASAVE(-2,-1,53,10,LENGTH,
     1KNTLNG,LTRKNO,KNTLNG,LTRLET,6,JDSK,IERR)
      CALL DASAVE(-2,0,53,10,ITALL ,
     1KNTFNT,LTRKNO,KNTLNG,LTRHIH,6,JDSK,IERR)
      CALL DASAVE(-2,0,53,10,LOCEND,
     1KNTFNT,LTRKNO,KNTLNG,LTRLMT,6,JDSK,IERR)
      CALL DASAVE(-2,0,53,10,MAXWID,
     1KNTFNT,LTRKNO,KNTLNG,LTRMAX,6,JDSK,IERR)
      CALL DASAVE(-2,0,53,10,MSTWID,
     1KNTFNT,LTRKNO,KNTLNG,LTRMNY,6,JDSK,IERR)
      CALL DASAVE(-2,0,53,10,LENGTH,
     1KNTLNG,LTRKNO,KNTLNG,LTRLNG,6,JDSK,IERR)
      CALL DASAVE(-2,0,53,10,IPACKD,
     1KNTPAC,LTRKNO,KNTLNG,LTRPAC,6,JDSK,IERR)
C
C     GENERATE THE EQUIVALENCE STATEMENTS
      CALL DASAVE(2,-1,53,10,LENGTH,
     1KNTLNG,LTRKNO,KNTLNG,LTRLET,6,JDSK,IERR)
      CALL DASAVE(2,0,53,10,ITALL ,
     1KNTFNT,LTRKNO,KNTLNG,LTRHIH,6,JDSK,IERR)
      CALL DASAVE(2,0,53,10,LOCEND,
     1KNTFNT,LTRKNO,KNTLNG,LTRLMT,6,JDSK,IERR)
      CALL DASAVE(2,0,53,10,MAXWID,
     1KNTFNT,LTRKNO,KNTLNG,LTRMAX,6,JDSK,IERR)
      CALL DASAVE(2,0,53,10,MSTWID,
     1KNTFNT,LTRKNO,KNTLNG,LTRMNY,6,JDSK,IERR)
      CALL DASAVE(2,0,53,10,LENGTH,
     1KNTLNG,LTRKNO,KNTLNG,LTRLNG,6,JDSK,IERR)
      CALL DASAVE(2,0,53,10,IPACKD,
     1KNTPAC,LTRKNO,KNTLNG,LTRPAC,6,JDSK,IERR)
C
C     GENERATE THE DATA STATEMENTS
      CALL DASAVE(3,-1,53,10,LENGTH,
     1KNTLNG,LTRKNO,KNTLNG,LTRLET,6,JDSK,IERR)
      CALL DASAVE(3,0,53,10,ITALL ,
     1KNTFNT,LTRKNO,KNTLNG,LTRHIH,6,JDSK,IERR)
      CALL DASAVE(3,0,53,10,LOCEND,
     1KNTFNT,LTRKNO,KNTLNG,LTRLMT,6,JDSK,IERR)
      CALL DASAVE(3,0,53,10,MAXWID,
     1KNTFNT,LTRKNO,KNTLNG,LTRMAX,6,JDSK,IERR)
      CALL DASAVE(3,0,53,10,MSTWID,
     1KNTFNT,LTRKNO,KNTLNG,LTRMNY,6,JDSK,IERR)
      CALL DASAVE(3,0,53,10,LENGTH,
     1KNTLNG,LTRKNO,KNTLNG,LTRLNG,6,JDSK,IERR)
      CALL DASAVE(3,0,53,10,IPACKD,
     1KNTPAC,LTRKNO,KNTLNG,LTRPAC,6,JDSK,IERR)
      WRITE(JDSK,62)KNTFNT
   62 FORMAT(6X,19HDATA KNTFNT,LOCKED/,
     11I3,5H,999/)
      IF(LTRSUB(1).NE.LTRSPA)WRITE(JDSK,63)
   63 FORMAT(6X,6HRETURN)
      WRITE(JDSK,64)
   64 FORMAT(6X,3HEND)
      STOP
      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
