mrdfits.pro

来自「basic median filter simulation」· PRO 代码 · 共 1,852 行 · 第 1/5 页

;  Find all instances of 'TFORM' followed by
;  a number.  Store the positions of the located keywords in mforms, and the
;  value of the number field in n_mforms
;

  mforms = WHERE(STRPOS(keyword,'TFORM') GE 0, n_mforms)
  if n_mforms GT nfld then begin
        message,/CON, $
        'WARNING - More columns found in binary table than specified in TFIELDS'
        n_mforms = nfld
        mforms = mforms[0:nfld-1]
  endif


  IF ( n_mforms GT 0 ) THEN BEGIN
      numst= STRMID(hdr[mforms], 5 ,3)      
 
      igood = WHERE(VALID_NUM(numst,/INTEGER), n_mforms)
      IF n_mforms GT 0 THEN BEGIN
          mforms = mforms[igood]
          number = fix( numst[igood])
          numst = numst[igood]
      ENDIF

  ENDIF ELSE RETURN              ;No fields in binary table

  ;; The others
  fnames = strarr(n_mforms)
  fforms = strarr(n_mforms) 
  scales = dblarr(n_mforms)
  offsets = dblarr(n_mforms)

  ;;comments = strarr(n_mnames)

  fnames_names  = 'TTYPE'+numst
  scales_names  = 'TSCAL'+numst
  offsets_names = 'TZERO'+numst
  number = number -1    ;Make zero-based


  match, keyword, fnames_names, mkey_names, mnames, count = N_mnames

  match, keyword, scales_names, mkey_scales, mscales, count = N_mscales

  match, keyword, offsets_names, mkey_offsets, moffsets,count = N_moffsets

  FOR in=0L, nnames-1 DO BEGIN 

      CASE names[in] OF
          'TTYPE': BEGIN 
              tmatches = mnames 
              matches = mkey_names
              nmatches = n_mnames
              result = fnames
          END 
          'TFORM': BEGIN 
              tmatches = lindgen(n_mforms)
              matches = mforms
              nmatches = n_mforms
              result = fforms
          END 
          'TSCAL': BEGIN 
              tmatches = mscales
              matches = mkey_scales
              nmatches = n_mscales
              result = scales
          END 
          'TZERO': BEGIN 
              tmatches = moffsets
              matches = mkey_offsets
              nmatches = n_moffsets
              result = offsets
          END 
          ELSE: message,'What?'
      ENDCASE 

      ;;help,matches,nmatches

;
;  Extract the parameter field from the specified header lines.  If one of the
;  special cases, then done.
;
      IF nmatches GT 0 THEN BEGIN 
          
          ;; "matches" is a subscript for hdr and keyword.
          ;; get just the matches in line
          
          line = hdr[matches]
          svalue = STRTRIM( STRMID(line,9,71),2)
          
          FOR i = 0, nmatches-1 DO BEGIN
              IF ( STRMID(svalue[i],0,1) EQ "'" ) THEN BEGIN

                  ;; Its a string
                  test = STRMID( svalue[i],1,STRLEN( svalue[i] )-1)
                  next_char = 0
                  off = 0
                  value = ''
;
;  Find the next apostrophe.
;
NEXT_APOST:
                  endap = STRPOS(test, "'", next_char)
                  IF endap LT 0 THEN MESSAGE,         $
                    'WARNING: Value of '+nam+' invalid in '+ " (no trailing ')", /info
                  value = value + STRMID( test, next_char, endap-next_char )
;
;  Test to see if the next character is also an apostrophe.  If so, then the
;  string isn't completed yet.  Apostrophes in the text string are signalled as
;  two apostrophes in a row.
;
                  IF STRMID( test, endap+1, 1) EQ "'" THEN BEGIN    
                      value = value + "'"
                      next_char = endap+2      
                      GOTO, NEXT_APOST
                  ENDIF

                 
;
;  If not a string, then separate the parameter field from the comment field.
;
              ENDIF ELSE BEGIN
                  ;; not a string
                  test = svalue[I]
                  slash = STRPOS(test, "/")
                  IF slash GT 0 THEN  test = STRMID(test, 0, slash)
                 
;
;  Find the first word in TEST.  Is it a logical value ('T' or 'F')?
;
                  test2 = test
                  value = GETTOK(test2,' ')
                  test2 = STRTRIM(test2,2)
                  IF ( value EQ 'T' ) THEN BEGIN
                      value = 1
                  END ELSE IF ( value EQ 'F' ) THEN BEGIN
                      value = 0
                  END ELSE BEGIN
;
;  Test to see if a complex number.  It's a complex number if the value and the
;  next word, if any, both are valid numbers.
;
                      IF STRLEN(test2) EQ 0 THEN GOTO, NOT_COMPLEX
                      test2 = GETTOK(test2,' ')
                      IF VALID_NUM(value,val1) AND VALID_NUM(value2,val2) $
                        THEN BEGIN
                          value = COMPLEX(val1,val2)
                          GOTO, GOT_VALUE
                      ENDIF
;
;  Not a complex number.  Decide if it is a floating point, double precision,
;  or integer number.  If an error occurs, then a string value is returned.
;  If the integer is not within the range of a valid long value, then it will 
;  be converted to a double.  
;
NOT_COMPLEX:
                      ON_IOERROR, GOT_VALUE
                      value = test
                      IF NOT VALID_NUM(value) THEN GOTO, GOT_VALUE

                      IF (STRPOS(value,'.') GE 0) OR (STRPOS(value,'E') $
                                                      GE 0) OR (STRPOS(value,'D') GE 0) THEN BEGIN
                          IF ( STRPOS(value,'D') GT 0 ) OR $
                            ( STRLEN(value) GE 8 ) THEN BEGIN
                              value = DOUBLE(value)
                          END ELSE value = FLOAT(value)
                      ENDIF ELSE BEGIN
                          lmax = long64(2)^31 - 1
                          lmin = -long64(2)^31
                          value = long64(value)
                          if (value GE lmin) and (value LE lmax) THEN $
                            value = LONG(value)
                      ENDELSE
                      
;
GOT_VALUE:
                      ON_IOERROR, NULL
                  ENDELSE
              ENDELSE           ; if string
;
;  Add to vector if required.
;
              
              result[tmatches[i]] = value
             
          ENDFOR

          CASE names[in] OF
              'TTYPE': fnames[number] = strtrim(result, 2)
              'TFORM': fforms[number] = strtrim(result, 2)
              'TSCAL': scales[number] = result
              'TZERO': offsets[number] = result
              ELSE: message,'What?'
          ENDCASE 

;
;  Error point for keyword not found.
;
      ENDIF
;



  ENDFOR 
END
  

; Get a tag name give the column name and index
function  mrd_dofn, name, index, use_colnum, alias=alias

    ; Check if the user has specified an alias.

    if n_elements(name) eq 0 then name = 'C'+strtrim(index, 2)
    name = strtrim(name)
    if keyword_set(alias) then begin
	sz = size(alias)
	
	if (sz[0] eq 1 or sz[0] eq 2) and sz[1] eq 2 and sz[sz[0]+1] eq 7 then begin
	    w=where(name eq alias[1,*])
	    if (w[0] ne -1) then begin
		name = alias[0,w[0]];
	    endif
	endif
    endif
    ; Convert the string name to a valid variable name.  If name 
    ; is not defined generate the string Cnn when nn is the index 
    ; number.

    table = 0
    sz = size(name) 
    nsz = n_elements(sz) 
    if not use_colnum and (sz[nsz-2] ne 0) then begin 
        if sz[nsz-2] eq 7 then begin 
            str = name[0] 
        endif else begin 
            str = 'C'+strtrim(index,2) 
        endelse 
    endif else begin 
        str = 'C'+strtrim(index,2) 
    endelse 
 
    return, IDL_VALIDNAME(str,/CONVERT_ALL) 
 
end 

;***************************************************************



; Parse the TFORM keyword and return the type and dimension of the 
; data. 
pro mrd_doff, form, dim, type 
 
    ; Find the first non-numeric character. 
 
    len = strlen(form) 
 
    if len le 0 then return 
 
    for i=0, len-1 do begin 
 
        c = strmid(form, i, 1) 
        if c lt '0'  or c gt '9' then goto, not_number 
         
    endfor 
 
  not_number: 

    if i ge len then return              ;Modified from len-1 on 26-Jul-1998
 
    if i gt 0 then begin 
        dim = long(strmid(form, 0, i)) 
        if dim EQ 0l then dim = -1l
    endif else begin 
        dim = 0 
    endelse 
 
    type = strmid(form, i, 1) 
end 



;*********************************************************************

;  Check that this name is unique with regard to other column names.

function mrd_chkfn, name, namelist, index 
 
    ; 
    ; 

    maxlen = 127

    if strlen(name) gt maxlen then name = strmid(name, 0, maxlen) 
    w = where(name eq strmid(namelist, 0, maxlen) )
    if w[0] ne -1 then begin
        ; We have found a name conflict. 
        ; 
            name = 'gen$name_'+strcompress(string(index+1),/remove_all) 
    endif 
 
    return, name 
 
end

; Find the appropriate offset for a given unsigned type.
; The type may be given as the bitpix value or the IDL
; variable type.

function mrd_unsigned_offset, type
    	    
    if (type eq 12 or type eq 16) then begin
	return, uint(32768)
    endif else if (type eq 13 or type eq 32) then begin
	return, ulong('2147483648')
    endif else if (type eq 15 or type eq 64) then begin
	return, ulong64('9223372036854775808');
    endif
    return, 0
end



; Can we treat this data as unsigned?

function mrd_chkunsigned, bitpix, scale, zero, unsigned=unsigned

    if not keyword_set(unsigned) then return, 0
    
    ; This is correct but we should note that
    ; FXPAR returns a double rather than a long.
    ; Since the offset is a power of two
    ; it is an integer that is exactly representable
    ; as a double.  However, if a user were to use
    ; 64 bit integers and an offset close to but not
    ; equal to 2^63, we would erroneously assume that
    ; the dataset was unsigned...

    
    if scale eq 1 then begin
	if (bitpix eq 16 and zero eq 32768L)  or                    $
	   (bitpix eq 32 and zero eq ulong('2147483648')) or        $
	   (bitpix eq 64 and zero eq ulong64('9223372036854775808')) then begin
	    return, 1
	endif
    endif
    return, 0
end

; Is this one of the IDL unsigned types?
function mrd_unsignedtype, data
       
    type = size(data,/ type) 
    if (type eq 12) or (type eq 13) or (type eq 15) then return, type $
                                                    else return, 0
    
end
    
; Return the currrent version string for MRDFITS
function mrd_version
    return, '2.15a '
end
;=====================================================================
; END OF GENERAL UTILITY FUNCTIONS ===================================
;=====================================================================


; Parse the TFORM keyword and return the type and dimension of the
; data.
pro mrd_atype, form, type, slen