Viewing contents of file '../idllib/ghrs/pro/calhrs_def.pro'
pro calhrs_def,defname,detector,grating,obsdate,aperture,par,log
;+
;*NAME:
;		CALHRS_DEF
;
;*PURPOSE:
; SUBROUTINE OF CALHRS - not standalone user procedure, used to set default
;	reference file names
;
;*PARAMETERS:
; INPUTS:
;	defname - name of text file containing default parameters
;	detector - detector number
;	grating - grating mode
;	obsdate - observations date "DD-MMM-YYYY HH:MM:SS.SS"
;	aperture - target aperture (SC1, SC2, LSA, SSA)
;
; INPUTS/OUTPUTS:
;
;	par - parameter array
;	log - processing log
;
;*NOTES:
; 	File DEFNAME is read to get default file names
;*HISTORY:
;	7-may-1991	JKF/ACC		- resolved UNIX logicals.
;	5-jun-1992	JKF/ACC		- stripe off VAX syntax (zcal:)
;	10-Jun-1992	DJL/ACC	- added BLEMTAB processing
;	01-Dec-1992	DJL/ACC - added ability to select default reference
;				files by grating, detector, aperture and
;				observation time.	
;	23-feb-1993	DJL/ACC - added BCKTAB to defaults.txt
;	7-Sep-1993	JKF/ACC - resolved logical(ZCAL) for non-VMS systems.
;-
; ---------------------------------------------------------------------------

;
; get the default location for logical ZCAL:
;
	dname= defname
	if strpos(defname,':') gt 0 then begin
		loc  = gettok(dname,':') 
	 	location = getlog(loc)
	   end else begin
		location = ''
	end
;
; update processing log
;
	gname = ['   ','G-1','G-2','G-3','G-4','G-5','E-A','E-B','   ', $
		 '   ','   ','   ','   ','   ']
	hist = strarr(2)
	hist(0) = 'CALHRS_DEF Defaults file: '+location+dname
	hist(1) = '    For Detector '+strtrim(detector,2)+' '+gname(grating)+ $
		  ' '+aperture+' Obsdate='+obsdate
	sxaddhist,hist,log
	if !dump gt 0 then printf,!textunit,hist
;
; open file containing default names
;
	get_lun,unit
	openr,unit,strtrim(location+dname,2)
	st=''
;
; read file -----------------------------------------------------------------
;
	filetypes = strarr(500)
	filenames = strarr(500)
	apertures = strarr(500)
	gratings = bytarr(500)
	mjd_start = dblarr(500)
	mjd_stop = replicate(1.0d30,500)
	detectors = bytarr(500)
	n = 0
	while not eof(unit) do begin
	    readf,unit,st
	    st = strtrim(gettok(st,';'),2)
	    if st ne '' then begin
		if strpos(st,'#') eq 0 then begin ;new reference file type?
		    current_type =  $
			strupcase(strtrim(strmid(st,1,strlen(st)-1),2))
		  end else begin
		    filenames(n) = strtrim(gettok(st,','),2)
		    ;
		    ; For non-VMS computers, resolve the full path name
		    ;  for the logical zcal:
		    ;  - JKF/ACC  9/93 - re-inserted for new CALHRS_DEF.
		    ;
		    if !version.os ne 'vms' then begin
			fname= filenames(n)
			location = gettok( fname,':')  ; Look for delimiter
			if strtrim(fname,2) ne '' then begin 
			   path = getlog(location)
			   filenames(n) = path + fname
			end 
		    end

		    filetypes(n) = current_type
		    st = strtrim(st,2)
		    while st ne '' do begin
			value = strtrim(gettok(st,','),2)
			st = strtrim(st,2)
			qualifier = strupcase(strtrim(gettok(value,'='),2))
			value = strupcase(strtrim(value,2))
			if value ne 'ANY' then begin
			    case strmid(qualifier,0,3) of

				'DET': detectors(n) = value
				'GRA': case value of
					'G-1': gratings(n) = 1
					'G-2': gratings(n) = 2
					'G-3': gratings(n) = 3
					'G-4': gratings(n) = 4
					'G-5': gratings(n) = 5
					'E-A': gratings(n) = 6
					'E-B': gratings(n) = 7
					else: begin
					 print,'CALHRS_DEF: invalid grating' + $
						' name specified'
					 retall
					 end
					endcase
				'APE': apertures(n) = value
				'STA': mjd_start(n) = jul_date(value)
				'STO': mjd_stop(n) = jul_date(value)
				else: begin
				  print,'ERROR invalid qualifier, '+qualifier+ $
					'found in default file '+ defname
				  retall
				  end
			    endcase
			endif
		    endwhile
		    n = n+1
		endelse
	    endif
	endwhile
	free_lun,unit

	filetypes = filetypes(0:n-1)
	filenames = filenames(0:n-1)
	apertures = apertures(0:n-1)
	gratings = gratings(0:n-1)
	mjd_start = mjd_start(0:n-1)
	mjd_stop = mjd_stop(0:n-1)
	detectors = detectors(0:n-1)
;
; for each reference file type find default file -----------------------------
;
	reftypes = ['LMAPTAB','SMAPTAB','CCTAB','DCTAB','IATAB','GRATTAB', $
		    'RIPTAB','DQIFILE','DIOFILE','PHCFILE','VIGFILE', $
		    'ABSFILE','WAVFILE','BLEMTAB','BCKTAB']
	par_pos  = [50,51,52,53,55,57,58,60,61,62,63,64,65,66,54]
	mjd = jul_date(obsdate)
	for itype = 0,n_elements(reftypes)-1 do begin
;
; did user supply default?
;
	    ipos = par_pos(itype)
	    if strupcase(par(ipos)) eq 'DEF' then begin
		good = where((filetypes eq reftypes(itype)) and $
			    ((detectors eq '') or (detectors eq detector)) and $
			    ((gratings eq 0) or (gratings eq grating)) and $
			    ((apertures eq '') or (apertures eq aperture)) and $
			    (mjd ge mjd_start) and (mjd le mjd_stop),ngood)

		if ngood lt 1 then begin
		   print,'CALHRS_DEF: no default '+reftypes(itype)+' found'
		   retall
		endif

		if ngood gt 1 then begin
		   print,'CALHRS_DEF: multiple default reference files' + $
			  ' found for '+reftypes(itype)
		   retall
		endif

		par(ipos) = filenames(good(0)) ; set default reference file
	    endif
	endfor	
;
; turn off unrelevant processing flags -------------------------------------
;
	if strupcase(par(50)) eq 'NONE' then par(30) = '0'	;lmaptab
	if strupcase(par(51)) eq 'NONE' then par(30) = '0'	;smaptab
	if strupcase(par(52)) eq 'NONE' then par(39) = '0'	;cctab
	if strupcase(par(53)) eq 'NONE' then par(39) = '0'	;dctab
	if strupcase(par(55)) eq 'NONE' then par(41) = '0'	;iatab
	if strupcase(par(57)) eq 'NONE' then par(43) = '0'	;grattab
	if strupcase(par(58)) eq 'NONE' then par(43) = '0'	;riptab
	if strupcase(par(61)) eq 'NONE' then par(33) = '0'	;diofile
	if strupcase(par(62)) eq 'NONE' then par(36) = '0'	;phcfile
	if strupcase(par(63)) eq 'NONE' then par(37) = '0'	;vigfile
	if strupcase(par(64)) eq 'NONE' then par(44) = '0'	;absfile
	if strupcase(par(65)) eq 'NONE' then par(44) = '0'	;wavfile
;
; when a processing step required for subsequent steps is not performed,
; turn off the subsequent steps.
;
	if fix(par(30)) eq 0 then begin	;MAP
		par(36) = '0'		;	PHC
		par(37) = '0'		;	VIG
		par(39) = '0'		;	ADC
	endif

	if fix(par(32)) eq 0 then begin	;EXP
		par(34) = '0'		;	PPC
		par(44) = '0'		;	ABS
	endif

	if fix(par(39)) eq 0 then begin	;ADC
		par(40) = '0'		;	THM
		par(41) = '0'		;	IAC
		par(44) = '0'		;	ABS
		par(45) = '0'		;	HEL
		par(46) = '0'		;	AIR
	endif
	
	if (grating lt 6) or (grating gt 7) then par(43)='0'	;RIP
return
end