
     PROGRAM MIRACLE_MESSAGE
**
     PROGRAM MIRACLE_MESSAGE     VAX-11 FORTRAN

---------------------------------------------------------*
							  *
     ALAN L. ZIRKLE     NAVAL SURFACE WEAPONS CENTER     *
                        CODE K105			  *
     (703) 663-7815     DAHLGREN, VIRGINIA  22448	  *
							  *
---------------------------------------------------------*

     MIRACLE MESSAGE PRINTING PROGRAM

     PRODUCES HIGHLY-READABLE COMPUTER-OUTPUT MESSAGES
     SUITABLE FOR USE AS WALL-HUNG POSTERS OR SIGNS.
     THE MESSAGES ARE PRINTED IN ROMAN LETTERS, THE
     CAPITALS OF WHICH ARE 2.7 INCHES TALL. THE TEXT
     OF THE MESSAGE IS PRINTED 'DOWN' THE PAGE,
     WITH UP TO FOUR ROWS  OF TEXT PRINTED AT A TIME.
     FOR EXAMPLE, THE LOWER CASE LETTER 'E' WOULD BE

          MMMMMMM        SU1
       MMMMMMMMMMMMM     SU2
      MMMMMMMMMMMMMMM    SU3                      VERTICAL---->
      MMMM    MM  MMMM   SU4
     MMMM     MM    MMM  SU5
     MMM      MM    MMM  SU6    (SU=SCAN UNIT)    HORIZONTAL
     MMM      MM    MMM  SU7                          I
     MMM      MM    MMM  SU8                          I
      MM      MM   MMM   SU9                        \ I /
      MMM     MMMMMMMM   SU10                        \I/
       MMM    MMMMMMM    SU11                         V
        MM    MMMMM      SU12

     UP TO 40 ROWS  OF TEXT CAN BE PRINTED, CONTAINING
     UP TO 1000 LETTERS TOTAL.

     THE PRINTED TEXT CAN CONTAIN ANY OF THE FOLLOWING
     CHARACTERS:

          ALPHABETIC LETTERS, UPPER AND LOWER CASE.

          NUMERALS

          +  -  /  (  )  =  ,  .  !  ?  :  ;

          LEFT AND RIGHT ' AND "  (` IS LEFT SINGLE QUOTE,
				    ~ IS LEFT DOUBLE QUOTE)

     THE FOLLOWING ARE USED AS ESCAPE CHARACTERS:

          #  (NORMAL/OVERPRINT DARKNESS) (DEFAULT NORMAL)

          $  (VERTICAL/ITALIC FONT)     (DEFAULT VERTICAL)

     (EACH IS RESET TO ITS DEFAULT AT THE START OF
     EVERY ROW OF TEXT)

     QUALIFIERS CAN BE USED TO SPECIFY OVERPRINTING
     (/DARKEN) OR CENTERING OF THE ROWS (/CENTER).

     DEFAULTS ARE NON-OVERPRINTED, LEFT-JUSTIFIED ROWS.

     EACH ROW OF TEXT IS SPECIFIED BY ONE INPUT RECORD.
     IF LESS THAN FOUR ROWS OF TEXT ARE REQUESTED, THE
     LINES ARE CENTERED VERTICALLY.

     SEE THE HELP FILE FOR MORE INFORMATION.


     A.L.ZIRKLE     DK-74    (EARLY 1970'S)     (ORIGINAL CDC VERSION)
     A.L.ZIRKLE     K105     MARCH 83           (VAX VERSION)

     IMPLICIT INTEGER (A-Z)

     LOGICAL*4 PRINT,DARKEN,CENTER,PROMPT,LXY,LA120

     COMMON /PAGE/ ROWS,GROWS,POSITN(6),HSIZE,VSIZE,OPRINT
     COMMON /QUAL/ PRINT,DARKEN,CENTER,PROMPT,LXY,LA120

*    PROCESS THE COMMAND LINE.

     CALL VAX_COMMAND

*    READ THE INPUT RECORDS AND BUILD THE 'SPECS' DATA STRUCTURE.

     CALL READ

*    IF 1-3 ROWS OF TEXT, CENTER THEM VERTICALLY ON PRINTED PAGE.

     IF (ROWS.LT.GROWS) THEN

         DO I=1,ROWS

             POSITN(I)=POSITN(I)-(VSIZE-33*ROWS)/2

         ENDDO

     ENDIF

*    HORIZONTALLY CENTER, IF DESIRED, AND PRINT THE ROWS OF TEXT.

     IF (CENTER) CALL CENTER_ROWS

     CALL PRINT_ROWS

     END
     SUBROUTINE VAX_COMMAND

---------------------------------------------------------*
							  *
     ALAN L. ZIRKLE     NAVAL SURFACE WEAPONS CENTER     *
                        CODE K105			  *
     (703) 663-7815     DAHLGREN, VIRGINIA  22448	  *
							  *
---------------------------------------------------------*

     IMPLICIT INTEGER (A-Z)

     CHARACTER QUEUE*64,OUTFILE*128,COPIES*4,INFILE*80
     LOGICAL*4 PRINT,DARKEN,CENTER,PROMPT,LXY,LA120

     COMMON /QUAL/ PRINT,DARKEN,CENTER,PROMPT,LXY,LA120
     COMMON /PAGE/ ROWS,GROWS,POSITN(6),HSIZE,VSIZE,OPRINT
     COMMON /PRNT/ QUEUE,OUTFILE,COPIES
     COMMON /WORK/ INFILE

     DATA GROWS,HSIZE,COPIES / 4,88,'1' /

     CALL CLI$GET_VALUE('P1',INFILE)
     OPEN (5,FILE=INFILE,STATUS='OLD',READONLY,ERR=100)

     CALL VAX_QUALIFIERS

     IF (GROWS.LT.6) THEN
         DO I=1,GROWS
             POSITN(I)=POSITN(I+6-GROWS)
         ENDDO
     ENDIF

     IF (DARKEN) OPRINT=9999999

     VSIZE=GROWS*33

     RECL=VSIZE+1
     IF (LXY) RECL=RECL+1

     OPEN (99,FILE=OUTFILE,DEFAULTFILE='.LIS',STATUS='NEW',
    1						RECL=RECL,ERR=110)

     CALL VAX_INPUT_FILE

     RETURN

 100 CALL ERROR(1)

 110 CALL ERROR(4)

     END
     SUBROUTINE VAX_QUALIFIERS

---------------------------------------------------------*
							  *
     ALAN L. ZIRKLE     NAVAL SURFACE WEAPONS CENTER     *
                        CODE K105			  *
     (703) 663-7815     DAHLGREN, VIRGINIA  22448	  *
							  *
---------------------------------------------------------*

     IMPLICIT INTEGER (A-Z)

     PARAMETER ( CLI$_PRESENT = '3FD19'X )

     CHARACTER QUEUE*64,OUTFILE*128,COPIES*4
     CHARACTER CEQUAL*16,LAQUAL*16
     LOGICAL*4 PRINT,DARKEN,CENTER,PROMPT,LXY,LA120,OUTPUT,COPY
     REAL*4 PAGE_SIZE

     COMMON /QUAL/ PRINT,DARKEN,CENTER,PROMPT,LXY,LA120
     COMMON /PAGE/ ROWS,GROWS,POSITN(6),HSIZE,VSIZE,OPRINT
     COMMON /PRNT/ QUEUE,OUTFILE,COPIES
     COMMON /WORK/ CEQUAL,LAQUAL

*    REMEMBER TO CHANGE THE 'HELP' FILE IF YOU CHANGE ANY DEFAULTS!

     PRINT =CLI$PRESENT('PRINT')
     OUTPUT=CLI$PRESENT('OUTPUT')
     DARKEN=CLI$PRESENT('DARKEN')
     CENTER=CLI$PRESENT('CENTER')
     LXY   =CLI$PRESENT('LXY')
     LA120 =CLI$PRESENT('LA120')
     COPY  =CLI$PRESENT('COPIES')

     IF (PRINT)  CALL CLI$GET_VALUE('PRINT' ,QUEUE)
     IF (OUTPUT) CALL CLI$GET_VALUE('OUTPUT',OUTFILE)
     IF (CENTER) CALL CLI$GET_VALUE('CENTER',CEQUAL)
     IF (LA120)  CALL CLI$GET_VALUE('LA120' ,LAQUAL)
     IF (COPY)   CALL CLI$GET_VALUE('COPIES',COPIES)

*    CHECK FOR INCOMPATIBILITIES AND INCONSISTENCIES.

     IF (LXY.AND.LA120) THEN
         IF (LXY.EQ.LA120) GO TO 110
         LA120=LA120.EQ.CLI$_PRESENT
         LXY=.NOT.LA120
     ENDIF

     IF (PRINT.AND.OUTPUT) THEN
         IF (PRINT.EQ.OUTPUT) GO TO 110
         OUTPUT=OUTPUT.EQ.CLI$_PRESENT
         PRINT=.NOT.OUTPUT
     ELSE
         IF (.NOT.(PRINT.OR.OUTPUT)) GO TO 110
     ENDIF

     IF (LXY .AND. DARKEN   ) GO TO 110
     IF (COPY.AND..NOT.PRINT) GO TO 110

     IF (LA120) THEN
         GROWS=ICHAR(LAQUAL(1:1))-ICHAR('0')
         IF (GROWS.LT.4.OR.GROWS.GT.6) GO TO 120
     ENDIF

     IF (COPY) THEN
         READ (COPIES,1000,ERR=120) COQUAL
         IF (COQUAL.LE.0) GO TO 120
     ENDIF

     IF (CENTER) THEN
         IF (INDEX(CEQUAL,'.').EQ.0) CEQUAL(INDEX(CEQUAL,' '):)='.'
         READ (CEQUAL,1001,ERR=120) PAGE_SIZE
         IF (PAGE_SIZE.LE.0.0) GO TO 120
         HSIZE=PAGE_SIZE*8.
         IF (GROWS.GT.4) HSIZE=PAGE_SIZE*12.	     ! FOR LA120=5ROWS OR 6ROWS
     ENDIF

     RETURN

 110 CALL ERROR(2)

 120 CALL ERROR(3)

1000 FORMAT (BN,I)
1001 FORMAT (BN,F)

     END
     SUBROUTINE VAX_INPUT_FILE

---------------------------------------------------------*
							  *
     ALAN L. ZIRKLE     NAVAL SURFACE WEAPONS CENTER     *
                        CODE K105			  *
     (703) 663-7815     DAHLGREN, VIRGINIA  22448	  *
							  *
---------------------------------------------------------*

     IMPLICIT INTEGER (A-Z)

     PARAMETER ( DVI$_DEVCLASS = '4'X , DC$_TERM = '42'X )

     CHARACTER INFILE*80
     LOGICAL*4 PRINT,DARKEN,CENTER,PROMPT,LXY,LA120
     INTEGER*4 ITMLST(4) / 4*0 /
     EXTERNAL ERROR

     COMMON /QUAL/ PRINT,DARKEN,CENTER,PROMPT,LXY,LA120
     COMMON /WORK/ INFILE

     INQUIRE (5,NAME=INFILE)

     ITMLST(1)=IOR(ISHFT(4,16),DVI$_DEVCLASS)
     ITMLST(2)=%LOC(CLASS)

     COL=INDEX(INFILE,':')

     STATUS=SYS$GETDVI(,,INFILE(1:COL-1),ITMLST,,,,)

     IF (.NOT.STATUS) CALL LIB$STOP(%VAL(STATUS))

     PROMPT = CLASS .EQ. DC$_TERM

     IF (PROMPT) THEN

         OPEN (6,FILE=INFILE(1:COL),STATUS='NEW')
         WRITE (6,100)
         CLOSE (6)

         CALL VAX_CONTROL_C(INFILE(1:COL),ERROR,8)

     ENDIF

 100 FORMAT ('0Enter your message below.  Press CTRL/Z when complete,',
    1        ' CTRL/C to quit:'/'--------------------------')

     END
     SUBROUTINE VAX_CONTROL_C (TERMINAL , ROUTINE , PARAMETER )


     SUBROUTINE VAX_CONTROL_C (TERMINAL , ROUTINE , PARAMETER )

     Sets up linkage for subroutine ROUTINE to get control when a
     CTRL/C is entered on TERMINAL (where TERMINAL is a character
     string containing the physical device name of the terminal).

     Argument ROUTINE must be declared EXTERNAL in the calling
     program.  The value of PARAMETER is passed to ROUTINE.

     4 February 1983

---------------------------------------------------------*
							  *
     ALAN L. ZIRKLE     NAVAL SURFACE WEAPONS CENTER     *
		         CODE K105			  *
     (703) 663-7815	 DAHLGREN, VIRGINIA  22448	  *
							  *
---------------------------------------------------------*


     IMPLICIT INTEGER (A-Z)

     PARAMETER ( IO$_SETMODE = '23'X , IO$M_CTRLCAST = '100'X )

     CHARACTER*(*) TERMINAL
     EXTERNAL ROUTINE

     INTEGER*2 CHAN,IOSB(4)

     STATUS=SYS$ASSIGN(TERMINAL,CHAN,,)

     IF (.NOT.STATUS) CALL LIB$STOP(%VAL(STATUS))

     STATUS=SYS$QIOW(,%VAL(CHAN),%VAL(IO$_SETMODE+IO$M_CTRLCAST),
    1					IOSB,,,ROUTINE,PARAMETER,,,,)

     IF (.NOT.STATUS) CALL LIB$STOP(%VAL(STATUS))

     IF (.NOT.IOSB(1)) CALL LIB$STOP(%VAL(IOSB(1)))

     END
     SUBROUTINE ERROR(ORDINAL)

---------------------------------------------------------*
							  *
     ALAN L. ZIRKLE     NAVAL SURFACE WEAPONS CENTER     *
                        CODE K105			  *
     (703) 663-7815     DAHLGREN, VIRGINIA  22448	  *
							  *
---------------------------------------------------------*

     IMPLICIT INTEGER (A-Z)

     INTEGER*4 VECTOR(10) / 10*0 /

     EXTERNAL MIRACLE_OPENIN  ,MIRACLE_INCOMPAT,MIRACLE_INVALID,
    1         MIRACLE_OPENOUT ,MIRACLE_TOOMANY ,MIRACLE_NOTEXT ,
    2         MIRACLE_OVERFLOW,MIRACLE_ABORTED

     LOGICAL OUTPUT_OPEN

     IF (ORDINAL.EQ.1.OR.ORDINAL.EQ.4) CALL ERRSNS(,RMSSTS,RMSSTV)

     INQUIRE (99,OPENED=OUTPUT_OPEN)

     IF (OUTPUT_OPEN) CLOSE (99,STATUS='DELETE')

     GO TO (1,2,3,4,5,6,7,8),ORDINAL

   1 CALL LIB$STOP(MIRACLE_OPENIN,%VAL(0),%VAL(RMSSTS),%VAL(0),
    1							%VAL(RMSSTV))

   2 CALL LIB$STOP(MIRACLE_INCOMPAT)

   3 CALL LIB$STOP(MIRACLE_INVALID)

   4 CALL LIB$STOP(MIRACLE_OPENOUT,%VAL(0),%VAL(RMSSTS),%VAL(0),
    1							%VAL(RMSSTV))

   5 CALL LIB$STOP(MIRACLE_TOOMANY)

   6 CALL LIB$STOP(MIRACLE_NOTEXT)

   7 CALL LIB$STOP(MIRACLE_OVERFLOW)

   8 CALL LIB$STOP(MIRACLE_ABORTED)

     END
     SUBROUTINE READ
*
     SUBROUTINE READ     VAX-11 FORTRAN     MIRACLE MESSAGE

     PROCESSES THE INPUT RECORDS, BUILDING THE ARRAYS 'SPECS',
     'POINTR', AND 'LENGTH', AND VARIABLES 'PAGES' AND 'ROWS'.


---------------------------------------------------------*
							  *
     ALAN L. ZIRKLE     NAVAL SURFACE WEAPONS CENTER     *
                        CODE K105			  *
     (703) 663-7815     DAHLGREN, VIRGINIA  22448	  *
							  *
---------------------------------------------------------*


     IMPLICIT INTEGER (A-Z)

     CHARACTER*1 CHARS,ISYM,LSYM
     CHARACTER*80 IN
     LOGICAL*4 PRINT,DARKEN,CENTER,PROMPT,LXY,LA120

     COMMON /PAGE/ ROWS,GROWS,POSITN(6),HSIZE,VSIZE,OPRINT
     COMMON /SPEC/ POINTR(40),LENGTH(40),SPECS(2,1000)
     COMMON /CHAR/ CHARS(78),LINKS(78,2),DATA(1004)
     COMMON /QUAL/ PRINT,DARKEN,CENTER,PROMPT,LXY,LA120
     COMMON /WORK/ IN

     ROWS=0
     ISPEC=0

*    READ NEXT RECORD AND START ANOTHER ROW OF TEXT. INITIALIZE TO
     NO OVERPRINTING, NON-ITALIC. IGNORE TRAILING BLANKS ON INPUT
     RECORD.  CREATE A ONE-SU BLANK ENTRY AT START OF ROW FOR
     USE IN HORIZONTAL CENTERING, IF PERFORMED.

   2 READ (5,1000,END=10) IN

     ISPEC=ISPEC+1
     IF (ISPEC.GT.1000) GO TO 100

     SPECS(1,ISPEC)=0
     SPECS(2,ISPEC)=1

     ROWS=ROWS+1
     IF (ROWS.GT.40) CALL ERROR(5)

     LENGTH(ROWS)=0
     POINTR(ROWS)=ISPEC

     OPRNT=0
     ITALIC=0
     LSYM=' '

     ENDCOL=1
     DO 3 ICOL=1,80
   3 IF (IN(ICOL:ICOL).NE.' ') ENDCOL=ICOL

     DO 9 ICOL=1,ENDCOL

*    GET NEXT CHARACTER FROM RECORD.

     ISYM=IN(ICOL:ICOL)

*    IF BLANK, CREATE AN ENTRY FOR A BLANK LETTER WHICH IS 8 SU'S
     LONG.

     IF (ISYM.NE.' ') GO TO 5

     ISPEC=ISPEC+1
     IF (ISPEC.GT.1000) GO TO 100

     SPECS(1,ISPEC)=0
     SPECS(2,ISPEC)=8

     LENGTH(ROWS)=LENGTH(ROWS)+8
     LSYM=' '
     GO TO 9

*    IF DOLLAR SIGN, SWITCH FONTS (ITALIC/VERTICAL). IF END OF
     ITALICS, PAD FINAL ITALIC LETTER WITH TRAILING BLANKS SO
     IT DOESN'T CRASH INTO TOP OF NEXT LETTER OR COME TOO CLOSE
     TO NEXT TEXT WORD, AND DISABLE OVERLAP PROCESSING.

   5 IF (ISYM.NE.'$') GO TO 11
     ITALIC=1-ITALIC
     IF (ITALIC.GT.0) GO TO 9
     SPECS(2,ISPEC)=SPECS(2,ISPEC)+5
     LENGTH(ROWS)=LENGTH(ROWS)+5
     LSYM=' '
     GO TO 9

*    IF POUND SIGN (#), SWITCH DARKNESS (OVERPRINT/NORMAL). HAS NO
     EFFECT IF '/DARK' COMMAND QUALIFIER IS IN EFFECT; IGNORED FOR LXY.

  11 IF (ISYM.NE.'#'.OR.LXY) GO TO 12
     OPRNT=1-OPRNT
     GO TO 9

*    SYMBOL IS NOT AN ESCAPE CHARACTER. IF IT IS NOT IMPLEMENTED,
     IGNORE IT; OTHERWISE, BUILD ITS ENTRY IN 'SPECS' ARRAY,
     INCLUDING A TRAILING TWO-SU INTER-LETTER GAP (WHICH MAY BE
     MODIFIED BY OVERLAP PROCESSING).  THEN, IF PREVIOUS INPUT
     SYMBOL (NOT INCLUDING ESCAPE CHARACTERS) WAS NON-BLANK, PERFORM
     OVERLAP PROCESSING.

  12 DO 6 NSYM=1,78
     IF (ISYM.EQ.CHARS(NSYM)) GO TO 7
   6 CONTINUE

     GO TO 9

   7 LENSYM=LINKS(NSYM,2)

     NEND=LENSYM+2
     NGAP=LENSYM
     NOVL=NEND

     ISPEC=ISPEC+1
     IF (ISPEC.GT.1000) GO TO 100

     SPECS(1,ISPEC)=LINKS(NSYM,1)
     SPECS(2,ISPEC)=NEND+10000*NGAP+1000000*NOVL+100000000*OPRNT+
    1                                             200000000*ITALIC
     LENGTH(ROWS)=LENGTH(ROWS)+NEND

     IF (LSYM.NE.' ') CALL OVRLAP(LSYM,ISYM,ISPEC)
     LSYM=ISYM

   9 CONTINUE

*    END OF AN INPUT RECORD REACHED; THUS, END OF A ROW OF TEXT. BUILD
     SPECIAL 'END-OF-ROW' ENTRY IN 'SPECS' ARRAY; THEN GET NEXT RECORD.

     ISPEC=ISPEC+1
     IF (ISPEC.GT.1000) GO TO 100

     SPECS(1,ISPEC)=-10000
     SPECS(2,ISPEC)=-10000

     IF (ITALIC.GT.0) LENGTH(ROWS)=LENGTH(ROWS)+5
     GO TO 2

*    LAST RECORD PROCESSED; HALT IF NO INPUT FOUND, ELSE RETURN.

  10 IF (ROWS.LE.0) CALL ERROR(6)
     RETURN

 100 CALL ERROR(7)

1000 FORMAT (A)

     END
     SUBROUTINE OVRLAP(LSYM,ISYM,ISPEC)
*
     SUBROUTINE OVRLAP     VAX-11 FORTRAN     MIRACLE MESSAGE

     CHECKS FOR POSSIBLE 'OVERLAPS', I.E. CONTIGUOUS TEXT
     LETTERS WHICH CAN BE 'SQUEEZED' TOGETHER TO ELIMINATE
     EXCESS SPACE WHICH GIVES AN UNAESTHETIC UNEVEN APPEARANCE.
     SUCH AN EXCESS SPACE OCCURS BETWEEN THE CAPITAL LETTERS
     'A' AND 'V', FOR INSTANCE.  DIFFERENT PAIRS OF LETTERS
     CAN BE OVERLAPPED BY DIFFERENT AMOUNTS; MOST PAIRS CANNOT
     BE OVERLAPPED AT ALL.  OTHER PAIRS OCCUR SO INFREQUENTLY
     THAT IT IS NOT WORTH CHECKING FOR THEM.  THE ARRAY 'PAIRS'
     CONTAIN THE KNOWN RELEVANT PAIRS WHICH CAN BE OVERLAPPED;
     IT MAY NOT BE COMPLETE.


---------------------------------------------------------*
							  *
     ALAN L. ZIRKLE     NAVAL SURFACE WEAPONS CENTER     *
                        CODE K105			  *
     (703) 663-7815     DAHLGREN, VIRGINIA  22448	  *
							  *
---------------------------------------------------------*


     IMPLICIT INTEGER (A-Z)

     CHARACTER*1 LSYM,ISYM
     CHARACTER*2 PAIRS,PAIR

     COMMON /SPEC/ POINTR(40),LENGTH(40),SPECS(2,1000)
     COMMON /PAGE/ ROWS,GROWS,POSITN(6),HSIZE,VSIZE,OPRINT
     COMMON /PAIR/ PAIRS(490)

*    CONVERT INPUT (LSYM,ISYM) INTO 'PAIR' WHICH IS IN FORMAT OF
     'PAIRS' ARRAY.

     PAIR = LSYM // ISYM

*    IF 'PAIR' IS NOT IN 'PAIRS' ARRAY THEN RETURN; NO OVERLAP
     IS POSSIBLE.

     DO 1 I=1,490
     IF (PAIR.EQ.PAIRS(I)) GO TO 2
   1 CONTINUE

     RETURN

*    COMPUTE OVERLAP AMOUNT (1-5) FROM POSITION OF 'PAIR' IN
     'PAIRS' ARRAY.

   2 IF (I.LE.225) THEN
         OVLAP=1
     ELSE IF (I.LE.358) THEN
         OVLAP=2
     ELSE IF (I.LE.442) THEN
         OVLAP=3
     ELSE IF (I.LE.478) THEN
         OVLAP=4
     ELSE
         OVLAP=5
     ENDIF

*    ENTER THE DATA NECESSARY TO PERFORM THE OVERLAP INTO THE
     'SPECS' ARRAY ENTRY OF THE FIRST LETTER OF THE PAIR (I.E. THE
     PREVIOUS INPUT SYMBOL).

     IOVLAP=OVLAP*1000000+MIN0(OVLAP,2)
     SPECS(2,ISPEC-1)=SPECS(2,ISPEC-1)-IOVLAP
     LENGTH(ROWS)=LENGTH(ROWS)-OVLAP
     RETURN

     END
     SUBROUTINE CENTER_ROWS
*
     SUBROUTINE CENTER_ROWS     VAX-11 FORTRAN     MIRACLE MESSAGE

     HORIZONTALLY CENTERS THE ROWS OF TEXT WITH RESPECT TO EACH
     OTHER, BY EXPANDING THE ONE-SU BLANK ENTRY AT THE START OF
     EACH ROW TO THE AMOUNT NECESSARY TO CENTER THE ROW.

     FIRST, THE LONGEST ROW IS FOUND, AND IT IS CENTERED BETWEEN
     PAGE PERFORATIONS, ALLOWING AT LEAST A ONE INCH LEFT/RIGHT
     MARGIN BETWEEN PERFORATIONS AND TEXT.  THEN, ALL OTHER ROWS
     ARE CENTERED WITH RESPECT TO THIS ROW.


---------------------------------------------------------*
							  *
     ALAN L. ZIRKLE     NAVAL SURFACE WEAPONS CENTER     *
                        CODE K105			  *
     (703) 663-7815     DAHLGREN, VIRGINIA  22448	  *
							  *
---------------------------------------------------------*


     IMPLICIT INTEGER (A-Z)

     COMMON /SPEC/ POINTR(40),LENGTH(40),SPECS(2,1000)
     COMMON /PAGE/ ROWS,GROWS,POSITN(6),HSIZE,VSIZE,OPRINT

     DATA LTOP / 6 /

     MAXLEN=0
     DO 1 I=1,ROWS
   1 MAXLEN=MAX(MAXLEN,LENGTH(I))

     LRSPA=HSIZE-MOD(MAXLEN,HSIZE)
     IF (LRSPA.LT.20) LRSPA=LRSPA+HSIZE
     LRSPA=LRSPA/2-LTOP

     DO 2 I=1,ROWS
     IBIAS=(MAXLEN-LENGTH(I))/2
     ISPEC=POINTR(I)
   2 SPECS(2,ISPEC)=IBIAS+LRSPA

     END
     SUBROUTINE PRINT_ROWS
*
     SUBROUTINE PRINT_ROWS     VAX-11 FORTRAN     MIRACLE MESSAGE

     PRINTS THE TEXT USING THE DATA FROM THE ARRAYS 'SPECS',
     'POINTR', AND 'DATA' AND FROM VARIABLES 'PAGES', 'ROWS',
     AND 'OPRINT'.  THE PRINTER SHOULD BE SET TO PRINT AT
     EIGHT LINES PER INCH.


---------------------------------------------------------*
							  *
     ALAN L. ZIRKLE     NAVAL SURFACE WEAPONS CENTER     *
                        CODE K105			  *
     (703) 663-7815     DAHLGREN, VIRGINIA  22448	  *
							  *
---------------------------------------------------------*


     IMPLICIT INTEGER (A-Z)

     PARAMETER ( line_size = 33*6 , buf_size = line_size*8 )

     CHARACTER*1 CHARS
     CHARACTER*(buf_size) OUT,PUT

     COMMON /PAGE/ ROWS,GROWS,POSITN(6),HSIZE,VSIZE,OPRINT
     COMMON /SPEC/ POINTR(40),LENGTH(40),SPECS(2,1000)
     COMMON /CHAR/ CHARS(78),LINKS(78,2),DATA(1004)
     COMMON OUT,PUT

     CHARACTER*1 BLACK / 'M' /, BLAKK / 'W' /

*    PRINT GROUPS OF FOUR ROWS OF TEXT AT A TIME (EXCEPT FINAL
     GROUP, WHICH MAY HAVE 1-4 ROWS).  (FOR LA120, GROUPS MAY HAVE
     UP TO SIX ROWS.)

     CALL PRINT_START

     DO 80 GROUP=1,(ROWS+GROWS-1)/GROWS

*    AT START OF EACH GROUP, INITIALIZE THE OUTPUT ARRAYS TO BLANKS.
     COMPUTE THE ROW NUMBERS IN THIS GROUP.  SET ITALICS OFF; OVER-
     PRINTING IS SET IN MAIN PROGRAM.

     OUT=' '
     PUT=' '

     JROW=GROWS*(GROUP-1)+1
     KROW=MIN(JROW+GROWS-1,ROWS)
     ISLANT=0
     DONE=0

*    PROCESS ONE SU (ONE PRINT LINE) OF ALL THE TEXT ROWS IN THIS
     THIS GROUP.

  10 I=1
     DO 70 IROW=JROW,KROW

*    IF ROW WAS NOT ALREADY COMPLETED, GET DATA TO PROCESS NEXT
     SU OF ROW.

     ISPEC=POINTR(IROW)
     IF (ISPEC.LE.0) GO TO 70

     N=SPECS(1,ISPEC)/10000
     LOCATN=MOD(SPECS(1,ISPEC),10000)
     NEND=MOD(SPECS(2,ISPEC),10000)
     NGAP=MOD(SPECS(2,ISPEC)/10000,100)
     NOVL=MOD(SPECS(2,ISPEC)/1000000,100)
     OPRNT=MOD(SPECS(2,ISPEC)/100000000,2)
     ITALIC=MOD(SPECS(2,ISPEC)/200000000,2)

*    IF END-OF-ROW FOUND, SET COMPLETION INDICATORS. IF ALL ROWS
     IN GROUP ARE FINISHED, EXIT TO END-OF-GROUP CODING.

     IF (N.GE.0) GO TO 30

     DONE=DONE+1
     IF (DONE.GE.KROW-JROW+1) GO TO 75
     POINTR(IROW)=0
     GO TO 70

*    PROCESS A SU OF A LETTER. BRANCH IF BLANK LETTER OR IF INTER-
     LETTER GAP REACHED; OTHERWISE GET BIT STRING TO PRINT THIS SU.

  30 IF (N.GE.NGAP) GO TO 60
     BITS=DATA(LOCATN)

*    BRANCH IF NOT IN OVERLAP SITUATION. OTHERWISE, GET BIT STRING
     FOR SU OF SECOND CHARACTER OF PAIR, AND COMBINE THE TWO. ALSO,
     INCREMENT SECOND CHARACTER'S VALUES OF 'N' AND 'LOCATN'.

     IF (N.LT.NOVL) GO TO 40
     LOCATN=MOD(SPECS(1,ISPEC+1),10000)
     BITS=BITS+DATA(LOCATN)
     SPECS(1,ISPEC+1)=SPECS(1,ISPEC+1)+10001

*    GET STARTING PRINT COLUMN FOR OUTPUT OF SU AND ENTER LOOP TO
     PROCESS EACH BIT IN THE BIT STRING. FOR BITS WHICH ARE OFF
     (ZERO), DON'T PRINT ANYTHING.

  40 ICOL=POSITN(I)+32
     DO 50 J=1,32
     ICOL=ICOL-1
     IF (IAND(BITS,1).EQ.0) GO TO 50

*    FOR NON-ZERO BITS, IF NON-ITALIC THEN PUT A CHARACTER IN THIS
     PRINT LINE POSITION. IF OVERPRINTING, PUT CHARACTER IN THIS
     OVERPRINT LINE POSITION.

     IF (ITALIC.GT.0) GO TO 45
     OUT(ICOL:ICOL)=BLACK
     OPRINT=MAX0(OPRINT,OPRNT)
     IF (OPRINT.GT.0) PUT(ICOL:ICOL)=BLAKK
     GO TO 50

*    FOR ITALIC LETTERS, COMPUTE POSITION FOR CHARACTER IN THE
     PRINT LINE BUFFER, BASED ON THE SLOPING FACTOR OF THE ITALIC
     FONT (4 TO 1). SET 'ISLANT' AND 'OPRINT' SO THAT BUFFER WILL
     BE EMPTIED IF ROW ENDS WITH AN ITALIC LETTER. IF OVERPRINTING,
     PUT CHARACTER IN PROPER OVERPRINT LINE BUFFER POSITION.

  45 JCOL=((32-J)/4)*VSIZE+ICOL
     OUT(JCOL:JCOL)=BLACK
     ISLANT=8
     OPRINT=MAX0(OPRINT,OPRNT*8)
     IF (OPRINT.GT.0) PUT(JCOL:JCOL)=BLAKK

*    PREPARE TO PROCESS NEXT BIT OF THIS SU OF LETTER.

  50 BITS=BITS/2

*    THIS SU OF LETTER DONE; PREPARE DATA TO ACCESS NEXT SU OF
     LETTER. IF LETTER COMPLETE, GO TO NEXT LETTER. THEN DO REST
     OF ROWS IN GROUP.

  60 SPECS(1,ISPEC)=SPECS(1,ISPEC)+10001
     IF (N+1.GE.NEND) POINTR(IROW)=POINTR(IROW)+1

  70 I=I+1

*    ONE PRINT LINE IS COMPLETE; PRINT IT, PRINT OVERPRINT LINE
     IF NECESSARY, DECREMENT FLAGS FOR NEXT PRINT LINE. SHIFT
     THE PRINT LINE BUFFERS FOR PROPER ITALIC PROCESSING, AND
     BLANK THE LAST LINE IN BUFFER. THEN GO PROCESS THE NEXT
     PRINT LINE.

     CALL PRINT_LINE(OUT(1:VSIZE),PUT(1:VSIZE),OPRINT)
     OPRINT=OPRINT-1
     ISLANT=ISLANT-1

     OUT=OUT(VSIZE+1:)
     PUT=PUT(VSIZE+1:)

     GO TO 10

*    END-OF-GROUP ENCOUNTERED. IF LONGEST ROW IN GROUP ENDED WITH
     AN ITALIC LETTER, THE PRINT LINE BUFFERS WILL CONTAIN DATA;
     PRINT IT. THEN DO REST OF GROUPS, THEN RETURN.

  75 IF (ISLANT.LE.0) GO TO 80

     DO I=1,ISLANT
         J=(I-1)*VSIZE
         CALL PRINT_LINE(OUT(J+1:J+VSIZE),PUT(J+1:J+VSIZE),OPRINT)
     ENDDO

     OPRINT=OPRINT-7

  80 WRITE (99,1000)

     CALL PRINT_FINISH

1000 FORMAT ('1')

     END
     SUBROUTINE PRINT_LINE(STRING1,STRING2,OPRINT)

---------------------------------------------------------*
							  *
     ALAN L. ZIRKLE     NAVAL SURFACE WEAPONS CENTER     *
                        CODE K105			  *
     (703) 663-7815     DAHLGREN, VIRGINIA  22448	  *
							  *
---------------------------------------------------------*

     IMPLICIT INTEGER (A-Z)

     CHARACTER*(*) STRING1,STRING2
     CHARACTER*1 LXY_8LPI / 6 /

     LOGICAL*4 PRINT,DARKEN,CENTER,PROMPT,LXY,LA120

     COMMON /QUAL/ PRINT,DARKEN,CENTER,PROMPT,LXY,LA120

     L=LEN(STRING1)

  10 IF (STRING1(L:L).NE.' ') GO TO 20
     L=L-1
     IF (L.GT.1) GO TO 10

  20 IF (LXY) THEN

         WRITE (99,1000) LXY_8LPI // STRING1(1:L)

     ELSE

         WRITE (99,1000) STRING1(1:L)

         IF (OPRINT.GT.0) WRITE (99,1001) STRING2(1:L)

     ENDIF

1000 FORMAT (1X,A)
1001 FORMAT ('+',A)

     END
     SUBROUTINE PRINT_START

---------------------------------------------------------*
							  *
     ALAN L. ZIRKLE     NAVAL SURFACE WEAPONS CENTER     *
                        CODE K105			  *
     (703) 663-7815     DAHLGREN, VIRGINIA  22448	  *
							  *
---------------------------------------------------------*

     IMPLICIT INTEGER (A-Z)

     CHARACTER*1 ESC / 27 /
     LOGICAL*4 PRINT,DARKEN,CENTER,PROMPT,LXY,LA120

     COMMON /QUAL/ PRINT,DARKEN,CENTER,PROMPT,LXY,LA120
     COMMON /PAGE/ ROWS,GROWS,POSITN(6),HSIZE,VSIZE,OPRINT

     IF (LA120) THEN
         IF (GROWS.EQ.4) WRITE (99,1000) '1'//ESC//'[2z'//ESC//'[1w'
         IF (GROWS.EQ.5) WRITE (99,1000) '1'//ESC//'[3z'//ESC//'[3w'
         IF (GROWS.EQ.6) WRITE (99,1000) '1'//ESC//'[3z'//ESC//'[4w'
         WRITE (99,1000) ' '//ESC//'[1;66r'
     ELSE
         WRITE (99,1000) '1'
     ENDIF

1000 FORMAT (A)

     END
     SUBROUTINE PRINT_FINISH

---------------------------------------------------------*
							  *
     ALAN L. ZIRKLE     NAVAL SURFACE WEAPONS CENTER     *
                        CODE K105			  *
     (703) 663-7815     DAHLGREN, VIRGINIA  22448	  *
							  *
---------------------------------------------------------*

     IMPLICIT INTEGER (A-Z)

     CHARACTER QUEUE*64,OUTFILE*128,COPIES*4,COMMAND*80
     CHARACTER*1 ESC / 27 /
     LOGICAL*4 PRINT,DARKEN,CENTER,PROMPT,LXY,LA120

     COMMON /QUAL/ PRINT,DARKEN,CENTER,PROMPT,LXY,LA120
     COMMON /PRNT/ QUEUE,OUTFILE,COPIES
     COMMON /WORK/ COMMAND

     IF (LA120) WRITE (99,1000) '1'//ESC//'[1z'//ESC//'[1w'//
    1							ESC//'[4;63r'

     IF (.NOT.PRINT) RETURN

     INQUIRE (99,NAME=OUTFILE)

     CLOSE (99)

     CALL STR$TRIM(OUTFILE,OUTFILE,FLEN)

     COMMAND = 'PRIN/DEL/NOFEED '
     CLEN=16

     IF (QUEUE.NE.'SYS$PRINT') THEN
         CALL STR$TRIM(QUEUE,QUEUE,QLEN)
         COMMAND(CLEN:) = '/QUE=' // QUEUE(1:QLEN) // ' '
         CLEN=CLEN+QLEN+5
     ENDIF

     IF (COPIES.NE.'1') THEN
         CALL STR$TRIM(COPIES,COPIES,QLEN)
         COMMAND(CLEN:) = '/COP=' // COPIES(1:QLEN) // ' '
         CLEN=CLEN+QLEN+5
     ENDIF

     CALL LIB$DO_COMMAND(COMMAND(1:CLEN)//OUTFILE(1:FLEN))

1000 FORMAT (A)

     END
     BLOCK DATA

---------------------------------------------------------*
							  *
     ALAN L. ZIRKLE     NAVAL SURFACE WEAPONS CENTER     *
                        CODE K105			  *
     (703) 663-7815     DAHLGREN, VIRGINIA  22448	  *
							  *
---------------------------------------------------------*


     DESCRIPTION OF VARIABLE NAMES     MIRACLE MESSAGE

  CHARS(78)----LIST OF LETTERS WHICH CAN BE USED IN POSTERS.

  LINKS(78,2)--POINTERS TO DATA FOR PRINTING EACH AVAILABLE LETTER
		(SEE 'CHARS').  THE POINTERS, IN THE FIRST COLUMN, POINT
		TO ELEMENTS OF ARRAY 'DATA'.  THE SECOND COLUMN GIVES
		THE NUMBER OF SU'S IN THE CHARACTER.

  DATA(1004)---BIT STRINGS FOR PRODUCING EACH SU OF EACH LETTER.
               ACCESSED VIA POINTERS IN ARRAY 'LINKS'. RIGHTMOST BIT IS
               TOP OF LETTER.  31 BITS ARE USED (MAX CHAR HEIGHT 27 PLUS
               4 FOR DESCENDER AS IN LOWER CASE G,P,Q,Y, ETC.) TO SPEC-
               IFY THE CONTENTS OF EACH SCAN UNIT (SU). EACH WORD IN THE
               ARRAY SPECIFIES ONE SU OF ONE LETTER.

  LENGTH(40)---THE LENGTH OF EACH ROW OF TEXT, IN SCAN UNITS (SU'S).
               USED FOR HORIZONTAL CENTERING WHEN '/CENTER' IS USED.

  PAIRS(490)---LIST OF PAIRS OF CHARACTERS WHICH CAN BE 'OVERLAPPED'
               TOGETHER TO ELIMINATE UNESTHETICAL EXCESS WHITE SPACE.
               EACH ELEMENT SPECIFIES ONE PAIR, AS:
                 BYTE 1 -- LEFT LETTER
                 BYTE 2 -- RIGHT LETTER
               ARRAYS R0 AND R1 CONTAIN PAIRS WHICH CAN BE OVERLAPPED
               ONE UNIT; R2 THRU R5 FOR OVERLAPPING 2-5 UNITS.

  POSITN(6)----PRINTER COLUMN WHERE EACH ROW OF TEXT STARTS ON THE
               PRINTED PAGE.  ONLY 'GROWS' ELEMENTS ARE USED.

  POINTR(40)---POINTS TO CURRENT ELEMENT OF ARRAY 'SPECS' BEING
               PROCESSED (PRINTED) FOR EACH ROW OF TEXT.

 SPECS(2,1000)-CONTAINS DATA NEEDED TO PRINT ALL ROWS OF TEXT.
               ACCESSED VIA ARRAY 'POINTR'. CONTAINS ONE TWO-WORD
               ELEMENT FOR EACH LETTER IN THE TEXT, PLUS SPECIAL
               ENTRIES FOR BLANKS AND END-OF-ROW. CONTAINS THE
               FOLLOWING FIELDS:

        N------CURRENT SU BEING PROCESSED FOR THIS LETTER (INIT 0).

        LOCATN-POINTER TO BIT STRING IN ARRAY 'DATA' FOR CURRENT
               SU OF THIS LETTER.

        NEND---NUMBER OF SU'S IN THIS LETTER (INCLUDING 2 BLANK SU'S
               AFTER LETTER IF NO OVERLAP).

        NGAP---NUMBER OF SU'S IN THIS LETTER NOT INCLUDING TRAILING
               BLANKS FOR INTER-LETTER GAP.    (USUALLY NGAP=NEND-2)

        NOVL---NUMBER OF SU'S IN THIS LETTER WHICH ARE NOT OVERLAPPED
               WITH THE FOLLOWING LETTER(NOVL=NEND UNLESS OVERLAP).

        OPRNT--FLAG TO INDICATE OVERPRINTING OF THIS LETTER.

        ITALIC-FLAG TO INDICATE ITALICIZING OF THIS LETTER.

               (FOR BLANK LETTER, NGAP=0 AND NEND=LENGTH OF SPACE)

               (FOR END-OF-ROW, N<0)

  OUT*1584-----OUT(1:132) ARE THE CHARACTERS IN THE CURRENT PRINT LINE
		BEING CREATED (GOES UP TO 198 FOR /LA120=6ROWS).  CHAR-
		ACTERS ARE EITHER BLANK OR TAKEN FROM VARIABLE 'BLACK'
		(CURRENTLY 'M').  THE REST OF 'OUT' IS USED ONLY WHEN
		ITALIC LETTERS ARE BEING CREATED, AND IT CONTAINS THE
		SEVEN SUCCEEDING PRINT LINES.

  PUT*1584-----SAME AS 'OUT' EXCEPT USED ONLY WHEN OVERPRINTING IS IN
		EFFECT.  CHARACTERS ARE BLANK WHEN NO OVERPRINTING IS
		TO BE DONE, OR ARE TAKEN FROM VARIABLE 'BLAKK' (CURR-
               RENTLY 'W').

  ROWS---------NUMBER OF ROWS OF TEXT TO BE CREATED.

  GROWS--------NUMBER OF ROWS OF TEXT IN A GROUP, I.E. NUMBER THAT CAN
		BE PRINTED AT A TIME.  THIS IS 4 UNLESS /LA120=5ROWS OR
		6ROWS IS SPECIFIED, IN WHICH CASE IT IS 5 OR 6.

  OPRINT-------OVERPRINT INDICATOR. IF>0 THEN OVERPRINT THAT MANY
               PRINT LINES, INCLUDING THE CURRENT ONE.

  ISLANT-------ITALIC INDICATOR. IF>0 THEN ITALIC MODE (USE OF ARRAYS
               'OUTS' AND 'PUTS') IS IN EFFECT FOR THAT MANY PRINT
               LINES.

  LPI----------LINES PER INCH OF PRINTER (SHOULD BE 8).

  LTOP---------LINE ON PRINTED PAGE ON WHICH FORTRAN CARRIAGE CONTROL
               CHARACTER '1' POSITIONS (CURRENTLY LINE 6 OF PAGE).

  MAXLEN-------LENGTH OF LONGEST ROW OF TEXT, IN SU'S.

  LRSPA--------NUMBER OF BLANK PRINT LINES NECESSARY BEFORE
               BEGINNING OF TEXT IN ORDER TO HORIZONTALLY
               CENTER THE LONGEST ROW OF TEXT BETWEEN PAGE
               PERFORATIONS.

  IBIAS--------NUMBER OF BLANK SU'S NEEDED TO HORIZONTALLY
               CENTER A LINE OF TEXT WITH RESPECT TO LONGEST LINE.

  ENDCOL-------LAST NON-BLANK COLUMN ON AN INPUT RECORD. (TRAILING
               BLANKS ARE IGNORED; THEY MAY BE MADE SIGNIFICANT BY
               FOLLOWING THEM WITH AN ASTERISK.)

  ISYM---------CURRENT LETTER IN INPUT SPECIFICATIONS.

  LSYM---------PREVIOUS LETTER IN INPUT SPECIFICATIONS. INITIALLY
               BLANK.  SET TO BLANK WHEN CHANGE FROM ITALIC TO
               VERTICAL TAKES PLACE, TO PREVENT RUNNING TOGETHER
               OF TOPS OF TWO CHARACTERS.

  ISPEC--------CURRENT POSITION IN 'SPECS' ARRAY.

  LENSYM-------LENGTH OF CURRENT INPUT LETTER, IN SU'S.

  NSYM---------POSITION OF CURRENT INPUT LETTER IN 'CHARS' ARRAY.

  PAIR---------CURRENT/PREVIOUS INPUT LETTER PAIR, IN FORMAT OF
               'PAIRS' ARRAY ELEMENTS.

  OVLAP--------AMOUNT OF OVERLAP POSSIBLE (1-5 SU'S) BETWEEN
               ELEMENTS OF 'PAIR'.

  DONE---------NUMBER OF ROWS, IN CURRENT GROUP OF ROWS, WHICH
               HAVE BEEN COMPLETELY PRINTED.

  BITS---------BIT STRING FOR CURRENT SU OF CURRENT LETTER OF
               CURRENT LINE OF TEXT BEING PRINTED.

  JROW---------FIRST TEXT ROW IN CURRENT 'PAGE' BEING PRINTED

  KROW---------FINAL TEXT ROW IN CURRENT 'PAGE' BEING PRINTED

  IROW---------CURRENT TEXT ROW BEING PRINTED.

  HSIZE--------NUMBER OF PRINT LINES BETWEEN PERFORATIONS.  FOR
		11-INCH PAPER, THIS IS 88, EXCEPT FOR /LXY=5ROWS
		6ROWS, IN WHICH CASE IT IS 132.

  VSIZE--------NUMBER OF PRINT COLUMNS USED FOR ONE PRINT LINE
		IN STRINGS 'OUT' AND 'PUT'.  THIS IS 132 EXCEPT
		FOR /LXY=5ROWS (165) AND /LXY=6ROWS (198).

  PRINT--------TRUE IF /PRINT QUALIFIER IS IN EFFECT.

  DARKEN-------TRUE IF /DARKEN QUALIFIER IS IN EFFECT.

  CENTER-------TRUE IF /CENTER QUALIFIER IS IN EFFECT.

  PROMPT-------TRUE IF INPUT IS DIRECTLY FROM A TERMINAL KEYBOARD.

  LXY----------TRUE IF /LXY QUALIFIER IS IN EFFECT.

  LA120--------TRUE IF /LA120 QUALIFIER IS IN EFFECT.


---------------------------------------------------------*
							  *
     ALAN L. ZIRKLE     NAVAL SURFACE WEAPONS CENTER     *
                        CODE K105			  *
     (703) 663-7815     DAHLGREN, VIRGINIA  22448	  *
							  *
---------------------------------------------------------*


     IMPLICIT INTEGER (A-Z)

     CHARACTER*1 CHARS,A(78)
     CHARACTER*2 R0,R1,R2,R3,R4,R5

     INTEGER B(78),C(78)
     INTEGER AA(137),AB(149),AC(142),AD(150),AE(166),AF(154),AG(106)
     INTEGER Z1(5,16),Z2(5,16),Z3(5,16),Z4(5,2)

     COMMON /CHAR/ CHARS(78),LINKS(78,2),DATA(1004)
     COMMON /PAGE/ ROWS,GROWS,POSITN(6),HSIZE,VSIZE,OPRINT
     COMMON /PAIR/ R0(96),R1(129),R2(133),R3(84),R4(36),R5(12)

     EQUIVALENCE (CHARS,A),(LINKS(1,1),B),(LINKS(1,2),C)

     EQUIVALENCE (DATA,AA),(DATA(138),AB),(DATA(287),AC),
    1    (DATA(429),AD),(DATA(579),AE),(DATA(745),AF),(DATA(899),AG)

     DATA POSITN / 166,133,100,67,34,1 /

DATA (A(I),B(I),C(I),I=1,16) /	'a' , 001 , 13 ,
1				'b' , 014 , 13 ,
2				'c' , 027 , 12 ,
3				'd' , 039 , 13 ,
4				'e' , 052 , 12 ,
5				'f' , 064 , 09 ,
6				'g' , 073 , 13 ,
7				'h' , 086 , 13 ,
8				'i' , 099 , 06 ,
9				'j' , 105 , 09 ,
1				'k' , 114 , 13 ,
2				'l' , 127 , 06 ,
3				'm' , 133 , 19 ,
4				'n' , 152 , 13 ,
5				'o' , 165 , 12 ,
6				'p' , 177 , 13 /
DATA (A(I),B(I),C(I),I=17,32) /	'q' , 190 , 13 ,
1				'r' , 203 , 11 ,
2				's' , 214 , 11 ,
3				't' , 225 , 09 ,
4				'u' , 234 , 13 ,
5				'v' , 247 , 13 ,
6				'w' , 260 , 17 ,
7				'x' , 277 , 13 ,
8				'y' , 290 , 12 ,
9				'z' , 302 , 11 ,
1				'A' , 313 , 17 ,
2				'B' , 330 , 16 ,
3				'C' , 346 , 15 ,
4				'D' , 361 , 17 ,
5				'E' , 378 , 15 ,
6				'F' , 393 , 14 /
DATA (A(I),B(I),C(I),I=33,48) /	'G' , 407 , 17 ,
1				'H' , 424 , 15 ,
2				'I' , 439 , 07 ,
3				'J' , 446 , 13 ,
4				'K' , 459 , 17 ,
5				'L' , 476 , 15 ,
6				'M' , 491 , 23 ,
7				'N' , 514 , 16 ,
8				'O' , 530 , 16 ,
9				'P' , 546 , 16 ,
1				'Q' , 562 , 16 ,
2				'R' , 578 , 19 ,
3				'S' , 597 , 13 ,
4				'T' , 610 , 14 ,
5				'U' , 624 , 17 ,
6				'V' , 641 , 15 /
DATA (A(I),B(I),C(I),I=49,64) /	'W' , 656 , 22 ,
1				'X' , 678 , 17 ,
2				'Y' , 695 , 17 ,
3				'Z' , 712 , 18 ,
4				'0' , 730 , 16 ,
5				'1' , 746 , 07 ,
6				'2' , 753 , 15 ,
7				'3' , 768 , 15 ,
8				'4' , 783 , 16 ,
9				'5' , 799 , 15 ,
1				'6' , 814 , 14 ,
2				'7' , 828 , 14 ,
3				'8' , 842 , 15 ,
4				'9' , 857 , 14 ,
5				'+' , 871 , 13 ,
6				'-' , 884 , 13 /
DATA (A(I),B(I),C(I),I=65,78) /	'/' , 897 , 15 ,
1				'(' , 912 , 08 ,
2				')' , 920 , 08 ,
3				'=' , 928 , 13 ,
4				',' , 941 , 04 ,
5				'.' , 945 , 04 ,
6				'''', 949 , 04 ,    ! SEE NOTE BELOW
7				'`' , 953 , 04 ,    ! SEE NOTE BELOW
8				'!' , 957 , 06 ,
9				':' , 963 , 04 ,
1				'"' , 967 , 10 ,    ! SEE NOTE BELOW
2				'~' , 977 , 10 ,    ! SEE NOTE BELOW
3				'?' , 987 , 14 ,
4				';' ,1001 , 04 /

     NOTE ON SINGLE QUOTES -- USE ` AT BEGINNING, ' AT END.
     NOTE ON DOUBLE QUOTES -- USE ~ AT BEGINNING, " AT END.

     DATA R0 /  'at' , 'au' , 'a''', 'a"' , 'b''', 'b"' , 'b?' , 'c)' ,
    1           'e)' , 'e''', 'e"' , 'fa' , 'fd' , 'fg' , 'fm' , 'fn' ,
    2           'fo' , 'fp' , 'fq' , 'fr' , 'fs' , 'fu' , 'fv' , 'fw' ,
    3           'fx' , 'fy' , 'fz' , 'ht' , 'hu' , 'hv' , 'hw' , 'h''',
    4           'h"' , 'k?' , 'mt' , 'mu' , 'mv' , 'mw' , 'm''', 'm"' ,
    5           'nt' , 'nu' , 'nv' , 'nw' , 'n''', 'n"' , 'ox' , 'o''',
    6           'o"' , 'pj' , 'p,' , 'p.' , 'p''', 'p"' , 'r?' , 's)' ,
    7           's''', 's"' , 's?' , 'tu' , 'tv' , 'tw' , 'ty' , 't''',
    8           't"' , 'va' , 'vc' , 've' , 'wa' , 'wc' , 'we' , 'wo' ,
    9           'w:' , 'w;' , 'xc' , 'xe' , 'xo' , 'ya' , 'yc' , 'ye' ,
    A           '0.' , '0,' , '24' , '47' , '49' , '4)' , '52' , '57' ,
    B           '59' , '5,' , '5.' , '62' , '69' , '6?' , '72' , '73' /
     DATA R1 /  '78' , '79' , '8)' , '93' , '(a' , '(d' , '(s' , '(t' ,
    1           '(7' , '(9' , '(5' , '),' , ').' , '.0' , '.4' , '.7' ,
    2           'At' , 'Au' , 'AO' , 'AQ' , 'AU' , 'Bj' , 'B)' , 'BX' ,
    3           'BY' , 'Cj' , 'C)' , 'DA' , 'DV' , 'DW' , 'Ev' , 'Ew' ,
    4           'Ff' , 'FO' , 'FQ' , 'Gj' , 'J,' , 'J.' , 'JA' , 'Kt' ,
    5           'Ku' , 'K?' , 'KC' , 'KG' , 'O,' , 'O.' , 'OA' , 'OV' ,
    6           'OW' , 'Po' , 'P:' , 'P;' , 'Ra' , 'Rd' , 'Ro' , 'Rt' ,
    7           'Ru' , 'Rv' , 'Rw' , 'R''', 'R!' , 'R"' , 'R?' , 'RC' ,
    8           'RG' , 'RJ' , 'RO' , 'RQ' , 'RS' , 'RT' , 'Sw' , 'Sx' ,
    9           'S)' , 'SV' , 'SW' , 'SX' , 'SY' , 'U,' , 'U.' , 'Vt' ,
    A           'VC' , 'VG' , 'VO' , 'VQ' , 'VS' , 'Wt' , 'WC' , 'WG' ,
    B           'WO' , 'WQ' , 'WS' , 'Xc' , 'Xe' , 'Xo' , 'Xq' , 'Xt' ,
    C           'X?' , 'XJ' , 'Yi' , 'Y?' , 'Zv' , 'Zw' , 'Z?' , '`a' ,
    D           '`c' , '`d' , '`e' , '`g' , '`j' , '`o' , '`q' , '`s' ,
    E           '`4' , '`6' , '`A' , '`J' , '~a' , '~c' , '~d' , '~e' ,
    F           '~g' , '~j' , '~o' , '~q' , '~s' , '~4' , '~6' , '~A' ,
    G           '~J' /
     DATA R2 /  'av' , 'aw' , 'a?' , 'e?' , 'fc' , 'fe' , 'fj' , 'f)' ,
    1           'f:' , 'f;' , 'h?' , 'm?' , 'n?' , 'o)' , 'o?' , 'p)' ,
    2           'p?' , 't)' , 't?' , 'w)' , 'w,' , 'w.' , 'y)' , 'y,' ,
    3           'y.' , '0)' , '3)' , '67' , '70' , '7:' , '7;' , '9)' ,
    4           '--' , '(c' , '(e' , '(o' , '(q' , '(u' , '(v' , '(w' ,
    5           '(0' , '(3' , '(6' , '(8' , '(C' , '(G' , '(J' , 'Av' ,
    6           'Aw' , 'A''', 'A"' , 'Dj' , 'D)' , 'D.' , 'D,' , 'Dx' ,
    7           'Fd' , 'Fm' , 'Fn' , 'Fp' , 'Fr' , 'Jj' , 'KO' , 'KQ' ,
    8           'Lv' , 'Lw' , 'L''', 'L"' , 'Oj' , 'O)' , 'OX' , 'OY' ,
    9           'Pa' , 'Pc' , 'Pe' , 'P)' , 'PX' , 'PY' , 'QV' , 'QW' ,
    A           'QY' , 'Rc' , 'Re' , 'Rq' , 'RU' , 'RV' , 'RW' , 'Sv' ,
    B           'Sy' , 'T,' , 'T.' , 'T:' , 'T;' , 'Uj' , 'UA' , 'Vf' ,
    C           'Vg' , 'Vm' , 'Vn' , 'Vp' , 'Vr' , 'Vu' , 'Vv' , 'Vw' ,
    D           'Vx' , 'Vy' , 'Vz' , 'V:' , 'V;' , 'Wf' , 'Wg' , 'Wm' ,
    E           'Wn' , 'Wp' , 'Wr' , 'Wu' , 'Wv' , 'Wx' , 'Wy' , 'Wz' ,
    F           'W:' , 'W;' , 'Xu' , 'XC' , 'XG' , 'XO' , 'XQ' , 'Yt' ,
    G           'YC' , 'YG' , 'YO' , 'YQ' , 'YS' /
     DATA R3 /  'f,' , 'f.' , 'r)' , 'r,' , 'r.' , 'vj' , 'v)' , 'v,' ,
    1           'v.' , 'wj' , 'yj' , '7,' , '7.' , '9,' , '9.' , '(4' ,
    2           '(O' , '(Q' , 'A?' , 'AT' , 'Fa' , 'Fc' , 'Fe' , 'Fg' ,
    3           'Fj' , 'Fo' , 'Fq' , 'Fs' , 'Fu' , 'Fv' , 'Fw' , 'Fx' ,
    4           'Fy' , 'Fz' , 'F:' , 'F;' , 'FJ' , 'Kv' , 'Kw' , 'L?' ,
    5           'LT' , 'Pj' , 'P,' , 'P.' , 'PA' , 'RY' , 'Tg' , 'Tj' ,
    6           'Tm' , 'Tn' , 'Tr' , 'Ts' , 'Tx' , 'Ty' , 'Tz' , 'TA' ,
    7           'Va' , 'Vc' , 'Vd' , 'Ve' , 'Vo' , 'Vq' , 'Vs' , 'V,' ,
    8           'V.' , 'VJ' , 'Wa' , 'Wc' , 'Wd' , 'We' , 'Wo' , 'Wq' ,
    9           'Ws' , 'W,' , 'W.' , 'WJ' , 'Xv' , 'Xw' , 'Yf' , 'Y,' ,
    A           'Y.' , 'Y:' , 'Y;' , 'DY' /
     DATA R4 /  '76' , 'AV' , 'AW' , 'AY' , 'F,' , 'F.' , 'FA' , 'LV' ,
    1           'LW' , 'LY' , 'PJ' , 'Ta' , 'Tc' , 'Td' , 'Te' , 'To' ,
    2           'Tp' , 'Tq' , 'Tu' , 'Tv' , 'Tw' , 'TJ' , 'Vj' , 'Wj' ,
    3           'WA' , 'Ym' , 'Yn' , 'Yp' , 'Yr' , 'Yu' , 'Yv' , 'Yw' ,
    4           'Yx' , 'Yy' , 'Yz' , 'VA' /
     DATA R5 /  '74' , 'Ya' , 'Yc' , 'Yd' , 'Ye' , 'Yg' , 'Yj' , 'Yo' ,
    1           'Yq' , 'Ys' , 'YA' , 'YJ' /

     ALL USES OR ADAPTATIONS OF THE DATA BELOW MUST BE ACCOMPANIED BY
     THE NAME AND ADDRESS OF THE DATA'S CREATOR, WHICH IS:

---------------------------------------------------------*
							  *
     ALAN L. ZIRKLE     NAVAL SURFACE WEAPONS CENTER     *
                        CODE K105			  *
     (703) 663-7815     DAHLGREN, VIRGINIA  22448	  *
							  *
---------------------------------------------------------*

     DATA AA / 32505856,66598912,133987328,119438336,118371840,11783526   001
    *4,50791936,59182592,25402880,134216704,134215680,134209536,1006632   002
    *96,100663320,134217720,134217720,134217720,12595200,25171968,58727   003
    *424,117444096,117444096,125836800,67107840,33552384,16773120,41615   004
    *36,33550336,67106816,62979072,125836800,117444096,117444096,117444   005
    *096,50359296,58784768,29423616,12611584,16773120,33552384,67107840   006
    *,125836800,117444096,117444096,58727424,25171968,12595224,13421772   007
    *0,134217720,134217720,100663296,4161536,33550336,67106816,63126528   008
    *,126029312,117640704,117640704,117640704,50535424,58981376,2962022   009
    *4,12836864,100687872,134217664,134217712,134217720,100687928,24600   010
    *,216,504,240,234942464,1058797568,1069546496,1946094592,1676545536   011
    *,1674446336,1674446336,1674446336,1737362944,2005339136,2131229696   012
    *,1040449280,201388800,100663320,134217720,134217720,134217720,1007   013
    *24736,15360,7680,7680,100679168,134217216,134216704,134213632,1006   014
    *63296,100664880,134217336,134217336,134217336,134217264,100663296,   015
    *251658240,1065353216,2004877312,1929379840,2013267504,2147483256,1   016
    *073741432,268435064,1584,100663320,134217720,134217720,134217720,1   017
    *04726528,983040,2080768,109043712,134019072,133200896,130031104,11   018
    *7456384,100678656,100663320,134217720,134217720,134217720,13421772   019
    *0,100663296,100664832,134217216,134217216,134217216,100724736/       020
     DATA AB / 15360,7680,100679168,134217216,134216704,134215680,10072   021
    *7808,15872,7680,100679168,134217216,134216704,134213632,100663296,   022
    *100664832,134217216,134217216,134217216,100724736,15360,7680,7680,   023
    *100679168,134217216,134216704,134213632,100663296,8380416,33552384   024
    *,67107840,62929920,125832704,100664832,100664832,117444096,6292992   025
    *0,67107840,33552384,8380416,1610614272,2147483136,2147483136,21474   026
    *83136,6303744,12589056,29367296,25169408,25169408,29367808,1677619   027
    *2,8386560,4190208,4190208,8386560,16776192,32513536,31460864,31460   028
    *864,29367296,12589056,1616916480,2147483136,2147483136,2147483136,   029
    *1610614272,100664832,134217216,134217216,134217216,100724736,14336   030
    *,7168,15872,32256,31744,14336,65138688,63174656,126352384,11796428   031
    *8,101699072,102729216,121570816,134088192,66978816,33295360,162590   032
    *72,1536,16777200,67108848,134217712,125830656,117442048,117442048,   033
    *62914560,29360128,1536,4193792,16776704,67108352,132122112,1258291   034
    *20,125829120,62914560,15730176,134217216,134217216,134217216,10066   035
    *4832,1536,15872,130560,1041920,8323072,66584576,133693440,67043328   036
    *,8381952,1048064,130560,15872,1536,1536,32256,523776,8381952,13408   037
    *6656,134086656,33546240,4192256,522240,8380416,134086656,134086656   038
    *,33547776,2096640,130560,7680,1536,100664832,125836800,132152832,1   039
    *17046784,4193792,2090496,2064384,109019136,134201344,133821952/      040
     DATA AC / 132152832,125836800,100664832,1006634496,2080390656,2013   041
    *396480,2081416704,1048510464,267911168,67043328,8381952,1048064,13   042
    *0560,15872,1536,117456384,130031104,133172736,133957120,108987904,   043
    *102745600,101187072,100793856,117472768,125836800,130024960,100663   044
    *296,133955584,134201344,102758400,1638144,1581024,1573880,1573118,   045
    *1573887,1581054,1638392,102760416,134217472,134215680,134201344,13   046
    *3955584,100663296,100663299,134217727,134217727,134217727,13421772   047
    *7,100691971,100691971,100691971,100691971,100691971,117504007,1259   048
    *59183,67100670,33546236,16748536,4064224,2097088,8388592,16777208,   049
    *33554428,66060414,62914590,125829135,117440519,117440519,117440519   050
    *,125829135,58720286,29360188,15728888,7341052,100663299,134217727,   051
    *134217727,134217727,134217727,100663299,100663299,100663299,117440   052
    *519,125829135,62914590,66060414,33424380,16777208,8388592,2097088,   053
    *261632,100663299,134217727,134217727,134217727,134217727,100675587   054
    *,100675587,100727811,100925187,100925187,100663299,117440515,12582   055
    *9127,132120591,133693503,100663299,134217727,134217727,134217727,1   056
    *34217727,100675587,12291,64515,261891,261891,3,7,15,63,2097088,838   057
    *8592,16777208,33554428,66846974,62914590,125829135,117440519,11744   058
    *0519,117440519,58720263,58728455,29384719,33546270,16769084,167692   059
    *76,8380926,100663299,134217727,134217727,134217727,134217727/        060
     DATA AD / 100675587,12288,12288,12288,100675587,134217727,13421772   061
    *7,134217727,134217727,100663299,100663299,134217727,134217727,1342   062
    *17727,134217727,134217727,100663299,8257536,33488896,67043328,1278   063
    *60736,118358016,117440512,117440512,130023427,67108863,33554431,16   064
    *777215,4194303,3,100663299,134217727,134217727,134217727,134217727   065
    *,101646339,491520,245760,122880,63488,523776,109051776,134211571,1   066
    *34185471,133955647,132120579,100663296,100663299,134217727,1342177   067
    *27,134217727,134217727,100663299,100663296,100663296,100663296,100   068
    *663296,100663296,117440512,125829120,132120576,133693440,100663299   069
    *,134217727,134217727,100663423,1023,8191,65528,524224,4193792,3355   070
    *0336,134184960,33423360,4177920,522240,65280,8160,1020,100663423,1   071
    *34217727,134217727,134217727,134217727,100663299,100663299,1342177   072
    *27,134217727,100663423,511,2047,8188,32752,131008,524032,2096128,8   073
    *384512,33538051,134217727,134217727,3,261632,2097088,16777208,3355   074
    *4428,66847230,130023455,117440519,100663299,100663299,117440519,13   075
    *0023455,66847230,33554428,16777208,2097088,261632,100663299,134217   076
    *727,134217727,134217727,134217727,100712451,49155,49155,57351,5735   077
    *1,61455,30750,32766,16380,8184,2016,261632,2097088,16777208,335544   078
    *28,66847230,130023455,117440519,101187587,102236163,125304839,1331   079
    *69183,66847230,134217724,125829112,102760384,67370496,100663299/     080
     DATA AE / 134217727,134217727,134217727,134217727,100712451,49155,   081
    *49155,49155,122887,253959,1044495,8386590,33521662,66994172,133701   082
    *624,130025440,100663296,67108864,33488896,33032176,65019900,629309   083
    *42,125861775,117505799,117570567,117700615,126873607,134209550,670   084
    *92542,33521916,8257536,127,31,7,3,100663299,134217727,134217727,13   085
    *4217727,134217727,100663299,3,7,31,127,3,2097151,16777215,33554431   086
    *,67108863,66060291,125829120,117440512,100663296,100663296,1174405   087
    *12,50331648,58720256,33030147,16777215,2097151,3,3,63,1023,16383,2   088
    *62143,4194275,67108352,134209536,67076096,4186112,261632,16355,102   089
    *3,63,3,3,63,1023,16383,262143,4194275,67108352,134209536,67076096,   090
    *4192256,262016,65528,2097144,67108736,134215680,67076096,4186112,2   091
    *61632,16355,1023,63,3,100663299,117440527,130023487,133169407,1087   092
    *90783,2035711,524275,131008,524032,2096128,109051648,134186944,134   093
    *087155,133693567,132120607,125829127,100663299,3,15,63,255,1023,10   094
    *0667391,134217715,134217664,134217472,134217472,100667328,1011,255   095
    *,127,63,15,3,67109119,117440575,130023439,133169159,133955587,1341   096
    *52195,134201347,104853507,101710851,100925187,100728771,100679667,   097
    *100667391,117441535,125829375,132120639,133693455,134152195,261632   098
    *,2097088,16777208,33554428,66847230,130023455,117440519,100663299,   099
    *100663299,117440519,130023455,66847230,33554428,16777208,2097088/    100
     DATA AF / 261632,100663344,134217720,134217724,134217726,134217727   101
    *,134217727,100663296,117441472,125831152,130025468,132121550,13316   102
    *9542,133693447,127795207,126812167,126074911,125956223,125894654,1   103
    *25861884,125837304,132122592,132120576,3670016,16515184,31326460,6   104
    *0686590,118227046,117446663,117446663,117455879,125861383,13015439   105
    *9,67108862,67104766,33540092,16744944,1966080,458752,507904,516096   106
    *,473088,465920,460544,459648,458976,458864,101122108,134217726,134   107
    *217727,134217727,134217727,101122048,458752,8126464,16678911,33439   108
    *743,60692511,51124255,100670495,100670495,100670495,117455903,1300   109
    *55199,67106847,33552415,16773151,4186143,491520,1032192,16776192,3   110
    *3554176,67108736,65077184,117455856,100669688,100670524,117455902,   111
    *132185102,67106823,33550339,16769027,2064384,96,124,117440543,1331   112
    *69183,134086687,134201375,134213663,1047583,65311,8095,991,127,31,   113
    *7,4063232,16744944,33540092,67104766,63045630,117472271,100669443,   114
    *100669443,100669443,117472271,63045630,67104766,33540092,16744944,   115
    *4063232,4032,100679672,100696060,117506046,58849343,63037447,31571   116
    *971,16302083,8314887,2095166,1048574,524284,131064,8064,245760,245   117
    *760,245760,245760,245760,33554304,33554304,33554304,245760,245760,   118
    *245760,245760,245760,245760,245760,245760,245760,245760,245760,245   119
    *760,245760,245760,245760,245760,245760,245760,100663296,125829120/   120
     DATA AG / 132120576,33030144,8257536,2064384,516096,129024,32256,8   121
    *064,2016,504,126,31,7,261120,2097024,8388576,33425400,65011836,587   122
    *20270,201326595,134217729,134217729,201326595,58720270,65011836,33   123
    *425400,8388576,2097024,261120,3947520,3947520,3947520,3947520,3947   124
    *520,3947520,3947520,3947520,3947520,3947520,3947520,3947520,394752   125
    *0,1736441856,1069547520,1069547520,260046848,58720256,130023424,13   126
    *0023424,58720256,828,510,510,124,496,1020,1020,486,8184,58982398,1   127
    *31071999,131071999,58982398,8184,58777600,130150400,130150400,5877   128
    *7600,828,510,510,124,0,0,828,510,510,124,496,1020,1020,486,0,0,496   129
    *,1020,1020,486,496,1020,1022,999,451,58720259,131006467,131055623,   130
    *58847239,64527,32766,16380,4088,992,1736499200,1069674496,10696744   131
    *96,260104192/                                                        132

     ALL USES OR ADAPTATIONS OF THE DATA ABOVE MUST BE ACCOMPANIED BY
     THE NAME AND ADDRESS OF THE DATA'S CREATOR, WHICH IS:

---------------------------------------------------------*
							  *
     ALAN L. ZIRKLE     NAVAL SURFACE WEAPONS CENTER     *
                        CODE K105			  *
     (703) 663-7815     DAHLGREN, VIRGINIA  22448	  *
							  *
---------------------------------------------------------*

     END