line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Astro::FITS::HdrTrans::ACSIS; |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
=head1 NAME |
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
Astro::FITS::HdrTrans::ACSIS - class for translation of JCMT ACSIS headers |
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
=head1 SYNOPSIS |
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
use Astro::FITS::HdrTrans::ACSIS; |
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
=head1 DESCRIPTION |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
This class provides a set of translations for ACSIS at JCMT. |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
=cut |
16
|
|
|
|
|
|
|
|
17
|
10
|
|
|
10
|
|
26695539
|
use 5.006; |
|
10
|
|
|
|
|
40
|
|
18
|
10
|
|
|
10
|
|
72
|
use warnings; |
|
10
|
|
|
|
|
27
|
|
|
10
|
|
|
|
|
368
|
|
19
|
10
|
|
|
10
|
|
53
|
use strict; |
|
10
|
|
|
|
|
21
|
|
|
10
|
|
|
|
|
252
|
|
20
|
10
|
|
|
10
|
|
64
|
use Carp; |
|
10
|
|
|
|
|
19
|
|
|
10
|
|
|
|
|
810
|
|
21
|
|
|
|
|
|
|
|
22
|
10
|
|
|
10
|
|
7978
|
use Astro::Coords; |
|
10
|
|
|
|
|
5851352
|
|
|
10
|
|
|
|
|
365
|
|
23
|
10
|
|
|
10
|
|
6832
|
use Astro::Telescope; |
|
10
|
|
|
|
|
48555
|
|
|
10
|
|
|
|
|
363
|
|
24
|
10
|
|
|
10
|
|
89
|
use DateTime; |
|
10
|
|
|
|
|
24
|
|
|
10
|
|
|
|
|
228
|
|
25
|
10
|
|
|
10
|
|
108
|
use DateTime::TimeZone; |
|
10
|
|
|
|
|
24
|
|
|
10
|
|
|
|
|
282
|
|
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
# inherit from the Base translation class and not HdrTrans |
28
|
|
|
|
|
|
|
# itself (which is just a class-less wrapper) |
29
|
10
|
|
|
10
|
|
52
|
use base qw/ Astro::FITS::HdrTrans::JCMT /; |
|
10
|
|
|
|
|
22
|
|
|
10
|
|
|
|
|
6473
|
|
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
# Use the FITS standard DATE-OBS handling |
32
|
|
|
|
|
|
|
#use Astro::FITS::HdrTrans::FITS; |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
# Speed of light in km/s. |
35
|
10
|
|
|
10
|
|
81
|
use constant CLIGHT => 2.99792458e5; |
|
10
|
|
|
|
|
24
|
|
|
10
|
|
|
|
|
635
|
|
36
|
|
|
|
|
|
|
|
37
|
10
|
|
|
10
|
|
59
|
use vars qw/ $VERSION /; |
|
10
|
|
|
|
|
26
|
|
|
10
|
|
|
|
|
32222
|
|
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
$VERSION = "1.63"; |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
# Cache UTC definition |
42
|
|
|
|
|
|
|
our $UTC = DateTime::TimeZone->new( name => 'UTC' ); |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
# in each class we have three sets of data. |
45
|
|
|
|
|
|
|
# - constant mappings |
46
|
|
|
|
|
|
|
# - unit mappings |
47
|
|
|
|
|
|
|
# - complex mappings |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
# for a constant mapping, there is no FITS header, just a generic |
50
|
|
|
|
|
|
|
# header that is constant |
51
|
|
|
|
|
|
|
my %CONST_MAP = ( |
52
|
|
|
|
|
|
|
INST_DHS => 'ACSIS', |
53
|
|
|
|
|
|
|
); |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
# unit mapping implies that the value propagates directly |
56
|
|
|
|
|
|
|
# to the output with only a keyword name change |
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
my %UNIT_MAP = ( |
59
|
|
|
|
|
|
|
AIRMASS_END => 'AMEND', |
60
|
|
|
|
|
|
|
AMBIENT_TEMPERATURE=> 'ATSTART', |
61
|
|
|
|
|
|
|
AZIMUTH_END => 'AZEND', |
62
|
|
|
|
|
|
|
BACKEND => 'BACKEND', |
63
|
|
|
|
|
|
|
BANDWIDTH_MODE => 'BWMODE', |
64
|
|
|
|
|
|
|
CHOP_ANGLE => 'CHOP_PA', |
65
|
|
|
|
|
|
|
CHOP_COORDINATE_SYSTEM => 'CHOP_CRD', |
66
|
|
|
|
|
|
|
CHOP_FREQUENCY => 'CHOP_FRQ', |
67
|
|
|
|
|
|
|
CHOP_THROW => 'CHOP_THR', |
68
|
|
|
|
|
|
|
ELEVATION_END => 'ELEND', |
69
|
|
|
|
|
|
|
FRONTEND => 'INSTRUME', |
70
|
|
|
|
|
|
|
NUMBER_OF_CYCLES => 'NUM_CYC', |
71
|
|
|
|
|
|
|
SWITCH_MODE => 'SW_MODE', |
72
|
|
|
|
|
|
|
SPECIES => 'MOLECULE', |
73
|
|
|
|
|
|
|
VELOCITY_TYPE => 'DOPPLER', |
74
|
|
|
|
|
|
|
); |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
# Create the translation methods |
77
|
|
|
|
|
|
|
__PACKAGE__->_generate_lookup_methods( \%CONST_MAP, \%UNIT_MAP ); |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
=head1 METHODS |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
=over 4 |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
=item B<can_translate> |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
Returns true if the supplied headers can be handled by this class. |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
$cando = $class->can_translate( \%hdrs ); |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
For this class, the method will return true if the B<BACKEND> header exists |
90
|
|
|
|
|
|
|
and matches 'ACSIS'. |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
Can also match translated GSD files. |
93
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
=cut |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
sub can_translate { |
97
|
21
|
|
|
21
|
1
|
62
|
my $self = shift; |
98
|
21
|
|
|
|
|
52
|
my $headers = shift; |
99
|
|
|
|
|
|
|
|
100
|
21
|
100
|
66
|
|
|
200
|
if ( exists $headers->{BACKEND} && |
|
|
50
|
100
|
|
|
|
|
|
|
50
|
66
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
|
33
|
|
|
|
|
101
|
|
|
|
|
|
|
defined $headers->{BACKEND} && |
102
|
|
|
|
|
|
|
$headers->{BACKEND} =~ /^ACSIS/i |
103
|
|
|
|
|
|
|
) { |
104
|
2
|
|
|
|
|
214
|
return 1; |
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
# BACKEND will discriminate between DAS files converted to ACSIS format |
107
|
|
|
|
|
|
|
# from GSD format directly (handled by Astro::FITS::HdrTrans::JCMT_GSD). |
108
|
|
|
|
|
|
|
} elsif ( exists $headers->{BACKEND} && |
109
|
|
|
|
|
|
|
defined $headers->{BACKEND} && |
110
|
|
|
|
|
|
|
$headers->{BACKEND} =~ /^DAS/i && |
111
|
|
|
|
|
|
|
! (exists $headers->{'GSDFILE'} && exists $headers->{'SCA#'})) { |
112
|
|
|
|
|
|
|
# Do not want to confuse with reverse conversion |
113
|
|
|
|
|
|
|
# of JCMT_GSD data headers which will have a defined |
114
|
|
|
|
|
|
|
# BACKEND header of DAS. |
115
|
0
|
|
|
|
|
0
|
return 1; |
116
|
|
|
|
|
|
|
} elsif ( exists $headers->{INST_DHS} && |
117
|
|
|
|
|
|
|
defined $headers->{INST_DHS} && |
118
|
|
|
|
|
|
|
$headers->{INST_DHS} eq 'ACSIS') { |
119
|
|
|
|
|
|
|
# This is for the reverse conversion of DAS data |
120
|
0
|
|
|
|
|
0
|
return 1; |
121
|
|
|
|
|
|
|
} else { |
122
|
19
|
|
|
|
|
723
|
return 0; |
123
|
|
|
|
|
|
|
} |
124
|
|
|
|
|
|
|
} |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
=back |
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
=head1 COMPLEX CONVERSIONS |
129
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
These methods are more complicated than a simple mapping. We have to |
131
|
|
|
|
|
|
|
provide both from- and to-FITS conversions All these routines are |
132
|
|
|
|
|
|
|
methods and the to_ routines all take a reference to a hash and return |
133
|
|
|
|
|
|
|
the translated value (a many-to-one mapping) The from_ methods take a |
134
|
|
|
|
|
|
|
reference to a generic hash and return a translated hash (sometimes |
135
|
|
|
|
|
|
|
these are many-to-many) |
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
=over 4 |
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
=item B<to_DR_RECIPE> |
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
Usually simply copies the "RECIPE" header. If the observation type is |
142
|
|
|
|
|
|
|
skydip and the RECIPE header is "REDUCE_SCIENCE" we actually use |
143
|
|
|
|
|
|
|
REDUCE_SKYDIP. If a skydip is not being done and the STANDARD header |
144
|
|
|
|
|
|
|
is true, then the recipe is set to REDUCE_STANDARD. If the INBEAM |
145
|
|
|
|
|
|
|
header is "POL", the recipe name has "_POL" appended if it is a |
146
|
|
|
|
|
|
|
science observation. "REDUCE_SCIENCE" is translated to |
147
|
|
|
|
|
|
|
"REDUCE_SCIENCE_GRADIENT". |
148
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
=cut |
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
sub to_DR_RECIPE { |
152
|
1
|
|
|
1
|
1
|
3
|
my $class = shift; |
153
|
1
|
|
|
|
|
3
|
my $FITS_headers = shift; |
154
|
|
|
|
|
|
|
|
155
|
1
|
|
|
|
|
3
|
my $dr = $FITS_headers->{RECIPE}; |
156
|
|
|
|
|
|
|
|
157
|
1
|
|
|
|
|
81
|
my $obstype = lc( $class->to_OBSERVATION_TYPE( $FITS_headers ) ); |
158
|
1
|
|
|
|
|
5
|
my $pol = $class->to_POLARIMETER( $FITS_headers ); |
159
|
1
|
|
|
|
|
29
|
my $standard = $class->to_STANDARD( $FITS_headers ); |
160
|
1
|
|
|
|
|
4
|
my $utdate = $class->to_UTDATE( $FITS_headers ); |
161
|
1
|
|
|
|
|
30
|
my $freq_sw = $class->_is_FSW( $FITS_headers ); |
162
|
|
|
|
|
|
|
|
163
|
1
|
50
|
|
|
|
8
|
if ($utdate < 20080701) { |
164
|
1
|
50
|
33
|
|
|
4
|
if ($obstype eq 'skydip' && $dr eq 'REDUCE_SCIENCE') { |
165
|
0
|
|
|
|
|
0
|
$dr = "REDUCE_SKYDIP"; |
166
|
|
|
|
|
|
|
} |
167
|
|
|
|
|
|
|
} |
168
|
|
|
|
|
|
|
|
169
|
1
|
|
|
|
|
7
|
my $is_sci = ( $obstype =~ /science|raster|scan|grid|jiggle/ ); |
170
|
|
|
|
|
|
|
|
171
|
1
|
50
|
33
|
|
|
4
|
if ( $standard && $is_sci ) { |
172
|
0
|
|
|
|
|
0
|
$dr = "REDUCE_STANDARD"; |
173
|
|
|
|
|
|
|
} |
174
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
# Append unless we have already appended |
176
|
1
|
0
|
33
|
|
|
4
|
if ( $utdate > 20081115 && $pol && $is_sci ) { |
|
|
|
33
|
|
|
|
|
177
|
0
|
0
|
|
|
|
0
|
$dr .= "_POL" unless $dr =~ /_POL$/; |
178
|
|
|
|
|
|
|
} |
179
|
1
|
|
|
|
|
2
|
$dr = uc($dr); |
180
|
1
|
50
|
|
|
|
3
|
if( $dr eq 'REDUCE_SCIENCE' ) { |
181
|
0
|
0
|
|
|
|
0
|
$dr .= '_' . ($freq_sw ? 'FSW' : 'GRADIENT'); |
182
|
|
|
|
|
|
|
} |
183
|
|
|
|
|
|
|
|
184
|
1
|
|
|
|
|
4
|
return $dr; |
185
|
|
|
|
|
|
|
} |
186
|
|
|
|
|
|
|
|
187
|
|
|
|
|
|
|
=item B<from_DR_RECIPE> |
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
Returns DR_RECIPE unless we have a skydip. |
190
|
|
|
|
|
|
|
|
191
|
|
|
|
|
|
|
=cut |
192
|
|
|
|
|
|
|
|
193
|
|
|
|
|
|
|
sub from_DR_RECIPE { |
194
|
1
|
|
|
1
|
1
|
3
|
my $class = shift; |
195
|
1
|
|
|
|
|
2
|
my $generic_headers = shift; |
196
|
1
|
|
|
|
|
3
|
my $dr = $generic_headers->{DR_RECIPE}; |
197
|
1
|
|
|
|
|
3
|
my $ut = $generic_headers->{UTDATE}; |
198
|
1
|
50
|
33
|
|
|
6
|
if (defined $ut && $ut < 20080615) { |
199
|
1
|
50
|
33
|
|
|
12
|
if (defined $dr && $dr eq 'REDUCE_SKYDIP') { |
200
|
0
|
|
|
|
|
0
|
$dr = 'REDUCE_SCIENCE'; |
201
|
|
|
|
|
|
|
} |
202
|
|
|
|
|
|
|
} |
203
|
1
|
|
|
|
|
19
|
return ("RECIPE" => $dr); |
204
|
|
|
|
|
|
|
} |
205
|
|
|
|
|
|
|
|
206
|
|
|
|
|
|
|
=item B<to_POLARIMETER> |
207
|
|
|
|
|
|
|
|
208
|
|
|
|
|
|
|
If the polarimeter is in the beam, as denoted by the INBEAM header |
209
|
|
|
|
|
|
|
containing "POL", then this returns true. Otherwise, return false. |
210
|
|
|
|
|
|
|
|
211
|
|
|
|
|
|
|
=cut |
212
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
sub to_POLARIMETER { |
214
|
2
|
|
|
2
|
1
|
3
|
my $class = shift; |
215
|
2
|
|
|
|
|
4
|
my $FITS_headers = shift; |
216
|
|
|
|
|
|
|
|
217
|
2
|
|
|
|
|
7
|
my $inbeam = $FITS_headers->{INBEAM}; |
218
|
2
|
|
|
|
|
87
|
my $utdate = $class->to_UTDATE( $FITS_headers ); |
219
|
|
|
|
|
|
|
|
220
|
2
|
0
|
33
|
|
|
69
|
if ( $utdate > 20081115 && |
|
|
|
33
|
|
|
|
|
221
|
|
|
|
|
|
|
defined( $inbeam ) && |
222
|
|
|
|
|
|
|
$inbeam =~ /pol/i ) { |
223
|
0
|
|
|
|
|
0
|
return 1; |
224
|
|
|
|
|
|
|
} |
225
|
2
|
|
|
|
|
5
|
return 0; |
226
|
|
|
|
|
|
|
} |
227
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
=item B<from_POLARIMETER> |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
If the POLARIMETER header is true, then return "POL" for the INBEAM |
231
|
|
|
|
|
|
|
header. Otherwise, return undef. |
232
|
|
|
|
|
|
|
|
233
|
|
|
|
|
|
|
=cut |
234
|
|
|
|
|
|
|
|
235
|
|
|
|
|
|
|
sub from_POLARIMETER { |
236
|
1
|
|
|
1
|
1
|
2
|
my $class = shift; |
237
|
1
|
|
|
|
|
2
|
my $generic_headers = shift; |
238
|
|
|
|
|
|
|
|
239
|
1
|
|
|
|
|
3
|
my $pol = $generic_headers->{POLARIMETER}; |
240
|
|
|
|
|
|
|
|
241
|
1
|
50
|
|
|
|
3
|
if ( $pol ) { |
242
|
0
|
|
|
|
|
0
|
return ( "INBEAM" => "POL" ); |
243
|
|
|
|
|
|
|
} |
244
|
|
|
|
|
|
|
|
245
|
1
|
|
|
|
|
10
|
return ( "INBEAM" => undef ); |
246
|
|
|
|
|
|
|
} |
247
|
|
|
|
|
|
|
|
248
|
|
|
|
|
|
|
=item B<to_REFERENCE_LOCATION> |
249
|
|
|
|
|
|
|
|
250
|
|
|
|
|
|
|
Creates a string representing the location of the reference spectrum |
251
|
|
|
|
|
|
|
to the nearest hundredth of a degree. It takes the form |
252
|
|
|
|
|
|
|
system_longitude_latitude where system will normally be J2000 or GAL. |
253
|
|
|
|
|
|
|
If the string cannot be evaluated (such as missing headers), the |
254
|
|
|
|
|
|
|
returned value is undefined. |
255
|
|
|
|
|
|
|
|
256
|
|
|
|
|
|
|
=cut |
257
|
|
|
|
|
|
|
|
258
|
|
|
|
|
|
|
sub to_REFERENCE_LOCATION { |
259
|
1
|
|
|
1
|
1
|
3
|
my $self = shift; |
260
|
1
|
|
|
|
|
3
|
my $FITS_headers = shift; |
261
|
|
|
|
|
|
|
|
262
|
|
|
|
|
|
|
# Set the returned value in case something goes awry. |
263
|
1
|
|
|
|
|
2
|
my $ref_location = undef; |
264
|
|
|
|
|
|
|
|
265
|
|
|
|
|
|
|
# Assume that the co-ordinate system is the same for the BASE |
266
|
|
|
|
|
|
|
# co-ordinates as the offset to the reference spectrum. |
267
|
1
|
|
|
|
|
3
|
my ( $system, $base_lon, $base_lat ); |
268
|
|
|
|
|
|
|
|
269
|
|
|
|
|
|
|
$system = defined( $FITS_headers->{'TRACKSYS'} ) ? |
270
|
1
|
50
|
|
|
|
4
|
$FITS_headers->{'TRACKSYS'} : |
271
|
|
|
|
|
|
|
undef; |
272
|
1
|
50
|
|
|
|
51
|
$system =~ s/\s+$// if defined( $system ); |
273
|
|
|
|
|
|
|
|
274
|
|
|
|
|
|
|
# Obtain the base location's longitude in decimal degrees. |
275
|
|
|
|
|
|
|
$base_lon = defined( $FITS_headers->{'BASEC1'} ) ? |
276
|
1
|
50
|
|
|
|
4
|
$FITS_headers->{'BASEC1'} : |
277
|
|
|
|
|
|
|
undef; |
278
|
|
|
|
|
|
|
|
279
|
|
|
|
|
|
|
# Obtain the base location's latitude in decimal degrees. |
280
|
|
|
|
|
|
|
$base_lat = defined( $FITS_headers->{'BASEC2'} ) ? |
281
|
1
|
50
|
|
|
|
43
|
$FITS_headers->{'BASEC2'} : |
282
|
|
|
|
|
|
|
undef; |
283
|
|
|
|
|
|
|
|
284
|
|
|
|
|
|
|
# Derive the reference position's longitude. |
285
|
1
|
|
|
|
|
39
|
my $ref_lon = undef; |
286
|
1
|
50
|
33
|
|
|
16
|
if ( defined( $system ) && defined( $base_lon ) ) { |
287
|
|
|
|
|
|
|
|
288
|
|
|
|
|
|
|
# The value of SKYREFX has the form |
289
|
|
|
|
|
|
|
# [OFFSET] <longitude_offset_in_arcsec> [<co-ordinate system>] |
290
|
|
|
|
|
|
|
# |
291
|
|
|
|
|
|
|
# Assume for now that the TRACKSYS and co-ordinate system are the |
292
|
|
|
|
|
|
|
# same. |
293
|
0
|
0
|
|
|
|
0
|
if ( defined( $FITS_headers->{'SKYREFX'} ) ) { |
294
|
0
|
|
|
|
|
0
|
my $ref_x = $FITS_headers->{'SKYREFX'}; |
295
|
0
|
|
|
|
|
0
|
my @comps = split( /\s+/, $ref_x ); |
296
|
0
|
|
|
|
|
0
|
my $offset_lon = $comps[1] / 3600.0; |
297
|
|
|
|
|
|
|
|
298
|
|
|
|
|
|
|
# Two decimal places should permit sufficient fuzziness. |
299
|
0
|
|
|
|
|
0
|
$ref_lon = sprintf( "%.2f", $base_lon + $offset_lon ); |
300
|
|
|
|
|
|
|
} |
301
|
|
|
|
|
|
|
} |
302
|
|
|
|
|
|
|
|
303
|
|
|
|
|
|
|
# Derive the reference position's latitude. |
304
|
1
|
|
|
|
|
2
|
my $ref_lat = undef; |
305
|
1
|
50
|
33
|
|
|
4
|
if ( defined( $system ) && defined( $base_lat ) ) { |
306
|
|
|
|
|
|
|
|
307
|
|
|
|
|
|
|
# The value of SKYREFY has the form |
308
|
|
|
|
|
|
|
# [OFFSET] <latitude_offset_in_arcsec> [<co-ordinate system>] |
309
|
|
|
|
|
|
|
# |
310
|
|
|
|
|
|
|
# Assume for now that the TRACKSYS and co-ordinate system are the |
311
|
|
|
|
|
|
|
# same. |
312
|
0
|
0
|
|
|
|
0
|
if ( defined( $FITS_headers->{'SKYREFY'} ) ) { |
313
|
0
|
|
|
|
|
0
|
my $ref_y = $FITS_headers->{'SKYREFY'}; |
314
|
0
|
|
|
|
|
0
|
my @comps = split( /\s+/, $ref_y ); |
315
|
0
|
|
|
|
|
0
|
my $offset_lat = $comps[1] / 3600.0; |
316
|
0
|
|
|
|
|
0
|
$ref_lat = sprintf( "%.2f", $base_lat + $offset_lat ); |
317
|
|
|
|
|
|
|
} |
318
|
|
|
|
|
|
|
} |
319
|
|
|
|
|
|
|
|
320
|
|
|
|
|
|
|
# Form the string comprising the three elements. |
321
|
1
|
50
|
33
|
|
|
4
|
if ( defined( $ref_lon ) && defined( $ref_lat ) ) { |
322
|
0
|
|
|
|
|
0
|
$ref_location = $system . "_" . $ref_lon . "_" . $ref_lat; |
323
|
|
|
|
|
|
|
} |
324
|
|
|
|
|
|
|
|
325
|
1
|
|
|
|
|
3
|
return $ref_location; |
326
|
|
|
|
|
|
|
} |
327
|
|
|
|
|
|
|
|
328
|
|
|
|
|
|
|
|
329
|
|
|
|
|
|
|
=item B<to_SAMPLE_MODE> |
330
|
|
|
|
|
|
|
|
331
|
|
|
|
|
|
|
If the SAM_MODE value is either 'raster' or 'scan', return |
332
|
|
|
|
|
|
|
'scan'. Otherwise, return the value in lowercase. |
333
|
|
|
|
|
|
|
|
334
|
|
|
|
|
|
|
=cut |
335
|
|
|
|
|
|
|
|
336
|
|
|
|
|
|
|
sub to_SAMPLE_MODE { |
337
|
1
|
|
|
1
|
1
|
3
|
my $self = shift; |
338
|
1
|
|
|
|
|
2
|
my $FITS_headers = shift; |
339
|
|
|
|
|
|
|
|
340
|
1
|
|
|
|
|
2
|
my $sam_mode; |
341
|
1
|
50
|
33
|
|
|
3
|
if( defined( $FITS_headers->{'SAM_MODE'} ) && |
342
|
|
|
|
|
|
|
uc( $FITS_headers->{'SAM_MODE'} ) eq 'RASTER' ) { |
343
|
0
|
|
|
|
|
0
|
$sam_mode = 'scan'; |
344
|
|
|
|
|
|
|
} else { |
345
|
1
|
|
|
|
|
119
|
$sam_mode = lc( $FITS_headers->{'SAM_MODE'} ); |
346
|
|
|
|
|
|
|
} |
347
|
1
|
|
|
|
|
57
|
return $sam_mode; |
348
|
|
|
|
|
|
|
} |
349
|
|
|
|
|
|
|
|
350
|
|
|
|
|
|
|
=item B<to_SURVEY> |
351
|
|
|
|
|
|
|
|
352
|
|
|
|
|
|
|
Checks the value of the SURVEY header and uses that. If it's |
353
|
|
|
|
|
|
|
undefined, then use the PROJECT header to determine an appropriate |
354
|
|
|
|
|
|
|
survey. |
355
|
|
|
|
|
|
|
|
356
|
|
|
|
|
|
|
=cut |
357
|
|
|
|
|
|
|
|
358
|
|
|
|
|
|
|
sub to_SURVEY { |
359
|
1
|
|
|
1
|
1
|
2
|
my $self = shift; |
360
|
1
|
|
|
|
|
2
|
my $FITS_headers = shift; |
361
|
|
|
|
|
|
|
|
362
|
1
|
|
|
|
|
2
|
my $survey; |
363
|
|
|
|
|
|
|
|
364
|
1
|
50
|
|
|
|
4
|
if( defined( $FITS_headers->{'SURVEY'} ) ) { |
365
|
0
|
|
|
|
|
0
|
$survey = $FITS_headers->{'SURVEY'}; |
366
|
|
|
|
|
|
|
} else { |
367
|
|
|
|
|
|
|
|
368
|
1
|
|
|
|
|
58
|
my $project = $FITS_headers->{'PROJECT'}; |
369
|
1
|
50
|
|
|
|
56
|
if( defined( $project ) ) { |
370
|
1
|
50
|
|
|
|
4
|
if( $project =~ /JLS([GNS])/ ) { |
371
|
0
|
0
|
|
|
|
0
|
if( $1 eq 'G' ) { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
372
|
0
|
|
|
|
|
0
|
$survey = 'GBS'; |
373
|
|
|
|
|
|
|
} elsif( $1 eq 'N' ) { |
374
|
0
|
|
|
|
|
0
|
$survey = 'NGS'; |
375
|
|
|
|
|
|
|
} elsif( $1 eq 'S' ) { |
376
|
0
|
|
|
|
|
0
|
$survey = 'SLS'; |
377
|
|
|
|
|
|
|
} |
378
|
|
|
|
|
|
|
} |
379
|
|
|
|
|
|
|
} |
380
|
|
|
|
|
|
|
} |
381
|
|
|
|
|
|
|
|
382
|
1
|
|
|
|
|
3
|
return $survey; |
383
|
|
|
|
|
|
|
|
384
|
|
|
|
|
|
|
} |
385
|
|
|
|
|
|
|
|
386
|
|
|
|
|
|
|
=item B<to_EXPOSURE_TIME> |
387
|
|
|
|
|
|
|
|
388
|
|
|
|
|
|
|
Uses the to_UTSTART and to_UTEND functions to calculate the exposure |
389
|
|
|
|
|
|
|
time. Returns the exposure time as a scalar, not as a Time::Seconds |
390
|
|
|
|
|
|
|
object. |
391
|
|
|
|
|
|
|
|
392
|
|
|
|
|
|
|
=cut |
393
|
|
|
|
|
|
|
|
394
|
|
|
|
|
|
|
sub to_EXPOSURE_TIME { |
395
|
1
|
|
|
1
|
1
|
5
|
my $self = shift; |
396
|
1
|
|
|
|
|
4
|
my $FITS_headers = shift; |
397
|
|
|
|
|
|
|
|
398
|
|
|
|
|
|
|
# force date headers to be standardized |
399
|
1
|
|
|
|
|
4
|
$self->_fix_dates( $FITS_headers ); |
400
|
|
|
|
|
|
|
|
401
|
1
|
|
|
|
|
7
|
my $return; |
402
|
1
|
50
|
33
|
|
|
7
|
if ( exists( $FITS_headers->{'DATE-OBS'} ) && |
403
|
|
|
|
|
|
|
exists( $FITS_headers->{'DATE-END'} ) ) { |
404
|
1
|
|
|
|
|
50
|
my $start = $self->to_UTSTART( $FITS_headers ); |
405
|
1
|
|
|
|
|
9
|
my $end = $self->to_UTEND( $FITS_headers ); |
406
|
1
|
|
|
|
|
15
|
my $duration = $end - $start; |
407
|
1
|
|
|
|
|
38
|
$return = $duration->seconds; |
408
|
|
|
|
|
|
|
} |
409
|
1
|
|
|
|
|
41
|
return $return; |
410
|
|
|
|
|
|
|
} |
411
|
|
|
|
|
|
|
|
412
|
|
|
|
|
|
|
=item B<to_INSTRUMENT> |
413
|
|
|
|
|
|
|
|
414
|
|
|
|
|
|
|
Converts the C<INSTRUME> header into the C<INSTRUMENT> header. If the |
415
|
|
|
|
|
|
|
C<INSTRUME> header begins with "HARP" or "FE_HARP", then the |
416
|
|
|
|
|
|
|
C<INSTRUMENT> header will be set to "HARP". |
417
|
|
|
|
|
|
|
|
418
|
|
|
|
|
|
|
=cut |
419
|
|
|
|
|
|
|
|
420
|
|
|
|
|
|
|
sub to_INSTRUMENT { |
421
|
1
|
|
|
1
|
1
|
40
|
my $self = shift; |
422
|
1
|
|
|
|
|
3
|
my $FITS_headers = shift; |
423
|
1
|
|
|
|
|
2
|
my $return; |
424
|
1
|
50
|
|
|
|
6
|
if ( exists( $FITS_headers->{'INSTRUME'} ) ) { |
425
|
1
|
50
|
33
|
|
|
29
|
if ( $FITS_headers->{'INSTRUME'} =~ /^HARP/ || |
426
|
|
|
|
|
|
|
$FITS_headers->{'INSTRUME'} =~ /^FE_HARP/ ) { |
427
|
0
|
|
|
|
|
0
|
$return = "HARP"; |
428
|
|
|
|
|
|
|
} else { |
429
|
1
|
|
|
|
|
132
|
$return = $FITS_headers->{'INSTRUME'}; |
430
|
|
|
|
|
|
|
} |
431
|
|
|
|
|
|
|
} |
432
|
1
|
|
|
|
|
56
|
return $return; |
433
|
|
|
|
|
|
|
} |
434
|
|
|
|
|
|
|
|
435
|
|
|
|
|
|
|
=item B<to_OBSERVATION_ID> |
436
|
|
|
|
|
|
|
|
437
|
|
|
|
|
|
|
Converts the C<OBSID> header directly into the C<OBSERVATION_ID> |
438
|
|
|
|
|
|
|
generic header, or if that header does not exist, converts the |
439
|
|
|
|
|
|
|
C<BACKEND>, C<OBSNUM>, and C<DATE-OBS> headers into C<OBSERVATION_ID>. |
440
|
|
|
|
|
|
|
|
441
|
|
|
|
|
|
|
=cut |
442
|
|
|
|
|
|
|
|
443
|
|
|
|
|
|
|
sub to_OBSERVATION_ID { |
444
|
1
|
|
|
1
|
1
|
3
|
my $self = shift; |
445
|
1
|
|
|
|
|
2
|
my $FITS_headers = shift; |
446
|
1
|
|
|
|
|
3
|
my $return; |
447
|
1
|
50
|
33
|
|
|
4
|
if ( exists( $FITS_headers->{'OBSID'} ) && |
448
|
|
|
|
|
|
|
defined( $FITS_headers->{'OBSID'} ) ) { |
449
|
1
|
|
|
|
|
80
|
$return = $FITS_headers->{'OBSID'}; |
450
|
|
|
|
|
|
|
} else { |
451
|
0
|
|
|
|
|
0
|
$self->_fix_dates( $FITS_headers ); |
452
|
|
|
|
|
|
|
|
453
|
0
|
|
|
|
|
0
|
my $backend = lc( $self->to_BACKEND( $FITS_headers ) ); |
454
|
0
|
|
|
|
|
0
|
my $obsnum = $self->to_OBSERVATION_NUMBER( $FITS_headers ); |
455
|
0
|
|
|
|
|
0
|
my $dateobs = $self->to_UTSTART( $FITS_headers ); |
456
|
|
|
|
|
|
|
|
457
|
0
|
0
|
0
|
|
|
0
|
if ( defined( $backend ) && |
|
|
|
0
|
|
|
|
|
458
|
|
|
|
|
|
|
defined( $obsnum ) && |
459
|
|
|
|
|
|
|
defined( $dateobs ) ) { |
460
|
0
|
|
|
|
|
0
|
my $datetime = $dateobs->datetime; |
461
|
0
|
|
|
|
|
0
|
$datetime =~ s/-//g; |
462
|
0
|
|
|
|
|
0
|
$datetime =~ s/://g; |
463
|
|
|
|
|
|
|
|
464
|
0
|
|
|
|
|
0
|
$return = join '_', $backend, $obsnum, $datetime; |
465
|
|
|
|
|
|
|
} |
466
|
|
|
|
|
|
|
} |
467
|
|
|
|
|
|
|
|
468
|
1
|
|
|
|
|
52
|
return $return; |
469
|
|
|
|
|
|
|
} |
470
|
|
|
|
|
|
|
|
471
|
|
|
|
|
|
|
=item B<to_OBSERVATION_MODE> |
472
|
|
|
|
|
|
|
|
473
|
|
|
|
|
|
|
Concatenates the SAM_MODE, SW_MODE, and OBS_TYPE header keywords into |
474
|
|
|
|
|
|
|
the OBSERVATION_MODE generic header, with spaces removed and joined |
475
|
|
|
|
|
|
|
with underscores. For example, if SAM_MODE is 'jiggle ', SW_MODE is |
476
|
|
|
|
|
|
|
'chop ', and OBS_TYPE is 'science ', then the OBSERVATION_MODE generic |
477
|
|
|
|
|
|
|
header will be 'jiggle_chop_science'. |
478
|
|
|
|
|
|
|
|
479
|
|
|
|
|
|
|
=cut |
480
|
|
|
|
|
|
|
|
481
|
|
|
|
|
|
|
sub to_OBSERVATION_MODE { |
482
|
1
|
|
|
1
|
1
|
4
|
my $self = shift; |
483
|
1
|
|
|
|
|
2
|
my $FITS_headers = shift; |
484
|
|
|
|
|
|
|
|
485
|
1
|
|
|
|
|
2
|
my $return; |
486
|
1
|
50
|
33
|
|
|
6
|
if ( exists( $FITS_headers->{'SAM_MODE'} ) && |
|
|
|
33
|
|
|
|
|
487
|
|
|
|
|
|
|
exists( $FITS_headers->{'SW_MODE'} ) && |
488
|
|
|
|
|
|
|
exists( $FITS_headers->{'OBS_TYPE'} ) ) { |
489
|
1
|
|
|
|
|
67
|
my $sam_mode = $FITS_headers->{'SAM_MODE'}; |
490
|
1
|
|
|
|
|
62
|
$sam_mode =~ s/\s//g; |
491
|
1
|
50
|
|
|
|
5
|
$sam_mode = "raster" if $sam_mode eq "scan"; |
492
|
1
|
|
|
|
|
4
|
my $sw_mode = $FITS_headers->{'SW_MODE'}; |
493
|
1
|
|
|
|
|
54
|
$sw_mode =~ s/\s//g; |
494
|
|
|
|
|
|
|
|
495
|
|
|
|
|
|
|
# handle OBS_TYPE missing |
496
|
1
|
|
|
|
|
4
|
my $obs_type = $FITS_headers->{'OBS_TYPE'}; |
497
|
1
|
50
|
|
|
|
55
|
$obs_type = "science" unless $obs_type; |
498
|
1
|
|
|
|
|
3
|
$obs_type =~ s/\s//g; |
499
|
|
|
|
|
|
|
|
500
|
1
|
50
|
|
|
|
6
|
$return = ( ( $obs_type =~ /science/i ) |
501
|
|
|
|
|
|
|
? join '_', $sam_mode, $sw_mode |
502
|
|
|
|
|
|
|
: join '_', $sam_mode, $sw_mode, $obs_type ); |
503
|
|
|
|
|
|
|
} |
504
|
1
|
|
|
|
|
3
|
return $return; |
505
|
|
|
|
|
|
|
} |
506
|
|
|
|
|
|
|
|
507
|
|
|
|
|
|
|
=item B<to_OBSERVATION_TYPE> |
508
|
|
|
|
|
|
|
|
509
|
|
|
|
|
|
|
Returns the type of observation that was done. If the OBS_TYPE header |
510
|
|
|
|
|
|
|
matches /science/, the SAM_MODE header is used: if SAM_MODE matches |
511
|
|
|
|
|
|
|
/raster/, then return 'raster'. If SAM_MODE matches /grid/, then |
512
|
|
|
|
|
|
|
return 'grid'. If SAM_MODE matches /jiggle/, then return 'jiggle'. |
513
|
|
|
|
|
|
|
|
514
|
|
|
|
|
|
|
If the OBS_TYPE header matches /focus/, then return 'focus'. If the |
515
|
|
|
|
|
|
|
OBS_TYPE header matches /pointing/, then return 'pointing'. |
516
|
|
|
|
|
|
|
|
517
|
|
|
|
|
|
|
If none of the above options hold, then return undef. |
518
|
|
|
|
|
|
|
|
519
|
|
|
|
|
|
|
=cut |
520
|
|
|
|
|
|
|
|
521
|
|
|
|
|
|
|
sub to_OBSERVATION_TYPE { |
522
|
2
|
|
|
2
|
1
|
4
|
my $self = shift; |
523
|
2
|
|
|
|
|
4
|
my $FITS_headers = shift; |
524
|
|
|
|
|
|
|
|
525
|
2
|
|
|
|
|
2
|
my $return; |
526
|
2
|
|
|
|
|
5
|
my $ot = $FITS_headers->{OBS_TYPE}; |
527
|
|
|
|
|
|
|
|
528
|
|
|
|
|
|
|
# Sometimes we lack OBS_TYPE. In that case we have to assume SCIENCE |
529
|
|
|
|
|
|
|
# even though the headers are broken. (eg 20080509#18 RxWD) |
530
|
2
|
50
|
|
|
|
120
|
$ot = "science" unless $ot; |
531
|
|
|
|
|
|
|
|
532
|
2
|
50
|
|
|
|
4
|
if ( $ot ) { |
533
|
2
|
|
|
|
|
4
|
my $obs_type = lc( $ot ); |
534
|
|
|
|
|
|
|
|
535
|
2
|
50
|
|
|
|
10
|
if ( $obs_type =~ /science/ ) { |
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
536
|
|
|
|
|
|
|
|
537
|
0
|
0
|
|
|
|
0
|
if ( defined( $FITS_headers->{'SAM_MODE'} ) ) { |
538
|
|
|
|
|
|
|
|
539
|
0
|
|
|
|
|
0
|
my $sam_mode = $FITS_headers->{'SAM_MODE'}; |
540
|
|
|
|
|
|
|
|
541
|
0
|
0
|
|
|
|
0
|
if ( $sam_mode =~ /raster|scan/ ) { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
542
|
0
|
|
|
|
|
0
|
$return = "raster"; |
543
|
|
|
|
|
|
|
} elsif ( $sam_mode =~ /grid/ ) { |
544
|
0
|
|
|
|
|
0
|
$return = "grid"; |
545
|
|
|
|
|
|
|
} elsif ( $sam_mode =~ /jiggle/ ) { |
546
|
0
|
|
|
|
|
0
|
$return = "jiggle"; |
547
|
|
|
|
|
|
|
} else { |
548
|
0
|
|
|
|
|
0
|
croak "Unexpected sample mode: '$sam_mode'"; |
549
|
|
|
|
|
|
|
} |
550
|
|
|
|
|
|
|
} |
551
|
|
|
|
|
|
|
} elsif ( $obs_type =~ /focus/ ) { |
552
|
2
|
|
|
|
|
5
|
$return = "focus"; |
553
|
|
|
|
|
|
|
} elsif ( $obs_type =~ /pointing/ ) { |
554
|
0
|
|
|
|
|
0
|
$return = "pointing"; |
555
|
|
|
|
|
|
|
} elsif ( $obs_type =~ /skydip/) { |
556
|
0
|
|
|
|
|
0
|
$return = "skydip"; |
557
|
|
|
|
|
|
|
} else { |
558
|
0
|
|
|
|
|
0
|
croak "Unexpected OBS_TYPE of '$obs_type'\n"; |
559
|
|
|
|
|
|
|
} |
560
|
|
|
|
|
|
|
} |
561
|
|
|
|
|
|
|
|
562
|
2
|
|
|
|
|
5
|
return $return; |
563
|
|
|
|
|
|
|
} |
564
|
|
|
|
|
|
|
|
565
|
|
|
|
|
|
|
|
566
|
|
|
|
|
|
|
=item B<to_REST_FREQUENCY> |
567
|
|
|
|
|
|
|
|
568
|
|
|
|
|
|
|
Uses an C<Starlink::AST::FrameSet> object to determine the |
569
|
|
|
|
|
|
|
frequency. If such an object is not passed in, then the rest frequency |
570
|
|
|
|
|
|
|
is set to zero. |
571
|
|
|
|
|
|
|
|
572
|
|
|
|
|
|
|
Returns the rest frequency in Hz. |
573
|
|
|
|
|
|
|
|
574
|
|
|
|
|
|
|
=cut |
575
|
|
|
|
|
|
|
|
576
|
|
|
|
|
|
|
sub to_REST_FREQUENCY { |
577
|
1
|
|
|
1
|
1
|
3
|
my $self = shift; |
578
|
1
|
|
|
|
|
2
|
my $FITS_headers = shift; |
579
|
1
|
|
|
|
|
1
|
my $frameset = shift; |
580
|
|
|
|
|
|
|
|
581
|
1
|
|
|
|
|
2
|
my $return; |
582
|
|
|
|
|
|
|
|
583
|
1
|
50
|
33
|
|
|
6
|
if ( defined( $frameset ) && |
|
|
50
|
33
|
|
|
|
|
|
|
|
33
|
|
|
|
|
584
|
|
|
|
|
|
|
UNIVERSAL::isa( $frameset, "Starlink::AST::FrameSet" ) ) { |
585
|
|
|
|
|
|
|
# in some rare cases restfreq is not set in the frameset |
586
|
0
|
|
|
|
|
0
|
eval { |
587
|
0
|
|
|
|
|
0
|
my $frequency = $frameset->Get( "restfreq" ); |
588
|
0
|
|
|
|
|
0
|
$return = $frequency * 1_000_000_000; |
589
|
|
|
|
|
|
|
}; |
590
|
|
|
|
|
|
|
} elsif ( exists( $FITS_headers->{'RESTFREQ'} ) || |
591
|
|
|
|
|
|
|
( exists( $FITS_headers->{'SUBHEADERS'} ) && |
592
|
|
|
|
|
|
|
exists( $FITS_headers->{'SUBHEADERS'}->[0]->{'RESTFREQ'} ) ) ) { |
593
|
|
|
|
|
|
|
|
594
|
|
|
|
|
|
|
$return = exists( $FITS_headers->{'RESTFREQ'} ) ? |
595
|
|
|
|
|
|
|
$FITS_headers->{'RESTFREQ'} : |
596
|
0
|
0
|
|
|
|
0
|
$FITS_headers->{'SUBHEADERS'}->[0]->{'RESTFREQ'}; |
597
|
0
|
|
|
|
|
0
|
$return *= 1_000_000_000; |
598
|
|
|
|
|
|
|
} |
599
|
|
|
|
|
|
|
|
600
|
1
|
|
|
|
|
74
|
return $return; |
601
|
|
|
|
|
|
|
} |
602
|
|
|
|
|
|
|
|
603
|
|
|
|
|
|
|
=item B<to_SYSTEM_VELOCITY> |
604
|
|
|
|
|
|
|
|
605
|
|
|
|
|
|
|
Converts the DOPPLER and SPECSYS headers into one combined |
606
|
|
|
|
|
|
|
SYSTEM_VELOCITY header. The first three characters of each specific |
607
|
|
|
|
|
|
|
header are used and concatenated. For example, if DOPPLER is 'radio' |
608
|
|
|
|
|
|
|
and SPECSYS is 'LSR', then the resulting SYSTEM_VELOCITY generic |
609
|
|
|
|
|
|
|
header will be 'RADLSR'. The results are always returned in capital |
610
|
|
|
|
|
|
|
letters. |
611
|
|
|
|
|
|
|
|
612
|
|
|
|
|
|
|
=cut |
613
|
|
|
|
|
|
|
|
614
|
|
|
|
|
|
|
sub to_SYSTEM_VELOCITY { |
615
|
1
|
|
|
1
|
1
|
3
|
my $self = shift; |
616
|
1
|
|
|
|
|
3
|
my $FITS_headers = shift; |
617
|
1
|
|
|
|
|
2
|
my $frameset = shift; |
618
|
|
|
|
|
|
|
|
619
|
1
|
|
|
|
|
1
|
my $return; |
620
|
1
|
50
|
33
|
|
|
5
|
if ( exists( $FITS_headers->{'DOPPLER'} ) && defined $FITS_headers->{DOPPLER} ) { |
621
|
0
|
|
|
|
|
0
|
my $doppler = uc( $FITS_headers->{'DOPPLER'} ); |
622
|
|
|
|
|
|
|
|
623
|
0
|
0
|
0
|
|
|
0
|
if ( defined( $frameset ) && |
624
|
|
|
|
|
|
|
UNIVERSAL::isa( $frameset, "Starlink::AST::FrameSet" ) ) { |
625
|
|
|
|
|
|
|
# Sometimes we have frequency axis (rare) |
626
|
0
|
|
|
|
|
0
|
eval { |
627
|
0
|
|
|
|
|
0
|
my $sourcevrf = uc( $frameset->Get( "sourcevrf" ) ); |
628
|
0
|
|
|
|
|
0
|
$return = substr( $doppler, 0, 3 ) . substr( $sourcevrf, 0, 3 ); |
629
|
|
|
|
|
|
|
}; |
630
|
|
|
|
|
|
|
} |
631
|
0
|
0
|
|
|
|
0
|
if (!defined $return) { |
632
|
0
|
0
|
|
|
|
0
|
if ( exists( $FITS_headers->{'SPECSYS'} ) ) { |
633
|
0
|
|
|
|
|
0
|
my $specsys = uc( $FITS_headers->{'SPECSYS'} ); |
634
|
0
|
|
|
|
|
0
|
$return = substr( $doppler, 0, 3 ) . substr( $specsys, 0, 3 ); |
635
|
|
|
|
|
|
|
} else { |
636
|
0
|
|
|
|
|
0
|
my $specsys = ''; |
637
|
0
|
0
|
|
|
|
0
|
if ( $doppler eq 'RADIO' ) { |
|
|
0
|
|
|
|
|
|
638
|
0
|
|
|
|
|
0
|
$specsys = 'LSRK'; |
639
|
|
|
|
|
|
|
} elsif ( $doppler eq 'OPTICAL' ) { |
640
|
0
|
|
|
|
|
0
|
$specsys = 'HELIOCENTRIC'; |
641
|
|
|
|
|
|
|
} |
642
|
0
|
|
|
|
|
0
|
$return = substr( $doppler, 0, 3 ) . substr( $specsys, 0, 3 ); |
643
|
|
|
|
|
|
|
} |
644
|
|
|
|
|
|
|
} |
645
|
|
|
|
|
|
|
} |
646
|
1
|
|
|
|
|
84
|
return $return; |
647
|
|
|
|
|
|
|
} |
648
|
|
|
|
|
|
|
|
649
|
|
|
|
|
|
|
=item B<to_TRANSITION> |
650
|
|
|
|
|
|
|
|
651
|
|
|
|
|
|
|
Converts the TRANSITI header to the TRANSITION generic header. |
652
|
|
|
|
|
|
|
|
653
|
|
|
|
|
|
|
This would be a unit mapping except that we would like to tidy up |
654
|
|
|
|
|
|
|
some whitespace issues. |
655
|
|
|
|
|
|
|
|
656
|
|
|
|
|
|
|
=cut |
657
|
|
|
|
|
|
|
|
658
|
|
|
|
|
|
|
sub to_TRANSITION { |
659
|
1
|
|
|
1
|
1
|
4
|
my $self = shift; |
660
|
1
|
|
|
|
|
2
|
my $FITS_headers = shift; |
661
|
|
|
|
|
|
|
|
662
|
1
|
|
|
|
|
4
|
my $transition = $FITS_headers->{'TRANSITI'}; |
663
|
|
|
|
|
|
|
|
664
|
1
|
50
|
|
|
|
70
|
return undef unless defined $transition; |
665
|
|
|
|
|
|
|
|
666
|
|
|
|
|
|
|
# Remove leading and trailing spaces. |
667
|
1
|
|
|
|
|
6
|
$transition =~ s/^ *//; |
668
|
1
|
|
|
|
|
5
|
$transition =~ s/ *$//; |
669
|
|
|
|
|
|
|
# Remove duplicated spaces. |
670
|
1
|
|
|
|
|
4
|
$transition =~ s/ +/ /g; |
671
|
|
|
|
|
|
|
|
672
|
1
|
|
|
|
|
3
|
return $transition; |
673
|
|
|
|
|
|
|
} |
674
|
|
|
|
|
|
|
|
675
|
|
|
|
|
|
|
=item B<from_TRANSITION> |
676
|
|
|
|
|
|
|
|
677
|
|
|
|
|
|
|
Converts TRANSITION back to TRANSITI. |
678
|
|
|
|
|
|
|
|
679
|
|
|
|
|
|
|
=cut |
680
|
|
|
|
|
|
|
|
681
|
|
|
|
|
|
|
sub from_TRANSITION { |
682
|
1
|
|
|
1
|
1
|
2
|
my $self = shift; |
683
|
1
|
|
|
|
|
3
|
my $generic_headers = shift; |
684
|
|
|
|
|
|
|
|
685
|
1
|
|
|
|
|
3
|
my $transition = $generic_headers->{'TRANSITION'}; |
686
|
|
|
|
|
|
|
|
687
|
1
|
50
|
|
|
|
5
|
if (defined $transition) { |
688
|
|
|
|
|
|
|
# Restore whitespace issue to allow comparison of untranslated header. |
689
|
1
|
|
|
|
|
5
|
$transition =~ s/ - / - /; |
690
|
|
|
|
|
|
|
} |
691
|
|
|
|
|
|
|
|
692
|
1
|
|
|
|
|
15
|
return (TRANSITI => $transition); |
693
|
|
|
|
|
|
|
} |
694
|
|
|
|
|
|
|
|
695
|
|
|
|
|
|
|
=item B<to_VELOCITY> |
696
|
|
|
|
|
|
|
|
697
|
|
|
|
|
|
|
Converts the ZSOURCE header into an appropriate system velocity, |
698
|
|
|
|
|
|
|
depending on the value of the DOPPLER header. If the DOPPLER header is |
699
|
|
|
|
|
|
|
'redshift', then the VELOCITY generic header will be returned |
700
|
|
|
|
|
|
|
as a redshift. If the DOPPLER header is 'optical', then the |
701
|
|
|
|
|
|
|
VELOCITY generic header will be returned as an optical |
702
|
|
|
|
|
|
|
velocity. If the DOPPLER header is 'radio', then the VELOCITY |
703
|
|
|
|
|
|
|
generic header will be returned as a radio velocity. Note that |
704
|
|
|
|
|
|
|
calculating the radio velocity from the zeropoint (which is the |
705
|
|
|
|
|
|
|
ZSOURCE header) gives accurates results only if the radio velocity is |
706
|
|
|
|
|
|
|
a small fraction (~0.01) of the speed of light. |
707
|
|
|
|
|
|
|
|
708
|
|
|
|
|
|
|
=cut |
709
|
|
|
|
|
|
|
|
710
|
|
|
|
|
|
|
sub to_VELOCITY { |
711
|
1
|
|
|
1
|
1
|
2
|
my $self = shift; |
712
|
1
|
|
|
|
|
3
|
my $FITS_headers = shift; |
713
|
1
|
|
|
|
|
2
|
my $frameset = shift; |
714
|
|
|
|
|
|
|
|
715
|
1
|
|
|
|
|
2
|
my $velocity = 0; |
716
|
1
|
50
|
33
|
|
|
5
|
if ( defined( $frameset ) && |
717
|
|
|
|
|
|
|
UNIVERSAL::isa( $frameset, "Starlink::AST::FrameSet" ) ) { |
718
|
|
|
|
|
|
|
|
719
|
0
|
|
|
|
|
0
|
my $sourcesys = "VRAD"; |
720
|
0
|
0
|
|
|
|
0
|
if ( defined( $FITS_headers->{'DOPPLER'} ) ) { |
721
|
0
|
0
|
|
|
|
0
|
if ( $FITS_headers->{'DOPPLER'} =~ /rad/i ) { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
722
|
0
|
|
|
|
|
0
|
$sourcesys = "VRAD"; |
723
|
|
|
|
|
|
|
} elsif ( $FITS_headers->{'DOPPLER'} =~ /opt/i ) { |
724
|
0
|
|
|
|
|
0
|
$sourcesys = "VOPT"; |
725
|
|
|
|
|
|
|
} elsif ( $FITS_headers->{'DOPPLER'} =~ /red/i ) { |
726
|
0
|
|
|
|
|
0
|
$sourcesys = "REDSHIFT"; |
727
|
|
|
|
|
|
|
} |
728
|
|
|
|
|
|
|
} |
729
|
|
|
|
|
|
|
# Sometimes we do not have a spec frame (broken files) |
730
|
0
|
|
|
|
|
0
|
eval { |
731
|
0
|
|
|
|
|
0
|
$frameset->Set( sourcesys => $sourcesys ); |
732
|
0
|
|
|
|
|
0
|
$velocity = $frameset->Get( "sourcevel" ); |
733
|
|
|
|
|
|
|
}; |
734
|
|
|
|
|
|
|
} else { |
735
|
|
|
|
|
|
|
|
736
|
|
|
|
|
|
|
# We weren't passed a frameset, so try using other headers. |
737
|
1
|
50
|
33
|
|
|
3
|
if ( exists( $FITS_headers->{'DOPPLER'} ) && |
|
|
|
33
|
|
|
|
|
738
|
|
|
|
|
|
|
( exists( $FITS_headers->{'ZSOURCE'} ) || |
739
|
|
|
|
|
|
|
exists( $FITS_headers->{'SUBHEADERS'}->[0]->{'ZSOURCE'} ) ) ) { |
740
|
0
|
|
|
|
|
0
|
my $doppler = uc( $FITS_headers->{'DOPPLER'} ); |
741
|
|
|
|
|
|
|
my $zsource = exists( $FITS_headers->{'ZSOURCE'} ) ? |
742
|
|
|
|
|
|
|
$FITS_headers->{'ZSOURCE'} : |
743
|
0
|
0
|
|
|
|
0
|
$FITS_headers->{'SUBHEADERS'}->[0]->{'ZSOURCE'}; |
744
|
|
|
|
|
|
|
|
745
|
0
|
0
|
|
|
|
0
|
if ( $doppler eq 'REDSHIFT' ) { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
746
|
0
|
|
|
|
|
0
|
$velocity = $zsource; |
747
|
|
|
|
|
|
|
} elsif ( $doppler eq 'OPTICAL' ) { |
748
|
0
|
|
|
|
|
0
|
$velocity = $zsource * CLIGHT; |
749
|
|
|
|
|
|
|
} elsif ( $doppler eq 'RADIO' ) { |
750
|
0
|
|
|
|
|
0
|
$velocity = ( CLIGHT * $zsource ) / ( 1 + $zsource ); |
751
|
|
|
|
|
|
|
} |
752
|
|
|
|
|
|
|
} |
753
|
|
|
|
|
|
|
} |
754
|
|
|
|
|
|
|
|
755
|
1
|
|
|
|
|
82
|
return $velocity; |
756
|
|
|
|
|
|
|
} |
757
|
|
|
|
|
|
|
|
758
|
|
|
|
|
|
|
=item B<to_SUBSYSTEM_IDKEY> |
759
|
|
|
|
|
|
|
|
760
|
|
|
|
|
|
|
=cut |
761
|
|
|
|
|
|
|
|
762
|
|
|
|
|
|
|
sub to_SUBSYSTEM_IDKEY { |
763
|
1
|
|
|
1
|
1
|
4
|
my $self = shift; |
764
|
1
|
|
|
|
|
3
|
my $FITS_headers = shift; |
765
|
|
|
|
|
|
|
|
766
|
|
|
|
|
|
|
# Try the general headers first |
767
|
1
|
|
|
|
|
7
|
my $general = $self->SUPER::to_SUBSYSTEM_IDKEY( $FITS_headers ); |
768
|
1
|
50
|
|
|
|
7
|
return ( defined $general ? $general : "SUBSYSNR" ); |
769
|
|
|
|
|
|
|
} |
770
|
|
|
|
|
|
|
|
771
|
|
|
|
|
|
|
|
772
|
|
|
|
|
|
|
=item B<_is_FSW> |
773
|
|
|
|
|
|
|
|
774
|
|
|
|
|
|
|
Helper function to determine if we are doing frequency switch. |
775
|
|
|
|
|
|
|
|
776
|
|
|
|
|
|
|
=cut |
777
|
|
|
|
|
|
|
|
778
|
|
|
|
|
|
|
sub _is_FSW { |
779
|
1
|
|
|
1
|
|
3
|
my $class = shift; |
780
|
1
|
|
|
|
|
2
|
my $FITS_headers = shift; |
781
|
|
|
|
|
|
|
|
782
|
1
|
|
|
|
|
4
|
my $fsw = $FITS_headers->{SW_MODE}; |
783
|
|
|
|
|
|
|
|
784
|
1
|
50
|
33
|
|
|
67
|
if ( defined( $fsw ) && |
785
|
|
|
|
|
|
|
$fsw =~ /freqsw/i ) { |
786
|
0
|
|
|
|
|
0
|
return 1; |
787
|
|
|
|
|
|
|
} |
788
|
1
|
|
|
|
|
7
|
return 0; |
789
|
|
|
|
|
|
|
} |
790
|
|
|
|
|
|
|
|
791
|
|
|
|
|
|
|
=back |
792
|
|
|
|
|
|
|
|
793
|
|
|
|
|
|
|
=head1 SEE ALSO |
794
|
|
|
|
|
|
|
|
795
|
|
|
|
|
|
|
C<Astro::FITS::HdrTrans>, C<Astro::FITS::HdrTrans::Base> |
796
|
|
|
|
|
|
|
|
797
|
|
|
|
|
|
|
=head1 AUTHORS |
798
|
|
|
|
|
|
|
|
799
|
|
|
|
|
|
|
Tim Jenness E<lt>t.jenness@jach.hawaii.eduE<gt>, |
800
|
|
|
|
|
|
|
Brad Cavanagh E<lt>b.cavanagh@jach.hawaii.eduE<gt>. |
801
|
|
|
|
|
|
|
|
802
|
|
|
|
|
|
|
=head1 COPYRIGHT |
803
|
|
|
|
|
|
|
|
804
|
|
|
|
|
|
|
Copyright (C) 2016 East Asian Observatory. |
805
|
|
|
|
|
|
|
Copyright (C) 2007-2013, 2016 Science and Technology Facilities Council. |
806
|
|
|
|
|
|
|
Copyright (C) 2005-2007 Particle Physics and Astronomy Research Council. |
807
|
|
|
|
|
|
|
All Rights Reserved. |
808
|
|
|
|
|
|
|
|
809
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or modify it under |
810
|
|
|
|
|
|
|
the terms of the GNU General Public License as published by the Free Software |
811
|
|
|
|
|
|
|
Foundation; either version 2 of the License, or (at your option) any later |
812
|
|
|
|
|
|
|
version. |
813
|
|
|
|
|
|
|
|
814
|
|
|
|
|
|
|
This program is distributed in the hope that it will be useful,but WITHOUT ANY |
815
|
|
|
|
|
|
|
WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A |
816
|
|
|
|
|
|
|
PARTICULAR PURPOSE. See the GNU General Public License for more details. |
817
|
|
|
|
|
|
|
|
818
|
|
|
|
|
|
|
You should have received a copy of the GNU General Public License along with |
819
|
|
|
|
|
|
|
this program; if not, write to the Free Software Foundation, Inc., 59 Temple |
820
|
|
|
|
|
|
|
Place,Suite 330, Boston, MA 02111-1307, USA |
821
|
|
|
|
|
|
|
|
822
|
|
|
|
|
|
|
=cut |
823
|
|
|
|
|
|
|
|
824
|
|
|
|
|
|
|
1; |