Viewing contents of file '../idllib/ghrs/pro/aipsrd.pro'
pro aipsrd,im,hdr,filename
;+
; NAME
; AIPSRD
; PURPOSE:
; Read an AIP disk image (MAP) file into an IDL image and header arrays
; Use AIPSDIR or AIPSNAME to determine the VAX filename of the desired
; AIPS image.
; CALLLING SEQUENCE:
; AIPSRD,IM,HDR,[FILENAME]
; OPTIONAL INPUT:
; FILENAME - String giving the complete VAX file name (including extension)
; of the AIPS image header file. The first two characters
; of the file name should be 'CB' and the last two should be
; '01'. If a directory is not supplied then AIPSRD uses a
; default directory (currently 'CHAMP$USER5:[AIPS.DATA]').
; OUTPUTS:
; IM - image array with size and dimensions as specified in the AIPS
; catalog header
; HDR - FITS type header array created from values in the AIPS catalog
; header. HDR will NOT include any HISTORY keywords.
; REVISION HISTORY:
; Written W. Landsman March 7, 1989
;-
defdisk = 'CHAMP$USER5:[AIPS.DATA]' ;Default directory to try
if n_params(0) lt 2 then begin
print,'CALLING SEQUENCE - aipsrd,im,hdr,[filename]
return
endif
if n_params(0) lt 3 then begin
filename = ''
read,'Enter VAX file name of AIPS image (including extension)',filename
endif else zparcheck,'AIPSRD',filename,3,7,0,'AIPS image catalog name'
fdecomp,filename,disk,dir,name,ext
if ext eq '' then $
message,'Three letter extension must be included in file name'
;
if strupcase(strmid(name,0,2)) ne 'CB' then $
message,"File name must be for a catalog header ('CB') file"
;
openr,lun,filename,/get_lun,error=err
if ERR lt 0 then message,'Unable to find '+spec_dir(filename)
a=assoc(lun,bytarr(492))
t = a(0)
naxis = fix(t,346)
ndim = fix(t,348,naxis)
crpix = float(t,268,naxis)
crota = float(t,296,naxis)
cdelt = float(t,240,naxis)
crval = float(t,184,naxis)
strput,name,'MA',0
mapname = disk+dir+name+'.'+ext
close,2
openr,2,mapname,/block
case fix(t,362) of
1: x = assoc(2,make_array(/int,dimen=ndim,/nozero))
2: x = assoc(2,make_array(/float,dimen=ndim,/nozero))
3: x = assoc(2,make_array(/double,dimen=ndim,/nozero))
else: message,'AIPSRD - Unrecognized data type'
endcase
IF NOT !QUIET THEN BEGIN
sdim = strtrim(ndim(0),2)
if naxis gt 1 then FOR i = 1,naxis-1 do $
sdim = sdim + ' by ' + strtrim(ndim(i),2) $
else sdim = sdim + ' element'
PRINT,'Now reading ',sdim,' AIPS image'
ENDIF
im = x(0)
mkhdr,hdr,im ;Make a minimal FITS header
imname = string(t(368:379))
if imname ne ' ' then sxaddpar,hdr,'OBJECT',imname
telscop = string(t(8:15))
if telscop ne ' ' then sxaddpar,hdr,'TELESCOP',telscop
observer = string(t(24:31))
if observer ne ' ' then sxaddpar,hdr,'OBSERVER',observer
dateobs = string(t(32:39))
if dateobs ne ' ' then sxaddpar,hdr,'DATE-OBS',dateobs
sxaddpar,hdr,'DATAMAX',float(t,328)
sxaddpar,hdr,'DATAMIN',float(t,332)
epoch = float(t,324)
if epoch ne 0. then sxaddpar,hdr,'EPOCH',epoch
for i=0,naxis-1 do begin
ii = strtrim(i+1,2)
sxaddpar,hdr,'CDELT'+ii,cdelt(i)
sxaddpar,hdr,'CRPIX'+ii,crpix(i)
sxaddpar,hdr,'CRVAL'+ii,crval(i)
sxaddpar,hdr,'CROTA'+ii,crota(i)
endfor
return
return
end