C***********************************************************************
C
C  PROGRAM GHCM
C
C  Transmit the ReGis part of a list of files to SYS$INPUT and reads the
C  Hardcopy back off a VT125 / VT24x screen, placing it into a file.
C  Foreign command interface, 
C   P1 is input files, 
C   P2 is output file,
C   option /TRIM takes away left hand graphic margin,
C   option /FORM adds formfeeds between graphs,
C   option /SELECT allows specifying a list of ordinal graph numbers
C     to take the hardcopy of.  DTR32 usually plots things twice, but
C     you only want the second one, as the first is not cross_hatched.
C
C  John Lloyd
C  MacDonald Dettwiler and Associates
C  3751 Shell Road
C  Richmond, B.C.  V6X 2Z9   CANADA
C
C  5-Nov-1985 / JA Lloyd
C    Added multiple output files; check for minimal set of plots to write
C  to screen; permit use of Ingres GBF files.
C  7-Oct-1985 / JA Lloyd
C
C
C  INPUTS
C
C  OUTPUTS
C
C  COMMON
C
C  SUBROUTINES CALLED
C    OPENINPUT	opens SYS$INPUT for read, setting special characteristics
C    FINIINPUT  closes SYS$INPUT for read, resetting special char + write XON
C    UPLINE	upline dumps the 125/240 screen
C    INLIST	is a number in a list
C    AFLIST	is a number larger than any in a list
C    PRLIST	is a number or number-1 in a list
C    TRIMIT	trims the LA50 form in a temporary file
C    WRITEOUT	write a line to a channel
C
C  FILES
C    SYS$INPUT is the screen
C    INPUT is file to convert from ReGIS to scan
C    OUTPUT is file to dump to; defined by Foreign command method
C
C  SIDE EFFECTS
C    Much smoke and handwaving on the VT125/VT240 screen.  Cleans up after
C    itself, though.
C
C***********************************************************************
C
	PROGRAM GHCM
	implicit	none
C
	integer		selsize
	parameter	(selsize=40)	! number of graphs selected
C
	character*(*)	default_name	! Default input filename
	parameter	(default_name = '*.out;')
C
	character*2	whitespace
	parameter	(whitespace=' '//char(9))
C
	character*1	ff
	parameter	(ff=char(12))
C
	character*(*)	ReGIS_start, ReGIS_stop
	parameter	(ReGIS_start=char(27)//'P',
     *  		 ReGIS_stop=char(27)//'\')
C
	integer*2	chan		! channel to sys$input 
C
	character*1024	inline		! Input lines
	integer		ill		! Length of inline
	integer*2	cll		! Length of command line
C
	logical		inout		! copy graphic line to sys$output?
	logical		needgr		! need this graph?
C
	logical		trim		! trim each graphic file?
	logical		addform		! add formffeeds after each graphic?
C
	character*255	infile		! name of input file
	integer*2	ifl
	character*255	outfile		! name of output file
	integer*2	ofl		! length of outfile
	character*255	outfiledef	! default name of outfile
	character*255	result_name	! name of resultant filename
C
	integer		p1,p2		! positions in input record
C
	integer		graphno		! Ordinal number of graphs
	integer		selist(selsize)	! list of selected graphs
	integer		sell		! length of list; 0 => no list
	logical		fnsel		! is outfile name selection used?
	integer		typsel		! filename type selector
	character*8	selchr(selsize)	! filename type list
	integer		selchrl(selsize)	! filename type lengths
C
	integer		exh_block(4)	! Exit handler control block
	integer		stat		! exit status
C
	integer		libstat		! status of find_file
	integer		context		! context of find_file
C
C  Externals
C
	external	finiinput	! exit handler for openinput
	external	ghcmtbl		! DCL tables
	integer		cli$dcl_parse,	! DCL routines
     *  		cli$get_value,
     *  		cli$present
	external	cli$_present
	integer		lib$find_file
	integer		str$find_first_in_set,
     *  		str$find_first_not_in_set,
     *  		str$position
	integer		loc_iofast$openr,
     *  		loc_iofast$close,
     *  		loc_iofast$get
	logical		inlist		! is a number in a list?
	logical		aflist		! is a number larger than the list?
	logical		prlist		! is a number or n-1 in the list?
C
C-------
C  Begin
C-------
C
C  Get command line
C
	call lib$get_foreign( inline, , cll )
	stat = cli$dcl_parse( 'GHCM '//inline(:cll), ghcmtbl )
	if( .not. stat ) call lib$stop( %val(stat) )
C
C  Open temporary output file
C
	open ( unit=1, 
     *  	name = 'GHCMZZZZ.TMP',
     *  	type = 'SCRATCH',
     *  	organization = 'SEQUENTIAL',
     *  	recordtype = 'VARIABLE',
     *  	carriagecontrol = 'NONE',
     *  	form = 'UNFORMATTED',
     *  	initialsize = 40 )
C
C  Is output to be trimmed?
C
	trim = .false.
	if( cli$present( 'TRIM' ) .eq. %loc(cli$_present) ) 
     *  	trim = .true.
C
C  Add formfeeds?
C
	addform = .false.
	if( cli$present( 'FORM' ) .eq. %loc(cli$_present) ) 
     *  	addform = .true.
C
C  Set up exit handler to restore terminal functions
C
	exh_block (2) = %loc (finiinput)	! Routine
	exh_block (3) = 0			! Number of args
	exh_block (4) = %loc (stat)		! Status field
	call sys$dclexh (exh_block)
C
C  Open SYS$INPUT, ensuring that it is indeed a terminal, and setting
C  some characteristics for QIOs to follow
C
	call openinput( chan )
C
C  Determine output file name, if any
C  Default the filename type, if specified; otherwise defer filename
C  calculation to input filelist loop
C
	outfile = '.'
	if( cli$get_value( 'OUTPUT', inline, cll ) ) then
	   outfile = inline(:cll)
	   outfiledef = default_name
	   fnsel = .false.
	   typsel = 1
	else
	   fnsel = .true.
	   typsel = 1
	endif
C
C  For all input filenames in the list
C
	do while( cli$get_value( 'INPUT', inline, cll ) )
	infile = inline(:cll)
C
C  Search for the input file(s)
C
	context = 0
	libstat = lib$find_file( 
     *  		infile,
     *  		result_name,
     *  		context,
     *  		default_name,
     *  		)
C
C  get list of graph numbers to plot, if any
C
	graphno = 1
	sell = 0
	call getsel( selist, sell, selchr, selchrl )
	needgr = prlist( selist, sell, graphno )
C
C  Open final output file, with name conditional on filename selection
C
	if( fnsel ) then
	   outfile = '.'//selchr(typsel)
	   outfiledef = result_name
	else
	open ( unit=2, 
     *  	name = outfile,
     *  	defaultfile = outfiledef,
     *  	type = 'NEW',
     *  	organization = 'SEQUENTIAL',
     *  	recordtype = 'VARIABLE',
     *  	carriagecontrol = 'NONE',
     *  	form = 'UNFORMATTED',
     *  	initialsize = 50 )
	endif
C
C  For each input file
C
	do while ( libstat )
	stat = loc_iofast$openr( 1, result_name, )
	if( .not. stat ) goto 100
C
C  Write complete Regis graphs to chan
C
	stat=loc_iofast$get( 1, inline, ill )
	if( .not. stat ) goto 100
	inout = .false.
	do while (stat)
	   p1 = str$position(inline(:ill), ReGIS_start)
	   if( p1 .eq. 0 ) p1 = 1
	   p2 = str$position(inline(:ill), ReGIS_stop ) + 
     *  	len(ReGIS_stop)
	   if( p2 .eq. len(ReGIS_stop) ) p2 = ill
	   if( 0 .ne. str$position(inline(:ill), ReGIS_start) ) 
     *  	inout=.true.
	   if( inout .and. needgr ) call writeout( chan, inline(:ill) )
	   if( inout .and. 
     *  	(0 .ne. str$position(inline(:ill), ReGIS_stop)) ) then
	      inout=.false.
C
C  Check if this graph is wanted
C
		if( inlist( selist, sell, graphno ) ) then
C
C		Upline load screen bitmap
C
		call upline( chan, 1 )
C
C		Re-write the temporary file to actual output, trimming if necc
C
		   if( fnsel )
     *  		open ( unit=2, 
     *  		name = outfile,
     *  		defaultfile = outfiledef,
     *  		type = 'NEW',
     *  		organization = 'SEQUENTIAL',
     *  		recordtype = 'VARIABLE',
     *  		carriagecontrol = 'NONE',
     *  		form = 'UNFORMATTED',
     *  		initialsize = 50 )
		call trimit( 1, 2, trim )
C
C		Add a formfeed
C
		if( addform )write( unit = 2 ) ff
C
C		If filename selection, then reopen output file
C
		if( fnsel ) then
		   typsel = typsel + 1
		   outfile = '.'//selchr(typsel)
		   outfiledef = result_name
		   close( unit = 2 )
		endif
		endif
	      if( aflist( selist, sell, graphno ) ) goto 100
	      graphno = graphno + 1
	      needgr = prlist( selist, sell, graphno )
	   endif
C
C  Read next record
C
	stat=loc_iofast$get( 1, inline, ill )
C
C  End record loop
C
	end do
C
C  End file loop
C
100	stat = loc_iofast$close( 1 )
	libstat = lib$find_file( infile,
     *  		result_name,
     *  		context,
     *  		default_name, )
	end do
C
C  End input filename list loop
C
	end do
C
C  Finished all images
C
200	close( unit = 1 )
	close( unit = 2 )
	end
C***********************************************************************
C
C  SUBROUTINE UPLINE
C
C  This routine upline loads the screen contents of a VT125/VT240/VT241
C
C  7-Oct-1985 / JA Lloyd
C
C
C  INPUTS
C    chan	channel to read from
C    unit	fortran unit to write to
C
C  OUTPUTS
C
C  COMMON
C
C  SUBROUTINES CALLED
C    FIRSTLINE  starts off upline dump of screen, getting a line of text back
C    GETLINE    reads next line of upline dump
C
C  FILES
C
C  SIDE EFFECTS
C
C***********************************************************************
C
	SUBROUTINE UPLINE( chan, unit )
C
	INTEGER*2		chan
	INTEGER			unit
C
	character*1	esc
	parameter	(esc= char(27))
C
	character*2	ST
	parameter	(ST=esc//'\')
C
	character*1024	inline		! input lines
	integer*2	ill		! Length of inline
	integer		stcnt		! count of ST sequences
C
C  Repeat reads, terminating on dash, cr, or backslash
C  Last read is as result of 4 * ST received
C
	stcnt = 1
	call firstline( chan, inline, ill )
	write( 1 ) ill, inline(:ill)
	do while (.true.)
	   call getline( chan, inline, ill )
	   if( ill .le. 0 ) goto 100
	   if( ill .gt. 1 ) then
	      if( inline(ill-1:ill) .eq. ST ) stcnt = stcnt + 1
	   end if
	   write( 1 ) ill, inline(:ill)
	   if( stcnt .ge. 4 ) goto 100
	end do
C
C  Done
C
100	return
	end
C***********************************************************************
C
C  SUBROUTINE WRITEOUT
C
C    Write a line to a channel
C
C  INPUT
C    chan	channel
C    line	line of text
C
C***********************************************************************
C
	SUBROUTINE WRITEOUT( chan, line )
C
	integer*2		chan
	character*(*)		line
C
	integer		s		! status
C
C  Externals
C
	external	IO$_WRITEVBLK
	integer		SYS$QIOW
C
	s = SYS$QIOW( , %VAL( CHAN ), IO$_WRITEVBLK,
     *  	, , ,
     *  	%REF( line ), %VAL( LEN( line ) ),
     *  	, , , )
	if(.not.s)call lib$stop(%val(s))
	return
	end
C***********************************************************************
C
C  SUBROUTINE OPENINPUT
C  SUBROUTINE FINIINPUT
C
C  This routine assigns a channel to SYS$INPUT, and issues the
C  appropriate SETMODE commands to make it work.  FINIINPUT resets
C  the terminal characteristics, and is recommended as an exit mode handler.
C
C  8-Sep-1985 / JA Lloyd
C
C  INPUTS
C
C  OUTPUTS
C
C    CHANNEL	VMS Channel number to the terminal port.
C
C  COMMON
C
C  SUBROUTINES CALLED
C    SYS$QIOW	VMS queue IO
C    SYS$ASSIGN	VMS assign channel to device
C    LIB$SIGNAL	VMS signal software exception
C
C  FILES
C
C  SIDE EFFECTS
C
C***********************************************************************
C
	SUBROUTINE OPENINPUT( CHANNEL )
C
	INTEGER*2		CHANNEL			! Dummy argument
C
	CHARACTER*1		DC1
	PARAMETER		(DC1=CHAR(17))
C
	INTEGER			ONBITS, OFFBITS		! Bits in TTCHAR
C
C  QIO IOSB structure
C
	INTEGER*2		IOSB(4)			! Word aligned
	BYTE			BIOSB(8)		! Byte sized
	INTEGER*2		TIO_STAT		! Completion status
	EQUIVALENCE		(IOSB(1),TIO_STAT),
     *  			(IOSB(1),BIOSB(1))
C
C  Sensemode / setmode buffer
C
	BYTE		SENSEBUF(12)
	BYTE		SB_CLASS	! Device class (DC$_TERM)
	BYTE		SB_TYPE		! Device type (e.g. unknown, vt100)
	BYTE		SB_LENG		! Page length (lines)
	INTEGER*2	SB_WIDT		! Page width (columns)
	INTEGER		SB_CHAR		! Basic characteristics (24 bits)
	INTEGER		SB_XCHAR	! Extended char (32 bits)
	EQUIVALENCE	(SENSEBUF(1),SB_CLASS),
     *  		(SENSEBUF(2),SB_TYPE),
     *  		(SENSEBUF(3),SB_WIDT),
     *  		(SENSEBUF(5),SB_CHAR),
     *  		(SENSEBUF(8),SB_LENG),
     *  		(SENSEBUF(9),SB_XCHAR)
C
	INTEGER		QIOSTAT		! QIO status
	BYTE		LENG		! local copy of SB_LENG
C
C  Save old terminal characteristics
C
	INTEGER			OLDCHAR(4)
	INTEGER*2		LOCAL_CHAN
C
C  Function codes and status values
C
	EXTERNAL	IO$_SENSEMODE, IO$_SETMODE
	EXTERNAL	IO$_WRITEVBLK
	EXTERNAL	DC$_TERM
	EXTERNAL	TT$M_NOBRDCST, TT$M_NOECHO, TT$M_TTSYNC
	EXTERNAL	TT$M_HOSTSYNC
	EXTERNAL	TT$M_READSYNC, TT$M_ESCAPE, TT$M_HALFDUP
	EXTERNAL	TT$M_NOTYPEAHD, TT$M_WRAP
	EXTERNAL	TT2$M_PASTHRU
	EXTERNAL	SS$_NORMAL, SS$_IVLOGNAM, SS$_IVDEVNAM
	EXTERNAL	SS$_REMOTE
C
C  External routines
C
	INTEGER		SYS$ASSIGN, SYS$QIOW
C
C  Saves
C
	SAVE		OLDCHAR, LOCAL_CHAN
C*
C
C  Assign a channel to the terminal port used
C
	QIOSTAT = SYS$ASSIGN( 'SYS$INPUT', CHANNEL, , )
	IF( QIOSTAT .EQ. %LOC( SS$_IVLOGNAM ) .OR.
     *      QIOSTAT .EQ. %LOC( SS$_IVDEVNAM )      )
     *  CALL LIB$SIGNAL( SS$_IVLOGNAM )
	IF( QIOSTAT .NE. %LOC( SS$_NORMAL )   .AND.
     *      QIOSTAT .NE. %LOC( SS$_REMOTE )        )
     *  THEN
	   CALL LIB$STOP( %VAL( QIOSTAT ) )
	ENDIF
	LOCAL_CHAN = CHANNEL
C
C  Sense terminal characteristics
C
	QIOSTAT = SYS$QIOW( , %VAL( CHANNEL ),
     *  	IO$_SENSEMODE, IOSB, , ,
     *  	SENSEBUF, %VAL( 12 ), , , , )
	IF( QIOSTAT .NE. %LOC( SS$_NORMAL ) )
     *  CALL LIB$SIGNAL( %VAL( QIOSTAT ) )
	IF( TIO_STAT .NE. %LOC( SS$_NORMAL ) )
     *  CALL LIB$SIGNAL( %VAL( TIO_STAT ) )	
	QIOSTAT = SYS$QIOW( , %VAL( CHANNEL ),
     *  	IO$_SENSEMODE, IOSB, , ,
     *  	OLDCHAR, %VAL( 12 ), , , , )
C
C  Check this is a terminal
C
	IF( SB_CLASS .NE. %LOC( DC$_TERM ) )
     *  CALL LIB$SIGNAL( SS$_IVLOGNAM )
C
C  Adjust device characteristics, and extended characteristics
C
	LENG=SB_LENG	
	ONBITS  = %LOC( TT$M_NOBRDCST ) 
     *  	+ %LOC( TT$M_NOECHO ) 
     *  	+ %LOC( TT$M_TTSYNC ) 
     *  	+ %LOC( TT$M_HOSTSYNC ) 
     *  	+ %LOC( TT$M_READSYNC ) 
	OFFBITS = %LOC( TT$M_ESCAPE )
     *  	+ %LOC( TT$M_HALFDUP )
     *  	+ %LOC( TT$M_NOTYPEAHD )
     *  	+ %LOC( TT$M_WRAP )
	SB_CHAR = (SB_CHAR .AND. .NOT. OFFBITS) .OR. ONBITS
	SB_LENG=LENG
	ONBITS = %LOC( TT2$M_PASTHRU )
	SB_XCHAR = SB_XCHAR .OR. ONBITS
	QIOSTAT = SYS$QIOW( , %VAL( CHANNEL ),
     *  	IO$_SETMODE, IOSB, , ,
     *  	SENSEBUF, %VAL( 12 ), , , , )
	IF( QIOSTAT .NE. %LOC( SS$_NORMAL ) )
     *  	CALL LIB$SIGNAL( %VAL( QIOSTAT ) )
	IF( TIO_STAT .NE. %LOC( SS$_NORMAL ) )
     *  	CALL LIB$SIGNAL( %VAL( TIO_STAT ) )	
C
	RETURN
C***********************************************************************
C
C  SUBROUTINE FINIINPUT
C
C    Reset the characteristics of the input terminal back to normal
C
C***********************************************************************
C
	ENTRY	FINIINPUT
C
C  reset terminal characteristics
C
	QIOSTAT = SYS$QIOW( , %VAL( LOCAL_CHAN ),
     *  	IO$_SETMODE, IOSB, , ,
     *  	OLDCHAR, %VAL( 12 ), , , , )
C
C  write out an XON to allow the terminal to transmit
C
	QIOSTAT = SYS$QIOW( , %VAL( LOCAL_CHAN ),
     *  	IO$_WRITEVBLK, IOSB, , ,
     *  	%REF( DC1 ), %VAL( LEN( DC1 ) ), , , , )
C
C  flush the output file
C
	close( unit=1, disp='DELETE' )
	close( unit=2 )
	RETURN
	END
C***********************************************************************
C
C  SUBROUTINE GETLINE
C  SUBROUTINE FIRSTLINE
C
C  Gets a line from the terminal.  FIRSTLINE gets the first line with a
C  special prompt.  Requires a ReGis terminal that has been loaded with
C  a plot (e.g. by DTR or a TYPE command).
C
C  8-Sep-1985 / JA Lloyd
C
C  INPUTS
C
C  OUTPUTS
C
C  COMMON
C
C  SUBROUTINES CALLED
C
C  FILES
C
C  SIDE EFFECTS
C
C***********************************************************************
C
	SUBROUTINE GETLINE( chan, l, ll )
C
	character*1	esc, cr, nul
	parameter	(esc=char(27), cr=char(13), nul=char(0))
	character*(*)	hardcopy
C	parameter	(hardcopy= esc // '[2J' // 			! Erase screen
	parameter	(hardcopy= 
     *  		 esc // '[?2i' // esc //			! Media copy to host
     *  		 'P1pS(H)S(E)P[100,200]@BS(H)' //		!  Regis: Hardcopy
     *  		 'W(I(W))P[,500]' //				! Write white; drop to bottom
     *  		 esc // '\' // esc // '[1;24r' //		! End Regis; scroll whole screen
     *  		 esc // '[24;0f' // nul // nul // nul //	! Goto bott lh corner
     *  		 esc // '[20;0f' //				! Goto 4 lines up
     *  		 esc // '[?0i' )				! Media copy to printer port
C
	character*64	terminators		! terminator bit set; 
	logical		term_def		! has terminators been defined
	data		term_def/.false./
	integer*2	chan
	character*(*)	l
	integer*2	ll
C
	integer		s			! status
C
C  QIO IOSB structure
C
	INTEGER*2		IOSB(4)			! Word aligned
	BYTE			BIOSB(8)		! Byte sized
	INTEGER*2		TIO_STAT		! Completion status
	INTEGER*2		TERM_LOC		! Offset to terminator
	INTEGER*2		TERMINAT		! Termination char
	INTEGER*2		TERM_SIZ		! Size of termination string
	EQUIVALENCE		(IOSB(1),TIO_STAT),
     *  			(IOSB(1),BIOSB(1)),
     *  			(IOSB(2),TERM_LOC),
     *  			(IOSB(3),TERMINAT),
     *  			(IOSB(4),TERM_SIZ)
C
C  Externals
C
	INTEGER		SYS$QIOW
	EXTERNAL	IO$_READVBLK, IO$_READPROMPT
C
C  what to keep
C
	save	term_def
C
C-------
C  BEGIN
C-------
C
	s = SYS$QIOW( , %VAL( CHAN ), IO$_READVBLK,
     *  	IOSB, , ,
     *  	%REF( l ), %VAL( LEN( l ) ),
     *  	, TERMINATORS, , )
C
	if( .not. s ) call lib$signal( %val(s) )
	if( .not. tio_stat ) call lib$signal( %val(tio_stat) )
	ll = term_siz + term_loc
	return
C
C***********************************************************************
C
C  SUBROUTINE FIRSTLINE
C
C  This entry point starts off the dump of things with a special prompt.
C
C***********************************************************************
C
	entry firstline( chan, l, ll )
C
	if( .not. term_def ) then
	   call lib$insv( 1, ichar( '\' ), 1, %ref( terminators ) )
	   call lib$insv( 1, ichar( cr  ), 1, %ref( terminators ) )
	   call lib$insv( 1, ichar( '-' ), 1, %ref( terminators ) )
	   term_def = .true.
	   endif
	s = SYS$QIOW( , %VAL( CHAN ), IO$_READPROMPT,
     *  	IOSB, , ,
     *  	%REF( l ), %VAL( LEN( l ) ),
     *  	, TERMINATORS, 
     *  	%ref( hardcopy ), %val( len(hardcopy) ) )
C
	if( .not. s ) call lib$signal( %val(s) )
	if( .not. tio_stat ) call lib$signal( %val(tio_stat) )
	ll = term_siz + term_loc
	return
	end
C***********************************************************************
C
C  SUBROUTINE TRIMIT
C
C  This routine reads a temporary scratch file, determining the left-hand
C  margin of the LA50 graphic output, and rewrites it to an output file,
C  trimming it.
C
C  INPUTS
C    chani	input fortran unit number
C    chano	output fortran unit number
C    trim	logical controlling trimming
C
C***********************************************************************
C
	SUBROUTINE TRIMIT( chani, chano, trim )
C
	character*(*)		digits, repchar, graphnull
	parameter		(digits='0123456789')	! ASCII digits
	parameter		(repchar='!')		! graphic repeat
	parameter		(graphnull='?')		! graphic blanks
C
	integer 		chani, chano
	logical			trim
C
	character*(1024)	inline
	integer*2		ill
C
	integer			litleft		! smallest left margin
	character*3		litchar		! ...character form
	integer			s,j		! temporary counters
	integer			i		! location in inline
	integer			firsti, lasti	! location of #s in inline
C
	integer			str$position
C
	litleft = 999
	rewind( unit = chani )
	do while (.true.)
100	   read( chani, end=200 ) ill, inline(:ill)
	   if( trim .and. (ill .gt. 5) ) then
	      i = 1
	      j = 0
	      do while( inline(i:i) .eq. repchar )
		i = i + 1
		s = 0
		do while( 0.ne.str$position( inline(i:i), digits ) )
		   s = s*10 + ichar(inline(i:i)) - ichar('0')
		   i = i + 1
		end do
		if( inline(i:i) .eq. graphnull ) then
		   j = j + s
		   i = i + 1
		endif
	     end do
	   if( j .lt. litleft ) litleft = j
	   endif
	end do
200	rewind( unit = chani )
	do while (.true.)
	   read( chani, end=300 ) ill, inline(:ill)
	   if( trim .and. (ill .gt. 5) ) then
	      i = 1
	      j = litleft
	      do while( inline(i:i) .eq. repchar )
		i = i + 1
		s = 0
		firsti = i
		do while( 0.ne.str$position( inline(i:i), digits ) )
		   s = s*10 + ichar(inline(i:i)) - ichar('0')
		   i = i + 1
		end do
		lasti = i - 1
		if( inline(i:i) .eq. graphnull ) then
		   if( s - j .lt. 0 ) then
		      s = 0
		      j = j - s
		   else
		      s = s - j
		      j = 0
		   endif
		   do while( lasti .ge. firsti )
		      inline(lasti:lasti) = char( ichar('0') +
     *  				    s - 10 * (s / 10) )
		      s = s / 10
		   end do
		endif
	     end do
	   endif
	   write( chano ) inline(:ill)
	end do
300	rewind( unit = chani )
	return
900	format( 'BN,I3' )
901	format( 'BZ,I3' )
	end
C***********************************************************************
C
C  SUBROUTINE GETSEL
C
C    This routine builds a list of numbers, obtained from the DCL
C  option on the input file, used to select which plots of a number of
C  plots are actually converted.  The reason for this option is for
C  area fills that, for example, DTR32 produces without adding a spatial
C  pattern.  Such plots print black, rather than patterned, and are
C  always produced by DTR32, even if you want the cross_hatched form.
C
C  INPUTS
C    l		list
C    ll		length of list
C
C  OUTPUTS
C    alpha	alpha form of list
C    alphal	length of each of alpha
C
C***********************************************************************
C
	SUBROUTINE GETSEL( l, ll, alpha, alphal )
C
	integer			l(1)		! list
	integer			ll		! Argument
	character*(8)		alpha(1)	! Argument
	integer			alphal(1)	! Argument
	integer			i
C
	integer			j		! temporary
	character*8		val		! string form of numbers
	integer*2		vall		! len of val
	integer			s		! status from CLI routines
C
C  Externals
C
	integer			cli$get_value
	external		cli$_absent
C
	ll = 0
	s = cli$get_value( 'SELECT', val, vall)
C
	do while( s )
	   call ots$cvt_ti_l( val(:vall), j )
	   ll = ll + 1
	   l(ll) = j
	   alpha(ll) = val(:vall)
	   alphal(ll) = vall
	   s = cli$get_value( 'SELECT', val, vall )
	end do
	if( s .ne. %loc( cli$_absent ) ) call lib$stop( %val(s) )
	return
	end
C
C***********************************************************************
C
C  LOGICAL FUNCTION INLIST
C
C  INPUTS
C    i		item potentially in list
C  OUTPUTS
C    inlist	.true. if i is in list, or list length is zero
C
C***********************************************************************
C
	LOGICAL FUNCTION INLIST( l, ll, i )
C
	integer		l(1), ll, i
C
	inlist=.true.
	if( ll .le. 0 ) return
C
	do j=1,ll
	if( l(j) .eq. i ) return
	end do
	inlist=.false.
	return
	end
C
C***********************************************************************
C
C  LOGICAL FUNCTION AFLIST
C
C  INPUTS
C    i		item potentially larger than elements in list
C  OUTPUTS
C    aflist	.true. if i is le list, or list length is zero
C
C***********************************************************************
C
	LOGICAL FUNCTION AFLIST( l, ll, i )
C
	integer		l(1), ll, i
C
	aflist=.false.
	if( ll .le. 0 ) return
C
	do j=1,ll
	if( l(j) .ge. i ) return
	end do
	aflist=.true.
	return
	end
C
C***********************************************************************
C
C  LOGICAL FUNCTION PRLIST
C
C    This rather complicated function determines if a plot number is
C  equal to or prior to (one less than) any element of plots in a list.
C  The reason for including priors is that some prior plots define things
C  for example legends that are not defined on the plot of interest, 
C  especially if the plot of interest is a cross-hatched version.
C
C  INPUTS
C    i		item potentially in list
C  OUTPUTS
C    inlist	.true. if i or i-1 is in list, or list length is zero
C
C***********************************************************************
C
	LOGICAL FUNCTION PRLIST( l, ll, i )
C
	integer		l(1), ll, i
C
	prlist=.true.
	if( ll .le. 0 ) return
C
	do j=1,ll
	if( (l(j) .eq. i) .or. (l(j) .eq. (i+1)) ) return
	end do
	prlist=.false.
	return
	end
