home *** CD-ROM | disk | FTP | other *** search
/ Antennas / Antennas_CD-ROM_Walnut_Creek_September_1996.iso / mininec / mn3basic / fmn9.clp < prev    next >
Text File  |  1996-06-30  |  54KB  |  1,646 lines
  1. 2 ON ERROR GOTO 60000
  2. 3 CLS
  3. 5     REM GEOMETRY MODIFIED 17 OCT 86 R.P.HAVILAND
  4. 6     REM SWEEP FREQUENCY ADDED JAN 87 RPH
  5. 10    REM ****** MININEC(3) **********  NOSC CODE 822 (JCL) 4-86 WITH REVS 1-9
  6. 30    DIM K!(6, 2), Q(14)
  7. 40    REM ----- MAXIMUM NUMBER OF SEGMENTS (PULSES + 2 * WIRES) = 150
  8. 50    MS = 150
  9. 60    DIM X(150), Y(150), Z(150)
  10. 70    REM ----- MAXIMUM NUMBER OF WIRES = 50
  11. 80    MW = 50
  12. 90    DIM A(50), CA(50), CB(50), CG(50), J1(50), J2(50, 2), N(50, 2), S(50)
  13. 100   REM ----- MAXIMUM NUMBER OF LOADS = 11
  14. 110   ML = 11
  15. 120   REM ----- MAXIMUM ORDER OF S-PARAMETER LOADS = 8
  16. 130   MA = 8
  17. 140   DIM LA(2, 11, 8), LP(11), LS(11)
  18. 150   REM ----- MAXIMUM NUMBER OF MEDIA = 6
  19. 160   MM = 6
  20. 170   REM ----- H MUST BE DIMENSIONED AT LEAST 6
  21. 180   DIM H(6), T(6), U(6), V(6), Z1(6), Z2(6)
  22. 190   REM ----- MAXIMUM NUMBER OF PULSES = 50
  23. 200   MP = 50
  24. 210   DIM C%(50, 2), CI(50), CR(50), P(50), W%(50)
  25. 220   DIM ZR(50, 50), ZI(50, 50)
  26. 230   REM ---- ARRAYS E,L & M DIMENSIONED TO MW+MP=100
  27. 240   DIM E(100), L(100), M(100)
  28. 250   REM:  COLOR 2,0
  29. 260   GOTO 14870
  30. 270   REM ********** KERNEL EVALUATION OF INTEGRALS I2 & I3 **********
  31. 280   IF K < 0 THEN 330
  32. 290   X3 = X2 + T * (V1 - X2)
  33. 300   Y3 = Y2 + T * (V2 - Y2)
  34. 310   Z3 = Z2 + T * (V3 - Z2)
  35. 320   GOTO 360
  36. 330   X3 = V1 + T * (X2 - V1)
  37. 340   Y3 = V2 + T * (Y2 - V2)
  38. 350   Z3 = V3 + T * (Z2 - V3)
  39. 360   D3 = X3 * X3 + Y3 * Y3 + Z3 * Z3
  40. 370   REM ----- MOD FOR SMALL RADIUS TO WAVELENGTH RATIO
  41. 380   IF A(P4) <= SRM THEN D = SQR(D3): GOTO 490
  42. 390   D = D3 + A2
  43. 400   IF D > 0 THEN D = SQR(D)
  44. 410   REM ----- CRITERIA FOR USING REDUCED KERNEL
  45. 420   IF I6! = 0 THEN 490
  46. 430   REM ----- EXACT KERNEL CALCULATION WITH ELLIPTIC INTEGRAL
  47. 440   B = D3 / (D3 + 4 * A2)
  48. 450   W0 = C0 + B * (C1 + B * (C2 + B * (C3 + B * C4)))
  49. 460   W1 = C5 + B * (C6 + B * (C7 + B * (C8 + B * C9)))
  50. 470   V0 = (W0 - W1 * LOG(B)) * SQR(1 - B)
  51. 480   T3 = T3 + (V0 + LOG(D3 / (64 * A2)) / 2) / P / A(P4) - 1 / D
  52. 490   B1 = D * W
  53. 500   REM ----- EXP(-J*K*R)/R
  54. 510   T3 = T3 + COS(B1) / D
  55. 520   T4 = T4 - SIN(B1) / D
  56. 530   RETURN
  57. 540   REM ***** PSI(P1,P2,P3) = T1 + J * T2 **********
  58. 550   REM ----- ENTRIES REQUIRED FOR NEAR FIELD CALCULATION
  59. 560   X1 = X0 + P1 * T5 / 2
  60. 570   Y1 = Y0 + P1 * T6 / 2
  61. 580   Z1 = Z0 + P1 * T7 / 2
  62. 590   X2 = X1 - X(P2)
  63. 600   Y2 = Y1 - Y(P2)
  64. 610   Z2 = Z1 - K * Z(P2)
  65. 620   V1 = X1 - X(P3)
  66. 630   V2 = Y1 - Y(P3)
  67. 640   V3 = Z1 - K * Z(P3)
  68. 650   GOTO 1350
  69. 660   I4 = INT(P2)
  70. 670   I5 = I4 + 1
  71. 680   X2 = X0 - (X(I4) + X(I5)) / 2
  72. 690   Y2 = Y0 - (Y(I4) + Y(I5)) / 2
  73. 700   Z2 = Z0 - K * (Z(I4) + Z(I5)) / 2
  74. 710   V1 = X0 - X(P3)
  75. 720   V2 = Y0 - Y(P3)
  76. 730   V3 = Z0 - K * Z(P3)
  77. 740   GOTO 1350
  78. 750   X2 = X0 - X(P2)
  79. 760   Y2 = Y0 - Y(P2)
  80. 770   Z2 = Z0 - K * Z(P2)
  81. 780   I4 = INT(P3)
  82. 790   I5 = I4 + 1
  83. 800   V1 = X0 - (X(I4) + X(I5)) / 2
  84. 810   V2 = Y0 - (Y(I4) + Y(I5)) / 2
  85. 820   V3 = Z0 - K * (Z(I4) + Z(I5)) / 2
  86. 830   GOTO 1350
  87. 840   REM ----- ENTRIES REQUIRED FOR IMPEDANCE MATRIX CALCULATION
  88. 850   REM ----- S(M) GOES IN (X1,Y1,Z1) FOR SCALAR POTENTIAL
  89. 860   REM ----- MOD FOR SMALL RADIUS TO WAVE LENGTH RATIO
  90. 870   FVS = 1
  91. 880   IF K < 1 THEN 940
  92. 890   IF A(P4) > SRM THEN 940
  93. 900   IF (P3 = P2 + 1 AND P1 = (P2 + P3) / 2) THEN 910 ELSE 940
  94. 910   T1 = 2 * LOG(S(P4) / A(P4))
  95. 920   T2 = -W * S(P4)
  96. 930   RETURN
  97. 940   I4 = INT(P1)
  98. 950   I5 = I4 + 1
  99. 960   X1 = (X(I4) + X(I5)) / 2
  100. 970   Y1 = (Y(I4) + Y(I5)) / 2
  101. 980   Z1 = (Z(I4) + Z(I5)) / 2
  102. 990   GOTO 1130
  103. 1000  REM ----- S(M) GOES IN (X1,Y1,Z1) FOR VECTOR POTENTIAL
  104. 1010  REM ----- MOD FOR SMALL RADIUS TO WAVE LENGTH RATIO
  105. 1020  FVS = 0
  106. 1030  IF K < 1 THEN 1090
  107. 1040  IF A(P4) >= SRM THEN 1090
  108. 1050  IF (I = J AND P3 = P2 + .5) THEN 1060 ELSE 1090
  109. 1060  T1 = LOG(S(P4) / A(P4))
  110. 1070  T2 = -W * S(P4) / 2
  111. 1080  RETURN
  112. 1090  X1 = X(P1)
  113. 1100  Y1 = Y(P1)
  114. 1110  Z1 = Z(P1)
  115. 1120  REM ----- S(U)-S(M) GOES IN (X2,Y2,Z2)
  116. 1130  I4 = INT(P2)
  117. 1140  IF I4 = P2 THEN 1200
  118. 1150  I5 = I4 + 1
  119. 1160  X2 = (X(I4) + X(I5)) / 2 - X1
  120. 1170  Y2 = (Y(I4) + Y(I5)) / 2 - Y1
  121. 1180  Z2 = K * (Z(I4) + Z(I5)) / 2 - Z1
  122. 1190  GOTO 1240
  123. 1200  X2 = X(P2) - X1
  124. 1210  Y2 = Y(P2) - Y1
  125. 1220  Z2 = K * Z(P2) - Z1
  126. 1230  REM ----- S(V)-S(M) GOES IN (V1,V2,V3)
  127. 1240  I4 = INT(P3)
  128. 1250  IF I4 = P3 THEN 1310
  129. 1260  I5 = I4 + 1
  130. 1270  V1 = (X(I4) + X(I5)) / 2 - X1
  131. 1280  V2 = (Y(I4) + Y(I5)) / 2 - Y1
  132. 1290  V3 = K * (Z(I4) + Z(I5)) / 2 - Z1
  133. 1300  GOTO 1350
  134. 1310  V1 = X(P3) - X1
  135. 1320  V2 = Y(P3) - Y1
  136. 1330  V3 = K * Z(P3) - Z1
  137. 1340  REM ----- MAGNITUDE OF S(U) - S(M)
  138. 1350  D0 = X2 * X2 + Y2 * Y2 + Z2 * Z2
  139. 1360  REM ----- MAGNITUDE OF S(V) - S(M)
  140. 1370  IF D0 > 0 THEN D0 = SQR(D0)
  141. 1380  D3 = V1 * V1 + V2 * V2 + V3 * V3
  142. 1390  IF D3 > 0 THEN D3 = SQR(D3)
  143. 1400  REM ----- SQUARE OF WIRE RADIUS
  144. 1410  A2 = A(P4) * A(P4)
  145. 1420  REM ----- MAGNITUDE OF S(V) - S(U)
  146. 1430  S4 = (P3 - P2) * S(P4)
  147. 1440  REM ----- ORDER OF INTEGRATION
  148. 1450  REM ----- LTH ORDER GAUSSIAN QUADRATURE
  149. 1460  T1 = 0
  150. 1470  T2 = 0
  151. 1480  I6! = 0
  152. 1490  F2 = 1
  153. 1500  L = 7
  154. 1510  T = (D0 + D3) / S(P4)
  155. 1520  REM ----- CRITERIA FOR EXACT KERNEL
  156. 1530  IF T > 1.1 THEN 1650
  157. 1540  IF C$ = "N" THEN 1650
  158. 1550  IF J2(W%(I), 1) = J2(W%(J), 1) THEN 1600
  159. 1560  IF J2(W%(I), 1) = J2(W%(J), 2) THEN 1600
  160. 1570  IF J2(W%(I), 2) = J2(W%(J), 1) THEN 1600
  161. 1580  IF J2(W%(I), 2) = J2(W%(J), 2) THEN 1600
  162. 1590  GOTO 1650
  163. 1600  IF A(P4) > SRM THEN 1620
  164. 1610  IF FVS = 1 THEN 910 ELSE 1060
  165. 1620  F2 = 2 * (P3 - P2)
  166. 1630  I6! = (1 - LOG(S4 / F2 / 8 / A(P4))) / P / A(P4)
  167. 1640  GOTO 1670
  168. 1650  IF T > 6 THEN L = 3
  169. 1660  IF T > 10 THEN L = 1
  170. 1670  I5 = L + L
  171. 1680  T3 = 0
  172. 1690  T4 = 0
  173. 1700  T = (Q(L) + .5) / F2
  174. 1710  GOSUB 280
  175. 1720  T = (.5 - Q(L)) / F2
  176. 1730  GOSUB 280
  177. 1740  L = L + 1
  178. 1750  T1 = T1 + Q(L) * T3
  179. 1760  T2 = T2 + Q(L) * T4
  180. 1770  L = L + 1
  181. 1780  IF L < I5 THEN 1680
  182. 1790  T1 = S4 * (T1 + I6!)
  183. 1800  T2 = S4 * T2
  184. 1810  RETURN
  185. 1820  REM ********** COMPLEX SQUARE ROOT **********
  186. 1830  REM ----- W6+I*W7=SQR(Z6+I*Z7)
  187. 1840  T6 = SQR((ABS(Z6) + SQR(Z6 * Z6 + Z7 * Z7)) / 2)
  188. 1850  T7 = ABS(Z7) / 2 / T6
  189. 1860  IF Z6 < 0 THEN 1910
  190. 1870  W6 = T6
  191. 1880  W7 = T7
  192. 1890  IF Z7 < 0 THEN W7 = -T7
  193. 1900  RETURN
  194. 1910  W6 = T7
  195. 1920  W7 = T6
  196. 1930  IF Z7 < 0 THEN W7 = -T6
  197. 1940  RETURN
  198. 1950  REM ********** IMPEDANCE MATRIX CALCULATION **********
  199. 1960  IF FLG = 1 THEN 4270
  200. 1970  IF FLG = 2 THEN 4760
  201. 1980  REM ----- BEGIN MATRIX FILL TIME CALCULATION
  202. 1990  OT$ = TIME$
  203. 2000  Q$ = "MATRIX FILL  "
  204. 2010  CLS
  205. 2020  PRINT "BEGIN "; Q$
  206. 2030  REM ----- ZERO IMPEDANCE MATRIX
  207. 2040  FOR I = 1 TO N
  208. 2050  FOR J = 1 TO N
  209. 2060  ZR(I, J) = 0
  210. 2070  ZI(I, J) = 0
  211. 2080  NEXT J
  212. 2090  NEXT I
  213. 2100  REM ----- COMPUTE ROW I OF MATRIX (OBSERVATION LOOP)
  214. 2110  FOR I = 1 TO N
  215. 2120  I1 = ABS(C%(I, 1))
  216. 2130  I2 = ABS(C%(I, 2))
  217. 2140  F4 = SGN(C%(I, 1)) * S(I1)
  218. 2150  F5 = SGN(C%(I, 2)) * S(I2)
  219. 2160  REM ----- R(M + 1/2) - R(M - 1/2) HAS COMPONENTS (T5,T6,T7)
  220. 2170  T5 = F4 * CA(I1) + F5 * CA(I2)
  221. 2180  T6 = F4 * CB(I1) + F5 * CB(I2)
  222. 2190  T7 = F4 * CG(I1) + F5 * CG(I2)
  223. 2200  IF C%(I, 1) = -C%(I, 2) THEN T7 = S(I1) * (CG(I1) + CG(I2))
  224. 2210  REM ----- COMPUTE COLUMN J OF ROW I (SOURCE LOOP)
  225. 2220  FOR J = 1 TO N
  226. 2230  J1 = ABS(C%(J, 1))
  227. 2240  J2 = ABS(C%(J, 2))
  228. 2250  F4 = SGN(C%(J, 1))
  229. 2260  F5 = SGN(C%(J, 2))
  230. 2270  F6 = 1
  231. 2280  F7 = 1
  232. 2290  REM ----- IMAGE LOOP
  233. 2300  FOR K = 1 TO G STEP -2
  234. 2310  IF C%(J, 1) <> -C%(J, 2) THEN 2350
  235. 2320  IF K < 0 THEN 3320
  236. 2330  F6 = F4
  237. 2340  F7 = F5
  238. 2350  F8 = 0
  239. 2360  IF K < 0 THEN 2480
  240. 2370  REM ----- SET FLAG TO AVOID REDUNANT CALCULATIONS
  241. 2380  IF I1 <> I2 THEN 2460
  242. 2390  IF (CA(I1) + CB(I1)) = 0 THEN 2410
  243. 2400  IF C%(I, 1) <> C%(I, 2) THEN 2460
  244. 2410  IF J1 <> J2 THEN 2460
  245. 2420  IF (CA(J1) + CB(J1)) = 0 THEN 2440
  246. 2430  IF C%(J, 1) <> C%(J, 2) THEN 2460
  247. 2440  IF I1 = J1 THEN F8 = 1
  248. 2450  IF I = J THEN F8 = 2
  249. 2460  IF ZR(I, J) <> 0 THEN 3170
  250. 2470  REM ----- COMPUTE PSI(M,N,N+1/2)
  251. 2480  P1 = 2 * W%(I) + I - 1
  252. 2490  P2 = 2 * W%(J) + J - 1
  253. 2500  P3 = P2 + .5
  254. 2510  P4 = J2
  255. 2520  GOSUB 1020
  256. 2530  U1 = F5 * T1
  257. 2540  U2 = F5 * T2
  258. 2550  REM ----- COMPUTE PSI(M,N-1/2,N)
  259. 2560  P3 = P2
  260. 2570  P2 = P2 - .5
  261. 2580  P4 = J1
  262. 2590  IF F8 < 2 THEN GOSUB 1020
  263. 2600  V1 = F4 * T1
  264. 2610  V2 = F4 * T2
  265. 2620  REM ----- S(N+1/2)*PSI(M,N,N+1/2) + S(N-1/2)*PSI(M,N-1/2,N)
  266. 2630  X3 = U1 * CA(J2) + V1 * CA(J1)
  267. 2640  Y3 = U1 * CB(J2) + V1 * CB(J1)
  268. 2650  Z3 = (F7 * U1 * CG(J2) + F6 * V1 * CG(J1)) * K
  269. 2660  REM ----- REAL PART OF VECTOR POTENTIAL CONTRIBUTION
  270. 2670  D1 = W2 * (X3 * T5 + Y3 * T6 + Z3 * T7)
  271. 2680  X3 = U2 * CA(J2) + V2 * CA(J1)
  272. 2690  Y3 = U2 * CB(J2) + V2 * CB(J1)
  273. 2700  Z3 = (F7 * U2 * CG(J2) + F6 * V2 * CG(J1)) * K
  274. 2710  REM ----- IMAGINARY PART OF VECTOR POTENTIAL CONTRIBUTION
  275. 2720  D2 = W2 * (X3 * T5 + Y3 * T6 + Z3 * T7)
  276. 2730  REM ----- COMPUTE PSI(M+1/2,N,N+1)
  277. 2740  P1 = P1 + .5
  278. 2750  IF F8 = 2 THEN P1 = P1 - 1
  279. 2760  P2 = P3
  280. 2770  P3 = P3 + 1
  281. 2780  P4 = J2
  282. 2790  IF F8 <> 1 THEN 2830
  283. 2800  U5 = F5 * U1 + T1
  284. 2810  U6 = F5 * U2 + T2
  285. 2820  GOTO 2910
  286. 2830  GOSUB 870
  287. 2840  IF F8 < 2 THEN 2880
  288. 2850  U1 = (2 * T1 - 4 * U1 * F5) / S(J1)
  289. 2860  U2 = (2 * T2 - 4 * U2 * F5) / S(J1)
  290. 2870  GOTO 3140
  291. 2880  U5 = T1
  292. 2890  U6 = T2
  293. 2900  REM ----- COMPUTE PSI(M-1/2,N,N+1)
  294. 2910  P1 = P1 - 1
  295. 2920  GOSUB 870
  296. 2930  U1 = (T1 - U5) / S(J2)
  297. 2940  U2 = (T2 - U6) / S(J2)
  298. 2950  REM ----- COMPUTE PSI(M+1/2,N-1,N)
  299. 2960  P1 = P1 + 1
  300. 2970  P3 = P2
  301. 2980  P2 = P2 - 1
  302. 2990  P4 = J1
  303. 3000  GOSUB 870
  304. 3010  U3 = T1
  305. 3020  U4 = T2
  306. 3030  REM ----- COMPUTE PSI(M-1/2,N-1,N)
  307. 3040  IF F8 < 1 THEN 3080
  308. 3050  T1 = U5
  309. 3060  T2 = U6
  310. 3070  GOTO 3110
  311. 3080  P1 = P1 - 1
  312. 3090  GOSUB 870
  313. 3100  REM ----- GRADIENT OF SCALAR POTENTIAL CONTRIBUTION
  314. 3110  U1 = U1 + (U3 - T1) / S(J1)
  315. 3120  U2 = U2 + (U4 - T2) / S(J1)
  316. 3130  REM ----- SUM INTO IMPEDANCE MATRIX
  317. 3140  ZR(I, J) = ZR(I, J) + K * (D1 + U1)
  318. 3150  ZI(I, J) = ZI(I, J) + K * (D2 + U2)
  319. 3160  REM ----- AVOID REDUNANT CALCULATIONS
  320. 3170  IF J < I THEN 3320
  321. 3180  IF F8 = 0 THEN 3320
  322. 3190  ZR(J, I) = ZR(I, J)
  323. 3200  ZI(J, I) = ZI(I, J)
  324. 3210  REM ----- SEGMENTS ON SAME WIRE SAME DISTANCE APART HAVE SAME Z
  325. 3220  P1 = J + 1
  326. 3230  IF P1 > N THEN 3320
  327. 3240  IF C%(P1, 1) <> C%(P1, 2) THEN 3320
  328. 3250  IF C%(P1, 2) = C%(J, 2) THEN 3280
  329. 3260  IF C%(P1, 2) <> -C%(J, 2) THEN 3320
  330. 3270  IF (CA(J2) + CB(J2)) <> 0 THEN 3320
  331. 3280  P2 = I + 1
  332. 3290  IF P2 > N THEN 3320
  333. 3300  ZR(P2, P1) = ZR(I, J)
  334. 3310  ZI(P2, P1) = ZI(I, J)
  335. 3320  NEXT K
  336. 3330  NEXT J
  337. 3340  PCT = I / N
  338. 3350  GOSUB 15890
  339. 3360  NEXT I
  340. 3370  REM ----- END MATRIX FILL TIME CALCULATION
  341. 3380  T$ = TIME$
  342. 3390  GOSUB 15790
  343. 3400  PRINT #3, " "
  344. 3410  PRINT #3, "FILL MATRIX  : "; T$
  345. 3420  REM ********** ADDITION OF LOADS **********
  346. 3430  IF NL = 0 THEN 3760
  347. 3440  F5 = 2 * P * F * 1000000
  348. 3450  FOR I = 1 TO NL
  349. 3460  IF L$ = "N" THEN 3650
  350. 3470  REM ----- S-PARAMETER LOADS
  351. 3480  U1 = 0
  352. 3490  U2 = 0
  353. 3500  D1 = 0
  354. 3510  D2 = 0
  355. 3520  S = -1
  356. 3530  FOR J = 0 TO LS(I) STEP 2
  357. 3535  S = -S
  358. 3540  U1 = U1 + LA(1, I, J) * S * F5 ^ J
  359. 3550  D1 = D1 + LA(2, I, J) * S * F5 ^ J
  360. 3560  L = J + 1
  361. 3570  U2 = U2 + LA(1, I, L) * S * F5 ^ L
  362. 3580  D2 = D2 + LA(2, I, L) * S * F5 ^ L
  363. 3590  NEXT J
  364. 3600  J = LP(I)
  365. 3610  D = D1 * D1 + D2 * D2: IF D = 0 THEN D = .000001
  366. 3620  LI = (U2 * D1 - D2 * U1) / D
  367. 3630  LR = (U1 * D1 + U2 * D2) / D
  368. 3640  GOTO 3680
  369. 3650  LR = LA(1, I, 1)
  370. 3660  LI = LA(2, I, 1)
  371. 3670  J = LP(I)
  372. 3680  F2 = 1 / M
  373. 3690  IF C%(J, 1) <> -C%(J, 2) THEN 3710
  374. 3700  IF K < 0 THEN F2 = 2 / M
  375. 3710  ZR(J, J) = ZR(J, J) + F2 * LI
  376. 3720  ZI(J, J) = ZI(J, J) - F2 * LR
  377. 3730  NEXT I
  378. 3740  REM ********** IMPEDANCE MATRIX FACTORIZATION **********
  379. 3750  REM ----- BEGIN MATRIX FACTOR TIME CALCULATION
  380. 3760  OT$ = TIME$
  381. 3770  Q$ = "FACTOR MATRIX"
  382. 3780  CLS
  383. 3790  PRINT "BEGIN "; Q$;
  384. 3800  X = N
  385. 3810  PCTN = X * (X - 1) * (X + X - 1)
  386. 3820  FOR K = 1 TO N - 1
  387. 3830  REM ----- SEARCH FOR PIVOT
  388. 3840  T = ZR(K, K) * ZR(K, K) + ZI(K, K) * ZI(K, K)
  389. 3850  I1 = K
  390. 3860  FOR I = K + 1 TO N
  391. 3870  T1 = ZR(I, K) * ZR(I, K) + ZI(I, K) * ZI(I, K)
  392. 3880  IF T1 < T THEN 3910
  393. 3890  I1 = I
  394. 3900  T = T1
  395. 3910  NEXT I
  396. 3920  REM ----- EXCHANGE ROWS K AND I1
  397. 3930  IF I1 = K THEN 4020
  398. 3940  FOR J = 1 TO N
  399. 3950  T1 = ZR(K, J)
  400. 3960  T2 = ZI(K, J)
  401. 3970  ZR(K, J) = ZR(I1, J)
  402. 3980  ZI(K, J) = ZI(I1, J)
  403. 3990  ZR(I1, J) = T1
  404. 4000  ZI(I1, J) = T2
  405. 4010  NEXT J
  406. 4020  P(K) = I1
  407. 4030  REM ----- SUBTRACT ROW K FROM ROWS K+1 TO N
  408. 4040  FOR I = K + 1 TO N
  409. 4050  REM ----- COMPUTE MULTIPLIER L(I,K)
  410. 4060  T1 = (ZR(I, K) * ZR(K, K) + ZI(I, K) * ZI(K, K)) / T
  411. 4070  T2 = (ZI(I, K) * ZR(K, K) - ZR(I, K) * ZI(K, K)) / T
  412. 4080  ZR(I, K) = T1
  413. 4090  ZI(I, K) = T2
  414. 4100  REM ----- SUBTRACT ROW K FROM ROW I
  415. 4110  FOR J = K + 1 TO N
  416. 4120  ZR(I, J) = ZR(I, J) - (ZR(K, J) * T1 - ZI(K, J) * T2)
  417. 4130  ZI(I, J) = ZI(I, J) - (ZR(K, J) * T2 + ZI(K, J) * T1)
  418. 4140  NEXT J
  419. 4150  NEXT I
  420. 4160  X = N - K
  421. 4170  PCT = 1 - X * (X - 1) * (X + X - 1) / PCTN
  422. 4180  GOSUB 15890
  423. 4190  NEXT K
  424. 4200  REM ----- END MATRIX FACTOR TIME CALCULATION
  425. 4210  T$ = TIME$
  426. 4220  GOSUB 15790
  427. 4230  PRINT
  428. 4240  PRINT #3, "FACTOR MATRIX: "; T$
  429. 4250  REM ********** SOLVE **********
  430. 4260  REM ----- COMPUTE RIGHT HAND SIDE
  431. 4270  FOR I = 1 TO N
  432. 4280  CR(I) = 0
  433. 4290  CI(I) = 0
  434. 4300  NEXT I
  435. 4310  FOR J = 1 TO NS
  436. 4320  F2 = 1 / M
  437. 4330  IF C%(E(J), 1) = -C%(E(J), 2) THEN F2 = 2 / M
  438. 4340  CR(E(J)) = F2 * M(J)
  439. 4350  CI(E(J)) = -F2 * L(J)
  440. 4360  NEXT J
  441. 4370  REM ----- PERMUTE EXCITATION
  442. 4380  FOR K = 1 TO N - 1
  443. 4390  I1 = P(K)
  444. 4400  IF I1 = K THEN 4470
  445. 4410  T1 = CR(K)
  446. 4420  T2 = CI(K)
  447. 4430  CR(K) = CR(I1)
  448. 4440  CI(K) = CI(I1)
  449. 4450  CR(I1) = T1
  450. 4460  CI(I1) = T2
  451. 4470  NEXT K
  452. 4480  REM ----- FORWARD ELIMINATION
  453. 4490  FOR I = 2 TO N
  454. 4500  T1 = 0
  455. 4510  T2 = 0
  456. 4520  FOR J = 1 TO I - 1
  457. 4530  T1 = T1 + ZR(I, J) * CR(J) - ZI(I, J) * CI(J)
  458. 4540  T2 = T2 + ZR(I, J) * CI(J) + ZI(I, J) * CR(J)
  459. 4550  NEXT J
  460. 4560  CR(I) = CR(I) - T1
  461. 4570  CI(I) = CI(I) - T2
  462. 4580  NEXT I
  463. 4590  REM ----- BACK SUBSTITUTION
  464. 4600  FOR I = N TO 1 STEP -1
  465. 4610  T1 = 0
  466. 4620  T2 = 0
  467. 4630  IF I = N THEN 4680
  468. 4640  FOR J = I + 1 TO N
  469. 4650  T1 = T1 + ZR(I, J) * CR(J) - ZI(I, J) * CI(J)
  470. 4660  T2 = T2 + ZR(I, J) * CI(J) + ZI(I, J) * CR(J)
  471. 4670  NEXT J
  472. 4680  T = ZR(I, I) * ZR(I, I) + ZI(I, I) * ZI(I, I)
  473. 4690  T1 = CR(I) - T1
  474. 4700  T2 = CI(I) - T2
  475. 4710  CR(I) = (T1 * ZR(I, I) + T2 * ZI(I, I)) / T
  476. 4720  CI(I) = (T2 * ZR(I, I) - T1 * ZI(I, I)) / T
  477. 4730  NEXT I
  478. 4740  FLG = 2
  479. 4750  REM ********** SOURCE DATA **********
  480. 4760  PRINT #3, " "
  481. 4770  PRINT #3, B$; "    SOURCE DATA     "; B$
  482. 4772 PRINT #3, "        FREQUENCY, MHZ.= "; F
  483. 4774 PRINT #3, "          RESISTANCE LOAD, OHMS = "; LA(1, 1, 1)
  484. 4776 PRINT #3, "          REACTANCE LOAD, OHMS = "; LA(2, 1, 1)
  485. 4780  PWR = 0
  486. 4790  FOR I = 1 TO NS
  487. 4800  CR = CR(E(I))
  488. 4810  CI = CI(E(I))
  489. 4820  T = CR * CR + CI * CI
  490. 4830  T1 = (L(I) * CR + M(I) * CI) / T
  491. 4840  T2 = (M(I) * CR - L(I) * CI) / T
  492. 4850  O2 = (L(I) * CR + M(I) * CI) / 2
  493. 4860  PWR = PWR + O2
  494. 4870  PRINT #3, "PULSE "; E(I), "VOLTAGE = ("; L(I); ","; M(I); "J)"
  495. 4880  PRINT #3, " ", "CURRENT = ("; CR; ","; CI; "J)"
  496. 4890  PRINT #3, " ", "IMPEDANCE = ("; T1; ","; T2; "J)"
  497. 4900  PRINT #3, " ", "POWER = "; O2; " WATTS"
  498. 4910  NEXT I
  499. 4920  IF NS > 1 THEN PRINT #3, " "
  500. 4930  IF NS > 1 THEN PRINT #3, "TOTAL POWER = "; PWR; "WATTS"
  501. 4940  RETURN
  502. 4950  REM ********** PRINT CURRENTS **********
  503. 4960  GOSUB 1960
  504. 4970  SC$ = "N"
  505. 4980  PRINT #3, " "
  506. 4990  PRINT #3, B$; "    CURRENT DATA    "; B$
  507. 5000  FOR K = 1 TO NW
  508. 5010  IF SC$ = "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 SC$ = "N" THEN PRINT #3, I$, I1!; TAB(29); J1!; TAB(43); S1; TAB(57); S2
  527. 5200   IF SC$ = "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 SC$ = "N" THEN PRINT #3, I, CR(I); TAB(29); CI(I); TAB(43); S1; TAB(57); S2
  536. 5290   IF SC$ = "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 SC$ = "N" THEN PRINT #3, N2, CR(N2); TAB(29); CI(N2); TAB(43); S1; TAB(57); S2
  553. 5460   IF SC$ = "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 SC$ = "N" THEN PRINT #3, I$, I1!; TAB(29); J1!; TAB(43); S1; TAB(57); S2
  559. 5520   IF SC$ = "Y" THEN PRINT #1, I1!; ","; J1!; ","; S1; ","; S2
  560. 5530  IF SC$ = "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) "; SC$
  565. 5575  INPUT "PRINT CURRENTS Y/N"; SC$
  566. 5580  IF SC$ = "N" THEN 5690
  567. 5590  IF SC$ <> "Y" THEN 5560
  568. 5600  RETURN
  569. 5640  FM$ = FS$ + LTRIM$(RTRIM$(STR$(FSN))) + ".CUR": 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   FSP$ = FS$ + LTRIM$(RTRIM$(STR$(FSN))) + ".PAT": OPEN FSP$ 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 SP$ = "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 SP$ = "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) "; SN$
  919. 9120  IF SN$ = "N" THEN 9200
  920. 9130  IF SN$ <> "Y" THEN 9110
  921. 9140   INPUT "FILEPATH+FILENAME "; F$
  922. 9150   IF LEFT$(RIGHT$(F$, 4), 1) = "." THEN 9160 ELSE F$ = F$ + ".NFO"
  923. 9160   IF O$ > "C" THEN PRINT #3, " ": PRINT #3, "FILENAME (NAME.NFO) "; 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 SN$ = "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 SN$ = "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 (SN$ = "Y" AND N$ = "E") THEN PRINT #2, F1 * PK; ","; O2
  1128. 11180 IF (SN$ = "Y" AND N$ = "H") THEN PRINT #2, F1 * PK; ","; O2
  1129. 11190 IF SN$ = "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: FSN = FSN + 1
  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$ FOR RANDOM 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.       REM 15178 INPUT "FILENAME FOR SAVES, SERIAL+SUFFIX WILL BE ADDED"; FS$
  1542. 15180 INPUT "FILEPATH+FILENAMR TO USE,INCLUDE ANY : AND \"; FS$
  1543.       REM 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. 15295 IF SP$ = "Y" THEN GOSUB 6735
  1557. 15300 IF C$ = "X" THEN GOSUB 14200
  1558. 15310 IF C$ = "E" THEN GOSUB 13540
  1559. 15320 IF C$ = "G" THEN GOSUB 11520
  1560. 15330 IF C$ = "C" THEN GOSUB 4960
  1561. 15335 IF SC$ = "Y" THEN GOSUB 6730
  1562. 15340 IF C$ = "L" THEN GOSUB 14450
  1563. 15350 IF C$ = "N" THEN GOSUB 8720
  1564. 15354 IF C$ = "FC" THEN GOSUB 21000
  1565. 15355 IF C$ = "PC" THEN GOSUB 6540
  1566. 15356 CLOSE 1
  1567. 15360 IF C$ <> "Q" THEN 15190
  1568. 15370 IF O$ = "P" THEN PRINT #3, CHR$(12) ELSE IF O$ = "C" THEN PRINT #3, " "
  1569. 15380 CLOSE
  1570. 15390 STOP  ' END
  1571. 15400 REM ********** NEC-TYPE GEOMETRY INPUT **********
  1572. 15410 OPEN "MININEC.INP" FOR RANDOM AS #1 LEN = 30
  1573. 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$
  1574. 15430 GET 1
  1575. 15440 NW = CVI(S$)
  1576. 15450 IF NW THEN INFILE = 1
  1577. 15460 RETURN
  1578. 15470 REM ---------- GET GEOMETRY DATA FROM MININEC.INP ETC
  1579. 15480 GET 1
  1580. 15490 S1 = CVI(S$)
  1581. 15500 X1 = CVS(X1$)
  1582. 15510 Y1 = CVS(Y1$)
  1583. 15520 Z1 = CVS(Z1$)
  1584. 15530 X2 = CVS(X2$)
  1585. 15540 Y2 = CVS(Y2$)
  1586. 15550 Z2 = CVS(Z2$)
  1587. 15560 A(I) = CVS(R$)
  1588. 15570 IF G < 0 THEN IF Z1 < 0 OR Z2 < 0 THEN GOSUB 15620
  1589. 15580 PRINT #3, " ": PRINT #3, "WIRE NO."; I
  1590. 15590 IF X1 = X2 AND Y1 = Y2 AND Z1 = Z2 THEN PRINT "WIRE LENGTH IS ZERO.": GOTO 15370
  1591. 15600 GOSUB 12890
  1592. 15610 RETURN
  1593. 15620 IF IZNEG THEN 15660
  1594. 15630 PRINT "NEGATIVE Z VALUE ENCOUNTERED FOR GROUND PLANE."
  1595. 15640 INPUT "ABORT OR CONVERT NEGATIVE Z VALUE TO ZERO (A/C)? "; A$
  1596. 15650 IF A$ = "A" THEN 15370 ELSE IF A$ = "C" THEN IZNEG = 1 ELSE 15640
  1597. 15660 IF Z1 < 0 THEN Z1 = -Z1
  1598. 15670 IF Z2 < 0 THEN Z2 = -Z2
  1599. 15680 RETURN
  1600. 15690 REM ********** IDENTIFY OUTPUT DEVICE **********
  1601. 15700 INPUT "OUTPUT TO CONSOLE, PRINTER, OR DISK (C/P/D)"; O$
  1602. 15710 IF O$ = "C" THEN F$ = "SCRN:": GOTO 15760
  1603. 15720 IF O$ = "P" THEN F$ = "LPT1:": GOTO 15760
  1604. 15730 IF O$ <> "D" THEN 15700
  1605. 15740 INPUT "ENTER FILEPATH + FILENAME (.OUT IS ADDED)"; F$
  1606. 15750 IF LEFT$(RIGHT$(F$, 4), 1) = "." THEN 15760 ELSE F$ = F$ + ".OUT"
  1607. 15760 OPEN F$ FOR OUTPUT AS #3
  1608. 15770 CLS
  1609. 15780 RETURN
  1610. 15790 REM ********** CALCULATE ELAPSED TIME **********
  1611. 15800 IH = VAL(MID$(T$, 1, 2)) - VAL(MID$(OT$, 1, 2))
  1612. 15810 IM = VAL(MID$(T$, 4, 2)) - VAL(MID$(OT$, 4, 2))
  1613. 15820 TIS = VAL(MID$(T$, 7, 2)) - VAL(MID$(OT$, 7, 2))
  1614. 15830 IF TIS < 0 THEN TIS = TIS + 60: IM = IM - 1
  1615. 15840 IF IM < 0 THEN IM = IM + 60: IH = IH - 1
  1616. 15850 IF IH < 0 THEN IH = IH + 24
  1617. 15860 T$ = ":" + MID$(STR$(TIS + 100), 3)
  1618. 15870 IF IH THEN T$ = MID$(STR$(IH), 2) + ":" + MID$(STR$(IM + 100), 3) + T$ ELSE T$ = MID$(STR$(IM), 2) + T$
  1619. 15880 RETURN
  1620. 15890 REM ********** CALCULATE APPROXIMATE TIME REMAINING **********
  1621. 15900 IPCT = 100 * PCT
  1622. 15910 T$ = TIME$
  1623. 15920 IH = VAL(MID$(T$, 1, 2)) - VAL(MID$(OT$, 1, 2))
  1624. 15930 IF IH < 0 THEN IH = IH + 24
  1625. 15940 IM = VAL(MID$(T$, 4, 2)) - VAL(MID$(OT$, 4, 2))
  1626. 15950 TIS = VAL(MID$(T$, 7, 2)) - VAL(MID$(OT$, 7, 2))
  1627. 15960 TIS = TIS + 60 * (IM + 60 * IH)
  1628. 15970 TIS = TIS * (1 / PCT - 1)
  1629. 15980 IM = INT(TIS / 60)
  1630. 15990 TIS = TIS MOD 60
  1631. 16000 IH = INT(IM / 60)
  1632. 16010 IM = IM MOD 60
  1633. 16020 T$ = ":" + MID$(STR$(TIS + 100), 3)
  1634. 16030 IF IH THEN T$ = MID$(STR$(IH), 2) + ":" + MID$(STR$(IM + 100), 3) + T$ ELSE T$ = MID$(STR$(IM), 2) + T$
  1635. 16040 LOCATE CSRLIN, 1
  1636. 16050 PRINT Q$; IPCT; "% COMPLETE - APPROX TIME REMAINING "; T$; "   ";
  1637. 16060 RETURN
  1638. 21000 REM ***** SWEEP FREQUENCY *****
  1639. 60000 PRINT "ERROR NO. "; ERR; "AT LINE"; ERL
  1640. 60010 IF ERL = 15144 THEN RESUME 15143
  1641. 60020 IF ERL = 6735 THEN RESUME 15190
  1642. 60030 IF ERL = 15760 THEN RESUME 15740
  1643. 60040 RESUME 15200
  1644. 64000 END
  1645.  
  1646.