C Primitive library to plot graphs using PGPLOT
C SMH 24-May-1995
c Tanya Riseman Nov 2001 - March 2002


c========================================================================
      subroutine pg_init(idev, rainbow, just_erase) 
C initialize PG package for dec-windows
      implicit none
      include 'arraysize.inc'
      include 'io_files.inc'
      include 'spur_layout.inc'
      include 'spur_scan.inc'
      
c...	passed variables
       integer idev
       logical rainbow, just_erase

c...	functions
       integer pgopen
       
c...	local variables
      logical debug
      parameter (debug = .false.)
cDebug       integer iwhich
cMoved      integer icol1, icol2
c      integer i
c      real graytrans

      if (idev.eq.0) then
        if (.not. just_erase) ipage_lattice =  pgopen('/XSERVE')
      else if (idev.eq.1) then
        if (.not. just_erase) ipage_lattice =  pgopen('/XWIN')
      else if (idev.eq. 2) then		!! Grey scale PS
       ipage_lattice =  pgopen(FILE_PS)
	call pgbbuf()	!! begin batch buffering of output for PS
	if (debug) then
	  write (*,*) 'pg_init: PS output to ', FILE_PS(1:50)	
	endif
      else if (idev.eq.3) then		!! Color PS
        ipage_lattice =  pgopen(FILE_CPS)
	call pgbbuf()	!! begin batch buffering of output for PS
	if (debug) then
	  write (*,*) 'pg_init: PS output to ', FILE_CPS(1:50)
	endif
      else if (idev.eq. 4) then		!! Grey scale PS
        ipage_lattice =  pgopen('/NULL')
      else if (idev.eq.5) then		!! Color PS
        ipage_lattice =  pgopen('/NULL')
      endif

      if (ipage_lattice .eq. 0) then
         write (*,*) 'pg_init: ', 
     &	 'Error opening page/screen for lattice plot'
	 stop
      else	 
cDebug         write (*,*) 'pg_init: opened ipage_lattice=', ipage_lattice
	if (debug) then
          write (*,*) 'pg_init: Opening LATTICE page, ID=', 
     &		ipage_lattice, ' dev=', idev, 'just_erase=', just_erase
        endif
      endif

cDebug	call PGQID (iwhich)
cDebug	write (*,*) 'pg_init: Current window ID =', iwhich

      if (makescanplot) then
       if (idev.eq.0) then
        if (.not. just_erase) ipage_scan =  pgopen('/XSERVE')
       else if (idev.eq.1) then
        if (.not. just_erase) ipage_scan =  pgopen('/XWIN')
       else if (idev.eq. 2) then		!! Grey scale PS
         ipage_scan =  pgopen('/NULL')
       else if (idev.eq.3) then		!! Color PS
        ipage_scan =  pgopen('/NULL')
       else if (idev.eq. 4) then		!! Grey scale PS
        ipage_scan =  pgopen(FILE_scan_PS)
	call pgbbuf()	!! begin batch buffering of output for PS
	if (debug) then
	  write (*,*) 'pg_init: PS output to ', FILE_scan_PS(1:50)
	endif
       else if (idev.eq. 5) then		!! Color PS
         ipage_scan =  pgopen(FILE_scan_CPS)
	call pgbbuf()	!! begin batch buffering of output for PS
	if (debug) then
	  write (*,*) 'pg_init: PS output to ', FILE_scan_CPS(1:50)
	endif
       endif

       if (ipage_scan .eq. 0) then
         write (*,*) 'pg_init: ', 
     &	 'Error opening page/screen for scan plot'
	 stop
       else	 
cDebug         write (*,*) 'pg_init: opened ipage_scan=', ipage_scan
	if (debug) then
          write (*,*) 'pg_init: Opening SCAN page, ID=', 
     &		ipage_scan, ' dev=', idev, 'just_erase=', just_erase
        endif
       endif
      
cDebug	call PGQID (iwhich)
cDebug	write (*,*) 'pg_init: Current window ID =', iwhich

      endif
      
c pgask: If the prompt state is
c ON, PGPAGE will type ``Type RETURN for next page:'' and will wait
c for the user to type a carriage-return before starting a new page.
      call pgask(.FALSE.)

      call pgscf(1)	!! set character font to normal
      call pgslw(2)	!! set line width in units of 0.005 inch (0.13 mm)
      
c      call pgqcol(icol1, icol2)
c      write (*,*) 'pg_init: Color representation has range ',
c     &	       icol1, icol2

c...	Have to select palette after slecting the page???
      call PGSLCT(ipage_lattice)
      call select_palette(rainbow, idev)
cDebug      call check_palette('after PGSLCT(ipage_lattice)')

      return
      end

c======================================================
      subroutine select_palette(rainbow, idev)
      implicit none
      include 'spur_color.inc'

c...	passed variables
      logical rainbow
      integer idev
      
c...	local variables
      real	graytrans, colortrans
      integer 	icolor, icol1
      real 	lightness      
cDebug      real cr, cb, cg
      real	firstangle, rangeangle

c      parameter (firstangle = 120.0)		!! Red
c      parameter (rangeangle = 120.0)		!! Up to green (240 degrees)

      parameter (firstangle = 240.0)		!! Green
      parameter (rangeangle = 120.0)		!! Up to blue (360 degrees)

c      parameter (firstangle = 0.0)		!! Blue
c      parameter (rangeangle = 120.0)		!! Up to red (120 degrees)

c      parameter (firstangle = 0.0)		!! Blue
c      parameter (rangeangle = 360.0)		!! All colors

c...	Rather than hardwire the maximum color index available (99 or 255)
c...	based on the device chosen, ask PGPLOT what it thinks it is.
      call pgqcol(icol1, icol2)
cDebug      write (*,*) 'select_pallete: Color representation has range ',
cDebug     &	       icol1, icol2
cDebug      write (*,*) 'select_pallete: device = ', idev
cDebug      write (*,*) 'select_pallete: rainbow = ', rainbow
      
      if ((.not. rainbow) .or. (idev .eq. 2))  then
c...	Grey scale or B&W PS
C  	set the grayscale for color indices from 16 to 99
C  	where 16 is white and 99 is black, appropriate
C  	for a white BG (as on paper) and opposite to convention 
C  	for the XWIN viewport (a black background)
	do icolor = 16, icol2
          graytrans=1.0-float(icolor-16)/(float(icol2)-16.0)
cccc	  call PGSCR (CIndex, CRed, CGreen, CBlue)
	call pgscr(icolor,graytrans,graytrans,graytrans)
cDebug        write (*,*) 'select_palette: gray ', icolor, graytrans

cDebug	  call pgqcr(icolor, cr, cg, cb)			!! debug
cDebug	  write (*,*) 'select_palette: ', icolor,' RGB=',cr,cg,cb	!! debug

	enddo
cDebug        write (*,*) 'select_palette: gray.  Max # of shades=', icol2-16

      else	!! /xwin or color PS
          lightness = 0.5
          do icolor = 16, icol2
	  colortrans = firstangle + 
     &	    rangeangle*(1.0-float(icolor-16)/(float(icol2)-16.0) )	
ccc        call  PGSHLS (CIndex, CHue, CLightness, CSaturation)
cYuck          lightness=0.25 + 
cYuck     &	    0.5*(1.0-float(icolor-16)/(float(icol2)-16.0) )	
ccc     &	  0.25*(1.0-float(abs(icolor-(icol2-16)/2))/(float(icol2)-16.0))
	  call pgshls(icolor, colortrans, lightness, 1.0)
cDebug          write (*,*) 'select_palette: color ',
cDebug      &		   icolor, colortrans, lightness

cDebug	  call pgqcr(icolor, cr, cg, cb)
cDebug	  write (*,*) 'select_palette: ', icolor, ' RGB=', cr, cg, cb	

cDebug	  call pgqcr(icolor, cr, cg, cb)			!! debug
cdebug	  write (*,*) 'select_palette: ', icolor,' RGB=',cr,cg,cb	!! debug

	  enddo
cDebug          write (*,*) 'select_palette:color. Max # of shades=', icol2-16
      endif

      return
      end

c======================================================
      subroutine check_palette(astring)		!! for debugging
      implicit none
      include 'spur_color.inc'

c...	passed variables
c      logical rainbow
c      integer idev
      
c...	local variables
      integer 	icolor
      real cr, cb, cg
      character*(*) astring
      integer icol1
      
      call pgqcol(icol1, icol2)

        write (*,*) 'check_palette: ', astring
	do icolor = 16, icol2
	  call pgqcr(icolor, cr, cg, cb)
	  write (*,*) 'check_palette: ', icolor,' RGB=',cr,cg,cb
	enddo
        write (*,*) 'check_palette: Max # of shades=', icol2-16

      return
      end


c======================================================
      integer function select_color(value)
      implicit none
      include 'spur_color.inc'
 
c...	passed variables
      real value
      
c...	local variables
c      real	graytrans, colortrans
      integer 	icolor
cDebug      real cr, cb, cg
      
c	The color palette has already been loaded up in select_palatte.
c	Here translate a value (0 - 1) into a color index number (16 - icol2),
c	for looking up the color in the palette.
c	Palette may be in color or grey scale.
c	
	icolor = 16+int(float(icol2-16)*value)	
        call pgsci(icolor)
        select_color = icolor
	
	if (icolor .eq. 1) then
	  write (*,*) 'select_color: value = ', value, 'Index ', icolor
	  write (*,*) 'select_color: This index for desired shade', 
     &	  ' is not defined. Using ink color instead.'
	endif

cDebug	call pgqcr(icolor, cr, cg, cb)
cDebug	write (*,*) 'select_color: ', icolor, ' RGB=', cr, cg, cb	

      return
      end

cc======================================================
c      subroutine select_color(value)
c      implicit none
c      include 'spur_color.inc'
c 
cc...	passed variables
c      real value
c      
cc...	local variables
cc      real	graytrans, colortrans
c      integer 	icolor
ccDebug      real cr, cb, cg
c      
cc	The color palette has already been loaded up in select_palatte.
cc	Here translate a value (0 - 1) into a color index number (16 - icol2),
cc	for looking up the color in the palette.
cc	Palette may be in color or grey scale.
cc	
c	icolor = 16+int(float(icol2-16)*value)	
c        call pgsci(icolor)
c
ccDebug	call pgqcr(icolor, cr, cg, cb)
ccDebug	write (*,*) 'select_color: ', icolor, ' RGB=', cr, cg, cb	
c      return
c      end

c======================================================
      character*10 function name_color(code)
      implicit none
      include 'spur_color.inc'
 
c...	passed variables
      integer code
      if (code .eq. color_bkgr) then
	name_color = 'background'
      else if (code .eq. color_ink) then
	name_color = 'ink'
      else if (code .eq. color_red) then
	name_color = 'red'
      else if (code .eq. color_green) then
	name_color = 'green'
      else if (code .eq. color_blue) then
	name_color = 'blue'
      else if (code .eq. color_cyan) then
	name_color = 'cyan'
      else if (code .eq. color_magenta) then
	name_color = 'magetna'
      else if (code .eq. color_yellow) then
	name_color = 'yellow'
      else if (code .eq. color_orange) then
	name_color = 'orange'
      else if (code .eq. color_yellowgreen) then
	name_color = 'yellwgreen'
      else if (code .eq. color_greencyan) then
	name_color = 'greencyan'
      else if (code .eq. color_bluecyan) then
	name_color = 'bluecyan'
      else if (code .eq. color_bluemagenta) then
	name_color = 'bluemagnet'
      else if (code .eq. color_redmagenta) then
	name_color = 'redmagneta'
      else if (code .eq. color_darkgrey) then
	name_color = 'darkgrey'
      else if (code .eq. color_lightgrey) then
	name_color = 'lightgrey'
      endif
      return
      end


c======================================================
      subroutine place_circle(x, y, pointsize, circsize,  
     &      fillstyle, overridesize)
      implicit none
      include 'spur_color.inc'

c...	passed variables
      real x, y
      real pointsize, circsize
c      integer color
      integer fillstyle
      logical overridesize
      
c...	local variables
      real	temp
      
      if (overridesize .or. (circsize .gt. 0.0)) then
	    temp =  2.0* abs(circsize)
      else
	    temp =  2.0*circsize*pointsize
      endif

      call pgsfs(fillstyle)	!! solid=1, outline=2
c02Jan      call pgsci(color)
      call pgcirc(x, y, temp)
cDebug      write (*,*) 'place_circle: radius=', temp, 'color=', color, 
cDebug     &      overridesize

c     Add a black outline to grey/colored solid circle      
      if (fillstyle .eq. 1) then		!! solid
        call pgsfs(2)				!! outline
        call pgsci(color_ink)
        call pgcirc(x, y, temp)
      endif

      return
      end

c======================================================
      subroutine place_cross(x, y, pointsize, circsize,  
     &      overridesize)
      implicit none
      include 'spur_color.inc'

c...	passed variables
      real x, y
      real pointsize, circsize
c02Jan      integer color
      logical overridesize
      
c...	local variables
      real	temp
      real	x_vert(2), y_vert(2), x_horz(2), y_horz(2)
      
      if (overridesize .or. (circsize .gt. 0.0)) then
	    temp =  2.0* abs(circsize)
      else
	    temp =  2.0*circsize*pointsize
      endif
      
      x_vert(1) = x
      x_vert(2) = x
      y_vert(1) = y - temp
      y_vert(2) = y + temp
      x_horz(1) = x - temp
      x_horz(2) = x + temp
      y_horz(1) = y 
      y_horz(2) = y

c      write (*,*) 'place_cross: ', x, y 
c      write (*,*) ' vert:', x_vert(1), x_vert(2), y_vert(1), y_vert(2)
c      write (*,*) ' horz:', x_horz(1), x_horz(2), y_horz(1), y_horz(2)

c02Jan      call pgsci(color)
      call PGLINE (2, x_vert, y_vert)
      call PGLINE (2, x_horz, y_horz)

      return
      end

c========================================================================
c      subroutine pg_graph(x,y,sig,yc,npt)
c      implicit none
c      include 'spur_color.inc'
c
c      integer ipt,npt,maxpts
c
c      parameter (maxpts=1000)
c
c      real*8 x(npt),y(npt),sig(npt),yc(npt)
c      real*4 x_(maxpts),y_(maxpts),y_err1(maxpts),y_err2(maxpts)
c      real*4 yc_(maxpts),ymax,ymin,xlim_min,xlim_max,ylim_min,ylim_max
c
c      ymin=y(1)
c      ymax=y(1)
c
c      do ipt=1,npt      ! copy data in real*4 arrays for PGPLOT
c        x_(ipt)=x(ipt)
c        y_(ipt)=y(ipt)
c        y_err1(ipt)=y(ipt)-sig(ipt)
c        y_err2(ipt)=y(ipt)+sig(ipt)
c        yc_(ipt)=yc(ipt)
c
c        ymin=min(ymin,y_err1(ipt))
c        ymax=max(ymax,y_err2(ipt))
c      enddo
c
c      call pgrnge(x_(1),x_(npt),xlim_min,xlim_max)
c      call pgrnge(ymin,ymax,ylim_min,ylim_max)
c
c      call pgvport(0.1,0.9,0.1,0.9)
c      call pgswin(xlim_min,xlim_max,ylim_min,ylim_max)
c
c      call pgupdt
c      call pgsci(color_ink)
cc01Dec      call pgsci(1)
c      call pgbox('bcints',0.0,0,'bcints',0.0,0)
c      call pglabel('Scanning Variable (rlu or meV)','Counts',' ')
c      call pgpoint(npt,x_,y_,4)
c      call pgerry(npt,x_,y_err1,y_err2,1.0)
c      call pgline(npt,x_,yc_)
c      call pgebuf
c
c      return
c      end     

c========================================================================
      subroutine pg_close(idev, just_erase)
      implicit none
      include 'arraysize.inc'
      include 'spur_layout.inc'
      include 'spur_scan.inc'

c..	passed variables
      integer idev
      logical just_erase
            
c...	local variables
      logical debug
      parameter (debug = .false.)
cDebug      integer iwhich
            
      if (ipage_lattice .ne. 0) then
        if (debug) then
	  write (*,*) 'pg_close: Closing LATTICE page, ID=', 
     &		ipage_lattice, ' dev=', idev
        endif
ccDebug	call PGQID (iwhich)
ccDebug	write (*,*) 'pg_close: Current window ID =', iwhich
        call PGSLCT(ipage_lattice)
ccDebug	call PGQID (iwhich)
ccDebug	write (*,*) 'pg_close: Current window ID =', iwhich
        if (idev.eq. 2) then		!! Grey scale PS
          call pgebuf			!! End buffering
        else if (idev.eq.3) then		!! Color PS
          call pgebuf			!! End buffering
	else
          call pgupdt		!! flush the graphics buffer
	endif
cCloses all        call pgend
	if ((just_erase) .and. 
     &  	((idev .eq. 0) .or. (idev .eq. 1))) then
          call pgeras			!! Only for xwindow and xserve
          if (debug) then
	    write (*,*) 'pg_close: erased ipage_lattice=', ipage_lattice
	  endif
       	else
          call pgclos
          if (debug) then
	    write (*,*) 'pg_close: closed ipage_lattice=', ipage_lattice
	  endif
	endif
ccDebug	call PGQID (iwhich)
ccDebug	write (*,*) 'pg_close: Current window ID =', iwhich
ccDebug        write (*,*) 'pg_close: closed ipage_lattice=', ipage_lattice
      else
        write (*,*) 'pg_close: non-existent ipage_lattice=', 
     &	ipage_lattice
      endif

      if (makescanplot) then
       if (ipage_scan .ne. 0) then
        if (debug) then
          write (*,*) 'pg_close: Closing SCAN page, ID=', ipage_scan, 
     &		' dev=', idev
        endif
ccDebug	call PGQID (iwhich)
ccDebug	write (*,*) 'pg_close: Current window ID =', iwhich
        call PGSLCT(ipage_scan)
ccDebug	call PGQID (iwhich)
ccDebug	write (*,*) 'pg_close: Current window ID =', iwhich
        if (idev.eq. 4) then		!! Grey scale PS
	  call pgebuf()	!! end batch buffering of output for PS
        else if (idev.eq. 5) then		!! Color PS
	  call pgebuf()	!! end batch buffering of output for PS
	else
          call pgupdt		!! flush the graphics buffer	
        endif
	if ((just_erase) .and. 
     &  	((idev .eq. 0) .or. (idev .eq. 1))) then
          call pgeras
          if (debug) then
            write (*,*) 'pg_close: erased ipage_scan=', ipage_scan
	  endif
	else
          call pgclos
          if (debug) then
            write (*,*) 'pg_close: closed ipage_scan=', ipage_scan
	  endif
	endif
cClosesallwindows        call pgend
ccDebug	call PGQID (iwhich)
ccDebug	write (*,*) 'pg_close: Current window ID =', iwhich
ccDebug        write (*,*) 'pg_close: closed ipage_scan=', ipage_scan
       else
        write (*,*) 'pg_close: non-existent ipage_scan=', ipage_scan
       endif
      endif
      
      return
      end



C************************************************************************
      subroutine init_pg2d(iaxis)
c...	Alternative to pgenv()
c...	Sets the aspect ratio of the paper to approx'ly A4 (8 1/2 X 11 ")
c...	in a landscape shape. Shifts the plot region over to the left,
c...	leaving room on the right for annotations later.
  
      implicit none
      include 'spur_layout.inc'
      include 'spur_color.inc'

c...	passed variables
ccc      integer  lwidth
cCommon      real	xmin,xmax,ymin,ymax
      integer  iaxis
c      logical do_grid

c...	local variables
      real	x1, x2, y1, y2

c         Change the aspect ratio of view graph to that approximating
c         A4 paper in portrait mode (aspect_ratio > 1) or landscape (<1).
c         First parameter is the width in inches. 0 means use widest possible.
cDebug      write (*,*) 'init_pg2d: aspect_ratio=',  aspect_ratio

      call PGSLCT(ipage_lattice)
      call pgpap(0, aspect_ratio)

c	set line width for the screen
c	call pgslw(lwidth)

      call pgscf(1)	!! set character font to normal
      call pgslw(2)	!! set line width in units of 0.005 inch (0.13 mm)

c	****define the window for pgplot
c		!! Shift figure over to the left. note: 0.8*(0.9-0.1) = 0.64
cLandscape        call pgsvp(0.07, 0.65, 0.177, 0.92)		!! landscape
cccc	aspect_ratio = ps_height/ ps_width
	if (aspect_ratio .gt. 1.0) then
	   portrait = .true.
cDebug           write (*,*) 'init_pg2d: Portrait'
	else
	   portrait = .false.
cDebug	   write (*,*) 'init_pg2d: landscape' 
	endif
	
cDebug      call pgsci(color_blue)
cDebug      call pgsvp(0.0, 1.0, 0.0, 1.0)
cDebug      call pgbox('bc',0.0,0,'bc',0.0,0)
cDebug      call pgsci(color_ink)

	width_plot = 0.65
	margin_plot = 0.075
	if (portrait) then
	  xmin_plot = margin_plot
	  xmax_plot = xmin_plot + width_plot
	  ymax_plot = (1.0 - margin_plot)
	  ymin_plot = ymax_plot - width_plot/aspect_ratio
	else
	  xmin_plot = margin_plot
	  xmax_plot = xmin_plot + width_plot*aspect_ratio
	  ymax_plot = (1.0 - margin_plot)
	  ymin_plot = ymax_plot - width_plot
	endif

cDebug        write (*,*) 'init_pg2d: Using portrait = ', portrait
cDebug        write (*,*) 'init_pg2d: pre-pgsvp',
cDebug     &	  xmin_plot, xmax_plot, ymin_plot, ymax_plot
        call pgsvp( xmin_plot, xmax_plot, ymin_plot, ymax_plot)

c	!! set window and adjust viewport to same aspect ratio
	call pgwnad(xmin,xmax,ymin,ymax)

	call  PGQVP (0, X1, X2, Y1, Y2)

c move this window up so title is always in approxly the same place.
c...	Turns out to be a bad idea. if very rectangular area,
c	Not enough room for the labels
	xmin_new = x1
	xmax_new = x2
	ymin_new = y1 
	ymax_new = y2
	goto 444
ccc	call pgsvp(x1, x2, (0.92 - (y2-y1)) ,0.92)

cDebug        write (*,*) 'init_pg2d: pre-pgsvp',
cDebug     &	 x1, x2, ((1.0-margin_plot) - (y2-y1)), (1.0-margin_plot)
	call pgsvp(x1, x2, ((1.0-margin_plot) - (y2-y1)), (1.0-margin_plot))
c        write (*,*) 'init_pg2d: viewport for plot',
c     &	  	xmin_plot, xmax_plot, ymin_plot, ymax_plot
	xmin_new = x1
	xmax_new = x2
	ymin_new = ((1.0-margin_plot) - (y2-y1)) 
	ymax_new = (1.0-margin_plot)
 444    continue

	call pgswin(xmin,xmax,ymin,ymax)
 
        xmin_label = xmax_plot + (0.75*margin_plot)
c02Mar        xmin_label = xmax_new + (0.25*margin_plot)
        xmax_label = 1.0 - margin_plot
        ymin_label = margin_plot
        ymax_label = ymax_plot
c02Mar        ymax_label = ymax_new

        xmin_annote = margin_plot
        xmax_annote = xmax_plot + (0.75*margin_plot)
c02Mar        xmax_annote = xmax_new
	ymin_annote = margin_plot
	ymax_annote = ymin_plot*(0.85)

c        xmin_label = xmax_new + (0.25*margin_plot)
c        xmax_label = 1 - margin_plot
c        ymin_label = ymin_plot*(0.85)
c        ymax_label = ymax_new
c
c        xmin_annote = margin_plot
c        xmax_annote = xmax_label
c	ymin_annote = margin_plot
c	ymax_annote = ymin_plot*(0.85)
c
cDebug        write (*,*) 'init_pg2d: viewport for plot',
cDebug     &	  	xmin_plot, xmax_plot, ymin_plot, ymax_plot
cDebug        write (*,*) 'init_pg2d: re-arranged viewport for plot',
cDebug     &	  	xmin_new, xmax_new, ymin_new, ymax_new
cDebug        write (*,*) 'init_pg2d: viewport for annotations',
cDebug     &		xmin_annote, xmax_annote, ymin_annote, ymax_annote
cDebug        write (*,*) 'init_pg2d: viewport for labels',
cDebug     &		xmin_label, xmax_label, ymin_label, ymax_label


c	call  PGQVP (0, X1, X2, Y1, Y2)
c	write (*,*) 'init_pgcontour: view ', X1, X2, Y1, Y2


c     IAXIS = -2 : draw no box, axes or labels;
c     IAXIS = -1 : draw box only;
c     IAXIS =  0 : draw box and label it with coordinates;
c     IAXIS =  1 : same as AXIS=0, but also draw the
c                  coordinate axes (X=0, Y=0);
c     IAXIS =  2 : same as AXIS=1, but also draw grid lines
c                  at major increments of the coordinates;
c     IAXIS = 10 : draw box and label X-axis logarithmically;
c     IAXIS = 20 : draw box and label Y-axis logarithmically;
c     IAXIS = 30 : draw box and label both axes logarithmically.
	if      (iaxis .eq. -2) then	
	  call pgbox('abcnts',0.0,0,'abcnts',0.0,0)
	else if (iaxis .eq. -1) then	
	  call pgbox('bc',0.0,0,'bc',0.0,0)
	else if (iaxis .eq. 0) then	
	  call pgbox('bcnts',0.0,0,'bcnts',0.0,0)
	else if (iaxis .eq. 1) then	
	  call pgbox('abcnts',0.0,0,'abcnts',0.0,0)
	else if (iaxis .eq. 2) then	
	  call pgbox('abcgnts',0.0,0,'abcgnts',0.0,0)
	else if (iaxis .eq. 10) then			!! x log scale
	  call pgbox('abcnts',0.0,0,'abcnts',0.0,0)
	else if (iaxis .eq. 10) then			!! x log scale
	  call pgbox('abclnts',0.0,0,'abcnts',0.0,0)
	else if (iaxis .eq. 20) then			!! y log scale
	  call pgbox('abcnts',0.0,0,'abclnts',0.0,0)
	else if (iaxis .eq. 30) then			!! x and y log scale
	  call pgbox('abclnts',0.0,0,'abclnts',0.0,0)
	endif 

      return
      end


C************************************************************************
      subroutine plot_txtinfo(thistext, this_many)
cMoved     &      , version_stamp, do_stamp)

      implicit none
      include 'spur_color.inc'
      include 'spur_layout.inc'
      include 'io_files.inc'
      
c... common blocks
      real		yhere, yoff, xhere, y_sofar
      common/cb_xyprint/ yhere, yoff, xhere, y_sofar

c...	passed variables
      character*80 thistext(*)
      integer	this_many
cMoved      character*(80) version_stamp
cMoved      logical do_stamp
      
      integer		i
cMoved	integer       nuser
c      integer		nnow
      real		xch, ych, ytop
c      character*80 	text
c      character*20	nowstring
cMoved      character*20	userstring
      character*80	aline

      call pgsci(color_ink)	!! Make sure we use black ink 

cChanges      call PGQCS(0, XCH, YCH)
cChanges       yoff = 1.5* YCH

      call pgsvp( xmin_annote, xmax_annote, ymin_annote, ymax_annote)
cDebug      call pgbox('bc',0.0,0,'bc',0.0,0)
      ytop = ((ymax_annote-ymin_annote)/(xmax_annote- xmin_annote))
      ytop = ytop *aspect_ratio
      call pgswin( 0.0, 1.0, 0.0, ytop)	!! make commensurate

      call PGSCH (0.55)		!! Shrink the lettering.
      yhere = ytop
c      yhere = 1.0
      xhere = 0.0
      y_sofar = yhere 
      call PGQCS(0, XCH, YCH)		!! normalized device units
      call PGQCS(4, XCH, YCH)		!! world units
      yoff = 1.5*ych
c      yoff=yoff*(1./(ymax_annote-ymin_annote))*(xmax_annote/ymax_annote)
cWorld      yoff=yoff*(1./(ymax_annote-ymin_annote))*(xmax_annote/ymax_annote)
ccc      yoff = 3.0* YCH
ccc      yoff = 1.75* YCH
c      yoff = 1.5* YCH
      ystamp = 0.05


cDebug      write (*,*) 'plot_txtinfo: ystamp ',  ystamp
      yhere = yhere - yoff
      aline =  FILE_BUFIN(1:35)//'  '//FILE_LPI(1:35)     
      call pgtext(xhere, yhere, aline)

      do i=1, this_many
cDebug        write (*,*) 'plot_txtinfo: ', i, xhere, yhere
        yhere = yhere - yoff
         if (yhere .gt. ystamp) then
c	  if (portrait) then
	    call pgtext(xhere, yhere, thistext(i))
c	    call ('LV', -0.25, yhere, 0.0, thistext(i))
c	  else
c	    call pgmtext('RV', 2.0, yhere, 0.0, thistext(i))
c	  endif
	 endif
      enddo


      call  PGSCH (1.0)		!! Restore the lettering. and plot region
      call PGQCS(0, XCH, YCH)
        call pgsvp( xmin_plot, xmax_plot, ymin_plot, ymax_plot)
	call pgwnad(xmin,xmax,ymin,ymax)
      call pgsvp( xmin_new, xmax_new, ymin_new, ymax_new)

      return
      end

C************************************************************************
      subroutine plot_stamp(version_stamp)

      implicit none
      include 'spur_color.inc'
      include 'spur_layout.inc'
      include 'spur_warn.inc'
      
c... common blocks
      real		yhere, yoff, xhere, y_sofar
      common/cb_xyprint/ yhere, yoff, xhere, y_sofar

c...	passed variables
      character*(80) version_stamp
      
      integer		nuser
c      integer		nnow
      real		xch, ych, ytop
c      character*80 	text
c      character*20	nowstring
      character*20	userstring

      call pgsvp( xmin_annote, xmax_annote, ymin_annote, ymax_annote)
      ytop = ((ymax_annote-ymin_annote)/(xmax_annote- xmin_annote))
      ytop = ytop *aspect_ratio
      call pgswin( 0.0, 1.0, 0.0, ytop)	!! make commensurate
c02Mar14      call pgsci(color_blue)
c02Mar14       call pgbox('bc',0.0,0,'bc',0.0,0)

      call pgsci(color_ink)	!! Make sure we use black ink 
      call PGSCH (0.55)		!! Shrink the lettering.
c      call PGSCH (0.5)		!! Shrink the lettering.
      call PGQCS(0, XCH, YCH)
ccc      yoff = 1.5* YCH
      yoff = 1.5*ych
c      yoff=yoff*(1./(ymax_annote-ymin_annote))*(xmax_annote/ymax_annote)
ccc      yoff = 1.5* YCH

      ystamp = 0.05

cChanges      write (*,*) 'plot_txtinfo: portrait=', portrait 
cChanges
cChanges      if (portrait) then
cChangesc        ystamp =  -1.0*(1.0 - 1.0/aspect_ratio) + margin_plot
cChanges        ystamp =  -2.0*(1.0 - 1.0/aspect_ratio)
cChanges      else
cChangesc        ystamp =  1.0*margin_plot
cChanges        ystamp =  -2.0*margin_plot
cChanges      endif

cChanges      write (*,*) 'plot_txtinfo: ystamp ',  ystamp
      

c      call pgqinf('NOW', nowstring, nnow)
        call pgqinf('USER', userstring, nuser)

        yhere = ystamp

        call pgmtext('RV', -0.1, yhere, 1.0, userstring(1:nuser))

        call pgmtext('LV', -0.1, yhere, 0.0,  version_stamp)

      call  PGSCH (1.0)		!! Restore the lettering.

      if (warn_options .ne. 0) then	!! Print warning in big red letters
        yhere = ystamp + 4.0*yoff
        call pgsci(color_red)	
	call pgmtext('LV', -0.1, yhere, 0.0, warnstring)
        call pgsci(color_ink)	
        yhere = ystamp
      endif


      call PGQCS(0, XCH, YCH)
        call pgsvp( xmin_plot, xmax_plot, ymin_plot, ymax_plot)
	call pgwnad(xmin,xmax,ymin,ymax)
      call pgsvp( xmin_new, xmax_new, ymin_new, ymax_new)

      return
      end

C************************************************************************
      subroutine plot_labelinfo(arrin, nunique, uniqueLabel, 
     &      indxunique1, indxunique2, multiplicity,
     &	    pointsize, circsize, overridesize, rainbow)

      implicit none
      include 'arraysize.inc'
      include 'spur_color.inc'
      include 'spur_layout.inc'

c..	functions
      integer select_color      
      
c... common blocks
c      real		yhere, yoff, xhere, y_sofar
c      common/cb_xyprint/ yhere, yoff, xhere, y_sofar
      integer ntiny, nabsent, npresent, nobserved
      common /nabsences/ ntiny, nabsent, npresent, nobserved

c...	passed variables
      real arrin(m_rlv_max,m_rlv_max)
      integer nunique
      character*1 uniqueLabel(m_rlv_max,m_rlv_max)
      integer indxunique1(unique_rlv_max)
      integer indxunique2(unique_rlv_max)
      integer multiplicity(unique_rlv_max)
c      integer indxunique1(0:unique_rlv_max)
c      integer indxunique2(0:unique_rlv_max)
c      integer multiplicity(0:unique_rlv_max)
      logical overridesize, rainbow
      real circsize
      real pointsize(m_rlv_max,m_rlv_max)

c...	local variables
      integer	i, this_color
      real	xch, ych, yyhere, xxhere, yyoff, yy_sofar, yystamp
      character*40 astring
      real	yytop, arrin_max

      integer fill_solid	!!, fill_hollow
      parameter (fill_solid = 1)
c      parameter (fill_hollow = 2)

      call pgsvp( xmin_label, xmax_label, ymin_label, ymax_label)
      yytop = ((ymax_label-ymin_label)/(xmax_label- xmin_label))
      yytop = yytop *aspect_ratio
      call pgswin( 0.0, 1.0, 0.0, yytop)	!! make commensurate
c      call pgswin( 0.0, 1.0, 0.0, 1.0) 	!! make the world units be normalized   
c02Mar14      call pgsci(color_blue)
c02Mar14      call pgbox('bc',0.0,0,'bc',0.0,0)
      call pgsci(color_ink)

c      call pgsci(color_ink)	!! Make sure we use black ink 
c      call PGSCH (1.0)		!! Shrink the lettering.
      call PGSCH (0.5)		!! Shrink the lettering.

        yyhere = yytop
c        yyhere = 1.0
        yy_sofar = yyhere
        call PGQCS(4, XCH, YCH)
      yyoff = 1.5*ych
cv        call PGQCS(0, XCH, YCH)
cv      yyoff = 3.0*ych
cv      yyoff=yyoff*(1.0/(ymax_label- ymin_label))*(xmax_label/ymax_label)
c        yyoff = 1.5* YCH
ccc        yyoff = 3.0* YCH
c        yyoff = 1.75* YCH
        yystamp = yyoff
        xxhere = yyoff/2.0

c...	Write highest value and then list the normalized values after a blank line
      yyhere = yyhere - yyoff
      do i=1, nunique
        if (uniqueLabel(indxunique1(i), indxunique2(i)) .ne. '#') then
         yyhere = yyhere - yyoff
         if (yyhere .ge. yystamp) then
           this_color = select_color(
     &		 pointsize(indxunique1(i), indxunique2(i)) )
c           call select_color(
c     &		 pointsize(indxunique1(i), indxunique2(i)) )
           call place_circle(xxhere, yyhere, 
     &		 pointsize(indxunique1(i), indxunique2(i)), 0.5*ych,  
     &      		 fill_solid, overridesize)
c           call place_circle(xxhere, yyhere, 
c     &		 pointsize(indxunique1(i), indxunique2(i)), ych/2.0,  
c     &      		 fill_solid, overridesize)
cDebug	    write (*,*) 'plot_labelinfo: placing circle',
cDebug     &	    pointsize(indxunique1(i), indxunique2(i)) 
	 else
	    write (*,*) 'plot_labelinfo: skipping circle', 
     &	    pointsize(indxunique1(i), indxunique2(i)) 
     	 endif

	endif
      enddo


      yyhere = yytop
      xxhere = yyoff*2.0
cViewport      yyhere = 1.0		!! pgmtext is in viewport normalized units
      call pgsci(color_ink)	!! Make sure we use black ink 
      i = 1
      arrin_max = arrin(indxunique1(i), indxunique2(i))
      write (astring, 110) 
     &		uniqueLabel(indxunique1(i), indxunique2(i)),
     &		arrin(indxunique1(i), indxunique2(i)),
     &		multiplicity(i)
         if (yyhere .ge. yystamp) then
	    call pgtext(xxhere, yyhere, astring)
cViewport	    call pgmtext('LV', -1.0, yyhere, 0.0, astring)
c	    call pgmtext('RV', 1.0, yyhere, 0.0, astring)
cDebug	    write (*,*) 'plot_labelinfo: placing ', astring
	 else
	    write (*,*) 'plot_labelinfo: skipping ', astring
	 endif

      yyhere = yyhere - yyoff
      do i=1, nunique
        if (uniqueLabel(indxunique1(i), indxunique2(i)) .ne. '#') then
         yyhere = yyhere - yyoff
	 write (astring, 110) 
     &		uniqueLabel(indxunique1(i), indxunique2(i)),
     &		(arrin(indxunique1(i), indxunique2(i)) /arrin_max),
     &		multiplicity(i)
c02Mar	 write (astring, 110) 
c02Mar     &		uniqueLabel(indxunique1(i), indxunique2(i)),
c02Mar     &		pointsize(indxunique1(i), indxunique2(i)),
c02Marccc     &		arrin(indxunique1(i), indxunique2(i)),
c02Mar     &		multiplicity(i)
110      format(a1, 1x, g10.3, 1x, 'm=', i3)

         if (yyhere .ge. yystamp) then
	    call pgtext(xxhere, yyhere, astring)
cViewport	    call pgmtext('LV', -1.0, yyhere, 0.0, astring)
c	    call pgmtext('RV', 1.0, yyhere, 0.0, astring)
cDebug	    write (*,*) 'plot_labelinfo: placing ', astring
	 else
	    write (*,*) 'plot_labelinfo: skipping ', astring
	 endif
	endif
	if (uniqueLabel(indxunique1(i), indxunique2(i)) .eq. '-') then
	  write (*,*) 'plot_labelinfo: Hey Programmer! Sort is messed up!'
	endif
      enddo

      if (multiplicity(unique_rlv_max) .gt. 0) then
        yyhere = yyhere - yyoff
        if (yyhere .ge. yystamp) then
	  write (astring, *) '# of Absences= ', multiplicity(unique_rlv_max)
	  call pgtext(xxhere, yyhere, astring)
cViewport	  call pgmtext('LV', -2.0, yyhere, 0.0, astring)
cc	  call pgmtext('RV', 2.0, yyhere, 0.0, astring)
	else
	    write (*,*) 'plot_labelinfo: skipping ', astring
	endif
      endif

        yyhere = yyhere - yyoff
        if (yyhere .ge. yystamp) then
	  write (astring, *) '# observed= ', nobserved
	  call pgtext(xxhere, yyhere, astring)
	else
	    write (*,*) 'plot_labelinfo: skipping ', astring
	endif

      call  PGSCH (1.0)		!! Restore the lettering.
      call PGQCS(0, XCH, YCH)
        call pgsvp( xmin_plot, xmax_plot, ymin_plot, ymax_plot)
	call pgwnad(xmin,xmax,ymin,ymax)
      call pgsvp( xmin_new, xmax_new, ymin_new, ymax_new)

      return
      end

c===========================================================================
      subroutine cycle_color(icolor, base)
c...	Cycle color. 
c...	Base=3 use ink, and 2 greys.
c...	base = 15 use the PGPLOT standard colors except for ink_bkgr.
      implicit none
      include 'spur_color.inc'
      
      integer icolor, base

      if (base .eq. 3) then
	if      (mod(icolor, base) .eq. 0) then
	  call pgsci(color_ink)
	else if (mod(icolor, base) .eq. 1) then
	  call pgsci(color_darkgrey)
	else if (mod(icolor, base) .eq. 2) then
	  call pgsci(color_lightgrey)
	endif
	icolor = icolor + 1
      else if (base .eq. 15) then
	if      (mod(icolor, base) .eq. 0) then
	  call pgsci(mod((icolor+1), base))
	else if (mod(icolor, base) .eq. 1) then
	  call pgsci(mod((icolor+1), base))
	else if (mod(icolor, base) .eq. 2) then
	  call pgsci(mod((icolor+1), base))
	endif
	icolor = icolor + 1
      else
        write (*,*) 'cycle_color: Only base=3 and 15 allowed ',
     &	'presently. base=', base
      endif
      
      return
      end

c===========================================================================
c      subroutine sketch_layout()
c
c      implicit none
c      include 'arraysize.inc'
c      include 'spur_color.inc'
c      include 'spur_layout.inc'
c      
c
c      call pgsci(color_ink)  ! opposite to BG colour
c      call pgrect (xmin,xmax,ymin,ymax)
c      
c      return
c      end

c===========================================================================

      integer function cycle_marker(inum, ibase)
c...	Cycle marker code, using PGPLOT marker symbols.

      implicit none
c...	passed variables      
      integer inum, ibase
      
c...	local variables
      integer i, base

      if (ibase .le. 0)  then
c	Always return a square for stupid values.      
        cycle_marker = 0	!! square
	return
      else
        if (ibase .gt. 15) then 
          base = 15
        else      
          base = ibase
        endif
      endif
      
      i = mod(inum, base)
      if      (i .eq. 0) then
        cycle_marker = 0	!! square
      else if (i .eq. 1) then
        cycle_marker = 2	!! cross
      else if (i .eq. 2) then
        cycle_marker = 3	!! *
      else if (i .eq. 3) then
        cycle_marker = 4	!! circle
      else if (i .eq. 4) then
        cycle_marker = 5	!! x
      else if (i .eq. 5) then
        cycle_marker = 7	!! triangle
      else if (i .eq. 6) then
        cycle_marker = 10	!! squashed square
      else if (i .eq. 7) then
        cycle_marker = 11	!! diamnond
      else if (i .eq. 8) then
        cycle_marker = 12	!! star
      else if (i .eq. 9) then
        cycle_marker = 13	!! filled triangle
      else if (i .eq. 10) then
        cycle_marker = 14	!! open cross
      else if (i .eq. 11) then
        cycle_marker = 15	!! star of david
      else if (i .eq. 12) then
        cycle_marker = 16	!! filled square
      else if (i .eq. 13) then
        cycle_marker = 17	!! filled circle
      else if (i .eq. 14) then
        cycle_marker = 18	!! filled star
      end if 

cDangerous	write (*,*) 'cycle_marker: ',  inum, base, cycle_marker
      return
      end


c===========================================================================

      integer function cycle_linestyle(inum, usesolid)
c...	Cycle marker code, using PGPLOT marker symbols.
c SUBROUTINE PGSLS (LS)
c      INTEGER  LS
c
c Set the line style attribute for subsequent plotting. This
c attribute affects line primitives only; it does not affect graph
c markers, text, or area fill.
c Five different line styles are available, with the following codes:
c 1 (full line), 2 (dashed), 3 (dot-dash-dot-dash), 4 (dotted),
c 5 (dash-dot-dot-dot). The default is 1 (normal full line).

      implicit none
c...	passed variables      
      integer inum
      logical usesolid
      
c...	local variables
      integer base

      if (usesolid) then
        base = 5
        cycle_linestyle = mod(inum-1, base) + 1	!! returns 1 - 5
      else
        base = 4
        cycle_linestyle = mod(inum-1, base) + 2	!! returns 2 - 5
      endif

      return
      end


	
