File Coverage

blib/lib/Astro/FITS/HdrTrans/SPEX.pm
Criterion Covered Total %
statement 18 205 8.7
branch 0 54 0.0
condition 0 18 0.0
subroutine 7 35 20.0
pod 4 29 13.7
total 29 341 8.5


line stmt bran cond sub pod time code
1             package Astro::FITS::HdrTrans::SPEX;
2              
3             =head1 NAME
4              
5             Astro::FITS::HdrTrans::SPEX - IRTF SPEX translations
6              
7             =head1 SYNOPSIS
8              
9             use Astro::FITS::HdrTrans::SPEX;
10              
11             %gen = Astro::FITS::HdrTrans::SPEX->translate_from_FITS( %hdr );
12              
13             =head1 DESCRIPTION
14              
15             This class provides a generic set of translations that are specific to
16             the SPEX camera of the IRTF.
17              
18             =cut
19              
20 10     10   36000614 use 5.006;
  10         40  
21 10     10   59 use warnings;
  10         31  
  10         329  
22 10     10   66 use strict;
  10         25  
  10         225  
23 10     10   63 use Carp;
  10         20  
  10         771  
24              
25             # Inherit from ESO
26 10     10   71 use base qw/ Astro::FITS::HdrTrans::FITS /;
  10         21  
  10         1650  
27              
28 10     10   69 use vars qw/ $VERSION /;
  10         38  
  10         21247  
29              
30             $VERSION = "1.64";
31              
32             # for a constant mapping, there is no FITS header, just a generic
33             # header that is constant
34             my %CONST_MAP = (
35             # Value in headers is too imprecise
36             DEC_SCALE => (-0.1182/3600.0),
37             DETECTOR_READ_TYPE => 'NDSTARE',
38             GAIN => 13.0,
39             OBSERVATION_MODE => 'imaging',
40             NSCAN_POSITIONS => 1,
41             # Value in headers is too imprecise
42             RA_SCALE => (-0.116/3600.0),
43             ROTATION => -1.03,
44             SPEED_GAIN => 'Normal',
45             );
46              
47             # NULL mappings used to override base class implementations
48             my @NULL_MAP = qw/ /;
49              
50             # unit mapping implies that the value propogates directly
51             # to the output with only a keyword name change
52              
53             my %UNIT_MAP = (
54             EXPOSURE_TIME => "ITIME",
55             FILTER => "GFLT",
56             OBJECT => 'OBJECT',
57             );
58              
59              
60             # Create the translation methods
61             __PACKAGE__->_generate_lookup_methods( \%CONST_MAP, \%UNIT_MAP, \@NULL_MAP );
62              
63             =head1 METHODS
64              
65             =over 4
66              
67             =item B<this_instrument>
68              
69             The name of the instrument required to match (case insensitively)
70             against the INSTRUME/INSTRUMENT keyword to allow this class to
71             translate the specified headers. Called by the default
72             C<can_translate> method.
73              
74             $inst = $class->this_instrument();
75              
76             Returns "INGRID".
77              
78             =cut
79              
80             sub this_instrument {
81 20     20 1 112 return qr/^SPEX/i;
82             }
83              
84             =back
85              
86             =head1 COMPLEX CONVERSIONS
87              
88             =over 4
89              
90             =cut
91              
92             sub to_AIRMASS_START {
93 0     0 0   my $self = shift;
94 0           my $FITS_headers = shift;
95 0           my $airmass = 1.0;
96 0 0         if ( defined( $FITS_headers->{AIRMASS} ) ) {
97 0           $airmass = $FITS_headers->{AIRMASS};
98             }
99 0           return $airmass;
100             }
101              
102             sub to_AIRMASS_END {
103 0     0 0   my $self = shift;
104 0           my $FITS_headers = shift;
105 0           my $airmass = 1.0;
106 0 0         if ( defined( $FITS_headers->{AIRMASS} ) ) {
107 0           $airmass = $FITS_headers->{AIRMASS};
108             }
109 0           return $airmass;
110             }
111              
112             sub from_AIRMASS_END {
113 0     0 0   my $self = shift;
114 0           my $generic_headers = shift;
115 0           "AMEND", $generic_headers->{ "AIRMASS_END" };
116             }
117              
118             # Convert from sexagesimal d:m:s to decimal degrees.
119             sub to_DEC_BASE {
120 0     0 0   my $self = shift;
121 0           my $FITS_headers = shift;
122 0           my $dec = 0.0;
123 0           my $sexa = $FITS_headers->{"DECBASE"};
124 0 0         if ( defined( $sexa ) ) {
125 0           $dec = $self->dms_to_degrees( $sexa );
126             }
127 0           return $dec;
128             }
129              
130             # Assume that the initial offset is 0.0, i.e. the base is the
131             # source position. This also assumes that the reference pixel
132             # is unchanged in the group, as is created in the conversion
133             # script. The other headers are measured in sexagesimal, but
134             # the offsets are in arcseconds.
135             sub to_DEC_TELESCOPE_OFFSET {
136 0     0 0   my $self = shift;
137 0           my $FITS_headers = shift;
138 0           my $offset;
139 0           my $base = $self->to_DEC_BASE($FITS_headers);
140              
141             # Convert from sexagesimal d:m:s to decimal degrees.
142 0           my $sexadec = $FITS_headers->{DEC};
143 0 0         if ( defined( $sexadec ) ) {
144 0           my $dec = $self->dms_to_degrees( $sexadec );
145              
146             # The offset is arcseconds with respect to the base position.
147 0           $offset = 3600.0 * ( $dec - $base );
148             } else {
149 0           $offset = 0.0;
150             }
151 0           return $offset;
152             }
153              
154             sub to_DR_RECIPE {
155 0     0 0   my $self = shift;
156 0           my $FITS_headers = shift;
157 0           my $recipe = "JITTER_SELF_FLAT";
158 0 0         if ( $self->to_OBSERVATION_TYPE($FITS_headers) eq "DARK" ) {
    0          
159 0           $recipe = "REDUCE_DARK";
160             } elsif ( $self->to_STANDARD($FITS_headers) ) {
161 0           $recipe = "JITTER_SELF_FLAT_APHOT";
162             }
163 0           return $recipe;
164             }
165              
166              
167             sub to_NUMBER_OF_EXPOSURES {
168 0     0 0   my $self = shift;
169 0           my $FITS_headers = shift;
170 0           my $coadds = 1;
171 0 0         if ( defined $FITS_headers->{CO_ADDS} ) {
172 0           $coadds = $FITS_headers->{CO_ADDS};
173             }
174              
175             }
176              
177             sub to_NUMBER_OF_OFFSETS {
178 0     0 0   my $self = shift;
179 0           my $FITS_headers = shift;
180              
181             # Allow for the UKIRT convention of the final offset to 0,0, and a
182             # default dither pattern of 5.
183 0           my $noffsets = 6;
184              
185             # The number of gripu members appears to be given by keyword LOOP.
186 0 0         if ( defined $FITS_headers->{NOFFSETS} ) {
187 0           $noffsets = $FITS_headers->{NOFFSETS};
188             }
189              
190 0           return $noffsets;
191             }
192              
193             sub to_OBSERVATION_TYPE {
194 0     0 0   my $self = shift;
195 0           my $FITS_headers = shift;
196 0           my $type = "OBJECT";
197 0 0 0       if ( defined $FITS_headers->{OBJECT} && defined $FITS_headers->{GFLT}) {
198 0           my $object = uc( $FITS_headers->{OBJECT} );
199 0           my $filter = uc( $FITS_headers->{GFLT} );
200 0 0         if ( $filter =~ /blank/i ) {
    0          
201 0           $type = "DARK";
202             } elsif ( $object =~ /flat/i ) {
203 0           $type = "FLAT";
204             }
205             }
206 0           return $type;
207             }
208              
209             # Convert from sexagesimal h:m:s to decimal degrees then to decimal
210             # hours.
211             sub to_RA_BASE {
212 0     0 0   my $self = shift;
213 0           my $FITS_headers = shift;
214 0           my $ra = 0.0;
215 0           my $sexa = $FITS_headers->{"RABASE"};
216 0 0         if ( defined( $sexa ) ) {
217 0           $ra = $self->hms_to_degrees( $sexa );
218             }
219 0           return $ra;
220             }
221              
222             # Assume that the initial offset is 0.0, i.e. the base is the
223             # source position. This also assumes that the reference pixel
224             # is unchanged in the group, as is created in the conversion
225             # script. The other headers are measured in sexagesimal, but
226             # the offsets are in arcseconds.
227             sub to_RA_TELESCOPE_OFFSET {
228 0     0 0   my $self = shift;
229 0           my $FITS_headers = shift;
230 0           my $offset;
231              
232             # Base RA is in degrees.
233 0           my $base = $self->to_RA_BASE($FITS_headers);
234              
235             # Convert from sexagesimal right ascension h:m:s and declination
236             # d:m:s to decimal degrees.
237 0           my $sexara = $FITS_headers->{RA};
238 0           my $sexadec = $FITS_headers->{DEC};
239 0 0 0       if ( defined( $base ) && defined( $sexara ) && defined( $sexadec ) ) {
      0        
240 0           my $dec = $self->dms_to_degrees( $sexadec );
241 0           my $ra = $self->hms_to_degrees( $sexara );
242              
243             # The offset is arcseconds with respect to the base position.
244 0           $offset = 3600.0 * ( $ra - $base ) * $self->cosdeg( $dec );
245             } else {
246 0           $offset = 0.0;
247             }
248 0           return $offset;
249             }
250              
251             # Take a pragmatic way of defining a standard. Not perfect, but
252             # should suffice unitl we know all the names.
253             sub to_STANDARD {
254 0     0 0   my $self = shift;
255 0           my $FITS_headers = shift;
256 0           my $standard = 0;
257 0           my $object = $FITS_headers->{"OBJECT"};
258 0 0 0       if ( defined( $object ) && $object =~ /^FS/ ) {
259 0           $standard = 1;
260             }
261 0           return $standard;
262             }
263              
264             # Allow for multiple occurences of the date, the first being valid and
265             # the second is blank.
266             sub to_UTDATE {
267 0     0 1   my $self = shift;
268 0           my $FITS_headers = shift;
269 0           my $utdate;
270 0 0         if ( exists $FITS_headers->{"DATE-OBS"} ) {
    0          
271 0           $utdate = $FITS_headers->{"DATE-OBS"};
272              
273             # This is a kludge to work with old data which has multiple values of
274             # the DATE keyword with the last value being blank (these were early
275             # SPEX data). Return the first value, since the last value can be
276             # blank.
277 0 0         if ( ref( $utdate ) eq 'ARRAY' ) {
278 0           $utdate = $utdate->[0];
279             }
280             } elsif (exists $FITS_headers->{'DATE_OBS'}) {
281 0           $utdate = $FITS_headers->{'DATE_OBS'};
282             }
283 0 0         $utdate =~ s/-//g if $utdate;
284 0           return $utdate;
285             }
286              
287             # Derive from the start time, plus the exposure time and some
288             # allowance for the read time taken from
289             # http://irtfweb.ifa.hawaii.edu/~spex
290             # http://irtfweb.ifa.hawaii.edu/Facility/spex/work/array_params/array_params.html
291             sub to_UTEND {
292 0     0 1   my $self = shift;
293 0           my $FITS_headers = shift;
294 0           my $utend = $self->to_UTSTART($FITS_headers);
295 0 0 0       if ( defined $FITS_headers->{ITIME} && defined $FITS_headers->{NDR} ) {
296 0           $utend += ( $FITS_headers->{ITIME} * $FITS_headers->{NDR}) ;
297             }
298 0           return $utend;
299             }
300              
301             sub to_UTSTART {
302 0     0 1   my $self = shift;
303 0           my $FITS_headers = shift;
304 0           my $base = $self->to_UTDATE( $FITS_headers );
305 0 0         return unless defined $base;
306 0 0         if (exists $FITS_headers->{TIME_OBS}) {
307 0           my $ymd = substr($base,0,4). "-". substr($base,4,2)."-". substr($base,6,2);
308 0           my $iso = $ymd. "T" . $FITS_headers->{TIME_OBS};
309 0           return $self->_parse_iso_date( $iso );
310             }
311 0           return;
312             }
313              
314             sub to_X_LOWER_BOUND {
315 0     0 0   my $self = shift;
316 0           my $FITS_headers = shift;
317 0           my @bounds = $self->get_bounds($FITS_headers);
318 0           return $bounds[ 0 ];
319             }
320              
321             # Specify the reference pixel, which is normally near the frame centre.
322             sub to_X_REFERENCE_PIXEL{
323 0     0 0   my $self = shift;
324 0           my $FITS_headers = shift;
325 0           my $xref;
326              
327             # Use the average of the bounds to define the centre and dimension.
328 0           my @bounds = $self->get_bounds($FITS_headers);
329 0           my $xdim = $bounds[ 2 ] - $bounds[ 0 ] + 1;
330 0           my $xmid = $self->nint( ( $bounds[ 2 ] + $bounds[ 0 ] ) / 2 );
331              
332             # SPEX is at the centre for a sub-array along an axis but offset slightly
333             # for a sub-array to avoid the joins between the four sub-array sections
334             # of the frame. Ideally these should come through the headers...
335 0 0         if ( $xdim == 512 ) {
336 0           $xref = $xmid - 36;
337             } else {
338 0           $xref = $xmid;
339             }
340 0           return $xref;
341             }
342              
343             sub from_X_REFERENCE_PIXEL {
344 0     0 0   my $self = shift;
345 0           my $generic_headers = shift;
346 0           "CRPIX1", $generic_headers->{"X_REFERENCE_PIXEL"};
347             }
348              
349             sub to_X_UPPER_BOUND {
350 0     0 0   my $self = shift;
351 0           my $FITS_headers = shift;
352 0           my @bounds = $self->get_bounds( $FITS_headers );
353 0           return $bounds[ 2 ];
354             }
355              
356             sub to_Y_LOWER_BOUND {
357 0     0 0   my $self = shift;
358 0           my $FITS_headers = shift;
359 0           my @bounds = $self->get_bounds( $FITS_headers );
360 0           return $bounds[ 1 ];
361             }
362              
363             # Specify the reference pixel, which is normally near the frame centre.
364             sub to_Y_REFERENCE_PIXEL{
365 0     0 0   my $self = shift;
366 0           my $FITS_headers = shift;
367 0           my $yref;
368              
369             # Use the average of the bounds to define the centre and dimension.
370 0           my @bounds = $self->get_bounds($FITS_headers);
371 0           my $ydim = $bounds[ 3 ] - $bounds[ 1 ] + 1;
372 0           my $ymid = $self->nint( ( $bounds[ 3 ] + $bounds[ 1 ] ) / 2 );
373              
374             # SPEX is at the centre for a sub-array along an axis but offset slightly
375             # for a sub-array to avoid the joins between the four sub-array sections
376             # of the frame. Ideally these should come through the headers...
377 0 0         if ( $ydim == 512 ) {
378 0           $yref = $ymid - 40;
379             } else {
380 0           $yref = $ymid;
381             }
382              
383 0           return $yref;
384             }
385              
386             sub from_Y_REFERENCE_PIXEL {
387 0     0 0   my $self = shift;
388 0           my $generic_headers = shift;
389 0           "CRPIX2", $generic_headers->{"Y_REFERENCE_PIXEL"};
390             }
391              
392             sub to_Y_UPPER_BOUND {
393 0     0 0   my $self = shift;
394 0           my $FITS_headers = shift;
395 0           my @bounds = $self->get_bounds( $FITS_headers );
396 0           return $bounds[ 3 ];
397             }
398              
399             # Supplementary methods for the translations
400             # ------------------------------------------
401              
402             # Converts a sky angle specified in d:m:s format into decimal degrees.
403             # Argument is the sexagesimal format angle.
404             sub dms_to_degrees {
405 0     0 0   my $self = shift;
406 0           my $sexa = shift;
407 0           my $dms;
408 0 0         if ( defined( $sexa ) ) {
409 0           my @pos = split( /:/, $sexa );
410 0           $dms = $pos[ 0 ] + $pos[ 1 ] / 60.0 + $pos [ 2 ] / 3600.;
411             }
412 0           return $dms;
413             }
414              
415             sub get_bounds {
416 0     0 0   my $self = shift;
417 0           my $FITS_headers = shift;
418 0           my @bounds = ( 1, 1, 512, 512 );
419 0 0         if ( exists $FITS_headers->{ARRAY0} ) {
420 0           my $boundlist = $FITS_headers->{ARRAY0};
421 0           @bounds = split( ",", $boundlist );
422              
423             # Bounds count from zero.
424 0           $bounds[ 0 ]++;
425 0           $bounds[ 1 ]++;
426             }
427 0           return @bounds;
428             }
429              
430             # Returns the UT date in yyyyMMdd format.
431             sub get_UT_date {
432 0     0 0   my $self = shift;
433 0           my $FITS_headers = shift;
434 0           my $date = $FITS_headers->{"DATE-OBS"};
435 0           $date =~ s/-//g;
436 0           return $date;
437             }
438              
439             # Returns the UT time of observation in decimal hours.
440             sub get_UT_hours {
441 0     0 0   my $self = shift;
442 0           my $FITS_headers = shift;
443 0 0 0       if ( exists $FITS_headers->{"TIME-OBS"} && $FITS_headers->{"TIME-OBS"} =~ /:/ ) {
444 0           my ($hour, $minute, $second) = split( /:/, $FITS_headers->{"TIME-OBS"} );
445 0           return $hour + ($minute / 60) + ($second / 3600);
446             } else {
447 0           return $FITS_headers->{"TIME-OBS"};
448             }
449             }
450              
451             # Converts a sky angle specified in h:m:s format into decimal degrees.
452             # It takes no account of latitude. Argument is the sexagesimal format angle.
453             sub hms_to_degrees {
454 0     0 0   my $self = shift;
455 0           my $sexa = shift;
456 0           my $hms;
457 0 0         if ( defined( $sexa ) ) {
458 0           my @pos = split( /:/, $sexa );
459 0           $hms = 15.0 * ( $pos[ 0 ] + $pos[ 1 ] / 60.0 + $pos [ 2 ] / 3600. );
460             }
461 0           return $hms;
462             }
463              
464              
465             =back
466              
467             =head1 SEE ALSO
468              
469             C<Astro::FITS::HdrTrans>, C<Astro::FITS::HdrTrans::UKIRT>.
470              
471             =head1 AUTHOR
472              
473             Malcolm J. Currie E<lt>mjc@star.rl.ac.ukE<gt>,
474             Tim Jenness E<lt>t.jenness@jach.hawaii.eduE<gt>.
475              
476             =head1 COPYRIGHT
477              
478             Copyright (C) 2008 Science and Technology Facilities Council.
479             Copyright (C) 2003-2005 Particle Physics and Astronomy Research Council.
480             All Rights Reserved.
481              
482             This program is free software; you can redistribute it and/or modify it under
483             the terms of the GNU General Public License as published by the Free Software
484             Foundation; either Version 2 of the License, or (at your option) any later
485             version.
486              
487             This program is distributed in the hope that it will be useful,but WITHOUT ANY
488             WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
489             PARTICULAR PURPOSE. See the GNU General Public License for more details.
490              
491             You should have received a copy of the GNU General Public License along with
492             this program; if not, write to the Free Software Foundation, Inc., 59 Temple
493             Place, Suite 330, Boston, MA 02111-1307, USA.
494              
495             =cut
496              
497             1;