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