File Coverage

blib/lib/Astro/Time.pm
Criterion Covered Total %
statement 302 431 70.0
branch 106 240 44.1
condition 21 63 33.3
subroutine 39 50 78.0
pod 38 43 88.3
total 506 827 61.1


line stmt bran cond sub pod time code
1             package Astro::Time;
2 1     1   387 use strict;
  1         2  
  1         36  
3              
4             =head1 NAME
5              
6             Astro::Time - Time based astronomical routines
7              
8             =head1 SYNOPSIS
9              
10             use Astro::Time;
11              
12             $dayno = cal2dayno($day, $month, $year);
13             print "It's a leap year!\n" if (leap($year));
14             $lmst = mjd2lst($mjd, $longitude, $dUT1);
15             $turns = str2turn($string, 'H');
16             $str = turn2str($turn, 'D', $sig);
17              
18             =head1 DESCRIPTION
19              
20             Astro::Time contains an assorted set Perl routines for time based
21             conversions, such as conversion between calendar dates and Modified
22             Julian day and conversion of UT to local sidereal time. Include are
23             routines for conversion between numerical and string representation of
24             angles.
25              
26             =head1 AUTHOR
27              
28             Chris Phillips Chris.Phillips@csiro.au
29              
30             =head1 FUNCTIONS
31              
32             =cut
33              
34              
35             BEGIN {
36 1     1   4 use Exporter ();
  1         1  
  1         18  
37 1         130 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK @EXPORT_FAIL
38 1     1   3 $PI $StrSep $StrZero $Quiet );
  1         8  
39 1     1   812 $VERSION = '1.21';
40 1         8 @ISA = qw(Exporter);
41              
42 1         4 @EXPORT = qw( cal2dayno dayno2cal leap yesterday tomorrow
43             mjd2cal cal2mjd mjd2dayno dayno2mjd now2mjd mjd2epoch
44             jd2mjd mjd2jd mjd2time mjd2weekday mjd2weekdaystr
45             gst mjd2lst cal2lst dayno2lst rise lst2mjd
46             turn2str deg2str rad2str str2turn str2deg str2rad
47             hms2time time2hms month2str str2month
48             deg2rad rad2deg turn2rad rad2turn turn2deg deg2turn
49             $PI );
50 1         2 @EXPORT_OK = qw ( daynoOK monthOK dayOK utOK nint $StrSep $StrZero
51             $Quiet);
52 1         2476 @EXPORT_FAIL = qw ( @days @MonthShortStr @MonthStr @WeekShortStr @WeekStr);
53              
54 1     1   5 use Carp;
  1         1  
  1         64  
55 1     1   497 use POSIX qw( fmod floor ceil acos );
  1         4782  
  1         3  
56             }
57              
58             $PI = 3.1415926535897932384626433832795028841971693993751;
59              
60             $StrZero = 0;
61             $StrSep = ':';
62              
63             my $debug = 0; # Used for debugging str2turn
64              
65             $Quiet = 0;
66              
67             my @days = (31,28,31,30,31,30,31,31,30,31,30,31);
68              
69             my @MonthShortStr = ('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', 'Jul', 'Aug',
70             'Sep', 'Oct', 'Nov', 'Dec');
71             my @MonthStr = ('January', 'February', 'March', 'April', 'May', 'June', 'July',
72             'August', 'September','October', 'November', 'December');
73              
74             my @WeekShortStr = ('Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat', 'Sun');
75             my @WeekStr = ('Monday', 'Tuesday', 'Wednesday', 'Thursday', 'Friday',
76             'Saturday', 'Sunday');
77              
78             # Is the dayno valid?
79             sub daynoOK ($$) {
80 9     9 0 10 my ($dayno, $year) = @_;
81              
82 9 50 33     41 if ($dayno<1 || $dayno>366 || ($dayno>365 && !leap($year))) {
      33        
      33        
83 0 0       0 carp '$dayno out of range' if (!$Quiet);
84 0         0 return 0;
85             } else {
86 9         17 return 1;
87             }
88             }
89              
90             # Is the month valid?
91             sub monthOK ($) {
92 11     11 0 10 my $month = shift;
93              
94 11 50 33     33 if ($month > 12 || $month < 1) {
95 0 0       0 carp '$month out of range' if (!$Quiet);
96 0         0 return 0;
97             } else {
98 11         23 return 1
99             }
100             }
101              
102             # IS the day of month OK? (assumes month IS ok - should be checked first)
103             sub dayOK ($$$) {
104 10     10 0 8 my ($day, $month, $year) = @_;
105              
106 10         11 $month--; # For array indexing
107 10 50       13 if (leap($year)) {
108 0         0 $days[1] = 29;
109             } else {
110 10         11 $days[1] = 28;
111             }
112              
113 10 50 33     29 if ($day < 1 || $day > $days[$month]) {
114 0 0       0 carp '$day out of range' if (!$Quiet);
115 0         0 return 0;
116             } else {
117 10         18 return 1;
118             }
119             }
120              
121             # Is the day fraction OK?
122             sub utOK ($) {
123 9     9 0 7 my $ut = shift;
124              
125 9 50 33     31 if ($ut < 0.0 || $ut >= 1.0) {
126 0 0       0 carp '$ut out of range' if (!$Quiet);
127 0         0 return 0;
128             } else {
129 9         15 return 1;
130             }
131             }
132              
133             # Return the nearest integer (ie round)
134             sub nint ($) {
135 2     2 0 3 my ($x) = @_;
136 2 50       8 ($x<0.0) ? return(ceil($x-0.5)) : return(floor($x+0.5))
137             }
138              
139             =over 4
140              
141             =item B
142              
143             $str = turn2str($turn, $mode, $sig);
144             $str = turn2str($turn, $mode, $sig, $strsep);
145              
146             Convert fraction of a turn into string representation
147             $turn Angle in turns
148             $mode Mode of string to convert to:
149             'H' for hours
150             'D' for degrees
151             $sig number of significant figures
152             $strsep String separator (override for default $Astro::Time::StrSep)
153             Note:
154             The behavior can be modified by the following two variables:
155             $Astro::Time::StrZero Minimum number of leading digits (zero padded
156             if needed)
157             $Astro::Time::StrSep (Overridden by optional fourth argument)
158             Deliminator used in string (Default ':')
159             This may also equal one of a number of special values:
160             'HMS' 12H45M12.3S or 170D34M56.2S
161             'hms' 12h45m12.3s or 170d34m56.2s
162             'deg' 170d34'56.2"
163              
164             =cut
165              
166             sub turn2str ($$$;$) {
167 67     67 1 194 my($turn, $mode, $sig, $strsep) = @_;
168 67         55 $mode = uc $mode;
169 67 50 66     171 if (($mode ne 'H') && ($mode ne 'D')) {
170 0         0 carp 'turn2str: $mode must equal \'H\' or \'D\'';
171 0         0 return undef;
172             }
173 67 100       90 $strsep = $StrSep if (!defined $strsep);
174              
175 67         52 my ($angle, $str, $sign, $wholesec, $secfract, $min);
176              
177 67 100       73 if ($mode eq 'H') {
178 27         27 $angle = $turn * 24;
179             } else {
180 40         37 $angle = $turn * 360;
181             }
182              
183 67 100       77 if ($angle < 0.0) {
184 4         4 $sign = -1;
185 4         5 $angle = -$angle;
186             } else {
187 63         48 $sign = 1;
188             }
189              
190 67         54 my $wholeangle = (int $angle);
191              
192 67         48 $angle -= $wholeangle;
193 67         54 $angle *= 3600;
194              
195             # Get second fraction
196 67         70 $wholesec = int $angle;
197 67         43 $secfract = $angle - $wholesec;
198              
199 67         51 $wholesec %= 60;
200 67         61 $min = ($angle-$wholesec - $secfract)/60.0;
201 67         60 $secfract = int ($secfract * 10**$sig + 0.5); # Add 0.5 to ensure rounding
202              
203             # Check we have not rounded too far
204 67 100       90 if ($secfract >= 10**$sig) {
205 38         27 $secfract -= 10**$sig;
206 38         29 $wholesec++;
207 38 100       46 if ($wholesec >= 60.0) {
208 1         1 $wholesec -= 60;
209 1         2 $min++;
210 1 50       2 if ($min >= 60.0) {
211 0         0 $min -= 60;
212 0         0 $wholeangle++;
213             }
214             }
215             }
216              
217 67         51 my $angleform;
218 67 50       73 if ($StrZero > 0) {
219 0         0 $angleform = "%0$StrZero";
220             } else {
221 67         56 $angleform = '%';
222             }
223              
224 67         43 my ($sep1, $sep2, $sep3);
225 67 50       122 if ($strsep eq 'HMS') {
    100          
    100          
226 0 0       0 if ($mode eq 'H') {
227 0         0 $sep1 = 'H';
228             } else {
229 0         0 $sep1 = 'D';
230             }
231 0         0 $sep2 = 'M';
232 0         0 $sep3 = 'S';
233             } elsif ($strsep eq 'hms') {
234 9 50       12 if ($mode eq 'H') {
235 9         9 $sep1 = 'h';
236             } else {
237 0         0 $sep1 = 'd';
238             }
239 9         5 $sep2 = 'm';
240 9         36 $sep3 = 's';
241             } elsif ($strsep eq 'deg') { # What if $mode eq 'H'??
242 3         3 $sep1 = 'd';
243 3         2 $sep2 = "'";
244 3         3 $sep3 = '"';
245             } else {
246 55         39 $sep1 = $sep2 = $strsep;
247 55         39 $sep3 = '';
248             }
249              
250 67 100       74 if ($sig > 0) {
251 9         29 $str = sprintf("${angleform}d$sep1%02d".
252             "$sep2%02d.%0${sig}d$sep3",
253             $wholeangle, $min, $wholesec, $secfract);
254             } else {
255 58         139 $str = sprintf("${angleform}d$sep1%02d".
256             "$sep2%02d$sep3",
257             $wholeangle, $min, $wholesec);
258             }
259              
260 67 100       87 if ($sign == -1) {
261 4         5 $str = '-'.$str;
262             }
263 67         219 return $str;
264             }
265              
266             =item B
267              
268             $str=deg2str($deg, $mode, $sig);
269              
270             Convert degrees into string representation
271             $deg angle in degrees
272             $mode mode of string to convert to:
273             'H' for hours
274             'D' for degrees
275             $sig number of significant figures
276             See note for turn2str
277              
278             =cut
279              
280             sub deg2str ($$$;$) {
281              
282 0     0 1 0 my($deg, $mode, $sig, $strsep) = @_;
283 0         0 return turn2str($deg/(360), $mode, $sig, $strsep);
284             }
285              
286             =item B
287              
288             $str=rad2str($rad, $mode, $sig);
289              
290             Convert radians into string representation
291             $rad angle in radians
292             $mode mode of string to convert to:
293             'H' for hours
294             'D' for degrees
295             $sig is number of significant figures
296             See note for turn2str
297              
298             =cut
299              
300             sub rad2str ($$$;$) {
301              
302 0     0 1 0 my($rad, $mode, $sig, $strsep) = @_;
303 0         0 return turn2str($rad/(2*$PI), $mode, $sig, $strsep);
304             }
305              
306             =item B
307              
308             $turns = str2turn($string,$mode);
309              
310             Convert angle from string representation into fraction of a turn
311             $string a : or space delimited angle
312             $mode type of angle
313             'H' if $string is in hours,min,sec
314             'D' if $string is in deg,arcmin,arcsec
315             The format of $string can be fairly flexible e.g.:
316             12.2
317             12:34
318             12:34:45.1
319             -23 34 12.3
320             -34 34.3
321              
322             Note: You cannot mix spaces and :
323              
324             =cut
325              
326             sub str2turn ($$) {
327 4     4 1 41 my($str,$mode) = @_;
328              
329 4 50       8 if (! defined $str) {
330 0         0 carp 'Use of uninitialized value at';
331 0         0 return undef;
332             }
333 4         6 $mode = uc $mode;
334 4 50 66     13 if (($mode ne "H") && ($mode ne "D")) {
335 0         0 carp 'str2turn: $mode must equal "H" or "D"';
336 0         0 return undef;
337             }
338              
339 4         4 my $sign = 1.0;
340 4         4 my $angle = 0.0;
341 4         4 my $min = 0.0;
342 4         3 my $sec = 0.0;
343              
344             # Does it match dd:dd:dd.d form
345 4 100       36 if ($str =~ /^\s*(?:([+-])\s*)? # Sign (optional)
    100          
    100          
    50          
    0          
346             (\d*): # Hours degrees
347             (\d{0,2})(?:: # Minutes
348             (\d{0,2}(?:\.\d*)?))? # Seconds and fractions (both optional)
349             /x) {
350 1 50       3 print STDERR "Matches dd:dd:dd.d\n" if $debug;
351 1 50 33     4 $sign = -1 if (defined($1) && $1 eq "-");
352 1 50       6 $angle = $2 if ($2);
353 1 50       3 $min = $3 if ($3);
354 1 50       4 $sec = $4 if ($4);
355              
356             # Does it match hms form 12h33m34.6s
357             } elsif ($str =~ /^\s*(?:([+-])\s*)? # Sign (optional)
358             (\d+)\s*(h)\s* # Hours
359             (?:(\d{0,2})\s*m\s* # Minutes optional
360             (?:(\d{0,2} # Seconds and fractions (optional)
361             (?:\.\d*)?)\s*s)?)?
362              
363             /x) {
364 1 50       3 print STDERR "Matches hms\n" if $debug;
365 1 50 33     5 $sign = -1 if (defined($1) && $1 eq "-");
366 1 50       8 $angle = $2 if ($2);
367 1         4 $mode = 'H';
368 1 50       3 $min = $4 if ($4);
369 1 50       6 $sec = $5 if ($5);
370              
371             # Does it match dms form 12d33m34.6s or 12d33'34.6"
372             } elsif ($str =~ /^\s*(?:([+-])\s*)? # Sign (optional)
373             (\d+)\s*([d])\s* # Degrees
374             (?:(\d{0,2})\s*[m']\s* # Minutes optional
375             (?:(\d{0,2} # Seconds and fractions (optional)
376             (?:\.\d*)?)\s*[s"])?)?
377             /x) {
378 1 50       3 print STDERR "Matches dms\n" if $debug;
379 1 50 33     3 $sign = -1 if (defined($1) && $1 eq "-");
380 1 50       3 $angle = $2 if ($2);
381             #$mode = uc($3);
382 1         1 $mode = 'D';
383 1 50       3 $min = $4 if ($4);
384 1 50       2 $sec = $5 if ($5);
385              
386             # Does is match dd dd dd.d form
387             } elsif ($str =~ /^\s*(?:([+-])\s*)? # Sign (optional)
388             (\d+)\s+ # Hours degrees
389             (\d{0,2})(?:\s+ # Minutes
390             (\d{0,2}(?:\.\d*)?))? # Seconds and fractions
391             /x) {
392 1 50       2 print STDERR "Matches dd dd dd.d\n" if $debug;
393 1 50 33     8 $sign = -1 if (defined($1) && $1 eq "-");
394 1 50       3 $angle = $2 if ($2);
395 1 50       2 $min = $3 if ($3);
396 1 50       3 $sec = $4 if ($4);
397              
398             # Does it match dd.d form
399             } elsif ($str =~ /^\s*(?:([+-])\s*)?(\d+(?:\.\d*)?)/) {
400 0 0       0 print STDERR "Matches dd.d\n" if $debug;
401 0 0 0     0 $sign = -1 if (defined($1) && $1 eq "-");
402 0 0       0 $angle = $2 if ($2);
403             } else {
404 0         0 return undef;
405             }
406              
407 4         5 my $factor;
408 4 100       7 if ($mode eq "H") {
409 2         3 $factor = 24.0;
410             } else {
411 2         1 $factor = 360.0;
412             }
413              
414 4 50       8 print "Got ($sign) $angle/$min/$sec [$mode]\n" if $debug;
415              
416 4         18 return $sign * (($angle + ($min + $sec/60.0)/60.0)/ $factor);
417             }
418              
419             =item B
420              
421             $degrees=str2deg($string,$mode);
422              
423             Convert angle from string representation into degrees
424             $string a : or space delimited angle
425             $mode 'H' if $string is in hours,min,sec
426             'D' if $string is in deg,arcmin,arcsec
427             See note for str2turn
428              
429             =cut
430              
431             sub str2deg ($$) {
432 0     0 1 0 my($str, $mode) = @_;
433 0         0 return str2turn($str, $mode) * 360;
434             }
435              
436             =item B
437              
438             $radians=str2rad($string,$mode);
439              
440             Convert angle from string representation into radians
441             $string a : or space delimited angle
442             $mode 'H' if $string is in hours,min,sec
443             'D' if $string is in deg,arcmin,arcsec
444             See note for str2turn
445              
446             =cut
447              
448             sub str2rad ($$) {
449 0     0 1 0 my($str, $mode) = @_;
450 0         0 return str2turn($str, $mode) * 2*$PI;
451             }
452              
453             =item B
454              
455             ($time) = hms2time($hour, $minute, $second);
456             ($time) = hms2time($hour, $minute, $second, $mode);
457              
458             Returns the day fraction given hours minutes and seconds (or degrees)
459             $time Day fraction
460             $hour Hours
461             $minutes Minutes
462             $second Seconds
463             $mode 'H' or 'D' to interpret as hours or degrees (default
464             hours)
465              
466             =cut
467              
468             sub hms2time ($$$;$) {
469              
470 1     1 1 10 my($hour, $minute, $second, $mode) = @_;
471 1 50       4 $mode = 'H' if (!defined $mode);
472              
473 1         1 my $factor;
474 1 50 33     4 if ($mode eq 'H' || $mode eq 'h') {
    0 0        
475 1         1 $factor = 24.0;
476             } elsif ($mode eq 'D' || $mode eq 'd') {
477 0         0 $factor = 360.0;
478             } else {
479 0         0 carp 'Illegal $mode value';
480 0         0 return undef;
481             }
482              
483 1         4 return (($second/60 + $minute)/60 + $hour)/$factor;
484             }
485              
486             =item B
487              
488             ($sign, $hour, $minute, $second) = time2hms($time, $mode, $sig);
489              
490             Returns hours (or degrees), minutes and seconds given the day fraction
491             $sign Sign of angle ('+' or '-')
492             $hour Hours
493             $minutes Minutes
494             $second Seconds
495             $time Day fraction
496             $mode Return degrees or Hours?
497             'H' for hours
498             'D' for degrees
499             $sig Number of significant digits for $second
500              
501             =cut
502              
503             sub time2hms ($$$) {
504              
505 0     0 1 0 my($turn, $mode, $sig) = @_;
506 0         0 $mode = uc $mode;
507 0 0 0     0 if (($mode ne 'H') && ($mode ne 'D')) {
508 0         0 carp 'time2hms: $mode must equal \'H\' or \'D\'';
509 0         0 return undef;
510             }
511              
512 0         0 my ($angle, $str, $sign, $wholesec, $secfract, $min);
513              
514 0 0       0 if ($mode eq 'H') {
515 0         0 $angle = $turn * 24;
516             } else {
517 0         0 $angle = $turn * 360;
518             }
519              
520 0 0       0 if ($angle < 0.0) {
521 0         0 $sign = '-';
522 0         0 $angle = -$angle;
523             } else {
524 0         0 $sign = '+';
525             }
526              
527 0         0 my $wholeangle = (int $angle);
528              
529 0         0 $angle -= $wholeangle;
530 0         0 $angle *= 3600;
531              
532             # Get second fraction
533 0         0 $wholesec = int $angle;
534 0         0 $secfract = $angle - $wholesec;
535              
536 0         0 $wholesec %= 60;
537 0         0 $min = ($angle-$wholesec - $secfract)/60.0;
538 0         0 $secfract = int ($secfract * 10**$sig + 0.5); # Add 0.5 to ensure rounding
539              
540             # Check we have not rounded too far
541 0 0       0 if ($secfract >= 10**$sig) {
542 0         0 $secfract -= 10**$sig;
543 0         0 $wholesec++;
544 0 0       0 if ($wholesec >= 60.0) {
545 0         0 $wholesec -= 60;
546 0         0 $min++;
547 0 0       0 if ($min >= 60.0) {
548 0         0 $min -= 60;
549 0         0 $wholeangle++;
550             }
551             }
552             }
553 0         0 my $format = sprintf '%%0%dd', $sig;
554 0         0 $secfract = sprintf($format, $secfract);
555              
556 0 0       0 if ($sig > 0) {
557 0         0 return($sign, $wholeangle, $min, "$wholesec.$secfract");
558             } else {
559 0         0 return($sign, $wholeangle, $min, $wholesec);
560             }
561             }
562              
563             =item B
564              
565             $rad=deg2rad($deg);
566             Convert degrees to radians
567              
568             =cut
569              
570             sub deg2rad ($) {
571 0     0 1 0 return $_[0] / 180*$PI;
572             }
573              
574             =item B
575              
576             $deg=rad2deg($rad);
577             Convert radians to degrees
578              
579             =cut
580              
581             sub rad2deg ($) {
582 1     1 1 7 return $_[0] * 180/$PI;
583             }
584              
585             =item B
586              
587             $rad=turn2rad($turn);
588             Convert turns to radians
589              
590             =cut
591              
592             #sub turn2rad ($) {
593             # return $_[0] * 2*$PI;
594             #}
595              
596             sub turn2rad {
597 63     63 1 39 my @ret;
598 63         62 foreach (@_) {
599 63         86 push @ret, $_ * 2*$PI;
600             }
601 63 50       77 if (@ret==1) {
    0          
602 63         106 return $ret[0];
603             } elsif (@ret==0) {
604 0         0 return undef;
605             } else {
606 0         0 return @ret;
607             }
608             }
609              
610             =item B
611              
612             $turn=rad2turn($rad);
613             Convert radians to turns
614              
615             =cut
616              
617             #sub rad2turn ($) {
618             # return $_[0] / (2*$PI);
619             #}
620              
621             sub rad2turn {
622 2     2 1 3 my @ret;
623 2         3 foreach (@_) {
624 2         5 push @ret, $_/(2*$PI);
625             }
626 2 50       4 if (@ret==1) {
    0          
627 2         5 return $ret[0];
628             } elsif (@ret==0) {
629 0         0 return undef;
630             } else {
631 0         0 return @ret;
632             }
633             }
634              
635             =item B
636              
637             $deg=turn2deg($turn);
638             Convert turns to radians
639              
640             =cut
641              
642             #sub turn2deg ($) {
643             # return $_[0] * 360.0;
644             #}
645              
646             sub turn2deg {
647 0     0 1 0 my @ret;
648 0         0 foreach (@_) {
649 0         0 push @ret, $_*360.0;
650             }
651 0 0       0 if (@ret==1) {
    0          
652 0         0 return $ret[0];
653             } elsif (@ret==0) {
654 0         0 return undef;
655             } else {
656 0         0 return @ret;
657             }
658             }
659              
660             =item B
661              
662             $turn=deg2turn($deg);
663             Convert degrees to turns
664              
665             =cut
666              
667             #sub deg2turn ($) {
668             # return $_[0] / 360.0;
669             #}
670              
671             sub deg2turn {
672 4     4 1 25 my @ret;
673 4         7 foreach (@_) {
674 4         9 push @ret, $_/360.0;
675             }
676 4 50       8 if (@ret==1) {
    0          
677 4         10 return $ret[0];
678             } elsif (@ret==0) {
679 0         0 return undef;
680             } else {
681 0         0 return @ret;
682             }
683             }
684              
685             =item B
686              
687             $dayno = cal2dayno($day, $month, $year);
688              
689             Returns the day number corresponding to $day of $month in $year.
690              
691             =cut
692              
693             # VERIFYED
694             sub cal2dayno ($$$) {
695              
696 3     3 1 13 my ($day, $month, $year) = @_;
697 3 50       5 return undef if (!monthOK($month));
698 3 50       7 return undef if (!dayOK($day, $month, $year));
699              
700 3         6 $month--; # For array indexing
701              
702 3 50       4 if (leap($year)) {
703 0         0 $days[1] = 29;
704             } else {
705 3         4 $days[1] = 28;
706             }
707              
708 3         3 my $mon;
709 3         3 my $dayno = $day;
710 3         6 for ($mon=0; $mon<$month; $mon++) {
711 29         39 $dayno += $days[$mon];
712             }
713              
714 3         6 return($dayno);
715             }
716              
717             =item B
718              
719             ($day, $month) = dayno2cal($dayno, $year);
720              
721             Return the $day and $month corresponding to $dayno of $year.
722              
723             =cut
724              
725             # Verified
726             sub dayno2cal ($$) {
727              
728 5     5 1 13 my($dayno, $year) = @_;
729 5 50       8 return undef if (!daynoOK($dayno, $year));
730              
731 5 50       8 if (leap($year)) {
732 0         0 $days[1] = 29;
733             } else {
734 5         5 $days[1] = 28;
735             }
736              
737 5         5 my $month = 0;
738 5         4 my $end = $days[$month];
739 5         11 while ($dayno>$end) {
740 47         29 $month++;
741 47         64 $end+= $days[$month];
742             }
743 5         8 $end -= $days[$month];
744 5         6 my $day = $dayno - $end;
745 5         4 $month++;
746              
747 5         8 return($day, $month);
748             }
749              
750             =item B
751              
752             $isleapyear = leap($year);
753              
754             Returns true if $year is a leap year.
755             $year year in full
756              
757             =cut
758              
759             # NOT Verified
760             sub leap ($) {
761 23     23 1 34 my $year = shift;
762 23   100     95 return (((!($year%4))&&($year%100))||(!($year%400)));
763             }
764              
765             =item B
766              
767             ($dayno, $year) = yesterday($dayno, $year);
768             ($day, $month, $year) = yesterday($day, $month, $year);
769              
770             Winds back the day number by one, taking account of year wraps.
771             $dayno Day number of year
772             $year Year
773             $month Month
774             $day Day of month
775              
776             =cut
777              
778             # Verified
779             sub yesterday($$;$) {
780              
781 1     1 1 10 my ($day, $month, $dayno, $year);
782            
783 1 50       3 if (scalar(@_)==2) {
784 0         0 ($dayno, $year) = @_;
785 0 0       0 return undef if (!daynoOK($dayno, $year));
786             } else {
787 1         2 ($day, $month, $year) = @_;
788 1 50       2 return undef if (!monthOK($month));
789 1 50       3 return undef if (!dayOK($day, $month, $year));
790 1         2 $dayno = cal2dayno($day, $month, $year);
791             }
792              
793 1         1 $dayno--;
794 1 50       3 if ($dayno==0) {
795 0         0 $year--;
796 0 0       0 if (leap($year)) {
797 0         0 $dayno = 366;
798             } else {
799 0         0 $dayno = 365;
800             }
801             }
802              
803 1 50       3 if (scalar(@_)==2) {
804 0         0 return ($dayno, $year);
805             } else {
806 1         2 ($day, $month) = dayno2cal($dayno, $year);
807 1         3 return($day, $month, $year);
808             }
809             }
810              
811             =item B
812              
813             ($dayno, $year) = tomorrow($dayno, $year);
814             ($day, $month, $year) = tomorrow($day, $month, $year);
815              
816             Advances the day number by one, taking account of year wraps.
817             $dayno Day number of year
818             $year Year
819             $month Month
820             $day Day of month
821              
822             =cut
823              
824             # Verified
825             sub tomorrow($$;$) {
826              
827 1     1 1 8 my ($day, $month, $dayno, $year);
828              
829 1 50       3 if (scalar(@_)==2) {
830 1         1 ($dayno, $year) = @_;
831 1 50       2 return undef if (!daynoOK($dayno, $year));
832             } else {
833 0         0 ($day, $month, $year) = @_;
834 0 0       0 return undef if (!monthOK($month));
835 0 0       0 return undef if (!dayOK($day, $month, $year));
836 0         0 $dayno = cal2dayno($day, $month, $year);
837             }
838              
839 1         2 $dayno++;
840 1 50 33     9 if (($dayno==366 && !leap($year)) || $dayno==367) {
      33        
841 0         0 $year++;
842 0         0 $dayno = 1;
843             }
844              
845 1 50       3 if (scalar(@_)==2) {
846 1         2 return ($dayno, $year);
847             } else {
848 0         0 ($day, $month) = dayno2cal($dayno, $year);
849 0         0 return($day, $month, $year);
850             }
851             }
852              
853             =item B
854              
855             ($day, $month, $year, $ut) = mjd2cal($mjd);
856              
857             Converts a modified Julian day number into calendar date (universal
858             time). (based on the slalib routine sla_djcl).
859             $mjd Modified Julian day (JD-2400000.5)
860             $day Day of the month.
861             $month Month of the year.
862             $year Year
863             $ut UT day fraction
864              
865             =cut
866              
867             # VERIFIED
868             sub mjd2cal($) {
869              
870 2     2 1 13 my $mjd = shift;
871              
872 2         11 my $ut = fmod($mjd,1.0);
873 2 50       4 if ($ut<0.0) {
874 0         0 $ut += 1.0;
875 0         0 $mjd -= 1;
876             }
877              
878 1     1   501 use integer; # Calculations require integer division and modulation
  1         8  
  1         3  
879             # Get the integral Julian Day number
880 2         5 my $jd = nint($mjd + 2400001);
881              
882             # Do some rather cryptic calculations
883              
884 2         6 my $temp1 = 4*($jd+((6*(((4*$jd-17918)/146097)))/4+1)/2-37);
885 2         8 my $temp2 = 10*((($temp1-237)%1461)/4)+5;
886              
887 2         3 my $year = $temp1/1461-4712;
888 2         1 my $month =(($temp2/306+2)%12)+1;
889 2         3 my $day = ($temp2%306)/10+1;
890              
891 2         6 return($day, $month, $year, $ut);
892             }
893              
894             =item B
895              
896             $mjd = cal2mjd($day, $month, $year, $ut);
897              
898             Converts a calendar date (universal time) into modified Julian day
899             number.
900             $day Day of the month.
901             $month Month of the year.
902             $year Year
903             $ut UT dayfraction
904             $mjd Modified Julian day (JD-2400000.5)
905              
906             =cut
907              
908             # Verified
909             sub cal2mjd($$$;$) {
910 6     6 1 9 my($day, $month, $year, $ut) = @_;
911 6 50       15 $ut = 0.0 if (!defined $ut);
912              
913 6 50       8 return undef if (!monthOK($month));
914 6 50       9 return undef if (!dayOK($day, $month, $year));
915 6 50       9 return undef if (!utOK($ut));
916              
917 6         4 my ($m, $y);
918 6 50       10 if ($month <= 2) {
919 0         0 $m = int($month+9);
920 0         0 $y = int($year-1);
921             } else {
922 6         4 $m = int($month-3);
923 6         13 $y = int($year);
924             }
925 6         8 my $c = int($y/100);
926 6         6 $y = $y-$c*100;
927 6         8 my $x1 = int(146097.0*$c/4.0);
928 6         6 my $x2 = int(1461.0*$y/4.0);
929 6         7 my $x3 = int((153.0*$m+2.0)/5.0);
930 6         12 return($x1+$x2+$x3+$day-678882+$ut);
931             }
932              
933             =item B
934              
935             ($dayno, $year, $ut) = mjd2dayno($mjd);
936              
937             Converts a modified Julian day number into year and dayno (universal
938             time).
939             $mjd Modified Julian day (JD-2400000.5)
940             $year Year
941             $dayno Dayno of year
942              
943             =cut
944              
945             # NOT Verified
946             sub mjd2dayno($) {
947              
948 1     1 1 5 my $mjd = shift;
949 1         2 my ($day, $month, $year, $ut) = mjd2cal($mjd);
950              
951 1         3 return (cal2dayno($day,$month,$year), $year, $ut);
952             }
953              
954             =item B
955              
956             $mjd = dayno2mjd($dayno, $year, $ut);
957              
958             Converts a dayno and year to modified Julian day
959             $mjd Modified Julian day (JD-2400000.5)
960             $year Year
961             $dayno Dayno of year
962              
963             =cut
964              
965             # Not verified - wrapper to cal2mjd
966             sub dayno2mjd($$;$) {
967              
968 3     3 1 6 my ($dayno, $year, $ut) = @_;
969 3 50       11 $ut = 0.0 if (!defined $ut);
970              
971 3 50       7 return undef if (!daynoOK($dayno,$year));
972 3 50       6 return undef if (!utOK($ut));
973              
974 3         4 my ($day, $month) = dayno2cal($dayno, $year);
975              
976 3         4 return cal2mjd($day, $month, $year, $ut);
977             }
978              
979             =item B
980              
981             $mjd = now2mjd()
982              
983             =cut
984              
985             # Not verified - just wrapper
986             sub now2mjd() {
987 1     1 1 16 my ($s, $m, $h, $day, $month, $year) = gmtime();
988 1         2 $month++;
989 1         1 $year += 1900;
990 1         5 return(cal2mjd($day, $month, $year, ((($s/60+$m)/60+$h)/24)));
991             }
992              
993             =item B
994              
995             $mjd = jd2mjd($jd);
996              
997             Converts a Julian day to Modified Julian day
998             $jd Julian day
999             $mjd Modified Julian day
1000              
1001             =cut
1002              
1003             sub jd2mjd($) {
1004 0     0 1 0 return (shift)-2400000.5;
1005             }
1006              
1007             =item B
1008              
1009             $jd = mjd2jd($mjd);
1010              
1011             Converts a Modified Julian day to Julian day
1012             $mjd Modified Julian day
1013             $jd Julian day
1014              
1015             =cut
1016              
1017             sub mjd2jd($) {
1018 0     0 1 0 return (shift)+2400000.5;
1019             }
1020              
1021             =item B
1022              
1023             $str = mjd2time($mjd);
1024             $str = mjd2time($mjd, $np);
1025              
1026             Converts a Modified Julian day to a formatted string
1027             $mjd Modified Julian day
1028             $str Formatted time
1029             $np Number of significant digits for fraction of a sec. Default 0
1030              
1031             =cut
1032              
1033             sub mjd2time($;$) {
1034 0     0 1 0 my ($dayno, $year, $ut) = mjd2dayno(shift);
1035 0         0 my $np = shift;
1036 0 0       0 $np = 0 if (! defined $np);
1037 0         0 return sprintf("$year %03d/%s", $dayno, turn2str($ut, 'H', $np));
1038             }
1039              
1040             =item B
1041              
1042             $time = mjd2epoch($mjd);
1043              
1044             Converts a Modified Julian day to unix Epoch (seconds sinve 1 Jan 1970)
1045             Rounded to the nearest second
1046             $mjd Modified Julian day
1047             $tie Seconds since 1 Jan 1970
1048              
1049             =cut
1050              
1051             sub mjd2epoch($) {
1052 1     1 1 6 my $mjd = shift;
1053 1         3 my $epoch = ($mjd - 40587)*24*60*60;
1054 1         3 return int($epoch + $epoch/abs($epoch*2)); # Work even if epoch is negative
1055             }
1056              
1057             =item B
1058              
1059             $gst = gst($mjd);
1060             $gmst = gst($mjd, $dUT1);
1061             $gtst = gst($mjd, $dUT1, $eqenx);
1062              
1063             Converts a modified Julian day number to Greenwich sidereal time
1064             $mjd modified Julian day (JD-2400000.5)
1065             $dUT1 difference between UTC and UT1 (UT1 = UTC + dUT1) (seconds)
1066             $eqenx Equation of the equinoxes (not yet supported)
1067             $gst Greenwich sidereal time (turns)
1068             $gmst Greenwich mean sidereal time (turns)
1069             $gtst Greenwich true sidereal time (turns)
1070              
1071             =cut
1072              
1073             # Verified
1074             sub gst($;$$) {
1075 6     6 1 12 my ($mjd, $dUT1, $eqenx) = @_;
1076 6 100       12 $dUT1 = 0.0 if (! defined $dUT1);
1077 6 50 33     34 if ($dUT1 > 0.5 || $dUT1 < -0.5) {
1078 0         0 carp '$dUT1 out of range';
1079 0         0 return undef;
1080             }
1081 6 50       10 if (defined $eqenx) {
1082 0         0 croak '$eqenx is not supported yet';
1083             }
1084              
1085 6         6 my $JULIAN_DAY_J2000 = 2451545.0;
1086 6         5 my $JULIAN_DAYS_IN_CENTURY = 36525.0;
1087 6         6 my $SOLAR_TO_SIDEREAL = 1.002737909350795;
1088              
1089 6         4 my $a=101.0 + 24110.54841/86400.0;
1090 6         3 my $b=8640184.812866/86400.0;
1091 6         6 my $e=0.093104/86400.0;
1092 6         5 my $d=0.0000062/86400.0;
1093 6         12 my $tu = (int($mjd)-($JULIAN_DAY_J2000-2400000.5))/$JULIAN_DAYS_IN_CENTURY;
1094 6         8 my $sidtim = $a + $tu*($b + $tu*($e - $tu*$d));
1095 6         7 $sidtim -= int($sidtim);
1096 6 50       10 if ($sidtim < 0.0) {$sidtim += 1.0};
  0         0  
1097 6         7 my $gmst = $sidtim + ($mjd - int($mjd) + $dUT1/86400.0)*$SOLAR_TO_SIDEREAL;
1098 6         11 while ($gmst<0.0) {
1099 0         0 $gmst += 1.0;
1100             }
1101 6         10 while ($gmst>1.0) {
1102 0         0 $gmst -= 1.0;
1103             }
1104              
1105 6         16 return $gmst;
1106             }
1107              
1108             # Not verified - wrapper to gmst
1109              
1110             =item B
1111              
1112             $lst = mjd2lst($mjd, $longitude);
1113             $lmst = mjd2lst($mjd, $longitude, $dUT1);
1114             $ltst = mjd2lst($mjd, $longitude, $dUT1, $eqenx);
1115              
1116             Converts a modified Julian day number into local sidereal time (lst),
1117             local mean sidereal time (lmst) or local true sidereal time (ltst).
1118             Unless high precisions is required dUT1 can be omitted (it will always
1119             be in the range -0.5 to 0.5 seconds).
1120             $mjd Modified Julian day (JD-2400000.5)
1121             $longitude Longitude for which the LST is required (turns)
1122             $dUT1 Difference between UTC and UT1 (UT1 = UTC + dUT1)(seconds)
1123             $eqenx Equation of the equinoxes (not yet supported)
1124             $lst Local sidereal time (turns)
1125             $lmst Local mean sidereal time (turns)
1126             $ltst Local true sidereal time (turns)
1127              
1128             =cut
1129              
1130             sub mjd2lst($$;$$) {
1131 5     5 1 9 my ($mjd, $longitude, $dUT1, $eqenx) = @_;
1132              
1133 5         8 my $lst = gst($mjd, $dUT1, $eqenx);
1134 5 50       7 return undef if (!defined $lst);
1135 5         7 $lst += $longitude;
1136              
1137 5         7 while ($lst>1.0) {
1138 4         8 $lst-= 1;
1139             }
1140 5         8 while ($lst < 0.0) {
1141 0         0 $lst += 1;
1142             }
1143 5         8 return $lst;
1144             }
1145              
1146             =item B
1147              
1148             $lst = cal2lst($day, $month, $year, $ut, $longitude);
1149             $lmst = cal2lst($day, $month, $year, $ut, $longitude, $dUT1);
1150             $ltst = cal2lst($day, $month, $year, $ut, $longitude, $dUT1, $eqenx);
1151              
1152             Wrapper to mjd2lst using calendar date rather than mjd
1153              
1154             =cut
1155              
1156             sub cal2lst($$$$$;$$) {
1157 1     1 1 7 my ($day, $month, $year, $ut, $longitude, $dUT1, $eqenx) = @_;
1158 1         2 my $mjd = cal2mjd($day, $month, $year, $ut);
1159 1 50       3 return undef if (!defined $mjd);
1160              
1161 1         4 return mjd2lst($mjd, $longitude, $dUT1, $eqenx);
1162             }
1163              
1164             =item B
1165              
1166             $lst = dayno2lst($dayno, $year, $ut, $longitude);
1167             $lmst = dayno2lst($dayno, $year, $ut, $longitude, $dUT1);
1168             $ltst = dayno2lst($dayno, $year, $ut, $longitude, $dUT1, $eqenx);
1169              
1170             Wrapper to mjd2lst using calendar date rather than mjd
1171              
1172             =cut
1173              
1174             sub dayno2lst($$$$;$$) {
1175 1     1 1 6 my ($dayno, $year, $ut, $longitude, $dUT1, $eqenx) = @_;
1176 1         2 my $mjd = dayno2mjd($dayno, $year, $ut);
1177 1 50       4 return undef if (!defined $mjd);
1178              
1179 1         3 return mjd2lst($mjd, $longitude, $dUT1, $eqenx);
1180             }
1181              
1182             # Not verified
1183              
1184             =item B
1185              
1186             ($lst_rise, $lst_set) = rise($ra, $dec, $obslat, $el_limit);
1187              
1188             Return the lst rise and set time of the given source
1189             $lst_rise, $lst_set Rise and set time (turns)
1190             $ra, $dec RA and Dec of source (turns)
1191             $obslat Latitude of observatory (turns)
1192             $el_limit Elevation limit of observatory
1193             (turns, 0 horizontal)
1194             Returns 'Circumpolar' if source circumpolar
1195             Returns undef if source never rises
1196              
1197             Uses the formula:
1198             cos $z_limit = sin $obslat * sin $dec + cos $obslat * cos $dec
1199             * cos $HA
1200             where:
1201             $z_limit is the zenith angle limit corresponding to $el_limit
1202             $HA is the Hour Angle of the source
1203             NOTE: For maximum accuracy source coordinated should be precessed to
1204             the current date.
1205              
1206             =cut
1207              
1208             sub rise ($$$$) {
1209             #print "rise: Got @_\n";
1210 1     1 1 1 my ($ra, $dec, $obslat, $el_limit) = @_;
1211 1         3 $ra = turn2rad($ra);
1212 1         3 $dec = turn2rad($dec);
1213 1         2 $obslat = turn2rad($obslat);
1214 1         2 $el_limit = turn2rad($el_limit);
1215              
1216 1         2 my $z_limit = $PI/2-$el_limit;
1217              
1218             #print "Check it\n";
1219              
1220             # Check whether the source ever rises or is circumpolar
1221 1         52 my $z = acos(sin($obslat)*sin($dec) + cos($obslat)*cos($dec)); # Highest point
1222 1 50       5 return (undef) if ($z>$z_limit);
1223              
1224             #print "Got here\n";
1225              
1226 1         4 $z = acos(sin($obslat)*sin($dec) - cos($obslat)*cos($dec)); # Lowest point
1227              
1228 1 50       3 return ('Circumpolar') if ($z<$z_limit);
1229              
1230 1         4 my $cos_ha = (cos($z_limit) - sin($obslat)*sin($dec))
1231             /(cos($obslat)*cos($dec));
1232 1         4 my $ha = acos($cos_ha);
1233              
1234 1         2 my $lst_rise = $ra - $ha;
1235 1         2 my $lst_set = $ra + $ha;
1236              
1237 1 50       9 $lst_rise += 2*$PI if ($lst_rise < 0.0);
1238 1 50       3 $lst_set -= 2*$PI if ($lst_set >= 2*$PI);
1239              
1240 1         3 return rad2turn($lst_rise), rad2turn($lst_set);
1241             }
1242              
1243             =item B
1244              
1245             $mjd = lst2mjd($lmst, $dayno, $year, $longitude);
1246             $mjd = lst2mjd($lmst, $dayno, $year, $longitude, $dUT1);
1247              
1248             This routine calculates the modified Julian day number corresponding
1249             to the local mean sidereal time $lmst at $longitude, on a given UT
1250             day number ($dayno). Unless high precision is required dUT1 can be
1251             omitted.
1252              
1253             The required inputs are :
1254             $lmst - The local mean sidereal time (turns)
1255             $dayno - The UT day of year for which to do the conversion
1256             $year - The year for which to do the conversion
1257             $longitude - The longitude of the observatory (turns)
1258             $dUT1 - Difference between UTC and UT1 (UT1 = UTC + dUT1)
1259             (seconds)
1260             $mjd The modified Julian day corresponding to $lmst on $dayno
1261              
1262             =cut
1263              
1264             sub lst2mjd($$$$;$) {
1265 1     1 1 6 my ($lmst, $dayno, $year, $longitude, $dUT1) = @_;
1266 1 50       3 $dUT1 = 0.0 if (!defined $dUT1);
1267              
1268 1         2 my $SOLAR_TO_SIDEREAL = 1.002737909350795;
1269              
1270 1         2 my $mjd = dayno2mjd($dayno, $year, $dUT1);
1271              
1272             # Time in turns from passed lmst to lmst at the start of $dayno
1273 1         3 my $delay = $lmst-mjd2lst($mjd, $longitude);
1274              
1275 1 50       3 if ($delay < 0.0) {
1276 1         2 $delay += 1.0;
1277             }
1278              
1279 1         2 return($mjd + $delay/$SOLAR_TO_SIDEREAL);
1280             }
1281              
1282             =item B
1283              
1284             $monthstr = month2str($month);
1285             $longmonthstr = month2str($month,1);
1286              
1287             This routine returns the name of the given month (as a number 1..12),
1288             where 1 is January. The default is a 3 character version of the month
1289             ('Jan', 'Feb', etc) in the second form the full month is returned
1290              
1291              
1292             The required inputs are :
1293             $month - The month in question with 1 == January.
1294              
1295             =cut
1296              
1297             sub month2str($;$) {
1298 1     1 1 5 my ($mon, $long) = @_;
1299              
1300 1 50       2 return undef if (!monthOK($mon));
1301              
1302 1 50       3 if ($long) {
1303 0         0 return $MonthStr[$mon-1];
1304             } else {
1305 1         3 return $MonthShortStr[$mon-1];
1306             }
1307             }
1308              
1309             =item B
1310              
1311             $weekday = mjd2weekday($mjd);
1312              
1313             Returns the weekday correspondig to the given MJD.
1314             0 ==> Monday. May not work for historical dates.
1315              
1316             $mjd Modified Julian day (JD-2400000.5)
1317              
1318             =cut
1319              
1320              
1321              
1322             sub mjd2weekday ($) {
1323 2     2 1 11 my $mjd = int floor ((shift)+0.00001); # MJD as an int...
1324 2         3 return ($mjd-5) % 7;
1325             }
1326              
1327             =item B
1328              
1329             $weekdaystr = mjd2weekdaystr($mjd);
1330              
1331             Returns the name of the weekday correspondig to the given MJD.
1332             May not work for historical dates.
1333              
1334             $mjd Modified Julian day (JD-2400000.5)
1335              
1336             =cut
1337              
1338              
1339             sub mjd2weekdaystr($;$) {
1340 1     1 1 5 my ($mjd, $long) = @_;
1341 1         5 my $dow = mjd2weekday($mjd);
1342 1 50       7 if ($long) {
1343 1         4 return $WeekStr[$dow];
1344             } else {
1345 0           return $WeekShortStr[$dow];
1346             }
1347             }
1348              
1349             =item B
1350              
1351             $month = month2str($monthstr);
1352              
1353             Given the name of a month (in English), this routine returns the
1354             an integer between 1 and 12, where 1 is January. Full month names of
1355             3 character abbreviations are acceptable. Minumum matching (e.g. "Marc")
1356             is not supported.
1357              
1358             The required inputs are :
1359             $month - Name of the month ('Jan', 'January', 'Feb', 'February' etc)
1360              
1361             =cut
1362              
1363             sub str2month($) {
1364 0     0 1   my $month = uc(shift);
1365              
1366 0           for (my $i=0; $i<12; $i++) {
1367 0 0 0       if ($month eq uc($MonthStr[$i]) || $month eq uc($MonthShortStr[$i])) {
1368 0           return $i+1;
1369             }
1370             }
1371 0           return undef;
1372             }
1373              
1374             1;
1375              
1376             __END__