csubroutnie plotstyle *******************************************************************
	subroutine arspltstyle(dev,gopt,opt,mxvar,red,green,blue,pen,colline,
     *       coltext,colbox,mnxtic,mnytic,mnztic,symbol,colsym,
     *       mxxtic,mxytic,mxztic,xhigh,xlow,yhigh,ylow,
     *       zhigh,zlow,bg)             
c
c	sets up variables for passing to plplot routines that govern color and 
c	line style changes to plots and all sorts of bells and whistles -pjk
c
	integer*4 gopt,opt,mxvar
	integer*4 red,green,blue,pen(mxvar),colline(mxvar),coltext,colbox
	integer*4 mnxtic,mnytic,mnztic,symbol(mxvar),colsym(mxvar)
	real*4 mxxtic,mxytic,mxztic,xhigh,xlow,yhigh,ylow,zhigh,zlow
       character*8 dev
       logical bg
c local
	integer*4 tmp
c
c begin subroutine
	if((gopt.gt.1.and.gopt.le.5).or.(gopt.eq.21))then
c	  open(unit=*,file='plotstylewindow',access='window,290,522,26,388')
	  write(*,'(/13x,''color table ______________________________________________'')')
	  write(*,'(13x,''white(0) red(1)  yellow(2)  green(3)  aquamarine(4) pink(5) '')')
	  write(*,'(13x,''wheat(6)  grey(7)  browm(8)  blue(9)  blueviolet(10)'')')
	  write(*,'(13x,''cyan(11)  turquoise(12)  magenta(13)  salmon(14)  black(15)'')')
	  write(*,'(13x,''___________________________________________________________'',/)')
	else if(gopt.eq.1)then
c	  open(unit=*,file='plotstylewindow',access='window,290,522,26,388')
	  write(*,'(/13x,''color table (background only) ____________________________'')')
	  write(*,'(13x,''black(0) white(1)  user defined (2)'')')
	  write(*,'(13x,''___________________________________________________________'',/)')
	else if(gopt.ge.6.and.gopt.le.21)then
c	  open(unit=*,file='plotstylewindow',access='window,290,522,26,388')
	endif  
	select case (gopt)
	   case(1)
	      write(*,'(/13x,''select new background color [0/1/2] : '',$)')
	      read(*,*)tmp
	      if(tmp.eq.0)then
	        red=0
	        blue=0
	        green=0
	        bg=.true.
	      elseif(tmp.eq.1)then
	        red=255
	        green=255
	        blue=255
	        bg=.false.
	      elseif(tmp.eq.2)then
	        write(*,'(13x,''enter red value [0-255] > '',$)')
	        read(*,*)red
	        write(*,'(13x,''enter green value [0-255] > '',$)')
	        read(*,*)green
	        write(*,'(13x,''enter blue value [0-255] > '',$)')
	        read(*,*)blue
	        bg=.false.
	      endif
c	      close(winu2)
	      return
	   case(2)
	      write(*,'(13x,''select new frame color [0-15] : '',$)')
	      read(*,*)colbox
c	      close(winu2)
	      return
	   case(3)
	      write(*,'(/13x,''select new text color: [0-15] : '',$)')
	      read(*,*)coltext
c	      close(winu2)
	      return
	   case(4)
	      write(*,'(13x,''select new line color: [0-15] : '',$)')
	      read(*,'(i4)')colline(1)
c	      close(winu2)
	      return
	   case(5)
	      write(*,'(13x,''select new curve color: [0-15] : '',$)')
	      read(*,'(i4)')colline(2)
c	      close(winu2)
	      return
	   case(6)
	      write(*,'(/13x,''select new line style: [0-8] : '',$)')
	      read(*,'(i4)')pen(1)
c	      close(winu2)
	      return
	   case(7)
	      write(*,'(/13x,''select new curve width: [0-8]  : '',$)')
	      read(*,'(i4)')pen(2)
c	      close(winu2)
	      return
	   case(8)
	      write(*,'(/13x,''change x axis major tics from: '',f6.0)')mxxtic
	      write(*,'(13x,''to > '',$)')
	      read(*,*)mxxtic
c	      close(winu2)
	      return
	   case(9)
	      write(*,'(/13x,''change x axis minor tics from: '',i4)')mnxtic
	      write(*,'(13x,''to > '',$)')
	      read(*,*)mnxtic
c	      close(winu2)
	      return
	   case(10)
	      write(*,'(/13x,''change y axis major tics from: '',f6.0)')mxytic
	      write(*,'(13x,''to > '',$)')
	      read(*,*)mxytic
c	      close(winu2)
	      return
	   case(11)
	      write(*,'(/13x,''change y axis minor tics from: '',i4)')mnytic
	      write(*,'(13x,''to > '',$)')
	      read(*,'(i4)')mnytic
c	      close(winu2)
	      return
	   case(12)
	      write(*,'(/13x,''change z axis major tics from: '',f6.0)')mxztic
	      write(*,'(13x,''to > '',$)')
	      read(*,*)mxztic
c	      close(winu2)
	      return
	   case(13)
	      write(*,'(/13x,''change z axis minor tics from: '',i4)')mnztic
	      write(*,'(13x,''to > '',$)')
	      read(*,'(i4)')mnztic
c	      close(winu2)
	      return
	   case(14)
	      write(*,'(/13x,''change x axis max value from: '',f8.3)')xhigh
	      write(*,'(13x,''to > '',$)')
	      read(*,*)xhigh
c	      close(winu2)
	      return
	   case(15)
	      write(*,'(/13x,''change x axis min value from: '',f8.3)')xlow
	      write(*,'(13x,''to > '',$)')
	      read(*,*)xlow
c	      close(winu2)
	      return
	   case(16)
	      write(*,'(/13x,''change y axis max value from: '',f8.3)')yhigh
	      write(*,'(13x,''to > '',$)')
	      read(*,*)yhigh
c	      close(winu2)
	      return
	   case(17)
	      write(*,'(/13x,''change y axis min value from: '',f8.3)')ylow
	      write(*,'(13x,''to > '',$)')
	      read(*,*)ylow
c	      close(winu2)
	      return
	   case(18)
	      write(*,'(/13x,''change z axis max value from: '',f8.3)')zhigh
	      write(*,'(13x,''to > '',$)')
	      read(*,*)zhigh
c	      close(winu2)
	      return
	   case(19)
	      write(*,'(/13x,''change z axis min value from: '',f8.3)')zlow
	      write(*,'(13x,''to > '',$)')
	      read(*,*)zlow
c	      close(winu2)
	      return
	   case(20)
	      write(*,'(/13x,''change symbol [0-126, 32 = no symbol]: '',i4)')symbol(1)
	      write(*,'(13x,''to > '',$)')
	      read(*,*)symbol(1)
c	      close(winu2)
	      return
	   case(21)
	      write(*,'(/13x,''change symbol color from: '',i4)')colsym(1)
	      write(*,'(13x,''to > '',$)')
	      read(*,*)colsym(1)
c	      close(winu2)
	      return
	   case(99)     !reset all options
	      red=255
	      blue=255
	      green=255
	      coltext=15
	      colbox=15
	      pen(1)=1
	      pen(2)=2
	      colsym(1)=9
	      symbol(1)=20
	      colline(1)=15
	      colline(2)=1
	      colline(3)=9
	      dev='xwin'
	      bg=.false.
	end select   
100	return
	end
c************************************************************************
c modified 12/06 to use routine scale for extra large x,y,z spans -pjk
	subroutine ticit(xlow,xhigh,ylow,yhigh,zlow,zhigh,mnxtic,mnytic,mnztic,
     *                    mxxtic,mxytic,mxztic)
c
c argument declarations
	integer mnxtic,mnytic,mnztic
	real*4 xlow,xhigh,ylow,yhigh,zlow,zhigh,mxxtic,mxytic,mxztic
c local
	integer span,ifault
	real*4 yt1,thigh,tlow
c
c begin subroutine to define the major and minor tic mark intervals for plotting
c
	span=(xhigh-xlow)
c
c  set major and minor ticks depending on x, y and z range (span)
c xaxis scales
	if(span.le.50)then
	  mxxtic=10.0
	  mnxtic=10
	elseif(span.gt.50.and.span.le.100)then
	  mxxtic=20
	  mnxtic=5
	elseif((span.le.200.0).and.(span.gt.100))then
	  mxxtic=20.0
	  mnxtic=10
	else if(span.le.500.0.and.span.gt.200.0)then
 	  mxxtic=50.0
	  mnxtic=5
	else if(span.le.1000.0.and.span.gt.500.0)then
	  mxxtic=100.0
	  mnxtic=10
	else if(span.le.2000.0.and.span.gt.1000)then
	  mxxtic=250.0
	  mnxtic=5
	elseif(span.gt.2000)then
c determine optimum x scale axis parameters
	  call scale(xlow, xhigh, 10, tlow, mxxtic, thigh, ifault)
	  xlow=tlow;xhigh=thigh
	  mnxtic=5
	end if
c yaxis scales
c 	round yhigh up or down depending on scale
	if(yhigh.lt.10)then
	   yt1=amod(yhigh,1.0)
	   if(yt1.le.0.5)then
	    yhigh=yhigh+(0.5-yt1)	
	   else
	    yhigh=yhigh+((1.0-yt1))
	   endif	
	elseif((yhigh.ge.10).and.(yhigh.lt.100))then
	   yt1=amod(yhigh,10.0)
	   if(yt1.le.5.0)then
	     yhigh=yhigh+(5.0-yt1)	
	   else
	     yhigh=yhigh+((10.0-yt1))
	   endif
	elseif(yhigh.ge.100)then
	   yt1=amod(yhigh,100.0)
	   if(yt1.le.50.0)then
	     yhigh=yhigh+(50.0-yt1)	
	   else
	     yhigh=yhigh+((100.0-yt1))
	   endif
	endif
c
	if(ylow.ge.0)then
	   span=yhigh-ylow
	else
	   span=yhigh+abs(ylow)
	endif
c
	if(span.le.2.0)then
	  mxytic=0.5
	  mnytic=4
	else if(span.gt.2.0.and.span.le.4.0)then
	  mxytic=1.0
	  mnytic=4
	else if(span.gt.4.0.and.span.le.10.0)then
	  mxytic=2.0
	  mnytic=4
	else if(span.gt.10.0.and.span.le.50.0)then
	  mxytic=5.0
	  mnytic=5
	else if(span.gt.50.and.span.le.100.0)then
	  mxytic=10.0
	  mnytic=2
	else if(span.gt.100.and.span.le.500)then
	  mxytic=100.0
	  mnytic=5
	else if(span.gt.500)then
c determine optimum x scale axis parameters
	  call scale(ylow, yhigh, 10, tlow, mxytic, thigh, ifault)
	  ylow=tlow;yhigh=thigh
	  mnxtic=5
	end if
c
c zaxis scales
c 	round zhigh up or down depending on scale
	if(zhigh.lt.10)then
	   yt1=amod(zhigh,1.0)
	   if(yt1.le.0.5)then
	    zhigh=zhigh+(0.5-yt1)	
	   else
	    zhigh=zhigh+((1.0-yt1))
	   endif	
	elseif((zhigh.ge.10).and.(zhigh.lt.100))then
	   yt1=amod(zhigh,10.0)
	   if(yt1.le.5.0)then
	     zhigh=zhigh+(5.0-yt1)	
	   else
	     zhigh=zhigh+((10.0-yt1))
	   endif
	elseif(zhigh.ge.100)then
	   yt1=amod(zhigh,100.0)
	   if(yt1.le.50.0)then
	     zhigh=zhigh+(50.0-yt1)	
	   else
	     zhigh=zhigh+((100.0-yt1))
	   endif
	endif
c
	if(zlow.ge.0)then
	   span=zhigh-zlow
	else
	   span=zhigh+abs(zlow)
	endif
c
	if(span.le.2.0)then
	  mxztic=0.5
	  mnztic=4
	else if(span.gt.2.0.and.span.le.4.0)then
	  mxztic=1.0
	  mnztic=4
	else if(span.gt.4.0.and.span.le.10.0)then
	  mxztic=2.0
	  mnztic=4
	else if(span.gt.10.0.and.span.le.50.0)then
	  mxztic=5
	  mnztic=5
	else if(span.gt.50.and.span.le.100.0)then
	  mxztic=10.0
	  mnztic=2
	else if(span.gt.100.and.span.le.500)then
	  mxztic=100.0
	  mnztic=5
	else if(span.gt.500)then
c determine optimum x scale axis parameters
	  call scale(zlow, zhigh, 10, tlow, mxztic, thigh, ifault)
	  zlow=tlow;zhigh=thigh
	  mnztic=5
	end if
	return
	end
c***********************************************************************
      subroutine scale(fmn, fmx, n, valmin, step, valmax, ifault)
c
c     algorithm as 96  appl. statist. (1976) vol.25, no.1
c
c     given extreme values fmn, fmx, and the need for a scale with n
c     marks, calculates value for the lowest scale mark (valmin) and
c     step length (step) and highest scale mark (valmax).
c
      real fmn, fmx, valmin, step, valmax
      integer n, ifault
c
c     units for step lengths
c
      real unit(11)
c
c     local variables
c
      integer nunit, i, j
      real tol, zero, half, one, ten, bias, fmax, fmin, rn, x, s, range
c
c     array length unit()
c
      data nunit /11/
c
c     local constant, defining effective equality of values.
c
      data tol /5.0e-6/
      data zero /0.0/, half /0.5/, one /1.0/, ten /10.0/
      data bias /1.0e-4/
      data unit /1.0, 1.2, 1.6, 2.0, 2.5, 3.0, 4.0, 5.0, 6.0, 8.0,
     *        10.0/
c
      fmax = fmx
      fmin = fmn
      ifault = 1
c
c     test for valid parameter values
c
      if (fmax .lt. fmin .or. n .le. 1) return
      ifault = 0
      rn = n - 1
      x = abs(fmax)
      if (x .eq. zero) x = one
      if ((fmax - fmin) / x .gt. tol) go to 20
c
c     all values effectively equal
c
      if (fmax .lt. zero) then
        fmax = zero
      else if (fmax .eq. zero) then
        fmax = one
      else
        fmin = zero
      end if
c
   20 step = (fmax - fmin) / rn
      s = step
c
c     find power of 10
c
   25 if (s .ge. one) go to 30
      s = s * ten
      go to 25
   30 if (s .lt. ten) go to 35
      s = s / ten
      go to 30
c
c     calculate step
c
   35 x = s - bias
      do 40 i = 1, nunit
        if (x .le. unit(i)) go to 45
   40 continue
   45 step = step * unit(i) / s
      range = step * rn
c
c     make first estimate of valmin
c
      x = half * (one + (fmin + fmax - range) / step)
      j = x - bias
      if (x .lt. zero) j = j - 1
      valmin = step * float(j)
c
c     test if valmin could be zero
c
      if (fmin .ge. zero .and. range .ge. fmax) valmin = zero
      valmax = valmin + range
c
c     test if valmax could be zero
c
      if (fmax .gt. zero .or. range .lt. -fmin) return
      valmax = zero
      valmin = -range
      return
      end
c ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
