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