underworld777 @Wiki
プログラム入力例
最終更新：
underworld777
-
view
10 rem 電磁誘導対策（通信ケーブル1条または2条で分岐のある場合）
20 width "LPT1:", 132
30 pi = 3.14.1593 : co = 0.2316419 : c1 = 0.31938153# : c2 = -0.356563782# : c3 = 1.78147937# : c4=-1.821255978# : c5 = 1.330274429#
40 pi = -1.010932E-04:p2 = 1.089623E-03:p3=-1.232968E-03:p4=-9.779868e-03:p5=-7.063361e-02:p6=5.18445:p7=-4.178707E-02:r1=-0.0000375:r2=1.520833e-03:r3=-2.502083E-02:r4=2.134792:r5=-9.974417:r6=2.3795:r7-1.558
50 s1=1.401356E-03:s2=-2.731182e-02:s3=1.988207:s4=-6.275802:s5=5.622195:s6=9.274739:s7=-3.502338E-02:t1=0.0000375:t2=1.579167e-03:t3=-2.714583e-02:t4=2.431042:t5=-1.182817:t6=2.791317:t7=-1.137
60 dim a$(3), b$(3), c$(5):a$(0)="プラスチック シース":a$(1)="LAP シース":a$(2)="アルミらせん巻 シース":a$(3)="アルミ シース":b$(0)=" 非ケーブル":b$(1)=" スチールフルゲート ケーブル":b$(2)=" 鋼帯外装ケーブル":b$(3)=" 鉄線外装ケーブル"
70 c$=(0)="架空":c$(1)="直埋":c$(2)="PVC管路":c$(3)="トラフ":c$(4)="鋼管管路":c$(5)="鋳鉄管管路":EMF$=被誘導起電力":SIG$="大地導電率":RE$="接地抵抗":O$="(Ω)"
80 X$=" 条件を設定または変更しますか (NO:0, YES:1)":Y$=" 前区間と同一ですか (YES:0, NO:1)"
90 cls:input "計算年月日 （西暦 , , ）";da1, da2, da3:cls
100 rem 条件入力
110 locate 1,20: color 0, 1:print "＊＊＊ 電子誘導対策 ＊＊＊":color 0, 0
120 rem 需要家、件名
130 color 0,1:print "需 要 家":color 0,0:print x$;:input x:xx=x:if x)0 then print " 需要家（文字入力）"; use$
140 color 0,1:print "件 名":color 0,0:print x$;:input x:x=xx:if x=0 then goto 160
150 input " 件名（文字入力）";pro$
160 input " 周 波 数 (Hz) ";ff;ome=2*pi*ff
200 rem 線路構成
210 color 0,1:print "線 路 構 成";:color 0,0:print x$;:input x:xx=xx+x:if x=0 then goto 1000
220 print "各局に一連番号を付してください(始端：0)"
230 input "最後の局番号"; n
240 if nn=n then goto 260 else if nn>0 then erase b1, b2, a1, a2, a3, jp, nb, sta$, tt
250 dim a1(n), a2(n), a3(n), b1(n), b2(n), jp(n), nb(n), sta$(n), tt(n)
260 nn=n:m=0:e=0:ed=0:tt=0
300 rem 本線
310 color 0,1:print "本 線":color 0,0
320 input "本線の端末の局番号";e
330 print " 始端の局名（漢字６，５文字） ";:input sta$(0)
340 nb=0:b1=0:b2=0:a1=1:a2=1:a3=1:jp=0
350 gosub 910
400 rem 分岐線
410 print " ";:color 0,1:print "分岐線":color 0,0
420 input " 本線からの分岐線の数";a:if a=0 then goto 800
430 print " ";sta$(0);":";:color 0,1:print 0;:color 0,0
440 for n=1 to e
450 print ", ";sta$(n);":";:color 0,1:print n;:color 0,0
460 next n
470 print
480 for j=1 to a
490 nb=1:a2=1:a3=M+1:ed=e
500 print " ";:color 0,1:print using "第##分岐線の分岐点の番号";j:color 0,0:input b:b1=0:b2=b
510 if b=0 then a2=m+1
520 print using "第##分岐線の端末の局番号";j:input e
530 gosub 910
600 rem 孫分岐線
610 print " ";:color 0,1:print "孫分岐線":color 0,0
620 print using " 第##分岐線からの孫分岐線の数";j:input c:if c=0 then goto 740
630 print " ";sta$(b2(n));":";:color 0,1:print b2(m);:color 0,0
640 for n=ed+1 to e
650 print ", ";sta$(n);":";:color 0,1:print n;:color 0,0
660 next n
670 print
680 for k=1 to c
690 nb=2:ed=e:if k=1 then a2=a3:a3=m+1:b1=b2 else a2=a3:a3=m+1:b1=b1
700 print " ";:color 0,1:print using "第##孫分岐線の分岐点の番号";k:color 0,0:input d:b2=d
710 print using " 第##孫分岐線の端末の局番号";k:input e
720 gosub 910
730 next k
740 next j
800 input "局番号を確認しますか（No:0, YES:1）";x:if x = 0 then goto 1000
810 for n=0 to nn
820 print using "NB(##)=##, A1(##)=##, B1(##)=##, A2(##)=##, B2(##)=##, A3(##)=##, JP(##)=##, STA(##)=& &";n,nb(n),n,a1(n),n,b1(n),n,a2(n),n,b2(n),n,a3(n),n,jp(n),n,sta$(n)
830 next n
840 print using "TT(1)=##", tt(1);
850 for n=2 to tt
860 print using ", TT(##)=##";n, tt(n);
870 next
880 print
890 goto 1000
900 rem 局名入力サブルーチン
910 for l=1 to e-ed
920 m=ed+l:nb(m)=nb:a1(m)=a1:b1(m)=b1:a2(m)=a2:b2(m)=b2:a3(m)=a3
930 if l=1 then jp(m)=b2 else jp(m)=m-1
940 print using " 第##番目の局名 （漢字６、５文字）";j;:input sta$(m)
950 if l=e-ed then tt=tt+1:tt(tt)=m
960 next l
970 return
1000 rem 通信ケーブル
1010 color 0,1:print "通信ケーブル":color 0,0:print x$;:input x:xx=xx+x:if x=0 then goto 1200
1020 color 0,1:print "ケーブル条数":color 0,0:print x$;:input x:xx=xx+1:if x=0 then goto 1060
1030 input " ケーブル条数";k:if kk=0 then kk=k else if kk=k and cha=0 then goto 1060 else kk=k:erase arm, dc, ds, dw, hc, i, gap, ll, nt, nu, nwr, ppp, she, tbd, ts, tt, wt, xx, yy, zz, aa, ea, ei, re, sig
1040 n=nn:dim arm(k, n), dc(k, n), ds(k, n), dw(k, n), hc(k, n), i(k), gap(k, n),ll(n), nt(k, n),nwr(k, n), ppp(k, n),she(k, n),tbd(k, n),ts(k, n),ttt(k,n),wt(k,n),xx(n),yy(k,n),zz(k,n)
1050 dim aa(n), ea(n),ei(n),re(n),sig(n)
1060 for k=1 to kk
1070 print " ";:color 0,1:print using "第##ケーブル";k:color 0,0:print x$;:input x:xx(k)=x:if x=0 then goto 1180
1080 for n=1 to nn
1090 print " ";:color 0,1:print sta$(jp(n));"から";sta$(n);"間":color 0,0:if k=1 then input " 区間長（km）";:ll(n)
1100 if n=1 then yy(k,n)=1:goto 1130 else print y$;:input y:yy(k,n)=y
1110 if y>0 then goto 1130 else dc(k,n)=dc(k,n-1):ppp(k,n)=ppp(k,n-1):ds(k,n)=ds(k,n-1):she(k,n)=she(k,n-1):ts(k,n)=ts(k,n-1)
1120 arm(k,n)=arm(k,n-1):ttt(k,n)=ttt(k,n-1):wt(k,n)=wt(k,n-1):gap(k,n)=gap(k,n-1):dw(k,n)=dw(k,n-1):nwr(k,n)=nwr(k,n-1):tbd(k,n)=tbd(k,n-1):hc(k,n)=hc(k,n-1):nt(k,n)=nt(k,n-1):goto 1180
1130 input " 線 径（mm）";dc(k,n):input " 対 数 ";ppp(k,n):input " コア外径（mm）";ds(k,n)
1140 input " シース（プラスチック:0, LAP:1, アルミらせん巻き:2, アルミ:3）";x:she(k,n)=x:if x=3 then input " アルミシース厚さ（mm）";ts(k,n) else if x=1 then ts(k,n)=0.2 else if x=2 then ts(k,n)=0.1
1150 input " 外装 （無し:0, フルゲートスチール:1, 鋼帯:2, 鉄線:3）";x:arm(k,n)=x:if x>0 then input " 座床厚さ（mm）";tbd(k,n)
1160 if x=1 then input " フルゲート厚さ（mm）";ttt(k,n):input " フルゲート高さ（mm）"
1170 if x=3 then input " 鉄線直径（mm）";dw(k,n):input " 本 数 ";nwr(k,n)
1180 next n
1190 next k
1200 ren 布設方法
1210 color 0,1:print "布設方法";:color 0,0:print x$;:input x:xx=xx+x:if x=0 then goto 1400
1220 if ss<>0 then erase bm, d12, dd, h, nu, td
1230 k=kk:n=nn:dim bm(k,n),d12(n), dd(k,n), h(k,n), nu(k,n), td(k,n)
1240 for k=1 to kk
1250 print " ";:color 0,1:print using "第 # ケーブル";k:color 0,0
1260 for n=1 to nn
1270 print " ";:color 0,1:print sta$(jp(n));"から";sta$(n);"間":color 0,0:if n=1 then goto 1290
1280 print y$;:input y:yy(k,n)=yy(k,n)+y:if y=0 then bm(k,n)=bm(k,n-1):h(k,n)~h(k,n-1):d12(n)=(n-1):dd(k,n)=dd(k,n-1):td(k,n)=td(k,n-1):nu(k,n)=num(k,n-1):goto 1340
1290 input " 布設方法（架空:0, 直埋:1, 管路:2）";x:bm(k,n)=x:if x=0 then goto 1330
1300 x=2 then input " 管路種別（PVC管:0, トラフ:1, 鋼管:2, 鋳鉄管:3）";y:bm(k,n)=y+2
1310 if y<2 then goto 1330 else input " 管路内径（mm）";dd(k,n):input " 厚さ （mm）";td(k,n)
1320 zz(k,n)=4:input " 比 導 磁 率 ";nu(k,n)
1330 if x=0 then input " 地上高さ（m）";h(k,n) else input " 埋設深さ（m）";h:h(k,n)=-h
1340 if k>1 then input " ケーブル間隔（m）";d12(n)
1350 next n
1360 next k
1400 rem 回線構成
1410 color 0,1:print "ケーブルごとの回線種別数";:color 0,0:print x$;:input x:xx=xx+x:if x=0 then goto 1700
1420 input "交換機がありますか（NO:0, YES:1）";exc
1430 for k=1 to kk
1440 print " ";k;"番目のケーブルの回線種別数";:input i(k):if i(k) > i then i=i(k)
1450 if ii= 0 then goto 1460 else if i=ii then goto 1470 else erase f, ff, g, gg, hb, hh, pp, tb
1460 ii=i:k~kk:dim f(k,i),ff(k,i), g(k,i), gg(k,i), hb(k,i), hh(k,i),pp(k,i),tb(k,i)
1470 color 0,1:print "回線構成（終端は順方向とする）":color 0,0:prit x$;:input x:if x=0 then goto 1590
1480 print " 局番号（";
1490 for n=0 to nn
1500 print sta$(n);":";n;", ";
1510 next n
1520 print "）"
1530 for i=0 to i(k)
1540 print " ";:color 0,1:print using "第 # ケーブルの第 ## 回線群";k,i:color 0,0:input " 始 端 局";ff(k,i):input " 終 端 局";gg(k,i):input " 対 数";pp(k,i)
1550 print "T分岐がありますか（NO:0, YES:1）";:input t:tb(k,i)=t:if t=0 then goto 1580
1560 input " T分岐の分岐点 ";hb(k,i)
1570 input " T分岐線の終端局";hh(k,i)
1580 next i
1590 next k
1700 rem 大地導電率
1710 color 0,1:print sig$:color 0,0:print x$;:input x:xx=xx+x:if x=0 then goto 1800
1720 for n=1 to nn
1730 print " ";:color 0,1:print sta$(jp(n));"から";sta$(n);"間":color 0,0
1740 print " ";sig$;" （mS/m）";:input x:sig(n)=x/1000
1750 next
1800 rem 接地抵抗
1810 color 0,1:print re$:color 0,0:print x$;:input x:if x=0 then goto 1900
1820 for n=0 to nn
1830 print " ";:color 0,1:print sta$(n);"局":color 0,0
1840 print " ";re$;o$;:input re(n)
1850 next
1900 rem 被誘導起電力
1910 color 0,1:print emf$:color 0,0:print x$;:input x:if x=0 then goto 2000
1920 for n=1 to nn
1930 print " ";:color 0,1:print sta$(jp(n));"から";sta$(n);"間":color 0,0
1940 print " ";emf$;" （V）";:input ei(n)
1950 print " 起電力偏角（°）";:input ea(n):aa(n)=ea(n)*pi/180
1960 next
2000 rem 遮蔽線輪
2010 color 0,1:print "遮蔽線輪":color 0,0
2020 input " 遮蔽線輪を挿入しますか（NO:0, YES:1）";x:if x=0 then goto 2300
2030 print x$;:input x:if x=0 then goto 2300 else if nsc>0 then erase nsc, asc, dsc, lsc, msc, psc, lscw, resc, recw
2040 nsc=1:k=kk:n=nn:dim nsc(k), asc(k, n),lsc(k, n),msc(k, n),psc(k, n), rsc(k, n), lscw(k, n),resc(k, n),rscw(k, n)
2050 for n=0 to nn:print sta$(n);":";n;", ";:next
2060 for k=1 to kk
2070 print " ";:color 0,1:print using "第 # ケーブル";k:color 0,0
2080 input " 台数";nsc(k)
2090 for i=1 to nsc(k)
2100 input "挿入場所（局番号）";x:ssc(k, i)=x:input "挿入方向（始端側:0, 終端側:1）";y:dsc(k,x)=y
2110 input "１次側インダクタンス（H）";lsc(k, x+y):input "１次側抵抗（Ω）";rsc(k, x+y)
2120 input "相互インダクタンス（H）";msc(k, x+y):input "２次側対数（対）";psc(k, x+y)
2130 input "挿入方法（ケーブルシース:0, 遠方接地:1）";esc:if esc=0 then goto 2160
2140 input "接地線長さ（m）";lscw(k, x+y):input "接地線断面積（mm^2）";ascw(k, x+y):input "遠方接地設置抵抗（Ω）";resc(k, x+y)
2150 rscw(k, x+y)=0.1741*lscw(k, x+y)/ascw(k, x+y)
2160 next i
2170 next k
2180 input "地絡電流（A）";ie:input "メッシュ接地抵抗（Ω）";remes
2300 rem 逆閃絡防止装置
2600 rem アレスタ
2610 color 0,1 :print "アレスタ":color 0,0:print x$;:input x:if x=0 then goto 2700
2620 input " アレスタ品名（文字入力）";arr$:input " 直流放電開始電圧（V）";vdg:vg=vdg/sqr(2):input " 偏差（％:0, VOLT:1）";dev
2630 if dev=0 then input " 偏 差（％）";dx:sig=vg*dx/300 else input " 偏 差（V）";dv:sig=dv/sqr(2)/3
2640 vo=vg-3*sig
2700 rem アレスタ挿入箇所
2710 color 0,1:print "アレスタ挿入箇所":color 0,0:print x$;:input x:if x=0 then goto 2900
2720 input " すべて両端末ですか（YES:0, NO:1）";ap
2730 for k=1 to kk
2740 for i=1 to i(k)
2750 if ap=0 then goto 2770 else print using " 第 # ケーブルの第 # 回線群";k;i
2760 input " 始 端 側";f(k,i):input " 終 端 側";g(k,i):goto 2780
2770 f(k,i)=ff(k,i):g(k,i)=gg(k,i)
2780 next i
2790 next k
2900 color 0, 1:print " 途中経過をプリントしますか（NO:0, YES:1）";:color 0,0:input prog
2910 color 0, 1:print " 訂正がありますか（NO:0, YES:1）";:color 0, 0:input x:if x>1 then stop
2920 color 0, 1:print " 動作心線数を設定しますか（NO:0, YES:1）";:color 0,0:input num
20 width "LPT1:", 132
30 pi = 3.14.1593 : co = 0.2316419 : c1 = 0.31938153# : c2 = -0.356563782# : c3 = 1.78147937# : c4=-1.821255978# : c5 = 1.330274429#
40 pi = -1.010932E-04:p2 = 1.089623E-03:p3=-1.232968E-03:p4=-9.779868e-03:p5=-7.063361e-02:p6=5.18445:p7=-4.178707E-02:r1=-0.0000375:r2=1.520833e-03:r3=-2.502083E-02:r4=2.134792:r5=-9.974417:r6=2.3795:r7-1.558
50 s1=1.401356E-03:s2=-2.731182e-02:s3=1.988207:s4=-6.275802:s5=5.622195:s6=9.274739:s7=-3.502338E-02:t1=0.0000375:t2=1.579167e-03:t3=-2.714583e-02:t4=2.431042:t5=-1.182817:t6=2.791317:t7=-1.137
60 dim a$(3), b$(3), c$(5):a$(0)="プラスチック シース":a$(1)="LAP シース":a$(2)="アルミらせん巻 シース":a$(3)="アルミ シース":b$(0)=" 非ケーブル":b$(1)=" スチールフルゲート ケーブル":b$(2)=" 鋼帯外装ケーブル":b$(3)=" 鉄線外装ケーブル"
70 c$=(0)="架空":c$(1)="直埋":c$(2)="PVC管路":c$(3)="トラフ":c$(4)="鋼管管路":c$(5)="鋳鉄管管路":EMF$=被誘導起電力":SIG$="大地導電率":RE$="接地抵抗":O$="(Ω)"
80 X$=" 条件を設定または変更しますか (NO:0, YES:1)":Y$=" 前区間と同一ですか (YES:0, NO:1)"
90 cls:input "計算年月日 （西暦 , , ）";da1, da2, da3:cls
100 rem 条件入力
110 locate 1,20: color 0, 1:print "＊＊＊ 電子誘導対策 ＊＊＊":color 0, 0
120 rem 需要家、件名
130 color 0,1:print "需 要 家":color 0,0:print x$;:input x:xx=x:if x)0 then print " 需要家（文字入力）"; use$
140 color 0,1:print "件 名":color 0,0:print x$;:input x:x=xx:if x=0 then goto 160
150 input " 件名（文字入力）";pro$
160 input " 周 波 数 (Hz) ";ff;ome=2*pi*ff
200 rem 線路構成
210 color 0,1:print "線 路 構 成";:color 0,0:print x$;:input x:xx=xx+x:if x=0 then goto 1000
220 print "各局に一連番号を付してください(始端：0)"
230 input "最後の局番号"; n
240 if nn=n then goto 260 else if nn>0 then erase b1, b2, a1, a2, a3, jp, nb, sta$, tt
250 dim a1(n), a2(n), a3(n), b1(n), b2(n), jp(n), nb(n), sta$(n), tt(n)
260 nn=n:m=0:e=0:ed=0:tt=0
300 rem 本線
310 color 0,1:print "本 線":color 0,0
320 input "本線の端末の局番号";e
330 print " 始端の局名（漢字６，５文字） ";:input sta$(0)
340 nb=0:b1=0:b2=0:a1=1:a2=1:a3=1:jp=0
350 gosub 910
400 rem 分岐線
410 print " ";:color 0,1:print "分岐線":color 0,0
420 input " 本線からの分岐線の数";a:if a=0 then goto 800
430 print " ";sta$(0);":";:color 0,1:print 0;:color 0,0
440 for n=1 to e
450 print ", ";sta$(n);":";:color 0,1:print n;:color 0,0
460 next n
470 print
480 for j=1 to a
490 nb=1:a2=1:a3=M+1:ed=e
500 print " ";:color 0,1:print using "第##分岐線の分岐点の番号";j:color 0,0:input b:b1=0:b2=b
510 if b=0 then a2=m+1
520 print using "第##分岐線の端末の局番号";j:input e
530 gosub 910
600 rem 孫分岐線
610 print " ";:color 0,1:print "孫分岐線":color 0,0
620 print using " 第##分岐線からの孫分岐線の数";j:input c:if c=0 then goto 740
630 print " ";sta$(b2(n));":";:color 0,1:print b2(m);:color 0,0
640 for n=ed+1 to e
650 print ", ";sta$(n);":";:color 0,1:print n;:color 0,0
660 next n
670 print
680 for k=1 to c
690 nb=2:ed=e:if k=1 then a2=a3:a3=m+1:b1=b2 else a2=a3:a3=m+1:b1=b1
700 print " ";:color 0,1:print using "第##孫分岐線の分岐点の番号";k:color 0,0:input d:b2=d
710 print using " 第##孫分岐線の端末の局番号";k:input e
720 gosub 910
730 next k
740 next j
800 input "局番号を確認しますか（No:0, YES:1）";x:if x = 0 then goto 1000
810 for n=0 to nn
820 print using "NB(##)=##, A1(##)=##, B1(##)=##, A2(##)=##, B2(##)=##, A3(##)=##, JP(##)=##, STA(##)=& &";n,nb(n),n,a1(n),n,b1(n),n,a2(n),n,b2(n),n,a3(n),n,jp(n),n,sta$(n)
830 next n
840 print using "TT(1)=##", tt(1);
850 for n=2 to tt
860 print using ", TT(##)=##";n, tt(n);
870 next
880 print
890 goto 1000
900 rem 局名入力サブルーチン
910 for l=1 to e-ed
920 m=ed+l:nb(m)=nb:a1(m)=a1:b1(m)=b1:a2(m)=a2:b2(m)=b2:a3(m)=a3
930 if l=1 then jp(m)=b2 else jp(m)=m-1
940 print using " 第##番目の局名 （漢字６、５文字）";j;:input sta$(m)
950 if l=e-ed then tt=tt+1:tt(tt)=m
960 next l
970 return
1000 rem 通信ケーブル
1010 color 0,1:print "通信ケーブル":color 0,0:print x$;:input x:xx=xx+x:if x=0 then goto 1200
1020 color 0,1:print "ケーブル条数":color 0,0:print x$;:input x:xx=xx+1:if x=0 then goto 1060
1030 input " ケーブル条数";k:if kk=0 then kk=k else if kk=k and cha=0 then goto 1060 else kk=k:erase arm, dc, ds, dw, hc, i, gap, ll, nt, nu, nwr, ppp, she, tbd, ts, tt, wt, xx, yy, zz, aa, ea, ei, re, sig
1040 n=nn:dim arm(k, n), dc(k, n), ds(k, n), dw(k, n), hc(k, n), i(k), gap(k, n),ll(n), nt(k, n),nwr(k, n), ppp(k, n),she(k, n),tbd(k, n),ts(k, n),ttt(k,n),wt(k,n),xx(n),yy(k,n),zz(k,n)
1050 dim aa(n), ea(n),ei(n),re(n),sig(n)
1060 for k=1 to kk
1070 print " ";:color 0,1:print using "第##ケーブル";k:color 0,0:print x$;:input x:xx(k)=x:if x=0 then goto 1180
1080 for n=1 to nn
1090 print " ";:color 0,1:print sta$(jp(n));"から";sta$(n);"間":color 0,0:if k=1 then input " 区間長（km）";:ll(n)
1100 if n=1 then yy(k,n)=1:goto 1130 else print y$;:input y:yy(k,n)=y
1110 if y>0 then goto 1130 else dc(k,n)=dc(k,n-1):ppp(k,n)=ppp(k,n-1):ds(k,n)=ds(k,n-1):she(k,n)=she(k,n-1):ts(k,n)=ts(k,n-1)
1120 arm(k,n)=arm(k,n-1):ttt(k,n)=ttt(k,n-1):wt(k,n)=wt(k,n-1):gap(k,n)=gap(k,n-1):dw(k,n)=dw(k,n-1):nwr(k,n)=nwr(k,n-1):tbd(k,n)=tbd(k,n-1):hc(k,n)=hc(k,n-1):nt(k,n)=nt(k,n-1):goto 1180
1130 input " 線 径（mm）";dc(k,n):input " 対 数 ";ppp(k,n):input " コア外径（mm）";ds(k,n)
1140 input " シース（プラスチック:0, LAP:1, アルミらせん巻き:2, アルミ:3）";x:she(k,n)=x:if x=3 then input " アルミシース厚さ（mm）";ts(k,n) else if x=1 then ts(k,n)=0.2 else if x=2 then ts(k,n)=0.1
1150 input " 外装 （無し:0, フルゲートスチール:1, 鋼帯:2, 鉄線:3）";x:arm(k,n)=x:if x>0 then input " 座床厚さ（mm）";tbd(k,n)
1160 if x=1 then input " フルゲート厚さ（mm）";ttt(k,n):input " フルゲート高さ（mm）"
1170 if x=3 then input " 鉄線直径（mm）";dw(k,n):input " 本 数 ";nwr(k,n)
1180 next n
1190 next k
1200 ren 布設方法
1210 color 0,1:print "布設方法";:color 0,0:print x$;:input x:xx=xx+x:if x=0 then goto 1400
1220 if ss<>0 then erase bm, d12, dd, h, nu, td
1230 k=kk:n=nn:dim bm(k,n),d12(n), dd(k,n), h(k,n), nu(k,n), td(k,n)
1240 for k=1 to kk
1250 print " ";:color 0,1:print using "第 # ケーブル";k:color 0,0
1260 for n=1 to nn
1270 print " ";:color 0,1:print sta$(jp(n));"から";sta$(n);"間":color 0,0:if n=1 then goto 1290
1280 print y$;:input y:yy(k,n)=yy(k,n)+y:if y=0 then bm(k,n)=bm(k,n-1):h(k,n)~h(k,n-1):d12(n)=(n-1):dd(k,n)=dd(k,n-1):td(k,n)=td(k,n-1):nu(k,n)=num(k,n-1):goto 1340
1290 input " 布設方法（架空:0, 直埋:1, 管路:2）";x:bm(k,n)=x:if x=0 then goto 1330
1300 x=2 then input " 管路種別（PVC管:0, トラフ:1, 鋼管:2, 鋳鉄管:3）";y:bm(k,n)=y+2
1310 if y<2 then goto 1330 else input " 管路内径（mm）";dd(k,n):input " 厚さ （mm）";td(k,n)
1320 zz(k,n)=4:input " 比 導 磁 率 ";nu(k,n)
1330 if x=0 then input " 地上高さ（m）";h(k,n) else input " 埋設深さ（m）";h:h(k,n)=-h
1340 if k>1 then input " ケーブル間隔（m）";d12(n)
1350 next n
1360 next k
1400 rem 回線構成
1410 color 0,1:print "ケーブルごとの回線種別数";:color 0,0:print x$;:input x:xx=xx+x:if x=0 then goto 1700
1420 input "交換機がありますか（NO:0, YES:1）";exc
1430 for k=1 to kk
1440 print " ";k;"番目のケーブルの回線種別数";:input i(k):if i(k) > i then i=i(k)
1450 if ii= 0 then goto 1460 else if i=ii then goto 1470 else erase f, ff, g, gg, hb, hh, pp, tb
1460 ii=i:k~kk:dim f(k,i),ff(k,i), g(k,i), gg(k,i), hb(k,i), hh(k,i),pp(k,i),tb(k,i)
1470 color 0,1:print "回線構成（終端は順方向とする）":color 0,0:prit x$;:input x:if x=0 then goto 1590
1480 print " 局番号（";
1490 for n=0 to nn
1500 print sta$(n);":";n;", ";
1510 next n
1520 print "）"
1530 for i=0 to i(k)
1540 print " ";:color 0,1:print using "第 # ケーブルの第 ## 回線群";k,i:color 0,0:input " 始 端 局";ff(k,i):input " 終 端 局";gg(k,i):input " 対 数";pp(k,i)
1550 print "T分岐がありますか（NO:0, YES:1）";:input t:tb(k,i)=t:if t=0 then goto 1580
1560 input " T分岐の分岐点 ";hb(k,i)
1570 input " T分岐線の終端局";hh(k,i)
1580 next i
1590 next k
1700 rem 大地導電率
1710 color 0,1:print sig$:color 0,0:print x$;:input x:xx=xx+x:if x=0 then goto 1800
1720 for n=1 to nn
1730 print " ";:color 0,1:print sta$(jp(n));"から";sta$(n);"間":color 0,0
1740 print " ";sig$;" （mS/m）";:input x:sig(n)=x/1000
1750 next
1800 rem 接地抵抗
1810 color 0,1:print re$:color 0,0:print x$;:input x:if x=0 then goto 1900
1820 for n=0 to nn
1830 print " ";:color 0,1:print sta$(n);"局":color 0,0
1840 print " ";re$;o$;:input re(n)
1850 next
1900 rem 被誘導起電力
1910 color 0,1:print emf$:color 0,0:print x$;:input x:if x=0 then goto 2000
1920 for n=1 to nn
1930 print " ";:color 0,1:print sta$(jp(n));"から";sta$(n);"間":color 0,0
1940 print " ";emf$;" （V）";:input ei(n)
1950 print " 起電力偏角（°）";:input ea(n):aa(n)=ea(n)*pi/180
1960 next
2000 rem 遮蔽線輪
2010 color 0,1:print "遮蔽線輪":color 0,0
2020 input " 遮蔽線輪を挿入しますか（NO:0, YES:1）";x:if x=0 then goto 2300
2030 print x$;:input x:if x=0 then goto 2300 else if nsc>0 then erase nsc, asc, dsc, lsc, msc, psc, lscw, resc, recw
2040 nsc=1:k=kk:n=nn:dim nsc(k), asc(k, n),lsc(k, n),msc(k, n),psc(k, n), rsc(k, n), lscw(k, n),resc(k, n),rscw(k, n)
2050 for n=0 to nn:print sta$(n);":";n;", ";:next
2060 for k=1 to kk
2070 print " ";:color 0,1:print using "第 # ケーブル";k:color 0,0
2080 input " 台数";nsc(k)
2090 for i=1 to nsc(k)
2100 input "挿入場所（局番号）";x:ssc(k, i)=x:input "挿入方向（始端側:0, 終端側:1）";y:dsc(k,x)=y
2110 input "１次側インダクタンス（H）";lsc(k, x+y):input "１次側抵抗（Ω）";rsc(k, x+y)
2120 input "相互インダクタンス（H）";msc(k, x+y):input "２次側対数（対）";psc(k, x+y)
2130 input "挿入方法（ケーブルシース:0, 遠方接地:1）";esc:if esc=0 then goto 2160
2140 input "接地線長さ（m）";lscw(k, x+y):input "接地線断面積（mm^2）";ascw(k, x+y):input "遠方接地設置抵抗（Ω）";resc(k, x+y)
2150 rscw(k, x+y)=0.1741*lscw(k, x+y)/ascw(k, x+y)
2160 next i
2170 next k
2180 input "地絡電流（A）";ie:input "メッシュ接地抵抗（Ω）";remes
2300 rem 逆閃絡防止装置
2600 rem アレスタ
2610 color 0,1 :print "アレスタ":color 0,0:print x$;:input x:if x=0 then goto 2700
2620 input " アレスタ品名（文字入力）";arr$:input " 直流放電開始電圧（V）";vdg:vg=vdg/sqr(2):input " 偏差（％:0, VOLT:1）";dev
2630 if dev=0 then input " 偏 差（％）";dx:sig=vg*dx/300 else input " 偏 差（V）";dv:sig=dv/sqr(2)/3
2640 vo=vg-3*sig
2700 rem アレスタ挿入箇所
2710 color 0,1:print "アレスタ挿入箇所":color 0,0:print x$;:input x:if x=0 then goto 2900
2720 input " すべて両端末ですか（YES:0, NO:1）";ap
2730 for k=1 to kk
2740 for i=1 to i(k)
2750 if ap=0 then goto 2770 else print using " 第 # ケーブルの第 # 回線群";k;i
2760 input " 始 端 側";f(k,i):input " 終 端 側";g(k,i):goto 2780
2770 f(k,i)=ff(k,i):g(k,i)=gg(k,i)
2780 next i
2790 next k
2900 color 0, 1:print " 途中経過をプリントしますか（NO:0, YES:1）";:color 0,0:input prog
2910 color 0, 1:print " 訂正がありますか（NO:0, YES:1）";:color 0, 0:input x:if x>1 then stop
2920 color 0, 1:print " 動作心線数を設定しますか（NO:0, YES:1）";:color 0,0:input num
