Viewing contents of file '../idllib/astron/contrib/markwardt/fxbreadm.pro'
PRO FXBREADM, UNIT, COL, $
              D0,  D1,  D2,  D3,  D4,  D5,  D6,  D7,  D8,  D9, $
              D10, D11, D12, D13, D14, D15, D16, D17, D18, D19, $
              D20, D21, D22, D23, D24, D25, D26, D27, D28, D29, $
              D30, D31, D32, D33, D34, D35, D36, D37, D38, D39, $
              D40, D41, D42, D43, D44, D45, D46, D47, D48, D49, $
              ROW=ROW, VIRTUAL=VIR, DIMENSIONS=DIM, $
              NOSCALE=NOSCALE, NOIEEE=NOIEEE, $
              NANVALUE=NANVALUE, BUFFERSIZE=BUFFERSIZE, $
              ERRMSG=ERRMSG, WARNMSG=WARNMSG, STATUS=OUTSTATUS

;+
; Project     : RXTE/PCA
;
; Name        : 
;	FXBREADM
; Purpose     : 
;	Read multiple columns/rows from a disk FITS binary table file.
; Explanation : 
;       A call to FXBREADM will read data from multiple rows and
;       multiple columns in a single procedure call.  Up to fifty
;       columns may be read in a single pass; the number of rows is
;       limited essentially by available memory.  The file should have
;       already been opened with FXBOPEN.  FXBREADM optimizes reading
;       multiple columns by first reading a large chunk of data from
;       the FITS file directly, and then slicing the data into columns
;       within memory.  FXBREADM cannot read variable-length arrays;
;       use FXBREAD instead.
; Use         : 
;	FXBREADM, UNIT, COL, DATA1, DATA2, ... [, ROW=ROW ]
; Inputs      : 
;	UNIT	= Logical unit number corresponding to the file containing the
;		  binary table.
;       COL     = An array of columns in the binary table to read data
;                 from, either as character strings containing column
;                 labels (TTYPE), or as numerical column indices
;                 starting from column one.
; Opt. Inputs : 
;       None.
; Outputs     : 
;	D0, ... = A named variable to accept the data values, one for
;                 each column.  The columns are stored in order of the
;                 list in COL.  If the read operation fails for a
;                 particular column, then the corresponding output Dn
;                 variable is not altered.  See the STATUS keyword.
;
; Opt. Outputs: 
;	None.
; Keywords    : 
;	ROW	= Either row number in the binary table to read data from,
;		  starting from row one, or a two element array containing a
;		  range of row numbers to read.  If not passed, then the entire
;		  column is read in.
;	NOSCALE	= If set, then the ouput data will not be scaled using the
;		  optional TSCAL and TZERO keywords in the FITS header.
;		  Default is to scale.
;	VIRTUAL	= If set, and COL is passed as a name rather than a number,
;		  then if the program can't find a column with that name, it
;		  will then look for a keyword with that name in the header.
;		  Such a keyword would then act as a "virtual column", with the
;		  same value for every row.
;	DIMENSIONS = FXBREADM ignores this keyword.  It is here for
;	          compatibility only.
;	NANVALUE= Value signalling data dropout.  All points corresponding to
;		  IEEE NaN (not-a-number) are converted to this 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 = ''
;			FXBREAD, ERRMSG=ERRMSG, ...
;			IF ERRMSG NE '' THEN ...
;       WARNMSG = Messages which are considered to be non-fatal
;                 "warnings" are returned in this  output string.
;       BUFFERSIZE = Raw data are transferred from the file in chunks
;                 to conserve memory.  This is the size in bytes of
;                 each chunk.  If a value of zero is given, then all
;                 of the data are transferred in one pass.  Default is
;                 32768 (32 kB).
;       STATUS  = An output array containing the status for each
;                 column read, 1 meaning success and 0 meaning failure.
;
; Calls       : 
;	IEEE_TO_HOST, FXPAR, WHERENAN
; Common      : 
;	Uses common block FXBINTABLE--see "fxbintable.pro" for more
;	information.
; Restrictions: 
;	The binary table file must have been opened with FXBOPEN.
;
;	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.
;
;       No variable-length columns may be read with FXBREADM.
;
;       Generaly speaking, FXBREADM will be faster than iterative
;       calls to FXBREAD when (a) a large number of columns is to be
;       read or (b) the size in bytes of each cell is small, so that
;       the overhead of the FOR loop in FXBREAD becomes significant.
;
; Side effects: 
;	If there are no elements to read in (the number of elements is zero),
;	then the program sets !ERR to -1, and DATA is unmodified.
;
; Category    : 
;	Data Handling, I/O, FITS, Generic.
; Prev. Hist. : 
;	W. Thompson, Jan 1992.
;	W. Thompson, Feb 1992, modified to support variable length arrays.
;	W. Thompson, Jun 1992, modified way that row ranges are read in.  No
;			       longer works reiteratively.
;	W. Thompson, Jun 1992, fixed bug where NANVALUE would be modified by
;			       TSCAL and TZERO keywords.
;	W. Thompson, Jun 1992, fixed bug when reading character strings.
;			       Treats dimensions better when reading multiple
;			       rows.
;       C. Markwardt, based in concept on FXBREAD version 12 from
;                              IDLASTRO, but with significant and
;                              major changes to accomodate the
;                              multiple row/column technique.  Mostly
;                              the parameter checking and general data
;                              flow remain.
;
; Written     : 
;       Craig Markwardt, GSFC, January 1999.
; Modified    :
;       Version 1, Craig Markwardt, GSFC 18 January 1999.
;               Documented this routine, 18 January 1999. 
; Version     :
;       Version 1, 18 January 1999.
;-
;
@fxbintable
	ON_ERROR, 2
;
;  Check the number of parameters.
;
	IF N_PARAMS() LT 2 THEN BEGIN
		MESSAGE = 'Syntax:  FXBREADM, UNIT, COL, D0, D1, ... [, ROW= ]'
		IF N_ELEMENTS(ERRMSG) NE 0 THEN BEGIN
			ERRMSG = MESSAGE
			RETURN
		END ELSE MESSAGE, MESSAGE
	ENDIF
        IF N_ELEMENTS(BUFFERSIZE) EQ 0 THEN BUFFERSIZE = 32768L

;
;  COL may be one of several descriptors:
;     * a list of column numbers, beginning with 1
;     * a list of column names
;
        MYCOL = [ COL ]    ; Make sure it is an array

        SC = SIZE(MYCOL)
        NUMCOLS = N_ELEMENTS(MYCOL)
        OUTSTATUS = LONARR(NUMCOLS)

;
;  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 number of columns.  It should be fewer than 50
;
        IF NUMCOLS GT 50 THEN BEGIN
            MESSAGE = 'Maximum of 50 columns exceeded'
            IF N_ELEMENTS(ERRMSG) NE 0 THEN BEGIN
                ERRMSG = MESSAGE
                RETURN
            END ELSE MESSAGE, MESSAGE
        ENDIF
        IF NUMCOLS LT N_PARAMS()-2 AND N_ELEMENTS(ERRMSG) EQ 0 THEN BEGIN
            MESSAGE, 'WARNING: number of data parameters less than columns', $
              /INFO
        ENDIF
            
        ICOL    = LONARR(NUMCOLS)
        VIRTUAL = BYTARR(NUMCOLS)
        VIRTYPE = LONARR(NUMCOLS)
        FOUND   = BYTARR(NUMCOLS)
        NOTFOUND = ''
        NNOTFOUND = 0L
        IF N_ELEMENTS(WARNMSG) NE 0 THEN WARNMSG = ''

;
;  If COL is of type string, then search for a column with that label.
;
        IF SC(SC(0)+1) EQ 7 THEN BEGIN
            MYCOL = STRUPCASE(STRTRIM(MYCOL,2))
            FOR I = 0, NUMCOLS-1 DO BEGIN
		XCOL = WHERE(TTYPE(*,ILUN) EQ MYCOL(I), NCOL)
		ICOL(I) = XCOL(0)
;
;  If the column was not found, and VIRTUAL was set, then search for a keyword
;  by that name.
;
                IF NCOL GT 0 THEN FOUND(I) = 1
                IF NOT FOUND(I) AND KEYWORD_SET(VIR) THEN BEGIN
                    HEADER = HEAD(*,ILUN)
                    VALUE = FXPAR(HEADER,MYCOL(I))
                    IF !ERR GE 0 THEN BEGIN
                        RESULT = EXECUTE('D'+STRTRIM(I,2)+$
                                         ' = VALUE')
                        SV = SIZE(VALUE)
                        VIRTYPE(I) = SV(SV(0)+1)
                        VIRTUAL(I) = 1
                        FOUND(I) = 1
                    ENDIF
                ENDIF ELSE IF NOT FOUND(I) THEN BEGIN
                    IF NOTFOUND EQ '' THEN NOTFOUND = MYCOL(I) $
                    ELSE NOTFOUND = NOTFOUND +', ' + MYCOL(I)
                    NNOTFOUND = NNOTFOUND + 1
                ENDIF

            ENDFOR

            IF NNOTFOUND EQ NUMCOLS THEN BEGIN
                MESSAGE = 'ERROR: None of the requested columns were found'
                IF N_ELEMENTS(ERRMSG) NE 0 THEN BEGIN
                    ERRMSG = MESSAGE
                    RETURN
                END ELSE MESSAGE, MESSAGE
            ENDIF ELSE IF NNOTFOUND GT 0 THEN BEGIN
                MESSAGE = 'WARNING: Columns ' + NOTFOUND + ' were not found'
                IF N_ELEMENTS(WARNMSG) NE 0 THEN WARNMSG = MESSAGE $
                ELSE MESSAGE, MESSAGE, /INFO
            ENDIF
                
;
;  Otherwise, a numerical column was passed.  Check its value.
;
	ENDIF ELSE BEGIN
            ICOL(*) = LONG(MYCOL) - 1
        ENDELSE

;  Step through each column index
        MESSAGE = ''
        FOR I = 0, NUMCOLS-1 DO BEGIN
            IF NOT FOUND(I) THEN GOTO, LOOP_END_COLCHECK
            IF VIRTUAL(I) THEN GOTO, LOOP_END_COLCHECK

            IF (ICOL(I) LT 0) OR (ICOL(I) GE TFIELDS(ILUN)) THEN BEGIN
                MESSAGE = MESSAGE + '; COL "'+STRTRIM(MYCOL(I),2)+$
                  '" must be between 1 and ' +	$
                  STRTRIM(TFIELDS(ILUN),2)
                FOUND(I) = 0
;                IF N_ELEMENTS(ERRMSG) NE 0 THEN BEGIN
;                    ERRMSG = MESSAGE
;                    RETURN
;                END ELSE MESSAGE, MESSAGE
            ENDIF
;
;  If there are no elements in the array, then set !ERR to -1.
;
            IF FOUND(I) AND N_ELEM(ICOL(I),ILUN) EQ 0 THEN BEGIN
                FOUND(I) = 0
                MESSAGE = MESSAGE + '; Number of elements to read in "'+$
                  STRTRIM(MYCOL(I),2)+'" is zero'
;                !ERR = -1
;                RETURN
            ENDIF

;
;  Do not permit variable-length columns
;
            IF MAXVAL(ICOL(I),ILUN) GT 0 THEN BEGIN
                MESSAGE = MESSAGE + '; FXBREADM cannot read ' + $
                  'variable-length column "'+STRTRIM(MYCOL(I),2)+'"'
                FOUND(I) = 0
;                IF N_ELEMENTS(ERRMSG) NE 0 THEN BEGIN
;                    ERRMSG = MESSAGE
;                    RETURN
;                END ELSE MESSAGE, MESSAGE
            ENDIF

            LOOP_END_COLCHECK:

        ENDFOR

;
;  Check to be sure that there are columns to be read
;
        W = WHERE(FOUND EQ 1, COUNT)
        IF COUNT EQ 0 THEN BEGIN
            STRPUT, MESSAGE, ':', 0
            MESSAGE = 'ERROR: No requested columns could be read'+MESSAGE
            IF N_ELEMENTS(ERRMSG) NE 0 THEN BEGIN
                ERRMSG = MESSAGE
                RETURN
            END ELSE MESSAGE, MESSAGE
        ENDIF ELSE IF MESSAGE NE '' THEN BEGIN
            STRPUT, MESSAGE, ':', 0
            MESSAGE = 'WARNING: Some columns could not be read'+MESSAGE
            IF N_ELEMENTS(WARNMSG) NE 0 THEN WARNMSG = MESSAGE $
            ELSE MESSAGE, MESSAGE, /INFO
        ENDIF
            
;
;  If ROW was not passed, then set it equal to the entire range.  Otherwise,
;  extract the range.
;
        IF N_ELEMENTS(ROW) EQ 0 THEN ROW = [1L, NAXIS2(ILUN)]
	CASE N_ELEMENTS(ROW) OF
		1:  ROW2 = LONG(ROW(0))
		2:  ROW2 = LONG(ROW(1))
		ELSE:  BEGIN
			MESSAGE = 'ROW must have one or two elements'
			IF N_ELEMENTS(ERRMSG) NE 0 THEN BEGIN
				ERRMSG = MESSAGE
				RETURN
			END ELSE MESSAGE, MESSAGE
			END
	ENDCASE
	ROW1 = LONG(ROW(0))
;
;  If ROW represents a range, then make sure that the row range is legal, and
;  that reading row ranges is allowed (i.e., the column is not variable length.
;
	IF ROW1 NE ROW2 THEN BEGIN
		MAXROW = NAXIS2(ILUN)
		IF (ROW1 LT 1) OR (ROW1 GT MAXROW) THEN BEGIN
			MESSAGE = 'ROW(0) must be between 1 and ' +	$
				STRTRIM(MAXROW,2)
			IF N_ELEMENTS(ERRMSG) NE 0 THEN BEGIN
				ERRMSG = MESSAGE
				RETURN
			END ELSE MESSAGE, MESSAGE
		END ELSE IF (ROW2 LT ROW1) OR (ROW2 GT MAXROW) THEN BEGIN
			MESSAGE = 'ROW(1) must be between ' +	$
				STRTRIM(ROW1,2) + ' and ' + STRTRIM(MAXROW,2)
			IF N_ELEMENTS(ERRMSG) NE 0 THEN BEGIN
				ERRMSG = MESSAGE
				RETURN
			END ELSE MESSAGE, MESSAGE
		ENDIF
;
;  Otherwise, if ROW is a single number, then just make sure it's valid.
;
	END ELSE BEGIN
		IF (ROW1 LT 1) OR (ROW1 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
	ENDELSE

;
;  Compose information about the output
;
        COLNDIM = LONARR(NUMCOLS)
        COLDIM  = LONARR(NUMCOLS, 20) ;; Maximum of 20 dimensions in output
        COLTYPE = LONARR(NUMCOLS)
        BOFF1   = LONARR(NUMCOLS)
        BOFF2   = LONARR(NUMCOLS)
        NROWS = ROW2-ROW1+1
        DTYPENAMES = [ 'BAD TYPE', 'BYTE', 'FIX', 'LONG', $
                       'FLOAT', 'DOUBLE', 'COMPLEX', 'STRING', $
                       'BAD TYPE', 'DCOMPLEX' ]
        FOR I = 0L, NUMCOLS-1 DO BEGIN

            IF NOT FOUND(I) THEN GOTO, LOOP_END_DIMS
            ;;  Data type of the input.
            IF VIRTUAL(I) THEN BEGIN
                COLTYPE(I) = VIRTYPE(I) 
                GOTO, LOOP_END_DIMS
            ENDIF ELSE $
              COLTYPE(I) = IDLTYPE(ICOL(I),ILUN)

            DIMS = N_DIMS(*,ICOL(I),ILUN)
            NDIMS = DIMS(0)
            DIMS  = DIMS(1:NDIMS)

            IF NDIMS EQ 1 AND DIMS(0) EQ 1 THEN BEGIN

                ;; Case of only one output element, try to return a
                ;; scalar.  Otherwise, it is a vector equal to the
                ;; number of rows to be read

                COLNDIM(I) = 1L
                COLDIM(I,0) = NROWS
            ENDIF ELSE BEGIN

                COLNDIM(I) = NDIMS
                COLDIM(I,0:(NDIMS-1)) = DIMS
                IF NROWS GT 1 THEN BEGIN
                    COLDIM(I,NDIMS) = NROWS
                    COLNDIM(I) = COLNDIM(I)+1
                ENDIF

            ENDELSE
            
            ;; For strings, the number of characters is the first
            ;; dimension.  This information is useless to us now,
            ;; since the STRING() type cast which will appear below
            ;; handles the array conversion automatically.
            IF COLTYPE(I) EQ 7 THEN BEGIN
                IF COLNDIM(I) GT 1 THEN BEGIN
                    COLDIM(I,0:COLNDIM(I)-2) = COLDIM(I,1:COLNDIM(I)-1)
                    COLDIM(I,COLNDIM(I)-1)   = 0
                    COLNDIM(I) = COLNDIM(I) - 1
                ENDIF ELSE BEGIN  ;; Case of a single row
                    COLNDIM(I) = 1L
                    COLDIM(I,0) = NROWS
                ENDELSE
            ENDIF

            ;; Byte offsets
            BOFF1(I) = BYTOFF(ICOL(I),ILUN)
            IF ICOL(I) EQ TFIELDS(ILUN)-1 THEN BOFF2(I) = NAXIS1(ILUN)-1 $
            ELSE BOFF2(I) = BYTOFF(ICOL(I)+1,ILUN)-1

            LOOP_END_DIMS:

        ENDFOR

;
;  Construct any virtual columns first
;
        WC = WHERE(FOUND EQ 1 AND VIRTUAL EQ 1, WCCOUNT)
        IF WCCOUNT GT 0 THEN BEGIN
            FOR I = 0, WCCOUNT-1 DO BEGIN
                ;; If it's virtual, then the value only needs to be
                ;; replicated
                EXTCMD = 'D'+STRTRIM(WC(I),2)+$
                  ' = REPLICATE(D'+STRTRIM(WC(I),2)+',NROWS)'
                ;; Run the command that selects the data
                RESULT = EXECUTE(EXTCMD)
                IF RESULT EQ 0 THEN BEGIN
                    MESSAGE = 'ERROR: Could not extract data (column '+$
                      STRTRIM(MYCOL(WC(I)),2)+')'
                    IF N_ELEMENTS(ERRMSG) NE 0 THEN BEGIN
                        ERRMSG = MESSAGE
                        RETURN
                    ENDIF ELSE MESSAGE, MESSAGE
                ENDIF
                OUTSTATUS(I) = 1
            ENDFOR
        ENDIF


;  Skip to the end if all columns are virtual
        IF WCCOUNT EQ NUMCOLS THEN GOTO, PROC_CLEANUP

        IF N_ELEMENTS(NANVALUE) GE NUMCOLS THEN BEGIN
            NANVALUES = NANVALUE(0:NUMCOLS-1)
        ENDIF ELSE IF N_ELEMENTS(NANVALUE) GT 0 THEN BEGIN
            NANVALUES = REPLICATE(NANVALUE(0), NUMCOLS)
            NANVALUES(0) = NANVALUE
            I = N_ELEMENTS(NANVALUE)
            IF I LT NUMCOLS THEN $
              NANVALUES(I:*) = NANVALUE(0)
        ENDIF

;
;  Find the position of the first byte of the data array in the file.
;
	OFFSET0 = NHEADER(ILUN) + NAXIS1(ILUN)*(ROW1-1)
        POS = 0L
        NROWS0 = NROWS
        J = 0L
        FIRST = 1
        ;; Here, we constrain the buffer to be at least 16 rows long.
        ;; If we fill up 32 kB with fewer than 16 rows, then there
        ;; must be a lot of (big) columns in this table.  It's
        ;; probably a candidate for using FXBREAD instead.
        BUFFROWS = LONG((BUFFERSIZE/NAXIS1(ILUN)) > 16L)
        IF BUFFERSIZE LE 0 THEN BUFFROWS = NROWS0

;
;  Loop through the data in chunks
;
        WHILE NROWS GT 0 DO BEGIN
        J = J + 1
        NR  = NROWS < BUFFROWS
        OFFSET1 = NAXIS1(ILUN)*POS

;
;  Proceed by reading a byte array from the input data file
;  FXBREADM reads all columns from the specified rows, and
;  sorts out the details of which bytes belong to which columns
;  in the next FOR loop.
;
        BB = BYTARR(NAXIS1(ILUN), NR)
        FXGSEEK, UNIT, OFFSET0+OFFSET1
        FXGREAD, UNIT, BB

;
;  Now select out the desired columns
;
        FOR I = 0, NUMCOLS-1 DO BEGIN
           
            ;; Extract the proper rows and columns
            IF NOT FOUND(I) THEN GOTO, LOOP_END_STORE
            IF VIRTUAL(I) THEN GOTO, LOOP_END_STORE

            ;; Extract the data from the byte array and convert it
            ;; The inner CALL_FUNCTION is to one of the coercion
            ;; functions, such as FIX(), DOUBLE(), STRING(), etc.,
            ;; which is called with an offset to force a conversion
            ;; from bytes to the data type.
            ;; The outer CALL_FUNCTION is to REFORM(), which makes
            ;; sure that the data structure is correct.
            ;;
            DIMS = COLDIM(I,0:COLNDIM(I)-1)
            PERROW = ROUND(PRODUCT(DIMS)/NROWS0)

            IF COLTYPE(I) EQ 7 THEN BEGIN
                DD = STRING(BB(BOFF1(I):BOFF2(I), *))
            ENDIF ELSE BEGIN
                DD = CALL_FUNCTION(DTYPENAMES(COLTYPE(I)), $
                                   BB(BOFF1(I):BOFF2(I),*),0, PERROW*NR)
            ENDELSE
            IF N_ELEMENTS(DD) EQ 1 THEN DD = [DD]
            DD = REFORM(DD, PERROW, NR, /OVERWRITE)

            ;; Now perform any type-specific conversions, etc.
            COUNT = 0L
            CT = COLTYPE(I)
            CASE 1 OF
                ;; Integer types
                (CT EQ 2 OR CT EQ 3): BEGIN
                    IF NOT KEYWORD_SET(NOIEEE) THEN $
                      IEEE_TO_HOST, DD 
                END

                ;; Floating and complex types
                (CT GE 4 OR CT LE 6 OR CT EQ 9): BEGIN
                    IF NOT KEYWORD_SET(NOIEEE) THEN BEGIN
                        IF N_ELEMENTS(NANVALUES) GT 0 THEN W=WHERENAN(DD,COUNT)
                        IEEE_TO_HOST, DD
                    ENDIF
                END

                ;; String types (CT EQ 7) have already been converted
                ;; in the above CALL_FUNCTION.  No further conversion
                ;; is necessary here.
            ENDCASE

;
;  If the parameters TZERO and TSCAL are non-trivial, then adjust the array by
;  these values.
;
            IF NOT KEYWORD_SET(NOIEEE) AND NOT KEYWORD_SET(NOSCALE) THEN BEGIN
                BZERO  = TZERO(ICOL(I),ILUN)
                BSCALE = TSCAL(ICOL(I),ILUN)
                IF (BSCALE NE 0) AND (BSCALE NE 1) THEN DD = BSCALE*DD
		IF BZERO NE 0 THEN DD = DD + BZERO
            ENDIF

;
;  Store NANVALUE everywhere where the data corresponded to IEEE NaN.
;
            IF COUNT GT 0 THEN DD(W) = NANVALUES(I)

            ;; Initialize the output variable on the first chunk
            IF FIRST THEN BEGIN
                RESULT = EXECUTE('D'+STRTRIM(I,2)+' = 0')
                DA = MAKE_ARRAY(PERROW, NROWS0, TYPE=COLTYPE(I))
                RESULT = EXECUTE('D'+STRTRIM(I,2)+' = '+$
                                 'REFORM(DA,PERROW, NROWS0,/OVERWRITE)')
            ENDIF

            ;; Finally, store this in the output variable
            RESULT = EXECUTE('D'+STRTRIM(I,2)+'(0,POS) = DD')
            DD = 0
            IF RESULT EQ 0 THEN BEGIN
                MESSAGE = 'ERROR: Could not compose output data D'+$
                  STRTRIM(I,2)
                IF N_ELEMENTS(ERRMSG) NE 0 THEN BEGIN
                    ERRMSG = MESSAGE
                    RETURN
                ENDIF ELSE MESSAGE, MESSAGE
            ENDIF

            OUTSTATUS(I) = 1

            LOOP_END_STORE:
        ENDFOR

        FIRST = 0
        NROWS = NROWS - NR
        POS   = POS + NR
        ENDWHILE

        FOR I = 0, NUMCOLS-1 DO BEGIN
            IF OUTSTATUS(I) NE 1 THEN GOTO, LOOP_END_FINAL
            DIMS = COLDIM(I,0:COLNDIM(I)-1)
            NEL  = PRODUCT(DIMS)
            IF NEL GT 1 THEN $
              RESULT = EXECUTE('D'+STRTRIM(I,2)+' = '+$
                               'REFORM(D'+STRTRIM(I,2)+',DIMS,/OVERWRITE)') $
            ELSE $
              RESULT = EXECUTE('D'+STRTRIM(I,2)+' = D'+STRTRIM(I,2)+'(0)')
            LOOP_END_FINAL:
        ENDFOR

        PROC_CLEANUP:
;
        IF N_ELEMENTS(ERRMSG) NE 0 THEN ERRMSG = ''
	RETURN
	END