aboutsummaryrefslogtreecommitdiff
path: root/vendor/x11iraf/ximtool/clients.old/lib/wcsgfterm.x
blob: 8b97a55b9bcef7283cd394509c5e4587c66568a0 (plain) (blame)
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
# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.


# WCS_GFTERM -- Compute the output FITS CRPIX, CRVAL, and CD arrays from the
# MWCS LTERM and WTERM. Note that the CD matrix terms are still transposed
# from the usual Fortran order.

procedure wcs_gfterm (mw, crpix, crval, cd, ndim)

pointer mw              			#i the input mwcs pointer
double  crpix[ndim]     			#o the output FITS CRPIX array
double  crval[ndim]     			#o the output FITS CRVAL array
double  cd[ndim,ndim]   			#o the output FITS CD matrix
int     ndim            			#i the dimensionality of the wcs

pointer sp, r, wcd, ltv, ltm, iltm
pointer	alert, errmsg
int	i, errcode

int	errget()

errchk	mw_gwtermd, mw_gltermd

begin
	call smark (sp)
	call salloc (r, ndim, TY_DOUBLE)
	call salloc (wcd, ndim * ndim, TY_DOUBLE)
	call salloc (ltv, ndim, TY_DOUBLE)
	call salloc (ltm, ndim * ndim, TY_DOUBLE)
	call salloc (iltm, ndim * ndim, TY_DOUBLE)

	iferr {
	    call mw_gwtermd (mw, Memd[r], crval, Memd[wcd], ndim)
	    call mw_gltermd (mw, Memd[ltm], Memd[ltv], ndim)
	    call mwvmuld (Memd[ltm], Memd[r], crpix, ndim)
	    call aaddd (crpix, Memd[ltv], crpix, ndim)
	    call mwinvertd (Memd[ltm], Memd[iltm], ndim)
	    call mwmmuld (Memd[wcd], Memd[iltm], cd, ndim)

	} then {
	    call salloc (alert, SZ_LINE, TY_CHAR)
	    call salloc (errmsg, SZ_LINE, TY_CHAR)

	    # Set up a default value.
	    call aclrd (cd, ndim*ndim)
	    for (i=1; i <= ndim; i=i+1) {
	        crpix[i] = 1.0d0
	        crval[i] = 1.0d0
	        cd[i,i] = 1.0d0
	    }

            # Send alert to the GUI.
	    errcode = errget (Memc[errmsg], SZ_LINE)
	    call sprintf (Memc[alert], SZ_FNAME, "%s\n\"%s\"")
		call pargstr ("Error decoding image WCS:")
		call pargstr (Memc[errmsg])
            call xim_alert (Memc[alert], "", "")
	}

	call sfree (sp)
end