PRO FXBWRITE, UNIT, DATA, COL, ROW, BIT=BIT, NANVALUE=NANVALUE, $ ERRMSG=ERRMSG ;+ ; NAME: ; FXBWRITE ; Purpose : ; Write a binary data array to a disk FITS binary table file. ; Explanation : ; Each call to FXBWRITE will write to the data file, which should already ; have been created and opened by FXBCREATE. One needs to call this ; routine for every column and every row in the binary table. FXBFINISH ; will then close the file. ; Use : ; FXBWRITE, UNIT, DATA, COL, ROW ; Inputs : ; UNIT = Logical unit number corresponding to the file containing the ; binary table. ; DATA = IDL data array to be written to the file. ; COL = Column in the binary table to place data in, starting from ; column one. ; ROW = Row in the binary table to place data in, starting from row ; one. ; Opt. Inputs : ; None. ; Outputs : ; None. ; Opt. Outputs: ; None. ; Keywords : ; BIT = Number of bits in bit mask arrays (type "X"). Only used if ; the column is of variable size. ; NANVALUE= Value signalling data dropout. All points corresponding to ; this value are set to be IEEE NaN (not-a-number). Ignored ; unless DATA is of type float, double-precision or complex. ; 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 = '' ; FXBWRITE, ERRMSG=ERRMSG, ... ; IF ERRMSG NE '' THEN ... ; ; Calls : ; HOST_TO_IEEE ; Common : ; Uses common block FXBINTABLE--see "fxbintable.pro" for more ; information. ; Restrictions: ; The binary table file must have been opened with FXBCREATE. ; ; The data must be consistent with the column definition in the binary ; table header. ; ; The row number must be consistent with the number of rows stored in the ; binary table header. ; ; Side effects: ; None. ; Category : ; Data Handling, I/O, FITS, Generic. ; Prev. Hist. : ; W. Thompson, Jan 1992, based on WRITEFITS by J. Woffard and W. Landsman. ; W. Thompson, Feb 1992, modified to support variable length arrays. ; W. Thompson, Feb 1992, removed all references to temporary files. ; Written : ; William Thompson, GSFC, January 1992. ; Modified : ; Version 1, William Thompson, GSFC, 12 April 1993. ; Incorporated into CDS library. ; Version 2, William Thompson, GSFC, 21 July 1993. ; Fixed bug with variable length arrays. ; Version 3, William Thompson, GSFC, 31 May 1994 ; Added ERRMSG keyword. ; Version 4, William Thompson, GSFC, 23 June 1994 ; Modified so that ERRMSG is not touched if not defined. ; Version 5, Wayne Landsman, GSFC, 12 Aug 1997 ; Recognize IDL double complex data type ; Version : ; Version 5, 12 August 1997 ; Converted to IDL V5.0 W. Landsman September 1997 ;- ; @fxbintable ON_ERROR, 2 ; ; Check the number of parameters. ; IF N_PARAMS() LT 4 THEN BEGIN MESSAGE = 'Syntax: FXBWRITE, UNIT, DATA, COL, ROW' IF N_ELEMENTS(ERRMSG) NE 0 THEN BEGIN ERRMSG = MESSAGE RETURN END ELSE MESSAGE, MESSAGE ENDIF ; ; Find the logical unit number in the FXBINTABLE common block. ; ILUN = WHERE(LUN EQ UNIT,NLUN) ILUN = ILUN[0] IF NLUN EQ 0 THEN BEGIN MESSAGE,'Unit ' + STRTRIM(UNIT,2) + $ ' not opened properly' IF N_ELEMENTS(ERRMSG) NE 0 THEN BEGIN ERRMSG = MESSAGE RETURN END ELSE MESSAGE, MESSAGE ENDIF ; ; Check the row and column parameters against the header. ; IF (COL LT 1) OR (COL GT TFIELDS[ILUN]) THEN BEGIN MESSAGE = 'COL must be between 1 and ' + $ STRTRIM(TFIELDS[ILUN],2) IF N_ELEMENTS(ERRMSG) NE 0 THEN BEGIN ERRMSG = MESSAGE RETURN END ELSE MESSAGE, MESSAGE END ELSE IF (ROW LT 1) OR (ROW GT NAXIS2[ILUN]) THEN BEGIN MESSAGE = 'ROW must be between 1 and ' + $ STRTRIM(NAXIS2[ILUN],2) IF N_ELEMENTS(ERRMSG) NE 0 THEN BEGIN ERRMSG = MESSAGE RETURN END ELSE MESSAGE, MESSAGE ENDIF ; ; Calculate the row and column parameters using IDL zero-based indexing. ; IROW = LONG(ROW) - 1 ICOL = LONG(COL) - 1 ; ; Check the type of the data against that defined for this column. ; SZ = SIZE(DATA) TYPE = SZ[SZ[0]+1] IF TYPE NE IDLTYPE[ICOL,ILUN] THEN BEGIN CASE IDLTYPE[ICOL,ILUN] OF 1: STYPE = 'byte' 2: STYPE = 'short integer' 3: STYPE = 'long integer' 4: STYPE = 'floating point' 5: STYPE = 'double precison' 6: STYPE = 'complex' 7: STYPE = 'string' 9: STYPE = 'double complex' ENDCASE MESSAGE = 'Data type should be ' + STYPE IF N_ELEMENTS(ERRMSG) NE 0 THEN BEGIN ERRMSG = MESSAGE RETURN END ELSE MESSAGE, MESSAGE ENDIF ; ; Check the number of elements, depending on whether or not the column ; contains variable length arrays. ; IF MAXVAL[ICOL,ILUN] GT 0 THEN BEGIN IF N_ELEMENTS(DATA) GT MAXVAL[ICOL,ILUN] THEN BEGIN MESSAGE = 'Data array should have no more than ' + $ STRTRIM(N_ELEM[ICOL,ILUN],2) + ' elements' IF N_ELEMENTS(ERRMSG) NE 0 THEN BEGIN ERRMSG = MESSAGE RETURN END ELSE MESSAGE, MESSAGE ENDIF END ELSE BEGIN IF N_ELEMENTS(DATA) NE N_ELEM[ICOL,ILUN] THEN BEGIN MESSAGE = 'Data array should have ' + $ STRTRIM(N_ELEM[ICOL,ILUN],2) + ' elements' IF N_ELEMENTS(ERRMSG) NE 0 THEN BEGIN ERRMSG = MESSAGE RETURN END ELSE MESSAGE, MESSAGE ENDIF ENDELSE ; ; Find the position of the first byte of the data array in the file. ; OFFSET = NHEADER[ILUN] + NAXIS1[ILUN]*IROW + BYTOFF[ICOL,ILUN] POINT_LUN,UNIT,OFFSET ; ; If a variable length array, then test to see if the array is of type ; double-precision complex (M) or bit (X). ; IF MAXVAL[ICOL,ILUN] GT 0 THEN BEGIN N_ELEM0 = N_ELEMENTS(DATA) IF FORMAT[ICOL,ILUN] EQ "X" THEN BEGIN IF N_ELEMENTS(BIT) EQ 0 THEN BEGIN MESSAGE = 'Number of bits not defined' IF N_ELEMENTS(ERRMSG) NE 0 THEN BEGIN ERRMSG = MESSAGE RETURN END ELSE MESSAGE, MESSAGE END ELSE IF N_ELEMENTS(BIT) NE 1 THEN BEGIN MESSAGE = 'Number of bits must be a scalar' IF N_ELEMENTS(ERRMSG) NE 0 THEN BEGIN ERRMSG = MESSAGE RETURN END ELSE MESSAGE, MESSAGE END ELSE IF LONG((BIT+7)/8) NE N_ELEM0 THEN BEGIN MESSAGE = 'Number of bits does not match ' + $ 'array size' IF N_ELEMENTS(ERRMSG) NE 0 THEN BEGIN ERRMSG = MESSAGE RETURN END ELSE MESSAGE, MESSAGE ENDIF N_ELEM0 = BIT ENDIF ; ; Write out the number of elements, and the pointer to the variable length ; array. ; POINTER = LONARR(2) POINTER[0] = N_ELEM0 POINTER[1] = DHEAP[ILUN] HOST_TO_IEEE,POINTER WRITEU,UNIT,POINTER POINT_LUN,UNIT,NHEADER[ILUN] + HEAP[ILUN] + DHEAP[ILUN] ; ; Update the HEAP pointer. ; CASE TYPE OF 1: DDHEAP = N_ELEMENTS(DATA) ;Byte 2: DDHEAP = N_ELEMENTS(DATA) * 2 ;Short integer 3: DDHEAP = N_ELEMENTS(DATA) * 4 ;Long integer 4: DDHEAP = N_ELEMENTS(DATA) * 4 ;Float 5: DDHEAP = N_ELEMENTS(DATA) * 8 ;Double 6: DDHEAP = N_ELEMENTS(DATA) * 8 ;Complex 7: DDHEAP = N_ELEMENTS(DATA) ;String 9: DDHEAP = N_ELEMENTS(DATA) * 16 ;Dble Complex ENDCASE DHEAP[ILUN] = DHEAP[ILUN] + DDHEAP ENDIF ; ; If a byte array, then simply write out the data. ; IF TYPE EQ 1 THEN BEGIN WRITEU,UNIT,DATA ; ; Otherwise, if a character string array, then write out the character strings ; with the correct width, truncating or padding with blanks as necessary. ; However, if a variable length string array, then simply write it out. ; END ELSE IF TYPE EQ 7 THEN BEGIN IF MAXVAL[ICOL,ILUN] GT 0 THEN BEGIN WRITEU,UNIT,DATA END ELSE BEGIN N_CHAR = N_DIMS[1,ICOL,ILUN] NEWDATA = REPLICATE(32B,N_CHAR,N_ELEMENTS(DATA)) FOR I=0,N_ELEMENTS(DATA)-1 DO $ NEWDATA[0,I] = BYTE(STRMID(DATA[I],0,N_CHAR)) WRITEU,UNIT,NEWDATA ENDELSE ; ; Otherwise, if necessary, then byte-swap the data before writing it out. ; Also, replace any values corresponding data dropout with IEEE NaN. ; END ELSE BEGIN IF (N_ELEMENTS(NANVALUE) EQ 1) AND (TYPE GE 4) AND $ ((TYPE LE 6) OR (TYPE EQ 9)) THEN BEGIN W = WHERE(DATA EQ NANVALUE, COUNT) CASE TYPE OF 4: NAN = FLOAT( REPLICATE('FF'XB,4),0,1) 5: NAN = DOUBLE( REPLICATE('FF'XB,8),0,1) 6: NAN = COMPLEX(REPLICATE('FF'XB,8),0,1) 9: NAN = DCOMPLEX(REPLICATE('FF'XB,16),0,1) ENDCASE END ELSE COUNT = 0 ; NEWDATA = DATA HOST_TO_IEEE, NEWDATA IF COUNT GT 0 THEN NEWDATA[W] = NAN WRITEU,UNIT,NEWDATA ENDELSE ; IF N_ELEMENTS(ERRMSG) NE 0 THEN ERRMSG = '' RETURN END