Viewing contents of file '../idllib/iuedac/iuelib/pro/fitslab.pro'
;******************************************************************************
;+
;*NAME:
;
; FITSLAB
;
;*CLASS:
;
; Data Conversion
;
;*CATEGORY:
;
; IUESIPS
;
;*PURPOSE:
;
; To convert the IUE label file to a set of FITS keywords.
; Binary data is converted to hexadecimal notation. Each line of the
; main header (including appendage) is written with a blank keyword.
; The HISTORY keyword is added to each line of the image processing
; history portion of the label.
;
;*CALLING SEQUENCE:
;
; FITSLAB,LAB_FILE,LABEL,FLAB
;
;*PARAMETERS:
;
; LABFILE (REQ) (I) (0) (S)
; Imaget filename for IUE label (.LAB).
;
; LABEL (REQ) (O) (1) (S)
; String array containing IUE label in ASCII format.
;
; FLAB (OPT) (O) (1) (S)
; LABEL with keywords ' ' & 'HISTORY' appropriately
; added at beginning of each line.
;
;*EXAMPLES:
;
; To write ascii version of label into string array LABEL and FITS
; keyword version of label into string array FITSLABEL:
;
; fitslab,'swp32199l.lab',label,fitslabel
;
;*SYSTEM VARIABLES USED:
;
; !iuer.dat
;
;*INTERACTIVE INPUT:
;
; none
;
;*SUBROUTINES CALLED:
;
; PARCHECK
; CHKFITS
; IFITSRD
;
;*FILES USED:
;
; !iuer.dat EBCASC.FIT - - converts EBCDIC to ASCII
;
;*SIDE EFFECTS:
;
;*RESTRICTIONS:
;
; This procedure should only be used with IUESIPS data.
;
;*NOTES:
;
; See the IUE IMAGE HEADER DOCUMENT (Version 2) for more
; information on the contents of the IUE header label.
; Program currently assumes that main label ends in line 100.
; This will not be correct for images with truncated labels,
; or images with added label extensions.
;
;*PROCEDURE:
;
; Reads through label converting each line depending on whether
; it is EBCDIC or binary information. According to the IUE Image
; Header Document (June 1986 version) binary portions in lines
; 33-35, 38-45, and 47-50 were never used and are therefore
; simply treated as blank lines.
;
;*I_HELP nn:
;
;*MODIFICATION HISTORY:
;
; written by R. Thompson 11/27/90 (based on routine READ_LAB).
; 2/6/91 RWT add comments to FLAB as proposed by VILSPA for final
; archive
; 27 Mar 1991 PJL modified for unix/sun; added PARCHECK;
; strings for header must be declared as 80 bytes
; 16 Apr 1991 PJL path to data file
; 23 Apr 1991 GRA added branch for vms file name processing
; 7/24/91 RWT use new multi-cpu logical assignments
; 16 Aug 93 PJL added IFITSRD to read ebscasc.fit (replaces ebcasc.dat)
; 11 Nov 93 PJL added findfile and CHKFITS
; 22 Feb 94 PJL for binary section - uppercase and add leading 0's
; 2 Sep 94 LLT replace IUER_DAT with !iuer.dat
;-
;******************************************************************************
pro fitslab,lab_file,label,flab
;
npar = n_params(0)
if (npar eq 0) then begin
print,'FITSLAB,LAB_FILE,LABEL,flab'
retall
endif ; npar eq 0
parcheck,npar,[2,3],'FITSLAB'
;
; check for existance of lab_file
;
temp = findfile(lab_file,count=count)
if (count eq 0) then begin
print,'File ' + lab_file + ' does not exist.'
print,'ACTION: retall'
retall
endif ; count eq 0
;
; make sure lab_file not fits
;
chkfits,lab_file,newsips,/silent
if (newsips) then begin
print,'The file ' + lab_file + ' appears to be in fits format.'
print,'ACTION: retall'
retall
endif ; newsips
;
; initialize temporary variables
;
tmp = indgen(18)*7
ind = [tmp+5,tmp+6]
ind = ind(sort(ind))
hex = string(bytarr(144)+32b)
hex1 = string(bytarr(72)+32b)
endbytes = string(bytarr(6)+32b)
;
; read in the ebcdic to ascii conversion table
;
ifitsrd,!iuer.dat+'ebcasc.fit',1,nm,exhd,table,/silent
;
; read record 0 for .lab file.
;
openr,unit,lab_file ,/get_lun
h_rec = assoc(unit,intarr(20))
h_line = h_rec(0)
rec = assoc(unit,bytarr(h_line(1))) ; label info.
label = strarr(h_line(2)+60) ; (72 char, no. lines)
;
; convert ebcdic portion (lines 1-50) of label
;
for i=0,49 do begin
templab = string(bytarr(72) + 32b)
strput,templab,string(table(rec(1:72,i+1))) ; 72 char's/line
label(i) = templab
endfor ; i
;
; convert binary portion of label (lines 51-82) to hexadecimal ascii
;
last = 49
j = -1
for i=50,81 do begin
j = j + 2
bin = rec(1:72,i+1) ; read each line as binary data
for n=0,3 do begin ; idl v1.0 bug fix (limited to 18z)
st = 18*n
tmp = bin(st:st+17) ; extract & convert 18 bytes at a time
tmp = byte(string(tmp,'(18z)')) ; convert to hexadecimal integers
tmp = string(tmp(ind)) ; save last 2 of each 7 char. int.
strput,hex,tmp,st*2 ; put back together
endfor ; n
hex = strupcase(hex) ; uppercase characters
;
; put zeroes in the blanks
;
zero = where(bin lt 16,zct)
if (zct gt 0) then for k=0,zct-1 do strput,hex,'0',zero(k)*2
;
strput,endbytes,string(table(bin(66:*))),0 ; save line number & C
strput,hex,endbytes,132 ; add both to end of 2nd line
strput,hex1,strmid(hex,0,66),0
strput,hex1,endbytes,66 ; add line number & C to 1st half
templab = string(bytarr(72) + 32b)
strput,templab,hex1 ; write out bytes 1 - 33 in 1st line
label(last+j) = templab
templab = string(bytarr(72) + 32b)
strput,templab,strmid(hex,66,72) ; write out bytes 34 - 72 in 2nd line
label(last+j+1) = templab
endfor ; i
last = last+j+1
;
; convert ebcdic lines 83-85
;
for i=82,84 do begin
last = last + 1 ; keep track of output line
templab = string(bytarr(72) + 32b)
strput,templab,string(table(rec(1:72,i+1))) ; 72 char's/line
label(last) = templab
endfor ; i
;
; convert binary data in lines 86-100
;
j = -1
for i=85,99 do begin
j = j + 2
bin = rec(1:72,i+1) ; read each line as binary data
for n=0,3 do begin ; idl bug fix (limited to 18z)
st = 18*n ; starting byte
tmp = bin(st:st+17) ; extract & convert 18 bytes at a time
tmp = byte(string(tmp,'(18z)')) ; since 72z wouldn't work!
tmp = string(tmp(ind)) ; save last 2 of each 7 char. int.
strput,hex,tmp,st*2 ; put back together
endfor ; n
hex = strupcase(hex) ; uppercase characters
;
; put zeroes in the blanks
;
zero = where(bin lt 16,zct)
if (zct gt 0) then for k=0,zct-1 do strput,hex,'0',zero(k)*2
;
strput,endbytes,string(table(bin(66:*))),0 ; save line number & C
strput,hex,endbytes,132 ; add both to end of 2nd line
strput,hex1,strmid(hex,0,66),0
strput,hex1,endbytes,66 ; add line number & C to 1st half
templab = string(bytarr(72) + 32b)
strput,templab,hex1 ; write out bytes 1 - 33 in 1st line
label(last+j) = templab
templab = string(bytarr(72) + 32b)
strput,templab,strmid(hex,66,72) ; write out bytes 34 - 72 in 2nd line
label(last+j+1) = templab
endfor ; i
last = last + j + 1
emain = last
;
; convert remaining lines (all in ebcdic)
;
if h_line(2) ge 100 then begin
for i=100,h_line(2)-1 do begin
last = last + 1
templab = string(bytarr(72) + 32b)
strput,templab,string(table(rec(1:72,i+1))) ; 72 char's/line
label(last) = templab
endfor ; i
endif ; h_line(2)
;
free_lun,unit
;
; add fits keywords & comments if requested
;
if (npar eq 3) then begin
flab = strarr(last+8)
tmpflab = string(bytarr(80) + 32b)
strput,tmpflab,'COMMENT *'
flab(0) = tmpflab
tmpflab = string(bytarr(80) + 32b)
strput,tmpflab,'COMMENT * THE IUE VICAR HEADER'
flab(1) = tmpflab
tmpflab = string(bytarr(80) + 32b)
strput,tmpflab,'COMMENT *'
flab(2) = tmpflab
tmpflab = string(bytarr(80) + 32b)
strput,tmpflab,'COMMENT IUE-VICAR HEADER START'
flab(3) = tmpflab
for i=0,emain do begin
tmpflab = string(bytarr(80) + 32b)
strput,tmpflab,string([byte(' '),byte(label(i))])
flab(i+4) = tmpflab
endfor ; i
tmpflab = string(bytarr(80) + 32b)
strput,tmpflab,'COMMENT IUE-VICAR HEADER ENDED'
flab(emain+5) = tmpflab
tmpflab = string(bytarr(80) + 32b)
strput,tmpflab,'HISTORY IUE-LOG STARTED'
flab(emain+6) = tmpflab
for i=emain+1,last do begin
tmpflab = string(bytarr(80) + 32b)
strput,tmpflab,string([byte('HISTORY '),byte(label(i))])
flab(i+6) = tmpflab
endfor ; i
tmpflab = string(bytarr(80) + 32b)
strput,tmpflab,'HISTORY IUE-LOG FINISHED'
flab(last+7) = tmpflab
endif ; npar eq 3
;
return
end ; fitslab