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
170
171
172
173
174
175
176
177
178
179
180
181
182
|
include <ctype.h>
include <pkg/mef.h>
# MEFGVAL.X -- Set of routines to decode the value of a FITS keyword given
# the whole card.
# MEF_GVALI -- Return the integer value of a FITS encoded card.
procedure mef_gvali (card, ival)
char card[ARB] #I card to be decoded
int ival #O receives integer value
int ip, ctoi()
char sval[MEF_SZVALSTR]
begin
call mef_gvalt (card, sval, MEF_SZVALSTR)
ip = 1
if (ctoi (sval, ip, ival) <= 0)
ival = 0
end
# MEF_GVALR -- Return the real value of a FITS encoded card.
procedure mef_gvalr (card, rval)
char card[ARB] #I card to be decoded
real rval #O receives integer value
int ip, ctor()
char sval[MEF_SZVALSTR]
begin
call mef_gvalt (card, sval, MEF_SZVALSTR)
ip = 1
if (ctor (sval, ip, rval) <= 0)
rval = 0.0
end
# MEF_GVALD -- Return the double value of a FITS encoded card.
procedure mef_gvald (card, dval)
char card[ARB] #I card to be decoded
double dval #O receives integer value
int ip, ctod()
char sval[MEF_SZVALSTR]
begin
call mef_gvalt (card, sval, MEF_SZVALSTR)
ip = 1
if (ctod (sval, ip, dval) <= 0)
dval = 0.0
end
# MEF_GVALB -- Return the boolean/integer value of a FITS encoded card.
procedure mef_gvalb (card, bval)
char card[ARB] #I card to be decoded
int bval #O receives YES/NO
char sval[MEF_SZVALSTR]
begin
call mef_gvalt (card, sval, MEF_SZVALSTR)
if (sval[1] == 'T')
bval = YES
else
bval = NO
end
# MEF_GVALT -- Get the string value of a FITS encoded card. Strip leading
# and trailing whitespace and any quotes.
procedure mef_gvalt (card, outstr, maxch)
char card[ARB] #I FITS card to be decoded
char outstr[ARB] #O output string to receive parameter value
int maxch #I length of outstr
int ip, op
int ctowrd(), strlen()
begin
ip = FITS_STARTVALUE
if (ctowrd (card, ip, outstr, maxch) > 0) {
# Strip trailing whitespace.
op = strlen (outstr)
while (op > 0 && (IS_WHITE(outstr[op]) || outstr[op] == '\n'))
op = op - 1
outstr[op+1] = EOS
} else
outstr[1] = EOS
end
# MEF_GETCMT -- Get the comment field of a FITS encoded card.
procedure mef_getcmt (card, comment, maxch)
char card[ARB] #I FITS card to be decoded
char comment[ARB] #O output string to receive comment
int maxch #I max chars out
int ip, op
int lastch
begin
# Find the slash which marks the beginning of the comment field.
ip = FITS_ENDVALUE + 1
while (card[ip] != EOS && card[ip] != '\n' && card[ip] != '/')
ip = ip + 1
# Copy the comment to the output string, omitting the /, any
# trailing blanks, and the newline.
lastch = 0
do op = 1, maxch {
if (card[ip] == EOS)
break
ip = ip + 1
comment[op] = card[ip]
if (card[ip] > ' ')
lastch = op
}
comment[lastch+1] = EOS
end
# MEF_GLTM -- Procedure to convert an input time stream with hh:mm:ss
# and date stream dd/mm/yy into seconds from jan 1st 1980.
procedure mef_gltm (time, date, limtime)
char time[ARB] #I time
char date[ARB] #I date
int limtime #O seconds
int hr,mn,sec,days,month,year, ip, iy, days_per_year, ctoi(),i
int month_to_days[12], adays
data month_to_days / 0,31,59,90,120,151,181,212,243,273,304,334/
begin
ip = 1
ip = ctoi (time, ip, hr)
ip = 1
ip = ctoi (time[4], ip, mn)
ip = 1
ip = ctoi (time[7], ip, sec)
sec = sec + mn * 60 + hr * 3600
ip = 1
ip = ctoi (date, ip, days)
ip = 1
ip = ctoi (date[4], ip, month)
ip = 1
ip = ctoi (date[7], ip, year)
days_per_year = 0
iy = year + 1900
do i = 1, iy - 1980
days_per_year = days_per_year + 365
adays= (year-80)/4
if (month > 2) adays=adays+1
days = adays + days-1 + days_per_year + month_to_days[month]
limtime = sec + days * 86400
end
|
