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
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
|
include <tbset.h>
include "tbtables.h"
include "tblfits.h"
# tbfrcd -- read all column descriptors
# For a FITS table, this routine reads the information describing all
# columns, and it assigns values to the column descriptors. Memory
# for the column descriptors is assumed to already have been allocated.
# (This is called by tbuopn.)
#
# Phil Hodge, 6-Jul-1995 Subroutine created
# Phil Hodge, 14-Apr-1998 Use strcpy instead of strpak or tbcftp for
# column name, units, and print format.
# Phil Hodge, 7-Jun-1999 Use TB_SUBTYPE instead of TB_HDUTYPE.
# Phil Hodge, 5-Aug-1999 Rewrite so that it reads all column info
# in one call, not just the info for a single column;
# in tbfcd3, assign COL_NELEM.
# Phil Hodge, 23-Jun-2000 The first character of TSCALi & TZEROi was being
# truncated. Assign values to COL_TDTYPE, COL_TSCAL, COL_TZERO;
# change default values of tscal & tzero to 1. & 0. respectively.
procedure tbfrcd (tp, cp, ncols)
pointer tp # i: pointer to table descriptor
pointer cp[ARB] # i: pointers to column descriptors
int ncols # i: number of columns in cp array
#--
pointer sp
pointer ttype # scratch for column name
pointer tform # scratch for column format
pointer tunit # scratch for column unit
pointer tdisp # scratch for display format
pointer tscal, tzero # parameters for scaling from integer to floating
errchk tbfcd1, tbfcd2, tbfcd3
begin
if (ncols < 1)
return
call smark (sp)
call salloc (ttype, (SZ_FTTYPE+1)*ncols, TY_CHAR)
call salloc (tform, (SZ_FTFORM+1)*ncols, TY_CHAR)
call salloc (tunit, (SZ_FTUNIT+1)*ncols, TY_CHAR)
call salloc (tdisp, (SZ_FTTYPE+1)*ncols, TY_CHAR)
call salloc (tscal, ncols, TY_DOUBLE)
call salloc (tzero, ncols, TY_DOUBLE)
# Initialize these arrays to null or indef.
call tbfcd1 (Memc[ttype], Memc[tform], Memc[tunit], Memc[tdisp],
Memd[tscal], Memd[tzero], ncols)
# Read each keyword in the header, and assign values to these
# arrays as keywords are found.
call tbfcd2 (tp,
Memc[ttype], Memc[tform], Memc[tunit], Memc[tdisp],
Memd[tscal], Memd[tzero], ncols)
# Loop over columns, interpret info from these arrays, and
# assign to column descriptors.
call tbfcd3 (tp, cp,
Memc[ttype], Memc[tform], Memc[tunit], Memc[tdisp],
Memd[tscal], Memd[tzero], ncols)
call sfree (sp)
end
# This routine initializes the array values to null or INDEFD.
procedure tbfcd1 (ttype, tform, tunit, tdisp,
tscal, tzero, ncols)
char ttype[SZ_FTTYPE,ncols] # o: will be initialized to null
char tform[SZ_FTFORM,ncols] # o: will be initialized to null
char tunit[SZ_FTUNIT,ncols] # o: will be initialized to null
char tdisp[SZ_FTTYPE,ncols] # o: will be initialized to null
double tscal[ncols] # o: will be initialized to 1.
double tzero[ncols] # o: will be initialized to 0.
int ncols # i: size of arrays
#--
int col
begin
do col = 1, ncols {
ttype[1,col] = EOS
tform[1,col] = EOS
tunit[1,col] = EOS
tdisp[1,col] = EOS
tscal[col] = 1.d0
tzero[col] = 0.d0
}
end
# This routine reads each header record, checks whether the keyword is one
# of the those that define a column, and if so, extracts the information
# to the appropriate output array.
procedure tbfcd2 (tp,
ttype, tform, tunit, tdisp,
tscal, tzero, ncols)
pointer tp # i: pointer to table descriptor
char ttype[SZ_FTTYPE,ncols] # o: will be assigned if keyword found
char tform[SZ_FTFORM,ncols] # o: will be assigned if keyword found
char tunit[SZ_FTUNIT,ncols] # o: will be assigned if keyword found
char tdisp[SZ_FTTYPE,ncols] # o: will be assigned if keyword found
double tscal[ncols] # o: will be assigned if keyword found
double tzero[ncols] # o: will be assigned if keyword found
int ncols # i: size of arrays
#--
pointer sp
pointer buf # scratch for header record
pointer value # scratch for keyword value
pointer comment # scratch for comment for keyword
double x # tscal or tzero
int parnum # loop index for keyword number
int col # column number, read from keyword name
int ip, ctoi(), ctod()
int strncmp(), strlen()
int status # = 0 is OK
errchk tbferr
begin
status = 0
call smark (sp)
call salloc (buf, SZ_FNAME, TY_CHAR)
call salloc (value, SZ_FNAME, TY_CHAR)
call salloc (comment, SZ_FNAME, TY_CHAR)
# Read each keyword in the header.
do parnum = 1, TB_NPAR(tp) {
# Read the record as a string.
call fsgrec (TB_FILE(tp), parnum, Memc[buf], status)
if (status != 0)
call tbferr (status)
if (Memc[buf] != 'T')
next
ip = 6 # first character of the column number
if (ctoi (Memc[buf], ip, col) < 1)
next
# Reject keywords such as "TTYPE5X".
if (Memc[buf+ip-1] != ' ' && Memc[buf+ip-1] != '=')
next
# Extract the value.
call fspsvc (Memc[buf], Memc[value], Memc[comment], status)
if (status != 0)
call tbferr (status)
# Trim trailing and leading blanks and single quotes.
ip = strlen (Memc[value]) - 1 # zero indexed
while (Memc[value+ip] == ' ' || Memc[value+ip] == '\'') {
Memc[value+ip] = EOS
ip = ip - 1
}
ip = 0
while (Memc[value+ip] == ' ' || Memc[value+ip] == '\'')
ip = ip + 1
# Check to see whether this is one of the keywords that we need,
# and if so, copy the value to the output array.
if (strncmp (Memc[buf], "TTYPE", 5) == 0) {
call strcpy (Memc[value+ip], ttype[1,col], SZ_FTTYPE)
} else if (strncmp (Memc[buf], "TFORM", 5) == 0) {
call strcpy (Memc[value+ip], tform[1,col], SZ_FTFORM)
} else if (strncmp (Memc[buf], "TUNIT", 5) == 0) {
call strcpy (Memc[value+ip], tunit[1,col], SZ_FTUNIT)
} else if (strncmp (Memc[buf], "TDISP", 5) == 0) {
call strcpy (Memc[value+ip], tdisp[1,col], SZ_FTTYPE)
} else if (strncmp (Memc[buf], "TSCAL", 5) == 0) {
ip = 1
if (ctod (Memc[value], ip, x) < 1)
call error (1, "can't interpret TSCAL keyword")
tscal[col] = x
} else if (strncmp (Memc[buf], "TZERO", 5) == 0) {
ip = 1
if (ctod (Memc[value], ip, x) < 1)
call error (1, "can't interpret TZERO keyword")
tzero[col] = x
}
}
call sfree (sp)
end
# This routine interprets the contents of the ttype, etc, arrays
# and assigns values to the column descriptors.
procedure tbfcd3 (tp, cp,
ttype, tform, tunit, tdisp,
tscal, tzero, ncols)
pointer tp # i: pointer to table descriptor
pointer cp[ncols] # i: pointers to column descriptors
char ttype[SZ_FTTYPE,ncols] # i: array of column names
char tform[SZ_FTFORM,ncols] # i: array that defines data types
char tunit[SZ_FTUNIT,ncols] # i: array of column units
char tdisp[SZ_FTTYPE,ncols] # i: array of print formats
double tscal[ncols] # i: array of tscal values
double tzero[ncols] # i: array of tzero values
int ncols # i: size of arrays
#--
char pform[SZ_COLFMT] # print format for column
int col # loop index for column number
errchk tbftya, tbftyb
begin
do col = 1, ncols {
# If there's no column name, assign a default.
if (ttype[1,col] == EOS) {
call sprintf (ttype[1,col], SZ_FTTYPE, "c%d")
call pargi (col)
}
if (tform[1,col] == EOS)
call error (1, "TFORM not specified; this keyword is required")
# Determine the data type, print format and array length.
if (TB_SUBTYPE(tp) == TBL_SUBTYPE_ASCII) {
call tbftya (tform[1,col], tdisp[1,col],
tscal[col], tzero[col],
COL_TDTYPE(cp[col]), COL_DTYPE(cp[col]),
pform, SZ_COLFMT, COL_LEN(cp[col]))
COL_NELEM(cp[col]) = 1 # does not support arrays
} else if (TB_SUBTYPE(tp) == TBL_SUBTYPE_BINTABLE) {
call tbftyb (tform[1,col], tdisp[1,col],
tscal[col], tzero[col],
COL_TDTYPE(cp[col]), COL_DTYPE(cp[col]),
pform, SZ_COLFMT,
COL_NELEM(cp[col]), COL_LEN(cp[col]))
} else {
call error (1, "tbfrcd: invalid HDU type")
}
# Assign values to column descriptor.
COL_NUMBER(cp[col]) = col
COL_OFFSET(cp[col]) = 0 # meaningless
COL_TSCAL(cp[col]) = tscal[col]
COL_TZERO(cp[col]) = tzero[col]
call strcpy (ttype[1,col], COL_NAME(cp[col]), SZ_COLNAME)
call strcpy (tunit[1,col], COL_UNITS(cp[col]), SZ_COLUNITS)
call strcpy (pform, COL_FMT(cp[col]), SZ_COLFMT)
}
end
|
