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
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
|
include <error.h>
include <pkg/mef.h>
define MEF_PLSIZE MEF_CGROUP
# MEF_WRPL --
procedure mef_wrpl (mef, title, ctime,mtime, limtime, minval,
maxval,plbuf, naxis, axlen)
char title[ARB]
int ctime, mtime, limtime
real minval, maxval
pointer mef #I input mef descriptor
short plbuf #I Pixel list buffer
int naxis, axlen[ARB]
pointer sp, ln, mii, hb
char blank[1]
int output_lines, npad, i
int pcount, fd, nlines
bool endk, new_outf
errchk open, fcopyo
begin
call smark (sp)
call salloc (ln, LEN_CARDNL, TY_CHAR)
# Output file descriptor
fd = MEF_FD(mef)
new_outf = false
if (MEF_ACMODE(mef) == NEW_IMAGE)
new_outf = true
output_lines = 0
endk = false
# Create a PHU
if (new_outf) {
# Must create a dummy header if input extension is not image
Memc[ln] = EOS
call mef_dummyhdr (fd, Memc[ln])
new_outf = false
}
call mef_wcardc ("XTENSION", "BINTABLE", "Extension type", fd)
call mef_wcardi ("BITPIX", 8, "Default value", fd)
call mef_wcardi ("NAXIS", 2, "Lines and cols", fd)
call mef_wcardi ("NAXIS1", 8, "Nbytes per line", fd)
call mef_wcardi ("NAXIS2", 1, "Nlines", fd)
# Calculate the number of 2880 bytes block the heap will
# occupy.
pcount = ((MEF_PLSIZE(mef)+1439)/1440)*2880
call mef_wcardi ("PCOUNT", pcount, "Heap size in bytes", fd)
call mef_wcardi ("GCOUNT", 1, "1 Group", fd)
call mef_wcardi ("TFIELDS", 1, "1 Column field", fd)
call sprintf (Memc[ln], LEN_CARD, "PI(%d)")
call pargi(MEF_PLSIZE(mef))
call mef_wcardc ("TFORM1", Memc[ln], "Variable word array", fd)
call mef_wcardb ("INHERIT", NO, "No Inherit", fd)
call mef_wcardc ("ORIGIN", FITS_ORIGIN, "FITS file originator", fd)
call mef_wcardc ("EXTNAME", MEF_EXTNAME(mef), "", fd)
call mef_wcardi ("EXTVER", MEF_EXTVER(mef), "", fd)
call mef_wcardi ("CTIME", ctime, "", fd)
call mef_wcardi ("MTIME", mtime, "", fd)
call mef_wcardi ("LIMTIME", limtime, "", fd)
call mef_wcardr ("DATAMIN", minval, "", fd)
call mef_wcardr ("DATAMAX", maxval, "", fd)
call mef_wcardc ("OBJECT", title, "", fd)
call mef_wcardb ("CMPIMAGE", YES, "Is a compressed image", fd)
call mef_wcardc ("CMPTYPE", "PLIO_1", "IRAF image masks", fd)
call mef_wcardi ("CBITPIX", 32, "BITPIX for uncompressed image", fd)
call mef_wcardi ("CNAXIS", naxis, "NAXIS for uncompressed image", fd)
do i = 1, naxis {
call sprintf (Memc[ln], LEN_CARD, "NAXIS%d")
call pargi(i)
call mef_wcardi ("CNAXIS", axlen[i], "axis length", fd)
}
hb = MEF_HDRP(mef)
output_lines = 23
nlines = MEF_HSIZE(mef) / LEN_CARDNL
for (i=1; i<= nlines; i=i+1) {
call mef_pakwr (fd, Memc[hb])
hb = hb + LEN_CARDNL
}
blank[1] = ' '
call amovkc (blank, Memc[ln], 80)
call strcpy ("END", Memc[ln], 3)
Memc[ln+3] = ' ' # Clear EOS mark
call mef_pakwr (fd, Memc[ln])
output_lines = output_lines + nlines + 1 + naxis
call mef_wrblank (fd, output_lines)
call salloc (mii, 1400, TY_INT)
# Now write 2 integers as table data (nelem,offset)
Memi[mii] = MEF_PLSIZE(mef) # Number of words in pl buff (2bytes)
Memi[mii+1] = 0 # Offset from start of heap
npad = 1438
call amovki (0, Memi[mii+2], npad)
call write (fd, Memi[mii], 1440)
# Write mask in heap area
call write (fd, plbuf, MEF_PLSIZE(mef)*SZ_SHORT)
# Pad to 1440 characters block in case we want to append another
# extension
npad = 1440 - mod (MEF_PLSIZE(mef), 1440)
call amovki (0, Memi[mii], npad)
call write (fd, Memi[mii], npad)
call sfree(sp)
end
procedure mef_wcardi (kname, kvalue, kcomm, fd)
char kname[ARB] #I Keyword name
int kvalue #I Keyword value
char kcomm[ARB] #I Card comment
int fd #I file descriptor
pointer sp, ln
begin
call smark (sp)
call salloc (ln, LEN_CARDNL, TY_CHAR)
call mef_encodei (kname, kvalue, Memc[ln], kcomm)
call mef_pakwr (fd, Memc[ln])
call sfree (sp)
end
procedure mef_wcardc (kname, kvalue, kcomm, fd)
char kname[ARB] #I Keyword name
char kvalue[ARB] #I Keyword value
char kcomm[ARB] #I Card comment
int fd #I file descriptor
pointer sp, ln
int slen, strlen()
begin
call smark (sp)
call salloc (ln, LEN_CARDNL, TY_CHAR)
slen = strlen(kvalue)
call mef_encodec (kname, kvalue, slen, Memc[ln], kcomm)
call mef_pakwr (fd, Memc[ln])
call sfree(sp)
end
procedure mef_wcardb (kname, kvalue, kcomm, fd)
char kname[ARB] #I Keyword name
int kvalue #I Keyword value
char kcomm[ARB] #I Card comment
int fd #I file descriptor
pointer sp, ln
begin
call smark (sp)
call salloc (ln, LEN_CARDNL, TY_CHAR)
call mef_encodeb (kname, kvalue, Memc[ln], kcomm)
call mef_pakwr (fd, Memc[ln])
call sfree(sp)
end
procedure mef_wcardr (kname, kvalue, kcomm, fd)
char kname[ARB] #I Keyword name
real kvalue #I Keyword value
char kcomm[ARB] #I Card comment
int fd #I file descriptor
pointer sp, ln
begin
call smark (sp)
call salloc (ln, LEN_CARDNL, TY_CHAR)
call mef_encoder (kname, kvalue, Memc[ln], kcomm, 6)
call mef_pakwr (fd, Memc[ln])
call sfree(sp)
end
|
