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
|
include <tbset.h>
include "tbtables.h"
# This define is here only temporarily.
define TBL_MAXDIM 7 # maximum dimension of array in table
# This file contains tbciga and tbcisa. For a column that contains arrays,
# the dimension of the array and the length of each axis may be gotten or
# specified using these routines.
#
# For table types other than FITS, these routines just get or set the
# total array length.
#
# Phil Hodge, 18-Nov-1994 Subroutines created.
# Phil Hodge, 5-Jul-1995 Modify for FITS tables; change calling sequence.
# Phil Hodge, 5-Aug-1999 Use COL_NELEM instead of tbalen to get array length.
# tbciga -- get dimension of array and length of each axis
procedure tbciga (tp, cp, ndim, axlen, maxdim)
pointer tp # i: pointer to table descriptor
pointer cp # i: pointer to column descriptor
int ndim # o: dimension of array
int axlen[maxdim] # o: length of each axis
int maxdim # i: size of axlen array
#--
errchk tbfiga
begin
if (TB_TYPE(tp) == TBL_TYPE_FITS) {
call tbfiga (tp, cp, ndim, axlen, maxdim)
} else {
ndim = 1
axlen[1] = COL_NELEM(cp)
}
end
# tbcisa -- set dimension of array and length of each axis
procedure tbcisa (tp, cp, ndim, axlen)
pointer tp # i: pointer to table descriptor
pointer cp # i: pointer to column descriptor
int ndim # i: dimension of array
int axlen[ARB] # i: length of each axis
#--
pointer sp
pointer errmess # scratch for possible error message
pointer colname # scratch for column name
int nelem # actual total number of elements in array
int nvals # total number specified as input
int i
errchk tbfisa
begin
# Compare actual array size of column with the total number of
# elements specified as input.
nelem = COL_NELEM(cp)
nvals = 1
do i = 1, ndim
nvals = nvals * axlen[i]
if (nelem != nvals) {
call smark (sp)
call salloc (errmess, SZ_LINE, TY_CHAR)
call salloc (colname, SZ_COLNAME, TY_CHAR)
call tbcigt (cp, TBL_COL_NAME, Memc[colname], SZ_COLNAME)
call sprintf (Memc[errmess], SZ_LINE,
"tbcisa: column `%s', actual array size=%d, specified size=%d")
call pargstr (Memc[colname])
call pargi (nelem)
call pargi (nvals)
call error (1, Memc[errmess])
}
# Check whether dimension is too large.
if (ndim > TBL_MAXDIM) {
call smark (sp)
call salloc (errmess, SZ_LINE, TY_CHAR)
call salloc (colname, SZ_COLNAME, TY_CHAR)
call tbcigt (cp, TBL_COL_NAME, Memc[colname], SZ_COLNAME)
call sprintf (Memc[errmess], SZ_LINE,
"tbcisa: column `%s', dimension %d is too large")
call pargstr (Memc[colname])
call pargi (ndim)
call error (1, Memc[errmess])
}
# Assign values in column descriptor.
if (TB_TYPE(tp) == TBL_TYPE_FITS) {
call tbfisa (tp, cp, ndim, axlen)
}
# else nothing
end
|
