10 '  SAVE"B:ninni",A
20 '  SAVE"B:ninni.CPY",A
30 '********************************************************************
40 '**** 任意の日における地軸の傾きと昼の長さ夜の長さ南中時刻の変化 ****
50 '****     1990年2月           山田  洋                           ****
60 '********************************************************************
70 SCREEN 3:CONSOLE 0,25,0,1:WIDTH 80,20:CLS 3:COLOR 7
80 DEFINT I-M
90 DEFDBL A-H,J-Z
100 DEFINT I
110 DEF FNF(TH)=1/(1+E*COS(TH))^2
120 DIM X(10,10),W(10,10)
130 DIM TG(12)
140 DIME=(((180+7)\8)*180*3+4)\4+1
150 DIM T%(DIME),TT%(DIME)
160 DIM XDD(200),YDD(200),CH(256)
170 GOSUB *FKEYNUL
180 'ON STOP GOSUB *MENU:STOP ON
190 ON KEY GOSUB *F1,*F2,*F3,*F4,*F5,*F6,*F7,*F8,*F9,*F10
200 FOR I=1 TO 10:KEY(I) ON:NEXT I
210 LOCATE 5,0:COLOR 6
220 PRINT"      ***** 任意の日における地軸の傾きと昼の長さ夜の長さの変化 *****":COLOR 7
230 PAY=3.141592653589793#
240 TH$="0":PH$="0":PK$="0":GATU$="1":HINITI$="1" ' 地軸の傾き、緯度、経度、月日の初期値　　　　　　　　　　　　　　
250 IFLAG1=1:IFLAG2=1:IFLAG3=1:IFLAG4=1           '始めは全て入力させる
260 IFLAG5=1                                      '始めは楕円軌道で解く
270 IFLAG6= 1:IFLAG7= 1:IFLAG8= 1:IFLAG9= 1       '始めは拡大図を書く
280 ICONT7=-1:ICONT8=-1:ICONT9=-1    'F7,F8,F9 は実行していない
290  HTILE$=CHR$(&H55)+CHR$(&HFF)+CHR$(&HFF)   '薄黄色
300  'YTILE$=CHR$(&H55)+CHR$(&H55)+CHR$(&H55)  '灰色
310  YTILE$=CHR$(&HAA)+CHR$(&H0)+CHR$(&H0)     '暗青色
320 GOSUB *CH
330 GOSUB *GAUSSP
340 GOSUB *WAKUSEIDATA
350 GOSUB *SETFKEY
360 '
370 '**** ω(e) を求める ****
380 AL=0:BE=2!*PAY:GOSUB *GAUSSEKIBUN:OMEGA=S/TK
390  '**** 近日点の冬至からはかったずれ角 ****
400  OMT=-OMEGA*TKINJT:GOSUB *EXACT:ALFA=-X
410 '
420 X0SUN=440:Y0SUN=110  '太陽の中心
430 RSUN=30              '太陽の半径
440 RKOUTE=140           '惑星の公転半径
450 RHIRIT=.3#            '公転軌道半径のＹ軸のＸ軸に対する比率
460 IFLAG=1               '初めて描くかどうかの判断のため
470 WKX0=240:WKY0=18            '   公転軌道図の枠の始点
480 WKXL=399:WKYL=180           '   公転軌道図の枠の長さ
490 '
500 YKX0=240:YKY0=198           '   公転軌道横図の枠の始点
510 YKXL=199:YKYL=164           '   公転軌道横図の枠の長さ
520 '
530 UEX0=440:UEY0=198           '   公転軌道上図の枠の始点
540 UEXL=199:UEYL=164           '   公転軌道上図の枠の長さ
550 '
560 '
570 GOSUB *NYUURYOKU
580      TN1=12                '南中時刻の初期値は１２時
590      HINITI=HINIT0+TN1/TJ  '観測日時の初期値を南中時刻に近い正午にする
600      II=1
610        GOSUB *KEISAN
620      IF ABS(TN1-TNANTU)<1D-006 OR II=10 THEN 670
630      TN1=TNANTU
640      HINITI=HINIT0+TN1/TJ
650      II=II+1
660      GOTO 610
670  '-------  経度による補正  ----------
672  D0=.5#*(HYOUJI-PK)*TJ/180:TNANTU=TNANTU+D0
674  HINODE=TNANTU-HIRU/2
676  HINOIR=TNANTU+HIRU/2
678 TIME=HIRU:GOSUB *TFUN:HIRUJ=JI:HIRUF=FUN
680 TIME=YORU:GOSUB *TFUN:YORUJ=JI:YORUF=FUN
682 TIME=HINODE:GOSUB *TFUN:HIDEJ=JI:HIDEF=FUN
684 TIME=HINOIR:GOSUB *TFUN:HIIRJ=JI:HIIRF=FUN
686 TIME=TNANTU:GOSUB *TFUN:NANTJ=JI:NANTF=FUN
688 HIRUHI=HIRU/TJ:YORUHI=1-HIRUHI
690 IF IFLAG=2 THEN 720
692 GOSUB *MESSEAGE
694 LINE(WKX0,WKY0)-STEP(WKXL,WKYL),7,B     '  公転軌道図の枠
700 '
710 '
720 '======== 公転している時の図 =========
730 ICONT9=1
740 TR=18                 '地球半径
750 TL=1.3#*TR             '地軸の長さ　　　　　　　　　　　
760 IF  IFLAG=1 OR IFLAG9=1 THEN 820
770 '------------- 地球を消す -----------------
780 WX1=-X0B:WY1=-Y0B:WX2=639-X0B:WY2=399-Y0B 'ワ−ルド座標
790 WINDOW(WX1,WY1)-(WX2,WY2)             'N88BASIC用
800 PUT@(MAP(-TL-8,0),MAP(-TL-8,1)),T%,PSET '地球を消す
810 '------------ 地球を描く -------------------
820 NZ$="KOUTEN"
830 X0=X0SUN-RKOUTE*COS(HIR):Y0=Y0SUN+RKOUTE*RHIRIT*SIN(HIR)   ' 画面の中心位置
840 WX1=-X0:WY1=-Y0:WX2=639-X0:WY2=399-Y0 'ワ−ルド座標
850 'WINDOW(WX1,WY1/.899)-(WX2,WY2/.899)   'FM-BASIC98用
860 WINDOW(WX1,WY1)-(WX2,WY2)             'N88BASIC用
870 GET@ (MAP(-TL-8,0) ,MAP(-TL-8,1))-STEP(2*TL+16,2*TL+16),T%
880 GOSUB *TIKYUU
890 GET@ (MAP(-TL-8,0) ,MAP(-TL-8,1))-STEP(2*TL+16,2*TL+16),TT%
900 X0B=X0:Y0B=Y0                '地球の中心座標を覚えておく
910 ICONT9=-1
920 '======== 計算数値，グラフ表示 =======
930 IF IFLAG6=-1 THEN 1000
940 ICONT6=1
950 '計算表示枠の左隅（ワード単位）
960 NXW=0                  :NYW=15
970  XHYOU=NXW*16:YHYOU=NYW*20 '計算表示枠の左隅（ドット単位）
980 IF IFLAG=1 THEN GOSUB *KEISANHYOUJI ELSE GOSUB *SUUHYOUJI
990 ICONT6=-1
1000 '======== 公転面の横から見た地球の拡大図 ===============
1010 IF IFLAG7=-1 THEN 1150
1020 ICONT7=1
1030 NZ$="KAKUDAI"
1040 X0=340         :Y0=290        '画面の中心位置
1050 WX1=-X0:WY1=-Y0:WX2=639-X0:WY2=399-Y0 'ワ−ルド座標
1060 'WINDOW(WX1,WY1/.899)-(WX2,WY2/.899)   'FM-BASIC98用
1070 WINDOW(WX1,WY1)-(WX2,WY2)             'N88BASIC用
1080 TR=50                 '地球半径
1090 TL=1.3#*TR             '地軸の長さ　　　　　　　　　　　
1100 IF IFLAG<>1 THEN LINE(-TL-8 ,-TL-8 )-(TL+8 ,TL   ),0,BF:GOTO 1130'地球を消す
1110 LINE (MAP(YKX0,2),MAP(YKY0+1,3))-STEP(YKXL,YKYL),7,B
1120 LOCATE (X0-TL-24)/8+1 ,(Y0-TL-28)/20:PRINT"公転面の横から見た図"
1130 GOSUB *TIKYUU
1140 ICONT7=-1
1150 '======== 地軸の真上から見た地球の拡大図 ============
1160 IF IFLAG8=-1 THEN 1300
1170 ICONT8=1
1180 NZ$="UE"
1190 X0=540  :Y0=290                       '画面の中心位置
1200 WX1=-X0:WY1=-Y0:WX2=639-X0:WY2=399-Y0 'ワ−ルド座標
1210 'WINDOW(WX1,WY1/.899)-(WX2,WY2/.899)   'FM-BASIC98用
1220 WINDOW(WX1,WY1)-(WX2,WY2)             'N88BASIC用
1230 TR=50                 '地球半径
1240 TL=1.3#*TR             '地軸の長さ　　　　　　　　　　　
1250 IF IFLAG<>1 THEN LINE(-TL-8 ,-TL-8 )-(TL+8 ,TL   ),0,BF:GOTO 1280'地球を消す
1260 LINE (MAP(UEX0,2),MAP(UEY0+1,3))-STEP(UEXL,UEYL),7,B
1270 LOCATE (X0-TL-24)/8+1 ,(Y0-TL-28)/20:PRINT"地軸の真上から見た図"
1280 GOSUB *UETIKYUU
1290 ICONT8=-1
1300 'IFLAG=1    ' ゲット、プットを使わずに再び描く（遅いけど見た目に良い）
1310  IFLAG=2    ' ゲット、プットを使う            （早いけどちらつく    )
1320 GOTO 550
1330 END
1340 '
1350 *MENU
1360 STOP OFF
1370 FOR I=1 TO 10:KEY(I) OFF:NEXT I
1380 GOSUB *FKEY0
1390 COLOR 7:RUN"MENU"
1400 RETURN
1410 '
1420 *MESSEAGE
1430 WINDOW(0,0)-(639,399)             'N88BASIC用
1440 CIRCLE (X0SUN,Y0SUN),RSUN,7                 '太陽
1450 'TAIYO$=CHR$(&H55)+CHR$(&HFF)+CHR$(&HFF)     '太陽の色（薄黄色）
1460 TAIYO$=HTILE$
1470 PAINT(X0SUN,Y0SUN),TAIYO$,7
1480 LOCATE X0SUN\8-2,Y0SUN\20 :COLOR 0:PRINT"太陽":COLOR 7
1490 CIRCLE(X0SUN,Y0SUN),RKOUTE,7,,,RHIRIT
1500 LOCATE INT(X0SUN-RKOUTE   )\8-5,INT(Y0SUN)\20:PRINT "冬"
1510 LOCATE INT(X0SUN+RKOUTE   )\8+5,INT(Y0SUN)\20:PRINT "夏"
1520 LOCATE INT(X0SUN   )\8-1,INT(Y0SUN+RKOUTE*RHIRIT)\20+2:PRINT "春"
1530 LOCATE INT(X0SUN   )\8-1,INT(Y0SUN-RKOUTE*RHIRIT)\20-2:PRINT "秋"
1540 RETURN
1550 *TIKYUU
1560 GOSUB *TIKYUUSHOKI
1570 GOSUB *TIJIKU
1580 GOSUB *SEKIDOU
1590 GOSUB *JITENITI
1600 RETURN
1610 *UETIKYUU
1620 CIRCLE(0,0),TR,7
1630 EL=TR*SIN(THR)
1640 KCOLOR=2:KANJIN=&H4E   '1/4角N      北半球の場合
1650 IF PHR<0 THEN EL=-EL:KCOLOR=7:KANJIN=&H53     '1/4角S   南半球の場合
1660 IF HIR=0 OR HIR=1.5#*PAY THEN X1=EL:Y1=SQR(TR*TR-EL*EL):LINE(X1,-Y1)-(-X1,Y1),7:GOTO 1800
1670 TAN1=TAN(HIR)
1680 TAN2=1!+TAN1*TAN1
1690 SQRTAN=SQR(TR*TR*TAN2-EL*EL)
1700 '****** 昼と夜の堺目の線と赤道の交点 (X1,Y1) , (X2,Y2) ******
1710 X1=(EL+ABS(TAN1)*SQRTAN)/TAN2
1720 X2=(EL-ABS(TAN1)*SQRTAN)/TAN2
1730 IF TAN1<0 THEN 1770
1740 Y1=(EL*TAN1-SQRTAN)/TAN2
1750 Y2=(EL*TAN1+SQRTAN)/TAN2
1760 GOTO 1790
1770 Y1=(EL*TAN1+SQRTAN)/TAN2
1780 Y2=(EL*TAN1-SQRTAN)/TAN2
1790 LINE(X1,-Y1)-(X2,-Y2),7             '昼と夜の堺の線
1800 PHIRUX=.5#*(.5#*(X1+X2)+TR*COS(HIR))  'ペインティングポイント（昼Ｘ座標）
1810 PHIRUY=.5#*(.5#*(Y1+Y2)+TR*SIN(HIR))  '　　〃                （昼Ｙ座標）
1820 PYORUX=.5#*(.5#*(X1+X2)-TR*COS(HIR))  '    〃                （夜Ｘ座標）
1830 PYORUY=.5#*(.5#*(Y1+Y2)-TR*SIN(HIR))  '    〃                （夜Ｙ座標）
1840 PAINT(PHIRUX,-PHIRUY),HTILE$,7
1850 PAINT(PYORUX,-PYORUY),YTILE$,7
1860 CIRCLE(0,0),TR,2                '赤道
1870 CIRCLE(0,0),TR*COS(PHR),4       '自転位置
1880 'CIRCLE(0,0),TR*COS(PHR)-.5#,4     '自転位置
1890 CIRCLE(0,0),1.3#,0,,,,F:CIRCLE(0,0),.2#,7,,,,F:'地軸
1900 PUT@ (MAP(0,0),MAP(-10,1)),KANJI(KANJIN),,KCOLOR,0  '極表示
1910 RETURN
1920 *SUUHYOUKESI
1930 '****** 計算表示枠を消す ********
1940 NXL=13.5#:NYL=2           '計算表示枠の長さ（ワード単位）
1950 XWAKU=NXL*16:YWAKU=NYL*20 '計算表示枠の長さ
1960 LINE (MAP(XHYOU,2),MAP(YHYOU+20,3))-STEP(XWAKU,YWAKU),0,BF    '数表枠消し
1970 LINE(MAP(0,2),MAP(10*20-2,3))-(MAP(13*16,2),MAP(14*20+2,3)),0,BF
1980 LINE (MAP(XHYOU+16,2),MAP(YHYOU+20-16,3))-STEP(XWAKU  ,16),0,BF '目盛消し
1990 LOCATE 3*NXW,NYW-5:PRINT"                        "              '数値消し
2000 LOCATE 3*NXW,NYW-4:PRINT"                        "              '数値消し
2010 LOCATE 3*NXW,NYW-3:PRINT"                        "              '数値消し
2020 LOCATE 3*NXW,NYW-2:PRINT"                        "              '数値消し
2030 LOCATE 2*NXW,NYW+1:PRINT"               "                       '数値消し
2040 LOCATE 2*NXW,NYW+2:PRINT"               "                       '数値消し
2050 RETURN
2060 *YOKOKESI
2070 '******  横図を消す **********
2080 TR=50                 '地球半径
2090 TL=1.3#*TR             '地軸の長さ　　　　　　　　　　　
2100  X0=340         :Y0=290        '画面の中心位置
2110 LINE(MAP(YKX0,2),MAP(YKY0+1,3))-STEP(YKXL,YKYL),0,BF
2120 LOCATE (X0-TL-24)/8+1 ,(Y0-TL-28)/20:PRINT"                    "
2130 RETURN
2140 *UEKESI
2150 '******  上図を消す **********
2160 TR=50                 '地球半径
2170 TL=1.3#*TR             '地軸の長さ　　　　　　　　　　　
2180  X0=540         :Y0=290        '画面の中心位置
2190 LINE(MAP(UEX0,2),MAP(UEY0+1,3))-STEP(UEXL,UEYL),0,BF
2200 LOCATE (X0-TL-24)/8+1 ,(Y0-TL-28)/20:PRINT"                    "
2210 RETURN
2220 *NYUURYOKU
2230 IF IFLAG<>1 THEN *INPTIJIKU
2240 NYUUX0=0:NYUUY0=2   '入力領域の左隅（ワード単位）
2250 NYUUXL=10:NYUUYL=3  '入力領域の枠の長さ（ワード単位）
2260 CLNYUU=7            '入力領域の枠の色
2270 LINE(MAP(16*NYUUX0,2),MAP(20*NYUUY0,3))-STEP(16*NYUUXL,20*NYUUYL),CLNYUU,B
2280 LINE(MAP(16*NYUUX0,2),MAP(20*NYUUY0+  20*NYUUYL/3,3))-STEP(16*NYUUXL,0),CLNYUU
2290 LINE(MAP(16*NYUUX0,2),MAP(20*NYUUY0+2*20*NYUUYL/3,3))-STEP(16*NYUUXL,0),CLNYUU
2300 LOCATE NYUUX0,NYUUY0:  PRINT " 地軸の傾き = "
2310 LOCATE NYUUX0,NYUUY0+1:PRINT " 緯度　　　 = "
2320 LOCATE NYUUX0,NYUUY0+2:PRINT " 経度　　　 = "
2330 XINP0=2*(NYUUX0+7):YINP0=NYUUY0
2340 '=======  地軸の傾き入力 ===========================
2350 *INPTIJIKU
2360 COLOR 7
2370 INPFLG=1
2380 IF IFLAG1=-1 THEN GOTO *INPIDO
2390 X=XINP0:Y=YINP0
2400 '----- RETURNｷ- を押した時には同じ値が入る。--------
2410 GOSUB *INPUTT:IF N$<>"" THEN TH=VAL(N$) ELSE *THRETURN
2420 LOCATE X,Y:PRINT "                                   "
2430 TH$=N$
2440 *THRETURN
2450 TH=VAL(TH$):IF TH$="" THEN TH$="0"
2460 LOCATE X,Y:PRINT TH$
2470 IF TH=90 THEN TH=89.9999#
2480 IF TH=-90 THEN TH=-89.9999#
2490 THR=TH*PAY/180
2500 '========  緯度の入力 ================================
2510 *INPIDO
2520 COLOR 7
2530 INPFLG=2
2540 IF IFLAG2=-1 THEN GOTO *INPKEIDO
2550 X=XINP0:Y=YINP0+1
2560 '----- RETURNｷ- を押した時には同じ値が入る。--------
2570 GOSUB *INPUTT:IF N$<>"" THEN PH=VAL(N$) ELSE *PHRETURN
2580 LOCATE X,Y:PRINT "                                   "
2590 IF ABS(PH)>90 THEN GOTO 2570
2600 PH$=N$
2610 *PHRETURN
2620 PH=VAL(PH$):IF PH$="" THEN PH$="0"
2630 LOCATE X,Y:PRINT PH$
2640 IF PH=90 THEN PH=89.9999#
2650 IF PH=-90 THEN PH=-89.9999#
2660 PHR=PH*PAY/180
2670 '========  経度の入力 ================================
2680 *INPKEIDO
2690 COLOR 7
2700 INPFLG=3
2710 IF IFLAG3=-1 THEN GOTO *INPGAPPI
2720 X=XINP0:Y=YINP0+2
2730 '----- RETURNｷ- を押した時には同じ値が入る。--------
2740 GOSUB *INPUTT:IF N$<>"" THEN PK=VAL(N$) ELSE *PKRETURN
2750 LOCATE X,Y:PRINT "                                   "
2760 IF ABS(PK)>180 THEN GOTO 2740
2770 PK$=N$
2780 *PKRETURN
2790 PK=VAL(PK$):IF PK$="" THEN PK$="0"
2800 LOCATE X,Y:PRINT PK$
2810 PKR=PK*PAY/180
2820 '====== 月日入力 ====================================
2830 *INPGAPPI
2840 COLOR 7
2850 INPFLG=4
2860 IF IFLAG4=-1 THEN 3150
2870 XGP=1:YGP=5   '月日入力の位置
2880 X=XGP:Y=YGP
2890 IF IFLAG<>1 THEN Y=YGP+1:GOTO 2930
2900 LOCATE 0,Y  :COLOR 7:PRINT"観測の月日"
2910 Y=YGP+1
2920 LOCATE 0,Y:COLOR 7:PRINT"   月   日"
2930 COLOR 6
2940 '------ RETURNｷ- を押した時には同じ値が入る。--------
2950 GOSUB *INPUTT:IF N$<>"" THEN GATU=VAL(N$) ELSE *GATURETURN
2960 IF GATU>=1 AND GATU<=12 THEN 3000
2970 LOCATE 0,Y:COLOR 7:PRINT"   月";
2980 IF IFLAG=1 THEN PRINT "   日      " ELSE COLOR 6:PRINT USING" &&";HINITI$;:COLOR 7:PRINT "日      "
2990 GOTO 2930
3000 GATU$=N$
3010 *GATURETURN
3020 IF GATU$="" THEN GATU$="1":GATU=1
3030 GATU=VAL(GATU$):LOCATE 0,Y:COLOR 6:PRINT USING" &&";GATU$:COLOR 7
3040 IF IFLAG4=-1 THEN 3160
3050 X=XGP+5
3060 COLOR 6
3070 '----- RETURNｷ- を押した時には同じ値が入る。--------
3080 GOSUB *INPUTT:IF N$<>"" THEN HINITI=VAL(N$):HINIT0=HINITI ELSE *NITIRETURN
3090 IF HINITI<1 OR HINITI>31 THEN LOCATE X,Y:COLOR 7:PRINT"  日      ":GOTO 3060
3100 COLOR 7
3110 HINITI$=N$
3120 *NITIRETURN
3130 HINITI=VAL(HINITI$):HINIT0=HINITI:IF HINITI$="" THEN HINITI$="1":HINITI=1:HINIT0=1
3140 LOCATE 0,Y:COLOR 6:PRINT USING" &&";GATU$;:COLOR 7:PRINT "月";:COLOR 6:PRINT USING" &&";HINITI$;:COLOR 7:PRINT "日"
3150 IF IFLAG1=-1 AND IFLAG2=-1 AND IFLAG3=-1 AND IFLAG4=-1 THEN GOSUB *F1:GOTO      2350           '入力が選ばれなかった時の処理
3160 RETURN
3170 *TIKYUUSHOKI
3180 CIRCLE(0,0),TR,7,,,,F,0                      '地球の外枠
3190 'IF HIR=0 OR HIR=PAY OR HIR=2*PAY THEN LINE(0,-TR)-(0,TR),7:GOTO 3240
3191 IF ABS(SIN(HIR))<2/TR THEN LINE(0,-TR)-(0,TR),7:GOTO 3240
3200 IF HIR>=0  AND HIR<.5#*PAY THEN CIRCLE(0,0),TR,7,1.5#*PAY, .5#*PAY,ABS(1/SIN(HIR)):PP=1:GOTO 3240      '日向と日影の堺目
3210 IF HIR>=.5# AND HIR<    PAY THEN CIRCLE(0,0),TR,7, .5#*PAY,1.5#*PAY,ABS(1/SIN(HIR)):PP=-1:GOTO 3240      '日向と日影の堺目
3220 IF HIR>=PAY AND HIR<1.5#*PAY THEN CIRCLE(0,0),TR,7,1.5#*PAY, .5#*PAY,ABS(1/SIN(HIR)):PP=-1:GOTO 3240      '日向と日影の堺目
3230 IF HIR>=1.5#*PAY AND HIR<2*PAY THEN CIRCLE(0,0),TR,7, .5#*PAY,1.5#*PAY,ABS(1/SIN(HIR)):PP=1                '日向と日影の堺目
3240 A1=.5#*TR*(1!+PP*SIN(HIR)):A2=A1-TR
3250 IF HIR>=.5#*PAY AND HIR< 1.5#*PAY THEN LTILE$=HTILE$:RTILE$=YTILE$ ELSE LTILE$=YTILE$:RTILE$=HTILE$
3260 IF A2+TR>=1 THEN PAINT(A2,0),LTILE$,7
3270 IF TR-A1>=1 THEN PAINT(A1,0),RTILE$,7
3280 RETURN
3290 '
3300 *TIJIKU
3310 '*******    地軸を描く   ********
3320 TLX1=TL*SIN(THR):TLY1=TL*COS(THR)
3330 TLX2=TR*SIN(THR):TLY2=TR*COS(THR)
3340 LINE(-TLX1,-TLY1)-(-TLX2,-TLY2),7
3350 LINE(TLX1,TLY1)-(TLX2,TLY2),7
3360  KANJIN=&H4E    '半角N
3370 'KANJIN=&H14E   '1/4角N
3380 'KANJIN=&H234E   '全角Ｎ
3390 PUT@ (MAP(-TLX1,0),MAP(-TLY1-8,1)),KANJI(KANJIN),,2,0  'Ｎ極表示
3400  KANJIS=&H53    '半角S
3410 'KANJIS=&H153   '1/4角S
3420 'KANJIS=&H2353   '全角Ｓ
3430 PUT@ (MAP(TLX1,0),MAP(TLY1-8,1)),KANJI(KANJIS),,7,0    'Ｓ極表示
3440 '********************************
3450 RETURN
3460 *SEKIDOU
3470 R=TR                  '楕円の長径
3480 GYOUKA=0             '仰角
3490 XX0=0:YY0=0           '傾いていない時の楕円の中心
3500 CLD=2                 '楕円の色
3510 'GOSUB *DAEN
3520 XL=TR*COS(THR):YL=TR*SIN(THR):LINE(-XL,YL)-(XL,-YL),CLD
3530 RETURN
3540 *JITENITI
3550 R=TR*COS(PHR)         '楕円の長径
3560 L=5*TR                'みる位置から楕円の中心までの距離
3570 'GYOUKA=ATN(R/L*SIN(PHR)*ABS(COS(THR))/(1-R/L*COS(PHR)))    '仰角
3580 GYOUKA=ATN(R/L*SIN(PHR)              /(1-R/L*COS(PHR)))    '仰角
3590 'GYOUKA=0
3600 XX0=0:YY0=TR*SIN(PHR) '傾いていない時の楕円の中心
3610 CLD=4                 '楕円の色
3620 GOSUB *DAEN
3630 RETURN
3640 *DAEN
3650 NS=20 ' 描くドット数
3660 TRDD=R*SIN(GYOUKA)
3670 FOR IS.=0 TO NS
3680 HR=PAY*IS./NS
3690 XX=R*COS(HR)+XX0:YY=TRDD*SIN(HR)+YY0
3700 '********（地軸の傾きによる回転変換）********
3710 XXX=XX*COS(THR)-YY*SIN(THR)
3720 YYY=XX*SIN(THR)+YY*COS(THR)
3730 XDD(IS.)=XXX:YDD(IS.)=YYY
3740 NEXT IS.
3750 *DAEN2
3760 FOR IS.=1 TO NS
3770 LINE(XDD(IS.-1),-YDD(IS.-1))-(XDD(IS.),-YDD(IS.)),CLD
3780 LINE(XDD(IS.-1),-YDD(IS.-1)+1)-(XDD(IS.),-YDD(IS.)+1),CLD
3790 NEXT IS.
3800 RETURN
3810 *KEISANHYOUJI
3820 COLOR 7
3830 NXL=13.5#:NYL=2            '計算表示枠の長さ（ワード単位）
3840 XWAKU=NXL*16:YWAKU=NYL*20 '計算表示枠の長さ
3850 CLWAKU=5                  '計算表示枠の色
3860 '****** 計算表示枠を描く ********
3870 GL=5.5# '棒グラフの長さ（ワード単位）
3880 GH=.2#   '棒グラフの巾（ワード単位）
3890 LINE (MAP(XHYOU,2),MAP(YHYOU+20,3))-STEP(XWAKU,YWAKU),CLWAKU,B
3900 LINE (MAP(XHYOU,2),MAP(YHYOU+20+.5#*YWAKU,3))-STEP(XWAKU,0),CLWAKU,B
3910 LINE (MAP(XHYOU+XWAKU-16*GL,2),MAP(YHYOU+YWAKU-20,3))-STEP(0,40),CLWAKU,B
3920 LOCATE 2*NXW,NYW+1:PRINT" 昼   時間  分"
3930 LOCATE 2*NXW,NYW+2:PRINT" 夜   時間  分"
3940 '**** グラフの目盛り ****
3950 LINE (MAP(XHYOU+XWAKU-8*GL+1,2),MAP(YHYOU+20,3))-STEP(0,-3),CLWAKU,B
3960 PUT@ (XHYOU+XWAKU-8*GL-8,YHYOU+ 5),KANJI(&H31),,7,0  '1/4角 1
3970 PUT@ (XHYOU+XWAKU-8*GL  ,YHYOU+ 5),KANJI(&H32),,7,0  '1/4角 2
3980 LINE (MAP(XHYOU+XWAKU,2),MAP(YHYOU+20,3))-STEP(0,-3),CLWAKU,B
3990 PUT@ (XHYOU+XWAKU-8,YHYOU+ 5),KANJI(&H32),,7,0  '1/4角 2
4000 PUT@ (XHYOU+XWAKU    ,YHYOU+ 5),KANJI(&H34),,7,0  '1/4角 4
4010 LINE(MAP(0,2),MAP(10*20-2,3))-(MAP(13*16,2),MAP(14*20+2,3)),7,B
4020 PAINT(MAP(10,2),MAP(12*20,3)),YTILE$,7
4030 '
4040 '
4050 '***** 計算数値を書く ******
4060 *SUUHYOUJI
4070 COLOR 7
4080 LOCATE 3,NYW-5:PRINT USING"南中高度=#####.##度";PNANTU*180/PAY
4090 LOCATE 3,NYW-4:PRINT USING"南中時刻=###時###分";NANTJ,NANTF
4100 LOCATE 3,NYW-3:PRINT USING"日の出  =###時###分";HIDEJ,HIDEF
4110 LOCATE 3,NYW-2:PRINT USING"日の入り=###時###分";HIIRJ,HIIRF
4120 '
4130 COLOR 6:LOCATE 2*NXW+ 4,NYW+1:PRINT USING "##";HIRUJ
4140         LOCATE 2*NXW+10,NYW+1:PRINT USING "##";HIRUF
4150         LOCATE 2*NXW+ 4,NYW+2:PRINT USING "##";YORUJ
4160         LOCATE 2*NXW+10,NYW+2:PRINT USING "##";YORUF:COLOR 7
4170 '***** 棒グラフを描く ****
4180 '  昼の棒グラフ
4190 LINE (MAP(XHYOU+XWAKU-16*GL+1,2),MAP(YHYOU+30-.5#*20*GH,3))-STEP(GL*16-2,20*GH),0,BF
4200 GGL=(16*GL-2)*HIRUHI
4210 IF GGL<1  THEN 4250
4220 LINE (MAP(XHYOU+XWAKU-16*GL+1,2),MAP(YHYOU+30-.5#*20*GH,3))-STEP(GGL,20*GH),7,B
4230 PAINT STEP(-1,-1),HTILE$,7
4240 '  夜の棒グラフ
4250 LINE (MAP(XHYOU+XWAKU-16*GL+1,2),MAP(YHYOU+50-.5#*20*GH,3))-STEP(GL*16-2,20*GH),0,BF
4260 GGL=(16*GL-2)*YORUHI
4270 IF GGL<1 THEN 4300
4280 LINE (MAP(XHYOU+XWAKU-16*GL+1,2),MAP(YHYOU+50-.5#*20*GH,3))-STEP(GGL,20*GH),1,B
4290 PAINT STEP(-1,-1),YTILE$,1
4300 RETURN
4310 '
4320 '---------- 数値のインプット -----------
4330 *INPUTT
4340 AA$=INKEY$:IF AA$<>"" THEN 4340  'キーバッファクリア
4350 N$="":DX=0
4360 V$=""
4370 LOCATE X+DX,Y:V$=INPUT$(1)
4380 IF V$="" THEN 4370
4390 CHV=CH(ASC(V$))
4400 ON CHV GOSUB *SUU,*KETTEI,*SAKUJYO
4410 GOTO 4360
4420 *INPUTTRETURN
4430 RETURN
4440 *CH
4450 FOR I=48 TO 57:CH(I)=1:NEXT I '1,2,3,････,9 ｷｰ
4460 CH(43)=1                      '+ ｷｰ
4470 CH(45)=1                      '- ｷｰ
4480 CH(46)=1                      '. ｷｰ
4490 CH(13)=2                      'RETURN ｷｰ
4500 CH(127)=3                     'DEL ｷｰ
4510 CH(8)=3                       'BS  ｷｰ
4520 CH(27)=4                      'ESC ｷｰ
4530 RETURN
4540 *SUU
4550 N$=N$+V$
4560 LOCATE X+DX,Y:PRINT V$;:DX=DX+1
4565 'LOCATE X+DX,Y:DO:PRINT"_":LOCATE X+DX,Y:V$=INKEY$:LOOP WHILE V$=""
4570 RETURN
4580 *KETTEI
4590 RETURN 4430
4600 *SAKUJYO
4610 IF N$="" THEN RETURN
4620 LOCATE X,Y:PRINT  SPACE$(DX)
4630 DX=DX-1
4640 N$=LEFT$(N$,DX)
4650 LOCATE X,Y:PRINT N$;
4660 RETURN
4670 '
4680 '******** ファンクションキーによる割り込みサブルーチン *********
4690 *F1
4700  IFLAG1=-IFLAG1
4710  CLF=(1+IFLAG1)/2
4720  PUT@ (FAST1                   +2,401-FWAKUY),KANJI(&H434F),,7,CLF '地
4730  PUT@ (FAST1                +16+2,401-FWAKUY),KANJI(&H3C34),,7,CLF '軸
4740  IF IFLAG1=-1 AND INPFLG=1 THEN RETURN *INPUTTRETURN
4750  RETURN
4760 *F2
4770  IFLAG2=-IFLAG2
4780  CLF=(1+IFLAG2)/2
4790  PUT@ (FAST1+(FKAN+FWAKUX)     +2,401-FWAKUY),KANJI(&H305E),,7,CLF '緯
4800  PUT@ (FAST1+(FKAN+FWAKUX)  +16+2,401-FWAKUY),KANJI(&H4559),,7,CLF '度
4810  IF IFLAG2=-1 AND INPFLG=2 THEN RETURN *INPUTTRETURN
4820  RETURN
4830 *F3
4840  IFLAG3=-IFLAG3
4850  CLF=(1+IFLAG3)/2
4860  PUT@ (FAST1+(FKAN+FWAKUX)*2+   2,401-FWAKUY),KANJI(&H3750),,7,CLF '経
4870  PUT@ (FAST1+(FKAN+FWAKUX)*2+16+2,401-FWAKUY),KANJI(&H4559),,7,CLF '度
4880  IF IFLAG3=-1 AND INPFLG=3 THEN RETURN *INPUTTRETURN
4890  RETURN
4900 *F4
4910 IFLAG4=-IFLAG4
4920  CLF=(1+IFLAG4)/2
4930  PUT@ (FAST1+(FKAN+FWAKUX)*3+   2,401-FWAKUY),KANJI(&H376E),,7,CLF '月
4940  PUT@ (FAST1+(FKAN+FWAKUX)*3+16+2,401-FWAKUY),KANJI(&H467C),,7,CLF '日
4950  IF IFLAG4=-1 AND INPFLG=4 THEN RETURN *INPUTTRETURN
4960  RETURN
4970 *F5
4980 IFLAG5=-IFLAG5
4990  CLF=(1+IFLAG5)/2
5000  PUT@ (FAST1+(FKAN+FWAKUX)*4+   2,401-FWAKUY),KANJI(&H424A),,7,CLF '楕
5010  PUT@ (FAST1+(FKAN+FWAKUX)*4+16+2,401-FWAKUY),KANJI(&H315F),,7,CLF '円
5020  RETURN
5030 *F6
5040 IF ICONT7=1 OR ICONT8=1 OR ICONT9=1 THEN RETURN
5050 IFLAG6=-IFLAG6
5060 CLF=(1+IFLAG6)/2
5070 PUT@ (FAST2+(FKAN+FWAKUX)*5+2,401-FWAKUY),KANJI(&H3F74),,7,CLF   '数
5080 PUT@ (FAST2+(FKAN+FWAKUX)*5+16+2,401-FWAKUY),KANJI(&H493D),,7,CLF'表
5090 IF IFLAG=1 THEN RETURN
5100 '計算表示枠の左隅（ワード単位）
5110 ICONT6=1
5120 NXW=0:NYW=15
5130 XHYOU=NXW*16:YHYOU=NYW*20 '計算表示枠の左隅（ドット単位）
5140 IF IFLAG6=1 THEN GOSUB *KEISANHYOUJI ELSE GOSUB *SUUHYOUKESI
5150 ICONT6=-1
5160 RETURN
5170 *F7
5180 IF ICONT6=1 OR ICONT8=1 OR ICONT9=1 THEN RETURN
5190 IFLAG7=-IFLAG7
5200 CLF=(1+IFLAG7)/2
5210 PUT@ (FAST2+(FKAN+FWAKUX)*6+2,401-FWAKUY),KANJI(&H3223),,7,CLF   '横
5220 PUT@ (FAST2+(FKAN+FWAKUX)*6+16+2,401-FWAKUY),KANJI(&H3F5E),,7,CLF'図
5230 IF IFLAG=1 THEN RETURN
5240 ICONT7=1
5250 IF IFLAG7=-1 THEN GOSUB *YOKOKESI:GOTO 5350
5260 NZ$="KAKUDAI"
5270 X0=340         :Y0=290        '画面の中心位置
5280 WX1=-X0:WY1=-Y0:WX2=639-X0:WY2=399-Y0 'ワ−ルド座標
5290 WINDOW(WX1,WY1)-(WX2,WY2)             'N88BASIC用
5300 TR=50                 '地球半径
5310 TL=1.3#*TR             '地軸の長さ　　　　　　　　　　　
5320 LINE (MAP(YKX0,2),MAP(YKY0+1,3))-STEP(YKXL,YKYL),7,B
5330 COLOR 7:LOCATE (X0-TL-24)/8+1 ,(Y0-TL-28)/20:PRINT"公転面の横から見た図"
5340 GOSUB *TIKYUU
5350 ICONT7=-1
5360 RETURN
5370 *F8
5380 IF ICONT6=1 OR ICONT7=1 OR ICONT9=1 THEN RETURN
5390 IFLAG8=-IFLAG8
5400 CLF=(1+IFLAG8)/2
5410 PUT@ (FAST2+(FKAN+FWAKUX)*7+2,401-FWAKUY),KANJI(&H3E65),,7,CLF   '上
5420 PUT@ (FAST2+(FKAN+FWAKUX)*7+16+2,401-FWAKUY),KANJI(&H3F5E),,7,CLF'図
5430 IF IFLAG=1 THEN RETURN
5440 IF IFLAG8=-1 THEN GOSUB *UEKESI:GOTO 5550
5450 ICONT8=1
5460 NZ$="UE"
5470 X0=540         :Y0=290        '画面の中心位置
5480 WX1=-X0:WY1=-Y0:WX2=639-X0:WY2=399-Y0 'ワ−ルド座標
5490 WINDOW(WX1,WY1)-(WX2,WY2)             'N88BASIC用
5500 TR=50                 '地球半径
5510 TL=1.3#*TR             '地軸の長さ　　　　　　　　　　　
5520 LINE (MAP(UEX0,2),MAP(UEY0+1,3))-STEP(UEXL,UEYL),7,B
5530 COLOR 7:LOCATE (X0-TL-24)/8+1 ,(Y0-TL-28)/20:PRINT"地軸の真上から見た図"
5540 GOSUB *UETIKYUU
5550 ICONT8=-1
5560 RETURN
5570 *F9
5580 IF ICONT6=1 OR ICONT7=1 OR ICONT8=1 THEN RETURN
5590 IFLAG9=-IFLAG9
5600 CLF=(1+IFLAG9)/2
5610 PUT@ (FAST2+(FKAN+FWAKUX)*8+2,401-FWAKUY),KANJI(&H3B44),,7,CLF   '残
5620 PUT@ (FAST2+(FKAN+FWAKUX)*8+16+2,401-FWAKUY),KANJI(&H2439),,7,CLF'す
5630 IF IFLAG=1 THEN RETURN
5640 ICONT9=1
5650 TR=18                 '地球半径
5660 TL=1.3#*TR             '地軸の長さ　　　　　　　　　　　
5670 WX1=-X0B:WY1=-Y0B:WX2=639-X0B:WY2=399-Y0B 'ワ−ルド座標
5680 WINDOW(WX1,WY1)-(WX2,WY2)             'N88BASIC用
5690 IF  IFLAG9=1 THEN 5740
5700 '------------- 地球を消す -----------------
5710 PUT@(MAP(-TL-8,0),MAP(-TL-8,1)),T%,PSET '地球を消す
5720 GOTO 5760
5730 '------------- 地球を描く -----------------
5740 PUT@(MAP(-TL-8,0),MAP(-TL-8,1)),TT%,PSET '地球をプットです
5750 'GOSUB *TIKYUU                           '地球を描く
5760 ICONT9=-1
5770 RETURN
5780  *F10
5790  PUT@ (FAST2+(FKAN+FWAKUX)*9+   2,401-FWAKUY),KANJI(&H3D2A),,7,2   '終
5800  PUT@ (FAST2+(FKAN+FWAKUX)*9+16+2,401-FWAKUY),KANJI(&H246A),,7,2   'り
5810  GOSUB *MENU
5820  RETURN
5830 '
5840 '
5850 '******************** ファンクションキーの設定 ***************************
5860 *SETFKEY
5870 FAST1=9                  'ファンクションキ−枠の始め(F1-F5 )
5880 FAST2=9+48               'ファンクションキ−枠の始め(F6-F10)
5890 FWAKUX=16*2+3            'ファンクションキ−枠の横の長さ
5900 FWAKUY=20                'ファンクションキ−枠の縦の長さ
5910 FKAN=22                  'ファンクションキー枠間の長さ
5920 FOR I=1 TO 5
5930 LINE(MAP(FAST1+(FKAN+FWAKUX)*(I-1),2),MAP(399-FWAKUY,3))-STEP(FWAKUX,FWAKUY),7,B
5940 NEXT I
5950 FFAST=FAST+16
5960 FOR I=6 TO 10
5970 LINE(MAP(FAST2+(FKAN+FWAKUX)*(I-1),2),MAP(399-FWAKUY,3))-STEP(FWAKUX,FWAKUY),7,B
5980 NEXT I
5990 CLF1=(1+IFLAG1)/2
6000 CLF2=(1+IFLAG2)/2
6010 CLF3=(1+IFLAG3)/2
6020 CLF4=(1+IFLAG4)/2
6030 CLF5=(1+IFLAG5)/2
6040 CLF6=(1+IFLAG6)/2
6050 CLF7=(1+IFLAG7)/2
6060 CLF8=(1+IFLAG8)/2
6070 CLF9=(1+IFLAG9)/2
6080 FFAST=FAST1
6090 PUT@ (FFAST                   +2,401-FWAKUY),KANJI(&H434F),,7,CLF1 '地
6100 PUT@ (FFAST                +16+2,401-FWAKUY),KANJI(&H3C34),,7,CLF1 '軸
6110 PUT@ (FFAST+(FKAN+FWAKUX)     +2,401-FWAKUY),KANJI(&H305E),,7,CLF2 '緯
6120 PUT@ (FFAST+(FKAN+FWAKUX)  +16+2,401-FWAKUY),KANJI(&H4559),,7,CLF2 '度
6130 PUT@ (FFAST+(FKAN+FWAKUX)*2+   2,401-FWAKUY),KANJI(&H3750),,7,CLF3 '経
6140 PUT@ (FFAST+(FKAN+FWAKUX)*2+16+2,401-FWAKUY),KANJI(&H4559),,7,CLF3 '度
6150 PUT@ (FFAST+(FKAN+FWAKUX)*3+   2,401-FWAKUY),KANJI(&H376E),,7,CLF4 '月
6160 PUT@ (FFAST+(FKAN+FWAKUX)*3+16+2,401-FWAKUY),KANJI(&H467C),,7,CLF4 '日
6170 PUT@ (FFAST+(FKAN+FWAKUX)*4+   2,401-FWAKUY),KANJI(&H424A),,7,CLF5 '楕
6180 PUT@ (FFAST+(FKAN+FWAKUX)*4+16+2,401-FWAKUY),KANJI(&H315F),,7,CLF5 '円
6190 FFAST=FAST2
6200 PUT@ (FFAST+(FKAN+FWAKUX)*5   +2,401-FWAKUY),KANJI(&H3F74),,7,CLF6 '数
6210 PUT@ (FFAST+(FKAN+FWAKUX)*5+16+2,401-FWAKUY),KANJI(&H493D),,7,CLF6 '表
6220 PUT@ (FFAST+(FKAN+FWAKUX)*6   +2,401-FWAKUY),KANJI(&H3223),,7,CLF7 '横
6230 PUT@ (FFAST+(FKAN+FWAKUX)*6+16+2,401-FWAKUY),KANJI(&H3F5E),,7,CLF7 '図
6240 PUT@ (FFAST+(FKAN+FWAKUX)*7   +2,401-FWAKUY),KANJI(&H3E65),,7,CLF8 '上
6250 PUT@ (FFAST+(FKAN+FWAKUX)*7+16+2,401-FWAKUY),KANJI(&H3F5E),,7,CLF8 '図
6260 PUT@ (FFAST+(FKAN+FWAKUX)*8   +2,401-FWAKUY),KANJI(&H3B44),,7,CLF9 '残
6270 PUT@ (FFAST+(FKAN+FWAKUX)*8+16+2,401-FWAKUY),KANJI(&H2439),,7,CLF9 'す
6280 PUT@ (FFAST+(FKAN+FWAKUX)*9   +2,401-FWAKUY),KANJI(&H3D2A),,7,0 '終
6290 PUT@ (FFAST+(FKAN+FWAKUX)*9+16+2,401-FWAKUY),KANJI(&H246A),,7,0 'り
6300 RETURN
6310 '
6320 '
6330 '*** ファンクションキー ****
6340 *FKEY0
6350 KEY 1,"load "+CHR$(&H22):KEY 2,"auto":KEY 3,"go to":KEY 4,"list ":KEY 5,"run"+CHR$(13):KEY 6,"save "+CHR$(&H22):KEY 7,"key":KEY 8,"print ":KEY 9,"edit ."+CHR$(13):KEY 10,"cont"+CHR$(13)
6360 RETURN
6370 *FKEYNUL
6380 KEY 1,"":KEY 2,"":KEY 3,"":KEY 4,"":KEY 5,"":KEY 6,"":KEY 7,"":KEY 8,"":KEY 9,"":KEY 10,""
6390 RETURN
6400 '
6410 '
6420 '**************  数値計算　*************************
6430 *KEISAN
6440  GOSUB *GAPPI
6450  IF HI>TK THEN *MENU
6460 GOSUB *KAKUDO
6470 '====== ATN(PHAY)  (0 < PHAY < 2PAY)  ======
6480 '
6490 HIDR=ATN(TAN(HIR)/COS(THR))
6500 IF HIR>=0       AND HIR<PAY/2   THEN HIDR=ATN(TAN(HIR)/COS(THR))
6510 IF HIR>=PAY/2   AND HIR<PAY     THEN HIDR=PAY-ATN(TAN(PAY-HIR)/COS(THR))
6520 IF HIR>=PAY     AND HIR<3*PAY/2 THEN HIDR=PAY+ATN(TAN(HIR-PAY)/COS(THR))
6530 IF HIR>=3*PAY/2 AND HIR<2*PAY  THEN HIDR=2*PAY-ATN(TAN(2*PAY-HIR)/COS(THR))
6540 'PRINT"HIR=";HIR;"HIDR=";HIDR
6550 '=== TH=90　の時にはＴＡＮ（ＨＩＲ）が発散するので Ｐ＝ＰＡＹと置く ===
6560 IF TH>89.999999# AND ABS(HIR-PAY)<1D-006 THEN P=PAY:GOTO 6720
6570 '****** ATN(PHAY)    (0 < PHAY < 2PAY)  ******
6580 COSP=TAN(THR)*TAN(PHR)*COS(HIDR)
6590 IF THR>=.5#*PAY AND THR<=PAY OR THR>=-1.5#*PAY AND THR<=-.5#*PAY THEN COSP=-COSP
6600 COSPP=COSP
6610 IF HIDR>.5#*PAY AND HIDR<1.5#*PAY THEN COSPP=-COSPP
6620 IF COSP>1 THEN HIRU=0:YORU=TJ:HINODE=0:HINOIR=0:GOSUB *NANTYU:P=0:GOTO 6760
6630 IF COSP<-1 THEN HIRU=TJ:YORU=0:HINODE=0:HINOIR=0:GOSUB *NANTYU:P=2#*PAY:GOTO 6760
6640 IF COSP=0 THEN P=PAY:GOTO 6720
6650 P=2*ATN(SQR(1/(COSP*COSP)-1))
6660 IF COSPP<0 THEN P=2*PAY-P
6670 IF HIDR>=PAY/2   AND HIDR<PAY     THEN P=2*PAY-P:GOTO 6720
6680 IF HIDR>=PAY     AND HIDR<3*PAY/2 THEN P=2*PAY-P:GOTO 6720
6690 IF HIDR>=3*PAY/2 AND HIDR<2*PAY   THEN P=      P:GOTO 6720
6700 IF ABS(COSP)>1 THEN A$="ABNOMAL":RETURN ELSE A$="OK!"
6710 '---- COS(PHR)は太陽が斜めに出てくる為の効果 , 2倍は朝と夕で二倍 ----
6720 COSP2=COS(.5#*P):TANPH=TAN(PHR):DCOSP2=COSP2*COSP2:DTANPH=TANPH*TANPH
6722 '***** 南中時刻 *****
6724 GOSUB *NANTYU
6730 FACTSQ=SQR((1!+DTANPH*DCOSP2)/(1!+DTANPH))
6740  HIRU=.5#*TJ*P/PAY+2!*(HOSEI1+HOSEI2)/FACTSQ
6745  IF HIRU>24# THEN HIRU=24#
6750  YORU=TJ-HIRU
6760 '****  南中高度  ****
6770 COHI=COS(HIDR):TATH=TAN(THR)
6775 IF ABS(THR) < 1D-005 THEN PNANTU = .5# * PAY - PHR:RETURN
6780 IF P<PAY OR P=PAY AND COHI>0 THEN PNANTU=ATN(1#/(TATH*COHI))-PHR:GOTO 6800
6790 PNANTU=PAY-PHR+ATN(1#/(TATH*COHI))
6800 IF PHR<0 THEN IF COHI<0 THEN PNANTU=PNANTU+PAY ELSE PNANTU=PNANTU-PAY
6910 RETURN
6920 '*****  小数点時を分に直す  *****
6930 *TFUN
6940 JI=INT(TIME)
6950 FUN=INT(60*(TIME-JI)+.5#):IF FUN=60 THEN FUN=0:JI=JI+1
6960 RETURN
6970 '**** 月日を冬至からの日にちに直す ****
6980 *GAPPI
6990 IF GATU=TOUJIG AND HINITI>=TOUJIH THEN HI=HINITI-TOUJIH:RETURN
7000 HI=TG(TOUJIG)-TOUJIH
7010 FOR I=1 TO GATU-1
7020 HI=HI+TG(I)
7030 NEXT I
7040 HI=HI+HINITI-(TOUJIJ+TOUJIF/60)/TJ
7050 'HI=HI+HINITI
7060 RETURN
7070 '*****  楕円軌道による角度  *****
7080 *KAKUDO
7090 IF IFLAG5=-1 THEN HIR=OMEGA*HI:RETURN  ' 楕円軌道オフ（円軌道）
7100 IF EA=2 THEN 7140
7110 '***** APPROXIMATION (E<<1) *******
7120 HIR=2!*E*SIN(OMEGA*(HI-TKINJT))+OMEGA*(HI-TKINJT)+ALFA
7130 RETURN
7140 '***** EXACT*******
7150 OMT=OMEGA*(HI-TKINJT):GOSUB *EXACT
7160 HIR=X+ALFA
7170 RETURN
7180 '***** 南中時刻 *****
7190 *NANTYU
7220 '-------  地軸が傾いているための南中時のずれ ------
7230 D1=.5#*(HIDR-HIR)*TJ/PAY
7240 '-------  楕円軌道をしているための南中時のずれ ------
7250 IF IFLAG5=-1 THEN D2=0:GOTO 7290
7260 HIR1=(HI-TKINJT)*2!*PAY/TK+ALFA '** 円軌道の時の回転角
7270 D2=.5#*(HIR-HIR1)*TJ/PAY         '** 円軌道と楕円軌道の差
7280 'PRINT "D1=";60*D1;"D2=";60*D2
7290 TNANTU=.5#*TJ+D1+D2
7300 RETURN
7310 *GAUSSP
7320 '**** ガウスポイント****
7330 X(1,1)=.577350269189626
7340 W(1,1)=1!
7350 X(2,1)=.861136311594053
7360 X(2,2)=.339981043584856
7370 W(2,1)=.347854845137454#
7380 W(2,2)=.652145154862546#
7390 X(3,1)=.9324695142031521
7400 X(3,2)=.661209386466265
7410 X(3,3)=.238619186083197
7420 W(3,1)=.17132449237917#
7430 W(3,2)=.360761573048139
7440 W(3,3)=.467913934572691#
7450 X(4,1)=.960289856497536
7460 X(4,2)=.796666477413627#
7470 X(4,3)=.525532409916329
7480 X(4,4)=.1834346424956498#
7490 W(4,1)=.101228536290376
7500 W(4,2)=.222381034453374
7510 W(4,3)=.313706645877887
7520 W(4,4)=.362683783378362#
7530 X(5,1)=.973906528517172
7540 X(5,2)=.8650633666889851
7550 X(5,3)=.679409568299024
7560 X(5,4)=.433395394129247#
7570 X(5,5)=.1488743389816312#
7580 W(5,1)=.0666713443086881
7590 W(5,2)=.149451349150581
7600 W(5,3)=.219086362515982
7610 W(5,4)=.269266719309996
7620 W(5,5)=.295524224714753#
7630 RETURN
7640 '****** ガウス積分 *****
7650 *GAUSSEKIBUN
7660 A=.5#*(BE-AL):B=.5#*(BE+AL)
7670 L=5
7680 S=0
7690 FOR I=1 TO L
7700 S=S+(FNF(A*X(L,I)+B)+FNF(-A*X(L,I)+B))*W(L,I)
7710 NEXT I
7720 S=A*S
7730 'PRINT "GAUSS POINT=";2*L;" SUM=";S:PRINT
7740 RETURN
7750 '*****  ニュートン法 *****
7760 *EXACT
7770 X1=0:AL=0:BE=X1:GOSUB *GAUSSEKIBUN
7780 Y1=S-OMT
7790 X2=2*PAY:AL=0:BE=X2:GOSUB *GAUSSEKIBUN
7800 Y2=S-OMT
7810 XO=(Y2*X1-Y1*X2)/(Y2-Y1)
7820 IF Y2=0 GOTO 7970
7830 M=1
7840 XM=XO:AL=0:BE=XM:GOSUB *GAUSSEKIBUN
7850 YM=S-OMT
7860 IF YM=0 GOTO 7970
7870 IF (YM*Y1)>0 GOTO 7910
7880 X2=XM
7890 Y2=YM
7900 GOTO 7930
7910 X1=XM
7920 Y1=YM
7930 XO=(Y2*X1-Y1*X2)/(Y2-Y1)
7940 IF ABS(XO-XM)<EP GOTO 7970
7950 M=M+1
7960 GOTO 7840
7970 X=XO
7980 RETURN
7990 '
8000 '
8010 '**********  惑星のデータ *************
8020 *WAKUSEIDATA
8030 '>>>>>>>>>> １９９９年のデータ <<<<<<<<<<<<<
8040 '------------------ DATA ---------------------
8050 '+++++ １９９９年　月の日にちＤＡＴＡ ++++++
8060 TG(1)=31           '　１月
8070 TG(2)=28           '　２月
8080 TG(3)=31           '　３月
8090 TG(4)=30           '　４月
8100 TG(5)=31           '　５月
8110 TG(6)=30           '　６月
8120 TG(7)=31           '　７月
8130 TG(8)=31           '　８月
8140 TG(9)=30           '　９月
8150 TG(10)=31          '１０月
8160 TG(11)=30          '１１月
8170 TG(12)=31          '１２月
8180 '------------------ DATA ---------------------
8190 '+++++++++++ 惑星のＤＡＴＡ ++++++++++++++
8200 '****　離心率　（地球）　****
8210 E=.01672          '理科年表１９９９年　天２より
8220 '**** 公転周期（日  ）*****
8230 TK=365.242          '太陽年      理科年表１９９９年　天１より
8240 '**** 自転周期（時間）*****
8250 TJ=24
8260 '**** １９９８年冬至 理科年表１９９８年　暦７より ****
8270 TOUJIG=12 '冬至の月
8280 TOUJIH=22 '冬至の日
8290 TOUJIJ=10 '冬至の時
8300 TOUJIF=56 '冬至の分
8310 '**** KINJIT;冬至から測った近日点の日にち *****
8320 '****  近日点通過日時 ････１月３日２２時　　 理科年表　歴６２より
8330 TKINJG=1     '近日点通過月
8340 TKINJH=3     '近日点通過日
8350 TKINJJ=22    '近日点通過時
8360 TKINJF=0     '近日点通過分
8370  TKINJT=TKINJH+TG(12)+(TKINJJ+TKINJF/60)/TJ-TOUJIH-(TOUJIJ+TOUJIF/60)/TJ
8380 '**** 標準時の経度 *****
8390 HYOUJI=135         ' 日本の標準時の経度（明石）
8400 '------------------ DATA ---------------------
8410 '++++++++++ 昼の長さの補正 ++++++++++++++
8420 '***** 太陽の視半径による昼の長さの補正　******
8430  HOSEI1=1.0666667#/60' 太陽の視半径＝１６' 数理天文学（渡辺敏夫著）P15
8440 'その他の原因による昼の長さの補正（大気による屈折など）
8450  HOSEI2=2.3333333#/60' 大気の屈折による補正＝３５' マイコン宇宙講座学（中野主一）P67
8460 '------------------ DATA ---------------------
8470 '***** 惑星の楕円軌道効果を入れるために *****
8480 'EA=1;ニュートン−ラプソン法を使わず近似的に解く
8490 'EA=2;ニュートン−ラプソン法を使ってＥＸＡＣＴに解く
8500 EA=2
8510 '------------------ DATA ---------------------
8520 '***** ニュートン−ラプソン法における収束値 *****
8530 EP=1E-15
8540 '------------------ DATA ---------------------
8550 RETURN