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