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