home *** CD-ROM | disk | FTP | other *** search
/ HAM Radio 1 / HamRadio.cdr / tech / design4 / iftloop.bas < prev    next >
BASIC Source File  |  1986-09-15  |  14KB  |  619 lines

  1. 5 DEFSNG A-H: DEFINT I-N: DEFDBL O-Z: PI=3.141592653589794#
  2. 10 DIM D%(20),PR(20),PJ(20),ZR(20),ZJ(20),TPR(20),TPJ(20),TZR(20),TZJ(20)
  3. 12 DIM C#(2048),P(20),CXPLOT(1026),CYPLOT(1026)
  4. 15 CLS
  5. 20 PRINT"MENU"
  6. 30 PRINT
  7. 40 PRINT"MAKE PROGRAM CHOICE BELOW"
  8. 50 PRINT
  9. 60 PRINT"TYPE A TO LOAD FREQUENCY VARIABLES FROM FILE"
  10. 70 PRINT
  11. 80 PRINT"TYPE B TO LOAD FREQUENCY VARIABLES FROM KEYBOARD"
  12. 90 PRINT
  13. 100 PRINT"TYPE C TO EDIT FREQUENCY VARIABLE LIST"
  14. 110 PRINT
  15. 120 PRINT"TYPE D TO RUN POLYNOMIAL FILTER SYNTHESIS"
  16. 130 PRINT
  17. 140 PRINT"TYPE E TO RUN OPEN & CLOSED LOOP FREQUENCY RESPONSE"
  18. 150 PRINT
  19. 160 PRINT"TYPE F TO DETERMINE CLOSED LOOP NOISE BANDWIDTH"
  20. 170 PRINT
  21. 180 PRINT"TYPE G TO RUN CLOSED LOOP TRANSIENT RESPONSE"
  22. 190 PRINT
  23. 192 PRINT"TYPE Q TO QUIT"
  24. 194 PRINT
  25. 200 INPUT"PROGRAM CHOICE";A$
  26. 210 PRINT
  27. 220 IF A$="A" THEN 300
  28. 230 IF A$="B" THEN 320
  29. 240 IF A$="C" THEN 340
  30. 250 IF A$="D" THEN 360
  31. 260 IF A$="E" THEN 380
  32. 270 IF A$="F" THEN 400
  33. 280 IF A$="G" THEN 420
  34. 282 IF A$="Q" THEN 430
  35. 290 GOTO 15
  36. 300 GOSUB 1000
  37. 310 GOTO 15
  38. 320 GOSUB 5000
  39. 330 GOTO 15
  40. 340 GOSUB 10000
  41. 350 GOTO 15
  42. 360 GOSUB 15000
  43. 370 GOTO 15
  44. 380 GOSUB 20000
  45. 390 GOTO 15
  46. 400 GOSUB 25000
  47. 410 GOTO 15
  48. 420 GOSUB 30000
  49. 425 GOTO 15
  50. 430 PRINT
  51. 435 INPUT"QUIT (Y/N)";B$
  52. 440 IF B$="Y" THEN 460
  53. 450 GOTO 15
  54. 460 PRINT
  55. 470 INPUT"DO YOU WANT TO SAVE THE FREQUENCY VARIABLES IN A FILE (Y/N)";C$
  56. 480 IF C$="N" THEN 610
  57. 490 PRINT
  58. 500 INPUT"DECLARE FILENAME";D$
  59. 510 OPEN D$ FOR OUTPUT AS #1
  60. 515 WRITE #1,NZ%
  61. 520 IF NZ%=0 THEN 565
  62. 530 FOR I=1 TO NZ%
  63. 540 WRITE #1,ZR(I)
  64. 550 WRITE #1,ZJ(I)
  65. 560 NEXT I
  66. 565 WRITE #1,NP%
  67. 570 FOR I=1 TO NP%
  68. 580 WRITE #1,PR(I)
  69. 590 WRITE #1,PJ(I)
  70. 600 NEXT I
  71. 610 END
  72. 1000 CLS
  73. 1010 INPUT"DECLARE FILENAME";F$
  74. 1020 OPEN F$ FOR INPUT AS #1
  75. 1030 INPUT #1,NZ%
  76. 1040 IF NZ%=0 THEN 1090
  77. 1050 FOR I=1 TO NZ%
  78. 1060 INPUT #1,ZR(I)
  79. 1070 INPUT #1,ZJ(I)
  80. 1080 NEXT I
  81. 1090 INPUT #1,NP%
  82. 1100 FOR I=1 TO NP%
  83. 1110 INPUT #1,PR(I)
  84. 1120 INPUT #1,PJ(I)
  85. 1130 NEXT I
  86. 1135 CLOSE #1
  87. 1270 RETURN
  88. 5000 CLS
  89. 5010 PRINT"INPUT # OF ZEROS";
  90. 5020 INPUT NZ%
  91. 5030 PRINT"INPUT # OF POLES";
  92. 5040 INPUT NP%
  93. 5050 PRINT
  94. 5060 IF NZ%=0 THEN 5150
  95. 5070 FOR I=1 TO NZ%
  96. 5080 PRINT"ZERO #";I;"REAL PART";
  97. 5090 INPUT ZR(I)
  98. 5100 PRINT"ZERO #";I;"IMAGINARY PART";
  99. 5110 INPUT ZJ(I)
  100. 5130 NEXT I
  101. 5140 PRINT
  102. 5150 FOR I=1 TO NP%
  103. 5160 PRINT"POLE #";I;"REAL PART";
  104. 5170 INPUT PR(I)
  105. 5180 PRINT"POLE #";I;"IMAGINARY PART";
  106. 5190 INPUT PJ(I)
  107. 5200 NEXT I
  108. 5210 RETURN
  109. 10000 CLS
  110. 10010 PRINT"THERE ARE";NZ%;"ZEROES AND";NP%;"POLES"
  111. 10020 PRINT
  112. 10030 IF NZ%=0 THEN 10090
  113. 10040 FOR I=1 TO NZ%
  114. 10050 PRINT"ZERO #";I;"REAL PART IS";ZR(I)
  115. 10060 PRINT"ZERO #";I;"IMAGINARY PART IS";ZJ(I)
  116. 10070 NEXT I
  117. 10080 PRINT
  118. 10090 FOR I=1 TO NP%
  119. 10100 PRINT"POLE #";I;"REAL PART IS";PR(I)
  120. 10110 PRINT"POLE #";I;"IMAGINARY PART IS";PJ(I)
  121. 10120 NEXT I
  122. 10130 PRINT
  123. 10140 PRINT"EDIT ZEROES (Y/N)";
  124. 10150 INPUT B$
  125. 10160 PRINT
  126. 10170 IF B$="N" THEN 10750
  127. 10180 PRINT"ADD,DELETE,OR SUBSTITUTE (A,D,S)";
  128. 10190 INPUT C$
  129. 10200 PRINT
  130. 10210 IF C$="S" THEN 10630
  131. 10220 IF C$="D" THEN 10380
  132. 10230 IF C$="A" THEN 10240 ELSE 10180
  133. 10240 PRINT"HOW MANY";
  134. 10250 INPUT NC%
  135. 10260 ND%=NZ%+NC%
  136. 10270 PRINT
  137. 10280 FOR I=1 TO ND%
  138. 10290 IF I>NZ% THEN 10310
  139. 10300 GOTO 10350
  140. 10310 PRINT"ZER0 #";I;"REAL PART";
  141. 10320 INPUT ZR(I)
  142. 10330 PRINT"ZERO #";I;"IMAGINARY PART";
  143. 10340 INPUT ZJ(I)
  144. 10350 NEXT I
  145. 10360 NZ%=NZ%+NC%
  146. 10370 GOTO 10750
  147. 10380 PRINT"HOW MANY";
  148. 10390 INPUT NC%
  149. 10400 PRINT
  150. 10410 FOR J=1 TO NC%
  151. 10420 INPUT"DELETE ZERO #";D%(J)
  152. 10430 NEXT J
  153. 10440 M=0
  154. 10450 FOR J=1 TO NC%
  155. 10460 FOR I=1 TO NZ%
  156. 10470 IF I=D%(J) THEN 10510
  157. 10480 M=M+1
  158. 10490 TZR(M)=ZR(I)
  159. 10500 TZJ(M)=ZJ(I)
  160. 10510 NEXT I
  161. 10520 NEXT J
  162. 10530 NZ%=NZ%-NC%
  163. 10560 FOR I=1 TO NZ%
  164. 10570 ZR(I)=TZR(I)
  165. 10580 ZJ(I)=TZJ(I)
  166. 10590 NEXT I
  167. 10620 GOTO 10750
  168. 10630 FOR I=1 TO NZ%
  169. 10640 PRINT"ZERO #";I;"IS";ZR(I);"AND J";ZJ(I)
  170. 10650 PRINT
  171. 10660 PRINT"CHANGE (Y/N)";
  172. 10670 INPUT D$
  173. 10675 PRINT
  174. 10680 IF D$="N" THEN 10740
  175. 10700 PRINT"ZERO #";I;"REAL PART";
  176. 10710 INPUT ZR(I)
  177. 10720 PRINT"ZERO #";I;"IMAGINARY PART";
  178. 10730 INPUT ZJ(I)
  179. 10740 NEXT I
  180. 10750 PRINT
  181. 10760 PRINT"EDIT POLES (Y/N)";
  182. 10770 INPUT A$
  183. 10780 IF A$="N" THEN 11380
  184. 10790 PRINT
  185. 10800 REM START POLE EDIT
  186. 10810 PRINT"ADD,DELETE,OR SUBSTITUTE POLES (A,D,S)";
  187. 10820 INPUT A$
  188. 10830 PRINT
  189. 10840 IF A$="S" THEN 11260
  190. 10850 IF A$="D" THEN 11010
  191. 10860 IF A$="A" THEN 10870 ELSE 10810
  192. 10870 PRINT"HOW MANY";
  193. 10880 INPUT NC%
  194. 10890 ND%=NP%+NC%
  195. 10900 PRINT
  196. 10910 FOR I=1 TO ND%
  197. 10920 IF I>NP% THEN 10940
  198. 10930 GOTO 10980
  199. 10940 PRINT"POLE #";I;"REAL PART";
  200. 10950 INPUT PR(I)
  201. 10960 PRINT"POLE #";I;"IMAGINARY PART";
  202. 10970 INPUT PJ(I)
  203. 10980 NEXT I
  204. 10990 NP%=NP%+NC%
  205. 11000 GOTO 11380
  206. 11010 PRINT"HOW MANY";
  207. 11020 INPUT NC%
  208. 11030 PRINT
  209. 11040 FOR J=1 TO NC%
  210. 11050 INPUT"DELETE POLE #";D%(J)
  211. 11060 NEXT J
  212. 11070 M=O
  213. 11080 FOR J=1 TO NC%
  214. 11090 FOR I=1 TO NP%
  215. 11100 IF I=D%(J) THEN 11140
  216. 11110 M=M+1
  217. 11120 TPR(M)=PR(I)
  218. 11130 TPJ(M)=PJ(I)
  219. 11140 NEXT I
  220. 11150 NEXT J
  221. 11160 NP%=NP%-NC%
  222. 11190 FOR I=1 TO NP%
  223. 11200 PR(I)=TPR(I)
  224. 11210 PJ(I)=TPJ(I)
  225. 11220 NEXT I
  226. 11250 GOTO 11380
  227. 11260 FOR I=1 TO NP%
  228. 11270 PRINT"POLE #";I;"IS";PR(I);"AND J";PJ(I)
  229. 11280 PRINT
  230. 11290 PRINT"CHANGE (Y/N)";
  231. 11300 INPUT C$
  232. 11305 PRINT
  233. 11310 IF C$="N" THEN 11370
  234. 11330 PRINT"POLE #";I;"REAL PART";
  235. 11340 INPUT PR(I)
  236. 11350 PRINT"POLE #";I;"IMAGINARY PART";
  237. 11360 INPUT PJ(I)
  238. 11370 NEXT I
  239. 11380 RETURN
  240. 15000 CLS
  241. 15010 PRINT"REQUIRED ATTENUATION IN dB";
  242. 15020 INPUT Z21
  243. 15040 PRINT
  244. 15050 PRINT"INPUT CUTTOFF FREQUENCY RATIO OF REQUIRED ATTENUATION";
  245. 15060 INPUT W
  246. 15070 IF W<=1# THEN 15050
  247. 15080 PRINT
  248. 15090 PRINT"PERMISSABLE PASSBAND RIPPLE IN dB , 0dB FOR BUTTERWORTH";
  249. 15100 INPUT R
  250. 15120 K#=10#^(Z21/10#)
  251. 15125 IF R=0 THEN 15440
  252. 15130 RES=(10#^(R/10#))-1#
  253. 15140 RE=SQR(RES)
  254. 15150 TW=SQR((K#-1#)/RES)
  255. 15160 FOR I=1 TO 20
  256. 15170 KA#=((W+SQR(W^2#-1#))^I+(W+SQR(W^2#-1#))^(1#/I))/2#
  257. 15180 IF KA#=>TW THEN 15200
  258. 15190 NEXT I
  259. 15200 PRINT
  260. 15210 PRINT"N=";I
  261. 15230 PRINT
  262. 15240 PRINT"RESULTS SATISFACTORY (Y/N)";
  263. 15250 INPUT A$
  264. 15260 IF A$="Y" THEN 15270 ELSE 15000
  265. 15270 X=(SQR((1#/RES)+1#)+1#/RE)^(1#/I)
  266. 15280 Y=1#/X
  267. 15290 SINH=(X-Y)/2#
  268. 15300 COSH#=(X+Y)/2#
  269. 15310 N%=I-1
  270. 15320 PRINT
  271. 15330 PRINT"FREQUENCY SCALE FACTOR";
  272. 15340 INPUT KF#
  273. 15350 PRINT
  274. 15370 PRINT
  275. 15380 FOR J=0 TO N%
  276. 15390 PR(J+1+NP%)=KF#*(-SINH*(SIN(((2#*J+1#)*PI)/(2#*I))))
  277. 15400 PJ(J+1+NP%)=KF#*(COSH#*(COS(((2#*J+1#)*PI)/(2#*I))))
  278. 15420 NEXT J
  279. 15430 GOTO 15610
  280. 15440 FOR I=1 TO 20
  281. 15450 KA#=1+W^(2#*I)
  282. 15460 IF KA#=>K# THEN 15480
  283. 15470 NEXT I
  284. 15480 PRINT
  285. 15490 PRINT"N=";I
  286. 15500 PRINT
  287. 15510 INPUT"RESULTS SATISFACTORY";A$
  288. 15520 IF A$="Y" THEN 15530 ELSE 15000
  289. 15530 PRINT
  290. 15540 INPUT"FREQUENCY SCALE FACTOR";KF#
  291. 15550 N%=I
  292. 15560 FOR J=1 TO N%
  293. 15570 P(J)=PI/2#+(PI/(2#*N%))*(2#*J-1#)
  294. 15580 PR(J+NP%)=KF#*(COS(P(J)))
  295. 15590 PJ(J+NP%)=KF#*(SIN(P(J)))
  296. 15600 NEXT J
  297. 15610 N=I
  298. 15620 J=0
  299. 15622 FOR L=1 TO N
  300. 15624 TPR(L)=PR(NP%+L)
  301. 15626 TPJ(L)=PJ(NP%+L)
  302. 15628 NEXT L
  303. 15630 FOR L=1 TO N
  304. 15640 J=J+1
  305. 15670 IF ABS(TPJ(L))=>ABS((10^-6)*TPR(L)) THEN 15680 ELSE 15750
  306. 15680 IF TPJ(L)<0 THEN 15770
  307. 15690 PR(NP%+J)=TPR(L)
  308. 15700 PJ(NP%+J)=TPJ(L)
  309. 15710 PR(NP%+J+1)=TPR(L)
  310. 15720 PJ(NP%+J+1)=-TPJ(L)
  311. 15730 J=J+1
  312. 15740 GOTO 15770
  313. 15750 PR(NP%+J)=TPR(L)
  314. 15760 PJ(NP%+J)=0#
  315. 15770 NEXT L
  316. 15780 NP%=NP%+I
  317. 15790 RETURN
  318. 20000 CLS
  319. 20010 KN#=1#
  320. 20020 IF NZ%=0 THEN 20080
  321. 20030 FOR I=1 TO NZ%
  322. 20040 ZT=ABS(ZR(I))+ABS(ZJ(I))
  323. 20050 IF ZT=0 THEN 20070
  324. 20060 KN#=KN#*SQR(ZR(I)^2+ZJ(I)^2)
  325. 20070 NEXT I
  326. 20080 KD#=1#
  327. 20090 FOR I=1 TO NP%
  328. 20100 PT=ABS(PR(I))+ABS(PJ(I))
  329. 20110 IF PT=0 THEN 20130
  330. 20120 KD#=KD#*SQR(PR(I)^2+PJ(I)^2)
  331. 20130 NEXT I
  332. 20140 PRINT
  333. 20150 PRINT"INPUT LOOP GAIN";
  334. 20160 INPUT U
  335. 20170 K#=(KD#/KN#)*U
  336. 20172 PRINT
  337. 20174 INPUT"PLOT (Y/N)";P$
  338. 20180 PRINT
  339. 20190 PRINT "START FREQ.";
  340. 20200 INPUT WS
  341. 20210 PRINT"NUMBER OF DECADES";
  342. 20220 INPUT WF
  343. 20222 IF P$="Y" THEN 20252
  344. 20230 PRINT"DECADE INCREMENT";
  345. 20240 INPUT WD
  346. 20250 N%=WF/WD
  347. 20251 GOTO 20260
  348. 20252 N%=500:WD=WF/500
  349. 20260 PRINT
  350. 20270 PRINT
  351. 20272 IF P$="Y" THEN 20290
  352. 20280 PRINT USING"\            \";"W","H(W)-dB","THETA(W)","H(W)'-dB","THETA(W)'"
  353. 20290 FOR I=0 TO N%
  354. 20300 W=WS*(10^(I*WD))
  355. 20310 PM=1
  356. 20320 PT=0
  357. 20330 TD=0
  358. 20340 FOR J=1 TO NP%
  359. 20350 PM=PM/(SQR(PR(J)^2+(W-PJ(J))^2))
  360. 20360 IF PR(J)=0 THEN 20390
  361. 20370 PT=PT+ATN((W-PJ(J))/PR(J))
  362. 20380 GOTO 20400
  363. 20390 PT=PT-PI/2
  364. 20400 NEXT J
  365. 20410 IF NZ%=0 THEN 20490
  366. 20420 FOR H=1 TO NZ%
  367. 20430 PM=PM*SQR(ZR(H)^2+(W-ZJ(H))^2)
  368. 20440 IF ZR(H)=0 THEN 20470
  369. 20450 PT=PT-ATN((W-ZJ(H))/ZR(H))
  370. 20460 GOTO 20480
  371. 20470 PT=PT+PI/2
  372. 20480 NEXT H
  373. 20490 PM=PM*K#
  374. 20500 R=PM*COS(PT)
  375. 20510 S=PM*SIN(PT)
  376. 20520 R=R+1
  377. 20530 MC#=PM/(SQR(R*R+S*S))
  378. 20540 X=R/(SQR(R*R+S*S))
  379. 20550 IF 1-X*X=0 THEN 20570
  380. 20560 PC=PT-SGN(S)*(PI/2-ATN(X/SQR(1-X*X)))
  381. 20570 XM=8.68589*LOG(PM)
  382. 20580 XC=8.68589*LOG(MC#)
  383. 20582 IF P$="Y" THEN 20592
  384. 20590 PRINT USING"##.###^^^^    ";W,XM,PT,XC,PC
  385. 20591 GOTO 20600
  386. 20592 CXPLOT(I)=W:CYPLOT(I)=XC
  387. 20600 NEXT I
  388. 20601 IF P$="Y" THEN 20602 ELSE 20610
  389. 20602 CLS
  390. 20603 NCURVES!=1
  391. 20604 NPOINTS!=500
  392. 20605 CALL PLOT((NCURVES!),(NPOINTS!),CXPLOT(),CYPLOT())
  393. 20610 PRINT
  394. 20620 PRINT"NEW GAIN VALUE (Y/N)";
  395. 20630 INPUT A$
  396. 20640 PRINT
  397. 20650 IF A$="Y" THEN 20150
  398. 20660 RETURN
  399. 25000 CLS
  400. 25010 KN#=1#
  401. 25020 IF NZ%=0 THEN 25080
  402. 25030 FOR I=1 TO NZ%
  403. 25040 ZT=ABS(ZR(I))+ABS(ZJ(I))
  404. 25050 IF ZT=0 THEN 25070
  405. 25060 KN#=KN#*SQR(ZR(I)^2+ZJ(I)^2)
  406. 25070 NEXT I
  407. 25080 KD#=1#
  408. 25090 FOR I=1 TO NP%
  409. 25100 PT=ABS(PR(I))+ABS(PJ(I))
  410. 25110 IF PT=0 THEN 25130
  411. 25120 KD#=KD#*SQR(PR(I)^2+PJ(I)^2)
  412. 25130 NEXT I
  413. 25140 PRINT
  414. 25150 PRINT"INPUT LOOP GAIN";
  415. 25160 INPUT U
  416. 25170 K#=(KD#/KN#)*U
  417. 25180 PRINT
  418. 25190 PRINT"INPUT APPROXIMATE -3dB RADIAN FREQUENCY";
  419. 25200 INPUT WC
  420. 25210 PRINT
  421. 25220 XN=0
  422. 25230 FOR A%=1 TO 3
  423. 25240 IF A%=1 THEN 25270
  424. 25250 WD=WC*(10^(A%-3))
  425. 25260 GOTO 25540
  426. 25270 FOR B%=1 TO 100
  427. 25280 WD=WC/100#
  428. 25290 W=WD*B%
  429. 25300 PM=1
  430. 25310 PT=0
  431. 25320 FOR J=1 TO NP%
  432. 25330 PM=PM/(SQR(PR(J)^2+(W-PJ(J))^2))
  433. 25340 IF PR(J)=0 THEN 25370
  434. 25350 PT=PT+ATN((W-PJ(J))/PR(J))
  435. 25360 GOTO 25380
  436. 25370 PT=PT-PI/2
  437. 25380 NEXT J
  438. 25390 IF NZ%=0 THEN 25470
  439. 25400 FOR H=1 TO NZ%
  440. 25410 PM=PM*SQR(ZR(H)^2+(W-ZJ(H))^2)
  441. 25420 IF ZR(H)=0 THEN 25450
  442. 25430 PT=PT-ATN((W-ZJ(H))/ZR(H))
  443. 25440 GOTO 25460
  444. 25450 PT=PT+PI/2
  445. 25460 NEXT H
  446. 25470 PM=PM*K#
  447. 25472 IF PM=>1# AND ABS(PT)>PI THEN 25474 ELSE 25480
  448. 25474 PRINT
  449. 25476 PRINT"THE SYSTEM IS UNSTABLE"
  450. 25478 GOTO 25810
  451. 25480 R=PM*COS(PT)
  452. 25490 S=PM*SIN(PT)
  453. 25500 R=R+1
  454. 25510 XN=XN+((PM*PM)/(R*R+S*S))*WD
  455. 25520 NEXT B%
  456. 25530 IF A%=1 THEN 25790
  457. 25540 FOR C%=1 TO 90
  458. 25550 W=WD*(10+C%)
  459. 25560 PM=1
  460. 25570 PT=0
  461. 25580 FOR J=1 TO NP%
  462. 25590 PM=PM/(SQR(PR(J)^2+(W-PJ(J))^2))
  463. 25600 IF PR(J)=0 THEN 25630
  464. 25610 PT=PT+ATN((W-PJ(J))/PR(J))
  465. 25620 GOTO 25640
  466. 25630 PT=PT-PI/2
  467. 25640 NEXT J
  468. 25650 IF NZ%=0 THEN 25730
  469. 25660 FOR H=1 TO NZ%
  470. 25670 PM=PM*SQR(ZR(H)^2+(W-ZJ(H))^2)
  471. 25680 IF ZR(H)=0 THEN 25710
  472. 25690 PT=PT-ATN((W-ZJ(H))/ZR(H))
  473. 25700 GOTO 25720
  474. 25710 PT=PT+PI/2
  475. 25720 NEXT H
  476. 25730 PM=PM*K#
  477. 25740 R=PM*COS(PT)
  478. 25750 S=PM*SIN(PT)
  479. 25760 R=R+1
  480. 25770 XN=XN+((PM*PM)/(R*R+S*S))*WD
  481. 25780 NEXT C%
  482. 25790 NEXT A%
  483. 25800 PRINT "THE LOOP NOISE BANDWIDTH IS";XN;"RAD/SEC"
  484. 25810 PRINT
  485. 25820 PRINT"NEW LOOP GAIN (Y/N)";
  486. 25830 INPUT A$
  487. 25840 PRINT
  488. 25850 IF A$="N" THEN 25860 ELSE 25150
  489. 25860 RETURN
  490. 30000 CLS
  491. 30010 KN#=1
  492. 30020 IF NZ%=0 THEN 30080
  493. 30030 FOR I=1 TO NZ%
  494. 30040 ZT=ABS(ZR(I))+ABS(ZJ(I))
  495. 30050 IF ZT=0 THEN 30070
  496. 30060 KN#=KN#*SQR(ZR(I)^2+ZJ(I)^2)
  497. 30070 NEXT I
  498. 30080 KD#=1
  499. 30090 FOR I=1 TO NP%
  500. 30100 PT=ABS(PR(I))+ABS(PJ(I))
  501. 30110 IF PT=0 THEN 30130
  502. 30120 KD#=KD#*SQR(PR(I)^2+PJ(I)^2)
  503. 30130 NEXT I
  504. 30140 PRINT
  505. 30150 PRINT"INPUT LOOP GAIN";
  506. 30160 INPUT U
  507. 30170 K#=(KD#/KN#)*U
  508. 30180 PRINT
  509. 30190 INPUT"AUTOSCALE TIME BASE (Y/N)";Q$
  510. 30200 IF Q$="N" THEN 30590
  511. 30210 NO%=0
  512. 30220 FOR I=1 TO NP%
  513. 30230 IF PR(I)=0 AND PJ(I)=0 THEN 30240 ELSE 30250
  514. 30240 NO%=NO%+1
  515. 30250 NEXT I
  516. 30260 IF NO%=0 THEN 30570
  517. 30270 WS=U^(1/NO%)
  518. 30280 WL=WS/1024
  519. 30290 WU=0
  520. 30300 FOR I=20 TO 0 STEP -1
  521. 30310 W=WL*(2#^I)+WU
  522. 30320 PM=1
  523. 30330 PT=0
  524. 30340 TD=0
  525. 30350 FOR J=1 TO NP%
  526. 30360 PM=PM/(SQR(PR(J)^2+(W-PJ(J))^2))
  527. 30370 IF PR(J)=0 THEN 30400
  528. 30380 PT=PT+ATN((W-PJ(J))/PR(J))
  529. 30390 GOTO 30410
  530. 30400 PT=PT-PI/2
  531. 30410 NEXT J
  532. 30420 IF NZ%=0 THEN 30500
  533. 30430 FOR H=1 TO NZ%
  534. 30440 PM=PM*SQR(ZR(H)^2+(W-ZJ(H))^2)
  535. 30450 IF ZR(H)=0 THEN 30480
  536. 30460 PT=PT-ATN((W-ZJ(H))/ZR(H))
  537. 30470 GOTO 30490
  538. 30480 PT=PT+PI/2
  539. 30490 NEXT H
  540. 30500 PM=PM*K#
  541. 30510 IF PM<1# THEN 30530
  542. 30520 WU=WU+W
  543. 30530 NEXT I
  544. 30540 WS=.025#*PI*WU
  545. 30550 T=(2#*PI)/WS
  546. 30560 GOTO 30620
  547. 30570 PRINT
  548. 30580 PRINT"CANNOT AUTOSCALE TIME BASE"
  549. 30590 PRINT
  550. 30600 INPUT"FULL SCALE TIME BASE (IN SECONDS)";T
  551. 30610 WS=(2#*PI)/T
  552. 30620 PRINT
  553. 30630 INPUT"STEP OR IMPULSE RESPONSE (S/I)";A$
  554. 30640 PRINT
  555. 30650 C#(0)=1#
  556. 30660 C#(1)=0#
  557. 30670 FOR I=1 TO 1023
  558. 30680 W=WS*I
  559. 30690 PM=1
  560. 30700 PT=0
  561. 30710 TD=0
  562. 30720 FOR J=1 TO NP%
  563. 30730 PM=PM/(SQR(PR(J)^2+(W-PJ(J))^2))
  564. 30740 IF PR(J)=0 THEN 30770
  565. 30750 PT=PT+ATN((W-PJ(J))/PR(J))
  566. 30760 GOTO 30780
  567. 30770 PT=PT-PI/2
  568. 30780 NEXT J
  569. 30790 IF NZ%=0 THEN 30870
  570. 30800 FOR H=1 TO NZ%
  571. 30810 PM=PM*SQR(ZR(H)^2+(W-ZJ(H))^2)
  572. 30820 IF ZR(H)=0 THEN 30850
  573. 30830 PT=PT-ATN((W-ZJ(H))/ZR(H))
  574. 30840 GOTO 30860
  575. 30850 PT=PT+PI/2
  576. 30860 NEXT H
  577. 30870 PM=PM*K#
  578. 30880 IF PM =>1# AND ABS(PT)>PI THEN 30890 ELSE 30920
  579. 30890 PRINT
  580. 30900 PRINT"THE SYSTEM IS UNSTABLE"
  581. 30910 GOTO 31230
  582. 30920 R=PM*COS(PT)
  583. 30930 S=PM*SIN(PT)
  584. 30940 R=R+1
  585. 30950 MC#=PM/(SQR(R*R+S*S))
  586. 30955 MC#=MC#*(1/(1+(W/(WS*316))^6))
  587. 30960 X=R/(SQR(R*R+S*S))
  588. 30970 IF 1-X*X=0 THEN 30990
  589. 30980 PC=PT-SGN(S)*(PI/2-ATN(X/SQR(1-X*X)))
  590. 30990 PC=PC-(80*PI*I)/1023
  591. 31000 C#(2*I)=MC#*COS(PC)
  592. 31010 C#(2*I+1)=MC#*SIN(PC)
  593. 31020 NEXT I
  594. 31030 PRINT
  595. 31040 N%=10
  596. 31050 NORM%=2
  597. 31060 SCALE=1#
  598. 31070 CALL RIFT(C#(0),N%,NORM%,SCALE)
  599. 31080 PRINT
  600. 31090 PRINT
  601. 31100 IF A$="I" THEN 31140
  602. 31110 FOR I=1 TO 1023
  603. 31120 C#(I)=C#(I)+C#(I-1)-C#(0)
  604. 31130 NEXT I
  605. 31132 FOR I=1 TO 1023
  606. 31134 C#(I)=C#(I)/C#(1023)
  607. 31136 NEXT I
  608. 31140 FOR I=1 TO 1024
  609. 31150 CYPLOT(I)=C#(I-1):CXPLOT(I)=(I-1)*(T/1023)
  610. 31160 NEXT I
  611. 31162 CLS
  612. 31170 NCURVES!=1
  613. 31180 NPOINTS!=1024
  614. 31190 CALL PLOT((NCURVES!),(NPOINTS!),CXPLOT(),CYPLOT())
  615. 31200 INPUT"NEW LOOP GAIN";A$
  616. 31210 IF A$="N" THEN 31230
  617. 31220 GOTO 30000
  618. 31230 RETURN
  619.