home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / HAMRADIO / MININEC3.ARC / MININEC3.BAS < prev    next >
Encoding:
BASIC Source File  |  1986-11-26  |  43.2 KB  |  1,618 lines
  1. 1 REM ****** MININEC(3) **********  NOSC CODE 822 (JCL CHANGE 9) 11-26-86
  2. 2 DEFINT I,J,K,N
  3. 3 DIM K!(6,2),Q(14)
  4. 4 REM ----- MAXIMUM NUMBER OF SEGMENTS (PULSES + 2 * WIRES) = 150
  5. 5 MS=150
  6. 6 DIM X(150),Y(150),Z(150)
  7. 7 REM ----- MAXIMUM NUMBER OF WIRES = 50
  8. 8 MW=50
  9. 9 DIM A(50),CA(50),CB(50),CG(50),J1(50),J2(50,2),N(50,2),S(50)
  10. 10 REM ----- MAXIMUM NUMBER OF LOADS = 11
  11. 11 ML=11
  12. 12 REM ----- MAXIMUM ORDER OF S-PARAMETER LOADS = 8
  13. 13 MA=8
  14. 14 DIM LA(2,11,8),LP(11),LS(11)
  15. 15 REM ----- MAXIMUM NUMBER OF MEDIA = 6
  16. 16 MM=6
  17. 17 REM ----- H MUST BE DIMENSIONED AT LEAST 6
  18. 18 DIM H(6),T(6),U(6),V(6),Z1(6),Z2(6)
  19. 19 REM ----- MAXIMUM NUMBER OF PULSES = 50 
  20. 20 MP=50 
  21. 21 DIM C%(50,2),CI(50),CR(50),P(50),W%(50)
  22. 22 DIM ZR(50,50),ZI(50,50)
  23. 23 REM ---- ARRAYS E,L & M DIMENSIONED TO MW+MP=100
  24. 24 DIM E(100),L(100),M(100)
  25. 25 COLOR 2,0
  26. 26 GOTO 1497
  27. 27 REM ********** KERNEL EVALUATION OF INTEGRALS I2 & I3 **********
  28. 28 IF K<0 THEN 33
  29. 29 X3=X2+T*(V1-X2)
  30. 30 Y3=Y2+T*(V2-Y2)
  31. 31 Z3=Z2+T*(V3-Z2)
  32. 32 GOTO 36
  33. 33 X3=V1+T*(X2-V1)
  34. 34 Y3=V2+T*(Y2-V2)
  35. 35 Z3=V3+T*(Z2-V3)
  36. 36 D3=X3*X3+Y3*Y3+Z3*Z3
  37. 37 REM ----- MOD FOR SMALL RADIUS TO WAVELENGTH RATIO
  38. 38 IF A(P4)<=SRM THEN D=SQR(D3):GOTO 49
  39. 39 D=D3+A2
  40. 40 IF D>0 THEN D=SQR(D)
  41. 41 REM ----- CRITERIA FOR USING REDUCED KERNEL
  42. 42 IF I6!=0 THEN 49
  43. 43 REM ----- EXACT KERNEL CALCULATION WITH ELLIPTIC INTEGRAL
  44. 44 B=D3/(D3+4*A2)
  45. 45 W0=C0+B*(C1+B*(C2+B*(C3+B*C4)))
  46. 46 W1=C5+B*(C6+B*(C7+B*(C8+B*C9)))
  47. 47 V0=(W0-W1*LOG(B))*SQR(1-B)
  48. 48 T3=T3+(V0+LOG(D3/(64*A2))/2)/P/A(P4)-1/D
  49. 49 B1=D*W
  50. 50 REM ----- EXP(-J*K*R)/R
  51. 51 T3=T3+COS(B1)/D
  52. 52 T4=T4-SIN(B1)/D
  53. 53 RETURN
  54. 54 REM ***** PSI(P1,P2,P3) = T1 + J * T2 **********
  55. 55 REM ----- ENTRIES REQUIRED FOR NEAR FIELD CALCULATION
  56. 56 X1=X0+P1*T5/2
  57. 57 Y1=Y0+P1*T6/2
  58. 58 Z1=Z0+P1*T7/2
  59. 59 X2=X1-X(P2)
  60. 60 Y2=Y1-Y(P2)
  61. 61 Z2=Z1-K*Z(P2)
  62. 62 V1=X1-X(P3)
  63. 63 V2=Y1-Y(P3)
  64. 64 V3=Z1-K*Z(P3)
  65. 65 GOTO 135
  66. 66 I4=INT(P2)
  67. 67 I5=I4+1
  68. 68 X2=X0-(X(I4)+X(I5))/2
  69. 69 Y2=Y0-(Y(I4)+Y(I5))/2
  70. 70 Z2=Z0-K*(Z(I4)+Z(I5))/2
  71. 71 V1=X0-X(P3)
  72. 72 V2=Y0-Y(P3)
  73. 73 V3=Z0-K*Z(P3)
  74. 74 GOTO 135
  75. 75 X2=X0-X(P2)
  76. 76 Y2=Y0-Y(P2)
  77. 77 Z2=Z0-K*Z(P2)
  78. 78 I4=INT(P3)
  79. 79 I5=I4+1
  80. 80 V1=X0-(X(I4)+X(I5))/2
  81. 81 V2=Y0-(Y(I4)+Y(I5))/2
  82. 82 V3=Z0-K*(Z(I4)+Z(I5))/2
  83. 83 GOTO 135
  84. 84 REM ----- ENTRIES REQUIRED FOR IMPEDANCE MATRIX CALCULATION
  85. 85 REM ----- S(M) GOES IN (X1,Y1,Z1) FOR SCALAR POTENTIAL
  86. 86 REM ----- MOD FOR SMALL RADIUS TO WAVE LENGTH RATIO
  87. 87 FVS=1
  88. 88 IF K<1 THEN 94
  89. 89 IF A(P4)>SRM THEN 94
  90. 90 IF (P3=P2+1 AND P1=(P2+P3)/2) THEN 91 ELSE 94
  91. 91 T1=2*LOG(S(P4)/A(P4))
  92. 92 T2=-W*S(P4)
  93. 93 RETURN
  94. 94 I4=INT(P1)
  95. 95 I5=I4+1
  96. 96 X1=(X(I4)+X(I5))/2
  97. 97 Y1=(Y(I4)+Y(I5))/2
  98. 98 Z1=(Z(I4)+Z(I5))/2
  99. 99 GOTO 113
  100. 100 REM ----- S(M) GOES IN (X1,Y1,Z1) FOR VECTOR POTENTIAL
  101. 101 REM ----- MOD FOR SMALL RADIUS TO WAVE LENGTH RATIO
  102. 102 FVS=0
  103. 103 IF K<1 THEN 109
  104. 104 IF A(P4)>=SRM THEN 109
  105. 105 IF (I=J AND P3=P2+.5) THEN 106 ELSE 109
  106. 106 T1=LOG(S(P4)/A(P4))
  107. 107 T2=-W*S(P4)/2
  108. 108 RETURN
  109. 109 X1=X(P1)
  110. 110 Y1=Y(P1)
  111. 111 Z1=Z(P1)
  112. 112 REM ----- S(U)-S(M) GOES IN (X2,Y2,Z2)
  113. 113 I4=INT(P2)
  114. 114 IF I4=P2 THEN 120
  115. 115 I5=I4+1
  116. 116 X2=(X(I4)+X(I5))/2-X1
  117. 117 Y2=(Y(I4)+Y(I5))/2-Y1
  118. 118 Z2=K*(Z(I4)+Z(I5))/2-Z1
  119. 119 GOTO 124
  120. 120 X2=X(P2)-X1
  121. 121 Y2=Y(P2)-Y1
  122. 122 Z2=K*Z(P2)-Z1
  123. 123 REM ----- S(V)-S(M) GOES IN (V1,V2,V3)
  124. 124 I4=INT(P3)
  125. 125 IF I4=P3 THEN 131
  126. 126 I5=I4+1
  127. 127 V1=(X(I4)+X(I5))/2-X1
  128. 128 V2=(Y(I4)+Y(I5))/2-Y1
  129. 129 V3=K*(Z(I4)+Z(I5))/2-Z1
  130. 130 GOTO 135
  131. 131 V1=X(P3)-X1
  132. 132 V2=Y(P3)-Y1
  133. 133 V3=K*Z(P3)-Z1
  134. 134 REM ----- MAGNITUDE OF S(U) - S(M)
  135. 135 D0=X2*X2+Y2*Y2+Z2*Z2
  136. 136 REM ----- MAGNITUDE OF S(V) - S(M)
  137. 137 IF D0>0 THEN D0=SQR(D0)
  138. 138 D3=V1*V1+V2*V2+V3*V3
  139. 139 IF D3>0 THEN D3=SQR(D3)
  140. 140 REM ----- SQUARE OF WIRE RADIUS
  141. 141 A2=A(P4)*A(P4)
  142. 142 REM ----- MAGNITUDE OF S(V) - S(U)
  143. 143 S4=(P3-P2)*S(P4)
  144. 144 REM ----- ORDER OF INTEGRATION
  145. 145 REM ----- LTH ORDER GAUSSIAN QUADRATURE
  146. 146 T1=0
  147. 147 T2=0
  148. 148 I6!=0
  149. 149 F2=1
  150. 150 L=7
  151. 151 T=(D0+D3)/S(P4)
  152. 152 REM ----- CRITERIA FOR EXACT KERNEL
  153. 153 IF T>1.1 THEN 165
  154. 154 IF C$="N" THEN 165
  155. 155 IF J2(W%(I),1)=J2(W%(J),1) THEN 160
  156. 156 IF J2(W%(I),1)=J2(W%(J),2) THEN 160
  157. 157 IF J2(W%(I),2)=J2(W%(J),1) THEN 160
  158. 158 IF J2(W%(I),2)=J2(W%(J),2) THEN 160
  159. 159 GOTO 165
  160. 160 IF A(P4)>SRM THEN 162
  161. 161 IF FVS=1 THEN 91 ELSE 106
  162. 162 F2=2*(P3-P2)
  163. 163 I6!=(1-LOG(S4/F2/8/A(P4)))/P/A(P4)
  164. 164 GOTO 167
  165. 165 IF T>6 THEN L=3
  166. 166 IF T>10 THEN L=1
  167. 167 I5=L+L
  168. 168 T3=0
  169. 169 T4=0
  170. 170 T=(Q(L)+.5)/F2
  171. 171 GOSUB 28
  172. 172 T=(.5-Q(L))/F2
  173. 173 GOSUB 28
  174. 174 L=L+1
  175. 175 T1=T1+Q(L)*T3
  176. 176 T2=T2+Q(L)*T4
  177. 177 L=L+1
  178. 178 IF L<I5 THEN 168
  179. 179 T1=S4*(T1+I6!)
  180. 180 T2=S4*T2
  181. 181 RETURN
  182. 182 REM ********** COMPLEX SQUARE ROOT **********
  183. 183 REM ----- W6+I*W7=SQR(Z6+I*Z7)
  184. 184 T6=SQR((ABS(Z6)+SQR(Z6*Z6+Z7*Z7))/2)
  185. 185 T7=ABS(Z7)/2/T6
  186. 186 IF Z6<0 THEN 191
  187. 187 W6=T6
  188. 188 W7=T7
  189. 189 IF Z7<0 THEN W7=-T7
  190. 190 RETURN
  191. 191 W6=T7
  192. 192 W7=T6
  193. 193 IF Z7<0 THEN W7=-T6
  194. 194 RETURN
  195. 195 REM ********** IMPEDANCE MATRIX CALCULATION **********
  196. 196 IF FLG=1 THEN 428
  197. 197 IF FLG=2 THEN 477
  198. 198 REM ----- BEGIN MATRIX FILL TIME CALCULATION
  199. 199 OT$=TIME$
  200. 200 Q$="MATRIX FILL  "
  201. 201 PRINT
  202. 202 PRINT "BEGIN ";Q$
  203. 203 REM ----- ZERO IMPEDANCE MATRIX
  204. 204 FOR I=1 TO N
  205. 205 FOR J=1 TO N
  206. 206 ZR(I,J)=0
  207. 207 ZI(I,J)=0
  208. 208 NEXT J
  209. 209 NEXT I
  210. 210 REM ----- COMPUTE ROW I OF MATRIX (OBSERVATION LOOP)
  211. 211 FOR I=1 TO N
  212. 212 I1=ABS(C%(I,1))
  213. 213 I2=ABS(C%(I,2))
  214. 214 F4=SGN(C%(I,1))*S(I1)
  215. 215 F5=SGN(C%(I,2))*S(I2)
  216. 216 REM ----- R(M + 1/2) - R(M - 1/2) HAS COMPONENTS (T5,T6,T7)
  217. 217 T5=F4*CA(I1)+F5*CA(I2)
  218. 218 T6=F4*CB(I1)+F5*CB(I2)
  219. 219 T7=F4*CG(I1)+F5*CG(I2)
  220. 220 IF C%(I,1)=-C%(I,2) THEN T7=S(I1)*(CG(I1)+CG(I2))
  221. 221 REM ----- COMPUTE COLUMN J OF ROW I (SOURCE LOOP)
  222. 222 FOR J=1 TO N
  223. 223 J1=ABS(C%(J,1))
  224. 224 J2=ABS(C%(J,2))
  225. 225 F4=SGN(C%(J,1))
  226. 226 F5=SGN(C%(J,2))
  227. 227 F6=1
  228. 228 F7=1
  229. 229 REM ----- IMAGE LOOP
  230. 230 FOR K=1 TO G STEP -2
  231. 231 IF C%(J,1)<>-C%(J,2) THEN 235
  232. 232 IF K<0 THEN 332
  233. 233 F6=F4
  234. 234 F7=F5
  235. 235 F8=0
  236. 236 IF K<0 THEN 248
  237. 237 REM ----- SET FLAG TO AVOID REDUNANT CALCULATIONS
  238. 238 IF I1<>I2 THEN 246
  239. 239 IF (CA(I1)+CB(I1))=0 THEN 241
  240. 240 IF C%(I,1)<>C%(I,2) THEN 246
  241. 241 IF J1<>J2 THEN 246
  242. 242 IF (CA(J1)+CB(J1))=0 THEN 244
  243. 243 IF C%(J,1)<>C%(J,2) THEN 246
  244. 244 IF I1=J1 THEN F8=1
  245. 245 IF I=J THEN F8=2
  246. 246 IF ZR(I,J)<>0 THEN 317
  247. 247 REM ----- COMPUTE PSI(M,N,N+1/2)
  248. 248 P1=2*W%(I)+I-1
  249. 249 P2=2*W%(J)+J-1
  250. 250 P3=P2+.5
  251. 251 P4=J2
  252. 252 GOSUB 102
  253. 253 U1=F5*T1
  254. 254 U2=F5*T2
  255. 255 REM ----- COMPUTE PSI(M,N-1/2,N)
  256. 256 P3=P2
  257. 257 P2=P2-.5
  258. 258 P4=J1
  259. 259 IF F8<2 THEN GOSUB 102
  260. 260 V1=F4*T1
  261. 261 V2=F4*T2
  262. 262 REM ----- S(N+1/2)*PSI(M,N,N+1/2) + S(N-1/2)*PSI(M,N-1/2,N)
  263. 263 X3=U1*CA(J2)+V1*CA(J1)
  264. 264 Y3=U1*CB(J2)+V1*CB(J1)
  265. 265 Z3=(F7*U1*CG(J2)+F6*V1*CG(J1))*K
  266. 266 REM ----- REAL PART OF VECTOR POTENTIAL CONTRIBUTION
  267. 267 D1=W2*(X3*T5+Y3*T6+Z3*T7)
  268. 268 X3=U2*CA(J2)+V2*CA(J1)
  269. 269 Y3=U2*CB(J2)+V2*CB(J1)
  270. 270 Z3=(F7*U2*CG(J2)+F6*V2*CG(J1))*K
  271. 271 REM ----- IMAGINARY PART OF VECTOR POTENTIAL CONTRIBUTION
  272. 272 D2=W2*(X3*T5+Y3*T6+Z3*T7)
  273. 273 REM ----- COMPUTE PSI(M+1/2,N,N+1)
  274. 274 P1=P1+.5
  275. 275 IF F8=2 THEN P1=P1-1
  276. 276 P2=P3
  277. 277 P3=P3+1
  278. 278 P4=J2
  279. 279 IF F8<>1 THEN 283
  280. 280 U5=F5*U1+T1
  281. 281 U6=F5*U2+T2
  282. 282 GOTO 291
  283. 283 GOSUB 87
  284. 284 IF F8<2 THEN 288
  285. 285 U1=(2*T1-4*U1*F5)/S(J1)
  286. 286 U2=(2*T2-4*U2*F5)/S(J1)
  287. 287 GOTO 314
  288. 288 U5=T1
  289. 289 U6=T2
  290. 290 REM ----- COMPUTE PSI(M-1/2,N,N+1)
  291. 291 P1=P1-1
  292. 292 GOSUB 87
  293. 293 U1=(T1-U5)/S(J2)
  294. 294 U2=(T2-U6)/S(J2)
  295. 295 REM ----- COMPUTE PSI(M+1/2,N-1,N)
  296. 296 P1=P1+1
  297. 297 P3=P2
  298. 298 P2=P2-1
  299. 299 P4=J1
  300. 300 GOSUB 87
  301. 301 U3=T1
  302. 302 U4=T2
  303. 303 REM ----- COMPUTE PSI(M-1/2,N-1,N)
  304. 304 IF F8<1 THEN 308
  305. 305 T1=U5
  306. 306 T2=U6
  307. 307 GOTO 311
  308. 308 P1=P1-1
  309. 309 GOSUB 87
  310. 310 REM ----- GRADIENT OF SCALAR POTENTIAL CONTRIBUTION
  311. 311 U1=U1+(U3-T1)/S(J1)
  312. 312 U2=U2+(U4-T2)/S(J1)
  313. 313 REM ----- SUM INTO IMPEDANCE MATRIX
  314. 314 ZR(I,J)=ZR(I,J)+K*(D1+U1)
  315. 315 ZI(I,J)=ZI(I,J)+K*(D2+U2)
  316. 316 REM ----- AVOID REDUNANT CALCULATIONS
  317. 317 IF J<I THEN 332
  318. 318 IF F8=0 THEN 332
  319. 319 ZR(J,I)=ZR(I,J)
  320. 320 ZI(J,I)=ZI(I,J)
  321. 321 REM ----- SEGMENTS ON SAME WIRE SAME DISTANCE APART HAVE SAME Z
  322. 322 P1=J+1
  323. 323 IF P1>N THEN 332
  324. 324 IF C%(P1,1)<>C%(P1,2) THEN 332
  325. 325 IF C%(P1,2)=C%(J,2) THEN 328
  326. 326 IF C%(P1,2)<>-C%(J,2) THEN 332
  327. 327 IF (CA(J2)+CB(J2))<>0 THEN 332
  328. 328 P2=I+1
  329. 329 IF P2>N THEN 332
  330. 330 ZR(P2,P1)=ZR(I,J)
  331. 331 ZI(P2,P1)=ZI(I,J)
  332. 332 NEXT K
  333. 333 NEXT J
  334. 334 PCT=I/N
  335. 335 GOSUB 1599
  336. 336 NEXT I
  337. 337 REM ----- END MATRIX FILL TIME CALCULATION
  338. 338 T$=TIME$
  339. 339 GOSUB 1589
  340. 340 PRINT #3," "
  341. 341 PRINT #3,"FILL MATRIX  : ";T$
  342. 342 REM ********** ADDITION OF LOADS **********
  343. 343 IF NL=0 THEN 377
  344. 344 F5=2*P*F
  345. 345 FOR I=1 TO NL
  346. 346 IF L$="N" THEN 366
  347. 347 REM ----- S-PARAMETER LOADS
  348. 348 U1=0
  349. 349 U2=0
  350. 350 D1=0
  351. 351 D2=0
  352. 352 S=1
  353. 353 FOR J=0 TO LS(I) STEP 2
  354. 354 U1=U1+LA(1,I,J)*S*F5^J
  355. 355 D1=D1+LA(2,I,J)*S*F5^J
  356. 356 L=J+1
  357. 357 U2=U2+LA(1,I,L)*S*F5^L
  358. 358 D2=D2+LA(2,I,L)*S*F5^L
  359. 359 S=-S
  360. 360 NEXT J
  361. 361 J=LP(I)
  362. 362 D=D1*D1+D2*D2
  363. 363 LI=(U2*D1-D2*U1)/D
  364. 364 LR=(U1*D1+U2*D2)/D
  365. 365 GOTO 369
  366. 366 LR=LA(1,I,1)
  367. 367 LI=LA(2,I,1)
  368. 368 J=LP(I)
  369. 369 F2=1/M
  370. 370 IF C%(J,1)<>-C%(J,2) THEN 372
  371. 371 IF K<0 THEN F2=2/M
  372. 372 ZR(J,J)=ZR(J,J)+F2*LI
  373. 373 ZI(J,J)=ZI(J,J)-F2*LR
  374. 374 NEXT I
  375. 375 REM ********** IMPEDANCE MATRIX FACTORIZATION **********
  376. 376 REM ----- BEGIN MATRIX FACTOR TIME CALCULATION
  377. 377 OT$=TIME$
  378. 378 Q$="FACTOR MATRIX"
  379. 379 PRINT
  380. 380 PRINT "BEGIN ";Q$;
  381. 381 X=N
  382. 382 PCTN=X*(X-1)*(X+X-1)
  383. 383 FOR K=1 TO N-1
  384. 384 REM ----- SEARCH FOR PIVOT
  385. 385 T=ZR(K,K)*ZR(K,K)+ZI(K,K)*ZI(K,K)
  386. 386 I1=K
  387. 387 FOR I=K+1 TO N
  388. 388 T1=ZR(I,K)*ZR(I,K)+ZI(I,K)*ZI(I,K)
  389. 389 IF T1<T THEN 392
  390. 390 I1=I
  391. 391 T=T1
  392. 392 NEXT I
  393. 393 REM ----- EXCHANGE ROWS K AND I1
  394. 394 IF I1=K THEN 403
  395. 395 FOR J=1 TO N
  396. 396 T1=ZR(K,J)
  397. 397 T2=ZI(K,J)
  398. 398 ZR(K,J)=ZR(I1,J)
  399. 399 ZI(K,J)=ZI(I1,J)
  400. 400 ZR(I1,J)=T1
  401. 401 ZI(I1,J)=T2
  402. 402 NEXT J
  403. 403 P(K)=I1
  404. 404 REM ----- SUBTRACT ROW K FROM ROWS K+1 TO N
  405. 405 FOR I=K+1 TO N
  406. 406 REM ----- COMPUTE MULTIPLIER L(I,K)
  407. 407 T1=(ZR(I,K)*ZR(K,K)+ZI(I,K)*ZI(K,K))/T
  408. 408 T2=(ZI(I,K)*ZR(K,K)-ZR(I,K)*ZI(K,K))/T
  409. 409 ZR(I,K)=T1
  410. 410 ZI(I,K)=T2
  411. 411 REM ----- SUBTRACT ROW K FROM ROW I
  412. 412 FOR J=K+1 TO N
  413. 413 ZR(I,J)=ZR(I,J)-(ZR(K,J)*T1-ZI(K,J)*T2)
  414. 414 ZI(I,J)=ZI(I,J)-(ZR(K,J)*T2+ZI(K,J)*T1)
  415. 415 NEXT J
  416. 416 NEXT I
  417. 417 X=N-K
  418. 418 PCT=1-X*(X-1)*(X+X-1)/PCTN
  419. 419 GOSUB 1599
  420. 420 NEXT K
  421. 421 REM ----- END MATRIX FACTOR TIME CALCULATION
  422. 422 T$=TIME$
  423. 423 GOSUB 1589
  424. 424 PRINT
  425. 425 PRINT #3, "FACTOR MATRIX: ";T$
  426. 426 REM ********** SOLVE **********
  427. 427 REM ----- COMPUTE RIGHT HAND SIDE
  428. 428 FOR I=1 TO N
  429. 429 CR(I)=0
  430. 430 CI(I)=0
  431. 431 NEXT I
  432. 432 FOR J=1 TO NS
  433. 433 F2=1/M
  434. 434 IF C%(E(J),1)=-C%(E(J),2) THEN F2=2/M
  435. 435 CR(E(J))=F2*M(J)
  436. 436 CI(E(J))=-F2*L(J)
  437. 437 NEXT J
  438. 438 REM ----- PERMUTE EXCITATION
  439. 439 FOR K=1 TO N-1
  440. 440 I1=P(K)
  441. 441 IF I1=K THEN 448
  442. 442 T1=CR(K)
  443. 443 T2=CI(K)
  444. 444 CR(K)=CR(I1)
  445. 445 CI(K)=CI(I1)
  446. 446 CR(I1)=T1
  447. 447 CI(I1)=T2
  448. 448 NEXT K
  449. 449 REM ----- FORWARD ELIMINATION
  450. 450 FOR I=2 TO N
  451. 451 T1=0
  452. 452 T2=0
  453. 453 FOR J=1 TO I-1
  454. 454 T1=T1+ZR(I,J)*CR(J)-ZI(I,J)*CI(J)
  455. 455 T2=T2+ZR(I,J)*CI(J)+ZI(I,J)*CR(J)
  456. 456 NEXT J
  457. 457 CR(I)=CR(I)-T1
  458. 458 CI(I)=CI(I)-T2
  459. 459 NEXT I
  460. 460 REM ----- BACK SUBSTITUTION
  461. 461 FOR I=N TO 1 STEP -1
  462. 462 T1=0
  463. 463 T2=0
  464. 464 IF I=N THEN 469
  465. 465 FOR J=I+1 TO N
  466. 466 T1=T1+ZR(I,J)*CR(J)-ZI(I,J)*CI(J)
  467. 467 T2=T2+ZR(I,J)*CI(J)+ZI(I,J)*CR(J)
  468. 468 NEXT J
  469. 469 T=ZR(I,I)*ZR(I,I)+ZI(I,I)*ZI(I,I)
  470. 470 T1=CR(I)-T1
  471. 471 T2=CI(I)-T2
  472. 472 CR(I)=(T1*ZR(I,I)+T2*ZI(I,I))/T
  473. 473 CI(I)=(T2*ZR(I,I)-T1*ZI(I,I))/T
  474. 474 NEXT I
  475. 475 FLG=2
  476. 476 REM ********** SOURCE DATA **********
  477. 477 PRINT #3," "
  478. 478 PRINT #3,B$;"    SOURCE DATA     ";B$
  479. 479 PWR=0
  480. 480 FOR I=1 TO NS
  481. 481 CR=CR(E(I))
  482. 482 CI=CI(E(I))
  483. 483 T=CR*CR+CI*CI
  484. 484 T1=(L(I)*CR+M(I)*CI)/T
  485. 485 T2=(M(I)*CR-L(I)*CI)/T
  486. 486 O2=(L(I)*CR+M(I)*CI)/2
  487. 487 PWR=PWR+O2
  488. 488 PRINT #3,"PULSE ";E(I),"VOLTAGE = (";L(I);",";M(I);"J)"
  489. 489 PRINT #3," ","CURRENT = (";CR;",";CI;"J)"
  490. 490 PRINT #3," ","IMPEDANCE = (";T1;",";T2;"J)"
  491. 491 PRINT #3," ","POWER = ";O2;" WATTS"
  492. 492 NEXT I
  493. 493 IF NS>1 THEN PRINT #3," "
  494. 494 IF NS>1 THEN PRINT #3,"TOTAL POWER = ";PWR;"WATTS"
  495. 495 RETURN
  496. 496 REM ********** PRINT CURRENTS **********
  497. 497 GOSUB 196
  498. 498 S$="N"
  499. 499 PRINT #3, " "
  500. 500 PRINT #3,B$;"    CURRENT DATA    ";B$
  501. 501 FOR K=1 TO NW
  502. 502 IF S$="Y" THEN 507
  503. 503 PRINT #3, " "
  504. 504 PRINT #3, "WIRE NO. ";K;":"
  505. 505 PRINT #3, "PULSE","REAL","IMAGINARY","MAGNITUDE","PHASE"
  506. 506 PRINT #3, " NO.","(AMPS)","(AMPS)","(AMPS)","(DEGREES)"
  507. 507 N1=N(K,1)
  508. 508 N2=N(K,2)
  509. 509 I=N1
  510. 510 C=C%(I,1)
  511. 511 IF (N1=0 AND N2=0) THEN C=K
  512. 512 IF G=1 THEN 515
  513. 513 IF (J1(K)=-1 AND N1>N2) THEN N2=N1
  514. 514 IF J1(K)=-1 THEN 525
  515. 515 E%=1
  516. 516 GOSUB 572
  517. 517 I2!=I1!
  518. 518 J2!=J1!
  519. 519 GOSUB 607
  520. 520 IF S$="N" THEN PRINT #3, I$,I1!;TAB(29);J1!;TAB(43);S1;TAB(57);S2
  521. 521 IF S$="Y" THEN PRINT #1,I1!;",";J1!;",";S1;",";S2
  522. 522 IF N1=0 THEN 532
  523. 523 IF C=K THEN 525
  524. 524 IF I$="J" THEN N1=N1+1
  525. 525 FOR I=N1 TO N2-1
  526. 526 I2!=CR(I)
  527. 527 J2!=CI(I)
  528. 528 GOSUB 607
  529. 529 IF S$="N" THEN PRINT #3, I,CR(I);TAB(29);CI(I);TAB(43);S1;TAB(57);S2
  530. 530 IF S$="Y" THEN PRINT #1,CR(I);",";CI(I);",";S1;",";S2
  531. 531 NEXT I
  532. 532 I=N2
  533. 533 C=C%(I,2)
  534. 534 IF (N1=0 AND N2=0) THEN C=K
  535. 535 IF G=1 THEN 537
  536. 536 IF J1(K)=1 THEN 543
  537. 537 E%=2
  538. 538 GOSUB 572
  539. 539 IF (N1=0 AND N2=0) THEN 549
  540. 540 IF N1>N2 THEN 549
  541. 541 IF C=K THEN 543
  542. 542 IF I$="J" THEN 549
  543. 543 I2!=CR(N2)
  544. 544 J2!=CI(N2)
  545. 545 GOSUB 607
  546. 546 IF S$="N" THEN PRINT #3, N2,CR(N2);TAB(29);CI(N2);TAB(43);S1;TAB(57);S2
  547. 547 IF S$="Y" THEN PRINT #1,CR(N2);",";CI(N2);",";S1;",";S2
  548. 548 IF J1(K)=1 THEN 554
  549. 549 I2!=I1!
  550. 550 J2!=J1!
  551. 551 GOSUB 607
  552. 552 IF S$="N" THEN PRINT #3,I$,I1!;TAB(29);J1!;TAB(43);S1;TAB(57);S2
  553. 553 IF S$="Y" THEN PRINT #1,I1!;",";J1!;",";S1;",";S2
  554. 554 IF S$="Y" THEN PRINT #1," 1 , 1 , 1 , 1"
  555. 555 NEXT K
  556. 556 IF S$="Y" THEN 569
  557. 557 PRINT
  558. 558 INPUT "SAVE CURRENTS TO A FILE (Y/N) ";S$
  559. 559 IF S$="N" THEN 570
  560. 560 IF S$<>"Y" THEN 557
  561. 561 PRINT #3," "
  562. 562 INPUT "FILENAME (NAME.OUT) ";F$
  563. 563 IF LEFT$(RIGHT$(F$,4),1)="." THEN 564 ELSE F$=F$+".OUT"
  564. 564 IF O$>"C" THEN PRINT #3,"FILENAME (NAME.OUT): ";F$
  565. 565 OPEN F$ FOR OUTPUT AS #1
  566. 566 PRINT #3," "
  567. 567 PRINT #1,NW;",";PWR;",C"
  568. 568 GOTO 501
  569. 569 CLOSE #1
  570. 570 RETURN
  571. 571 REM ----- SORT JUNCTION CURRENTS
  572. 572 I$="E"
  573. 573 I1!=0! 
  574. 574 J1!=0! 
  575. 575 IF (C=K OR C=0) THEN 580
  576. 576 I$="J" 
  577. 577 I1!=CR(I)
  578. 578 J1!=CI(I)
  579. 579 REM ----- CHECK FOR OTHER OVERLAPPING WIRES
  580. 580 FOR J=1 TO NW
  581. 581 IF J=K GOTO 604
  582. 582 L1=N(J,1)
  583. 583 L2=N(J,2)
  584. 584 IF E%=2 THEN 590
  585. 585 CO=C%(L1,1)
  586. 586 CT=C%(L2,2)
  587. 587 L3=L1
  588. 588 L4=L2
  589. 589 GOTO 594
  590. 590 CO=C%(L2,2)
  591. 591 CT=C%(L1,1)
  592. 592 L3=L2
  593. 593 L4=L1
  594. 594 IF CO=-K THEN 596
  595. 595 GOTO 599
  596. 596 I1!=I1!-CR(L3)
  597. 597 J1!=J1!-CI(L3)
  598. 598 I$="J"
  599. 599 IF CT=K THEN 601
  600. 600 GOTO 604
  601. 601 I1!=I1!+CR(L4)
  602. 602 J1!=J1!+CI(L4)
  603. 603 I$="J"
  604. 604 NEXT J
  605. 605 RETURN
  606. 606 REM ----- CALCULATE S1 AND S2
  607. 607 I3!=I2!*I2!
  608. 608 J3!=J2!*J2!
  609. 609 IF (I3!>0 OR J3!>0) THEN 612
  610. 610 S1=0!
  611. 611 GOTO 613
  612. 612 S1=SQR(I3!+J3!)
  613. 613 IF I2!><0 THEN 616
  614. 614 S2=0!
  615. 615 RETURN
  616. 616 S2=ATN(J2!/I2!)/P0
  617. 617 IF I2!>0 THEN RETURN
  618. 618 S2=S2+SGN(J2!)*180
  619. 619 RETURN
  620. 620 REM ********** FAR FIELD CALCULATION **********
  621. 621 IF FLG<2 THEN GOSUB 196
  622. 622 O2=PWR
  623. 623 REM ----- TABULATE IMPEDANCE
  624. 624 IF NM=0 THEN 634
  625. 625 FOR I=1 TO NM
  626. 626 Z6=T(I)
  627. 627 Z7=-V(I)/(2*P*F*8.85E-06)
  628. 628 REM ----- FORM IMPEDANCE=1/SQR(DIELECTRIC CONSTANT)
  629. 629 GOSUB 184
  630. 630 D=W6*W6+W7*W7
  631. 631 Z1(I)=W6/D
  632. 632 Z2(I)=-W7/D
  633. 633 NEXT I
  634. 634 PRINT #3," "
  635. 635 PRINT #3,B$;"     FAR FIELD      ";B$
  636. 636 PRINT #3," "
  637. 637 REM ----- INPUT VARIABLES FOR FAR FIELD CALCULATION
  638. 638 INPUT "CALCULATE PATTERN IN DBI OR VOLTS/METER (D/V)";P$
  639. 639 IF P$="D" THEN 655
  640. 640 IF P$<>"V" THEN 638
  641. 641 F1=1
  642. 642 PRINT
  643. 643 PRINT "PRESENT POWER LEVEL =  ";PWR;" WATTS"
  644. 644 INPUT "CHANGE POWER LEVEL (Y/N) ";A$
  645. 645 IF A$="N" THEN 650
  646. 646 IF A$<>"Y" THEN 644
  647. 647 INPUT "NEW POWER LEVEL (WATTS)  ";O2
  648. 648 IF O$>"C" THEN PRINT #3,"NEW POWER LEVEL = ";O2
  649. 649 GOTO 644
  650. 650 IF (O2<0 OR O2=0) THEN O2=PWR
  651. 651 F1=SQR(O2/PWR)
  652. 652 PRINT
  653. 653 INPUT "RADIAL DISTANCE (METERS) ";RD
  654. 654 IF RD<0 THEN RD=0
  655. 655 A$="ZENITH ANGLE : INITIAL,INCREMENT,NUMBER"
  656. 656 PRINT A$;
  657. 657 INPUT ZA,ZC,NZ
  658. 658 IF NZ=0 THEN NZ=1
  659. 659 IF O$>"C" THEN PRINT #3,A$;": ";ZA;",";ZC;",";NZ
  660. 660 A$="AZIMUTH ANGLE: INITIAL,INCREMENT,NUMBER"
  661. 661 PRINT A$;
  662. 662 INPUT AA,AC,NA
  663. 663 IF NA=0 THEN NA=1
  664. 664 IF O$>"C" THEN PRINT #3,A$;": ";AA;",";AC;",";NA
  665. 665 PRINT #3," "
  666. 666 REM ********** FILE FAR FIELD DATA **********
  667. 667 INPUT "FILE PATTERN (Y/N)";S$
  668. 668 IF S$="N" THEN 676
  669. 669 IF S$<>"Y" THEN 667
  670. 670 PRINT #3," "
  671. 671 INPUT "FILENAME (NAME.OUT)";F$
  672. 672 IF LEFT$(RIGHT$(F$,4),1)="." THEN 673 ELSE F$=F$+".OUT"
  673. 673 IF O$>"C" THEN PRINT #3,"FILENAME (NAME.OUT): ";F$
  674. 674 OPEN F$ FOR OUTPUT AS #1
  675. 675 PRINT #1,NA*NZ;",";O2;",";P$
  676. 676 PRINT #3, " "
  677. 677 K9!=.016678/PWR
  678. 678 REM ----- PATTERN HEADER
  679. 679 PRINT #3,B$;"    PATTERN DATA    ";B$
  680. 680 IF P$="V" GOTO 685
  681. 681 PRINT #3,"ZENITH","AZIMUTH","VERTICAL","HORIZONTAL","TOTAL"
  682. 682 A$="PATTERN (DB)"
  683. 683 PRINT #3," ANGLE"," ANGLE",A$,A$,A$
  684. 684 GOTO 692
  685. 685 IF RD>0 THEN PRINT #3,TAB(15);"RADIAL DISTANCE = ";RD;" METERS"
  686. 686 PRINT #3,TAB(15);"POWER LEVEL = ";PWR*F1*F1;" WATTS"
  687. 687 PRINT #3,"ZENITH   AZIMUTH","     E(THETA)     ","     E(PHI)"
  688. 688 A$=" MAG(V/M)    PHASE(DEG)"
  689. 689 PRINT #3," ANGLE    ANGLE",A$,A$
  690. 690 IF S$="Y" THEN PRINT #1,RD
  691. 691 REM ----- LOOP OVER AZIMUTH ANGLE
  692. 692 Q1=AA
  693. 693 FOR I1=1 TO NA
  694. 694 U3=Q1*P0
  695. 695 V1=-SIN(U3)
  696. 696 V2=COS(U3)
  697. 697 REM ----- LOOP OVER ZENITH ANGLE
  698. 698 Q2=ZA
  699. 699 FOR I2=1 TO NZ
  700. 700 U4=Q2*P0
  701. 701 R3=COS(U4)
  702. 702 T3=-SIN(U4)
  703. 703 T1=R3*V2
  704. 704 T2=-R3*V1
  705. 705 R1=-T3*V2
  706. 706 R2=T3*V1
  707. 707 X1=0
  708. 708 Y1=0
  709. 709 Z1=0
  710. 710 X2=0
  711. 711 Y2=0
  712. 712 Z2=0
  713. 713 REM ----- IMAGE LOOP
  714. 714 FOR K=1 TO G STEP -2
  715. 715 FOR I=1 TO N
  716. 716 IF K>0 THEN 718
  717. 717 IF C%(I,1)=-C%(I,2) THEN 813
  718. 718 J=2*W%(I)-1+I
  719. 719 REM ----- FOR EACH END OF PULSE COMPUTE A CONTRIBUTION TO E-FIELD
  720. 720 FOR F5=1 TO 2
  721. 721 L=ABS(C%(I,F5))
  722. 722 F3=SGN(C%(I,F5))*W*S(L)/2
  723. 723 IF C%(I,1)<>-C%(I,2) THEN 725
  724. 724 IF F3<0 THEN 812
  725. 725 IF K=1 THEN 728
  726. 726 IF NM<>0 THEN 747
  727. 727 REM ----- STANDARD CASE
  728. 728 S2=W*(X(J)*R1+Y(J)*R2+Z(J)*K*R3)
  729. 729 S1=COS(S2)
  730. 730 S2=SIN(S2)
  731. 731 B1=F3*(S1*CR(I)-S2*CI(I))
  732. 732 B2=F3*(S1*CI(I)+S2*CR(I))
  733. 733 IF C%(I,1)=-C%(I,2) THEN 742
  734. 734 X1=X1+K*B1*CA(L)
  735. 735 X2=X2+K*B2*CA(L)
  736. 736 Y1=Y1+K*B1*CB(L)
  737. 737 Y2=Y2+K*B2*CB(L)
  738. 738 Z1=Z1+B1*CG(L)
  739. 739 Z2=Z2+B2*CG(L)
  740. 740 GOTO 812
  741. 741 REM ----- GROUNDED ENDS
  742. 742 Z1=Z1+2*B1*CG(L)
  743. 743 Z2=Z2+2*B2*CG(L)
  744. 744 GOTO 812
  745. 745 REM ----- REAL GROUND CASE
  746. 746 REM ----- BEGIN BY FINDING SPECULAR DISTANCE
  747. 747 T4=100000!
  748. 748 IF R3=0 THEN 750
  749. 749 T4=-Z(J)*T3/R3
  750. 750 B9=T4*V2+X(J)
  751. 751 IF TB=1 THEN 755
  752. 752 B9=B9*B9+(Y(J)-T4*V1)^2
  753. 753 IF B9>0 THEN B9=SQR(B9) ELSE 755
  754. 754 REM ----- SEARCH FOR THE CORRESPONDING MEDIUM
  755. 755 J2=NM
  756. 756 FOR J1=NM TO 1 STEP -1
  757. 757 IF B9>U(J1) THEN 759
  758. 758 J2=J1
  759. 759 NEXT J1
  760. 760 REM ----- OBTAIN IMPEDANCE AT SPECULAR POINT
  761. 761 Z4=Z1(J2)
  762. 762 Z5=Z2(J2)
  763. 763 REM ----- IF PRESENT INCLUDE GROUND SCREEN IMPEDANCE IN PARALLEL
  764. 764 IF NR=0 THEN 776
  765. 765 IF B9>U(1) THEN 776
  766. 766 R=B9+NR*RR
  767. 767 Z8=W*R*LOG(R/(NR*RR))/NR
  768. 768 S8=-Z5*Z8
  769. 769 S9=Z4*Z8
  770. 770 T8=Z4
  771. 771 T9=Z5+Z8
  772. 772 D=T8*T8+T9*T9
  773. 773 Z4=(S8*T8+S9*T9)/D
  774. 774 Z5=(S9*T8-S8*T9)/D
  775. 775 REM ----- FORM SQR(1-Z^2*SIN^2)
  776. 776 Z6=1-(Z4*Z4-Z5*Z5)*T3*T3
  777. 777 Z7=-(2*Z4*Z5)*T3*T3
  778. 778 GOSUB 184
  779. 779 REM ----- VERTICAL REFLECTION COEFFICIENT
  780. 780 S8=R3-(W6*Z4-W7*Z5)
  781. 781 S9=-(W6*Z5+W7*Z4)
  782. 782 T8=R3+(W6*Z4-W7*Z5)
  783. 783 T9=W6*Z5+W7*Z4
  784. 784 D=T8*T8+T9*T9
  785. 785 V8=(S8*T8+S9*T9)/D
  786. 786 V9=(S9*T8-S8*T9)/D
  787. 787 REM ----- HORIZONTAL REFLECTION COEFFICIENT
  788. 788 S8=W6-R3*Z4
  789. 789 S9=W7-R3*Z5
  790. 790 T8=W6+R3*Z4
  791. 791 T9=W7+R3*Z5
  792. 792 D=T8*T8+T9*T9
  793. 793 H8=(S8*T8+S9*T9)/D-V8
  794. 794 H9=(S9*T8-S8*T9)/D-V9
  795. 795 REM ----- COMPUTE CONTRIBUTION TO SUM
  796. 796 S2=W*(X(J)*R1+Y(J)*R2-(Z(J)-2*H(J2))*R3)
  797. 797 S1=COS(S2)
  798. 798 S2=SIN(S2)
  799. 799 B1=F3*(S1*CR(I)-S2*CI(I))
  800. 800 B2=F3*(S1*CI(I)+S2*CR(I))
  801. 801 W6=B1*V8-B2*V9
  802. 802 W7=B1*V9+B2*V8
  803. 803 D=CA(L)*V1+CB(L)*V2
  804. 804 Z6=D*(B1*H8-B2*H9)
  805. 805 Z7=D*(B1*H9+B2*H8)
  806. 806 X1=X1-(CA(L)*W6+V1*Z6)
  807. 807 X2=X2-(CA(L)*W7+V1*Z7)
  808. 808 Y1=Y1-(CB(L)*W6+V2*Z6)
  809. 809 Y2=Y2-(CB(L)*W7+V2*Z7)
  810. 810 Z1=Z1+CG(L)*W6
  811. 811 Z2=Z2+CG(L)*W7
  812. 812 NEXT F5
  813. 813 NEXT I
  814. 814 NEXT K
  815. 815 H2=-(X1*T1+Y1*T2+Z1*T3)*G0
  816. 816 H1=(X2*T1+Y2*T2+Z2*T3)*G0
  817. 817 X4=-(X1*V1+Y1*V2)*G0
  818. 818 X3=(X2*V1+Y2*V2)*G0
  819. 819 IF P$="D" THEN 827
  820. 820 IF RD=0 THEN 842
  821. 821 H1=H1/RD
  822. 822 H2=H2/RD
  823. 823 X3=X3/RD
  824. 824 X4=X4/RD
  825. 825 GOTO 842
  826. 826 REM ----- PATTERN IN DB
  827. 827 P1=-999
  828. 828 P2=P1
  829. 829 P3=P1
  830. 830 T1=K9!*(H1*H1+H2*H2)
  831. 831 T2=K9!*(X3*X3+X4*X4)
  832. 832 T3=T1+T2
  833. 833 REM ----- CALCULATE VALUES IN DB
  834. 834 IF T1>1E-30 THEN P1=4.343*LOG(T1)
  835. 835 IF T2>1E-30 THEN P2=4.343*LOG(T2)
  836. 836 IF T3>1E-30 THEN P3=4.343*LOG(T3)
  837. 837 PRINT #3,Q2;TAB(15);Q1;TAB(29);P1;TAB(43);P2;TAB(57);P3
  838. 838 IF S$="Y" THEN PRINT #1,Q2;",";Q1;",";P1;",";P2;",";P3
  839. 839 GOTO 866
  840. 840 REM ----- PATTERN IN VOLTS/METER
  841. 841 REM ----- MAGNITUDE AND PHASE OF E(THETA)
  842. 842 S1=0 
  843. 843 IF (H1=0 AND H2=0) THEN 845
  844. 844 S1=SQR(H1*H1+H2*H2)
  845. 845 IF H1><0 THEN 848
  846. 846 S2=0
  847. 847 GOTO 851
  848. 848 S2=ATN(H2/H1)/P0
  849. 849 IF H1<0 THEN S2=S2+SGN(H2)*180
  850. 850 REM ----- MAGNITUDE AND PHASE OF E(PHI)
  851. 851 S3=0
  852. 852 IF (X3=0 AND X4=0) THEN 854
  853. 853 S3=SQR(X3*X3+X4*X4)
  854. 854 IF X3><0 THEN 857
  855. 855 S4=0
  856. 856 GOTO 859
  857. 857 S4=ATN(X4/X3)/P0
  858. 858 IF X3<0 THEN S4=S4+SGN(X4)*180
  859. 859 PRINT #3,USING "###.##    ";Q2,Q1;
  860. 860 PRINT #3,USING "       ##.###^^^^";S1*F1;
  861. 861 PRINT #3,USING "   ###.##   ";S2;
  862. 862 PRINT #3,USING "       ##.###^^^^";S3*F1;
  863. 863 PRINT #3,USING "   ###.##";S4
  864. 864 IF S$="Y" THEN PRINT #1,Q2;",";Q1;",";S1*F1;",";S2;",";S3*F1;","S4
  865. 865 REM ----- INCREMENT ZENITH ANGLE
  866. 866 Q2=Q2+ZC
  867. 867 NEXT I2
  868. 868 REM ----- INCREMENT AZIMUTH ANGLE
  869. 869 Q1=Q1+AC
  870. 870 NEXT I1
  871. 871 CLOSE #1
  872. 872 RETURN
  873. 873 REM ********** NEAR FIELD CALCULATION **********
  874. 874 REM ----- ENSURE CURRENTS HAVE BEEN CALCULATED
  875. 875 IF FLG<2 THEN GOSUB 196
  876. 876 O2=PWR
  877. 877 PRINT #3," "
  878. 878 PRINT #3,B$;"    NEAR FIELDS     ";B$
  879. 879 PRINT #3," "
  880. 880 INPUT "ELECTRIC OR MAGNETIC NEAR FIELDS (E/H) ";N$
  881. 881 IF(N$="H" OR N$="E") GOTO 883
  882. 882 GOTO 880
  883. 883 PRINT
  884. 884 REM ----- INPUT VARIABLES FOR NEAR FIELD CALCULATION
  885. 885 PRINT "FIELD LOCATION(S):"
  886. 886 A$="-COORDINATE (M): INITIAL,INCREMENT,NUMBER "
  887. 887 PRINT "   X";A$;
  888. 888 INPUT XI,XC,NX
  889. 889 IF NX=0 THEN NX=1
  890. 890 IF O$>"C" THEN PRINT #3,"X";A$;": ";XI;",";XC;",";NX
  891. 891 PRINT "   Y";A$;
  892. 892 INPUT YI,YC,NY
  893. 893 IF NY=0 THEN NY=1
  894. 894 IF O$>"C" THEN PRINT #3,"Y";A$;": ";YI;",";YC;",";NY
  895. 895 PRINT "   Z";A$;
  896. 896 INPUT ZI,ZC,NZ
  897. 897 IF NZ=0 THEN NZ=1
  898. 898 IF O$>"C" THEN PRINT #3,"Z";A$;": ";ZI;",";ZC;",";NZ
  899. 899 F1=1
  900. 900 PRINT
  901. 901 PRINT "PRESENT POWER LEVEL IS ";PWR;" WATTS"
  902. 902 INPUT "CHANGE POWER LEVEL (Y/N) ";A$
  903. 903 IF A$="N" THEN 908
  904. 904 IF A$<>"Y" THEN 902
  905. 905 INPUT "NEW POWER LEVEL (WATTS)  ";O2
  906. 906 IF O$>"C" THEN PRINT #3," ":PRINT #3,"NEW POWER LEVEL (WATTS) = ";O2
  907. 907 GOTO 902
  908. 908 IF (O2<0 OR O2=0) THEN O2=PWR
  909. 909 REM ----- RATIO OF POWER LEVELS
  910. 910 F1=SQR(O2/PWR)
  911. 911 IF N$="H" THEN F1=F1/S0/4/P
  912. 912 PRINT
  913. 913 REM ----- DESIGNATION OF OUTPUT FILE FOR NEAR FIELD DATA
  914. 914 INPUT "SAVE TO A FILE (Y/N) ";S$
  915. 915 IF S$="N" THEN 923
  916. 916 IF S$<>"Y" THEN 914
  917. 917 INPUT "FILENAME (NAME.OUT)  ";F$
  918. 918 IF LEFT$(RIGHT$(F$,4),1)="." THEN 919 ELSE F$=F$+".OUT"
  919. 919 IF O$>"C" THEN PRINT #3," ":PRINT #3,"FILENAME (NAME.OUT) ";F$
  920. 920 OPEN F$ FOR OUTPUT AS #2
  921. 921 PRINT #2,NX*NY*NZ;",";O2;",";N$
  922. 922 REM ----- LOOP OVER Z DIMENSION
  923. 923 FOR IZ=1 TO NZ
  924. 924 ZZ=ZI+(IZ-1)*ZC
  925. 925 REM ----- LOOP OVER Y DIMENSION
  926. 926 FOR IY=1 TO NY
  927. 927 YY=YI+(IY-1)*YC
  928. 928 REM ----- LOOP OVER X DIMENSION
  929. 929 FOR IX=1 TO NX
  930. 930 XX=XI+(IX-1)*XC
  931. 931 REM ----- NEAR FIELD HEADER
  932. 932 PRINT #3," "
  933. 933 IF N$="E" THEN PRINT #3,B$;"NEAR ELECTRIC FIELDS";B$
  934. 934 IF N$="H" THEN PRINT #3,B$;"NEAR MAGNETIC FIELDS";B$
  935. 935 PRINT #3,TAB(10);"FIELD POINT: ";"X = ";XX;" Y = ";YY;" Z = ";ZZ
  936. 936 PRINT #3,"  VECTOR","REAL","IMAGINARY","MAGNITUDE","PHASE"
  937. 937 IF N$="E" THEN A$=" V/M "
  938. 938 IF N$="H" THEN A$=" AMPS/M "
  939. 939 PRINT #3," COMPONENT  ",A$,A$,A$," DEG"
  940. 940 A1=0
  941. 941 A3=0
  942. 942 A4=0
  943. 943 REM ----- LOOP OVER THREE VECTOR COMPONENTS
  944. 944 FOR I=1 TO 3
  945. 945 X0=XX
  946. 946 Y0=YY
  947. 947 Z0=ZZ
  948. 948 IF N$="H" THEN 958
  949. 949 T5=0
  950. 950 T6=0
  951. 951 T7=0
  952. 952 IF I=1 THEN T5=2*S0
  953. 953 IF I=2 THEN T6=2*S0
  954. 954 IF I=3 THEN T7=2*S0
  955. 955 U7=0
  956. 956 U8=0
  957. 957 GOTO 968
  958. 958 FOR J8=1 TO 6
  959. 959 K!(J8,1)=0
  960. 960 K!(J8,2)=0
  961. 961 NEXT J8
  962. 962 J9=1
  963. 963 J8=-1
  964. 964 IF I=1 THEN X0=XX+J8*S0/2
  965. 965 IF I=2 THEN Y0=YY+J8*S0/2
  966. 966 IF I=3 THEN Z0=ZZ+J8*S0/2
  967. 967 REM ----- LOOP OVER SOURCE SEGMENTS
  968. 968 FOR J=1 TO N
  969. 969 J1=ABS(C%(J,1))
  970. 970 J2=ABS(C%(J,2))
  971. 971 J3=J2
  972. 972 IF J1>J2 THEN J3=J1
  973. 973 F4=SGN(C%(J,1))
  974. 974 F5=SGN(C%(J,2))
  975. 975 F6=1
  976. 976 F7=1
  977. 977 U5=0
  978. 978 U6=0
  979. 979 REM ----- IMAGE LOOP
  980. 980 FOR K=1 TO G STEP -2
  981. 981 IF C%(J,1)<>-C%(J,2) THEN 987
  982. 982 IF K<0 THEN 1048
  983. 983 REM ----- COMPUTE VECTOR POTENTIAL A
  984. 984 F6=F4
  985. 985 F7=F5
  986. 986 REM ----- COMPUTE PSI(0,J,J+.5)
  987. 987 P1=0
  988. 988 P2=2*J3+J-1
  989. 989 P3=P2+.5
  990. 990 P4=J2
  991. 991 GOSUB 75
  992. 992 U1=T1*F5
  993. 993 U2=T2*F5
  994. 994 REM ----- COMPUTE PSI(0,J-.5,J)
  995. 995 P3=P2
  996. 996 P2=P2-.5
  997. 997 P4=J1
  998. 998 GOSUB 66
  999. 999 V1=F4*T1
  1000. 1000 V2=F4*T2
  1001. 1001 REM ----- REAL PART OF VECTOR POTENTIAL CONTRIBUTION
  1002. 1002 X3=U1*CA(J2)+V1*CA(J1)
  1003. 1003 Y3=U1*CB(J2)+V1*CB(J1)
  1004. 1004 Z3=(F7*U1*CG(J2)+F6*V1*CG(J1))*K
  1005. 1005 REM ----- IMAGINARY PART OF VECTOR POTENTIAL CONTRIBUTION
  1006. 1006 X5=U2*CA(J2)+V2*CA(J1)
  1007. 1007 Y5=U2*CB(J2)+V2*CB(J1)
  1008. 1008 Z5=(F7*U2*CG(J2)+F6*V2*CG(J1))*K
  1009. 1009 REM ----- MAGNETIC FIELD CALCULATION COMPLETED
  1010. 1010 IF N$="H" THEN 1042
  1011. 1011 D1=(X3*T5+Y3*T6+Z3*T7)*W2
  1012. 1012 D2=(X5*T5+Y5*T6+Z5*T7)*W2
  1013. 1013 REM ----- COMPUTE PSI(.5,J,J+1)
  1014. 1014 P1=.5
  1015. 1015 P2=P3
  1016. 1016 P3=P3+1
  1017. 1017 P4=J2
  1018. 1018 GOSUB 56
  1019. 1019 U1=T1
  1020. 1020 U2=T2
  1021. 1021 REM ----- COMPUTE PSI(-.5,J,J+1)
  1022. 1022 P1=-P1
  1023. 1023 GOSUB 56
  1024. 1024 U1=(T1-U1)/S(J2)
  1025. 1025 U2=(T2-U2)/S(J2)
  1026. 1026 REM ----- COMPUTE PSI(.5,J-1,J)
  1027. 1027 P1=-P1
  1028. 1028 P3=P2
  1029. 1029 P2=P2-1
  1030. 1030 P4=J1
  1031. 1031 GOSUB 56
  1032. 1032 U3=T1
  1033. 1033 U4=T2
  1034. 1034 REM ----- COMPUTE PSI(-.5,J-1,J)
  1035. 1035 P1=-P1
  1036. 1036 GOSUB 56
  1037. 1037 REM ----- GRADIENT OF SCALAR POTENTIAL
  1038. 1038 U5=(U1+(U3-T1)/S(J1)+D1)*K+U5
  1039. 1039 U6=(U2+(U4-T2)/S(J1)+D2)*K+U6
  1040. 1040 GOTO 1048
  1041. 1041 REM ----- COMPONENTS OF VECTOR POTENTIAL A
  1042. 1042 K!(1,J9)=K!(1,J9)+(X3*CR(J)-X5*CI(J))*K
  1043. 1043 K!(2,J9)=K!(2,J9)+(X5*CR(J)+X3*CI(J))*K
  1044. 1044 K!(3,J9)=K!(3,J9)+(Y3*CR(J)-Y5*CI(J))*K
  1045. 1045 K!(4,J9)=K!(4,J9)+(Y5*CR(J)+Y3*CI(J))*K
  1046. 1046 K!(5,J9)=K!(5,J9)+(Z3*CR(J)-Z5*CI(J))*K
  1047. 1047 K!(6,J9)=K!(6,J9)+(Z5*CR(J)+Z3*CI(J))*K
  1048. 1048 NEXT K
  1049. 1049 IF N$="H" THEN 1052
  1050. 1050 U7=U5*CR(J)-U6*CI(J)+U7
  1051. 1051 U8=U6*CR(J)+U5*CI(J)+U8
  1052. 1052 NEXT J
  1053. 1053 IF N$="E" THEN 1075
  1054. 1054 REM ----- DIFFERENCES OF VECTOR POTENTIAL A
  1055. 1055 J8=1
  1056. 1056 J9=J9+1
  1057. 1057 IF J9=2 THEN 964
  1058. 1058 ON I GOTO 1059,1064,1069
  1059. 1059 H(3)=K!(5,1)-K!(5,2)
  1060. 1060 H(4)=K!(6,1)-K!(6,2)
  1061. 1061 H(5)=K!(3,2)-K!(3,1)
  1062. 1062 H(6)=K!(4,2)-K!(4,1)
  1063. 1063 GOTO 1097
  1064. 1064 H(1)=K!(5,2)-K!(5,1)
  1065. 1065 H(2)=K!(6,2)-K!(6,1)
  1066. 1066 H(5)=H(5)-K!(1,2)+K!(1,1)
  1067. 1067 H(6)=H(6)-K!(2,2)+K!(2,1)
  1068. 1068 GOTO 1097
  1069. 1069 H(1)=H(1)-K!(3,2)+K!(3,1)
  1070. 1070 H(2)=H(2)-K!(4,2)+K!(4,1)
  1071. 1071 H(3)=H(3)+K!(1,2)-K!(1,1)
  1072. 1072 H(4)=H(4)+K!(2,2)-K!(2,1)
  1073. 1073 GOTO 1097
  1074. 1074 REM ----- IMAGINARY PART OF ELECTRIC FIELD
  1075. 1075 U7=-M*U7/S0
  1076. 1076 REM ----- REAL PART OF ELECTRIC FIELD
  1077. 1077 U8=M*U8/S0
  1078. 1078 REM ----- MAGNITUDE AND PHASE CALCULATION
  1079. 1079 S1=0
  1080. 1080 IF (U7=0 AND U8=0) THEN 1082
  1081. 1081 S1=SQR(U7*U7+U8*U8)
  1082. 1082 S2=0
  1083. 1083 IF U8<>0 THEN S2=ATN(U7/U8)/P0
  1084. 1084 IF U8>0 THEN 1086
  1085. 1085 S2=S2+SGN(U7)*180
  1086. 1086 IF I=1 THEN PRINT #3,"   X  ",
  1087. 1087 IF I=2 THEN PRINT #3,"   Y  ",
  1088. 1088 IF I=3 THEN PRINT #3,"   Z  ",
  1089. 1089 PRINT #3,TAB(15);F1*U8;TAB(29);F1*U7;TAB(43);F1*S1;TAB(57);S2
  1090. 1090 IF S$="Y" THEN PRINT #2,F1*U8;",";F1*U7;",";F1*S1;",";S2
  1091. 1091 REM ----- CALCULATION FOR PEAK ELECTRIC FIELD
  1092. 1092 S1=S1*S1
  1093. 1093 S2=S2*P0
  1094. 1094 A1=A1+S1*COS(2*S2)
  1095. 1095 A3=A3+S1*SIN(2*S2)
  1096. 1096 A4=A4+S1
  1097. 1097 NEXT I
  1098. 1098 IF N$="E" THEN 1121
  1099. 1099 REM ----- MAGNETIC FIELD MAGNITUDE AND PHASE CALCULATION
  1100. 1100 FOR I=1 TO 5 STEP 2
  1101. 1101 S1=0
  1102. 1102 IF (H(I)=0 AND H(I+1)=0) THEN 1104
  1103. 1103 S1=SQR(H(I)*H(I)+H(I+1)*H(I+1))
  1104. 1104 S2=0
  1105. 1105 IF H(I)<>0 THEN S2=ATN(H(I+1)/H(I))/P0
  1106. 1106 IF H(I)>0 THEN 1108
  1107. 1107 S2=S2+SGN(H(I+1))*180
  1108. 1108 IF I=1 THEN PRINT #3,"   X  ",
  1109. 1109 IF I=3 THEN PRINT #3,"   Y  ",
  1110. 1110 IF I=5 THEN PRINT #3,"   Z  ",
  1111. 1111 PRINT #3,TAB(15);F1*H(I);TAB(29);F1*H(I+1);TAB(43);F1*S1;TAB(57);S2
  1112. 1112 IF S$="Y" THEN PRINT #2,F1*H(I);",";F1*H(I+1);",";F1*S1;",";S2
  1113. 1113 REM ----- CALCULATION FOR PEAK MAGNETIC FIELD
  1114. 1114 S1=S1*S1
  1115. 1115 S2=S2*P0
  1116. 1116 A1=A1+S1*COS(2*S2)
  1117. 1117 A3=A3+S1*SIN(2*S2)
  1118. 1118 A4=A4+S1
  1119. 1119 NEXT I
  1120. 1120 REM ----- PEAK FIELD CALCULATION
  1121. 1121 PK=SQR(A4/2+SQR(A1*A1+A3*A3)/2)
  1122. 1122 PRINT #3,"   MAXIMUM OR PEAK FIELD = ";F1*PK;A$
  1123. 1123 IF (S$="Y" AND N$="E") THEN PRINT #2,F1*PK;",";O2
  1124. 1124 IF (S$="Y" AND N$="H") THEN PRINT #2,F1*PK;",";O2
  1125. 1125 IF S$="Y" THEN PRINT #2,XX;",";YY;",";ZZ
  1126. 1126 NEXT IX
  1127. 1127 NEXT IY
  1128. 1128 NEXT IZ
  1129. 1129 CLOSE #2
  1130. 1130 RETURN
  1131. 1131 REM ********** FREQUENCY INPUT **********
  1132. 1132 REM ----- SET FLAG
  1133. 1133 PRINT
  1134. 1134 INPUT "FREQUENCY (MHZ)";F
  1135. 1135 IF F=0 THEN F=299.8
  1136. 1136 IF O$>"C" THEN PRINT #3, " ":PRINT #3, "FREQUENCY (MHZ):";F
  1137. 1137 W=299.8/F
  1138. 1138 REM -----VIRTUAL DIPOLE LENGTH FOR NEAR FIELD CALCULATION
  1139. 1139 S0=.001*W
  1140. 1140 REM ----- 1 / (4 * PI * OMEGA * EPSILON)
  1141. 1141 M=4.77783352#*W
  1142. 1142 REM ----- SET SMALL RADIUS MODIFICATION CONDITION
  1143. 1143 SRM=.0001*W
  1144. 1144 PRINT #3, "    WAVE LENGTH = ";W;" METERS"
  1145. 1145 REM ----- 2 PI / WAVELENGTH
  1146. 1146 W=2*P/W
  1147. 1147 W2=W*W/2
  1148. 1148 FLG=0
  1149. 1149 RETURN
  1150. 1150 REM ********** GEOMETRY INPUT **********
  1151. 1151 REM ----- WHEN GEOMETRY IS CHANGED, ENVIRONMENT MUST BE CHECKED
  1152. 1152 GOSUB 1369
  1153. 1153 PRINT
  1154. 1154 IF INFILE THEN 1160
  1155. 1155 INPUT "NO. OF WIRES";NW
  1156. 1156 IF NW=0 THEN RETURN
  1157. 1157 IF NW<=MW THEN 1160
  1158. 1158 PRINT "NUMBER OF WIRES EXCEEDS DIMENSION..."
  1159. 1159 GOTO 1155
  1160. 1160 IF O$>"C" THEN PRINT #3," ":PRINT #3,"NO. OF WIRES:";NW
  1161. 1161 REM ----- INITIALIZE NUMBER OF PULSES TO ZERO
  1162. 1162 N=0
  1163. 1163 FOR I=1 TO NW
  1164. 1164 IF INFILE THEN GOSUB 1557:GOTO 1190
  1165. 1165 PRINT
  1166. 1166 PRINT "WIRE NO.";I
  1167. 1167 INPUT "   NO. OF SEGMENTS";S1
  1168. 1168 IF S1=0 THEN 1153
  1169. 1169 A$="   END ONE COORDINATES (X,Y,Z)"
  1170. 1170 PRINT A$;
  1171. 1171 INPUT X1,Y1,Z1
  1172. 1172 IF G<0 AND Z1<0 THEN PRINT "Z CANNOT BE NEGATIVE":GOTO 1170
  1173. 1173 A$="   END TWO COORDINATES (X,Y,Z)"
  1174. 1174 PRINT A$;
  1175. 1175 INPUT X2,Y2,Z2
  1176. 1176 IF G<0 AND Z2<0 THEN PRINT "Z CANNOT BE NEGATIVE":GOTO 1174
  1177. 1177 IF X1=X2 AND Y1=Y2 AND Z1=Z2 THEN PRINT"ZERO LENGTH WIRE.":GOTO 1166
  1178. 1178 A$="   RADIUS"
  1179. 1179 PRINT "                     "A$;
  1180. 1180 INPUT A(I)
  1181. 1181 IF A(I)<=0! THEN 1179
  1182. 1182 REM ----- DETERMINE CONNECTIONS
  1183. 1183 IF O$>"C" THEN PRINT #3," ":PRINT #3,"WIRE NO.";I
  1184. 1184 GOSUB 1299
  1185. 1185 PRINT "CHANGE WIRE NO. ";I;" (Y/N) ";
  1186. 1186 INPUT A$
  1187. 1187 IF A$="Y" THEN 1165
  1188. 1188 IF A$<>"N" THEN 1185
  1189. 1189 REM ----- COMPUTE DIRECTION COSINES
  1190. 1190 X3=X2-X1
  1191. 1191 Y3=Y2-Y1
  1192. 1192 Z3=Z2-Z1
  1193. 1193 D=SQR(X3*X3+Y3*Y3+Z3*Z3)
  1194. 1194 CA(I)=X3/D
  1195. 1195 CB(I)=Y3/D
  1196. 1196 CG(I)=Z3/D
  1197. 1197 S(I)=D/S1
  1198. 1198 REM ----- COMPUTE CONNECTIVITY DATA (PULSES N1 TO N)
  1199. 1199 N1=N+1
  1200. 1200 N(I,1)=N1
  1201. 1201 IF (S1=1 AND I1=0) THEN N(I,1)=0
  1202. 1202 N=N1+S1
  1203. 1203 IF I1=0 THEN N=N-1
  1204. 1204 IF I2=0 THEN N=N-1
  1205. 1205 IF N>MP THEN PRINT "PULSE NUMBER EXCEEDS DIMENSION":CLOSE:GOTO 1155
  1206. 1206 N(I,2)=N
  1207. 1207 IF (S1=1 AND I2=0) THEN N(I,2)=0
  1208. 1208 IF N<N1 THEN 1247
  1209. 1209 FOR J=N1 TO N
  1210. 1210 C%(J,1)=I
  1211. 1211 C%(J,2)=I
  1212. 1212 W%(J)=I
  1213. 1213 NEXT J
  1214. 1214 C%(N1,1)=I1
  1215. 1215 C%(N,2)=I2
  1216. 1216 REM ----- COMPUTE COORDINATES OF BREAK POINTS
  1217. 1217 I1=N1+2*(I-1)
  1218. 1218 I3=I1
  1219. 1219 X(I1)=X1
  1220. 1220 Y(I1)=Y1
  1221. 1221 Z(I1)=Z1
  1222. 1222 IF C%(N1,1)=0 THEN 1230
  1223. 1223 I2=ABS(C%(N1,1))
  1224. 1224 F3=SGN(C%(N1,1))*S(I2)
  1225. 1225 X(I1)=X(I1)-F3*CA(I2)
  1226. 1226 Y(I1)=Y(I1)-F3*CB(I2)
  1227. 1227 IF C%(N1,1)=-I THEN F3=-F3
  1228. 1228 Z(I1)=Z(I1)-F3*CG(I2)
  1229. 1229 I3=I3+1
  1230. 1230 I6=N+2*I
  1231. 1231 FOR I4=I1+1 TO I6
  1232. 1232 J=I4-I3
  1233. 1233 X(I4)=X1+J*X3/S1
  1234. 1234 Y(I4)=Y1+J*Y3/S1
  1235. 1235 Z(I4)=Z1+J*Z3/S1
  1236. 1236 NEXT I4
  1237. 1237 IF C%(N,2)=0 THEN 1245
  1238. 1238 I2=ABS(C%(N,2))
  1239. 1239 F3=SGN(C%(N,2))*S(I2)
  1240. 1240 I3=I6-1
  1241. 1241 X(I6)=X(I3)+F3*CA(I2)
  1242. 1242 Y(I6)=Y(I3)+F3*CB(I2)
  1243. 1243 IF I=-C%(N,2) THEN F3=-F3
  1244. 1244 Z(I6)=Z(I3)+F3*CG(I2)
  1245. 1245 GOTO 1255
  1246. 1246 REM ---- SINGLE SEGMEN 0 PULSE CASE
  1247. 1247 I1=N1+2*(I-1)
  1248. 1248 X(I1)=X1
  1249. 1249 Y(I1)=Y1
  1250. 1250 Z(I1)=Z1
  1251. 1251 I1=I1+1
  1252. 1252 X(I1)=X2
  1253. 1253 Y(I1)=Y2
  1254. 1254 Z(I1)=Z2
  1255. 1255 NEXT I
  1256. 1256 REM ********** GEOMETRY OUTPUT **********
  1257. 1257 PRINT #3, " "
  1258. 1258 PRINT #3, "                  **** ANTENNA GEOMETRY ****"
  1259. 1259 IF N>0 THEN 1264
  1260. 1260 PRINT
  1261. 1261 PRINT "NUMBER OF PULSES IS ZERO....RE-ENTER GEOMETRY"
  1262. 1262 PRINT
  1263. 1263 GOTO 1155
  1264. 1264 K=1
  1265. 1265 J=0
  1266. 1266 FOR I=1 TO N
  1267. 1267 I1=2*W%(I)-1+I
  1268. 1268 IF K>NW THEN 1279
  1269. 1269 IF K=J THEN 1279
  1270. 1270 J=K
  1271. 1271 PRINT #3," "
  1272. 1272 PRINT #3,"WIRE NO. ";K;" COORDINATES",,,"CONNECTION PULSE"
  1273. 1273 PRINT #3,"X","Y","Z","RADIUS","END1 END2  NO."
  1274. 1274 IF (N(K,1)><0 OR  N(K,2)><0) THEN 1279
  1275. 1275 PRINT #3,"-","-","-","    -"," -    -    0"
  1276. 1276 K=K+1
  1277. 1277 IF K>NW THEN 1286
  1278. 1278 GOTO 1270
  1279. 1279 PRINT #3,X(I1);TAB(15);Y(I1);TAB(29);Z(I1);TAB(43);A(W%(I));TAB(57);
  1280. 1280 PRINT #3, USING "###  ###   ##";C%(I,1),C%(I,2),I
  1281. 1281 IF (I=N(K,2) OR N(K,1)=N(K,2) OR C%(I,2)=0) THEN K=K+1
  1282. 1282 IF C%(I,1)=0 THEN C%(I,1)=W%(I)
  1283. 1283 IF C%(I,2)=0 THEN C%(I,2)=W%(I)
  1284. 1284 IF (K=NW AND N(K,1)=0 AND N(K,2)=0) THEN 1270
  1285. 1285 IF (I=N AND K<NW) THEN 1270
  1286. 1286 NEXT I
  1287. 1287 PRINT
  1288. 1288 CLOSE 1:IF INFILE THEN INFILE=0:IF O$>"C" THEN 1293
  1289. 1289 INPUT "    CHANGE GEOMETRY (Y/N) ";A$
  1290. 1290 IF A$="Y" THEN 1153
  1291. 1291 IF A$<>"N" THEN 1289
  1292. 1292 REM ----- EXCITATION INPUT
  1293. 1293 GOSUB 1430
  1294. 1294 REM ----- LOADS/NETWORKS INPUT
  1295. 1295 GOSUB 1455
  1296. 1296 FLG=0
  1297. 1297 RETURN
  1298. 1298 REM ********** CONNECTIONS **********
  1299. 1299 E(I)=X1
  1300. 1300 L(I)=Y1
  1301. 1301 M(I)=Z1
  1302. 1302 E(I+NW)=X2
  1303. 1303 L(I+NW)=Y2
  1304. 1304 M(I+NW)=Z2
  1305. 1305 G%=0
  1306. 1306 I1=0
  1307. 1307 I2=0
  1308. 1308 J1(I)=0
  1309. 1309 J2(I,1)=-I
  1310. 1310 J2(I,2)=-I
  1311. 1311 IF G=1 THEN 1323
  1312. 1312 REM ----- CHECK FOR GROUND CONNECTION
  1313. 1313 IF Z1=0 THEN 1315
  1314. 1314 GOTO 1318
  1315. 1315 I1=-I
  1316. 1316 J1(I)=-1
  1317. 1317 GOTO 1340
  1318. 1318 IF Z2=0 THEN 1320
  1319. 1319 GOTO 1323
  1320. 1320 I2=-I
  1321. 1321 J1(I)=1
  1322. 1322 G%=1
  1323. 1323 IF I=1 THEN 1358
  1324. 1324 FOR J=1 TO I-1
  1325. 1325 REM ----- CHECK FOR END1 TO END1
  1326. 1326 IF (X1=E(J) AND Y1=L(J) AND Z1=M(J)) THEN 1328
  1327. 1327 GOTO 1333
  1328. 1328 I1=-J
  1329. 1329 J2(I,1)=J
  1330. 1330 IF J2(J,1)=-J THEN J2(J,1)=J
  1331. 1331 GOTO 1340
  1332. 1332 REM ----- CHECK FOR END1 TO END2
  1333. 1333 IF (X1=E(J+NW) AND Y1=L(J+NW) AND Z1=M(J+NW)) THEN 1335
  1334. 1334 GOTO 1339
  1335. 1335 I1=J
  1336. 1336 J2(I,1)=J
  1337. 1337 IF J2(J,2)=-J THEN J2(J,2)=J
  1338. 1338 GOTO 1340
  1339. 1339 NEXT J
  1340. 1340 IF G%=1 THEN 1358
  1341. 1341 IF I=1 THEN 1358
  1342. 1342 FOR J=1 TO I-1
  1343. 1343 REM ----- CHECK END2 TO END2
  1344. 1344 IF (X2=E(J+NW) AND Y2=L(J+NW) AND Z2=M(J+NW)) THEN 1346
  1345. 1345 GOTO 1351
  1346. 1346 I2=-J
  1347. 1347 J2(I,2)=J
  1348. 1348 IF J2(J,2)=-J THEN J2(J,2)=J
  1349. 1349 GOTO 1358
  1350. 1350 REM ----- CHECK FOR END2 TO END1
  1351. 1351 IF (X2=E(J) AND Y2=L(J) AND Z2=M(J)) THEN 1353
  1352. 1352 GOTO 1357
  1353. 1353 I2=J
  1354. 1354 J2(I,2)=J
  1355. 1355 IF J2(J,1)=-J THEN J2(J,1)=J
  1356. 1356 GOTO 1358
  1357. 1357 NEXT J
  1358. 1358 PRINT #3,"            COORDINATES","  ","  ","END         NO. OF"
  1359. 1359 PRINT #3,"   X","   Y","   Z","RADIUS     CONNECTION     SEGMENTS"
  1360. 1360 PRINT #3,X1;TAB(15);Y1;TAB(29);Z1;TAB(57);I1
  1361. 1361 PRINT #3,X2;TAB(15);Y2;TAB(29);Z2;TAB(43);A(I);TAB(57);I2;TAB(71);S1
  1362. 1362 RETURN
  1363. 1363 REM ********** ENVIROMENT INPUT **********
  1364. 1364 PRINT
  1365. 1365 PRINT "                        **** WARNING ****"
  1366. 1366 PRINT "REDO GEOMETRY TO ENSURE PROPER GROUND CONNECTION/DISCONNECTION"
  1367. 1367 PRINT
  1368. 1368 REM ----- INITIALIZE NUMBER OF RADIAL WIRES TO ZERO
  1369. 1369 NR=0
  1370. 1370 REM ----- SET ENVIRONMENT
  1371. 1371 PRINT #3," "
  1372. 1372 A$="ENVIRONMENT (+1 FOR FREE SPACE, -1 FOR GROUND PLANE)"
  1373. 1373 PRINT A$;
  1374. 1374 INPUT G
  1375. 1375 IF O$>"C" THEN PRINT #3,A$;": ";G
  1376. 1376 IF G=1 THEN 1428
  1377. 1377 IF G<>-1 THEN 1373
  1378. 1378 REM ----- NUMBER OF MEDIA
  1379. 1379 A$=" NUMBER OF MEDIA (0 FOR PERFECTLY CONDUCTING GROUND)"
  1380. 1380 PRINT A$;
  1381. 1381 INPUT NM
  1382. 1382 IF NM<=MM THEN 1385
  1383. 1383 PRINT "NUMBER OF MEDIA EXCEEDS DIMENSION..."
  1384. 1384 GOTO 1380
  1385. 1385 IF O$>"C" THEN PRINT #3,A$;": ";NM
  1386. 1386 REM ----- INITIALIZE BOUNDARY TYPE
  1387. 1387 TB=1
  1388. 1388 IF NM=0 THEN 1428
  1389. 1389 IF NM=1 THEN 1396
  1390. 1390 REM ----- TYPE OF BOUNDARY
  1391. 1391 A$=" TYPE OF BOUNDARY (1-LINEAR, 2-CIRCULAR)"
  1392. 1392 PRINT "            ";A$;
  1393. 1393 INPUT TB
  1394. 1394 IF O$>"C" THEN PRINT #3,A$;": ";TB
  1395. 1395 REM ----- BOUNDARY CONDITIONS
  1396. 1396 FOR I=1 TO NM
  1397. 1397 PRINT "MEDIA";I
  1398. 1398 A$=" RELATIVE DIELECTRIC CONSTANT, CONDUCTIVITY"
  1399. 1399 PRINT "         ";A$;
  1400. 1400 INPUT T(I),V(I)
  1401. 1401 IF O$>"C" THEN PRINT #3,A$;": ";T(I)","V(I)
  1402. 1402 IF I>1 THEN 1414
  1403. 1403 IF TB=1 THEN 1414
  1404. 1404 A$=" NUMBER OF RADIAL WIRES IN GROUND SCREEN"
  1405. 1405 PRINT "            ";A$;
  1406. 1406 INPUT NR
  1407. 1407 IF O$>"C" THEN PRINT #3,A$;": ";NR
  1408. 1408 IF NR=0 THEN 1414
  1409. 1409 A$=" RADIUS OF RADIAL WIRES"
  1410. 1410 PRINT "                             ";A$;
  1411. 1411 INPUT RR
  1412. 1412 IF O$>"C" THEN PRINT #3,A$;": ";RR
  1413. 1413 REM ----- INITIALIZE COORDINATE OF MEDIA INTERFACE
  1414. 1414 U(I)=1000000!
  1415. 1415 REM ----- INITIALIZE HEIGHT OF MEDIA
  1416. 1416 H(I)=0
  1417. 1417 IF I=NM THEN 1422
  1418. 1418 A$=" X OR R COORDINATE OF NEXT MEDIA INTERFACE"
  1419. 1419 PRINT "          ";A$;
  1420. 1420 INPUT U(I)
  1421. 1421 IF O$>"C" THEN PRINT #3,A$;": ";U(I)
  1422. 1422 IF I=1 THEN 1427
  1423. 1423 A$=" HEIGHT OF MEDIA"
  1424. 1424 PRINT "                                    ";A$;
  1425. 1425 INPUT H(I)
  1426. 1426 IF O$>"C" THEN PRINT #3,A$;": ";H(I)
  1427. 1427 NEXT I
  1428. 1428 RETURN
  1429. 1429 REM ********** EXCITATION INPUT **********
  1430. 1430 PRINT
  1431. 1431 A$="NO. OF SOURCES "
  1432. 1432 PRINT A$;
  1433. 1433 INPUT NS
  1434. 1434 IF NS<1 THEN NS=1
  1435. 1435 IF NS<=MP THEN 1438
  1436. 1436 PRINT "NO. OF SOURCES EXCEEDS DIMENSION ..."
  1437. 1437 GOTO 1432
  1438. 1438 IF O$>"C" THEN PRINT #3," ":PRINT #3, A$;": ";NS
  1439. 1439 FOR I=1 TO NS
  1440. 1440 PRINT
  1441. 1441 PRINT "SOURCE NO. ";I;":"
  1442. 1442 A$="PULSE NO., VOLTAGE MAGNITUDE, PHASE (DEGREES)"
  1443. 1443 PRINT A$;
  1444. 1444 INPUT E(I),VM,VP
  1445. 1445 IF E(I)<=N THEN 1448
  1446. 1446 PRINT "PULSE NUMBER EXCEEDS NUMBER OF PULSES..."
  1447. 1447 GOTO 1443
  1448. 1448 IF O$>"C" THEN PRINT #3,A$;": ";E(I)","VM","VP
  1449. 1449 L(I)=VM*COS(VP*P0)
  1450. 1450 M(I)=VM*SIN(VP*P0)
  1451. 1451 NEXT I
  1452. 1452 IF FLG=2 THEN FLG=1
  1453. 1453 RETURN
  1454. 1454 REM ********** LOADS INPUT **********
  1455. 1455 PRINT
  1456. 1456 INPUT "NUMBER OF LOADS       ";NL
  1457. 1457 IF NL<=ML THEN 1460
  1458. 1458 PRINT "NUMBER OF LOADS EXCEEDS DIMENSION..."
  1459. 1459 GOTO 1456
  1460. 1460 IF O$>"C" THEN PRINT #3,"NUMBER OF LOADS";NL
  1461. 1461 IF NL<1 THEN 1492
  1462. 1462 INPUT "S-PARAMETER (S=jw) IMPEDANCE LOAD (Y/N)";L$
  1463. 1463 IF L$<>"Y" AND L$<>"N" THEN 1462
  1464. 1464 A$="PULSE NO.,RESISTANCE,REACTANCE"
  1465. 1465 IF L$="Y" THEN A$= "PULSE NO., ORDER OF S-PARAMETER FUNCTION"
  1466. 1466 FOR I=1 TO NL
  1467. 1467 PRINT
  1468. 1468 PRINT "LOAD NO. ";I;":"
  1469. 1469 IF L$="Y" THEN 1476
  1470. 1470 PRINT A$;
  1471. 1471 INPUT LP(I),LA(1,I,1),LA(2,I,1)
  1472. 1472 IF LP(I)>N THEN PRINT "PULSE NUMBER EXCEEDS NUMBER OF PULSES...": GOTO 1470
  1473. 1473 IF O$>"C" THEN PRINT #3,A$;": ";LP(I);",";LA(1,I,1);",";LA(2,I,1)
  1474. 1474 GOTO 1491
  1475. 1475 REM ----- S-PARAMETER LOADS
  1476. 1476 PRINT A$;
  1477. 1477 INPUT LP(I),LS(I)
  1478. 1478 IF LP(I)>N THEN PRINT "PULSE NUMBER EXCEEDS NUMBER OF PULSES...": GOTO 1476
  1479. 1479 IF LS(I)>MA THEN PRINT "MAXIMUM DIMENSION IS 10":GOTO 1477
  1480. 1480 IF O$>"C" THEN PRINT #3,A$;": ";LP(I);",";LS(I)
  1481. 1481 FOR J=0 TO LS(I)
  1482. 1482 A$="NUMERATOR, DENOMINATOR COEFFICIENTS OF S^"
  1483. 1483 PRINT A$;J;
  1484. 1484 INPUT LA(1,I,J),LA(2,I,J)
  1485. 1485 IF O$>"C" THEN PRINT #3,A$;J;":";LA(1,I,J);",";LA(2,I,J)
  1486. 1486 NEXT J
  1487. 1487 IF LS(I)>0 THEN 1491
  1488. 1488 LS(I)=1
  1489. 1489 LA(1,I,1)=0
  1490. 1490 LA(2,I,1)=0
  1491. 1491 NEXT I
  1492. 1492 FLG=0
  1493. 1493 RETURN
  1494. 1494 REM ********** MAIN PROGRAM **********
  1495. 1495 REM ----- DATA INITIALIZATION
  1496. 1496 REM ----- PI
  1497. 1497 P=4*ATN(1)
  1498. 1498 REM ----- CHANGES DEGREES TO RADIANS
  1499. 1499 P0=P/180
  1500. 1500 B$="********************"
  1501. 1501 REM ----- INTRINSIC IMPEDANCE OF FREE SPACE DIVIDED BY 2 PI
  1502. 1502 G0=29.979221#
  1503. 1503 REM ---------- Q-VECTOR FOR GAUSSIAN QUADRATURE
  1504. 1504 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)
  1505. 1505 READ Q(13),Q(14)
  1506. 1506 DATA .288675135,.5,.430568156,.173927423,.169990522,.326072577
  1507. 1507 DATA .480144928,.050614268,.398333239,.111190517
  1508. 1508 DATA .262766205,.156853323,.091717321,.181341892
  1509. 1509 REM ---------- E-VECTOR FOR COEFFICIENTS OF ELLIPTIC INTEGRAL
  1510. 1510 READ C0,C1,C2,C3,C4,C5,C6,C7,C8,C9
  1511. 1511 DATA 1.38629436112,.09666344259,.03590092383,.03742563713,.01451196212
  1512. 1512 DATA .5,.12498593397,.06880248576,.0332835346,.00441787012
  1513. 1513 REM ----- IDENTIFY OUTPUT DEVICE
  1514. 1514 GOSUB 1580
  1515. 1515 PRINT #3,TAB(20);B$;B$
  1516. 1516 PRINT #3,TAB(22);"MINI-NUMERICAL ELECTROMAGNETICS CODE"
  1517. 1517 PRINT #3,TAB(36);"MININEC"
  1518. 1518 PRINT #3,TAB(24);DATE$;TAB(48);TIME$
  1519. 1519 PRINT #3,TAB(20);B$;B$
  1520. 1520 REM ----- FREQUENCY INPUT
  1521. 1521 GOSUB 1133
  1522. 1522 REM ----- ENVIRONMENT INPUT
  1523. 1523 GOSUB 1369
  1524. 1524 REM ----- CHECK FOR NEC-TYPE GEOMETRY INPUT
  1525. 1525 GOSUB 1550
  1526. 1526 REM ----- GEOMETRY INPUT
  1527. 1527 GOSUB 1153
  1528. 1528 REM ----- MENU
  1529. 1529 PRINT
  1530. 1530 PRINT B$;"    MININEC MENU    ";B$
  1531. 1531 PRINT "   G - CHANGE GEOMETRY     C - COMPUTE/DISPLAY CURRENTS"
  1532. 1532 PRINT "   E - CHANGE ENVIRONMENT  P - COMPUTE FAR-FIELD PATTERNS"
  1533. 1533 PRINT "   X - CHANGE EXCITATION   N - COMPUTE NEAR-FIELDS"
  1534. 1534 PRINT "   L - CHANGE LOADS"
  1535. 1535 PRINT "   F - CHANGE FREQUENCY    Q - QUIT"
  1536. 1536 PRINT B$;B$;B$
  1537. 1537 INPUT "   COMMAND ";C$
  1538. 1538 IF C$="F" THEN GOSUB 1133
  1539. 1539 IF C$="P" THEN GOSUB 621
  1540. 1540 IF C$="X" THEN GOSUB 1430
  1541. 1541 IF C$="E" THEN GOSUB 1364
  1542. 1542 IF C$="G" THEN GOSUB 1152
  1543. 1543 IF C$="C" THEN GOSUB 497
  1544. 1544 IF C$="L" THEN GOSUB 1455
  1545. 1545 IF C$="N" THEN GOSUB 875
  1546. 1546 IF C$<>"Q" THEN 1529
  1547. 1547 IF O$="P" THEN PRINT #3, CHR$(12) ELSE IF O$="C" THEN PRINT #3, " "
  1548. 1548 CLOSE
  1549. 1549 GOTO 1617
  1550. 1550 REM ********** NEC-TYPE GEOMETRY INPUT **********
  1551. 1551 OPEN "MININEC.INP" AS #1 LEN=30
  1552. 1552 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$
  1553. 1553 GET 1
  1554. 1554 NW=CVI(S$)
  1555. 1555 IF NW THEN INFILE=1
  1556. 1556 RETURN
  1557. 1557 REM ---------- GET GEOMETRY DATA FROM MININEC.INP
  1558. 1558 GET 1
  1559. 1559 S1=CVI(S$)
  1560. 1560 X1=CVS(X1$)
  1561. 1561 Y1=CVS(Y1$)
  1562. 1562 Z1=CVS(Z1$)
  1563. 1563 X2=CVS(X2$)
  1564. 1564 Y2=CVS(Y2$)
  1565. 1565 Z2=CVS(Z2$)
  1566. 1566 A(I)=CVS(R$)
  1567. 1567 IF G<0 THEN IF Z1<0 OR Z2<0 THEN GOSUB 1572
  1568. 1568 PRINT #3," ":PRINT #3,"WIRE NO.";I
  1569. 1569 IF X1=X2 AND Y1=Y2 AND Z1=Z2 THEN PRINT"WIRE LENGTH IS ZERO.":GOTO 1547
  1570. 1570 GOSUB 1299
  1571. 1571 RETURN
  1572. 1572 IF IZNEG THEN 1576
  1573. 1573 PRINT"NEGATIVE Z VALUE ENCOUNTERED FOR GROUND PLANE."
  1574. 1574 INPUT "ABORT OR CONVERT NEGATIVE Z VALUE TO ZERO (A/C)? ";A$
  1575. 1575 IF A$="A" THEN 1547 ELSE IF A$="C" THEN IZNEG=1 ELSE 1574
  1576. 1576 IF Z1<0 THEN Z1=-Z1
  1577. 1577 IF Z2<0 THEN Z2=-Z2
  1578. 1578 RETURN
  1579. 1579 REM ********** IDENTIFY OUTPUT DEVICE **********
  1580. 1580 INPUT "OUTPUT TO CONSOLE, PRINTER, OR DISK (C/P/D)";O$
  1581. 1581 IF O$="C" THEN F$="SCRN:":GOTO 1586
  1582. 1582 IF O$="P" THEN F$="LPT1:":GOTO 1586
  1583. 1583 IF O$<>"D" THEN 1580
  1584. 1584 INPUT "FILENAME (NAME.OUT)";F$
  1585. 1585 IF LEFT$(RIGHT$(F$,4),1)="." THEN 1586 ELSE F$=F$+".OUT"
  1586. 1586 OPEN F$ FOR OUTPUT AS #3
  1587. 1587 CLS
  1588. 1588 RETURN
  1589. 1589 REM ********** CALCULATE ELAPSED TIME **********
  1590. 1590 IH=VAL(MID$(T$,1,2))-VAL(MID$(OT$,1,2))
  1591. 1591 IM=VAL(MID$(T$,4,2))-VAL(MID$(OT$,4,2))
  1592. 1592 IS=VAL(MID$(T$,7,2))-VAL(MID$(OT$,7,2))
  1593. 1593 IF IS<0 THEN IS=IS+60:IM=IM-1
  1594. 1594 IF IM<0 THEN IM=IM+60:IH=IH-1
  1595. 1595 IF IH<0 THEN IH=IH+24
  1596. 1596 T$=":"+MID$(STR$(IS+100),3)
  1597. 1597 IF IH THEN T$=MID$(STR$(IH),2)+":"+MID$(STR$(IM+100),3)+T$ ELSE T$=MID$(STR$(IM),2)+T$
  1598. 1598 RETURN
  1599. 1599 REM ********** CALCULATE APPROXIMATE TIME REMAINING **********
  1600. 1600 IPCT=100*PCT
  1601. 1601 T$=TIME$
  1602. 1602 IH=VAL(MID$(T$,1,2))-VAL(MID$(OT$,1,2))
  1603. 1603 IF IH<0 THEN IH=IH+24
  1604. 1604 IM=VAL(MID$(T$,4,2))-VAL(MID$(OT$,4,2))
  1605. 1605 IS=VAL(MID$(T$,7,2))-VAL(MID$(OT$,7,2))
  1606. 1606 IS=IS+60*(IM+60*IH)
  1607. 1607 IS=IS*(1/PCT-1)
  1608. 1608 IM=INT(IS/60)
  1609. 1609 IS=IS MOD 60
  1610. 1610 IH=INT(IM/60)
  1611. 1611 IM=IM MOD 60
  1612. 1612 T$=":"+MID$(STR$(IS+100),3)
  1613. 1613 IF IH THEN T$=MID$(STR$(IH),2)+":"+MID$(STR$(IM+100),3)+T$ ELSE T$=MID$(STR$(IM),2)+T$
  1614. 1614 LOCATE CSRLIN,1
  1615. 1615 PRINT Q$;IPCT;"% COMPLETE - APPROX TIME REMAINING "T$"   ";
  1616. 1616 RETURN
  1617. 1617 END
  1618.