fxread.pro

来自「basic median filter simulation」· PRO 代码 · 共 576 行 · 第 1/2 页

                END ELSE MESSAGE, MESSAGE
            ENDIF
        ENDIF
            
        ;; Handle case of empty image, or no data requested
        IF NAXIS EQ 0 OR KEYWORD_SET(NODATA) THEN BEGIN
            ;; Make DATA an undefined variable, reflecting no data
            DATA = 0 & DUMMY = TEMPORARY(DATA)

            ERRMSG = ''
            FREE_LUN,UNIT
            RETURN
        ENDIF

	DIMS = FXPAR(HEADER,'NAXIS*')
	N1 = DIMS[0]
	IF NAXIS EQ 2 THEN N2 = DIMS[1] ELSE N2 = 1
;
;  Determine the array type from the keyword BITPIX.
;
	CASE BITPIX OF
		  8:	IDLTYPE = 1	; Byte
		 16:	IDLTYPE = 2	; Integer*2
		 32:	IDLTYPE = 3	; Integer*4
		-32:	IDLTYPE = 4	; Real*4
		-64:	IDLTYPE = 5	; Real*8
	ENDCASE
;
;  Set the default values for the optional parameters.
;
	IF (I1 EQ -1) AND (I2 EQ -1) THEN BEGIN
           I1 = 0
           I2 = N1-1
        ENDIF
	IF (J1 EQ -1) AND (J2 EQ -1) THEN BEGIN
           J1 = 0
           J2 = N2-1
        ENDIF
;
;  If the prompt keyword was set, the prompt for the parameters.
;
	IF KEYWORD_SET(PROMPT) THEN BEGIN
		ANSWER = ''
		READ,'Enter lower limit for X ['+STRTRIM(I1,2)+']: ', ANSWER
		IF ANSWER NE '' THEN I1 = (ANSWER)
;
		ANSWER = ''
		READ,'Enter upper limit for X ['+STRTRIM(I2,2)+']: ', ANSWER
		IF ANSWER NE '' THEN I2 = LONG(ANSWER)
;
		ANSWER = ''
		READ,'Enter lower limit for Y ['+STRTRIM(J1,2)+']: ', ANSWER
		IF ANSWER NE '' THEN J1 = LONG(ANSWER)
;
		ANSWER = ''
		READ,'Enter upper limit for Y ['+STRTRIM(J2,2)+']: ', ANSWER
		IF ANSWER NE '' THEN J2 = LONG(ANSWER)
;
		ANSWER = ''
		READ,'Enter step size ['+STRTRIM(STEP,2)+']: ', ANSWER
		IF ANSWER NE '' THEN STEP = LONG(ANSWER)
	ENDIF
;
;  Differentiate between XSTEP and YSTEP.
;
	XSTEP = STEP > 1
	IF N_ELEMENTS(Y_STEP) EQ 1 THEN YSTEP = Y_STEP ELSE YSTEP = XSTEP
;
;  If any of the optional parameters were passed, then update the dimensions
;  accordingly.  First check I1 and I2.
;
	IF (I1 NE 0) OR (I2 NE N1-1) THEN BEGIN
		IF NAXIS GT 2 THEN BEGIN
			FREE_LUN,UNIT
			MESSAGE = 'Range parameters can only be set for ' + $
				'one or two-dimensional arrays'
			IF N_ELEMENTS(ERRMSG) NE 0 THEN BEGIN
				ERRMSG = MESSAGE
				RETURN
			END ELSE MESSAGE, MESSAGE
		ENDIF
		IF (MIN([I1,I2]) LT 0) OR (MAX([I1,I2]) GE DIMS[0]) THEN BEGIN
			FREE_LUN,UNIT
			MESSAGE = 'I1,I2 must be in the range 0 to ' +	$
				STRTRIM(DIMS[0]-1,2)
			IF N_ELEMENTS(ERRMSG) NE 0 THEN BEGIN
				ERRMSG = MESSAGE
				RETURN
			END ELSE MESSAGE, MESSAGE
		END ELSE IF I1 GT I2 THEN BEGIN
			MESSAGE = 'I2 must be >= I1'
			IF N_ELEMENTS(ERRMSG) NE 0 THEN BEGIN
				ERRMSG = MESSAGE
				RETURN
			END ELSE MESSAGE, MESSAGE
		ENDIF
		DIMS[0] = I2 - I1 + 1
	ENDIF
;
;  Next, check J1 and J2.
;
	IF (J1 NE 0) OR (J2 NE N2-1) THEN BEGIN
		IF NAXIS NE 2 THEN BEGIN
			FREE_LUN,UNIT
			MESSAGE = 'J1, J2 can only be set for ' +	$
				'two-dimensional arrays'
			IF N_ELEMENTS(ERRMSG) NE 0 THEN BEGIN
				ERRMSG = MESSAGE
				RETURN
			END ELSE MESSAGE, MESSAGE
		ENDIF
		IF (MIN([J1,J2]) LT 0) OR (MAX([J1,J2]) GE DIMS[1]) THEN BEGIN
			FREE_LUN,UNIT
			MESSAGE = 'J1,J2 must be in the range 0 to ' +	$
				STRTRIM(DIMS[1]-1,2)
			IF N_ELEMENTS(ERRMSG) NE 0 THEN BEGIN
				ERRMSG = MESSAGE
				RETURN
			END ELSE MESSAGE, MESSAGE
		END ELSE IF J1 GT J2 THEN BEGIN
			MESSAGE = 'J2 must be >= J1'
			IF N_ELEMENTS(ERRMSG) NE 0 THEN BEGIN
				ERRMSG = MESSAGE
				RETURN
			END ELSE MESSAGE, MESSAGE
		ENDIF
		DIMS[1] = J2 - J1 + 1
	ENDIF
;
;  Next, check XSTEP.  Note that the dimensions of the final result are
;  somewhat differ depending on whether the keyword AVERAGE is set or not.
;
	IF XSTEP GT 1 THEN BEGIN
	    IF NAXIS GT 2 THEN BEGIN
		FREE_LUN,UNIT
	        MESSAGE = 'STEP can only be set for one or ' +	$
	            'two-dimensional arrays'
		IF N_ELEMENTS(ERRMSG) NE 0 THEN BEGIN
			ERRMSG = MESSAGE
			RETURN
		END ELSE MESSAGE, MESSAGE
	    END ELSE IF XSTEP NE LONG(XSTEP) THEN BEGIN
		FREE_LUN,UNIT
	        MESSAGE = 'STEP must be an integer value'
		IF N_ELEMENTS(ERRMSG) NE 0 THEN BEGIN
			ERRMSG = MESSAGE
			RETURN
		END ELSE MESSAGE, MESSAGE
	    END ELSE IF KEYWORD_SET(AVERAGE) THEN BEGIN
	        DIMS[0] = DIMS[0] / LONG(XSTEP)
	    END ELSE BEGIN
	        DIMS[0] = LONG(DIMS[0] + XSTEP - 1) / LONG(XSTEP)
	        INDEX = LINDGEN(DIMS[0])*XSTEP
	    ENDELSE
	ENDIF
;
;  Finally, check YSTEP.  This parameter is ignored for anything other than
;  two-dimensional arrays.
;
	IF (NAXIS EQ 2) AND (YSTEP GT 1) THEN BEGIN
	    IF YSTEP NE LONG(YSTEP) THEN BEGIN
		FREE_LUN,UNIT
	        MESSAGE = 'YSTEP must be an integer value'
		IF N_ELEMENTS(ERRMSG) NE 0 THEN BEGIN
			ERRMSG = MESSAGE
			RETURN
		END ELSE MESSAGE, MESSAGE
	    END ELSE IF KEYWORD_SET(AVERAGE) THEN BEGIN
	        DIMS[1] = DIMS[1] / LONG(YSTEP)
	    END ELSE BEGIN
	        DIMS[1] = LONG(DIMS[1]+YSTEP-1) / LONG(YSTEP)
	    ENDELSE
	END ELSE YSTEP = 1
;
;  Make the array.
;
	DATA = MAKE_ARRAY(DIMENSION=DIMS,TYPE=IDLTYPE,/NOZERO)
;
;  Find the start of the data to be read in.
;
	POINT_LUN,-UNIT,OFFSET		;Current position
	DELTA = N1*ABS(BITPIX)/8
	IF J1 NE 0 THEN BEGIN
		OFFSET = OFFSET + J1*DELTA
		POINT_LUN,UNIT,OFFSET
	ENDIF
;
;  If the I range, XSTEP or YSTEP is non-trivial, then read in the file line by
;  line.  If pixel averaging, then read in YSTEP lines.
;
        ON_IOERROR,QUIT
	IF (DIMS[0] NE N1) OR (XSTEP GT 1) OR (YSTEP GT 1) THEN BEGIN
	    IF NAXIS EQ 1 THEN NJ = 1 ELSE NJ = DIMS[1]
	    FOR J = 0,NJ-1 DO BEGIN
	        IF YSTEP GT 1 THEN POINT_LUN,UNIT,OFFSET+J*YSTEP*DELTA
	        IF (YSTEP GT 1) AND KEYWORD_SET(AVERAGE) AND (NAXIS EQ 2) $
	            THEN LINE = MAKE_ARRAY(N1,YSTEP,TYPE=IDLTYPE,/NOZERO) $
	            ELSE LINE = MAKE_ARRAY(N1,TYPE=IDLTYPE,/NOZERO)
	        READU,UNIT,LINE
;
;  If I1,I2 do not match the array size, then extract the relevant subarray.
;
	        IF (I1 NE 0) OR (I2 NE N1-1) THEN LINE = LINE[I1:I2,*]
;
;  Suppose that the step size is non-trivial.  If AVERAGE was set, then convert
;  to the host format, and use REBIN to average the data.  (Note that missing
;  pixels are not correctly handled in this case.)  Otherwise, select out the
;  relevant portion of the data.
;
	        IF (XSTEP GT 1) OR (YSTEP GT 1) THEN BEGIN
	            IF KEYWORD_SET(AVERAGE) THEN BEGIN
			IEEE_TO_HOST, LINE
			ALREADY_CONVERTED = 1
	                IF NAXIS EQ 1 THEN BEGIN
	                    DATA[0,J] = REBIN(LINE[0:XSTEP*DIMS[0]]-1,DIMS[0])
	                END ELSE BEGIN
	                    DATA[0,J] = REBIN(LINE[0:XSTEP*DIMS[0]-1,*],DIMS[0],1)
	                ENDELSE
		    END ELSE DATA[0,J] = LINE[INDEX]
;
;  Otherwise, if the step size is trivial, then simply store the line in the
;  data array.
;
	        END ELSE BEGIN
	            DATA[0,J] = LINE
	        ENDELSE
	    ENDFOR
;
;  Otherwise, if the file doesn't have to be read in line by line, then just
;  read the data array.
;
	END ELSE READU,UNIT,DATA
;
;  Convert the data from IEEE to host format, keeping track of any IEEE NaN
;  values.  Don't do this if the conversion has already taken place.
;
	IF NOT ALREADY_CONVERTED THEN BEGIN
		IF (N_ELEMENTS(NANVALUE) EQ 1) AND (IDLTYPE GE 4) AND	$
			(IDLTYPE LE 6) THEN W = WHERENAN(DATA,COUNT) ELSE $
			COUNT = 0
		IEEE_TO_HOST,DATA
	END ELSE COUNT = 0
;
;  If the parameters BZERO and BSCALE are non-trivial, then adjust the array by
;  these values.
;
	IF NOT KEYWORD_SET(NOSCALE) THEN BEGIN
		BZERO  = FXPAR(HEADER,'BZERO')
		BSCALE = FXPAR(HEADER,'BSCALE')
		GET_DATE,DTE
		IF (BSCALE NE 0) AND (BSCALE NE 1) THEN BEGIN
			DATA = BSCALE*DATA
			IF NOT KEYWORD_SET(NOUPDATE) THEN BEGIN
				FXADDPAR,HEADER,'BSCALE',1.
				FXADDPAR,HEADER,'HISTORY',DTE +		$
					' applied BSCALE = '+ STRTRIM(BSCALE,2)
			ENDIF
		ENDIF
		IF BZERO NE 0 THEN BEGIN
			DATA = DATA + BZERO
			IF NOT KEYWORD_SET(NOUPDATE) THEN BEGIN
				FXADDPAR,HEADER,'BZERO',0.
				FXADDPAR,HEADER,'HISTORY',DTE +		$
					' applied BZERO = '+ STRTRIM(BZERO,2)
			ENDIF
		ENDIF
	ENDIF
;
;  Store NANVALUE everywhere where the data corresponded to IEE NaN.
;
	IF COUNT GT 0 THEN DATA[W] = NANVALUE
;
;  Close the file and return.
;
        READ_OK=1
QUIT:   ON_IOERROR,NULL
	FREE_LUN, UNIT
        IF NOT READ_OK THEN BEGIN
	    MESSAGE='Error reading file '+FILENAME
	    IF N_ELEMENTS(ERRMSG) NE 0 THEN BEGIN
		ERRMSG = MESSAGE
		RETURN
	    END ELSE MESSAGE, MESSAGE
	ENDIF
	IF N_ELEMENTS(ERRMSG) NE 0 THEN ERRMSG = ''
	RETURN
	END