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