File: writetemp.x

package info (click to toggle)
iraf-rvsao 2.8.3-1
  • links: PTS, VCS
  • area: main
  • in suites: bullseye, buster, sid
  • size: 16,456 kB
  • sloc: ansic: 963; lisp: 651; fortran: 397; makefile: 27
file content (315 lines) | stat: -rw-r--r-- 8,306 bytes parent folder | download
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
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
# File rvsao/Makespec/writetemp.x
# October 15, 2007
# By Doug Mink, Harvard-Smithsonian Center for Astrophysics

# TMP_OPEN -- Open a new template file for writing

include <error.h>
include <imhdr.h>
include <imset.h>
include <fio.h>
include <mach.h>
include <fset.h>

procedure tmp_open (im, iraffile, spectrum, npix, nspec, oldim)

pointer	im			# Output image structure (returned)
char	iraffile[ARB]		# IRAF template file name
pointer	spectrum		# Pointer to spectrum vector (retuned)
int	npix			# Number of pixels in spectrum
int	nspec			# Number of spectra in output file
pointer	oldim			# Old image structure (ignored if NULL)

int	immap()
errchk	immap

begin

#  Create IRAF image header
	if (oldim == NULL)
	    im = immap (iraffile, NEW_IMAGE, 0)
	else
	    im = immap (iraffile, NEW_COPY, oldim)
	if (im == NULL) return

# Initialize a few header parameters
	IM_PIXTYPE(im) = TY_REAL
	if (nspec < 1)
	    nspec = 1
	if (nspec > 1)
	    IM_NDIM(im) = 2
	else
	    IM_NDIM(im) = 1
	IM_LEN(im,1) = npix
	IM_PHYSLEN(im,1) = npix
	IM_LEN(im,2) = nspec
	IM_PHYSLEN(im,2) = nspec

# Allocate memory for the template spectrum
	call malloc (spectrum,npix,TY_REAL)

	return
end


# TMP_CLOSE -- Write pixels to template file and close it

procedure tmp_close (im,spectrum,debug)

pointer	im			# Pointer to output image structure (returned)
pointer	spectrum		# Pointer to spectrum vector (retuned)
bool	debug			# True for diagnostic listing

errchk	mfree, imunmap

begin

	if (im == NULL) return

#  Move spectrum from buffer to image
	call tmp_write_iraf (im, 1, spectrum, TY_REAL, debug)

#  Close files and clean up.
	call imunmap (im)
	call mfree (spectrum,TY_REAL)

	return
end


# TMP_WRITE_IRAF --  Write spectrum pixels to IRAF image file

procedure tmp_write_iraf (im, ispec, tempbuf, temptype, debug)

pointer	im		# IRAF image descriptor
int	ispec		# Number of spectrum in 2D spectrum to write
pointer	tempbuf		# Template spectrum data buffer
int	temptype	# Template spectrum data type
bool	debug		# True for diagnostic output

int	npix
long	v[IM_MAXDIM], nlines
pointer	outline, templine
real	linemax, linemin
long	clktime()

errchk	malloc
errchk	tmp_change_pix, tmp_put_image_line, tmp_pix_lim

begin
	if (IM_NDIM(im) == 0) {
	    call printf ("WPIXTEMP: No pixel file created\n")
	    return
	}

	npix = IM_LEN(im, 1)
	nlines = 1

	IM_MAX(im) = -MAX_REAL
	IM_MIN(im) = MAX_REAL

	call amovkl (long(1), v, IM_MAXDIM)
	if (ispec > 1)
	    v[2] = long (ispec)

	if (debug) {
	    call printf ("WPIXTEMP:  %d pixels, type %d\n")
	    call pargi (npix)
	    call pargi (IM_PIXTYPE(im))
	    }

# Set output image line buffer
	templine = tempbuf
	call tmp_put_image_line (im, outline, v, IM_PIXTYPE(im))

# Change pixels to appropriate type
	call tmp_change_pix (templine, outline, npix, temptype, IM_PIXTYPE(im))

# Calculate image maximum and minimum
	call tmp_pix_lim (outline, npix, IM_PIXTYPE(im), linemin, linemax)
	IM_MAX(im) = max (IM_MAX(im), linemax)
	IM_MIN(im) = min (IM_MIN(im), linemin)

	if (debug) {
	    call printf ("WPIXTEMP:  minimum is %f, maximum is %f\n")
	    call pargr (IM_MIN(im))
	    call pargr (IM_MAX(im))
	    }
	IM_CTIME(im) = clktime (long(0))
	return
end


# TMP_PUT_IMAGE_LINE -- Get a buffer pointer to output a line to an IRAF file

procedure tmp_put_image_line (im, buf, v, data_type)

pointer	im			# IRAF image descriptor
pointer	buf			# Pointer to output image line
long	v[ARB]			# imio pointer
int	data_type		# output pixel type

int	impnll(), impnlr(), impnld(), impnlx(), impnls()
errchk	impnll, impnlr, impnld, impnlx, impnls

begin
	switch (data_type) {
	case TY_SHORT, TY_USHORT:
	    if (impnls (im, buf, v) == EOF)
		call error (3, "TMP_PUT_IMAGE_LINE: Error writing IRAF file")
	case TY_INT, TY_LONG:
	    if (impnll (im, buf, v) == EOF)
		call error (3, "TMP_PUT_IMAGE_LINE: Error writing IRAF file")
	case TY_REAL:
	    if (impnlr (im, buf, v) == EOF)
		call error (3, "TMP_PUT_IMAGE_LINE: Error writing IRAF file")
	case TY_DOUBLE:
	    if (impnld (im, buf, v) == EOF)
		call error (3, "TMP_PUT_IMAGE_LINE: Error writing IRAF file")
	case TY_COMPLEX:
	    if (impnlx (im, buf, v) == EOF)
		call error (3, "TMP_PUT_IMAGE_LINE: Error writing IRAF file")
	default:
	    call error (10, "TMP_PUT_IMAGE_LINE: Unsupported IRAF image type")
	}
	return
end


# TMP_CHANGE_PIX -- Change a line of numbers to the IRAF image type

procedure tmp_change_pix (inbuf, outbuf, npix, in_type, out_type)

pointer inbuf			# array of archive data
pointer	outbuf			# pointer to IRAF image line
int	npix			# number of pixels
int	in_type			# input pixel type
int	out_type		# output pixel type

begin
	switch (out_type) {
	    case TY_SHORT, TY_USHORT:
		switch (in_type) {
	    	    case TY_SHORT, TY_USHORT:
			Call achtss (Mems[inbuf], Mems[outbuf], npix)
	    	    case TY_INT, TY_LONG:
			Call achtls (Memi[inbuf], Mems[outbuf], npix)
		    case TY_REAL:
			Call achtrs (Memr[inbuf], Mems[outbuf], npix)
		    case TY_DOUBLE:
			Call achtds (Memd[inbuf], Mems[outbuf], npix)
		    default:
			call error (10, "TMP_CHANGE_LINE: Illegal archive type")
		    }
	    case TY_INT, TY_LONG:
		switch (in_type) {
	    	    case TY_SHORT, TY_USHORT:
			Call achtsl (Mems[inbuf], Meml[outbuf], npix)
	    	    case TY_INT, TY_LONG:
			Call achtll (Memi[inbuf], Meml[outbuf], npix)
		    case TY_REAL:
			Call achtrl (Memr[inbuf], Meml[outbuf], npix)
		    case TY_DOUBLE:
			Call achtdl (Memd[inbuf], Meml[outbuf], npix)
		    default:
			call error (10, "TMP_CHANGE_LINE: Illegal archive type")
		    }
	    case TY_REAL:
		switch (in_type) {
	    	    case TY_SHORT, TY_USHORT:
			Call achtsr (Mems[inbuf], Memr[outbuf], npix)
	    	    case TY_INT, TY_LONG:
			Call achtlr (Memi[inbuf], Memr[outbuf], npix)
		    case TY_REAL:
			Call achtrr (Memr[inbuf], Memr[outbuf], npix)
		    case TY_DOUBLE:
			Call achtdr (Memd[inbuf], Memr[outbuf], npix)
		    default:
			call error (10, "TMP_CHANGE_LINE: Illegal archive type")
		    }
	    case TY_DOUBLE:
		switch (in_type) {
	    	    case TY_SHORT, TY_USHORT:
			Call achtsd (Mems[inbuf], Meml[outbuf], npix)
	    	    case TY_INT, TY_LONG:
			Call achtld (Memi[inbuf], Meml[outbuf], npix)
		    case TY_REAL:
			Call achtrd (Memr[inbuf], Meml[outbuf], npix)
		    case TY_DOUBLE:
			Call achtdd (Memd[inbuf], Meml[outbuf], npix)
		    default:
			call error (10, "TMP_CHANGE_LINE: Illegal archive type")
		    }
	    case TY_COMPLEX:
		switch (in_type) {
	    	    case TY_SHORT, TY_USHORT:
			Call achtsx (Mems[inbuf], Memx[outbuf], npix)
	    	    case TY_INT, TY_LONG:
			Call achtlx (Memi[inbuf], Memx[outbuf], npix)
		    case TY_REAL:
			Call achtrx (Memr[inbuf], Memx[outbuf], npix)
		    case TY_DOUBLE:
			Call achtdx (Memd[inbuf], Memx[outbuf], npix)
		    default:
			call error (10, "TMP_CHANGE_LINE: Illegal archive type")
		    }
	    default:
		call error (10, "TMP_CHANGE_LINE: Illegal IRAF image type")
	    }
	return
end


# TMP_PIX_LIMITS -- Determine the maximum and minimum values in a line

procedure tmp_pix_lim (buf, npix, pixtype, linemin, linemax)

pointer	buf			# pointer to IRAF image line
int	npix			# number of pixels
int	pixtype			# output data type
real	linemax, linemin	# min and max pixel values

short	smax, smin
long	lmax, lmin
real	rmax, rmin
double	dmax, dmin
complex	xmax, xmin

begin
	switch (pixtype) {
	case TY_SHORT, TY_USHORT:
	    call alims (Mems[buf], npix, smin, smax)
	    linemax = smax
	    linemin = smin
	case TY_INT, TY_LONG:
	    call aliml (Meml[buf], npix, lmin, lmax)
	    linemax = lmax
	    linemin = lmin
	case TY_REAL:
	    call alimr (Memr[buf], npix, rmin, rmax)
	    linemax = rmax
	    linemin = rmin
	case TY_DOUBLE:
	    call alimd (Memd[buf], npix, dmin, dmax)
	    linemax = dmax
	    linemin = dmin
	case TY_COMPLEX:
	    call alimx (Memx[buf], npix, xmin, xmax)
	    linemax = xmax
	    linemin = xmin
	default:
	    call error (30, "TMP_PIX_LIMITS: Unknown IRAF type")
	}
	return
end

# Jul 21 1995	New program
# Oct 11 1995	Remove unnecessary diagnostic printing
# Oct 13 1995	Drop HISTORY; it is done by ADDTEMP

# Apr 22 1998	Fix debug if statements after Bryan Miller found a bug
# Dec 18 1998	Add support for 2D output files

# Jul 27 1999	Add argument to copy an old file header to the new file

# Oct 15 2007	Change (debug == TRUE) to (debug)