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
|
C--------------------------------------------------------------------------
subroutine ftgatp(ibuff,keynam,value,status)
C Get ASCII Table Parameter
C test if the keyword is one of the table column definition keywords
C of an ASCII table. If so, decode it and update the value in the common
C block
C ibuff i sequence number of the data buffer
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
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)
C tfield = number of fields in the table
C tbcol = byte offset in the row of the beginning of the column
C rowlen = length of one row of the table, in bytes
C tdtype = integer code representing the datatype of the column
C trept = the repeat count = number of data values/element in the column
C tnull = the value used to represent an undefined value in the column
C tscale = the scale factor for the column
C tzero = the scaling zero point for the column
C scount = the total size of the binary table heap (+ gap if any)
C theap = the starting byte offset for the binary table heap, relative
C to the start of the binary table data
C nxheap = the next empty heap location
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 cnull = character string representing nulls in character columns
C cform = the Fortran format of the column
character cnull*16, cform*8
common/ft0003/cnull(nf),cform(nf)
C-------END OF COMMON BLOCK DEFINITIONS-----------------------------------
integer nfield,i,c2,bcol,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)
if (status .gt. 0)return
if (tform(1:1) .ne. 'A' .and. tform(1:1) .ne. 'I'
& .and. tform(1:1) .ne. 'F' .and. tform(1:1) .ne. 'E'
& .and. tform(1:1) .ne. 'D')then
status=311
call ftpmsg('Illegal '//keynam//' format code: '
& //tform)
return
end if
cform(nfield+tstart(ibuff))=tform
C set numeric data type code to indicate an ASCII table field
tdtype(nfield+tstart(ibuff))=16
C set the repeat count to 1
trept(nfield+tstart(ibuff))=1
C set the TNULL parameter to the width of the field:
c2=0
do 10 i=2,8
if (tform(i:i) .ge. '0' .and. tform(i:i)
& .le. '9')then
c2=i
else
go to 20
end if
10 continue
20 continue
if (status .gt. 0)return
if (c2 .eq. 0)then
C no explicit field width, so assume width=1 character
tnull(nfield+tstart(ibuff))=1
else
call ftc2ii(tform(2:c2),tnull(nfield+
& tstart(ibuff)),status)
if (status .gt. 0)then
C error parsing the TFORM value string
status=261
call ftpmsg('Error parsing '//keynam//' field width: '
& //tform)
end if
end if
end if
else if (keynam(1:5) .eq. 'TBCOL')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 TBCOLn keyword
status=tstat
else
C get the beginning column number
call ftc2ii(value,bcol,status)
if (status .gt. 0)then
call ftpmsg('Error reading value of '//keynam
& //' as an integer: '//value)
else
tbcol(nfield+tstart(ibuff))=bcol-1
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 get the Null value flag (character)
call ftc2s(value,cnull(nfield+tstart(ibuff)),status)
if (status .gt. 0)then
call ftpmsg('Error reading value of'//keynam
& //' as a character string: '//value)
end if
end if
end if
end
|
