File Coverage

blib/lib/Date/Qreki.pm
Criterion Covered Total %
statement 353 406 86.9
branch 37 60 61.6
condition 15 36 41.6
subroutine 15 16 93.7
pod 2 12 16.6
total 422 530 79.6


line stmt bran cond sub pod time code
1             package Date::Qreki;
2             require Exporter;
3             @ISA = qw(Exporter);
4             @EXPORT_OK = qw/calc_kyureki get_rokuyou/;
5 1     1   12847 use warnings;
  1         2  
  1         25  
6 1     1   3 use strict;
  1         1  
  1         35  
7             our $VERSION = '0.06';
8              
9             #=========================================================================
10             # 旧暦計算サンプルプログラム $Revision: 1.1 $
11             # Coded by H.Takano 1993,1994
12             #
13             # Arranged for Perl Script by N.Ueno
14             #
15             #
16             # オリジナルのスクリプトは高野氏のAWKです。下記より入手できます。
17             # http://www.vector.co.jp/soft/dos/personal/se016093.html
18             #
19             #
20             #========================================================================
21              
22             #-----------------------------------------------------------------------
23             # 円周率の定義と(角度の)度からラジアンに変換する係数の定義
24             #-----------------------------------------------------------------------
25 1     1   3 use constant PI => 3.141592653589793238462;
  1         3  
  1         78  
26 1     1   3 use constant k => PI/180.0;
  1         1  
  1         2407  
27              
28             sub deg_cos
29             {
30 22348     22348 0 13232 my ($angle) = @_;
31 22348         19467 return cos ($angle * k);
32             }
33              
34             #=========================================================================
35             # 六曜算出関数
36             #
37             # 引数:新暦年月日
38             # 戻値:0:大安 1:赤口 2:先勝 3:友引 4:先負 5:仏滅
39             #
40             #=========================================================================
41             sub get_rokuyou
42             {
43              
44 4     4 1 2250 my ($year,$mon,$day) = @_;
45 4         5 my ($tm0,$q_year,$q_mon,$q_day,$uruu,$q_yaer);
46              
47 4         9 ($q_yaer,$uruu,$q_mon,$q_day) = calc_kyureki($year,$mon,$day);
48              
49 4         25 return(($q_mon + $q_day) % 6);
50             }
51              
52             #=========================================================================
53             # 新暦に対応する、旧暦を求める。
54             #
55             # 呼び出し時にセットする変数
56             # 引 数 year : 計算する日付
57             # mon
58             # day
59             #
60             # 戻り値 kyureki : 答えの格納先(配列に答えをかえす)
61             #    kyureki[0] : 旧暦年
62             #    kyureki[1] : 平月/閏月 flag .... 平月:0 閏月:1
63             #    kyureki[2] : 旧暦月
64             #    kyureki[3] : 旧暦日
65             #
66             #=========================================================================
67             sub calc_kyureki
68             {
69 8     8 1 1534 my ($year,$mon,$day) = @_;
70 8         8 my (@kyureki,$tm,@saku,$lap,@a,$i,@m);
71              
72 8         19 my $tm0 = YMDT2JD($year,$mon,$day,0,0,0);
73              
74             #-----------------------------------------------------------------------
75             # 計算対象の直前にあたる二分二至の時刻を求める
76             # chu[0,0]:二分二至の時刻 chu[0,1]:その時の太陽黄経
77             #-----------------------------------------------------------------------
78 8         10 my @chu;
79 8         20 ($chu[0][0],$chu[0][1]) = before_nibun($tm0);
80              
81             #-----------------------------------------------------------------------
82             # 中気の時刻を計算(4回計算する)
83             # chu[i,0]:中気の時刻 chu[i,1]:太陽黄経
84             #-----------------------------------------------------------------------
85 8         23 for($i=1;$i<4;$i++){
86 24         48 ($chu[$i][0],$chu[$i][1]) = calc_chu($chu[$i-1][0]+32.0);
87             }
88              
89             #-----------------------------------------------------------------------
90             # 計算対象の直前にあたる二分二至の直前の朔の時刻を求める
91             #-----------------------------------------------------------------------
92 8         12 $saku[0] = calc_saku($chu[0][0]);
93              
94              
95             #-----------------------------------------------------------------------
96             # 朔の時刻を求める
97             #-----------------------------------------------------------------------
98 8         17 for($i=1;$i<5;$i++){
99 32         30 $tm=$saku[$i-1];
100 32         22 $tm += 30.0;
101 32         33 $saku[$i]=calc_saku($tm);
102              
103             # 前と同じ時刻を計算した場合(両者の差が26日以内)には、初期値を
104             # +33日にして再実行させる。
105 32 50       115 if( abs( int($saku[$i-1])-int($saku[$i]) ) <= 26.0 ){
106 0         0 $saku[$i]=calc_saku($saku[$i-1]+35.0);
107             }
108             }
109              
110             #-----------------------------------------------------------------------
111             # saku[1]が二分二至の時刻以前になってしまった場合には、朔をさかのぼり過ぎ
112             # たと考えて、朔の時刻を繰り下げて修正する。
113             # その際、計算もれ(saku[4])になっている部分を補うため、朔の時刻を計算
114             # する。(近日点通過の近辺で朔があると起こる事があるようだ...?)
115             #-----------------------------------------------------------------------
116 8 50       46 if( int($saku[1]) <= int($chu[0][0]) ){
    50          
117 0         0 for($i=0;$i<5;$i++){
118 0         0 $saku[$i]=$saku[$i+1];
119             }
120 0         0 $saku[4] = calc_saku($saku[3]+35.0);
121             }
122              
123             #-----------------------------------------------------------------------
124             # saku[0]が二分二至の時刻以後になってしまった場合には、朔をさかのぼり足
125             # りないと見て、朔の時刻を繰り上げて修正する。
126             # その際、計算もれ(saku[0])になっている部分を補うため、朔の時刻を計算
127             # する。(春分点の近辺で朔があると起こる事があるようだ...?)
128             #-----------------------------------------------------------------------
129             elsif( int($saku[0]) > int($chu[0][0]) ){
130 0         0 for($i=4;$i>0;$i--){
131 0         0 $saku[$i] = $saku[$i-1];
132             }
133 0         0 $saku[0] = calc_saku($saku[0]-27.0);
134             }
135              
136             #-----------------------------------------------------------------------
137             # 閏月検索Flagセット
138             # (節月で4ヶ月の間に朔が5回あると、閏月がある可能性がある。)
139             # lap=0:平月 lap=1:閏月
140             #-----------------------------------------------------------------------
141 8 50       29 if(int($saku[4]) <= int($chu[3][0]) ){
142 0         0 $lap=1;
143             }else{
144 8         12 $lap=0;
145             }
146              
147             #-----------------------------------------------------------------------
148             # 朔日行列の作成
149             # m[i,0] ... 月名(1:正月 2:2月 3:3月 ....)
150             # m[i,1] ... 閏フラグ(0:平月 1:閏月)
151             # m[i,2] ... 朔日のjd
152             #-----------------------------------------------------------------------
153 8         33 $m[0][0]=int($chu[0][1]/30.0) + 2;
154 8 50 33     26 if(defined $m[0][1] && $m[0][1] > 12 ){
155 0         0 $m[0][0]-=12;
156             }
157 8         13 $m[0][2]=int($saku[0]);
158 8         10 $m[0][1]=0;
159              
160 8         21 for($i=1;$i<5;$i++){
161 32 50 33     56 if($lap == 1 && $i !=1 ){
162 0 0 0     0 if( int($chu[$i-1][0]) <= int($saku[$i-1]) || int($chu[$i-1][0]) >= int($saku[$i]) ){
163 0         0 $m[$i-1][0] = $m[$i-2][0];
164 0         0 $m[$i-1][1] = 1;
165 0         0 $m[$i-1][2] = int($saku[$i-1]);
166 0         0 $lap=0;
167             }
168             }
169 32         54 $m[$i][0] = $m[$i-1][0]+1;
170 32 100       47 if( $m[$i][0] > 12 ){
171 6         7 $m[$i][0]-=12;
172             }
173 32         25 $m[$i][2]=int($saku[$i]);
174 32         59 $m[$i][1]=0;
175             }
176              
177             #-----------------------------------------------------------------------
178             # 朔日行列から旧暦を求める。
179             #-----------------------------------------------------------------------
180 8         8 my $state=0;
181 8         15 for($i=0;$i<5;$i++){
182 28 100       65 if(int($tm0) < int($m[$i][2])){
    50          
183 8         6 $state=1;
184 8         14 last;
185             }elsif(int($tm0) == int($m[$i][2])){
186 0         0 $state=2;
187 0         0 last;
188             }
189             }
190 8 50 33     32 if($state==0||$state==1){
191 8         7 $i--;
192             }
193              
194 8         12 $kyureki[1]=$m[$i][1];
195 8         12 $kyureki[2]=$m[$i][0];
196 8         18 $kyureki[3]=int($tm0)-int($m[$i][2])+1;
197              
198             #-----------------------------------------------------------------------
199             # 旧暦年の計算
200             # (旧暦月が10以上でかつ新暦月より大きい場合には、
201             # まだ年を越していないはず...)
202             #-----------------------------------------------------------------------
203              
204 8         19 @a = JD2YMDT($tm0);
205 8         11 $kyureki[0] = $a[0];
206 8 100 66     33 if($kyureki[2] > 9 && $kyureki[2] > $a[1]){
207 4         5 $kyureki[0]--;
208             }
209              
210 8         58 return($kyureki[0],$kyureki[1],$kyureki[2],$kyureki[3]);
211              
212             }
213              
214             #=========================================================================
215             # 中気の時刻を求める
216             #
217             # 呼び出し時にセットする変数
218             # tm ........ 計算対象となる時刻(ユリウス日)
219             # chu ....... 戻り値を格納する配列のポインター
220             # i ......... 戻り値を格納する配列の要素番号
221             # 戻り値 .... 中気の時刻、その時の黄経を配列で渡す
222             #
223             #=========================================================================
224             sub calc_chu
225             {
226 24     24 0 25 my ($tm) = @_;
227 24         14 my ($tm1,$tm2,$t,$rm_sun0,$rm_sun,$delta_t1,$delta_t2,$delta_rm);
228 0         0 my (@temp);
229             #-----------------------------------------------------------------------
230             #時刻引数を分解する
231             #-----------------------------------------------------------------------
232 24         20 $tm1 = int( $tm );
233 24         22 $tm2 = $tm - $tm1;
234              
235             #-----------------------------------------------------------------------
236             # JST ==> DT (補正時刻=0.0sec と仮定して計算)
237             #-----------------------------------------------------------------------
238 24         17 $tm2-=9.0/24.0;
239              
240             #-----------------------------------------------------------------------
241             # 中気の黄経 λsun0 を求める
242             #-----------------------------------------------------------------------
243 24         29 $t=($tm2+0.5) / 36525.0;
244 24         26 $t=$t + ($tm1-2451545.0) / 36525.0;
245 24         34 $rm_sun = LONGITUDE_SUN( $t );
246              
247 24         26 $rm_sun0 = 30.0*int($rm_sun/30.0);
248              
249             #-----------------------------------------------------------------------
250             # 繰り返し計算によって中気の時刻を計算する
251             # (誤差が±1.0 sec以内になったら打ち切る。)
252             #-----------------------------------------------------------------------
253 24         13 $delta_t1 = 0;
254 24         47 for( $delta_t2 = 1.0 ; abs( $delta_t1 + $delta_t2 ) > ( 1.0 / 86400.0 ) ; ){
255              
256             #-----------------------------------------------------------------------
257             # λsun を計算
258             #-----------------------------------------------------------------------
259 108         71 $t =($tm2+0.5) / 36525.0;
260 108         66 $t =$t + ($tm1-2451545.0) / 36525.0;
261 108         97 $rm_sun=LONGITUDE_SUN( $t );
262              
263             #-----------------------------------------------------------------------
264             # 黄経差 Δλ=λsun −λsun0
265             #-----------------------------------------------------------------------
266 108         71 $delta_rm = $rm_sun - $rm_sun0 ;
267              
268             #-----------------------------------------------------------------------
269             # Δλの引き込み範囲(±180°)を逸脱した場合には、補正を行う
270             #-----------------------------------------------------------------------
271 108 100       168 if( $delta_rm > 180.0 ){
    50          
272 8         8 $delta_rm-=360.0;
273             }elsif( $delta_rm < -180.0 ){
274 0         0 $delta_rm+=360.0;
275             }
276              
277             #-----------------------------------------------------------------------
278             # 時刻引数の補正値 Δt
279             # delta_t = delta_rm * 365.2 / 360.0;
280             #-----------------------------------------------------------------------
281 108         85 $delta_t1 = int($delta_rm * 365.2 / 360.0);
282 108         68 $delta_t2 = $delta_rm * 365.2 / 360.0;
283 108         66 $delta_t2 -= $delta_t1;
284              
285             #-----------------------------------------------------------------------
286             # 時刻引数の補正
287             # tm -= delta_t;
288             #-----------------------------------------------------------------------
289 108         60 $tm1 = $tm1 - $delta_t1;
290 108         63 $tm2 = $tm2 - $delta_t2;
291 108 100       194 if($tm2 < 0){
292 18         12 $tm2+=1.0;$tm1-=1.0;
  18         29  
293             }
294             }
295              
296             #-----------------------------------------------------------------------
297             # 戻り値の作成
298             # chu[i,0]:時刻引数を合成するのと、DT ==> JST 変換を行い、戻り値とする
299             # (補正時刻=0.0sec と仮定して計算)
300             # chu[i,1]:黄経
301             #-----------------------------------------------------------------------
302 24         25 $temp[0] = $tm2+9.0/24.0;
303 24         19 $temp[0] += $tm1;
304 24         16 $temp[1] = $rm_sun0;
305              
306 24         83 return(@temp);
307             }
308              
309             #=========================================================================
310             # 直前の二分二至の時刻を求める
311             #
312             # 呼び出し時にセットする変数
313             # tm ........ 計算対象となる時刻(ユリウス日)
314             # nibun ..... 戻り値を格納する配列のポインター
315             # 戻り値 .... 二分二至の時刻、その時の黄経を配列で渡す
316             # (戻り値の渡し方がちょっと気にくわないがまぁいいや。)
317             #=========================================================================
318             sub before_nibun
319             {
320 8     8 0 8 my ($tm) = @_;
321 8         7 my (@nibun,$tm1,$tm2,$t,$rm_sun0,$rm_sun,$delta_t1,$delta_t2,$delta_rm);
322              
323             #-----------------------------------------------------------------------
324             #時刻引数を分解する
325             #-----------------------------------------------------------------------
326 8         9 $tm1 = int( $tm );
327 8         9 $tm2 = $tm - $tm1;
328              
329             #-----------------------------------------------------------------------
330             # JST ==> DT (補正時刻=0.0sec と仮定して計算)
331             #-----------------------------------------------------------------------
332 8         8 $tm2-=9.0/24.0;
333              
334             #-----------------------------------------------------------------------
335             # 直前の二分二至の黄経 λsun0 を求める
336             #-----------------------------------------------------------------------
337 8         11 $t=($tm2+0.5) / 36525.0;
338 8         12 $t=$t + ($tm1-2451545.0) / 36525.0;
339 8         15 $rm_sun=LONGITUDE_SUN( $t );
340 8         11 $rm_sun0=90*int($rm_sun/90.0);
341              
342             #-----------------------------------------------------------------------
343             # 繰り返し計算によって直前の二分二至の時刻を計算する
344             # (誤差が±1.0 sec以内になったら打ち切る。)
345             #-----------------------------------------------------------------------
346 8         11 $delta_t1 = 0;
347 8         25 for( $delta_t2 = 1.0 ; abs( $delta_t1+$delta_t2 ) > ( 1.0 / 86400.0 ) ; ){
348              
349             #-----------------------------------------------------------------------
350             # λsun を計算
351             #-----------------------------------------------------------------------
352 44         34 $t=($tm2+0.5) / 36525.0;
353 44         32 $t=$t + ($tm1-2451545.0) / 36525.0;
354 44         41 $rm_sun=LONGITUDE_SUN( $t );
355              
356             #-----------------------------------------------------------------------
357             # 黄経差 Δλ=λsun −λsun0
358             #-----------------------------------------------------------------------
359 44         35 $delta_rm = $rm_sun - $rm_sun0 ;
360              
361             #-----------------------------------------------------------------------
362             # Δλの引き込み範囲(±180°)を逸脱した場合には、補正を行う
363             #-----------------------------------------------------------------------
364 44 50       114 if( $delta_rm > 180.0 ){
    50          
365 0         0 $delta_rm-=360.0;
366             }elsif( $delta_rm < -180.0){
367 0         0 $delta_rm+=360.0;
368             }
369              
370             #-----------------------------------------------------------------------
371             # 時刻引数の補正値 Δt
372             # delta_t = delta_rm * 365.2 / 360.0;
373             #-----------------------------------------------------------------------
374 44         38 $delta_t1 = int($delta_rm * 365.2 / 360.0);
375 44         35 $delta_t2 = $delta_rm * 365.2 / 360.0;
376 44         31 $delta_t2 -= $delta_t1;
377              
378             #-----------------------------------------------------------------------
379             # 時刻引数の補正
380             # tm -= delta_t;
381             #-----------------------------------------------------------------------
382 44         22 $tm1 = $tm1 - $delta_t1;
383 44         24 $tm2 = $tm2 - $delta_t2;
384 44 100       84 if($tm2 < 0){
385 10         6 $tm2+=1.0;$tm1-=1.0;
  10         19  
386             }
387              
388             }
389              
390             #-----------------------------------------------------------------------
391             # 戻り値の作成
392             # nibun[0,0]:時刻引数を合成するのと、DT ==> JST 変換を行い、戻り値とする
393             # (補正時刻=0.0sec と仮定して計算)
394             # nibun[0,1]:黄経
395             #-----------------------------------------------------------------------
396 8         10 $nibun[0] = $tm2+9.0/24.0;
397 8         8 $nibun[0] += $tm1;
398 8         5 $nibun[1] = $rm_sun0;
399              
400 8         25 return(@nibun);
401              
402             }
403              
404             #=========================================================================
405             # 朔の計算
406             # 与えられた時刻の直近の朔の時刻(JST)を求める
407             #
408             # 呼び出し時にセットする変数
409             # tm ........ 計算対象となる時刻(ユリウス日)
410             # 戻り値 .... 朔の時刻
411             #
412             # ※ 引数、戻り値ともユリウス日で表し、時分秒は日の小数で表す。
413             #
414             #=========================================================================
415             sub calc_saku
416             {
417 40     40 0 33 my ($tm) = @_;
418 40         26 my ($lc,$t,$tm1,$tm2,$rm_sun,$rm_moon,$delta_rm,$delta_t1,$delta_t2);
419              
420             #-----------------------------------------------------------------------
421             # ループカウンタのセット
422             #-----------------------------------------------------------------------
423 40         27 $lc=1;
424              
425             #-----------------------------------------------------------------------
426             #時刻引数を分解する
427             #-----------------------------------------------------------------------
428 40         32 $tm1 = int( $tm );
429 40         28 $tm2 = $tm - $tm1;
430              
431             #-----------------------------------------------------------------------
432             # JST ==> DT (補正時刻=0.0sec と仮定して計算)
433             #-----------------------------------------------------------------------
434 40         26 $tm2-=9.0/24.0;
435              
436             #-----------------------------------------------------------------------
437             # 繰り返し計算によって朔の時刻を計算する
438             # (誤差が±1.0 sec以内になったら打ち切る。)
439             #-----------------------------------------------------------------------
440 40         23 $delta_t1 = 0;
441 40         69 for( $delta_t2 = 1.0 ; abs( $delta_t1+$delta_t2 ) > ( 1.0 / 86400.0 ) ; $lc++){
442              
443             #-----------------------------------------------------------------------
444             # 太陽の黄経λsun ,月の黄経λmoon を計算
445             # t = (tm - 2451548.0 + 0.5)/36525.0;
446             #-----------------------------------------------------------------------
447 252         191 $t=($tm2+0.5) / 36525.0;
448 252         189 $t=$t + ($tm1-2451545.0) / 36525.0;
449 252         228 $rm_sun=LONGITUDE_SUN( $t );
450 252         236 $rm_moon=LONGITUDE_MOON( $t );
451              
452             #-----------------------------------------------------------------------
453             # 月と太陽の黄経差Δλ
454             # Δλ=λmoon−λsun
455             #-----------------------------------------------------------------------
456 252         155 $delta_rm = $rm_moon - $rm_sun ;
457              
458             #-----------------------------------------------------------------------
459             # ループの1回目(lc=1)で delta_rm < 0.0 の場合には引き込み範囲に
460             # 入るように補正する
461             #-----------------------------------------------------------------------
462 252 100 100     1285 if( $lc==1 && $delta_rm < 0.0 ){
    50 66        
    100 66        
463 6         7 $delta_rm = NORMALIZATION_ANGLE( $delta_rm );
464             }
465             #-----------------------------------------------------------------------
466             # 春分の近くで朔がある場合(0 ≦λsun≦ 20)で、月の黄経λmoon≧300 の
467             # 場合には、Δλ= 360.0 − Δλ と計算して補正する
468             #-----------------------------------------------------------------------
469             elsif( $rm_sun >= 0 && $rm_sun <= 20 && $rm_moon >= 300 ){
470 0         0 $delta_rm = NORMALIZATION_ANGLE( $delta_rm );
471 0         0 $delta_rm = 360.0 - $delta_rm;
472             }
473             #-----------------------------------------------------------------------
474             # Δλの引き込み範囲(±40°)を逸脱した場合には、補正を行う
475             #-----------------------------------------------------------------------
476             elsif( abs( $delta_rm ) > 40.0 ) {
477 2         4 $delta_rm = NORMALIZATION_ANGLE( $delta_rm );
478             }
479              
480             #-----------------------------------------------------------------------
481             # 時刻引数の補正値 Δt
482             # delta_t = delta_rm * 29.530589 / 360.0;
483             #-----------------------------------------------------------------------
484 252         204 $delta_t1 = int($delta_rm * 29.530589 / 360.0);
485 252         186 $delta_t2 = $delta_rm * 29.530589 / 360.0;
486 252         151 $delta_t2 -= $delta_t1;
487              
488             #-----------------------------------------------------------------------
489             # 時刻引数の補正
490             # tm -= delta_t;
491             #-----------------------------------------------------------------------
492 252         152 $tm1 = $tm1 - $delta_t1;
493 252         141 $tm2 = $tm2 - $delta_t2;
494 252 100       304 if($tm2 < 0.0){
495 38         27 $tm2+=1.0;$tm1-=1.0;
  38         26  
496             }
497              
498             #-----------------------------------------------------------------------
499             # ループ回数が15回になったら、初期値 tm を tm-26 とする。
500             #-----------------------------------------------------------------------
501 252 50 33     958 if($lc == 15 && abs( $delta_t1+$delta_t2 ) > ( 1.0 / 86400.0 ) ){
    50 33        
502 0         0 $tm1 = int( $tm-26 );
503 0         0 $tm2 = 0;
504             }
505              
506             #-----------------------------------------------------------------------
507             # 初期値を補正したにも関わらず、振動を続ける場合には初期値を答えとして
508             # 返して強制的にループを抜け出して異常終了させる。
509             #-----------------------------------------------------------------------
510             elsif( $lc > 30 && abs( $delta_t1+$delta_t2 ) > ( 1.0 / 86400.0 ) ){
511 0         0 $tm1=$tm;$tm2=0;
  0         0  
512 0         0 last;
513             }
514             }
515              
516             #-----------------------------------------------------------------------
517             # 時刻引数を合成するのと、DT ==> JST 変換を行い、戻り値とする
518             # (補正時刻=0.0sec と仮定して計算)
519             #-----------------------------------------------------------------------
520              
521 40         71 return($tm2+$tm1+9.0/24.0);
522             }
523              
524             #=========================================================================
525             # 角度の正規化を行う。すなわち引数の範囲を 0≦θ<360 にする。
526             #=========================================================================
527             sub NORMALIZATION_ANGLE
528             {
529 23984     23984 0 13775 my ($angle) = @_;
530 23984         13363 my ($angle1,$angle2);
531              
532 23984 100       20545 if( $angle < 0.0 ){
533 21756         12147 $angle1 = -$angle;
534 21756         13623 $angle2 = int( $angle1 / 360.0 );
535 21756         12622 $angle1 -= 360.0 * $angle2;
536 21756         13135 $angle1 = 360.0 - $angle1;
537             }else{
538 2228         1443 $angle1 = int( $angle / 360.0 );
539 2228         1443 $angle1 = $angle - 360.0 * $angle1;
540             }
541              
542 23984         17948 return($angle1);
543             }
544              
545             #=========================================================================
546             # 太陽の黄経 λsun を計算する
547             #=========================================================================
548             sub LONGITUDE_SUN
549             {
550 436     436 0 342 my ($t) = @_;
551 436         243 my ($th,$ang);
552              
553             #-----------------------------------------------------------------------
554             # 摂動項の計算
555             #-----------------------------------------------------------------------
556 436         472 $ang = NORMALIZATION_ANGLE( 31557.0 * $t + 161.0 );
557 436         414 $th = .0004 * deg_cos( $ang );
558 436         413 $ang = NORMALIZATION_ANGLE( 29930.0 * $t + 48.0 );
559 436         421 $th = $th + .0004 * deg_cos ($ang );
560 436         441 $ang = NORMALIZATION_ANGLE( 2281.0 * $t + 221.0 );
561 436         427 $th = $th + .0005 * deg_cos ($ang );
562 436         454 $ang = NORMALIZATION_ANGLE( 155.0 * $t + 118.0 );
563 436         428 $th = $th + .0005 * deg_cos ($ang );
564 436         445 $ang = NORMALIZATION_ANGLE( 33718.0 * $t + 316.0 );
565 436         377 $th = $th + .0006 * deg_cos ($ang );
566 436         456 $ang = NORMALIZATION_ANGLE( 9038.0 * $t + 64.0 );
567 436         387 $th = $th + .0007 * deg_cos ($ang );
568 436         420 $ang = NORMALIZATION_ANGLE( 3035.0 * $t + 110.0 );
569 436         434 $th = $th + .0007 * deg_cos ($ang );
570 436         415 $ang = NORMALIZATION_ANGLE( 65929.0 * $t + 45.0 );
571 436         395 $th = $th + .0007 * deg_cos ($ang );
572 436         406 $ang = NORMALIZATION_ANGLE( 22519.0 * $t + 352.0 );
573 436         400 $th = $th + .0013 * deg_cos ($ang );
574 436         428 $ang = NORMALIZATION_ANGLE( 45038.0 * $t + 254.0 );
575 436         376 $th = $th + .0015 * deg_cos ($ang );
576 436         437 $ang = NORMALIZATION_ANGLE( 445267.0 * $t + 208.0 );
577 436         382 $th = $th + .0018 * deg_cos ($ang );
578 436         414 $ang = NORMALIZATION_ANGLE( 19.0 * $t + 159.0 );
579 436         395 $th = $th + .0018 * deg_cos ($ang );
580 436         412 $ang = NORMALIZATION_ANGLE( 32964.0 * $t + 158.0 );
581 436         396 $th = $th + .0020 * deg_cos ($ang );
582 436         415 $ang = NORMALIZATION_ANGLE( 71998.1 * $t + 265.1 );
583 436         368 $th = $th + .0200 * deg_cos ($ang );
584 436         445 $ang = NORMALIZATION_ANGLE( 35999.05 * $t + 267.52 );
585 436         414 $th = $th - 0.0048 * $t * deg_cos ($ang ) ;
586 436         368 $th = $th + 1.9147 * deg_cos ($ang ) ;
587              
588             #-----------------------------------------------------------------------
589             # 比例項の計算
590             #-----------------------------------------------------------------------
591 436         406 $ang = NORMALIZATION_ANGLE( 36000.7695 * $t );
592 436         424 $ang = NORMALIZATION_ANGLE( $ang + 280.4659 );
593 436         420 $th = NORMALIZATION_ANGLE( $th + $ang );
594              
595 436         331 return($th);
596             }
597              
598             #=========================================================================
599             # 月の黄経 λmoon を計算する
600             #=========================================================================
601             sub LONGITUDE_MOON
602             {
603 252     252 0 170 my ($t) = @_;
604 252         131 my ($th,$ang);
605              
606             #-----------------------------------------------------------------------
607             # 摂動項の計算
608             #-----------------------------------------------------------------------
609 252         252 $ang = NORMALIZATION_ANGLE( 2322131.0 * $t + 191.0 );
610 252         235 $th = .0003 * deg_cos ($ang );
611 252         254 $ang = NORMALIZATION_ANGLE( 4067.0 * $t + 70.0 );
612 252         239 $th = $th + .0003 * deg_cos ($ang );
613 252         252 $ang = NORMALIZATION_ANGLE( 549197.0 * $t + 220.0 );
614 252         270 $th = $th + .0003 * deg_cos ($ang );
615 252         242 $ang = NORMALIZATION_ANGLE( 1808933.0 * $t + 58.0 );
616 252         253 $th = $th + .0003 * deg_cos ($ang );
617 252         266 $ang = NORMALIZATION_ANGLE( 349472.0 * $t + 337.0 );
618 252         242 $th = $th + .0003 * deg_cos ($ang );
619 252         246 $ang = NORMALIZATION_ANGLE( 381404.0 * $t + 354.0 );
620 252         227 $th = $th + .0003 * deg_cos ($ang );
621 252         278 $ang = NORMALIZATION_ANGLE( 958465.0 * $t + 340.0 );
622 252         238 $th = $th + .0003 * deg_cos ($ang );
623 252         263 $ang = NORMALIZATION_ANGLE( 12006.0 * $t + 187.0 );
624 252         232 $th = $th + .0004 * deg_cos ($ang );
625 252         247 $ang = NORMALIZATION_ANGLE( 39871.0 * $t + 223.0 );
626 252         229 $th = $th + .0004 * deg_cos ($ang );
627 252         263 $ang = NORMALIZATION_ANGLE( 509131.0 * $t + 242.0 );
628 252         248 $th = $th + .0005 * deg_cos ($ang );
629 252         255 $ang = NORMALIZATION_ANGLE( 1745069.0 * $t + 24.0 );
630 252         229 $th = $th + .0005 * deg_cos ($ang );
631 252         239 $ang = NORMALIZATION_ANGLE( 1908795.0 * $t + 90.0 );
632 252         215 $th = $th + .0005 * deg_cos ($ang );
633 252         266 $ang = NORMALIZATION_ANGLE( 2258267.0 * $t + 156.0 );
634 252         218 $th = $th + .0006 * deg_cos ($ang );
635 252         246 $ang = NORMALIZATION_ANGLE( 111869.0 * $t + 38.0 );
636 252         229 $th = $th + .0006 * deg_cos ($ang );
637 252         242 $ang = NORMALIZATION_ANGLE( 27864.0 * $t + 127.0 );
638 252         235 $th = $th + .0007 * deg_cos ($ang );
639 252         234 $ang = NORMALIZATION_ANGLE( 485333.0 * $t + 186.0 );
640 252         235 $th = $th + .0007 * deg_cos ($ang );
641 252         238 $ang = NORMALIZATION_ANGLE( 405201.0 * $t + 50.0 );
642 252         234 $th = $th + .0007 * deg_cos ($ang );
643 252         253 $ang = NORMALIZATION_ANGLE( 790672.0 * $t + 114.0 );
644 252         218 $th = $th + .0007 * deg_cos ($ang );
645 252         237 $ang = NORMALIZATION_ANGLE( 1403732.0 * $t + 98.0 );
646 252         232 $th = $th + .0008 * deg_cos ($ang );
647 252         262 $ang = NORMALIZATION_ANGLE( 858602.0 * $t + 129.0 );
648 252         238 $th = $th + .0009 * deg_cos ($ang );
649 252         261 $ang = NORMALIZATION_ANGLE( 1920802.0 * $t + 186.0 );
650 252         236 $th = $th + .0011 * deg_cos ($ang );
651 252         261 $ang = NORMALIZATION_ANGLE( 1267871.0 * $t + 249.0 );
652 252         232 $th = $th + .0012 * deg_cos ($ang );
653 252         263 $ang = NORMALIZATION_ANGLE( 1856938.0 * $t + 152.0 );
654 252         254 $th = $th + .0016 * deg_cos ($ang );
655 252         248 $ang = NORMALIZATION_ANGLE( 401329.0 * $t + 274.0 );
656 252         224 $th = $th + .0018 * deg_cos ($ang );
657 252         256 $ang = NORMALIZATION_ANGLE( 341337.0 * $t + 16.0 );
658 252         237 $th = $th + .0021 * deg_cos ($ang );
659 252         252 $ang = NORMALIZATION_ANGLE( 71998.0 * $t + 85.0 );
660 252         228 $th = $th + .0021 * deg_cos ($ang );
661 252         259 $ang = NORMALIZATION_ANGLE( 990397.0 * $t + 357.0 );
662 252         221 $th = $th + .0021 * deg_cos ($ang );
663 252         258 $ang = NORMALIZATION_ANGLE( 818536.0 * $t + 151.0 );
664 252         286 $th = $th + .0022 * deg_cos ($ang );
665 252         247 $ang = NORMALIZATION_ANGLE( 922466.0 * $t + 163.0 );
666 252         237 $th = $th + .0023 * deg_cos ($ang );
667 252         256 $ang = NORMALIZATION_ANGLE( 99863.0 * $t + 122.0 );
668 252         240 $th = $th + .0024 * deg_cos ($ang );
669 252         269 $ang = NORMALIZATION_ANGLE( 1379739.0 * $t + 17.0 );
670 252         213 $th = $th + .0026 * deg_cos ($ang );
671 252         247 $ang = NORMALIZATION_ANGLE( 918399.0 * $t + 182.0 );
672 252         235 $th = $th + .0027 * deg_cos ($ang );
673 252         232 $ang = NORMALIZATION_ANGLE( 1934.0 * $t + 145.0 );
674 252         249 $th = $th + .0028 * deg_cos ($ang );
675 252         273 $ang = NORMALIZATION_ANGLE( 541062.0 * $t + 259.0 );
676 252         248 $th = $th + .0037 * deg_cos ($ang );
677 252         270 $ang = NORMALIZATION_ANGLE( 1781068.0 * $t + 21.0 );
678 252         566 $th = $th + .0038 * deg_cos ($ang );
679 252         268 $ang = NORMALIZATION_ANGLE( 133.0 * $t + 29.0 );
680 252         233 $th = $th + .0040 * deg_cos ($ang );
681 252         248 $ang = NORMALIZATION_ANGLE( 1844932.0 * $t + 56.0 );
682 252         228 $th = $th + .0040 * deg_cos ($ang );
683 252         253 $ang = NORMALIZATION_ANGLE( 1331734.0 * $t + 283.0 );
684 252         238 $th = $th + .0040 * deg_cos ($ang );
685 252         247 $ang = NORMALIZATION_ANGLE( 481266.0 * $t + 205.0 );
686 252         234 $th = $th + .0050 * deg_cos ($ang );
687 252         250 $ang = NORMALIZATION_ANGLE( 31932.0 * $t + 107.0 );
688 252         221 $th = $th + .0052 * deg_cos ($ang );
689 252         234 $ang = NORMALIZATION_ANGLE( 926533.0 * $t + 323.0 );
690 252         231 $th = $th + .0068 * deg_cos ($ang );
691 252         235 $ang = NORMALIZATION_ANGLE( 449334.0 * $t + 188.0 );
692 252         212 $th = $th + .0079 * deg_cos ($ang );
693 252         260 $ang = NORMALIZATION_ANGLE( 826671.0 * $t + 111.0 );
694 252         233 $th = $th + .0085 * deg_cos ($ang );
695 252         242 $ang = NORMALIZATION_ANGLE( 1431597.0 * $t + 315.0 );
696 252         213 $th = $th + .0100 * deg_cos ($ang );
697 252         232 $ang = NORMALIZATION_ANGLE( 1303870.0 * $t + 246.0 );
698 252         251 $th = $th + .0107 * deg_cos ($ang );
699 252         230 $ang = NORMALIZATION_ANGLE( 489205.0 * $t + 142.0 );
700 252         238 $th = $th + .0110 * deg_cos ($ang );
701 252         246 $ang = NORMALIZATION_ANGLE( 1443603.0 * $t + 52.0 );
702 252         235 $th = $th + .0125 * deg_cos ($ang );
703 252         253 $ang = NORMALIZATION_ANGLE( 75870.0 * $t + 41.0 );
704 252         301 $th = $th + .0154 * deg_cos ($ang );
705 252         239 $ang = NORMALIZATION_ANGLE( 513197.9 * $t + 222.5 );
706 252         237 $th = $th + .0304 * deg_cos ($ang );
707 252         233 $ang = NORMALIZATION_ANGLE( 445267.1 * $t + 27.9 );
708 252         227 $th = $th + .0347 * deg_cos ($ang );
709 252         232 $ang = NORMALIZATION_ANGLE( 441199.8 * $t + 47.4 );
710 252         218 $th = $th + .0409 * deg_cos ($ang );
711 252         273 $ang = NORMALIZATION_ANGLE( 854535.2 * $t + 148.2 );
712 252         227 $th = $th + .0458 * deg_cos ($ang );
713 252         240 $ang = NORMALIZATION_ANGLE( 1367733.1 * $t + 280.7 );
714 252         238 $th = $th + .0533 * deg_cos ($ang );
715 252         239 $ang = NORMALIZATION_ANGLE( 377336.3 * $t + 13.2 );
716 252         231 $th = $th + .0571 * deg_cos ($ang );
717 252         236 $ang = NORMALIZATION_ANGLE( 63863.5 * $t + 124.2 );
718 252         218 $th = $th + .0588 * deg_cos ($ang );
719 252         225 $ang = NORMALIZATION_ANGLE( 966404.0 * $t + 276.5 );
720 252         244 $th = $th + .1144 * deg_cos ($ang );
721 252         234 $ang = NORMALIZATION_ANGLE( 35999.05 * $t + 87.53 );
722 252         220 $th = $th + .1851 * deg_cos ($ang );
723 252         237 $ang = NORMALIZATION_ANGLE( 954397.74 * $t + 179.93 );
724 252         211 $th = $th + .2136 * deg_cos ($ang );
725 252         246 $ang = NORMALIZATION_ANGLE( 890534.22 * $t + 145.7 );
726 252         224 $th = $th + .6583 * deg_cos ($ang );
727 252         245 $ang = NORMALIZATION_ANGLE( 413335.35 * $t + 10.74 );
728 252         229 $th = $th + 1.2740 * deg_cos ($ang );
729 252         237 $ang = NORMALIZATION_ANGLE( 477198.868 * $t + 44.963 );
730 252         215 $th = $th + 6.2888 * deg_cos ($ang );
731              
732             #-----------------------------------------------------------------------
733             # 比例項の計算
734             #-----------------------------------------------------------------------
735 252         218 $ang = NORMALIZATION_ANGLE( 481267.8809 * $t );
736 252         231 $ang = NORMALIZATION_ANGLE( $ang + 218.3162 );
737 252         242 $th = NORMALIZATION_ANGLE( $th + $ang );
738              
739 252         207 return($th);
740             }
741              
742             #=========================================================================
743             # 年月日、時分秒(世界時)からユリウス日(JD)を計算する
744             #
745             # ※ この関数では、グレゴリオ暦法による年月日から求めるものである。
746             # (ユリウス暦法による年月日から求める場合には使用できない。)
747             #=========================================================================
748             sub YMDT2JD
749             {
750 8     8 0 10 my ($year,$month,$day,$hour,$min,$sec) = @_;
751 8         7 my ($jd,$t);
752              
753 8 100       24 if( $month < 3.0 ){
754 4         8 $year -= 1.0;
755 4         5 $month += 12.0;
756             }
757              
758 8         18 $jd = int( 365.25 * $year );
759 8         16 $jd += int( $year / 400.0 );
760 8         14 $jd -= int( $year / 100.0 );
761 8         13 $jd += int( 30.59 * ( $month-2.0 ) );
762 8         9 $jd += 1721088;
763 8         11 $jd += $day;
764              
765 8         12 $t = $sec / 3600.0;
766 8         8 $t += $min /60.0;
767 8         7 $t += $hour;
768 8         8 $t = $t / 24.0;
769              
770 8         5 $jd += $t;
771              
772 8         10 return( $jd );
773              
774             }
775              
776             #=========================================================================
777             # ユリウス日(JD)から年月日、時分秒(世界時)を計算する
778             #
779             # 戻り値の配列TIME[]の内訳
780             # TIME[0] ... 年 TIME[1] ... 月 TIME[2] ... 日
781             # TIME[3] ... 時 TIME[4] ... 分 TIME[5] ... 秒
782             #
783             # ※ この関数で求めた年月日は、グレゴリオ暦法によって表されている。
784             #
785             #=========================================================================
786             sub JD2YMDT
787             {
788              
789 8     8 0 8 my ($JD) = @_;
790 8         8 my (@TIME,$x0,$x1,$x2,$x3,$x4,$x5,$x6,$tm);
791              
792 8         9 $x0 = int( $JD+68570.0);
793 8         8 $x1 = int( $x0/36524.25 );
794 8         11 $x2 = $x0 - int( 36524.25*$x1 + 0.75 );
795 8         9 $x3 = int( ( $x2+1 )/365.2425 );
796 8         19 $x4 = $x2 - int( 365.25*$x3 )+31.0;
797 8         11 $x5 = int( int($x4) / 30.59 );
798 8         9 $x6 = int( int($x5) / 11.0 );
799              
800 8         12 $TIME[2] = $x4 - int( 30.59*$x5 );
801 8         9 $TIME[1] = $x5 - 12*$x6 + 2;
802 8         10 $TIME[0] = 100*( $x1-49 ) + $x3 + $x6;
803              
804             # 2月30日の補正
805 8 50 33     21 if($TIME[1]==2 && $TIME[2] > 28){
806 0 0 0     0 if($TIME[0] % 100 == 0 && $TIME[0] % 400 == 0){
    0          
807 0         0 $TIME[2]=29;
808             }elsif($TIME[0] % 4 ==0){
809 0         0 $TIME[2]=29;
810             }else{
811 0         0 $TIME[2]=28;
812             }
813             }
814              
815 8         13 $tm=86400.0*( $JD - int( $JD ) );
816 8         11 $TIME[3] = int( $tm/3600.0 );
817 8         16 $TIME[4] = int( ($tm - 3600.0*$TIME[3])/60.0 );
818 8         32 $TIME[5] = int( $tm - 3600.0*$TIME[3] - 60*$TIME[4] );
819              
820 8         27 return(@TIME);
821             }
822              
823             #=========================================================================
824             # 今日が24節気かどうか調べる
825             #
826             # 引数  .... 計算対象となる年月日 $year $mon $day
827             #
828             # 戻り値 .... 24節気の名称
829             #
830             #=========================================================================
831             sub check_24sekki
832             {
833 0     0 0   my ($year,$mon,$day) = @_;
834 0           my ($tm1,$tm2,$t,$rm_sun_today,$rm_sun_today0,$rm_sun_tommorow,$rm_sun_tommorow0);
835              
836             #-----------------------------------------------------------------------
837             # 24節気の定義
838             #-----------------------------------------------------------------------
839 0           my (@sekki24) = ("春分","清明","穀雨","立夏","小満","芒種","夏至","小暑","大暑","立秋","処暑","白露",
840             "秋分","寒露","霜降","立冬","小雪","大雪","冬至","小寒","大寒","立春","雨水","啓蟄");
841              
842 0           my $tm = YMDT2JD($year,$mon,$day,0,0,0);
843              
844             #-----------------------------------------------------------------------
845             #時刻引数を分解する
846             #-----------------------------------------------------------------------
847 0           $tm1 = int( $tm );
848 0           $tm2 = $tm - $tm1;
849 0           $tm2-=9.0/24.0;
850 0           $t=($tm2+0.5) / 36525.0;
851 0           $t=$t + ($tm1-2451545.0) / 36525.0;
852              
853             #今日の太陽の黄経
854 0           $rm_sun_today = LONGITUDE_SUN( $t );
855              
856 0           $tm++;
857 0           $tm1 = int($tm);
858 0           $tm2 = $tm - $tm1;
859 0           $tm2-=9.0/24.0;
860 0           $t=($tm2+0.5) / 36525.0;
861 0           $t=$t + ($tm1-2451545.0) / 36525.0;
862              
863             #明日の太陽の黄経
864 0           $rm_sun_tommorow = LONGITUDE_SUN($t);
865              
866             #
867 0           $rm_sun_today0 = 15.0 * int($rm_sun_today / 15.0);
868 0           $rm_sun_tommorow0 = 15.0 * int($rm_sun_tommorow / 15.0);
869              
870 0 0         if($rm_sun_today0 != $rm_sun_tommorow0){
871 0           return($sekki24[$rm_sun_tommorow0 / 15]);
872             }else{
873 0           return('');
874             }
875             }
876              
877             1;