mwrfits.pro

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

;+
; NAME:
;       MWRFITS
; PURPOSE:
;       Write all standard FITS data types from input arrays or structures.
;
; CALLING SEQUENCE:
;       MWRFITS, Input, Filename, [Header],
;                       /LSCALE , /ISCALE, /BSCALE, 
;                       /USE_COLNUM, /Silent, /Create, /No_comment, /Version, $
;                       Alias=, /ASCII, Separator=, Terminator=, Null=,
;                       /Logical_cols, /Bit_cols, /Nbit_cols, 
;                       Group=, Pscale=, Pzero=, Status=
;
; INPUTS:
;       Input = Array or structure to be written to FITS file.
;
;               -When writing FITS primary data or image extensions
;                input should be an array.
;               --If data is to be grouped
;                 the Group keyword should be specified to point to
;                 a two dimensional array.  The first dimension of the
;                 Group array will be PCOUNT while the second dimension
;                 should be the same as the last dimension of Input.
;               --If Input is undefined, then a dummy primary dataset
;                 or Image extension is created [This might be done, e.g.,
;                 to put appropriate keywords in a dummy primary
;                 HDU].
;
;               -When writing an ASCII table extension, Input should
;                be a structure array where no element of the structure
;                is a structure or array (except see below).
;               --A byte array will be written as A field.  No checking
;                 is done to ensure that the values in the byte field
;                 are valid ASCII.
;               --Complex numbers are written to two columns with '_R' and
;                 '_I' appended to the TTYPE fields (if present).  The
;                 complex number is enclosed in square brackets in the output.
;               --Strings are written to fields with the length adjusted
;                 to accommodate the largest string.  Shorter strings are
;                 blank padded to the right.
;
;               -When writing a binary table extension, the input should
;                be a structure array with no element of the structure
;                being a substructure.
;
;               If a structure is specified on input and the output
;               file does not exist or the /CREATE keyword is specified
;               a dummy primary HDU is created.
;
;       Filename = String containing the name of the file to be written.
;                By default MWRFITS appends a new extension to existing
;                files which are assumed to be valid FITS.  The /CREATE
;                keyword can be used to ensure that a new FITS file
;                is created even if the file already exists.
;
; OUTPUTS:
;
; OPTIONAL INPUTS:
;       Header = Header should be a string array.  Each element of the
;                array is added as a row in the FITS  header.  No
;                parsing is done of this data.  MWRFITS will prepend
;                required structural (and, if specified, scaling)
;                keywords before the rows specified in Header.
;                Rows describing columns in the table will be appended
;                to the contents of Header.
;                Header lines will be extended or truncated to
;                80 characters as necessary.
;                If Header is specified then on return Header will have
;                the header generated for the specified extension.
;
; OPTIONAL INPUT KEYWORDS:
;       ALias=   Set up aliases to convert from the IDL structure
;                to the FITS column name.  The value should be
;                a STRARR(2,*) value where the first element of
;                each pair of values corresponds to a column
;                in the structure and the second is the name
;                to be used in the FITS file.
;                The order of the alias keyword is compatible with
;                use in MRDFITS.
;       ASCII  - Creates an ASCII table rather than a binary table.
;                This keyword may be specified as:
;                /ASCII - Use default formats for columns.
;                ASCII='format_string' allows the user to specify
;                  the format of various data types such using the following
;                  syntax 'column_type:format, column_type:format'.  E.g.,
;                ASCII='A:A1,I:I6,L:I10,B:I4,F:G15.9,D:G23.17,C:G15.9,M:G23.17'
;                gives the default formats used for each type.  The TFORM
;                fields for the real and complex types indicate will use corresponding
;                E and D formats when a G format is specified.
;                Note that the length of the field for ASCII strings and
;                byte arrays is automatically determined for each column.
;       BIT_COLS=   An array of indices of the bit columns.   The data should
;                comprise a byte array with the appropriate dimensions.
;                If the number of bits per row (see NBIT_COLS)
;                is greater than 8, then the first dimension of the array 
;                should match the number of input bytes per row.
;       BSCALE   Scale floats, longs, or shorts to unsigned bytes (see LSCALE)
;       /CREATE   If this keyword is non-zero, then a new FITS file will
;                be created regardless of whether the file currently
;                exists.  Otherwise when the file already exists,
;                a FITS extension will be appended to the existing file
;                which is assumed to be a valid FITS file.
;       GROUP=   This keyword indicates that GROUPed FITS data is to
;                be generated.
;                Group should be a 2-D array of the appropriate output type.
;                The first dimension will set the number of group parameters.
;                The second dimension must agree with the last dimension
;                of the Input array.
;       ISCALE   Scale floats or longs to short integer (see LSCALE)
;       LOGICAL_COLS=  An array of indices of the logical column numbers.
;                These should start with the first column having index 0.
;                The structure element should either be an array of characters
;                with the values 'T' or 'F', or an array of bytes having the 
;                values byte('T'), byte('F') or 0b.     The use of bytes allows
;                the specification of undefined values (0b).
;       LSCALE   Scale floating point numbers to long integers.
;                This keyword may be specified in three ways.
;                /LSCALE (or LSCALE=1) asks for scaling to be automatically
;                determined. LSCALE=value divides the input by value.
;                I.e., BSCALE=value, BZERO=0.  Numbers out of range are 
;                given the value of NULL if specified, otherwise they are given
;                the appropriate extremum value.  LSCALE=(value,value)
;                uses the first value as BSCALE and the second as BZERO
;                (or TSCALE and TZERO for tables).
;       NBIT_COLS=  The number of bits actually used in the bit array.
;                This argument must point to an array of the same dimension
;                as BIT_COLS.
;       NO_TYPES  If the NO_TYPES keyword is specified, then no TTYPE
;                keywords will be created for ASCII and BINARY tables.
;       No_comment Do not write comment keywords in the header
;       NULL=    Value to be written for integers/strings which are
;                undefined or unwritable.
;       PSCALE=  An array giving scaling parameters for the group keywords.
;                It should have the same dimension as the first dimension
;                of Group.
;       PZERO=   An array giving offset parameters for the group keywords.
;                It should have the same dimension as the first dimension
;                of Group.
;       Separator= This keyword can be specified as a string which will
;                be used to separate fields in ASCII tables.  By default
;                fields are separated by a blank.
;       /SILENT   Suppress informative messages.  Errors will still
;                be reported.
;       Terminator= This keyword can be specified to provide a string which
;                will be placed at the end of each row of an ASCII table.
;                No terminator is used when not specified.
;                If a non-string terminator is specified (including
;                when the /terminator form is used), a new line terminator
;                is appended.
;       USE_COLNUM  When creating column names for binary and ASCII tables
;                MWRFITS attempts to use structure field name
;                values.  If USE_COLNUM is specified and non-zero then
;                column names will be generated as 'C1, C2, ... 'Cn'
;                for the number of columns in the table.
;       Version   Print the version number of MWRFITS.
;
; OPTIONAL OUTPUT KEYWORD:
;       Status - 0 if FITS file is successfully written, -1 if there is a
;                a problem (e.g. nonexistent directory, or no write permission)
; EXAMPLE:
;       Write a simple array:
;            a=fltarr(20,20)
;            mwrfits,a,'test.fits'
;
;       Append a 3 column, 2 row, binary table extension to file just created.
;            a={name:'M31', coords:(30., 20.), distance:2}
;            a=replicate(a, 2);
;            mwrfits,a,'test.fits'
;
;       Now add on an image extension:
;            a=lonarr(10,10,10)
;            hdr=("COMMENT  This is a comment line to put in the header", $
;                 "MYKEY    = "Some desired keyword value")
;            mwrfits,a,'test.fits',hdr
;
; RESTRICTIONS:
;       (1)     Variable length columns are not supported for anything
;               other than simple types (byte, int, long, float, double).
;       (2)     Empty strings are converted to 1 element blank strings (because
;               IDL refuses to write an empty string (0b) from a structure)
; NOTES:
;       This multiple format FITS writer is designed to provide a
;       single, simple interface to writing all common types of FITS data.
;       Given the number of options within the program and the
;       variety of IDL systems available it is likely that a number
;       of bugs are yet to be uncovered.  If you find an anomaly
;       please send a report to:
;           Tom McGlynn
;           NASA/GSFC Code 660.2
;           [e-mail] (or 301-286-7743)
;
; PROCEDURES USED:
;       FXPAR(), FXADDPAR
; MODIfICATION HISTORY:
;       Version 0.9: By T. McGlynn   1997-07-23
;              Initial beta release.
;       Dec 1, 1997, Lindler, Modified to work under VMS.
;       Version 0.91: T. McGlynn  1998-03-09
;               Fixed problem in handling null primary arrays.
;       Version 0.92: T. McGlynn 1998-09-09
;               Add no_comment flag and keep user comments on fields.
;               Fix handling of bit fields.
;       Version 0.93: T. McGlynn 1999-03-10
;               Fix table appends on VMS.
;       Version 0.93a  W. Landsman/D. Schlegel
;               Update keyword values in chk_and_upd if data type has changed 
;       Version 0.94: T. McGlynn 2000-02-02
;               Efficient processing of ASCII tables.
;               Use G rather than E formats as defaults for ASCII tables
;                and make the default precision long enough that transformations
;                binary to/from ASCII are invertible.
;               Some loop indices made long.
;               Fixed some ends to match block beginnings.
;       Version 0.95: T. McGlynn 2000-11-06
;               Several fixes to scaling.  Thanks to David Sahnow for
;               documenting the problems.
;               Added PCOUNT,GCOUNT keywords to Image extensions.
;               Version numbers shown in SIMPLE/XTENSION comments
;       Version 0.96: T. McGlynn 2001-04-06
;               Changed how files are opened to handle ~ consistently
;       Version 1.0: T. McGlynn 2001-12-04
;               Unsigned integers,
;               64 bit integers.
;               Aliases
;               Variable length arrays
;               Some code cleanup
;       Version 1.1: T. McGlynn 2002-2-18
;               Fixed major bug in processing of unsigned integers.
;               (Thanks to Stephane Beland)
;       Version 1.2: Stephane Beland 2003-03-17
;               Fixed problem in creating dummy dataset when passing undefined
;               data, caused by an update to FXADDPAR routine.
;       Version 1.2.1 Stephane Beland 2003-09-10
;               Exit gracefully if write priveleges unavailable
;       Version 1.3 Wayne Landsman 2003-10-24
;               Don't use EXECUTE() statement if on a virtual machine
;       Version 1.3a Wayne Landsman 2004-5-21
;               Fix for variable type arrays
;       Version 1.4 Wayne Landsman 2004-07-16
;               Use STRUCT_ASSIGN when modifying structure with pointer tags
;       Version 1.4a Wayne Landsman 2005-01-03
;               Fix writing of empty strings in binary tables 
;       Version 1.4b Wayne Landsman 2006-02-23
;               Propagate /SILENT keyword to mwr_tablehdr
;       Version 1.5 Wayne Landsman  2006-05-24
;               Open file using /SWAP_IF_LITTLE_ENDIAN keyword 
;               Convert empty strings to 1 element blank strings before writing            
;       Version 1.5a Wayne Landsman 2006-06-29
;               Fix problem introduced 2006-05-24 with multidimensional strings
;       Version 1.5b K. Tolbert 2006-06-29
;               Make V1.5a fix work pre-V6.0
;       Version 1.5c I.Evans/W.Landsman 2006-08-08
;               Allow logical columns to be specified as bytes 
;       Version 1,5d K. Tolbert 2006-08-11 
;               Make V1.5a fix work for scalar empty string
;       Version 1.6  W. Landsman  2006-09-22
;               Assume since V5.5, remove VMS support
;       Version 1.6a  W. Landsman  2006-09-22
;               Don't right-justify strings 
;       Version 1.7  W. Landsman  2009-01-12
;               Added STATUS output keyword
;       Version 1.7a W. Landsman 2009-04-10
;               Since V6.4 strings are no longer limited to 1024 elements 
;-

; What is the current version of this program?
function mwr_version
    return, '1.7a'
end
    

; Find the appropriate offset for a given unsigned type
; or just return 0 if the type is not unsigned.

function mwr_unsigned_offset, type
               
    if (type eq 12) then begin
       return, uint(32768)
    endif else if (type eq 13) then begin
       return, ulong('2147483648')
    endif else if (type eq 15) then begin
       return, ulong64('9223372036854775808')
    endif
    return, 0
end


; Add a keyword as non-destructively as possible to a FITS header
pro chk_and_upd, header, key, value, comment


    xcomm = ""
    if n_elements(comment) gt 0 then xcomm = comment
    if n_elements(header) eq 0 then begin
      
        fxaddpar, header, key, value, xcomm
       
    endif else begin
       
        oldvalue = fxpar(header, key, count=count, comment=oldcomment)
   
        if (count eq 1) then begin

           qchange = 0 ; Set to 1 if either the type of variable or its
                       ; value changes.
            size1 = size(oldvalue,/type) & size2 = size(value,/type)
            if size1 NE size2 then qchange = 1 $
            else if (oldvalue ne value) then qchange = 1

            if (qchange) then begin

               if n_elements(oldcomment) gt 0 then xcomm = oldcomment[0]
               fxaddpar, header, key, value, xcomm
              
           endif
           
       endif else begin
           
            fxaddpar, header, key, value, xcomm
        endelse
       
    endelse
end

; Get the column name appropriate for a given tag
function mwr_checktype, tag, alias=alias

    if not keyword_set(alias) then return, tag

    sz = size(alias)
    ; 1 or 2 D string array with first dimension of 2
    if (sz[0] eq 1 or sz[1] eq 2) and sz[1] eq 2 and sz[sz[0]+1] eq 7 then begin
       w = where(tag eq alias[0,*])
       if (w[0] eq -1) then begin
           return, tag
       endif else begin
           return, alias[1,w[0]]
       endelse
    endif else begin
       print,'MWRFITS: Warning: Alias values not strarr(2) or strarr(2,*)'
    endelse
    return, tag
end

; Create an ASCII table
pro mwr_ascii, input, siz, lun, bof, header,     $
        ascii=ascii,                             $
       null=null,                               $
       use_colnum = use_colnum,                 $
       lscale=lscale, iscale=iscale,               $
       bscale=bscale,                           $
       no_types=no_types,                      $
       separator=separator,                     $
       terminator=terminator,                   $
        no_comment=no_comment,                   $
       silent=silent,                           $
       alias=alias
       
    ; Write the header and data for a FITS ASCII table extension.
  
    types=  ['A',   'I',   'L',   'B',   'F',    'D',      'C',     'M',     'K']
    formats=['A1',  'I6',  'I10', 'I4',  'G15.9','G23.17', 'G15.9', 'G23.17','I20']
    lengths=[1,     6,     10,     4,    15,     23,       15,      23,      20]

    ; Check if the user is overriding any default formats.
    sz = size(ascii)

    if sz[0] eq 0 and sz[1] eq 7 then begin
        ascii = strupcase(strcompress(ascii,/remo))
        for i=0, n_elements(types)-1  do begin
            p = strpos(ascii,types[i]+':')
            if p ge 0 then begin

               q = strpos(ascii, ',', p+1)
               if q lt p then q = strlen(ascii)+1
               formats[i] = strmid(ascii, p+2, (q-p)-2)
               len = 0
           
               reads, formats[i], len, format='(1X,I)'
               lengths[i] = len
            endif
        endfor
    endif

    i0      = input[0]
    ntag    = n_tags(i0)
    tags    = tag_names(i0)
    ctypes  = lonarr(ntag)
    strmaxs = lonarr(ntag)

    if not keyword_set(separator) then separator=' '
    slen = strlen(separator)

    offsets = 0
    tforms = ''
    ttypes = ''
    offset = 0

    totalFormat = ""
    xsep = "";

    for i=0, ntag-1 do begin

        totalFormat = totalFormat + xsep;
    
        sz = size(i0.(i))
        if sz[0] ne 0 and (sz[sz[0]+1] ne 1) then begin
            print, 'MWRFITS Error: ASCII table cannot contain arrays'
           return
        endif

        ctypes[i] = sz[1]

        xtype = mwr_checktype(tags[i], alias=alias)
    
        ttypes = [ttypes, xtype+' ']

        if sz[0] gt 0 then begin
            ; Byte array to be handled as a string.
           nelem = sz[sz[0]+2]
           ctypes[i] = sz[sz[0]+1]
            tf = 'A'+strcompress(string(nelem))
            tforms = [tforms, tf]