home *** CD-ROM | disk | FTP | other *** search
/ Antennas / Antennas_CD-ROM_Walnut_Creek_September_1996.iso / mininec / amiga / fmn9.asc < prev    next >
Text File  |  1996-06-30  |  49KB  |  1,653 lines
  1. 2 ON ERROR  GOTO 60000
  2. 5     REM GEOMETRY MODIFIED 17 OCT 86 R.P.HAVILAND
  3. 6     REM SWEEP FREQUENCY ADDED JAN 87 RPH
  4. 10    REM ****** MININEC(3) **********  NOSC CODE 822 (JCL) 4-86 WITH REVS 1-9
  5. 30    DIM K!(6,2),Q(14)
  6. 40    REM ----- MAXIMUM NUMBER OF SEGMENTS (PULSES + 2 * WIRES) = 150
  7. 50    MS=150
  8. 60    DIM X(150),Y(150),Z(150)
  9. 70    REM ----- MAXIMUM NUMBER OF WIRES = 50
  10. 80    MW=50
  11. 90    DIM A(50),CA(50),CB(50),CG(50),J1(50),J2(50,2),N(50,2),S(50)
  12. 100   REM ----- MAXIMUM NUMBER OF LOADS = 11
  13. 110   ML=11
  14. 120   REM ----- MAXIMUM ORDER OF S-PARAMETER LOADS = 8
  15. 130   MA=8
  16. 140   DIM LA(2,11,8),LP(11),LS(11)
  17. 150   REM ----- MAXIMUM NUMBER OF MEDIA = 6
  18. 160   MM=6
  19. 170   REM ----- H MUST BE DIMENSIONED AT LEAST 6
  20. 180   DIM H(6),T(6),U(6),V(6),Z1(6),Z2(6)
  21. 190   REM ----- MAXIMUM NUMBER OF PULSES = 50 
  22. 200   MP=50 
  23. 210   DIM C%(50,2),CI(50),CR(50),P(50),W%(50)
  24. 220   DIM ZR(50,50),ZI(50,50)
  25. 230   REM ---- ARRAYS E,L & M DIMENSIONED TO MW+MP=100
  26. 240   DIM E(100),L(100),M(100)
  27. 250   REM:  COLOR 2,0
  28. 260   GOTO 14870
  29. 270   REM ********** KERNEL EVALUATION OF INTEGRALS I2 & I3 **********
  30. 280   IF K<0 THEN 330
  31. 290   X3=X2+T*(V1-X2)
  32. 300   Y3=Y2+T*(V2-Y2)
  33. 310   Z3=Z2+T*(V3-Z2)
  34. 320   GOTO 360
  35. 330   X3=V1+T*(X2-V1)
  36. 340   Y3=V2+T*(Y2-V2)
  37. 350   Z3=V3+T*(Z2-V3)
  38. 360   D3=X3*X3+Y3*Y3+Z3*Z3
  39. 370   REM ----- MOD FOR SMALL RADIUS TO WAVELENGTH RATIO
  40. 380   IF A(P4)<=SRM THEN D=SQR(D3):GOTO 490
  41. 390   D=D3+A2
  42. 400   IF D>0 THEN D=SQR(D)
  43. 410   REM ----- CRITERIA FOR USING REDUCED KERNEL
  44. 420   IF I6!=0 THEN 490
  45. 430   REM ----- EXACT KERNEL CALCULATION WITH ELLIPTIC INTEGRAL
  46. 440   B=D3/(D3+4*A2)
  47. 450   W0=C0+B*(C1+B*(C2+B*(C3+B*C4)))
  48. 460   W1=C5+B*(C6+B*(C7+B*(C8+B*C9)))
  49. 470   V0=(W0-W1*LOG(B))*SQR(1-B)
  50. 480   T3=T3+(V0+LOG(D3/(64*A2))/2)/P/A(P4)-1/D
  51. 490   B1=D*W
  52. 500   REM ----- EXP(-J*K*R)/R
  53. 510   T3=T3+COS(B1)/D
  54. 520   T4=T4-SIN(B1)/D
  55. 530   RETURN
  56. 540   REM ***** PSI(P1,P2,P3) = T1 + J * T2 **********
  57. 550   REM ----- ENTRIES REQUIRED FOR NEAR FIELD CALCULATION
  58. 560   X1=X0+P1*T5/2
  59. 570   Y1=Y0+P1*T6/2
  60. 580   Z1=Z0+P1*T7/2
  61. 590   X2=X1-X(P2)
  62. 600   Y2=Y1-Y(P2)
  63. 610   Z2=Z1-K*Z(P2)
  64. 620   V1=X1-X(P3)
  65. 630   V2=Y1-Y(P3)
  66. 640   V3=Z1-K*Z(P3)
  67. 650   GOTO 1350
  68. 660   I4=INT(P2)
  69. 670   I5=I4+1
  70. 680   X2=X0-(X(I4)+X(I5))/2
  71. 690   Y2=Y0-(Y(I4)+Y(I5))/2
  72. 700   Z2=Z0-K*(Z(I4)+Z(I5))/2
  73. 710   V1=X0-X(P3)
  74. 720   V2=Y0-Y(P3)
  75. 730   V3=Z0-K*Z(P3)
  76. 740   GOTO 1350
  77. 750   X2=X0-X(P2)
  78. 760   Y2=Y0-Y(P2)
  79. 770   Z2=Z0-K*Z(P2)
  80. 780   I4=INT(P3)
  81. 790   I5=I4+1
  82. 800   V1=X0-(X(I4)+X(I5))/2
  83. 810   V2=Y0-(Y(I4)+Y(I5))/2
  84. 820   V3=Z0-K*(Z(I4)+Z(I5))/2
  85. 830   GOTO 1350
  86. 840   REM ----- ENTRIES REQUIRED FOR IMPEDANCE MATRIX CALCULATION
  87. 850   REM ----- S(M) GOES IN (X1,Y1,Z1) FOR SCALAR POTENTIAL
  88. 860   REM ----- MOD FOR SMALL RADIUS TO WAVE LENGTH RATIO
  89. 870   FVS=1
  90. 880   IF K<1 THEN 940
  91. 890   IF A(P4)>SRM THEN 940
  92. 900   IF (P3=P2+1 AND P1=(P2+P3)/2) THEN 910 ELSE 940
  93. 910   T1=2*LOG(S(P4)/A(P4))
  94. 920   T2=-W*S(P4)                                          
  95. 930   RETURN
  96. 940   I4=INT(P1)
  97. 950   I5=I4+1
  98. 960   X1=(X(I4)+X(I5))/2
  99. 970   Y1=(Y(I4)+Y(I5))/2
  100. 980   Z1=(Z(I4)+Z(I5))/2
  101. 990   GOTO 1130
  102. 1000  REM ----- S(M) GOES IN (X1,Y1,Z1) FOR VECTOR POTENTIAL
  103. 1010  REM ----- MOD FOR SMALL RADIUS TO WAVE LENGTH RATIO
  104. 1020  FVS=0
  105. 1030  IF K<1 THEN 1090
  106. 1040  IF A(P4)>=SRM THEN 1090
  107. 1050  IF (I=J AND P3=P2+.5) THEN 1060 ELSE 1090
  108. 1060  T1=LOG(S(P4)/A(P4))
  109. 1070  T2=-W*S(P4)/2
  110. 1080  RETURN
  111. 1090  X1=X(P1)
  112. 1100  Y1=Y(P1)
  113. 1110  Z1=Z(P1)
  114. 1120  REM ----- S(U)-S(M) GOES IN (X2,Y2,Z2)
  115. 1130  I4=INT(P2)
  116. 1140  IF I4=P2 THEN 1200
  117. 1150  I5=I4+1
  118. 1160  X2=(X(I4)+X(I5))/2-X1
  119. 1170  Y2=(Y(I4)+Y(I5))/2-Y1
  120. 1180  Z2=K*(Z(I4)+Z(I5))/2-Z1
  121. 1190  GOTO 1240
  122. 1200  X2=X(P2)-X1
  123. 1210  Y2=Y(P2)-Y1
  124. 1220  Z2=K*Z(P2)-Z1
  125. 1230  REM ----- S(V)-S(M) GOES IN (V1,V2,V3)
  126. 1240  I4=INT(P3)
  127. 1250  IF I4=P3 THEN 1310
  128. 1260  I5=I4+1
  129. 1270  V1=(X(I4)+X(I5))/2-X1
  130. 1280  V2=(Y(I4)+Y(I5))/2-Y1
  131. 1290  V3=K*(Z(I4)+Z(I5))/2-Z1
  132. 1300  GOTO 1350
  133. 1310  V1=X(P3)-X1
  134. 1320  V2=Y(P3)-Y1
  135. 1330  V3=K*Z(P3)-Z1
  136. 1340  REM ----- MAGNITUDE OF S(U) - S(M)
  137. 1350  D0=X2*X2+Y2*Y2+Z2*Z2
  138. 1360  REM ----- MAGNITUDE OF S(V) - S(M)
  139. 1370  IF D0>0 THEN D0=SQR(D0)
  140. 1380  D3=V1*V1+V2*V2+V3*V3
  141. 1390  IF D3>0 THEN D3=SQR(D3)
  142. 1400  REM ----- SQUARE OF WIRE RADIUS
  143. 1410  A2=A(P4)*A(P4)
  144. 1420  REM ----- MAGNITUDE OF S(V) - S(U)
  145. 1430  S4=(P3-P2)*S(P4)
  146. 1440  REM ----- ORDER OF INTEGRATION
  147. 1450  REM ----- LTH ORDER GAUSSIAN QUADRATURE
  148. 1460  T1=0
  149. 1470  T2=0
  150. 1480  I6!=0
  151. 1490  F2=1
  152. 1500  L=7
  153. 1510  T=(D0+D3)/S(P4)
  154. 1520  REM ----- CRITERIA FOR EXACT KERNEL
  155. 1530  IF T>1.1 THEN 1650
  156. 1540  IF C$="N" THEN 1650
  157. 1550  IF J2(W%(I),1)=J2(W%(J),1) THEN 1600
  158. 1560  IF J2(W%(I),1)=J2(W%(J),2) THEN 1600
  159. 1570  IF J2(W%(I),2)=J2(W%(J),1) THEN 1600
  160. 1580  IF J2(W%(I),2)=J2(W%(J),2) THEN 1600
  161. 1590  GOTO 1650
  162. 1600  IF A(P4)>SRM THEN 1620
  163. 1610  IF FVS=1 THEN 910 ELSE 1060
  164. 1620  F2=2*(P3-P2)
  165. 1630  I6!=(1-LOG(S4/F2/8/A(P4)))/P/A(P4)
  166. 1640  GOTO 1670
  167. 1650  IF T>6 THEN L=3
  168. 1660  IF T>10 THEN L=1
  169. 1670  I5=L+L
  170. 1680  T3=0
  171. 1690  T4=0
  172. 1700  T=(Q(L)+.5)/F2
  173. 1710  GOSUB 280
  174. 1720  T=(.5-Q(L))/F2
  175. 1730  GOSUB 280
  176. 1740  L=L+1
  177. 1750  T1=T1+Q(L)*T3
  178. 1760  T2=T2+Q(L)*T4
  179. 1770  L=L+1
  180. 1780  IF L<I5 THEN 1680
  181. 1790  T1=S4*(T1+I6!)
  182. 1800  T2=S4*T2
  183. 1810  RETURN
  184. 1820  REM ********** COMPLEX SQUARE ROOT **********
  185. 1830  REM ----- W6+I*W7=SQR(Z6+I*Z7)
  186. 1840  T6=SQR((ABS(Z6)+SQR(Z6*Z6+Z7*Z7))/2)
  187. 1850  T7=ABS(Z7)/2/T6
  188. 1860  IF Z6<0 THEN 1910
  189. 1870  W6=T6
  190. 1880  W7=T7
  191. 1890  IF Z7<0 THEN W7=-T7
  192. 1900  RETURN
  193. 1910  W6=T7
  194. 1920  W7=T6
  195. 1930  IF Z7<0 THEN W7=-T6
  196. 1940  RETURN
  197. 1950  REM ********** IMPEDANCE MATRIX CALCULATION **********
  198. 1960  IF FLG=1 THEN 4270
  199. 1970  IF FLG=2 THEN 4760
  200. 1980  REM ----- BEGIN MATRIX FILL TIME CALCULATION
  201. 1990  OT$=TIME$
  202. 2000  Q$="MATRIX FILL  "
  203. 2010  CLS
  204. 2020  PRINT "BEGIN ";Q$
  205. 2030  REM ----- ZERO IMPEDANCE MATRIX
  206. 2040  FOR I=1 TO N
  207. 2050  FOR J=1 TO N
  208. 2060  ZR(I,J)=0
  209. 2070  ZI(I,J)=0
  210. 2080  NEXT J
  211. 2090  NEXT I
  212. 2100  REM ----- COMPUTE ROW I OF MATRIX (OBSERVATION LOOP)
  213. 2110  FOR I=1 TO N
  214. 2120  I1=ABS(C%(I,1))
  215. 2130  I2=ABS(C%(I,2))
  216. 2140  F4=SGN(C%(I,1))*S(I1)
  217. 2150  F5=SGN(C%(I,2))*S(I2)
  218. 2160  REM ----- R(M + 1/2) - R(M - 1/2) HAS COMPONENTS (T5,T6,T7)
  219. 2170  T5=F4*CA(I1)+F5*CA(I2)
  220. 2180  T6=F4*CB(I1)+F5*CB(I2)
  221. 2190  T7=F4*CG(I1)+F5*CG(I2)
  222. 2200  IF C%(I,1)=-C%(I,2) THEN T7=S(I1)*(CG(I1)+CG(I2))
  223. 2210  REM ----- COMPUTE COLUMN J OF ROW I (SOURCE LOOP)
  224. 2220  FOR J=1 TO N
  225. 2230  J1=ABS(C%(J,1))
  226. 2240  J2=ABS(C%(J,2))
  227. 2250  F4=SGN(C%(J,1))
  228. 2260  F5=SGN(C%(J,2))
  229. 2270  F6=1
  230. 2280  F7=1
  231. 2290  REM ----- IMAGE LOOP
  232. 2300  FOR K=1 TO G STEP -2
  233. 2310  IF C%(J,1)<>-C%(J,2) THEN 2350
  234. 2320  IF K<0 THEN 3320
  235. 2330  F6=F4
  236. 2340  F7=F5
  237. 2350  F8=0
  238. 2360  IF K<0 THEN 2480
  239. 2370  REM ----- SET FLAG TO AVOID REDUNANT CALCULATIONS
  240. 2380  IF I1<>I2 THEN 2460
  241. 2390  IF (CA(I1)+CB(I1))=0 THEN 2410
  242. 2400  IF C%(I,1)<>C%(I,2) THEN 2460
  243. 2410  IF J1<>J2 THEN 2460
  244. 2420  IF (CA(J1)+CB(J1))=0 THEN 2440
  245. 2430  IF C%(J,1)<>C%(J,2) THEN 2460
  246. 2440  IF I1=J1 THEN F8=1
  247. 2450  IF I=J THEN F8=2
  248. 2460  IF ZR(I,J)<>0 THEN 3170
  249. 2470  REM ----- COMPUTE PSI(M,N,N+1/2)
  250. 2480  P1=2*W%(I)+I-1
  251. 2490  P2=2*W%(J)+J-1
  252. 2500  P3=P2+.5
  253. 2510  P4=J2
  254. 2520  GOSUB 1020
  255. 2530  U1=F5*T1
  256. 2540  U2=F5*T2
  257. 2550  REM ----- COMPUTE PSI(M,N-1/2,N)
  258. 2560  P3=P2
  259. 2570  P2=P2-.5
  260. 2580  P4=J1
  261. 2590  IF F8<2 THEN GOSUB 1020
  262. 2600  V1=F4*T1
  263. 2610  V2=F4*T2
  264. 2620  REM ----- S(N+1/2)*PSI(M,N,N+1/2) + S(N-1/2)*PSI(M,N-1/2,N)
  265. 2630  X3=U1*CA(J2)+V1*CA(J1)
  266. 2640  Y3=U1*CB(J2)+V1*CB(J1)
  267. 2650  Z3=(F7*U1*CG(J2)+F6*V1*CG(J1))*K
  268. 2660  REM ----- REAL PART OF VECTOR POTENTIAL CONTRIBUTION
  269. 2670  D1=W2*(X3*T5+Y3*T6+Z3*T7)
  270. 2680  X3=U2*CA(J2)+V2*CA(J1)
  271. 2690  Y3=U2*CB(J2)+V2*CB(J1)
  272. 2700  Z3=(F7*U2*CG(J2)+F6*V2*CG(J1))*K
  273. 2710  REM ----- IMAGINARY PART OF VECTOR POTENTIAL CONTRIBUTION
  274. 2720  D2=W2*(X3*T5+Y3*T6+Z3*T7)
  275. 2730  REM ----- COMPUTE PSI(M+1/2,N,N+1)
  276. 2740  P1=P1+.5
  277. 2750  IF F8=2 THEN P1=P1-1
  278. 2760  P2=P3
  279. 2770  P3=P3+1
  280. 2780  P4=J2
  281. 2790  IF F8<>1 THEN 2830
  282. 2800  U5=F5*U1+T1
  283. 2810  U6=F5*U2+T2
  284. 2820  GOTO 2910
  285. 2830  GOSUB 870
  286. 2840  IF F8<2 THEN 2880
  287. 2850  U1=(2*T1-4*U1*F5)/S(J1)
  288. 2860  U2=(2*T2-4*U2*F5)/S(J1)
  289. 2870  GOTO 3140
  290. 2880  U5=T1
  291. 2890  U6=T2
  292. 2900  REM ----- COMPUTE PSI(M-1/2,N,N+1)
  293. 2910  P1=P1-1
  294. 2920  GOSUB 870
  295. 2930  U1=(T1-U5)/S(J2)
  296. 2940  U2=(T2-U6)/S(J2)
  297. 2950  REM ----- COMPUTE PSI(M+1/2,N-1,N)
  298. 2960  P1=P1+1
  299. 2970  P3=P2
  300. 2980  P2=P2-1
  301. 2990  P4=J1
  302. 3000  GOSUB 870
  303. 3010  U3=T1
  304. 3020  U4=T2
  305. 3030  REM ----- COMPUTE PSI(M-1/2,N-1,N)
  306. 3040  IF F8<1 THEN 3080
  307. 3050  T1=U5
  308. 3060  T2=U6
  309. 3070  GOTO 3110
  310. 3080  P1=P1-1
  311. 3090  GOSUB 870
  312. 3100  REM ----- GRADIENT OF SCALAR POTENTIAL CONTRIBUTION
  313. 3110  U1=U1+(U3-T1)/S(J1)
  314. 3120  U2=U2+(U4-T2)/S(J1)
  315. 3130  REM ----- SUM INTO IMPEDANCE MATRIX
  316. 3140  ZR(I,J)=ZR(I,J)+K*(D1+U1)
  317. 3150  ZI(I,J)=ZI(I,J)+K*(D2+U2)
  318. 3160  REM ----- AVOID REDUNANT CALCULATIONS
  319. 3170  IF J<I THEN 3320
  320. 3180  IF F8=0 THEN 3320
  321. 3190  ZR(J,I)=ZR(I,J)
  322. 3200  ZI(J,I)=ZI(I,J)
  323. 3210  REM ----- SEGMENTS ON SAME WIRE SAME DISTANCE APART HAVE SAME Z
  324. 3220  P1=J+1
  325. 3230  IF P1>N THEN 3320
  326. 3240  IF C%(P1,1)<>C%(P1,2) THEN 3320
  327. 3250  IF C%(P1,2)=C%(J,2) THEN 3280
  328. 3260  IF C%(P1,2)<>-C%(J,2) THEN 3320
  329. 3270  IF (CA(J2)+CB(J2))<>0 THEN 3320
  330. 3280  P2=I+1
  331. 3290  IF P2>N THEN 3320
  332. 3300  ZR(P2,P1)=ZR(I,J)
  333. 3310  ZI(P2,P1)=ZI(I,J)
  334. 3320  NEXT K
  335. 3330  NEXT J
  336. 3340  PCT=I/N
  337. 3350  GOSUB 15890
  338. 3360  NEXT I
  339. 3370  REM ----- END MATRIX FILL TIME CALCULATION
  340. 3380  T$=TIME$
  341. 3390  GOSUB 15790
  342. 3400  PRINT #3," "
  343. 3410  PRINT #3,"FILL MATRIX  : ";T$
  344. 3420  REM ********** ADDITION OF LOADS **********
  345. 3430  IF NL=0 THEN 3760
  346. 3440  F5=2*P*F*1000000&
  347. 3450  FOR I=1 TO NL
  348. 3460  IF L$="N" THEN 3650
  349. 3470  REM ----- S-PARAMETER LOADS
  350. 3480  U1=0
  351. 3490  U2=0
  352. 3500  D1=0
  353. 3510  D2=0
  354. 3520  S=-1
  355. 3530  FOR J=0 TO LS(I) STEP 2
  356. 3535  S=-S 
  357. 3540  U1=U1+LA(1,I,J)*S*F5^J
  358. 3550  D1=D1+LA(2,I,J)*S*F5^J
  359. 3560  L=J+1
  360. 3570  U2=U2+LA(1,I,L)*S*F5^L
  361. 3580  D2=D2+LA(2,I,L)*S*F5^L
  362. 3590  NEXT J
  363. 3600  J=LP(I)
  364. 3610  D=D1*D1+D2*D2 :IF D=0 THEN D=.000001
  365. 3620  LI=(U2*D1-D2*U1)/D
  366. 3630  LR=(U1*D1+U2*D2)/D
  367. 3640  GOTO 3680
  368. 3650  LR=LA(1,I,1)
  369. 3660  LI=LA(2,I,1)
  370. 3670  J=LP(I)
  371. 3680  F2=1/M
  372. 3690  IF C%(J,1)<>-C%(J,2) THEN 3710
  373. 3700  IF K<0 THEN F2=2/M
  374. 3710  ZR(J,J)=ZR(J,J)+F2*LI
  375. 3720  ZI(J,J)=ZI(J,J)-F2*LR
  376. 3730  NEXT I
  377. 3740  REM ********** IMPEDANCE MATRIX FACTORIZATION **********
  378. 3750  REM ----- BEGIN MATRIX FACTOR TIME CALCULATION
  379. 3760  OT$=TIME$
  380. 3770  Q$="FACTOR MATRIX"
  381. 3780  CLS
  382. 3790  PRINT "BEGIN ";Q$;
  383. 3800  X=N
  384. 3810  PCTN=X*(X-1)*(X+X-1)
  385. 3820  FOR K=1 TO N-1
  386. 3830  REM ----- SEARCH FOR PIVOT
  387. 3840  T=ZR(K,K)*ZR(K,K)+ZI(K,K)*ZI(K,K)
  388. 3850  I1=K
  389. 3860  FOR I=K+1 TO N
  390. 3870  T1=ZR(I,K)*ZR(I,K)+ZI(I,K)*ZI(I,K)
  391. 3880  IF T1<T THEN 3910
  392. 3890  I1=I
  393. 3900  T=T1
  394. 3910  NEXT I
  395. 3920  REM ----- EXCHANGE ROWS K AND I1
  396. 3930  IF I1=K THEN 4020
  397. 3940  FOR J=1 TO N
  398. 3950  T1=ZR(K,J)
  399. 3960  T2=ZI(K,J)
  400. 3970  ZR(K,J)=ZR(I1,J)
  401. 3980  ZI(K,J)=ZI(I1,J)
  402. 3990  ZR(I1,J)=T1
  403. 4000  ZI(I1,J)=T2
  404. 4010  NEXT J
  405. 4020  P(K)=I1
  406. 4030  REM ----- SUBTRACT ROW K FROM ROWS K+1 TO N
  407. 4040  FOR I=K+1 TO N
  408. 4050  REM ----- COMPUTE MULTIPLIER L(I,K)
  409. 4060  T1=(ZR(I,K)*ZR(K,K)+ZI(I,K)*ZI(K,K))/T
  410. 4070  T2=(ZI(I,K)*ZR(K,K)-ZR(I,K)*ZI(K,K))/T
  411. 4080  ZR(I,K)=T1
  412. 4090  ZI(I,K)=T2
  413. 4100  REM ----- SUBTRACT ROW K FROM ROW I
  414. 4110  FOR J=K+1 TO N
  415. 4120  ZR(I,J)=ZR(I,J)-(ZR(K,J)*T1-ZI(K,J)*T2)
  416. 4130  ZI(I,J)=ZI(I,J)-(ZR(K,J)*T2+ZI(K,J)*T1)
  417. 4140  NEXT J
  418. 4150  NEXT I
  419. 4160  X=N-K
  420. 4170  PCT=1-X*(X-1)*(X+X-1)/PCTN
  421. 4180  GOSUB 15890
  422. 4190  NEXT K
  423. 4200  REM ----- END MATRIX FACTOR TIME CALCULATION
  424. 4210  T$=TIME$
  425. 4220  GOSUB 15790
  426. 4230  PRINT
  427. 4240  PRINT #3, "FACTOR MATRIX: ";T$
  428. 4250  REM ********** SOLVE **********
  429. 4260  REM ----- COMPUTE RIGHT HAND SIDE
  430. 4270  FOR I=1 TO N
  431. 4280  CR(I)=0
  432. 4290  CI(I)=0
  433. 4300  NEXT I
  434. 4310  FOR J=1 TO NS
  435. 4320  F2=1/M
  436. 4330  IF C%(E(J),1)=-C%(E(J),2) THEN F2=2/M
  437. 4340  CR(E(J))=F2*M(J)
  438. 4350  CI(E(J))=-F2*L(J)
  439. 4360  NEXT J
  440. 4370  REM ----- PERMUTE EXCITATION
  441. 4380  FOR K=1 TO N-1
  442. 4390  I1=P(K)
  443. 4400  IF I1=K THEN 4470
  444. 4410  T1=CR(K)
  445. 4420  T2=CI(K)
  446. 4430  CR(K)=CR(I1)
  447. 4440  CI(K)=CI(I1)
  448. 4450  CR(I1)=T1
  449. 4460  CI(I1)=T2
  450. 4470  NEXT K
  451. 4480  REM ----- FORWARD ELIMINATION
  452. 4490  FOR I=2 TO N
  453. 4500  T1=0
  454. 4510  T2=0
  455. 4520  FOR J=1 TO I-1
  456. 4530  T1=T1+ZR(I,J)*CR(J)-ZI(I,J)*CI(J)
  457. 4540  T2=T2+ZR(I,J)*CI(J)+ZI(I,J)*CR(J)
  458. 4550  NEXT J
  459. 4560  CR(I)=CR(I)-T1
  460. 4570  CI(I)=CI(I)-T2
  461. 4580  NEXT I
  462. 4590  REM ----- BACK SUBSTITUTION
  463. 4600  FOR I=N TO 1 STEP -1
  464. 4610  T1=0
  465. 4620  T2=0
  466. 4630  IF I=N THEN 4680
  467. 4640  FOR J=I+1 TO N
  468. 4650  T1=T1+ZR(I,J)*CR(J)-ZI(I,J)*CI(J)
  469. 4660  T2=T2+ZR(I,J)*CI(J)+ZI(I,J)*CR(J)
  470. 4670  NEXT J
  471. 4680  T=ZR(I,I)*ZR(I,I)+ZI(I,I)*ZI(I,I)
  472. 4690  T1=CR(I)-T1
  473. 4700  T2=CI(I)-T2
  474. 4710  CR(I)=(T1*ZR(I,I)+T2*ZI(I,I))/T
  475. 4720  CI(I)=(T2*ZR(I,I)-T1*ZI(I,I))/T
  476. 4730  NEXT I
  477. 4740  FLG=2
  478. 4750  REM ********** SOURCE DATA **********
  479. 4760  PRINT #3," "
  480. 4770  PRINT #3,B$;"    SOURCE DATA     ";B$
  481. 4772 PRINT #3,"        FREQUENCY, MHZ.= ";F
  482. 4774 PRINT #3,"          RESISTANCE LOAD, OHMS = ";LA(1,1,1)
  483. 4776 PRINT #3,"          REACTANCE LOAD, OHMS = ";LA(2,1,1) 
  484. 4780  PWR=0
  485. 4790  FOR I=1 TO NS
  486. 4800  CR=CR(E(I))
  487. 4810  CI=CI(E(I))
  488. 4820  T=CR*CR+CI*CI
  489. 4830  T1=(L(I)*CR+M(I)*CI)/T
  490. 4840  T2=(M(I)*CR-L(I)*CI)/T
  491. 4850  O2=(L(I)*CR+M(I)*CI)/2
  492. 4860  PWR=PWR+O2
  493. 4870  PRINT #3,"PULSE ";E(I),"VOLTAGE = (";L(I);",";M(I);"J)"
  494. 4880  PRINT #3," ","CURRENT = (";CR;",";CI;"J)"
  495. 4890  PRINT #3," ","IMPEDANCE = (";T1;",";T2;"J)"
  496. 4900  PRINT #3," ","POWER = ";O2;" WATTS"
  497. 4910  NEXT I
  498. 4920  IF NS>1 THEN PRINT #3," "
  499. 4930  IF NS>1 THEN PRINT #3,"TOTAL POWER = ";PWR;"WATTS"
  500. 4940  RETURN
  501. 4950  REM ********** PRINT CURRENTS **********
  502.  
  503. 4960  GOSUB 1960
  504. 4970  S$="N"
  505. 4980  PRINT #3, " "
  506. 4990  PRINT #3,B$;"    CURRENT DATA    ";B$
  507. 5000  FOR K=1 TO NW
  508. 5010  IF S$="Y" THEN 5060
  509. 5020  PRINT #3, " "
  510. 5030  PRINT #3, "WIRE NO. ";K;":"
  511. 5040  PRINT #3, "PULSE","REAL","IMAGINARY","MAGNITUDE","PHASE"
  512. 5050  PRINT #3, " NO.","(AMPS)","(AMPS)","(AMPS)","(DEGREES)"
  513. 5060  N1=N(K,1)
  514. 5070   N2=N(K,2)
  515. 5080  I=N1
  516. 5090  C=C%(I,1)
  517. 5100   IF (N1=0 AND N2=0) THEN C=K
  518. 5110  IF G=1 THEN 5140
  519. 5120   IF (J1(K)=-1 AND N1>N2) THEN N2=N1
  520. 5130  IF J1(K)=-1 THEN 5240
  521. 5140   E%=1
  522. 5150  GOSUB 5710
  523. 5160  I2!=I1!
  524. 5170  J2!=J1!
  525. 5180  GOSUB 6060
  526. 5190   IF S$="N" THEN PRINT #3, I$,I1!;TAB(29);J1!;TAB(43);S1;TAB(57);S2
  527. 5200   IF S$="Y" THEN PRINT #1,I1!;",";J1!;",";S1;",";S2
  528. 5210  IF N1=0 THEN 5310
  529. 5220  IF C=K THEN 5240
  530. 5230   IF I$="J" THEN N1=N1+1
  531. 5240   FOR I=N1 TO N2-1
  532. 5250  I2!=CR(I)
  533. 5260  J2!=CI(I)
  534. 5270  GOSUB 6060
  535. 5280   IF S$="N" THEN PRINT #3, I,CR(I);TAB(29);CI(I);TAB(43);S1;TAB(57);S2
  536. 5290   IF S$="Y" THEN PRINT #1,CR(I);",";CI(I);",";S1;",";S2
  537. 5300  NEXT I
  538. 5310   I=N2
  539. 5320  C=C%(I,2)
  540. 5330   IF (N1=0 AND N2=0) THEN C=K
  541. 5340  IF G=1 THEN 5360
  542. 5350  IF J1(K)=1 THEN 5420
  543. 5360   E%=2
  544. 5370  GOSUB 5710
  545. 5380   IF (N1=0 AND N2=0) THEN 5480
  546. 5390   IF N1>N2 THEN 5480
  547. 5400  IF C=K THEN 5420
  548. 5410   IF I$="J" THEN 5480
  549. 5420   I2!=CR(N2)
  550. 5430   J2!=CI(N2)
  551. 5440  GOSUB 6060
  552. 5450   IF S$="N" THEN PRINT #3, N2,CR(N2);TAB(29);CI(N2);TAB(43);S1;TAB(57);S2
  553. 5460   IF S$="Y" THEN PRINT #1,CR(N2);",";CI(N2);",";S1;",";S2
  554. 5470  IF J1(K)=1 THEN 5530
  555. 5480  I2!=I1!
  556. 5490  J2!=J1!
  557. 5500  GOSUB 6060
  558. 5510   IF S$="N" THEN PRINT #3,I$,I1!;TAB(29);J1!;TAB(43);S1;TAB(57);S2
  559. 5520   IF S$="Y" THEN PRINT #1,I1!;",";J1!;",";S1;",";S2
  560. 5530  IF S$="Y" THEN PRINT #1," 1 , 1 , 1 , 1"
  561. 5540  NEXT K
  562. 5550  IF S$="Y" THEN 5680
  563. 5560  RETURN
  564. 5570  INPUT "SAVE CURRENTS TO A FILE (Y/N) ";S$
  565. 5575  INPUT "PRINT CURRENTS Y/N";CC$
  566. 5580  IF S$="N" THEN 5690
  567. 5590  IF S$<>"Y" THEN 5560
  568. 5600  RETURN
  569. 5640  FM$=FS$+STR$(FSN):OPEN FM$ FOR OUTPUT AS #1
  570. 5650  PRINT #3," "
  571. 5660  PRINT #1,NW;",";PWR;",C"
  572. 5670  GOTO 5000
  573. 5680  CLOSE #1:FSN=FSN+1
  574. 5690  RETURN
  575. 5700  REM ----- SORT JUNCTION CURRENTS
  576. 5710   I$="E"
  577. 5720  I1!=0! 
  578. 5730  J1!=0! 
  579. 5740  IF (C=K OR C=0) THEN 5790
  580. 5750   I$="J" 
  581. 5760  I1!=CR(I)
  582. 5770  J1!=CI(I)
  583. 5780  REM ----- CHECK FOR OTHER OVERLAPPING WIRES
  584. 5790  FOR J=1 TO NW
  585. 5800  IF J=K GOTO 6030
  586. 5810   L1=N(J,1)
  587. 5820   L2=N(J,2)
  588. 5830   IF E%=2 THEN 5890
  589. 5840   CO=C%(L1,1)
  590. 5850   CT=C%(L2,2)
  591. 5860   L3=L1
  592. 5870   L4=L2
  593. 5880  GOTO 5930
  594. 5890   CO=C%(L2,2)
  595. 5900   CT=C%(L1,1)
  596. 5910   L3=L2
  597. 5920   L4=L1
  598. 5930   IF CO=-K THEN 5950
  599. 5940  GOTO 5980
  600. 5950   I1!=I1!-CR(L3)
  601. 5960   J1!=J1!-CI(L3)
  602. 5970   I$="J"
  603. 5980   IF CT=K THEN 6000
  604. 5990  GOTO 6030
  605. 6000   I1!=I1!+CR(L4)
  606. 6010   J1!=J1!+CI(L4)
  607. 6020   I$="J"
  608. 6030  NEXT J
  609. 6040  RETURN
  610. 6050  REM ----- CALCULATE S1 AND S2
  611. 6060   I3!=I2!*I2!
  612. 6070   J3!=J2!*J2!
  613. 6080   IF (I3!>0 OR J3!>0) THEN 6110
  614. 6090   S1=0!
  615. 6100  GOTO 6120
  616. 6110   S1=SQR(I3!+J3!)
  617. 6120   IF I2!><0 THEN 6150
  618. 6130   S2=0!
  619. 6140  RETURN
  620. 6150   S2=ATN(J2!/I2!)/P0
  621. 6160  IF I2!>0 THEN RETURN
  622. 6170   S2=S2+SGN(J2!)*180
  623. 6180  RETURN
  624. 6190  REM ********** FAR FIELD CALCULATION **********
  625. 6200  IF FLG<2 THEN GOSUB 1960
  626. 6210  O2=PWR
  627. 6220  REM ----- TABULATE IMPEDANCE
  628. 6230   IF NM=0 THEN 6330
  629. 6240   FOR I=1 TO NM
  630. 6250  Z6=T(I)
  631. 6260  Z7=-V(I)/(2*P*F*8.85E-06)
  632. 6270  REM ----- FORM IMPEDANCE=1/SQR(DIELECTRIC CONSTANT)
  633. 6280  GOSUB 1840
  634. 6290  D=W6*W6+W7*W7
  635. 6300  Z1(I)=W6/D
  636. 6310  Z2(I)=-W7/D
  637. 6320  NEXT I
  638. 6330  PRINT #3," "
  639. 6340  PRINT #3,B$;"     FAR FIELD      ";B$
  640. 6350  PRINT #3," "
  641. 6355 GOTO 6730
  642. 6360  REM ----- INPUT VARIABLES FOR FAR FIELD CALCULATION
  643. 6370   INPUT "CALCULATE PATTERN IN DBI OR VOLTS/METER (D/V)";P$
  644. 6380   IF P$="D" THEN 6540
  645. 6390   IF P$<>"V" THEN 6370
  646. 6400   F1=1
  647. 6410  PRINT
  648. 6420  PRINT "PRESENT POWER LEVEL =  ";PWR;" WATTS"
  649. 6430   INPUT "CHANGE POWER LEVEL (Y/N) ";A$
  650. 6440   IF A$="N" THEN 6490    
  651. 6450   IF A$<>"Y" THEN 6430
  652. 6460  INPUT "NEW POWER LEVEL (WATTS)  ";O2
  653. 6470   IF O$>"C" THEN PRINT #3,"NEW POWER LEVEL = ";O2
  654. 6480  GOTO 6430
  655. 6490  IF (O2<0 OR O2=0) THEN O2=PWR
  656. 6500   F1=SQR(O2/PWR)
  657. 6510  PRINT
  658. 6520   INPUT "RADIAL DISTANCE (METERS) ";RD
  659. 6530   IF RD<0 THEN RD=0
  660. 6535   GOTO 6430  
  661. 6540   A$="ZENITH ANGLE : INITIAL,INCREMENT,NUMBER"
  662. 6545 PRINT  "  PATTERN CALCULATION"
  663. 6550   PRINT A$;
  664. 6560   INPUT ZA,ZC,NZ
  665. 6570   IF NZ=0 THEN NZ=1
  666. 6580   IF O$>"C" THEN PRINT #3,A$;": ";ZA;",";ZC;",";NZ
  667. 6590   A$="AZIMUTH ANGLE: INITIAL,INCREMENT,NUMBER"
  668. 6600   PRINT A$;
  669. 6610   INPUT AA,AC,NA
  670. 6620   IF NA=0 THEN NA=1
  671. 6630   IF O$>"C" THEN PRINT #3,A$;": ";AA;",";AC;",";NA
  672. 6640  PRINT #3," "
  673. 6645 RETURN
  674. 6650  REM ********** FILE FAR FIELD DATA **********
  675. 6660  INPUT "FILE PATTERN (Y/N)";SP$
  676. 6690  RETURN
  677. 6730  IF S$<>"Y" OR SP$<>"Y" THEN 6750
  678. 6735   FSN$=FS$+STR$(FSN):OPEN FSN$ FOR OUTPUT AS #1
  679. 6740   PRINT #1,NA*NZ;",";O2;",";P$
  680. 6750  PRINT #3, " "
  681. 6760   K9!=.016678/PWR
  682. 6770  REM ----- PATTERN HEADER
  683. 6780  PRINT #3,B$;"    PATTERN DATA    ";B$
  684. 6790   IF P$="V" GOTO 6840
  685. 6800  PRINT #3,"ZENITH","AZIMUTH","VERTICAL","HORIZONTAL","TOTAL"
  686. 6810   A$="PATTERN (DB)"
  687. 6820   PRINT #3," ANGLE"," ANGLE",A$,A$,A$
  688. 6830  GOTO 6910
  689. 6840   IF RD>0 THEN PRINT #3,TAB(15);"RADIAL DISTANCE = ";RD;" METERS"
  690. 6850   PRINT #3,TAB(15);"POWER LEVEL = ";PWR*F1*F1;" WATTS"
  691. 6860  PRINT #3,"ZENITH   AZIMUTH","     E(THETA)     ","     E(PHI)"
  692. 6870   A$=" MAG(V/M)    PHASE(DEG)"
  693. 6880   PRINT #3," ANGLE    ANGLE",A$,A$
  694. 6890   IF S$="Y" THEN PRINT #1,RD
  695. 6900  REM ----- LOOP OVER AZIMUTH ANGLE
  696. 6910   Q1=AA
  697. 6920   FOR I1=1 TO NA
  698. 6930   U3=Q1*P0
  699. 6940  V1=-SIN(U3)
  700. 6950  V2=COS(U3)
  701. 6960  REM ----- LOOP OVER ZENITH ANGLE
  702. 6970   Q2=ZA
  703. 6980   FOR I2=1 TO NZ
  704. 6990   U4=Q2*P0
  705. 7000   R3=COS(U4)
  706. 7010  T3=-SIN(U4)
  707. 7020   T1=R3*V2
  708. 7030   T2=-R3*V1
  709. 7040   R1=-T3*V2
  710. 7050   R2=T3*V1
  711. 7060  X1=0
  712. 7070  Y1=0
  713. 7080  Z1=0
  714. 7090  X2=0
  715. 7100  Y2=0
  716. 7110  Z2=0
  717. 7120  REM ----- IMAGE LOOP
  718. 7130  FOR K=1 TO G STEP -2
  719. 7140  FOR I=1 TO N
  720. 7150  IF K>0 THEN 7170
  721. 7160  IF C%(I,1)=-C%(I,2) THEN 8110
  722. 7170  J=2*W%(I)-1+I
  723. 7180  REM ----- FOR EACH END OF PULSE COMPUTE A CONTRIBUTION TO E-FIELD
  724. 7190  FOR F5=1 TO 2
  725. 7200  L=ABS(C%(I,F5))
  726. 7210   F3=SGN(C%(I,F5))*W*S(L)/2
  727. 7220  IF C%(I,1)<>-C%(I,2) THEN 7240
  728. 7230   IF F3<0 THEN 8100
  729. 7240  IF K=1 THEN 7270
  730. 7250   IF NM<>0 THEN 7460 
  731. 7260  REM ----- STANDARD CASE
  732. 7270   S2=W*(X(J)*R1+Y(J)*R2+Z(J)*K*R3)
  733. 7280   S1=COS(S2)
  734. 7290   S2=SIN(S2)
  735. 7300   B1=F3*(S1*CR(I)-S2*CI(I))
  736. 7310   B2=F3*(S1*CI(I)+S2*CR(I))
  737. 7320  IF C%(I,1)=-C%(I,2) THEN 7410
  738. 7330  X1=X1+K*B1*CA(L)
  739. 7340   X2=X2+K*B2*CA(L)
  740. 7350  Y1=Y1+K*B1*CB(L)
  741. 7360   Y2=Y2+K*B2*CB(L)
  742. 7370  Z1=Z1+B1*CG(L)
  743. 7380   Z2=Z2+B2*CG(L)
  744. 7390  GOTO 8100
  745. 7400  REM ----- GROUNDED ENDS
  746. 7410  Z1=Z1+2*B1*CG(L)
  747. 7420   Z2=Z2+2*B2*CG(L)
  748. 7430  GOTO 8100
  749. 7440  REM ----- REAL GROUND CASE
  750. 7450  REM ----- BEGIN BY FINDING SPECULAR DISTANCE
  751. 7460  T4=100000!
  752. 7470   IF R3=0 THEN 7490
  753. 7480   T4=-Z(J)*T3/R3
  754. 7490   B9=T4*V2+X(J)
  755. 7500   IF TB=1 THEN 7530
  756. 7510  B9=B9*B9+(Y(J)-T4*V1)^2
  757. 7515  IF B9>0 THEN B9=SQR(B9) ELSE 7530
  758. 7520  REM ----- SEARCH FOR THE CORRESPONDING MEDIUM
  759. 7530   J2=NM
  760. 7540   FOR J1=NM TO 1 STEP -1
  761. 7550   IF B9 > U(J1) THEN GOTO 7570
  762. 7560  J2=J1
  763. 7570  NEXT J1
  764. 7580  REM ----- OBTAIN IMPEDANCE AT SPECULAR POINT
  765. 7590   Z4=Z1(J2)
  766. 7600   Z5=Z2(J2)
  767. 7610  REM ----- IF PRESENT INCLUDE GROUND SCREEN IMPEDANCE IN PARALLEL
  768. 7620   IF NR=0 THEN 7740
  769. 7630   IF B9>U(1) THEN 7740
  770. 7640   R=B9+NR*RR
  771. 7650   Z8=W*R*LOG(R/(NR*RR))/NR
  772. 7660   S8=-Z5*Z8
  773. 7670   S9=Z4*Z8
  774. 7680   T8=Z4
  775. 7690   T9=Z5+Z8
  776. 7700   D=T8*T8+T9*T9
  777. 7710   Z4=(S8*T8+S9*T9)/D
  778. 7720   Z5=(S9*T8-S8*T9)/D
  779. 7730  REM ----- FORM SQR(1-Z^2*SIN^2)
  780. 7740   Z6=1-(Z4*Z4-Z5*Z5)*T3*T3
  781. 7750   Z7=-(2*Z4*Z5)*T3*T3
  782. 7760  GOSUB 1840
  783. 7770  REM ----- VERTICAL REFLECTION COEFFICIENT
  784. 7780   S8=R3-(W6*Z4-W7*Z5)
  785. 7790   S9=-(W6*Z5+W7*Z4)
  786. 7800   T8=R3+(W6*Z4-W7*Z5)
  787. 7810   T9=W6*Z5+W7*Z4
  788. 7820   D=T8*T8+T9*T9
  789. 7830   V8=(S8*T8+S9*T9)/D
  790. 7840   V9=(S9*T8-S8*T9)/D
  791. 7850  REM ----- HORIZONTAL REFLECTION COEFFICIENT
  792. 7860   S8=W6-R3*Z4
  793. 7870   S9=W7-R3*Z5
  794. 7880   T8=W6+R3*Z4
  795. 7890   T9=W7+R3*Z5
  796. 7900   D=T8*T8+T9*T9
  797. 7910   H8=(S8*T8+S9*T9)/D-V8
  798. 7920   H9=(S9*T8-S8*T9)/D-V9
  799. 7930  REM ----- COMPUTE CONTRIBUTION TO SUM
  800. 7940   S2=W*(X(J)*R1+Y(J)*R2-(Z(J)-2*H(J2))*R3)
  801. 7950   S1=COS(S2)
  802. 7960   S2=SIN(S2)
  803. 7970   B1=F3*(S1*CR(I)-S2*CI(I))
  804. 7980   B2=F3*(S1*CI(I)+S2*CR(I))
  805. 7990   W6=B1*V8-B2*V9
  806. 8000   W7=B1*V9+B2*V8
  807. 8010  D=CA(L)*V1+CB(L)*V2
  808. 8020   Z6=D*(B1*H8-B2*H9)
  809. 8030   Z7=D*(B1*H9+B2*H8)
  810. 8040  X1=X1-(CA(L)*W6+V1*Z6)
  811. 8050  X2=X2-(CA(L)*W7+V1*Z7)
  812. 8060  Y1=Y1-(CB(L)*W6+V2*Z6)
  813. 8070  Y2=Y2-(CB(L)*W7+V2*Z7)
  814. 8080  Z1=Z1+CG(L)*W6
  815. 8090  Z2=Z2+CG(L)*W7
  816. 8100  NEXT F5
  817. 8110  NEXT I
  818. 8120  NEXT K
  819. 8130   H2=(X1*T1+Y1*T2+Z1*T3)*G0
  820. 8140   H1=(X2*T1+Y2*T2+Z2*T3)*G0
  821. 8150   X4=(X1*V1+Y1*V2)*G0
  822. 8160   X3=(X2*V1+Y2*V2)*G0
  823. 8170   IF P$="D" THEN 8240
  824. 8180   IF RD=0 THEN 8390
  825. 8190   H1=H1/RD
  826. 8191   H2=H2/RD
  827. 8200   X3=X3/RD
  828. 8210   X4=X4/RD
  829. 8220  GOTO 8390
  830. 8230  REM ----- PATTERN IN DB
  831. 8240  P1=-999
  832. 8250  P2=P1
  833. 8260  P3=P1
  834. 8270   T1=K9!*(H1*H1+H2*H2)
  835. 8280   T2=K9!*(X3*X3+X4*X4)
  836. 8290  T3=T1+T2
  837. 8300  REM ----- CALCULATE VALUES IN DB
  838. 8310  IF T1>1E-30 THEN P1=4.343*LOG(T1)
  839. 8320  IF T2>1E-30 THEN P2=4.343*LOG(T2)
  840. 8330  IF T3>1E-30 THEN P3=4.343*LOG(T3)
  841. 8340   PRINT #3,Q2;TAB(15);Q1;TAB(29);P1;TAB(43);P2;TAB(57);P3
  842. 8350   IF S$="Y" THEN PRINT #1,Q2;",";Q1;",";P1;",";P2;",";P3
  843. 8360  GOTO 8630
  844. 8370  REM ----- PATTERN IN VOLTS/METER
  845. 8380  REM ----- MAGNITUDE AND PHASE OF E(THETA)
  846. 8390   S1=0 
  847. 8400   IF (H1=0 AND H2=0) THEN 8420
  848. 8410   S1=SQR(H1*H1+H2*H2)
  849. 8420   IF H1><0 THEN 8450
  850. 8430   S2=0
  851. 8440  GOTO 8480
  852. 8450   S2=ATN(H2/H1)/P0
  853. 8460   IF H1<0 THEN S2=S2+SGN(H2)*180
  854. 8470  REM ----- MAGNITUDE AND PHASE OF E(PHI)
  855. 8480   S3=0
  856. 8490   IF (X3=0 AND X4=0) THEN 8510
  857. 8500   S3=SQR(X3*X3+X4*X4)
  858. 8510   IF X3><0 THEN 8540
  859. 8520  S4=0
  860. 8530  GOTO 8560
  861. 8540   S4=ATN(X4/X3)/P0
  862. 8550   IF X3<0 THEN S4=S4+SGN(X4)*180
  863. 8560   PRINT #3,USING "###.##    ";Q2,Q1;
  864. 8570   PRINT #3,USING "       ##.###^^^^";S1*F1;
  865. 8580   PRINT #3,USING "   ###.##   ";S2;
  866. 8590   PRINT #3,USING "       ##.###^^^^";S3*F1;
  867. 8600  PRINT #3,USING "   ###.##";S4
  868. 8610   IF SP$="Y" THEN PRINT #1,Q2;",";Q1;",";S1*F1;",";S2;",";S3*F1;","S4
  869. 8620  REM ----- INCREMENT ZENITH ANGLE
  870. 8630   Q2=Q2+ZC
  871. 8640  NEXT I2
  872. 8650  REM ----- INCREMENT AZIMUTH ANGLE
  873. 8660   Q1=Q1+AC
  874. 8670  NEXT I1
  875. 8680  CLOSE #1: FSN=FSN+1
  876. 8690  RETURN
  877. 8700  REM ********** NEAR FIELD CALCULATION **********
  878. 8710  REM ----- ENSURE CURRENTS HAVE BEEN CALCULATED
  879. 8720  IF FLG<2 THEN GOSUB 1960
  880. 8730  O2=PWR
  881. 8740  PRINT #3," "
  882. 8750  PRINT #3,B$;"    NEAR FIELDS     ";B$
  883. 8760  PRINT #3," "
  884. 8770   INPUT "ELECTRIC OR MAGNETIC NEAR FIELDS (E/H) ";N$
  885. 8780   IF(N$="H" OR N$="E") GOTO 8800
  886. 8790  GOTO 8770
  887. 8800  PRINT
  888. 8810  REM ----- INPUT VARIABLES FOR NEAR FIELD CALCULATION
  889. 8820  PRINT "FIELD LOCATION(S):"
  890. 8830   A$="-COORDINATE (M): INITIAL,INCREMENT,NUMBER "
  891. 8840   PRINT "   X";A$;
  892. 8850   INPUT XI,XC,NX
  893. 8860   IF NX=0 THEN NX=1
  894. 8870   IF O$>"C" THEN PRINT #3,"X";A$;": ";XI;",";XC;",";NX
  895. 8880   PRINT "   Y";A$;
  896. 8890   INPUT YI,YC,NY
  897. 8900   IF NY=0 THEN NY=1
  898. 8910   IF O$>"C" THEN PRINT #3,"Y";A$;": ";YI;",";YC;",";NY
  899. 8920   PRINT "   Z";A$;
  900. 8930   INPUT ZI,ZC,NZ
  901. 8940   IF NZ=0 THEN NZ=1
  902. 8950   IF O$>"C" THEN PRINT #3,"Z";A$;": ";ZI;",";ZC;",";NZ
  903. 8960   F1=1
  904. 8970  PRINT
  905. 8980  PRINT "PRESENT POWER LEVEL IS ";PWR;" WATTS"
  906. 8990   INPUT "CHANGE POWER LEVEL (Y/N) ";A$
  907. 9000   IF A$="N" THEN 9050
  908. 9010   IF A$<>"Y" THEN 8990
  909. 9020  INPUT "NEW POWER LEVEL (WATTS)  ";O2
  910. 9030   IF O$>"C" THEN PRINT #3," ":PRINT #3,"NEW POWER LEVEL (WATTS) = ";O2
  911. 9040  GOTO 8990
  912. 9050  IF (O2<0 OR O2=0) THEN O2=PWR
  913. 9060  REM ----- RATIO OF POWER LEVELS
  914. 9070   F1=SQR(O2/PWR)
  915. 9080   IF N$="H" THEN F1=F1/S0/4/P
  916. 9090  PRINT
  917. 9100  REM ----- DESIGNATION OF OUTPUT FILE FOR NEAR FIELD DATA
  918. 9110  INPUT "SAVE TO A FILE (Y/N) ";S$
  919. 9120  IF S$="N" THEN 9200
  920. 9130  IF S$<>"Y" THEN 9110
  921. 9140   INPUT "FILENAME (NAME.OUT)  ";F$
  922. 9150   IF LEFT$(RIGHT$(F$,4),1)="." THEN 9160 ELSE F$=F$+".OUT"
  923. 9160   IF O$>"C" THEN PRINT #3," ":PRINT #3,"FILENAME (NAME.OUT) ";F$
  924. 9170   OPEN F$ FOR OUTPUT AS #2
  925. 9180   PRINT #2,NX*NY*NZ;",";O2;",";N$
  926. 9190  REM ----- LOOP OVER Z DIMENSION
  927. 9200   FOR IZ=1 TO NZ
  928. 9205  ZZ=ZI+(IZ-1)*ZC  
  929. 9210  REM ----- LOOP OVER Y DIMENSION
  930. 9220   FOR IY=1 TO NY
  931. 9225  YY=YI+(IY-1)*YC  
  932. 9230  REM ----- LOOP OVER X DIMENSION
  933. 9240   FOR IX=1 TO NX
  934. 9245 XX=XI+(IX-1)*XC  
  935. 9250  REM ----- NEAR FIELD HEADER
  936. 9260  PRINT #3," "
  937. 9270   IF N$="E" THEN PRINT #3,B$;"NEAR ELECTRIC FIELDS";B$
  938. 9280   IF N$="H" THEN PRINT #3,B$;"NEAR MAGNETIC FIELDS";B$
  939. 9290   PRINT #3,TAB(10);"FIELD POINT: ";"X = ";XX;" Y = ";YY;" Z = ";ZZ
  940. 9300  PRINT #3,"  VECTOR","REAL","IMAGINARY","MAGNITUDE","PHASE"
  941. 9310   IF N$="E" THEN A$=" V/M "
  942. 9320   IF N$="H" THEN A$=" AMPS/M "
  943. 9330   PRINT #3," COMPONENT  ",A$,A$,A$," DEG"
  944. 9340   A1=0
  945. 9350   A3=0
  946. 9360   A4=0
  947. 9370  REM ----- LOOP OVER THREE VECTOR COMPONENTS
  948. 9380  FOR I=1 TO 3
  949. 9390   X0=XX
  950. 9400   Y0=YY
  951. 9410   Z0=ZZ
  952. 9420   IF N$="H" THEN 9520
  953. 9430  T5=0
  954. 9440  T6=0
  955. 9450  T7=0
  956. 9460   IF I=1 THEN T5=2*S0
  957. 9470   IF I=2 THEN T6=2*S0
  958. 9480   IF I=3 THEN T7=2*S0
  959. 9490   U7=0
  960. 9500   U8=0
  961. 9510  GOTO 9620
  962. 9520   FOR J8=1 TO 6
  963. 9530   K!(J8,1)=0
  964. 9540   K!(J8,2)=0
  965. 9550   NEXT J8
  966. 9560   J9=1
  967. 9570   J8=-1
  968. 9580   IF I=1 THEN X0=XX+J8*S0/2
  969. 9590   IF I=2 THEN Y0=YY+J8*S0/2
  970. 9600   IF I=3 THEN Z0=ZZ+J8*S0/2
  971. 9610  REM ----- LOOP OVER SOURCE SEGMENTS
  972. 9620  FOR J=1 TO N
  973. 9630  J1=ABS(C%(J,1))
  974. 9640  J2=ABS(C%(J,2))
  975. 9650   J3=J2
  976. 9660   IF J1>J2 THEN J3=J1
  977. 9670  F4=SGN(C%(J,1))
  978. 9680  F5=SGN(C%(J,2))
  979. 9690  F6=1
  980. 9700  F7=1
  981. 9710  U5=0
  982. 9720  U6=0
  983. 9730  REM ----- IMAGE LOOP
  984. 9740  FOR K=1 TO G STEP -2
  985. 9750  IF C%(J,1)<>-C%(J,2) THEN 9810
  986. 9760  IF K<0 THEN 10420
  987. 9770  REM ----- COMPUTE VECTOR POTENTIAL A
  988. 9780  F6=F4
  989. 9790  F7=F5
  990. 9800  REM ----- COMPUTE PSI(0,J,J+.5)
  991. 9810  P1=0
  992. 9820   P2=2*J3+J-1
  993. 9830  P3=P2+.5
  994. 9840  P4=J2
  995. 9850  GOSUB 750                                                                                       
  996. 9860  U1=T1*F5
  997. 9870  U2=T2*F5
  998. 9880  REM ----- COMPUTE PSI(0,J-.5,J)
  999. 9890  P3=P2
  1000. 9900  P2=P2-.5
  1001. 9910  P4=J1
  1002. 9920  GOSUB 660
  1003. 9930  V1=F4*T1
  1004. 9940  V2=F4*T2
  1005. 9950  REM ----- REAL PART OF VECTOR POTENTIAL CONTRIBUTION
  1006. 9960  X3=U1*CA(J2)+V1*CA(J1)
  1007. 9970  Y3=U1*CB(J2)+V1*CB(J1)
  1008. 9980  Z3=(F7*U1*CG(J2)+F6*V1*CG(J1))*K
  1009. 9990  REM ----- IMAGINARY PART OF VECTOR POTENTIAL CONTRIBUTION
  1010. 10000 X5=U2*CA(J2)+V2*CA(J1)
  1011. 10010 Y5=U2*CB(J2)+V2*CB(J1)
  1012. 10020 Z5=(F7*U2*CG(J2)+F6*V2*CG(J1))*K
  1013. 10030 REM ----- MAGNETIC FIELD CALCULATION COMPLETED
  1014. 10040 IF N$="H" THEN 10360
  1015. 10050 D1=(X3*T5+Y3*T6+Z3*T7)*W2
  1016. 10060 D2=(X5*T5+Y5*T6+Z5*T7)*W2
  1017. 10070 REM ----- COMPUTE PSI(.5,J,J+1)
  1018. 10080 P1=.5
  1019. 10090 P2=P3
  1020. 10100 P3=P3+1
  1021. 10110 P4=J2
  1022. 10120 GOSUB 560
  1023. 10130 U1=T1
  1024. 10140 U2=T2
  1025. 10150 REM ----- COMPUTE PSI(-.5,J,J+1)
  1026. 10160 P1=-P1
  1027. 10170 GOSUB 560
  1028. 10180 U1=(T1-U1)/S(J2)
  1029. 10190 U2=(T2-U2)/S(J2)
  1030. 10200 REM ----- COMPUTE PSI(.5,J-1,J)
  1031. 10210 P1=-P1
  1032. 10220 P3=P2
  1033. 10230 P2=P2-1
  1034. 10240 P4=J1
  1035. 10250 GOSUB 560
  1036. 10260 U3=T1
  1037. 10270 U4=T2
  1038. 10280 REM ----- COMPUTE PSI(-.5,J-1,J)
  1039. 10290 P1=-P1
  1040. 10300 GOSUB 560
  1041. 10310 REM ----- GRADIENT OF SCALAR POTENTIAL
  1042. 10320 U5=(U1+(U3-T1)/S(J1)+D1)*K+U5
  1043. 10330 U6=(U2+(U4-T2)/S(J1)+D2)*K+U6
  1044. 10340 GOTO 10420
  1045. 10350 REM ----- COMPONENTS OF VECTOR POTENTIAL A
  1046. 10360 K!(1,J9)=K!(1,J9)+(X3*CR(J)-X5*CI(J))*K
  1047. 10370 K!(2,J9)=K!(2,J9)+(X5*CR(J)+X3*CI(J))*K
  1048. 10380 K!(3,J9)=K!(3,J9)+(Y3*CR(J)-Y5*CI(J))*K
  1049. 10390 K!(4,J9)=K!(4,J9)+(Y5*CR(J)+Y3*CI(J))*K
  1050. 10400 K!(5,J9)=K!(5,J9)+(Z3*CR(J)-Z5*CI(J))*K
  1051. 10410 K!(6,J9)=K!(6,J9)+(Z5*CR(J)+Z3*CI(J))*K
  1052. 10420 NEXT K
  1053. 10430 IF N$="H" THEN 10460
  1054. 10440 U7=U5*CR(J)-U6*CI(J)+U7
  1055. 10450 U8=U6*CR(J)+U5*CI(J)+U8
  1056. 10460 NEXT J
  1057. 10470 IF N$="E" THEN 10690
  1058. 10480 REM ----- DIFFERENCES OF VECTOR POTENTIAL A
  1059. 10490 J8=1
  1060. 10500 J9=J9+1
  1061. 10510 IF J9=2 THEN 9580
  1062. 10520 ON I GOTO 10530,10580,10630
  1063. 10530 H(3)=K!(5,1)-K!(5,2)
  1064. 10540 H(4)=K!(6,1)-K!(6,2)
  1065. 10550 H(5)=K!(3,2)-K!(3,1)
  1066. 10560 H(6)=K!(4,2)-K!(4,1)
  1067. 10570 GOTO 10910
  1068. 10580 H(1)=K!(5,2)-K!(5,1)
  1069. 10590 H(2)=K!(6,2)-K!(6,1)
  1070. 10600 H(5)=H(5)-K!(1,2)+K!(1,1)
  1071. 10610 H(6)=H(6)-K!(2,2)+K!(2,1)
  1072. 10620 GOTO 10910
  1073. 10630 H(1)=H(1)-K!(3,2)+K!(3,1)
  1074. 10640 H(2)=H(2)-K!(4,2)+K!(4,1)
  1075. 10650 H(3)=H(3)+K!(1,2)-K!(1,1)
  1076. 10660 H(4)=H(4)+K!(2,2)-K!(2,1)
  1077. 10670 GOTO 10910
  1078. 10680 REM ----- IMAGINARY PART OF ELECTRIC FIELD
  1079. 10690 U7=-M*U7/S0
  1080. 10700 REM ----- REAL PART OF ELECTRIC FIELD
  1081. 10710 U8=M*U8/S0
  1082. 10720 REM ----- MAGNITUDE AND PHASE CALCULATION
  1083. 10730 S1=0
  1084. 10740 IF (U7=0 AND U8=0) THEN 10760
  1085. 10750 S1=SQR(U7*U7+U8*U8)
  1086. 10760 S2=0
  1087. 10770 IF U8<>0 THEN S2=ATN(U7/U8)/P0
  1088. 10780 IF U8>0 THEN 10800
  1089. 10790 S2=S2+SGN(U7)*180
  1090. 10800 IF I=1 THEN PRINT #3,"   X  ",
  1091. 10810 IF I=2 THEN PRINT #3,"   Y  ",
  1092. 10820 IF I=3 THEN PRINT #3,"   Z  ",
  1093. 10830 PRINT #3,TAB(15);F1*U8;TAB(29);F1*U7;TAB(43);F1*S1;TAB(57);S2
  1094. 10840 IF S$="Y" THEN PRINT #2,F1*U8;",";F1*U7;",";F1*S1;",";S2
  1095. 10850 REM ----- CALCULATION FOR PEAK ELECTRIC FIELD
  1096. 10860 S1=S1*S1
  1097. 10870 S2=S2*P0
  1098. 10880 A1=A1+S1*COS(2*S2)
  1099. 10890 A3=A3+S1*SIN(2*S2)
  1100. 10900 A4=A4+S1
  1101. 10910 NEXT I
  1102. 10920 IF N$="E" THEN 11150
  1103. 10930 REM ----- MAGNETIC FIELD MAGNITUDE AND PHASE CALCULATION
  1104. 10940 FOR I=1 TO 5 STEP 2
  1105. 10950 S1=0
  1106. 10960 IF (H(I)=0 AND H(I+1)=0) THEN 10980
  1107. 10970 S1=SQR(H(I)*H(I)+H(I+1)*H(I+1))
  1108. 10980 S2=0
  1109. 10990 IF H(I)<>0 THEN S2=ATN(H(I+1)/H(I))/P0
  1110. 11000 IF H(I)>0 THEN 11020
  1111. 11010 S2=S2+SGN(H(I+1))*180
  1112. 11020 IF I=1 THEN PRINT #3,"   X  ",
  1113. 11030 IF I=3 THEN PRINT #3,"   Y  ",
  1114. 11040 IF I=5 THEN PRINT #3,"   Z  ",
  1115. 11050 PRINT #3,TAB(15);F1*H(I);TAB(29);F1*H(I+1);TAB(43);F1*S1;TAB(57);S2
  1116. 11060 IF S$="Y" THEN PRINT #2,F1*H(I);",";F1*H(I+1);",";F1*S1;",";S2
  1117. 11070 REM ----- CALCULATION FOR PEAK MAGNETIC FIELD
  1118. 11080 S1=S1*S1
  1119. 11090 S2=S2*P0
  1120. 11100 A1=A1+S1*COS(2*S2)
  1121. 11110 A3=A3+S1*SIN(2*S2)
  1122. 11120 A4=A4+S1
  1123. 11130 NEXT I
  1124. 11140 REM ----- PEAK FIELD CALCULATION
  1125. 11150 PK=SQR(A4/2+SQR(A1*A1+A3*A3)/2)
  1126. 11160 PRINT #3,"   MAXIMUM OR PEAK FIELD = ";F1*PK;A$
  1127. 11170 IF (S$="Y" AND N$="E") THEN PRINT #2,F1*PK;",";O2
  1128. 11180 IF (S$="Y" AND N$="H") THEN PRINT #2,F1*PK;",";O2
  1129. 11190 IF S$="Y" THEN PRINT #2,XX;",";YY;",";ZZ
  1130. 1071 U8=M*U8/S0
  1131. 11220 NEXT IX
  1132. 11250 NEXT IY
  1133. 11280 NEXT IZ
  1134. 11290 CLOSE #2
  1135. 11300 RETURN
  1136. 11310 REM ********** FREQUENCY INPUT **********
  1137. 11320 REM ----- SET FLAG
  1138. 11330 PRINT
  1139. 11340 INPUT "FREQUENCY (MHZ)";F
  1140. 11350 IF F=0 THEN F=299.8
  1141. 11360 IF O$>"C" THEN PRINT #3, " ":PRINT #3, "FREQUENCY (MHZ):";F
  1142. 11370 W=299.8/F
  1143. 11380 REM -----VIRTUAL DIPOLE LENGTH FOR NEAR FIELD CALCULATION
  1144. 11390 S0=.001*W
  1145. 11400 REM ----- 1 / (4 * PI * OMEGA * EPSILON)
  1146. 11410 M=4.77783352#*W
  1147. 11420 REM ----- SET SMALL RADIUS MODIFICATION CONDITION
  1148. 11430 SRM=.0001*W
  1149. 11440 PRINT #3, "    WAVE LENGTH = ";W;" METERS"
  1150. 11450 REM ----- 2 PI / WAVELENGTH
  1151. 11460 W=2*P/W
  1152. 11470 W2=W*W/2
  1153. 11480 FLG=0
  1154. 11490 RETURN
  1155. 11500 REM ********** GEOMETRY INPUT **********
  1156. 11510 REM ----- WHEN GEOMETRY IS CHANGED, ENVIRONMENT MUST BE CHECKED
  1157. 11520 GOSUB 13590
  1158. 11530 PRINT
  1159. 11540 IF INFILE THEN 11600
  1160. 11550 INPUT "NO. OF WIRES";NW
  1161. 11560 IF NW=0 THEN RETURN
  1162. 11570 IF NW<=MW THEN 11600
  1163. 11580 PRINT "NUMBER OF WIRES EXCEEDS DIMENSION..."
  1164. 11590 GOTO 11550
  1165. 11600 IF O$>"C" THEN PRINT #3," ":PRINT #3,"NO. OF WIRES:";NW
  1166. 11610 REM ----- INITIALIZE NUMBER OF PULSES TO ZERO
  1167. 11620 N=0
  1168. 11630 FOR I=1 TO NW
  1169. 11640 IF INFILE THEN GOSUB 15470:GOTO 11900
  1170. 11650 PRINT
  1171. 11660 PRINT "WIRE NO.";I
  1172. 11670 INPUT "   NO. OF SEGMENTS";S1
  1173. 11680 IF S1=0 THEN 11530
  1174. 11690 A$="   END ONE COORDINATES (X,Y,Z)"
  1175. 11700 PRINT A$;
  1176. 11710 INPUT X1,Y1,Z1
  1177. 11720 IF G<0 AND Z1<0 THEN PRINT "Z CANNOT BE NEGATIVE":GOTO 11700
  1178. 11730 A$="   END TWO COORDINATES (X,Y,Z)"
  1179. 11740 PRINT A$;
  1180. 11750 INPUT X2,Y2,Z2
  1181. 11760 IF G<0 AND Z2<0 THEN PRINT "Z CANNOT BE NEGATIVE":GOTO 11740
  1182. 11770 IF X1=X2 AND Y1=Y2 AND Z1=Z2 THEN PRINT"ZERO LENGTH WIRE.":GOTO 11660
  1183. 11780 A$="   RADIUS"
  1184. 11790 PRINT "                     "A$;
  1185. 11800 INPUT A(I)
  1186. 11810 IF A(I)<=0! THEN 11790
  1187. 11820 REM ----- DETERMINE CONNECTIONS
  1188. 11830 IF O$>"C" THEN PRINT #3," ":PRINT #3,"WIRE NO.";I
  1189. 11840 GOSUB 12890
  1190. 11850 PRINT "CHANGE WIRE NO. ";I;" (Y/N) ";
  1191. 11860 INPUT A$
  1192. 11870 IF A$="Y" THEN 11650
  1193. 11880 IF A$<>"N" THEN 11850
  1194. 11890 REM ----- COMPUTE DIRECTION COSINES
  1195. 11900 X3=X2-X1
  1196. 11910 Y3=Y2-Y1
  1197. 11920 Z3=Z2-Z1
  1198. 11930 D=SQR(X3*X3+Y3*Y3+Z3*Z3)
  1199. 11940 CA(I)=X3/D
  1200. 11950 CB(I)=Y3/D
  1201. 11960 CG(I)=Z3/D
  1202. 11970 S(I)=D/S1
  1203. 11980 REM ----- COMPUTE CONNECTIVITY DATA (PULSES N1 TO N)
  1204. 11990 N1=N+1
  1205. 12000 N(I,1)=N1
  1206. 12010 IF (S1=1 AND I1=0) THEN N(I,1)=0
  1207. 12020 N=N1+S1
  1208. 12030 IF I1=0 THEN N=N-1
  1209. 12040 IF I2=0 THEN N=N-1
  1210. 12050 IF N>MP THEN PRINT "PULSE NUMBER EXCEEDS DIMENSION":CLOSE:GOTO 11550
  1211. 12060 N(I,2)=N
  1212. 12070 IF (S1=1 AND I2=0) THEN N(I,2)=0
  1213. 12080 IF N<N1 THEN 12442
  1214. 12090 FOR J=N1 TO N
  1215. 12100 C%(J,1)=I
  1216. 12110 C%(J,2)=I
  1217. 12120 W%(J)=I
  1218. 12130 NEXT J
  1219. 12140 C%(N1,1)=I1
  1220. 12150 C%(N,2)=I2
  1221. 12160 REM ----- COMPUTE COORDINATES OF BREAK POINTS
  1222. 12170 I1=N1+2*(I-1)
  1223. 12180 I3=I1
  1224. 12190 X(I1)=X1
  1225. 12200 Y(I1)=Y1
  1226. 12210 Z(I1)=Z1
  1227. 12220 IF C%(N1,1)=0 THEN 12300
  1228. 12230 I2=ABS(C%(N1,1))
  1229. 12240 F3=SGN(C%(N1,1))*S(I2)
  1230. 12250 X(I1)=X(I1)-F3*CA(I2)
  1231. 12260 Y(I1)=Y(I1)-F3*CB(I2)
  1232. 12270 IF C%(N1,1)=-I THEN F3=-F3
  1233. 12280 Z(I1)=Z(I1)-F3*CG(I2)
  1234. 12290 I3=I3+1
  1235. 12300 I6=N+2*I
  1236. 12310 FOR I4=I1+1 TO I6
  1237. 12320 J=I4-I3
  1238. 12330 X(I4)=X1+J*X3/S1
  1239. 12340 Y(I4)=Y1+J*Y3/S1
  1240. 12350 Z(I4)=Z1+J*Z3/S1
  1241. 12360 NEXT I4
  1242. 12370 IF C%(N,2)=0 THEN 12450
  1243. 12380 I2=ABS(C%(N,2))
  1244. 12390 F3=SGN(C%(N,2))*S(I2)
  1245. 12400 I3=I6-1
  1246. 12410 X(I6)=X(I3)+F3*CA(I2)
  1247. 12420 Y(I6)=Y(I3)+F3*CB(I2)
  1248. 12430 IF I=-C%(N,2) THEN F3=-F3
  1249. 12440 Z(I6)=Z(I3)+F3*CG(I2)
  1250. 12441 GOTO 12450
  1251. 12442 I1=N1-2*(I-1): REM SINGLE SEGMENT/PULSE CASE
  1252. 12443 X(I1)=X1
  1253. 12444 Y(I1)=Y1
  1254. 12445 Z(I1)=Z1
  1255. 12446 I1=I1+1
  1256. 12447 X(I1)=X2
  1257. 12448 Y(I1)=Y2
  1258. 12449 Z(I1)=Z2
  1259. 12450 NEXT I
  1260. 12460 REM ********** GEOMETRY OUTPUT **********
  1261. 12470 PRINT #3, " "
  1262. 12480 PRINT #3, "                  **** ANTENNA GEOMETRY ****"
  1263. 12490 IF N>0 THEN 12540
  1264. 12500 PRINT
  1265. 12510 PRINT "NUMBER OF PULSES IS ZERO....RE-ENTER GEOMETRY"
  1266. 12520 PRINT
  1267. 12530 GOTO 11550
  1268. 12540 K=1
  1269. 12550 J=0
  1270. 12560 FOR I=1 TO N
  1271. 12570 I1=2*W%(I)-1+I
  1272. 12580 IF K>NW THEN 12690
  1273. 12590 IF K=J THEN 12690
  1274. 12600 J=K
  1275. 12610 PRINT #3," "
  1276. 12620 PRINT #3,"WIRE NO. ";K;" COORDINATES",,,"CONNECTION PULSE"
  1277. 12630 PRINT #3,"X","Y","Z","RADIUS","END1 END2  NO."
  1278. 12640 IF (N(K,1)><0 OR  N(K,2)><0) THEN 12690
  1279. 12650 PRINT #3,"-","-","-","    -"," -    -    0"
  1280. 12660 K=K+1
  1281. 12670 IF K>NW THEN 12760
  1282. 12680 GOTO 12600
  1283. 12690 PRINT #3,X(I1);TAB(15);Y(I1);TAB(29);Z(I1);TAB(43);A(W%(I));TAB(57);
  1284. 12700 PRINT #3, USING "###  ###   ##";C%(I,1),C%(I,2),I
  1285. 12710 IF (I=N(K,2) OR N(K,1)=N(K,2) OR C%(I,2)=0) THEN K=K+1
  1286. 12720 IF C%(I,1)=0 THEN C%(I,1)=W%(I)
  1287. 12730 IF C%(I,2)=0 THEN C%(I,2)=W%(I)
  1288. 12740 IF (K=NW AND N(K,1)=0 AND N(K,2)=0) THEN 12600
  1289. 12750 IF (I=N AND K<NW) THEN 12600
  1290. 12760 NEXT I
  1291. 12770 PRINT
  1292. 12780 CLOSE 1:IF INFILE THEN INFILE=0:IF O$>"C" THEN 12830
  1293. 12790 INPUT "    CHANGE GEOMETRY (Y/N) ";A$
  1294. 12800 IF A$="Y" THEN 11530
  1295. 12810 IF A$<>"N" THEN 12790
  1296. 12820 REM ----- EXCITATION INPUT
  1297. 12830 GOSUB 14200
  1298. 12840 REM ----- LOADS/NETWORKS INPUT
  1299. 12850 GOSUB 14450
  1300. 12860 FLG=0
  1301. 12870 RETURN
  1302. 12880 REM ********** CONNECTIONS **********
  1303. 12890 E(I)=X1
  1304. 12900 L(I)=Y1
  1305. 12910 M(I)=Z1
  1306. 12920 E(I+NW)=X2
  1307. 12930 L(I+NW)=Y2
  1308. 12940 M(I+NW)=Z2
  1309. 12950 G%=0
  1310. 12960 I1=0
  1311. 12970 I2=0
  1312. 12980 J1(I)=0
  1313. 12990 J2(I,1)=-I
  1314. 13000 J2(I,2)=-I
  1315. 13010 IF G=1 THEN 13130
  1316. 13020 REM ----- CHECK FOR GROUND CONNECTION
  1317. 13030 IF Z1=0 THEN 13050
  1318. 13040 GOTO 13080
  1319. 13050 I1=-I
  1320. 13060 J1(I)=-1
  1321. 13070 GOTO 13300
  1322. 13080 IF Z2=0 THEN 13100
  1323. 13090 GOTO 13130
  1324. 13100 I2=-I
  1325. 13110 J1(I)=1
  1326. 13120 G%=1
  1327. 13130 IF I=1 THEN 13480
  1328. 13140 FOR J=1 TO I-1
  1329. 13150 REM ----- CHECK FOR END1 TO END1
  1330. 13160 IF (X1=E(J) AND Y1=L(J) AND Z1=M(J)) THEN 13180
  1331. 13170 GOTO 13230
  1332. 13180 I1=-J
  1333. 13190 J2(I,1)=J
  1334. 13200 IF J2(J,1)=-J THEN J2(J,1)=J
  1335. 13210 GOTO 13300
  1336. 13220 REM ----- CHECK FOR END1 TO END2
  1337. 13230 IF (X1=E(J+NW) AND Y1=L(J+NW) AND Z1=M(J+NW)) THEN 13250
  1338. 13240 GOTO 13290
  1339. 13250 I1=J
  1340. 13260 J2(I,1)=J
  1341. 13270 IF J2(J,2)=-J THEN J2(J,2)=J
  1342. 13280 GOTO 13300
  1343. 13290 NEXT J
  1344. 13300 IF G%=1 THEN 13480
  1345. 13310 IF I=1 THEN 13480
  1346. 13320 FOR J=1 TO I-1
  1347. 13330 REM ----- CHECK END2 TO END2
  1348. 13340 IF (X2=E(J+NW) AND Y2=L(J+NW) AND Z2=M(J+NW)) THEN 13360
  1349. 13350 GOTO 13410
  1350. 13360 I2=-J
  1351. 13370 J2(I,2)=J
  1352. 13380 IF J2(J,2)=-J THEN J2(J,2)=J
  1353. 13390 GOTO 13480
  1354. 13400 REM ----- CHECK FOR END2 TO END1
  1355. 13410 IF (X2=E(J) AND Y2=L(J) AND Z2=M(J)) THEN 13430
  1356. 13420 GOTO 13470
  1357. 13430 I2=J
  1358. 13440 J2(I,2)=J
  1359. 13450 IF J2(J,1)=-J THEN J2(J,1)=J
  1360. 13460 GOTO 13480
  1361. 13470 NEXT J
  1362. 13480 PRINT #3,"            COORDINATES","  ","  ","END         NO. OF"
  1363. 13490 PRINT #3,"   X","   Y","   Z","RADIUS     CONNECTION     SEGMENTS"
  1364. 13500 PRINT #3,X1;TAB(15);Y1;TAB(29);Z1;TAB(57);I1
  1365. 13510 PRINT #3,X2;TAB(15);Y2;TAB(29);Z2;TAB(43);A(I);TAB(57);I2;TAB(71);S1
  1366. 13520 RETURN
  1367. 13530 REM ********** ENVIROMENT INPUT **********
  1368. 13540 PRINT
  1369. 13550 PRINT "                        **** WARNING ****"
  1370. 13560 PRINT "REDO GEOMETRY TO ENSURE PROPER GROUND CONNECTION/DISCONNECTION"
  1371. 13570 PRINT
  1372. 13580 REM ----- INITIALIZE NUMBER OF RADIAL WIRES TO ZERO
  1373. 13590 NR=0
  1374. 13600 REM ----- SET ENVIRONMENT
  1375. 13610 PRINT #3," "
  1376. 13620 A$="ENVIRONMENT (+1 FOR FREE SPACE, -1 FOR GROUND PLANE)"
  1377. 13630 PRINT A$;
  1378. 13640 INPUT G
  1379. 13650 IF O$>"C" THEN PRINT #3,A$;": ";G
  1380. 13660 IF G=1 THEN 14180
  1381. 13670 IF G<>-1 THEN 13630
  1382. 13680 REM ----- NUMBER OF MEDIA
  1383. 13690 A$=" NUMBER OF MEDIA (0 FOR PERFECTLY CONDUCTING GROUND)"
  1384. 13700 PRINT A$;
  1385. 13710 INPUT NM
  1386. 13720 IF NM<=MM THEN 13750
  1387. 13730 PRINT "NUMBER OF MEDIA EXCEEDS DIMENSION..."
  1388. 13740 GOTO 13700
  1389. 13750 IF O$>"C" THEN PRINT #3,A$;": ";NM
  1390. 13760 REM ----- INITIALIZE BOUNDARY TYPE
  1391. 13770 TB=1
  1392. 13780 IF NM=0 THEN 14180
  1393. 13790 IF NM=1 THEN 13860
  1394. 13800 REM ----- TYPE OF BOUNDARY
  1395. 13810 A$=" TYPE OF BOUNDARY (1-LINEAR, 2-CIRCULAR)"
  1396. 13820 PRINT "            ";A$;
  1397. 13830 INPUT TB
  1398. 13840 IF O$>"C" THEN PRINT #3,A$;": ";TB
  1399. 13850 REM ----- BOUNDARY CONDITIONS
  1400. 13860 FOR I=1 TO NM
  1401. 13870 PRINT "MEDIA";I
  1402. 13880 A$=" RELATIVE DIELECTRIC CONSTANT, CONDUCTIVITY"
  1403. 13890 PRINT "         ";A$;
  1404. 13900 INPUT T(I),V(I)
  1405. 13910 IF O$>"C" THEN PRINT #3,A$;": ";T(I)","V(I)
  1406. 13920 IF I>1 THEN 14040
  1407. 13930 IF TB=1 THEN 14040
  1408. 13940 A$=" NUMBER OF RADIAL WIRES IN GROUND SCREEN"
  1409. 13950 PRINT "            ";A$;
  1410. 13960 INPUT NR
  1411. 13970 IF O$>"C" THEN PRINT #3,A$;": ";NR
  1412. 13980 IF NR=0 THEN 14040
  1413. 13990 A$=" RADIUS OF RADIAL WIRES"
  1414. 14000 PRINT "                             ";A$;
  1415. 14010 INPUT RR
  1416. 14020 IF O$>"C" THEN PRINT #3,A$;": ";RR
  1417. 14030 REM ----- INITIALIZE COORDINATE OF MEDIA INTERFACE
  1418. 14040 U(I)=1000000!
  1419. 14050 REM ----- INITIALIZE HEIGHT OF MEDIA
  1420. 14060 H(I)=0
  1421. 14070 IF I=NM THEN 14120
  1422. 14080 A$=" X OR R COORDINATE OF NEXT MEDIA INTERFACE"
  1423. 14090 PRINT "          ";A$;
  1424. 14100 INPUT U(I)
  1425. 14110 IF O$>"C" THEN PRINT #3,A$;": ";U(I)
  1426. 14120 IF I=1 THEN 14170
  1427. 14130 A$=" HEIGHT OF MEDIA"
  1428. 14140 PRINT "                                    ";A$;
  1429. 14150 INPUT H(I)
  1430. 14160 IF O$>"C" THEN PRINT #3,A$;": ";H(I)
  1431. 14170 NEXT I
  1432. 14180 RETURN
  1433. 14190 REM ********** EXCITATION INPUT **********
  1434. 14200 PRINT
  1435. 14210 A$="NO. OF SOURCES "
  1436. 14220 PRINT A$;
  1437. 14230 INPUT NS
  1438. 14240 IF NS<1 THEN NS=1
  1439. 14250 IF NS<=MP THEN 14280
  1440. 14260 PRINT "NO. OF SOURCES EXCEEDS DIMENSION ..."
  1441. 14270 GOTO 14220
  1442. 14280 IF O$>"C" THEN PRINT #3," ":PRINT #3, A$;": ";NS
  1443. 14290 FOR I=1 TO NS
  1444. 14300 PRINT
  1445. 14310 PRINT "SOURCE NO. ";I;":"
  1446. 14320 A$="PULSE NO., VOLTAGE MAGNITUDE, PHASE (DEGREES)"
  1447. 14330 PRINT A$;
  1448. 14340 INPUT E(I),VM,VP
  1449. 14350 IF E(I)<=N THEN 14380
  1450. 14360 PRINT "PULSE NUMBER EXCEEDS NUMBER OF PULSES..."
  1451. 14370 GOTO 14330
  1452. 14380 IF O$>"C" THEN PRINT #3,A$;": ";E(I)","VM","VP
  1453. 14390 L(I)=VM*COS(VP*P0)
  1454. 14400 M(I)=VM*SIN(VP*P0)
  1455. 14410 NEXT I
  1456. 14420 IF FLG=2 THEN FLG=1
  1457. 14430 RETURN
  1458. 14440 REM ********** LOADS INPUT **********
  1459. 14450 PRINT
  1460. 14460 INPUT "NUMBER OF LOADS       ";NL
  1461. 14470 IF NL<=ML THEN 14500
  1462. 14480 PRINT "NUMBER OF LOADS EXCEEDS DIMENSION..."
  1463. 14490 GOTO 14460
  1464. 14500 IF O$>"C" THEN PRINT #3,"NUMBER OF LOADS";NL
  1465. 14510 IF NL<1 THEN 14820
  1466. 14520 INPUT "S-PARAMETER (S=jW) IMPEDANCE LOAD (Y/N)";L$
  1467. 14530 IF L$<>"Y" AND L$<>"N" THEN 14520
  1468. 14540 A$="PULSE NO.,RESISTANCE,REACTANCE"
  1469. 14550 IF L$="Y" THEN A$= "PULSE NO., ORDER OF S-PARAMETER FUNCTION"
  1470. 14560 FOR I=1 TO NL
  1471. 14570 PRINT
  1472. 14580 PRINT "LOAD NO. ";I;":"
  1473. 14590 IF L$="Y" THEN 14660
  1474. 14600 PRINT A$;
  1475. 14610 INPUT LP(I),LA(1,I,1),LA(2,I,1)
  1476. 14620 IF LP(I)>N THEN PRINT "PULSE NUMBER EXCEEDS NUMBER OF PULSES...": GOTO 14600
  1477. 14630 IF O$>"C" THEN PRINT #3,A$;": ";LP(I);",";LA(1,I,1);",";LA(2,I,1)
  1478. 14640 GOTO 14810
  1479. 14650 REM ----- S-PARAMETER LOADS
  1480. 14660 PRINT A$;
  1481. 14670 INPUT LP(I),LS(I)
  1482. 14680 IF LP(I)>N THEN PRINT "PULSE NUMBER EXCEEDS NUMBER OF PULSES...": GOTO 14660
  1483. 14690 IF LS(I)>MA THEN PRINT "MAXIMUM DIMENSION IS 10":GOTO 14670
  1484. 14700 IF O$>"C" THEN PRINT #3,A$;": ";LP(I);",";LS(I)
  1485. 14710 FOR J=0 TO LS(I)
  1486. 14720 A$="NUMERATOR, DENOMINATOR COEFFICIENTS OF S^"
  1487. 14730 PRINT A$;J;
  1488. 14740 INPUT LA(1,I,J),LA(2,I,J)
  1489. 14750 IF O$>"C" THEN PRINT #3,A$;J;":";LA(1,I,J);",";LA(2,I,J)
  1490. 14760 NEXT J
  1491. 14770 IF LS(I)>0 THEN 14810
  1492. 14780 LS(I)=1
  1493. 14790 LA(1,I,1)=0
  1494. 14800 LA(2,I,1)=0
  1495. 14810 NEXT I
  1496. 14820 FLG=0
  1497. 14830 RETURN
  1498. 14840 REM ********** MAIN PROGRAM **********
  1499. 14850 REM ----- DATA INITIALIZATION
  1500. 14860 REM ----- PI
  1501. 14870 P=4*ATN(1)
  1502. 14880 REM ----- CHANGES DEGREES TO RADIANS
  1503. 14890 P0=P/180
  1504. 14900 B$="********************"
  1505. 14910 REM ----- INTRINSIC IMPEDANCE OF FREE SPACE DIVIDED BY 2 PI
  1506. 14920 G0=29.979221#
  1507. 14930 REM ---------- Q-VECTOR FOR GAUSSIAN QUADRATURE
  1508. 14940 READ Q(1),Q(2),Q(3),Q(4),Q(5),Q(6),Q(7),Q(8),Q(9),Q(10),Q(11),Q(12)
  1509. 14950 READ Q(13),Q(14)
  1510. 14960 DATA .288675135,.5,.430568156,.173927423,.169990522,.326072577
  1511. 14970 DATA .480144928,.050614268,.398333239,.111190517
  1512. 14980 DATA .262766205,.156853323,.091717321,.181341892
  1513. 14990 REM ---------- E-VECTOR FOR COEFFICIENTS OF ELLIPTIC INTEGRAL
  1514. 15000 READ C0,C1,C2,C3,C4,C5,C6,C7,C8,C9
  1515. 15010 DATA 1.38629436112,.09666344259,.03590092383,.03742563713,.01451196212
  1516. 15020 DATA .5,.1249859397,.06880248576,.0332355346,.00441787012
  1517. 15030 REM ----- IDENTIFY OUTPUT DEVICE
  1518. 15040 GOSUB 15700
  1519. 15050 PRINT #3,TAB(20);B$;B$
  1520. 15060 PRINT #3,TAB(22);"MINI-NUMERICAL ELECTROMAGNETICS CODE"
  1521. 15070 PRINT #3,TAB(36);"MININEC"
  1522. 15080 PRINT #3,TAB(24);DATE$;TAB(48);TIME$
  1523. 15090 PRINT #3,TAB(20);B$;B$
  1524. 15100 REM ----- FREQUENCY INPUT
  1525. 15110 GOSUB 11330
  1526. 15120 REM ----- ENVIRONMENT INPUT
  1527. 15130 GOSUB 13590
  1528. 15140 REM ----- CHECK GEOMETRY INPUT
  1529. 15141 INPUT "GEOMETRY FROM FILE, Y/N "; NA$
  1530. 15142 IF NA$ <> "Y" THEN NA$="": GOTO 15170
  1531. 15143 INPUT " ENTER FILEPATH + NAME OF FILE (.GEO IS ADDED)"; NA$: NA$=NA$+".GEO"
  1532. 15144 OPEN NA$ AS #1 LEN=30
  1533. 15150 GOSUB 15420
  1534. 15160 REM ----- GEOMETRY, ETC INPUT
  1535. 15170 GOSUB 11530
  1536. 15172 GOSUB 5570
  1537. 15174 GOSUB 6660
  1538. 15175 GOSUB 6370
  1539. 15176 IF S$<>"Y" AND  SP$<>"Y" THEN 15190
  1540. 15177 INPUT "STARTING FILE SERIAL NO.";FSN
  1541. 15178 INPUT "FILENAME FOR SAVES, SERIAL+SUFFIX WILL BE ADDED";F$
  1542. 15180 INPUT "FILE PATH TO USE,INCLUDE ANY : AND /"; T$
  1543. 15182 FS$=F$+T$
  1544. 15185 REM ----- MENU
  1545. 15190 PRINT
  1546. 15200 PRINT B$;"    MININEC MENU    ";B$
  1547. 15210 PRINT "   G - CHANGE GEOMETRY     C - COMPUTE/DISPLAY CURRENTS"
  1548. 15220 PRINT "   E - CHANGE ENVIRONMENT  P - COMPUTE FAR-FIELD PATTERNS"
  1549. 15230 PRINT "   X - CHANGE EXCITATION   N - COMPUTE NEAR-FIELDS"
  1550. 15240 PRINT "   L - CHANGE LOADS"
  1551. 15250 PRINT "   F - CHANGE FREQUENCY    FC- CYCLE FREQUENCY"
  1552. 15260 PRINT "   Q - QUIT                PC- CHANGE PATTERN INCREMENTS":PRINT 
  1553. 15270 INPUT "   COMMAND ";C$
  1554. 15280 IF C$="F" THEN GOSUB 11330
  1555. 15290 IF C$="P" THEN GOSUB 6200
  1556. 15300 IF C$="X" THEN GOSUB 14200
  1557. 15310 IF C$="E" THEN GOSUB 13540
  1558. 15320 IF C$="G" THEN GOSUB 11520
  1559. 15330 IF C$="C" THEN GOSUB 4960
  1560. 15340 IF C$="L" THEN GOSUB 14450
  1561. 15350 IF C$="N" THEN GOSUB 8720
  1562. 15354 IF C$="FC" THEN GOSUB 21000
  1563. 15355 IF C$="PC" THEN GOSUB 6540
  1564. 15360 IF C$<>"Q" THEN 15190
  1565. 15370 IF O$="P" THEN PRINT #3, CHR$(12) ELSE IF O$="C" THEN PRINT #3, " "
  1566. 15380 CLOSE
  1567. 15390 STOP  ' END
  1568. 15400 REM ********** NEC-TYPE GEOMETRY INPUT **********
  1569. 15410 OPEN "MININEC.INP" AS #1 LEN=30
  1570. 15420 FIELD #1,2 AS S$,4 AS X1$,4 AS Y1$,4 AS Z1$,4 AS X2$,4 AS Y2$,4 AS Z2$,4 AS R$
  1571. 15430 GET 1
  1572. 15440 NW=CVI(S$)
  1573. 15450 IF NW THEN INFILE=1
  1574. 15460 RETURN
  1575. 15470 REM ---------- GET GEOMETRY DATA FROM MININEC.INP ETC
  1576. 15480 GET 1
  1577. 15490 S1=CVI(S$)
  1578. 15500 X1=CVS(X1$)
  1579. 15510 Y1=CVS(Y1$)
  1580. 15520 Z1=CVS(Z1$)
  1581. 15530 X2=CVS(X2$)
  1582. 15540 Y2=CVS(Y2$)
  1583. 15550 Z2=CVS(Z2$)
  1584. 15560 A(I)=CVS(R$)
  1585. 15570 IF G<0 THEN IF Z1<0 OR Z2<0 THEN GOSUB 15620
  1586. 15580 PRINT #3," ":PRINT #3,"WIRE NO.";I
  1587. 15590 IF X1=X2 AND Y1=Y2 AND Z1=Z2 THEN PRINT"WIRE LENGTH IS ZERO.":GOTO 15370
  1588. 15600 GOSUB 12890
  1589. 15610 RETURN
  1590. 15620 IF IZNEG THEN 15660
  1591. 15630 PRINT"NEGATIVE Z VALUE ENCOUNTERED FOR GROUND PLANE."
  1592. 15640 INPUT "ABORT OR CONVERT NEGATIVE Z VALUE TO ZERO (A/C)? ";A$
  1593. 15650 IF A$="A" THEN 15370 ELSE IF A$="C" THEN IZNEG=1 ELSE 15640
  1594. 15660 IF Z1<0 THEN Z1=-Z1
  1595. 15670 IF Z2<0 THEN Z2=-Z2
  1596. 15680 RETURN
  1597. 15690 REM ********** IDENTIFY OUTPUT DEVICE **********
  1598. 15700 INPUT "OUTPUT TO CONSOLE, PRINTER, OR DISK (C/P/D)";O$
  1599. 15710 IF O$="C" THEN F$="SCRN:":GOTO 15760
  1600. 15720 IF O$="P" THEN F$="LPT1:":GOTO 15760
  1601. 15730 IF O$<>"D" THEN 15700
  1602. 15740 INPUT "ENTER FILEPATH + FILENAME (.OUT IS ADDED)";F$
  1603.  
  1604. 15750 IF LEFT$(RIGHT$(F$,4),1)="." THEN 15760 ELSE F$=F$+".OUT"
  1605. 15760 OPEN F$ FOR OUTPUT AS #3
  1606. 15770 CLS
  1607. 15780 RETURN
  1608. 15790 REM ********** CALCULATE ELAPSED TIME **********
  1609. 15800 IH=VAL(MID$(T$,1,2))-VAL(MID$(OT$,1,2))
  1610. 15810 IM=VAL(MID$(T$,4,2))-VAL(MID$(OT$,4,2))
  1611. 15820 IS=VAL(MID$(T$,7,2))-VAL(MID$(OT$,7,2))
  1612. 15830 IF IS<0 THEN IS=IS+60:IM=IM-1
  1613. 15840 IF IM<0 THEN IM=IM+60:IH=IH-1
  1614. 15850 IF IH<0 THEN IH=IH+24
  1615. 15860 T$=":"+MID$(STR$(IS+100),3)
  1616. 15870 IF IH THEN T$=MID$(STR$(IH),2)+":"+MID$(STR$(IM+100),3)+T$ ELSE T$=MID$(STR$(IM),2)+T$
  1617. 15880 RETURN
  1618. 15890 REM ********** CALCULATE APPROXIMATE TIME REMAINING **********
  1619. 15900 IPCT=100*PCT
  1620. 15910 T$=TIME$
  1621. 15920 IH=VAL(MID$(T$,1,2))-VAL(MID$(OT$,1,2))
  1622. 15930 IF IH<0 THEN IH=IH+24
  1623. 15940 IM=VAL(MID$(T$,4,2))-VAL(MID$(OT$,4,2))
  1624. 15950 IS=VAL(MID$(T$,7,2))-VAL(MID$(OT$,7,2))
  1625. 15960 IS=IS+60*(IM+60*IH)
  1626. 15970 IS=IS*(1/PCT-1)
  1627. 15980 IM=INT(IS/60)
  1628. 15990 IS=IS MOD 60
  1629. 16000 IH=INT(IM/60)
  1630. 16010 IM=IM MOD 60
  1631. 16020 T$=":"+MID$(STR$(IS+100),3)
  1632. 16030 IF IH THEN T$=MID$(STR$(IH),2)+":"+MID$(STR$(IM+100),3)+T$ ELSE T$=MID$(STR$(IM),2)+T$
  1633. 16040 LOCATE CSRLIN,1
  1634. 16050 PRINT Q$;IPCT;"% COMPLETE - APPROX TIME REMAINING "T$"   ";
  1635. 16060 RETURN
  1636. 21000 REM ***** SWEEP FREQUENCY *****
  1637. 21010 PRINT 
  1638. 21020 INPUT "INITIAL FREQUENCY, INCREMENT, NO. STEPS";FSV,FSI,FSN
  1639. 21030 FOR F=FSV TO FSV+FSN*FSI STEP FSI
  1640. 21040 GOSUB 11360
  1641. 21050 REM   GOSUB 4960
  1642. 21060 GOSUB 6200
  1643. 21070 IF S$="Y" THEN GOSUB 5640
  1644. 21080 IF SP$="Y" THEN GOSUB 6730
  1645. 21090 NEXT F
  1646. 21700 RETURN 
  1647. 60000 PRINT "ERROR NO. ";ERR;"AT LINE";ERL
  1648. 60010 IF ERL=15144 THEN RESUME 15143
  1649. 60020 IF ERL=6735 THEN RESUME 15177
  1650. 60030 IF ERL=15760 THEN RESUME 15740
  1651. 60040 RESUME 15200
  1652. 64000 END
  1653.