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
|
include <imhdr.h>
include <mwset.h>
include <smw.h>
# SMW_EQUISPEC -- Setup the EQUISPEC SMW parameters.
# The aperture information is in the APNUM and APID keywords and the
# WCS information is in the linear MWCS.
procedure smw_equispec (im, smw)
pointer im #I IMIO pointer
pointer smw #U MWCS pointer input SMW pointer output
int i, j, k, nchar, ap, beam, dtype, nw
double w1, dw, z
real aplow[2], aphigh[2], mw_c1tranr()
pointer sp, key, val, wterm, mw, ct, mw_sctran()
int imgeti(), mw_stati(), ctoi(), ctor()
errchk imgstr, mw_gwtermd, mw_sctran
errchk smw_open, smw_saxes, smw_swattrs, smw_sapid
begin
call smark (sp)
call salloc (key, SZ_FNAME, TY_CHAR)
call salloc (val, SZ_LINE, TY_CHAR)
# Determine the dispersion parameters
mw = smw
i = mw_stati (mw, MW_NDIM)
call salloc (wterm, 2*i+i*i, TY_DOUBLE)
call mw_gwtermd (mw, Memd[wterm], Memd[wterm+i], Memd[wterm+2*i], i)
w1 = Memd[wterm+i]
dw = Memd[wterm+2*i]
# Determine the number of physical pixels.
ct = mw_sctran (mw, "logical", "physical", 1)
nw = max (mw_c1tranr (ct, 1.), mw_c1tranr (ct, real(IM_LEN(im,1))))
call mw_ctfree (ct)
# Determine the dispersion type.
iferr (dtype = imgeti (im, "DC-FLAG"))
dtype = DCNO
if (dtype==DCLOG) {
if (abs(w1)>20. || abs(w1+(nw-1)*dw)>20.)
dtype = DCLINEAR
else {
w1 = 10D0 ** w1
dw = w1 * (10D0 ** ((nw-1)*dw) - 1) / (nw - 1)
}
}
# Set the SMW data structure.
call smw_open (smw, NULL, im)
do i = 1, SMW_NSPEC(smw) {
call smw_mw (smw, i, 1, mw, j, k)
if (j < 1000)
call sprintf (Memc[key], SZ_FNAME, "APNUM%d")
else
call sprintf (Memc[key], SZ_FNAME, "AP%d")
call pargi (j)
call imgstr (im, Memc[key], Memc[val], SZ_LINE)
k = 1
nchar = ctoi (Memc[val], k, ap)
nchar = ctoi (Memc[val], k, beam)
if (ctor (Memc[val], k, aplow[1]) == 0)
aplow[1] = INDEF
if (ctor (Memc[val], k, aphigh[1]) == 0)
aphigh[1] = INDEF
if (ctor (Memc[val], k, aplow[2]) == 0)
aplow[2] = INDEF
if (ctor (Memc[val], k, aphigh[2]) == 0)
aphigh[2] = INDEF
z = 0.
call smw_swattrs (smw, i, 1, ap, beam, dtype, w1, dw, nw, z,
aplow, aphigh, "")
call sprintf (Memc[key], SZ_FNAME, "APID%d")
call pargi (j)
ifnoerr (call imgstr (im, Memc[key], Memc[val], SZ_LINE))
call smw_sapid (smw, i, 1, Memc[val])
}
call sfree (sp)
end
|
