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
|
# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
include <syserr.h>
include <error.h>
include "mwcs.h"
# MW_OPEN -- Create a new MWCS descriptor. If the non-NULL address of a
# buffer containing a saved MWCS is given, the saved MWCS will be loaded,
# otherwise a unitary MWCS of the indicated dimension is created.
pointer procedure mw_open (bufptr, ndim)
pointer bufptr #I pointer to encoded MWCS, or NULL
int ndim #I dimension of system to be created
int i
pointer mw, wp
int mw_allocd()
errchk calloc, mw_load, syserrs, mw_allocd
string s_physical "physical"
begin
# Initialize the function drivers.
call wf_init()
# Allocate the base descriptor.
call calloc (mw, LEN_MWCS, TY_STRUCT)
# Load saved MWCS, if one was given.
if (bufptr != NULL) {
call mw_load (mw, bufptr)
return (mw)
}
# Initialize the new descriptor to a unitary transform of dimension
# NDIM. Most of this is accomplished by merely creating a zeroed
# descriptor.
if (ndim < 1 || ndim > MAX_DIM) {
call mfree (mw, TY_STRUCT)
call syserrs (SYS_MWNDIM, "mw_open")
}
MI_MAGIC(mw) = MWCS_MAGIC
MI_NDIM(mw) = ndim
MI_NLOGDIM(mw) = ndim
MI_LTV(mw) = mw_allocd (mw, ndim)
MI_LTM(mw) = mw_allocd (mw, ndim * ndim)
call mw_mkidmd (D(mw,MI_LTM(mw)), ndim)
do i = 1, ndim {
MI_AXNO(mw,i) = i
MI_PHYSAX(mw,i) = i
}
# Set up the builtin world systems "physical" and "logical".
# Both are linear systems. The physical system is a unitary
# transformation (since world systems are defined relative to
# the physical system), and the logical system has the Lterm
# for its linear term. No wcs attributes other than wtype are
# defined.
# Create the physical system.
call mw_newsystem (mw, s_physical, ndim)
do i = 1, ndim
call mw_swtype (mw, i, 1, "linear", "")
# Create the logical system.
call mw_newsystem (mw, "logical", ndim)
do i = 1, ndim
call mw_swtype (mw, i, 1, "linear", "")
# Set W and CD for the logical system to point to the Lterm.
wp = MI_WCS(mw)
WCS_W(wp) = MI_LTV(mw)
WCS_CD(wp) = MI_LTM(mw)
# Set the default world system.
call mw_sdefwcs (mw)
return (mw)
end
|
