c************
c  Description: Static Raster plotter for X-terminal graphics
c
c  Author:	JGS   7/1/91  (Pilfered mostly from XRTRaster)
c
c  $Revision: 1.1 $
c  $Modtime:   01 Aug 1997 15:30:52  $
c  MIB 06-Jul-2000 DR RRCcl00988
c    Repaired " z:" and "dz:" cursor readouts when in x-cut or y-cut plot mode
c    when "zspecs" are displayed.
c  MRSL/TAS 13-Feb-2001 Fixes for scroll bar overwritten by frame data.
c  MRSL/TAS 13-Feb-2001 Fixes for unzoom message from x or y cuts.
c  
c************

	program XRASTER
c
	include 'xraster.inc'
	logical*4 pause,autoexit

	call M$CHECKIN
	call XRASTER_INIT
	autoexit = M$GET_SWITCH('AUTOEXIT').gt.0
	call M$SYNC

	call XRASTER_RESTART
	call ACCESSORIES (a_c+a_p, 1)

	pause = .false.

	do while (.not. (Mc.break .or. Mx.breakflag))
	  if (pause) call M$PAUSE (Mc.pause)
	  pause = .not. Gx.reading
	  if (Gx.reading) call XRASTER_READ
	  if (XRASTER_MSG()) pause = .false.
	  if (Gx.hold .lt. 2) then
	    if (XRASTER_EVENT()) pause = .false.
	  endif
	  if (autoexit .and. .not.Gx.reading) Mx.breakflag = .true.
	enddo
c
	call XRASTER_CLEANUP
	call MSGDO(MSK_EXIT)
	call M$RETURN
c
	end


	subroutine XRASTER_CLEANUP

	include 'xraster.inc'

	if (Gx.HIN.open) call M$CLOSE (Gx.HIN)
	if (Gx.mbuf.p .ne. 0) call M$FREE (Gx.mbuf)
	if (Gx.lbuf.p .ne. 0) call M$FREE (Gx.lbuf)
	if (Gx.bs.buf.p .ne. 0) call M$FREE (Gx.bs.buf)
	if (Gx.rbuf.p .ne. 0) call M$FREE (Gx.rbuf)
	call MX$FACILITIES (Gx.xf, 'ABP', L_CleanExit)
	call MX$CLOSE

	return
	end

	subroutine XRASTER_INIT

	include 'xraster.inc'
	external DISPLAY_SPECS
	character cmode*2, ch
	character*80 filename
	real*4 dbscale
	integer*2 map5(28) / 0,0,0,40, 50,0,45,55, 50,0,55,55, 
     &		50,0,70,20, 75,75,40,25, 100,100,100,95, 100,100,100,100 /

c open input file - set frame length
	filename   = M$APICK(1)
	Gx.zmin    = M$FPICK(2)
	Gx.zmax    = M$FPICK(3)
	cmode      = M$APICK(4)
	Gx.xframe  = M$DPICK(5)
	Gx.ncolors = M$BPICK(6)
	if (iabs(Gx.ncolors).lt.2) Gx.ncolors = isign(2,Gx.ncolors)
c
c get autoscaling and exponential length and init real time range
	Gx.autom = max (0, min (3, M$GET_SWITCH('AUTO')))
	if (Gx.autom.eq.0) then
	  if (.not.M$PPICK(2)) Gx.autom = 1
	  if (.not.M$PPICK(3)) Gx.autom = Gx.autom + 2
	  if (Gx.autom.eq.3) Gx.autom = 5	! first pass auto fix
	endif
	Gx.autol = M$GET_SWITCH('AUTOL')
	if (Gx.autol.lt.0) Gx.autol = 5
c
c get widget controls mode
	Gx.cntrls = M$GET_SWITCH('XCNT')
	if (Gx.cntrls.gt.2 .or. Gx.cntrls.lt.0) Gx.cntrls = 1
c
c figure out X and Y mouse results parameter labels
	if (M$GET_USWITCH('XMN',Gx.mouse) .le. 0)  Gx.mouse = 'MOUSE'
c
c get forced lines per frame switch
	Gx.lpf = M$GET_SWITCH('LPF')
	if (Gx.lpf.eq.-1) Gx.lpf = 1
	Gx.all = M$GET_SSWITCH('ALL')
c
c get axes, crosshairs switches
	Gx.axes = M$GET_SWITCH('AXES') .gt. 0
	Gx.cross = M$GET_SWITCH('NOCROSS') .le. 0
c
c open file
	Gx.HIN.file_name = ' '
	Gx.HIN.open = .false.
	call XRASTER_OPENFILE (filename, 0)
c
c report file open status
	if (.not. Gx.HIN.open .and. filename.ne.' ')  then
	  call MX$MESSAGE ('Could not open file '//filename,1.0)
	endif
c
c get complex/display mode
	if (Gx.cx) then
	  Gx.cmode = 1		! Default to magnitude mode for COMPLEX data
	  if (cmode.eq.'PH') Gx.cmode = 2	! These modes are valid only
	  if (cmode.eq.'RE') Gx.cmode = 3	! for complex data
	  if (cmode.eq.'IM') Gx.cmode = 4
	else
	  Gx.cmode = 3		! Default to real mode for scalar data
	  if (cmode.eq.'MA') Gx.cmode = 1
	endif
	if (cmode.eq.'LO' .or. cmode.eq.'D1') Gx.cmode = 5
	if (cmode.eq.'L2' .or. cmode.eq.'D2') Gx.cmode = 6
c
c convert 'LO' and 'L2' parameters to DB and set lower limit on DB values
	Gx.dbmin = 1e-20
	Gx.dbrange = M$GET_SWITCH('DBRANGE')
	if (Gx.dbrange.lt.0 .and. cmode(1:1).ne.'L') Gx.dbrange = 50.d0
	if (Gx.cmode .ge. 5) then
	  dbscale = 10.0
	  if (Gx.cmode.eq.6) dbscale = 20.0
	  if (cmode(1:1).eq.'L') then	! keep backwords compatible behavior
	    if (Gx.cx) then
	      Gx.zmin = amax1(Gx.zmin, 1e-10)
	      Gx.zmax = amax1(Gx.zmax, 1e-10)
	    else
	      Gx.zmin = amax1(Gx.zmin, 1e-20)
	      Gx.zmax = amax1(Gx.zmax, 1e-20)
	    endif
	    Gx.zmin = log10(Gx.zmin) * dbscale
	    Gx.zmax = log10(Gx.zmax) * dbscale
	  elseif (Gx.cx) then	! these values must be squared
	    Gx.zmin = amax1(-18.0 * dbscale, Gx.zmin)
	    Gx.zmax = amax1(-18.0 * dbscale, Gx.zmax)
	    Gx.dbmin = 1e-37		! smallest possible float
	  elseif (amin1(Gx.zmin,Gx.zmax) .lt. -20.0*dbscale) then
	    Gx.zmin = amax1(-37.0 * dbscale, Gx.zmin)
	    Gx.zmax = amax1(-37.0 * dbscale, Gx.zmax)
	    Gx.dbmin = 10**(amin1(Gx.zmin,Gx.zmax)/dbscale)
	  endif
	endif
	Gx.rmin = Gx.zmin
	Gx.rmax = Gx.zmax

c
c set up raster window size and open X-window
	call MX$SETUP (Mc.width,Mc.height)
	call MX$OPEN ('X-Raster')
	call MX$SETFONT (min(8,Mx.width/67))
c
c setup colormap 
	Gx.cmap = M$GET_SWITCH('XC')
	if (Gx.ncolors.lt.0) then		! greyscale
	  Gx.ncolors = -Gx.ncolors
	  Gx.cmap = max (1, Gx.cmap)
	endif
	if (Gx.cmap.lt.1 .or. Gx.cmap.gt.5) then
	  if (Gx.cmode.eq.2) Gx.cmap = 3	! color wheel
	  if (Gx.cmode.ne.2) Gx.cmap = 2	! color ramp
	endif
	call M$MOVE(map5, Gx.map5, 28*2)
	if (Gx.cmap.ne.5) call MX$COLORMAP (Mc.colormap(Gx.cmap), Gx.ncolors)
	if (Gx.cmap.eq.5) call MX$COLORMAP (Gx.map5, Gx.ncolors)
	! if only one color is given, allocate the bgcolor to slot 1
	! and the color allocated to slot 2 so the color is the high value
	if (Gx.ncolors.eq.1) then
	  Mx.pixel(2) = Mx.pixel(1)
	  Mx.pixel(1) = Mx.black
	  Gx.ncolors = 2
	endif
c
c set the rubberband GC to double thick in two XOR's unless we are already
c limited to BLACK and WHITE.  (helps out on color rasters to try two XORs)
	if (MX$QUERY('B').eq.0) call MX$DRAW_MODE(L_RModeOn)
c
c set up the facilities used
	Mx.origin = 4
#if _PGF77|_HPUX
	Gx.xf.ROUTINE.p = get_address(DISPLAY_SPECS)
#else
	Gx.xf.ROUTINE.p = %loc(DISPLAY_SPECS)
#endif
	Gx.xf.xy = .false.
	Gx.xf.mannt = 20
	Gx.xf.mbox = 100
	Gx.xf.mpoint = 1024
	call MX$FACILITIES (Gx.xf, 'ABP', L_InitFacilities)
c
c if MSGID switch is indicated, this plot will send & respond to
c status change messages
	Gx.xf.msgid   = M$GET_SWITCH ('MSGID')
	Gx.xf.msgmask = max (0, M$GET_SWITCH ('MASK'))
	Gx.mimic      = M$GET_SWITCH ('MIMIC')
c
c set counters/initializations
	if (M$GET_USWITCH('SPECS',ch).lt.0) ch = ' '
	Gx.iabsc = M$SEARCH('IRS',ch)
	Gx.lbuf.p = 0
	Gx.mbuf.p = 0
	Gx.rbuf.p = 0
	Gx.bs.buf.p = 0
	Mx.level = 1
	Gx.readlevel = 1
	Gx.pcut = M$GET_SWITCH('PCUTS') .ge. 1
	Gx.xmap.ip = 0
	Gx.ymap.ip = 0
	Gx.cmp = min(4, max(1, M$GET_SWITCH('CMP')))
	Gx.lvl(1).cut = 0
	Gx.offset = 0.d0
	Gx.lpb_ask = M$GET_SWITCH('LPB')
	Gx.inmem = M$GET_PSWITCH('INMEM')
	Gx.autorr = M$GET_PSWITCH('AUTORR')
	Gx.cbar = M$GET_PSWITCH('CBAR')
	Gx.specs = M$GET_SWITCH('SPECS') .ne. 0
	Gx.fast = .not. M$GET_PSWITCH('EXACT')
	Gx.readmax = 0.d0
	Gx.istart = 0
	Gx.xmrk = 0.d0
	Gx.ymrk = 0.d0
	Gx.zmrk = 0.d0
	Gx.xlab = M$GET_SWITCH('XLAB')
	Gx.ylab = M$GET_SWITCH('YLAB')
	Gx.zlab = M$GET_SWITCH('ZLAB')
	if (M$GET_USWITCH('XFMT',Gx.xfmt) .le. 0)  Gx.xfmt = ' '
	if (M$GET_USWITCH('YFMT',Gx.yfmt) .le. 0)  Gx.yfmt = ' '
	if (M$GET_USWITCH('ZFMT',Gx.zfmt) .le. 0)  Gx.zfmt = ' '
	Gx.dstart = 1.d0
c
c initialize the coutours variables
	Gx.ctm = max(0,min(2,M$GET_SWITCH('CTM')))
	Gx.ctc = M$GET_SWITCH('CTC') 
	if (.not.M$GET_PSWITCH('CTC')) Gx.ctc = 0
	Gx.ctl = M$GET_SWITCH('CTL') 

	return
	end

	subroutine XRASTER_OPENFILE (name, mode)

	include 'xraster.inc'
	character*(*) name
	integer*4 mode, nbytes
	record /HEADER/ HCB

	if (Gx.HIN.open) call M$CLOSE (Gx.HIN)

	HCB.file_name = name
	HCB.type_allow = '1000,2000'
	HCB.format_allow = 'S#,C#'
	HCB.switch = 'NOABORT'
	call M$INOK (HCB)

	if (HCB.open) then
	  if (HCB.pipe.ne.0) then
	    Gx.inmem = .true.
	    HCB.size = Mu.todo
	  endif
	  if (HCB.xdelta .eq. 0) then
	    call M$WARNING ('File has 0.0 X abscissa delta, using 1.0')
	    HCB.xdelta = 1
	  endif
	  if (HCB.class .eq. 2) then
	    if (HCB.subsize .eq. 0) then
	      call M$WARNING ('Type 2000 file has 0 element subsize, using 1.')
	      HCB.subsize = 1
	    endif
	    if (Gx.xframe.lt.0.d0) then
	      Gx.xframe = min(dabs(Gx.xframe), HCB.size*HCB.subsize)
	      HCB.ydelta = HCB.ydelta * (Gx.xframe/HCB.subsize)
	    else
	      Gx.xframe = HCB.subsize
	    endif
	    if (HCB.ydelta .eq. 0) then
	      call M$WARNING ('File has 0.0 Y abscissa delta, using 1.0')
	      HCB.ydelta = 1.d0
	    endif
	  else
	    Gx.xframe = min(dabs(Gx.xframe), HCB.size)
	  endif
	  if (Gx.xframe .eq. 0) then
	    call M$WARNING ('0.0 element X frame detected, using 1.d0.')
	    Gx.xframe = 1.d0
	  endif
	  if (HCB.class .eq .2) then
	    Gx.xstart = HCB.xstart
	    Gx.xdelta = HCB.xdelta
	    Gx.ystart = HCB.ystart
	    Gx.ydelta = HCB.ydelta
	  else
	    Gx.xstart = 0.d0
	    Gx.xdelta = HCB.xdelta
	    Gx.ystart = HCB.xstart
	    Gx.ydelta = Gx.xdelta*Gx.xframe
	  endif
	  call M$FORCE1000 (HCB)
	  if (HCB.format.ne.'SO') HCB.buf_type = 'F'
	  Gx.cx = HCB.format(1:1).eq.'C'
	  if (.not.Gx.cx .and. Gx.cmode.eq.2 .or. Gx.cmode.eq.4) Gx.cmode = 3
	  call M$MOVE (HCB, Gx.HIN, L_header_size)
	  Gx.readmax = 0.d0
	  Mx.resize = .true.

	else
	  if (name.ne.' ') then
	    if (mode.eq.0 .and. M$GET_SWITCH('STAY').le.0) then
	      call M$ERROR ('No file to plot, use /STAY to override')
	    elseif (mode.eq.1) then
	      call MX$MESSAGE ('Could not open file '//name,1.0)
	    endif
	  endif
	  Gx.xstart = 0.d0
	  Gx.xdelta = 1.d0
	  Gx.ystart = 0.d0
	  Gx.ydelta = 1.d0
	  Gx.HIN.open   = .false.
	  Gx.HIN.size   = Gx.xframe
	  Gx.HIN.bpe    = 8
	  Gx.HIN.spa    = 2
	  Gx.HIN.format = 'CD'
	  Gx.cx = .true.
	  Mx.resize = .true.
	endif
	if (Gx.autom.eq.4) Gx.autom = 5

	return
	end

	subroutine XRASTER_RESTART

	include 'xraster.inc'
	integer*4 i, ipw
	real*4 rx,ry
	real*8 dftot

	Mx.resize = .false.
	if (Gx.hold .gt. 0) return

	call MX$SETFONT (min(8,Mx.width/67))
	Gx.l = 1
	Gx.w = Mx.width
	Gx.t = 2
	Gx.h = Mx.height - 4
	if (Gx.axes) then
	  Gx.l = Gx.l + Mx.text_w*6
	  Gx.w = Gx.w - Mx.text_w*7
	  Gx.t = Gx.t + Mx.text_h*2
	  Gx.h = Gx.h - Mx.text_h*3.5
	endif
	if (Gx.specs) Gx.h = Gx.h - Mx.text_h*2.5
	if (Gx.cbar) Gx.w = Gx.w - Mx.text_w*3
	if (Gx.cbar.and.Gx.axes) Gx.w = Gx.w - Mx.text_w*5
C MRSL/TAS attempt to reserve a little extra room for the scroll bar...
	Gx.w = Gx.w - Mx.text_w
	Gx.iframe = Gx.xframe
	ipw = 0
	if (Gx.pcut) ipw = min(50,Gx.w/8,Gx.h/8)
c
c set initial image bounds
	Gx.yframe = DINT(Gx.HIN.size/Gx.xframe)
	dftot = Gx.yframe
	if (Gx.all .or. Gx.lpf.eq.0) then
	  Gx.istart = 0
	else
	  if (Gx.lpf.gt.0) ry = float(Gx.lpf)		! forced expansion
	  if (Gx.lpf.lt.0) ry = 1.0/float(-Gx.lpf)	! forced compression
	  i = Gx.h - ipw
	  if (INT(ry*Gx.yframe).gt.i) Gx.yframe = INT(i/ry - 1)
	  Gx.istart = max (0, min (Gx.istart, INT(dftot-Gx.yframe)))
	endif
	Gx.pbar = Gx.yframe .lt. dftot
	if (Gx.pbar) Gx.w = Gx.w - Mx.text_w*2.5
	Mx.stk(1).xmin = Gx.xstart
	Mx.stk(1).xmax = Gx.xstart + (Gx.iframe-1) * Gx.xdelta
	Mx.stk(1).ymin = Gx.ystart + Gx.istart * Gx.ydelta
	Mx.stk(1).ymax = Mx.stk(1).ymin + (Gx.yframe-1) * Gx.ydelta
	call CLEAN_WINDOW
	call XRASTER_REREAD

	return
	end


	subroutine XRASTER_REREAD

	include 'xraster.inc'
	integer*4 i,ipw,nfx,nfy,iw,ih,nx,ny
	integer*4 nyb,nbytes,ix2,iy2
	real*4 rx,ry
c
c determine compression/expansion factors
	ipw = 0		! space for PCUTS
	if (Gx.pcut) ipw = min(50,Gx.w/8,Gx.h/8)
	if (Mx.level .eq. 1) then
	  iw = Gx.w-ipw
	  ih = Gx.h-ipw
	else
	  iw = Mx.width-ipw
	  ih = Mx.height-ipw
	  if (Gx.specs) ih = ih - Mx.text_h*2.5
	endif
	i = Mx.level
	nfx = NINT( (Mx.stk(i).xmax-Mx.stk(i).xmin)/Gx.xdelta ) + 1
	nfy = NINT( (Mx.stk(i).ymax-Mx.stk(i).ymin)/Gx.ydelta ) + 1
	if (nfx.eq.0) nfx = 1
	if (nfy.eq.0) nfy = 1
	rx = float(iw)/float(nfx)
	ry = float(ih)/float(nfy)
	if (i.eq.1 .and. Gx.lpf.ne.0 .and. .not. Gx.all) then
	  if (Gx.lpf.gt.0) ry = float(Gx.lpf)		! forced expansion
	  if (Gx.lpf.lt.0) ry = 1.0/float(-Gx.lpf)	! forced compression
	elseif (ry .ge. 2.d0) then	! expand lines
	  ry = INT(.99*ry)
	elseif (ry.lt.1.0) then		! compress lines
	  ry = 1.d0/(INT(.99/ry)+1)
	else
	  ry = 1.d0
	endif	  
	if (rx .ge. 2.0) then		! expand pixels
	  rx = INT(.99*rx)
	elseif (rx.lt.1.0) then		! compress pixels
	  rx = 1.d0/(INT(.99/rx)+1)
	else
	  rx = 1.d0
	endif	  
	nx = rx*nfx
	ny = ry*nfy
	Gx.xe = max(1,NINT(rx))
	Gx.ye = max(1,NINT(ry))
	Gx.xc = max(1,NINT(1.d0/rx))
	Gx.yc = max(1,NINT(1.d0/ry))
	Gx.nx = nx / Gx.xe
	Mx.stk(i).xscl = Gx.xdelta/rx
	Mx.stk(i).yscl = Gx.ydelta/ry
	Gx.x1 = NINT( (Mx.stk(i).xmin-Gx.xstart)/Gx.xdelta ) + 1
	Gx.x2 = Gx.x1 + nfx - 1
	Gx.lvl(i).xcmp  = Gx.xc
	Gx.lvl(i).ycmp  = Gx.yc
	Gx.lvl(i).cmode = Gx.cmode
	Gx.lvl(i).cut	= 0
	Gx.lvl(i).rmin  = Gx.rmin
	Gx.lvl(i).rmax  = Gx.rmax
	Gx.lvl(i).ctm   = Gx.ctm
c
c allocate a buffer for the data and the image
	! if no /LPB applied, calculate a default
	Gx.lpb = Gx.lpb_ask
	if (Gx.lpb.eq.0) Gx.lpb = Gx.yframe
	if (Gx.lpb.le.0) Gx.lpb = 16
	Gx.lpb = max(1,Gx.lpb/Gx.yc)*Gx.yc
	nbytes = Gx.lpb * max( Gx.HIN.bpe, 4*Gx.HIN.spa) * Gx.iframe
	call M$REMALLOC (nbytes, Gx.lbuf)			! get new buf
c
c allocate a buffer for the cut data and its image
	nbytes = 4 * (Mx.screen_width + Mx.screen_height + 4)
	call M$REMALLOC (nbytes, Gx.mbuf)		   	! get new buf
c
c if this is first level, set the window limits here
	if (i.eq.1) then
	  Gx.bs.size = 0		! get new buf for backing store
	  Gx.bs.nx = Gx.nx
	  Gx.bs.ny = ny / Gx.ye
	  Gx.bs.xe = Gx.xe
	  Gx.bs.ye = Gx.ye
	  call M$REMALLOC (Gx.bs.nx * Gx.bs.ny, Gx.bs.buf)
	  call MX$CLEAR_WINDOW ()
	  Mx.stk(1).x1 = Gx.l
	  Mx.stk(1).y1 = Gx.t
	  Mx.stk(1).x2 = Gx.l + nx - 1
	  Mx.stk(1).y2 = Gx.t + ny - 1
c
c if this is a resolve pass redo the zoom window
	elseif (Gx.readlevel.lt.0) then
	  if (Gx.readlevel.ne.-2) call MX$UNZOOM ()
	  ix2 = max(2,(iw-nx)/2)
	  iy2 = max(2,(ih-ny)/2)
	  call MX$ZOOM (ix2,iy2,nx,ny,ix2,iy2,1,1)
	  call MX$CLEAR_AREA (ix2,iy2,nx,ny)
	  Mx.stk(i).x1 = ix2
	  Mx.stk(i).y1 = iy2
	  Mx.stk(i).x2 = ix2 + nx - 1
	  Mx.stk(i).y2 = iy2 + ny - 1
	endif
	Gx.readlevel = i
c
c set grab and image pointers
	Gx.top = 0
	Gx.start = DNINT((Mx.stk(i).ymin-Gx.ystart)/Gx.ydelta ) + 1.d0
	Gx.end   = DNINT((Mx.stk(i).ymax-Gx.ystart)/Gx.ydelta) + 1.d0
	Gx.stopread = Gx.start.gt.Gx.end .or. .not. Gx.HIN.open
	Gx.reading = .true.
	call MX$SETBAR ('X-Raster...File Read In Progress')
c
c reset xmax,ymax to reflect true .x2,.y2 value map for expanded plots
c currently they hold the value of the first pixel in the block, need the last
	Mx.stk(i).xmax = Mx.stk(i).xmax + (Gx.xe-1) * Mx.stk(i).xscl
	Mx.stk(i).ymax = Mx.stk(i).ymax + (Gx.ye-1) * Mx.stk(i).yscl
	call SETTINGS (t_xlab, Gx.xlab)
	call SETTINGS (t_ylab, Gx.ylab)
	call SETTINGS (t_zlab, Gx.zlab)
	if (Gx.axes .and. Gx.readlevel.eq.1) then
	  call MX$DRAWAXIS (5, 5, Gx.ixlab, Gx.iylab, .false.)
	  i = Mx.stk(1).x2 - (Mx.text_w * M$LENGTH (Gx.HIN.file_name))
	  call MX$TEXT (i, NINT(1.5*Mx.text_h-2), Gx.HIN.file_name)
	endif

	if ( XRASTER_PAN_HANDLE(0,0) ) continue
	call XRASTER_COLORBAR
	call DISPLAY_SPECS
	if (Gx.stopread) call STOP_READ
	if (Gx.reading .and. Gx.autom.ge.1 .and. Gx.autom.le.3 .and. 
     &		Gx.autol.eq.0) Gx.rmin = Gx.rmax + 1.d0

	return
	end

	subroutine XRASTER_REFRESH

	include 'xraster.inc'
	real*8 dftot
	integer*4 h, r, b

	Gx.xe = Gx.bs.xe
	Gx.ye = Gx.bs.ye
	Gx.xc = Gx.lvl(1).xcmp
	Gx.yc = Gx.lvl(1).ycmp
	Gx.readlevel = 1
	Gx.reading = .true.
	call CLEAN_WINDOW 
	if (Gx.ctm .gt. 0) then
	  call REREAD_PREP(0)
	  return
	endif
	if (Gx.axes) then
	  call MX$DRAWAXIS (5, 5, Gx.ixlab, Gx.iylab, .false.)
	  h = Mx.stk(1).x2 - (Mx.text_w * M$LENGTH (Gx.HIN.file_name))
	  call MX$TEXT (h, NINT(1.5*Mx.text_h-2), Gx.HIN.file_name)
	endif
	h = Gx.bs.size / Gx.bs.nx
	b = Gx.t + h * Gx.ye
	r = Gx.l + Gx.bs.nx * Gx.xe - 1
	call MX$PUT_IMAGE(%val(Gx.bs.buf.p),
     &	  Gx.bs.nx, h, Gx.xe, Gx.ye, Gx.l, Gx.t, 0)
	dftot = Gx.HIN.size/Gx.xframe
	if ( XRASTER_PAN_HANDLE(0,0) ) continue
	call XRASTER_COLORBAR
	call DISPLAY_SPECS
	if (Gx.stopread) call STOP_READ
	return
	end



	subroutine XRASTER_COLORBAR

	include 'xraster.inc'
	integer*4 i1, i2, j1, j2, ih, iw, j, jl, n, istr, istrx
	character str*6, strx*6
	real*8 dval, ddel, dexp

	if (Mx.level .gt. 1) return

	if (Gx.cbar) then	! along right edge
	  i1 = min(Gx.l+Gx.w,Mx.stk(1).x2) + Mx.text_w*2
	  j1 = Mx.stk(1).y1
	  iw = Mx.text_w 
	  ih = max(Mx.stk(1).y2-Mx.stk(1).y1,Gx.h/2)
	elseif (.not. Gx.specs) then
	  return
	else			! in specs space
	  i1 = 66*Mx.text_w
	  j1 = Mx.height - Mx.text_h*2.5
	  iw = Mx.text_w 
	  ih = Mx.text_h * 2
	endif
	i2 = i1 + iw
	j2 = j1 + ih
	do j = 2, ih-2
	  call MX$DRAW_LINE (1 + Gx.ncolors*(j-2)/(ih-3), i1, j2-j, i2 ,j2-j)
	enddo
	call MX$DRAW_BOX (-1, i1-2, j1, iw+4, j2-j1)
	if (Gx.cbar .and. Gx.axes) then
	  jl = -100
	  ddel = (Gx.rmax-Gx.rmin)/Gx.ncolors
	  dval = Gx.rmin + ddel*(Gx.ncolors+.5)
	  dexp = max( dabs(dval), dabs(dval-ddel*Gx.ncolors) )
	  istrx = M$D2A_FORM(dexp,strx,'ENG')
	  istrx = M$SEARCH(strx,'E')
	  if (istrx.gt.0) then
	    read (strx(istrx+1:),*) dexp
	    dexp = 10.0 ** (-dexp)
	  else
	    dexp = 1
	  endif
	  do n = 1,Gx.ncolors
	    dval = dval - ddel
	    j = j1 + ih*(n-.5)/Gx.ncolors + Mx.text_h*.25
	    if (j-jl.gt.Mx.text_h) then
	      istr = M$D2A (dval*dexp,str)
	      call MX$TEXT (i2,j,str(1:istr))
	      jl = j
	    endif
	  enddo
	  if (istrx.gt.0) call MX$TEXT(i2,j2+Mx.text_h,strx(istrx:))
	endif
	return
	end


	function XRASTER_PAN_HANDLE (m,i)
	include 'xraster.inc'
	include 'xwidgets.inc'
	real*8 d1,dw,df1,dfw
	integer*4 i,k,m,junk,llstart
	integer*4 ix1,ix2,iy1,iy2
	record /SCROLLBAR/ sb

	XRASTER_PAN_HANDLE = .false.
	if (.not. Gx.pbar .or. Mx.level.gt.1) return

	ix1 = Mx.width - Mx.text_w*2
	ix2 = ix1 + Mx.text_w
	iy1 = Mx.stk(1).y1
	iy2 = Mx.stk(1).y2
	d1 = Mx.stk(1).ymin
	dw = Mx.stk(1).ymax - Mx.stk(1).ymin
	df1 = Gx.ystart
	dfw = DINT(Gx.HIN.size/Gx.xframe) * Gx.ydelta
	if (m.eq.0) then
          junk = MX$SCROLLBAR (0,ix1,ix2,iy1,iy2,d1,d1+dw,df1,df1+dfw)
	elseif (Mx.xpos.gt.ix1.and.Mx.ypos.gt.iy1.and.Mx.ypos.lt.iy2) then
	  i = 0
	  XRASTER_PAN_HANDLE = .true.
	  llstart = Gx.istart	
	  junk = MX$SCROLL(sb, XW_INIT)
	  call MX$SCROLL_LOC(sb, ix1, iy1, ix2-ix1+1, iy2-iy1+1, 4)
	  call MX$SCROLL_VALS(sb, d1, dw, df1, dfw, 1d-1*dw, 9d-1*dw, 1.d0)
	  sb.dragoutline = .TRUE.
	  if (MX$SCROLL(sb,XW_EVENT)) d1 = sb.smin
	  Gx.istart = (d1-df1)/Gx.ydelta
          if (Gx.istart.ne.llstart) i = 1	! pan
	endif

	return
	end

c*****************************************************************************
c get next buffer of data
c
c LGET    - # of frames of data we want and can fit in our buffer
c LLGET   - # of data elements we want 
c LGOT    - # of frames of data we actually got from the grab
c LLGOT   - # of data elements we got
c Gx.start  - frame index of the next frame to grab 
c ddstart - data element index of the start of the grab 
c Gx.end    - frame index of the last frame we need to grab
c Gx.offset - offset from the formal frame boundaries from which to grab data
c LOFF    - index offset in data buffer, for multiple grabs when Gx.xframe
c	    does not lie on integer boundaries.
c LPUT    - number of raster lines (before expansion) to be put on the screen
c*****************************************************************************


	subroutine XRASTER_READ

	include 'xraster.inc'
	external DISPLAY_SPECS
	integer*4 get, got, put, off, i, j
	real*8 start, ddstart
	logical*4 preread
	byte pbuf(1)
	pointer (pbuf_ptr, pbuf)

	preread = (Gx.autom.ge.1 .and. Gx.autom.le.3 .and. Gx.autol.eq.0)
c+++
c DR 5483
c All arguments to min need to be of the same type and size
c	get = min( Gx.lpb, NINT(Gx.end-Gx.start+1) )
	get = min( int(Gx.lpb), NINT(Gx.end-Gx.start+1) )
c---
	if (Gx.xframe.eq.Gx.iframe .or. get.eq.1) then
	  get = get * Gx.iframe
	  ddstart = DNINT((Gx.start-1.d0)*Gx.xframe+Gx.offset)+Gx.dstart
	  call GRAB(%val(Gx.lbuf.p), ddstart, get, got)
!	print *, 'Get ',ddstart,get
!	got = get
	  got = (got + Gx.offset)/Gx.iframe
	else
	  do i = 0, get-1
	    ddstart = DNINT((Gx.start+i-1.d0)*Gx.xframe+Gx.offset)+Gx.dstart
	    off = i * Gx.iframe * Gx.HIN.spa * 4
	    call GRAB(%val(Gx.lbuf.p+off), ddstart, Gx.iframe, got)
	  enddo
	  got = get
	endif
	put = got / Gx.yc
	if (preread) then
	  call FORM_BUF(%val(Gx.lbuf.p),got,Gx.x1,Gx.x2,%val(Gx.lbuf.p),0)
	else
	 if (Gx.readlevel.eq.1) then
	  pbuf_ptr = Gx.bs.buf.p + Gx.bs.size
	  call FORM_BUF(%val(Gx.lbuf.p), got, Gx.x1, Gx.x2, pbuf, 0)
	  Gx.bs.size = Gx.bs.size + Gx.nx * put
	  if (Gx.ctm.eq.0.or.Gx.ctm.eq.2) call MX$PUT_IMAGE(pbuf,
     &		Gx.nx, put, Gx.xe, Gx.ye, Gx.l, Gx.top+Gx.t, 0)
	 else
	  call M$MALLOC(Gx.nx*got, pbuf_ptr)
	  call FORM_BUF(%val(Gx.lbuf.p), got, Gx.x1, Gx.x2, pbuf, 0)
	  if (Gx.ctm.eq.0.or.Gx.ctm.eq.2) call MX$PUT_IMAGE(pbuf,
     &		Gx.nx, put, Gx.xe, Gx.ye, 0, Gx.top, Gx.readlevel-1)
	  call M$FREE(pbuf_ptr)
	 endif
	 if (Gx.ctm.eq.1.or.Gx.ctm.eq.2) call CONTOURS (put)
	endif
	Gx.lvl(Gx.readlevel).rmin = Gx.rmin
	Gx.lvl(Gx.readlevel).rmax = Gx.rmax
	call DISPLAY_SPECS
	Gx.start = min (Gx.start + got, Gx.end + 1) 
	Gx.stopread = Gx.start .gt. Gx.end
	Gx.top = Gx.top + put*Gx.ye
	i = Mx.stk(Gx.readlevel).x1
	j = Mx.stk(Gx.readlevel).y1 + Gx.top
	if (j .lt. Mx.stk(Gx.readlevel).y2) then
	  if (Gx.ctm .ne. 0) then
	    ! cant draw lines - no next raster buffer to overwrite it
	  elseif (Mx.level.eq.Gx.readlevel) then
	    if (preread) call MX$DRAW_LINE (-1, i, j, i+4, j) 
	    if (.not.preread) call MX$DRAW_LINE (-1, i, j, i+Gx.nx*Gx.xe-1, j)
	  elseif (i+8 .lt. Mx.stk(2).x1) then
	    call MX$DRAW_LINE (-1, i, j, i+4, j)
	  endif
	endif
	if (Gx.stopread) then
	  call STOP_READ
	  if (Gx.axes .and. Mx.level.gt.1) call MX$DRAWAXIS (5, 5, 
     &		Gx.ixlab, Gx.iylab,L_noxplab+L_noyplab+L_insidelab)
	  call ACCESSORIES (a_c+a_p, 1)
	endif

	return
	end


	subroutine STOP_READ

	include 'xraster.inc'
	logical*4 autoscale
	integer*4 i
	record /MAPSTRUCT/ top

	autoscale = Gx.autom.ge.1 .and. Gx.autom.le.3
	if (autoscale .and. Gx.autol.eq.0) then		! preread finished
	  if (Gx.readlevel.eq.1) Gx.bs.size = 0		! now plot it
	  i = Gx.readlevel
	  Gx.autol    = -1
	  Gx.top      = 0
	  Gx.start    = DNINT((Mx.stk(i).ymin-Gx.ystart)/Gx.ydelta) + 1.d0
	  Gx.stopread = Gx.start.gt.Gx.end .or. .not. Gx.HIN.open
	  Gx.reading  = .true.
	else
	  if (autoscale .and. Gx.autol.lt.0) Gx.autol = 0
	  if (Gx.reading) then
	    Gx.reading = .false.
	    Gx.stopread = .true.
	    call MX$UNSETBAR ()
	    call ACCESSORIES (a_a+a_bp, 1)
	  endif
	endif
c
	return
	end

c*****************************************************************************
c
c  Get messages off queue
c
	function XRASTER_MSG ()

	include 'xraster.inc'
	include 'tables.inc'
	include 'qmessdef.inc'
	include 'qmessdecl.inc'
	external DISPLAY_SPECS
	integer*4 cxm_items
	parameter (cxm_items=8)
	character*2 cxm(cxm_items) /'MA','PH','RE','IM','LO','L2','D1','D2'/
	character*3 fac /'BPA'/
	integer*4 i, j, x1, x2, y1, y2, info, sid, mimic, msgid
	integer*4 pline, pdot, flag, cut
	logical*4 bview
	real*8 dval

	XRASTER_MSG = .false.
	if (Gx.HIN.pipe.ne.0 .and. Gx.reading) return

	do while (.not. Mx.breakflag)

	  if (M$GET_MSG(MQH,MQD,L_mqd,0.0,0) .le. 0) return

	  XRASTER_MSG = .true.

	  info = MQH.info
	  sid = MQH.sender
	  mimic = Gx.mimic
	  msgid = Gx.xf.msgid
	  cut = Gx.lvl(Mx.level).cut

	  Gx.xf.iarg = info
	  Gx.xf.mqdloc.p = %loc(MQD)

	  if (MQH.name.ne.MQH_QUERY.name) call ACCESSORIES (a_c, -1)
	  ! Do not echo actions caused by an id to that id, unless MSK_ECHO set
	  if (.not. BTEST(Gx.xf.msgmask,MSK_ECHO)) then
	    if (msgid.gt.0 .and. msgid.eq.sid) Gx.xf.msgid = -1
	    if (mimic.gt.0 .and. mimic.eq.sid) Gx.mimic = -1
	  endif

	  if (MX$MIMIC_MSG(MQH,MQD,mimic).lt.0) then
	    ! info message we don't know or don't need to mimic

	  elseif (MX$GRAPHICS_MSG(Mx,MQH,MQD,msgid,Gx.xf.msgmask).ne.0) then
	    if (Mx.breakflag) return

	  elseif (MQH.name .eq. MQH_QUERY.name) then
	    if (MQD.QUERY.object .eq. MQH_BOXINFO.name) then
	      call INFOMSG (MSK_BOXES, info, sid)
	    elseif (MQD.QUERY.object .eq. MQH_CXMODEINFO.name) then
	      call INFOMSG (MSK_CXMODE, info+1, sid)
	    elseif (MQD.QUERY.object .eq. MQH_COLORINFO.name) then
	      call INFOMSG (MSK_COLOR, info, sid)
	    elseif (MQD.QUERY.object .eq. MQH_COLORMAPINFO.name) then
	      call INFOMSG (MSK_COLOR, -info, sid)
	    elseif (MQD.QUERY.object .eq. MQH_MARKINFO.name) then
	      call INFOMSG (MSK_MARK, info+1, sid)
	    elseif (MQD.QUERY.object .eq. MQH_PANINFO.name) then
	      call INFOMSG (MSK_PANY, info+1, sid)
	    elseif (MQD.QUERY.object .eq. MQH_PLOTINFO.name) then
	      call INFOMSG (-1, info+1, sid)
	    elseif (MQD.QUERY.object .eq. MQH_POINTINFO.name) then
	      call INFOMSG (MSK_POINTS, info, sid)
	    elseif (MQD.QUERY.object .eq. MQH_ZOOMINFO.name) then
	      call INFOMSG (MSK_ZOOM, info+1, sid)
	    endif

	  elseif (MQH.name .eq. MQH_ANNOTATE.name) then
	    call FACILITIES('A', 3)

	  elseif (MQH.name(1:3).eq.'BOX' .or. MQH.name(1:5).eq.'POINT') then
	    if (cut .gt. 0) then
	      bview = Gx.xf.bview
	      pdot = Gx.xf.pdot
	      pline = Gx.xf.pline
	      Gx.xf.bview = .false.
	      Gx.xf.pdot = 0
	      Gx.xf.pline = -3
	    endif

	    if (MQH.name .eq. MQH_POINTDELETE.name) then
	      call FACILITIES ('P', 4)
	    elseif (MQH.name .eq. MQH_BOXDELETE.name) then
	      call FACILITIES ('B', 4)
	    else
	      i = 2
	      if (info .eq. -1) i = L_OneShot
	      if (i.eq.L_OneShot .and. cut.gt.0) then
		call M$WARNING ('Cannot interactively alter '//
     &			'points/boxes while in XY cut')
	      elseif (MQH.name .eq. MQH_POINTADD.name) then
		Gx.xf.iarg = Gx.xf.npoint + 1
		call FACILITIES ('P', i)
	      elseif (MQH.name .eq. MQH_POINTALTER.name) then
		call FACILITIES ('P', i)
	      elseif (MQH.name .eq. MQH_BOXADD.name) then
		Gx.xf.iarg = Gx.xf.nbox + 1
		call FACILITIES ('B', i)
	      elseif (MQH.name .eq. MQH_BOXALTER.name) then
		call FACILITIES ('B', i)
	      endif
	    endif

	    if (cut.gt.0) then
	      Gx.xf.bview = bview
	      Gx.xf.pdot = pdot
	      Gx.xf.pline = pline
	    endif

	  elseif (MQH.name .eq. MQH_COLORMAP.name) then
	    if (info.le.5 .and. info.ne.Gx.cmap) then
	      if (info.le.0 .or. info.eq.5) then
	        Gx.cmap = 5
	        if (info.le.0) call M$MOVE (MQD.COLORMAP, Gx.map5, 56)
	        call MX$COLORMAP (Gx.map5, Gx.ncolors)
	      else
		Gx.cmap = info
		call MX$COLORMAP (Mc.colormap(Gx.cmap), Gx.ncolors)
	      endif
	      call MSGDO (MSK_COLOR)
	    endif

	  elseif (MQH.name .eq. MQH_CXMODE.name) then
	    do i = 1, cxm_items
	      if (MQD.CXMODE.mode.eq.cxm(i) .and. Gx.cmode.ne.i) then
	        j = Gx.cmode
		call XRASTER_CMODE(i)
		if (cut .gt. 0) then
		  call DRAW_CUT(0, 0, 0, 0, cut)	
		elseif (.not.Gx.reading.and.(j.lt.5.or.Gx.cmode.lt.5)) then
		  call REREAD_PREP(1)
		endif
	      endif
	    enddo

	  elseif (MQH.name .eq. MQH_MARK.name) then
	    Gx.xmrk = MQD.MARK.x
	    Gx.ymrk = MQD.MARK.y
	    Gx.zmrk = MQD.MARK.z
	    if (Gx.cntrls.gt.0) then
	      call M$DRSLT (Mx.xtag, Gx.xmrk)
	      call M$DRSLT (Mx.ytag, Gx.ymrk)
	      call M$DRSLT (Mx.xytag, Gx.xmrk+Gx.ymrk)
	    endif
	    call DISPLAY_SPECS
	    call MSGDO (MSK_MARK)

	  elseif (MQH.name .eq. MQH_NEWFILE.name) then
	    i = MQD.NEWFILE.arg1
	    if (i .eq. 0) then
	      call XRASTER_OPENFILE (MQD.NEWFILE.filename, 1)
	      call XRASTER_RESTART
	    elseif (i.ge.1 .and. i.le.3) then
	      call FACILITIES (fac(i:i), 6)
	    endif

	  elseif (MQH.name .eq. MQH_PAN.name) then
	    if (MQD.PAN.ymin .lt. MQD.PAN.ymax) then
	      if (Gx.ydelta .lt. 0) then
	        i = NINT((MQD.PAN.ymax - Gx.ystart) / Gx.ydelta)
	      else
	        i = NINT((MQD.PAN.ymin - Gx.ystart) / Gx.ydelta)
	      endif
	      j = NINT(Gx.HIN.size/Gx.xframe) - Gx.bs.ny * Gx.lvl(1).ycmp
	      i = max (min(i,j), 0)
	      if (i.ne.Gx.istart) then
	        Gx.istart = i
	        call XRASTER_RESTART
	        call MSGDO (MSK_PANY)
	      endif
	    endif

	  elseif (MQH.name .eq. MQH_SELECT.name) then
	    if (MQD.SELECT.field .eq. 1) then
	      Gx.indy = NINT((MQD.SELECT.elemt-Gx.ystart)/Gx.ydelta) + 1
	      call DRAW_CUT(0, 0, 0, 0, 1)
	      call MSGDO (MSK_SELECT)
	    elseif (MQD.SELECT.field .eq. 2) then
	      Gx.indx = NINT((MQD.SELECT.elemt-Gx.xstart)/Gx.xdelta) + 1
	      call DRAW_CUT(0, 0, 0, 0, 2)
	      call MSGDO (MSK_SELECT)
	    else
	      call M$WARNING ('Info field X=1, Y=2 for select message')
	    endif

	  elseif (MQH.name .eq. MQH_REFRESH.name) then
	    if (Gx.readlevel.ne.1 .and. Gx.reading) then
	      Gx.reading = .false.
	      Gx.stopread = .true.
	    endif
	    call XRASTER_REFRESH ()

	  elseif (MQH.name .eq. MQH_REREAD.name) then
	    if (cut.eq.0 .and. Gx.stopread) call REREAD_PREP(1)

          elseif (MQH.name .eq. MQH_SET.name) then
	    i = (M$SEARCH('ALL     ,AUTO    ,AUTOL   ,AUTORR  ,AXES    ,'//
     &			  'COLORBAR,CMP     ,CROSS   ,CONTOURM,CONTOURC,'//
     &			  'CONTOURL,FAST    ,HOLD    ,LPF     ,MIMIC   ,'//
     &			  'MSGID   ,PCUTS   ,SPECS   ,XLABEL  ,YLABEL  ,'//
     &			  'ZLABEL  ,', MQD.set.object(1:8)//',') + 8) / 9

	    if (i.eq.t_mimic) then
	      mimic = info
	    elseif (i.eq.t_msgid) then
	      msgid = info
	    elseif (i.ne.0) then
	      call SETTINGS(i, info)
	    elseif (MQD.SET.object(1:4) .eq. 'ANNT' .or.
     &	    	    MQD.SET.object(1:3) .eq. 'BOX' .or.
     &	    	    MQD.SET.object(1:5) .eq. 'POINT') then
	      call FACILITIES(MQD.SET.object(1:1), 5)
	    else
	      call M$WARNING ('Unrecognized set object: '//MQD.SET.object)
            endif

	  elseif (MQH.name .eq. MQH_SETD.name) then
	    if (MQD.SETD.object .eq. 'FRAME') then
	      call XRASTER_REFRAME(MQD.SETD.value, Gx.offset, info)
	    elseif (MQD.SETD.object .eq. 'OFFSET') then
	      call XRASTER_REFRAME(Gx.xframe, MQD.SETD.value, info)
	    elseif (MQD.SETD.object .eq. 'SCALEMIN') then
	      Gx.zmin = MQD.SETD.value
	      Gx.rmin = Gx.zmin
	    elseif (MQD.SETD.object .eq. 'SCALEMAX') then
	      Gx.zmax = MQD.SETD.value
	      Gx.rmax = Gx.zmax
	    else
	      Mx.resize = .true.
	      if (MQD.SETD.object .eq. 'XSTART') then
		Gx.xstart = MQD.SETD.value
	      elseif (MQD.SETD.object .eq. 'YSTART') then
		Gx.ystart = MQD.SETD.value
	      elseif (MQD.SETD.object .eq. 'XDELTA') then
		Gx.xdelta = MQD.SETD.value
	      elseif (MQD.SETD.object .eq. 'YDELTA') then
		Gx.ydelta = MQD.SETD.value
	      else
		Mx.resize = .false.
	      endif
	    endif
	    if (Mx.resize) call XRASTER_RESTART()

	  elseif (MQH.name .eq. MQH_UNZOOM.name) then
	    if (info.lt.0) info = max (0, Mx.level+info-1)
	    if (info.lt.Mx.level-1) call XRASTER_UNZOOM (info+1)

	  elseif (MQH.name .eq. MQH_ZOOM.name) then
	    if (Mx.level.lt.10) then			! Put Zoom
	      i = Mx.level
	      if (MQD.ZOOM.xmin .lt. MQD.ZOOM.xmax) then
		dval = 1.d0 / Mx.stk(i).xscl
		if (dval .ge. 0.d0) then
		  x1 = Mx.stk(i).x1 + NINT((MQD.ZOOM.xmin-Mx.stk(i).xmin)*dval)
		  x2 = Mx.stk(i).x2 + NINT((MQD.ZOOM.xmax-Mx.stk(i).xmax)*dval)
		else
		  x1 = Mx.stk(i).x1 + NINT((MQD.ZOOM.xmax-Mx.stk(i).xmin)*dval)
		  x2 = Mx.stk(i).x2 + NINT((MQD.ZOOM.xmin-Mx.stk(i).xmax)*dval)
		endif
	      else
		x1 = Mx.stk(i).x1
		x2 = Mx.stk(i).x2
	      endif
	      if (MQD.ZOOM.ymin .lt. MQD.ZOOM.ymax) then
		dval = 1.d0 / Mx.stk(i).yscl
		if (dval .ge. 0.d0) then
		  y1 = Mx.stk(i).y1 + NINT((MQD.ZOOM.ymin-Mx.stk(i).ymin)*dval)
		  y2 = Mx.stk(i).y2 + NINT((MQD.ZOOM.ymax-Mx.stk(i).ymax)*dval)
		else
		  y1 = Mx.stk(i).y1 + NINT((MQD.ZOOM.ymax-Mx.stk(i).ymin)*dval)
		  y2 = Mx.stk(i).y2 + NINT((MQD.ZOOM.ymin-Mx.stk(i).ymax)*dval)
		endif
	      else
		y1 = Mx.stk(i).y1
		y2 = Mx.stk(i).y2
	      endif
	      call XRASTER_ZOOM (x1, x2, y1, y2)
	    endif

	  elseif (MQH.name .eq. MQH_HARDCOPY.name) then

	    if (MX$HARDCOPY_OPEN(MQD.HARDCOPY.file, MQH.info)) then
	      call XRASTER_REFRESH ()
	      call MX$HARDCOPY_CLOSE ()
	    endif
 
	  elseif (MQH.name .eq. 'DEBUG') then
	    write (*,*) 'Gx.HIN.class   = ', Gx.HIN.class
	    write (*,*) 'Gx.HIN.size    = ', Gx.HIN.size
	    write (*,*) 'Gx.HIN.subsize = ', Gx.HIN.subsize
	    write (*,*) 'Gx.xstart = ', Gx.xstart
	    write (*,*) 'Gx.ystart = ', Gx.ystart
	    write (*,*) 'Gx.xdelta = ', Gx.xdelta
	    write (*,*) 'Gx.ydelta = ', Gx.ydelta
	    if (Gx.HIN.pipe .ne. 0) write (*,*) 'Gx.dstart = ', Gx.dstart
	    write (*,*) 'Gx.xframe = ', Gx.xframe
	    write (*,*) 'Gx.offset = ', Gx.offset

	  elseif (MQH.name .eq. MQH_XTODO.name) then
	    if (Gx.HIN.pipe.ne.0) then 	! Update the read pointers
	      if (Gx.HIN.size .gt. 0.d0) then
		Gx.dstart = Gx.dstart + Gx.HIN.size
		if (Gx.inmem) then
		  Gx.readmax = Gx.dstart - 1.d0
		else
		  Gx.HIN.cons_len = Gx.HIN.size
		  Gx.HIN.xfer_len = 0
		  call M$GRABX(Gx.HIN, i, j)
		  Gx.HIN.cons_len = -2
		endif
	      endif
	      Gx.HIN.size = MQD.XTODO.amount
	      if (Gx.HIN.class.eq.2) Gx.HIN.size = Gx.HIN.size*Gx.HIN.subsize
	      if (Gx.autom.eq.4) Gx.autom = 5
	      call XRASTER_RESTART()
	    endif
	  else
	    XRASTER_MSG = .false.
	  endif

	  if (MQH.name.ne.MQH_QUERY.name) call ACCESSORIES (a_c+a_p, 1)
	  Gx.mimic = mimic
	  Gx.xf.msgid = msgid

	enddo

	return
	end

	function XRASTER_EVENT ()
c
	include 'xraster.inc'
	external DISPLAY_SPECS
	character*76 text
	character*300 menu
	character c, cspec*10
	integer*4 i, j, k, llstart, cut, x1, x2, y1, y2, frames
	integer*4 ih, item, newmode, oldmode, nbytes, imax
	integer*4 optmask
	logical*4 warn, pany, event
	real*4 rz(4), dbscale
	real*8 dfl, dol, ddstart, dval
	character*(L_max_ascii) psfile
	external XRASTER_SETTINGS

	XRASTER_EVENT = .false.
	if (MX$QUEUED() .le. 0) return

	item = 0
	pany = .false.
	cut = Gx.lvl(Mx.level).cut

	call ACCESSORIES (a_c, -1)

	do while (MX$IFEVENT() .and. .not.(Mc.break .or. Mx.breakflag))

	XRASTER_EVENT = .true.

	if (Mx.button_press.eq.1 .or. Mx.button_press.eq.2) then
	  if (XRASTER_PAN_HANDLE(1,i) ) then
	    if (i.gt.0) then	! moved pan range
	      Mx.resize = .true.
	      pany = .true.
	    endif
	    Mx.button_press = 0
	  endif
	endif

	if (Mx.motion_notify) then
	  call ACCESSORIES (a_c+a_p, 1)
	  call ACCESSORIES (a_c, -1)

	elseif (Mx.button_press.eq.1) then	! pan/set origin/zoom

	  call MX$RUBBERBOX (x1, y1, x2, y2, DISPLAY_SPECS)
	  if (Mx.button_release.ne.1) then
	  elseif (x2-x1.lt.2 .or. y2-y1.lt.2) then
	    call DISPLAY_SPECS	  ! set origin
	    Gx.xmrk = Gx.retx
	    Gx.ymrk = Gx.rety
	    Gx.zmrk = Gx.retz
	    call MSGDO (MSK_MARK)
	    call DISPLAY_SPECS
	    if (Gx.cntrls.eq.1) then			! set controls
	      call M$DRSLT (Mx.xtag, Gx.xmrk)
	      call M$DRSLT (Mx.ytag, Gx.ymrk)
	      call M$DRSLT (Mx.xytag, Gx.xmrk+Gx.ymrk)
	    endif
	  else					! zoom
	    call XRASTER_ZOOM (x1, x2, y1, y2)
	  endif

	elseif (Mx.button_press.eq.3) then		! unzoom
	  if (Gx.readlevel.ne.1 .and. Gx.reading) then
	    call MX$MESSAGE ('Wait for image resolve to complete',-1.0)
	  elseif (cut.gt.0 .and. Gx.lvl(Mx.level-1).cut.eq.0) then
	    if ( MX$MENU(1,'Exit XY Cut ?;Yes,No') .eq. 1)
     &		call XRASTER_UNZOOM (Mx.level-1)
	  elseif (Mx.level.gt.1) then
	    call XRASTER_UNZOOM (Mx.level-1)
	  endif

	elseif (Mx.button_press.eq.2 .or. Mx.key_upchar.eq.'M') then 	! menu 

	  item = MX$MENU (0,'X-RASTER;Refresh,StopRead,Reread,'//
     &		'Cntrls...,CX Mode...,Frame...,Scale...,Colormap...,'//
     &		'New File...,Settings...,Boxes,Points,Annotate,'//
     &		'Spawn...,Keypress Info,Exit')

	  if (item.eq.1) then			! refresh
	    if (Gx.readlevel.ne.1 .and. Gx.reading) then
	      Gx.reading = .false.
	      Gx.stopread = .true.
	    endif
	    Mx.exposure = .true.

	  elseif (item.eq.2) then		! stop read
	    if (.not. Gx.stopread) call STOP_READ

	  elseif (item.eq.3) then		! reread
	    if (Gx.lvl(Mx.level).cut.gt.0) then
	      call DRAW_CUT(0, 0, 0, 0, cut)
	    elseif (Gx.reading) then
	      call MX$MESSAGE('File READ already in progress',-1.0)
	    else
	      call REREAD_PREP(1)
	    endif

	  elseif (item.eq.4) then		! controls option
	    if (Gx.cntrls.ge.0) then
	      i = MX$MENU (Gx.cntrls+1,'CONTROLS OPTIONS;Off,LM Click,'//
     &		'Continuous,Assign...')
	    else
	      i = MX$MENU (1-Gx.cntrls,'CONTROLS OPTIONS;Off,LM Click '//
     &		'(Disabled),Continuous (Disabled),Assign...')
	    endif
	    if (i.le.3) then
	      Gx.cntrls = isign(i - 1, Gx.cntrls)
	    else
	      call MX$PROMPT ('Mouse X location -> ',Mx.xtag)
	      call MX$PROMPT ('Mouse Y location -> ',Mx.ytag)
	      call MX$PROMPT ('Mouse X+Y location -> ',Mx.xytag)
	      call M$UPPERCASE (Mx.xtag)
	      call M$UPPERCASE (Mx.ytag)
	      call M$UPPERCASE (Mx.xytag)
	    endif

	  elseif (item.eq.5) then			! change complex mode
	    oldmode = Gx.cmode
	    newmode = MX$MENU (Gx.cmode, 'DATA TRANSFORM;Magnitude,'//
     &		'Phase,Real,Imaginary,10*Log10,20*Log10')
	    if (.not. Gx.cx .and. (newmode.eq.2 .or. newmode.eq.4) ) then
	      call MX$MESSAGE('Mode not available for SCALAR data',1.0)
	    elseif (newmode.ne.Gx.cmode) then
	      call XRASTER_CMODE(newmode)
	      if (cut.gt.0) then
		call DRAW_CUT(0, 0, 0, 0, cut)	
	      elseif (Gx.reading) then
		call MX$MESSAGE('Reread to view entire File in new mode',1.0)
	      elseif (oldmode.lt.5 .or. newmode.lt.5) then
		call REREAD_PREP(1)
	      endif
	    endif

	  elseif (item.eq.6) then			! reframe
	    dfl = Gx.xframe
	    dol = Gx.offset

	    call MX$DPROMPT ('Frame Length: ', dfl)
	    call MX$DPROMPT ('Frame Offset: ', dol)

	    call XRASTER_REFRAME (dfl, dol, 0)

	  elseif (item.eq.7) then			! scale
	    Gx.autom = MX$MENU(Gx.autom+2,'SCALING;Threshold...,'//
     &		'Parameters...,Min Auto...,Max Auto...,'//
     &		'Full Auto...,Fix Auto...') - 2

	    if (Gx.cmode.ge.5) then
	      cspec = '(dB): '
	      i = 6
	    else
	      cspec = ': '
	      i = 2
	    endif
	    if (Gx.autom.eq.-1) then
	      Gx.rmin = 0.5*(Gx.zmin+Gx.zmax)
	      call MX$FPROMPT('Threshold'//cspec(1:i), Gx.rmin)
	      Gx.rmax = Gx.rmin
	    elseif (Gx.autom.eq.0) then
	      call MX$FPROMPT('Minimum'//cspec(1:i), Gx.zmin)
	      call MX$FPROMPT('Maximum'//cspec(1:i), Gx.zmax)
	      Gx.rmin = Gx.zmin
	      Gx.rmax = Gx.zmax
	    elseif (Gx.autom.eq.4) then
	      call MX$FPROMPT('AutoMin Fix'//cspec(1:i), Gx.rmin)
	      call MX$FPROMPT('AutoMax Fix'//cspec(1:i), Gx.rmax)
	    else
	      if (Gx.cmode.ge.5 .and. (Gx.autom.eq.1 .or. Gx.autom.eq.3))
     &		call MX$FVAL('dB Range: ',Gx.dbrange,0.0,
     &                                300.0,5.0,0)
	      call MX$LPROMPT('Number lines in average: ',Gx.autol)
	      Gx.autol = max(0,Gx.autol)
	    endif
	    if (Gx.cmode.ge.5) then
	      dbscale = 10.0
	      if (Gx.cmode.eq.6) dbscale = dbscale * 2.0
	      if (Gx.cx) dbscale = dbscale / 2.0
	      Gx.rmin = max(Gx.rmin, -37*dbscale)
	      Gx.rmax = min(Gx.rmax,  37*dbscale)
	      if (Gx.autom.eq.0) then
		Gx.zmin = Gx.rmin
		Gx.zmax = Gx.rmax
	      endif
	    endif

	  elseif (item.eq.8) then			! change colormap
	    i = MX$MENU(Gx.cmap, 'COLORMAP;Greyscale,Ramp Colormap,'//
     &		'Color Wheel,Spectrum,Local,Adjust...')
	    if (i.eq.6) then
	      if (Gx.cmap.ne.5) call M$MOVE (Mc.colormap(Gx.cmap),Gx.map5,56)
	      call MX$COLORMAP (Gx.map5, -1)
	      Gx.cmap = 5
	      call MSGDO (MSK_COLOR)
	    elseif (i.ne.Gx.cmap) then
	      Gx.cmap = i
	      if (Gx.cmap.eq.5) then
		call MX$COLORMAP (Gx.map5, Gx.ncolors)
	      else
		call MX$COLORMAP (Mc.colormap(Gx.cmap), Gx.ncolors)
	      endif
	      call MSGDO (MSK_COLOR)
	    endif

	  elseif (item.eq.9) then			! Open file
	    text = ' '
	    i = MX$FILES (text)
	    if (i.gt.0) call XRASTER_OPENFILE (text(1:i), 1)

	  elseif (item.eq.10) then			! Settings

	    optmask = 0
	    if (Gx.all) optmask = IBSET (optmask,t_all)
	    if (Gx.autorr) optmask = IBSET (optmask,t_autorr)
	    if (Gx.axes) optmask = IBSET (optmask,t_axes)
	    if (Gx.cbar) optmask = IBSET (optmask,t_cbar)
	    if (Gx.cross) optmask = IBSET (optmask,t_cross)
	    if (Gx.fast) optmask = IBSET (optmask,t_fast)
	    if (Gx.pcut) optmask = IBSET (optmask,t_pcuts)
	    if (Gx.specs) optmask = IBSET (optmask,t_specs)
	    if (Gx.hold.ne.0) optmask = IBSET (optmask,t_hold)

	    optmask = MX$MENUPLUS (optmask,'SETTINGS;#ALL Mode,'//
     &	     'AUTO scale...,AUTO Lines...,#AUTOReRead,#AXES,'//
     &	     '#ColorBAR,CoMPression...,#CROSShairs,ConTour'//
     &	     'Mode...,ConTourColor...,ConTourLines...,#FAST,#Hold,'//
     &	     'Lines/Frame...,MIMIC id...,MSGID...,#PCUTS,#SPECS,'//
     &	     'XLABel...,YLABel...,ZLABel...', 
     &		L_CBautomask, L_CBenable, XRASTER_SETTINGS)

	  elseif (item.ge.11 .and. item.le.13) then		! box,pts,ann
	    if (item.ne.13 .and. Gx.lvl(Mx.level).cut.gt.0) then
	      text = ' Boxes mode cannot be entered while X or Y cuts are up'
	      if (item.eq.12) text(1:5) = 'Point'
	      call MX$MESSAGE (text, -1.0)
	    else
	      text = 'BPA'
	      call FACILITIES (text(item-10:item-10), L_Interactive)
	    endif

	  elseif (item.eq.14) then		      ! spawn
	    text = ' '
	    call MX$PROMPT ('Spawn Command: ', text)
	    i = M$LENGTH(text)
	    if (i.gt.0) call M$DISPATCH(text(1:i), LD_smart, -1)

	  elseif (item.eq.15) then			! keypress help
	    call MX$MHELP('X-RASTER','Keypress Info')

	  elseif (item.eq.16) then			! exit
	    if (Mx.noexit.gt.1) call MX$MESSAGE ('Exit disabled', 1.0)
	    if (Mx.noexit.le.1) Mx.breakflag = .true.
	  endif
								! box,pts
	elseif (Mx.key_upchar.eq.'P' .or. Mx.key_upchar.eq.'B' ) then
	  if (Gx.lvl(Mx.level).cut.gt.0) then
	    call MX$MESSAGE ('One shot mode cannot be entered while cuts '//
     &		'are up', -1.0)
	  else
	    call FACILITIES (Mx.key_upchar, L_OneShot)
	  endif

	elseif (Mx.key_upchar.eq.'H') then              ! hardcopy
	  psfile = 'xraster'
	  if (MX$HARDCOPY_OPEN(psfile,-1)) then
	    call XRASTER_REFRESH ()
	    call MX$HARDCOPY_CLOSE ()
	  endif

	elseif (Mx.key_upchar.eq.'R') then 		! resolved?
	  k = Mx.level
	  do while (k.gt.1 .and. (
     &	     Mx.xpos.lt.Mx.stk(k).x1 .or. Mx.xpos.gt.Mx.stk(k).x2 .or.
     &	     Mx.ypos.lt.Mx.stk(k).y1 .or. Mx.ypos.gt.Mx.stk(k).y2) )
	    k = k - 1
	  enddo
	  if (Gx.lvl(k).cut .eq. 0) then
	    i = Gx.lvl(k).xcmp
	    j = Gx.lvl(k).ycmp
	    if (i.eq.1 .and. j.eq.1) then
	      call MX$MESSAGE ('Image fully resolved.', -1.0)
	    else
	      text = 'X compression: None@Y compression: None@'//
     &		'You must zoom for higher resolution.'
	      if (i.gt.1) write (text(16:19),'(i3,a)') i,'x'
	      if (j.gt.1) write (text(36:39),'(i3,a)') j,'x'
	      if (k.gt.1 .and. (
     &		(Mx.stk(k).xmax-Mx.stk(k).xmin)/(Gx.w*Gx.xdelta)+1.lt.i .or.
     &		(Mx.stk(k).ymax-Mx.stk(k).ymin)/(Gx.h*Gx.ydelta)+1.lt.j)) 
     &		  text(41:53) = 'Choose Reread'
	      call MX$MESSAGE (text, -1.0)
	    endif
	  endif

	elseif (Mx.key_char.ge.'0' .and. Mx.key_char.le.'9') then ! markers
	  call DISPLAY_SPECS
	  i = M$LENGTHQ (Gx.mouse)
	  call M$DRSLT (Gx.mouse(1:i)//'_X'//Mx.key_char, Gx.retx)
	  call M$DRSLT (Gx.mouse(1:i)//'_Y'//Mx.key_char, Gx.rety)
	  call M$BEEP (1, 0.0)

	elseif (Mx.key_upchar.eq.'T') then 			! timecode
	  call DISPLAY_SPECS
	  if (Gx.HIN.class .eq. 2) then
	    i = M$SEC2TOD(Gx.HIN.timecode+Gx.rety,text)
	  else
	    i = M$SEC2TOD(Gx.HIN.timecode+Gx.retx+Gx.rety,text)
	  endif
	  call MX$MESSAGE ('Time = '//text(1:i),-1.0)

	elseif (Mx.key_upchar.ge.'X' .and. Mx.key_upchar.le.'Z') then ! XYZ CUTS
	  cut = ICHAR(Mx.key_upchar) - ICHAR('W')
	  i = Mx.level
	  if (.not. Gx.HIN.open) then
	    call MX$MESSAGE ('File must be open to perform a cut.', -1.0)
	  elseif (cut.eq.3) then		! Z-cut
	    call DISPLAY_SPECS 
	    if (Gx.indx.gt.0 .and. Gx.indy.gt.0) then
	      ddstart = DNINT ((Gx.indy-1) * Gx.xframe + max(1, Gx.indx) )
	      call GRAB (rz, ddstart, 1, j)
	      call FORM_BUF (rz, 1, 1, 1, rz, cut)
	      i = M$F2A (rz(1), text)
	      call MX$MESSAGE('Z = '//text(1:i),-1.0)
	    endif
	  elseif (Gx.lvl(i).cut.gt.0) then
	    if (Gx.lvl(i).cut.eq.cut) then 	!unzoom cut layers
	      do while (Gx.lvl(i).cut.gt.0)
		i = i - 1
	      enddo
	      call XRASTER_UNZOOM (i)
	    else
	      call MX$MESSAGE ('Exit current cut before entering new cut',
     &                          1.5)
	    endif
	  elseif (i.ge.10) then
	    call MX$MESSAGE ('At least one zoom level must be available',
     &                        -1.0)
	  elseif (.not. Gx.stopread .and. Gx.readlevel.ne.1) then
	    call MX$MESSAGE ('Cuts not available during zoom reread',
     &                        -1.0)
	  else
	    nbytes = max (Gx.HIN.bpe, 8*Gx.HIN.spa) 
	    nbytes = 2 * nbytes * max (Gx.iframe, INT(Gx.yframe+2)) 
	    call M$REMALLOC(nbytes, Gx.mbuf)
	    call DRAW_CUT(0, 0, 0, 0, cut)
	    call MSGDO (MSK_SELECT)
	  endif

	elseif (Mx.key_upchar.eq.'?') then 	! help
	  call MX$MHELP('X-RASTER','Primitive')

	elseif (Mx.key_upchar.eq.'A') then 	! abscissa mode
	  Gx.iabsc = mod (Gx.iabsc+1, 4)

	elseif (Mx.key_upchar.eq.'S') then 	! abscissa mode
	  Gx.specs = .not. Gx.specs
	  if (Gx.specs) call XRASTER_RESTART ()
	  if (.not.Gx.specs) call XRASTER_REFRESH ()

	elseif (Mx.key_upchar.eq.'C') then      ! toggle Gx.cntrls
	  Gx.cntrls = -Gx.cntrls

	elseif (Mx.key_upchar.eq.'V') then 	! toggle View (raster/contour)
	  j = mod(Gx.ctm+1,3)
	  call SETTINGS (t_ctm, j)
	  call REREAD_PREP(1)

	elseif (Mx.key_upchar.eq.'K') then      ! toggle PCUTS
	  call SETTINGS (t_pcuts,-1)

	elseif (Mx.key_press.eq.13 .and. Mx.noexit.le.0) then	! the END
	  Mx.breakflag = .true.

	endif

	call DISPLAY_SPECS 
	if (Mx.motion_notify .and. Gx.cntrls.eq.2) then
	  call M$DRSLT (Mx.xtag,Gx.retx)		! continous controls
	  call M$DRSLT (Mx.ytag,Gx.rety)
	  call M$DRSLT (Mx.xytag,Gx.retx+Gx.rety)
	endif

	if (Mx.resize) then
	  call XRASTER_RESTART
	  if (pany) call MSGDO (MSK_PANY)
	elseif (Mx.exposure) then
	  if (item.eq.1 .or. Mx.level.eq.1) call XRASTER_REFRESH
	endif

	enddo

	call ACCESSORIES (a_c+a_p, 1)

	return
	end


	subroutine CLEAN_WINDOW

	include 'xraster.inc'

	if (Mx.level .gt. 1) then
	  do while (Mx.zlevel .gt. 0)
	    call MX$MAP (Mx.zoom(Mx.zlevel), 0, 0, 0, 0, L_FreeMap)
	    Mx.zlevel = Mx.zlevel - 1
	  enddo
	  Mx.level = 1
	  call MSGDO (MSK_UNZOOM)
	endif

	if (Gx.pcut) call PCUTS(-1)
	call MX$CLEAR_WINDOW ()

	return
	end

	subroutine REREAD_PREP(remove_zoom)
c
	include 'xraster.inc'
	integer*4 i,remove_zoom
c
	call ACCESSORIES (a_a+a_p, -1)
	i = Mx.level
	Mx.stk(i).xmin = Gx.xstart + 
     &		Gx.xdelta * DINT((Mx.stk(i).xmin-Gx.xstart)/Gx.xdelta)
	Mx.stk(i).xmax = Gx.xstart + 
     &		Gx.xdelta * DINT((Mx.stk(i).xmax-Gx.xstart)/Gx.xdelta)
	Mx.stk(i).ymin = Gx.ystart + 
     &		Gx.ydelta * DINT((Mx.stk(i).ymin-Gx.ystart)/Gx.ydelta)
	Mx.stk(i).ymax = Gx.ystart + 
     &		Gx.ydelta * DINT((Mx.stk(i).ymax-Gx.ystart)/Gx.ydelta)
	Gx.readlevel = -1
	if (remove_zoom.eq.0) Gx.readlevel = -2
	call XRASTER_REREAD
c
	return
	end

	subroutine DISPLAY_SPECS
c
	include 'xraster.inc'
	include 'tables.inc'
	character*64 chara, charb
	character*2 cxm(6) /'Ma','Ph','Re','Im','Lo','L2'/
	character*6 cam(0:3) /'(absc)', '(indx)', '(1/ab)', '(dxdy)'/
	integer*4 i, xt, yt, iretx, irety, cmode, ls
	real*8 zmin, zmax
c
c valid range check
	iretx = Mx.xpos
	irety = Mx.ypos
c
c which zoom window are we in
	i = Mx.level
	do while (i.gt.1 .and. (
     &	   iretx .lt. Mx.stk(i).x1  .or. iretx .gt. Mx.stk(i).x2 .or.  
     &	   irety .lt. Mx.stk(i).y1  .or. irety .gt. Mx.stk(i).y2) )
	  i = i-1
	enddo
c
c adjust/scale for segments
	Gx.retx = Mx.stk(i).xmin + (iretx-Mx.stk(i).x1)*Mx.stk(i).xscl
	Gx.rety = Mx.stk(i).ymin + (irety-Mx.stk(i).y1)*Mx.stk(i).yscl
	if (Gx.lvl(i).cut.eq.0) then
	  Gx.indx = (Gx.retx-Gx.xstart)/Gx.xdelta + 1	! Normal raster specs
	  Gx.indy = (Gx.rety-Gx.ystart)/Gx.ydelta + 1
	  Gx.retx = Gx.xstart + (Gx.indx-1)*Gx.xdelta
	  Gx.rety = Gx.ystart + (Gx.indy-1)*Gx.ydelta
	else
	  Gx.retz = Gx.rety
	  Gx.aretz = Gx.retz
	  Gx.dretz = Gx.retz-Gx.zmrk
	  if (Gx.iabsc.eq.2) then
	    if (Gx.aretz.ne.0.d0) Gx.aretz = 1/Gx.aretz
	    if (Gx.dretz.ne.0.d0) Gx.dretz = 1/Gx.dretz
	  endif
	  if (Gx.lvl(i).cut .eq. 1) then	! X CUT
	    Gx.retx = (Gx.retx-Gx.xstart)/Gx.xdelta + 1.
	    Gx.indx = NINT(Gx.retx)			! Round Gx.indx in X cut
	    Gx.retx = Gx.xstart + (INT(Gx.retx)-1)*Gx.xdelta ! but not Gx.retx
	    Gx.indy = Gx.lvl(i).indy
	    Gx.rety = Gx.ystart + (Gx.indy-1)*Gx.ydelta
	  else					! Y CUT
	    Gx.rety = (Gx.retx-Gx.ystart)/Gx.ydelta + 1.
	    Gx.indy = NINT(Gx.rety)			! Round Gx.indy in Y cut
	    Gx.rety = Gx.ystart + (INT(Gx.rety)-1)*Gx.ydelta ! but not Gx.rety
	    Gx.indx = Gx.lvl(i).indx
	    Gx.retx = Gx.xstart + (Gx.indx-1)*Gx.xdelta
	  endif
	endif
c
c adjust for abscissa mode
	Gx.aretx = Gx.retx
	Gx.arety = Gx.rety
	Gx.dretx = Gx.retx-Gx.xmrk
	Gx.drety = Gx.rety-Gx.ymrk
	if (Gx.iabsc.eq.1) then
	  Gx.aretx = Gx.indx
	  Gx.arety = Gx.indy
	  Gx.dretx = NINT(Gx.dretx/Gx.xdelta)
	  Gx.drety = NINT(Gx.drety/Gx.ydelta)
	elseif (Gx.iabsc.eq.2) then
	  if (Gx.aretx.ne.0.d0) Gx.aretx = 1/Gx.aretx
	  if (Gx.arety.ne.0.d0) Gx.arety = 1/Gx.arety
	  if (Gx.dretx.ne.0.d0) Gx.dretx = 1/Gx.dretx
	  if (Gx.drety.ne.0.d0) Gx.drety = 1/Gx.drety
	endif
c
c  display updated specs
	if (.not. Gx.specs) return
	cmode = Gx.lvl(i).cmode
	if (Gx.lvl(i).cut .ne. 0) then	! X/Y cut Z specs
c  MIB 06-Jul-2000 DR RRCcl00988 start modifications
	  zmax = Gx.aretz
	  zmin = Gx.dretz
c  MIB 06-Jul-2000 DR RRCcl00988 end modifications
	elseif (cmode.eq.2) then	! sub phase range specs
	  zmin = -180.
	  zmax = 180.
	else				! sub all other range specs
	  zmin = Gx.lvl(i).rmin
	  zmax = Gx.lvl(i).rmax
	endif
	xt = Mx.text_w
	yt = NINT (Mx.height - 1.5*Mx.text_h)
	if (Gx.lvl(i).cut .eq. 0) then
	  write(chara,1001) Gx.arety,Gx.drety,i-1,cxm(cmode),zmax
	  write(charb,1002) Gx.aretx,Gx.dretx,cam(Gx.iabsc),zmin
	else			! X,Y Cut -- show zspecs
	  write(chara,1003) Gx.arety,Gx.drety,i-1,cxm(cmode),zmax
	  write(charb,1004) Gx.aretx,Gx.dretx,cam(Gx.iabsc),zmin
	endif
        if (Gx.iabsc.eq.3) then
	  chara(21:40) = 'sl: Inf'
	  if (Gx.lvl(i).cut .eq. 1) then
	    if (Gx.dretx .ne. 0.d0)
     &      write(chara(21:40), '(4hsl: , g16.9)') Gx.dretz/Gx.dretx
	    charb(42:47) = '(dzdx)'
	  elseif (Gx.lvl(i).cut .eq. 2) then
	    if (Gx.drety .ne. 0.d0)
     &      write(chara(21:40), '(4hsl: , g16.9)') Gx.dretz/Gx.drety
	    charb(42:47) = '(dzdy)'
          else
	    if (Gx.drety .ne. 0.d0)
     &	    write(chara(21:40), '(4hsl: , g16.9)') Gx.dretx/Gx.drety
          endif
        endif
	if (Gx.iabsc.eq.0 .and. Gx.yfmt.ne.' ') then
	  ls = M$D2A_FORM (Gx.arety, chara( 4:19), Gx.yfmt)
	  ls = M$D2A_FORM (Gx.drety, chara(25:40), Gx.yfmt)
	elseif (Gx.iabsc.eq.0 .and. Gx.iylab.eq.4) then
	  ls = M$SEC2TSPEC(Gx.arety, chara( 4:19), 0)
	  ls = M$SEC2TSPEC(Gx.drety, chara(25:40), 1)
	endif
	if (Gx.iabsc.eq.0 .and. Gx.xfmt.ne.' ') then
	  ls = M$D2A_FORM (Gx.aretx, charb( 4:19), Gx.xfmt)
	  ls = M$D2A_FORM (Gx.dretx, charb(25:40), Gx.xfmt)
	elseif (Gx.iabsc.eq.0 .and. Gx.ixlab.eq.4) then
	  ls = M$SEC2TSPEC(Gx.aretx, charb( 4:19), 0)
	  ls = M$SEC2TSPEC(Gx.dretx, charb(25:40), 1)
	endif
	if (Gx.zfmt.ne.' ') then
	  ls = M$D2A_FORM (zmax, chara(53:64), Gx.zfmt)
	  ls = M$D2A_FORM (zmin, charb(53:64), Gx.zfmt)
	endif

	call MX$TEXT (xt, yt, chara)
	yt = yt + Mx.text_h
	call MX$TEXT (xt, yt, charb)

	xt = Mx.width - Mx.text_w*2
	if (Gx.cntrls.gt.0) call MX$TEXT (xt, yt, 'C')
	if (Gx.cntrls.le.0) call MX$TEXT (xt, yt, ' ')

 1001	format('y: ',1p1g16.9,' dy: ',g16.9,' L=',i1,a3,' zH: ',g12.5)
 1002	format('x: ',1p1g16.9,' dx: ',g16.9,' ',a6,' zL: ',g12.5)
 1003	format('y: ',1p1g16.9,' dy: ',g16.9,' L=',i1,a3,'  z: ',g12.5)
 1004	format('x: ',1p1g16.9,' dx: ',g16.9,' ',a6,' dz: ',g12.5)

	return
	end


	subroutine FORM_BUF (fbuf, lines, ix1, ix2, pbuf, cut)
c
	include 'xraster.inc'
	integer*4 L_bbuf
	parameter (L_bbuf=16)
	include 'buffers.inc'
c Parameters
	real*4 fbuf(*)
	integer*4 lines, ix1, ix2, cut
	byte   pbuf(*)
c Locals
	record /BUFFER/ DB
	integer*4 i, j, ix3, ix, iy, iiy, l, cmode, size
	integer*4 nbpe, n, nn, nnn, nnx, nny, nnxo, ninc, noff, imin, imax
	logical*4 threshold, preread, autoscale
	real*4    factor, qmax, qmin, fmin, fscale, dbscale, dbmin
	integer*2 idbmin, idbmax, ibuf(1)
	pointer (ibuf_ptr, ibuf)
	byte	  t0, t1
	integer*4 idbmagindex	! location of exponent in idbmag()
#if _EEEI
	parameter (idbmagindex=2)	! exponent in last 2 bytes
#else
	parameter (idbmagindex=1)	! exponent in first 2 bytes
#endif

	call M$VSTYPE ('F')
c
c trap special form for single data value read
	cmode = Gx.cmode
	nnx = Gx.iframe
	nny = lines 
	if (cut.gt.0) nnx = ix2
	if (cut.eq.3) then
	  i = Mx.level
	  do while (i.gt.1 .and. (
     &	     Mx.xpos.lt.Mx.stk(i).x1  .or. Mx.xpos.gt.Mx.stk(i).x2 .or.  
     &	     Mx.ypos.lt.Mx.stk(i).y1  .or. Mx.ypos.gt.Mx.stk(i).y2) )
	    i = i-1
	  enddo
	  cmode = Gx.lvl(i).cmode
	endif
	size = nnx*nny
	autoscale = (Gx.autom.gt.0 .and. Gx.autom.ne.4 .and. cmode.ne.2)
	preread = (autoscale .and. Gx.autom.ne.5 .and. Gx.autol.eq.0)
c
c special pre-formatted case
	if (Gx.HIN.format.eq.'SO') then
!!RDA - color translation now in put_image
!!RDA	  do n = 1, size
!!RDA	    i = pbuf(n)
!!RDA	    pbuf(n) = Mx.pixel(i)
!!RDA	  enddo
	  return
	endif
c
c perform 2D thin if necessary
	if (ix1.ne.1 .or. ix2.ne.nnx) then
	  ix3 = ix2 - ix1 + 1
	  if (Gx.cx) then
	    do iy = 0,2*nny-2,2
	      call M$CVMOV(fbuf(iy*nnx+2*ix1-1), 1, fbuf(iy*ix3+1), 1, ix3)
	    enddo
	  else
	    do iy = 0,nny-1
	      call M$VMOV(fbuf(iy*nnx+ix1), 1, fbuf(iy*ix3+1), 1, ix3)
	    enddo
	  endif
	  nnx = ix3
	  size = nnx*nny
	endif

	if (cut.eq.0.and.Gx.cmp.eq.4.and.(Gx.xc.gt.1.or.Gx.yc.gt.1)) then
	  n = 1
	  nnxo = nnx
	  nnx = nnx / Gx.xc
	  nny = nny / Gx.yc
	  do nn = 1, size, nnxo*Gx.yc
	    if (Gx.cx) then
	      call M$CVMOV(fbuf(2*nn-1), Gx.xc, fbuf(2*n-1), 1, nnx)
	    else
	      call M$VMOV(fbuf(nn), Gx.xc, fbuf(n), 1, nnx)
	    endif
	    n = n + nnx
	  enddo
	  size = nnx*nny
	endif
c
c do any data transformations needed on the data
	if (Gx.cx) then	
	  if (cmode.eq.1) then		! CX MAGNITUDE
	    call M$CVMAG(fbuf, fbuf, size)
	  elseif (cmode.eq.2) then	! CX PHASE
	    if (cut.eq.0) then
	      call M$CVRPHAD(fbuf, fbuf, size, 20)
	    else
	      call M$CVPHAD(fbuf, fbuf, size)
	    endif
	  elseif (cmode.eq.3) then	! CX REAL
	    call M$VMOV(fbuf, 2, fbuf, 1, size)
	  elseif (cmode.eq.4) then	! CX IMAGINARY
	    call M$VMOV(fbuf(2), 2, fbuf, 1, size)
	  elseif (cmode.ge.5) then	! CX LOG and LOG2
	    call M$CVMAG2(fbuf, fbuf, size)
	  endif
	elseif (cmode.eq.1 .or. cmode.ge.5) then	! SCALAR MAGNITUDE
	  do n = 1, size
	    fbuf(n) = ABS(fbuf(n))
	  enddo
	endif

	! final LOG and LOG2 conversions for SCALAR and COMPLEX data
	if (cmode.ge.5) then
	  dbscale = 10.0
	  if (cmode.eq.6) dbscale = 20.0
	  if (Gx.cx) dbscale = dbscale * 0.5

	  ! Fast Algorithm uses exponent bytes directly, no log needed
	  dbmin = Gx.dbmin
	  if (cut.le.0 .and. Gx.fast) then
	    do i = 1, size
	      if (fbuf(i) .lt. dbmin) fbuf(i) = dbmin
	    enddo
	  else
	    call M$VLOG10(fbuf, dbmin, fbuf, size)
	    if (cut.gt.0) call M$VSMUL(fbuf, dbscale, fbuf, size)
	  endif
	endif
c
c XYZ cuts can leave this routine now
	if (cut.gt.0) return
c
c compress the data lines?
	if (Gx.yc .gt. 1 .and. Gx.cmp.ne.4) then
	  n = 1
	  ninc = Gx.yc*nnx - nnx
	  if (Gx.cmp .eq. 1) factor = 1.0 / Gx.yc
	  do nn = 1, size, nnx*Gx.yc
	    nnn = nn+nnx
	    if (nnn.gt.size) then
	    elseif (Gx.cmp .eq. 1) then		! Y compression average
	      call M$VADD (fbuf(nn), fbuf(nnn), fbuf(n), nnx)
	      do nnn = nnn+nnx, nn+ninc, nnx
	        call M$VADD (fbuf(n), fbuf(nnn), fbuf(n), nnx)
	      enddo
	      call M$VSMUL (fbuf(n), factor, fbuf(n), nnx)
	    elseif (Gx.cmp .eq. 2) then		! Y compression min
	      do i = 0, nnx-1
	        fbuf(n+i) = min(fbuf(nn+i),fbuf(nnn+i))
	      enddo
	      do nnn = nnn+nnx, nn+ninc, nnx
	        do i = 0, nnx-1
		  if (fbuf(nnn+i) .lt. fbuf(n+i)) fbuf(n+i) = fbuf(nnn+i)
	        enddo
	      enddo
	    else				! Y compression max
	      do i = 0, nnx-1
	        fbuf(n+i) = max(fbuf(nn+i),fbuf(nnn+i))
	      enddo
	      do nnn = nnn+nnx, nn+ninc, nnx
	        do i = 0, nnx-1
		  if (fbuf(nnn+i) .gt. fbuf(n+i)) fbuf(n+i) = fbuf(nnn+i)
	        enddo
	      enddo
	    endif
	    n = n + nnx
	  enddo
	  nny = nny / Gx.yc
	  size = nnx*nny
	endif
c
c compress the data pixels?
	if (Gx.xc .gt. 1 .and. Gx.cmp.ne.4) then
	  nnxo = nnx
	  nnx = nnx / Gx.xc
	  if (Gx.cmp.eq.1) then    	! X compression average
	    n = 1
	    factor = 1./Gx.xc
	    do iy = 1, size, nnxo
	      call M$VBLK (fbuf(iy), fbuf(n), Gx.xc, nnxo)
	      call M$VSMUL (fbuf(n), factor, fbuf(n), nnx)
	      n = n + nnx
	    enddo

	  elseif (Gx.cmp.eq.2) then    	! X compression min
	    n = 1		! index of current compressed element
	    nnn = nnx*Gx.xc
	    do iy = 0, (nny-1)*nnxo, nnxo
	      nn = iy+1		! first value in a cluster of Gx.xc values
	      do ix = iy+1, iy+nnn
		if (ix.eq.nn) then
		  n = n + 1
		  fbuf(n) = fbuf(ix)
		  nn = nn + Gx.xc	! start next cluster here
		elseif (fbuf(n) .gt. fbuf(ix)) then
		  fbuf(n) = fbuf(ix)
		endif
	      enddo
	    enddo

	  elseif (Gx.cmp.eq.3) then    	! X compression max
	    n = 0		! index of current compressed element
	    nnn = nnx*Gx.xc
	    do iy = 0, (nny-1)*nnxo, nnxo
	      nn = iy+1		! first value in a cluster of Gx.xc values
	      do ix = iy+1, iy+nnn
		if (ix.eq.nn) then
		  n = n + 1
		  fbuf(n) = fbuf(ix)
		  nn = nn + Gx.xc	! start next cluster here
		elseif (fbuf(n) .lt. fbuf(ix)) then
		  fbuf(n) = fbuf(ix)
		endif
	      enddo
	    enddo

	  endif

	  size = nnx*nny
	endif
c
c if no autoscale - handle all lines at once
	if (Gx.autom.le.0 .or. Gx.autom.eq.5 .or. Gx.autol.eq.0) then
	  nnx = size
	  nny = 1
	  factor = 1.		! first pass auto scale fix
	else
	  factor = 1./float(Gx.autol)
	endif

c
c loop through raster lines
	do l = 1,nny
	  noff = (l-1)*nnx
c
c find range and modify scale
c  Gx.autom	 scaling mode: -1 Threshold	 1 Automin 	3 Autofull 
c				0 Parameters	 2 Automax 	4 Auto Fix 
	  if (autoscale .and. Gx.autol.ge.0) then
	    call M$VMXMN(fbuf(noff+1), qmax, qmin, j, i, nnx)

	    if (Gx.autol.le.1) then
	      if (cmode.ge.5) then
		if (Gx.autom.ne.1) then
		  if (.not. Gx.fast) qmax = 10**qmax
		  qmax = dbscale * log10(max(qmax,1e-20))
	        endif
		if (Gx.autom.ne.2 .and. Gx.dbrange.le.0) then
		  if (.not. Gx.fast) qmin = 10**qmin
		  qmin = dbscale * log10(max(qmin,1e-20))
		endif
	      endif
	      if (Gx.autol.eq.0 .and. Gx.rmin.le.Gx.rmax) then
	        if (Gx.autom.ne.1) Gx.rmax = max (Gx.rmax, qmax)
	        if (Gx.autom.ne.2) Gx.rmin = min (Gx.rmin, qmin) 
	      else
	        if (Gx.autom.ne.1) Gx.rmax = qmax
	        if (Gx.autom.ne.2) Gx.rmin = qmin
	      endif
	      if (Gx.autom.ne.2 .and. cmode.ge.5 .and. Gx.dbrange.gt.0) then
		Gx.rmin = Gx.rmax - Gx.dbrange
	      endif
	    elseif (cmode.ge.5) then
	      if (Gx.autom.ne.1) then
		if (.not. Gx.fast) qmax = 10**qmax
		qmax = qmax*factor + 10**(Gx.rmax/dbscale)*(1.-factor)
		Gx.rmax = dbscale * log10(max(qmax,1e-20))
	      endif
	      if (Gx.autom.ne.2) then
		if (Gx.dbrange.gt.0) then
		  Gx.rmin = Gx.rmax - Gx.dbrange
		else
		  if (.not. Gx.fast) qmin = 10**qmin
		  qmin = qmin*factor + 10**(Gx.rmin/dbscale)*(1.-factor)
		  Gx.rmin = dbscale * log10(max(qmin,1e-20))
		endif
	      endif
	    else
	      if (Gx.autom.ne.2) Gx.rmin = qmin*factor + Gx.rmin*(1.-factor)
	      if (Gx.autom.ne.1) Gx.rmax = qmax*factor + Gx.rmax*(1.-factor)
	    endif
	    if (Gx.autom.eq.5) then
	      Gx.autom = 4
	      autoscale = .false.
	      if (Gx.cbar .and. Gx.axes) call XRASTER_COLORBAR()
	    endif
	  endif

	  if (.not. preread) then
c
c set scaling factors
	    threshold = (Gx.autom.lt.0)
	    if (cmode.eq.2 .and. Gx.cx) then
	      qmin = -180.0
	      qmax = 180.0
	      if (threshold) qmin = 0.0
	    elseif (Gx.fast .and. cmode.ge.5) then
	      DB.fbuf(1) = 10.0**(Gx.rmin/dbscale)
	      DB.fbuf(2) = 10.0**(Gx.rmax/dbscale)
	      idbmin = DB.ibuf(idbmagindex)
	      idbmax = DB.ibuf(2+idbmagindex)
	      if (idbmin.eq.idbmax) threshold = .true.
	    else
	      if (cmode.ge.5) then
		qmin = Gx.rmin / dbscale
		qmax = Gx.rmax / dbscale
	      else
		qmin = Gx.rmin
		qmax = Gx.rmax
	      endif
	      if (qmin.eq.qmax) threshold = .true.
	    endif
c
c transform data to pixel values
	    if (threshold) then			! Threshold
	      t0 = 1	!RDA
	      t1 = Gx.ncolors	!RDA
	      if (cmode.ge.5 .and. Gx.fast) then ! fast DB threshold
		ibuf_ptr = %loc(fbuf) + 4*noff
		i = idbmagindex
		do n = noff+1, noff+nnx
	  	  if (ibuf(i).gt.idbmin) then
	  	    pbuf(n) = t1
	  	  else
	  	    pbuf(n) = t0
	  	  endif
		  i = i + 2
		enddo
	      else
		do n = noff+1, noff+nnx
	  	  if (fbuf(n).gt.qmin) then
	  	    pbuf(n) = t1
	  	  else
	  	    pbuf(n) = t0
	  	  endif
		enddo
	      endif
	    else				! non-threshold mode
	      if (cmode.ge.5 .and. Gx.fast) then ! fast non-dB, non-threshold
		fscale = float(Gx.ncolors)/float(idbmax-idbmin)
		fmin = idbmin - 1/fscale
		ibuf_ptr = %loc(fbuf) + 4*noff
		i = idbmagindex
		do n = noff+1, noff+nnx
		  j = (ibuf(i)-fmin)*fscale
		  pbuf(n) = max(1,min(Gx.ncolors,j))	!RDA
		  i = i + 2
		enddo
	      else			! Exact, all modes, non-threshold
		if (qmax-qmin .gt. 1e-32) then
		  fscale = float(Gx.ncolors)/(qmax-qmin)
		else
		  fscale = 1.0
		endif
		fmin = qmin - 1/fscale
		do n = noff+1, noff+nnx
	  	  j = (fbuf(n)-fmin)*fscale
	  	  pbuf(n) = max(1,min(Gx.ncolors,j))	!RDA
		enddo
	      endif
	    endif

	  endif
c
c end loop through raster lines
	enddo
c
	return
	end
	      

	subroutine PCUTS (mode)
c
	include 'xraster.inc'
	integer*4 lbuf(1), mode, xx, xy, xw, xh, yx, yy, yw, yh
	integer*4 ileft, itop, ibottom, i, bw, ipw, iyax, ixcb, iysp
	real*4 	  scale
	pointer (lbuf_ptr, lbuf)
	save
	record /PIXSTRUCT/ pix(4096)
c
	if (mode.ge.0.and.(Gx.reading.or.Gx.lvl(Mx.level).cut.gt.0)) return
	if (Gx.ctm .ne. 0) return

	lbuf_ptr = Gx.mbuf.p

	if (mode.le.0) then
	  if (Gx.xmap.ip .ne. 0) then
	    i = L_FreeMap
	    if (mode.eq.0) i = i + L_PutMap
	    call MX$MAP (Gx.xmap, 0, 0, 0, 0, i)
	    call MX$MAP (Gx.ymap, 0, 0, 0, 0, i) 
	  endif
	  return
	endif
c
	bw = 3
	i = Mx.level
	ipw = min(50,Gx.w/8,Gx.h/8)
	yw = ipw
	xh = ipw
	iyax = 0
	if (Gx.axes .and. Mx.level.eq.1) iyax = Mx.text_h*2
	ixcb = 0
	if (Gx.cbar.and.Mx.level.eq.1) ixcb = Mx.text_w*4
	if (Gx.cbar.and.Gx.axes.and.Mx.level.eq.1) ixcb = Mx.text_w*10
	iysp = 0
	if (Gx.specs) iysp = Mx.text_h * 2.5
c
	xx = Mx.stk(i).x1
	xw = Mx.stk(i).x2 - xx + 1
	yy = Mx.stk(i).y1
	yh = Mx.stk(i).y2 - yy + 1
	if (Gx.xmap.ip.eq.0) then
	  xy = min (Mx.height-iysp-xh, Mx.stk(i).y2 + 5 + iyax)
	  yx = min (Mx.width-yw,  Mx.stk(i).x2 + 5 + ixcb)
	  i = bw*2
	  call MX$MAP (Gx.xmap, xx-bw, xy-bw, xw+i, xh+i, L_NewMap)
	  call MX$MAP (Gx.ymap, yx-bw, yy-bw, yw+i, yh+i, L_NewMap)
	  do i = 1, bw
	    call MX$DRAW_BOX (-1, xx-i, xy-i, xw+2*i-1, xh+2*i-1)
	    call MX$DRAW_BOX (-1, yx-i, yy-i, yw+2*i-1, yh+2*i-1)
	  enddo
	endif

	if (Gx.xmap.ip .ne. 0) then
	  xy = Gx.xmap.y + bw
	  yx = Gx.ymap.x + bw
	  call MX$GET_IMAGE (lbuf, xx, Mx.ypos, xw, 1, Gx.ncolors)
	  call MX$GET_IMAGE (lbuf(xw+1), Mx.xpos, yy, 1, yh, Gx.ncolors)
c
	  scale = float(xh)/float(Gx.ncolors+1)		! X P-Cut Calculations
	  ibottom = xy + xh - 1
	  ileft = xx - 1
	  do i = 1, xw
	    pix(i).x = ileft + i
	    pix(i).y = ibottom - scale*lbuf(i)
	  enddo
c
	  scale = float(yw)/float(Gx.ncolors+1)		! Y P-Cut Calculations
	  itop = yy - xw - 1
	  do i = xw+1, xw+yh
	    pix(i).y = itop + i 
	    pix(i).x = yx + scale*lbuf(i)
	  enddo
c
	  call MX$CLEAR_AREA (xx, xy, xw, xh)		! Clr & Draw X,Y P-Cuts
	  call MX$CLEAR_AREA (yx, yy, yw, yh)
	  call MX$DRAW_LINES (-1, pix, xw)
	  call MX$DRAW_LINES (-1, pix(xw+1), yh)
	endif
c
	return
	end



	subroutine DRAW_CUT (jx1, jy1, jx2, jy2, cut)
c
	include 'xraster.inc'
	character*25 chara
	real*4 	 fbuf(1), qmax, qmin, scl
	real*8   start, delta, dstart, ymin0, ymax0, xmin0, xmax0, point(1)
	integer*4  i, j, n, k, cut, istart, jx1, jx2, jy1, jy2, iw, ih, d
	integer*4  ioff, ibeg, iend, npts, llgot, lb, rb, vb
	record /STKSTRUCT/ stk4
	pointer (fbuf_ptr, fbuf)
	pointer (point_ptr, point)

	call ACCESSORIES (a_a+a_bp+a_p, -1)
c
c find the start mode
	fbuf_ptr = Gx.mbuf.p
	point_ptr = Gx.mbuf.p
	istart = jx1 + jx2 + jy1 + jy2	! istart <> 0 means its a cut zoom
	if (istart.eq.0) then
	  do while (Gx.lvl(Mx.level).cut .gt. 0)
	    call MX$UNZOOM ()
	    Mx.level = Mx.level - 1
	  enddo
	endif
c
c define the region to cut over and get data if the first time
	k = Mx.level+1
	if (cut.eq.1) then
	  start = Gx.xstart
	  delta = Gx.xdelta
	else
	  start = Gx.ystart
	  delta = Gx.ydelta
	endif
c
	lb = 6.5 * Mx.text_w	! Borders for the grid:left,right and vertical
	rb = 4 * Mx.text_w
	vb = 2 * Mx.text_h

	if (istart.eq.0) then			! first time
	  if (cut.eq.1) then			! first time get data
	    xmin0 = Mx.stk(k-1).xmin
	    xmax0 = Mx.stk(k-1).xmax
	    ioff = max( 0, NINT((xmin0 - start)/delta) - 1) 
c+++
c DR 5347
c  4/18/02 BGB     fixed bug when performing an X cut on a file > 2G
c Old
c	    Gx.indy = max(1,min(INT(Gx.HIN.size),Gx.indy))
c	    dstart = DNINT( (Gx.indy-1)*Gx.xframe ) + ioff + 1
c New
	   Gx.indy = INT(max(DBLE(1.0),min(Gx.HIN.size,DBLE(Gx.indy))))
	    dstart = DNINT( DBLE(Gx.indy-1)*Gx.xframe ) + DBLE(ioff + 1)
c---
	    if (dstart .gt. Gx.HIN.size) return
	    npts = min( Gx.iframe, NINT((xmax0-start)/delta)+2) - ioff
	    call GRAB (fbuf, dstart, npts, llgot)
	  else
	    xmin0 = Mx.stk(k-1).ymin
	    xmax0 = Mx.stk(k-1).ymax
	    ioff = max(0, NINT((xmin0 - start)/delta) - 1) 
	    npts = min( NINT(Gx.HIN.size/Gx.xframe),
     &			NINT((xmax0-start)/delta) + 2 ) - ioff
	    Gx.indx = max(1,min(Gx.iframe,Gx.indx))
	    dstart = ioff * Gx.xframe + Gx.indx
	    n = 1
	    i = 0
	    j = 200
	    do while (n.le.npts)
	      call GRAB(%val(%loc(fbuf)+i), DNINT(dstart), 1, llgot)
	      if (n.eq.j) then
		write(chara,2001) 100*n/npts
 2001		format('Reading from file: ',i3,'%')
		call MX$SETBAR (chara)
		do while (MX$IFEVENT())
		  if (Mx.button_press.eq.2 .or. Mx.key_upchar.eq.'M') then 
		    if (MX$MENU (1,'FILE READ;Continue,Stop').eq.2) npts = n
		  endif
		enddo
		j = j + 200
	      endif
	      i = i + 4 * Gx.HIN.spa
	      n = n + 1
	      dstart = dstart + Gx.xframe
	    enddo
	    call MX$UNSETBAR ()
	  endif

	  if (Gx.cmode.eq.2) then
	    ymin0 = -180.d0
	    ymax0 = 180.d0
	  elseif (Gx.rmin .eq. Gx.rmax) then
	    ymin0 = Gx.rmin - 1.d0
	    ymax0 = Gx.rmax + 1.d0
	  else
	    ymin0 = Gx.rmin
	    ymax0 = Gx.rmax
	  endif

	  iw = Mx.width
	  ih = Mx.height
	  if (Gx.specs) ih = ih-Mx.text_h*2.5
	  stk4.x1 = 0.1 * iw 
	  stk4.y1 = 0.1 * ih 
	  stk4.x2 = stk4.x1 + 0.8 * iw - 1
	  stk4.y2 = stk4.y1 + 0.8 * ih - 1

	  call FORM_BUF (fbuf, 1, 1, npts, fbuf, cut)

	  Gx.lvl(k).ioff = ioff		! Offset index of fbuf data
	  Gx.lvl(k).size = npts		! Number of elements in fbuf
	  do n = npts, 1, -1
	    point(n) = fbuf(n)
	    ymin0 = min (point(n), ymin0)
	    ymax0 = max (point(n), ymax0)
	  enddo
	  ymin0 = ymin0 - .02 * (ymax0-ymin0)
	  ymax0 = ymax0 + .02 * (ymax0-ymin0)

	else						! zoom on cut
	  call M$MOVE (Mx.stk(Mx.level), stk4, L_xstack)
	  xmin0 = stk4.xmin + (jx1-stk4.x1) * stk4.xscl
	  xmax0 = stk4.xmax + (jx2-stk4.x2) * stk4.xscl
	  ymax0 = stk4.ymin + (jy1-stk4.y1) * stk4.yscl
	  ymin0 = stk4.ymax + (jy2-stk4.y2) * stk4.yscl
	  Gx.lvl(k).ioff = Gx.lvl(k-1).ioff	! offset
	  Gx.lvl(k).size = Gx.lvl(k-1).size	! # of elements in fbuf
	endif

	stk4.xscl = (xmax0-xmin0) / float(max (1,stk4.x2-stk4.x1-(lb+rb)))
	stk4.yscl = (ymin0-ymax0) / float(max (1,stk4.y2-stk4.y1-2*vb))
	stk4.xmin = xmin0 - lb * stk4.xscl
	stk4.xmax = xmax0 + rb * stk4.xscl
	stk4.ymin = ymax0 - vb * stk4.yscl
	stk4.ymax = ymin0 + vb * stk4.yscl

	Mx.stk(k).x1 = stk4.x1 + lb
	Mx.stk(k).y1 = stk4.y1 + vb
	Mx.stk(k).x2 = stk4.x2 - rb
	Mx.stk(k).y2 = stk4.y2 - vb
	Mx.stk(k).xmin = stk4.xmin + lb * stk4.xscl
	Mx.stk(k).xmax = stk4.xmax - rb * stk4.xscl
	Mx.stk(k).ymin = stk4.ymin + vb * stk4.yscl
	Mx.stk(k).ymax = stk4.ymax - vb * stk4.yscl
	Mx.stk(k).xscl = stk4.xscl
	Mx.stk(k).yscl = stk4.yscl

	ibeg = max( 1, INT((Mx.stk(k).xmin-start)/delta)-Gx.lvl(k).ioff-1)
	iend = NINT((Mx.stk(k).xmax-start)/delta) - Gx.lvl(k).ioff + 2
	npts = min( iend, Gx.lvl(k).size) - ibeg + 1
c
c rezoom and clear
	Mx.level = k
	iw = stk4.x2 - stk4.x1 + 1
	ih = stk4.y2 - stk4.y1 + 1
	call MX$ZOOM (stk4.x1, stk4.y1, iw, ih, stk4.x1, stk4.y1, 1, 1)
	call MX$CLEAR_AREA (stk4.x1, stk4.y1, iw, ih)

	if (cut.eq.1) then
	  call MX$DRAWAXIS (5, 5, Gx.ixlab, Gx.izlab, .true.)
	else
	  call MX$DRAWAXIS (5, 5, Gx.iylab, Gx.izlab, .true.)
	endif
c
c recalculate abscissa values every time, why?: MX$PLOT writes over them 
c each time using that array for a workspace to convert real to pixel values
	i = Gx.lvl(k).size
	dstart = start + (ibeg + Gx.lvl(k).ioff - 2)*delta
	do n = 1, npts
	  point(i+n) = dstart + n * delta
	enddo
	d = 0
	if (npts.le.2) d = -2
	call MX$PLOT (-1, point(i+1), point(ibeg), npts, 1, 1, d, point(i+1))
c
	call M$MOVE (stk4, Mx.stk(k), L_xstack)
	if (Gx.lvl(k-1).cut .gt. 0) then
	  Gx.lvl(k).indx = Gx.lvl(k-1).indx ! save x cut loc
	  Gx.lvl(k).indy = Gx.lvl(k-1).indy ! save y cut loc
	else
	  Gx.lvl(k).indx = Gx.indx		! save x cut loc
	  Gx.lvl(k).indy = Gx.indy		! save y cut loc
	endif
	Gx.lvl(k).xpts = npts		! save number of points in x dimension
	Gx.lvl(k).ypts = 1		! only one frame of data viewed
	Gx.lvl(k).cut = cut		! save cut type
	Gx.lvl(k).cmode = Gx.cmode	! save complex mode
c
	call ACCESSORIES (a_a, 1)
	return
	end
	      
	subroutine MSGDO (bit)
	include 'xraster.inc'
	integer*4 bit

	if (Gx.xf.msgid.gt.0 .and. BTEST(Gx.xf.msgmask,bit)) 
     &		call INFOMSG (bit, Mx.level, Gx.xf.msgid)
	return
	end

	subroutine INFOMSG (bit, iarg, rid)

	include 'xraster.inc'
	include 'qmessdef.inc'
	include 'qmessdecl.inc'
	character*2 cxm(6)  /'MA', 'PH', 'RE', 'IM', 'LO', 'L2'/
	integer*4  ylab(6) / 28 ,  24 ,  21 ,  22 ,  26 ,  27 /	
	integer*4 iarg, rid, i, bit
	real*8 d

	if (bit .eq. MSK_EXIT) then
	  call M$SEND_MSG (MQH_EXITINFO, MQD, rid, 0)
	elseif (bit .eq. MSK_COLOR) then
	  if (iarg .gt. 0) then			! get color
	    MQH_COLORINFO.colorid = iarg
	    call MX$COLORTAB (iarg, MQD.color, -3)
	    call M$SEND_MSG (MQH_COLORINFO, MQD.COLOR, rid, 0)
	  elseif (Gx.cmap.eq.5) then		! get colormap
	    MQH_COLORMAPINFO.colormapid = -1
	    call M$SEND_MSG (MQH_COLORMAPINFO, Gx.map5, rid, 0)
	  else
	    MQH_COLORMAPINFO.colormapid = Gx.cmap
	    call M$SEND_MSG (MQH_COLORMAPINFO, Mc.colormap(Gx.cmap), rid, 0)
	  endif
	elseif (bit .eq. MSK_BOXES) then
	  Gx.xf.iarg = iarg
	  Gx.xf.mqdloc.p = %loc(MQD)
	  call MX$FACILITIES (Gx.xf, 'B', 3) 
	  MQH_BOXINFO.boxid = Gx.xf.iarg
	  call M$SEND_MSG (MQH_BOXINFO, MQD.BOXINFO, rid, 0)
	elseif (bit .eq. MSK_CXMODE) then
	  if (iarg.le.Mx.level) then
	    if (iarg.lt.1) i = max (1, Mx.level+iarg)
	    if (iarg.ge.1) i = min (iarg, Mx.level)
	    MQD.CXMODEINFO.mode = cxm(Gx.lvl(i).cmode)
	    MQH_CXMODEINFO.level = i - 1
	  else
	    MQD.CXMODEINFO.mode = cxm(Gx.cmode)
	    MQH_CXMODEINFO.level = Mx.level
	  endif
	  call M$SEND_MSG (MQH_CXMODEINFO, MQD.CXMODEINFO, rid, 0)
	elseif (bit .eq. MSK_MARK) then
	  MQD.MARKINFO.x = Gx.retx
	  MQD.MARKINFO.y = Gx.rety
	  MQD.MARKINFO.z = Gx.retz
	  MQH_MARKINFO.info = Mx.state_mask
	  call M$SEND_MSG (MQH_MARKINFO, MQD.MARKINFO, rid, 0)
	elseif (bit .eq. MSK_POINTS) then
	  Gx.xf.iarg = iarg
	  Gx.xf.mqdloc.p = %loc(MQD)
	  call MX$FACILITIES (Gx.xf, 'P', 3)
	  MQH_POINTINFO.pointid = Gx.xf.iarg
	  call M$SEND_MSG (MQH_POINTINFO, MQD.POINTINFO, rid, 0)
	elseif (bit .eq. MSK_SELECT) then
	  MQH_SELECTINFO.info = Mx.level
	  MQD.SELECTINFO.field = Gx.lvl(Mx.level).cut
	  if (MQD.SELECTINFO.field .eq. 1) then
	    MQD.SELECTINFO.elemt = Gx.ystart + (Gx.indy-1)*Gx.ydelta
	  elseif (MQD.SELECTINFO.field .eq. 2) then
	    MQD.SELECTINFO.elemt = Gx.xstart + (Gx.indx-1)*Gx.xdelta
	  endif
	  call M$SEND_MSG (MQH_SELECTINFO, MQD.SELECTINFO, rid, 0)
	else
	  if (iarg.lt.1) i = max (1, Mx.level+iarg)
	  if (iarg.ge.1) i = min (iarg, Mx.level)
	  MQD.PLOTINFO.xmin = min (Mx.stk(i).xmin, Mx.stk(i).xmax)
	  MQD.PLOTINFO.xmax = max (Mx.stk(i).xmin, Mx.stk(i).xmax)
	  MQD.PLOTINFO.ymin = min (Mx.stk(i).ymin, Mx.stk(i).ymax)
	  MQD.PLOTINFO.ymax = max (Mx.stk(i).ymin, Mx.stk(i).ymax)
	  if (bit .eq. MSK_ZOOM) then
	    MQH_ZOOMINFO.level = i - 1
	    call M$SEND_MSG (MQH_ZOOMINFO, MQD.PLOTINFO, rid, 0)
	  elseif (bit .eq. MSK_UNZOOM) then
	    MQH_UNZOOMINFO.level = i - 1
	    call M$SEND_MSG (MQH_UNZOOMINFO, MQD.PLOTINFO, rid, 0)
	  else
	    if (Gx.lvl(i).cut.eq.2) then
	      MQD.PLOTINFO.xunits = Gx.ylab
	      if (Gx.ylab.lt.0) MQD.PLOTINFO.xunits = Gx.HIN.yunits
	    else
	      MQD.PLOTINFO.xunits = Gx.HIN.xunits
	      if (Gx.xlab.ge.0) MQD.PLOTINFO.xunits = Gx.xlab
	    endif
	    if (Gx.lvl(i).cut .gt. 0) then
	      if ((.not.Gx.cx .and. Gx.lvl(i).cmode.eq.3) .or.
     &		  (Gx.cx .and. Gx.lvl(i).cmode.eq.1)) then
		MQD.PLOTINFO.yunits = Gx.zlab
	      else
		MQD.PLOTINFO.yunits = ylab(Gx.lvl(i).cmode)
	      endif
	    else
	      MQD.PLOTINFO.yunits = Gx.HIN.yunits
	      if (Gx.ylab.ge.0) MQD.PLOTINFO.yunits = Gx.ylab
	    endif
	    MQD.PLOTINFO.cxmode = cxm(Gx.lvl(i).cmode)
	    if (bit .eq. MSK_PANX .or. bit .eq. MSK_PANY) then
	      MQH_PANINFO.level = i - 1
	      call M$SEND_MSG (MQH_PANINFO, MQD.PLOTINFO, rid, 0)
	    elseif (bit .eq. -1) then
	      MQH_PLOTINFO.level = i - 1
	      MQD.PLOTINFO.xframe = Gx.lvl(i).xpts
	      MQD.PLOTINFO.yframe = Gx.lvl(i).ypts
	      MQD.PLOTINFO.primname = 'XRASTER'
	      call M$SEND_MSG (MQH_PLOTINFO, MQD.PLOTINFO, rid, 0)
	    endif
	  endif
	endif

	return
	end

	subroutine XRASTER_ZOOM (ix1, ix2, iy1, iy2)

	include 'xraster.inc'
	integer*4 ix1, ix2, iy1, iy2, x1, x2, y1, y2, x12, y12
	integer*4 j, k, iw, ih, inx, iny, cut, ixs, iys, ipw

	j = Mx.level
	cut = Gx.lvl(j).cut
	if (j.ge.10) then
	  call MX$MESSAGE ('No more zoom levels available', -1.0)
	elseif (Gx.readlevel.ne.1 .and. Gx.reading) then
	  call MX$MESSAGE ('Wait for image resolve to complete', -1.0)
	elseif (Gx.HIN.open) then
	  ! clip on previous zoom level
	  x1 = max (min(ix1,ix2), Mx.stk(j).x1)
	  x2 = min (max(ix1,ix2), Mx.stk(j).x2)
	  y1 = max (min(iy1,iy2), Mx.stk(j).y1)
	  y2 = min (max(iy1,iy2), Mx.stk(j).y2)
	  x12 = x2 - x1
	  y12 = y2 - y1
	  if (x12.gt.0 .and. y12.gt.0) then
	    if (Gx.lvl(j).cut .gt. 0) then	! zoom on x,y cuts
	      call DRAW_CUT(x1, y1, x2, y2, cut)
	    else			    ! zoom on raster
	      call ACCESSORIES (a_a+a_bp+a_p, -1)
	      k = j + 1
	      Mx.stk(k).xmin = Mx.stk(j).xmin+(x1-Mx.stk(j).x1)*Mx.stk(j).xscl
	      Mx.stk(k).ymin = Mx.stk(j).ymin+(y1-Mx.stk(j).y1)*Mx.stk(j).yscl

	      Mx.stk(k).xmax = Mx.stk(j).xmax+(x2-Mx.stk(j).x2)*Mx.stk(j).xscl
	      Mx.stk(k).ymax = Mx.stk(j).ymax+(y2-Mx.stk(j).y2)*Mx.stk(j).yscl

	      Gx.lvl(k).xpts = 1+(Mx.stk(k).xmax-Mx.stk(k).xmin)/Gx.xdelta
	      Gx.lvl(k).ypts = 1+(Mx.stk(k).ymax-Mx.stk(k).ymin)/Gx.ydelta


	      ipw = 0		! space for PCUTS
	      if (Gx.pcut) ipw = min(50,Gx.w/8,Gx.h/8)
	      ixs = ipw
!	      if (Gx.axes) ixs = ixs + Mx.text_w*7
	      iys = ipw
!	      if (Gx.axes) iys = iys + Mx.text_h*2
	      if (Gx.specs) iys = iys + Mx.text_h*2.5

	      ! if currently drawing, stack zooms inside the 1st zoom
	      if (Gx.reading .and. j.gt.1) then
		iw = Mx.stk(2).x2 - Mx.stk(2).x1 - 3
		ih = Mx.stk(2).y2 - Mx.stk(2).y1 - 3
		inx = max(1, iw / x12 )
		iny = max(1, ih / y12 )
		x2 = Mx.stk(2).x1 + (iw-x12*inx)/2
		y2 = Mx.stk(2).y1 + (ih-y12*iny)/2
	      else
		iw = Mx.width-ixs
		ih = Mx.height-iys
		inx = max(1, NINT(iw*.9) / x12 )
		iny = max(1, NINT(ih*.9) / y12 )
		x2 = max(2,(Mx.width-ixs-x12*inx)/2) + ixs-ipw
		y2 = max(2,(Mx.height-iys-y12*iny)/2)
	      endif

	      iw = x12*inx
	      ih = y12*iny
	      Mx.stk(k).x1    = x2
	      Mx.stk(k).y1    = y2
	      Mx.stk(k).x2    = x2 + iw - 1
	      Mx.stk(k).y2    = y2 + ih - 1
	      Mx.stk(k).xscl = (Mx.stk(k).xmax-Mx.stk(k).xmin)/float(iw-1)
	      Mx.stk(k).yscl = (Mx.stk(k).ymax-Mx.stk(k).ymin)/float(ih-1)
	      Gx.lvl(k).xcmp  = Gx.xc
	      Gx.lvl(k).ycmp  = Gx.yc
	      Gx.lvl(k).cmode = Gx.lvl(j).cmode
	      Gx.lvl(k).cut   = Gx.lvl(j).cut
	      Gx.lvl(k).ctm   = Gx.ctm
	      Gx.lvl(k).rmin  = Gx.lvl(j).rmin
	      Gx.lvl(k).rmax  = Gx.lvl(j).rmax
	      Mx.level = k
	      if (Gx.autorr .or. Gx.ctm.ne.0) then
		call REREAD_PREP(0)
		! draw axis is at the end of XRASTER_READ
	      else
	        call MX$ZOOM (x1, y1, x12, y12, x2, y2, inx, iny)
	        call ACCESSORIES (a_a+a_bp, 1)
		if (Gx.axes) call MX$DRAWAXIS (5, 5, Gx.ixlab, Gx.iylab,
     &			L_noxplab+L_noyplab+L_insidelab)
	      endif
	    endif
	  endif
	  call MSGDO (MSK_ZOOM)
	endif
	return
	end

	subroutine XRASTER_UNZOOM (level)

	include 'xraster.inc'
	integer*4 level
	logical*4 pcut, xycut

	xycut = Gx.lvl(Mx.level).cut .gt. 0
	call ACCESSORIES (a_a+a_p, -1)
	do while (Mx.level .gt. level)
	  call MX$UNZOOM ()
	  Mx.level = Mx.level - 1
	enddo
	if (Gx.lvl(Mx.level).cut .eq. 0) then
	  Gx.readlevel = min(Gx.readlevel, Mx.level)
	  Gx.xc = Gx.lvl(Mx.level).xcmp
	  Gx.yc = Gx.lvl(Mx.level).ycmp
	  Gx.ctm = Gx.lvl(Mx.level).ctm 
c? has to do with global default concept
c?	  Gx.cmode = Gx.lvl(Mx.level).cmode
c?	  Gx.rmin = Gx.lvl(Mx.level).rmin
c?	  Gx.rmax = Gx.lvl(Mx.level).rmax
	  if (xycut .and. .not.Gx.stopread) Gx.reading = .true.
	endif
	call ACCESSORIES (a_a+a_bp, 1)
C MRSL/TAS, DR 1031, make certain that =unzoom messages are only sent if
C                    corresponding =zoom messages were sent.
	if (.not. xycut) call MSGDO (MSK_UNZOOM)

	return
	end



	subroutine SETTINGS (flag, v)
	include 'xraster.inc'
	record /CBSTRUCT/ cb
	integer*4 flag, v, status
	cb.item = flag
	cb.value = v
	cb.mode = 0
	if (v.eq.-999) cb.mode = L_CBenable
	call XRASTER_SETTINGS (cb)
	return
	end


	subroutine XRASTER_SETTINGS (cb)
        include 'xraster.inc'
	record /CBSTRUCT/ cb
	integer*4 v, i, cut, item
	logical*4 t, set, interactive
	integer*4  zlab(6) / 28,24,21,22,26,27 /	

	cb.status = L_CBokaction

	v = cb.value
	item = cb.item
	interactive = cb.mode .eq. L_CBenable
	if (interactive) v = -1
	t = v .lt. 0
	set = v .gt. 0

	if (item.eq.t_all) then
	  if (t .or. (Gx.all .neqv. set)) then
	    Gx.all = .not. Gx.all
	    call XRASTER_RESTART ()
	  endif
	elseif (item.eq.t_auto) then
	  if (interactive) then
	    v = MX$MENU (Gx.autom+2,'SCALING;Threshold...,'//
     &		'Parameters...,Min Auto...,Max Auto...,'//
     &		'Full Auto...,Fix Auto...') - 2
	  endif
	  Gx.autom = min(max(-1,v),4)
	elseif (item.eq.t_autol) then
	  if (interactive) then
	    v = Gx.autol
	    call MX$LPROMPT ('Lines in Average: ', v)
	  endif
	  Gx.autol = max(0,v)
	elseif (item.eq.t_axes) then
	  if (t .or. (Gx.axes .neqv. set)) then
	    Gx.axes = .not. Gx.axes
	    if (Gx.axes) call XRASTER_RESTART ()
	    if (.not.Gx.axes) call XRASTER_REFRESH ()
	  endif
	elseif (item.eq.t_specs) then
	  if (t .or. (Gx.specs .neqv. set)) then
	    Gx.specs = .not. Gx.specs
	    if (Gx.specs) call XRASTER_RESTART ()
	    if (.not.Gx.specs) call XRASTER_REFRESH ()
	  endif
	elseif (item.eq.t_cbar) then
	  if (t .or. (Gx.cbar .neqv. set)) then
	    Gx.cbar = .not. Gx.cbar
	    if (Gx.cbar) call XRASTER_RESTART ()
	    if (.not.Gx.cbar) call XRASTER_REFRESH ()
	  endif
	elseif (item.eq.t_cmp) then
	  if (interactive) then
	    v = MX$MENU (Gx.cmp,'COMPRESSION METHOD;Average,Min Value,'//
     &		'Max Value,First Element')
	  endif
	  Gx.cmp = min(max(1,v),4)
	elseif (item.eq.t_cross) then
	  if (t .or. (Gx.cross .neqv. set)) Gx.cross = .not. Gx.cross
	elseif (item.eq.t_lpf) then
	  if (interactive) then
	    v = Gx.lpf
	    call MX$LPROMPT ('Raster Lines Per Frame: ', v)
	  endif
	  i = v
	  if (i.eq.-1) i = 0
	  if (Gx.lpf .ne. i) then
	    Gx.lpf = i
	    if (Gx.lpf.eq.0) Gx.istart = 0
	    call XRASTER_RESTART ()
	  endif
	elseif (item.eq.t_mimic) then
	  if (interactive) then
	    v = Gx.mimic
	    call MX$LPROMPT ('ID of primitive to MIMIC: ', v)
	  endif
	  Gx.mimic = v
	elseif (item.eq.t_msgid) then
	  if (interactive) then
	    v = Gx.xf.msgid
	    call MX$LPROMPT ('ID of primitive to send MSGs: ', v)
	  endif
	  Gx.xf.msgid = v
	elseif (item.eq.t_autorr) then
	  if (t .or. (Gx.autorr .neqv. set)) Gx.autorr = .not. Gx.autorr
	elseif (item.eq.t_pcuts) then
	  if (interactive .and. .not. Gx.pcut .and. Gx.reading) then
	    call MX$MESSAGE ('Wait until FILE read is completed',1.0)
	    cb.status = L_CBnoaction
	    return
	  endif
	  if (t .or. (Gx.pcut .neqv. set)) Gx.pcut = .not. Gx.pcut
	  if (Gx.pcut) call PCUTS(1)
	  if (.not. Gx.pcut) call PCUTS(0)
	elseif (item.eq.t_ctm) then
	  if (interactive) then
	    v = MX$MENU(Gx.ctm+1,
     &		'CONTOUR MODE;Off,Contour,Overlay')-1
	  endif
	  if (v.eq.Gx.ctm) return
	  if (Gx.pcut) call PCUTS(0)
	  Gx.ctm = v
	  call REREAD_PREP(1)
	elseif (item.eq.t_ctc) then
	  if (interactive) then
	    v = Gx.ctc
	    call MX$LPROMPT ('Overlay contour color: ', v)
	  endif
	  if (v.eq.Gx.ctc) return
	  Gx.ctc = v
	  call REREAD_PREP(1)
	elseif (item.eq.t_ctl) then
	  if (interactive) then
	    v = Gx.ctl
	    call MX$LPROMPT ('Number of contour steps: ', v)
	  endif
	  if (v.eq.Gx.ctl) return
	  Gx.ctl = v
	  call REREAD_PREP(1)
	elseif (item.ge.t_xlab .and. item.le.t_zlab) then
	  set = .false.
	  cut = Gx.lvl(Mx.level).cut
	  if (item.eq.t_xlab) then
	    if (interactive) then
	      v = Gx.xlab
	      call MX$LPROMPT ('X Units: ', v)
	    endif
	    if (v.ne.Gx.xlab .and. (v.ge.0 .or. Gx.xlab.ge.0)) then
	      Gx.xlab = v
	      set = .not. Gx.axes .and. cut.eq.1
	      if (Gx.axes) call XRASTER_RESTART ()
	    endif
	    Gx.ixlab = Gx.HIN.xunits
	    if (Gx.xlab .ge. 0) Gx.ixlab = Gx.xlab
	  elseif (item.eq.t_ylab) then
	    if (interactive) then
	      v = Gx.ylab
	      call MX$LPROMPT ('Y Units: ', v)
	    endif
	    if (v.ne.Gx.ylab .and. (v.ge.0 .or. Gx.ylab.ge.0)) then
	      Gx.ylab = v
	      set = .not. Gx.axes .and. cut.eq.2
	      if (Gx.axes) call XRASTER_RESTART ()
	    endif
	    Gx.iylab = Gx.HIN.yunits
	    if (Gx.ylab .ge. 0) Gx.iylab = Gx.ylab
	  elseif (item.eq.t_zlab) then
	    if (interactive) then
	      v = Gx.zlab
	      call MX$LPROMPT ('Z Units: ', v)
	    endif
	    if (v.ne.Gx.zlab .and. (v.ge.0 .or. Gx.zlab.ge.0)) then
	      Gx.zlab = v
	      set = cut.gt.0
	    endif
	    Gx.izlab = zlab(Gx.cmode)
	    if ( Gx.zlab .ge. 0 .and. ( 
     &	       (.not.Gx.cx .and. Gx.cmode.eq.3) .or.
     &	       (Gx.cx .and. Gx.cmode.eq.1) ) ) Gx.izlab = Gx.zlab
	    if (set) call DRAW_CUT(0, 0, 0, 0, cut)
	  endif
	  call DISPLAY_SPECS ()
	elseif (item.eq.t_hold) then
	  i = Gx.hold
	  if (t .and. Gx.hold.eq.0) then
	    Gx.hold = 1
	  elseif (t .and. Gx.hold.ne.0) then
	    Gx.hold = 0
	  else
	    Gx.hold = v
	  endif
	  if (i.gt.0 .and. Gx.hold.eq.0) call XRASTER_RESTART ()
	endif

	return
	end



	subroutine ACCESSORIES (flag, draw)
c
	include 'xraster.inc'
	integer*4 flag, draw, k
	logical*4 nocut, annot, bxpts, cross, pcut, cont

	annot = IAND(a_a,flag).ne.0 .and. Gx.xf.nannt.gt.0 .and. Gx.stopread
	nocut = Gx.lvl(Mx.level).cut.eq.0 .and. Gx.stopread
	bxpts = IAND(a_bp,flag).ne.0 .and. nocut
	bxpts = bxpts .and. (Gx.xf.nbox.gt.0 .or. Gx.xf.npoint.gt.0)
	cross = IAND(a_c,flag).ne.0 .and. nocut .and. Gx.cross
	pcut  = IAND(a_p,flag).ne.0 .and. nocut .and. Gx.pcut

	k = Mx.level
	cross = cross  
     &	 .and.	Mx.xpos.ge.Mx.stk(k).x1 .and. Mx.xpos.le.Mx.stk(k).x2
     &	 .and.	Mx.ypos.ge.Mx.stk(k).y1 .and. Mx.ypos.le.Mx.stk(k).y2

	if (draw.le.0) then
	  if (cross) then
	    call MX$RUBBERLINE (Mx.stk(k).x1,Mx.ypos,Mx.stk(k).x2,Mx.ypos)
	    call MX$RUBBERLINE (Mx.xpos,Mx.stk(k).y1,Mx.xpos,Mx.stk(k).y2)
	  endif
	  if (pcut ) call PCUTS(0)
	  if (annot) call MX$FACILITIES (Gx.xf, 'A', -2)
	  if (bxpts) call MX$FACILITIES (Gx.xf,'BP',L_Draw)
	else
	  if (bxpts) call MX$FACILITIES (Gx.xf, 'BP', L_Draw)
	  if (annot) call MX$FACILITIES (Gx.xf, 'A', L_Draw)
	  if (pcut ) call PCUTS(1)
	  if (cross) then
	    call MX$RUBBERLINE (Mx.stk(k).x1,Mx.ypos,Mx.stk(k).x2,Mx.ypos)
	    call MX$RUBBERLINE (Mx.xpos,Mx.stk(k).y1,Mx.xpos,Mx.stk(k).y2)
	  endif
	endif
	return
	end

	subroutine FACILITIES (type, mode)
	include 'xraster.inc'
	character*1 type
	integer*4 mode, cut, i, j
	logical*4 stopread
	i = 0
	cut = Gx.lvl(Mx.level).cut
	stopread = Gx.stopread
	if (Gx.stopread .and. cut.eq.0) then
	  j = -1
	  i = a_p
	  if (type .ne. 'A') i = i + a_a
	elseif (.not. Gx.stopread) then
	  j = 1
	  if (cut .eq. 0) i = a_bp
	  if (type .eq. 'A') i = i + a_a
	endif
	Gx.stopread = .true.
	if (i.ne.0) call ACCESSORIES (i, j)
	call MX$FACILITIES (Gx.xf, type, mode)
	if (i.ne.0) call ACCESSORIES (i, -j)
	Gx.stopread = stopread
	return
	end

	subroutine XRASTER_REFRAME (frame, offset, flag)
	include 'xraster.inc'
	real*8 frame, offset, dval
	integer*4 flag

	if (frame.le.0.0) frame = 1.0
	if (offset.ge.frame .or. offset.lt.0.d0) then
	  offset = offset - frame*DINT(offset/frame)
	  if (offset.lt.0.d0) offset = offset + frame
	endif

	if (flag.eq.1) then
	  Gx.HIN.subsize = frame
	else
	  dval = Gx.HIN.size
	  if (Gx.HIN.class .eq. 2) dval = dval * Gx.HIN.subsize
	  frame = min(frame, dval-offset)
	endif

	if (frame .ne. Gx.xframe) then
	  if (flag.eq.0) Gx.ydelta = Gx.ydelta*(frame/Gx.xframe)
	  Gx.xframe = frame
	  Mx.resize = .true.
	endif

	if (offset .ne. Gx.offset) then
	  Gx.offset = offset
	  Mx.resize = .true.
	endif

	return
	end

	subroutine GRAB (buf, start, get, got)
	include 'xraster.inc'
	real*4 buf(*)
	real*8 start, dstart, end
	integer*4 lget, get, got, bpa, off, nbytes

	if (Gx.inmem) then
	  bpa = Gx.HIN.spa * 4
	  got = min(get, NINT(Gx.dstart+Gx.HIN.size-start)+1)
	  off = bpa * (start - Gx.dstart)
	  end = start + got - 1.d0
	  if (end .gt. Gx.readmax) then
	    lget = get
	    dstart = start
	    if (Gx.readmax .lt. Gx.dstart) then
	      nbytes = Gx.HIN.size * Gx.HIN.spa * 4
	      call M$REMALLOC(nbytes, Gx.rbuf)
	    elseif (start .le. Gx.readmax) then
	      dstart = Gx.readmax + 1.d0
	      lget = NINT(end - Gx.readmax)
	      off = bpa * (dstart - Gx.dstart)
	    endif
	    call M$GRAB(Gx.HIN, %val(Gx.rbuf.p+off), dstart, lget, got)
	    if (start .le. Gx.readmax+1) Gx.readmax = max(end, Gx.readmax)
	  endif
	  call M$MOVE(%val(Gx.rbuf.p+off), buf, got*bpa)
	else
	  call M$GRAB (Gx.HIN, buf, start, get, got)
	endif

	return
	end




	subroutine CONTOURS (put)
c	
	include 'xraster.inc'
	integer*4 MAXLINES,MAXPIX
	parameter(MAXLINES=8192,MAXPIX=4096)
	integer*4 put,nx,ny,i,j,k,n,nout,npts,nplot,levels,ic
	real*4 zlevel,lines(MAXLINES*2),time
	real*4 xstart,xdelta,ystart,ydelta,rmin,rdel
	integer*2 pix(MAXPIX*2)	! also used to store last line of fbuf()
	integer*4 lbuf(1)
	byte	  work(1)
	pointer (lbuf_ptr, lbuf)
	pointer (work_ptr, work)
c
c we can perform the pixel mapping in MX$CONTOUR if we specify the 
c grid spacing in pixel coordinates
	k = Mx.level
	nx = Gx.nx
	ny = put
	levels = Gx.ctl
	if (levels.le.1) levels = Gx.ncolors
	xstart = Mx.stk(k).x1
	xdelta = Gx.xdelta / Mx.stk(k).xscl * Gx.xc
	ystart = Mx.stk(k).y1 + Gx.top
	ydelta = Gx.ydelta / Mx.stk(k).yscl * Gx.yc
	! offset to center of a cell
	xstart = xstart + xdelta*.5
	ystart = ystart + ydelta*.5
c
c insert bottom of last buffer to enforce contiguous lines
	if (Gx.top .eq. 0) then
	  lbuf_ptr = Gx.lbuf.p
	else
	  ny = ny+1
	  call M$MALLOC(nx*ny*4, lbuf_ptr)
	  call M$MOVE(pix, lbuf, nx*4)
	  call M$MOVE(%val(Gx.lbuf.p), lbuf(nx+1), (ny-1)*nx*4)
	  ystart = ystart - ydelta
	endif
c
c temp work buffer of contour algorithm
	call M$MALLOC(nx*ny*4, work_ptr)
c
c spread the levels out to cover entire plotted range
	rdel = (Gx.rmax-Gx.rmin)/levels
c
c set clip region - not needed with this scheme
	call MX$CLIP (Mx.stk(k).x1,Mx.stk(k).y1,
     &		Mx.stk(k).x2-Mx.stk(k).x1,Mx.stk(k).y2-Mx.stk(k).y1)
c
c loop through the contour levels	
	do n = 0,levels

	  if (Gx.ctm .eq. 1) then
	    zlevel = Gx.rmin + (n+.5)*rdel
	    if (n.eq.levels) goto 9
	    ic = NINT(n*float(Gx.ncolors)/levels) + 1
	  else
	    zlevel = Gx.rmin + n*rdel
	    ic = Gx.ctc
	  endif
	  ! the fbuf data is squared in the log mode
	  if (Gx.cmode.ge.5) zlevel = 10.0 ** (2*zlevel)

	  call MX$CONTOUR (zlevel, 0.0, 1, 
     &		lbuf, work, lines, nout, MAXLINES*8,
     &		nx,ny, xstart,xdelta, ystart,ydelta)	
	  j = 0
	  do while (j.lt.nout*2)
	    npts  = NINT(lines(j+1))
	    nplot = min(npts,MAXPIX)
	    j = j+6
	    do i = 1,nplot*2
	      pix(i) = max(-32767, min(32767, INT(lines(i+j)) ))
	    enddo
	    call MX$DRAW_LINES (ic,pix,nplot)
	    j = j+npts*2
	  enddo
 9	enddo
c
c clean up
	call MX$CLIP (0,0,0,0)
	call M$FREE(work_ptr)
	call M$MOVE(lbuf((ny-1)*nx+1), pix, nx*4)
	if (lbuf_ptr .ne. Gx.lbuf.p) call M$FREE(lbuf_ptr)
c
	return
	end


	subroutine XRASTER_CMODE (imode)
	include 'xraster.inc'
	integer*4 imode, iimode, k
	real*4 dbscale

	iimode = imode
	if (imode .gt. 6) iimode = imode - 2	! DB and D2 = LO and L2

	if (Gx.cmode .ne. iimode) then
	  ! Both modes non-log, no changes needed
	  if (Gx.cmode.lt.5 .and. iimode.lt.5) then
	  ! Changing from log to log mode
	  elseif (Gx.cmode.ge.5 .and. iimode.ge.5) then
	    dbscale = 2.0
	    if (Gx.cmode .eq. 6) dbscale = 0.5
	    Gx.zmin = Gx.zmin * dbscale
	    Gx.zmax = Gx.zmax * dbscale
	    Gx.rmin = Gx.rmin * dbscale
	    Gx.rmax = Gx.rmax * dbscale
	    k = Mx.level
	    if (Gx.lvl(k).cmode.ge.5 .and. Gx.lvl(k).cmode.ne.iimode) then
	      Gx.lvl(k).rmin = Gx.lvl(k).rmin * dbscale
	      Gx.lvl(k).rmax = Gx.lvl(k).rmax * dbscale
	      Gx.lvl(k).cmode = iimode
	    endif
	  ! Changing from log to non-log mode
	  elseif (Gx.cmode.ge.5) then
	    dbscale = 10.0
	    if (Gx.cmode.eq.6) dbscale = 20.0
	    Gx.zmin = 10**(Gx.zmin/dbscale)
	    Gx.zmax = 10**(Gx.zmax/dbscale)
	    Gx.rmin = 10**(Gx.rmin/dbscale)
	    Gx.rmax = 10**(Gx.rmax/dbscale)
	  ! Changing from non-log to log mode
	  else
	    dbscale = 10.0
	    if (iimode.eq.6) dbscale = 20.0
	    Gx.zmin = log10(amax1(abs(Gx.zmin),Gx.dbmin)) * dbscale
	    Gx.zmax = log10(amax1(abs(Gx.zmax),Gx.dbmin)) * dbscale
	    Gx.rmin = log10(amax1(abs(Gx.rmin),Gx.dbmin)) * dbscale
	    Gx.rmax = log10(amax1(abs(Gx.rmax),Gx.dbmin)) * dbscale
	  endif
	  Gx.cmode = iimode
	  call DISPLAY_SPECS()
	  call MSGDO (MSK_CXMODE)
	endif

	return
	end
