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

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

13.三級水準測量の計算 (F-BASIC)

'-----三級水準測量計算-----
lprint type"dc"
defint I,J,P:defstr N,Q:defdbl A-H
dim BS(40),FS(40),HS(40),BSD(40),FSD(40),HSD(40),HKS(40),HKK(40),P(40),HA(40)
N0$="            ---------------------------------------------------------"
*KAISI:cls:locate 15,8:print"*** 作 業 メニュウ- ***"
gosub *MENU1
on J goto *DETAIN,*SYUSEI,*KEISAN,*OWARI
'
*DETAIN
cls:locate 15,1:print"*** 三級水準測量計算 ***"
locate 10,5:input"出発点名  ";NS$
locate 10,7:input"到着点名  ";NF$
cls:locate 5,2:print"番号  後 視   前 視          番号  後 視   前 視"
J=0:BS=0:FS=0:HD1=0:HD2=0:P=0:HS=0:HKK=0
locate 50,22:print"固定点は 9,9    終了は 0,0"
*IN1:J=J+1
locate 10,22:input"後視、前視  ";BS(J),FS(J)
locate 25,22:print"             "
if BS(J)=0 then *KOTEI
if BS(J)=9 then *KOTEI
if J<18 then locate 5,(2+J):print using"#####   ##.###     ##.###";J,BS(J),FS(J) else locate 40,(J-15):print using"### ##   ##.###    ##.###";J,P,BS(J),FS(J)
JJ=J:goto *IN1
*KOTEI:J=J-1:JJ=J:P=P+1:PP=P:P(P)=J
if BS(J+1)=0 then *KAISI
goto *IN1
'
*SYUSEI
cls:locate 15,1:print"*** 三級水準測量計算 修正 ***"
locate 30,5:print"出発点名 ------1 "
locate 30,7:print"到着点名 ------2 "
locate 30,9:print"後視、前視 ---3"
locate 30,11:print"終 了 -------4"
locate 35,14:input"番号を指定  ";J
if J<1 or J>4 then *SYUSEI
on J goto *37,*38,*39,*KAISI
'
*37:locate 20,18:input"出発点名  ";NS$:goto *SYUSEI
*38:locate 20,18:input"到着点名  ";NF$:goto *SYUSEI
*39:locate 20,18:input"何番目の後視、前視か番号を指定  ";J
locate 20,21:input"後視、前視  ";BS(J),FS(J)
goto *SYUSEI
'
*KEISAN'------計 算------
HS=0:BS=0:FS=0:HD1=0:HD2=0
for J=1 to JJ
HS(J)=BS(J)-FS(J):HS=HS+HS(J):BS=BS+BS(J):FS=FS+FS(J)
if HS(J)<0 then HD2=HD2+HS(J) else HD1=HD1+HS(J)
for P=1 to PP
if P(P)=J then HA(J)=BS-FS
next P
next J
'
for P=1 to PP
HKK(P(P))=HA(P(P))-HA(P(P-1))
next P
'
cls:locate 25,10:print"*** 三級水準測量計算書の作成中 ***"
lprint:lprint:lprint:lprint:lprint:lprint:lprint tab(25)"*** 三級水準測量計算 ***":lprint:lprint
lprint using"               出発点  &      &--------> 到着点  &       &";NS$,NF$:lprint
lprint tab(10)"   番号  後 視   前 視  比高+  比高-  備 考":lprint
for J=1 to JJ
if HKK(J)=0 and HS(J)>0 then *53
if HKK(J)=0 and HS(J)<0 then *54
if HKK(J)<>0 and HS(J)>0 then *55
if HKK(J)<>0 and HS(J)<0 then *56
*53:lprint using"           ####     ##.###      ##.###    ##.###";J,BS(J),FS(J),HS(J):goto *57
*54:lprint using"           ####     ##.###      ##.###              ##.###";J,BS(J),FS(J),HS(J):goto *57
*55:lprint using"           ####     ##.###      ##.###    ##.###             ###.###";J,BS(J),FS(J),HS(J),HKK(J)
lprint N0$:goto *57
*56:lprint using"           ####     ##.###      ##.###              ##.###   ###.###";J,BS(J),FS(J),HS(J),HKK(J)
lprint N0$
*57:next J
lprint N0$
lprint using"            合計   ###.###     ###.###   ###.###   ###.###   ###.###";BS,FS,HD1,HD2,HS
lprint using"            差           ###.###             ###.###";HS,(HD1+HD2)
lprint chr$(12);
goto *KAISI
'
*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"番号を指定    ";J
if J<1 or J>4 then *MENU1
return
'
*OWARI
'
end