; Copyright (c) 1998-2008 A.P. Hitchcock  All rights reserved
;+
;NAME:
;	WRITE_XAS
;
;LAST CHANGED: ----------------------------------- 04-Jun-08
;
;PURPOSE:
;	This procedure writes a spectrum into 'XAS' format, with
; optional guided writing of the header paramaters
;
;CATEGORY:
;	STAND ALONE:  spectral processing
;
;CALLING SEQUENCE:
; 	WRITE_XAS_WRAP
;
;CALLED FROM AXIS:
;	Write-XAS spectrum
;
;ROUTINES
;	WRITE_XAS_WRAP
;	WRITE_XAS - routine that actually writes data (many keywords!)
;
;INPUTS:
;	lun		logical unit number
;	header	header array
;	info	request for information about routine
; for WRITE_XAS
;	filename - name of file
;	ev		energy array
;	data	intensity array
;	header	header
;
;KEYWORDS:
;	none for write_xas_wrap
;
;	for WRITE_XAS:
;   formula		= chemical formula of sample
;	common_name	= common_name of sample
;	edge		= edge
;	acquisition_mode = acquisition_mode
;	source_purity = source_purity
;	comments 	= comments 				; multiple lines
;	delta_ev	= energy resolution
;	yaxis		= yaxis label
;	contact_person = contact_person
;	journal		= journal
;	authors		= authors
;	title		= title
;	volume		= volume
;	issue_number = issue_number
;	year		= year
;	pages		= pages
;	booktitle	= booktitle
;	editors		= editors
;	publisher	= publisher
;	address		= address
;	help		= help
;
;OUTPUTS:
;	File written in XAS format
;
;COMMON BLOCKS:
;	none
;
;MODIFICATION HISTORY:
; file obtained from Jacobsen Feb-98; developed from Mancini / Hitchcock format
; (26-sep-00 aph) AXIS standard documentation
; (22-May-08 aph) add multi-column write for ISEELS & polymer database
; (04-jun-08 aph) add handling of ISEELS and NSLS headers
;-

PRO write_xas_wrap, lun, header, info
; wrapper for Jacobsen's write_xas (APH)
;; This routine expects to get the header without leading stars

IF (n_params() LT 2) THEN BEGIN
    return
ENDIF ELSE IF (n_params() EQ 2) THEN BEGIN
    remaining_line = header
ENDIF ELSE BEGIN
    IF (n_elements(info) NE 0) THEN BEGIN
        remaining_line = header+info
    ENDIF ELSE BEGIN
        remaining_line = header
    ENDELSE
ENDELSE

wrote_header = 0
WHILE (strlen(remaining_line) GE 70) DO BEGIN
    chopped_line = strmid(remaining_line,0,75)
    space_pos = rstrpos(chopped_line,' ')
    IF (space_pos EQ (-1)) THEN BEGIN
        ;; puzzled so just put it out
        IF (wrote_header NE 0) THEN BEGIN
            printf, lun, '*  '+remaining_line
        ENDIF ELSE BEGIN
            printf, lun, '* '+remaining_line
            wrote_header = 1
        ENDELSE
        return
    ENDIF ELSE BEGIN
        chopped_line = strmid(remaining_line,0,space_pos)
        remaining_line = strmid(remaining_line,(space_pos+1),$
                                (strlen(remaining_line)-space_pos))
        IF (wrote_header NE 0) THEN BEGIN
            printf, lun, '*  '+chopped_line
        ENDIF ELSE BEGIN
            printf, lun, '* '+chopped_line
            wrote_header = 1
        ENDELSE
    ENDELSE
ENDWHILE

IF (strlen(remaining_line) NE 0) THEN BEGIN
    IF (wrote_header NE 0) THEN BEGIN
        printf, lun, '*  '+remaining_line
    ENDIF ELSE BEGIN
        printf, lun, '* '+remaining_line
        wrote_header = 1
    ENDELSE
ENDIF

return
END

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

PRO write_xas, filename, ev, data, header, iseels=iseels, $
         formula=formula, $
         common_name=common_name, $
         edge=edge, $
         acquisition_mode=acquisition_mode, $
         source_purity=source_purity, $
         comments=comments, $
         delta_ev=delta_ev, $
         yaxis=yaxis, $
         contact_person=contact_person, $
         journal=journal, $
         authors=authors, $
         title=title, $
         volume=volume, $
         issue_number=issue_number, $
         year=year, $
         pages=pages, $
         booktitle=booktitle, $
         editors=editors, $
         publisher=publisher, $
         address=address, $
         help=help

IF ((n_params() lt 2) OR keyword_set(help)) THEN BEGIN
    print, 'write_xas, filename, ev, data, [header]'
    print, "  Options to set header fields (NSLS): '
    print, "    formula='', common_name='', edge='', "
    print, "    acquisition_mode='', source_purity='', comments='', "
    print, "    delta_ev='', yaxis='', contact_person='', journal='', "
    print, "    authors='', title='', volume='', issue_number='', "
    print, "    year='', pages='', booktitle='', editors='', "
    print, "    publisher='', address=''"
    return
ENDIF

data_size = size(data)
n_ev = n_elements(ev)
n_data = 0
multi_spectra=0
CASE data_size(0) OF
    0: BEGIN
        print,'Data should be an array, not a scaler.  Nothing done.'
        return
    END

    1: BEGIN
        IF (data_size(1) NE n_ev) THEN BEGIN
            print,'Sizes of arrays "ev" and "data" do not match.  '+$
              'Nothing done.'
            return
        ENDIF
        n_data = 1
        my_data = reform(data,1,n_ev)
    END

    2: BEGIN
        IF (data_size(2) NE n_ev) THEN BEGIN
            print,'Sizes of arrays "ev" and "data" do not match.  '+$
              'Nothing done.'
            return
        ENDIF
        n_data = data_size(1)
        my_data = data
    END
    ELSE: BEGIN
		multi_spectra= data_size(0)-2
        axis_log,'Data array contains ' + strtrim(string(multi_spectra),2) + ' columns'
        return
    ENDELSE
ENDCASE

IF (n_ev LE 1) THEN BEGIN
    print,'No data to write; nothing done.'
    return
ENDIF

get_lun,lun
on_ioerror,bailout
openw,lun,filename

; differentiate NSLS from ISEELS header format

if keyword_set(iseels) then begin
	printf, lun,$
	'*********************  Core Excitation Data  ********************'
	printf, lun,$
	'****************  A.P. Hitchcock & D.C. Mancini  ****************'
	printf, lun, '*'

	names=tag_names(header)
	FOR i = 0, n_tags(header)-1 do begin
		write_xas_wrap,lun, names(i), ': '+header.(i)+' '
	ENDFOR											; last entry is name string
	printf, lun, '*--------------------------------------------------------------'
	printf, lun, '* No. of Spectra: ', fix(n_data),'  ', header.File_names
	printf, lun, '*   E (eV)        Raw data             Osc. Str. per atom (E-2)'
	printf, lun,'*--------------------------------------------------------------'

endif else begin

	my_header = {header,$
	             formula: '',common_name: '',edge: '',$
	             acquisition_mode: '',source_purity: '',comments: '',$
	             delta_ev: '',min_ev: '',max_ev: '',yaxis: '', $
	             contact_person: '',write_date: '',journal: '',$
	             authors: '',title: '',volume: '',$
	             issue_number: '',year: '',pages: '',$
	             booktitle: '',editors: '',publisher: '',$
	             address: ''}

	IF (n_tags(header) NE n_tags(my_header)) THEN BEGIN
	    header = my_header
	ENDIF

	header.min_ev =  strtrim(string(min(ev), format='(f12.3)'), 2)
	header.max_ev =  strtrim(string(max(ev), format='(f12.3)'), 2)

	IF keyword_set(formula) THEN $
	  header.formula = strtrim(string(formula),2)
	IF keyword_set(common_name) THEN $
	  header.common_name = strtrim(string(common_name),2)
	IF keyword_set(edge) THEN $
	  header.edge = strtrim(string(edge),2)
	IF keyword_set(acquisition_mode) THEN $
	  header.acquisition_mode = strtrim(string(acquisition_mode),2)
	IF keyword_set(source_purity) THEN $
	  header.source_purity = strtrim(string(source_purity),2)
	IF keyword_set(comments) THEN $
	  header.comments = strtrim(string(comments),2)
	IF keyword_set(delta_ev) THEN $
	  header.delta_ev = strtrim(string(delta_ev),2)
	IF keyword_set(yaxis) THEN $
	  header.yaxis = strtrim(string(yaxis),2)
	IF keyword_set(contact_person) THEN $
	  header.contact_person = strtrim(string(contact_person),2)
	IF keyword_set(journal) THEN $
	  header.journal = strtrim(string(journal),2)
	IF keyword_set(authors) THEN $
	  header.authors = strtrim(string(authors),2)
	IF keyword_set(title) THEN $
	  header.title = strtrim(string(title),2)
	IF keyword_set(volume) THEN $
	  header.volume = strtrim(string(volume),2)
	IF keyword_set(issue_number) THEN $
	  header.issue_number = strtrim(string(issue_number),2)
	IF keyword_set(year) THEN $
	  header.year = strtrim(string(year),2)
	IF keyword_set(pages) THEN $
	  header.pages = strtrim(string(pages),2)
	IF keyword_set(booktitle) THEN $
	  header.booktitle = strtrim(string(booktitle),2)
	IF keyword_set(editors) THEN $
	  header.editors = strtrim(string(editors),2)
	IF keyword_set(publisher) THEN $
	  header.publisher = strtrim(string(publisher),2)
	IF keyword_set(address) THEN $
	  header.address = strtrim(string(address),2)

	; We have to figure out the date in dd-mmm-yyyy format
	date_array = bin_date(systime())
	day_string = strtrim(string(date_array(2),format='(i2)'),2)
	IF (strlen(day_string) EQ 1) THEN BEGIN
	    day_string = '0'+day_string
	ENDIF
	months = ['JAN','FEB','MAR','APR','MAY','JUN','JUL',$
	          'AUG','SEP','OCT','NOV','DEC']
	month_string = months(date_array(1)-1)
	header.write_date = day_string+'-'+month_string+'-'+$
	  string(date_array(0),format='(i4)')

	printf, lun,$
	  '*********************  X-ray Absorption Data  ********************'
	printf, lun,'*'
	write_xas_wrap,lun,'Formula: ',header.formula
	write_xas_wrap,lun,'Common name: ',header.common_name
	write_xas_wrap,lun,'Edge: ',header.edge
	write_xas_wrap,lun,'Acquisition mode: ',header.acquisition_mode
	write_xas_wrap,lun,'Source and purity: ',header.source_purity
	write_xas_wrap,lun,'Comments: ',header.comments
	write_xas_wrap,lun,'Delta eV: ',header.delta_ev
	write_xas_wrap,lun,'Min eV: ',header.min_ev
	write_xas_wrap,lun,'Max eV: ',header.max_ev
	write_xas_wrap,lun,'Y axis: ',header.yaxis
	write_xas_wrap,lun,'Contact person: ',header.contact_person
	write_xas_wrap,lun,'Write date: ',header.write_date
	write_xas_wrap,lun,'Journal: ',header.journal
	write_xas_wrap,lun,'Authors: ',header.authors
	write_xas_wrap,lun,'Title: ',header.title
	write_xas_wrap,lun,'Volume: ',header.volume
	write_xas_wrap,lun,'Issue number: ',header.issue_number
	write_xas_wrap,lun,'Year: ',header.year
	write_xas_wrap,lun,'Pages: ',header.pages
	write_xas_wrap,lun,'Booktitle: ',header.booktitle
	write_xas_wrap,lun,'Editors: ',header.editors
	write_xas_wrap,lun,'Publisher: ',header.publisher
	write_xas_wrap,lun,'Address: ',header.address
	printf, lun,'*--------------------------------------------------------------'
ENDELSE
tab_char = string(byte(9))

IF multi_spectra EQ 0 THEN BEGIN
	FOR i_ev=0,(n_ev-1) DO BEGIN
	    output_string = ' '+string(ev(i_ev),format='(g14.6)')
	    FOR i_data = 0, (n_data-1) DO BEGIN
	        output_string = output_string+tab_char+' '+$
	          string(my_data(i_data,i_ev),format='(g14.6)')
	    ENDFOR
	    printf, lun,output_string
	ENDFOR
ENDIF ELSE BEGIN		; multi-column write
	dformat = strtrim(string(multi_spectra),2) +'(g14.6)'
	FOR i_ev=0,(n_ev-1) DO BEGIN
	    output_string = ' '+string(ev(i_ev),format=dformat)
		FOR j=0,multi_spectra-1 DO BEGIN
		    FOR i_data = 0, (n_data-1) DO BEGIN
		        output_string = output_string+tab_char+' '+$
		          string(my_data(i_data+j,i_ev),format='(g14.6)')
		    ENDFOR
		ENDFOR
	    printf, lun,output_string
	ENDFOR
ENDELSE

bailout:
close,lun
free_lun,lun

return
END
