c...	file spurion_scan.f
cc==========================================================================
      subroutine plot_scan(constq, ec, es, hc, hs, mon, nscan,
     &	      esparr, pointsize, relcircsize, nspurtot, nelastictot,   
     &     	 nincohmon, nincohana, 
     &		sfhkl, phimax, whichqbuf, version_stamp)
c     , fresh, addspur, addannote)
     
      implicit none
      include 'arraysize.inc'
      include 'io_files.inc'
      include 'spur_color.inc'
      include 'spur_layout.inc'
      include 'spur_scan.inc'
      include 'spur_data.inc'		!! contains data and plotdata
      include 'spur_buf.inc'
      include 'spur_warn.inc'

c...	functions
      logical input_data
cNotUsed      integer ilen
      
cc...	passed variables
      logical constq
      real ec, es
      REAL*4 hc(3), hs(3)
      CHARACTER*5 mon
      integer nscan
      real esparr(n_spur_max,n_spur_max,maxnpts)
      real pointsize(m_rlv_max,m_rlv_max)
      real relcircsize
cInc      integer ispur(n_spur_max*n_spur_max)
cInc      integer jspur(n_spur_max*n_spur_max)
      integer nspurtot, nelastictot,  nincohmon, nincohana
      real sfhkl(m_rlv_max,m_rlv_max)
      real phimax
      character*1 whichqbuf
      character*80 version_stamp
c      logical fresh, addspur, addannote
            
c...	local variables
      logical debugthis
      parameter (debugthis = .false.)
c      parameter (debugthis = .true.)
      integer iwhich
cUnused      integer i
      real def_charsize

c      do i = 1, nspurtot
c        write (*,*) 'pre input_data : ', i, scanpt_spot(i),
c     &		  ispot(i), jspot(i), ispur(i), jspur(i)
c      enddo   
        
      plotdata = input_data(whichqbuf)

      if (debugthis) then
	call PGQID (iwhich)
	write (*,*) 'plot_scan: Current window ID =', iwhich
      endif

      call PGSLCT(ipage_scan)

      if (debugthis) then
	write (*,*) 'plot_scan: PGSLCT(ipage_scan)', ipage_scan
	call PGQID (iwhich)
	write (*,*) 'plot_scan: Current window ID =', iwhich
      endif

      call pgpap(0, aspect_ratio)
      call PGVSTD		!! Set the viewport

c      if (fresh) then
        call plot_scan_intensity(nscan, phimax)	!! Plot scan pt v.s data intensity
c      endif

cDebug      do i = 1, nspurtot
cDebug        write (*,*) 'pre plot_scan_intbragg : ', i, 
cDebug     &	  scanpt_spot(i), ispot(i), jspot(i), ispur(i), jspur(i)
cDebug      enddo     

	call PGQCH (def_charSIZE)
        call pgsch(def_charSIZE*2.0)

c	!! Plot scan pt v.s Bragg intensity at spurions
        call plot_scan_intBragg(nscan, nspurtot, sfhkl)
      
c	!! Plot scan pt v.s fake intensity of elastic spurions
        call plot_scan_intElastic(nscan, nelastictot)
      
c	!! Plot scan pt v.s  fake intensity of Al spurions
        call plot_scan_intAl(nscan)

c	!! Plot scan pt v.s  fake intensity of incoherent spurions from 
c	!! monchrometer and analyser
        call plot_scan_intIncoh(nscan, nincohmon, nincohana)

        call pgsch(def_charSIZE)


c      if (fresh) then
        call plot_scan_qaxis(nscan)		!! Extra axis
c      endif

       call plot_scan_a4(nscan, phimax)		!! Extra axis
      

c      if (fresh) then
        call plot_scan_eaxis(nscan)		!! Extra axis
c      endif

       
c	!! Plot Energy vs. scan # for higher order spurions

cDebug      do i = 1, nspurtot
cDebug        write (*,*) 'pre plot_scan_higherspurions : ', i, 
cDebug     &	  scanpt_spot(i), ispot(i), jspot(i), ispur(i), jspur(i)
cDebug      enddo     

      call plot_scan_higherspurions(nscan, nspurtot, esparr, 
cInc     &      ispur, jspur, 
     &	pointsize, relcircsize)	

cDebug      do i = 1, nspurtot
cDebug        write (*,*) 'pre plot_scan_higherbragg : ', i,
cDebug     &	   scanpt_spot(i), ispot(i), jspot(i), ispur(i), jspur(i)
cDebug      enddo  
         
	call PGQCH (def_charSIZE)
        call pgsch(def_charSIZE*2.0)	!! MAKE MARKERS BIGGER
      call plot_scan_higherbragg(nscan, nspurtot, esparr, 
     &	pointsize, relcircsize)

      call plot_scan_higherelastic(nscan, nelastictot, esparr)
        call pgsch(def_charSIZE)

c      if (addannote) then
        call plot_scan_annotate(version_stamp, nspurtot,nelastictot, 
     &      nincohmon, nincohana)	
c      endif
      
c----------------------------------------------
c...	Flush the graphics buffer before switching to other x-window 
      call pgupdt		!! flush the graphics buffer

      if (debugthis) then
	call PGQID (iwhich)
	write (*,*) 'plot_scan: Current window ID =', iwhich
      endif

      call PGSLCT(ipage_lattice)

      if (debugthis) then
	write (*,*) 'plot_scan: PGSLCT(ipage_lattice)', ipage_lattice
	call PGQID (iwhich)
	write (*,*) 'plot_scan: Current window ID =', iwhich
      endif

c      nscan_bragg = 0

      return
      end

c=============================================================
      subroutine plot_scan_intensity(nscan, phimax)
      implicit none

      include 'arraysize.inc'
      include 'io_files.inc'
      include 'spur_color.inc'
      include 'spur_layout.inc'
      include 'spur_scan.inc'
      include 'spur_data.inc'		!! contains data and plotdata
      include 'spur_buf.inc'
      include 'spur_warn.inc'

c...	passed variables
      integer nscan
      real	phimax
      
c...	local variables
      real temp1, temp2
      character*80 x_label, y_label
      integer k, i
      real 	x_xaxis(2), y_xaxis(2)
      
      x_label = 'scan point #'
      y_label = 'Intensity [Counts] '
 
      xscan_max = nscan
      xscan_min = 1
      do k = 1, nscan
        xscan(k) = float(k)
        if (plotdata) then
         yscan(k) = float(cnts_data(k))
	else
	 yscan(k) = 1.0
	endif
	 if (k .eq. 1) then
	   yscan_max = yscan(k)
	   yscan_min = yscan(k)
	 else
	   if (yscan(k) .gt. yscan_max) yscan_max = yscan(k)
	   if (yscan(k) .lt. yscan_min) yscan_min = yscan(k)
	 endif
      enddo      

      if (.not. plotdata) then
        yscan_peak = 1.0
      	yscan_max = 1.2
c	yscan_min = 0.0
	yscan_min = -0.35
c	yscan_min = -0.25
      else
c	Plump up the limits by error bars, plus a bit.
        yscan_peak = yscan_max
	yscan_max = yscan_max + sqrt(yscan_max)
	yscan_min = yscan_min - sqrt(yscan_min)
        yscan_max = yscan_max + 0.1*(yscan_max - yscan_min)
c        if (yscan_min .lt. 0.1*(yscan_max - yscan_min) ) then
c      	  yscan_min = 0.0
c        endif
	yscan_min = -0.35 * yscan_peak
c	yscan_min = -0.25 * yscan_peak
      endif

      xscan_max = nscan 
      xscan_min = 1

c----------------------------------------------
c...	Plot the counts in data  vs. scan point #.
        call PGSVP(vxmin_sc_cnts,vxmax_sc_cnts,
     &		      vymin_sc_cnts,vymax_sc_cnts)

      if (auto_xmin_sc)  then 
        xmin_sc = Xscan_MIN
      endif
      if (auto_xmax_sc)  then 
        xmax_sc = Xscan_Max
      endif
        ymin_sc_cnts = yscan_MIN
        ymax_sc_cnts= yscan_Max

c...	Selectplot range
        call PGSWIN (xmin_sc, xmax_sc,  ymin_sc_cnts, ymax_sc_cnts)

c...	Make the regions which have inaccessible angle A4 grey
	call pgsci(color_lightgrey)
	do k = 1, nscan
c	  if (angle4_store(k) .gt. phimax) then
	  if (.not. A4_OK(k)) then
	     temp1 = float(k) - 0.5
	     temp2 = float(k) + 0.5
            call PGRECT (temp1, temp2, ymin_sc_cnts, ymax_sc_cnts)  
cDebug	    write (*,*) 'plot_scan_intensity:gray box at k=', k
cDebug	    write (*,*) 'plot_scan_intensity:', 
cDebug     &	    	temp1, temp2, ymin_sc_cnts, ymax_sc_cnts
	  endif 
	enddo

c...	Draw axes box and number labels
	call pgsci(color_ink)
        call pgbox ('BCNST', 0, 0, 'BCNST', 0, 0)

c...	Make x-axes 
	x_xaxis(1) = xmin_sc
	x_xaxis(2) = xmax_sc
	y_xaxis(1) = 0.0
	y_xaxis(2) = 0.0

c	 write (*,*) 'plot_scan_intensity: xaxis =', 
c     &		 (x_xaxis(i), y_xaxis(i), i =1, 2)
	call pgsci(color_blue)
	call PGSLS (2)		!! Dashed line
	call PGLINE (2, X_xaxis, Y_xaxis)
	call PGSLS (1)		!! solid line
	call pgsci(color_ink)

        call pgpt(nscan, xscan, yscan, 0)

        if (plotdata) then 	!! error bars
          do i = 1, nscan
            call PGERR1 (6, Xscan(i), Yscan(i), sqrt(yscan(i)), 1.0)
          enddo
        endif

c----------------------------------------------
c...	Mark off the temperature values
c...	Put the temperature along the top of the graph
	if (qb_temp_incT .ne. 0.0) then
	  temp1 = qb_temp_T0 + qb_temp_incT*float(nint(xmin_sc)-1)
	  temp2 = qb_temp_T0 + qb_temp_incT*float(nint(xmax_sc)-1)

cDebug	 write (*,*) 'plot_scan_intensity: x,y, min, max=', 
cDebug     &	 xmin_sc, xmax_sc,  ymin_sc_cnts, ymax_sc_cnts
         call pgaxis('N',xmin_sc, ymax_sc_cnts,  xmax_sc, ymax_sc_cnts, 
     &	   temp1, temp2,
     &     0.0, 1, 0.5,0.0, 0.5, -0.5,0.0)
         call PGMTXT ('T', 1.5, 0.5, 0.5, 'Temperature (K)')

	endif  

       call PGLAB (x_label, y_label, ' ')
       call PGMTXT ('T', 2.0, 0.0, 0.0, file_bufin) 
      
      return
      end


c=============================================================
      subroutine plot_scan_intBragg(nscan, nspurtot, sfhkl)
c      Plot the intensity of the Bragg points on top of the data.
 
      implicit none

      include 'arraysize.inc'
      include 'io_files.inc'
      include 'spur_color.inc'
      include 'spur_layout.inc'
      include 'spur_scan.inc'
      include 'spur_data.inc'		!! contains data and plotdata
      include 'spur_buf.inc'
      include 'spur_warn.inc'

c...	functions
      integer cycle_marker      

c...	passed variables
      integer nscan
       integer nspurtot
      real sfhkl(m_rlv_max,m_rlv_max)
      
c...	local variables
      integer i, k, ii, jj
      real	yy
      real	ybragg_max

       ybragg_max  = 0.0
        do i=1,nspurtot
          do ii=1,m_rlv_max
            do jj=1,m_rlv_max
 	      if ((ispot(i).eq.ii) .and.(jspot(i).eq.jj)) then
	        if (ybragg_max .lt. sfhkl(ispot(i),jspot(i)) ) then
			 ybragg_max = sfhkl(ispot(i),jspot(i))
		endif
	      endif
	    enddo
	  enddo
	enddo
c	write (*,*) 'plot_scan_intbragg : ybragg_max=',  ybragg_max 
c	write (*,*) 'plot_scan_intbragg : yscan_min, yscan_peak=', 
c     &		yscan_min, yscan_peak 

        do ii=1,m_rlv_max
          do jj=1,m_rlv_max

c	    call pgsci(color_ink)

c            do iscan=1,nscan
c...		Bragg peaks along the scan.  
c                if ((abs(zeta(ii,jj)-qarr(1,iscan)).lt.tol).and.
c     &              (abs(eta(ii,jj)-qspur(2,iscan)).lt.tol).and.
c     &               .not.absent(ii,jj)) then
c                  if (ybragg_max .eq. 0.0) then
c		   yy = yscan_min + 0.1*(yscan_max  - yscan_min )
c		  else
c		   yy = sfhkl(ii,jj) *  yscan_peak /ybragg_max
c		  endif
c		endif
c		call pgpt1(float(iscan), yy, 25)	!! big circle marker
c	    enddo
	    
	    call pgsci(color_yellow)
            do i=1,nspurtot
c...		Bragg peaks at the higher order spurions
	      call pgsci(color_yellow)
 	      if ((ispot(i).eq.ii) .and.(jspot(i).eq.jj)) then
                if (ybragg_max .eq. 0.0) then
		 yy = yscan_min
		else
		 yy = sfhkl(ispot(i),jspot(i)) *  yscan_peak /ybragg_max
		endif
	        k = scanpt_spot(i)
		call pgpt1(float(k), yy, cycle_marker(rankspot(i)+5, 15))
c		write (*,*) 'plot_scan_intbragg :',i,
c     &		 k, yy, cycle_marker(rankspot(i)+5, 15), rankspot(i)
ccc		call pgpt1(float(k), yy, 17)	!! solid circle

c		write (*,*) 'plot_scan_intbragg : ', k, i, ii, jj, 
c     &		  ispot(i), jspot(i), yy

	      endif
	    enddo
	  enddo
	enddo

	call pgsci(color_ink)


      return
      end
      
      
c=============================================================
      subroutine plot_scan_intElastic(nscan, nelastictot)
c      Plot the "intensity" of the higher order elastic spurions 
c	on top of the data. (no ibntensity known, so just make it the minimum.)
c	Because we don't know it's relative intensity, make it negative.
 
      implicit none

      include 'arraysize.inc'
      include 'io_files.inc'
      include 'spur_color.inc'
      include 'spur_layout.inc'
      include 'spur_scan.inc'
      include 'spur_data.inc'		!! contains data and plotdata
      include 'spur_buf.inc'
      include 'spur_warn.inc'

c...	functions
      integer cycle_marker, cycle_linestyle

c...	passed variables
      integer nscan
       integer nelastictot
      
c...	local variables
      integer i, k
      real	yy
      real xline(2), yline(2)

	    call pgsci(color_red)
c...		These are the elastic spurions which match a scan point to 
c...		within tolerances.
            do i=1,nelastictot
c		Offset the elastic spurions slightly.	    
ccc	      yy = yscan_min + 0.1 * (yscan_peak-yscan_min)
	      yy = -0.1 * yscan_peak
	      k = scanpt_elst(i)
	      call pgpt1(float(k), yy, cycle_marker(rankelst(i)+10, 15))
c	      call pgpt1(float(k), yy, 13)	!! solid triangle

c		write (*,*) 'plot_scan_intElastic : ', k, i, yy

c		write (*,*) 'plot_scan_intElastic :', i,
c     &		 k, yy, cycle_marker(rankelst(i)+10, 15), rankelst(i)

	    enddo

c....	This are the exact positions of the elastic spurions that 
c....	are within the scan range
cOld        call pgsls(4)          ! dotted line
	do i = 1, n_zeroelst
          call pgsls(cycle_linestyle(i, .false.))	!! non-solid line style
	  xline(1) = iscan_zerospur(i)
	  xline(2) = xline(1)
	  yline(1) = yscan_min
	  yline(2) = yscan_max
	  call pgline(2, xline, yline)
	enddo

	call pgsls(1)				!! return to solid lines
	call pgsci(color_ink)

      return
      end
      
c=============================================================
      subroutine plot_scan_intAl(nscan) 
c      Plot the "intensity" of the Al spurions 
c	on top of the data.
c	Because we don't know it's relative intensity, make it negative.
 
      implicit none

      include 'arraysize.inc'
      include 'io_files.inc'
      include 'spur_color.inc'
      include 'spur_layout.inc'
      include 'spur_scan.inc'
      include 'spur_data.inc'		!! contains data and plotdata
      include 'spur_buf.inc'
      include 'spur_warn.inc'
      
c...	functions 
      integer  cycle_marker

c...	passed variables
      integer nscan
      
c...	local variables
      integer i, k, imark
      real	yy

	    call pgsci(color_greencyan)
            do i=1,nal_match
c		Offset the Al spurions slightly.	    
	      yy = -0.2 * yscan_peak
	      k = iqal_iscan(i)
	      imark = cycle_marker(iqal_ial(i), nal_match)
cWrong	      imark = cycle_marker(i, nal_match)
	      call pgpt1(float(k), yy, imark)	!! solid circle
	    enddo

	call pgsci(color_ink)

      return
      end
      
c=============================================================
      subroutine plot_scan_intIncoh(nscan, nincohmon, nincohana)
c      Plot the "intensity" of the incoherent spurions from the 
c	monochrometer and analyzer on top of the data. 
c	Because we don't know it's relative intensity, make it negative.
 
      implicit none

      include 'arraysize.inc'
      include 'io_files.inc'
      include 'spur_color.inc'
      include 'spur_layout.inc'
      include 'spur_scan.inc'
      include 'spur_data.inc'		!! contains data and plotdata
      include 'spur_buf.inc'
      include 'spur_warn.inc'

c...	functions
      integer cycle_marker      

c...	passed variables
      integer nscan
       integer nincohmon, nincohana 
      
c...	local variables
      integer i, k
      real	yy

	    call pgsci(color_cyan)
            do i=1, nincohmon
c		Offset the elastic spurions slightly.	    
	      yy = -0.25 * yscan_peak
	      k = scanpt_incmon(i)
	      call pgpt1(float(k), yy, cycle_marker(rankincmon(i), 15))
cDebug	      write (*,*) 'plot_scan_intIncoh: MON', i, k, yy,
cDebug     &		       rankincmon(i), cycle_marker(rankincmon(i), 15)
	    enddo
	call pgsci(color_ink)

	    call pgsci(color_bluecyan)
            do i=1, nincohana
c		Offset the elastic spurions slightly.	    
	      yy = -0.3 * yscan_peak
	      k = scanpt_incana(i)
	      call pgpt1(float(k), yy, cycle_marker(rankincana(i), 15))
	      write (*,*) 'plot_scan_intIncoh: ANA', i, k, yy,
     &		       rankincana(i), cycle_marker(rankincana(i), 15)
	    enddo
	call pgsci(color_ink)

      return
      end
      

c=============================================================
      subroutine plot_scan_qaxis(nscan)
      implicit none

      include 'arraysize.inc'
      include 'io_files.inc'
      include 'spur_color.inc'
      include 'spur_layout.inc'
      include 'spur_scan.inc'
      include 'spur_data.inc'		!! contains data and plotdata
      include 'spur_buf.inc'
      include 'spur_warn.inc'

c...  	passed variables
      integer 	nscan
      
c...	local variables
      real def_charSIZE
      real qx, qy, qz
      character*16	qstring
      real	xpos
      integer	nskip
      character*80  y_label
      integer	i

c----------------------------------------------
c...	Mark off the q-values
      vymax_sc_q = vymin_sc_cnts - 0.075
c02Apr      vymax_sc_q = vymin_sc_cnts - 0.1
      if ( (abs(qb_space_hs(1)) .le. 0.1e-7) .and. 
     &     (abs(qb_space_hs(2)) .le. 0.1e-7) .and.  
     &     (abs(qb_space_hs(3)) .le. 0.1e-7)  )then
	vymin_sc_q = vymax_sc_q
      else
	vymin_sc_q = vymax_sc_q - 0.08
c02mar	vymin_sc_q = vymax_sc_q - 0.15        
	call PGQCH (def_charSIZE)
        call pgsch(def_charSIZE*0.5)
        call PGSVP(vxmin_sc_q,vxmax_sc_q,vymin_sc_q,vymax_sc_q)
        call PGSWIN (xmin_sc, xmax_sc,  ymin_sc_q, ymax_sc_q)

c      call PGSVP (0.08, 0.92, 0.35, 0.5)
c      call PGSWIN (Xscan_MIN, Xscan_MAX, 0.0, 1.0) 
CLeaveout?        call pgbox ('BNT', 0, 0, 'B', 0, 0)
        y_label = 'Q(h,k,l)'
        call PGLAB (' ', y_label, ' ')
c02Mar        call PGLAB (x_label, y_label, ' ')
cOld        do i = 1, nscan
        do i = nint(xmin_sc), nint(xmax_sc)
	 nskip = (nint(xmax_sc-xmin_sc+1) - 
     &		   mod(nint(xmax_sc-xmin_sc+1), 5))/5
	 if (nskip .eq. 0) nskip = 1 
	 if (mod(i, nskip) .eq. 0) then
          xpos = xmin_sc + float(i-nint(xmin_sc))
cOld          xpos = xscan_min + xscan_max*(float(i)/(xscan_max- xscan_min))
	  qx = qb_space_hc(1) +
     &	  	(float(i-1)-(float(nscan-1))/2.0)*qb_space_hs(1)
	  qy = qb_space_hc(2) +
     &	 	(float(i-1)-(float(nscan-1))/2.0)*qb_space_hs(2)
	  qz = qb_space_hc(3) +
     &	  	(float(i-1)-(float(nscan-1))/2.0)*qb_space_hs(3)
          write (qstring, 120)  Qx, Qy, Qz
c03Mar          write (qstring, 120)  Qx_data(i), Qy_data(i), Qz_data(i)
 120	  format( '(', f4.2, ',', f4.2, ',', f4.2, ')' )
c          write (*,*) 'q label = ', i, ' "', qstring, '"', e_data(i)
          call PGpTXT (xpos, 0.0, 90.0, 0.0, qstring)
	 endif
        enddo
        call pgsch(def_charSIZE)
      endif

      return
      end


c=============================================================
      subroutine plot_scan_a4(nscan, phimax)
      implicit none

      include 'arraysize.inc'
      include 'io_files.inc'
      include 'spur_color.inc'
      include 'spur_layout.inc'
      include 'spur_scan.inc'
      include 'spur_data.inc'		!! contains data and plotdata
      include 'spur_buf.inc'
      include 'spur_warn.inc'
      
c...    passed variables
      integer	nscan
      real	phimax

c...	local variables
c      character*80 x_label, y_label
c      real temp1, temp2
      real def_charsize
      CHARACTER*6 A4STRING
      real xpos, this_a4
      integer nskip, i

c----------------------------------------------
c..	Mark off A4 angle
      vymax_sc_a4 = vymin_sc_q 
      
cDebug	  write (*,*) 'plot_scan_a4: angle4_varies=',angle4_varies
      if (.not. angle4_varies) then
	vymin_sc_a4 = vymax_sc_a4
      else
	vymin_sc_a4 = vymax_sc_a4 - 0.035
c02Apr	vymin_sc_a4 = vymax_sc_a4 - 0.013 
        call PGSVP(vxmin_sc_a4,vxmax_sc_a4,vymin_sc_a4,vymax_sc_a4)
        call PGSWIN (xmin_sc, xmax_sc,  ymin_sc_a4, ymax_sc_a4)

cc...	Put tick marks not but not the numbers on the axes
c        call pgbox ('BT', 0, 0, '', 0, 0)
c        x_label = 'Angle 4 [Degrees]'
c        y_label = ' '
c
c        call pgaxis('N',xmin_sc, ymin_sc_a4,  xmax_sc, ymin_sc_a4, 
c     &	   angle4(1), angle4(nscan),
c     &     0.0, 1, 0.0,0.5, 0.5, 0.5,0.0)
c        call PGMTXT ('B', 2.0, 0.5, 0.5, x_label)
c
c      endif

c...	Must do it a complicated way because Angle4 will not be evenly spaced.
	call PGQCH (def_charSIZE)
        call pgsch(def_charSIZE*0.5)
        call PGSVP(vxmin_sc_a4,vxmax_sc_a4,vymin_sc_a4,vymax_sc_a4)
        call PGSWIN (xmin_sc, xmax_sc,  ymin_sc_a4, ymax_sc_a4)

        call PGLAB (' ', 'A4 [Deg]', ' ')
        do i = nint(xmin_sc), nint(xmax_sc)
	 nskip = (nint(xmax_sc-xmin_sc+1) - 
     &		   mod(nint(xmax_sc-xmin_sc+1), 5))/5
	 if (nskip .eq. 0) nskip = 1 
	 if (mod(i, nskip) .eq. 0) then
          xpos = xmin_sc + float(i-nint(xmin_sc))
	  this_a4 = angle4_store(nint(xpos)) *180.0/acos(-1.0)
          write (a4string, 120) this_a4
 120	  format( f6.2 )
          call PGpTXT (xpos, 0.0, 90.0, 0.0, A4string)
cDebug	  write (*,*) 'plot_scan_a4: ',nskip, i, xpos, this_a4
	 endif
        enddo
        call pgsch(def_charSIZE)
      endif


      return
      end


c=============================================================
      subroutine plot_scan_eaxis(nscan)
      implicit none

      include 'arraysize.inc'
      include 'io_files.inc'
      include 'spur_color.inc'
      include 'spur_layout.inc'
      include 'spur_scan.inc'
      include 'spur_data.inc'		!! contains data and plotdata
      include 'spur_buf.inc'
      include 'spur_warn.inc'
      
c...    passed variables
      integer	nscan

c...	local variables
      character*80 x_label, y_label
      real temp1, temp2

c----------------------------------------------
c..	Mark off the energy 
      vymax_sc_de = vymin_sc_A4
c      vymax_sc_de = vymin_sc_q 
      if (abs(qb_energy_es) .le. 0.1e-7) then
	vymin_sc_de = vymax_sc_de
      else
	vymin_sc_de = vymax_sc_de - 0.01 
        call PGSVP(vxmin_sc_de,vxmax_sc_de,vymin_sc_de,vymax_sc_de)
        call PGSWIN (xmin_sc, xmax_sc,  ymin_sc_de, ymax_sc_de)

c...	Put tick marks not but not the numbers on the axes
        call pgbox ('BT', 0, 0, '', 0, 0)
        x_label = 'delta Energy [meV]'
        y_label = ' '

	temp1 = qb_energy_ec + 
     &		  qb_energy_es*((xmin_sc-1.0) - (nscan-1)/2.0)
	temp2 = qb_energy_ec + 
     &		  qb_energy_es*((xmax_sc-1.0) - (nscan-1)/2.0)

        call pgaxis('N',xmin_sc, ymin_sc_de,  xmax_sc, ymin_sc_de, 
     &	   temp1, temp2,
     &     0.0, 1, 0.0,0.5, 0.5, 0.5,0.0)
        call PGMTXT ('B', 2.0, 0.5, 0.5, x_label)


      endif

      return
      end


c=============================================================
      subroutine plot_scan_higherspurions(nscan, nspurtot, esparr, 
cInc     &      ispur, jspur, 
     &	pointsize, relcircsize)
      implicit none
c----------------------------------------------
c..     Plot scan number vs. the energy  for all the higher order spurions.

      include 'arraysize.inc'
      include 'io_files.inc'
      include 'spur_color.inc'
      include 'spur_layout.inc'
      include 'spur_scan.inc'
      include 'spur_data.inc'		!! contains data and plotdata
      include 'spur_buf.inc'
      include 'spur_warn.inc'

c...	functions
      integer cycle_linestyle 
      
c...	passed variables
      integer 	nscan
      integer nspurtot
      real esparr(n_spur_max,n_spur_max,maxnpts)
cInc      integer ispur(n_spur_max*n_spur_max)
cInc      integer jspur(n_spur_max*n_spur_max)
      real pointsize(m_rlv_max,m_rlv_max)
      real relcircsize

c...	local variables
      real def_charSIZE
      integer icolor
      character*29 spur_label
      real yhispur_min, yhispur_max
      integer ii, jj, i, k, izero
      real 	x_xaxis(2), y_xaxis(2)

c----------------------------------------------
c..	Plot scan number vs. the energy  for all the higher order spurions.
      vymax_sc_hs = vymin_sc_de - 0.07
c...	Leave at least a certain amount of room for LPI notes
      vymin_sc_hs = max(vymax_sc_hs/2.0, 0.25)
c      vymin_sc_hs = max(vymax_sc_hs/2.0, vymax_sc_hs - 0.15)
cOrig      vymin_sc_hs = vymax_sc_hs /2.0
      
      if (auto_ymin_sc_hs) then
        ymin_sc_hs = qb_energy_ec + 
     &		  qb_energy_es*(float(0-1) - (nscan-1)/2.0)
      endif
      if (auto_ymax_sc_hs) then
        ymax_sc_hs = qb_energy_ec + 
     &		  qb_energy_es*(float(nscan+1-1) - (nscan-1)/2.0)
      endif
      
        do i = 1, nscan
          if (plotdata) then
            yhispur(i) = e_data(i)
	  else
	    yhispur(i) = qb_energy_ec + 
     &		  qb_energy_es*(float(i-1) - (nscan-1)/2.0)
	  endif
	enddo
	
	yhispur_max =  yhispur(1)
	yhispur_min =  yhispur(1)
	if (yhispur_max .lt. yhispur(nscan)) yhispur_max =  yhispur(nscan)
	if (yhispur_min .gt. yhispur(nscan)) yhispur_min =  yhispur(nscan)

        do ii=1,n_spur_max
          do jj=1,n_spur_max
	    if (.not. ((ii .eq. 1) .and. (jj .eq. 1)) ) then
	      k= 1		!! only do endpoints of scan
	        if (yhispur_max .lt. esparr(ii,jj,k)) then
	          yhispur_max =  esparr(ii,jj,k)
	        endif
	        if (yhispur_min .gt. esparr(ii,jj,k)) then
	          yhispur_min =  esparr(ii,jj,k)
	        endif
	      k= nscan		!! only do endpoints of scan
	        if (yhispur_max .lt. esparr(ii,jj,k)) then
	          yhispur_max =  esparr(ii,jj,k)
	        endif
	        if (yhispur_min .gt. esparr(ii,jj,k)) then
	          yhispur_min =  esparr(ii,jj,k)
	        endif
 	    endif
	  enddo
        enddo
	
c	write (*,*) 'plot_scan: Spurion energy range:', 
c     &		yhispur_min, yhispur_max 

      if (auto_ymin_sc_hs) then
	ymin_sc_hs = yhispur_min
      endif
      if (auto_ymin_sc_hs) then
	ymax_sc_hs = yhispur_max 
      endif
	
        call PGSVP(vxmin_sc_hs,vxmax_sc_hs,vymin_sc_hs,vymax_sc_hs)
        call PGSWIN (xmin_sc, xmax_sc,  ymin_sc_hs, ymax_sc_hs)

        call pgbox ('BCNST', 0, 0, 'BCNST', 0, 0)
        call PGLAB ('scan point #. (Q [rlu])', 
     &		'Spur En. [meV]', ' ')
c        call PGLAB ('scan point #', 
c     &		'Spurion Energies [meV] (Q [rlu])', ' ')


c...	x-axis
	x_xaxis(1) = xmin_sc
	x_xaxis(2) = xmax_sc
	y_xaxis(1) = 0.0
	y_xaxis(2) = 0.0
	call pgsci(color_blue)
	call PGSLS (2)		!! Dashed line
	call PGLINE (2, X_xaxis, Y_xaxis)
	call PGSLS (1)		!! solid line
	call pgsci(color_ink)

c...	The scan line
	call PGQCH (def_charSIZE)
        call pgsch(def_charSIZE*0.5)
	icolor = 0
	call cycle_color(icolor, 3)
        call PGSLS (3)		!! dashed
        call pgline(nscan, xscan,  yhispur)
        call PGSLS (1)		!! solid


	if ( ((0.0 .ge. ymin_sc_hs) ) .and.
     &	           ((0.0 .le. ymax_sc_hs) )) then
	  call pgtext(xscan(nint(xmax_sc)), 0.0, 'x-axis')
	endif

	if ( ((yhispur(nint(xmax_sc)) .ge. ymin_sc_hs) ) .and.
     &	           ((yhispur(nint(xmax_sc)) .le. ymax_sc_hs) )) then
	  call pgtext(xscan(nint(xmax_sc)), yhispur(nint(xmax_sc)), 'Scan')
	endif
c	call pgtext(xscan(nscan), yhispur(nscan), 'Scan')

cDebug	write (*,*) 'plot_scan: higher order spurions:'
        do ii=1,n_spur_max
          do jj=1,n_spur_max

	    if (.not. ((ii .eq. 1) .and. (jj .eq. 1)) ) then
              do k = 1, nscan
                 yhispur(k) = esparr(ii,jj,k)
	      enddo
c	      write (*,*) 'plot_scan:  ', ii, jj, 
c     &		      yhispur(1), yhispur(nscan)
	      call cycle_color(icolor, 3)
	      do izero = 1, n_zeroelst
	        if ((ii .eq. ii_zerospur(izero)) .and.
     &		 	(jj .eq. jj_zerospur(izero)) ) then
     		  call pgsci(color_red)
		  call PGSLS (cycle_linestyle(izero, .false.)) !! non-solid lines
     		endif
	      enddo
              call pgline(nscan, xscan,  yhispur)
 110          format(i1, '*Ki-', i1, '*Kf', 1x, a)	      
 	      write (spur_label, 110), ii, jj, afloat_hkl_end(ii,jj)

	      if ( ((yhispur(nint(xmax_sc)) .ge. ymin_sc_hs)) .and.
     &	           ((yhispur(nint(xmax_sc)) .le. ymax_sc_hs))) then
	        call pgtext(xscan(nint(xmax_sc)), yhispur(nint(xmax_sc)),
     &		      spur_label)
     	      endif
     
	      if ( ((yhispur(nint(xmin_sc)) .ge. ymin_sc_hs) ) .and.
     &	           ((yhispur(nint(xmin_sc)) .le. ymax_sc_hs) )) then
	        call pgtext(xscan(nint(xmin_sc)), yhispur(nint(xmin_sc)),
     &		     afloat_hkl_start(ii,jj) )
     	      endif


	    endif
	    call PGSLS (1)		!! solid
	  enddo
        enddo

        call pgsci(color_ink)
        call pgsch(def_charSIZE)	!! restore character size

      return
      end

c=============================================================
      subroutine plot_scan_higherbragg(nscan, nspurtot, esparr, 
     &	pointsize, relcircsize)
c----------------------------------------------
c...    Place the positions of the bragg peaks which intersect with
c        the higher order spurions. 
      implicit none

      include 'arraysize.inc'
      include 'io_files.inc'
      include 'spur_color.inc'
      include 'spur_layout.inc'
      include 'spur_scan.inc'
      include 'spur_data.inc'		!! contains data and plotdata
      include 'spur_buf.inc'
      include 'spur_warn.inc'

c...	functions
      integer cycle_marker      
      
c...	passed variables
      integer 	nscan
      integer nspurtot
      real esparr(n_spur_max,n_spur_max,maxnpts)
      real pointsize(m_rlv_max,m_rlv_max)
      real relcircsize

c...	local variables
      real def_charSIZE
c      integer icolor
c      character*29 spur_label
c      real yhispur_min, yhispur_max
cUnused      integer ii, jj
      integer i, k

        call PGSVP(vxmin_sc_hs,vxmax_sc_hs,vymin_sc_hs,vymax_sc_hs)
        call PGSWIN (xmin_sc, xmax_sc,  ymin_sc_hs, ymax_sc_hs)

c----------------------------------------------
c...	Place the positions of the bragg peaks with intersect
c	 the higher order spurions. 
c	write (*,*) 'plot_scan: # of Bragg matches=', nscan_bragg

	call PGQCH (def_charSIZE)
        call pgsch(def_charSIZE*0.5)
	call pgsci(color_yellow)

        do i=1,nspurtot
	  k = scanpt_spot(i)

	  call pgpt1(float(k), esparr(ispur(i),jspur(i),k), 
     &		  cycle_marker(rankspot(i)+5, 15))
c	  call pgpt1(float(k), esparr(ispur(i),jspur(i),k), 17)
	enddo

c555    continue

       call pgsci(color_ink)
       call pgsch(def_charSIZE)	!! restore character size


      return
      end


c=============================================================
      subroutine plot_scan_higherelastic(nscan, nelastictot, esparr)
c----------------------------------------------
c...    Place the positions of the higher order spurions which are elastic. 
      implicit none

      include 'arraysize.inc'
      include 'io_files.inc'
      include 'spur_color.inc'
      include 'spur_layout.inc'
      include 'spur_scan.inc'
      include 'spur_data.inc'		!! contains data and plotdata
      include 'spur_buf.inc'
      include 'spur_warn.inc'

c...	functions
      integer cycle_marker
            
c...	passed variables
      integer 	nscan
      integer nelastictot
      real esparr(n_spur_max,n_spur_max,maxnpts)

c...	local variables
      real def_charSIZE
      integer i, k

        call PGSVP(vxmin_sc_hs,vxmax_sc_hs,vymin_sc_hs,vymax_sc_hs)
        call PGSWIN (xmin_sc, xmax_sc,  ymin_sc_hs, ymax_sc_hs)

c	  write (*,*) 'plot_scan_higherelastic: entered'

	call PGQCH (def_charSIZE)
        call pgsch(def_charSIZE*0.5)
	call pgsci(color_red)
        do i=1,nelastictot
	  k = scanpt_elst(i)
c	  call pgpt1(float(k), esparr(ielst(i),jelst(i),k), 16)
c	  write (*,*) 'plot_scan_higherelastic: ', 
c     &		  i, k, esparr(ielst(i),jelst(i),k)
	  call pgpt1(float(k), esparr(ielst(i),jelst(i),k),
     &		  cycle_marker(rankelst(i)+10, 15))
cDebug	  write (*,*) 'plot_scan_higherelastic: elast. matches: ', 
cDebug     &	    'Using symbol ', cycle_marker(rankelst(i)+10, 15), rankelst(i)
	enddo
	

c	The exact placement of zero crossings.
	do i = 1, n_zeroelst 
	  call pgpt1(iscan_zerospur(i), 0.0, 17)	!! filled circle
	  write (*,*) 'plot_scan_higherelastic: zero crossings: ', 
     &	    'Using symbol ', 17
	  
	enddo
	

       call pgsci(color_ink)
       call pgsch(def_charSIZE)	!! restore character size

      return
      end


c=============================================================
      subroutine plot_scan_annotate(version_stamp, nspurtot,nelastictot, 
     &      nincohmon, nincohana)
      implicit none

      include 'arraysize.inc'
      include 'io_files.inc'
      include 'spur_color.inc'
      include 'spur_layout.inc'
      include 'spur_scan.inc'
      include 'spur_data.inc'		!! contains data and plotdata
      include 'spur_buf.inc'
      include 'spur_warn.inc'
      
c...	functions
      integer cycle_marker, cycle_linestyle
      
c...	passed variables
      character*80 version_stamp
      integer nspurtot, nelastictot, nincohmon, nincohana

c...	Local variables
      real ytop, xch, ych
      real	 yyhere, xxhere, xx2here, yyoff, yytop, yy_sofar
      integer		nuser
      character*20	userstring
      character*(80) aline
      logical moremore
      real def_charSIZE
      integer ial, i, j, ihigh
      character*7	alstring
      character*9	higherstring
      real	xline(2), yline(2)
      

c----------------------------------------------
c...	Put the LPI file on the bottom of the page, if it is being used.
      vymax_sc_lpi = vymin_sc_hs - 0.04
c      vymax_sc_lpi = vymin_sc_hs - 0.07
      vymin_sc_lpi = 0.03
c      vymin_sc_lpi = margin_plot
      call PGSVP(vxmin_sc_hs,vxmax_sc_hs,vymin_sc_lpi,vymax_sc_lpi)
      ytop = ((vymax_sc_lpi-vymin_sc_lpi)/(vxmax_sc_hs- vxmin_sc_hs))
      ytop = ytop *aspect_ratio
      call pgswin( 0.0, 1.0, 0.0, ytop)	!! make commensurate

      call PGQCS(4, XCH, YCH)		!! world units
      yoff_sc = 1.5*ych
      if (warn_options .ne. 0) then	!! Print warning in big red letters
        yhere_sc = vymin_sc_lpi + yoff_sc
        call pgsci(color_red)	
	call pgmtext('LV', -0.1, yhere_sc, 0.0, warnstring)
        call pgsci(color_ink)	
      endif

      call PGQCH (def_charSIZE)
      call pgsch(def_charSIZE*0.55)  !! Shrink the lettering.
      xhere_sc = 0.0
      call PGQCS(4, XCH, YCH)		!! world units
      yoff_sc = 1.5*ych
      
      yhere_sc = vymin_sc_lpi
      call pgqinf('USER', userstring, nuser)
      call pgmtext('RV', -0.1, yhere_sc, 1.0, userstring(1:nuser))
      call pgmtext('LV', -0.1, yhere_sc, 0.0,  version_stamp)

      OPEN(UNIT=unitlpi,FILE=file_lpi,STATUS='OLD',err=622)

      yhere_sc = ytop
      yhere_sc = yhere_sc - yoff_sc
      call pgtext(xhere_sc, yhere_sc, file_lpi)

      moremore = .true.
      do while (moremore)
	read (unitlpi, '(a80)', err=620, end=620) aline
        yhere_sc = yhere_sc - yoff_sc
        if (yhere_sc .gt. 0.05) then
	  call pgtext(xhere_sc, yhere_sc, aline)
	endif	
      enddo

 620  continue
      close (unitlpi)
 622  continue     
      call pgsch(def_charSIZE)	  !! restore the lettering.

c----------------------------------------------
c...	Put the marker labels on the right of the page
      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

      call PGQCH (def_charSIZE)
      call pgsch(def_charSIZE*1.0)  !! increase the lettering size.
        yyhere = yytop
c        yyhere = yytop + yyoff
        yy_sofar = yyhere
        call PGQCS(4, XCH, YCH)
        yyoff = 1.5*ych
c        xxhere = yyoff/2.0
        xxhere = yyoff*1.5
        xx2here = yyoff*2.25
	
c...	data
        yyhere = yyhere - yyoff
        call pgsci(color_ink)
 	call pgpt1(xxhere, yyhere, 0)		!! box
	call pgtext(xx2here, yyhere, 'Data')

	if (nspurtot .gt. 0) then
          call pgsci(color_yellow)
          yyhere = yyhere - yyoff
	  call pgtext(xxhere, yyhere, 'Higher Spurs:')
	endif

c...	higher order spurions intersecting Bragg peaks
cc	if (nspurtot .gt. 0) then
c          	call pgsci(color_yellow)
c          	yyhere = yyhere - yyoff
c	  	call pgpt1(xxhere, yyhere, 17)		!! solid circle
c	  	call pgtext(xx2here, yyhere, 'Bragg')
cc	endif

c...	higher order spurions intersecting Bragg peaks
c	ihigh = 0 	
       do ihigh = 1, n_rankspot
	do i = 1, nspurtot
	  if ((ihigh) .eq. rankspot(i)) then
c	  if ((ihigh+1) .eq. rankspot(i)) then
c	    ihigh = ihigh + 1
c	    write (*,*) 'plot_scan_annotate:', i, ihigh, 
c     &		  rankspot(i), cycle_marker(ihigh+5, 15)
            yyhere = yyhere - yyoff
	    write (higherstring, 90) ispur(i), jspur(i)
 90	    format(i1, '*Ki-', i1, '*Kf')		
	    call pgpt1(xxhere, yyhere, cycle_marker(ihigh+5, 15))	!! markers 
	    call pgtext(xx2here, yyhere, higherstring)
	    goto 81
	  endif
	enddo
 81	continue
       enddo

c	ihigh = 0
c	do ii = 1, n_spur_max
c	  do jj = 1, n_spur_max
c	    do i = 1, nspurtot
c	      if ((ii .eq. ispot(i))  .and. (jj .eq. jspot(i)) then
c	        ihigh = ihigh + 1
c          	yyhere = yyhere - yyoff
c          	call pgsci(color_yellow)
c		write (higherstring, 90) ii, jj
c 90		format(i1, '*Ki-', i1, '*Kf')		
c	  	call pgpt1(xxhere, yyhere, cycle_marker(ihigh+5, 15))	!! markers 
c	  	call pgtext(xx2here, yyhere, higherstring)
cc	  	call pgpt1(xxhere, yyhere, 17)		!! solid circle
cc	  	call pgtext(xx2here, yyhere, 'Bragg')
c	  	goto 91			!! Only report 1 label per ii*Ki - jj*Kf
c	      endif
c	    enddo
c	  enddo
c 91	  continue	  
c	enddo
c	endif

	if ((n_zeroelst .gt. 0) .or. (nelastictot .gt. 0)) then
          call pgsci(color_red)
          yyhere = yyhere - yyoff
	  call pgtext(xxhere, yyhere, 'Elst Spurs:')
	endif

	
c02May	if (nelastictot .gt. 0) then
c02May          call pgsci(color_red)
c02May          yyhere = yyhere - yyoff
c02May	  call pgtext(xxhere, yyhere, 'Elst Spurs:')
c02May	endif

c...	Dashed lines for all elastic spurions within scan range,
c...	even if not within tolerance of a scan point
      do i = 1, n_zeroelst
        call pgsls(cycle_linestyle(i, .false.))		!! non-solid line style
        yyhere = yyhere - yyoff
        write (higherstring, 90) ii_zerospur(i), jj_zerospur(i)
	xline(1) = yyoff*1.0		!! xxhere
	xline(2) = xx2here
	yline(1) = yyhere
	yline(2)  = yline(1)
	call pgline(2, xline, yline) 
	call pgtext(xx2here, yyhere, higherstring)
      enddo
      call pgsls(1)          ! solid line

c...	higher order elastic spurions matches to scan points
      do ihigh = 1, n_rankelst
c	ihigh = 0 	
	do i = 1, nelastictot
	  if ((ihigh) .eq. rankelst(i)) then
c	  if ((ihigh+1) .eq. rankelst(i)) then
c	    ihigh = ihigh + 1
            yyhere = yyhere - yyoff
	    write (higherstring, 90) ielst(i), jelst(i)
	    call pgpt1(xxhere, yyhere, cycle_marker(ihigh+10, 15))	!! markers 
	    call pgtext(xx2here, yyhere, higherstring)
	    goto 91
	  endif
	enddo
 91	continue
       enddo

cc	if (nelastic .gt. 0) then
c          yyhere = yyhere - yyoff
c          call pgsci(color_red)
c	  call pgpt1(xxhere, yyhere, 13)		!! solid triangle
c	  call pgtext(xx2here, yyhere, 'elastic')
cc	endif

c...	al spurions
        call pgsci(color_green)
 	do ial = 1, nal
	  do j = 1, nal_match
	    if ( iqal_ial(j) .eq. ial) then
              yyhere = yyhere - yyoff
	      write (alstring, 105 ) (hklal(i,ial), i=1, 3)
c	      write (alstring, 105 ) (hklal(i,j), i=1, 3)
 105 	      format ('Al(', 3i1, ')' )
	      call pgpt1(xxhere, yyhere, cycle_marker(ial, nal_match))	!! a marker
	      call pgtext(xx2here, yyhere, alstring)
cDebug	      write (*,*) 'cmd_al: ial=', ial, j, alstring
	      goto 111			!! Only report 1 label per Al ring
cDebug	    else 
cDebug	      write (*,*) 'cmd_al: skipping ial=', ial, j
	    endif
	  enddo
 111      continue
	enddo

c...	incoherent spurions

	if (nincohmon .gt. 0) then
          call pgsci(color_cyan)
          yyhere = yyhere - yyoff
	  call pgtext(xxhere, yyhere, 'MON Incoh:')
	endif

      do ihigh = 1, n_rankincmon
	do i = 1, nincohmon
	  if ((ihigh) .eq. rankincmon(i)) then
            yyhere = yyhere - yyoff
	    call pgpt1(xxhere, yyhere, cycle_marker(ihigh, 15))	!! markers 
	    call pgtext(xx2here, yyhere, lab_incmon(i)) 
	    goto 121
	  endif
	enddo
121	continue
       enddo

	if (nincohana .gt. 0) then
          call pgsci(color_bluecyan)
          yyhere = yyhere - yyoff
	  call pgtext(xxhere, yyhere, 'ANA Incoh:')
	endif

       do ihigh = 1, n_rankincana
	do i = 1, nincohana
	  if ((ihigh) .eq. rankincana(i)) then
            yyhere = yyhere - yyoff
	    call pgpt1(xxhere, yyhere, cycle_marker(ihigh, 15))	!! markers 
	    call pgtext(xx2here, yyhere, lab_incana(i)) 
	    goto 131
	  endif
	enddo
131	continue
       enddo


      call pgsch(def_charSIZE)	  !! restore the lettering.


      return
      end

      
cc==========================================================================
      logical function input_datahdr(whichqbuf)
           
      implicit none
      include 'arraysize.inc'
      include 'io_files.inc'
      include 'spur_buf.inc'
cObsolete      include 'spur_data.inc'

c...	common blocks
c..	functions
      integer ilen
      
cc...	passed variables
      character*1 whichqbuf
      
cc...	local variables
      character*80 aline
      integer i
cNotUsed      character*40 filename
      real	areal


      OPEN(UNIT=unitdata,FILE=file_bufin,STATUS='OLD',err=661)
cObsolete      OPEN(UNIT=unitdata,FILE=file_data,STATUS='OLD',err=661)
      
c 'PROSS007.BT2' '12-AUG-2001 12:43' 'Q'    1175000.    6  'NEUT'  105  'RAW'
      read (unitdata, *, err=660) qd_filename, qd_date, 
     &      qd_scanstyle,  areal, qd_prefactor, qd_base,  
     &	    qd_scanpts, qd_type
      qd_monitor  = nint(areal)

c      read (unitdata, *, err=660) filename, data_date, 
c     &      data_scantype, areal, data_prf, data_probe, 
c     &	    data_nscan, data_type
c      data_mon = nint(areal)
      
c   Filename         Date            Scan       Mon    Prf  Base   #pts  Type
      read (unitdata, 80, err=663) aline		! Skip labels for previous line
 80   format (a80)      
c02May      read (unitdata, *, err=663) aline		! Skip labels for previous line

c PrOsS  PrOs4Sb12                                  
      read (unitdata, '(a7, a73)', err=662) qd_fileprefix, qd_comment
c02May      read (unitdata, *, err=662) qd_fileprefix, qd_comment
c      read (unitdata, *, err=662) aline		! skip chemical composition
      
c  60 20 40  2       0  0  0         1  0  0   0.000     0  0  1
      read (unitdata, *, err=664) (qd_collimation(i), i=1,4), 
     &	    (qd_mosaic(i), i=1,3), 
     &      (qd_u(i), i=1,3), qd_angle, (qd_v(i), i=1,3)
c      read (unitdata, *, err=664) (collimation(i), i=1,4), 
c     &	    (mosaic(i), i=1,3), 
c     &      (u_data(i), i=1,3), angle_data, (v_data(i), i=1,3)
     
c  Collimation        Mosaic              Xstal Orientation
      read (unitdata, 80, err=662) aline		! Skip labels for previous line
c02May      read (unitdata, *, err=662) aline		! Skip labels for previous line

c      6.283     6.283     6.283    90.000    90.000    90.000
      read (unitdata, *, err=665) (qd_lattice_a(i), i=1,3), 
     &     (qd_lattice_angle(i), i=1,3)
c      read (unitdata, *, err=665) a_data, b_data, c_data, 
c     &      alpha_data, beta_data, gamma_data

c Lattice Parameters in real space
      read (unitdata, 80, err=662) aline		! Skip labels for previous line
c02May      read (unitdata, *, err=662) aline		! Skip labels for previous line

c     11.000    -0.250       14.700        3.354   3.354      6.00000   0.00000
      read (unitdata, *, err=666)  qd_ec, qd_es, qd_fe,  qd_dM, qd_dA,  
     &        qd_temp_T0, qd_temp_incT	
c      read (unitdata, *, err=666)  ec_data, es_data, fe_data
c    &, m_dsp, a_dsp, tmp_srt, tmp_inc

c   E center  Delta E      EA fixed      M-dsp   A-dsp     Tmp strt   Tmp inc
c23456789_123456789_123456789_123456789_123456789_123456789_123456789_123456789_
      read (unitdata, 80, err=662) aline		! Skip labels for previous line
cBroken      read (unitdata, *, err=662) aline		! Skip labels for previous line
      qd_ana_or_mon = aline(28:29)
cDebug      write (*,*) 'input_datahdr: aline ='
cDebug      write (*,*) '"', aline(1:50), '"'
cDebug      write (*,*) 'input_datahdr: aline(25:32)="', aline(25:32), '"'
cDebug      write (*,*) 'input_datahdr: qd_ana_or_mon=aline(28:29)="', 
cDebug     &	qd_ana_or_mon , '"'
      if (qd_ana_or_mon .eq. 'EA') then
        qb_energy_fix = '(ANA)'
      else if (qd_ana_or_mon .eq. 'EM') then
        qb_energy_fix = '(MON)'
      else
         write (*,*) 'input_datahdr: qd_ana_or_mon = "', 
     &		 qd_ana_or_mon, '"'
        qb_energy_fix = '(???)'
      endif

      
c   1.800   0.000   0.000    0.0000  0.0000  0.0000      0.0000
      read (unitdata,*,err=667) (qd_space_hc(i),i=1,3), 
     &		      (qd_space_hs(i),i=1,3)
c      read (unitdata,*,err=667) (hc_data(i),i=1,3), (hs_data(i),i=1,3)
c    Q (hkl scan center)        Delta Q (hkl)            Hfield
      read (unitdata, 80, err=662) aline		! Skip labels for previous line
c02May      read (unitdata, *, err=662) aline		! Skip labels for previous line


c     Q(x)    Q(y)    Q(z)     E       T-act    min       Counts
      read (unitdata, 80, err=662) aline		! Skip labels data columns
c02May      read (unitdata, *, err=662) aline		! Skip labels data columns
      

c      constq_data = .true.
c      do i = 1, 3
c        if (hs_data(i) .ne. 0.0) then
c          constq_data = .false.
c        endif
c      enddo
      

      if (qd_scanpts .gt. maxnpts) then
	write (*,*) 'input_data: Change arraysize.inc''s maxnpts ', 
     &    'so that this # of data points can be read in:', qd_scanpts
	stop
      endif

c      if (data_nscan .gt. maxnpts) then
c	write (*,*) 'input_data: Change arraysize.inc''s maxnpts ', 
c     &    'so that this # of data points can be read in:', data_nscan
c	stop
c      endif

      close (UNIT=unitdata)
      
      input_datahdr = .true.

      goto 999
      
 671  write (*,*) 'input_datadhr: Can not open data file: ', 
     &		file_bufin(1:ilen(file_bufin))
      goto 777

 672  write (*,*) 'input_datadhr: Error skipping header, line ', i
      goto 777

 661  write (*,*) 'input_datadhr: Can not open data file: ', 
     &		file_data(1:ilen(file_data))
      goto 777

 660  write (*,*) 'input_datadhr: Error first line'
c      write (*,*) '  =',  filename
c      write (*,*) '  =', data_date
c      write (*,*) '  =', data_scantype
c      write (*,*) '  =',  data_mon
c      write (*,*) '  =', data_prf 
c      write (*,*) '  =',  data_probe
c      write (*,*) '  =',  data_nscan
c      write (*,*) '  =',  data_type
      goto 777

 662  write (*,*) 'input_datadhr: Error reading skipped line "', 
     &		aline(1:ilen(aline)), '"'
      goto 777
      
 663  write (*,*) 'input_datadhr: Error line containing filename'
      goto 777

 664  write (*,*) 'input_datadhr: Error line containing XTL orientation'
      goto 777

 665  write (*,*) 'input_datadhr: ', 
     &	 'Error line containing lattice parameters'
      goto 777

 666  write (*,*) 'input_datadhr: Error line containing ', 
     &		'Energy center and step'
      goto 777

 667  write (*,*) 'input_datadhr: ', 
     &	 'Error line containing Q center and step'
      goto 777


 777  input_datahdr = .false.      	      
 999  return
      end
      
cc==========================================================================
      logical function input_data(whichqbuf)
           
      implicit none
      include 'arraysize.inc'
      include 'io_files.inc'
c      include 'spur_color.inc'
c      include 'spur_layout.inc'
c      include 'spur_scan.inc'
      include 'spur_data.inc'
      include 'spur_buf.inc'


c...	common blocks
c..	functions
      integer ilen
      logical extractfirstword
      
cc...	passed variables
      character*1 whichqbuf
      
cc...	local variables
      character*80 aline
      integer i
      character*8    labels(7)
      
cNotused      character*40 filename
cNotUsed      real	areal

c03Mar 202  write(*,'(a,$)') ' Enter name of data file: ' 
c03Mar      read(*,'(A)',err=202) file_data
c03Mar      plotdata = .false.
      if ( (ichar(whichqbuf) .ge. ichar('0')) .and. 
     &		(ichar(whichqbuf) .le. ichar('9')) ) then 
       OPEN(UNIT=unitdata,FILE=file_bufin,STATUS='OLD',err=671)
       do i = 1, 11		!! skip header info.
ccc       do i = 1, 12		!! skip header info.
         read (unitdata, 80, err=672, end=772) aline
80	 format(a80)
c02May         read (unitdata, *, err=672) aline
       enddo
       read (unitdata, 80, err=673, end=772) aline
       do i = 1, 7
          labels(i) = ''
          if (.not. extractfirstword(aline, labels(i), ' ')) goto 222
       enddo
222    continue
      else		!! no data file
	goto 777 
      endif
      
 
c      write (*,*) 'Data file is:', file_data(1:ilen(file_data))
c      write (*,*) 'Buffer files is: ', file_bufin(1:ilen(file_bufin))
      
      
      do i = 1, qd_scanpts
cObsolete      do i = 1, data_nscan
c   1.8000  0.0000  0.0000  24.0000  8.00510    5.95          21
	if (labels(5) .eq. 'T-act') then 
          read (unitdata, *, err=668, end=768)
     &		 qx_data(i), qy_data(i), qz_data(i),
     &		e_data(i), tmp_data(i), minutes_data(i), cnts_data(i)	
        else
          read (unitdata, *, err=668, end=768)
     &		 qx_data(i), qy_data(i), qz_data(i),
     &		e_data(i), minutes_data(i), cnts_data(i)	
	endif
cOK        write (*,*) 'read=', qx_data(i), qy_data(i), qz_data(i),
cOK     &		e_data(i), tmp_data(i), minutes_data(i), cnts_data(i)	
cc            h(i)=hc(i)+(k-(float(npts)+1.0)/2.0)*hs(i)
c        qmag_data(i)=sqrt(qx_data(i)**2 +qy_data(i)**2 +qz_data(i)**2)
        if (i .eq. 1) then
c	  Qdata_max = Qmag_data(i)
c	  Qdata_min = Qmag_data(i)
	  Edata_max = E_data(i)
	  Edata_min = E_data(i)
	else
c	  if (Qdata_max .gt. Qmag_data(i))  Qdata_max = Qmag_data(i)
c	  if (Qdata_min .lt. Qmag_data(i))  Qdata_min = Qmag_data(i)
	  if (Edata_max .lt. E_data(i))  Edata_max = E_data(i)
	  if (Edata_min .gt. E_data(i))  Edata_min = E_data(i)
	endif
cOK        write (*,*) 'read2=', qx_data(i), qy_data(i), qz_data(i),
COK     &		e_data(i), tmp_data(i), minutes_data(i), cnts_data(i)	
      enddo

      close (UNIT=unitdata)
      
      input_data = .true.
      plotdata = .true.

cDebug      do i = 1, data_nscan
cDebug        write (*,*) 'write1:', qx_data(i), qy_data(i), qz_data(i),
cDebug     &		e_data(i), tmp_data(i), minutes_data(i), cnts_data(i)	
cDebug      enddo

cDebug      write (*,*) 'input_data:  Edata_min,Edata_max =', 
cDebug     &	      Edata_min,  Edata_max  

cDebug      do i = 1, data_nscan
cDebug        write (*,*) 'write2:',qx_data(i), qy_data(i), qz_data(i),
cDebug     &		e_data(i), tmp_data(i), minutes_data(i), cnts_data(i)	
cDebug      enddo
cDebug      write (*,*) 'end  of data.'

c      write (*,*) 'input_data:  Edata_min,Edata_max =', 
c     &	      Edata_min,  Edata_max  

      goto 999
      
 668  write (*,*) 'input_data: Error reading data. Line', i
cccc 668  write (*,*) 'input_data: Error line containing data', i
      goto 777

 671  write (*,*) 'input_data: Can not open data file: ', 
     &		file_bufin(1:ilen(file_bufin))
      goto 777

 672  write (*,*) 'input_data: Error skipping header, line ', i
      goto 777

 673  write (*,*) 'input_data: Error reading column labels, line ', 12
      goto 777

 768  write (*,*) 'input_data: Premature end to data, pt=', i,
     &		' Expected # of scanpts=', qd_scanpts 	
      goto 777

 772  write (*,*) 'input_data: Premature end to header line ', i
      goto 777

 777  input_data = .false.      	      
 999  return
      end
