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