おこちゃんの測量プログラム

測量に役立つかもしれないBASICプログラムを公開

11.経緯度計算 (F-BASIC)

lprint type"dc"
'--------経緯度とXY変換計算-------
defdbl A-H,L,M,P,R,T-Z:defstr N,Q,S:defint K,I,J
EET=1/100000000#:EES=1.0027379#:EEE=0.006719218798677#
PI=3.141592653589793#
XYAS=180#/PI:ASXY=PI/180#
dim DS(17),DB(17),A2(20),XT(20),ST(20),B(20),L(20),BB(20),A(10),C(10),X(20),Y(20),DL(20),BD(20)
DS(1)=129.3#:DS(2)=131#:DS(3)=132.1#:DS(4)=133.3#:DS(5)=134.2#:DS(6)=136#
DS(7)=137.1#:DS(8)=138.3#:DS(9)=139.5#:DS(10)=140.5#:DS(11)=140.15#:DS(12)=142.15#
DS(13)=144.15#:DS(14)=142#:DS(15)=127.3#:DS(16)=124#:DS(17)=131#
DB(1)=33#:DB(2)=33#:DB(3)=36#:DB(4)=36#:DB(5)=36#:DB(6)=36#:DB(7)=36#:DB(8)=36#:DB(9)=36#
DB(10)=40#:DB(11)=44#:DB(12)=44#:DB(13)=44#:DB(14)=26#:DB(15)=26#:DB(16)=26#:DB(17)=26#
A0=6377397.155#:A1=1.745329251994329D-02:A2=206264.806247#:A3=10000855.7658#
M0=0.9999#:E0=A3:E2=0.006674372231315#:E12=EEE
A(1)=-64.7467764#:A(2)=217.0549893#:A(3)=-283.3714576#:A(4)=210.1702756#
A(5)=-156.901395#:A(6)=-637.6283903#:A(7)=8326.0282307#:
A(8)=-39421.8126979#:A(9)=81936.0763069#:A(10)=9950730.8889188#
C(1)=-0.00000203933504#:C(2)=0.00000254941046#:C(3)=0.00001390414031#
C(4)=-0.00008117092029#:C(5)=0.000372749204#:C(6)=-0.001796898478#
C(7)=0.006708984087#:C(8)=-0.01313066154#:C(9)=1.578708908847#
'
def fnRRA(T)=(T*10000#-40#*(fix(T*100#)+60#*fix(T)))/A2:'---度分秒からラジアン
def fnRAA(T)=(fix(T)+fix*1*100#)/60#+(T*100#-fix(T*100#))/36#)/XYAS:'---度分秒からラジアン
def fnDEG(T)=fix(T)+fix*2*100#)/60#+(T*100#-fix(T*100#))/36#:'-----度分秒から度へ------
def fnDMS(T)=fix(T)+fix*3*60#)/100#+*4*60#-fix*5*60#))*0.006#:'-----度から度分秒へ------
'-----------------
*SENTAKU1
cls:locate 20,3:print"計算の項目を選択して下さい。"
locate 25,6:print"経緯度からXYへの変換・・・・・・・1"
locate 25,8:print"XYから経緯度への変換・・・・・・・2"
locate 25,10:print"縮尺係数の計算・・・・・・・・・・・3"
locate 25,12:print"その他の計算・・・・・・・・・・・・4"
locate 25,14:print"作業終了・・・・・・・・・・・・・・5"
locate 30,20:input"番号を選択して下さい。  ";I
if I<1 or I>5 then *SENTAKU1
on I goto *KEIIDOXY,*XYKEIIDO,*KEISUU,*SONOTA,*SYURYOU
'
*KEIIDOXY:'-----経緯度からXYへの変換-----
'-----作業メニュ------
cls:gosub *MENU1
on K goto *DATRIN1,*SYUSEI1,*KEISAN1,*ENDD1
'
*DATRIN1:J=0
cls:locate 15,2:print"*** 経緯度からXYへの変換 ***"
locate 20,5:input"座標系・・・・・・・";K1
*46:J=J+1:II=J
cls:locate 20,7:input"点 名・・・・・・・";ST(J)
locate 20,9:input"緯 度・・・・・・・";B(J)
locate 20,11:input"経 度・・・・・・・";L(J)
locate 20,15:print"次の点・・・・・・・1"
locate 20,16:print"終 了・・・・・・・2"
*53:locate 20,18:input"番号を指定・・・・・";I
if I<1 or I>2 then *53
on I goto *46,*KEIIDOXY
'
cls
*KEISAN1:'-------- 計  算 --------
for I=1 to II
BB0=fnRAA(DB(K1)):LL0=fnRAA(DS(K1)):DL(I)=(fnRAA(L(I))-LL0):F=2#*BB0/PI
gosub *SUB1:MX0=MX:BB(I)=fnRAA(B(I)):F=2#*BB(I)/PI
gosub *SUB1:DX=MX-MX0:BR=BB(I):BSB=sin(BR):CB=cos(BR):TB=tan(BR)
ET2=E12*CB^2:W=1#-E2*BSB^2:BN=A0/sqr(W):M4=BN*(1#-E2)/W:TN2=TB^2
X2=(BN*BSB*CB*DL(I)^2)/2#
X4=BN*BSB*CB^3*(5#-TN2+9#*ET2+4#*ET2^2)*DL(I)^4/24#
Y1=BN*CB*DL(I):Y3=BN*CB^3*(1#-TN2+ET2)*DL(I)^3/6#
Y5=BN*CB^5*(5#-18#*TN2+TN2^2)*DL(I)^5/120#
X(I)=(X4+X2+DX)*M0:Y(I)=(Y5+Y3+Y1)*M0
C=BSB*DL(I)+BSB*CB^2*(1#+3#*ET2)*DL(I)^3/3#:TZ=C*XYAS:TZ(I)=fnDMS(TZ)*(-1#)
M2=Y(I)^2/2#/M4/BN/M0^2:M3=(Y(I)^4)/24#/M4^2/M0^4/BN^2
M(I)=M0*(1#+M2+M3)
next I
'
'-------- 印 刷 --------
lprint:lprint:lprint:lprint:lprint:lprint:lprint"                     *** 経緯度からXYへの変換計算 ***"
lprint:lprint:lprint using"                                                         座標系  ### 系";K1:lprint
lprint:lprint"         点 名      緯 度          経 度"
lprint:lprint"                       X         Y      真北方位角  縮尺係数"
for J=1 to II
lprint:lprint using"         &     &   ####.######### ####.######### ";ST(J),B(J),L(J)
lprint:lprint using"                #######.#####  #######.#####     ####.######     ##.#######";X(J),Y(J),TZ(J),M(J)
lprint:lprint:lprint
next J
'
lprint chr$(12);
'
goto *KEIIDOXY
'
*SYUSEI1:'-----デ-タの修正-------
cls:locate 15,3:print"*** 経緯度からXYへの変換計算 ***"
locate 20,6:print"座標系・・・・・・・ 1"
locate 20,8:print"点 名・・・・・・・ 2"
locate 20,10:print"緯 度・・・・・・・ 3"
locate 20,12:print"経 度・・・・・・・ 4"
locate 20,14:print"次の点・・・・・・・ 5"
locate 20,16:print"終 了・・・・・・・ 6"
'
locate 20,18:input"何番目の点か・・・・  ";P
locate 30,21:input"番号を指定  ";I
if I<1 or I>6 then *SYUSEI1
on I goto *91,*92,*93,*94,*SYUSEI1,*KEIIDOXY
'
*91:cls:locate 20,10:input"座標系・・・・・・・";K1:goto *SYUSEI1
*92:cls:locate 20,10:input"点 名・・・・・・・";ST(P):goto *SYUSEI1
*93:cls:locate 20,10:input"緯 度・・・・・・・";B(P):goto *SYUSEI1
*94:cls:locate 20,10:input"経 度・・・・・・・";L(P):goto *SYUSEI1
'
'
'--------------XYから経緯度への変換計算----------
*XYKEIIDO
'-----作業メニュ------
cls:gosub *MENU1
on K goto *DATRIN2,*SYUSEI2,*KEISAN2,*ENDD1
'
*DATRIN2:J=0
cls:locate 15,2:print"*** XYから経緯度への変換計算 ***"
locate 20,5:input"座標系・・・・・・・";K1
*170:J=J+1:II=J
cls:locate 20,7:input"点 名・・・・・・・・";ST(J)
locate 20,9:input"座標 X・・・・・・・";X(J)
locate 20,11:input"座標 Y・・・・・・・";Y(J)
locate 20,15:print"次の点・・・・・・・・1"
locate 20,16:print"終 了・・・・・・・・2"
*176:locate 20,18:input"番号を指定・・・・・";I
if I<1 or I>2 then *176
on I goto *170,*XYKEIIDO
'
*SYUSEI2:'-----デ-タの修正-------
cls:locate 15,3:print"*** XYから経緯度への変換計算 ***"
locate 20,6:print"座標系・・・・・・・ 1"
locate 20,8:print"点 名・・・・・・・ 2"
locate 20,10:print"座標 X・・・・・・ 3"
locate 20,12:print"座標 Y・・・・・・ 4"
locate 20,14:print"次の点・・・・・・・ 5"
locate 20,16:print"終 了・・・・・・・ 6"
'
locate 20,18:input"何番目の点か・・・・  ";P
locate 30,21:input"番号を指定  ";I
if I<1 or I>6 then *SYUSEI2
on I goto *191,*192,*193,*194,*SYUSEI2,*XYKEIIDO
'
*191:cls:locate 20,10:input"座標系・・・・・・・";K1:goto *SYUSEI2
*192:cls:locate 20,10:input"点 名・・・・・・・";ST(P):goto *SYUSEI2
*193:cls:locate 20,10:input"座標 X・・・・・・";X(P):goto *SYUSEI2
*194:cls:locate 20,10:input"座標 Y・・・・・・";Y(P):goto *SYUSEI2
'
*KEISAN2:cls:'-------- 計  算 --------
for I=1 to II
BB0=fnRAA(DB(K1)):LL0=fnRAA(DS(K1))
X1=X(I)/M0:Y1=Y(I)/M0:F=2#*BB0/PI:gosub *SUB1
M=(MX+X1)/A3:gosub *SUB2:B1=BM
BSB=sin(BM):CB=cos(BM):TB=tan(BM):ET2=E12*CB:W=1#-E2*BSB^2
BN1=A0/sqr(W):M1=BN1*(1#-E2)/W:TN2=TB^2:B2=TB*Y1^2/(2#*M1*BN1)
B4=TB*(5#+3#*TN2+ET2-9#*ET2*TN2-4#*ET2^2)*(Y1^4)/(24#*M1*BN1^3)
B=(B1-B2+B4)*XYAS:B(I)=fnDMS(B)
L1=Y1/(BN1*CB):L3=(1#+2#*TN2+ET2)*Y1^3/(6#*BN1^3*CB)
L5=(5#+28#*TN2+24#*TN2^2)*Y1^5/(120#*BN1^5*CB)
DL=(L1-L3+L5+LL0)*XYAS:L(I)=fnDMS(DL)
MA1=TB*Y1/BN1-TB*(1#*TN2-ET2)*Y1^3/(3#*BN1^3)
MA2=TB*(1#+TN2)*(2#+3#*TN2)*Y1^5/(15#*BN1^5)
MA=(MA1+MA2)*XYAS:TZ(I)=fnDMS(MA)*(-1#)
M2=Y(I)^2/2#/M1/BN1/(M0^2):M3=Y(I)^4/24#/M1^2/BN1^2/M0^4
M(I)=M0*(1#+M2+M3)
next I
'
'-------- 印 刷 --------
lprint:lprint:lprint:lprint:lprint:lprint:lprint"                     *** XYから経緯度への変換計算 ***"
lprint:lprint:lprint using"                                                         座標系  ### 系";K1:lprint
lprint:lprint"         点 名        X        Y"
lprint:lprint"                     緯 度        経 度     真北方位角 縮尺係数"
for J=1 to II
lprint:lprint using"         &     & #######.####  #######.#### ";ST(J),X(J),Y(J)
lprint:lprint using"                  ####.######## ####.######### ####.######   ##.#######";B(J),L(J),TZ(J),M(J)
lprint:lprint:lprint
next J
'
lprint chr$(12);
'
goto *XYKEIIDO
'
'-------------縮尺係数の計算-----------
*KEISUU:'-----作業メニュ------
cls:gosub *MENU1
on K goto *DATRIN3,*SYUSEI3,*KEISAN3,*ENDD1
'
*DATRIN3:J=0
cls:locate 15,2:print"*** 縮尺係数の計算 ***"
locate 20,5:input"座標系・・・・・・・・";K1
*189:J=J+1:II=J
cls:locate 20,7:input"点 名・・・・・・・・";ST(J)
locate 20,9:input"座標 X・・・・・・・";X(J)
locate 20,11:input"座標 Y・・・・・・・";Y(J)
locate 20,15:print"次の点・・・・・・・・1"
locate 20,16:print"終 了・・・・・・・・2"
*195:locate 20,18:input"番号を指定・・・・・";I
if I<1 or I>2 then *195
on I goto *189,*KEISUU
'
*SYUSEI3:'-----デ-タの修正-------
cls:locate 15,3:print"*** 縮尺係数の計算 ***"
locate 20,6:print"座標系・・・・・・・ 1"
locate 20,8:print"点 名・・・・・・・ 2"
locate 20,10:print"座標 X・・・・・・ 3"
locate 20,12:print"座標 Y・・・・・・ 4"
locate 20,14:print"次の点・・・・・・・ 5"
locate 20,16:print"終 了・・・・・・・ 6"
'
locate 20,18:input"何番目の点か・・・・  ";P
locate 30,21:input"番号を指定  ";I
if I<1 or I>6 then *SYUSEI2
on I goto *211,*212,*213,*214,*SYUSEI3,*KEISUU
'
*211:cls:locate 20,10:input"座標系・・・・・・・";K1:goto *SYUSEI3
*212:cls:locate 20,10:input"点 名・・・・・・・";ST(P):goto *SYUSEI3
*213:cls:locate 20,10:input"座標 X・・・・・・";X(P):goto *SYUSEI3
*214:cls:locate 20,10:input"座標 Y・・・・・・";Y(P):goto *SYUSEI3
'
*KEISAN3:cls:'-------- 計  算 --------
for I=1 to II
BB0=fnRAA(DB(K1)):LL0=fnRAA(DS(K1))
X1=X(I)/M0:Y1=Y(I)/M0:F=2#*BB0/PI:gosub *SUB1
M=(MX+X1)/A3:gosub *SUB2:B1=BM
BSB=sin(BM):CB=cos(BM):TB=tan(BM):ET2=E12*CB:W=1#-E2*BSB^2
BN1=A0/sqr(W):M1=BN1*(1#-E2)/W:TN2=TB^2:B2=TB*Y1^2/(2#*M1*BN1)
B4=TB*(5#+3#*TN2+ET2-9#*ET2*TN2-4#*ET2^2)*(Y1^4)/(24#*M1*BN1^3)
B=(B1-B2+B4)*XYAS:B(I)=fnDMS(B)
L1=Y1/(BN1*CB):L3=(1#+2#*TN2+ET2)*Y1^3/(6#*BN1^3*CB)
L5=(5#+28#*TN2+24#*TN2^2)*Y1^5/(120#*BN1^5*CB)
DL=(L1-L3+L5+LL0)*XYAS:L(I)=fnDMS(DL)
MA1=TB*Y1/BN1-TB*(1#*TN2-ET2)*Y1^3/(3#*BN1^3):T1=MA1*XYAS:T1=fnDMS(T1)
MA2=TB*(1#+TN2)*(2#+3#*TN2)*Y1^5/(15#*BN1^5):T2=MA2*XYAS:T2=fnDMS(T2)
MA=(MA1+MA2)*XYAS:TZ(I)=fnDMS(MA)*(-1#)
M2=Y(I)^2/2#/M1/BN1/(M0^2):M3=Y(I)^4/24#/M1^2/BN1^2/M0^4
M(I)=M0*(1#+M2+M3)
next I
'
lprint:lprint:lprint:lprint:lprint:lprint:lprint"                           *** 縮尺係数の計算 ***"
lprint:lprint:lprint using"                                                         座標系  ### 系";K1:lprint
lprint:lprint"         点 名        X         Y    真北方位角   縮尺係数"
for J=1 to II
lprint:lprint using"         &     & #######.#####  #######.#####   ##.######    ##.#######";ST(J),X(J),Y(J),TZ(J),M(J)
lprint:lprint
next J
'
lprint chr$(12);
'
goto *KEISUU
'
*SUB1
F2=F^2:MX=A(1)
for J=2 to 10
MX=MX*F2+A(J)
next J
MX=MX*F
return
'
*SUB2
M2=M^2:BM=C(1)
for J=2 to 9:BM=BM*M2+C(J)
next J
BM=BM*M
return
'
*5200:'------角度の正規化-----
if AZ=>360# then AZ=AZ-360#
*5210:if AZ=<0 then AZ=AZ+360#
if AZ=>360 then *5200
if AZ<0 then *5210
*5300:'-----度 分 秒の分散-----
VV=abs(AN):V1=fix(AN):VV2=(VV-fix(VV)+EET)*100#
V2=fix(VV2):V3=(VV2-fix(VV2))*100#
return
'
'
'------------その他の計算--------------
*SONOTA
cls:locate 15,6:print"*** その他の計算 ***"
locate 20,9:input"角 度・・・・・・・";BP
'
RRA=fnRRA(BP):RAA=fnRAA(BP):AR1=RRA*XYAS:AR2=RAA*XYAS
DMS1=fnDMS(AR1):DMS2=fnDMS(AR2):DEG=fnDEG(BP)
AA2=A2/3600#
'
cls:lprint:lprint:lprint:lprint:lprint
lprint "             度、分、秒とラジアンの変換計算":lprint:lprint:lprint
lprint using "            方向角  T3 = #######.######";BP:lprint
lprint using "         ラジアン       TR1= ###.##########";RRA:lprint
lprint using "         ラジアン       TR2= ###.##########";RAA:lprint
lprint using "         度分秒から度   AR1=####.#########";DEG:lprint
lprint using "                DEG    AR1=####.######";AR1:lprint
lprint using "                DEG    AR2=####.######";AR2:lprint
lprint using "                DMS      T =####.######";DMS1:lprint
lprint using "                DMS      T =####.######";DMS2:lprint
lprint using "               206264/3600 =####.######";AA2:lprint
lprint using "                180/PI   T =####.######";XYAS:lprint
lprint using "                PI       T =####.################";PI:lprint
lprint chr$(12);
'
goto *ENDD1
'
*MENU1
locate 15,8:print"*** 作 業 メニュウ- ***"
locate 20,12:print"デ-タの入力 ・・・・・・・1"
locate 20,14:print"デ-タの修正 ・・・・・・・2 "
locate 20,16:print"計算書の印刷 ・・・・・・・3 "
locate 20,18:print"作業の終了 ・・・・・・・・4 "
locate 30,21:input"番号を指定    ";K
if K<1 or K>4 then *MENU1
return
'
*SYURYOU
'
*ENDD1
'
end
 

*1:T-fix(T

*2:T-fix(T

*3:T-fix(T

*4:T-fix(T

*5:T-fix(T