; Copyright (c) 1998-2000 A.P. Hitchcock  All rights reserved 
;+ 
;NAME: 
;	WRITE_XAS 
; 
;LAST CHANGED: ----------------------------------- 26-sep-00 
; 
;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 
;	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 
;- 
 
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, $ 
         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: ' 
    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 
 
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 
        print,'Multidimensional data?  Nothing done.' 
        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 
 
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,'*--------------------------------------------------------------' 
 
tab_char = string(byte(9)) 
 
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 
 
bailout: 
close,lun 
free_lun,lun 
 
return 
END 
