home *** CD-ROM | disk | FTP | other *** search
GW-BASIC | 1985-08-20 | 6.5 KB | 272 lines |
- 1000 ' NETWORK - An AC electronic circuit simulator program
- 1001 '
- 1002 ' Origional: "Verify Network Frequency Response With This
- 1003 ' Simple BASIC Program", Werner Schnider, EDN
- 1004 '<UNK! {0009}><UNK! {0009}> magazine, Oct. 5, 1977 (HP 9830 implementation).
- 1005 '
- 1010 ' Next: "Basic Program Performs Circuit Analysis", Richard
- 1011 ' <UNK! {0009}><UNK! {0009}> Steincross, EDN magazine, Sept. 1, 1982 (Apple ][
- 1012 ' <UNK! {0009}><UNK! {0009}> implementation with inductive elements added)<UNK! {0009}>
- 1013 '
- 1020 ' Now:<UNK! {0009}> Converted for the IBM PC/XT and compatibles by
- 1021 '<UNK! {0009}><UNK! {0009}> Bruce A. Trolli, Cleveland, Oh., 2/16/85
- 1022 '
- 1100 CLS
- 1110 LOCATE 2,10:PRINT "AC ELECTRONIC CIRCUIT FREQUENCY RESPONSE"
- 1120 LOCATE 4,20:PRINT "NETWORK (V1.0)"
- 1140 PRINT
- 1160 I=0:J=0:K=0:N=0:I1=0
- 1180 GOSUB 6200 <UNK! {0009}><UNK! {0009}><UNK! {0009}>' Print help information on screen
- 1190 PRINT
- 1200 Y=40 ' Allocate memory for circuit
- 1220 'Note: If you have less than 64K in your system, you must decrease Y
- 1240 DIM A(Y,Y),B(Y,Y),P(Y,Y),Q(Y,Y),B1(Y,Y),Q1(Y,Y)
- 1300 N=0:PI=3.14159:LGTEN=8.68589<UNK! {0009}>' Initialize constants<UNK! {0009}>
- 1340 INPUT"What file for input? [Hit CR for list.] ",F$
- 1360 IF F$="" THEN FILES"*.net":GOTO 1340 <UNK! {0009}>' Show possible input files
- 1380 FOR I=1 TO LEN(F$)<UNK! {0009}><UNK! {0009}><UNK! {0009}><UNK! {0009}>' Check for extension
- 1400 IF MID$(F$,I,1)="." THEN J=I
- 1420 NEXT I
- 1440 IF J<>0 THEN F$=MID$(F$,1,J-1)<UNK! {0009}><UNK! {0009}>' Add .NET if missing<UNK! {0009}>
- 1460 F$=F$+".net"
- 1500 OPEN F$ FOR INPUT AS #1
- 1510 PRINT
- 1530 '
- 1531 '
- 1532 '************* Main Loop for Input of Circuit Description *************
- 1533 '
- 1540 IF EOF(1) THEN GOTO 2220
- 1545 INPUT #1,Z$
- 1550 PRINT Z$
- 1560 E$=Z$:Z$=LEFT$(Z$,1)
- 1570 IF Z$=";" THEN GOTO 1540 'Comment for Description of Circuit
- 1580 IF Z$="R" OR Z$="r" THEN 1860 'Resistors
- 1600 IF Z$="C" OR Z$="c" THEN 1900 'Capacitors
- 1620 IF Z$="L" OR Z$="l" THEN 1960 'Inductors
- 1640 IF Z$="O" OR Z$="o" THEN 2140 'Amplifiers
- 1660 IF Z$="F" OR Z$="f" THEN 2020 'Fets
- 1680 IF Z$="B" OR Z$="b" THEN 2060 'Bipolar Transistors
- 1720 CLOSE #1 'Not Valid Component
- 1730 BEEP:BEEP
- 1740 PRINT
- 1760 PRINT"Bad component type":PRINT Z$
- 1800 PRINT
- 1840 END
- 1850 '
- 1851 '
- 1852 ' ************** Enter Component Parameters into Matrix ****************
- 1853 '
- 1860 INPUT #1,I,J,V <UNK! {0009}><UNK! {0009}><UNK! {0009}><UNK! {0009}><UNK! {0009}>'resistor
- 1861 PRINT I,J,V
- 1880 V=1/V:GOSUB 3900:GOTO 1540
- 1900 INPUT #1,I,J,V <UNK! {0009}><UNK! {0009}><UNK! {0009}><UNK! {0009}><UNK! {0009}>' capacitor
- 1901 PRINT I,J,V
- 1920 V=V/1E+06
- 1940 GOSUB 4120:GOTO 1540
- 1960 INPUT #1,I,J,V <UNK! {0009}><UNK! {0009}><UNK! {0009}><UNK! {0009}><UNK! {0009}>' inductor
- 1961 PRINT I,J,V
- 1980 V=-1/V
- 2000 GOSUB 4260:GOTO 1540
- 2020 INPUT #1,K,J,I,V <UNK! {0009}><UNK! {0009}><UNK! {0009}><UNK! {0009}><UNK! {0009}>'fet
- 2021 PRINT K,J,I,V
- 2040 L=J:GOTO 2200
- 2060 INPUT #1,K,J,I,B1,V <UNK! {0009}><UNK! {0009}><UNK! {0009}><UNK! {0009}>'npn transistor
- 2061 PRINT K,J,I,B1,V
- 2080 L=I:I=K:V=1/V:GOSUB 3900
- 2100 I=L:L=J:GOTO 2180
- 2120 <UNK! {0009}><UNK! {0009}><UNK! {0009}><UNK! {0009}><UNK! {0009}><UNK! {0009}><UNK! {0009}>' op amp
- 2140 INPUT #1,K,L,J,I,B1,V 'in+,-:out+,-:,gain,ohms
- 2141 PRINT K,L,J,I,B1,V
- 2160 V=1/V:GOSUB 3900
- 2180 V=B1*V
- 2200 GOSUB 4400:GOTO 1540
- 2220 E=1:F=N 'end read io
- 2240 CLOSE #1
- 2300 FOR I=0 TO N
- 2320 FOR J=0 TO N
- 2340 P(I,J)=A(I,J)
- 2360 Q1(I,J)=B1(I,J)
- 2380 Q(I,J)=B(I,J)
- 2400 NEXT J:NEXT I
- 3000 PRINT
- 3020 PRINT "This circuit has ";N;"nodes"
- 3040 PRINT "Node";E;"is INPUT & Node";F;"IS OUTPUT"
- 3060 PRINT
- 3200 ' entry point for new freq range
- 3225 INPUT "Enter file for data save [CR for no-save]: ",DATFILE$
- 3226 IF DATFILE$<>"" THEN OPEN DATFILE$ FOR OUTPUT AS #2
- 3260 PRINT
- 3280 PRINT "Frequency range [Start,End,Increment (- for log incr)] ";
- 3320 INPUT G,H,D
- 3340 PRINT
- 3360 PRINT" Frequency Amplitude Amplitude(db) Phase"
- 3370 PRINT"--------------------------------------------------------------------"
- 3380 IF D<0 THEN F2=-D:GOTO 3420
- 3400 F2=1+(H-G)/D
- 3420 IF D<0 THEN D=-((H/G)^(1/(-D-1)))
- 3440 F1=G
- 3460 FOR I1=1 TO F2
- 3480 W=2*PI*F1:D1=E:D2=F:GOSUB 5660
- 3500 V=B1:U=D2
- 3520 IF (-1)^(E+F) >0 THEN 3560
- 3540 U=U-180
- 3560 D1=E:D2=E
- 3580 GOSUB 5660:V=V/B1:U=U-D2
- 3600 IF U>180 THEN U=U-360
- 3620 IF U<-180 THEN U=U+360
- 3640 DB=LGTEN*LOG(V)
- 3645 T1=F1
- 3646 T2=V
- 3647 T3=DB
- 3648 T4=U
- 3660 PRINT USING "##########.#######";T1;
- 3680 PRINT USING "###########.#######";T2;
- 3685 PRINT USING "#######.#######";T3;
- 3700 PRINT USING "#####.#######";T4
- 3705 IF DATFILE$<>"" THEN WRITE #2,T1,T2,T3,T4
- 3720 IF D<0 THEN F1 =-F1*D:GOTO 3760
- 3740 F1=F1+D
- 3760 NEXT I1
- 3765 CLOSE #2
- 3780 PRINT CHR$(7): ' ring bell
- 3800 PRINT "Do you want a new freq sweep ";
- 3820 INPUT Z$
- 3840 PRINT:IF Z$="y" OR Z$="Y" THEN 3000
- 3860 END
- 3885 '
- 3886 ' Calculation Portion
- 3887 '
- 3888 '
- 3900 IF I=0 THEN 4000
- 3920 A(I,I)=A(I,I)+V
- 3940 IF J=0 THEN 4020
- 3960 A(I,J)=A(I,J)-V
- 3980 A(J,I)=A(J,I)-V
- 4000 A(J,J)=A(J,J)+V
- 4020 IF I<N THEN 4060
- 4040 N=I
- 4060 IF J<N THEN 4100
- 4080 N=J
- 4100 RETURN
- 4120 IF I=0 THEN 4220
- 4140 B(I,I)=B(I,I)+V
- 4160 IF J=0 THEN 4020
- 4180 B(I,J)=B(I,J)-V
- 4200 B(J,I)=B(J,I)-V
- 4220 B(J,J)=B(J,J)+V
- 4240 GOTO 4020
- 4260 IF I=0 THEN 4360
- 4280 B1(I,I)=B1(I,I)+V
- 4300 IF J=0 THEN 4020
- 4320 B1(I,J)=B1(I,J)-V
- 4340 B1(J,I)=B1(J,I)-V
- 4360 B1(J,J)=B1(J,J)+V
- 4380 GOTO 4020
- 4400 IF I<>0 AND K<>0 THEN A(I,K)=A(I,K)+V
- 4420 IF J<>0 AND L<>0 THEN A(J,L)=A(J,L)+V
- 4440 IF J<>0 AND K<>0 THEN A(J,K)=A(J,K)-V
- 4460 IF I<>0 AND L<>0 THEN A(I,L)=A(I,L)-V
- 4480 IF K<N THEN 4520
- 4500 N=K
- 4520 IF L<N THEN 4560
- 4540 N=L
- 4560 GOTO 4020
- 4580 ' determinant computation
- 4600 IF N>1 THEN 4640
- 4620 D1=A(N,N):D2=B(N,N):RETURN
- 4640 D1=1:D2=0:K=1
- 4660 L=K
- 4680 S=ABS(A(K,K))+ABS(B(K,K))
- 4700 FOR I=K TO N
- 4720 T=ABS(A(I,K))+ABS(B(I,K))
- 4740 IF S>=T THEN 4780
- 4760 L=I:S=T
- 4780 NEXT I
- 4800 IF L=K THEN 4960
- 4820 FOR J=1 TO N
- 4840 S=-A(K,J)
- 4860 A(K,J)=A(L,J)
- 4880 A(L,J)=S
- 4900 S1=-B(K,J)
- 4920 B(K,J)=B(L,J):B(L,J)=S1
- 4940 NEXT J
- 4960 L=K+1
- 4980 FOR I=L TO N
- 5000 S1=A(K,K)*A(K,K)+B(K,K)*B(K,K)
- 5020 S=(A(I,K)*A(K,K)+B(I,K)*B(K,K))/S1
- 5040 B(I,K)=(A(K,K)*B(I,K)-A(I,K)*B(K,K))/S1
- 5060 A(I,K)=S:NEXT I
- 5080 J2=K-1
- 5100 IF J2=0 THEN 5220
- 5120 FOR J=L TO N
- 5140 FOR I=1 TO J2
- 5160 A(K,J)=A(K,J)-A(K,I)*A(I,J)+B(K,I)*B(I,J)
- 5180 B(K,J)=B(K,J)-B(K,I)*A(I,J)-A(K,I)*B(I,J)
- 5200 NEXT I:NEXT J
- 5220 J2=K:K=K+1
- 5240 FOR I=K TO N
- 5260 FOR J=1 TO J2
- 5280 A(I,K)=A(I,K)-A(I,J)*A(J,K)+B(I,J)*B(J,K)
- 5300 B(I,K)=B(I,K)-B(I,J)*A(J,K)-A(I,J)*B(J,K)
- 5320 NEXT J:NEXT I
- 5340 IF K<>N THEN 4660
- 5360 L=1
- 5380 J2=INT(N/2)
- 5400 IF N=2*J2 THEN 5480
- 5420 L=0
- 5440 D1=A(N,N)
- 5460 D2=B(N,N)
- 5480 FOR I=1 TO J2
- 5500 J=N-I+L
- 5520 S=A(I,I)*A(J,J)-B(I,I)*B(J,J)
- 5540 S1=A(I,I)*B(J,J)+A(J,J)*B(I,I)
- 5560 T=D1*S-D2*S1
- 5580 D2=D2*S+D1*S1
- 5600 D1=T
- 5620 NEXT I
- 5640 RETURN
- 5660 N1=N:N=N-1:I=0
- 5680 FOR K=1 TO N
- 5700 IF K<>D1 THEN 5740
- 5720 I=1
- 5740 J=0
- 5760 FOR L=1 TO N
- 5780 IF L<>D2 THEN 5820
- 5800 J=1
- 5820 A(K,L)=P(K+I,L+J)
- 5840 B(K,L)=W*Q(K+I,L+J)+Q1(K+I,L+J)/W
- 5860 NEXT L:NEXT K
- 5880 GOSUB 4600
- 5900 N=N1
- 5920 B1=SQR(D1*D1+D2*D2)
- 5940 IF D1<>0 THEN 6020
- 5960 IF D2=0 THEN 6100
- 5980 IF D2>0 THEN D2=90:GOTO 6100
- 6000 D2=-90:GOTO 6100
- 6020 IF D1<0 THEN Q=180:GOTO 6060
- 6040 Q=0
- 6060 IF D2<0 THEN Q=-Q
- 6080 D2=Q+180*ATN(D2/D1)/PI
- 6100 RETURN
- 6200 '
- 6201 '
- 6202 '
- 6205 '******************** Print help information *****************
- 6206 '
- 6220 PRINT"Data must be in a text file in the following format:"
- 6240 PRINT
- 6260 PRINT"R (resistor)"
- 6280 PRINT"from node #, to node #, value in ohms"
- 6300 PRINT"C (capacitor)"
- 6320 PRINT"from node #, to node #, value in microfarads"
- 6340 PRINT"L (inductor)"
- 6360 PRINT"from node #, to node #, value in henries"
- 6380 PRINT"F (fet transistor)"
- 6400 PRINT"gate, source, drain, gain (amps/volts)"
- 6420 PRINT"B (bipolar transistor)"
- 6440 PRINT"base, emitter, collector, beta, b-e ohms"
- 6460 PRINT"O (op-amp)"
- 6480 PRINT"+in, -in, +out, -out, gain, ohms out"
- 6540 PRINT
- 6560 RETURN
-