File Coverage

blib/lib/Astro/FITS/HdrTrans/MICHELLE.pm
Criterion Covered Total %
statement 81 100 81.0
branch 10 24 41.6
condition 6 27 22.2
subroutine 16 17 94.1
pod 11 11 100.0
total 124 179 69.2


line stmt bran cond sub pod time code
1             package Astro::FITS::HdrTrans::MICHELLE;
2              
3             =head1 NAME
4              
5             Astro::FITS::HdrTrans::MICHELLE - UKIRT Michelle translations
6              
7             =head1 SYNOPSIS
8              
9             use Astro::FITS::HdrTrans::MICHELLE;
10              
11             %gen = Astro::FITS::HdrTrans::MICHELLE->translate_from_FITS( %hdr );
12              
13             =head1 DESCRIPTION
14              
15             This class provides a generic set of translations that are specific to
16             the MICHELLE camera and spectrometer of the United Kingdom Infrared
17             Telescope.
18              
19             =cut
20              
21 10     10   33685670 use 5.006;
  10         75  
22 10     10   104 use warnings;
  10         23  
  10         912  
23 10     10   98 use strict;
  10         35  
  10         293  
24 10     10   54 use Carp;
  10         19  
  10         1285  
25              
26             # Inherit from UKIRT
27             # UKIRTNew must come first because of DATE-OBS handling
28 10     10   83 use base qw/ Astro::FITS::HdrTrans::UKIRTNew /;
  10         30  
  10         16540  
29              
30             our $VERSION = "1.66";
31              
32             # for a constant mapping, there is no FITS header, just a generic
33             # header that is constant
34             my %CONST_MAP = (
35              
36             );
37              
38             # unit mapping implies that the value propogates directly
39             # to the output with only a keyword name change
40              
41             my %UNIT_MAP = (
42             # Michelle Specific
43             CHOP_ANGLE => "CHPANGLE",
44             CHOP_THROW => "CHPTHROW",
45             GRATING_DISPERSION => "GRATDISP",
46             GRATING_NAME => "GRATNAME",
47             GRATING_ORDER => "GRATORD",
48             GRATING_WAVELENGTH => "GRATPOS",
49             SAMPLING => "SAMPLING",
50             SLIT_ANGLE => "SLITANG",
51              
52             # CGS4 compatible
53             NSCAN_POSITIONS => "DETNINCR",
54             SCAN_INCREMENT => "DETINCR",
55              
56             # UIST compatible
57             NUMBER_OF_READS => "NREADS",
58             POLARIMETRY => "POLARISE",
59             SLIT_NAME => "SLITNAME",
60              
61             # UIST + WFCAM compatible
62             EXPOSURE_TIME => "EXP_TIME",
63              
64             # UFTI + IRCAM compatible
65             SPEED_GAIN => "SPD_GAIN",
66              
67             # CGS4 + UIST + WFCAM
68             CONFIGURATION_INDEX => 'CNFINDEX',
69             );
70              
71             # Derived from end entry in subheader
72             my %ENDOBS_MAP = (
73             DETECTOR_INDEX => 'DINDEX',
74             );
75              
76              
77             # Create the translation methods
78             __PACKAGE__->_generate_lookup_methods( \%CONST_MAP, \%UNIT_MAP, undef, \%ENDOBS_MAP );
79              
80             =head1 METHODS
81              
82             =over 4
83              
84             =item B<this_instrument>
85              
86             The name of the instrument required to match (case insensitively)
87             against the INSTRUME/INSTRUMENT keyword to allow this class to
88             translate the specified headers. Called by the default
89             C<can_translate> method.
90              
91             $inst = $class->this_instrument();
92              
93             Returns "MICHELLE".
94              
95             =cut
96              
97             sub this_instrument {
98 20     20 1 67 return "MICHELLE";
99             }
100              
101             =back
102              
103             =head1 COMPLEX CONVERSIONS
104              
105             =over 4
106              
107             =item B<to_DEC_TELESCOPE_OFFSET>
108              
109             Declination offsets need to be handled differently for spectroscopy
110             mode because of the new nod iterator.
111              
112             =cut
113              
114             sub to_DEC_TELESCOPE_OFFSET {
115 1     1 1 4 my $self = shift;
116 1         3 my $FITS_headers = shift;
117 1         3 my $decoff;
118              
119             # Determine the observation mode, e.g. spectroscopy or imaging.
120 1         7 my $mode = $self->to_OBSERVATION_MODE($FITS_headers);
121 1 50       6 if ( $mode eq 'spectroscopy' ) {
122              
123             # If the nod iterator is used, then telescope offsets always come out
124             # as 0,0. We need to check if we're in the B beam (the nodded
125             # position) to figure out what the offset is using the chop angle
126             # and throw.
127 1 50 33     5 if ( exists( $FITS_headers->{CHOPBEAM} ) &&
      33        
      33        
128             $FITS_headers->{CHOPBEAM} =~ /^B/ &&
129             exists( $FITS_headers->{CHPANGLE} ) &&
130             exists( $FITS_headers->{CHPTHROW} ) ) {
131              
132 1         214 my $pi = 4 * atan2( 1, 1 );
133 1         5 my $throw = $FITS_headers->{CHPTHROW};
134 1         92 my $angle = $FITS_headers->{CHPANGLE} * $pi / 180.0;
135 1         95 $decoff = $throw * cos( $angle );
136             } else {
137 0         0 $decoff = $FITS_headers->{TDECOFF};
138             }
139              
140             # Imaging.
141             } else {
142 0         0 $decoff = $FITS_headers->{TDECOFF};
143             }
144              
145 1         7 return $decoff;
146             }
147              
148             =item B<from_DEC_TELESCOPE_OFFSET>
149              
150             If we are nodding TDECOFF always comes out as 0.0. We always return
151             zero for spectroscopy and TDECOFF otherwise. It's possible that this
152             is incorrect and should only occur for the specific case of a B
153             chop beam. The chopbeam is not stored in the generic headers.
154              
155             =cut
156              
157             sub from_DEC_TELESCOPE_OFFSET {
158 1     1 1 4 my $self = shift;
159 1         3 my $generic_headers = shift;
160 1         2 my $tdecoff;
161 1 50       6 if ($generic_headers->{OBSERVATION_MODE} eq 'spectroscopy') {
162 1         3 $tdecoff = 0.0;
163             } else {
164 0         0 $tdecoff = $generic_headers->{DEC_TELESCOPE_OFFSET};
165             }
166 1         11 return ("TDECOFF",$tdecoff);
167             }
168              
169             =item B<to_DETECTOR_READ_TYPE>
170              
171             Usually DET_MODE but in some older data it can be DETMODE.
172              
173             =cut
174              
175             sub to_DETECTOR_READ_TYPE {
176 1     1 1 4 my $self = shift;
177 1         3 my $FITS_headers = shift;
178              
179             # cut off date is 20040206
180 1         2 my $read_type;
181 1         3 for my $k (qw/ DET_MODE DETMODE /) {
182 1 50       6 if (exists $FITS_headers->{$k}) {
183 1         41 $read_type = $FITS_headers->{$k};
184 1         93 last;
185             }
186             }
187 1         5 return $read_type;
188             }
189              
190             =item B<to_NUMBER_OF_OFFSETS>
191              
192             Cater for early data with missing headers. Normally the NOFFSETS
193             header is available.
194              
195             =cut
196              
197             sub to_NUMBER_OF_OFFSETS {
198 1     1 1 3 my $self = shift;
199 1         3 my $FITS_headers = shift;
200              
201             # It's normally a ABBA pattern. Add one for the final offset to 0,0.
202 1         2 my $noffsets = 5;
203              
204             # Look for a defined header containing integers.
205 1 50       6 if ( exists $FITS_headers->{NOFFSETS} ) {
206 1         76 my $noff = $FITS_headers->{NOFFSETS};
207 1 50 33     137 if ( defined $noff && $noff =~ /\d+/ ) {
208 1         5 $noffsets = $noff;
209             }
210             }
211 1         6 return $noffsets;
212             }
213              
214             =item B<to_OBSERVATION_MODE>
215              
216             Normally use INSTMODE header but for older data use CAMERA.
217              
218             =cut
219              
220             sub to_OBSERVATION_MODE {
221 2     2 1 7 my $self = shift;
222 2         6 my $FITS_headers = shift;
223              
224 2         4 my $mode;
225             # 20040206
226 2         5 for my $k (qw/ INSTMODE CAMERA /) {
227 2 50       17 if (exists $FITS_headers->{$k}) {
228 2         84 $mode = $FITS_headers->{$k};
229 2         195 last;
230             }
231             }
232 2         9 return $mode;
233             }
234              
235             =item B<to_RA_TELESCOPE_OFFSET>
236              
237             Right-ascension offsets need to be handled differently for spectroscopy
238             mode because of the new nod iterator.
239              
240             =cut
241              
242             sub _to_RA_TELESCOPE_OFFSET {
243 0     0   0 my $self = shift;
244 0         0 my $FITS_headers = shift;
245 0         0 my $raoff;
246              
247             # Determine the observation mode, e.g. spectroscopy or imaging.
248 0         0 my $mode = $self->to_OBSERVATION_MODE($FITS_headers);
249 0 0       0 if ( $mode eq 'spectroscopy' ) {
250              
251             # If the nod iterator is used, then telescope offsets always come out
252             # as 0,0. We need to check if we're in the B beam (the nodded
253             # position) to figure out what the offset is using the chop angle
254             # and throw.
255 0 0 0     0 if ( exists( $FITS_headers->{CHOPBEAM} ) &&
      0        
      0        
256             $FITS_headers->{CHOPBEAM} =~ /^B/ &&
257             exists( $FITS_headers->{CHPANGLE} ) &&
258             exists( $FITS_headers->{CHPTHROW} ) ) {
259 0         0 my $pi = 4 * atan2( 1, 1 );
260 0         0 my $throw = $FITS_headers->{CHPTHROW};
261 0         0 my $angle = $FITS_headers->{CHPANGLE} * $pi / 180.0;
262 0         0 $raoff = $throw * sin( $angle );
263              
264             } else {
265 0         0 $raoff = $FITS_headers->{TRAOFF};
266             }
267              
268             # Imaging.
269             } else {
270 0         0 $raoff = $FITS_headers->{TRAOFF};
271             }
272 0         0 return $raoff;
273             }
274              
275             =item B<from_TELESCOPE>
276              
277             For data taken before 20010906, return 'UKATC'. For data taken on and
278             after 20010906, return 'UKIRT'. Returned header is C<TELESCOP>.
279              
280             =cut
281              
282             sub from_TELESCOPE {
283 1     1 1 3 my $self = shift;
284 1         3 my $generic_headers = shift;
285 1         28 my $utdate = $generic_headers->{'UTDATE'};
286 1 50       33 if ( $utdate < 20010906 ) {
287 0         0 return( "TELESCOP", "UKATC" );
288             } else {
289 1         35 return( "TELESCOP", "UKIRT" );
290             }
291             }
292              
293             =item B<to_X_REFERENCE_PIXEL>
294              
295             Specify the reference pixel, which is normally near the frame centre.
296             Note that offsets for polarimetry are undefined.
297              
298             =cut
299              
300             sub to_X_REFERENCE_PIXEL{
301 1     1 1 4 my $self = shift;
302 1         2 my $FITS_headers = shift;
303 1         3 my $xref;
304              
305             # Use the average of the bounds to define the centre.
306 1 50 33     7 if ( exists $FITS_headers->{RDOUT_X1} && exists $FITS_headers->{RDOUT_X2} ) {
307 1         122 my $xl = $FITS_headers->{RDOUT_X1};
308 1         102 my $xu = $FITS_headers->{RDOUT_X2};
309 1         97 $xref = $self->nint( ( $xl + $xu ) / 2 );
310              
311             # Use a default of the centre of the full array.
312             } else {
313 0         0 $xref = 161;
314             }
315 1         5 return $xref;
316             }
317              
318             =item B<from_X_REFERENCE_PIXEL>
319              
320             Always returns the value '1' as CRPIX1.
321              
322             =cut
323              
324             sub from_X_REFERENCE_PIXEL {
325 1     1 1 4 my $self = shift;
326 1         29 return ("CRPIX1", 1.0);
327             }
328              
329             =item B<to_Y_REFERENCE_PIXEL>
330              
331             Specify the reference pixel, which is normally near the frame centre.
332             Note that offsets for polarimetry are undefined.
333              
334             =cut
335              
336             sub to_Y_REFERENCE_PIXEL{
337 1     1 1 3 my $self = shift;
338 1         3 my $FITS_headers = shift;
339 1         3 my $yref;
340              
341             # Use the average of the bounds to define the centre.
342 1 50 33     5 if ( exists $FITS_headers->{RDOUT_Y1} && exists $FITS_headers->{RDOUT_Y2} ) {
343 1         70 my $yl = $FITS_headers->{RDOUT_Y1};
344 1         93 my $yu = $FITS_headers->{RDOUT_Y2};
345 1         89 $yref = $self->nint( ( $yl + $yu ) / 2 );
346              
347             # Use a default of the centre of the full array.
348             } else {
349 0         0 $yref = 121;
350             }
351 1         5 return $yref;
352             }
353              
354             =item B<from_Y_REFERENCE_PIXEL>
355              
356             Always returns the value '1' as CRPIX2.
357              
358             =cut
359              
360             sub from_Y_REFERENCE_PIXEL {
361 1     1 1 3 my $self = shift;
362 1         27 return ("CRPIX2", 1.0);
363             }
364              
365             =back
366              
367             =head1 SEE ALSO
368              
369             C<Astro::FITS::HdrTrans>, C<Astro::FITS::HdrTrans::UKIRT>.
370              
371             =head1 AUTHOR
372              
373             Malcolm J. Currie E<lt>mjc@star.rl.ac.ukE<gt>
374             Brad Cavanagh E<lt>b.cavanagh@jach.hawaii.eduE<gt>,
375             Tim Jenness E<lt>t.jenness@jach.hawaii.eduE<gt>.
376              
377             =head1 COPYRIGHT
378              
379             Copyright (C) 2008 Science and Technology Facilities Council.
380             Copyright (C) 2006-2007 Particle Physics and Astronomy Research Council.
381             ACopyright (C) 2003-2005 Particle Physics and Astronomy Research Council.
382             All Rights Reserved.
383              
384             This program is free software; you can redistribute it and/or modify it under
385             the terms of the GNU General Public License as published by the Free Software
386             Foundation; either Version 2 of the License, or (at your option) any later
387             version.
388              
389             This program is distributed in the hope that it will be useful,but WITHOUT ANY
390             WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
391             PARTICULAR PURPOSE. See the GNU General Public License for more details.
392              
393             You should have received a copy of the GNU General Public License along with
394             this program; if not, write to the Free Software Foundation, Inc., 59 Temple
395             Place, Suite 330, Boston, MA 02111-1307, USA.
396              
397             =cut
398              
399             1;