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
|
C----------------------------------------------------------------------
subroutine ftgtbn(iunit,ncols,nrows,pcount,nfield,status)
C check that this is a valid binary table and get parameters
C
C iunit i Fortran i/o unit number
C ncols i width of each row of the table, in bytes
C nrows i number of rows in the table
C pcount i size of special data area following the table (usually = 0)
C nfield i number of fields in the table
C status i returned error status (0=ok)
C
C written by Wm Pence, HEASARC/GSFC, June 1991
integer iunit,ncols,nrows,nfield,pcount,status
character keynam*8,value*10,comm*8,rec*80
if (status .gt. 0)return
C check for correct type of extension
call ftgrec(iunit,1,rec,status)
if (status .gt. 0)go to 900
keynam=rec(1:8)
if (keynam .eq. 'XTENSION')then
call ftpsvc(rec,value,comm,status)
if (status .gt. 0)go to 900
if (value(2:9) .ne. 'BINTABLE' .and.
& value(2:9) .ne. 'A3DTABLE' .and.
& value(2:9) .ne. '3DTABLE ')then
C this is not a binary table extension
status=227
go to 900
end if
else
status=225
go to 900
end if
C check that the second keyword is BITPIX = 8
call fttkyn(iunit,2,'BITPIX','8',status)
if (status .eq. 208)then
C BITPIX keyword not found
status=222
else if (status .eq. 209)then
C illegal value of BITPIX
status=211
end if
if (status .gt. 0)go to 900
C check that the third keyword is NAXIS = 2
call fttkyn(iunit,3,'NAXIS','2',status)
if (status .eq. 208)then
C NAXIS keyword not found
status=223
else if (status .eq. 209)then
C illegal NAXIS value
status=212
end if
if (status .gt. 0)go to 900
C check that the 4th keyword is NAXIS1 and get it's value
call ftgtkn(iunit,4,'NAXIS1',ncols,status)
if (status .eq. 208)then
C NAXIS1 keyword not found
status=224
else if (status .eq. 209)then
C illegal value of NAXISnnn
status=213
end if
if (status .gt. 0)go to 900
C check that the 5th keyword is NAXIS2 and get it's value
call ftgtkn(iunit,5,'NAXIS2',nrows,status)
if (status .eq. 208)then
C NAXIS2 keyword not found
status=224
else if (status .eq. 209)then
C illegal value of NAXISnnn
status=213
end if
if (status .gt. 0)go to 900
C check that the 6th keyword is PCOUNT and get it's value
call ftgtkn(iunit,6,'PCOUNT',pcount,status)
if (status .eq. 208)then
C PCOUNT keyword not found
status=228
else if (status .eq. 209)then
C illegal PCOUNT value
status=214
end if
if (status .gt. 0)go to 900
C check that the 7th keyword is GCOUNT = 1
call fttkyn(iunit,7,'GCOUNT','1',status)
if (status .eq. 208)then
C GCOUNT keyword not found
status=229
else if (status .eq. 209)then
C illegal value of GCOUNT
status=215
end if
if (status .gt. 0)go to 900
C check that the 8th keyword is TFIELDS and get it's value
call ftgtkn(iunit,8,'TFIELDS',nfield,status)
if (status .eq. 208)then
C TFIELDS keyword not found
status=230
else if (status .eq. 209)then
C illegal value of TFIELDS
status=216
end if
900 continue
if (status .gt. 0)then
call ftpmsg('Failed to parse the required keywords in '//
& 'the binary BINTABLE header (FTGTTB).')
end if
end
|
