c ########################################################################
c  Copyright (c) 1991  Siemens Analytical X-ray Instruments (SAXI)
c                      6300 Enterprise Lane
c                      Madison, WI 53719 USA          All rights reserved.
c ########################################################################
c
c RAW_AT$3.FOR primitives for reading and writing to raw data in the
c   DIFFRAC-AT file formats, either version 1 or 2. These routines will
c   automatically convert PC IEEE binary format to native format upon
c   the DIFFRAC_AT file IO.
c
c Version 1.0 F77L3                   18Feb91 -- KLS
c Version 1.1 F77L3                   04Jun91 -- KLS
c   Added support for Diffrac AT / V2 file structure
c Version 1.2 F77L                    05Nov91 -- HEC
c   Set ier to -2 for range not found
c
*+
c raw_diffat_read - reads a single range of a standard DIFFRACT-AT file.
c       The DIFFRAC-AT file is in binary PC format and is converted to
c       native binary format upon reading each record.
c
	integer function raw_diffat_read ( rawfile, nrange, raw, angbeg,
     &     angend, anginc, wave, time, title)
	implicit none
	character*(*) rawfile   !(R) Input file name
	integer nrange          !(R) Range number
	real raw(*)             !(W) Intensity array
	real angbeg             !(W) Starting angle
	real angend             !(W) Ending angle
	real anginc             !(W) Step width (angle increment)
	real wave(3)            !(W) Wavelengths (avg, a1, a2)
	real time               !(W) Scan time in seconds
	character*(*) title     !(W) Title
*-
	character str4*4, tmpstr*32
	integer ier, jer, lun, i, j, iopen
	integer npts, irange, rec0
c
c Input file must exist
	lun = iopen (rawfile, '*.raw', 'OLD', 'DIRECT',
     &    'UNFORMATTED', 4, 0, ier)
	if (ier.ne.0) goto 90
c
c Verify the file is a DIFF-AT *.RAW file
	read (lun,rec=1) str4    !identifier
	if (str4.ne.'RAW ' .and. str4.ne.'PRO ') then
	   call prg_set_error_string('Invalid DIFFRAC-AT file')
	   ier = -1
	   goto 90
	end if
c
c Skip to requested range
	read (lun,rec=39) irange
	if (irange+1.lt.nrange) then
	   call prg_set_error_string('Requested range not found')
	   ier = -2
	   goto 90
	end if
	rec0 = 0
	do 05 i=1,nrange-1
	   read (lun,rec=1+rec0) str4
	   if (str4.ne.'RAW ' .and. str4.ne.'PRO ') rec0 = rec0 -1
	   read (lun,rec=2+rec0) npts
	   rec0 = 39 + npts + rec0
   05   continue
c
c Read little-endian IEEE floating point format
	read (lun,rec=1+rec0) str4       !optional header line
	if (str4.ne.'RAW ' .and. str4.ne.'PRO ') rec0 = rec0 -1
	read (lun,rec=2+rec0) npts       !no of counts
	read (lun,rec=3+rec0) time       !count time for 1st range
	read (lun,rec=4+rec0) anginc     !step size in degrees
	read (lun,rec=7+rec0) angbeg     !2é starting angle
	angend = angbeg + (npts-1) * anginc
        j = 1
	do 10 i=11,18
	   read (lun,rec=i+rec0) tmpstr(j:j+3)!sample name
           j = j + 4
   10   continue
        title = tmpstr
	read (lun,rec=19+rec0) wave(2)  !Ka1 wavelength
	read (lun,rec=20+rec0) wave(3)  !Ka2 wavelength or 0 if monochr.
	do 30 i=1,npts
	   read (lun,rec=39+i+rec0) raw(i)      !counts
   30   continue
c
c Default Kavg wavelength
	wave(1) = wave(2)               !Kavg = Ka1
	if (abs(wave(2)-1.54056).lt.0.01) wave(1) = 1.54184 ! CuKavg
	if (abs(wave(2)-0.70930).lt.0.01) wave(1) = 0.71069 ! MoKavg
	if (abs(wave(2)-2.28970).lt.0.01) wave(1) = 2.29092 ! CrKavg
	if (abs(wave(2)-1.93604).lt.0.01) wave(1) = 1.93728 ! FeKavg
	if (abs(wave(2)-1.78897).lt.0.01) wave(1) = 1.79021 ! CoKavg
c
   90   call iclose (lun, jer)
	if (ier.eq.0) ier = jer
	raw_diffat_read = ier
	return
	end
*+
c RAW_DIFFAT_WRITE - writes a single range to a DIFFRAC-AT format file in 
c       native PC binary format.
c
	integer function raw_diffat_write ( rawfile, append, raw,
     &     angbeg, angend, anginc, wave, time, title)
	implicit none
	character*(*) rawfile   !(R) Output file name
	integer append          !(R)non-zero to append data to existing file
	real raw(*)             !(R) Intensity array
	real angbeg             !(R) Starting angle
	real angend             !(R) Ending angle
	real anginc             !(R) Step width (angle increment)
	real wave(3)            !(R) Wavelengths (avg, a1, a2)
	real time               !(R) Scan time in seconds
	character*(*) title     !(R) Title
*-
	character str4*4, tmpstr*32
	integer ier, lun, i, j, jer, iopen
	integer npts, iskip, rec0
	logical*4 ondisk
	real skip
c
	ier = 0
	if (rawfile(1:1).eq.' ') goto 9999
c
c Default to '*.raw" extension
        call dfltext(rawfile, '.raw', rawfile)
c
c Or creating new file? (SVS cannot use ENDFILE on *.RAW files)
	ondisk = .FALSE.
	if (append.ne.0) then
          inquire (file=rawfile, exist=ondisk)
        else
          call delfil$p(rawfile, ' ', ier)
        end if
c
	lun = iopen (rawfile, '*.raw', 'UNKNOWN', 'DIRECT',
     &    'UNFORMATTED', 4, 0, ier)
	if (ier.ne.0) goto 90
c
c Find end of file
	rec0 = 0
	if (ondisk) then
	   read (lun,rec=39) iskip
	   iskip = iskip + 1             !appending, increment range counter
	   write (lun,rec=39) iskip      ! and store
	   do 05 i=1,iskip
	      read (lun,rec=1+rec0) str4
	      if (str4.ne.'RAW ' .and. str4.ne.'PRO ') rec0 = rec0 - 1
	      read (lun,rec=2+rec0) npts
	      rec0 = 39 + npts + rec0
   05      continue
	end if
c
	write (lun,rec=1+rec0) 'RAW '    !identifier
	npts = 1 + nint( (angend - angbeg) / anginc )
	write (lun,rec=2+rec0) npts      !no of counts
	write (lun,rec=3+rec0) time      !count time for 1st range
	write (lun,rec=4+rec0) anginc    !step size in degrees
	iskip = 0
	write (lun,rec=5+rec0) iskip     !DACO-MP code - not used
	write (lun,rec=6+rec0) iskip     !sample position - 0=not used
	write (lun,rec=7+rec0) angbeg    !2é starting angle
	skip = 0.0
	write (lun,rec=8+rec0) skip      !é starting angle (omega)
	write (lun,rec=9+rec0) skip      !chi starting angle
	write (lun,rec=10+rec0) skip     !phi starting angle
        tmpstr = title
        j = 1
	do 10 i=11,18
	   write (lun,rec=i+rec0) tmpstr(j:j+3)!sample name
           j = j + 4
   10   continue
	write (lun,rec=19+rec0) wave(2)  !Ka1 wavelength
	write (lun,rec=20+rec0) wave(3)  !Ka2 wavelength or 0 if monochromator
	do 20 i=21,38
	   write (lun,rec=i+rec0) iskip  !unused
   20   continue
	write (lun,rec=39+rec0) iskip    !0=single range
	do 30 i=1,npts
	   write (lun,rec=39+i+rec0) raw(i)     !counts
   30   continue
c
c Truncate and close or just close data file
cSVS	if (append.eq.0) endfile (unit=lun, iostat=ier)
   90   call iclose (lun, jer)
	if (ier.eq.0) ier = jer
 9999   raw_diffat_write = ier
	return
	end
*+
c raw_profile_read - reads a single profile from a SQUID profile file (which is
c       a special format of a DIFFRAC-AT type file)
c
	integer function raw_profile_read ( rawfile, nrange, raw,
     &     angbeg, angend, anginc, wave, time, title,
     &     jrange, ttheta, fwhm, offset)
	implicit none
	character*(*) rawfile   !(R) Input file name
	integer nrange          !(R) Range number
	real raw(*)             !(W) Intensity array
	real angbeg             !(W) Starting angle
	real angend             !(W) Ending angle
	real anginc             !(W) Step width (angle increment)
	real wave(3)            !(W) Wavelengths (avg, a1, a2)
	real time               !(W) Scan time in seconds
	character*(*) title     !(W) Title
	integer jrange          !(W) Total number of profiles in file
	real ttheta             !(W) Two-theta of peak in profile
	real fwhm               !(W) fwhm of profile
	real offset             !(W) offset of peak from Imax
*-
	character str4*4, tmpstr*32
	integer ier, jer, lun, i, j, iopen
	integer npts, irange, rec0
c
c Input file must exist
	lun = iopen (rawfile, '*.pro', 'OLD', 'DIRECT',
     &    'UNFORMATTED', 4, 0, ier)
	if (ier.ne.0) goto 90
c
c Verify the file is a SQUID *.PRO file
	read (lun,rec=1) str4    !identifier
	if (str4.ne.'PRO ') then
	   call prg_set_error_string('Invalid PROFILE file')
	   ier = -1
	   goto 90
	end if
c
c Skip to requested range
	read (lun,rec=39) irange
	if (irange+1.lt.nrange) then
	   call prg_set_error_string('Requested range not found')
	   ier = -2
	   goto 90
	end if
	rec0 = 0
	do 05 i=1,nrange-1
	   read (lun,rec=2+rec0) npts
	   rec0 = 39 + npts + rec0
   05   continue
c
c Read file
	read (lun,rec=2+rec0) npts       !no of counts
	read (lun,rec=3+rec0) time       !count time for 1st range
	read (lun,rec=4+rec0) anginc     !step size in degrees
	read (lun,rec=7+rec0) angbeg     !2é starting angle
	angend = angbeg + (npts-1) * anginc
        j = 1
	do 10 i=11,18
	   read (lun,rec=i+rec0) tmpstr(j:j+3)!sample name
           j = j + 4
   10   continue
        title = tmpstr
	read (lun,rec=19+rec0) wave(2)  !Ka1 wavelength
	read (lun,rec=20+rec0) wave(3)  !Ka2 wavelength or 0 if monochromator
c
c Variables specific to profile files
	jrange = irange + 1             !Total number of profiles in file
	read (lun,rec=29+rec0) ttheta   !Two-theta of peak in profile
	read (lun,rec=30+rec0) fwhm     !FWHM of peak in profile
	read (lun,rec=31+rec0) offset   !Offset of peak in profile from Imax
c
c Read profile data
	do 30 i=1,npts
	   read (lun,rec=39+i+rec0) raw(i)      !counts
   30   continue
c
c Default Kavg wavelength
	wave(1) = wave(2)               !Kavg = Ka1
	if (abs(wave(2)-1.54056).lt.0.01) wave(1) = 1.54184 ! CuKavg
	if (abs(wave(2)-0.70930).lt.0.01) wave(1) = 0.71069 ! MoKavg
	if (abs(wave(2)-2.28970).lt.0.01) wave(1) = 2.29092 ! CrKavg
	if (abs(wave(2)-1.93604).lt.0.01) wave(1) = 1.93728 ! FeKavg
	if (abs(wave(2)-1.78897).lt.0.01) wave(1) = 1.79021 ! CoKavg
c
   90   call iclose (lun, jer)
	if (ier.eq.0) ier = jer
	raw_profile_read = ier
	return
	end
*+
c RAW_PROFILE_WRITE - write a single profile to a SQUID profile file.
c   *.PRO profile lineshape files MUST be stored with all profiles in
c   ascending two-theta order. Thus appending may actually insert a profile.
c
	integer function raw_profile_write ( rawfile, append, raw,
     &     angbeg, angend, anginc, wave, time, title,
     &     ttheta, fwhm, offset)
	implicit none
	character*(*) rawfile   !(R) Output file name
	integer append          !(R)non-zero to append data to existing file
	real raw(*)             !(R) Intensity array
	real angbeg             !(R) Starting angle
	real angend             !(R) Ending angle
	real anginc             !(R) Step width (angle increment)
	real wave(3)            !(R) Wavelengths (avg, a1, a2)
	real time               !(R) Scan time in seconds
	character*(*) title     !(R) Title
	real ttheta             !(R) Two-theta of peak in profile
	real fwhm               !(R) fwhm of peak in profile
	real offset             !(R) offset of peak from Imax
*-
        character tmpstr*32
	integer ier, lun, i, j, jer, iopen, irange
	integer npts, iskip, rec0, lrec, byte4
	logical*4 ondisk
	real skip, pro_ttheta
c
	if (rawfile(1:1).eq.' ') return
c
c Default to '*.pro" extension
        call dfltext(rawfile, '.pro', rawfile)
c
c Or creating new file? (SVS cannot use ENDFILE on *.RAW files)
	rec0 = 0
	if (append.ne.0) then
	   inquire (file=rawfile, exist=ondisk)
	   if (ondisk) rec0 = 4
        else
           call delfil$p(rawfile, ' ', ier)
	end if
c
	lun = iopen (rawfile, '*.pro', 'UNKNOWN', 'DIRECT',
     &    'UNFORMATTED', 4, 0, ier)
	if (ier.ne.0) goto 90
c
	lrec = 0                         !last record in profile file
	irange = 0                       !number of subsequent ranges
	if (rec0.gt.0) then
	   read (lun,rec=39) irange
	   irange = irange + 1           !appending, increment range counter
	   rec0 = 0                      !record to store profile
	   do 05 i=1,irange
	      write (lun,rec=39+lrec) irange     !store new # of ranges
	      read (lun,rec=2+lrec) npts
	      read (lun,rec=29+lrec) pro_ttheta  !Two-theta of peak in profile
	      lrec = 39 + npts + lrec
	      if (ttheta.ge.pro_ttheta) rec0 = lrec
   05      continue
	end if
c
c Inserting a profile?
	if (lrec.gt.rec0) then
	  npts = 1 + nint( (angend - angbeg) / anginc )
	  npts = 39 + npts
	  do i=lrec,rec0+1,-1
	    read (lun,rec=i) byte4
	    write(lun,rec=i+npts) byte4
	  end do
	end if
c
c Write SQUID *.pro file in PC floating point format (IEEE little-endian)
	write (lun,rec=1+rec0) 'PRO '    !identifier
	npts = 1 + nint( (angend - angbeg) / anginc )
	write (lun,rec=2+rec0) npts      !no of counts
	write (lun,rec=3+rec0) time      !count time for 1st range
	write (lun,rec=4+rec0) anginc    !step size in degrees
	iskip = 0
	write (lun,rec=5+rec0) iskip     !DACO-MP code - not used
	write (lun,rec=6+rec0) iskip     !sample position - 0=not used
	write (lun,rec=7+rec0) angbeg    !2é starting angle
	skip = 0.0
	write (lun,rec=8+rec0) skip      !é starting angle (omega)
	write (lun,rec=9+rec0) skip      !chi starting angle
	write (lun,rec=10+rec0) skip     !phi starting angle
        tmpstr = title
        j = 1
	do 10 i=11,18
	   write (lun,rec=i+rec0) tmpstr(j:j+3)!sample name
	   j = j + 4
   10   continue
	write (lun,rec=19+rec0) wave(2)  !Ka1 wavelength
	write (lun,rec=20+rec0) wave(3)  !Ka2 wavelength or 0 if monochromator
	do 20 i=21,28
	   write (lun,rec=i+rec0) iskip  !unused
   20   continue
c
c Variables specific to profile files
	write (lun,rec=29+rec0) ttheta   !Two-theta of peak in profile
	write (lun,rec=30+rec0) fwhm     !FWHM of peak in profile
	write (lun,rec=31+rec0) offset   !Offset of peak in profile from Imax

	write (lun,rec=39+rec0) irange   !0=single range
	do 30 i=1,npts
	   write (lun,rec=39+i+rec0) raw(i)     !counts
   30   continue
c
c Truncate and close or just close data file
cSVS	if (append.eq.0) endfile (unit=lun, iostat=ier)
   90   call iclose (lun, jer)
	if (ier.eq.0) ier = jer
	raw_profile_write = ier
	return
	end
*+
c RAW_PROFILE_DELETE
	integer function raw_profile_delete ( rawfile, nrange)
	implicit none
	character*(*) rawfile   !(R) Output file name
	integer nrange          !(R) Range number to delete
*-
	character str4*4, default*8
	integer i, ier, irange, lun, npts, rec0, rec1, lrec, ientry, jer
	integer*4 byte4
c
	integer iopen, raw_diffat_delete
c
	ientry = 0
	default = '*.pro'
	goto 10
*+
	entry raw_diffat_delete (rawfile, nrange)
c       character*(*) rawfile   !(R) Output file name
c       integer nrange          !(R) Range number to delete
*-
	ientry = 1
	default = '*.raw'
c
c Input file must exist
10      lun = iopen (rawfile, default, 'OLD', 'DIRECT',
     &    'UNFORMATTED', 4, 0, ier)
	if (ier.ne.0) goto 90
c
c Verify the file is a SQUID *.PRO or DIFFAT *.RAW file
	read (lun,rec=1) str4    !identifier
	if (ientry.eq.0 .and. str4.ne.'PRO ') then
	   call prg_set_error_string('Invalid PROFILE file')
	   ier = -1
	   goto 90
	end if
	if (ientry.eq.1 .and. str4.ne.'RAW ') then
	   call prg_set_error_string('Invalid RAW V1 file')
	   ier = -1
	   goto 90
	end if
c
c Is requested range present?
	read (lun,rec=39) irange
	if (irange+1.lt.nrange) then
	   call prg_set_error_string('Requested range not found')
	   ier = -2
	   goto 90
	end if
c
c Trivial case: deleting first and only range in file. This will truncate file
c to zero length
	if (irange.eq.0 .and. nrange.eq.1) then
	   read (lun,rec=1) str4
	   backspace (unit=lun, iostat=ier)
	   endfile (unit=lun, iostat=ier)
	   goto 90
	end if
c
c Skip to requested range: rec0 = start of range to delete
	rec0 = 0
	rec1 = 0
	lrec = 0
	do 05 i=1,irange+1
	   read (lun,rec=1+rec0) str4
	   if (str4.ne.'RAW ' .and. str4.ne.'PRO ') rec0 = rec0 -1
	   read (lun,rec=2+rec0) npts
	   lrec = 39 + npts + lrec
	   if (i.eq.nrange-1) rec0 = lrec
	   if (i.eq.nrange) rec1 = lrec
   05   continue
c
c Delete requested range. Copy later range records and set end-of-file marker.
	npts = rec1 - rec0              !number of records in range to delete
	do i=rec1+1, lrec
	  read (lun,rec=i) byte4
	  write(lun,rec=i-npts) byte4
	end do
	read(lun,rec=lrec-npts) byte4   !last valid data in file
	endfile (unit=lun, iostat=ier)
c
c Update number of ranges
	irange = irange - 1
	write (lun,rec=39) irange
c
c Finished
   90   call iclose (lun, jer)
	if (ier.eq.0) ier = jer
   99   if (ientry.eq.0) then
	  raw_profile_delete = ier
	else
	  raw_diffat_delete = ier
	end if
	return
	end
*+
c raw_diffat_v2_read - reads a single range of a standard DIFFRACT-AT file.
c       The DIFFRAC-AT V2 file is in binary PC format and is converted to
c       native binary format upon reading each record.
c
c       This code is INTEL specific! Do not attempt to compile under any other
c       computer system. (only little-endian, IEEE floating type machines)
c
	integer function raw_diffat_v2_read ( rawfile, nrange, raw,
     &     angbeg, angend, anginc, target, wave, time, title)
	implicit none
	character*(*) rawfile   !(R) Input file name
	integer nrange          !(R) Range number
	real raw(*)             !(W) Intensity array
	real angbeg             !(W) Starting angle
	real angend             !(W) Ending angle
	real anginc             !(W) Step width (angle increment)
	character*2 target      !(W) X-ray target material
	real wave(3)            !(W) Wavelengths (avg, a1, a2)
	real time               !(W) Scan time in seconds
	character*(*) title     !(W) Title
*-
c        integer FACILITY
c        parameter (FACILITY = 1303)

	integer*2 irange, ibytes, npts
	integer ier, jer, lun, i, j, rec0, nb, nbytes
c
	integer err_iostat$p, seq_open$p, seq_read$p
c       integer makecode
c
c Equate character buffer with byte buffer
        logical*1 ibuf(256)
        character cbuf*256
        equivalence (cbuf(1:1), ibuf(1))
c
c Input file must exist
	lun = seq_open$p(rawfile, '*.raw', 'OLD', 0, ier)
	if (ier.ne.0) goto 90
c
c Read the entire file header: 256-bytes
        nb = seq_read$p(lun, ibuf, 256, ier)
	if (ier.ne.0) goto 90
c
c Verify the file is a DIFF-AT V2 *.RAW file
        if (cbuf(1:4).ne.'RAW2') then
c           ier = makecode(1, FACILITY)  !Invalid DIFFRAC-AT V2 file
	   call prg_set_error_string('Invalid DIFFRAC-AT V2 file')
	   ier = -1
           goto 90
        end if
c
c Check number of ranges
        call memcpy$p(irange, ibuf(5), 2)
	if (irange.lt.nrange) then
c           ier = makecode(2, FACILITY)
	   call prg_set_error_string('Requested range not found')
	   ier = -2
	   goto 90
	end if
c
c Read main header block variables
	j = min( 160, len(title) )
        title(1:j) = cbuf(8+1:8+j)  !sample name, etc.
c
c Read target and Ka1, Ka2 wavelengths
        target = cbuf(189:190)
        call memcpy$p(wave(2), ibuf(191), 4)
        call memcpy$p(wave(3), ibuf(195), 4)
c
c Default Kavg wavelength
	wave(1) = wave(2)               !Kavg = Ka1
	if (abs(wave(2)-1.54056).lt.0.01) wave(1) = 1.54184 ! CuKavg
	if (abs(wave(2)-0.70930).lt.0.01) wave(1) = 0.71069 ! MoKavg
	if (abs(wave(2)-2.28970).lt.0.01) wave(1) = 2.29092 ! CrKavg
	if (abs(wave(2)-1.93604).lt.0.01) wave(1) = 1.93728 ! FeKavg
	if (abs(wave(2)-1.78897).lt.0.01) wave(1) = 1.79021 ! CoKavg
c
c Skip to requested range header block
        rec0 = 256
	do 05 i=1,nrange-1
           nb = seq_read$p(lun, ibytes, 2, ier)
           if (ier.ne.0) goto 90
           nb = seq_read$p(lun, npts, 2, ier)
           if (ier.ne.0) goto 90
	   rec0 = rec0 + ibytes + 4 * npts
           call seq_seek$p(lun, rec0, ier)
           if (ier.ne.0) goto 90
   05   continue
c
c Read range header block variables
        nb = seq_read$p(lun, ibuf, 60, ier)
	if (ier.ne.0) goto 90
        call memcpy$p(ibytes, ibuf(1), 2)   ! # of bytes in range header
        call memcpy$p(npts, ibuf(3), 2)     ! # of counts in range
        call memcpy$p(time, ibuf(9), 4)     ! count time for range
        call memcpy$p(anginc, ibuf(13), 4)  ! step size in degrees
        call memcpy$p(angbeg, ibuf(17), 4)  ! 2T starting angle
	angend = angbeg + (npts-1) * anginc
c
c Range header might be longer than the 60 bytes minimum
c Skip the supplementary range information bytes
        rec0 = rec0 + ibytes
        call seq_seek$p(lun, rec0, ier)
c
c Read data block counts
        nbytes = 4 * npts
        nb = seq_read$p(lun, raw, nbytes, ier)
c
c Exit with error status
   90   call seq_close$p(lun, jer)
	if (ier.eq.0) ier = jer
c        ier = err_iostat$p( ier )
	raw_diffat_v2_read = ier
	return
	end
*+
c RAW_DIFFAT_V2_WRITE - writes a single range to a DIFFRAC-AT V2 format file in
c       native PC binary format.
c
c       This code is INTEL specific! Do not attempt to compile under any other
c       computer system. (only little-endian, IEEE floating type machines)
c
	integer function raw_diffat_v2_write ( rawfile, append, raw,
     &     angbeg, angend, anginc, target, wave, time, title)
	implicit none
	character*(*) rawfile   !(R) Output file name
	integer append          !(R)non-zero to append data to existing file
	real raw(*)             !(R) Intensity array
	real angbeg             !(R) Starting angle
	real angend             !(R) Ending angle
	real anginc             !(R) Step width (angle increment)
	character*2 target      !(R) X-ray target material
	real wave(3)            !(R) Wavelengths (avg, a1, a2)
	real time               !(R) Scan time in seconds
	character*(*) title     !(R) Title
*-
c        integer FACILITY
c        parameter (FACILITY = 1303)

	integer*2 irange, ibytes, npts
	integer ier, jer, lun, i, j, rec0, nb, nbytes
	logical*4 ondisk
c
	integer err_iostat$p, seq_open$p, seq_read$p, seq_write$p
c        integer makecode
c
c Equate character buffer with byte buffer
        logical*1 ibuf(256)
        character cbuf*256
        equivalence (cbuf(1:1), ibuf(1))
c
c Filename must be specified
	ier = 0
	if (rawfile(1:1).eq.' ') goto 9999
c
c Default to '*.raw" extension
        call dfltext(rawfile, '.raw', rawfile)
c
c Creating a new file (append=0) will pre-delete any existing file
	inquire (file=rawfile, exist=ondisk)
        if (ondisk .and. append.eq.0) then
           ! Only delete file if existing file is DIFFRAC-V2 file type
  	   lun = seq_open$p(rawfile, '*.raw', 'UNKNOWN', 0, ier)
	   if (ier.ne.0) goto 90
           nb = seq_read$p(lun, ibuf, 4, ier)
           if (cbuf(1:4).ne.'RAW2') then
c             ier = makecode(1, FACILITY)
              ier = -1
              call prg_set_error_string
     &           ('Cannot overwrite a non-DIFFRAC-V2 file')
              goto 90
           end if
           call seq_close$p(lun, ier)
           call delfil$p(rawfile, ' ', ier)
           ondisk = .FALSE.
	end if
c
c Open existing or new file for output
	lun = seq_open$p(rawfile, '*.raw', 'UNKNOWN', 0, ier)
	if (ier.ne.0) goto 90
c
c For existing files, verify file type and skip to end of last range
	if (ondisk) then
           ! Verify file is DIFFRAC-V2 file type
           nb = seq_read$p(lun, ibuf, 4, ier)
           if (ier.ne.0) goto 90
           if (cbuf(1:4) .ne. 'RAW2') then
c             ier = makecode(1, FACILITY)
              ier = -1
              call prg_set_error_string
     &           ('Cannot overwrite a non-DIFFRAC-V2 file')
              goto 90
           end if

           ! Skip to end of last range data block (end of file)
           nb = seq_read$p(lun, irange, 2, ier) ! # of ranges in file
           if (ier.ne.0) goto 90
           rec0 = 256       ! file header is 256-bytes long
           call seq_seek$p(lun, rec0, ier)
           if (ier.ne.0) goto 90
	   do 05 i = 1, irange                      ! skip all ranges
             nb = seq_read$p(lun, ibytes, 2, ier)   ! # bytes in range header
             if (ier.ne.0) goto 90
             nb = seq_read$p(lun, npts, 2, ier)     !# counts in range data blk
             if (ier.ne.0) goto 90
	     rec0 = rec0 + ibytes + 4 * npts        !# of bytes for file offset
             call seq_seek$p(lun, rec0, ier)        !Position file pointer
             if (ier.ne.0) goto 90
   05      continue
c
c New files must create entire file header block.
        else
           call memclr$p(ibuf, 0, 256)          ! Pre-clear header bytes
           cbuf(1:4) = 'RAW2'                   ! Identification string
	   irange = 1                           ! # of ranges in file
           call memcpy$p(ibuf(5), irange, 2)    ! Place in header block
	   j = min( 160, len(title) )           ! Length of title string
           cbuf(8+1:8+j) = title(1:j)           ! Place in header block
           cbuf(8+j+1:188) = ' '                ! Clear with spaces
           cbuf(189:190) = target               ! Anode element in hdr block
           call memcpy$p(ibuf(191), wave(2), 4) ! Alpha-1 into header block
           call memcpy$p(ibuf(195), wave(3), 4) ! Alpha-2 into header block
           nb = seq_write$p(lun, ibuf, 256, ier)! Write header block to disk
           if (ier.ne.0) goto 90
	end if
c
c Write range header block variables
        ibytes = 60
	npts = 1 + nint( (angend - angbeg) / anginc )
        call memclr$p(ibuf, 0, 60)          ! clear range header
        call memcpy$p(ibuf(1), ibytes, 2)   ! # of bytes in range header
        call memcpy$p(ibuf(3), npts, 2)     ! # of counts in ranges
        call memcpy$p(ibuf(9), time, 4)     ! count time for range
        call memcpy$p(ibuf(13), anginc, 4)  ! step size in degrees
        call memcpy$p(ibuf(17), angbeg, 4)  ! 2T starting angle
        nbytes = ibytes
        nb = seq_write$p(lun, ibuf, nbytes, ier)
        if (ier.ne.0) goto 90
c
c Write data block counts
        nbytes = 4 * npts                   ! # of bytes in range data block
        nb = seq_write$p(lun, raw, nbytes, ier)
        if (ier.ne.0) goto 90
c
c Update number of ranges within the file (for appending option)
        if (ondisk) then
	   irange = irange + 1              ! Increment # of ranges counter
           call seq_seek$p(lun, 4, ier)     ! Position file pointer
           if (ier.ne.0) goto 90
           nb = seq_write$p(lun, irange, 2, ier)    ! Update # ranges in file
           if (ier.ne.0) goto 90
        end if
c
c Close data file and return error status
   90   call seq_close$p(lun, jer)
	if (ier.eq.0) ier = jer
c        ier = err_iostat$p(ier)
c
c Finished, exit with error status
 9999   raw_diffat_v2_write = ier
	return
	end