File Coverage

blib/lib/Astro/FITS/HdrTrans/IRIS2.pm
Criterion Covered Total %
statement 21 194 10.8
branch 0 70 0.0
condition 0 42 0.0
subroutine 8 29 27.5
pod 21 22 95.4
total 50 357 14.0


line stmt bran cond sub pod time code
1              
2             =head1 NAME
3              
4             Astro::FITS::HdrTrans::IRIS2 - IRIS-2 Header translations
5              
6             =head1 SYNOPSIS
7              
8             %generic_headers = translate_from_FITS(\%FITS_headers, \@header_array);
9              
10             %FITS_headers = transate_to_FITS(\%generic_headers, \@header_array);
11              
12             =head1 DESCRIPTION
13              
14             Converts information contained in AAO IRIS2 FITS headers to and from
15             generic headers. See Astro::FITS::HdrTrans for a list of generic
16             headers.
17              
18             =cut
19              
20             use 5.006;
21 10     10   10622767 use warnings;
  10         27  
22 10     10   46 use strict;
  10         17  
  10         286  
23 10     10   38 use Carp;
  10         18  
  10         195  
24 10     10   52  
  10         17  
  10         688  
25             use Math::Trig qw/ acos deg2rad rad2deg /;
26 10     10   563  
  10         11523  
  10         532  
27             # Inherit from Base
28             use base qw/ Astro::FITS::HdrTrans::Base /;
29 10     10   61  
  10         23  
  10         1489  
30             use vars qw/ $VERSION /;
31 10     10   63  
  10         17  
  10         15817  
32             # Note that we use %02 not %03 because of historical reasons
33             $VERSION = "1.65";
34              
35              
36             # for a constant mapping, there is no FITS header, just a generic
37             # header that is constant
38             my %CONST_MAP = (
39             COORDINATE_UNITS => 'degrees',
40             GAIN => 5.2,
41             NSCAN_POSITIONS => 1,
42             SCAN_INCREMENT => 1,
43             );
44              
45             # NULL mappings used to override base class implementations
46             my @NULL_MAP = ();
47              
48             # unit mapping implies that the value propogates directly
49             # to the output with only a keyword name change
50              
51             my %UNIT_MAP = (
52             DEC_BASE => "CRVAL2",
53             DEC_TELESCOPE_OFFSET => "TDECOFF",
54             DETECTOR_INDEX => "DINDEX",
55             DETECTOR_READ_TYPE => "METHOD",
56             DR_GROUP => "GRPNUM",
57             DR_RECIPE => "RECIPE",
58             EQUINOX => "EQUINOX",
59             EXPOSURE_TIME => "EXPOSED",
60             INSTRUMENT => "INSTRUME",
61             NUMBER_OF_EXPOSURES => "CYCLES",
62             NUMBER_OF_OFFSETS => "NOFFSETS",
63             NUMBER_OF_READS => "READS",
64             OBJECT => "OBJECT",
65             OBSERVATION_NUMBER => "RUN",
66             OBSERVATION_TYPE => "OBSTYPE",
67             RA_BASE => "CRVAL1",
68             RA_TELESCOPE_OFFSET => "TRAOFF",
69             SLIT_ANGLE => "TEL_PA",
70             SLIT_NAME => "SLIT",
71             SPEED_GAIN => "SPEED",
72             STANDARD => "STANDARD",
73             TELESCOPE => "TELESCOP",
74             WAVEPLATE_ANGLE => "WPLANGLE",
75             X_DIM => "NAXIS1",
76             X_LOWER_BOUND => "DETECXS",
77             X_OFFSET => "RAOFF",
78             X_REFERENCE_PIXEL => "CRPIX1",
79             X_UPPER_BOUND => "DETECXE",
80             Y_BASE => "DECBASE",
81             Y_DIM => "NAXIS2",
82             Y_LOWER_BOUND => "DETECYS",
83             Y_OFFSET => "DECOFF",
84             Y_REFERENCE_PIXEL => "CRPIX2",
85             Y_UPPER_BOUND => "DETECYE",
86             );
87              
88              
89             # Create the translation methods
90             __PACKAGE__->_generate_lookup_methods( \%CONST_MAP, \%UNIT_MAP, \@NULL_MAP );
91              
92              
93             =head1 METHODS
94              
95             =over 4
96              
97             =item B<this_instrument>
98              
99             The name of the instrument required to match (case insensitively)
100             against the INSTRUME/INSTRUMENT keyword to allow this class to
101             translate the specified headers. Called by the default
102             C<can_translate> method.
103              
104             $inst = $class->this_instrument();
105              
106             Returns "IRIS2".
107              
108             =cut
109              
110             return "IRIS2";
111             }
112 20     20 1 53  
113             =back
114              
115             =head1 COMPLEX CONVERSIONS
116              
117             These methods are more complicated than a simple mapping. We have to
118             provide both from- and to-FITS conversions All these routines are
119             methods and the to_ routines all take a reference to a hash and return
120             the translated value (a many-to-one mapping) The from_ methods take a
121             reference to a generic hash and return a translated hash (sometimes
122             these are many-to-many)
123              
124             =over 4
125              
126             =item B<to_AIRMASS_END>
127              
128             Converts FITS header value of zenith distance into airmass value.
129              
130             =cut
131              
132             my $self = shift;
133             my $FITS_headers = shift;
134             my $pi = atan2( 1, 1 ) * 4;
135 0     0 1   my $return;
136 0           if (exists($FITS_headers->{ZDEND})) {
137 0           $return = 1 / cos( deg2rad($FITS_headers->{ZDEND}) );
138 0           }
139 0 0          
140 0           return $return;
141              
142             }
143 0            
144             =item B<from_AIRMASS_END>
145              
146             Converts airmass into zenith distance.
147              
148             =cut
149              
150             my $self = shift;
151             my $generic_headers = shift;
152             my %return_hash;
153             if (exists($generic_headers->{AIRMASS_END})) {
154 0     0 1   $return_hash{ZDEND} = rad2deg(acos($generic_headers->{AIRMASS_END}));
155 0           }
156 0           return %return_hash;
157 0 0         }
158 0            
159             =item B<to_AIRMASS_START>
160 0            
161             Converts FITS header value of zenith distance into airmass value.
162              
163             =cut
164              
165             my $self = shift;
166             my $FITS_headers = shift;
167             my $pi = atan2( 1, 1 ) * 4;
168             my $return;
169             if (exists($FITS_headers->{ZDSTART})) {
170 0     0 1   $return = 1 / cos( deg2rad($FITS_headers->{ZDSTART}) );
171 0           }
172 0            
173 0           return $return;
174 0 0          
175 0           }
176              
177             =item B<from_AIRMASS_START>
178 0            
179             Converts airmass into zenith distance.
180              
181             =cut
182              
183             my $self = shift;
184             my $generic_headers = shift;
185             my %return_hash;
186             if (exists($generic_headers->{AIRMASS_START})) {
187             $return_hash{ZDSTART} = rad2deg(acos($generic_headers->{AIRMASS_START}));
188             }
189 0     0 1   return %return_hash;
190 0           }
191 0            
192 0 0         =item B<to_COORDINATE_TYPE>
193 0            
194             Converts the C<EQUINOX> FITS header into B1950 or J2000, depending
195 0           on equinox value, and sets the C<COORDINATE_TYPE> generic header.
196              
197             =cut
198              
199             my $self = shift;
200             my $FITS_headers = shift;
201             my $return;
202             if (exists($FITS_headers->{EQUINOX})) {
203             if ($FITS_headers->{EQUINOX} =~ /1950/) {
204             $return = "B1950";
205             } elsif ($FITS_headers->{EQUINOX} =~ /2000/) {
206 0     0 1   $return = "J2000";
207 0           }
208 0           }
209 0 0         return $return;
210 0 0         }
    0          
211 0            
212             =item B<to_DEC_SCALE>
213 0            
214             Calculate the Declination pixel scale from the CD matrix.
215              
216 0           =cut
217              
218             my $self = shift;
219             my $FITS_headers = shift;
220             my $cd11 = $FITS_headers->{CD1_1};
221             my $cd12 = $FITS_headers->{CD1_2};
222             my $cd21 = $FITS_headers->{CD2_1};
223             my $cd22 = $FITS_headers->{CD2_2};
224             my $sgn;
225             if ( ( $cd11 * $cd22 - $cd12 * $cd21 ) < 0 ) {
226 0     0 1   $sgn = -1;
227 0           } else {
228 0           $sgn = 1;
229 0           }
230 0           return abs( sqrt( $cd11**2 + $cd21**2 ) );
231 0           }
232 0            
233 0 0         =item B<to_FILTER>
234 0            
235             Determine the filter name. Depends on the value of IR2_FILT.
236 0            
237             =cut
238 0            
239             my $self = shift;
240             my $FITS_headers = shift;
241             my $return;
242              
243             if ( $FITS_headers->{IR2_FILT} =~ /^OPEN$/i ) {
244             $return = $FITS_headers->{IR2_COLD};
245             } else {
246             $return = $FITS_headers->{IR2_FILT};
247             }
248 0     0 1   $return =~ s/ //g;
249 0           return $return;
250 0           }
251              
252 0 0         =item B<to_GRATING_DISPERSION>
253 0            
254             Calculate grating dispersion.
255 0            
256             Dispersion is only a function of grism and blocking filter used, but
257 0           need to allow for various choices of blocking filter
258 0            
259             =cut
260              
261             my $self = shift;
262             my $FITS_headers = shift;
263             my $return;
264              
265             my $obsmode = $self->to_OBSERVATION_MODE( $FITS_headers );
266             my $filter = $self->to_FILTER( $FITS_headers );
267              
268             if ( $obsmode eq 'spectroscopy' ) {
269             if ( uc($filter) eq 'K' || uc($filter) eq 'KS' ) {
270             $return = 0.0004423;
271 0     0 1   } elsif ( uc($filter) eq 'JS' ) {
272 0           $return = 0.0002322;
273 0           } elsif ( uc($filter) eq 'J' || uc($filter) eq 'JL' ) {
274             $return = 0.0002251;
275 0           } elsif ( uc($filter) eq 'H' || uc($filter) eq 'HS' || uc($filter) eq 'HL' ) {
276 0           $return = 0.0003413;
277             }
278 0 0         }
279 0 0 0       return $return;
    0 0        
    0 0        
    0 0        
280 0           }
281              
282 0           =item B<to_GRATING_DISPERSION>
283              
284 0           Calculate grating wavelength.
285              
286 0           Central wavelength is a function of grism + blocking filter + slit
287             used. Assume offset slit used for H/Hs and Jl, otherwise centre slit
288             is used. Central wavelengths computed for pixel 513, to match
289 0           calculation used in ORAC-DR.
290              
291             =cut
292              
293             my $self = shift;
294             my $FITS_headers = shift;
295             my $return;
296              
297             my $obsmode = $self->to_OBSERVATION_MODE( $FITS_headers );
298             my $filter = $self->to_FILTER( $FITS_headers );
299              
300             if ( $obsmode eq 'spectroscopy' ) {
301             if ( uc( $filter ) eq 'K' || uc( $filter ) eq 'KS' ) {
302             $return = 2.249388;
303             } elsif ( uc($filter) eq 'JS' ) {
304 0     0 0   $return = 1.157610;
305 0           } elsif ( uc($filter) eq 'J' || uc($filter) eq 'JL' ) {
306 0           $return = 1.219538;
307             } elsif ( uc($filter) eq 'H' || uc($filter) eq 'HS' || uc($filter) eq 'HL' ) {
308 0           $return = 1.636566;
309 0           }
310             }
311 0 0         return $return;
312 0 0 0       }
    0 0        
    0 0        
    0 0        
313 0            
314             =item B<to_OBSERVATION_MODE>
315 0            
316             Determines the observation mode from the IR2_SLIT or IR2_GRSM FITS header values. If
317 0           IR2_SLIT value is equal to "OPEN1", then the observation mode is imaging.
318             Otherwise, the observation mode is spectroscopy. If IR2_GRSM is matches SAP or SIL then
319 0           it is spectroscopy. IR2_GRSM is used in preference to IR2_SLIT.
320              
321             =cut
322 0            
323             my $self = shift;
324             my $FITS_headers = shift;
325             my $return;
326             if (exists($FITS_headers->{IR2_GRSM})) {
327             $return = ($FITS_headers->{IR2_GRSM} =~ /^(SAP|SIL)/i) ? "spectroscopy" : "imaging";
328             } elsif (exists($FITS_headers->{IR2_SLIT})) {
329             $return = ($FITS_headers->{IR2_SLIT} eq "OPEN1") ? "imaging" : "spectroscopy";
330             }
331             return $return;
332             }
333              
334             =item B<to_RA_SCALE>
335 0     0 1    
336 0           Calculate the right-ascension pixel scale from the CD matrix.
337 0            
338 0 0         =cut
    0          
339 0 0          
340             my $self = shift;
341 0 0         my $FITS_headers = shift;
342             my $cd12 = $FITS_headers->{CD1_2};
343 0           my $cd22 = $FITS_headers->{CD2_2};
344             return sqrt( $cd12**2 + $cd22**2 );
345             }
346              
347             =item B<to_UTDATE>
348              
349             Converts FITS header values into standard UT date value of the form
350             YYYYMMDD.
351              
352             =cut
353 0     0 1    
354 0           my $self = shift;
355 0           my $FITS_headers = shift;
356 0           my $return;
357 0           if (exists($FITS_headers->{UTDATE})) {
358             my $utdate = $FITS_headers->{UTDATE};
359             $utdate =~ s/://g;
360             $return = $utdate;
361             }
362              
363             return $return;
364             }
365              
366             =item B<from_UTDATE>
367              
368 0     0 1   Converts UT date in the form C<yyyymmdd> to C<yyyy:mm:dd>.
369 0            
370 0           =cut
371 0 0          
372 0           my $self = shift;
373 0           my $generic_headers = shift;
374 0           my %return_hash;
375             if (exists($generic_headers->{UTDATE})) {
376             my $date = $generic_headers->{UTDATE};
377 0           return () unless defined $date;
378             $return_hash{UTDATE} = substr($date,0,4).":".
379             substr($date,4,2).":".substr($date,6,2);
380             }
381             return %return_hash;
382             }
383              
384             =item B<to_UTEND>
385              
386             Converts FITS header UT date/time values for the end of the observation into
387 0     0 1   a C<Time::Piece> object.
388 0            
389 0           =cut
390 0 0          
391 0           my $self = shift;
392 0 0         my $FITS_headers = shift;
393 0           my $return;
394             if (exists($FITS_headers->{UTDATE}) && exists($FITS_headers->{UTEND})) {
395             my $utdate = $FITS_headers->{UTDATE};
396 0           $utdate =~ s/:/-/g;
397             $return = $utdate . "T" . $FITS_headers->{UTEND};
398             $return = $self->_parse_iso_date( $return );
399             }
400             return $return;
401             }
402              
403             =item B<from_UTEND>
404              
405             Converts end date into two FITS headers for IRIS2: UTDATE
406             (in the format YYYYMMDD) and UTEND (HH:MM:SS).
407 0     0 1    
408 0           =cut
409 0            
410 0 0 0       my $self = shift;
411 0           my $generic_headers = shift;
412 0           my %return_hash;
413 0           if (exists($generic_headers->{UTEND})) {
414 0           my $date = $generic_headers->{UTEND};
415             $return_hash{UTDATE} = sprintf("%04d:%02d:%02d",
416 0           $date->year, $date->mon, $date->mday);
417             $return_hash{UTEND} = sprintf("%02d:%02d:%02d",
418             $date->hour, $date->minute, $date->second);
419             }
420             return %return_hash;
421             }
422              
423             =item B<to_UTSTART>
424              
425             Converts FITS header UT date/time values for the start of the observation
426             into a C<Time::Piece> object.
427 0     0 1    
428 0           =cut
429 0            
430 0 0         my $self = shift;
431 0           my $FITS_headers = shift;
432 0           my $return;
433             if (exists($FITS_headers->{UTDATE}) && exists($FITS_headers->{UTSTART})) {
434 0           my $utdate = $FITS_headers->{UTDATE};
435             $utdate =~ s/:/-/g;
436             $return = $utdate . "T" . $FITS_headers->{UTSTART} . "";
437 0           $return = $self->_parse_iso_date( $return );
438             }
439             return $return;
440             }
441              
442             =item B<from_UTSTART>
443              
444             Converts the date into two FITS headers for IRIS2: UTDATE
445             (in the format YYYYMMDD) and UTSTART (HH:MM:SS).
446              
447             =cut
448 0     0 1    
449 0           my $self = shift;
450 0           my $generic_headers = shift;
451 0 0 0       my %return_hash;
452 0           if (exists($generic_headers->{UTSTART})) {
453 0           my $date = $generic_headers->{UTSTART};
454 0           $return_hash{UTDATE} = sprintf("%04d:%02d:%02d",
455 0           $date->year, $date->mon, $date->mday);
456             $return_hash{UTSTART} = sprintf("%02d:%02d:%02d",
457 0           $date->hour, $date->minute, $date->second);
458             }
459             return %return_hash;
460             }
461              
462             =item B<to_X_BASE>
463              
464             Converts the decimal hours in the FITS header C<RABASE> into
465             decimal degrees for the generic header C<X_BASE>.
466              
467             =cut
468 0     0 1    
469 0           my $self = shift;
470 0           my $FITS_headers = shift;
471 0 0         my $return;
472 0           if (exists($FITS_headers->{RABASE})) {
473 0           $return = $FITS_headers->{RABASE} * 15;
474             }
475 0           return $return;
476             }
477              
478 0           =item B<from_X_BASE>
479              
480             Converts the decimal degrees in the generic header C<X_BASE>
481             into decimal hours for the FITS header C<RABASE>.
482              
483             =cut
484              
485             my $self = shift;
486             my $generic_headers = shift;
487             my %return_hash;
488             if (exists($generic_headers->{X_BASE})) {
489 0     0 1   $return_hash{'RABASE'} = $generic_headers->{X_BASE} / 15;
490 0           }
491 0           return %return_hash;
492 0 0         }
493 0            
494             =item B<to_X_SCALE>
495 0            
496             Converts a linear transformation matrix into a pixel scale in the right
497             ascension axis. Results are in arcseconds per pixel.
498              
499             =cut
500              
501             # X_SCALE conversion courtesy Micah Johnson, from the cdelrot.pl script
502             # supplied for use with XIMAGE.
503              
504             my $self = shift;
505             my $FITS_headers = shift;
506 0     0 1   my $return;
507 0           if (exists($FITS_headers->{CD1_2}) &&
508 0           exists($FITS_headers->{CD2_2}) ) {
509 0 0         my $cd12 = $FITS_headers->{CD1_2};
510 0           my $cd22 = $FITS_headers->{CD2_2};
511             $return = sqrt( $cd12**2 + $cd22**2 ) * 3600;
512 0           }
513             return $return;
514             }
515              
516             =item B<to_Y_SCALE>
517              
518             Converts a linear transformation matrix into a pixel scale in the declination
519             axis. Results are in arcseconds per pixel.
520              
521             =cut
522              
523             # Y_SCALE conversion courtesy Micah Johnson, from the cdelrot.pl script
524             # supplied for use with XIMAGE.
525              
526 0     0 1   my $self = shift;
527 0           my $FITS_headers = shift;
528 0           my $return;
529 0 0 0       if (exists($FITS_headers->{CD1_1}) &&
530             exists($FITS_headers->{CD1_2}) &&
531 0           exists($FITS_headers->{CD2_1}) &&
532 0           exists($FITS_headers->{CD2_2}) ) {
533 0           my $cd11 = $FITS_headers->{CD1_1};
534             my $cd12 = $FITS_headers->{CD1_2};
535 0           my $cd21 = $FITS_headers->{CD2_1};
536             my $cd22 = $FITS_headers->{CD2_2};
537             my $sgn;
538             if ( ( $cd11 * $cd22 - $cd12 * $cd21 ) < 0 ) {
539             $sgn = -1;
540             } else {
541             $sgn = 1;
542             }
543             $return = $sgn * sqrt( $cd11**2 + $cd21**2 ) * 3600;
544             }
545             return $return;
546             }
547              
548             =back
549 0     0 1    
550 0           =head1 SEE ALSO
551 0            
552 0 0 0       C<Astro::FITS::HdrTrans>, C<Astro::FITS::HdrTrans::Base>.
      0        
      0        
553              
554             =head1 AUTHOR
555              
556 0           Brad Cavanagh E<lt>b.cavanagh@jach.hawaii.eduE<gt>,
557 0           Tim Jenness E<lt>t.jenness@jach.hawaii.eduE<gt>
558 0            
559 0           =head1 COPYRIGHT
560 0            
561 0 0         Copyright (C) 2008 Science and Technology Facilities Council.
562 0           Copyright (C) 2002-2007 Particle Physics and Astronomy Research Council.
563             All Rights Reserved.
564 0            
565             This program is free software; you can redistribute it and/or modify it under
566 0           the terms of the GNU General Public License as published by the Free Software
567             Foundation; either version 2 of the License, or (at your option) any later
568 0           version.
569              
570             This program is distributed in the hope that it will be useful,but WITHOUT ANY
571             WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
572             PARTICULAR PURPOSE. See the GNU General Public License for more details.
573              
574             You should have received a copy of the GNU General Public License along with
575             this program; if not, write to the Free Software Foundation, Inc., 59 Temple
576             Place,Suite 330, Boston, MA 02111-1307, USA
577              
578             =cut
579              
580             1;