OV-GSO-DC / dustem-wrapper_idl

Blame view

src/idl_misc/fxmove.pro 4.46 KB
Edit Raw Normal View History
427f1205   Jean-Michel Glorian   version 4.2 merged 
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
 
FUNCTION FXMOVE, UNIT, EXTEN, SILENT = Silent, EXT_NO = ext_no, ERRMSG=errmsg

;+
; NAME:
;     FXMOVE
; PURPOSE:
;     Skip to a specified extension number or name in a FITS file
;
; CALLING SEQUENCE:
;     STATUS=FXMOVE(UNIT, EXT, /Silent)
;     STATUS=FXMOVE(UNIT, EXTNAME, /Silent, EXT_NO=, ERRMSG= )
;
; INPUT PARAMETERS:
;     UNIT     = An open unit descriptor for a FITS data stream.
;     EXTEN   = Number of extensions to skip.
;                              or
;             Scalar string giving extension name (in the EXTNAME keyword)           
; OPTIONAL INPUT PARAMETER:
;     /SILENT - If set, then any messages about invalid characters in the 
;               FITS file are suppressed.
; OPTIONAL OUTPUT PARAMETER:
;       ERRMSG  = If this keyword is present, 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.
;
; RETURNS:
;     0 if successful.
;    -1 if an error is encountered.
;
; COMMON BLOCKS:
;      None.
; SIDE EFFECTS:
;      Repositions the file pointer.
; PROCEDURE:
;      Each FITS header is read in and parsed, and the file pointer is moved
;      to where the next FITS extension header until the desired
;      extension is reached.
; PROCEDURE CALLS:
;      FXPAR(), MRD_HREAD, MRD_SKIP
; MODIFICATION HISTORY:
;      Extracted from FXPOSIT 8-March-2000 by T. McGlynn
;      Added /SILENT keyword  14-Dec-2000 by W. Landsman
;      Save time by not reading the full header  W. Landsman   Feb. 2003
;      Allow extension name to be specified, added EXT_NO, ERRMSG keywords
;         W. Landsman  December 2006
;      Make search for EXTNAME case-independent  W.Landsman March 2007 
;      Avoid round-off error for very large extensions N. Piskunov Dec 2007
;-
         DO_NAME = SIZE( EXTEN,/TNAME) EQ 'STRING'
	 PRINT_ERROR = NOT ARG_PRESENT(ERRMSG)
         ERRMSG = ''
         IF DO_NAME THEN BEGIN 
	              FIRSTBLOCK = 0
		      EXT_NO = 9999
		      ENAME = STRTRIM( STRUPCASE(EXTEN), 2 )
		      ON_IOERROR, ALLOW_PLUN
		      POINT_LUN, -UNIT, DUM
		      ON_IOERROR, NULL
         ENDIF ELSE BEGIN 
	              FIRSTBLOCK = 1
		      EXT_NO = EXTEN
	ENDELSE 	            
		
        FOR I = 1, EXT_NO DO BEGIN
               
;
;  Read the next header, and get the number of bytes taken up by the data.
; 

                IF EOF(UNIT) THEN BEGIN 
		    IF DO_NAME THEN ERRMSG = $
	'Extension name ' + ename + ' not found in FITS file' ELSE ERRMSG = $	    
	'EOF encountered while moving to specified extension'
	        if PRINT_ERROR then message,errmsg	
		RETURN, -1
		ENDIF
           
                ; Can't use FXHREAD to read from pipe, since it uses
                ; POINT_LUN.  So we read this in ourselves using mrd_hread

                MRD_HREAD, UNIT, HEADER, STATUS, SILENT = Silent, FIRSTBLOCK=FIRSTBLOCK
                IF STATUS LT 0 THEN RETURN, -1
                        
                ; Get parameters that determine size of data
                ; region.
                IF DO_NAME THEN IF I GT 1 THEN BEGIN
		       EXTNAME = STRTRIM(SXPAR(HEADER,'EXTNAME',COUNT=N_name),2)
			 if N_NAME GT 0 THEN $
			  IF ENAME EQ STRUPCASE(EXTNAME) THEN BEGIN
			        EXT_NO= I-1
				BLOCK = 1 + ((N_ELEMENTS(HEADER)-1)/36)
				POINT_LUN, -UNIT, CURR_POSS
				POINT_LUN, UNIT, CURR_POSS - BLOCK*2880 
			        BREAK
			ENDIF	
		ENDIF	         
                BITPIX = FXPAR(HEADER,'BITPIX')
                NAXIS  = FXPAR(HEADER,'NAXIS')
                GCOUNT = FXPAR(HEADER,'GCOUNT') 
                IF GCOUNT EQ 0 THEN GCOUNT = 1
                PCOUNT = FXPAR(HEADER,'PCOUNT')
                
                IF NAXIS GT 0 THEN BEGIN 
                        DIMS = FXPAR(HEADER,'NAXIS*')           ;Read dimensions
                        IF !VERSION.RELEASE GE '6.1' THEN $
			         NDATA = PRODUCT(DIMS,/INTEGER) ELSE $
				 NDATA = LONG64( PRODUCT(DIMS) )                     
                ENDIF ELSE NDATA = 0
                
                NBYTES = LONG64(ABS(BITPIX) / 8) * GCOUNT * (PCOUNT + NDATA)
;
;  Move to the next extension header in the file.
;
                NREC = (NBYTES + 2879) / 2880
                
                MRD_SKIP, UNIT, NREC*2880L 

        ENDFOR
	        
        RETURN, 0
ALLOW_PLUN:
        ERRMSG =  $
	'Extension name cannot be specified unless POINT_LUN access is available'
	if PRINT_ERROR then message,errmsg	
	RETURN, -1        
END