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
|
include <tbset.h>
include "tbtables.h"
include "tblerr.h"
# tbhcal -- copy all header parameters
# All header (i.e. user) parameters are copied from the input to the
# output table, both of which must be open. This would normally be used
# for a recently created output table which would not have any parameters.
# If there are header parameter(s) in the output table (except for history
# or comments) that have the same keyword names as parameters in the input
# table, the records from the input replace those in the output.
#
# Phil Hodge, 31-Aug-1987 Subroutine created.
# Phil Hodge, 9-Mar-1989 Change dtype from char to int.
# Phil Hodge, 30-Jan-1992 Modify for text tables (copy comment buffer).
# Phil Hodge, 22-Apr-1994 Call tbbcmt to append comment buffer.
# Phil Hodge, 11-May-1994 Simplify text table section, and dereference
# pointer TB_COMMENT in call to tbbcmt.
# Phil Hodge, 6-Mar-1995 Also copy comment.
# Phil Hodge, 3-Apr-1995 Set TB_MODIFIED to true for text table.
# Phil Hodge, 14-Jun-1995 Modify for FITS tables.
# Phil Hodge, 30-Jan-1996 Set TB_MODIFIED to true.
# Phil Hodge, 7-Jun-1999 Copy parameters for a text table.
procedure tbhcal (itp, otp)
pointer itp # i: pointer to descriptor of input table
pointer otp # i: pointer to descriptor of output table
#--
pointer sp
pointer par # buffer for header record for parameter
pointer comment # scratch for comment string
pointer key # scratch for keyword names
pointer pnum # scratch for parameter number
char keyword[SZ_KEYWORD] # parameter name
int dtype # data type of parameter (ignored)
int parnum # parameter number
int j # loop index for par number in input table
int k # loop index for par number in output table
int numout # initial number of par in output table
int allout # total number of parameters for output table
int num_noncomment # number of non-comment parameters
int key_offset # an offset for keyword names in scratch array
int strncmp()
bool tbhisc()
errchk tbtchs, tbbcmt, tbfcal, tbhgnp, tbhpnp, tbhanp, tbhrpr, tbhwpr
begin
if ( ! TB_IS_OPEN(otp) )
call error (1, "tbhcal: output table is not open yet")
if (TB_READONLY(otp))
call error (ER_TBREADONLY,
"tbhcal: can't write to table; it's readonly")
if (TB_TYPE(itp) == TBL_TYPE_FITS || TB_TYPE(otp) == TBL_TYPE_FITS) {
call tbfcal (itp, otp)
TB_MODIFIED(otp) = true
return
}
if (TB_TYPE(otp) == TBL_TYPE_TEXT) {
# For a text table we also copy the comment buffer, but only
# if there's an input comment buffer.
if (TB_COMMENT(itp) != NULL)
call tbbcmt (otp, Memc[TB_COMMENT(itp)])
}
call smark (sp)
call salloc (par, SZ_PARREC, TY_CHAR)
call salloc (comment, SZ_PARREC, TY_CHAR)
# This will be zero if it's a new table.
numout = TB_NPAR(otp)
# Do we need more space for header parameters in the output table?
allout = numout + TB_NPAR(itp)
if (allout > TB_MAXPAR(otp))
call tbtchs (otp, allout+DEFMAXPAR, -1, -1, -1)
# Are there already some parameters in the output table?
if (numout > 0) {
call salloc (key, numout*SZ_KEYWORD, TY_CHAR)
call salloc (pnum, numout, TY_INT)
# Make a list of all non-comment keywords in output table.
num_noncomment = 0 # initial values
key_offset = key
do k = 1, numout {
# Get Nth parameter from output table (we just need
# the keyword name).
call tbhgnp (otp, k, keyword, dtype, Memc[par])
if ( ! tbhisc (keyword) ) {
# Not a comment, so add it to the list.
num_noncomment = num_noncomment + 1
call strcpy (keyword, Memc[key_offset], SZ_KEYWORD)
key_offset = key_offset + SZ_KEYWORD
Memi[pnum+num_noncomment-1] = k # param number
}
}
# Copy each input parameter.
do j = 1, TB_NPAR(itp) {
# Get Nth parameter and its comment from the input table.
call tbhgnp (itp, j, keyword, dtype, Memc[par])
call tbhgcm (itp, keyword, Memc[comment], SZ_PARREC)
parnum = 0 # initial values
key_offset = key
do k = 1, num_noncomment {
if (strncmp (keyword, Memc[key_offset], SZ_KEYWORD) == 0) {
parnum = Memi[pnum+k-1] # found it
break
} else {
key_offset = key_offset + SZ_KEYWORD
}
}
if (parnum > 0)
# It's already present in output table; put Nth parameter.
call tbhpnp (otp, parnum, keyword, dtype, Memc[par])
else
# Add new parameter; the output parnum is ignored.
call tbhanp (otp, keyword, dtype, Memc[par], parnum)
# Append the comment.
call tbhpcm (otp, keyword, Memc[comment])
}
} else {
# No parameters in output table yet; copy every parameter.
do j = 1, TB_NPAR(itp) {
call tbhrpr (itp, j, Memc[par])
call tbhwpr (otp, j, Memc[par])
}
TB_NPAR(otp) = TB_NPAR(itp)
}
TB_MODIFIED(otp) = true
call sfree (sp)
end
|
