/usr/share/gnudatalanguage/astrolib/irafrd.pro is in gdl-astrolib 2018.02.16+dfsg-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 | pro irafrd,im,hd,filename, SILENT=silent ;Read in IRAF image array and header array
;+
; NAME:
; IRAFRD
; PURPOSE:
; Read an IRAF (.imh) file into IDL image and header arrays.
; EXPLANATION:
; The internal IRAF format changed somewhat in IRAF V2.11 to a machine
; independent format, with longer filename allocations. This version
; of IRAFRD should be able to read either format.
;
; CALLING SEQUENCE:
; IRAFRD, im, hdr, filename, [/SILENT ]
;
; OPTIONAL INPUT:
; FILENAME - Character string giving the name of the IRAF image
; header. If omitted, then program will prompt for the
; file name. IRAFRD always assumes the header file has an
; extension '.imh'. IRAFRD will automatically locate the
; ".pix" file containing the data by parsing the contents of
; the .imh file. (If the parse is unsuccesful, then IRAFRD looks
; in the same directory as the .imh file.)
; OUTPUTS:
; IM - array containing image data
; HDR - string array containing header. Basic information in the
; IRAF header is converted to a FITS style header
;
; OPTIONAL INPUT KEYWORDS:
; /SILENT - If this keyword is set and non-zero, then messages displayed
; while reading the image will be suppressed.
;
; RESTRICTIONS:
; (1) Image size and history sections of the IRAF header are copied
; into the FITS header HDR. Other information (e.g. astrometry)
; might not be included unless it is also in the history section
; (2) IRAFRD ignores the node name when deciphering the name of the
; IRAF ".pix" file.
; (3) Certain FITS keywords ( DATATYPE, IRAFNAME) may appear more than
; once in the output name
; (4) Does not read the DATE keyword for the new (V2.11) IRAF files
; NOTES:
; IRAFRD obtains dimensions and type of image from the IRAF header.
;
; PROCEDURES CALLED:
; FDECOMP, SXADDPAR, SXPAR()
;
; MODIFICATION HISTORY:
; Written W. Landsman, STX January 1989
; Converted to IDL Version 2. M. Greason, STX, June 1990
; Updated for DecStation compatibility W. Landsman March 1992
; Don't leave an open LUN W. Landsman July 1993
; Don't overwrite existing OBS-DATE W. Landsman October 1994
; Don't bomb on very long FITS headers W. Landsman April 1995
; Work on Alpha/OSF and Linux W. Landsman Dec 1995
; Remove /VMSIMG keyword, improve efficiency when physical and
; image dimensions differ W. Landsman April 1996
; Don't use FINDFILE (too slow) W. Landsman Oct 1996
; Read V2.11 files, remove some parameter checks W. Landsman Nov. 1997
; Fixed problem reading V2.11 files with long headers Jan. 1998
; Accept names with multiple extensions W. Landsman April 98
; Test for big endian machine under V2.11 format W. Landsman Feb. 1999
; Don't read past the end of file for V5.4 compatilibity W.L. Jan. 2001
; Convert to square brackets W.L May 2001
; Assume since V5.4, remove SPEC_DIR() W. L. April 2006
;-
On_error,2 ;Return to caller
compile_opt idl2
npar = N_params()
if ( npar EQ 0 ) then begin
print,'Syntax - IRAFRD, im, hdr, [filename, /SILENT ]'
return
endif
if ( npar EQ 3 ) then $
if ( N_elements(filename) EQ 0 ) then message, $
'Third parameter (IRAF Header file name) must be a character string' $
else begin
file_name = filename
goto,FINDER
endelse
file_name = '' ;Get file name if not supplied
read,'Enter name of IRAF data file (no quotes): ',file_name
if ( file_name EQ '' ) then return
FINDER:
fdecomp, file_name, disk, dir, name, ext, ver
IF ext EQ 'imh' THEN fname = file_name ELSE fname = file_name + '.imh'
openr, lun1, fname, /GET_LUN, ERROR = error ;Open the IRAF header file
if error NE 0 then $
message, 'Unable to find IRAF header file '+ FILE_EXPAND_PATH(fname)
; Get image size and name from IRAF header
irafver = bytarr(5)
readu, lun1, irafver
newformat = string(irafver) EQ 'imhv2'
big_endian = is_ieee_big()
if newformat then begin
hdrsize = 2048
doffset = 2048
endif else begin
hdrsize = 572
doffset = 1024
endelse
point_lun, lun1, 0 ;Back to top of the header
tmp = assoc(lun1,bytarr(hdrsize))
hdr = tmp[0]
hdr2 = hdr
if not newformat then begin ;Old format is not machine independent
if not big_endian then begin
byteorder,hdr,/sswap
byteorder,hdr,/lswap
endif
hdrlen = fix(hdr,12) ;Length (in words) of header
datatype = fix(hdr,16) ;IRAF datatype
ndim = fix(hdr,20) ;Number of dimensions
if ( ndim GT 5 ) then $
message,'Too stupid to do more than 5 dimensions'
if (ndim EQ 0) then message,'IRAF file contains no data (NAXIS = 0)'
dimen = long(hdr2,24,ndim) ;Get vector of image dimensions
physdim = long(hdr2,52,ndim) ;Get vector of physical dimensions
if big_endian then pixname = string( hdr[412+indgen(80)*2] ) else $
pixname = string( hdr2[413+indgen(80)*2] )
endif else begin
hdrlen = long(hdr,6) ;Length (in words) of header
datatype = fix(hdr,12) ;IRAF datatype
ndim = fix(hdr,20) ;Number of dimensions
if big_endian then begin
byteorder,hdrlen,/NTOHL
byteorder,datatype,/NTOHS
byteorder,ndim,/NTOHS
endif
if ( ndim GT 7 ) then $
message,'Too stupid to do more than 7 dimensions'
if (ndim EQ 0) then message,'IRAF file contains no data (NAXIS = 0)'
dimen = long(hdr,22,ndim) ;Get vector of image dimensions
physdim = long(hdr,50,ndim) ;Get vector of physical dimensions
if big_endian then begin
byteorder,dimen,/NTOHL
byteorder,physdim, /NTOHL
endif
pixname = string(hdr[126:126+255])
endelse
expos = strpos(pixname,'!')
pixname = strmid(pixname,expos+1,strlen(pixname))
expos = strpos(pixname,'!')
pixname = strmid(pixname,expos+1,strlen(pixname))
if strmid(pixname,0,4) eq 'HDR$' then begin
if disk + dir EQ '' then begin
cd, CURRENT = curdir
curdir = curdir + path_sep()
endif else curdir = disk+dir
pixname = curdir + strmid(pixname,4,strlen(pixname))
endif
; Use file name found in header to open .pix file. If this file is not
; found then look for a .pix file in the same directory as the header
openr, lun2, pixname, ERROR=err, /GET_LUN ; ...on given directory
if ( err LT 0 ) then begin
openr,lun2, name + '.pix', ERROR = err, /GET_LUN
if ( err LT 0 ) then goto, NOFILE
endif
if ~keyword_set(SILENT) then begin
sdim = strtrim(dimen[0],2)
message,'Now reading '+strjoin(sdim,' by ') + $
' IRAF array', /INFORM
endif
; Convert from IRAF data types to IDL data types
CASE datatype OF
1: begin & dtype = 1 & bitpix = 8 & end ;Byte
3: begin & dtype = 2 & bitpix = 16 & end ;Integer*2
4: begin & dtype = 3 & bitpix = 32 & end ;Integer*4
5: begin & dtype = 3 & bitpix = 32 & end ;Integer*4
6: begin & dtype = 4 & bitpix = -32 & end ;Real*4
7: begin & dtype = 5 & bitpix = -64 & end ;Real*8
11: begin &dtype = 3 & bitpix = 16 & end ;Integer*2
else: message,'Unknown Datatype Code ' + strtrim(datatype,2)
endcase
; Read the .pix file, skipping the first 1024 bytes. The last physical
; dimension can be set equal to the image dimension.
physdim[ndim-1] = dimen[ndim-1]
tmp = assoc (lun2, make_array(DIMEN = physdim, TYPE= dtype, /NOZERO), doffset)
im = tmp[0]
; If the physical dimension of an IRAF image is larger than the image size,
; then extract the appropriate subimage
dimen = dimen - 1
pdim = physdim - 1
case ndim of
1 :
2 : if dimen[0] LT pdim[0] then im = im[ 0:dimen[0], *]
3 : if total(dimen LT pdim) then im = im[ 0:dimen[0], 0:dimen[1], * ]
4 : if total(dimen LT pdim) then $
im = im[ 0:dimen[0], 0:dimen[1], 0:dimen[2], * ]
5 : if total(dimen LT pdim) then $
im = im[ 0:dimen[0], 0:dimen[1], 0:dimen[2], 0:dimen[3], *]
6: if total(dimen LT pdim) then $
im = im[ 0:dimen[0], 0:dimen[1], 0:dimen[2], 0:dimen[3], $
0:dimen[4], *]
7: if total(dimen LT pdim) then $
im = im[ 0:dimen[0], 0:dimen[1], 0:dimen[2], 0:dimen[3], $
0:dimen[4], 0:dimen[5], *]
endcase
hd = strarr(ndim + 5) + string(' ',format='(a80)') ;Create empty FITS hdr
hd[0] = 'END' + string(replicate(32b,77))
sxaddpar, hd, 'SIMPLE', 'T',' Read by IDL: '+ systime()
sxaddpar, hd, 'BITPIX', bitpix
sxaddpar, hd, 'NAXIS', ndim ;# of dimensions
if ( ndim GT 0 ) then $
for i = 1, ndim do sxaddpar,hd,'NAXIS' + strtrim(i,2),dimen[i-1]+1
sxaddpar,hd,'irafname',name + '.imh' ;Add history records
if ( hdrlen GT 513 ) then begin ;Add history records
if newformat then nfits = (hdrlen*2l - 2049)/81 else $
nfits = (hdrlen*4l - 2054)/162
tmp = assoc(lun1,bytarr(hdrlen*4l < (fstat(lun1)).size ))
hdr = tmp[0]
if not newformat then if not big_endian then byteorder, hdr, /SSWAP
SKIP1:
if newformat then $
object = string( hdr[638 + indgen(67)] ) else $
object = string( hdr[732 + indgen(67)*2] )
if (object NE '') then $
sxaddpar, hd, 'OBJECT', object,' Object Name' ;Add object name
endline = where( strmid(hd,0,8) EQ 'END ')
endline = endline[0]
endfits = hd[endline]
hd = [ hd[0:endline-1], strarr(nfits+1) ]
if newformat then begin
index = indgen(80)
for i = 0l,nfits-1 do $
hd[endline+i] = string( hdr[2046 + 81*i + index] )
endif else begin
index = indgen(80)*2
for i = 0l,nfits-1 do $
hd[endline+i] = string( hdr[ 2052 + 162*i + index] )
endelse
hd[endline + nfits] = endfits ;Add back END keyword
if not newformat then begin
history = string(hdr[ 892 + indgen(580)*2] )
st1 = gettok( history, string(10B))
if big_endian then $
origin = gettok( strmid( st1, 1, strlen(st1)),"'") else $
origin = gettok( strmid( st1, 0, strlen(st1)),"'")
sxaddpar, hd, 'ORIGIN', origin, ' ', 'IRAFNAME' ; Add 'ORIGIN" record
test = sxpar(hd,'HISTORY', Count = N)
if N EQ 0 then begin
while (strpos(history,string(10B)) GE 0) do begin
hist_rec = gettok( history, string(10B) ) ; Add history comment strings
sxaddpar, hd, 'HISTORY', hist_rec
endwhile
endif
endif
endif
free_lun,lun1,lun2
return ;Successful return
NOFILE:
message,'Unable to find IRAF pixel file ' + pixname,/CON
free_lun,lun1
return
end
|