File: velsubs.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 (289 lines) | stat: -rw-r--r-- 7,611 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
# File Util/velsubs.x
# October 1, 1997
# By Doug Mink

include <imhdr.h>
include <error.h>

# VELS_GET -- Get header parameters which describe the wavelength axis.

procedure vels_get (im, axis, crval, cdelt)

pointer	im			# Image structure pointer
int	axis			# Dispersion axis
double	crval			# Reference wavelength (returned)
double	cdelt			# Wavelength step (returned)

char	keyword[SZ_FNAME]
double	imgetd()
int	imaccf()

begin
	# FITS or IRAF keyword
	# Wavelength scale zero is common for ST and FITS formats.
	call sprintf (keyword, SZ_FNAME, "CRVAL%1d")
	    call pargi (axis)
	if (imaccf (im, keyword) == YES)
	    crval = imgetd (im, keyword)

	# STSDAS keyword
	call sprintf (keyword, SZ_FNAME, "CD%1d_1")
	    call pargi (axis)
	if (imaccf (im, keyword) == YES)
	    cdelt = imgetd (im, keyword)

	# FITS keyword
	call sprintf (keyword, SZ_FNAME, "CDELT%1d")
	    call pargi (axis)
	if (imaccf (im, keyword) == YES)
	    cdelt = imgetd (im, keyword)

	# Old IRAF keywords
	if (imaccf (im, "W0") == YES) {
	    crval = imgetd (im, "W0")
	    cdelt = imgetd (im, "WPC")
	    }
end

# VELS_PUT -- Put header parameters which describe the wavelength axis.

procedure vels_put (im, axis, crval, cdelt)

pointer	im			# Image structure pointer
int	axis			# Dispersion axis
double	crval			# Reference wavelength
double	cdelt			# Wavelength step

int	imaccf()
char	keyword[SZ_FNAME]

begin
	# FITS or IRAF keyword
	# Wavelength scale zero is common for ST and FITS formats.
	call sprintf (keyword, SZ_FNAME, "CRVAL%1d")
	    call pargi (axis)
	if (imaccf (im, keyword) == YES)
	    call imputd (im, keyword, crval)

	# STSDAS keyword
	call sprintf (keyword, SZ_FNAME, "CD%1d_1")
	    call pargi (axis)
	if (imaccf (im, keyword) == YES)
	    call imputd (im, keyword, cdelt)

	# FITS keyword
	call sprintf (keyword, SZ_FNAME, "CDELT%1d")
	    call pargi (axis)
	if (imaccf (im, keyword) == YES)
	    call imputd (im, keyword, cdelt)

	# Old IRAF keywords
	if (imaccf (im, "W0") == YES) {
	    call imputd (im, "W0", crval)
	    call imputd (im, "WPC", cdelt)
	    }
end

# VELS_TIMELOG -- Prepend a time stamp to the given string.
#
# For the purpose of a history logging prepend a short time stamp to the
# given string.  Note that the input string is modified.

procedure vels_timelog (str, max_char)

char	str[ARB]		# String to be time stamped
int	max_char		# Maximum characters in string

pointer	sp, time, temp

begin
	call smark (sp)
	call salloc (time, SZ_LINE, TY_CHAR)
	call salloc (temp, max_char, TY_CHAR)

	call logtime (Memc[time], SZ_LINE)
	call sprintf (Memc[temp], max_char, "%s %s")
	    call pargstr (Memc[time])
	    call pargstr (str)
	call strcpy (Memc[temp], str, max_char)
	call sfree (sp)
end


# VELS_IMCOPY -- Copy an image.  Use sequential routines to permit copying
# images of any dimension.  Perform pixel i/o in the datatype of the image,
# to avoid unnecessary type conversion.
#
# This routine is basicaly task images.imcopy whith verbose option and
# output image section handling removed.

procedure vels_imcopy (image1, image2)

char	image1[ARB]			# Input image
char	image2[ARB]			# Output image

int	npix, junk
pointer	buf1, buf2, im1, im2
pointer	sp, imtemp
long	v1[IM_MAXDIM], v2[IM_MAXDIM]

int	imgnls(), imgnll(), imgnlr(), imgnld(), imgnlx()
int	impnls(), impnll(), impnlr(), impnld(), impnlx()
pointer	immap()

begin
	call smark (sp)
	call salloc (imtemp, SZ_PATHNAME, TY_CHAR)

	# Map the input image.
	im1 = immap (image1, READ_ONLY, 0)

	# Get a temporary output image name and map it as a copy of the 
	# input image.
	# Copy the input image to the temporary output image and unmap
	# the images.  Release the temporary image name.

	call xt_mkimtemp (image1, image2, Memc[imtemp], SZ_PATHNAME)
	im2 = immap (image2, NEW_COPY, im1)

	# Setup start vector for sequential reads and writes.

	call amovkl (long(1), v1, IM_MAXDIM)
	call amovkl (long(1), v2, IM_MAXDIM)

	# Copy the image.

	npix = IM_LEN(im1, 1)
	switch (IM_PIXTYPE(im1)) {
	case TY_SHORT:
	    while (imgnls (im1, buf1, v1) != EOF) {
		junk = impnls (im2, buf2, v2)
		call amovs (Mems[buf1], Mems[buf2], npix)
	    }
	case TY_USHORT, TY_INT, TY_LONG:
	    while (imgnll (im1, buf1, v1) != EOF) {
		junk = impnll (im2, buf2, v2)
		call amovl (Meml[buf1], Meml[buf2], npix)
	    }
	case TY_REAL:
	    while (imgnlr (im1, buf1, v1) != EOF) {
		junk = impnlr (im2, buf2, v2)
		call amovr (Memr[buf1], Memr[buf2], npix)
	    }
	case TY_DOUBLE:
	    while (imgnld (im1, buf1, v1) != EOF) {
		junk = impnld (im2, buf2, v2)
		call amovd (Memd[buf1], Memd[buf2], npix)
	    }
	case TY_COMPLEX:
	    while (imgnlx (im1, buf1, v1) != EOF) {
	        junk = impnlx (im2, buf2, v2)
		call amovx (Memx[buf1], Memx[buf2], npix)
	    }
	default:
	    call error (1, "unknown pixel datatype")
	}

	# Unmap the images.

	call imunmap (im2)
	call imunmap (im1)
	call xt_delimtemp (image2, Memc[imtemp])
	call sfree (sp)
end


# VELS_CONVERT -- Copy an image, translating in wavelength.  Use sequential
# routines to permit copying images of any dimension.  Perform pixel i/o in
# the datatype of the image, to avoid unnecessary type conversion.

# This routine is basicaly task images.imcopy with verbose option and
# output image section handling removed.

procedure vels_convert (image1, image2, inwl1, indwl, outwl1, outdwl)

char	image1[ARB]	# Input image
char	image2[ARB]	# Output image
double	inwl1		# Input starting wavelength
double	indwl		# Input delta wavelength
double	outwl1		# Output starting wavelength
double	outdwl		# Output delta wavelength

int	npix, junk
pointer	buf1, buf2, im1, im2
pointer	sp, imtemp, tbuf
long	v1[IM_MAXDIM], v2[IM_MAXDIM]

int	imgnls(), imgnll(), imgnlr(), imgnld(), imgnlx()
int	impnls(), impnll(), impnlr(), impnld(), impnlx()
pointer	immap()

begin
	call smark (sp)
	call salloc (imtemp, SZ_PATHNAME, TY_CHAR)

	# Map the input image.
	im1 = immap (image1, READ_ONLY, 0)

	# Get a temporary output image name and map it as a copy of the 
	# input image.
	# Copy the input image to the temporary output image and unmap
	# the images.  Release the temporary image name.

	call xt_mkimtemp (image1, image2, Memc[imtemp], SZ_PATHNAME)
	im2 = immap (image2, NEW_COPY, im1)

	# Setup start vector for sequential reads and writes.

	call amovkl (long(1), v1, IM_MAXDIM)
	call amovkl (long(1), v2, IM_MAXDIM)

	# Copy the image.

	npix = IM_LEN(im1, 1)
	switch (IM_PIXTYPE(im1)) {
	case TY_SHORT:
	    call salloc (tbuf, TY_SHORT, npix)
	    while (imgnls (im1, buf1, v1) != EOF) {
		junk = impnls (im2, buf2, v2)
		call amovs (Mems[buf1], Mems[buf2], npix)
	    }
	case TY_USHORT, TY_INT, TY_LONG:
	    call salloc (tbuf, TY_LONG, npix)
	    while (imgnll (im1, buf1, v1) != EOF) {
		junk = impnll (im2, buf2, v2)
		call amovl (Meml[buf1], Meml[buf2], npix)
	    }
	case TY_REAL:
	    call salloc (tbuf, TY_REAL, npix)
	    while (imgnlr (im1, buf1, v1) != EOF) {
		junk = impnlr (im2, buf2, v2)
		call amovr (Memr[buf1], Memr[buf2], npix)
	    }
	case TY_DOUBLE:
	    call salloc (tbuf, TY_DOUBLE, npix)
	    while (imgnld (im1, buf1, v1) != EOF) {
		junk = impnld (im2, buf2, v2)
		call amovd (Memd[buf1], Memd[buf2], npix)
	    }
	case TY_COMPLEX:
	    while (imgnlx (im1, buf1, v1) != EOF) {
	        junk = impnlx (im2, buf2, v2)
		call amovx (Memx[buf1], Memx[buf2], npix)
	    }
	default:
	    call error (1, "unknown pixel datatype")
	}

	# Unmap the images.

	call imunmap (im2)
	call imunmap (im1)
	call xt_delimtemp (image2, Memc[imtemp])
	call sfree (sp)
end
# Jul 13 1994	New file

# Mar 28 1995	Free all stack pointers

# Oct  1 1997	Print 4-digit year in time stamp