aboutsummaryrefslogtreecommitdiff
path: root/vo/votools/t_makewcs.x
blob: 593027eb41e8be48d46f8cf7b3056591c5516d20 (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
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
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
include <error.h>

# MAKEWCS -- Task to write the WCS information into a header of an image
# subset from the scanned plate catalog.

procedure t_makewcs()

int	imtopenp(), imtgetim()
int	list
char	image[SZ_FNAME]
bool	verbose, clgetb()

begin
	list = imtopenp ("infiles")
	verbose = clgetb("verbose")
	while (imtgetim(list, image, SZ_FNAME) != EOF) {
	    call makecd(image)
	    if (verbose) {
	       call printf (" WCS for %s\n")
		   call pargstr(image)
	       call flush(STDOUT)
	    }
	}

end

include <imhdr.h>
include <math.h>

define  SZ_KEYWORD  8

# MAKECD -- Procedure to calculate the WCS values for a subset of a 
# scanned plate that contains a general plate solution.
#
# Calculates CRPIX, CRVAL and CD matrix from the information in the GSSS
# header wich consist on the positions of the lower left corner of the
# subimage (CNPIX1, CNPIX2) w/r to the lower left corner of the scanned plate.
# From here create a grid of 100x100 points and do a local solution to 
# the CD values and translate the reference position to the center of the
# subimage. 
#

procedure makecd(image)

char	image[SZ_FNAME]

double	amdx[20], amdy[20]		# Plate Soln.coeff.
double  plate_cen_x, plate_cen_y	# center position (microns)
double  plate_cen_ra, plate_cen_dec	# in radians
double	x_pixel_size, y_pixel_size	# step size (microns)
double	plate_scale			# arcsec/mm
int	ra_h, ra_m			# RA hours, minutes
double	ra_s				# RA seconds
char	dec_sign[1]			# 
int	dec_d, dec_m			# DEC degrees, minutes
double	dec_s				# DEC seconds
double  object_mag, object_col		# Magnitud, color for object
double  im_x_center_pix, im_y_center_pix # Pixel position of image center
				        # w/r to the original scanned plate
int	xcorner, ycorner		# Lower left position of image w/r to
					# original scanned plate
int	xsize, ysize			# Naxis1, naxis2
real    crpix1, crpix2
double	crval1, crval2
double	cdmatx[4]
double	imgetd()
real	imgetr()
int	imgeti()
char 	parname[8]
int	i
pointer im
int	immap(), imaccf()
errchk  imgetd, imgeti

begin
	im = immap (image, READ_WRITE, 0)

	# See if image header has the General Plate solution.
	if (imaccf(im,"PPO3    ") == NO)
	   call error(0,"No Plate solution available in header")

	# If we have an old DSS image (i.e. the one with the CRPIX), rename
	# this keyword to CNPIX and proceed.

	if (imaccf(im,"CRPIX1") == YES ) {
	   if (imaccf(im,"CRVAL1") == YES) {
	      if (imaccf(im,"CD1_1") == NO ){
		 # This is the case when we have CRPIX1, CRVAL1 and no CD1_1
		 # so, proceed to calculate the WCS again.
	         crpix1 = imgetr (im, "CRPIX1")
	         call imdelf (im, "CRPIX1")
	         call imaddr (im, "CNPIX1", crpix1)
	         crpix2 = imgetr (im, "CRPIX2")
	         call imdelf (im, "CRPIX2")
	         call imaddr (im, "CNPIX2", crpix2)
	      }
	   } else {
	      crpix1 = imgetr (im, "CRPIX1")
	      call imdelf (im, "CRPIX1")
	      call imaddr (im, "CNPIX1", crpix1)
	      crpix2 = imgetr (im, "CRPIX2")
	      call imdelf (im, "CRPIX2")
	      call imaddr (im, "CNPIX2", crpix2)
	   }
	}
	if (imaccf(im,"CNPIX1") == NO )
	   call error(0,"Lower left position CNPIX(1,2) not found")
	plate_cen_x = imgetd(im, "PPO3    ")
	plate_cen_y = imgetd(im, "PPO6    ")
	x_pixel_size = imgetd(im, "XPIXELSZ")
	y_pixel_size = imgetd(im, "YPIXELSZ")
	plate_scale = imgetd(im, "PLTSCALE")
	ra_h = imgeti (im, "PLTRAH  ")
	ra_m = imgeti (im, "PLTRAM  ")
	ra_s = imgetd (im, "PLTRAS  ")
	call imgstr(im, "PLTDECSN", dec_sign, 1)
	dec_d = imgeti (im, "PLTDECD ")
	dec_m = imgeti (im, "PLTDECM ")
	dec_s = imgetd (im, "PLTDECS ")

	plate_cen_ra = DEGTORAD ((ra_h + ra_m/60.0d0 + ra_s/3600.0)*15.0d0)
	plate_cen_dec = DEGTORAD (dec_d + dec_m/60.0d0 + dec_s/3600.0d0)
	if (dec_sign[1] == '-')
	   plate_cen_dec = -plate_cen_dec
 
	# Get general plate solution coefficients
	do i = 1, 20 {
	  call sprintf(parname, SZ_LINE, "AMDX%d")
	       call pargi(i)
	  amdx[i] = imgetd (im, parname)
	}
	do i = 1, 20 {
	  call sprintf(parname, SZ_LINE, "AMDY%d")
	       call pargi(i)
	  amdy[i] = imgetd (im, parname)
	}

	if (imaccf(im, "CNPIX1") == YES) {
	   xcorner = imgetr (im, "CNPIX1")
	   ycorner = imgetr (im, "CNPIX2")
	} else
	   call error(0,"CNPIXs keyword found")

	xsize   = IM_LEN(im,1)
	ysize   = IM_LEN(im,2) 
	crpix1  = xsize/2.
	crpix2  = ysize/2.

	# Center of image w/r to original lower left corner of
	# scanned plate
	im_x_center_pix = xcorner + (xsize/2.) - 0.5
	im_y_center_pix = ycorner + (ysize/2.) - 0.5

	# Calculate equatorial coordinates for the center of subset giving
	# the complete plate solution w/r to the original lower left corner
	call ccgseq (plate_cen_ra,
     		     plate_cen_dec,
		     plate_cen_x,
		     plate_cen_y,
		     x_pixel_size,
		     y_pixel_size,
		     plate_scale,
		     amdx,
		     amdy,
		     im_x_center_pix,
		     im_y_center_pix,
		     object_mag,
		     object_col,
		     crval1,
		     crval2)

	
	# calculate CD matrix values for the input subset from the original
	# plate solution.
	call calcds (plate_cen_ra,
		  plate_cen_dec,
		  plate_cen_x,
		  plate_cen_y,
		  xcorner,
		  ycorner,
		  x_pixel_size,
		  y_pixel_size,
		  plate_scale,
		  xsize,
		  ysize,	
		  crval1,
		  crval2,
		  amdx,
		  amdy,
		  cdmatx)

	# Now update the image header

	iferr (call addkf (im, "CTYPE1", 8, TY_CHAR,
			"r.a. in tangent plane proyection"))
			;
	call impstr (im, "CTYPE1", "RA---TAN")

	iferr (call addkf (im, "CTYPE2", 8, TY_CHAR,
			"dec. in tangent plane proyection"))
			;
	call impstr (im, "CTYPE2", "DEC--TAN")

	iferr (call addkf (im, "CRPIX1", 1, TY_REAL,
			"reference pixel of first axis"))
			;
	call imputr (im, "CRPIX1", crpix1)

	iferr (call addkf (im, "CRPIX2", 1, TY_REAL,
			"reference pixel of second axis"))
			;
	call imputr (im, "CRPIX2", crpix2)

	iferr (call addkf (im, "CRVAL1", 1, TY_REAL,
			"r.a. at pixel crpix1 in decimal degrees"))
			;
	call imputd (im, "CRVAL1", RADTODEG(crval1))

	iferr (call addkf (im, "CRVAL2", 1, TY_REAL,
			"dec. at pixel crpix2 in decimal degrees"))
			;
	call imputd (im, "CRVAL2", RADTODEG(crval2))

	# now add the new CD values
	iferr (call addkf (im, "CD1_1", 1, TY_REAL,
			"Change in r.a. per pixel along the first axis"))
			;
	else 
	   call addkf (im, "", 1, TY_REAL,
			"evaluated at the reference pixel")
	call imputd (im, "CD1_1", cdmatx[1])

	iferr (call addkf (im, "CD1_2", 1, TY_REAL,
			"ditto along the second axis"))
			;
	call imputd (im, "CD1_2", cdmatx[2])

	iferr (call addkf (im, "CD2_1", 1, TY_REAL,
			"Change in dec. per pixel along the first axis"))
			;
	else 
	   call addkf (im, "", 1, TY_REAL,
			"evaluated at the reference pixel")
	call imputd (im, "CD2_1", cdmatx[3])

	iferr (call addkf (im, "CD2_2", 1, TY_REAL,
			"ditto along the second axis"))
			;
	call imputd (im, "CD2_2", cdmatx[4])

	call imunmap (im)
end

include	<syserr.h>
include	<imhdr.h>
include <imio.h>
include <mach.h>

define  SZ_VALSTR   80
# ADDKF -- Add a user field to the image header.  It is an error if the named
# field already exists. 

procedure addkf (im, key, lenv, datatype, comment)

pointer	im			# image descriptor
char	key[SZ_KEYWORD]		# name of the new parameter
int	lenv			# keyword value length
int	datatype		# datatype of parameter
char	comment[SZ_VALSTR]		# comment describing new parameter

int	max_lenuserarea, diff, slen
pointer	sp, keyname, rp, ua, op
int	idb_kwlookup(), idb_findrecord(), strlen()
errchk	syserrs

begin
	call smark (sp)
	call salloc (keyname, SZ_FNAME, TY_CHAR)
	call strcpy (key, Memc[keyname], SZ_FNAME)

	# Check for a redefinition.
	if ((idb_kwlookup (key) > 0) || (idb_findrecord (im, key, rp) > 0))
	    call syserrs (SYS_IDBREDEF, key)
	
	# Open the user area string for appending.  If the user area is not
	# empty the last character must be the newline record delimiter,
	# else the new record we add will be invalid.

	max_lenuserarea = (LEN_IMDES + IM_LENHDRMEM(im) - IMU + 1) * SZ_STRUCT
	ua = IM_USERAREA(im)

	for (rp=ua;  Memc[rp] != EOS;  rp=rp+1)
	    ;
	if (rp - ua + SZ_VALSTR + 1 >= max_lenuserarea)
	    call syserrs (SYS_IDBOVFL, key)

	if (rp > ua && Memc[rp-1] != '\n') {
	    Memc[rp] = '\n'
	    rp = rp + 1
	}

	# Append the new record with an uninitialized value field.  Keyword
	# value pairs are encoded in FITS format.

	do op = rp, rp + SZ_VALSTR		# blank fill card
	    Memc[op] = ' '

	# Add the "= 'value' / comment".
	slen = strlen(Memc[keyname])
	call amovc (Memc[keyname], Memc[rp], slen)
	if (slen != 0)
	   Memc[rp+9-1] = '='
	if (datatype == TY_CHAR) {
	    Memc[rp+11-1] = '\''
	    Memc[rp+20-1] = '\''
	}

	# Add the comment field.
	diff = lenv - 20
	if (diff > 0) {
	   Memc[rp+34-1+diff] = '/'
	   call amovc (comment, Memc[rp+36-1+diff],
	       min (SZ_VALSTR-36+1-diff, strlen(comment)))
	} else {
	   Memc[rp+32-1] = '/'
	   call amovc (comment, Memc[rp+34-1],
	       min (SZ_VALSTR-34+1, strlen(comment)))
	}
	# Terminate the card.
	Memc[rp+SZ_VALSTR] = '\n'
	Memc[rp+SZ_VALSTR+1] = EOS

	call sfree (sp)
end