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
|
include "skywcsdef.h"
include "skywcs.h"
# SK_SAVEIM -- Update the image header keywords that describe the
# fundamental coordinate system, CTYPE, RADECSYS, EQUINOX (EPOCH), and
# MJD-WCS.
procedure sk_saveim (coo, mw, im)
pointer coo #I pointer to the coordinate structure
pointer mw #I pointer to the mwcs structure
pointer im #I image descriptor
errchk imdelf()
begin
# Move all this to a separate routine
switch (SKY_CTYPE(coo)) {
case CTYPE_EQUATORIAL:
call mw_swattrs (mw, SKY_PLNGAX(coo), "axtype", "ra")
call mw_swattrs (mw, SKY_PLATAX(coo), "axtype", "dec")
switch (SKY_RADECSYS(coo)) {
case EQTYPE_FK4:
call imastr (im, "radecsys", "FK4")
call imaddd (im, "equinox", SKY_EQUINOX(coo))
call imaddd (im, "mjd-wcs", SKY_EPOCH(coo))
case EQTYPE_FK4NOE:
call imastr (im, "radecsys", "FK4NOE")
call imaddd (im, "equinox", SKY_EQUINOX(coo))
call imaddd (im, "mjd-wcs", SKY_EPOCH(coo))
case EQTYPE_FK5:
call imastr (im, "radecsys", "FK5")
call imaddd (im, "equinox", SKY_EQUINOX(coo))
iferr (call imdelf (im, "mjd-wcs"))
;
case EQTYPE_ICRS:
call imastr (im, "radecsys", "ICRS")
call imaddd (im, "equinox", SKY_EQUINOX(coo))
iferr (call imdelf (im, "mjd-wcs"))
;
case EQTYPE_GAPPT:
call imastr (im, "radecsys", "GAPPT")
iferr (call imdelf (im, "equinox"))
;
call imaddd (im, "mjd-wcs", SKY_EPOCH(coo))
}
case CTYPE_ECLIPTIC:
call mw_swattrs (mw, SKY_PLNGAX(coo), "axtype", "elon")
call mw_swattrs (mw, SKY_PLATAX(coo), "axtype", "elat")
iferr (call imdelf (im, "radecsys"))
;
iferr (call imdelf (im, "equinox"))
;
call imaddd (im, "mjd-wcs", SKY_EPOCH(coo))
case CTYPE_GALACTIC:
call mw_swattrs (mw, SKY_PLNGAX(coo), "axtype", "glon")
call mw_swattrs (mw, SKY_PLATAX(coo), "axtype", "glat")
iferr (call imdelf (im, "radecsys"))
;
iferr (call imdelf (im, "equinox"))
;
iferr (call imdelf (im, "mjd-wcs"))
;
case CTYPE_SUPERGALACTIC:
call mw_swattrs (mw, SKY_PLNGAX(coo), "axtype", "slon")
call mw_swattrs (mw, SKY_PLATAX(coo), "axtype", "slat")
iferr (call imdelf (im, "radecsys"))
;
iferr (call imdelf (im, "equinox"))
;
iferr (call imdelf (im, "mjd-wcs"))
;
}
end
# SK_CTYPEIM -- Modify the CTYPE keywords appropriately. This step will
# become unnecessary when MWCS is updated to deal with non-equatorial celestial
# coordinate systems.
procedure sk_ctypeim (coo, im)
pointer coo #I pointer to the coordinate structure
pointer im #I image descriptor
pointer sp, wtype, key1, key2, attr
int sk_wrdstr()
begin
call smark (sp)
call salloc (key1, 8, TY_CHAR)
call salloc (key2, 8, TY_CHAR)
call salloc (wtype, 3, TY_CHAR)
call salloc (attr, 8, TY_CHAR)
call sprintf (Memc[key1], 8, "CTYPE%d")
call pargi (SKY_PLNGAX(coo))
call sprintf (Memc[key2], 8, "CTYPE%d")
call pargi (SKY_PLATAX(coo))
if (SKY_WTYPE(coo) <= 0 || SKY_WTYPE(coo) == WTYPE_LIN) {
call imastr (im, Memc[key1], "LINEAR")
call imastr (im, Memc[key2], "LINEAR")
call sfree (sp)
return
}
if (sk_wrdstr (SKY_WTYPE(coo), Memc[wtype], 3, WTYPE_LIST) <= 0)
call strcpy ("tan", Memc[wtype], 3)
call strupr (Memc[wtype])
# Move all this to a separate routine
switch (SKY_CTYPE(coo)) {
case CTYPE_EQUATORIAL:
call sprintf (Memc[attr], 8, "RA---%3s")
call pargstr (Memc[wtype])
call imastr (im, Memc[key1], Memc[attr])
call sprintf (Memc[attr], 8, "DEC--%3s")
call pargstr (Memc[wtype])
call imastr (im, Memc[key2], Memc[attr])
case CTYPE_ECLIPTIC:
call sprintf (Memc[attr], 8, "ELON-%3s")
call pargstr (Memc[wtype])
call imastr (im, Memc[key1], Memc[attr])
call sprintf (Memc[attr], 8, "ELAT-%3s")
call pargstr (Memc[wtype])
call imastr (im, Memc[key2], Memc[attr])
case CTYPE_GALACTIC:
call sprintf (Memc[attr], 8, "GLON-%3s")
call pargstr (Memc[wtype])
call imastr (im, Memc[key1], Memc[attr])
call sprintf (Memc[attr], 8, "GLAT-%3s")
call pargstr (Memc[wtype])
call imastr (im, Memc[key2], Memc[attr])
case CTYPE_SUPERGALACTIC:
call sprintf (Memc[attr], 8, "SLON-%3s")
call pargstr (Memc[wtype])
call imastr (im, Memc[key1], Memc[attr])
call sprintf (Memc[attr], 8, "SLAT-%3s")
call pargstr (Memc[wtype])
call imastr (im, Memc[key2], Memc[attr])
default:
call imastr (im, Memc[key1], "LINEAR")
call imastr (im, Memc[key2], "LINEAR")
}
call sfree (sp)
end
|
