      SUBROUTINE LIBNAM( BUF )
      CHARACTER*(*) BUF
      BUF = 'HPLIBR'
      RETURN
      END
C = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
C
C	SUBROUTINE PLOT ( X, Y, ICODE )
C
C  This subroutine moves the pen from its current position to X,Y
C
C  If ICODE is +/-2 then the pen is down thus drawing a line.
C  If ICODE is +/-3 then the pen is up during the move.
C
C  If ICODE is negative then the new pen position becomes to plot
C  origin (ie 0,0).
C
C = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
	SUBROUTINE PLOT ( X, Y, ICODE )

C ===
C  Include the HPLIBR common block of variables.
C ===
	INCLUDE 'HPLIBR.CMN'

C ===
C  Convert the user coordinates into absolute plotter units.
C ===
	IX = IFIX( X * XCONV * FACT + .5 ) + IXORG
	IY = IFIX( Y * YCONV * FACT + .5 ) + IYORG
C ===
C  Clip the coordinates if they are off the page.
C ===
	IF(IX.GT.IXMAX) IX = IXMAX
	IF(IY.GT.IYMAX) IY = IYMAX
	IF(IX.LT.0) IX = 0
	IF(IY.LT.0) IY = 0
C ===
C  Determine the relative corrdinates to get there from
C  the present pen position.
C ===
	IXR = IX - IXNOW
	IYR = IY - IYNOW
C ===
C  Update the current pen position to reflect this move.
C ===
	IXNOW = IX
	IYNOW = IY
C ===
C  If ICODE is 2 and the pen is currently up then it
C  must be put down prior to moving.
C ===
	IF( IABS(ICODE).EQ.2 .AND. PENUP ) THEN
		HPCODE = 'PD;'
		CALL HPINST
		PENUP = .FALSE.
	END IF

C ===
C  If ICODE is 3 and the pen is currently down then it
C  must be lifted prior to moving.
C ===
	IF( IABS(ICODE).EQ.3 .AND. (.NOT.PENUP) ) THEN
		HPCODE = 'PU;'
		CALL HPINST
		PENUP = .TRUE.
	END IF

C ===
C  If the last instruction to the plotter was a PR command
C  then we can simply append the relative coordinates to the 
C  instruction buffer (subtract 1 from the buffer pointer which
C  will write over the ";"), otherwise, we must include the "PR"
C  command and set the plot relative flag to .TRUE.
C ===
	WRITE( HPCODE, 3000 ) IXR, IYR
3000	FORMAT( 'PR', I6, ',', I6, ';' )
	PRINST = .TRUE.
	CALL HPINST
C ===
C  Change the origin if ICODE is negative.
C ===
	IF( ICODE.LT.0) THEN
		IXORG = IXNOW
		IYORG = IYNOW
	END IF
C ===
C  That's all there is to it!
C ===
	RETURN
	END
	SUBROUTINE HPINST

	INCLUDE 'HPLIBR.CMN'
C ===
C  Get the length of the instruction code.
C ===
	NCHAR = LENCHR( HPCODE )
C ===
C  If the new instructions won't fit in the buffer then dump the
C  buffer.
C ===
	IF( IBUFP+NCHAR.GE.IBUFD ) CALL HPDUMP
C ===
C  If the HPLITR flag is set to true then don't strip the
C  blank characters from the instruction code (this is set
C  by the LABEL and HPWNDO subroutines for obvious reasons!).
C ===
	IF( HPLITR ) THEN
		HPBUFF(IBUFP:IBUFP+NCHAR) = HPCODE(1:NCHAR)
		IBUFP = IBUFP + NCHAR
		HPLITR = .FALSE.
		GOTO 2000
	END IF
C ===
C  If this is a "PR" (plot relative) instruction AND the last
C  intruction was a "PR" then we need only append the coordinates
C  to the buffer.
C ===
	IF( PRINST .AND. PRLAST ) THEN
		HPCODE(1:2) = ' ,'
		IBUFP = IBUFP - 1
	END IF
C ===
C  Place the contents of the instruction code into the buffer
C  stripping any "blanks" as we go.
C ===
	DO 1000 I=1, NCHAR
	IF( HPCODE(I:I).EQ.' ' ) GOTO 1000
	HPBUFF(IBUFP:IBUFP) = HPCODE(I:I)
	IBUFP = IBUFP + 1
1000	CONTINUE

2000	IF( PRINST ) THEN
		PRLAST = .TRUE.
		PRINST = .FALSE.
	ELSE
		PRLAST = .FALSE.
	END IF
C ===
C  Blank-out the instruction code string.
C ===
	HPCODE = ' '

	RETURN

	END
C ===
C  This subroutine dumps the contents of HPBUFF to
C  the appropriate logical unit.
C ===
	SUBROUTINE HPDUMP

	INCLUDE 'HPLIBR.CMN'

	BYTE ON(4), OFF(4)

	DATA  ON/ 27, '[', '5', 'i'/
	DATA OFF/ 27, '[', '4', 'i'/

	IF (IHPOUT.EQ.6 ) GOTO 100
C ===
C  Plotter output is to HP: or FNAME
C ===
	WRITE( IHPOUT, 1000 ) HPBUFF(1:IBUFP-1)
1000	FORMAT( A )
	GOTO 200
C ===
C  Plotter output is to printer port so we need to
C  turn on the port, dump the buffer, and close the port.
C  We must also supress the CR/LF at the end of the dump,
C  in order to accomplish this we will use the '+' character
C  as the carriage control character.
C ===
100	WRITE( IHPOUT, 1001 ) ON, HPBUFF(1:IBUFP-1), OFF
1001	FORMAT( '+', 4A1, A, 4A1 )
C ===
C  Refresh the HPBUFF pointer and blank-out the HPBUFF string.
C ===
200	HPBUFF = ' '
	IBUFP = 1
	PRLAST = .FALSE.
C ===
C  Das all--back to the main program we go.
C ===
	RETURN

	END
C ===
C	SUBROUTINE START( X, Y, IPAPER, IERR, FNAME )
C
C	ROUTINE TO INITIALIZE PLOTTING PACKAGE ON 
C	HEWLETT-PACKERD 7550 SERIES 8 PEN PLOTTERS.
C ===
C
C	X,Y = Initial origin of pen in inches.
C
C	IPAPER	= 0 Small paper size (8.5"x11").
C		= 1 Large paper size (11"x17").
C
C	IOUT    = 0 Output is directed to a datafile called FNAME.
C		= 1 Output is directed to device HP: (ie the plotter).
C		= 2 Output is through the terminal printer port.
C       if an error occurs during the "OPEN" operation then the value
C       of IOUT is set to -1.
C
C	FNAME	= Name of the datafile where the plotter code is
C		  written to.  If FNAME is "HP:" the code is sent
C		  to the plotter.  If FNAME is "TT:" then the code
C		  is sent thru the terminal printer port.
C                 If FNAME is empty then the default file name
C                 will be HP7550.PLT 
C ===
C  HPLIBR common block definition.
C ===
C	COMMON /HPLIBR/ HPBUFF, HPCODE, IBUFP, IBUFD, IHPOUT,
C	1 HPLITR, PRINST, PRLAST, PENUP,
C	1 XCONV, YCONV, IXORG, IYORG, IXNOW, IYNOW, IXMAX, IYMAX, FACT,
C	1 ICPEN, IUPDN, IFTYP, IFSPA, IFANG, ILTYP, ILSPA, ISYMB,
C	1 CHRWD, CHRHT, CHRSL, CHRAN, LOCHR, ISPEC, IALTC
C
C	LOGICAL*1 HPLITR, PRINST, PRLAST
C
C	CHARACTER HPBUFF*132, HPCODE*132
C ===
C  Description of the HPLIBR common block variables:
C
C      HPBUFF = Instruction buffer for the plotter.
C      HPCODE = Character string of plotter commands to be placed
C               into HPBUFF via a call to HPINST.
C       IBUFP = Position of the last character in HPUFF.
C       IBUFD = Maximum length of HPBUFF string instruction (130)
C
C      IHPOUT = I/O unit assiciated with the plotter buffer.
C
C       XCONV = Conversion factor from user units to plotter units (X).
C       YCONV = Conversion factor from user units to plotter units (Y).
C       IXORG = Current X coordinate of user origin.
C       IYORG = Current Y coordinate of user origin.
C       IXMAX = Maximum distance in the X direction.
C       IYMAX = Maximum distance in the Y direction.
C       IXNOW = Current pen X coordinate.
C       IYNOW = Current pen Y coordinate.
C        FACT = Current scaling factor.
C
C      PRINST = Flag set in the PLOT subroutine to indicate a plot
C                relative command.
C      PRLAST = Flag set if the last command was a plot relative one.
C
C      HPLITR = Flag set to disable blank character stripping when the
C               contents of HPCODE are placed into HPBUFF.
C
C       PENUP = Flag set if the pen is in the UP position.
C
C       ICPEN = Current number pen in hand.
C
C       IFTYP = Current "fill" pattern.
C       IFSPA = Current "fill" spacing.
C       IFANG = Current "fill" angle.
C
C       ILTYP = Current "line" pattern.
C       ILSPA = Current "line" pattern length.
C
C       ISYMB = Currently defined symbol number.
C
C       CHRWD = Current character width (cm).
C       CHRHT = Current character height (cm).
C	CHWRAT = Character height:width ratio.
C       CHRSL = Current character slant (deg).
C       CHRAN = Current character label angle (deg).
C       CHRLO = Current label origin.
C
C       ISPEC = If 1 then special character mode is active and 0 if not.
C       IALTC = Current alternate character set.
C ===
	SUBROUTINE START( X, Y)  ! , IPAPER, IERR, FNAME )	!JDW
C ===
C  HPLIBR common block variables.
C ===
	INCLUDE 'HPLIBR.CMN'

CC	CHARACTER FNAME*(*)	!JDW
	PARAMETER FNAME = 'HP'	!JDW
	PARAMETER IPAPER = 0	!JDW
C ===
C  Open appropriate unit and file for plotter output.
C ===
	IF( FNAME.EQ.'HP:' .OR. FNAME.EQ.'hp:' ) GOTO 2000
	IF( FNAME.EQ.'TT:' .OR. FNAME.EQ.'tt:' ) GOTO 3000
C ===
C  Output is to directed to FNAME.
C ===
	IHPOUT = 2
	IBUFD = 120
	IF( FNAME.EQ.' ' ) THEN
		OPEN (UNIT = IHPOUT, NAME = 'HP7550.PLT', TYPE = 'NEW',
	1 	CARRIAGECONTROL = 'LIST', ERR = 1010 )
	ELSE
		OPEN (UNIT = IHPOUT, NAME = FNAME, TYPE = 'NEW',
	1 	CARRIAGECONTROL = 'LIST', ERR = 1010 )
	END IF
	GOTO 4000
C ===
C  There has been an error associated with openning FNAME.
C ===
1010	CALL ERRSNS ( IERR, ISTS, ISTV, IHPOUT, ICON )
	IF( FNAME.EQ.' ' ) THEN
		TYPE 1020, 7, 7, IERR, 'HP7550.PLT'
	ELSE
		TYPE 1020, 7, 7, IERR, FNAME
1020	FORMAT( /,
	1 5X, 2A1, 'ERROR', I5, ' OCCURED ATTEMPTING TO
	1 OPEN FILENAME: ', A, /,
	1 5X, 'AS OUTPUT IN SUBROUTINE "START".' )
	END IF

	IERR = -1
	RETURN
C ===
C  Output is to directed to plotter at HP:
C ===
2000	IHPOUT = 2
	IBUFD = 120
	OPEN( UNIT=IHPOUT, NAME='HP:', TYPE='NEW',
	1 CARRIAGECONTROL='NONE', ERR=2010 )
C ===
C  Send the plotter an <ESC>.( <ESC>.L <ESC>.) string to
C  output a signal when the plotter buffer is empty and we
C  are clear to send data to it.
C ===
	WRITE( IHPOUT, 2005 ) 27, 27, 27
2005	FORMAT( A1, '.(', A1, '.L', A1, '.)', $ )
	READ( IHPOUT, *, ERR=2010 ) IDUMMY
	GOTO 4000
C ===
C  There is an error openning HP:
C ===
2010	CALL ERRSNS ( IERR, ISTS, ISTV, IHPOUT, ICON )
	IF( IERR.EQ.30 ) THEN
		TYPE 2020, 7, 7
2020	FORMAT( /, 5X, A1, 'Plotter is currently unavalible.', A1 )
	ELSE
		TYPE 2030, 7, 7, IERR
2030	FORMAT( /, 5X, 2A1, 'ERROR', I5, 'OCCURED ATTEMPTING
	1 TO ATTATCH HP:', 5X, 'AS OUTPUT IN SUBROUTINE "START".' )
	END IF
	IERR = -1
	RETURN
C ===
C  Output is to be directed to terminal IUNIT = 6
C ===
3000	IHPOUT = 6
	CALL SET_TERM( 'SAVE' )
	CALL SET_TERM( 'PASTHRU' )
	CALL SET_TERM( 'NOWRAP' )
	CALL SET_TERM( 'NOBROADCAST' )
	IBUFD = 120
	GO TO 4000
C ===
C  There is an error openning TT:
C ===
3010	CALL ERRSNS ( IERR, ISTS, ISTV, IHPOUT, ICON )
	TYPE 3020, 7, 7, IERR
3020	FORMAT( /, 5X, 2A1, 'ERROR', I5,' OCCURED ATTEMPTING TO OPEN TT:'
	1 5X, 'AS OUTPUT IN SUBROUTINE "START".' )
	IERR = -1
	RETURN
C ===
C  Set the buffer pointer to 1
C ===
4000	IBUFP = 1
C ===
C  Set pen position to "UP"
C ===
	PENUP = .TRUE.
C ===
C  Set PRINST to .FALSE. (ie last instruction was not a relative pen movement).
C ===
	PRLAST = .FALSE.
C ===
C  Set default scaling factor to 1.
C ===
	FACT = 1.0
C ===
C  Set hard clip limits according to paper size.
C ===
	IF( IPAPER.EQ.1 ) THEN
		IXMAX = 16450	! Limits for large paper 11"x17"
		IYMAX = 10170	! availible plotting area is 16.12"x10"
	ELSE
		IXMAX = 10170	! Limits for small paper 8.5"x11"
		IYMAX =  7840	! availible plotting area is 7.7"x10"
	END IF
C ===
C  Conversion factor from inches to plotter unit.
C ===
	XCONV = 1016.0
	YCONV = 1016.0
C ===
C  Set the initial pen position and origin to 0,0
C ===
	IXNOW = 0
	IYNOW = 0
	IXORG = 0
	IYORG = 0
C ===
C  Initialize the character cell dimensions and characteristics.
C ===
	CHRWD = 0.0
	CHRHT = 0.0
	CHWRAT = 0.6
	CHRSL = 0.0
	CHRAN = 0.0
	LOCHR = 1
	ISPEC = 0
	IALTC = 0
C ===
C  Set the default values for the FILL pattern.
C ===
	IFTYP = 1
	IFSPA = 0
	IFANG = 0
C ===
C  Set the default values for the LINE pattern.
C ===
	ILTYP = 0
	ILSPA = 4
C ===
C  Set the pen number in hand to 0 (we ain't got one yet!!).
C ===
	ICPEN = 0
C ===
C  Define the plotter initialization instruction string as follows:
C
C	(1) --->  <ESC>.(
C	(2) --->  <ESC>.@2:
C	(3) --->  "ten null characters"
C	(4) --->  <ESC>.T4096;4096;2048;;2048:
C	(5) --->  <ESC>.@4050:
C	(6) --->  <ESC>.P1:
C	(7) --->  IN;
C	(8) --->  IP;
C	(9) --->  PA0,0;
C
C  Which are the following instructions:
C
C	(1)  Plotter ON code (tells the plotter to accept all 
C	information until it encounters an <ESC>.) instruction.
C	
C	(2)  Forces the plotter to send an XOFF to the computer 
C	when its buffer has 2 or more characters in it.  This will force
C	the plotter to complete all instructions currently in its buffer
C	(ie finish the previous plot if it is not done yet) before it
C	allows any more instructions to enter its buffer.  This is needed
C	since the next instruction (the <ESC>.T one) will wipe-out all
C	unexicuted instructions currently in the buffer. 
C	
C	(3)  These 10 null characters are sent to let instruction #2 take 
C	effect (it take a finite amount of time for the plotter to send 
C	the Xoff character to the computer.
C	
C	(4)  This is the instruction string that configures the plotter's
C	buffer.  There are 12,800 bytes avalible which will be allocated
C	as follows: 4096 for physical I/O, 4096 for the polygon buffer,
C	2048 for down loadable (userdefined) characters, whatever is left
C	over in the replot buffer (512), and 2048 for the vector buffer. 
C	This configuration is sufficient for most plots. 
C	
C	(5)  Tell the plotter to send the XOFF character when its buffer 
C	gets 4050 characters full (this resets the condition set by the 
C	<ESC>.2@: instruction).
C	
C	(6)  This tells the plotter to use normal RS232 interfacing
C	proceedures. 
C	
C	(7)  Instructs the plotter to initialize itself to the "power up" 
C	state with respect to graphics parameters.
C	
C	(8)  Initialize plotter scaling units to default values.
C	
C	(9)  Do an absolute move to the paper origin.
C
C  More information on the details of these commands can be found 
C  in the Interfacing and Programming Manual for the HP 7550A 
C  graphics plotter (RS-232-C/CCITT V.24.  This library of routines
C  was written from the January 1986 edition of the manual. 
C	
C ===
CC	WRITE( HPCODE, 5000 ) 27, 27, 0,0,0,0,0,0,0,0,0,0, 27
CC5000	FORMAT( A1, '.(', A1, '.@2:', 10A1, A1, '.T4096;4096;2048;;2048:' )
C
C  Force the plotter to wait until previous plot is done.
	WRITE(HPCODE,101) 27,27,13,0,0,0,0,0, 0,0,0,0,0, 0,0,0,0,0,27	!JDW
101	FORMAT(A1,'.(',A1,'.@',17A1,'.)')				!JDW
C ===
C  Put the setup string into the plotter buffer and send it.
C ===
	CALL HPINST

	CALL HPDUMP
C ===
C  Put the second half of the instruction string in.
C ===
C
C  Initialize the handshakeing.
	WRITE(HPCODE,102) 27,27,27, 27,27		!JDW
102	FORMAT(A1,'.(',A1,'.@890:',A1,'.M50;;;13:',	!JDW
     &   A1,'.N10;19:',A1,'.I80;0;17:IN;IP;PA0,0;' )	!JDW
CC	WRITE( HPCODE, 7000 ) 27, 27
CC7000	FORMAT( A1, '.@4050:', A1, '.P1:IN;IP;PA0,0;' )

C ===
C  Put the setup string into the plotter buffer and send it.
C ===
	CALL HPINST

	CALL HPDUMP
C ===
C  Move the origin to user specified position of X,Y
C ===
	CALL PLOT( X, Y, -3 )
C ===
C  Reset the axis clipping limits for data plotting using
C  the PDATA subroutine.
C ===
	CALL AXCLIP( 0.0, 0.0 )
C
C  Grap pen # 1
	CALL PEN(1)	!JDW
C ===
C  Das all for now.
C ===
	IERR = 0

	RETURN

	END
C
C Dummy Subroutine	JDW
	SUBROUTINE SET_TERM
	RETURN
	END
C ===
C	SUBROUTINE AXCLIP( XAXLEN, YAXLEN )
C
C  This subroutine sets the plotting window limits for the PDATA
C  subroutine.
C
C ===
	SUBROUTINE AXCLIP( XAXLEN, YAXLEN )

	COMMON /AXCLIP/ XCLIP, YCLIP

	IF( XAXLEN.EQ.0.0 .OR. YAXLEN.EQ.0 ) THEN
		XCLIP = 0.0
		YCLIP = 0.0
	ELSE
		XCLIP = XAXLEN
		YCLIP = YAXLEN
	END IF

	RETURN

	END
	SUBROUTINE PEN( NEWP )
C
	INCLUDE 'HPLIBR.CMN'
C ===
C  Check for an invalid pen number or if we already have
C  this pen in hand.
C ===
	IF( NEWP.LT.0 .OR. NEWP.GT.8 .OR. NEWP.EQ.ICPEN ) RETURN
C ===
C  Put the new pen instruction in the plotter buffer.
C ===
	WRITE( HPCODE, 1000 ) NEWP
1000	FORMAT( 'SP', I1, ';' )
	CALL HPINST

	ICPEN = NEWP

	RETURN
	END
	SUBROUTINE END
C ===
C  This subroutine wraps up the plotter subroutine calls.
C ===
	INCLUDE 'HPLIBR.CMN'
C ===
C  Put away the pen like a good boy.
C ===
	CALL PEN (0)
C ===
C  Move to the origin.
C ===
	CALL PLOT (0.0, 0.0, 3)
C ===
C  Issue the eject page command "PG" and the plotter off code "<ESC>.)"
C ===
	WRITE( HPCODE, 1000 ) 27
1000	FORMAT( 'PG;', A1, '.)' )
C ===
C  Send instruction code to the buffer.
C ===
	CALL HPINST
C ===
C  Dump the plotter buffer.
C ===
	CALL HPDUMP
C ===
C  Close the plotter I/O port.
C ===
	CLOSE (UNIT = IHPOUT)
	IF( IHPOUT.EQ.6 ) CALL SET_TERM( 'RECALL' )
C ===
C  That's all folks, we be done!
C ===
	RETURN

	END
	SUBROUTINE FACTOR (FACTR)

	INCLUDE 'HPLIBR.CMN'

	IF( FACTR.LE.0.0 ) RETURN

	FACT = FACTR

	RETURN

	END
	SUBROUTINE WHERE (X, Y, FAC)

	INCLUDE 'HPLIBR.CMN'

	FAC = FACT
	X = (IXNOW - IXORG)/XCONV
	Y = (IYNOW - IYORG)/YCONV
	RETURN
	END

	SUBROUTINE SYMBOL( XPOS, YPOS, SIZE, TEXT, ANGLE, NCHAR )
	CHARACTER TEXT*(*)
      IF(NCHAR.LE.0 .AND. TEXT.LT.'@') THEN
	ISYM = ICHAR(TEXT(1:1))
	CALL SMODE( ISYM, SIZE )
	CALL PLOT( XPOS, YPOS, -NCHAR )
	CALL SMODE( 0, SIZE )
      ELSE
	CALL LABEL(XPOS, YPOS, TEXT, NCHAR, SIZE, 0.0, ANGLE, 1, 0)
      END IF

	RETURN

	END
	SUBROUTINE SMODE( ISY, SIZE )

	INCLUDE 'HPLIBR.CMN'

	ISYM = ISY

	IF( ISYM.LT.0 .OR. ISYM.GT.9 ) ISYM = 1
C ===
C  If ISYM is zero then that's the signal to exit from the
C  symbol mode.
C ===
	IF( ISYM.EQ.0 ) GOTO 7000
C ===
C  Set code the size of the character cell and cell angle if different
C  from the current character cell settings.
C ===
	CW = SIZE * XCONV * FACT / 400.0 
	CH = CW

	IF( CW.EQ.CHRWD .AND. CH.EQ.CHRHT .AND. CHRAN.EQ.0.0 ) GOTO 3000

	WRITE( HPCODE, 1000 ) CW, CH
1000	FORMAT( 'DI1,0;SI', F5.3, ',', F5.3, ';' )
	CALL HPINST
C ===
C  Update the current character cell parameters.
C ===
	CHRWD = CW
	CHRHT = CH
	CHRAN = 0.0
C ===
C  If the same symbol is to be used as last symbol, or ISYM is 1
C  then skip the symbol definition coding.
C ===
3000	IF( ISYM.EQ.ISYMB .OR. ISYM.EQ.1 ) GOTO 5000
C ===
C  Define the specified symbol as the "0" character (ASCII code=48).
C  In all cases (except for ISYM=1) the symbol is defined using the
C  DL command.
C
C	ISYM = 1 draw an "O".
C	ISYM = 2 define and draw a box.
C	ISYM = 3 define and draw a triangle.
C	ISYM = 4 define and draw an "X".
C	ISYM = 5 define and draw a diamond.
C	ISYM = 6 define and draw a cross "+".
C	ISYM = 7 define and inverted triangle.
C	ISYM = 8 define and draw an "*".
C ===
	IF( ISYM.EQ.2 ) HPCODE =
	1 'DL48,0,0,32,0,32,32,0,32,0,0;'

	IF( ISYM.EQ.3 ) HPCODE =
	1 'DL48,0,0,32,0,16,32,0,0;'

	IF( ISYM.EQ.4 ) HPCODE =
	1 'DL48,-128,3,3,29,29,-128,3,29,29,3;'

	IF( ISYM.EQ.5 ) HPCODE =
	1 'DL48,16,0,32,16,16,32,0,16,16,0;'

	IF( ISYM.EQ.6 ) HPCODE =
	1 'DL48,16,32,16,0,-128,0,16,32,16;'

	IF( ISYM.EQ.7 ) HPCODE = 
	1 'DL48,0,32,32,32,16,0,0,32;'

	IF( ISYM.EQ.8 ) HPCODE =
	1 'DL48,16,32,16,0,-128,0,16,32,16,
	1-128,3,3,29,29,-128,3,29,29,3;'

	CALL HPINST
C ===
C  Enter the symbol mode.
C ===
5000	IF( ISYM.EQ.1 ) THEN
		HPCODE = 'CS;SM0;'
	ELSE
		HPCODE = 'CS-1;SM0;'
	END IF

	CALL HPINST

	GOTO 8000
C ===
C  Cancel symbol mode and establish default character set.
C ===
7000	HPCODE = 'SM;CS;'
	CALL HPINST
C ===
C  Update the current symbol number.
C ===
8000	ISYMB = ISYM

	RETURN

	END
C ===
C  SUBROUTINE LABEL( X, Y, TEXT, NCHAR, SIZE, SLANT, ANGLE, ICODE, IBOLD )
C
C  Description of variables:
C     X, Y - Coordinates of label origin.
C     SIZE - Height (in inches) of the characters to be plotted.
C     TEXT - Character variable containing the
C            characters to be drawn.
C    NCHAR - Number of characters in TEXT to be
C            drawn, if NCHAR is 0 then the subroutine
C            will determine the number of characters in TEXT.
C    SLANT - Slant angle of characters along the line.
C    ANGLE - Angle of label line with respect to the page orientation.
C    ICODE - Postioning of the label with respect to the origin
C            as defined by the X,Y coordinates.
C            The following is a summary of the ICODE parameter:
C
C            If ICODE = 1 the label is drawn placing the lower left
C                       corner of the first character at X,Y
C            If ICODE = 4 the label is drawn centered with
C                       respect to the X,Y coordinates.
C            If ICODE = 7 the label is drawn with the last character
C                       at the X,Y coordinates.
C
C            If ICODE is negative, all "\" characters in the label
C                     will be converted to ASCII code 142 (shift-in)
C                     characters so the next character will be printed
C                     from the alternate character set in G2 of the
C                     plotter buffer.  It will also replace "{" characters
C                     with ASCII code 10 (<LF>)'s and "{" characters
C                     with ASCII code 11 (<VT>)'s for super and subscript
C                     characters.
C ===
	SUBROUTINE LABEL( X, Y, TEXT, NC, SIZE, SL, AN, IC, IB )

C ===
C  The HP common variable list.
C ===
	INCLUDE 'HPLIBR.CMN'

	CHARACTER TEXT*(*)

	PARAMETER ( RADIAN = 57.29578 )
	NCHAR = NC
	ICODE = IABS( IC )
	IBOLD = IB
	SLANT = SL
	ANGLE = AN
	STRING = ' '
C ===
C  If the value of NCHAR is 0 then determine the number of characters 
C  in TEXT, if then value of NCHAR is still 0 then just return (nothing
C  to plot!).
C ===
	IF( NCHAR.LE.0 ) NCHAR = LENCHR( TEXT )
	IF( NCHAR.EQ.0 ) RETURN
	IF( NCHAR.GT.LEN( TEXT ) ) NCHAR = LEN( TEXT )
C ===
C  Check for invalid parameters.
C ===
	IF( ICODE.LT.1 .OR. ICODE.GT.19 .OR. ICODE.EQ.10 ) ICODE = 1

	IF( SLANT.GT. 80.0 ) SLANT =  80.0
	IF( SLANT.LT.-80.0 ) SLANT = -80.0
C ===
C  Move the pen to X,Y
C ===
	CALL PLOT( X, Y, 3 )
C ===
C  Set character height.
C ===
	CALL CHRHGT( SIZE )
C ===
C  Change label angle if different from current value.
C ===
	IF( ANGLE.NE.CHRAN ) THEN
		WRITE( HPCODE, 1020 )
	1	COS( ANGLE/RADIAN ), SIN( ANGLE/RADIAN )
1020	FORMAT( 'DI', F6.3, ',', F6.3, ';' )
		CALL HPINST
		CHRAN = ANGLE
	END IF
C ===
C  Change character slant if different from current value.
C ===
	IF( SLANT.NE.CHRSL ) THEN
		WRITE( HPCODE, 1030 ) TAN( SLANT/RADIAN )
1030	FORMAT( 'SL', F6.3, ';' )
		CALL HPINST
		CHRSL = SLANT
	END IF
C ===
C  Change label position code if different from current value.
C ===
	IF( ICODE.NE.LOCHR ) THEN
		WRITE( HPCODE, 1040 ) ICODE
1040	FORMAT( 'LO', I2, ';' )
		CALL HPINST
		LOCHR = ICODE
	END IF
C ===
C  If IC is negative and the "special" character set has not
C  been loaded then load the special character set instructions.
C ===
	IF( IC.LT.0 .AND. ISPEC.EQ.0 ) THEN
		WRITE( HPCODE, 1050 )
1050	FORMAT( 'CM3;DS2,5;ES0,-0.7;' )
		CALL HPINST
		ISPEC = 1
	END IF
C ===
C  Write the contents of TEXT to the instruction code.
C  NOTE: a carriagereturn character is inserted to put the plotter
C  pen back to its label origin position after printing.
C ===
	WRITE( HPCODE, 2000 ) TEXT(1:NCHAR), 13, 3
2000	FORMAT( 'BL', A, A1, A1, ';PB;' )

C ===
C  If IC is positive then no alternate character set is
C  being used.
C ===
	IF( IC.GE.0 ) GOTO 2800
C ===
C  Search the plotter label buffer for "\" characters and change
C  them to "shift-out" characters (ASCII code 142) to access
C  the alternate character set located in G2.  Change all "{" to
C  <VT>'s and change all "}" to <LF>'s for super and subscript
C  characters.
C ===
	DO 2500, I=3, NCHAR+3
	IF( HPCODE(I:I).EQ.'{' ) HPCODE(I:I) = CHAR( 11 )
	IF( HPCODE(I:I).EQ.'}' ) HPCODE(I:I) = CHAR( 10 )
2500	IF( HPCODE(I:I).EQ.'\' ) HPCODE(I:I) = CHAR(142 )

C ===
C  Put the buffer label into the plotter buffer.
C ===
2800	HPLITR = .TRUE.
	CALL HPINST
C ===
C  Check to see if bolding or shading is needed.
C ===
	IF( IBOLD.EQ.0 ) GOTO 5000
C ===
C  Shadowing has been requested, so loop through and move
C  the starting pen location over ~0.15" in the "X"
C  direction (see angle correction) each time for a maximum
C  of IBOLD times.
C ===
	XBOLD = 0.015 * COS( ANGLE/RADIAN )
	YBOLD = 0.015 * SIN( ANGLE/RADIAN )

	XPOS = X
	YPOS = Y

	DO 4000 J = 1, ABS( IBOLD )

	XPOS = XPOS + XBOLD
	YPOS = YPOS + YBOLD

	CALL PLOT( XPOS, YPOS, 3 )

	WRITE( HPCODE, 4500 )
4500	FORMAT( 'PB;' )

	CALL HPINST

4000	CONTINUE
C ===
C  Put the pen back to the original X,Y position.
C ===
	CALL PLOT( X, Y, 3 )

5000	RETURN

	END
	SUBROUTINE CHRHGT( SIZE )

	INCLUDE 'HPLIBR.CMN'
C ===
C  Calculate the character cell size.
C ===
	CH = ABS( SIZE ) * YCONV / 400.0 * FACT
	CW = CHWRAT * CH

	IF( SIZE.LT.0 ) CW = -CW
C ===
C  If no change is necessary, just return.
C ===
	IF( CH.EQ.CHRHT .AND. CW.EQ.CHRWD ) RETURN
C ===
C  Change character cell dimensions.
C ===
	WRITE( HPCODE, 1010 ) CW, CH
1010	FORMAT( 'SI', F6.3, ',', F6.3, ';' )
	CALL HPINST

	CHRWD = CW
	CHRHT = CH

	RETURN

	END
C ***  SUBROUTINE NUMBER
C *
C *  HOMEBREW NUMBER ROUTINE.  FOLLOWS SAME RULES AS THOSE OF CALCOMP.
C *
      SUBROUTINE NUMBER(XPAGE,YPAGE,HEIGHT,FPN,ANGLE,NDEC)
C *
      CHARACTER LOC(20)*1, BLANK*1 ,DP*1
      DATA BLANK/' '/
      DATA DP/'.'/
C *
C *  ROUND THE FPN TO THE NEAREST NDEC DECIMAL PLACE
      XFPN = FPN
      NDXP = NDEC
      IF(NDEC.LT.0) NDXP = IABS( NDEC ) - 1
      IF(FPN.GT.0.0) XFPN = XFPN + 0.5*10.**(-NDXP)
      IF(FPN.LT.0.0) XFPN = XFPN - 0.5*10.**(-NDXP)
C *
C ENCODE THE FLOATING POINT NUMBER INTO 'A' FORMAT.
      ENCODE(20,1000,LOC(1)) XFPN
1000  FORMAT(F20.6)
C FIND THE FIRST NON BLANK CHARACTER.
      DO 10 I=1,20
10    IF(LOC(I).NE.BLANK) GO TO 15
C ALL BLANK CHARACTERS. HMMMM. PROBLEMS. GIVE IT UP.
      J2=20
      GO TO 45
C SHIFT THE LOC ARRAY LEFT AND FIND DECIMAL POINT LOCATION.
15    K=1
      IDP=20
      DO 20 J=I,20
      LOC(K)=LOC(J)
      LOC(J)=BLANK
      IF(LOC(K).EQ.DP) IDP=K
      K=K+1
20    CONTINUE
C NOW PROCESS THE LOC ARRAY POINTERS FOR THE DESIRED OUTPUT.
      IF(NDEC) 25,35,40
C NDEC NEGATIVE. IF NDEC=-1 OUTPUT THE INTEGER PORTION OF THE NUMBER.
C WITH OUT THE DECIMAL POINT.
25    IF(NDEC.NE.-1) GO TO 30
      J2=IDP-1
      GO TO 45
C IF NDEC<-1 OUTPUT IABS(NDEC)-1 DIGITS FROM THE NUMBER.
30    J2=IABS(NDEC)-1
C DON'T FORGET THE MINUS SIGN IF PRESENT.
      IF(FPN.LT.0.0) J2=J2+1
      GO TO 45
C NDEC=0.  PRINT OUT THE INTEGER PORTION OF THE NUMBER WITH DEC. PT.
35    J2=IDP
      GO TO 45
C PRINT OUT NDEC DIGITS TO THE RIGHT OF THE DECIMAL POINT.
40    J2=IDP+NDEC
45    DO 50 I=J2+1,20
      LOC(I)=BLANK
50    CONTINUE
      CALL SYMBOL(XPAGE,YPAGE,HEIGHT,%DESCR(LOC),ANGLE,J2)
      RETURN
      END
	FUNCTION LENCHR( TEXT )

	CHARACTER TEXT*(*)

	NMAX = LEN( TEXT )

	DO 100 I = NMAX, 1, -1
100	IF( TEXT(I:I).NE.' ' .AND. TEXT(I:I).NE.CHAR(0) ) GOTO 200
	I = 0

200	LENCHR = I
	RETURN

	END

	SUBROUTINE PAGE

	INCLUDE 'HPLIBR.CMN'

	WRITE( HPCODE, 1000 )
1000	FORMAT( 'PG;PA0,0;' )

	CALL HPINST

	CALL HPDUMP

	IXNOW = 0
	IYNOW = 0
	IXORG = 0
	IYORG = 0

	IF( IHPOUT.EQ.6 ) CLOSE (UNIT = IHPOUT)

	RETURN

	END
      SUBROUTINE AXIS(XPAGE,YPAGE,IBCD,NCHAR,AXLEN,ANGLE,FIRSTV,DELTAV)
C Translate a calcomp axis call into MJH's syntax.
      CHARACTER IBCD*(*)
      IF(ANGLE.EQ.0.0) THEN
	CALL XAXIS1(XPAGE,YPAGE,IBCD,NCHAR,0,AXLEN,FIRSTV,DELTAV)
      ELSE
	CALL YAXIS1(XPAGE,YPAGE,IBCD,NCHAR,0,AXLEN,FIRSTV,DELTAV)
      ENDIF
      RETURN
      END
C ===
C	SUBROUTINE XAXIS1( XPOS, YPOS, LABEL, NCHAR, ICODE,
C	1 AXLEN, FIRSTV, DELTAV )
C
C  This subroutine draws a linear "X" axis.
C
C  Variables sent to subroutine:
C
C	XPOS   =  X-coordinate of starting point of the axis.
C	YPOS   =  Y-coordinate of starting point of the axis.
C	LABEL  =  axis label to be centered along the axis.
C	NCHAR  =  Number of characters in label,
C		  if NCHAR=0 then the subroutine will determine
C		  the number of characters in LABEL.
C	AXLEN  =  Length of axis in whole inches.
C	FIRSTV =  First value to be plotted on axis.
C	DELTAV =  Change in axis values between 1" tick marks.
C	ICODE  =  Code specifying the type of X axis to be drawn:
C			 0  axis values and label are positioned
C			    below the axis.
C			 1  axis values and label are positioned
C			    above the axis.
C
C =================================================================
	SUBROUTINE XAXIS1( XPAGE, YPAGE, AXLAB, NC, ICODE,
	1 AXLEN, FIRSTV, DELTAV )

	CHARACTER CLABEL*132, CVALUE*14, AXLAB*(*)
C ===
C  Length of major and minor tick marks.
C ===
	TXMAJ = 0.08
	TXMIN = 0.04

	IF( ICODE.EQ.1 ) THEN
		TXMAJ = - TXMAJ
		TXMIN = - TXMIN
	END IF
C ===
C  Height of axis values and distance from the axis.
C ===
	HGTV = 0.11
	OSV  = 0.1
C ===
C  Height of axis label and distance from axis values.
C ===
	HGTL = 0.14
	OSL  = 0.1
C ===
C  LABEL subroutine values for character slant and bolding factor.
C ===
	SLANT = 0.0
	IBOLD = 0
C ===
C  Blank-out the labels.
C ===
	CLABEL = ' '
	CVALUE = ' '
C ==
C  Determine the largest absolute value to
C  be plotted on the axis.
C ===
	IENG = 0
	NEXP = 0
	VAL1 = FIRSTV
	VAL2 = FIRSTV + DELTAV * AXLEN
	VAL3 = DELTAV
	VMAX = AMAX1( ABS(VAL1), ABS(VAL2), ABS(VAL3) )
C ===
C  Check to see if the maximum value is within
C  the 5 character limit.  if not then adjust
C  axis values according to scientific notation.
C
C  If axis values are too large (>= 10,000)
C  modify them by units of 10** 3,6,9,12 etc.
C ===
100	IF ( ABS(VMAX).LT.10000.0 .AND. IENG.EQ.0 ) GOTO 200
150	IF ( ABS(VMAX).LT.100.0 ) GOTO 300
	NEXP = NEXP + 3
	VAL1 = VAL1 * 10.0**(-3)
	VAL2 = VAL2 * 10.0**(-3)
	VAL3 = VAL3 * 10.0**(-3)
	VMAX = VMAX * 10.0**(-3)
	IENG = 1
	GOTO 150
C ===
C  Axis values are too small (<= 0.01)
C  modify them by units 10** -3,-6,-9,-12 ETC.
C ===
200	IF ( ABS(VMAX).GE.0.01 .AND. IENG.EQ.0 ) GOTO 300
250	IF ( ABS(VMAX).GE.1.0 ) GOTO 300
	NEXP = NEXP - 3
	VAL1 = VAL1 * 10.0**(+3)
	VAL2 = VAL2 * 10.0**(+3)
	VAL3 = VAL3 * 10.0**(+3)
	VMAX = VMAX * 10.0**(+3)
	IENG = 1
	GOTO 250
C ===
C  Determine the number of decimal places to be
C  displayed along the axis.
C  	NDEC = 0 if integers are best
C  	NDEC = 1,2, or 3 for all other cases.
C ===	
300	X1 = ABS(VAL1)
	X3 = ABS(VAL3)
	NDEC = 0
350	F1 = AMOD( ABS(X1), 1.0 )
	F3 = AMOD( ABS(X3), 1.0 )
	IF ( ( ( F1.LT.0.001 .OR. F1.GT.0.999 ) .AND. 
	1      ( F3.LT.0.001. OR. F3.GT.0.999 ) ) .OR.
	1      ( NDEC.GE.3 ) ) GOTO 400
	NDEC = NDEC + 1
	X1 = F1 * 10.0
	X3 = F3 * 10.0
	GOTO 350
C ===
C  Move to the starting position and make a major tick mark.
C ===
400	X = XPAGE
	Y = YPAGE
	CALL PLOT( X, Y, 3 )
	CALL PLOT( X, Y+TXMAJ , 2 )
	CALL PLOT( X, Y, 3 )
C ===
C  Draw the axis with tickmarks.
C ===	
	DO 500 I = 1, INT( AXLEN )

	X = X + 0.5
	CALL PLOT( X, Y, 2 )
	CALL PLOT( X, Y+TXMIN, 2 )
	CALL PLOT( X, Y, 3 )

	X = X + 0.5
	CALL PLOT( X, Y, 2 )
	CALL PLOT( X, Y+TXMAJ, 2 )
	CALL PLOT( X, Y, 3 )
500	CONTINUE
C ===
C  If NC is negative then just axis was to be drawn.
C ===
	IF( NC.LT.0 ) RETURN
C ===
C  Determine the IPOS value for the LABEL subroutine
C  for drawing the axis values.
C ===
	IF( ICODE.EQ.0 ) THEN
		DY = -OSV
		IPOS = 6
	ELSE
		DY = OSV
		IPOS = 4
	END IF
C ===
C  Draw the axis values at the major tick marks.
C ===
	X = XPAGE
	Y = YPAGE + DY
	NMAX = 0
	ANGLE = 0.0

	DO 600 I = 0, INT( AXLEN )
	VALUE = VAL1 + I * VAL3

	CALL CVNUM( VALUE, NDEC, CVALUE, NCHAR )

	CALL LABEL( X, Y, CVALUE, NCHAR, HGTV, SLANT, ANGLE, IPOS, IBOLD )

	IF( NCHAR.GT.NMAX ) NMAX = NCHAR
	X = X + 1.0
600	CONTINUE
C ===
C  Determine the number of characters in the axis label.
C ===
	NCHAR = NC
	IF( NCHAR.EQ.0 ) NCHAR = LENCHR( AXLAB )
	CLABEL(1:NCHAR) = AXLAB(1:NCHAR)
C ===
C  Modify the axis label with "x10" if an adjustment was made
C  to the axis values.
C ===
	IF( IENG.EQ.0 ) GOTO 700
	CALL CVNUM( FLOAT(NEXP), 0, CVALUE, N )
	WRITE( CLABEL(NCHAR+1:), 660 ) CVALUE(1:N)
660	FORMAT( '  x10{', A, '}' )
	NCHAR = NCHAR + N + 7
C ===
C  Determine the appropriate IPOS value and X position for the
C  LABEL subroutine to draw the axis label.
C ===
700	DY = HGTV + OSV + OSL
	IF( IENG.NE.0 .AND. ICODE.EQ.0 ) DY = DY + HGTL/2.0

	IF( ICODE.EQ.0 ) THEN
		IPOS = 6
		DY = -DY
	ELSE
		IPOS = 4
	END IF

	ANGLE = 0.0
C ===
C  Draw the axis label.
C ===
	X = XPAGE + AXLEN/2.0
	Y = YPAGE + DY

	CALL LABEL( X, Y, CLABEL, NCHAR, HGTL, SLANT, ANGLE, -IPOS, IBOLD )
C ===
C  We be done!!
C ===
	RETURN

	END
C ===
C	SUBROUTINE YAXIS1( XPOS, YPOS, LABEL, NCHAR, ICODE,
C	1 AXLEN, FIRSTV, DELTAV )
C
C  This subroutine draws a linear "Y" axis.
C
C  Variables sent to subroutine:
C
C	XPOS  =  X-coordinate of starting point of the axis.
C	YPOS  =  Y-coordinate of starting point of the axis.
C	LABEL  =  axis label to be centered along the axis.
C	NCHAR  =  Number of characters in label,
C		  if NCHAR=0 then the subroutine will determine
C		  the number of characters in LABEL.
C	AXLEN  =  Length of axis in whole inches.
C	FIRSTV =  First value to be plotted on axis.
C	DELTAV =  Change in axis values between 1" tick marks.
C	ICODE  =  Code specifying the type of Y axis to be drawn:
C			 0  axis values and label are positioned
C			    to the left of the axis.
C			 1  axis values and label are positioned
C			    to the right of the axis.
C
C =================================================================
	SUBROUTINE YAXIS1( XPOS, YPOS, AXLAB, NC, ICODE,
	1 AXLEN, FIRSTV, DELTAV )

	CHARACTER CLABEL*132, CVALUE*14, AXLAB*(*)
C ===
C  Length of major and minor tick marks.
C ===
	TXMAJ = 0.08
	TXMIN = 0.04

	IF( ICODE.EQ.1 ) THEN
		TXMAJ = - TXMAJ
		TXMIN = - TXMIN
	END IF
C ===
C  Height of axis values and distance from the axis.
C ===
	HGTV = 0.11
	OSV  = 0.1
C ===
C  Height of axis label and distance from axis values.
C ===
	HGTL = 0.14
	OSL  = 0.1
C ===
C  LABEL subroutine values for character slant and bolding factor.
C ===
	SLANT = 0.0
	IBOLD = 0
C ===
C  Blank-out the labels.
C ===
	CLABEL = ' '
	CVALUE = ' '
C ==
C  Determine the largest absolute value to
C  be plotted on the axis.
C ===
	IENG = 0
	NEXP = 0
	VAL1 = FIRSTV
	VAL2 = FIRSTV + DELTAV * AXLEN
	VAL3 = DELTAV
	VMAX = AMAX1( ABS(VAL1), ABS(VAL2), ABS(VAL3) )
C ===
C  Check to see if the maximum value is within
C  the 5 character limit.  if not then adjust
C  axis values according to scientific notation.
C
C  If axis values are too large (>= 10,000)
C  modify them by units of 10** 3,6,9,12 etc.
C ===
100	IF ( ABS(VMAX).LT.10000.0 .AND. IENG.EQ.0 ) GOTO 200
150	IF ( ABS(VMAX).LT.100.0 ) GOTO 300
	NEXP = NEXP + 3
	VAL1 = VAL1 * 10.0**(-3)
	VAL2 = VAL2 * 10.0**(-3)
	VAL3 = VAL3 * 10.0**(-3)
	VMAX = VMAX * 10.0**(-3)
	IENG = 1
	GOTO 150
C ===
C  Axis values are too small (<= 0.01)
C  modify them by units 10** -3,-6,-9,-12 ETC.
C ===
200	IF ( ABS(VMAX).GE.0.01 .AND. IENG.EQ.0 ) GOTO 300
250	IF ( ABS(VMAX).GE.1.0 ) GOTO 300
	NEXP = NEXP - 3
	VAL1 = VAL1 * 10.0**(+3)
	VAL2 = VAL2 * 10.0**(+3)
	VAL3 = VAL3 * 10.0**(+3)
	VMAX = VMAX * 10.0**(+3)
	IENG = 1
	GOTO 250
C ===
C  Determine the number of decimal places to be
C  displayed along the axis.
C  	NDEC = 0 if integers are best
C  	NDEC = 1,2, or 3 for all other cases.
C ===	
300	X1 = ABS(VAL1)
	X3 = ABS(VAL3)
	NDEC = 0
350	F1 = AMOD( ABS(X1), 1.0 )
	F3 = AMOD( ABS(X3), 1.0 )
	IF ( ( ( F1.LT.0.001 .OR. F1.GT.0.999 ) .AND. 
	1      ( F3.LT.0.001. OR. F3.GT.0.999 ) ) .OR.
	1      ( NDEC.GE.3 ) ) GOTO 400
	NDEC = NDEC + 1
	X1 = F1 * 10.0
	X3 = F3 * 10.0
	GOTO 350

C ===
C  Move to the starting position and make a major tick mark.
C ===
400	X = XPOS
	Y = YPOS
	CALL PLOT( X, Y, 3 )
	CALL PLOT( X+TXMAJ, Y, 2 )
	CALL PLOT( X, Y, 3 )
C ===
C  Draw the axis with tickmarks.
C ===	
	DO 500 I = 1, INT( AXLEN )

	Y = Y + 0.5
	CALL PLOT( X, Y, 2 )
	CALL PLOT( X+TXMIN, Y, 2 )
	CALL PLOT( X, Y, 3 )

	Y = Y + 0.5
	CALL PLOT( X, Y, 2 )
	CALL PLOT( X+TXMAJ, Y, 2 )
	CALL PLOT( X, Y, 3 )
500	CONTINUE
C ===
C  If NC is negatice then just axis was to be drawn.
C ===
	IF( NC.LT.0 ) RETURN
C ===
C  Determine the IPOS value for the LABEL subroutine
C  for drawing the axis values.
C ===
	IF( ICODE.EQ.0 ) THEN
		DX = -OSV
C		IPOS = 8
		IPOS = 4
	ELSE
		DX = OSV
C		IPOS = 2
		IPOS = 4
	END IF
C ===
C  Draw the axis values at the major tick marks.
C ===
	X = XPOS + DX
	Y = YPOS
	NMAX = 0
C	ANGLE = 0.0
	ANGLE = 90.0

	DO 600 I = 0, INT( AXLEN )
	VALUE = VAL1 + I * VAL3

	CALL CVNUM( VALUE, NDEC, CVALUE, NCHAR )
	CALL LABEL( X, Y, CVALUE, NCHAR, HGTV, SLANT, ANGLE, IPOS, IBOLD )

	IF( NCHAR.GT.NMAX ) NMAX = NCHAR
	Y = Y + 1.0
600	CONTINUE
C ===
C  Determine the number of characters in the axis label.
C ===
	NCHAR = NC
	IF( NCHAR.EQ.0 ) NCHAR = LENCHR( AXLAB )
	CLABEL(1:NCHAR) = AXLAB(1:NCHAR)
C ===
C  Modify the axis label with "x10" if an adjustment was made
C  to the axis values.
C ===
	IF( IENG.EQ.0 ) GOTO 700
	CALL CVNUM( FLOAT(NEXP), 0, CVALUE, N )
	WRITE( CLABEL(NCHAR+1:), 660 ) CVALUE(1:N)
660	FORMAT( '  x10{', A, '}' )
	NCHAR = NCHAR + N + 7
C ===
C  Determine the appropriate IPOS value and X position for the
C  LABEL subroutine to draw the axis label.
C ===
700	DX = NMAX * HGTV * 0.9 + OSV + OSL
	IF( IENG.NE.0 ) DX = DX + 0.5 * OSL

	IF( ICODE.EQ.0 ) THEN
		IPOS = 4
		DX = -DX
	ELSE
		IPOS = 6
	END IF

	ANGLE = 90.0

C ===
C  Draw the axis label.
C ===
	X = XPOS + DX
	Y = YPOS + AXLEN/2.0

	CALL LABEL( X, Y, CLABEL, NCHAR, HGTL, SLANT, ANGLE, -IPOS, IBOLD )
C ===
C  We be done!!
C ===
	RETURN

	END
C ===
C	SUBROUTINE CVNUM( VALUE, NDEC, CHAR, NCHAR )
C
C  This subroutine converts the number VALUE into the character
C  variable CHAR with NDEC number of decimal places.  The number
C  of character placed in CHAR is returned as NCHAR.
C  If NDEC is 0 then the number will appear as an integer with
C  no decimal point.
C ===
	SUBROUTINE CVNUM( V, NDEC, CHAR, NCHAR )
	CHARACTER CHAR*14
	VALUE = V
C ===
C  Determine the number of characters to the left of the
C  decimal point.
C ===
	IF( VALUE.EQ.0 ) THEN
		NLEFT = 1
	ELSE IF( ABS(VALUE).LE.1.0 ) THEN
		NLEFT = 1
	ELSE
		NLEFT = IFIX( LOG10( ABS( VALUE ) ) ) + 1
	END IF
C ===
C  If the number is negative then there is one more character.
C ===
	IF( VALUE.LT.0.0 ) NLEFT = NLEFT + 1
C ===
C  Determine the number of characters to the right of the
C  decimal point.
C ===
	IF( NDEC.EQ.0 ) THEN
		NRIGHT = 0
	ELSE
		NRIGHT = NDEC + 1
	END IF
C ===
C  Do the conversion of VALUE to CHAR.
C ===
	IF( NDEC.EQ.0 ) THEN
		WRITE( CHAR, 1000 ) inINT( VALUE )
	ELSE
		WRITE( CHAR, 2000, ERR=9000 ) VALUE
	END IF
1000	FORMAT( I<NLEFT> )
2000	FORMAT( F<NLEFT+NRIGHT>.<NDEC> )
C ===
C  And finally, put the number of character into NCHAR and return.
C ===
	NCHAR = NLEFT + NRIGHT

	RETURN

9000	TYPE 9010, VALUE, NDEC, NLEFT, NRIGHT
9010	FORMAT( //, 5X, 'ERROR IN CVNUM AT LINE: 41', /,
	1 5X, 'VALUE:', G, /,
	1 5X, 'NDEC =', I, '  NLEFT =', I, '  NRIGHT =', I )

	RETURN

	END
      SUBROUTINE TICKS(X,Y,XAL,YAL)
C
C PROGRAMMER: C.L. MALLORY
C             ALFRED UNIVERSITY
C
C ROUTINE TO PLACE TICK MARKS ON RIGHT AND TOP SIDES OF GRAPH BOX.
C
C ARGUMENT DEFINITIONS:
C
C X,Y - LOCATION OF THE POINT IN COMMON BETWEEN THE
C       CURRENT X AND Y AXIS TO BE TICKED.
C XAL,YAL - X AXIS AND Y AXIS LENGTHS.
C
C LOCAL VARIABLES:
C TL - THE LENGTH OF THE TICK MARK TO BE USED.
C
C
C EXTERNAL SUBROUTINES REQUIRED:
C        PLOT
C
      IXAL=INT( XAL * 2. + .5 )
      IYAL=INT( YAL * 2. + .5 )
      TL=0.07
C TICK THE RIGHT HAND AXIS
	A=1.0
	TK=TL/2.0
	TL=TL-TK
      X1=X+XAL
      CALL PLOT(X1,Y,3)
      DO 10 I=1,IYAL
      Y1=Y+0.5*I
      CALL PLOT(X1,Y1,2)
      CALL PLOT(X1-TL,Y1,2)
      CALL PLOT(X1,Y1,2)
	TL=TL+A*TK
	A=-1.0*A
10    CONTINUE
C TICK THE TOP AXIS.
	TL=0.07
	TK=TL/2.0
	TL=TL-TK
	A=1.0
      Y1=Y+YAL
      CALL PLOT(X1,Y1,3)
      DO 15 I=IXAL-1,0,-1
      X1=X+0.5*I
      CALL PLOT(X1,Y1,2)
      CALL PLOT(X1,Y1-TL,2)
      CALL PLOT(X1,Y1,2)
	TL=TL+A*TK
	A=-1.0*A
15    CONTINUE
      RETURN
      END
