PRO FXBOPEN, UNIT, FILENAME0, EXTENSION, HEADER, NO_TDIM=NO_TDIM, $ ERRMSG=ERRMSG, ACCESS=ACCESS, REOPEN=REOPEN ;+ ; NAME: ; FXBOPEN ; Purpose : ; Open binary table extension in a disk FITS file for reading or updating ; Explanation : ; Opens a binary table extension in a disk FITS file for reading. The ; columns are then read using FXBREAD, and the file is closed when done ; with FXBCLOSE. ; Use : ; FXBOPEN, UNIT, FILENAME, EXTENSION [, HEADER ] ; Inputs : ; FILENAME = Name of FITS file to be opened. Optional ; extension *number* may be specified, in either of ; the following formats (using the FTOOLS ; convention): FILENAME[EXT] or FILENAME+EXT, where ; EXT is 1 or higher. Such an extension ; specification takes priority over EXTENSION. ; ; EXTENSION = Either the number of the FITS extension, starting with the ; first extension after the primary data unit being one; or a ; character string containing the value of EXTNAME to search ; for. ; Opt. Inputs : ; None. ; Outputs : ; UNIT = Logical unit number of the opened file. ; Opt. Outputs: ; HEADER = String array containing the FITS binary table extension ; header. ; Keywords : ; NO_TDIM = If set, then any TDIMn keywords found in the header are ; ignored. ; ; ACCESS = A scalar string describing access privileges as ; one of READ ('R') or UPDATE ('RW'). ; DEFAULT: 'R' ; ; REOPEN = If set, UNIT must be an already-opened file unit. ; FXBOPEN will treat the file as a FITS file. ; ; ERRMSG = If defined and passed, then any error messages will be ; returned to the user in this parameter rather than ; depending on the MESSAGE routine in IDL. If no errors are ; encountered, then a null string is returned. In order to ; use this feature, ERRMSG must be defined first, e.g. ; ; ERRMSG = '' ; FXBOPEN, ERRMSG=ERRMSG, ... ; IF ERRMSG NE '' THEN ... ; ; Calls : ; FXBFINDLUN, FXBPARSE, FXHREAD, FXPAR ; Common : ; Uses common block FXBINTABLE--see "fxbintable.pro" for more ; information. ; Restrictions: ; The file must be a valid FITS file. ; Side effects: ; None. ; Category : ; Data Handling, I/O, FITS, Generic. ; Prev. Hist. : ; W. Thompson, Feb 1992, based on READFITS by J. Woffard and W. Landsman. ; W. Thompson, Feb 1992, changed from function to procedure. ; W. Thompson, June 1992, fixed up error handling. ; Written : ; William Thompson, GSFC, February 1992. ; Modified : ; Version 1, William Thompson, GSFC, 12 April 1993. ; Incorporated into CDS library. ; Version 2, William Thompson, GSFC, 27 May 1994 ; Added ERRMSG keyword. ; Version 3, William Thompson, GSFC, 21 June 1994 ; Extended ERRMSG to call to FXBPARSE ; Version 4, William Thompson, GSFC, 23 June 1994 ; Modified so that ERRMSG is not touched if not defined. ; Version 4, 23 June 1994 ; Converted to IDL V5.0 W. Landsman September 1997 ; ; Added ACCESS, REOPEN keywords, and FXFILTER package, CM 1999 Feb 03 ; Added FILENAME[EXT] and FILENAME+EXT extension parsing, CM 1999 Jun 28 ; Some general tidying, CM 1999 Nov 18 ; ;- ; @fxbintable ON_ERROR, 2 ; ; Check the number of parameters. ; IF N_PARAMS() LT 3 THEN BEGIN MESSAGE = 'Syntax: FXBOPEN, UNIT, FILENAME, EXTENSION ' + $ '[, HEADER ]' IF N_ELEMENTS(ERRMSG) NE 0 THEN BEGIN ERRMSG = MESSAGE RETURN END ELSE MESSAGE, MESSAGE ENDIF ; ; Check the type of the EXTENSION parameter. ; IF N_ELEMENTS(EXTENSION) NE 1 THEN BEGIN MESSAGE = 'EXTENSION must be a scalar' IF N_ELEMENTS(ERRMSG) NE 0 THEN BEGIN ERRMSG = MESSAGE RETURN END ELSE MESSAGE, MESSAGE ENDIF SZ = SIZE(EXTENSION) ETYPE = SZ[SZ[0]+1] IF ETYPE EQ 8 THEN BEGIN MESSAGE = 'EXTENSION must not be a structure' IF N_ELEMENTS(ERRMSG) NE 0 THEN BEGIN ERRMSG = MESSAGE RETURN END ELSE MESSAGE, MESSAGE ENDIF ; ; If EXTENSION is of type string, then search for the proper extension by ; name. Otherwise, search by number. ; IF ETYPE EQ 7 THEN BEGIN S_EXTENSION = STRTRIM(STRUPCASE(EXTENSION),2) END ELSE BEGIN I_EXTENSION = FIX(EXTENSION) IF I_EXTENSION LT 1 THEN BEGIN MESSAGE = 'EXTENSION must be greater than zero' IF N_ELEMENTS(ERRMSG) NE 0 THEN BEGIN ERRMSG = MESSAGE RETURN END ELSE MESSAGE, MESSAGE ENDIF ENDELSE ; ; Check access parameter IF N_ELEMENTS(ACCESS) EQ 0 THEN ACCESS='R' SZ = SIZE(ACCESS) IF SZ[SZ[0]+1] NE 7 THEN GOTO, ACCERR IF STRUPCASE(ACCESS) NE 'R' AND STRUPCASE(ACCESS) NE 'RW' THEN BEGIN ACCERR: MESSAGE = "ACCESS must be either 'R' or 'RW'" IF N_ELEMENTS(ERRMSG) NE 0 THEN BEGIN ERRMSG = MESSAGE RETURN END ELSE MESSAGE, MESSAGE ENDIF ; ; Establish the read/write state ; ST = 1 ; Read only IF STRUPCASE(ACCESS) EQ 'RW' THEN ST = 2 ; Read/write ; ; Get a logical unit number, and open the file. ; FILENAME = FILENAME0 IF NOT KEYWORD_SET(REOPEN) THEN BEGIN ;; Check for extension name at the end of a filename LEN = STRLEN(FILENAME0) NEWEXT = 0L BFILENAME = BYTE(FILENAME) B0 = (BYTE('0'))(0) & B9 = (BYTE('9'))(0) I = LEN-1 BB = BFILENAME[I] ;; First case: FILENAME[5] IF LEN GE 4 AND STRING(BB) EQ ']' THEN BEGIN ;; Count backwards I = I - 1 IF BFILENAME[I] GE B0 AND BFILENAME[I] LE B9 THEN BEGIN WHILE I GT 0 AND $ BFILENAME[I] GE B0 AND BFILENAME[I] LT B9 DO I = I - 1 IF I GT 0 AND STRING(BFILENAME[I]) EQ '[' THEN BEGIN NEWEXT = LONG(STRMID(FILENAME,I+1,10)) FLEN = I ENDIF ENDIF ENDIF ;; Second case: FILENAME+5 IF LEN GE 3 AND BB GE B0 AND BB LE B9 THEN BEGIN ;; Count backwards WHILE I GT 0 AND $ BFILENAME[I] GE B0 AND BFILENAME[I] LT B9 DO I = I - 1 IF I GT 0 AND STRING(BFILENAME[I]) EQ '+' THEN BEGIN NEWEXT = LONG(STRMID(FILENAME,I+1,10)) FLEN = I ENDIF ENDIF IF NEWEXT GT 0 THEN BEGIN FILENAME = STRMID(FILENAME, 0, FLEN) I_EXTENSION = NEWEXT ETYPE = 1 ENDIF ;; Open the file IF ST EQ 1 THEN $ OPENR, UNIT, FILENAME, /BLOCK, /GET_LUN, ERROR=ERROR $ ELSE $ OPENU, UNIT, FILENAME, /BLOCK, /GET_LUN, ERROR=ERROR IF ERROR NE 0 THEN GOTO, NO_SUCH_FILE ENDIF ; ; Reopen the file if requested. Essentially this means seeking to ; the start, after some error checking. ; IF KEYWORD_SET(REOPEN) THEN BEGIN SZ = SIZE(UNIT) IF N_ELEMENTS(UNIT) NE 1 OR SZ[SZ[0]+1] EQ 8 THEN BEGIN MESSAGE = 'UNIT must be a scalar numeric type' IF N_ELEMENTS(ERRMSG) NE 0 THEN BEGIN ERRMSG = MESSAGE RETURN END ELSE MESSAGE, MESSAGE ENDIF ; ; Error checking on file unit ; UNIT = UNIT[0] FS = FSTAT(UNIT) IF (FS.OPEN NE 1) OR (FS.READ NE 1) $ OR (ST EQ 2 AND FS.WRITE NE 1) THEN BEGIN MESSAGE = 'UNIT '+strtrim(unit,2)+' must be open for reading' IF ST EQ 2 THEN MESSAGE = MESSAGE + '/writing' IF N_ELEMENTS(ERRMSG) NE 0 THEN BEGIN ERRMSG = MESSAGE RETURN END ELSE MESSAGE, MESSAGE ENDIF ;; Seek to the start of the file POINT_LUN, UNIT, 0L ENDIF ; ; Store the UNIT number in the common block, and leave space for the other ; parameters. Initialize the common block if need be. ILUN is an index into ; the arrays. ; ILUN = FXBFINDLUN(UNIT) ; ; Mark the file as open for read or write. ; STATE[ILUN] = ST ; ; Read the primary header. ; FXHREAD,UNIT,HEADER,STATUS IF STATUS NE 0 THEN BEGIN FREE_LUN,UNIT MESSAGE = 'Unable to read primary FITS header' IF N_ELEMENTS(ERRMSG) NE 0 THEN BEGIN ERRMSG = MESSAGE RETURN END ELSE MESSAGE, MESSAGE ENDIF I_EXT = 0 ; ; Make sure that the file does contain extensions. ; START = 0L IF NOT FXPAR(HEADER,'EXTEND', START=START) THEN BEGIN FREE_LUN, UNIT MESSAGE = 'File ' + FILENAME + ' does not contain extensions' IF N_ELEMENTS(ERRMSG) NE 0 THEN BEGIN ERRMSG = MESSAGE RETURN END ELSE MESSAGE, MESSAGE ENDIF ; ; Get the number of bytes taken up by the data. ; NEXT_EXT: BITPIX = FXPAR(HEADER,'BITPIX', START=START) NAXIS = FXPAR(HEADER,'NAXIS', START=START) GCOUNT = FXPAR(HEADER,'GCOUNT', START=START) IF GCOUNT EQ 0 THEN GCOUNT = 1 PCOUNT = FXPAR(HEADER,'PCOUNT', START=START) IF NAXIS GT 0 THEN BEGIN DIMS = FXPAR(HEADER,'NAXIS*') ;Read dimensions NDATA = DIMS[0] IF NAXIS GT 1 THEN FOR I=2,NAXIS DO NDATA = NDATA*DIMS[I-1] ENDIF ELSE NDATA = 0 NBYTES = (ABS(BITPIX) / 8) * GCOUNT * (PCOUNT + NDATA) ; ; Read the next extension header in the file. ; NREC = LONG((NBYTES + 2879) / 2880) POINT_LUN, -UNIT, POINTLUN ;Current position MHEAD0 = POINTLUN + NREC*2880L POINT_LUN, UNIT, MHEAD0 ;Next FITS extension FXHREAD,UNIT,HEADER,STATUS IF STATUS NE 0 THEN BEGIN FREE_LUN,UNIT MESSAGE = 'Requested extension not found' IF N_ELEMENTS(ERRMSG) NE 0 THEN BEGIN ERRMSG = MESSAGE RETURN END ELSE MESSAGE, MESSAGE ENDIF I_EXT = I_EXT + 1 ; ; Check to see if the current extension is the one desired. ; START = 0L IF ETYPE EQ 7 THEN BEGIN EXTNAME = STRTRIM(STRUPCASE(FXPAR(HEADER,'EXTNAME', $ START=START)),2) IF EXTNAME EQ S_EXTENSION THEN GOTO, DONE END ELSE IF I_EXT EQ I_EXTENSION THEN GOTO, DONE GOTO, NEXT_EXT ; ; Check to see if the extension type is BINTABLE or A3DTABLE. ; DONE: XTENSION = STRTRIM(STRUPCASE(FXPAR(HEADER,'XTENSION', START=START)),2) IF (XTENSION NE 'BINTABLE') AND (XTENSION NE 'A3DTABLE') THEN BEGIN IF ETYPE EQ 7 THEN EXT = S_EXTENSION ELSE EXT = I_EXTENSION FREE_LUN,UNIT MESSAGE = 'Extension ' + STRTRIM(EXT,2) + $ ' is not a binary table' IF N_ELEMENTS(ERRMSG) NE 0 THEN BEGIN ERRMSG = MESSAGE RETURN END ELSE MESSAGE, MESSAGE ENDIF ; ; Get the rest of the information, and store it in the common block. ; MHEADER[ILUN] = MHEAD0 FXBPARSE,ILUN,HEADER,NO_TDIM=NO_TDIM,ERRMSG=ERRMSG RETURN ; ; Error point for not being able to open the file ; NO_SUCH_FILE: MESSAGE = 'Unable to open file ' + STRTRIM(FILENAME,2) IF N_ELEMENTS(ERRMSG) NE 0 THEN BEGIN ERRMSG = MESSAGE RETURN END ELSE MESSAGE, MESSAGE END