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
|
# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
include <error.h>
include <imhdr.h>
include <fset.h>
include "rfits.h"
# RFT_READ_FITZ -- Convert a FITS file. An EOT is signalled by returning EOF.
int procedure rft_read_fitz (fitsfile, iraffile)
char fitsfile[ARB] # FITS file name
char iraffile[ARB] # IRAF file name
int fits_fd, stat, min_lenuserarea, ip
pointer im, sp, fits, envstr
int rft_read_header(), mtopen(), immap(), strlen(), envfind(), ctoi()
errchk smark, sfree, salloc, rft_read_header, rft_read_image, rft_find_eof()
errchk rft_scan_file, mtopen, immap, imdelete, close, imunmap
include "rfits.com"
begin
# Open input FITS data.
fits_fd = mtopen (fitsfile, READ_ONLY, 0)
# Allocate memory for program data structure.
call smark (sp)
call salloc (fits, LEN_FITS, TY_STRUCT)
call salloc (envstr, SZ_FNAME, TY_CHAR)
# Set up for printing a long or a short header.
if (long_header == YES || short_header == YES) {
if (make_image == YES) {
call printf ("File: %s ")
call pargstr (iraffile)
} else {
call printf ("File: %s ")
call pargstr (fitsfile)
}
if (long_header == YES)
call printf ("\n")
}
call flush (STDOUT)
# Create the IRAF image header. If only a header listing is desired
# then map the scratch image onto DEV$NULL (faster than a real file).
if (make_image == NO)
call strcpy ("dev$null", iraffile, SZ_FNAME)
if (envfind ("min_lenuserarea", Memc[envstr], SZ_FNAME) > 0) {
ip = 1
if (ctoi (Memc[envstr], ip, min_lenuserarea) <= 0)
min_lenuserarea = LEN_USERAREA
else
min_lenuserarea = max (LEN_USERAREA, min_lenuserarea)
} else
min_lenuserarea = LEN_USERAREA
im = immap (iraffile, NEW_IMAGE, min_lenuserarea)
# Read header. EOT is signalled by an EOF status from fits_read_header.
# Create an IRAF image if desired.
iferr {
IRAFNAME(fits) = EOS
stat = rft_read_header (fits_fd, fits, im)
if (stat == EOF)
call printf ("End of data\n")
else {
if (make_image == YES) {
call rft_read_image (fits_fd, fits, im)
if (fe > 0.0)
call rft_find_eof (fits_fd)
} else if (fe > 0.0)
call rft_scan_file (fits_fd, fits, im, fe)
}
} then {
call flush (STDOUT)
call erract (EA_WARN)
}
# Close files and clean up.
call imunmap (im)
# Optionally restore the old IRAF name.
if (stat == EOF || make_image == NO) {
call imdelete (iraffile)
} else if (old_name == YES && strlen (IRAFNAME(fits)) != 0) {
iferr {
call imgimage (IRAFNAME(fits), IRAFNAME(fits), SZ_FNAME)
call imrename (iraffile, IRAFNAME(fits))
} then {
call printf (" Cannot rename image %s to %s\n")
call pargstr (iraffile)
call pargstr (IRAFNAME(fits))
call flush (STDOUT)
call erract (EA_WARN)
} else {
call printf (" File: %s restored to IRAF File: %s\n")
call pargstr (iraffile)
call pargstr (IRAFNAME(fits))
}
}
if (long_header == YES)
call printf ("\n")
call close (fits_fd)
call sfree (sp)
return (stat)
end
# RFT_FIND_EOF -- Read the FITS data file until EOF is reached.
procedure rft_find_eof (fd)
int fd # the FITS file descriptor
int szbuf
pointer sp, buf
int fstati(), read()
errchk read
begin
# Scan through the file.
szbuf = fstati (fd, F_BUFSIZE)
call smark (sp)
call salloc (buf, szbuf, TY_CHAR)
while (read (fd, Memc[buf], szbuf) != EOF)
;
call sfree (sp)
end
# RFT_SCAN_FILE -- Determine whether it is more efficient to read the
# entire file or to skip forward to the next file if the parameter
# make_image was set to no.
procedure rft_scan_file (fd, fits, im, fe)
int fd # the FITS file descriptor
pointer fits # pointer to the FITS descriptor
pointer im # pointer to the output image
real fe # maximum file size in Kb for scan mode
int i, szbuf
pointer sp, buf
real file_size
int fstati(), read()
errchk read
begin
# Compute the file size in Kb and return if it is bigger than fe.
file_size = 1.0
do i = 1, IM_NDIM(im)
file_size = file_size * IM_LEN(im,i)
if (IM_NDIM(im) <= 0)
file_size = 0.0
else
file_size = file_size * abs (BITPIX(fits)) / FITS_BYTE / 1.0e3
if (file_size >= fe)
return
# Scan through the file.
szbuf = fstati (fd, F_BUFSIZE)
call smark (sp)
call salloc (buf, szbuf, TY_CHAR)
while (read (fd, Memc[buf], szbuf) != EOF)
;
call sfree (sp)
end
|
