gdl-astrolib 2018.02.16+dfsg-1 / usr / share / gnudatalanguage / astrolib / ftaddcol.pro

This file is indexed.

/usr/share/gnudatalanguage/astrolib/ftaddcol.pro is in gdl-astrolib 2018.02.16+dfsg-1.

This file is owned by root:root, with mode 0o644.

The actual contents of the file can be viewed below. 

  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
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
pro ftaddcol,h,tab,name,idltype,tform,tunit,tscal,tzero,tnull
;+
; NAME:
;      FTADDCOL
; PURPOSE:
;      Routine to add a field to a FITS ASCII table
;
; CALLING SEQUENCE:
;      ftaddcol, h, tab, name, idltype, [ tform, tunit, tscal, tzero, tnull ]
;
; INPUTS:
;      h - FITS table header.  It will be updated as appropriate
;      tab - FITS table array.  Number of columns will be increased if
;               neccessary.
;      name - field name, scalar string
;      idltype - idl data type (as returned by SIZE function) for field,
;               For string data (type=7) use minus the string length.
;
; OPTIONAL INPUTS:
;       tform - format specification 'qww.dd' where q = A, I, E, or D
;       tunit - string giving physical units for the column.
;       tscal - scale factor
;       tzero - zero point for field
;       tnull - null value for field
;
;       Use '' as the value of tform,tunit,tscal,tzero,tnull if you want
;       the default or no specification of them in the table header.
;
; OUTPUTS:
;       h,tab - updated to allow new column of data
;
; PROCEDURES USED:
;       FTINFO, FTSIZE, GETTOK(), SXADDPAR
; HISTORY:
;       version 1  D. Lindler   July, 1987
;       Converted to IDL V5.0   W. Landsman   September 1997
;       Updated call to new FTINFO   W. Landsman   April 2000
;-
  On_error,2
  if N_params() LT 2 then begin
      print,'Syntax - FTADDCOL, h, tab, name, idltype, ' 
      print,'                [ tform, tunit, tscal, tzero, tnull ]'
      return
  endif

; get table size

 ftsize,h,tab,ncols,nrows,tfields,allcols,allrows

; check to see if column name is a string

 s = size(name)
 if (s[0] NE 0) or (s[1] NE 7) then $
        message,'Column name must be a string'

; check to see if column already exists

 ftinfo,h,ft_str, Count = count
 if Count GT 0 then begin
    g = where(strtrim(ft_str.ttype,2) EQ strupcase(name), Ng)
    if Ng GT 0 then message,'ERROR - Column '+name+' already exists'
 endif

; set non specified inputs to ''

 npar = N_params()
 if npar lt 5 then tform = ''
 if npar lt 6 then tunit = ''
 if npar lt 7 then tscal = ''
 if npar lt 8 then tzero = ''
 if npar lt 9 then tnull = ''

; create default format if not supplied

 if tform eq '' then begin
        case idltype of
                1:      tform = 'I4'            ;byte
                2:      tform = 'I6'            ;integer*2
                4:      tform = 'E15.8'         ;real*4
                3:      tform = 'I11'           ;longword
                5:      tform = 'D23.8'         ;real*8
                else: begin
                        if idltype LT 0 then begin      ;string
                            tform = 'A'+strtrim(fix(abs(idltype)),2)
                            idltype = 7
                          end else message,'Invalid idltype specified'
                      end
        end; case
 end

; get field width from format

 width = fix(gettok(strmid(tform,1,strlen(tform)-1),'.'))

;
; is present allocated table size large enough?
;
;  If the new field is not a string, put a zero in the leftmost position
;  of the record so that a "Type conversion error" won't occur.
;
 if (width+ncols) GT allcols then begin
    tab = [ tab, replicate(32B,width,allrows)]          ;increase size  
    if (idltype NE 7) then tab[allcols,*] = 48B
 endif

;
; update header
;
 tfields = tfields+1
 apos = strtrim(tfields,2)
 ttype = strupcase(name)                                        ;ttype
 while strlen(ttype) lt 8 do ttype = ttype+' '
 sxaddpar,h,'TTYPE'+apos,ttype,'','HISTORY'

;
 sxaddpar,h,'TBCOL'+apos,ncols+1,'','HISTORY'           ;tbcol (WBL 2-88)

;
 while strlen(tform) lt 8 do tform = tform+' '          ;tform
 sxaddpar,h,'TFORM'+apos,tform,'','HISTORY'


 if tunit NE '' then begin                              ;tunit
        while strlen(tunit) lt 8 do tunit = tunit+' '
        sxaddpar,h,'tunit'+apos,tunit,'','HISTORY'
 end

 if string(tscal) NE '' then $
        sxaddpar,h,'tscal'+apos,tscal,'','HISTORY'      ;tscal


 if string(tzero) NE '' then $
        sxaddpar,h,'tzero'+apos,tzero,'','HISTORY'      ;tzero

 if string(tnull) NE '' then begin                      ;tnull
        s = size(tnull) & type = s[s[0]+1]
        if type NE 1 then stnull = string(tnull,'('+strtrim(tform)+')') $
                     else stnull = tnull
        while strlen(stnull) LT 8 do stnull = stnull+' '
        sxaddpar, h, 'TNULL' + apos, stnull, '', 'HISTORY'
 end

;
; increase table size in header
;
 sxaddpar,h,'TFIELDS',tfields
 sxaddpar,h,'NAXIS1',ncols+width

 return
 end

APT Browse - Built by Thomas Orozco.