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
|
C--------------------------------------------------------------------------
subroutine ftgbtp(ibuff,keynam,value,status)
C Get Binary Table Parameter
C test if the keyword is one of the table column definition keywords
C of a binary table. If so, decode it and update the values in the common
C block
C ibuff i sequence number of the data buffer
C OUTPUT PARAMETERS:
C keynam c name of the keyword
C value c value of the keyword
C status i returned error status (0=ok)
C
C written by Wm Pence, HEASARC/GSFC, June 1991
integer ibuff,status,width
character keynam*8,value*70
C-------COMMON BLOCK DEFINITIONS:--------------------------------------------
C nb = number of file buffers = max. number of FITS file opened at once
C nf = maximum number of fields allowed in a table
integer nf,nb
parameter (nb = 20)
parameter (nf = 3000)
integer tfield,tstart,tbcol,rowlen,tdtype,trept,tnull,scount
integer theap,nxheap
double precision tscale,tzero
common/ft0002/tfield(nb),tstart(nb),tbcol(nf),rowlen(nb),
& tdtype(nf),trept(nf),tscale(nf),tzero(nf),tnull(nf),scount(nb)
& ,theap(nb),nxheap(nb)
C-------END OF COMMON BLOCK DEFINITIONS-----------------------------------
integer nfield,tstat
character tform*16
if (status .gt. 0)return
tstat=status
if (keynam(1:5) .eq. 'TFORM')then
C get the field number
call ftc2ii(keynam(6:8),nfield,status)
if (status .gt. 0)then
C this must not have been a TFORMn keyword
status=tstat
else
C get the TFORM character string, without quotes
call ftc2s(value,tform,status)
C get the datatype code and repeat count
call ftbnfm(tform,tdtype(nfield+tstart(ibuff)),
& trept(nfield+tstart(ibuff)),width,status)
if (tdtype(nfield+tstart(ibuff)) .eq. 1)then
C treat Bit datatype as if it were a Byte datatype
tdtype(nfield+tstart(ibuff))=11
trept(nfield+tstart(ibuff))=(trept(nfield+
& tstart(ibuff))+7)/8
else if (tdtype(nfield+tstart(ibuff)) .eq. 16)then
C store the width of the ASCII field in the TNULL parameter
tnull(nfield+tstart(ibuff))=width
end if
end if
else if (keynam(1:5) .eq. 'TSCAL')then
C get the field number
call ftc2ii(keynam(6:8),nfield,status)
if (status .gt. 0)then
C this must not have been a TSCALn keyword
status=tstat
else
C get the scale factor
call ftc2dd(value,tscale(nfield+tstart(ibuff)),
& status)
if (status .gt. 0)then
call ftpmsg('Error reading value of'//keynam
& //' as a Double: '//value)
end if
end if
else if (keynam(1:5) .eq. 'TZERO')then
C get the field number
call ftc2ii(keynam(6:8),nfield,status)
if (status .gt. 0)then
C this must not have been a TZEROn keyword
status=tstat
else
C get the scaling zero point
call ftc2dd(value,tzero(nfield+tstart(ibuff)),
& status)
if (status .gt. 0)then
call ftpmsg('Error reading value of'//keynam
& //' as a Double: '//value)
end if
end if
else if (keynam(1:5) .eq. 'TNULL')then
C get the field number
call ftc2ii(keynam(6:8),nfield,status)
if (status .gt. 0)then
C this must not have been a TNULLn keyword
status=tstat
else
C make sure this is not an ASCII column (the tnull
C variable is use to store the ASCII column width)
if (tdtype(nfield+tstart(ibuff)) .ne. 16)then
C get the Null value flag (Integer)
call ftc2ii(value,tnull(nfield+tstart(ibuff)),
& status)
if (status .gt. 0)then
call ftpmsg('Error reading value of '//
& keynam//' as an integer: '//value)
end if
end if
end if
else if (keynam(1:8) .eq. 'THEAP ')then
C get the heap offset value
call ftc2ii(value,theap(ibuff),status)
if (status .gt. 0)then
call ftpmsg('Error reading value of '//keynam
& //' as an integer: '//value)
end if
end if
end
|
