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
214
215
216
|
# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
include <mach.h>
include <error.h>
include <fset.h>
include "wfits.h"
# T_WFITS -- This procedure converts a series of IRAF image files to
# FITS image files.
procedure t_wfits ()
char iraf_files[SZ_FNAME] # list of IRAF images
char fits_files[SZ_FNAME] # list of FITS files
bool newtape # new or used tape ?
char in_fname[SZ_FNAME] # input file name
char out_fname[SZ_FNAME] # output file name
int imlist, flist, nimages, nfiles, file_number
bool clgetb()
double clgetd()
int imtopen(), imtlen (), wft_get_bitpix(), clgeti(), imtgetim()
int mtfile(), btoi(), fstati(), fntlenb(), fntgfnb(), mtneedfileno()
int wft_blkfac(), fntrfnb(), strlen()
pointer fntopnb()
include "wfits.com"
begin
# Flush on a newline if STDOUT has not been redirected.
if (fstati (STDOUT, F_REDIR) == NO)
call fseti (STDOUT, F_FLUSHNL, YES)
# Open iraf_files template and determine number of files in list.
call clgstr ("iraf_files", iraf_files, SZ_FNAME)
imlist = imtopen (iraf_files)
nimages = imtlen (imlist)
# Get the wfits parameters.
long_header = btoi (clgetb ("long_header"))
short_header = btoi (clgetb ("short_header"))
make_image = btoi (clgetb ("make_image"))
# Get the FITS bits per pixel and the FITS logical record size.
bitpix = wft_get_bitpix (clgeti ("bitpix"))
len_record = FITS_RECORD
# Get the scaling parameters.
scale = btoi (clgetb ("scale"))
if (scale == YES) {
if (clgetb ("autoscale"))
autoscale = YES
else {
bscale = clgetd ("bscale")
bzero = clgetd ("bzero")
autoscale = NO
}
} else {
autoscale = NO
bscale = 1.0d0
bzero = 0.0d0
}
# Get the output file name and type (tape or disk). If no tape file
# number is given for output, the user is asked if the tape is blank
# or contains data. If the tape is blank output begins at BOT,
# otherwise at EOT.
if (make_image == YES) {
call clgstr ("fits_files", fits_files, SZ_FNAME)
if (mtfile (fits_files) == YES) {
flist = NULL
if (mtneedfileno (fits_files) == YES) {
newtape = clgetb ("newtape")
if (newtape)
call mtfname (fits_files, 1, out_fname, SZ_FNAME)
else
call mtfname (fits_files, EOT, out_fname, SZ_FNAME)
} else {
call strcpy (fits_files, out_fname, SZ_FNAME)
newtape = false
}
} else {
flist = fntopnb (fits_files, NO)
nfiles = fntlenb (flist)
if ((nfiles > 1) && (nfiles != nimages))
call error (0,
"T_WFITS: Input and output lists are not the same length")
}
} else {
fits_files[1] = EOS
flist = NULL
}
# Get the fits file blocking factor.
blkfac = wft_blkfac (fits_files, clgeti ("blocking_factor"))
# Loop through the list of input images files.
file_number = 1
while (imtgetim (imlist, in_fname, SZ_FNAME) != EOF) {
# Print the id string.
if (long_header == YES || short_header == YES) {
call printf ("File %d: %s")
call pargi (file_number)
call pargstr (in_fname)
}
# Get the output file name. If single file output to disk, use
# name fits_file. If multiple file output to disk, the file number
# is added to the output file name, if no output name list is
# supplied. If an output name list is supplied then the names
# are extracted one by one from that list.
if (make_image == YES) {
if (mtfile (fits_files) == YES) {
if (file_number == 2)
call mtfname (out_fname, EOT, out_fname, SZ_FNAME)
} else if (nfiles > 1) {
if (fntgfnb (flist, out_fname, SZ_FNAME) == EOF)
call error (0, "Error reading output file name")
} else {
if (fntrfnb (flist, 1, out_fname, SZ_FNAME) == EOF)
call strcpy (fits_files, out_fname, SZ_FNAME)
if (nimages > 1) {
call sprintf (out_fname[strlen(out_fname)+1],
SZ_FNAME, "%04d")
call pargi (file_number)
}
}
}
# Write each output file.
iferr (call wft_write_fitz (in_fname, out_fname)) {
call printf ("Error writing file: %s\n")
call pargstr (out_fname)
call erract (EA_WARN)
break
} else
file_number = file_number + 1
}
# Close up the input and output lists.
call clpcls (imlist)
if (flist != NULL)
call fntclsb (flist)
end
# WFT_GET_BITPIX -- This procedure fetches the user determined bitpix or ERR if
# the bitpix is not one of the permitted FITS types.
int procedure wft_get_bitpix (bitpix)
int bitpix
begin
switch (bitpix) {
case FITS_BYTE, FITS_SHORT, FITS_LONG, FITS_REAL, FITS_DOUBLE:
return (bitpix)
default:
return (ERR)
}
end
# WFT_BLKFAC -- Get the fits tape blocking factor.
int procedure wft_blkfac (file, ublkfac)
char file[ARB] # the input file name
int ublkfac # the user supplied blocking factor
int bs, fb, blkfac
pointer gty
int mtfile(), mtcap(), gtygeti()
errchk mtcap(), gtygeti()
begin
# Return a blocking factor of 1 if the file is a disk file.
if (mtfile (file) == NO)
return (0)
# Open the tapecap device entry for the given device, and get
# the device block size and default FITS blocking factor
# parameters.
iferr (gty = mtcap (file))
return (max (ublkfac,1))
iferr (bs = gtygeti (gty, "bs")) {
call gtyclose (gty)
return (max (ublkfac,1))
}
iferr (fb = max (gtygeti (gty, "fb"), 1))
fb = 1
# Determine whether the device is a fixed or variable blocked
# device. Set the fits blocking factor to the value of the fb
# parameter if device is fixed block or if the user has
# requested the default blocking factor. Set the blocking factor
# to the user requested value if the device supports variable
# blocking factors.
if (bs == 0) {
if (ublkfac <= 0)
blkfac = fb
else
blkfac = ublkfac
} else
blkfac = fb
call gtyclose (gty)
return (blkfac)
end
|
